[libnetlib-java] 03/03: Restore old 0.9.3 version
Andreas Tille
tille at debian.org
Fri May 20 18:55:42 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository libnetlib-java.
commit 61413fc757ee06d02ecaaed44b6b568dce64c15e
Author: Andreas Tille <tille at debian.org>
Date: Fri May 20 20:49:28 2016 +0200
Restore old 0.9.3 version
---
.gitignore | 8 -
LICENSE.txt | 49 -
README.md | 274 -
all/pom.xml | 102 -
build.xml | 48 +
core/pom.xml | 118 -
generator/LICENSE.txt | 674 -
generator/pom.xml | 179 -
.../netlib/generator/AbstractJavaGenerator.java | 65 -
.../netlib/generator/AbstractNetlibGenerator.java | 221 -
.../fommil/netlib/generator/F2jImplGenerator.java | 77 -
.../netlib/generator/F2jJavadocExtractor.java | 76 -
.../fommil/netlib/generator/JarMethodScanner.java | 92 -
.../netlib/generator/JavaInterfaceGenerator.java | 97 -
.../netlib/generator/NativeImplJavaGenerator.java | 114 -
.../netlib/generator/NativeImplJniGenerator.java | 232 -
.../fommil/netlib/generator/netlib-common.stg | 56 -
.../github/fommil/netlib/generator/netlib-java.stg | 145 -
.../github/fommil/netlib/generator/netlib-jni.stg | 159 -
javadoc/allclasses-frame.html | 42 +
javadoc/allclasses-noframe.html | 42 +
javadoc/constant-values.html | 147 +
javadoc/deprecated-list.html | 147 +
javadoc/help-doc.html | 224 +
javadoc/index-files/index-1.html | 150 +
javadoc/index-files/index-10.html | 2186 +
javadoc/index-files/index-11.html | 157 +
javadoc/index-files/index-2.html | 147 +
javadoc/index-files/index-3.html | 2183 +
javadoc/index-files/index-4.html | 156 +
javadoc/index-files/index-5.html | 195 +
javadoc/index-files/index-6.html | 147 +
javadoc/index-files/index-7.html | 162 +
javadoc/index-files/index-8.html | 146 +
javadoc/index-files/index-9.html | 146 +
javadoc/index.html | 40 +
javadoc/org/netlib/arpack/ARPACK.html | 2573 +
javadoc/org/netlib/arpack/class-use/ARPACK.html | 181 +
javadoc/org/netlib/arpack/package-frame.html | 33 +
javadoc/org/netlib/arpack/package-summary.html | 159 +
javadoc/org/netlib/arpack/package-tree.html | 154 +
javadoc/org/netlib/arpack/package-use.html | 172 +
javadoc/org/netlib/blas/BLAS.html | 8198 ++
javadoc/org/netlib/blas/class-use/BLAS.html | 181 +
javadoc/org/netlib/blas/package-frame.html | 33 +
javadoc/org/netlib/blas/package-summary.html | 159 +
javadoc/org/netlib/blas/package-tree.html | 154 +
javadoc/org/netlib/blas/package-use.html | 172 +
javadoc/org/netlib/lapack/LAPACK.html | 100064 ++++++++++++++++++
javadoc/org/netlib/lapack/class-use/LAPACK.html | 181 +
javadoc/org/netlib/lapack/package-frame.html | 33 +
javadoc/org/netlib/lapack/package-summary.html | 159 +
javadoc/org/netlib/lapack/package-tree.html | 154 +
javadoc/org/netlib/lapack/package-use.html | 172 +
javadoc/org/netlib/utils/JNIMethods.ARCHType.html | 394 +
javadoc/org/netlib/utils/JNIMethods.OSType.html | 378 +
javadoc/org/netlib/utils/JNIMethods.html | 402 +
.../utils/class-use/JNIMethods.ARCHType.html | 206 +
.../netlib/utils/class-use/JNIMethods.OSType.html | 206 +
javadoc/org/netlib/utils/class-use/JNIMethods.html | 145 +
javadoc/org/netlib/utils/package-frame.html | 46 +
javadoc/org/netlib/utils/package-summary.html | 177 +
javadoc/org/netlib/utils/package-tree.html | 164 +
javadoc/org/netlib/utils/package-use.html | 177 +
javadoc/overview-frame.html | 49 +
javadoc/overview-summary.html | 164 +
javadoc/overview-tree.html | 163 +
javadoc/package-list | 4 +
javadoc/resources/inherit.gif | Bin 0 -> 57 bytes
javadoc/stylesheet.css | 29 +
jni/Makefile | 44 +
jni/arpack.h | 99 +
jni/clapack.h | 5079 +
jni/configure | 136 +
jni/f2c.h | 223 +
jni/f2j_jni.c | 69 +
jni/f2j_jni.h | 25 +
jni/org_netlib_arpack_NativeARPACK.c | 469 +
jni/org_netlib_blas_NativeBLAS.c | 1154 +
jni/org_netlib_lapack_NativeLAPACK.c | 17512 +++
legacy/pom.xml | 37 -
legacy/src/main/java/org/netlib/arpack/ARPACK.java | 31 -
legacy/src/main/java/org/netlib/blas/BLAS.java | 31 -
legacy/src/main/java/org/netlib/lapack/LAPACK.java | 31 -
lib/nblibraries.properties | 8 +
manifest.mf | 3 +
native_ref/java/pom.xml | 92 -
native_ref/osx-x86_64/pom.xml | 95 -
native_ref/pom.xml | 230 -
native_ref/win-i686/pom.xml | 107 -
native_ref/win-x86_64/pom.xml | 106 -
native_ref/xbuilds/linux-armhf/pom.xml | 105 -
native_ref/xbuilds/linux-armhf/rpi | 567 -
native_ref/xbuilds/linux-i686/pom.xml | 100 -
native_ref/xbuilds/linux-x86_64/pom.xml | 87 -
native_ref/xbuilds/pom.xml | 28 -
native_system/java/pom.xml | 92 -
native_system/osx-x86_64/pom.xml | 99 -
native_system/pom.xml | 270 -
native_system/win-i686/pom.xml | 120 -
native_system/win-x86_64/pom.xml | 118 -
native_system/xbuilds/linux-armhf/pom.xml | 118 -
native_system/xbuilds/linux-i686/pom.xml | 118 -
native_system/xbuilds/linux-x86_64/pom.xml | 100 -
native_system/xbuilds/pom.xml | 28 -
nbproject/build-impl.xml | 1066 +
nbproject/genfiles.properties | 8 +
nbproject/private/private.properties | 1 +
nbproject/project.properties | 64 +
nbproject/project.xml | 19 +
netlib/ARPACK/arpack.h | 76 -
netlib/ARPACK/debug.h | 16 -
netlib/ARPACK/dgetv0.f | 419 -
netlib/ARPACK/dlaqrb.f | 521 -
netlib/ARPACK/dmout.f | 167 -
netlib/ARPACK/dnaitr.f | 840 -
netlib/ARPACK/dnapps.f | 647 -
netlib/ARPACK/dnaup2.f | 846 -
netlib/ARPACK/dnaupd.f | 693 -
netlib/ARPACK/dnconv.f | 146 -
netlib/ARPACK/dneigh.f | 314 -
netlib/ARPACK/dneupd.f | 1068 -
netlib/ARPACK/dngets.f | 231 -
netlib/ARPACK/dsaitr.f | 853 -
netlib/ARPACK/dsapps.f | 516 -
netlib/ARPACK/dsaup2.f | 850 -
netlib/ARPACK/dsaupd.f | 690 -
netlib/ARPACK/dsconv.f | 138 -
netlib/ARPACK/dseigt.f | 181 -
netlib/ARPACK/dsesrt.f | 217 -
netlib/ARPACK/dseupd.f | 867 -
netlib/ARPACK/dsgets.f | 219 -
netlib/ARPACK/dsortc.f | 344 -
netlib/ARPACK/dsortr.f | 218 -
netlib/ARPACK/dstatn.f | 61 -
netlib/ARPACK/dstats.f | 47 -
netlib/ARPACK/dstqrb.f | 594 -
netlib/ARPACK/dvout.f | 122 -
netlib/ARPACK/icnteq.f | 18 -
netlib/ARPACK/icopy.f | 77 -
netlib/ARPACK/iset.f | 16 -
netlib/ARPACK/iswap.f | 55 -
netlib/ARPACK/ivout.f | 120 -
netlib/ARPACK/second.f | 36 -
netlib/ARPACK/sgetv0.f | 419 -
netlib/ARPACK/slaqrb.f | 521 -
netlib/ARPACK/smout.f | 157 -
netlib/ARPACK/snaitr.f | 840 -
netlib/ARPACK/snapps.f | 647 -
netlib/ARPACK/snaup2.f | 847 -
netlib/ARPACK/snaupd.f | 693 -
netlib/ARPACK/snconv.f | 146 -
netlib/ARPACK/sneigh.f | 314 -
netlib/ARPACK/sneupd.f | 1067 -
netlib/ARPACK/sngets.f | 231 -
netlib/ARPACK/ssaitr.f | 853 -
netlib/ARPACK/ssapps.f | 516 -
netlib/ARPACK/ssaup2.f | 850 -
netlib/ARPACK/ssaupd.f | 690 -
netlib/ARPACK/ssconv.f | 138 -
netlib/ARPACK/sseigt.f | 181 -
netlib/ARPACK/ssesrt.f | 217 -
netlib/ARPACK/sseupd.f | 867 -
netlib/ARPACK/ssgets.f | 219 -
netlib/ARPACK/ssortc.f | 344 -
netlib/ARPACK/ssortr.f | 218 -
netlib/ARPACK/sstatn.f | 61 -
netlib/ARPACK/sstats.f | 47 -
netlib/ARPACK/sstqrb.f | 594 -
netlib/ARPACK/stat.h | 21 -
netlib/ARPACK/svout.f | 112 -
netlib/ARPACK/version.h | 30 -
netlib/BLAS/dasum.f | 66 -
netlib/BLAS/daxpy.f | 69 -
netlib/BLAS/dcabs1.f | 18 -
netlib/BLAS/dcopy.f | 70 -
netlib/BLAS/ddot.f | 72 -
netlib/BLAS/dgbmv.f | 302 -
netlib/BLAS/dgemm.f | 316 -
netlib/BLAS/dgemv.f | 265 -
netlib/BLAS/dger.f | 162 -
netlib/BLAS/dnrm2.f | 67 -
netlib/BLAS/drot.f | 55 -
netlib/BLAS/drotg.f | 44 -
netlib/BLAS/drotm.f | 142 -
netlib/BLAS/drotmg.f | 196 -
netlib/BLAS/dsbmv.f | 307 -
netlib/BLAS/dscal.f | 64 -
netlib/BLAS/dsdot.f | 98 -
netlib/BLAS/dspmv.f | 266 -
netlib/BLAS/dspr.f | 202 -
netlib/BLAS/dspr2.f | 233 -
netlib/BLAS/dswap.f | 77 -
netlib/BLAS/dsymm.f | 297 -
netlib/BLAS/dsymv.f | 266 -
netlib/BLAS/dsyr.f | 202 -
netlib/BLAS/dsyr2.f | 233 -
netlib/BLAS/dsyr2k.f | 329 -
netlib/BLAS/dsyrk.f | 298 -
netlib/BLAS/dtbmv.f | 336 -
netlib/BLAS/dtbsv.f | 339 -
netlib/BLAS/dtpmv.f | 294 -
netlib/BLAS/dtpsv.f | 296 -
netlib/BLAS/dtrmm.f | 349 -
netlib/BLAS/dtrmv.f | 282 -
netlib/BLAS/dtrsm.f | 376 -
netlib/BLAS/dtrsv.f | 282 -
netlib/BLAS/dzasum.f | 52 -
netlib/BLAS/dznrm2.f | 74 -
netlib/BLAS/icamax.f | 62 -
netlib/BLAS/idamax.f | 61 -
netlib/BLAS/isamax.f | 61 -
netlib/BLAS/izamax.f | 62 -
netlib/BLAS/lsame.f | 85 -
netlib/BLAS/sasum.f | 67 -
netlib/BLAS/saxpy.f | 69 -
netlib/BLAS/scabs1.f | 18 -
netlib/BLAS/scasum.f | 52 -
netlib/BLAS/scnrm2.f | 74 -
netlib/BLAS/scopy.f | 70 -
netlib/BLAS/sdot.f | 72 -
netlib/BLAS/sdsdot.f | 109 -
netlib/BLAS/sgbmv.f | 302 -
netlib/BLAS/sgemm.f | 316 -
netlib/BLAS/sgemv.f | 265 -
netlib/BLAS/sger.f | 162 -
netlib/BLAS/snrm2.f | 67 -
netlib/BLAS/srot.f | 55 -
netlib/BLAS/srotg.f | 44 -
netlib/BLAS/srotm.f | 143 -
netlib/BLAS/srotmg.f | 198 -
netlib/BLAS/ssbmv.f | 307 -
netlib/BLAS/sscal.f | 64 -
netlib/BLAS/sspmv.f | 266 -
netlib/BLAS/sspr.f | 202 -
netlib/BLAS/sspr2.f | 233 -
netlib/BLAS/sswap.f | 77 -
netlib/BLAS/ssymm.f | 297 -
netlib/BLAS/ssymv.f | 266 -
netlib/BLAS/ssyr.f | 202 -
netlib/BLAS/ssyr2.f | 233 -
netlib/BLAS/ssyr2k.f | 329 -
netlib/BLAS/ssyrk.f | 298 -
netlib/BLAS/stbmv.f | 336 -
netlib/BLAS/stbsv.f | 339 -
netlib/BLAS/stpmv.f | 294 -
netlib/BLAS/stpsv.f | 296 -
netlib/BLAS/strmm.f | 349 -
netlib/BLAS/strmv.f | 282 -
netlib/BLAS/strsm.f | 376 -
netlib/BLAS/strsv.f | 284 -
netlib/BLAS/xerbla.f | 48 -
netlib/CBLAS/cblas.h | 575 -
netlib/CBLAS/cblas_dasum.c | 23 -
netlib/CBLAS/cblas_daxpy.c | 22 -
netlib/CBLAS/cblas_dcopy.c | 22 -
netlib/CBLAS/cblas_ddot.c | 25 -
netlib/CBLAS/cblas_dgbmv.c | 81 -
netlib/CBLAS/cblas_dgemm.c | 109 -
netlib/CBLAS/cblas_dgemv.c | 78 -
netlib/CBLAS/cblas_dger.c | 47 -
netlib/CBLAS/cblas_dnrm2.c | 23 -
netlib/CBLAS/cblas_drot.c | 23 -
netlib/CBLAS/cblas_drotg.c | 14 -
netlib/CBLAS/cblas_drotm.c | 14 -
netlib/CBLAS/cblas_drotmg.c | 15 -
netlib/CBLAS/cblas_dsbmv.c | 77 -
netlib/CBLAS/cblas_dscal.c | 21 -
netlib/CBLAS/cblas_dsdot.c | 25 -
netlib/CBLAS/cblas_dspmv.c | 76 -
netlib/CBLAS/cblas_dspr.c | 70 -
netlib/CBLAS/cblas_dspr2.c | 70 -
netlib/CBLAS/cblas_dswap.c | 22 -
netlib/CBLAS/cblas_dsymm.c | 106 -
netlib/CBLAS/cblas_dsymv.c | 76 -
netlib/CBLAS/cblas_dsyr.c | 71 -
netlib/CBLAS/cblas_dsyr2.c | 76 -
netlib/CBLAS/cblas_dsyr2k.c | 109 -
netlib/CBLAS/cblas_dsyrk.c | 108 -
netlib/CBLAS/cblas_dtbmv.c | 122 -
netlib/CBLAS/cblas_dtbsv.c | 122 -
netlib/CBLAS/cblas_dtpmv.c | 117 -
netlib/CBLAS/cblas_dtpsv.c | 118 -
netlib/CBLAS/cblas_dtrmm.c | 148 -
netlib/CBLAS/cblas_dtrmv.c | 122 -
netlib/CBLAS/cblas_dtrsm.c | 153 -
netlib/CBLAS/cblas_dtrsv.c | 121 -
netlib/CBLAS/cblas_dzasum.c | 23 -
netlib/CBLAS/cblas_dznrm2.c | 23 -
netlib/CBLAS/cblas_f77.h | 701 -
netlib/CBLAS/cblas_globals.c | 2 -
netlib/CBLAS/cblas_icamax.c | 23 -
netlib/CBLAS/cblas_idamax.c | 23 -
netlib/CBLAS/cblas_isamax.c | 23 -
netlib/CBLAS/cblas_izamax.c | 23 -
netlib/CBLAS/cblas_sasum.c | 23 -
netlib/CBLAS/cblas_saxpy.c | 23 -
netlib/CBLAS/cblas_scasum.c | 23 -
netlib/CBLAS/cblas_scnrm2.c | 23 -
netlib/CBLAS/cblas_scopy.c | 22 -
netlib/CBLAS/cblas_sdot.c | 25 -
netlib/CBLAS/cblas_sdsdot.c | 25 -
netlib/CBLAS/cblas_sgbmv.c | 83 -
netlib/CBLAS/cblas_sgemm.c | 110 -
netlib/CBLAS/cblas_sgemv.c | 78 -
netlib/CBLAS/cblas_sger.c | 46 -
netlib/CBLAS/cblas_snrm2.c | 23 -
netlib/CBLAS/cblas_srot.c | 22 -
netlib/CBLAS/cblas_srotg.c | 14 -
netlib/CBLAS/cblas_srotm.c | 22 -
netlib/CBLAS/cblas_srotmg.c | 15 -
netlib/CBLAS/cblas_ssbmv.c | 76 -
netlib/CBLAS/cblas_sscal.c | 21 -
netlib/CBLAS/cblas_sspmv.c | 73 -
netlib/CBLAS/cblas_sspr.c | 72 -
netlib/CBLAS/cblas_sspr2.c | 71 -
netlib/CBLAS/cblas_sswap.c | 22 -
netlib/CBLAS/cblas_ssymm.c | 108 -
netlib/CBLAS/cblas_ssymv.c | 76 -
netlib/CBLAS/cblas_ssyr.c | 70 -
netlib/CBLAS/cblas_ssyr2.c | 76 -
netlib/CBLAS/cblas_ssyr2k.c | 111 -
netlib/CBLAS/cblas_ssyrk.c | 110 -
netlib/CBLAS/cblas_stbmv.c | 122 -
netlib/CBLAS/cblas_stbsv.c | 122 -
netlib/CBLAS/cblas_stpmv.c | 118 -
netlib/CBLAS/cblas_stpsv.c | 118 -
netlib/CBLAS/cblas_strmm.c | 148 -
netlib/CBLAS/cblas_strmv.c | 122 -
netlib/CBLAS/cblas_strsm.c | 143 -
netlib/CBLAS/cblas_strsv.c | 121 -
netlib/CBLAS/cblas_xerbla.c | 68 -
netlib/CBLAS/dasumsub.f | 15 -
netlib/CBLAS/ddotsub.f | 15 -
netlib/CBLAS/dnrm2sub.f | 15 -
netlib/CBLAS/dsdotsub.f | 15 -
netlib/CBLAS/dzasumsub.f | 15 -
netlib/CBLAS/dznrm2sub.f | 15 -
netlib/CBLAS/icamaxsub.f | 15 -
netlib/CBLAS/idamaxsub.f | 15 -
netlib/CBLAS/isamaxsub.f | 15 -
netlib/CBLAS/izamaxsub.f | 15 -
netlib/CBLAS/sasumsub.f | 15 -
netlib/CBLAS/scasumsub.f | 15 -
netlib/CBLAS/scnrm2sub.f | 15 -
netlib/CBLAS/sdotsub.f | 15 -
netlib/CBLAS/sdsdotsub.f | 15 -
netlib/CBLAS/snrm2sub.f | 15 -
netlib/JNI/netlib-jni.c | 95 -
netlib/JNI/netlib-jni.h | 27 -
netlib/LAPACK/VARIANTS/cholesky/RL/dpotrf.f | 242 -
netlib/LAPACK/VARIANTS/cholesky/RL/spotrf.f | 242 -
netlib/LAPACK/VARIANTS/cholesky/TOP/dpotrf.f | 238 -
netlib/LAPACK/VARIANTS/cholesky/TOP/spotrf.f | 237 -
netlib/LAPACK/VARIANTS/lu/CR/dgetrf.f | 223 -
netlib/LAPACK/VARIANTS/lu/CR/sgetrf.f | 223 -
netlib/LAPACK/VARIANTS/lu/LL/dgetrf.f | 247 -
netlib/LAPACK/VARIANTS/lu/LL/sgetrf.f | 248 -
netlib/LAPACK/VARIANTS/lu/REC/dgetrf.f | 277 -
netlib/LAPACK/VARIANTS/lu/REC/sgetrf.f | 277 -
netlib/LAPACK/VARIANTS/qr/LL/dgeqrf.f | 417 -
netlib/LAPACK/VARIANTS/qr/LL/sceil.f | 87 -
netlib/LAPACK/VARIANTS/qr/LL/sgeqrf.f | 416 -
netlib/LAPACK/chla_transtype.f | 91 -
netlib/LAPACK/dbbcsd.f | 1077 -
netlib/LAPACK/dbdsdc.f | 521 -
netlib/LAPACK/dbdsqr.f | 850 -
netlib/LAPACK/ddisna.f | 245 -
netlib/LAPACK/dgbbrd.f | 547 -
netlib/LAPACK/dgbcon.f | 311 -
netlib/LAPACK/dgbequ.f | 324 -
netlib/LAPACK/dgbequb.f | 340 -
netlib/LAPACK/dgbrfs.f | 464 -
netlib/LAPACK/dgbsv.f | 223 -
netlib/LAPACK/dgbsvx.f | 642 -
netlib/LAPACK/dgbtf2.f | 277 -
netlib/LAPACK/dgbtrf.f | 516 -
netlib/LAPACK/dgbtrs.f | 269 -
netlib/LAPACK/dgebak.f | 268 -
netlib/LAPACK/dgebal.f | 405 -
netlib/LAPACK/dgebd2.f | 320 -
netlib/LAPACK/dgebrd.f | 353 -
netlib/LAPACK/dgecon.f | 261 -
netlib/LAPACK/dgeequ.f | 304 -
netlib/LAPACK/dgeequb.f | 321 -
netlib/LAPACK/dgees.f | 535 -
netlib/LAPACK/dgeesx.f | 649 -
netlib/LAPACK/dgeev.f | 516 -
netlib/LAPACK/dgeevx.f | 681 -
netlib/LAPACK/dgegs.f | 541 -
netlib/LAPACK/dgegv.f | 769 -
netlib/LAPACK/dgehd2.f | 225 -
netlib/LAPACK/dgehrd.f | 352 -
netlib/LAPACK/dgejsv.f | 1777 -
netlib/LAPACK/dgelq2.f | 192 -
netlib/LAPACK/dgelqf.f | 269 -
netlib/LAPACK/dgels.f | 504 -
netlib/LAPACK/dgelsd.f | 629 -
netlib/LAPACK/dgelss.f | 747 -
netlib/LAPACK/dgelsx.f | 435 -
netlib/LAPACK/dgelsy.f | 479 -
netlib/LAPACK/dgemqrt.f | 291 -
netlib/LAPACK/dgeql2.f | 193 -
netlib/LAPACK/dgeqlf.f | 287 -
netlib/LAPACK/dgeqp3.f | 367 -
netlib/LAPACK/dgeqpf.f | 306 -
netlib/LAPACK/dgeqr2.f | 192 -
netlib/LAPACK/dgeqr2p.f | 192 -
netlib/LAPACK/dgeqrf.f | 270 -
netlib/LAPACK/dgeqrfp.f | 270 -
netlib/LAPACK/dgeqrt.f | 218 -
netlib/LAPACK/dgeqrt2.f | 227 -
netlib/LAPACK/dgeqrt3.f | 257 -
netlib/LAPACK/dgerfs.f | 438 -
netlib/LAPACK/dgerq2.f | 193 -
netlib/LAPACK/dgerqf.f | 287 -
netlib/LAPACK/dgesc2.f | 201 -
netlib/LAPACK/dgesdd.f | 1431 -
netlib/LAPACK/dgesv.f | 179 -
netlib/LAPACK/dgesvd.f | 3493 -
netlib/LAPACK/dgesvj.f | 1613 -
netlib/LAPACK/dgesvx.f | 602 -
netlib/LAPACK/dgetc2.f | 211 -
netlib/LAPACK/dgetf2.f | 213 -
netlib/LAPACK/dgetrf.f | 225 -
netlib/LAPACK/dgetri.f | 261 -
netlib/LAPACK/dgetrs.f | 225 -
netlib/LAPACK/dggbak.f | 306 -
netlib/LAPACK/dggbal.f | 559 -
netlib/LAPACK/dgges.f | 682 -
netlib/LAPACK/dggesx.f | 820 -
netlib/LAPACK/dggev.f | 592 -
netlib/LAPACK/dggevx.f | 868 -
netlib/LAPACK/dggglm.f | 348 -
netlib/LAPACK/dgghrd.f | 361 -
netlib/LAPACK/dgglse.f | 354 -
netlib/LAPACK/dggqrf.f | 299 -
netlib/LAPACK/dggrqf.f | 299 -
netlib/LAPACK/dggsvd.f | 462 -
netlib/LAPACK/dggsvp.f | 520 -
netlib/LAPACK/dgsvj0.f | 1078 -
netlib/LAPACK/dgsvj1.f | 783 -
netlib/LAPACK/dgtcon.f | 255 -
netlib/LAPACK/dgtrfs.f | 474 -
netlib/LAPACK/dgtsv.f | 333 -
netlib/LAPACK/dgtsvx.f | 414 -
netlib/LAPACK/dgttrf.f | 237 -
netlib/LAPACK/dgttrs.f | 223 -
netlib/LAPACK/dgtts2.f | 274 -
netlib/LAPACK/dhgeqz.f | 1357 -
netlib/LAPACK/dhsein.f | 526 -
netlib/LAPACK/dhseqr.f | 516 -
netlib/LAPACK/disnan.f | 80 -
netlib/LAPACK/dla_gbamv.f | 411 -
netlib/LAPACK/dla_gbrcond.f | 353 -
netlib/LAPACK/dla_gbrpvgrw.f | 160 -
netlib/LAPACK/dla_geamv.f | 396 -
netlib/LAPACK/dla_gercond.f | 329 -
netlib/LAPACK/dla_gerpvgrw.f | 142 -
netlib/LAPACK/dla_lin_berr.f | 153 -
netlib/LAPACK/dla_porcond.f | 329 -
netlib/LAPACK/dla_porpvgrw.f | 210 -
netlib/LAPACK/dla_syamv.f | 417 -
netlib/LAPACK/dla_syrcond.f | 342 -
netlib/LAPACK/dla_syrpvgrw.f | 320 -
netlib/LAPACK/dla_wwaddw.f | 111 -
netlib/LAPACK/dlabad.f | 105 -
netlib/LAPACK/dlabrd.f | 381 -
netlib/LAPACK/dlacn2.f | 294 -
netlib/LAPACK/dlacon.f | 275 -
netlib/LAPACK/dlacpy.f | 156 -
netlib/LAPACK/dladiv.f | 128 -
netlib/LAPACK/dlae2.f | 185 -
netlib/LAPACK/dlaebz.f | 649 -
netlib/LAPACK/dlaed0.f | 434 -
netlib/LAPACK/dlaed1.f | 274 -
netlib/LAPACK/dlaed2.f | 539 -
netlib/LAPACK/dlaed3.f | 353 -
netlib/LAPACK/dlaed4.f | 917 -
netlib/LAPACK/dlaed5.f | 189 -
netlib/LAPACK/dlaed6.f | 409 -
netlib/LAPACK/dlaed7.f | 407 -
netlib/LAPACK/dlaed8.f | 524 -
netlib/LAPACK/dlaed9.f | 294 -
netlib/LAPACK/dlaeda.f | 308 -
netlib/LAPACK/dlaein.f | 632 -
netlib/LAPACK/dlaev2.f | 238 -
netlib/LAPACK/dlaexc.f | 436 -
netlib/LAPACK/dlag2.f | 379 -
netlib/LAPACK/dlag2s.f | 152 -
netlib/LAPACK/dlagge.f | 357 -
netlib/LAPACK/dlags2.f | 362 -
netlib/LAPACK/dlagsy.f | 261 -
netlib/LAPACK/dlagtf.f | 266 -
netlib/LAPACK/dlagtm.f | 278 -
netlib/LAPACK/dlagts.f | 383 -
netlib/LAPACK/dlagv2.f | 374 -
netlib/LAPACK/dlahilb.f | 225 -
netlib/LAPACK/dlahqr.f | 611 -
netlib/LAPACK/dlahr2.f | 326 -
netlib/LAPACK/dlahrd.f | 288 -
netlib/LAPACK/dlaic1.f | 367 -
netlib/LAPACK/dlaisnan.f | 91 -
netlib/LAPACK/dlakf2.f | 191 -
netlib/LAPACK/dlaln2.f | 611 -
netlib/LAPACK/dlals0.f | 502 -
netlib/LAPACK/dlalsa.f | 495 -
netlib/LAPACK/dlalsd.f | 523 -
netlib/LAPACK/dlamch.f | 189 -
netlib/LAPACK/dlamrg.f | 171 -
netlib/LAPACK/dlaneg.f | 227 -
netlib/LAPACK/dlangb.f | 225 -
netlib/LAPACK/dlange.f | 211 -
netlib/LAPACK/dlangt.f | 208 -
netlib/LAPACK/dlanhs.f | 205 -
netlib/LAPACK/dlansb.f | 258 -
netlib/LAPACK/dlansf.f | 963 -
netlib/LAPACK/dlansp.f | 261 -
netlib/LAPACK/dlanst.f | 186 -
netlib/LAPACK/dlansy.f | 241 -
netlib/LAPACK/dlantb.f | 361 -
netlib/LAPACK/dlantp.f | 355 -
netlib/LAPACK/dlantr.f | 353 -
netlib/LAPACK/dlanv2.f | 289 -
netlib/LAPACK/dlapll.f | 165 -
netlib/LAPACK/dlapmr.f | 204 -
netlib/LAPACK/dlapmt.f | 203 -
netlib/LAPACK/dlapy2.f | 104 -
netlib/LAPACK/dlapy3.f | 111 -
netlib/LAPACK/dlaqgb.f | 256 -
netlib/LAPACK/dlaqge.f | 236 -
netlib/LAPACK/dlaqp2.f | 262 -
netlib/LAPACK/dlaqps.f | 358 -
netlib/LAPACK/dlaqr0.f | 740 -
netlib/LAPACK/dlaqr1.f | 179 -
netlib/LAPACK/dlaqr2.f | 684 -
netlib/LAPACK/dlaqr3.f | 695 -
netlib/LAPACK/dlaqr4.f | 739 -
netlib/LAPACK/dlaqr5.f | 921 -
netlib/LAPACK/dlaqsb.f | 226 -
netlib/LAPACK/dlaqsp.f | 212 -
netlib/LAPACK/dlaqsy.f | 216 -
netlib/LAPACK/dlaqtr.f | 748 -
netlib/LAPACK/dlar1v.f | 486 -
netlib/LAPACK/dlar2v.f | 157 -
netlib/LAPACK/dlaran.f | 146 -
netlib/LAPACK/dlarf.f | 227 -
netlib/LAPACK/dlarfb.f | 758 -
netlib/LAPACK/dlarfg.f | 196 -
netlib/LAPACK/dlarfgp.f | 242 -
netlib/LAPACK/dlarft.f | 326 -
netlib/LAPACK/dlarfx.f | 697 -
netlib/LAPACK/dlarge.f | 174 -
netlib/LAPACK/dlargv.f | 167 -
netlib/LAPACK/dlarnd.f | 133 -
netlib/LAPACK/dlarnv.f | 178 -
netlib/LAPACK/dlaror.f | 304 -
netlib/LAPACK/dlarot.f | 317 -
netlib/LAPACK/dlarra.f | 204 -
netlib/LAPACK/dlarrb.f | 401 -
netlib/LAPACK/dlarrc.f | 243 -
netlib/LAPACK/dlarrd.f | 855 -
netlib/LAPACK/dlarre.f | 891 -
netlib/LAPACK/dlarrf.f | 487 -
netlib/LAPACK/dlarrj.f | 373 -
netlib/LAPACK/dlarrk.f | 249 -
netlib/LAPACK/dlarrr.f | 204 -
netlib/LAPACK/dlarrv.f | 1028 -
netlib/LAPACK/dlarscl2.f | 119 -
netlib/LAPACK/dlartg.f | 204 -
netlib/LAPACK/dlartgp.f | 202 -
netlib/LAPACK/dlartgs.f | 158 -
netlib/LAPACK/dlartv.f | 147 -
netlib/LAPACK/dlaruv.f | 446 -
netlib/LAPACK/dlarz.f | 236 -
netlib/LAPACK/dlarzb.f | 323 -
netlib/LAPACK/dlarzt.f | 264 -
netlib/LAPACK/dlas2.f | 183 -
netlib/LAPACK/dlascl.f | 364 -
netlib/LAPACK/dlascl2.f | 119 -
netlib/LAPACK/dlasd0.f | 315 -
netlib/LAPACK/dlasd1.f | 323 -
netlib/LAPACK/dlasd2.f | 634 -
netlib/LAPACK/dlasd3.f | 470 -
netlib/LAPACK/dlasd4.f | 1057 -
netlib/LAPACK/dlasd5.f | 231 -
netlib/LAPACK/dlasd6.f | 445 -
netlib/LAPACK/dlasd7.f | 580 -
netlib/LAPACK/dlasd8.f | 343 -
netlib/LAPACK/dlasda.f | 515 -
netlib/LAPACK/dlasdq.f | 413 -
netlib/LAPACK/dlasdt.f | 172 -
netlib/LAPACK/dlaset.f | 184 -
netlib/LAPACK/dlasq1.f | 224 -
netlib/LAPACK/dlasq2.f | 582 -
netlib/LAPACK/dlasq3.f | 421 -
netlib/LAPACK/dlasq4.f | 425 -
netlib/LAPACK/dlasq5.f | 410 -
netlib/LAPACK/dlasq6.f | 254 -
netlib/LAPACK/dlasr.f | 436 -
netlib/LAPACK/dlasrt.f | 303 -
netlib/LAPACK/dlassq.f | 155 -
netlib/LAPACK/dlasv2.f | 325 -
netlib/LAPACK/dlaswp.f | 191 -
netlib/LAPACK/dlasy2.f | 480 -
netlib/LAPACK/dlasyf.f | 666 -
netlib/LAPACK/dlat2s.f | 173 -
netlib/LAPACK/dlatbs.f | 812 -
netlib/LAPACK/dlatdf.f | 323 -
netlib/LAPACK/dlatm1.f | 299 -
netlib/LAPACK/dlatm2.f | 315 -
netlib/LAPACK/dlatm3.f | 335 -
netlib/LAPACK/dlatm5.f | 501 -
netlib/LAPACK/dlatm6.f | 333 -
netlib/LAPACK/dlatm7.f | 297 -
netlib/LAPACK/dlatme.f | 710 -
netlib/LAPACK/dlatmr.f | 1227 -
netlib/LAPACK/dlatms.f | 1128 -
netlib/LAPACK/dlatmt.f | 1139 -
netlib/LAPACK/dlatps.f | 795 -
netlib/LAPACK/dlatrd.f | 336 -
netlib/LAPACK/dlatrs.f | 787 -
netlib/LAPACK/dlatrz.f | 200 -
netlib/LAPACK/dlatzm.f | 221 -
netlib/LAPACK/dlauu2.f | 198 -
netlib/LAPACK/dlauum.f | 218 -
netlib/LAPACK/dopgtr.f | 232 -
netlib/LAPACK/dopmtr.f | 339 -
netlib/LAPACK/dorbdb.f | 607 -
netlib/LAPACK/dorcsd.f | 598 -
netlib/LAPACK/dorg2l.f | 198 -
netlib/LAPACK/dorg2r.f | 200 -
netlib/LAPACK/dorgbr.f | 338 -
netlib/LAPACK/dorghr.f | 240 -
netlib/LAPACK/dorgl2.f | 204 -
netlib/LAPACK/dorglq.f | 289 -
netlib/LAPACK/dorgql.f | 296 -
netlib/LAPACK/dorgqr.f | 290 -
netlib/LAPACK/dorgr2.f | 202 -
netlib/LAPACK/dorgrq.f | 296 -
netlib/LAPACK/dorgtr.f | 255 -
netlib/LAPACK/dorm2l.f | 278 -
netlib/LAPACK/dorm2r.f | 282 -
netlib/LAPACK/dormbr.f | 372 -
netlib/LAPACK/dormhr.f | 294 -
netlib/LAPACK/dorml2.f | 282 -
netlib/LAPACK/dormlq.f | 354 -
netlib/LAPACK/dormql.f | 348 -
netlib/LAPACK/dormqr.f | 347 -
netlib/LAPACK/dormr2.f | 278 -
netlib/LAPACK/dormr3.f | 299 -
netlib/LAPACK/dormrq.f | 355 -
netlib/LAPACK/dormrz.f | 389 -
netlib/LAPACK/dormtr.f | 310 -
netlib/LAPACK/dpbcon.f | 271 -
netlib/LAPACK/dpbequ.f | 242 -
netlib/LAPACK/dpbrfs.f | 443 -
netlib/LAPACK/dpbstf.f | 319 -
netlib/LAPACK/dpbsv.f | 229 -
netlib/LAPACK/dpbsvx.f | 545 -
netlib/LAPACK/dpbtf2.f | 263 -
netlib/LAPACK/dpbtrf.f | 435 -
netlib/LAPACK/dpbtrs.f | 220 -
netlib/LAPACK/dpftrf.f | 457 -
netlib/LAPACK/dpftri.f | 423 -
netlib/LAPACK/dpftrs.f | 280 -
netlib/LAPACK/dpocon.f | 253 -
netlib/LAPACK/dpoequ.f | 205 -
netlib/LAPACK/dpoequb.f | 215 -
netlib/LAPACK/dporfs.f | 430 -
netlib/LAPACK/dposv.f | 193 -
netlib/LAPACK/dposvx.f | 494 -
netlib/LAPACK/dpotf2.f | 230 -
netlib/LAPACK/dpotrf.f | 246 -
netlib/LAPACK/dpotri.f | 159 -
netlib/LAPACK/dpotrs.f | 204 -
netlib/LAPACK/dppcon.f | 248 -
netlib/LAPACK/dppequ.f | 238 -
netlib/LAPACK/dpprfs.f | 421 -
netlib/LAPACK/dppsv.f | 205 -
netlib/LAPACK/dppsvx.f | 494 -
netlib/LAPACK/dpptrf.f | 240 -
netlib/LAPACK/dpptri.f | 188 -
netlib/LAPACK/dpptrs.f | 203 -
netlib/LAPACK/dpstf2.f | 385 -
netlib/LAPACK/dpstrf.f | 443 -
netlib/LAPACK/dptcon.f | 221 -
netlib/LAPACK/dpteqr.f | 261 -
netlib/LAPACK/dptrfs.f | 395 -
netlib/LAPACK/dptsv.f | 167 -
netlib/LAPACK/dptsvx.f | 336 -
netlib/LAPACK/dpttrf.f | 211 -
netlib/LAPACK/dpttrs.f | 182 -
netlib/LAPACK/dptts2.f | 158 -
netlib/LAPACK/drscl.f | 174 -
netlib/LAPACK/dsbev.f | 287 -
netlib/LAPACK/dsbevd.f | 360 -
netlib/LAPACK/dsbevx.f | 536 -
netlib/LAPACK/dsbgst.f | 1434 -
netlib/LAPACK/dsbgv.f | 280 -
netlib/LAPACK/dsbgvd.f | 372 -
netlib/LAPACK/dsbgvx.f | 513 -
netlib/LAPACK/dsbtrd.f | 641 -
netlib/LAPACK/dsfrk.f | 544 -
netlib/LAPACK/dsgesv.f | 433 -
netlib/LAPACK/dspcon.f | 238 -
netlib/LAPACK/dspev.f | 262 -
netlib/LAPACK/dspevd.f | 338 -
netlib/LAPACK/dspevx.f | 489 -
netlib/LAPACK/dspgst.f | 274 -
netlib/LAPACK/dspgv.f | 278 -
netlib/LAPACK/dspgvd.f | 364 -
netlib/LAPACK/dspgvx.f | 408 -
netlib/LAPACK/dsposv.f | 439 -
netlib/LAPACK/dsprfs.f | 431 -
netlib/LAPACK/dspsv.f | 224 -
netlib/LAPACK/dspsvx.f | 386 -
netlib/LAPACK/dsptrd.f | 300 -
netlib/LAPACK/dsptrf.f | 616 -
netlib/LAPACK/dsptri.f | 401 -
netlib/LAPACK/dsptrs.f | 450 -
netlib/LAPACK/dstebz.f | 761 -
netlib/LAPACK/dstedc.f | 489 -
netlib/LAPACK/dstegr.f | 293 -
netlib/LAPACK/dstein.f | 452 -
netlib/LAPACK/dstemr.f | 767 -
netlib/LAPACK/dsteqr.f | 572 -
netlib/LAPACK/dsterf.f | 426 -
netlib/LAPACK/dstev.f | 235 -
netlib/LAPACK/dstevd.f | 302 -
netlib/LAPACK/dstevr.f | 575 -
netlib/LAPACK/dstevx.f | 457 -
netlib/LAPACK/dsycon.f | 244 -
netlib/LAPACK/dsyconv.f | 362 -
netlib/LAPACK/dsyequb.f | 342 -
netlib/LAPACK/dsyev.f | 286 -
netlib/LAPACK/dsyevd.f | 357 -
netlib/LAPACK/dsyevr.f | 672 -
netlib/LAPACK/dsyevx.f | 547 -
netlib/LAPACK/dsygs2.f | 283 -
netlib/LAPACK/dsygst.f | 321 -
netlib/LAPACK/dsygv.f | 314 -
netlib/LAPACK/dsygvd.f | 380 -
netlib/LAPACK/dsygvx.f | 458 -
netlib/LAPACK/dsyrfs.f | 441 -
netlib/LAPACK/dsysv.f | 270 -
netlib/LAPACK/dsysvx.f | 416 -
netlib/LAPACK/dsyswapr.f | 193 -
netlib/LAPACK/dsytd2.f | 323 -
netlib/LAPACK/dsytf2.f | 597 -
netlib/LAPACK/dsytrd.f | 376 -
netlib/LAPACK/dsytrf.f | 363 -
netlib/LAPACK/dsytri.f | 382 -
netlib/LAPACK/dsytri2.f | 205 -
netlib/LAPACK/dsytri2x.f | 591 -
netlib/LAPACK/dsytrs.f | 445 -
netlib/LAPACK/dsytrs2.f | 356 -
netlib/LAPACK/dtbcon.f | 284 -
netlib/LAPACK/dtbrfs.f | 485 -
netlib/LAPACK/dtbtrs.f | 244 -
netlib/LAPACK/dtfsm.f | 1006 -
netlib/LAPACK/dtftri.f | 472 -
netlib/LAPACK/dtfttp.f | 517 -
netlib/LAPACK/dtfttr.f | 495 -
netlib/LAPACK/dtgevc.f | 1211 -
netlib/LAPACK/dtgex2.f | 699 -
netlib/LAPACK/dtgexc.f | 544 -
netlib/LAPACK/dtgsen.f | 864 -
netlib/LAPACK/dtgsja.f | 655 -
netlib/LAPACK/dtgsna.f | 700 -
netlib/LAPACK/dtgsy2.f | 1075 -
netlib/LAPACK/dtgsyl.f | 682 -
netlib/LAPACK/dtpcon.f | 267 -
netlib/LAPACK/dtpmqrt.f | 366 -
netlib/LAPACK/dtpqrt.f | 270 -
netlib/LAPACK/dtpqrt2.f | 302 -
netlib/LAPACK/dtprfb.f | 811 -
netlib/LAPACK/dtprfs.f | 473 -
netlib/LAPACK/dtptri.f | 241 -
netlib/LAPACK/dtptrs.f | 228 -
netlib/LAPACK/dtpttf.f | 502 -
netlib/LAPACK/dtpttr.f | 176 -
netlib/LAPACK/dtrcon.f | 276 -
netlib/LAPACK/dtrevc.f | 1076 -
netlib/LAPACK/dtrexc.f | 426 -
netlib/LAPACK/dtrrfs.f | 472 -
netlib/LAPACK/dtrsen.f | 570 -
netlib/LAPACK/dtrsna.f | 603 -
netlib/LAPACK/dtrsyl.f | 1002 -
netlib/LAPACK/dtrti2.f | 212 -
netlib/LAPACK/dtrtri.f | 242 -
netlib/LAPACK/dtrtrs.f | 226 -
netlib/LAPACK/dtrttf.f | 492 -
netlib/LAPACK/dtrttp.f | 176 -
netlib/LAPACK/dtzrqf.f | 232 -
netlib/LAPACK/dtzrzf.f | 313 -
netlib/LAPACK/dzsum1.f | 140 -
netlib/LAPACK/icmax1.f | 154 -
netlib/LAPACK/ieeeck.f | 203 -
netlib/LAPACK/ilaclc.f | 118 -
netlib/LAPACK/ilaclr.f | 121 -
netlib/LAPACK/iladiag.f | 92 -
netlib/LAPACK/iladlc.f | 118 -
netlib/LAPACK/iladlr.f | 121 -
netlib/LAPACK/ilaenv.f | 624 -
netlib/LAPACK/ilaprec.f | 98 -
netlib/LAPACK/ilaslc.f | 118 -
netlib/LAPACK/ilaslr.f | 121 -
netlib/LAPACK/ilatrans.f | 95 -
netlib/LAPACK/ilauplo.f | 92 -
netlib/LAPACK/ilaver.f | 66 -
netlib/LAPACK/ilazlc.f | 118 -
netlib/LAPACK/ilazlr.f | 121 -
netlib/LAPACK/iparmq.f | 322 -
netlib/LAPACK/izmax1.f | 154 -
netlib/LAPACK/lsamen.f | 122 -
netlib/LAPACK/sbbcsd.f | 1077 -
netlib/LAPACK/sbdsdc.f | 521 -
netlib/LAPACK/sbdsqr.f | 850 -
netlib/LAPACK/scsum1.f | 140 -
netlib/LAPACK/sdisna.f | 245 -
netlib/LAPACK/sgbbrd.f | 547 -
netlib/LAPACK/sgbcon.f | 311 -
netlib/LAPACK/sgbequ.f | 324 -
netlib/LAPACK/sgbequb.f | 340 -
netlib/LAPACK/sgbrfs.f | 464 -
netlib/LAPACK/sgbsv.f | 223 -
netlib/LAPACK/sgbsvx.f | 644 -
netlib/LAPACK/sgbtf2.f | 277 -
netlib/LAPACK/sgbtrf.f | 516 -
netlib/LAPACK/sgbtrs.f | 269 -
netlib/LAPACK/sgebak.f | 268 -
netlib/LAPACK/sgebal.f | 405 -
netlib/LAPACK/sgebd2.f | 320 -
netlib/LAPACK/sgebrd.f | 353 -
netlib/LAPACK/sgecon.f | 261 -
netlib/LAPACK/sgeequ.f | 304 -
netlib/LAPACK/sgeequb.f | 321 -
netlib/LAPACK/sgees.f | 535 -
netlib/LAPACK/sgeesx.f | 649 -
netlib/LAPACK/sgeev.f | 516 -
netlib/LAPACK/sgeevx.f | 680 -
netlib/LAPACK/sgegs.f | 541 -
netlib/LAPACK/sgegv.f | 769 -
netlib/LAPACK/sgehd2.f | 225 -
netlib/LAPACK/sgehrd.f | 352 -
netlib/LAPACK/sgejsv.f | 1777 -
netlib/LAPACK/sgelq2.f | 192 -
netlib/LAPACK/sgelqf.f | 269 -
netlib/LAPACK/sgels.f | 504 -
netlib/LAPACK/sgelsd.f | 633 -
netlib/LAPACK/sgelss.f | 743 -
netlib/LAPACK/sgelsx.f | 435 -
netlib/LAPACK/sgelsy.f | 479 -
netlib/LAPACK/sgemqrt.f | 291 -
netlib/LAPACK/sgeql2.f | 193 -
netlib/LAPACK/sgeqlf.f | 287 -
netlib/LAPACK/sgeqp3.f | 364 -
netlib/LAPACK/sgeqpf.f | 306 -
netlib/LAPACK/sgeqr2.f | 192 -
netlib/LAPACK/sgeqr2p.f | 192 -
netlib/LAPACK/sgeqrf.f | 270 -
netlib/LAPACK/sgeqrfp.f | 270 -
netlib/LAPACK/sgeqrt.f | 218 -
netlib/LAPACK/sgeqrt2.f | 227 -
netlib/LAPACK/sgeqrt3.f | 257 -
netlib/LAPACK/sgerfs.f | 438 -
netlib/LAPACK/sgerq2.f | 193 -
netlib/LAPACK/sgerqf.f | 290 -
netlib/LAPACK/sgesc2.f | 201 -
netlib/LAPACK/sgesdd.f | 1431 -
netlib/LAPACK/sgesv.f | 179 -
netlib/LAPACK/sgesvd.f | 3494 -
netlib/LAPACK/sgesvj.f | 1599 -
netlib/LAPACK/sgesvx.f | 602 -
netlib/LAPACK/sgetc2.f | 211 -
netlib/LAPACK/sgetf2.f | 213 -
netlib/LAPACK/sgetrf.f | 225 -
netlib/LAPACK/sgetri.f | 261 -
netlib/LAPACK/sgetrs.f | 225 -
netlib/LAPACK/sggbak.f | 306 -
netlib/LAPACK/sggbal.f | 559 -
netlib/LAPACK/sgges.f | 680 -
netlib/LAPACK/sggesx.f | 820 -
netlib/LAPACK/sggev.f | 592 -
netlib/LAPACK/sggevx.f | 866 -
netlib/LAPACK/sggglm.f | 348 -
netlib/LAPACK/sgghrd.f | 361 -
netlib/LAPACK/sgglse.f | 354 -
netlib/LAPACK/sggqrf.f | 299 -
netlib/LAPACK/sggrqf.f | 299 -
netlib/LAPACK/sggsvd.f | 462 -
netlib/LAPACK/sggsvp.f | 520 -
netlib/LAPACK/sgsvj0.f | 1078 -
netlib/LAPACK/sgsvj1.f | 783 -
netlib/LAPACK/sgtcon.f | 255 -
netlib/LAPACK/sgtrfs.f | 474 -
netlib/LAPACK/sgtsv.f | 333 -
netlib/LAPACK/sgtsvx.f | 414 -
netlib/LAPACK/sgttrf.f | 237 -
netlib/LAPACK/sgttrs.f | 223 -
netlib/LAPACK/sgtts2.f | 274 -
netlib/LAPACK/shgeqz.f | 1357 -
netlib/LAPACK/shsein.f | 526 -
netlib/LAPACK/shseqr.f | 516 -
netlib/LAPACK/sisnan.f | 80 -
netlib/LAPACK/sla_gbamv.f | 410 -
netlib/LAPACK/sla_gbrcond.f | 351 -
netlib/LAPACK/sla_gbrpvgrw.f | 160 -
netlib/LAPACK/sla_geamv.f | 396 -
netlib/LAPACK/sla_gercond.f | 327 -
netlib/LAPACK/sla_gerpvgrw.f | 139 -
netlib/LAPACK/sla_lin_berr.f | 153 -
netlib/LAPACK/sla_porcond.f | 327 -
netlib/LAPACK/sla_porpvgrw.f | 208 -
netlib/LAPACK/sla_syamv.f | 417 -
netlib/LAPACK/sla_syrcond.f | 340 -
netlib/LAPACK/sla_syrpvgrw.f | 320 -
netlib/LAPACK/sla_wwaddw.f | 111 -
netlib/LAPACK/slabad.f | 105 -
netlib/LAPACK/slabrd.f | 381 -
netlib/LAPACK/slacn2.f | 294 -
netlib/LAPACK/slacon.f | 275 -
netlib/LAPACK/slacpy.f | 156 -
netlib/LAPACK/sladiv.f | 128 -
netlib/LAPACK/slae2.f | 185 -
netlib/LAPACK/slaebz.f | 649 -
netlib/LAPACK/slaed0.f | 434 -
netlib/LAPACK/slaed1.f | 274 -
netlib/LAPACK/slaed2.f | 539 -
netlib/LAPACK/slaed3.f | 353 -
netlib/LAPACK/slaed4.f | 917 -
netlib/LAPACK/slaed5.f | 189 -
netlib/LAPACK/slaed6.f | 409 -
netlib/LAPACK/slaed7.f | 407 -
netlib/LAPACK/slaed8.f | 524 -
netlib/LAPACK/slaed9.f | 294 -
netlib/LAPACK/slaeda.f | 308 -
netlib/LAPACK/slaein.f | 632 -
netlib/LAPACK/slaev2.f | 238 -
netlib/LAPACK/slaexc.f | 435 -
netlib/LAPACK/slag2.f | 379 -
netlib/LAPACK/slag2d.f | 137 -
netlib/LAPACK/slagge.f | 357 -
netlib/LAPACK/slags2.f | 362 -
netlib/LAPACK/slagsy.f | 261 -
netlib/LAPACK/slagtf.f | 266 -
netlib/LAPACK/slagtm.f | 278 -
netlib/LAPACK/slagts.f | 383 -
netlib/LAPACK/slagv2.f | 374 -
netlib/LAPACK/slahilb.f | 223 -
netlib/LAPACK/slahqr.f | 611 -
netlib/LAPACK/slahr2.f | 326 -
netlib/LAPACK/slahrd.f | 288 -
netlib/LAPACK/slaic1.f | 367 -
netlib/LAPACK/slaisnan.f | 91 -
netlib/LAPACK/slakf2.f | 191 -
netlib/LAPACK/slaln2.f | 611 -
netlib/LAPACK/slals0.f | 502 -
netlib/LAPACK/slalsa.f | 495 -
netlib/LAPACK/slalsd.f | 523 -
netlib/LAPACK/slamch.f | 192 -
netlib/LAPACK/slamrg.f | 171 -
netlib/LAPACK/slaneg.f | 227 -
netlib/LAPACK/slangb.f | 225 -
netlib/LAPACK/slange.f | 211 -
netlib/LAPACK/slangt.f | 208 -
netlib/LAPACK/slanhs.f | 205 -
netlib/LAPACK/slansb.f | 258 -
netlib/LAPACK/slansf.f | 964 -
netlib/LAPACK/slansp.f | 261 -
netlib/LAPACK/slanst.f | 186 -
netlib/LAPACK/slansy.f | 241 -
netlib/LAPACK/slantb.f | 361 -
netlib/LAPACK/slantp.f | 355 -
netlib/LAPACK/slantr.f | 353 -
netlib/LAPACK/slanv2.f | 289 -
netlib/LAPACK/slapll.f | 165 -
netlib/LAPACK/slapmr.f | 204 -
netlib/LAPACK/slapmt.f | 203 -
netlib/LAPACK/slapy2.f | 104 -
netlib/LAPACK/slapy3.f | 111 -
netlib/LAPACK/slaqgb.f | 256 -
netlib/LAPACK/slaqge.f | 236 -
netlib/LAPACK/slaqp2.f | 262 -
netlib/LAPACK/slaqps.f | 359 -
netlib/LAPACK/slaqr0.f | 739 -
netlib/LAPACK/slaqr1.f | 179 -
netlib/LAPACK/slaqr2.f | 684 -
netlib/LAPACK/slaqr3.f | 695 -
netlib/LAPACK/slaqr4.f | 742 -
netlib/LAPACK/slaqr5.f | 921 -
netlib/LAPACK/slaqsb.f | 226 -
netlib/LAPACK/slaqsp.f | 212 -
netlib/LAPACK/slaqsy.f | 216 -
netlib/LAPACK/slaqtr.f | 748 -
netlib/LAPACK/slar1v.f | 486 -
netlib/LAPACK/slar2v.f | 157 -
netlib/LAPACK/slaran.f | 147 -
netlib/LAPACK/slarf.f | 227 -
netlib/LAPACK/slarfb.f | 758 -
netlib/LAPACK/slarfg.f | 196 -
netlib/LAPACK/slarfgp.f | 242 -
netlib/LAPACK/slarft.f | 326 -
netlib/LAPACK/slarfx.f | 696 -
netlib/LAPACK/slarge.f | 174 -
netlib/LAPACK/slargv.f | 167 -
netlib/LAPACK/slarnd.f | 133 -
netlib/LAPACK/slarnv.f | 178 -
netlib/LAPACK/slaror.f | 304 -
netlib/LAPACK/slarot.f | 317 -
netlib/LAPACK/slarra.f | 204 -
netlib/LAPACK/slarrb.f | 401 -
netlib/LAPACK/slarrc.f | 243 -
netlib/LAPACK/slarrd.f | 855 -
netlib/LAPACK/slarre.f | 895 -
netlib/LAPACK/slarrf.f | 487 -
netlib/LAPACK/slarrj.f | 373 -
netlib/LAPACK/slarrk.f | 249 -
netlib/LAPACK/slarrr.f | 204 -
netlib/LAPACK/slarrv.f | 1028 -
netlib/LAPACK/slarscl2.f | 119 -
netlib/LAPACK/slartg.f | 204 -
netlib/LAPACK/slartgp.f | 202 -
netlib/LAPACK/slartgs.f | 158 -
netlib/LAPACK/slartv.f | 147 -
netlib/LAPACK/slaruv.f | 447 -
netlib/LAPACK/slarz.f | 236 -
netlib/LAPACK/slarzb.f | 323 -
netlib/LAPACK/slarzt.f | 264 -
netlib/LAPACK/slas2.f | 183 -
netlib/LAPACK/slascl.f | 364 -
netlib/LAPACK/slascl2.f | 119 -
netlib/LAPACK/slasd0.f | 313 -
netlib/LAPACK/slasd1.f | 323 -
netlib/LAPACK/slasd2.f | 634 -
netlib/LAPACK/slasd3.f | 470 -
netlib/LAPACK/slasd4.f | 1057 -
netlib/LAPACK/slasd5.f | 231 -
netlib/LAPACK/slasd6.f | 445 -
netlib/LAPACK/slasd7.f | 580 -
netlib/LAPACK/slasd8.f | 343 -
netlib/LAPACK/slasda.f | 514 -
netlib/LAPACK/slasdq.f | 413 -
netlib/LAPACK/slasdt.f | 172 -
netlib/LAPACK/slaset.f | 184 -
netlib/LAPACK/slasq1.f | 224 -
netlib/LAPACK/slasq2.f | 589 -
netlib/LAPACK/slasq3.f | 421 -
netlib/LAPACK/slasq4.f | 425 -
netlib/LAPACK/slasq5.f | 399 -
netlib/LAPACK/slasq6.f | 254 -
netlib/LAPACK/slasr.f | 436 -
netlib/LAPACK/slasrt.f | 303 -
netlib/LAPACK/slassq.f | 155 -
netlib/LAPACK/slasv2.f | 325 -
netlib/LAPACK/slaswp.f | 191 -
netlib/LAPACK/slasy2.f | 480 -
netlib/LAPACK/slasyf.f | 666 -
netlib/LAPACK/slatbs.f | 812 -
netlib/LAPACK/slatdf.f | 323 -
netlib/LAPACK/slatm1.f | 299 -
netlib/LAPACK/slatm2.f | 315 -
netlib/LAPACK/slatm3.f | 335 -
netlib/LAPACK/slatm5.f | 501 -
netlib/LAPACK/slatm6.f | 333 -
netlib/LAPACK/slatm7.f | 297 -
netlib/LAPACK/slatme.f | 710 -
netlib/LAPACK/slatmr.f | 1227 -
netlib/LAPACK/slatms.f | 1128 -
netlib/LAPACK/slatmt.f | 1139 -
netlib/LAPACK/slatps.f | 795 -
netlib/LAPACK/slatrd.f | 336 -
netlib/LAPACK/slatrs.f | 787 -
netlib/LAPACK/slatrz.f | 200 -
netlib/LAPACK/slatzm.f | 221 -
netlib/LAPACK/slauu2.f | 198 -
netlib/LAPACK/slauum.f | 218 -
netlib/LAPACK/sopgtr.f | 232 -
netlib/LAPACK/sopmtr.f | 339 -
netlib/LAPACK/sorbdb.f | 607 -
netlib/LAPACK/sorcsd.f | 602 -
netlib/LAPACK/sorg2l.f | 198 -
netlib/LAPACK/sorg2r.f | 200 -
netlib/LAPACK/sorgbr.f | 338 -
netlib/LAPACK/sorghr.f | 240 -
netlib/LAPACK/sorgl2.f | 204 -
netlib/LAPACK/sorglq.f | 289 -
netlib/LAPACK/sorgql.f | 296 -
netlib/LAPACK/sorgqr.f | 290 -
netlib/LAPACK/sorgr2.f | 202 -
netlib/LAPACK/sorgrq.f | 296 -
netlib/LAPACK/sorgtr.f | 255 -
netlib/LAPACK/sorm2l.f | 278 -
netlib/LAPACK/sorm2r.f | 282 -
netlib/LAPACK/sormbr.f | 374 -
netlib/LAPACK/sormhr.f | 296 -
netlib/LAPACK/sorml2.f | 282 -
netlib/LAPACK/sormlq.f | 356 -
netlib/LAPACK/sormql.f | 351 -
netlib/LAPACK/sormqr.f | 349 -
netlib/LAPACK/sormr2.f | 278 -
netlib/LAPACK/sormr3.f | 299 -
netlib/LAPACK/sormrq.f | 357 -
netlib/LAPACK/sormrz.f | 388 -
netlib/LAPACK/sormtr.f | 312 -
netlib/LAPACK/spbcon.f | 271 -
netlib/LAPACK/spbequ.f | 242 -
netlib/LAPACK/spbrfs.f | 443 -
netlib/LAPACK/spbstf.f | 319 -
netlib/LAPACK/spbsv.f | 229 -
netlib/LAPACK/spbsvx.f | 545 -
netlib/LAPACK/spbtf2.f | 263 -
netlib/LAPACK/spbtrf.f | 435 -
netlib/LAPACK/spbtrs.f | 220 -
netlib/LAPACK/spftrf.f | 457 -
netlib/LAPACK/spftri.f | 423 -
netlib/LAPACK/spftrs.f | 280 -
netlib/LAPACK/spocon.f | 253 -
netlib/LAPACK/spoequ.f | 205 -
netlib/LAPACK/spoequb.f | 215 -
netlib/LAPACK/sporfs.f | 430 -
netlib/LAPACK/sposv.f | 193 -
netlib/LAPACK/sposvx.f | 494 -
netlib/LAPACK/spotf2.f | 230 -
netlib/LAPACK/spotrf.f | 246 -
netlib/LAPACK/spotri.f | 159 -
netlib/LAPACK/spotrs.f | 204 -
netlib/LAPACK/sppcon.f | 248 -
netlib/LAPACK/sppequ.f | 238 -
netlib/LAPACK/spprfs.f | 421 -
netlib/LAPACK/sppsv.f | 205 -
netlib/LAPACK/sppsvx.f | 494 -
netlib/LAPACK/spptrf.f | 240 -
netlib/LAPACK/spptri.f | 188 -
netlib/LAPACK/spptrs.f | 203 -
netlib/LAPACK/spstf2.f | 385 -
netlib/LAPACK/spstrf.f | 443 -
netlib/LAPACK/sptcon.f | 221 -
netlib/LAPACK/spteqr.f | 261 -
netlib/LAPACK/sptrfs.f | 395 -
netlib/LAPACK/sptsv.f | 167 -
netlib/LAPACK/sptsvx.f | 336 -
netlib/LAPACK/spttrf.f | 211 -
netlib/LAPACK/spttrs.f | 182 -
netlib/LAPACK/sptts2.f | 158 -
netlib/LAPACK/srscl.f | 174 -
netlib/LAPACK/ssbev.f | 287 -
netlib/LAPACK/ssbevd.f | 360 -
netlib/LAPACK/ssbevx.f | 536 -
netlib/LAPACK/ssbgst.f | 1434 -
netlib/LAPACK/ssbgv.f | 280 -
netlib/LAPACK/ssbgvd.f | 372 -
netlib/LAPACK/ssbgvx.f | 513 -
netlib/LAPACK/ssbtrd.f | 641 -
netlib/LAPACK/ssfrk.f | 543 -
netlib/LAPACK/sspcon.f | 238 -
netlib/LAPACK/sspev.f | 262 -
netlib/LAPACK/sspevd.f | 337 -
netlib/LAPACK/sspevx.f | 489 -
netlib/LAPACK/sspgst.f | 274 -
netlib/LAPACK/sspgv.f | 278 -
netlib/LAPACK/sspgvd.f | 364 -
netlib/LAPACK/sspgvx.f | 408 -
netlib/LAPACK/ssprfs.f | 431 -
netlib/LAPACK/sspsv.f | 224 -
netlib/LAPACK/sspsvx.f | 386 -
netlib/LAPACK/ssptrd.f | 299 -
netlib/LAPACK/ssptrf.f | 614 -
netlib/LAPACK/ssptri.f | 401 -
netlib/LAPACK/ssptrs.f | 450 -
netlib/LAPACK/sstebz.f | 760 -
netlib/LAPACK/sstedc.f | 488 -
netlib/LAPACK/sstegr.f | 293 -
netlib/LAPACK/sstein.f | 452 -
netlib/LAPACK/sstemr.f | 762 -
netlib/LAPACK/ssteqr.f | 572 -
netlib/LAPACK/ssterf.f | 425 -
netlib/LAPACK/sstev.f | 235 -
netlib/LAPACK/sstevd.f | 302 -
netlib/LAPACK/sstevr.f | 573 -
netlib/LAPACK/sstevx.f | 457 -
netlib/LAPACK/ssycon.f | 244 -
netlib/LAPACK/ssyconv.f | 362 -
netlib/LAPACK/ssyequb.f | 342 -
netlib/LAPACK/ssyev.f | 286 -
netlib/LAPACK/ssyevd.f | 355 -
netlib/LAPACK/ssyevr.f | 681 -
netlib/LAPACK/ssyevx.f | 547 -
netlib/LAPACK/ssygs2.f | 283 -
netlib/LAPACK/ssygst.f | 321 -
netlib/LAPACK/ssygv.f | 314 -
netlib/LAPACK/ssygvd.f | 380 -
netlib/LAPACK/ssygvx.f | 458 -
netlib/LAPACK/ssyrfs.f | 441 -
netlib/LAPACK/ssysv.f | 270 -
netlib/LAPACK/ssysvx.f | 416 -
netlib/LAPACK/ssyswapr.f | 193 -
netlib/LAPACK/ssytd2.f | 322 -
netlib/LAPACK/ssytf2.f | 598 -
netlib/LAPACK/ssytrd.f | 376 -
netlib/LAPACK/ssytrf.f | 363 -
netlib/LAPACK/ssytri.f | 382 -
netlib/LAPACK/ssytri2.f | 205 -
netlib/LAPACK/ssytri2x.f | 590 -
netlib/LAPACK/ssytrs.f | 445 -
netlib/LAPACK/ssytrs2.f | 356 -
netlib/LAPACK/stbcon.f | 284 -
netlib/LAPACK/stbrfs.f | 485 -
netlib/LAPACK/stbtrs.f | 244 -
netlib/LAPACK/stfsm.f | 1005 -
netlib/LAPACK/stftri.f | 472 -
netlib/LAPACK/stfttp.f | 517 -
netlib/LAPACK/stfttr.f | 495 -
netlib/LAPACK/stgevc.f | 1211 -
netlib/LAPACK/stgex2.f | 699 -
netlib/LAPACK/stgexc.f | 544 -
netlib/LAPACK/stgsen.f | 863 -
netlib/LAPACK/stgsja.f | 655 -
netlib/LAPACK/stgsna.f | 700 -
netlib/LAPACK/stgsy2.f | 1075 -
netlib/LAPACK/stgsyl.f | 682 -
netlib/LAPACK/stpcon.f | 267 -
netlib/LAPACK/stpmqrt.f | 366 -
netlib/LAPACK/stpqrt.f | 270 -
netlib/LAPACK/stpqrt2.f | 302 -
netlib/LAPACK/stprfb.f | 811 -
netlib/LAPACK/stprfs.f | 473 -
netlib/LAPACK/stptri.f | 241 -
netlib/LAPACK/stptrs.f | 228 -
netlib/LAPACK/stpttf.f | 502 -
netlib/LAPACK/stpttr.f | 176 -
netlib/LAPACK/strcon.f | 276 -
netlib/LAPACK/strevc.f | 1077 -
netlib/LAPACK/strexc.f | 426 -
netlib/LAPACK/strrfs.f | 472 -
netlib/LAPACK/strsen.f | 571 -
netlib/LAPACK/strsna.f | 603 -
netlib/LAPACK/strsyl.f | 1002 -
netlib/LAPACK/strti2.f | 212 -
netlib/LAPACK/strtri.f | 242 -
netlib/LAPACK/strtrs.f | 226 -
netlib/LAPACK/strttf.f | 492 -
netlib/LAPACK/strttp.f | 175 -
netlib/LAPACK/stzrqf.f | 232 -
netlib/LAPACK/stzrzf.f | 313 -
netlib/LAPACK/xerbla_array.f | 129 -
netlib/LAPACKE/lapacke.h | 16305 ---
netlib/LAPACKE/lapacke_config.h | 119 -
netlib/LAPACKE/lapacke_d_nancheck.c | 51 -
netlib/LAPACKE/lapacke_dbbcsd.c | 115 -
netlib/LAPACKE/lapacke_dbbcsd_work.c | 199 -
netlib/LAPACKE/lapacke_dbdsdc.c | 92 -
netlib/LAPACKE/lapacke_dbdsdc_work.c | 112 -
netlib/LAPACKE/lapacke_dbdsqr.c | 88 -
netlib/LAPACKE/lapacke_dbdsqr_work.c | 145 -
netlib/LAPACKE/lapacke_ddisna.c | 46 -
netlib/LAPACKE/lapacke_ddisna_work.c | 43 -
netlib/LAPACKE/lapacke_dgb_nancheck.c | 64 -
netlib/LAPACKE/lapacke_dgb_trans.c | 67 -
netlib/LAPACKE/lapacke_dgbbrd.c | 76 -
netlib/LAPACKE/lapacke_dgbbrd_work.c | 156 -
netlib/LAPACKE/lapacke_dgbcon.c | 80 -
netlib/LAPACKE/lapacke_dgbcon_work.c | 85 -
netlib/LAPACKE/lapacke_dgbequ.c | 53 -
netlib/LAPACKE/lapacke_dgbequ_work.c | 83 -
netlib/LAPACKE/lapacke_dgbequb.c | 53 -
netlib/LAPACKE/lapacke_dgbequb_work.c | 83 -
netlib/LAPACKE/lapacke_dgbrfs.c | 89 -
netlib/LAPACKE/lapacke_dgbrfs_work.c | 136 -
netlib/LAPACKE/lapacke_dgbsv.c | 56 -
netlib/LAPACKE/lapacke_dgbsv_work.c | 102 -
netlib/LAPACKE/lapacke_dgbsvx.c | 105 -
netlib/LAPACKE/lapacke_dgbsvx_work.c | 151 -
netlib/LAPACKE/lapacke_dgbtrf.c | 51 -
netlib/LAPACKE/lapacke_dgbtrf_work.c | 84 -
netlib/LAPACKE/lapacke_dgbtrs.c | 56 -
netlib/LAPACKE/lapacke_dgbtrs_work.c | 102 -
netlib/LAPACKE/lapacke_dge_nancheck.c | 62 -
netlib/LAPACKE/lapacke_dge_trans.c | 65 -
netlib/LAPACKE/lapacke_dgebak.c | 55 -
netlib/LAPACKE/lapacke_dgebak_work.c | 84 -
netlib/LAPACKE/lapacke_dgebal.c | 54 -
netlib/LAPACKE/lapacke_dgebal_work.c | 94 -
netlib/LAPACKE/lapacke_dgebrd.c | 77 -
netlib/LAPACKE/lapacke_dgebrd_work.c | 90 -
netlib/LAPACKE/lapacke_dgecon.c | 79 -
netlib/LAPACKE/lapacke_dgecon_work.c | 81 -
netlib/LAPACKE/lapacke_dgeequ.c | 53 -
netlib/LAPACKE/lapacke_dgeequ_work.c | 81 -
netlib/LAPACKE/lapacke_dgeequb.c | 53 -
netlib/LAPACKE/lapacke_dgeequb_work.c | 82 -
netlib/LAPACKE/lapacke_dgees.c | 93 -
netlib/LAPACKE/lapacke_dgees_work.c | 115 -
netlib/LAPACKE/lapacke_dgeesx.c | 111 -
netlib/LAPACKE/lapacke_dgeesx_work.c | 120 -
netlib/LAPACKE/lapacke_dgeev.c | 78 -
netlib/LAPACKE/lapacke_dgeev_work.c | 136 -
netlib/LAPACKE/lapacke_dgeevx.c | 98 -
netlib/LAPACKE/lapacke_dgeevx_work.c | 142 -
netlib/LAPACKE/lapacke_dgehrd.c | 77 -
netlib/LAPACKE/lapacke_dgehrd_work.c | 88 -
netlib/LAPACKE/lapacke_dgejsv.c | 133 -
netlib/LAPACKE/lapacke_dgejsv_work.c | 147 -
netlib/LAPACKE/lapacke_dgelq2.c | 66 -
netlib/LAPACKE/lapacke_dgelq2_work.c | 82 -
netlib/LAPACKE/lapacke_dgelqf.c | 75 -
netlib/LAPACKE/lapacke_dgelqf_work.c | 87 -
netlib/LAPACKE/lapacke_dgels.c | 80 -
netlib/LAPACKE/lapacke_dgels_work.c | 108 -
netlib/LAPACKE/lapacke_dgelsd.c | 96 -
netlib/LAPACKE/lapacke_dgelsd_work.c | 109 -
netlib/LAPACKE/lapacke_dgelss.c | 84 -
netlib/LAPACKE/lapacke_dgelss_work.c | 109 -
netlib/LAPACKE/lapacke_dgelsy.c | 84 -
netlib/LAPACKE/lapacke_dgelsy_work.c | 109 -
netlib/LAPACKE/lapacke_dgemqrt.c | 76 -
netlib/LAPACKE/lapacke_dgemqrt_work.c | 116 -
netlib/LAPACKE/lapacke_dgeqlf.c | 75 -
netlib/LAPACKE/lapacke_dgeqlf_work.c | 87 -
netlib/LAPACKE/lapacke_dgeqp3.c | 77 -
netlib/LAPACKE/lapacke_dgeqp3_work.c | 87 -
netlib/LAPACKE/lapacke_dgeqpf.c | 67 -
netlib/LAPACKE/lapacke_dgeqpf_work.c | 82 -
netlib/LAPACKE/lapacke_dgeqr2.c | 66 -
netlib/LAPACKE/lapacke_dgeqr2_work.c | 82 -
netlib/LAPACKE/lapacke_dgeqrf.c | 75 -
netlib/LAPACKE/lapacke_dgeqrf_work.c | 87 -
netlib/LAPACKE/lapacke_dgeqrfp.c | 75 -
netlib/LAPACKE/lapacke_dgeqrfp_work.c | 87 -
netlib/LAPACKE/lapacke_dgeqrt.c | 67 -
netlib/LAPACKE/lapacke_dgeqrt2.c | 51 -
netlib/LAPACKE/lapacke_dgeqrt2_work.c | 97 -
netlib/LAPACKE/lapacke_dgeqrt3.c | 51 -
netlib/LAPACKE/lapacke_dgeqrt3_work.c | 97 -
netlib/LAPACKE/lapacke_dgeqrt_work.c | 99 -
netlib/LAPACKE/lapacke_dgerfs.c | 88 -
netlib/LAPACKE/lapacke_dgerfs_work.c | 133 -
netlib/LAPACKE/lapacke_dgerqf.c | 75 -
netlib/LAPACKE/lapacke_dgerqf_work.c | 87 -
netlib/LAPACKE/lapacke_dgesdd.c | 88 -
netlib/LAPACKE/lapacke_dgesdd_work.c | 153 -
netlib/LAPACKE/lapacke_dgesv.c | 54 -
netlib/LAPACKE/lapacke_dgesv_work.c | 98 -
netlib/LAPACKE/lapacke_dgesvd.c | 83 -
netlib/LAPACKE/lapacke_dgesvd_work.c | 144 -
netlib/LAPACKE/lapacke_dgesvj.c | 84 -
netlib/LAPACKE/lapacke_dgesvj_work.c | 113 -
netlib/LAPACKE/lapacke_dgesvx.c | 103 -
netlib/LAPACKE/lapacke_dgesvx_work.c | 147 -
netlib/LAPACKE/lapacke_dgetf2.c | 50 -
netlib/LAPACKE/lapacke_dgetf2_work.c | 81 -
netlib/LAPACKE/lapacke_dgetrf.c | 50 -
netlib/LAPACKE/lapacke_dgetrf_work.c | 81 -
netlib/LAPACKE/lapacke_dgetri.c | 75 -
netlib/LAPACKE/lapacke_dgetri_work.c | 87 -
netlib/LAPACKE/lapacke_dgetrs.c | 55 -
netlib/LAPACKE/lapacke_dgetrs_work.c | 99 -
netlib/LAPACKE/lapacke_dgg_nancheck.c | 43 -
netlib/LAPACKE/lapacke_dgg_trans.c | 45 -
netlib/LAPACKE/lapacke_dggbak.c | 59 -
netlib/LAPACKE/lapacke_dggbak_work.c | 85 -
netlib/LAPACKE/lapacke_dggbal.c | 86 -
netlib/LAPACKE/lapacke_dggbal_work.c | 126 -
netlib/LAPACKE/lapacke_dgges.c | 99 -
netlib/LAPACKE/lapacke_dgges_work.c | 160 -
netlib/LAPACKE/lapacke_dggesx.c | 114 -
netlib/LAPACKE/lapacke_dggesx_work.c | 165 -
netlib/LAPACKE/lapacke_dggev.c | 84 -
netlib/LAPACKE/lapacke_dggev_work.c | 161 -
netlib/LAPACKE/lapacke_dggevx.c | 120 -
netlib/LAPACKE/lapacke_dggevx_work.c | 163 -
netlib/LAPACKE/lapacke_dggglm.c | 83 -
netlib/LAPACKE/lapacke_dggglm_work.c | 107 -
netlib/LAPACKE/lapacke_dgghrd.c | 67 -
netlib/LAPACKE/lapacke_dgghrd_work.c | 150 -
netlib/LAPACKE/lapacke_dgglse.c | 86 -
netlib/LAPACKE/lapacke_dgglse_work.c | 107 -
netlib/LAPACKE/lapacke_dggqrf.c | 81 -
netlib/LAPACKE/lapacke_dggqrf_work.c | 107 -
netlib/LAPACKE/lapacke_dggrqf.c | 81 -
netlib/LAPACKE/lapacke_dggrqf_work.c | 107 -
netlib/LAPACKE/lapacke_dggsvd.c | 76 -
netlib/LAPACKE/lapacke_dggsvd_work.c | 170 -
netlib/LAPACKE/lapacke_dggsvp.c | 97 -
netlib/LAPACKE/lapacke_dggsvp_work.c | 170 -
netlib/LAPACKE/lapacke_dgt_nancheck.c | 45 -
netlib/LAPACKE/lapacke_dgtcon.c | 84 -
netlib/LAPACKE/lapacke_dgtcon_work.c | 47 -
netlib/LAPACKE/lapacke_dgtrfs.c | 105 -
netlib/LAPACKE/lapacke_dgtrfs_work.c | 106 -
netlib/LAPACKE/lapacke_dgtsv.c | 60 -
netlib/LAPACKE/lapacke_dgtsv_work.c | 82 -
netlib/LAPACKE/lapacke_dgtsvx.c | 110 -
netlib/LAPACKE/lapacke_dgtsvx_work.c | 105 -
netlib/LAPACKE/lapacke_dgttrf.c | 52 -
netlib/LAPACKE/lapacke_dgttrf_work.c | 43 -
netlib/LAPACKE/lapacke_dgttrs.c | 65 -
netlib/LAPACKE/lapacke_dgttrs_work.c | 86 -
netlib/LAPACKE/lapacke_dhgeqz.c | 95 -
netlib/LAPACKE/lapacke_dhgeqz_work.c | 161 -
netlib/LAPACKE/lapacke_dhs_nancheck.c | 57 -
netlib/LAPACKE/lapacke_dhs_trans.c | 59 -
netlib/LAPACKE/lapacke_dhsein.c | 89 -
netlib/LAPACKE/lapacke_dhsein_work.c | 142 -
netlib/LAPACKE/lapacke_dhseqr.c | 83 -
netlib/LAPACKE/lapacke_dhseqr_work.c | 116 -
netlib/LAPACKE/lapacke_dlacpy.c | 51 -
netlib/LAPACKE/lapacke_dlacpy_work.c | 94 -
netlib/LAPACKE/lapacke_dlag2s.c | 51 -
netlib/LAPACKE/lapacke_dlag2s_work.c | 96 -
netlib/LAPACKE/lapacke_dlagge.c | 68 -
netlib/LAPACKE/lapacke_dlagge_work.c | 81 -
netlib/LAPACKE/lapacke_dlagsy.c | 67 -
netlib/LAPACKE/lapacke_dlagsy_work.c | 80 -
netlib/LAPACKE/lapacke_dlamch.c | 39 -
netlib/LAPACKE/lapacke_dlamch_work.c | 43 -
netlib/LAPACKE/lapacke_dlange.c | 71 -
netlib/LAPACKE/lapacke_dlange_work.c | 79 -
netlib/LAPACKE/lapacke_dlansy.c | 73 -
netlib/LAPACKE/lapacke_dlansy_work.c | 79 -
netlib/LAPACKE/lapacke_dlantr.c | 75 -
netlib/LAPACKE/lapacke_dlantr_work.c | 79 -
netlib/LAPACKE/lapacke_dlapmr.c | 51 -
netlib/LAPACKE/lapacke_dlapmr_work.c | 80 -
netlib/LAPACKE/lapacke_dlapy2.c | 48 -
netlib/LAPACKE/lapacke_dlapy2_work.c | 42 -
netlib/LAPACKE/lapacke_dlapy3.c | 51 -
netlib/LAPACKE/lapacke_dlapy3_work.c | 42 -
netlib/LAPACKE/lapacke_dlarfb.c | 118 -
netlib/LAPACKE/lapacke_dlarfb_work.c | 155 -
netlib/LAPACKE/lapacke_dlarfg.c | 49 -
netlib/LAPACKE/lapacke_dlarfg_work.c | 43 -
netlib/LAPACKE/lapacke_dlarft.c | 61 -
netlib/LAPACKE/lapacke_dlarft_work.c | 102 -
netlib/LAPACKE/lapacke_dlarfx.c | 58 -
netlib/LAPACKE/lapacke_dlarfx_work.c | 80 -
netlib/LAPACKE/lapacke_dlarnv.c | 40 -
netlib/LAPACKE/lapacke_dlarnv_work.c | 43 -
netlib/LAPACKE/lapacke_dlartgp.c | 49 -
netlib/LAPACKE/lapacke_dlartgp_work.c | 43 -
netlib/LAPACKE/lapacke_dlartgs.c | 52 -
netlib/LAPACKE/lapacke_dlartgs_work.c | 43 -
netlib/LAPACKE/lapacke_dlaset.c | 57 -
netlib/LAPACKE/lapacke_dlaset_work.c | 80 -
netlib/LAPACKE/lapacke_dlasrt.c | 45 -
netlib/LAPACKE/lapacke_dlasrt_work.c | 42 -
netlib/LAPACKE/lapacke_dlaswp.c | 51 -
netlib/LAPACKE/lapacke_dlaswp_work.c | 80 -
netlib/LAPACKE/lapacke_dlatms.c | 79 -
netlib/LAPACKE/lapacke_dlatms_work.c | 87 -
netlib/LAPACKE/lapacke_dlauum.c | 50 -
netlib/LAPACKE/lapacke_dlauum_work.c | 81 -
netlib/LAPACKE/lapacke_dopgtr.c | 70 -
netlib/LAPACKE/lapacke_dopgtr_work.c | 91 -
netlib/LAPACKE/lapacke_dopmtr.c | 86 -
netlib/LAPACKE/lapacke_dopmtr_work.c | 97 -
netlib/LAPACKE/lapacke_dorbdb.c | 98 -
netlib/LAPACKE/lapacke_dorbdb_work.c | 160 -
netlib/LAPACKE/lapacke_dorcsd.c | 112 -
netlib/LAPACKE/lapacke_dorcsd_work.c | 264 -
netlib/LAPACKE/lapacke_dorgbr.c | 80 -
netlib/LAPACKE/lapacke_dorgbr_work.c | 90 -
netlib/LAPACKE/lapacke_dorghr.c | 80 -
netlib/LAPACKE/lapacke_dorghr_work.c | 89 -
netlib/LAPACKE/lapacke_dorglq.c | 80 -
netlib/LAPACKE/lapacke_dorglq_work.c | 88 -
netlib/LAPACKE/lapacke_dorgql.c | 80 -
netlib/LAPACKE/lapacke_dorgql_work.c | 88 -
netlib/LAPACKE/lapacke_dorgqr.c | 80 -
netlib/LAPACKE/lapacke_dorgqr_work.c | 88 -
netlib/LAPACKE/lapacke_dorgrq.c | 80 -
netlib/LAPACKE/lapacke_dorgrq_work.c | 88 -
netlib/LAPACKE/lapacke_dorgtr.c | 79 -
netlib/LAPACKE/lapacke_dorgtr_work.c | 87 -
netlib/LAPACKE/lapacke_dormbr.c | 87 -
netlib/LAPACKE/lapacke_dormbr_work.c | 111 -
netlib/LAPACKE/lapacke_dormhr.c | 86 -
netlib/LAPACKE/lapacke_dormhr_work.c | 109 -
netlib/LAPACKE/lapacke_dormlq.c | 84 -
netlib/LAPACKE/lapacke_dormlq_work.c | 107 -
netlib/LAPACKE/lapacke_dormql.c | 86 -
netlib/LAPACKE/lapacke_dormql_work.c | 109 -
netlib/LAPACKE/lapacke_dormqr.c | 86 -
netlib/LAPACKE/lapacke_dormqr_work.c | 109 -
netlib/LAPACKE/lapacke_dormrq.c | 84 -
netlib/LAPACKE/lapacke_dormrq_work.c | 107 -
netlib/LAPACKE/lapacke_dormrz.c | 84 -
netlib/LAPACKE/lapacke_dormrz_work.c | 107 -
netlib/LAPACKE/lapacke_dormtr.c | 86 -
netlib/LAPACKE/lapacke_dormtr_work.c | 108 -
netlib/LAPACKE/lapacke_dpb_nancheck.c | 48 -
netlib/LAPACKE/lapacke_dpb_trans.c | 50 -
netlib/LAPACKE/lapacke_dpbcon.c | 79 -
netlib/LAPACKE/lapacke_dpbcon_work.c | 83 -
netlib/LAPACKE/lapacke_dpbequ.c | 52 -
netlib/LAPACKE/lapacke_dpbequ_work.c | 81 -
netlib/LAPACKE/lapacke_dpbrfs.c | 88 -
netlib/LAPACKE/lapacke_dpbrfs_work.c | 135 -
netlib/LAPACKE/lapacke_dpbstf.c | 50 -
netlib/LAPACKE/lapacke_dpbstf_work.c | 82 -
netlib/LAPACKE/lapacke_dpbsv.c | 55 -
netlib/LAPACKE/lapacke_dpbsv_work.c | 100 -
netlib/LAPACKE/lapacke_dpbsvx.c | 93 -
netlib/LAPACKE/lapacke_dpbsvx_work.c | 146 -
netlib/LAPACKE/lapacke_dpbtrf.c | 50 -
netlib/LAPACKE/lapacke_dpbtrf_work.c | 82 -
netlib/LAPACKE/lapacke_dpbtrs.c | 55 -
netlib/LAPACKE/lapacke_dpbtrs_work.c | 99 -
netlib/LAPACKE/lapacke_dpf_nancheck.c | 46 -
netlib/LAPACKE/lapacke_dpf_trans.c | 45 -
netlib/LAPACKE/lapacke_dpftrf.c | 50 -
netlib/LAPACKE/lapacke_dpftrf_work.c | 75 -
netlib/LAPACKE/lapacke_dpftri.c | 50 -
netlib/LAPACKE/lapacke_dpftri_work.c | 75 -
netlib/LAPACKE/lapacke_dpftrs.c | 55 -
netlib/LAPACKE/lapacke_dpftrs_work.c | 92 -
netlib/LAPACKE/lapacke_dpo_nancheck.c | 43 -
netlib/LAPACKE/lapacke_dpo_trans.c | 45 -
netlib/LAPACKE/lapacke_dpocon.c | 79 -
netlib/LAPACKE/lapacke_dpocon_work.c | 81 -
netlib/LAPACKE/lapacke_dpoequ.c | 51 -
netlib/LAPACKE/lapacke_dpoequ_work.c | 80 -
netlib/LAPACKE/lapacke_dpoequb.c | 51 -
netlib/LAPACKE/lapacke_dpoequb_work.c | 80 -
netlib/LAPACKE/lapacke_dporfs.c | 87 -
netlib/LAPACKE/lapacke_dporfs_work.c | 133 -
netlib/LAPACKE/lapacke_dposv.c | 54 -
netlib/LAPACKE/lapacke_dposv_work.c | 98 -
netlib/LAPACKE/lapacke_dposvx.c | 92 -
netlib/LAPACKE/lapacke_dposvx_work.c | 143 -
netlib/LAPACKE/lapacke_dpotrf.c | 50 -
netlib/LAPACKE/lapacke_dpotrf_work.c | 81 -
netlib/LAPACKE/lapacke_dpotri.c | 50 -
netlib/LAPACKE/lapacke_dpotri_work.c | 81 -
netlib/LAPACKE/lapacke_dpotrs.c | 54 -
netlib/LAPACKE/lapacke_dpotrs_work.c | 97 -
netlib/LAPACKE/lapacke_dpp_nancheck.c | 45 -
netlib/LAPACKE/lapacke_dpp_trans.c | 45 -
netlib/LAPACKE/lapacke_dppcon.c | 78 -
netlib/LAPACKE/lapacke_dppcon_work.c | 74 -
netlib/LAPACKE/lapacke_dppequ.c | 51 -
netlib/LAPACKE/lapacke_dppequ_work.c | 74 -
netlib/LAPACKE/lapacke_dpprfs.c | 86 -
netlib/LAPACKE/lapacke_dpprfs_work.c | 122 -
netlib/LAPACKE/lapacke_dppsv.c | 54 -
netlib/LAPACKE/lapacke_dppsv_work.c | 93 -
netlib/LAPACKE/lapacke_dppsvx.c | 92 -
netlib/LAPACKE/lapacke_dppsvx_work.c | 131 -
netlib/LAPACKE/lapacke_dpptrf.c | 50 -
netlib/LAPACKE/lapacke_dpptrf_work.c | 75 -
netlib/LAPACKE/lapacke_dpptri.c | 50 -
netlib/LAPACKE/lapacke_dpptri_work.c | 75 -
netlib/LAPACKE/lapacke_dpptrs.c | 54 -
netlib/LAPACKE/lapacke_dpptrs_work.c | 92 -
netlib/LAPACKE/lapacke_dpstrf.c | 71 -
netlib/LAPACKE/lapacke_dpstrf_work.c | 82 -
netlib/LAPACKE/lapacke_dpt_nancheck.c | 43 -
netlib/LAPACKE/lapacke_dptcon.c | 68 -
netlib/LAPACKE/lapacke_dptcon_work.c | 43 -
netlib/LAPACKE/lapacke_dpteqr.c | 82 -
netlib/LAPACKE/lapacke_dpteqr_work.c | 84 -
netlib/LAPACKE/lapacke_dptrfs.c | 85 -
netlib/LAPACKE/lapacke_dptrfs_work.c | 102 -
netlib/LAPACKE/lapacke_dptsv.c | 56 -
netlib/LAPACKE/lapacke_dptsv_work.c | 81 -
netlib/LAPACKE/lapacke_dptsvx.c | 86 -
netlib/LAPACKE/lapacke_dptsvx_work.c | 101 -
netlib/LAPACKE/lapacke_dpttrf.c | 48 -
netlib/LAPACKE/lapacke_dpttrf_work.c | 42 -
netlib/LAPACKE/lapacke_dpttrs.c | 57 -
netlib/LAPACKE/lapacke_dpttrs_work.c | 82 -
netlib/LAPACKE/lapacke_dsb_nancheck.c | 48 -
netlib/LAPACKE/lapacke_dsb_trans.c | 50 -
netlib/LAPACKE/lapacke_dsbev.c | 68 -
netlib/LAPACKE/lapacke_dsbev_work.c | 107 -
netlib/LAPACKE/lapacke_dsbevd.c | 88 -
netlib/LAPACKE/lapacke_dsbevd_work.c | 114 -
netlib/LAPACKE/lapacke_dsbevx.c | 93 -
netlib/LAPACKE/lapacke_dsbevx_work.c | 139 -
netlib/LAPACKE/lapacke_dsbgst.c | 72 -
netlib/LAPACKE/lapacke_dsbgst_work.c | 123 -
netlib/LAPACKE/lapacke_dsbgv.c | 72 -
netlib/LAPACKE/lapacke_dsbgv_work.c | 125 -
netlib/LAPACKE/lapacke_dsbgvd.c | 94 -
netlib/LAPACKE/lapacke_dsbgvd_work.c | 132 -
netlib/LAPACKE/lapacke_dsbgvx.c | 97 -
netlib/LAPACKE/lapacke_dsbgvx_work.c | 152 -
netlib/LAPACKE/lapacke_dsbtrd.c | 73 -
netlib/LAPACKE/lapacke_dsbtrd_work.c | 110 -
netlib/LAPACKE/lapacke_dsfrk.c | 65 -
netlib/LAPACKE/lapacke_dsfrk_work.c | 95 -
netlib/LAPACKE/lapacke_dsgesv.c | 80 -
netlib/LAPACKE/lapacke_dsgesv_work.c | 117 -
netlib/LAPACKE/lapacke_dsp_nancheck.c | 45 -
netlib/LAPACKE/lapacke_dsp_trans.c | 45 -
netlib/LAPACKE/lapacke_dspcon.c | 79 -
netlib/LAPACKE/lapacke_dspcon_work.c | 76 -
netlib/LAPACKE/lapacke_dspev.c | 67 -
netlib/LAPACKE/lapacke_dspev_work.c | 98 -
netlib/LAPACKE/lapacke_dspevd.c | 87 -
netlib/LAPACKE/lapacke_dspevd_work.c | 107 -
netlib/LAPACKE/lapacke_dspevx.c | 92 -
netlib/LAPACKE/lapacke_dspevx_work.c | 108 -
netlib/LAPACKE/lapacke_dspgst.c | 53 -
netlib/LAPACKE/lapacke_dspgst_work.c | 85 -
netlib/LAPACKE/lapacke_dspgv.c | 71 -
netlib/LAPACKE/lapacke_dspgv_work.c | 112 -
netlib/LAPACKE/lapacke_dspgvd.c | 92 -
netlib/LAPACKE/lapacke_dspgvd_work.c | 119 -
netlib/LAPACKE/lapacke_dspgvx.c | 96 -
netlib/LAPACKE/lapacke_dspgvx_work.c | 121 -
netlib/LAPACKE/lapacke_dsposv.c | 80 -
netlib/LAPACKE/lapacke_dsposv_work.c | 117 -
netlib/LAPACKE/lapacke_dsprfs.c | 87 -
netlib/LAPACKE/lapacke_dsprfs_work.c | 122 -
netlib/LAPACKE/lapacke_dspsv.c | 54 -
netlib/LAPACKE/lapacke_dspsv_work.c | 93 -
netlib/LAPACKE/lapacke_dspsvx.c | 87 -
netlib/LAPACKE/lapacke_dspsvx_work.c | 126 -
netlib/LAPACKE/lapacke_dsptrd.c | 50 -
netlib/LAPACKE/lapacke_dsptrd_work.c | 75 -
netlib/LAPACKE/lapacke_dsptrf.c | 50 -
netlib/LAPACKE/lapacke_dsptrf_work.c | 75 -
netlib/LAPACKE/lapacke_dsptri.c | 66 -
netlib/LAPACKE/lapacke_dsptri_work.c | 76 -
netlib/LAPACKE/lapacke_dsptrs.c | 54 -
netlib/LAPACKE/lapacke_dsptrs_work.c | 93 -
netlib/LAPACKE/lapacke_dst_nancheck.c | 43 -
netlib/LAPACKE/lapacke_dstebz.c | 90 -
netlib/LAPACKE/lapacke_dstebz_work.c | 48 -
netlib/LAPACKE/lapacke_dstedc.c | 95 -
netlib/LAPACKE/lapacke_dstedc_work.c | 99 -
netlib/LAPACKE/lapacke_dstegr.c | 108 -
netlib/LAPACKE/lapacke_dstegr_work.c | 102 -
netlib/LAPACKE/lapacke_dstein.c | 83 -
netlib/LAPACKE/lapacke_dstein_work.c | 85 -
netlib/LAPACKE/lapacke_dstemr.c | 102 -
netlib/LAPACKE/lapacke_dstemr_work.c | 102 -
netlib/LAPACKE/lapacke_dsteqr.c | 82 -
netlib/LAPACKE/lapacke_dsteqr_work.c | 90 -
netlib/LAPACKE/lapacke_dsterf.c | 48 -
netlib/LAPACKE/lapacke_dsterf_work.c | 42 -
netlib/LAPACKE/lapacke_dstev.c | 73 -
netlib/LAPACKE/lapacke_dstev_work.c | 86 -
netlib/LAPACKE/lapacke_dstevd.c | 90 -
netlib/LAPACKE/lapacke_dstevd_work.c | 95 -
netlib/LAPACKE/lapacke_dstevr.c | 108 -
netlib/LAPACKE/lapacke_dstevr_work.c | 106 -
netlib/LAPACKE/lapacke_dstevx.c | 94 -
netlib/LAPACKE/lapacke_dstevx_work.c | 96 -
netlib/LAPACKE/lapacke_dsy_nancheck.c | 43 -
netlib/LAPACKE/lapacke_dsy_trans.c | 45 -
netlib/LAPACKE/lapacke_dsycon.c | 79 -
netlib/LAPACKE/lapacke_dsycon_work.c | 83 -
netlib/LAPACKE/lapacke_dsyconv.c | 67 -
netlib/LAPACKE/lapacke_dsyconv_work.c | 82 -
netlib/LAPACKE/lapacke_dsyequb.c | 68 -
netlib/LAPACKE/lapacke_dsyequb_work.c | 80 -
netlib/LAPACKE/lapacke_dsyev.c | 76 -
netlib/LAPACKE/lapacke_dsyev_work.c | 87 -
netlib/LAPACKE/lapacke_dsyevd.c | 87 -
netlib/LAPACKE/lapacke_dsyevd_work.c | 91 -
netlib/LAPACKE/lapacke_dsyevr.c | 105 -
netlib/LAPACKE/lapacke_dsyevr_work.c | 124 -
netlib/LAPACKE/lapacke_dsyevx.c | 103 -
netlib/LAPACKE/lapacke_dsyevx_work.c | 123 -
netlib/LAPACKE/lapacke_dsygst.c | 54 -
netlib/LAPACKE/lapacke_dsygst_work.c | 97 -
netlib/LAPACKE/lapacke_dsygv.c | 80 -
netlib/LAPACKE/lapacke_dsygv_work.c | 107 -
netlib/LAPACKE/lapacke_dsygvd.c | 92 -
netlib/LAPACKE/lapacke_dsygvd_work.c | 108 -
netlib/LAPACKE/lapacke_dsygvx.c | 107 -
netlib/LAPACKE/lapacke_dsygvx_work.c | 140 -
netlib/LAPACKE/lapacke_dsyrfs.c | 88 -
netlib/LAPACKE/lapacke_dsyrfs_work.c | 133 -
netlib/LAPACKE/lapacke_dsysv.c | 80 -
netlib/LAPACKE/lapacke_dsysv_work.c | 107 -
netlib/LAPACKE/lapacke_dsysvx.c | 99 -
netlib/LAPACKE/lapacke_dsysvx_work.c | 148 -
netlib/LAPACKE/lapacke_dsyswapr.c | 50 -
netlib/LAPACKE/lapacke_dsyswapr_work.c | 72 -
netlib/LAPACKE/lapacke_dsytrd.c | 76 -
netlib/LAPACKE/lapacke_dsytrd_work.c | 88 -
netlib/LAPACKE/lapacke_dsytrf.c | 76 -
netlib/LAPACKE/lapacke_dsytrf_work.c | 87 -
netlib/LAPACKE/lapacke_dsytri.c | 66 -
netlib/LAPACKE/lapacke_dsytri2.c | 77 -
netlib/LAPACKE/lapacke_dsytri2_work.c | 88 -
netlib/LAPACKE/lapacke_dsytri2x.c | 68 -
netlib/LAPACKE/lapacke_dsytri2x_work.c | 83 -
netlib/LAPACKE/lapacke_dsytri_work.c | 82 -
netlib/LAPACKE/lapacke_dsytrs.c | 55 -
netlib/LAPACKE/lapacke_dsytrs2.c | 71 -
netlib/LAPACKE/lapacke_dsytrs2_work.c | 99 -
netlib/LAPACKE/lapacke_dsytrs_work.c | 99 -
netlib/LAPACKE/lapacke_dtb_nancheck.c | 84 -
netlib/LAPACKE/lapacke_dtb_trans.c | 89 -
netlib/LAPACKE/lapacke_dtbcon.c | 76 -
netlib/LAPACKE/lapacke_dtbcon_work.c | 84 -
netlib/LAPACKE/lapacke_dtbrfs.c | 85 -
netlib/LAPACKE/lapacke_dtbrfs_work.c | 117 -
netlib/LAPACKE/lapacke_dtbtrs.c | 56 -
netlib/LAPACKE/lapacke_dtbtrs_work.c | 101 -
netlib/LAPACKE/lapacke_dtf_nancheck.c | 157 -
netlib/LAPACKE/lapacke_dtf_trans.c | 89 -
netlib/LAPACKE/lapacke_dtfsm.c | 63 -
netlib/LAPACKE/lapacke_dtfsm_work.c | 102 -
netlib/LAPACKE/lapacke_dtftri.c | 50 -
netlib/LAPACKE/lapacke_dtftri_work.c | 75 -
netlib/LAPACKE/lapacke_dtfttp.c | 50 -
netlib/LAPACKE/lapacke_dtfttp_work.c | 84 -
netlib/LAPACKE/lapacke_dtfttr.c | 51 -
netlib/LAPACKE/lapacke_dtfttr_work.c | 91 -
netlib/LAPACKE/lapacke_dtgevc.c | 84 -
netlib/LAPACKE/lapacke_dtgevc_work.c | 155 -
netlib/LAPACKE/lapacke_dtgexc.c | 93 -
netlib/LAPACKE/lapacke_dtgexc_work.c | 158 -
netlib/LAPACKE/lapacke_dtgsen.c | 113 -
netlib/LAPACKE/lapacke_dtgsen_work.c | 165 -
netlib/LAPACKE/lapacke_dtgsja.c | 98 -
netlib/LAPACKE/lapacke_dtgsja_work.c | 180 -
netlib/LAPACKE/lapacke_dtgsna.c | 112 -
netlib/LAPACKE/lapacke_dtgsna_work.c | 155 -
netlib/LAPACKE/lapacke_dtgsyl.c | 107 -
netlib/LAPACKE/lapacke_dtgsyl_work.c | 174 -
netlib/LAPACKE/lapacke_dtp_nancheck.c | 83 -
netlib/LAPACKE/lapacke_dtp_trans.c | 85 -
netlib/LAPACKE/lapacke_dtpcon.c | 75 -
netlib/LAPACKE/lapacke_dtpcon_work.c | 75 -
netlib/LAPACKE/lapacke_dtpmqrt.c | 80 -
netlib/LAPACKE/lapacke_dtpmqrt_work.c | 134 -
netlib/LAPACKE/lapacke_dtpqrt.c | 72 -
netlib/LAPACKE/lapacke_dtpqrt2.c | 55 -
netlib/LAPACKE/lapacke_dtpqrt2_work.c | 114 -
netlib/LAPACKE/lapacke_dtpqrt_work.c | 116 -
netlib/LAPACKE/lapacke_dtprfb.c | 91 -
netlib/LAPACKE/lapacke_dtprfb_work.c | 134 -
netlib/LAPACKE/lapacke_dtprfs.c | 83 -
netlib/LAPACKE/lapacke_dtprfs_work.c | 110 -
netlib/LAPACKE/lapacke_dtptri.c | 50 -
netlib/LAPACKE/lapacke_dtptri_work.c | 75 -
netlib/LAPACKE/lapacke_dtptrs.c | 55 -
netlib/LAPACKE/lapacke_dtptrs_work.c | 93 -
netlib/LAPACKE/lapacke_dtpttf.c | 50 -
netlib/LAPACKE/lapacke_dtpttf_work.c | 84 -
netlib/LAPACKE/lapacke_dtpttr.c | 50 -
netlib/LAPACKE/lapacke_dtpttr_work.c | 90 -
netlib/LAPACKE/lapacke_dtr_nancheck.c | 85 -
netlib/LAPACKE/lapacke_dtr_trans.c | 85 -
netlib/LAPACKE/lapacke_dtrcon.c | 76 -
netlib/LAPACKE/lapacke_dtrcon_work.c | 83 -
netlib/LAPACKE/lapacke_dtrevc.c | 80 -
netlib/LAPACKE/lapacke_dtrevc_work.c | 139 -
netlib/LAPACKE/lapacke_dtrexc.c | 73 -
netlib/LAPACKE/lapacke_dtrexc_work.c | 108 -
netlib/LAPACKE/lapacke_dtrrfs.c | 84 -
netlib/LAPACKE/lapacke_dtrrfs_work.c | 115 -
netlib/LAPACKE/lapacke_dtrsen.c | 101 -
netlib/LAPACKE/lapacke_dtrsen_work.c | 121 -
netlib/LAPACKE/lapacke_dtrsna.c | 100 -
netlib/LAPACKE/lapacke_dtrsna_work.c | 132 -
netlib/LAPACKE/lapacke_dtrsyl.c | 60 -
netlib/LAPACKE/lapacke_dtrsyl_work.c | 116 -
netlib/LAPACKE/lapacke_dtrtri.c | 50 -
netlib/LAPACKE/lapacke_dtrtri_work.c | 82 -
netlib/LAPACKE/lapacke_dtrtrs.c | 55 -
netlib/LAPACKE/lapacke_dtrtrs_work.c | 100 -
netlib/LAPACKE/lapacke_dtrttf.c | 51 -
netlib/LAPACKE/lapacke_dtrttf_work.c | 91 -
netlib/LAPACKE/lapacke_dtrttp.c | 50 -
netlib/LAPACKE/lapacke_dtrttp_work.c | 90 -
netlib/LAPACKE/lapacke_dtzrzf.c | 75 -
netlib/LAPACKE/lapacke_dtzrzf_work.c | 87 -
netlib/LAPACKE/lapacke_ilaver.c | 43 -
netlib/LAPACKE/lapacke_lsame.c | 41 -
netlib/LAPACKE/lapacke_make_complex_double.c | 51 -
netlib/LAPACKE/lapacke_make_complex_float.c | 51 -
netlib/LAPACKE/lapacke_mangling.h | 17 -
netlib/LAPACKE/lapacke_mangling_with_flags.h | 17 -
netlib/LAPACKE/lapacke_s_nancheck.c | 51 -
netlib/LAPACKE/lapacke_sbbcsd.c | 114 -
netlib/LAPACKE/lapacke_sbbcsd_work.c | 198 -
netlib/LAPACKE/lapacke_sbdsdc.c | 92 -
netlib/LAPACKE/lapacke_sbdsdc_work.c | 111 -
netlib/LAPACKE/lapacke_sbdsqr.c | 87 -
netlib/LAPACKE/lapacke_sbdsqr_work.c | 144 -
netlib/LAPACKE/lapacke_sdisna.c | 46 -
netlib/LAPACKE/lapacke_sdisna_work.c | 43 -
netlib/LAPACKE/lapacke_sgb_nancheck.c | 64 -
netlib/LAPACKE/lapacke_sgb_trans.c | 67 -
netlib/LAPACKE/lapacke_sgbbrd.c | 75 -
netlib/LAPACKE/lapacke_sgbbrd_work.c | 154 -
netlib/LAPACKE/lapacke_sgbcon.c | 80 -
netlib/LAPACKE/lapacke_sgbcon_work.c | 85 -
netlib/LAPACKE/lapacke_sgbequ.c | 53 -
netlib/LAPACKE/lapacke_sgbequ_work.c | 83 -
netlib/LAPACKE/lapacke_sgbequb.c | 53 -
netlib/LAPACKE/lapacke_sgbequb_work.c | 83 -
netlib/LAPACKE/lapacke_sgbrfs.c | 89 -
netlib/LAPACKE/lapacke_sgbrfs_work.c | 136 -
netlib/LAPACKE/lapacke_sgbsv.c | 56 -
netlib/LAPACKE/lapacke_sgbsv_work.c | 102 -
netlib/LAPACKE/lapacke_sgbsvx.c | 105 -
netlib/LAPACKE/lapacke_sgbsvx_work.c | 151 -
netlib/LAPACKE/lapacke_sgbtrf.c | 51 -
netlib/LAPACKE/lapacke_sgbtrf_work.c | 84 -
netlib/LAPACKE/lapacke_sgbtrs.c | 56 -
netlib/LAPACKE/lapacke_sgbtrs_work.c | 102 -
netlib/LAPACKE/lapacke_sge_nancheck.c | 62 -
netlib/LAPACKE/lapacke_sge_trans.c | 65 -
netlib/LAPACKE/lapacke_sgebak.c | 55 -
netlib/LAPACKE/lapacke_sgebak_work.c | 84 -
netlib/LAPACKE/lapacke_sgebal.c | 54 -
netlib/LAPACKE/lapacke_sgebal_work.c | 94 -
netlib/LAPACKE/lapacke_sgebrd.c | 77 -
netlib/LAPACKE/lapacke_sgebrd_work.c | 90 -
netlib/LAPACKE/lapacke_sgecon.c | 79 -
netlib/LAPACKE/lapacke_sgecon_work.c | 81 -
netlib/LAPACKE/lapacke_sgeequ.c | 52 -
netlib/LAPACKE/lapacke_sgeequ_work.c | 81 -
netlib/LAPACKE/lapacke_sgeequb.c | 52 -
netlib/LAPACKE/lapacke_sgeequb_work.c | 82 -
netlib/LAPACKE/lapacke_sgees.c | 93 -
netlib/LAPACKE/lapacke_sgees_work.c | 114 -
netlib/LAPACKE/lapacke_sgeesx.c | 111 -
netlib/LAPACKE/lapacke_sgeesx_work.c | 119 -
netlib/LAPACKE/lapacke_sgeev.c | 78 -
netlib/LAPACKE/lapacke_sgeev_work.c | 134 -
netlib/LAPACKE/lapacke_sgeevx.c | 98 -
netlib/LAPACKE/lapacke_sgeevx_work.c | 140 -
netlib/LAPACKE/lapacke_sgehrd.c | 77 -
netlib/LAPACKE/lapacke_sgehrd_work.c | 88 -
netlib/LAPACKE/lapacke_sgejsv.c | 133 -
netlib/LAPACKE/lapacke_sgejsv_work.c | 147 -
netlib/LAPACKE/lapacke_sgelq2.c | 66 -
netlib/LAPACKE/lapacke_sgelq2_work.c | 82 -
netlib/LAPACKE/lapacke_sgelqf.c | 75 -
netlib/LAPACKE/lapacke_sgelqf_work.c | 87 -
netlib/LAPACKE/lapacke_sgels.c | 80 -
netlib/LAPACKE/lapacke_sgels_work.c | 108 -
netlib/LAPACKE/lapacke_sgelsd.c | 96 -
netlib/LAPACKE/lapacke_sgelsd_work.c | 109 -
netlib/LAPACKE/lapacke_sgelss.c | 84 -
netlib/LAPACKE/lapacke_sgelss_work.c | 109 -
netlib/LAPACKE/lapacke_sgelsy.c | 84 -
netlib/LAPACKE/lapacke_sgelsy_work.c | 109 -
netlib/LAPACKE/lapacke_sgemqrt.c | 76 -
netlib/LAPACKE/lapacke_sgemqrt_work.c | 116 -
netlib/LAPACKE/lapacke_sgeqlf.c | 75 -
netlib/LAPACKE/lapacke_sgeqlf_work.c | 87 -
netlib/LAPACKE/lapacke_sgeqp3.c | 77 -
netlib/LAPACKE/lapacke_sgeqp3_work.c | 87 -
netlib/LAPACKE/lapacke_sgeqpf.c | 67 -
netlib/LAPACKE/lapacke_sgeqpf_work.c | 82 -
netlib/LAPACKE/lapacke_sgeqr2.c | 66 -
netlib/LAPACKE/lapacke_sgeqr2_work.c | 82 -
netlib/LAPACKE/lapacke_sgeqrf.c | 75 -
netlib/LAPACKE/lapacke_sgeqrf_work.c | 87 -
netlib/LAPACKE/lapacke_sgeqrfp.c | 75 -
netlib/LAPACKE/lapacke_sgeqrfp_work.c | 87 -
netlib/LAPACKE/lapacke_sgeqrt.c | 67 -
netlib/LAPACKE/lapacke_sgeqrt2.c | 50 -
netlib/LAPACKE/lapacke_sgeqrt2_work.c | 97 -
netlib/LAPACKE/lapacke_sgeqrt3.c | 50 -
netlib/LAPACKE/lapacke_sgeqrt3_work.c | 97 -
netlib/LAPACKE/lapacke_sgeqrt_work.c | 98 -
netlib/LAPACKE/lapacke_sgerfs.c | 88 -
netlib/LAPACKE/lapacke_sgerfs_work.c | 133 -
netlib/LAPACKE/lapacke_sgerqf.c | 75 -
netlib/LAPACKE/lapacke_sgerqf_work.c | 87 -
netlib/LAPACKE/lapacke_sgesdd.c | 88 -
netlib/LAPACKE/lapacke_sgesdd_work.c | 152 -
netlib/LAPACKE/lapacke_sgesv.c | 54 -
netlib/LAPACKE/lapacke_sgesv_work.c | 98 -
netlib/LAPACKE/lapacke_sgesvd.c | 83 -
netlib/LAPACKE/lapacke_sgesvd_work.c | 143 -
netlib/LAPACKE/lapacke_sgesvj.c | 84 -
netlib/LAPACKE/lapacke_sgesvj_work.c | 113 -
netlib/LAPACKE/lapacke_sgesvx.c | 103 -
netlib/LAPACKE/lapacke_sgesvx_work.c | 147 -
netlib/LAPACKE/lapacke_sgetf2.c | 50 -
netlib/LAPACKE/lapacke_sgetf2_work.c | 81 -
netlib/LAPACKE/lapacke_sgetrf.c | 50 -
netlib/LAPACKE/lapacke_sgetrf_work.c | 81 -
netlib/LAPACKE/lapacke_sgetri.c | 75 -
netlib/LAPACKE/lapacke_sgetri_work.c | 87 -
netlib/LAPACKE/lapacke_sgetrs.c | 55 -
netlib/LAPACKE/lapacke_sgetrs_work.c | 99 -
netlib/LAPACKE/lapacke_sgg_nancheck.c | 43 -
netlib/LAPACKE/lapacke_sgg_trans.c | 45 -
netlib/LAPACKE/lapacke_sggbak.c | 59 -
netlib/LAPACKE/lapacke_sggbak_work.c | 85 -
netlib/LAPACKE/lapacke_sggbal.c | 86 -
netlib/LAPACKE/lapacke_sggbal_work.c | 126 -
netlib/LAPACKE/lapacke_sgges.c | 99 -
netlib/LAPACKE/lapacke_sgges_work.c | 160 -
netlib/LAPACKE/lapacke_sggesx.c | 114 -
netlib/LAPACKE/lapacke_sggesx_work.c | 165 -
netlib/LAPACKE/lapacke_sggev.c | 84 -
netlib/LAPACKE/lapacke_sggev_work.c | 161 -
netlib/LAPACKE/lapacke_sggevx.c | 120 -
netlib/LAPACKE/lapacke_sggevx_work.c | 161 -
netlib/LAPACKE/lapacke_sggglm.c | 83 -
netlib/LAPACKE/lapacke_sggglm_work.c | 107 -
netlib/LAPACKE/lapacke_sgghrd.c | 66 -
netlib/LAPACKE/lapacke_sgghrd_work.c | 150 -
netlib/LAPACKE/lapacke_sgglse.c | 86 -
netlib/LAPACKE/lapacke_sgglse_work.c | 107 -
netlib/LAPACKE/lapacke_sggqrf.c | 80 -
netlib/LAPACKE/lapacke_sggqrf_work.c | 107 -
netlib/LAPACKE/lapacke_sggrqf.c | 80 -
netlib/LAPACKE/lapacke_sggrqf_work.c | 107 -
netlib/LAPACKE/lapacke_sggsvd.c | 76 -
netlib/LAPACKE/lapacke_sggsvd_work.c | 170 -
netlib/LAPACKE/lapacke_sggsvp.c | 97 -
netlib/LAPACKE/lapacke_sggsvp_work.c | 170 -
netlib/LAPACKE/lapacke_sgt_nancheck.c | 45 -
netlib/LAPACKE/lapacke_sgtcon.c | 84 -
netlib/LAPACKE/lapacke_sgtcon_work.c | 47 -
netlib/LAPACKE/lapacke_sgtrfs.c | 105 -
netlib/LAPACKE/lapacke_sgtrfs_work.c | 106 -
netlib/LAPACKE/lapacke_sgtsv.c | 60 -
netlib/LAPACKE/lapacke_sgtsv_work.c | 82 -
netlib/LAPACKE/lapacke_sgtsvx.c | 110 -
netlib/LAPACKE/lapacke_sgtsvx_work.c | 105 -
netlib/LAPACKE/lapacke_sgttrf.c | 52 -
netlib/LAPACKE/lapacke_sgttrf_work.c | 43 -
netlib/LAPACKE/lapacke_sgttrs.c | 65 -
netlib/LAPACKE/lapacke_sgttrs_work.c | 86 -
netlib/LAPACKE/lapacke_shgeqz.c | 94 -
netlib/LAPACKE/lapacke_shgeqz_work.c | 161 -
netlib/LAPACKE/lapacke_shs_nancheck.c | 57 -
netlib/LAPACKE/lapacke_shs_trans.c | 59 -
netlib/LAPACKE/lapacke_shsein.c | 88 -
netlib/LAPACKE/lapacke_shsein_work.c | 140 -
netlib/LAPACKE/lapacke_shseqr.c | 83 -
netlib/LAPACKE/lapacke_shseqr_work.c | 116 -
netlib/LAPACKE/lapacke_slacpy.c | 51 -
netlib/LAPACKE/lapacke_slacpy_work.c | 94 -
netlib/LAPACKE/lapacke_slag2d.c | 51 -
netlib/LAPACKE/lapacke_slag2d_work.c | 96 -
netlib/LAPACKE/lapacke_slagge.c | 68 -
netlib/LAPACKE/lapacke_slagge_work.c | 81 -
netlib/LAPACKE/lapacke_slagsy.c | 67 -
netlib/LAPACKE/lapacke_slagsy_work.c | 80 -
netlib/LAPACKE/lapacke_slamch.c | 39 -
netlib/LAPACKE/lapacke_slamch_work.c | 43 -
netlib/LAPACKE/lapacke_slange.c | 71 -
netlib/LAPACKE/lapacke_slange_work.c | 79 -
netlib/LAPACKE/lapacke_slansy.c | 73 -
netlib/LAPACKE/lapacke_slansy_work.c | 79 -
netlib/LAPACKE/lapacke_slantr.c | 75 -
netlib/LAPACKE/lapacke_slantr_work.c | 79 -
netlib/LAPACKE/lapacke_slapmr.c | 51 -
netlib/LAPACKE/lapacke_slapmr_work.c | 80 -
netlib/LAPACKE/lapacke_slapy2.c | 48 -
netlib/LAPACKE/lapacke_slapy2_work.c | 42 -
netlib/LAPACKE/lapacke_slapy3.c | 51 -
netlib/LAPACKE/lapacke_slapy3_work.c | 42 -
netlib/LAPACKE/lapacke_slarfb.c | 118 -
netlib/LAPACKE/lapacke_slarfb_work.c | 154 -
netlib/LAPACKE/lapacke_slarfg.c | 49 -
netlib/LAPACKE/lapacke_slarfg_work.c | 43 -
netlib/LAPACKE/lapacke_slarft.c | 61 -
netlib/LAPACKE/lapacke_slarft_work.c | 101 -
netlib/LAPACKE/lapacke_slarfx.c | 58 -
netlib/LAPACKE/lapacke_slarfx_work.c | 80 -
netlib/LAPACKE/lapacke_slarnv.c | 40 -
netlib/LAPACKE/lapacke_slarnv_work.c | 43 -
netlib/LAPACKE/lapacke_slartgp.c | 48 -
netlib/LAPACKE/lapacke_slartgp_work.c | 43 -
netlib/LAPACKE/lapacke_slartgs.c | 52 -
netlib/LAPACKE/lapacke_slartgs_work.c | 43 -
netlib/LAPACKE/lapacke_slaset.c | 57 -
netlib/LAPACKE/lapacke_slaset_work.c | 80 -
netlib/LAPACKE/lapacke_slasrt.c | 45 -
netlib/LAPACKE/lapacke_slasrt_work.c | 42 -
netlib/LAPACKE/lapacke_slaswp.c | 51 -
netlib/LAPACKE/lapacke_slaswp_work.c | 80 -
netlib/LAPACKE/lapacke_slatms.c | 79 -
netlib/LAPACKE/lapacke_slatms_work.c | 87 -
netlib/LAPACKE/lapacke_slauum.c | 50 -
netlib/LAPACKE/lapacke_slauum_work.c | 81 -
netlib/LAPACKE/lapacke_sopgtr.c | 70 -
netlib/LAPACKE/lapacke_sopgtr_work.c | 91 -
netlib/LAPACKE/lapacke_sopmtr.c | 86 -
netlib/LAPACKE/lapacke_sopmtr_work.c | 97 -
netlib/LAPACKE/lapacke_sorbdb.c | 98 -
netlib/LAPACKE/lapacke_sorbdb_work.c | 158 -
netlib/LAPACKE/lapacke_sorcsd.c | 112 -
netlib/LAPACKE/lapacke_sorcsd_work.c | 261 -
netlib/LAPACKE/lapacke_sorgbr.c | 80 -
netlib/LAPACKE/lapacke_sorgbr_work.c | 90 -
netlib/LAPACKE/lapacke_sorghr.c | 80 -
netlib/LAPACKE/lapacke_sorghr_work.c | 89 -
netlib/LAPACKE/lapacke_sorglq.c | 80 -
netlib/LAPACKE/lapacke_sorglq_work.c | 88 -
netlib/LAPACKE/lapacke_sorgql.c | 80 -
netlib/LAPACKE/lapacke_sorgql_work.c | 88 -
netlib/LAPACKE/lapacke_sorgqr.c | 80 -
netlib/LAPACKE/lapacke_sorgqr_work.c | 88 -
netlib/LAPACKE/lapacke_sorgrq.c | 80 -
netlib/LAPACKE/lapacke_sorgrq_work.c | 88 -
netlib/LAPACKE/lapacke_sorgtr.c | 79 -
netlib/LAPACKE/lapacke_sorgtr_work.c | 87 -
netlib/LAPACKE/lapacke_sormbr.c | 87 -
netlib/LAPACKE/lapacke_sormbr_work.c | 111 -
netlib/LAPACKE/lapacke_sormhr.c | 86 -
netlib/LAPACKE/lapacke_sormhr_work.c | 109 -
netlib/LAPACKE/lapacke_sormlq.c | 84 -
netlib/LAPACKE/lapacke_sormlq_work.c | 107 -
netlib/LAPACKE/lapacke_sormql.c | 86 -
netlib/LAPACKE/lapacke_sormql_work.c | 109 -
netlib/LAPACKE/lapacke_sormqr.c | 86 -
netlib/LAPACKE/lapacke_sormqr_work.c | 109 -
netlib/LAPACKE/lapacke_sormrq.c | 84 -
netlib/LAPACKE/lapacke_sormrq_work.c | 107 -
netlib/LAPACKE/lapacke_sormrz.c | 84 -
netlib/LAPACKE/lapacke_sormrz_work.c | 107 -
netlib/LAPACKE/lapacke_sormtr.c | 86 -
netlib/LAPACKE/lapacke_sormtr_work.c | 108 -
netlib/LAPACKE/lapacke_spb_nancheck.c | 48 -
netlib/LAPACKE/lapacke_spb_trans.c | 50 -
netlib/LAPACKE/lapacke_spbcon.c | 79 -
netlib/LAPACKE/lapacke_spbcon_work.c | 83 -
netlib/LAPACKE/lapacke_spbequ.c | 52 -
netlib/LAPACKE/lapacke_spbequ_work.c | 80 -
netlib/LAPACKE/lapacke_spbrfs.c | 88 -
netlib/LAPACKE/lapacke_spbrfs_work.c | 135 -
netlib/LAPACKE/lapacke_spbstf.c | 50 -
netlib/LAPACKE/lapacke_spbstf_work.c | 82 -
netlib/LAPACKE/lapacke_spbsv.c | 55 -
netlib/LAPACKE/lapacke_spbsv_work.c | 100 -
netlib/LAPACKE/lapacke_spbsvx.c | 93 -
netlib/LAPACKE/lapacke_spbsvx_work.c | 146 -
netlib/LAPACKE/lapacke_spbtrf.c | 50 -
netlib/LAPACKE/lapacke_spbtrf_work.c | 82 -
netlib/LAPACKE/lapacke_spbtrs.c | 55 -
netlib/LAPACKE/lapacke_spbtrs_work.c | 98 -
netlib/LAPACKE/lapacke_spf_nancheck.c | 46 -
netlib/LAPACKE/lapacke_spf_trans.c | 45 -
netlib/LAPACKE/lapacke_spftrf.c | 50 -
netlib/LAPACKE/lapacke_spftrf_work.c | 75 -
netlib/LAPACKE/lapacke_spftri.c | 50 -
netlib/LAPACKE/lapacke_spftri_work.c | 75 -
netlib/LAPACKE/lapacke_spftrs.c | 55 -
netlib/LAPACKE/lapacke_spftrs_work.c | 92 -
netlib/LAPACKE/lapacke_spo_nancheck.c | 43 -
netlib/LAPACKE/lapacke_spo_trans.c | 45 -
netlib/LAPACKE/lapacke_spocon.c | 79 -
netlib/LAPACKE/lapacke_spocon_work.c | 81 -
netlib/LAPACKE/lapacke_spoequ.c | 50 -
netlib/LAPACKE/lapacke_spoequ_work.c | 80 -
netlib/LAPACKE/lapacke_spoequb.c | 51 -
netlib/LAPACKE/lapacke_spoequb_work.c | 80 -
netlib/LAPACKE/lapacke_sporfs.c | 87 -
netlib/LAPACKE/lapacke_sporfs_work.c | 132 -
netlib/LAPACKE/lapacke_sposv.c | 54 -
netlib/LAPACKE/lapacke_sposv_work.c | 98 -
netlib/LAPACKE/lapacke_sposvx.c | 92 -
netlib/LAPACKE/lapacke_sposvx_work.c | 143 -
netlib/LAPACKE/lapacke_spotrf.c | 50 -
netlib/LAPACKE/lapacke_spotrf_work.c | 81 -
netlib/LAPACKE/lapacke_spotri.c | 50 -
netlib/LAPACKE/lapacke_spotri_work.c | 81 -
netlib/LAPACKE/lapacke_spotrs.c | 54 -
netlib/LAPACKE/lapacke_spotrs_work.c | 97 -
netlib/LAPACKE/lapacke_spp_nancheck.c | 45 -
netlib/LAPACKE/lapacke_spp_trans.c | 45 -
netlib/LAPACKE/lapacke_sppcon.c | 78 -
netlib/LAPACKE/lapacke_sppcon_work.c | 74 -
netlib/LAPACKE/lapacke_sppequ.c | 51 -
netlib/LAPACKE/lapacke_sppequ_work.c | 74 -
netlib/LAPACKE/lapacke_spprfs.c | 86 -
netlib/LAPACKE/lapacke_spprfs_work.c | 122 -
netlib/LAPACKE/lapacke_sppsv.c | 53 -
netlib/LAPACKE/lapacke_sppsv_work.c | 93 -
netlib/LAPACKE/lapacke_sppsvx.c | 92 -
netlib/LAPACKE/lapacke_sppsvx_work.c | 131 -
netlib/LAPACKE/lapacke_spptrf.c | 50 -
netlib/LAPACKE/lapacke_spptrf_work.c | 75 -
netlib/LAPACKE/lapacke_spptri.c | 50 -
netlib/LAPACKE/lapacke_spptri_work.c | 75 -
netlib/LAPACKE/lapacke_spptrs.c | 54 -
netlib/LAPACKE/lapacke_spptrs_work.c | 92 -
netlib/LAPACKE/lapacke_spstrf.c | 71 -
netlib/LAPACKE/lapacke_spstrf_work.c | 82 -
netlib/LAPACKE/lapacke_spt_nancheck.c | 43 -
netlib/LAPACKE/lapacke_sptcon.c | 68 -
netlib/LAPACKE/lapacke_sptcon_work.c | 43 -
netlib/LAPACKE/lapacke_spteqr.c | 82 -
netlib/LAPACKE/lapacke_spteqr_work.c | 84 -
netlib/LAPACKE/lapacke_sptrfs.c | 84 -
netlib/LAPACKE/lapacke_sptrfs_work.c | 101 -
netlib/LAPACKE/lapacke_sptsv.c | 56 -
netlib/LAPACKE/lapacke_sptsv_work.c | 81 -
netlib/LAPACKE/lapacke_sptsvx.c | 86 -
netlib/LAPACKE/lapacke_sptsvx_work.c | 101 -
netlib/LAPACKE/lapacke_spttrf.c | 48 -
netlib/LAPACKE/lapacke_spttrf_work.c | 42 -
netlib/LAPACKE/lapacke_spttrs.c | 57 -
netlib/LAPACKE/lapacke_spttrs_work.c | 82 -
netlib/LAPACKE/lapacke_ssb_nancheck.c | 48 -
netlib/LAPACKE/lapacke_ssb_trans.c | 50 -
netlib/LAPACKE/lapacke_ssbev.c | 68 -
netlib/LAPACKE/lapacke_ssbev_work.c | 107 -
netlib/LAPACKE/lapacke_ssbevd.c | 88 -
netlib/LAPACKE/lapacke_ssbevd_work.c | 114 -
netlib/LAPACKE/lapacke_ssbevx.c | 93 -
netlib/LAPACKE/lapacke_ssbevx_work.c | 139 -
netlib/LAPACKE/lapacke_ssbgst.c | 72 -
netlib/LAPACKE/lapacke_ssbgst_work.c | 123 -
netlib/LAPACKE/lapacke_ssbgv.c | 72 -
netlib/LAPACKE/lapacke_ssbgv_work.c | 125 -
netlib/LAPACKE/lapacke_ssbgvd.c | 94 -
netlib/LAPACKE/lapacke_ssbgvd_work.c | 132 -
netlib/LAPACKE/lapacke_ssbgvx.c | 97 -
netlib/LAPACKE/lapacke_ssbgvx_work.c | 152 -
netlib/LAPACKE/lapacke_ssbtrd.c | 73 -
netlib/LAPACKE/lapacke_ssbtrd_work.c | 110 -
netlib/LAPACKE/lapacke_ssfrk.c | 64 -
netlib/LAPACKE/lapacke_ssfrk_work.c | 95 -
netlib/LAPACKE/lapacke_ssp_nancheck.c | 45 -
netlib/LAPACKE/lapacke_ssp_trans.c | 46 -
netlib/LAPACKE/lapacke_sspcon.c | 79 -
netlib/LAPACKE/lapacke_sspcon_work.c | 76 -
netlib/LAPACKE/lapacke_sspev.c | 67 -
netlib/LAPACKE/lapacke_sspev_work.c | 98 -
netlib/LAPACKE/lapacke_sspevd.c | 87 -
netlib/LAPACKE/lapacke_sspevd_work.c | 107 -
netlib/LAPACKE/lapacke_sspevx.c | 92 -
netlib/LAPACKE/lapacke_sspevx_work.c | 108 -
netlib/LAPACKE/lapacke_sspgst.c | 53 -
netlib/LAPACKE/lapacke_sspgst_work.c | 85 -
netlib/LAPACKE/lapacke_sspgv.c | 71 -
netlib/LAPACKE/lapacke_sspgv_work.c | 111 -
netlib/LAPACKE/lapacke_sspgvd.c | 92 -
netlib/LAPACKE/lapacke_sspgvd_work.c | 119 -
netlib/LAPACKE/lapacke_sspgvx.c | 95 -
netlib/LAPACKE/lapacke_sspgvx_work.c | 120 -
netlib/LAPACKE/lapacke_ssprfs.c | 87 -
netlib/LAPACKE/lapacke_ssprfs_work.c | 122 -
netlib/LAPACKE/lapacke_sspsv.c | 54 -
netlib/LAPACKE/lapacke_sspsv_work.c | 93 -
netlib/LAPACKE/lapacke_sspsvx.c | 87 -
netlib/LAPACKE/lapacke_sspsvx_work.c | 126 -
netlib/LAPACKE/lapacke_ssptrd.c | 50 -
netlib/LAPACKE/lapacke_ssptrd_work.c | 75 -
netlib/LAPACKE/lapacke_ssptrf.c | 50 -
netlib/LAPACKE/lapacke_ssptrf_work.c | 75 -
netlib/LAPACKE/lapacke_ssptri.c | 66 -
netlib/LAPACKE/lapacke_ssptri_work.c | 75 -
netlib/LAPACKE/lapacke_ssptrs.c | 54 -
netlib/LAPACKE/lapacke_ssptrs_work.c | 93 -
netlib/LAPACKE/lapacke_sst_nancheck.c | 43 -
netlib/LAPACKE/lapacke_sstebz.c | 90 -
netlib/LAPACKE/lapacke_sstebz_work.c | 48 -
netlib/LAPACKE/lapacke_sstedc.c | 95 -
netlib/LAPACKE/lapacke_sstedc_work.c | 99 -
netlib/LAPACKE/lapacke_sstegr.c | 108 -
netlib/LAPACKE/lapacke_sstegr_work.c | 102 -
netlib/LAPACKE/lapacke_sstein.c | 83 -
netlib/LAPACKE/lapacke_sstein_work.c | 85 -
netlib/LAPACKE/lapacke_sstemr.c | 101 -
netlib/LAPACKE/lapacke_sstemr_work.c | 102 -
netlib/LAPACKE/lapacke_ssteqr.c | 82 -
netlib/LAPACKE/lapacke_ssteqr_work.c | 90 -
netlib/LAPACKE/lapacke_ssterf.c | 48 -
netlib/LAPACKE/lapacke_ssterf_work.c | 42 -
netlib/LAPACKE/lapacke_sstev.c | 73 -
netlib/LAPACKE/lapacke_sstev_work.c | 86 -
netlib/LAPACKE/lapacke_sstevd.c | 90 -
netlib/LAPACKE/lapacke_sstevd_work.c | 95 -
netlib/LAPACKE/lapacke_sstevr.c | 108 -
netlib/LAPACKE/lapacke_sstevr_work.c | 106 -
netlib/LAPACKE/lapacke_sstevx.c | 94 -
netlib/LAPACKE/lapacke_sstevx_work.c | 96 -
netlib/LAPACKE/lapacke_ssy_nancheck.c | 43 -
netlib/LAPACKE/lapacke_ssy_trans.c | 45 -
netlib/LAPACKE/lapacke_ssycon.c | 79 -
netlib/LAPACKE/lapacke_ssycon_work.c | 83 -
netlib/LAPACKE/lapacke_ssyconv.c | 67 -
netlib/LAPACKE/lapacke_ssyconv_work.c | 82 -
netlib/LAPACKE/lapacke_ssyequb.c | 68 -
netlib/LAPACKE/lapacke_ssyequb_work.c | 80 -
netlib/LAPACKE/lapacke_ssyev.c | 76 -
netlib/LAPACKE/lapacke_ssyev_work.c | 87 -
netlib/LAPACKE/lapacke_ssyevd.c | 87 -
netlib/LAPACKE/lapacke_ssyevd_work.c | 91 -
netlib/LAPACKE/lapacke_ssyevr.c | 105 -
netlib/LAPACKE/lapacke_ssyevr_work.c | 124 -
netlib/LAPACKE/lapacke_ssyevx.c | 103 -
netlib/LAPACKE/lapacke_ssyevx_work.c | 123 -
netlib/LAPACKE/lapacke_ssygst.c | 54 -
netlib/LAPACKE/lapacke_ssygst_work.c | 97 -
netlib/LAPACKE/lapacke_ssygv.c | 80 -
netlib/LAPACKE/lapacke_ssygv_work.c | 107 -
netlib/LAPACKE/lapacke_ssygvd.c | 92 -
netlib/LAPACKE/lapacke_ssygvd_work.c | 108 -
netlib/LAPACKE/lapacke_ssygvx.c | 107 -
netlib/LAPACKE/lapacke_ssygvx_work.c | 140 -
netlib/LAPACKE/lapacke_ssyrfs.c | 88 -
netlib/LAPACKE/lapacke_ssyrfs_work.c | 133 -
netlib/LAPACKE/lapacke_ssysv.c | 80 -
netlib/LAPACKE/lapacke_ssysv_work.c | 107 -
netlib/LAPACKE/lapacke_ssysvx.c | 99 -
netlib/LAPACKE/lapacke_ssysvx_work.c | 148 -
netlib/LAPACKE/lapacke_ssyswapr.c | 50 -
netlib/LAPACKE/lapacke_ssyswapr_work.c | 72 -
netlib/LAPACKE/lapacke_ssytrd.c | 76 -
netlib/LAPACKE/lapacke_ssytrd_work.c | 88 -
netlib/LAPACKE/lapacke_ssytrf.c | 76 -
netlib/LAPACKE/lapacke_ssytrf_work.c | 87 -
netlib/LAPACKE/lapacke_ssytri.c | 66 -
netlib/LAPACKE/lapacke_ssytri2.c | 77 -
netlib/LAPACKE/lapacke_ssytri2_work.c | 88 -
netlib/LAPACKE/lapacke_ssytri2x.c | 68 -
netlib/LAPACKE/lapacke_ssytri2x_work.c | 83 -
netlib/LAPACKE/lapacke_ssytri_work.c | 82 -
netlib/LAPACKE/lapacke_ssytrs.c | 55 -
netlib/LAPACKE/lapacke_ssytrs2.c | 71 -
netlib/LAPACKE/lapacke_ssytrs2_work.c | 99 -
netlib/LAPACKE/lapacke_ssytrs_work.c | 99 -
netlib/LAPACKE/lapacke_stb_nancheck.c | 84 -
netlib/LAPACKE/lapacke_stb_trans.c | 89 -
netlib/LAPACKE/lapacke_stbcon.c | 76 -
netlib/LAPACKE/lapacke_stbcon_work.c | 84 -
netlib/LAPACKE/lapacke_stbrfs.c | 85 -
netlib/LAPACKE/lapacke_stbrfs_work.c | 116 -
netlib/LAPACKE/lapacke_stbtrs.c | 56 -
netlib/LAPACKE/lapacke_stbtrs_work.c | 101 -
netlib/LAPACKE/lapacke_stf_nancheck.c | 158 -
netlib/LAPACKE/lapacke_stf_trans.c | 89 -
netlib/LAPACKE/lapacke_stfsm.c | 63 -
netlib/LAPACKE/lapacke_stfsm_work.c | 101 -
netlib/LAPACKE/lapacke_stftri.c | 50 -
netlib/LAPACKE/lapacke_stftri_work.c | 75 -
netlib/LAPACKE/lapacke_stfttp.c | 50 -
netlib/LAPACKE/lapacke_stfttp_work.c | 84 -
netlib/LAPACKE/lapacke_stfttr.c | 51 -
netlib/LAPACKE/lapacke_stfttr_work.c | 91 -
netlib/LAPACKE/lapacke_stgevc.c | 84 -
netlib/LAPACKE/lapacke_stgevc_work.c | 153 -
netlib/LAPACKE/lapacke_stgexc.c | 93 -
netlib/LAPACKE/lapacke_stgexc_work.c | 158 -
netlib/LAPACKE/lapacke_stgsen.c | 113 -
netlib/LAPACKE/lapacke_stgsen_work.c | 165 -
netlib/LAPACKE/lapacke_stgsja.c | 97 -
netlib/LAPACKE/lapacke_stgsja_work.c | 180 -
netlib/LAPACKE/lapacke_stgsna.c | 112 -
netlib/LAPACKE/lapacke_stgsna_work.c | 152 -
netlib/LAPACKE/lapacke_stgsyl.c | 106 -
netlib/LAPACKE/lapacke_stgsyl_work.c | 174 -
netlib/LAPACKE/lapacke_stp_nancheck.c | 83 -
netlib/LAPACKE/lapacke_stp_trans.c | 85 -
netlib/LAPACKE/lapacke_stpcon.c | 75 -
netlib/LAPACKE/lapacke_stpcon_work.c | 75 -
netlib/LAPACKE/lapacke_stpmqrt.c | 79 -
netlib/LAPACKE/lapacke_stpmqrt_work.c | 134 -
netlib/LAPACKE/lapacke_stpqrt2.c | 55 -
netlib/LAPACKE/lapacke_stpqrt2_work.c | 114 -
netlib/LAPACKE/lapacke_stprfb.c | 91 -
netlib/LAPACKE/lapacke_stprfb_work.c | 134 -
netlib/LAPACKE/lapacke_stprfs.c | 83 -
netlib/LAPACKE/lapacke_stprfs_work.c | 109 -
netlib/LAPACKE/lapacke_stptri.c | 50 -
netlib/LAPACKE/lapacke_stptri_work.c | 75 -
netlib/LAPACKE/lapacke_stptrs.c | 55 -
netlib/LAPACKE/lapacke_stptrs_work.c | 93 -
netlib/LAPACKE/lapacke_stpttf.c | 50 -
netlib/LAPACKE/lapacke_stpttf_work.c | 84 -
netlib/LAPACKE/lapacke_stpttr.c | 50 -
netlib/LAPACKE/lapacke_stpttr_work.c | 90 -
netlib/LAPACKE/lapacke_str_nancheck.c | 85 -
netlib/LAPACKE/lapacke_str_trans.c | 85 -
netlib/LAPACKE/lapacke_strcon.c | 76 -
netlib/LAPACKE/lapacke_strcon_work.c | 83 -
netlib/LAPACKE/lapacke_strevc.c | 80 -
netlib/LAPACKE/lapacke_strevc_work.c | 137 -
netlib/LAPACKE/lapacke_strexc.c | 73 -
netlib/LAPACKE/lapacke_strexc_work.c | 108 -
netlib/LAPACKE/lapacke_strrfs.c | 84 -
netlib/LAPACKE/lapacke_strrfs_work.c | 115 -
netlib/LAPACKE/lapacke_strsen.c | 100 -
netlib/LAPACKE/lapacke_strsen_work.c | 121 -
netlib/LAPACKE/lapacke_strsna.c | 99 -
netlib/LAPACKE/lapacke_strsna_work.c | 129 -
netlib/LAPACKE/lapacke_strsyl.c | 60 -
netlib/LAPACKE/lapacke_strsyl_work.c | 116 -
netlib/LAPACKE/lapacke_strtri.c | 50 -
netlib/LAPACKE/lapacke_strtri_work.c | 82 -
netlib/LAPACKE/lapacke_strtrs.c | 55 -
netlib/LAPACKE/lapacke_strtrs_work.c | 100 -
netlib/LAPACKE/lapacke_strttf.c | 51 -
netlib/LAPACKE/lapacke_strttf_work.c | 91 -
netlib/LAPACKE/lapacke_strttp.c | 50 -
netlib/LAPACKE/lapacke_strttp_work.c | 90 -
netlib/LAPACKE/lapacke_stzrzf.c | 75 -
netlib/LAPACKE/lapacke_stzrzf_work.c | 87 -
netlib/LAPACKE/lapacke_utils.h | 579 -
netlib/LAPACKE/lapacke_xerbla.c | 46 -
netlib/README | 39 -
netlib/symbol.map | 1 -
perf/logging.properties | 9 -
perf/pom.xml | 86 -
perf/results/linux-arm-avian-ddot-f2jblas.csv.gz | Bin 588 -> 0 bytes
perf/results/linux-arm-avian-dgemm-f2jblas.csv.gz | Bin 970 -> 0 bytes
perf/results/linux-arm-avian-dgetri-f2jblas.csv.gz | Bin 990 -> 0 bytes
.../results/linux-arm-avian-linpack-f2jblas.csv.gz | Bin 147 -> 0 bytes
perf/results/linux-arm-ddot-CBLAS.csv.gz | Bin 1798 -> 0 bytes
perf/results/linux-arm-ddot-atlas.csv.gz | Bin 1673 -> 0 bytes
perf/results/linux-arm-ddot-nativerefblas.csv.gz | Bin 1957 -> 0 bytes
.../results/linux-arm-ddot-nativesystemblas.csv.gz | Bin 2049 -> 0 bytes
perf/results/linux-arm-dgemm-CBLAS.csv.gz | Bin 2301 -> 0 bytes
perf/results/linux-arm-dgemm-atlas.csv.gz | Bin 2284 -> 0 bytes
perf/results/linux-arm-dgemm-nativerefblas.csv.gz | Bin 2634 -> 0 bytes
.../linux-arm-dgemm-nativesystemblas.csv.gz | Bin 2501 -> 0 bytes
perf/results/linux-arm-dgetri-CBLAS.csv.gz | Bin 2440 -> 0 bytes
perf/results/linux-arm-dgetri-atlas.csv.gz | Bin 2555 -> 0 bytes
perf/results/linux-arm-dgetri-nativerefblas.csv.gz | Bin 2638 -> 0 bytes
.../linux-arm-dgetri-nativesystemblas.csv.gz | Bin 2682 -> 0 bytes
perf/results/linux-arm-jamvm-ddot-f2jblas.csv.gz | Bin 2463 -> 0 bytes
perf/results/linux-arm-jamvm-dgemm-f2jblas.csv.gz | Bin 3114 -> 0 bytes
perf/results/linux-arm-jamvm-dgetri-f2jblas.csv.gz | Bin 3477 -> 0 bytes
.../results/linux-arm-jamvm-linpack-f2jblas.csv.gz | Bin 393 -> 0 bytes
perf/results/linux-arm-jdk7-ddot-f2jblas.csv.gz | Bin 2272 -> 0 bytes
perf/results/linux-arm-jdk7-dgemm-f2jblas.csv.gz | Bin 3407 -> 0 bytes
perf/results/linux-arm-jdk7-dgetri-f2jblas.csv.gz | Bin 3673 -> 0 bytes
perf/results/linux-arm-jdk7-linpack-f2jblas.csv.gz | Bin 402 -> 0 bytes
perf/results/linux-arm-jdk8-ddot-f2jblas.csv.gz | Bin 1858 -> 0 bytes
perf/results/linux-arm-jdk8-dgemm-f2jblas.csv.gz | Bin 2682 -> 0 bytes
perf/results/linux-arm-jdk8-dgetri-f2jblas.csv.gz | Bin 2984 -> 0 bytes
perf/results/linux-arm-jdk8-linpack-f2jblas.csv.gz | Bin 352 -> 0 bytes
.../results/linux-arm-linpack-nativerefblas.csv.gz | Bin 393 -> 0 bytes
.../linux-arm-linpack-nativesystemblas.csv.gz | Bin 389 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-CBLAS.csv.gz | Bin 1762 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-atlas.csv.gz | Bin 1888 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-cuda.csv.gz | Bin 3300 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-cuda_nooh.csv.gz | Bin 2695 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-f2jblas.csv.gz | Bin 1699 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-mkl.csv.gz | Bin 1905 -> 0 bytes
.../mac_os_x-x86_64-ddot-nativerefblas.csv.gz | Bin 1671 -> 0 bytes
.../mac_os_x-x86_64-ddot-nativesystemblas.csv.gz | Bin 1669 -> 0 bytes
perf/results/mac_os_x-x86_64-ddot-veclib.csv.gz | Bin 1854 -> 0 bytes
perf/results/mac_os_x-x86_64-dgemm-CBLAS.csv.gz | Bin 2421 -> 0 bytes
perf/results/mac_os_x-x86_64-dgemm-atlas.csv.gz | Bin 2449 -> 0 bytes
perf/results/mac_os_x-x86_64-dgemm-cuda.csv.gz | Bin 3572 -> 0 bytes
.../results/mac_os_x-x86_64-dgemm-cuda_nooh.csv.gz | Bin 1866 -> 0 bytes
perf/results/mac_os_x-x86_64-dgemm-f2jblas.csv.gz | Bin 2574 -> 0 bytes
perf/results/mac_os_x-x86_64-dgemm-mkl.csv.gz | Bin 2388 -> 0 bytes
.../mac_os_x-x86_64-dgemm-nativerefblas.csv.gz | Bin 2469 -> 0 bytes
.../mac_os_x-x86_64-dgemm-nativesystemblas.csv.gz | Bin 2507 -> 0 bytes
perf/results/mac_os_x-x86_64-dgemm-veclib.csv.gz | Bin 2524 -> 0 bytes
perf/results/mac_os_x-x86_64-dgetri-CBLAS.csv.gz | Bin 2478 -> 0 bytes
perf/results/mac_os_x-x86_64-dgetri-atlas.csv.gz | Bin 2603 -> 0 bytes
perf/results/mac_os_x-x86_64-dgetri-f2jblas.csv.gz | Bin 3061 -> 0 bytes
perf/results/mac_os_x-x86_64-dgetri-mkl.csv.gz | Bin 2547 -> 0 bytes
.../mac_os_x-x86_64-dgetri-nativerefblas.csv.gz | Bin 2626 -> 0 bytes
.../mac_os_x-x86_64-dgetri-nativesystemblas.csv.gz | Bin 2579 -> 0 bytes
perf/results/mac_os_x-x86_64-dgetri-veclib.csv.gz | Bin 2666 -> 0 bytes
perf/results/mac_os_x-x86_64-dsaupd-f2jblas.csv.gz | Bin 4090 -> 0 bytes
.../mac_os_x-x86_64-dsaupd-nativerefblas.csv.gz | Bin 3974 -> 0 bytes
.../mac_os_x-x86_64-dsaupd-nativesystemblas.csv.gz | Bin 3960 -> 0 bytes
.../results/mac_os_x-x86_64-linpack-f2jblas.csv.gz | Bin 293 -> 0 bytes
.../mac_os_x-x86_64-linpack-nativerefblas.csv.gz | Bin 311 -> 0 bytes
...mac_os_x-x86_64-linpack-nativesystemblas.csv.gz | Bin 318 -> 0 bytes
perf/results/plot.R | 178 -
perf/src/main/c/clwrapper.c | 125 -
perf/src/main/c/common.c | 54 -
perf/src/main/c/common.h | 3 -
perf/src/main/c/cudaddottest.c | 81 -
perf/src/main/c/cudadgemmtest.c | 127 -
perf/src/main/c/cudawrapper.c | 85 -
perf/src/main/c/ddottest.c | 64 -
perf/src/main/c/dgemmtest.c | 103 -
perf/src/main/c/dgetritest.c | 66 -
.../java/com/github/fommil/netlib/Benchmark.java | 15 -
.../java/com/github/fommil/netlib/Benchmarks.java | 114 -
.../main/java/com/github/fommil/netlib/Ddot.java | 27 -
.../main/java/com/github/fommil/netlib/Dgemm.java | 26 -
.../main/java/com/github/fommil/netlib/Dgetri.java | 51 -
.../main/java/com/github/fommil/netlib/Dsaupd.java | 121 -
.../java/com/github/fommil/netlib/Linpack.java | 299 -
.../java/com/github/fommil/netlib/BLASTest.java | 40 -
.../java/com/github/fommil/netlib/LAPACKTest.java | 78 -
pom.xml | 269 -
src/org/netlib/arpack/ARPACK.java | 1122 +
src/org/netlib/arpack/JARPACK.java | 100 +
src/org/netlib/arpack/NativeARPACK.java | 99 +
src/org/netlib/blas/BLAS.java | 6352 ++
src/org/netlib/blas/JBLAS.java | 405 +
src/org/netlib/blas/NativeBLAS.java | 282 +
src/org/netlib/generate/JNIGenerator.java | 617 +
src/org/netlib/generate/JavaGenerator.java | 970 +
src/org/netlib/lapack/JLAPACK.java | 3195 +
src/org/netlib/lapack/LAPACK.java | 80189 ++++++++++++++
src/org/netlib/lapack/NativeLAPACK.java | 1956 +
src/org/netlib/utils/JNIMethods.java | 162 +
tests/org/netlib/blas/BLASTest.java | 79 +
tests/org/netlib/lapack/LAPACKTest.java | 88 +
2402 files changed, 243696 insertions(+), 515625 deletions(-)
diff --git a/.gitignore b/.gitignore
deleted file mode 100644
index 358abdf..0000000
--- a/.gitignore
+++ /dev/null
@@ -1,8 +0,0 @@
-*.class
-
-# Package Files #
-*.jar
-*.war
-*.ear
-*.iml
-
diff --git a/LICENSE.txt b/LICENSE.txt
deleted file mode 100644
index b7d2849..0000000
--- a/LICENSE.txt
+++ /dev/null
@@ -1,49 +0,0 @@
-Copyright (c) 2013 Samuel Halliday
-Copyright (c) 1992-2011 The University of Tennessee and The University
- of Tennessee Research Foundation. All rights
- reserved.
-Copyright (c) 2000-2011 The University of California Berkeley. All
- rights reserved.
-Copyright (c) 2006-2011 The University of Colorado Denver. All rights
- reserved.
-
-$COPYRIGHT$
-
-Additional copyrights may follow
-
-$HEADER$
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are
-met:
-
-- Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
-- Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer listed
- in this license in the documentation and/or other materials
- provided with the distribution.
-
-- Neither the name of the copyright holders nor the names of its
- contributors may be used to endorse or promote products derived from
- this software without specific prior written permission.
-
-The copyright holders provide no reassurances that the source code
-provided does not infringe any patent, copyright, or any other
-intellectual property rights of third parties. The copyright holders
-disclaim any liability to any recipient for claims brought against
-recipient by any third party for infringement of that parties
-intellectual property rights.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
deleted file mode 100644
index cc155af..0000000
--- a/README.md
+++ /dev/null
@@ -1,274 +0,0 @@
-netlib-java
-===========
-
-`netlib-java` is a wrapper for low-level [BLAS](http://en.wikipedia.org/wiki/Basic_Linear_Algebra_Subprograms),
-[LAPACK](http://en.wikipedia.org/wiki/LAPACK) and [ARPACK](http://en.wikipedia.org/wiki/ARPACK)
-that performs **as fast as the C / Fortran interfaces**.
-
-If you're a developer looking for an easy-to-use linear algebra library on the JVM, we strongly recommend Commons-Math, MTJ and Breeze:
-
-* [Apache Commons Math](http://commons.apache.org/proper/commons-math/) for the most popular mathematics library in Java ([not using `netlib-java`](https://issues.apache.org/jira/browse/MATH-270)).
-* [Matrix Toolkits for Java](https://github.com/fommil/matrix-toolkits-java/) for high performance linear algebra in Java (builds on top of `netlib-java`).
-* [Breeze](https://github.com/scalanlp/breeze) for high performance linear algebra in Scala (builds on top of `netlib-java`).
-
-
-In `netlib-java`, implementations of BLAS/LAPACK/ARPACK are provided by:
-
-* delegating builds that use machine optimised system libraries (see below)
-* self-contained native builds using the reference Fortran from [netlib.org](http://www.netlib.org)
-* [F2J](http://icl.cs.utk.edu/f2j/) to ensure full portability on the JVM
-
-The [JNILoader](https://github.com/fommil/jniloader) will attempt to load the implementations in this order automatically.
-
-All major operating systems are supported out-of-the-box:
-
-* OS X (`x86_64`)
-* Linux (`i686`, `x86_64`, Raspberry Pi `armhf`) (**must have `libgfortran3` installed**)
-* Windows (32 and 64 bit)
-
-
-Machine Optimised System Libraries
-==================================
-
-High performance BLAS / LAPACK are available
-[commercially and open source](http://en.wikipedia.org/wiki/Basic_Linear_Algebra_Subprograms#Implementations)
-for specific CPU chipsets. It is worth noting that "optimised" here means a lot more than simply changing
-the compiler optimisation flags: specialist assembly instructions are combined with [compile time profiling](http://en.wikipedia.org/wiki/Automatically_Tuned_Linear_Algebra_Software#Optimization_approach)
-and the [selection of array alignments for the kernel and CPU combination](http://en.wikipedia.org/wiki/Automatically_Tuned_Linear_Algebra_Software#Can_it_afford_to_copy.3F).
-
-An alternative to optimised libraries is to use the GPU:
-e.g. [cuBLAS](https://developer.nvidia.com/cublas) or [clBLAS](https://github.com/clMathLibraries/clBLAS).
-However, GPU implementations have severe performance degradation for small arrays.
-[MultiBLAS](https://github.com/fommil/multiblas) is an initiative to work around
-the limitation of GPU BLAS implementations by selecting the optimal implementation
-at runtime, based on the array size.
-
-**To enable machine optimised natives in `netlib-java`, end-users make their machine-optimised `libblas3` (CBLAS) and
-`liblapack3` (Fortran) available as shared libraries at runtime.**
-
-If it is not possible to provide a shared library, [the author](https://github.com/fommil/) may be available
-to assist with custom builds (and further improvements to `netlib-java`) on a commercial basis.
-Make contact for availability (budget estimates are appreciated).
-
-OS X
-----
-
-Apple OS X requires no further setup because OS X ships with the [veclib framework](https://developer.apple.com/documentation/Performance/Conceptual/vecLib/),
-boasting incredible CPU performance that is difficult to surpass (performance charts below
-show that it out-performs ATLAS and is on par with the Intel MKL).
-
-
-Linux
------
-
-(includes Raspberry Pi)
-
-Generically-tuned ATLAS and OpenBLAS are available with most distributions (e.g. [Debian](https://wiki.debian.org/DebianScience/LinearAlgebraLibraries)) and must be enabled
-explicitly using the package-manager. e.g. for Debian / Ubuntu one would type
-
- sudo apt-get install libatlas3-base libopenblas-base
- sudo update-alternatives --config libblas.so.3
- sudo update-alternatives --config liblapack.so.3
-
-selecting the preferred implementation.
-
-However, these are only generic pre-tuned builds. To get optimal performance for a specific
-machine, it is best to compile locally by grabbing the [latest ATLAS](http://sourceforge.net/projects/math-atlas/files/latest/download) or the [latest OpenBLAS](https://github.com/xianyi/OpenBLAS/archive/master.zip) and following the compilation
-instructions (don't forget to turn off CPU throttling and power management during the build!).
-Install the shared libraries into a folder that is seen by the runtime linker (e.g. add your install
-folder to `/etc/ld.so.conf` then run `ldconfig`) ensuring that `libblas.so.3` and `liblapack.so.3`
-exist and point to your optimal builds.
-
-If you have an [Intel MKL](http://software.intel.com/en-us/intel-mkl) licence, you could also
-create symbolic links from `libblas.so.3` and `liblapack.so.3` to `libmkl_rt.so`.
-
-*NOTE: Some distributions, such as Ubuntu `precise` do not create the necessary symbolic links
-`/usr/lib/libblas.so.3` and `/usr/lib/liblapack.so.3` for the system-installed implementations,
-so they must be created manually.*
-
-Windows
--------
-
-The `native_system` builds expect to find `libblas3.dll` and `liblapack3.dll` on the `%PATH%`
-(or current working directory).
-Besides vendor-supplied implementations,
-OpenBLAS provide [generically tuned binaries](http://sourceforge.net/projects/openblas/files/),
-and it is possible to build
-[ATLAS](http://math-atlas.sourceforge.net/atlas_install/node54.html).
-
-Use [Dependency Walker](http://www.dependencywalker.com) to help resolve any problems such as:
-`UnsatisfiedLinkError (Can't find dependent libraries)`.
-
-*NOTE: OpenBLAS [doesn't provide separate libraries](https://github.com/xianyi/OpenBLAS/issues/296)
-so you will have to customise the build or copy the binary into both `libblas3.dll` and
-`liblapack3.dll` whilst also obtaining a copy of `libgfortran-1-3.dll`, `libquadmath-0.dll` and
-`libgcc_s_seh-1.dll` from [MinGW](http://www.mingw.org).*
-
-
-Customisation
-=============
-
-A specific implementation may be forced like so:
-
-* `-Dcom.github.fommil.netlib.BLAS=com.github.fommil.netlib.NativeRefBLAS`
-* `-Dcom.github.fommil.netlib.LAPACK=com.github.fommil.netlib.NativeRefLAPACK`
-* `-Dcom.github.fommil.netlib.ARPACK=com.github.fommil.netlib.NativeRefARPACK`
-
-And a specific (non-standard) native binary may be forced like so:
-
-* `-Dcom.github.fommil.netlib.NativeSystemBLAS.natives=netlib-native_system-myos-myarch.so`
-
-To turn off natives altogether, add these to the JVM flags:
-
-* `-Dcom.github.fommil.netlib.BLAS=com.github.fommil.netlib.F2jBLAS`
-* `-Dcom.github.fommil.netlib.LAPACK=com.github.fommil.netlib.F2jLAPACK`
-* `-Dcom.github.fommil.netlib.ARPACK=com.github.fommil.netlib.F2jARPACK`
-
-
-Performance
-===========
-
-Java has a reputation with older generation developers because
-Java applications were slow in the 1990s.
-Nowadays, the [JIT](http://en.wikipedia.org/wiki/Just-in-time_compilation)
-ensures that Java applications keep pace with – or exceed the performance of –
-C / C++ / Fortran applications.
-
-The following performance charts give an idea of the performance ratios of Java vs the native
-implementations. Also shown are pure C performance runs that show that
-**dropping to C at the application layer gives no performance benefit**.
-If anything, the Java version is faster for smaller matrices and is consistently faster
-than the "optimised" implementations for some types of operations (e.g. `ddot`).
-
-One can expect machine-optimised natives to out-perform the reference implementation
-– especially for larger arrays – as demonstrated below by Apple's
-[veclib framework](https://developer.apple.com/library/mac/documentation/Performance/Conceptual/vecLib/Reference/reference.html),
-Intel's [MKL](http://software.intel.com/en-us/intel-mkl) and (to a lesser extent)
-[ATLAS](https://sourceforge.net/projects/math-atlas/).
-
-Of particular note is the [cuBLAS](https://developer.nvidia.com/cublas) (NVIDIA's graphics card) which performs as well
-as ATLAS on `DGEMM` for arrays of `~20,000+` elements (but as badly as the Raspberry Pi for smaller arrays!) and
-not so good for `DDOT`.
-
-Included in the CUDA performance results is the
-time taken to setup the CUDA interface and copy the matrix elements to the GPU device. The `nooh` run is
-a version that does not include the overhead of transferring arrays to/from the GPU device: to take
-full advantage of the GPU requires developers to re-write their applications with
-GPU devices in mind. e.g. re-written implementation of LAPACK that took advantage of the GPU BLAS
-would give a much better performance improvement than dipping in-and-out of GPU address space.
-
-
-The [DGEMM](http://www.netlib.no/netlib/lapack/double/dgemm.f) benchmark
-measures [matrix multiplication](http://en.wikipedia.org/wiki/General_Matrix_Multiply)
-performance:
-
-
-
-The [DGETRI](http://www.netlib.no/netlib/lapack/double/dgetri.f) benchmark
-measures matrix [LU Factorisation](http://en.wikipedia.org/wiki/LU_decomposition)
-and [matrix inversion](http://mathworld.wolfram.com/MatrixInverse.html) performance:
-
-
-
-The [DDOT](http://www.netlib.no/netlib/blas/ddot.f) benchmark measures
-[vector dot product](http://en.wikipedia.org/wiki/Dot_product) performance:
-
-
-
-
-The [DSAUPD](http://www.caam.rice.edu/software/ARPACK/UG/node136.html) benchmark measures the
-calculation of 10% of the eigenvalues for sparse matrices (`N` rows by `N` colums). Not included in
-this benchmark is the time taken to perform the matrix multiplication at each iteration
-(typically `N` iterations).
-
-
-
-
-*NOTE: larger arrays were called first so the JIT has already kicked in for F2J
-implementations: on a cold startup the F2J implementations are about 10 times slower and get to peak
-performance after about 20 calls of a function (Raspberry Pi doesn't seem to have a JIT).*
-
-
-Installation
-============
-
-Releases are distributed on Maven central:
-
-```xml
-<dependency>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>all</artifactId>
- <version>1.1</version>
- <type>pom</type>
-</dependency>
-```
-
-SBT developers can use
-
-```scala
-"com.github.fommil.netlib" % "all" % "1.1" pomOnly()
-```
-
-Those wanting to preserve the pre-1.0 API can use the legacy package (but
-note that it **will** be removed in the next release):
-
-```xml
-<dependency>
- <groupId>com.googlecode.netlib-java</groupId>
- <artifactId>netlib</artifactId>
- <version>1.1</version>
-</dependency>
-```
-
-and developers who feel the native libs are too much bandwidth can
-depend on a subset of implementations: simply look in the `all`
-module's [`pom.xml`](all/pom.xml).
-
-
-Snapshots are distributed on Sonatype's Snapshot Repository, e.g.:
-
-```xml
-<dependency>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>all</artifactId>
- <version>1.2-SNAPSHOT</version>
-</dependency>
-```
-
-If the above fails, ensure you have the following in your `pom.xml`:
-
-```xml
- <repositories>
- <repository>
- <id>sonatype-snapshots</id>
- <url>https://oss.sonatype.org/content/repositories/snapshots/</url>
- <releases>
- <enabled>false</enabled>
- </releases>
- <snapshots>
- <enabled>true</enabled>
- </snapshots>
- </repository>
- </repositories>
-```
-
-
-
-Donations
-=========
-
-Please consider supporting the maintenance of this open source project with a donation:
-
-[](https://www.paypal.com/cgi-bin/webscr?cmd=_donations&business=B2HW5ATB8C3QW&lc=GB&item_name=netlib¤cy_code=GBP&bn=PP%2dDonationsBF%3abtn_donateCC_LG%2egif%3aNonHosted)
-
-
-Contributing
-============
-
-You can contribute by clicking the star button!
-
-Contributors are encouraged to fork this repository and issue pull
-requests. Contributors implicitly agree to assign an unrestricted licence
-to Sam Halliday, but retain the copyright of their code (this means
-we both have the freedom to update the licence for those contributions).
-
diff --git a/all/pom.xml b/all/pom.xml
deleted file mode 100644
index 061dddc..0000000
--- a/all/pom.xml
+++ /dev/null
@@ -1,102 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.1</version>
- </parent>
-
- <artifactId>all</artifactId>
- <packaging>pom</packaging>
- <version>1.1.1</version>
-
- <dependencies>
- <dependency>
- <!-- WORKAROUND: https://github.com/sbt/sbt/issues/861 -->
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <version>0.1</version>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>core</artifactId>
- <version>1.1.1</version>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_ref-osx-x86_64</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_ref-linux-x86_64</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_ref-linux-i686</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_ref-win-x86_64</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_ref-win-i686</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_ref-linux-armhf</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_system-osx-x86_64</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_system-linux-x86_64</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_system-linux-i686</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_system-linux-armhf</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_system-win-x86_64</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>netlib-native_system-win-i686</artifactId>
- <version>${project.parent.version}</version>
- <classifier>natives</classifier>
- </dependency>
- </dependencies>
-</project>
diff --git a/build.xml b/build.xml
new file mode 100644
index 0000000..1d1fbe4
--- /dev/null
+++ b/build.xml
@@ -0,0 +1,48 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<project name="org.netlib" default="default" basedir=".">
+ <description>Builds, tests, and runs the project org.netlib.</description>
+ <property name="version" value="0.9.3" />
+ <!-- REMINDER: When bumping the version value, also bump the value in jni/configure -->
+ <import file="nbproject/build-impl.xml"/>
+
+ <!-- NOTE: before running 'ant test', run 'ant clean generate compile package' and then build the JNI -->
+
+ <!-- Delete all files that are autogenerated -->
+ <target name="-post-clean">
+ <delete>
+ <fileset dir="src/org/netlib/blas/" includes="**/*"/>
+ <fileset dir="src/org/netlib/lapack/" includes="**/*"/>
+ <fileset dir="src/org/netlib/arpack/" includes="**/*"/>
+ <fileset dir="jni/" includes="**org_netlib_*.c"/>
+ <fileset dir="jni/" includes="**.o"/>
+ <fileset dir="jni/" includes="**.a"/>
+ <fileset dir="jni/" includes="**org_netlib_*.h"/>
+ <fileset dir="jni/" includes="**Makefile.incl"/>
+ <fileset dir="jni/" includes="**.so"/>
+ <fileset dir="jni/" includes="**.jnilib"/>
+ </delete>
+ <delete dir="jni/ARPACK"/>
+ </target>
+ <target name="generate" depends="compile">
+ <!-- Autogenerate the Java and C files -->
+ <java fork="yes" classname="org.netlib.generate.JavaGenerator" classpath="${run.classpath}" />
+ </target>
+
+ <!--
+ WARNING: you need to call `ant clean generate compile package` for this to work
+ because there is no easy way to tell ant that we really do need the second
+ compile task to run.
+ -->
+ <target name="package" depends="javadoc">
+ <!-- TODO: unpack and include the F2J classes -->
+ <jar destfile="netlib-java-${version}.jar">
+ <fileset dir="build/classes"
+ excludes="**org/netlib/generate**" />
+ </jar>
+ <move file="dist/javadoc" todir="." />
+ <zip destfile="netlib-java-${version}.zip">
+ <zipfileset dir="." excludes="**/lib/nblibraries-private.properties **/nbproject/private** **/.ant-targets-build.xml dist/** build/** **/*.zip **/.svn** **/jni/*.tar.gz" prefix="netlib-java-${version}" />
+ </zip>
+ <delete dir="javadoc"/>
+ </target>
+</project>
diff --git a/core/pom.xml b/core/pom.xml
deleted file mode 100644
index e853ef7..0000000
--- a/core/pom.xml
+++ /dev/null
@@ -1,118 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.1</version>
- </parent>
-
- <artifactId>core</artifactId>
- <packaging>jar</packaging>
- <version>1.1.1</version>
-
- <dependencies>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <classifier>javadoc</classifier>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- </plugin>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <version>1.1.1</version>
- <executions>
- <execution>
- <id>blas-interface</id>
- <goals>
- <goal>interface</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/BLAS.java</outputName>
- <scan>org.netlib.blas</scan>
- <fallback>com.github.fommil.netlib.F2jBLAS</fallback>
- <impls>com.github.fommil.netlib.NativeSystemBLAS,com.github.fommil.netlib.NativeRefBLAS,com.github.fommil.netlib.F2jBLAS</impls>
- </configuration>
- </execution>
- <execution>
- <id>blas-f2j-implementation</id>
- <goals>
- <goal>f2j</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/F2jBLAS.java</outputName>
- <scan>org.netlib.blas</scan>
- <implementing>com.github.fommil.netlib.BLAS</implementing>
- </configuration>
- </execution>
- <execution>
- <id>lapack-interface</id>
- <goals>
- <goal>interface</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/LAPACK.java</outputName>
- <scan>org.netlib.lapack</scan>
- <fallback>com.github.fommil.netlib.F2jLAPACK</fallback>
- <impls>com.github.fommil.netlib.NativeSystemLAPACK,com.github.fommil.netlib.NativeRefLAPACK,com.github.fommil.netlib.F2jLAPACK</impls>
- <initCode>INSTANCE.slamch("E"); INSTANCE.dlamch("E");</initCode>
- </configuration>
- </execution>
- <execution>
- <id>lapack-f2j-implementation</id>
- <goals>
- <goal>f2j</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/F2jLAPACK.java</outputName>
- <scan>org.netlib.lapack</scan>
- <implementing>com.github.fommil.netlib.LAPACK</implementing>
- </configuration>
- </execution>
- <execution>
- <id>arpack-interface</id>
- <goals>
- <goal>interface</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/ARPACK.java</outputName>
- <scan>org.netlib.arpack</scan>
- <fallback>com.github.fommil.netlib.F2jARPACK</fallback>
- <impls>com.github.fommil.netlib.NativeSystemARPACK,com.github.fommil.netlib.NativeRefARPACK,com.github.fommil.netlib.F2jARPACK</impls>
- </configuration>
- </execution>
- <execution>
- <id>arpack-f2j-implementation</id>
- <goals>
- <goal>f2j</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/F2jARPACK.java</outputName>
- <scan>org.netlib.arpack</scan>
- <implementing>com.github.fommil.netlib.ARPACK</implementing>
- </configuration>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/generator/LICENSE.txt b/generator/LICENSE.txt
deleted file mode 100644
index 94a9ed0..0000000
--- a/generator/LICENSE.txt
+++ /dev/null
@@ -1,674 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The GNU General Public License is a free, copyleft license for
-software and other kinds of works.
-
- The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works. By contrast,
-the GNU General Public License is intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users. We, the Free Software Foundation, use the
-GNU General Public License for most of our software; it applies also to
-any other work released this way by its authors. You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
- To protect your rights, we need to prevent others from denying you
-these rights or asking you to surrender the rights. Therefore, you have
-certain responsibilities if you distribute copies of the software, or if
-you modify it: responsibilities to respect the freedom of others.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must pass on to the recipients the same
-freedoms that you received. You must make sure that they, too, receive
-or can get the source code. And you must show them these terms so they
-know their rights.
-
- Developers that use the GNU GPL protect your rights with two steps:
-(1) assert copyright on the software, and (2) offer you this License
-giving you legal permission to copy, distribute and/or modify it.
-
- For the developers' and authors' protection, the GPL clearly explains
-that there is no warranty for this free software. For both users' and
-authors' sake, the GPL requires that modified versions be marked as
-changed, so that their problems will not be attributed erroneously to
-authors of previous versions.
-
- Some devices are designed to deny users access to install or run
-modified versions of the software inside them, although the manufacturer
-can do so. This is fundamentally incompatible with the aim of
-protecting users' freedom to change the software. The systematic
-pattern of such abuse occurs in the area of products for individuals to
-use, which is precisely where it is most unacceptable. Therefore, we
-have designed this version of the GPL to prohibit the practice for those
-products. If such problems arise substantially in other domains, we
-stand ready to extend this provision to those domains in future versions
-of the GPL, as needed to protect the freedom of users.
-
- Finally, every program is threatened constantly by software patents.
-States should not allow patents to restrict development and use of
-software on general-purpose computers, but in those that do, we wish to
-avoid the special danger that patents applied to a free program could
-make it effectively proprietary. To prevent this, the GPL assures that
-patents cannot be used to render the program non-free.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- TERMS AND CONDITIONS
-
- 0. Definitions.
-
- "This License" refers to version 3 of the GNU General Public License.
-
- "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
- "The Program" refers to any copyrightable work licensed under this
-License. Each licensee is addressed as "you". "Licensees" and
-"recipients" may be individuals or organizations.
-
- To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy. The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
- A "covered work" means either the unmodified Program or a work based
-on the Program.
-
- To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy. Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
- To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies. Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
- An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License. If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
- 1. Source Code.
-
- The "source code" for a work means the preferred form of the work
-for making modifications to it. "Object code" means any non-source
-form of a work.
-
- A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
- The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form. A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
- The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities. However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work. For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
- The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
- The Corresponding Source for a work in source code form is that
-same work.
-
- 2. Basic Permissions.
-
- All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met. This License explicitly affirms your unlimited
-permission to run the unmodified Program. The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work. This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
- You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force. You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright. Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
- Conveying under any other circumstances is permitted solely under
-the conditions stated below. Sublicensing is not allowed; section 10
-makes it unnecessary.
-
- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
- No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
- When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
- 4. Conveying Verbatim Copies.
-
- You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
- You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
- 5. Conveying Modified Source Versions.
-
- You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
- a) The work must carry prominent notices stating that you modified
- it, and giving a relevant date.
-
- b) The work must carry prominent notices stating that it is
- released under this License and any conditions added under section
- 7. This requirement modifies the requirement in section 4 to
- "keep intact all notices".
-
- c) You must license the entire work, as a whole, under this
- License to anyone who comes into possession of a copy. This
- License will therefore apply, along with any applicable section 7
- additional terms, to the whole of the work, and all its parts,
- regardless of how they are packaged. This License gives no
- permission to license the work in any other way, but it does not
- invalidate such permission if you have separately received it.
-
- d) If the work has interactive user interfaces, each must display
- Appropriate Legal Notices; however, if the Program has interactive
- interfaces that do not display Appropriate Legal Notices, your
- work need not make them do so.
-
- A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit. Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
- 6. Conveying Non-Source Forms.
-
- You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
- a) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by the
- Corresponding Source fixed on a durable physical medium
- customarily used for software interchange.
-
- b) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by a
- written offer, valid for at least three years and valid for as
- long as you offer spare parts or customer support for that product
- model, to give anyone who possesses the object code either (1) a
- copy of the Corresponding Source for all the software in the
- product that is covered by this License, on a durable physical
- medium customarily used for software interchange, for a price no
- more than your reasonable cost of physically performing this
- conveying of source, or (2) access to copy the
- Corresponding Source from a network server at no charge.
-
- c) Convey individual copies of the object code with a copy of the
- written offer to provide the Corresponding Source. This
- alternative is allowed only occasionally and noncommercially, and
- only if you received the object code with such an offer, in accord
- with subsection 6b.
-
- d) Convey the object code by offering access from a designated
- place (gratis or for a charge), and offer equivalent access to the
- Corresponding Source in the same way through the same place at no
- further charge. You need not require recipients to copy the
- Corresponding Source along with the object code. If the place to
- copy the object code is a network server, the Corresponding Source
- may be on a different server (operated by you or a third party)
- that supports equivalent copying facilities, provided you maintain
- clear directions next to the object code saying where to find the
- Corresponding Source. Regardless of what server hosts the
- Corresponding Source, you remain obligated to ensure that it is
- available for as long as needed to satisfy these requirements.
-
- e) Convey the object code using peer-to-peer transmission, provided
- you inform other peers where the object code and Corresponding
- Source of the work are being offered to the general public at no
- charge under subsection 6d.
-
- A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
- A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling. In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage. For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product. A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
- "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source. The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
- If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information. But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
- The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed. Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
- Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
- 7. Additional Terms.
-
- "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law. If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
- When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it. (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.) You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
- Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
- a) Disclaiming warranty or limiting liability differently from the
- terms of sections 15 and 16 of this License; or
-
- b) Requiring preservation of specified reasonable legal notices or
- author attributions in that material or in the Appropriate Legal
- Notices displayed by works containing it; or
-
- c) Prohibiting misrepresentation of the origin of that material, or
- requiring that modified versions of such material be marked in
- reasonable ways as different from the original version; or
-
- d) Limiting the use for publicity purposes of names of licensors or
- authors of the material; or
-
- e) Declining to grant rights under trademark law for use of some
- trade names, trademarks, or service marks; or
-
- f) Requiring indemnification of licensors and authors of that
- material by anyone who conveys the material (or modified versions of
- it) with contractual assumptions of liability to the recipient, for
- any liability that these contractual assumptions directly impose on
- those licensors and authors.
-
- All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10. If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term. If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
- If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
- Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
- 8. Termination.
-
- You may not propagate or modify a covered work except as expressly
-provided under this License. Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
- However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
- Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
- Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
- 9. Acceptance Not Required for Having Copies.
-
- You are not required to accept this License in order to receive or
-run a copy of the Program. Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance. However,
-nothing other than this License grants you permission to propagate or
-modify any covered work. These actions infringe copyright if you do
-not accept this License. Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
- 10. Automatic Licensing of Downstream Recipients.
-
- Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License. You are not responsible
-for enforcing compliance by third parties with this License.
-
- An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations. If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
- You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License. For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
- 11. Patents.
-
- A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based. The
-work thus licensed is called the contributor's "contributor version".
-
- A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version. For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
- Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
- In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement). To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
- If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients. "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
- If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
- A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License. You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
- Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
- 12. No Surrender of Others' Freedom.
-
- If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all. For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
- 13. Use with the GNU Affero General Public License.
-
- Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU Affero General Public License into a single
-combined work, and to convey the resulting work. The terms of this
-License will continue to apply to the part which is the covered work,
-but the special requirements of the GNU Affero General Public License,
-section 13, concerning interaction through a network will apply to the
-combination as such.
-
- 14. Revised Versions of this License.
-
- The Free Software Foundation may publish revised and/or new versions of
-the GNU General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Program specifies that a certain numbered version of the GNU General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation. If the Program does not specify a version number of the
-GNU General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
- If the Program specifies that a proxy can decide which future
-versions of the GNU General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
- Later license versions may give you additional or different
-permissions. However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
- 15. Disclaimer of Warranty.
-
- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. Limitation of Liability.
-
- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
- 17. Interpretation of Sections 15 and 16.
-
- If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-Also add information on how to contact you by electronic and paper mail.
-
- If the program does terminal interaction, make it output a short
-notice like this when it starts in an interactive mode:
-
- <program> Copyright (C) <year> <name of author>
- This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, your program's commands
-might be different; for a GUI interface, you would use an "about box".
-
- You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
-
- The GNU General Public License does not permit incorporating your program
-into proprietary programs. If your program is a subroutine library, you
-may consider it more useful to permit linking proprietary applications with
-the library. If this is what you want to do, use the GNU Lesser General
-Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/generator/pom.xml b/generator/pom.xml
deleted file mode 100644
index 6fde680..0000000
--- a/generator/pom.xml
+++ /dev/null
@@ -1,179 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <!--
- NOTE: not part of the reactor
- https://github.com/fommil/netlib-java/issues/45
-
- To release, see ../pom.xml
- -->
-
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <version>1.1.1</version>
- <packaging>maven-plugin</packaging>
-
- <properties>
- <project.build.sourceEncoding>UTF-8</project.build.sourceEncoding>
- </properties>
- <prerequisites>
- <maven>3.0.3</maven>
- </prerequisites>
-
- <parent>
- <groupId>org.sonatype.oss</groupId>
- <artifactId>oss-parent</artifactId>
- <version>7</version>
- <relativePath />
- </parent>
- <name>netlib for Java (Generator)</name>
- <description>Mission-critical components for linear algebra systems.</description>
- <url>https://github.com/fommil/netlib-java</url>
- <licenses>
- <license>
- <name>GPL</name>
- <url>http://www.gnu.org/licenses/gpl.txt</url>
- </license>
- </licenses>
- <!-- maven doesn't seem to support our SCM module setup -->
- <!-- <scm>
- <url>https://github.com/fommil/netlib-java</url>
- <connection>scm:git:git at github.com:fommil/netlib-java.git</connection>
- <developerConnection>scm:git:git at github.com:fommil/netlib-java.git</developerConnection>
- </scm> -->
- <developers>
- <developer>
- <name>Sam Halliday</name>
- <id>fommil</id>
- <email>sam.halliday at gmail.com</email>
- </developer>
- </developers>
- <issueManagement>
- <system>github</system>
- <url>https://github.com/fommil/netlib-java/issues</url>
- </issueManagement>
-
- <repositories>
- <repository>
- <id>sonatype-snapshots</id>
- <url>https://oss.sonatype.org/content/repositories/snapshots/</url>
- <releases>
- <enabled>false</enabled>
- </releases>
- <snapshots>
- <enabled>true</enabled>
- </snapshots>
- </repository>
- <repository>
- <id>sonatype-releases</id>
- <url>https://oss.sonatype.org/content/repositories/releases/</url>
- <releases>
- <enabled>true</enabled>
- </releases>
- <snapshots>
- <enabled>false</enabled>
- </snapshots>
- </repository>
- </repositories>
-
- <!-- mvn versions:display-dependency-updates -->
- <dependencies>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- <version>1.12.2</version>
- <scope>provided</scope>
- </dependency>
- <dependency>
- <groupId>com.google.guava</groupId>
- <artifactId>guava</artifactId>
- <version>15.0</version>
- </dependency>
- <dependency>
- <groupId>com.google.code.findbugs</groupId>
- <artifactId>jsr305</artifactId>
- <version>2.0.2</version>
- </dependency>
- <dependency>
- <groupId>org.apache.maven</groupId>
- <artifactId>maven-plugin-api</artifactId>
- <version>3.1.1</version>
- <scope>provided</scope>
- </dependency>
- <dependency>
- <groupId>org.apache.maven.plugin-tools</groupId>
- <artifactId>maven-plugin-annotations</artifactId>
- <version>3.2</version>
- <scope>provided</scope>
- </dependency>
- <dependency>
- <groupId>org.apache.maven</groupId>
- <artifactId>maven-core</artifactId>
- <version>3.1.1</version>
- <scope>provided</scope>
- </dependency>
- <dependency>
- <groupId>com.thoughtworks.paranamer</groupId>
- <artifactId>paranamer</artifactId>
- <version>2.6</version>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <version>0.1</version>
- </dependency>
- <dependency>
- <groupId>org.antlr</groupId>
- <artifactId>stringtemplate</artifactId>
- <version>4.0.2</version>
- </dependency>
- </dependencies>
-
- <!-- mvn versions:display-plugin-updates -->
- <build>
- <plugins>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-gpg-plugin</artifactId>
- <version>1.4</version>
- <executions>
- <execution>
- <id>sign-artifacts</id>
- <phase>verify</phase>
- <goals>
- <goal>sign</goal>
- </goals>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- <version>3.1</version>
- <configuration>
- <source>1.6</source>
- <target>1.6</target>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-plugin-plugin</artifactId>
- <version>3.2</version>
- <configuration>
- <!-- see http://jira.codehaus.org/browse/MNG-5346 -->
- <skipErrorNoDescriptorsFound>true</skipErrorNoDescriptorsFound>
- </configuration>
- <executions>
- <execution>
- <id>mojo-descriptor</id>
- <goals>
- <goal>descriptor</goal>
- </goals>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-
-</project>
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/AbstractJavaGenerator.java b/generator/src/main/java/com/github/fommil/netlib/generator/AbstractJavaGenerator.java
deleted file mode 100644
index a595982..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/AbstractJavaGenerator.java
+++ /dev/null
@@ -1,65 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.collect.Lists;
-import org.stringtemplate.v4.STGroupFile;
-
-import java.lang.reflect.Method;
-import java.util.List;
-
-import static java.lang.String.format;
-
-public abstract class AbstractJavaGenerator extends AbstractNetlibGenerator {
-
- protected final STGroupFile jTemplates = new STGroupFile("com/github/fommil/netlib/generator/netlib-java.stg", '$', '$');
-
- protected String getTargetPackage() {
- return outputName.replace("/", ".").substring(0, outputName.lastIndexOf("/"));
- }
-
- protected String getTargetClassName() {
- return outputName.replace(".java", "").substring(outputName.lastIndexOf("/") + 1);
- }
-
- /**
- * @param method
- * @return parameters to pass to the F2J implementation.
- */
- protected List<String> getF2jJavaParameters(Method method, final boolean offsets) {
- final List<String> args = Lists.newArrayList();
- iterateRelevantParameters(method, offsets, new ParameterCallback() {
- @Override
- public void process(int i, Class<?> param, String name, String offsetName) {
- args.add(name);
- if (param.isArray() && !offsets) args.add("0");
- }
- });
- return args;
- }
-
- /**
- * @return a Javadoc summary text of the plugin parameters.
- */
- protected String getGenerationSummaryJavadocs() {
- return format(
- "Generated by {@code %s} from {@code %s} in {@code %s}.",
- getClass().getSimpleName(), scan, input
- );
- }
-
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/AbstractNetlibGenerator.java b/generator/src/main/java/com/github/fommil/netlib/generator/AbstractNetlibGenerator.java
deleted file mode 100644
index 68b1c8c..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/AbstractNetlibGenerator.java
+++ /dev/null
@@ -1,221 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.base.Charsets;
-import com.google.common.base.Predicate;
-import com.google.common.base.Strings;
-import com.google.common.collect.Iterables;
-import com.google.common.collect.Lists;
-import com.google.common.io.Files;
-import com.thoughtworks.paranamer.*;
-import org.apache.maven.artifact.Artifact;
-import org.apache.maven.plugin.AbstractMojo;
-import org.apache.maven.plugin.MojoExecutionException;
-import org.apache.maven.plugins.annotations.Component;
-import org.apache.maven.plugins.annotations.Parameter;
-import org.apache.maven.project.MavenProject;
-
-import javax.annotation.Nullable;
-import java.io.File;
-import java.lang.reflect.Method;
-import java.util.List;
-
-public abstract class AbstractNetlibGenerator extends AbstractMojo {
-
- /**
- * Location of the generated source files.
- */
- @Parameter(defaultValue = "${project.build.directory}/generated-sources/netlib-java", required = true)
- protected File outputDir;
-
- @Parameter(required = true)
- protected String outputName;
-
- /**
- * The artifact of the jar to generate from.
- * Note that this must be listed as a <code>dependency</code>
- * section of the calling module, not a plugin <code>dependency</code>.
- */
- @Parameter(defaultValue = "net.sourceforge.f2j:arpack_combined_all:jar:0.1", required = true)
- protected String input;
-
- /**
- * The artifact of the javadocs to extract parameter names.
- * Note that this must be listed as a <code>dependency</code>
- * section of the calling module, not a plugin <code>dependency</code>.
- */
- @Parameter(defaultValue = "net.sourceforge.f2j:arpack_combined_all:jar:javadoc:0.1")
- protected String javadoc;
-
- /**
- * The package to scan.
- */
- @Parameter(required = true)
- protected String scan;
-
- /**
- * Method names to exclude (regex);
- */
- @Parameter
- protected String exclude;
-
- @Component
- protected MavenProject project;
-
- protected File getFile(String artifactName) {
- // artifactMap is a bit too simplistic
- for (Artifact artifact : project.getArtifacts())
- if (artifact.toString().startsWith(artifactName))
- return artifact.getFile();
- throw new IllegalArgumentException("could not find " + artifactName + " in " + project.getArtifacts());
- }
-
- /**
- * Implementation specific interpretation of the parameters.
- *
- * @param methods obtained from a scan of F2J public static methods.
- * @return the file contents for the generated file associated to the parameters.
- * @throws Exception
- */
- abstract protected String generate(List<Method> methods) throws Exception;
-
- protected Paranamer paranamer = new DefaultParanamer();
-
- @Override
- public void execute() throws MojoExecutionException {
- try {
- project.addCompileSourceRoot(outputDir.getAbsolutePath());
- File output = new File(outputDir, outputName);
- if (output.exists() && project.getFile().lastModified() < output.lastModified()) {
- getLog().info("No changes detected, skipping: " + output);
- return;
- }
-
- if (Strings.isNullOrEmpty(javadoc))
- getLog().warn("Javadocs not attached for paranamer.");
- else
- paranamer = new CachingParanamer(new JavadocParanamer(getFile(javadoc)));
-
- File jar = getFile(input);
- JarMethodScanner scanner = new JarMethodScanner(jar);
-
- List<Method> methods = Lists.newArrayList(
- Iterables.filter(scanner.getStaticMethods(scan), new Predicate<Method>() {
- @Override
- public boolean apply(Method input) {
- return exclude == null || !input.getName().matches(exclude);
- }
- }));
-
- String generated = generate(methods);
-
- output.getParentFile().mkdirs();
-
- getLog().info("Generating " + output.getAbsoluteFile());
- Files.write(generated, output, Charsets.UTF_8);
- } catch (Exception e) {
- throw new MojoExecutionException("java generation", e);
- }
- }
-
-
- /**
- * @param method
- * @return parameters names for the netlib interface.
- */
- protected List<String> getNetlibJavaParameterNames(Method method, boolean offsets) {
- final List<String> params = Lists.newArrayList();
- iterateRelevantParameters(method, offsets, new ParameterCallback() {
- @Override
- public void process(int i, Class<?> param, String name, String offsetName) {
- params.add(name);
- }
- });
- return params;
- }
-
- /**
- * @param method
- * @return canonical parameter types for the netlib interface.
- */
- protected List<String> getNetlibJavaParameterTypes(Method method, boolean offsets) {
- final List<String> types = Lists.newArrayList();
- iterateRelevantParameters(method, offsets, new ParameterCallback() {
- @Override
- public void process(int i, Class<?> param, String name, String offsetName) {
- types.add(param.getCanonicalName());
- }
- });
- return types;
- }
-
- protected interface ParameterCallback {
- void process(int i, Class<?> param, String name, @Nullable String offsetName);
- }
-
- /**
- * Calls the callback with every parameter of the method, skipping out the offset parameter
- * introduced by F2J for array arguments.
- *
- * @param method
- * @param callback
- */
- protected void iterateRelevantParameters(Method method, boolean offsets, ParameterCallback callback) {
- if (method.getParameterTypes().length == 0)
- return;
-
- String[] names = new String[0];
- try {
- names = paranamer.lookupParameterNames(method, true);
- } catch (ParameterNamesNotFoundException e) {
- getLog().warn(e);
- }
-
- for (int i = 0; i < method.getParameterTypes().length; i++) {
- Class<?> param = method.getParameterTypes()[i];
- if (i > 0 && !offsets && param == Integer.TYPE && method.getParameterTypes()[i - 1].isArray()) {
- continue;
- }
- String name;
- if (names.length > 0)
- name = names[i];
- else
- name = "arg" + i;
-
- String offsetName = null;
- if (i < method.getParameterTypes().length - 1
- && param.isArray()
- && method.getParameterTypes()[i + 1] == Integer.TYPE)
- offsetName = names[i+1];
-
- callback.process(i, param, name, offsetName);
- }
- }
-
- public boolean hasOffsets(Method method) {
- Class<?> last = null;
- for (int i = 0; i < method.getParameterTypes().length; i++) {
- Class<?> param = method.getParameterTypes()[i];
- if (last != null && last.isArray() && param.equals(Integer.TYPE))
- return true;
- last = param;
- }
- return false;
- }
-
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/F2jImplGenerator.java b/generator/src/main/java/com/github/fommil/netlib/generator/F2jImplGenerator.java
deleted file mode 100644
index fcc7384..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/F2jImplGenerator.java
+++ /dev/null
@@ -1,77 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.collect.Lists;
-import org.apache.maven.plugins.annotations.LifecyclePhase;
-import org.apache.maven.plugins.annotations.Mojo;
-import org.apache.maven.plugins.annotations.Parameter;
-import org.apache.maven.plugins.annotations.ResolutionScope;
-import org.stringtemplate.v4.ST;
-
-import java.lang.reflect.Method;
-import java.util.List;
-
-/**
- * Generates the F2J implementation of a netlib-java interface for the given methods.
- */
- at Mojo(
- name = "f2j",
- defaultPhase = LifecyclePhase.GENERATE_SOURCES,
- requiresDependencyResolution = ResolutionScope.COMPILE
-)
-public class F2jImplGenerator extends AbstractJavaGenerator {
-
- /**
- * The interface that we are implementing.
- */
- @Parameter(required = true)
- protected String implementing;
-
- @Override
- protected String generate(List<Method> methods) throws Exception {
- List<String> members = Lists.newArrayList();
- for (Method method : methods) {
- members.add(renderMethod(method, false));
- if (hasOffsets(method))
- members.add(renderMethod(method, true));
- }
-
- ST t = jTemplates.getInstanceOf("implClass");
- t.add("package", getTargetPackage());
- t.add("name", getTargetClassName());
- t.add("members", members);
- t.add("docs", getGenerationSummaryJavadocs());
- t.add("parent", implementing);
-
- return t.render();
- }
-
- private String renderMethod(Method method, boolean offsets) {
- ST m = jTemplates.getInstanceOf("f2jImplMethod");
- m.add("returns", method.getReturnType());
- m.add("method", method.getName());
- m.add("paramTypes", getNetlibJavaParameterTypes(method, offsets));
- m.add("paramNames", getNetlibJavaParameterNames(method, offsets));
- m.add("impl", method.getDeclaringClass().getCanonicalName() + "." + method.getName());
- m.add("calls", getF2jJavaParameters(method, offsets));
- if (method.getReturnType().equals(Void.TYPE))
- m.add("return", "");
- return m.render();
- }
-
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/F2jJavadocExtractor.java b/generator/src/main/java/com/github/fommil/netlib/generator/F2jJavadocExtractor.java
deleted file mode 100644
index f676151..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/F2jJavadocExtractor.java
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.io.CharStreams;
-import lombok.Cleanup;
-import lombok.RequiredArgsConstructor;
-
-import java.io.File;
-import java.io.IOException;
-import java.io.InputStreamReader;
-import java.lang.reflect.Method;
-import java.util.Enumeration;
-import java.util.regex.Matcher;
-import java.util.regex.Pattern;
-import java.util.zip.ZipEntry;
-import java.util.zip.ZipFile;
-
-import static java.lang.String.format;
-
-/**
- * Extracts F2J Javadoc comments.
- *
- * @author Sam Halliday
- */
- at RequiredArgsConstructor
-public class F2jJavadocExtractor {
-
- private final File jar;
-
- private String getRawJavadoc(Method method) throws IOException {
- String filename = method.getDeclaringClass().getCanonicalName().replace(".", "/") + ".html";
-
- @Cleanup ZipFile zip = new ZipFile(jar);
- Enumeration<? extends ZipEntry> en = zip.entries();
- while (en.hasMoreElements()) {
- ZipEntry entry = en.nextElement();
- if (entry.getName().endsWith(filename)) {
- @Cleanup InputStreamReader stream = new InputStreamReader(zip.getInputStream(entry), "UTF-8");
- return CharStreams.toString(stream);
- }
- }
- return "";
- }
-
- public String getJavadocDescription(Method method) throws IOException {
- Pattern pattern = Pattern.compile("seymour at cs.utk.edu</a> with any questions.\n<p>");
- String javadoc = getRawJavadoc(method);
- Matcher matcher = pattern.matcher(javadoc);
- boolean matched = matcher.find();
- if (!matched) return format(
- "<i>{@code %s} could not find docs for {@code %s} in {@code %s}</i>.",
- getClass().getSimpleName(), method, jar.getName()
- );
-
- int start = matcher.end();
- int end = javadoc.indexOf("</pre>", start);
- javadoc = javadoc.substring(start, end).replaceAll("\n\\s*c(?!\\w)", "\n").replace("\n\n", "\n");
- return "<pre><code>" + javadoc + " * </code></pre>";
- }
-
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/JarMethodScanner.java b/generator/src/main/java/com/github/fommil/netlib/generator/JarMethodScanner.java
deleted file mode 100644
index 5244b72..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/JarMethodScanner.java
+++ /dev/null
@@ -1,92 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import lombok.Cleanup;
-import lombok.NonNull;
-import lombok.RequiredArgsConstructor;
-import lombok.extern.java.Log;
-
-import java.io.File;
-import java.io.IOException;
-import java.lang.reflect.Method;
-import java.net.MalformedURLException;
-import java.net.URL;
-import java.net.URLClassLoader;
-import java.util.Enumeration;
-import java.util.List;
-import java.util.jar.JarEntry;
-import java.util.jar.JarFile;
-
-import static com.google.common.collect.Lists.newArrayList;
-import static java.lang.reflect.Modifier.isPublic;
-import static java.lang.reflect.Modifier.isStatic;
-
-/**
- * Scans jar files for methods.
- * <p>
- * <b>SIDE-EFFECT WARNING: discovered classes are loaded</b>
- * (only point at trusted jars, as arbitrary code may be invoked).
- *
- * @author Sam Halliday
- */
- at RequiredArgsConstructor
- at Log
-public class JarMethodScanner {
-
- @NonNull
- private final File file;
-
- private URLClassLoader createLoader() {
- try {
- URL url = file.toURI().toURL();
- return new URLClassLoader(new URL[]{url});
- } catch (MalformedURLException e) {
- throw new IllegalArgumentException(e);
- }
- }
-
- private List<String> getClasses(String packageName) throws IOException {
- @Cleanup JarFile jar = new JarFile(file);
- List<String> matched = newArrayList();
- for (Enumeration<JarEntry> entries = jar.entries(); entries.hasMoreElements(); ) {
- String entryName = entries.nextElement().getName();
- if (entryName.startsWith(packageName.replace(".", "/")) && entryName.endsWith(".class"))
- matched.add(entryName.replace(".class", "").replace("/", "."));
- }
- return matched;
- }
-
- public List<Method> getStaticMethods(String packageName) throws Exception {
- List<Method> methods = newArrayList();
- List<String> classNames = getClasses(packageName);
- URLClassLoader loader = createLoader();
-
- for (String className : classNames) {
- Class<?> clazz = loader.loadClass(className);
- for (Method method : clazz.getMethods()) {
- int modifiers = method.getModifiers();
- String fqn = method.getDeclaringClass().getCanonicalName();
- if (isStatic(modifiers) && isPublic(modifiers) && fqn.startsWith(packageName))
- methods.add(method);
- }
- }
-
- return methods;
- }
-
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/JavaInterfaceGenerator.java b/generator/src/main/java/com/github/fommil/netlib/generator/JavaInterfaceGenerator.java
deleted file mode 100644
index 97215e3..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/JavaInterfaceGenerator.java
+++ /dev/null
@@ -1,97 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.base.Strings;
-import com.google.common.collect.Lists;
-import org.apache.maven.plugins.annotations.LifecyclePhase;
-import org.apache.maven.plugins.annotations.Mojo;
-import org.apache.maven.plugins.annotations.Parameter;
-import org.apache.maven.plugins.annotations.ResolutionScope;
-import org.stringtemplate.v4.ST;
-
-import java.io.File;
-import java.io.IOException;
-import java.lang.reflect.Method;
-import java.util.List;
-
- at Mojo(
- name = "interface",
- defaultPhase = LifecyclePhase.GENERATE_SOURCES,
- requiresDependencyResolution = ResolutionScope.COMPILE
-)
-public class JavaInterfaceGenerator extends AbstractJavaGenerator {
-
- /**
- * The fallback implementation.
- */
- @Parameter(required = true)
- protected String fallback;
-
- /**
- * The default implementations (CSV).
- */
- @Parameter(required = true)
- protected String impls;
-
- /**
- * Arbitrary Java code that is run after instance creation.
- */
- @Parameter
- protected String initCode;
-
- @Override
- protected String generate(List<Method> methods) throws Exception {
- List<String> members = Lists.newArrayList();
- for (Method method : methods) {
- members.add(renderMethod(method, false));
- if (hasOffsets(method))
- members.add(renderMethod(method, true));
- }
-
- ST t = jTemplates.getInstanceOf("abstractClass");
- t.add("package", getTargetPackage());
- t.add("name", getTargetClassName());
- t.add("members", members);
- t.add("docs", getGenerationSummaryJavadocs());
- t.add("fallback", fallback);
- t.add("impls", impls);
- if (!Strings.isNullOrEmpty(initCode))
- t.add("initCode", initCode);
-
- return t.render();
- }
-
- private String renderMethod(Method method, boolean offsets) throws IOException {
- ST m = jTemplates.getInstanceOf("abstractMethod");
- m.add("return", method.getReturnType());
- if (method.getReturnType().equals(Void.TYPE))
- m.add("returnDocs", "");
- m.add("method", method.getName());
- m.add("paramTypes", getNetlibJavaParameterTypes(method, offsets));
- m.add("paramNames", getNetlibJavaParameterNames(method, offsets));
- if (!Strings.isNullOrEmpty(javadoc))
- m.add("docs", getJavadocs(method));
- return m.render();
- }
-
- private String getJavadocs(Method method) throws IOException {
- File jar = getFile(javadoc);
- F2jJavadocExtractor extractor = new F2jJavadocExtractor(jar);
- return extractor.getJavadocDescription(method);
- }
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/NativeImplJavaGenerator.java b/generator/src/main/java/com/github/fommil/netlib/generator/NativeImplJavaGenerator.java
deleted file mode 100644
index 5cdaf8b..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/NativeImplJavaGenerator.java
+++ /dev/null
@@ -1,114 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.collect.Lists;
-import org.apache.maven.plugins.annotations.LifecyclePhase;
-import org.apache.maven.plugins.annotations.Mojo;
-import org.apache.maven.plugins.annotations.Parameter;
-import org.apache.maven.plugins.annotations.ResolutionScope;
-import org.stringtemplate.v4.ST;
-
-import java.lang.reflect.Method;
-import java.util.List;
-
-/**
- * Generates the Java part of a JNI implementation of a netlib interface.
- */
- at Mojo(
- name = "native-java",
- defaultPhase = LifecyclePhase.GENERATE_SOURCES,
- requiresDependencyResolution = ResolutionScope.COMPILE
-)
-public class NativeImplJavaGenerator extends AbstractJavaGenerator {
-
- /**
- * The interface that we are implementing.
- */
- @Parameter(required = true)
- protected String implementing;
-
- /**
- * The default name of the native libraries. CSV.
- */
- @Parameter(required = true)
- protected String natives;
-
- /**
- * The implementation that we are extending (if not specified,
- * {@link UnsupportedOperationException} may be thrown by excluded
- * methods we are implementing).
- *
- * @see #unsupported
- */
- @Parameter
- protected String extending;
-
- /**
- * Methods we don't support.
- */
- @Parameter
- protected String unsupported;
-
- @Override
- protected String generate(List<Method> methods) throws Exception {
- List<String> members = Lists.newArrayList();
-
- ST loader = jTemplates.getInstanceOf("staticJniLoader");
- loader.add("lib", natives);
- loader.add("prop", getTargetPackage() + "." + getTargetClassName() + ".natives");
- members.add(loader.render());
-
- for (Method method : methods) {
- ST m = getTemplate(method, false);
- if (m == null) continue;
- members.add(render(m, method, false));
- if (hasOffsets(method))
- members.add(render(getTemplate(method, true), method, true));
- }
-
- ST t = jTemplates.getInstanceOf("implClass");
- t.add("package", getTargetPackage());
- t.add("name", getTargetClassName());
- t.add("members", members);
- t.add("docs", getGenerationSummaryJavadocs());
- t.add("parent", extending != null ? extending : implementing);
-
- return t.render();
- }
-
- private ST getTemplate(Method method, boolean offsets) {
- ST m = jTemplates.getInstanceOf("nativeImplMethod" + (offsets ? "_offsets" : ""));
- if (unsupported != null && method.getName().matches(unsupported)) {
- if (extending == null)
- m = jTemplates.getInstanceOf("unsupportedMethod");
- else
- return null;
- }
- return m;
- }
-
- private String render(ST m, Method method, boolean offsets) {
- m.add("returns", method.getReturnType());
- if (offsets && method.getReturnType() == Void.TYPE)
- m.add("return", "");
- m.add("method", method.getName());
- m.add("paramTypes", getNetlibJavaParameterTypes(method, offsets));
- m.add("paramNames", getNetlibJavaParameterNames(method, offsets));
- return m.render();
- }
-}
diff --git a/generator/src/main/java/com/github/fommil/netlib/generator/NativeImplJniGenerator.java b/generator/src/main/java/com/github/fommil/netlib/generator/NativeImplJniGenerator.java
deleted file mode 100644
index 93f85d9..0000000
--- a/generator/src/main/java/com/github/fommil/netlib/generator/NativeImplJniGenerator.java
+++ /dev/null
@@ -1,232 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-package com.github.fommil.netlib.generator;
-
-import com.google.common.collect.Iterables;
-import com.google.common.collect.Lists;
-import org.apache.maven.plugins.annotations.LifecyclePhase;
-import org.apache.maven.plugins.annotations.Mojo;
-import org.apache.maven.plugins.annotations.Parameter;
-import org.apache.maven.plugins.annotations.ResolutionScope;
-import org.stringtemplate.v4.ST;
-import org.stringtemplate.v4.STGroupFile;
-
-import java.lang.reflect.Method;
-import java.util.Collections;
-import java.util.LinkedList;
-import java.util.List;
-
- at Mojo(
- name = "native-jni",
- defaultPhase = LifecyclePhase.GENERATE_SOURCES,
- requiresDependencyResolution = ResolutionScope.COMPILE
-)
-public class NativeImplJniGenerator extends AbstractNetlibGenerator {
-
- protected final STGroupFile jniTemplates = new STGroupFile("com/github/fommil/netlib/generator/netlib-jni.stg", '$', '$');
-
- /**
- * The interface that we are implementing.
- */
- @Parameter(required = true)
- protected String implementing;
-
- /**
- * C Header files to include
- */
- @Parameter
- protected List<String> includes;
-
- /**
- * Prepended to the native function name.
- */
- @Parameter
- protected String prefix = "";
-
- /**
- * Suffixed to the native function name.
- */
- @Parameter
- protected String suffix = "";
-
- /**
- * Prepended to the native function parameter list.
- */
- @Parameter
- protected String firstParam;
-
- @Parameter
- protected String noFirstParam;
-
- @Parameter
- protected boolean cblas_hack;
-
- @Parameter
- protected boolean lapacke_hack;
-
- @Parameter
- protected boolean fortran_hack;
-
- @Parameter
- protected boolean extractChar;
-
- @Override
- protected String generate(List<Method> methods) throws Exception {
- ST t = jniTemplates.getInstanceOf("jni");
-
- if (includes == null)
- includes = Lists.newArrayList();
-
- includes.add(outputName.replace(".c", ".h"));
- t.add("includes", includes);
-
- List<String> members = Lists.newArrayList();
- for (Method method : methods) {
- members.add(render(method, false));
- if (hasOffsets(method))
- members.add(render(method, true));
- }
-
- t.add("members", members);
-
- return t.render();
- }
-
- private String render(Method method, boolean offsets) {
- ST f = jniTemplates.getInstanceOf("function");
- f.add("returns", jType2C(method.getReturnType()));
- f.add("fqn", (implementing + "." + method.getName()).replace(".", "_") + (offsets ? "_1offsets" : ""));
- f.add("name", prefix + method.getName() + suffix);
- List<String> params = getNetlibCParameterTypes(method, offsets);
- List<String> names = getNetlibJavaParameterNames(method, offsets);
- f.add("paramTypes", params);
- f.add("paramNames", names);
- f.add("params", getCMethodParams(method, offsets));
-
- if (method.getReturnType() == Void.TYPE) {
- if (lapacke_hack && Iterables.getLast(names).equals("info")) {
- f.add("assignReturn", "int returnValue = ");
- } else {
- f.add("assignReturn", "");
- }
- f.add("return", "");
- } else {
- f.add("assignReturn", jType2C(method.getReturnType()) + " returnValue = ");
- f.add("return", "return returnValue;");
- }
-
- List<String> init = Lists.newArrayList();
- List<String> clean = Lists.newArrayList();
-
- for (int i = 0; i < params.size(); i++) {
- String param = params.get(i);
- String name = names.get(i);
- ST before = jniTemplates.getInstanceOf(param + "_init");
- if (lapacke_hack && name.equals("info"))
- before = jniTemplates.getInstanceOf(param + "_info_init");
- if (before != null) {
- before.add("name", name);
- init.add(before.render());
- }
-
- ST after = jniTemplates.getInstanceOf(param + "_clean");
- if (lapacke_hack && name.equals("info"))
- after = jniTemplates.getInstanceOf(param + "_info_clean");
- if (after != null) {
- after.add("name", name);
- clean.add(after.render());
- }
- }
- Collections.reverse(clean);
-
- f.add("init", init);
- f.add("clean", clean);
- return f.render();
- }
-
- private List<String> getNetlibCParameterTypes(Method method, boolean offsets) {
- final List<String> types = Lists.newArrayList();
- iterateRelevantParameters(method, offsets, new ParameterCallback() {
- @Override
- public void process(int i, Class<?> param, String name, String offsetName) {
- types.add(jType2C(param));
- }
- });
- return types;
- }
-
- private String jType2C(Class param) {
- if (param == Void.TYPE)
- return "void";
- if (param.isArray())
- return "j" + param.getComponentType().getSimpleName() + "Array";
- return "j" + param.getSimpleName().toLowerCase();
- }
-
- private List<String> getCMethodParams(final Method method, final boolean offsets) {
- final LinkedList<String> params = Lists.newLinkedList();
- if (firstParam != null && !method.getName().matches(noFirstParam)) {
- params.add(firstParam);
- }
-
- iterateRelevantParameters(method, false, new ParameterCallback() {
- @Override
- public void process(int i, Class<?> param, String name, String offsetName) {
- if (lapacke_hack && name.equals("info"))
- return;
-
- if (param == Object.class)
- throw new UnsupportedOperationException(method + " " + param + " " + name);
-
- if (param == Boolean.TYPE || !param.isPrimitive()) {
- name = "jni_" + name;
- // NOTE: direct comparisons against StringW.class don't work as expected
- if (!param.getSimpleName().equals("StringW") && param.getSimpleName().endsWith("W")) {
- name = "&" + name;
- }
- }
-
- if (param == String.class) {
- if (cblas_hack) {
- if (name.contains("trans"))
- name = "getCblasTrans(" + name + ")";
- else if (name.contains("uplo"))
- name = "getCblasUpLo(" + name + ")";
- else if (name.contains("side"))
- name = "getCblasSide(" + name + ")";
- else if (name.contains("diag"))
- name = "getCblasDiag(" + name + ")";
- }
- }
-
- if (!fortran_hack && param == String.class && extractChar)
- name = name + "[0]";
-
- if (fortran_hack && param.isPrimitive())
- name = "&" + name;
-
- if (offsets & offsetName != null) {
- name = name + " + " + offsetName;
- }
-
- params.add(name);
- }
- });
-
- return params;
- }
-}
diff --git a/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-common.stg b/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-common.stg
deleted file mode 100644
index 25111d2..0000000
--- a/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-common.stg
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-
-// http://www.antlr.org/wiki/display/ST4/Group+file+syntax
-// http://www.antlr.org/wiki/display/ST4/Templates
-
-group netlib-java;
-
-copyright() ::= <<
-/* Copyright 2013 Samuel Halliday (generated Java and C).
- * Copyright 2003-2007 Keith Seymour (Fortran to Java translation).
- * Copyright 1992-2007 The University of Tennessee. All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- *
- * - Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- *
- * - Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer listed
- * in this license in the documentation and/or other materials
- * provided with the distribution.
- *
- * - Neither the name of the copyright holders nor the names of its
- * contributors may be used to endorse or promote products derived from
- * this software without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
- * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
- * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
- * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
- * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
- * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
- * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
- * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
- * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
->>
diff --git a/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-java.stg b/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-java.stg
deleted file mode 100644
index 1ffc714..0000000
--- a/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-java.stg
+++ /dev/null
@@ -1,145 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-
-group netlib-java;
-
-import "netlib-common.stg"
-
-implClass(package, name, members, docs, parent) ::= <<
-$copyright()$
-package $package$;
-
-/**
- * $docs$
- */
-public class $name$ extends $parent$ {
- $members; separator="\n\n"$
-}
->>
-
-params(paramTypes, paramNames) ::= <<
-$paramTypes,paramNames:{t,p|$t$ $p$};separator=", "$
->>
-
-f2jImplMethod(returns, method, impl, paramTypes, paramNames, calls, return="return") ::= <<
- at Override
-public $returns$ $method$($params(paramTypes,paramNames)$) {
- $return$ $impl$($calls; separator=", "$);
-}
->>
-
-
-abstractMethod(return, method, paramTypes, paramNames, docs = "", returnDocs = "@return") ::= <<
-/**
- * $docs$
- *
-$paramNames:{n| * @param $n$};separator="\n"$
- * $returnDocs$
- */
-abstract public $return$ $method$($params(paramTypes,paramNames)$);
->>
-
-abstractClass(package, name, members, docs, fallback, impls, initCode = "") ::= <<
-$copyright()$
-package $package$;
-
-/**
- * $docs$
- * <p>
- * Property {@value #PROPERTY_KEY} defines the implementation to load,
- * defaulting to {@value #FALLBACK}.
- * <p>
- * <i>This requires 1D column-major linearized arrays, as
- * expected by the lower level routines; contrary to
- * typical Java 2D row-major arrays.</i>
- */
- at lombok.extern.java.Log
-public abstract class $name$ {
-
- private static final String FALLBACK = "$fallback$";
- private static final String IMPLS = "$impls$";
- private static final String PROPERTY_KEY = "$package$.$name$";
- private static final $name$ INSTANCE;
- static {
- try {
- String[] classNames = System.getProperty(PROPERTY_KEY, IMPLS).split(",");
- $name$ impl = null;
- for (String className: classNames) {
- try {
- impl = load(className);
- break;
- } catch (Exception e) {
- log.warning("Failed to load implementation from: " + className);
- }
- }
- if (impl == null) {
- log.warning("Using the fallback implementation.");
- impl = load(FALLBACK);
- }
- INSTANCE = impl;
- log.config("Implementation provided by " + INSTANCE.getClass());
- $initCode$
- } catch (Exception e) {
- throw new ExceptionInInitializerError(e);
- }
- }
-
- private static $name$ load(String className) throws Exception {
- Class klass = Class.forName(className);
- return ($name$) klass.newInstance();
- }
-
- /**
- * @return the environment-defined implementation.
- */
- public static $name$ getInstance() {
- return INSTANCE;
- }
-
- $members; separator="\n\n"$
-}
->>
-
-nativeImplMethod(returns, method, paramTypes, paramNames) ::= <<
- at Override
-public native $returns$ $method$($params(paramTypes,paramNames)$);
->>
-
-nativeImplMethod_offsets(returns, method, paramTypes, paramNames, return="return ") ::= <<
- at Override
-public $returns$ $method$($params(paramTypes,paramNames)$) {
- $return$$method$_offsets($paramNames; separator=", "$);
-}
-
-public native $returns$ $method$_offsets($params(paramTypes,paramNames)$);
->>
-
-
-unsupportedMethod(returns, method, paramTypes, paramNames) ::= <<
- at Override
-public $returns$ $method$($params(paramTypes,paramNames)$) {
- throw new UnsupportedOperationException();
-}
->>
-
-staticJniLoader(prop, lib) ::= <<
-static {
- String jnilib = com.github.fommil.jni.JniNamer.getJniName("$lib$");
- String natives = System.getProperty("$prop$", jnilib);
- com.github.fommil.jni.JniLoader.load(natives.split(","));
-}
->>
\ No newline at end of file
diff --git a/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-jni.stg b/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-jni.stg
deleted file mode 100644
index db8183f..0000000
--- a/generator/src/main/resources/com/github/fommil/netlib/generator/netlib-jni.stg
+++ /dev/null
@@ -1,159 +0,0 @@
-/*
- * Copyright (C) 2013 Samuel Halliday
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program. If not, see [http://www.gnu.org/licenses/].
- */
-
-group netlib-java;
-
-import "netlib-common.stg"
-import "netlib-java.stg"
-
-include(files) ::= <<
-$files:{f|#include <$f$>};separator="\n"$
->>
-
-function(returns, fqn, init, clean, paramTypes, paramNames, assignReturn, return, params, name) ::= <<
-JNIEXPORT $returns$ JNICALL Java_$fqn$ (JNIEnv * env, jobject calling_obj, $params(paramTypes,paramNames)$) {
- $init; separator="\n"$
- $assignReturn$$name$($params;separator=", "$);
- $clean; separator="\n"$
- $return$
-}
->>
-
-jni(includes, members) ::= <<
-$copyright()$
-
-#include <jni.h>
-#include <netlib-jni.h>
-$include(includes)$
-
-$members; separator="\n\n"$
->>
-
-array_init(type, name) ::= <<
-$type$ * jni_$name$ = NULL;
-if ($name$ != NULL) {
- jni_$name$ = (*env)->GetPrimitiveArrayCritical(env, $name$, JNI_FALSE);
- check_memory(env, jni_$name$);
-}
->>
-
-array_clean(name) ::= <<
-if ($name$ != NULL) {
- (*env)->ReleasePrimitiveArrayCritical(env, $name$, jni_$name$, 0);
-}
->>
-
-jdoubleArray_init(name, type="jdouble") ::= "$array_init(type, name)$"
-jdoubleArray_clean(name) ::= "$array_clean(name)$"
-jfloatArray_init(name, type="jfloat") ::= "$array_init(type, name)$"
-jfloatArray_clean(name) ::= "$array_clean(name)$"
-jintArray_init(name, type="jint") ::= "$array_init(type, name)$"
-jintArray_clean(name) ::= "$array_clean(name)$"
-
-jbooleanArray_init(name) ::= <<
-jboolean * jni_$name$_raw = NULL;
-jint jni_$name$_size = 0;
-int* jni_$name$ = NULL;
-if ($name$ != NULL) {
- jni_$name$_raw = (*env)->GetPrimitiveArrayCritical(env, $name$, JNI_FALSE);
- check_memory(env, jni_$name$_raw);
- jni_$name$_size = (*env)->GetArrayLength(env, $name$);
- jni_$name$ = jbooleanArray2intArray(env, jni_$name$_raw, jni_$name$_size);
-}
->>
-
-jbooleanArray_clean(name) ::= <<
-if ($name$ != NULL) {
- intArray2jbooleanArray(jni_$name$, jni_$name$_raw, jni_$name$_size);
- free(jni_$name$);
- (*env)->ReleasePrimitiveArrayCritical(env, $name$, jni_$name$_raw, 0);
-}
->>
-
-jstring_init(name) ::= <<
-char * jni_$name$ = (char *)(*env)->GetStringUTFChars(env, $name$, JNI_FALSE);
->>
-
-jstring_clean(name) ::= <<
-(*env)->ReleaseStringUTFChars(env, $name$, jni_$name$);
->>
-
-jboolean_init(name) ::= <<
-int jni_$name$ = jboolean2int($name$);
->>
-
-jfloatw_init(name) ::= <<
-jclass jni_$name$Class = (*env)->GetObjectClass(env, $name$);
-jfieldID jni_$name$Id = (*env)->GetFieldID(env, jni_$name$Class, "val", "F");
-jfloat jni_$name$ = (*env)->GetFloatField(env, $name$, jni_$name$Id);
->>
-
-jfloatw_clean(name) ::= <<
-(*env)->SetFloatField(env, $name$, jni_$name$Id, jni_$name$);
->>
-
-jdoublew_init(name) ::= <<
-jclass jni_$name$Class = (*env)->GetObjectClass(env, $name$);
-jfieldID jni_$name$Id = (*env)->GetFieldID(env, jni_$name$Class, "val", "D");
-jdouble jni_$name$ = (*env)->GetDoubleField(env, $name$, jni_$name$Id);
->>
-
-jdoublew_clean(name) ::= <<
-(*env)->SetDoubleField(env, $name$, jni_$name$Id, jni_$name$);
->>
-
-jintw_init(name) ::= <<
-jclass jni_$name$Class = (*env)->GetObjectClass(env, $name$);
-jfieldID jni_$name$Id = (*env)->GetFieldID(env, jni_$name$Class, "val", "I");
-jint jni_$name$ = (*env)->GetIntField(env, $name$, jni_$name$Id);
->>
-
-jintw_clean(name) ::= <<
-(*env)->SetIntField(env, $name$, jni_$name$Id, jni_$name$);
->>
-
-jintw_info_init(name) ::= <<
-jclass jni_$name$Class = (*env)->GetObjectClass(env, $name$);
-jfieldID jni_$name$Id = (*env)->GetFieldID(env, jni_$name$Class, "val", "I");
->>
-
-jintw_info_clean(name) ::= <<
-(*env)->SetIntField(env, $name$, jni_$name$Id, returnValue);
->>
-
-jstringw_init(name) ::= <<
-jclass jni_$name$Class = (*env)->GetObjectClass(env, $name$);
-jfieldID jni_$name$Id = (*env)->GetFieldID(env, jni_$name$Class, "val", "Ljava/lang/String;");
-jstring jni_$name$String = (jstring)((*env)->GetObjectField(env, $name$, jni_$name$Id));
-char * jni_$name$ = (char *)(*env)->GetStringUTFChars(env, jni_$name$String, JNI_FALSE);
->>
-
-jstringw_clean(name) ::= <<
-(*env)->SetObjectField(env, $name$, jni_$name$Id, (*env)->NewStringUTF(env, jni_$name$));
->>
-
-jbooleanw_init(name) ::= <<
-jclass jni_$name$Class = (*env)->GetObjectClass(env, $name$);
-jfieldID jni_$name$Id = (*env)->GetFieldID(env, jni_$name$Class, "val", "Z");
-jboolean jni_$name$_raw = (*env)->GetBooleanField(env, $name$, jni_$name$Id);
-int jni_$name$ = jboolean2int(jni_$name$_raw);
->>
-
-jbooleanw_clean(name) ::= <<
-jni_$name$_raw = int2jboolean(jni_$name$);
-(*env)->SetIntField(env, $name$, jni_$name$Id, jni_$name$_raw);
->>
diff --git a/javadoc/allclasses-frame.html b/javadoc/allclasses-frame.html
new file mode 100644
index 0000000..fd86b73
--- /dev/null
+++ b/javadoc/allclasses-frame.html
@@ -0,0 +1,42 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+All Classes
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+<FONT size="+1" CLASS="FrameHeadingFont">
+<B>All Classes</B></FONT>
+<BR>
+
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT CLASS="FrameItemFont"><A HREF="org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack" target="classFrame">ARPACK</A>
+<BR>
+<A HREF="org/netlib/blas/BLAS.html" title="class in org.netlib.blas" target="classFrame">BLAS</A>
+<BR>
+<A HREF="org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils" target="classFrame">JNIMethods</A>
+<BR>
+<A HREF="org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils" target="classFrame">JNIMethods.ARCHType</A>
+<BR>
+<A HREF="org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils" target="classFrame">JNIMethods.OSType</A>
+<BR>
+<A HREF="org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack" target="classFrame">LAPACK</A>
+<BR>
+</FONT></TD>
+</TR>
+</TABLE>
+
+</BODY>
+</HTML>
diff --git a/javadoc/allclasses-noframe.html b/javadoc/allclasses-noframe.html
new file mode 100644
index 0000000..3df3145
--- /dev/null
+++ b/javadoc/allclasses-noframe.html
@@ -0,0 +1,42 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+All Classes
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+<FONT size="+1" CLASS="FrameHeadingFont">
+<B>All Classes</B></FONT>
+<BR>
+
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT CLASS="FrameItemFont"><A HREF="org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<BR>
+<A HREF="org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<BR>
+<A HREF="org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A>
+<BR>
+<A HREF="org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>
+<BR>
+<A HREF="org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>
+<BR>
+<A HREF="org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<BR>
+</FONT></TD>
+</TR>
+</TABLE>
+
+</BODY>
+</HTML>
diff --git a/javadoc/constant-values.html b/javadoc/constant-values.html
new file mode 100644
index 0000000..cdd4973
--- /dev/null
+++ b/javadoc/constant-values.html
@@ -0,0 +1,147 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Constant Field Values
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Constant Field Values";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?constant-values.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="constant-values.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H1>
+Constant Field Values</H1>
+</CENTER>
+<HR SIZE="4" NOSHADE>
+<B>Contents</B><UL>
+</UL>
+
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?constant-values.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="constant-values.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/deprecated-list.html b/javadoc/deprecated-list.html
new file mode 100644
index 0000000..b6ed6a4
--- /dev/null
+++ b/javadoc/deprecated-list.html
@@ -0,0 +1,147 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Deprecated List
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Deprecated List";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Deprecated</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?deprecated-list.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="deprecated-list.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Deprecated API</B></H2>
+</CENTER>
+<HR SIZE="4" NOSHADE>
+<B>Contents</B><UL>
+</UL>
+
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Deprecated</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?deprecated-list.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="deprecated-list.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/help-doc.html b/javadoc/help-doc.html
new file mode 100644
index 0000000..1f4e661
--- /dev/null
+++ b/javadoc/help-doc.html
@@ -0,0 +1,224 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+API Help
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="API Help";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Help</B></FONT> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?help-doc.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="help-doc.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H1>
+How This API Document Is Organized</H1>
+</CENTER>
+This API (Application Programming Interface) document has pages corresponding to the items in the navigation bar, described as follows.<H3>
+Overview</H3>
+<BLOCKQUOTE>
+
+<P>
+The <A HREF="overview-summary.html">Overview</A> page is the front page of this API document and provides a list of all packages with a summary for each. This page can also contain an overall description of the set of packages.</BLOCKQUOTE>
+<H3>
+Package</H3>
+<BLOCKQUOTE>
+
+<P>
+Each package has a page that contains a list of its classes and interfaces, with a summary for each. This page can contain four categories:<UL>
+<LI>Interfaces (italic)<LI>Classes<LI>Enums<LI>Exceptions<LI>Errors<LI>Annotation Types</UL>
+</BLOCKQUOTE>
+<H3>
+Class/Interface</H3>
+<BLOCKQUOTE>
+
+<P>
+Each class, interface, nested class and nested interface has its own separate page. Each of these pages has three sections consisting of a class/interface description, summary tables, and detailed member descriptions:<UL>
+<LI>Class inheritance diagram<LI>Direct Subclasses<LI>All Known Subinterfaces<LI>All Known Implementing Classes<LI>Class/interface declaration<LI>Class/interface description
+<P>
+<LI>Nested Class Summary<LI>Field Summary<LI>Constructor Summary<LI>Method Summary
+<P>
+<LI>Field Detail<LI>Constructor Detail<LI>Method Detail</UL>
+Each summary entry contains the first sentence from the detailed description for that item. The summary entries are alphabetical, while the detailed descriptions are in the order they appear in the source code. This preserves the logical groupings established by the programmer.</BLOCKQUOTE>
+</BLOCKQUOTE>
+<H3>
+Annotation Type</H3>
+<BLOCKQUOTE>
+
+<P>
+Each annotation type has its own separate page with the following sections:<UL>
+<LI>Annotation Type declaration<LI>Annotation Type description<LI>Required Element Summary<LI>Optional Element Summary<LI>Element Detail</UL>
+</BLOCKQUOTE>
+</BLOCKQUOTE>
+<H3>
+Enum</H3>
+<BLOCKQUOTE>
+
+<P>
+Each enum has its own separate page with the following sections:<UL>
+<LI>Enum declaration<LI>Enum description<LI>Enum Constant Summary<LI>Enum Constant Detail</UL>
+</BLOCKQUOTE>
+<H3>
+Use</H3>
+<BLOCKQUOTE>
+Each documented package, class and interface has its own Use page. This page describes what packages, classes, methods, constructors and fields use any part of the given class or package. Given a class or interface A, its Use page includes subclasses of A, fields declared as A, methods that return A, and methods and constructors with parameters of type A. You can access this page by first going to the package, class or interface, then clicking on the "Use" link in the navigation bar.</ [...]
+<H3>
+Tree (Class Hierarchy)</H3>
+<BLOCKQUOTE>
+There is a <A HREF="overview-tree.html">Class Hierarchy</A> page for all packages, plus a hierarchy for each package. Each hierarchy page contains a list of classes and a list of interfaces. The classes are organized by inheritance structure starting with <code>java.lang.Object</code>. The interfaces do not inherit from <code>java.lang.Object</code>.<UL>
+<LI>When viewing the Overview page, clicking on "Tree" displays the hierarchy for all packages.<LI>When viewing a particular package, class or interface page, clicking "Tree" displays the hierarchy for only that package.</UL>
+</BLOCKQUOTE>
+<H3>
+Deprecated API</H3>
+<BLOCKQUOTE>
+The <A HREF="deprecated-list.html">Deprecated API</A> page lists all of the API that have been deprecated. A deprecated API is not recommended for use, generally due to improvements, and a replacement API is usually given. Deprecated APIs may be removed in future implementations.</BLOCKQUOTE>
+<H3>
+Index</H3>
+<BLOCKQUOTE>
+The <A HREF="index-files/index-1.html">Index</A> contains an alphabetic list of all classes, interfaces, constructors, methods, and fields.</BLOCKQUOTE>
+<H3>
+Prev/Next</H3>
+These links take you to the next or previous class, interface, package, or related page.<H3>
+Frames/No Frames</H3>
+These links show and hide the HTML frames. All pages are available with or without frames.
+<P>
+<H3>
+Serialized Form</H3>
+Each serializable or externalizable class has a description of its serialization fields and methods. This information is of interest to re-implementors, not to developers using the API. While there is no link in the navigation bar, you can get to this information by going to any serialized class and clicking "Serialized Form" in the "See also" section of the class description.
+<P>
+<H3>
+Constant Field Values</H3>
+The <a href="constant-values.html">Constant Field Values</a> page lists the static final fields and their values.
+<P>
+<FONT SIZE="-1">
+<EM>
+This help file applies to API documentation generated using the standard doclet.</EM>
+</FONT>
+<BR>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Help</B></FONT> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?help-doc.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="help-doc.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-1.html b/javadoc/index-files/index-1.html
new file mode 100644
index 0000000..358c3a1
--- /dev/null
+++ b/javadoc/index-files/index-1.html
@@ -0,0 +1,150 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+A-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="A-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV LETTER
+ <A HREF="index-2.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-1.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-1.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_A_"><!-- --></A><H2>
+<B>A</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/utils/JNIMethods.html#ARCH"><B>ARCH</B></A> -
+Static variable in class org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A>
+<DD>Stores the CPU Architecture the JVM is currently running on.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack"><B>ARPACK</B></A> - Class in <A HREF="../org/netlib/arpack/package-summary.html">org.netlib.arpack</A><DD>ARPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.<DT><A HREF="../org/netlib/arpack/ARPACK.html#ARPACK()"><B>ARPACK()</B></A> -
+Constructor for class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV LETTER
+ <A HREF="index-2.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-1.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-1.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-10.html b/javadoc/index-files/index-10.html
new file mode 100644
index 0000000..4fdc1a0
--- /dev/null
+++ b/javadoc/index-files/index-10.html
@@ -0,0 +1,2186 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+S-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="S-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-9.html"><B>PREV LETTER</B></A>
+ <A HREF="index-11.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-10.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-10.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_S_"><!-- --></A><H2>
+<B>S</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/blas/BLAS.html#sasum(int, float[], int)"><B>sasum(int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#saxpy(int, float, float[], int, float[], int)"><B>saxpy(int, float, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sbdsdc(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], int, float[], int[], float[], int[], org.netlib.util.intW)"><B>sbdsdc(String, String, int, float[], float[], float[], int, float[], int, float[], int[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sbdsqr(java.lang.String, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><B>sbdsqr(String, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#scopy(int, float[], int, float[], int)"><B>scopy(int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sdisna(java.lang.String, int, int, float[], float[], org.netlib.util.intW)"><B>sdisna(String, int, int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sdot(int, float[], int, float[], int)"><B>sdot(int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sdsdot(int, float, float[], int, float[], int)"><B>sdsdot(int, float, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#second(org.netlib.util.floatW)"><B>second(floatW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#second()"><B>second()</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbbrd(java.lang.String, int, int, int, int, int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><B>sgbbrd(String, int, int, int, int, int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbcon(java.lang.String, int, int, int, float[], int, int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>sgbcon(String, int, int, int, float[], int, int[], float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbequ(int, int, int, int, float[], int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>sgbequ(int, int, int, int, float[], int, float[], float[], floatW, floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sgbmv(java.lang.String, int, int, int, int, float, float[], int, float[], int, float, float[], int)"><B>sgbmv(String, int, int, int, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbrfs(java.lang.String, int, int, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>sgbrfs(String, int, int, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbsv(int, int, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>sgbsv(int, int, int, int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbsvx(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], int, int[], org.netlib.util.StringW, float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>sgbsvx(String, String, int, int, int, int, float[], int, float[], int, int[], StringW, float[], float[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbtf2(int, int, int, int, float[], int, int[], org.netlib.util.intW)"><B>sgbtf2(int, int, int, int, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbtrf(int, int, int, int, float[], int, int[], org.netlib.util.intW)"><B>sgbtrf(int, int, int, int, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgbtrs(java.lang.String, int, int, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>sgbtrs(String, int, int, int, int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgebak(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>sgebak(String, String, int, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgebal(java.lang.String, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.intW)"><B>sgebal(String, int, float[], int, intW, intW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgebd2(int, int, float[], int, float[], float[], float[], float[], float[], org.netlib.util.intW)"><B>sgebd2(int, int, float[], int, float[], float[], float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgebrd(int, int, float[], int, float[], float[], float[], float[], float[], int, org.netlib.util.intW)"><B>sgebrd(int, int, float[], int, float[], float[], float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgecon(java.lang.String, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>sgecon(String, int, float[], int, float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeequ(int, int, float[], int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>sgeequ(int, int, float[], int, float[], float[], floatW, floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgees(java.lang.String, java.lang.String, java.lang.Object, int, float[], int, org.netlib.util.intW, float[], float[], float[], int, float[], int, boolean[], org.netlib.util.intW)"><B>sgees(String, String, Object, int, float[], int, intW, float[], float[], float[], int, float[], int, boolean[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeesx(java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, float[], int, org.netlib.util.intW, float[], float[], float[], int, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], int, boolean[], org.netlib.util.intW)"><B>sgeesx(String, String, Object, String, int, float[], int, intW, float[], float[], float[], int, floatW, floatW, float[], int, int[], int, boolean[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeev(java.lang.String, java.lang.String, int, float[], int, float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sgeev(String, String, int, float[], int, float[], float[], float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.floatW, float[], float[], float[], int, int[], org.netlib.util.intW)"><B>sgeevx(String, String, String, String, int, float[], int, float[], float[], float[], int, float[], int, intW, intW, float[], floatW, float[], float[], float[], [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgegs(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sgegs(String, String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgegv(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sgegv(String, String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgehd2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sgehd2(int, int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgehrd(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sgehrd(int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgelq2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sgelq2(int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgelqf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sgelqf(int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgels(java.lang.String, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sgels(String, int, int, int, float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgelsd(int, int, int, float[], int, float[], int, float[], float, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)"><B>sgelsd(int, int, int, float[], int, float[], int, float[], float, intW, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgelss(int, int, int, float[], int, float[], int, float[], float, org.netlib.util.intW, float[], int, org.netlib.util.intW)"><B>sgelss(int, int, int, float[], int, float[], int, float[], float, intW, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgelsx(int, int, int, float[], int, float[], int, int[], float, org.netlib.util.intW, float[], org.netlib.util.intW)"><B>sgelsx(int, int, int, float[], int, float[], int, int[], float, intW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgelsy(int, int, int, float[], int, float[], int, int[], float, org.netlib.util.intW, float[], int, org.netlib.util.intW)"><B>sgelsy(int, int, int, float[], int, float[], int, int[], float, intW, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sgemm(java.lang.String, java.lang.String, int, int, int, float, float[], int, float[], int, float, float[], int)"><B>sgemm(String, String, int, int, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sgemv(java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><B>sgemv(String, int, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeql2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sgeql2(int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeqlf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sgeqlf(int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeqp3(int, int, float[], int, int[], float[], float[], int, org.netlib.util.intW)"><B>sgeqp3(int, int, float[], int, int[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeqpf(int, int, float[], int, int[], float[], float[], org.netlib.util.intW)"><B>sgeqpf(int, int, float[], int, int[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeqr2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sgeqr2(int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgeqrf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sgeqrf(int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sger(int, int, float, float[], int, float[], int, float[], int)"><B>sger(int, int, float, float[], int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgerfs(java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>sgerfs(String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgerq2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sgerq2(int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgerqf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sgerqf(int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgesc2(int, float[], int, float[], int[], int[], org.netlib.util.floatW)"><B>sgesc2(int, float[], int, float[], int[], int[], floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgesdd(java.lang.String, int, int, float[], int, float[], float[], int, float[], int, float[], int, int[], org.netlib.util.intW)"><B>sgesdd(String, int, int, float[], int, float[], float[], int, float[], int, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgesv(int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>sgesv(int, int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgesvd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sgesvd(String, String, int, int, float[], int, float[], float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgesvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, int[], org.netlib.util.StringW, float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>sgesvx(String, String, int, int, float[], int, float[], int, int[], StringW, float[], float[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgetc2(int, float[], int, int[], int[], org.netlib.util.intW)"><B>sgetc2(int, float[], int, int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgetf2(int, int, float[], int, int[], org.netlib.util.intW)"><B>sgetf2(int, int, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgetrf(int, int, float[], int, int[], org.netlib.util.intW)"><B>sgetrf(int, int, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgetri(int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>sgetri(int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgetrs(java.lang.String, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>sgetrs(String, int, int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sgetv0(org.netlib.util.intW, java.lang.String, int, boolean, int, int, float[], int, float[], org.netlib.util.floatW, int[], float[], org.netlib.util.intW)"><B>sgetv0(intW, String, int, boolean, int, int, float[], int, float[], floatW, int[], float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggbak(java.lang.String, java.lang.String, int, int, int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sggbak(String, String, int, int, int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggbal(java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], org.netlib.util.intW)"><B>sggbal(String, int, float[], int, float[], int, intW, intW, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgges(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, int, float[], int, float[], int, org.netlib.util.intW, float[], float[], float[], float[], int, float[], int, float[], int, boolean[], org.netlib.util.intW)"><B>sgges(String, String, String, Object, int, float[], int, float[], int, intW, float[], float[], float[], float[], int, float[], int, float[], int, boolean[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggesx(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, float[], float[], float[], float[], int, float[], int, float[], float[], float[], int, int[], int, boolean[], org.netlib.util.intW)"><B>sggesx(String, String, String, Object, String, int, float[], int, float[], int, intW, float[], float[], float[], float[], int, float[], int, float[], float[], [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggev(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sggev(String, String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], float[], int, int[], boolean[], org.netlib.util.intW)"><B>sggevx(String, String, String, String, int, float[], int, float[], int, float[], float[], flo [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggglm(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)"><B>sggglm(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgghrd(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>sgghrd(String, String, int, int, int, float[], int, float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgglse(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)"><B>sgglse(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggqrf(int, int, int, float[], int, float[], float[], int, float[], float[], int, org.netlib.util.intW)"><B>sggqrf(int, int, int, float[], int, float[], float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggrqf(int, int, int, float[], int, float[], float[], int, float[], float[], int, org.netlib.util.intW)"><B>sggrqf(int, int, int, float[], int, float[], float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggsvd(java.lang.String, java.lang.String, java.lang.String, int, int, int, org.netlib.util.intW, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], int[], org.netlib.util.intW)"><B>sggsvd(String, String, String, int, int, int, intW, intW, float[], int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sggsvp(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float, float, org.netlib.util.intW, org.netlib.util.intW, float[], int, float[], int, float[], int, int[], float[], float[], org.netlib.util.intW)"><B>sggsvp(String, String, String, int, int, int, float[], int, float[], int, float, float, intW, intW, float[], int, float[], int, float[], int, int[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgtcon(java.lang.String, int, float[], float[], float[], float[], int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>sgtcon(String, int, float[], float[], float[], float[], int[], float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgtrfs(java.lang.String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>sgtrfs(String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgtsv(int, int, float[], float[], float[], float[], int, org.netlib.util.intW)"><B>sgtsv(int, int, float[], float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgtsvx(java.lang.String, java.lang.String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>sgtsvx(String, String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgttrf(int, float[], float[], float[], float[], int[], org.netlib.util.intW)"><B>sgttrf(int, float[], float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgttrs(java.lang.String, int, int, float[], float[], float[], float[], int[], float[], int, org.netlib.util.intW)"><B>sgttrs(String, int, int, float[], float[], float[], float[], int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sgtts2(int, int, int, float[], float[], float[], float[], int[], float[], int)"><B>sgtts2(int, int, int, float[], float[], float[], float[], int[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#shgeqz(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><B>shgeqz(String, String, String, int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#shsein(java.lang.String, java.lang.String, java.lang.String, boolean[], int, float[], int, float[], float[], float[], int, float[], int, int, org.netlib.util.intW, float[], int[], int[], org.netlib.util.intW)"><B>shsein(String, String, String, boolean[], int, float[], int, float[], float[], float[], int, float[], int, int, intW, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#shseqr(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], float[], int, float[], int, org.netlib.util.intW)"><B>shseqr(String, String, int, int, int, float[], int, float[], float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sisnan(float)"><B>sisnan(float)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slabad(org.netlib.util.floatW, org.netlib.util.floatW)"><B>slabad(floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slabrd(int, int, int, float[], int, float[], float[], float[], float[], float[], int, float[], int)"><B>slabrd(int, int, int, float[], int, float[], float[], float[], float[], float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slacn2(int, float[], float[], int[], org.netlib.util.floatW, org.netlib.util.intW, int[])"><B>slacn2(int, float[], float[], int[], floatW, intW, int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slacon(int, float[], float[], int[], org.netlib.util.floatW, org.netlib.util.intW)"><B>slacon(int, float[], float[], int[], floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slacpy(java.lang.String, int, int, float[], int, float[], int)"><B>slacpy(String, int, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sladiv(float, float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)"><B>sladiv(float, float, float, float, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slae2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slae2(float, float, float, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaebz(int, int, int, int, int, int, float, float, float, float[], float[], float[], int[], float[], float[], org.netlib.util.intW, int[], float[], int[], org.netlib.util.intW)"><B>slaebz(int, int, int, int, int, int, float, float, float, float[], float[], float[], int[], float[], float[], intW, int[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed0(int, int, int, float[], float[], float[], int, float[], int, float[], int[], org.netlib.util.intW)"><B>slaed0(int, int, int, float[], float[], float[], int, float[], int, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed1(int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], int[], org.netlib.util.intW)"><B>slaed1(int, float[], float[], int, int[], floatW, int, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed2(org.netlib.util.intW, int, int, float[], float[], int, int[], org.netlib.util.floatW, float[], float[], float[], float[], int[], int[], int[], int[], org.netlib.util.intW)"><B>slaed2(intW, int, int, float[], float[], int, int[], floatW, float[], float[], float[], float[], int[], int[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed3(int, int, int, float[], float[], int, float, float[], float[], int[], int[], float[], float[], org.netlib.util.intW)"><B>slaed3(int, int, int, float[], float[], int, float, float[], float[], int[], int[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed4(int, int, float[], float[], float[], float, org.netlib.util.floatW, org.netlib.util.intW)"><B>slaed4(int, int, float[], float[], float[], float, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed5(int, float[], float[], float[], float, org.netlib.util.floatW)"><B>slaed5(int, float[], float[], float[], float, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed6(int, boolean, float, float[], float[], float, org.netlib.util.floatW, org.netlib.util.intW)"><B>slaed6(int, boolean, float, float[], float[], float, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed7(int, int, int, int, int, int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], int[], int[], int[], int[], int[], float[], float[], int[], org.netlib.util.intW)"><B>slaed7(int, int, int, int, int, int, float[], float[], int, int[], floatW, int, float[], int[], int[], int[], int[], int[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed8(int, org.netlib.util.intW, int, int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], float[], float[], int, float[], int[], org.netlib.util.intW, int[], float[], int[], int[], org.netlib.util.intW)"><B>slaed8(int, intW, int, int, float[], float[], int, int[], floatW, int, float[], float[], float[], int, float[], int[], intW, int[], float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaed9(int, int, int, int, float[], float[], int, float, float[], float[], float[], int, org.netlib.util.intW)"><B>slaed9(int, int, int, int, float[], float[], int, float, float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaeda(int, int, int, int, int[], int[], int[], int[], float[], float[], int[], float[], float[], org.netlib.util.intW)"><B>slaeda(int, int, int, int, int[], int[], int[], int[], float[], float[], int[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaein(boolean, boolean, int, float[], int, float, float, float[], float[], float[], int, float[], float, float, float, org.netlib.util.intW)"><B>slaein(boolean, boolean, int, float[], int, float, float, float[], float[], float[], int, float[], float, float, float, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaev2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slaev2(float, float, float, floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaexc(boolean, int, float[], int, float[], int, int, int, int, float[], org.netlib.util.intW)"><B>slaexc(boolean, int, float[], int, float[], int, int, int, int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slag2(float[], int, float[], int, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slag2(float[], int, float[], int, float, floatW, floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slag2d(int, int, float[], int, double[], int, org.netlib.util.intW)"><B>slag2d(int, int, float[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slags2(boolean, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slags2(boolean, float, float, float, float, float, float, floatW, floatW, floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slagtf(int, float[], float, float[], float[], float, float[], int[], org.netlib.util.intW)"><B>slagtf(int, float[], float, float[], float[], float, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slagtm(java.lang.String, int, int, float, float[], float[], float[], float[], int, float, float[], int)"><B>slagtm(String, int, int, float, float[], float[], float[], float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slagts(int, int, float[], float[], float[], float[], int[], float[], org.netlib.util.floatW, org.netlib.util.intW)"><B>slagts(int, int, float[], float[], float[], float[], int[], float[], floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slagv2(float[], int, float[], int, float[], float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slagv2(float[], int, float[], int, float[], float[], float[], floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slahqr(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, org.netlib.util.intW)"><B>slahqr(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slahr2(int, int, int, float[], int, float[], float[], int, float[], int)"><B>slahr2(int, int, int, float[], int, float[], float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slahrd(int, int, int, float[], int, float[], float[], int, float[], int)"><B>slahrd(int, int, int, float[], int, float[], float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaic1(int, int, float[], float, float[], float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slaic1(int, int, float[], float, float[], float, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaisnan(float, float)"><B>slaisnan(float, float)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaln2(boolean, int, int, float, float, float[], int, float, float, float[], int, float, float, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>slaln2(boolean, int, int, float, float, float[], int, float, float, float[], int, float, float, float[], int, floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slals0(int, int, int, int, int, float[], int, float[], int, int[], int, int[], int, float[], int, float[], float[], float[], float[], int, float, float, float[], org.netlib.util.intW)"><B>slals0(int, int, int, int, int, float[], int, float[], int, int[], int, int[], int, float[], int, float[], float[], float[], float[], int, float, float, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slalsa(int, int, int, int, float[], int, float[], int, float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], org.netlib.util.intW)"><B>slalsa(int, int, int, int, float[], int, float[], int, float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slalsd(java.lang.String, int, int, int, float[], float[], float[], int, float, org.netlib.util.intW, float[], int[], org.netlib.util.intW)"><B>slalsd(String, int, int, int, float[], float[], float[], int, float, intW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamc1(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.booleanW)"><B>slamc1(intW, intW, booleanW, booleanW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamc2(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW)"><B>slamc2(intW, intW, booleanW, floatW, intW, floatW, intW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamc3(float, float)"><B>slamc3(float, float)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamc4(org.netlib.util.intW, float, int)"><B>slamc4(intW, float, int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamc5(int, int, int, boolean, org.netlib.util.intW, org.netlib.util.floatW)"><B>slamc5(int, int, int, boolean, intW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamch(java.lang.String)"><B>slamch(String)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slamrg(int, int, float[], int, int, int[])"><B>slamrg(int, int, float[], int, int, int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaneg(int, float[], float[], float, float, int)"><B>slaneg(int, float[], float[], float, float, int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slangb(java.lang.String, int, int, int, float[], int, float[])"><B>slangb(String, int, int, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slange(java.lang.String, int, int, float[], int, float[])"><B>slange(String, int, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slangt(java.lang.String, int, float[], float[], float[])"><B>slangt(String, int, float[], float[], float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slanhs(java.lang.String, int, float[], int, float[])"><B>slanhs(String, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slansb(java.lang.String, java.lang.String, int, int, float[], int, float[])"><B>slansb(String, String, int, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slansp(java.lang.String, java.lang.String, int, float[], float[])"><B>slansp(String, String, int, float[], float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slanst(java.lang.String, int, float[], float[])"><B>slanst(String, int, float[], float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slansy(java.lang.String, java.lang.String, int, float[], int, float[])"><B>slansy(String, String, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slantb(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[])"><B>slantb(String, String, String, int, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slantp(java.lang.String, java.lang.String, java.lang.String, int, float[], float[])"><B>slantp(String, String, String, int, float[], float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slantr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[])"><B>slantr(String, String, String, int, int, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slanv2(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slanv2(floatW, floatW, floatW, floatW, floatW, floatW, floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slapll(int, float[], int, float[], int, org.netlib.util.floatW)"><B>slapll(int, float[], int, float[], int, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slapmt(boolean, int, int, float[], int, int[])"><B>slapmt(boolean, int, int, float[], int, int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slapy2(float, float)"><B>slapy2(float, float)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slapy3(float, float, float)"><B>slapy3(float, float, float)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqgb(int, int, int, int, float[], int, float[], float[], float, float, float, org.netlib.util.StringW)"><B>slaqgb(int, int, int, int, float[], int, float[], float[], float, float, float, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqge(int, int, float[], int, float[], float[], float, float, float, org.netlib.util.StringW)"><B>slaqge(int, int, float[], int, float[], float[], float, float, float, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqp2(int, int, int, float[], int, int[], float[], float[], float[], float[])"><B>slaqp2(int, int, int, float[], int, int[], float[], float[], float[], float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqps(int, int, int, int, org.netlib.util.intW, float[], int, int[], float[], float[], float[], float[], float[], int)"><B>slaqps(int, int, int, int, intW, float[], int, int[], float[], float[], float[], float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqr0(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, org.netlib.util.intW)"><B>slaqr0(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqr1(int, float[], int, float, float, float, float, float[])"><B>slaqr1(int, float[], int, float, float, float, float, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqr2(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)"><B>slaqr2(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, intW, intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqr3(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)"><B>slaqr3(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, intW, intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqr4(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, org.netlib.util.intW)"><B>slaqr4(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqr5(boolean, boolean, int, int, int, int, int, float[], float[], float[], int, int, int, float[], int, float[], int, float[], int, int, float[], int, int, float[], int)"><B>slaqr5(boolean, boolean, int, int, int, int, int, float[], float[], float[], int, int, int, float[], int, float[], int, float[], int, int, float[], int, int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#slaqrb(boolean, int, int, int, float[], int, float[], float[], float[], org.netlib.util.intW)"><B>slaqrb(boolean, int, int, int, float[], int, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqsb(java.lang.String, int, int, float[], int, float[], float, float, org.netlib.util.StringW)"><B>slaqsb(String, int, int, float[], int, float[], float, float, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqsp(java.lang.String, int, float[], float[], float, float, org.netlib.util.StringW)"><B>slaqsp(String, int, float[], float[], float, float, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqsy(java.lang.String, int, float[], int, float[], float, float, org.netlib.util.StringW)"><B>slaqsy(String, int, float[], int, float[], float, float, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaqtr(boolean, boolean, int, float[], int, float[], float, org.netlib.util.floatW, float[], float[], org.netlib.util.intW)"><B>slaqtr(boolean, boolean, int, float[], int, float[], float, floatW, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slar1v(int, int, int, float, float[], float[], float[], float[], float, float, float[], boolean, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, int[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, float[])"><B>slar1v(int, int, int, float, float[], float[], float[], float[], float, float, float[], boolean, intW, floatW, floatW, intW, int[], floatW, floatW, floatW, float[])< [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slar2v(int, float[], float[], float[], int, float[], float[], int)"><B>slar2v(int, float[], float[], float[], int, float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarf(java.lang.String, int, int, float[], int, float, float[], int, float[])"><B>slarf(String, int, int, float[], int, float, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarfb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int)"><B>slarfb(String, String, String, String, int, int, int, float[], int, float[], int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarfg(int, org.netlib.util.floatW, float[], int, org.netlib.util.floatW)"><B>slarfg(int, floatW, float[], int, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarft(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int)"><B>slarft(String, String, int, int, float[], int, float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarfx(java.lang.String, int, int, float[], float, float[], int, float[])"><B>slarfx(String, int, int, float[], float, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slargv(int, float[], int, float[], int, float[], int)"><B>slargv(int, float[], int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarnv(int, int[], int, float[])"><B>slarnv(int, int[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarra(int, float[], float[], float[], float, float, org.netlib.util.intW, int[], org.netlib.util.intW)"><B>slarra(int, float[], float[], float[], float, float, intW, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrb(int, float[], float[], int, int, float, float, int, float[], float[], float[], float[], int[], float, float, int, org.netlib.util.intW)"><B>slarrb(int, float[], float[], int, int, float, float, int, float[], float[], float[], float[], int[], float, float, int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrc(java.lang.String, int, float, float, float[], float[], float, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)"><B>slarrc(String, int, float, float, float[], float[], float, intW, intW, intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrd(java.lang.String, java.lang.String, int, float, float, int, int, float[], float, float[], float[], float[], float, int, int[], org.netlib.util.intW, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[], float[], int[], org.netlib.util.intW)"><B>slarrd(String, String, int, float, float, int, int, float[], float, float[], float[], float[], float, int, int[], intW, float[], float[], floatW, floatW, int[], int[], [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarre(java.lang.String, int, org.netlib.util.floatW, org.netlib.util.floatW, int, int, float[], float[], float[], float, float, float, org.netlib.util.intW, int[], org.netlib.util.intW, float[], float[], float[], int[], int[], float[], org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>slarre(String, int, floatW, floatW, int, int, float[], float[], float[], float, float, float, intW, int[], intW, float[], float[], float[], int [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrf(int, float[], float[], float[], int, int, float[], float[], float[], float, float, float, float, org.netlib.util.floatW, float[], float[], float[], org.netlib.util.intW)"><B>slarrf(int, float[], float[], float[], int, int, float[], float[], float[], float, float, float, float, floatW, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrj(int, float[], float[], int, int, float, int, float[], float[], float[], int[], float, float, org.netlib.util.intW)"><B>slarrj(int, float[], float[], int, int, float, int, float[], float[], float[], int[], float, float, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrk(int, int, float, float, float[], float[], float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>slarrk(int, int, float, float, float[], float[], float, float, floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrr(int, float[], float[], org.netlib.util.intW)"><B>slarrr(int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarrv(int, float, float, float[], float[], float, int[], int, int, int, float, org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], float[], int[], int[], float[], float[], int, int[], float[], int[], org.netlib.util.intW)"><B>slarrv(int, float, float, float[], float[], float, int[], int, int, int, float, floatW, floatW, float[], float[], float[], int[], int[], float[], float[], int, int[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slartg(float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slartg(float, float, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slartv(int, float[], int, float[], int, float[], float[], int)"><B>slartv(int, float[], int, float[], int, float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaruv(int[], int, float[])"><B>slaruv(int[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarz(java.lang.String, int, int, int, float[], int, float, float[], int, float[])"><B>slarz(String, int, int, int, float[], int, float, float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarzb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], int, float[], int, float[], int)"><B>slarzb(String, String, String, String, int, int, int, int, float[], int, float[], int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slarzt(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int)"><B>slarzt(String, String, int, int, float[], int, float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slas2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slas2(float, float, float, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slascl(java.lang.String, int, int, float, float, int, int, float[], int, org.netlib.util.intW)"><B>slascl(String, int, int, float, float, int, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd0(int, int, float[], float[], float[], int, float[], int, int, int[], float[], org.netlib.util.intW)"><B>slasd0(int, int, float[], float[], float[], int, float[], int, int, int[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd1(int, int, int, float[], org.netlib.util.floatW, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], org.netlib.util.intW)"><B>slasd1(int, int, int, float[], floatW, floatW, float[], int, float[], int, int[], int[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd2(int, int, int, org.netlib.util.intW, float[], float[], float, float, float[], int, float[], int, float[], float[], int, float[], int, int[], int[], int[], int[], int[], org.netlib.util.intW)"><B>slasd2(int, int, int, intW, float[], float[], float, float, float[], int, float[], int, float[], float[], int, float[], int, int[], int[], int[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd3(int, int, int, int, float[], float[], int, float[], float[], int, float[], int, float[], int, float[], int, int[], int[], float[], org.netlib.util.intW)"><B>slasd3(int, int, int, int, float[], float[], int, float[], float[], int, float[], int, float[], int, float[], int, int[], int[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd4(int, int, float[], float[], float[], float, org.netlib.util.floatW, float[], org.netlib.util.intW)"><B>slasd4(int, int, float[], float[], float[], float, floatW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd5(int, float[], float[], float[], float, org.netlib.util.floatW, float[])"><B>slasd5(int, float[], float[], float[], float, floatW, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd6(int, int, int, int, float[], float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[], org.netlib.util.intW, int[], int, float[], int, float[], float[], float[], float[], org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>slasd6(int, int, int, int, float[], float[], float[], floatW, floatW, int[], int[], intW, int[], int, float[], int, float[], float[], [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd7(int, int, int, int, org.netlib.util.intW, float[], float[], float[], float[], float[], float[], float[], float, float, float[], int[], int[], int[], int[], org.netlib.util.intW, int[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>slasd7(int, int, int, int, intW, float[], float[], float[], float[], float[], float[], float[], float, float, float[], int[], int[], int[], int[], intW, int[], i [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasd8(int, int, float[], float[], float[], float[], float[], float[], int, float[], float[], org.netlib.util.intW)"><B>slasd8(int, int, float[], float[], float[], float[], float[], float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasda(int, int, int, int, float[], float[], float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], org.netlib.util.intW)"><B>slasda(int, int, int, int, float[], float[], float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasdq(java.lang.String, int, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><B>slasdq(String, int, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasdt(int, org.netlib.util.intW, org.netlib.util.intW, int[], int[], int[], int)"><B>slasdt(int, intW, intW, int[], int[], int[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaset(java.lang.String, int, int, float, float, float[], int)"><B>slaset(String, int, int, float, float, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasq1(int, float[], float[], float[], org.netlib.util.intW)"><B>slasq1(int, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasq2(int, float[], org.netlib.util.intW)"><B>slasq2(int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasq3(int, org.netlib.util.intW, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean)"><B>slasq3(int, intW, float[], int, floatW, floatW, floatW, floatW, intW, intW, intW, boolean)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasq4(int, int, float[], int, int, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.intW)"><B>slasq4(int, int, float[], int, int, float, float, float, float, float, float, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasq5(int, int, float[], int, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, boolean)"><B>slasq5(int, int, float[], int, float, floatW, floatW, floatW, floatW, floatW, floatW, boolean)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasq6(int, int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slasq6(int, int, float[], int, floatW, floatW, floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], float[], int)"><B>slasr(String, String, String, int, int, float[], float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasrt(java.lang.String, int, float[], org.netlib.util.intW)"><B>slasrt(String, int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slassq(int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slassq(int, float[], int, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasv2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slasv2(float, float, float, floatW, floatW, floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slaswp(int, float[], int, int, int, int[], int)"><B>slaswp(int, float[], int, int, int, int[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasy2(boolean, boolean, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.floatW, float[], int, org.netlib.util.floatW, org.netlib.util.intW)"><B>slasy2(boolean, boolean, int, int, int, float[], int, float[], int, float[], int, floatW, float[], int, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slasyf(java.lang.String, int, int, org.netlib.util.intW, float[], int, int[], float[], int, org.netlib.util.intW)"><B>slasyf(String, int, int, intW, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatbs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], org.netlib.util.floatW, float[], org.netlib.util.intW)"><B>slatbs(String, String, String, String, int, int, float[], int, float[], floatW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatdf(int, int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[])"><B>slatdf(int, int, float[], int, float[], floatW, floatW, int[], int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatps(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], float[], org.netlib.util.floatW, float[], org.netlib.util.intW)"><B>slatps(String, String, String, String, int, float[], float[], floatW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatrd(java.lang.String, int, int, float[], int, float[], float[], float[], int)"><B>slatrd(String, int, int, float[], int, float[], float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatrs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], org.netlib.util.floatW, float[], org.netlib.util.intW)"><B>slatrs(String, String, String, String, int, float[], int, float[], floatW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatrz(int, int, int, float[], int, float[], float[])"><B>slatrz(int, int, int, float[], int, float[], float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slatzm(java.lang.String, int, int, float[], int, float, float[], float[], int, float[])"><B>slatzm(String, int, int, float[], int, float, float[], float[], int, float[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slauu2(java.lang.String, int, float[], int, org.netlib.util.intW)"><B>slauu2(String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slauum(java.lang.String, int, float[], int, org.netlib.util.intW)"><B>slauum(String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slazq3(int, org.netlib.util.intW, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>slazq3(int, intW, float[], int, floatW, floatW, floatW, f [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#slazq4(int, int, float[], int, int, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW)"><B>slazq4(int, int, float[], int, int, float, float, float, float, float, float, floatW, intW, floatW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#smout(int, int, int, float[], int, int, java.lang.String)"><B>smout(int, int, int, float[], int, int, String)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#snaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, float[], org.netlib.util.floatW, float[], int, float[], int, int[], float[], org.netlib.util.intW)"><B>snaitr(intW, String, int, int, int, int, float[], floatW, float[], int, float[], int, int[], float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#snapps(int, org.netlib.util.intW, int, float[], float[], float[], int, float[], int, float[], float[], int, float[], float[])"><B>snapps(int, intW, int, float[], float[], float[], int, float[], int, float[], float[], int, float[], float[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#snaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float, float[], int, int, int, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], float[], int, float[], int[], float[], org.netlib.util.intW)"><B>snaup2(intW, String, int, String, intW, intW, float, float[], int, int, int, intW, float[], int, float[], int, float[], float[], float[], float[], int, float[] [...]
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#snaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><B>snaupd(intW, String, int, String, int, floatW, float[], int, float[], int, int[], int[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#snconv(int, float[], float[], float[], float, org.netlib.util.intW)"><B>snconv(int, float[], float[], float[], float, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sneigh(float, org.netlib.util.intW, float[], int, float[], float[], float[], float[], int, float[], org.netlib.util.intW)"><B>sneigh(float, intW, float[], int, float[], float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sneupd(boolean, java.lang.String, boolean[], float[], float[], float[], int, float, float, float[], java.lang.String, int, java.lang.String, org.netlib.util.intW, float, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><B>sneupd(boolean, String, boolean[], float[], float[], float[], int, float, float, float[], String, int, String, intW, float, float[], int, float[], int, int[], int[], float[], float[], i [...]
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sngets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], float[], float[])"><B>sngets(int, String, intW, intW, float[], float[], float[], float[], float[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/blas/BLAS.html#snrm2(int, float[], int)"><B>snrm2(int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sopgtr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>sopgtr(String, int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sopmtr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>sopmtr(String, String, String, int, int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorg2l(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sorg2l(int, int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorg2r(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sorg2r(int, int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgbr(java.lang.String, int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorgbr(String, int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorghr(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorghr(int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgl2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sorgl2(int, int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorglq(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorglq(int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgql(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorgql(int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgqr(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorgqr(int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgr2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><B>sorgr2(int, int, int, float[], int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgrq(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorgrq(int, int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorgtr(java.lang.String, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>sorgtr(String, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorm2l(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>sorm2l(String, String, int, int, int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorm2r(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>sorm2r(String, String, int, int, int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormbr(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormbr(String, String, String, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormhr(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormhr(String, String, int, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sorml2(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>sorml2(String, String, int, int, int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormlq(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormlq(String, String, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormql(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormql(String, String, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormqr(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormqr(String, String, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormr2(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>sormr2(String, String, int, int, int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormr3(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>sormr3(String, String, int, int, int, int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormrq(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormrq(String, String, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormrz(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormrz(String, String, int, int, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sormtr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><B>sormtr(String, String, String, int, int, float[], int, float[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbcon(java.lang.String, int, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>spbcon(String, int, int, float[], int, float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbequ(java.lang.String, int, int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>spbequ(String, int, int, float[], int, float[], floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbrfs(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>spbrfs(String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbstf(java.lang.String, int, int, float[], int, org.netlib.util.intW)"><B>spbstf(String, int, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbsv(java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>spbsv(String, int, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbsvx(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>spbsvx(String, String, int, int, int, float[], int, float[], int, StringW, float[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbtf2(java.lang.String, int, int, float[], int, org.netlib.util.intW)"><B>spbtf2(String, int, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbtrf(java.lang.String, int, int, float[], int, org.netlib.util.intW)"><B>spbtrf(String, int, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spbtrs(java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>spbtrs(String, int, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spocon(java.lang.String, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>spocon(String, int, float[], int, float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spoequ(int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>spoequ(int, float[], int, float[], floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sporfs(java.lang.String, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>sporfs(String, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sposv(java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>sposv(String, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sposvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>sposvx(String, String, int, int, float[], int, float[], int, StringW, float[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spotf2(java.lang.String, int, float[], int, org.netlib.util.intW)"><B>spotf2(String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spotrf(java.lang.String, int, float[], int, org.netlib.util.intW)"><B>spotrf(String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spotri(java.lang.String, int, float[], int, org.netlib.util.intW)"><B>spotri(String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spotrs(java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>spotrs(String, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sppcon(java.lang.String, int, float[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>sppcon(String, int, float[], float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sppequ(java.lang.String, int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><B>sppequ(String, int, float[], float[], floatW, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spprfs(java.lang.String, int, int, float[], float[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>spprfs(String, int, int, float[], float[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sppsv(java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)"><B>sppsv(String, int, int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sppsvx(java.lang.String, java.lang.String, int, int, float[], float[], org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>sppsvx(String, String, int, int, float[], float[], StringW, float[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spptrf(java.lang.String, int, float[], org.netlib.util.intW)"><B>spptrf(String, int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spptri(java.lang.String, int, float[], org.netlib.util.intW)"><B>spptri(String, int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spptrs(java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)"><B>spptrs(String, int, int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sptcon(int, float[], float[], float, org.netlib.util.floatW, float[], org.netlib.util.intW)"><B>sptcon(int, float[], float[], float, floatW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spteqr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>spteqr(String, int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sptrfs(int, int, float[], float[], float[], float[], float[], int, float[], int, float[], float[], float[], org.netlib.util.intW)"><B>sptrfs(int, int, float[], float[], float[], float[], float[], int, float[], int, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sptsv(int, int, float[], float[], float[], int, org.netlib.util.intW)"><B>sptsv(int, int, float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sptsvx(java.lang.String, int, int, float[], float[], float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], org.netlib.util.intW)"><B>sptsvx(String, int, int, float[], float[], float[], float[], float[], int, float[], int, floatW, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spttrf(int, float[], float[], org.netlib.util.intW)"><B>spttrf(int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#spttrs(int, int, float[], float[], float[], int, org.netlib.util.intW)"><B>spttrs(int, int, float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sptts2(int, int, float[], float[], float[], int)"><B>sptts2(int, int, float[], float[], float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#srot(int, float[], int, float[], int, float, float)"><B>srot(int, float[], int, float[], int, float, float)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#srotg(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><B>srotg(floatW, floatW, floatW, floatW)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#srotm(int, float[], int, float[], int, float[])"><B>srotm(int, float[], int, float[], int, float[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#srotmg(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, float, float[])"><B>srotmg(floatW, floatW, floatW, float, float[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#srscl(int, float, float[], int)"><B>srscl(int, float, float[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, float[], org.netlib.util.floatW, float[], int, float[], int, int[], float[], org.netlib.util.intW)"><B>ssaitr(intW, String, int, int, int, int, float[], floatW, float[], int, float[], int, int[], float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssapps(int, int, int, float[], float[], int, float[], int, float[], float[], int, float[])"><B>ssapps(int, int, int, float[], float[], int, float[], int, float[], float[], int, float[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float, float[], int, int, int, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], int, float[], int[], float[], org.netlib.util.intW)"><B>ssaup2(intW, String, int, String, intW, intW, float, float[], int, int, int, intW, float[], int, float[], int, float[], float[], float[], int, float[], int[], float[], [...]
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><B>ssaupd(intW, String, int, String, int, floatW, float[], int, float[], int, int[], int[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbev(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>ssbev(String, String, int, int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbevd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><B>ssbevd(String, String, int, int, float[], int, float[], float[], int, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbevx(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><B>ssbevx(String, String, String, int, int, float[], int, float[], int, float, float, int, int, float, intW, float[], float[], int, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbgst(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><B>ssbgst(String, String, int, int, int, float[], int, float[], int, float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbgv(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><B>ssbgv(String, String, int, int, int, float[], int, float[], int, float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbgvd(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><B>ssbgvd(String, String, int, int, int, float[], int, float[], int, float[], float[], int, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbgvx(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><B>ssbgvx(String, String, String, int, int, int, float[], int, float[], int, float[], int, float, float, int, int, float, intW, float[], float[], int, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssbmv(java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><B>ssbmv(String, int, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssbtrd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>ssbtrd(String, String, int, int, float[], int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sscal(int, float, float[], int)"><B>sscal(int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssconv(int, float[], float[], float, org.netlib.util.intW)"><B>ssconv(int, float[], float[], float, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sseigt(float, int, float[], int, float[], float[], float[], org.netlib.util.intW)"><B>sseigt(float, int, float[], int, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssesrt(java.lang.String, boolean, int, float[], int, float[], int)"><B>ssesrt(String, boolean, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sseupd(boolean, java.lang.String, boolean[], float[], float[], int, float, java.lang.String, int, java.lang.String, org.netlib.util.intW, float, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><B>sseupd(boolean, String, boolean[], float[], float[], int, float, String, int, String, intW, float, float[], int, float[], int, int[], int[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssgets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[])"><B>ssgets(int, String, intW, intW, float[], float[], float[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssortc(java.lang.String, boolean, int, float[], float[], float[])"><B>ssortc(String, boolean, int, float[], float[], float[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ssortr(java.lang.String, boolean, int, float[], float[])"><B>ssortr(String, boolean, int, float[], float[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspcon(java.lang.String, int, float[], int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>sspcon(String, int, float[], int[], float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspev(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>sspev(String, String, int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspevd(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><B>sspevd(String, String, int, float[], float[], float[], int, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspevx(java.lang.String, java.lang.String, java.lang.String, int, float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><B>sspevx(String, String, String, int, float[], float, float, int, int, float, intW, float[], float[], int, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspgst(int, java.lang.String, int, float[], float[], org.netlib.util.intW)"><B>sspgst(int, String, int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspgv(int, java.lang.String, java.lang.String, int, float[], float[], float[], float[], int, float[], org.netlib.util.intW)"><B>sspgv(int, String, String, int, float[], float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspgvd(int, java.lang.String, java.lang.String, int, float[], float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><B>sspgvd(int, String, String, int, float[], float[], float[], float[], int, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspgvx(int, java.lang.String, java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><B>sspgvx(int, String, String, String, int, float[], float[], float, float, int, int, float, intW, float[], float[], int, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sspmv(java.lang.String, int, float, float[], float[], int, float, float[], int)"><B>sspmv(String, int, float, float[], float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sspr(java.lang.String, int, float, float[], int, float[])"><B>sspr(String, int, float, float[], int, float[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#sspr2(java.lang.String, int, float, float[], int, float[], int, float[])"><B>sspr2(String, int, float, float[], int, float[], int, float[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssprfs(java.lang.String, int, int, float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>ssprfs(String, int, int, float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspsv(java.lang.String, int, int, float[], int[], float[], int, org.netlib.util.intW)"><B>sspsv(String, int, int, float[], int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sspsvx(java.lang.String, java.lang.String, int, int, float[], float[], int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><B>sspsvx(String, String, int, int, float[], float[], int[], float[], int, float[], int, floatW, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssptrd(java.lang.String, int, float[], float[], float[], float[], org.netlib.util.intW)"><B>ssptrd(String, int, float[], float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssptrf(java.lang.String, int, float[], int[], org.netlib.util.intW)"><B>ssptrf(String, int, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssptri(java.lang.String, int, float[], int[], float[], org.netlib.util.intW)"><B>ssptri(String, int, float[], int[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssptrs(java.lang.String, int, int, float[], int[], float[], int, org.netlib.util.intW)"><B>ssptrs(String, int, int, float[], int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sstatn()"><B>sstatn()</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sstats()"><B>sstats()</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstebz(java.lang.String, java.lang.String, int, float, float, int, int, float, float[], float[], org.netlib.util.intW, org.netlib.util.intW, float[], int[], int[], float[], int[], org.netlib.util.intW)"><B>sstebz(String, String, int, float, float, int, int, float, float[], float[], intW, intW, float[], int[], int[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstedc(java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><B>sstedc(String, int, float[], float[], float[], int, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstegr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)"><B>sstegr(String, String, int, float[], float[], float, float, int, int, float, intW, float[], float[], int, int[], float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstein(int, float[], float[], int, float[], int[], int[], float[], int, float[], int[], int[], org.netlib.util.intW)"><B>sstein(int, float[], float[], int, float[], int[], int[], float[], int, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstemr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, org.netlib.util.intW, float[], float[], int, int, int[], org.netlib.util.booleanW, float[], int, int[], int, org.netlib.util.intW)"><B>sstemr(String, String, int, float[], float[], float, float, int, int, intW, float[], float[], int, int, int[], booleanW, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssteqr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>ssteqr(String, int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssterf(int, float[], float[], org.netlib.util.intW)"><B>ssterf(int, float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstev(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><B>sstev(String, int, float[], float[], float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstevd(java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><B>sstevd(String, int, float[], float[], float[], int, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstevr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)"><B>sstevr(String, String, int, float[], float[], float, float, int, int, float, intW, float[], float[], int, int[], float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#sstevx(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><B>sstevx(String, String, int, float[], float[], float, float, int, int, float, intW, float[], float[], int, float[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#sstqrb(int, float[], float[], float[], float[], org.netlib.util.intW)"><B>sstqrb(int, float[], float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/blas/BLAS.html#sswap(int, float[], int, float[], int)"><B>sswap(int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssycon(java.lang.String, int, float[], int, int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>ssycon(String, int, float[], int, int[], float, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssyev(java.lang.String, java.lang.String, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>ssyev(String, String, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssyevd(java.lang.String, java.lang.String, int, float[], int, float[], float[], int, int[], int, org.netlib.util.intW)"><B>ssyevd(String, String, int, float[], int, float[], float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssyevr(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)"><B>ssyevr(String, String, String, int, float[], int, float, float, int, int, float, intW, float[], float[], int, int[], float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssyevx(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int, int[], int[], org.netlib.util.intW)"><B>ssyevx(String, String, String, int, float[], int, float, float, int, int, float, intW, float[], float[], int, float[], int, int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssygs2(int, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW)"><B>ssygs2(int, String, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssygst(int, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW)"><B>ssygst(int, String, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssygv(int, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>ssygv(int, String, String, int, float[], int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssygvd(int, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], int, int[], int, org.netlib.util.intW)"><B>ssygvd(int, String, String, int, float[], int, float[], int, float[], float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssygvx(int, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int, int[], int[], org.netlib.util.intW)"><B>ssygvx(int, String, String, String, int, float[], int, float[], int, float, float, int, int, float, intW, float[], float[], int, float[], int, int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssymm(java.lang.String, java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><B>ssymm(String, String, int, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssymv(java.lang.String, int, float, float[], int, float[], int, float, float[], int)"><B>ssymv(String, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssyr(java.lang.String, int, float, float[], int, float[], int)"><B>ssyr(String, int, float, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssyr2(java.lang.String, int, float, float[], int, float[], int, float[], int)"><B>ssyr2(String, int, float, float[], int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssyr2k(java.lang.String, java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><B>ssyr2k(String, String, int, int, float, float[], int, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssyrfs(java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>ssyrfs(String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ssyrk(java.lang.String, java.lang.String, int, int, float, float[], int, float, float[], int)"><B>ssyrk(String, String, int, int, float, float[], int, float, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssysv(java.lang.String, int, int, float[], int, int[], float[], int, float[], int, org.netlib.util.intW)"><B>ssysv(String, int, int, float[], int, int[], float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssysvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int, int[], org.netlib.util.intW)"><B>ssysvx(String, String, int, int, float[], int, float[], int, int[], float[], int, float[], int, floatW, float[], float[], float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssytd2(java.lang.String, int, float[], int, float[], float[], float[], org.netlib.util.intW)"><B>ssytd2(String, int, float[], int, float[], float[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssytf2(java.lang.String, int, float[], int, int[], org.netlib.util.intW)"><B>ssytf2(String, int, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssytrd(java.lang.String, int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)"><B>ssytrd(String, int, float[], int, float[], float[], float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssytrf(java.lang.String, int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>ssytrf(String, int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssytri(java.lang.String, int, float[], int, int[], float[], org.netlib.util.intW)"><B>ssytri(String, int, float[], int, int[], float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ssytrs(java.lang.String, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><B>ssytrs(String, int, int, float[], int, int[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stbcon(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>stbcon(String, String, String, int, int, float[], int, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#stbmv(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int)"><B>stbmv(String, String, String, int, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stbrfs(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>stbrfs(String, String, String, int, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#stbsv(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int)"><B>stbsv(String, String, String, int, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stbtrs(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>stbtrs(String, String, String, int, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgevc(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], int, int, org.netlib.util.intW, float[], org.netlib.util.intW)"><B>stgevc(String, String, boolean[], int, float[], int, float[], int, float[], int, float[], int, int, intW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgex2(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, int, int, int, float[], int, org.netlib.util.intW)"><B>stgex2(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, int, int, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgexc(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], int, org.netlib.util.intW)"><B>stgexc(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, intW, intW, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgsen(int, boolean, boolean, boolean[], int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], int, int[], int, org.netlib.util.intW)"><B>stgsen(int, boolean, boolean, boolean[], int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, intW, floatW, floatW, float[], float[], int, int[], int, [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgsja(java.lang.String, java.lang.String, java.lang.String, int, int, int, int, int, float[], int, float[], int, float, float, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW, org.netlib.util.intW)"><B>stgsja(String, String, String, int, int, int, int, int, float[], int, float[], int, float, float, float[], float[], float[], int, float[], int, float[], int, float[], intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgsna(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)"><B>stgsna(String, String, boolean[], int, float[], int, float[], int, float[], int, float[], int, float[], float[], int, intW, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgsy2(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, int[], org.netlib.util.intW, org.netlib.util.intW)"><B>stgsy2(String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, floatW, floatW, floatW, int[], intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stgsyl(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], org.netlib.util.intW)"><B>stgsyl(String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, floatW, floatW, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stpcon(java.lang.String, java.lang.String, java.lang.String, int, float[], org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>stpcon(String, String, String, int, float[], floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#stpmv(java.lang.String, java.lang.String, java.lang.String, int, float[], float[], int)"><B>stpmv(String, String, String, int, float[], float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stprfs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>stprfs(String, String, String, int, int, float[], float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#stpsv(java.lang.String, java.lang.String, java.lang.String, int, float[], float[], int)"><B>stpsv(String, String, String, int, float[], float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stptri(java.lang.String, java.lang.String, int, float[], org.netlib.util.intW)"><B>stptri(String, String, int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stptrs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)"><B>stptrs(String, String, String, int, int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strcon(java.lang.String, java.lang.String, java.lang.String, int, float[], int, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><B>strcon(String, String, String, int, float[], int, floatW, float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strevc(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, int, org.netlib.util.intW, float[], org.netlib.util.intW)"><B>strevc(String, String, boolean[], int, float[], int, float[], int, float[], int, int, intW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strexc(java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.intW)"><B>strexc(String, int, float[], int, float[], int, intW, intW, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#strmm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float, float[], int, float[], int)"><B>strmm(String, String, String, String, int, int, float, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#strmv(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int)"><B>strmv(String, String, String, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strrfs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><B>strrfs(String, String, String, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strsen(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], float[], org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], int, org.netlib.util.intW)"><B>strsen(String, String, boolean[], int, float[], int, float[], int, float[], float[], intW, floatW, floatW, float[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#strsm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float, float[], int, float[], int)"><B>strsm(String, String, String, String, int, int, float, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strsna(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)"><B>strsna(String, String, boolean[], int, float[], int, float[], int, float[], int, float[], float[], int, intW, float[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#strsv(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int)"><B>strsv(String, String, String, int, float[], int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strsyl(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.intW)"><B>strsyl(String, String, int, int, int, float[], int, float[], int, float[], int, floatW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strti2(java.lang.String, java.lang.String, int, float[], int, org.netlib.util.intW)"><B>strti2(String, String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strtri(java.lang.String, java.lang.String, int, float[], int, org.netlib.util.intW)"><B>strtri(String, String, int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#strtrs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)"><B>strtrs(String, String, String, int, int, float[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stzrqf(int, int, float[], int, float[], org.netlib.util.intW)"><B>stzrqf(int, int, float[], int, float[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#stzrzf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><B>stzrzf(int, int, float[], int, float[], float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#svout(int, int, float[], int, java.lang.String)"><B>svout(int, int, float[], int, String)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-9.html"><B>PREV LETTER</B></A>
+ <A HREF="index-11.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-10.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-10.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-11.html b/javadoc/index-files/index-11.html
new file mode 100644
index 0000000..8ca3117
--- /dev/null
+++ b/javadoc/index-files/index-11.html
@@ -0,0 +1,157 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+V-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="V-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-10.html"><B>PREV LETTER</B></A>
+ NEXT LETTER</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-11.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-11.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_V_"><!-- --></A><H2>
+<B>V</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/utils/JNIMethods.ARCHType.html#valueOf(java.lang.String)"><B>valueOf(String)</B></A> -
+Static method in enum org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>
+<DD>Returns the enum constant of this type with the specified name.
+<DT><A HREF="../org/netlib/utils/JNIMethods.OSType.html#valueOf(java.lang.String)"><B>valueOf(String)</B></A> -
+Static method in enum org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>
+<DD>Returns the enum constant of this type with the specified name.
+<DT><A HREF="../org/netlib/utils/JNIMethods.ARCHType.html#values()"><B>values()</B></A> -
+Static method in enum org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>
+<DD>Returns an array containing the constants of this enum type, in
+the order they are declared.
+<DT><A HREF="../org/netlib/utils/JNIMethods.OSType.html#values()"><B>values()</B></A> -
+Static method in enum org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>
+<DD>Returns an array containing the constants of this enum type, in
+the order they are declared.
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-10.html"><B>PREV LETTER</B></A>
+ NEXT LETTER</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-11.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-11.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-2.html b/javadoc/index-files/index-2.html
new file mode 100644
index 0000000..8a33a3b
--- /dev/null
+++ b/javadoc/index-files/index-2.html
@@ -0,0 +1,147 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+B-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="B-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-1.html"><B>PREV LETTER</B></A>
+ <A HREF="index-3.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-2.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-2.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_B_"><!-- --></A><H2>
+<B>B</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas"><B>BLAS</B></A> - Class in <A HREF="../org/netlib/blas/package-summary.html">org.netlib.blas</A><DD>BLAS provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.<DT><A HREF="../org/netlib/blas/BLAS.html#BLAS()"><B>BLAS()</B></A> -
+Constructor for class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-1.html"><B>PREV LETTER</B></A>
+ <A HREF="index-3.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-2.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-2.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-3.html b/javadoc/index-files/index-3.html
new file mode 100644
index 0000000..0d0362e
--- /dev/null
+++ b/javadoc/index-files/index-3.html
@@ -0,0 +1,2183 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+D-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="D-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-2.html"><B>PREV LETTER</B></A>
+ <A HREF="index-4.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-3.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-3.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_D_"><!-- --></A><H2>
+<B>D</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/blas/BLAS.html#dasum(int, double[], int)"><B>dasum(int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#daxpy(int, double, double[], int, double[], int)"><B>daxpy(int, double, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dbdsdc(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], int, double[], int[], double[], int[], org.netlib.util.intW)"><B>dbdsdc(String, String, int, double[], double[], double[], int, double[], int, double[], int[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dbdsqr(java.lang.String, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><B>dbdsqr(String, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dcopy(int, double[], int, double[], int)"><B>dcopy(int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ddisna(java.lang.String, int, int, double[], double[], org.netlib.util.intW)"><B>ddisna(String, int, int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#ddot(int, double[], int, double[], int)"><B>ddot(int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbbrd(java.lang.String, int, int, int, int, int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><B>dgbbrd(String, int, int, int, int, int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbcon(java.lang.String, int, int, int, double[], int, int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dgbcon(String, int, int, int, double[], int, int[], double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbequ(int, int, int, int, double[], int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dgbequ(int, int, int, int, double[], int, double[], double[], doubleW, doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dgbmv(java.lang.String, int, int, int, int, double, double[], int, double[], int, double, double[], int)"><B>dgbmv(String, int, int, int, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbrfs(java.lang.String, int, int, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dgbrfs(String, int, int, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbsv(int, int, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dgbsv(int, int, int, int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbsvx(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], int, int[], org.netlib.util.StringW, double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dgbsvx(String, String, int, int, int, int, double[], int, double[], int, int[], StringW, double[], double[], double[], int, double[], int, doubleW, double[], double[], double[], int[] [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbtf2(int, int, int, int, double[], int, int[], org.netlib.util.intW)"><B>dgbtf2(int, int, int, int, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbtrf(int, int, int, int, double[], int, int[], org.netlib.util.intW)"><B>dgbtrf(int, int, int, int, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgbtrs(java.lang.String, int, int, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dgbtrs(String, int, int, int, int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgebak(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dgebak(String, String, int, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgebal(java.lang.String, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.intW)"><B>dgebal(String, int, double[], int, intW, intW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgebd2(int, int, double[], int, double[], double[], double[], double[], double[], org.netlib.util.intW)"><B>dgebd2(int, int, double[], int, double[], double[], double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgebrd(int, int, double[], int, double[], double[], double[], double[], double[], int, org.netlib.util.intW)"><B>dgebrd(int, int, double[], int, double[], double[], double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgecon(java.lang.String, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dgecon(String, int, double[], int, double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeequ(int, int, double[], int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dgeequ(int, int, double[], int, double[], double[], doubleW, doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgees(java.lang.String, java.lang.String, java.lang.Object, int, double[], int, org.netlib.util.intW, double[], double[], double[], int, double[], int, boolean[], org.netlib.util.intW)"><B>dgees(String, String, Object, int, double[], int, intW, double[], double[], double[], int, double[], int, boolean[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeesx(java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, double[], int, org.netlib.util.intW, double[], double[], double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], int, boolean[], org.netlib.util.intW)"><B>dgeesx(String, String, Object, String, int, double[], int, intW, double[], double[], double[], int, doubleW, doubleW, double[], int, int[], int, boolean[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeev(java.lang.String, java.lang.String, int, double[], int, double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dgeev(String, String, int, double[], int, double[], double[], double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.doubleW, double[], double[], double[], int, int[], org.netlib.util.intW)"><B>dgeevx(String, String, String, String, int, double[], int, double[], double[], double[], int, double[], int, intW, intW, double[], doubleW, double[], [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgegs(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dgegs(String, String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgegv(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dgegv(String, String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgehd2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dgehd2(int, int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgehrd(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dgehrd(int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgelq2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dgelq2(int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgelqf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dgelqf(int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgels(java.lang.String, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dgels(String, int, int, int, double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgelsd(int, int, int, double[], int, double[], int, double[], double, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)"><B>dgelsd(int, int, int, double[], int, double[], int, double[], double, intW, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgelss(int, int, int, double[], int, double[], int, double[], double, org.netlib.util.intW, double[], int, org.netlib.util.intW)"><B>dgelss(int, int, int, double[], int, double[], int, double[], double, intW, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgelsx(int, int, int, double[], int, double[], int, int[], double, org.netlib.util.intW, double[], org.netlib.util.intW)"><B>dgelsx(int, int, int, double[], int, double[], int, int[], double, intW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgelsy(int, int, int, double[], int, double[], int, int[], double, org.netlib.util.intW, double[], int, org.netlib.util.intW)"><B>dgelsy(int, int, int, double[], int, double[], int, int[], double, intW, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dgemm(java.lang.String, java.lang.String, int, int, int, double, double[], int, double[], int, double, double[], int)"><B>dgemm(String, String, int, int, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dgemv(java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><B>dgemv(String, int, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeql2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dgeql2(int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeqlf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dgeqlf(int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeqp3(int, int, double[], int, int[], double[], double[], int, org.netlib.util.intW)"><B>dgeqp3(int, int, double[], int, int[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeqpf(int, int, double[], int, int[], double[], double[], org.netlib.util.intW)"><B>dgeqpf(int, int, double[], int, int[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeqr2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dgeqr2(int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgeqrf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dgeqrf(int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dger(int, int, double, double[], int, double[], int, double[], int)"><B>dger(int, int, double, double[], int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgerfs(java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dgerfs(String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgerq2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dgerq2(int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgerqf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dgerqf(int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgesc2(int, double[], int, double[], int[], int[], org.netlib.util.doubleW)"><B>dgesc2(int, double[], int, double[], int[], int[], doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgesdd(java.lang.String, int, int, double[], int, double[], double[], int, double[], int, double[], int, int[], org.netlib.util.intW)"><B>dgesdd(String, int, int, double[], int, double[], double[], int, double[], int, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgesv(int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dgesv(int, int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgesvd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dgesvd(String, String, int, int, double[], int, double[], double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgesvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, int[], org.netlib.util.StringW, double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dgesvx(String, String, int, int, double[], int, double[], int, int[], StringW, double[], double[], double[], int, double[], int, doubleW, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgetc2(int, double[], int, int[], int[], org.netlib.util.intW)"><B>dgetc2(int, double[], int, int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgetf2(int, int, double[], int, int[], org.netlib.util.intW)"><B>dgetf2(int, int, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgetrf(int, int, double[], int, int[], org.netlib.util.intW)"><B>dgetrf(int, int, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgetri(int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dgetri(int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgetrs(java.lang.String, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dgetrs(String, int, int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dgetv0(org.netlib.util.intW, java.lang.String, int, boolean, int, int, double[], int, double[], org.netlib.util.doubleW, int[], double[], org.netlib.util.intW)"><B>dgetv0(intW, String, int, boolean, int, int, double[], int, double[], doubleW, int[], double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggbak(java.lang.String, java.lang.String, int, int, int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dggbak(String, String, int, int, int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggbal(java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], org.netlib.util.intW)"><B>dggbal(String, int, double[], int, double[], int, intW, intW, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgges(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, int, double[], int, double[], int, org.netlib.util.intW, double[], double[], double[], double[], int, double[], int, double[], int, boolean[], org.netlib.util.intW)"><B>dgges(String, String, String, Object, int, double[], int, double[], int, intW, double[], double[], double[], double[], int, double[], int, double[], int, boolean[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggesx(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, double[], double[], double[], double[], int, double[], int, double[], double[], double[], int, int[], int, boolean[], org.netlib.util.intW)"><B>dggesx(String, String, String, Object, String, int, double[], int, double[], int, intW, double[], double[], double[], double[], int, double[], int, [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggev(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dggev(String, String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], double[], int, int[], boolean[], org.netlib.util.intW)"><B>dggevx(String, String, String, String, int, double[], int, double[], int, doubl [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggglm(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)"><B>dggglm(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgghrd(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dgghrd(String, String, int, int, int, double[], int, double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgglse(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)"><B>dgglse(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggqrf(int, int, int, double[], int, double[], double[], int, double[], double[], int, org.netlib.util.intW)"><B>dggqrf(int, int, int, double[], int, double[], double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggrqf(int, int, int, double[], int, double[], double[], int, double[], double[], int, org.netlib.util.intW)"><B>dggrqf(int, int, int, double[], int, double[], double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggsvd(java.lang.String, java.lang.String, java.lang.String, int, int, int, org.netlib.util.intW, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], int[], org.netlib.util.intW)"><B>dggsvd(String, String, String, int, int, int, intW, intW, double[], int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dggsvp(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double, double, org.netlib.util.intW, org.netlib.util.intW, double[], int, double[], int, double[], int, int[], double[], double[], org.netlib.util.intW)"><B>dggsvp(String, String, String, int, int, int, double[], int, double[], int, double, double, intW, intW, double[], int, double[], int, double[], int, int[], double[], double[], intW)< [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgtcon(java.lang.String, int, double[], double[], double[], double[], int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dgtcon(String, int, double[], double[], double[], double[], int[], double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgtrfs(java.lang.String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dgtrfs(String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgtsv(int, int, double[], double[], double[], double[], int, org.netlib.util.intW)"><B>dgtsv(int, int, double[], double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgtsvx(java.lang.String, java.lang.String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dgtsvx(String, String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, doubleW, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgttrf(int, double[], double[], double[], double[], int[], org.netlib.util.intW)"><B>dgttrf(int, double[], double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgttrs(java.lang.String, int, int, double[], double[], double[], double[], int[], double[], int, org.netlib.util.intW)"><B>dgttrs(String, int, int, double[], double[], double[], double[], int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dgtts2(int, int, int, double[], double[], double[], double[], int[], double[], int)"><B>dgtts2(int, int, int, double[], double[], double[], double[], int[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dhgeqz(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><B>dhgeqz(String, String, String, int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dhsein(java.lang.String, java.lang.String, java.lang.String, boolean[], int, double[], int, double[], double[], double[], int, double[], int, int, org.netlib.util.intW, double[], int[], int[], org.netlib.util.intW)"><B>dhsein(String, String, String, boolean[], int, double[], int, double[], double[], double[], int, double[], int, int, intW, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dhseqr(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], double[], int, double[], int, org.netlib.util.intW)"><B>dhseqr(String, String, int, int, int, double[], int, double[], double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#disnan(double)"><B>disnan(double)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlabad(org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlabad(doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlabrd(int, int, int, double[], int, double[], double[], double[], double[], double[], int, double[], int)"><B>dlabrd(int, int, int, double[], int, double[], double[], double[], double[], double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlacn2(int, double[], double[], int[], org.netlib.util.doubleW, org.netlib.util.intW, int[])"><B>dlacn2(int, double[], double[], int[], doubleW, intW, int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlacon(int, double[], double[], int[], org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlacon(int, double[], double[], int[], doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlacpy(java.lang.String, int, int, double[], int, double[], int)"><B>dlacpy(String, int, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dladiv(double, double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dladiv(double, double, double, double, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlae2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlae2(double, double, double, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaebz(int, int, int, int, int, int, double, double, double, double[], double[], double[], int[], double[], double[], org.netlib.util.intW, int[], double[], int[], org.netlib.util.intW)"><B>dlaebz(int, int, int, int, int, int, double, double, double, double[], double[], double[], int[], double[], double[], intW, int[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed0(int, int, int, double[], double[], double[], int, double[], int, double[], int[], org.netlib.util.intW)"><B>dlaed0(int, int, int, double[], double[], double[], int, double[], int, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed1(int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], int[], org.netlib.util.intW)"><B>dlaed1(int, double[], double[], int, int[], doubleW, int, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed2(org.netlib.util.intW, int, int, double[], double[], int, int[], org.netlib.util.doubleW, double[], double[], double[], double[], int[], int[], int[], int[], org.netlib.util.intW)"><B>dlaed2(intW, int, int, double[], double[], int, int[], doubleW, double[], double[], double[], double[], int[], int[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed3(int, int, int, double[], double[], int, double, double[], double[], int[], int[], double[], double[], org.netlib.util.intW)"><B>dlaed3(int, int, int, double[], double[], int, double, double[], double[], int[], int[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed4(int, int, double[], double[], double[], double, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlaed4(int, int, double[], double[], double[], double, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed5(int, double[], double[], double[], double, org.netlib.util.doubleW)"><B>dlaed5(int, double[], double[], double[], double, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed6(int, boolean, double, double[], double[], double, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlaed6(int, boolean, double, double[], double[], double, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed7(int, int, int, int, int, int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], int[], int[], int[], int[], int[], double[], double[], int[], org.netlib.util.intW)"><B>dlaed7(int, int, int, int, int, int, double[], double[], int, int[], doubleW, int, double[], int[], int[], int[], int[], int[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed8(int, org.netlib.util.intW, int, int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], double[], double[], int, double[], int[], org.netlib.util.intW, int[], double[], int[], int[], org.netlib.util.intW)"><B>dlaed8(int, intW, int, int, double[], double[], int, int[], doubleW, int, double[], double[], double[], int, double[], int[], intW, int[], double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaed9(int, int, int, int, double[], double[], int, double, double[], double[], double[], int, org.netlib.util.intW)"><B>dlaed9(int, int, int, int, double[], double[], int, double, double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaeda(int, int, int, int, int[], int[], int[], int[], double[], double[], int[], double[], double[], org.netlib.util.intW)"><B>dlaeda(int, int, int, int, int[], int[], int[], int[], double[], double[], int[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaein(boolean, boolean, int, double[], int, double, double, double[], double[], double[], int, double[], double, double, double, org.netlib.util.intW)"><B>dlaein(boolean, boolean, int, double[], int, double, double, double[], double[], double[], int, double[], double, double, double, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaev2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlaev2(double, double, double, doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaexc(boolean, int, double[], int, double[], int, int, int, int, double[], org.netlib.util.intW)"><B>dlaexc(boolean, int, double[], int, double[], int, int, int, int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlag2(double[], int, double[], int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlag2(double[], int, double[], int, double, doubleW, doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlag2s(int, int, double[], int, float[], int, org.netlib.util.intW)"><B>dlag2s(int, int, double[], int, float[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlags2(boolean, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlags2(boolean, double, double, double, double, double, double, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlagtf(int, double[], double, double[], double[], double, double[], int[], org.netlib.util.intW)"><B>dlagtf(int, double[], double, double[], double[], double, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlagtm(java.lang.String, int, int, double, double[], double[], double[], double[], int, double, double[], int)"><B>dlagtm(String, int, int, double, double[], double[], double[], double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlagts(int, int, double[], double[], double[], double[], int[], double[], org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlagts(int, int, double[], double[], double[], double[], int[], double[], doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlagv2(double[], int, double[], int, double[], double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlagv2(double[], int, double[], int, double[], double[], double[], doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlahqr(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, org.netlib.util.intW)"><B>dlahqr(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlahr2(int, int, int, double[], int, double[], double[], int, double[], int)"><B>dlahr2(int, int, int, double[], int, double[], double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlahrd(int, int, int, double[], int, double[], double[], int, double[], int)"><B>dlahrd(int, int, int, double[], int, double[], double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaic1(int, int, double[], double, double[], double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlaic1(int, int, double[], double, double[], double, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaisnan(double, double)"><B>dlaisnan(double, double)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaln2(boolean, int, int, double, double, double[], int, double, double, double[], int, double, double, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlaln2(boolean, int, int, double, double, double[], int, double, double, double[], int, double, double, double[], int, doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlals0(int, int, int, int, int, double[], int, double[], int, int[], int, int[], int, double[], int, double[], double[], double[], double[], int, double, double, double[], org.netlib.util.intW)"><B>dlals0(int, int, int, int, int, double[], int, double[], int, int[], int, int[], int, double[], int, double[], double[], double[], double[], int, double, double, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlalsa(int, int, int, int, double[], int, double[], int, double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], org.netlib.util.intW)"><B>dlalsa(int, int, int, int, double[], int, double[], int, double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlalsd(java.lang.String, int, int, int, double[], double[], double[], int, double, org.netlib.util.intW, double[], int[], org.netlib.util.intW)"><B>dlalsd(String, int, int, int, double[], double[], double[], int, double, intW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamc1(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.booleanW)"><B>dlamc1(intW, intW, booleanW, booleanW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamc2(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW)"><B>dlamc2(intW, intW, booleanW, doubleW, intW, doubleW, intW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamc3(double, double)"><B>dlamc3(double, double)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamc4(org.netlib.util.intW, double, int)"><B>dlamc4(intW, double, int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamc5(int, int, int, boolean, org.netlib.util.intW, org.netlib.util.doubleW)"><B>dlamc5(int, int, int, boolean, intW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamch(java.lang.String)"><B>dlamch(String)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlamrg(int, int, double[], int, int, int[])"><B>dlamrg(int, int, double[], int, int, int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaneg(int, double[], double[], double, double, int)"><B>dlaneg(int, double[], double[], double, double, int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlangb(java.lang.String, int, int, int, double[], int, double[])"><B>dlangb(String, int, int, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlange(java.lang.String, int, int, double[], int, double[])"><B>dlange(String, int, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlangt(java.lang.String, int, double[], double[], double[])"><B>dlangt(String, int, double[], double[], double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlanhs(java.lang.String, int, double[], int, double[])"><B>dlanhs(String, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlansb(java.lang.String, java.lang.String, int, int, double[], int, double[])"><B>dlansb(String, String, int, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlansp(java.lang.String, java.lang.String, int, double[], double[])"><B>dlansp(String, String, int, double[], double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlanst(java.lang.String, int, double[], double[])"><B>dlanst(String, int, double[], double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlansy(java.lang.String, java.lang.String, int, double[], int, double[])"><B>dlansy(String, String, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlantb(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[])"><B>dlantb(String, String, String, int, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlantp(java.lang.String, java.lang.String, java.lang.String, int, double[], double[])"><B>dlantp(String, String, String, int, double[], double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlantr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[])"><B>dlantr(String, String, String, int, int, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlanv2(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlanv2(doubleW, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlapll(int, double[], int, double[], int, org.netlib.util.doubleW)"><B>dlapll(int, double[], int, double[], int, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlapmt(boolean, int, int, double[], int, int[])"><B>dlapmt(boolean, int, int, double[], int, int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlapy2(double, double)"><B>dlapy2(double, double)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlapy3(double, double, double)"><B>dlapy3(double, double, double)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqgb(int, int, int, int, double[], int, double[], double[], double, double, double, org.netlib.util.StringW)"><B>dlaqgb(int, int, int, int, double[], int, double[], double[], double, double, double, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqge(int, int, double[], int, double[], double[], double, double, double, org.netlib.util.StringW)"><B>dlaqge(int, int, double[], int, double[], double[], double, double, double, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqp2(int, int, int, double[], int, int[], double[], double[], double[], double[])"><B>dlaqp2(int, int, int, double[], int, int[], double[], double[], double[], double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqps(int, int, int, int, org.netlib.util.intW, double[], int, int[], double[], double[], double[], double[], double[], int)"><B>dlaqps(int, int, int, int, intW, double[], int, int[], double[], double[], double[], double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqr0(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dlaqr0(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqr1(int, double[], int, double, double, double, double, double[])"><B>dlaqr1(int, double[], int, double, double, double, double, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqr2(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)"><B>dlaqr2(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, intW, intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqr3(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)"><B>dlaqr3(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, intW, intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqr4(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dlaqr4(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqr5(boolean, boolean, int, int, int, int, int, double[], double[], double[], int, int, int, double[], int, double[], int, double[], int, int, double[], int, int, double[], int)"><B>dlaqr5(boolean, boolean, int, int, int, int, int, double[], double[], double[], int, int, int, double[], int, double[], int, double[], int, int, double[], int, int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dlaqrb(boolean, int, int, int, double[], int, double[], double[], double[], org.netlib.util.intW)"><B>dlaqrb(boolean, int, int, int, double[], int, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqsb(java.lang.String, int, int, double[], int, double[], double, double, org.netlib.util.StringW)"><B>dlaqsb(String, int, int, double[], int, double[], double, double, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqsp(java.lang.String, int, double[], double[], double, double, org.netlib.util.StringW)"><B>dlaqsp(String, int, double[], double[], double, double, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqsy(java.lang.String, int, double[], int, double[], double, double, org.netlib.util.StringW)"><B>dlaqsy(String, int, double[], int, double[], double, double, StringW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaqtr(boolean, boolean, int, double[], int, double[], double, org.netlib.util.doubleW, double[], double[], org.netlib.util.intW)"><B>dlaqtr(boolean, boolean, int, double[], int, double[], double, doubleW, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlar1v(int, int, int, double, double[], double[], double[], double[], double, double, double[], boolean, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, int[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[])"><B>dlar1v(int, int, int, double, double[], double[], double[], double[], double, double, double[], boolean, intW, doubleW, doubleW, intW, int[], doubleW, [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlar2v(int, double[], double[], double[], int, double[], double[], int)"><B>dlar2v(int, double[], double[], double[], int, double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarf(java.lang.String, int, int, double[], int, double, double[], int, double[])"><B>dlarf(String, int, int, double[], int, double, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarfb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int)"><B>dlarfb(String, String, String, String, int, int, int, double[], int, double[], int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarfg(int, org.netlib.util.doubleW, double[], int, org.netlib.util.doubleW)"><B>dlarfg(int, doubleW, double[], int, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarft(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int)"><B>dlarft(String, String, int, int, double[], int, double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarfx(java.lang.String, int, int, double[], double, double[], int, double[])"><B>dlarfx(String, int, int, double[], double, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlargv(int, double[], int, double[], int, double[], int)"><B>dlargv(int, double[], int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarnv(int, int[], int, double[])"><B>dlarnv(int, int[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarra(int, double[], double[], double[], double, double, org.netlib.util.intW, int[], org.netlib.util.intW)"><B>dlarra(int, double[], double[], double[], double, double, intW, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrb(int, double[], double[], int, int, double, double, int, double[], double[], double[], double[], int[], double, double, int, org.netlib.util.intW)"><B>dlarrb(int, double[], double[], int, int, double, double, int, double[], double[], double[], double[], int[], double, double, int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrc(java.lang.String, int, double, double, double[], double[], double, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)"><B>dlarrc(String, int, double, double, double[], double[], double, intW, intW, intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrd(java.lang.String, java.lang.String, int, double, double, int, int, double[], double, double[], double[], double[], double, int, int[], org.netlib.util.intW, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[], double[], int[], org.netlib.util.intW)"><B>dlarrd(String, String, int, double, double, int, int, double[], double, double[], double[], double[], double, int, int[], intW, double[], double[], doubleW [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarre(java.lang.String, int, org.netlib.util.doubleW, org.netlib.util.doubleW, int, int, double[], double[], double[], double, double, double, org.netlib.util.intW, int[], org.netlib.util.intW, double[], double[], double[], int[], int[], double[], org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dlarre(String, int, doubleW, doubleW, int, int, double[], double[], double[], double, double, double, intW, int[], intW, double[] [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrf(int, double[], double[], double[], int, int, double[], double[], double[], double, double, double, double, org.netlib.util.doubleW, double[], double[], double[], org.netlib.util.intW)"><B>dlarrf(int, double[], double[], double[], int, int, double[], double[], double[], double, double, double, double, doubleW, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrj(int, double[], double[], int, int, double, int, double[], double[], double[], int[], double, double, org.netlib.util.intW)"><B>dlarrj(int, double[], double[], int, int, double, int, double[], double[], double[], int[], double, double, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrk(int, int, double, double, double[], double[], double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlarrk(int, int, double, double, double[], double[], double, double, doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrr(int, double[], double[], org.netlib.util.intW)"><B>dlarrr(int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarrv(int, double, double, double[], double[], double, int[], int, int, int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], double[], int[], int[], double[], double[], int, int[], double[], int[], org.netlib.util.intW)"><B>dlarrv(int, double, double, double[], double[], double, int[], int, int, int, double, doubleW, doubleW, double[], double[], double[], int[], int[], double[], double[], int, int[], double[], i [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlartg(double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlartg(double, double, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlartv(int, double[], int, double[], int, double[], double[], int)"><B>dlartv(int, double[], int, double[], int, double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaruv(int[], int, double[])"><B>dlaruv(int[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarz(java.lang.String, int, int, int, double[], int, double, double[], int, double[])"><B>dlarz(String, int, int, int, double[], int, double, double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarzb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], int, double[], int, double[], int)"><B>dlarzb(String, String, String, String, int, int, int, int, double[], int, double[], int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlarzt(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int)"><B>dlarzt(String, String, int, int, double[], int, double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlas2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlas2(double, double, double, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlascl(java.lang.String, int, int, double, double, int, int, double[], int, org.netlib.util.intW)"><B>dlascl(String, int, int, double, double, int, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd0(int, int, double[], double[], double[], int, double[], int, int, int[], double[], org.netlib.util.intW)"><B>dlasd0(int, int, double[], double[], double[], int, double[], int, int, int[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd1(int, int, int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], org.netlib.util.intW)"><B>dlasd1(int, int, int, double[], doubleW, doubleW, double[], int, double[], int, int[], int[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd2(int, int, int, org.netlib.util.intW, double[], double[], double, double, double[], int, double[], int, double[], double[], int, double[], int, int[], int[], int[], int[], int[], org.netlib.util.intW)"><B>dlasd2(int, int, int, intW, double[], double[], double, double, double[], int, double[], int, double[], double[], int, double[], int, int[], int[], int[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd3(int, int, int, int, double[], double[], int, double[], double[], int, double[], int, double[], int, double[], int, int[], int[], double[], org.netlib.util.intW)"><B>dlasd3(int, int, int, int, double[], double[], int, double[], double[], int, double[], int, double[], int, double[], int, int[], int[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd4(int, int, double[], double[], double[], double, org.netlib.util.doubleW, double[], org.netlib.util.intW)"><B>dlasd4(int, int, double[], double[], double[], double, doubleW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd5(int, double[], double[], double[], double, org.netlib.util.doubleW, double[])"><B>dlasd5(int, double[], double[], double[], double, doubleW, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd6(int, int, int, int, double[], double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[], org.netlib.util.intW, int[], int, double[], int, double[], double[], double[], double[], org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dlasd6(int, int, int, int, double[], double[], double[], doubleW, doubleW, int[], int[], intW, int[], int, double[], int, [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd7(int, int, int, int, org.netlib.util.intW, double[], double[], double[], double[], double[], double[], double[], double, double, double[], int[], int[], int[], int[], org.netlib.util.intW, int[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlasd7(int, int, int, int, intW, double[], double[], double[], double[], double[], double[], double[], double, double, double[], int[], int[], int[] [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasd8(int, int, double[], double[], double[], double[], double[], double[], int, double[], double[], org.netlib.util.intW)"><B>dlasd8(int, int, double[], double[], double[], double[], double[], double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasda(int, int, int, int, double[], double[], double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], org.netlib.util.intW)"><B>dlasda(int, int, int, int, double[], double[], double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasdq(java.lang.String, int, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><B>dlasdq(String, int, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasdt(int, org.netlib.util.intW, org.netlib.util.intW, int[], int[], int[], int)"><B>dlasdt(int, intW, intW, int[], int[], int[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaset(java.lang.String, int, int, double, double, double[], int)"><B>dlaset(String, int, int, double, double, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasq1(int, double[], double[], double[], org.netlib.util.intW)"><B>dlasq1(int, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasq2(int, double[], org.netlib.util.intW)"><B>dlasq2(int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasq3(int, org.netlib.util.intW, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean)"><B>dlasq3(int, intW, double[], int, doubleW, doubleW, doubleW, doubleW, intW, intW, intW, boolean)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasq4(int, int, double[], int, int, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlasq4(int, int, double[], int, int, double, double, double, double, double, double, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasq5(int, int, double[], int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, boolean)"><B>dlasq5(int, int, double[], int, double, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW, boolean)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasq6(int, int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlasq6(int, int, double[], int, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], double[], int)"><B>dlasr(String, String, String, int, int, double[], double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasrt(java.lang.String, int, double[], org.netlib.util.intW)"><B>dlasrt(String, int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlassq(int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlassq(int, double[], int, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasv2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlasv2(double, double, double, doubleW, doubleW, doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlaswp(int, double[], int, int, int, int[], int)"><B>dlaswp(int, double[], int, int, int, int[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasy2(boolean, boolean, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, double[], int, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dlasy2(boolean, boolean, int, int, int, double[], int, double[], int, double[], int, doubleW, double[], int, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlasyf(java.lang.String, int, int, org.netlib.util.intW, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dlasyf(String, int, int, intW, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatbs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)"><B>dlatbs(String, String, String, String, int, int, double[], int, double[], doubleW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatdf(int, int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[])"><B>dlatdf(int, int, double[], int, double[], doubleW, doubleW, int[], int[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatps(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)"><B>dlatps(String, String, String, String, int, double[], double[], doubleW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatrd(java.lang.String, int, int, double[], int, double[], double[], double[], int)"><B>dlatrd(String, int, int, double[], int, double[], double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatrs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)"><B>dlatrs(String, String, String, String, int, double[], int, double[], doubleW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatrz(int, int, int, double[], int, double[], double[])"><B>dlatrz(int, int, int, double[], int, double[], double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlatzm(java.lang.String, int, int, double[], int, double, double[], double[], int, double[])"><B>dlatzm(String, int, int, double[], int, double, double[], double[], int, double[])</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlauu2(java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dlauu2(String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlauum(java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dlauum(String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlazq3(int, org.netlib.util.intW, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>dlazq3(int, intW, double[], int, doubleW, doub [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dlazq4(int, int, double[], int, int, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW)"><B>dlazq4(int, int, double[], int, int, double, double, double, double, double, double, doubleW, intW, doubleW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dmout(int, int, int, double[], int, int, java.lang.String)"><B>dmout(int, int, int, double[], int, int, String)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dnaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, double[], org.netlib.util.doubleW, double[], int, double[], int, int[], double[], org.netlib.util.intW)"><B>dnaitr(intW, String, int, int, int, int, double[], doubleW, double[], int, double[], int, int[], double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dnapps(int, org.netlib.util.intW, int, double[], double[], double[], int, double[], int, double[], double[], int, double[], double[])"><B>dnapps(int, intW, int, double[], double[], double[], int, double[], int, double[], double[], int, double[], double[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dnaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double, double[], int, int, int, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], double[], int, double[], int[], double[], org.netlib.util.intW)"><B>dnaup2(intW, String, int, String, intW, intW, double, double[], int, int, int, intW, double[], int, double[], int, double[], double[], double[], doub [...]
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dnaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><B>dnaupd(intW, String, int, String, int, doubleW, double[], int, double[], int, int[], int[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dnconv(int, double[], double[], double[], double, org.netlib.util.intW)"><B>dnconv(int, double[], double[], double[], double, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dneigh(double, org.netlib.util.intW, double[], int, double[], double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dneigh(double, intW, double[], int, double[], double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dneupd(boolean, java.lang.String, boolean[], double[], double[], double[], int, double, double, double[], java.lang.String, int, java.lang.String, org.netlib.util.intW, double, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><B>dneupd(boolean, String, boolean[], double[], double[], double[], int, double, double, double[], String, int, String, intW, double, double[], int, double[], int, int[], int[], [...]
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dngets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], double[], double[])"><B>dngets(int, String, intW, intW, double[], double[], double[], double[], double[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/blas/BLAS.html#dnrm2(int, double[], int)"><B>dnrm2(int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dopgtr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dopgtr(String, int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dopmtr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dopmtr(String, String, String, int, int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorg2l(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dorg2l(int, int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorg2r(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dorg2r(int, int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgbr(java.lang.String, int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorgbr(String, int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorghr(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorghr(int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgl2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dorgl2(int, int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorglq(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorglq(int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgql(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorgql(int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgqr(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorgqr(int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgr2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><B>dorgr2(int, int, int, double[], int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgrq(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorgrq(int, int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorgtr(java.lang.String, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dorgtr(String, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorm2l(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dorm2l(String, String, int, int, int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorm2r(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dorm2r(String, String, int, int, int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormbr(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormbr(String, String, String, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormhr(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormhr(String, String, int, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dorml2(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dorml2(String, String, int, int, int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormlq(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormlq(String, String, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormql(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormql(String, String, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormqr(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormqr(String, String, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormr2(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dormr2(String, String, int, int, int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormr3(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dormr3(String, String, int, int, int, int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormrq(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormrq(String, String, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormrz(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormrz(String, String, int, int, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dormtr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><B>dormtr(String, String, String, int, int, double[], int, double[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbcon(java.lang.String, int, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dpbcon(String, int, int, double[], int, double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbequ(java.lang.String, int, int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dpbequ(String, int, int, double[], int, double[], doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbrfs(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dpbrfs(String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbstf(java.lang.String, int, int, double[], int, org.netlib.util.intW)"><B>dpbstf(String, int, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbsv(java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dpbsv(String, int, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbsvx(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dpbsvx(String, String, int, int, int, double[], int, double[], int, StringW, double[], double[], int, double[], int, doubleW, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbtf2(java.lang.String, int, int, double[], int, org.netlib.util.intW)"><B>dpbtf2(String, int, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbtrf(java.lang.String, int, int, double[], int, org.netlib.util.intW)"><B>dpbtrf(String, int, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpbtrs(java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dpbtrs(String, int, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpocon(java.lang.String, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dpocon(String, int, double[], int, double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpoequ(int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dpoequ(int, double[], int, double[], doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dporfs(java.lang.String, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dporfs(String, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dposv(java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dposv(String, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dposvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dposvx(String, String, int, int, double[], int, double[], int, StringW, double[], double[], int, double[], int, doubleW, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpotf2(java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dpotf2(String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpotrf(java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dpotrf(String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpotri(java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dpotri(String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpotrs(java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dpotrs(String, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dppcon(java.lang.String, int, double[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dppcon(String, int, double[], double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dppequ(java.lang.String, int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dppequ(String, int, double[], double[], doubleW, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpprfs(java.lang.String, int, int, double[], double[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dpprfs(String, int, int, double[], double[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dppsv(java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)"><B>dppsv(String, int, int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dppsvx(java.lang.String, java.lang.String, int, int, double[], double[], org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dppsvx(String, String, int, int, double[], double[], StringW, double[], double[], int, double[], int, doubleW, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpptrf(java.lang.String, int, double[], org.netlib.util.intW)"><B>dpptrf(String, int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpptri(java.lang.String, int, double[], org.netlib.util.intW)"><B>dpptri(String, int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpptrs(java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)"><B>dpptrs(String, int, int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dptcon(int, double[], double[], double, org.netlib.util.doubleW, double[], org.netlib.util.intW)"><B>dptcon(int, double[], double[], double, doubleW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpteqr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dpteqr(String, int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dptrfs(int, int, double[], double[], double[], double[], double[], int, double[], int, double[], double[], double[], org.netlib.util.intW)"><B>dptrfs(int, int, double[], double[], double[], double[], double[], int, double[], int, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dptsv(int, int, double[], double[], double[], int, org.netlib.util.intW)"><B>dptsv(int, int, double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dptsvx(java.lang.String, int, int, double[], double[], double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], org.netlib.util.intW)"><B>dptsvx(String, int, int, double[], double[], double[], double[], double[], int, double[], int, doubleW, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpttrf(int, double[], double[], org.netlib.util.intW)"><B>dpttrf(int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dpttrs(int, int, double[], double[], double[], int, org.netlib.util.intW)"><B>dpttrs(int, int, double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dptts2(int, int, double[], double[], double[], int)"><B>dptts2(int, int, double[], double[], double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#drot(int, double[], int, double[], int, double, double)"><B>drot(int, double[], int, double[], int, double, double)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#drotg(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><B>drotg(doubleW, doubleW, doubleW, doubleW)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#drotm(int, double[], int, double[], int, double[])"><B>drotm(int, double[], int, double[], int, double[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#drotmg(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, double, double[])"><B>drotmg(doubleW, doubleW, doubleW, double, double[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#drscl(int, double, double[], int)"><B>drscl(int, double, double[], int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, double[], org.netlib.util.doubleW, double[], int, double[], int, int[], double[], org.netlib.util.intW)"><B>dsaitr(intW, String, int, int, int, int, double[], doubleW, double[], int, double[], int, int[], double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsapps(int, int, int, double[], double[], int, double[], int, double[], double[], int, double[])"><B>dsapps(int, int, int, double[], double[], int, double[], int, double[], double[], int, double[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double, double[], int, int, int, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], int, double[], int[], double[], org.netlib.util.intW)"><B>dsaup2(intW, String, int, String, intW, intW, double, double[], int, int, int, intW, double[], int, double[], int, double[], double[], double[], int, double[], [...]
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><B>dsaupd(intW, String, int, String, int, doubleW, double[], int, double[], int, int[], int[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbev(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dsbev(String, String, int, int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbevd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><B>dsbevd(String, String, int, int, double[], int, double[], double[], int, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbevx(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><B>dsbevx(String, String, String, int, int, double[], int, double[], int, double, double, int, int, double, intW, double[], double[], int, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbgst(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><B>dsbgst(String, String, int, int, int, double[], int, double[], int, double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbgv(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><B>dsbgv(String, String, int, int, int, double[], int, double[], int, double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbgvd(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><B>dsbgvd(String, String, int, int, int, double[], int, double[], int, double[], double[], int, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbgvx(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><B>dsbgvx(String, String, String, int, int, int, double[], int, double[], int, double[], int, double, double, int, int, double, intW, double[], double[], int, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsbmv(java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><B>dsbmv(String, int, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsbtrd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dsbtrd(String, String, int, int, double[], int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dscal(int, double, double[], int)"><B>dscal(int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsconv(int, double[], double[], double, org.netlib.util.intW)"><B>dsconv(int, double[], double[], double, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsecnd()"><B>dsecnd()</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dseigt(double, int, double[], int, double[], double[], double[], org.netlib.util.intW)"><B>dseigt(double, int, double[], int, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsesrt(java.lang.String, boolean, int, double[], int, double[], int)"><B>dsesrt(String, boolean, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dseupd(boolean, java.lang.String, boolean[], double[], double[], int, double, java.lang.String, int, java.lang.String, org.netlib.util.intW, double, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><B>dseupd(boolean, String, boolean[], double[], double[], int, double, String, int, String, intW, double, double[], int, double[], int, int[], int[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsgesv(int, int, double[], int, int[], double[], int, double[], int, double[], float[], org.netlib.util.intW, org.netlib.util.intW)"><B>dsgesv(int, int, double[], int, int[], double[], int, double[], int, double[], float[], intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsgets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[])"><B>dsgets(int, String, intW, intW, double[], double[], double[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsortc(java.lang.String, boolean, int, double[], double[], double[])"><B>dsortc(String, boolean, int, double[], double[], double[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dsortr(java.lang.String, boolean, int, double[], double[])"><B>dsortr(String, boolean, int, double[], double[])</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspcon(java.lang.String, int, double[], int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dspcon(String, int, double[], int[], double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspev(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dspev(String, String, int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspevd(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><B>dspevd(String, String, int, double[], double[], double[], int, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspevx(java.lang.String, java.lang.String, java.lang.String, int, double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><B>dspevx(String, String, String, int, double[], double, double, int, int, double, intW, double[], double[], int, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspgst(int, java.lang.String, int, double[], double[], org.netlib.util.intW)"><B>dspgst(int, String, int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspgv(int, java.lang.String, java.lang.String, int, double[], double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dspgv(int, String, String, int, double[], double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspgvd(int, java.lang.String, java.lang.String, int, double[], double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><B>dspgvd(int, String, String, int, double[], double[], double[], double[], int, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspgvx(int, java.lang.String, java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><B>dspgvx(int, String, String, String, int, double[], double[], double, double, int, int, double, intW, double[], double[], int, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dspmv(java.lang.String, int, double, double[], double[], int, double, double[], int)"><B>dspmv(String, int, double, double[], double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dspr(java.lang.String, int, double, double[], int, double[])"><B>dspr(String, int, double, double[], int, double[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dspr2(java.lang.String, int, double, double[], int, double[], int, double[])"><B>dspr2(String, int, double, double[], int, double[], int, double[])</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsprfs(java.lang.String, int, int, double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dsprfs(String, int, int, double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspsv(java.lang.String, int, int, double[], int[], double[], int, org.netlib.util.intW)"><B>dspsv(String, int, int, double[], int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dspsvx(java.lang.String, java.lang.String, int, int, double[], double[], int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><B>dspsvx(String, String, int, int, double[], double[], int[], double[], int, double[], int, doubleW, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsptrd(java.lang.String, int, double[], double[], double[], double[], org.netlib.util.intW)"><B>dsptrd(String, int, double[], double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsptrf(java.lang.String, int, double[], int[], org.netlib.util.intW)"><B>dsptrf(String, int, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsptri(java.lang.String, int, double[], int[], double[], org.netlib.util.intW)"><B>dsptri(String, int, double[], int[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsptrs(java.lang.String, int, int, double[], int[], double[], int, org.netlib.util.intW)"><B>dsptrs(String, int, int, double[], int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dstatn()"><B>dstatn()</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dstats()"><B>dstats()</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstebz(java.lang.String, java.lang.String, int, double, double, int, int, double, double[], double[], org.netlib.util.intW, org.netlib.util.intW, double[], int[], int[], double[], int[], org.netlib.util.intW)"><B>dstebz(String, String, int, double, double, int, int, double, double[], double[], intW, intW, double[], int[], int[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstedc(java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><B>dstedc(String, int, double[], double[], double[], int, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstegr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)"><B>dstegr(String, String, int, double[], double[], double, double, int, int, double, intW, double[], double[], int, int[], double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstein(int, double[], double[], int, double[], int[], int[], double[], int, double[], int[], int[], org.netlib.util.intW)"><B>dstein(int, double[], double[], int, double[], int[], int[], double[], int, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstemr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, org.netlib.util.intW, double[], double[], int, int, int[], org.netlib.util.booleanW, double[], int, int[], int, org.netlib.util.intW)"><B>dstemr(String, String, int, double[], double[], double, double, int, int, intW, double[], double[], int, int, int[], booleanW, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsteqr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dsteqr(String, int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsterf(int, double[], double[], org.netlib.util.intW)"><B>dsterf(int, double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstev(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><B>dstev(String, int, double[], double[], double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstevd(java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><B>dstevd(String, int, double[], double[], double[], int, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstevr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)"><B>dstevr(String, String, int, double[], double[], double, double, int, int, double, intW, double[], double[], int, int[], double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dstevx(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><B>dstevx(String, String, int, double[], double[], double, double, int, int, double, intW, double[], double[], int, double[], int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dstqrb(int, double[], double[], double[], double[], org.netlib.util.intW)"><B>dstqrb(int, double[], double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/blas/BLAS.html#dswap(int, double[], int, double[], int)"><B>dswap(int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsycon(java.lang.String, int, double[], int, int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dsycon(String, int, double[], int, int[], double, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsyev(java.lang.String, java.lang.String, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dsyev(String, String, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsyevd(java.lang.String, java.lang.String, int, double[], int, double[], double[], int, int[], int, org.netlib.util.intW)"><B>dsyevd(String, String, int, double[], int, double[], double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsyevr(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)"><B>dsyevr(String, String, String, int, double[], int, double, double, int, int, double, intW, double[], double[], int, int[], double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsyevx(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int, int[], int[], org.netlib.util.intW)"><B>dsyevx(String, String, String, int, double[], int, double, double, int, int, double, intW, double[], double[], int, double[], int, int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsygs2(int, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW)"><B>dsygs2(int, String, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsygst(int, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW)"><B>dsygst(int, String, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsygv(int, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dsygv(int, String, String, int, double[], int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsygvd(int, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], int, int[], int, org.netlib.util.intW)"><B>dsygvd(int, String, String, int, double[], int, double[], int, double[], double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsygvx(int, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int, int[], int[], org.netlib.util.intW)"><B>dsygvx(int, String, String, String, int, double[], int, double[], int, double, double, int, int, double, intW, double[], double[], int, double[], int, int[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsymm(java.lang.String, java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><B>dsymm(String, String, int, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsymv(java.lang.String, int, double, double[], int, double[], int, double, double[], int)"><B>dsymv(String, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsyr(java.lang.String, int, double, double[], int, double[], int)"><B>dsyr(String, int, double, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsyr2(java.lang.String, int, double, double[], int, double[], int, double[], int)"><B>dsyr2(String, int, double, double[], int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsyr2k(java.lang.String, java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><B>dsyr2k(String, String, int, int, double, double[], int, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsyrfs(java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dsyrfs(String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dsyrk(java.lang.String, java.lang.String, int, int, double, double[], int, double, double[], int)"><B>dsyrk(String, String, int, int, double, double[], int, double, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsysv(java.lang.String, int, int, double[], int, int[], double[], int, double[], int, org.netlib.util.intW)"><B>dsysv(String, int, int, double[], int, int[], double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsysvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int, int[], org.netlib.util.intW)"><B>dsysvx(String, String, int, int, double[], int, double[], int, int[], double[], int, double[], int, doubleW, double[], double[], double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsytd2(java.lang.String, int, double[], int, double[], double[], double[], org.netlib.util.intW)"><B>dsytd2(String, int, double[], int, double[], double[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsytf2(java.lang.String, int, double[], int, int[], org.netlib.util.intW)"><B>dsytf2(String, int, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsytrd(java.lang.String, int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)"><B>dsytrd(String, int, double[], int, double[], double[], double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsytrf(java.lang.String, int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dsytrf(String, int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsytri(java.lang.String, int, double[], int, int[], double[], org.netlib.util.intW)"><B>dsytri(String, int, double[], int, int[], double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dsytrs(java.lang.String, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><B>dsytrs(String, int, int, double[], int, int[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtbcon(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dtbcon(String, String, String, int, int, double[], int, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtbmv(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int)"><B>dtbmv(String, String, String, int, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtbrfs(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dtbrfs(String, String, String, int, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtbsv(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int)"><B>dtbsv(String, String, String, int, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtbtrs(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dtbtrs(String, String, String, int, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgevc(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], int, int, org.netlib.util.intW, double[], org.netlib.util.intW)"><B>dtgevc(String, String, boolean[], int, double[], int, double[], int, double[], int, double[], int, int, intW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgex2(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, int, int, int, double[], int, org.netlib.util.intW)"><B>dtgex2(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, int, int, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgexc(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], int, org.netlib.util.intW)"><B>dtgexc(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, intW, intW, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgsen(int, boolean, boolean, boolean[], int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], int, int[], int, org.netlib.util.intW)"><B>dtgsen(int, boolean, boolean, boolean[], int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, intW, doubleW, doubleW, double[], doubl [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgsja(java.lang.String, java.lang.String, java.lang.String, int, int, int, int, int, double[], int, double[], int, double, double, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW, org.netlib.util.intW)"><B>dtgsja(String, String, String, int, int, int, int, int, double[], int, double[], int, double, double, double[], double[], double[], int, double[], int, double[], int, double[], intW, intW)</B [...]
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgsna(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)"><B>dtgsna(String, String, boolean[], int, double[], int, double[], int, double[], int, double[], int, double[], double[], int, intW, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgsy2(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, int[], org.netlib.util.intW, org.netlib.util.intW)"><B>dtgsy2(String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, doubleW, doubleW, doubleW, int[], intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtgsyl(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], org.netlib.util.intW)"><B>dtgsyl(String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, doubleW, doubleW, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtpcon(java.lang.String, java.lang.String, java.lang.String, int, double[], org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dtpcon(String, String, String, int, double[], doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtpmv(java.lang.String, java.lang.String, java.lang.String, int, double[], double[], int)"><B>dtpmv(String, String, String, int, double[], double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtprfs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dtprfs(String, String, String, int, int, double[], double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtpsv(java.lang.String, java.lang.String, java.lang.String, int, double[], double[], int)"><B>dtpsv(String, String, String, int, double[], double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtptri(java.lang.String, java.lang.String, int, double[], org.netlib.util.intW)"><B>dtptri(String, String, int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtptrs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)"><B>dtptrs(String, String, String, int, int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrcon(java.lang.String, java.lang.String, java.lang.String, int, double[], int, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><B>dtrcon(String, String, String, int, double[], int, doubleW, double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrevc(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, int, org.netlib.util.intW, double[], org.netlib.util.intW)"><B>dtrevc(String, String, boolean[], int, double[], int, double[], int, double[], int, int, intW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrexc(java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.intW)"><B>dtrexc(String, int, double[], int, double[], int, intW, intW, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtrmm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double, double[], int, double[], int)"><B>dtrmm(String, String, String, String, int, int, double, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtrmv(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int)"><B>dtrmv(String, String, String, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrrfs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><B>dtrrfs(String, String, String, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrsen(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], double[], org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], int, org.netlib.util.intW)"><B>dtrsen(String, String, boolean[], int, double[], int, double[], int, double[], double[], intW, doubleW, doubleW, double[], int, int[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtrsm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double, double[], int, double[], int)"><B>dtrsm(String, String, String, String, int, int, double, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrsna(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)"><B>dtrsna(String, String, boolean[], int, double[], int, double[], int, double[], int, double[], double[], int, intW, double[], int, int[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/blas/BLAS.html#dtrsv(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int)"><B>dtrsv(String, String, String, int, double[], int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrsyl(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.intW)"><B>dtrsyl(String, String, int, int, int, double[], int, double[], int, double[], int, doubleW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrti2(java.lang.String, java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dtrti2(String, String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrtri(java.lang.String, java.lang.String, int, double[], int, org.netlib.util.intW)"><B>dtrtri(String, String, int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtrtrs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)"><B>dtrtrs(String, String, String, int, int, double[], int, double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtzrqf(int, int, double[], int, double[], org.netlib.util.intW)"><B>dtzrqf(int, int, double[], int, double[], intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#dtzrzf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><B>dtzrzf(int, int, double[], int, double[], double[], int, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#dvout(int, int, double[], int, java.lang.String)"><B>dvout(int, int, double[], int, String)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-2.html"><B>PREV LETTER</B></A>
+ <A HREF="index-4.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-3.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-3.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-4.html b/javadoc/index-files/index-4.html
new file mode 100644
index 0000000..ef749bb
--- /dev/null
+++ b/javadoc/index-files/index-4.html
@@ -0,0 +1,156 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+G-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="G-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-3.html"><B>PREV LETTER</B></A>
+ <A HREF="index-5.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-4.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-4.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_G_"><!-- --></A><H2>
+<B>G</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#getInstance()"><B>getInstance()</B></A> -
+Static method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>
+<DT><A HREF="../org/netlib/blas/BLAS.html#getInstance()"><B>getInstance()</B></A> -
+Static method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#getInstance()"><B>getInstance()</B></A> -
+Static method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+<DT><A HREF="../org/netlib/utils/JNIMethods.html#getPortableLibraryName(java.lang.String)"><B>getPortableLibraryName(String)</B></A> -
+Static method in class org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A>
+<DD>The System.mapLibraryName method is broken in the sense that it does not give
+ unique names for operating systems and architectures.
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-3.html"><B>PREV LETTER</B></A>
+ <A HREF="index-5.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-4.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-4.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-5.html b/javadoc/index-files/index-5.html
new file mode 100644
index 0000000..e0d0bc4
--- /dev/null
+++ b/javadoc/index-files/index-5.html
@@ -0,0 +1,195 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+I-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="I-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-4.html"><B>PREV LETTER</B></A>
+ <A HREF="index-6.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-5.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-5.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_I_"><!-- --></A><H2>
+<B>I</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#icnteq(int, int[], int)"><B>icnteq(int, int[], int)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#icopy(int, int[], int, int[], int)"><B>icopy(int, int[], int, int[], int)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/blas/BLAS.html#idamax(int, double[], int)"><B>idamax(int, double[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ieeeck(int, float, float)"><B>ieeeck(int, float, float)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ilaenv(int, java.lang.String, java.lang.String, int, int, int, int)"><B>ilaenv(int, String, String, int, int, int, int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#ilaver(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)"><B>ilaver(intW, intW, intW)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+
+ -- LAPACK routine (version 3.1.1) --
+ Univ.
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#iparmq(int, java.lang.String, java.lang.String, int, int, int, int)"><B>iparmq(int, String, String, int, int, int, int)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+
+ Purpose
+ =======
+
+ This program sets problem and machine dependent parameters
+ useful for xHSEQR and its subroutines.
+<DT><A HREF="../org/netlib/blas/BLAS.html#isamax(int, float[], int)"><B>isamax(int, float[], int)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#iset(int, int, int[], int)"><B>iset(int, int, int[], int)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#iswap(int, int[], int, int[], int)"><B>iswap(int, int[], int, int[], int)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+<DT><A HREF="../org/netlib/arpack/ARPACK.html#ivout(int, int, int[], int, java.lang.String)"><B>ivout(int, int, int[], int, String)</B></A> -
+Method in class org.netlib.arpack.<A HREF="../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A>
+<DD>No documentation was available when generating this method.
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-4.html"><B>PREV LETTER</B></A>
+ <A HREF="index-6.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-5.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-5.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-6.html b/javadoc/index-files/index-6.html
new file mode 100644
index 0000000..acb0fda
--- /dev/null
+++ b/javadoc/index-files/index-6.html
@@ -0,0 +1,147 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+J-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="J-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-5.html"><B>PREV LETTER</B></A>
+ <A HREF="index-7.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-6.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-6.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_J_"><!-- --></A><H2>
+<B>J</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><B>JNIMethods</B></A> - Class in <A HREF="../org/netlib/utils/package-summary.html">org.netlib.utils</A><DD>Static helper methods for dealing with the Java Native Interface and detection of
+ operating systems and architectures.<DT><A HREF="../org/netlib/utils/JNIMethods.html#JNIMethods()"><B>JNIMethods()</B></A> -
+Constructor for class org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A>
+<DD>
+<DT><A HREF="../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>JNIMethods.ARCHType</B></A> - Enum in <A HREF="../org/netlib/utils/package-summary.html">org.netlib.utils</A><DD>Enumeration of common CPU architectures.<DT><A HREF="../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><B>JNIMethods.OSType</B></A> - Enum in <A HREF="../org/netlib/utils/package-summary.html">org.netlib.utils</A><DD>Enumeration of common operating systems, [...]
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-5.html"><B>PREV LETTER</B></A>
+ <A HREF="index-7.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-6.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-6.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-7.html b/javadoc/index-files/index-7.html
new file mode 100644
index 0000000..c8a7c10
--- /dev/null
+++ b/javadoc/index-files/index-7.html
@@ -0,0 +1,162 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+L-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="L-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-6.html"><B>PREV LETTER</B></A>
+ <A HREF="index-8.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-7.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-7.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_L_"><!-- --></A><H2>
+<B>L</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack"><B>LAPACK</B></A> - Class in <A HREF="../org/netlib/lapack/package-summary.html">org.netlib.lapack</A><DD>LAPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.<DT><A HREF="../org/netlib/lapack/LAPACK.html#LAPACK()"><B>LAPACK()</B></A> -
+Constructor for class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+<DT><A HREF="../org/netlib/blas/BLAS.html#lsame(java.lang.String, java.lang.String)"><B>lsame(String, String)</B></A> -
+Method in class org.netlib.blas.<A HREF="../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#lsame(java.lang.String, java.lang.String)"><B>lsame(String, String)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+<DT><A HREF="../org/netlib/lapack/LAPACK.html#lsamen(int, java.lang.String, java.lang.String)"><B>lsamen(int, String, String)</B></A> -
+Method in class org.netlib.lapack.<A HREF="../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A>
+<DD>
+
+ ..
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-6.html"><B>PREV LETTER</B></A>
+ <A HREF="index-8.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-7.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-7.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-8.html b/javadoc/index-files/index-8.html
new file mode 100644
index 0000000..7b9da4f
--- /dev/null
+++ b/javadoc/index-files/index-8.html
@@ -0,0 +1,146 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+M-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="M-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-7.html"><B>PREV LETTER</B></A>
+ <A HREF="index-9.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-8.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-8.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_M_"><!-- --></A><H2>
+<B>M</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/utils/JNIMethods.html#main(java.lang.String[])"><B>main(String[])</B></A> -
+Static method in class org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A>
+<DD>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-7.html"><B>PREV LETTER</B></A>
+ <A HREF="index-9.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-8.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-8.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index-files/index-9.html b/javadoc/index-files/index-9.html
new file mode 100644
index 0000000..39a43bf
--- /dev/null
+++ b/javadoc/index-files/index-9.html
@@ -0,0 +1,146 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+O-Index
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="O-Index";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-8.html"><B>PREV LETTER</B></A>
+ <A HREF="index-10.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-9.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-9.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+<A NAME="_O_"><!-- --></A><H2>
+<B>O</B></H2>
+<DL>
+<DT><A HREF="../org/netlib/arpack/package-summary.html"><B>org.netlib.arpack</B></A> - package org.netlib.arpack<DD> <DT><A HREF="../org/netlib/blas/package-summary.html"><B>org.netlib.blas</B></A> - package org.netlib.blas<DD> <DT><A HREF="../org/netlib/lapack/package-summary.html"><B>org.netlib.lapack</B></A> - package org.netlib.lapack<DD> <DT><A HREF="../org/netlib/utils/package-summary.html"><B>org.netlib.utils</B></A> - package org.netlib.utils<DD> <DT><A HREF=" [...]
+Static variable in class org.netlib.utils.<A HREF="../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A>
+<DD>Stores the operating system the JVM is currently running on.
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Index</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index-8.html"><B>PREV LETTER</B></A>
+ <A HREF="index-10.html"><B>NEXT LETTER</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../index.html?index-filesindex-9.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="index-9.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<A HREF="index-1.html">A</A> <A HREF="index-2.html">B</A> <A HREF="index-3.html">D</A> <A HREF="index-4.html">G</A> <A HREF="index-5.html">I</A> <A HREF="index-6.html">J</A> <A HREF="index-7.html">L</A> <A HREF="index-8.html">M</A> <A HREF="index-9.html">O</A> <A HREF="index-10.html">S</A> <A HREF="index-11.html">V</A> <HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/index.html b/javadoc/index.html
new file mode 100644
index 0000000..c47aca2
--- /dev/null
+++ b/javadoc/index.html
@@ -0,0 +1,40 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc on Fri Apr 22 23:31:22 BST 2011-->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Generated Documentation (Untitled)
+</TITLE>
+<SCRIPT type="text/javascript">
+ targetPage = "" + window.location.search;
+ if (targetPage != "" && targetPage != "undefined")
+ targetPage = targetPage.substring(1);
+ if (targetPage.indexOf(":") != -1)
+ targetPage = "undefined";
+ function loadFrames() {
+ if (targetPage != "" && targetPage != "undefined")
+ top.classFrame.location = top.targetPage;
+ }
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+</HEAD>
+<FRAMESET cols="20%,80%" title="" onLoad="top.loadFrames()">
+<FRAMESET rows="30%,70%" title="" onLoad="top.loadFrames()">
+<FRAME src="overview-frame.html" name="packageListFrame" title="All Packages">
+<FRAME src="allclasses-frame.html" name="packageFrame" title="All classes and interfaces (except non-static nested types)">
+</FRAMESET>
+<FRAME src="overview-summary.html" name="classFrame" title="Package, class and interface descriptions" scrolling="yes">
+<NOFRAMES>
+<H2>
+Frame Alert</H2>
+
+<P>
+This document is designed to be viewed using the frames feature. If you see this message, you are using a non-frame-capable web client.
+<BR>
+Link to<A HREF="overview-summary.html">Non-frame version.</A>
+</NOFRAMES>
+</FRAMESET>
+</HTML>
diff --git a/javadoc/org/netlib/arpack/ARPACK.html b/javadoc/org/netlib/arpack/ARPACK.html
new file mode 100644
index 0000000..a27fc81
--- /dev/null
+++ b/javadoc/org/netlib/arpack/ARPACK.html
@@ -0,0 +1,2573 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:20 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+ARPACK
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="ARPACK";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/ARPACK.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/ARPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="ARPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | FIELD | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: FIELD | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<!-- ======== START OF CLASS DATA ======== -->
+<H2>
+<FONT SIZE="-1">
+org.netlib.arpack</FONT>
+<BR>
+Class ARPACK</H2>
+<PRE>
+java.lang.Object
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by "><B>org.netlib.arpack.ARPACK</B>
+</PRE>
+<HR>
+<DL>
+<DT><PRE>public abstract class <B>ARPACK</B><DT>extends java.lang.Object</DL>
+</PRE>
+
+<P>
+ARPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.
+<P>
+
+<P>
+<DL>
+<DT><B>See Also:</B><DD><CODE>http://sourceforge.net/projects/f2j</CODE>,
+<CODE>http://www.netlib.org/arpack/</CODE></DL>
+<HR>
+
+<P>
+
+<!-- ======== CONSTRUCTOR SUMMARY ======== -->
+
+<A NAME="constructor_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Constructor Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ARPACK()">ARPACK</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<!-- ========== METHOD SUMMARY =========== -->
+
+<A NAME="method_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Method Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dgetv0(org.netlib.util.intW, java.lang.String, int, boolean, int, int, double[], int, double[], org.netlib.util.doubleW, int[], double[], org.netlib.util.intW)">dgetv0</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ boolean arg4,
+ int arg5,
+ int arg6,
+ double[] arg7,
+ int arg9,
+ double[] arg10,
+ org.netlib.util.doubleW arg12,
+ int[] arg13,
+ double[] arg15,
+ org.netlib.util.intW arg17)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dlaqrb(boolean, int, int, int, double[], int, double[], double[], double[], org.netlib.util.intW)">dlaqrb</A></B>(boolean arg1,
+ int arg2,
+ int arg3,
+ int arg4,
+ double[] arg5,
+ int arg7,
+ double[] arg8,
+ double[] arg10,
+ double[] arg12,
+ org.netlib.util.intW arg14)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dmout(int, int, int, double[], int, int, java.lang.String)">dmout</A></B>(int arg1,
+ int arg2,
+ int arg3,
+ double[] arg4,
+ int arg6,
+ int arg7,
+ java.lang.String arg8)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dnaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, double[], org.netlib.util.doubleW, double[], int, double[], int, int[], double[], org.netlib.util.intW)">dnaitr</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ double[] arg7,
+ org.netlib.util.doubleW arg9,
+ double[] arg10,
+ int arg12,
+ double[] arg13,
+ int arg15,
+ int[] arg16,
+ double[] arg18,
+ org.netlib.util.intW arg20)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dnapps(int, org.netlib.util.intW, int, double[], double[], double[], int, double[], int, double[], double[], int, double[], double[])">dnapps</A></B>(int arg1,
+ org.netlib.util.intW arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6,
+ double[] arg8,
+ int arg10,
+ double[] arg11,
+ int arg13,
+ double[] arg14,
+ double[] arg16,
+ int arg18,
+ double[] arg19,
+ double[] arg21)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dnaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double, double[], int, int, int, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], double[], int, double[], int[], double[], org.netlib.util.intW)">dnaup2</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ double arg7,
+ double[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ double[] arg14,
+ int arg16,
+ double[] arg17,
+ int arg19,
+ double[] arg20,
+ double[] arg22,
+ double[] arg24,
+ double[] arg26,
+ int arg28,
+ double[] arg29,
+ int[] arg31,
+ double[] arg33,
+ org.netlib.util.intW arg35)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dnaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)">dnaupd</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.doubleW arg6,
+ double[] arg7,
+ int arg9,
+ double[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ double[] arg17,
+ double[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dnconv(int, double[], double[], double[], double, org.netlib.util.intW)">dnconv</A></B>(int arg1,
+ double[] arg2,
+ double[] arg4,
+ double[] arg6,
+ double arg8,
+ org.netlib.util.intW arg9)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dneigh(double, org.netlib.util.intW, double[], int, double[], double[], double[], double[], int, double[], org.netlib.util.intW)">dneigh</A></B>(double arg1,
+ org.netlib.util.intW arg2,
+ double[] arg3,
+ int arg5,
+ double[] arg6,
+ double[] arg8,
+ double[] arg10,
+ double[] arg12,
+ int arg14,
+ double[] arg15,
+ org.netlib.util.intW arg17)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dneupd(boolean, java.lang.String, boolean[], double[], double[], double[], int, double, double, double[], java.lang.String, int, java.lang.String, org.netlib.util.intW, double, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)">dneupd</A></B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ double[] arg5,
+ double[] arg7,
+ double[] arg9,
+ int arg11,
+ double arg12,
+ double arg13,
+ double[] arg14,
+ java.lang.String arg16,
+ int arg17,
+ java.lang.String arg18,
+ org.netlib.util.intW arg19,
+ double arg20,
+ double[] arg21,
+ int arg23,
+ double[] arg24,
+ int arg26,
+ int[] arg27,
+ int[] arg29,
+ double[] arg31,
+ double[] arg33,
+ int arg35,
+ org.netlib.util.intW arg36)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dngets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], double[], double[])">dngets</A></B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ double[] arg5,
+ double[] arg7,
+ double[] arg9,
+ double[] arg11,
+ double[] arg13)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, double[], org.netlib.util.doubleW, double[], int, double[], int, int[], double[], org.netlib.util.intW)">dsaitr</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ double[] arg7,
+ org.netlib.util.doubleW arg9,
+ double[] arg10,
+ int arg12,
+ double[] arg13,
+ int arg15,
+ int[] arg16,
+ double[] arg18,
+ org.netlib.util.intW arg20)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsapps(int, int, int, double[], double[], int, double[], int, double[], double[], int, double[])">dsapps</A></B>(int arg1,
+ int arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6,
+ int arg8,
+ double[] arg9,
+ int arg11,
+ double[] arg12,
+ double[] arg14,
+ int arg16,
+ double[] arg17)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double, double[], int, int, int, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], int, double[], int[], double[], org.netlib.util.intW)">dsaup2</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ double arg7,
+ double[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ double[] arg14,
+ int arg16,
+ double[] arg17,
+ int arg19,
+ double[] arg20,
+ double[] arg22,
+ double[] arg24,
+ int arg26,
+ double[] arg27,
+ int[] arg29,
+ double[] arg31,
+ org.netlib.util.intW arg33)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)">dsaupd</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.doubleW arg6,
+ double[] arg7,
+ int arg9,
+ double[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ double[] arg17,
+ double[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsconv(int, double[], double[], double, org.netlib.util.intW)">dsconv</A></B>(int arg1,
+ double[] arg2,
+ double[] arg4,
+ double arg6,
+ org.netlib.util.intW arg7)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dseigt(double, int, double[], int, double[], double[], double[], org.netlib.util.intW)">dseigt</A></B>(double arg1,
+ int arg2,
+ double[] arg3,
+ int arg5,
+ double[] arg6,
+ double[] arg8,
+ double[] arg10,
+ org.netlib.util.intW arg12)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsesrt(java.lang.String, boolean, int, double[], int, double[], int)">dsesrt</A></B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ double[] arg4,
+ int arg6,
+ double[] arg7,
+ int arg9)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dseupd(boolean, java.lang.String, boolean[], double[], double[], int, double, java.lang.String, int, java.lang.String, org.netlib.util.intW, double, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)">dseupd</A></B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ double[] arg5,
+ double[] arg7,
+ int arg9,
+ double arg10,
+ java.lang.String arg11,
+ int arg12,
+ java.lang.String arg13,
+ org.netlib.util.intW arg14,
+ double arg15,
+ double[] arg16,
+ int arg18,
+ double[] arg19,
+ int arg21,
+ int[] arg22,
+ int[] arg24,
+ double[] arg26,
+ double[] arg28,
+ int arg30,
+ org.netlib.util.intW arg31)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsgets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[])">dsgets</A></B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ double[] arg5,
+ double[] arg7,
+ double[] arg9)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsortc(java.lang.String, boolean, int, double[], double[], double[])">dsortc</A></B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6,
+ double[] arg8)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dsortr(java.lang.String, boolean, int, double[], double[])">dsortr</A></B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dstatn()">dstatn</A></B>()</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dstats()">dstats</A></B>()</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dstqrb(int, double[], double[], double[], double[], org.netlib.util.intW)">dstqrb</A></B>(int arg1,
+ double[] arg2,
+ double[] arg4,
+ double[] arg6,
+ double[] arg8,
+ org.netlib.util.intW arg10)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#dvout(int, int, double[], int, java.lang.String)">dvout</A></B>(int arg1,
+ int arg2,
+ double[] arg3,
+ int arg5,
+ java.lang.String arg6)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#getInstance()">getInstance</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#icnteq(int, int[], int)">icnteq</A></B>(int arg1,
+ int[] arg2,
+ int arg4)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#icopy(int, int[], int, int[], int)">icopy</A></B>(int arg1,
+ int[] arg2,
+ int arg4,
+ int[] arg5,
+ int arg7)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#iset(int, int, int[], int)">iset</A></B>(int arg1,
+ int arg2,
+ int[] arg3,
+ int arg5)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#iswap(int, int[], int, int[], int)">iswap</A></B>(int arg1,
+ int[] arg2,
+ int arg4,
+ int[] arg5,
+ int arg7)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ivout(int, int, int[], int, java.lang.String)">ivout</A></B>(int arg1,
+ int arg2,
+ int[] arg3,
+ int arg5,
+ java.lang.String arg6)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#second(org.netlib.util.floatW)">second</A></B>(org.netlib.util.floatW arg1)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sgetv0(org.netlib.util.intW, java.lang.String, int, boolean, int, int, float[], int, float[], org.netlib.util.floatW, int[], float[], org.netlib.util.intW)">sgetv0</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ boolean arg4,
+ int arg5,
+ int arg6,
+ float[] arg7,
+ int arg9,
+ float[] arg10,
+ org.netlib.util.floatW arg12,
+ int[] arg13,
+ float[] arg15,
+ org.netlib.util.intW arg17)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#slaqrb(boolean, int, int, int, float[], int, float[], float[], float[], org.netlib.util.intW)">slaqrb</A></B>(boolean arg1,
+ int arg2,
+ int arg3,
+ int arg4,
+ float[] arg5,
+ int arg7,
+ float[] arg8,
+ float[] arg10,
+ float[] arg12,
+ org.netlib.util.intW arg14)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#smout(int, int, int, float[], int, int, java.lang.String)">smout</A></B>(int arg1,
+ int arg2,
+ int arg3,
+ float[] arg4,
+ int arg6,
+ int arg7,
+ java.lang.String arg8)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#snaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, float[], org.netlib.util.floatW, float[], int, float[], int, int[], float[], org.netlib.util.intW)">snaitr</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ float[] arg7,
+ org.netlib.util.floatW arg9,
+ float[] arg10,
+ int arg12,
+ float[] arg13,
+ int arg15,
+ int[] arg16,
+ float[] arg18,
+ org.netlib.util.intW arg20)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#snapps(int, org.netlib.util.intW, int, float[], float[], float[], int, float[], int, float[], float[], int, float[], float[])">snapps</A></B>(int arg1,
+ org.netlib.util.intW arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6,
+ float[] arg8,
+ int arg10,
+ float[] arg11,
+ int arg13,
+ float[] arg14,
+ float[] arg16,
+ int arg18,
+ float[] arg19,
+ float[] arg21)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#snaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float, float[], int, int, int, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], float[], int, float[], int[], float[], org.netlib.util.intW)">snaup2</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ float arg7,
+ float[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ float[] arg14,
+ int arg16,
+ float[] arg17,
+ int arg19,
+ float[] arg20,
+ float[] arg22,
+ float[] arg24,
+ float[] arg26,
+ int arg28,
+ float[] arg29,
+ int[] arg31,
+ float[] arg33,
+ org.netlib.util.intW arg35)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#snaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)">snaupd</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.floatW arg6,
+ float[] arg7,
+ int arg9,
+ float[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ float[] arg17,
+ float[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#snconv(int, float[], float[], float[], float, org.netlib.util.intW)">snconv</A></B>(int arg1,
+ float[] arg2,
+ float[] arg4,
+ float[] arg6,
+ float arg8,
+ org.netlib.util.intW arg9)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sneigh(float, org.netlib.util.intW, float[], int, float[], float[], float[], float[], int, float[], org.netlib.util.intW)">sneigh</A></B>(float arg1,
+ org.netlib.util.intW arg2,
+ float[] arg3,
+ int arg5,
+ float[] arg6,
+ float[] arg8,
+ float[] arg10,
+ float[] arg12,
+ int arg14,
+ float[] arg15,
+ org.netlib.util.intW arg17)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sneupd(boolean, java.lang.String, boolean[], float[], float[], float[], int, float, float, float[], java.lang.String, int, java.lang.String, org.netlib.util.intW, float, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)">sneupd</A></B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ float[] arg5,
+ float[] arg7,
+ float[] arg9,
+ int arg11,
+ float arg12,
+ float arg13,
+ float[] arg14,
+ java.lang.String arg16,
+ int arg17,
+ java.lang.String arg18,
+ org.netlib.util.intW arg19,
+ float arg20,
+ float[] arg21,
+ int arg23,
+ float[] arg24,
+ int arg26,
+ int[] arg27,
+ int[] arg29,
+ float[] arg31,
+ float[] arg33,
+ int arg35,
+ org.netlib.util.intW arg36)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sngets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], float[], float[])">sngets</A></B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ float[] arg5,
+ float[] arg7,
+ float[] arg9,
+ float[] arg11,
+ float[] arg13)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, float[], org.netlib.util.floatW, float[], int, float[], int, int[], float[], org.netlib.util.intW)">ssaitr</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ float[] arg7,
+ org.netlib.util.floatW arg9,
+ float[] arg10,
+ int arg12,
+ float[] arg13,
+ int arg15,
+ int[] arg16,
+ float[] arg18,
+ org.netlib.util.intW arg20)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssapps(int, int, int, float[], float[], int, float[], int, float[], float[], int, float[])">ssapps</A></B>(int arg1,
+ int arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6,
+ int arg8,
+ float[] arg9,
+ int arg11,
+ float[] arg12,
+ float[] arg14,
+ int arg16,
+ float[] arg17)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float, float[], int, int, int, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], int, float[], int[], float[], org.netlib.util.intW)">ssaup2</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ float arg7,
+ float[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ float[] arg14,
+ int arg16,
+ float[] arg17,
+ int arg19,
+ float[] arg20,
+ float[] arg22,
+ float[] arg24,
+ int arg26,
+ float[] arg27,
+ int[] arg29,
+ float[] arg31,
+ org.netlib.util.intW arg33)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)">ssaupd</A></B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.floatW arg6,
+ float[] arg7,
+ int arg9,
+ float[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ float[] arg17,
+ float[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssconv(int, float[], float[], float, org.netlib.util.intW)">ssconv</A></B>(int arg1,
+ float[] arg2,
+ float[] arg4,
+ float arg6,
+ org.netlib.util.intW arg7)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sseigt(float, int, float[], int, float[], float[], float[], org.netlib.util.intW)">sseigt</A></B>(float arg1,
+ int arg2,
+ float[] arg3,
+ int arg5,
+ float[] arg6,
+ float[] arg8,
+ float[] arg10,
+ org.netlib.util.intW arg12)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssesrt(java.lang.String, boolean, int, float[], int, float[], int)">ssesrt</A></B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ float[] arg4,
+ int arg6,
+ float[] arg7,
+ int arg9)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sseupd(boolean, java.lang.String, boolean[], float[], float[], int, float, java.lang.String, int, java.lang.String, org.netlib.util.intW, float, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)">sseupd</A></B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ float[] arg5,
+ float[] arg7,
+ int arg9,
+ float arg10,
+ java.lang.String arg11,
+ int arg12,
+ java.lang.String arg13,
+ org.netlib.util.intW arg14,
+ float arg15,
+ float[] arg16,
+ int arg18,
+ float[] arg19,
+ int arg21,
+ int[] arg22,
+ int[] arg24,
+ float[] arg26,
+ float[] arg28,
+ int arg30,
+ org.netlib.util.intW arg31)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssgets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[])">ssgets</A></B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ float[] arg5,
+ float[] arg7,
+ float[] arg9)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssortc(java.lang.String, boolean, int, float[], float[], float[])">ssortc</A></B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6,
+ float[] arg8)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#ssortr(java.lang.String, boolean, int, float[], float[])">ssortr</A></B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sstatn()">sstatn</A></B>()</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sstats()">sstats</A></B>()</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#sstqrb(int, float[], float[], float[], float[], org.netlib.util.intW)">sstqrb</A></B>(int arg1,
+ float[] arg2,
+ float[] arg4,
+ float[] arg6,
+ float[] arg8,
+ org.netlib.util.intW arg10)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/arpack/ARPACK.html#svout(int, int, float[], int, java.lang.String)">svout</A></B>(int arg1,
+ int arg2,
+ float[] arg3,
+ int arg5,
+ java.lang.String arg6)</CODE>
+
+<BR>
+ No documentation was available when generating this method.</TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Object"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Object</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>clone, equals, finalize, getClass, hashCode, notify, notifyAll, toString, wait, wait, wait</CODE></TD>
+</TR>
+</TABLE>
+
+<P>
+
+<!-- ========= CONSTRUCTOR DETAIL ======== -->
+
+<A NAME="constructor_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Constructor Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="ARPACK()"><!-- --></A><H3>
+ARPACK</H3>
+<PRE>
+public <B>ARPACK</B>()</PRE>
+<DL>
+</DL>
+
+<!-- ============ METHOD DETAIL ========== -->
+
+<A NAME="method_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Method Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="getInstance()"><!-- --></A><H3>
+getInstance</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A> <B>getInstance</B>()</PRE>
+<DL>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dmout(int, int, int, double[], int, int, java.lang.String)"><!-- --></A><H3>
+dmout</H3>
+<PRE>
+public void <B>dmout</B>(int arg1,
+ int arg2,
+ int arg3,
+ double[] arg4,
+ int arg6,
+ int arg7,
+ java.lang.String arg8)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dvout(int, int, double[], int, java.lang.String)"><!-- --></A><H3>
+dvout</H3>
+<PRE>
+public void <B>dvout</B>(int arg1,
+ int arg2,
+ double[] arg3,
+ int arg5,
+ java.lang.String arg6)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="icnteq(int, int[], int)"><!-- --></A><H3>
+icnteq</H3>
+<PRE>
+public int <B>icnteq</B>(int arg1,
+ int[] arg2,
+ int arg4)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="icopy(int, int[], int, int[], int)"><!-- --></A><H3>
+icopy</H3>
+<PRE>
+public void <B>icopy</B>(int arg1,
+ int[] arg2,
+ int arg4,
+ int[] arg5,
+ int arg7)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="iset(int, int, int[], int)"><!-- --></A><H3>
+iset</H3>
+<PRE>
+public void <B>iset</B>(int arg1,
+ int arg2,
+ int[] arg3,
+ int arg5)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="iswap(int, int[], int, int[], int)"><!-- --></A><H3>
+iswap</H3>
+<PRE>
+public void <B>iswap</B>(int arg1,
+ int[] arg2,
+ int arg4,
+ int[] arg5,
+ int arg7)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ivout(int, int, int[], int, java.lang.String)"><!-- --></A><H3>
+ivout</H3>
+<PRE>
+public void <B>ivout</B>(int arg1,
+ int arg2,
+ int[] arg3,
+ int arg5,
+ java.lang.String arg6)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="second(org.netlib.util.floatW)"><!-- --></A><H3>
+second</H3>
+<PRE>
+public void <B>second</B>(org.netlib.util.floatW arg1)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="smout(int, int, int, float[], int, int, java.lang.String)"><!-- --></A><H3>
+smout</H3>
+<PRE>
+public void <B>smout</B>(int arg1,
+ int arg2,
+ int arg3,
+ float[] arg4,
+ int arg6,
+ int arg7,
+ java.lang.String arg8)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="svout(int, int, float[], int, java.lang.String)"><!-- --></A><H3>
+svout</H3>
+<PRE>
+public void <B>svout</B>(int arg1,
+ int arg2,
+ float[] arg3,
+ int arg5,
+ java.lang.String arg6)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgetv0(org.netlib.util.intW, java.lang.String, int, boolean, int, int, double[], int, double[], org.netlib.util.doubleW, int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgetv0</H3>
+<PRE>
+public void <B>dgetv0</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ boolean arg4,
+ int arg5,
+ int arg6,
+ double[] arg7,
+ int arg9,
+ double[] arg10,
+ org.netlib.util.doubleW arg12,
+ int[] arg13,
+ double[] arg15,
+ org.netlib.util.intW arg17)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqrb(boolean, int, int, int, double[], int, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaqrb</H3>
+<PRE>
+public void <B>dlaqrb</B>(boolean arg1,
+ int arg2,
+ int arg3,
+ int arg4,
+ double[] arg5,
+ int arg7,
+ double[] arg8,
+ double[] arg10,
+ double[] arg12,
+ org.netlib.util.intW arg14)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg14</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dnaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, double[], org.netlib.util.doubleW, double[], int, double[], int, int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dnaitr</H3>
+<PRE>
+public void <B>dnaitr</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ double[] arg7,
+ org.netlib.util.doubleW arg9,
+ double[] arg10,
+ int arg12,
+ double[] arg13,
+ int arg15,
+ int[] arg16,
+ double[] arg18,
+ org.netlib.util.intW arg20)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg20</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dnapps(int, org.netlib.util.intW, int, double[], double[], double[], int, double[], int, double[], double[], int, double[], double[])"><!-- --></A><H3>
+dnapps</H3>
+<PRE>
+public void <B>dnapps</B>(int arg1,
+ org.netlib.util.intW arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6,
+ double[] arg8,
+ int arg10,
+ double[] arg11,
+ int arg13,
+ double[] arg14,
+ double[] arg16,
+ int arg18,
+ double[] arg19,
+ double[] arg21)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dnaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double, double[], int, int, int, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], double[], int, double[], int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dnaup2</H3>
+<PRE>
+public void <B>dnaup2</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ double arg7,
+ double[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ double[] arg14,
+ int arg16,
+ double[] arg17,
+ int arg19,
+ double[] arg20,
+ double[] arg22,
+ double[] arg24,
+ double[] arg26,
+ int arg28,
+ double[] arg29,
+ int[] arg31,
+ double[] arg33,
+ org.netlib.util.intW arg35)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg20</CODE> - <DD><CODE>arg22</CODE> - <DD><CODE>arg24</CODE> - <DD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dnaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dnaupd</H3>
+<PRE>
+public abstract void <B>dnaupd</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.doubleW arg6,
+ double[] arg7,
+ int arg9,
+ double[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ double[] arg17,
+ double[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg22</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dnconv(int, double[], double[], double[], double, org.netlib.util.intW)"><!-- --></A><H3>
+dnconv</H3>
+<PRE>
+public void <B>dnconv</B>(int arg1,
+ double[] arg2,
+ double[] arg4,
+ double[] arg6,
+ double arg8,
+ org.netlib.util.intW arg9)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg9</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dneigh(double, org.netlib.util.intW, double[], int, double[], double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dneigh</H3>
+<PRE>
+public void <B>dneigh</B>(double arg1,
+ org.netlib.util.intW arg2,
+ double[] arg3,
+ int arg5,
+ double[] arg6,
+ double[] arg8,
+ double[] arg10,
+ double[] arg12,
+ int arg14,
+ double[] arg15,
+ org.netlib.util.intW arg17)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dneupd(boolean, java.lang.String, boolean[], double[], double[], double[], int, double, double, double[], java.lang.String, int, java.lang.String, org.netlib.util.intW, double, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dneupd</H3>
+<PRE>
+public abstract void <B>dneupd</B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ double[] arg5,
+ double[] arg7,
+ double[] arg9,
+ int arg11,
+ double arg12,
+ double arg13,
+ double[] arg14,
+ java.lang.String arg16,
+ int arg17,
+ java.lang.String arg18,
+ org.netlib.util.intW arg19,
+ double arg20,
+ double[] arg21,
+ int arg23,
+ double[] arg24,
+ int arg26,
+ int[] arg27,
+ int[] arg29,
+ double[] arg31,
+ double[] arg33,
+ int arg35,
+ org.netlib.util.intW arg36)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg20</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg23</CODE> - <DD><CODE>arg24</CODE> - <DD><CODE>arg26</CODE> - < [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dngets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], double[], double[])"><!-- --></A><H3>
+dngets</H3>
+<PRE>
+public void <B>dngets</B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ double[] arg5,
+ double[] arg7,
+ double[] arg9,
+ double[] arg11,
+ double[] arg13)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg13</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, double[], org.netlib.util.doubleW, double[], int, double[], int, int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsaitr</H3>
+<PRE>
+public void <B>dsaitr</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ double[] arg7,
+ org.netlib.util.doubleW arg9,
+ double[] arg10,
+ int arg12,
+ double[] arg13,
+ int arg15,
+ int[] arg16,
+ double[] arg18,
+ org.netlib.util.intW arg20)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg20</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsapps(int, int, int, double[], double[], int, double[], int, double[], double[], int, double[])"><!-- --></A><H3>
+dsapps</H3>
+<PRE>
+public void <B>dsapps</B>(int arg1,
+ int arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6,
+ int arg8,
+ double[] arg9,
+ int arg11,
+ double[] arg12,
+ double[] arg14,
+ int arg16,
+ double[] arg17)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double, double[], int, int, int, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], int, double[], int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsaup2</H3>
+<PRE>
+public void <B>dsaup2</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ double arg7,
+ double[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ double[] arg14,
+ int arg16,
+ double[] arg17,
+ int arg19,
+ double[] arg20,
+ double[] arg22,
+ double[] arg24,
+ int arg26,
+ double[] arg27,
+ int[] arg29,
+ double[] arg31,
+ org.netlib.util.intW arg33)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg20</CODE> - <DD><CODE>arg22</CODE> - <DD><CODE>arg24</CODE> - <DD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsaupd</H3>
+<PRE>
+public abstract void <B>dsaupd</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.doubleW arg6,
+ double[] arg7,
+ int arg9,
+ double[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ double[] arg17,
+ double[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg22</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsconv(int, double[], double[], double, org.netlib.util.intW)"><!-- --></A><H3>
+dsconv</H3>
+<PRE>
+public void <B>dsconv</B>(int arg1,
+ double[] arg2,
+ double[] arg4,
+ double arg6,
+ org.netlib.util.intW arg7)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dseigt(double, int, double[], int, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dseigt</H3>
+<PRE>
+public void <B>dseigt</B>(double arg1,
+ int arg2,
+ double[] arg3,
+ int arg5,
+ double[] arg6,
+ double[] arg8,
+ double[] arg10,
+ org.netlib.util.intW arg12)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsesrt(java.lang.String, boolean, int, double[], int, double[], int)"><!-- --></A><H3>
+dsesrt</H3>
+<PRE>
+public void <B>dsesrt</B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ double[] arg4,
+ int arg6,
+ double[] arg7,
+ int arg9)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dseupd(boolean, java.lang.String, boolean[], double[], double[], int, double, java.lang.String, int, java.lang.String, org.netlib.util.intW, double, double[], int, double[], int, int[], int[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dseupd</H3>
+<PRE>
+public abstract void <B>dseupd</B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ double[] arg5,
+ double[] arg7,
+ int arg9,
+ double arg10,
+ java.lang.String arg11,
+ int arg12,
+ java.lang.String arg13,
+ org.netlib.util.intW arg14,
+ double arg15,
+ double[] arg16,
+ int arg18,
+ double[] arg19,
+ int arg21,
+ int[] arg22,
+ int[] arg24,
+ double[] arg26,
+ double[] arg28,
+ int arg30,
+ org.netlib.util.intW arg31)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg22</CODE> - <DD><CODE>arg24</CODE> - <DD><CODE>arg26</CODE> - < [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsgets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[])"><!-- --></A><H3>
+dsgets</H3>
+<PRE>
+public void <B>dsgets</B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ double[] arg5,
+ double[] arg7,
+ double[] arg9)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsortc(java.lang.String, boolean, int, double[], double[], double[])"><!-- --></A><H3>
+dsortc</H3>
+<PRE>
+public void <B>dsortc</B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6,
+ double[] arg8)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsortr(java.lang.String, boolean, int, double[], double[])"><!-- --></A><H3>
+dsortr</H3>
+<PRE>
+public void <B>dsortr</B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ double[] arg4,
+ double[] arg6)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstatn()"><!-- --></A><H3>
+dstatn</H3>
+<PRE>
+public void <B>dstatn</B>()</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstats()"><!-- --></A><H3>
+dstats</H3>
+<PRE>
+public void <B>dstats</B>()</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstqrb(int, double[], double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dstqrb</H3>
+<PRE>
+public void <B>dstqrb</B>(int arg1,
+ double[] arg2,
+ double[] arg4,
+ double[] arg6,
+ double[] arg8,
+ org.netlib.util.intW arg10)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgetv0(org.netlib.util.intW, java.lang.String, int, boolean, int, int, float[], int, float[], org.netlib.util.floatW, int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgetv0</H3>
+<PRE>
+public void <B>sgetv0</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ boolean arg4,
+ int arg5,
+ int arg6,
+ float[] arg7,
+ int arg9,
+ float[] arg10,
+ org.netlib.util.floatW arg12,
+ int[] arg13,
+ float[] arg15,
+ org.netlib.util.intW arg17)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqrb(boolean, int, int, int, float[], int, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slaqrb</H3>
+<PRE>
+public void <B>slaqrb</B>(boolean arg1,
+ int arg2,
+ int arg3,
+ int arg4,
+ float[] arg5,
+ int arg7,
+ float[] arg8,
+ float[] arg10,
+ float[] arg12,
+ org.netlib.util.intW arg14)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg14</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="snaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, float[], org.netlib.util.floatW, float[], int, float[], int, int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+snaitr</H3>
+<PRE>
+public void <B>snaitr</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ float[] arg7,
+ org.netlib.util.floatW arg9,
+ float[] arg10,
+ int arg12,
+ float[] arg13,
+ int arg15,
+ int[] arg16,
+ float[] arg18,
+ org.netlib.util.intW arg20)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg20</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="snapps(int, org.netlib.util.intW, int, float[], float[], float[], int, float[], int, float[], float[], int, float[], float[])"><!-- --></A><H3>
+snapps</H3>
+<PRE>
+public void <B>snapps</B>(int arg1,
+ org.netlib.util.intW arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6,
+ float[] arg8,
+ int arg10,
+ float[] arg11,
+ int arg13,
+ float[] arg14,
+ float[] arg16,
+ int arg18,
+ float[] arg19,
+ float[] arg21)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="snaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float, float[], int, int, int, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], float[], int, float[], int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+snaup2</H3>
+<PRE>
+public void <B>snaup2</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ float arg7,
+ float[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ float[] arg14,
+ int arg16,
+ float[] arg17,
+ int arg19,
+ float[] arg20,
+ float[] arg22,
+ float[] arg24,
+ float[] arg26,
+ int arg28,
+ float[] arg29,
+ int[] arg31,
+ float[] arg33,
+ org.netlib.util.intW arg35)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg20</CODE> - <DD><CODE>arg22</CODE> - <DD><CODE>arg24</CODE> - <DD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="snaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+snaupd</H3>
+<PRE>
+public abstract void <B>snaupd</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.floatW arg6,
+ float[] arg7,
+ int arg9,
+ float[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ float[] arg17,
+ float[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg22</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="snconv(int, float[], float[], float[], float, org.netlib.util.intW)"><!-- --></A><H3>
+snconv</H3>
+<PRE>
+public void <B>snconv</B>(int arg1,
+ float[] arg2,
+ float[] arg4,
+ float[] arg6,
+ float arg8,
+ org.netlib.util.intW arg9)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg9</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sneigh(float, org.netlib.util.intW, float[], int, float[], float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sneigh</H3>
+<PRE>
+public void <B>sneigh</B>(float arg1,
+ org.netlib.util.intW arg2,
+ float[] arg3,
+ int arg5,
+ float[] arg6,
+ float[] arg8,
+ float[] arg10,
+ float[] arg12,
+ int arg14,
+ float[] arg15,
+ org.netlib.util.intW arg17)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sneupd(boolean, java.lang.String, boolean[], float[], float[], float[], int, float, float, float[], java.lang.String, int, java.lang.String, org.netlib.util.intW, float, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sneupd</H3>
+<PRE>
+public abstract void <B>sneupd</B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ float[] arg5,
+ float[] arg7,
+ float[] arg9,
+ int arg11,
+ float arg12,
+ float arg13,
+ float[] arg14,
+ java.lang.String arg16,
+ int arg17,
+ java.lang.String arg18,
+ org.netlib.util.intW arg19,
+ float arg20,
+ float[] arg21,
+ int arg23,
+ float[] arg24,
+ int arg26,
+ int[] arg27,
+ int[] arg29,
+ float[] arg31,
+ float[] arg33,
+ int arg35,
+ org.netlib.util.intW arg36)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg20</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg23</CODE> - <DD><CODE>arg24</CODE> - <DD><CODE>arg26</CODE> - < [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sngets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], float[], float[])"><!-- --></A><H3>
+sngets</H3>
+<PRE>
+public void <B>sngets</B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ float[] arg5,
+ float[] arg7,
+ float[] arg9,
+ float[] arg11,
+ float[] arg13)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg13</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssaitr(org.netlib.util.intW, java.lang.String, int, int, int, int, float[], org.netlib.util.floatW, float[], int, float[], int, int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssaitr</H3>
+<PRE>
+public void <B>ssaitr</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ int arg4,
+ int arg5,
+ int arg6,
+ float[] arg7,
+ org.netlib.util.floatW arg9,
+ float[] arg10,
+ int arg12,
+ float[] arg13,
+ int arg15,
+ int[] arg16,
+ float[] arg18,
+ org.netlib.util.intW arg20)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg20</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssapps(int, int, int, float[], float[], int, float[], int, float[], float[], int, float[])"><!-- --></A><H3>
+ssapps</H3>
+<PRE>
+public void <B>ssapps</B>(int arg1,
+ int arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6,
+ int arg8,
+ float[] arg9,
+ int arg11,
+ float[] arg12,
+ float[] arg14,
+ int arg16,
+ float[] arg17)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssaup2(org.netlib.util.intW, java.lang.String, int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float, float[], int, int, int, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], int, float[], int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssaup2</H3>
+<PRE>
+public void <B>ssaup2</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ org.netlib.util.intW arg5,
+ org.netlib.util.intW arg6,
+ float arg7,
+ float[] arg8,
+ int arg10,
+ int arg11,
+ int arg12,
+ org.netlib.util.intW arg13,
+ float[] arg14,
+ int arg16,
+ float[] arg17,
+ int arg19,
+ float[] arg20,
+ float[] arg22,
+ float[] arg24,
+ int arg26,
+ float[] arg27,
+ int[] arg29,
+ float[] arg31,
+ org.netlib.util.intW arg33)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg20</CODE> - <DD><CODE>arg22</CODE> - <DD><CODE>arg24</CODE> - <DD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssaupd(org.netlib.util.intW, java.lang.String, int, java.lang.String, int, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssaupd</H3>
+<PRE>
+public abstract void <B>ssaupd</B>(org.netlib.util.intW arg1,
+ java.lang.String arg2,
+ int arg3,
+ java.lang.String arg4,
+ int arg5,
+ org.netlib.util.floatW arg6,
+ float[] arg7,
+ int arg9,
+ float[] arg10,
+ int arg12,
+ int[] arg13,
+ int[] arg15,
+ float[] arg17,
+ float[] arg19,
+ int arg21,
+ org.netlib.util.intW arg22)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg17</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg22</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssconv(int, float[], float[], float, org.netlib.util.intW)"><!-- --></A><H3>
+ssconv</H3>
+<PRE>
+public void <B>ssconv</B>(int arg1,
+ float[] arg2,
+ float[] arg4,
+ float arg6,
+ org.netlib.util.intW arg7)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sseigt(float, int, float[], int, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sseigt</H3>
+<PRE>
+public void <B>sseigt</B>(float arg1,
+ int arg2,
+ float[] arg3,
+ int arg5,
+ float[] arg6,
+ float[] arg8,
+ float[] arg10,
+ org.netlib.util.intW arg12)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg12</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssesrt(java.lang.String, boolean, int, float[], int, float[], int)"><!-- --></A><H3>
+ssesrt</H3>
+<PRE>
+public void <B>ssesrt</B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ float[] arg4,
+ int arg6,
+ float[] arg7,
+ int arg9)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sseupd(boolean, java.lang.String, boolean[], float[], float[], int, float, java.lang.String, int, java.lang.String, org.netlib.util.intW, float, float[], int, float[], int, int[], int[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sseupd</H3>
+<PRE>
+public abstract void <B>sseupd</B>(boolean arg1,
+ java.lang.String arg2,
+ boolean[] arg3,
+ float[] arg5,
+ float[] arg7,
+ int arg9,
+ float arg10,
+ java.lang.String arg11,
+ int arg12,
+ java.lang.String arg13,
+ org.netlib.util.intW arg14,
+ float arg15,
+ float[] arg16,
+ int arg18,
+ float[] arg19,
+ int arg21,
+ int[] arg22,
+ int[] arg24,
+ float[] arg26,
+ float[] arg28,
+ int arg30,
+ org.netlib.util.intW arg31)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - <DD><CODE>arg10</CODE> - <DD><CODE>arg11</CODE> - <DD><CODE>arg12</CODE> - <DD><CODE>arg13</CODE> - <DD><CODE>arg14</CODE> - <DD><CODE>arg15</CODE> - <DD><CODE>arg16</CODE> - <DD><CODE>arg18</CODE> - <DD><CODE>arg19</CODE> - <DD><CODE>arg21</CODE> - <DD><CODE>arg22</CODE> - <DD><CODE>arg24</CODE> - <DD><CODE>arg26</CODE> - < [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssgets(int, java.lang.String, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[])"><!-- --></A><H3>
+ssgets</H3>
+<PRE>
+public void <B>ssgets</B>(int arg1,
+ java.lang.String arg2,
+ org.netlib.util.intW arg3,
+ org.netlib.util.intW arg4,
+ float[] arg5,
+ float[] arg7,
+ float[] arg9)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg5</CODE> - <DD><CODE>arg7</CODE> - <DD><CODE>arg9</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssortc(java.lang.String, boolean, int, float[], float[], float[])"><!-- --></A><H3>
+ssortc</H3>
+<PRE>
+public void <B>ssortc</B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6,
+ float[] arg8)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssortr(java.lang.String, boolean, int, float[], float[])"><!-- --></A><H3>
+ssortr</H3>
+<PRE>
+public void <B>ssortr</B>(java.lang.String arg1,
+ boolean arg2,
+ int arg3,
+ float[] arg4,
+ float[] arg6)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg3</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstatn()"><!-- --></A><H3>
+sstatn</H3>
+<PRE>
+public void <B>sstatn</B>()</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstats()"><!-- --></A><H3>
+sstats</H3>
+<PRE>
+public void <B>sstats</B>()</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstqrb(int, float[], float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sstqrb</H3>
+<PRE>
+public void <B>sstqrb</B>(int arg1,
+ float[] arg2,
+ float[] arg4,
+ float[] arg6,
+ float[] arg8,
+ org.netlib.util.intW arg10)</PRE>
+<DL>
+<DD>No documentation was available when generating this method.
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>arg1</CODE> - <DD><CODE>arg2</CODE> - <DD><CODE>arg4</CODE> - <DD><CODE>arg6</CODE> - <DD><CODE>arg8</CODE> - <DD><CODE>arg10</CODE> - </DL>
+</DD>
+</DL>
+<!-- ========= END OF CLASS DATA ========= -->
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/ARPACK.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/ARPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="ARPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | FIELD | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: FIELD | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/arpack/class-use/ARPACK.html b/javadoc/org/netlib/arpack/class-use/ARPACK.html
new file mode 100644
index 0000000..fc565e0
--- /dev/null
+++ b/javadoc/org/netlib/arpack/class-use/ARPACK.html
@@ -0,0 +1,181 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Class org.netlib.arpack.ARPACK
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Class org.netlib.arpack.ARPACK";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/arpack//class-useARPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="ARPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Class<br>org.netlib.arpack.ARPACK</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.arpack"><B>org.netlib.arpack</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.arpack"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Uses of <A HREF="../../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A> in <A HREF="../../../../org/netlib/arpack/package-summary.html">org.netlib.arpack</A></FONT></TH>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Methods in <A HREF="../../../../org/netlib/arpack/package-summary.html">org.netlib.arpack</A> that return <A HREF="../../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A></CODE></FONT></TD>
+<TD><CODE><B>ARPACK.</B><B><A HREF="../../../../org/netlib/arpack/ARPACK.html#getInstance()">getInstance</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/arpack//class-useARPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="ARPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/arpack/package-frame.html b/javadoc/org/netlib/arpack/package-frame.html
new file mode 100644
index 0000000..a33907d
--- /dev/null
+++ b/javadoc/org/netlib/arpack/package-frame.html
@@ -0,0 +1,33 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.arpack
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+<FONT size="+1" CLASS="FrameTitleFont">
+<A HREF="../../../org/netlib/arpack/package-summary.html" target="classFrame">org.netlib.arpack</A></FONT>
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT size="+1" CLASS="FrameHeadingFont">
+Classes</FONT>
+<FONT CLASS="FrameItemFont">
+<BR>
+<A HREF="ARPACK.html" title="class in org.netlib.arpack" target="classFrame">ARPACK</A></FONT></TD>
+</TR>
+</TABLE>
+
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/arpack/package-summary.html b/javadoc/org/netlib/arpack/package-summary.html
new file mode 100644
index 0000000..45149f9
--- /dev/null
+++ b/javadoc/org/netlib/arpack/package-summary.html
@@ -0,0 +1,159 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.arpack
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.arpack";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV PACKAGE
+ <A HREF="../../../org/netlib/blas/package-summary.html"><B>NEXT PACKAGE</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<H2>
+Package org.netlib.arpack
+</H2>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Class Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="15%"><B><A HREF="../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack">ARPACK</A></B></TD>
+<TD>ARPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.</TD>
+</TR>
+</TABLE>
+
+
+<P>
+<DL>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV PACKAGE
+ <A HREF="../../../org/netlib/blas/package-summary.html"><B>NEXT PACKAGE</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/arpack/package-tree.html b/javadoc/org/netlib/arpack/package-tree.html
new file mode 100644
index 0000000..5380a01
--- /dev/null
+++ b/javadoc/org/netlib/arpack/package-tree.html
@@ -0,0 +1,154 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.arpack Class Hierarchy
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.arpack Class Hierarchy";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ <A HREF="../../../org/netlib/blas/package-tree.html"><B>NEXT</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+Hierarchy For Package org.netlib.arpack
+</H2>
+</CENTER>
+<DL>
+<DT><B>Package Hierarchies:</B><DD><A HREF="../../../overview-tree.html">All Packages</A></DL>
+<HR>
+<H2>
+Class Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">org.netlib.arpack.<A HREF="../../../org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack"><B>ARPACK</B></A></UL>
+</UL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ <A HREF="../../../org/netlib/blas/package-tree.html"><B>NEXT</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/arpack/package-use.html b/javadoc/org/netlib/arpack/package-use.html
new file mode 100644
index 0000000..c73af9d
--- /dev/null
+++ b/javadoc/org/netlib/arpack/package-use.html
@@ -0,0 +1,172 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Package org.netlib.arpack
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Package org.netlib.arpack";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Package<br>org.netlib.arpack</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../org/netlib/arpack/package-summary.html">org.netlib.arpack</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.arpack"><B>org.netlib.arpack</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.arpack"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Classes in <A HREF="../../../org/netlib/arpack/package-summary.html">org.netlib.arpack</A> used by <A HREF="../../../org/netlib/arpack/package-summary.html">org.netlib.arpack</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><B><A HREF="../../../org/netlib/arpack/class-use/ARPACK.html#org.netlib.arpack"><B>ARPACK</B></A></B>
+
+<BR>
+ ARPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.</TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/arpack/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/blas/BLAS.html b/javadoc/org/netlib/blas/BLAS.html
new file mode 100644
index 0000000..4999f0e
--- /dev/null
+++ b/javadoc/org/netlib/blas/BLAS.html
@@ -0,0 +1,8198 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:17 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+BLAS
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="BLAS";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/BLAS.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/BLAS.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="BLAS.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | FIELD | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: FIELD | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<!-- ======== START OF CLASS DATA ======== -->
+<H2>
+<FONT SIZE="-1">
+org.netlib.blas</FONT>
+<BR>
+Class BLAS</H2>
+<PRE>
+java.lang.Object
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by "><B>org.netlib.blas.BLAS</B>
+</PRE>
+<HR>
+<DL>
+<DT><PRE>public abstract class <B>BLAS</B><DT>extends java.lang.Object</DL>
+</PRE>
+
+<P>
+BLAS provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.
+<P>
+
+<P>
+<DL>
+<DT><B>See Also:</B><DD><CODE>http://sourceforge.net/projects/f2j</CODE>,
+<CODE>http://www.netlib.org/blas/</CODE></DL>
+<HR>
+
+<P>
+
+<!-- ======== CONSTRUCTOR SUMMARY ======== -->
+
+<A NAME="constructor_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Constructor Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#BLAS()">BLAS</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<!-- ========== METHOD SUMMARY =========== -->
+
+<A NAME="method_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Method Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dasum(int, double[], int)">dasum</A></B>(int n,
+ double[] dx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#daxpy(int, double, double[], int, double[], int)">daxpy</A></B>(int n,
+ double da,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dcopy(int, double[], int, double[], int)">dcopy</A></B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ddot(int, double[], int, double[], int)">ddot</A></B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dgbmv(java.lang.String, int, int, int, int, double, double[], int, double[], int, double, double[], int)">dgbmv</A></B>(java.lang.String trans,
+ int m,
+ int n,
+ int kl,
+ int ku,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dgemm(java.lang.String, java.lang.String, int, int, int, double, double[], int, double[], int, double, double[], int)">dgemm</A></B>(java.lang.String transa,
+ java.lang.String transb,
+ int m,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double beta,
+ double[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dgemv(java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)">dgemv</A></B>(java.lang.String trans,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dger(int, int, double, double[], int, double[], int, double[], int)">dger</A></B>(int m,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dnrm2(int, double[], int)">dnrm2</A></B>(int n,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#drot(int, double[], int, double[], int, double, double)">drot</A></B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy,
+ double c,
+ double s)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#drotg(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">drotg</A></B>(org.netlib.util.doubleW da,
+ org.netlib.util.doubleW db,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW s)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#drotm(int, double[], int, double[], int, double[])">drotm</A></B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy,
+ double[] dparam)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#drotmg(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, double, double[])">drotmg</A></B>(org.netlib.util.doubleW dd1,
+ org.netlib.util.doubleW dd2,
+ org.netlib.util.doubleW dx1,
+ double dy1,
+ double[] dparam)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsbmv(java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)">dsbmv</A></B>(java.lang.String uplo,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dscal(int, double, double[], int)">dscal</A></B>(int n,
+ double da,
+ double[] dx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dspmv(java.lang.String, int, double, double[], double[], int, double, double[], int)">dspmv</A></B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] ap,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dspr(java.lang.String, int, double, double[], int, double[])">dspr</A></B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] ap)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dspr2(java.lang.String, int, double, double[], int, double[], int, double[])">dspr2</A></B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] ap)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dswap(int, double[], int, double[], int)">dswap</A></B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsymm(java.lang.String, java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)">dsymm</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double beta,
+ double[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsymv(java.lang.String, int, double, double[], int, double[], int, double, double[], int)">dsymv</A></B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsyr(java.lang.String, int, double, double[], int, double[], int)">dsyr</A></B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsyr2(java.lang.String, int, double, double[], int, double[], int, double[], int)">dsyr2</A></B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsyr2k(java.lang.String, java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)">dsyr2k</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double beta,
+ double[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dsyrk(java.lang.String, java.lang.String, int, int, double, double[], int, double, double[], int)">dsyrk</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double beta,
+ double[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtbmv(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int)">dtbmv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtbsv(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int)">dtbsv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtpmv(java.lang.String, java.lang.String, java.lang.String, int, double[], double[], int)">dtpmv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtpsv(java.lang.String, java.lang.String, java.lang.String, int, double[], double[], int)">dtpsv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtrmm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double, double[], int, double[], int)">dtrmm</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtrmv(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int)">dtrmv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtrsm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double, double[], int, double[], int)">dtrsm</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#dtrsv(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int)">dtrsv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#getInstance()">getInstance</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#idamax(int, double[], int)">idamax</A></B>(int n,
+ double[] dx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#isamax(int, float[], int)">isamax</A></B>(int n,
+ float[] sx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#lsame(java.lang.String, java.lang.String)">lsame</A></B>(java.lang.String ca,
+ java.lang.String cb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sasum(int, float[], int)">sasum</A></B>(int n,
+ float[] sx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#saxpy(int, float, float[], int, float[], int)">saxpy</A></B>(int n,
+ float sa,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#scopy(int, float[], int, float[], int)">scopy</A></B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sdot(int, float[], int, float[], int)">sdot</A></B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sdsdot(int, float, float[], int, float[], int)">sdsdot</A></B>(int n,
+ float sb,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sgbmv(java.lang.String, int, int, int, int, float, float[], int, float[], int, float, float[], int)">sgbmv</A></B>(java.lang.String trans,
+ int m,
+ int n,
+ int kl,
+ int ku,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sgemm(java.lang.String, java.lang.String, int, int, int, float, float[], int, float[], int, float, float[], int)">sgemm</A></B>(java.lang.String transa,
+ java.lang.String transb,
+ int m,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float beta,
+ float[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sgemv(java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)">sgemv</A></B>(java.lang.String trans,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sger(int, int, float, float[], int, float[], int, float[], int)">sger</A></B>(int m,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#snrm2(int, float[], int)">snrm2</A></B>(int n,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#srot(int, float[], int, float[], int, float, float)">srot</A></B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy,
+ float c,
+ float s)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#srotg(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">srotg</A></B>(org.netlib.util.floatW sa,
+ org.netlib.util.floatW sb,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW s)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#srotm(int, float[], int, float[], int, float[])">srotm</A></B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy,
+ float[] sparam)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#srotmg(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, float, float[])">srotmg</A></B>(org.netlib.util.floatW sd1,
+ org.netlib.util.floatW sd2,
+ org.netlib.util.floatW sx1,
+ float sy1,
+ float[] sparam)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssbmv(java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)">ssbmv</A></B>(java.lang.String uplo,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sscal(int, float, float[], int)">sscal</A></B>(int n,
+ float sa,
+ float[] sx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sspmv(java.lang.String, int, float, float[], float[], int, float, float[], int)">sspmv</A></B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] ap,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sspr(java.lang.String, int, float, float[], int, float[])">sspr</A></B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] ap)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sspr2(java.lang.String, int, float, float[], int, float[], int, float[])">sspr2</A></B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] ap)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#sswap(int, float[], int, float[], int)">sswap</A></B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssymm(java.lang.String, java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)">ssymm</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float beta,
+ float[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssymv(java.lang.String, int, float, float[], int, float[], int, float, float[], int)">ssymv</A></B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssyr(java.lang.String, int, float, float[], int, float[], int)">ssyr</A></B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssyr2(java.lang.String, int, float, float[], int, float[], int, float[], int)">ssyr2</A></B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssyr2k(java.lang.String, java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)">ssyr2k</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float beta,
+ float[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#ssyrk(java.lang.String, java.lang.String, int, int, float, float[], int, float, float[], int)">ssyrk</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float beta,
+ float[] c,
+ int Ldc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#stbmv(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int)">stbmv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#stbsv(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int)">stbsv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#stpmv(java.lang.String, java.lang.String, java.lang.String, int, float[], float[], int)">stpmv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#stpsv(java.lang.String, java.lang.String, java.lang.String, int, float[], float[], int)">stpsv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#strmm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float, float[], int, float[], int)">strmm</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#strmv(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int)">strmv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#strsm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float, float[], int, float[], int)">strsm</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/blas/BLAS.html#strsv(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int)">strsv</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Object"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Object</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>clone, equals, finalize, getClass, hashCode, notify, notifyAll, toString, wait, wait, wait</CODE></TD>
+</TR>
+</TABLE>
+
+<P>
+
+<!-- ========= CONSTRUCTOR DETAIL ======== -->
+
+<A NAME="constructor_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Constructor Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="BLAS()"><!-- --></A><H3>
+BLAS</H3>
+<PRE>
+public <B>BLAS</B>()</PRE>
+<DL>
+</DL>
+
+<!-- ============ METHOD DETAIL ========== -->
+
+<A NAME="method_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Method Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="getInstance()"><!-- --></A><H3>
+getInstance</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A> <B>getInstance</B>()</PRE>
+<DL>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dasum(int, double[], int)"><!-- --></A><H3>
+dasum</H3>
+<PRE>
+public abstract double <B>dasum</B>(int n,
+ double[] dx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ takes the sum of the absolute values.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="daxpy(int, double, double[], int, double[], int)"><!-- --></A><H3>
+daxpy</H3>
+<PRE>
+public abstract void <B>daxpy</B>(int n,
+ double da,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ constant times a vector plus a vector.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>da</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>dy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dcopy(int, double[], int, double[], int)"><!-- --></A><H3>
+dcopy</H3>
+<PRE>
+public abstract void <B>dcopy</B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ copies a vector, x, to a vector, y.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>dy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ddot(int, double[], int, double[], int)"><!-- --></A><H3>
+ddot</H3>
+<PRE>
+public abstract double <B>ddot</B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ forms the dot product of two vectors.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>dy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbmv(java.lang.String, int, int, int, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dgbmv</H3>
+<PRE>
+public abstract void <B>dgbmv</B>(java.lang.String trans,
+ int m,
+ int n,
+ int kl,
+ int ku,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ KL - INTEGER.
+ On entry, KL specifies the number of sub-diagonals of the
+ matrix A. KL must satisfy 0 .le. KL.
+ Unchanged on exit.
+
+ KU - INTEGER.
+ On entry, KU specifies the number of super-diagonals of the
+
+ matrix A. KU must satisfy 0 .le. KU.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading ( kl + ku + 1 ) by n part of the
+ array A must contain the matrix of coefficients, supplied
+ column by column, with the leading diagonal of the matrix in
+ row ( ku + 1 ) of the array, the first super-diagonal
+ starting at position 2 in row ku, the first sub-diagonal
+ starting at position 1 in row ( ku + 2 ), and so on.
+ Elements in the array A that do not correspond to elements
+ in the band matrix (such as the top left ku by ku triangle)
+
+ are not referenced.
+ The following program segment will transfer a band matrix
+ from conventional full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ K = KU + 1 - J
+ DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+ A( K + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( kl + ku + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgemm(java.lang.String, java.lang.String, int, int, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dgemm</H3>
+<PRE>
+public abstract void <B>dgemm</B>(java.lang.String transa,
+ java.lang.String transb,
+ int m,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double beta,
+ double[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEMM performs one of the matrix-matrix operations
+
+ C := alpha*op( A )*op( B ) + beta*C,
+
+ where op( X ) is one of
+
+ op( X ) = X or op( X ) = X',
+
+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n', op( A ) = A.
+
+ TRANSA = 'T' or 't', op( A ) = A'.
+
+ TRANSA = 'C' or 'c', op( A ) = A'.
+
+ Unchanged on exit.
+
+ TRANSB - CHARACTER*1.
+ On entry, TRANSB specifies the form of op( B ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSB = 'N' or 'n', op( B ) = B.
+
+ TRANSB = 'T' or 't', op( B ) = B'.
+
+ TRANSB = 'C' or 'c', op( B ) = B'.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix
+ op( A ) and of the matrix C. M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix
+ op( B ) and the number of columns of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of columns of the matrix
+ op( A ) and the number of rows of the matrix op( B ). K must
+ be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANSA = 'N' or 'n', and is m otherwise.
+ Before entry with TRANSA = 'N' or 'n', the leading m by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by m part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, k ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+ n when TRANSB = 'N' or 'n', and is k otherwise.
+ Before entry with TRANSB = 'N' or 'n', the leading k by n
+ part of the array B must contain the matrix B, otherwise
+ the leading n by k part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
+ LDB must be at least max( 1, k ), otherwise LDB must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n matrix
+ ( alpha*op( A )*op( B ) + beta*C ).
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>transa</CODE> - <DD><CODE>transb</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgemv(java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dgemv</H3>
+<PRE>
+public abstract void <B>dgemv</B>(java.lang.String trans,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dger(int, int, double, double[], int, double[], int, double[], int)"><!-- --></A><H3>
+dger</H3>
+<PRE>
+public abstract void <B>dger</B>(int m,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+
+ vector and A is an m by n matrix.
+
+ Arguments
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dnrm2(int, double[], int)"><!-- --></A><H3>
+dnrm2</H3>
+<PRE>
+public abstract double <B>dnrm2</B>(int n,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DNRM2 returns the euclidean norm of a vector via the function
+ name, so that
+
+ DNRM2 := sqrt( x'*x )
+
+
+ -- This version written on 25-October-1982.
+ Modified on 14-October-1993 to inline the call to DLASSQ.
+ Sven Hammarling, Nag Ltd.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="drot(int, double[], int, double[], int, double, double)"><!-- --></A><H3>
+drot</H3>
+<PRE>
+public abstract void <B>drot</B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy,
+ double c,
+ double s)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ applies a plane rotation.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>dy</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="drotg(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+drotg</H3>
+<PRE>
+public abstract void <B>drotg</B>(org.netlib.util.doubleW da,
+ org.netlib.util.doubleW db,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW s)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ construct givens plane rotation.
+ jack dongarra, linpack, 3/11/78.
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>da</CODE> - <DD><CODE>db</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="drotm(int, double[], int, double[], int, double[])"><!-- --></A><H3>
+drotm</H3>
+<PRE>
+public abstract void <B>drotm</B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy,
+ double[] dparam)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+
+
+ (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
+ (DY**T)
+
+ DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+ LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
+ WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
+
+ (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
+ H=( ) ( ) ( ) ( )
+ (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
+ SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ number of elements in input vector(s)
+
+ DX (input/output) DOUBLE PRECISION array, dimension N
+ double precision vector with 5 elements
+
+ INCX (input) INTEGER
+ storage spacing between elements of DX
+
+ DY (input/output) DOUBLE PRECISION array, dimension N
+ double precision vector with N elements
+
+ INCY (input) INTEGER
+ storage spacing between elements of DY
+
+ DPARAM (input/output) DOUBLE PRECISION array, dimension 5
+ DPARAM(1)=DFLAG
+ DPARAM(2)=DH11
+ DPARAM(3)=DH21
+ DPARAM(4)=DH12
+ DPARAM(5)=DH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>dy</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>dparam</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="drotmg(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, double, double[])"><!-- --></A><H3>
+drotmg</H3>
+<PRE>
+public abstract void <B>drotmg</B>(org.netlib.util.doubleW dd1,
+ org.netlib.util.doubleW dd2,
+ org.netlib.util.doubleW dx1,
+ double dy1,
+ double[] dparam)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+
+ THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*
+
+ DY2)**T.
+ WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
+
+ (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
+ H=( ) ( ) ( ) ( )
+ (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
+ LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
+ RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
+ VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
+
+ THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+ INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+ OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+
+
+ Arguments
+ =========
+
+ DD1 (input/output) DOUBLE PRECISION
+
+ DD2 (input/output) DOUBLE PRECISION
+
+ DX1 (input/output) DOUBLE PRECISION
+
+ DY1 (input) DOUBLE PRECISION
+
+ DPARAM (input/output) DOUBLE PRECISION array, dimension 5
+ DPARAM(1)=DFLAG
+ DPARAM(2)=DH11
+ DPARAM(3)=DH21
+ DPARAM(4)=DH12
+ DPARAM(5)=DH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>dd1</CODE> - <DD><CODE>dd2</CODE> - <DD><CODE>dx1</CODE> - <DD><CODE>dy1</CODE> - <DD><CODE>dparam</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbmv(java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dsbmv</H3>
+<PRE>
+public abstract void <B>dsbmv</B>(java.lang.String uplo,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric band matrix, with k super-diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the band matrix A is being supplied as
+ follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ being supplied.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ being supplied.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of super-diagonals of the
+ matrix A. K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer the upper
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer the lower
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dscal(int, double, double[], int)"><!-- --></A><H3>
+dscal</H3>
+<PRE>
+public abstract void <B>dscal</B>(int n,
+ double da,
+ double[] dx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ scales a vector by a constant.
+ uses unrolled loops for increment equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>da</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspmv(java.lang.String, int, double, double[], double[], int, double, double[], int)"><!-- --></A><H3>
+dspmv</H3>
+<PRE>
+public abstract void <B>dspmv</B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] ap,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspr(java.lang.String, int, double, double[], int, double[])"><!-- --></A><H3>
+dspr</H3>
+<PRE>
+public abstract void <B>dspr</B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] ap)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>ap</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspr2(java.lang.String, int, double, double[], int, double[], int, double[])"><!-- --></A><H3>
+dspr2</H3>
+<PRE>
+public abstract void <B>dspr2</B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] ap)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>ap</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dswap(int, double[], int, double[], int)"><!-- --></A><H3>
+dswap</H3>
+<PRE>
+public abstract void <B>dswap</B>(int n,
+ double[] dx,
+ int incx,
+ double[] dy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ interchanges two vectors.
+ uses unrolled loops for increments equal one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>dy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsymm(java.lang.String, java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dsymm</H3>
+<PRE>
+public abstract void <B>dsymm</B>(java.lang.String side,
+ java.lang.String uplo,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double beta,
+ double[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYMM performs one of the matrix-matrix operations
+
+ C := alpha*A*B + beta*C,
+
+ or
+
+ C := alpha*B*A + beta*C,
+
+ where alpha and beta are scalars, A is a symmetric matrix and B and
+ C are m by n matrices.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether the symmetric matrix A
+ appears on the left or right in the operation as follows:
+
+ SIDE = 'L' or 'l' C := alpha*A*B + beta*C,
+
+ SIDE = 'R' or 'r' C := alpha*B*A + beta*C,
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the symmetric matrix A is to be
+ referenced as follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of the
+ symmetric matrix is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of the
+ symmetric matrix is to be referenced.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix C.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix C.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ m when SIDE = 'L' or 'l' and is n otherwise.
+ Before entry with SIDE = 'L' or 'l', the m by m part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading m by m upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading m by m lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Before entry with SIDE = 'R' or 'r', the n by n part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading n by n upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading n by n lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n updated
+ matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsymv(java.lang.String, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dsymv</H3>
+<PRE>
+public abstract void <B>dsymv</B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx,
+ double beta,
+ double[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyr(java.lang.String, int, double, double[], int, double[], int)"><!-- --></A><H3>
+dsyr</H3>
+<PRE>
+public abstract void <B>dsyr</B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyr2(java.lang.String, int, double, double[], int, double[], int, double[], int)"><!-- --></A><H3>
+dsyr2</H3>
+<PRE>
+public abstract void <B>dsyr2</B>(java.lang.String uplo,
+ int n,
+ double alpha,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an n
+
+ by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyr2k(java.lang.String, java.lang.String, int, int, double, double[], int, double[], int, double, double[], int)"><!-- --></A><H3>
+dsyr2k</H3>
+<PRE>
+public abstract void <B>dsyr2k</B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double beta,
+ double[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYR2K performs one of the symmetric rank 2k operations
+
+ C := alpha*A*B' + alpha*B*A' + beta*C,
+
+ or
+
+ C := alpha*A'*B + alpha*B'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A and B are n by k matrices in the first case and k by n
+ matrices in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +
+ beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrices A and B, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrices A and B. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array B must contain the matrix B, otherwise
+ the leading k by n part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDB must be at least max( 1, n ), otherwise LDB must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyrk(java.lang.String, java.lang.String, int, int, double, double[], int, double, double[], int)"><!-- --></A><H3>
+dsyrk</H3>
+<PRE>
+public abstract void <B>dsyrk</B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ double alpha,
+ double[] a,
+ int lda,
+ double beta,
+ double[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYRK performs one of the symmetric rank k operations
+
+ C := alpha*A*A' + beta*C,
+
+ or
+
+ C := alpha*A'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A is an n by k matrix in the first case and a k by n matrix
+ in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrix A, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrix A. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtbmv(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int)"><!-- --></A><H3>
+dtbmv</H3>
+<PRE>
+public abstract void <B>dtbmv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtbsv(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int)"><!-- --></A><H3>
+dtbsv</H3>
+<PRE>
+public abstract void <B>dtbsv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular band matrix, with ( k + 1 )
+ diagonals.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtpmv(java.lang.String, java.lang.String, java.lang.String, int, double[], double[], int)"><!-- --></A><H3>
+dtpmv</H3>
+<PRE>
+public abstract void <B>dtpmv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtpsv(java.lang.String, java.lang.String, java.lang.String, int, double[], double[], int)"><!-- --></A><H3>
+dtpsv</H3>
+<PRE>
+public abstract void <B>dtpsv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix, supplied in packed form.
+
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrmm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double, double[], int, double[], int)"><!-- --></A><H3>
+dtrmm</H3>
+<PRE>
+public abstract void <B>dtrmm</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRMM performs one of the matrix-matrix operations
+
+ B := alpha*op( A )*B, or B := alpha*B*op( A ),
+
+ where alpha is a scalar, B is an m by n matrix, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) multiplies B from
+ the left or right as follows:
+
+ SIDE = 'L' or 'l' B := alpha*op( A )*B.
+
+ SIDE = 'R' or 'r' B := alpha*B*op( A ).
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B, and on exit is overwritten by the
+ transformed matrix.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>transa</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrmv(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int)"><!-- --></A><H3>
+dtrmv</H3>
+<PRE>
+public abstract void <B>dtrmv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrsm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double, double[], int, double[], int)"><!-- --></A><H3>
+dtrsm</H3>
+<PRE>
+public abstract void <B>dtrsm</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ double alpha,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSM solves one of the matrix equations
+
+ op( A )*X = alpha*B, or X*op( A ) = alpha*B,
+
+ where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ The matrix X is overwritten on B.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) appears on the left
+ or right of X as follows:
+
+ SIDE = 'L' or 'l' op( A )*X = alpha*B.
+
+ SIDE = 'R' or 'r' X*op( A ) = alpha*B.
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the right-hand side matrix B, and on exit is
+ overwritten by the solution matrix X.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>transa</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrsv(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int)"><!-- --></A><H3>
+dtrsv</H3>
+<PRE>
+public abstract void <B>dtrsv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ double[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="idamax(int, double[], int)"><!-- --></A><H3>
+idamax</H3>
+<PRE>
+public abstract int <B>idamax</B>(int n,
+ double[] dx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ finds the index of element having max. absolute value.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="isamax(int, float[], int)"><!-- --></A><H3>
+isamax</H3>
+<PRE>
+public abstract int <B>isamax</B>(int n,
+ float[] sx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ finds the index of element having max. absolute value.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="lsame(java.lang.String, java.lang.String)"><!-- --></A><H3>
+lsame</H3>
+<PRE>
+public boolean <B>lsame</B>(java.lang.String ca,
+ java.lang.String cb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
+ case.
+
+ Arguments
+ =========
+
+ CA (input) CHARACTER*1
+
+ CB (input) CHARACTER*1
+ CA and CB specify the single characters to be compared.
+
+ =====================================================================
+
+
+ .. Intrinsic Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ca</CODE> - <DD><CODE>cb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sasum(int, float[], int)"><!-- --></A><H3>
+sasum</H3>
+<PRE>
+public abstract float <B>sasum</B>(int n,
+ float[] sx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ takes the sum of the absolute values.
+ uses unrolled loops for increment equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="saxpy(int, float, float[], int, float[], int)"><!-- --></A><H3>
+saxpy</H3>
+<PRE>
+public abstract void <B>saxpy</B>(int n,
+ float sa,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SAXPY constant times a vector plus a vector.
+ uses unrolled loop for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sa</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="scopy(int, float[], int, float[], int)"><!-- --></A><H3>
+scopy</H3>
+<PRE>
+public abstract void <B>scopy</B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ copies a vector, x, to a vector, y.
+ uses unrolled loops for increments equal to 1.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sdot(int, float[], int, float[], int)"><!-- --></A><H3>
+sdot</H3>
+<PRE>
+public abstract float <B>sdot</B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ forms the dot product of two vectors.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sdsdot(int, float, float[], int, float[], int)"><!-- --></A><H3>
+sdsdot</H3>
+<PRE>
+public abstract float <B>sdsdot</B>(int n,
+ float sb,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ PURPOSE
+ =======
+
+ Compute the inner product of two vectors with extended
+ precision accumulation.
+
+ Returns S.P. result with dot product accumulated in D.P.
+ SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
+ where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+ defined in a similar way using INCY.
+
+ AUTHOR
+ ======
+ Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
+ Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
+
+ ARGUMENTS
+ =========
+
+ N (input) INTEGER
+ number of elements in input vector(s)
+
+ SB (input) REAL
+ single precision scalar to be added to inner product
+
+ SX (input) REAL array, dimension (N)
+ single precision vector with N elements
+
+ INCX (input) INTEGER
+ storage spacing between elements of SX
+
+ SY (input) REAL array, dimension (N)
+ single precision vector with N elements
+
+ INCY (input) INTEGER
+ storage spacing between elements of SY
+
+ SDSDOT (output) REAL
+ single precision dot product (SB if N .LE. 0)
+
+ REFERENCES
+ ==========
+
+ C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+ Krogh, Basic linear algebra subprograms for Fortran
+ usage, Algorithm No. 539, Transactions on Mathematical
+ Software 5, 3 (September 1979), pp. 308-323.
+
+ REVISION HISTORY (YYMMDD)
+ ==========================
+
+ 791001 DATE WRITTEN
+ 890531 Changed all specific intrinsics to generic. (WRB)
+ 890831 Modified array declarations. (WRB)
+ 890831 REVISION DATE from Version 3.2
+ 891214 Prologue converted to Version 4.0 format. (BAB)
+ 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+ 920501 Reformatted the REFERENCES section. (WRB)
+ 070118 Reformat to LAPACK coding style
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sb</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbmv(java.lang.String, int, int, int, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+sgbmv</H3>
+<PRE>
+public abstract void <B>sgbmv</B>(java.lang.String trans,
+ int m,
+ int n,
+ int kl,
+ int ku,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ KL - INTEGER.
+ On entry, KL specifies the number of sub-diagonals of the
+ matrix A. KL must satisfy 0 .le. KL.
+ Unchanged on exit.
+
+ KU - INTEGER.
+ On entry, KU specifies the number of super-diagonals of the
+
+ matrix A. KU must satisfy 0 .le. KU.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry, the leading ( kl + ku + 1 ) by n part of the
+ array A must contain the matrix of coefficients, supplied
+ column by column, with the leading diagonal of the matrix in
+ row ( ku + 1 ) of the array, the first super-diagonal
+ starting at position 2 in row ku, the first sub-diagonal
+ starting at position 1 in row ( ku + 2 ), and so on.
+ Elements in the array A that do not correspond to elements
+ in the band matrix (such as the top left ku by ku triangle)
+
+ are not referenced.
+ The following program segment will transfer a band matrix
+ from conventional full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ K = KU + 1 - J
+ DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+ A( K + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( kl + ku + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgemm(java.lang.String, java.lang.String, int, int, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+sgemm</H3>
+<PRE>
+public abstract void <B>sgemm</B>(java.lang.String transa,
+ java.lang.String transb,
+ int m,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float beta,
+ float[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEMM performs one of the matrix-matrix operations
+
+ C := alpha*op( A )*op( B ) + beta*C,
+
+ where op( X ) is one of
+
+ op( X ) = X or op( X ) = X',
+
+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n', op( A ) = A.
+
+ TRANSA = 'T' or 't', op( A ) = A'.
+
+ TRANSA = 'C' or 'c', op( A ) = A'.
+
+ Unchanged on exit.
+
+ TRANSB - CHARACTER*1.
+ On entry, TRANSB specifies the form of op( B ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSB = 'N' or 'n', op( B ) = B.
+
+ TRANSB = 'T' or 't', op( B ) = B'.
+
+ TRANSB = 'C' or 'c', op( B ) = B'.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix
+ op( A ) and of the matrix C. M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix
+ op( B ) and the number of columns of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of columns of the matrix
+ op( A ) and the number of rows of the matrix op( B ). K must
+ be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANSA = 'N' or 'n', and is m otherwise.
+ Before entry with TRANSA = 'N' or 'n', the leading m by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by m part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, k ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, kb ), where kb is
+ n when TRANSB = 'N' or 'n', and is k otherwise.
+ Before entry with TRANSB = 'N' or 'n', the leading k by n
+ part of the array B must contain the matrix B, otherwise
+ the leading n by k part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
+ LDB must be at least max( 1, k ), otherwise LDB must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n matrix
+ ( alpha*op( A )*op( B ) + beta*C ).
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>transa</CODE> - <DD><CODE>transb</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgemv(java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+sgemv</H3>
+<PRE>
+public abstract void <B>sgemv</B>(java.lang.String trans,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sger(int, int, float, float[], int, float[], int, float[], int)"><!-- --></A><H3>
+sger</H3>
+<PRE>
+public abstract void <B>sger</B>(int m,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+
+ vector and A is an m by n matrix.
+
+ Arguments
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="snrm2(int, float[], int)"><!-- --></A><H3>
+snrm2</H3>
+<PRE>
+public abstract float <B>snrm2</B>(int n,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SNRM2 returns the euclidean norm of a vector via the function
+ name, so that
+
+ SNRM2 := sqrt( x'*x ).
+
+ Further Details
+ ===============
+
+ -- This version written on 25-October-1982.
+ Modified on 14-October-1993 to inline the call to SLASSQ.
+ Sven Hammarling, Nag Ltd.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="srot(int, float[], int, float[], int, float, float)"><!-- --></A><H3>
+srot</H3>
+<PRE>
+public abstract void <B>srot</B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy,
+ float c,
+ float s)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ applies a plane rotation.
+
+ Further Details
+ ===============
+
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="srotg(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+srotg</H3>
+<PRE>
+public abstract void <B>srotg</B>(org.netlib.util.floatW sa,
+ org.netlib.util.floatW sb,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW s)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ construct givens plane rotation.
+ jack dongarra, linpack, 3/11/78.
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>sa</CODE> - <DD><CODE>sb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="srotm(int, float[], int, float[], int, float[])"><!-- --></A><H3>
+srotm</H3>
+<PRE>
+public abstract void <B>srotm</B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy,
+ float[] sparam)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+
+
+ (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
+ (DX**T)
+
+ SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+ LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
+ WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
+
+ (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
+ H=( ) ( ) ( ) ( )
+ (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
+ SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ number of elements in input vector(s)
+
+ SX (input/output) REAL array, dimension N
+ double precision vector with 5 elements
+
+ INCX (input) INTEGER
+ storage spacing between elements of SX
+
+ SY (input/output) REAL array, dimension N
+ double precision vector with N elements
+
+ INCY (input) INTEGER
+ storage spacing between elements of SY
+
+ SPARAM (input/output) REAL array, dimension 5
+ SPARAM(1)=SFLAG
+ SPARAM(2)=SH11
+ SPARAM(3)=SH21
+ SPARAM(4)=SH12
+ SPARAM(5)=SH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>sparam</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="srotmg(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, float, float[])"><!-- --></A><H3>
+srotmg</H3>
+<PRE>
+public abstract void <B>srotmg</B>(org.netlib.util.floatW sd1,
+ org.netlib.util.floatW sd2,
+ org.netlib.util.floatW sx1,
+ float sy1,
+ float[] sparam)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+
+ THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)*
+ SY2)**T.
+ WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
+
+ (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
+ H=( ) ( ) ( ) ( )
+ (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
+ LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22
+ RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE
+ VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.)
+
+ THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+ INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+ OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+
+
+ Arguments
+ =========
+
+
+ SD1 (input/output) REAL
+
+ SD2 (input/output) REAL
+
+ SX1 (input/output) REAL
+
+ SY1 (input) REAL
+
+
+ SPARAM (input/output) REAL array, dimension 5
+ SPARAM(1)=SFLAG
+ SPARAM(2)=SH11
+ SPARAM(3)=SH21
+ SPARAM(4)=SH12
+ SPARAM(5)=SH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>sd1</CODE> - <DD><CODE>sd2</CODE> - <DD><CODE>sx1</CODE> - <DD><CODE>sy1</CODE> - <DD><CODE>sparam</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbmv(java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+ssbmv</H3>
+<PRE>
+public abstract void <B>ssbmv</B>(java.lang.String uplo,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric band matrix, with k super-diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the band matrix A is being supplied as
+ follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ being supplied.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ being supplied.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of super-diagonals of the
+ matrix A. K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer the upper
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer the lower
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ Y - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sscal(int, float, float[], int)"><!-- --></A><H3>
+sscal</H3>
+<PRE>
+public abstract void <B>sscal</B>(int n,
+ float sa,
+ float[] sx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ scales a vector by a constant.
+ uses unrolled loops for increment equal to 1.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sa</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspmv(java.lang.String, int, float, float[], float[], int, float, float[], int)"><!-- --></A><H3>
+sspmv</H3>
+<PRE>
+public abstract void <B>sspmv</B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] ap,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspr(java.lang.String, int, float, float[], int, float[])"><!-- --></A><H3>
+sspr</H3>
+<PRE>
+public abstract void <B>sspr</B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] ap)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>ap</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspr2(java.lang.String, int, float, float[], int, float[], int, float[])"><!-- --></A><H3>
+sspr2</H3>
+<PRE>
+public abstract void <B>sspr2</B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] ap)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>ap</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sswap(int, float[], int, float[], int)"><!-- --></A><H3>
+sswap</H3>
+<PRE>
+public abstract void <B>sswap</B>(int n,
+ float[] sx,
+ int incx,
+ float[] sy,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ interchanges two vectors.
+ uses unrolled loops for increments equal to 1.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>sy</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssymm(java.lang.String, java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+ssymm</H3>
+<PRE>
+public abstract void <B>ssymm</B>(java.lang.String side,
+ java.lang.String uplo,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float beta,
+ float[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYMM performs one of the matrix-matrix operations
+
+ C := alpha*A*B + beta*C,
+
+ or
+
+ C := alpha*B*A + beta*C,
+
+ where alpha and beta are scalars, A is a symmetric matrix and B and
+ C are m by n matrices.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether the symmetric matrix A
+ appears on the left or right in the operation as follows:
+
+ SIDE = 'L' or 'l' C := alpha*A*B + beta*C,
+
+ SIDE = 'R' or 'r' C := alpha*B*A + beta*C,
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the symmetric matrix A is to be
+ referenced as follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of the
+ symmetric matrix is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of the
+ symmetric matrix is to be referenced.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix C.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix C.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ m when SIDE = 'L' or 'l' and is n otherwise.
+ Before entry with SIDE = 'L' or 'l', the m by m part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading m by m upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading m by m lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Before entry with SIDE = 'R' or 'r', the n by n part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading n by n upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading n by n lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n updated
+ matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssymv(java.lang.String, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+ssymv</H3>
+<PRE>
+public abstract void <B>ssymv</B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx,
+ float beta,
+ float[] y,
+ int incy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyr(java.lang.String, int, float, float[], int, float[], int)"><!-- --></A><H3>
+ssyr</H3>
+<PRE>
+public abstract void <B>ssyr</B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyr2(java.lang.String, int, float, float[], int, float[], int, float[], int)"><!-- --></A><H3>
+ssyr2</H3>
+<PRE>
+public abstract void <B>ssyr2</B>(java.lang.String uplo,
+ int n,
+ float alpha,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an n
+
+ by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyr2k(java.lang.String, java.lang.String, int, int, float, float[], int, float[], int, float, float[], int)"><!-- --></A><H3>
+ssyr2k</H3>
+<PRE>
+public abstract void <B>ssyr2k</B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float beta,
+ float[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYR2K performs one of the symmetric rank 2k operations
+
+ C := alpha*A*B' + alpha*B*A' + beta*C,
+
+ or
+
+ C := alpha*A'*B + alpha*B'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A and B are n by k matrices in the first case and k by n
+ matrices in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +
+ beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrices A and B, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrices A and B. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, kb ), where kb is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array B must contain the matrix B, otherwise
+ the leading k by n part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDB must be at least max( 1, n ), otherwise LDB must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyrk(java.lang.String, java.lang.String, int, int, float, float[], int, float, float[], int)"><!-- --></A><H3>
+ssyrk</H3>
+<PRE>
+public abstract void <B>ssyrk</B>(java.lang.String uplo,
+ java.lang.String trans,
+ int n,
+ int k,
+ float alpha,
+ float[] a,
+ int lda,
+ float beta,
+ float[] c,
+ int Ldc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYRK performs one of the symmetric rank k operations
+
+ C := alpha*A*A' + beta*C,
+
+ or
+
+ C := alpha*A'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A is an n by k matrix in the first case and a k by n matrix
+ in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrix A, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrix A. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stbmv(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int)"><!-- --></A><H3>
+stbmv</H3>
+<PRE>
+public abstract void <B>stbmv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stbsv(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int)"><!-- --></A><H3>
+stbsv</H3>
+<PRE>
+public abstract void <B>stbsv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular band matrix, with ( k + 1 )
+ diagonals.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stpmv(java.lang.String, java.lang.String, java.lang.String, int, float[], float[], int)"><!-- --></A><H3>
+stpmv</H3>
+<PRE>
+public abstract void <B>stpmv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stpsv(java.lang.String, java.lang.String, java.lang.String, int, float[], float[], int)"><!-- --></A><H3>
+stpsv</H3>
+<PRE>
+public abstract void <B>stpsv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix, supplied in packed form.
+
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strmm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float, float[], int, float[], int)"><!-- --></A><H3>
+strmm</H3>
+<PRE>
+public abstract void <B>strmm</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRMM performs one of the matrix-matrix operations
+
+ B := alpha*op( A )*B, or B := alpha*B*op( A ),
+
+ where alpha is a scalar, B is an m by n matrix, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) multiplies B from
+ the left or right as follows:
+
+ SIDE = 'L' or 'l' B := alpha*op( A )*B.
+
+ SIDE = 'R' or 'r' B := alpha*B*op( A ).
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B, and on exit is overwritten by the
+ transformed matrix.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>transa</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strmv(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int)"><!-- --></A><H3>
+strmv</H3>
+<PRE>
+public abstract void <B>strmv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strsm(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float, float[], int, float[], int)"><!-- --></A><H3>
+strsm</H3>
+<PRE>
+public abstract void <B>strsm</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String transa,
+ java.lang.String diag,
+ int m,
+ int n,
+ float alpha,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSM solves one of the matrix equations
+
+ op( A )*X = alpha*B, or X*op( A ) = alpha*B,
+
+ where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ The matrix X is overwritten on B.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) appears on the left
+ or right of X as follows:
+
+ SIDE = 'L' or 'l' op( A )*X = alpha*B.
+
+ SIDE = 'R' or 'r' X*op( A ) = alpha*B.
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the right-hand side matrix B, and on exit is
+ overwritten by the solution matrix X.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>transa</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strsv(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int)"><!-- --></A><H3>
+strsv</H3>
+<PRE>
+public abstract void <B>strsv</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ float[] x,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<!-- ========= END OF CLASS DATA ========= -->
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/BLAS.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/BLAS.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="BLAS.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | FIELD | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: FIELD | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/blas/class-use/BLAS.html b/javadoc/org/netlib/blas/class-use/BLAS.html
new file mode 100644
index 0000000..2bba828
--- /dev/null
+++ b/javadoc/org/netlib/blas/class-use/BLAS.html
@@ -0,0 +1,181 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Class org.netlib.blas.BLAS
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Class org.netlib.blas.BLAS";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/blas//class-useBLAS.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="BLAS.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Class<br>org.netlib.blas.BLAS</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.blas"><B>org.netlib.blas</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.blas"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Uses of <A HREF="../../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A> in <A HREF="../../../../org/netlib/blas/package-summary.html">org.netlib.blas</A></FONT></TH>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Methods in <A HREF="../../../../org/netlib/blas/package-summary.html">org.netlib.blas</A> that return <A HREF="../../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A></CODE></FONT></TD>
+<TD><CODE><B>BLAS.</B><B><A HREF="../../../../org/netlib/blas/BLAS.html#getInstance()">getInstance</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/blas//class-useBLAS.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="BLAS.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/blas/package-frame.html b/javadoc/org/netlib/blas/package-frame.html
new file mode 100644
index 0000000..18a1f5c
--- /dev/null
+++ b/javadoc/org/netlib/blas/package-frame.html
@@ -0,0 +1,33 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.blas
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+<FONT size="+1" CLASS="FrameTitleFont">
+<A HREF="../../../org/netlib/blas/package-summary.html" target="classFrame">org.netlib.blas</A></FONT>
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT size="+1" CLASS="FrameHeadingFont">
+Classes</FONT>
+<FONT CLASS="FrameItemFont">
+<BR>
+<A HREF="BLAS.html" title="class in org.netlib.blas" target="classFrame">BLAS</A></FONT></TD>
+</TR>
+</TABLE>
+
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/blas/package-summary.html b/javadoc/org/netlib/blas/package-summary.html
new file mode 100644
index 0000000..858d9ac
--- /dev/null
+++ b/javadoc/org/netlib/blas/package-summary.html
@@ -0,0 +1,159 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.blas
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.blas";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/arpack/package-summary.html"><B>PREV PACKAGE</B></A>
+ <A HREF="../../../org/netlib/lapack/package-summary.html"><B>NEXT PACKAGE</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<H2>
+Package org.netlib.blas
+</H2>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Class Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="15%"><B><A HREF="../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas">BLAS</A></B></TD>
+<TD>BLAS provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.</TD>
+</TR>
+</TABLE>
+
+
+<P>
+<DL>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/arpack/package-summary.html"><B>PREV PACKAGE</B></A>
+ <A HREF="../../../org/netlib/lapack/package-summary.html"><B>NEXT PACKAGE</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/blas/package-tree.html b/javadoc/org/netlib/blas/package-tree.html
new file mode 100644
index 0000000..6011376
--- /dev/null
+++ b/javadoc/org/netlib/blas/package-tree.html
@@ -0,0 +1,154 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.blas Class Hierarchy
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.blas Class Hierarchy";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/arpack/package-tree.html"><B>PREV</B></A>
+ <A HREF="../../../org/netlib/lapack/package-tree.html"><B>NEXT</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+Hierarchy For Package org.netlib.blas
+</H2>
+</CENTER>
+<DL>
+<DT><B>Package Hierarchies:</B><DD><A HREF="../../../overview-tree.html">All Packages</A></DL>
+<HR>
+<H2>
+Class Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">org.netlib.blas.<A HREF="../../../org/netlib/blas/BLAS.html" title="class in org.netlib.blas"><B>BLAS</B></A></UL>
+</UL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/arpack/package-tree.html"><B>PREV</B></A>
+ <A HREF="../../../org/netlib/lapack/package-tree.html"><B>NEXT</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/blas/package-use.html b/javadoc/org/netlib/blas/package-use.html
new file mode 100644
index 0000000..f8eb687
--- /dev/null
+++ b/javadoc/org/netlib/blas/package-use.html
@@ -0,0 +1,172 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Package org.netlib.blas
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Package org.netlib.blas";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Package<br>org.netlib.blas</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../org/netlib/blas/package-summary.html">org.netlib.blas</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.blas"><B>org.netlib.blas</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.blas"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Classes in <A HREF="../../../org/netlib/blas/package-summary.html">org.netlib.blas</A> used by <A HREF="../../../org/netlib/blas/package-summary.html">org.netlib.blas</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><B><A HREF="../../../org/netlib/blas/class-use/BLAS.html#org.netlib.blas"><B>BLAS</B></A></B>
+
+<BR>
+ BLAS provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.</TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/blas/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/lapack/LAPACK.html b/javadoc/org/netlib/lapack/LAPACK.html
new file mode 100644
index 0000000..762a42f
--- /dev/null
+++ b/javadoc/org/netlib/lapack/LAPACK.html
@@ -0,0 +1,100064 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:18 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+LAPACK
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="LAPACK";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/LAPACK.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/LAPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="LAPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | FIELD | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: FIELD | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<!-- ======== START OF CLASS DATA ======== -->
+<H2>
+<FONT SIZE="-1">
+org.netlib.lapack</FONT>
+<BR>
+Class LAPACK</H2>
+<PRE>
+java.lang.Object
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by "><B>org.netlib.lapack.LAPACK</B>
+</PRE>
+<HR>
+<DL>
+<DT><PRE>public abstract class <B>LAPACK</B><DT>extends java.lang.Object</DL>
+</PRE>
+
+<P>
+LAPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.
+<P>
+
+<P>
+<DL>
+<DT><B>See Also:</B><DD><CODE>http://sourceforge.net/projects/f2j</CODE>,
+<CODE>http://www.netlib.org/lapack/</CODE></DL>
+<HR>
+
+<P>
+
+<!-- ======== CONSTRUCTOR SUMMARY ======== -->
+
+<A NAME="constructor_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Constructor Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#LAPACK()">LAPACK</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<!-- ========== METHOD SUMMARY =========== -->
+
+<A NAME="method_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Method Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dbdsdc(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], int, double[], int[], double[], int[], org.netlib.util.intW)">dbdsdc</A></B>(java.lang.String uplo,
+ java.lang.String compq,
+ int n,
+ double[] d,
+ double[] e,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] q,
+ int[] iq,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dbdsqr(java.lang.String, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)">dbdsqr</A></B>(java.lang.String uplo,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ double[] d,
+ double[] e,
+ double[] vt,
+ int ldvt,
+ double[] u,
+ int ldu,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ddisna(java.lang.String, int, int, double[], double[], org.netlib.util.intW)">ddisna</A></B>(java.lang.String job,
+ int m,
+ int n,
+ double[] d,
+ double[] sep,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbbrd(java.lang.String, int, int, int, int, int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)">dgbbrd</A></B>(java.lang.String vect,
+ int m,
+ int n,
+ int ncc,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] d,
+ double[] e,
+ double[] q,
+ int ldq,
+ double[] pt,
+ int ldpt,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbcon(java.lang.String, int, int, int, double[], int, int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dgbcon</A></B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbequ(int, int, int, int, double[], int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dgbequ</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] r,
+ double[] c,
+ org.netlib.util.doubleW rowcnd,
+ org.netlib.util.doubleW colcnd,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbrfs(java.lang.String, int, int, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dgbrfs</A></B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbsv(int, int, int, int, double[], int, int[], double[], int, org.netlib.util.intW)">dgbsv</A></B>(int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbsvx(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], int, int[], org.netlib.util.StringW, double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dgbsvx</A></B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ double[] r,
+ double[] c,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbtf2(int, int, int, int, double[], int, int[], org.netlib.util.intW)">dgbtf2</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbtrf(int, int, int, int, double[], int, int[], org.netlib.util.intW)">dgbtrf</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgbtrs(java.lang.String, int, int, int, int, double[], int, int[], double[], int, org.netlib.util.intW)">dgbtrs</A></B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgebak(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)">dgebak</A></B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ double[] scale,
+ int m,
+ double[] v,
+ int ldv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgebal(java.lang.String, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.intW)">dgebal</A></B>(java.lang.String job,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] scale,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgebd2(int, int, double[], int, double[], double[], double[], double[], double[], org.netlib.util.intW)">dgebd2</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tauq,
+ double[] taup,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgebrd(int, int, double[], int, double[], double[], double[], double[], double[], int, org.netlib.util.intW)">dgebrd</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tauq,
+ double[] taup,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgecon(java.lang.String, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dgecon</A></B>(java.lang.String norm,
+ int n,
+ double[] a,
+ int lda,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeequ(int, int, double[], int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dgeequ</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] r,
+ double[] c,
+ org.netlib.util.doubleW rowcnd,
+ org.netlib.util.doubleW colcnd,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgees(java.lang.String, java.lang.String, java.lang.Object, int, double[], int, org.netlib.util.intW, double[], double[], double[], int, double[], int, boolean[], org.netlib.util.intW)">dgees</A></B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ double[] wr,
+ double[] wi,
+ double[] vs,
+ int ldvs,
+ double[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeesx(java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, double[], int, org.netlib.util.intW, double[], double[], double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], int, boolean[], org.netlib.util.intW)">dgeesx</A></B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ double[] wr,
+ double[] wi,
+ double[] vs,
+ int ldvs,
+ org.netlib.util.doubleW rconde,
+ org.netlib.util.doubleW rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeev(java.lang.String, java.lang.String, int, double[], int, double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)">dgeev</A></B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ double[] a,
+ int lda,
+ double[] wr,
+ double[] wi,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.doubleW, double[], double[], double[], int, int[], org.netlib.util.intW)">dgeevx</A></B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ double[] wr,
+ double[] wi,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] scale,
+ org.netlib.util.doubleW abnrm,
+ double[] rconde,
+ double[] rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgegs(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)">dgegs</A></B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vsl,
+ int ldvsl,
+ double[] vsr,
+ int ldvsr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgegv(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)">dgegv</A></B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgehd2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)">dgehd2</A></B>(int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgehrd(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dgehrd</A></B>(int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgelq2(int, int, double[], int, double[], double[], org.netlib.util.intW)">dgelq2</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgelqf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dgelqf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgels(java.lang.String, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.intW)">dgels</A></B>(java.lang.String trans,
+ int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgelsd(int, int, int, double[], int, double[], int, double[], double, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)">dgelsd</A></B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] s,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgelss(int, int, int, double[], int, double[], int, double[], double, org.netlib.util.intW, double[], int, org.netlib.util.intW)">dgelss</A></B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] s,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgelsx(int, int, int, double[], int, double[], int, int[], double, org.netlib.util.intW, double[], org.netlib.util.intW)">dgelsx</A></B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ int[] jpvt,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgelsy(int, int, int, double[], int, double[], int, int[], double, org.netlib.util.intW, double[], int, org.netlib.util.intW)">dgelsy</A></B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ int[] jpvt,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeql2(int, int, double[], int, double[], double[], org.netlib.util.intW)">dgeql2</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeqlf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dgeqlf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeqp3(int, int, double[], int, int[], double[], double[], int, org.netlib.util.intW)">dgeqp3</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeqpf(int, int, double[], int, int[], double[], double[], org.netlib.util.intW)">dgeqpf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeqr2(int, int, double[], int, double[], double[], org.netlib.util.intW)">dgeqr2</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgeqrf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dgeqrf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgerfs(java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dgerfs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgerq2(int, int, double[], int, double[], double[], org.netlib.util.intW)">dgerq2</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgerqf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dgerqf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgesc2(int, double[], int, double[], int[], int[], org.netlib.util.doubleW)">dgesc2</A></B>(int n,
+ double[] a,
+ int lda,
+ double[] rhs,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.doubleW scale)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgesdd(java.lang.String, int, int, double[], int, double[], double[], int, double[], int, double[], int, int[], org.netlib.util.intW)">dgesdd</A></B>(java.lang.String jobz,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] s,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgesv(int, int, double[], int, int[], double[], int, org.netlib.util.intW)">dgesv</A></B>(int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgesvd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, double[], int, org.netlib.util.intW)">dgesvd</A></B>(java.lang.String jobu,
+ java.lang.String jobvt,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] s,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgesvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, int[], org.netlib.util.StringW, double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dgesvx</A></B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ double[] r,
+ double[] c,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgetc2(int, double[], int, int[], int[], org.netlib.util.intW)">dgetc2</A></B>(int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgetf2(int, int, double[], int, int[], org.netlib.util.intW)">dgetf2</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgetrf(int, int, double[], int, int[], org.netlib.util.intW)">dgetrf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgetri(int, double[], int, int[], double[], int, org.netlib.util.intW)">dgetri</A></B>(int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgetrs(java.lang.String, int, int, double[], int, int[], double[], int, org.netlib.util.intW)">dgetrs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggbak(java.lang.String, java.lang.String, int, int, int, double[], double[], int, double[], int, org.netlib.util.intW)">dggbak</A></B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ double[] lscale,
+ double[] rscale,
+ int m,
+ double[] v,
+ int ldv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggbal(java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], org.netlib.util.intW)">dggbal</A></B>(java.lang.String job,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] lscale,
+ double[] rscale,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgges(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, int, double[], int, double[], int, org.netlib.util.intW, double[], double[], double[], double[], int, double[], int, double[], int, boolean[], org.netlib.util.intW)">dgges</A></B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vsl,
+ int ldvsl,
+ double[] vsr,
+ int ldvsr,
+ double[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggesx(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, double[], double[], double[], double[], int, double[], int, double[], double[], double[], int, int[], int, boolean[], org.netlib.util.intW)">dggesx</A></B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vsl,
+ int ldvsl,
+ double[] vsr,
+ int ldvsr,
+ double[] rconde,
+ double[] rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggev(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)">dggev</A></B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], double[], int, int[], boolean[], org.netlib.util.intW)">dggevx</A></B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] lscale,
+ double[] rscale,
+ org.netlib.util.doubleW abnrm,
+ org.netlib.util.doubleW bbnrm,
+ double[] rconde,
+ double[] rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggglm(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)">dggglm</A></B>(int n,
+ int m,
+ int p,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] d,
+ double[] x,
+ double[] y,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgghrd(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.intW)">dgghrd</A></B>(java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgglse(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)">dgglse</A></B>(int m,
+ int n,
+ int p,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ double[] d,
+ double[] x,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggqrf(int, int, int, double[], int, double[], double[], int, double[], double[], int, org.netlib.util.intW)">dggqrf</A></B>(int n,
+ int m,
+ int p,
+ double[] a,
+ int lda,
+ double[] taua,
+ double[] b,
+ int ldb,
+ double[] taub,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggrqf(int, int, int, double[], int, double[], double[], int, double[], double[], int, org.netlib.util.intW)">dggrqf</A></B>(int m,
+ int p,
+ int n,
+ double[] a,
+ int lda,
+ double[] taua,
+ double[] b,
+ int ldb,
+ double[] taub,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggsvd(java.lang.String, java.lang.String, java.lang.String, int, int, int, org.netlib.util.intW, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], int[], org.netlib.util.intW)">dggsvd</A></B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int n,
+ int p,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alpha,
+ double[] beta,
+ double[] u,
+ int ldu,
+ double[] v,
+ int ldv,
+ double[] q,
+ int ldq,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dggsvp(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double, double, org.netlib.util.intW, org.netlib.util.intW, double[], int, double[], int, double[], int, int[], double[], double[], org.netlib.util.intW)">dggsvp</A></B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double tola,
+ double tolb,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ double[] u,
+ int ldu,
+ double[] v,
+ int ldv,
+ double[] q,
+ int ldq,
+ int[] iwork,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgtcon(java.lang.String, int, double[], double[], double[], double[], int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dgtcon</A></B>(java.lang.String norm,
+ int n,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgtrfs(java.lang.String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dgtrfs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] dlf,
+ double[] df,
+ double[] duf,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgtsv(int, int, double[], double[], double[], double[], int, org.netlib.util.intW)">dgtsv</A></B>(int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgtsvx(java.lang.String, java.lang.String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dgtsvx</A></B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] dlf,
+ double[] df,
+ double[] duf,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgttrf(int, double[], double[], double[], double[], int[], org.netlib.util.intW)">dgttrf</A></B>(int n,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgttrs(java.lang.String, int, int, double[], double[], double[], double[], int[], double[], int, org.netlib.util.intW)">dgttrs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dgtts2(int, int, int, double[], double[], double[], double[], int[], double[], int)">dgtts2</A></B>(int itrans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dhgeqz(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)">dhgeqz</A></B>(java.lang.String job,
+ java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] t,
+ int ldt,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dhsein(java.lang.String, java.lang.String, java.lang.String, boolean[], int, double[], int, double[], double[], double[], int, double[], int, int, org.netlib.util.intW, double[], int[], int[], org.netlib.util.intW)">dhsein</A></B>(java.lang.String side,
+ java.lang.String eigsrc,
+ java.lang.String initv,
+ boolean[] select,
+ int n,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ int[] ifaill,
+ int[] ifailr,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dhseqr(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], double[], int, double[], int, org.netlib.util.intW)">dhseqr</A></B>(java.lang.String job,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#disnan(double)">disnan</A></B>(double din)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlabad(org.netlib.util.doubleW, org.netlib.util.doubleW)">dlabad</A></B>(org.netlib.util.doubleW small,
+ org.netlib.util.doubleW large)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlabrd(int, int, int, double[], int, double[], double[], double[], double[], double[], int, double[], int)">dlabrd</A></B>(int m,
+ int n,
+ int nb,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tauq,
+ double[] taup,
+ double[] x,
+ int ldx,
+ double[] y,
+ int ldy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlacn2(int, double[], double[], int[], org.netlib.util.doubleW, org.netlib.util.intW, int[])">dlacn2</A></B>(int n,
+ double[] v,
+ double[] x,
+ int[] isgn,
+ org.netlib.util.doubleW est,
+ org.netlib.util.intW kase,
+ int[] isave)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlacon(int, double[], double[], int[], org.netlib.util.doubleW, org.netlib.util.intW)">dlacon</A></B>(int n,
+ double[] v,
+ double[] x,
+ int[] isgn,
+ org.netlib.util.doubleW est,
+ org.netlib.util.intW kase)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlacpy(java.lang.String, int, int, double[], int, double[], int)">dlacpy</A></B>(java.lang.String uplo,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dladiv(double, double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)">dladiv</A></B>(double a,
+ double b,
+ double c,
+ double d,
+ org.netlib.util.doubleW p,
+ org.netlib.util.doubleW q)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlae2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlae2</A></B>(double a,
+ double b,
+ double c,
+ org.netlib.util.doubleW rt1,
+ org.netlib.util.doubleW rt2)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaebz(int, int, int, int, int, int, double, double, double, double[], double[], double[], int[], double[], double[], org.netlib.util.intW, int[], double[], int[], org.netlib.util.intW)">dlaebz</A></B>(int ijob,
+ int nitmax,
+ int n,
+ int mmax,
+ int minp,
+ int nbmin,
+ double abstol,
+ double reltol,
+ double pivmin,
+ double[] d,
+ double[] e,
+ double[] e2,
+ int[] nval,
+ double[] ab,
+ double[] c,
+ org.netlib.util.intW mout,
+ int[] nab,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed0(int, int, int, double[], double[], double[], int, double[], int, double[], int[], org.netlib.util.intW)">dlaed0</A></B>(int icompq,
+ int qsiz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] q,
+ int ldq,
+ double[] qstore,
+ int ldqs,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed1(int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], int[], org.netlib.util.intW)">dlaed1</A></B>(int n,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ int cutpnt,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed2(org.netlib.util.intW, int, int, double[], double[], int, int[], org.netlib.util.doubleW, double[], double[], double[], double[], int[], int[], int[], int[], org.netlib.util.intW)">dlaed2</A></B>(org.netlib.util.intW k,
+ int n,
+ int n1,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ double[] z,
+ double[] dlamda,
+ double[] w,
+ double[] q2,
+ int[] indx,
+ int[] indxc,
+ int[] indxp,
+ int[] coltyp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed3(int, int, int, double[], double[], int, double, double[], double[], int[], int[], double[], double[], org.netlib.util.intW)">dlaed3</A></B>(int k,
+ int n,
+ int n1,
+ double[] d,
+ double[] q,
+ int ldq,
+ double rho,
+ double[] dlamda,
+ double[] q2,
+ int[] indx,
+ int[] ctot,
+ double[] w,
+ double[] s,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed4(int, int, double[], double[], double[], double, org.netlib.util.doubleW, org.netlib.util.intW)">dlaed4</A></B>(int n,
+ int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW dlam,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed5(int, double[], double[], double[], double, org.netlib.util.doubleW)">dlaed5</A></B>(int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW dlam)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed6(int, boolean, double, double[], double[], double, org.netlib.util.doubleW, org.netlib.util.intW)">dlaed6</A></B>(int kniter,
+ boolean orgati,
+ double rho,
+ double[] d,
+ double[] z,
+ double finit,
+ org.netlib.util.doubleW tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed7(int, int, int, int, int, int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], int[], int[], int[], int[], int[], double[], double[], int[], org.netlib.util.intW)">dlaed7</A></B>(int icompq,
+ int n,
+ int qsiz,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ int cutpnt,
+ double[] qstore,
+ int[] qptr,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ double[] givnum,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed8(int, org.netlib.util.intW, int, int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], double[], double[], int, double[], int[], org.netlib.util.intW, int[], double[], int[], int[], org.netlib.util.intW)">dlaed8</A></B>(int icompq,
+ org.netlib.util.intW k,
+ int n,
+ int qsiz,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ int cutpnt,
+ double[] z,
+ double[] dlamda,
+ double[] q2,
+ int ldq2,
+ double[] w,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ double[] givnum,
+ int[] indxp,
+ int[] indx,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaed9(int, int, int, int, double[], double[], int, double, double[], double[], double[], int, org.netlib.util.intW)">dlaed9</A></B>(int k,
+ int kstart,
+ int kstop,
+ int n,
+ double[] d,
+ double[] q,
+ int ldq,
+ double rho,
+ double[] dlamda,
+ double[] w,
+ double[] s,
+ int lds,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaeda(int, int, int, int, int[], int[], int[], int[], double[], double[], int[], double[], double[], org.netlib.util.intW)">dlaeda</A></B>(int n,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ double[] givnum,
+ double[] q,
+ int[] qptr,
+ double[] z,
+ double[] ztemp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaein(boolean, boolean, int, double[], int, double, double, double[], double[], double[], int, double[], double, double, double, org.netlib.util.intW)">dlaein</A></B>(boolean rightv,
+ boolean noinit,
+ int n,
+ double[] h,
+ int ldh,
+ double wr,
+ double wi,
+ double[] vr,
+ double[] vi,
+ double[] b,
+ int ldb,
+ double[] work,
+ double eps3,
+ double smlnum,
+ double bignum,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaev2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlaev2</A></B>(double a,
+ double b,
+ double c,
+ org.netlib.util.doubleW rt1,
+ org.netlib.util.doubleW rt2,
+ org.netlib.util.doubleW cs1,
+ org.netlib.util.doubleW sn1)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaexc(boolean, int, double[], int, double[], int, int, int, int, double[], org.netlib.util.intW)">dlaexc</A></B>(boolean wantq,
+ int n,
+ double[] t,
+ int ldt,
+ double[] q,
+ int ldq,
+ int j1,
+ int n1,
+ int n2,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlag2(double[], int, double[], int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlag2</A></B>(double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double safmin,
+ org.netlib.util.doubleW scale1,
+ org.netlib.util.doubleW scale2,
+ org.netlib.util.doubleW wr1,
+ org.netlib.util.doubleW wr2,
+ org.netlib.util.doubleW wi)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlag2s(int, int, double[], int, float[], int, org.netlib.util.intW)">dlag2s</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ float[] sa,
+ int ldsa,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlags2(boolean, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlags2</A></B>(boolean upper,
+ double a1,
+ double a2,
+ double a3,
+ double b1,
+ double b2,
+ double b3,
+ org.netlib.util.doubleW csu,
+ org.netlib.util.doubleW snu,
+ org.netlib.util.doubleW csv,
+ org.netlib.util.doubleW snv,
+ org.netlib.util.doubleW csq,
+ org.netlib.util.doubleW snq)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlagtf(int, double[], double, double[], double[], double, double[], int[], org.netlib.util.intW)">dlagtf</A></B>(int n,
+ double[] a,
+ double lambda,
+ double[] b,
+ double[] c,
+ double tol,
+ double[] d,
+ int[] in,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlagtm(java.lang.String, int, int, double, double[], double[], double[], double[], int, double, double[], int)">dlagtm</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double alpha,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] x,
+ int ldx,
+ double beta,
+ double[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlagts(int, int, double[], double[], double[], double[], int[], double[], org.netlib.util.doubleW, org.netlib.util.intW)">dlagts</A></B>(int job,
+ int n,
+ double[] a,
+ double[] b,
+ double[] c,
+ double[] d,
+ int[] in,
+ double[] y,
+ org.netlib.util.doubleW tol,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlagv2(double[], int, double[], int, double[], double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlagv2</A></B>(double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ org.netlib.util.doubleW csl,
+ org.netlib.util.doubleW snl,
+ org.netlib.util.doubleW csr,
+ org.netlib.util.doubleW snr)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlahqr(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, org.netlib.util.intW)">dlahqr</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlahr2(int, int, int, double[], int, double[], double[], int, double[], int)">dlahr2</A></B>(int n,
+ int k,
+ int nb,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] t,
+ int ldt,
+ double[] y,
+ int ldy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlahrd(int, int, int, double[], int, double[], double[], int, double[], int)">dlahrd</A></B>(int n,
+ int k,
+ int nb,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] t,
+ int ldt,
+ double[] y,
+ int ldy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaic1(int, int, double[], double, double[], double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlaic1</A></B>(int job,
+ int j,
+ double[] x,
+ double sest,
+ double[] w,
+ double gamma,
+ org.netlib.util.doubleW sestpr,
+ org.netlib.util.doubleW s,
+ org.netlib.util.doubleW c)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaisnan(double, double)">dlaisnan</A></B>(double din1,
+ double din2)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaln2(boolean, int, int, double, double, double[], int, double, double, double[], int, double, double, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dlaln2</A></B>(boolean ltrans,
+ int na,
+ int nw,
+ double smin,
+ double ca,
+ double[] a,
+ int lda,
+ double d1,
+ double d2,
+ double[] b,
+ int ldb,
+ double wr,
+ double wi,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW xnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlals0(int, int, int, int, int, double[], int, double[], int, int[], int, int[], int, double[], int, double[], double[], double[], double[], int, double, double, double[], org.netlib.util.intW)">dlals0</A></B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ int nrhs,
+ double[] b,
+ int ldb,
+ double[] bx,
+ int ldbx,
+ int[] perm,
+ int givptr,
+ int[] givcol,
+ int ldgcol,
+ double[] givnum,
+ int ldgnum,
+ double[] poles,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ int k,
+ double c,
+ double s,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlalsa(int, int, int, int, double[], int, double[], int, double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], org.netlib.util.intW)">dlalsa</A></B>(int icompq,
+ int smlsiz,
+ int n,
+ int nrhs,
+ double[] b,
+ int ldb,
+ double[] bx,
+ int ldbx,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int[] k,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ double[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ double[] givnum,
+ double[] c,
+ double[] s,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlalsd(java.lang.String, int, int, int, double[], double[], double[], int, double, org.netlib.util.intW, double[], int[], org.netlib.util.intW)">dlalsd</A></B>(java.lang.String uplo,
+ int smlsiz,
+ int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamc1(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.booleanW)">dlamc1</A></B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.booleanW ieee1)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamc2(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW)">dlamc2</A></B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.doubleW eps,
+ org.netlib.util.intW emin,
+ org.netlib.util.doubleW rmin,
+ org.netlib.util.intW emax,
+ org.netlib.util.doubleW rmax)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamc3(double, double)">dlamc3</A></B>(double a,
+ double b)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamc4(org.netlib.util.intW, double, int)">dlamc4</A></B>(org.netlib.util.intW emin,
+ double start,
+ int base)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamc5(int, int, int, boolean, org.netlib.util.intW, org.netlib.util.doubleW)">dlamc5</A></B>(int beta,
+ int p,
+ int emin,
+ boolean ieee,
+ org.netlib.util.intW emax,
+ org.netlib.util.doubleW rmax)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamch(java.lang.String)">dlamch</A></B>(java.lang.String cmach)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlamrg(int, int, double[], int, int, int[])">dlamrg</A></B>(int n1,
+ int n2,
+ double[] a,
+ int dtrd1,
+ int dtrd2,
+ int[] index)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaneg(int, double[], double[], double, double, int)">dlaneg</A></B>(int n,
+ double[] d,
+ double[] lld,
+ double sigma,
+ double pivmin,
+ int r)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlangb(java.lang.String, int, int, int, double[], int, double[])">dlangb</A></B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlange(java.lang.String, int, int, double[], int, double[])">dlange</A></B>(java.lang.String norm,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlangt(java.lang.String, int, double[], double[], double[])">dlangt</A></B>(java.lang.String norm,
+ int n,
+ double[] dl,
+ double[] d,
+ double[] du)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlanhs(java.lang.String, int, double[], int, double[])">dlanhs</A></B>(java.lang.String norm,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlansb(java.lang.String, java.lang.String, int, int, double[], int, double[])">dlansb</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ int k,
+ double[] ab,
+ int ldab,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlansp(java.lang.String, java.lang.String, int, double[], double[])">dlansp</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlanst(java.lang.String, int, double[], double[])">dlanst</A></B>(java.lang.String norm,
+ int n,
+ double[] d,
+ double[] e)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlansy(java.lang.String, java.lang.String, int, double[], int, double[])">dlansy</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlantb(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[])">dlantb</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int k,
+ double[] ab,
+ int ldab,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlantp(java.lang.String, java.lang.String, java.lang.String, int, double[], double[])">dlantp</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlantr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[])">dlantr</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlanv2(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlanv2</A></B>(org.netlib.util.doubleW a,
+ org.netlib.util.doubleW b,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW d,
+ org.netlib.util.doubleW rt1r,
+ org.netlib.util.doubleW rt1i,
+ org.netlib.util.doubleW rt2r,
+ org.netlib.util.doubleW rt2i,
+ org.netlib.util.doubleW cs,
+ org.netlib.util.doubleW sn)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlapll(int, double[], int, double[], int, org.netlib.util.doubleW)">dlapll</A></B>(int n,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ org.netlib.util.doubleW ssmin)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlapmt(boolean, int, int, double[], int, int[])">dlapmt</A></B>(boolean forwrd,
+ int m,
+ int n,
+ double[] x,
+ int ldx,
+ int[] k)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlapy2(double, double)">dlapy2</A></B>(double x,
+ double y)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlapy3(double, double, double)">dlapy3</A></B>(double x,
+ double y,
+ double z)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqgb(int, int, int, int, double[], int, double[], double[], double, double, double, org.netlib.util.StringW)">dlaqgb</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] r,
+ double[] c,
+ double rowcnd,
+ double colcnd,
+ double amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqge(int, int, double[], int, double[], double[], double, double, double, org.netlib.util.StringW)">dlaqge</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] r,
+ double[] c,
+ double rowcnd,
+ double colcnd,
+ double amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqp2(int, int, int, double[], int, int[], double[], double[], double[], double[])">dlaqp2</A></B>(int m,
+ int n,
+ int offset,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] vn1,
+ double[] vn2,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqps(int, int, int, int, org.netlib.util.intW, double[], int, int[], double[], double[], double[], double[], double[], int)">dlaqps</A></B>(int m,
+ int n,
+ int offset,
+ int nb,
+ org.netlib.util.intW kb,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] vn1,
+ double[] vn2,
+ double[] auxv,
+ double[] f,
+ int ldf)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqr0(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, org.netlib.util.intW)">dlaqr0</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqr1(int, double[], int, double, double, double, double, double[])">dlaqr1</A></B>(int n,
+ double[] h,
+ int ldh,
+ double sr1,
+ double si1,
+ double sr2,
+ double si2,
+ double[] v)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqr2(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)">dlaqr2</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ double[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ double[] sr,
+ double[] si,
+ double[] v,
+ int ldv,
+ int nh,
+ double[] t,
+ int ldt,
+ int nv,
+ double[] wv,
+ int ldwv,
+ double[] work,
+ int lwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqr3(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)">dlaqr3</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ double[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ double[] sr,
+ double[] si,
+ double[] v,
+ int ldv,
+ int nh,
+ double[] t,
+ int ldt,
+ int nv,
+ double[] wv,
+ int ldwv,
+ double[] work,
+ int lwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqr4(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, org.netlib.util.intW)">dlaqr4</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqr5(boolean, boolean, int, int, int, int, int, double[], double[], double[], int, int, int, double[], int, double[], int, double[], int, int, double[], int, int, double[], int)">dlaqr5</A></B>(boolean wantt,
+ boolean wantz,
+ int kacc22,
+ int n,
+ int ktop,
+ int kbot,
+ int nshfts,
+ double[] sr,
+ double[] si,
+ double[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ double[] v,
+ int ldv,
+ double[] u,
+ int ldu,
+ int nv,
+ double[] wv,
+ int ldwv,
+ int nh,
+ double[] wh,
+ int ldwh)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqsb(java.lang.String, int, int, double[], int, double[], double, double, org.netlib.util.StringW)">dlaqsb</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] s,
+ double scond,
+ double amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqsp(java.lang.String, int, double[], double[], double, double, org.netlib.util.StringW)">dlaqsp</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] s,
+ double scond,
+ double amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqsy(java.lang.String, int, double[], int, double[], double, double, org.netlib.util.StringW)">dlaqsy</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] s,
+ double scond,
+ double amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaqtr(boolean, boolean, int, double[], int, double[], double, org.netlib.util.doubleW, double[], double[], org.netlib.util.intW)">dlaqtr</A></B>(boolean ltran,
+ boolean lreal,
+ int n,
+ double[] t,
+ int ldt,
+ double[] b,
+ double w,
+ org.netlib.util.doubleW scale,
+ double[] x,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlar1v(int, int, int, double, double[], double[], double[], double[], double, double, double[], boolean, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, int[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[])">dlar1v</A></B>(int n,
+ int b1,
+ int bn,
+ double lambda,
+ double[] d,
+ double[] l,
+ double[] ld,
+ double[] lld,
+ double pivmin,
+ double gaptol,
+ double[] z,
+ boolean wantnc,
+ org.netlib.util.intW negcnt,
+ org.netlib.util.doubleW ztz,
+ org.netlib.util.doubleW mingma,
+ org.netlib.util.intW r,
+ int[] isuppz,
+ org.netlib.util.doubleW nrminv,
+ org.netlib.util.doubleW resid,
+ org.netlib.util.doubleW rqcorr,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlar2v(int, double[], double[], double[], int, double[], double[], int)">dlar2v</A></B>(int n,
+ double[] x,
+ double[] y,
+ double[] z,
+ int incx,
+ double[] c,
+ double[] s,
+ int incc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarf(java.lang.String, int, int, double[], int, double, double[], int, double[])">dlarf</A></B>(java.lang.String side,
+ int m,
+ int n,
+ double[] v,
+ int incv,
+ double tau,
+ double[] c,
+ int Ldc,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarfb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int)">dlarfb</A></B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ double[] v,
+ int ldv,
+ double[] t,
+ int ldt,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int ldwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarfg(int, org.netlib.util.doubleW, double[], int, org.netlib.util.doubleW)">dlarfg</A></B>(int n,
+ org.netlib.util.doubleW alpha,
+ double[] x,
+ int incx,
+ org.netlib.util.doubleW tau)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarft(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int)">dlarft</A></B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ double[] v,
+ int ldv,
+ double[] tau,
+ double[] t,
+ int ldt)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarfx(java.lang.String, int, int, double[], double, double[], int, double[])">dlarfx</A></B>(java.lang.String side,
+ int m,
+ int n,
+ double[] v,
+ double tau,
+ double[] c,
+ int Ldc,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlargv(int, double[], int, double[], int, double[], int)">dlargv</A></B>(int n,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] c,
+ int incc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarnv(int, int[], int, double[])">dlarnv</A></B>(int idist,
+ int[] iseed,
+ int n,
+ double[] x)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarra(int, double[], double[], double[], double, double, org.netlib.util.intW, int[], org.netlib.util.intW)">dlarra</A></B>(int n,
+ double[] d,
+ double[] e,
+ double[] e2,
+ double spltol,
+ double tnrm,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrb(int, double[], double[], int, int, double, double, int, double[], double[], double[], double[], int[], double, double, int, org.netlib.util.intW)">dlarrb</A></B>(int n,
+ double[] d,
+ double[] lld,
+ int ifirst,
+ int ilast,
+ double rtol1,
+ double rtol2,
+ int offset,
+ double[] w,
+ double[] wgap,
+ double[] werr,
+ double[] work,
+ int[] iwork,
+ double pivmin,
+ double spdiam,
+ int twist,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrc(java.lang.String, int, double, double, double[], double[], double, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)">dlarrc</A></B>(java.lang.String jobt,
+ int n,
+ double vl,
+ double vu,
+ double[] d,
+ double[] e,
+ double pivmin,
+ org.netlib.util.intW eigcnt,
+ org.netlib.util.intW lcnt,
+ org.netlib.util.intW rcnt,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrd(java.lang.String, java.lang.String, int, double, double, int, int, double[], double, double[], double[], double[], double, int, int[], org.netlib.util.intW, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[], double[], int[], org.netlib.util.intW)">dlarrd</A></B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double[] gers,
+ double reltol,
+ double[] d,
+ double[] e,
+ double[] e2,
+ double pivmin,
+ int nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] werr,
+ org.netlib.util.doubleW wl,
+ org.netlib.util.doubleW wu,
+ int[] iblock,
+ int[] indexw,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarre(java.lang.String, int, org.netlib.util.doubleW, org.netlib.util.doubleW, int, int, double[], double[], double[], double, double, double, org.netlib.util.intW, int[], org.netlib.util.intW, double[], double[], double[], int[], int[], double[], org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dlarre</A></B>(java.lang.String range,
+ int n,
+ org.netlib.util.doubleW vl,
+ org.netlib.util.doubleW vu,
+ int il,
+ int iu,
+ double[] d,
+ double[] e,
+ double[] e2,
+ double rtol1,
+ double rtol2,
+ double spltol,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] werr,
+ double[] wgap,
+ int[] iblock,
+ int[] indexw,
+ double[] gers,
+ org.netlib.util.doubleW pivmin,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrf(int, double[], double[], double[], int, int, double[], double[], double[], double, double, double, double, org.netlib.util.doubleW, double[], double[], double[], org.netlib.util.intW)">dlarrf</A></B>(int n,
+ double[] d,
+ double[] l,
+ double[] ld,
+ int clstrt,
+ int clend,
+ double[] w,
+ double[] wgap,
+ double[] werr,
+ double spdiam,
+ double clgapl,
+ double clgapr,
+ double pivmin,
+ org.netlib.util.doubleW sigma,
+ double[] dplus,
+ double[] lplus,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrj(int, double[], double[], int, int, double, int, double[], double[], double[], int[], double, double, org.netlib.util.intW)">dlarrj</A></B>(int n,
+ double[] d,
+ double[] e2,
+ int ifirst,
+ int ilast,
+ double rtol,
+ int offset,
+ double[] w,
+ double[] werr,
+ double[] work,
+ int[] iwork,
+ double pivmin,
+ double spdiam,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrk(int, int, double, double, double[], double[], double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dlarrk</A></B>(int n,
+ int iw,
+ double gl,
+ double gu,
+ double[] d,
+ double[] e2,
+ double pivmin,
+ double reltol,
+ org.netlib.util.doubleW w,
+ org.netlib.util.doubleW werr,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrr(int, double[], double[], org.netlib.util.intW)">dlarrr</A></B>(int n,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarrv(int, double, double, double[], double[], double, int[], int, int, int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], double[], int[], int[], double[], double[], int, int[], double[], int[], org.netlib.util.intW)">dlarrv</A></B>(int n,
+ double vl,
+ double vu,
+ double[] d,
+ double[] l,
+ double pivmin,
+ int[] isplit,
+ int m,
+ int dol,
+ int dou,
+ double minrgp,
+ org.netlib.util.doubleW rtol1,
+ org.netlib.util.doubleW rtol2,
+ double[] w,
+ double[] werr,
+ double[] wgap,
+ int[] iblock,
+ int[] indexw,
+ double[] gers,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlartg(double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlartg</A></B>(double f,
+ double g,
+ org.netlib.util.doubleW cs,
+ org.netlib.util.doubleW sn,
+ org.netlib.util.doubleW r)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlartv(int, double[], int, double[], int, double[], double[], int)">dlartv</A></B>(int n,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] c,
+ double[] s,
+ int incc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaruv(int[], int, double[])">dlaruv</A></B>(int[] iseed,
+ int n,
+ double[] x)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarz(java.lang.String, int, int, int, double[], int, double, double[], int, double[])">dlarz</A></B>(java.lang.String side,
+ int m,
+ int n,
+ int l,
+ double[] v,
+ int incv,
+ double tau,
+ double[] c,
+ int Ldc,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarzb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], int, double[], int, double[], int)">dlarzb</A></B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ int l,
+ double[] v,
+ int ldv,
+ double[] t,
+ int ldt,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int ldwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlarzt(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int)">dlarzt</A></B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ double[] v,
+ int ldv,
+ double[] tau,
+ double[] t,
+ int ldt)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlas2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlas2</A></B>(double f,
+ double g,
+ double h,
+ org.netlib.util.doubleW ssmin,
+ org.netlib.util.doubleW ssmax)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlascl(java.lang.String, int, int, double, double, int, int, double[], int, org.netlib.util.intW)">dlascl</A></B>(java.lang.String type,
+ int kl,
+ int ku,
+ double cfrom,
+ double cto,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd0(int, int, double[], double[], double[], int, double[], int, int, int[], double[], org.netlib.util.intW)">dlasd0</A></B>(int n,
+ int sqre,
+ double[] d,
+ double[] e,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ int smlsiz,
+ int[] iwork,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd1(int, int, int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], org.netlib.util.intW)">dlasd1</A></B>(int nl,
+ int nr,
+ int sqre,
+ double[] d,
+ org.netlib.util.doubleW alpha,
+ org.netlib.util.doubleW beta,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ int[] idxq,
+ int[] iwork,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd2(int, int, int, org.netlib.util.intW, double[], double[], double, double, double[], int, double[], int, double[], double[], int, double[], int, int[], int[], int[], int[], int[], org.netlib.util.intW)">dlasd2</A></B>(int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ double[] d,
+ double[] z,
+ double alpha,
+ double beta,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] dsigma,
+ double[] u2,
+ int ldu2,
+ double[] vt2,
+ int ldvt2,
+ int[] idxp,
+ int[] idx,
+ int[] idxc,
+ int[] idxq,
+ int[] coltyp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd3(int, int, int, int, double[], double[], int, double[], double[], int, double[], int, double[], int, double[], int, int[], int[], double[], org.netlib.util.intW)">dlasd3</A></B>(int nl,
+ int nr,
+ int sqre,
+ int k,
+ double[] d,
+ double[] q,
+ int ldq,
+ double[] dsigma,
+ double[] u,
+ int ldu,
+ double[] u2,
+ int ldu2,
+ double[] vt,
+ int ldvt,
+ double[] vt2,
+ int ldvt2,
+ int[] idxc,
+ int[] ctot,
+ double[] z,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd4(int, int, double[], double[], double[], double, org.netlib.util.doubleW, double[], org.netlib.util.intW)">dlasd4</A></B>(int n,
+ int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW sigma,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd5(int, double[], double[], double[], double, org.netlib.util.doubleW, double[])">dlasd5</A></B>(int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW dsigma,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd6(int, int, int, int, double[], double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[], org.netlib.util.intW, int[], int, double[], int, double[], double[], double[], double[], org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dlasd6</A></B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ double[] d,
+ double[] vf,
+ double[] vl,
+ org.netlib.util.doubleW alpha,
+ org.netlib.util.doubleW beta,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ double[] givnum,
+ int ldgnum,
+ double[] poles,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ org.netlib.util.intW k,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW s,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd7(int, int, int, int, org.netlib.util.intW, double[], double[], double[], double[], double[], double[], double[], double, double, double[], int[], int[], int[], int[], org.netlib.util.intW, int[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dlasd7</A></B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ double[] d,
+ double[] z,
+ double[] zw,
+ double[] vf,
+ double[] vfw,
+ double[] vl,
+ double[] vlw,
+ double alpha,
+ double beta,
+ double[] dsigma,
+ int[] idx,
+ int[] idxp,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ double[] givnum,
+ int ldgnum,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW s,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasd8(int, int, double[], double[], double[], double[], double[], double[], int, double[], double[], org.netlib.util.intW)">dlasd8</A></B>(int icompq,
+ int k,
+ double[] d,
+ double[] z,
+ double[] vf,
+ double[] vl,
+ double[] difl,
+ double[] difr,
+ int lddifr,
+ double[] dsigma,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasda(int, int, int, int, double[], double[], double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], org.netlib.util.intW)">dlasda</A></B>(int icompq,
+ int smlsiz,
+ int n,
+ int sqre,
+ double[] d,
+ double[] e,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int[] k,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ double[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ double[] givnum,
+ double[] c,
+ double[] s,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasdq(java.lang.String, int, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)">dlasdq</A></B>(java.lang.String uplo,
+ int sqre,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ double[] d,
+ double[] e,
+ double[] vt,
+ int ldvt,
+ double[] u,
+ int ldu,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasdt(int, org.netlib.util.intW, org.netlib.util.intW, int[], int[], int[], int)">dlasdt</A></B>(int n,
+ org.netlib.util.intW lvl,
+ org.netlib.util.intW nd,
+ int[] inode,
+ int[] ndiml,
+ int[] ndimr,
+ int msub)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaset(java.lang.String, int, int, double, double, double[], int)">dlaset</A></B>(java.lang.String uplo,
+ int m,
+ int n,
+ double alpha,
+ double beta,
+ double[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasq1(int, double[], double[], double[], org.netlib.util.intW)">dlasq1</A></B>(int n,
+ double[] d,
+ double[] e,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasq2(int, double[], org.netlib.util.intW)">dlasq2</A></B>(int n,
+ double[] z,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasq3(int, org.netlib.util.intW, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean)">dlasq3</A></B>(int i0,
+ org.netlib.util.intW n0,
+ double[] z,
+ int pp,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW sigma,
+ org.netlib.util.doubleW desig,
+ org.netlib.util.doubleW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasq4(int, int, double[], int, int, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.intW)">dlasq4</A></B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ int n0in,
+ double dmin,
+ double dmin1,
+ double dmin2,
+ double dn,
+ double dn1,
+ double dn2,
+ org.netlib.util.doubleW tau,
+ org.netlib.util.intW ttype)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasq5(int, int, double[], int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, boolean)">dlasq5</A></B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ double tau,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW dmin1,
+ org.netlib.util.doubleW dmin2,
+ org.netlib.util.doubleW dn,
+ org.netlib.util.doubleW dnm1,
+ org.netlib.util.doubleW dnm2,
+ boolean ieee)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasq6(int, int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlasq6</A></B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW dmin1,
+ org.netlib.util.doubleW dmin2,
+ org.netlib.util.doubleW dn,
+ org.netlib.util.doubleW dnm1,
+ org.netlib.util.doubleW dnm2)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], double[], int)">dlasr</A></B>(java.lang.String side,
+ java.lang.String pivot,
+ java.lang.String direct,
+ int m,
+ int n,
+ double[] c,
+ double[] s,
+ double[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasrt(java.lang.String, int, double[], org.netlib.util.intW)">dlasrt</A></B>(java.lang.String id,
+ int n,
+ double[] d,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlassq(int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlassq</A></B>(int n,
+ double[] x,
+ int incx,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW sumsq)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasv2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlasv2</A></B>(double f,
+ double g,
+ double h,
+ org.netlib.util.doubleW ssmin,
+ org.netlib.util.doubleW ssmax,
+ org.netlib.util.doubleW snr,
+ org.netlib.util.doubleW csr,
+ org.netlib.util.doubleW snl,
+ org.netlib.util.doubleW csl)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlaswp(int, double[], int, int, int, int[], int)">dlaswp</A></B>(int n,
+ double[] a,
+ int lda,
+ int k1,
+ int k2,
+ int[] ipiv,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasy2(boolean, boolean, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, double[], int, org.netlib.util.doubleW, org.netlib.util.intW)">dlasy2</A></B>(boolean ltranl,
+ boolean ltranr,
+ int isgn,
+ int n1,
+ int n2,
+ double[] tl,
+ int ldtl,
+ double[] tr,
+ int ldtr,
+ double[] b,
+ int ldb,
+ org.netlib.util.doubleW scale,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW xnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlasyf(java.lang.String, int, int, org.netlib.util.intW, double[], int, int[], double[], int, org.netlib.util.intW)">dlasyf</A></B>(java.lang.String uplo,
+ int n,
+ int nb,
+ org.netlib.util.intW kb,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] w,
+ int ldw,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatbs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)">dlatbs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] x,
+ org.netlib.util.doubleW scale,
+ double[] cnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatdf(int, int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[])">dlatdf</A></B>(int ijob,
+ int n,
+ double[] z,
+ int ldz,
+ double[] rhs,
+ org.netlib.util.doubleW rdsum,
+ org.netlib.util.doubleW rdscal,
+ int[] ipiv,
+ int[] jpiv)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatps(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)">dlatps</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ double[] ap,
+ double[] x,
+ org.netlib.util.doubleW scale,
+ double[] cnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatrd(java.lang.String, int, int, double[], int, double[], double[], double[], int)">dlatrd</A></B>(java.lang.String uplo,
+ int n,
+ int nb,
+ double[] a,
+ int lda,
+ double[] e,
+ double[] tau,
+ double[] w,
+ int ldw)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatrs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)">dlatrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ double[] a,
+ int lda,
+ double[] x,
+ org.netlib.util.doubleW scale,
+ double[] cnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatrz(int, int, int, double[], int, double[], double[])">dlatrz</A></B>(int m,
+ int n,
+ int l,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlatzm(java.lang.String, int, int, double[], int, double, double[], double[], int, double[])">dlatzm</A></B>(java.lang.String side,
+ int m,
+ int n,
+ double[] v,
+ int incv,
+ double tau,
+ double[] c1,
+ double[] c2,
+ int Ldc,
+ double[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlauu2(java.lang.String, int, double[], int, org.netlib.util.intW)">dlauu2</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlauum(java.lang.String, int, double[], int, org.netlib.util.intW)">dlauum</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlazq3(int, org.netlib.util.intW, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)">dlazq3</A></B>(int i0,
+ org.netlib.util.intW n0,
+ double[] z,
+ int pp,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW sigma,
+ org.netlib.util.doubleW desig,
+ org.netlib.util.doubleW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee,
+ org.netlib.util.intW ttype,
+ org.netlib.util.doubleW dmin1,
+ org.netlib.util.doubleW dmin2,
+ org.netlib.util.doubleW dn,
+ org.netlib.util.doubleW dn1,
+ org.netlib.util.doubleW dn2,
+ org.netlib.util.doubleW tau)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dlazq4(int, int, double[], int, int, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW)">dlazq4</A></B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ int n0in,
+ double dmin,
+ double dmin1,
+ double dmin2,
+ double dn,
+ double dn1,
+ double dn2,
+ org.netlib.util.doubleW tau,
+ org.netlib.util.intW ttype,
+ org.netlib.util.doubleW g)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dopgtr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)">dopgtr</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] tau,
+ double[] q,
+ int ldq,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dopmtr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], double[], int, double[], org.netlib.util.intW)">dopmtr</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ double[] ap,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorg2l(int, int, int, double[], int, double[], double[], org.netlib.util.intW)">dorg2l</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorg2r(int, int, int, double[], int, double[], double[], org.netlib.util.intW)">dorg2r</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgbr(java.lang.String, int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorgbr</A></B>(java.lang.String vect,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorghr(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorghr</A></B>(int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgl2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)">dorgl2</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorglq(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorglq</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgql(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorgql</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgqr(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorgqr</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgr2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)">dorgr2</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgrq(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorgrq</A></B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorgtr(java.lang.String, int, double[], int, double[], double[], int, org.netlib.util.intW)">dorgtr</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorm2l(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dorm2l</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorm2r(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dorm2r</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormbr(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormbr</A></B>(java.lang.String vect,
+ java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormhr(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormhr</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dorml2(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dorml2</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormlq(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormlq</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormql(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormql</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormqr(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormqr</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormr2(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dormr2</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormr3(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dormr3</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormrq(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormrq</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormrz(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormrz</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dormtr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)">dormtr</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbcon(java.lang.String, int, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dpbcon</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbequ(java.lang.String, int, int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dpbequ</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] s,
+ org.netlib.util.doubleW scond,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbrfs(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dpbrfs</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbstf(java.lang.String, int, int, double[], int, org.netlib.util.intW)">dpbstf</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbsv(java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)">dpbsv</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbsvx(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dpbsvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ org.netlib.util.StringW equed,
+ double[] s,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbtf2(java.lang.String, int, int, double[], int, org.netlib.util.intW)">dpbtf2</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbtrf(java.lang.String, int, int, double[], int, org.netlib.util.intW)">dpbtrf</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpbtrs(java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)">dpbtrs</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpocon(java.lang.String, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dpocon</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpoequ(int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dpoequ</A></B>(int n,
+ double[] a,
+ int lda,
+ double[] s,
+ org.netlib.util.doubleW scond,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dporfs(java.lang.String, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dporfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dposv(java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)">dposv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dposvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dposvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ org.netlib.util.StringW equed,
+ double[] s,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpotf2(java.lang.String, int, double[], int, org.netlib.util.intW)">dpotf2</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpotrf(java.lang.String, int, double[], int, org.netlib.util.intW)">dpotrf</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpotri(java.lang.String, int, double[], int, org.netlib.util.intW)">dpotri</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpotrs(java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)">dpotrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dppcon(java.lang.String, int, double[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dppcon</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dppequ(java.lang.String, int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)">dppequ</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] s,
+ org.netlib.util.doubleW scond,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpprfs(java.lang.String, int, int, double[], double[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dpprfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dppsv(java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)">dppsv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dppsvx(java.lang.String, java.lang.String, int, int, double[], double[], org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dppsvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ org.netlib.util.StringW equed,
+ double[] s,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpptrf(java.lang.String, int, double[], org.netlib.util.intW)">dpptrf</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpptri(java.lang.String, int, double[], org.netlib.util.intW)">dpptri</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpptrs(java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)">dpptrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dptcon(int, double[], double[], double, org.netlib.util.doubleW, double[], org.netlib.util.intW)">dptcon</A></B>(int n,
+ double[] d,
+ double[] e,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpteqr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)">dpteqr</A></B>(java.lang.String compz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dptrfs(int, int, double[], double[], double[], double[], double[], int, double[], int, double[], double[], double[], org.netlib.util.intW)">dptrfs</A></B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] df,
+ double[] ef,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dptsv(int, int, double[], double[], double[], int, org.netlib.util.intW)">dptsv</A></B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dptsvx(java.lang.String, int, int, double[], double[], double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], org.netlib.util.intW)">dptsvx</A></B>(java.lang.String fact,
+ int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] df,
+ double[] ef,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpttrf(int, double[], double[], org.netlib.util.intW)">dpttrf</A></B>(int n,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dpttrs(int, int, double[], double[], double[], int, org.netlib.util.intW)">dpttrs</A></B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dptts2(int, int, double[], double[], double[], int)">dptts2</A></B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#drscl(int, double, double[], int)">drscl</A></B>(int n,
+ double sa,
+ double[] sx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbev(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dsbev</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbevd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, int[], int, org.netlib.util.intW)">dsbevd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbevx(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)">dsbevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] q,
+ int ldq,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbgst(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], org.netlib.util.intW)">dsbgst</A></B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] x,
+ int ldx,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbgv(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], int, double[], org.netlib.util.intW)">dsbgv</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbgvd(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], int, double[], int, int[], int, org.netlib.util.intW)">dsbgvd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbgvx(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)">dsbgvx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] q,
+ int ldq,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsbtrd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], double[], int, double[], org.netlib.util.intW)">dsbtrd</A></B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] d,
+ double[] e,
+ double[] q,
+ int ldq,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> double</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsecnd()">dsecnd</A></B>()</CODE>
+
+<BR>
+
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsgesv(int, int, double[], int, int[], double[], int, double[], int, double[], float[], org.netlib.util.intW, org.netlib.util.intW)">dsgesv</A></B>(int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] work,
+ float[] swork,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspcon(java.lang.String, int, double[], int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dspcon</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspev(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)">dspev</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspevd(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)">dspevd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspevx(java.lang.String, java.lang.String, java.lang.String, int, double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)">dspevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspgst(int, java.lang.String, int, double[], double[], org.netlib.util.intW)">dspgst</A></B>(int itype,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspgv(int, java.lang.String, java.lang.String, int, double[], double[], double[], double[], int, double[], org.netlib.util.intW)">dspgv</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspgvd(int, java.lang.String, java.lang.String, int, double[], double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)">dspgvd</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspgvx(int, java.lang.String, java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)">dspgvx</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsprfs(java.lang.String, int, int, double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dsprfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspsv(java.lang.String, int, int, double[], int[], double[], int, org.netlib.util.intW)">dspsv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dspsvx(java.lang.String, java.lang.String, int, int, double[], double[], int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)">dspsvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsptrd(java.lang.String, int, double[], double[], double[], double[], org.netlib.util.intW)">dsptrd</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] d,
+ double[] e,
+ double[] tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsptrf(java.lang.String, int, double[], int[], org.netlib.util.intW)">dsptrf</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsptri(java.lang.String, int, double[], int[], double[], org.netlib.util.intW)">dsptri</A></B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ int[] ipiv,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsptrs(java.lang.String, int, int, double[], int[], double[], int, org.netlib.util.intW)">dsptrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstebz(java.lang.String, java.lang.String, int, double, double, int, int, double, double[], double[], org.netlib.util.intW, org.netlib.util.intW, double[], int[], int[], double[], int[], org.netlib.util.intW)">dstebz</A></B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW m,
+ org.netlib.util.intW nsplit,
+ double[] w,
+ int[] iblock,
+ int[] isplit,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstedc(java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)">dstedc</A></B>(java.lang.String compz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstegr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)">dstegr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstein(int, double[], double[], int, double[], int[], int[], double[], int, double[], int[], int[], org.netlib.util.intW)">dstein</A></B>(int n,
+ double[] d,
+ double[] e,
+ int m,
+ double[] w,
+ int[] iblock,
+ int[] isplit,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstemr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, org.netlib.util.intW, double[], double[], int, int, int[], org.netlib.util.booleanW, double[], int, int[], int, org.netlib.util.intW)">dstemr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int nzc,
+ int[] isuppz,
+ org.netlib.util.booleanW tryrac,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsteqr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)">dsteqr</A></B>(java.lang.String compz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsterf(int, double[], double[], org.netlib.util.intW)">dsterf</A></B>(int n,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstev(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)">dstev</A></B>(java.lang.String jobz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstevd(java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)">dstevd</A></B>(java.lang.String jobz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstevr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)">dstevr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dstevx(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)">dstevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsycon(java.lang.String, int, double[], int, int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dsycon</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsyev(java.lang.String, java.lang.String, int, double[], int, double[], double[], int, org.netlib.util.intW)">dsyev</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] w,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsyevd(java.lang.String, java.lang.String, int, double[], int, double[], double[], int, int[], int, org.netlib.util.intW)">dsyevd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] w,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsyevr(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)">dsyevr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsyevx(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int, int[], int[], org.netlib.util.intW)">dsyevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsygs2(int, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW)">dsygs2</A></B>(int itype,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsygst(int, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW)">dsygst</A></B>(int itype,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsygv(int, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW)">dsygv</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] w,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsygvd(int, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], int, int[], int, org.netlib.util.intW)">dsygvd</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] w,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsygvx(int, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int, int[], int[], org.netlib.util.intW)">dsygvx</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsyrfs(java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dsyrfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsysv(java.lang.String, int, int, double[], int, int[], double[], int, double[], int, org.netlib.util.intW)">dsysv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsysvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int, int[], org.netlib.util.intW)">dsysvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsytd2(java.lang.String, int, double[], int, double[], double[], double[], org.netlib.util.intW)">dsytd2</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsytf2(java.lang.String, int, double[], int, int[], org.netlib.util.intW)">dsytf2</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsytrd(java.lang.String, int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)">dsytrd</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsytrf(java.lang.String, int, double[], int, int[], double[], int, org.netlib.util.intW)">dsytrf</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsytri(java.lang.String, int, double[], int, int[], double[], org.netlib.util.intW)">dsytri</A></B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dsytrs(java.lang.String, int, int, double[], int, int[], double[], int, org.netlib.util.intW)">dsytrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtbcon(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dtbcon</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtbrfs(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dtbrfs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtbtrs(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)">dtbtrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgevc(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], int, int, org.netlib.util.intW, double[], org.netlib.util.intW)">dtgevc</A></B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] s,
+ int lds,
+ double[] p,
+ int ldp,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgex2(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, int, int, int, double[], int, org.netlib.util.intW)">dtgex2</A></B>(boolean wantq,
+ boolean wantz,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ int j1,
+ int n1,
+ int n2,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgexc(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], int, org.netlib.util.intW)">dtgexc</A></B>(boolean wantq,
+ boolean wantz,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgsen(int, boolean, boolean, boolean[], int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], int, int[], int, org.netlib.util.intW)">dtgsen</A></B>(int ijob,
+ boolean wantq,
+ boolean wantz,
+ boolean[] select,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW m,
+ org.netlib.util.doubleW pl,
+ org.netlib.util.doubleW pr,
+ double[] dif,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgsja(java.lang.String, java.lang.String, java.lang.String, int, int, int, int, int, double[], int, double[], int, double, double, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW, org.netlib.util.intW)">dtgsja</A></B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ int k,
+ int l,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double tola,
+ double tolb,
+ double[] alpha,
+ double[] beta,
+ double[] u,
+ int ldu,
+ double[] v,
+ int ldv,
+ double[] q,
+ int ldq,
+ double[] work,
+ org.netlib.util.intW ncycle,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgsna(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)">dtgsna</A></B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] s,
+ double[] dif,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgsy2(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, int[], org.netlib.util.intW, org.netlib.util.intW)">dtgsy2</A></B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ int Ldc,
+ double[] d,
+ int ldd,
+ double[] e,
+ int lde,
+ double[] f,
+ int ldf,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW rdsum,
+ org.netlib.util.doubleW rdscal,
+ int[] iwork,
+ org.netlib.util.intW pq,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtgsyl(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], org.netlib.util.intW)">dtgsyl</A></B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ int Ldc,
+ double[] d,
+ int ldd,
+ double[] e,
+ int lde,
+ double[] f,
+ int ldf,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW dif,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtpcon(java.lang.String, java.lang.String, java.lang.String, int, double[], org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dtpcon</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtprfs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dtprfs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtptri(java.lang.String, java.lang.String, int, double[], org.netlib.util.intW)">dtptri</A></B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtptrs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)">dtptrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrcon(java.lang.String, java.lang.String, java.lang.String, int, double[], int, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)">dtrcon</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrevc(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, int, org.netlib.util.intW, double[], org.netlib.util.intW)">dtrevc</A></B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] t,
+ int ldt,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrexc(java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.intW)">dtrexc</A></B>(java.lang.String compq,
+ int n,
+ double[] t,
+ int ldt,
+ double[] q,
+ int ldq,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ double[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrrfs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)">dtrrfs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrsen(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], double[], org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], int, org.netlib.util.intW)">dtrsen</A></B>(java.lang.String job,
+ java.lang.String compq,
+ boolean[] select,
+ int n,
+ double[] t,
+ int ldt,
+ double[] q,
+ int ldq,
+ double[] wr,
+ double[] wi,
+ org.netlib.util.intW m,
+ org.netlib.util.doubleW s,
+ org.netlib.util.doubleW sep,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrsna(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)">dtrsna</A></B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] t,
+ int ldt,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] s,
+ double[] sep,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ int ldwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrsyl(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.intW)">dtrsyl</A></B>(java.lang.String trana,
+ java.lang.String tranb,
+ int isgn,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ int Ldc,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrti2(java.lang.String, java.lang.String, int, double[], int, org.netlib.util.intW)">dtrti2</A></B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrtri(java.lang.String, java.lang.String, int, double[], int, org.netlib.util.intW)">dtrtri</A></B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtrtrs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)">dtrtrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtzrqf(int, int, double[], int, double[], org.netlib.util.intW)">dtzrqf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#dtzrzf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)">dtzrzf</A></B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#getInstance()">getInstance</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ieeeck(int, float, float)">ieeeck</A></B>(int ispec,
+ float zero,
+ float one)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ilaenv(int, java.lang.String, java.lang.String, int, int, int, int)">ilaenv</A></B>(int ispec,
+ java.lang.String name,
+ java.lang.String opts,
+ int n1,
+ int n2,
+ int n3,
+ int n4)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ilaver(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)">ilaver</A></B>(org.netlib.util.intW vers_major,
+ org.netlib.util.intW vers_minor,
+ org.netlib.util.intW vers_patch)</CODE>
+
+<BR>
+
+
+
+ -- LAPACK routine (version 3.1.1) --
+ Univ.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#iparmq(int, java.lang.String, java.lang.String, int, int, int, int)">iparmq</A></B>(int ispec,
+ java.lang.String name,
+ java.lang.String opts,
+ int n,
+ int ilo,
+ int ihi,
+ int lwork)</CODE>
+
+<BR>
+
+
+
+ Purpose
+ =======
+
+ This program sets problem and machine dependent parameters
+ useful for xHSEQR and its subroutines.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#lsame(java.lang.String, java.lang.String)">lsame</A></B>(java.lang.String ca,
+ java.lang.String cb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#lsamen(int, java.lang.String, java.lang.String)">lsamen</A></B>(int n,
+ java.lang.String ca,
+ java.lang.String cb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sbdsdc(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], int, float[], int[], float[], int[], org.netlib.util.intW)">sbdsdc</A></B>(java.lang.String uplo,
+ java.lang.String compq,
+ int n,
+ float[] d,
+ float[] e,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] q,
+ int[] iq,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sbdsqr(java.lang.String, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)">sbdsqr</A></B>(java.lang.String uplo,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ float[] d,
+ float[] e,
+ float[] vt,
+ int ldvt,
+ float[] u,
+ int ldu,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sdisna(java.lang.String, int, int, float[], float[], org.netlib.util.intW)">sdisna</A></B>(java.lang.String job,
+ int m,
+ int n,
+ float[] d,
+ float[] sep,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#second()">second</A></B>()</CODE>
+
+<BR>
+
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbbrd(java.lang.String, int, int, int, int, int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)">sgbbrd</A></B>(java.lang.String vect,
+ int m,
+ int n,
+ int ncc,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] d,
+ float[] e,
+ float[] q,
+ int ldq,
+ float[] pt,
+ int ldpt,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbcon(java.lang.String, int, int, int, float[], int, int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">sgbcon</A></B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbequ(int, int, int, int, float[], int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">sgbequ</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] r,
+ float[] c,
+ org.netlib.util.floatW rowcnd,
+ org.netlib.util.floatW colcnd,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbrfs(java.lang.String, int, int, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">sgbrfs</A></B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbsv(int, int, int, int, float[], int, int[], float[], int, org.netlib.util.intW)">sgbsv</A></B>(int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbsvx(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], int, int[], org.netlib.util.StringW, float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">sgbsvx</A></B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ float[] r,
+ float[] c,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbtf2(int, int, int, int, float[], int, int[], org.netlib.util.intW)">sgbtf2</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbtrf(int, int, int, int, float[], int, int[], org.netlib.util.intW)">sgbtrf</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgbtrs(java.lang.String, int, int, int, int, float[], int, int[], float[], int, org.netlib.util.intW)">sgbtrs</A></B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgebak(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)">sgebak</A></B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ float[] scale,
+ int m,
+ float[] v,
+ int ldv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgebal(java.lang.String, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.intW)">sgebal</A></B>(java.lang.String job,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] scale,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgebd2(int, int, float[], int, float[], float[], float[], float[], float[], org.netlib.util.intW)">sgebd2</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tauq,
+ float[] taup,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgebrd(int, int, float[], int, float[], float[], float[], float[], float[], int, org.netlib.util.intW)">sgebrd</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tauq,
+ float[] taup,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgecon(java.lang.String, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">sgecon</A></B>(java.lang.String norm,
+ int n,
+ float[] a,
+ int lda,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeequ(int, int, float[], int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">sgeequ</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] r,
+ float[] c,
+ org.netlib.util.floatW rowcnd,
+ org.netlib.util.floatW colcnd,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgees(java.lang.String, java.lang.String, java.lang.Object, int, float[], int, org.netlib.util.intW, float[], float[], float[], int, float[], int, boolean[], org.netlib.util.intW)">sgees</A></B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ float[] wr,
+ float[] wi,
+ float[] vs,
+ int ldvs,
+ float[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeesx(java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, float[], int, org.netlib.util.intW, float[], float[], float[], int, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], int, boolean[], org.netlib.util.intW)">sgeesx</A></B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ float[] wr,
+ float[] wi,
+ float[] vs,
+ int ldvs,
+ org.netlib.util.floatW rconde,
+ org.netlib.util.floatW rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeev(java.lang.String, java.lang.String, int, float[], int, float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)">sgeev</A></B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ float[] a,
+ int lda,
+ float[] wr,
+ float[] wi,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.floatW, float[], float[], float[], int, int[], org.netlib.util.intW)">sgeevx</A></B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ float[] wr,
+ float[] wi,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] scale,
+ org.netlib.util.floatW abnrm,
+ float[] rconde,
+ float[] rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgegs(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)">sgegs</A></B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vsl,
+ int ldvsl,
+ float[] vsr,
+ int ldvsr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgegv(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)">sgegv</A></B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgehd2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)">sgehd2</A></B>(int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgehrd(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sgehrd</A></B>(int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgelq2(int, int, float[], int, float[], float[], org.netlib.util.intW)">sgelq2</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgelqf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sgelqf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgels(java.lang.String, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.intW)">sgels</A></B>(java.lang.String trans,
+ int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgelsd(int, int, int, float[], int, float[], int, float[], float, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)">sgelsd</A></B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] s,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgelss(int, int, int, float[], int, float[], int, float[], float, org.netlib.util.intW, float[], int, org.netlib.util.intW)">sgelss</A></B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] s,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgelsx(int, int, int, float[], int, float[], int, int[], float, org.netlib.util.intW, float[], org.netlib.util.intW)">sgelsx</A></B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ int[] jpvt,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgelsy(int, int, int, float[], int, float[], int, int[], float, org.netlib.util.intW, float[], int, org.netlib.util.intW)">sgelsy</A></B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ int[] jpvt,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeql2(int, int, float[], int, float[], float[], org.netlib.util.intW)">sgeql2</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeqlf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sgeqlf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeqp3(int, int, float[], int, int[], float[], float[], int, org.netlib.util.intW)">sgeqp3</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeqpf(int, int, float[], int, int[], float[], float[], org.netlib.util.intW)">sgeqpf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeqr2(int, int, float[], int, float[], float[], org.netlib.util.intW)">sgeqr2</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgeqrf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sgeqrf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgerfs(java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">sgerfs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgerq2(int, int, float[], int, float[], float[], org.netlib.util.intW)">sgerq2</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgerqf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sgerqf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgesc2(int, float[], int, float[], int[], int[], org.netlib.util.floatW)">sgesc2</A></B>(int n,
+ float[] a,
+ int lda,
+ float[] rhs,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.floatW scale)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgesdd(java.lang.String, int, int, float[], int, float[], float[], int, float[], int, float[], int, int[], org.netlib.util.intW)">sgesdd</A></B>(java.lang.String jobz,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] s,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgesv(int, int, float[], int, int[], float[], int, org.netlib.util.intW)">sgesv</A></B>(int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgesvd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, float[], int, org.netlib.util.intW)">sgesvd</A></B>(java.lang.String jobu,
+ java.lang.String jobvt,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] s,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgesvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, int[], org.netlib.util.StringW, float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">sgesvx</A></B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ float[] r,
+ float[] c,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgetc2(int, float[], int, int[], int[], org.netlib.util.intW)">sgetc2</A></B>(int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgetf2(int, int, float[], int, int[], org.netlib.util.intW)">sgetf2</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgetrf(int, int, float[], int, int[], org.netlib.util.intW)">sgetrf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgetri(int, float[], int, int[], float[], int, org.netlib.util.intW)">sgetri</A></B>(int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgetrs(java.lang.String, int, int, float[], int, int[], float[], int, org.netlib.util.intW)">sgetrs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggbak(java.lang.String, java.lang.String, int, int, int, float[], float[], int, float[], int, org.netlib.util.intW)">sggbak</A></B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ float[] lscale,
+ float[] rscale,
+ int m,
+ float[] v,
+ int ldv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggbal(java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], org.netlib.util.intW)">sggbal</A></B>(java.lang.String job,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] lscale,
+ float[] rscale,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgges(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, int, float[], int, float[], int, org.netlib.util.intW, float[], float[], float[], float[], int, float[], int, float[], int, boolean[], org.netlib.util.intW)">sgges</A></B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vsl,
+ int ldvsl,
+ float[] vsr,
+ int ldvsr,
+ float[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggesx(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, float[], float[], float[], float[], int, float[], int, float[], float[], float[], int, int[], int, boolean[], org.netlib.util.intW)">sggesx</A></B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vsl,
+ int ldvsl,
+ float[] vsr,
+ int ldvsr,
+ float[] rconde,
+ float[] rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggev(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)">sggev</A></B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], float[], int, int[], boolean[], org.netlib.util.intW)">sggevx</A></B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] lscale,
+ float[] rscale,
+ org.netlib.util.floatW abnrm,
+ org.netlib.util.floatW bbnrm,
+ float[] rconde,
+ float[] rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggglm(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)">sggglm</A></B>(int n,
+ int m,
+ int p,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] d,
+ float[] x,
+ float[] y,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgghrd(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.intW)">sgghrd</A></B>(java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgglse(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)">sgglse</A></B>(int m,
+ int n,
+ int p,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ float[] d,
+ float[] x,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggqrf(int, int, int, float[], int, float[], float[], int, float[], float[], int, org.netlib.util.intW)">sggqrf</A></B>(int n,
+ int m,
+ int p,
+ float[] a,
+ int lda,
+ float[] taua,
+ float[] b,
+ int ldb,
+ float[] taub,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggrqf(int, int, int, float[], int, float[], float[], int, float[], float[], int, org.netlib.util.intW)">sggrqf</A></B>(int m,
+ int p,
+ int n,
+ float[] a,
+ int lda,
+ float[] taua,
+ float[] b,
+ int ldb,
+ float[] taub,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggsvd(java.lang.String, java.lang.String, java.lang.String, int, int, int, org.netlib.util.intW, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], int[], org.netlib.util.intW)">sggsvd</A></B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int n,
+ int p,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alpha,
+ float[] beta,
+ float[] u,
+ int ldu,
+ float[] v,
+ int ldv,
+ float[] q,
+ int ldq,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sggsvp(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float, float, org.netlib.util.intW, org.netlib.util.intW, float[], int, float[], int, float[], int, int[], float[], float[], org.netlib.util.intW)">sggsvp</A></B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float tola,
+ float tolb,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ float[] u,
+ int ldu,
+ float[] v,
+ int ldv,
+ float[] q,
+ int ldq,
+ int[] iwork,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgtcon(java.lang.String, int, float[], float[], float[], float[], int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">sgtcon</A></B>(java.lang.String norm,
+ int n,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgtrfs(java.lang.String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">sgtrfs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] dlf,
+ float[] df,
+ float[] duf,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgtsv(int, int, float[], float[], float[], float[], int, org.netlib.util.intW)">sgtsv</A></B>(int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgtsvx(java.lang.String, java.lang.String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">sgtsvx</A></B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] dlf,
+ float[] df,
+ float[] duf,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgttrf(int, float[], float[], float[], float[], int[], org.netlib.util.intW)">sgttrf</A></B>(int n,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgttrs(java.lang.String, int, int, float[], float[], float[], float[], int[], float[], int, org.netlib.util.intW)">sgttrs</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sgtts2(int, int, int, float[], float[], float[], float[], int[], float[], int)">sgtts2</A></B>(int itrans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#shgeqz(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)">shgeqz</A></B>(java.lang.String job,
+ java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] t,
+ int ldt,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#shsein(java.lang.String, java.lang.String, java.lang.String, boolean[], int, float[], int, float[], float[], float[], int, float[], int, int, org.netlib.util.intW, float[], int[], int[], org.netlib.util.intW)">shsein</A></B>(java.lang.String side,
+ java.lang.String eigsrc,
+ java.lang.String initv,
+ boolean[] select,
+ int n,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ int[] ifaill,
+ int[] ifailr,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#shseqr(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], float[], int, float[], int, org.netlib.util.intW)">shseqr</A></B>(java.lang.String job,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sisnan(float)">sisnan</A></B>(float sin)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slabad(org.netlib.util.floatW, org.netlib.util.floatW)">slabad</A></B>(org.netlib.util.floatW small,
+ org.netlib.util.floatW large)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slabrd(int, int, int, float[], int, float[], float[], float[], float[], float[], int, float[], int)">slabrd</A></B>(int m,
+ int n,
+ int nb,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tauq,
+ float[] taup,
+ float[] x,
+ int ldx,
+ float[] y,
+ int ldy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slacn2(int, float[], float[], int[], org.netlib.util.floatW, org.netlib.util.intW, int[])">slacn2</A></B>(int n,
+ float[] v,
+ float[] x,
+ int[] isgn,
+ org.netlib.util.floatW est,
+ org.netlib.util.intW kase,
+ int[] isave)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slacon(int, float[], float[], int[], org.netlib.util.floatW, org.netlib.util.intW)">slacon</A></B>(int n,
+ float[] v,
+ float[] x,
+ int[] isgn,
+ org.netlib.util.floatW est,
+ org.netlib.util.intW kase)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slacpy(java.lang.String, int, int, float[], int, float[], int)">slacpy</A></B>(java.lang.String uplo,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sladiv(float, float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)">sladiv</A></B>(float a,
+ float b,
+ float c,
+ float d,
+ org.netlib.util.floatW p,
+ org.netlib.util.floatW q)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slae2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)">slae2</A></B>(float a,
+ float b,
+ float c,
+ org.netlib.util.floatW rt1,
+ org.netlib.util.floatW rt2)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaebz(int, int, int, int, int, int, float, float, float, float[], float[], float[], int[], float[], float[], org.netlib.util.intW, int[], float[], int[], org.netlib.util.intW)">slaebz</A></B>(int ijob,
+ int nitmax,
+ int n,
+ int mmax,
+ int minp,
+ int nbmin,
+ float abstol,
+ float reltol,
+ float pivmin,
+ float[] d,
+ float[] e,
+ float[] e2,
+ int[] nval,
+ float[] ab,
+ float[] c,
+ org.netlib.util.intW mout,
+ int[] nab,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed0(int, int, int, float[], float[], float[], int, float[], int, float[], int[], org.netlib.util.intW)">slaed0</A></B>(int icompq,
+ int qsiz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] q,
+ int ldq,
+ float[] qstore,
+ int ldqs,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed1(int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], int[], org.netlib.util.intW)">slaed1</A></B>(int n,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ int cutpnt,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed2(org.netlib.util.intW, int, int, float[], float[], int, int[], org.netlib.util.floatW, float[], float[], float[], float[], int[], int[], int[], int[], org.netlib.util.intW)">slaed2</A></B>(org.netlib.util.intW k,
+ int n,
+ int n1,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ float[] z,
+ float[] dlamda,
+ float[] w,
+ float[] q2,
+ int[] indx,
+ int[] indxc,
+ int[] indxp,
+ int[] coltyp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed3(int, int, int, float[], float[], int, float, float[], float[], int[], int[], float[], float[], org.netlib.util.intW)">slaed3</A></B>(int k,
+ int n,
+ int n1,
+ float[] d,
+ float[] q,
+ int ldq,
+ float rho,
+ float[] dlamda,
+ float[] q2,
+ int[] indx,
+ int[] ctot,
+ float[] w,
+ float[] s,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed4(int, int, float[], float[], float[], float, org.netlib.util.floatW, org.netlib.util.intW)">slaed4</A></B>(int n,
+ int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW dlam,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed5(int, float[], float[], float[], float, org.netlib.util.floatW)">slaed5</A></B>(int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW dlam)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed6(int, boolean, float, float[], float[], float, org.netlib.util.floatW, org.netlib.util.intW)">slaed6</A></B>(int kniter,
+ boolean orgati,
+ float rho,
+ float[] d,
+ float[] z,
+ float finit,
+ org.netlib.util.floatW tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed7(int, int, int, int, int, int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], int[], int[], int[], int[], int[], float[], float[], int[], org.netlib.util.intW)">slaed7</A></B>(int icompq,
+ int n,
+ int qsiz,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ int cutpnt,
+ float[] qstore,
+ int[] qptr,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ float[] givnum,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed8(int, org.netlib.util.intW, int, int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], float[], float[], int, float[], int[], org.netlib.util.intW, int[], float[], int[], int[], org.netlib.util.intW)">slaed8</A></B>(int icompq,
+ org.netlib.util.intW k,
+ int n,
+ int qsiz,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ int cutpnt,
+ float[] z,
+ float[] dlamda,
+ float[] q2,
+ int ldq2,
+ float[] w,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ float[] givnum,
+ int[] indxp,
+ int[] indx,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaed9(int, int, int, int, float[], float[], int, float, float[], float[], float[], int, org.netlib.util.intW)">slaed9</A></B>(int k,
+ int kstart,
+ int kstop,
+ int n,
+ float[] d,
+ float[] q,
+ int ldq,
+ float rho,
+ float[] dlamda,
+ float[] w,
+ float[] s,
+ int lds,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaeda(int, int, int, int, int[], int[], int[], int[], float[], float[], int[], float[], float[], org.netlib.util.intW)">slaeda</A></B>(int n,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ float[] givnum,
+ float[] q,
+ int[] qptr,
+ float[] z,
+ float[] ztemp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaein(boolean, boolean, int, float[], int, float, float, float[], float[], float[], int, float[], float, float, float, org.netlib.util.intW)">slaein</A></B>(boolean rightv,
+ boolean noinit,
+ int n,
+ float[] h,
+ int ldh,
+ float wr,
+ float wi,
+ float[] vr,
+ float[] vi,
+ float[] b,
+ int ldb,
+ float[] work,
+ float eps3,
+ float smlnum,
+ float bignum,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaev2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slaev2</A></B>(float a,
+ float b,
+ float c,
+ org.netlib.util.floatW rt1,
+ org.netlib.util.floatW rt2,
+ org.netlib.util.floatW cs1,
+ org.netlib.util.floatW sn1)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaexc(boolean, int, float[], int, float[], int, int, int, int, float[], org.netlib.util.intW)">slaexc</A></B>(boolean wantq,
+ int n,
+ float[] t,
+ int ldt,
+ float[] q,
+ int ldq,
+ int j1,
+ int n1,
+ int n2,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slag2(float[], int, float[], int, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slag2</A></B>(float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float safmin,
+ org.netlib.util.floatW scale1,
+ org.netlib.util.floatW scale2,
+ org.netlib.util.floatW wr1,
+ org.netlib.util.floatW wr2,
+ org.netlib.util.floatW wi)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slag2d(int, int, float[], int, double[], int, org.netlib.util.intW)">slag2d</A></B>(int m,
+ int n,
+ float[] sa,
+ int ldsa,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slags2(boolean, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slags2</A></B>(boolean upper,
+ float a1,
+ float a2,
+ float a3,
+ float b1,
+ float b2,
+ float b3,
+ org.netlib.util.floatW csu,
+ org.netlib.util.floatW snu,
+ org.netlib.util.floatW csv,
+ org.netlib.util.floatW snv,
+ org.netlib.util.floatW csq,
+ org.netlib.util.floatW snq)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slagtf(int, float[], float, float[], float[], float, float[], int[], org.netlib.util.intW)">slagtf</A></B>(int n,
+ float[] a,
+ float lambda,
+ float[] b,
+ float[] c,
+ float tol,
+ float[] d,
+ int[] in,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slagtm(java.lang.String, int, int, float, float[], float[], float[], float[], int, float, float[], int)">slagtm</A></B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float alpha,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] x,
+ int ldx,
+ float beta,
+ float[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slagts(int, int, float[], float[], float[], float[], int[], float[], org.netlib.util.floatW, org.netlib.util.intW)">slagts</A></B>(int job,
+ int n,
+ float[] a,
+ float[] b,
+ float[] c,
+ float[] d,
+ int[] in,
+ float[] y,
+ org.netlib.util.floatW tol,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slagv2(float[], int, float[], int, float[], float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slagv2</A></B>(float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ org.netlib.util.floatW csl,
+ org.netlib.util.floatW snl,
+ org.netlib.util.floatW csr,
+ org.netlib.util.floatW snr)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slahqr(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, org.netlib.util.intW)">slahqr</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slahr2(int, int, int, float[], int, float[], float[], int, float[], int)">slahr2</A></B>(int n,
+ int k,
+ int nb,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] t,
+ int ldt,
+ float[] y,
+ int ldy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slahrd(int, int, int, float[], int, float[], float[], int, float[], int)">slahrd</A></B>(int n,
+ int k,
+ int nb,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] t,
+ int ldt,
+ float[] y,
+ int ldy)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaic1(int, int, float[], float, float[], float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slaic1</A></B>(int job,
+ int j,
+ float[] x,
+ float sest,
+ float[] w,
+ float gamma,
+ org.netlib.util.floatW sestpr,
+ org.netlib.util.floatW s,
+ org.netlib.util.floatW c)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> boolean</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaisnan(float, float)">slaisnan</A></B>(float sin1,
+ float sin2)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaln2(boolean, int, int, float, float, float[], int, float, float, float[], int, float, float, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">slaln2</A></B>(boolean ltrans,
+ int na,
+ int nw,
+ float smin,
+ float ca,
+ float[] a,
+ int lda,
+ float d1,
+ float d2,
+ float[] b,
+ int ldb,
+ float wr,
+ float wi,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW xnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slals0(int, int, int, int, int, float[], int, float[], int, int[], int, int[], int, float[], int, float[], float[], float[], float[], int, float, float, float[], org.netlib.util.intW)">slals0</A></B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ int nrhs,
+ float[] b,
+ int ldb,
+ float[] bx,
+ int ldbx,
+ int[] perm,
+ int givptr,
+ int[] givcol,
+ int ldgcol,
+ float[] givnum,
+ int ldgnum,
+ float[] poles,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ int k,
+ float c,
+ float s,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slalsa(int, int, int, int, float[], int, float[], int, float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], org.netlib.util.intW)">slalsa</A></B>(int icompq,
+ int smlsiz,
+ int n,
+ int nrhs,
+ float[] b,
+ int ldb,
+ float[] bx,
+ int ldbx,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int[] k,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ float[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ float[] givnum,
+ float[] c,
+ float[] s,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slalsd(java.lang.String, int, int, int, float[], float[], float[], int, float, org.netlib.util.intW, float[], int[], org.netlib.util.intW)">slalsd</A></B>(java.lang.String uplo,
+ int smlsiz,
+ int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamc1(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.booleanW)">slamc1</A></B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.booleanW ieee1)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamc2(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW)">slamc2</A></B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.floatW eps,
+ org.netlib.util.intW emin,
+ org.netlib.util.floatW rmin,
+ org.netlib.util.intW emax,
+ org.netlib.util.floatW rmax)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamc3(float, float)">slamc3</A></B>(float a,
+ float b)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamc4(org.netlib.util.intW, float, int)">slamc4</A></B>(org.netlib.util.intW emin,
+ float start,
+ int base)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamc5(int, int, int, boolean, org.netlib.util.intW, org.netlib.util.floatW)">slamc5</A></B>(int beta,
+ int p,
+ int emin,
+ boolean ieee,
+ org.netlib.util.intW emax,
+ org.netlib.util.floatW rmax)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamch(java.lang.String)">slamch</A></B>(java.lang.String cmach)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slamrg(int, int, float[], int, int, int[])">slamrg</A></B>(int n1,
+ int n2,
+ float[] a,
+ int strd1,
+ int strd2,
+ int[] index)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> int</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaneg(int, float[], float[], float, float, int)">slaneg</A></B>(int n,
+ float[] d,
+ float[] lld,
+ float sigma,
+ float pivmin,
+ int r)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slangb(java.lang.String, int, int, int, float[], int, float[])">slangb</A></B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slange(java.lang.String, int, int, float[], int, float[])">slange</A></B>(java.lang.String norm,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slangt(java.lang.String, int, float[], float[], float[])">slangt</A></B>(java.lang.String norm,
+ int n,
+ float[] dl,
+ float[] d,
+ float[] du)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slanhs(java.lang.String, int, float[], int, float[])">slanhs</A></B>(java.lang.String norm,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slansb(java.lang.String, java.lang.String, int, int, float[], int, float[])">slansb</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ int k,
+ float[] ab,
+ int ldab,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slansp(java.lang.String, java.lang.String, int, float[], float[])">slansp</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slanst(java.lang.String, int, float[], float[])">slanst</A></B>(java.lang.String norm,
+ int n,
+ float[] d,
+ float[] e)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slansy(java.lang.String, java.lang.String, int, float[], int, float[])">slansy</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slantb(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[])">slantb</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int k,
+ float[] ab,
+ int ldab,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slantp(java.lang.String, java.lang.String, java.lang.String, int, float[], float[])">slantp</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slantr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[])">slantr</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slanv2(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slanv2</A></B>(org.netlib.util.floatW a,
+ org.netlib.util.floatW b,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW d,
+ org.netlib.util.floatW rt1r,
+ org.netlib.util.floatW rt1i,
+ org.netlib.util.floatW rt2r,
+ org.netlib.util.floatW rt2i,
+ org.netlib.util.floatW cs,
+ org.netlib.util.floatW sn)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slapll(int, float[], int, float[], int, org.netlib.util.floatW)">slapll</A></B>(int n,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ org.netlib.util.floatW ssmin)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slapmt(boolean, int, int, float[], int, int[])">slapmt</A></B>(boolean forwrd,
+ int m,
+ int n,
+ float[] x,
+ int ldx,
+ int[] k)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slapy2(float, float)">slapy2</A></B>(float x,
+ float y)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> float</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slapy3(float, float, float)">slapy3</A></B>(float x,
+ float y,
+ float z)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqgb(int, int, int, int, float[], int, float[], float[], float, float, float, org.netlib.util.StringW)">slaqgb</A></B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] r,
+ float[] c,
+ float rowcnd,
+ float colcnd,
+ float amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqge(int, int, float[], int, float[], float[], float, float, float, org.netlib.util.StringW)">slaqge</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] r,
+ float[] c,
+ float rowcnd,
+ float colcnd,
+ float amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqp2(int, int, int, float[], int, int[], float[], float[], float[], float[])">slaqp2</A></B>(int m,
+ int n,
+ int offset,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] vn1,
+ float[] vn2,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqps(int, int, int, int, org.netlib.util.intW, float[], int, int[], float[], float[], float[], float[], float[], int)">slaqps</A></B>(int m,
+ int n,
+ int offset,
+ int nb,
+ org.netlib.util.intW kb,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] vn1,
+ float[] vn2,
+ float[] auxv,
+ float[] f,
+ int ldf)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqr0(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, org.netlib.util.intW)">slaqr0</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqr1(int, float[], int, float, float, float, float, float[])">slaqr1</A></B>(int n,
+ float[] h,
+ int ldh,
+ float sr1,
+ float si1,
+ float sr2,
+ float si2,
+ float[] v)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqr2(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)">slaqr2</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ float[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ float[] sr,
+ float[] si,
+ float[] v,
+ int ldv,
+ int nh,
+ float[] t,
+ int ldt,
+ int nv,
+ float[] wv,
+ int ldwv,
+ float[] work,
+ int lwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqr3(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)">slaqr3</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ float[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ float[] sr,
+ float[] si,
+ float[] v,
+ int ldv,
+ int nh,
+ float[] t,
+ int ldt,
+ int nv,
+ float[] wv,
+ int ldwv,
+ float[] work,
+ int lwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqr4(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, org.netlib.util.intW)">slaqr4</A></B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqr5(boolean, boolean, int, int, int, int, int, float[], float[], float[], int, int, int, float[], int, float[], int, float[], int, int, float[], int, int, float[], int)">slaqr5</A></B>(boolean wantt,
+ boolean wantz,
+ int kacc22,
+ int n,
+ int ktop,
+ int kbot,
+ int nshfts,
+ float[] sr,
+ float[] si,
+ float[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ float[] v,
+ int ldv,
+ float[] u,
+ int ldu,
+ int nv,
+ float[] wv,
+ int ldwv,
+ int nh,
+ float[] wh,
+ int ldwh)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqsb(java.lang.String, int, int, float[], int, float[], float, float, org.netlib.util.StringW)">slaqsb</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] s,
+ float scond,
+ float amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqsp(java.lang.String, int, float[], float[], float, float, org.netlib.util.StringW)">slaqsp</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] s,
+ float scond,
+ float amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqsy(java.lang.String, int, float[], int, float[], float, float, org.netlib.util.StringW)">slaqsy</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] s,
+ float scond,
+ float amax,
+ org.netlib.util.StringW equed)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaqtr(boolean, boolean, int, float[], int, float[], float, org.netlib.util.floatW, float[], float[], org.netlib.util.intW)">slaqtr</A></B>(boolean ltran,
+ boolean lreal,
+ int n,
+ float[] t,
+ int ldt,
+ float[] b,
+ float w,
+ org.netlib.util.floatW scale,
+ float[] x,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slar1v(int, int, int, float, float[], float[], float[], float[], float, float, float[], boolean, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, int[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, float[])">slar1v</A></B>(int n,
+ int b1,
+ int bn,
+ float lambda,
+ float[] d,
+ float[] l,
+ float[] ld,
+ float[] lld,
+ float pivmin,
+ float gaptol,
+ float[] z,
+ boolean wantnc,
+ org.netlib.util.intW negcnt,
+ org.netlib.util.floatW ztz,
+ org.netlib.util.floatW mingma,
+ org.netlib.util.intW r,
+ int[] isuppz,
+ org.netlib.util.floatW nrminv,
+ org.netlib.util.floatW resid,
+ org.netlib.util.floatW rqcorr,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slar2v(int, float[], float[], float[], int, float[], float[], int)">slar2v</A></B>(int n,
+ float[] x,
+ float[] y,
+ float[] z,
+ int incx,
+ float[] c,
+ float[] s,
+ int incc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarf(java.lang.String, int, int, float[], int, float, float[], int, float[])">slarf</A></B>(java.lang.String side,
+ int m,
+ int n,
+ float[] v,
+ int incv,
+ float tau,
+ float[] c,
+ int Ldc,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarfb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int)">slarfb</A></B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ float[] v,
+ int ldv,
+ float[] t,
+ int ldt,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int ldwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarfg(int, org.netlib.util.floatW, float[], int, org.netlib.util.floatW)">slarfg</A></B>(int n,
+ org.netlib.util.floatW alpha,
+ float[] x,
+ int incx,
+ org.netlib.util.floatW tau)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarft(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int)">slarft</A></B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ float[] v,
+ int ldv,
+ float[] tau,
+ float[] t,
+ int ldt)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarfx(java.lang.String, int, int, float[], float, float[], int, float[])">slarfx</A></B>(java.lang.String side,
+ int m,
+ int n,
+ float[] v,
+ float tau,
+ float[] c,
+ int Ldc,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slargv(int, float[], int, float[], int, float[], int)">slargv</A></B>(int n,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] c,
+ int incc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarnv(int, int[], int, float[])">slarnv</A></B>(int idist,
+ int[] iseed,
+ int n,
+ float[] x)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarra(int, float[], float[], float[], float, float, org.netlib.util.intW, int[], org.netlib.util.intW)">slarra</A></B>(int n,
+ float[] d,
+ float[] e,
+ float[] e2,
+ float spltol,
+ float tnrm,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrb(int, float[], float[], int, int, float, float, int, float[], float[], float[], float[], int[], float, float, int, org.netlib.util.intW)">slarrb</A></B>(int n,
+ float[] d,
+ float[] lld,
+ int ifirst,
+ int ilast,
+ float rtol1,
+ float rtol2,
+ int offset,
+ float[] w,
+ float[] wgap,
+ float[] werr,
+ float[] work,
+ int[] iwork,
+ float pivmin,
+ float spdiam,
+ int twist,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrc(java.lang.String, int, float, float, float[], float[], float, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)">slarrc</A></B>(java.lang.String jobt,
+ int n,
+ float vl,
+ float vu,
+ float[] d,
+ float[] e,
+ float pivmin,
+ org.netlib.util.intW eigcnt,
+ org.netlib.util.intW lcnt,
+ org.netlib.util.intW rcnt,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrd(java.lang.String, java.lang.String, int, float, float, int, int, float[], float, float[], float[], float[], float, int, int[], org.netlib.util.intW, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[], float[], int[], org.netlib.util.intW)">slarrd</A></B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float[] gers,
+ float reltol,
+ float[] d,
+ float[] e,
+ float[] e2,
+ float pivmin,
+ int nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] werr,
+ org.netlib.util.floatW wl,
+ org.netlib.util.floatW wu,
+ int[] iblock,
+ int[] indexw,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarre(java.lang.String, int, org.netlib.util.floatW, org.netlib.util.floatW, int, int, float[], float[], float[], float, float, float, org.netlib.util.intW, int[], org.netlib.util.intW, float[], float[], float[], int[], int[], float[], org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">slarre</A></B>(java.lang.String range,
+ int n,
+ org.netlib.util.floatW vl,
+ org.netlib.util.floatW vu,
+ int il,
+ int iu,
+ float[] d,
+ float[] e,
+ float[] e2,
+ float rtol1,
+ float rtol2,
+ float spltol,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] werr,
+ float[] wgap,
+ int[] iblock,
+ int[] indexw,
+ float[] gers,
+ org.netlib.util.floatW pivmin,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrf(int, float[], float[], float[], int, int, float[], float[], float[], float, float, float, float, org.netlib.util.floatW, float[], float[], float[], org.netlib.util.intW)">slarrf</A></B>(int n,
+ float[] d,
+ float[] l,
+ float[] ld,
+ int clstrt,
+ int clend,
+ float[] w,
+ float[] wgap,
+ float[] werr,
+ float spdiam,
+ float clgapl,
+ float clgapr,
+ float pivmin,
+ org.netlib.util.floatW sigma,
+ float[] dplus,
+ float[] lplus,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrj(int, float[], float[], int, int, float, int, float[], float[], float[], int[], float, float, org.netlib.util.intW)">slarrj</A></B>(int n,
+ float[] d,
+ float[] e2,
+ int ifirst,
+ int ilast,
+ float rtol,
+ int offset,
+ float[] w,
+ float[] werr,
+ float[] work,
+ int[] iwork,
+ float pivmin,
+ float spdiam,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrk(int, int, float, float, float[], float[], float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">slarrk</A></B>(int n,
+ int iw,
+ float gl,
+ float gu,
+ float[] d,
+ float[] e2,
+ float pivmin,
+ float reltol,
+ org.netlib.util.floatW w,
+ org.netlib.util.floatW werr,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrr(int, float[], float[], org.netlib.util.intW)">slarrr</A></B>(int n,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarrv(int, float, float, float[], float[], float, int[], int, int, int, float, org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], float[], int[], int[], float[], float[], int, int[], float[], int[], org.netlib.util.intW)">slarrv</A></B>(int n,
+ float vl,
+ float vu,
+ float[] d,
+ float[] l,
+ float pivmin,
+ int[] isplit,
+ int m,
+ int dol,
+ int dou,
+ float minrgp,
+ org.netlib.util.floatW rtol1,
+ org.netlib.util.floatW rtol2,
+ float[] w,
+ float[] werr,
+ float[] wgap,
+ int[] iblock,
+ int[] indexw,
+ float[] gers,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slartg(float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slartg</A></B>(float f,
+ float g,
+ org.netlib.util.floatW cs,
+ org.netlib.util.floatW sn,
+ org.netlib.util.floatW r)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slartv(int, float[], int, float[], int, float[], float[], int)">slartv</A></B>(int n,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] c,
+ float[] s,
+ int incc)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaruv(int[], int, float[])">slaruv</A></B>(int[] iseed,
+ int n,
+ float[] x)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarz(java.lang.String, int, int, int, float[], int, float, float[], int, float[])">slarz</A></B>(java.lang.String side,
+ int m,
+ int n,
+ int l,
+ float[] v,
+ int incv,
+ float tau,
+ float[] c,
+ int Ldc,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarzb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], int, float[], int, float[], int)">slarzb</A></B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ int l,
+ float[] v,
+ int ldv,
+ float[] t,
+ int ldt,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int ldwork)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slarzt(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int)">slarzt</A></B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ float[] v,
+ int ldv,
+ float[] tau,
+ float[] t,
+ int ldt)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slas2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)">slas2</A></B>(float f,
+ float g,
+ float h,
+ org.netlib.util.floatW ssmin,
+ org.netlib.util.floatW ssmax)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slascl(java.lang.String, int, int, float, float, int, int, float[], int, org.netlib.util.intW)">slascl</A></B>(java.lang.String type,
+ int kl,
+ int ku,
+ float cfrom,
+ float cto,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd0(int, int, float[], float[], float[], int, float[], int, int, int[], float[], org.netlib.util.intW)">slasd0</A></B>(int n,
+ int sqre,
+ float[] d,
+ float[] e,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ int smlsiz,
+ int[] iwork,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd1(int, int, int, float[], org.netlib.util.floatW, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], org.netlib.util.intW)">slasd1</A></B>(int nl,
+ int nr,
+ int sqre,
+ float[] d,
+ org.netlib.util.floatW alpha,
+ org.netlib.util.floatW beta,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ int[] idxq,
+ int[] iwork,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd2(int, int, int, org.netlib.util.intW, float[], float[], float, float, float[], int, float[], int, float[], float[], int, float[], int, int[], int[], int[], int[], int[], org.netlib.util.intW)">slasd2</A></B>(int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ float[] d,
+ float[] z,
+ float alpha,
+ float beta,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] dsigma,
+ float[] u2,
+ int ldu2,
+ float[] vt2,
+ int ldvt2,
+ int[] idxp,
+ int[] idx,
+ int[] idxc,
+ int[] idxq,
+ int[] coltyp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd3(int, int, int, int, float[], float[], int, float[], float[], int, float[], int, float[], int, float[], int, int[], int[], float[], org.netlib.util.intW)">slasd3</A></B>(int nl,
+ int nr,
+ int sqre,
+ int k,
+ float[] d,
+ float[] q,
+ int ldq,
+ float[] dsigma,
+ float[] u,
+ int ldu,
+ float[] u2,
+ int ldu2,
+ float[] vt,
+ int ldvt,
+ float[] vt2,
+ int ldvt2,
+ int[] idxc,
+ int[] ctot,
+ float[] z,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd4(int, int, float[], float[], float[], float, org.netlib.util.floatW, float[], org.netlib.util.intW)">slasd4</A></B>(int n,
+ int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW sigma,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd5(int, float[], float[], float[], float, org.netlib.util.floatW, float[])">slasd5</A></B>(int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW dsigma,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd6(int, int, int, int, float[], float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[], org.netlib.util.intW, int[], int, float[], int, float[], float[], float[], float[], org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">slasd6</A></B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ float[] d,
+ float[] vf,
+ float[] vl,
+ org.netlib.util.floatW alpha,
+ org.netlib.util.floatW beta,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ float[] givnum,
+ int ldgnum,
+ float[] poles,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ org.netlib.util.intW k,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW s,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd7(int, int, int, int, org.netlib.util.intW, float[], float[], float[], float[], float[], float[], float[], float, float, float[], int[], int[], int[], int[], org.netlib.util.intW, int[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">slasd7</A></B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ float[] d,
+ float[] z,
+ float[] zw,
+ float[] vf,
+ float[] vfw,
+ float[] vl,
+ float[] vlw,
+ float alpha,
+ float beta,
+ float[] dsigma,
+ int[] idx,
+ int[] idxp,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ float[] givnum,
+ int ldgnum,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW s,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasd8(int, int, float[], float[], float[], float[], float[], float[], int, float[], float[], org.netlib.util.intW)">slasd8</A></B>(int icompq,
+ int k,
+ float[] d,
+ float[] z,
+ float[] vf,
+ float[] vl,
+ float[] difl,
+ float[] difr,
+ int lddifr,
+ float[] dsigma,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasda(int, int, int, int, float[], float[], float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], org.netlib.util.intW)">slasda</A></B>(int icompq,
+ int smlsiz,
+ int n,
+ int sqre,
+ float[] d,
+ float[] e,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int[] k,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ float[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ float[] givnum,
+ float[] c,
+ float[] s,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasdq(java.lang.String, int, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)">slasdq</A></B>(java.lang.String uplo,
+ int sqre,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ float[] d,
+ float[] e,
+ float[] vt,
+ int ldvt,
+ float[] u,
+ int ldu,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasdt(int, org.netlib.util.intW, org.netlib.util.intW, int[], int[], int[], int)">slasdt</A></B>(int n,
+ org.netlib.util.intW lvl,
+ org.netlib.util.intW nd,
+ int[] inode,
+ int[] ndiml,
+ int[] ndimr,
+ int msub)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaset(java.lang.String, int, int, float, float, float[], int)">slaset</A></B>(java.lang.String uplo,
+ int m,
+ int n,
+ float alpha,
+ float beta,
+ float[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasq1(int, float[], float[], float[], org.netlib.util.intW)">slasq1</A></B>(int n,
+ float[] d,
+ float[] e,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasq2(int, float[], org.netlib.util.intW)">slasq2</A></B>(int n,
+ float[] z,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasq3(int, org.netlib.util.intW, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean)">slasq3</A></B>(int i0,
+ org.netlib.util.intW n0,
+ float[] z,
+ int pp,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW sigma,
+ org.netlib.util.floatW desig,
+ org.netlib.util.floatW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasq4(int, int, float[], int, int, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.intW)">slasq4</A></B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ int n0in,
+ float dmin,
+ float dmin1,
+ float dmin2,
+ float dn,
+ float dn1,
+ float dn2,
+ org.netlib.util.floatW tau,
+ org.netlib.util.intW ttype)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasq5(int, int, float[], int, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, boolean)">slasq5</A></B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ float tau,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW dmin1,
+ org.netlib.util.floatW dmin2,
+ org.netlib.util.floatW dn,
+ org.netlib.util.floatW dnm1,
+ org.netlib.util.floatW dnm2,
+ boolean ieee)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasq6(int, int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slasq6</A></B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW dmin1,
+ org.netlib.util.floatW dmin2,
+ org.netlib.util.floatW dn,
+ org.netlib.util.floatW dnm1,
+ org.netlib.util.floatW dnm2)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], float[], int)">slasr</A></B>(java.lang.String side,
+ java.lang.String pivot,
+ java.lang.String direct,
+ int m,
+ int n,
+ float[] c,
+ float[] s,
+ float[] a,
+ int lda)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasrt(java.lang.String, int, float[], org.netlib.util.intW)">slasrt</A></B>(java.lang.String id,
+ int n,
+ float[] d,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slassq(int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW)">slassq</A></B>(int n,
+ float[] x,
+ int incx,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW sumsq)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasv2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slasv2</A></B>(float f,
+ float g,
+ float h,
+ org.netlib.util.floatW ssmin,
+ org.netlib.util.floatW ssmax,
+ org.netlib.util.floatW snr,
+ org.netlib.util.floatW csr,
+ org.netlib.util.floatW snl,
+ org.netlib.util.floatW csl)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slaswp(int, float[], int, int, int, int[], int)">slaswp</A></B>(int n,
+ float[] a,
+ int lda,
+ int k1,
+ int k2,
+ int[] ipiv,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasy2(boolean, boolean, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.floatW, float[], int, org.netlib.util.floatW, org.netlib.util.intW)">slasy2</A></B>(boolean ltranl,
+ boolean ltranr,
+ int isgn,
+ int n1,
+ int n2,
+ float[] tl,
+ int ldtl,
+ float[] tr,
+ int ldtr,
+ float[] b,
+ int ldb,
+ org.netlib.util.floatW scale,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW xnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slasyf(java.lang.String, int, int, org.netlib.util.intW, float[], int, int[], float[], int, org.netlib.util.intW)">slasyf</A></B>(java.lang.String uplo,
+ int n,
+ int nb,
+ org.netlib.util.intW kb,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] w,
+ int ldw,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatbs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], org.netlib.util.floatW, float[], org.netlib.util.intW)">slatbs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] x,
+ org.netlib.util.floatW scale,
+ float[] cnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatdf(int, int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[])">slatdf</A></B>(int ijob,
+ int n,
+ float[] z,
+ int ldz,
+ float[] rhs,
+ org.netlib.util.floatW rdsum,
+ org.netlib.util.floatW rdscal,
+ int[] ipiv,
+ int[] jpiv)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatps(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], float[], org.netlib.util.floatW, float[], org.netlib.util.intW)">slatps</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ float[] ap,
+ float[] x,
+ org.netlib.util.floatW scale,
+ float[] cnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatrd(java.lang.String, int, int, float[], int, float[], float[], float[], int)">slatrd</A></B>(java.lang.String uplo,
+ int n,
+ int nb,
+ float[] a,
+ int lda,
+ float[] e,
+ float[] tau,
+ float[] w,
+ int ldw)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatrs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], org.netlib.util.floatW, float[], org.netlib.util.intW)">slatrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ float[] a,
+ int lda,
+ float[] x,
+ org.netlib.util.floatW scale,
+ float[] cnorm,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatrz(int, int, int, float[], int, float[], float[])">slatrz</A></B>(int m,
+ int n,
+ int l,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slatzm(java.lang.String, int, int, float[], int, float, float[], float[], int, float[])">slatzm</A></B>(java.lang.String side,
+ int m,
+ int n,
+ float[] v,
+ int incv,
+ float tau,
+ float[] c1,
+ float[] c2,
+ int Ldc,
+ float[] work)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slauu2(java.lang.String, int, float[], int, org.netlib.util.intW)">slauu2</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slauum(java.lang.String, int, float[], int, org.netlib.util.intW)">slauum</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slazq3(int, org.netlib.util.intW, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)">slazq3</A></B>(int i0,
+ org.netlib.util.intW n0,
+ float[] z,
+ int pp,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW sigma,
+ org.netlib.util.floatW desig,
+ org.netlib.util.floatW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee,
+ org.netlib.util.intW ttype,
+ org.netlib.util.floatW dmin1,
+ org.netlib.util.floatW dmin2,
+ org.netlib.util.floatW dn,
+ org.netlib.util.floatW dn1,
+ org.netlib.util.floatW dn2,
+ org.netlib.util.floatW tau)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#slazq4(int, int, float[], int, int, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW)">slazq4</A></B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ int n0in,
+ float dmin,
+ float dmin1,
+ float dmin2,
+ float dn,
+ float dn1,
+ float dn2,
+ org.netlib.util.floatW tau,
+ org.netlib.util.intW ttype,
+ org.netlib.util.floatW g)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sopgtr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)">sopgtr</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] tau,
+ float[] q,
+ int ldq,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sopmtr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], float[], int, float[], org.netlib.util.intW)">sopmtr</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ float[] ap,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorg2l(int, int, int, float[], int, float[], float[], org.netlib.util.intW)">sorg2l</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorg2r(int, int, int, float[], int, float[], float[], org.netlib.util.intW)">sorg2r</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgbr(java.lang.String, int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorgbr</A></B>(java.lang.String vect,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorghr(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorghr</A></B>(int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgl2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)">sorgl2</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorglq(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorglq</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgql(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorgql</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgqr(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorgqr</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgr2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)">sorgr2</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgrq(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorgrq</A></B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorgtr(java.lang.String, int, float[], int, float[], float[], int, org.netlib.util.intW)">sorgtr</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorm2l(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">sorm2l</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorm2r(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">sorm2r</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormbr(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormbr</A></B>(java.lang.String vect,
+ java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormhr(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormhr</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sorml2(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">sorml2</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormlq(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormlq</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormql(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormql</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormqr(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormqr</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormr2(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">sormr2</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormr3(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">sormr3</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormrq(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormrq</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormrz(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormrz</A></B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sormtr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)">sormtr</A></B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbcon(java.lang.String, int, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">spbcon</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbequ(java.lang.String, int, int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">spbequ</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] s,
+ org.netlib.util.floatW scond,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbrfs(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">spbrfs</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbstf(java.lang.String, int, int, float[], int, org.netlib.util.intW)">spbstf</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbsv(java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)">spbsv</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbsvx(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">spbsvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ org.netlib.util.StringW equed,
+ float[] s,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbtf2(java.lang.String, int, int, float[], int, org.netlib.util.intW)">spbtf2</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbtrf(java.lang.String, int, int, float[], int, org.netlib.util.intW)">spbtrf</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spbtrs(java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)">spbtrs</A></B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spocon(java.lang.String, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">spocon</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spoequ(int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">spoequ</A></B>(int n,
+ float[] a,
+ int lda,
+ float[] s,
+ org.netlib.util.floatW scond,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sporfs(java.lang.String, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">sporfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sposv(java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)">sposv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sposvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">sposvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ org.netlib.util.StringW equed,
+ float[] s,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spotf2(java.lang.String, int, float[], int, org.netlib.util.intW)">spotf2</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spotrf(java.lang.String, int, float[], int, org.netlib.util.intW)">spotrf</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spotri(java.lang.String, int, float[], int, org.netlib.util.intW)">spotri</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spotrs(java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)">spotrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sppcon(java.lang.String, int, float[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">sppcon</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sppequ(java.lang.String, int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)">sppequ</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] s,
+ org.netlib.util.floatW scond,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spprfs(java.lang.String, int, int, float[], float[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">spprfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sppsv(java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)">sppsv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sppsvx(java.lang.String, java.lang.String, int, int, float[], float[], org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">sppsvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ org.netlib.util.StringW equed,
+ float[] s,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spptrf(java.lang.String, int, float[], org.netlib.util.intW)">spptrf</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spptri(java.lang.String, int, float[], org.netlib.util.intW)">spptri</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spptrs(java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)">spptrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sptcon(int, float[], float[], float, org.netlib.util.floatW, float[], org.netlib.util.intW)">sptcon</A></B>(int n,
+ float[] d,
+ float[] e,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spteqr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)">spteqr</A></B>(java.lang.String compz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sptrfs(int, int, float[], float[], float[], float[], float[], int, float[], int, float[], float[], float[], org.netlib.util.intW)">sptrfs</A></B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] df,
+ float[] ef,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sptsv(int, int, float[], float[], float[], int, org.netlib.util.intW)">sptsv</A></B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sptsvx(java.lang.String, int, int, float[], float[], float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], org.netlib.util.intW)">sptsvx</A></B>(java.lang.String fact,
+ int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] df,
+ float[] ef,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spttrf(int, float[], float[], org.netlib.util.intW)">spttrf</A></B>(int n,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#spttrs(int, int, float[], float[], float[], int, org.netlib.util.intW)">spttrs</A></B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sptts2(int, int, float[], float[], float[], int)">sptts2</A></B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#srscl(int, float, float[], int)">srscl</A></B>(int n,
+ float sa,
+ float[] sx,
+ int incx)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbev(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">ssbev</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbevd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, int[], int, org.netlib.util.intW)">ssbevd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbevx(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)">ssbevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] q,
+ int ldq,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbgst(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], org.netlib.util.intW)">ssbgst</A></B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] x,
+ int ldx,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbgv(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], int, float[], org.netlib.util.intW)">ssbgv</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbgvd(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], int, float[], int, int[], int, org.netlib.util.intW)">ssbgvd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbgvx(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)">ssbgvx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] q,
+ int ldq,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssbtrd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], float[], int, float[], org.netlib.util.intW)">ssbtrd</A></B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] d,
+ float[] e,
+ float[] q,
+ int ldq,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspcon(java.lang.String, int, float[], int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">sspcon</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspev(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)">sspev</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspevd(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)">sspevd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspevx(java.lang.String, java.lang.String, java.lang.String, int, float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)">sspevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspgst(int, java.lang.String, int, float[], float[], org.netlib.util.intW)">sspgst</A></B>(int itype,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspgv(int, java.lang.String, java.lang.String, int, float[], float[], float[], float[], int, float[], org.netlib.util.intW)">sspgv</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspgvd(int, java.lang.String, java.lang.String, int, float[], float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)">sspgvd</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspgvx(int, java.lang.String, java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)">sspgvx</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssprfs(java.lang.String, int, int, float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">ssprfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspsv(java.lang.String, int, int, float[], int[], float[], int, org.netlib.util.intW)">sspsv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sspsvx(java.lang.String, java.lang.String, int, int, float[], float[], int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)">sspsvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssptrd(java.lang.String, int, float[], float[], float[], float[], org.netlib.util.intW)">ssptrd</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] d,
+ float[] e,
+ float[] tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssptrf(java.lang.String, int, float[], int[], org.netlib.util.intW)">ssptrf</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssptri(java.lang.String, int, float[], int[], float[], org.netlib.util.intW)">ssptri</A></B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ int[] ipiv,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssptrs(java.lang.String, int, int, float[], int[], float[], int, org.netlib.util.intW)">ssptrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstebz(java.lang.String, java.lang.String, int, float, float, int, int, float, float[], float[], org.netlib.util.intW, org.netlib.util.intW, float[], int[], int[], float[], int[], org.netlib.util.intW)">sstebz</A></B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW m,
+ org.netlib.util.intW nsplit,
+ float[] w,
+ int[] iblock,
+ int[] isplit,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstedc(java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)">sstedc</A></B>(java.lang.String compz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstegr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)">sstegr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstein(int, float[], float[], int, float[], int[], int[], float[], int, float[], int[], int[], org.netlib.util.intW)">sstein</A></B>(int n,
+ float[] d,
+ float[] e,
+ int m,
+ float[] w,
+ int[] iblock,
+ int[] isplit,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE> void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstemr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, org.netlib.util.intW, float[], float[], int, int, int[], org.netlib.util.booleanW, float[], int, int[], int, org.netlib.util.intW)">sstemr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int nzc,
+ int[] isuppz,
+ org.netlib.util.booleanW tryrac,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssteqr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)">ssteqr</A></B>(java.lang.String compz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssterf(int, float[], float[], org.netlib.util.intW)">ssterf</A></B>(int n,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstev(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)">sstev</A></B>(java.lang.String jobz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstevd(java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)">sstevd</A></B>(java.lang.String jobz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstevr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)">sstevr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#sstevx(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)">sstevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssycon(java.lang.String, int, float[], int, int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">ssycon</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssyev(java.lang.String, java.lang.String, int, float[], int, float[], float[], int, org.netlib.util.intW)">ssyev</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] w,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssyevd(java.lang.String, java.lang.String, int, float[], int, float[], float[], int, int[], int, org.netlib.util.intW)">ssyevd</A></B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] w,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssyevr(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)">ssyevr</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssyevx(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int, int[], int[], org.netlib.util.intW)">ssyevx</A></B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssygs2(int, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW)">ssygs2</A></B>(int itype,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssygst(int, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW)">ssygst</A></B>(int itype,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssygv(int, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW)">ssygv</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] w,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssygvd(int, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], int, int[], int, org.netlib.util.intW)">ssygvd</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] w,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssygvx(int, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int, int[], int[], org.netlib.util.intW)">ssygvx</A></B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssyrfs(java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">ssyrfs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssysv(java.lang.String, int, int, float[], int, int[], float[], int, float[], int, org.netlib.util.intW)">ssysv</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssysvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int, int[], org.netlib.util.intW)">ssysvx</A></B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssytd2(java.lang.String, int, float[], int, float[], float[], float[], org.netlib.util.intW)">ssytd2</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssytf2(java.lang.String, int, float[], int, int[], org.netlib.util.intW)">ssytf2</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssytrd(java.lang.String, int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)">ssytrd</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssytrf(java.lang.String, int, float[], int, int[], float[], int, org.netlib.util.intW)">ssytrf</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssytri(java.lang.String, int, float[], int, int[], float[], org.netlib.util.intW)">ssytri</A></B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#ssytrs(java.lang.String, int, int, float[], int, int[], float[], int, org.netlib.util.intW)">ssytrs</A></B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stbcon(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">stbcon</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stbrfs(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">stbrfs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stbtrs(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)">stbtrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgevc(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], int, int, org.netlib.util.intW, float[], org.netlib.util.intW)">stgevc</A></B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] s,
+ int lds,
+ float[] p,
+ int ldp,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgex2(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, int, int, int, float[], int, org.netlib.util.intW)">stgex2</A></B>(boolean wantq,
+ boolean wantz,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ int j1,
+ int n1,
+ int n2,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgexc(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], int, org.netlib.util.intW)">stgexc</A></B>(boolean wantq,
+ boolean wantz,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgsen(int, boolean, boolean, boolean[], int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], int, int[], int, org.netlib.util.intW)">stgsen</A></B>(int ijob,
+ boolean wantq,
+ boolean wantz,
+ boolean[] select,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW m,
+ org.netlib.util.floatW pl,
+ org.netlib.util.floatW pr,
+ float[] dif,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgsja(java.lang.String, java.lang.String, java.lang.String, int, int, int, int, int, float[], int, float[], int, float, float, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW, org.netlib.util.intW)">stgsja</A></B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ int k,
+ int l,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float tola,
+ float tolb,
+ float[] alpha,
+ float[] beta,
+ float[] u,
+ int ldu,
+ float[] v,
+ int ldv,
+ float[] q,
+ int ldq,
+ float[] work,
+ org.netlib.util.intW ncycle,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgsna(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)">stgsna</A></B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] s,
+ float[] dif,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgsy2(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, int[], org.netlib.util.intW, org.netlib.util.intW)">stgsy2</A></B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ int Ldc,
+ float[] d,
+ int ldd,
+ float[] e,
+ int lde,
+ float[] f,
+ int ldf,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW rdsum,
+ org.netlib.util.floatW rdscal,
+ int[] iwork,
+ org.netlib.util.intW pq,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stgsyl(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], org.netlib.util.intW)">stgsyl</A></B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ int Ldc,
+ float[] d,
+ int ldd,
+ float[] e,
+ int lde,
+ float[] f,
+ int ldf,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW dif,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stpcon(java.lang.String, java.lang.String, java.lang.String, int, float[], org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">stpcon</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stprfs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">stprfs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stptri(java.lang.String, java.lang.String, int, float[], org.netlib.util.intW)">stptri</A></B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stptrs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)">stptrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strcon(java.lang.String, java.lang.String, java.lang.String, int, float[], int, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)">strcon</A></B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strevc(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, int, org.netlib.util.intW, float[], org.netlib.util.intW)">strevc</A></B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] t,
+ int ldt,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strexc(java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.intW)">strexc</A></B>(java.lang.String compq,
+ int n,
+ float[] t,
+ int ldt,
+ float[] q,
+ int ldq,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ float[] work,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strrfs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)">strrfs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strsen(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], float[], org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], int, org.netlib.util.intW)">strsen</A></B>(java.lang.String job,
+ java.lang.String compq,
+ boolean[] select,
+ int n,
+ float[] t,
+ int ldt,
+ float[] q,
+ int ldq,
+ float[] wr,
+ float[] wi,
+ org.netlib.util.intW m,
+ org.netlib.util.floatW s,
+ org.netlib.util.floatW sep,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strsna(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)">strsna</A></B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] t,
+ int ldt,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] s,
+ float[] sep,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ int ldwork,
+ int[] iwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strsyl(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.intW)">strsyl</A></B>(java.lang.String trana,
+ java.lang.String tranb,
+ int isgn,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ int Ldc,
+ org.netlib.util.floatW scale,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strti2(java.lang.String, java.lang.String, int, float[], int, org.netlib.util.intW)">strti2</A></B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strtri(java.lang.String, java.lang.String, int, float[], int, org.netlib.util.intW)">strtri</A></B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#strtrs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)">strtrs</A></B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stzrqf(int, int, float[], int, float[], org.netlib.util.intW)">stzrqf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>abstract void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/lapack/LAPACK.html#stzrzf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)">stzrzf</A></B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</CODE>
+
+<BR>
+
+
+ ..</TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Object"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Object</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>clone, equals, finalize, getClass, hashCode, notify, notifyAll, toString, wait, wait, wait</CODE></TD>
+</TR>
+</TABLE>
+
+<P>
+
+<!-- ========= CONSTRUCTOR DETAIL ======== -->
+
+<A NAME="constructor_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Constructor Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="LAPACK()"><!-- --></A><H3>
+LAPACK</H3>
+<PRE>
+public <B>LAPACK</B>()</PRE>
+<DL>
+</DL>
+
+<!-- ============ METHOD DETAIL ========== -->
+
+<A NAME="method_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Method Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="getInstance()"><!-- --></A><H3>
+getInstance</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A> <B>getInstance</B>()</PRE>
+<DL>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dbdsdc(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], int, double[], int[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dbdsdc</H3>
+<PRE>
+public abstract void <B>dbdsdc</B>(java.lang.String uplo,
+ java.lang.String compq,
+ int n,
+ double[] d,
+ double[] e,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] q,
+ int[] iq,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DBDSDC computes the singular value decomposition (SVD) of a real
+ N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
+ using a divide and conquer method, where S is a diagonal matrix
+ with non-negative diagonal elements (the singular values of B), and
+ U and VT are orthogonal matrices of left and right singular vectors,
+
+ respectively. DBDSDC can be used to compute all singular values,
+ and optionally, singular vectors or singular vectors in compact form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLASD3 for details.
+
+ The code currently calls DLASDQ if singular values only are desired.
+
+ However, it can be slightly modified to compute singular values
+ using the divide and conquer method.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal.
+ = 'L': B is lower bidiagonal.
+
+ COMPQ (input) CHARACTER*1
+ Specifies whether singular vectors are to be computed
+ as follows:
+ = 'N': Compute singular values only;
+ = 'P': Compute singular values and compute singular
+ vectors in compact form;
+ = 'I': Compute singular values and singular vectors.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the elements of E contain the offdiagonal
+ elements of the bidiagonal matrix whose SVD is desired.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, U contains the left singular vectors
+ of the bidiagonal matrix.
+ For other values of COMPQ, U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1.
+ If singular vectors are desired, then LDU >= max( 1, N ).
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, VT' contains the right singular
+ vectors of the bidiagonal matrix.
+ For other values of COMPQ, VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1.
+ If singular vectors are desired, then LDVT >= max( 1, N ).
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, Q contains all the DOUBLE PRECISION data in
+ LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, Q is not referenced.
+
+ IQ (output) INTEGER array, dimension (LDIQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, IQ contains all INTEGER data in
+ LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, IQ is not referenced.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+
+ If COMPQ = 'N' then LWORK >= (4 * N).
+ If COMPQ = 'P' then LWORK >= (6 * N).
+ If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value.
+ The update process of divide and conquer failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+ Changed dimension statement in comment describing E from (N) to
+ (N-1). Sven, 17 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>compq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>iq</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dbdsqr(java.lang.String, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dbdsqr</H3>
+<PRE>
+public abstract void <B>dbdsqr</B>(java.lang.String uplo,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ double[] d,
+ double[] e,
+ double[] vt,
+ int ldvt,
+ double[] u,
+ int ldu,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DBDSQR computes the singular values and, optionally, the right and/or
+ left singular vectors from the singular value decomposition (SVD) of
+
+ a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+ zero-shift QR algorithm. The SVD of B has the form
+
+ B = Q * S * P**T
+
+ where S is the diagonal matrix of singular values, Q is an orthogonal
+ matrix of left singular vectors, and P is an orthogonal matrix of
+ right singular vectors. If left singular vectors are requested, this
+ subroutine actually returns U*Q instead of Q, and, if right singular
+
+ vectors are requested, this subroutine returns P**T*VT instead of
+ P**T, for given real input matrices U and VT. When U and VT are the
+
+ orthogonal matrices that reduce a general matrix A to bidiagonal
+ form: A = U*B*VT, as computed by DGEBRD, then
+
+ A = (U*Q) * S * (P**T*VT)
+
+ is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+
+ for a given real input matrix C.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
+ no. 5, pp. 873-912, Sept 1990) and
+ "Accurate singular values and differential qd algorithms," by
+ B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
+ Department, University of California at Berkeley, July 1992
+ for a detailed description of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal;
+ = 'L': B is lower bidiagonal.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ NCVT (input) INTEGER
+ The number of columns of the matrix VT. NCVT >= 0.
+
+ NRU (input) INTEGER
+ The number of rows of the matrix U. NRU >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B in decreasing
+ order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the N-1 offdiagonal elements of the bidiagonal
+ matrix B.
+ On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
+ will contain the diagonal and superdiagonal elements of a
+ bidiagonal matrix orthogonally equivalent to the one given
+ as input.
+
+ VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
+ On entry, an N-by-NCVT matrix VT.
+ On exit, VT is overwritten by P**T * VT.
+ Not referenced if NCVT = 0.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT.
+ LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
+ On entry, an NRU-by-N matrix U.
+ On exit, U is overwritten by U * Q.
+ Not referenced if NRU = 0.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,NRU).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
+ On entry, an N-by-NCC matrix C.
+ On exit, C is overwritten by Q**T * C.
+ Not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ if NCVT = NRU = NCC = 0, (max(1, 4*N)) otherwise
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm did not converge; D and E contain the
+ elements of a bidiagonal matrix which is orthogonally
+ similar to the input matrix B; if INFO = i, i
+ elements of E have not converged to zero.
+
+ Internal Parameters
+ ===================
+
+ TOLMUL DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
+ TOLMUL controls the convergence criterion of the QR loop.
+ If it is positive, TOLMUL*EPS is the desired relative
+ precision in the computed singular values.
+ If it is negative, abs(TOLMUL*EPS*sigma_max) is the
+ desired absolute accuracy in the computed singular
+ values (corresponds to relative accuracy
+ abs(TOLMUL*EPS) in the largest singular value.
+ abs(TOLMUL) should be between 1 and 1/EPS, and preferably
+ between 10 (for fast convergence) and .1/EPS
+ (for there to be some accuracy in the results).
+ Default is to lose at either one eighth or 2 of the
+ available decimal digits in each computed singular value
+ (whichever is smaller).
+
+ MAXITR INTEGER, default = 6
+ MAXITR controls the maximum number of passes of the
+ algorithm through its inner loop. The algorithms stops
+ (and so fails to converge) if the number of passes
+ through the inner loop exceeds MAXITR*N**2.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ncvt</CODE> - <DD><CODE>nru</CODE> - <DD><CODE>ncc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ddisna(java.lang.String, int, int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+ddisna</H3>
+<PRE>
+public abstract void <B>ddisna</B>(java.lang.String job,
+ int m,
+ int n,
+ double[] d,
+ double[] sep,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DDISNA computes the reciprocal condition numbers for the eigenvectors
+ of a real symmetric or complex Hermitian matrix or for the left or
+ right singular vectors of a general m-by-n matrix. The reciprocal
+ condition number is the 'gap' between the corresponding eigenvalue or
+ singular value and the nearest other one.
+
+ The bound on the error, measured by angle in radians, in the I-th
+ computed vector is given by
+
+ DLAMCH( 'E' ) * ( ANORM / SEP( I ) )
+
+ where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
+
+ to be smaller than DLAMCH( 'E' )*ANORM in order to limit the size of
+
+ the error bound.
+
+ DDISNA may also be used to compute error bounds for eigenvectors of
+ the generalized symmetric definite eigenproblem.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies for which problem the reciprocal condition numbers
+
+ should be computed:
+ = 'E': the eigenvectors of a symmetric/Hermitian matrix;
+ = 'L': the left singular vectors of a general matrix;
+ = 'R': the right singular vectors of a general matrix.
+
+ M (input) INTEGER
+ The number of rows of the matrix. M >= 0.
+
+ N (input) INTEGER
+ If JOB = 'L' or 'R', the number of columns of the matrix,
+ in which case N >= 0. Ignored if JOB = 'E'.
+
+ D (input) DOUBLE PRECISION array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+
+ The eigenvalues (if JOB = 'E') or singular values (if JOB =
+ 'L' or 'R') of the matrix, in either increasing or decreasing
+ order. If singular values, they must be non-negative.
+
+ SEP (output) DOUBLE PRECISION array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+ The reciprocal condition numbers of the vectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>sep</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbbrd(java.lang.String, int, int, int, int, int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgbbrd</H3>
+<PRE>
+public abstract void <B>dgbbrd</B>(java.lang.String vect,
+ int m,
+ int n,
+ int ncc,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] d,
+ double[] e,
+ double[] q,
+ int ldq,
+ double[] pt,
+ int ldpt,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBBRD reduces a real general m-by-n band matrix A to upper
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ The routine computes B, and optionally forms Q or P', or computes
+ Q'*C for a given matrix C.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether or not the matrices Q and P' are to be
+ formed.
+ = 'N': do not form Q or P';
+ = 'Q': form Q only;
+ = 'P': form P' only;
+ = 'B': form both.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals of the matrix A. KU >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the m-by-n band matrix A, stored in rows 1 to
+ KL+KU+1. The j-th column of A is stored in the j-th column of
+ the array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+ On exit, A is overwritten by values generated during the
+ reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KL+KU+1.
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B.
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The superdiagonal elements of the bidiagonal matrix B.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,M)
+ If VECT = 'Q' or 'B', the m-by-m orthogonal matrix Q.
+ If VECT = 'N' or 'P', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise.
+
+ PT (output) DOUBLE PRECISION array, dimension (LDPT,N)
+ If VECT = 'P' or 'B', the n-by-n orthogonal matrix P'.
+ If VECT = 'N' or 'Q', the array PT is not referenced.
+
+ LDPT (input) INTEGER
+ The leading dimension of the array PT.
+ LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,NCC)
+ On entry, an m-by-ncc matrix C.
+ On exit, C is overwritten by Q'*C.
+ C is not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ncc</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>pt</CODE> - <DD><CODE>ldpt</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbcon(java.lang.String, int, int, int, double[], int, int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgbcon</H3>
+<PRE>
+public abstract void <B>dgbcon</B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBCON estimates the reciprocal of the condition number of a real
+ general band matrix A, in either the 1-norm or the infinity-norm,
+ using the LU factorization computed by DGBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by DGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ ANORM (input) DOUBLE PRECISION
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbequ(int, int, int, int, double[], int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dgbequ</H3>
+<PRE>
+public abstract void <B>dgbequ</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] r,
+ double[] c,
+ org.netlib.util.doubleW rowcnd,
+ org.netlib.util.doubleW colcnd,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBEQU computes row and column scalings intended to equilibrate an
+ M-by-N band matrix A and reduce its condition number. R returns the
+
+ row scale factors and C the column scale factors, chosen to try to
+ make the largest element in each row and column of the matrix B with
+
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ R (output) DOUBLE PRECISION array, dimension (M)
+ If INFO = 0, or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) DOUBLE PRECISION
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) DOUBLE PRECISION
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbrfs(java.lang.String, int, int, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgbrfs</H3>
+<PRE>
+public abstract void <B>dgbrfs</B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is banded, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The original band matrix A, stored in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input) DOUBLE PRECISION array, dimension (LDAFB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by DGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
+
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGBTRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DGBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbsv(int, int, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgbsv</H3>
+<PRE>
+public abstract void <B>dgbsv</B>(int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBSV computes the solution to a real system of linear equations
+ A * X = B, where A is a band matrix of order N with KL subdiagonals
+ and KU superdiagonals, and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as A = L * U, where L is a product of permutation
+ and unit lower triangular matrices with KL subdiagonals, and U is
+ upper triangular with KL+KU superdiagonals. The factored form of A
+ is then used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * + + + * * * u14 u25 u36
+ * + + + + * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbsvx(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], int, int[], org.netlib.util.StringW, double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgbsvx</H3>
+<PRE>
+public abstract void <B>dgbsvx</B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ double[] r,
+ double[] c,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B, A**T * X = B, or A**H * X = B,
+
+ where A is a band matrix of order N with KL subdiagonals and KU
+ superdiagonals, and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed by this subroutine:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = L * U,
+ where L is a product of permutation and unit lower triangular
+ matrices with KL subdiagonals, and U is upper triangular with
+ KL+KU superdiagonals.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB and IPIV contain the factored form of
+ A. If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ AB, AFB, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
+
+ If FACT = 'F' and EQUED is not 'N', then A must have been
+ equilibrated by the scaling factors in R and/or C. AB is not
+ modified if FACT = 'F' or 'N', or if FACT = 'E' and
+ EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input or output) DOUBLE PRECISION array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains details of the LU factorization of the band matrix
+ A, as computed by DGBTRF. U is stored as an upper triangular
+ band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
+ and the multipliers used during the factorization are stored
+
+ in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
+ the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns details of the LU factorization of A.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns details of the LU factorization of the equilibrated
+ matrix A (see the description of AB for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
+
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = L*U
+ as computed by DGBTRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) DOUBLE PRECISION array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (3*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbtf2(int, int, int, int, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgbtf2</H3>
+<PRE>
+public abstract void <B>dgbtf2</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBTF2 computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * + + + * * * u14 u25 u36
+ * + + + + * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U, because of fill-in resulting from the row
+ interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbtrf(int, int, int, int, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgbtrf</H3>
+<PRE>
+public abstract void <B>dgbtrf</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBTRF computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * + + + * * * u14 u25 u36
+ * + + + + * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgbtrs(java.lang.String, int, int, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgbtrs</H3>
+<PRE>
+public abstract void <B>dgbtrs</B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBTRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general band matrix A using the LU factorization computed
+ by DGBTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by DGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgebak(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgebak</H3>
+<PRE>
+public abstract void <B>dgebak</B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ double[] scale,
+ int m,
+ double[] v,
+ int ldv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBAK forms the right or left eigenvectors of a real general matrix
+
+ by backward transformation on the computed eigenvectors of the
+ balanced matrix output by DGEBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N', do nothing, return immediately;
+ = 'P', do backward transformation for permutation only;
+ = 'S', do backward transformation for scaling only;
+ = 'B', do backward transformations for both permutation and
+ scaling.
+ JOB must be the same as the argument JOB supplied to DGEBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by DGEBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ SCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutation and scaling factors, as returned
+ by DGEBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by DHSEIN or DTREVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>side</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>m</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgebal(java.lang.String, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgebal</H3>
+<PRE>
+public abstract void <B>dgebal</B>(java.lang.String job,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] scale,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBAL balances a general real matrix A. This involves, first,
+ permuting A by a similarity transformation to isolate eigenvalues
+ in the first 1 to ILO-1 and last IHI+1 to N elements on the
+ diagonal; and second, applying a diagonal similarity transformation
+ to rows and columns ILO to IHI to make the rows and columns as
+ close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrix, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A:
+ = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+ for i = 1,...,N;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ SCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied to
+ A. If P(j) is the index of the row and column interchanged
+ with row and column j and D(j) is the scaling factor
+ applied to row and column j, then
+ SCALE(j) = P(j) for j = 1,...,ILO-1
+ = D(j) for j = ILO,...,IHI
+ = P(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The permutations consist of row and column interchanges which put
+ the matrix in the form
+
+ ( T1 X Y )
+ P A P = ( 0 B Z )
+ ( 0 0 T2 )
+
+ where T1 and T2 are upper triangular matrices whose eigenvalues lie
+ along the diagonal. The column indices ILO and IHI mark the starting
+ and ending columns of the submatrix B. Balancing consists of applying
+ a diagonal similarity transformation inv(D) * B * D to make the
+ 1-norms of each row of B and its corresponding column nearly equal.
+ The output matrix is
+
+ ( T1 X*D Y )
+ ( 0 inv(D)*B*D inv(D)*Z ).
+ ( 0 0 T2 )
+
+ Information about the permutations P and the diagonal matrix D is
+ returned in the vector SCALE.
+
+ This subroutine is based on the EISPACK routine BALANC.
+
+ Modified by Tzu-Yi Chen, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgebd2(int, int, double[], int, double[], double[], double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgebd2</H3>
+<PRE>
+public abstract void <B>dgebd2</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tauq,
+ double[] taup,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBD2 reduces a real general m by n matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tauq</CODE> - <DD><CODE>taup</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgebrd(int, int, double[], int, double[], double[], double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgebrd</H3>
+<PRE>
+public abstract void <B>dgebrd</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tauq,
+ double[] taup,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBRD reduces a general real M-by-N matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
+
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,M,N).
+ For optimum performance LWORK >= (M+N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tauq</CODE> - <DD><CODE>taup</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgecon(java.lang.String, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgecon</H3>
+<PRE>
+public abstract void <B>dgecon</B>(java.lang.String norm,
+ int n,
+ double[] a,
+ int lda,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGECON estimates the reciprocal of the condition number of a general
+
+ real matrix A, in either the 1-norm or the infinity-norm, using
+ the LU factorization computed by DGETRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) DOUBLE PRECISION
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeequ(int, int, double[], int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dgeequ</H3>
+<PRE>
+public abstract void <B>dgeequ</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] r,
+ double[] c,
+ org.netlib.util.doubleW rowcnd,
+ org.netlib.util.doubleW colcnd,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEEQU computes row and column scalings intended to equilibrate an
+ M-by-N matrix A and reduce its condition number. R returns the row
+ scale factors and C the column scale factors, chosen to try to make
+ the largest element in each row and column of the matrix B with
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The M-by-N matrix whose equilibration factors are
+ to be computed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ R (output) DOUBLE PRECISION array, dimension (M)
+ If INFO = 0 or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) DOUBLE PRECISION
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) DOUBLE PRECISION
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgees(java.lang.String, java.lang.String, java.lang.Object, int, double[], int, org.netlib.util.intW, double[], double[], double[], int, double[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+dgees</H3>
+<PRE>
+public void <B>dgees</B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ double[] wr,
+ double[] wi,
+ double[] vs,
+ int ldvs,
+ double[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEES computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left.
+ The leading columns of Z then form an orthonormal basis for the
+ invariant subspace corresponding to the selected eigenvalues.
+
+ A matrix is in real Schur form if it is upper quasi-triangular with
+ 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
+ form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
+ conjugate pair of eigenvalues is selected, then both complex
+
+ eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO is set to N+2 (see INFO below).
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues in the same order
+ that they appear on the diagonal of the output Schur form T.
+
+ Complex conjugate pairs of eigenvalues will appear
+ consecutively with the eigenvalue having the positive
+ imaginary part first.
+
+ VS (output) DOUBLE PRECISION array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1; if
+ JOBVS = 'V', LDVS >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the matrix which reduces A
+
+ to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvs</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vs</CODE> - <DD><CODE>ldvs</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>bwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeesx(java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, double[], int, org.netlib.util.intW, double[], double[], double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+dgeesx</H3>
+<PRE>
+public void <B>dgeesx</B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ double[] wr,
+ double[] wi,
+ double[] vs,
+ int ldvs,
+ org.netlib.util.doubleW rconde,
+ org.netlib.util.doubleW rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEESX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left;
+ computes a reciprocal condition number for the average of the
+ selected eigenvalues (RCONDE); and computes a reciprocal condition
+ number for the right invariant subspace corresponding to the
+ selected eigenvalues (RCONDV). The leading columns of Z form an
+ orthonormal basis for this invariant subspace.
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
+ these quantities are called s and sep respectively).
+
+ A real matrix is in real Schur form if it is upper quasi-triangular
+ with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
+
+ the form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a
+ complex conjugate pair of eigenvalues is selected, then both
+
+ are. Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO may be set to N+3 (see INFO below).
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for average of selected eigenvalues only;
+ = 'V': Computed for selected right invariant subspace only;
+ = 'B': Computed for both.
+ If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the N-by-N matrix A.
+ On exit, A is overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts, respectively,
+ of the computed eigenvalues, in the same order that they
+ appear on the diagonal of the output Schur form T. Complex
+ conjugate pairs of eigenvalues appear consecutively with the
+
+ eigenvalue having the positive imaginary part first.
+
+ VS (output) DOUBLE PRECISION array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1, and if
+ JOBVS = 'V', LDVS >= N.
+
+ RCONDE (output) DOUBLE PRECISION
+ If SENSE = 'E' or 'B', RCONDE contains the reciprocal
+ condition number for the average of the selected eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) DOUBLE PRECISION
+ If SENSE = 'V' or 'B', RCONDV contains the reciprocal
+ condition number for the selected right invariant subspace.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ Also, if SENSE = 'E' or 'V' or 'B',
+ LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
+ selected eigenvalues computed by this routine. Note that
+ N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
+ returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
+
+ 'B' this may not be large enough.
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates upper bounds on the optimal sizes of the
+ arrays WORK and IWORK, returns these values as the first
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
+
+ Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
+
+ only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
+ may not be large enough.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates upper bounds on the optimal sizes of
+
+ the arrays WORK and IWORK, returns these values as the first
+
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the transformation which
+ reduces A to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvs</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>select</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vs</CODE> - <DD><CODE>ldvs</CODE> - <DD><CODE>rconde</CODE> - <DD><CODE>rcondv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>bwork</CODE> - <DD><CODE>info [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeev(java.lang.String, java.lang.String, int, double[], int, double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgeev</H3>
+<PRE>
+public abstract void <B>dgeev</B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ double[] a,
+ int lda,
+ double[] wr,
+ double[] wi,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEEV computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1; if
+ JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N), and
+ if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
+ performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors have been computed;
+ elements i+1:N of WR and WI contain eigenvalues which
+ have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.doubleW, double[], double[], double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgeevx</H3>
+<PRE>
+public abstract void <B>dgeevx</B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ double[] wr,
+ double[] wi,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] scale,
+ org.netlib.util.doubleW abnrm,
+ double[] rconde,
+ double[] rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEEVX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
+ (RCONDE), and reciprocal condition numbers for the right
+ eigenvectors (RCONDV).
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Balancing a matrix means permuting the rows and columns to make it
+ more nearly upper triangular, and applying a diagonal similarity
+ transformation D * A * D**(-1), where D is a diagonal matrix, to
+ make its rows and columns closer in norm and the condition numbers
+ of its eigenvalues and eigenvectors smaller. The computed
+ reciprocal condition numbers correspond to the balanced matrix.
+ Permuting rows and columns will not change the condition numbers
+ (in exact arithmetic) but diagonal scaling will. For further
+ explanation of balancing, see section 4.10.2 of the LAPACK
+ Users' Guide.
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Indicates how the input matrix should be diagonally scaled
+ and/or permuted to improve the conditioning of its
+ eigenvalues.
+ = 'N': Do not diagonally scale or permute;
+ = 'P': Perform permutations to make the matrix more nearly
+ upper triangular. Do not diagonally scale;
+ = 'S': Diagonally scale the matrix, i.e. replace A by
+ D*A*D**(-1), where D is a diagonal matrix chosen
+ to make the rows and columns of A more equal in
+ norm. Do not permute;
+ = 'B': Both diagonally scale and permute A.
+
+ Computed reciprocal condition numbers will be for the matrix
+
+ after balancing and/or permuting. Permuting does not change
+ condition numbers (in exact arithmetic), but balancing does.
+
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVL must = 'V'.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVR must = 'V'.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for eigenvalues only;
+ = 'V': Computed for right eigenvectors only;
+ = 'B': Computed for eigenvalues and right eigenvectors.
+
+ If SENSE = 'E' or 'B', both left and right eigenvectors
+ must also be computed (JOBVL = 'V' and JOBVR = 'V').
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten. If JOBVL = 'V' or
+ JOBVR = 'V', A contains the real Schur form of the balanced
+ version of the input matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues will appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values determined when A was
+ balanced. The balanced A(i,j) = 0 if I > J and
+ J = 1,...,ILO-1 or I = IHI+1,...,N.
+
+ SCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ when balancing A. If P(j) is the index of the row and column
+ interchanged with row and column j, and D(j) is the scaling
+ factor applied to row and column j, then
+ SCALE(J) = P(J), for J = 1,...,ILO-1
+ = D(J), for J = ILO,...,IHI
+ = P(J) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) DOUBLE PRECISION
+ The one-norm of the balanced matrix (the maximum
+ of the sum of absolute values of elements of any column).
+
+ RCONDE (output) DOUBLE PRECISION array, dimension (N)
+ RCONDE(j) is the reciprocal condition number of the j-th
+ eigenvalue.
+
+ RCONDV (output) DOUBLE PRECISION array, dimension (N)
+ RCONDV(j) is the reciprocal condition number of the j-th
+ right eigenvector.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. If SENSE = 'N' or 'E',
+ LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
+ LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (2*N-2)
+ If SENSE = 'N' or 'E', not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors or condition numbers
+ have been computed; elements 1:ILO-1 and i+1:N of WR
+ and WI contain eigenvalues which have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>balanc</CODE> - <DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>abnrm</CODE> - <DD><CODE>rconde</CODE> - <DD><CODE>rcondv</CODE> - <DD><CODE>work</CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgegs(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgegs</H3>
+<PRE>
+public abstract void <B>dgegs</B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vsl,
+ int ldvsl,
+ double[] vsr,
+ int ldvsr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGGES.
+
+ DGEGS computes the eigenvalues, real Schur form, and, optionally,
+ left and or/right Schur vectors of a real matrix pair (A,B).
+ Given two square matrices A and B, the generalized real Schur
+ factorization has the form
+
+ A = Q*S*Z**T, B = Q*T*Z**T
+
+ where Q and Z are orthogonal matrices, T is upper triangular, and S
+ is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
+ blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
+ of eigenvalues of (A,B). The columns of Q are the left Schur vectors
+ and the columns of Z are the right Schur vectors.
+
+ If only the eigenvalues of (A,B) are needed, the driver routine
+ DGEGV should be used instead. See DGEGV for a description of the
+ eigenvalues of the generalized nonsymmetric eigenvalue problem
+ (GNEP).
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors (returned in VSL).
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors (returned in VSR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A.
+ On exit, the upper quasi-triangular matrix S from the
+ generalized real Schur factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B.
+ On exit, the upper triangular matrix T from the generalized
+ real Schur factorization.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and (j+1)-st
+ eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+ If JOBVSL = 'V', the matrix of left Schur vectors Q.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+ If JOBVSR = 'V', the matrix of right Schur vectors Z.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,4*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for DGEQRF, DORMQR, and DORGQR.) Then compute:
+ NB -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR
+ The optimal LWORK is 2*N + N*(NB+1).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from DGGBAL
+ =N+2: error return from DGEQRF
+ =N+3: error return from DORMQR
+ =N+4: error return from DORGQR
+ =N+5: error return from DGGHRD
+ =N+6: error return from DHGEQZ (other than failed
+ iteration)
+ =N+7: error return from DGGBAK (computing VSL)
+ =N+8: error return from DGGBAK (computing VSR)
+ =N+9: error return from DLASCL (various places)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvsl</CODE> - <DD><CODE>jobvsr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vsl</CODE> - <DD><CODE>ldvsl</CODE> - <DD><CODE>vsr</CODE> - <DD><CODE>ldvsr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgegv(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgegv</H3>
+<PRE>
+public abstract void <B>dgegv</B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGGEV.
+
+ DGEGV computes the eigenvalues and, optionally, the left and/or right
+ eigenvectors of a real matrix pair (A,B).
+ Given two square matrices A and B,
+ the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+ eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+ that
+
+ A*x = lambda*B*x.
+
+ An alternate form is to find the eigenvalues mu and corresponding
+ eigenvectors y such that
+
+ mu*A*y = B*y.
+
+ These two forms are equivalent with mu = 1/lambda and x = y if
+ neither lambda nor mu is zero. In order to deal with the case that
+ lambda or mu is zero or small, two values alpha and beta are returned
+ for each eigenvalue, such that lambda = alpha/beta and
+ mu = beta/alpha.
+
+ The vectors x and y in the above equations are right eigenvectors of
+
+ the matrix pair (A,B). Vectors u and v satisfying
+
+ u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+
+ are left eigenvectors of (A,B).
+
+ Note: this routine performs "full balancing" on A and B -- see
+ "Further Details", below.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors (returned
+ in VL).
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors (returned
+
+ in VR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit A
+ contains the real Schur form of A from the generalized Schur
+
+ factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only the diagonal
+ blocks from the Schur form will be correct. See DGGHRD and
+ DHGEQZ for details.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+ upper triangular matrix obtained from B in the generalized
+ Schur factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only those elements of
+ B corresponding to the diagonal blocks from the Schur form of
+ A will be correct. See DGGHRD and DHGEQZ for details.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue of
+ GNEP.
+
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored
+ in the columns of VL, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ u(j) = VL(:,j) + i*VL(:,j+1)
+ and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvectors
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors x(j) are stored
+ in the columns of VR, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then x(j) = VR(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ x(j) = VR(:,j) + i*VR(:,j+1)
+ and
+ x(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvalues
+
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for DGEQRF, DORMQR, and DORGQR.) Then compute:
+ NB -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR;
+
+ The optimal LWORK is:
+ 2*N + MAX( 6*N, N*(NB+1) ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from DGGBAL
+ =N+2: error return from DGEQRF
+ =N+3: error return from DORMQR
+ =N+4: error return from DORGQR
+ =N+5: error return from DGGHRD
+ =N+6: error return from DHGEQZ (other than failed
+ iteration)
+ =N+7: error return from DTGEVC
+ =N+8: error return from DGGBAK (computing VL)
+ =N+9: error return from DGGBAK (computing VR)
+ =N+10: error return from DLASCL (various calls)
+
+ Further Details
+ ===============
+
+ Balancing
+ ---------
+
+ This driver calls DGGBAL to both permute and scale rows and columns
+ of A and B. The permutations PL and PR are chosen so that PL*A*PR
+ and PL*B*R will be upper triangular except for the diagonal blocks
+ A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
+ possible. The diagonal scaling matrices DL and DR are chosen so
+ that the pair DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
+ one (except for the elements that start out zero.)
+
+ After the eigenvalues and eigenvectors of the balanced matrices
+ have been computed, DGGBAK transforms the eigenvectors back to what
+ they would have been (in perfect arithmetic) if they had not been
+ balanced.
+
+ Contents of A and B on Exit
+ -------- -- - --- - -- ----
+
+ If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
+ both), then on exit the arrays A and B will contain the real Schur
+ form[*] of the "balanced" versions of A and B. If no eigenvectors
+ are computed, then only the diagonal blocks will be correct.
+
+ [*] See DHGEQZ, DGEGS, or read the book "Matrix Computations",
+ by Golub & van Loan, pub. by Johns Hopkins U. Press.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgehd2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgehd2</H3>
+<PRE>
+public abstract void <B>dgehd2</B>(int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= max(1,N).
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the n by n general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgehrd(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgehrd</H3>
+<PRE>
+public abstract void <B>dgehrd</B>(int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEHRD reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+ zero.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's DGEHRD
+ subroutine incorporating improvements proposed by Quintana-Orti and
+ Van de Geijn (2005).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgelq2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgelq2</H3>
+<PRE>
+public abstract void <B>dgelq2</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELQ2 computes an LQ factorization of a real m by n matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m by min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgelqf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgelqf</H3>
+<PRE>
+public abstract void <B>dgelqf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELQF computes an LQ factorization of a real M-by-N matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m-by-min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgels(java.lang.String, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgels</H3>
+<PRE>
+public abstract void <B>dgels</B>(java.lang.String trans,
+ int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELS solves overdetermined or underdetermined real linear systems
+ involving an M-by-N matrix A, or its transpose, using a QR or LQ
+ factorization of A. It is assumed that A has full rank.
+
+ The following options are provided:
+
+ 1. If TRANS = 'N' and m >= n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A*X ||.
+
+ 2. If TRANS = 'N' and m < n: find the minimum norm solution of
+ an underdetermined system A * X = B.
+
+ 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
+ an undetermined system A**T * X = B.
+
+ 4. If TRANS = 'T' and m < n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A**T * X ||.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N': the linear system involves A;
+ = 'T': the linear system involves A**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of the matrices B and X. NRHS >=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if M >= N, A is overwritten by details of its QR
+ factorization as returned by DGEQRF;
+ if M < N, A is overwritten by details of its LQ
+ factorization as returned by DGELQF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the matrix B of right hand side vectors, stored
+ columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+ if TRANS = 'T'.
+ On exit, if INFO = 0, B is overwritten by the solution
+ vectors, stored columnwise:
+ if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+ squares solution vectors; the residual sum of squares for the
+ solution in each column is given by the sum of squares of
+ elements N+1 to M in that column;
+ if TRANS = 'N' and m < n, rows 1 to N of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m < n, rows 1 to M of B contain the
+ least squares solution vectors; the residual sum of squares
+ for the solution in each column is given by the sum of
+ squares of elements M+1 to N in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= MAX(1,M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= max( 1, MN + max( MN, NRHS ) ).
+ For optimal performance,
+ LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
+ where MN = min(M,N) and NB is the optimum block size.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of the
+ triangular factor of A is zero, so that A does not have
+ full rank; the least squares solution could not be
+ computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgelsd(int, int, int, double[], int, double[], int, double[], double, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgelsd</H3>
+<PRE>
+public abstract void <B>dgelsd</B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] s,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELSD computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize 2-norm(| b - A*x |)
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The problem is solved in three steps:
+ (1) Reduce the coefficient matrix A to bidiagonal form with
+ Householder transformations, reducing the original problem
+ into a "bidiagonal least squares problem" (BLS)
+ (2) Solve the BLS using a divide and conquer approach.
+ (3) Apply back all the Householder tranformations to solve
+ the original least squares problem.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK must be at least 1.
+ The exact minimum amount of workspace needed depends on M,
+ N and NRHS. As long as LWORK is at least
+ 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
+ if M is greater than or equal to N or
+ 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
+ if M is less than N, the code will execute correctly.
+ SMLSIZ is returned by ILAENV and is equal to the maximum
+ size of the subproblems at the bottom of the computation
+ tree (usually about 25), and
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
+ where MINMN = MIN( M,N ).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>s</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgelss(int, int, int, double[], int, double[], int, double[], double, org.netlib.util.intW, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgelss</H3>
+<PRE>
+public abstract void <B>dgelss</B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] s,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELSS computes the minimum norm solution to a real linear least
+ squares problem:
+
+ Minimize 2-norm(| b - A*x |).
+
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
+
+ X.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the first min(m,n) rows of A are overwritten with
+ its right singular vectors, stored rowwise.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1, and also:
+ LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>s</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgelsx(int, int, int, double[], int, double[], int, int[], double, org.netlib.util.intW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgelsx</H3>
+<PRE>
+public abstract void <B>dgelsx</B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ int[] jpvt,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGELSY.
+
+ DGELSX computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+ If m >= n and RANK = n, the residual sum-of-squares for
+ the solution in the i-th column is given by the sum of
+ squares of elements N+1:M in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is an
+ initial column, otherwise it is a free column. Before
+ the QR factorization of A, all initial columns are
+ permuted to the leading positions; only the remaining
+ free columns are moved as a result of column pivoting
+ during the factorization.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgelsy(int, int, int, double[], int, double[], int, int[], double, org.netlib.util.intW, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgelsy</H3>
+<PRE>
+public abstract void <B>dgelsy</B>(int m,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ int[] jpvt,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELSY computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ This routine is basically identical to the original xGELSX except
+ three differences:
+ o The call to the subroutine xGEQPF has been substituted by the
+ the call to the subroutine xGEQP3. This subroutine is a Blas-3
+ version of the QR factorization with column pivoting.
+ o Matrix B (the right hand side) is updated with Blas-3.
+ o The permutation of matrix B (the right hand side) is faster and
+ more simple.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of AP, otherwise column i is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of AP
+ was the k-th column of A.
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ The unblocked strategy requires that:
+ LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
+ where MN = min( M, N ).
+ The block algorithm requires that:
+ LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
+ where NB is an upper bound on the blocksize returned
+ by ILAENV for the routines DGEQP3, DTZRZF, STZRQF, DORMQR,
+ and DORMRZ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeql2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgeql2</H3>
+<PRE>
+public abstract void <B>dgeql2</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQL2 computes a QL factorization of a real m by n matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the m by n lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeqlf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgeqlf</H3>
+<PRE>
+public abstract void <B>dgeqlf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQLF computes a QL factorization of a real M-by-N matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the M-by-N lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeqp3(int, int, double[], int, int[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgeqp3</H3>
+<PRE>
+public abstract void <B>dgeqp3</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQP3 computes a QR factorization with column pivoting of a
+ matrix A: A*P = Q*R using Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper trapezoidal matrix R; the elements below
+
+ the diagonal, together with the array TAU, represent the
+ orthogonal matrix Q as a product of min(M,N) elementary
+ reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(J).ne.0, the J-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(J)=0,
+ the J-th column of A is a free column.
+ On exit, if JPVT(J)=K, then the J-th column of A*P was the
+ the K-th column of A.
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO=0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 3*N+1.
+ For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real/complex scalar, and v is a real/complex vector
+ with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
+ A(i+1:m,i), and tau in TAU(i).
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeqpf(int, int, double[], int, int[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgeqpf</H3>
+<PRE>
+public abstract void <B>dgeqpf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGEQP3.
+
+ DGEQPF computes a QR factorization with column pivoting of a
+ real M-by-N matrix A: A*P = Q*R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper triangular matrix R; the elements
+ below the diagonal, together with the array TAU,
+ represent the orthogonal matrix Q as a product of
+ min(m,n) elementary reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(n)
+
+ Each H(i) has the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
+
+
+ The matrix P is represented in jpvt as follows: If
+ jpvt(j) = i
+ then the jth column of P is the ith canonical unit vector.
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeqr2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgeqr2</H3>
+<PRE>
+public abstract void <B>dgeqr2</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQR2 computes a QR factorization of a real m by n matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(m,n) by n upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgeqrf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgeqrf</H3>
+<PRE>
+public abstract void <B>dgeqrf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQRF computes a QR factorization of a real M-by-N matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of min(m,n) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgerfs(java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgerfs</H3>
+<PRE>
+public abstract void <B>dgerfs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGERFS improves the computed solution to a system of linear
+ equations and provides error bounds and backward error estimates for
+
+ the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The original N-by-N matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DGETRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgerq2(int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dgerq2</H3>
+<PRE>
+public abstract void <B>dgerq2</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGERQ2 computes an RQ factorization of a real m by n matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the m by n upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAU, represent the orthogonal matrix
+ Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgerqf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgerqf</H3>
+<PRE>
+public abstract void <B>dgerqf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGERQF computes an RQ factorization of a real M-by-N matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the M-by-N upper trapezoidal matrix R;
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of min(m,n) elementary
+ reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgesc2(int, double[], int, double[], int[], int[], org.netlib.util.doubleW)"><!-- --></A><H3>
+dgesc2</H3>
+<PRE>
+public abstract void <B>dgesc2</B>(int n,
+ double[] a,
+ int lda,
+ double[] rhs,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.doubleW scale)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESC2 solves a system of linear equations
+
+ A * X = scale* RHS
+
+ with a general N-by-N matrix A using the LU factorization with
+ complete pivoting computed by DGETC2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix A computed by DGETC2: A = P * L * U * Q
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, N).
+
+ RHS (input/output) DOUBLE PRECISION array, dimension (N).
+ On entry, the right hand side vector b.
+ On exit, the solution vector X.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ 0 <= SCALE <= 1 to prevent owerflow in the solution.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>rhs</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>jpiv</CODE> - <DD><CODE>scale</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgesdd(java.lang.String, int, int, double[], int, double[], double[], int, double[], int, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgesdd</H3>
+<PRE>
+public abstract void <B>dgesdd</B>(java.lang.String jobz,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] s,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESDD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and right singular
+ vectors. If singular vectors are desired, it uses a
+ divide-and-conquer algorithm.
+
+ The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns VT = V**T, not V.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U and all N rows of V**T are
+ returned in the arrays U and VT;
+ = 'S': the first min(M,N) columns of U and the first
+ min(M,N) rows of V**T are returned in the arrays U
+ and VT;
+ = 'O': If M >= N, the first N columns of U are overwritten
+ on the array A and all rows of V**T are returned in
+ the array VT;
+ otherwise, all columns of U are returned in the
+ array U and the first M rows of V**T are overwritten
+
+ in the array A;
+ = 'N': no columns of U or rows of V**T are computed.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBZ = 'O', A is overwritten with the first N columns
+ of U (the left singular vectors, stored
+ columnwise) if M >= N;
+ A is overwritten with the first M rows
+ of V**T (the right singular vectors, stored
+ rowwise) otherwise.
+ if JOBZ .ne. 'O', the contents of A are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,UCOL)
+ UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
+ UCOL = min(M,N) if JOBZ = 'S'.
+ If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
+
+ orthogonal matrix U;
+ if JOBZ = 'S', U contains the first min(M,N) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
+ N-by-N orthogonal matrix V**T;
+ if JOBZ = 'S', VT contains the first min(M,N) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
+ if JOBZ = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ If JOBZ = 'N',
+ LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)).
+ If JOBZ = 'O',
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+ If JOBZ = 'S' or 'A'
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+ For good performance, LWORK should generally be larger.
+ If LWORK = -1 but other input arguments are legal, WORK(1)
+ returns the optimal LWORK.
+
+ IWORK (workspace) INTEGER array, dimension (8*min(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: DBDSDC did not converge, updating process failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgesv(int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgesv</H3>
+<PRE>
+public abstract void <B>dgesv</B>(int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as
+ A = P * L * U,
+ where P is a permutation matrix, L is unit lower triangular, and U is
+ upper triangular. The factored form of A is then used to solve the
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgesvd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgesvd</H3>
+<PRE>
+public abstract void <B>dgesvd</B>(java.lang.String jobu,
+ java.lang.String jobvt,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] s,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESVD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and/or right singular
+
+ vectors. The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns V**T, not V.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U are returned in array U:
+ = 'S': the first min(m,n) columns of U (the left singular
+ vectors) are returned in the array U;
+ = 'O': the first min(m,n) columns of U (the left singular
+ vectors) are overwritten on the array A;
+ = 'N': no columns of U (no left singular vectors) are
+ computed.
+
+ JOBVT (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix
+ V**T:
+ = 'A': all N rows of V**T are returned in the array VT;
+ = 'S': the first min(m,n) rows of V**T (the right singular
+ vectors) are returned in the array VT;
+ = 'O': the first min(m,n) rows of V**T (the right singular
+ vectors) are overwritten on the array A;
+ = 'N': no rows of V**T (no right singular vectors) are
+ computed.
+
+ JOBVT and JOBU cannot both be 'O'.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBU = 'O', A is overwritten with the first min(m,n)
+ columns of U (the left singular vectors,
+ stored columnwise);
+ if JOBVT = 'O', A is overwritten with the first min(m,n)
+ rows of V**T (the right singular vectors,
+ stored rowwise);
+ if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
+ are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,UCOL)
+ (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
+ If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
+ if JOBU = 'S', U contains the first min(m,n) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBU = 'N' or 'O', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBU = 'S' or 'A', LDU >= M.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
+ V**T;
+ if JOBVT = 'S', VT contains the first min(m,n) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBVT = 'N' or 'O', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+ if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
+ superdiagonal elements of an upper bidiagonal matrix B
+ whose diagonal is in S (not necessarily sorted). B
+ satisfies A = U * B * VT, so it has the same singular values
+
+ as A, and singular vectors related by U and VT.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if DBDSQR did not converge, INFO specifies how many
+ superdiagonals of an intermediate bidiagonal form B
+ did not converge to zero. See the description of WORK
+ above for details.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobvt</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgesvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, int[], org.netlib.util.StringW, double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgesvx</H3>
+<PRE>
+public abstract void <B>dgesvx</B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ double[] r,
+ double[] c,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESVX uses the LU factorization to compute the solution to a real
+ system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = P * L * U,
+ where P is a permutation matrix, L is a unit lower triangular
+ matrix, and U is upper triangular.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF and IPIV contain the factored form of A.
+ If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ A, AF, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
+ not 'N', then A must have been equilibrated by the scaling
+ factors in R and/or C. A is not modified if FACT = 'F' or
+ 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
+
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the factors L and U from the factorization
+ A = P*L*U as computed by DGETRF. If EQUED .ne. 'N', then
+ AF is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the original matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the equilibrated matrix A (see the description of A for
+ the form of the equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = P*L*U
+ as computed by DGETRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) DOUBLE PRECISION array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (4*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization has
+ been completed, but the factor U is exactly
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgetc2(int, double[], int, int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgetc2</H3>
+<PRE>
+public abstract void <B>dgetc2</B>(int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETC2 computes an LU factorization with complete pivoting of the
+ n-by-n matrix A. The factorization has the form A = P * L * U * Q,
+ where P and Q are permutation matrices, L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ This is the Level 2 BLAS algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the n-by-n matrix A to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U*Q; the unit diagonal elements of L are not stored.
+
+ If U(k, k) appears to be less than SMIN, U(k, k) is given the
+ value of SMIN, i.e., giving a nonsingular perturbed system.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, U(k, k) is likely to produce owerflow if
+ we try to solve for x in Ax = b. So U is perturbed to
+ avoid the overflow.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>jpiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgetf2(int, int, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgetf2</H3>
+<PRE>
+public abstract void <B>dgetf2</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETF2 computes an LU factorization of a general m-by-n matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgetrf(int, int, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgetrf</H3>
+<PRE>
+public abstract void <B>dgetrf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETRF computes an LU factorization of a general M-by-N matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgetri(int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgetri</H3>
+<PRE>
+public abstract void <B>dgetri</B>(int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETRI computes the inverse of a matrix using the LU factorization
+ computed by DGETRF.
+
+ This method inverts U and then computes inv(A) by solving the system
+
+ inv(A)*L = inv(U) for inv(A).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the factors L and U from the factorization
+ A = P*L*U as computed by DGETRF.
+ On exit, if INFO = 0, the inverse of the original matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimal performance LWORK >= N*NB, where NB is
+ the optimal blocksize returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
+ singular and its inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgetrs(java.lang.String, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgetrs</H3>
+<PRE>
+public abstract void <B>dgetrs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general N-by-N matrix A using the LU factorization computed
+ by DGETRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggbak(java.lang.String, java.lang.String, int, int, int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dggbak</H3>
+<PRE>
+public abstract void <B>dggbak</B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ double[] lscale,
+ double[] rscale,
+ int m,
+ double[] v,
+ int ldv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGBAK forms the right or left eigenvectors of a real generalized
+ eigenvalue problem A*x = lambda*B*x, by backward transformation on
+ the computed eigenvectors of the balanced pair of matrices output by
+
+ DGGBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N': do nothing, return immediately;
+ = 'P': do backward transformation for permutation only;
+ = 'S': do backward transformation for scaling only;
+ = 'B': do backward transformations for both permutation and
+
+ scaling.
+ JOB must be the same as the argument JOB supplied to DGGBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by DGGBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ LSCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the left side of A and B, as returned by DGGBAL.
+
+ RSCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the right side of A and B, as returned by DGGBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by DTGEVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the matrix V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. Ward, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>side</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lscale</CODE> - <DD><CODE>rscale</CODE> - <DD><CODE>m</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggbal(java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dggbal</H3>
+<PRE>
+public abstract void <B>dggbal</B>(java.lang.String job,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] lscale,
+ double[] rscale,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGBAL balances a pair of general real matrices (A,B). This
+ involves, first, permuting A and B by similarity transformations to
+ isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
+ elements on the diagonal; and second, applying a diagonal similarity
+
+ transformation to rows and columns ILO to IHI to make the rows
+ and columns as close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrices, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors in the
+ generalized eigenvalue problem A*x = lambda*B*x.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A and B:
+ = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
+ and RSCALE(I) = 1.0 for i = 1,...,N.
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the input matrix B.
+ On exit, B is overwritten by the balanced matrix.
+ If JOB = 'N', B is not referenced.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If P(j) is the index of the
+ row interchanged with row j, and D(j)
+ is the scaling factor applied to row j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If P(j) is the index of the
+ column interchanged with column j, and D(j)
+ is the scaling factor applied to column j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ WORK (workspace) REAL array, dimension (lwork)
+ lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
+
+ at least 1 when JOB = 'N' or 'P'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. WARD, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lscale</CODE> - <DD><CODE>rscale</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgges(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, int, double[], int, double[], int, org.netlib.util.intW, double[], double[], double[], double[], int, double[], int, double[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+dgges</H3>
+<PRE>
+public void <B>dgges</B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vsl,
+ int ldvsl,
+ double[] vsr,
+ int ldvsr,
+ double[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
+ the generalized eigenvalues, the generalized real Schur form (S,T),
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T.The
+ leading columns of VSL and VSR then form an orthonormal basis for the
+ corresponding left and right eigenspaces (deflating subspaces).
+
+ (If only the generalized eigenvalues are needed, use the driver
+ DGGEV instead, which is faster.)
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG);
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three DOUBLE PRECISI
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+
+ Note that in the ill-conditioned case, a selected complex
+ eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
+
+ BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
+ in this case.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else LWORK >= 8*N+16.
+ For good performance , LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in DTGSEN.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvsl</CODE> - <DD><CODE>jobvsr</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>selctg</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vsl</CODE> - <DD><CODE>ldvsl</CODE> - <DD><CODE>vsr</CODE> - <DD><CODE>ldvsr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>bwor [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggesx(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, double[], double[], double[], double[], int, double[], int, double[], double[], double[], int, int[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+dggesx</H3>
+<PRE>
+public void <B>dggesx</B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vsl,
+ int ldvsl,
+ double[] vsr,
+ int ldvsr,
+ double[] rconde,
+ double[] rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGESX computes for a pair of N-by-N real nonsymmetric matrices
+ (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T; computes
+ a reciprocal condition number for the average of the selected
+ eigenvalues (RCONDE); and computes a reciprocal condition number for
+
+ the right and left deflating subspaces corresponding to the selected
+
+ eigenvalues (RCONDV). The leading columns of VSL and VSR then form
+ an orthonormal basis for the corresponding left and right eigenspaces
+ (deflating subspaces).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or for both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG).
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three DOUBLE PRECISI
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer satisfy
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
+
+ since ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned), in this
+ case INFO is set to N+3.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N' : None are computed;
+ = 'E' : Computed for average of selected eigenvalues only;
+ = 'V' : Computed for selected deflating subspaces only;
+ = 'B' : Computed for both.
+ If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ RCONDE (output) DOUBLE PRECISION array, dimension ( 2 )
+ If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
+ reciprocal condition numbers for the average of the selected
+
+ eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) DOUBLE PRECISION array, dimension ( 2 )
+ If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
+ reciprocal condition numbers for the selected deflating
+ subspaces.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
+ LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
+ LWORK >= max( 8*N, 6*N+16 ).
+ Note that 2*SDIM*(N-SDIM) <= N*N/2.
+ Note also that an error is only returned if
+ LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
+ this may not be large enough.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the bound on the optimal size of the WORK
+ array and the minimum size of the IWORK array, returns these
+
+ values as the first entries of the WORK and IWORK arrays, and
+ no error message related to LWORK or LIWORK is issued by
+ XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
+ LIWORK >= N+6.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the bound on the optimal size of the
+
+ WORK array and the minimum size of the IWORK array, returns
+ these values as the first entries of the WORK and IWORK
+ arrays, and no error message related to LWORK or LIWORK is
+ issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in DTGSEN.
+
+ Further details
+ ===============
+
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / RCONDE( 1 ).
+
+ An approximate (asymptotic) bound on the maximum angular error in
+ the computed deflating subspaces is
+
+ EPS * norm((A, B)) / RCONDV( 2 ).
+
+ See LAPACK User's Guide, section 4.11 for more information.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvsl</CODE> - <DD><CODE>jobvsr</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>selctg</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vsl</CODE> - <DD><CODE>ldvsl</CODE> - <DD><CODE>vsr</CODE> - <DD><CODE>ldvsr</CODE> - <DD><CODE>rconde</CODE> - <DD><CODE>rc [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggev(java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dggev</H3>
+<PRE>
+public abstract void <B>dggev</B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j).
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B .
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ alpha/beta. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ =N+2: error return from DTGEVC.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], double[], int, int[], boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+dggevx</H3>
+<PRE>
+public abstract void <B>dggevx</B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ double[] lscale,
+ double[] rscale,
+ org.netlib.util.doubleW abnrm,
+ org.netlib.util.doubleW bbnrm,
+ double[] rconde,
+ double[] rcondv,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
+ the eigenvalues (RCONDE), and reciprocal condition numbers for the
+ right eigenvectors (RCONDV).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j) .
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B.
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Specifies the balance option to be performed.
+ = 'N': do not diagonally scale or permute;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+ Computed reciprocal condition numbers will be for the
+ matrices after permuting and/or balancing. Permuting does
+ not change condition numbers (in exact arithmetic), but
+ balancing does.
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': none are computed;
+ = 'E': computed for eigenvalues only;
+ = 'V': computed for eigenvectors only;
+ = 'B': computed for eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then A contains the first part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then B contains the second part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If PL(j) is the index of the
+ row interchanged with row j, and DL(j) is the scaling
+ factor applied to row j, then
+ LSCALE(j) = PL(j) for j = 1,...,ILO-1
+ = DL(j) for j = ILO,...,IHI
+ = PL(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If PR(j) is the index of the
+ column interchanged with column j, and DR(j) is the scaling
+ factor applied to column j, then
+ RSCALE(j) = PR(j) for j = 1,...,ILO-1
+ = DR(j) for j = ILO,...,IHI
+ = PR(j) for j = IHI+1,...,N
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) DOUBLE PRECISION
+ The one-norm of the balanced matrix A.
+
+ BBNRM (output) DOUBLE PRECISION
+ The one-norm of the balanced matrix B.
+
+ RCONDE (output) DOUBLE PRECISION array, dimension (N)
+ If SENSE = 'E' or 'B', the reciprocal condition numbers of
+ the eigenvalues, stored in consecutive elements of the array.
+ For a complex conjugate pair of eigenvalues two consecutive
+ elements of RCONDE are set to the same value. Thus RCONDE(j),
+ RCONDV(j), and the j-th columns of VL and VR all correspond
+ to the j-th eigenpair.
+ If SENSE = 'N or 'V', RCONDE is not referenced.
+
+ RCONDV (output) DOUBLE PRECISION array, dimension (N)
+ If SENSE = 'V' or 'B', the estimated reciprocal condition
+ numbers of the eigenvectors, stored in consecutive elements
+ of the array. For a complex eigenvector two consecutive
+ elements of RCONDV are set to the same value. If the
+ eigenvalues cannot be reordered to compute RCONDV(j),
+ RCONDV(j) is set to 0; this can only occur when the true
+ value would be very small anyway.
+ If SENSE = 'N' or 'E', RCONDV is not referenced.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,2*N).
+ If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
+ LWORK >= max(1,6*N).
+ If SENSE = 'E' or 'B', LWORK >= max(1,10*N).
+ If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N+6)
+ If SENSE = 'E', IWORK is not referenced.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ If SENSE = 'N', BWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ =N+2: error return from DTGEVC.
+
+ Further Details
+ ===============
+
+ Balancing a matrix pair (A,B) includes, first, permuting rows and
+ columns to isolate eigenvalues, second, applying diagonal similarity
+
+ transformation to the rows and columns to make the rows and columns
+ as close in norm as possible. The computed reciprocal condition
+ numbers correspond to the balanced matrix. Permuting rows and columns
+ will not change the condition numbers (in exact arithmetic) but
+ diagonal scaling will. For further explanation of balancing, see
+ section 4.11.1.2 of LAPACK Users' Guide.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)
+
+ An approximate error bound for the angle between the i-th computed
+ eigenvector VL(i) or VR(i) is given by
+
+ EPS * norm(ABNRM, BBNRM) / DIF(i).
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see section 4.11 of LAPACK User's Guide.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>balanc</CODE> - <DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lscale</CODE> - <DD><CODE>rscale</CO [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggglm(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dggglm</H3>
+<PRE>
+public abstract void <B>dggglm</B>(int n,
+ int m,
+ int p,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] d,
+ double[] x,
+ double[] y,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGGLM solves a general Gauss-Markov linear model (GLM) problem:
+
+ minimize || y ||_2 subject to d = A*x + B*y
+ x
+
+ where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
+ given N-vector. It is assumed that M <= N <= M+P, and
+
+ rank(A) = M and rank( A B ) = N.
+
+ Under these assumptions, the constrained equation is always
+ consistent, and there is a unique solution x and a minimal 2-norm
+ solution y, which is obtained using a generalized QR factorization
+ of the matrices (A, B) given by
+
+ A = Q*(R), B = Q*T*Z.
+ (0)
+
+ In particular, if matrix B is square nonsingular, then the problem
+ GLM is equivalent to the following weighted linear least squares
+ problem
+
+ minimize || inv(B)*(d-A*x) ||_2
+ x
+
+ where inv(B) denotes the inverse of B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. 0 <= M <= N.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= N-M.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the upper triangular part of the array A contains
+ the M-by-M upper triangular matrix R.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)th subdiagonal
+ contain the N-by-P upper trapezoidal matrix T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D is the left hand side of the GLM equation.
+ On exit, D is destroyed.
+
+ X (output) DOUBLE PRECISION array, dimension (M)
+ Y (output) DOUBLE PRECISION array, dimension (P)
+ On exit, X and Y are the solutions of the GLM problem.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N+M+P).
+ For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ DGEQRF, SGERQF, DORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with A in the
+
+ generalized QR factorization of the pair (A, B) is
+ singular, so that rank(A) < M; the least squares
+ solution could not be computed.
+ = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal
+ factor T associated with B in the generalized QR
+ factorization of the pair (A, B) is singular, so that
+ rank( A B ) < N; the least squares solution could not
+ be computed.
+
+ ===================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>d</CODE> - <DD><CODE>x</CODE> - <DD><CODE>y</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgghrd(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgghrd</H3>
+<PRE>
+public abstract void <B>dgghrd</B>(java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGHRD reduces a pair of real matrices (A,B) to generalized upper
+ Hessenberg form using orthogonal transformations, where A is a
+ general matrix and B is upper triangular. The form of the
+ generalized eigenvalue problem is
+ A*x = lambda*B*x,
+ and B is typically made upper triangular by computing its QR
+ factorization and moving the orthogonal matrix Q to the left side
+ of the equation.
+
+ This subroutine simultaneously reduces A to a Hessenberg matrix H:
+ Q**T*A*Z = H
+ and transforms B to another upper triangular matrix T:
+ Q**T*B*Z = T
+ in order to reduce the problem to its standard form
+ H*y = lambda*T*y
+ where y = Z**T*x.
+
+ The orthogonal matrices Q and Z are determined as products of Givens
+
+ rotations. They may either be formed explicitly, or they may be
+ postmultiplied into input matrices Q1 and Z1, so that
+
+ Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+
+ Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+
+ If Q1 is the orthogonal matrix from the QR factorization of B in the
+
+ original equation A*x = lambda*B*x, then DGGHRD reduces the original
+
+ problem to generalized Hessenberg form.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'N': do not compute Q;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry,
+ and the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': do not compute Z;
+ = 'I': Z is initialized to the unit matrix, and the
+ orthogonal matrix Z is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry,
+ and the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of A which are to be
+ reduced. It is assumed that A is already upper triangular
+ in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+ normally set by a previous call to SGGBAL; otherwise they
+ should be set to 1 and N respectively.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ rest is set to zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the N-by-N upper triangular matrix B.
+ On exit, the upper triangular matrix T = Q**T B Z. The
+ elements below the diagonal are set to zero.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+ typically from the QR factorization of B.
+ On exit, if COMPQ='I', the orthogonal matrix Q, and if
+ COMPQ = 'V', the product Q1*Q.
+ Not referenced if COMPQ='N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+ On exit, if COMPZ='I', the orthogonal matrix Z, and if
+ COMPZ = 'V', the product Z1*Z.
+ Not referenced if COMPZ='N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z.
+ LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ This routine reduces A to Hessenberg and B to triangular form by
+ an unblocked reduction, as described in _Matrix_Computations_,
+ by Golub and Van Loan (Johns Hopkins Press.)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compq</CODE> - <DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgglse(int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgglse</H3>
+<PRE>
+public abstract void <B>dgglse</B>(int m,
+ int n,
+ int p,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ double[] d,
+ double[] x,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGLSE solves the linear equality-constrained least squares (LSE)
+ problem:
+
+ minimize || c - A*x ||_2 subject to B*x = d
+
+ where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
+ M-vector, and d is a given P-vector. It is assumed that
+ P <= N <= M+P, and
+
+ rank(B) = P and rank( (A) ) = N.
+ ( (B) )
+
+ These conditions ensure that the LSE problem has a unique solution,
+ which is obtained using a generalized RQ factorization of the
+ matrices (B, A) given by
+
+ B = (0 R)*Q, A = Z*T*Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. 0 <= P <= N <= M+P.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the upper triangle of the subarray B(1:P,N-P+1:N)
+ contains the P-by-P upper triangular matrix R.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ C (input/output) DOUBLE PRECISION array, dimension (M)
+ On entry, C contains the right hand side vector for the
+ least squares part of the LSE problem.
+ On exit, the residual sum of squares for the solution
+ is given by the sum of squares of elements N-P+1 to M of
+ vector C.
+
+ D (input/output) DOUBLE PRECISION array, dimension (P)
+ On entry, D contains the right hand side vector for the
+ constrained equation.
+ On exit, D is destroyed.
+
+ X (output) DOUBLE PRECISION array, dimension (N)
+ On exit, X is the solution of the LSE problem.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M+N+P).
+ For optimum performance LWORK >= P+min(M,N)+max(M,N)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ DGEQRF, SGERQF, DORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with B in the
+
+ generalized RQ factorization of the pair (B, A) is
+ singular, so that rank(B) < P; the least squares
+ solution could not be computed.
+ = 2: the (N-P) by (N-P) part of the upper trapezoidal factor
+ T associated with A in the generalized RQ factorization
+ of the pair (B, A) is singular, so that
+ rank( (A) ) < N; the least squares solution could not
+ ( (B) )
+ be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>p</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>x</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggqrf(int, int, int, double[], int, double[], double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dggqrf</H3>
+<PRE>
+public abstract void <B>dggqrf</B>(int n,
+ int m,
+ int p,
+ double[] a,
+ int lda,
+ double[] taua,
+ double[] b,
+ int ldb,
+ double[] taub,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGQRF computes a generalized QR factorization of an N-by-M matrix A
+
+ and an N-by-P matrix B:
+
+ A = Q*R, B = Q*T*Z,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
+ ( 0 ) N-M N M-N
+ M
+
+ where R11 is upper triangular, and
+
+ if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
+ P-N N ( T21 ) P
+ P
+
+ where T12 or T21 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GQR factorization
+
+ of A and B implicitly gives the QR factorization of inv(B)*A:
+
+ inv(B)*A = Z'*(inv(T)*R)
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(N,M)-by-M upper trapezoidal matrix R (R is
+ upper triangular if N >= M); the elements below the diagonal,
+ with the array TAUA, represent the orthogonal matrix Q as a
+ product of min(N,M) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAUA (output) DOUBLE PRECISION array, dimension (min(N,M))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)-th subdiagonal
+
+ contain the N-by-P upper trapezoidal matrix T; the remaining
+
+ elements, with the array TAUB, represent the orthogonal
+ matrix Z as a product of elementary reflectors (see Further
+ Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ TAUB (output) DOUBLE PRECISION array, dimension (min(N,P))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the QR factorization
+ of an N-by-M matrix, NB2 is the optimal blocksize for the
+ RQ factorization of an N-by-P matrix, and NB3 is the optimal
+
+ blocksize for a call of DORMQR.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(n,m).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine DORGQR.
+ To use Q to update another matrix, use LAPACK subroutine DORMQR.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(n,p).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(p-k+i+1:p) = 0 and v(p-k+i) = 1; v(1:p-k+i-1) is stored on exit in
+
+ B(n-k+i,1:p-k+i-1), and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine DORGRQ.
+ To use Z to update another matrix, use LAPACK subroutine DORMRQ.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>taua</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>taub</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggrqf(int, int, int, double[], int, double[], double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dggrqf</H3>
+<PRE>
+public abstract void <B>dggrqf</B>(int m,
+ int p,
+ int n,
+ double[] a,
+ int lda,
+ double[] taua,
+ double[] b,
+ int ldb,
+ double[] taub,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGRQF computes a generalized RQ factorization of an M-by-N matrix A
+
+ and a P-by-N matrix B:
+
+ A = R*Q, B = Z*T*Q,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
+ N-M M ( R21 ) N
+ N
+
+ where R12 or R21 is upper triangular, and
+
+ if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
+ ( 0 ) P-N P N-P
+ N
+
+ where T11 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GRQ factorization
+
+ of A and B implicitly gives the RQ factorization of A*inv(B):
+
+ A*inv(B) = (R*inv(T))*Z'
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, if M <= N, the upper triangle of the subarray
+ A(1:M,N-M+1:N) contains the M-by-M upper triangular matrix R;
+ if M > N, the elements on and above the (M-N)-th subdiagonal
+
+ contain the M-by-N upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAUA, represent the orthogonal
+ matrix Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAUA (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(P,N)-by-N upper trapezoidal matrix T (T is
+ upper triangular if P >= N); the elements below the diagonal,
+ with the array TAUB, represent the orthogonal matrix Z as a
+ product of elementary reflectors (see Further Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TAUB (output) DOUBLE PRECISION array, dimension (min(P,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the RQ factorization
+ of an M-by-N matrix, NB2 is the optimal blocksize for the
+ QR factorization of a P-by-N matrix, and NB3 is the optimal
+ blocksize for a call of DORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INF0= -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine DORGRQ.
+ To use Q to update another matrix, use LAPACK subroutine DORMRQ.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(p,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i),
+
+ and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine DORGQR.
+ To use Z to update another matrix, use LAPACK subroutine DORMQR.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>taua</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>taub</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggsvd(java.lang.String, java.lang.String, java.lang.String, int, int, int, org.netlib.util.intW, org.netlib.util.intW, double[], int, double[], int, double[], double[], double[], int, double[], int, double[], int, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dggsvd</H3>
+<PRE>
+public abstract void <B>dggsvd</B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int n,
+ int p,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alpha,
+ double[] beta,
+ double[] u,
+ int ldu,
+ double[] v,
+ int ldv,
+ double[] q,
+ int ldq,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGSVD computes the generalized singular value decomposition (GSVD)
+ of an M-by-N real matrix A and P-by-N real matrix B:
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R )
+
+ where U, V and Q are orthogonal matrices, and Z' is the transpose
+ of Z. Let K+L = the effective numerical rank of the matrix (A',B')',
+ then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
+ D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
+ following structures, respectively:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 )
+ L ( 0 0 R22 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The routine computes C, S, R, and optionally the orthogonal
+ transformation matrices U, V and Q.
+
+ In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
+ A and B implicitly gives the SVD of A*inv(B):
+ A*inv(B) = U*(D1*inv(D2))*V'.
+ If ( A',B')' has orthonormal columns, then the GSVD of A and B is
+ also equal to the CS decomposition of A and B. Furthermore, the GSVD
+
+ can be used to derive the solution of the eigenvalue problem:
+ A'*A x = lambda* B'*B x.
+ In some literature, the GSVD of A and B is presented in the form
+ U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 )
+ where U and V are orthogonal and X is nonsingular, D1 and D2 are
+ ``diagonal''. The former GSVD form can be converted to the latter
+ form by taking the nonsingular matrix X as
+
+ X = Q*( I 0 )
+ ( 0 inv(R) ).
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in the Purpose section.
+ K + L = effective numerical rank of (A',B')'.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular matrix R, or part of R.
+ See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix R if M-K-L < 0.
+ See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ ALPHA (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = C,
+ BETA(K+1:K+L) = S,
+ or if M-K-L < 0,
+ ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
+ BETA(K+1:M) =S, BETA(M+1:K+L) =1
+ and
+ ALPHA(K+L+1:N) = 0
+ BETA(K+L+1:N) = 0
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,M)
+ If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) DOUBLE PRECISION array, dimension (LDV,P)
+ If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) DOUBLE PRECISION array,
+ dimension (max(3*N,M,P)+N)
+
+ IWORK (workspace/output) INTEGER array, dimension (N)
+ On exit, IWORK stores the sorting information. More
+ precisely, the following loop will sort ALPHA
+ for I = K+1, min(M,K+L)
+ swap ALPHA(I) and ALPHA(IWORK(I))
+ endfor
+ such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, the Jacobi-type procedure failed to
+ converge. For further details, see subroutine DTGSJA.
+
+
+ Internal Parameters
+ ===================
+
+ TOLA DOUBLE PRECISION
+ TOLB DOUBLE PRECISION
+ TOLA and TOLB are the thresholds to determine the effective
+ rank of (A',B')'. Generally, they are set to
+ TOLA = MAX(M,N)*norm(A)*MAZHEPS,
+ TOLB = MAX(P,N)*norm(B)*MAZHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ Further Details
+ ===============
+
+ 2-96 Based on modifications by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobv</CODE> - <DD><CODE>jobq</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>p</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>work</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dggsvp(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double, double, org.netlib.util.intW, org.netlib.util.intW, double[], int, double[], int, double[], int, int[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dggsvp</H3>
+<PRE>
+public abstract void <B>dggsvp</B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double tola,
+ double tolb,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ double[] u,
+ int ldu,
+ double[] v,
+ int ldv,
+ double[] q,
+ int ldq,
+ int[] iwork,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGSVP computes orthogonal matrices U, V and Q such that
+
+ N-K-L K L
+ U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ V'*B*Q = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
+ numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the
+ transpose of Z.
+
+ This decomposition is the preprocessing step for computing the
+ Generalized Singular Value Decomposition (GSVD), see subroutine
+ DGGSVD.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular (or trapezoidal) matrix
+ described in the Purpose section.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix described in
+ the Purpose section.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) DOUBLE PRECISION
+ TOLB (input) DOUBLE PRECISION
+ TOLA and TOLB are the thresholds to determine the effective
+ numerical rank of matrix B and a subblock of A. Generally,
+ they are set to
+ TOLA = MAX(M,N)*norm(A)*MAZHEPS,
+ TOLB = MAX(P,N)*norm(B)*MAZHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in Purpose.
+ K + L = effective numerical rank of (A',B')'.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,M)
+ If JOBU = 'U', U contains the orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) DOUBLE PRECISION array, dimension (LDV,M)
+ If JOBV = 'V', V contains the orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ TAU (workspace) DOUBLE PRECISION array, dimension (N)
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(3*N,M,P))
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+
+ Further Details
+ ===============
+
+ The subroutine uses LAPACK subroutine DGEQPF for the QR factorization
+ with column pivoting to detect the effective numerical rank of the
+ a matrix. It may be replaced by a better rank determination strategy.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobv</CODE> - <DD><CODE>jobq</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>tola</CODE> - <DD><CODE>tolb</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>iwork</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgtcon(java.lang.String, int, double[], double[], double[], double[], int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgtcon</H3>
+<PRE>
+public abstract void <B>dgtcon</B>(java.lang.String norm,
+ int n,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTCON estimates the reciprocal of the condition number of a real
+ tridiagonal matrix A using the LU factorization as computed by
+ DGTTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by DGTTRF.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ ANORM (input) DOUBLE PRECISION
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgtrfs(java.lang.String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgtrfs</H3>
+<PRE>
+public abstract void <B>dgtrfs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] dlf,
+ double[] df,
+ double[] duf,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is tridiagonal, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by DGTTRF.
+
+ DF (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DUF (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DGTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>dlf</CODE> - <DD><CODE>df</CODE> - <DD><CODE>duf</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgtsv(int, int, double[], double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgtsv</H3>
+<PRE>
+public abstract void <B>dgtsv</B>(int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTSV solves the equation
+
+ A*X = B,
+
+ where A is an n by n tridiagonal matrix, by Gaussian elimination with
+ partial pivoting.
+
+ Note that the equation A'*X = B may be solved by interchanging the
+
+ order of the arguments DU and DL.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-2) elements of the
+ second super-diagonal of the upper triangular matrix U from
+ the LU factorization of A, in DL(1), ..., DL(n-2).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of U.
+
+ DU (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N by NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero, and the solution
+ has not been computed. The factorization has not been
+ completed unless i = N.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgtsvx(java.lang.String, java.lang.String, int, int, double[], double[], double[], double[], double[], double[], double[], int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgtsvx</H3>
+<PRE>
+public abstract void <B>dgtsvx</B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] dlf,
+ double[] df,
+ double[] duf,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B or A**T * X = B,
+ where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
+
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
+ as A = L * U, where L is a product of permutation and unit lower
+ bidiagonal matrices and U is upper triangular with nonzeros in
+ only the main diagonal and first two superdiagonals.
+
+ 2. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
+ form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
+ will not be modified.
+ = 'N': The matrix will be copied to DLF, DF, and DUF
+ and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input or output) DOUBLE PRECISION array, dimension (N-1)
+ If FACT = 'F', then DLF is an input argument and on entry
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A as computed by DGTTRF.
+
+ If FACT = 'N', then DLF is an output argument and on exit
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A.
+
+ DF (input or output) DOUBLE PRECISION array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ DUF (input or output) DOUBLE PRECISION array, dimension (N-1)
+ If FACT = 'F', then DUF is an input argument and on entry
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ If FACT = 'N', then DUF is an output argument and on exit
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ DU2 (input or output) DOUBLE PRECISION array, dimension (N-2)
+ If FACT = 'F', then DU2 is an input argument and on entry
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ If FACT = 'N', then DU2 is an output argument and on exit
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the LU factorization of A as
+
+ computed by DGTTRF.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the LU factorization of A;
+ row i of the matrix was interchanged with row IPIV(i).
+ IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
+ a row interchange was not required.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has not been completed unless i = N, but the
+ factor U is exactly singular, so the solution
+ and error bounds could not be computed.
+ RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>dlf</CODE> - <DD><CODE>df</CODE> - <DD><CODE>duf</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>i [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgttrf(int, double[], double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dgttrf</H3>
+<PRE>
+public abstract void <B>dgttrf</B>(int n,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTTRF computes an LU factorization of a real tridiagonal matrix A
+ using elimination with partial pivoting and row interchanges.
+
+ The factorization has the form
+ A = L * U
+ where L is a product of permutation and unit lower bidiagonal
+ matrices and U is upper triangular with nonzeros in only the main
+ diagonal and first two superdiagonals.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ DL (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-1) multipliers that
+ define the matrix L from the LU factorization of A.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of the
+ upper triangular matrix U from the LU factorization of A.
+
+ DU (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ DU2 (output) DOUBLE PRECISION array, dimension (N-2)
+ On exit, DU2 is overwritten by the (n-2) elements of the
+ second super-diagonal of U.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgttrs(java.lang.String, int, int, double[], double[], double[], double[], int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dgttrs</H3>
+<PRE>
+public abstract void <B>dgttrs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTTRS solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by DGTTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dgtts2(int, int, int, double[], double[], double[], double[], int[], double[], int)"><!-- --></A><H3>
+dgtts2</H3>
+<PRE>
+public abstract void <B>dgtts2</B>(int itrans,
+ int n,
+ int nrhs,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] du2,
+ int[] ipiv,
+ double[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTTS2 solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by DGTTRF.
+
+ Arguments
+ =========
+
+ ITRANS (input) INTEGER
+ Specifies the form of the system of equations.
+ = 0: A * X = B (No transpose)
+ = 1: A'* X = B (Transpose)
+ = 2: A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itrans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dhgeqz(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dhgeqz</H3>
+<PRE>
+public abstract void <B>dhgeqz</B>(java.lang.String job,
+ java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] t,
+ int ldt,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+ where H is an upper Hessenberg matrix and T is upper triangular,
+ using the double-shift QZ method.
+ Matrix pairs of this type are produced by the reduction to
+ generalized upper Hessenberg form of a real matrix pair (A,B):
+
+ A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+
+ as computed by DGGHRD.
+
+ If JOB='S', then the Hessenberg-triangular pair (H,T) is
+ also reduced to generalized Schur form,
+
+ H = Q*S*Z**T, T = Q*P*Z**T,
+
+ where Q and Z are orthogonal matrices, P is an upper triangular
+ matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+ diagonal blocks.
+
+ The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+ (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+
+ eigenvalues.
+
+ Additionally, the 2-by-2 upper triangular diagonal blocks of P
+ corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+
+ form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+ P(j,j) > 0, and P(j+1,j+1) > 0.
+
+ Optionally, the orthogonal matrix Q from the generalized Schur
+ factorization may be postmultiplied into an input matrix Q1, and the
+
+ orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+ If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced
+ the matrix pair (A,B) to generalized upper Hessenberg form, then the
+
+ output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+ generalized Schur factorization of (A,B):
+
+ A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+
+ To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently
+ of (A,B)) are computed as a pair of values (alpha,beta), where alpha
+ complex and beta real.
+ If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+ generalized nonsymmetric eigenvalue problem (GNEP)
+ A*x = lambda*B*x
+ and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+ alternate form of the GNEP
+ mu*A*y = B*y.
+ Real eigenvalues can be read directly from the generalized Schur
+ form:
+ alpha = S(i,i), beta = P(i,i).
+
+ Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
+
+ Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
+ pp. 241--256.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': Compute eigenvalues only;
+ = 'S': Compute eigenvalues and the Schur form.
+
+ COMPQ (input) CHARACTER*1
+ = 'N': Left Schur vectors (Q) are not computed;
+ = 'I': Q is initialized to the unit matrix and the matrix Q
+ of left Schur vectors of (H,T) is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry and
+ the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Right Schur vectors (Z) are not computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of right Schur vectors of (H,T) is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry and
+ the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices H, T, Q, and Z. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of H which are in
+ Hessenberg form. It is assumed that A is already upper
+ triangular in rows and columns 1:ILO-1 and IHI+1:N.
+ If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH, N)
+ On entry, the N-by-N upper Hessenberg matrix H.
+ On exit, if JOB = 'S', H contains the upper quasi-triangular
+
+ matrix S from the generalized Schur factorization;
+ 2-by-2 diagonal blocks (corresponding to complex conjugate
+ pairs of eigenvalues) are returned in standard form, with
+ H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+ If JOB = 'E', the diagonal blocks of H match those of S, but
+
+ the rest of H is unspecified.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max( 1, N ).
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT, N)
+ On entry, the N-by-N upper triangular matrix T.
+ On exit, if JOB = 'S', T contains the upper triangular
+ matrix P from the generalized Schur factorization;
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of
+ are reduced to positive diagonal form, i.e., if H(j+1,j) is
+ non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+ T(j+1,j+1) > 0.
+ If JOB = 'E', the diagonal blocks of T match those of P, but
+
+ the rest of T is unspecified.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max( 1, N ).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+
+ vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+ of left Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If COMPQ='V' or 'I', then LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of
+ right Schur vectors of (H,T), and if COMPZ = 'V', the
+ orthogonal matrix of right Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If COMPZ='V' or 'I', then LDZ >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1,...,N: the QZ iteration did not converge. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO+1,...,N should be correct.
+ = N+1,...,2*N: the shift calculation failed. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO-N+1,...,N should be correct.
+
+ Further Details
+ ===============
+
+ Iteration counters:
+
+ JITER -- counts iterations.
+ IITER -- counts iterations run since ILAST was last
+ changed. This is therefore reset only when a 1-by-1 or
+ 2-by-2 block deflates off the bottom.
+
+ =====================================================================
+
+ .. Parameters ..
+ $ SAFETY = 1.0E+0 )
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>compq</CODE> - <DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dhsein(java.lang.String, java.lang.String, java.lang.String, boolean[], int, double[], int, double[], double[], double[], int, double[], int, int, org.netlib.util.intW, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dhsein</H3>
+<PRE>
+public abstract void <B>dhsein</B>(java.lang.String side,
+ java.lang.String eigsrc,
+ java.lang.String initv,
+ boolean[] select,
+ int n,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ int[] ifaill,
+ int[] ifailr,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DHSEIN uses inverse iteration to find specified right and/or left
+ eigenvectors of a real upper Hessenberg matrix H.
+
+ The right eigenvector x and the left eigenvector y of the matrix H
+ corresponding to an eigenvalue w are defined by:
+
+ H * x = w * x, y**h * H = w * y**h
+
+ where y**h denotes the conjugate transpose of the vector y.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ EIGSRC (input) CHARACTER*1
+ Specifies the source of eigenvalues supplied in (WR,WI):
+ = 'Q': the eigenvalues were found using DHSEQR; thus, if
+ H has zero subdiagonal elements, and so is
+ block-triangular, then the j-th eigenvalue can be
+ assumed to be an eigenvalue of the block containing
+ the j-th row/column. This property allows DHSEIN to
+ perform inverse iteration on just one diagonal block.
+
+ = 'N': no assumptions are made on the correspondence
+ between eigenvalues and diagonal blocks. In this
+ case, DHSEIN must always perform inverse iteration
+ using the whole matrix H.
+
+ INITV (input) CHARACTER*1
+ = 'N': no initial vectors are supplied;
+ = 'U': user-supplied initial vectors are stored in the arrays
+ VL and/or VR.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ Specifies the eigenvectors to be computed. To select the
+ real eigenvector corresponding to a real eigenvalue WR(j),
+ SELECT(j) must be set to .TRUE.. To select the complex
+ eigenvector corresponding to a complex eigenvalue
+ (WR(j),WI(j)), with complex conjugate (WR(j+1),WI(j+1)),
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; then on exit SELECT(j) is .TRUE. and SELECT(j+1) is
+ .FALSE..
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) DOUBLE PRECISION array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input/output) DOUBLE PRECISION array, dimension (N)
+ WI (input) DOUBLE PRECISION array, dimension (N)
+ On entry, the real and imaginary parts of the eigenvalues of
+
+ H; a complex conjugate pair of eigenvalues must be stored in
+
+ consecutive elements of WR and WI.
+ On exit, WR may have been altered since close eigenvalues
+ are perturbed slightly in searching for independent
+ eigenvectors.
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if INITV = 'U' and SIDE = 'L' or 'B', VL must
+ contain starting vectors for the inverse iteration for the
+ left eigenvectors; the starting vector for each eigenvector
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'L' or 'B', the left eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VL, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'R', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if INITV = 'U' and SIDE = 'R' or 'B', VR must
+ contain starting vectors for the inverse iteration for the
+ right eigenvectors; the starting vector for each eigenvector
+
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'R' or 'B', the right eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VR, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'L', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR required to
+
+ store the eigenvectors; each selected real eigenvector
+ occupies one column and each selected complex eigenvector
+ occupies two columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ((N+2)*N)
+
+ IFAILL (output) INTEGER array, dimension (MM)
+ If SIDE = 'L' or 'B', IFAILL(i) = j > 0 if the left
+ eigenvector in the i-th column of VL (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILL(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VL hold a complex eigenvector, then IFAILL(i) and
+
+ IFAILL(i+1) are set to the same value.
+ If SIDE = 'R', IFAILL is not referenced.
+
+ IFAILR (output) INTEGER array, dimension (MM)
+ If SIDE = 'R' or 'B', IFAILR(i) = j > 0 if the right
+ eigenvector in the i-th column of VR (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILR(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VR hold a complex eigenvector, then IFAILR(i) and
+
+ IFAILR(i+1) are set to the same value.
+ If SIDE = 'L', IFAILR is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, i is the number of eigenvectors which
+ failed to converge; see IFAILL and IFAILR for further
+ details.
+
+ Further Details
+ ===============
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x|+|y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>eigsrc</CODE> - <DD><CODE>initv</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ifaill</CODE> - <DD><CODE>ifailr</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dhseqr(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dhseqr</H3>
+<PRE>
+public abstract void <B>dhseqr</B>(java.lang.String job,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+ Purpose
+ =======
+
+ DHSEQR computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': compute eigenvalues only;
+ = 'S': compute eigenvalues and the Schur form T.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': no Schur vectors are computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of Schur vectors of H is returned;
+ = 'V': Z must contain an orthogonal matrix Q on entry, and
+
+ the product Q*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL, and then passed to DGEHRD
+
+ when the matrix output by DGEBAL is reduced to Hessenberg
+ form. Otherwise ILO and IHI should be set to 1 and N
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and JOB = 'S', then H contains the
+ upper quasi-triangular matrix T from the Schur decomposition
+ (the Schur form); 2-by-2 diagonal blocks (corresponding to
+ complex conjugate pairs of eigenvalues) are returned in
+ standard form, with H(i,i) = H(i+1,i+1) and
+ H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
+ contents of H are unspecified on exit. (The output value of
+ H when INFO.GT.0 is given under the description of INFO
+ below.)
+
+ Unlike earlier versions of DHSEQR, this subroutine may
+ explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
+ or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues. If two eigenvalues are computed as a complex
+ conjugate pair, they are stored in consecutive elements of
+ WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
+ WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
+
+ the same order as on the diagonal of the Schur form returned
+ in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
+ diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ If COMPZ = 'N', Z is not referenced.
+ If COMPZ = 'I', on entry Z need not be set and on exit,
+ if INFO = 0, Z contains the orthogonal matrix Z of the Schur
+ vectors of H. If COMPZ = 'V', on entry Z must contain an
+ N-by-N matrix Q, which is assumed to be equal to the unit
+ matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
+ if INFO = 0, Z contains Q*Z.
+ Normally Q is the orthogonal matrix generated by DORGHR
+ after the call to DGEHRD which formed the Hessenberg matrix
+
+ H. (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if COMPZ = 'I' or
+ COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then DHSEQR does a workspace query.
+ In this case, DHSEQR checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .LT. 0: if INFO = -i, the i-th argument had an illegal
+ value
+ .GT. 0: if INFO = i, DHSEQR failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and JOB = 'E', then on exit, the
+ remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and JOB = 'S', then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and COMPZ = 'V', then on exit
+
+ (final value of Z) = (initial value of Z)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'I', then on exit
+ (final value of Z) = U
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'N', then Z is not
+ accessed.
+
+ ================================================================
+ Default values supplied by
+ ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
+ It is suggested that these defaults be adjusted in order
+ to attain best performance in each particular
+ computational environment.
+
+ ISPEC=1: The DLAHQR vs DLAQR0 crossover point.
+ Default: 75. (Must be at least 11.)
+
+ ISPEC=2: Recommended deflation window size.
+ This depends on ILO, IHI and NS. NS is the
+ number of simultaneous shifts returned
+ by ILAENV(ISPEC=4). (See ISPEC=4 below.)
+ The default for (IHI-ILO+1).LE.500 is NS.
+ The default for (IHI-ILO+1).GT.500 is 3*NS/2.
+
+ ISPEC=3: Nibble crossover point. (See ILAENV for
+ details.) Default: 14% of deflation window
+ size.
+
+ ISPEC=4: Number of simultaneous shifts, NS, in
+ a multi-shift QR iteration.
+
+ If IHI-ILO+1 is ...
+
+ greater than ...but less ... the
+ or equal to ... than default is
+
+ 1 30 NS - 2(+)
+ 30 60 NS - 4(+)
+ 60 150 NS = 10(+)
+ 150 590 NS = **
+ 590 3000 NS = 64
+ 3000 6000 NS = 128
+ 6000 infinity NS = 256
+
+ (+) By default some or all matrices of this order
+ are passed to the implicit double shift routine
+
+ DLAHQR and NS is ignored. See ISPEC=1 above
+ and comments in IPARM for details.
+
+ The asterisks (**) indicate an ad-hoc
+ function of N increasing from 10 to 64.
+
+ ISPEC=5: Select structured matrix multiply.
+ (See ILAENV for details.) Default: 3.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . DLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== NL allocates some local workspace to help small matrices
+ . through a rare DLAHQR failure. NL .GT. NTINY = 11 is
+ . required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
+ . mended. (The default value of NMIN is 75.) Using NL = 49
+ . allows up to six simultaneous shifts and a 16-by-16
+ . deflation window. ====
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="disnan(double)"><!-- --></A><H3>
+disnan</H3>
+<PRE>
+public boolean <B>disnan</B>(double din)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DISNAN returns .TRUE. if its argument is NaN, and .FALSE.
+ otherwise. To be replaced by the Fortran 2003 intrinsic in the
+ future.
+
+ Arguments
+ =========
+
+ DIN (input) DOUBLE PRECISION
+ Input to test for NaN.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>din</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlabad(org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlabad</H3>
+<PRE>
+public abstract void <B>dlabad</B>(org.netlib.util.doubleW small,
+ org.netlib.util.doubleW large)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLABAD takes as input the values computed by DLAMCH for underflow and
+ overflow, and returns the square root of each of these values if the
+
+ log of LARGE is sufficiently large. This subroutine is intended to
+ identify machines with a large exponent range, such as the Crays, and
+ redefine the underflow and overflow limits to be the square roots of
+
+ the values computed by DLAMCH. This subroutine is needed because
+ DLAMCH does not compensate for poor arithmetic in the upper half of
+ the exponent range, as is found on a Cray.
+
+ Arguments
+ =========
+
+ SMALL (input/output) DOUBLE PRECISION
+ On entry, the underflow threshold as computed by DLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of SMALL, otherwise unchanged.
+
+ LARGE (input/output) DOUBLE PRECISION
+ On entry, the overflow threshold as computed by DLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of LARGE, otherwise unchanged.
+
+ =====================================================================
+
+ .. Intrinsic Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>small</CODE> - <DD><CODE>large</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlabrd(int, int, int, double[], int, double[], double[], double[], double[], double[], int, double[], int)"><!-- --></A><H3>
+dlabrd</H3>
+<PRE>
+public abstract void <B>dlabrd</B>(int m,
+ int n,
+ int nb,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tauq,
+ double[] taup,
+ double[] x,
+ int ldx,
+ double[] y,
+ int ldy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLABRD reduces the first NB rows and columns of a real general
+ m by n matrix A to upper or lower bidiagonal form by an orthogonal
+ transformation Q' * A * P, and returns the matrices X and Y which
+ are needed to apply the transformation to the unreduced part of A.
+
+ If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
+
+ bidiagonal form.
+
+ This is an auxiliary routine called by DGEBRD
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A.
+
+ N (input) INTEGER
+ The number of columns in the matrix A.
+
+ NB (input) INTEGER
+ The number of leading rows and columns of A to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit, the first NB rows and columns of the matrix are
+ overwritten; the rest of the array is unchanged.
+ If m >= n, elements on and below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors; and
+ elements above the diagonal in the first NB rows, with the
+
+ array TAUP, represent the orthogonal matrix P as a product
+
+ of elementary reflectors.
+ If m < n, elements below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors, and
+ elements on and above the diagonal in the first NB rows,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (NB)
+ The diagonal elements of the first NB rows and columns of
+ the reduced matrix. D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (NB)
+ The off-diagonal elements of the first NB rows and columns of
+ the reduced matrix.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NB)
+ The m-by-nb matrix X required to update the unreduced part
+ of A.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= M.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y required to update the unreduced part
+ of A.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors.
+
+ If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
+ A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The elements of the vectors v and u together form the m-by-nb matrix
+
+ V and the nb-by-n matrix U' which are needed, with X and Y, to apply
+
+ the transformation to the unreduced part of the matrix, using a block
+ update of the form: A := A - V*Y' - X*U'.
+
+ The contents of A on exit are illustrated by the following examples
+ with nb = 2:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
+ ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
+ ( v1 v2 a a a ) ( v1 1 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix which is unchanged,
+ vi denotes an element of the vector defining H(i), and ui an element
+
+ of the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tauq</CODE> - <DD><CODE>taup</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>ldy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlacn2(int, double[], double[], int[], org.netlib.util.doubleW, org.netlib.util.intW, int[])"><!-- --></A><H3>
+dlacn2</H3>
+<PRE>
+public void <B>dlacn2</B>(int n,
+ double[] v,
+ double[] x,
+ int[] isgn,
+ org.netlib.util.doubleW est,
+ org.netlib.util.intW kase,
+ int[] isave)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLACN2 estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) DOUBLE PRECISION array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and DLACN2 must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) DOUBLE PRECISION
+ On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
+ unchanged from the previous call to DLACN2.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to DLACN2, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from DLACN2, KASE will again be 0.
+
+ ISAVE (input/output) INTEGER array, dimension (3)
+ ISAVE is used to save variables between calls to DLACN2
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ This is a thread safe version of DLACON, which uses the array ISAVE
+ in place of a SAVE statement, as follows:
+
+ DLACON DLACN2
+ JUMP ISAVE(1)
+ J ISAVE(2)
+ ITER ISAVE(3)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>x</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>est</CODE> - <DD><CODE>kase</CODE> - <DD><CODE>isave</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlacon(int, double[], double[], int[], org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlacon</H3>
+<PRE>
+public abstract void <B>dlacon</B>(int n,
+ double[] v,
+ double[] x,
+ int[] isgn,
+ org.netlib.util.doubleW est,
+ org.netlib.util.intW kase)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLACON estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) DOUBLE PRECISION array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and DLACON must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) DOUBLE PRECISION
+ On entry with KASE = 1 or 2 and JUMP = 3, EST should be
+ unchanged from the previous call to DLACON.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to DLACON, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from DLACON, KASE will again be 0.
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>x</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>est</CODE> - <DD><CODE>kase</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlacpy(java.lang.String, int, int, double[], int, double[], int)"><!-- --></A><H3>
+dlacpy</H3>
+<PRE>
+public abstract void <B>dlacpy</B>(java.lang.String uplo,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLACPY copies all or part of a two-dimensional matrix A to another
+ matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper triangle
+
+ or trapezoid is accessed; if UPLO = 'L', only the lower
+ triangle or trapezoid is accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) DOUBLE PRECISION array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dladiv(double, double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dladiv</H3>
+<PRE>
+public abstract void <B>dladiv</B>(double a,
+ double b,
+ double c,
+ double d,
+ org.netlib.util.doubleW p,
+ org.netlib.util.doubleW q)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLADIV performs complex division in real arithmetic
+
+ a + i*b
+ p + i*q = ---------
+ c + i*d
+
+ The algorithm is due to Robert L. Smith and can be found
+ in D. Knuth, The art of Computer Programming, Vol.2, p.195
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ B (input) DOUBLE PRECISION
+ C (input) DOUBLE PRECISION
+ D (input) DOUBLE PRECISION
+ The scalars a, b, c, and d in the above expression.
+
+ P (output) DOUBLE PRECISION
+ Q (output) DOUBLE PRECISION
+ The scalars p and q in the above expression.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>p</CODE> - <DD><CODE>q</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlae2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlae2</H3>
+<PRE>
+public abstract void <B>dlae2</B>(double a,
+ double b,
+ double c,
+ org.netlib.util.doubleW rt1,
+ org.netlib.util.doubleW rt2)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, and RT2
+ is the eigenvalue of smaller absolute value.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) DOUBLE PRECISION
+ The (1,2) and (2,1) elements of the 2-by-2 matrix.
+
+ C (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) DOUBLE PRECISION
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) DOUBLE PRECISION
+ The eigenvalue of smaller absolute value.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rt1</CODE> - <DD><CODE>rt2</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaebz(int, int, int, int, int, int, double, double, double, double[], double[], double[], int[], double[], double[], org.netlib.util.intW, int[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaebz</H3>
+<PRE>
+public abstract void <B>dlaebz</B>(int ijob,
+ int nitmax,
+ int n,
+ int mmax,
+ int minp,
+ int nbmin,
+ double abstol,
+ double reltol,
+ double pivmin,
+ double[] d,
+ double[] e,
+ double[] e2,
+ int[] nval,
+ double[] ab,
+ double[] c,
+ org.netlib.util.intW mout,
+ int[] nab,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEBZ contains the iteration loops which compute and use the
+ function N(w), which is the count of eigenvalues of a symmetric
+ tridiagonal matrix T less than or equal to its argument w. It
+ performs a choice of two types of loops:
+
+ IJOB=1, followed by
+ IJOB=2: It takes as input a list of intervals and returns a list of
+ sufficiently small intervals whose union contains the same
+ eigenvalues as the union of the original intervals.
+ The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
+ The output interval (AB(j,1),AB(j,2)] will contain
+ eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
+
+ IJOB=3: It performs a binary search in each input interval
+ (AB(j,1),AB(j,2)] for a point w(j) such that
+ N(w(j))=NVAL(j), and uses C(j) as the starting point of
+ the search. If such a w(j) is found, then on output
+ AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
+
+ (AB(j,1),AB(j,2)] will be a small interval containing the
+ point where N(w) jumps through NVAL(j), unless that point
+ lies outside the initial interval.
+
+ Note that the intervals are in all cases half-open intervals,
+ i.e., of the form (a,b] , which includes b but not a .
+
+ To avoid underflow, the matrix should be scaled so that its largest
+ element is no greater than overflow**(1/2) * underflow**(1/4)
+ in absolute value. To assure the most accurate computation
+ of small eigenvalues, the matrix should be scaled to be
+ not much smaller than that, either.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966
+
+ Note: the arguments are, in general, *not* checked for unreasonable
+ values.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies what is to be done:
+ = 1: Compute NAB for the initial intervals.
+ = 2: Perform bisection iteration to find eigenvalues of T.
+ = 3: Perform bisection iteration to invert N(w), i.e.,
+ to find a point which has a specified number of
+ eigenvalues of T to its left.
+ Other values will cause DLAEBZ to return with INFO=-1.
+
+ NITMAX (input) INTEGER
+ The maximum number of "levels" of bisection to be
+ performed, i.e., an interval of width W will not be made
+ smaller than 2^(-NITMAX) * W. If not all intervals
+ have converged after NITMAX iterations, then INFO is set
+ to the number of non-converged intervals.
+
+ N (input) INTEGER
+ The dimension n of the tridiagonal matrix T. It must be at
+ least 1.
+
+ MMAX (input) INTEGER
+ The maximum number of intervals. If more than MMAX intervals
+ are generated, then DLAEBZ will quit with INFO=MMAX+1.
+
+ MINP (input) INTEGER
+ The initial number of intervals. It may not be greater than
+
+ MMAX.
+
+ NBMIN (input) INTEGER
+ The smallest number of intervals that should be processed
+ using a vector loop. If zero, then only the scalar loop
+ will be used.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The minimum (absolute) width of an interval. When an
+ interval is narrower than ABSTOL, or than RELTOL times the
+ larger (in magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. This must be at least
+ zero.
+
+ RELTOL (input) DOUBLE PRECISION
+ The minimum relative width of an interval. When an interval
+
+ is narrower than ABSTOL, or than RELTOL times the larger (in
+
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum absolute value of a "pivot" in the Sturm
+ sequence loop. This *must* be at least max |e(j)**2| *
+ safe_min and at least safe_min, where safe_min is at least
+ the smallest number that can divide one without overflow.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N)
+ The offdiagonal elements of the tridiagonal matrix T in
+ positions 1 through N-1. E(N) is arbitrary.
+
+ E2 (input) DOUBLE PRECISION array, dimension (N)
+ The squares of the offdiagonal elements of the tridiagonal
+ matrix T. E2(N) is ignored.
+
+ NVAL (input/output) INTEGER array, dimension (MINP)
+ If IJOB=1 or 2, not referenced.
+ If IJOB=3, the desired values of N(w). The elements of NVAL
+
+ will be reordered to correspond with the intervals in AB.
+ Thus, NVAL(j) on output will not, in general be the same as
+ NVAL(j) on input, but it will correspond with the interval
+ (AB(j,1),AB(j,2)] on output.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (MMAX,2)
+ The endpoints of the intervals. AB(j,1) is a(j), the left
+ endpoint of the j-th interval, and AB(j,2) is b(j), the
+ right endpoint of the j-th interval. The input intervals
+ will, in general, be modified, split, and reordered by the
+ calculation.
+
+ C (input/output) DOUBLE PRECISION array, dimension (MMAX)
+ If IJOB=1, ignored.
+ If IJOB=2, workspace.
+ If IJOB=3, then on input C(j) should be initialized to the
+ first search point in the binary search.
+
+ MOUT (output) INTEGER
+ If IJOB=1, the number of eigenvalues in the intervals.
+ If IJOB=2 or 3, the number of intervals output.
+ If IJOB=3, MOUT will equal MINP.
+
+ NAB (input/output) INTEGER array, dimension (MMAX,2)
+ If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)).
+ If IJOB=2, then on input, NAB(i,j) should be set. It must
+ satisfy the condition:
+ N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)),
+ which means that in interval i only eigenvalues
+ NAB(i,1)+1,...,NAB(i,2) will be considered. Usually,
+ NAB(i,j)=N(AB(i,j)), from a previous call to DLAEBZ with
+ IJOB=1.
+ On output, NAB(i,j) will contain
+ max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of
+
+ the input interval that the output interval
+ (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the
+ the input values of NAB(k,1) and NAB(k,2).
+ If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)),
+ unless N(w) > NVAL(i) for all search points w , in which
+
+ case NAB(i,1) will not be modified, i.e., the output
+ value will be the same as the input value (modulo
+ reorderings -- see NVAL and AB), or unless N(w) < NVAL(i)
+
+ for all search points w , in which case NAB(i,2) will
+ not be modified. Normally, NAB should be set to some
+ distinctive value(s) before DLAEBZ is called.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MMAX)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (MMAX)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: All intervals converged.
+ = 1--MMAX: The last INFO intervals did not converge.
+ = MMAX+1: More than MMAX intervals were generated.
+
+ Further Details
+ ===============
+
+ This routine is intended to be called only by other LAPACK
+ routines, thus the interface is less user-friendly. It is intended
+ for two purposes:
+
+ (a) finding eigenvalues. In this case, DLAEBZ should have one or
+ more initial intervals set up in AB, and DLAEBZ should be called
+
+ with IJOB=1. This sets up NAB, and also counts the eigenvalues.
+
+ Intervals with no eigenvalues would usually be thrown out at
+ this point. Also, if not all the eigenvalues in an interval i
+ are desired, NAB(i,1) can be increased or NAB(i,2) decreased.
+ For example, set NAB(i,1)=NAB(i,2)-1 to get the largest
+ eigenvalue. DLAEBZ is then called with IJOB=2 and MMAX
+ no smaller than the value of MOUT returned by the call with
+ IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1
+ through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the
+ tolerance specified by ABSTOL and RELTOL.
+
+ (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l).
+ In this case, start with a Gershgorin interval (a,b). Set up
+ AB to contain 2 search intervals, both initially (a,b). One
+ NVAL element should contain f-1 and the other should contain l
+ , while C should contain a and b, resp. NAB(i,1) should be -1
+ and NAB(i,2) should be N+1, to flag an error if the desired
+ interval does not lie in (a,b). DLAEBZ is then called with
+ IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals --
+
+ j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while
+ if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r
+ >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and
+ N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and
+ w(l-r)=...=w(l+k) are handled similarly.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ijob</CODE> - <DD><CODE>nitmax</CODE> - <DD><CODE>n</CODE> - <DD><CODE>mmax</CODE> - <DD><CODE>minp</CODE> - <DD><CODE>nbmin</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>reltol</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>nval</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>c</CODE> - <DD><CODE>mout</CODE> - <DD><CODE>nab</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed0(int, int, int, double[], double[], double[], int, double[], int, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaed0</H3>
+<PRE>
+public abstract void <B>dlaed0</B>(int icompq,
+ int qsiz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] q,
+ int ldq,
+ double[] qstore,
+ int ldqs,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED0 computes all eigenvalues and corresponding eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+ = 2: Compute eigenvalues and eigenvectors of tridiagonal
+ matrix.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the main diagonal of the tridiagonal matrix.
+ On exit, its eigenvalues.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, Q must contain an N-by-N orthogonal matrix.
+ If ICOMPQ = 0 Q is not referenced.
+ If ICOMPQ = 1 On entry, Q is a subset of the columns of the
+ orthogonal matrix used to reduce the full
+ matrix to tridiagonal form corresponding to
+ the subset of the full matrix which is being
+
+ decomposed at this time.
+ If ICOMPQ = 2 On entry, Q will be the identity matrix.
+ On exit, Q contains the eigenvectors of the
+ tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If eigenvectors are
+ desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
+
+ QSTORE (workspace) DOUBLE PRECISION array, dimension (LDQS, N)
+ Referenced only when ICOMPQ = 1. Used to store parts of
+ the eigenvector matrix when the updating matrix multiplies
+ take place.
+
+ LDQS (input) INTEGER
+ The leading dimension of the array QSTORE. If ICOMPQ = 1,
+ then LDQS >= max(1,N). In any case, LDQS >= 1.
+
+ WORK (workspace) DOUBLE PRECISION array,
+ If ICOMPQ = 0 or 1, the dimension of WORK must be at least
+ 1 + 3*N + 2*N*lg N + 2*N**2
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of WORK must be at least
+ 4*N + N**2.
+
+ IWORK (workspace) INTEGER array,
+ If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
+ 6 + 6*N + 5*N*lg N.
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of IWORK must be at least
+ 3 + 5*N.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>qsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>qstore</CODE> - <DD><CODE>ldqs</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed1(int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaed1</H3>
+<PRE>
+public abstract void <B>dlaed1</B>(int n,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ int cutpnt,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED1 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and eigenvectors of a tridiagonal matrix. DLAED7 handles
+ the case in which eigenvalues only or eigenvalues and eigenvectors
+ of a full symmetric matrix (which was reduced to tridiagonal form)
+ are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED2.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by DLAED3).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ On entry, the permutation which separately sorts the two
+ subproblems in D into ascending order.
+ On exit, the permutation which will reintegrate the
+ subproblems back into sorted order,
+ i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
+
+ RHO (input) DOUBLE PRECISION
+ The subdiagonal entry used to create the rank-1 modification.
+
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= CUTPNT <= N/2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N + N**2)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>cutpnt</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed2(org.netlib.util.intW, int, int, double[], double[], int, int[], org.netlib.util.doubleW, double[], double[], double[], double[], int[], int[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaed2</H3>
+<PRE>
+public abstract void <B>dlaed2</B>(org.netlib.util.intW k,
+ int n,
+ int n1,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ double[] z,
+ double[] dlamda,
+ double[] w,
+ double[] q2,
+ int[] indx,
+ int[] indxc,
+ int[] indxp,
+ int[] coltyp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED2 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation. 0 <= K <=N.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the eigenvalues of the two submatrices to
+ be combined.
+ On exit, D contains the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, Q contains the eigenvectors of two submatrices in
+ the two square blocks with corners at (1,1), (N1,N1)
+ and (N1+1, N1+1), (N,N).
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have N1 added to their
+ values. Destroyed on exit.
+
+ RHO (input/output) DOUBLE PRECISION
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ DLAED3.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On entry, Z contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+ On exit, the contents of Z have been destroyed by the updating
+ process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ DLAED3 to form the secular equation.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first k values of the final deflation-altered z-vector
+ which will be passed to DLAED3.
+
+ Q2 (output) DOUBLE PRECISION array, dimension (N1**2+(N-N1)**2)
+ A copy of the first K eigenvectors which will be used by
+ DLAED3 in a matrix multiply (DGEMM) to solve for the new
+ eigenvectors.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of DLAMDA into
+ ascending order.
+
+ INDXC (output) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups: the first group contains non-zero
+ elements only at and above N1, the second contains
+ non-zero elements only below N1, and the third is dense.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ During execution, a label which will indicate which of the
+ following types a column in the Q2 matrix is:
+ 1 : non-zero in the upper half only;
+ 2 : dense;
+ 3 : non-zero in the lower half only;
+ 4 : deflated.
+ On exit, COLTYP(i) is the number of columns of type i,
+ for i=1 to 4 only.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>k</CODE> - <DD><CODE>n</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>z</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>q2</CODE> - <DD><CODE>indx</CODE> - <DD><CODE>indxc</CODE> - <DD><CODE>indxp</CODE> - <DD><CODE>coltyp</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed3(int, int, int, double[], double[], int, double, double[], double[], int[], int[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaed3</H3>
+<PRE>
+public abstract void <B>dlaed3</B>(int k,
+ int n,
+ int n1,
+ double[] d,
+ double[] q,
+ int ldq,
+ double rho,
+ double[] dlamda,
+ double[] q2,
+ int[] indx,
+ int[] ctot,
+ double[] w,
+ double[] s,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED3 finds the roots of the secular equation, as defined by the
+ values in D, W, and RHO, between 1 and K. It makes the
+ appropriate calls to DLAED4 and then updates the eigenvectors by
+ multiplying the matrix of eigenvectors of the pair of eigensystems
+ being combined by the matrix of eigenvectors of the K-by-K system
+ which is solved here.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ DLAED4. K >= 0.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (deflation may result in N>K).
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading submatrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ D(I) contains the updated eigenvalues for
+ 1 <= I <= K.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ Initially the first K columns are used as workspace.
+ On output the columns 1 to K contain
+ the updated eigenvectors.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ RHO (input) DOUBLE PRECISION
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input/output) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation. May be changed on output by
+ having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
+
+ Cray-2, or Cray C-90, as described above.
+
+ Q2 (input) DOUBLE PRECISION array, dimension (LDQ2, N)
+ The first K columns of this matrix contain the non-deflated
+ eigenvectors for the split problem.
+
+ INDX (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups (see DLAED2).
+ The rows of the eigenvectors found by DLAED4 must be likewise
+ permuted before the matrix multiply can take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in Q, as described in INDX. The fourth column type is any
+ column which has been deflated.
+
+ W (input/output) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector. Destroyed on
+ output.
+
+ S (workspace) DOUBLE PRECISION array, dimension (N1 + 1)*K
+ Will contain the eigenvectors of the repaired matrix which
+ will be multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max(1,K).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>k</CODE> - <DD><CODE>n</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>q2</CODE> - <DD><CODE>indx</CODE> - <DD><CODE>ctot</CODE> - <DD><CODE>w</CODE> - <DD><CODE>s</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed4(int, int, double[], double[], double[], double, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlaed4</H3>
+<PRE>
+public abstract void <B>dlaed4</B>(int n,
+ int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW dlam,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th updated eigenvalue of a symmetric
+ rank-one modification to a diagonal matrix whose elements are
+ given in the array d, and that
+
+ D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The original eigenvalues. It is assumed that they are in
+ order, D(I) < D(J) for I < J.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension (N)
+ If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. If N = 2, see DLAED5
+
+ for detail. The vector DELTA contains the information necessar
+ to construct the eigenvectors by DLAED3 and DLAED9.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlam</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed5(int, double[], double[], double[], double, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlaed5</H3>
+<PRE>
+public abstract void <B>dlaed5</B>(int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW dlam)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th eigenvalue of a symmetric rank-one
+
+ modification of a 2-by-2 diagonal matrix
+
+ diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal elements in the array D are assumed to satisfy
+
+ D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) DOUBLE PRECISION array, dimension (2)
+ The original eigenvalues. We assume D(1) < D(2).
+
+ Z (input) DOUBLE PRECISION array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension (2)
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlam</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed6(int, boolean, double, double[], double[], double, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlaed6</H3>
+<PRE>
+public abstract void <B>dlaed6</B>(int kniter,
+ boolean orgati,
+ double rho,
+ double[] d,
+ double[] z,
+ double finit,
+ org.netlib.util.doubleW tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED6 computes the positive or negative root (closest to the origin)
+ of
+ z(1) z(2) z(3)
+ f(x) = rho + --------- + ---------- + ---------
+ d(1)-x d(2)-x d(3)-x
+
+ It is assumed that
+
+ if ORGATI = .true. the root is between d(2) and d(3);
+ otherwise it is between d(1) and d(2)
+
+ This routine will be called by DLAED4 when necessary. In most cases,
+
+ the root sought is the smallest in magnitude, though it might not be
+
+ in some extremely rare situations.
+
+ Arguments
+ =========
+
+ KNITER (input) INTEGER
+ Refer to DLAED4 for its significance.
+
+ ORGATI (input) LOGICAL
+ If ORGATI is true, the needed root is between d(2) and
+ d(3); otherwise it is between d(1) and d(2). See
+ DLAED4 for further details.
+
+ RHO (input) DOUBLE PRECISION
+ Refer to the equation f(x) above.
+
+ D (input) DOUBLE PRECISION array, dimension (3)
+ D satisfies d(1) < d(2) < d(3).
+
+ Z (input) DOUBLE PRECISION array, dimension (3)
+ Each of the elements in z must be positive.
+
+ FINIT (input) DOUBLE PRECISION
+ The value of f at 0. It is more accurate than the one
+ evaluated inside this routine (if someone wants to do
+ so).
+
+ TAU (output) DOUBLE PRECISION
+ The root of the equation f(x).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, failure to converge
+
+ Further Details
+ ===============
+
+ 30/06/99: Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ 10/02/03: This version has a few statements commented out for thread
+
+ safety (machine parameters are computed on each entry). SJH.
+
+ 05/10/06: Modified from a new version of Ren-Cang Li, use
+ Gragg-Thornton-Warner cubic convergent scheme for better stability
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>kniter</CODE> - <DD><CODE>orgati</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>finit</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed7(int, int, int, int, int, int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], int[], int[], int[], int[], int[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaed7</H3>
+<PRE>
+public abstract void <B>dlaed7</B>(int icompq,
+ int n,
+ int qsiz,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ int cutpnt,
+ double[] qstore,
+ int[] qptr,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ double[] givnum,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED7 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and optionally eigenvectors of a dense symmetric matrix
+ that has been reduced to tridiagonal form. DLAED1 handles
+ the case in which all eigenvalues and eigenvectors of a symmetric
+ tridiagonal matrix are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED8.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by DLAED9).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= CURLVL <= TLVLS.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (output) INTEGER array, dimension (N)
+ The permutation which will reintegrate the subproblem just
+ solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
+ will be in ascending order.
+
+ RHO (input) DOUBLE PRECISION
+ The subdiagonal element used to create the rank-1
+ modification.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ QSTORE (input/output) DOUBLE PRECISION array, dimension (N**2+1)
+ Stores eigenvectors of submatrices encountered during
+ divide and conquer, packed together. QPTR points to
+ beginning of the submatrices.
+
+ QPTR (input/output) INTEGER array, dimension (N+2)
+ List of indices pointing to beginning of submatrices stored
+ in QSTORE. The submatrices are numbered starting at the
+ bottom left of the divide and conquer tree, from left to
+ right and bottom to top.
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and also the size of
+ the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N+QSIZ*N)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>qsiz</CODE> - <DD><CODE>tlvls</CODE> - <DD><CODE>curlvl</CODE> - <DD><CODE>curpbm</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>cutpnt</CODE> - <DD><CODE>qstore</CODE> - <DD><CODE>qptr</CODE> - <DD><CODE>prmptr</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>givnum</CODE> - <DD>< [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed8(int, org.netlib.util.intW, int, int, double[], double[], int, int[], org.netlib.util.doubleW, int, double[], double[], double[], int, double[], int[], org.netlib.util.intW, int[], double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaed8</H3>
+<PRE>
+public abstract void <B>dlaed8</B>(int icompq,
+ org.netlib.util.intW k,
+ int n,
+ int qsiz,
+ double[] d,
+ double[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.doubleW rho,
+ int cutpnt,
+ double[] z,
+ double[] dlamda,
+ double[] q2,
+ int ldq2,
+ double[] w,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ double[] givnum,
+ int[] indxp,
+ int[] indx,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED8 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny element in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the two submatrices to be
+ combined. On exit, the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If ICOMPQ = 0, Q is not referenced. Otherwise,
+ on entry, Q contains the eigenvectors of the partially solved
+
+ system which has been previously updated in matrix
+ multiplies with other partially solved eigensystems.
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have CUTPNT added to
+ their values in order to be accurate.
+
+ RHO (input/output) DOUBLE PRECISION
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ DLAED3.
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On entry, Z contains the updating vector (the last row of
+ the first sub-eigenvector matrix and the first row of the
+ second sub-eigenvector matrix).
+ On exit, the contents of Z are destroyed by the updating
+ process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ DLAED3 to form the secular equation.
+
+ Q2 (output) DOUBLE PRECISION array, dimension (LDQ2,N)
+ If ICOMPQ = 0, Q2 is not referenced. Otherwise,
+ a copy of the first K eigenvectors which will be used by
+ DLAED7 in a matrix multiply (DGEMM) to update the new
+ eigenvectors.
+
+ LDQ2 (input) INTEGER
+ The leading dimension of the array Q2. LDQ2 >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first k values of the final deflation-altered z-vector and
+ will be passed to DLAED3.
+
+ PERM (output) INTEGER array, dimension (N)
+ The permutations (from deflation and sorting) to be applied
+ to each eigenblock.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (output) INTEGER array, dimension (2, N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension (2, N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of D into ascending
+
+ order.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>k</CODE> - <DD><CODE>n</CODE> - <DD><CODE>qsiz</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>cutpnt</CODE> - <DD><CODE>z</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>q2</CODE> - <DD><CODE>ldq2</CODE> - <DD><CODE>w</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>indxp</CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaed9(int, int, int, int, double[], double[], int, double, double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlaed9</H3>
+<PRE>
+public abstract void <B>dlaed9</B>(int k,
+ int kstart,
+ int kstop,
+ int n,
+ double[] d,
+ double[] q,
+ int ldq,
+ double rho,
+ double[] dlamda,
+ double[] w,
+ double[] s,
+ int lds,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED9 finds the roots of the secular equation, as defined by the
+ values in D, Z, and RHO, between KSTART and KSTOP. It makes the
+ appropriate calls to DLAED4 and then stores the new matrix of
+ eigenvectors for use in calculating the next level of Z vectors.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ DLAED4. K >= 0.
+
+ KSTART (input) INTEGER
+ KSTOP (input) INTEGER
+ The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
+ are to be computed. 1 <= KSTART <= KSTOP <= K.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (delation may result in N > K).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ D(I) contains the updated eigenvalues
+ for KSTART <= I <= KSTOP.
+
+ Q (workspace) DOUBLE PRECISION array, dimension (LDQ,N)
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max( 1, N ).
+
+ RHO (input) DOUBLE PRECISION
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ W (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector.
+
+ S (output) DOUBLE PRECISION array, dimension (LDS, K)
+ Will contain the eigenvectors of the repaired matrix which
+ will be stored for subsequent Z vector calculation and
+ multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max( 1, K ).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>k</CODE> - <DD><CODE>kstart</CODE> - <DD><CODE>kstop</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>s</CODE> - <DD><CODE>lds</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaeda(int, int, int, int, int[], int[], int[], int[], double[], double[], int[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaeda</H3>
+<PRE>
+public abstract void <B>dlaeda</B>(int n,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ double[] givnum,
+ double[] q,
+ int[] qptr,
+ double[] z,
+ double[] ztemp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEDA computes the Z vector corresponding to the merge step in the
+ CURLVLth step of the merge process with TLVLS steps for the CURPBMth
+
+ problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= curlvl <= tlvls.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and incidentally the
+ size of the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ Q (input) DOUBLE PRECISION array, dimension (N**2)
+ Contains the square eigenblocks from previous levels, the
+ starting positions for blocks are given by QPTR.
+
+ QPTR (input) INTEGER array, dimension (N+2)
+ Contains a list of pointers which indicate where in Q an
+ eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
+ the size of the block.
+
+ Z (output) DOUBLE PRECISION array, dimension (N)
+ On output this vector contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+
+ ZTEMP (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>tlvls</CODE> - <DD><CODE>curlvl</CODE> - <DD><CODE>curpbm</CODE> - <DD><CODE>prmptr</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>q</CODE> - <DD><CODE>qptr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ztemp</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaein(boolean, boolean, int, double[], int, double, double, double[], double[], double[], int, double[], double, double, double, org.netlib.util.intW)"><!-- --></A><H3>
+dlaein</H3>
+<PRE>
+public abstract void <B>dlaein</B>(boolean rightv,
+ boolean noinit,
+ int n,
+ double[] h,
+ int ldh,
+ double wr,
+ double wi,
+ double[] vr,
+ double[] vi,
+ double[] b,
+ int ldb,
+ double[] work,
+ double eps3,
+ double smlnum,
+ double bignum,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEIN uses inverse iteration to find a right or left eigenvector
+ corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg
+ matrix H.
+
+ Arguments
+ =========
+
+ RIGHTV (input) LOGICAL
+ = .TRUE. : compute right eigenvector;
+ = .FALSE.: compute left eigenvector.
+
+ NOINIT (input) LOGICAL
+ = .TRUE. : no initial vector supplied in (VR,VI).
+ = .FALSE.: initial vector supplied in (VR,VI).
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) DOUBLE PRECISION array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input) DOUBLE PRECISION
+ WI (input) DOUBLE PRECISION
+ The real and imaginary parts of the eigenvalue of H whose
+ corresponding right or left eigenvector is to be computed.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (N)
+ VI (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, if NOINIT = .FALSE. and WI = 0.0, VR must contain
+ a real starting vector for inverse iteration using the real
+ eigenvalue WR; if NOINIT = .FALSE. and WI.ne.0.0, VR and VI
+ must contain the real and imaginary parts of a complex
+ starting vector for inverse iteration using the complex
+ eigenvalue (WR,WI); otherwise VR and VI need not be set.
+ On exit, if WI = 0.0 (real eigenvalue), VR contains the
+ computed real eigenvector; if WI.ne.0.0 (complex eigenvalue),
+ VR and VI contain the real and imaginary parts of the
+ computed complex eigenvector. The eigenvector is normalized
+ so that the component of largest magnitude has magnitude 1;
+ here the magnitude of a complex number (x,y) is taken to be
+ |x| + |y|.
+ VI is not referenced if WI = 0.0.
+
+ B (workspace) DOUBLE PRECISION array, dimension (LDB,N)
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= N+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ EPS3 (input) DOUBLE PRECISION
+ A small machine-dependent value which is used to perturb
+ close eigenvalues, and to replace zero pivots.
+
+ SMLNUM (input) DOUBLE PRECISION
+ A machine-dependent value close to the underflow threshold.
+
+ BIGNUM (input) DOUBLE PRECISION
+ A machine-dependent value close to the overflow threshold.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: inverse iteration did not converge; VR is set to the
+ last iterate, and so is VI if WI.ne.0.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>rightv</CODE> - <DD><CODE>noinit</CODE> - <DD><CODE>n</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>vi</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>work</CODE> - <DD><CODE>eps3</CODE> - <DD><CODE>smlnum</CODE> - <DD><CODE>bignum</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaev2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlaev2</H3>
+<PRE>
+public abstract void <B>dlaev2</B>(double a,
+ double b,
+ double c,
+ org.netlib.util.doubleW rt1,
+ org.netlib.util.doubleW rt2,
+ org.netlib.util.doubleW cs1,
+ org.netlib.util.doubleW sn1)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
+ eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
+ eigenvector for RT1, giving the decomposition
+
+ [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
+ [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) DOUBLE PRECISION
+ The (1,2) element and the conjugate of the (2,1) element of
+ the 2-by-2 matrix.
+
+ C (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) DOUBLE PRECISION
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) DOUBLE PRECISION
+ The eigenvalue of smaller absolute value.
+
+ CS1 (output) DOUBLE PRECISION
+ SN1 (output) DOUBLE PRECISION
+ The vector (CS1, SN1) is a unit right eigenvector for RT1.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ CS1 and SN1 are accurate to a few ulps barring over/underflow.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rt1</CODE> - <DD><CODE>rt2</CODE> - <DD><CODE>cs1</CODE> - <DD><CODE>sn1</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaexc(boolean, int, double[], int, double[], int, int, int, int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaexc</H3>
+<PRE>
+public abstract void <B>dlaexc</B>(boolean wantq,
+ int n,
+ double[] t,
+ int ldt,
+ double[] q,
+ int ldq,
+ int j1,
+ int n1,
+ int n2,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
+
+ an upper quasi-triangular matrix T by an orthogonal similarity
+ transformation.
+
+ T must be in Schur canonical form, that is, block upper triangular
+ with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
+ has its diagonal elemnts equal and its off-diagonal elements of
+ opposite sign.
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ = .TRUE. : accumulate the transformation in the matrix Q;
+ = .FALSE.: do not accumulate the transformation.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, the updated matrix T, again in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
+ On exit, if WANTQ is .TRUE., the updated matrix Q.
+ If WANTQ is .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
+
+ J1 (input) INTEGER
+ The index of the first row of the first block T11.
+
+ N1 (input) INTEGER
+ The order of the first block T11. N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block T22. N2 = 0, 1 or 2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: the transformed matrix T would be too far from Schur
+ form; the blocks are not swapped and T and Q are
+ unchanged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>j1</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlag2(double[], int, double[], int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlag2</H3>
+<PRE>
+public abstract void <B>dlag2</B>(double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double safmin,
+ org.netlib.util.doubleW scale1,
+ org.netlib.util.doubleW scale2,
+ org.netlib.util.doubleW wr1,
+ org.netlib.util.doubleW wr2,
+ org.netlib.util.doubleW wi)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
+ problem A - w B, with scaling as necessary to avoid over-/underflow.
+
+ The scaling factor "s" results in a modified eigenvalue equation
+
+ s A - w B
+
+ where s is a non-negative scaling factor chosen so that w, w B,
+ and s A do not overflow and, if possible, do not underflow, either.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
+
+ is less than 1/SAFMIN. Entries less than
+ sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= 2.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, 2)
+ On entry, the 2 x 2 upper triangular matrix B. It is
+ assumed that the one-norm of B is less than 1/SAFMIN. The
+ diagonals should be at least sqrt(SAFMIN) times the largest
+ element of B (in absolute value); if a diagonal is smaller
+ than that, then +/- sqrt(SAFMIN) will be used instead of
+ that diagonal.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= 2.
+
+ SAFMIN (input) DOUBLE PRECISION
+ The smallest positive number s.t. 1/SAFMIN does not
+ overflow. (This should always be DLAMCH('S') -- it is an
+ argument in order to avoid having to call DLAMCH frequently.)
+
+ SCALE1 (output) DOUBLE PRECISION
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the first eigenvalue. If
+ the eigenvalues are complex, then the eigenvalues are
+ ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
+ exponent range of the machine), SCALE1=SCALE2, and SCALE1
+ will always be positive. If the eigenvalues are real, then
+ the first (real) eigenvalue is WR1 / SCALE1 , but this may
+ overflow or underflow, and in fact, SCALE1 may be zero or
+ less than the underflow threshhold if the exact eigenvalue
+ is sufficiently large.
+
+ SCALE2 (output) DOUBLE PRECISION
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the second eigenvalue. If
+
+ the eigenvalues are complex, then SCALE2=SCALE1. If the
+ eigenvalues are real, then the second (real) eigenvalue is
+ WR2 / SCALE2 , but this may overflow or underflow, and in
+ fact, SCALE2 may be zero or less than the underflow
+ threshhold if the exact eigenvalue is sufficiently large.
+
+ WR1 (output) DOUBLE PRECISION
+ If the eigenvalue is real, then WR1 is SCALE1 times the
+ eigenvalue closest to the (2,2) element of A B**(-1). If the
+ eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
+
+ part of the eigenvalues.
+
+ WR2 (output) DOUBLE PRECISION
+ If the eigenvalue is real, then WR2 is SCALE2 times the
+ other eigenvalue. If the eigenvalue is complex, then
+ WR1=WR2 is SCALE1 times the real part of the eigenvalues.
+
+ WI (output) DOUBLE PRECISION
+ If the eigenvalue is real, then WI is zero. If the
+ eigenvalue is complex, then WI is SCALE1 times the imaginary
+
+ part of the eigenvalues. WI will always be non-negative.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>safmin</CODE> - <DD><CODE>scale1</CODE> - <DD><CODE>scale2</CODE> - <DD><CODE>wr1</CODE> - <DD><CODE>wr2</CODE> - <DD><CODE>wi</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlag2s(int, int, double[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlag2s</H3>
+<PRE>
+public void <B>dlag2s</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ float[] sa,
+ int ldsa,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE
+ PRECISION matrix, A.
+
+ RMAX is the overflow for the SINGLE PRECISION arithmetic
+ DLAG2S checks that all the entries of A are between -RMAX and
+ RMAX. If not the convertion is aborted and a flag is raised.
+
+ This is a helper routine so there is no argument checking.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of lines of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N coefficient matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ SA (output) REAL array, dimension (LDSA,N)
+ On exit, if INFO=0, the M-by-N coefficient matrix SA.
+
+ LDSA (input) INTEGER
+ The leading dimension of the array SA. LDSA >= max(1,M).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, the (i,j) entry of the matrix A has
+ overflowed when moving from DOUBLE PRECISION to SINGLE
+
+ k is given by k = (i-1)*LDA+j
+
+ =========
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>sa</CODE> - <DD><CODE>ldsa</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlags2(boolean, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlags2</H3>
+<PRE>
+public abstract void <B>dlags2</B>(boolean upper,
+ double a1,
+ double a2,
+ double a3,
+ double b1,
+ double b2,
+ double b3,
+ org.netlib.util.doubleW csu,
+ org.netlib.util.doubleW snu,
+ org.netlib.util.doubleW csv,
+ org.netlib.util.doubleW snv,
+ org.netlib.util.doubleW csq,
+ org.netlib.util.doubleW snq)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
+ that if ( UPPER ) then
+
+ U'*A*Q = U'*( A1 A2 )*Q = ( x 0 )
+ ( 0 A3 ) ( x x )
+ and
+ V'*B*Q = V'*( B1 B2 )*Q = ( x 0 )
+ ( 0 B3 ) ( x x )
+
+ or if ( .NOT.UPPER ) then
+
+ U'*A*Q = U'*( A1 0 )*Q = ( x x )
+ ( A2 A3 ) ( 0 x )
+ and
+ V'*B*Q = V'*( B1 0 )*Q = ( x x )
+ ( B2 B3 ) ( 0 x )
+
+ The rows of the transformed A and B are parallel, where
+
+ U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
+ ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
+
+ Z' denotes the transpose of Z.
+
+
+ Arguments
+ =========
+
+ UPPER (input) LOGICAL
+ = .TRUE.: the input matrices A and B are upper triangular.
+ = .FALSE.: the input matrices A and B are lower triangular.
+
+ A1 (input) DOUBLE PRECISION
+ A2 (input) DOUBLE PRECISION
+ A3 (input) DOUBLE PRECISION
+ On entry, A1, A2 and A3 are elements of the input 2-by-2
+ upper (lower) triangular matrix A.
+
+ B1 (input) DOUBLE PRECISION
+ B2 (input) DOUBLE PRECISION
+ B3 (input) DOUBLE PRECISION
+ On entry, B1, B2 and B3 are elements of the input 2-by-2
+ upper (lower) triangular matrix B.
+
+ CSU (output) DOUBLE PRECISION
+ SNU (output) DOUBLE PRECISION
+ The desired orthogonal matrix U.
+
+ CSV (output) DOUBLE PRECISION
+ SNV (output) DOUBLE PRECISION
+ The desired orthogonal matrix V.
+
+ CSQ (output) DOUBLE PRECISION
+ SNQ (output) DOUBLE PRECISION
+ The desired orthogonal matrix Q.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>upper</CODE> - <DD><CODE>a1</CODE> - <DD><CODE>a2</CODE> - <DD><CODE>a3</CODE> - <DD><CODE>b1</CODE> - <DD><CODE>b2</CODE> - <DD><CODE>b3</CODE> - <DD><CODE>csu</CODE> - <DD><CODE>snu</CODE> - <DD><CODE>csv</CODE> - <DD><CODE>snv</CODE> - <DD><CODE>csq</CODE> - <DD><CODE>snq</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlagtf(int, double[], double, double[], double[], double, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlagtf</H3>
+<PRE>
+public abstract void <B>dlagtf</B>(int n,
+ double[] a,
+ double lambda,
+ double[] b,
+ double[] c,
+ double tol,
+ double[] d,
+ int[] in,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
+ tridiagonal matrix and lambda is a scalar, as
+
+ T - lambda*I = PLU,
+
+ where P is a permutation matrix, L is a unit lower tridiagonal matrix
+ with at most one non-zero sub-diagonal elements per column and U is
+ an upper triangular matrix with at most two non-zero super-diagonal
+ elements per column.
+
+ The factorization is obtained by Gaussian elimination with partial
+ pivoting and implicit row scaling.
+
+ The parameter LAMBDA is included in the routine so that DLAGTF may
+ be used, in conjunction with DLAGTS, to obtain eigenvectors of T by
+ inverse iteration.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, A must contain the diagonal elements of T.
+
+ On exit, A is overwritten by the n diagonal elements of the
+ upper triangular matrix U of the factorization of T.
+
+ LAMBDA (input) DOUBLE PRECISION
+ On entry, the scalar lambda.
+
+ B (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, B must contain the (n-1) super-diagonal elements of
+ T.
+
+ On exit, B is overwritten by the (n-1) super-diagonal
+ elements of the matrix U of the factorization of T.
+
+ C (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, C must contain the (n-1) sub-diagonal elements of
+ T.
+
+ On exit, C is overwritten by the (n-1) sub-diagonal elements
+
+ of the matrix L of the factorization of T.
+
+ TOL (input) DOUBLE PRECISION
+ On entry, a relative tolerance used to indicate whether or
+ not the matrix (T - lambda*I) is nearly singular. TOL should
+
+ normally be chose as approximately the largest relative error
+ in the elements of T. For example, if the elements of T are
+ correct to about 4 significant figures, then TOL should be
+ set to about 5*10**(-4). If TOL is supplied as less than eps,
+ where eps is the relative machine precision, then the value
+ eps is used in place of TOL.
+
+ D (output) DOUBLE PRECISION array, dimension (N-2)
+ On exit, D is overwritten by the (n-2) second super-diagonal
+
+ elements of the matrix U of the factorization of T.
+
+ IN (output) INTEGER array, dimension (N)
+ On exit, IN contains details of the permutation matrix P. If
+
+ an interchange occurred at the kth step of the elimination,
+ then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
+ returns the smallest positive integer j such that
+
+ abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
+
+ where norm( A(j) ) denotes the sum of the absolute values of
+
+ the jth row of the matrix A. If no such j exists then IN(n)
+ is returned as zero. If IN(n) is returned as positive, then a
+ diagonal element of U is small, indicating that
+ (T - lambda*I) is singular or nearly singular,
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -k, the kth argument had an illegal value
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lambda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>tol</CODE> - <DD><CODE>d</CODE> - <DD><CODE>in</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlagtm(java.lang.String, int, int, double, double[], double[], double[], double[], int, double, double[], int)"><!-- --></A><H3>
+dlagtm</H3>
+<PRE>
+public abstract void <B>dlagtm</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ double alpha,
+ double[] dl,
+ double[] d,
+ double[] du,
+ double[] x,
+ int ldx,
+ double beta,
+ double[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGTM performs a matrix-vector product of the form
+
+ B := alpha * A * X + beta * B
+
+ where A is a tridiagonal matrix of order N, B and X are N by NRHS
+ matrices, and alpha and beta are real scalars, each of which may be
+ 0., 1., or -1.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': No transpose, B := alpha * A * X + beta * B
+ = 'T': Transpose, B := alpha * A'* X + beta * B
+ = 'C': Conjugate transpose = Transpose
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices X and B.
+
+ ALPHA (input) DOUBLE PRECISION
+ The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal elements of T.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of T.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) super-diagonal elements of T.
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The N by NRHS matrix X.
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(N,1).
+
+ BETA (input) DOUBLE PRECISION
+ The scalar beta. BETA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix B.
+ On exit, B is overwritten by the matrix expression
+ B := alpha * A * X + beta * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(N,1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlagts(int, int, double[], double[], double[], double[], int[], double[], org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlagts</H3>
+<PRE>
+public abstract void <B>dlagts</B>(int job,
+ int n,
+ double[] a,
+ double[] b,
+ double[] c,
+ double[] d,
+ int[] in,
+ double[] y,
+ org.netlib.util.doubleW tol,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGTS may be used to solve one of the systems of equations
+
+ (T - lambda*I)*x = y or (T - lambda*I)'*x = y,
+
+ where T is an n by n tridiagonal matrix, for x, following the
+ factorization of (T - lambda*I) as
+
+ (T - lambda*I) = P*L*U ,
+
+ by routine DLAGTF. The choice of equation to be solved is
+ controlled by the argument JOB, and in each case there is an option
+ to perturb zero or very small diagonal elements of U, this option
+ being intended for use in applications such as inverse iteration.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ Specifies the job to be performed by DLAGTS as follows:
+ = 1: The equations (T - lambda*I)x = y are to be solved,
+ but diagonal elements of U are not to be perturbed.
+ = -1: The equations (T - lambda*I)x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+ = 2: The equations (T - lambda*I)'x = y are to be solved,
+
+ but diagonal elements of U are not to be perturbed.
+ = -2: The equations (T - lambda*I)'x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input) DOUBLE PRECISION array, dimension (N)
+ On entry, A must contain the diagonal elements of U as
+ returned from DLAGTF.
+
+ B (input) DOUBLE PRECISION array, dimension (N-1)
+ On entry, B must contain the first super-diagonal elements of
+ U as returned from DLAGTF.
+
+ C (input) DOUBLE PRECISION array, dimension (N-1)
+ On entry, C must contain the sub-diagonal elements of L as
+ returned from DLAGTF.
+
+ D (input) DOUBLE PRECISION array, dimension (N-2)
+ On entry, D must contain the second super-diagonal elements
+ of U as returned from DLAGTF.
+
+ IN (input) INTEGER array, dimension (N)
+ On entry, IN must contain details of the matrix P as returned
+ from DLAGTF.
+
+ Y (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side vector y.
+ On exit, Y is overwritten by the solution vector x.
+
+ TOL (input/output) DOUBLE PRECISION
+ On entry, with JOB .lt. 0, TOL should be the minimum
+ perturbation to be made to very small diagonal elements of U.
+ TOL should normally be chosen as about eps*norm(U), where eps
+ is the relative machine precision, but if TOL is supplied as
+
+ non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
+ If JOB .gt. 0 then TOL is not referenced.
+
+ On exit, TOL is changed as described above, only if TOL is
+ non-positive on entry. Otherwise TOL is unchanged.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -i, the i-th argument had an illegal value
+
+ .gt. 0: overflow would occur when computing the INFO(th)
+ element of the solution vector x. This can only occur
+ when JOB is supplied as positive and either means
+ that a diagonal element of U is very small, or that
+ the elements of the right-hand side vector y are very
+ large.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>in</CODE> - <DD><CODE>y</CODE> - <DD><CODE>tol</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlagv2(double[], int, double[], int, double[], double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlagv2</H3>
+<PRE>
+public abstract void <B>dlagv2</B>(double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ org.netlib.util.doubleW csl,
+ org.netlib.util.doubleW snl,
+ org.netlib.util.doubleW csr,
+ org.netlib.util.doubleW snr)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGV2 computes the Generalized Schur factorization of a real 2-by-2
+
+ matrix pencil (A,B) where B is upper triangular. This routine
+ computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
+ SNR such that
+
+ 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
+ types), then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
+
+ 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
+ then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
+
+ where b11 >= b22 > 0.
+
+
+ Arguments
+ =========
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A.
+ On exit, A is overwritten by the ``A-part'' of the
+ generalized Schur form.
+
+ LDA (input) INTEGER
+ THe leading dimension of the array A. LDA >= 2.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, 2)
+ On entry, the upper triangular 2 x 2 matrix B.
+ On exit, B is overwritten by the ``B-part'' of the
+ generalized Schur form.
+
+ LDB (input) INTEGER
+ THe leading dimension of the array B. LDB >= 2.
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (2)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (2)
+ BETA (output) DOUBLE PRECISION array, dimension (2)
+ (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
+ pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
+ be zero.
+
+ CSL (output) DOUBLE PRECISION
+ The cosine of the left rotation matrix.
+
+ SNL (output) DOUBLE PRECISION
+ The sine of the left rotation matrix.
+
+ CSR (output) DOUBLE PRECISION
+ The cosine of the right rotation matrix.
+
+ SNR (output) DOUBLE PRECISION
+ The sine of the right rotation matrix.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>csl</CODE> - <DD><CODE>snl</CODE> - <DD><CODE>csr</CODE> - <DD><CODE>snr</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlahqr(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlahqr</H3>
+<PRE>
+public abstract void <B>dlahqr</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAHQR is an auxiliary routine called by DHSEQR to update the
+ eigenvalues and Schur decomposition already computed by DHSEQR, by
+ dealing with the Hessenberg submatrix in rows and columns ILO to
+ IHI.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper quasi-triangular in
+ rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
+ ILO = 1). DLAHQR works primarily with the Hessenberg
+ submatrix in rows and columns ILO to IHI, but applies
+ transformations to all of H if WANTT is .TRUE..
+ 1 <= ILO <= max(1,IHI); IHI <= N.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO is zero and if WANTT is .TRUE., H is upper
+ quasi-triangular in rows and columns ILO:IHI, with any
+ 2-by-2 diagonal blocks in standard form. If INFO is zero
+ and WANTT is .FALSE., the contents of H are unspecified on
+ exit. The output state of H if INFO is nonzero is given
+ below under the description of INFO.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+ eigenvalues ILO to IHI are stored in the corresponding
+ elements of WR and WI. If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
+ eigenvalues are stored in the same order as on the diagonal
+ of the Schur form returned in H, with WR(i) = H(i,i), and, if
+ H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
+ WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ If WANTZ is .TRUE., on entry Z must contain the current
+ matrix Z of transformations accumulated by DHSEQR, and on
+ exit Z has been updated; transformations are applied only to
+
+ the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+ If WANTZ is .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: If INFO = i, DLAHQR failed to compute all the
+ eigenvalues ILO to IHI in a total of 30 iterations
+ per eigenvalue; elements i+1:ihi of WR and WI
+ contain those eigenvalues which have been
+ successfully computed.
+
+ If INFO .GT. 0 and WANTT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the
+ eigenvalues of the upper Hessenberg matrix rows
+ and columns ILO thorugh INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+ (*) (initial value of H)*U = U*(final value of H)
+ where U is an orthognal matrix. The final
+ value of H is upper Hessenberg and triangular in
+ rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+ (final value of Z) = (initial value of Z)*U
+ where U is the orthogonal matrix in (*)
+ (regardless of the value of WANTT.)
+
+ Further Details
+ ===============
+
+ 02-96 Based on modifications by
+ David Day, Sandia National Laboratory, USA
+
+ 12-04 Further modifications by
+ Ralph Byers, University of Kansas, USA
+
+ This is a modified version of DLAHQR from LAPACK version 3.0.
+ It is (1) more robust against overflow and underflow and
+ (2) adopts the more conservative Ahues & Tisseur stopping
+ criterion (LAWN 122, 1997).
+
+ =========================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlahr2(int, int, int, double[], int, double[], double[], int, double[], int)"><!-- --></A><H3>
+dlahr2</H3>
+<PRE>
+public void <B>dlahr2</B>(int n,
+ int k,
+ int nb,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] t,
+ int ldt,
+ double[] y,
+ int ldy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an auxiliary routine called by DGEHRD.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+ K < N.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
+
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) DOUBLE PRECISION array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a a a a a )
+ ( a a a a a )
+ ( a a a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's DLAHRD
+ incorporating improvements proposed by Quintana-Orti and Van de
+ Gejin. Note that the entries of A(1:K,2:NB) differ from those
+ returned by the original LAPACK routine. This function is
+ not backward compatible with LAPACK3.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>y</CODE> - <DD><CODE>ldy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlahrd(int, int, int, double[], int, double[], double[], int, double[], int)"><!-- --></A><H3>
+dlahrd</H3>
+<PRE>
+public abstract void <B>dlahrd</B>(int n,
+ int k,
+ int nb,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] t,
+ int ldt,
+ double[] y,
+ int ldy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an OBSOLETE auxiliary routine.
+ This routine will be 'deprecated' in a future release.
+ Please use the new routine DLAHR2 instead.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
+
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) DOUBLE PRECISION array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a h a a a )
+ ( a h a a a )
+ ( a h a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>y</CODE> - <DD><CODE>ldy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaic1(int, int, double[], double, double[], double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlaic1</H3>
+<PRE>
+public abstract void <B>dlaic1</B>(int job,
+ int j,
+ double[] x,
+ double sest,
+ double[] w,
+ double gamma,
+ org.netlib.util.doubleW sestpr,
+ org.netlib.util.doubleW s,
+ org.netlib.util.doubleW c)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAIC1 applies one step of incremental condition estimation in
+ its simplest version:
+
+ Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
+ lower triangular matrix L, such that
+ twonorm(L*x) = sest
+ Then DLAIC1 computes sestpr, s, c such that
+ the vector
+ [ s*x ]
+ xhat = [ c ]
+ is an approximate singular vector of
+ [ L 0 ]
+ Lhat = [ w' gamma ]
+ in the sense that
+ twonorm(Lhat*xhat) = sestpr.
+
+ Depending on JOB, an estimate for the largest or smallest singular
+ value is computed.
+
+ Note that [s c]' and sestpr**2 is an eigenpair of the system
+
+ diag(sest*sest, 0) + [alpha gamma] * [ alpha ]
+ [ gamma ]
+
+ where alpha = x'*w.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ = 1: an estimate for the largest singular value is computed.
+
+ = 2: an estimate for the smallest singular value is computed.
+
+ J (input) INTEGER
+ Length of X and W
+
+ X (input) DOUBLE PRECISION array, dimension (J)
+ The j-vector x.
+
+ SEST (input) DOUBLE PRECISION
+ Estimated singular value of j by j matrix L
+
+ W (input) DOUBLE PRECISION array, dimension (J)
+ The j-vector w.
+
+ GAMMA (input) DOUBLE PRECISION
+ The diagonal element gamma.
+
+ SESTPR (output) DOUBLE PRECISION
+ Estimated singular value of (j+1) by (j+1) matrix Lhat.
+
+ S (output) DOUBLE PRECISION
+ Sine needed in forming xhat.
+
+ C (output) DOUBLE PRECISION
+ Cosine needed in forming xhat.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>j</CODE> - <DD><CODE>x</CODE> - <DD><CODE>sest</CODE> - <DD><CODE>w</CODE> - <DD><CODE>gamma</CODE> - <DD><CODE>sestpr</CODE> - <DD><CODE>s</CODE> - <DD><CODE>c</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaisnan(double, double)"><!-- --></A><H3>
+dlaisnan</H3>
+<PRE>
+public boolean <B>dlaisnan</B>(double din1,
+ double din2)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is not for general use. It exists solely to avoid
+ over-optimization in DISNAN.
+
+ DLAISNAN checks for NaNs by comparing its two arguments for
+ inequality. NaN is the only floating-point value where NaN != NaN
+ returns .TRUE. To check for NaNs, pass the same variable as both
+ arguments.
+
+ Strictly speaking, Fortran does not allow aliasing of function
+ arguments. So a compiler must assume that the two arguments are
+ not the same variable, and the test will not be optimized away.
+ Interprocedural or whole-program optimization may delete this
+ test. The ISNAN functions will be replaced by the correct
+ Fortran 03 intrinsic once the intrinsic is widely available.
+
+ Arguments
+ =========
+
+ DIN1 (input) DOUBLE PRECISION
+ DIN2 (input) DOUBLE PRECISION
+ Two numbers to compare for inequality.
+
+ =====================================================================
+
+ .. Executable Statements ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>din1</CODE> - <DD><CODE>din2</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaln2(boolean, int, int, double, double, double[], int, double, double, double[], int, double, double, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlaln2</H3>
+<PRE>
+public abstract void <B>dlaln2</B>(boolean ltrans,
+ int na,
+ int nw,
+ double smin,
+ double ca,
+ double[] a,
+ int lda,
+ double d1,
+ double d2,
+ double[] b,
+ int ldb,
+ double wr,
+ double wi,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW xnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALN2 solves a system of the form (ca A - w D ) X = s B
+ or (ca A' - w D) X = s B with possible scaling ("s") and
+ perturbation of A. (A' means A-transpose.)
+
+ A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
+ real diagonal matrix, w is a real or complex value, and X and B are
+ NA x 1 matrices -- real if w is real, complex if w is complex. NA
+ may be 1 or 2.
+
+ If w is complex, X and B are represented as NA x 2 matrices,
+ the first column of each being the real part and the second
+ being the imaginary part.
+
+ "s" is a scaling factor (.LE. 1), computed by DLALN2, which is
+ so chosen that X can be computed without overflow. X is further
+ scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
+ than overflow.
+
+ If both singular values of (ca A - w D) are less than SMIN,
+ SMIN*identity will be used instead of (ca A - w D). If only one
+ singular value is less than SMIN, one element of (ca A - w D) will be
+ perturbed enough to make the smallest singular value roughly SMIN.
+ If both singular values are at least SMIN, (ca A - w D) will not be
+ perturbed. In any case, the perturbation will be at most some small
+
+ multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
+ are computed by infinity-norm approximations, and thus will only be
+ correct to a factor of 2 or so.
+
+ Note: all input quantities are assumed to be smaller than overflow
+ by a reasonable factor. (See BIGNUM.)
+
+ Arguments
+ ==========
+
+ LTRANS (input) LOGICAL
+ =.TRUE.: A-transpose will be used.
+ =.FALSE.: A will be used (not transposed.)
+
+ NA (input) INTEGER
+ The size of the matrix A. It may (only) be 1 or 2.
+
+ NW (input) INTEGER
+ 1 if "w" is real, 2 if "w" is complex. It may only be 1
+ or 2.
+
+ SMIN (input) DOUBLE PRECISION
+ The desired lower bound on the singular values of A. This
+ should be a safe distance away from underflow or overflow,
+ say, between (underflow/machine precision) and (machine
+ precision * overflow ). (See BIGNUM and ULP.)
+
+ CA (input) DOUBLE PRECISION
+ The coefficient c, which A is multiplied by.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,NA)
+ The NA x NA matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of A. It must be at least NA.
+
+ D1 (input) DOUBLE PRECISION
+ The 1,1 element in the diagonal matrix D.
+
+ D2 (input) DOUBLE PRECISION
+ The 2,2 element in the diagonal matrix D. Not used if NW=1.
+
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NW)
+ The NA x NW matrix B (right-hand side). If NW=2 ("w" is
+ complex), column 1 contains the real part of B and column 2
+ contains the imaginary part.
+
+ LDB (input) INTEGER
+ The leading dimension of B. It must be at least NA.
+
+ WR (input) DOUBLE PRECISION
+ The real part of the scalar "w".
+
+ WI (input) DOUBLE PRECISION
+ The imaginary part of the scalar "w". Not used if NW=1.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NW)
+ The NA x NW matrix X (unknowns), as computed by DLALN2.
+ If NW=2 ("w" is complex), on exit, column 1 will contain
+ the real part of X and column 2 will contain the imaginary
+ part.
+
+ LDX (input) INTEGER
+ The leading dimension of X. It must be at least NA.
+
+ SCALE (output) DOUBLE PRECISION
+ The scale factor that B must be multiplied by to insure
+ that overflow does not occur when computing X. Thus,
+ (ca A - w D) X will be SCALE*B, not B (ignoring
+ perturbations of A.) It will be at most 1.
+
+ XNORM (output) DOUBLE PRECISION
+ The infinity-norm of X, when X is regarded as an NA x NW
+ real matrix.
+
+ INFO (output) INTEGER
+ An error flag. It will be set to zero if no error occurs,
+ a negative number if an argument is in error, or a positive
+ number if ca A - w D had to be perturbed.
+ The possible values are:
+ = 0: No error occurred, and (ca A - w D) did not have to be
+ perturbed.
+ = 1: (ca A - w D) had to be perturbed to make its smallest
+ (or only) singular value greater than SMIN.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ltrans</CODE> - <DD><CODE>na</CODE> - <DD><CODE>nw</CODE> - <DD><CODE>smin</CODE> - <DD><CODE>ca</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d1</CODE> - <DD><CODE>d2</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>xnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlals0(int, int, int, int, int, double[], int, double[], int, int[], int, int[], int, double[], int, double[], double[], double[], double[], int, double, double, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlals0</H3>
+<PRE>
+public abstract void <B>dlals0</B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ int nrhs,
+ double[] b,
+ int ldb,
+ double[] bx,
+ int ldbx,
+ int[] perm,
+ int givptr,
+ int[] givcol,
+ int ldgcol,
+ double[] givnum,
+ int ldgnum,
+ double[] poles,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ int k,
+ double c,
+ double s,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALS0 applies back the multiplying factors of either the left or the
+ right singular vector matrix of a diagonal matrix appended by a row
+ to the right hand side matrix B in solving the least squares problem
+
+ using the divide-and-conquer SVD approach.
+
+ For the left singular vector matrix, three types of orthogonal
+ matrices are involved:
+
+ (1L) Givens rotations: the number of such rotations is GIVPTR; the
+ pairs of columns/rows they were applied to are stored in GIVCOL;
+ and the C- and S-values of these rotations are stored in GIVNUM.
+
+ (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
+
+ row, and for J=2:N, PERM(J)-th row of B is to be moved to the
+ J-th row.
+
+ (3L) The left singular vector matrix of the remaining matrix.
+
+ For the right singular vector matrix, four types of orthogonal
+ matrices are involved:
+
+ (1R) The right singular vector matrix of the remaining matrix.
+
+ (2R) If SQRE = 1, one extra Givens rotation to generate the right
+ null space.
+
+ (3R) The inverse transformation of (2L).
+
+ (4R) The inverse transformation of (1L).
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Left singular vector matrix.
+ = 1: Right singular vector matrix.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB must be at least
+ max(1,MAX( M, N ) ).
+
+ BX (workspace) DOUBLE PRECISION array, dimension ( LDBX, NRHS )
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ PERM (input) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) applied
+ to the two blocks.
+
+ GIVPTR (input) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of rows/columns
+ involved in a Givens rotation.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value used in the
+ corresponding Givens rotation.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of arrays DIFR, POLES and
+ GIVNUM, must be at least K.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On entry, POLES(1:K, 1) contains the new singular
+ values obtained from solving the secular equation, and
+ POLES(1:K, 2) is an array containing the poles in the secular
+
+ equation.
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( K ).
+ On entry, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ).
+ On entry, DIFR(I, 1) contains the distances between I-th
+ updated (undeflated) singular value and the I+1-th
+ (undeflated) old singular value. And DIFR(I, 2) is the
+ normalizing factor for the I-th right singular vector.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ Contain the components of the deflation-adjusted updating row
+
+ vector.
+
+ K (input) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (input) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (input) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( K )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>bx</CODE> - <DD><CODE>ldbx</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>ldgnum</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>k</C [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlalsa(int, int, int, int, double[], int, double[], int, double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlalsa</H3>
+<PRE>
+public abstract void <B>dlalsa</B>(int icompq,
+ int smlsiz,
+ int n,
+ int nrhs,
+ double[] b,
+ int ldb,
+ double[] bx,
+ int ldbx,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int[] k,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ double[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ double[] givnum,
+ double[] c,
+ double[] s,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALSA is an itermediate step in solving the least squares problem
+ by computing the SVD of the coefficient matrix in compact form (The
+ singular vectors are computed as products of simple orthorgonal
+ matrices.).
+
+ If ICOMPQ = 0, DLALSA applies the inverse of the left singular vector
+ matrix of an upper bidiagonal matrix to the right hand side; and if
+ ICOMPQ = 1, DLALSA applies the right singular vector matrix to the
+ right hand side. The singular vector matrices were generated in
+ compact form by DLALSA.
+
+ Arguments
+ =========
+
+
+ ICOMPQ (input) INTEGER
+ Specifies whether the left or the right singular vector
+ matrix is involved.
+ = 0: Left singular vector matrix
+ = 1: Right singular vector matrix
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row and column dimensions of the upper bidiagonal matrix.
+
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M.
+ On output, B contains the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,MAX( M, N ) ).
+
+ BX (output) DOUBLE PRECISION array, dimension ( LDBX, NRHS )
+ On exit, the result of applying the left or right singular
+ vector matrix to B.
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ U (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ ).
+ On entry, U contains the left singular vector matrices of all
+
+ subproblems at the bottom level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR,
+ POLES, GIVNUM, and Z.
+
+ VT (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ+1 ).
+ On entry, VT' contains the right singular vector matrices of
+ all subproblems at the bottom level.
+
+ K (input) INTEGER array, dimension ( N ).
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
+ distances between singular values on the I-th level and
+ singular values on the (I -1)-th level, and DIFR(*, 2 * I)
+ record the normalizing factors of the right singular vectors
+ matrices of subproblems on I-th level.
+
+ Z (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ On entry, Z(1, I) contains the components of the deflation-
+ adjusted updating row vector for subproblems on the I-th
+ level.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
+ singular values involved in the secular equations on the I-th
+
+ level.
+
+ GIVPTR (input) INTEGER array, dimension ( N ).
+ On entry, GIVPTR( I ) records the number of Givens
+ rotations performed on the I-th problem on the computation
+ tree.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
+ On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
+
+ locations of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (input) INTEGER array, dimension ( LDGCOL, NLVL ).
+ On entry, PERM(*, I) records permutations done on the I-th
+ level of the computation tree.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
+ values of Givens rotations performed on the I-th level on the
+
+ computation tree.
+
+ C (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ S( I ) contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) DOUBLE PRECISION array.
+ The dimension must be at least N.
+
+ IWORK (workspace) INTEGER array.
+ The dimension must be at least 3 * N
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>bx</CODE> - <DD><CODE>ldbx</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>k</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>perm</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlalsd(java.lang.String, int, int, int, double[], double[], double[], int, double, org.netlib.util.intW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlalsd</H3>
+<PRE>
+public abstract void <B>dlalsd</B>(java.lang.String uplo,
+ int smlsiz,
+ int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb,
+ double rcond,
+ org.netlib.util.intW rank,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALSD uses the singular value decomposition of A to solve the least
+
+ squares problem of finding X to minimize the Euclidean norm of each
+ column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
+ are N-by-NRHS. The solution X overwrites B.
+
+ The singular values of A smaller than RCOND times the largest
+ singular value are treated as zero in solving the least squares
+ problem; in this case a minimum norm solution is returned.
+ The actual singular values are returned in D in ascending order.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': D and E define an upper bidiagonal matrix.
+ = 'L': D and E define a lower bidiagonal matrix.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The dimension of the bidiagonal matrix. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of columns of B. NRHS must be at least 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit, if INFO = 0, D contains its singular values.
+
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ Contains the super-diagonal entries of the bidiagonal matrix.
+
+ On exit, E has been destroyed.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On input, B contains the right hand sides of the least
+ squares problem. On output, B contains the solution X.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,N).
+
+ RCOND (input) DOUBLE PRECISION
+ The singular values of A less than or equal to RCOND times
+ the largest singular value are treated as zero in solving
+ the least squares problem. If RCOND is negative,
+ machine precision is used instead.
+ For example, if diag(S)*X=B were the least squares problem,
+ where diag(S) is a diagonal matrix of singular values, the
+ solution would be X(i) = B(i) / S(i) if S(i) is greater than
+ RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
+ RCOND*max(S).
+
+ RANK (output) INTEGER
+ The number of singular values of A greater than RCOND times
+ the largest singular value.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension at least
+ (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
+ where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
+
+ IWORK (workspace) INTEGER array, dimension at least
+ (3*N*NLVL + 11*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value while
+
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through MOD(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamrg(int, int, double[], int, int, int[])"><!-- --></A><H3>
+dlamrg</H3>
+<PRE>
+public abstract void <B>dlamrg</B>(int n1,
+ int n2,
+ double[] a,
+ int dtrd1,
+ int dtrd2,
+ int[] index)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMRG will create a permutation list which will merge the elements
+ of A (which is composed of two independently sorted sets) into a
+ single set which is sorted in ascending order.
+
+ Arguments
+ =========
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ These arguements contain the respective lengths of the two
+ sorted lists to be merged.
+
+ A (input) DOUBLE PRECISION array, dimension (N1+N2)
+ The first N1 elements of A contain a list of numbers which
+ are sorted in either ascending or descending order. Likewise
+
+ for the final N2 elements.
+
+ DTRD1 (input) INTEGER
+ DTRD2 (input) INTEGER
+ These are the strides to be taken through the array A.
+ Allowable strides are 1 and -1. They indicate whether a
+ subset of A is sorted in ascending (DTRDx = 1) or descending
+ (DTRDx = -1) order.
+
+ INDEX (output) INTEGER array, dimension (N1+N2)
+ On exit this array will contain a permutation such that
+ if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
+ sorted in ascending order.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>a</CODE> - <DD><CODE>dtrd1</CODE> - <DD><CODE>dtrd2</CODE> - <DD><CODE>index</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaneg(int, double[], double[], double, double, int)"><!-- --></A><H3>
+dlaneg</H3>
+<PRE>
+public int <B>dlaneg</B>(int n,
+ double[] d,
+ double[] lld,
+ double sigma,
+ double pivmin,
+ int r)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANEG computes the Sturm count, the number of negative pivots
+ encountered while factoring tridiagonal T - sigma I = L D L^T.
+ This implementation works directly on the factors without forming
+ the tridiagonal matrix T. The Sturm count is also the number of
+ eigenvalues of T less than sigma.
+
+ This routine is called from DLARRB.
+
+ The current routine does not use the PIVMIN parameter but rather
+ requires IEEE-754 propagation of Infinities and NaNs. This
+ routine also has no input range restrictions but does require
+ default exception handling such that x/0 produces Inf when x is
+ non-zero, and Inf/Inf produces NaN. For more information, see:
+
+ Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
+ Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
+ Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
+ (Tech report version in LAWN 172 with the same title.)
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ SIGMA (input) DOUBLE PRECISION
+ Shift amount in T - sigma I = L D L^T.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence. May be used
+ when zero pivots are encountered on non-IEEE-754
+ architectures.
+
+ R (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+ Jason Riedy, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>lld</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>r</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlangb(java.lang.String, int, int, int, double[], int, double[])"><!-- --></A><H3>
+dlangb</H3>
+<PRE>
+public double <B>dlangb</B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANGB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
+
+ Description
+ ===========
+
+ DLANGB returns the value
+
+ DLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGB as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANGB is
+ set to zero.
+
+ KL (input) INTEGER
+ The number of sub-diagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of super-diagonals of the matrix A. KU >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlange(java.lang.String, int, int, double[], int, double[])"><!-- --></A><H3>
+dlange</H3>
+<PRE>
+public double <B>dlange</B>(java.lang.String norm,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANGE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real matrix A.
+
+ Description
+ ===========
+
+ DLANGE returns the value
+
+ DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGE as described
+ above.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0. When M = 0,
+ DLANGE is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0. When N = 0,
+
+ DLANGE is set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlangt(java.lang.String, int, double[], double[], double[])"><!-- --></A><H3>
+dlangt</H3>
+<PRE>
+public double <B>dlangt</B>(java.lang.String norm,
+ int n,
+ double[] dl,
+ double[] d,
+ double[] du)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANGT returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real tridiagonal matrix A.
+
+ Description
+ ===========
+
+ DLANGT returns the value
+
+ DLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGT as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANGT is
+ set to zero.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal elements of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlanhs(java.lang.String, int, double[], int, double[])"><!-- --></A><H3>
+dlanhs</H3>
+<PRE>
+public double <B>dlanhs</B>(java.lang.String norm,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANHS returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ Hessenberg matrix A.
+
+ Description
+ ===========
+
+ DLANHS returns the value
+
+ DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANHS as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANHS is
+ set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The n by n upper Hessenberg matrix A; the part of A below the
+ first sub-diagonal is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlansb(java.lang.String, java.lang.String, int, int, double[], int, double[])"><!-- --></A><H3>
+dlansb</H3>
+<PRE>
+public double <B>dlansb</B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ int k,
+ double[] ab,
+ int ldab,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANSB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n symmetric band matrix A, with k super-diagonals.
+
+ Description
+ ===========
+
+ DLANSB returns the value
+
+ DLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ band matrix A is supplied.
+ = 'U': Upper triangular part is supplied
+ = 'L': Lower triangular part is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals or sub-diagonals of the
+ band matrix A. K >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first K+1 rows of AB. The j-th column of A is
+
+ stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlansp(java.lang.String, java.lang.String, int, double[], double[])"><!-- --></A><H3>
+dlansp</H3>
+<PRE>
+public double <B>dlansp</B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANSP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ DLANSP returns the value
+
+ DLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is supplied.
+ = 'U': Upper triangular part of A is supplied
+ = 'L': Lower triangular part of A is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSP is
+ set to zero.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlanst(java.lang.String, int, double[], double[])"><!-- --></A><H3>
+dlanst</H3>
+<PRE>
+public double <B>dlanst</B>(java.lang.String norm,
+ int n,
+ double[] d,
+ double[] e)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANST returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric tridiagonal matrix A.
+
+ Description
+ ===========
+
+ DLANST returns the value
+
+ DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANST as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANST is
+ set to zero.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal or super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlansy(java.lang.String, java.lang.String, int, double[], int, double[])"><!-- --></A><H3>
+dlansy</H3>
+<PRE>
+public double <B>dlansy</B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANSY returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A.
+
+ Description
+ ===========
+
+ DLANSY returns the value
+
+ DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSY as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is to be referenced.
+ = 'U': Upper triangular part of A is referenced
+ = 'L': Lower triangular part of A is referenced
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSY is
+ set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlantb(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[])"><!-- --></A><H3>
+dlantb</H3>
+<PRE>
+public double <B>dlantb</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int k,
+ double[] ab,
+ int ldab,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANTB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n triangular band matrix A, with ( k + 1 ) diagonals.
+
+ Description
+ ===========
+
+ DLANTB returns the value
+
+ DLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANTB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANTB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals of the matrix A if UPLO = 'L'.
+ K >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first k+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+ Note that when DIAG = 'U', the elements of the array AB
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlantp(java.lang.String, java.lang.String, java.lang.String, int, double[], double[])"><!-- --></A><H3>
+dlantp</H3>
+<PRE>
+public double <B>dlantp</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANTP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ triangular matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ DLANTP returns the value
+
+ DLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANTP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANTP is
+ set to zero.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ Note that when DIAG = 'U', the elements of the array AP
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlantr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[])"><!-- --></A><H3>
+dlantr</H3>
+<PRE>
+public double <B>dlantr</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANTR returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ trapezoidal or triangular matrix A.
+
+ Description
+ ===========
+
+ DLANTR returns the value
+
+ DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANTR as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower trapezoidal.
+ = 'U': Upper trapezoidal
+ = 'L': Lower trapezoidal
+ Note that A is triangular instead of trapezoidal if M = N.
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A has unit diagonal.
+ = 'N': Non-unit diagonal
+ = 'U': Unit diagonal
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0, and if
+ UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0, and if
+ UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The trapezoidal matrix A (A is triangular if M = N).
+ If UPLO = 'U', the leading m by n upper trapezoidal part of
+ the array A contains the upper trapezoidal matrix, and the
+ strictly lower triangular part of A is not referenced.
+ If UPLO = 'L', the leading m by n lower trapezoidal part of
+ the array A contains the lower trapezoidal matrix, and the
+ strictly upper triangular part of A is not referenced. Note
+
+ that when DIAG = 'U', the diagonal elements of A are not
+ referenced and are assumed to be one.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlanv2(org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlanv2</H3>
+<PRE>
+public abstract void <B>dlanv2</B>(org.netlib.util.doubleW a,
+ org.netlib.util.doubleW b,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW d,
+ org.netlib.util.doubleW rt1r,
+ org.netlib.util.doubleW rt1i,
+ org.netlib.util.doubleW rt2r,
+ org.netlib.util.doubleW rt2i,
+ org.netlib.util.doubleW cs,
+ org.netlib.util.doubleW sn)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
+ matrix in standard form:
+
+ [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
+ [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
+
+ where either
+ 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
+ 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
+ conjugate eigenvalues.
+
+ Arguments
+ =========
+
+ A (input/output) DOUBLE PRECISION
+ B (input/output) DOUBLE PRECISION
+ C (input/output) DOUBLE PRECISION
+ D (input/output) DOUBLE PRECISION
+ On entry, the elements of the input matrix.
+ On exit, they are overwritten by the elements of the
+ standardised Schur form.
+
+ RT1R (output) DOUBLE PRECISION
+ RT1I (output) DOUBLE PRECISION
+ RT2R (output) DOUBLE PRECISION
+ RT2I (output) DOUBLE PRECISION
+ The real and imaginary parts of the eigenvalues. If the
+ eigenvalues are a complex conjugate pair, RT1I > 0.
+
+ CS (output) DOUBLE PRECISION
+ SN (output) DOUBLE PRECISION
+ Parameters of the rotation matrix.
+
+ Further Details
+ ===============
+
+ Modified by V. Sima, Research Institute for Informatics, Bucharest,
+ Romania, to reduce the risk of cancellation errors,
+ when computing real eigenvalues, and to ensure, if possible, that
+ abs(RT1R) >= abs(RT2R).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>rt1r</CODE> - <DD><CODE>rt1i</CODE> - <DD><CODE>rt2r</CODE> - <DD><CODE>rt2i</CODE> - <DD><CODE>cs</CODE> - <DD><CODE>sn</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlapll(int, double[], int, double[], int, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlapll</H3>
+<PRE>
+public abstract void <B>dlapll</B>(int n,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ org.netlib.util.doubleW ssmin)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given two column vectors X and Y, let
+
+ A = ( X Y ).
+
+ The subroutine first computes the QR factorization of A = Q*R,
+ and then computes the SVD of the 2-by-2 upper triangular matrix R.
+ The smaller singular value of R is returned in SSMIN, which is used
+ as the measurement of the linear dependency of the vectors X and Y.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of the vectors X and Y.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ On entry, X contains the N-vector X.
+ On exit, X is overwritten.
+
+ INCX (input) INTEGER
+ The increment between successive elements of X. INCX > 0.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCY)
+ On entry, Y contains the N-vector Y.
+ On exit, Y is overwritten.
+
+ INCY (input) INTEGER
+ The increment between successive elements of Y. INCY > 0.
+
+ SSMIN (output) DOUBLE PRECISION
+ The smallest singular value of the N-by-2 matrix A = ( X Y ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>ssmin</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlapmt(boolean, int, int, double[], int, int[])"><!-- --></A><H3>
+dlapmt</H3>
+<PRE>
+public abstract void <B>dlapmt</B>(boolean forwrd,
+ int m,
+ int n,
+ double[] x,
+ int ldx,
+ int[] k)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAPMT rearranges the columns of the M by N matrix X as specified
+ by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+ If FORWRD = .TRUE., forward permutation:
+
+ X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+
+ If FORWRD = .FALSE., backward permutation:
+
+ X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+
+ Arguments
+ =========
+
+ FORWRD (input) LOGICAL
+ = .TRUE., forward permutation
+ = .FALSE., backward permutation
+
+ M (input) INTEGER
+ The number of rows of the matrix X. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix X. N >= 0.
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,N)
+ On entry, the M by N matrix X.
+ On exit, X contains the permuted matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X, LDX >= MAX(1,M).
+
+ K (input/output) INTEGER array, dimension (N)
+ On entry, K contains the permutation vector. K is used as
+ internal workspace, but reset to its original value on
+ output.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>forwrd</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>k</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlapy2(double, double)"><!-- --></A><H3>
+dlapy2</H3>
+<PRE>
+public double <B>dlapy2</B>(double x,
+ double y)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+
+ overflow.
+
+ Arguments
+ =========
+
+ X (input) DOUBLE PRECISION
+ Y (input) DOUBLE PRECISION
+ X and Y specify the values x and y.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>x</CODE> - <DD><CODE>y</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlapy3(double, double, double)"><!-- --></A><H3>
+dlapy3</H3>
+<PRE>
+public double <B>dlapy3</B>(double x,
+ double y,
+ double z)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+ unnecessary overflow.
+
+ Arguments
+ =========
+
+ X (input) DOUBLE PRECISION
+ Y (input) DOUBLE PRECISION
+ Z (input) DOUBLE PRECISION
+ X, Y and Z specify the values x, y and z.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>x</CODE> - <DD><CODE>y</CODE> - <DD><CODE>z</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqgb(int, int, int, int, double[], int, double[], double[], double, double, double, org.netlib.util.StringW)"><!-- --></A><H3>
+dlaqgb</H3>
+<PRE>
+public abstract void <B>dlaqgb</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ double[] ab,
+ int ldab,
+ double[] r,
+ double[] c,
+ double rowcnd,
+ double colcnd,
+ double amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQGB equilibrates a general M by N band matrix A with KL
+ subdiagonals and KU superdiagonals using the row and scaling factors
+
+ in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, the equilibrated matrix, in the same storage format
+
+ as A. See EQUED for the form of the equilibrated matrix.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDA >= KL+KU+1.
+
+ R (input) DOUBLE PRECISION array, dimension (M)
+ The row scale factors for A.
+
+ C (input) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) DOUBLE PRECISION
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) DOUBLE PRECISION
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqge(int, int, double[], int, double[], double[], double, double, double, org.netlib.util.StringW)"><!-- --></A><H3>
+dlaqge</H3>
+<PRE>
+public abstract void <B>dlaqge</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] r,
+ double[] c,
+ double rowcnd,
+ double colcnd,
+ double amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQGE equilibrates a general M by N matrix A using the row and
+ column scaling factors in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M by N matrix A.
+ On exit, the equilibrated matrix. See EQUED for the form of
+
+ the equilibrated matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ R (input) DOUBLE PRECISION array, dimension (M)
+ The row scale factors for A.
+
+ C (input) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) DOUBLE PRECISION
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) DOUBLE PRECISION
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqp2(int, int, int, double[], int, int[], double[], double[], double[], double[])"><!-- --></A><H3>
+dlaqp2</H3>
+<PRE>
+public abstract void <B>dlaqp2</B>(int m,
+ int n,
+ int offset,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] vn1,
+ double[] vn2,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQP2 computes a QR factorization with column pivoting of
+ the block A(OFFSET+1:M,1:N).
+ The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ OFFSET (input) INTEGER
+ The number of rows of the matrix A that must be pivoted
+ but no factorized. OFFSET >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
+ the triangular factor obtained; the elements in block
+ A(OFFSET+1:M,1:N) below the diagonal, together with the
+ array TAU, represent the orthogonal matrix Q as a product of
+
+ elementary reflectors. Block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the exact column norms.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>vn1</CODE> - <DD><CODE>vn2</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqps(int, int, int, int, org.netlib.util.intW, double[], int, int[], double[], double[], double[], double[], double[], int)"><!-- --></A><H3>
+dlaqps</H3>
+<PRE>
+public abstract void <B>dlaqps</B>(int m,
+ int n,
+ int offset,
+ int nb,
+ org.netlib.util.intW kb,
+ double[] a,
+ int lda,
+ int[] jpvt,
+ double[] tau,
+ double[] vn1,
+ double[] vn2,
+ double[] auxv,
+ double[] f,
+ int ldf)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQPS computes a step of QR factorization with column pivoting
+ of a real M-by-N matrix A by using Blas-3. It tries to factorize
+ NB columns from A starting from the row OFFSET+1, and updates all
+ of the matrix with Blas-3 xGEMM.
+
+ In some cases, due to catastrophic cancellations, it cannot
+ factorize NB columns. Hence, the actual number of factorized
+ columns is returned in KB.
+
+ Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ OFFSET (input) INTEGER
+ The number of rows of A that have been factorized in
+ previous steps.
+
+ NB (input) INTEGER
+ The number of columns to factorize.
+
+ KB (output) INTEGER
+ The number of columns actually factorized.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, block A(OFFSET+1:M,1:KB) is the triangular
+ factor obtained and block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+ The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
+ been updated.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ JPVT(I) = K <==> Column K of the full matrix A has been
+ permuted into position I in AP.
+
+ TAU (output) DOUBLE PRECISION array, dimension (KB)
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the exact column norms.
+
+ AUXV (input/output) DOUBLE PRECISION array, dimension (NB)
+ Auxiliar vector.
+
+ F (input/output) DOUBLE PRECISION array, dimension (LDF,NB)
+ Matrix F' = L*Y'*A.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1,N).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>vn1</CODE> - <DD><CODE>vn2</CODE> - <DD><CODE>auxv</CODE> - <DD><CODE>f</CODE> - <DD><CODE>ldf</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqr0(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlaqr0</H3>
+<PRE>
+public void <B>dlaqr0</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQR0 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to DGEBAL, and then passed to DGEHRD when the
+
+ matrix output by DGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (IHI)
+ WI (output) DOUBLE PRECISION array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then DLAQR0 does a workspace query.
+ In this case, DLAQR0 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, DLAQR0 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . DLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqr1(int, double[], int, double, double, double, double, double[])"><!-- --></A><H3>
+dlaqr1</H3>
+<PRE>
+public void <B>dlaqr1</B>(int n,
+ double[] h,
+ int ldh,
+ double sr1,
+ double si1,
+ double sr2,
+ double si2,
+ double[] v)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a
+ scalar multiple of the first column of the product
+
+ (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
+
+ scaling to avoid overflows and most underflows. It
+ is assumed that either
+
+ 1) sr1 = sr2 and si1 = -si2
+ or
+ 2) si1 = si2 = 0.
+
+ This is useful for starting double implicit shift bulges
+ in the QR algorithm.
+
+
+ N (input) integer
+ Order of the matrix H. N must be either 2 or 3.
+
+ H (input) DOUBLE PRECISION array of dimension (LDH,N)
+ The 2-by-2 or 3-by-3 matrix H in (*).
+
+ LDH (input) integer
+ The leading dimension of H as declared in
+ the calling procedure. LDH.GE.N
+
+ SR1 (input) DOUBLE PRECISION
+ SI1 The shifts in (*).
+ SR2
+ SI2
+
+ V (output) DOUBLE PRECISION array of dimension N
+ A scalar multiple of the first column of the
+ matrix K in (*).
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>sr1</CODE> - <DD><CODE>si1</CODE> - <DD><CODE>sr2</CODE> - <DD><CODE>si2</CODE> - <DD><CODE>v</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqr2(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)"><!-- --></A><H3>
+dlaqr2</H3>
+<PRE>
+public void <B>dlaqr2</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ double[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ double[] sr,
+ double[] si,
+ double[] v,
+ int ldv,
+ int nh,
+ double[] t,
+ int ldt,
+ int nv,
+ double[] wv,
+ int ldwv,
+ double[] work,
+ int lwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ This subroutine is identical to DLAQR3 except that it avoids
+ recursion by calling DLAHQR instead of DLAQR4.
+
+
+
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) DOUBLE PRECISION array, dimension KBOT
+ SI (output) DOUBLE PRECISION array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) DOUBLE PRECISION array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) DOUBLE PRECISION array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) DOUBLE PRECISION array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) DOUBLE PRECISION array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; DLAQR2
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ktop</CODE> - <DD><CODE>kbot</CODE> - <DD><CODE>nw</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>ns</CODE> - <DD><CODE>nd</CODE> - <DD><CODE>sr</CODE> - <DD><CODE>si</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>nh</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</COD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqr3(boolean, boolean, int, int, int, int, double[], int, int, int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], double[], double[], int, int, double[], int, int, double[], int, double[], int)"><!-- --></A><H3>
+dlaqr3</H3>
+<PRE>
+public void <B>dlaqr3</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ double[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ double[] sr,
+ double[] si,
+ double[] v,
+ int ldv,
+ int nh,
+ double[] t,
+ int ldt,
+ int nv,
+ double[] wv,
+ int ldwv,
+ double[] work,
+ int lwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) DOUBLE PRECISION array, dimension KBOT
+ SI (output) DOUBLE PRECISION array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) DOUBLE PRECISION array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) DOUBLE PRECISION array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) DOUBLE PRECISION array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) DOUBLE PRECISION array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; DLAQR3
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ==================================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ktop</CODE> - <DD><CODE>kbot</CODE> - <DD><CODE>nw</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>ns</CODE> - <DD><CODE>nd</CODE> - <DD><CODE>sr</CODE> - <DD><CODE>si</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>nh</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</COD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqr4(boolean, boolean, int, int, int, double[], int, double[], double[], int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlaqr4</H3>
+<PRE>
+public void <B>dlaqr4</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ double[] h,
+ int ldh,
+ double[] wr,
+ double[] wi,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ This subroutine implements one level of recursion for DLAQR0.
+ It is a complete implementation of the small bulge multi-shift
+ QR algorithm. It may be called by DLAQR0 and, for large enough
+ deflation window size, it may be called by DLAQR3. This
+ subroutine is identical to DLAQR0 except that it calls DLAQR2
+ instead of DLAQR3.
+
+ Purpose
+ =======
+
+ DLAQR4 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to DGEBAL, and then passed to DGEHRD when the
+
+ matrix output by DGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (IHI)
+ WI (output) DOUBLE PRECISION array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then DLAQR4 does a workspace query.
+ In this case, DLAQR4 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, DLAQR4 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . DLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqr5(boolean, boolean, int, int, int, int, int, double[], double[], double[], int, int, int, double[], int, double[], int, double[], int, int, double[], int, int, double[], int)"><!-- --></A><H3>
+dlaqr5</H3>
+<PRE>
+public void <B>dlaqr5</B>(boolean wantt,
+ boolean wantz,
+ int kacc22,
+ int n,
+ int ktop,
+ int kbot,
+ int nshfts,
+ double[] sr,
+ double[] si,
+ double[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ double[] z,
+ int ldz,
+ double[] v,
+ int ldv,
+ double[] u,
+ int ldu,
+ int nv,
+ double[] wv,
+ int ldwv,
+ int nh,
+ double[] wh,
+ int ldwh)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ This auxiliary subroutine called by DLAQR0 performs a
+ single small-bulge multi-shift QR sweep.
+
+ WANTT (input) logical scalar
+ WANTT = .true. if the quasi-triangular Schur factor
+ is being computed. WANTT is set to .false. otherwise.
+
+ WANTZ (input) logical scalar
+ WANTZ = .true. if the orthogonal Schur factor is being
+ computed. WANTZ is set to .false. otherwise.
+
+ KACC22 (input) integer with value 0, 1, or 2.
+ Specifies the computation mode of far-from-diagonal
+ orthogonal updates.
+ = 0: DLAQR5 does not accumulate reflections and does not
+ use matrix-matrix multiply to update far-from-diagonal
+ matrix entries.
+ = 1: DLAQR5 accumulates reflections and uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries.
+ = 2: DLAQR5 accumulates reflections, uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries,
+ and takes advantage of 2-by-2 block structure during
+ matrix multiplies.
+
+ N (input) integer scalar
+ N is the order of the Hessenberg matrix H upon which this
+
+ subroutine operates.
+
+ KTOP (input) integer scalar
+ KBOT (input) integer scalar
+ These are the first and last rows and columns of an
+ isolated diagonal block upon which the QR sweep is to be
+ applied. It is assumed without a check that
+ either KTOP = 1 or H(KTOP,KTOP-1) = 0
+ and
+ either KBOT = N or H(KBOT+1,KBOT) = 0.
+
+ NSHFTS (input) integer scalar
+ NSHFTS gives the number of simultaneous shifts. NSHFTS
+ must be positive and even.
+
+ SR (input) DOUBLE PRECISION array of size (NSHFTS)
+ SI (input) DOUBLE PRECISION array of size (NSHFTS)
+ SR contains the real parts and SI contains the imaginary
+ parts of the NSHFTS shifts of origin that define the
+ multi-shift QR sweep.
+
+ H (input/output) DOUBLE PRECISION array of size (LDH,N)
+ On input H contains a Hessenberg matrix. On output a
+ multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
+
+ to the isolated diagonal block in rows and columns KTOP
+ through KBOT.
+
+ LDH (input) integer scalar
+ LDH is the leading dimension of H just as declared in the
+
+ calling procedure. LDH.GE.MAX(1,N).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
+
+ Z (input/output) DOUBLE PRECISION array of size (LDZ,IHI)
+ If WANTZ = .TRUE., then the QR Sweep orthogonal
+ similarity transformation is accumulated into
+ Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ = .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer scalar
+ LDA is the leading dimension of Z just as declared in
+ the calling procedure. LDZ.GE.N.
+
+ V (workspace) DOUBLE PRECISION array of size (LDV,NSHFTS/2)
+
+
+ LDV (input) integer scalar
+ LDV is the leading dimension of V as declared in the
+ calling procedure. LDV.GE.3.
+
+ U (workspace) DOUBLE PRECISION array of size
+ (LDU,3*NSHFTS-3)
+
+ LDU (input) integer scalar
+ LDU is the leading dimension of U just as declared in the
+
+ in the calling subroutine. LDU.GE.3*NSHFTS-3.
+
+ NH (input) integer scalar
+ NH is the number of columns in array WH available for
+ workspace. NH.GE.1.
+
+ WH (workspace) DOUBLE PRECISION array of size (LDWH,NH)
+
+ LDWH (input) integer scalar
+ Leading dimension of WH just as declared in the
+ calling procedure. LDWH.GE.3*NSHFTS-3.
+
+ NV (input) integer scalar
+ NV is the number of rows in WV agailable for workspace.
+ NV.GE.1.
+
+ WV (workspace) DOUBLE PRECISION array of size
+ (LDWV,3*NSHFTS-3)
+
+ LDWV (input) integer scalar
+ LDWV is the leading dimension of WV as declared in the
+ in the calling subroutine. LDWV.GE.NV.
+
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ============================================================
+ Reference:
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and
+ Level 3 Performance, SIAM Journal of Matrix Analysis,
+ volume 23, pages 929--947, 2002.
+
+ ============================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>kacc22</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ktop</CODE> - <DD><CODE>kbot</CODE> - <DD><CODE>nshfts</CODE> - <DD><CODE>sr</CODE> - <DD><CODE>si</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>nv</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqsb(java.lang.String, int, int, double[], int, double[], double, double, org.netlib.util.StringW)"><!-- --></A><H3>
+dlaqsb</H3>
+<PRE>
+public abstract void <B>dlaqsb</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] s,
+ double scond,
+ double amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQSB equilibrates a symmetric band matrix A using the scaling
+ factors in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ S (input) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) DOUBLE PRECISION
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqsp(java.lang.String, int, double[], double[], double, double, org.netlib.util.StringW)"><!-- --></A><H3>
+dlaqsp</H3>
+<PRE>
+public abstract void <B>dlaqsp</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] s,
+ double scond,
+ double amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQSP equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the equilibrated matrix: diag(S) * A * diag(S), in
+
+ the same storage format as A.
+
+ S (input) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) DOUBLE PRECISION
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqsy(java.lang.String, int, double[], int, double[], double, double, org.netlib.util.StringW)"><!-- --></A><H3>
+dlaqsy</H3>
+<PRE>
+public abstract void <B>dlaqsy</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] s,
+ double scond,
+ double amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQSY equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if EQUED = 'Y', the equilibrated matrix:
+ diag(S) * A * diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ S (input) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) DOUBLE PRECISION
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaqtr(boolean, boolean, int, double[], int, double[], double, org.netlib.util.doubleW, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlaqtr</H3>
+<PRE>
+public abstract void <B>dlaqtr</B>(boolean ltran,
+ boolean lreal,
+ int n,
+ double[] t,
+ int ldt,
+ double[] b,
+ double w,
+ org.netlib.util.doubleW scale,
+ double[] x,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQTR solves the real quasi-triangular system
+
+ op(T)*p = scale*c, if LREAL = .TRUE.
+
+ or the complex quasi-triangular systems
+
+ op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
+
+ in real arithmetic, where T is upper quasi-triangular.
+ If LREAL = .FALSE., then the first diagonal block of T must be
+ 1 by 1, B is the specially structured matrix
+
+ B = [ b(1) b(2) ... b(n) ]
+ [ w ]
+ [ w ]
+ [ . ]
+ [ w ]
+
+ op(A) = A or A', A' denotes the conjugate transpose of
+ matrix A.
+
+ On input, X = [ c ]. On output, X = [ p ].
+ [ d ] [ q ]
+
+ This subroutine is designed for the condition number estimation
+ in routine DTRSNA.
+
+ Arguments
+ =========
+
+ LTRAN (input) LOGICAL
+ On entry, LTRAN specifies the option of conjugate transpose:
+
+ = .FALSE., op(T+i*B) = T+i*B,
+ = .TRUE., op(T+i*B) = (T+i*B)'.
+
+ LREAL (input) LOGICAL
+ On entry, LREAL specifies the input matrix structure:
+ = .FALSE., the input is complex
+ = .TRUE., the input is real
+
+ N (input) INTEGER
+ On entry, N specifies the order of T+i*B. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, T contains a matrix in Schur canonical form.
+ If LREAL = .FALSE., then the first diagonal block of T mu
+ be 1 by 1.
+
+ LDT (input) INTEGER
+ The leading dimension of the matrix T. LDT >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (N)
+ On entry, B contains the elements to form the matrix
+ B as described above.
+ If LREAL = .TRUE., B is not referenced.
+
+ W (input) DOUBLE PRECISION
+ On entry, W is the diagonal element of the matrix B.
+ If LREAL = .TRUE., W is not referenced.
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, SCALE is the scale factor.
+
+ X (input/output) DOUBLE PRECISION array, dimension (2*N)
+ On entry, X contains the right hand side of the system.
+ On exit, X is overwritten by the solution.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: the some diagonal 1 by 1 block has been perturbed by
+
+ a small number SMIN to keep nonsingularity.
+ 2: the some diagonal 2 by 2 block has been perturbed by
+
+ a small number in DLALN2 to keep nonsingularity.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ltran</CODE> - <DD><CODE>lreal</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>b</CODE> - <DD><CODE>w</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>x</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlar1v(int, int, int, double, double[], double[], double[], double[], double, double, double[], boolean, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, int[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[])"><!-- --></A><H3>
+dlar1v</H3>
+<PRE>
+public void <B>dlar1v</B>(int n,
+ int b1,
+ int bn,
+ double lambda,
+ double[] d,
+ double[] l,
+ double[] ld,
+ double[] lld,
+ double pivmin,
+ double gaptol,
+ double[] z,
+ boolean wantnc,
+ org.netlib.util.intW negcnt,
+ org.netlib.util.doubleW ztz,
+ org.netlib.util.doubleW mingma,
+ org.netlib.util.intW r,
+ int[] isuppz,
+ org.netlib.util.doubleW nrminv,
+ org.netlib.util.doubleW resid,
+ org.netlib.util.doubleW rqcorr,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAR1V computes the (scaled) r-th column of the inverse of
+ the sumbmatrix in rows B1 through BN of the tridiagonal matrix
+ L D L^T - sigma I. When sigma is close to an eigenvalue, the
+ computed vector is an accurate eigenvector. Usually, r corresponds
+ to the index where the eigenvector is largest in magnitude.
+ The following steps accomplish this computation :
+ (a) Stationary qd transform, L D L^T - sigma I = L(+) D(+) L(+)^T,
+ (b) Progressive qd transform, L D L^T - sigma I = U(-) D(-) U(-)^T,
+ (c) Computation of the diagonal elements of the inverse of
+ L D L^T - sigma I by combining the above transforms, and choosing
+ r as the index where the diagonal of the inverse is (one of the)
+
+ largest in magnitude.
+ (d) Computation of the (scaled) r-th column of the inverse using the
+
+ twisted factorization obtained by combining the top part of the
+ the stationary and the bottom part of the progressive transform.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix L D L^T.
+
+ B1 (input) INTEGER
+ First index of the submatrix of L D L^T.
+
+ BN (input) INTEGER
+ Last index of the submatrix of L D L^T.
+
+ LAMBDA (input) DOUBLE PRECISION
+ The shift. In order to compute an accurate eigenvector,
+ LAMBDA should be a good approximation to an eigenvalue
+ of L D L^T.
+
+ L (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal matrix
+ L, in elements 1 to N-1.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D.
+
+ LD (input) DOUBLE PRECISION array, dimension (N-1)
+ The n-1 elements L(i)*D(i).
+
+ LLD (input) DOUBLE PRECISION array, dimension (N-1)
+ The n-1 elements L(i)*L(i)*D(i).
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence.
+
+ GAPTOL (input) DOUBLE PRECISION
+ Tolerance that indicates when eigenvector entries are neglig
+ w.r.t. their contribution to the residual.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, all entries of Z must be set to 0.
+ On output, Z contains the (scaled) r-th column of the
+ inverse. The scaling is such that Z(R) equals 1.
+
+ WANTNC (input) LOGICAL
+ Specifies whether NEGCNT has to be computed.
+
+ NEGCNT (output) INTEGER
+ If WANTNC is .TRUE. then NEGCNT = the number of pivots < piv
+ in the matrix factorization L D L^T, and NEGCNT = -1 otherw
+
+ ZTZ (output) DOUBLE PRECISION
+ The square of the 2-norm of Z.
+
+ MINGMA (output) DOUBLE PRECISION
+ The reciprocal of the largest (in magnitude) diagonal
+ element of the inverse of L D L^T - sigma I.
+
+ R (input/output) INTEGER
+ The twist index for the twisted factorization used to
+ compute Z.
+ On input, 0 <= R <= N. If R is input as 0, R is set to
+ the index where (L D L^T - sigma I)^{-1} is largest
+ in magnitude. If 1 <= R <= N, R is unchanged.
+ On output, R contains the twist index used to compute Z.
+ Ideally, R designates the position of the maximum entry in t
+ eigenvector.
+
+ ISUPPZ (output) INTEGER array, dimension (2)
+ The support of the vector in Z, i.e., the vector Z is
+ nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
+
+ NRMINV (output) DOUBLE PRECISION
+ NRMINV = 1/SQRT( ZTZ )
+
+ RESID (output) DOUBLE PRECISION
+ The residual of the FP vector.
+ RESID = ABS( MINGMA )/SQRT( ZTZ )
+
+ RQCORR (output) DOUBLE PRECISION
+ The Rayleigh Quotient correction to LAMBDA.
+ RQCORR = MINGMA*TMP
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>b1</CODE> - <DD><CODE>bn</CODE> - <DD><CODE>lambda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>l</CODE> - <DD><CODE>ld</CODE> - <DD><CODE>lld</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>gaptol</CODE> - <DD><CODE>z</CODE> - <DD><CODE>wantnc</CODE> - <DD><CODE>negcnt</CODE> - <DD><CODE>ztz</CODE> - <DD><CODE>mingma</CODE> - <DD><CODE>r</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>nrminv</CODE> - <DD><CODE>resid</CODE> - <DD><CODE>rqcorr</CO [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlar2v(int, double[], double[], double[], int, double[], double[], int)"><!-- --></A><H3>
+dlar2v</H3>
+<PRE>
+public abstract void <B>dlar2v</B>(int n,
+ double[] x,
+ double[] y,
+ double[] z,
+ int incx,
+ double[] c,
+ double[] s,
+ int incc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAR2V applies a vector of real plane rotations from both sides to
+ a sequence of 2-by-2 real symmetric matrices, defined by the elements
+ of the vectors x, y and z. For i = 1,2,...,n
+
+ ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) )
+ ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector y.
+
+ Z (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector z.
+
+ INCX (input) INTEGER
+ The increment between elements of X, Y and Z. INCX > 0.
+
+ C (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>y</CODE> - <DD><CODE>z</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - <DD><CODE>incc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarf(java.lang.String, int, int, double[], int, double, double[], int, double[])"><!-- --></A><H3>
+dlarf</H3>
+<PRE>
+public abstract void <B>dlarf</B>(java.lang.String side,
+ int m,
+ int n,
+ double[] v,
+ int incv,
+ double tau,
+ double[] c,
+ int Ldc,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARF applies a real elementary reflector H to a real m by n matrix
+ C, from either the left or the right. H is represented in the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of H. V is not used if
+ TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>incv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarfb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int)"><!-- --></A><H3>
+dlarfb</H3>
+<PRE>
+public abstract void <B>dlarfb</B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ double[] v,
+ int ldv,
+ double[] t,
+ int ldt,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int ldwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARFB applies a real block reflector H or its transpose H' to a
+ real m by n matrix C, from either the left or the right.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'T': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ V (input) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,M) if STOREV = 'R' and SIDE = 'L'
+
+ (LDV,N) if STOREV = 'R' and SIDE = 'R'
+
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+ if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+ if STOREV = 'R', LDV >= K.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,K)
+ The triangular k by k matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ldwork</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarfg(int, org.netlib.util.doubleW, double[], int, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlarfg</H3>
+<PRE>
+public abstract void <B>dlarfg</B>(int n,
+ org.netlib.util.doubleW alpha,
+ double[] x,
+ int incx,
+ org.netlib.util.doubleW tau)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARFG generates a real elementary reflector H of order n, such
+ that
+
+ H * ( alpha ) = ( beta ), H' * H = I.
+ ( x ) ( 0 )
+
+ where alpha and beta are scalars, and x is an (n-1)-element real
+ vector. H is represented in the form
+
+ H = I - tau * ( 1 ) * ( 1 v' ) ,
+ ( v )
+
+ where tau is a real scalar and v is a real (n-1)-element
+ vector.
+
+ If the elements of x are all zero, then tau = 0 and H is taken to be
+
+ the unit matrix.
+
+ Otherwise 1 <= tau <= 2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the elementary reflector.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ On entry, the value alpha.
+ On exit, it is overwritten with the value beta.
+
+ X (input/output) DOUBLE PRECISION array, dimension
+ (1+(N-2)*abs(INCX))
+ On entry, the vector x.
+ On exit, it is overwritten with the vector v.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ TAU (output) DOUBLE PRECISION
+ The value tau.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>tau</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarft(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int)"><!-- --></A><H3>
+dlarft</H3>
+<PRE>
+public abstract void <B>dlarft</B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ double[] v,
+ int ldv,
+ double[] tau,
+ double[] t,
+ int ldt)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ 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'
+
+ 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 * V
+
+ Arguments
+ =========
+
+ DIRECT (input) 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)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ 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 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarfx(java.lang.String, int, int, double[], double, double[], int, double[])"><!-- --></A><H3>
+dlarfx</H3>
+<PRE>
+public abstract void <B>dlarfx</B>(java.lang.String side,
+ int m,
+ int n,
+ double[] v,
+ double tau,
+ double[] c,
+ int Ldc,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARFX applies a real elementary reflector H to a real m by n
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix
+
+ This version uses inline code if H has order < 11.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
+ or (N) if SIDE = 'R'
+ The vector v in the representation of H.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= (1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+ WORK is not referenced if H has order < 11.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlargv(int, double[], int, double[], int, double[], int)"><!-- --></A><H3>
+dlargv</H3>
+<PRE>
+public abstract void <B>dlargv</B>(int n,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] c,
+ int incc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARGV generates a vector of real plane rotations, determined by
+ elements of the real vectors x and y. For i = 1,2,...,n
+
+ ( c(i) s(i) ) ( x(i) ) = ( a(i) )
+ ( -s(i) c(i) ) ( y(i) ) = ( 0 )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be generated.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ On entry, the vector x.
+ On exit, x(i) is overwritten by a(i), for i = 1,...,n.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCY)
+ On entry, the vector y.
+ On exit, the sines of the plane rotations.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (output) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C. INCC > 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>c</CODE> - <DD><CODE>incc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarnv(int, int[], int, double[])"><!-- --></A><H3>
+dlarnv</H3>
+<PRE>
+public abstract void <B>dlarnv</B>(int idist,
+ int[] iseed,
+ int n,
+ double[] x)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARNV returns a vector of n random real numbers from a uniform or
+ normal distribution.
+
+ Arguments
+ =========
+
+ IDIST (input) INTEGER
+ Specifies the distribution of the random numbers:
+ = 1: uniform (0,1)
+ = 2: uniform (-1,1)
+ = 3: normal (0,1)
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated.
+
+ X (output) DOUBLE PRECISION array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine calls the auxiliary routine DLARUV to generate random
+ real numbers from a uniform (0,1) distribution, in batches of up to
+ 128 using vectorisable code. The Box-Muller method is used to
+ transform numbers from a uniform to a normal distribution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>idist</CODE> - <DD><CODE>iseed</CODE> - <DD><CODE>n</CODE> - <DD><CODE>x</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarra(int, double[], double[], double[], double, double, org.netlib.util.intW, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlarra</H3>
+<PRE>
+public void <B>dlarra</B>(int n,
+ double[] d,
+ double[] e,
+ double[] e2,
+ double spltol,
+ double tnrm,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Compute the splitting points with threshold SPLTOL.
+ DLARRA sets any "small" off-diagonal elements to zero.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
+ are set to zero, the other entries of E are untouched.
+
+ E2 (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ SPLTOL (input) DOUBLE PRECISION
+ The threshold for splitting. Two criteria can be used:
+ SPLTOL<0 : criterion based on absolute off-diagonal value
+ SPLTOL>0 : criterion that preserves relative accuracy
+
+ TNRM (input) DOUBLE PRECISION
+ The norm of the matrix.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>spltol</CODE> - <DD><CODE>tnrm</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrb(int, double[], double[], int, int, double, double, int, double[], double[], double[], double[], int[], double, double, int, org.netlib.util.intW)"><!-- --></A><H3>
+dlarrb</H3>
+<PRE>
+public void <B>dlarrb</B>(int n,
+ double[] d,
+ double[] lld,
+ int ifirst,
+ int ilast,
+ double rtol1,
+ double rtol2,
+ int offset,
+ double[] w,
+ double[] wgap,
+ double[] werr,
+ double[] work,
+ int[] iwork,
+ double pivmin,
+ double spdiam,
+ int twist,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the relatively robust representation(RRR) L D L^T, DLARRB
+ does "limited" bisection to refine the eigenvalues of L D L^T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses and their gaps are input in WERR
+ and WGAP, respectively. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL1 (input) DOUBLE PRECISION
+ RTOL2 (input) DOUBLE PRECISION
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+ where GAP is the (estimated) distance to the nearest
+ eigenvalue.
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFS
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WGAP (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On input, the (estimated) gaps between consecutive
+ eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap betwe
+ eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST
+ then WGAP(IFIRST-OFFSET) must be set to ZERO.
+ On output, these gaps are refined.
+
+ WERR (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of the matrix.
+
+ TWIST (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+ TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L
+ TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U
+ TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>lld</CODE> - <DD><CODE>ifirst</CODE> - <DD><CODE>ilast</CODE> - <DD><CODE>rtol1</CODE> - <DD><CODE>rtol2</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>w</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>spdiam</CODE> - <DD><CODE>twist</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrc(java.lang.String, int, double, double, double[], double[], double, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+dlarrc</H3>
+<PRE>
+public void <B>dlarrc</B>(java.lang.String jobt,
+ int n,
+ double vl,
+ double vu,
+ double[] d,
+ double[] e,
+ double pivmin,
+ org.netlib.util.intW eigcnt,
+ org.netlib.util.intW lcnt,
+ org.netlib.util.intW rcnt,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Find the number of eigenvalues of the symmetric tridiagonal matrix T
+
+ that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
+ if JOBT = 'L'.
+
+ Arguments
+ =========
+
+ JOBT (input) CHARACTER*1
+ = 'T': Compute Sturm count for matrix T.
+ = 'L': Compute Sturm count for matrix L D L^T.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ The lower and upper bounds for the eigenvalues.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N diagonal elements of the tridiagonal matrix
+ JOBT = 'L': The N diagonal elements of the diagonal matrix D.
+
+ E (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
+ JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ EIGCNT (output) INTEGER
+ The number of eigenvalues of the symmetric tridiagonal matrix
+ that are in the interval (VL,VU]
+
+ LCNT (output) INTEGER
+ RCNT (output) INTEGER
+ The left and right negcounts of the interval.
+
+ INFO (output) INTEGER
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobt</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>eigcnt</CODE> - <DD><CODE>lcnt</CODE> - <DD><CODE>rcnt</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrd(java.lang.String, java.lang.String, int, double, double, int, int, double[], double, double[], double[], double[], double, int, int[], org.netlib.util.intW, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlarrd</H3>
+<PRE>
+public void <B>dlarrd</B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double[] gers,
+ double reltol,
+ double[] d,
+ double[] e,
+ double[] e2,
+ double pivmin,
+ int nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] werr,
+ org.netlib.util.doubleW wl,
+ org.netlib.util.doubleW wu,
+ int[] iblock,
+ int[] indexw,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARRD computes the eigenvalues of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from DSTEMR.
+ The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ GERS (input) DOUBLE PRECISION array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ RELTOL (input) DOUBLE PRECISION
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ E2 (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ NSPLIT (input) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalue approximations. DLARRD computes an interval
+ I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
+ approximation is given as the interval midpoint
+ W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
+ WERR(j) = abs( a_j - b_j)/2
+
+ WERR (output) DOUBLE PRECISION array, dimension (N)
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ WL (output) DOUBLE PRECISION
+ WU (output) DOUBLE PRECISION
+ The interval (WL, WU] contains all the wanted eigenvalues.
+ If RANGE='V', then WL=VL and WU=VU.
+ If RANGE='A', then WL and WU are the global Gerschgorin bound
+ on the spectrum.
+ If RANGE='I', then WL and WU are computed by DLAEBZ from the
+
+ index range specified.
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (DLARRD may use the remaining N-M elements as
+ workspace.)
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
+ i-th eigenvalue W(i) is the j-th eigenvalue in block k.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ FUDGE DOUBLE PRECISION, default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ Based on contributions by
+ W. Kahan, University of California, Berkeley, USA
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>range</CODE> - <DD><CODE>order</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>gers</CODE> - <DD><CODE>reltol</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>wl</CODE> - <DD><CODE>wu</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarre(java.lang.String, int, org.netlib.util.doubleW, org.netlib.util.doubleW, int, int, double[], double[], double[], double, double, double, org.netlib.util.intW, int[], org.netlib.util.intW, double[], double[], double[], int[], int[], double[], org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlarre</H3>
+<PRE>
+public void <B>dlarre</B>(java.lang.String range,
+ int n,
+ org.netlib.util.doubleW vl,
+ org.netlib.util.doubleW vu,
+ int il,
+ int iu,
+ double[] d,
+ double[] e,
+ double[] e2,
+ double rtol1,
+ double rtol2,
+ double spltol,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] werr,
+ double[] wgap,
+ int[] iblock,
+ int[] indexw,
+ double[] gers,
+ org.netlib.util.doubleW pivmin,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ To find the desired eigenvalues of a given real symmetric
+ tridiagonal matrix T, DLARRE sets any "small" off-diagonal
+ elements to zero, and for each unreduced block T_i, it finds
+ (a) a suitable shift at one end of the block's spectrum,
+ (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
+ (c) eigenvalues of each L_i D_i L_i^T.
+ The representations and eigenvalues found are then used by
+ DSTEMR to compute the eigenvectors of T.
+ The accuracy varies depending on whether bisection is used to
+ find a few eigenvalues or the dqds algorithm (subroutine DLASQ2) to
+ conpute all and then discard any unwanted one.
+ As an added benefit, DLARRE also outputs the n
+ Gerschgorin intervals for the matrices L_i D_i L_i^T.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input/output) DOUBLE PRECISION
+ VU (input/output) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds for the eigenvalues.
+ Eigenvalues less than or equal to VL, or greater than VU,
+ will not be returned. VL < VU.
+ If RANGE='I' or ='A', DLARRE computes bounds on the desired
+ part of the spectrum.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+ On exit, the N diagonal elements of the diagonal
+ matrices D_i.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, E contains the subdiagonal elements of the unit
+ bidiagonal matrices L_i. The entries E( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, contain the base points sigma_i on output.
+
+
+ E2 (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ RTOL1 (input) DOUBLE PRECISION
+ RTOL2 (input) DOUBLE PRECISION
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ SPLTOL (input) DOUBLE PRECISION
+ The threshold for splitting.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+ M (output) INTEGER
+ The total number of eigenvalues (of all L_i D_i L_i^T)
+ found.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the eigenvalues. The
+ eigenvalues of each of the blocks, L_i D_i L_i^T, are
+ sorted in ascending order ( DLARRE may use the
+ remaining N-M elements as workspace).
+
+ WERR (output) DOUBLE PRECISION array, dimension (N)
+ The error bound on the corresponding eigenvalue in W.
+
+ WGAP (output) DOUBLE PRECISION array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+ The gap is only with respect to the eigenvalues of the same b
+ as each block has its own representation tree.
+ Exception: at the right end of a block we store the left gap
+
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in block 2
+
+ GERS (output) DOUBLE PRECISION array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ PIVMIN (output) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (6*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: A problem occured in DLARRE.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in DLARRD.
+ = 2: No base representation could be found in MAXTRY iterati
+ Increasing MAXTRY and recompilation might be a remedy.
+
+ =-3: Problem in DLARRB when computing the refined root
+ representation for DLASQ2.
+ =-4: Problem in DLARRB when preforming bisection on the
+ desired part of the spectrum.
+ =-5: Problem in DLASQ2.
+ =-6: Problem in DLASQ2.
+
+ Further Details
+ The base representations are required to suffer very little
+ element growth and consequently define all their eigenvalues to
+ high relative accuracy.
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>rtol1</CODE> - <DD><CODE>rtol2</CODE> - <DD><CODE>spltol</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>indexw</CODE> - <D [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrf(int, double[], double[], double[], int, int, double[], double[], double[], double, double, double, double, org.netlib.util.doubleW, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlarrf</H3>
+<PRE>
+public void <B>dlarrf</B>(int n,
+ double[] d,
+ double[] l,
+ double[] ld,
+ int clstrt,
+ int clend,
+ double[] w,
+ double[] wgap,
+ double[] werr,
+ double spdiam,
+ double clgapl,
+ double clgapr,
+ double pivmin,
+ org.netlib.util.doubleW sigma,
+ double[] dplus,
+ double[] lplus,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial representation L D L^T and its cluster of close
+ eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
+
+ W( CLEND ), DLARRF finds a new relatively robust representation
+ L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
+ eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix (subblock, if the matrix splitted).
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ L (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) subdiagonal elements of the unit bidiagonal
+ matrix L.
+
+ LD (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) elements L(i)*D(i).
+
+ CLSTRT (input) INTEGER
+ The index of the first eigenvalue in the cluster.
+
+ CLEND (input) INTEGER
+ The index of the last eigenvalue in the cluster.
+
+ W (input) DOUBLE PRECISION array, dimension >= (CLEND-CLSTRT+1
+ The eigenvalue APPROXIMATIONS of L D L^T in ascending order.
+
+ W( CLSTRT ) through W( CLEND ) form the cluster of relatively
+ close eigenalues.
+
+ WGAP (input/output) DOUBLE PRECISION array, dimension >= (CLEND-C
+ The separation from the right neighbor eigenvalue in W.
+
+ WERR (input) DOUBLE PRECISION array, dimension >= (CLEND-CLSTRT+1
+ WERR contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue APPROXIMATION in W
+
+ SPDIAM (input) estimate of the spectral diameter obtained from the
+ Gerschgorin intervals
+
+ CLGAPL, CLGAPR (input) absolute gap on each end of the cluster.
+ Set by the calling routine to protect against shifts too clos
+ to eigenvalues outside the cluster.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ SIGMA (output) DOUBLE PRECISION
+ The shift used to form L(+) D(+) L(+)^T.
+
+ DPLUS (output) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D(+).
+
+ LPLUS (output) DOUBLE PRECISION array, dimension (N-1)
+ The first (N-1) elements of LPLUS contain the subdiagonal
+ elements of the unit bidiagonal matrix L(+).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ Workspace.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>l</CODE> - <DD><CODE>ld</CODE> - <DD><CODE>clstrt</CODE> - <DD><CODE>clend</CODE> - <DD><CODE>w</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>spdiam</CODE> - <DD><CODE>clgapl</CODE> - <DD><CODE>clgapr</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>dplus</CODE> - <DD><CODE>lplus</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrj(int, double[], double[], int, int, double, int, double[], double[], double[], int[], double, double, org.netlib.util.intW)"><!-- --></A><H3>
+dlarrj</H3>
+<PRE>
+public void <B>dlarrj</B>(int n,
+ double[] d,
+ double[] e2,
+ int ifirst,
+ int ilast,
+ double rtol,
+ int offset,
+ double[] w,
+ double[] werr,
+ double[] work,
+ int[] iwork,
+ double pivmin,
+ double spdiam,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial eigenvalue approximations of T, DLARRJ
+ does bisection to refine the eigenvalues of T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses in WERR. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of T.
+
+ E2 (input) DOUBLE PRECISION array, dimension (N-1)
+ The Squares of the (N-1) subdiagonal elements of T.
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL (input) DOUBLE PRECISION
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WERR (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of T.
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>ifirst</CODE> - <DD><CODE>ilast</CODE> - <DD><CODE>rtol</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>spdiam</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrk(int, int, double, double, double[], double[], double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlarrk</H3>
+<PRE>
+public void <B>dlarrk</B>(int n,
+ int iw,
+ double gl,
+ double gu,
+ double[] d,
+ double[] e2,
+ double pivmin,
+ double reltol,
+ org.netlib.util.doubleW w,
+ org.netlib.util.doubleW werr,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARRK computes one eigenvalue of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from DSTEMR.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ IW (input) INTEGER
+ The index of the eigenvalues to be returned.
+
+ GL (input) DOUBLE PRECISION
+ GU (input) DOUBLE PRECISION
+ An upper and a lower bound on the eigenvalue.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E2 (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ RELTOL (input) DOUBLE PRECISION
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ W (output) DOUBLE PRECISION
+
+ WERR (output) DOUBLE PRECISION
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ INFO (output) INTEGER
+ = 0: Eigenvalue converged
+ = -1: Eigenvalue did NOT converge
+
+ Internal Parameters
+ ===================
+
+ FUDGE DOUBLE PRECISION, default = 2
+ A "fudge factor" to widen the Gershgorin intervals.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>iw</CODE> - <DD><CODE>gl</CODE> - <DD><CODE>gu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>reltol</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrr(int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlarrr</H3>
+<PRE>
+public void <B>dlarrr</B>(int n,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ Perform tests to decide whether the symmetric tridiagonal matrix T
+ warrants expensive computations which guarantee high relative accurac
+ in the eigenvalues.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the tridiagonal matrix T.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) is set to ZERO.
+
+ INFO (output) INTEGER
+ INFO = 0(default) : the matrix warrants computations preservi
+ relative accuracy.
+ INFO = 1 : the matrix warrants computations guarante
+ only absolute accuracy.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarrv(int, double, double, double[], double[], double, int[], int, int, int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], double[], int[], int[], double[], double[], int, int[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlarrv</H3>
+<PRE>
+public void <B>dlarrv</B>(int n,
+ double vl,
+ double vu,
+ double[] d,
+ double[] l,
+ double pivmin,
+ int[] isplit,
+ int m,
+ int dol,
+ int dou,
+ double minrgp,
+ org.netlib.util.doubleW rtol1,
+ org.netlib.util.doubleW rtol2,
+ double[] w,
+ double[] werr,
+ double[] wgap,
+ int[] iblock,
+ int[] indexw,
+ double[] gers,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARRV computes the eigenvectors of the tridiagonal matrix
+ T = L D L^T given L, D and APPROXIMATIONS to the eigenvalues of L D L
+ The input eigenvalues should have been computed by DLARRE.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ Lower and upper bounds of the interval that contains the desi
+ eigenvalues. VL < VU. Needed to compute gaps on the left or r
+ end of the extremal eigenvalues in the desired RANGE.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the diagonal matrix D.
+ On exit, D may be overwritten.
+
+ L (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the unit
+ bidiagonal matrix L are in elements 1 to N-1 of L
+ (if the matrix is not splitted.) At the end of each block
+ is stored the corresponding shift as given by DLARRE.
+ On exit, L is overwritten.
+
+ PIVMIN (in) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+
+ M (input) INTEGER
+ The total number of input eigenvalues. 0 <= M <= N.
+
+ DOL (input) INTEGER
+ DOU (input) INTEGER
+ If the user wants to compute only selected eigenvectors from
+ the eigenvalues supplied, he can specify an index range DOL:D
+ Or else the setting DOL=1, DOU=M should be applied.
+ Note that DOL and DOU refer to the order in which the eigenva
+ are stored in W.
+ If the user wants to compute only selected eigenpairs, then
+ the columns DOL-1 to DOU+1 of the eigenvector space Z contain
+ computed eigenvectors. All other columns of Z are set to zero
+
+ MINRGP (input) DOUBLE PRECISION
+
+ RTOL1 (input) DOUBLE PRECISION
+ RTOL2 (input) DOUBLE PRECISION
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ W (input/output) DOUBLE PRECISION array, dimension (N)
+ The first M elements of W contain the APPROXIMATE eigenvalues
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block ( The output array
+ W from DLARRE is expected here ). Furthermore, they are with
+
+ respect to the shift of the corresponding root representation
+ for their block. On exit, W holds the eigenvalues of the
+ UNshifted matrix.
+
+ WERR (input/output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue in W
+
+ WGAP (input/output) DOUBLE PRECISION array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (input) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in the second bl
+
+ GERS (input) DOUBLE PRECISION array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should
+ be computed from the original UNshifted matrix.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If INFO = 0, the first M columns of Z contain the
+ orthonormal eigenvectors of the matrix T
+ corresponding to the input eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The I-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*I-1 ) through
+ ISUPPZ( 2*I ).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (12*N)
+
+ IWORK (workspace) INTEGER array, dimension (7*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ > 0: A problem occured in DLARRV.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in DLARRB when refining a child's eigenvalues.
+
+ =-2: Problem in DLARRF when computing the RRR of a child.
+ When a child is inside a tight cluster, it can be diffi
+ to find an RRR. A partial remedy from the user's point
+ view is to make the parameter MINRGP smaller and recomp
+ However, as the orthogonality of the computed vectors i
+ proportional to 1/MINRGP, the user should be aware that
+ he might be trading in precision when he decreases MINR
+ =-3: Problem in DLARRB when refining a single eigenvalue
+ after the Rayleigh correction was rejected.
+ = 5: The Rayleigh Quotient Iteration failed to converge to
+ full accuracy in MAXITR steps.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>l</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>m</CODE> - <DD><CODE>dol</CODE> - <DD><CODE>dou</CODE> - <DD><CODE>minrgp</CODE> - <DD><CODE>rtol1</CODE> - <DD><CODE>rtol2</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>indexw</CODE> - <DD><CODE>gers</CODE> - <DD><CODE>z</CODE> - <D [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlartg(double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlartg</H3>
+<PRE>
+public abstract void <B>dlartg</B>(double f,
+ double g,
+ org.netlib.util.doubleW cs,
+ org.netlib.util.doubleW sn,
+ org.netlib.util.doubleW r)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARTG generate a plane rotation so that
+
+ [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+ [ -SN CS ] [ G ] [ 0 ]
+
+ This is a slower, more accurate version of the BLAS1 routine DROTG,
+ with the following other differences:
+ F and G are unchanged on return.
+ If G=0, then CS=1 and SN=0.
+ If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+ floating point operations (saves work in DBDSQR when
+ there are zeros on the diagonal).
+
+ If F exceeds G in magnitude, CS will be positive.
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The first component of vector to be rotated.
+
+ G (input) DOUBLE PRECISION
+ The second component of vector to be rotated.
+
+ CS (output) DOUBLE PRECISION
+ The cosine of the rotation.
+
+ SN (output) DOUBLE PRECISION
+ The sine of the rotation.
+
+ R (output) DOUBLE PRECISION
+ The nonzero component of the rotated vector.
+
+ This version has a few statements commented out for thread safety
+ (machine parameters are computed on each entry). 10 feb 03, SJH.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>f</CODE> - <DD><CODE>g</CODE> - <DD><CODE>cs</CODE> - <DD><CODE>sn</CODE> - <DD><CODE>r</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlartv(int, double[], int, double[], int, double[], double[], int)"><!-- --></A><H3>
+dlartv</H3>
+<PRE>
+public abstract void <B>dlartv</B>(int n,
+ double[] x,
+ int incx,
+ double[] y,
+ int incy,
+ double[] c,
+ double[] s,
+ int incc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARTV applies a vector of real plane rotations to elements of the
+ real vectors x and y. For i = 1,2,...,n
+
+ ( x(i) ) := ( c(i) s(i) ) ( x(i) )
+ ( y(i) ) ( -s(i) c(i) ) ( y(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCY)
+ The vector y.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - <DD><CODE>incc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaruv(int[], int, double[])"><!-- --></A><H3>
+dlaruv</H3>
+<PRE>
+public abstract void <B>dlaruv</B>(int[] iseed,
+ int n,
+ double[] x)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARUV returns a vector of n random real numbers from a uniform (0,1)
+ distribution (n <= 128).
+
+ This is an auxiliary routine called by DLARNV and ZLARNV.
+
+ Arguments
+ =========
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated. N <= 128.
+
+ X (output) DOUBLE PRECISION array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine uses a multiplicative congruential method with modulus
+ 2**48 and multiplier 33952834046453 (see G.S.Fishman,
+ 'Multiplicative congruential random number generators with modulus
+ 2**b: an exhaustive analysis for b = 32 and a partial analysis for
+ b = 48', Math. Comp. 189, pp 331-344, 1990).
+
+ 48-bit integers are stored in 4 integer array elements with 12 bits
+ per element. Hence the routine is portable across machines with
+ integers of 32 bits or more.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>iseed</CODE> - <DD><CODE>n</CODE> - <DD><CODE>x</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarz(java.lang.String, int, int, int, double[], int, double, double[], int, double[])"><!-- --></A><H3>
+dlarz</H3>
+<PRE>
+public abstract void <B>dlarz</B>(java.lang.String side,
+ int m,
+ int n,
+ int l,
+ double[] v,
+ int incv,
+ double tau,
+ double[] c,
+ int Ldc,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARZ applies a real elementary reflector H to a real M-by-N
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+
+ H is a product of k elementary reflectors as returned by DTZRZF.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ L (input) INTEGER
+ The number of entries of the vector V containing
+ the meaningful part of the Householder vectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) DOUBLE PRECISION array, dimension (1+(L-1)*abs(INCV))
+ The vector v in the representation of H as returned by
+ DTZRZF. V is not used if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>l</CODE> - <DD><CODE>v</CODE> - <DD><CODE>incv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarzb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], int, double[], int, double[], int)"><!-- --></A><H3>
+dlarzb</H3>
+<PRE>
+public abstract void <B>dlarzb</B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ int l,
+ double[] v,
+ int ldv,
+ double[] t,
+ int ldt,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int ldwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARZB applies a real block reflector H or its transpose H**T to
+ a real distributed M-by-N C from the left or the right.
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'C': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise (not supported yet)
+
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ L (input) INTEGER
+ The number of columns of the matrix V containing the
+ meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) DOUBLE PRECISION array, dimension (LDV,NV).
+ If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,K)
+ The triangular K-by-K matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ldwork</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlarzt(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int)"><!-- --></A><H3>
+dlarzt</H3>
+<PRE>
+public abstract void <B>dlarzt</B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ double[] v,
+ int ldv,
+ double[] tau,
+ double[] t,
+ int ldt)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARZT 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'
+
+ 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 * V
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ DIRECT (input) 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, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise (not supported yet)
+
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+
+ ______V_____
+ ( v1 v2 v3 ) / \
+ ( v1 v2 v3 ) ( v1 v1 v1 v1 v1 . . . . 1 )
+ V = ( v1 v2 v3 ) ( v2 v2 v2 v2 v2 . . . 1 )
+ ( v1 v2 v3 ) ( v3 v3 v3 v3 v3 . . 1 )
+ ( v1 v2 v3 )
+ . . .
+ . . .
+ 1 . .
+ 1 .
+ 1
+
+ DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+
+ ______V_____
+ 1 / \
+ . 1 ( 1 . . . . v1 v1 v1 v1 v1 )
+ . . 1 ( . 1 . . . v2 v2 v2 v2 v2 )
+ . . . ( . . 1 . . v3 v3 v3 v3 v3 )
+ . . .
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ V = ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlas2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlas2</H3>
+<PRE>
+public abstract void <B>dlas2</B>(double f,
+ double g,
+ double h,
+ org.netlib.util.doubleW ssmin,
+ org.netlib.util.doubleW ssmax)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAS2 computes the singular values of the 2-by-2 matrix
+ [ F G ]
+ [ 0 H ].
+ On return, SSMIN is the smaller singular value and SSMAX is the
+ larger singular value.
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) DOUBLE PRECISION
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) DOUBLE PRECISION
+ The smaller singular value.
+
+ SSMAX (output) DOUBLE PRECISION
+ The larger singular value.
+
+ Further Details
+ ===============
+
+ Barring over/underflow, all output quantities are correct to within
+ a few units in the last place (ulps), even in the absence of a guard
+
+ digit in addition/subtraction.
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows, or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ ====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>f</CODE> - <DD><CODE>g</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ssmin</CODE> - <DD><CODE>ssmax</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlascl(java.lang.String, int, int, double, double, int, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlascl</H3>
+<PRE>
+public abstract void <B>dlascl</B>(java.lang.String type,
+ int kl,
+ int ku,
+ double cfrom,
+ double cto,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASCL multiplies the M by N real matrix A by the real scalar
+ CTO/CFROM. This is done without over/underflow as long as the final
+
+ result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+
+ A may be full, upper triangular, lower triangular, upper Hessenberg,
+
+ or banded.
+
+ Arguments
+ =========
+
+ TYPE (input) CHARACTER*1
+ TYPE indices the storage type of the input matrix.
+ = 'G': A is a full matrix.
+ = 'L': A is a lower triangular matrix.
+ = 'U': A is an upper triangular matrix.
+ = 'H': A is an upper Hessenberg matrix.
+ = 'B': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the lower
+ half stored.
+ = 'Q': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the upper
+ half stored.
+ = 'Z': A is a band matrix with lower bandwidth KL and upper
+
+ bandwidth KU.
+
+ KL (input) INTEGER
+ The lower bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ KU (input) INTEGER
+ The upper bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ CFROM (input) DOUBLE PRECISION
+ CTO (input) DOUBLE PRECISION
+ The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+ without over/underflow if the final result CTO*A(I,J)/CFROM
+ can be represented without over/underflow. CFROM must be
+ nonzero.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ The matrix to be multiplied by CTO/CFROM. See TYPE for the
+ storage type.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ 0 - successful exit
+ <0 - if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>type</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>cfrom</CODE> - <DD><CODE>cto</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd0(int, int, double[], double[], double[], int, double[], int, int, int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd0</H3>
+<PRE>
+public abstract void <B>dlasd0</B>(int n,
+ int sqre,
+ double[] d,
+ double[] e,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ int smlsiz,
+ int[] iwork,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, DLASD0 computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M
+ matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
+ The algorithm computes orthogonal matrices U and VT such that
+ B = U * S * VT. The singular values S are overwritten on D.
+
+ A related subroutine, DLASDA, computes only the singular values,
+ and optionally, the singular vectors in compact form.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the row dimension of the upper bidiagonal matrix.
+ This is also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N+1;
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix.
+ On exit D, if INFO = 0, contains its singular values.
+
+ E (input) DOUBLE PRECISION array, dimension (M-1)
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array, dimension at least (LDQ, N)
+ On exit, U contains the left singular vectors.
+
+ LDU (input) INTEGER
+ On entry, leading dimension of U.
+
+ VT (output) DOUBLE PRECISION array, dimension at least (LDVT, M)
+
+ On exit, VT' contains the right singular vectors.
+
+ LDVT (input) INTEGER
+ On entry, leading dimension of VT.
+
+ SMLSIZ (input) INTEGER
+ On entry, maximum size of the subproblems at the
+ bottom of the computation tree.
+
+ IWORK (workspace) INTEGER work array.
+ Dimension must be at least (8 * N)
+
+ WORK (workspace) DOUBLE PRECISION work array.
+ Dimension must be at least (3 * M**2 + 2 * M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd1(int, int, int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, double[], int, int[], int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd1</H3>
+<PRE>
+public abstract void <B>dlasd1</B>(int nl,
+ int nr,
+ int sqre,
+ double[] d,
+ org.netlib.util.doubleW alpha,
+ org.netlib.util.doubleW beta,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ int[] idxq,
+ int[] iwork,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
+ where N = NL + NR + 1 and M = N + SQRE. DLASD1 is called from DLASD0.
+
+ A related subroutine DLASD7 handles the case in which the singular
+ values (and the singular vectors in factored form) are desired.
+
+ DLASD1 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The left singular vectors of the original matrix are stored in U, and
+ the transpose of the right singular vectors are stored in VT, and the
+ singular values are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or when there are zeros in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLASD2.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the square roots of the
+ roots of the secular equation via the routine DLASD4 (as called
+ by DLASD3). This routine also calculates the singular vectors of
+ the current problem.
+
+ The final stage consists of computing the updated singular vectors
+ directly using the updated singular values. The singular vectors
+
+ for the current problem are multiplied with the singular vectors
+ from the overall problem.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) DOUBLE PRECISION array,
+ dimension (N = NL+NR+1).
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block; and D(NL+2:N) contains the singular values of
+ the lower block. On exit D(1:N) contains the singular values
+ of the modified matrix.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) DOUBLE PRECISION array, dimension(LDU,N)
+ On entry U(1:NL, 1:NL) contains the left singular vectors of
+ the upper block; U(NL+2:N, NL+2:N) contains the left singular
+
+ vectors of the lower block. On exit U contains the left
+ singular vectors of the bidiagonal matrix.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max( 1, N ).
+
+ VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M)
+ where M = N + SQRE.
+ On entry VT(1:NL+1, 1:NL+1)' contains the right singular
+ vectors of the upper block; VT(NL+2:M, NL+2:M)' contains
+ the right singular vectors of the lower block. On exit
+ VT' contains the right singular vectors of the
+ bidiagonal matrix.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= max( 1, M ).
+
+ IDXQ (output) INTEGER array, dimension(N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ IWORK (workspace) INTEGER array, dimension( 4 * N )
+
+ WORK (workspace) DOUBLE PRECISION array, dimension( 3*M**2 + 2*M )
+
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>idxq</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd2(int, int, int, org.netlib.util.intW, double[], double[], double, double, double[], int, double[], int, double[], double[], int, double[], int, int[], int[], int[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd2</H3>
+<PRE>
+public abstract void <B>dlasd2</B>(int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ double[] d,
+ double[] z,
+ double alpha,
+ double beta,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int ldvt,
+ double[] dsigma,
+ double[] u2,
+ int ldu2,
+ double[] vt2,
+ int ldvt2,
+ int[] idxp,
+ int[] idx,
+ int[] idxc,
+ int[] idxq,
+ int[] coltyp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD2 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ singular values are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ DLASD2 is called from DLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) DOUBLE PRECISION array, dimension(N)
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) DOUBLE PRECISION array, dimension(N)
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) DOUBLE PRECISION array, dimension(LDU,N)
+ On entry U contains the left singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL, NL), and (NL+2, NL+2), (N,N).
+ On exit U contains the trailing (N-K) updated left singular
+ vectors (those which were deflated) in its last N-K columns.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M)
+ On entry VT' contains the right singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL+1, NL+1), and (NL+2, NL+2), (M,M).
+ On exit VT' contains the trailing (N-K) updated right singular
+ vectors (those which were deflated) in its last N-K columns.
+ In case SQRE =1, the last row of VT spans the right null
+ space.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= M.
+
+ DSIGMA (output) DOUBLE PRECISION array, dimension (N)
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ U2 (output) DOUBLE PRECISION array, dimension(LDU2,N)
+ Contains a copy of the first K-1 left singular vectors which
+ will be used by DLASD3 in a matrix multiply (DGEMM) to solve
+ for the new left singular vectors. U2 is arranged into four
+ blocks. The first block contains a column with 1 at NL+1 and
+ zero everywhere else; the second block contains non-zero
+ entries only at and above NL; the third contains non-zero
+ entries only below NL+1; and the fourth is dense.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT2 (output) DOUBLE PRECISION array, dimension(LDVT2,N)
+ VT2' contains a copy of the first K right singular vectors
+ which will be used by DLASD3 in a matrix multiply (DGEMM) to
+ solve for the new right singular vectors. VT2 is arranged into
+ three blocks. The first block contains a row that corresponds
+
+ to the special 0 diagonal element in SIGMA; the second block
+ contains non-zeros only at and before NL +1; the third block
+ contains non-zeros only at and after NL +2.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= M.
+
+ IDXP (workspace) INTEGER array dimension(N)
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDX (workspace) INTEGER array dimension(N)
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXC (output) INTEGER array dimension(N)
+ This will contain the permutation used to arrange the columns
+
+ of the deflated U matrix into three groups: the first group
+ contains non-zero entries only at and above NL, the second
+ contains non-zero entries only below NL+2, and the third is
+ dense.
+
+ IDXQ (input/output) INTEGER array dimension(N)
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first hlaf of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ COLTYP (workspace/output) INTEGER array dimension(N)
+ As workspace, this will contain a label which will indicate
+ which of the following types a column in the U2 matrix or a
+ row in the VT2 matrix is:
+ 1 : non-zero in the upper half only
+ 2 : non-zero in the lower half only
+ 3 : dense
+ 4 : deflated
+
+ On exit, it is an array of dimension 4, with COLTYP(I) being
+ the dimension of the I-th type columns.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>u2</CODE> - <DD><CODE>ldu2</CODE> - <DD><CODE>vt2</CODE> - <DD><CODE>ldvt2</CODE> - <DD><CODE>idxp</CODE> - <DD><CODE>idx</CODE> - <DD><CODE>idxc</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd3(int, int, int, int, double[], double[], int, double[], double[], int, double[], int, double[], int, double[], int, int[], int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd3</H3>
+<PRE>
+public abstract void <B>dlasd3</B>(int nl,
+ int nr,
+ int sqre,
+ int k,
+ double[] d,
+ double[] q,
+ int ldq,
+ double[] dsigma,
+ double[] u,
+ int ldu,
+ double[] u2,
+ int ldu2,
+ double[] vt,
+ int ldvt,
+ double[] vt2,
+ int ldvt2,
+ int[] idxc,
+ int[] ctot,
+ double[] z,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD3 finds all the square roots of the roots of the secular
+ equation, as defined by the values in D and Z. It makes the
+ appropriate calls to DLASD4 and then updates the singular
+ vectors by matrix multiplication.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ DLASD3 is called from DLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (input) INTEGER
+ The size of the secular equation, 1 =< K = < N.
+
+ D (output) DOUBLE PRECISION array, dimension(K)
+ On exit the square roots of the roots of the secular equation,
+ in ascending order.
+
+ Q (workspace) DOUBLE PRECISION array,
+ dimension at least (LDQ,K).
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= K.
+
+ DSIGMA (input) DOUBLE PRECISION array, dimension(K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU, N)
+ The last N - K columns of this matrix contain the deflated
+ left singular vectors.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ U2 (input/output) DOUBLE PRECISION array, dimension (LDU2, N)
+ The first K columns of this matrix contain the non-deflated
+ left singular vectors for the split problem.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT, M)
+ The last M - K columns of VT' contain the deflated
+ right singular vectors.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= N.
+
+ VT2 (input/output) DOUBLE PRECISION array, dimension (LDVT2, N)
+ The first K columns of VT2' contain the non-deflated
+ right singular vectors for the split problem.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= N.
+
+ IDXC (input) INTEGER array, dimension ( N )
+ The permutation used to arrange the columns of U (and rows of
+
+ VT) into three groups: the first group contains non-zero
+ entries only at and above (or before) NL +1; the second
+ contains non-zero entries only at and below (or after) NL+2;
+ and the third is dense. The first column of U and the row of
+ VT are treated separately, however.
+
+ The rows of the singular vectors found by DLASD4
+ must be likewise permuted before the matrix multiplies can
+ take place.
+
+ CTOT (input) INTEGER array, dimension ( 4 )
+ A count of the total number of the various types of columns
+ in U (or rows in VT), as described in IDXC. The fourth column
+
+ type is any column which has been deflated.
+
+ Z (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>u2</CODE> - <DD><CODE>ldu2</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>vt2</CODE> - <DD><CODE>ldvt2</CODE> - <DD><CODE>idxc</CODE> - <DD><CODE>ctot</CODE> - <DD><CODE>z</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd4(int, int, double[], double[], double[], double, org.netlib.util.doubleW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd4</H3>
+<PRE>
+public abstract void <B>dlasd4</B>(int n,
+ int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW sigma,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th updated
+ eigenvalue of a positive symmetric rank-one modification to
+ a positive diagonal matrix whose entries are given as the squares
+ of the corresponding entries in the array d, and that
+
+ 0 <= D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) * diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) DOUBLE PRECISION array, dimension ( N )
+ The original eigenvalues. It is assumed that they are in
+ order, 0 <= D(I) < D(J) for I < J.
+
+ Z (input) DOUBLE PRECISION array, dimension ( N )
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension ( N )
+ If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. The vector DELTA
+ contains the information necessary to construct the
+ (singular) eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ SIGMA (output) DOUBLE PRECISION
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( N )
+ If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
+ component. If N = 1, then WORK( 1 ) = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd5(int, double[], double[], double[], double, org.netlib.util.doubleW, double[])"><!-- --></A><H3>
+dlasd5</H3>
+<PRE>
+public abstract void <B>dlasd5</B>(int i,
+ double[] d,
+ double[] z,
+ double[] delta,
+ double rho,
+ org.netlib.util.doubleW dsigma,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th eigenvalue
+ of a positive symmetric rank-one modification of a 2-by-2 diagonal
+ matrix
+
+ diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal entries in the array D are assumed to satisfy
+
+ 0 <= D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) DOUBLE PRECISION array, dimension ( 2 )
+ The original eigenvalues. We assume 0 <= D(1) < D(2).
+
+ Z (input) DOUBLE PRECISION array, dimension ( 2 )
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension ( 2 )
+ Contains (D(j) - sigma_I) in its j-th component.
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DSIGMA (output) DOUBLE PRECISION
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( 2 )
+ WORK contains (D(j) + sigma_I) in its j-th component.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd6(int, int, int, int, double[], double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[], org.netlib.util.intW, int[], int, double[], int, double[], double[], double[], double[], org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd6</H3>
+<PRE>
+public abstract void <B>dlasd6</B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ double[] d,
+ double[] vf,
+ double[] vl,
+ org.netlib.util.doubleW alpha,
+ org.netlib.util.doubleW beta,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ double[] givnum,
+ int ldgnum,
+ double[] poles,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ org.netlib.util.intW k,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW s,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD6 computes the SVD of an updated upper bidiagonal matrix B
+ obtained by merging two smaller ones by appending a row. This
+ routine is used only for the problem which requires all singular
+ values and optionally singular vector matrices in factored form.
+ B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
+ A related subroutine, DLASD1, handles the case in which all singular
+
+ values and singular vectors of the bidiagonal matrix are desired.
+
+ DLASD6 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The singular values of B can be computed using D1, D2, the first
+ components of all the right singular vectors of the lower block, and
+
+ the last components of all the right singular vectors of the upper
+ block. These components are stored and updated in VF and VL,
+ respectively, in DLASD6. Hence U and VT are not explicitly
+ referenced.
+
+ The singular values are stored in D. The algorithm consists of two
+ stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or if there is a zero
+ in the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLASD7.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the roots of the
+ secular equation via the routine DLASD4 (as called by DLASD8).
+
+ This routine also updates VF and VL and computes the distances
+
+ between the updated singular values and the old singular
+ values.
+
+ DLASD6 is called from DLASDA.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( NL+NR+1 ).
+
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block, and D(NL+2:N) contains the singular values
+ of the lower block. On exit D(1:N) contains the singular
+ values of the modified matrix.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors of
+
+ the lower block. On exit, VL contains the last components of
+ all right singular vectors of the bidiagonal matrix.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ IDXQ (output) INTEGER array, dimension ( N )
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM and POLES, must be at least N.
+
+ POLES (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On exit, POLES(1,*) is an array containing the new singular
+ values obtained from solving the secular equation, and
+ POLES(2,*) is an array containing the poles in the secular
+ equation. Not referenced if ICOMPQ = 0.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( N )
+ On exit, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ On exit, DIFR(I, 1) is the distance between I-th updated
+ (undeflated) singular value and the I+1-th (undeflated) old
+ singular value.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ See DLASD8 for details on DIFL and DIFR.
+
+ Z (output) DOUBLE PRECISION array, dimension ( M )
+ The first elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (output) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( 4 * M )
+
+ IWORK (workspace) INTEGER array, dimension ( 3 * N )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>vf</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>idxq</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>ldgnum</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd7(int, int, int, int, org.netlib.util.intW, double[], double[], double[], double[], double[], double[], double[], double, double, double[], int[], int[], int[], int[], org.netlib.util.intW, int[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlasd7</H3>
+<PRE>
+public abstract void <B>dlasd7</B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ double[] d,
+ double[] z,
+ double[] zw,
+ double[] vf,
+ double[] vfw,
+ double[] vl,
+ double[] vlw,
+ double alpha,
+ double beta,
+ double[] dsigma,
+ int[] idx,
+ int[] idxp,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ double[] givnum,
+ int ldgnum,
+ org.netlib.util.doubleW c,
+ org.netlib.util.doubleW s,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD7 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem. There
+ are two ways in which deflation can occur: when two or more singular
+ values are close together or if there is a tiny entry in the Z
+ vector. For each such occurrence the order of the related
+ secular equation problem is reduced by one.
+
+ DLASD7 is called from DLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper
+ bidiagonal matrix in compact form.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix, this is
+ the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( N )
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) DOUBLE PRECISION array, dimension ( M )
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ZW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for Z.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VFW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for VF.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors
+ of the lower block. On exit, VL contains the last components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VLW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for VL.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ DSIGMA (output) DOUBLE PRECISION array, dimension ( N )
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ IDX (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXP (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDXQ (input) INTEGER array, dimension ( N )
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first half of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each singular block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM, must be at least N.
+
+ C (output) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>zw</CODE> - <DD><CODE>vf</CODE> - <DD><CODE>vfw</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vlw</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>idx</CODE> - <DD><CODE>idxp</CODE> - <DD><CODE>idxq</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD>< [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasd8(int, int, double[], double[], double[], double[], double[], double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasd8</H3>
+<PRE>
+public abstract void <B>dlasd8</B>(int icompq,
+ int k,
+ double[] d,
+ double[] z,
+ double[] vf,
+ double[] vl,
+ double[] difl,
+ double[] difr,
+ int lddifr,
+ double[] dsigma,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD8 finds the square roots of the roots of the secular equation,
+ as defined by the values in DSIGMA and Z. It makes the appropriate
+ calls to DLASD4, and stores, for each element in D, the distance
+ to its two nearest poles (elements in DSIGMA). It also updates
+ the arrays VF and VL, the first and last components of all the
+ right singular vectors of the original bidiagonal matrix.
+
+ DLASD8 is called from DLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form in the calling routine:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved
+ by DLASD4. K >= 1.
+
+ D (output) DOUBLE PRECISION array, dimension ( K )
+ On output, D contains the updated singular values.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( K )
+ On entry, VF contains information passed through DBEDE8.
+ On exit, VF contains the first K components of the first
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( K )
+ On entry, VL contains information passed through DBEDE8.
+ On exit, VL contains the first K components of the last
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( K )
+ On exit, DIFL(I) = D(I) - DSIGMA(I).
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
+ dimension ( K ) if ICOMPQ = 0.
+ On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
+ defined and will not be referenced.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ LDDIFR (input) INTEGER
+ The leading dimension of DIFR, must be at least K.
+
+ DSIGMA (input) DOUBLE PRECISION array, dimension ( K )
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension at least 3 * K
+
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>vf</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>lddifr</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasda(int, int, int, int, double[], double[], double[], int, double[], int[], double[], double[], double[], double[], int[], int[], int, int[], double[], double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasda</H3>
+<PRE>
+public abstract void <B>dlasda</B>(int icompq,
+ int smlsiz,
+ int n,
+ int sqre,
+ double[] d,
+ double[] e,
+ double[] u,
+ int ldu,
+ double[] vt,
+ int[] k,
+ double[] difl,
+ double[] difr,
+ double[] z,
+ double[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ double[] givnum,
+ double[] c,
+ double[] s,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, DLASDA computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
+ B with diagonal D and offdiagonal E, where M = N + SQRE. The
+ algorithm computes the singular values in the SVD B = U * S * VT.
+ The orthogonal matrices U and VT are optionally computed in
+ compact form.
+
+ A related subroutine, DLASD0, computes the singular values and
+ the singular vectors in explicit form.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper bidiagonal
+ matrix in compact form.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row dimension of the upper bidiagonal matrix. This is
+ also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N + 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( N )
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit D, if INFO = 0, contains its singular values.
+
+
+ E (input) DOUBLE PRECISION array, dimension ( M-1 )
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array,
+ dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
+ GIVNUM, and Z.
+
+ VT (output) DOUBLE PRECISION array,
+ dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT' contains the right
+
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ K (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
+ secular equation on the computation tree.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( LDU, NLVL ),
+ where NLVL = floor(log_2 (N/SMLSIZ))).
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
+
+ record distances between singular values on the I-th
+ level and singular values on the (I -1)-th level, and
+ DIFR(1:N, 2 * I ) contains the normalizing factors for
+ the right singular vector matrix. See DLASD8 for details.
+
+ Z (output) DOUBLE PRECISION array,
+ dimension ( LDU, NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ The first K elements of Z(1, I) contain the components of
+ the deflation-adjusted updating row vector for subproblems
+ on the I-th level.
+
+ POLES (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
+ POLES(1, 2*I) contain the new and old singular values
+ involved in the secular equations on the I-th level.
+
+ GIVPTR (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1, and not referenced if
+ ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
+ the number of Givens rotations performed on the I-th
+ problem on the computation tree.
+
+ GIVCOL (output) INTEGER array,
+ dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
+ of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (output) INTEGER array,
+ dimension ( LDGCOL, NLVL ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
+ permutations done on the I-th level of the computation tree.
+
+ GIVNUM (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
+ values of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ C (output) DOUBLE PRECISION array,
+ dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
+
+ If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
+
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (output) DOUBLE PRECISION array, dimension ( N ) if
+ ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
+ and the I-th subproblem is not square, on exit, S( I )
+ contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
+
+ IWORK (workspace) INTEGER array.
+ Dimension must be at least (7 * N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>k</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>c</CODE> - < [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasdq(java.lang.String, int, int, int, int, int, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasdq</H3>
+<PRE>
+public abstract void <B>dlasdq</B>(java.lang.String uplo,
+ int sqre,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ double[] d,
+ double[] e,
+ double[] vt,
+ int ldvt,
+ double[] u,
+ int ldu,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASDQ computes the singular value decomposition (SVD) of a real
+ (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
+ E, accumulating the transformations if desired. Letting B denote
+ the input bidiagonal matrix, the algorithm computes orthogonal
+ matrices Q and P such that B = Q * S * P' (P' denotes the transpose
+ of P). The singular values S are overwritten on D.
+
+ The input matrix U is changed to U * Q if desired.
+ The input matrix VT is changed to P' * VT if desired.
+ The input matrix C is changed to Q' * C if desired.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3, for a detailed description of the algorithm.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ On entry, UPLO specifies whether the input bidiagonal matrix
+ is upper or lower bidiagonal, and wether it is square are
+ not.
+ UPLO = 'U' or 'u' B is upper bidiagonal.
+ UPLO = 'L' or 'l' B is lower bidiagonal.
+
+ SQRE (input) INTEGER
+ = 0: then the input matrix is N-by-N.
+ = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
+ (N+1)-by-N if UPLU = 'L'.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ N (input) INTEGER
+ On entry, N specifies the number of rows and columns
+ in the matrix. N must be at least 0.
+
+ NCVT (input) INTEGER
+ On entry, NCVT specifies the number of columns of
+ the matrix VT. NCVT must be at least 0.
+
+ NRU (input) INTEGER
+ On entry, NRU specifies the number of rows of
+ the matrix U. NRU must be at least 0.
+
+ NCC (input) INTEGER
+ On entry, NCC specifies the number of columns of
+ the matrix C. NCC must be at least 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the diagonal entries of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in ascending order.
+
+ E (input/output) DOUBLE PRECISION array.
+ dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
+ On entry, the entries of E contain the offdiagonal entries
+ of the bidiagonal matrix whose SVD is desired. On normal
+ exit, E will contain 0. If the algorithm does not converge,
+ D and E will contain the diagonal and superdiagonal entries
+ of a bidiagonal matrix orthogonally equivalent to the one
+ given as input.
+
+ VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
+ On entry, contains a matrix which on exit has been
+ premultiplied by P', dimension N-by-NCVT if SQRE = 0
+ and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
+
+ LDVT (input) INTEGER
+ On entry, LDVT specifies the leading dimension of VT as
+ declared in the calling (sub) program. LDVT must be at
+ least 1. If NCVT is nonzero LDVT must also be at least N.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
+ On entry, contains a matrix which on exit has been
+ postmultiplied by Q, dimension NRU-by-N if SQRE = 0
+ and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
+
+ LDU (input) INTEGER
+ On entry, LDU specifies the leading dimension of U as
+ declared in the calling (sub) program. LDU must be at
+ least max( 1, NRU ) .
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
+ On entry, contains an N-by-NCC matrix which on exit
+ has been premultiplied by Q' dimension N-by-NCC if SQRE = 0
+ and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
+
+ LDC (input) INTEGER
+ On entry, LDC specifies the leading dimension of C as
+ declared in the calling (sub) program. LDC must be at
+ least 1. If NCC is nonzero, LDC must also be at least N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+ Workspace. Only referenced if one of NCVT, NRU, or NCC is
+ nonzero, and if N is at least 2.
+
+ INFO (output) INTEGER
+ On exit, a value of 0 indicates a successful exit.
+ If INFO < 0, argument number -INFO is illegal.
+ If INFO > 0, the algorithm did not converge, and INFO
+ specifies how many superdiagonals did not converge.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ncvt</CODE> - <DD><CODE>nru</CODE> - <DD><CODE>ncc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasdt(int, org.netlib.util.intW, org.netlib.util.intW, int[], int[], int[], int)"><!-- --></A><H3>
+dlasdt</H3>
+<PRE>
+public abstract void <B>dlasdt</B>(int n,
+ org.netlib.util.intW lvl,
+ org.netlib.util.intW nd,
+ int[] inode,
+ int[] ndiml,
+ int[] ndimr,
+ int msub)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASDT creates a tree of subproblems for bidiagonal divide and
+ conquer.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the number of diagonal elements of the
+ bidiagonal matrix.
+
+ LVL (output) INTEGER
+ On exit, the number of levels on the computation tree.
+
+ ND (output) INTEGER
+ On exit, the number of nodes on the tree.
+
+ INODE (output) INTEGER array, dimension ( N )
+ On exit, centers of subproblems.
+
+ NDIML (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of left children.
+
+ NDIMR (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of right children.
+
+ MSUB (input) INTEGER.
+ On entry, the maximum row dimension each subproblem at the
+ bottom of the tree can be of.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>lvl</CODE> - <DD><CODE>nd</CODE> - <DD><CODE>inode</CODE> - <DD><CODE>ndiml</CODE> - <DD><CODE>ndimr</CODE> - <DD><CODE>msub</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaset(java.lang.String, int, int, double, double, double[], int)"><!-- --></A><H3>
+dlaset</H3>
+<PRE>
+public abstract void <B>dlaset</B>(java.lang.String uplo,
+ int m,
+ int n,
+ double alpha,
+ double beta,
+ double[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASET initializes an m-by-n matrix A to BETA on the diagonal and
+ ALPHA on the offdiagonals.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be set.
+ = 'U': Upper triangular part is set; the strictly lower
+
+ triangular part of A is not changed.
+ = 'L': Lower triangular part is set; the strictly upper
+
+ triangular part of A is not changed.
+ Otherwise: All of the matrix A is set.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ ALPHA (input) DOUBLE PRECISION
+ The constant to which the offdiagonal elements are to be set.
+
+ BETA (input) DOUBLE PRECISION
+ The constant to which the diagonal elements are to be set.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On exit, the leading m-by-n submatrix of A is set as follows:
+
+ if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+ if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+ otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+
+ and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasq1(int, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasq1</H3>
+<PRE>
+public abstract void <B>dlasq1</B>(int n,
+ double[] d,
+ double[] e,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ1 computes the singular values of a real N-by-N bidiagonal
+ matrix with diagonal D and off-diagonal E. The singular values
+ are computed to high relative accuracy, in the absence of
+ denormalization, underflow and overflow. The algorithm was first
+ presented in
+
+ "Accurate singular values and differential qd algorithms" by K. V.
+ Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
+ 1994,
+
+ and the present implementation is described in "An implementation of
+
+ the dqds Algorithm (Positive Case)", LAPACK Working Note.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the diagonal elements of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in decreasing order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, elements E(1:N-1) contain the off-diagonal elements
+ of the bidiagonal matrix whose SVD is desired.
+ On exit, E is overwritten.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasq2(int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasq2</H3>
+<PRE>
+public abstract void <B>dlasq2</B>(int n,
+ double[] z,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ2 computes all the eigenvalues of the symmetric positive
+ definite tridiagonal matrix associated with the qd array Z to high
+ relative accuracy are computed to high relative accuracy, in the
+ absence of denormalization, underflow and overflow.
+
+ To see the relation of Z to the tridiagonal matrix, let L be a
+ unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
+ let U be an upper bidiagonal matrix with 1's above and diagonal
+ Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
+ symmetric tridiagonal to which it is similar.
+
+ Note : DLASQ2 defines a logical variable, IEEE, which is true
+ on machines which follow ieee-754 floating-point standard in their
+ handling of infinities and NaNs, and false otherwise. This variable
+ is passed to DLAZQ3.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ Z (workspace) DOUBLE PRECISION array, dimension ( 4*N )
+ On entry Z holds the qd array. On exit, entries 1 to N hold
+ the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
+ trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
+ N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
+ holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
+ shifts that failed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if the i-th argument is a scalar and had an illegal
+ value, then INFO = -i, if the i-th argument is an
+ array and the j-entry had an illegal value, then
+ INFO = -(i*100+j)
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ Further Details
+ ===============
+ Local Variables: I0:N0 defines a current unreduced segment of Z.
+ The shifts are accumulated in SIGMA. Iteration count is in ITER.
+ Ping-pong is controlled by PP (alternates between 0 and 1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>z</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasq3(int, org.netlib.util.intW, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean)"><!-- --></A><H3>
+dlasq3</H3>
+<PRE>
+public abstract void <B>dlasq3</B>(int i0,
+ org.netlib.util.intW n0,
+ double[] z,
+ int pp,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW sigma,
+ org.netlib.util.doubleW desig,
+ org.netlib.util.doubleW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ SIGMA (output) DOUBLE PRECISION
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) DOUBLE PRECISION
+ Lower order part of SIGMA
+
+ QMAX (input) DOUBLE PRECISION
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>desig</CODE> - <DD><CODE>qmax</CODE> - <DD><CODE>nfail</CODE> - <DD><CODE>iter</CODE> - <DD><CODE>ndiv</CODE> - <DD><CODE>ieee</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasq4(int, int, double[], int, int, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlasq4</H3>
+<PRE>
+public abstract void <B>dlasq4</B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ int n0in,
+ double dmin,
+ double dmin1,
+ double dmin2,
+ double dn,
+ double dn1,
+ double dn2,
+ org.netlib.util.doubleW tau,
+ org.netlib.util.intW ttype)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) DOUBLE PRECISION
+ d(N)
+
+ DN1 (input) DOUBLE PRECISION
+ d(N-1)
+
+ DN2 (input) DOUBLE PRECISION
+ d(N-2)
+
+ TAU (output) DOUBLE PRECISION
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>n0in</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dn1</CODE> - <DD><CODE>dn2</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>ttype</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasq5(int, int, double[], int, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, boolean)"><!-- --></A><H3>
+dlasq5</H3>
+<PRE>
+public abstract void <B>dlasq5</B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ double tau,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW dmin1,
+ org.netlib.util.doubleW dmin2,
+ org.netlib.util.doubleW dn,
+ org.netlib.util.doubleW dnm1,
+ org.netlib.util.doubleW dnm2,
+ boolean ieee)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ5 computes one dqds transform in ping-pong form, one
+ version for IEEE machines another for non IEEE machines.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ TAU (input) DOUBLE PRECISION
+ This is the shift.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) DOUBLE PRECISION
+ d(N0), the last value of d.
+
+ DNM1 (output) DOUBLE PRECISION
+ d(N0-1).
+
+ DNM2 (output) DOUBLE PRECISION
+ d(N0-2).
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic.
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dnm1</CODE> - <DD><CODE>dnm2</CODE> - <DD><CODE>ieee</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasq6(int, int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlasq6</H3>
+<PRE>
+public abstract void <B>dlasq6</B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW dmin1,
+ org.netlib.util.doubleW dmin2,
+ org.netlib.util.doubleW dn,
+ org.netlib.util.doubleW dnm1,
+ org.netlib.util.doubleW dnm2)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ6 computes one dqd (shift equal to zero) transform in
+ ping-pong form, with protection against underflow and overflow.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) DOUBLE PRECISION
+ d(N0), the last value of d.
+
+ DNM1 (output) DOUBLE PRECISION
+ d(N0-1).
+
+ DNM2 (output) DOUBLE PRECISION
+ d(N0-2).
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dnm1</CODE> - <DD><CODE>dnm2</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], double[], int)"><!-- --></A><H3>
+dlasr</H3>
+<PRE>
+public abstract void <B>dlasr</B>(java.lang.String side,
+ java.lang.String pivot,
+ java.lang.String direct,
+ int m,
+ int n,
+ double[] c,
+ double[] s,
+ double[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASR applies a sequence of plane rotations to a real matrix A,
+ from either the left or the right.
+
+ When SIDE = 'L', the transformation takes the form
+
+ A := P*A
+
+ and when SIDE = 'R', the transformation takes the form
+
+ A := A*P**T
+
+ where P is an orthogonal matrix consisting of a sequence of z plane
+ rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+ and P**T is the transpose of P.
+
+ When DIRECT = 'F' (Forward sequence), then
+
+ P = P(z-1) * ... * P(2) * P(1)
+
+ and when DIRECT = 'B' (Backward sequence), then
+
+ P = P(1) * P(2) * ... * P(z-1)
+
+ where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+
+
+ R(k) = ( c(k) s(k) )
+ = ( -s(k) c(k) ).
+
+ When PIVOT = 'V' (Variable pivot), the rotation is performed
+ for the plane (k,k+1), i.e., P(k) has the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears as a rank-2 modification to the identity matrix in
+ rows and columns k and k+1.
+
+ When PIVOT = 'T' (Top pivot), the rotation is performed for the
+ plane (1,k+1), so P(k) has the form
+
+ P(k) = ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears in rows and columns 1 and k+1.
+
+ Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+ performed for the plane (k,z), giving P(k) the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+
+ where R(k) appears in rows and columns k and z. The rotations are
+ performed without ever forming P(k) explicitly.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ Specifies whether the plane rotation matrix P is applied to
+ A on the left or the right.
+ = 'L': Left, compute A := P*A
+ = 'R': Right, compute A:= A*P**T
+
+ PIVOT (input) CHARACTER*1
+ Specifies the plane for which P(k) is a plane rotation
+ matrix.
+ = 'V': Variable pivot, the plane (k,k+1)
+ = 'T': Top pivot, the plane (1,k+1)
+ = 'B': Bottom pivot, the plane (k,z)
+
+ DIRECT (input) CHARACTER*1
+ Specifies whether P is a forward or backward sequence of
+ plane rotations.
+ = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+ = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
+
+ M (input) INTEGER
+ The number of rows of the matrix A. If m <= 1, an immediate
+
+ return is effected.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. If n <= 1, an
+ immediate return is effected.
+
+ C (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The cosines c(k) of the plane rotations.
+
+ S (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The sines s(k) of the plane rotations. The 2-by-2 plane
+ rotation part of the matrix P(k), R(k), has the form
+ R(k) = ( c(k) s(k) )
+ ( -s(k) c(k) ).
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ The M-by-N matrix A. On exit, A is overwritten by P*A if
+ SIDE = 'R' or by A*P**T if SIDE = 'L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>pivot</CODE> - <DD><CODE>direct</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasrt(java.lang.String, int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlasrt</H3>
+<PRE>
+public abstract void <B>dlasrt</B>(java.lang.String id,
+ int n,
+ double[] d,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Sort the numbers in D in increasing order (if ID = 'I') or
+ in decreasing order (if ID = 'D' ).
+
+ Use Quick Sort, reverting to Insertion sort on arrays of
+ size <= 20. Dimension of STACK limits N to about 2**32.
+
+ Arguments
+ =========
+
+ ID (input) CHARACTER*1
+ = 'I': sort D in increasing order;
+ = 'D': sort D in decreasing order.
+
+ N (input) INTEGER
+ The length of the array D.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the array to be sorted.
+ On exit, D has been sorted into increasing order
+ (D(1) <= ... <= D(N) ) or into decreasing order
+ (D(1) >= ... >= D(N) ), depending on ID.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>id</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlassq(int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlassq</H3>
+<PRE>
+public abstract void <B>dlassq</B>(int n,
+ double[] x,
+ int incx,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW sumsq)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASSQ returns the values scl and smsq such that
+
+ ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+
+
+ where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+ assumed to be non-negative and scl returns the value
+
+ scl = max( scale, abs( x( i ) ) ).
+
+ scale and sumsq must be supplied in SCALE and SUMSQ and
+ scl and smsq are overwritten on SCALE and SUMSQ respectively.
+
+ The routine makes only one pass through the vector x.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of elements to be used from the vector X.
+
+ X (input) DOUBLE PRECISION array, dimension (N)
+ The vector for which a scaled sum of squares is computed.
+ x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector X.
+ INCX > 0.
+
+ SCALE (input/output) DOUBLE PRECISION
+ On entry, the value scale in the equation above.
+ On exit, SCALE is overwritten with scl , the scaling factor
+
+ for the sum of squares.
+
+ SUMSQ (input/output) DOUBLE PRECISION
+ On entry, the value sumsq in the equation above.
+ On exit, SUMSQ is overwritten with smsq , the basic sum of
+ squares from which scl has been factored out.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>sumsq</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasv2(double, double, double, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlasv2</H3>
+<PRE>
+public abstract void <B>dlasv2</B>(double f,
+ double g,
+ double h,
+ org.netlib.util.doubleW ssmin,
+ org.netlib.util.doubleW ssmax,
+ org.netlib.util.doubleW snr,
+ org.netlib.util.doubleW csr,
+ org.netlib.util.doubleW snl,
+ org.netlib.util.doubleW csl)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASV2 computes the singular value decomposition of a 2-by-2
+ triangular matrix
+ [ F G ]
+ [ 0 H ].
+ On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+ smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+
+ right singular vectors for abs(SSMAX), giving the decomposition
+
+ [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+ [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) DOUBLE PRECISION
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) DOUBLE PRECISION
+ abs(SSMIN) is the smaller singular value.
+
+ SSMAX (output) DOUBLE PRECISION
+ abs(SSMAX) is the larger singular value.
+
+ SNL (output) DOUBLE PRECISION
+ CSL (output) DOUBLE PRECISION
+ The vector (CSL, SNL) is a unit left singular vector for the
+
+ singular value abs(SSMAX).
+
+ SNR (output) DOUBLE PRECISION
+ CSR (output) DOUBLE PRECISION
+ The vector (CSR, SNR) is a unit right singular vector for the
+ singular value abs(SSMAX).
+
+ Further Details
+ ===============
+
+ Any input parameter may be aliased with any output parameter.
+
+ Barring over/underflow and assuming a guard digit in subtraction, all
+ output quantities are correct to within a few units in the last
+ place (ulps).
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>f</CODE> - <DD><CODE>g</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ssmin</CODE> - <DD><CODE>ssmax</CODE> - <DD><CODE>snr</CODE> - <DD><CODE>csr</CODE> - <DD><CODE>snl</CODE> - <DD><CODE>csl</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlaswp(int, double[], int, int, int, int[], int)"><!-- --></A><H3>
+dlaswp</H3>
+<PRE>
+public abstract void <B>dlaswp</B>(int n,
+ double[] a,
+ int lda,
+ int k1,
+ int k2,
+ int[] ipiv,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASWP performs a series of row interchanges on the matrix A.
+ One row interchange is initiated for each of rows K1 through K2 of A.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of columns of the matrix A.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the matrix of column dimension N to which the row
+ interchanges will be applied.
+ On exit, the permuted matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+
+ K1 (input) INTEGER
+ The first element of IPIV for which a row interchange will
+ be done.
+
+ K2 (input) INTEGER
+ The last element of IPIV for which a row interchange will
+ be done.
+
+ IPIV (input) INTEGER array, dimension (K2*abs(INCX))
+ The vector of pivot indices. Only the elements in positions
+
+ K1 through K2 of IPIV are accessed.
+ IPIV(K) = L implies rows K and L are to be interchanged.
+
+ INCX (input) INTEGER
+ The increment between successive values of IPIV. If IPIV
+ is negative, the pivots are applied in reverse order.
+
+ Further Details
+ ===============
+
+ Modified by
+ R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>k1</CODE> - <DD><CODE>k2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasy2(boolean, boolean, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, double[], int, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dlasy2</H3>
+<PRE>
+public abstract void <B>dlasy2</B>(boolean ltranl,
+ boolean ltranr,
+ int isgn,
+ int n1,
+ int n2,
+ double[] tl,
+ int ldtl,
+ double[] tr,
+ int ldtr,
+ double[] b,
+ int ldb,
+ org.netlib.util.doubleW scale,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW xnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
+
+ op(TL)*X + ISGN*X*op(TR) = SCALE*B,
+
+ where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
+
+ -1. op(T) = T or T', where T' denotes the transpose of T.
+
+ Arguments
+ =========
+
+ LTRANL (input) LOGICAL
+ On entry, LTRANL specifies the op(TL):
+ = .FALSE., op(TL) = TL,
+ = .TRUE., op(TL) = TL'.
+
+ LTRANR (input) LOGICAL
+ On entry, LTRANR specifies the op(TR):
+ = .FALSE., op(TR) = TR,
+ = .TRUE., op(TR) = TR'.
+
+ ISGN (input) INTEGER
+ On entry, ISGN specifies the sign of the equation
+ as described before. ISGN may only be 1 or -1.
+
+ N1 (input) INTEGER
+ On entry, N1 specifies the order of matrix TL.
+ N1 may only be 0, 1 or 2.
+
+ N2 (input) INTEGER
+ On entry, N2 specifies the order of matrix TR.
+ N2 may only be 0, 1 or 2.
+
+ TL (input) DOUBLE PRECISION array, dimension (LDTL,2)
+ On entry, TL contains an N1 by N1 matrix.
+
+ LDTL (input) INTEGER
+ The leading dimension of the matrix TL. LDTL >= max(1,N1).
+
+ TR (input) DOUBLE PRECISION array, dimension (LDTR,2)
+ On entry, TR contains an N2 by N2 matrix.
+
+ LDTR (input) INTEGER
+ The leading dimension of the matrix TR. LDTR >= max(1,N2).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,2)
+ On entry, the N1 by N2 matrix B contains the right-hand
+ side of the equation.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1,N1).
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ less than or equal to 1 to prevent the solution overflowing.
+
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,2)
+ On exit, X contains the N1 by N2 solution.
+
+ LDX (input) INTEGER
+ The leading dimension of the matrix X. LDX >= max(1,N1).
+
+ XNORM (output) DOUBLE PRECISION
+ On exit, XNORM is the infinity-norm of the solution.
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: TL and TR have too close eigenvalues, so TL or
+ TR is perturbed to get a nonsingular equation.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ltranl</CODE> - <DD><CODE>ltranr</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>tl</CODE> - <DD><CODE>ldtl</CODE> - <DD><CODE>tr</CODE> - <DD><CODE>ldtr</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>xnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlasyf(java.lang.String, int, int, org.netlib.util.intW, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlasyf</H3>
+<PRE>
+public abstract void <B>dlasyf</B>(java.lang.String uplo,
+ int n,
+ int nb,
+ org.netlib.util.intW kb,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] w,
+ int ldw,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASYF computes a partial factorization of a real symmetric matrix A
+
+ using the Bunch-Kaufman diagonal pivoting method. The partial
+ factorization has the form:
+
+ A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
+ ( 0 U22 ) ( 0 D ) ( U12' U22' )
+
+ A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L'
+ ( L21 I ) ( 0 A22 ) ( 0 I )
+
+ where the order of D is at most NB. The actual order is returned in
+ the argument KB, and is either NB or NB-1, or N if N <= NB.
+
+ DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code
+ (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
+ A22 (if UPLO = 'L').
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NB (input) INTEGER
+ The maximum number of columns of the matrix A that should be
+
+ factored. NB should be at least 2 to allow for 2-by-2 pivot
+
+ blocks.
+
+ KB (output) INTEGER
+ The number of columns of A that were actually factored.
+ KB is either NB-1 or NB, or N if N <= NB.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, A contains details of the partial factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If UPLO = 'U', only the last KB elements of IPIV are set;
+ if UPLO = 'L', only the first KB elements are set.
+
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ W (workspace) DOUBLE PRECISION array, dimension (LDW,NB)
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>w</CODE> - <DD><CODE>ldw</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatbs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlatbs</H3>
+<PRE>
+public abstract void <B>dlatbs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] x,
+ org.netlib.util.doubleW scale,
+ double[] cnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATBS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular band matrix. Here A' denotes the transpose of A, x and b
+
+ are n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine DTBSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of subdiagonals or superdiagonals in the
+ triangular matrix A. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first KD+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, DTBSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTBSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call DTBSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>normin</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>x</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>cnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatdf(int, int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, int[], int[])"><!-- --></A><H3>
+dlatdf</H3>
+<PRE>
+public abstract void <B>dlatdf</B>(int ijob,
+ int n,
+ double[] z,
+ int ldz,
+ double[] rhs,
+ org.netlib.util.doubleW rdsum,
+ org.netlib.util.doubleW rdscal,
+ int[] ipiv,
+ int[] jpiv)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATDF uses the LU factorization of the n-by-n matrix Z computed by
+ DGETC2 and computes a contribution to the reciprocal Dif-estimate
+ by solving Z * x = b for x, and choosing the r.h.s. b such that
+ the norm of x is as large as possible. On entry RHS = b holds the
+ contribution from earlier solved sub-systems, and on return RHS = x.
+
+
+ The factorization of Z returned by DGETC2 has the form Z = P*L*U*Q,
+ where P and Q are permutation matrices. L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ IJOB = 2: First compute an approximative null-vector e
+ of Z using DGECON, e is normalized and solve for
+ Zx = +-e - f with the sign giving the greater value
+ of 2-norm(x). About 5 times as expensive as Default.
+ IJOB .ne. 2: Local look ahead strategy where all entries of
+ the r.h.s. b is choosen as either +1 or -1 (Default).
+
+ N (input) INTEGER
+ The number of columns of the matrix Z.
+
+ Z (input) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix Z computed by DGETC2: Z = P * L * U * Q
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDA >= max(1, N).
+
+ RHS (input/output) DOUBLE PRECISION array, dimension N.
+ On entry, RHS contains contributions from other subsystems.
+ On exit, RHS contains the solution of the subsystem with
+ entries acoording to the value of IJOB (see above).
+
+ RDSUM (input/output) DOUBLE PRECISION
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by DTGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
+
+ RDSCAL (input/output) DOUBLE PRECISION
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when DTGSY2 is called by
+ DTGSYL.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ This routine is a further developed implementation of algorithm
+ BSOLVE in [1] using complete pivoting in the LU factorization.
+
+ [1] Bo Kagstrom and Lars Westin,
+ Generalized Schur Methods with Condition Estimators for
+ Solving the Generalized Sylvester Equation, IEEE Transactions
+ on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
+
+ [2] Peter Poromaa,
+ On Efficient and Robust Estimators for the Separation
+ between two Regular Matrix Pairs with Applications in
+ Condition Estimation. Report IMINF-95.05, Departement of
+ Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ijob</CODE> - <DD><CODE>n</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>rhs</CODE> - <DD><CODE>rdsum</CODE> - <DD><CODE>rdscal</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>jpiv</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatps(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlatps</H3>
+<PRE>
+public abstract void <B>dlatps</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ double[] ap,
+ double[] x,
+ org.netlib.util.doubleW scale,
+ double[] cnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATPS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular matrix stored in packed form. Here A' denotes the
+ transpose of A, x and b are n-element vectors, and s is a scaling
+ factor, usually less than or equal to 1, chosen so that the
+ components of x will be less than the overflow threshold. If the
+ unscaled problem will not cause overflow, the Level 2 BLAS routine
+ DTPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
+ then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, DTPSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTPSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call DTPSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>normin</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>cnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatrd(java.lang.String, int, int, double[], int, double[], double[], double[], int)"><!-- --></A><H3>
+dlatrd</H3>
+<PRE>
+public abstract void <B>dlatrd</B>(java.lang.String uplo,
+ int n,
+ int nb,
+ double[] a,
+ int lda,
+ double[] e,
+ double[] tau,
+ double[] w,
+ int ldw)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATRD reduces NB rows and columns of a real symmetric matrix A to
+ symmetric tridiagonal form by an orthogonal similarity
+ transformation Q' * A * Q, and returns the matrices V and W which are
+ needed to apply the transformation to the unreduced part of A.
+
+ If UPLO = 'U', DLATRD reduces the last NB rows and columns of a
+ matrix, of which the upper triangle is supplied;
+ if UPLO = 'L', DLATRD reduces the first NB rows and columns of a
+ matrix, of which the lower triangle is supplied.
+
+ This is an auxiliary routine called by DSYTRD.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NB (input) INTEGER
+ The number of rows and columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit:
+ if UPLO = 'U', the last NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements above the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+
+ product of elementary reflectors;
+ if UPLO = 'L', the first NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements below the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= (1,N).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+ elements of the last NB columns of the reduced matrix;
+ if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+ the first NB columns of the reduced matrix.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors, stored in
+ TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+
+ See Further Details.
+
+ W (output) DOUBLE PRECISION array, dimension (LDW,NB)
+ The n-by-nb matrix W required to update the unreduced part
+ of A.
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n) H(n-1) . . . H(n-nb+1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+
+ and tau in TAU(i-1).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and tau in TAU(i).
+
+ The elements of the vectors v together form the n-by-nb matrix V
+ which is needed, with W, to apply the transformation to the unreduced
+ part of the matrix, using a symmetric rank-2k update of the form:
+ A := A - V*W' - W*V'.
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5 and nb = 2:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( a a a v4 v5 ) ( d )
+ ( a a v4 v5 ) ( 1 d )
+ ( a 1 v5 ) ( v1 1 a )
+ ( d 1 ) ( v1 v2 a a )
+ ( d ) ( v1 v2 a a a )
+
+ where d denotes a diagonal element of the reduced matrix, a denotes
+ an element of the original matrix that is unchanged, and vi denotes
+ an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>w</CODE> - <DD><CODE>ldw</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatrs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], org.netlib.util.doubleW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dlatrs</H3>
+<PRE>
+public abstract void <B>dlatrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ double[] a,
+ int lda,
+ double[] x,
+ org.netlib.util.doubleW scale,
+ double[] cnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATRS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow. Here A is an upper or lower
+ triangular matrix, A' denotes the transpose of A, x and b are
+ n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine DTRSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max (1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, DTRSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>normin</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>cnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatrz(int, int, int, double[], int, double[], double[])"><!-- --></A><H3>
+dlatrz</H3>
+<PRE>
+public abstract void <B>dlatrz</B>(int m,
+ int n,
+ int l,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
+ [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means
+ of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal
+ matrix and, R and A1 are M-by-M upper triangular matrices.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing the
+ meaningful part of the Householder vectors. N-M >= L >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements N-L+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an l element vector. tau and z( k )
+ are chosen to annihilate the elements of the kth row of A2.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A2, such that the elements of z( k ) are
+ in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A1.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlatzm(java.lang.String, int, int, double[], int, double, double[], double[], int, double[])"><!-- --></A><H3>
+dlatzm</H3>
+<PRE>
+public abstract void <B>dlatzm</B>(java.lang.String side,
+ int m,
+ int n,
+ double[] v,
+ int incv,
+ double tau,
+ double[] c1,
+ double[] c2,
+ int Ldc,
+ double[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DORMRZ.
+
+ DLATZM applies a Householder matrix generated by DTZRQF to a matrix.
+
+
+ Let P = I - tau*u*u', u = ( 1 ),
+ ( v )
+ where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
+ SIDE = 'R'.
+
+ If SIDE equals 'L', let
+ C = [ C1 ] 1
+ [ C2 ] m-1
+ n
+ Then C is overwritten by P*C.
+
+ If SIDE equals 'R', let
+ C = [ C1, C2 ] m
+ 1 n-1
+ Then C is overwritten by C*P.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form P * C
+ = 'R': form C * P
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of P. V is not used
+ if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of P.
+
+ C1 (input/output) DOUBLE PRECISION array, dimension
+ (LDC,N) if SIDE = 'L'
+ (M,1) if SIDE = 'R'
+ On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
+ if SIDE = 'R'.
+
+ On exit, the first row of P*C if SIDE = 'L', or the first
+ column of C*P if SIDE = 'R'.
+
+ C2 (input/output) DOUBLE PRECISION array, dimension
+ (LDC, N) if SIDE = 'L'
+ (LDC, N-1) if SIDE = 'R'
+ On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
+ m x (n - 1) matrix C2 if SIDE = 'R'.
+
+ On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
+ if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the arrays C1 and C2. LDC >= (1,M).
+
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>incv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c1</CODE> - <DD><CODE>c2</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlauu2(java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlauu2</H3>
+<PRE>
+public abstract void <B>dlauu2</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAUU2 computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the unblocked form of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlauum(java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dlauum</H3>
+<PRE>
+public abstract void <B>dlauum</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAUUM computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the blocked form of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlazq3(int, org.netlib.util.intW, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlazq3</H3>
+<PRE>
+public void <B>dlazq3</B>(int i0,
+ org.netlib.util.intW n0,
+ double[] z,
+ int pp,
+ org.netlib.util.doubleW dmin,
+ org.netlib.util.doubleW sigma,
+ org.netlib.util.doubleW desig,
+ org.netlib.util.doubleW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee,
+ org.netlib.util.intW ttype,
+ org.netlib.util.doubleW dmin1,
+ org.netlib.util.doubleW dmin2,
+ org.netlib.util.doubleW dn,
+ org.netlib.util.doubleW dn1,
+ org.netlib.util.doubleW dn2,
+ org.netlib.util.doubleW tau)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAZQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ SIGMA (output) DOUBLE PRECISION
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) DOUBLE PRECISION
+ Lower order part of SIGMA
+
+ QMAX (input) DOUBLE PRECISION
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
+
+ TTYPE (input/output) INTEGER
+ Shift type. TTYPE is passed as an argument in order to save
+ its value between calls to DLAZQ3
+
+ DMIN1 (input/output) REAL
+ DMIN2 (input/output) REAL
+ DN (input/output) REAL
+ DN1 (input/output) REAL
+ DN2 (input/output) REAL
+ TAU (input/output) REAL
+ These are passed as arguments in order to save their values
+ between calls to DLAZQ3
+
+ This is a thread safe version of DLASQ3, which passes TTYPE, DMIN1,
+ DMIN2, DN, DN1. DN2 and TAU through the argument list in place of
+ declaring them in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>desig</CODE> - <DD><CODE>qmax</CODE> - <DD><CODE>nfail</CODE> - <DD><CODE>iter</CODE> - <DD><CODE>ndiv</CODE> - <DD><CODE>ieee</CODE> - <DD><CODE>ttype</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dn1</CODE> - <DD><CODE>dn2</CODE> - <DD><CODE>tau</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlazq4(int, int, double[], int, int, double, double, double, double, double, double, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlazq4</H3>
+<PRE>
+public void <B>dlazq4</B>(int i0,
+ int n0,
+ double[] z,
+ int pp,
+ int n0in,
+ double dmin,
+ double dmin1,
+ double dmin2,
+ double dn,
+ double dn1,
+ double dn2,
+ org.netlib.util.doubleW tau,
+ org.netlib.util.intW ttype,
+ org.netlib.util.doubleW g)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAZQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) DOUBLE PRECISION
+ d(N)
+
+ DN1 (input) DOUBLE PRECISION
+ d(N-1)
+
+ DN2 (input) DOUBLE PRECISION
+ d(N-2)
+
+ TAU (output) DOUBLE PRECISION
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ G (input/output) DOUBLE PRECISION
+ G is passed as an argument in order to save its value between
+ calls to DLAZQ4
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ This is a thread safe version of DLASQ4, which passes G through the
+ argument list in place of declaring G in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>n0in</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dn1</CODE> - <DD><CODE>dn2</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>ttype</CODE> - <DD><CODE>g</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dopgtr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dopgtr</H3>
+<PRE>
+public abstract void <B>dopgtr</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] tau,
+ double[] q,
+ int ldq,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DOPGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors H(i) of order n, as returned by
+
+ DSPTRD using packed storage:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to DSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to DSPTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The vectors which define the elementary reflectors, as
+ returned by DSPTRD.
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSPTRD.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ The N-by-N orthogonal matrix Q.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N-1)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dopmtr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dopmtr</H3>
+<PRE>
+public abstract void <B>dopmtr</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ double[] ap,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DOPMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by DSPTRD using packed
+ storage:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to DSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to DSPTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension
+ (M*(M+1)/2) if SIDE = 'L'
+ (N*(N+1)/2) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DSPTRD. AP is modified by the routine but
+ restored on exit.
+
+ TAU (input) DOUBLE PRECISION array, dimension (M-1) if SIDE = 'L'
+ or (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSPTRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorg2l(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorg2l</H3>
+<PRE>
+public abstract void <B>dorg2l</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORG2L generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the last n columns of a product of k elementary
+ reflectors of order m
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQLF in the last k columns of its array
+ argument A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorg2r(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorg2r</H3>
+<PRE>
+public abstract void <B>dorg2r</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORG2R generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the first n columns of a product of k elementary
+
+ reflectors of order m
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQRF in the first k columns of its array
+ argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgbr(java.lang.String, int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorgbr</H3>
+<PRE>
+public abstract void <B>dorgbr</B>(java.lang.String vect,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGBR generates one of the real orthogonal matrices Q or P**T
+ determined by DGEBRD when reducing a real matrix A to bidiagonal
+ form: A = Q * B * P**T. Q and P**T are defined as products of
+ elementary reflectors H(i) or G(i) respectively.
+
+ If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
+ is of order M:
+ if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
+ columns of Q, where m >= n >= k;
+ if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
+ M-by-M matrix.
+
+ If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
+ is of order N:
+ if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
+
+ rows of P**T, where n >= m >= k;
+ if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
+ an N-by-N matrix.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether the matrix Q or the matrix P**T is
+ required, as defined in the transformation applied by DGEBRD:
+ = 'Q': generate Q;
+ = 'P': generate P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix Q or P**T to be returned.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q or P**T to be returned.
+ N >= 0.
+ If VECT = 'Q', M >= N >= min(M,K);
+ if VECT = 'P', N >= M >= min(N,K).
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original M-by-K
+ matrix reduced by DGEBRD.
+ If VECT = 'P', the number of rows in the original K-by-N
+ matrix reduced by DGEBRD.
+ K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DGEBRD.
+ On exit, the M-by-N matrix Q or P**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (min(M,K)) if VECT = 'Q'
+ (min(N,K)) if VECT = 'P'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i), which determines Q or P**T, as
+ returned by DGEBRD in its array argument TAUQ or TAUP.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,min(M,N)).
+ For optimum performance LWORK >= min(M,N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorghr(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorghr</H3>
+<PRE>
+public abstract void <B>dorghr</B>(int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGHR generates a real orthogonal matrix Q which is defined as the
+ product of IHI-ILO elementary reflectors of order N, as returned by
+ DGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of DGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DGEHRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEHRD.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= IHI-ILO.
+ For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgl2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorgl2</H3>
+<PRE>
+public abstract void <B>dorgl2</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGL2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the first m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by DGELQF in the first k rows of its array argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorglq(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorglq</H3>
+<PRE>
+public abstract void <B>dorglq</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGLQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the first M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by DGELQF in the first k rows of its array argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgql(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorgql</H3>
+<PRE>
+public abstract void <B>dorgql</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGQL generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the last N columns of a product of K elementary
+ reflectors of order M
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQLF in the last k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgqr(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorgqr</H3>
+<PRE>
+public abstract void <B>dorgqr</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGQR generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the first N columns of a product of K elementary
+
+ reflectors of order M
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQRF in the first k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgr2(int, int, int, double[], int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorgr2</H3>
+<PRE>
+public abstract void <B>dorgr2</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGR2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the last m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGERQF in the last k rows of its array argument
+ A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgrq(int, int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorgrq</H3>
+<PRE>
+public abstract void <B>dorgrq</B>(int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGRQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the last M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGERQF in the last k rows of its array argument
+ A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorgtr(java.lang.String, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dorgtr</H3>
+<PRE>
+public abstract void <B>dorgtr</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors of order N, as returned by
+ DSYTRD:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from DSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from DSYTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DSYTRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSYTRD.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N-1).
+ For optimum performance LWORK >= (N-1)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorm2l(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorm2l</H3>
+<PRE>
+public abstract void <B>dorm2l</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORM2L overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorm2r(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorm2r</H3>
+<PRE>
+public abstract void <B>dorm2r</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORM2R overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormbr(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormbr</H3>
+<PRE>
+public abstract void <B>dormbr</B>(java.lang.String vect,
+ java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ If VECT = 'Q', DORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': P * C C * P
+ TRANS = 'T': P**T * C C * P**T
+
+ Here Q and P**T are the orthogonal matrices determined by DGEBRD when
+ reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
+
+ P**T are defined as products of elementary reflectors H(i) and G(i)
+ respectively.
+
+ Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
+ order of the orthogonal matrix Q or P**T that is applied.
+
+ If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
+ if nq >= k, Q = H(1) H(2) . . . H(k);
+ if nq < k, Q = H(1) H(2) . . . H(nq-1).
+
+ If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
+ if k < nq, P = G(1) G(2) . . . G(k);
+ if k >= nq, P = G(1) G(2) . . . G(nq-1).
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'Q': apply Q or Q**T;
+ = 'P': apply P or P**T.
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q, Q**T, P or P**T from the Left;
+ = 'R': apply Q, Q**T, P or P**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q or P;
+ = 'T': Transpose, apply Q**T or P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original
+ matrix reduced by DGEBRD.
+ If VECT = 'P', the number of rows in the original
+ matrix reduced by DGEBRD.
+ K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,min(nq,K)) if VECT = 'Q'
+ (LDA,nq) if VECT = 'P'
+ The vectors which define the elementary reflectors H(i) and
+ G(i), whose products determine the matrices Q and P, as
+ returned by DGEBRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If VECT = 'Q', LDA >= max(1,nq);
+ if VECT = 'P', LDA >= max(1,min(nq,K)).
+
+ TAU (input) DOUBLE PRECISION array, dimension (min(nq,K))
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i) which determines Q or P, as returned
+ by DGEBRD in the array argument TAUQ or TAUP.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
+ or P*C or P**T*C or C*P or C*P**T.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormhr(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormhr</H3>
+<PRE>
+public abstract void <B>dormhr</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int ilo,
+ int ihi,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMHR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ IHI-ILO elementary reflectors, as returned by DGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of DGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
+ ILO = 1 and IHI = 0, if M = 0;
+ if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
+ ILO = 1 and IHI = 0, if N = 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DGEHRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEHRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dorml2(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dorml2</H3>
+<PRE>
+public abstract void <B>dorml2</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORML2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormlq(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormlq</H3>
+<PRE>
+public abstract void <B>dormlq</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMLQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormql(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormql</H3>
+<PRE>
+public abstract void <B>dormql</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMQL overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormqr(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormqr</H3>
+<PRE>
+public abstract void <B>dormqr</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMQR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormr2(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dormr2</H3>
+<PRE>
+public abstract void <B>dormr2</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMR2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormr3(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dormr3</H3>
+<PRE>
+public abstract void <B>dormr3</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMR3 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DTZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DTZRZF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormrq(java.lang.String, java.lang.String, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormrq</H3>
+<PRE>
+public abstract void <B>dormrq</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMRQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormrz(java.lang.String, java.lang.String, int, int, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormrz</H3>
+<PRE>
+public abstract void <B>dormrz</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMRZ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DTZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DTZRZF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dormtr(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dormtr</H3>
+<PRE>
+public abstract void <B>dormtr</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] c,
+ int Ldc,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by DSYTRD:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from DSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from DSYTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DSYTRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSYTRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbcon(java.lang.String, int, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dpbcon</H3>
+<PRE>
+public abstract void <B>dpbcon</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite band matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm (or infinity-norm) of the symmetric band matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbequ(java.lang.String, int, int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dpbequ</H3>
+<PRE>
+public abstract void <B>dpbequ</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] s,
+ org.netlib.util.doubleW scond,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite band matrix A and reduce its condition
+ number (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular of A is stored;
+ = 'L': Lower triangular of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ S (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) DOUBLE PRECISION
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbrfs(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dpbrfs</H3>
+<PRE>
+public abstract void <B>dpbrfs</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and banded, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ AFB (input) DOUBLE PRECISION array, dimension (LDAFB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A as computed by
+
+ DPBTRF, in the same storage format as A (see AB).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbstf(java.lang.String, int, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpbstf</H3>
+<PRE>
+public abstract void <B>dpbstf</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBSTF computes a split Cholesky factorization of a real
+ symmetric positive definite band matrix A.
+
+ This routine is designed to be used in conjunction with DSBGST.
+
+ The factorization has the form A = S**T*S where S is a band matrix
+
+ of the same bandwidth as A and the following structure:
+
+ S = ( U )
+ ( M L )
+
+ where U is upper triangular of order m = (n+kd)/2, and L is lower
+ triangular of order n-m.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first kd+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the factor S from the split Cholesky
+ factorization A = S**T*S. See Further Details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the factorization could not be completed,
+ because the updated element a(i,i) was negative; the
+ matrix A is not positive definite.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 7, KD = 2:
+
+ S = ( s11 s12 s13 )
+ ( s22 s23 s24 )
+ ( s33 s34 )
+ ( s44 )
+ ( s53 s54 s55 )
+ ( s64 s65 s66 )
+ ( s75 s76 s77 )
+
+ If UPLO = 'U', the array AB holds:
+
+ on entry: on exit:
+
+ * a13 a24 a35 a46 a57 * * s13 s24 s53 s64 s75
+
+ a12 a23 a34 a45 a56 a67 * s12 s23 s34 s54 s65 s76
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+
+ If UPLO = 'L', the array AB holds:
+
+ on entry: on exit:
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+ a21 a32 a43 a54 a65 a76 * s12 s23 s34 s54 s65 s76 *
+ a31 a42 a53 a64 a64 * * s13 s24 s53 s64 s75 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbsv(java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpbsv</H3>
+<PRE>
+public abstract void <B>dpbsv</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix, with the same number of superdiagonals or
+ subdiagonals as A. The factored form of A is then used to solve the
+
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * a13 a24 a35 a46 * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbsvx(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dpbsvx</H3>
+<PRE>
+public abstract void <B>dpbsvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] afb,
+ int ldafb,
+ org.netlib.util.StringW equed,
+ double[] s,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AB and AFB will not
+ be modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right-hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array, except
+
+ if FACT = 'F' and EQUED = 'Y', then A must contain the
+ equilibrated matrix diag(S)*A*diag(S). The j-th column of A
+
+ is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ AFB (input or output) DOUBLE PRECISION array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the band matrix
+ A, in the same storage format as A (see AB). If EQUED = 'Y',
+ then AFB is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13
+ a22 a23 a24
+ a33 a34 a35
+ a44 a45 a46
+ a55 a56
+ (aij=conjg(aji)) a66
+
+ Band storage of the upper triangle of A:
+
+ * a13 a24 a35 a46
+ a12 a23 a34 a45 a56
+ a11 a22 a33 a44 a55 a66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ a11 a22 a33 a44 a55 a66
+ a21 a32 a43 a54 a65 *
+ a31 a42 a53 a64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>s</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD>< [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbtf2(java.lang.String, int, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpbtf2</H3>
+<PRE>
+public abstract void <B>dpbtf2</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBTF2 computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix, U' is the transpose of U, and
+
+ L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * a13 a24 a35 a46 * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbtrf(java.lang.String, int, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpbtrf</H3>
+<PRE>
+public abstract void <B>dpbtrf</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBTRF computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * a13 a24 a35 a46 * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ Contributed by
+ Peter Mayes and Giuseppe Radicati, IBM ECSEC, Rome, March 23, 1989
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpbtrs(java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpbtrs</H3>
+<PRE>
+public abstract void <B>dpbtrs</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite band matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by DPBTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpocon(java.lang.String, int, double[], int, double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dpocon</H3>
+<PRE>
+public abstract void <B>dpocon</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpoequ(int, double[], int, double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dpoequ</H3>
+<PRE>
+public abstract void <B>dpoequ</B>(int n,
+ double[] a,
+ int lda,
+ double[] s,
+ org.netlib.util.doubleW scond,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A and reduce its condition number
+
+ (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The N-by-N symmetric positive definite matrix whose scaling
+ factors are to be computed. Only the diagonal elements of A
+
+ are referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ S (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) DOUBLE PRECISION
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dporfs(java.lang.String, int, int, double[], int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dporfs</H3>
+<PRE>
+public abstract void <B>dporfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPORFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite,
+ and provides error bounds and backward error estimates for the
+ solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPOTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPOTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dposv(java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dposv</H3>
+<PRE>
+public abstract void <B>dposv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dposvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dposvx</H3>
+<PRE>
+public abstract void <B>dposvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ org.netlib.util.StringW equed,
+ double[] s,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. A and AF will not
+ be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A, except if FACT = 'F' and
+ EQUED = 'Y', then A must contain the equilibrated matrix
+ diag(S)*A*diag(S). If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
+
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A. If EQUED .ne. 'N', then AF is the factored form
+ of the equilibrated matrix diag(S)*A*diag(S).
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the original
+ matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>s</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpotf2(java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpotf2</H3>
+<PRE>
+public abstract void <B>dpotf2</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTF2 computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpotrf(java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpotrf</H3>
+<PRE>
+public abstract void <B>dpotrf</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the block version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpotri(java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpotri</H3>
+<PRE>
+public abstract void <B>dpotri</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by DPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, as computed by
+ DPOTRF.
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpotrs(java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpotrs</H3>
+<PRE>
+public abstract void <B>dpotrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by DPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dppcon(java.lang.String, int, double[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dppcon</H3>
+<PRE>
+public abstract void <B>dppcon</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite packed matrix using
+ the Cholesky factorization A = U**T*U or A = L*L**T computed by
+ DPPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dppequ(java.lang.String, int, double[], double[], org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dppequ</H3>
+<PRE>
+public abstract void <B>dppequ</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] s,
+ org.netlib.util.doubleW scond,
+ org.netlib.util.doubleW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A in packed storage and reduce
+ its condition number (with respect to the two-norm). S contains the
+
+ scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
+
+ B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
+ This choice of S puts the condition number of B within a factor N of
+
+ the smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ S (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) DOUBLE PRECISION
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpprfs(java.lang.String, int, int, double[], double[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dpprfs</H3>
+<PRE>
+public abstract void <B>dpprfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ AFP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPPTRF/ZPPTRF,
+ packed columnwise in a linear array in the same format as A
+ (see AP).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dppsv(java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dppsv</H3>
+<PRE>
+public abstract void <B>dppsv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dppsvx(java.lang.String, java.lang.String, int, int, double[], double[], org.netlib.util.StringW, double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dppsvx</H3>
+<PRE>
+public abstract void <B>dppsvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ org.netlib.util.StringW equed,
+ double[] s,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFP contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AP and AFP will not
+ be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array, except if FACT = 'F'
+
+ and EQUED = 'Y', then A must contain the equilibrated matrix
+
+ diag(S)*A*diag(S). The j-th column of A is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ AFP (input or output) DOUBLE PRECISION array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L', in the same storage
+ format as A. If EQUED .ne. 'N', then AFP is the factored
+ form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the original matrix A.
+
+
+ If FACT = 'E', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the equilibrated
+ matrix A (see the description of AP for the form of the
+ equilibrated matrix).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>s</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpptrf(java.lang.String, int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dpptrf</H3>
+<PRE>
+public abstract void <B>dpptrf</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A stored in packed format.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T, in the same
+
+ storage format as A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ======= =======
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpptri(java.lang.String, int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dpptri</H3>
+<PRE>
+public abstract void <B>dpptri</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by DPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor is stored in AP;
+ = 'L': Lower triangular factor is stored in AP.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, packed columnwise as
+
+ a linear array. The j-th column of U or L is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpptrs(java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpptrs</H3>
+<PRE>
+public abstract void <B>dpptrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A in packed storage using the Cholesky
+ factorization A = U**T*U or A = L*L**T computed by DPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dptcon(int, double[], double[], double, org.netlib.util.doubleW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dptcon</H3>
+<PRE>
+public abstract void <B>dptcon</B>(int n,
+ double[] d,
+ double[] e,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTCON computes the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite tridiagonal matrix
+ using the factorization A = L*D*L**T or A = U**T*D*U computed by
+ DPTTRF.
+
+ Norm(inv(A)) is computed by a direct method, and the reciprocal of
+ the condition number is computed as
+ RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization of A, as computed by DPTTRF.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) off-diagonal elements of the unit bidiagonal factor
+ U or L from the factorization of A, as computed by DPTTRF.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
+ 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The method used is described in Nicholas J. Higham, "Efficient
+ Algorithms for Computing the Condition Number of a Tridiagonal
+ Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpteqr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dpteqr</H3>
+<PRE>
+public abstract void <B>dpteqr</B>(java.lang.String compz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric positive definite tridiagonal matrix by first factoring the
+ matrix using DPTTRF, and then calling DBDSQR to compute the singular
+
+ values of the bidiagonal factor.
+
+ This routine computes the eigenvalues of the positive definite
+ tridiagonal matrix to high relative accuracy. This means that if the
+ eigenvalues range over many orders of magnitude in size, then the
+ small eigenvalues and corresponding eigenvectors will be computed
+ more accurately than, for example, with the standard QR method.
+
+ The eigenvectors of a full or band symmetric positive definite matrix
+ can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to
+ reduce this matrix to tridiagonal form. (The reduction to tridiagonal
+ form, however, may preclude the possibility of obtaining high
+ relative accuracy in the small eigenvalues of the original matrix, if
+ these eigenvalues range over many orders of magnitude.)
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvectors of original symmetric
+ matrix also. Array Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal
+ matrix.
+ On normal exit, D contains the eigenvalues, in descending
+ order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix used in the
+ reduction to tridiagonal form.
+ On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
+
+ original symmetric matrix;
+ if COMPZ = 'I', the orthonormal eigenvectors of the
+ tridiagonal matrix.
+ If INFO > 0 on exit, Z contains the eigenvectors associated
+ with only the stored eigenvalues.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ COMPZ = 'V' or 'I', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is:
+ <= N the Cholesky factorization of the matrix could
+ not be performed because the i-th principal minor
+ was not positive definite.
+ > N the SVD algorithm failed to converge;
+ if INFO = N+i, i off-diagonal elements of the
+ bidiagonal factor did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dptrfs(int, int, double[], double[], double[], double[], double[], int, double[], int, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dptrfs</H3>
+<PRE>
+public abstract void <B>dptrfs</B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] df,
+ double[] ef,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and tridiagonal, and provides error bounds and backward error
+ estimates for the solution.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization computed by DPTTRF.
+
+ EF (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the factorization computed by DPTTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>df</CODE> - <DD><CODE>ef</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dptsv(int, int, double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dptsv</H3>
+<PRE>
+public abstract void <B>dptsv</B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTSV computes the solution to a real system of linear equations
+ A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
+ matrix, and X and B are N-by-NRHS matrices.
+
+ A is factored as A = L*D*L**T, and the factored form of A is then
+ used to solve the system of equations.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the factorization A = L*D*L**T.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L**T factorization of
+ A. (E can also be regarded as the superdiagonal of the unit
+
+ bidiagonal factor U from the U**T*D*U factorization of A.)
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the solution has not been
+ computed. The factorization has not been completed
+ unless i = N.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dptsvx(java.lang.String, int, int, double[], double[], double[], double[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dptsvx</H3>
+<PRE>
+public abstract void <B>dptsvx</B>(java.lang.String fact,
+ int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] df,
+ double[] ef,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTSVX uses the factorization A = L*D*L**T to compute the solution
+ to a real system of linear equations A*X = B, where A is an N-by-N
+ symmetric positive definite tridiagonal matrix and X and B are
+ N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
+ is a unit lower bidiagonal matrix and D is diagonal. The
+ factorization can also be regarded as having the form
+ A = U**T*D*U.
+
+ 2. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, DF and EF contain the factored form of A.
+ D, E, DF, and EF will not be modified.
+ = 'N': The matrix A will be copied to DF and EF and
+ factored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input or output) DOUBLE PRECISION array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+
+ EF (input or output) DOUBLE PRECISION array, dimension (N-1)
+ If FACT = 'F', then EF is an input argument and on entry
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+ If FACT = 'N', then EF is an output argument and on exit
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal condition number of the matrix A. If RCOND
+ is less than the machine precision (in particular, if
+ RCOND = 0), the matrix is singular to working precision.
+ This condition is indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in any
+ element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>df</CODE> - <DD><CODE>ef</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpttrf(int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dpttrf</H3>
+<PRE>
+public abstract void <B>dpttrf</B>(int n,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTTRF computes the L*D*L' factorization of a real symmetric
+ positive definite tridiagonal matrix A. The factorization may also
+ be regarded as having the form A = U'*D*U.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the L*D*L' factorization of A.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L' factorization of A.
+
+ E can also be regarded as the superdiagonal of the unit
+ bidiagonal factor U from the U'*D*U factorization of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite; if k < N, the factorization could not
+ be completed, while if k = N, the factorization was
+ completed, but D(N) <= 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dpttrs(int, int, double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dpttrs</H3>
+<PRE>
+public abstract void <B>dpttrs</B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTTRS solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by DPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dptts2(int, int, double[], double[], double[], int)"><!-- --></A><H3>
+dptts2</H3>
+<PRE>
+public abstract void <B>dptts2</B>(int n,
+ int nrhs,
+ double[] d,
+ double[] e,
+ double[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTTS2 solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by DPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="drscl(int, double, double[], int)"><!-- --></A><H3>
+drscl</H3>
+<PRE>
+public abstract void <B>drscl</B>(int n,
+ double sa,
+ double[] sx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DRSCL multiplies an n-element real vector x by the real scalar 1/a.
+ This is done without overflow or underflow as long as
+ the final result x/a does not overflow or underflow.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of components of the vector x.
+
+ SA (input) DOUBLE PRECISION
+ The scalar a which is used to divide each component of x.
+ SA must be >= 0, or the subroutine will divide by zero.
+
+ SX (input/output) DOUBLE PRECISION array, dimension
+ (1+(N-1)*abs(INCX))
+ The n-element vector x.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector SX.
+ > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
+
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sa</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbev(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsbev</H3>
+<PRE>
+public abstract void <B>dsbev</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBEV computes all the eigenvalues and, optionally, eigenvectors of
+ a real symmetric band matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,3*N-2))
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbevd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsbevd</H3>
+<PRE>
+public abstract void <B>dsbevd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBEVD computes all the eigenvalues and, optionally, eigenvectors of
+
+ a real symmetric band matrix A. If eigenvectors are desired, it uses
+
+ a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ IF N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 2, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 2, LWORK must be at least
+ ( 1 + 5*N + 2*N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array LIWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbevx(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsbevx</H3>
+<PRE>
+public abstract void <B>dsbevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] q,
+ int ldq,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric band matrix A. Eigenvalues and eigenvectors can
+
+ be selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ, N)
+ If JOBZ = 'V', the N-by-N orthogonal matrix used in the
+ reduction to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'V', then
+ LDQ >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AB to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (7*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbgst(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsbgst</H3>
+<PRE>
+public abstract void <B>dsbgst</B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] x,
+ int ldx,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGST reduces a real symmetric-definite banded generalized
+ eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
+ such that C has the same bandwidth as A.
+
+ B must have been previously factorized as S**T*S by DPBSTF, using a
+ split Cholesky factorization. A is overwritten by C = X**T*A*X, where
+ X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the
+ bandwidth of A.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form the transformation matrix X;
+ = 'V': form X.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= KB >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the transformed matrix X**T*A*X, stored in the same
+
+ format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input) DOUBLE PRECISION array, dimension (LDBB,N)
+ The banded factor S from the split Cholesky factorization of
+
+ B, as returned by DPBSTF, stored in the first KB+1 rows of
+ the array.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,N)
+ If VECT = 'V', the n-by-n matrix X.
+ If VECT = 'N', the array X is not referenced.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X.
+ LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbgv(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsbgv</H3>
+<PRE>
+public abstract void <B>dsbgv</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+ and banded, and B is also positive definite.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) DOUBLE PRECISION array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by DPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so that Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbgvd(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsbgvd</H3>
+<PRE>
+public abstract void <B>dsbgvd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of the
+
+ form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and
+
+ banded, and B is also positive definite. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) DOUBLE PRECISION array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by DPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 3*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 5*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if LIWORK > 0, IWORK(1) returns the optimal LIWORK.
+
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbgvx(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsbgvx</H3>
+<PRE>
+public abstract void <B>dsbgvx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ double[] ab,
+ int ldab,
+ double[] bb,
+ int ldbb,
+ double[] q,
+ int ldq,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+
+ and banded, and B is also positive definite. Eigenvalues and
+ eigenvectors can be selected by specifying either all eigenvalues,
+ a range of values or a range of indices for the desired eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) DOUBLE PRECISION array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by DPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ, N)
+ If JOBZ = 'V', the n-by-n matrix used in the reduction of
+ A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
+ and consequently C to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'N',
+ LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (7*N)
+
+ IWORK (workspace/output) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvalues that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ < 0 : if INFO = -i, the i-th argument had an illegal value
+ <= N: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in IFAIL.
+ > N : DPBSTF returned an error code; i.e.,
+ if INFO = N + i, for 1 <= i <= N, then the leading
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsbtrd(java.lang.String, java.lang.String, int, int, double[], int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsbtrd</H3>
+<PRE>
+public abstract void <B>dsbtrd</B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ double[] d,
+ double[] e,
+ double[] q,
+ int ldq,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBTRD reduces a real symmetric band matrix A to symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form Q;
+ = 'V': form Q;
+ = 'U': update a matrix X, by forming X*Q.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ On exit, the diagonal elements of AB are overwritten by the
+ diagonal elements of the tridiagonal matrix T; if KD > 0, the
+ elements on the first superdiagonal (if UPLO = 'U') or the
+ first subdiagonal (if UPLO = 'L') are overwritten by the
+ off-diagonal elements of T; the rest of AB is overwritten by
+
+ values generated during the reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if VECT = 'U', then Q must contain an N-by-N
+ matrix X; if VECT = 'N' or 'V', then Q need not be set.
+
+ On exit:
+ if VECT = 'V', Q contains the N-by-N orthogonal matrix Q;
+ if VECT = 'U', Q contains the product X*Q;
+ if VECT = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Modified by Linda Kaufman, Bell Labs.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsgesv(int, int, double[], int, int[], double[], int, double[], int, double[], float[], org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+dsgesv</H3>
+<PRE>
+public void <B>dsgesv</B>(int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] work,
+ float[] swork,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ DSGESV first attempts to factorize the matrix in SINGLE PRECISION
+ and use this factorization within an iterative refinement procedure t
+ produce a solution with DOUBLE PRECISION normwise backward error
+ quality (see below). If the approach fails the method switches to a
+ DOUBLE PRECISION factorization and solve.
+
+ The iterative refinement is not going to be a winning strategy if
+ the ratio SINGLE PRECISION performance over DOUBLE PRECISION performa
+ is too small. A reasonable strategy should take the number of right-h
+ sides and the size of the matrix into account. This might be done wit
+ call to ILAENV in the future. Up to now, we always try iterative refi
+
+ The iterative refinement process is stopped if
+ ITER > ITERMAX
+ or for all the RHS we have:
+ RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX
+ where
+ o ITER is the number of the current iteration in the iterative
+ refinement process
+ o RNRM is the infinity-norm of the residual
+ o XNRM is the infinity-norm of the solution
+ o ANRM is the infinity-operator-norm of the matrix A
+ o EPS is the machine epsilon returned by DLAMCH('Epsilon')
+ The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 respectively
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input or input/ouptut) DOUBLE PRECISION array,
+ dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, if iterative refinement has been successfully used
+ (INFO.EQ.0 and ITER.GE.0, see description below), then A is
+ unchanged, if double precision factorization has been used
+ (INFO.EQ.0 and ITER.LT.0, see description below), then the
+ array A contains the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+ Corresponds either to the single precision factorization
+ (if INFO.EQ.0 and ITER.GE.0) or the double precision
+ factorization (if INFO.EQ.0 and ITER.LT.0).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS matrix of right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N*NRHS)
+ This array is used to hold the residual vectors.
+
+ SWORK (workspace) REAL array, dimension (N*(N+NRHS))
+ This array is used to use the single precision matrix and the
+ right-hand sides or solutions in single precision.
+
+ ITER (output) INTEGER
+ < 0: iterative refinement has failed, double precision
+ factorization has been performed
+ -1 : taking into account machine parameters, N, NRHS, it
+ is a priori not worth working in SINGLE PRECISION
+ -2 : overflow of an entry when moving from double to
+ SINGLE PRECISION
+ -3 : failure of SGETRF
+ -31: stop the iterative refinement after the 30th
+ iterations
+ > 0: iterative refinement has been sucessfully used.
+ Returns the number of iterations
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) computed in DOUBLE PRECISION is
+ exactly zero. The factorization has been completed,
+ but the factor U is exactly singular, so the solution
+ could not be computed.
+
+ =========
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>work</CODE> - <DD><CODE>swork</CODE> - <DD><CODE>iter</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspcon(java.lang.String, int, double[], int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dspcon</H3>
+<PRE>
+public abstract void <B>dspcon</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric packed matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by DSPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspev(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dspev</H3>
+<PRE>
+public abstract void <B>dspev</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPEV computes all the eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A in packed storage.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspevd(java.lang.String, java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dspevd</H3>
+<PRE>
+public abstract void <B>dspevd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPEVD computes all the eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspevx(java.lang.String, java.lang.String, java.lang.String, int, double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dspevx</H3>
+<PRE>
+public abstract void <B>dspevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. Eigenvalues/vectors
+
+ can be selected by specifying either a range of values or a range of
+
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AP to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the selected eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspgst(int, java.lang.String, int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dspgst</H3>
+<PRE>
+public abstract void <B>dspgst</B>(int itype,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form, using packed storage.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by DPPTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ BP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor from the Cholesky factorization of B,
+ stored in the same format as A, as returned by DPPTRF.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspgv(int, java.lang.String, java.lang.String, int, double[], double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dspgv</H3>
+<PRE>
+public abstract void <B>dspgv</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGV computes all the eigenvalues and, optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric, stored in packed format,
+ and B is also positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension
+ (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPPTRF or DSPEV returned an error code:
+ <= N: if INFO = i, DSPEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero.
+ > N: if INFO = n + i, for 1 <= i <= n, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspgvd(int, java.lang.String, java.lang.String, int, double[], double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dspgvd</H3>
+<PRE>
+public abstract void <B>dspgvd</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric, stored in packed format, and B is also
+ positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPPTRF or DSPEVD returned an error code:
+ <= N: if INFO = i, DSPEVD failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspgvx(int, java.lang.String, java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dspgvx</H3>
+<PRE>
+public abstract void <B>dspgvx</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] bp,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric, stored in packed storage, and B
+ is also positive definite. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPPTRF or DSPEVX returned an error code:
+ <= N: if INFO = i, DSPEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsprfs(java.lang.String, int, int, double[], double[], int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsprfs</H3>
+<PRE>
+public abstract void <B>dsprfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ AFP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The factored form of the matrix A. AFP contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by DSPTRF, stored as a packed
+ triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DSPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspsv(java.lang.String, int, int, double[], int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dspsv</H3>
+<PRE>
+public abstract void <B>dspsv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix stored in packed format and X
+ and B are N-by-NRHS matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, D is symmetric and block diagonal with 1-by-1
+ and 2-by-2 diagonal blocks. The factored form of A is then used to
+ solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by DSPTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, so the solution could not be
+ computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dspsvx(java.lang.String, java.lang.String, int, int, double[], double[], int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dspsvx</H3>
+<PRE>
+public abstract void <B>dspsvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] afp,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPSVX uses the diagonal pivoting factorization A = U*D*U**T or
+ A = L*D*L**T to compute the solution to a real system of linear
+ equations A * X = B, where A is an N-by-N symmetric matrix stored
+ in packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AFP and IPIV contain the factored form of
+ A. AP, AFP and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ See below for further details.
+
+ AFP (input or output) DOUBLE PRECISION array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSPTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSPTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsptrd(java.lang.String, int, double[], double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsptrd</H3>
+<PRE>
+public abstract void <B>dsptrd</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ double[] d,
+ double[] e,
+ double[] tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRD reduces a real symmetric matrix A stored in packed form to
+ symmetric tridiagonal form T by an orthogonal similarity
+ transformation: Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
+ overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
+ overwriting A(i+2:n,i), and tau is stored in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsptrf(java.lang.String, int, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsptrf</H3>
+<PRE>
+public abstract void <B>dsptrf</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRF computes the factorization of a real symmetric matrix A stored
+ in packed format using the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L, stored as a packed triangular
+ matrix overwriting A (see below for further details).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 5-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsptri(java.lang.String, int, double[], int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsptri</H3>
+<PRE>
+public abstract void <B>dsptri</B>(java.lang.String uplo,
+ int n,
+ double[] ap,
+ int[] ipiv,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRI computes the inverse of a real symmetric indefinite matrix
+ A in packed storage using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by DSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by DSPTRF,
+ stored as a packed triangular matrix.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix, stored as a packed triangular matrix. The j-th column
+ of inv(A) is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = inv(A)(i,j) for 1<=i<=j;
+ if UPLO = 'L',
+ AP(i + (j-1)*(2n-j)/2) = inv(A)(i,j) for j<=i<=n.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsptrs(java.lang.String, int, int, double[], int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsptrs</H3>
+<PRE>
+public abstract void <B>dsptrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] ap,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A stored in packed format using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by DSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstebz(java.lang.String, java.lang.String, int, double, double, int, int, double, double[], double[], org.netlib.util.intW, org.netlib.util.intW, double[], int[], int[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dstebz</H3>
+<PRE>
+public abstract void <B>dstebz</B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW m,
+ org.netlib.util.intW nsplit,
+ double[] w,
+ int[] iblock,
+ int[] isplit,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEBZ computes the eigenvalues of a symmetric tridiagonal
+ matrix T. The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER*1
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER*1
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute tolerance for the eigenvalues. An eigenvalue
+ (or cluster) is considered to be located if it has been
+ determined to lie in an interval whose width is ABSTOL or
+ less. If ABSTOL is less than or equal to zero, then ULP*|T|
+
+ will be used, where |T| means the 1-norm of T.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ NSPLIT (output) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalues. (DSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (DSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ RELFAC DOUBLE PRECISION, default = 2.0e0
+ The relative tolerance. An interval (a,b] lies within
+ "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|),
+ where "ulp" is the machine precision (distance from 1 to
+ the next larger floating point number.)
+
+ FUDGE DOUBLE PRECISION, default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>range</CODE> - <DD><CODE>order</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>m</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>w</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstedc(java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dstedc</H3>
+<PRE>
+public abstract void <B>dstedc</B>(java.lang.String compz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEDC computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+ The eigenvectors of a full or band real symmetric matrix can also be
+
+ found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLAED3 for details.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+ = 'V': Compute eigenvectors of original dense symmetric
+ matrix also. On entry, Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the subdiagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 3*N + 2*N*lg N + 3*N**2 ),
+ where lg( N ) = smallest integer k such
+ that 2**k >= N.
+ If COMPZ = 'I' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LWORK need
+ only be max(1,2*(N-1)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LIWORK must be at least
+ ( 6 + 6*N + 5*N*lg N ).
+ If COMPZ = 'I' and N > 1 then LIWORK must be at least
+ ( 3 + 5*N ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LIWORK
+ need only be 1.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstegr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dstegr</H3>
+<PRE>
+public abstract void <B>dstegr</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEGR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ DSTEGR is a compatability wrapper around the improved DSTEMR routine.
+ See DSTEMR for further details.
+
+ One important change is that the ABSTOL parameter no longer provides
+ benefit and hence is no longer used.
+
+ Note : DSTEGR and DSTEMR work only on machines which follow
+ IEEE-754 floating-point standard in their handling of infinities and
+
+ NaNs. Normal execution may create these exceptiona values and hence
+
+ may abort due to a floating point exception in environments which
+ do not conform to the IEEE-754 standard.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ Unused. Was the absolute error tolerance for the
+ eigenvalues/eigenvectors in previous versions.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in DLARRE,
+ if INFO = 2X, internal error in DLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by DLARRE or
+ DLARRV, respectively.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstein(int, double[], double[], int, double[], int[], int[], double[], int, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dstein</H3>
+<PRE>
+public abstract void <B>dstein</B>(int n,
+ double[] d,
+ double[] e,
+ int m,
+ double[] w,
+ int[] iblock,
+ int[] isplit,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEIN computes the eigenvectors of a real symmetric tridiagonal
+ matrix T corresponding to specified eigenvalues, using inverse
+ iteration.
+
+ The maximum number of iterations allowed for each eigenvector is
+ specified by an internal parameter MAXITS (currently set to 5).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix
+ T, in elements 1 to N-1.
+
+ M (input) INTEGER
+ The number of eigenvectors to be found. 0 <= M <= N.
+
+ W (input) DOUBLE PRECISION array, dimension (N)
+ The first M elements of W contain the eigenvalues for
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block. ( The output array
+ W from DSTEBZ with ORDER = 'B' is expected here. )
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The submatrix indices associated with the corresponding
+ eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to
+ the first submatrix from the top, =2 if W(i) belongs to
+ the second submatrix, etc. ( The output array IBLOCK
+ from DSTEBZ is expected here. )
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+ ( The output array ISPLIT from DSTEBZ is expected here. )
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, M)
+ The computed eigenvectors. The eigenvector associated
+ with the eigenvalue W(i) is stored in the i-th column of
+ Z. Any vector which fails to converge is set to its current
+
+ iterate after MAXITS iterations.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ On normal exit, all elements of IFAIL are zero.
+ If one or more eigenvectors fail to converge after
+ MAXITS iterations, then their indices are stored in
+ array IFAIL.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge
+ in MAXITS iterations. Their indices are stored in
+ array IFAIL.
+
+ Internal Parameters
+ ===================
+
+ MAXITS INTEGER, default = 5
+ The maximum number of iterations performed.
+
+ EXTRA INTEGER, default = 2
+ The number of iterations performed after norm growth
+ criterion is satisfied, should be at least 1.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstemr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, org.netlib.util.intW, double[], double[], int, int, int[], org.netlib.util.booleanW, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dstemr</H3>
+<PRE>
+public void <B>dstemr</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int nzc,
+ int[] isuppz,
+ org.netlib.util.booleanW tryrac,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEMR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ Depending on the number of desired eigenvalues, these are computed ei
+ by bisection or the dqds algorithm. Numerically orthogonal eigenvecto
+ computed by the use of various suitable L D L^T factorizations near c
+ of close eigenvalues (referred to as RRRs, Relatively Robust
+ Representations). An informal sketch of the algorithm follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ For more details, see:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+ Notes:
+ 1.DSTEMR works only on machines which follow IEEE-754
+ floating-point standard in their handling of infinities and NaNs.
+ This permits the use of efficient inner loops avoiding a check for
+ zero divisors.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and can be computed with a workspace
+
+ query by setting NZC = -1, see below.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ NZC (input) INTEGER
+ The number of eigenvectors to be held in the array Z.
+ If RANGE = 'A', then NZC >= max(1,N).
+ If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,
+ If RANGE = 'I', then NZC >= IU-IL+1.
+ If NZC = -1, then a workspace query is assumed; the
+ routine calculates the number of columns of the array Z that
+
+ are needed to hold the eigenvectors.
+ This value is returned as the first entry of the Z array, and
+ no error message related to NZC is issued by XERBLA.
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ TRYRAC (input/output) LOGICAL
+ If TRYRAC.EQ..TRUE., indicates that the code should check whe
+ the tridiagonal matrix defines its eigenvalues to high relati
+ accuracy. If so, the code uses relative-accuracy preserving
+
+ algorithms that might be (a bit) slower depending on the matr
+ If the matrix does not define its eigenvalues to high relativ
+ accuracy, the code can uses possibly faster algorithms.
+ If TRYRAC.EQ..FALSE., the code is not required to guarantee
+ relatively accurate eigenvalues and can use the fastest possi
+ techniques.
+ On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix
+ does not define its eigenvalues to high relative accuracy.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in DLARRE,
+ if INFO = 2X, internal error in DLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by DLARRE or
+ DLARRV, respectively.
+
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>nzc</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>tryrac</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsteqr(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsteqr</H3>
+<PRE>
+public abstract void <B>dsteqr</B>(java.lang.String compz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the implicit QL or QR method.
+ The eigenvectors of a full or band symmetric matrix can also be found
+ if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to
+
+ tridiagonal form.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvalues and eigenvectors of the original
+
+ symmetric matrix. On entry, Z must contain the
+ orthogonal matrix used to reduce the original matrix
+
+ to tridiagonal form.
+ = 'I': Compute eigenvalues and eigenvectors of the
+ tridiagonal matrix. Z is initialized to the identity
+ matrix.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
+
+ If COMPZ = 'N', then WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm has failed to find all the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero; on exit, D
+ and E contain the elements of a symmetric tridiagonal
+ matrix which is orthogonally similar to the original
+ matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsterf(int, double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsterf</H3>
+<PRE>
+public abstract void <B>dsterf</B>(int n,
+ double[] d,
+ double[] e,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
+ using the Pal-Walker-Kahan variant of the QL or QR algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix.
+
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed to find all of the eigenvalues in
+
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstev(java.lang.String, int, double[], double[], double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dstev</H3>
+<PRE>
+public abstract void <B>dstev</B>(java.lang.String jobz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
+
+ If JOBZ = 'N', WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstevd(java.lang.String, int, double[], double[], double[], int, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dstevd</H3>
+<PRE>
+public abstract void <B>dstevd</B>(java.lang.String jobz,
+ int n,
+ double[] d,
+ double[] e,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix. If eigenvectors are desired, it
+ uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
+
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstevr(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dstevr</H3>
+<PRE>
+public abstract void <B>dstevr</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Whenever possible, DSTEVR calls DSTEMR to compute the
+ eigenspectrum using Relatively Robust Representations. DSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows. For the i-th
+ unreduced block of T,
+ (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T
+ is a relatively robust representation,
+ (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high
+ relative accuracy by the dqds algorithm,
+ (c) If there is a cluster of close eigenvalues, "choose" sigma_i
+ close to the cluster, and go to step (a),
+ (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T,
+ compute the corresponding eigenvector by forming a
+ rank-revealing twisted factorization.
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon,
+ Computer Science Division Technical Report No. UCB//CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of DSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+ For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
+ DSTEIN are called
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) DOUBLE PRECISION array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ DLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+ Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal (and
+ minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,20*N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal (and
+ minimal) LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dstevx(java.lang.String, java.lang.String, int, double[], double[], double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dstevx</H3>
+<PRE>
+public abstract void <B>dstevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ double[] d,
+ double[] e,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix A. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) DOUBLE PRECISION array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less
+ than or equal to zero, then EPS*|T| will be used in
+ its place, where |T| is the 1-norm of the tridiagonal
+ matrix.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge (INFO > 0), then that
+ column of Z contains the latest approximation to the
+ eigenvector, and the index of the eigenvector is returned
+ in IFAIL. If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsycon(java.lang.String, int, double[], int, int[], double, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsycon</H3>
+<PRE>
+public abstract void <B>dsycon</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double anorm,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by DSYTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyev(java.lang.String, java.lang.String, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsyev</H3>
+<PRE>
+public abstract void <B>dsyev</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] w,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for DSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyevd(java.lang.String, java.lang.String, int, double[], int, double[], double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsyevd</H3>
+<PRE>
+public abstract void <B>dsyevd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] w,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A. If eigenvectors are desired, it uses a
+ divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Because of large use of BLAS of level 3, DSYEVD needs N**2 more
+ workspace than DSYEVX.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i and JOBZ = 'N', then the algorithm failed
+ to converge; i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ if INFO = i and JOBZ = 'V', then the algorithm failed
+ to compute an eigenvalue while working on the submatrix
+ lying in rows and columns INFO/(N+1) through
+ mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ Modified description of INFO. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyevr(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, int[], double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsyevr</H3>
+<PRE>
+public abstract void <B>dsyevr</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ int[] isuppz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ DSYEVR first reduces the matrix A to tridiagonal form T with a call
+ to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute
+ the eigenspectrum using Relatively Robust Representations. DSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see DSTEMR's documentation and:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : DSYEVR calls DSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ DSYEVR calls DSTEBZ and SSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of DSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+ For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
+ DSTEIN are called
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ DLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+ Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,26*N).
+ For optimal efficiency, LWORK >= (NB+6)*N,
+ where NB is the max of the blocksize for DSYTRD and DORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+ Jason Riedy, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><C [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyevx(java.lang.String, java.lang.String, java.lang.String, int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int, int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsyevx</H3>
+<PRE>
+public abstract void <B>dsyevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= 1, when N <= 1;
+ otherwise 8*N.
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the max of the blocksize for DSYTRD and DORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsygs2(int, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsygs2</H3>
+<PRE>
+public abstract void <B>dsygs2</B>(int itype,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGS2 reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U')*A*inv(U) or inv(L)*A*inv(L')
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U` or L'*A*L.
+
+ B must have been previously factorized as U'*U or L*L' by DPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U')*A*inv(U) or inv(L)*A*inv(L');
+ = 2 or 3: compute U*A*U' or L'*A*L.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored, and how B has been factorized.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by DPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsygst(int, java.lang.String, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsygst</H3>
+<PRE>
+public abstract void <B>dsygst</B>(int itype,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by DPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by DPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsygv(int, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsygv</H3>
+<PRE>
+public abstract void <B>dsygv</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] w,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric and B is also
+ positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the symmetric positive definite matrix B.
+ If UPLO = 'U', the leading N-by-N upper triangular part of B
+
+ contains the upper triangular part of the matrix B.
+ If UPLO = 'L', the leading N-by-N lower triangular part of B
+
+ contains the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for DSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPOTRF or DSYEV returned an error code:
+ <= N: if INFO = i, DSYEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsygvd(int, java.lang.String, java.lang.String, int, double[], int, double[], int, double[], double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsygvd</H3>
+<PRE>
+public abstract void <B>dsygvd</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] w,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric and B is also positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK >= 1.
+ If JOBZ = 'N' and N > 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPOTRF or DSYEVD returned an error code:
+ <= N: if INFO = i and JOBZ = 'N', then the algorithm
+ failed to converge; i off-diagonal elements of an
+ intermediate tridiagonal form did not converge to
+ zero;
+ if INFO = i and JOBZ = 'V', then the algorithm
+ failed to compute an eigenvalue while working on
+ the submatrix lying in rows and columns INFO/(N+1)
+
+ through mod(INFO,N+1);
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ Modified so that no backsubstitution is performed if DSYEVD fails to
+
+ converge (NEIG in old code could be greater than N causing out of
+ bounds reference to A - reported by Ralf Meyer). Also corrected the
+
+ description of INFO and the test on ITYPE. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsygvx(int, java.lang.String, java.lang.String, java.lang.String, int, double[], int, double[], int, double, double, int, int, double, org.netlib.util.intW, double[], double[], int, double[], int, int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsygvx</H3>
+<PRE>
+public abstract void <B>dsygvx</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double vl,
+ double vu,
+ int il,
+ int iu,
+ double abstol,
+ org.netlib.util.intW m,
+ double[] w,
+ double[] z,
+ int ldz,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric and B is also positive definite.
+ Eigenvalues and eigenvectors can be selected by specifying either a
+ range of values or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,8*N).
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the blocksize for DSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPOTRF or DSYEVX returned an error code:
+ <= N: if INFO = i, DSYEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwor [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsyrfs(java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsyrfs</H3>
+<PRE>
+public abstract void <B>dsyrfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite, and
+ provides error bounds and backward error estimates for the solution.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
+ The factored form of the matrix A. AF contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by DSYTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DSYTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsysv(java.lang.String, int, int, double[], int, int[], double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsysv</H3>
+<PRE>
+public abstract void <B>dsysv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
+ used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the block diagonal matrix D and the
+ multipliers used to obtain the factor U or L from the
+ factorization A = U*D*U**T or A = L*D*L**T as computed by
+ DSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by DSYTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= 1, and for best performance
+ LWORK >= max(1,N*NB), where NB is the optimal blocksize for
+ DSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsysvx(java.lang.String, java.lang.String, int, int, double[], int, double[], int, int[], double[], int, double[], int, org.netlib.util.doubleW, double[], double[], double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsysvx</H3>
+<PRE>
+public abstract void <B>dsysvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] af,
+ int ldaf,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ org.netlib.util.doubleW rcond,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYSVX uses the diagonal pivoting factorization to compute the
+ solution to a real system of linear equations A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A.
+ The form of the factorization is
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AF and IPIV contain the factored form of
+ A. AF and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
+
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSYTRF.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the block diagonal matrix D and the multipliers used
+
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSYTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSYTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= max(1,3*N), and for best
+ performance, when FACT = 'N', LWORK >= max(1,3*N,N*NB), where
+ NB is the optimal blocksize for DSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsytd2(java.lang.String, int, double[], int, double[], double[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsytd2</H3>
+<PRE>
+public abstract void <B>dsytd2</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
+ form T by an orthogonal similarity transformation: Q' * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsytf2(java.lang.String, int, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dsytf2</H3>
+<PRE>
+public abstract void <B>dsytf2</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTF2 computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U' or A = L*D*L'
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, U' is the transpose of U, and D is symmetric and
+ block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 09-29-06 - patch from
+ Bobby Cheng, MathWorks
+
+ Replace l.204 and l.372
+ IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+ by
+ IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
+
+ 01-01-96 - Based on modifications by
+ J. Lewis, Boeing Computer Services Company
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ 1-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsytrd(java.lang.String, int, double[], int, double[], double[], double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsytrd</H3>
+<PRE>
+public abstract void <B>dsytrd</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ double[] d,
+ double[] e,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRD reduces a real symmetric matrix A to real symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsytrf(java.lang.String, int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsytrf</H3>
+<PRE>
+public abstract void <B>dsytrf</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRF computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method. The form of the
+ factorization is
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >=1. For best performance
+ LWORK >= N*NB, where NB is the block size returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, and division by zero will occur if it
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsytri(java.lang.String, int, double[], int, int[], double[], org.netlib.util.intW)"><!-- --></A><H3>
+dsytri</H3>
+<PRE>
+public abstract void <B>dsytri</B>(java.lang.String uplo,
+ int n,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRI computes the inverse of a real symmetric indefinite matrix
+ A using the factorization A = U*D*U**T or A = L*D*L**T computed by
+ DSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by DSYTRF.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix. If UPLO = 'U', the upper triangular part of the
+ inverse is formed and the part of A below the diagonal is not
+ referenced; if UPLO = 'L' the lower triangular part of the
+ inverse is formed and the part of A above the diagonal is
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsytrs(java.lang.String, int, int, double[], int, int[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dsytrs</H3>
+<PRE>
+public abstract void <B>dsytrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ int[] ipiv,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by DSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtbcon(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtbcon</H3>
+<PRE>
+public abstract void <B>dtbcon</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int kd,
+ double[] ab,
+ int ldab,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBCON estimates the reciprocal of the condition number of a
+ triangular band matrix A, in either the 1-norm or the infinity-norm.
+
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtbrfs(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtbrfs</H3>
+<PRE>
+public abstract void <B>dtbrfs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular band
+ coefficient matrix.
+
+ The solution matrix X must be computed by DTBTRS or some other
+ means before entering this routine. DTBRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtbtrs(java.lang.String, java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtbtrs</H3>
+<PRE>
+public abstract void <B>dtbtrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ double[] ab,
+ int ldab,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular band matrix of order N, and B is an
+ N-by NRHS matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgevc(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], int, int, org.netlib.util.intW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dtgevc</H3>
+<PRE>
+public abstract void <B>dtgevc</B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] s,
+ int lds,
+ double[] p,
+ int ldp,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ DTGEVC computes some or all of the right and/or left eigenvectors of
+
+ a pair of real matrices (S,P), where S is a quasi-triangular matrix
+ and P is upper triangular. Matrix pairs of this type are produced by
+ the generalized Schur factorization of a matrix pair (A,B):
+
+ A = Q*S*Z**T, B = Q*P*Z**T
+
+ as computed by DGGHRD + DHGEQZ.
+
+ The right eigenvector x and the left eigenvector y of (S,P)
+ corresponding to an eigenvalue w are defined by:
+
+ S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+
+ where y**H denotes the conjugate tranpose of y.
+ The eigenvalues are not input to this routine, but are computed
+ directly from the diagonal blocks of S and P.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+ where Z and Q are input matrices.
+ If Q and Z are the orthogonal factors from the generalized Schur
+ factorization of a matrix pair (A,B), then Z*X and Q*Y
+ are the matrices of right and left eigenvectors of (A,B).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ specified by the logical array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY='S', SELECT specifies the eigenvectors to be
+ computed. If w(j) is a real eigenvalue, the corresponding
+ real eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector
+ is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+ and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+ set to .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrices S and P. N >= 0.
+
+ S (input) DOUBLE PRECISION array, dimension (LDS,N)
+ The upper quasi-triangular matrix S from a generalized Schur
+
+ factorization, as computed by DHGEQZ.
+
+ LDS (input) INTEGER
+ The leading dimension of array S. LDS >= max(1,N).
+
+ P (input) DOUBLE PRECISION array, dimension (LDP,N)
+ The upper triangular matrix P from a generalized Schur
+ factorization, as computed by DHGEQZ.
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+ of S must be in positive diagonal form.
+
+ LDP (input) INTEGER
+ The leading dimension of array P. LDP >= max(1,N).
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of left Schur vectors returned by DHGEQZ).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
+
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
+
+ SELECT, stored consecutively in the columns of
+ VL, in the same order as their eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Z (usually the orthogonal matrix Z
+ of right Schur vectors returned by DHGEQZ).
+
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+ if HOWMNY = 'B' or 'b', the matrix Z*X;
+ if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+ specified by SELECT, stored consecutively in the
+
+ columns of VR, in the same order as their
+ eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
+ is set to N. Each selected real eigenvector occupies one
+ column and each selected complex eigenvector occupies two
+ columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (6*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the 2-by-2 block (INFO:INFO+1) does not have a complex
+
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Allocation of workspace:
+ ---------- -- ---------
+
+ WORK( j ) = 1-norm of j-th column of A, above the diagonal
+ WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
+ WORK( 2*N+1:3*N ) = real part of eigenvector
+ WORK( 3*N+1:4*N ) = imaginary part of eigenvector
+ WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
+ WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
+
+ Rowwise vs. columnwise solution methods:
+ ------- -- ---------- -------- -------
+
+ Finding a generalized eigenvector consists basically of solving the
+ singular triangular system
+
+ (A - w B) x = 0 (for right) or: (A - w B)**H y = 0 (for left)
+
+ Consider finding the i-th right eigenvector (assume all eigenvalues
+ are real). The equation to be solved is:
+ n i
+ 0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. . .,1
+ k=j k=j
+
+ where C = (A - w B) (The components v(i+1:n) are 0.)
+
+ The "rowwise" method is:
+
+ (1) v(i) := 1
+ for j = i-1,. . .,1:
+ i
+ (2) compute s = - sum C(j,k) v(k) and
+ k=j+1
+
+ (3) v(j) := s / C(j,j)
+
+ Step 2 is sometimes called the "dot product" step, since it is an
+ inner product between the j-th row and the portion of the eigenvector
+ that has been computed so far.
+
+ The "columnwise" method consists basically in doing the sums
+ for all the rows in parallel. As each v(j) is computed, the
+ contribution of v(j) times the j-th column of C is added to the
+ partial sums. Since FORTRAN arrays are stored columnwise, this has
+ the advantage that at each step, the elements of C that are accessed
+
+ are adjacent to one another, whereas with the rowwise method, the
+ elements accessed at a step are spaced LDS (and LDP) words apart.
+
+ When finding left eigenvectors, the matrix in question is the
+ transpose of the one in storage, so the rowwise method then
+ actually accesses columns of A and B at each step, and so is the
+ preferred method.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>s</CODE> - <DD><CODE>lds</CODE> - <DD><CODE>p</CODE> - <DD><CODE>ldp</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgex2(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, int, int, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtgex2</H3>
+<PRE>
+public abstract void <B>dtgex2</B>(boolean wantq,
+ boolean wantz,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ int j1,
+ int n1,
+ int n2,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
+ of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
+ (A, B) by an orthogonal equivalence transformation.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION arrays, dimensions (LDA,N)
+ On entry, the matrix A in the pair (A, B).
+ On exit, the updated matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION arrays, dimensions (LDB,N)
+ On entry, the matrix B in the pair (A, B).
+ On exit, the updated matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ Not referenced if WANTQ = .FALSE..
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ Not referenced if WANTZ = .FALSE..
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ J1 (input) INTEGER
+ The index to the first block (A11, B11). 1 <= J1 <= N.
+
+ N1 (input) INTEGER
+ The order of the first block (A11, B11). N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block (A22, B22). N2 = 0, 1 or 2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX( 1, N*(N2+N1), (N2+N1)*(N2+N1)*2 )
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ >0: If INFO = 1, the transformed matrix (A, B) would be
+ too far from generalized Schur form; the blocks are
+ not swapped and (A, B) and (Q, Z) are unchanged.
+ The problem of swapping is too ill-conditioned.
+ <0: If INFO = -16: LWORK is too small. Appropriate value
+ for LWORK is returned in WORK(1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ In the current code both weak and strong stability tests are
+ performed. The user can omit the strong stability test by changing
+ the internal logical parameter WANDS to .FALSE.. See ref. [2] for
+ details.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ =====================================================================
+ Replaced various illegal calls to DCOPY by calls to DLASET, or by DO
+
+ loops. Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantq</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>j1</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgexc(boolean, boolean, int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtgexc</H3>
+<PRE>
+public abstract void <B>dtgexc</B>(boolean wantq,
+ boolean wantz,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGEXC reorders the generalized real Schur decomposition of a real
+ matrix pair (A,B) using an orthogonal equivalence transformation
+
+ (A, B) = Q * (A, B) * Z',
+
+ so that the diagonal block of (A, B) with row index IFST is moved
+ to row ILST.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the matrix A in generalized real Schur canonical
+ form.
+ On exit, the updated matrix A, again in generalized
+ real Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the matrix B in generalized real Schur canonical
+ form (A,B).
+ On exit, the updated matrix B, again in generalized
+ real Schur canonical form (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of (A, B).
+ The block with row index IFST is moved to row ILST, by a
+ sequence of swapping between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of
+ a 2-by-2 block, it is changed to point to the first row;
+ ILST always points to the first row of the block in its
+ final position (which may differ from its input value by
+ +1 or -1). 1 <= IFST, ILST <= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: successful exit.
+ <0: if INFO = -i, the i-th argument had an illegal value.
+ =1: The transformed matrix pair (A, B) would be too far
+ from generalized Schur form; the problem is ill-
+ conditioned. (A, B) may have been partially reordered,
+
+ and ILST points to the first row of the current
+ position of the block being moved.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantq</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>ifst</CODE> - <DD><CODE>ilst</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgsen(int, boolean, boolean, boolean[], int, double[], int, double[], int, double[], double[], double[], double[], int, double[], int, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtgsen</H3>
+<PRE>
+public abstract void <B>dtgsen</B>(int ijob,
+ boolean wantq,
+ boolean wantz,
+ boolean[] select,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] alphar,
+ double[] alphai,
+ double[] beta,
+ double[] q,
+ int ldq,
+ double[] z,
+ int ldz,
+ org.netlib.util.intW m,
+ org.netlib.util.doubleW pl,
+ org.netlib.util.doubleW pr,
+ double[] dif,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSEN reorders the generalized real Schur decomposition of a real
+ matrix pair (A, B) (in terms of an orthonormal equivalence trans-
+ formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
+ appears in the leading diagonal blocks of the upper quasi-triangular
+
+ matrix A and the upper triangular B. The leading columns of Q and
+ Z form orthonormal bases of the corresponding left and right eigen-
+ spaces (deflating subspaces). (A, B) must be in generalized real
+ Schur canonical form (as returned by DGGES), i.e. A is block upper
+ triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
+ triangular.
+
+ DTGSEN also computes the generalized eigenvalues
+
+ w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
+
+ of the reordered matrix pair (A, B).
+
+ Optionally, DTGSEN computes the estimates of reciprocal condition
+ numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
+ (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
+ between the matrix pairs (A11, B11) and (A22,B22) that correspond to
+
+ the selected cluster and the eigenvalues outside the cluster, resp.,
+
+ and norms of "projections" onto left and right eigenspaces w.r.t.
+ the selected cluster in the (1,1)-block.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (PL and PR) or the deflating subspaces
+ (Difu and Difl):
+ =0: Only reorder w.r.t. SELECT. No extras.
+ =1: Reciprocal of norms of "projections" onto left and right
+ eigenspaces w.r.t. the selected cluster (PL and PR).
+ =2: Upper bounds on Difu and Difl. F-norm-based estimate
+ (DIF(1:2)).
+ =3: Estimate of Difu and Difl. 1-norm-based estimate
+ (DIF(1:2)).
+ About 5 times as expensive as IJOB = 2.
+ =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
+ version to get it all.
+ =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster.
+ To select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension(LDA,N)
+ On entry, the upper quasi-triangular matrix A, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, A is overwritten by the reordered matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension(LDB,N)
+ On entry, the upper triangular matrix B, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, B is overwritten by the reordered matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real generalized Schur form of (A,B) were further reduced
+ to triangular form using complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
+ On exit, Q has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Q form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1;
+ and if WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
+ On exit, Z has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Z form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1;
+ If WANTZ = .TRUE., LDZ >= N.
+
+ M (output) INTEGER
+ The dimension of the specified pair of left and right eigen-
+
+ spaces (deflating subspaces). 0 <= M <= N.
+
+ PL (output) DOUBLE PRECISION
+ PR (output) DOUBLE PRECISION
+ If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
+ reciprocal of the norm of "projections" onto left and right
+ eigenspaces with respect to the selected cluster.
+ 0 < PL, PR <= 1.
+ If M = 0 or M = N, PL = PR = 1.
+ If IJOB = 0, 2 or 3, PL and PR are not referenced.
+
+ DIF (output) DOUBLE PRECISION array, dimension (2).
+ If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
+
+ If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
+ Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
+ estimates of Difu and Difl.
+ If M = 0 or N, DIF(1:2) = F-norm([A, B]).
+ If IJOB = 0 or 1, DIF is not referenced.
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 4*N+16.
+ If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
+ If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ IF IJOB = 0, IWORK is not referenced. Otherwise,
+ on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= 1.
+ If IJOB = 1, 2 or 4, LIWORK >= N+6.
+ If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: Successful exit.
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ =1: Reordering of (A, B) failed because the transformed
+ matrix pair (A, B) would be too far from generalized
+ Schur form; the problem is very ill-conditioned.
+ (A, B) may have been partially reordered.
+ If requested, 0 is returned in DIF(*), PL and PR.
+
+ Further Details
+ ===============
+
+ DTGSEN first collects the selected eigenvalues by computing
+ orthogonal U and W that move them to the top left corner of (A, B).
+ In other words, the selected eigenvalues are the eigenvalues of
+ (A11, B11) in:
+
+ U'*(A, B)*W = (A11 A12) (B11 B12) n1
+ ( 0 A22),( 0 B22) n2
+ n1 n2 n1 n2
+
+ where N = n1+n2 and U' means the transpose of U. The first n1 columns
+ of U and W span the specified pair of left and right eigenspaces
+ (deflating subspaces) of (A, B).
+
+ If (A, B) has been obtained from the generalized real Schur
+ decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
+ reordered generalized real Schur form of (C, D) is given by
+
+ (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
+
+ and the first n1 columns of Q*U and Z*W span the corresponding
+ deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
+
+ Note that if the selected eigenvalue is sufficiently ill-conditioned,
+ then its value may differ significantly from its value before
+ reordering.
+
+ The reciprocal condition numbers of the left and right eigenspaces
+ spanned by the first n1 columns of U and W (or Q*U and Z*W) may
+ be returned in DIF(1:2), corresponding to Difu and Difl, resp.
+
+ The Difu and Difl are defined as:
+
+ Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
+ and
+ Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
+
+ where sigma-min(Zu) is the smallest singular value of the
+ (2*n1*n2)-by-(2*n1*n2) matrix
+
+ Zu = [ kron(In2, A11) -kron(A22', In1) ]
+ [ kron(In2, B11) -kron(B22', In1) ].
+
+ Here, Inx is the identity matrix of size nx and A22' is the
+ transpose of A22. kron(X, Y) is the Kronecker product between
+ the matrices X and Y.
+
+ When DIF(2) is small, small changes in (A, B) can cause large changes
+ in the deflating subspace. An approximate (asymptotic) bound on the
+ maximum angular error in the computed deflating subspaces is
+
+ EPS * norm((A, B)) / DIF(2),
+
+ where EPS is the machine precision.
+
+ The reciprocal norm of the projectors on the left and right
+ eigenspaces associated with (A11, B11) may be returned in PL and PR.
+
+ They are computed as follows. First we compute L and R so that
+ P*(A, B)*Q is block diagonal, where
+
+ P = ( I -L ) n1 Q = ( I R ) n1
+ ( 0 I ) n2 and ( 0 I ) n2
+ n1 n2 n1 n2
+
+ and (L, R) is the solution to the generalized Sylvester equation
+
+ A11*R - L*A22 = -A12
+ B11*R - L*B22 = -B12
+
+ Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / PL.
+
+ There are also global error bounds which valid for perturbations up
+ to a certain restriction: A lower bound (x) on the smallest
+ F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
+ coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
+ (i.e. (A + E, B + F), is
+
+ x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
+
+
+ An approximate bound on x can be computed from DIF(1:2), PL and PR.
+
+ If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
+ (L', R') and unperturbed (L, R) left and right deflating subspaces
+ associated with the selected cluster in the (1,1)-blocks can be
+ bounded as
+
+ max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
+
+ max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
+
+
+ See LAPACK User's Guide section 4.11 or the following references
+ for more information.
+
+ Note that if the default method for computing the Frobenius-norm-
+ based estimate DIF is not wanted (see DLATDF), then the parameter
+ IDIFJB (see below) should be changed from 3 to 4 (routine DLATDF
+ (IJOB = 2 will be used)). See DTGSYL for more details.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
+ 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ijob</CODE> - <DD><CODE>wantq</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>m</CODE> - <DD><CODE>pl</CODE> - <DD><CODE>pr</CODE> - <DD><CODE>dif</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgsja(java.lang.String, java.lang.String, java.lang.String, int, int, int, int, int, double[], int, double[], int, double, double, double[], double[], double[], int, double[], int, double[], int, double[], org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+dtgsja</H3>
+<PRE>
+public abstract void <B>dtgsja</B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ int k,
+ int l,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double tola,
+ double tolb,
+ double[] alpha,
+ double[] beta,
+ double[] u,
+ int ldu,
+ double[] v,
+ int ldv,
+ double[] q,
+ int ldq,
+ double[] work,
+ org.netlib.util.intW ncycle,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSJA computes the generalized singular value decomposition (GSVD)
+ of two real upper triangular (or trapezoidal) matrices A and B.
+
+ On entry, it is assumed that matrices A and B have the following
+ forms, which may be obtained by the preprocessing subroutine DGGSVP
+ from a general M-by-N matrix A and P-by-N matrix B:
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ B = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal.
+
+ On exit,
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ),
+
+ where U, V and Q are orthogonal matrices, Z' denotes the transpose
+ of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are
+ ``diagonal'' matrices, which are of the following structures:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 ) K
+ L ( 0 0 R22 ) L
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
+
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The computation of the orthogonal transformation matrices U, V or Q
+ is optional. These matrices may either be formed explicitly, or they
+ may be postmultiplied into input matrices U1, V1, or Q1.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': U must contain an orthogonal matrix U1 on entry, and
+
+ the product U1*U is returned;
+ = 'I': U is initialized to the unit matrix, and the
+ orthogonal matrix U is returned;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': V must contain an orthogonal matrix V1 on entry, and
+
+ the product V1*V is returned;
+ = 'I': V is initialized to the unit matrix, and the
+ orthogonal matrix V is returned;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
+
+ the product Q1*Q is returned;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ K (input) INTEGER
+ L (input) INTEGER
+ K and L specify the subblocks in the input matrices A and B:
+
+ A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
+ of A and B, whose GSVD is going to be computed by DTGSJA.
+ See Further details.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
+ matrix R or part of R. See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
+ a part of R. See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) DOUBLE PRECISION
+ TOLB (input) DOUBLE PRECISION
+ TOLA and TOLB are the convergence criteria for the Jacobi-
+ Kogbetliantz iteration procedure. Generally, they are the
+ same as used in the preprocessing step, say
+ TOLA = max(M,N)*norm(A)*MAZHEPS,
+ TOLB = max(P,N)*norm(B)*MAZHEPS.
+
+ ALPHA (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = diag(C),
+ BETA(K+1:K+L) = diag(S),
+ or if M-K-L < 0,
+ ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
+ BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
+ Furthermore, if K+L < N,
+ ALPHA(K+L+1:N) = 0 and
+ BETA(K+L+1:N) = 0.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU,M)
+ On entry, if JOBU = 'U', U must contain a matrix U1 (usually
+
+ the orthogonal matrix returned by DGGSVP).
+ On exit,
+ if JOBU = 'I', U contains the orthogonal matrix U;
+ if JOBU = 'U', U contains the product U1*U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,P)
+ On entry, if JOBV = 'V', V must contain a matrix V1 (usually
+
+ the orthogonal matrix returned by DGGSVP).
+ On exit,
+ if JOBV = 'I', V contains the orthogonal matrix V;
+ if JOBV = 'V', V contains the product V1*V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
+
+ the orthogonal matrix returned by DGGSVP).
+ On exit,
+ if JOBQ = 'I', Q contains the orthogonal matrix Q;
+ if JOBQ = 'Q', Q contains the product Q1*Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ NCYCLE (output) INTEGER
+ The number of cycles required for convergence.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the procedure does not converge after MAXIT cycles.
+
+ Internal Parameters
+ ===================
+
+ MAXIT INTEGER
+ MAXIT specifies the total loops that the iterative procedure
+
+ may take. If after MAXIT cycles, the routine fails to
+ converge, we return INFO = 1.
+
+ Further Details
+ ===============
+
+ DTGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
+ min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
+ matrix B13 to the form:
+
+ U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1,
+
+ where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose
+ of Z. C1 and S1 are diagonal matrices satisfying
+
+ C1**2 + S1**2 = I,
+
+ and R1 is an L-by-L nonsingular upper triangular matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobv</CODE> - <DD><CODE>jobq</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>tola</CODE> - <DD><CODE>tolb</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>q</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgsna(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtgsna</H3>
+<PRE>
+public abstract void <B>dtgsna</B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] s,
+ double[] dif,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or eigenvectors of a matrix pair (A, B) in
+ generalized real Schur canonical form (or of any matrix pair
+ (Q*A*Z', Q*B*Z') with orthogonal matrices Q and Z, where
+ Z' denotes the transpose of Z.
+
+ (A, B) must be in generalized real Schur form (as returned by DGGES),
+ i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal
+ blocks. B is upper triangular.
+
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (DIF):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (DIF);
+ = 'B': for both eigenvalues and eigenvectors (S and DIF).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the square matrix pair (A, B). N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The upper quasi-triangular matrix A in the pair (A,B).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The upper triangular matrix B in the pair (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) DOUBLE PRECISION array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns of VL, as returned by DTGEVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1.
+ If JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) DOUBLE PRECISION array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns ov VR, as returned by DTGEVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1.
+ If JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), DIF(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ DIF (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of DIF are set to the same value. If
+ the eigenvalues cannot be reordered to compute DIF(j), DIF(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', DIF is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S and DIF. MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and DIF used to store
+
+ the specified condition numbers; for each selected real
+ eigenvalue one element is used, and for each selected complex
+ conjugate pair of eigenvalues, two elements are used.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N + 6)
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value
+
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of a generalized eigenvalue
+ w = (a, b) is defined as
+
+ S(w) = (|u'Av|**2 + |u'Bv|**2)**(1/2) / (norm(u)*norm(v))
+
+ where u and v are the left and right eigenvectors of (A, B)
+ corresponding to w; |z| denotes the absolute value of the complex
+ number, and norm(u) denotes the 2-norm of the vector u.
+ The pair (a, b) corresponds to an eigenvalue w = a/b (= u'Av/u'Bv)
+ of the matrix pair (A, B). If both a and b equal zero, then (A B) is
+
+ singular and S(I) = -1 is returned.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(A, B) / S(I)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number DIF(i) of right eigenvector u
+
+ and left eigenvector v corresponding to the generalized eigenvalue w
+
+ is defined as follows:
+
+ a) If the i-th eigenvalue w = (a,b) is real
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( a * ) ( b * ) 1
+ ( 0 S22 ),( 0 T22 ) n-1
+ 1 n-1 1 n-1
+
+ Then the reciprocal condition number DIF(i) is
+
+ Difl((a, b), (S22, T22)) = sigma-min( Zl ),
+
+ where sigma-min(Zl) denotes the smallest singular value of the
+ 2(n-1)-by-2(n-1) matrix
+
+ Zl = [ kron(a, In-1) -kron(1, S22) ]
+ [ kron(b, In-1) -kron(1, T22) ] .
+
+ Here In-1 is the identity matrix of size n-1. kron(X, Y) is the
+ Kronecker product between the matrices X and Y.
+
+ Note that if the default method for computing DIF(i) is wanted
+ (see DLATDF), then the parameter DIFDRI (see below) should be
+ changed from 3 to 4 (routine DLATDF(IJOB = 2 will be used)).
+ See DTGSYL for more details.
+
+ b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair,
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2
+ ( 0 S22 ),( 0 T22) n-2
+ 2 n-2 2 n-2
+
+ and (S11, T11) corresponds to the complex conjugate eigenvalue
+ pair (w, conjg(w)). There exist unitary matrices U1 and V1 such
+ that
+
+ U1'*S11*V1 = ( s11 s12 ) and U1'*T11*V1 = ( t11 t12 )
+ ( 0 s22 ) ( 0 t22 )
+
+ where the generalized eigenvalues w = s11/t11 and
+ conjg(w) = s22/t22.
+
+ Then the reciprocal condition number DIF(i) is bounded by
+
+ min( d1, max( 1, |real(s11)/real(s22)| )*d2 )
+
+ where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where
+ Z1 is the complex 2-by-2 matrix
+
+ Z1 = [ s11 -s22 ]
+ [ t11 -t22 ],
+
+ This is done by computing (using real arithmetic) the
+ roots of the characteristical polynomial det(Z1' * Z1 - lambda I),
+ where Z1' denotes the conjugate transpose of Z1 and det(X) denotes
+ the determinant of X.
+
+ and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an
+
+ upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2)
+
+ Z2 = [ kron(S11', In-2) -kron(I2, S22) ]
+ [ kron(T11', In-2) -kron(I2, T22) ]
+
+ Note that if the default method for computing DIF is wanted (see
+ DLATDF), then the parameter DIFDRI (see below) should be changed
+ from 3 to 4 (routine DLATDF(IJOB = 2 will be used)). See DTGSYL
+ for more details.
+
+ For each eigenvalue/vector specified by SELECT, DIF stores a
+ Frobenius norm-based estimate of Difl.
+
+ An approximate error bound for the i-th computed eigenvector VL(i) or
+ VR(i) is given by
+
+ EPS * norm(A, B) / DIF(i).
+
+ See ref. [2-3] for more details and further references.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>s</CODE> - <DD><CODE>dif</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgsy2(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, org.netlib.util.doubleW, int[], org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+dtgsy2</H3>
+<PRE>
+public abstract void <B>dtgsy2</B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ int Ldc,
+ double[] d,
+ int ldd,
+ double[] e,
+ int lde,
+ double[] f,
+ int ldf,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW rdsum,
+ org.netlib.util.doubleW rdscal,
+ int[] iwork,
+ org.netlib.util.intW pq,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSY2 solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F,
+
+ using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
+
+ (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
+ N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
+ must be in generalized Schur canonical form, i.e. A, B are upper
+ quasi triangular and D, E are upper triangular. The solution (R, L)
+ overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
+ chosen to avoid overflow.
+
+ In matrix notation solving equation (1) corresponds to solve
+ Z*x = scale*b, where Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ],
+
+ Ik is the identity matrix of size k and X' is the transpose of X.
+ kron(X, Y) is the Kronecker product between the matrices X and Y.
+ In the process of solving (1), we solve a number of such systems
+ where Dim(In), Dim(In) = 1 or 2.
+
+ If TRANS = 'T', solve the transposed system Z'*y = scale*b for y,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * -F
+
+ This case is used to compute an estimate of Dif[(A, D), (B, E)] =
+ sigma_min(Z) using reverse communicaton with DLACON.
+
+ DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL
+ of an upper bound on the separation between to matrix pairs. Then
+ the input (A, D), (B, E) are sub-pencils of the matrix pair in
+ DTGSYL. See DTGSYL for details.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T': solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ = 0: solve (1) only.
+ = 1: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (look ahead strategy is used).
+ = 2: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (DGECON on sub-systems is used.)
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ On entry, M specifies the order of A and D, and the row
+ dimension of C, F, R and L.
+
+ N (input) INTEGER
+ On entry, N specifies the order of B and E, and the column
+ dimension of C, F, R and L.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, M)
+ On entry, A contains an upper quasi triangular matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the matrix A. LDA >= max(1, M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, B contains an upper quasi triangular matrix.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1, N).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1).
+ On exit, if IJOB = 0, C has been overwritten by the
+ solution R.
+
+ LDC (input) INTEGER
+ The leading dimension of the matrix C. LDC >= max(1, M).
+
+ D (input) DOUBLE PRECISION array, dimension (LDD, M)
+ On entry, D contains an upper triangular matrix.
+
+ LDD (input) INTEGER
+ The leading dimension of the matrix D. LDD >= max(1, M).
+
+ E (input) DOUBLE PRECISION array, dimension (LDE, N)
+ On entry, E contains an upper triangular matrix.
+
+ LDE (input) INTEGER
+ The leading dimension of the matrix E. LDE >= max(1, N).
+
+ F (input/output) DOUBLE PRECISION array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1).
+ On exit, if IJOB = 0, F has been overwritten by the
+ solution L.
+
+ LDF (input) INTEGER
+ The leading dimension of the matrix F. LDF >= max(1, M).
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
+ R and L (C and F on entry) will hold the solutions to a
+ slightly perturbed system but the input matrices A, B, D and
+
+ E have not been changed. If SCALE = 0, R and L will hold the
+
+ solutions to the homogeneous system with C = F = 0. Normally,
+ SCALE = 1.
+
+ RDSUM (input/output) DOUBLE PRECISION
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by DTGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when DTGSY2 is called by DTGSYL.
+
+ RDSCAL (input/output) DOUBLE PRECISION
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when DTGSY2 is called by
+ DTGSYL.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+2)
+
+ PQ (output) INTEGER
+ On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
+ 8-by-8) solved by this routine.
+
+ INFO (output) INTEGER
+ On exit, if INFO is set to
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: The matrix pairs (A, D) and (B, E) have common or very
+
+ close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+ Replaced various illegal calls to DCOPY by calls to DLASET.
+ Sven Hammarling, 27/5/02.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>ijob</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>ldd</CODE> - <DD><CODE>e</CODE> - <DD><CODE>lde</CODE> - <DD><CODE>f</CODE> - <DD><CODE>ldf</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>rdsum</CODE> - <DD><CODE>rdscal</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>pq</ [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtgsyl(java.lang.String, int, int, int, double[], int, double[], int, double[], int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtgsyl</H3>
+<PRE>
+public abstract void <B>dtgsyl</B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ int Ldc,
+ double[] d,
+ int ldd,
+ double[] e,
+ int lde,
+ double[] f,
+ int ldf,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.doubleW dif,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSYL solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F
+
+ where R and L are unknown m-by-n matrices, (A, D), (B, E) and
+ (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
+ respectively, with real entries. (A, D) and (B, E) must be in
+ generalized (real) Schur canonical form, i.e. A, B are upper quasi
+ triangular and D, E are upper triangular.
+
+ The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
+ scaling factor chosen to avoid overflow.
+
+ In matrix notation (1) is equivalent to solve Zx = scale b, where
+ Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ].
+
+ Here Ik is the identity matrix of size k and X' is the transpose of
+ X. kron(X, Y) is the Kronecker product between the matrices X and Y.
+
+
+ If TRANS = 'T', DTGSYL solves the transposed system Z'*y = scale*b,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * (-F)
+
+ This case (TRANS = 'T') is used to compute an one-norm-based estimate
+ of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
+ and (B,E), using DLACON.
+
+ If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate
+ of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
+
+ reciprocal of the smallest singular value of Z. See [1-2] for more
+ information.
+
+ This is a level 3 BLAS algorithm.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T', solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ =0: solve (1) only.
+ =1: The functionality of 0 and 3.
+ =2: The functionality of 0 and 4.
+ =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ (look ahead strategy IJOB = 1 is used).
+ =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ ( DGECON on sub-systems is used ).
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ The order of the matrices A and D, and the row dimension of
+ the matrices C, F, R and L.
+
+ N (input) INTEGER
+ The order of the matrices B and E, and the column dimension
+ of the matrices C, F, R and L.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, M)
+ The upper quasi triangular matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, N)
+ The upper quasi triangular matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1, N).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, C has been overwritten by
+ the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1, M).
+
+ D (input) DOUBLE PRECISION array, dimension (LDD, M)
+ The upper triangular matrix D.
+
+ LDD (input) INTEGER
+ The leading dimension of the array D. LDD >= max(1, M).
+
+ E (input) DOUBLE PRECISION array, dimension (LDE, N)
+ The upper triangular matrix E.
+
+ LDE (input) INTEGER
+ The leading dimension of the array E. LDE >= max(1, N).
+
+ F (input/output) DOUBLE PRECISION array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, F has been overwritten by
+ the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1, M).
+
+ DIF (output) DOUBLE PRECISION
+ On exit DIF is the reciprocal of a lower bound of the
+ reciprocal of the Dif-function, i.e. DIF is an upper bound of
+ Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
+ IF IJOB = 0 or TRANS = 'T', DIF is not touched.
+
+ SCALE (output) DOUBLE PRECISION
+ On exit SCALE is the scaling factor in (1) or (3).
+ If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
+
+ to a slightly perturbed system but the input matrices A, B, D
+ and E have not been changed. If SCALE = 0, C and F hold the
+ solutions R and L, respectively, to the homogeneous system
+ with C = F = 0. Normally, SCALE = 1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK > = 1.
+ If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+6)
+
+ INFO (output) INTEGER
+ =0: successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: (A, D) and (B, E) have common or close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
+ Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
+ Appl., 15(4):1045-1060, 1994
+
+ [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
+ Condition Estimators for Solving the Generalized Sylvester
+ Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
+ July 1989, pp 745-751.
+
+ =====================================================================
+ Replaced various illegal calls to DCOPY by calls to DLASET.
+ Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>ijob</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>ldd</CODE> - <DD><CODE>e</CODE> - <DD><CODE>lde</CODE> - <DD><CODE>f</CODE> - <DD><CODE>ldf</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>dif</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</C [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtpcon(java.lang.String, java.lang.String, java.lang.String, int, double[], org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtpcon</H3>
+<PRE>
+public abstract void <B>dtpcon</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPCON estimates the reciprocal of the condition number of a packed
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtprfs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtprfs</H3>
+<PRE>
+public abstract void <B>dtprfs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular packed
+ coefficient matrix.
+
+ The solution matrix X must be computed by DTPTRS or some other
+ means before entering this routine. DTPRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtptri(java.lang.String, java.lang.String, int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dtptri</H3>
+<PRE>
+public abstract void <B>dtptri</B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] ap,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPTRI computes the inverse of a real upper or lower triangular
+ matrix A stored in packed format.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangular matrix A, stored
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*((2*n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same packed storage format.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+ Further Details
+ ===============
+
+ A triangular matrix A can be transferred to packed storage using one
+
+ of the following program segments:
+
+ UPLO = 'U': UPLO = 'L':
+
+ JC = 1 JC = 1
+ DO 2 J = 1, N DO 2 J = 1, N
+ DO 1 I = 1, J DO 1 I = J, N
+ AP(JC+I-1) = A(I,J) AP(JC+I-J) = A(I,J)
+ 1 CONTINUE 1 CONTINUE
+ JC = JC + J JC = JC + N - J + 1
+ 2 CONTINUE 2 CONTINUE
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtptrs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtptrs</H3>
+<PRE>
+public abstract void <B>dtptrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] ap,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N stored in packed format,
+ and B is an N-by-NRHS matrix. A check is made to verify that A is
+ nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrcon(java.lang.String, java.lang.String, java.lang.String, int, double[], int, org.netlib.util.doubleW, double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtrcon</H3>
+<PRE>
+public abstract void <B>dtrcon</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.doubleW rcond,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRCON estimates the reciprocal of the condition number of a
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrevc(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, int, org.netlib.util.intW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dtrevc</H3>
+<PRE>
+public abstract void <B>dtrevc</B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] t,
+ int ldt,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTREVC computes some or all of the right and/or left eigenvectors of
+
+ a real upper quasi-triangular matrix T.
+ Matrices of this type are produced by the Schur factorization of
+ a real general matrix: A = Q*T*Q**T, as computed by DHSEQR.
+
+ The right eigenvector x and the left eigenvector y of T corresponding
+ to an eigenvalue w are defined by:
+
+ T*x = w*x, (y**H)*T = w*(y**H)
+
+ where y**H denotes the conjugate transpose of y.
+ The eigenvalues are not input to this routine, but are read directly
+
+ from the diagonal blocks of T.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+ input matrix. If Q is the orthogonal factor that reduces a matrix
+ A to Schur form T, then Q*X and Q*Y are the matrices of right and
+ left eigenvectors of A.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ as indicated by the logical array SELECT.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+ computed.
+ If w(j) is a real eigenvalue, the corresponding real
+ eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector is
+
+ computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+ on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+
+ .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ The upper quasi-triangular matrix T in Schur canonical form.
+
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by DHSEQR).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VL, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by DHSEQR).
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*X;
+ if HOWMNY = 'S', the right eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VR, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors.
+ If HOWMNY = 'A' or 'B', M is set to N.
+ Each selected real eigenvector occupies one column and each
+ selected complex eigenvector occupies two columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The algorithm used in this program is basically backward (forward)
+ substitution, with scaling to make the the code robust against
+ possible overflow.
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x| + |y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrexc(java.lang.String, int, double[], int, double[], int, org.netlib.util.intW, org.netlib.util.intW, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dtrexc</H3>
+<PRE>
+public abstract void <B>dtrexc</B>(java.lang.String compq,
+ int n,
+ double[] t,
+ int ldt,
+ double[] q,
+ int ldq,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ double[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTREXC reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
+
+ moved to row ILST.
+
+ The real Schur form T is reordered by an orthogonal similarity
+ transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
+ is updated by postmultiplying it with Z.
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ Schur canonical form.
+ On exit, the reordered upper quasi-triangular matrix, again
+ in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix Z which reorders T.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of T.
+ The block with row index IFST is moved to row ILST, by a
+ sequence of transpositions between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of a
+ 2-by-2 block, it is changed to point to the first row; ILST
+ always points to the first row of the block in its final
+ position (which may differ from its input value by +1 or -1).
+ 1 <= IFST <= N; 1 <= ILST <= N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: two adjacent blocks were too close to swap (the problem
+ is very ill-conditioned); T may have been partially
+ reordered, and ILST points to the first row of the
+ current position of the block being moved.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>ifst</CODE> - <DD><CODE>ilst</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrrfs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, double[], int, double[], double[], double[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtrrfs</H3>
+<PRE>
+public abstract void <B>dtrrfs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] x,
+ int ldx,
+ double[] ferr,
+ double[] berr,
+ double[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular
+ coefficient matrix.
+
+ The solution matrix X must be computed by DTRTRS or some other
+ means before entering this routine. DTRRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrsen(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], double[], org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.doubleW, double[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtrsen</H3>
+<PRE>
+public abstract void <B>dtrsen</B>(java.lang.String job,
+ java.lang.String compq,
+ boolean[] select,
+ int n,
+ double[] t,
+ int ldt,
+ double[] q,
+ int ldq,
+ double[] wr,
+ double[] wi,
+ org.netlib.util.intW m,
+ org.netlib.util.doubleW s,
+ org.netlib.util.doubleW sep,
+ double[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSEN reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
+ the leading diagonal blocks of the upper quasi-triangular matrix T,
+ and the leading columns of Q form an orthonormal basis of the
+ corresponding right invariant subspace.
+
+ Optionally the routine computes the reciprocal condition numbers of
+ the cluster of eigenvalues and/or the invariant subspace.
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elemnts equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (S) or the invariant subspace (SEP):
+ = 'N': none;
+ = 'E': for eigenvalues only (S);
+ = 'V': for invariant subspace only (SEP);
+ = 'B': for both eigenvalues and invariant subspace (S and
+ SEP).
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster. To
+
+ select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, T is overwritten by the reordered matrix T, again in
+ Schur canonical form, with the selected eigenvalues in the
+ leading diagonal blocks.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix which reorders T; the
+ leading M columns of Q form an orthonormal basis for the
+ specified invariant subspace.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the reordered
+
+ eigenvalues of T. The eigenvalues are stored in the same
+ order as on the diagonal of T, with WR(i) = T(i,i) and, if
+ T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
+ WI(i+1) = -WI(i). Note that if a complex eigenvalue is
+ sufficiently ill-conditioned, then its value may differ
+ significantly from its value before reordering.
+
+ M (output) INTEGER
+ The dimension of the specified invariant subspace.
+ 0 < = M <= N.
+
+ S (output) DOUBLE PRECISION
+ If JOB = 'E' or 'B', S is a lower bound on the reciprocal
+ condition number for the selected cluster of eigenvalues.
+ S cannot underestimate the true reciprocal condition number
+ by more than a factor of sqrt(N). If M = 0 or N, S = 1.
+ If JOB = 'N' or 'V', S is not referenced.
+
+ SEP (output) DOUBLE PRECISION
+ If JOB = 'V' or 'B', SEP is the estimated reciprocal
+ condition number of the specified invariant subspace. If
+ M = 0 or N, SEP = norm(T).
+ If JOB = 'N' or 'E', SEP is not referenced.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOB = 'N', LWORK >= max(1,N);
+ if JOB = 'E', LWORK >= max(1,M*(N-M));
+ if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOB = 'N' or 'E', LIWORK >= 1;
+ if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: reordering of T failed because some eigenvalues are too
+
+ close to separate (the problem is very ill-conditioned);
+ T may have been partially reordered, and WR and WI
+ contain the eigenvalues in the same order as in T; S and
+ SEP (if requested) are set to zero.
+
+ Further Details
+ ===============
+
+ DTRSEN first collects the selected eigenvalues by computing an
+ orthogonal transformation Z to move them to the top left corner of T.
+ In other words, the selected eigenvalues are the eigenvalues of T11
+ in:
+
+ Z'*T*Z = ( T11 T12 ) n1
+ ( 0 T22 ) n2
+ n1 n2
+
+ where N = n1+n2 and Z' means the transpose of Z. The first n1 columns
+ of Z span the specified invariant subspace of T.
+
+ If T has been obtained from the real Schur factorization of a matrix
+
+ A = Q*T*Q', then the reordered real Schur factorization of A is given
+ by A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span
+ the corresponding invariant subspace of A.
+
+ The reciprocal condition number of the average of the eigenvalues of
+
+ T11 may be returned in S. S lies between 0 (very badly conditioned)
+ and 1 (very well conditioned). It is computed as follows. First we
+ compute R so that
+
+ P = ( I R ) n1
+ ( 0 0 ) n2
+ n1 n2
+
+ is the projector on the invariant subspace associated with T11.
+ R is the solution of the Sylvester equation:
+
+ T11*R - R*T22 = T12.
+
+ Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
+ the two-norm of M. Then S is computed as the lower bound
+
+ (1 + F-norm(R)**2)**(-1/2)
+
+ on the reciprocal of 2-norm(P), the true reciprocal condition number.
+ S cannot underestimate 1 / 2-norm(P) by more than a factor of
+ sqrt(N).
+
+ An approximate error bound for the computed average of the
+ eigenvalues of T11 is
+
+ EPS * norm(T) / S
+
+ where EPS is the machine precision.
+
+ The reciprocal condition number of the right invariant subspace
+ spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
+
+ SEP is defined as the separation of T11 and T22:
+
+ sep( T11, T22 ) = sigma-min( C )
+
+ where sigma-min(C) is the smallest singular value of the
+ n1*n2-by-n1*n2 matrix
+
+ C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
+
+ I(m) is an m by m identity matrix, and kprod denotes the Kronecker
+ product. We estimate sigma-min(C) by the reciprocal of an estimate of
+ the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
+ cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
+
+ When SEP is small, small changes in T can cause large changes in
+ the invariant subspace. An approximate bound on the maximum angular
+ error in the computed right invariant subspace is
+
+ EPS * norm(T) / SEP
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>compq</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>m</CODE> - <DD><CODE>s</CODE> - <DD><CODE>sep</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrsna(java.lang.String, java.lang.String, boolean[], int, double[], int, double[], int, double[], int, double[], double[], int, org.netlib.util.intW, double[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+dtrsna</H3>
+<PRE>
+public abstract void <B>dtrsna</B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ double[] t,
+ int ldt,
+ double[] vl,
+ int ldvl,
+ double[] vr,
+ int ldvr,
+ double[] s,
+ double[] sep,
+ int mm,
+ org.netlib.util.intW m,
+ double[] work,
+ int ldwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or right eigenvectors of a real upper
+ quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
+ orthogonal).
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (SEP):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (SEP);
+ = 'B': for both eigenvalues and eigenvectors (S and SEP).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ The upper quasi-triangular matrix T, in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input) DOUBLE PRECISION array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of T
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VL, as returned by
+ DHSEIN or DTREVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) DOUBLE PRECISION array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of T
+
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VR, as returned by
+ DHSEIN or DTREVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), SEP(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ SEP (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of SEP are set to the same value. If
+ the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', SEP is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S (if JOB = 'E' or 'B')
+
+ and/or SEP (if JOB = 'V' or 'B'). MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and/or SEP actually
+ used to store the estimated condition numbers.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,N+6)
+ If JOB = 'E', WORK is not referenced.
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
+
+ IWORK (workspace) INTEGER array, dimension (2*(N-1))
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of an eigenvalue lambda is
+ defined as
+
+ S(lambda) = |v'*u| / (norm(u)*norm(v))
+
+ where u and v are the right and left eigenvectors of T corresponding
+
+ to lambda; v' denotes the conjugate-transpose of v, and norm(u)
+ denotes the Euclidean norm. These reciprocal condition numbers always
+ lie between zero (very badly conditioned) and one (very well
+ conditioned). If n = 1, S(lambda) is defined to be 1.
+
+ An approximate error bound for a computed eigenvalue W(i) is given by
+
+ EPS * norm(T) / S(i)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number of the right eigenvector u
+ corresponding to lambda is defined as follows. Suppose
+
+ T = ( lambda c )
+ ( 0 T22 )
+
+ Then the reciprocal condition number is
+
+ SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
+
+ where sigma-min denotes the smallest singular value. We approximate
+ the smallest singular value by the reciprocal of an estimate of the
+ one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
+ defined to be abs(T(1,1)).
+
+ An approximate error bound for a computed right eigenvector VR(i)
+ is given by
+
+ EPS * norm(T) / SEP(i)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>s</CODE> - <DD><CODE>sep</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ldwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrsyl(java.lang.String, java.lang.String, int, int, int, double[], int, double[], int, double[], int, org.netlib.util.doubleW, org.netlib.util.intW)"><!-- --></A><H3>
+dtrsyl</H3>
+<PRE>
+public abstract void <B>dtrsyl</B>(java.lang.String trana,
+ java.lang.String tranb,
+ int isgn,
+ int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ double[] c,
+ int Ldc,
+ org.netlib.util.doubleW scale,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSYL solves the real Sylvester matrix equation:
+
+ op(A)*X + X*op(B) = scale*C or
+ op(A)*X - X*op(B) = scale*C,
+
+ where op(A) = A or A**T, and A and B are both upper quasi-
+ triangular. A is M-by-M and B is N-by-N; the right hand side C and
+ the solution X are M-by-N; and scale is an output scale factor, set
+ <= 1 to avoid overflow in X.
+
+ A and B must be in Schur canonical form (as returned by DHSEQR), that
+ is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
+ each 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ TRANA (input) CHARACTER*1
+ Specifies the option op(A):
+ = 'N': op(A) = A (No transpose)
+ = 'T': op(A) = A**T (Transpose)
+ = 'C': op(A) = A**H (Conjugate transpose = Transpose)
+
+ TRANB (input) CHARACTER*1
+ Specifies the option op(B):
+ = 'N': op(B) = B (No transpose)
+ = 'T': op(B) = B**T (Transpose)
+ = 'C': op(B) = B**H (Conjugate transpose = Transpose)
+
+ ISGN (input) INTEGER
+ Specifies the sign in the equation:
+ = +1: solve op(A)*X + X*op(B) = scale*C
+ = -1: solve op(A)*X - X*op(B) = scale*C
+
+ M (input) INTEGER
+ The order of the matrix A, and the number of rows in the
+ matrices X and C. M >= 0.
+
+ N (input) INTEGER
+ The order of the matrix B, and the number of columns in the
+ matrices X and C. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,M)
+ The upper quasi-triangular matrix A, in Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The upper quasi-triangular matrix B, in Schur canonical form.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N right hand side matrix C.
+ On exit, C is overwritten by the solution matrix X.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M)
+
+ SCALE (output) DOUBLE PRECISION
+ The scale factor, scale, set <= 1 to avoid overflow in X.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: A and B have common or very close eigenvalues; perturbed
+ values were used to solve the equation (but the matrices
+ A and B are unchanged).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trana</CODE> - <DD><CODE>tranb</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrti2(java.lang.String, java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtrti2</H3>
+<PRE>
+public abstract void <B>dtrti2</B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRTI2 computes the inverse of a real upper or lower triangular
+ matrix.
+
+ This is the Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading n by n upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrtri(java.lang.String, java.lang.String, int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtrtri</H3>
+<PRE>
+public abstract void <B>dtrtri</B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRTRI computes the inverse of a real upper or lower triangular
+ matrix A.
+
+ This is the Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtrtrs(java.lang.String, java.lang.String, java.lang.String, int, int, double[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtrtrs</H3>
+<PRE>
+public abstract void <B>dtrtrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ double[] a,
+ int lda,
+ double[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N, and B is an N-by-NRHS
+ matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the solutions
+ X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtzrqf(int, int, double[], int, double[], org.netlib.util.intW)"><!-- --></A><H3>
+dtzrqf</H3>
+<PRE>
+public abstract void <B>dtzrqf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DTZRZF.
+
+ DTZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dtzrzf(int, int, double[], int, double[], double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+dtzrzf</H3>
+<PRE>
+public abstract void <B>dtzrzf</B>(int m,
+ int n,
+ double[] a,
+ int lda,
+ double[] tau,
+ double[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ieeeck(int, float, float)"><!-- --></A><H3>
+ieeeck</H3>
+<PRE>
+public abstract int <B>ieeeck</B>(int ispec,
+ float zero,
+ float one)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ IEEECK is called from the ILAENV to verify that Infinity and
+ possibly NaN arithmetic is safe (i.e. will not trap).
+
+ Arguments
+ =========
+
+ ISPEC (input) INTEGER
+ Specifies whether to test just for inifinity arithmetic
+ or whether to test for infinity and NaN arithmetic.
+ = 0: Verify infinity arithmetic only.
+ = 1: Verify infinity and NaN arithmetic.
+
+ ZERO (input) REAL
+ Must contain the value 0.0
+ This is passed to prevent the compiler from optimizing
+ away this code.
+
+ ONE (input) REAL
+ Must contain the value 1.0
+ This is passed to prevent the compiler from optimizing
+ away this code.
+
+ RETURN VALUE: INTEGER
+ = 0: Arithmetic failed to produce the correct answers
+ = 1: Arithmetic produced the correct answers
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ispec</CODE> - <DD><CODE>zero</CODE> - <DD><CODE>one</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ilaenv(int, java.lang.String, java.lang.String, int, int, int, int)"><!-- --></A><H3>
+ilaenv</H3>
+<PRE>
+public abstract int <B>ilaenv</B>(int ispec,
+ java.lang.String name,
+ java.lang.String opts,
+ int n1,
+ int n2,
+ int n3,
+ int n4)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ ILAENV is called from the LAPACK routines to choose problem-dependent
+ parameters for the local environment. See ISPEC for a description of
+ the parameters.
+
+ ILAENV returns an INTEGER
+ if ILAENV >= 0: ILAENV returns the value of the parameter specified b
+ if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal valu
+
+ This version provides a set of parameters which should give good,
+ but not optimal, performance on many of the currently available
+ computers. Users are encouraged to modify this subroutine to set
+ the tuning parameters for their particular machine using the option
+ and problem size information in the arguments.
+
+ This routine will not function correctly if it is converted to all
+ lower case. Converting it to all upper case is allowed.
+
+ Arguments
+ =========
+
+ ISPEC (input) INTEGER
+ Specifies the parameter to be returned as the value of
+ ILAENV.
+ = 1: the optimal blocksize; if this value is 1, an unblocked
+
+ algorithm will give the best performance.
+ = 2: the minimum block size for which the block routine
+ should be used; if the usable block size is less than
+ this value, an unblocked routine should be used.
+ = 3: the crossover point (in a block routine, for N less
+ than this value, an unblocked routine should be used)
+ = 4: the number of shifts, used in the nonsymmetric
+ eigenvalue routines (DEPRECATED)
+ = 5: the minimum column dimension for blocking to be used;
+ rectangular blocks must have dimension at least k by m,
+
+ where k is given by ILAENV(2,...) and m by ILAENV(5,...)
+ = 6: the crossover point for the SVD (when reducing an m by n
+ matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
+
+ this value, a QR factorization is used first to reduce
+ the matrix to a triangular form.)
+ = 7: the number of processors
+ = 8: the crossover point for the multishift QR method
+ for nonsymmetric eigenvalue problems (DEPRECATED)
+ = 9: maximum size of the subproblems at the bottom of the
+ computation tree in the divide-and-conquer algorithm
+ (used by xGELSD and xGESDD)
+ =10: ieee NaN arithmetic can be trusted not to trap
+ =11: infinity arithmetic can be trusted not to trap
+ 12 <= ISPEC <= 16:
+ xHSEQR or one of its subroutines,
+ see IPARMQ for detailed explanation
+
+ NAME (input) CHARACTER*(*)
+ The name of the calling subroutine, in either upper case or
+ lower case.
+
+ OPTS (input) CHARACTER*(*)
+ The character options to the subroutine NAME, concatenated
+ into a single character string. For example, UPLO = 'U',
+ TRANS = 'T', and DIAG = 'N' for a triangular routine would
+ be specified as OPTS = 'UTN'.
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ N3 (input) INTEGER
+ N4 (input) INTEGER
+ Problem dimensions for the subroutine NAME; these may not all
+ be required.
+
+ Further Details
+ ===============
+
+ The following conventions have been used when calling ILAENV from the
+ LAPACK routines:
+ 1) OPTS is a concatenation of all of the character options to
+ subroutine NAME, in the same order that they appear in the
+ argument list for NAME, even if they are not used in determining
+
+ the value of the parameter specified by ISPEC.
+ 2) The problem dimensions N1, N2, N3, N4 are specified in the order
+
+ that they appear in the argument list for NAME. N1 is used
+ first, N2 second, and so on, and unused problem dimensions are
+ passed a value of -1.
+ 3) The parameter value returned by ILAENV is checked for validity in
+ the calling subroutine. For example, ILAENV is used to retrieve
+
+ the optimal blocksize for STRTRI as follows:
+
+ NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
+ IF( NB.LE.1 ) NB = MAX( 1, N )
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ispec</CODE> - <DD><CODE>name</CODE> - <DD><CODE>opts</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>n3</CODE> - <DD><CODE>n4</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ilaver(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+ilaver</H3>
+<PRE>
+public void <B>ilaver</B>(org.netlib.util.intW vers_major,
+ org.netlib.util.intW vers_minor,
+ org.netlib.util.intW vers_patch)</PRE>
+<DL>
+<DD><pre>
+
+
+ -- LAPACK routine (version 3.1.1) --
+ Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+ January 2007
+ ..
+
+ Purpose
+ =======
+
+ This subroutine return the Lapack version
+
+ Arguments
+ =========
+ VERS_MAJOR (output) INTEGER
+ return the lapack major version
+ VERS_MINOR (output) INTEGER
+ return the lapack minor version from the major version
+ VERS_PATCH (output) INTEGER
+ return the lapack patch version from the minor version
+ =====================================================================
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vers_major</CODE> - <DD><CODE>vers_minor</CODE> - <DD><CODE>vers_patch</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="iparmq(int, java.lang.String, java.lang.String, int, int, int, int)"><!-- --></A><H3>
+iparmq</H3>
+<PRE>
+public int <B>iparmq</B>(int ispec,
+ java.lang.String name,
+ java.lang.String opts,
+ int n,
+ int ilo,
+ int ihi,
+ int lwork)</PRE>
+<DL>
+<DD><pre>
+
+
+ Purpose
+ =======
+
+ This program sets problem and machine dependent parameters
+ useful for xHSEQR and its subroutines. It is called whenever
+ ILAENV is called with 12 <= ISPEC <= 16
+
+ Arguments
+ =========
+
+ ISPEC (input) integer scalar
+ ISPEC specifies which tunable parameter IPARMQ should
+ return.
+
+ ISPEC=12: (INMIN) Matrices of order nmin or less
+ are sent directly to xLAHQR, the implicit
+ double shift QR algorithm. NMIN must be
+ at least 11.
+
+ ISPEC=13: (INWIN) Size of the deflation window.
+ This is best set greater than or equal to
+ the number of simultaneous shifts NS.
+ Larger matrices benefit from larger deflation
+ windows.
+
+ ISPEC=14: (INIBL) Determines when to stop nibbling and
+ invest in an (expensive) multi-shift QR sweep.
+
+ If the aggressive early deflation subroutine
+ finds LD converged eigenvalues from an order
+ NW deflation window and LD.GT.(NW*NIBBLE)/100,
+
+ then the next QR sweep is skipped and early
+ deflation is applied immediately to the
+ remaining active diagonal block. Setting
+ IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
+ multi-shift QR sweep whenever early deflation
+ finds a converged eigenvalue. Setting
+ IPARMQ(ISPEC=14) greater than or equal to 100
+ prevents TTQRE from skipping a multi-shift
+ QR sweep.
+
+ ISPEC=15: (NSHFTS) The number of simultaneous shifts in
+ a multi-shift QR iteration.
+
+ ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
+ following meanings.
+ 0: During the multi-shift QR sweep,
+ xLAQR5 does not accumulate reflections and
+
+ does not use matrix-matrix multiply to
+ update the far-from-diagonal matrix
+ entries.
+ 1: During the multi-shift QR sweep,
+ xLAQR5 and/or xLAQRaccumulates reflections
+ matrix-matrix multiply to update the
+ far-from-diagonal matrix entries.
+ 2: During the multi-shift QR sweep.
+ xLAQR5 accumulates reflections and takes
+ advantage of 2-by-2 block structure during
+
+ matrix-matrix multiplies.
+ (If xTRMM is slower than xGEMM, then
+ IPARMQ(ISPEC=16)=1 may be more efficient than
+ IPARMQ(ISPEC=16)=2 despite the greater level of
+ arithmetic work implied by the latter choice.)
+
+
+ NAME (input) character string
+ Name of the calling subroutine
+
+ OPTS (input) character string
+ This is a concatenation of the string arguments to
+ TTQRE.
+
+ N (input) integer scalar
+ N is the order of the Hessenberg matrix H.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular
+ in rows and columns 1:ILO-1 and IHI+1:N.
+
+ LWORK (input) integer scalar
+ The amount of workspace available.
+
+ Further Details
+ ===============
+
+ Little is known about how best to choose these parameters.
+ It is possible to use different values of the parameters
+ for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
+
+ It is probably best to choose different parameters for
+ different matrices and different parameters at different
+ times during the iteration, but this has not been
+ implemented --- yet.
+
+
+ The best choices of most of the parameters depend
+ in an ill-understood way on the relative execution
+ rate of xLAQR3 and xLAQR5 and on the nature of each
+ particular eigenvalue problem. Experiment may be the
+ only practical way to determine which choices are most
+ effective.
+
+ Following is a list of default values supplied by IPARMQ.
+ These defaults may be adjusted in order to attain better
+ performance in any particular computational environment.
+
+ IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
+ Default: 75. (Must be at least 11.)
+
+ IPARMQ(ISPEC=13) Recommended deflation window size.
+ This depends on ILO, IHI and NS, the
+ number of simultaneous shifts returned
+ by IPARMQ(ISPEC=15). The default for
+ (IHI-ILO+1).LE.500 is NS. The default
+ for (IHI-ILO+1).GT.500 is 3*NS/2.
+
+ IPARMQ(ISPEC=14) Nibble crossover point. Default: 14.
+
+ IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
+ a multi-shift QR iteration.
+
+ If IHI-ILO+1 is ...
+
+ greater than ...but less ... the
+ or equal to ... than default is
+
+ 0 30 NS = 2+
+ 30 60 NS = 4+
+ 60 150 NS = 10
+ 150 590 NS = **
+ 590 3000 NS = 64
+ 3000 6000 NS = 128
+ 6000 infinity NS = 256
+
+ (+) By default matrices of this order are
+ passed to the implicit double shift routine
+ xLAHQR. See IPARMQ(ISPEC=12) above. These
+ values of NS are used only in case of a rare
+ xLAHQR failure.
+
+ (**) The asterisks (**) indicate an ad-hoc
+ function increasing from 10 to 64.
+
+ IPARMQ(ISPEC=16) Select structured matrix multiply.
+ (See ISPEC=16 above for details.)
+ Default: 3.
+
+ ================================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ispec</CODE> - <DD><CODE>name</CODE> - <DD><CODE>opts</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lwork</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="lsamen(int, java.lang.String, java.lang.String)"><!-- --></A><H3>
+lsamen</H3>
+<PRE>
+public boolean <B>lsamen</B>(int n,
+ java.lang.String ca,
+ java.lang.String cb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ LSAMEN tests if the first N letters of CA are the same as the
+ first N letters of CB, regardless of case.
+ LSAMEN returns .TRUE. if CA and CB are equivalent except for case
+ and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA )
+ or LEN( CB ) is less than N.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of characters in CA and CB to be compared.
+
+ CA (input) CHARACTER*(*)
+ CB (input) CHARACTER*(*)
+ CA and CB specify two character strings of length at least N.
+ Only the first N characters of each string will be accessed.
+
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ca</CODE> - <DD><CODE>cb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sbdsdc(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], int, float[], int[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sbdsdc</H3>
+<PRE>
+public abstract void <B>sbdsdc</B>(java.lang.String uplo,
+ java.lang.String compq,
+ int n,
+ float[] d,
+ float[] e,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] q,
+ int[] iq,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SBDSDC computes the singular value decomposition (SVD) of a real
+ N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
+ using a divide and conquer method, where S is a diagonal matrix
+ with non-negative diagonal elements (the singular values of B), and
+ U and VT are orthogonal matrices of left and right singular vectors,
+
+ respectively. SBDSDC can be used to compute all singular values,
+ and optionally, singular vectors or singular vectors in compact form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See SLASD3 for details.
+
+ The code currently calls SLASDQ if singular values only are desired.
+
+ However, it can be slightly modified to compute singular values
+ using the divide and conquer method.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal.
+ = 'L': B is lower bidiagonal.
+
+ COMPQ (input) CHARACTER*1
+ Specifies whether singular vectors are to be computed
+ as follows:
+ = 'N': Compute singular values only;
+ = 'P': Compute singular values and compute singular
+ vectors in compact form;
+ = 'I': Compute singular values and singular vectors.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the elements of E contain the offdiagonal
+ elements of the bidiagonal matrix whose SVD is desired.
+ On exit, E has been destroyed.
+
+ U (output) REAL array, dimension (LDU,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, U contains the left singular vectors
+ of the bidiagonal matrix.
+ For other values of COMPQ, U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1.
+ If singular vectors are desired, then LDU >= max( 1, N ).
+
+ VT (output) REAL array, dimension (LDVT,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, VT' contains the right singular
+ vectors of the bidiagonal matrix.
+ For other values of COMPQ, VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1.
+ If singular vectors are desired, then LDVT >= max( 1, N ).
+
+ Q (output) REAL array, dimension (LDQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, Q contains all the REAL data in
+ LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, Q is not referenced.
+
+ IQ (output) INTEGER array, dimension (LDIQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, IQ contains all INTEGER data in
+ LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, IQ is not referenced.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK))
+ If COMPQ = 'N' then LWORK >= (4 * N).
+ If COMPQ = 'P' then LWORK >= (6 * N).
+ If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value.
+ The update process of divide and conquer failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+ =====================================================================
+ Changed dimension statement in comment describing E from (N) to
+ (N-1). Sven, 17 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>compq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>iq</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sbdsqr(java.lang.String, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sbdsqr</H3>
+<PRE>
+public abstract void <B>sbdsqr</B>(java.lang.String uplo,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ float[] d,
+ float[] e,
+ float[] vt,
+ int ldvt,
+ float[] u,
+ int ldu,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SBDSQR computes the singular values and, optionally, the right and/or
+ left singular vectors from the singular value decomposition (SVD) of
+
+ a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+ zero-shift QR algorithm. The SVD of B has the form
+
+ B = Q * S * P**T
+
+ where S is the diagonal matrix of singular values, Q is an orthogonal
+ matrix of left singular vectors, and P is an orthogonal matrix of
+ right singular vectors. If left singular vectors are requested, this
+ subroutine actually returns U*Q instead of Q, and, if right singular
+
+ vectors are requested, this subroutine returns P**T*VT instead of
+ P**T, for given real input matrices U and VT. When U and VT are the
+
+ orthogonal matrices that reduce a general matrix A to bidiagonal
+ form: A = U*B*VT, as computed by SGEBRD, then
+
+ A = (U*Q) * S * (P**T*VT)
+
+ is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+
+ for a given real input matrix C.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
+ no. 5, pp. 873-912, Sept 1990) and
+ "Accurate singular values and differential qd algorithms," by
+ B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
+ Department, University of California at Berkeley, July 1992
+ for a detailed description of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal;
+ = 'L': B is lower bidiagonal.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ NCVT (input) INTEGER
+ The number of columns of the matrix VT. NCVT >= 0.
+
+ NRU (input) INTEGER
+ The number of rows of the matrix U. NRU >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B in decreasing
+ order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the N-1 offdiagonal elements of the bidiagonal
+ matrix B.
+ On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
+ will contain the diagonal and superdiagonal elements of a
+ bidiagonal matrix orthogonally equivalent to the one given
+ as input.
+
+ VT (input/output) REAL array, dimension (LDVT, NCVT)
+ On entry, an N-by-NCVT matrix VT.
+ On exit, VT is overwritten by P**T * VT.
+ Not referenced if NCVT = 0.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT.
+ LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
+
+ U (input/output) REAL array, dimension (LDU, N)
+ On entry, an NRU-by-N matrix U.
+ On exit, U is overwritten by U * Q.
+ Not referenced if NRU = 0.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,NRU).
+
+ C (input/output) REAL array, dimension (LDC, NCC)
+ On entry, an N-by-NCC matrix C.
+ On exit, C is overwritten by Q**T * C.
+ Not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
+
+ WORK (workspace) REAL array, dimension (2*N)
+ if NCVT = NRU = NCC = 0, (max(1, 4*N)) otherwise
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm did not converge; D and E contain the
+ elements of a bidiagonal matrix which is orthogonally
+ similar to the input matrix B; if INFO = i, i
+ elements of E have not converged to zero.
+
+ Internal Parameters
+ ===================
+
+ TOLMUL REAL, default = max(10,min(100,EPS**(-1/8)))
+ TOLMUL controls the convergence criterion of the QR loop.
+ If it is positive, TOLMUL*EPS is the desired relative
+ precision in the computed singular values.
+ If it is negative, abs(TOLMUL*EPS*sigma_max) is the
+ desired absolute accuracy in the computed singular
+ values (corresponds to relative accuracy
+ abs(TOLMUL*EPS) in the largest singular value.
+ abs(TOLMUL) should be between 1 and 1/EPS, and preferably
+ between 10 (for fast convergence) and .1/EPS
+ (for there to be some accuracy in the results).
+ Default is to lose at either one eighth or 2 of the
+ available decimal digits in each computed singular value
+ (whichever is smaller).
+
+ MAXITR INTEGER, default = 6
+ MAXITR controls the maximum number of passes of the
+ algorithm through its inner loop. The algorithms stops
+ (and so fails to converge) if the number of passes
+ through the inner loop exceeds MAXITR*N**2.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ncvt</CODE> - <DD><CODE>nru</CODE> - <DD><CODE>ncc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sdisna(java.lang.String, int, int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sdisna</H3>
+<PRE>
+public abstract void <B>sdisna</B>(java.lang.String job,
+ int m,
+ int n,
+ float[] d,
+ float[] sep,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SDISNA computes the reciprocal condition numbers for the eigenvectors
+ of a real symmetric or complex Hermitian matrix or for the left or
+ right singular vectors of a general m-by-n matrix. The reciprocal
+ condition number is the 'gap' between the corresponding eigenvalue or
+ singular value and the nearest other one.
+
+ The bound on the error, measured by angle in radians, in the I-th
+ computed vector is given by
+
+ SLAMCH( 'E' ) * ( ANORM / SEP( I ) )
+
+ where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
+
+ to be smaller than SLAMCH( 'E' )*ANORM in order to limit the size of
+
+ the error bound.
+
+ SDISNA may also be used to compute error bounds for eigenvectors of
+ the generalized symmetric definite eigenproblem.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies for which problem the reciprocal condition numbers
+
+ should be computed:
+ = 'E': the eigenvectors of a symmetric/Hermitian matrix;
+ = 'L': the left singular vectors of a general matrix;
+ = 'R': the right singular vectors of a general matrix.
+
+ M (input) INTEGER
+ The number of rows of the matrix. M >= 0.
+
+ N (input) INTEGER
+ If JOB = 'L' or 'R', the number of columns of the matrix,
+ in which case N >= 0. Ignored if JOB = 'E'.
+
+ D (input) REAL array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+
+ The eigenvalues (if JOB = 'E') or singular values (if JOB =
+ 'L' or 'R') of the matrix, in either increasing or decreasing
+ order. If singular values, they must be non-negative.
+
+ SEP (output) REAL array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+ The reciprocal condition numbers of the vectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>sep</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbbrd(java.lang.String, int, int, int, int, int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgbbrd</H3>
+<PRE>
+public abstract void <B>sgbbrd</B>(java.lang.String vect,
+ int m,
+ int n,
+ int ncc,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] d,
+ float[] e,
+ float[] q,
+ int ldq,
+ float[] pt,
+ int ldpt,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBBRD reduces a real general m-by-n band matrix A to upper
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ The routine computes B, and optionally forms Q or P', or computes
+ Q'*C for a given matrix C.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether or not the matrices Q and P' are to be
+ formed.
+ = 'N': do not form Q or P';
+ = 'Q': form Q only;
+ = 'P': form P' only;
+ = 'B': form both.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals of the matrix A. KU >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the m-by-n band matrix A, stored in rows 1 to
+ KL+KU+1. The j-th column of A is stored in the j-th column of
+ the array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+ On exit, A is overwritten by values generated during the
+ reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KL+KU+1.
+
+ D (output) REAL array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B.
+
+ E (output) REAL array, dimension (min(M,N)-1)
+ The superdiagonal elements of the bidiagonal matrix B.
+
+ Q (output) REAL array, dimension (LDQ,M)
+ If VECT = 'Q' or 'B', the m-by-m orthogonal matrix Q.
+ If VECT = 'N' or 'P', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise.
+
+ PT (output) REAL array, dimension (LDPT,N)
+ If VECT = 'P' or 'B', the n-by-n orthogonal matrix P'.
+ If VECT = 'N' or 'Q', the array PT is not referenced.
+
+ LDPT (input) INTEGER
+ The leading dimension of the array PT.
+ LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise.
+
+ C (input/output) REAL array, dimension (LDC,NCC)
+ On entry, an m-by-ncc matrix C.
+ On exit, C is overwritten by Q'*C.
+ C is not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0.
+
+ WORK (workspace) REAL array, dimension (2*max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ncc</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>pt</CODE> - <DD><CODE>ldpt</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbcon(java.lang.String, int, int, int, float[], int, int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgbcon</H3>
+<PRE>
+public abstract void <B>sgbcon</B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBCON estimates the reciprocal of the condition number of a real
+ general band matrix A, in either the 1-norm or the infinity-norm,
+ using the LU factorization computed by SGBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) REAL array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by SGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ ANORM (input) REAL
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbequ(int, int, int, int, float[], int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+sgbequ</H3>
+<PRE>
+public abstract void <B>sgbequ</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] r,
+ float[] c,
+ org.netlib.util.floatW rowcnd,
+ org.netlib.util.floatW colcnd,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBEQU computes row and column scalings intended to equilibrate an
+ M-by-N band matrix A and reduce its condition number. R returns the
+
+ row scale factors and C the column scale factors, chosen to try to
+ make the largest element in each row and column of the matrix B with
+
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ R (output) REAL array, dimension (M)
+ If INFO = 0, or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) REAL array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) REAL
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) REAL
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbrfs(java.lang.String, int, int, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgbrfs</H3>
+<PRE>
+public abstract void <B>sgbrfs</B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is banded, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The original band matrix A, stored in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input) REAL array, dimension (LDAFB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by SGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
+
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGBTRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SGBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbsv(int, int, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgbsv</H3>
+<PRE>
+public abstract void <B>sgbsv</B>(int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBSV computes the solution to a real system of linear equations
+ A * X = B, where A is a band matrix of order N with KL subdiagonals
+ and KU superdiagonals, and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as A = L * U, where L is a product of permutation
+ and unit lower triangular matrices with KL subdiagonals, and U is
+ upper triangular with KL+KU superdiagonals. The factored form of A
+ is then used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * + + + * * * u14 u25 u36
+ * + + + + * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbsvx(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], int, int[], org.netlib.util.StringW, float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgbsvx</H3>
+<PRE>
+public abstract void <B>sgbsvx</B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ float[] r,
+ float[] c,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B, A**T * X = B, or A**H * X = B,
+
+ where A is a band matrix of order N with KL subdiagonals and KU
+ superdiagonals, and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed by this subroutine:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = L * U,
+ where L is a product of permutation and unit lower triangular
+ matrices with KL subdiagonals, and U is upper triangular with
+ KL+KU superdiagonals.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB and IPIV contain the factored form of
+ A. If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ AB, AFB, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
+
+ If FACT = 'F' and EQUED is not 'N', then A must have been
+ equilibrated by the scaling factors in R and/or C. AB is not
+ modified if FACT = 'F' or 'N', or if FACT = 'E' and
+ EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input or output) REAL array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains details of the LU factorization of the band matrix
+ A, as computed by SGBTRF. U is stored as an upper triangular
+ band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
+ and the multipliers used during the factorization are stored
+
+ in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
+ the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns details of the LU factorization of A.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns details of the LU factorization of the equilibrated
+ matrix A (see the description of AB for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
+
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = L*U
+ as computed by SGBTRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) REAL array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) REAL array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) REAL array, dimension (3*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+
+ value of RCOND would suggest.
+ =====================================================================
+ Moved setting of INFO = N+1 so INFO does not subsequently get
+ overwritten. Sven, 17 Mar 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbtf2(int, int, int, int, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgbtf2</H3>
+<PRE>
+public abstract void <B>sgbtf2</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBTF2 computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * + + + * * * u14 u25 u36
+ * + + + + * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U, because of fill-in resulting from the row
+ interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbtrf(int, int, int, int, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgbtrf</H3>
+<PRE>
+public abstract void <B>sgbtrf</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBTRF computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * + + + * * * u14 u25 u36
+ * + + + + * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgbtrs(java.lang.String, int, int, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgbtrs</H3>
+<PRE>
+public abstract void <B>sgbtrs</B>(java.lang.String trans,
+ int n,
+ int kl,
+ int ku,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBTRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general band matrix A using the LU factorization computed
+ by SGBTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by SGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgebak(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgebak</H3>
+<PRE>
+public abstract void <B>sgebak</B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ float[] scale,
+ int m,
+ float[] v,
+ int ldv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBAK forms the right or left eigenvectors of a real general matrix
+
+ by backward transformation on the computed eigenvectors of the
+ balanced matrix output by SGEBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N', do nothing, return immediately;
+ = 'P', do backward transformation for permutation only;
+ = 'S', do backward transformation for scaling only;
+ = 'B', do backward transformations for both permutation and
+ scaling.
+ JOB must be the same as the argument JOB supplied to SGEBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by SGEBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ SCALE (input) REAL array, dimension (N)
+ Details of the permutation and scaling factors, as returned
+ by SGEBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) REAL array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by SHSEIN or STREVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>side</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>m</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgebal(java.lang.String, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgebal</H3>
+<PRE>
+public abstract void <B>sgebal</B>(java.lang.String job,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] scale,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBAL balances a general real matrix A. This involves, first,
+ permuting A by a similarity transformation to isolate eigenvalues
+ in the first 1 to ILO-1 and last IHI+1 to N elements on the
+ diagonal; and second, applying a diagonal similarity transformation
+ to rows and columns ILO to IHI to make the rows and columns as
+ close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrix, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A:
+ = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+ for i = 1,...,N;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ SCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied to
+ A. If P(j) is the index of the row and column interchanged
+ with row and column j and D(j) is the scaling factor
+ applied to row and column j, then
+ SCALE(j) = P(j) for j = 1,...,ILO-1
+ = D(j) for j = ILO,...,IHI
+ = P(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The permutations consist of row and column interchanges which put
+ the matrix in the form
+
+ ( T1 X Y )
+ P A P = ( 0 B Z )
+ ( 0 0 T2 )
+
+ where T1 and T2 are upper triangular matrices whose eigenvalues lie
+ along the diagonal. The column indices ILO and IHI mark the starting
+ and ending columns of the submatrix B. Balancing consists of applying
+ a diagonal similarity transformation inv(D) * B * D to make the
+ 1-norms of each row of B and its corresponding column nearly equal.
+ The output matrix is
+
+ ( T1 X*D Y )
+ ( 0 inv(D)*B*D inv(D)*Z ).
+ ( 0 0 T2 )
+
+ Information about the permutations P and the diagonal matrix D is
+ returned in the vector SCALE.
+
+ This subroutine is based on the EISPACK routine BALANC.
+
+ Modified by Tzu-Yi Chen, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgebd2(int, int, float[], int, float[], float[], float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgebd2</H3>
+<PRE>
+public abstract void <B>sgebd2</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tauq,
+ float[] taup,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBD2 reduces a real general m by n matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) REAL array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) REAL array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace) REAL array, dimension (max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tauq</CODE> - <DD><CODE>taup</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgebrd(int, int, float[], int, float[], float[], float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgebrd</H3>
+<PRE>
+public abstract void <B>sgebrd</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tauq,
+ float[] taup,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBRD reduces a general real M-by-N matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
+
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) REAL array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) REAL array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,M,N).
+ For optimum performance LWORK >= (M+N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tauq</CODE> - <DD><CODE>taup</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgecon(java.lang.String, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgecon</H3>
+<PRE>
+public abstract void <B>sgecon</B>(java.lang.String norm,
+ int n,
+ float[] a,
+ int lda,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGECON estimates the reciprocal of the condition number of a general
+
+ real matrix A, in either the 1-norm or the infinity-norm, using
+ the LU factorization computed by SGETRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by SGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) REAL
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeequ(int, int, float[], int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+sgeequ</H3>
+<PRE>
+public abstract void <B>sgeequ</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] r,
+ float[] c,
+ org.netlib.util.floatW rowcnd,
+ org.netlib.util.floatW colcnd,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEEQU computes row and column scalings intended to equilibrate an
+ M-by-N matrix A and reduce its condition number. R returns the row
+ scale factors and C the column scale factors, chosen to try to make
+ the largest element in each row and column of the matrix B with
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The M-by-N matrix whose equilibration factors are
+ to be computed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ R (output) REAL array, dimension (M)
+ If INFO = 0 or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) REAL array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) REAL
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) REAL
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgees(java.lang.String, java.lang.String, java.lang.Object, int, float[], int, org.netlib.util.intW, float[], float[], float[], int, float[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+sgees</H3>
+<PRE>
+public void <B>sgees</B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ float[] wr,
+ float[] wi,
+ float[] vs,
+ int ldvs,
+ float[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEES computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left.
+ The leading columns of Z then form an orthonormal basis for the
+ invariant subspace corresponding to the selected eigenvalues.
+
+ A matrix is in real Schur form if it is upper quasi-triangular with
+ 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
+ form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two REAL arguments
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
+ conjugate pair of eigenvalues is selected, then both complex
+
+ eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO is set to N+2 (see INFO below).
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues in the same order
+ that they appear on the diagonal of the output Schur form T.
+
+ Complex conjugate pairs of eigenvalues will appear
+ consecutively with the eigenvalue having the positive
+ imaginary part first.
+
+ VS (output) REAL array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1; if
+ JOBVS = 'V', LDVS >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the matrix which reduces A
+
+ to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvs</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vs</CODE> - <DD><CODE>ldvs</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>bwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeesx(java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, float[], int, org.netlib.util.intW, float[], float[], float[], int, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+sgeesx</H3>
+<PRE>
+public void <B>sgeesx</B>(java.lang.String jobvs,
+ java.lang.String sort,
+ java.lang.Object select,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW sdim,
+ float[] wr,
+ float[] wi,
+ float[] vs,
+ int ldvs,
+ org.netlib.util.floatW rconde,
+ org.netlib.util.floatW rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEESX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left;
+ computes a reciprocal condition number for the average of the
+ selected eigenvalues (RCONDE); and computes a reciprocal condition
+ number for the right invariant subspace corresponding to the
+ selected eigenvalues (RCONDV). The leading columns of Z form an
+ orthonormal basis for this invariant subspace.
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
+ these quantities are called s and sep respectively).
+
+ A real matrix is in real Schur form if it is upper quasi-triangular
+ with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
+
+ the form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two REAL arguments
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a
+ complex conjugate pair of eigenvalues is selected, then both
+
+ are. Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO may be set to N+3 (see INFO below).
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for average of selected eigenvalues only;
+ = 'V': Computed for selected right invariant subspace only;
+ = 'B': Computed for both.
+ If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the N-by-N matrix A.
+ On exit, A is overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts, respectively,
+ of the computed eigenvalues, in the same order that they
+ appear on the diagonal of the output Schur form T. Complex
+ conjugate pairs of eigenvalues appear consecutively with the
+
+ eigenvalue having the positive imaginary part first.
+
+ VS (output) REAL array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1, and if
+ JOBVS = 'V', LDVS >= N.
+
+ RCONDE (output) REAL
+ If SENSE = 'E' or 'B', RCONDE contains the reciprocal
+ condition number for the average of the selected eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) REAL
+ If SENSE = 'V' or 'B', RCONDV contains the reciprocal
+ condition number for the selected right invariant subspace.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ Also, if SENSE = 'E' or 'V' or 'B',
+ LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
+ selected eigenvalues computed by this routine. Note that
+ N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
+ returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
+
+ 'B' this may not be large enough.
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates upper bounds on the optimal sizes of the
+ arrays WORK and IWORK, returns these values as the first
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
+
+ Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
+
+ only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
+ may not be large enough.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates upper bounds on the optimal sizes of
+
+ the arrays WORK and IWORK, returns these values as the first
+
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the transformation which
+ reduces A to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvs</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>select</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vs</CODE> - <DD><CODE>ldvs</CODE> - <DD><CODE>rconde</CODE> - <DD><CODE>rcondv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>bwork</CODE> - <DD><CODE>info [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeev(java.lang.String, java.lang.String, int, float[], int, float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgeev</H3>
+<PRE>
+public abstract void <B>sgeev</B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ float[] a,
+ int lda,
+ float[] wr,
+ float[] wi,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEEV computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1; if
+ JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N), and
+ if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
+ performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors have been computed;
+ elements i+1:N of WR and WI contain eigenvalues which
+ have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.floatW, float[], float[], float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgeevx</H3>
+<PRE>
+public abstract void <B>sgeevx</B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ float[] wr,
+ float[] wi,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] scale,
+ org.netlib.util.floatW abnrm,
+ float[] rconde,
+ float[] rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEEVX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
+ (RCONDE), and reciprocal condition numbers for the right
+ eigenvectors (RCONDV).
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Balancing a matrix means permuting the rows and columns to make it
+ more nearly upper triangular, and applying a diagonal similarity
+ transformation D * A * D**(-1), where D is a diagonal matrix, to
+ make its rows and columns closer in norm and the condition numbers
+ of its eigenvalues and eigenvectors smaller. The computed
+ reciprocal condition numbers correspond to the balanced matrix.
+ Permuting rows and columns will not change the condition numbers
+ (in exact arithmetic) but diagonal scaling will. For further
+ explanation of balancing, see section 4.10.2 of the LAPACK
+ Users' Guide.
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Indicates how the input matrix should be diagonally scaled
+ and/or permuted to improve the conditioning of its
+ eigenvalues.
+ = 'N': Do not diagonally scale or permute;
+ = 'P': Perform permutations to make the matrix more nearly
+ upper triangular. Do not diagonally scale;
+ = 'S': Diagonally scale the matrix, i.e. replace A by
+ D*A*D**(-1), where D is a diagonal matrix chosen
+ to make the rows and columns of A more equal in
+ norm. Do not permute;
+ = 'B': Both diagonally scale and permute A.
+
+ Computed reciprocal condition numbers will be for the matrix
+
+ after balancing and/or permuting. Permuting does not change
+ condition numbers (in exact arithmetic), but balancing does.
+
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVL must = 'V'.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVR must = 'V'.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for eigenvalues only;
+ = 'V': Computed for right eigenvectors only;
+ = 'B': Computed for eigenvalues and right eigenvectors.
+
+ If SENSE = 'E' or 'B', both left and right eigenvectors
+ must also be computed (JOBVL = 'V' and JOBVR = 'V').
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten. If JOBVL = 'V' or
+ JOBVR = 'V', A contains the real Schur form of the balanced
+ version of the input matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues will appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values determined when A was
+ balanced. The balanced A(i,j) = 0 if I > J and
+ J = 1,...,ILO-1 or I = IHI+1,...,N.
+
+ SCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ when balancing A. If P(j) is the index of the row and column
+ interchanged with row and column j, and D(j) is the scaling
+ factor applied to row and column j, then
+ SCALE(J) = P(J), for J = 1,...,ILO-1
+ = D(J), for J = ILO,...,IHI
+ = P(J) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) REAL
+ The one-norm of the balanced matrix (the maximum
+ of the sum of absolute values of elements of any column).
+
+ RCONDE (output) REAL array, dimension (N)
+ RCONDE(j) is the reciprocal condition number of the j-th
+ eigenvalue.
+
+ RCONDV (output) REAL array, dimension (N)
+ RCONDV(j) is the reciprocal condition number of the j-th
+ right eigenvector.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. If SENSE = 'N' or 'E',
+ LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
+ LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (2*N-2)
+ If SENSE = 'N' or 'E', not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors or condition numbers
+ have been computed; elements 1:ILO-1 and i+1:N of WR
+ and WI contain eigenvalues which have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>balanc</CODE> - <DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>abnrm</CODE> - <DD><CODE>rconde</CODE> - <DD><CODE>rcondv</CODE> - <DD><CODE>work</CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgegs(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgegs</H3>
+<PRE>
+public abstract void <B>sgegs</B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vsl,
+ int ldvsl,
+ float[] vsr,
+ int ldvsr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGGES.
+
+ SGEGS computes the eigenvalues, real Schur form, and, optionally,
+ left and or/right Schur vectors of a real matrix pair (A,B).
+ Given two square matrices A and B, the generalized real Schur
+ factorization has the form
+
+ A = Q*S*Z**T, B = Q*T*Z**T
+
+ where Q and Z are orthogonal matrices, T is upper triangular, and S
+ is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
+ blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
+ of eigenvalues of (A,B). The columns of Q are the left Schur vectors
+ and the columns of Z are the right Schur vectors.
+
+ If only the eigenvalues of (A,B) are needed, the driver routine
+ SGEGV should be used instead. See SGEGV for a description of the
+ eigenvalues of the generalized nonsymmetric eigenvalue problem
+ (GNEP).
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors (returned in VSL).
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors (returned in VSR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A.
+ On exit, the upper quasi-triangular matrix S from the
+ generalized real Schur factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B.
+ On exit, the upper triangular matrix T from the generalized
+ real Schur factorization.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) REAL array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and (j+1)-st
+ eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) REAL array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VSL (output) REAL array, dimension (LDVSL,N)
+ If JOBVSL = 'V', the matrix of left Schur vectors Q.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) REAL array, dimension (LDVSR,N)
+ If JOBVSR = 'V', the matrix of right Schur vectors Z.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,4*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for SGEQRF, SORMQR, and SORGQR.) Then compute:
+ NB -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR
+ The optimal LWORK is 2*N + N*(NB+1).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from SGGBAL
+ =N+2: error return from SGEQRF
+ =N+3: error return from SORMQR
+ =N+4: error return from SORGQR
+ =N+5: error return from SGGHRD
+ =N+6: error return from SHGEQZ (other than failed
+ iteration)
+ =N+7: error return from SGGBAK (computing VSL)
+ =N+8: error return from SGGBAK (computing VSR)
+ =N+9: error return from SLASCL (various places)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvsl</CODE> - <DD><CODE>jobvsr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vsl</CODE> - <DD><CODE>ldvsl</CODE> - <DD><CODE>vsr</CODE> - <DD><CODE>ldvsr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgegv(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgegv</H3>
+<PRE>
+public abstract void <B>sgegv</B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGGEV.
+
+ SGEGV computes the eigenvalues and, optionally, the left and/or right
+ eigenvectors of a real matrix pair (A,B).
+ Given two square matrices A and B,
+ the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+ eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+ that
+
+ A*x = lambda*B*x.
+
+ An alternate form is to find the eigenvalues mu and corresponding
+ eigenvectors y such that
+
+ mu*A*y = B*y.
+
+ These two forms are equivalent with mu = 1/lambda and x = y if
+ neither lambda nor mu is zero. In order to deal with the case that
+ lambda or mu is zero or small, two values alpha and beta are returned
+ for each eigenvalue, such that lambda = alpha/beta and
+ mu = beta/alpha.
+
+ The vectors x and y in the above equations are right eigenvectors of
+
+ the matrix pair (A,B). Vectors u and v satisfying
+
+ u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+
+ are left eigenvectors of (A,B).
+
+ Note: this routine performs "full balancing" on A and B -- see
+ "Further Details", below.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors (returned
+ in VL).
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors (returned
+
+ in VR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit A
+ contains the real Schur form of A from the generalized Schur
+
+ factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only the diagonal
+ blocks from the Schur form will be correct. See SGGHRD and
+ SHGEQZ for details.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+ upper triangular matrix obtained from B in the generalized
+ Schur factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only those elements of
+ B corresponding to the diagonal blocks from the Schur form of
+ A will be correct. See SGGHRD and SHGEQZ for details.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue of
+ GNEP.
+
+ ALPHAI (output) REAL array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) REAL array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored
+ in the columns of VL, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ u(j) = VL(:,j) + i*VL(:,j+1)
+ and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvectors
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors x(j) are stored
+ in the columns of VR, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then x(j) = VR(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ x(j) = VR(:,j) + i*VR(:,j+1)
+ and
+ x(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvalues
+
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for SGEQRF, SORMQR, and SORGQR.) Then compute:
+ NB -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR;
+
+ The optimal LWORK is:
+ 2*N + MAX( 6*N, N*(NB+1) ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from SGGBAL
+ =N+2: error return from SGEQRF
+ =N+3: error return from SORMQR
+ =N+4: error return from SORGQR
+ =N+5: error return from SGGHRD
+ =N+6: error return from SHGEQZ (other than failed
+ iteration)
+ =N+7: error return from STGEVC
+ =N+8: error return from SGGBAK (computing VL)
+ =N+9: error return from SGGBAK (computing VR)
+ =N+10: error return from SLASCL (various calls)
+
+ Further Details
+ ===============
+
+ Balancing
+ ---------
+
+ This driver calls SGGBAL to both permute and scale rows and columns
+ of A and B. The permutations PL and PR are chosen so that PL*A*PR
+ and PL*B*R will be upper triangular except for the diagonal blocks
+ A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
+ possible. The diagonal scaling matrices DL and DR are chosen so
+ that the pair DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
+ one (except for the elements that start out zero.)
+
+ After the eigenvalues and eigenvectors of the balanced matrices
+ have been computed, SGGBAK transforms the eigenvectors back to what
+ they would have been (in perfect arithmetic) if they had not been
+ balanced.
+
+ Contents of A and B on Exit
+ -------- -- - --- - -- ----
+
+ If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
+ both), then on exit the arrays A and B will contain the real Schur
+ form[*] of the "balanced" versions of A and B. If no eigenvectors
+ are computed, then only the diagonal blocks will be correct.
+
+ [*] See SHGEQZ, SGEGS, or read the book "Matrix Computations",
+ by Golub & van Loan, pub. by Johns Hopkins U. Press.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgehd2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgehd2</H3>
+<PRE>
+public abstract void <B>sgehd2</B>(int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEHD2 reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to SGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= max(1,N).
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the n by n general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgehrd(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgehrd</H3>
+<PRE>
+public abstract void <B>sgehrd</B>(int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEHRD reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to SGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+ zero.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's SGEHRD
+ subroutine incorporating improvements proposed by Quintana-Orti and
+ Van de Geijn (2005).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgelq2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgelq2</H3>
+<PRE>
+public abstract void <B>sgelq2</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELQ2 computes an LQ factorization of a real m by n matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m by min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgelqf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgelqf</H3>
+<PRE>
+public abstract void <B>sgelqf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELQF computes an LQ factorization of a real M-by-N matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m-by-min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgels(java.lang.String, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgels</H3>
+<PRE>
+public abstract void <B>sgels</B>(java.lang.String trans,
+ int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELS solves overdetermined or underdetermined real linear systems
+ involving an M-by-N matrix A, or its transpose, using a QR or LQ
+ factorization of A. It is assumed that A has full rank.
+
+ The following options are provided:
+
+ 1. If TRANS = 'N' and m >= n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A*X ||.
+
+ 2. If TRANS = 'N' and m < n: find the minimum norm solution of
+ an underdetermined system A * X = B.
+
+ 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
+ an undetermined system A**T * X = B.
+
+ 4. If TRANS = 'T' and m < n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A**T * X ||.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N': the linear system involves A;
+ = 'T': the linear system involves A**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of the matrices B and X. NRHS >=0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if M >= N, A is overwritten by details of its QR
+ factorization as returned by SGEQRF;
+ if M < N, A is overwritten by details of its LQ
+ factorization as returned by SGELQF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the matrix B of right hand side vectors, stored
+ columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+ if TRANS = 'T'.
+ On exit, if INFO = 0, B is overwritten by the solution
+ vectors, stored columnwise:
+ if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+ squares solution vectors; the residual sum of squares for the
+ solution in each column is given by the sum of squares of
+ elements N+1 to M in that column;
+ if TRANS = 'N' and m < n, rows 1 to N of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m < n, rows 1 to M of B contain the
+ least squares solution vectors; the residual sum of squares
+ for the solution in each column is given by the sum of
+ squares of elements M+1 to N in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= MAX(1,M,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= max( 1, MN + max( MN, NRHS ) ).
+ For optimal performance,
+ LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
+ where MN = min(M,N) and NB is the optimum block size.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of the
+ triangular factor of A is zero, so that A does not have
+ full rank; the least squares solution could not be
+ computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgelsd(int, int, int, float[], int, float[], int, float[], float, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgelsd</H3>
+<PRE>
+public abstract void <B>sgelsd</B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] s,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELSD computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize 2-norm(| b - A*x |)
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The problem is solved in three steps:
+ (1) Reduce the coefficient matrix A to bidiagonal form with
+ Householder transformations, reducing the original problem
+ into a "bidiagonal least squares problem" (BLS)
+ (2) Solve the BLS using a divide and conquer approach.
+ (3) Apply back all the Householder tranformations to solve
+ the original least squares problem.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK must be at least 1.
+ The exact minimum amount of workspace needed depends on M,
+ N and NRHS. As long as LWORK is at least
+ 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
+ if M is greater than or equal to N or
+ 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
+ if M is less than N, the code will execute correctly.
+ SMLSIZ is returned by ILAENV and is equal to the maximum
+ size of the subproblems at the bottom of the computation
+ tree (usually about 25), and
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the array WORK and the
+ minimum size of the array IWORK, and returns these values as
+
+ the first entries of the WORK and IWORK arrays, and no error
+
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ LIWORK >= max(1, 3*MINMN*NLVL + 11*MINMN),
+ where MINMN = MIN( M,N ).
+ On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>s</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgelss(int, int, int, float[], int, float[], int, float[], float, org.netlib.util.intW, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgelss</H3>
+<PRE>
+public abstract void <B>sgelss</B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] s,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELSS computes the minimum norm solution to a real linear least
+ squares problem:
+
+ Minimize 2-norm(| b - A*x |).
+
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
+
+ X.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the first min(m,n) rows of A are overwritten with
+ its right singular vectors, stored rowwise.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1, and also:
+ LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>s</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgelsx(int, int, int, float[], int, float[], int, int[], float, org.netlib.util.intW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgelsx</H3>
+<PRE>
+public abstract void <B>sgelsx</B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ int[] jpvt,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGELSY.
+
+ SGELSX computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+ If m >= n and RANK = n, the residual sum-of-squares for
+ the solution in the i-th column is given by the sum of
+ squares of elements N+1:M in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is an
+ initial column, otherwise it is a free column. Before
+ the QR factorization of A, all initial columns are
+ permuted to the leading positions; only the remaining
+ free columns are moved as a result of column pivoting
+ during the factorization.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace) REAL array, dimension
+ (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgelsy(int, int, int, float[], int, float[], int, int[], float, org.netlib.util.intW, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgelsy</H3>
+<PRE>
+public abstract void <B>sgelsy</B>(int m,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ int[] jpvt,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELSY computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ This routine is basically identical to the original xGELSX except
+ three differences:
+ o The call to the subroutine xGEQPF has been substituted by the
+ the call to the subroutine xGEQP3. This subroutine is a Blas-3
+ version of the QR factorization with column pivoting.
+ o Matrix B (the right hand side) is updated with Blas-3.
+ o The permutation of matrix B (the right hand side) is faster and
+ more simple.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of AP, otherwise column i is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of AP
+ was the k-th column of A.
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ The unblocked strategy requires that:
+ LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
+ where MN = min( M, N ).
+ The block algorithm requires that:
+ LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
+ where NB is an upper bound on the blocksize returned
+ by ILAENV for the routines SGEQP3, STZRZF, STZRQF, SORMQR,
+ and SORMRZ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeql2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgeql2</H3>
+<PRE>
+public abstract void <B>sgeql2</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQL2 computes a QL factorization of a real m by n matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the m by n lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeqlf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgeqlf</H3>
+<PRE>
+public abstract void <B>sgeqlf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQLF computes a QL factorization of a real M-by-N matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the M-by-N lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeqp3(int, int, float[], int, int[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgeqp3</H3>
+<PRE>
+public abstract void <B>sgeqp3</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQP3 computes a QR factorization with column pivoting of a
+ matrix A: A*P = Q*R using Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper trapezoidal matrix R; the elements below
+
+ the diagonal, together with the array TAU, represent the
+ orthogonal matrix Q as a product of min(M,N) elementary
+ reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(J).ne.0, the J-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(J)=0,
+ the J-th column of A is a free column.
+ On exit, if JPVT(J)=K, then the J-th column of A*P was the
+ the K-th column of A.
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO=0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 3*N+1.
+ For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real/complex scalar, and v is a real/complex vector
+ with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
+ A(i+1:m,i), and tau in TAU(i).
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeqpf(int, int, float[], int, int[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgeqpf</H3>
+<PRE>
+public abstract void <B>sgeqpf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGEQP3.
+
+ SGEQPF computes a QR factorization with column pivoting of a
+ real M-by-N matrix A: A*P = Q*R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper triangular matrix R; the elements
+ below the diagonal, together with the array TAU,
+ represent the orthogonal matrix Q as a product of
+ min(m,n) elementary reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(n)
+
+ Each H(i) has the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
+
+
+ The matrix P is represented in jpvt as follows: If
+ jpvt(j) = i
+ then the jth column of P is the ith canonical unit vector.
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeqr2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgeqr2</H3>
+<PRE>
+public abstract void <B>sgeqr2</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQR2 computes a QR factorization of a real m by n matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(m,n) by n upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgeqrf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgeqrf</H3>
+<PRE>
+public abstract void <B>sgeqrf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQRF computes a QR factorization of a real M-by-N matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of min(m,n) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgerfs(java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgerfs</H3>
+<PRE>
+public abstract void <B>sgerfs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGERFS improves the computed solution to a system of linear
+ equations and provides error bounds and backward error estimates for
+
+ the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The original N-by-N matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) REAL array, dimension (LDAF,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by SGETRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SGETRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgerq2(int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sgerq2</H3>
+<PRE>
+public abstract void <B>sgerq2</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGERQ2 computes an RQ factorization of a real m by n matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the m by n upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAU, represent the orthogonal matrix
+ Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgerqf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgerqf</H3>
+<PRE>
+public abstract void <B>sgerqf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGERQF computes an RQ factorization of a real M-by-N matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the M-by-N upper trapezoidal matrix R;
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of min(m,n) elementary
+ reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgesc2(int, float[], int, float[], int[], int[], org.netlib.util.floatW)"><!-- --></A><H3>
+sgesc2</H3>
+<PRE>
+public abstract void <B>sgesc2</B>(int n,
+ float[] a,
+ int lda,
+ float[] rhs,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.floatW scale)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESC2 solves a system of linear equations
+
+ A * X = scale* RHS
+
+ with a general N-by-N matrix A using the LU factorization with
+ complete pivoting computed by SGETC2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ A (input) REAL array, dimension (LDA,N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix A computed by SGETC2: A = P * L * U * Q
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, N).
+
+ RHS (input/output) REAL array, dimension (N).
+ On entry, the right hand side vector b.
+ On exit, the solution vector X.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ SCALE (output) REAL
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ 0 <= SCALE <= 1 to prevent owerflow in the solution.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>rhs</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>jpiv</CODE> - <DD><CODE>scale</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgesdd(java.lang.String, int, int, float[], int, float[], float[], int, float[], int, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgesdd</H3>
+<PRE>
+public abstract void <B>sgesdd</B>(java.lang.String jobz,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] s,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESDD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and right singular
+ vectors. If singular vectors are desired, it uses a
+ divide-and-conquer algorithm.
+
+ The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns VT = V**T, not V.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U and all N rows of V**T are
+ returned in the arrays U and VT;
+ = 'S': the first min(M,N) columns of U and the first
+ min(M,N) rows of V**T are returned in the arrays U
+ and VT;
+ = 'O': If M >= N, the first N columns of U are overwritten
+ on the array A and all rows of V**T are returned in
+ the array VT;
+ otherwise, all columns of U are returned in the
+ array U and the first M rows of V**T are overwritten
+
+ in the array A;
+ = 'N': no columns of U or rows of V**T are computed.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBZ = 'O', A is overwritten with the first N columns
+ of U (the left singular vectors, stored
+ columnwise) if M >= N;
+ A is overwritten with the first M rows
+ of V**T (the right singular vectors, stored
+ rowwise) otherwise.
+ if JOBZ .ne. 'O', the contents of A are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) REAL array, dimension (LDU,UCOL)
+ UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
+ UCOL = min(M,N) if JOBZ = 'S'.
+ If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
+
+ orthogonal matrix U;
+ if JOBZ = 'S', U contains the first min(M,N) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
+
+ VT (output) REAL array, dimension (LDVT,N)
+ If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
+ N-by-N orthogonal matrix V**T;
+ if JOBZ = 'S', VT contains the first min(M,N) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
+ if JOBZ = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ If JOBZ = 'N',
+ LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)).
+ If JOBZ = 'O',
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+ If JOBZ = 'S' or 'A'
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+ For good performance, LWORK should generally be larger.
+ If LWORK = -1 but other input arguments are legal, WORK(1)
+ returns the optimal LWORK.
+
+ IWORK (workspace) INTEGER array, dimension (8*min(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: SBDSDC did not converge, updating process failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgesv(int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgesv</H3>
+<PRE>
+public abstract void <B>sgesv</B>(int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as
+ A = P * L * U,
+ where P is a permutation matrix, L is unit lower triangular, and U is
+ upper triangular. The factored form of A is then used to solve the
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgesvd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgesvd</H3>
+<PRE>
+public abstract void <B>sgesvd</B>(java.lang.String jobu,
+ java.lang.String jobvt,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] s,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESVD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and/or right singular
+
+ vectors. The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns V**T, not V.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U are returned in array U:
+ = 'S': the first min(m,n) columns of U (the left singular
+ vectors) are returned in the array U;
+ = 'O': the first min(m,n) columns of U (the left singular
+ vectors) are overwritten on the array A;
+ = 'N': no columns of U (no left singular vectors) are
+ computed.
+
+ JOBVT (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix
+ V**T:
+ = 'A': all N rows of V**T are returned in the array VT;
+ = 'S': the first min(m,n) rows of V**T (the right singular
+ vectors) are returned in the array VT;
+ = 'O': the first min(m,n) rows of V**T (the right singular
+ vectors) are overwritten on the array A;
+ = 'N': no rows of V**T (no right singular vectors) are
+ computed.
+
+ JOBVT and JOBU cannot both be 'O'.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBU = 'O', A is overwritten with the first min(m,n)
+ columns of U (the left singular vectors,
+ stored columnwise);
+ if JOBVT = 'O', A is overwritten with the first min(m,n)
+ rows of V**T (the right singular vectors,
+ stored rowwise);
+ if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
+ are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) REAL array, dimension (LDU,UCOL)
+ (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
+ If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
+ if JOBU = 'S', U contains the first min(m,n) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBU = 'N' or 'O', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBU = 'S' or 'A', LDU >= M.
+
+ VT (output) REAL array, dimension (LDVT,N)
+ If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
+ V**T;
+ if JOBVT = 'S', VT contains the first min(m,n) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBVT = 'N' or 'O', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+ if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
+ superdiagonal elements of an upper bidiagonal matrix B
+ whose diagonal is in S (not necessarily sorted). B
+ satisfies A = U * B * VT, so it has the same singular values
+
+ as A, and singular vectors related by U and VT.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if SBDSQR did not converge, INFO specifies how many
+ superdiagonals of an intermediate bidiagonal form B
+ did not converge to zero. See the description of WORK
+ above for details.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobvt</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgesvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, int[], org.netlib.util.StringW, float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgesvx</H3>
+<PRE>
+public abstract void <B>sgesvx</B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ org.netlib.util.StringW equed,
+ float[] r,
+ float[] c,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESVX uses the LU factorization to compute the solution to a real
+ system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = P * L * U,
+ where P is a permutation matrix, L is a unit lower triangular
+ matrix, and U is upper triangular.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF and IPIV contain the factored form of A.
+ If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ A, AF, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
+ not 'N', then A must have been equilibrated by the scaling
+ factors in R and/or C. A is not modified if FACT = 'F' or
+ 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) REAL array, dimension (LDAF,N)
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the factors L and U from the factorization
+ A = P*L*U as computed by SGETRF. If EQUED .ne. 'N', then
+ AF is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the original matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the equilibrated matrix A (see the description of A for
+ the form of the equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = P*L*U
+ as computed by SGETRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) REAL array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) REAL array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) REAL array, dimension (4*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization has
+ been completed, but the factor U is exactly
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgetc2(int, float[], int, int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgetc2</H3>
+<PRE>
+public abstract void <B>sgetc2</B>(int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ int[] jpiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETC2 computes an LU factorization with complete pivoting of the
+ n-by-n matrix A. The factorization has the form A = P * L * U * Q,
+ where P and Q are permutation matrices, L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ This is the Level 2 BLAS algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the n-by-n matrix A to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U*Q; the unit diagonal elements of L are not stored.
+
+ If U(k, k) appears to be less than SMIN, U(k, k) is given the
+ value of SMIN, i.e., giving a nonsingular perturbed system.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, U(k, k) is likely to produce owerflow if
+ we try to solve for x in Ax = b. So U is perturbed to
+ avoid the overflow.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>jpiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgetf2(int, int, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgetf2</H3>
+<PRE>
+public abstract void <B>sgetf2</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETF2 computes an LU factorization of a general m-by-n matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgetrf(int, int, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgetrf</H3>
+<PRE>
+public abstract void <B>sgetrf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETRF computes an LU factorization of a general M-by-N matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgetri(int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgetri</H3>
+<PRE>
+public abstract void <B>sgetri</B>(int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETRI computes the inverse of a matrix using the LU factorization
+ computed by SGETRF.
+
+ This method inverts U and then computes inv(A) by solving the system
+
+ inv(A)*L = inv(U) for inv(A).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the factors L and U from the factorization
+ A = P*L*U as computed by SGETRF.
+ On exit, if INFO = 0, the inverse of the original matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimal performance LWORK >= N*NB, where NB is
+ the optimal blocksize returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
+ singular and its inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgetrs(java.lang.String, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgetrs</H3>
+<PRE>
+public abstract void <B>sgetrs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general N-by-N matrix A using the LU factorization computed
+ by SGETRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by SGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggbak(java.lang.String, java.lang.String, int, int, int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sggbak</H3>
+<PRE>
+public abstract void <B>sggbak</B>(java.lang.String job,
+ java.lang.String side,
+ int n,
+ int ilo,
+ int ihi,
+ float[] lscale,
+ float[] rscale,
+ int m,
+ float[] v,
+ int ldv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGBAK forms the right or left eigenvectors of a real generalized
+ eigenvalue problem A*x = lambda*B*x, by backward transformation on
+ the computed eigenvectors of the balanced pair of matrices output by
+
+ SGGBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N': do nothing, return immediately;
+ = 'P': do backward transformation for permutation only;
+ = 'S': do backward transformation for scaling only;
+ = 'B': do backward transformations for both permutation and
+
+ scaling.
+ JOB must be the same as the argument JOB supplied to SGGBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by SGGBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ LSCALE (input) REAL array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the left side of A and B, as returned by SGGBAL.
+
+ RSCALE (input) REAL array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the right side of A and B, as returned by SGGBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) REAL array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by STGEVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the matrix V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. Ward, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>side</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lscale</CODE> - <DD><CODE>rscale</CODE> - <DD><CODE>m</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggbal(java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sggbal</H3>
+<PRE>
+public abstract void <B>sggbal</B>(java.lang.String job,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] lscale,
+ float[] rscale,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGBAL balances a pair of general real matrices (A,B). This
+ involves, first, permuting A and B by similarity transformations to
+ isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
+ elements on the diagonal; and second, applying a diagonal similarity
+
+ transformation to rows and columns ILO to IHI to make the rows
+ and columns as close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrices, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors in the
+ generalized eigenvalue problem A*x = lambda*B*x.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A and B:
+ = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
+ and RSCALE(I) = 1.0 for i = 1,...,N.
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the input matrix B.
+ On exit, B is overwritten by the balanced matrix.
+ If JOB = 'N', B is not referenced.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If P(j) is the index of the
+ row interchanged with row j, and D(j)
+ is the scaling factor applied to row j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If P(j) is the index of the
+ column interchanged with column j, and D(j)
+ is the scaling factor applied to column j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ WORK (workspace) REAL array, dimension (lwork)
+ lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
+
+ at least 1 when JOB = 'N' or 'P'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. WARD, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lscale</CODE> - <DD><CODE>rscale</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgges(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, int, float[], int, float[], int, org.netlib.util.intW, float[], float[], float[], float[], int, float[], int, float[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+sgges</H3>
+<PRE>
+public void <B>sgges</B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vsl,
+ int ldvsl,
+ float[] vsr,
+ int ldvsr,
+ float[] work,
+ int lwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
+ the generalized eigenvalues, the generalized real Schur form (S,T),
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T.The
+ leading columns of VSL and VSR then form an orthonormal basis for the
+ corresponding left and right eigenspaces (deflating subspaces).
+
+ (If only the generalized eigenvalues are needed, use the driver
+ SGGEV instead, which is faster.)
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG);
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three REAL arguments
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+
+ Note that in the ill-conditioned case, a selected complex
+ eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
+
+ BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
+ in this case.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) REAL array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) REAL array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else LWORK >= max(8*N,6*N+16).
+ For good performance , LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ.
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in STGSEN.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvsl</CODE> - <DD><CODE>jobvsr</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>selctg</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vsl</CODE> - <DD><CODE>ldvsl</CODE> - <DD><CODE>vsr</CODE> - <DD><CODE>ldvsr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>bwor [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggesx(java.lang.String, java.lang.String, java.lang.String, java.lang.Object, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, float[], float[], float[], float[], int, float[], int, float[], float[], float[], int, int[], int, boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+sggesx</H3>
+<PRE>
+public void <B>sggesx</B>(java.lang.String jobvsl,
+ java.lang.String jobvsr,
+ java.lang.String sort,
+ java.lang.Object selctg,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW sdim,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vsl,
+ int ldvsl,
+ float[] vsr,
+ int ldvsr,
+ float[] rconde,
+ float[] rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGESX computes for a pair of N-by-N real nonsymmetric matrices
+ (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T; computes
+ a reciprocal condition number for the average of the selected
+ eigenvalues (RCONDE); and computes a reciprocal condition number for
+
+ the right and left deflating subspaces corresponding to the selected
+
+ eigenvalues (RCONDV). The leading columns of VSL and VSR then form
+ an orthonormal basis for the corresponding left and right eigenspaces
+ (deflating subspaces).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or for both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG).
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three REAL arguments
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer satisfy
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
+
+ since ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned), in this
+ case INFO is set to N+3.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N' : None are computed;
+ = 'E' : Computed for average of selected eigenvalues only;
+ = 'V' : Computed for selected deflating subspaces only;
+ = 'B' : Computed for both.
+ If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) REAL array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) REAL array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ RCONDE (output) REAL array, dimension ( 2 )
+ If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
+ reciprocal condition numbers for the average of the selected
+
+ eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) REAL array, dimension ( 2 )
+ If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
+ reciprocal condition numbers for the selected deflating
+ subspaces.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
+ LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
+ LWORK >= max( 8*N, 6*N+16 ).
+ Note that 2*SDIM*(N-SDIM) <= N*N/2.
+ Note also that an error is only returned if
+ LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
+ this may not be large enough.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the bound on the optimal size of the WORK
+ array and the minimum size of the IWORK array, returns these
+
+ values as the first entries of the WORK and IWORK arrays, and
+ no error message related to LWORK or LIWORK is issued by
+ XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
+ LIWORK >= N+6.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the bound on the optimal size of the
+
+ WORK array and the minimum size of the IWORK array, returns
+ these values as the first entries of the WORK and IWORK
+ arrays, and no error message related to LWORK or LIWORK is
+ issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in STGSEN.
+
+ Further details
+ ===============
+
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / RCONDE( 1 ).
+
+ An approximate (asymptotic) bound on the maximum angular error in
+ the computed deflating subspaces is
+
+ EPS * norm((A, B)) / RCONDV( 2 ).
+
+ See LAPACK User's Guide, section 4.11 for more information.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvsl</CODE> - <DD><CODE>jobvsr</CODE> - <DD><CODE>sort</CODE> - <DD><CODE>selctg</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>sdim</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vsl</CODE> - <DD><CODE>ldvsl</CODE> - <DD><CODE>vsr</CODE> - <DD><CODE>ldvsr</CODE> - <DD><CODE>rconde</CODE> - <DD><CODE>rc [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggev(java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sggev</H3>
+<PRE>
+public abstract void <B>sggev</B>(java.lang.String jobvl,
+ java.lang.String jobvr,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j).
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B .
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ alpha/beta. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ.
+ =N+2: error return from STGEVC.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggevx(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], float[], int, int[], boolean[], org.netlib.util.intW)"><!-- --></A><H3>
+sggevx</H3>
+<PRE>
+public abstract void <B>sggevx</B>(java.lang.String balanc,
+ java.lang.String jobvl,
+ java.lang.String jobvr,
+ java.lang.String sense,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ org.netlib.util.intW ilo,
+ org.netlib.util.intW ihi,
+ float[] lscale,
+ float[] rscale,
+ org.netlib.util.floatW abnrm,
+ org.netlib.util.floatW bbnrm,
+ float[] rconde,
+ float[] rcondv,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ boolean[] bwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
+ the eigenvalues (RCONDE), and reciprocal condition numbers for the
+ right eigenvectors (RCONDV).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j) .
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B.
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Specifies the balance option to be performed.
+ = 'N': do not diagonally scale or permute;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+ Computed reciprocal condition numbers will be for the
+ matrices after permuting and/or balancing. Permuting does
+ not change condition numbers (in exact arithmetic), but
+ balancing does.
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': none are computed;
+ = 'E': computed for eigenvalues only;
+ = 'V': computed for eigenvectors only;
+ = 'B': computed for eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then A contains the first part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then B contains the second part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If PL(j) is the index of the
+ row interchanged with row j, and DL(j) is the scaling
+ factor applied to row j, then
+ LSCALE(j) = PL(j) for j = 1,...,ILO-1
+ = DL(j) for j = ILO,...,IHI
+ = PL(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If PR(j) is the index of the
+ column interchanged with column j, and DR(j) is the scaling
+ factor applied to column j, then
+ RSCALE(j) = PR(j) for j = 1,...,ILO-1
+ = DR(j) for j = ILO,...,IHI
+ = PR(j) for j = IHI+1,...,N
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) REAL
+ The one-norm of the balanced matrix A.
+
+ BBNRM (output) REAL
+ The one-norm of the balanced matrix B.
+
+ RCONDE (output) REAL array, dimension (N)
+ If SENSE = 'E' or 'B', the reciprocal condition numbers of
+ the eigenvalues, stored in consecutive elements of the array.
+ For a complex conjugate pair of eigenvalues two consecutive
+ elements of RCONDE are set to the same value. Thus RCONDE(j),
+ RCONDV(j), and the j-th columns of VL and VR all correspond
+ to the j-th eigenpair.
+ If SENSE = 'N' or 'V', RCONDE is not referenced.
+
+ RCONDV (output) REAL array, dimension (N)
+ If SENSE = 'V' or 'B', the estimated reciprocal condition
+ numbers of the eigenvectors, stored in consecutive elements
+ of the array. For a complex eigenvector two consecutive
+ elements of RCONDV are set to the same value. If the
+ eigenvalues cannot be reordered to compute RCONDV(j),
+ RCONDV(j) is set to 0; this can only occur when the true
+ value would be very small anyway.
+ If SENSE = 'N' or 'E', RCONDV is not referenced.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,2*N).
+ If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
+ LWORK >= max(1,6*N).
+ If SENSE = 'E', LWORK >= max(1,10*N).
+ If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N+6)
+ If SENSE = 'E', IWORK is not referenced.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ If SENSE = 'N', BWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ.
+ =N+2: error return from STGEVC.
+
+ Further Details
+ ===============
+
+ Balancing a matrix pair (A,B) includes, first, permuting rows and
+ columns to isolate eigenvalues, second, applying diagonal similarity
+
+ transformation to the rows and columns to make the rows and columns
+ as close in norm as possible. The computed reciprocal condition
+ numbers correspond to the balanced matrix. Permuting rows and columns
+ will not change the condition numbers (in exact arithmetic) but
+ diagonal scaling will. For further explanation of balancing, see
+ section 4.11.1.2 of LAPACK Users' Guide.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)
+
+ An approximate error bound for the angle between the i-th computed
+ eigenvector VL(i) or VR(i) is given by
+
+ EPS * norm(ABNRM, BBNRM) / DIF(i).
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see section 4.11 of LAPACK User's Guide.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>balanc</CODE> - <DD><CODE>jobvl</CODE> - <DD><CODE>jobvr</CODE> - <DD><CODE>sense</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>lscale</CODE> - <DD><CODE>rscale</CO [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggglm(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sggglm</H3>
+<PRE>
+public abstract void <B>sggglm</B>(int n,
+ int m,
+ int p,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] d,
+ float[] x,
+ float[] y,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGGLM solves a general Gauss-Markov linear model (GLM) problem:
+
+ minimize || y ||_2 subject to d = A*x + B*y
+ x
+
+ where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
+ given N-vector. It is assumed that M <= N <= M+P, and
+
+ rank(A) = M and rank( A B ) = N.
+
+ Under these assumptions, the constrained equation is always
+ consistent, and there is a unique solution x and a minimal 2-norm
+ solution y, which is obtained using a generalized QR factorization
+ of the matrices (A, B) given by
+
+ A = Q*(R), B = Q*T*Z.
+ (0)
+
+ In particular, if matrix B is square nonsingular, then the problem
+ GLM is equivalent to the following weighted linear least squares
+ problem
+
+ minimize || inv(B)*(d-A*x) ||_2
+ x
+
+ where inv(B) denotes the inverse of B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. 0 <= M <= N.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= N-M.
+
+ A (input/output) REAL array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the upper triangular part of the array A contains
+ the M-by-M upper triangular matrix R.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)th subdiagonal
+ contain the N-by-P upper trapezoidal matrix T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D is the left hand side of the GLM equation.
+ On exit, D is destroyed.
+
+ X (output) REAL array, dimension (M)
+ Y (output) REAL array, dimension (P)
+ On exit, X and Y are the solutions of the GLM problem.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N+M+P).
+ For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ SGEQRF, SGERQF, SORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with A in the
+
+ generalized QR factorization of the pair (A, B) is
+ singular, so that rank(A) < M; the least squares
+ solution could not be computed.
+ = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal
+ factor T associated with B in the generalized QR
+ factorization of the pair (A, B) is singular, so that
+ rank( A B ) < N; the least squares solution could not
+ be computed.
+
+ ===================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>d</CODE> - <DD><CODE>x</CODE> - <DD><CODE>y</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgghrd(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgghrd</H3>
+<PRE>
+public abstract void <B>sgghrd</B>(java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGHRD reduces a pair of real matrices (A,B) to generalized upper
+ Hessenberg form using orthogonal transformations, where A is a
+ general matrix and B is upper triangular. The form of the
+ generalized eigenvalue problem is
+ A*x = lambda*B*x,
+ and B is typically made upper triangular by computing its QR
+ factorization and moving the orthogonal matrix Q to the left side
+ of the equation.
+
+ This subroutine simultaneously reduces A to a Hessenberg matrix H:
+ Q**T*A*Z = H
+ and transforms B to another upper triangular matrix T:
+ Q**T*B*Z = T
+ in order to reduce the problem to its standard form
+ H*y = lambda*T*y
+ where y = Z**T*x.
+
+ The orthogonal matrices Q and Z are determined as products of Givens
+
+ rotations. They may either be formed explicitly, or they may be
+ postmultiplied into input matrices Q1 and Z1, so that
+
+ Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+
+ Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+
+ If Q1 is the orthogonal matrix from the QR factorization of B in the
+
+ original equation A*x = lambda*B*x, then SGGHRD reduces the original
+
+ problem to generalized Hessenberg form.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'N': do not compute Q;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry,
+ and the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': do not compute Z;
+ = 'I': Z is initialized to the unit matrix, and the
+ orthogonal matrix Z is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry,
+ and the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of A which are to be
+ reduced. It is assumed that A is already upper triangular
+ in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+ normally set by a previous call to SGGBAL; otherwise they
+ should be set to 1 and N respectively.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ rest is set to zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the N-by-N upper triangular matrix B.
+ On exit, the upper triangular matrix T = Q**T B Z. The
+ elements below the diagonal are set to zero.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+ typically from the QR factorization of B.
+ On exit, if COMPQ='I', the orthogonal matrix Q, and if
+ COMPQ = 'V', the product Q1*Q.
+ Not referenced if COMPQ='N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+ On exit, if COMPZ='I', the orthogonal matrix Z, and if
+ COMPZ = 'V', the product Z1*Z.
+ Not referenced if COMPZ='N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z.
+ LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ This routine reduces A to Hessenberg and B to triangular form by
+ an unblocked reduction, as described in _Matrix_Computations_,
+ by Golub and Van Loan (Johns Hopkins Press.)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compq</CODE> - <DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgglse(int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgglse</H3>
+<PRE>
+public abstract void <B>sgglse</B>(int m,
+ int n,
+ int p,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ float[] d,
+ float[] x,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGLSE solves the linear equality-constrained least squares (LSE)
+ problem:
+
+ minimize || c - A*x ||_2 subject to B*x = d
+
+ where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
+ M-vector, and d is a given P-vector. It is assumed that
+ P <= N <= M+P, and
+
+ rank(B) = P and rank( (A) ) = N.
+ ( (B) )
+
+ These conditions ensure that the LSE problem has a unique solution,
+ which is obtained using a generalized RQ factorization of the
+ matrices (B, A) given by
+
+ B = (0 R)*Q, A = Z*T*Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. 0 <= P <= N <= M+P.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the upper triangle of the subarray B(1:P,N-P+1:N)
+ contains the P-by-P upper triangular matrix R.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ C (input/output) REAL array, dimension (M)
+ On entry, C contains the right hand side vector for the
+ least squares part of the LSE problem.
+ On exit, the residual sum of squares for the solution
+ is given by the sum of squares of elements N-P+1 to M of
+ vector C.
+
+ D (input/output) REAL array, dimension (P)
+ On entry, D contains the right hand side vector for the
+ constrained equation.
+ On exit, D is destroyed.
+
+ X (output) REAL array, dimension (N)
+ On exit, X is the solution of the LSE problem.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M+N+P).
+ For optimum performance LWORK >= P+min(M,N)+max(M,N)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ SGEQRF, SGERQF, SORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with B in the
+
+ generalized RQ factorization of the pair (B, A) is
+ singular, so that rank(B) < P; the least squares
+ solution could not be computed.
+ = 2: the (N-P) by (N-P) part of the upper trapezoidal factor
+ T associated with A in the generalized RQ factorization
+ of the pair (B, A) is singular, so that
+ rank( (A) ) < N; the least squares solution could not
+ ( (B) )
+ be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>p</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>x</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggqrf(int, int, int, float[], int, float[], float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sggqrf</H3>
+<PRE>
+public abstract void <B>sggqrf</B>(int n,
+ int m,
+ int p,
+ float[] a,
+ int lda,
+ float[] taua,
+ float[] b,
+ int ldb,
+ float[] taub,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGQRF computes a generalized QR factorization of an N-by-M matrix A
+
+ and an N-by-P matrix B:
+
+ A = Q*R, B = Q*T*Z,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
+ ( 0 ) N-M N M-N
+ M
+
+ where R11 is upper triangular, and
+
+ if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
+ P-N N ( T21 ) P
+ P
+
+ where T12 or T21 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GQR factorization
+
+ of A and B implicitly gives the QR factorization of inv(B)*A:
+
+ inv(B)*A = Z'*(inv(T)*R)
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= 0.
+
+ A (input/output) REAL array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(N,M)-by-M upper trapezoidal matrix R (R is
+ upper triangular if N >= M); the elements below the diagonal,
+ with the array TAUA, represent the orthogonal matrix Q as a
+ product of min(N,M) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAUA (output) REAL array, dimension (min(N,M))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) REAL array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)-th subdiagonal
+
+ contain the N-by-P upper trapezoidal matrix T; the remaining
+
+ elements, with the array TAUB, represent the orthogonal
+ matrix Z as a product of elementary reflectors (see Further
+ Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ TAUB (output) REAL array, dimension (min(N,P))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the QR factorization
+ of an N-by-M matrix, NB2 is the optimal blocksize for the
+ RQ factorization of an N-by-P matrix, and NB3 is the optimal
+
+ blocksize for a call of SORMQR.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(n,m).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine SORGQR.
+ To use Q to update another matrix, use LAPACK subroutine SORMQR.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(n,p).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(p-k+i+1:p) = 0 and v(p-k+i) = 1; v(1:p-k+i-1) is stored on exit in
+
+ B(n-k+i,1:p-k+i-1), and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine SORGRQ.
+ To use Z to update another matrix, use LAPACK subroutine SORMRQ.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>taua</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>taub</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggrqf(int, int, int, float[], int, float[], float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sggrqf</H3>
+<PRE>
+public abstract void <B>sggrqf</B>(int m,
+ int p,
+ int n,
+ float[] a,
+ int lda,
+ float[] taua,
+ float[] b,
+ int ldb,
+ float[] taub,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGRQF computes a generalized RQ factorization of an M-by-N matrix A
+
+ and a P-by-N matrix B:
+
+ A = R*Q, B = Z*T*Q,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
+ N-M M ( R21 ) N
+ N
+
+ where R12 or R21 is upper triangular, and
+
+ if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
+ ( 0 ) P-N P N-P
+ N
+
+ where T11 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GRQ factorization
+
+ of A and B implicitly gives the RQ factorization of A*inv(B):
+
+ A*inv(B) = (R*inv(T))*Z'
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, if M <= N, the upper triangle of the subarray
+ A(1:M,N-M+1:N) contains the M-by-M upper triangular matrix R;
+ if M > N, the elements on and above the (M-N)-th subdiagonal
+
+ contain the M-by-N upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAUA, represent the orthogonal
+ matrix Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAUA (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(P,N)-by-N upper trapezoidal matrix T (T is
+ upper triangular if P >= N); the elements below the diagonal,
+ with the array TAUB, represent the orthogonal matrix Z as a
+ product of elementary reflectors (see Further Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TAUB (output) REAL array, dimension (min(P,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the RQ factorization
+ of an M-by-N matrix, NB2 is the optimal blocksize for the
+ QR factorization of a P-by-N matrix, and NB3 is the optimal
+ blocksize for a call of SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INF0= -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine SORGRQ.
+ To use Q to update another matrix, use LAPACK subroutine SORMRQ.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(p,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i),
+
+ and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine SORGQR.
+ To use Z to update another matrix, use LAPACK subroutine SORMQR.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>taua</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>taub</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggsvd(java.lang.String, java.lang.String, java.lang.String, int, int, int, org.netlib.util.intW, org.netlib.util.intW, float[], int, float[], int, float[], float[], float[], int, float[], int, float[], int, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sggsvd</H3>
+<PRE>
+public abstract void <B>sggsvd</B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int n,
+ int p,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alpha,
+ float[] beta,
+ float[] u,
+ int ldu,
+ float[] v,
+ int ldv,
+ float[] q,
+ int ldq,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGSVD computes the generalized singular value decomposition (GSVD)
+ of an M-by-N real matrix A and P-by-N real matrix B:
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R )
+
+ where U, V and Q are orthogonal matrices, and Z' is the transpose
+ of Z. Let K+L = the effective numerical rank of the matrix (A',B')',
+ then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
+ D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
+ following structures, respectively:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 )
+ L ( 0 0 R22 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The routine computes C, S, R, and optionally the orthogonal
+ transformation matrices U, V and Q.
+
+ In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
+ A and B implicitly gives the SVD of A*inv(B):
+ A*inv(B) = U*(D1*inv(D2))*V'.
+ If ( A',B')' has orthonormal columns, then the GSVD of A and B is
+ also equal to the CS decomposition of A and B. Furthermore, the GSVD
+
+ can be used to derive the solution of the eigenvalue problem:
+ A'*A x = lambda* B'*B x.
+ In some literature, the GSVD of A and B is presented in the form
+ U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 )
+ where U and V are orthogonal and X is nonsingular, D1 and D2 are
+ ``diagonal''. The former GSVD form can be converted to the latter
+ form by taking the nonsingular matrix X as
+
+ X = Q*( I 0 )
+ ( 0 inv(R) ).
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in the Purpose section.
+ K + L = effective numerical rank of (A',B')'.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular matrix R, or part of R.
+ See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix R if M-K-L < 0.
+ See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ ALPHA (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = C,
+ BETA(K+1:K+L) = S,
+ or if M-K-L < 0,
+ ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
+ BETA(K+1:M) =S, BETA(M+1:K+L) =1
+ and
+ ALPHA(K+L+1:N) = 0
+ BETA(K+L+1:N) = 0
+
+ U (output) REAL array, dimension (LDU,M)
+ If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) REAL array, dimension (LDV,P)
+ If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) REAL array,
+ dimension (max(3*N,M,P)+N)
+
+ IWORK (workspace/output) INTEGER array, dimension (N)
+ On exit, IWORK stores the sorting information. More
+ precisely, the following loop will sort ALPHA
+ for I = K+1, min(M,K+L)
+ swap ALPHA(I) and ALPHA(IWORK(I))
+ endfor
+ such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, the Jacobi-type procedure failed to
+ converge. For further details, see subroutine STGSJA.
+
+
+ Internal Parameters
+ ===================
+
+ TOLA REAL
+ TOLB REAL
+ TOLA and TOLB are the thresholds to determine the effective
+ rank of (A',B')'. Generally, they are set to
+ TOLA = MAX(M,N)*norm(A)*MACHEPS,
+ TOLB = MAX(P,N)*norm(B)*MACHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ Further Details
+ ===============
+
+ 2-96 Based on modifications by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobv</CODE> - <DD><CODE>jobq</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>p</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>work</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sggsvp(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float, float, org.netlib.util.intW, org.netlib.util.intW, float[], int, float[], int, float[], int, int[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sggsvp</H3>
+<PRE>
+public abstract void <B>sggsvp</B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float tola,
+ float tolb,
+ org.netlib.util.intW k,
+ org.netlib.util.intW l,
+ float[] u,
+ int ldu,
+ float[] v,
+ int ldv,
+ float[] q,
+ int ldq,
+ int[] iwork,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGSVP computes orthogonal matrices U, V and Q such that
+
+ N-K-L K L
+ U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ V'*B*Q = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
+ numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the
+ transpose of Z.
+
+ This decomposition is the preprocessing step for computing the
+ Generalized Singular Value Decomposition (GSVD), see subroutine
+ SGGSVD.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular (or trapezoidal) matrix
+ described in the Purpose section.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix described in
+ the Purpose section.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) REAL
+ TOLB (input) REAL
+ TOLA and TOLB are the thresholds to determine the effective
+ numerical rank of matrix B and a subblock of A. Generally,
+ they are set to
+ TOLA = MAX(M,N)*norm(A)*MACHEPS,
+ TOLB = MAX(P,N)*norm(B)*MACHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in Purpose.
+ K + L = effective numerical rank of (A',B')'.
+
+ U (output) REAL array, dimension (LDU,M)
+ If JOBU = 'U', U contains the orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) REAL array, dimension (LDV,M)
+ If JOBV = 'V', V contains the orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ TAU (workspace) REAL array, dimension (N)
+
+ WORK (workspace) REAL array, dimension (max(3*N,M,P))
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+
+ Further Details
+ ===============
+
+ The subroutine uses LAPACK subroutine SGEQPF for the QR factorization
+ with column pivoting to detect the effective numerical rank of the
+ a matrix. It may be replaced by a better rank determination strategy.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobv</CODE> - <DD><CODE>jobq</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>tola</CODE> - <DD><CODE>tolb</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>iwork</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgtcon(java.lang.String, int, float[], float[], float[], float[], int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgtcon</H3>
+<PRE>
+public abstract void <B>sgtcon</B>(java.lang.String norm,
+ int n,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTCON estimates the reciprocal of the condition number of a real
+ tridiagonal matrix A using the LU factorization as computed by
+ SGTTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by SGTTRF.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ ANORM (input) REAL
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgtrfs(java.lang.String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgtrfs</H3>
+<PRE>
+public abstract void <B>sgtrfs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] dlf,
+ float[] df,
+ float[] duf,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is tridiagonal, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by SGTTRF.
+
+ DF (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DUF (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SGTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>dlf</CODE> - <DD><CODE>df</CODE> - <DD><CODE>duf</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgtsv(int, int, float[], float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgtsv</H3>
+<PRE>
+public abstract void <B>sgtsv</B>(int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTSV solves the equation
+
+ A*X = B,
+
+ where A is an n by n tridiagonal matrix, by Gaussian elimination with
+ partial pivoting.
+
+ Note that the equation A'*X = B may be solved by interchanging the
+
+ order of the arguments DU and DL.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input/output) REAL array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-2) elements of the
+ second super-diagonal of the upper triangular matrix U from
+ the LU factorization of A, in DL(1), ..., DL(n-2).
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of U.
+
+ DU (input/output) REAL array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N by NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero, and the solution
+ has not been computed. The factorization has not been
+ completed unless i = N.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgtsvx(java.lang.String, java.lang.String, int, int, float[], float[], float[], float[], float[], float[], float[], int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgtsvx</H3>
+<PRE>
+public abstract void <B>sgtsvx</B>(java.lang.String fact,
+ java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] dlf,
+ float[] df,
+ float[] duf,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B or A**T * X = B,
+ where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
+
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
+ as A = L * U, where L is a product of permutation and unit lower
+ bidiagonal matrices and U is upper triangular with nonzeros in
+ only the main diagonal and first two superdiagonals.
+
+ 2. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
+ form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
+ will not be modified.
+ = 'N': The matrix will be copied to DLF, DF, and DUF
+ and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input or output) REAL array, dimension (N-1)
+ If FACT = 'F', then DLF is an input argument and on entry
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A as computed by SGTTRF.
+
+ If FACT = 'N', then DLF is an output argument and on exit
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A.
+
+ DF (input or output) REAL array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ DUF (input or output) REAL array, dimension (N-1)
+ If FACT = 'F', then DUF is an input argument and on entry
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ If FACT = 'N', then DUF is an output argument and on exit
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ DU2 (input or output) REAL array, dimension (N-2)
+ If FACT = 'F', then DU2 is an input argument and on entry
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ If FACT = 'N', then DU2 is an output argument and on exit
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the LU factorization of A as
+
+ computed by SGTTRF.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the LU factorization of A;
+ row i of the matrix was interchanged with row IPIV(i).
+ IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
+ a row interchange was not required.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has not been completed unless i = N, but the
+ factor U is exactly singular, so the solution
+ and error bounds could not be computed.
+ RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>dlf</CODE> - <DD><CODE>df</CODE> - <DD><CODE>duf</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>i [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgttrf(int, float[], float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sgttrf</H3>
+<PRE>
+public abstract void <B>sgttrf</B>(int n,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTTRF computes an LU factorization of a real tridiagonal matrix A
+ using elimination with partial pivoting and row interchanges.
+
+ The factorization has the form
+ A = L * U
+ where L is a product of permutation and unit lower bidiagonal
+ matrices and U is upper triangular with nonzeros in only the main
+ diagonal and first two superdiagonals.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ DL (input/output) REAL array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-1) multipliers that
+ define the matrix L from the LU factorization of A.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of the
+ upper triangular matrix U from the LU factorization of A.
+
+ DU (input/output) REAL array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ DU2 (output) REAL array, dimension (N-2)
+ On exit, DU2 is overwritten by the (n-2) elements of the
+ second super-diagonal of U.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgttrs(java.lang.String, int, int, float[], float[], float[], float[], int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sgttrs</H3>
+<PRE>
+public abstract void <B>sgttrs</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTTRS solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by SGTTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sgtts2(int, int, int, float[], float[], float[], float[], int[], float[], int)"><!-- --></A><H3>
+sgtts2</H3>
+<PRE>
+public abstract void <B>sgtts2</B>(int itrans,
+ int n,
+ int nrhs,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] du2,
+ int[] ipiv,
+ float[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTTS2 solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by SGTTRF.
+
+ Arguments
+ =========
+
+ ITRANS (input) INTEGER
+ Specifies the form of the system of equations.
+ = 0: A * X = B (No transpose)
+ = 1: A'* X = B (Transpose)
+ = 2: A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itrans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>du2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="shgeqz(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+shgeqz</H3>
+<PRE>
+public abstract void <B>shgeqz</B>(java.lang.String job,
+ java.lang.String compq,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] t,
+ int ldt,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+ where H is an upper Hessenberg matrix and T is upper triangular,
+ using the double-shift QZ method.
+ Matrix pairs of this type are produced by the reduction to
+ generalized upper Hessenberg form of a real matrix pair (A,B):
+
+ A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+
+ as computed by SGGHRD.
+
+ If JOB='S', then the Hessenberg-triangular pair (H,T) is
+ also reduced to generalized Schur form,
+
+ H = Q*S*Z**T, T = Q*P*Z**T,
+
+ where Q and Z are orthogonal matrices, P is an upper triangular
+ matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+ diagonal blocks.
+
+ The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+ (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+
+ eigenvalues.
+
+ Additionally, the 2-by-2 upper triangular diagonal blocks of P
+ corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+
+ form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+ P(j,j) > 0, and P(j+1,j+1) > 0.
+
+ Optionally, the orthogonal matrix Q from the generalized Schur
+ factorization may be postmultiplied into an input matrix Q1, and the
+
+ orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+ If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced
+ the matrix pair (A,B) to generalized upper Hessenberg form, then the
+
+ output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+ generalized Schur factorization of (A,B):
+
+ A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+
+ To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently
+ of (A,B)) are computed as a pair of values (alpha,beta), where alpha
+ complex and beta real.
+ If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+ generalized nonsymmetric eigenvalue problem (GNEP)
+ A*x = lambda*B*x
+ and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+ alternate form of the GNEP
+ mu*A*y = B*y.
+ Real eigenvalues can be read directly from the generalized Schur
+ form:
+ alpha = S(i,i), beta = P(i,i).
+
+ Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
+
+ Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
+ pp. 241--256.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': Compute eigenvalues only;
+ = 'S': Compute eigenvalues and the Schur form.
+
+ COMPQ (input) CHARACTER*1
+ = 'N': Left Schur vectors (Q) are not computed;
+ = 'I': Q is initialized to the unit matrix and the matrix Q
+ of left Schur vectors of (H,T) is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry and
+ the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Right Schur vectors (Z) are not computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of right Schur vectors of (H,T) is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry and
+ the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices H, T, Q, and Z. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of H which are in
+ Hessenberg form. It is assumed that A is already upper
+ triangular in rows and columns 1:ILO-1 and IHI+1:N.
+ If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+
+ H (input/output) REAL array, dimension (LDH, N)
+ On entry, the N-by-N upper Hessenberg matrix H.
+ On exit, if JOB = 'S', H contains the upper quasi-triangular
+
+ matrix S from the generalized Schur factorization;
+ 2-by-2 diagonal blocks (corresponding to complex conjugate
+ pairs of eigenvalues) are returned in standard form, with
+ H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+ If JOB = 'E', the diagonal blocks of H match those of S, but
+
+ the rest of H is unspecified.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max( 1, N ).
+
+ T (input/output) REAL array, dimension (LDT, N)
+ On entry, the N-by-N upper triangular matrix T.
+ On exit, if JOB = 'S', T contains the upper triangular
+ matrix P from the generalized Schur factorization;
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of
+ are reduced to positive diagonal form, i.e., if H(j+1,j) is
+ non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+ T(j+1,j+1) > 0.
+ If JOB = 'E', the diagonal blocks of T match those of P, but
+
+ the rest of T is unspecified.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max( 1, N ).
+
+ ALPHAR (output) REAL array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) REAL array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) REAL array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+
+ vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+ of left Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If COMPQ='V' or 'I', then LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of
+ right Schur vectors of (H,T), and if COMPZ = 'V', the
+ orthogonal matrix of right Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If COMPZ='V' or 'I', then LDZ >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1,...,N: the QZ iteration did not converge. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO+1,...,N should be correct.
+ = N+1,...,2*N: the shift calculation failed. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO-N+1,...,N should be correct.
+
+ Further Details
+ ===============
+
+ Iteration counters:
+
+ JITER -- counts iterations.
+ IITER -- counts iterations run since ILAST was last
+ changed. This is therefore reset only when a 1-by-1 or
+ 2-by-2 block deflates off the bottom.
+
+ =====================================================================
+
+ .. Parameters ..
+ $ SAFETY = 1.0E+0 )
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>compq</CODE> - <DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="shsein(java.lang.String, java.lang.String, java.lang.String, boolean[], int, float[], int, float[], float[], float[], int, float[], int, int, org.netlib.util.intW, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+shsein</H3>
+<PRE>
+public abstract void <B>shsein</B>(java.lang.String side,
+ java.lang.String eigsrc,
+ java.lang.String initv,
+ boolean[] select,
+ int n,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ int[] ifaill,
+ int[] ifailr,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SHSEIN uses inverse iteration to find specified right and/or left
+ eigenvectors of a real upper Hessenberg matrix H.
+
+ The right eigenvector x and the left eigenvector y of the matrix H
+ corresponding to an eigenvalue w are defined by:
+
+ H * x = w * x, y**h * H = w * y**h
+
+ where y**h denotes the conjugate transpose of the vector y.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ EIGSRC (input) CHARACTER*1
+ Specifies the source of eigenvalues supplied in (WR,WI):
+ = 'Q': the eigenvalues were found using SHSEQR; thus, if
+ H has zero subdiagonal elements, and so is
+ block-triangular, then the j-th eigenvalue can be
+ assumed to be an eigenvalue of the block containing
+ the j-th row/column. This property allows SHSEIN to
+ perform inverse iteration on just one diagonal block.
+
+ = 'N': no assumptions are made on the correspondence
+ between eigenvalues and diagonal blocks. In this
+ case, SHSEIN must always perform inverse iteration
+ using the whole matrix H.
+
+ INITV (input) CHARACTER*1
+ = 'N': no initial vectors are supplied;
+ = 'U': user-supplied initial vectors are stored in the arrays
+ VL and/or VR.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ Specifies the eigenvectors to be computed. To select the
+ real eigenvector corresponding to a real eigenvalue WR(j),
+ SELECT(j) must be set to .TRUE.. To select the complex
+ eigenvector corresponding to a complex eigenvalue
+ (WR(j),WI(j)), with complex conjugate (WR(j+1),WI(j+1)),
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; then on exit SELECT(j) is .TRUE. and SELECT(j+1) is
+ .FALSE..
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) REAL array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input/output) REAL array, dimension (N)
+ WI (input) REAL array, dimension (N)
+ On entry, the real and imaginary parts of the eigenvalues of
+
+ H; a complex conjugate pair of eigenvalues must be stored in
+
+ consecutive elements of WR and WI.
+ On exit, WR may have been altered since close eigenvalues
+ are perturbed slightly in searching for independent
+ eigenvectors.
+
+ VL (input/output) REAL array, dimension (LDVL,MM)
+ On entry, if INITV = 'U' and SIDE = 'L' or 'B', VL must
+ contain starting vectors for the inverse iteration for the
+ left eigenvectors; the starting vector for each eigenvector
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'L' or 'B', the left eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VL, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'R', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+
+ VR (input/output) REAL array, dimension (LDVR,MM)
+ On entry, if INITV = 'U' and SIDE = 'R' or 'B', VR must
+ contain starting vectors for the inverse iteration for the
+ right eigenvectors; the starting vector for each eigenvector
+
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'R' or 'B', the right eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VR, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'L', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR required to
+
+ store the eigenvectors; each selected real eigenvector
+ occupies one column and each selected complex eigenvector
+ occupies two columns.
+
+ WORK (workspace) REAL array, dimension ((N+2)*N)
+
+ IFAILL (output) INTEGER array, dimension (MM)
+ If SIDE = 'L' or 'B', IFAILL(i) = j > 0 if the left
+ eigenvector in the i-th column of VL (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILL(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VL hold a complex eigenvector, then IFAILL(i) and
+
+ IFAILL(i+1) are set to the same value.
+ If SIDE = 'R', IFAILL is not referenced.
+
+ IFAILR (output) INTEGER array, dimension (MM)
+ If SIDE = 'R' or 'B', IFAILR(i) = j > 0 if the right
+ eigenvector in the i-th column of VR (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILR(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VR hold a complex eigenvector, then IFAILR(i) and
+
+ IFAILR(i+1) are set to the same value.
+ If SIDE = 'L', IFAILR is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, i is the number of eigenvectors which
+ failed to converge; see IFAILL and IFAILR for further
+ details.
+
+ Further Details
+ ===============
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x|+|y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>eigsrc</CODE> - <DD><CODE>initv</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ifaill</CODE> - <DD><CODE>ifailr</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="shseqr(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+shseqr</H3>
+<PRE>
+public abstract void <B>shseqr</B>(java.lang.String job,
+ java.lang.String compz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+ Purpose
+ =======
+
+ SHSEQR computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': compute eigenvalues only;
+ = 'S': compute eigenvalues and the Schur form T.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': no Schur vectors are computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of Schur vectors of H is returned;
+ = 'V': Z must contain an orthogonal matrix Q on entry, and
+
+ the product Q*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to SGEBAL, and then passed to SGEHRD
+
+ when the matrix output by SGEBAL is reduced to Hessenberg
+ form. Otherwise ILO and IHI should be set to 1 and N
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and JOB = 'S', then H contains the
+ upper quasi-triangular matrix T from the Schur decomposition
+ (the Schur form); 2-by-2 diagonal blocks (corresponding to
+ complex conjugate pairs of eigenvalues) are returned in
+ standard form, with H(i,i) = H(i+1,i+1) and
+ H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
+ contents of H are unspecified on exit. (The output value of
+ H when INFO.GT.0 is given under the description of INFO
+ below.)
+
+ Unlike earlier versions of SHSEQR, this subroutine may
+ explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
+ or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues. If two eigenvalues are computed as a complex
+ conjugate pair, they are stored in consecutive elements of
+ WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
+ WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
+
+ the same order as on the diagonal of the Schur form returned
+ in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
+ diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ If COMPZ = 'N', Z is not referenced.
+ If COMPZ = 'I', on entry Z need not be set and on exit,
+ if INFO = 0, Z contains the orthogonal matrix Z of the Schur
+ vectors of H. If COMPZ = 'V', on entry Z must contain an
+ N-by-N matrix Q, which is assumed to be equal to the unit
+ matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
+ if INFO = 0, Z contains Q*Z.
+ Normally Q is the orthogonal matrix generated by SORGHR
+ after the call to SGEHRD which formed the Hessenberg matrix
+
+ H. (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if COMPZ = 'I' or
+ COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then SHSEQR does a workspace query.
+ In this case, SHSEQR checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .LT. 0: if INFO = -i, the i-th argument had an illegal
+ value
+ .GT. 0: if INFO = i, SHSEQR failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and JOB = 'E', then on exit, the
+ remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and JOB = 'S', then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and COMPZ = 'V', then on exit
+
+ (final value of Z) = (initial value of Z)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'I', then on exit
+ (final value of Z) = U
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'N', then Z is not
+ accessed.
+
+ ================================================================
+ Default values supplied by
+ ILAENV(ISPEC,'SHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
+ It is suggested that these defaults be adjusted in order
+ to attain best performance in each particular
+ computational environment.
+
+ ISPEC=1: The SLAHQR vs SLAQR0 crossover point.
+ Default: 75. (Must be at least 11.)
+
+ ISPEC=2: Recommended deflation window size.
+ This depends on ILO, IHI and NS. NS is the
+ number of simultaneous shifts returned
+ by ILAENV(ISPEC=4). (See ISPEC=4 below.)
+ The default for (IHI-ILO+1).LE.500 is NS.
+ The default for (IHI-ILO+1).GT.500 is 3*NS/2.
+
+ ISPEC=3: Nibble crossover point. (See ILAENV for
+ details.) Default: 14% of deflation window
+ size.
+
+ ISPEC=4: Number of simultaneous shifts, NS, in
+ a multi-shift QR iteration.
+
+ If IHI-ILO+1 is ...
+
+ greater than ...but less ... the
+ or equal to ... than default is
+
+ 1 30 NS - 2(+)
+ 30 60 NS - 4(+)
+ 60 150 NS = 10(+)
+ 150 590 NS = **
+ 590 3000 NS = 64
+ 3000 6000 NS = 128
+ 6000 infinity NS = 256
+
+ (+) By default some or all matrices of this order
+ are passed to the implicit double shift routine
+
+ SLAHQR and NS is ignored. See ISPEC=1 above
+ and comments in IPARM for details.
+
+ The asterisks (**) indicate an ad-hoc
+ function of N increasing from 10 to 64.
+
+ ISPEC=5: Select structured matrix multiply.
+ (See ILAENV for details.) Default: 3.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . SLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== NL allocates some local workspace to help small matrices
+ . through a rare SLAHQR failure. NL .GT. NTINY = 11 is
+ . required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
+ . mended. (The default value of NMIN is 75.) Using NL = 49
+ . allows up to six simultaneous shifts and a 16-by-16
+ . deflation window. ====
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sisnan(float)"><!-- --></A><H3>
+sisnan</H3>
+<PRE>
+public boolean <B>sisnan</B>(float sin)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SISNAN returns .TRUE. if its argument is NaN, and .FALSE.
+ otherwise. To be replaced by the Fortran 2003 intrinsic in the
+ future.
+
+ Arguments
+ =========
+
+ SIN (input) REAL
+ Input to test for NaN.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>sin</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slabad(org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slabad</H3>
+<PRE>
+public abstract void <B>slabad</B>(org.netlib.util.floatW small,
+ org.netlib.util.floatW large)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLABAD takes as input the values computed by SLAMCH for underflow and
+ overflow, and returns the square root of each of these values if the
+
+ log of LARGE is sufficiently large. This subroutine is intended to
+ identify machines with a large exponent range, such as the Crays, and
+ redefine the underflow and overflow limits to be the square roots of
+
+ the values computed by SLAMCH. This subroutine is needed because
+ SLAMCH does not compensate for poor arithmetic in the upper half of
+ the exponent range, as is found on a Cray.
+
+ Arguments
+ =========
+
+ SMALL (input/output) REAL
+ On entry, the underflow threshold as computed by SLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of SMALL, otherwise unchanged.
+
+ LARGE (input/output) REAL
+ On entry, the overflow threshold as computed by SLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of LARGE, otherwise unchanged.
+
+ =====================================================================
+
+ .. Intrinsic Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>small</CODE> - <DD><CODE>large</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slabrd(int, int, int, float[], int, float[], float[], float[], float[], float[], int, float[], int)"><!-- --></A><H3>
+slabrd</H3>
+<PRE>
+public abstract void <B>slabrd</B>(int m,
+ int n,
+ int nb,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tauq,
+ float[] taup,
+ float[] x,
+ int ldx,
+ float[] y,
+ int ldy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLABRD reduces the first NB rows and columns of a real general
+ m by n matrix A to upper or lower bidiagonal form by an orthogonal
+ transformation Q' * A * P, and returns the matrices X and Y which
+ are needed to apply the transformation to the unreduced part of A.
+
+ If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
+
+ bidiagonal form.
+
+ This is an auxiliary routine called by SGEBRD
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A.
+
+ N (input) INTEGER
+ The number of columns in the matrix A.
+
+ NB (input) INTEGER
+ The number of leading rows and columns of A to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit, the first NB rows and columns of the matrix are
+ overwritten; the rest of the array is unchanged.
+ If m >= n, elements on and below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors; and
+ elements above the diagonal in the first NB rows, with the
+
+ array TAUP, represent the orthogonal matrix P as a product
+
+ of elementary reflectors.
+ If m < n, elements below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors, and
+ elements on and above the diagonal in the first NB rows,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) REAL array, dimension (NB)
+ The diagonal elements of the first NB rows and columns of
+ the reduced matrix. D(i) = A(i,i).
+
+ E (output) REAL array, dimension (NB)
+ The off-diagonal elements of the first NB rows and columns of
+ the reduced matrix.
+
+ TAUQ (output) REAL array dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) REAL array, dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ X (output) REAL array, dimension (LDX,NB)
+ The m-by-nb matrix X required to update the unreduced part
+ of A.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= M.
+
+ Y (output) REAL array, dimension (LDY,NB)
+ The n-by-nb matrix Y required to update the unreduced part
+ of A.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors.
+
+ If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
+ A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The elements of the vectors v and u together form the m-by-nb matrix
+
+ V and the nb-by-n matrix U' which are needed, with X and Y, to apply
+
+ the transformation to the unreduced part of the matrix, using a block
+ update of the form: A := A - V*Y' - X*U'.
+
+ The contents of A on exit are illustrated by the following examples
+ with nb = 2:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
+ ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
+ ( v1 v2 a a a ) ( v1 1 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix which is unchanged,
+ vi denotes an element of the vector defining H(i), and ui an element
+
+ of the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tauq</CODE> - <DD><CODE>taup</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>ldy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slacn2(int, float[], float[], int[], org.netlib.util.floatW, org.netlib.util.intW, int[])"><!-- --></A><H3>
+slacn2</H3>
+<PRE>
+public void <B>slacn2</B>(int n,
+ float[] v,
+ float[] x,
+ int[] isgn,
+ org.netlib.util.floatW est,
+ org.netlib.util.intW kase,
+ int[] isave)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLACN2 estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) REAL array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) REAL array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and SLACN2 must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) REAL
+ On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
+ unchanged from the previous call to SLACN2.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to SLACN2, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from SLACN2, KASE will again be 0.
+
+ ISAVE (input/output) INTEGER array, dimension (3)
+ ISAVE is used to save variables between calls to SLACN2
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ This is a thread safe version of SLACON, which uses the array ISAVE
+ in place of a SAVE statement, as follows:
+
+ SLACON SLACN2
+ JUMP ISAVE(1)
+ J ISAVE(2)
+ ITER ISAVE(3)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>x</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>est</CODE> - <DD><CODE>kase</CODE> - <DD><CODE>isave</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slacon(int, float[], float[], int[], org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slacon</H3>
+<PRE>
+public abstract void <B>slacon</B>(int n,
+ float[] v,
+ float[] x,
+ int[] isgn,
+ org.netlib.util.floatW est,
+ org.netlib.util.intW kase)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLACON estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) REAL array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) REAL array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and SLACON must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) REAL
+ On entry with KASE = 1 or 2 and JUMP = 3, EST should be
+ unchanged from the previous call to SLACON.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to SLACON, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from SLACON, KASE will again be 0.
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>x</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>est</CODE> - <DD><CODE>kase</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slacpy(java.lang.String, int, int, float[], int, float[], int)"><!-- --></A><H3>
+slacpy</H3>
+<PRE>
+public abstract void <B>slacpy</B>(java.lang.String uplo,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLACPY copies all or part of a two-dimensional matrix A to another
+ matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper triangle
+
+ or trapezoid is accessed; if UPLO = 'L', only the lower
+ triangle or trapezoid is accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) REAL array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sladiv(float, float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+sladiv</H3>
+<PRE>
+public abstract void <B>sladiv</B>(float a,
+ float b,
+ float c,
+ float d,
+ org.netlib.util.floatW p,
+ org.netlib.util.floatW q)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLADIV performs complex division in real arithmetic
+
+ a + i*b
+ p + i*q = ---------
+ c + i*d
+
+ The algorithm is due to Robert L. Smith and can be found
+ in D. Knuth, The art of Computer Programming, Vol.2, p.195
+
+ Arguments
+ =========
+
+ A (input) REAL
+ B (input) REAL
+ C (input) REAL
+ D (input) REAL
+ The scalars a, b, c, and d in the above expression.
+
+ P (output) REAL
+ Q (output) REAL
+ The scalars p and q in the above expression.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>p</CODE> - <DD><CODE>q</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slae2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slae2</H3>
+<PRE>
+public abstract void <B>slae2</B>(float a,
+ float b,
+ float c,
+ org.netlib.util.floatW rt1,
+ org.netlib.util.floatW rt2)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, and RT2
+ is the eigenvalue of smaller absolute value.
+
+ Arguments
+ =========
+
+ A (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) REAL
+ The (1,2) and (2,1) elements of the 2-by-2 matrix.
+
+ C (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) REAL
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) REAL
+ The eigenvalue of smaller absolute value.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rt1</CODE> - <DD><CODE>rt2</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaebz(int, int, int, int, int, int, float, float, float, float[], float[], float[], int[], float[], float[], org.netlib.util.intW, int[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slaebz</H3>
+<PRE>
+public abstract void <B>slaebz</B>(int ijob,
+ int nitmax,
+ int n,
+ int mmax,
+ int minp,
+ int nbmin,
+ float abstol,
+ float reltol,
+ float pivmin,
+ float[] d,
+ float[] e,
+ float[] e2,
+ int[] nval,
+ float[] ab,
+ float[] c,
+ org.netlib.util.intW mout,
+ int[] nab,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEBZ contains the iteration loops which compute and use the
+ function N(w), which is the count of eigenvalues of a symmetric
+ tridiagonal matrix T less than or equal to its argument w. It
+ performs a choice of two types of loops:
+
+ IJOB=1, followed by
+ IJOB=2: It takes as input a list of intervals and returns a list of
+ sufficiently small intervals whose union contains the same
+ eigenvalues as the union of the original intervals.
+ The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
+ The output interval (AB(j,1),AB(j,2)] will contain
+ eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
+
+ IJOB=3: It performs a binary search in each input interval
+ (AB(j,1),AB(j,2)] for a point w(j) such that
+ N(w(j))=NVAL(j), and uses C(j) as the starting point of
+ the search. If such a w(j) is found, then on output
+ AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
+
+ (AB(j,1),AB(j,2)] will be a small interval containing the
+ point where N(w) jumps through NVAL(j), unless that point
+ lies outside the initial interval.
+
+ Note that the intervals are in all cases half-open intervals,
+ i.e., of the form (a,b] , which includes b but not a .
+
+ To avoid underflow, the matrix should be scaled so that its largest
+ element is no greater than overflow**(1/2) * underflow**(1/4)
+ in absolute value. To assure the most accurate computation
+ of small eigenvalues, the matrix should be scaled to be
+ not much smaller than that, either.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966
+
+ Note: the arguments are, in general, *not* checked for unreasonable
+ values.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies what is to be done:
+ = 1: Compute NAB for the initial intervals.
+ = 2: Perform bisection iteration to find eigenvalues of T.
+ = 3: Perform bisection iteration to invert N(w), i.e.,
+ to find a point which has a specified number of
+ eigenvalues of T to its left.
+ Other values will cause SLAEBZ to return with INFO=-1.
+
+ NITMAX (input) INTEGER
+ The maximum number of "levels" of bisection to be
+ performed, i.e., an interval of width W will not be made
+ smaller than 2^(-NITMAX) * W. If not all intervals
+ have converged after NITMAX iterations, then INFO is set
+ to the number of non-converged intervals.
+
+ N (input) INTEGER
+ The dimension n of the tridiagonal matrix T. It must be at
+ least 1.
+
+ MMAX (input) INTEGER
+ The maximum number of intervals. If more than MMAX intervals
+ are generated, then SLAEBZ will quit with INFO=MMAX+1.
+
+ MINP (input) INTEGER
+ The initial number of intervals. It may not be greater than
+
+ MMAX.
+
+ NBMIN (input) INTEGER
+ The smallest number of intervals that should be processed
+ using a vector loop. If zero, then only the scalar loop
+ will be used.
+
+ ABSTOL (input) REAL
+ The minimum (absolute) width of an interval. When an
+ interval is narrower than ABSTOL, or than RELTOL times the
+ larger (in magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. This must be at least
+ zero.
+
+ RELTOL (input) REAL
+ The minimum relative width of an interval. When an interval
+
+ is narrower than ABSTOL, or than RELTOL times the larger (in
+
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ PIVMIN (input) REAL
+ The minimum absolute value of a "pivot" in the Sturm
+ sequence loop. This *must* be at least max |e(j)**2| *
+ safe_min and at least safe_min, where safe_min is at least
+ the smallest number that can divide one without overflow.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N)
+ The offdiagonal elements of the tridiagonal matrix T in
+ positions 1 through N-1. E(N) is arbitrary.
+
+ E2 (input) REAL array, dimension (N)
+ The squares of the offdiagonal elements of the tridiagonal
+ matrix T. E2(N) is ignored.
+
+ NVAL (input/output) INTEGER array, dimension (MINP)
+ If IJOB=1 or 2, not referenced.
+ If IJOB=3, the desired values of N(w). The elements of NVAL
+
+ will be reordered to correspond with the intervals in AB.
+ Thus, NVAL(j) on output will not, in general be the same as
+ NVAL(j) on input, but it will correspond with the interval
+ (AB(j,1),AB(j,2)] on output.
+
+ AB (input/output) REAL array, dimension (MMAX,2)
+ The endpoints of the intervals. AB(j,1) is a(j), the left
+ endpoint of the j-th interval, and AB(j,2) is b(j), the
+ right endpoint of the j-th interval. The input intervals
+ will, in general, be modified, split, and reordered by the
+ calculation.
+
+ C (input/output) REAL array, dimension (MMAX)
+ If IJOB=1, ignored.
+ If IJOB=2, workspace.
+ If IJOB=3, then on input C(j) should be initialized to the
+ first search point in the binary search.
+
+ MOUT (output) INTEGER
+ If IJOB=1, the number of eigenvalues in the intervals.
+ If IJOB=2 or 3, the number of intervals output.
+ If IJOB=3, MOUT will equal MINP.
+
+ NAB (input/output) INTEGER array, dimension (MMAX,2)
+ If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)).
+ If IJOB=2, then on input, NAB(i,j) should be set. It must
+ satisfy the condition:
+ N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)),
+ which means that in interval i only eigenvalues
+ NAB(i,1)+1,...,NAB(i,2) will be considered. Usually,
+ NAB(i,j)=N(AB(i,j)), from a previous call to SLAEBZ with
+ IJOB=1.
+ On output, NAB(i,j) will contain
+ max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of
+
+ the input interval that the output interval
+ (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the
+ the input values of NAB(k,1) and NAB(k,2).
+ If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)),
+ unless N(w) > NVAL(i) for all search points w , in which
+
+ case NAB(i,1) will not be modified, i.e., the output
+ value will be the same as the input value (modulo
+ reorderings -- see NVAL and AB), or unless N(w) < NVAL(i)
+
+ for all search points w , in which case NAB(i,2) will
+ not be modified. Normally, NAB should be set to some
+ distinctive value(s) before SLAEBZ is called.
+
+ WORK (workspace) REAL array, dimension (MMAX)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (MMAX)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: All intervals converged.
+ = 1--MMAX: The last INFO intervals did not converge.
+ = MMAX+1: More than MMAX intervals were generated.
+
+ Further Details
+ ===============
+
+ This routine is intended to be called only by other LAPACK
+ routines, thus the interface is less user-friendly. It is intended
+ for two purposes:
+
+ (a) finding eigenvalues. In this case, SLAEBZ should have one or
+ more initial intervals set up in AB, and SLAEBZ should be called
+
+ with IJOB=1. This sets up NAB, and also counts the eigenvalues.
+
+ Intervals with no eigenvalues would usually be thrown out at
+ this point. Also, if not all the eigenvalues in an interval i
+ are desired, NAB(i,1) can be increased or NAB(i,2) decreased.
+ For example, set NAB(i,1)=NAB(i,2)-1 to get the largest
+ eigenvalue. SLAEBZ is then called with IJOB=2 and MMAX
+ no smaller than the value of MOUT returned by the call with
+ IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1
+ through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the
+ tolerance specified by ABSTOL and RELTOL.
+
+ (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l).
+ In this case, start with a Gershgorin interval (a,b). Set up
+ AB to contain 2 search intervals, both initially (a,b). One
+ NVAL element should contain f-1 and the other should contain l
+ , while C should contain a and b, resp. NAB(i,1) should be -1
+ and NAB(i,2) should be N+1, to flag an error if the desired
+ interval does not lie in (a,b). SLAEBZ is then called with
+ IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals --
+
+ j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while
+ if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r
+ >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and
+ N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and
+ w(l-r)=...=w(l+k) are handled similarly.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ijob</CODE> - <DD><CODE>nitmax</CODE> - <DD><CODE>n</CODE> - <DD><CODE>mmax</CODE> - <DD><CODE>minp</CODE> - <DD><CODE>nbmin</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>reltol</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>nval</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>c</CODE> - <DD><CODE>mout</CODE> - <DD><CODE>nab</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed0(int, int, int, float[], float[], float[], int, float[], int, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slaed0</H3>
+<PRE>
+public abstract void <B>slaed0</B>(int icompq,
+ int qsiz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] q,
+ int ldq,
+ float[] qstore,
+ int ldqs,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED0 computes all eigenvalues and corresponding eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+ = 2: Compute eigenvalues and eigenvectors of tridiagonal
+ matrix.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the main diagonal of the tridiagonal matrix.
+ On exit, its eigenvalues.
+
+ E (input) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, Q must contain an N-by-N orthogonal matrix.
+ If ICOMPQ = 0 Q is not referenced.
+ If ICOMPQ = 1 On entry, Q is a subset of the columns of the
+ orthogonal matrix used to reduce the full
+ matrix to tridiagonal form corresponding to
+ the subset of the full matrix which is being
+
+ decomposed at this time.
+ If ICOMPQ = 2 On entry, Q will be the identity matrix.
+ On exit, Q contains the eigenvectors of the
+ tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If eigenvectors are
+ desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
+
+ QSTORE (workspace) REAL array, dimension (LDQS, N)
+ Referenced only when ICOMPQ = 1. Used to store parts of
+ the eigenvector matrix when the updating matrix multiplies
+ take place.
+
+ LDQS (input) INTEGER
+ The leading dimension of the array QSTORE. If ICOMPQ = 1,
+ then LDQS >= max(1,N). In any case, LDQS >= 1.
+
+ WORK (workspace) REAL array,
+ If ICOMPQ = 0 or 1, the dimension of WORK must be at least
+ 1 + 3*N + 2*N*lg N + 2*N**2
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of WORK must be at least
+ 4*N + N**2.
+
+ IWORK (workspace) INTEGER array,
+ If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
+ 6 + 6*N + 5*N*lg N.
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of IWORK must be at least
+ 3 + 5*N.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>qsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>qstore</CODE> - <DD><CODE>ldqs</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed1(int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slaed1</H3>
+<PRE>
+public abstract void <B>slaed1</B>(int n,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ int cutpnt,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED1 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and eigenvectors of a tridiagonal matrix. SLAED7 handles
+ the case in which eigenvalues only or eigenvalues and eigenvectors
+ of a full symmetric matrix (which was reduced to tridiagonal form)
+ are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLAED2.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine SLAED4 (as called by SLAED3).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ On entry, the permutation which separately sorts the two
+ subproblems in D into ascending order.
+ On exit, the permutation which will reintegrate the
+ subproblems back into sorted order,
+ i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
+
+ RHO (input) REAL
+ The subdiagonal entry used to create the rank-1 modification.
+
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= CUTPNT <= N/2.
+
+ WORK (workspace) REAL array, dimension (4*N + N**2)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>cutpnt</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed2(org.netlib.util.intW, int, int, float[], float[], int, int[], org.netlib.util.floatW, float[], float[], float[], float[], int[], int[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slaed2</H3>
+<PRE>
+public abstract void <B>slaed2</B>(org.netlib.util.intW k,
+ int n,
+ int n1,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ float[] z,
+ float[] dlamda,
+ float[] w,
+ float[] q2,
+ int[] indx,
+ int[] indxc,
+ int[] indxp,
+ int[] coltyp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED2 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation. 0 <= K <=N.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D contains the eigenvalues of the two submatrices to
+ be combined.
+ On exit, D contains the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, Q contains the eigenvectors of two submatrices in
+ the two square blocks with corners at (1,1), (N1,N1)
+ and (N1+1, N1+1), (N,N).
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have N1 added to their
+ values. Destroyed on exit.
+
+ RHO (input/output) REAL
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ SLAED3.
+
+ Z (input) REAL array, dimension (N)
+ On entry, Z contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+ On exit, the contents of Z have been destroyed by the updating
+ process.
+
+ DLAMDA (output) REAL array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ SLAED3 to form the secular equation.
+
+ W (output) REAL array, dimension (N)
+ The first k values of the final deflation-altered z-vector
+ which will be passed to SLAED3.
+
+ Q2 (output) REAL array, dimension (N1**2+(N-N1)**2)
+ A copy of the first K eigenvectors which will be used by
+ SLAED3 in a matrix multiply (SGEMM) to solve for the new
+ eigenvectors.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of DLAMDA into
+ ascending order.
+
+ INDXC (output) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups: the first group contains non-zero
+ elements only at and above N1, the second contains
+ non-zero elements only below N1, and the third is dense.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ During execution, a label which will indicate which of the
+ following types a column in the Q2 matrix is:
+ 1 : non-zero in the upper half only;
+ 2 : dense;
+ 3 : non-zero in the lower half only;
+ 4 : deflated.
+ On exit, COLTYP(i) is the number of columns of type i,
+ for i=1 to 4 only.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>k</CODE> - <DD><CODE>n</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>z</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>q2</CODE> - <DD><CODE>indx</CODE> - <DD><CODE>indxc</CODE> - <DD><CODE>indxp</CODE> - <DD><CODE>coltyp</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed3(int, int, int, float[], float[], int, float, float[], float[], int[], int[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slaed3</H3>
+<PRE>
+public abstract void <B>slaed3</B>(int k,
+ int n,
+ int n1,
+ float[] d,
+ float[] q,
+ int ldq,
+ float rho,
+ float[] dlamda,
+ float[] q2,
+ int[] indx,
+ int[] ctot,
+ float[] w,
+ float[] s,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED3 finds the roots of the secular equation, as defined by the
+ values in D, W, and RHO, between 1 and K. It makes the
+ appropriate calls to SLAED4 and then updates the eigenvectors by
+ multiplying the matrix of eigenvectors of the pair of eigensystems
+ being combined by the matrix of eigenvectors of the K-by-K system
+ which is solved here.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ SLAED4. K >= 0.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (deflation may result in N>K).
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading submatrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (output) REAL array, dimension (N)
+ D(I) contains the updated eigenvalues for
+ 1 <= I <= K.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ Initially the first K columns are used as workspace.
+ On output the columns 1 to K contain
+ the updated eigenvectors.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ RHO (input) REAL
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input/output) REAL array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation. May be changed on output by
+ having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
+
+ Cray-2, or Cray C-90, as described above.
+
+ Q2 (input) REAL array, dimension (LDQ2, N)
+ The first K columns of this matrix contain the non-deflated
+ eigenvectors for the split problem.
+
+ INDX (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups (see SLAED2).
+ The rows of the eigenvectors found by SLAED4 must be likewise
+ permuted before the matrix multiply can take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in Q, as described in INDX. The fourth column type is any
+ column which has been deflated.
+
+ W (input/output) REAL array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector. Destroyed on
+ output.
+
+ S (workspace) REAL array, dimension (N1 + 1)*K
+ Will contain the eigenvectors of the repaired matrix which
+ will be multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max(1,K).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>k</CODE> - <DD><CODE>n</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>q2</CODE> - <DD><CODE>indx</CODE> - <DD><CODE>ctot</CODE> - <DD><CODE>w</CODE> - <DD><CODE>s</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed4(int, int, float[], float[], float[], float, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slaed4</H3>
+<PRE>
+public abstract void <B>slaed4</B>(int n,
+ int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW dlam,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th updated eigenvalue of a symmetric
+ rank-one modification to a diagonal matrix whose elements are
+ given in the array d, and that
+
+ D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) REAL array, dimension (N)
+ The original eigenvalues. It is assumed that they are in
+ order, D(I) < D(J) for I < J.
+
+ Z (input) REAL array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (N)
+ If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5
+
+ for detail. The vector DELTA contains the information necessar
+ to construct the eigenvectors by SLAED3 and SLAED9.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) REAL
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlam</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed5(int, float[], float[], float[], float, org.netlib.util.floatW)"><!-- --></A><H3>
+slaed5</H3>
+<PRE>
+public abstract void <B>slaed5</B>(int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW dlam)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th eigenvalue of a symmetric rank-one
+
+ modification of a 2-by-2 diagonal matrix
+
+ diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal elements in the array D are assumed to satisfy
+
+ D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) REAL array, dimension (2)
+ The original eigenvalues. We assume D(1) < D(2).
+
+ Z (input) REAL array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (2)
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) REAL
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlam</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed6(int, boolean, float, float[], float[], float, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slaed6</H3>
+<PRE>
+public abstract void <B>slaed6</B>(int kniter,
+ boolean orgati,
+ float rho,
+ float[] d,
+ float[] z,
+ float finit,
+ org.netlib.util.floatW tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED6 computes the positive or negative root (closest to the origin)
+ of
+ z(1) z(2) z(3)
+ f(x) = rho + --------- + ---------- + ---------
+ d(1)-x d(2)-x d(3)-x
+
+ It is assumed that
+
+ if ORGATI = .true. the root is between d(2) and d(3);
+ otherwise it is between d(1) and d(2)
+
+ This routine will be called by SLAED4 when necessary. In most cases,
+
+ the root sought is the smallest in magnitude, though it might not be
+
+ in some extremely rare situations.
+
+ Arguments
+ =========
+
+ KNITER (input) INTEGER
+ Refer to SLAED4 for its significance.
+
+ ORGATI (input) LOGICAL
+ If ORGATI is true, the needed root is between d(2) and
+ d(3); otherwise it is between d(1) and d(2). See
+ SLAED4 for further details.
+
+ RHO (input) REAL
+ Refer to the equation f(x) above.
+
+ D (input) REAL array, dimension (3)
+ D satisfies d(1) < d(2) < d(3).
+
+ Z (input) REAL array, dimension (3)
+ Each of the elements in z must be positive.
+
+ FINIT (input) REAL
+ The value of f at 0. It is more accurate than the one
+ evaluated inside this routine (if someone wants to do
+ so).
+
+ TAU (output) REAL
+ The root of the equation f(x).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, failure to converge
+
+ Further Details
+ ===============
+
+ 30/06/99: Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ 10/02/03: This version has a few statements commented out for thread
+ (machine parameters are computed on each entry). SJH.
+
+ 05/10/06: Modified from a new version of Ren-Cang Li, use
+ Gragg-Thornton-Warner cubic convergent scheme for better stability
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>kniter</CODE> - <DD><CODE>orgati</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>finit</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed7(int, int, int, int, int, int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], int[], int[], int[], int[], int[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slaed7</H3>
+<PRE>
+public abstract void <B>slaed7</B>(int icompq,
+ int n,
+ int qsiz,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ int cutpnt,
+ float[] qstore,
+ int[] qptr,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ float[] givnum,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED7 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and optionally eigenvectors of a dense symmetric matrix
+ that has been reduced to tridiagonal form. SLAED1 handles
+ the case in which all eigenvalues and eigenvectors of a symmetric
+ tridiagonal matrix are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLAED8.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine SLAED4 (as called by SLAED9).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= CURLVL <= TLVLS.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (output) INTEGER array, dimension (N)
+ The permutation which will reintegrate the subproblem just
+ solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
+ will be in ascending order.
+
+ RHO (input) REAL
+ The subdiagonal element used to create the rank-1
+ modification.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ QSTORE (input/output) REAL array, dimension (N**2+1)
+ Stores eigenvectors of submatrices encountered during
+ divide and conquer, packed together. QPTR points to
+ beginning of the submatrices.
+
+ QPTR (input/output) INTEGER array, dimension (N+2)
+ List of indices pointing to beginning of submatrices stored
+ in QSTORE. The submatrices are numbered starting at the
+ bottom left of the divide and conquer tree, from left to
+ right and bottom to top.
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and also the size of
+ the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) REAL array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ WORK (workspace) REAL array, dimension (3*N+QSIZ*N)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>qsiz</CODE> - <DD><CODE>tlvls</CODE> - <DD><CODE>curlvl</CODE> - <DD><CODE>curpbm</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>cutpnt</CODE> - <DD><CODE>qstore</CODE> - <DD><CODE>qptr</CODE> - <DD><CODE>prmptr</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>givnum</CODE> - <DD>< [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed8(int, org.netlib.util.intW, int, int, float[], float[], int, int[], org.netlib.util.floatW, int, float[], float[], float[], int, float[], int[], org.netlib.util.intW, int[], float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slaed8</H3>
+<PRE>
+public abstract void <B>slaed8</B>(int icompq,
+ org.netlib.util.intW k,
+ int n,
+ int qsiz,
+ float[] d,
+ float[] q,
+ int ldq,
+ int[] indxq,
+ org.netlib.util.floatW rho,
+ int cutpnt,
+ float[] z,
+ float[] dlamda,
+ float[] q2,
+ int ldq2,
+ float[] w,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ float[] givnum,
+ int[] indxp,
+ int[] indx,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED8 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny element in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the eigenvalues of the two submatrices to be
+ combined. On exit, the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ If ICOMPQ = 0, Q is not referenced. Otherwise,
+ on entry, Q contains the eigenvectors of the partially solved
+
+ system which has been previously updated in matrix
+ multiplies with other partially solved eigensystems.
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have CUTPNT added to
+ their values in order to be accurate.
+
+ RHO (input/output) REAL
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ SLAED3.
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ Z (input) REAL array, dimension (N)
+ On entry, Z contains the updating vector (the last row of
+ the first sub-eigenvector matrix and the first row of the
+ second sub-eigenvector matrix).
+ On exit, the contents of Z are destroyed by the updating
+ process.
+
+ DLAMDA (output) REAL array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ SLAED3 to form the secular equation.
+
+ Q2 (output) REAL array, dimension (LDQ2,N)
+ If ICOMPQ = 0, Q2 is not referenced. Otherwise,
+ a copy of the first K eigenvectors which will be used by
+ SLAED7 in a matrix multiply (SGEMM) to update the new
+ eigenvectors.
+
+ LDQ2 (input) INTEGER
+ The leading dimension of the array Q2. LDQ2 >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ The first k values of the final deflation-altered z-vector and
+ will be passed to SLAED3.
+
+ PERM (output) INTEGER array, dimension (N)
+ The permutations (from deflation and sorting) to be applied
+ to each eigenblock.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (output) INTEGER array, dimension (2, N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (output) REAL array, dimension (2, N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of D into ascending
+
+ order.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>k</CODE> - <DD><CODE>n</CODE> - <DD><CODE>qsiz</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>indxq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>cutpnt</CODE> - <DD><CODE>z</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>q2</CODE> - <DD><CODE>ldq2</CODE> - <DD><CODE>w</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>indxp</CODE> [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaed9(int, int, int, int, float[], float[], int, float, float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slaed9</H3>
+<PRE>
+public abstract void <B>slaed9</B>(int k,
+ int kstart,
+ int kstop,
+ int n,
+ float[] d,
+ float[] q,
+ int ldq,
+ float rho,
+ float[] dlamda,
+ float[] w,
+ float[] s,
+ int lds,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED9 finds the roots of the secular equation, as defined by the
+ values in D, Z, and RHO, between KSTART and KSTOP. It makes the
+ appropriate calls to SLAED4 and then stores the new matrix of
+ eigenvectors for use in calculating the next level of Z vectors.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ SLAED4. K >= 0.
+
+ KSTART (input) INTEGER
+ KSTOP (input) INTEGER
+ The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
+ are to be computed. 1 <= KSTART <= KSTOP <= K.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (delation may result in N > K).
+
+ D (output) REAL array, dimension (N)
+ D(I) contains the updated eigenvalues
+ for KSTART <= I <= KSTOP.
+
+ Q (workspace) REAL array, dimension (LDQ,N)
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max( 1, N ).
+
+ RHO (input) REAL
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input) REAL array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ W (input) REAL array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector.
+
+ S (output) REAL array, dimension (LDS, K)
+ Will contain the eigenvectors of the repaired matrix which
+ will be stored for subsequent Z vector calculation and
+ multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max( 1, K ).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>k</CODE> - <DD><CODE>kstart</CODE> - <DD><CODE>kstop</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dlamda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>s</CODE> - <DD><CODE>lds</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaeda(int, int, int, int, int[], int[], int[], int[], float[], float[], int[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slaeda</H3>
+<PRE>
+public abstract void <B>slaeda</B>(int n,
+ int tlvls,
+ int curlvl,
+ int curpbm,
+ int[] prmptr,
+ int[] perm,
+ int[] givptr,
+ int[] givcol,
+ float[] givnum,
+ float[] q,
+ int[] qptr,
+ float[] z,
+ float[] ztemp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEDA computes the Z vector corresponding to the merge step in the
+ CURLVLth step of the merge process with TLVLS steps for the CURPBMth
+
+ problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= curlvl <= tlvls.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and incidentally the
+ size of the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) REAL array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ Q (input) REAL array, dimension (N**2)
+ Contains the square eigenblocks from previous levels, the
+ starting positions for blocks are given by QPTR.
+
+ QPTR (input) INTEGER array, dimension (N+2)
+ Contains a list of pointers which indicate where in Q an
+ eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
+ the size of the block.
+
+ Z (output) REAL array, dimension (N)
+ On output this vector contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+
+ ZTEMP (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>tlvls</CODE> - <DD><CODE>curlvl</CODE> - <DD><CODE>curpbm</CODE> - <DD><CODE>prmptr</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>q</CODE> - <DD><CODE>qptr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ztemp</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaein(boolean, boolean, int, float[], int, float, float, float[], float[], float[], int, float[], float, float, float, org.netlib.util.intW)"><!-- --></A><H3>
+slaein</H3>
+<PRE>
+public abstract void <B>slaein</B>(boolean rightv,
+ boolean noinit,
+ int n,
+ float[] h,
+ int ldh,
+ float wr,
+ float wi,
+ float[] vr,
+ float[] vi,
+ float[] b,
+ int ldb,
+ float[] work,
+ float eps3,
+ float smlnum,
+ float bignum,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEIN uses inverse iteration to find a right or left eigenvector
+ corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg
+ matrix H.
+
+ Arguments
+ =========
+
+ RIGHTV (input) LOGICAL
+ = .TRUE. : compute right eigenvector;
+ = .FALSE.: compute left eigenvector.
+
+ NOINIT (input) LOGICAL
+ = .TRUE. : no initial vector supplied in (VR,VI).
+ = .FALSE.: initial vector supplied in (VR,VI).
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) REAL array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input) REAL
+ WI (input) REAL
+ The real and imaginary parts of the eigenvalue of H whose
+ corresponding right or left eigenvector is to be computed.
+
+ VR (input/output) REAL array, dimension (N)
+ VI (input/output) REAL array, dimension (N)
+ On entry, if NOINIT = .FALSE. and WI = 0.0, VR must contain
+ a real starting vector for inverse iteration using the real
+ eigenvalue WR; if NOINIT = .FALSE. and WI.ne.0.0, VR and VI
+ must contain the real and imaginary parts of a complex
+ starting vector for inverse iteration using the complex
+ eigenvalue (WR,WI); otherwise VR and VI need not be set.
+ On exit, if WI = 0.0 (real eigenvalue), VR contains the
+ computed real eigenvector; if WI.ne.0.0 (complex eigenvalue),
+ VR and VI contain the real and imaginary parts of the
+ computed complex eigenvector. The eigenvector is normalized
+ so that the component of largest magnitude has magnitude 1;
+ here the magnitude of a complex number (x,y) is taken to be
+ |x| + |y|.
+ VI is not referenced if WI = 0.0.
+
+ B (workspace) REAL array, dimension (LDB,N)
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= N+1.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ EPS3 (input) REAL
+ A small machine-dependent value which is used to perturb
+ close eigenvalues, and to replace zero pivots.
+
+ SMLNUM (input) REAL
+ A machine-dependent value close to the underflow threshold.
+
+ BIGNUM (input) REAL
+ A machine-dependent value close to the overflow threshold.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: inverse iteration did not converge; VR is set to the
+ last iterate, and so is VI if WI.ne.0.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>rightv</CODE> - <DD><CODE>noinit</CODE> - <DD><CODE>n</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>vi</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>work</CODE> - <DD><CODE>eps3</CODE> - <DD><CODE>smlnum</CODE> - <DD><CODE>bignum</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaev2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slaev2</H3>
+<PRE>
+public abstract void <B>slaev2</B>(float a,
+ float b,
+ float c,
+ org.netlib.util.floatW rt1,
+ org.netlib.util.floatW rt2,
+ org.netlib.util.floatW cs1,
+ org.netlib.util.floatW sn1)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
+ eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
+ eigenvector for RT1, giving the decomposition
+
+ [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
+ [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
+
+ Arguments
+ =========
+
+ A (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) REAL
+ The (1,2) element and the conjugate of the (2,1) element of
+ the 2-by-2 matrix.
+
+ C (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) REAL
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) REAL
+ The eigenvalue of smaller absolute value.
+
+ CS1 (output) REAL
+ SN1 (output) REAL
+ The vector (CS1, SN1) is a unit right eigenvector for RT1.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ CS1 and SN1 are accurate to a few ulps barring over/underflow.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rt1</CODE> - <DD><CODE>rt2</CODE> - <DD><CODE>cs1</CODE> - <DD><CODE>sn1</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaexc(boolean, int, float[], int, float[], int, int, int, int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slaexc</H3>
+<PRE>
+public abstract void <B>slaexc</B>(boolean wantq,
+ int n,
+ float[] t,
+ int ldt,
+ float[] q,
+ int ldq,
+ int j1,
+ int n1,
+ int n2,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
+
+ an upper quasi-triangular matrix T by an orthogonal similarity
+ transformation.
+
+ T must be in Schur canonical form, that is, block upper triangular
+ with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
+ has its diagonal elemnts equal and its off-diagonal elements of
+ opposite sign.
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ = .TRUE. : accumulate the transformation in the matrix Q;
+ = .FALSE.: do not accumulate the transformation.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) REAL array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, the updated matrix T, again in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
+ On exit, if WANTQ is .TRUE., the updated matrix Q.
+ If WANTQ is .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
+
+ J1 (input) INTEGER
+ The index of the first row of the first block T11.
+
+ N1 (input) INTEGER
+ The order of the first block T11. N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block T22. N2 = 0, 1 or 2.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: the transformed matrix T would be too far from Schur
+ form; the blocks are not swapped and T and Q are
+ unchanged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>j1</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slag2(float[], int, float[], int, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slag2</H3>
+<PRE>
+public abstract void <B>slag2</B>(float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float safmin,
+ org.netlib.util.floatW scale1,
+ org.netlib.util.floatW scale2,
+ org.netlib.util.floatW wr1,
+ org.netlib.util.floatW wr2,
+ org.netlib.util.floatW wi)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
+ problem A - w B, with scaling as necessary to avoid over-/underflow.
+
+ The scaling factor "s" results in a modified eigenvalue equation
+
+ s A - w B
+
+ where s is a non-negative scaling factor chosen so that w, w B,
+ and s A do not overflow and, if possible, do not underflow, either.
+
+ Arguments
+ =========
+
+ A (input) REAL array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
+
+ is less than 1/SAFMIN. Entries less than
+ sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= 2.
+
+ B (input) REAL array, dimension (LDB, 2)
+ On entry, the 2 x 2 upper triangular matrix B. It is
+ assumed that the one-norm of B is less than 1/SAFMIN. The
+ diagonals should be at least sqrt(SAFMIN) times the largest
+ element of B (in absolute value); if a diagonal is smaller
+ than that, then +/- sqrt(SAFMIN) will be used instead of
+ that diagonal.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= 2.
+
+ SAFMIN (input) REAL
+ The smallest positive number s.t. 1/SAFMIN does not
+ overflow. (This should always be SLAMCH('S') -- it is an
+ argument in order to avoid having to call SLAMCH frequently.)
+
+ SCALE1 (output) REAL
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the first eigenvalue. If
+ the eigenvalues are complex, then the eigenvalues are
+ ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
+ exponent range of the machine), SCALE1=SCALE2, and SCALE1
+ will always be positive. If the eigenvalues are real, then
+ the first (real) eigenvalue is WR1 / SCALE1 , but this may
+ overflow or underflow, and in fact, SCALE1 may be zero or
+ less than the underflow threshhold if the exact eigenvalue
+ is sufficiently large.
+
+ SCALE2 (output) REAL
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the second eigenvalue. If
+
+ the eigenvalues are complex, then SCALE2=SCALE1. If the
+ eigenvalues are real, then the second (real) eigenvalue is
+ WR2 / SCALE2 , but this may overflow or underflow, and in
+ fact, SCALE2 may be zero or less than the underflow
+ threshhold if the exact eigenvalue is sufficiently large.
+
+ WR1 (output) REAL
+ If the eigenvalue is real, then WR1 is SCALE1 times the
+ eigenvalue closest to the (2,2) element of A B**(-1). If the
+ eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
+
+ part of the eigenvalues.
+
+ WR2 (output) REAL
+ If the eigenvalue is real, then WR2 is SCALE2 times the
+ other eigenvalue. If the eigenvalue is complex, then
+ WR1=WR2 is SCALE1 times the real part of the eigenvalues.
+
+ WI (output) REAL
+ If the eigenvalue is real, then WI is zero. If the
+ eigenvalue is complex, then WI is SCALE1 times the imaginary
+
+ part of the eigenvalues. WI will always be non-negative.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>safmin</CODE> - <DD><CODE>scale1</CODE> - <DD><CODE>scale2</CODE> - <DD><CODE>wr1</CODE> - <DD><CODE>wr2</CODE> - <DD><CODE>wi</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slag2d(int, int, float[], int, double[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slag2d</H3>
+<PRE>
+public void <B>slag2d</B>(int m,
+ int n,
+ float[] sa,
+ int ldsa,
+ double[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAG2D converts a SINGLE PRECISION matrix, SA, to a DOUBLE
+ PRECISION matrix, A.
+
+ Note that while it is possible to overflow while converting
+ from double to single, it is not possible to overflow when
+ converting from single to double.
+
+ This is a helper routine so there is no argument checking.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of lines of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ SA (output) REAL array, dimension (LDSA,N)
+ On exit, the M-by-N coefficient matrix SA.
+
+ LDSA (input) INTEGER
+ The leading dimension of the array SA. LDSA >= max(1,M).
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N coefficient matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ =========
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>sa</CODE> - <DD><CODE>ldsa</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slags2(boolean, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slags2</H3>
+<PRE>
+public abstract void <B>slags2</B>(boolean upper,
+ float a1,
+ float a2,
+ float a3,
+ float b1,
+ float b2,
+ float b3,
+ org.netlib.util.floatW csu,
+ org.netlib.util.floatW snu,
+ org.netlib.util.floatW csv,
+ org.netlib.util.floatW snv,
+ org.netlib.util.floatW csq,
+ org.netlib.util.floatW snq)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
+ that if ( UPPER ) then
+
+ U'*A*Q = U'*( A1 A2 )*Q = ( x 0 )
+ ( 0 A3 ) ( x x )
+ and
+ V'*B*Q = V'*( B1 B2 )*Q = ( x 0 )
+ ( 0 B3 ) ( x x )
+
+ or if ( .NOT.UPPER ) then
+
+ U'*A*Q = U'*( A1 0 )*Q = ( x x )
+ ( A2 A3 ) ( 0 x )
+ and
+ V'*B*Q = V'*( B1 0 )*Q = ( x x )
+ ( B2 B3 ) ( 0 x )
+
+ The rows of the transformed A and B are parallel, where
+
+ U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
+ ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
+
+ Z' denotes the transpose of Z.
+
+
+ Arguments
+ =========
+
+ UPPER (input) LOGICAL
+ = .TRUE.: the input matrices A and B are upper triangular.
+ = .FALSE.: the input matrices A and B are lower triangular.
+
+ A1 (input) REAL
+ A2 (input) REAL
+ A3 (input) REAL
+ On entry, A1, A2 and A3 are elements of the input 2-by-2
+ upper (lower) triangular matrix A.
+
+ B1 (input) REAL
+ B2 (input) REAL
+ B3 (input) REAL
+ On entry, B1, B2 and B3 are elements of the input 2-by-2
+ upper (lower) triangular matrix B.
+
+ CSU (output) REAL
+ SNU (output) REAL
+ The desired orthogonal matrix U.
+
+ CSV (output) REAL
+ SNV (output) REAL
+ The desired orthogonal matrix V.
+
+ CSQ (output) REAL
+ SNQ (output) REAL
+ The desired orthogonal matrix Q.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>upper</CODE> - <DD><CODE>a1</CODE> - <DD><CODE>a2</CODE> - <DD><CODE>a3</CODE> - <DD><CODE>b1</CODE> - <DD><CODE>b2</CODE> - <DD><CODE>b3</CODE> - <DD><CODE>csu</CODE> - <DD><CODE>snu</CODE> - <DD><CODE>csv</CODE> - <DD><CODE>snv</CODE> - <DD><CODE>csq</CODE> - <DD><CODE>snq</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slagtf(int, float[], float, float[], float[], float, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slagtf</H3>
+<PRE>
+public abstract void <B>slagtf</B>(int n,
+ float[] a,
+ float lambda,
+ float[] b,
+ float[] c,
+ float tol,
+ float[] d,
+ int[] in,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
+ tridiagonal matrix and lambda is a scalar, as
+
+ T - lambda*I = PLU,
+
+ where P is a permutation matrix, L is a unit lower tridiagonal matrix
+ with at most one non-zero sub-diagonal elements per column and U is
+ an upper triangular matrix with at most two non-zero super-diagonal
+ elements per column.
+
+ The factorization is obtained by Gaussian elimination with partial
+ pivoting and implicit row scaling.
+
+ The parameter LAMBDA is included in the routine so that SLAGTF may
+ be used, in conjunction with SLAGTS, to obtain eigenvectors of T by
+ inverse iteration.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input/output) REAL array, dimension (N)
+ On entry, A must contain the diagonal elements of T.
+
+ On exit, A is overwritten by the n diagonal elements of the
+ upper triangular matrix U of the factorization of T.
+
+ LAMBDA (input) REAL
+ On entry, the scalar lambda.
+
+ B (input/output) REAL array, dimension (N-1)
+ On entry, B must contain the (n-1) super-diagonal elements of
+ T.
+
+ On exit, B is overwritten by the (n-1) super-diagonal
+ elements of the matrix U of the factorization of T.
+
+ C (input/output) REAL array, dimension (N-1)
+ On entry, C must contain the (n-1) sub-diagonal elements of
+ T.
+
+ On exit, C is overwritten by the (n-1) sub-diagonal elements
+
+ of the matrix L of the factorization of T.
+
+ TOL (input) REAL
+ On entry, a relative tolerance used to indicate whether or
+ not the matrix (T - lambda*I) is nearly singular. TOL should
+
+ normally be chose as approximately the largest relative error
+ in the elements of T. For example, if the elements of T are
+ correct to about 4 significant figures, then TOL should be
+ set to about 5*10**(-4). If TOL is supplied as less than eps,
+ where eps is the relative machine precision, then the value
+ eps is used in place of TOL.
+
+ D (output) REAL array, dimension (N-2)
+ On exit, D is overwritten by the (n-2) second super-diagonal
+
+ elements of the matrix U of the factorization of T.
+
+ IN (output) INTEGER array, dimension (N)
+ On exit, IN contains details of the permutation matrix P. If
+
+ an interchange occurred at the kth step of the elimination,
+ then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
+ returns the smallest positive integer j such that
+
+ abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
+
+ where norm( A(j) ) denotes the sum of the absolute values of
+
+ the jth row of the matrix A. If no such j exists then IN(n)
+ is returned as zero. If IN(n) is returned as positive, then a
+ diagonal element of U is small, indicating that
+ (T - lambda*I) is singular or nearly singular,
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -k, the kth argument had an illegal value
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lambda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>tol</CODE> - <DD><CODE>d</CODE> - <DD><CODE>in</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slagtm(java.lang.String, int, int, float, float[], float[], float[], float[], int, float, float[], int)"><!-- --></A><H3>
+slagtm</H3>
+<PRE>
+public abstract void <B>slagtm</B>(java.lang.String trans,
+ int n,
+ int nrhs,
+ float alpha,
+ float[] dl,
+ float[] d,
+ float[] du,
+ float[] x,
+ int ldx,
+ float beta,
+ float[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGTM performs a matrix-vector product of the form
+
+ B := alpha * A * X + beta * B
+
+ where A is a tridiagonal matrix of order N, B and X are N by NRHS
+ matrices, and alpha and beta are real scalars, each of which may be
+ 0., 1., or -1.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': No transpose, B := alpha * A * X + beta * B
+ = 'T': Transpose, B := alpha * A'* X + beta * B
+ = 'C': Conjugate transpose = Transpose
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices X and B.
+
+ ALPHA (input) REAL
+ The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) sub-diagonal elements of T.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of T.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) super-diagonal elements of T.
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The N by NRHS matrix X.
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(N,1).
+
+ BETA (input) REAL
+ The scalar beta. BETA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix B.
+ On exit, B is overwritten by the matrix expression
+ B := alpha * A * X + beta * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(N,1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slagts(int, int, float[], float[], float[], float[], int[], float[], org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slagts</H3>
+<PRE>
+public abstract void <B>slagts</B>(int job,
+ int n,
+ float[] a,
+ float[] b,
+ float[] c,
+ float[] d,
+ int[] in,
+ float[] y,
+ org.netlib.util.floatW tol,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGTS may be used to solve one of the systems of equations
+
+ (T - lambda*I)*x = y or (T - lambda*I)'*x = y,
+
+ where T is an n by n tridiagonal matrix, for x, following the
+ factorization of (T - lambda*I) as
+
+ (T - lambda*I) = P*L*U ,
+
+ by routine SLAGTF. The choice of equation to be solved is
+ controlled by the argument JOB, and in each case there is an option
+ to perturb zero or very small diagonal elements of U, this option
+ being intended for use in applications such as inverse iteration.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ Specifies the job to be performed by SLAGTS as follows:
+ = 1: The equations (T - lambda*I)x = y are to be solved,
+ but diagonal elements of U are not to be perturbed.
+ = -1: The equations (T - lambda*I)x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+ = 2: The equations (T - lambda*I)'x = y are to be solved,
+
+ but diagonal elements of U are not to be perturbed.
+ = -2: The equations (T - lambda*I)'x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input) REAL array, dimension (N)
+ On entry, A must contain the diagonal elements of U as
+ returned from SLAGTF.
+
+ B (input) REAL array, dimension (N-1)
+ On entry, B must contain the first super-diagonal elements of
+ U as returned from SLAGTF.
+
+ C (input) REAL array, dimension (N-1)
+ On entry, C must contain the sub-diagonal elements of L as
+ returned from SLAGTF.
+
+ D (input) REAL array, dimension (N-2)
+ On entry, D must contain the second super-diagonal elements
+ of U as returned from SLAGTF.
+
+ IN (input) INTEGER array, dimension (N)
+ On entry, IN must contain details of the matrix P as returned
+ from SLAGTF.
+
+ Y (input/output) REAL array, dimension (N)
+ On entry, the right hand side vector y.
+ On exit, Y is overwritten by the solution vector x.
+
+ TOL (input/output) REAL
+ On entry, with JOB .lt. 0, TOL should be the minimum
+ perturbation to be made to very small diagonal elements of U.
+ TOL should normally be chosen as about eps*norm(U), where eps
+ is the relative machine precision, but if TOL is supplied as
+
+ non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
+ If JOB .gt. 0 then TOL is not referenced.
+
+ On exit, TOL is changed as described above, only if TOL is
+ non-positive on entry. Otherwise TOL is unchanged.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -i, the i-th argument had an illegal value
+
+ .gt. 0: overflow would occur when computing the INFO(th)
+ element of the solution vector x. This can only occur
+ when JOB is supplied as positive and either means
+ that a diagonal element of U is very small, or that
+ the elements of the right-hand side vector y are very
+ large.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>in</CODE> - <DD><CODE>y</CODE> - <DD><CODE>tol</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slagv2(float[], int, float[], int, float[], float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slagv2</H3>
+<PRE>
+public abstract void <B>slagv2</B>(float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ org.netlib.util.floatW csl,
+ org.netlib.util.floatW snl,
+ org.netlib.util.floatW csr,
+ org.netlib.util.floatW snr)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGV2 computes the Generalized Schur factorization of a real 2-by-2
+
+ matrix pencil (A,B) where B is upper triangular. This routine
+ computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
+ SNR such that
+
+ 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
+ types), then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
+
+ 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
+ then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
+
+ where b11 >= b22 > 0.
+
+
+ Arguments
+ =========
+
+ A (input/output) REAL array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A.
+ On exit, A is overwritten by the ``A-part'' of the
+ generalized Schur form.
+
+ LDA (input) INTEGER
+ THe leading dimension of the array A. LDA >= 2.
+
+ B (input/output) REAL array, dimension (LDB, 2)
+ On entry, the upper triangular 2 x 2 matrix B.
+ On exit, B is overwritten by the ``B-part'' of the
+ generalized Schur form.
+
+ LDB (input) INTEGER
+ THe leading dimension of the array B. LDB >= 2.
+
+ ALPHAR (output) REAL array, dimension (2)
+ ALPHAI (output) REAL array, dimension (2)
+ BETA (output) REAL array, dimension (2)
+ (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
+ pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
+ be zero.
+
+ CSL (output) REAL
+ The cosine of the left rotation matrix.
+
+ SNL (output) REAL
+ The sine of the left rotation matrix.
+
+ CSR (output) REAL
+ The cosine of the right rotation matrix.
+
+ SNR (output) REAL
+ The sine of the right rotation matrix.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>csl</CODE> - <DD><CODE>snl</CODE> - <DD><CODE>csr</CODE> - <DD><CODE>snr</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slahqr(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slahqr</H3>
+<PRE>
+public abstract void <B>slahqr</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAHQR is an auxiliary routine called by SHSEQR to update the
+ eigenvalues and Schur decomposition already computed by SHSEQR, by
+ dealing with the Hessenberg submatrix in rows and columns ILO to
+ IHI.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper quasi-triangular in
+ rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
+ ILO = 1). SLAHQR works primarily with the Hessenberg
+ submatrix in rows and columns ILO to IHI, but applies
+ transformations to all of H if WANTT is .TRUE..
+ 1 <= ILO <= max(1,IHI); IHI <= N.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO is zero and if WANTT is .TRUE., H is upper
+ quasi-triangular in rows and columns ILO:IHI, with any
+ 2-by-2 diagonal blocks in standard form. If INFO is zero
+ and WANTT is .FALSE., the contents of H are unspecified on
+ exit. The output state of H if INFO is nonzero is given
+ below under the description of INFO.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+ eigenvalues ILO to IHI are stored in the corresponding
+ elements of WR and WI. If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
+ eigenvalues are stored in the same order as on the diagonal
+ of the Schur form returned in H, with WR(i) = H(i,i), and, if
+ H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
+ WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ If WANTZ is .TRUE., on entry Z must contain the current
+ matrix Z of transformations accumulated by SHSEQR, and on
+ exit Z has been updated; transformations are applied only to
+
+ the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+ If WANTZ is .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: If INFO = i, SLAHQR failed to compute all the
+ eigenvalues ILO to IHI in a total of 30 iterations
+ per eigenvalue; elements i+1:ihi of WR and WI
+ contain those eigenvalues which have been
+ successfully computed.
+
+ If INFO .GT. 0 and WANTT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the
+ eigenvalues of the upper Hessenberg matrix rows
+ and columns ILO thorugh INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+ (*) (initial value of H)*U = U*(final value of H)
+ where U is an orthognal matrix. The final
+ value of H is upper Hessenberg and triangular in
+ rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+ (final value of Z) = (initial value of Z)*U
+ where U is the orthogonal matrix in (*)
+ (regardless of the value of WANTT.)
+
+ Further Details
+ ===============
+
+ 02-96 Based on modifications by
+ David Day, Sandia National Laboratory, USA
+
+ 12-04 Further modifications by
+ Ralph Byers, University of Kansas, USA
+
+ This is a modified version of SLAHQR from LAPACK version 3.0.
+ It is (1) more robust against overflow and underflow and
+ (2) adopts the more conservative Ahues & Tisseur stopping
+ criterion (LAWN 122, 1997).
+
+ =========================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slahr2(int, int, int, float[], int, float[], float[], int, float[], int)"><!-- --></A><H3>
+slahr2</H3>
+<PRE>
+public void <B>slahr2</B>(int n,
+ int k,
+ int nb,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] t,
+ int ldt,
+ float[] y,
+ int ldy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an auxiliary routine called by SGEHRD.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+ K < N.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N-K+1)
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) REAL array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) REAL array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a a a a a )
+ ( a a a a a )
+ ( a a a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's SLAHRD
+ incorporating improvements proposed by Quintana-Orti and Van de
+ Gejin. Note that the entries of A(1:K,2:NB) differ from those
+ returned by the original LAPACK routine. This function is
+ not backward compatible with LAPACK3.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>y</CODE> - <DD><CODE>ldy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slahrd(int, int, int, float[], int, float[], float[], int, float[], int)"><!-- --></A><H3>
+slahrd</H3>
+<PRE>
+public abstract void <B>slahrd</B>(int n,
+ int k,
+ int nb,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] t,
+ int ldt,
+ float[] y,
+ int ldy)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an OBSOLETE auxiliary routine.
+ This routine will be 'deprecated' in a future release.
+ Please use the new routine SLAHR2 instead.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N-K+1)
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) REAL array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) REAL array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a h a a a )
+ ( a h a a a )
+ ( a h a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>y</CODE> - <DD><CODE>ldy</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaic1(int, int, float[], float, float[], float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slaic1</H3>
+<PRE>
+public abstract void <B>slaic1</B>(int job,
+ int j,
+ float[] x,
+ float sest,
+ float[] w,
+ float gamma,
+ org.netlib.util.floatW sestpr,
+ org.netlib.util.floatW s,
+ org.netlib.util.floatW c)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAIC1 applies one step of incremental condition estimation in
+ its simplest version:
+
+ Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
+ lower triangular matrix L, such that
+ twonorm(L*x) = sest
+ Then SLAIC1 computes sestpr, s, c such that
+ the vector
+ [ s*x ]
+ xhat = [ c ]
+ is an approximate singular vector of
+ [ L 0 ]
+ Lhat = [ w' gamma ]
+ in the sense that
+ twonorm(Lhat*xhat) = sestpr.
+
+ Depending on JOB, an estimate for the largest or smallest singular
+ value is computed.
+
+ Note that [s c]' and sestpr**2 is an eigenpair of the system
+
+ diag(sest*sest, 0) + [alpha gamma] * [ alpha ]
+ [ gamma ]
+
+ where alpha = x'*w.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ = 1: an estimate for the largest singular value is computed.
+
+ = 2: an estimate for the smallest singular value is computed.
+
+ J (input) INTEGER
+ Length of X and W
+
+ X (input) REAL array, dimension (J)
+ The j-vector x.
+
+ SEST (input) REAL
+ Estimated singular value of j by j matrix L
+
+ W (input) REAL array, dimension (J)
+ The j-vector w.
+
+ GAMMA (input) REAL
+ The diagonal element gamma.
+
+ SESTPR (output) REAL
+ Estimated singular value of (j+1) by (j+1) matrix Lhat.
+
+ S (output) REAL
+ Sine needed in forming xhat.
+
+ C (output) REAL
+ Cosine needed in forming xhat.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>j</CODE> - <DD><CODE>x</CODE> - <DD><CODE>sest</CODE> - <DD><CODE>w</CODE> - <DD><CODE>gamma</CODE> - <DD><CODE>sestpr</CODE> - <DD><CODE>s</CODE> - <DD><CODE>c</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaisnan(float, float)"><!-- --></A><H3>
+slaisnan</H3>
+<PRE>
+public boolean <B>slaisnan</B>(float sin1,
+ float sin2)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is not for general use. It exists solely to avoid
+ over-optimization in SISNAN.
+
+ SLAISNAN checks for NaNs by comparing its two arguments for
+ inequality. NaN is the only floating-point value where NaN != NaN
+ returns .TRUE. To check for NaNs, pass the same variable as both
+ arguments.
+
+ Strictly speaking, Fortran does not allow aliasing of function
+ arguments. So a compiler must assume that the two arguments are
+ not the same variable, and the test will not be optimized away.
+ Interprocedural or whole-program optimization may delete this
+ test. The ISNAN functions will be replaced by the correct
+ Fortran 03 intrinsic once the intrinsic is widely available.
+
+ Arguments
+ =========
+
+ SIN1 (input) REAL
+ SIN2 (input) REAL
+ Two numbers to compare for inequality.
+
+ =====================================================================
+
+ .. Executable Statements ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>sin1</CODE> - <DD><CODE>sin2</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaln2(boolean, int, int, float, float, float[], int, float, float, float[], int, float, float, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slaln2</H3>
+<PRE>
+public abstract void <B>slaln2</B>(boolean ltrans,
+ int na,
+ int nw,
+ float smin,
+ float ca,
+ float[] a,
+ int lda,
+ float d1,
+ float d2,
+ float[] b,
+ int ldb,
+ float wr,
+ float wi,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW xnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALN2 solves a system of the form (ca A - w D ) X = s B
+ or (ca A' - w D) X = s B with possible scaling ("s") and
+ perturbation of A. (A' means A-transpose.)
+
+ A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
+ real diagonal matrix, w is a real or complex value, and X and B are
+ NA x 1 matrices -- real if w is real, complex if w is complex. NA
+ may be 1 or 2.
+
+ If w is complex, X and B are represented as NA x 2 matrices,
+ the first column of each being the real part and the second
+ being the imaginary part.
+
+ "s" is a scaling factor (.LE. 1), computed by SLALN2, which is
+ so chosen that X can be computed without overflow. X is further
+ scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
+ than overflow.
+
+ If both singular values of (ca A - w D) are less than SMIN,
+ SMIN*identity will be used instead of (ca A - w D). If only one
+ singular value is less than SMIN, one element of (ca A - w D) will be
+ perturbed enough to make the smallest singular value roughly SMIN.
+ If both singular values are at least SMIN, (ca A - w D) will not be
+ perturbed. In any case, the perturbation will be at most some small
+
+ multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
+ are computed by infinity-norm approximations, and thus will only be
+ correct to a factor of 2 or so.
+
+ Note: all input quantities are assumed to be smaller than overflow
+ by a reasonable factor. (See BIGNUM.)
+
+ Arguments
+ ==========
+
+ LTRANS (input) LOGICAL
+ =.TRUE.: A-transpose will be used.
+ =.FALSE.: A will be used (not transposed.)
+
+ NA (input) INTEGER
+ The size of the matrix A. It may (only) be 1 or 2.
+
+ NW (input) INTEGER
+ 1 if "w" is real, 2 if "w" is complex. It may only be 1
+ or 2.
+
+ SMIN (input) REAL
+ The desired lower bound on the singular values of A. This
+ should be a safe distance away from underflow or overflow,
+ say, between (underflow/machine precision) and (machine
+ precision * overflow ). (See BIGNUM and ULP.)
+
+ CA (input) REAL
+ The coefficient c, which A is multiplied by.
+
+ A (input) REAL array, dimension (LDA,NA)
+ The NA x NA matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of A. It must be at least NA.
+
+ D1 (input) REAL
+ The 1,1 element in the diagonal matrix D.
+
+ D2 (input) REAL
+ The 2,2 element in the diagonal matrix D. Not used if NW=1.
+
+
+ B (input) REAL array, dimension (LDB,NW)
+ The NA x NW matrix B (right-hand side). If NW=2 ("w" is
+ complex), column 1 contains the real part of B and column 2
+ contains the imaginary part.
+
+ LDB (input) INTEGER
+ The leading dimension of B. It must be at least NA.
+
+ WR (input) REAL
+ The real part of the scalar "w".
+
+ WI (input) REAL
+ The imaginary part of the scalar "w". Not used if NW=1.
+
+ X (output) REAL array, dimension (LDX,NW)
+ The NA x NW matrix X (unknowns), as computed by SLALN2.
+ If NW=2 ("w" is complex), on exit, column 1 will contain
+ the real part of X and column 2 will contain the imaginary
+ part.
+
+ LDX (input) INTEGER
+ The leading dimension of X. It must be at least NA.
+
+ SCALE (output) REAL
+ The scale factor that B must be multiplied by to insure
+ that overflow does not occur when computing X. Thus,
+ (ca A - w D) X will be SCALE*B, not B (ignoring
+ perturbations of A.) It will be at most 1.
+
+ XNORM (output) REAL
+ The infinity-norm of X, when X is regarded as an NA x NW
+ real matrix.
+
+ INFO (output) INTEGER
+ An error flag. It will be set to zero if no error occurs,
+ a negative number if an argument is in error, or a positive
+ number if ca A - w D had to be perturbed.
+ The possible values are:
+ = 0: No error occurred, and (ca A - w D) did not have to be
+ perturbed.
+ = 1: (ca A - w D) had to be perturbed to make its smallest
+ (or only) singular value greater than SMIN.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ltrans</CODE> - <DD><CODE>na</CODE> - <DD><CODE>nw</CODE> - <DD><CODE>smin</CODE> - <DD><CODE>ca</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d1</CODE> - <DD><CODE>d2</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>xnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slals0(int, int, int, int, int, float[], int, float[], int, int[], int, int[], int, float[], int, float[], float[], float[], float[], int, float, float, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slals0</H3>
+<PRE>
+public abstract void <B>slals0</B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ int nrhs,
+ float[] b,
+ int ldb,
+ float[] bx,
+ int ldbx,
+ int[] perm,
+ int givptr,
+ int[] givcol,
+ int ldgcol,
+ float[] givnum,
+ int ldgnum,
+ float[] poles,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ int k,
+ float c,
+ float s,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALS0 applies back the multiplying factors of either the left or the
+ right singular vector matrix of a diagonal matrix appended by a row
+ to the right hand side matrix B in solving the least squares problem
+
+ using the divide-and-conquer SVD approach.
+
+ For the left singular vector matrix, three types of orthogonal
+ matrices are involved:
+
+ (1L) Givens rotations: the number of such rotations is GIVPTR; the
+ pairs of columns/rows they were applied to are stored in GIVCOL;
+ and the C- and S-values of these rotations are stored in GIVNUM.
+
+ (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
+
+ row, and for J=2:N, PERM(J)-th row of B is to be moved to the
+ J-th row.
+
+ (3L) The left singular vector matrix of the remaining matrix.
+
+ For the right singular vector matrix, four types of orthogonal
+ matrices are involved:
+
+ (1R) The right singular vector matrix of the remaining matrix.
+
+ (2R) If SQRE = 1, one extra Givens rotation to generate the right
+ null space.
+
+ (3R) The inverse transformation of (2L).
+
+ (4R) The inverse transformation of (1L).
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Left singular vector matrix.
+ = 1: Right singular vector matrix.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) REAL array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB must be at least
+ max(1,MAX( M, N ) ).
+
+ BX (workspace) REAL array, dimension ( LDBX, NRHS )
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ PERM (input) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) applied
+ to the two blocks.
+
+ GIVPTR (input) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of rows/columns
+ involved in a Givens rotation.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (input) REAL array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value used in the
+ corresponding Givens rotation.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of arrays DIFR, POLES and
+ GIVNUM, must be at least K.
+
+ POLES (input) REAL array, dimension ( LDGNUM, 2 )
+ On entry, POLES(1:K, 1) contains the new singular
+ values obtained from solving the secular equation, and
+ POLES(1:K, 2) is an array containing the poles in the secular
+
+ equation.
+
+ DIFL (input) REAL array, dimension ( K ).
+ On entry, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (input) REAL array, dimension ( LDGNUM, 2 ).
+ On entry, DIFR(I, 1) contains the distances between I-th
+ updated (undeflated) singular value and the I+1-th
+ (undeflated) old singular value. And DIFR(I, 2) is the
+ normalizing factor for the I-th right singular vector.
+
+ Z (input) REAL array, dimension ( K )
+ Contain the components of the deflation-adjusted updating row
+
+ vector.
+
+ K (input) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (input) REAL
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (input) REAL
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) REAL array, dimension ( K )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>bx</CODE> - <DD><CODE>ldbx</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>ldgnum</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>k</C [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slalsa(int, int, int, int, float[], int, float[], int, float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slalsa</H3>
+<PRE>
+public abstract void <B>slalsa</B>(int icompq,
+ int smlsiz,
+ int n,
+ int nrhs,
+ float[] b,
+ int ldb,
+ float[] bx,
+ int ldbx,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int[] k,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ float[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ float[] givnum,
+ float[] c,
+ float[] s,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALSA is an itermediate step in solving the least squares problem
+ by computing the SVD of the coefficient matrix in compact form (The
+ singular vectors are computed as products of simple orthorgonal
+ matrices.).
+
+ If ICOMPQ = 0, SLALSA applies the inverse of the left singular vector
+ matrix of an upper bidiagonal matrix to the right hand side; and if
+ ICOMPQ = 1, SLALSA applies the right singular vector matrix to the
+ right hand side. The singular vector matrices were generated in
+ compact form by SLALSA.
+
+ Arguments
+ =========
+
+
+ ICOMPQ (input) INTEGER
+ Specifies whether the left or the right singular vector
+ matrix is involved.
+ = 0: Left singular vector matrix
+ = 1: Right singular vector matrix
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row and column dimensions of the upper bidiagonal matrix.
+
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) REAL array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M.
+ On output, B contains the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,MAX( M, N ) ).
+
+ BX (output) REAL array, dimension ( LDBX, NRHS )
+ On exit, the result of applying the left or right singular
+ vector matrix to B.
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ U (input) REAL array, dimension ( LDU, SMLSIZ ).
+ On entry, U contains the left singular vector matrices of all
+
+ subproblems at the bottom level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR,
+ POLES, GIVNUM, and Z.
+
+ VT (input) REAL array, dimension ( LDU, SMLSIZ+1 ).
+ On entry, VT' contains the right singular vector matrices of
+ all subproblems at the bottom level.
+
+ K (input) INTEGER array, dimension ( N ).
+
+ DIFL (input) REAL array, dimension ( LDU, NLVL ).
+ where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
+
+ DIFR (input) REAL array, dimension ( LDU, 2 * NLVL ).
+ On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
+ distances between singular values on the I-th level and
+ singular values on the (I -1)-th level, and DIFR(*, 2 * I)
+ record the normalizing factors of the right singular vectors
+ matrices of subproblems on I-th level.
+
+ Z (input) REAL array, dimension ( LDU, NLVL ).
+ On entry, Z(1, I) contains the components of the deflation-
+ adjusted updating row vector for subproblems on the I-th
+ level.
+
+ POLES (input) REAL array, dimension ( LDU, 2 * NLVL ).
+ On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
+ singular values involved in the secular equations on the I-th
+
+ level.
+
+ GIVPTR (input) INTEGER array, dimension ( N ).
+ On entry, GIVPTR( I ) records the number of Givens
+ rotations performed on the I-th problem on the computation
+ tree.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
+ On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
+
+ locations of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (input) INTEGER array, dimension ( LDGCOL, NLVL ).
+ On entry, PERM(*, I) records permutations done on the I-th
+ level of the computation tree.
+
+ GIVNUM (input) REAL array, dimension ( LDU, 2 * NLVL ).
+ On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
+ values of Givens rotations performed on the I-th level on the
+
+ computation tree.
+
+ C (input) REAL array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (input) REAL array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ S( I ) contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) REAL array.
+ The dimension must be at least N.
+
+ IWORK (workspace) INTEGER array.
+ The dimension must be at least 3 * N
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>bx</CODE> - <DD><CODE>ldbx</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>k</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>perm</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slalsd(java.lang.String, int, int, int, float[], float[], float[], int, float, org.netlib.util.intW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slalsd</H3>
+<PRE>
+public abstract void <B>slalsd</B>(java.lang.String uplo,
+ int smlsiz,
+ int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb,
+ float rcond,
+ org.netlib.util.intW rank,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALSD uses the singular value decomposition of A to solve the least
+
+ squares problem of finding X to minimize the Euclidean norm of each
+ column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
+ are N-by-NRHS. The solution X overwrites B.
+
+ The singular values of A smaller than RCOND times the largest
+ singular value are treated as zero in solving the least squares
+ problem; in this case a minimum norm solution is returned.
+ The actual singular values are returned in D in ascending order.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': D and E define an upper bidiagonal matrix.
+ = 'L': D and E define a lower bidiagonal matrix.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The dimension of the bidiagonal matrix. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of columns of B. NRHS must be at least 1.
+
+ D (input/output) REAL array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit, if INFO = 0, D contains its singular values.
+
+
+ E (input/output) REAL array, dimension (N-1)
+ Contains the super-diagonal entries of the bidiagonal matrix.
+
+ On exit, E has been destroyed.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On input, B contains the right hand sides of the least
+ squares problem. On output, B contains the solution X.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,N).
+
+ RCOND (input) REAL
+ The singular values of A less than or equal to RCOND times
+ the largest singular value are treated as zero in solving
+ the least squares problem. If RCOND is negative,
+ machine precision is used instead.
+ For example, if diag(S)*X=B were the least squares problem,
+ where diag(S) is a diagonal matrix of singular values, the
+ solution would be X(i) = B(i) / S(i) if S(i) is greater than
+ RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
+ RCOND*max(S).
+
+ RANK (output) INTEGER
+ The number of singular values of A greater than RCOND times
+ the largest singular value.
+
+ WORK (workspace) REAL array, dimension at least
+ (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
+ where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
+
+ IWORK (workspace) INTEGER array, dimension at least
+ (3*N*NLVL + 11*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value while
+
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through MOD(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>rank</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamrg(int, int, float[], int, int, int[])"><!-- --></A><H3>
+slamrg</H3>
+<PRE>
+public abstract void <B>slamrg</B>(int n1,
+ int n2,
+ float[] a,
+ int strd1,
+ int strd2,
+ int[] index)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMRG will create a permutation list which will merge the elements
+ of A (which is composed of two independently sorted sets) into a
+ single set which is sorted in ascending order.
+
+ Arguments
+ =========
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ These arguements contain the respective lengths of the two
+ sorted lists to be merged.
+
+ A (input) REAL array, dimension (N1+N2)
+ The first N1 elements of A contain a list of numbers which
+ are sorted in either ascending or descending order. Likewise
+
+ for the final N2 elements.
+
+ STRD1 (input) INTEGER
+ STRD2 (input) INTEGER
+ These are the strides to be taken through the array A.
+ Allowable strides are 1 and -1. They indicate whether a
+ subset of A is sorted in ascending (STRDx = 1) or descending
+ (STRDx = -1) order.
+
+ INDEX (output) INTEGER array, dimension (N1+N2)
+ On exit this array will contain a permutation such that
+ if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
+ sorted in ascending order.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>a</CODE> - <DD><CODE>strd1</CODE> - <DD><CODE>strd2</CODE> - <DD><CODE>index</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaneg(int, float[], float[], float, float, int)"><!-- --></A><H3>
+slaneg</H3>
+<PRE>
+public int <B>slaneg</B>(int n,
+ float[] d,
+ float[] lld,
+ float sigma,
+ float pivmin,
+ int r)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANEG computes the Sturm count, the number of negative pivots
+ encountered while factoring tridiagonal T - sigma I = L D L^T.
+ This implementation works directly on the factors without forming
+ the tridiagonal matrix T. The Sturm count is also the number of
+ eigenvalues of T less than sigma.
+
+ This routine is called from SLARRB.
+
+ The current routine does not use the PIVMIN parameter but rather
+ requires IEEE-754 propagation of Infinities and NaNs. This
+ routine also has no input range restrictions but does require
+ default exception handling such that x/0 produces Inf when x is
+ non-zero, and Inf/Inf produces NaN. For more information, see:
+
+ Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
+ Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
+ Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
+ (Tech report version in LAWN 172 with the same title.)
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) REAL array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ SIGMA (input) REAL
+ Shift amount in T - sigma I = L D L^T.
+
+ PIVMIN (input) REAL
+ The minimum pivot in the Sturm sequence. May be used
+ when zero pivots are encountered on non-IEEE-754
+ architectures.
+
+ R (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+ Jason Riedy, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>lld</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>r</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slangb(java.lang.String, int, int, int, float[], int, float[])"><!-- --></A><H3>
+slangb</H3>
+<PRE>
+public float <B>slangb</B>(java.lang.String norm,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANGB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
+
+ Description
+ ===========
+
+ SLANGB returns the value
+
+ SLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANGB as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANGB is
+ set to zero.
+
+ KL (input) INTEGER
+ The number of sub-diagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of super-diagonals of the matrix A. KU >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slange(java.lang.String, int, int, float[], int, float[])"><!-- --></A><H3>
+slange</H3>
+<PRE>
+public float <B>slange</B>(java.lang.String norm,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANGE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real matrix A.
+
+ Description
+ ===========
+
+ SLANGE returns the value
+
+ SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANGE as described
+ above.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0. When M = 0,
+ SLANGE is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0. When N = 0,
+
+ SLANGE is set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The m by n matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slangt(java.lang.String, int, float[], float[], float[])"><!-- --></A><H3>
+slangt</H3>
+<PRE>
+public float <B>slangt</B>(java.lang.String norm,
+ int n,
+ float[] dl,
+ float[] d,
+ float[] du)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANGT returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real tridiagonal matrix A.
+
+ Description
+ ===========
+
+ SLANGT returns the value
+
+ SLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANGT as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANGT is
+ set to zero.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) sub-diagonal elements of A.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>dl</CODE> - <DD><CODE>d</CODE> - <DD><CODE>du</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slanhs(java.lang.String, int, float[], int, float[])"><!-- --></A><H3>
+slanhs</H3>
+<PRE>
+public float <B>slanhs</B>(java.lang.String norm,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANHS returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ Hessenberg matrix A.
+
+ Description
+ ===========
+
+ SLANHS returns the value
+
+ SLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANHS as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANHS is
+ set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The n by n upper Hessenberg matrix A; the part of A below the
+ first sub-diagonal is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slansb(java.lang.String, java.lang.String, int, int, float[], int, float[])"><!-- --></A><H3>
+slansb</H3>
+<PRE>
+public float <B>slansb</B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ int k,
+ float[] ab,
+ int ldab,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANSB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n symmetric band matrix A, with k super-diagonals.
+
+ Description
+ ===========
+
+ SLANSB returns the value
+
+ SLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANSB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ band matrix A is supplied.
+ = 'U': Upper triangular part is supplied
+ = 'L': Lower triangular part is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANSB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals or sub-diagonals of the
+ band matrix A. K >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first K+1 rows of AB. The j-th column of A is
+
+ stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slansp(java.lang.String, java.lang.String, int, float[], float[])"><!-- --></A><H3>
+slansp</H3>
+<PRE>
+public float <B>slansp</B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANSP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ SLANSP returns the value
+
+ SLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANSP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is supplied.
+ = 'U': Upper triangular part of A is supplied
+ = 'L': Lower triangular part of A is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANSP is
+ set to zero.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slanst(java.lang.String, int, float[], float[])"><!-- --></A><H3>
+slanst</H3>
+<PRE>
+public float <B>slanst</B>(java.lang.String norm,
+ int n,
+ float[] d,
+ float[] e)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANST returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric tridiagonal matrix A.
+
+ Description
+ ===========
+
+ SLANST returns the value
+
+ SLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANST as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANST is
+ set to zero.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) sub-diagonal or super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slansy(java.lang.String, java.lang.String, int, float[], int, float[])"><!-- --></A><H3>
+slansy</H3>
+<PRE>
+public float <B>slansy</B>(java.lang.String norm,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANSY returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A.
+
+ Description
+ ===========
+
+ SLANSY returns the value
+
+ SLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANSY as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is to be referenced.
+ = 'U': Upper triangular part of A is referenced
+ = 'L': Lower triangular part of A is referenced
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANSY is
+ set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slantb(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[])"><!-- --></A><H3>
+slantb</H3>
+<PRE>
+public float <B>slantb</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int k,
+ float[] ab,
+ int ldab,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANTB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n triangular band matrix A, with ( k + 1 ) diagonals.
+
+ Description
+ ===========
+
+ SLANTB returns the value
+
+ SLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANTB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANTB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals of the matrix A if UPLO = 'L'.
+ K >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first k+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+ Note that when DIAG = 'U', the elements of the array AB
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slantp(java.lang.String, java.lang.String, java.lang.String, int, float[], float[])"><!-- --></A><H3>
+slantp</H3>
+<PRE>
+public float <B>slantp</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANTP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ triangular matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ SLANTP returns the value
+
+ SLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANTP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANTP is
+ set to zero.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ Note that when DIAG = 'U', the elements of the array AP
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slantr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[])"><!-- --></A><H3>
+slantr</H3>
+<PRE>
+public float <B>slantr</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANTR returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ trapezoidal or triangular matrix A.
+
+ Description
+ ===========
+
+ SLANTR returns the value
+
+ SLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANTR as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower trapezoidal.
+ = 'U': Upper trapezoidal
+ = 'L': Lower trapezoidal
+ Note that A is triangular instead of trapezoidal if M = N.
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A has unit diagonal.
+ = 'N': Non-unit diagonal
+ = 'U': Unit diagonal
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0, and if
+ UPLO = 'U', M <= N. When M = 0, SLANTR is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0, and if
+ UPLO = 'L', N <= M. When N = 0, SLANTR is set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The trapezoidal matrix A (A is triangular if M = N).
+ If UPLO = 'U', the leading m by n upper trapezoidal part of
+ the array A contains the upper trapezoidal matrix, and the
+ strictly lower triangular part of A is not referenced.
+ If UPLO = 'L', the leading m by n lower trapezoidal part of
+ the array A contains the lower trapezoidal matrix, and the
+ strictly upper triangular part of A is not referenced. Note
+
+ that when DIAG = 'U', the diagonal elements of A are not
+ referenced and are assumed to be one.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slanv2(org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slanv2</H3>
+<PRE>
+public abstract void <B>slanv2</B>(org.netlib.util.floatW a,
+ org.netlib.util.floatW b,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW d,
+ org.netlib.util.floatW rt1r,
+ org.netlib.util.floatW rt1i,
+ org.netlib.util.floatW rt2r,
+ org.netlib.util.floatW rt2i,
+ org.netlib.util.floatW cs,
+ org.netlib.util.floatW sn)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
+ matrix in standard form:
+
+ [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
+ [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
+
+ where either
+ 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
+ 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
+ conjugate eigenvalues.
+
+ Arguments
+ =========
+
+ A (input/output) REAL
+ B (input/output) REAL
+ C (input/output) REAL
+ D (input/output) REAL
+ On entry, the elements of the input matrix.
+ On exit, they are overwritten by the elements of the
+ standardised Schur form.
+
+ RT1R (output) REAL
+ RT1I (output) REAL
+ RT2R (output) REAL
+ RT2I (output) REAL
+ The real and imaginary parts of the eigenvalues. If the
+ eigenvalues are a complex conjugate pair, RT1I > 0.
+
+ CS (output) REAL
+ SN (output) REAL
+ Parameters of the rotation matrix.
+
+ Further Details
+ ===============
+
+ Modified by V. Sima, Research Institute for Informatics, Bucharest,
+ Romania, to reduce the risk of cancellation errors,
+ when computing real eigenvalues, and to ensure, if possible, that
+ abs(RT1R) >= abs(RT2R).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - <DD><CODE>c</CODE> - <DD><CODE>d</CODE> - <DD><CODE>rt1r</CODE> - <DD><CODE>rt1i</CODE> - <DD><CODE>rt2r</CODE> - <DD><CODE>rt2i</CODE> - <DD><CODE>cs</CODE> - <DD><CODE>sn</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slapll(int, float[], int, float[], int, org.netlib.util.floatW)"><!-- --></A><H3>
+slapll</H3>
+<PRE>
+public abstract void <B>slapll</B>(int n,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ org.netlib.util.floatW ssmin)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given two column vectors X and Y, let
+
+ A = ( X Y ).
+
+ The subroutine first computes the QR factorization of A = Q*R,
+ and then computes the SVD of the 2-by-2 upper triangular matrix R.
+ The smaller singular value of R is returned in SSMIN, which is used
+ as the measurement of the linear dependency of the vectors X and Y.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of the vectors X and Y.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ On entry, X contains the N-vector X.
+ On exit, X is overwritten.
+
+ INCX (input) INTEGER
+ The increment between successive elements of X. INCX > 0.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCY)
+ On entry, Y contains the N-vector Y.
+ On exit, Y is overwritten.
+
+ INCY (input) INTEGER
+ The increment between successive elements of Y. INCY > 0.
+
+ SSMIN (output) REAL
+ The smallest singular value of the N-by-2 matrix A = ( X Y ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>ssmin</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slapmt(boolean, int, int, float[], int, int[])"><!-- --></A><H3>
+slapmt</H3>
+<PRE>
+public abstract void <B>slapmt</B>(boolean forwrd,
+ int m,
+ int n,
+ float[] x,
+ int ldx,
+ int[] k)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAPMT rearranges the columns of the M by N matrix X as specified
+ by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+ If FORWRD = .TRUE., forward permutation:
+
+ X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+
+ If FORWRD = .FALSE., backward permutation:
+
+ X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+
+ Arguments
+ =========
+
+ FORWRD (input) LOGICAL
+ = .TRUE., forward permutation
+ = .FALSE., backward permutation
+
+ M (input) INTEGER
+ The number of rows of the matrix X. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix X. N >= 0.
+
+ X (input/output) REAL array, dimension (LDX,N)
+ On entry, the M by N matrix X.
+ On exit, X contains the permuted matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X, LDX >= MAX(1,M).
+
+ K (input/output) INTEGER array, dimension (N)
+ On entry, K contains the permutation vector. K is used as
+ internal workspace, but reset to its original value on
+ output.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>forwrd</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>k</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slapy2(float, float)"><!-- --></A><H3>
+slapy2</H3>
+<PRE>
+public float <B>slapy2</B>(float x,
+ float y)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+
+ overflow.
+
+ Arguments
+ =========
+
+ X (input) REAL
+ Y (input) REAL
+ X and Y specify the values x and y.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>x</CODE> - <DD><CODE>y</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slapy3(float, float, float)"><!-- --></A><H3>
+slapy3</H3>
+<PRE>
+public float <B>slapy3</B>(float x,
+ float y,
+ float z)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+ unnecessary overflow.
+
+ Arguments
+ =========
+
+ X (input) REAL
+ Y (input) REAL
+ Z (input) REAL
+ X, Y and Z specify the values x, y and z.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>x</CODE> - <DD><CODE>y</CODE> - <DD><CODE>z</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqgb(int, int, int, int, float[], int, float[], float[], float, float, float, org.netlib.util.StringW)"><!-- --></A><H3>
+slaqgb</H3>
+<PRE>
+public abstract void <B>slaqgb</B>(int m,
+ int n,
+ int kl,
+ int ku,
+ float[] ab,
+ int ldab,
+ float[] r,
+ float[] c,
+ float rowcnd,
+ float colcnd,
+ float amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQGB equilibrates a general M by N band matrix A with KL
+ subdiagonals and KU superdiagonals using the row and scaling factors
+
+ in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, the equilibrated matrix, in the same storage format
+
+ as A. See EQUED for the form of the equilibrated matrix.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDA >= KL+KU+1.
+
+ R (input) REAL array, dimension (M)
+ The row scale factors for A.
+
+ C (input) REAL array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) REAL
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) REAL
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqge(int, int, float[], int, float[], float[], float, float, float, org.netlib.util.StringW)"><!-- --></A><H3>
+slaqge</H3>
+<PRE>
+public abstract void <B>slaqge</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] r,
+ float[] c,
+ float rowcnd,
+ float colcnd,
+ float amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQGE equilibrates a general M by N matrix A using the row and
+ column scaling factors in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M by N matrix A.
+ On exit, the equilibrated matrix. See EQUED for the form of
+
+ the equilibrated matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ R (input) REAL array, dimension (M)
+ The row scale factors for A.
+
+ C (input) REAL array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) REAL
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) REAL
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>r</CODE> - <DD><CODE>c</CODE> - <DD><CODE>rowcnd</CODE> - <DD><CODE>colcnd</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqp2(int, int, int, float[], int, int[], float[], float[], float[], float[])"><!-- --></A><H3>
+slaqp2</H3>
+<PRE>
+public abstract void <B>slaqp2</B>(int m,
+ int n,
+ int offset,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] vn1,
+ float[] vn2,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQP2 computes a QR factorization with column pivoting of
+ the block A(OFFSET+1:M,1:N).
+ The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ OFFSET (input) INTEGER
+ The number of rows of the matrix A that must be pivoted
+ but no factorized. OFFSET >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
+ the triangular factor obtained; the elements in block
+ A(OFFSET+1:M,1:N) below the diagonal, together with the
+ array TAU, represent the orthogonal matrix Q as a product of
+
+ elementary reflectors. Block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) REAL array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) REAL array, dimension (N)
+ The vector with the exact column norms.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>vn1</CODE> - <DD><CODE>vn2</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqps(int, int, int, int, org.netlib.util.intW, float[], int, int[], float[], float[], float[], float[], float[], int)"><!-- --></A><H3>
+slaqps</H3>
+<PRE>
+public abstract void <B>slaqps</B>(int m,
+ int n,
+ int offset,
+ int nb,
+ org.netlib.util.intW kb,
+ float[] a,
+ int lda,
+ int[] jpvt,
+ float[] tau,
+ float[] vn1,
+ float[] vn2,
+ float[] auxv,
+ float[] f,
+ int ldf)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQPS computes a step of QR factorization with column pivoting
+ of a real M-by-N matrix A by using Blas-3. It tries to factorize
+ NB columns from A starting from the row OFFSET+1, and updates all
+ of the matrix with Blas-3 xGEMM.
+
+ In some cases, due to catastrophic cancellations, it cannot
+ factorize NB columns. Hence, the actual number of factorized
+ columns is returned in KB.
+
+ Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ OFFSET (input) INTEGER
+ The number of rows of A that have been factorized in
+ previous steps.
+
+ NB (input) INTEGER
+ The number of columns to factorize.
+
+ KB (output) INTEGER
+ The number of columns actually factorized.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, block A(OFFSET+1:M,1:KB) is the triangular
+ factor obtained and block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+ The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
+ been updated.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ JPVT(I) = K <==> Column K of the full matrix A has been
+ permuted into position I in AP.
+
+ TAU (output) REAL array, dimension (KB)
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) REAL array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) REAL array, dimension (N)
+ The vector with the exact column norms.
+
+ AUXV (input/output) REAL array, dimension (NB)
+ Auxiliar vector.
+
+ F (input/output) REAL array, dimension (LDF,NB)
+ Matrix F' = L*Y'*A.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1,N).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>jpvt</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>vn1</CODE> - <DD><CODE>vn2</CODE> - <DD><CODE>auxv</CODE> - <DD><CODE>f</CODE> - <DD><CODE>ldf</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqr0(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slaqr0</H3>
+<PRE>
+public void <B>slaqr0</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQR0 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to SGEBAL, and then passed to SGEHRD when the
+
+ matrix output by SGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) REAL array, dimension (IHI)
+ WI (output) REAL array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) REAL array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then SLAQR0 does a workspace query.
+ In this case, SLAQR0 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, SLAQR0 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . SLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqr1(int, float[], int, float, float, float, float, float[])"><!-- --></A><H3>
+slaqr1</H3>
+<PRE>
+public void <B>slaqr1</B>(int n,
+ float[] h,
+ int ldh,
+ float sr1,
+ float si1,
+ float sr2,
+ float si2,
+ float[] v)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Given a 2-by-2 or 3-by-3 matrix H, SLAQR1 sets v to a
+ scalar multiple of the first column of the product
+
+ (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
+
+ scaling to avoid overflows and most underflows. It
+ is assumed that either
+
+ 1) sr1 = sr2 and si1 = -si2
+ or
+ 2) si1 = si2 = 0.
+
+ This is useful for starting double implicit shift bulges
+ in the QR algorithm.
+
+
+ N (input) integer
+ Order of the matrix H. N must be either 2 or 3.
+
+ H (input) REAL array of dimension (LDH,N)
+ The 2-by-2 or 3-by-3 matrix H in (*).
+
+ LDH (input) integer
+ The leading dimension of H as declared in
+ the calling procedure. LDH.GE.N
+
+ SR1 (input) REAL
+ SI1 The shifts in (*).
+ SR2
+ SI2
+
+ V (output) REAL array of dimension N
+ A scalar multiple of the first column of the
+ matrix K in (*).
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>sr1</CODE> - <DD><CODE>si1</CODE> - <DD><CODE>sr2</CODE> - <DD><CODE>si2</CODE> - <DD><CODE>v</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqr2(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)"><!-- --></A><H3>
+slaqr2</H3>
+<PRE>
+public void <B>slaqr2</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ float[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ float[] sr,
+ float[] si,
+ float[] v,
+ int ldv,
+ int nh,
+ float[] t,
+ int ldt,
+ int nv,
+ float[] wv,
+ int ldwv,
+ float[] work,
+ int lwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ This subroutine is identical to SLAQR3 except that it avoids
+ recursion by calling SLAHQR instead of SLAQR4.
+
+
+
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) REAL array, dimension KBOT
+ SI (output) REAL array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) REAL array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) REAL array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) REAL array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) REAL array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; SLAQR2
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ==================================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ktop</CODE> - <DD><CODE>kbot</CODE> - <DD><CODE>nw</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>ns</CODE> - <DD><CODE>nd</CODE> - <DD><CODE>sr</CODE> - <DD><CODE>si</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>nh</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</COD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqr3(boolean, boolean, int, int, int, int, float[], int, int, int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], float[], float[], int, int, float[], int, int, float[], int, float[], int)"><!-- --></A><H3>
+slaqr3</H3>
+<PRE>
+public void <B>slaqr3</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ktop,
+ int kbot,
+ int nw,
+ float[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW ns,
+ org.netlib.util.intW nd,
+ float[] sr,
+ float[] si,
+ float[] v,
+ int ldv,
+ int nh,
+ float[] t,
+ int ldt,
+ int nv,
+ float[] wv,
+ int ldwv,
+ float[] work,
+ int lwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) REAL array, dimension KBOT
+ SI (output) REAL array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) REAL array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) REAL array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) REAL array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) REAL array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; SLAQR3
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ==================================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ktop</CODE> - <DD><CODE>kbot</CODE> - <DD><CODE>nw</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>ns</CODE> - <DD><CODE>nd</CODE> - <DD><CODE>sr</CODE> - <DD><CODE>si</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>nh</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</COD [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqr4(boolean, boolean, int, int, int, float[], int, float[], float[], int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slaqr4</H3>
+<PRE>
+public void <B>slaqr4</B>(boolean wantt,
+ boolean wantz,
+ int n,
+ int ilo,
+ int ihi,
+ float[] h,
+ int ldh,
+ float[] wr,
+ float[] wi,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ This subroutine implements one level of recursion for SLAQR0.
+ It is a complete implementation of the small bulge multi-shift
+ QR algorithm. It may be called by SLAQR0 and, for large enough
+ deflation window size, it may be called by SLAQR3. This
+ subroutine is identical to SLAQR0 except that it calls SLAQR2
+ instead of SLAQR3.
+
+ Purpose
+ =======
+
+ SLAQR4 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to SGEBAL, and then passed to SGEHRD when the
+
+ matrix output by SGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) REAL array, dimension (IHI)
+ WI (output) REAL array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) REAL array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then SLAQR4 does a workspace query.
+ In this case, SLAQR4 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, SLAQR4 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . SLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqr5(boolean, boolean, int, int, int, int, int, float[], float[], float[], int, int, int, float[], int, float[], int, float[], int, int, float[], int, int, float[], int)"><!-- --></A><H3>
+slaqr5</H3>
+<PRE>
+public void <B>slaqr5</B>(boolean wantt,
+ boolean wantz,
+ int kacc22,
+ int n,
+ int ktop,
+ int kbot,
+ int nshfts,
+ float[] sr,
+ float[] si,
+ float[] h,
+ int ldh,
+ int iloz,
+ int ihiz,
+ float[] z,
+ int ldz,
+ float[] v,
+ int ldv,
+ float[] u,
+ int ldu,
+ int nv,
+ float[] wv,
+ int ldwv,
+ int nh,
+ float[] wh,
+ int ldwh)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ This auxiliary subroutine called by SLAQR0 performs a
+ single small-bulge multi-shift QR sweep.
+
+ WANTT (input) logical scalar
+ WANTT = .true. if the quasi-triangular Schur factor
+ is being computed. WANTT is set to .false. otherwise.
+
+ WANTZ (input) logical scalar
+ WANTZ = .true. if the orthogonal Schur factor is being
+ computed. WANTZ is set to .false. otherwise.
+
+ KACC22 (input) integer with value 0, 1, or 2.
+ Specifies the computation mode of far-from-diagonal
+ orthogonal updates.
+ = 0: SLAQR5 does not accumulate reflections and does not
+ use matrix-matrix multiply to update far-from-diagonal
+ matrix entries.
+ = 1: SLAQR5 accumulates reflections and uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries.
+ = 2: SLAQR5 accumulates reflections, uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries,
+ and takes advantage of 2-by-2 block structure during
+ matrix multiplies.
+
+ N (input) integer scalar
+ N is the order of the Hessenberg matrix H upon which this
+
+ subroutine operates.
+
+ KTOP (input) integer scalar
+ KBOT (input) integer scalar
+ These are the first and last rows and columns of an
+ isolated diagonal block upon which the QR sweep is to be
+ applied. It is assumed without a check that
+ either KTOP = 1 or H(KTOP,KTOP-1) = 0
+ and
+ either KBOT = N or H(KBOT+1,KBOT) = 0.
+
+ NSHFTS (input) integer scalar
+ NSHFTS gives the number of simultaneous shifts. NSHFTS
+ must be positive and even.
+
+ SR (input) REAL array of size (NSHFTS)
+ SI (input) REAL array of size (NSHFTS)
+ SR contains the real parts and SI contains the imaginary
+ parts of the NSHFTS shifts of origin that define the
+ multi-shift QR sweep.
+
+ H (input/output) REAL array of size (LDH,N)
+ On input H contains a Hessenberg matrix. On output a
+ multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
+
+ to the isolated diagonal block in rows and columns KTOP
+ through KBOT.
+
+ LDH (input) integer scalar
+ LDH is the leading dimension of H just as declared in the
+
+ calling procedure. LDH.GE.MAX(1,N).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
+
+ Z (input/output) REAL array of size (LDZ,IHI)
+ If WANTZ = .TRUE., then the QR Sweep orthogonal
+ similarity transformation is accumulated into
+ Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ = .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer scalar
+ LDA is the leading dimension of Z just as declared in
+ the calling procedure. LDZ.GE.N.
+
+ V (workspace) REAL array of size (LDV,NSHFTS/2)
+
+ LDV (input) integer scalar
+ LDV is the leading dimension of V as declared in the
+ calling procedure. LDV.GE.3.
+
+ U (workspace) REAL array of size
+ (LDU,3*NSHFTS-3)
+
+ LDU (input) integer scalar
+ LDU is the leading dimension of U just as declared in the
+
+ in the calling subroutine. LDU.GE.3*NSHFTS-3.
+
+ NH (input) integer scalar
+ NH is the number of columns in array WH available for
+ workspace. NH.GE.1.
+
+ WH (workspace) REAL array of size (LDWH,NH)
+
+ LDWH (input) integer scalar
+ Leading dimension of WH just as declared in the
+ calling procedure. LDWH.GE.3*NSHFTS-3.
+
+ NV (input) integer scalar
+ NV is the number of rows in WV agailable for workspace.
+ NV.GE.1.
+
+ WV (workspace) REAL array of size
+ (LDWV,3*NSHFTS-3)
+
+ LDWV (input) integer scalar
+ LDWV is the leading dimension of WV as declared in the
+ in the calling subroutine. LDWV.GE.NV.
+
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ============================================================
+ Reference:
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and
+ Level 3 Performance, SIAM Journal of Matrix Analysis,
+ volume 23, pages 929--947, 2002.
+
+ ============================================================
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantt</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>kacc22</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ktop</CODE> - <DD><CODE>kbot</CODE> - <DD><CODE>nshfts</CODE> - <DD><CODE>sr</CODE> - <DD><CODE>si</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ldh</CODE> - <DD><CODE>iloz</CODE> - <DD><CODE>ihiz</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>nv</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqsb(java.lang.String, int, int, float[], int, float[], float, float, org.netlib.util.StringW)"><!-- --></A><H3>
+slaqsb</H3>
+<PRE>
+public abstract void <B>slaqsb</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] s,
+ float scond,
+ float amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQSB equilibrates a symmetric band matrix A using the scaling
+ factors in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ S (input) REAL array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) REAL
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqsp(java.lang.String, int, float[], float[], float, float, org.netlib.util.StringW)"><!-- --></A><H3>
+slaqsp</H3>
+<PRE>
+public abstract void <B>slaqsp</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] s,
+ float scond,
+ float amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQSP equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the equilibrated matrix: diag(S) * A * diag(S), in
+
+ the same storage format as A.
+
+ S (input) REAL array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) REAL
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqsy(java.lang.String, int, float[], int, float[], float, float, org.netlib.util.StringW)"><!-- --></A><H3>
+slaqsy</H3>
+<PRE>
+public abstract void <B>slaqsy</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] s,
+ float scond,
+ float amax,
+ org.netlib.util.StringW equed)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQSY equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if EQUED = 'Y', the equilibrated matrix:
+ diag(S) * A * diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ S (input) REAL array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) REAL
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>equed</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaqtr(boolean, boolean, int, float[], int, float[], float, org.netlib.util.floatW, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slaqtr</H3>
+<PRE>
+public abstract void <B>slaqtr</B>(boolean ltran,
+ boolean lreal,
+ int n,
+ float[] t,
+ int ldt,
+ float[] b,
+ float w,
+ org.netlib.util.floatW scale,
+ float[] x,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQTR solves the real quasi-triangular system
+
+ op(T)*p = scale*c, if LREAL = .TRUE.
+
+ or the complex quasi-triangular systems
+
+ op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
+
+ in real arithmetic, where T is upper quasi-triangular.
+ If LREAL = .FALSE., then the first diagonal block of T must be
+ 1 by 1, B is the specially structured matrix
+
+ B = [ b(1) b(2) ... b(n) ]
+ [ w ]
+ [ w ]
+ [ . ]
+ [ w ]
+
+ op(A) = A or A', A' denotes the conjugate transpose of
+ matrix A.
+
+ On input, X = [ c ]. On output, X = [ p ].
+ [ d ] [ q ]
+
+ This subroutine is designed for the condition number estimation
+ in routine STRSNA.
+
+ Arguments
+ =========
+
+ LTRAN (input) LOGICAL
+ On entry, LTRAN specifies the option of conjugate transpose:
+
+ = .FALSE., op(T+i*B) = T+i*B,
+ = .TRUE., op(T+i*B) = (T+i*B)'.
+
+ LREAL (input) LOGICAL
+ On entry, LREAL specifies the input matrix structure:
+ = .FALSE., the input is complex
+ = .TRUE., the input is real
+
+ N (input) INTEGER
+ On entry, N specifies the order of T+i*B. N >= 0.
+
+ T (input) REAL array, dimension (LDT,N)
+ On entry, T contains a matrix in Schur canonical form.
+ If LREAL = .FALSE., then the first diagonal block of T must
+ be 1 by 1.
+
+ LDT (input) INTEGER
+ The leading dimension of the matrix T. LDT >= max(1,N).
+
+ B (input) REAL array, dimension (N)
+ On entry, B contains the elements to form the matrix
+ B as described above.
+ If LREAL = .TRUE., B is not referenced.
+
+ W (input) REAL
+ On entry, W is the diagonal element of the matrix B.
+ If LREAL = .TRUE., W is not referenced.
+
+ SCALE (output) REAL
+ On exit, SCALE is the scale factor.
+
+ X (input/output) REAL array, dimension (2*N)
+ On entry, X contains the right hand side of the system.
+ On exit, X is overwritten by the solution.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: the some diagonal 1 by 1 block has been perturbed by
+
+ a small number SMIN to keep nonsingularity.
+ 2: the some diagonal 2 by 2 block has been perturbed by
+
+ a small number in SLALN2 to keep nonsingularity.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ltran</CODE> - <DD><CODE>lreal</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>b</CODE> - <DD><CODE>w</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>x</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slar1v(int, int, int, float, float[], float[], float[], float[], float, float, float[], boolean, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, int[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, float[])"><!-- --></A><H3>
+slar1v</H3>
+<PRE>
+public void <B>slar1v</B>(int n,
+ int b1,
+ int bn,
+ float lambda,
+ float[] d,
+ float[] l,
+ float[] ld,
+ float[] lld,
+ float pivmin,
+ float gaptol,
+ float[] z,
+ boolean wantnc,
+ org.netlib.util.intW negcnt,
+ org.netlib.util.floatW ztz,
+ org.netlib.util.floatW mingma,
+ org.netlib.util.intW r,
+ int[] isuppz,
+ org.netlib.util.floatW nrminv,
+ org.netlib.util.floatW resid,
+ org.netlib.util.floatW rqcorr,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAR1V computes the (scaled) r-th column of the inverse of
+ the sumbmatrix in rows B1 through BN of the tridiagonal matrix
+ L D L^T - sigma I. When sigma is close to an eigenvalue, the
+ computed vector is an accurate eigenvector. Usually, r corresponds
+ to the index where the eigenvector is largest in magnitude.
+ The following steps accomplish this computation :
+ (a) Stationary qd transform, L D L^T - sigma I = L(+) D(+) L(+)^T,
+ (b) Progressive qd transform, L D L^T - sigma I = U(-) D(-) U(-)^T,
+ (c) Computation of the diagonal elements of the inverse of
+ L D L^T - sigma I by combining the above transforms, and choosing
+ r as the index where the diagonal of the inverse is (one of the)
+
+ largest in magnitude.
+ (d) Computation of the (scaled) r-th column of the inverse using the
+
+ twisted factorization obtained by combining the top part of the
+ the stationary and the bottom part of the progressive transform.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix L D L^T.
+
+ B1 (input) INTEGER
+ First index of the submatrix of L D L^T.
+
+ BN (input) INTEGER
+ Last index of the submatrix of L D L^T.
+
+ LAMBDA (input) REAL
+ The shift. In order to compute an accurate eigenvector,
+ LAMBDA should be a good approximation to an eigenvalue
+ of L D L^T.
+
+ L (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal matrix
+ L, in elements 1 to N-1.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D.
+
+ LD (input) REAL array, dimension (N-1)
+ The n-1 elements L(i)*D(i).
+
+ LLD (input) REAL array, dimension (N-1)
+ The n-1 elements L(i)*L(i)*D(i).
+
+ PIVMIN (input) REAL
+ The minimum pivot in the Sturm sequence.
+
+ GAPTOL (input) REAL
+ Tolerance that indicates when eigenvector entries are neglig
+ w.r.t. their contribution to the residual.
+
+ Z (input/output) REAL array, dimension (N)
+ On input, all entries of Z must be set to 0.
+ On output, Z contains the (scaled) r-th column of the
+ inverse. The scaling is such that Z(R) equals 1.
+
+ WANTNC (input) LOGICAL
+ Specifies whether NEGCNT has to be computed.
+
+ NEGCNT (output) INTEGER
+ If WANTNC is .TRUE. then NEGCNT = the number of pivots < piv
+ in the matrix factorization L D L^T, and NEGCNT = -1 otherw
+
+ ZTZ (output) REAL
+ The square of the 2-norm of Z.
+
+ MINGMA (output) REAL
+ The reciprocal of the largest (in magnitude) diagonal
+ element of the inverse of L D L^T - sigma I.
+
+ R (input/output) INTEGER
+ The twist index for the twisted factorization used to
+ compute Z.
+ On input, 0 <= R <= N. If R is input as 0, R is set to
+ the index where (L D L^T - sigma I)^{-1} is largest
+ in magnitude. If 1 <= R <= N, R is unchanged.
+ On output, R contains the twist index used to compute Z.
+ Ideally, R designates the position of the maximum entry in t
+ eigenvector.
+
+ ISUPPZ (output) INTEGER array, dimension (2)
+ The support of the vector in Z, i.e., the vector Z is
+ nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
+
+ NRMINV (output) REAL
+ NRMINV = 1/SQRT( ZTZ )
+
+ RESID (output) REAL
+ The residual of the FP vector.
+ RESID = ABS( MINGMA )/SQRT( ZTZ )
+
+ RQCORR (output) REAL
+ The Rayleigh Quotient correction to LAMBDA.
+ RQCORR = MINGMA*TMP
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>b1</CODE> - <DD><CODE>bn</CODE> - <DD><CODE>lambda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>l</CODE> - <DD><CODE>ld</CODE> - <DD><CODE>lld</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>gaptol</CODE> - <DD><CODE>z</CODE> - <DD><CODE>wantnc</CODE> - <DD><CODE>negcnt</CODE> - <DD><CODE>ztz</CODE> - <DD><CODE>mingma</CODE> - <DD><CODE>r</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>nrminv</CODE> - <DD><CODE>resid</CODE> - <DD><CODE>rqcorr</CO [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slar2v(int, float[], float[], float[], int, float[], float[], int)"><!-- --></A><H3>
+slar2v</H3>
+<PRE>
+public abstract void <B>slar2v</B>(int n,
+ float[] x,
+ float[] y,
+ float[] z,
+ int incx,
+ float[] c,
+ float[] s,
+ int incc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAR2V applies a vector of real plane rotations from both sides to
+ a sequence of 2-by-2 real symmetric matrices, defined by the elements
+ of the vectors x, y and z. For i = 1,2,...,n
+
+ ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) )
+ ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector y.
+
+ Z (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector z.
+
+ INCX (input) INTEGER
+ The increment between elements of X, Y and Z. INCX > 0.
+
+ C (input) REAL array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) REAL array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>y</CODE> - <DD><CODE>z</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - <DD><CODE>incc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarf(java.lang.String, int, int, float[], int, float, float[], int, float[])"><!-- --></A><H3>
+slarf</H3>
+<PRE>
+public abstract void <B>slarf</B>(java.lang.String side,
+ int m,
+ int n,
+ float[] v,
+ int incv,
+ float tau,
+ float[] c,
+ int Ldc,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARF applies a real elementary reflector H to a real m by n matrix
+ C, from either the left or the right. H is represented in the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) REAL array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of H. V is not used if
+ TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) REAL
+ The value tau in the representation of H.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>incv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarfb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int)"><!-- --></A><H3>
+slarfb</H3>
+<PRE>
+public abstract void <B>slarfb</B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ float[] v,
+ int ldv,
+ float[] t,
+ int ldt,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int ldwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARFB applies a real block reflector H or its transpose H' to a
+ real m by n matrix C, from either the left or the right.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'T': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ V (input) REAL array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,M) if STOREV = 'R' and SIDE = 'L'
+
+ (LDV,N) if STOREV = 'R' and SIDE = 'R'
+
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+ if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+ if STOREV = 'R', LDV >= K.
+
+ T (input) REAL array, dimension (LDT,K)
+ The triangular k by k matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= max(1,M).
+
+ WORK (workspace) REAL array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ldwork</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarfg(int, org.netlib.util.floatW, float[], int, org.netlib.util.floatW)"><!-- --></A><H3>
+slarfg</H3>
+<PRE>
+public abstract void <B>slarfg</B>(int n,
+ org.netlib.util.floatW alpha,
+ float[] x,
+ int incx,
+ org.netlib.util.floatW tau)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARFG generates a real elementary reflector H of order n, such
+ that
+
+ H * ( alpha ) = ( beta ), H' * H = I.
+ ( x ) ( 0 )
+
+ where alpha and beta are scalars, and x is an (n-1)-element real
+ vector. H is represented in the form
+
+ H = I - tau * ( 1 ) * ( 1 v' ) ,
+ ( v )
+
+ where tau is a real scalar and v is a real (n-1)-element
+ vector.
+
+ If the elements of x are all zero, then tau = 0 and H is taken to be
+
+ the unit matrix.
+
+ Otherwise 1 <= tau <= 2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the elementary reflector.
+
+ ALPHA (input/output) REAL
+ On entry, the value alpha.
+ On exit, it is overwritten with the value beta.
+
+ X (input/output) REAL array, dimension
+ (1+(N-2)*abs(INCX))
+ On entry, the vector x.
+ On exit, it is overwritten with the vector v.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ TAU (output) REAL
+ The value tau.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>tau</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarft(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int)"><!-- --></A><H3>
+slarft</H3>
+<PRE>
+public abstract void <B>slarft</B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ float[] v,
+ int ldv,
+ float[] tau,
+ float[] t,
+ int ldt)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ 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'
+
+ 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 * V
+
+ Arguments
+ =========
+
+ DIRECT (input) 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)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) REAL array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ 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 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarfx(java.lang.String, int, int, float[], float, float[], int, float[])"><!-- --></A><H3>
+slarfx</H3>
+<PRE>
+public abstract void <B>slarfx</B>(java.lang.String side,
+ int m,
+ int n,
+ float[] v,
+ float tau,
+ float[] c,
+ int Ldc,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARFX applies a real elementary reflector H to a real m by n
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix
+
+ This version uses inline code if H has order < 11.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) REAL array, dimension (M) if SIDE = 'L'
+ or (N) if SIDE = 'R'
+ The vector v in the representation of H.
+
+ TAU (input) REAL
+ The value tau in the representation of H.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= (1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+ WORK is not referenced if H has order < 11.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slargv(int, float[], int, float[], int, float[], int)"><!-- --></A><H3>
+slargv</H3>
+<PRE>
+public abstract void <B>slargv</B>(int n,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] c,
+ int incc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARGV generates a vector of real plane rotations, determined by
+ elements of the real vectors x and y. For i = 1,2,...,n
+
+ ( c(i) s(i) ) ( x(i) ) = ( a(i) )
+ ( -s(i) c(i) ) ( y(i) ) = ( 0 )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be generated.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ On entry, the vector x.
+ On exit, x(i) is overwritten by a(i), for i = 1,...,n.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCY)
+ On entry, the vector y.
+ On exit, the sines of the plane rotations.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (output) REAL array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C. INCC > 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>c</CODE> - <DD><CODE>incc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarnv(int, int[], int, float[])"><!-- --></A><H3>
+slarnv</H3>
+<PRE>
+public abstract void <B>slarnv</B>(int idist,
+ int[] iseed,
+ int n,
+ float[] x)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARNV returns a vector of n random real numbers from a uniform or
+ normal distribution.
+
+ Arguments
+ =========
+
+ IDIST (input) INTEGER
+ Specifies the distribution of the random numbers:
+ = 1: uniform (0,1)
+ = 2: uniform (-1,1)
+ = 3: normal (0,1)
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated.
+
+ X (output) REAL array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine calls the auxiliary routine SLARUV to generate random
+ real numbers from a uniform (0,1) distribution, in batches of up to
+ 128 using vectorisable code. The Box-Muller method is used to
+ transform numbers from a uniform to a normal distribution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>idist</CODE> - <DD><CODE>iseed</CODE> - <DD><CODE>n</CODE> - <DD><CODE>x</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarra(int, float[], float[], float[], float, float, org.netlib.util.intW, int[], org.netlib.util.intW)"><!-- --></A><H3>
+slarra</H3>
+<PRE>
+public void <B>slarra</B>(int n,
+ float[] d,
+ float[] e,
+ float[] e2,
+ float spltol,
+ float tnrm,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Compute the splitting points with threshold SPLTOL.
+ SLARRA sets any "small" off-diagonal elements to zero.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
+ are set to zero, the other entries of E are untouched.
+
+ E2 (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ SPLTOL (input) REAL
+ The threshold for splitting. Two criteria can be used:
+ SPLTOL<0 : criterion based on absolute off-diagonal value
+ SPLTOL>0 : criterion that preserves relative accuracy
+
+ TNRM (input) REAL
+ The norm of the matrix.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>spltol</CODE> - <DD><CODE>tnrm</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrb(int, float[], float[], int, int, float, float, int, float[], float[], float[], float[], int[], float, float, int, org.netlib.util.intW)"><!-- --></A><H3>
+slarrb</H3>
+<PRE>
+public void <B>slarrb</B>(int n,
+ float[] d,
+ float[] lld,
+ int ifirst,
+ int ilast,
+ float rtol1,
+ float rtol2,
+ int offset,
+ float[] w,
+ float[] wgap,
+ float[] werr,
+ float[] work,
+ int[] iwork,
+ float pivmin,
+ float spdiam,
+ int twist,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the relatively robust representation(RRR) L D L^T, SLARRB
+ does "limited" bisection to refine the eigenvalues of L D L^T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses and their gaps are input in WERR
+ and WGAP, respectively. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) REAL array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL1 (input) REAL
+ RTOL2 (input) REAL
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+ where GAP is the (estimated) distance to the nearest
+ eigenvalue.
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFS
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) REAL array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WGAP (input/output) REAL array, dimension (N-1)
+ On input, the (estimated) gaps between consecutive
+ eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap betwe
+ eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST
+ then WGAP(IFIRST-OFFSET) must be set to ZERO.
+ On output, these gaps are refined.
+
+ WERR (input/output) REAL array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) REAL array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of the matrix.
+
+ TWIST (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+ TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L
+ TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U
+ TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>lld</CODE> - <DD><CODE>ifirst</CODE> - <DD><CODE>ilast</CODE> - <DD><CODE>rtol1</CODE> - <DD><CODE>rtol2</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>w</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>spdiam</CODE> - <DD><CODE>twist</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrc(java.lang.String, int, float, float, float[], float[], float, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+slarrc</H3>
+<PRE>
+public void <B>slarrc</B>(java.lang.String jobt,
+ int n,
+ float vl,
+ float vu,
+ float[] d,
+ float[] e,
+ float pivmin,
+ org.netlib.util.intW eigcnt,
+ org.netlib.util.intW lcnt,
+ org.netlib.util.intW rcnt,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Find the number of eigenvalues of the symmetric tridiagonal matrix T
+
+ that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
+ if JOBT = 'L'.
+
+ Arguments
+ =========
+
+ JOBT (input) CHARACTER*1
+ = 'T': Compute Sturm count for matrix T.
+ = 'L': Compute Sturm count for matrix L D L^T.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ The lower and upper bounds for the eigenvalues.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N diagonal elements of the tridiagonal matrix
+ JOBT = 'L': The N diagonal elements of the diagonal matrix D.
+
+ E (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
+ JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ EIGCNT (output) INTEGER
+ The number of eigenvalues of the symmetric tridiagonal matrix
+ that are in the interval (VL,VU]
+
+ LCNT (output) INTEGER
+ RCNT (output) INTEGER
+ The left and right negcounts of the interval.
+
+ INFO (output) INTEGER
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobt</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>eigcnt</CODE> - <DD><CODE>lcnt</CODE> - <DD><CODE>rcnt</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrd(java.lang.String, java.lang.String, int, float, float, int, int, float[], float, float[], float[], float[], float, int, int[], org.netlib.util.intW, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slarrd</H3>
+<PRE>
+public void <B>slarrd</B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float[] gers,
+ float reltol,
+ float[] d,
+ float[] e,
+ float[] e2,
+ float pivmin,
+ int nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] werr,
+ org.netlib.util.floatW wl,
+ org.netlib.util.floatW wu,
+ int[] iblock,
+ int[] indexw,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARRD computes the eigenvalues of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from SSTEMR.
+ The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ GERS (input) REAL array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ RELTOL (input) REAL
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ E2 (input) REAL array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) REAL
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ NSPLIT (input) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ W (output) REAL array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalue approximations. SLARRD computes an interval
+ I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
+ approximation is given as the interval midpoint
+ W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
+ WERR(j) = abs( a_j - b_j)/2
+
+ WERR (output) REAL array, dimension (N)
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ WL (output) REAL
+ WU (output) REAL
+ The interval (WL, WU] contains all the wanted eigenvalues.
+ If RANGE='V', then WL=VL and WU=VU.
+ If RANGE='A', then WL and WU are the global Gerschgorin bound
+ on the spectrum.
+ If RANGE='I', then WL and WU are computed by SLAEBZ from the
+
+ index range specified.
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (SLARRD may use the remaining N-M elements as
+ workspace.)
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
+ i-th eigenvalue W(i) is the j-th eigenvalue in block k.
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ FUDGE REAL , default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ Based on contributions by
+ W. Kahan, University of California, Berkeley, USA
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>range</CODE> - <DD><CODE>order</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>gers</CODE> - <DD><CODE>reltol</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>wl</CODE> - <DD><CODE>wu</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarre(java.lang.String, int, org.netlib.util.floatW, org.netlib.util.floatW, int, int, float[], float[], float[], float, float, float, org.netlib.util.intW, int[], org.netlib.util.intW, float[], float[], float[], int[], int[], float[], org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slarre</H3>
+<PRE>
+public void <B>slarre</B>(java.lang.String range,
+ int n,
+ org.netlib.util.floatW vl,
+ org.netlib.util.floatW vu,
+ int il,
+ int iu,
+ float[] d,
+ float[] e,
+ float[] e2,
+ float rtol1,
+ float rtol2,
+ float spltol,
+ org.netlib.util.intW nsplit,
+ int[] isplit,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] werr,
+ float[] wgap,
+ int[] iblock,
+ int[] indexw,
+ float[] gers,
+ org.netlib.util.floatW pivmin,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ To find the desired eigenvalues of a given real symmetric
+ tridiagonal matrix T, SLARRE sets any "small" off-diagonal
+ elements to zero, and for each unreduced block T_i, it finds
+ (a) a suitable shift at one end of the block's spectrum,
+ (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
+ (c) eigenvalues of each L_i D_i L_i^T.
+ The representations and eigenvalues found are then used by
+ SSTEMR to compute the eigenvectors of T.
+ The accuracy varies depending on whether bisection is used to
+ find a few eigenvalues or the dqds algorithm (subroutine SLASQ2) to
+ conpute all and then discard any unwanted one.
+ As an added benefit, SLARRE also outputs the n
+ Gerschgorin intervals for the matrices L_i D_i L_i^T.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input/output) REAL
+ VU (input/output) REAL
+ If RANGE='V', the lower and upper bounds for the eigenvalues.
+ Eigenvalues less than or equal to VL, or greater than VU,
+ will not be returned. VL < VU.
+ If RANGE='I' or ='A', SLARRE computes bounds on the desired
+ part of the spectrum.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+ On exit, the N diagonal elements of the diagonal
+ matrices D_i.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, E contains the subdiagonal elements of the unit
+ bidiagonal matrices L_i. The entries E( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, contain the base points sigma_i on output.
+
+
+ E2 (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ RTOL1 (input) REAL
+ RTOL2 (input) REAL
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ SPLTOL (input) REAL
+ The threshold for splitting.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+ M (output) INTEGER
+ The total number of eigenvalues (of all L_i D_i L_i^T)
+ found.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the eigenvalues. The
+ eigenvalues of each of the blocks, L_i D_i L_i^T, are
+ sorted in ascending order ( SLARRE may use the
+ remaining N-M elements as workspace).
+
+ WERR (output) REAL array, dimension (N)
+ The error bound on the corresponding eigenvalue in W.
+
+ WGAP (output) REAL array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+ The gap is only with respect to the eigenvalues of the same b
+ as each block has its own representation tree.
+ Exception: at the right end of a block we store the left gap
+
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in block 2
+
+ GERS (output) REAL array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ PIVMIN (output) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ WORK (workspace) REAL array, dimension (6*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: A problem occured in SLARRE.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in SLARRD.
+ = 2: No base representation could be found in MAXTRY iterati
+ Increasing MAXTRY and recompilation might be a remedy.
+
+ =-3: Problem in SLARRB when computing the refined root
+ representation for SLASQ2.
+ =-4: Problem in SLARRB when preforming bisection on the
+ desired part of the spectrum.
+ =-5: Problem in SLASQ2.
+ =-6: Problem in SLASQ2.
+
+ Further Details
+ The base representations are required to suffer very little
+ element growth and consequently define all their eigenvalues to
+ high relative accuracy.
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>rtol1</CODE> - <DD><CODE>rtol2</CODE> - <DD><CODE>spltol</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>indexw</CODE> - <D [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrf(int, float[], float[], float[], int, int, float[], float[], float[], float, float, float, float, org.netlib.util.floatW, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slarrf</H3>
+<PRE>
+public void <B>slarrf</B>(int n,
+ float[] d,
+ float[] l,
+ float[] ld,
+ int clstrt,
+ int clend,
+ float[] w,
+ float[] wgap,
+ float[] werr,
+ float spdiam,
+ float clgapl,
+ float clgapr,
+ float pivmin,
+ org.netlib.util.floatW sigma,
+ float[] dplus,
+ float[] lplus,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial representation L D L^T and its cluster of close
+ eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
+
+ W( CLEND ), SLARRF finds a new relatively robust representation
+ L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
+ eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix (subblock, if the matrix splitted).
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ L (input) REAL array, dimension (N-1)
+ The (N-1) subdiagonal elements of the unit bidiagonal
+ matrix L.
+
+ LD (input) REAL array, dimension (N-1)
+ The (N-1) elements L(i)*D(i).
+
+ CLSTRT (input) INTEGER
+ The index of the first eigenvalue in the cluster.
+
+ CLEND (input) INTEGER
+ The index of the last eigenvalue in the cluster.
+
+ W (input) REAL array, dimension >= (CLEND-CLSTRT+1
+ The eigenvalue APPROXIMATIONS of L D L^T in ascending order.
+
+ W( CLSTRT ) through W( CLEND ) form the cluster of relatively
+ close eigenalues.
+
+ WGAP (input/output) REAL array, dimension >= (CLEND-C
+ The separation from the right neighbor eigenvalue in W.
+
+ WERR (input) REAL array, dimension >= (CLEND-CLSTRT+1
+ WERR contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue APPROXIMATION in W
+
+ SPDIAM (input) estimate of the spectral diameter obtained from the
+ Gerschgorin intervals
+
+ CLGAPL, CLGAPR (input) absolute gap on each end of the cluster.
+ Set by the calling routine to protect against shifts too clos
+ to eigenvalues outside the cluster.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ SIGMA (output) REAL
+ The shift used to form L(+) D(+) L(+)^T.
+
+ DPLUS (output) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D(+).
+
+ LPLUS (output) REAL array, dimension (N-1)
+ The first (N-1) elements of LPLUS contain the subdiagonal
+ elements of the unit bidiagonal matrix L(+).
+
+ WORK (workspace) REAL array, dimension (2*N)
+ Workspace.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>l</CODE> - <DD><CODE>ld</CODE> - <DD><CODE>clstrt</CODE> - <DD><CODE>clend</CODE> - <DD><CODE>w</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>spdiam</CODE> - <DD><CODE>clgapl</CODE> - <DD><CODE>clgapr</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>dplus</CODE> - <DD><CODE>lplus</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrj(int, float[], float[], int, int, float, int, float[], float[], float[], int[], float, float, org.netlib.util.intW)"><!-- --></A><H3>
+slarrj</H3>
+<PRE>
+public void <B>slarrj</B>(int n,
+ float[] d,
+ float[] e2,
+ int ifirst,
+ int ilast,
+ float rtol,
+ int offset,
+ float[] w,
+ float[] werr,
+ float[] work,
+ int[] iwork,
+ float pivmin,
+ float spdiam,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial eigenvalue approximations of T, SLARRJ
+ does bisection to refine the eigenvalues of T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses in WERR. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of T.
+
+ E2 (input) REAL array, dimension (N-1)
+ The Squares of the (N-1) subdiagonal elements of T.
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL (input) REAL
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) REAL array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WERR (input/output) REAL array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) REAL array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of T.
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>ifirst</CODE> - <DD><CODE>ilast</CODE> - <DD><CODE>rtol</CODE> - <DD><CODE>offset</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>spdiam</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrk(int, int, float, float, float[], float[], float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slarrk</H3>
+<PRE>
+public void <B>slarrk</B>(int n,
+ int iw,
+ float gl,
+ float gu,
+ float[] d,
+ float[] e2,
+ float pivmin,
+ float reltol,
+ org.netlib.util.floatW w,
+ org.netlib.util.floatW werr,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARRK computes one eigenvalue of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from SSTEMR.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ IW (input) INTEGER
+ The index of the eigenvalues to be returned.
+
+ GL (input) REAL
+ GU (input) REAL
+ An upper and a lower bound on the eigenvalue.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E2 (input) REAL array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) REAL
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ RELTOL (input) REAL
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ W (output) REAL
+
+ WERR (output) REAL
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ INFO (output) INTEGER
+ = 0: Eigenvalue converged
+ = -1: Eigenvalue did NOT converge
+
+ Internal Parameters
+ ===================
+
+ FUDGE REAL , default = 2
+ A "fudge factor" to widen the Gershgorin intervals.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>iw</CODE> - <DD><CODE>gl</CODE> - <DD><CODE>gu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e2</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>reltol</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrr(int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slarrr</H3>
+<PRE>
+public void <B>slarrr</B>(int n,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ Perform tests to decide whether the symmetric tridiagonal matrix T
+ warrants expensive computations which guarantee high relative accurac
+ in the eigenvalues.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the tridiagonal matrix T.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) is set to ZERO.
+
+ INFO (output) INTEGER
+ INFO = 0(default) : the matrix warrants computations preservi
+ relative accuracy.
+ INFO = 1 : the matrix warrants computations guarante
+ only absolute accuracy.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarrv(int, float, float, float[], float[], float, int[], int, int, int, float, org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], float[], int[], int[], float[], float[], int, int[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slarrv</H3>
+<PRE>
+public void <B>slarrv</B>(int n,
+ float vl,
+ float vu,
+ float[] d,
+ float[] l,
+ float pivmin,
+ int[] isplit,
+ int m,
+ int dol,
+ int dou,
+ float minrgp,
+ org.netlib.util.floatW rtol1,
+ org.netlib.util.floatW rtol2,
+ float[] w,
+ float[] werr,
+ float[] wgap,
+ int[] iblock,
+ int[] indexw,
+ float[] gers,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARRV computes the eigenvectors of the tridiagonal matrix
+ T = L D L^T given L, D and APPROXIMATIONS to the eigenvalues of L D L
+ The input eigenvalues should have been computed by SLARRE.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ VL (input) REAL
+ VU (input) REAL
+ Lower and upper bounds of the interval that contains the desi
+ eigenvalues. VL < VU. Needed to compute gaps on the left or r
+ end of the extremal eigenvalues in the desired RANGE.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the diagonal matrix D.
+ On exit, D may be overwritten.
+
+ L (input/output) REAL array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the unit
+ bidiagonal matrix L are in elements 1 to N-1 of L
+ (if the matrix is not splitted.) At the end of each block
+ is stored the corresponding shift as given by SLARRE.
+ On exit, L is overwritten.
+
+ PIVMIN (in) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+
+ M (input) INTEGER
+ The total number of input eigenvalues. 0 <= M <= N.
+
+ DOL (input) INTEGER
+ DOU (input) INTEGER
+ If the user wants to compute only selected eigenvectors from
+ the eigenvalues supplied, he can specify an index range DOL:D
+ Or else the setting DOL=1, DOU=M should be applied.
+ Note that DOL and DOU refer to the order in which the eigenva
+ are stored in W.
+ If the user wants to compute only selected eigenpairs, then
+ the columns DOL-1 to DOU+1 of the eigenvector space Z contain
+ computed eigenvectors. All other columns of Z are set to zero
+
+ MINRGP (input) REAL
+
+ RTOL1 (input) REAL
+ RTOL2 (input) REAL
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ W (input/output) REAL array, dimension (N)
+ The first M elements of W contain the APPROXIMATE eigenvalues
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block ( The output array
+ W from SLARRE is expected here ). Furthermore, they are with
+
+ respect to the shift of the corresponding root representation
+ for their block. On exit, W holds the eigenvalues of the
+ UNshifted matrix.
+
+ WERR (input/output) REAL array, dimension (N)
+ The first M elements contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue in W
+
+ WGAP (input/output) REAL array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (input) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in the second bl
+
+ GERS (input) REAL array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should
+ be computed from the original UNshifted matrix.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If INFO = 0, the first M columns of Z contain the
+ orthonormal eigenvectors of the matrix T
+ corresponding to the input eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The I-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*I-1 ) through
+ ISUPPZ( 2*I ).
+
+ WORK (workspace) REAL array, dimension (12*N)
+
+ IWORK (workspace) INTEGER array, dimension (7*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ > 0: A problem occured in SLARRV.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in SLARRB when refining a child's eigenvalues.
+
+ =-2: Problem in SLARRF when computing the RRR of a child.
+ When a child is inside a tight cluster, it can be diffi
+ to find an RRR. A partial remedy from the user's point
+ view is to make the parameter MINRGP smaller and recomp
+ However, as the orthogonality of the computed vectors i
+ proportional to 1/MINRGP, the user should be aware that
+ he might be trading in precision when he decreases MINR
+ =-3: Problem in SLARRB when refining a single eigenvalue
+ after the Rayleigh correction was rejected.
+ = 5: The Rayleigh Quotient Iteration failed to converge to
+ full accuracy in MAXITR steps.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>d</CODE> - <DD><CODE>l</CODE> - <DD><CODE>pivmin</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>m</CODE> - <DD><CODE>dol</CODE> - <DD><CODE>dou</CODE> - <DD><CODE>minrgp</CODE> - <DD><CODE>rtol1</CODE> - <DD><CODE>rtol2</CODE> - <DD><CODE>w</CODE> - <DD><CODE>werr</CODE> - <DD><CODE>wgap</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>indexw</CODE> - <DD><CODE>gers</CODE> - <DD><CODE>z</CODE> - <D [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slartg(float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slartg</H3>
+<PRE>
+public abstract void <B>slartg</B>(float f,
+ float g,
+ org.netlib.util.floatW cs,
+ org.netlib.util.floatW sn,
+ org.netlib.util.floatW r)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARTG generate a plane rotation so that
+
+ [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+ [ -SN CS ] [ G ] [ 0 ]
+
+ This is a slower, more accurate version of the BLAS1 routine SROTG,
+ with the following other differences:
+ F and G are unchanged on return.
+ If G=0, then CS=1 and SN=0.
+ If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+ floating point operations (saves work in SBDSQR when
+ there are zeros on the diagonal).
+
+ If F exceeds G in magnitude, CS will be positive.
+
+ Arguments
+ =========
+
+ F (input) REAL
+ The first component of vector to be rotated.
+
+ G (input) REAL
+ The second component of vector to be rotated.
+
+ CS (output) REAL
+ The cosine of the rotation.
+
+ SN (output) REAL
+ The sine of the rotation.
+
+ R (output) REAL
+ The nonzero component of the rotated vector.
+
+ This version has a few statements commented out for thread safety
+ (machine parameters are computed on each entry). 10 feb 03, SJH.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>f</CODE> - <DD><CODE>g</CODE> - <DD><CODE>cs</CODE> - <DD><CODE>sn</CODE> - <DD><CODE>r</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slartv(int, float[], int, float[], int, float[], float[], int)"><!-- --></A><H3>
+slartv</H3>
+<PRE>
+public abstract void <B>slartv</B>(int n,
+ float[] x,
+ int incx,
+ float[] y,
+ int incy,
+ float[] c,
+ float[] s,
+ int incc)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARTV applies a vector of real plane rotations to elements of the
+ real vectors x and y. For i = 1,2,...,n
+
+ ( x(i) ) := ( c(i) s(i) ) ( x(i) )
+ ( y(i) ) ( -s(i) c(i) ) ( y(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCY)
+ The vector y.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (input) REAL array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) REAL array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>y</CODE> - <DD><CODE>incy</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - <DD><CODE>incc</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaruv(int[], int, float[])"><!-- --></A><H3>
+slaruv</H3>
+<PRE>
+public abstract void <B>slaruv</B>(int[] iseed,
+ int n,
+ float[] x)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARUV returns a vector of n random real numbers from a uniform (0,1)
+ distribution (n <= 128).
+
+ This is an auxiliary routine called by SLARNV and CLARNV.
+
+ Arguments
+ =========
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated. N <= 128.
+
+ X (output) REAL array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine uses a multiplicative congruential method with modulus
+ 2**48 and multiplier 33952834046453 (see G.S.Fishman,
+ 'Multiplicative congruential random number generators with modulus
+ 2**b: an exhaustive analysis for b = 32 and a partial analysis for
+ b = 48', Math. Comp. 189, pp 331-344, 1990).
+
+ 48-bit integers are stored in 4 integer array elements with 12 bits
+ per element. Hence the routine is portable across machines with
+ integers of 32 bits or more.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>iseed</CODE> - <DD><CODE>n</CODE> - <DD><CODE>x</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarz(java.lang.String, int, int, int, float[], int, float, float[], int, float[])"><!-- --></A><H3>
+slarz</H3>
+<PRE>
+public abstract void <B>slarz</B>(java.lang.String side,
+ int m,
+ int n,
+ int l,
+ float[] v,
+ int incv,
+ float tau,
+ float[] c,
+ int Ldc,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARZ applies a real elementary reflector H to a real M-by-N
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+
+ H is a product of k elementary reflectors as returned by STZRZF.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ L (input) INTEGER
+ The number of entries of the vector V containing
+ the meaningful part of the Householder vectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) REAL array, dimension (1+(L-1)*abs(INCV))
+ The vector v in the representation of H as returned by
+ STZRZF. V is not used if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) REAL
+ The value tau in the representation of H.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>l</CODE> - <DD><CODE>v</CODE> - <DD><CODE>incv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarzb(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], int, float[], int, float[], int)"><!-- --></A><H3>
+slarzb</H3>
+<PRE>
+public abstract void <B>slarzb</B>(java.lang.String side,
+ java.lang.String trans,
+ java.lang.String direct,
+ java.lang.String storev,
+ int m,
+ int n,
+ int k,
+ int l,
+ float[] v,
+ int ldv,
+ float[] t,
+ int ldt,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int ldwork)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARZB applies a real block reflector H or its transpose H**T to
+ a real distributed M-by-N C from the left or the right.
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'C': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise (not supported yet)
+
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ L (input) INTEGER
+ The number of columns of the matrix V containing the
+ meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) REAL array, dimension (LDV,NV).
+ If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
+
+ T (input) REAL array, dimension (LDT,K)
+ The triangular K-by-K matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ldwork</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slarzt(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int)"><!-- --></A><H3>
+slarzt</H3>
+<PRE>
+public abstract void <B>slarzt</B>(java.lang.String direct,
+ java.lang.String storev,
+ int n,
+ int k,
+ float[] v,
+ int ldv,
+ float[] tau,
+ float[] t,
+ int ldt)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARZT 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'
+
+ 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 * V
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ DIRECT (input) 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, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise (not supported yet)
+
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) REAL array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+
+ ______V_____
+ ( v1 v2 v3 ) / \
+ ( v1 v2 v3 ) ( v1 v1 v1 v1 v1 . . . . 1 )
+ V = ( v1 v2 v3 ) ( v2 v2 v2 v2 v2 . . . 1 )
+ ( v1 v2 v3 ) ( v3 v3 v3 v3 v3 . . 1 )
+ ( v1 v2 v3 )
+ . . .
+ . . .
+ 1 . .
+ 1 .
+ 1
+
+ DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+
+ ______V_____
+ 1 / \
+ . 1 ( 1 . . . . v1 v1 v1 v1 v1 )
+ . . 1 ( . 1 . . . v2 v2 v2 v2 v2 )
+ . . . ( . . 1 . . v3 v3 v3 v3 v3 )
+ . . .
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ V = ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>direct</CODE> - <DD><CODE>storev</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slas2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slas2</H3>
+<PRE>
+public abstract void <B>slas2</B>(float f,
+ float g,
+ float h,
+ org.netlib.util.floatW ssmin,
+ org.netlib.util.floatW ssmax)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAS2 computes the singular values of the 2-by-2 matrix
+ [ F G ]
+ [ 0 H ].
+ On return, SSMIN is the smaller singular value and SSMAX is the
+ larger singular value.
+
+ Arguments
+ =========
+
+ F (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) REAL
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) REAL
+ The smaller singular value.
+
+ SSMAX (output) REAL
+ The larger singular value.
+
+ Further Details
+ ===============
+
+ Barring over/underflow, all output quantities are correct to within
+ a few units in the last place (ulps), even in the absence of a guard
+
+ digit in addition/subtraction.
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows, or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ ====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>f</CODE> - <DD><CODE>g</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ssmin</CODE> - <DD><CODE>ssmax</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slascl(java.lang.String, int, int, float, float, int, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slascl</H3>
+<PRE>
+public abstract void <B>slascl</B>(java.lang.String type,
+ int kl,
+ int ku,
+ float cfrom,
+ float cto,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASCL multiplies the M by N real matrix A by the real scalar
+ CTO/CFROM. This is done without over/underflow as long as the final
+
+ result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+
+ A may be full, upper triangular, lower triangular, upper Hessenberg,
+
+ or banded.
+
+ Arguments
+ =========
+
+ TYPE (input) CHARACTER*1
+ TYPE indices the storage type of the input matrix.
+ = 'G': A is a full matrix.
+ = 'L': A is a lower triangular matrix.
+ = 'U': A is an upper triangular matrix.
+ = 'H': A is an upper Hessenberg matrix.
+ = 'B': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the lower
+ half stored.
+ = 'Q': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the upper
+ half stored.
+ = 'Z': A is a band matrix with lower bandwidth KL and upper
+
+ bandwidth KU.
+
+ KL (input) INTEGER
+ The lower bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ KU (input) INTEGER
+ The upper bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ CFROM (input) REAL
+ CTO (input) REAL
+ The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+ without over/underflow if the final result CTO*A(I,J)/CFROM
+ can be represented without over/underflow. CFROM must be
+ nonzero.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ The matrix to be multiplied by CTO/CFROM. See TYPE for the
+ storage type.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ 0 - successful exit
+ <0 - if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>type</CODE> - <DD><CODE>kl</CODE> - <DD><CODE>ku</CODE> - <DD><CODE>cfrom</CODE> - <DD><CODE>cto</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd0(int, int, float[], float[], float[], int, float[], int, int, int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd0</H3>
+<PRE>
+public abstract void <B>slasd0</B>(int n,
+ int sqre,
+ float[] d,
+ float[] e,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ int smlsiz,
+ int[] iwork,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, SLASD0 computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M
+ matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
+ The algorithm computes orthogonal matrices U and VT such that
+ B = U * S * VT. The singular values S are overwritten on D.
+
+ A related subroutine, SLASDA, computes only the singular values,
+ and optionally, the singular vectors in compact form.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the row dimension of the upper bidiagonal matrix.
+ This is also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N+1;
+
+ D (input/output) REAL array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix.
+ On exit D, if INFO = 0, contains its singular values.
+
+ E (input) REAL array, dimension (M-1)
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) REAL array, dimension at least (LDQ, N)
+ On exit, U contains the left singular vectors.
+
+ LDU (input) INTEGER
+ On entry, leading dimension of U.
+
+ VT (output) REAL array, dimension at least (LDVT, M)
+ On exit, VT' contains the right singular vectors.
+
+ LDVT (input) INTEGER
+ On entry, leading dimension of VT.
+
+ SMLSIZ (input) INTEGER
+ On entry, maximum size of the subproblems at the
+ bottom of the computation tree.
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ WORK (workspace) REAL array, dimension (3*M**2+2*M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd1(int, int, int, float[], org.netlib.util.floatW, org.netlib.util.floatW, float[], int, float[], int, int[], int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd1</H3>
+<PRE>
+public abstract void <B>slasd1</B>(int nl,
+ int nr,
+ int sqre,
+ float[] d,
+ org.netlib.util.floatW alpha,
+ org.netlib.util.floatW beta,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ int[] idxq,
+ int[] iwork,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
+ where N = NL + NR + 1 and M = N + SQRE. SLASD1 is called from SLASD0.
+
+ A related subroutine SLASD7 handles the case in which the singular
+ values (and the singular vectors in factored form) are desired.
+
+ SLASD1 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The left singular vectors of the original matrix are stored in U, and
+ the transpose of the right singular vectors are stored in VT, and the
+ singular values are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or when there are zeros in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLASD2.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the square roots of the
+ roots of the secular equation via the routine SLASD4 (as called
+ by SLASD3). This routine also calculates the singular vectors of
+ the current problem.
+
+ The final stage consists of computing the updated singular vectors
+ directly using the updated singular values. The singular vectors
+
+ for the current problem are multiplied with the singular vectors
+ from the overall problem.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) REAL array, dimension (NL+NR+1).
+ N = NL+NR+1
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block; and D(NL+2:N) contains the singular values of
+ the lower block. On exit D(1:N) contains the singular values
+ of the modified matrix.
+
+ ALPHA (input/output) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) REAL array, dimension (LDU,N)
+ On entry U(1:NL, 1:NL) contains the left singular vectors of
+ the upper block; U(NL+2:N, NL+2:N) contains the left singular
+
+ vectors of the lower block. On exit U contains the left
+ singular vectors of the bidiagonal matrix.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max( 1, N ).
+
+ VT (input/output) REAL array, dimension (LDVT,M)
+ where M = N + SQRE.
+ On entry VT(1:NL+1, 1:NL+1)' contains the right singular
+ vectors of the upper block; VT(NL+2:M, NL+2:M)' contains
+ the right singular vectors of the lower block. On exit
+ VT' contains the right singular vectors of the
+ bidiagonal matrix.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= max( 1, M ).
+
+ IDXQ (output) INTEGER array, dimension (N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ WORK (workspace) REAL array, dimension (3*M**2+2*M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>idxq</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd2(int, int, int, org.netlib.util.intW, float[], float[], float, float, float[], int, float[], int, float[], float[], int, float[], int, int[], int[], int[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd2</H3>
+<PRE>
+public abstract void <B>slasd2</B>(int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ float[] d,
+ float[] z,
+ float alpha,
+ float beta,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int ldvt,
+ float[] dsigma,
+ float[] u2,
+ int ldu2,
+ float[] vt2,
+ int ldvt2,
+ int[] idxp,
+ int[] idx,
+ int[] idxc,
+ int[] idxq,
+ int[] coltyp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD2 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ singular values are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ SLASD2 is called from SLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) REAL array, dimension (N)
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) REAL array, dimension (N)
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ALPHA (input) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) REAL array, dimension (LDU,N)
+ On entry U contains the left singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL, NL), and (NL+2, NL+2), (N,N).
+ On exit U contains the trailing (N-K) updated left singular
+ vectors (those which were deflated) in its last N-K columns.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ VT (input/output) REAL array, dimension (LDVT,M)
+ On entry VT' contains the right singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL+1, NL+1), and (NL+2, NL+2), (M,M).
+ On exit VT' contains the trailing (N-K) updated right singular
+ vectors (those which were deflated) in its last N-K columns.
+ In case SQRE =1, the last row of VT spans the right null
+ space.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= M.
+
+ DSIGMA (output) REAL array, dimension (N)
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ U2 (output) REAL array, dimension (LDU2,N)
+ Contains a copy of the first K-1 left singular vectors which
+ will be used by SLASD3 in a matrix multiply (SGEMM) to solve
+ for the new left singular vectors. U2 is arranged into four
+ blocks. The first block contains a column with 1 at NL+1 and
+ zero everywhere else; the second block contains non-zero
+ entries only at and above NL; the third contains non-zero
+ entries only below NL+1; and the fourth is dense.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT2 (output) REAL array, dimension (LDVT2,N)
+ VT2' contains a copy of the first K right singular vectors
+ which will be used by SLASD3 in a matrix multiply (SGEMM) to
+ solve for the new right singular vectors. VT2 is arranged into
+ three blocks. The first block contains a row that corresponds
+
+ to the special 0 diagonal element in SIGMA; the second block
+ contains non-zeros only at and before NL +1; the third block
+ contains non-zeros only at and after NL +2.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= M.
+
+ IDXP (workspace) INTEGER array, dimension (N)
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDX (workspace) INTEGER array, dimension (N)
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXC (output) INTEGER array, dimension (N)
+ This will contain the permutation used to arrange the columns
+
+ of the deflated U matrix into three groups: the first group
+ contains non-zero entries only at and above NL, the second
+ contains non-zero entries only below NL+2, and the third is
+ dense.
+
+ IDXQ (input/output) INTEGER array, dimension (N)
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first hlaf of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ As workspace, this will contain a label which will indicate
+ which of the following types a column in the U2 matrix or a
+ row in the VT2 matrix is:
+ 1 : non-zero in the upper half only
+ 2 : non-zero in the lower half only
+ 3 : dense
+ 4 : deflated
+
+ On exit, it is an array of dimension 4, with COLTYP(I) being
+ the dimension of the I-th type columns.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>u2</CODE> - <DD><CODE>ldu2</CODE> - <DD><CODE>vt2</CODE> - <DD><CODE>ldvt2</CODE> - <DD><CODE>idxp</CODE> - <DD><CODE>idx</CODE> - <DD><CODE>idxc</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd3(int, int, int, int, float[], float[], int, float[], float[], int, float[], int, float[], int, float[], int, int[], int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd3</H3>
+<PRE>
+public abstract void <B>slasd3</B>(int nl,
+ int nr,
+ int sqre,
+ int k,
+ float[] d,
+ float[] q,
+ int ldq,
+ float[] dsigma,
+ float[] u,
+ int ldu,
+ float[] u2,
+ int ldu2,
+ float[] vt,
+ int ldvt,
+ float[] vt2,
+ int ldvt2,
+ int[] idxc,
+ int[] ctot,
+ float[] z,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD3 finds all the square roots of the roots of the secular
+ equation, as defined by the values in D and Z. It makes the
+ appropriate calls to SLASD4 and then updates the singular
+ vectors by matrix multiplication.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ SLASD3 is called from SLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (input) INTEGER
+ The size of the secular equation, 1 =< K = < N.
+
+ D (output) REAL array, dimension(K)
+ On exit the square roots of the roots of the secular equation,
+ in ascending order.
+
+ Q (workspace) REAL array,
+ dimension at least (LDQ,K).
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= K.
+
+ DSIGMA (input/output) REAL array, dimension(K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ U (output) REAL array, dimension (LDU, N)
+ The last N - K columns of this matrix contain the deflated
+ left singular vectors.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ U2 (input) REAL array, dimension (LDU2, N)
+ The first K columns of this matrix contain the non-deflated
+ left singular vectors for the split problem.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT (output) REAL array, dimension (LDVT, M)
+ The last M - K columns of VT' contain the deflated
+ right singular vectors.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= N.
+
+ VT2 (input/output) REAL array, dimension (LDVT2, N)
+ The first K columns of VT2' contain the non-deflated
+ right singular vectors for the split problem.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= N.
+
+ IDXC (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of U (and rows of
+
+ VT) into three groups: the first group contains non-zero
+ entries only at and above (or before) NL +1; the second
+ contains non-zero entries only at and below (or after) NL+2;
+ and the third is dense. The first column of U and the row of
+ VT are treated separately, however.
+
+ The rows of the singular vectors found by SLASD4
+ must be likewise permuted before the matrix multiplies can
+ take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in U (or rows in VT), as described in IDXC. The fourth column
+
+ type is any column which has been deflated.
+
+ Z (input/output) REAL array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>u2</CODE> - <DD><CODE>ldu2</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>vt2</CODE> - <DD><CODE>ldvt2</CODE> - <DD><CODE>idxc</CODE> - <DD><CODE>ctot</CODE> - <DD><CODE>z</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd4(int, int, float[], float[], float[], float, org.netlib.util.floatW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd4</H3>
+<PRE>
+public abstract void <B>slasd4</B>(int n,
+ int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW sigma,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th updated
+ eigenvalue of a positive symmetric rank-one modification to
+ a positive diagonal matrix whose entries are given as the squares
+ of the corresponding entries in the array d, and that
+
+ 0 <= D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) * diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) REAL array, dimension ( N )
+ The original eigenvalues. It is assumed that they are in
+ order, 0 <= D(I) < D(J) for I < J.
+
+ Z (input) REAL array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (N)
+ If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. The vector DELTA
+ contains the information necessary to construct the
+ (singular) eigenvectors.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ SIGMA (output) REAL
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) REAL array, dimension (N)
+ If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
+ component. If N = 1, then WORK( 1 ) = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd5(int, float[], float[], float[], float, org.netlib.util.floatW, float[])"><!-- --></A><H3>
+slasd5</H3>
+<PRE>
+public abstract void <B>slasd5</B>(int i,
+ float[] d,
+ float[] z,
+ float[] delta,
+ float rho,
+ org.netlib.util.floatW dsigma,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th eigenvalue
+ of a positive symmetric rank-one modification of a 2-by-2 diagonal
+ matrix
+
+ diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal entries in the array D are assumed to satisfy
+
+ 0 <= D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) REAL array, dimension (2)
+ The original eigenvalues. We assume 0 <= D(1) < D(2).
+
+ Z (input) REAL array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (2)
+ Contains (D(j) - sigma_I) in its j-th component.
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ DSIGMA (output) REAL
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) REAL array, dimension (2)
+ WORK contains (D(j) + sigma_I) in its j-th component.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>delta</CODE> - <DD><CODE>rho</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd6(int, int, int, int, float[], float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[], org.netlib.util.intW, int[], int, float[], int, float[], float[], float[], float[], org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd6</H3>
+<PRE>
+public abstract void <B>slasd6</B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ float[] d,
+ float[] vf,
+ float[] vl,
+ org.netlib.util.floatW alpha,
+ org.netlib.util.floatW beta,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ float[] givnum,
+ int ldgnum,
+ float[] poles,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ org.netlib.util.intW k,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW s,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD6 computes the SVD of an updated upper bidiagonal matrix B
+ obtained by merging two smaller ones by appending a row. This
+ routine is used only for the problem which requires all singular
+ values and optionally singular vector matrices in factored form.
+ B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
+ A related subroutine, SLASD1, handles the case in which all singular
+
+ values and singular vectors of the bidiagonal matrix are desired.
+
+ SLASD6 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The singular values of B can be computed using D1, D2, the first
+ components of all the right singular vectors of the lower block, and
+
+ the last components of all the right singular vectors of the upper
+ block. These components are stored and updated in VF and VL,
+ respectively, in SLASD6. Hence U and VT are not explicitly
+ referenced.
+
+ The singular values are stored in D. The algorithm consists of two
+ stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or if there is a zero
+ in the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLASD7.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the roots of the
+ secular equation via the routine SLASD4 (as called by SLASD8).
+
+ This routine also updates VF and VL and computes the distances
+
+ between the updated singular values and the old singular
+ values.
+
+ SLASD6 is called from SLASDA.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) REAL array, dimension (NL+NR+1).
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block, and D(NL+2:N) contains the singular values
+ of the lower block. On exit D(1:N) contains the singular
+ values of the modified matrix.
+
+ VF (input/output) REAL array, dimension (M)
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VL (input/output) REAL array, dimension (M)
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors of
+
+ the lower block. On exit, VL contains the last components of
+ all right singular vectors of the bidiagonal matrix.
+
+ ALPHA (input/output) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ IDXQ (output) INTEGER array, dimension (N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) REAL array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM and POLES, must be at least N.
+
+ POLES (output) REAL array, dimension ( LDGNUM, 2 )
+ On exit, POLES(1,*) is an array containing the new singular
+ values obtained from solving the secular equation, and
+ POLES(2,*) is an array containing the poles in the secular
+ equation. Not referenced if ICOMPQ = 0.
+
+ DIFL (output) REAL array, dimension ( N )
+ On exit, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (output) REAL array,
+ dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ On exit, DIFR(I, 1) is the distance between I-th updated
+ (undeflated) singular value and the I+1-th (undeflated) old
+ singular value.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ See SLASD8 for details on DIFL and DIFR.
+
+ Z (output) REAL array, dimension ( M )
+ The first elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (output) REAL
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) REAL
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) REAL array, dimension ( 4 * M )
+
+ IWORK (workspace) INTEGER array, dimension ( 3 * N )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>vf</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>idxq</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>ldgnum</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd7(int, int, int, int, org.netlib.util.intW, float[], float[], float[], float[], float[], float[], float[], float, float, float[], int[], int[], int[], int[], org.netlib.util.intW, int[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slasd7</H3>
+<PRE>
+public abstract void <B>slasd7</B>(int icompq,
+ int nl,
+ int nr,
+ int sqre,
+ org.netlib.util.intW k,
+ float[] d,
+ float[] z,
+ float[] zw,
+ float[] vf,
+ float[] vfw,
+ float[] vl,
+ float[] vlw,
+ float alpha,
+ float beta,
+ float[] dsigma,
+ int[] idx,
+ int[] idxp,
+ int[] idxq,
+ int[] perm,
+ org.netlib.util.intW givptr,
+ int[] givcol,
+ int ldgcol,
+ float[] givnum,
+ int ldgnum,
+ org.netlib.util.floatW c,
+ org.netlib.util.floatW s,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD7 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem. There
+ are two ways in which deflation can occur: when two or more singular
+ values are close together or if there is a tiny entry in the Z
+ vector. For each such occurrence the order of the related
+ secular equation problem is reduced by one.
+
+ SLASD7 is called from SLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper
+ bidiagonal matrix in compact form.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix, this is
+ the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) REAL array, dimension ( N )
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) REAL array, dimension ( M )
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ZW (workspace) REAL array, dimension ( M )
+ Workspace for Z.
+
+ VF (input/output) REAL array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VFW (workspace) REAL array, dimension ( M )
+ Workspace for VF.
+
+ VL (input/output) REAL array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors
+ of the lower block. On exit, VL contains the last components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VLW (workspace) REAL array, dimension ( M )
+ Workspace for VL.
+
+ ALPHA (input) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ DSIGMA (output) REAL array, dimension ( N )
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ IDX (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXP (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDXQ (input) INTEGER array, dimension ( N )
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first half of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each singular block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) REAL array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM, must be at least N.
+
+ C (output) REAL
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) REAL
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>nl</CODE> - <DD><CODE>nr</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>zw</CODE> - <DD><CODE>vf</CODE> - <DD><CODE>vfw</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vlw</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>idx</CODE> - <DD><CODE>idxp</CODE> - <DD><CODE>idxq</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givptr</CODE> - <DD>< [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasd8(int, int, float[], float[], float[], float[], float[], float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasd8</H3>
+<PRE>
+public abstract void <B>slasd8</B>(int icompq,
+ int k,
+ float[] d,
+ float[] z,
+ float[] vf,
+ float[] vl,
+ float[] difl,
+ float[] difr,
+ int lddifr,
+ float[] dsigma,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD8 finds the square roots of the roots of the secular equation,
+ as defined by the values in DSIGMA and Z. It makes the appropriate
+ calls to SLASD4, and stores, for each element in D, the distance
+ to its two nearest poles (elements in DSIGMA). It also updates
+ the arrays VF and VL, the first and last components of all the
+ right singular vectors of the original bidiagonal matrix.
+
+ SLASD8 is called from SLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form in the calling routine:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved
+ by SLASD4. K >= 1.
+
+ D (output) REAL array, dimension ( K )
+ On output, D contains the updated singular values.
+
+ Z (input) REAL array, dimension ( K )
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ VF (input/output) REAL array, dimension ( K )
+ On entry, VF contains information passed through DBEDE8.
+ On exit, VF contains the first K components of the first
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ VL (input/output) REAL array, dimension ( K )
+ On entry, VL contains information passed through DBEDE8.
+ On exit, VL contains the first K components of the last
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ DIFL (output) REAL array, dimension ( K )
+ On exit, DIFL(I) = D(I) - DSIGMA(I).
+
+ DIFR (output) REAL array,
+ dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
+ dimension ( K ) if ICOMPQ = 0.
+ On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
+ defined and will not be referenced.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ LDDIFR (input) INTEGER
+ The leading dimension of DIFR, must be at least K.
+
+ DSIGMA (input) REAL array, dimension ( K )
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ WORK (workspace) REAL array, dimension at least 3 * K
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>k</CODE> - <DD><CODE>d</CODE> - <DD><CODE>z</CODE> - <DD><CODE>vf</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>lddifr</CODE> - <DD><CODE>dsigma</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasda(int, int, int, int, float[], float[], float[], int, float[], int[], float[], float[], float[], float[], int[], int[], int, int[], float[], float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+slasda</H3>
+<PRE>
+public abstract void <B>slasda</B>(int icompq,
+ int smlsiz,
+ int n,
+ int sqre,
+ float[] d,
+ float[] e,
+ float[] u,
+ int ldu,
+ float[] vt,
+ int[] k,
+ float[] difl,
+ float[] difr,
+ float[] z,
+ float[] poles,
+ int[] givptr,
+ int[] givcol,
+ int ldgcol,
+ int[] perm,
+ float[] givnum,
+ float[] c,
+ float[] s,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, SLASDA computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
+ B with diagonal D and offdiagonal E, where M = N + SQRE. The
+ algorithm computes the singular values in the SVD B = U * S * VT.
+ The orthogonal matrices U and VT are optionally computed in
+ compact form.
+
+ A related subroutine, SLASD0, computes the singular values and
+ the singular vectors in explicit form.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper bidiagonal
+ matrix in compact form.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row dimension of the upper bidiagonal matrix. This is
+ also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N + 1.
+
+ D (input/output) REAL array, dimension ( N )
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit D, if INFO = 0, contains its singular values.
+
+
+ E (input) REAL array, dimension ( M-1 )
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) REAL array,
+ dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
+ GIVNUM, and Z.
+
+ VT (output) REAL array,
+ dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT' contains the right
+
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ K (output) INTEGER array, dimension ( N )
+ if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
+ secular equation on the computation tree.
+
+ DIFL (output) REAL array, dimension ( LDU, NLVL ),
+ where NLVL = floor(log_2 (N/SMLSIZ))).
+
+ DIFR (output) REAL array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
+
+ record distances between singular values on the I-th
+ level and singular values on the (I -1)-th level, and
+ DIFR(1:N, 2 * I ) contains the normalizing factors for
+ the right singular vector matrix. See SLASD8 for details.
+
+ Z (output) REAL array,
+ dimension ( LDU, NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ The first K elements of Z(1, I) contain the components of
+ the deflation-adjusted updating row vector for subproblems
+ on the I-th level.
+
+ POLES (output) REAL array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
+ POLES(1, 2*I) contain the new and old singular values
+ involved in the secular equations on the I-th level.
+
+ GIVPTR (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1, and not referenced if
+ ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
+ the number of Givens rotations performed on the I-th
+ problem on the computation tree.
+
+ GIVCOL (output) INTEGER array,
+ dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
+ of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (output) INTEGER array, dimension ( LDGCOL, NLVL )
+ if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
+ permutations done on the I-th level of the computation tree.
+
+ GIVNUM (output) REAL array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
+ values of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ C (output) REAL array,
+ dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
+
+ If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
+
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (output) REAL array, dimension ( N ) if
+ ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
+ and the I-th subproblem is not square, on exit, S( I )
+ contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) REAL array, dimension
+ (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
+
+ IWORK (workspace) INTEGER array, dimension (7*N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>icompq</CODE> - <DD><CODE>smlsiz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>k</CODE> - <DD><CODE>difl</CODE> - <DD><CODE>difr</CODE> - <DD><CODE>z</CODE> - <DD><CODE>poles</CODE> - <DD><CODE>givptr</CODE> - <DD><CODE>givcol</CODE> - <DD><CODE>ldgcol</CODE> - <DD><CODE>perm</CODE> - <DD><CODE>givnum</CODE> - <DD><CODE>c</CODE> - < [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasdq(java.lang.String, int, int, int, int, int, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasdq</H3>
+<PRE>
+public abstract void <B>slasdq</B>(java.lang.String uplo,
+ int sqre,
+ int n,
+ int ncvt,
+ int nru,
+ int ncc,
+ float[] d,
+ float[] e,
+ float[] vt,
+ int ldvt,
+ float[] u,
+ int ldu,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASDQ computes the singular value decomposition (SVD) of a real
+ (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
+ E, accumulating the transformations if desired. Letting B denote
+ the input bidiagonal matrix, the algorithm computes orthogonal
+ matrices Q and P such that B = Q * S * P' (P' denotes the transpose
+ of P). The singular values S are overwritten on D.
+
+ The input matrix U is changed to U * Q if desired.
+ The input matrix VT is changed to P' * VT if desired.
+ The input matrix C is changed to Q' * C if desired.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3, for a detailed description of the algorithm.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ On entry, UPLO specifies whether the input bidiagonal matrix
+ is upper or lower bidiagonal, and wether it is square are
+ not.
+ UPLO = 'U' or 'u' B is upper bidiagonal.
+ UPLO = 'L' or 'l' B is lower bidiagonal.
+
+ SQRE (input) INTEGER
+ = 0: then the input matrix is N-by-N.
+ = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
+ (N+1)-by-N if UPLU = 'L'.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ N (input) INTEGER
+ On entry, N specifies the number of rows and columns
+ in the matrix. N must be at least 0.
+
+ NCVT (input) INTEGER
+ On entry, NCVT specifies the number of columns of
+ the matrix VT. NCVT must be at least 0.
+
+ NRU (input) INTEGER
+ On entry, NRU specifies the number of rows of
+ the matrix U. NRU must be at least 0.
+
+ NCC (input) INTEGER
+ On entry, NCC specifies the number of columns of
+ the matrix C. NCC must be at least 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D contains the diagonal entries of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in ascending order.
+
+ E (input/output) REAL array.
+ dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
+ On entry, the entries of E contain the offdiagonal entries
+ of the bidiagonal matrix whose SVD is desired. On normal
+ exit, E will contain 0. If the algorithm does not converge,
+ D and E will contain the diagonal and superdiagonal entries
+ of a bidiagonal matrix orthogonally equivalent to the one
+ given as input.
+
+ VT (input/output) REAL array, dimension (LDVT, NCVT)
+ On entry, contains a matrix which on exit has been
+ premultiplied by P', dimension N-by-NCVT if SQRE = 0
+ and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
+
+ LDVT (input) INTEGER
+ On entry, LDVT specifies the leading dimension of VT as
+ declared in the calling (sub) program. LDVT must be at
+ least 1. If NCVT is nonzero LDVT must also be at least N.
+
+ U (input/output) REAL array, dimension (LDU, N)
+ On entry, contains a matrix which on exit has been
+ postmultiplied by Q, dimension NRU-by-N if SQRE = 0
+ and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
+
+ LDU (input) INTEGER
+ On entry, LDU specifies the leading dimension of U as
+ declared in the calling (sub) program. LDU must be at
+ least max( 1, NRU ) .
+
+ C (input/output) REAL array, dimension (LDC, NCC)
+ On entry, contains an N-by-NCC matrix which on exit
+ has been premultiplied by Q' dimension N-by-NCC if SQRE = 0
+ and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
+
+ LDC (input) INTEGER
+ On entry, LDC specifies the leading dimension of C as
+ declared in the calling (sub) program. LDC must be at
+ least 1. If NCC is nonzero, LDC must also be at least N.
+
+ WORK (workspace) REAL array, dimension (4*N)
+ Workspace. Only referenced if one of NCVT, NRU, or NCC is
+ nonzero, and if N is at least 2.
+
+ INFO (output) INTEGER
+ On exit, a value of 0 indicates a successful exit.
+ If INFO < 0, argument number -INFO is illegal.
+ If INFO > 0, the algorithm did not converge, and INFO
+ specifies how many superdiagonals did not converge.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>sqre</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ncvt</CODE> - <DD><CODE>nru</CODE> - <DD><CODE>ncc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vt</CODE> - <DD><CODE>ldvt</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasdt(int, org.netlib.util.intW, org.netlib.util.intW, int[], int[], int[], int)"><!-- --></A><H3>
+slasdt</H3>
+<PRE>
+public abstract void <B>slasdt</B>(int n,
+ org.netlib.util.intW lvl,
+ org.netlib.util.intW nd,
+ int[] inode,
+ int[] ndiml,
+ int[] ndimr,
+ int msub)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASDT creates a tree of subproblems for bidiagonal divide and
+ conquer.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the number of diagonal elements of the
+ bidiagonal matrix.
+
+ LVL (output) INTEGER
+ On exit, the number of levels on the computation tree.
+
+ ND (output) INTEGER
+ On exit, the number of nodes on the tree.
+
+ INODE (output) INTEGER array, dimension ( N )
+ On exit, centers of subproblems.
+
+ NDIML (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of left children.
+
+ NDIMR (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of right children.
+
+ MSUB (input) INTEGER.
+ On entry, the maximum row dimension each subproblem at the
+ bottom of the tree can be of.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>lvl</CODE> - <DD><CODE>nd</CODE> - <DD><CODE>inode</CODE> - <DD><CODE>ndiml</CODE> - <DD><CODE>ndimr</CODE> - <DD><CODE>msub</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaset(java.lang.String, int, int, float, float, float[], int)"><!-- --></A><H3>
+slaset</H3>
+<PRE>
+public abstract void <B>slaset</B>(java.lang.String uplo,
+ int m,
+ int n,
+ float alpha,
+ float beta,
+ float[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASET initializes an m-by-n matrix A to BETA on the diagonal and
+ ALPHA on the offdiagonals.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be set.
+ = 'U': Upper triangular part is set; the strictly lower
+
+ triangular part of A is not changed.
+ = 'L': Lower triangular part is set; the strictly upper
+
+ triangular part of A is not changed.
+ Otherwise: All of the matrix A is set.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ ALPHA (input) REAL
+ The constant to which the offdiagonal elements are to be set.
+
+ BETA (input) REAL
+ The constant to which the diagonal elements are to be set.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On exit, the leading m-by-n submatrix of A is set as follows:
+
+ if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+ if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+ otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+
+ and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasq1(int, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasq1</H3>
+<PRE>
+public abstract void <B>slasq1</B>(int n,
+ float[] d,
+ float[] e,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ1 computes the singular values of a real N-by-N bidiagonal
+ matrix with diagonal D and off-diagonal E. The singular values
+ are computed to high relative accuracy, in the absence of
+ denormalization, underflow and overflow. The algorithm was first
+ presented in
+
+ "Accurate singular values and differential qd algorithms" by K. V.
+ Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
+ 1994,
+
+ and the present implementation is described in "An implementation of
+
+ the dqds Algorithm (Positive Case)", LAPACK Working Note.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D contains the diagonal elements of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in decreasing order.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, elements E(1:N-1) contain the off-diagonal elements
+ of the bidiagonal matrix whose SVD is desired.
+ On exit, E is overwritten.
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasq2(int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasq2</H3>
+<PRE>
+public abstract void <B>slasq2</B>(int n,
+ float[] z,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ2 computes all the eigenvalues of the symmetric positive
+ definite tridiagonal matrix associated with the qd array Z to high
+ relative accuracy are computed to high relative accuracy, in the
+ absence of denormalization, underflow and overflow.
+
+ To see the relation of Z to the tridiagonal matrix, let L be a
+ unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
+ let U be an upper bidiagonal matrix with 1's above and diagonal
+ Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
+ symmetric tridiagonal to which it is similar.
+
+ Note : SLASQ2 defines a logical variable, IEEE, which is true
+ on machines which follow ieee-754 floating-point standard in their
+ handling of infinities and NaNs, and false otherwise. This variable
+ is passed to SLAZQ3.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ Z (workspace) REAL array, dimension (4*N)
+ On entry Z holds the qd array. On exit, entries 1 to N hold
+ the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
+ trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
+ N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
+ holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
+ shifts that failed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if the i-th argument is a scalar and had an illegal
+ value, then INFO = -i, if the i-th argument is an
+ array and the j-entry had an illegal value, then
+ INFO = -(i*100+j)
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ Further Details
+ ===============
+ Local Variables: I0:N0 defines a current unreduced segment of Z.
+ The shifts are accumulated in SIGMA. Iteration count is in ITER.
+ Ping-pong is controlled by PP (alternates between 0 and 1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>z</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasq3(int, org.netlib.util.intW, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean)"><!-- --></A><H3>
+slasq3</H3>
+<PRE>
+public abstract void <B>slasq3</B>(int i0,
+ org.netlib.util.intW n0,
+ float[] z,
+ int pp,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW sigma,
+ org.netlib.util.floatW desig,
+ org.netlib.util.floatW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ SIGMA (output) REAL
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) REAL
+ Lower order part of SIGMA
+
+ QMAX (input) REAL
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to SLASQ5).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>desig</CODE> - <DD><CODE>qmax</CODE> - <DD><CODE>nfail</CODE> - <DD><CODE>iter</CODE> - <DD><CODE>ndiv</CODE> - <DD><CODE>ieee</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasq4(int, int, float[], int, int, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slasq4</H3>
+<PRE>
+public abstract void <B>slasq4</B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ int n0in,
+ float dmin,
+ float dmin1,
+ float dmin2,
+ float dn,
+ float dn1,
+ float dn2,
+ org.netlib.util.floatW tau,
+ org.netlib.util.intW ttype)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) REAL
+ Minimum value of d.
+
+ DMIN1 (input) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) REAL
+ d(N)
+
+ DN1 (input) REAL
+ d(N-1)
+
+ DN2 (input) REAL
+ d(N-2)
+
+ TAU (output) REAL
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>n0in</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dn1</CODE> - <DD><CODE>dn2</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>ttype</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasq5(int, int, float[], int, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, boolean)"><!-- --></A><H3>
+slasq5</H3>
+<PRE>
+public abstract void <B>slasq5</B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ float tau,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW dmin1,
+ org.netlib.util.floatW dmin2,
+ org.netlib.util.floatW dn,
+ org.netlib.util.floatW dnm1,
+ org.netlib.util.floatW dnm2,
+ boolean ieee)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ5 computes one dqds transform in ping-pong form, one
+ version for IEEE machines another for non IEEE machines.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ TAU (input) REAL
+ This is the shift.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ DMIN1 (output) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) REAL
+ d(N0), the last value of d.
+
+ DNM1 (output) REAL
+ d(N0-1).
+
+ DNM2 (output) REAL
+ d(N0-2).
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic.
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dnm1</CODE> - <DD><CODE>dnm2</CODE> - <DD><CODE>ieee</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasq6(int, int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slasq6</H3>
+<PRE>
+public abstract void <B>slasq6</B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW dmin1,
+ org.netlib.util.floatW dmin2,
+ org.netlib.util.floatW dn,
+ org.netlib.util.floatW dnm1,
+ org.netlib.util.floatW dnm2)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ6 computes one dqd (shift equal to zero) transform in
+ ping-pong form, with protection against underflow and overflow.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ DMIN1 (output) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) REAL
+ d(N0), the last value of d.
+
+ DNM1 (output) REAL
+ d(N0-1).
+
+ DNM2 (output) REAL
+ d(N0-2).
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dnm1</CODE> - <DD><CODE>dnm2</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], float[], int)"><!-- --></A><H3>
+slasr</H3>
+<PRE>
+public abstract void <B>slasr</B>(java.lang.String side,
+ java.lang.String pivot,
+ java.lang.String direct,
+ int m,
+ int n,
+ float[] c,
+ float[] s,
+ float[] a,
+ int lda)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASR applies a sequence of plane rotations to a real matrix A,
+ from either the left or the right.
+
+ When SIDE = 'L', the transformation takes the form
+
+ A := P*A
+
+ and when SIDE = 'R', the transformation takes the form
+
+ A := A*P**T
+
+ where P is an orthogonal matrix consisting of a sequence of z plane
+ rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+ and P**T is the transpose of P.
+
+ When DIRECT = 'F' (Forward sequence), then
+
+ P = P(z-1) * ... * P(2) * P(1)
+
+ and when DIRECT = 'B' (Backward sequence), then
+
+ P = P(1) * P(2) * ... * P(z-1)
+
+ where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+
+
+ R(k) = ( c(k) s(k) )
+ = ( -s(k) c(k) ).
+
+ When PIVOT = 'V' (Variable pivot), the rotation is performed
+ for the plane (k,k+1), i.e., P(k) has the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears as a rank-2 modification to the identity matrix in
+ rows and columns k and k+1.
+
+ When PIVOT = 'T' (Top pivot), the rotation is performed for the
+ plane (1,k+1), so P(k) has the form
+
+ P(k) = ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears in rows and columns 1 and k+1.
+
+ Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+ performed for the plane (k,z), giving P(k) the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+
+ where R(k) appears in rows and columns k and z. The rotations are
+ performed without ever forming P(k) explicitly.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ Specifies whether the plane rotation matrix P is applied to
+ A on the left or the right.
+ = 'L': Left, compute A := P*A
+ = 'R': Right, compute A:= A*P**T
+
+ PIVOT (input) CHARACTER*1
+ Specifies the plane for which P(k) is a plane rotation
+ matrix.
+ = 'V': Variable pivot, the plane (k,k+1)
+ = 'T': Top pivot, the plane (1,k+1)
+ = 'B': Bottom pivot, the plane (k,z)
+
+ DIRECT (input) CHARACTER*1
+ Specifies whether P is a forward or backward sequence of
+ plane rotations.
+ = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+ = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
+
+ M (input) INTEGER
+ The number of rows of the matrix A. If m <= 1, an immediate
+
+ return is effected.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. If n <= 1, an
+ immediate return is effected.
+
+ C (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The cosines c(k) of the plane rotations.
+
+ S (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The sines s(k) of the plane rotations. The 2-by-2 plane
+ rotation part of the matrix P(k), R(k), has the form
+ R(k) = ( c(k) s(k) )
+ ( -s(k) c(k) ).
+
+ A (input/output) REAL array, dimension (LDA,N)
+ The M-by-N matrix A. On exit, A is overwritten by P*A if
+ SIDE = 'R' or by A*P**T if SIDE = 'L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>pivot</CODE> - <DD><CODE>direct</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>c</CODE> - <DD><CODE>s</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasrt(java.lang.String, int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slasrt</H3>
+<PRE>
+public abstract void <B>slasrt</B>(java.lang.String id,
+ int n,
+ float[] d,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Sort the numbers in D in increasing order (if ID = 'I') or
+ in decreasing order (if ID = 'D' ).
+
+ Use Quick Sort, reverting to Insertion sort on arrays of
+ size <= 20. Dimension of STACK limits N to about 2**32.
+
+ Arguments
+ =========
+
+ ID (input) CHARACTER*1
+ = 'I': sort D in increasing order;
+ = 'D': sort D in decreasing order.
+
+ N (input) INTEGER
+ The length of the array D.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the array to be sorted.
+ On exit, D has been sorted into increasing order
+ (D(1) <= ... <= D(N) ) or into decreasing order
+ (D(1) >= ... >= D(N) ), depending on ID.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>id</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slassq(int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slassq</H3>
+<PRE>
+public abstract void <B>slassq</B>(int n,
+ float[] x,
+ int incx,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW sumsq)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASSQ returns the values scl and smsq such that
+
+ ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+
+
+ where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+ assumed to be non-negative and scl returns the value
+
+ scl = max( scale, abs( x( i ) ) ).
+
+ scale and sumsq must be supplied in SCALE and SUMSQ and
+ scl and smsq are overwritten on SCALE and SUMSQ respectively.
+
+ The routine makes only one pass through the vector x.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of elements to be used from the vector X.
+
+ X (input) REAL array, dimension (N)
+ The vector for which a scaled sum of squares is computed.
+ x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector X.
+ INCX > 0.
+
+ SCALE (input/output) REAL
+ On entry, the value scale in the equation above.
+ On exit, SCALE is overwritten with scl , the scaling factor
+
+ for the sum of squares.
+
+ SUMSQ (input/output) REAL
+ On entry, the value sumsq in the equation above.
+ On exit, SUMSQ is overwritten with smsq , the basic sum of
+ squares from which scl has been factored out.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>x</CODE> - <DD><CODE>incx</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>sumsq</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasv2(float, float, float, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slasv2</H3>
+<PRE>
+public abstract void <B>slasv2</B>(float f,
+ float g,
+ float h,
+ org.netlib.util.floatW ssmin,
+ org.netlib.util.floatW ssmax,
+ org.netlib.util.floatW snr,
+ org.netlib.util.floatW csr,
+ org.netlib.util.floatW snl,
+ org.netlib.util.floatW csl)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASV2 computes the singular value decomposition of a 2-by-2
+ triangular matrix
+ [ F G ]
+ [ 0 H ].
+ On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+ smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+
+ right singular vectors for abs(SSMAX), giving the decomposition
+
+ [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+ [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+
+ Arguments
+ =========
+
+ F (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) REAL
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) REAL
+ abs(SSMIN) is the smaller singular value.
+
+ SSMAX (output) REAL
+ abs(SSMAX) is the larger singular value.
+
+ SNL (output) REAL
+ CSL (output) REAL
+ The vector (CSL, SNL) is a unit left singular vector for the
+
+ singular value abs(SSMAX).
+
+ SNR (output) REAL
+ CSR (output) REAL
+ The vector (CSR, SNR) is a unit right singular vector for the
+ singular value abs(SSMAX).
+
+ Further Details
+ ===============
+
+ Any input parameter may be aliased with any output parameter.
+
+ Barring over/underflow and assuming a guard digit in subtraction, all
+ output quantities are correct to within a few units in the last
+ place (ulps).
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>f</CODE> - <DD><CODE>g</CODE> - <DD><CODE>h</CODE> - <DD><CODE>ssmin</CODE> - <DD><CODE>ssmax</CODE> - <DD><CODE>snr</CODE> - <DD><CODE>csr</CODE> - <DD><CODE>snl</CODE> - <DD><CODE>csl</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slaswp(int, float[], int, int, int, int[], int)"><!-- --></A><H3>
+slaswp</H3>
+<PRE>
+public abstract void <B>slaswp</B>(int n,
+ float[] a,
+ int lda,
+ int k1,
+ int k2,
+ int[] ipiv,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASWP performs a series of row interchanges on the matrix A.
+ One row interchange is initiated for each of rows K1 through K2 of A.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of columns of the matrix A.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the matrix of column dimension N to which the row
+ interchanges will be applied.
+ On exit, the permuted matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+
+ K1 (input) INTEGER
+ The first element of IPIV for which a row interchange will
+ be done.
+
+ K2 (input) INTEGER
+ The last element of IPIV for which a row interchange will
+ be done.
+
+ IPIV (input) INTEGER array, dimension (K2*abs(INCX))
+ The vector of pivot indices. Only the elements in positions
+
+ K1 through K2 of IPIV are accessed.
+ IPIV(K) = L implies rows K and L are to be interchanged.
+
+ INCX (input) INTEGER
+ The increment between successive values of IPIV. If IPIV
+ is negative, the pivots are applied in reverse order.
+
+ Further Details
+ ===============
+
+ Modified by
+ R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>k1</CODE> - <DD><CODE>k2</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasy2(boolean, boolean, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.floatW, float[], int, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+slasy2</H3>
+<PRE>
+public abstract void <B>slasy2</B>(boolean ltranl,
+ boolean ltranr,
+ int isgn,
+ int n1,
+ int n2,
+ float[] tl,
+ int ldtl,
+ float[] tr,
+ int ldtr,
+ float[] b,
+ int ldb,
+ org.netlib.util.floatW scale,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW xnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
+
+ op(TL)*X + ISGN*X*op(TR) = SCALE*B,
+
+ where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
+
+ -1. op(T) = T or T', where T' denotes the transpose of T.
+
+ Arguments
+ =========
+
+ LTRANL (input) LOGICAL
+ On entry, LTRANL specifies the op(TL):
+ = .FALSE., op(TL) = TL,
+ = .TRUE., op(TL) = TL'.
+
+ LTRANR (input) LOGICAL
+ On entry, LTRANR specifies the op(TR):
+ = .FALSE., op(TR) = TR,
+ = .TRUE., op(TR) = TR'.
+
+ ISGN (input) INTEGER
+ On entry, ISGN specifies the sign of the equation
+ as described before. ISGN may only be 1 or -1.
+
+ N1 (input) INTEGER
+ On entry, N1 specifies the order of matrix TL.
+ N1 may only be 0, 1 or 2.
+
+ N2 (input) INTEGER
+ On entry, N2 specifies the order of matrix TR.
+ N2 may only be 0, 1 or 2.
+
+ TL (input) REAL array, dimension (LDTL,2)
+ On entry, TL contains an N1 by N1 matrix.
+
+ LDTL (input) INTEGER
+ The leading dimension of the matrix TL. LDTL >= max(1,N1).
+
+ TR (input) REAL array, dimension (LDTR,2)
+ On entry, TR contains an N2 by N2 matrix.
+
+ LDTR (input) INTEGER
+ The leading dimension of the matrix TR. LDTR >= max(1,N2).
+
+ B (input) REAL array, dimension (LDB,2)
+ On entry, the N1 by N2 matrix B contains the right-hand
+ side of the equation.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1,N1).
+
+ SCALE (output) REAL
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ less than or equal to 1 to prevent the solution overflowing.
+
+
+ X (output) REAL array, dimension (LDX,2)
+ On exit, X contains the N1 by N2 solution.
+
+ LDX (input) INTEGER
+ The leading dimension of the matrix X. LDX >= max(1,N1).
+
+ XNORM (output) REAL
+ On exit, XNORM is the infinity-norm of the solution.
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: TL and TR have too close eigenvalues, so TL or
+ TR is perturbed to get a nonsingular equation.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ltranl</CODE> - <DD><CODE>ltranr</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>tl</CODE> - <DD><CODE>ldtl</CODE> - <DD><CODE>tr</CODE> - <DD><CODE>ldtr</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>xnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slasyf(java.lang.String, int, int, org.netlib.util.intW, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slasyf</H3>
+<PRE>
+public abstract void <B>slasyf</B>(java.lang.String uplo,
+ int n,
+ int nb,
+ org.netlib.util.intW kb,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] w,
+ int ldw,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASYF computes a partial factorization of a real symmetric matrix A
+
+ using the Bunch-Kaufman diagonal pivoting method. The partial
+ factorization has the form:
+
+ A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
+ ( 0 U22 ) ( 0 D ) ( U12' U22' )
+
+ A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L'
+ ( L21 I ) ( 0 A22 ) ( 0 I )
+
+ where the order of D is at most NB. The actual order is returned in
+ the argument KB, and is either NB or NB-1, or N if N <= NB.
+
+ SLASYF is an auxiliary routine called by SSYTRF. It uses blocked code
+ (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
+ A22 (if UPLO = 'L').
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NB (input) INTEGER
+ The maximum number of columns of the matrix A that should be
+
+ factored. NB should be at least 2 to allow for 2-by-2 pivot
+
+ blocks.
+
+ KB (output) INTEGER
+ The number of columns of A that were actually factored.
+ KB is either NB-1 or NB, or N if N <= NB.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, A contains details of the partial factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If UPLO = 'U', only the last KB elements of IPIV are set;
+ if UPLO = 'L', only the first KB elements are set.
+
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ W (workspace) REAL array, dimension (LDW,NB)
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>w</CODE> - <DD><CODE>ldw</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatbs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], org.netlib.util.floatW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slatbs</H3>
+<PRE>
+public abstract void <B>slatbs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] x,
+ org.netlib.util.floatW scale,
+ float[] cnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATBS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular band matrix. Here A' denotes the transpose of A, x and b
+
+ are n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine STBSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of subdiagonals or superdiagonals in the
+ triangular matrix A. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first KD+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ X (input/output) REAL array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) REAL
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) REAL array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, STBSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine STBSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call STBSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>normin</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>x</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>cnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatdf(int, int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, int[], int[])"><!-- --></A><H3>
+slatdf</H3>
+<PRE>
+public abstract void <B>slatdf</B>(int ijob,
+ int n,
+ float[] z,
+ int ldz,
+ float[] rhs,
+ org.netlib.util.floatW rdsum,
+ org.netlib.util.floatW rdscal,
+ int[] ipiv,
+ int[] jpiv)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATDF uses the LU factorization of the n-by-n matrix Z computed by
+ SGETC2 and computes a contribution to the reciprocal Dif-estimate
+ by solving Z * x = b for x, and choosing the r.h.s. b such that
+ the norm of x is as large as possible. On entry RHS = b holds the
+ contribution from earlier solved sub-systems, and on return RHS = x.
+
+
+ The factorization of Z returned by SGETC2 has the form Z = P*L*U*Q,
+ where P and Q are permutation matrices. L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ IJOB = 2: First compute an approximative null-vector e
+ of Z using SGECON, e is normalized and solve for
+ Zx = +-e - f with the sign giving the greater value
+ of 2-norm(x). About 5 times as expensive as Default.
+ IJOB .ne. 2: Local look ahead strategy where all entries of
+ the r.h.s. b is choosen as either +1 or -1 (Default).
+
+ N (input) INTEGER
+ The number of columns of the matrix Z.
+
+ Z (input) REAL array, dimension (LDZ, N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix Z computed by SGETC2: Z = P * L * U * Q
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDA >= max(1, N).
+
+ RHS (input/output) REAL array, dimension N.
+ On entry, RHS contains contributions from other subsystems.
+ On exit, RHS contains the solution of the subsystem with
+ entries acoording to the value of IJOB (see above).
+
+ RDSUM (input/output) REAL
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by STGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when STGSY2 is called by STGSYL.
+
+ RDSCAL (input/output) REAL
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when STGSY2 is called by
+ STGSYL.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ This routine is a further developed implementation of algorithm
+ BSOLVE in [1] using complete pivoting in the LU factorization.
+
+ [1] Bo Kagstrom and Lars Westin,
+ Generalized Schur Methods with Condition Estimators for
+ Solving the Generalized Sylvester Equation, IEEE Transactions
+ on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
+
+ [2] Peter Poromaa,
+ On Efficient and Robust Estimators for the Separation
+ between two Regular Matrix Pairs with Applications in
+ Condition Estimation. Report IMINF-95.05, Departement of
+ Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ijob</CODE> - <DD><CODE>n</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>rhs</CODE> - <DD><CODE>rdsum</CODE> - <DD><CODE>rdscal</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>jpiv</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatps(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], float[], org.netlib.util.floatW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slatps</H3>
+<PRE>
+public abstract void <B>slatps</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ float[] ap,
+ float[] x,
+ org.netlib.util.floatW scale,
+ float[] cnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATPS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular matrix stored in packed form. Here A' denotes the
+ transpose of A, x and b are n-element vectors, and s is a scaling
+ factor, usually less than or equal to 1, chosen so that the
+ components of x will be less than the overflow threshold. If the
+ unscaled problem will not cause overflow, the Level 2 BLAS routine
+ STPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
+ then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ X (input/output) REAL array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) REAL
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) REAL array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, STPSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine STPSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call STPSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>normin</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>x</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>cnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatrd(java.lang.String, int, int, float[], int, float[], float[], float[], int)"><!-- --></A><H3>
+slatrd</H3>
+<PRE>
+public abstract void <B>slatrd</B>(java.lang.String uplo,
+ int n,
+ int nb,
+ float[] a,
+ int lda,
+ float[] e,
+ float[] tau,
+ float[] w,
+ int ldw)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATRD reduces NB rows and columns of a real symmetric matrix A to
+ symmetric tridiagonal form by an orthogonal similarity
+ transformation Q' * A * Q, and returns the matrices V and W which are
+ needed to apply the transformation to the unreduced part of A.
+
+ If UPLO = 'U', SLATRD reduces the last NB rows and columns of a
+ matrix, of which the upper triangle is supplied;
+ if UPLO = 'L', SLATRD reduces the first NB rows and columns of a
+ matrix, of which the lower triangle is supplied.
+
+ This is an auxiliary routine called by SSYTRD.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NB (input) INTEGER
+ The number of rows and columns to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit:
+ if UPLO = 'U', the last NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements above the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+
+ product of elementary reflectors;
+ if UPLO = 'L', the first NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements below the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= (1,N).
+
+ E (output) REAL array, dimension (N-1)
+ If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+ elements of the last NB columns of the reduced matrix;
+ if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+ the first NB columns of the reduced matrix.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors, stored in
+ TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+
+ See Further Details.
+
+ W (output) REAL array, dimension (LDW,NB)
+ The n-by-nb matrix W required to update the unreduced part
+ of A.
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n) H(n-1) . . . H(n-nb+1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+
+ and tau in TAU(i-1).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and tau in TAU(i).
+
+ The elements of the vectors v together form the n-by-nb matrix V
+ which is needed, with W, to apply the transformation to the unreduced
+ part of the matrix, using a symmetric rank-2k update of the form:
+ A := A - V*W' - W*V'.
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5 and nb = 2:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( a a a v4 v5 ) ( d )
+ ( a a v4 v5 ) ( 1 d )
+ ( a 1 v5 ) ( v1 1 a )
+ ( d 1 ) ( v1 v2 a a )
+ ( d ) ( v1 v2 a a a )
+
+ where d denotes a diagonal element of the reduced matrix, a denotes
+ an element of the original matrix that is unchanged, and vi denotes
+ an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nb</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>w</CODE> - <DD><CODE>ldw</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatrs(java.lang.String, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], org.netlib.util.floatW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+slatrs</H3>
+<PRE>
+public abstract void <B>slatrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ java.lang.String normin,
+ int n,
+ float[] a,
+ int lda,
+ float[] x,
+ org.netlib.util.floatW scale,
+ float[] cnorm,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATRS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow. Here A is an upper or lower
+ triangular matrix, A' denotes the transpose of A, x and b are
+ n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine STRSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max (1,N).
+
+ X (input/output) REAL array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) REAL
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) REAL array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, STRSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine STRSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call STRSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>normin</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>x</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>cnorm</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatrz(int, int, int, float[], int, float[], float[])"><!-- --></A><H3>
+slatrz</H3>
+<PRE>
+public abstract void <B>slatrz</B>(int m,
+ int n,
+ int l,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
+ [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means
+ of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal
+ matrix and, R and A1 are M-by-M upper triangular matrices.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing the
+ meaningful part of the Householder vectors. N-M >= L >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements N-L+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) REAL array, dimension (M)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an l element vector. tau and z( k )
+ are chosen to annihilate the elements of the kth row of A2.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A2, such that the elements of z( k ) are
+ in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A1.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slatzm(java.lang.String, int, int, float[], int, float, float[], float[], int, float[])"><!-- --></A><H3>
+slatzm</H3>
+<PRE>
+public abstract void <B>slatzm</B>(java.lang.String side,
+ int m,
+ int n,
+ float[] v,
+ int incv,
+ float tau,
+ float[] c1,
+ float[] c2,
+ int Ldc,
+ float[] work)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SORMRZ.
+
+ SLATZM applies a Householder matrix generated by STZRQF to a matrix.
+
+
+ Let P = I - tau*u*u', u = ( 1 ),
+ ( v )
+ where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
+ SIDE = 'R'.
+
+ If SIDE equals 'L', let
+ C = [ C1 ] 1
+ [ C2 ] m-1
+ n
+ Then C is overwritten by P*C.
+
+ If SIDE equals 'R', let
+ C = [ C1, C2 ] m
+ 1 n-1
+ Then C is overwritten by C*P.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form P * C
+ = 'R': form C * P
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) REAL array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of P. V is not used
+ if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0
+
+ TAU (input) REAL
+ The value tau in the representation of P.
+
+ C1 (input/output) REAL array, dimension
+ (LDC,N) if SIDE = 'L'
+ (M,1) if SIDE = 'R'
+ On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
+ if SIDE = 'R'.
+
+ On exit, the first row of P*C if SIDE = 'L', or the first
+ column of C*P if SIDE = 'R'.
+
+ C2 (input/output) REAL array, dimension
+ (LDC, N) if SIDE = 'L'
+ (LDC, N-1) if SIDE = 'R'
+ On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
+ m x (n - 1) matrix C2 if SIDE = 'R'.
+
+ On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
+ if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the arrays C1 and C2. LDC >= (1,M).
+
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>v</CODE> - <DD><CODE>incv</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c1</CODE> - <DD><CODE>c2</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slauu2(java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slauu2</H3>
+<PRE>
+public abstract void <B>slauu2</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAUU2 computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the unblocked form of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slauum(java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+slauum</H3>
+<PRE>
+public abstract void <B>slauum</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAUUM computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the blocked form of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slazq3(int, org.netlib.util.intW, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.intW, boolean, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW)"><!-- --></A><H3>
+slazq3</H3>
+<PRE>
+public void <B>slazq3</B>(int i0,
+ org.netlib.util.intW n0,
+ float[] z,
+ int pp,
+ org.netlib.util.floatW dmin,
+ org.netlib.util.floatW sigma,
+ org.netlib.util.floatW desig,
+ org.netlib.util.floatW qmax,
+ org.netlib.util.intW nfail,
+ org.netlib.util.intW iter,
+ org.netlib.util.intW ndiv,
+ boolean ieee,
+ org.netlib.util.intW ttype,
+ org.netlib.util.floatW dmin1,
+ org.netlib.util.floatW dmin2,
+ org.netlib.util.floatW dn,
+ org.netlib.util.floatW dn1,
+ org.netlib.util.floatW dn2,
+ org.netlib.util.floatW tau)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAZQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ SIGMA (output) REAL
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) REAL
+ Lower order part of SIGMA
+
+ QMAX (input) REAL
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to SLASQ5).
+
+ TTYPE (input/output) INTEGER
+ Shift type. TTYPE is passed as an argument in order to save
+ its value between calls to SLAZQ3
+
+ DMIN1 (input/output) REAL
+ DMIN2 (input/output) REAL
+ DN (input/output) REAL
+ DN1 (input/output) REAL
+ DN2 (input/output) REAL
+ TAU (input/output) REAL
+ These are passed as arguments in order to save their values
+ between calls to SLAZQ3
+
+ This is a thread safe version of SLASQ3, which passes TTYPE, DMIN1,
+ DMIN2, DN, DN1. DN2 and TAU through the argument list in place of
+ declaring them in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>sigma</CODE> - <DD><CODE>desig</CODE> - <DD><CODE>qmax</CODE> - <DD><CODE>nfail</CODE> - <DD><CODE>iter</CODE> - <DD><CODE>ndiv</CODE> - <DD><CODE>ieee</CODE> - <DD><CODE>ttype</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dn1</CODE> - <DD><CODE>dn2</CODE> - <DD><CODE>tau</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slazq4(int, int, float[], int, int, float, float, float, float, float, float, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW)"><!-- --></A><H3>
+slazq4</H3>
+<PRE>
+public void <B>slazq4</B>(int i0,
+ int n0,
+ float[] z,
+ int pp,
+ int n0in,
+ float dmin,
+ float dmin1,
+ float dmin2,
+ float dn,
+ float dn1,
+ float dn2,
+ org.netlib.util.floatW tau,
+ org.netlib.util.intW ttype,
+ org.netlib.util.floatW g)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAZQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) REAL
+ Minimum value of d.
+
+ DMIN1 (input) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) REAL
+ d(N)
+
+ DN1 (input) REAL
+ d(N-1)
+
+ DN2 (input) REAL
+ d(N-2)
+
+ TAU (output) REAL
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ G (input/output) REAL
+ G is passed as an argument in order to save its value between
+ calls to SLAZQ4
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ This is a thread safe version of SLASQ4, which passes G through the
+ argument list in place of declaring G in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>i0</CODE> - <DD><CODE>n0</CODE> - <DD><CODE>z</CODE> - <DD><CODE>pp</CODE> - <DD><CODE>n0in</CODE> - <DD><CODE>dmin</CODE> - <DD><CODE>dmin1</CODE> - <DD><CODE>dmin2</CODE> - <DD><CODE>dn</CODE> - <DD><CODE>dn1</CODE> - <DD><CODE>dn2</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>ttype</CODE> - <DD><CODE>g</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sopgtr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sopgtr</H3>
+<PRE>
+public abstract void <B>sopgtr</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] tau,
+ float[] q,
+ int ldq,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SOPGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors H(i) of order n, as returned by
+
+ SSPTRD using packed storage:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to SSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to SSPTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The vectors which define the elementary reflectors, as
+ returned by SSPTRD.
+
+ TAU (input) REAL array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSPTRD.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ The N-by-N orthogonal matrix Q.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (N-1)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sopmtr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sopmtr</H3>
+<PRE>
+public abstract void <B>sopmtr</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ float[] ap,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SOPMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by SSPTRD using packed
+ storage:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to SSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to SSPTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ AP (input) REAL array, dimension
+ (M*(M+1)/2) if SIDE = 'L'
+ (N*(N+1)/2) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by SSPTRD. AP is modified by the routine but
+ restored on exit.
+
+ TAU (input) REAL array, dimension (M-1) if SIDE = 'L'
+ or (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSPTRD.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorg2l(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorg2l</H3>
+<PRE>
+public abstract void <B>sorg2l</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORG2L generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the last n columns of a product of k elementary
+ reflectors of order m
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQLF in the last k columns of its array
+ argument A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorg2r(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorg2r</H3>
+<PRE>
+public abstract void <B>sorg2r</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORG2R generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the first n columns of a product of k elementary
+
+ reflectors of order m
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQRF in the first k columns of its array
+ argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgbr(java.lang.String, int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorgbr</H3>
+<PRE>
+public abstract void <B>sorgbr</B>(java.lang.String vect,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGBR generates one of the real orthogonal matrices Q or P**T
+ determined by SGEBRD when reducing a real matrix A to bidiagonal
+ form: A = Q * B * P**T. Q and P**T are defined as products of
+ elementary reflectors H(i) or G(i) respectively.
+
+ If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
+ is of order M:
+ if m >= k, Q = H(1) H(2) . . . H(k) and SORGBR returns the first n
+ columns of Q, where m >= n >= k;
+ if m < k, Q = H(1) H(2) . . . H(m-1) and SORGBR returns Q as an
+ M-by-M matrix.
+
+ If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
+ is of order N:
+ if k < n, P**T = G(k) . . . G(2) G(1) and SORGBR returns the first m
+
+ rows of P**T, where n >= m >= k;
+ if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as
+ an N-by-N matrix.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether the matrix Q or the matrix P**T is
+ required, as defined in the transformation applied by SGEBRD:
+ = 'Q': generate Q;
+ = 'P': generate P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix Q or P**T to be returned.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q or P**T to be returned.
+ N >= 0.
+ If VECT = 'Q', M >= N >= min(M,K);
+ if VECT = 'P', N >= M >= min(N,K).
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original M-by-K
+ matrix reduced by SGEBRD.
+ If VECT = 'P', the number of rows in the original K-by-N
+ matrix reduced by SGEBRD.
+ K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by SGEBRD.
+ On exit, the M-by-N matrix Q or P**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension
+ (min(M,K)) if VECT = 'Q'
+ (min(N,K)) if VECT = 'P'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i), which determines Q or P**T, as
+ returned by SGEBRD in its array argument TAUQ or TAUP.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,min(M,N)).
+ For optimum performance LWORK >= min(M,N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorghr(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorghr</H3>
+<PRE>
+public abstract void <B>sorghr</B>(int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGHR generates a real orthogonal matrix Q which is defined as the
+ product of IHI-ILO elementary reflectors of order N, as returned by
+ SGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of SGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by SGEHRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEHRD.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= IHI-ILO.
+ For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgl2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorgl2</H3>
+<PRE>
+public abstract void <B>sorgl2</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGL2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the first m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by SGELQF in the first k rows of its array argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorglq(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorglq</H3>
+<PRE>
+public abstract void <B>sorglq</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGLQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the first M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by SGELQF in the first k rows of its array argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgql(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorgql</H3>
+<PRE>
+public abstract void <B>sorgql</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGQL generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the last N columns of a product of K elementary
+ reflectors of order M
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQLF in the last k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgqr(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorgqr</H3>
+<PRE>
+public abstract void <B>sorgqr</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGQR generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the first N columns of a product of K elementary
+
+ reflectors of order M
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQRF in the first k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgr2(int, int, int, float[], int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorgr2</H3>
+<PRE>
+public abstract void <B>sorgr2</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGR2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the last m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGERQF in the last k rows of its array argument
+ A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgrq(int, int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorgrq</H3>
+<PRE>
+public abstract void <B>sorgrq</B>(int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGRQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the last M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGERQF in the last k rows of its array argument
+ A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorgtr(java.lang.String, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sorgtr</H3>
+<PRE>
+public abstract void <B>sorgtr</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors of order N, as returned by
+ SSYTRD:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from SSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from SSYTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by SSYTRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSYTRD.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N-1).
+ For optimum performance LWORK >= (N-1)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorm2l(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorm2l</H3>
+<PRE>
+public abstract void <B>sorm2l</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORM2L overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorm2r(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorm2r</H3>
+<PRE>
+public abstract void <B>sorm2r</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORM2R overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormbr(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormbr</H3>
+<PRE>
+public abstract void <B>sormbr</B>(java.lang.String vect,
+ java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ If VECT = 'Q', SORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ If VECT = 'P', SORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': P * C C * P
+ TRANS = 'T': P**T * C C * P**T
+
+ Here Q and P**T are the orthogonal matrices determined by SGEBRD when
+ reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
+
+ P**T are defined as products of elementary reflectors H(i) and G(i)
+ respectively.
+
+ Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
+ order of the orthogonal matrix Q or P**T that is applied.
+
+ If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
+ if nq >= k, Q = H(1) H(2) . . . H(k);
+ if nq < k, Q = H(1) H(2) . . . H(nq-1).
+
+ If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
+ if k < nq, P = G(1) G(2) . . . G(k);
+ if k >= nq, P = G(1) G(2) . . . G(nq-1).
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'Q': apply Q or Q**T;
+ = 'P': apply P or P**T.
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q, Q**T, P or P**T from the Left;
+ = 'R': apply Q, Q**T, P or P**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q or P;
+ = 'T': Transpose, apply Q**T or P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original
+ matrix reduced by SGEBRD.
+ If VECT = 'P', the number of rows in the original
+ matrix reduced by SGEBRD.
+ K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,min(nq,K)) if VECT = 'Q'
+ (LDA,nq) if VECT = 'P'
+ The vectors which define the elementary reflectors H(i) and
+ G(i), whose products determine the matrices Q and P, as
+ returned by SGEBRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If VECT = 'Q', LDA >= max(1,nq);
+ if VECT = 'P', LDA >= max(1,min(nq,K)).
+
+ TAU (input) REAL array, dimension (min(nq,K))
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i) which determines Q or P, as returned
+ by SGEBRD in the array argument TAUQ or TAUP.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
+ or P*C or P**T*C or C*P or C*P**T.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormhr(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormhr</H3>
+<PRE>
+public abstract void <B>sormhr</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int ilo,
+ int ihi,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMHR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ IHI-ILO elementary reflectors, as returned by SGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of SGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
+ ILO = 1 and IHI = 0, if M = 0;
+ if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
+ ILO = 1 and IHI = 0, if N = 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by SGEHRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEHRD.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ilo</CODE> - <DD><CODE>ihi</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sorml2(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sorml2</H3>
+<PRE>
+public abstract void <B>sorml2</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORML2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormlq(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormlq</H3>
+<PRE>
+public abstract void <B>sormlq</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMLQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormql(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormql</H3>
+<PRE>
+public abstract void <B>sormql</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMQL overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormqr(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormqr</H3>
+<PRE>
+public abstract void <B>sormqr</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMQR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormr2(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sormr2</H3>
+<PRE>
+public abstract void <B>sormr2</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMR2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormr3(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sormr3</H3>
+<PRE>
+public abstract void <B>sormr3</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMR3 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ STZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by STZRZF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormrq(java.lang.String, java.lang.String, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormrq</H3>
+<PRE>
+public abstract void <B>sormrq</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMRQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormrz(java.lang.String, java.lang.String, int, int, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormrz</H3>
+<PRE>
+public abstract void <B>sormrz</B>(java.lang.String side,
+ java.lang.String trans,
+ int m,
+ int n,
+ int k,
+ int l,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMRZ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ STZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by STZRZF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sormtr(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sormtr</H3>
+<PRE>
+public abstract void <B>sormtr</B>(java.lang.String side,
+ java.lang.String uplo,
+ java.lang.String trans,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] c,
+ int Ldc,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by SSYTRD:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from SSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from SSYTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by SSYTRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSYTRD.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbcon(java.lang.String, int, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+spbcon</H3>
+<PRE>
+public abstract void <B>spbcon</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite band matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by SPBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ ANORM (input) REAL
+ The 1-norm (or infinity-norm) of the symmetric band matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbequ(java.lang.String, int, int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+spbequ</H3>
+<PRE>
+public abstract void <B>spbequ</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] s,
+ org.netlib.util.floatW scond,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite band matrix A and reduce its condition
+ number (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular of A is stored;
+ = 'L': Lower triangular of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ S (output) REAL array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) REAL
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbrfs(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+spbrfs</H3>
+<PRE>
+public abstract void <B>spbrfs</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and banded, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ AFB (input) REAL array, dimension (LDAFB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A as computed by
+
+ SPBTRF, in the same storage format as A (see AB).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbstf(java.lang.String, int, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spbstf</H3>
+<PRE>
+public abstract void <B>spbstf</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBSTF computes a split Cholesky factorization of a real
+ symmetric positive definite band matrix A.
+
+ This routine is designed to be used in conjunction with SSBGST.
+
+ The factorization has the form A = S**T*S where S is a band matrix
+
+ of the same bandwidth as A and the following structure:
+
+ S = ( U )
+ ( M L )
+
+ where U is upper triangular of order m = (n+kd)/2, and L is lower
+ triangular of order n-m.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first kd+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the factor S from the split Cholesky
+ factorization A = S**T*S. See Further Details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the factorization could not be completed,
+ because the updated element a(i,i) was negative; the
+ matrix A is not positive definite.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 7, KD = 2:
+
+ S = ( s11 s12 s13 )
+ ( s22 s23 s24 )
+ ( s33 s34 )
+ ( s44 )
+ ( s53 s54 s55 )
+ ( s64 s65 s66 )
+ ( s75 s76 s77 )
+
+ If UPLO = 'U', the array AB holds:
+
+ on entry: on exit:
+
+ * a13 a24 a35 a46 a57 * * s13 s24 s53 s64 s75
+
+ a12 a23 a34 a45 a56 a67 * s12 s23 s34 s54 s65 s76
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+
+ If UPLO = 'L', the array AB holds:
+
+ on entry: on exit:
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+ a21 a32 a43 a54 a65 a76 * s12 s23 s34 s54 s65 s76 *
+ a31 a42 a53 a64 a64 * * s13 s24 s53 s64 s75 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbsv(java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spbsv</H3>
+<PRE>
+public abstract void <B>spbsv</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix, with the same number of superdiagonals or
+ subdiagonals as A. The factored form of A is then used to solve the
+
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * a13 a24 a35 a46 * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbsvx(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+spbsvx</H3>
+<PRE>
+public abstract void <B>spbsvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] afb,
+ int ldafb,
+ org.netlib.util.StringW equed,
+ float[] s,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AB and AFB will not
+ be modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right-hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array, except
+
+ if FACT = 'F' and EQUED = 'Y', then A must contain the
+ equilibrated matrix diag(S)*A*diag(S). The j-th column of A
+
+ is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ AFB (input or output) REAL array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the band matrix
+ A, in the same storage format as A (see AB). If EQUED = 'Y',
+ then AFB is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) REAL array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13
+ a22 a23 a24
+ a33 a34 a35
+ a44 a45 a46
+ a55 a56
+ (aij=conjg(aji)) a66
+
+ Band storage of the upper triangle of A:
+
+ * a13 a24 a35 a46
+ a12 a23 a34 a45 a56
+ a11 a22 a33 a44 a55 a66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ a11 a22 a33 a44 a55 a66
+ a21 a32 a43 a54 a65 *
+ a31 a42 a53 a64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>afb</CODE> - <DD><CODE>ldafb</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>s</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD>< [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbtf2(java.lang.String, int, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spbtf2</H3>
+<PRE>
+public abstract void <B>spbtf2</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBTF2 computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix, U' is the transpose of U, and
+
+ L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * a13 a24 a35 a46 * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbtrf(java.lang.String, int, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spbtrf</H3>
+<PRE>
+public abstract void <B>spbtrf</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBTRF computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * a13 a24 a35 a46 * * u13 u24 u35 u46
+ a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ Contributed by
+ Peter Mayes and Giuseppe Radicati, IBM ECSEC, Rome, March 23, 1989
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spbtrs(java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spbtrs</H3>
+<PRE>
+public abstract void <B>spbtrs</B>(java.lang.String uplo,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite band matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by SPBTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spocon(java.lang.String, int, float[], int, float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+spocon</H3>
+<PRE>
+public abstract void <B>spocon</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) REAL
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spoequ(int, float[], int, float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+spoequ</H3>
+<PRE>
+public abstract void <B>spoequ</B>(int n,
+ float[] a,
+ int lda,
+ float[] s,
+ org.netlib.util.floatW scond,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A and reduce its condition number
+
+ (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The N-by-N symmetric positive definite matrix whose scaling
+ factors are to be computed. Only the diagonal elements of A
+
+ are referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ S (output) REAL array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) REAL
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sporfs(java.lang.String, int, int, float[], int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sporfs</H3>
+<PRE>
+public abstract void <B>sporfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPORFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite,
+ and provides error bounds and backward error estimates for the
+ solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) REAL array, dimension (LDAF,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPOTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPOTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sposv(java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sposv</H3>
+<PRE>
+public abstract void <B>sposv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sposvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sposvx</H3>
+<PRE>
+public abstract void <B>sposvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ org.netlib.util.StringW equed,
+ float[] s,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. A and AF will not
+ be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A, except if FACT = 'F' and
+ EQUED = 'Y', then A must contain the equilibrated matrix
+ diag(S)*A*diag(S). If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) REAL array, dimension (LDAF,N)
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A. If EQUED .ne. 'N', then AF is the factored form
+ of the equilibrated matrix diag(S)*A*diag(S).
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the original
+ matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) REAL array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>s</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spotf2(java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spotf2</H3>
+<PRE>
+public abstract void <B>spotf2</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTF2 computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spotrf(java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spotrf</H3>
+<PRE>
+public abstract void <B>spotrf</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the block version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spotri(java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spotri</H3>
+<PRE>
+public abstract void <B>spotri</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by SPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, as computed by
+ SPOTRF.
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spotrs(java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spotrs</H3>
+<PRE>
+public abstract void <B>spotrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by SPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sppcon(java.lang.String, int, float[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sppcon</H3>
+<PRE>
+public abstract void <B>sppcon</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite packed matrix using
+ the Cholesky factorization A = U**T*U or A = L*L**T computed by
+ SPPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ ANORM (input) REAL
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sppequ(java.lang.String, int, float[], float[], org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+sppequ</H3>
+<PRE>
+public abstract void <B>sppequ</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] s,
+ org.netlib.util.floatW scond,
+ org.netlib.util.floatW amax,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A in packed storage and reduce
+ its condition number (with respect to the two-norm). S contains the
+
+ scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
+
+ B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
+ This choice of S puts the condition number of B within a factor N of
+
+ the smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ S (output) REAL array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) REAL
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>s</CODE> - <DD><CODE>scond</CODE> - <DD><CODE>amax</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spprfs(java.lang.String, int, int, float[], float[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+spprfs</H3>
+<PRE>
+public abstract void <B>spprfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ AFP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPPTRF/CPPTRF,
+ packed columnwise in a linear array in the same format as A
+ (see AP).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sppsv(java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sppsv</H3>
+<PRE>
+public abstract void <B>sppsv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sppsvx(java.lang.String, java.lang.String, int, int, float[], float[], org.netlib.util.StringW, float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sppsvx</H3>
+<PRE>
+public abstract void <B>sppsvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ org.netlib.util.StringW equed,
+ float[] s,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFP contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AP and AFP will not
+ be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array, except if FACT = 'F'
+
+ and EQUED = 'Y', then A must contain the equilibrated matrix
+
+ diag(S)*A*diag(S). The j-th column of A is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ AFP (input or output) REAL array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L', in the same storage
+ format as A. If EQUED .ne. 'N', then AFP is the factored
+ form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the original matrix A.
+
+
+ If FACT = 'E', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the equilibrated
+ matrix A (see the description of AP for the form of the
+ equilibrated matrix).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) REAL array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>equed</CODE> - <DD><CODE>s</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spptrf(java.lang.String, int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+spptrf</H3>
+<PRE>
+public abstract void <B>spptrf</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A stored in packed format.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T, in the same
+
+ storage format as A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ======= =======
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spptri(java.lang.String, int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+spptri</H3>
+<PRE>
+public abstract void <B>spptri</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by SPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor is stored in AP;
+ = 'L': Lower triangular factor is stored in AP.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, packed columnwise as
+
+ a linear array. The j-th column of U or L is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spptrs(java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spptrs</H3>
+<PRE>
+public abstract void <B>spptrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A in packed storage using the Cholesky
+ factorization A = U**T*U or A = L*L**T computed by SPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sptcon(int, float[], float[], float, org.netlib.util.floatW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sptcon</H3>
+<PRE>
+public abstract void <B>sptcon</B>(int n,
+ float[] d,
+ float[] e,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTCON computes the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite tridiagonal matrix
+ using the factorization A = L*D*L**T or A = U**T*D*U computed by
+ SPTTRF.
+
+ Norm(inv(A)) is computed by a direct method, and the reciprocal of
+ the condition number is computed as
+ RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization of A, as computed by SPTTRF.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) off-diagonal elements of the unit bidiagonal factor
+ U or L from the factorization of A, as computed by SPTTRF.
+
+ ANORM (input) REAL
+ The 1-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
+ 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The method used is described in Nicholas J. Higham, "Efficient
+ Algorithms for Computing the Condition Number of a Tridiagonal
+ Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spteqr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+spteqr</H3>
+<PRE>
+public abstract void <B>spteqr</B>(java.lang.String compz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric positive definite tridiagonal matrix by first factoring the
+ matrix using SPTTRF, and then calling SBDSQR to compute the singular
+
+ values of the bidiagonal factor.
+
+ This routine computes the eigenvalues of the positive definite
+ tridiagonal matrix to high relative accuracy. This means that if the
+ eigenvalues range over many orders of magnitude in size, then the
+ small eigenvalues and corresponding eigenvectors will be computed
+ more accurately than, for example, with the standard QR method.
+
+ The eigenvectors of a full or band symmetric positive definite matrix
+ can also be found if SSYTRD, SSPTRD, or SSBTRD has been used to
+ reduce this matrix to tridiagonal form. (The reduction to tridiagonal
+ form, however, may preclude the possibility of obtaining high
+ relative accuracy in the small eigenvalues of the original matrix, if
+ these eigenvalues range over many orders of magnitude.)
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvectors of original symmetric
+ matrix also. Array Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal
+ matrix.
+ On normal exit, D contains the eigenvalues, in descending
+ order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix used in the
+ reduction to tridiagonal form.
+ On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
+
+ original symmetric matrix;
+ if COMPZ = 'I', the orthonormal eigenvectors of the
+ tridiagonal matrix.
+ If INFO > 0 on exit, Z contains the eigenvectors associated
+ with only the stored eigenvalues.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ COMPZ = 'V' or 'I', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is:
+ <= N the Cholesky factorization of the matrix could
+ not be performed because the i-th principal minor
+ was not positive definite.
+ > N the SVD algorithm failed to converge;
+ if INFO = N+i, i off-diagonal elements of the
+ bidiagonal factor did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sptrfs(int, int, float[], float[], float[], float[], float[], int, float[], int, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sptrfs</H3>
+<PRE>
+public abstract void <B>sptrfs</B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] df,
+ float[] ef,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and tridiagonal, and provides error bounds and backward error
+ estimates for the solution.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization computed by SPTTRF.
+
+ EF (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the factorization computed by SPTTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>df</CODE> - <DD><CODE>ef</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sptsv(int, int, float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sptsv</H3>
+<PRE>
+public abstract void <B>sptsv</B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTSV computes the solution to a real system of linear equations
+ A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
+ matrix, and X and B are N-by-NRHS matrices.
+
+ A is factored as A = L*D*L**T, and the factored form of A is then
+ used to solve the system of equations.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the factorization A = L*D*L**T.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L**T factorization of
+ A. (E can also be regarded as the superdiagonal of the unit
+
+ bidiagonal factor U from the U**T*D*U factorization of A.)
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the solution has not been
+ computed. The factorization has not been completed
+ unless i = N.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sptsvx(java.lang.String, int, int, float[], float[], float[], float[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sptsvx</H3>
+<PRE>
+public abstract void <B>sptsvx</B>(java.lang.String fact,
+ int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] df,
+ float[] ef,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTSVX uses the factorization A = L*D*L**T to compute the solution
+ to a real system of linear equations A*X = B, where A is an N-by-N
+ symmetric positive definite tridiagonal matrix and X and B are
+ N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
+ is a unit lower bidiagonal matrix and D is diagonal. The
+ factorization can also be regarded as having the form
+ A = U**T*D*U.
+
+ 2. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, DF and EF contain the factored form of A.
+ D, E, DF, and EF will not be modified.
+ = 'N': The matrix A will be copied to DF and EF and
+ factored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input or output) REAL array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+
+ EF (input or output) REAL array, dimension (N-1)
+ If FACT = 'F', then EF is an input argument and on entry
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+ If FACT = 'N', then EF is an output argument and on exit
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The reciprocal condition number of the matrix A. If RCOND
+ is less than the machine precision (in particular, if
+ RCOND = 0), the matrix is singular to working precision.
+ This condition is indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in any
+ element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>df</CODE> - <DD><CODE>ef</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spttrf(int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+spttrf</H3>
+<PRE>
+public abstract void <B>spttrf</B>(int n,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTTRF computes the L*D*L' factorization of a real symmetric
+ positive definite tridiagonal matrix A. The factorization may also
+ be regarded as having the form A = U'*D*U.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the L*D*L' factorization of A.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L' factorization of A.
+
+ E can also be regarded as the superdiagonal of the unit
+ bidiagonal factor U from the U'*D*U factorization of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite; if k < N, the factorization could not
+ be completed, while if k = N, the factorization was
+ completed, but D(N) <= 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="spttrs(int, int, float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+spttrs</H3>
+<PRE>
+public abstract void <B>spttrs</B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTTRS solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by SPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sptts2(int, int, float[], float[], float[], int)"><!-- --></A><H3>
+sptts2</H3>
+<PRE>
+public abstract void <B>sptts2</B>(int n,
+ int nrhs,
+ float[] d,
+ float[] e,
+ float[] b,
+ int ldb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTTS2 solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by SPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="srscl(int, float, float[], int)"><!-- --></A><H3>
+srscl</H3>
+<PRE>
+public abstract void <B>srscl</B>(int n,
+ float sa,
+ float[] sx,
+ int incx)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SRSCL multiplies an n-element real vector x by the real scalar 1/a.
+ This is done without overflow or underflow as long as
+ the final result x/a does not overflow or underflow.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of components of the vector x.
+
+ SA (input) REAL
+ The scalar a which is used to divide each component of x.
+ SA must be >= 0, or the subroutine will divide by zero.
+
+ SX (input/output) REAL array, dimension
+ (1+(N-1)*abs(INCX))
+ The n-element vector x.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector SX.
+ > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
+
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>sa</CODE> - <DD><CODE>sx</CODE> - <DD><CODE>incx</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbev(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssbev</H3>
+<PRE>
+public abstract void <B>ssbev</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBEV computes all the eigenvalues and, optionally, eigenvectors of
+ a real symmetric band matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (max(1,3*N-2))
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbevd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssbevd</H3>
+<PRE>
+public abstract void <B>ssbevd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBEVD computes all the eigenvalues and, optionally, eigenvectors of
+
+ a real symmetric band matrix A. If eigenvectors are desired, it uses
+
+ a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ IF N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 2, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 2, LWORK must be at least
+ ( 1 + 5*N + 2*N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array LIWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbevx(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssbevx</H3>
+<PRE>
+public abstract void <B>ssbevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] q,
+ int ldq,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric band matrix A. Eigenvalues and eigenvectors can
+
+ be selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ Q (output) REAL array, dimension (LDQ, N)
+ If JOBZ = 'V', the N-by-N orthogonal matrix used in the
+ reduction to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'V', then
+ LDQ >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AB to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (7*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbgst(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssbgst</H3>
+<PRE>
+public abstract void <B>ssbgst</B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] x,
+ int ldx,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGST reduces a real symmetric-definite banded generalized
+ eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
+ such that C has the same bandwidth as A.
+
+ B must have been previously factorized as S**T*S by SPBSTF, using a
+ split Cholesky factorization. A is overwritten by C = X**T*A*X, where
+ X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the
+ bandwidth of A.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form the transformation matrix X;
+ = 'V': form X.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= KB >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the transformed matrix X**T*A*X, stored in the same
+
+ format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input) REAL array, dimension (LDBB,N)
+ The banded factor S from the split Cholesky factorization of
+
+ B, as returned by SPBSTF, stored in the first KB+1 rows of
+ the array.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ X (output) REAL array, dimension (LDX,N)
+ If VECT = 'V', the n-by-n matrix X.
+ If VECT = 'N', the array X is not referenced.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X.
+ LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbgv(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssbgv</H3>
+<PRE>
+public abstract void <B>ssbgv</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+ and banded, and B is also positive definite.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) REAL array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by SPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so that Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= N.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then SPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbgvd(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssbgvd</H3>
+<PRE>
+public abstract void <B>ssbgvd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of the
+
+ form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and
+
+ banded, and B is also positive definite. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) REAL array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by SPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 3*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 5*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if LIWORK > 0, IWORK(1) returns the optimal LIWORK.
+
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then SPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbgvx(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssbgvx</H3>
+<PRE>
+public abstract void <B>ssbgvx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ int ka,
+ int kb,
+ float[] ab,
+ int ldab,
+ float[] bb,
+ int ldbb,
+ float[] q,
+ int ldq,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+
+ and banded, and B is also positive definite. Eigenvalues and
+ eigenvectors can be selected by specifying either all eigenvalues,
+ a range of values or a range of indices for the desired eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) REAL array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by SPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ Q (output) REAL array, dimension (LDQ, N)
+ If JOBZ = 'V', the n-by-n matrix used in the reduction of
+ A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
+ and consequently C to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'N',
+ LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (7N)
+
+ IWORK (workspace/output) INTEGER array, dimension (5N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvalues that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ < 0 : if INFO = -i, the i-th argument had an illegal value
+ <= N: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in IFAIL.
+ > N : SPBSTF returned an error code; i.e.,
+ if INFO = N + i, for 1 <= i <= N, then the leading
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ka</CODE> - <DD><CODE>kb</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>bb</CODE> - <DD><CODE>ldbb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssbtrd(java.lang.String, java.lang.String, int, int, float[], int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssbtrd</H3>
+<PRE>
+public abstract void <B>ssbtrd</B>(java.lang.String vect,
+ java.lang.String uplo,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ float[] d,
+ float[] e,
+ float[] q,
+ int ldq,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBTRD reduces a real symmetric band matrix A to symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form Q;
+ = 'V': form Q;
+ = 'U': update a matrix X, by forming X*Q.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ On exit, the diagonal elements of AB are overwritten by the
+ diagonal elements of the tridiagonal matrix T; if KD > 0, the
+ elements on the first superdiagonal (if UPLO = 'U') or the
+ first subdiagonal (if UPLO = 'L') are overwritten by the
+ off-diagonal elements of T; the rest of AB is overwritten by
+
+ values generated during the reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if VECT = 'U', then Q must contain an N-by-N
+ matrix X; if VECT = 'N' or 'V', then Q need not be set.
+
+ On exit:
+ if VECT = 'V', Q contains the N-by-N orthogonal matrix Q;
+ if VECT = 'U', Q contains the product X*Q;
+ if VECT = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Modified by Linda Kaufman, Bell Labs.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>vect</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspcon(java.lang.String, int, float[], int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sspcon</H3>
+<PRE>
+public abstract void <B>sspcon</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric packed matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ ANORM (input) REAL
+ The 1-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspev(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sspev</H3>
+<PRE>
+public abstract void <B>sspev</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPEV computes all the eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A in packed storage.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspevd(java.lang.String, java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sspevd</H3>
+<PRE>
+public abstract void <B>sspevd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPEVD computes all the eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspevx(java.lang.String, java.lang.String, java.lang.String, int, float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sspevx</H3>
+<PRE>
+public abstract void <B>sspevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. Eigenvalues/vectors
+
+ can be selected by specifying either a range of values or a range of
+
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AP to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the selected eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspgst(int, java.lang.String, int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+sspgst</H3>
+<PRE>
+public abstract void <B>sspgst</B>(int itype,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form, using packed storage.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by SPPTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ BP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor from the Cholesky factorization of B,
+ stored in the same format as A, as returned by SPPTRF.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspgv(int, java.lang.String, java.lang.String, int, float[], float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sspgv</H3>
+<PRE>
+public abstract void <B>sspgv</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGV computes all the eigenvalues and, optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric, stored in packed format,
+ and B is also positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) REAL array, dimension
+ (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPPTRF or SSPEV returned an error code:
+ <= N: if INFO = i, SSPEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero.
+ > N: if INFO = n + i, for 1 <= i <= n, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspgvd(int, java.lang.String, java.lang.String, int, float[], float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sspgvd</H3>
+<PRE>
+public abstract void <B>sspgvd</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric, stored in packed format, and B is also
+ positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPPTRF or SSPEVD returned an error code:
+ <= N: if INFO = i, SSPEVD failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspgvx(int, java.lang.String, java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sspgvx</H3>
+<PRE>
+public abstract void <B>sspgvx</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] bp,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric, stored in packed storage, and B
+ is also positive definite. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPPTRF or SSPEVX returned an error code:
+ <= N: if INFO = i, SSPEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>bp</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssprfs(java.lang.String, int, int, float[], float[], int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssprfs</H3>
+<PRE>
+public abstract void <B>ssprfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ AFP (input) REAL array, dimension (N*(N+1)/2)
+ The factored form of the matrix A. AFP contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by SSPTRF, stored as a packed
+ triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SSPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspsv(java.lang.String, int, int, float[], int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sspsv</H3>
+<PRE>
+public abstract void <B>sspsv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix stored in packed format and X
+ and B are N-by-NRHS matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, D is symmetric and block diagonal with 1-by-1
+ and 2-by-2 diagonal blocks. The factored form of A is then used to
+ solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by SSPTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, so the solution could not be
+ computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sspsvx(java.lang.String, java.lang.String, int, int, float[], float[], int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sspsvx</H3>
+<PRE>
+public abstract void <B>sspsvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] afp,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPSVX uses the diagonal pivoting factorization A = U*D*U**T or
+ A = L*D*L**T to compute the solution to a real system of linear
+ equations A * X = B, where A is an N-by-N symmetric matrix stored
+ in packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AFP and IPIV contain the factored form of
+ A. AP, AFP and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ See below for further details.
+
+ AFP (input or output) REAL array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSPTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSPTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>afp</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssptrd(java.lang.String, int, float[], float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssptrd</H3>
+<PRE>
+public abstract void <B>ssptrd</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ float[] d,
+ float[] e,
+ float[] tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRD reduces a real symmetric matrix A stored in packed form to
+ symmetric tridiagonal form T by an orthogonal similarity
+ transformation: Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
+ overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
+ overwriting A(i+2:n,i), and tau is stored in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssptrf(java.lang.String, int, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssptrf</H3>
+<PRE>
+public abstract void <B>ssptrf</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRF computes the factorization of a real symmetric matrix A stored
+ in packed format using the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L, stored as a packed triangular
+ matrix overwriting A (see below for further details).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 5-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssptri(java.lang.String, int, float[], int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssptri</H3>
+<PRE>
+public abstract void <B>ssptri</B>(java.lang.String uplo,
+ int n,
+ float[] ap,
+ int[] ipiv,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRI computes the inverse of a real symmetric indefinite matrix
+ A in packed storage using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by SSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by SSPTRF,
+ stored as a packed triangular matrix.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix, stored as a packed triangular matrix. The j-th column
+ of inv(A) is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = inv(A)(i,j) for 1<=i<=j;
+ if UPLO = 'L',
+ AP(i + (j-1)*(2n-j)/2) = inv(A)(i,j) for j<=i<=n.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssptrs(java.lang.String, int, int, float[], int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssptrs</H3>
+<PRE>
+public abstract void <B>ssptrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] ap,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A stored in packed format using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstebz(java.lang.String, java.lang.String, int, float, float, int, int, float, float[], float[], org.netlib.util.intW, org.netlib.util.intW, float[], int[], int[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sstebz</H3>
+<PRE>
+public abstract void <B>sstebz</B>(java.lang.String range,
+ java.lang.String order,
+ int n,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW m,
+ org.netlib.util.intW nsplit,
+ float[] w,
+ int[] iblock,
+ int[] isplit,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEBZ computes the eigenvalues of a symmetric tridiagonal
+ matrix T. The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER*1
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER*1
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute tolerance for the eigenvalues. An eigenvalue
+ (or cluster) is considered to be located if it has been
+ determined to lie in an interval whose width is ABSTOL or
+ less. If ABSTOL is less than or equal to zero, then ULP*|T|
+
+ will be used, where |T| means the 1-norm of T.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ NSPLIT (output) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ W (output) REAL array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalues. (SSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (SSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ RELFAC REAL, default = 2.0e0
+ The relative tolerance. An interval (a,b] lies within
+ "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|),
+ where "ulp" is the machine precision (distance from 1 to
+ the next larger floating point number.)
+
+ FUDGE REAL, default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>range</CODE> - <DD><CODE>order</CODE> - <DD><CODE>n</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>m</CODE> - <DD><CODE>nsplit</CODE> - <DD><CODE>w</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstedc(java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sstedc</H3>
+<PRE>
+public abstract void <B>sstedc</B>(java.lang.String compz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEDC computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+ The eigenvectors of a full or band real symmetric matrix can also be
+
+ found if SSYTRD or SSPTRD or SSBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See SLAED3 for details.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+ = 'V': Compute eigenvectors of original dense symmetric
+ matrix also. On entry, Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the subdiagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 3*N + 2*N*lg N + 3*N**2 ),
+ where lg( N ) = smallest integer k such
+ that 2**k >= N.
+ If COMPZ = 'I' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LWORK need
+ only be max(1,2*(N-1)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LIWORK must be at least
+ ( 6 + 6*N + 5*N*lg N ).
+ If COMPZ = 'I' and N > 1 then LIWORK must be at least
+ ( 3 + 5*N ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LIWORK
+ need only be 1.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstegr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sstegr</H3>
+<PRE>
+public abstract void <B>sstegr</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEGR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ SSTEGR is a compatability wrapper around the improved SSTEMR routine.
+ See SSTEMR for further details.
+
+ One important change is that the ABSTOL parameter no longer provides
+ benefit and hence is no longer used.
+
+ Note : SSTEGR and SSTEMR work only on machines which follow
+ IEEE-754 floating-point standard in their handling of infinities and
+
+ NaNs. Normal execution may create these exceptiona values and hence
+
+ may abort due to a floating point exception in environments which
+ do not conform to the IEEE-754 standard.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ Unused. Was the absolute error tolerance for the
+ eigenvalues/eigenvectors in previous versions.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in SLARRE,
+ if INFO = 2X, internal error in SLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by SLARRE or
+ SLARRV, respectively.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstein(int, float[], float[], int, float[], int[], int[], float[], int, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sstein</H3>
+<PRE>
+public abstract void <B>sstein</B>(int n,
+ float[] d,
+ float[] e,
+ int m,
+ float[] w,
+ int[] iblock,
+ int[] isplit,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEIN computes the eigenvectors of a real symmetric tridiagonal
+ matrix T corresponding to specified eigenvalues, using inverse
+ iteration.
+
+ The maximum number of iterations allowed for each eigenvector is
+ specified by an internal parameter MAXITS (currently set to 5).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix
+ T, in elements 1 to N-1.
+
+ M (input) INTEGER
+ The number of eigenvectors to be found. 0 <= M <= N.
+
+ W (input) REAL array, dimension (N)
+ The first M elements of W contain the eigenvalues for
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block. ( The output array
+ W from SSTEBZ with ORDER = 'B' is expected here. )
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The submatrix indices associated with the corresponding
+ eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to
+ the first submatrix from the top, =2 if W(i) belongs to
+ the second submatrix, etc. ( The output array IBLOCK
+ from SSTEBZ is expected here. )
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+ ( The output array ISPLIT from SSTEBZ is expected here. )
+
+ Z (output) REAL array, dimension (LDZ, M)
+ The computed eigenvectors. The eigenvector associated
+ with the eigenvalue W(i) is stored in the i-th column of
+ Z. Any vector which fails to converge is set to its current
+
+ iterate after MAXITS iterations.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ On normal exit, all elements of IFAIL are zero.
+ If one or more eigenvectors fail to converge after
+ MAXITS iterations, then their indices are stored in
+ array IFAIL.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge
+ in MAXITS iterations. Their indices are stored in
+ array IFAIL.
+
+ Internal Parameters
+ ===================
+
+ MAXITS INTEGER, default = 5
+ The maximum number of iterations performed.
+
+ EXTRA INTEGER, default = 2
+ The number of iterations performed after norm growth
+ criterion is satisfied, should be at least 1.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>iblock</CODE> - <DD><CODE>isplit</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstemr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, org.netlib.util.intW, float[], float[], int, int, int[], org.netlib.util.booleanW, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sstemr</H3>
+<PRE>
+public void <B>sstemr</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int nzc,
+ int[] isuppz,
+ org.netlib.util.booleanW tryrac,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEMR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ Depending on the number of desired eigenvalues, these are computed ei
+ by bisection or the dqds algorithm. Numerically orthogonal eigenvecto
+ computed by the use of various suitable L D L^T factorizations near c
+ of close eigenvalues (referred to as RRRs, Relatively Robust
+ Representations). An informal sketch of the algorithm follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ For more details, see:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+ Notes:
+ 1.SSTEMR works only on machines which follow IEEE-754
+ floating-point standard in their handling of infinities and NaNs.
+ This permits the use of efficient inner loops avoiding a check for
+ zero divisors.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and can be computed with a workspace
+
+ query by setting NZC = -1, see below.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ NZC (input) INTEGER
+ The number of eigenvectors to be held in the array Z.
+ If RANGE = 'A', then NZC >= max(1,N).
+ If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,
+ If RANGE = 'I', then NZC >= IU-IL+1.
+ If NZC = -1, then a workspace query is assumed; the
+ routine calculates the number of columns of the array Z that
+
+ are needed to hold the eigenvectors.
+ This value is returned as the first entry of the Z array, and
+ no error message related to NZC is issued by XERBLA.
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ TRYRAC (input/output) LOGICAL
+ If TRYRAC.EQ..TRUE., indicates that the code should check whe
+ the tridiagonal matrix defines its eigenvalues to high relati
+ accuracy. If so, the code uses relative-accuracy preserving
+
+ algorithms that might be (a bit) slower depending on the matr
+ If the matrix does not define its eigenvalues to high relativ
+ accuracy, the code can uses possibly faster algorithms.
+ If TRYRAC.EQ..FALSE., the code is not required to guarantee
+ relatively accurate eigenvalues and can use the fastest possi
+ techniques.
+ On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix
+ does not define its eigenvalues to high relative accuracy.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in SLARRE,
+ if INFO = 2X, internal error in SLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by SLARRE or
+ SLARRV, respectively.
+
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>nzc</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>tryrac</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssteqr(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssteqr</H3>
+<PRE>
+public abstract void <B>ssteqr</B>(java.lang.String compz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the implicit QL or QR method.
+ The eigenvectors of a full or band symmetric matrix can also be found
+ if SSYTRD or SSPTRD or SSBTRD has been used to reduce this matrix to
+
+ tridiagonal form.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvalues and eigenvectors of the original
+
+ symmetric matrix. On entry, Z must contain the
+ orthogonal matrix used to reduce the original matrix
+
+ to tridiagonal form.
+ = 'I': Compute eigenvalues and eigenvectors of the
+ tridiagonal matrix. Z is initialized to the identity
+ matrix.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (max(1,2*N-2))
+ If COMPZ = 'N', then WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm has failed to find all the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero; on exit, D
+ and E contain the elements of a symmetric tridiagonal
+ matrix which is orthogonally similar to the original
+ matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssterf(int, float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssterf</H3>
+<PRE>
+public abstract void <B>ssterf</B>(int n,
+ float[] d,
+ float[] e,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTERF computes all eigenvalues of a symmetric tridiagonal matrix
+ using the Pal-Walker-Kahan variant of the QL or QR algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix.
+
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed to find all of the eigenvalues in
+
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstev(java.lang.String, int, float[], float[], float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+sstev</H3>
+<PRE>
+public abstract void <B>sstev</B>(java.lang.String jobz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (max(1,2*N-2))
+ If JOBZ = 'N', WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstevd(java.lang.String, int, float[], float[], float[], int, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sstevd</H3>
+<PRE>
+public abstract void <B>sstevd</B>(java.lang.String jobz,
+ int n,
+ float[] d,
+ float[] e,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix. If eigenvectors are desired, it
+ uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
+
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstevr(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+sstevr</H3>
+<PRE>
+public abstract void <B>sstevr</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Whenever possible, SSTEVR calls SSTEMR to compute the
+ eigenspectrum using Relatively Robust Representations. SSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows. For the i-th
+ unreduced block of T,
+ (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T
+ is a relatively robust representation,
+ (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high
+ relative accuracy by the dqds algorithm,
+ (c) If there is a cluster of close eigenvalues, "choose" sigma_i
+ close to the cluster, and go to step (a),
+ (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T,
+ compute the corresponding eigenvector by forming a
+ rank-revealing twisted factorization.
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon,
+ Computer Science Division Technical Report No. UCB//CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : SSTEVR calls SSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ SSTEVR calls SSTEBZ and SSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of SSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+ For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
+ SSTEIN are called
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) REAL array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ SLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+ Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal (and
+ minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 20*N.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal (and
+ minimal) LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= 10*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+ Jason Riedy, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="sstevx(java.lang.String, java.lang.String, int, float[], float[], float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+sstevx</H3>
+<PRE>
+public abstract void <B>sstevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ int n,
+ float[] d,
+ float[] e,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix A. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) REAL array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less
+ than or equal to zero, then EPS*|T| will be used in
+ its place, where |T| is the 1-norm of the tridiagonal
+ matrix.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge (INFO > 0), then that
+ column of Z contains the latest approximation to the
+ eigenvector, and the index of the eigenvector is returned
+ in IFAIL. If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>n</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssycon(java.lang.String, int, float[], int, int[], float, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssycon</H3>
+<PRE>
+public abstract void <B>ssycon</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float anorm,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by SSYTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ ANORM (input) REAL
+ The 1-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>anorm</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyev(java.lang.String, java.lang.String, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssyev</H3>
+<PRE>
+public abstract void <B>ssyev</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] w,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for SSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyevd(java.lang.String, java.lang.String, int, float[], int, float[], float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssyevd</H3>
+<PRE>
+public abstract void <B>ssyevd</B>(java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] w,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A. If eigenvectors are desired, it uses a
+ divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Because of large use of BLAS of level 3, SSYEVD needs N**2 more
+ workspace than SSYEVX.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i and JOBZ = 'N', then the algorithm failed
+ to converge; i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ if INFO = i and JOBZ = 'V', then the algorithm failed
+ to compute an eigenvalue while working on the submatrix
+ lying in rows and columns INFO/(N+1) through
+ mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ Modified description of INFO. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyevr(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, int[], float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssyevr</H3>
+<PRE>
+public abstract void <B>ssyevr</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ int[] isuppz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ SSYEVR first reduces the matrix A to tridiagonal form T with a call
+ to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute
+ the eigenspectrum using Relatively Robust Representations. SSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see SSTEMR's documentation and:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : SSYEVR calls SSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of SSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+ For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
+ SSTEIN are called
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ SLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+ Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,26*N).
+ For optimal efficiency, LWORK >= (NB+6)*N,
+ where NB is the max of the blocksize for SSYTRD and SORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+ Jason Riedy, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>isuppz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><C [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyevx(java.lang.String, java.lang.String, java.lang.String, int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int, int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssyevx</H3>
+<PRE>
+public abstract void <B>ssyevx</B>(java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= 1, when N <= 1;
+ otherwise 8*N.
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the max of the blocksize for SSYTRD and SORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>ifail</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssygs2(int, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssygs2</H3>
+<PRE>
+public abstract void <B>ssygs2</B>(int itype,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGS2 reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U')*A*inv(U) or inv(L)*A*inv(L')
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U` or L'*A*L.
+
+ B must have been previously factorized as U'*U or L*L' by SPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U')*A*inv(U) or inv(L)*A*inv(L');
+ = 2 or 3: compute U*A*U' or L'*A*L.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored, and how B has been factorized.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by SPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssygst(int, java.lang.String, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssygst</H3>
+<PRE>
+public abstract void <B>ssygst</B>(int itype,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by SPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by SPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssygv(int, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssygv</H3>
+<PRE>
+public abstract void <B>ssygv</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] w,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric and B is also
+ positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the symmetric positive definite matrix B.
+ If UPLO = 'U', the leading N-by-N upper triangular part of B
+
+ contains the upper triangular part of the matrix B.
+ If UPLO = 'L', the leading N-by-N lower triangular part of B
+
+ contains the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for SSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPOTRF or SSYEV returned an error code:
+ <= N: if INFO = i, SSYEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssygvd(int, java.lang.String, java.lang.String, int, float[], int, float[], int, float[], float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssygvd</H3>
+<PRE>
+public abstract void <B>ssygvd</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] w,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric and B is also positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK >= 1.
+ If JOBZ = 'N' and N > 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPOTRF or SSYEVD returned an error code:
+ <= N: if INFO = i and JOBZ = 'N', then the algorithm
+ failed to converge; i off-diagonal elements of an
+ intermediate tridiagonal form did not converge to
+ zero;
+ if INFO = i and JOBZ = 'V', then the algorithm
+ failed to compute an eigenvalue while working on
+ the submatrix lying in rows and columns INFO/(N+1)
+
+ through mod(INFO,N+1);
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ Modified so that no backsubstitution is performed if SSYEVD fails to
+
+ converge (NEIG in old code could be greater than N causing out of
+ bounds reference to A - reported by Ralf Meyer). Also corrected the
+
+ description of INFO and the test on ITYPE. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>w</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssygvx(int, java.lang.String, java.lang.String, java.lang.String, int, float[], int, float[], int, float, float, int, int, float, org.netlib.util.intW, float[], float[], int, float[], int, int[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssygvx</H3>
+<PRE>
+public abstract void <B>ssygvx</B>(int itype,
+ java.lang.String jobz,
+ java.lang.String range,
+ java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float vl,
+ float vu,
+ int il,
+ int iu,
+ float abstol,
+ org.netlib.util.intW m,
+ float[] w,
+ float[] z,
+ int ldz,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int[] ifail,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric and B is also positive definite.
+ Eigenvalues and eigenvectors can be selected by specifying either a
+ range of values or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,8*N).
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the blocksize for SSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPOTRF or SSYEVX returned an error code:
+ <= N: if INFO = i, SSYEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>itype</CODE> - <DD><CODE>jobz</CODE> - <DD><CODE>range</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>vu</CODE> - <DD><CODE>il</CODE> - <DD><CODE>iu</CODE> - <DD><CODE>abstol</CODE> - <DD><CODE>m</CODE> - <DD><CODE>w</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwor [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssyrfs(java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssyrfs</H3>
+<PRE>
+public abstract void <B>ssyrfs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite, and
+ provides error bounds and backward error estimates for the solution.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) REAL array, dimension (LDAF,N)
+ The factored form of the matrix A. AF contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by SSYTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SSYTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssysv(java.lang.String, int, int, float[], int, int[], float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssysv</H3>
+<PRE>
+public abstract void <B>ssysv</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
+ used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the block diagonal matrix D and the
+ multipliers used to obtain the factor U or L from the
+ factorization A = U*D*U**T or A = L*D*L**T as computed by
+ SSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by SSYTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= 1, and for best performance
+ LWORK >= max(1,N*NB), where NB is the optimal blocksize for
+ SSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssysvx(java.lang.String, java.lang.String, int, int, float[], int, float[], int, int[], float[], int, float[], int, org.netlib.util.floatW, float[], float[], float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssysvx</H3>
+<PRE>
+public abstract void <B>ssysvx</B>(java.lang.String fact,
+ java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] af,
+ int ldaf,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ org.netlib.util.floatW rcond,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYSVX uses the diagonal pivoting factorization to compute the
+ solution to a real system of linear equations A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A.
+ The form of the factorization is
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AF and IPIV contain the factored form of
+ A. AF and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) REAL array, dimension (LDAF,N)
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSYTRF.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the block diagonal matrix D and the multipliers used
+
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSYTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSYTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= max(1,3*N), and for best
+ performance, when FACT = 'N', LWORK >= max(1,3*N,N*NB), where
+ NB is the optimal blocksize for SSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>fact</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>af</CODE> - <DD><CODE>ldaf</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssytd2(java.lang.String, int, float[], int, float[], float[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssytd2</H3>
+<PRE>
+public abstract void <B>ssytd2</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
+ form T by an orthogonal similarity transformation: Q' * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssytf2(java.lang.String, int, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+ssytf2</H3>
+<PRE>
+public abstract void <B>ssytf2</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTF2 computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U' or A = L*D*L'
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, U' is the transpose of U, and D is symmetric and
+ block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 09-29-06 - patch from
+ Bobby Cheng, MathWorks
+
+ Replace l.204 and l.372
+ IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+ by
+ IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN
+
+ 01-01-96 - Based on modifications by
+ J. Lewis, Boeing Computer Services Company
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ 1-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssytrd(java.lang.String, int, float[], int, float[], float[], float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssytrd</H3>
+<PRE>
+public abstract void <B>ssytrd</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ float[] d,
+ float[] e,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRD reduces a real symmetric matrix A to real symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>d</CODE> - <DD><CODE>e</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssytrf(java.lang.String, int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssytrf</H3>
+<PRE>
+public abstract void <B>ssytrf</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRF computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method. The form of the
+ factorization is
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >=1. For best performance
+ LWORK >= N*NB, where NB is the block size returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, and division by zero will occur if it
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssytri(java.lang.String, int, float[], int, int[], float[], org.netlib.util.intW)"><!-- --></A><H3>
+ssytri</H3>
+<PRE>
+public abstract void <B>ssytri</B>(java.lang.String uplo,
+ int n,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRI computes the inverse of a real symmetric indefinite matrix
+ A using the factorization A = U*D*U**T or A = L*D*L**T computed by
+ SSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by SSYTRF.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix. If UPLO = 'U', the upper triangular part of the
+ inverse is formed and the part of A below the diagonal is not
+ referenced; if UPLO = 'L' the lower triangular part of the
+ inverse is formed and the part of A above the diagonal is
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="ssytrs(java.lang.String, int, int, float[], int, int[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+ssytrs</H3>
+<PRE>
+public abstract void <B>ssytrs</B>(java.lang.String uplo,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ int[] ipiv,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by SSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>ipiv</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stbcon(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+stbcon</H3>
+<PRE>
+public abstract void <B>stbcon</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ int kd,
+ float[] ab,
+ int ldab,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBCON estimates the reciprocal of the condition number of a
+ triangular band matrix A, in either the 1-norm or the infinity-norm.
+
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stbrfs(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+stbrfs</H3>
+<PRE>
+public abstract void <B>stbrfs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular band
+ coefficient matrix.
+
+ The solution matrix X must be computed by STBTRS or some other
+ means before entering this routine. STBRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stbtrs(java.lang.String, java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+stbtrs</H3>
+<PRE>
+public abstract void <B>stbtrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int kd,
+ int nrhs,
+ float[] ab,
+ int ldab,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular band matrix of order N, and B is an
+ N-by NRHS matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>kd</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ab</CODE> - <DD><CODE>ldab</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgevc(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], int, int, org.netlib.util.intW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+stgevc</H3>
+<PRE>
+public abstract void <B>stgevc</B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] s,
+ int lds,
+ float[] p,
+ int ldp,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ STGEVC computes some or all of the right and/or left eigenvectors of
+
+ a pair of real matrices (S,P), where S is a quasi-triangular matrix
+ and P is upper triangular. Matrix pairs of this type are produced by
+ the generalized Schur factorization of a matrix pair (A,B):
+
+ A = Q*S*Z**T, B = Q*P*Z**T
+
+ as computed by SGGHRD + SHGEQZ.
+
+ The right eigenvector x and the left eigenvector y of (S,P)
+ corresponding to an eigenvalue w are defined by:
+
+ S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+
+ where y**H denotes the conjugate tranpose of y.
+ The eigenvalues are not input to this routine, but are computed
+ directly from the diagonal blocks of S and P.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+ where Z and Q are input matrices.
+ If Q and Z are the orthogonal factors from the generalized Schur
+ factorization of a matrix pair (A,B), then Z*X and Q*Y
+ are the matrices of right and left eigenvectors of (A,B).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ specified by the logical array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY='S', SELECT specifies the eigenvectors to be
+ computed. If w(j) is a real eigenvalue, the corresponding
+ real eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector
+ is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+ and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+ set to .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrices S and P. N >= 0.
+
+ S (input) REAL array, dimension (LDS,N)
+ The upper quasi-triangular matrix S from a generalized Schur
+
+ factorization, as computed by SHGEQZ.
+
+ LDS (input) INTEGER
+ The leading dimension of array S. LDS >= max(1,N).
+
+ P (input) REAL array, dimension (LDP,N)
+ The upper triangular matrix P from a generalized Schur
+ factorization, as computed by SHGEQZ.
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+ of S must be in positive diagonal form.
+
+ LDP (input) INTEGER
+ The leading dimension of array P. LDP >= max(1,N).
+
+ VL (input/output) REAL array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of left Schur vectors returned by SHGEQZ).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
+
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
+
+ SELECT, stored consecutively in the columns of
+ VL, in the same order as their eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) REAL array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Z (usually the orthogonal matrix Z
+ of right Schur vectors returned by SHGEQZ).
+
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+ if HOWMNY = 'B' or 'b', the matrix Z*X;
+ if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+ specified by SELECT, stored consecutively in the
+
+ columns of VR, in the same order as their
+ eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
+ is set to N. Each selected real eigenvector occupies one
+ column and each selected complex eigenvector occupies two
+ columns.
+
+ WORK (workspace) REAL array, dimension (6*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the 2-by-2 block (INFO:INFO+1) does not have a complex
+
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Allocation of workspace:
+ ---------- -- ---------
+
+ WORK( j ) = 1-norm of j-th column of A, above the diagonal
+ WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
+ WORK( 2*N+1:3*N ) = real part of eigenvector
+ WORK( 3*N+1:4*N ) = imaginary part of eigenvector
+ WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
+ WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
+
+ Rowwise vs. columnwise solution methods:
+ ------- -- ---------- -------- -------
+
+ Finding a generalized eigenvector consists basically of solving the
+ singular triangular system
+
+ (A - w B) x = 0 (for right) or: (A - w B)**H y = 0 (for left)
+
+ Consider finding the i-th right eigenvector (assume all eigenvalues
+ are real). The equation to be solved is:
+ n i
+ 0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. . .,1
+ k=j k=j
+
+ where C = (A - w B) (The components v(i+1:n) are 0.)
+
+ The "rowwise" method is:
+
+ (1) v(i) := 1
+ for j = i-1,. . .,1:
+ i
+ (2) compute s = - sum C(j,k) v(k) and
+ k=j+1
+
+ (3) v(j) := s / C(j,j)
+
+ Step 2 is sometimes called the "dot product" step, since it is an
+ inner product between the j-th row and the portion of the eigenvector
+ that has been computed so far.
+
+ The "columnwise" method consists basically in doing the sums
+ for all the rows in parallel. As each v(j) is computed, the
+ contribution of v(j) times the j-th column of C is added to the
+ partial sums. Since FORTRAN arrays are stored columnwise, this has
+ the advantage that at each step, the elements of C that are accessed
+
+ are adjacent to one another, whereas with the rowwise method, the
+ elements accessed at a step are spaced LDS (and LDP) words apart.
+
+ When finding left eigenvectors, the matrix in question is the
+ transpose of the one in storage, so the rowwise method then
+ actually accesses columns of A and B at each step, and so is the
+ preferred method.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>s</CODE> - <DD><CODE>lds</CODE> - <DD><CODE>p</CODE> - <DD><CODE>ldp</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgex2(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, int, int, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+stgex2</H3>
+<PRE>
+public abstract void <B>stgex2</B>(boolean wantq,
+ boolean wantz,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ int j1,
+ int n1,
+ int n2,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
+ of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
+ (A, B) by an orthogonal equivalence transformation.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL arrays, dimensions (LDA,N)
+ On entry, the matrix A in the pair (A, B).
+ On exit, the updated matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL arrays, dimensions (LDB,N)
+ On entry, the matrix B in the pair (A, B).
+ On exit, the updated matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ Not referenced if WANTQ = .FALSE..
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ Not referenced if WANTZ = .FALSE..
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ J1 (input) INTEGER
+ The index to the first block (A11, B11). 1 <= J1 <= N.
+
+ N1 (input) INTEGER
+ The order of the first block (A11, B11). N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block (A22, B22). N2 = 0, 1 or 2.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)).
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX( N*(N2+N1), (N2+N1)*(N2+N1)*2 )
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ >0: If INFO = 1, the transformed matrix (A, B) would be
+ too far from generalized Schur form; the blocks are
+ not swapped and (A, B) and (Q, Z) are unchanged.
+ The problem of swapping is too ill-conditioned.
+ <0: If INFO = -16: LWORK is too small. Appropriate value
+ for LWORK is returned in WORK(1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ In the current code both weak and strong stability tests are
+ performed. The user can omit the strong stability test by changing
+ the internal logical parameter WANDS to .FALSE.. See ref. [2] for
+ details.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ =====================================================================
+ Replaced various illegal calls to SCOPY by calls to SLASET, or by DO
+
+ loops. Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantq</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>j1</CODE> - <DD><CODE>n1</CODE> - <DD><CODE>n2</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgexc(boolean, boolean, int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+stgexc</H3>
+<PRE>
+public abstract void <B>stgexc</B>(boolean wantq,
+ boolean wantz,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGEXC reorders the generalized real Schur decomposition of a real
+ matrix pair (A,B) using an orthogonal equivalence transformation
+
+ (A, B) = Q * (A, B) * Z',
+
+ so that the diagonal block of (A, B) with row index IFST is moved
+ to row ILST.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the matrix A in generalized real Schur canonical
+ form.
+ On exit, the updated matrix A, again in generalized
+ real Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the matrix B in generalized real Schur canonical
+ form (A,B).
+ On exit, the updated matrix B, again in generalized
+ real Schur canonical form (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of (A, B).
+ The block with row index IFST is moved to row ILST, by a
+ sequence of swapping between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of
+ a 2-by-2 block, it is changed to point to the first row;
+ ILST always points to the first row of the block in its
+ final position (which may differ from its input value by
+ +1 or -1). 1 <= IFST, ILST <= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: successful exit.
+ <0: if INFO = -i, the i-th argument had an illegal value.
+ =1: The transformed matrix pair (A, B) would be too far
+ from generalized Schur form; the problem is ill-
+ conditioned. (A, B) may have been partially reordered,
+
+ and ILST points to the first row of the current
+ position of the block being moved.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>wantq</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>ifst</CODE> - <DD><CODE>ilst</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgsen(int, boolean, boolean, boolean[], int, float[], int, float[], int, float[], float[], float[], float[], int, float[], int, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+stgsen</H3>
+<PRE>
+public abstract void <B>stgsen</B>(int ijob,
+ boolean wantq,
+ boolean wantz,
+ boolean[] select,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] alphar,
+ float[] alphai,
+ float[] beta,
+ float[] q,
+ int ldq,
+ float[] z,
+ int ldz,
+ org.netlib.util.intW m,
+ org.netlib.util.floatW pl,
+ org.netlib.util.floatW pr,
+ float[] dif,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSEN reorders the generalized real Schur decomposition of a real
+ matrix pair (A, B) (in terms of an orthonormal equivalence trans-
+ formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
+ appears in the leading diagonal blocks of the upper quasi-triangular
+
+ matrix A and the upper triangular B. The leading columns of Q and
+ Z form orthonormal bases of the corresponding left and right eigen-
+ spaces (deflating subspaces). (A, B) must be in generalized real
+ Schur canonical form (as returned by SGGES), i.e. A is block upper
+ triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
+ triangular.
+
+ STGSEN also computes the generalized eigenvalues
+
+ w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
+
+ of the reordered matrix pair (A, B).
+
+ Optionally, STGSEN computes the estimates of reciprocal condition
+ numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
+ (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
+ between the matrix pairs (A11, B11) and (A22,B22) that correspond to
+
+ the selected cluster and the eigenvalues outside the cluster, resp.,
+
+ and norms of "projections" onto left and right eigenspaces w.r.t.
+ the selected cluster in the (1,1)-block.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (PL and PR) or the deflating subspaces
+ (Difu and Difl):
+ =0: Only reorder w.r.t. SELECT. No extras.
+ =1: Reciprocal of norms of "projections" onto left and right
+ eigenspaces w.r.t. the selected cluster (PL and PR).
+ =2: Upper bounds on Difu and Difl. F-norm-based estimate
+ (DIF(1:2)).
+ =3: Estimate of Difu and Difl. 1-norm-based estimate
+ (DIF(1:2)).
+ About 5 times as expensive as IJOB = 2.
+ =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
+ version to get it all.
+ =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster.
+ To select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension(LDA,N)
+ On entry, the upper quasi-triangular matrix A, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, A is overwritten by the reordered matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension(LDB,N)
+ On entry, the upper triangular matrix B, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, B is overwritten by the reordered matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real generalized Schur form of (A,B) were further reduced
+ to triangular form using complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
+ On exit, Q has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Q form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1;
+ and if WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
+ On exit, Z has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Z form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1;
+ If WANTZ = .TRUE., LDZ >= N.
+
+ M (output) INTEGER
+ The dimension of the specified pair of left and right eigen-
+
+ spaces (deflating subspaces). 0 <= M <= N.
+
+ PL (output) REAL
+ PR (output) REAL
+ If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
+ reciprocal of the norm of "projections" onto left and right
+ eigenspaces with respect to the selected cluster.
+ 0 < PL, PR <= 1.
+ If M = 0 or M = N, PL = PR = 1.
+ If IJOB = 0, 2 or 3, PL and PR are not referenced.
+
+ DIF (output) REAL array, dimension (2).
+ If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
+
+ If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
+ Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
+ estimates of Difu and Difl.
+ If M = 0 or N, DIF(1:2) = F-norm([A, B]).
+ If IJOB = 0 or 1, DIF is not referenced.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 4*N+16.
+ If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
+ If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ IF IJOB = 0, IWORK is not referenced. Otherwise,
+ on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= 1.
+ If IJOB = 1, 2 or 4, LIWORK >= N+6.
+ If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: Successful exit.
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ =1: Reordering of (A, B) failed because the transformed
+ matrix pair (A, B) would be too far from generalized
+ Schur form; the problem is very ill-conditioned.
+ (A, B) may have been partially reordered.
+ If requested, 0 is returned in DIF(*), PL and PR.
+
+ Further Details
+ ===============
+
+ STGSEN first collects the selected eigenvalues by computing
+ orthogonal U and W that move them to the top left corner of (A, B).
+ In other words, the selected eigenvalues are the eigenvalues of
+ (A11, B11) in:
+
+ U'*(A, B)*W = (A11 A12) (B11 B12) n1
+ ( 0 A22),( 0 B22) n2
+ n1 n2 n1 n2
+
+ where N = n1+n2 and U' means the transpose of U. The first n1 columns
+ of U and W span the specified pair of left and right eigenspaces
+ (deflating subspaces) of (A, B).
+
+ If (A, B) has been obtained from the generalized real Schur
+ decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
+ reordered generalized real Schur form of (C, D) is given by
+
+ (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
+
+ and the first n1 columns of Q*U and Z*W span the corresponding
+ deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
+
+ Note that if the selected eigenvalue is sufficiently ill-conditioned,
+ then its value may differ significantly from its value before
+ reordering.
+
+ The reciprocal condition numbers of the left and right eigenspaces
+ spanned by the first n1 columns of U and W (or Q*U and Z*W) may
+ be returned in DIF(1:2), corresponding to Difu and Difl, resp.
+
+ The Difu and Difl are defined as:
+
+ Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
+ and
+ Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
+
+ where sigma-min(Zu) is the smallest singular value of the
+ (2*n1*n2)-by-(2*n1*n2) matrix
+
+ Zu = [ kron(In2, A11) -kron(A22', In1) ]
+ [ kron(In2, B11) -kron(B22', In1) ].
+
+ Here, Inx is the identity matrix of size nx and A22' is the
+ transpose of A22. kron(X, Y) is the Kronecker product between
+ the matrices X and Y.
+
+ When DIF(2) is small, small changes in (A, B) can cause large changes
+ in the deflating subspace. An approximate (asymptotic) bound on the
+ maximum angular error in the computed deflating subspaces is
+
+ EPS * norm((A, B)) / DIF(2),
+
+ where EPS is the machine precision.
+
+ The reciprocal norm of the projectors on the left and right
+ eigenspaces associated with (A11, B11) may be returned in PL and PR.
+
+ They are computed as follows. First we compute L and R so that
+ P*(A, B)*Q is block diagonal, where
+
+ P = ( I -L ) n1 Q = ( I R ) n1
+ ( 0 I ) n2 and ( 0 I ) n2
+ n1 n2 n1 n2
+
+ and (L, R) is the solution to the generalized Sylvester equation
+
+ A11*R - L*A22 = -A12
+ B11*R - L*B22 = -B12
+
+ Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / PL.
+
+ There are also global error bounds which valid for perturbations up
+ to a certain restriction: A lower bound (x) on the smallest
+ F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
+ coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
+ (i.e. (A + E, B + F), is
+
+ x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
+
+
+ An approximate bound on x can be computed from DIF(1:2), PL and PR.
+
+ If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
+ (L', R') and unperturbed (L, R) left and right deflating subspaces
+ associated with the selected cluster in the (1,1)-blocks can be
+ bounded as
+
+ max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
+
+ max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
+
+
+ See LAPACK User's Guide section 4.11 or the following references
+ for more information.
+
+ Note that if the default method for computing the Frobenius-norm-
+ based estimate DIF is not wanted (see SLATDF), then the parameter
+ IDIFJB (see below) should be changed from 3 to 4 (routine SLATDF
+ (IJOB = 2 will be used)). See STGSYL for more details.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
+ 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ijob</CODE> - <DD><CODE>wantq</CODE> - <DD><CODE>wantz</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>alphar</CODE> - <DD><CODE>alphai</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>z</CODE> - <DD><CODE>ldz</CODE> - <DD><CODE>m</CODE> - <DD><CODE>pl</CODE> - <DD><CODE>pr</CODE> - <DD><CODE>dif</CODE> - <DD><CODE [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgsja(java.lang.String, java.lang.String, java.lang.String, int, int, int, int, int, float[], int, float[], int, float, float, float[], float[], float[], int, float[], int, float[], int, float[], org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+stgsja</H3>
+<PRE>
+public abstract void <B>stgsja</B>(java.lang.String jobu,
+ java.lang.String jobv,
+ java.lang.String jobq,
+ int m,
+ int p,
+ int n,
+ int k,
+ int l,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float tola,
+ float tolb,
+ float[] alpha,
+ float[] beta,
+ float[] u,
+ int ldu,
+ float[] v,
+ int ldv,
+ float[] q,
+ int ldq,
+ float[] work,
+ org.netlib.util.intW ncycle,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSJA computes the generalized singular value decomposition (GSVD)
+ of two real upper triangular (or trapezoidal) matrices A and B.
+
+ On entry, it is assumed that matrices A and B have the following
+ forms, which may be obtained by the preprocessing subroutine SGGSVP
+ from a general M-by-N matrix A and P-by-N matrix B:
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ B = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal.
+
+ On exit,
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ),
+
+ where U, V and Q are orthogonal matrices, Z' denotes the transpose
+ of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are
+ ``diagonal'' matrices, which are of the following structures:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 ) K
+ L ( 0 0 R22 ) L
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
+
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The computation of the orthogonal transformation matrices U, V or Q
+ is optional. These matrices may either be formed explicitly, or they
+ may be postmultiplied into input matrices U1, V1, or Q1.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': U must contain an orthogonal matrix U1 on entry, and
+
+ the product U1*U is returned;
+ = 'I': U is initialized to the unit matrix, and the
+ orthogonal matrix U is returned;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': V must contain an orthogonal matrix V1 on entry, and
+
+ the product V1*V is returned;
+ = 'I': V is initialized to the unit matrix, and the
+ orthogonal matrix V is returned;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
+
+ the product Q1*Q is returned;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ K (input) INTEGER
+ L (input) INTEGER
+ K and L specify the subblocks in the input matrices A and B:
+
+ A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
+ of A and B, whose GSVD is going to be computed by STGSJA.
+ See Further details.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
+ matrix R or part of R. See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
+ a part of R. See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) REAL
+ TOLB (input) REAL
+ TOLA and TOLB are the convergence criteria for the Jacobi-
+ Kogbetliantz iteration procedure. Generally, they are the
+ same as used in the preprocessing step, say
+ TOLA = max(M,N)*norm(A)*MACHEPS,
+ TOLB = max(P,N)*norm(B)*MACHEPS.
+
+ ALPHA (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = diag(C),
+ BETA(K+1:K+L) = diag(S),
+ or if M-K-L < 0,
+ ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
+ BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
+ Furthermore, if K+L < N,
+ ALPHA(K+L+1:N) = 0 and
+ BETA(K+L+1:N) = 0.
+
+ U (input/output) REAL array, dimension (LDU,M)
+ On entry, if JOBU = 'U', U must contain a matrix U1 (usually
+
+ the orthogonal matrix returned by SGGSVP).
+ On exit,
+ if JOBU = 'I', U contains the orthogonal matrix U;
+ if JOBU = 'U', U contains the product U1*U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (input/output) REAL array, dimension (LDV,P)
+ On entry, if JOBV = 'V', V must contain a matrix V1 (usually
+
+ the orthogonal matrix returned by SGGSVP).
+ On exit,
+ if JOBV = 'I', V contains the orthogonal matrix V;
+ if JOBV = 'V', V contains the product V1*V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
+
+ the orthogonal matrix returned by SGGSVP).
+ On exit,
+ if JOBQ = 'I', Q contains the orthogonal matrix Q;
+ if JOBQ = 'Q', Q contains the product Q1*Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ NCYCLE (output) INTEGER
+ The number of cycles required for convergence.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the procedure does not converge after MAXIT cycles.
+
+ Internal Parameters
+ ===================
+
+ MAXIT INTEGER
+ MAXIT specifies the total loops that the iterative procedure
+
+ may take. If after MAXIT cycles, the routine fails to
+ converge, we return INFO = 1.
+
+ Further Details
+ ===============
+
+ STGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
+ min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
+ matrix B13 to the form:
+
+ U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1,
+
+ where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose
+ of Z. C1 and S1 are diagonal matrices satisfying
+
+ C1**2 + S1**2 = I,
+
+ and R1 is an L-by-L nonsingular upper triangular matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>jobu</CODE> - <DD><CODE>jobv</CODE> - <DD><CODE>jobq</CODE> - <DD><CODE>m</CODE> - <DD><CODE>p</CODE> - <DD><CODE>n</CODE> - <DD><CODE>k</CODE> - <DD><CODE>l</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>tola</CODE> - <DD><CODE>tolb</CODE> - <DD><CODE>alpha</CODE> - <DD><CODE>beta</CODE> - <DD><CODE>u</CODE> - <DD><CODE>ldu</CODE> - <DD><CODE>v</CODE> - <DD><CODE>ldv</CODE> - <DD><CODE>q</CODE> - [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgsna(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+stgsna</H3>
+<PRE>
+public abstract void <B>stgsna</B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] s,
+ float[] dif,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or eigenvectors of a matrix pair (A, B) in
+ generalized real Schur canonical form (or of any matrix pair
+ (Q*A*Z', Q*B*Z') with orthogonal matrices Q and Z, where
+ Z' denotes the transpose of Z.
+
+ (A, B) must be in generalized real Schur form (as returned by SGGES),
+ i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal
+ blocks. B is upper triangular.
+
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (DIF):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (DIF);
+ = 'B': for both eigenvalues and eigenvectors (S and DIF).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the square matrix pair (A, B). N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The upper quasi-triangular matrix A in the pair (A,B).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,N)
+ The upper triangular matrix B in the pair (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) REAL array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns of VL, as returned by STGEVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1.
+ If JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) REAL array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns ov VR, as returned by STGEVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1.
+ If JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) REAL array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), DIF(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ DIF (output) REAL array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of DIF are set to the same value. If
+ the eigenvalues cannot be reordered to compute DIF(j), DIF(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', DIF is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S and DIF. MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and DIF used to store
+
+ the specified condition numbers; for each selected real
+ eigenvalue one element is used, and for each selected complex
+ conjugate pair of eigenvalues, two elements are used.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N + 6)
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value
+
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of a generalized eigenvalue
+ w = (a, b) is defined as
+
+ S(w) = (|u'Av|**2 + |u'Bv|**2)**(1/2) / (norm(u)*norm(v))
+
+ where u and v are the left and right eigenvectors of (A, B)
+ corresponding to w; |z| denotes the absolute value of the complex
+ number, and norm(u) denotes the 2-norm of the vector u.
+ The pair (a, b) corresponds to an eigenvalue w = a/b (= u'Av/u'Bv)
+ of the matrix pair (A, B). If both a and b equal zero, then (A B) is
+
+ singular and S(I) = -1 is returned.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(A, B) / S(I)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number DIF(i) of right eigenvector u
+
+ and left eigenvector v corresponding to the generalized eigenvalue w
+
+ is defined as follows:
+
+ a) If the i-th eigenvalue w = (a,b) is real
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( a * ) ( b * ) 1
+ ( 0 S22 ),( 0 T22 ) n-1
+ 1 n-1 1 n-1
+
+ Then the reciprocal condition number DIF(i) is
+
+ Difl((a, b), (S22, T22)) = sigma-min( Zl ),
+
+ where sigma-min(Zl) denotes the smallest singular value of the
+ 2(n-1)-by-2(n-1) matrix
+
+ Zl = [ kron(a, In-1) -kron(1, S22) ]
+ [ kron(b, In-1) -kron(1, T22) ] .
+
+ Here In-1 is the identity matrix of size n-1. kron(X, Y) is the
+ Kronecker product between the matrices X and Y.
+
+ Note that if the default method for computing DIF(i) is wanted
+ (see SLATDF), then the parameter DIFDRI (see below) should be
+ changed from 3 to 4 (routine SLATDF(IJOB = 2 will be used)).
+ See STGSYL for more details.
+
+ b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair,
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2
+ ( 0 S22 ),( 0 T22) n-2
+ 2 n-2 2 n-2
+
+ and (S11, T11) corresponds to the complex conjugate eigenvalue
+ pair (w, conjg(w)). There exist unitary matrices U1 and V1 such
+ that
+
+ U1'*S11*V1 = ( s11 s12 ) and U1'*T11*V1 = ( t11 t12 )
+ ( 0 s22 ) ( 0 t22 )
+
+ where the generalized eigenvalues w = s11/t11 and
+ conjg(w) = s22/t22.
+
+ Then the reciprocal condition number DIF(i) is bounded by
+
+ min( d1, max( 1, |real(s11)/real(s22)| )*d2 )
+
+ where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where
+ Z1 is the complex 2-by-2 matrix
+
+ Z1 = [ s11 -s22 ]
+ [ t11 -t22 ],
+
+ This is done by computing (using real arithmetic) the
+ roots of the characteristical polynomial det(Z1' * Z1 - lambda I),
+ where Z1' denotes the conjugate transpose of Z1 and det(X) denotes
+ the determinant of X.
+
+ and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an
+
+ upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2)
+
+ Z2 = [ kron(S11', In-2) -kron(I2, S22) ]
+ [ kron(T11', In-2) -kron(I2, T22) ]
+
+ Note that if the default method for computing DIF is wanted (see
+ SLATDF), then the parameter DIFDRI (see below) should be changed
+ from 3 to 4 (routine SLATDF(IJOB = 2 will be used)). See STGSYL
+ for more details.
+
+ For each eigenvalue/vector specified by SELECT, DIF stores a
+ Frobenius norm-based estimate of Difl.
+
+ An approximate error bound for the i-th computed eigenvector VL(i) or
+ VR(i) is given by
+
+ EPS * norm(A, B) / DIF(i).
+
+ See ref. [2-3] for more details and further references.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>s</CODE> - <DD><CODE>dif</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgsy2(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, org.netlib.util.floatW, int[], org.netlib.util.intW, org.netlib.util.intW)"><!-- --></A><H3>
+stgsy2</H3>
+<PRE>
+public abstract void <B>stgsy2</B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ int Ldc,
+ float[] d,
+ int ldd,
+ float[] e,
+ int lde,
+ float[] f,
+ int ldf,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW rdsum,
+ org.netlib.util.floatW rdscal,
+ int[] iwork,
+ org.netlib.util.intW pq,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSY2 solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F,
+
+ using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
+
+ (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
+ N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
+ must be in generalized Schur canonical form, i.e. A, B are upper
+ quasi triangular and D, E are upper triangular. The solution (R, L)
+ overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
+ chosen to avoid overflow.
+
+ In matrix notation solving equation (1) corresponds to solve
+ Z*x = scale*b, where Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ],
+
+ Ik is the identity matrix of size k and X' is the transpose of X.
+ kron(X, Y) is the Kronecker product between the matrices X and Y.
+ In the process of solving (1), we solve a number of such systems
+ where Dim(In), Dim(In) = 1 or 2.
+
+ If TRANS = 'T', solve the transposed system Z'*y = scale*b for y,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * -F
+
+ This case is used to compute an estimate of Dif[(A, D), (B, E)] =
+ sigma_min(Z) using reverse communicaton with SLACON.
+
+ STGSY2 also (IJOB >= 1) contributes to the computation in STGSYL
+ of an upper bound on the separation between to matrix pairs. Then
+ the input (A, D), (B, E) are sub-pencils of the matrix pair in
+ STGSYL. See STGSYL for details.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T': solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ = 0: solve (1) only.
+ = 1: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (look ahead strategy is used).
+ = 2: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (SGECON on sub-systems is used.)
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ On entry, M specifies the order of A and D, and the row
+ dimension of C, F, R and L.
+
+ N (input) INTEGER
+ On entry, N specifies the order of B and E, and the column
+ dimension of C, F, R and L.
+
+ A (input) REAL array, dimension (LDA, M)
+ On entry, A contains an upper quasi triangular matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the matrix A. LDA >= max(1, M).
+
+ B (input) REAL array, dimension (LDB, N)
+ On entry, B contains an upper quasi triangular matrix.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1, N).
+
+ C (input/output) REAL array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1).
+ On exit, if IJOB = 0, C has been overwritten by the
+ solution R.
+
+ LDC (input) INTEGER
+ The leading dimension of the matrix C. LDC >= max(1, M).
+
+ D (input) REAL array, dimension (LDD, M)
+ On entry, D contains an upper triangular matrix.
+
+ LDD (input) INTEGER
+ The leading dimension of the matrix D. LDD >= max(1, M).
+
+ E (input) REAL array, dimension (LDE, N)
+ On entry, E contains an upper triangular matrix.
+
+ LDE (input) INTEGER
+ The leading dimension of the matrix E. LDE >= max(1, N).
+
+ F (input/output) REAL array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1).
+ On exit, if IJOB = 0, F has been overwritten by the
+ solution L.
+
+ LDF (input) INTEGER
+ The leading dimension of the matrix F. LDF >= max(1, M).
+
+ SCALE (output) REAL
+ On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
+ R and L (C and F on entry) will hold the solutions to a
+ slightly perturbed system but the input matrices A, B, D and
+
+ E have not been changed. If SCALE = 0, R and L will hold the
+
+ solutions to the homogeneous system with C = F = 0. Normally,
+ SCALE = 1.
+
+ RDSUM (input/output) REAL
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by STGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when STGSY2 is called by STGSYL.
+
+ RDSCAL (input/output) REAL
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when STGSY2 is called by
+ STGSYL.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+2)
+
+ PQ (output) INTEGER
+ On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
+ 8-by-8) solved by this routine.
+
+ INFO (output) INTEGER
+ On exit, if INFO is set to
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: The matrix pairs (A, D) and (B, E) have common or very
+
+ close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+ Replaced various illegal calls to SCOPY by calls to SLASET.
+ Sven Hammarling, 27/5/02.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>ijob</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>ldd</CODE> - <DD><CODE>e</CODE> - <DD><CODE>lde</CODE> - <DD><CODE>f</CODE> - <DD><CODE>ldf</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>rdsum</CODE> - <DD><CODE>rdscal</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>pq</ [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="stgsyl(java.lang.String, int, int, int, float[], int, float[], int, float[], int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+stgsyl</H3>
+<PRE>
+public abstract void <B>stgsyl</B>(java.lang.String trans,
+ int ijob,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ int Ldc,
+ float[] d,
+ int ldd,
+ float[] e,
+ int lde,
+ float[] f,
+ int ldf,
+ org.netlib.util.floatW scale,
+ org.netlib.util.floatW dif,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSYL solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F
+
+ where R and L are unknown m-by-n matrices, (A, D), (B, E) and
+ (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
+ respectively, with real entries. (A, D) and (B, E) must be in
+ generalized (real) Schur canonical form, i.e. A, B are upper quasi
+ triangular and D, E are upper triangular.
+
+ The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
+ scaling factor chosen to avoid overflow.
+
+ In matrix notation (1) is equivalent to solve Zx = scale b, where
+ Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ].
+
+ Here Ik is the identity matrix of size k and X' is the transpose of
+ X. kron(X, Y) is the Kronecker product between the matrices X and Y.
+
+
+ If TRANS = 'T', STGSYL solves the transposed system Z'*y = scale*b,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * (-F)
+
+ This case (TRANS = 'T') is used to compute an one-norm-based estimate
+ of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
+ and (B,E), using SLACON.
+
+ If IJOB >= 1, STGSYL computes a Frobenius norm-based estimate
+ of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
+
+ reciprocal of the smallest singular value of Z. See [1-2] for more
+ information.
+
+ This is a level 3 BLAS algorithm.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T', solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ =0: solve (1) only.
+ =1: The functionality of 0 and 3.
+ =2: The functionality of 0 and 4.
+ =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ (look ahead strategy IJOB = 1 is used).
+ =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ ( SGECON on sub-systems is used ).
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ The order of the matrices A and D, and the row dimension of
+ the matrices C, F, R and L.
+
+ N (input) INTEGER
+ The order of the matrices B and E, and the column dimension
+ of the matrices C, F, R and L.
+
+ A (input) REAL array, dimension (LDA, M)
+ The upper quasi triangular matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, M).
+
+ B (input) REAL array, dimension (LDB, N)
+ The upper quasi triangular matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1, N).
+
+ C (input/output) REAL array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, C has been overwritten by
+ the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1, M).
+
+ D (input) REAL array, dimension (LDD, M)
+ The upper triangular matrix D.
+
+ LDD (input) INTEGER
+ The leading dimension of the array D. LDD >= max(1, M).
+
+ E (input) REAL array, dimension (LDE, N)
+ The upper triangular matrix E.
+
+ LDE (input) INTEGER
+ The leading dimension of the array E. LDE >= max(1, N).
+
+ F (input/output) REAL array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, F has been overwritten by
+ the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1, M).
+
+ DIF (output) REAL
+ On exit DIF is the reciprocal of a lower bound of the
+ reciprocal of the Dif-function, i.e. DIF is an upper bound of
+ Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
+ IF IJOB = 0 or TRANS = 'T', DIF is not touched.
+
+ SCALE (output) REAL
+ On exit SCALE is the scaling factor in (1) or (3).
+ If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
+
+ to a slightly perturbed system but the input matrices A, B, D
+ and E have not been changed. If SCALE = 0, C and F hold the
+ solutions R and L, respectively, to the homogeneous system
+ with C = F = 0. Normally, SCALE = 1.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK > = 1.
+ If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+6)
+
+ INFO (output) INTEGER
+ =0: successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: (A, D) and (B, E) have common or close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
+ Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
+ Appl., 15(4):1045-1060, 1994
+
+ [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
+ Condition Estimators for Solving the Generalized Sylvester
+ Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
+ July 1989, pp 745-751.
+
+ =====================================================================
+ Replaced various illegal calls to SCOPY by calls to SLASET.
+ Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trans</CODE> - <DD><CODE>ijob</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>d</CODE> - <DD><CODE>ldd</CODE> - <DD><CODE>e</CODE> - <DD><CODE>lde</CODE> - <DD><CODE>f</CODE> - <DD><CODE>ldf</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>dif</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</C [...]
+</DD>
+</DL>
+<HR>
+
+<A NAME="stpcon(java.lang.String, java.lang.String, java.lang.String, int, float[], org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+stpcon</H3>
+<PRE>
+public abstract void <B>stpcon</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPCON estimates the reciprocal of the condition number of a packed
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stprfs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+stprfs</H3>
+<PRE>
+public abstract void <B>stprfs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular packed
+ coefficient matrix.
+
+ The solution matrix X must be computed by STPTRS or some other
+ means before entering this routine. STPRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stptri(java.lang.String, java.lang.String, int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+stptri</H3>
+<PRE>
+public abstract void <B>stptri</B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] ap,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPTRI computes the inverse of a real upper or lower triangular
+ matrix A stored in packed format.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangular matrix A, stored
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*((2*n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same packed storage format.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+ Further Details
+ ===============
+
+ A triangular matrix A can be transferred to packed storage using one
+
+ of the following program segments:
+
+ UPLO = 'U': UPLO = 'L':
+
+ JC = 1 JC = 1
+ DO 2 J = 1, N DO 2 J = 1, N
+ DO 1 I = 1, J DO 1 I = J, N
+ AP(JC+I-1) = A(I,J) AP(JC+I-J) = A(I,J)
+ 1 CONTINUE 1 CONTINUE
+ JC = JC + J JC = JC + N - J + 1
+ 2 CONTINUE 2 CONTINUE
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stptrs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+stptrs</H3>
+<PRE>
+public abstract void <B>stptrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] ap,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N stored in packed format,
+ and B is an N-by-NRHS matrix. A check is made to verify that A is
+ nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>ap</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strcon(java.lang.String, java.lang.String, java.lang.String, int, float[], int, org.netlib.util.floatW, float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+strcon</H3>
+<PRE>
+public abstract void <B>strcon</B>(java.lang.String norm,
+ java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.floatW rcond,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRCON estimates the reciprocal of the condition number of a
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>norm</CODE> - <DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>rcond</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strevc(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, int, org.netlib.util.intW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+strevc</H3>
+<PRE>
+public abstract void <B>strevc</B>(java.lang.String side,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] t,
+ int ldt,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STREVC computes some or all of the right and/or left eigenvectors of
+
+ a real upper quasi-triangular matrix T.
+ Matrices of this type are produced by the Schur factorization of
+ a real general matrix: A = Q*T*Q**T, as computed by SHSEQR.
+
+ The right eigenvector x and the left eigenvector y of T corresponding
+ to an eigenvalue w are defined by:
+
+ T*x = w*x, (y**H)*T = w*(y**H)
+
+ where y**H denotes the conjugate transpose of y.
+ The eigenvalues are not input to this routine, but are read directly
+
+ from the diagonal blocks of T.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+ input matrix. If Q is the orthogonal factor that reduces a matrix
+ A to Schur form T, then Q*X and Q*Y are the matrices of right and
+ left eigenvectors of A.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ as indicated by the logical array SELECT.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+ computed.
+ If w(j) is a real eigenvalue, the corresponding real
+ eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector is
+
+ computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+ on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+
+ .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) REAL array, dimension (LDT,N)
+ The upper quasi-triangular matrix T in Schur canonical form.
+
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input/output) REAL array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by SHSEQR).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VL, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) REAL array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by SHSEQR).
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*X;
+ if HOWMNY = 'S', the right eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VR, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors.
+ If HOWMNY = 'A' or 'B', M is set to N.
+ Each selected real eigenvector occupies one column and each
+ selected complex eigenvector occupies two columns.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The algorithm used in this program is basically backward (forward)
+ substitution, with scaling to make the the code robust against
+ possible overflow.
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x| + |y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>side</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strexc(java.lang.String, int, float[], int, float[], int, org.netlib.util.intW, org.netlib.util.intW, float[], org.netlib.util.intW)"><!-- --></A><H3>
+strexc</H3>
+<PRE>
+public abstract void <B>strexc</B>(java.lang.String compq,
+ int n,
+ float[] t,
+ int ldt,
+ float[] q,
+ int ldq,
+ org.netlib.util.intW ifst,
+ org.netlib.util.intW ilst,
+ float[] work,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STREXC reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
+
+ moved to row ILST.
+
+ The real Schur form T is reordered by an orthogonal similarity
+ transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
+ is updated by postmultiplying it with Z.
+
+ T must be in Schur canonical form (as returned by SHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) REAL array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ Schur canonical form.
+ On exit, the reordered upper quasi-triangular matrix, again
+ in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix Z which reorders T.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of T.
+ The block with row index IFST is moved to row ILST, by a
+ sequence of transpositions between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of a
+ 2-by-2 block, it is changed to point to the first row; ILST
+ always points to the first row of the block in its final
+ position (which may differ from its input value by +1 or -1).
+ 1 <= IFST <= N; 1 <= ILST <= N.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: two adjacent blocks were too close to swap (the problem
+ is very ill-conditioned); T may have been partially
+ reordered, and ILST points to the first row of the
+ current position of the block being moved.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>compq</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>ifst</CODE> - <DD><CODE>ilst</CODE> - <DD><CODE>work</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strrfs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, float[], int, float[], float[], float[], int[], org.netlib.util.intW)"><!-- --></A><H3>
+strrfs</H3>
+<PRE>
+public abstract void <B>strrfs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] x,
+ int ldx,
+ float[] ferr,
+ float[] berr,
+ float[] work,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular
+ coefficient matrix.
+
+ The solution matrix X must be computed by STRTRS or some other
+ means before entering this routine. STRRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>x</CODE> - <DD><CODE>ldx</CODE> - <DD><CODE>ferr</CODE> - <DD><CODE>berr</CODE> - <DD><CODE>work</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strsen(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], float[], org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.floatW, float[], int, int[], int, org.netlib.util.intW)"><!-- --></A><H3>
+strsen</H3>
+<PRE>
+public abstract void <B>strsen</B>(java.lang.String job,
+ java.lang.String compq,
+ boolean[] select,
+ int n,
+ float[] t,
+ int ldt,
+ float[] q,
+ int ldq,
+ float[] wr,
+ float[] wi,
+ org.netlib.util.intW m,
+ org.netlib.util.floatW s,
+ org.netlib.util.floatW sep,
+ float[] work,
+ int lwork,
+ int[] iwork,
+ int liwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSEN reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
+ the leading diagonal blocks of the upper quasi-triangular matrix T,
+ and the leading columns of Q form an orthonormal basis of the
+ corresponding right invariant subspace.
+
+ Optionally the routine computes the reciprocal condition numbers of
+ the cluster of eigenvalues and/or the invariant subspace.
+
+ T must be in Schur canonical form (as returned by SHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elemnts equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (S) or the invariant subspace (SEP):
+ = 'N': none;
+ = 'E': for eigenvalues only (S);
+ = 'V': for invariant subspace only (SEP);
+ = 'B': for both eigenvalues and invariant subspace (S and
+ SEP).
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster. To
+
+ select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) REAL array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, T is overwritten by the reordered matrix T, again in
+ Schur canonical form, with the selected eigenvalues in the
+ leading diagonal blocks.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix which reorders T; the
+ leading M columns of Q form an orthonormal basis for the
+ specified invariant subspace.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ The real and imaginary parts, respectively, of the reordered
+
+ eigenvalues of T. The eigenvalues are stored in the same
+ order as on the diagonal of T, with WR(i) = T(i,i) and, if
+ T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
+ WI(i+1) = -WI(i). Note that if a complex eigenvalue is
+ sufficiently ill-conditioned, then its value may differ
+ significantly from its value before reordering.
+
+ M (output) INTEGER
+ The dimension of the specified invariant subspace.
+ 0 < = M <= N.
+
+ S (output) REAL
+ If JOB = 'E' or 'B', S is a lower bound on the reciprocal
+ condition number for the selected cluster of eigenvalues.
+ S cannot underestimate the true reciprocal condition number
+ by more than a factor of sqrt(N). If M = 0 or N, S = 1.
+ If JOB = 'N' or 'V', S is not referenced.
+
+ SEP (output) REAL
+ If JOB = 'V' or 'B', SEP is the estimated reciprocal
+ condition number of the specified invariant subspace. If
+ M = 0 or N, SEP = norm(T).
+ If JOB = 'N' or 'E', SEP is not referenced.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOB = 'N', LWORK >= max(1,N);
+ if JOB = 'E', LWORK >= max(1,M*(N-M));
+ if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOB = 'N' or 'E', LIWORK >= 1;
+ if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: reordering of T failed because some eigenvalues are too
+
+ close to separate (the problem is very ill-conditioned);
+ T may have been partially reordered, and WR and WI
+ contain the eigenvalues in the same order as in T; S and
+ SEP (if requested) are set to zero.
+
+ Further Details
+ ===============
+
+ STRSEN first collects the selected eigenvalues by computing an
+ orthogonal transformation Z to move them to the top left corner of T.
+ In other words, the selected eigenvalues are the eigenvalues of T11
+ in:
+
+ Z'*T*Z = ( T11 T12 ) n1
+ ( 0 T22 ) n2
+ n1 n2
+
+ where N = n1+n2 and Z' means the transpose of Z. The first n1 columns
+ of Z span the specified invariant subspace of T.
+
+ If T has been obtained from the real Schur factorization of a matrix
+
+ A = Q*T*Q', then the reordered real Schur factorization of A is given
+ by A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span
+ the corresponding invariant subspace of A.
+
+ The reciprocal condition number of the average of the eigenvalues of
+
+ T11 may be returned in S. S lies between 0 (very badly conditioned)
+ and 1 (very well conditioned). It is computed as follows. First we
+ compute R so that
+
+ P = ( I R ) n1
+ ( 0 0 ) n2
+ n1 n2
+
+ is the projector on the invariant subspace associated with T11.
+ R is the solution of the Sylvester equation:
+
+ T11*R - R*T22 = T12.
+
+ Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
+ the two-norm of M. Then S is computed as the lower bound
+
+ (1 + F-norm(R)**2)**(-1/2)
+
+ on the reciprocal of 2-norm(P), the true reciprocal condition number.
+ S cannot underestimate 1 / 2-norm(P) by more than a factor of
+ sqrt(N).
+
+ An approximate error bound for the computed average of the
+ eigenvalues of T11 is
+
+ EPS * norm(T) / S
+
+ where EPS is the machine precision.
+
+ The reciprocal condition number of the right invariant subspace
+ spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
+
+ SEP is defined as the separation of T11 and T22:
+
+ sep( T11, T22 ) = sigma-min( C )
+
+ where sigma-min(C) is the smallest singular value of the
+ n1*n2-by-n1*n2 matrix
+
+ C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
+
+ I(m) is an m by m identity matrix, and kprod denotes the Kronecker
+ product. We estimate sigma-min(C) by the reciprocal of an estimate of
+ the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
+ cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
+
+ When SEP is small, small changes in T can cause large changes in
+ the invariant subspace. An approximate bound on the maximum angular
+ error in the computed right invariant subspace is
+
+ EPS * norm(T) / SEP
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>compq</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>q</CODE> - <DD><CODE>ldq</CODE> - <DD><CODE>wr</CODE> - <DD><CODE>wi</CODE> - <DD><CODE>m</CODE> - <DD><CODE>s</CODE> - <DD><CODE>sep</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>liwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strsna(java.lang.String, java.lang.String, boolean[], int, float[], int, float[], int, float[], int, float[], float[], int, org.netlib.util.intW, float[], int, int[], org.netlib.util.intW)"><!-- --></A><H3>
+strsna</H3>
+<PRE>
+public abstract void <B>strsna</B>(java.lang.String job,
+ java.lang.String howmny,
+ boolean[] select,
+ int n,
+ float[] t,
+ int ldt,
+ float[] vl,
+ int ldvl,
+ float[] vr,
+ int ldvr,
+ float[] s,
+ float[] sep,
+ int mm,
+ org.netlib.util.intW m,
+ float[] work,
+ int ldwork,
+ int[] iwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or right eigenvectors of a real upper
+ quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
+ orthogonal).
+
+ T must be in Schur canonical form (as returned by SHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (SEP):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (SEP);
+ = 'B': for both eigenvalues and eigenvectors (S and SEP).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) REAL array, dimension (LDT,N)
+ The upper quasi-triangular matrix T, in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input) REAL array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of T
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VL, as returned by
+ SHSEIN or STREVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) REAL array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of T
+
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VR, as returned by
+ SHSEIN or STREVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) REAL array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), SEP(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ SEP (output) REAL array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of SEP are set to the same value. If
+ the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', SEP is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S (if JOB = 'E' or 'B')
+
+ and/or SEP (if JOB = 'V' or 'B'). MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and/or SEP actually
+ used to store the estimated condition numbers.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace) REAL array, dimension (LDWORK,N+6)
+ If JOB = 'E', WORK is not referenced.
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
+
+ IWORK (workspace) INTEGER array, dimension (2*(N-1))
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of an eigenvalue lambda is
+ defined as
+
+ S(lambda) = |v'*u| / (norm(u)*norm(v))
+
+ where u and v are the right and left eigenvectors of T corresponding
+
+ to lambda; v' denotes the conjugate-transpose of v, and norm(u)
+ denotes the Euclidean norm. These reciprocal condition numbers always
+ lie between zero (very badly conditioned) and one (very well
+ conditioned). If n = 1, S(lambda) is defined to be 1.
+
+ An approximate error bound for a computed eigenvalue W(i) is given by
+
+ EPS * norm(T) / S(i)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number of the right eigenvector u
+ corresponding to lambda is defined as follows. Suppose
+
+ T = ( lambda c )
+ ( 0 T22 )
+
+ Then the reciprocal condition number is
+
+ SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
+
+ where sigma-min denotes the smallest singular value. We approximate
+ the smallest singular value by the reciprocal of an estimate of the
+ one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
+ defined to be abs(T(1,1)).
+
+ An approximate error bound for a computed right eigenvector VR(i)
+ is given by
+
+ EPS * norm(T) / SEP(i)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>job</CODE> - <DD><CODE>howmny</CODE> - <DD><CODE>select</CODE> - <DD><CODE>n</CODE> - <DD><CODE>t</CODE> - <DD><CODE>ldt</CODE> - <DD><CODE>vl</CODE> - <DD><CODE>ldvl</CODE> - <DD><CODE>vr</CODE> - <DD><CODE>ldvr</CODE> - <DD><CODE>s</CODE> - <DD><CODE>sep</CODE> - <DD><CODE>mm</CODE> - <DD><CODE>m</CODE> - <DD><CODE>work</CODE> - <DD><CODE>ldwork</CODE> - <DD><CODE>iwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strsyl(java.lang.String, java.lang.String, int, int, int, float[], int, float[], int, float[], int, org.netlib.util.floatW, org.netlib.util.intW)"><!-- --></A><H3>
+strsyl</H3>
+<PRE>
+public abstract void <B>strsyl</B>(java.lang.String trana,
+ java.lang.String tranb,
+ int isgn,
+ int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ float[] c,
+ int Ldc,
+ org.netlib.util.floatW scale,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSYL solves the real Sylvester matrix equation:
+
+ op(A)*X + X*op(B) = scale*C or
+ op(A)*X - X*op(B) = scale*C,
+
+ where op(A) = A or A**T, and A and B are both upper quasi-
+ triangular. A is M-by-M and B is N-by-N; the right hand side C and
+ the solution X are M-by-N; and scale is an output scale factor, set
+ <= 1 to avoid overflow in X.
+
+ A and B must be in Schur canonical form (as returned by SHSEQR), that
+ is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
+ each 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ TRANA (input) CHARACTER*1
+ Specifies the option op(A):
+ = 'N': op(A) = A (No transpose)
+ = 'T': op(A) = A**T (Transpose)
+ = 'C': op(A) = A**H (Conjugate transpose = Transpose)
+
+ TRANB (input) CHARACTER*1
+ Specifies the option op(B):
+ = 'N': op(B) = B (No transpose)
+ = 'T': op(B) = B**T (Transpose)
+ = 'C': op(B) = B**H (Conjugate transpose = Transpose)
+
+ ISGN (input) INTEGER
+ Specifies the sign in the equation:
+ = +1: solve op(A)*X + X*op(B) = scale*C
+ = -1: solve op(A)*X - X*op(B) = scale*C
+
+ M (input) INTEGER
+ The order of the matrix A, and the number of rows in the
+ matrices X and C. M >= 0.
+
+ N (input) INTEGER
+ The order of the matrix B, and the number of columns in the
+ matrices X and C. N >= 0.
+
+ A (input) REAL array, dimension (LDA,M)
+ The upper quasi-triangular matrix A, in Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input) REAL array, dimension (LDB,N)
+ The upper quasi-triangular matrix B, in Schur canonical form.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N right hand side matrix C.
+ On exit, C is overwritten by the solution matrix X.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M)
+
+ SCALE (output) REAL
+ The scale factor, scale, set <= 1 to avoid overflow in X.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: A and B have common or very close eigenvalues; perturbed
+ values were used to solve the equation (but the matrices
+ A and B are unchanged).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>trana</CODE> - <DD><CODE>tranb</CODE> - <DD><CODE>isgn</CODE> - <DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>c</CODE> - <DD><CODE>Ldc</CODE> - <DD><CODE>scale</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strti2(java.lang.String, java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+strti2</H3>
+<PRE>
+public abstract void <B>strti2</B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRTI2 computes the inverse of a real upper or lower triangular
+ matrix.
+
+ This is the Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading n by n upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strtri(java.lang.String, java.lang.String, int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+strtri</H3>
+<PRE>
+public abstract void <B>strtri</B>(java.lang.String uplo,
+ java.lang.String diag,
+ int n,
+ float[] a,
+ int lda,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRTRI computes the inverse of a real upper or lower triangular
+ matrix A.
+
+ This is the Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="strtrs(java.lang.String, java.lang.String, java.lang.String, int, int, float[], int, float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+strtrs</H3>
+<PRE>
+public abstract void <B>strtrs</B>(java.lang.String uplo,
+ java.lang.String trans,
+ java.lang.String diag,
+ int n,
+ int nrhs,
+ float[] a,
+ int lda,
+ float[] b,
+ int ldb,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N, and B is an N-by-NRHS
+ matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the solutions
+ X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>uplo</CODE> - <DD><CODE>trans</CODE> - <DD><CODE>diag</CODE> - <DD><CODE>n</CODE> - <DD><CODE>nrhs</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>b</CODE> - <DD><CODE>ldb</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stzrqf(int, int, float[], int, float[], org.netlib.util.intW)"><!-- --></A><H3>
+stzrqf</H3>
+<PRE>
+public abstract void <B>stzrqf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine STZRZF.
+
+ STZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="stzrzf(int, int, float[], int, float[], float[], int, org.netlib.util.intW)"><!-- --></A><H3>
+stzrzf</H3>
+<PRE>
+public abstract void <B>stzrzf</B>(int m,
+ int n,
+ float[] a,
+ int lda,
+ float[] tau,
+ float[] work,
+ int lwork,
+ org.netlib.util.intW info)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>m</CODE> - <DD><CODE>n</CODE> - <DD><CODE>a</CODE> - <DD><CODE>lda</CODE> - <DD><CODE>tau</CODE> - <DD><CODE>work</CODE> - <DD><CODE>lwork</CODE> - <DD><CODE>info</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamch(java.lang.String)"><!-- --></A><H3>
+dlamch</H3>
+<PRE>
+public abstract double <B>dlamch</B>(java.lang.String cmach)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMCH determines double precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by DLAMCH:
+ = 'E' or 'e', DLAMCH := eps
+ = 'S' or 's , DLAMCH := sfmin
+ = 'B' or 'b', DLAMCH := base
+ = 'P' or 'p', DLAMCH := eps*base
+ = 'N' or 'n', DLAMCH := t
+ = 'R' or 'r', DLAMCH := rnd
+ = 'M' or 'm', DLAMCH := emin
+ = 'U' or 'u', DLAMCH := rmin
+ = 'L' or 'l', DLAMCH := emax
+ = 'O' or 'o', DLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>cmach</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamc1(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.booleanW)"><!-- --></A><H3>
+dlamc1</H3>
+<PRE>
+public abstract void <B>dlamc1</B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.booleanW ieee1)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>beta</CODE> - <DD><CODE>t</CODE> - <DD><CODE>rnd</CODE> - <DD><CODE>ieee1</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamc2(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW, org.netlib.util.intW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlamc2</H3>
+<PRE>
+public abstract void <B>dlamc2</B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.doubleW eps,
+ org.netlib.util.intW emin,
+ org.netlib.util.doubleW rmin,
+ org.netlib.util.intW emax,
+ org.netlib.util.doubleW rmax)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) DOUBLE PRECISION
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) DOUBLE PRECISION
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) DOUBLE PRECISION
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>beta</CODE> - <DD><CODE>t</CODE> - <DD><CODE>rnd</CODE> - <DD><CODE>eps</CODE> - <DD><CODE>emin</CODE> - <DD><CODE>rmin</CODE> - <DD><CODE>emax</CODE> - <DD><CODE>rmax</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamc3(double, double)"><!-- --></A><H3>
+dlamc3</H3>
+<PRE>
+public double <B>dlamc3</B>(double a,
+ double b)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC3 is intended to force A and B to be stored prior to doing
+
+ the addition of A and B , for use in situations where optimizers
+
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ B (input) DOUBLE PRECISION
+ The values A and B.
+
+ =====================================================================
+
+
+ .. Executable Statements ..
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamc4(org.netlib.util.intW, double, int)"><!-- --></A><H3>
+dlamc4</H3>
+<PRE>
+public abstract void <B>dlamc4</B>(org.netlib.util.intW emin,
+ double start,
+ int base)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC4 is a service routine for DLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow, computed by
+
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) DOUBLE PRECISION
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>emin</CODE> - <DD><CODE>start</CODE> - <DD><CODE>base</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dlamc5(int, int, int, boolean, org.netlib.util.intW, org.netlib.util.doubleW)"><!-- --></A><H3>
+dlamc5</H3>
+<PRE>
+public abstract void <B>dlamc5</B>(int beta,
+ int p,
+ int emin,
+ boolean ieee,
+ org.netlib.util.intW emax,
+ org.netlib.util.doubleW rmax)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) DOUBLE PRECISION
+ The largest machine floating-point number.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>beta</CODE> - <DD><CODE>p</CODE> - <DD><CODE>emin</CODE> - <DD><CODE>ieee</CODE> - <DD><CODE>emax</CODE> - <DD><CODE>rmax</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="dsecnd()"><!-- --></A><H3>
+dsecnd</H3>
+<PRE>
+public double <B>dsecnd</B>()</PRE>
+<DL>
+<DD><pre>
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+ February 2007
+
+ Purpose
+ =======
+
+ DSECND returns the user time for a process in seconds.
+ This version gets the time from the EXTERNAL system function ETIME.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="lsame(java.lang.String, java.lang.String)"><!-- --></A><H3>
+lsame</H3>
+<PRE>
+public boolean <B>lsame</B>(java.lang.String ca,
+ java.lang.String cb)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
+ case.
+
+ Arguments
+ =========
+
+ CA (input) CHARACTER*1
+ CB (input) CHARACTER*1
+ CA and CB specify the single characters to be compared.
+
+ =====================================================================
+
+
+ .. Intrinsic Functions ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>ca</CODE> - <DD><CODE>cb</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="second()"><!-- --></A><H3>
+second</H3>
+<PRE>
+public float <B>second</B>()</PRE>
+<DL>
+<DD><pre>
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+ February 2007
+
+ Purpose
+ =======
+
+ SECOND returns the user time for a process in seconds.
+ This version gets the time from the EXTERNAL system function ETIME.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamch(java.lang.String)"><!-- --></A><H3>
+slamch</H3>
+<PRE>
+public float <B>slamch</B>(java.lang.String cmach)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMCH determines single precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by SLAMCH:
+ = 'E' or 'e', SLAMCH := eps
+ = 'S' or 's , SLAMCH := sfmin
+ = 'B' or 'b', SLAMCH := base
+ = 'P' or 'p', SLAMCH := eps*base
+ = 'N' or 'n', SLAMCH := t
+ = 'R' or 'r', SLAMCH := rnd
+ = 'M' or 'm', SLAMCH := emin
+ = 'U' or 'u', SLAMCH := rmin
+ = 'L' or 'l', SLAMCH := emax
+ = 'O' or 'o', SLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>cmach</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamc1(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.booleanW)"><!-- --></A><H3>
+slamc1</H3>
+<PRE>
+public abstract void <B>slamc1</B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.booleanW ieee1)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>beta</CODE> - <DD><CODE>t</CODE> - <DD><CODE>rnd</CODE> - <DD><CODE>ieee1</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamc2(org.netlib.util.intW, org.netlib.util.intW, org.netlib.util.booleanW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW, org.netlib.util.intW, org.netlib.util.floatW)"><!-- --></A><H3>
+slamc2</H3>
+<PRE>
+public abstract void <B>slamc2</B>(org.netlib.util.intW beta,
+ org.netlib.util.intW t,
+ org.netlib.util.booleanW rnd,
+ org.netlib.util.floatW eps,
+ org.netlib.util.intW emin,
+ org.netlib.util.floatW rmin,
+ org.netlib.util.intW emax,
+ org.netlib.util.floatW rmax)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) REAL
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) REAL
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) REAL
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>beta</CODE> - <DD><CODE>t</CODE> - <DD><CODE>rnd</CODE> - <DD><CODE>eps</CODE> - <DD><CODE>emin</CODE> - <DD><CODE>rmin</CODE> - <DD><CODE>emax</CODE> - <DD><CODE>rmax</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamc3(float, float)"><!-- --></A><H3>
+slamc3</H3>
+<PRE>
+public float <B>slamc3</B>(float a,
+ float b)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC3 is intended to force A and B to be stored prior to doing
+
+ the addition of A and B , for use in situations where optimizers
+
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A (input) REAL
+ B (input) REAL
+ The values A and B.
+
+ =====================================================================
+
+
+ .. Executable Statements ..
+
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>a</CODE> - <DD><CODE>b</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamc4(org.netlib.util.intW, float, int)"><!-- --></A><H3>
+slamc4</H3>
+<PRE>
+public abstract void <B>slamc4</B>(org.netlib.util.intW emin,
+ float start,
+ int base)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC4 is a service routine for SLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow, computed by
+
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) REAL
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>emin</CODE> - <DD><CODE>start</CODE> - <DD><CODE>base</CODE> - </DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="slamc5(int, int, int, boolean, org.netlib.util.intW, org.netlib.util.floatW)"><!-- --></A><H3>
+slamc5</H3>
+<PRE>
+public abstract void <B>slamc5</B>(int beta,
+ int p,
+ int emin,
+ boolean ieee,
+ org.netlib.util.intW emax,
+ org.netlib.util.floatW rmax)</PRE>
+<DL>
+<DD><pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) REAL
+ The largest machine floating-point number.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>beta</CODE> - <DD><CODE>p</CODE> - <DD><CODE>emin</CODE> - <DD><CODE>ieee</CODE> - <DD><CODE>emax</CODE> - <DD><CODE>rmax</CODE> - </DL>
+</DD>
+</DL>
+<!-- ========= END OF CLASS DATA ========= -->
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/LAPACK.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/LAPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="LAPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | FIELD | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: FIELD | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/lapack/class-use/LAPACK.html b/javadoc/org/netlib/lapack/class-use/LAPACK.html
new file mode 100644
index 0000000..64f4623
--- /dev/null
+++ b/javadoc/org/netlib/lapack/class-use/LAPACK.html
@@ -0,0 +1,181 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Class org.netlib.lapack.LAPACK
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Class org.netlib.lapack.LAPACK";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/lapack//class-useLAPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="LAPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Class<br>org.netlib.lapack.LAPACK</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.lapack"><B>org.netlib.lapack</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.lapack"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Uses of <A HREF="../../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A> in <A HREF="../../../../org/netlib/lapack/package-summary.html">org.netlib.lapack</A></FONT></TH>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Methods in <A HREF="../../../../org/netlib/lapack/package-summary.html">org.netlib.lapack</A> that return <A HREF="../../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A></CODE></FONT></TD>
+<TD><CODE><B>LAPACK.</B><B><A HREF="../../../../org/netlib/lapack/LAPACK.html#getInstance()">getInstance</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/lapack//class-useLAPACK.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="LAPACK.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/lapack/package-frame.html b/javadoc/org/netlib/lapack/package-frame.html
new file mode 100644
index 0000000..cff6f89
--- /dev/null
+++ b/javadoc/org/netlib/lapack/package-frame.html
@@ -0,0 +1,33 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.lapack
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+<FONT size="+1" CLASS="FrameTitleFont">
+<A HREF="../../../org/netlib/lapack/package-summary.html" target="classFrame">org.netlib.lapack</A></FONT>
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT size="+1" CLASS="FrameHeadingFont">
+Classes</FONT>
+<FONT CLASS="FrameItemFont">
+<BR>
+<A HREF="LAPACK.html" title="class in org.netlib.lapack" target="classFrame">LAPACK</A></FONT></TD>
+</TR>
+</TABLE>
+
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/lapack/package-summary.html b/javadoc/org/netlib/lapack/package-summary.html
new file mode 100644
index 0000000..31fdf5d
--- /dev/null
+++ b/javadoc/org/netlib/lapack/package-summary.html
@@ -0,0 +1,159 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.lapack
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.lapack";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/blas/package-summary.html"><B>PREV PACKAGE</B></A>
+ <A HREF="../../../org/netlib/utils/package-summary.html"><B>NEXT PACKAGE</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<H2>
+Package org.netlib.lapack
+</H2>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Class Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="15%"><B><A HREF="../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack">LAPACK</A></B></TD>
+<TD>LAPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.</TD>
+</TR>
+</TABLE>
+
+
+<P>
+<DL>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/blas/package-summary.html"><B>PREV PACKAGE</B></A>
+ <A HREF="../../../org/netlib/utils/package-summary.html"><B>NEXT PACKAGE</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/lapack/package-tree.html b/javadoc/org/netlib/lapack/package-tree.html
new file mode 100644
index 0000000..458b241
--- /dev/null
+++ b/javadoc/org/netlib/lapack/package-tree.html
@@ -0,0 +1,154 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.lapack Class Hierarchy
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.lapack Class Hierarchy";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/blas/package-tree.html"><B>PREV</B></A>
+ <A HREF="../../../org/netlib/utils/package-tree.html"><B>NEXT</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+Hierarchy For Package org.netlib.lapack
+</H2>
+</CENTER>
+<DL>
+<DT><B>Package Hierarchies:</B><DD><A HREF="../../../overview-tree.html">All Packages</A></DL>
+<HR>
+<H2>
+Class Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">org.netlib.lapack.<A HREF="../../../org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack"><B>LAPACK</B></A></UL>
+</UL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/blas/package-tree.html"><B>PREV</B></A>
+ <A HREF="../../../org/netlib/utils/package-tree.html"><B>NEXT</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/lapack/package-use.html b/javadoc/org/netlib/lapack/package-use.html
new file mode 100644
index 0000000..fda8f88
--- /dev/null
+++ b/javadoc/org/netlib/lapack/package-use.html
@@ -0,0 +1,172 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Package org.netlib.lapack
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Package org.netlib.lapack";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Package<br>org.netlib.lapack</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../org/netlib/lapack/package-summary.html">org.netlib.lapack</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.lapack"><B>org.netlib.lapack</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.lapack"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Classes in <A HREF="../../../org/netlib/lapack/package-summary.html">org.netlib.lapack</A> used by <A HREF="../../../org/netlib/lapack/package-summary.html">org.netlib.lapack</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><B><A HREF="../../../org/netlib/lapack/class-use/LAPACK.html#org.netlib.lapack"><B>LAPACK</B></A></B>
+
+<BR>
+ LAPACK provider which will attempt to access a native implementation
+ and falling back to use F2J if none is available.</TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/lapack/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/JNIMethods.ARCHType.html b/javadoc/org/netlib/utils/JNIMethods.ARCHType.html
new file mode 100644
index 0000000..22900c5
--- /dev/null
+++ b/javadoc/org/netlib/utils/JNIMethods.ARCHType.html
@@ -0,0 +1,394 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:20 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+JNIMethods.ARCHType
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="JNIMethods.ARCHType";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/JNIMethods.ARCHType.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><B>PREV CLASS</B></A>
+ <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><B>NEXT CLASS</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/JNIMethods.ARCHType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.ARCHType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | <A HREF="#enum_constant_summary">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: <A HREF="#enum_constant_detail">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<!-- ======== START OF CLASS DATA ======== -->
+<H2>
+<FONT SIZE="-1">
+org.netlib.utils</FONT>
+<BR>
+Enum JNIMethods.ARCHType</H2>
+<PRE>
+java.lang.Object
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by ">java.lang.Enum<<A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>>
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by "><B>org.netlib.utils.JNIMethods.ARCHType</B>
+</PRE>
+<DL>
+<DT><B>All Implemented Interfaces:</B> <DD>java.io.Serializable, java.lang.Comparable<<A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>></DD>
+</DL>
+<DL>
+<DT><B>Enclosing class:</B><DD><A HREF="../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A></DD>
+</DL>
+<HR>
+<DL>
+<DT><PRE>public static enum <B>JNIMethods.ARCHType</B><DT>extends java.lang.Enum<<A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>></DL>
+</PRE>
+
+<P>
+Enumeration of common CPU architectures.
+<P>
+
+<P>
+<HR>
+
+<P>
+<!-- =========== ENUM CONSTANT SUMMARY =========== -->
+
+<A NAME="enum_constant_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Enum Constant Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#PPC">PPC</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#PPC_64">PPC_64</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#SPARC">SPARC</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#UNKNOWN">UNKNOWN</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#X86">X86</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#X86_64">X86_64</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<!-- ========== METHOD SUMMARY =========== -->
+
+<A NAME="method_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Method Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#valueOf(java.lang.String)">valueOf</A></B>(java.lang.String name)</CODE>
+
+<BR>
+ Returns the enum constant of this type with the specified name.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>[]</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html#values()">values</A></B>()</CODE>
+
+<BR>
+ Returns an array containing the constants of this enum type, in
+the order they are declared.</TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Enum"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Enum</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>clone, compareTo, equals, finalize, getDeclaringClass, hashCode, name, ordinal, toString, valueOf</CODE></TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Object"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Object</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>getClass, notify, notifyAll, wait, wait, wait</CODE></TD>
+</TR>
+</TABLE>
+
+<P>
+
+<!-- ============ ENUM CONSTANT DETAIL =========== -->
+
+<A NAME="enum_constant_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Enum Constant Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="PPC"><!-- --></A><H3>
+PPC</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>PPC</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="PPC_64"><!-- --></A><H3>
+PPC_64</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>PPC_64</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="SPARC"><!-- --></A><H3>
+SPARC</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>SPARC</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="UNKNOWN"><!-- --></A><H3>
+UNKNOWN</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>UNKNOWN</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="X86"><!-- --></A><H3>
+X86</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>X86</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="X86_64"><!-- --></A><H3>
+X86_64</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>X86_64</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+
+<!-- ============ METHOD DETAIL ========== -->
+
+<A NAME="method_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Method Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="values()"><!-- --></A><H3>
+values</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>[] <B>values</B>()</PRE>
+<DL>
+<DD>Returns an array containing the constants of this enum type, in
+the order they are declared. This method may be used to iterate
+over the constants as follows:
+<pre>
+for (JNIMethods.ARCHType c : JNIMethods.ARCHType.values())
+ System.out.println(c);
+</pre>
+<P>
+<DD><DL>
+
+<DT><B>Returns:</B><DD>an array containing the constants of this enum type, in
+the order they are declared</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="valueOf(java.lang.String)"><!-- --></A><H3>
+valueOf</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>valueOf</B>(java.lang.String name)</PRE>
+<DL>
+<DD>Returns the enum constant of this type with the specified name.
+The string must match <I>exactly</I> an identifier used to declare an
+enum constant in this type. (Extraneous whitespace characters are
+not permitted.)
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>name</CODE> - the name of the enum constant to be returned.
+<DT><B>Returns:</B><DD>the enum constant with the specified name
+<DT><B>Throws:</B>
+<DD><CODE>java.lang.IllegalArgumentException</CODE> - if this enum type has no constant
+with the specified name
+<DD><CODE>java.lang.NullPointerException</CODE> - if the argument is null</DL>
+</DD>
+</DL>
+<!-- ========= END OF CLASS DATA ========= -->
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/JNIMethods.ARCHType.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><B>PREV CLASS</B></A>
+ <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><B>NEXT CLASS</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/JNIMethods.ARCHType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.ARCHType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | <A HREF="#enum_constant_summary">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: <A HREF="#enum_constant_detail">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/JNIMethods.OSType.html b/javadoc/org/netlib/utils/JNIMethods.OSType.html
new file mode 100644
index 0000000..8bbd805
--- /dev/null
+++ b/javadoc/org/netlib/utils/JNIMethods.OSType.html
@@ -0,0 +1,378 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:20 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+JNIMethods.OSType
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="JNIMethods.OSType";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/JNIMethods.OSType.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>PREV CLASS</B></A>
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/JNIMethods.OSType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.OSType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | <A HREF="#enum_constant_summary">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: <A HREF="#enum_constant_detail">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<!-- ======== START OF CLASS DATA ======== -->
+<H2>
+<FONT SIZE="-1">
+org.netlib.utils</FONT>
+<BR>
+Enum JNIMethods.OSType</H2>
+<PRE>
+java.lang.Object
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by ">java.lang.Enum<<A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>>
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by "><B>org.netlib.utils.JNIMethods.OSType</B>
+</PRE>
+<DL>
+<DT><B>All Implemented Interfaces:</B> <DD>java.io.Serializable, java.lang.Comparable<<A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>></DD>
+</DL>
+<DL>
+<DT><B>Enclosing class:</B><DD><A HREF="../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A></DD>
+</DL>
+<HR>
+<DL>
+<DT><PRE>public static enum <B>JNIMethods.OSType</B><DT>extends java.lang.Enum<<A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>></DL>
+</PRE>
+
+<P>
+Enumeration of common operating systems, independent of version or architecture.
+<P>
+
+<P>
+<HR>
+
+<P>
+<!-- =========== ENUM CONSTANT SUMMARY =========== -->
+
+<A NAME="enum_constant_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Enum Constant Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#APPLE">APPLE</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#LINUX">LINUX</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#SUN">SUN</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#UNKNOWN">UNKNOWN</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#WINDOWS">WINDOWS</A></B></CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<!-- ========== METHOD SUMMARY =========== -->
+
+<A NAME="method_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Method Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#valueOf(java.lang.String)">valueOf</A></B>(java.lang.String name)</CODE>
+
+<BR>
+ Returns the enum constant of this type with the specified name.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>[]</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html#values()">values</A></B>()</CODE>
+
+<BR>
+ Returns an array containing the constants of this enum type, in
+the order they are declared.</TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Enum"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Enum</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>clone, compareTo, equals, finalize, getDeclaringClass, hashCode, name, ordinal, toString, valueOf</CODE></TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Object"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Object</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>getClass, notify, notifyAll, wait, wait, wait</CODE></TD>
+</TR>
+</TABLE>
+
+<P>
+
+<!-- ============ ENUM CONSTANT DETAIL =========== -->
+
+<A NAME="enum_constant_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Enum Constant Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="APPLE"><!-- --></A><H3>
+APPLE</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>APPLE</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="LINUX"><!-- --></A><H3>
+LINUX</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>LINUX</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="SUN"><!-- --></A><H3>
+SUN</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>SUN</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="UNKNOWN"><!-- --></A><H3>
+UNKNOWN</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>UNKNOWN</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="WINDOWS"><!-- --></A><H3>
+WINDOWS</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>WINDOWS</B></PRE>
+<DL>
+<DL>
+</DL>
+</DL>
+
+<!-- ============ METHOD DETAIL ========== -->
+
+<A NAME="method_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Method Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="values()"><!-- --></A><H3>
+values</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>[] <B>values</B>()</PRE>
+<DL>
+<DD>Returns an array containing the constants of this enum type, in
+the order they are declared. This method may be used to iterate
+over the constants as follows:
+<pre>
+for (JNIMethods.OSType c : JNIMethods.OSType.values())
+ System.out.println(c);
+</pre>
+<P>
+<DD><DL>
+
+<DT><B>Returns:</B><DD>an array containing the constants of this enum type, in
+the order they are declared</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="valueOf(java.lang.String)"><!-- --></A><H3>
+valueOf</H3>
+<PRE>
+public static <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>valueOf</B>(java.lang.String name)</PRE>
+<DL>
+<DD>Returns the enum constant of this type with the specified name.
+The string must match <I>exactly</I> an identifier used to declare an
+enum constant in this type. (Extraneous whitespace characters are
+not permitted.)
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>name</CODE> - the name of the enum constant to be returned.
+<DT><B>Returns:</B><DD>the enum constant with the specified name
+<DT><B>Throws:</B>
+<DD><CODE>java.lang.IllegalArgumentException</CODE> - if this enum type has no constant
+with the specified name
+<DD><CODE>java.lang.NullPointerException</CODE> - if the argument is null</DL>
+</DD>
+</DL>
+<!-- ========= END OF CLASS DATA ========= -->
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/JNIMethods.OSType.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>PREV CLASS</B></A>
+ NEXT CLASS</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/JNIMethods.OSType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.OSType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: NESTED | <A HREF="#enum_constant_summary">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: <A HREF="#enum_constant_detail">ENUM CONSTANTS</A> | FIELD | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/JNIMethods.html b/javadoc/org/netlib/utils/JNIMethods.html
new file mode 100644
index 0000000..7944662
--- /dev/null
+++ b/javadoc/org/netlib/utils/JNIMethods.html
@@ -0,0 +1,402 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:20 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+JNIMethods
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="JNIMethods";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/JNIMethods.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>NEXT CLASS</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/JNIMethods.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: <A HREF="#nested_class_summary">NESTED</A> | <A HREF="#field_summary">FIELD</A> | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: <A HREF="#field_detail">FIELD</A> | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<!-- ======== START OF CLASS DATA ======== -->
+<H2>
+<FONT SIZE="-1">
+org.netlib.utils</FONT>
+<BR>
+Class JNIMethods</H2>
+<PRE>
+java.lang.Object
+ <IMG SRC="../../../resources/inherit.gif" ALT="extended by "><B>org.netlib.utils.JNIMethods</B>
+</PRE>
+<HR>
+<DL>
+<DT><PRE>public final class <B>JNIMethods</B><DT>extends java.lang.Object</DL>
+</PRE>
+
+<P>
+Static helper methods for dealing with the Java Native Interface and detection of
+ operating systems and architectures. The main purpose of this class is to provide a
+ more portable alternative to the System.loadLibrary method (and horrible syntax of
+ Bundle-NativeCode in MANIFEST files) when bundling binaries as part of a jar (either
+ inside, or in a directory structure nearby).
+ <p>
+ Note on usage: unfortunately it is not possible to provide a loadLibrary(String) method
+ here as it needs to know the calling class, which is lost when wrapped here. To load a
+ native library using this class, call the getPortableLibraryName() method to return a
+ String which may then be passed to System.loadLibrary().
+ <p>
+ Note: due to the nature of this class, a portable JUnit TestCase is not possible.
+<P>
+
+<P>
+<HR>
+
+<P>
+<!-- ======== NESTED CLASS SUMMARY ======== -->
+
+<A NAME="nested_class_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Nested Class Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static class</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></B></CODE>
+
+<BR>
+ Enumeration of common CPU architectures.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static class</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></B></CODE>
+
+<BR>
+ Enumeration of common operating systems, independent of version or architecture.</TD>
+</TR>
+</TABLE>
+ <!-- =========== FIELD SUMMARY =========== -->
+
+<A NAME="field_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Field Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.html#ARCH">ARCH</A></B></CODE>
+
+<BR>
+ Stores the CPU Architecture the JVM is currently running on.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.html#OS">OS</A></B></CODE>
+
+<BR>
+ Stores the operating system the JVM is currently running on.</TD>
+</TR>
+</TABLE>
+
+<!-- ======== CONSTRUCTOR SUMMARY ======== -->
+
+<A NAME="constructor_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Constructor Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.html#JNIMethods()">JNIMethods</A></B>()</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+
+<!-- ========== METHOD SUMMARY =========== -->
+
+<A NAME="method_summary"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Method Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static java.lang.String</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.html#getPortableLibraryName(java.lang.String)">getPortableLibraryName</A></B>(java.lang.String name)</CODE>
+
+<BR>
+ The System.mapLibraryName method is broken in the sense that it does not give
+ unique names for operating systems and architectures.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static void</CODE></FONT></TD>
+<TD><CODE><B><A HREF="../../../org/netlib/utils/JNIMethods.html#main(java.lang.String[])">main</A></B>(java.lang.String[] args)</CODE>
+
+<BR>
+ </TD>
+</TR>
+</TABLE>
+ <A NAME="methods_inherited_from_class_java.lang.Object"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#EEEEFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left"><B>Methods inherited from class java.lang.Object</B></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><CODE>clone, equals, finalize, getClass, hashCode, notify, notifyAll, toString, wait, wait, wait</CODE></TD>
+</TR>
+</TABLE>
+
+<P>
+
+<!-- ============ FIELD DETAIL =========== -->
+
+<A NAME="field_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Field Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="ARCH"><!-- --></A><H3>
+ARCH</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> <B>ARCH</B></PRE>
+<DL>
+<DD>Stores the CPU Architecture the JVM is currently running on.
+<P>
+<DL>
+</DL>
+</DL>
+<HR>
+
+<A NAME="OS"><!-- --></A><H3>
+OS</H3>
+<PRE>
+public static final <A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> <B>OS</B></PRE>
+<DL>
+<DD>Stores the operating system the JVM is currently running on.
+<P>
+<DL>
+</DL>
+</DL>
+
+<!-- ========= CONSTRUCTOR DETAIL ======== -->
+
+<A NAME="constructor_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Constructor Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="JNIMethods()"><!-- --></A><H3>
+JNIMethods</H3>
+<PRE>
+public <B>JNIMethods</B>()</PRE>
+<DL>
+</DL>
+
+<!-- ============ METHOD DETAIL ========== -->
+
+<A NAME="method_detail"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="1"><FONT SIZE="+2">
+<B>Method Detail</B></FONT></TH>
+</TR>
+</TABLE>
+
+<A NAME="getPortableLibraryName(java.lang.String)"><!-- --></A><H3>
+getPortableLibraryName</H3>
+<PRE>
+public static java.lang.String <B>getPortableLibraryName</B>(java.lang.String name)</PRE>
+<DL>
+<DD>The System.mapLibraryName method is broken in the sense that it does not give
+ unique names for operating systems and architectures. In order to facilitate
+ cross-platform compatibility allowing bundled binary files, this method will return
+ a unique library name, dependent on the operating system and architecture. The
+ return value of this method should be passed to the System.loadLibrary method
+ instead of the raw library name.
+ <p>
+ The resulting filename will be constructed by forcing the library name to lowercase
+ and appending an extra String that is defined by the operating system (the
+ architecture is only encoded if it is relevant). Some examples are for the
+ parameter 'name':-
+ <ul>
+ <li>Apple (G3, G4): "name-apple-ppc"</li>
+ <li>Apple (G5): "name-apple-ppc_64"</li>
+ <li>Apple (Intel): "name-apple-x86"</li>
+ <li>Apple (Intel 64 Bit mode): "name-apple-x86_64"</li>
+ <li>Linux (i686): "name-linux-x86"</li>
+ <li>Linux (Intel/AMD 64): "name-linux-x86_64"</li>
+ <li>Linux (sparc): "name-linux-sparc"</li>
+ <li>Linux (PPC 32 bit): "name-linux-ppc"</li>
+ <li>Linux (PPC 64 bit): "name-linux-ppc_64"</li>
+ <li>Windows XP/Vista (i686): "name-windows-x86"</li>
+ <li>Windows XP/Vista (Intel/AMD 64): "name-windows-x86_64"</li>
+ <li>Sun Solaris (Blade): "name-sun-sparc"</li>
+ <li>Sun Solaris (Intel 64 bit): "name-sun-x86_64"</li>
+ </ul>
+<P>
+<DD><DL>
+<DT><B>Parameters:</B><DD><CODE>name</CODE> -
+<DT><B>Returns:</B><DD>
+<DT><B>Throws:</B>
+<DD><CODE>java.lang.IllegalArgumentException</CODE> - if the input name is zero length or contains a directory separator
+ character.</DL>
+</DD>
+</DL>
+<HR>
+
+<A NAME="main(java.lang.String[])"><!-- --></A><H3>
+main</H3>
+<PRE>
+public static void <B>main</B>(java.lang.String[] args)</PRE>
+<DL>
+<DD><DL>
+</DL>
+</DD>
+</DL>
+<!-- ========= END OF CLASS DATA ========= -->
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Class</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="class-use/JNIMethods.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV CLASS
+ <A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>NEXT CLASS</B></A></FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/JNIMethods.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+<TR>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+ SUMMARY: <A HREF="#nested_class_summary">NESTED</A> | <A HREF="#field_summary">FIELD</A> | <A HREF="#constructor_summary">CONSTR</A> | <A HREF="#method_summary">METHOD</A></FONT></TD>
+<TD VALIGN="top" CLASS="NavBarCell3"><FONT SIZE="-2">
+DETAIL: <A HREF="#field_detail">FIELD</A> | <A HREF="#constructor_detail">CONSTR</A> | <A HREF="#method_detail">METHOD</A></FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/class-use/JNIMethods.ARCHType.html b/javadoc/org/netlib/utils/class-use/JNIMethods.ARCHType.html
new file mode 100644
index 0000000..e3d8638
--- /dev/null
+++ b/javadoc/org/netlib/utils/class-use/JNIMethods.ARCHType.html
@@ -0,0 +1,206 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Class org.netlib.utils.JNIMethods.ARCHType
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Class org.netlib.utils.JNIMethods.ARCHType";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/utils//class-useJNIMethods.ARCHType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.ARCHType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Class<br>org.netlib.utils.JNIMethods.ARCHType</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.utils"><B>org.netlib.utils</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.utils"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Uses of <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A> in <A HREF="../../../../org/netlib/utils/package-summary.html">org.netlib.utils</A></FONT></TH>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Fields in <A HREF="../../../../org/netlib/utils/package-summary.html">org.netlib.utils</A> declared as <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></CODE></FONT></TD>
+<TD><CODE><B>JNIMethods.</B><B><A HREF="../../../../org/netlib/utils/JNIMethods.html#ARCH">ARCH</A></B></CODE>
+
+<BR>
+ Stores the CPU Architecture the JVM is currently running on.</TD>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Methods in <A HREF="../../../../org/netlib/utils/package-summary.html">org.netlib.utils</A> that return <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></CODE></FONT></TD>
+<TD><CODE><B>JNIMethods.ARCHType.</B><B><A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html#valueOf(java.lang.String)">valueOf</A></B>(java.lang.String name)</CODE>
+
+<BR>
+ Returns the enum constant of this type with the specified name.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A>[]</CODE></FONT></TD>
+<TD><CODE><B>JNIMethods.ARCHType.</B><B><A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html#values()">values</A></B>()</CODE>
+
+<BR>
+ Returns an array containing the constants of this enum type, in
+the order they are declared.</TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/utils//class-useJNIMethods.ARCHType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.ARCHType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/class-use/JNIMethods.OSType.html b/javadoc/org/netlib/utils/class-use/JNIMethods.OSType.html
new file mode 100644
index 0000000..f962530
--- /dev/null
+++ b/javadoc/org/netlib/utils/class-use/JNIMethods.OSType.html
@@ -0,0 +1,206 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Class org.netlib.utils.JNIMethods.OSType
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Class org.netlib.utils.JNIMethods.OSType";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/utils//class-useJNIMethods.OSType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.OSType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Class<br>org.netlib.utils.JNIMethods.OSType</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.utils"><B>org.netlib.utils</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.utils"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Uses of <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A> in <A HREF="../../../../org/netlib/utils/package-summary.html">org.netlib.utils</A></FONT></TH>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Fields in <A HREF="../../../../org/netlib/utils/package-summary.html">org.netlib.utils</A> declared as <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></CODE></FONT></TD>
+<TD><CODE><B>JNIMethods.</B><B><A HREF="../../../../org/netlib/utils/JNIMethods.html#OS">OS</A></B></CODE>
+
+<BR>
+ Stores the operating system the JVM is currently running on.</TD>
+</TR>
+</TABLE>
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableSubHeadingColor">
+<TH ALIGN="left" COLSPAN="2">Methods in <A HREF="../../../../org/netlib/utils/package-summary.html">org.netlib.utils</A> that return <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></CODE></FONT></TD>
+<TD><CODE><B>JNIMethods.OSType.</B><B><A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html#valueOf(java.lang.String)">valueOf</A></B>(java.lang.String name)</CODE>
+
+<BR>
+ Returns the enum constant of this type with the specified name.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD ALIGN="right" VALIGN="top" WIDTH="1%"><FONT SIZE="-1">
+<CODE>static <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A>[]</CODE></FONT></TD>
+<TD><CODE><B>JNIMethods.OSType.</B><B><A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html#values()">values</A></B>()</CODE>
+
+<BR>
+ Returns an array containing the constants of this enum type, in
+the order they are declared.</TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/utils//class-useJNIMethods.OSType.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.OSType.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/class-use/JNIMethods.html b/javadoc/org/netlib/utils/class-use/JNIMethods.html
new file mode 100644
index 0000000..19d91ff
--- /dev/null
+++ b/javadoc/org/netlib/utils/class-use/JNIMethods.html
@@ -0,0 +1,145 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Class org.netlib.utils.JNIMethods
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Class org.netlib.utils.JNIMethods";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/utils//class-useJNIMethods.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Class<br>org.netlib.utils.JNIMethods</B></H2>
+</CENTER>
+No usage of org.netlib.utils.JNIMethods
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><FONT CLASS="NavBarFont1"><B>Class</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../../index.html?org/netlib/utils//class-useJNIMethods.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="JNIMethods.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/package-frame.html b/javadoc/org/netlib/utils/package-frame.html
new file mode 100644
index 0000000..c1d0310
--- /dev/null
+++ b/javadoc/org/netlib/utils/package-frame.html
@@ -0,0 +1,46 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.utils
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+<FONT size="+1" CLASS="FrameTitleFont">
+<A HREF="../../../org/netlib/utils/package-summary.html" target="classFrame">org.netlib.utils</A></FONT>
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT size="+1" CLASS="FrameHeadingFont">
+Classes</FONT>
+<FONT CLASS="FrameItemFont">
+<BR>
+<A HREF="JNIMethods.html" title="class in org.netlib.utils" target="classFrame">JNIMethods</A></FONT></TD>
+</TR>
+</TABLE>
+
+
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT size="+1" CLASS="FrameHeadingFont">
+Enums</FONT>
+<FONT CLASS="FrameItemFont">
+<BR>
+<A HREF="JNIMethods.ARCHType.html" title="enum in org.netlib.utils" target="classFrame">JNIMethods.ARCHType</A>
+<BR>
+<A HREF="JNIMethods.OSType.html" title="enum in org.netlib.utils" target="classFrame">JNIMethods.OSType</A></FONT></TD>
+</TR>
+</TABLE>
+
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/package-summary.html b/javadoc/org/netlib/utils/package-summary.html
new file mode 100644
index 0000000..4420d3e
--- /dev/null
+++ b/javadoc/org/netlib/utils/package-summary.html
@@ -0,0 +1,177 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.utils
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.utils";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/lapack/package-summary.html"><B>PREV PACKAGE</B></A>
+ NEXT PACKAGE</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<H2>
+Package org.netlib.utils
+</H2>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Class Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="15%"><B><A HREF="../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils">JNIMethods</A></B></TD>
+<TD>Static helper methods for dealing with the Java Native Interface and detection of
+ operating systems and architectures.</TD>
+</TR>
+</TABLE>
+
+
+<P>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Enum Summary</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="15%"><B><A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils">JNIMethods.ARCHType</A></B></TD>
+<TD>Enumeration of common CPU architectures.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="15%"><B><A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils">JNIMethods.OSType</A></B></TD>
+<TD>Enumeration of common operating systems, independent of version or architecture.</TD>
+</TR>
+</TABLE>
+
+
+<P>
+<DL>
+</DL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Package</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-use.html"><FONT CLASS="NavBarFont1"><B>Use</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/lapack/package-summary.html"><B>PREV PACKAGE</B></A>
+ NEXT PACKAGE</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/package-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/package-tree.html b/javadoc/org/netlib/utils/package-tree.html
new file mode 100644
index 0000000..4ac18e1
--- /dev/null
+++ b/javadoc/org/netlib/utils/package-tree.html
@@ -0,0 +1,164 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+org.netlib.utils Class Hierarchy
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="org.netlib.utils Class Hierarchy";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/lapack/package-tree.html"><B>PREV</B></A>
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+Hierarchy For Package org.netlib.utils
+</H2>
+</CENTER>
+<DL>
+<DT><B>Package Hierarchies:</B><DD><A HREF="../../../overview-tree.html">All Packages</A></DL>
+<HR>
+<H2>
+Class Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">org.netlib.utils.<A HREF="../../../org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><B>JNIMethods</B></A></UL>
+</UL>
+<H2>
+Enum Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">java.lang.Enum<E> (implements java.lang.Comparable<T>, java.io.Serializable)
+<UL>
+<LI TYPE="circle">org.netlib.utils.<A HREF="../../../org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><B>JNIMethods.OSType</B></A><LI TYPE="circle">org.netlib.utils.<A HREF="../../../org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>JNIMethods.ARCHType</B></A></UL>
+</UL>
+</UL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../org/netlib/lapack/package-tree.html"><B>PREV</B></A>
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/package-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/org/netlib/utils/package-use.html b/javadoc/org/netlib/utils/package-use.html
new file mode 100644
index 0000000..288e613
--- /dev/null
+++ b/javadoc/org/netlib/utils/package-use.html
@@ -0,0 +1,177 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Uses of Package org.netlib.utils
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="../../../stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Uses of Package org.netlib.utils";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+<B>Uses of Package<br>org.netlib.utils</B></H2>
+</CENTER>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Packages that use <A HREF="../../../org/netlib/utils/package-summary.html">org.netlib.utils</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><A HREF="#org.netlib.utils"><B>org.netlib.utils</B></A></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+<A NAME="org.netlib.utils"><!-- --></A>
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+Classes in <A HREF="../../../org/netlib/utils/package-summary.html">org.netlib.utils</A> used by <A HREF="../../../org/netlib/utils/package-summary.html">org.netlib.utils</A></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><B><A HREF="../../../org/netlib/utils/class-use/JNIMethods.ARCHType.html#org.netlib.utils"><B>JNIMethods.ARCHType</B></A></B>
+
+<BR>
+ Enumeration of common CPU architectures.</TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD><B><A HREF="../../../org/netlib/utils/class-use/JNIMethods.OSType.html#org.netlib.utils"><B>JNIMethods.OSType</B></A></B>
+
+<BR>
+ Enumeration of common operating systems, independent of version or architecture.</TD>
+</TR>
+</TABLE>
+
+<P>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-summary.html"><FONT CLASS="NavBarFont1"><B>Package</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Use</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="package-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="../../../help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="../../../index.html?org/netlib/utils/package-use.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="package-use.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="../../../allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/overview-frame.html b/javadoc/overview-frame.html
new file mode 100644
index 0000000..0428900
--- /dev/null
+++ b/javadoc/overview-frame.html
@@ -0,0 +1,49 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:21 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Overview List
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+
+</HEAD>
+
+<BODY BGCOLOR="white">
+
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TH ALIGN="left" NOWRAP><FONT size="+1" CLASS="FrameTitleFont">
+<B></B></FONT></TH>
+</TR>
+</TABLE>
+
+<TABLE BORDER="0" WIDTH="100%" SUMMARY="">
+<TR>
+<TD NOWRAP><FONT CLASS="FrameItemFont"><A HREF="allclasses-frame.html" target="packageFrame">All Classes</A></FONT>
+<P>
+<FONT size="+1" CLASS="FrameHeadingFont">
+Packages</FONT>
+<BR>
+<FONT CLASS="FrameItemFont"><A HREF="org/netlib/arpack/package-frame.html" target="packageFrame">org.netlib.arpack</A></FONT>
+<BR>
+<FONT CLASS="FrameItemFont"><A HREF="org/netlib/blas/package-frame.html" target="packageFrame">org.netlib.blas</A></FONT>
+<BR>
+<FONT CLASS="FrameItemFont"><A HREF="org/netlib/lapack/package-frame.html" target="packageFrame">org.netlib.lapack</A></FONT>
+<BR>
+<FONT CLASS="FrameItemFont"><A HREF="org/netlib/utils/package-frame.html" target="packageFrame">org.netlib.utils</A></FONT>
+<BR>
+</TD>
+</TR>
+</TABLE>
+
+<P>
+
+</BODY>
+</HTML>
diff --git a/javadoc/overview-summary.html b/javadoc/overview-summary.html
new file mode 100644
index 0000000..9091cae
--- /dev/null
+++ b/javadoc/overview-summary.html
@@ -0,0 +1,164 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Overview
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Overview";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Overview</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?overview-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="overview-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+
+<TABLE BORDER="1" WIDTH="100%" CELLPADDING="3" CELLSPACING="0" SUMMARY="">
+<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
+<TH ALIGN="left" COLSPAN="2"><FONT SIZE="+2">
+<B>Packages</B></FONT></TH>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="20%"><B><A HREF="org/netlib/arpack/package-summary.html">org.netlib.arpack</A></B></TD>
+<TD> </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="20%"><B><A HREF="org/netlib/blas/package-summary.html">org.netlib.blas</A></B></TD>
+<TD> </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="20%"><B><A HREF="org/netlib/lapack/package-summary.html">org.netlib.lapack</A></B></TD>
+<TD> </TD>
+</TR>
+<TR BGCOLOR="white" CLASS="TableRowColor">
+<TD WIDTH="20%"><B><A HREF="org/netlib/utils/package-summary.html">org.netlib.utils</A></B></TD>
+<TD> </TD>
+</TR>
+</TABLE>
+
+<P>
+ <HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Overview</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?overview-summary.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="overview-summary.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/overview-tree.html b/javadoc/overview-tree.html
new file mode 100644
index 0000000..7bcf3df
--- /dev/null
+++ b/javadoc/overview-tree.html
@@ -0,0 +1,163 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<!--NewPage-->
+<HTML>
+<HEAD>
+<!-- Generated by javadoc (build 1.6.0_24) on Fri Apr 22 23:31:22 BST 2011 -->
+<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<TITLE>
+Class Hierarchy
+</TITLE>
+
+<META NAME="date" CONTENT="2011-04-22">
+
+<LINK REL ="stylesheet" TYPE="text/css" HREF="stylesheet.css" TITLE="Style">
+
+<SCRIPT type="text/javascript">
+function windowTitle()
+{
+ if (location.href.indexOf('is-external=true') == -1) {
+ parent.document.title="Class Hierarchy";
+ }
+}
+</SCRIPT>
+<NOSCRIPT>
+</NOSCRIPT>
+
+</HEAD>
+
+<BODY BGCOLOR="white" onload="windowTitle();">
+<HR>
+
+
+<!-- ========= START OF TOP NAVBAR ======= -->
+<A NAME="navbar_top"><!-- --></A>
+<A HREF="#skip-navbar_top" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_top_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?overview-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="overview-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_top"></A>
+<!-- ========= END OF TOP NAVBAR ========= -->
+
+<HR>
+<CENTER>
+<H2>
+Hierarchy For All Packages</H2>
+</CENTER>
+<DL>
+<DT><B>Package Hierarchies:</B><DD><A HREF="org/netlib/arpack/package-tree.html">org.netlib.arpack</A>, <A HREF="org/netlib/blas/package-tree.html">org.netlib.blas</A>, <A HREF="org/netlib/lapack/package-tree.html">org.netlib.lapack</A>, <A HREF="org/netlib/utils/package-tree.html">org.netlib.utils</A></DL>
+<HR>
+<H2>
+Class Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">org.netlib.arpack.<A HREF="org/netlib/arpack/ARPACK.html" title="class in org.netlib.arpack"><B>ARPACK</B></A><LI TYPE="circle">org.netlib.blas.<A HREF="org/netlib/blas/BLAS.html" title="class in org.netlib.blas"><B>BLAS</B></A><LI TYPE="circle">org.netlib.utils.<A HREF="org/netlib/utils/JNIMethods.html" title="class in org.netlib.utils"><B>JNIMethods</B></A><LI TYPE="circle">org.netlib.lapack.<A HREF="org/netlib/lapack/LAPACK.html" title="class in org.netlib.lapack"><B [...]
+</UL>
+<H2>
+Enum Hierarchy
+</H2>
+<UL>
+<LI TYPE="circle">java.lang.Object<UL>
+<LI TYPE="circle">java.lang.Enum<E> (implements java.lang.Comparable<T>, java.io.Serializable)
+<UL>
+<LI TYPE="circle">org.netlib.utils.<A HREF="org/netlib/utils/JNIMethods.ARCHType.html" title="enum in org.netlib.utils"><B>JNIMethods.ARCHType</B></A><LI TYPE="circle">org.netlib.utils.<A HREF="org/netlib/utils/JNIMethods.OSType.html" title="enum in org.netlib.utils"><B>JNIMethods.OSType</B></A></UL>
+</UL>
+</UL>
+<HR>
+
+
+<!-- ======= START OF BOTTOM NAVBAR ====== -->
+<A NAME="navbar_bottom"><!-- --></A>
+<A HREF="#skip-navbar_bottom" title="Skip navigation links"></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0" SUMMARY="">
+<TR>
+<TD COLSPAN=2 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+<A NAME="navbar_bottom_firstrow"><!-- --></A>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3" SUMMARY="">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-summary.html"><FONT CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Package</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Class</FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT CLASS="NavBarFont1">Use</FONT> </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="index-files/index-1.html"><FONT CLASS="NavBarFont1"><B>Index</B></FONT></A> </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="help-doc.html"><FONT CLASS="NavBarFont1"><B>Help</B></FONT></A> </TD>
+ </TR>
+</TABLE>
+</TD>
+<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
+</EM>
+</TD>
+</TR>
+
+<TR>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ PREV
+ NEXT</FONT></TD>
+<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
+ <A HREF="index.html?overview-tree.html" target="_top"><B>FRAMES</B></A>
+ <A HREF="overview-tree.html" target="_top"><B>NO FRAMES</B></A>
+ <SCRIPT type="text/javascript">
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html"><B>All Classes</B></A>');
+ }
+ //-->
+</SCRIPT>
+<NOSCRIPT>
+ <A HREF="allclasses-noframe.html"><B>All Classes</B></A>
+</NOSCRIPT>
+
+
+</FONT></TD>
+</TR>
+</TABLE>
+<A NAME="skip-navbar_bottom"></A>
+<!-- ======== END OF BOTTOM NAVBAR ======= -->
+
+<HR>
+
+</BODY>
+</HTML>
diff --git a/javadoc/package-list b/javadoc/package-list
new file mode 100644
index 0000000..bb61dc0
--- /dev/null
+++ b/javadoc/package-list
@@ -0,0 +1,4 @@
+org.netlib.arpack
+org.netlib.blas
+org.netlib.lapack
+org.netlib.utils
diff --git a/javadoc/resources/inherit.gif b/javadoc/resources/inherit.gif
new file mode 100644
index 0000000..c814867
Binary files /dev/null and b/javadoc/resources/inherit.gif differ
diff --git a/javadoc/stylesheet.css b/javadoc/stylesheet.css
new file mode 100644
index 0000000..6ea9e51
--- /dev/null
+++ b/javadoc/stylesheet.css
@@ -0,0 +1,29 @@
+/* Javadoc style sheet */
+
+/* Define colors, fonts and other style attributes here to override the defaults */
+
+/* Page background color */
+body { background-color: #FFFFFF; color:#000000 }
+
+/* Headings */
+h1 { font-size: 145% }
+
+/* Table colors */
+.TableHeadingColor { background: #CCCCFF; color:#000000 } /* Dark mauve */
+.TableSubHeadingColor { background: #EEEEFF; color:#000000 } /* Light mauve */
+.TableRowColor { background: #FFFFFF; color:#000000 } /* White */
+
+/* Font used in left-hand frame lists */
+.FrameTitleFont { font-size: 100%; font-family: Helvetica, Arial, sans-serif; color:#000000 }
+.FrameHeadingFont { font-size: 90%; font-family: Helvetica, Arial, sans-serif; color:#000000 }
+.FrameItemFont { font-size: 90%; font-family: Helvetica, Arial, sans-serif; color:#000000 }
+
+/* Navigation bar fonts and colors */
+.NavBarCell1 { background-color:#EEEEFF; color:#000000} /* Light mauve */
+.NavBarCell1Rev { background-color:#00008B; color:#FFFFFF} /* Dark Blue */
+.NavBarFont1 { font-family: Arial, Helvetica, sans-serif; color:#000000;color:#000000;}
+.NavBarFont1Rev { font-family: Arial, Helvetica, sans-serif; color:#FFFFFF;color:#FFFFFF;}
+
+.NavBarCell2 { font-family: Arial, Helvetica, sans-serif; background-color:#FFFFFF; color:#000000}
+.NavBarCell3 { font-family: Arial, Helvetica, sans-serif; background-color:#FFFFFF; color:#000000}
+
diff --git a/jni/Makefile b/jni/Makefile
new file mode 100644
index 0000000..63e2997
--- /dev/null
+++ b/jni/Makefile
@@ -0,0 +1,44 @@
+include Makefile.incl
+
+all: jniblas jnilapack jniarpack
+
+jniblas: $(LIBPREPEND)jniblas$(LIBAPPEND)
+
+jnilapack: $(LIBPREPEND)jnilapack$(LIBAPPEND)
+
+jniarpack: $(LIBPREPEND)jniarpack$(LIBAPPEND)
+
+$(LIBPREPEND)jniblas$(LIBAPPEND): org_netlib_blas_NativeBLAS.h org_netlib_blas_NativeBLAS.o f2j_jni.o
+ $(LD) $(LDFLAGS) $(BLAS_LIBS) org_netlib_blas_NativeBLAS.o f2j_jni.o -o $@
+
+$(LIBPREPEND)jnilapack$(LIBAPPEND): org_netlib_lapack_NativeLAPACK.h org_netlib_lapack_NativeLAPACK.o f2j_jni.o
+ $(LD) $(LDFLAGS) $(BLAS_LIBS) $(LAPACK_LIBS) org_netlib_lapack_NativeLAPACK.o f2j_jni.o -o $@
+
+$(LIBPREPEND)jniarpack$(LIBAPPEND): org_netlib_arpack_NativeARPACK.h org_netlib_arpack_NativeARPACK.o f2j_jni.o arpack.a
+ $(LD) $(LDFLAGS) $(BLAS_LIBS) $(LAPACK_LIBS) $(FORTRAN_LIBS) org_netlib_arpack_NativeARPACK.o f2j_jni.o arpack.a -o $@
+
+arpack.a:
+ rm -f ARPACK/SRC/dnaupe.f 2>/dev/null
+ rm -f ARPACK/SRC/snaupe.f 2>/dev/null
+ cd ARPACK/UTIL/ ; $(FC) $(FFLAGS) -c *.f
+ cd ARPACK/SRC/ ; $(FC) $(FFLAGS) -c *.f
+ ar rc arpack.a ARPACK/UTIL/*.o ARPACK/SRC/*.o
+
+%.o: %.c %.h
+ $(CC) $(CPPFLAGS) $(LAPACK_INCLUDES) $(CFLAGS) -c $*.c
+
+org_netlib_blas_NativeBLAS.h:
+ javah -classpath $(JLAPACK_JNI_CP) -jni org.netlib.blas.NativeBLAS
+
+org_netlib_lapack_NativeLAPACK.h:
+ javah -classpath $(JLAPACK_JNI_CP) -jni org.netlib.lapack.NativeLAPACK
+
+org_netlib_arpack_NativeARPACK.h:
+ javah -classpath $(JLAPACK_JNI_CP) -jni org.netlib.arpack.NativeARPACK
+
+clean:
+ rm -f *.o ARPACK/UTIL/*.o ARPACK/SRC/*.o arpack.a org_*.h
+
+distclean: clean
+ rm -f *.dll *.so *.jnilib Makefile.incl
+ rm -rf ARPACK
diff --git a/jni/arpack.h b/jni/arpack.h
new file mode 100644
index 0000000..85c3e0f
--- /dev/null
+++ b/jni/arpack.h
@@ -0,0 +1,99 @@
+/*
+ This file has been extracted and edited from the ARPACK++ distribution
+ to define the Fortran routines for use in C.
+
+ ARPACK++ v1.0 8/1/1997
+ c++ interface to ARPACK code.
+
+ MODULE arpackf.h
+ ARPACK FORTRAN routines.
+
+ ARPACK Authors
+ Richard Lehoucq
+ Danny Sorensen
+ Chao Yang
+ Dept. of Computational & Applied Mathematics
+ Rice University
+ Houston, Texas
+*/
+
+// debug "common" statement.
+
+ struct {
+ integer logfil, ndigit, mgetv0;
+ integer msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd;
+ integer mnaupd, mnaup2, mnaitr, mneigt, mnapps, mngets, mneupd;
+ integer mcaupd, mcaup2, mcaitr, mceigt, mcapps, mcgets, mceupd;
+ } debug_;
+
+
+// double precision symmetric routines.
+
+ void dsaupd_(integer *ido, char *bmat, integer *n, char *which,
+ integer *nev, double *tol, double *resid,
+ integer *ncv, double *V, integer *ldv,
+ integer *iparam, integer *ipntr, double *workd,
+ double *workl, integer *lworkl, integer *info);
+
+ void dseupd_(logical *rvec, char *HowMny, logical *select,
+ double *d, double *Z, integer *ldz,
+ double *sigma, char *bmat, integer *n,
+ char *which, integer *nev, double *tol,
+ double *resid, integer *ncv, double *V,
+ integer *ldv, integer *iparam, integer *ipntr,
+ double *workd, double *workl,
+ integer *lworkl, integer *info);
+
+// double precision nonsymmetric routines.
+
+ void dnaupd_(integer *ido, char *bmat, integer *n, char *which,
+ integer *nev, double *tol, double *resid,
+ integer *ncv, double *V, integer *ldv,
+ integer *iparam, integer *ipntr, double *workd,
+ double *workl, integer *lworkl, integer *info);
+
+ void dneupd_(logical *rvec, char *HowMny, logical *select,
+ double *dr, double *di, double *Z,
+ integer *ldz, double *sigmar,
+ double *sigmai, double *workev,
+ char *bmat, integer *n, char *which,
+ integer *nev, double *tol, double *resid,
+ integer *ncv, double *V, integer *ldv,
+ integer *iparam, integer *ipntr,
+ double *workd, double *workl,
+ integer *lworkl, integer *info);
+
+// single precision symmetric routines.
+
+ void ssaupd_(integer *ido, char *bmat, integer *n, char *which,
+ integer *nev, float *tol, float *resid,
+ integer *ncv, float *V, integer *ldv,
+ integer *iparam, integer *ipntr, float *workd,
+ float *workl, integer *lworkl, integer *info);
+
+ void sseupd_(logical *rvec, char *HowMny, logical *select,
+ float *d, float *Z, integer *ldz,
+ float *sigma, char *bmat, integer *n,
+ char *which, integer *nev, float *tol,
+ float *resid, integer *ncv, float *V,
+ integer *ldv, integer *iparam, integer *ipntr,
+ float *workd, float *workl,
+ integer *lworkl, integer *info);
+
+// single precision nonsymmetric routines.
+
+ void snaupd_(integer *ido, char *bmat, integer *n, char *which,
+ integer *nev, float *tol, float *resid,
+ integer *ncv, float *V, integer *ldv,
+ integer *iparam, integer *ipntr, float *workd,
+ float *workl, integer *lworkl, integer *info);
+
+ void sneupd_(logical *rvec, char *HowMny, logical *select,
+ float *dr, float *di, float *Z,
+ integer *ldz, float *sigmar,
+ float *sigmai, float *workev, char *bmat,
+ integer *n, char *which, integer *nev,
+ float *tol, float *resid, integer *ncv,
+ float *V, integer *ldv, integer *iparam,
+ integer *ipntr, float *workd, float *workl,
+ integer *lworkl, integer *info);
diff --git a/jni/clapack.h b/jni/clapack.h
new file mode 100644
index 0000000..cad9a4c
--- /dev/null
+++ b/jni/clapack.h
@@ -0,0 +1,5079 @@
+#ifndef __CLAPACK_H
+#define __CLAPACK_H
+
+/* Subroutine */ int cbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, real *d__, real *e, complex *vt, integer *ldvt,
+ complex *u, integer *ldu, complex *c__, integer *ldc, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, complex *ab, integer *ldab, real *d__,
+ real *e, complex *q, integer *ldq, complex *pt, integer *ldpt,
+ complex *c__, integer *ldc, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, integer *ipiv, real *anorm, real *rcond,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real
+ *colcnd, real *amax, integer *info);
+
+/* Subroutine */ int cgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, complex *ab, integer *ldab, complex *afb, integer *
+ ldafb, integer *ipiv, complex *b, integer *ldb, complex *x, integer *
+ ldx, real *ferr, real *berr, complex *work, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, complex *ab, integer *ldab, integer *ipiv, complex *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int cgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, complex *ab, integer *ldab, complex *afb,
+ integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
+ complex *b, integer *ldb, complex *x, integer *ldx, real *rcond, real
+ *ferr, real *berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int cgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int cgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, complex *ab, integer *ldab, integer *ipiv, complex
+ *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *scale, integer *m, complex *v, integer *ldv,
+ integer *info);
+
+/* Subroutine */ int cgebal_(char *job, integer *n, complex *a, integer *lda,
+ integer *ilo, integer *ihi, real *scale, integer *info);
+
+/* Subroutine */ int cgebd2_(integer *m, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tauq, complex *taup, complex *work,
+ integer *info);
+
+/* Subroutine */ int cgebrd_(integer *m, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tauq, complex *taup, complex *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int cgecon_(char *norm, integer *n, complex *a, integer *lda,
+ real *anorm, real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgeequ_(integer *m, integer *n, complex *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax,
+ integer *info);
+
+/* Subroutine */ int cgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ complex *a, integer *lda, integer *sdim, complex *w, complex *vs,
+ integer *ldvs, complex *work, integer *lwork, real *rwork, logical *
+ bwork, integer *info);
+
+/* Subroutine */ int cgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, complex *a, integer *lda, integer *sdim, complex *
+ w, complex *vs, integer *ldvs, real *rconde, real *rcondv, complex *
+ work, integer *lwork, real *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int cgeev_(char *jobvl, char *jobvr, integer *n, complex *a,
+ integer *lda, complex *w, complex *vl, integer *ldvl, complex *vr,
+ integer *ldvr, complex *work, integer *lwork, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, complex *a, integer *lda, complex *w, complex *vl,
+ integer *ldvl, complex *vr, integer *ldvr, integer *ilo, integer *ihi,
+ real *scale, real *abnrm, real *rconde, real *rcondv, complex *work,
+ integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cgegs_(char *jobvsl, char *jobvsr, integer *n, complex *
+ a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *
+ beta, complex *vsl, integer *ldvsl, complex *vsr, integer *ldvsr,
+ complex *work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cgegv_(char *jobvl, char *jobvr, integer *n, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, complex *
+ work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cgehd2_(integer *n, integer *ilo, integer *ihi, complex *
+ a, integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex *
+ a, integer *lda, complex *tau, complex *work, integer *lwork, integer
+ *info);
+
+/* Subroutine */ int cgelq2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgelqf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgelsx_(integer *m, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgelsy_(integer *m, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, complex *work, integer *lwork, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgeql2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgeqlf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgeqp3_(integer *m, integer *n, complex *a, integer *lda,
+ integer *jpvt, complex *tau, complex *work, integer *lwork, real *
+ rwork, integer *info);
+
+/* Subroutine */ int cgeqpf_(integer *m, integer *n, complex *a, integer *lda,
+ integer *jpvt, complex *tau, complex *work, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgeqr2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgeqrf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgerfs_(char *trans, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, integer *ipiv, complex *
+ b, integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgerq2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgerqf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgesc2_(integer *n, complex *a, integer *lda, complex *
+ rhs, integer *ipiv, integer *jpiv, real *scale);
+
+/* Subroutine */ int cgesv_(integer *n, integer *nrhs, complex *a, integer *
+ lda, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, char *equed, real *r__, real *c__, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgetc2_(integer *n, complex *a, integer *lda, integer *
+ ipiv, integer *jpiv, integer *info);
+
+/* Subroutine */ int cgetf2_(integer *m, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int cgetrf_(integer *m, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int cgetri_(integer *n, complex *a, integer *lda, integer *
+ ipiv, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgetrs_(char *trans, integer *n, integer *nrhs, complex *
+ a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int cggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *lscale, real *rscale, integer *m, complex *v,
+ integer *ldv, integer *info);
+
+/* Subroutine */ int cggbal_(char *job, integer *n, complex *a, integer *lda,
+ complex *b, integer *ldb, integer *ilo, integer *ihi, real *lscale,
+ real *rscale, real *work, integer *info);
+
+/* Subroutine */ int cgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, integer *n, complex *a, integer *lda, complex *b, integer *
+ ldb, integer *sdim, complex *alpha, complex *beta, complex *vsl,
+ integer *ldvsl, complex *vsr, integer *ldvsr, complex *work, integer *
+ lwork, real *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int cggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, char *sense, integer *n, complex *a, integer *lda, complex *b,
+ integer *ldb, integer *sdim, complex *alpha, complex *beta, complex *
+ vsl, integer *ldvsl, complex *vsr, integer *ldvsr, real *rconde, real
+ *rcondv, complex *work, integer *lwork, real *rwork, integer *iwork,
+ integer *liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int cggev_(char *jobvl, char *jobvr, integer *n, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, complex *
+ work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *alpha, complex *beta, complex *vl, integer *ldvl, complex *
+ vr, integer *ldvr, integer *ilo, integer *ihi, real *lscale, real *
+ rscale, real *abnrm, real *bbnrm, real *rconde, real *rcondv, complex
+ *work, integer *lwork, real *rwork, integer *iwork, logical *bwork,
+ integer *info);
+
+/* Subroutine */ int cggglm_(integer *n, integer *m, integer *p, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *d__, complex *x,
+ complex *y, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *q, integer *ldq, complex *z__, integer *ldz, integer *info);
+
+/* Subroutine */ int cgglse_(integer *m, integer *n, integer *p, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *c__, complex *d__,
+ complex *x, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cggqrf_(integer *n, integer *m, integer *p, complex *a,
+ integer *lda, complex *taua, complex *b, integer *ldb, complex *taub,
+ complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cggrqf_(integer *m, integer *p, integer *n, complex *a,
+ integer *lda, complex *taua, complex *b, integer *ldb, complex *taub,
+ complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, complex *a, integer *
+ lda, complex *b, integer *ldb, real *alpha, real *beta, complex *u,
+ integer *ldu, complex *v, integer *ldv, complex *q, integer *ldq,
+ complex *work, real *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int cggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, complex *a, integer *lda, complex *b, integer
+ *ldb, real *tola, real *tolb, integer *k, integer *l, complex *u,
+ integer *ldu, complex *v, integer *ldv, complex *q, integer *ldq,
+ integer *iwork, real *rwork, complex *tau, complex *work, integer *
+ info);
+
+/* Subroutine */ int cgtcon_(char *norm, integer *n, complex *dl, complex *
+ d__, complex *du, complex *du2, integer *ipiv, real *anorm, real *
+ rcond, complex *work, integer *info);
+
+/* Subroutine */ int cgtrfs_(char *trans, integer *n, integer *nrhs, complex *
+ dl, complex *d__, complex *du, complex *dlf, complex *df, complex *
+ duf, complex *du2, integer *ipiv, complex *b, integer *ldb, complex *
+ x, integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cgtsv_(integer *n, integer *nrhs, complex *dl, complex *
+ d__, complex *du, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, complex *dl, complex *d__, complex *du, complex *dlf, complex *
+ df, complex *duf, complex *du2, integer *ipiv, complex *b, integer *
+ ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgttrf_(integer *n, complex *dl, complex *d__, complex *
+ du, complex *du2, integer *ipiv, integer *info);
+
+/* Subroutine */ int cgttrs_(char *trans, integer *n, integer *nrhs, complex *
+ dl, complex *d__, complex *du, complex *du2, integer *ipiv, complex *
+ b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgtts2_(integer *itrans, integer *n, integer *nrhs,
+ complex *dl, complex *d__, complex *du, complex *du2, integer *ipiv,
+ complex *b, integer *ldb);
+
+/* Subroutine */ int chbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ complex *ab, integer *ldab, real *w, complex *z__, integer *ldz,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ complex *ab, integer *ldab, real *w, complex *z__, integer *ldz,
+ complex *work, integer *lwork, real *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int chbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, complex *ab, integer *ldab, complex *q, integer *ldq,
+ real *vl, real *vu, integer *il, integer *iu, real *abstol, integer *
+ m, real *w, complex *z__, integer *ldz, complex *work, real *rwork,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int chbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, complex *ab, integer *ldab, complex *bb, integer *ldbb,
+ complex *x, integer *ldx, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, complex *ab, integer *ldab, complex *bb, integer *ldbb,
+ real *w, complex *z__, integer *ldz, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, complex *ab, integer *ldab, complex *bb,
+ integer *ldbb, complex *q, integer *ldq, real *vl, real *vu, integer *
+ il, integer *iu, real *abstol, integer *m, real *w, complex *z__,
+ integer *ldz, complex *work, real *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int chbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ complex *ab, integer *ldab, real *d__, real *e, complex *q, integer *
+ ldq, complex *work, integer *info);
+
+/* Subroutine */ int checon_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, real *anorm, real *rcond, complex *work, integer *
+ info);
+
+/* Subroutine */ int cheev_(char *jobz, char *uplo, integer *n, complex *a,
+ integer *lda, real *w, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cheevd_(char *jobz, char *uplo, integer *n, complex *a,
+ integer *lda, real *w, complex *work, integer *lwork, real *rwork,
+ integer *lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int cheevr_(char *jobz, char *range, char *uplo, integer *n,
+ complex *a, integer *lda, real *vl, real *vu, integer *il, integer *
+ iu, real *abstol, integer *m, real *w, complex *z__, integer *ldz,
+ integer *isuppz, complex *work, integer *lwork, real *rwork, integer *
+ lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int cheevx_(char *jobz, char *range, char *uplo, integer *n,
+ complex *a, integer *lda, real *vl, real *vu, integer *il, integer *
+ iu, real *abstol, integer *m, real *w, complex *z__, integer *ldz,
+ complex *work, integer *lwork, real *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int chegs2_(integer *itype, char *uplo, integer *n, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chegst_(integer *itype, char *uplo, integer *n, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chegv_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, real *w,
+ complex *work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int chegvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, real *w,
+ complex *work, integer *lwork, real *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int chegvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ real *vl, real *vu, integer *il, integer *iu, real *abstol, integer *
+ m, real *w, complex *z__, integer *ldz, complex *work, integer *lwork,
+ real *rwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int cherfs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, integer *ipiv, complex *
+ b, integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chesv_(char *uplo, integer *n, integer *nrhs, complex *a,
+ integer *lda, integer *ipiv, complex *b, integer *ldb, complex *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int chesvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, complex *b, integer *ldb, complex *x, integer *ldx, real *rcond,
+ real *ferr, real *berr, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chetf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int chetrd_(char *uplo, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tau, complex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int chetrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int chetri_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *info);
+
+/* Subroutine */ int chetrs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int chgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, complex *a, integer *lda, complex *b,
+ integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq,
+ complex *z__, integer *ldz, complex *work, integer *lwork, real *
+ rwork, integer *info);
+
+/* Subroutine */ int chpcon_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, real *anorm, real *rcond, complex *work, integer *info);
+
+/* Subroutine */ int chpev_(char *jobz, char *uplo, integer *n, complex *ap,
+ real *w, complex *z__, integer *ldz, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chpevd_(char *jobz, char *uplo, integer *n, complex *ap,
+ real *w, complex *z__, integer *ldz, complex *work, integer *lwork,
+ real *rwork, integer *lrwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int chpevx_(char *jobz, char *range, char *uplo, integer *n,
+ complex *ap, real *vl, real *vu, integer *il, integer *iu, real *
+ abstol, integer *m, real *w, complex *z__, integer *ldz, complex *
+ work, real *rwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int chpgst_(integer *itype, char *uplo, integer *n, complex *
+ ap, complex *bp, integer *info);
+
+/* Subroutine */ int chpgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *ap, complex *bp, real *w, complex *z__, integer *ldz,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chpgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *ap, complex *bp, real *w, complex *z__, integer *ldz,
+ complex *work, integer *lwork, real *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int chpgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, complex *ap, complex *bp, real *vl, real *vu,
+ integer *il, integer *iu, real *abstol, integer *m, real *w, complex *
+ z__, integer *ldz, complex *work, real *rwork, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int chprfs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *afp, integer *ipiv, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chpsv_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chpsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *ap, complex *afp, integer *ipiv, complex *b, integer *
+ ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chptrd_(char *uplo, integer *n, complex *ap, real *d__,
+ real *e, complex *tau, integer *info);
+
+/* Subroutine */ int chptrf_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, integer *info);
+
+/* Subroutine */ int chptri_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, complex *work, integer *info);
+
+/* Subroutine */ int chptrs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, complex *h__, integer *ldh, complex *w, complex *
+ vl, integer *ldvl, complex *vr, integer *ldvr, integer *mm, integer *
+ m, complex *work, real *rwork, integer *ifaill, integer *ifailr,
+ integer *info);
+
+/* Subroutine */ int chseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, complex *h__, integer *ldh, complex *w, complex *z__,
+ integer *ldz, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int clabrd_(integer *m, integer *n, integer *nb, complex *a,
+ integer *lda, real *d__, real *e, complex *tauq, complex *taup,
+ complex *x, integer *ldx, complex *y, integer *ldy);
+
+/* Subroutine */ int clacgv_(integer *n, complex *x, integer *incx);
+
+/* Subroutine */ int clacon_(integer *n, complex *v, complex *x, real *est,
+ integer *kase);
+
+/* Subroutine */ int clacp2_(char *uplo, integer *m, integer *n, real *a,
+ integer *lda, complex *b, integer *ldb);
+
+/* Subroutine */ int clacpy_(char *uplo, integer *m, integer *n, complex *a,
+ integer *lda, complex *b, integer *ldb);
+
+/* Subroutine */ int clacrm_(integer *m, integer *n, complex *a, integer *lda,
+ real *b, integer *ldb, complex *c__, integer *ldc, real *rwork);
+
+/* Subroutine */ int clacrt_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy, complex *c__, complex *s);
+
+/* Subroutine */ int claed0_(integer *qsiz, integer *n, real *d__, real *e,
+ complex *q, integer *ldq, complex *qstore, integer *ldqs, real *rwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int claed7_(integer *n, integer *cutpnt, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, real *d__, complex *
+ q, integer *ldq, real *rho, integer *indxq, real *qstore, integer *
+ qptr, integer *prmptr, integer *perm, integer *givptr, integer *
+ givcol, real *givnum, complex *work, real *rwork, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int claed8_(integer *k, integer *n, integer *qsiz, complex *
+ q, integer *ldq, real *d__, real *rho, integer *cutpnt, real *z__,
+ real *dlamda, complex *q2, integer *ldq2, real *w, integer *indxp,
+ integer *indx, integer *indxq, integer *perm, integer *givptr,
+ integer *givcol, real *givnum, integer *info);
+
+/* Subroutine */ int claein_(logical *rightv, logical *noinit, integer *n,
+ complex *h__, integer *ldh, complex *w, complex *v, complex *b,
+ integer *ldb, real *rwork, real *eps3, real *smlnum, integer *info);
+
+/* Subroutine */ int claesy_(complex *a, complex *b, complex *c__, complex *
+ rt1, complex *rt2, complex *evscal, complex *cs1, complex *sn1);
+
+/* Subroutine */ int claev2_(complex *a, complex *b, complex *c__, real *rt1,
+ real *rt2, real *cs1, complex *sn1);
+
+/* Subroutine */ int clags2_(logical *upper, real *a1, complex *a2, real *a3,
+ real *b1, complex *b2, real *b3, real *csu, complex *snu, real *csv,
+ complex *snv, real *csq, complex *snq);
+
+/* Subroutine */ int clagtm_(char *trans, integer *n, integer *nrhs, real *
+ alpha, complex *dl, complex *d__, complex *du, complex *x, integer *
+ ldx, real *beta, complex *b, integer *ldb);
+
+/* Subroutine */ int clahef_(char *uplo, integer *n, integer *nb, integer *kb,
+ complex *a, integer *lda, integer *ipiv, complex *w, integer *ldw,
+ integer *info);
+
+/* Subroutine */ int clahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w,
+ integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer *
+ info);
+
+/* Subroutine */ int clahrd_(integer *n, integer *k, integer *nb, complex *a,
+ integer *lda, complex *tau, complex *t, integer *ldt, complex *y,
+ integer *ldy);
+
+/* Subroutine */ int claic1_(integer *job, integer *j, complex *x, real *sest,
+ complex *w, complex *gamma, real *sestpr, complex *s, complex *c__);
+
+/* Subroutine */ int clals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, complex *b, integer *ldb, complex *bx,
+ integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
+ difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
+ rwork, integer *info);
+
+/* Subroutine */ int clalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, complex *b, integer *ldb, complex *bx, integer *ldbx,
+ real *u, integer *ldu, real *vt, integer *k, real *difl, real *difr,
+ real *z__, real *poles, integer *givptr, integer *givcol, integer *
+ ldgcol, integer *perm, real *givnum, real *c__, real *s, real *rwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int clapll_(integer *n, complex *x, integer *incx, complex *
+ y, integer *incy, real *ssmin);
+
+/* Subroutine */ int clapmt_(logical *forwrd, integer *m, integer *n, complex
+ *x, integer *ldx, integer *k);
+
+/* Subroutine */ int claqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real
+ *colcnd, real *amax, char *equed);
+
+/* Subroutine */ int claqge_(integer *m, integer *n, complex *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, char *
+ equed);
+
+/* Subroutine */ int claqhb_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqhe_(char *uplo, integer *n, complex *a, integer *lda,
+ real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqhp_(char *uplo, integer *n, complex *ap, real *s,
+ real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqp2_(integer *m, integer *n, integer *offset, complex
+ *a, integer *lda, integer *jpvt, complex *tau, real *vn1, real *vn2,
+ complex *work);
+
+/* Subroutine */ int claqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, complex *a, integer *lda, integer *jpvt, complex *
+ tau, real *vn1, real *vn2, complex *auxv, complex *f, integer *ldf);
+
+/* Subroutine */ int claqsb_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqsp_(char *uplo, integer *n, complex *ap, real *s,
+ real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqsy_(char *uplo, integer *n, complex *a, integer *lda,
+ real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int clar1v_(integer *n, integer *b1, integer *bn, real *
+ sigma, real *d__, real *l, real *ld, real *lld, real *gersch, complex
+ *z__, real *ztz, real *mingma, integer *r__, integer *isuppz, real *
+ work);
+
+/* Subroutine */ int clar2v_(integer *n, complex *x, complex *y, complex *z__,
+ integer *incx, real *c__, complex *s, integer *incc);
+
+/* Subroutine */ int clarcm_(integer *m, integer *n, real *a, integer *lda,
+ complex *b, integer *ldb, complex *c__, integer *ldc, real *rwork);
+
+/* Subroutine */ int clarf_(char *side, integer *m, integer *n, complex *v,
+ integer *incv, complex *tau, complex *c__, integer *ldc, complex *
+ work);
+
+/* Subroutine */ int clarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, complex *v, integer *ldv,
+ complex *t, integer *ldt, complex *c__, integer *ldc, complex *work,
+ integer *ldwork);
+
+/* Subroutine */ int clarfg_(integer *n, complex *alpha, complex *x, integer *
+ incx, complex *tau);
+
+/* Subroutine */ int clarft_(char *direct, char *storev, integer *n, integer *
+ k, complex *v, integer *ldv, complex *tau, complex *t, integer *ldt);
+
+/* Subroutine */ int clarfx_(char *side, integer *m, integer *n, complex *v,
+ complex *tau, complex *c__, integer *ldc, complex *work);
+
+/* Subroutine */ int clargv_(integer *n, complex *x, integer *incx, complex *
+ y, integer *incy, real *c__, integer *incc);
+
+/* Subroutine */ int clarnv_(integer *idist, integer *iseed, integer *n,
+ complex *x);
+
+/* Subroutine */ int clarrv_(integer *n, real *d__, real *l, integer *isplit,
+ integer *m, real *w, integer *iblock, real *gersch, real *tol,
+ complex *z__, integer *ldz, integer *isuppz, real *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int clartg_(complex *f, complex *g, real *cs, complex *sn,
+ complex *r__);
+
+/* Subroutine */ int clartv_(integer *n, complex *x, integer *incx, complex *
+ y, integer *incy, real *c__, complex *s, integer *incc);
+
+/* Subroutine */ int clarz_(char *side, integer *m, integer *n, integer *l,
+ complex *v, integer *incv, complex *tau, complex *c__, integer *ldc,
+ complex *work);
+
+/* Subroutine */ int clarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, complex *v,
+ integer *ldv, complex *t, integer *ldt, complex *c__, integer *ldc,
+ complex *work, integer *ldwork);
+
+/* Subroutine */ int clarzt_(char *direct, char *storev, integer *n, integer *
+ k, complex *v, integer *ldv, complex *tau, complex *t, integer *ldt);
+
+/* Subroutine */ int clascl_(char *type__, integer *kl, integer *ku, real *
+ cfrom, real *cto, integer *m, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int claset_(char *uplo, integer *m, integer *n, complex *
+ alpha, complex *beta, complex *a, integer *lda);
+
+/* Subroutine */ int clasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, real *c__, real *s, complex *a, integer *lda);
+
+/* Subroutine */ int classq_(integer *n, complex *x, integer *incx, real *
+ scale, real *sumsq);
+
+/* Subroutine */ int claswp_(integer *n, complex *a, integer *lda, integer *
+ k1, integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int clasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ complex *a, integer *lda, integer *ipiv, complex *w, integer *ldw,
+ integer *info);
+
+/* Subroutine */ int clatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, complex *ab, integer *ldab, complex *
+ x, real *scale, real *cnorm, integer *info);
+
+/* Subroutine */ int clatdf_(integer *ijob, integer *n, complex *z__, integer
+ *ldz, complex *rhs, real *rdsum, real *rdscal, integer *ipiv, integer
+ *jpiv);
+
+/* Subroutine */ int clatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, complex *ap, complex *x, real *scale, real *cnorm,
+ integer *info);
+
+/* Subroutine */ int clatrd_(char *uplo, integer *n, integer *nb, complex *a,
+ integer *lda, real *e, complex *tau, complex *w, integer *ldw);
+
+/* Subroutine */ int clatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, complex *a, integer *lda, complex *x, real *scale,
+ real *cnorm, integer *info);
+
+/* Subroutine */ int clatrz_(integer *m, integer *n, integer *l, complex *a,
+ integer *lda, complex *tau, complex *work);
+
+/* Subroutine */ int clatzm_(char *side, integer *m, integer *n, complex *v,
+ integer *incv, complex *tau, complex *c1, complex *c2, integer *ldc,
+ complex *work);
+
+/* Subroutine */ int clauu2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int clauum_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpbcon_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *anorm, real *rcond, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cpbequ_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *s, real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cpbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, complex *ab, integer *ldab, complex *afb, integer *ldafb,
+ complex *b, integer *ldb, complex *x, integer *ldx, real *ferr, real *
+ berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpbstf_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int cpbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, complex *ab, integer *ldab, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int cpbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, complex *ab, integer *ldab, complex *afb, integer *
+ ldafb, char *equed, real *s, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *rcond, real *ferr, real *berr, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int cpbtf2_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int cpbtrf_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int cpbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, complex *ab, integer *ldab, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int cpocon_(char *uplo, integer *n, complex *a, integer *lda,
+ real *anorm, real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpoequ_(integer *n, complex *a, integer *lda, real *s,
+ real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cporfs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *ferr, real *berr, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int cposv_(char *uplo, integer *n, integer *nrhs, complex *a,
+ integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, char *
+ equed, real *s, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *rcond, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cpotf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpotrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpotri_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpotrs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cppcon_(char *uplo, integer *n, complex *ap, real *anorm,
+ real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cppequ_(char *uplo, integer *n, complex *ap, real *s,
+ real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cpprfs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *afp, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *ferr, real *berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cppsv_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *ap, complex *afp, char *equed, real *s, complex *b,
+ integer *ldb, complex *x, integer *ldx, real *rcond, real *ferr, real
+ *berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpptrf_(char *uplo, integer *n, complex *ap, integer *
+ info);
+
+/* Subroutine */ int cpptri_(char *uplo, integer *n, complex *ap, integer *
+ info);
+
+/* Subroutine */ int cpptrs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cptcon_(integer *n, real *d__, complex *e, real *anorm,
+ real *rcond, real *rwork, integer *info);
+
+/* Subroutine */ int cptrfs_(char *uplo, integer *n, integer *nrhs, real *d__,
+ complex *e, real *df, complex *ef, complex *b, integer *ldb, complex
+ *x, integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cptsv_(integer *n, integer *nrhs, real *d__, complex *e,
+ complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cptsvx_(char *fact, integer *n, integer *nrhs, real *d__,
+ complex *e, real *df, complex *ef, complex *b, integer *ldb, complex
+ *x, integer *ldx, real *rcond, real *ferr, real *berr, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int cpttrf_(integer *n, real *d__, complex *e, integer *info);
+
+/* Subroutine */ int cpttrs_(char *uplo, integer *n, integer *nrhs, real *d__,
+ complex *e, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cptts2_(integer *iuplo, integer *n, integer *nrhs, real *
+ d__, complex *e, complex *b, integer *ldb);
+
+/* Subroutine */ int crot_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy, real *c__, complex *s);
+
+/* Subroutine */ int cspcon_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, real *anorm, real *rcond, complex *work, integer *info);
+
+/* Subroutine */ int cspmv_(char *uplo, integer *n, complex *alpha, complex *
+ ap, complex *x, integer *incx, complex *beta, complex *y, integer *
+ incy);
+
+/* Subroutine */ int cspr_(char *uplo, integer *n, complex *alpha, complex *x,
+ integer *incx, complex *ap);
+
+/* Subroutine */ int csprfs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *afp, integer *ipiv, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cspsv_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *ap, complex *afp, integer *ipiv, complex *b, integer *
+ ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int csptrf_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, integer *info);
+
+/* Subroutine */ int csptri_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, complex *work, integer *info);
+
+/* Subroutine */ int csptrs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int csrot_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy, real *c__, real *s);
+
+/* Subroutine */ int csrscl_(integer *n, real *sa, complex *sx, integer *incx);
+
+/* Subroutine */ int cstedc_(char *compz, integer *n, real *d__, real *e,
+ complex *z__, integer *ldz, complex *work, integer *lwork, real *
+ rwork, integer *lrwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int cstein_(integer *n, real *d__, real *e, integer *m, real
+ *w, integer *iblock, integer *isplit, complex *z__, integer *ldz,
+ real *work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int csteqr_(char *compz, integer *n, real *d__, real *e,
+ complex *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int csycon_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, real *anorm, real *rcond, complex *work, integer *
+ info);
+
+/* Subroutine */ int csymv_(char *uplo, integer *n, complex *alpha, complex *
+ a, integer *lda, complex *x, integer *incx, complex *beta, complex *y,
+ integer *incy);
+
+/* Subroutine */ int csyr_(char *uplo, integer *n, complex *alpha, complex *x,
+ integer *incx, complex *a, integer *lda);
+
+/* Subroutine */ int csyrfs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, integer *ipiv, complex *
+ b, integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int csysv_(char *uplo, integer *n, integer *nrhs, complex *a,
+ integer *lda, integer *ipiv, complex *b, integer *ldb, complex *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int csysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, complex *b, integer *ldb, complex *x, integer *ldx, real *rcond,
+ real *ferr, real *berr, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int csytf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int csytrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int csytri_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *info);
+
+/* Subroutine */ int csytrs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int ctbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, complex *ab, integer *ldab, real *rcond, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int ctbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, complex *ab, integer *ldab, complex *b,
+ integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int ctbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, complex *ab, integer *ldab, complex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int ctgevc_(char *side, char *howmny, logical *select,
+ integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, integer *mm,
+ integer *m, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int ctgex2_(logical *wantq, logical *wantz, integer *n,
+ complex *a, integer *lda, complex *b, integer *ldb, complex *q,
+ integer *ldq, complex *z__, integer *ldz, integer *j1, integer *info);
+
+/* Subroutine */ int ctgexc_(logical *wantq, logical *wantz, integer *n,
+ complex *a, integer *lda, complex *b, integer *ldb, complex *q,
+ integer *ldq, complex *z__, integer *ldz, integer *ifst, integer *
+ ilst, integer *info);
+
+/* Subroutine */ int ctgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, complex *a, integer *lda, complex *b,
+ integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq,
+ complex *z__, integer *ldz, integer *m, real *pl, real *pr, real *
+ dif, complex *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int ctgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, complex *a, integer *
+ lda, complex *b, integer *ldb, real *tola, real *tolb, real *alpha,
+ real *beta, complex *u, integer *ldu, complex *v, integer *ldv,
+ complex *q, integer *ldq, complex *work, integer *ncycle, integer *
+ info);
+
+/* Subroutine */ int ctgsna_(char *job, char *howmny, logical *select,
+ integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, real *s, real
+ *dif, integer *mm, integer *m, complex *work, integer *lwork, integer
+ *iwork, integer *info);
+
+/* Subroutine */ int ctgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, complex *c__,
+ integer *ldc, complex *d__, integer *ldd, complex *e, integer *lde,
+ complex *f, integer *ldf, real *scale, real *rdsum, real *rdscal,
+ integer *info);
+
+/* Subroutine */ int ctgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, complex *c__,
+ integer *ldc, complex *d__, integer *ldd, complex *e, integer *lde,
+ complex *f, integer *ldf, real *scale, real *dif, complex *work,
+ integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int ctpcon_(char *norm, char *uplo, char *diag, integer *n,
+ complex *ap, real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int ctprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *ap, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int ctptri_(char *uplo, char *diag, integer *n, complex *ap,
+ integer *info);
+
+/* Subroutine */ int ctptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *ap, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ctrcon_(char *norm, char *uplo, char *diag, integer *n,
+ complex *a, integer *lda, real *rcond, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int ctrevc_(char *side, char *howmny, logical *select,
+ integer *n, complex *t, integer *ldt, complex *vl, integer *ldvl,
+ complex *vr, integer *ldvr, integer *mm, integer *m, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int ctrexc_(char *compq, integer *n, complex *t, integer *
+ ldt, complex *q, integer *ldq, integer *ifst, integer *ilst, integer *
+ info);
+
+/* Subroutine */ int ctrrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *ferr, real *berr, complex *work, real
+ *rwork, integer *info);
+
+/* Subroutine */ int ctrsen_(char *job, char *compq, logical *select, integer
+ *n, complex *t, integer *ldt, complex *q, integer *ldq, complex *w,
+ integer *m, real *s, real *sep, complex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int ctrsna_(char *job, char *howmny, logical *select,
+ integer *n, complex *t, integer *ldt, complex *vl, integer *ldvl,
+ complex *vr, integer *ldvr, real *s, real *sep, integer *mm, integer *
+ m, complex *work, integer *ldwork, real *rwork, integer *info);
+
+/* Subroutine */ int ctrsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *c__, integer *ldc, real *scale, integer *info);
+
+/* Subroutine */ int ctrti2_(char *uplo, char *diag, integer *n, complex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int ctrtri_(char *uplo, char *diag, integer *n, complex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int ctrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *a, integer *lda, complex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int ctzrqf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, integer *info);
+
+/* Subroutine */ int ctzrzf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cung2l_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cung2r_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cungbr_(char *vect, integer *m, integer *n, integer *k,
+ complex *a, integer *lda, complex *tau, complex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int cunghr_(integer *n, integer *ilo, integer *ihi, complex *
+ a, integer *lda, complex *tau, complex *work, integer *lwork, integer
+ *info);
+
+/* Subroutine */ int cungl2_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cunglq_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungql_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungqr_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungr2_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cungrq_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungtr_(char *uplo, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cunmhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cunml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cunmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cupgtr_(char *uplo, integer *n, complex *ap, complex *
+ tau, complex *q, integer *ldq, complex *work, integer *info);
+
+/* Subroutine */ int cupmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, complex *ap, complex *tau, complex *c__, integer *ldc,
+ complex *work, integer *info);
+
+/* Subroutine */ int dbdsdc_(char *uplo, char *compq, integer *n, doublereal *
+ d__, doublereal *e, doublereal *u, integer *ldu, doublereal *vt,
+ integer *ldvt, doublereal *q, integer *iq, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, doublereal *d__, doublereal *e, doublereal *vt,
+ integer *ldvt, doublereal *u, integer *ldu, doublereal *c__, integer *
+ ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int ddisna_(char *job, integer *m, integer *n, doublereal *
+ d__, doublereal *sep, integer *info);
+
+/* Subroutine */ int dgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, doublereal *ab, integer *ldab, doublereal *
+ d__, doublereal *e, doublereal *q, integer *ldq, doublereal *pt,
+ integer *ldpt, doublereal *c__, integer *ldc, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, integer *ipiv, doublereal *anorm,
+ doublereal *rcond, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, integer *
+ info);
+
+/* Subroutine */ int dgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublereal *ab, integer *ldab, doublereal *afb,
+ integer *ldafb, integer *ipiv, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, doublereal *ab, integer *ldab, integer *ipiv, doublereal *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int dgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, doublereal *ab, integer *ldab,
+ doublereal *afb, integer *ldafb, integer *ipiv, char *equed,
+ doublereal *r__, doublereal *c__, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublereal *ab, integer *ldab, integer *ipiv,
+ doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *scale, integer *m, doublereal *v, integer *
+ ldv, integer *info);
+
+/* Subroutine */ int dgebal_(char *job, integer *n, doublereal *a, integer *
+ lda, integer *ilo, integer *ihi, doublereal *scale, integer *info);
+
+/* Subroutine */ int dgebd2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *
+ taup, doublereal *work, integer *info);
+
+/* Subroutine */ int dgebrd_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *
+ taup, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgecon_(char *norm, integer *n, doublereal *a, integer *
+ lda, doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgeequ_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal
+ *colcnd, doublereal *amax, integer *info);
+
+/* Subroutine */ int dgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ doublereal *a, integer *lda, integer *sdim, doublereal *wr,
+ doublereal *wi, doublereal *vs, integer *ldvs, doublereal *work,
+ integer *lwork, logical *bwork, integer *info);
+
+/* Subroutine */ int dgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, doublereal *a, integer *lda, integer *sdim,
+ doublereal *wr, doublereal *wi, doublereal *vs, integer *ldvs,
+ doublereal *rconde, doublereal *rcondv, doublereal *work, integer *
+ lwork, integer *iwork, integer *liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal *
+ a, integer *lda, doublereal *wr, doublereal *wi, doublereal *vl,
+ integer *ldvl, doublereal *vr, integer *ldvr, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublereal *a, integer *lda, doublereal *wr,
+ doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr,
+ integer *ldvr, integer *ilo, integer *ihi, doublereal *scale,
+ doublereal *abnrm, doublereal *rconde, doublereal *rcondv, doublereal
+ *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int dgegs_(char *jobvsl, char *jobvsr, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ alphar, doublereal *alphai, doublereal *beta, doublereal *vsl,
+ integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dgegv_(char *jobvl, char *jobvr, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *alphar,
+ doublereal *alphai, doublereal *beta, doublereal *vl, integer *ldvl,
+ doublereal *vr, integer *ldvr, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgehd2_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dgehrd_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dgelq2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgelqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgelsd_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dgelss_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgelsx_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ jpvt, doublereal *rcond, integer *rank, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dgelsy_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ jpvt, doublereal *rcond, integer *rank, doublereal *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int dgeql2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgeqlf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgeqp3_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *jpvt, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgeqpf_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *jpvt, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgeqr2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgeqrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgerfs_(char *trans, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *af, integer *ldaf, integer *
+ ipiv, doublereal *b, integer *ldb, doublereal *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dgerq2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgerqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgesc2_(integer *n, doublereal *a, integer *lda,
+ doublereal *rhs, integer *ipiv, integer *jpiv, doublereal *scale);
+
+/* Subroutine */ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *
+ a, integer *lda, doublereal *s, doublereal *u, integer *ldu,
+ doublereal *vt, integer *ldvt, doublereal *work, integer *lwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer
+ *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
+ doublereal *a, integer *lda, doublereal *s, doublereal *u, integer *
+ ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, char *equed, doublereal *r__, doublereal *c__,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgetc2_(integer *n, doublereal *a, integer *lda, integer
+ *ipiv, integer *jpiv, integer *info);
+
+/* Subroutine */ int dgetf2_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgetrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgetri_(integer *n, doublereal *a, integer *lda, integer
+ *ipiv, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgetrs_(char *trans, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int dggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *lscale, doublereal *rscale, integer *m,
+ doublereal *v, integer *ldv, integer *info);
+
+/* Subroutine */ int dggbal_(char *job, integer *n, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb, integer *ilo, integer *ihi,
+ doublereal *lscale, doublereal *rscale, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ delctg, integer *n, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai,
+ doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr,
+ integer *ldvsr, doublereal *work, integer *lwork, logical *bwork,
+ integer *info);
+
+/* Subroutine */ int dggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ delctg, char *sense, integer *n, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, integer *sdim, doublereal *alphar,
+ doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl,
+ doublereal *vsr, integer *ldvsr, doublereal *rconde, doublereal *
+ rcondv, doublereal *work, integer *lwork, integer *iwork, integer *
+ liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int dggev_(char *jobvl, char *jobvr, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *alphar,
+ doublereal *alphai, doublereal *beta, doublereal *vl, integer *ldvl,
+ doublereal *vr, integer *ldvr, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr,
+ integer *ilo, integer *ihi, doublereal *lscale, doublereal *rscale,
+ doublereal *abnrm, doublereal *bbnrm, doublereal *rconde, doublereal *
+ rcondv, doublereal *work, integer *lwork, integer *iwork, logical *
+ bwork, integer *info);
+
+/* Subroutine */ int dggglm_(integer *n, integer *m, integer *p, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *d__,
+ doublereal *x, doublereal *y, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *q, integer *ldq, doublereal *z__, integer *
+ ldz, integer *info);
+
+/* Subroutine */ int dgglse_(integer *m, integer *n, integer *p, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *c__,
+ doublereal *d__, doublereal *x, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dggqrf_(integer *n, integer *m, integer *p, doublereal *
+ a, integer *lda, doublereal *taua, doublereal *b, integer *ldb,
+ doublereal *taub, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dggrqf_(integer *m, integer *p, integer *n, doublereal *
+ a, integer *lda, doublereal *taua, doublereal *b, integer *ldb,
+ doublereal *taub, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, doublereal *a,
+ integer *lda, doublereal *b, integer *ldb, doublereal *alpha,
+ doublereal *beta, doublereal *u, integer *ldu, doublereal *v, integer
+ *ldv, doublereal *q, integer *ldq, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *tola, doublereal *tolb, integer *k, integer
+ *l, doublereal *u, integer *ldu, doublereal *v, integer *ldv,
+ doublereal *q, integer *ldq, integer *iwork, doublereal *tau,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dgtcon_(char *norm, integer *n, doublereal *dl,
+ doublereal *d__, doublereal *du, doublereal *du2, integer *ipiv,
+ doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgtrfs_(char *trans, integer *n, integer *nrhs,
+ doublereal *dl, doublereal *d__, doublereal *du, doublereal *dlf,
+ doublereal *df, doublereal *duf, doublereal *du2, integer *ipiv,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ ferr, doublereal *berr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dgtsv_(integer *n, integer *nrhs, doublereal *dl,
+ doublereal *d__, doublereal *du, doublereal *b, integer *ldb, integer
+ *info);
+
+/* Subroutine */ int dgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublereal *dl, doublereal *d__, doublereal *du, doublereal *
+ dlf, doublereal *df, doublereal *duf, doublereal *du2, integer *ipiv,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgttrf_(integer *n, doublereal *dl, doublereal *d__,
+ doublereal *du, doublereal *du2, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgttrs_(char *trans, integer *n, integer *nrhs,
+ doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2,
+ integer *ipiv, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dgtts2_(integer *itrans, integer *n, integer *nrhs,
+ doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2,
+ integer *ipiv, doublereal *b, integer *ldb);
+
+/* Subroutine */ int dhgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *
+ b, integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *q, integer *ldq, doublereal *z__, integer *ldz,
+ doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dhsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, doublereal *h__, integer *ldh, doublereal *wr,
+ doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr,
+ integer *ldvr, integer *mm, integer *m, doublereal *work, integer *
+ ifaill, integer *ifailr, integer *info);
+
+/* Subroutine */ int dhseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, doublereal *h__, integer *ldh, doublereal *wr,
+ doublereal *wi, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dlabad_(doublereal *small, doublereal *large);
+
+/* Subroutine */ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *
+ a, integer *lda, doublereal *d__, doublereal *e, doublereal *tauq,
+ doublereal *taup, doublereal *x, integer *ldx, doublereal *y, integer
+ *ldy);
+
+/* Subroutine */ int dlacon_(integer *n, doublereal *v, doublereal *x,
+ integer *isgn, doublereal *est, integer *kase);
+
+/* Subroutine */ int dlacpy_(char *uplo, integer *m, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb);
+
+/* Subroutine */ int dladiv_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *d__, doublereal *p, doublereal *q);
+
+/* Subroutine */ int dlae2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *rt1, doublereal *rt2);
+
+/* Subroutine */ int dlaebz_(integer *ijob, integer *nitmax, integer *n,
+ integer *mmax, integer *minp, integer *nbmin, doublereal *abstol,
+ doublereal *reltol, doublereal *pivmin, doublereal *d__, doublereal *
+ e, doublereal *e2, integer *nval, doublereal *ab, doublereal *c__,
+ integer *mout, integer *nab, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlaed0_(integer *icompq, integer *qsiz, integer *n,
+ doublereal *d__, doublereal *e, doublereal *q, integer *ldq,
+ doublereal *qstore, integer *ldqs, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlaed1_(integer *n, doublereal *d__, doublereal *q,
+ integer *ldq, integer *indxq, doublereal *rho, integer *cutpnt,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlaed2_(integer *k, integer *n, integer *n1, doublereal *
+ d__, doublereal *q, integer *ldq, integer *indxq, doublereal *rho,
+ doublereal *z__, doublereal *dlamda, doublereal *w, doublereal *q2,
+ integer *indx, integer *indxc, integer *indxp, integer *coltyp,
+ integer *info);
+
+/* Subroutine */ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *
+ d__, doublereal *q, integer *ldq, doublereal *rho, doublereal *dlamda,
+ doublereal *q2, integer *indx, integer *ctot, doublereal *w,
+ doublereal *s, integer *info);
+
+/* Subroutine */ int dlaed4_(integer *n, integer *i__, doublereal *d__,
+ doublereal *z__, doublereal *delta, doublereal *rho, doublereal *dlam,
+ integer *info);
+
+/* Subroutine */ int dlaed5_(integer *i__, doublereal *d__, doublereal *z__,
+ doublereal *delta, doublereal *rho, doublereal *dlam);
+
+/* Subroutine */ int dlaed6_(integer *kniter, logical *orgati, doublereal *
+ rho, doublereal *d__, doublereal *z__, doublereal *finit, doublereal *
+ tau, integer *info);
+
+/* Subroutine */ int dlaed7_(integer *icompq, integer *n, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, doublereal *d__,
+ doublereal *q, integer *ldq, integer *indxq, doublereal *rho, integer
+ *cutpnt, doublereal *qstore, integer *qptr, integer *prmptr, integer *
+ perm, integer *givptr, integer *givcol, doublereal *givnum,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlaed8_(integer *icompq, integer *k, integer *n, integer
+ *qsiz, doublereal *d__, doublereal *q, integer *ldq, integer *indxq,
+ doublereal *rho, integer *cutpnt, doublereal *z__, doublereal *dlamda,
+ doublereal *q2, integer *ldq2, doublereal *w, integer *perm, integer
+ *givptr, integer *givcol, doublereal *givnum, integer *indxp, integer
+ *indx, integer *info);
+
+/* Subroutine */ int dlaed9_(integer *k, integer *kstart, integer *kstop,
+ integer *n, doublereal *d__, doublereal *q, integer *ldq, doublereal *
+ rho, doublereal *dlamda, doublereal *w, doublereal *s, integer *lds,
+ integer *info);
+
+/* Subroutine */ int dlaeda_(integer *n, integer *tlvls, integer *curlvl,
+ integer *curpbm, integer *prmptr, integer *perm, integer *givptr,
+ integer *givcol, doublereal *givnum, doublereal *q, integer *qptr,
+ doublereal *z__, doublereal *ztemp, integer *info);
+
+/* Subroutine */ int dlaein_(logical *rightv, logical *noinit, integer *n,
+ doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi,
+ doublereal *vr, doublereal *vi, doublereal *b, integer *ldb,
+ doublereal *work, doublereal *eps3, doublereal *smlnum, doublereal *
+ bignum, integer *info);
+
+/* Subroutine */ int dlaev2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1);
+
+/* Subroutine */ int dlaexc_(logical *wantq, integer *n, doublereal *t,
+ integer *ldt, doublereal *q, integer *ldq, integer *j1, integer *n1,
+ integer *n2, doublereal *work, integer *info);
+
+/* Subroutine */ int dlag2_(doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *safmin, doublereal *scale1, doublereal *
+ scale2, doublereal *wr1, doublereal *wr2, doublereal *wi);
+
+/* Subroutine */ int dlags2_(logical *upper, doublereal *a1, doublereal *a2,
+ doublereal *a3, doublereal *b1, doublereal *b2, doublereal *b3,
+ doublereal *csu, doublereal *snu, doublereal *csv, doublereal *snv,
+ doublereal *csq, doublereal *snq);
+
+/* Subroutine */ int dlagtf_(integer *n, doublereal *a, doublereal *lambda,
+ doublereal *b, doublereal *c__, doublereal *tol, doublereal *d__,
+ integer *in, integer *info);
+
+/* Subroutine */ int dlagtm_(char *trans, integer *n, integer *nrhs,
+ doublereal *alpha, doublereal *dl, doublereal *d__, doublereal *du,
+ doublereal *x, integer *ldx, doublereal *beta, doublereal *b, integer
+ *ldb);
+
+/* Subroutine */ int dlagts_(integer *job, integer *n, doublereal *a,
+ doublereal *b, doublereal *c__, doublereal *d__, integer *in,
+ doublereal *y, doublereal *tol, integer *info);
+
+/* Subroutine */ int dlagv2_(doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *csl, doublereal *snl, doublereal *csr, doublereal *
+ snr);
+
+/* Subroutine */ int dlahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal
+ *wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__,
+ integer *ldz, integer *info);
+
+/* Subroutine */ int dlahrd_(integer *n, integer *k, integer *nb, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *t, integer *ldt,
+ doublereal *y, integer *ldy);
+
+/* Subroutine */ int dlaic1_(integer *job, integer *j, doublereal *x,
+ doublereal *sest, doublereal *w, doublereal *gamma, doublereal *
+ sestpr, doublereal *s, doublereal *c__);
+
+/* Subroutine */ int dlaln2_(logical *ltrans, integer *na, integer *nw,
+ doublereal *smin, doublereal *ca, doublereal *a, integer *lda,
+ doublereal *d1, doublereal *d2, doublereal *b, integer *ldb,
+ doublereal *wr, doublereal *wi, doublereal *x, integer *ldx,
+ doublereal *scale, doublereal *xnorm, integer *info);
+
+/* Subroutine */ int dlals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, doublereal *b, integer *ldb, doublereal
+ *bx, integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, doublereal *givnum, integer *ldgnum, doublereal *
+ poles, doublereal *difl, doublereal *difr, doublereal *z__, integer *
+ k, doublereal *c__, doublereal *s, doublereal *work, integer *info);
+
+/* Subroutine */ int dlalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, doublereal *b, integer *ldb, doublereal *bx, integer *
+ ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *k,
+ doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
+ poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
+ perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, doublereal *d__, doublereal *e, doublereal *b, integer *ldb,
+ doublereal *rcond, integer *rank, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1);
+
+/* Subroutine */ int dlamc2_(integer *beta, integer *t, logical *rnd,
+ doublereal *eps, integer *emin, doublereal *rmin, integer *emax,
+ doublereal *rmax);
+
+/* Subroutine */ int dlamc4_(integer *emin, doublereal *start, integer *base);
+
+/* Subroutine */ int dlamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, doublereal *rmax);
+
+/* Subroutine */ int dlamrg_(integer *n1, integer *n2, doublereal *a, integer
+ *dtrd1, integer *dtrd2, integer *index);
+
+/* Subroutine */ int dlanv2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *d__, doublereal *rt1r, doublereal *rt1i, doublereal *rt2r,
+ doublereal *rt2i, doublereal *cs, doublereal *sn);
+
+/* Subroutine */ int dlapll_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *ssmin);
+
+/* Subroutine */ int dlapmt_(logical *forwrd, integer *m, integer *n,
+ doublereal *x, integer *ldx, integer *k);
+
+/* Subroutine */ int dlaqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqge_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal
+ *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqp2_(integer *m, integer *n, integer *offset,
+ doublereal *a, integer *lda, integer *jpvt, doublereal *tau,
+ doublereal *vn1, doublereal *vn2, doublereal *work);
+
+/* Subroutine */ int dlaqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, doublereal *a, integer *lda, integer *jpvt,
+ doublereal *tau, doublereal *vn1, doublereal *vn2, doublereal *auxv,
+ doublereal *f, integer *ldf);
+
+/* Subroutine */ int dlaqsb_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, doublereal *s, doublereal *scond, doublereal *amax,
+ char *equed);
+
+/* Subroutine */ int dlaqsp_(char *uplo, integer *n, doublereal *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqsy_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqtr_(logical *ltran, logical *lreal, integer *n,
+ doublereal *t, integer *ldt, doublereal *b, doublereal *w, doublereal
+ *scale, doublereal *x, doublereal *work, integer *info);
+
+/* Subroutine */ int dlar1v_(integer *n, integer *b1, integer *bn, doublereal
+ *sigma, doublereal *d__, doublereal *l, doublereal *ld, doublereal *
+ lld, doublereal *gersch, doublereal *z__, doublereal *ztz, doublereal
+ *mingma, integer *r__, integer *isuppz, doublereal *work);
+
+/* Subroutine */ int dlar2v_(integer *n, doublereal *x, doublereal *y,
+ doublereal *z__, integer *incx, doublereal *c__, doublereal *s,
+ integer *incc);
+
+/* Subroutine */ int dlarf_(char *side, integer *m, integer *n, doublereal *v,
+ integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
+ doublereal *work);
+
+/* Subroutine */ int dlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublereal *v, integer *
+ ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc,
+ doublereal *work, integer *ldwork);
+
+/* Subroutine */ int dlarfg_(integer *n, doublereal *alpha, doublereal *x,
+ integer *incx, doublereal *tau);
+
+/* Subroutine */ int dlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t,
+ integer *ldt);
+
+/* Subroutine */ int dlarfx_(char *side, integer *m, integer *n, doublereal *
+ v, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work);
+
+/* Subroutine */ int dlargv_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *c__, integer *incc);
+
+/* Subroutine */ int dlarnv_(integer *idist, integer *iseed, integer *n,
+ doublereal *x);
+
+/* Subroutine */ int dlarrb_(integer *n, doublereal *d__, doublereal *l,
+ doublereal *ld, doublereal *lld, integer *ifirst, integer *ilast,
+ doublereal *sigma, doublereal *reltol, doublereal *w, doublereal *
+ wgap, doublereal *werr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dlarre_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *tol, integer *nsplit, integer *isplit, integer *m,
+ doublereal *w, doublereal *woff, doublereal *gersch, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dlarrf_(integer *n, doublereal *d__, doublereal *l,
+ doublereal *ld, doublereal *lld, integer *ifirst, integer *ilast,
+ doublereal *w, doublereal *dplus, doublereal *lplus, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dlarrv_(integer *n, doublereal *d__, doublereal *l,
+ integer *isplit, integer *m, doublereal *w, integer *iblock,
+ doublereal *gersch, doublereal *tol, doublereal *z__, integer *ldz,
+ integer *isuppz, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlartg_(doublereal *f, doublereal *g, doublereal *cs,
+ doublereal *sn, doublereal *r__);
+
+/* Subroutine */ int dlartv_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *c__, doublereal *s, integer
+ *incc);
+
+/* Subroutine */ int dlaruv_(integer *iseed, integer *n, doublereal *x);
+
+/* Subroutine */ int dlarz_(char *side, integer *m, integer *n, integer *l,
+ doublereal *v, integer *incv, doublereal *tau, doublereal *c__,
+ integer *ldc, doublereal *work);
+
+/* Subroutine */ int dlarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, doublereal *v,
+ integer *ldv, doublereal *t, integer *ldt, doublereal *c__, integer *
+ ldc, doublereal *work, integer *ldwork);
+
+/* Subroutine */ int dlarzt_(char *direct, char *storev, integer *n, integer *
+ k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t,
+ integer *ldt);
+
+/* Subroutine */ int dlas2_(doublereal *f, doublereal *g, doublereal *h__,
+ doublereal *ssmin, doublereal *ssmax);
+
+/* Subroutine */ int dlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublereal *a, integer *lda, integer *info);
+
+/* Subroutine */ int dlasd0_(integer *n, integer *sqre, doublereal *d__,
+ doublereal *e, doublereal *u, integer *ldu, doublereal *vt, integer *
+ ldvt, integer *smlsiz, integer *iwork, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dlasd1_(integer *nl, integer *nr, integer *sqre,
+ doublereal *d__, doublereal *alpha, doublereal *beta, doublereal *u,
+ integer *ldu, doublereal *vt, integer *ldvt, integer *idxq, integer *
+ iwork, doublereal *work, integer *info);
+
+/* Subroutine */ int dlasd2_(integer *nl, integer *nr, integer *sqre, integer
+ *k, doublereal *d__, doublereal *z__, doublereal *alpha, doublereal *
+ beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt,
+ doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2,
+ integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer *
+ idxq, integer *coltyp, integer *info);
+
+/* Subroutine */ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer
+ *k, doublereal *d__, doublereal *q, integer *ldq, doublereal *dsigma,
+ doublereal *u, integer *ldu, doublereal *u2, integer *ldu2,
+ doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2,
+ integer *idxc, integer *ctot, doublereal *z__, integer *info);
+
+/* Subroutine */ int dlasd4_(integer *n, integer *i__, doublereal *d__,
+ doublereal *z__, doublereal *delta, doublereal *rho, doublereal *
+ sigma, doublereal *work, integer *info);
+
+/* Subroutine */ int dlasd5_(integer *i__, doublereal *d__, doublereal *z__,
+ doublereal *delta, doublereal *rho, doublereal *dsigma, doublereal *
+ work);
+
+/* Subroutine */ int dlasd6_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, doublereal *d__, doublereal *vf, doublereal *vl,
+ doublereal *alpha, doublereal *beta, integer *idxq, integer *perm,
+ integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum,
+ integer *ldgnum, doublereal *poles, doublereal *difl, doublereal *
+ difr, doublereal *z__, integer *k, doublereal *c__, doublereal *s,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlasd7_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *k, doublereal *d__, doublereal *z__,
+ doublereal *zw, doublereal *vf, doublereal *vfw, doublereal *vl,
+ doublereal *vlw, doublereal *alpha, doublereal *beta, doublereal *
+ dsigma, integer *idx, integer *idxp, integer *idxq, integer *perm,
+ integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum,
+ integer *ldgnum, doublereal *c__, doublereal *s, integer *info);
+
+/* Subroutine */ int dlasd8_(integer *icompq, integer *k, doublereal *d__,
+ doublereal *z__, doublereal *vf, doublereal *vl, doublereal *difl,
+ doublereal *difr, integer *lddifr, doublereal *dsigma, doublereal *
+ work, integer *info);
+
+/* Subroutine */ int dlasd9_(integer *icompq, integer *ldu, integer *k,
+ doublereal *d__, doublereal *z__, doublereal *vf, doublereal *vl,
+ doublereal *difl, doublereal *difr, doublereal *dsigma, doublereal *
+ work, integer *info);
+
+/* Subroutine */ int dlasda_(integer *icompq, integer *smlsiz, integer *n,
+ integer *sqre, doublereal *d__, doublereal *e, doublereal *u, integer
+ *ldu, doublereal *vt, integer *k, doublereal *difl, doublereal *difr,
+ doublereal *z__, doublereal *poles, integer *givptr, integer *givcol,
+ integer *ldgcol, integer *perm, doublereal *givnum, doublereal *c__,
+ doublereal *s, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlasdq_(char *uplo, integer *sqre, integer *n, integer *
+ ncvt, integer *nru, integer *ncc, doublereal *d__, doublereal *e,
+ doublereal *vt, integer *ldvt, doublereal *u, integer *ldu,
+ doublereal *c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dlasdt_(integer *n, integer *lvl, integer *nd, integer *
+ inode, integer *ndiml, integer *ndimr, integer *msub);
+
+/* Subroutine */ int dlaset_(char *uplo, integer *m, integer *n, doublereal *
+ alpha, doublereal *beta, doublereal *a, integer *lda);
+
+/* Subroutine */ int dlasq1_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dlasq2_(integer *n, doublereal *z__, integer *info);
+
+/* Subroutine */ int dlasq3_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig,
+ doublereal *qmax, integer *nfail, integer *iter, integer *ndiv,
+ logical *ieee);
+
+/* Subroutine */ int dlasq4_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1,
+ doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2,
+ doublereal *tau, integer *ttype);
+
+/* Subroutine */ int dlasq5_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *tau, doublereal *dmin__, doublereal *dmin1,
+ doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2,
+ logical *ieee);
+
+/* Subroutine */ int dlasq6_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2,
+ doublereal *dn, doublereal *dnm1, doublereal *dnm2);
+
+/* Subroutine */ int dlasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *
+ lda);
+
+/* Subroutine */ int dlasrt_(char *id, integer *n, doublereal *d__, integer *
+ info);
+
+/* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx,
+ doublereal *scale, doublereal *sumsq);
+
+/* Subroutine */ int dlasv2_(doublereal *f, doublereal *g, doublereal *h__,
+ doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *
+ csr, doublereal *snl, doublereal *csl);
+
+/* Subroutine */ int dlaswp_(integer *n, doublereal *a, integer *lda, integer
+ *k1, integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int dlasy2_(logical *ltranl, logical *ltranr, integer *isgn,
+ integer *n1, integer *n2, doublereal *tl, integer *ldtl, doublereal *
+ tr, integer *ldtr, doublereal *b, integer *ldb, doublereal *scale,
+ doublereal *x, integer *ldx, doublereal *xnorm, integer *info);
+
+/* Subroutine */ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *w, integer *
+ ldw, integer *info);
+
+/* Subroutine */ int dlatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, doublereal *ab, integer *ldab,
+ doublereal *x, doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int dlatdf_(integer *ijob, integer *n, doublereal *z__,
+ integer *ldz, doublereal *rhs, doublereal *rdsum, doublereal *rdscal,
+ integer *ipiv, integer *jpiv);
+
+/* Subroutine */ int dlatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublereal *ap, doublereal *x, doublereal *scale,
+ doublereal *cnorm, integer *info);
+
+/* Subroutine */ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *
+ a, integer *lda, doublereal *e, doublereal *tau, doublereal *w,
+ integer *ldw);
+
+/* Subroutine */ int dlatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublereal *a, integer *lda, doublereal *x,
+ doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int dlatrz_(integer *m, integer *n, integer *l, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work);
+
+/* Subroutine */ int dlatzm_(char *side, integer *m, integer *n, doublereal *
+ v, integer *incv, doublereal *tau, doublereal *c1, doublereal *c2,
+ integer *ldc, doublereal *work);
+
+/* Subroutine */ int dlauu2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dlauum_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dopgtr_(char *uplo, integer *n, doublereal *ap,
+ doublereal *tau, doublereal *q, integer *ldq, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dopmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublereal *ap, doublereal *tau, doublereal *c__, integer
+ *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dorg2l_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorg2r_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorgbr_(char *vect, integer *m, integer *n, integer *k,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dorghr_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dorgl2_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorglq_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgql_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgqr_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgr2_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorgrq_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgtr_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dorm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dorm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dormhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *
+ tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dormtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dpbcon_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, doublereal *anorm, doublereal *rcond, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dpbequ_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, doublereal *s, doublereal *scond, doublereal *amax,
+ integer *info);
+
+/* Subroutine */ int dpbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublereal *ab, integer *ldab, doublereal *afb, integer *ldafb,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ ferr, doublereal *berr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dpbstf_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, integer *info);
+
+/* Subroutine */ int dpbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublereal *ab, integer *ldab, doublereal *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int dpbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, doublereal *ab, integer *ldab, doublereal *afb,
+ integer *ldafb, char *equed, doublereal *s, doublereal *b, integer *
+ ldb, doublereal *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dpbtf2_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, integer *info);
+
+/* Subroutine */ int dpbtrf_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, integer *info);
+
+/* Subroutine */ int dpbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublereal *ab, integer *ldab, doublereal *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int dpocon_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dpoequ_(integer *n, doublereal *a, integer *lda,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int dporfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ ferr, doublereal *berr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dposv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *a, integer *lda, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ char *equed, doublereal *s, doublereal *b, integer *ldb, doublereal *
+ x, integer *ldx, doublereal *rcond, doublereal *ferr, doublereal *
+ berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dpotf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dpotrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dpotri_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dpotrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dppcon_(char *uplo, integer *n, doublereal *ap,
+ doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dppequ_(char *uplo, integer *n, doublereal *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int dpprfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, doublereal *afp, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dppsv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *ap, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *ap, doublereal *afp, char *equed, doublereal *s,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dpptrf_(char *uplo, integer *n, doublereal *ap, integer *
+ info);
+
+/* Subroutine */ int dpptri_(char *uplo, integer *n, doublereal *ap, integer *
+ info);
+
+/* Subroutine */ int dpptrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dptcon_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *anorm, doublereal *rcond, doublereal *work, integer *info);
+
+/* Subroutine */ int dpteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dptrfs_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *df, doublereal *ef, doublereal *b, integer
+ *ldb, doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dptsv_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dptsvx_(char *fact, integer *n, integer *nrhs,
+ doublereal *d__, doublereal *e, doublereal *df, doublereal *ef,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dpttrf_(integer *n, doublereal *d__, doublereal *e,
+ integer *info);
+
+/* Subroutine */ int dpttrs_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dptts2_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *b, integer *ldb);
+
+/* Subroutine */ int drscl_(integer *n, doublereal *sa, doublereal *sx,
+ integer *incx);
+
+/* Subroutine */ int dsbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublereal *ab, integer *ldab, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *info);
+
+/* Subroutine */ int dsbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublereal *ab, integer *ldab, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int dsbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, doublereal *ab, integer *ldab, doublereal *q, integer *
+ ldq, doublereal *vl, doublereal *vu, integer *il, integer *iu,
+ doublereal *abstol, integer *m, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *iwork, integer *ifail,
+ integer *info);
+
+/* Subroutine */ int dsbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, doublereal *ab, integer *ldab, doublereal *bb, integer *
+ ldbb, doublereal *x, integer *ldx, doublereal *work, integer *info);
+
+/* Subroutine */ int dsbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublereal *ab, integer *ldab, doublereal *bb, integer *
+ ldbb, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dsbgvd_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublereal *ab, integer *ldab, doublereal *bb, integer *
+ ldbb, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, doublereal *ab, integer *ldab, doublereal *
+ bb, integer *ldbb, doublereal *q, integer *ldq, doublereal *vl,
+ doublereal *vu, integer *il, integer *iu, doublereal *abstol, integer
+ *m, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int dsbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ doublereal *ab, integer *ldab, doublereal *d__, doublereal *e,
+ doublereal *q, integer *ldq, doublereal *work, integer *info);
+
+/* Subroutine */ int dspcon_(char *uplo, integer *n, doublereal *ap, integer *
+ ipiv, doublereal *anorm, doublereal *rcond, doublereal *work, integer
+ *iwork, integer *info);
+
+/* Subroutine */ int dspev_(char *jobz, char *uplo, integer *n, doublereal *
+ ap, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dspevd_(char *jobz, char *uplo, integer *n, doublereal *
+ ap, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dspevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublereal *ap, doublereal *vl, doublereal *vu, integer *il, integer *
+ iu, doublereal *abstol, integer *m, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *iwork, integer *ifail,
+ integer *info);
+
+/* Subroutine */ int dspgst_(integer *itype, char *uplo, integer *n,
+ doublereal *ap, doublereal *bp, integer *info);
+
+/* Subroutine */ int dspgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *ap, doublereal *bp, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *info);
+
+/* Subroutine */ int dspgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *ap, doublereal *bp, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int dspgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublereal *ap, doublereal *bp, doublereal *vl,
+ doublereal *vu, integer *il, integer *iu, doublereal *abstol, integer
+ *m, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int dsprfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, doublereal *afp, integer *ipiv, doublereal *b,
+ integer *ldb, doublereal *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dspsv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *ap, integer *ipiv, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *ap, doublereal *afp, integer *ipiv, doublereal *b,
+ integer *ldb, doublereal *x, integer *ldx, doublereal *rcond,
+ doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dsptrd_(char *uplo, integer *n, doublereal *ap,
+ doublereal *d__, doublereal *e, doublereal *tau, integer *info);
+
+/* Subroutine */ int dsptrf_(char *uplo, integer *n, doublereal *ap, integer *
+ ipiv, integer *info);
+
+/* Subroutine */ int dsptri_(char *uplo, integer *n, doublereal *ap, integer *
+ ipiv, doublereal *work, integer *info);
+
+/* Subroutine */ int dsptrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, integer *ipiv, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dstebz_(char *range, char *order, integer *n, doublereal
+ *vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol,
+ doublereal *d__, doublereal *e, integer *m, integer *nsplit,
+ doublereal *w, integer *iblock, integer *isplit, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dstedc_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstegr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstein_(integer *n, doublereal *d__, doublereal *e,
+ integer *m, doublereal *w, integer *iblock, integer *isplit,
+ doublereal *z__, integer *ldz, doublereal *work, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int dsteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dsterf_(integer *n, doublereal *d__, doublereal *e,
+ integer *info);
+
+/* Subroutine */ int dstev_(char *jobz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dstevd_(char *jobz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstevr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstevx_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, doublereal *work, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int dsycon_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *anorm, doublereal *rcond, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dsyev_(char *jobz, char *uplo, integer *n, doublereal *a,
+ integer *lda, doublereal *w, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dsyevd_(char *jobz, char *uplo, integer *n, doublereal *
+ a, integer *lda, doublereal *w, doublereal *work, integer *lwork,
+ integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsyevr_(char *jobz, char *range, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *vl, doublereal *vu, integer *
+ il, integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsyevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *vl, doublereal *vu, integer *
+ il, integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, doublereal *work, integer *lwork,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int dsygs2_(integer *itype, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dsygst_(integer *itype, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dsygv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *w, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsygvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *w, doublereal *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int dsygvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublereal *a, integer *lda, doublereal *b, integer
+ *ldb, doublereal *vl, doublereal *vu, integer *il, integer *iu,
+ doublereal *abstol, integer *m, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *lwork, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int dsyrfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *af, integer *ldaf, integer *
+ ipiv, doublereal *b, integer *ldb, doublereal *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dsysv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb,
+ doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, doublereal *b, integer *ldb, doublereal *x, integer *
+ ldx, doublereal *rcond, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int dsytd2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tau, integer *info);
+
+/* Subroutine */ int dsytf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int dsytrd_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsytrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsytri_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *work, integer *info);
+
+/* Subroutine */ int dsytrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int dtbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, doublereal *ab, integer *ldab, doublereal *rcond,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublereal *ab, integer *ldab, doublereal
+ *b, integer *ldb, doublereal *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublereal *ab, integer *ldab, doublereal
+ *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dtgevc_(char *side, char *howmny, logical *select,
+ integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr, integer
+ *mm, integer *m, doublereal *work, integer *info);
+
+/* Subroutine */ int dtgex2_(logical *wantq, logical *wantz, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ q, integer *ldq, doublereal *z__, integer *ldz, integer *j1, integer *
+ n1, integer *n2, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dtgexc_(logical *wantq, logical *wantz, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ q, integer *ldq, doublereal *z__, integer *ldz, integer *ifst,
+ integer *ilst, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dtgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, doublereal *a, integer *lda, doublereal *
+ b, integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *q, integer *ldq, doublereal *z__, integer *ldz,
+ integer *m, doublereal *pl, doublereal *pr, doublereal *dif,
+ doublereal *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int dtgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, doublereal *a,
+ integer *lda, doublereal *b, integer *ldb, doublereal *tola,
+ doublereal *tolb, doublereal *alpha, doublereal *beta, doublereal *u,
+ integer *ldu, doublereal *v, integer *ldv, doublereal *q, integer *
+ ldq, doublereal *work, integer *ncycle, integer *info);
+
+/* Subroutine */ int dtgsna_(char *job, char *howmny, logical *select,
+ integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr,
+ doublereal *s, doublereal *dif, integer *mm, integer *m, doublereal *
+ work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int dtgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *c__, integer *ldc, doublereal *d__, integer *ldd,
+ doublereal *e, integer *lde, doublereal *f, integer *ldf, doublereal *
+ scale, doublereal *rdsum, doublereal *rdscal, integer *iwork, integer
+ *pq, integer *info);
+
+/* Subroutine */ int dtgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *c__, integer *ldc, doublereal *d__, integer *ldd,
+ doublereal *e, integer *lde, doublereal *f, integer *ldf, doublereal *
+ scale, doublereal *dif, doublereal *work, integer *lwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dtpcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublereal *ap, doublereal *rcond, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dtprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *ap, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtptri_(char *uplo, char *diag, integer *n, doublereal *
+ ap, integer *info);
+
+/* Subroutine */ int dtptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *ap, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dtrcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublereal *a, integer *lda, doublereal *rcond, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dtrevc_(char *side, char *howmny, logical *select,
+ integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *
+ ldvl, doublereal *vr, integer *ldvr, integer *mm, integer *m,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dtrexc_(char *compq, integer *n, doublereal *t, integer *
+ ldt, doublereal *q, integer *ldq, integer *ifst, integer *ilst,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dtrrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtrsen_(char *job, char *compq, logical *select, integer
+ *n, doublereal *t, integer *ldt, doublereal *q, integer *ldq,
+ doublereal *wr, doublereal *wi, integer *m, doublereal *s, doublereal
+ *sep, doublereal *work, integer *lwork, integer *iwork, integer *
+ liwork, integer *info);
+
+/* Subroutine */ int dtrsna_(char *job, char *howmny, logical *select,
+ integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *
+ ldvl, doublereal *vr, integer *ldvr, doublereal *s, doublereal *sep,
+ integer *mm, integer *m, doublereal *work, integer *ldwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dtrsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, doublereal *c__, integer *ldc, doublereal *scale, integer *info);
+
+/* Subroutine */ int dtrti2_(char *uplo, char *diag, integer *n, doublereal *
+ a, integer *lda, integer *info);
+
+/* Subroutine */ int dtrtri_(char *uplo, char *diag, integer *n, doublereal *
+ a, integer *lda, integer *info);
+
+/* Subroutine */ int dtrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int dtzrqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, integer *info);
+
+/* Subroutine */ int dtzrzf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+integer icmax1_(integer *n, complex *cx, integer *incx);
+
+integer ieeeck_(integer *ispec, real *zero, real *one);
+
+integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
+ integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen
+ opts_len);
+
+integer izmax1_(integer *n, doublecomplex *cx, integer *incx);
+
+/* Subroutine */ int sbdsdc_(char *uplo, char *compq, integer *n, real *d__,
+ real *e, real *u, integer *ldu, real *vt, integer *ldvt, real *q,
+ integer *iq, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, real *d__, real *e, real *vt, integer *ldvt, real *
+ u, integer *ldu, real *c__, integer *ldc, real *work, integer *info);
+
+/* Subroutine */ int sdisna_(char *job, integer *m, integer *n, real *d__,
+ real *sep, integer *info);
+
+/* Subroutine */ int sgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, real *ab, integer *ldab, real *d__, real *
+ e, real *q, integer *ldq, real *pt, integer *ldpt, real *c__, integer
+ *ldc, real *work, integer *info);
+
+/* Subroutine */ int sgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, integer *ipiv, real *anorm, real *rcond,
+ real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real *
+ colcnd, real *amax, integer *info);
+
+/* Subroutine */ int sgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, real *ab, integer *ldab, real *afb, integer *ldafb,
+ integer *ipiv, real *b, integer *ldb, real *x, integer *ldx, real *
+ ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, real *ab, integer *ldab, integer *ipiv, real *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int sgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, real *ab, integer *ldab, real *afb,
+ integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
+ real *b, integer *ldb, real *x, integer *ldx, real *rcond, real *ferr,
+ real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int sgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int sgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, real *ab, integer *ldab, integer *ipiv, real *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int sgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *scale, integer *m, real *v, integer *ldv, integer
+ *info);
+
+/* Subroutine */ int sgebal_(char *job, integer *n, real *a, integer *lda,
+ integer *ilo, integer *ihi, real *scale, integer *info);
+
+/* Subroutine */ int sgebd2_(integer *m, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tauq, real *taup, real *work, integer *info);
+
+/* Subroutine */ int sgebrd_(integer *m, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tauq, real *taup, real *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int sgecon_(char *norm, integer *n, real *a, integer *lda,
+ real *anorm, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgeequ_(integer *m, integer *n, real *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, integer
+ *info);
+
+/* Subroutine */ int sgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ real *a, integer *lda, integer *sdim, real *wr, real *wi, real *vs,
+ integer *ldvs, real *work, integer *lwork, logical *bwork, integer *
+ info);
+
+/* Subroutine */ int sgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, real *a, integer *lda, integer *sdim, real *wr,
+ real *wi, real *vs, integer *ldvs, real *rconde, real *rcondv, real *
+ work, integer *lwork, integer *iwork, integer *liwork, logical *bwork,
+ integer *info);
+
+/* Subroutine */ int sgeev_(char *jobvl, char *jobvr, integer *n, real *a,
+ integer *lda, real *wr, real *wi, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, real *a, integer *lda, real *wr, real *wi, real *
+ vl, integer *ldvl, real *vr, integer *ldvr, integer *ilo, integer *
+ ihi, real *scale, real *abnrm, real *rconde, real *rcondv, real *work,
+ integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgegs_(char *jobvsl, char *jobvsr, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real
+ *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgegv_(char *jobvl, char *jobvr, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real
+ *beta, real *vl, integer *ldvl, real *vr, integer *ldvr, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sgehd2_(integer *n, integer *ilo, integer *ihi, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgehrd_(integer *n, integer *ilo, integer *ihi, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgelq2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgelqf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, real *a, integer *lda, real *b, integer *ldb, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sgelsd_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, real *s, real *rcond, integer *
+ rank, real *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgelss_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, real *s, real *rcond, integer *
+ rank, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgelsx_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, real *work, integer *info);
+
+/* Subroutine */ int sgelsy_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeql2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgeqlf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeqp3_(integer *m, integer *n, real *a, integer *lda,
+ integer *jpvt, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeqpf_(integer *m, integer *n, real *a, integer *lda,
+ integer *jpvt, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgeqr2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgeqrf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgerfs_(char *trans, integer *n, integer *nrhs, real *a,
+ integer *lda, real *af, integer *ldaf, integer *ipiv, real *b,
+ integer *ldb, real *x, integer *ldx, real *ferr, real *berr, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgerq2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgerqf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgesc2_(integer *n, real *a, integer *lda, real *rhs,
+ integer *ipiv, integer *jpiv, real *scale);
+
+/* Subroutine */ int sgesdd_(char *jobz, integer *m, integer *n, real *a,
+ integer *lda, real *s, real *u, integer *ldu, real *vt, integer *ldvt,
+ real *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgesv_(integer *n, integer *nrhs, real *a, integer *lda,
+ integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
+ real *a, integer *lda, real *s, real *u, integer *ldu, real *vt,
+ integer *ldvt, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ char *equed, real *r__, real *c__, real *b, integer *ldb, real *x,
+ integer *ldx, real *rcond, real *ferr, real *berr, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int sgetc2_(integer *n, real *a, integer *lda, integer *ipiv,
+ integer *jpiv, integer *info);
+
+/* Subroutine */ int sgetf2_(integer *m, integer *n, real *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int sgetrf_(integer *m, integer *n, real *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int sgetri_(integer *n, real *a, integer *lda, integer *ipiv,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgetrs_(char *trans, integer *n, integer *nrhs, real *a,
+ integer *lda, integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *lscale, real *rscale, integer *m, real *v,
+ integer *ldv, integer *info);
+
+/* Subroutine */ int sggbal_(char *job, integer *n, real *a, integer *lda,
+ real *b, integer *ldb, integer *ilo, integer *ihi, real *lscale, real
+ *rscale, real *work, integer *info);
+
+/* Subroutine */ int sgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, integer *n, real *a, integer *lda, real *b, integer *ldb,
+ integer *sdim, real *alphar, real *alphai, real *beta, real *vsl,
+ integer *ldvsl, real *vsr, integer *ldvsr, real *work, integer *lwork,
+ logical *bwork, integer *info);
+
+/* Subroutine */ int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, char *sense, integer *n, real *a, integer *lda, real *b,
+ integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta,
+ real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *rconde,
+ real *rcondv, real *work, integer *lwork, integer *iwork, integer *
+ liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int sggev_(char *jobvl, char *jobvr, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real
+ *beta, real *vl, integer *ldvl, real *vr, integer *ldvr, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, real *a, integer *lda, real *b, integer *ldb, real
+ *alphar, real *alphai, real *beta, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, integer *ilo, integer *ihi, real *lscale, real *rscale,
+ real *abnrm, real *bbnrm, real *rconde, real *rcondv, real *work,
+ integer *lwork, integer *iwork, logical *bwork, integer *info);
+
+/* Subroutine */ int sggglm_(integer *n, integer *m, integer *p, real *a,
+ integer *lda, real *b, integer *ldb, real *d__, real *x, real *y,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, real *a, integer *lda, real *b, integer *ldb, real
+ *q, integer *ldq, real *z__, integer *ldz, integer *info);
+
+/* Subroutine */ int sgglse_(integer *m, integer *n, integer *p, real *a,
+ integer *lda, real *b, integer *ldb, real *c__, real *d__, real *x,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sggqrf_(integer *n, integer *m, integer *p, real *a,
+ integer *lda, real *taua, real *b, integer *ldb, real *taub, real *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int sggrqf_(integer *m, integer *p, integer *n, real *a,
+ integer *lda, real *taua, real *b, integer *ldb, real *taub, real *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int sggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, real *a, integer *lda,
+ real *b, integer *ldb, real *alpha, real *beta, real *u, integer *
+ ldu, real *v, integer *ldv, real *q, integer *ldq, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int sggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, real *a, integer *lda, real *b, integer *ldb,
+ real *tola, real *tolb, integer *k, integer *l, real *u, integer *ldu,
+ real *v, integer *ldv, real *q, integer *ldq, integer *iwork, real *
+ tau, real *work, integer *info);
+
+/* Subroutine */ int sgtcon_(char *norm, integer *n, real *dl, real *d__,
+ real *du, real *du2, integer *ipiv, real *anorm, real *rcond, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgtrfs_(char *trans, integer *n, integer *nrhs, real *dl,
+ real *d__, real *du, real *dlf, real *df, real *duf, real *du2,
+ integer *ipiv, real *b, integer *ldb, real *x, integer *ldx, real *
+ ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgtsv_(integer *n, integer *nrhs, real *dl, real *d__,
+ real *du, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, real *dl, real *d__, real *du, real *dlf, real *df, real *duf,
+ real *du2, integer *ipiv, real *b, integer *ldb, real *x, integer *
+ ldx, real *rcond, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int sgttrf_(integer *n, real *dl, real *d__, real *du, real *
+ du2, integer *ipiv, integer *info);
+
+/* Subroutine */ int sgttrs_(char *trans, integer *n, integer *nrhs, real *dl,
+ real *d__, real *du, real *du2, integer *ipiv, real *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int sgtts2_(integer *itrans, integer *n, integer *nrhs, real
+ *dl, real *d__, real *du, real *du2, integer *ipiv, real *b, integer *
+ ldb);
+
+/* Subroutine */ int shgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, real *a, integer *lda, real *b, integer *
+ ldb, real *alphar, real *alphai, real *beta, real *q, integer *ldq,
+ real *z__, integer *ldz, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int shsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, real *h__, integer *ldh, real *wr, real *wi, real
+ *vl, integer *ldvl, real *vr, integer *ldvr, integer *mm, integer *m,
+ real *work, integer *ifaill, integer *ifailr, integer *info);
+
+/* Subroutine */ int shseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, real *h__, integer *ldh, real *wr, real *wi, real *z__,
+ integer *ldz, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int slabad_(real *small, real *large);
+
+/* Subroutine */ int slabrd_(integer *m, integer *n, integer *nb, real *a,
+ integer *lda, real *d__, real *e, real *tauq, real *taup, real *x,
+ integer *ldx, real *y, integer *ldy);
+
+/* Subroutine */ int slacon_(integer *n, real *v, real *x, integer *isgn,
+ real *est, integer *kase);
+
+/* Subroutine */ int slacpy_(char *uplo, integer *m, integer *n, real *a,
+ integer *lda, real *b, integer *ldb);
+
+/* Subroutine */ int sladiv_(real *a, real *b, real *c__, real *d__, real *p,
+ real *q);
+
+/* Subroutine */ int slae2_(real *a, real *b, real *c__, real *rt1, real *rt2);
+
+/* Subroutine */ int slaebz_(integer *ijob, integer *nitmax, integer *n,
+ integer *mmax, integer *minp, integer *nbmin, real *abstol, real *
+ reltol, real *pivmin, real *d__, real *e, real *e2, integer *nval,
+ real *ab, real *c__, integer *mout, integer *nab, real *work, integer
+ *iwork, integer *info);
+
+/* Subroutine */ int slaed0_(integer *icompq, integer *qsiz, integer *n, real
+ *d__, real *e, real *q, integer *ldq, real *qstore, integer *ldqs,
+ real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slaed1_(integer *n, real *d__, real *q, integer *ldq,
+ integer *indxq, real *rho, integer *cutpnt, real *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int slaed2_(integer *k, integer *n, integer *n1, real *d__,
+ real *q, integer *ldq, integer *indxq, real *rho, real *z__, real *
+ dlamda, real *w, real *q2, integer *indx, integer *indxc, integer *
+ indxp, integer *coltyp, integer *info);
+
+/* Subroutine */ int slaed3_(integer *k, integer *n, integer *n1, real *d__,
+ real *q, integer *ldq, real *rho, real *dlamda, real *q2, integer *
+ indx, integer *ctot, real *w, real *s, integer *info);
+
+/* Subroutine */ int slaed4_(integer *n, integer *i__, real *d__, real *z__,
+ real *delta, real *rho, real *dlam, integer *info);
+
+/* Subroutine */ int slaed5_(integer *i__, real *d__, real *z__, real *delta,
+ real *rho, real *dlam);
+
+/* Subroutine */ int slaed6_(integer *kniter, logical *orgati, real *rho,
+ real *d__, real *z__, real *finit, real *tau, integer *info);
+
+/* Subroutine */ int slaed7_(integer *icompq, integer *n, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, real *d__, real *q,
+ integer *ldq, integer *indxq, real *rho, integer *cutpnt, real *
+ qstore, integer *qptr, integer *prmptr, integer *perm, integer *
+ givptr, integer *givcol, real *givnum, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int slaed8_(integer *icompq, integer *k, integer *n, integer
+ *qsiz, real *d__, real *q, integer *ldq, integer *indxq, real *rho,
+ integer *cutpnt, real *z__, real *dlamda, real *q2, integer *ldq2,
+ real *w, integer *perm, integer *givptr, integer *givcol, real *
+ givnum, integer *indxp, integer *indx, integer *info);
+
+/* Subroutine */ int slaed9_(integer *k, integer *kstart, integer *kstop,
+ integer *n, real *d__, real *q, integer *ldq, real *rho, real *dlamda,
+ real *w, real *s, integer *lds, integer *info);
+
+/* Subroutine */ int slaeda_(integer *n, integer *tlvls, integer *curlvl,
+ integer *curpbm, integer *prmptr, integer *perm, integer *givptr,
+ integer *givcol, real *givnum, real *q, integer *qptr, real *z__,
+ real *ztemp, integer *info);
+
+/* Subroutine */ int slaein_(logical *rightv, logical *noinit, integer *n,
+ real *h__, integer *ldh, real *wr, real *wi, real *vr, real *vi, real
+ *b, integer *ldb, real *work, real *eps3, real *smlnum, real *bignum,
+ integer *info);
+
+/* Subroutine */ int slaev2_(real *a, real *b, real *c__, real *rt1, real *
+ rt2, real *cs1, real *sn1);
+
+/* Subroutine */ int slaexc_(logical *wantq, integer *n, real *t, integer *
+ ldt, real *q, integer *ldq, integer *j1, integer *n1, integer *n2,
+ real *work, integer *info);
+
+/* Subroutine */ int slag2_(real *a, integer *lda, real *b, integer *ldb,
+ real *safmin, real *scale1, real *scale2, real *wr1, real *wr2, real *
+ wi);
+
+/* Subroutine */ int slags2_(logical *upper, real *a1, real *a2, real *a3,
+ real *b1, real *b2, real *b3, real *csu, real *snu, real *csv, real *
+ snv, real *csq, real *snq);
+
+/* Subroutine */ int slagtf_(integer *n, real *a, real *lambda, real *b, real
+ *c__, real *tol, real *d__, integer *in, integer *info);
+
+/* Subroutine */ int slagtm_(char *trans, integer *n, integer *nrhs, real *
+ alpha, real *dl, real *d__, real *du, real *x, integer *ldx, real *
+ beta, real *b, integer *ldb);
+
+/* Subroutine */ int slagts_(integer *job, integer *n, real *a, real *b, real
+ *c__, real *d__, integer *in, real *y, real *tol, integer *info);
+
+/* Subroutine */ int slagv2_(real *a, integer *lda, real *b, integer *ldb,
+ real *alphar, real *alphai, real *beta, real *csl, real *snl, real *
+ csr, real *snr);
+
+/* Subroutine */ int slahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, real *h__, integer *ldh, real *wr, real *
+ wi, integer *iloz, integer *ihiz, real *z__, integer *ldz, integer *
+ info);
+
+/* Subroutine */ int slahrd_(integer *n, integer *k, integer *nb, real *a,
+ integer *lda, real *tau, real *t, integer *ldt, real *y, integer *ldy);
+
+/* Subroutine */ int slaic1_(integer *job, integer *j, real *x, real *sest,
+ real *w, real *gamma, real *sestpr, real *s, real *c__);
+
+/* Subroutine */ int slaln2_(logical *ltrans, integer *na, integer *nw, real *
+ smin, real *ca, real *a, integer *lda, real *d1, real *d2, real *b,
+ integer *ldb, real *wr, real *wi, real *x, integer *ldx, real *scale,
+ real *xnorm, integer *info);
+
+/* Subroutine */ int slals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, real *b, integer *ldb, real *bx,
+ integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
+ difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
+ work, integer *info);
+
+/* Subroutine */ int slalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, real *b, integer *ldb, real *bx, integer *ldbx, real *
+ u, integer *ldu, real *vt, integer *k, real *difl, real *difr, real *
+ z__, real *poles, integer *givptr, integer *givcol, integer *ldgcol,
+ integer *perm, real *givnum, real *c__, real *s, real *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int slalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, real *d__, real *e, real *b, integer *ldb, real *rcond,
+ integer *rank, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1);
+
+/* Subroutine */ int slamc2_(integer *beta, integer *t, logical *rnd, real *
+ eps, integer *emin, real *rmin, integer *emax, real *rmax);
+
+/* Subroutine */ int slamc4_(integer *emin, real *start, integer *base);
+
+/* Subroutine */ int slamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, real *rmax);
+
+/* Subroutine */ int slamrg_(integer *n1, integer *n2, real *a, integer *
+ strd1, integer *strd2, integer *index);
+
+/* Subroutine */ int slanv2_(real *a, real *b, real *c__, real *d__, real *
+ rt1r, real *rt1i, real *rt2r, real *rt2i, real *cs, real *sn);
+
+/* Subroutine */ int slapll_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *ssmin);
+
+/* Subroutine */ int slapmt_(logical *forwrd, integer *m, integer *n, real *x,
+ integer *ldx, integer *k);
+
+/* Subroutine */ int slaqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real *
+ colcnd, real *amax, char *equed);
+
+/* Subroutine */ int slaqge_(integer *m, integer *n, real *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, char *
+ equed);
+
+/* Subroutine */ int slaqp2_(integer *m, integer *n, integer *offset, real *a,
+ integer *lda, integer *jpvt, real *tau, real *vn1, real *vn2, real *
+ work);
+
+/* Subroutine */ int slaqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, real *a, integer *lda, integer *jpvt, real *tau,
+ real *vn1, real *vn2, real *auxv, real *f, integer *ldf);
+
+/* Subroutine */ int slaqsb_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int slaqsp_(char *uplo, integer *n, real *ap, real *s, real *
+ scond, real *amax, char *equed);
+
+/* Subroutine */ int slaqsy_(char *uplo, integer *n, real *a, integer *lda,
+ real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int slaqtr_(logical *ltran, logical *lreal, integer *n, real
+ *t, integer *ldt, real *b, real *w, real *scale, real *x, real *work,
+ integer *info);
+
+/* Subroutine */ int slar1v_(integer *n, integer *b1, integer *bn, real *
+ sigma, real *d__, real *l, real *ld, real *lld, real *gersch, real *
+ z__, real *ztz, real *mingma, integer *r__, integer *isuppz, real *
+ work);
+
+/* Subroutine */ int slar2v_(integer *n, real *x, real *y, real *z__, integer
+ *incx, real *c__, real *s, integer *incc);
+
+/* Subroutine */ int slarf_(char *side, integer *m, integer *n, real *v,
+ integer *incv, real *tau, real *c__, integer *ldc, real *work);
+
+/* Subroutine */ int slarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, real *v, integer *ldv,
+ real *t, integer *ldt, real *c__, integer *ldc, real *work, integer *
+ ldwork);
+
+/* Subroutine */ int slarfg_(integer *n, real *alpha, real *x, integer *incx,
+ real *tau);
+
+/* Subroutine */ int slarft_(char *direct, char *storev, integer *n, integer *
+ k, real *v, integer *ldv, real *tau, real *t, integer *ldt);
+
+/* Subroutine */ int slarfx_(char *side, integer *m, integer *n, real *v,
+ real *tau, real *c__, integer *ldc, real *work);
+
+/* Subroutine */ int slargv_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *c__, integer *incc);
+
+/* Subroutine */ int slarnv_(integer *idist, integer *iseed, integer *n, real
+ *x);
+
+/* Subroutine */ int slarrb_(integer *n, real *d__, real *l, real *ld, real *
+ lld, integer *ifirst, integer *ilast, real *sigma, real *reltol, real
+ *w, real *wgap, real *werr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slarre_(integer *n, real *d__, real *e, real *tol,
+ integer *nsplit, integer *isplit, integer *m, real *w, real *woff,
+ real *gersch, real *work, integer *info);
+
+/* Subroutine */ int slarrf_(integer *n, real *d__, real *l, real *ld, real *
+ lld, integer *ifirst, integer *ilast, real *w, real *dplus, real *
+ lplus, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slarrv_(integer *n, real *d__, real *l, integer *isplit,
+ integer *m, real *w, integer *iblock, real *gersch, real *tol, real *
+ z__, integer *ldz, integer *isuppz, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int slartg_(real *f, real *g, real *cs, real *sn, real *r__);
+
+/* Subroutine */ int slartv_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *c__, real *s, integer *incc);
+
+/* Subroutine */ int slaruv_(integer *iseed, integer *n, real *x);
+
+/* Subroutine */ int slarz_(char *side, integer *m, integer *n, integer *l,
+ real *v, integer *incv, real *tau, real *c__, integer *ldc, real *
+ work);
+
+/* Subroutine */ int slarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, real *v,
+ integer *ldv, real *t, integer *ldt, real *c__, integer *ldc, real *
+ work, integer *ldwork);
+
+/* Subroutine */ int slarzt_(char *direct, char *storev, integer *n, integer *
+ k, real *v, integer *ldv, real *tau, real *t, integer *ldt);
+
+/* Subroutine */ int slas2_(real *f, real *g, real *h__, real *ssmin, real *
+ ssmax);
+
+/* Subroutine */ int slascl_(char *type__, integer *kl, integer *ku, real *
+ cfrom, real *cto, integer *m, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int slasd0_(integer *n, integer *sqre, real *d__, real *e,
+ real *u, integer *ldu, real *vt, integer *ldvt, integer *smlsiz,
+ integer *iwork, real *work, integer *info);
+
+/* Subroutine */ int slasd1_(integer *nl, integer *nr, integer *sqre, real *
+ d__, real *alpha, real *beta, real *u, integer *ldu, real *vt,
+ integer *ldvt, integer *idxq, integer *iwork, real *work, integer *
+ info);
+
+/* Subroutine */ int slasd2_(integer *nl, integer *nr, integer *sqre, integer
+ *k, real *d__, real *z__, real *alpha, real *beta, real *u, integer *
+ ldu, real *vt, integer *ldvt, real *dsigma, real *u2, integer *ldu2,
+ real *vt2, integer *ldvt2, integer *idxp, integer *idx, integer *idxc,
+ integer *idxq, integer *coltyp, integer *info);
+
+/* Subroutine */ int slasd3_(integer *nl, integer *nr, integer *sqre, integer
+ *k, real *d__, real *q, integer *ldq, real *dsigma, real *u, integer *
+ ldu, real *u2, integer *ldu2, real *vt, integer *ldvt, real *vt2,
+ integer *ldvt2, integer *idxc, integer *ctot, real *z__, integer *
+ info);
+
+/* Subroutine */ int slasd4_(integer *n, integer *i__, real *d__, real *z__,
+ real *delta, real *rho, real *sigma, real *work, integer *info);
+
+/* Subroutine */ int slasd5_(integer *i__, real *d__, real *z__, real *delta,
+ real *rho, real *dsigma, real *work);
+
+/* Subroutine */ int slasd6_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, real *d__, real *vf, real *vl, real *alpha, real *beta,
+ integer *idxq, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
+ difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int slasd7_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *k, real *d__, real *z__, real *zw, real *vf,
+ real *vfw, real *vl, real *vlw, real *alpha, real *beta, real *dsigma,
+ integer *idx, integer *idxp, integer *idxq, integer *perm, integer *
+ givptr, integer *givcol, integer *ldgcol, real *givnum, integer *
+ ldgnum, real *c__, real *s, integer *info);
+
+/* Subroutine */ int slasd8_(integer *icompq, integer *k, real *d__, real *
+ z__, real *vf, real *vl, real *difl, real *difr, integer *lddifr,
+ real *dsigma, real *work, integer *info);
+
+/* Subroutine */ int slasd9_(integer *icompq, integer *ldu, integer *k, real *
+ d__, real *z__, real *vf, real *vl, real *difl, real *difr, real *
+ dsigma, real *work, integer *info);
+
+/* Subroutine */ int slasda_(integer *icompq, integer *smlsiz, integer *n,
+ integer *sqre, real *d__, real *e, real *u, integer *ldu, real *vt,
+ integer *k, real *difl, real *difr, real *z__, real *poles, integer *
+ givptr, integer *givcol, integer *ldgcol, integer *perm, real *givnum,
+ real *c__, real *s, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slasdq_(char *uplo, integer *sqre, integer *n, integer *
+ ncvt, integer *nru, integer *ncc, real *d__, real *e, real *vt,
+ integer *ldvt, real *u, integer *ldu, real *c__, integer *ldc, real *
+ work, integer *info);
+
+/* Subroutine */ int slasdt_(integer *n, integer *lvl, integer *nd, integer *
+ inode, integer *ndiml, integer *ndimr, integer *msub);
+
+/* Subroutine */ int slaset_(char *uplo, integer *m, integer *n, real *alpha,
+ real *beta, real *a, integer *lda);
+
+/* Subroutine */ int slasq1_(integer *n, real *d__, real *e, real *work,
+ integer *info);
+
+/* Subroutine */ int slasq2_(integer *n, real *z__, integer *info);
+
+/* Subroutine */ int slasq3_(integer *i0, integer *n0, real *z__, integer *pp,
+ real *dmin__, real *sigma, real *desig, real *qmax, integer *nfail,
+ integer *iter, integer *ndiv, logical *ieee);
+
+/* Subroutine */ int slasq4_(integer *i0, integer *n0, real *z__, integer *pp,
+ integer *n0in, real *dmin__, real *dmin1, real *dmin2, real *dn,
+ real *dn1, real *dn2, real *tau, integer *ttype);
+
+/* Subroutine */ int slasq5_(integer *i0, integer *n0, real *z__, integer *pp,
+ real *tau, real *dmin__, real *dmin1, real *dmin2, real *dn, real *
+ dnm1, real *dnm2, logical *ieee);
+
+/* Subroutine */ int slasq6_(integer *i0, integer *n0, real *z__, integer *pp,
+ real *dmin__, real *dmin1, real *dmin2, real *dn, real *dnm1, real *
+ dnm2);
+
+/* Subroutine */ int slasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, real *c__, real *s, real *a, integer *lda);
+
+/* Subroutine */ int slasrt_(char *id, integer *n, real *d__, integer *info);
+
+/* Subroutine */ int slassq_(integer *n, real *x, integer *incx, real *scale,
+ real *sumsq);
+
+/* Subroutine */ int slasv2_(real *f, real *g, real *h__, real *ssmin, real *
+ ssmax, real *snr, real *csr, real *snl, real *csl);
+
+/* Subroutine */ int slaswp_(integer *n, real *a, integer *lda, integer *k1,
+ integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int slasy2_(logical *ltranl, logical *ltranr, integer *isgn,
+ integer *n1, integer *n2, real *tl, integer *ldtl, real *tr, integer *
+ ldtr, real *b, integer *ldb, real *scale, real *x, integer *ldx, real
+ *xnorm, integer *info);
+
+/* Subroutine */ int slasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ real *a, integer *lda, integer *ipiv, real *w, integer *ldw, integer
+ *info);
+
+/* Subroutine */ int slatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, real *ab, integer *ldab, real *x,
+ real *scale, real *cnorm, integer *info);
+
+/* Subroutine */ int slatdf_(integer *ijob, integer *n, real *z__, integer *
+ ldz, real *rhs, real *rdsum, real *rdscal, integer *ipiv, integer *
+ jpiv);
+
+/* Subroutine */ int slatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, real *ap, real *x, real *scale, real *cnorm,
+ integer *info);
+
+/* Subroutine */ int slatrd_(char *uplo, integer *n, integer *nb, real *a,
+ integer *lda, real *e, real *tau, real *w, integer *ldw);
+
+/* Subroutine */ int slatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, real *a, integer *lda, real *x, real *scale, real
+ *cnorm, integer *info);
+
+/* Subroutine */ int slatrz_(integer *m, integer *n, integer *l, real *a,
+ integer *lda, real *tau, real *work);
+
+/* Subroutine */ int slatzm_(char *side, integer *m, integer *n, real *v,
+ integer *incv, real *tau, real *c1, real *c2, integer *ldc, real *
+ work);
+
+/* Subroutine */ int slauu2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int slauum_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int sopgtr_(char *uplo, integer *n, real *ap, real *tau,
+ real *q, integer *ldq, real *work, integer *info);
+
+/* Subroutine */ int sopmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, real *ap, real *tau, real *c__, integer *ldc, real *work,
+ integer *info);
+
+/* Subroutine */ int sorg2l_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorg2r_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorgbr_(char *vect, integer *m, integer *n, integer *k,
+ real *a, integer *lda, real *tau, real *work, integer *lwork, integer
+ *info);
+
+/* Subroutine */ int sorghr_(integer *n, integer *ilo, integer *ihi, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgl2_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorglq_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgql_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgqr_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgr2_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorgrq_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgtr_(char *uplo, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sorm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sormbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, real *a, integer *lda, real *tau, real *c__,
+ integer *ldc, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, real *a, integer *lda, real *tau, real *
+ c__, integer *ldc, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sormlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sormr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, real *a, integer *lda, real *tau, real *c__,
+ integer *ldc, real *work, integer *info);
+
+/* Subroutine */ int sormrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, real *a, integer *lda, real *tau, real *c__,
+ integer *ldc, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int spbcon_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, real *anorm, real *rcond, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int spbequ_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, real *s, real *scond, real *amax, integer *info);
+
+/* Subroutine */ int spbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, real *ab, integer *ldab, real *afb, integer *ldafb, real *b,
+ integer *ldb, real *x, integer *ldx, real *ferr, real *berr, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int spbstf_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int spbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, real *ab, integer *ldab, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int spbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, real *ab, integer *ldab, real *afb, integer *ldafb,
+ char *equed, real *s, real *b, integer *ldb, real *x, integer *ldx,
+ real *rcond, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int spbtf2_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int spbtrf_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int spbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, real *ab, integer *ldab, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int spocon_(char *uplo, integer *n, real *a, integer *lda,
+ real *anorm, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int spoequ_(integer *n, real *a, integer *lda, real *s, real
+ *scond, real *amax, integer *info);
+
+/* Subroutine */ int sporfs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *af, integer *ldaf, real *b, integer *ldb, real *x,
+ integer *ldx, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int sposv_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, char *equed,
+ real *s, real *b, integer *ldb, real *x, integer *ldx, real *rcond,
+ real *ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int spotf2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int spotrf_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int spotri_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sppcon_(char *uplo, integer *n, real *ap, real *anorm,
+ real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sppequ_(char *uplo, integer *n, real *ap, real *s, real *
+ scond, real *amax, integer *info);
+
+/* Subroutine */ int spprfs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *afp, real *b, integer *ldb, real *x, integer *ldx, real *ferr,
+ real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sppsv_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *ap, real *afp, char *equed, real *s, real *b, integer *
+ ldb, real *x, integer *ldx, real *rcond, real *ferr, real *berr, real
+ *work, integer *iwork, integer *info);
+
+/* Subroutine */ int spptrf_(char *uplo, integer *n, real *ap, integer *info);
+
+/* Subroutine */ int spptri_(char *uplo, integer *n, real *ap, integer *info);
+
+/* Subroutine */ int spptrs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sptcon_(integer *n, real *d__, real *e, real *anorm,
+ real *rcond, real *work, integer *info);
+
+/* Subroutine */ int spteqr_(char *compz, integer *n, real *d__, real *e,
+ real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int sptrfs_(integer *n, integer *nrhs, real *d__, real *e,
+ real *df, real *ef, real *b, integer *ldb, real *x, integer *ldx,
+ real *ferr, real *berr, real *work, integer *info);
+
+/* Subroutine */ int sptsv_(integer *n, integer *nrhs, real *d__, real *e,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sptsvx_(char *fact, integer *n, integer *nrhs, real *d__,
+ real *e, real *df, real *ef, real *b, integer *ldb, real *x, integer
+ *ldx, real *rcond, real *ferr, real *berr, real *work, integer *info);
+
+/* Subroutine */ int spttrf_(integer *n, real *d__, real *e, integer *info);
+
+/* Subroutine */ int spttrs_(integer *n, integer *nrhs, real *d__, real *e,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sptts2_(integer *n, integer *nrhs, real *d__, real *e,
+ real *b, integer *ldb);
+
+/* Subroutine */ int srscl_(integer *n, real *sa, real *sx, integer *incx);
+
+/* Subroutine */ int ssbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ real *ab, integer *ldab, real *w, real *z__, integer *ldz, real *work,
+ integer *info);
+
+/* Subroutine */ int ssbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ real *ab, integer *ldab, real *w, real *z__, integer *ldz, real *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int ssbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, real *ab, integer *ldab, real *q, integer *ldq, real *vl,
+ real *vu, integer *il, integer *iu, real *abstol, integer *m, real *
+ w, real *z__, integer *ldz, real *work, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int ssbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, real *ab, integer *ldab, real *bb, integer *ldbb, real *
+ x, integer *ldx, real *work, integer *info);
+
+/* Subroutine */ int ssbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, real *ab, integer *ldab, real *bb, integer *ldbb, real *
+ w, real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int ssbgvd_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, real *ab, integer *ldab, real *bb, integer *ldbb, real *
+ w, real *z__, integer *ldz, real *work, integer *lwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int ssbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, real *ab, integer *ldab, real *bb, integer *
+ ldbb, real *q, integer *ldq, real *vl, real *vu, integer *il, integer
+ *iu, real *abstol, integer *m, real *w, real *z__, integer *ldz, real
+ *work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ real *ab, integer *ldab, real *d__, real *e, real *q, integer *ldq,
+ real *work, integer *info);
+
+/* Subroutine */ int sspcon_(char *uplo, integer *n, real *ap, integer *ipiv,
+ real *anorm, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sspev_(char *jobz, char *uplo, integer *n, real *ap,
+ real *w, real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int sspevd_(char *jobz, char *uplo, integer *n, real *ap,
+ real *w, real *z__, integer *ldz, real *work, integer *lwork, integer
+ *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sspevx_(char *jobz, char *range, char *uplo, integer *n,
+ real *ap, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, real *work, integer *
+ iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int sspgst_(integer *itype, char *uplo, integer *n, real *ap,
+ real *bp, integer *info);
+
+/* Subroutine */ int sspgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *ap, real *bp, real *w, real *z__, integer *ldz, real *work,
+ integer *info);
+
+/* Subroutine */ int sspgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *ap, real *bp, real *w, real *z__, integer *ldz, real *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sspgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, real *ap, real *bp, real *vl, real *vu, integer *il,
+ integer *iu, real *abstol, integer *m, real *w, real *z__, integer *
+ ldz, real *work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssprfs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *afp, integer *ipiv, real *b, integer *ldb, real *x, integer *
+ ldx, real *ferr, real *berr, real *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int sspsv_(char *uplo, integer *n, integer *nrhs, real *ap,
+ integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *ap, real *afp, integer *ipiv, real *b, integer *ldb, real
+ *x, integer *ldx, real *rcond, real *ferr, real *berr, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int ssptrd_(char *uplo, integer *n, real *ap, real *d__,
+ real *e, real *tau, integer *info);
+
+/* Subroutine */ int ssptrf_(char *uplo, integer *n, real *ap, integer *ipiv,
+ integer *info);
+
+/* Subroutine */ int ssptri_(char *uplo, integer *n, real *ap, integer *ipiv,
+ real *work, integer *info);
+
+/* Subroutine */ int ssptrs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sstebz_(char *range, char *order, integer *n, real *vl,
+ real *vu, integer *il, integer *iu, real *abstol, real *d__, real *e,
+ integer *m, integer *nsplit, real *w, integer *iblock, integer *
+ isplit, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sstedc_(char *compz, integer *n, real *d__, real *e,
+ real *z__, integer *ldz, real *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int sstegr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, integer *isuppz, real *
+ work, integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sstein_(integer *n, real *d__, real *e, integer *m, real
+ *w, integer *iblock, integer *isplit, real *z__, integer *ldz, real *
+ work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssteqr_(char *compz, integer *n, real *d__, real *e,
+ real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int ssterf_(integer *n, real *d__, real *e, integer *info);
+
+/* Subroutine */ int sstev_(char *jobz, integer *n, real *d__, real *e, real *
+ z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int sstevd_(char *jobz, integer *n, real *d__, real *e, real
+ *z__, integer *ldz, real *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int sstevr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, integer *isuppz, real *
+ work, integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sstevx_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, real *work, integer *
+ iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssycon_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, real *anorm, real *rcond, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int ssyev_(char *jobz, char *uplo, integer *n, real *a,
+ integer *lda, real *w, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int ssyevd_(char *jobz, char *uplo, integer *n, real *a,
+ integer *lda, real *w, real *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int ssyevr_(char *jobz, char *range, char *uplo, integer *n,
+ real *a, integer *lda, real *vl, real *vu, integer *il, integer *iu,
+ real *abstol, integer *m, real *w, real *z__, integer *ldz, integer *
+ isuppz, real *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int ssyevx_(char *jobz, char *range, char *uplo, integer *n,
+ real *a, integer *lda, real *vl, real *vu, integer *il, integer *iu,
+ real *abstol, integer *m, real *w, real *z__, integer *ldz, real *
+ work, integer *lwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssygs2_(integer *itype, char *uplo, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ssygst_(integer *itype, char *uplo, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ssygv_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *w, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int ssygvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *w, real *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int ssygvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, real *a, integer *lda, real *b, integer *ldb, real *
+ vl, real *vu, integer *il, integer *iu, real *abstol, integer *m,
+ real *w, real *z__, integer *ldz, real *work, integer *lwork, integer
+ *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssyrfs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *af, integer *ldaf, integer *ipiv, real *b,
+ integer *ldb, real *x, integer *ldx, real *ferr, real *berr, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int ssysv_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, integer *ipiv, real *b, integer *ldb, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int ssysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ real *b, integer *ldb, real *x, integer *ldx, real *rcond, real *ferr,
+ real *berr, real *work, integer *lwork, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int ssytd2_(char *uplo, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tau, integer *info);
+
+/* Subroutine */ int ssytf2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int ssytrd_(char *uplo, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tau, real *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int ssytrf_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int ssytri_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, real *work, integer *info);
+
+/* Subroutine */ int ssytrs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int stbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, real *ab, integer *ldab, real *rcond, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int stbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, real *ab, integer *ldab, real *b, integer
+ *ldb, real *x, integer *ldx, real *ferr, real *berr, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int stbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, real *ab, integer *ldab, real *b, integer
+ *ldb, integer *info);
+
+/* Subroutine */ int stgevc_(char *side, char *howmny, logical *select,
+ integer *n, real *a, integer *lda, real *b, integer *ldb, real *vl,
+ integer *ldvl, real *vr, integer *ldvr, integer *mm, integer *m, real
+ *work, integer *info);
+
+/* Subroutine */ int stgex2_(logical *wantq, logical *wantz, integer *n, real
+ *a, integer *lda, real *b, integer *ldb, real *q, integer *ldq, real *
+ z__, integer *ldz, integer *j1, integer *n1, integer *n2, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int stgexc_(logical *wantq, logical *wantz, integer *n, real
+ *a, integer *lda, real *b, integer *ldb, real *q, integer *ldq, real *
+ z__, integer *ldz, integer *ifst, integer *ilst, real *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int stgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, real *a, integer *lda, real *b, integer *
+ ldb, real *alphar, real *alphai, real *beta, real *q, integer *ldq,
+ real *z__, integer *ldz, integer *m, real *pl, real *pr, real *dif,
+ real *work, integer *lwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int stgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, real *a, integer *lda,
+ real *b, integer *ldb, real *tola, real *tolb, real *alpha, real *
+ beta, real *u, integer *ldu, real *v, integer *ldv, real *q, integer *
+ ldq, real *work, integer *ncycle, integer *info);
+
+/* Subroutine */ int stgsna_(char *job, char *howmny, logical *select,
+ integer *n, real *a, integer *lda, real *b, integer *ldb, real *vl,
+ integer *ldvl, real *vr, integer *ldvr, real *s, real *dif, integer *
+ mm, integer *m, real *work, integer *lwork, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int stgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *c__, integer *
+ ldc, real *d__, integer *ldd, real *e, integer *lde, real *f, integer
+ *ldf, real *scale, real *rdsum, real *rdscal, integer *iwork, integer
+ *pq, integer *info);
+
+/* Subroutine */ int stgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *c__, integer *
+ ldc, real *d__, integer *ldd, real *e, integer *lde, real *f, integer
+ *ldf, real *scale, real *dif, real *work, integer *lwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int stpcon_(char *norm, char *uplo, char *diag, integer *n,
+ real *ap, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int stprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *ap, real *b, integer *ldb, real *x, integer *ldx,
+ real *ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int stptri_(char *uplo, char *diag, integer *n, real *ap,
+ integer *info);
+
+/* Subroutine */ int stptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *ap, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int strcon_(char *norm, char *uplo, char *diag, integer *n,
+ real *a, integer *lda, real *rcond, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int strevc_(char *side, char *howmny, logical *select,
+ integer *n, real *t, integer *ldt, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, integer *mm, integer *m, real *work, integer *info);
+
+/* Subroutine */ int strexc_(char *compq, integer *n, real *t, integer *ldt,
+ real *q, integer *ldq, integer *ifst, integer *ilst, real *work,
+ integer *info);
+
+/* Subroutine */ int strrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *a, integer *lda, real *b, integer *ldb, real *x,
+ integer *ldx, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int strsen_(char *job, char *compq, logical *select, integer
+ *n, real *t, integer *ldt, real *q, integer *ldq, real *wr, real *wi,
+ integer *m, real *s, real *sep, real *work, integer *lwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int strsna_(char *job, char *howmny, logical *select,
+ integer *n, real *t, integer *ldt, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, real *s, real *sep, integer *mm, integer *m, real *
+ work, integer *ldwork, integer *iwork, integer *info);
+
+/* Subroutine */ int strsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, real *a, integer *lda, real *b, integer *ldb, real *
+ c__, integer *ldc, real *scale, integer *info);
+
+/* Subroutine */ int strti2_(char *uplo, char *diag, integer *n, real *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int strtri_(char *uplo, char *diag, integer *n, real *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int strtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *a, integer *lda, real *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int stzrqf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, integer *info);
+
+/* Subroutine */ int stzrzf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int xerbla_(char *srname, integer *info);
+
+/* Subroutine */ int zbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, doublereal *d__, doublereal *e, doublecomplex *vt,
+ integer *ldvt, doublecomplex *u, integer *ldu, doublecomplex *c__,
+ integer *ldc, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zdrot_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s);
+
+/* Subroutine */ int zdrscl_(integer *n, doublereal *sa, doublecomplex *sx,
+ integer *incx);
+
+/* Subroutine */ int zgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, doublecomplex *ab, integer *ldab,
+ doublereal *d__, doublereal *e, doublecomplex *q, integer *ldq,
+ doublecomplex *pt, integer *ldpt, doublecomplex *c__, integer *ldc,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, integer *ipiv, doublereal *anorm,
+ doublereal *rcond, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, integer *
+ info);
+
+/* Subroutine */ int zgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublecomplex *ab, integer *ldab, doublecomplex *
+ afb, integer *ldafb, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, doublecomplex *ab, integer *ldab, integer *ipiv, doublecomplex *
+ b, integer *ldb, integer *info);
+
+/* Subroutine */ int zgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *afb, integer *ldafb, integer *ipiv, char *equed,
+ doublereal *r__, doublereal *c__, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublecomplex *ab, integer *ldab, integer *ipiv,
+ doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *scale, integer *m, doublecomplex *v,
+ integer *ldv, integer *info);
+
+/* Subroutine */ int zgebal_(char *job, integer *n, doublecomplex *a, integer
+ *lda, integer *ilo, integer *ihi, doublereal *scale, integer *info);
+
+/* Subroutine */ int zgebd2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq,
+ doublecomplex *taup, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgebrd_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq,
+ doublecomplex *taup, doublecomplex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int zgecon_(char *norm, integer *n, doublecomplex *a,
+ integer *lda, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeequ_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd,
+ doublereal *colcnd, doublereal *amax, integer *info);
+
+/* Subroutine */ int zgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w,
+ doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork,
+ doublereal *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, doublecomplex *a, integer *lda, integer *sdim,
+ doublecomplex *w, doublecomplex *vs, integer *ldvs, doublereal *
+ rconde, doublereal *rcondv, doublecomplex *work, integer *lwork,
+ doublereal *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zgeev_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *w, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublecomplex *a, integer *lda, doublecomplex *w,
+ doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *ldvr,
+ integer *ilo, integer *ihi, doublereal *scale, doublereal *abnrm,
+ doublereal *rconde, doublereal *rcondv, doublecomplex *work, integer *
+ lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgegs_(char *jobvsl, char *jobvsr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *vsl,
+ integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublecomplex *
+ work, integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgegv_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *vl, integer
+ *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work, integer
+ *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgehd2_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zgehrd_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgelq2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgelqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgelsx_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *jpvt, doublereal *rcond, integer *rank, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgelsy_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *jpvt, doublereal *rcond, integer *rank, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeql2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgeqlf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgeqp3_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *jpvt, doublecomplex *tau, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeqpf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *jpvt, doublecomplex *tau, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeqr2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgeqrf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgerfs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgerq2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgerqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgesc2_(integer *n, doublecomplex *a, integer *lda,
+ doublecomplex *rhs, integer *ipiv, integer *jpiv, doublereal *scale);
+
+/* Subroutine */ int zgesv_(integer *n, integer *nrhs, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int zgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, char *equed, doublereal *r__, doublereal *c__,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgetc2_(integer *n, doublecomplex *a, integer *lda,
+ integer *ipiv, integer *jpiv, integer *info);
+
+/* Subroutine */ int zgetf2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgetrf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgetri_(integer *n, doublecomplex *a, integer *lda,
+ integer *ipiv, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgetrs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int zggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *lscale, doublereal *rscale, integer *m,
+ doublecomplex *v, integer *ldv, integer *info);
+
+/* Subroutine */ int zggbal_(char *job, integer *n, doublecomplex *a, integer
+ *lda, doublecomplex *b, integer *ldb, integer *ilo, integer *ihi,
+ doublereal *lscale, doublereal *rscale, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int zgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ delctg, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex *
+ beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer
+ *ldvsr, doublecomplex *work, integer *lwork, doublereal *rwork,
+ logical *bwork, integer *info);
+
+/* Subroutine */ int zggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ delctg, char *sense, integer *n, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha,
+ doublecomplex *beta, doublecomplex *vsl, integer *ldvsl,
+ doublecomplex *vsr, integer *ldvsr, doublereal *rconde, doublereal *
+ rcondv, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *iwork, integer *liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zggev_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *vl, integer
+ *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work, integer
+ *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *alpha, doublecomplex *beta,
+ doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *ldvr,
+ integer *ilo, integer *ihi, doublereal *lscale, doublereal *rscale,
+ doublereal *abnrm, doublereal *bbnrm, doublereal *rconde, doublereal *
+ rcondv, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *iwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zggglm_(integer *n, integer *m, integer *p,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *d__, doublecomplex *x, doublecomplex *y, doublecomplex
+ *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__,
+ integer *ldz, integer *info);
+
+/* Subroutine */ int zgglse_(integer *m, integer *n, integer *p,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *c__, doublecomplex *d__, doublecomplex *x,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zggqrf_(integer *n, integer *m, integer *p,
+ doublecomplex *a, integer *lda, doublecomplex *taua, doublecomplex *b,
+ integer *ldb, doublecomplex *taub, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zggrqf_(integer *m, integer *p, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *taua, doublecomplex *b,
+ integer *ldb, doublecomplex *taub, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb, doublereal *alpha,
+ doublereal *beta, doublecomplex *u, integer *ldu, doublecomplex *v,
+ integer *ldv, doublecomplex *q, integer *ldq, doublecomplex *work,
+ doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, doublecomplex *a, integer *lda, doublecomplex
+ *b, integer *ldb, doublereal *tola, doublereal *tolb, integer *k,
+ integer *l, doublecomplex *u, integer *ldu, doublecomplex *v, integer
+ *ldv, doublecomplex *q, integer *ldq, integer *iwork, doublereal *
+ rwork, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgtcon_(char *norm, integer *n, doublecomplex *dl,
+ doublecomplex *d__, doublecomplex *du, doublecomplex *du2, integer *
+ ipiv, doublereal *anorm, doublereal *rcond, doublecomplex *work,
+ integer *info);
+
+/* Subroutine */ int zgtrfs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *dlf, doublecomplex *df, doublecomplex *duf,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgtsv_(integer *n, integer *nrhs, doublecomplex *dl,
+ doublecomplex *d__, doublecomplex *du, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *dlf, doublecomplex *df, doublecomplex *duf,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zgttrf_(integer *n, doublecomplex *dl, doublecomplex *
+ d__, doublecomplex *du, doublecomplex *du2, integer *ipiv, integer *
+ info);
+
+/* Subroutine */ int zgttrs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zgtts2_(integer *itrans, integer *n, integer *nrhs,
+ doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zhbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, doublecomplex *ab, integer *ldab, doublecomplex *q,
+ integer *ldq, doublereal *vl, doublereal *vu, integer *il, integer *
+ iu, doublereal *abstol, integer *m, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, doublereal *rwork, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int zhbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, doublecomplex *ab, integer *ldab, doublecomplex *bb,
+ integer *ldbb, doublecomplex *x, integer *ldx, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublecomplex *ab, integer *ldab, doublecomplex *bb,
+ integer *ldbb, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, doublecomplex *ab, integer *ldab,
+ doublecomplex *bb, integer *ldbb, doublecomplex *q, integer *ldq,
+ doublereal *vl, doublereal *vu, integer *il, integer *iu, doublereal *
+ abstol, integer *m, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, doublereal *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int zhbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *d__, doublereal *e,
+ doublecomplex *q, integer *ldq, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zhecon_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublereal *anorm, doublereal *rcond,
+ doublecomplex *work, integer *info);
+
+/* Subroutine */ int zheev_(char *jobz, char *uplo, integer *n, doublecomplex
+ *a, integer *lda, doublereal *w, doublecomplex *work, integer *lwork,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zheevd_(char *jobz, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *w, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *lrwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int zheevr_(char *jobz, char *range, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *vl, doublereal *vu,
+ integer *il, integer *iu, doublereal *abstol, integer *m, doublereal *
+ w, doublecomplex *z__, integer *ldz, integer *isuppz, doublecomplex *
+ work, integer *lwork, doublereal *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zheevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *vl, doublereal *vu,
+ integer *il, integer *iu, doublereal *abstol, integer *m, doublereal *
+ w, doublecomplex *z__, integer *ldz, doublecomplex *work, integer *
+ lwork, doublereal *rwork, integer *iwork, integer *ifail, integer *
+ info);
+
+/* Subroutine */ int zhegs2_(integer *itype, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhegst_(integer *itype, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhegv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *w, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zhegvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *w, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhegvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublereal *vl, doublereal *vu, integer *il, integer *
+ iu, doublereal *abstol, integer *m, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int zherfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhesv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zhesvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *rcond, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhetf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zhetrd_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zhetrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zhetri_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zhetrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int zhgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex *
+ beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *
+ ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zhpcon_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zhpev_(char *jobz, char *uplo, integer *n, doublecomplex
+ *ap, doublereal *w, doublecomplex *z__, integer *ldz, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhpevd_(char *jobz, char *uplo, integer *n,
+ doublecomplex *ap, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *
+ lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhpevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublecomplex *ap, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublecomplex *z__, integer *ldz, doublecomplex *work, doublereal *
+ rwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int zhpgst_(integer *itype, char *uplo, integer *n,
+ doublecomplex *ap, doublecomplex *bp, integer *info);
+
+/* Subroutine */ int zhpgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *ap, doublecomplex *bp, doublereal *w, doublecomplex
+ *z__, integer *ldz, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zhpgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *ap, doublecomplex *bp, doublereal *w, doublecomplex
+ *z__, integer *ldz, doublecomplex *work, integer *lwork, doublereal *
+ rwork, integer *lrwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int zhpgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublecomplex *ap, doublecomplex *bp, doublereal *
+ vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol,
+ integer *m, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, doublereal *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int zhprfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *afp, integer *ipiv, doublecomplex *
+ b, integer *ldb, doublecomplex *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zhpsv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhpsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *ap, doublecomplex *afp, integer *ipiv,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhptrd_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *d__, doublereal *e, doublecomplex *tau, integer *info);
+
+/* Subroutine */ int zhptrf_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int zhptri_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zhptrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, doublecomplex *h__, integer *ldh, doublecomplex *
+ w, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *ldvr,
+ integer *mm, integer *m, doublecomplex *work, doublereal *rwork,
+ integer *ifaill, integer *ifailr, integer *info);
+
+/* Subroutine */ int zhseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, doublecomplex *h__, integer *ldh, doublecomplex *w,
+ doublecomplex *z__, integer *ldz, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zlabrd_(integer *m, integer *n, integer *nb,
+ doublecomplex *a, integer *lda, doublereal *d__, doublereal *e,
+ doublecomplex *tauq, doublecomplex *taup, doublecomplex *x, integer *
+ ldx, doublecomplex *y, integer *ldy);
+
+/* Subroutine */ int zlacgv_(integer *n, doublecomplex *x, integer *incx);
+
+/* Subroutine */ int zlacon_(integer *n, doublecomplex *v, doublecomplex *x,
+ doublereal *est, integer *kase);
+
+/* Subroutine */ int zlacp2_(char *uplo, integer *m, integer *n, doublereal *
+ a, integer *lda, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zlacpy_(char *uplo, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zlacrm_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *b, integer *ldb, doublecomplex *c__,
+ integer *ldc, doublereal *rwork);
+
+/* Subroutine */ int zlacrt_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublecomplex *c__, doublecomplex *
+ s);
+
+/* Subroutine */ int zlaed0_(integer *qsiz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *q, integer *ldq, doublecomplex *qstore,
+ integer *ldqs, doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zlaed7_(integer *n, integer *cutpnt, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, doublereal *d__,
+ doublecomplex *q, integer *ldq, doublereal *rho, integer *indxq,
+ doublereal *qstore, integer *qptr, integer *prmptr, integer *perm,
+ integer *givptr, integer *givcol, doublereal *givnum, doublecomplex *
+ work, doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zlaed8_(integer *k, integer *n, integer *qsiz,
+ doublecomplex *q, integer *ldq, doublereal *d__, doublereal *rho,
+ integer *cutpnt, doublereal *z__, doublereal *dlamda, doublecomplex *
+ q2, integer *ldq2, doublereal *w, integer *indxp, integer *indx,
+ integer *indxq, integer *perm, integer *givptr, integer *givcol,
+ doublereal *givnum, integer *info);
+
+/* Subroutine */ int zlaein_(logical *rightv, logical *noinit, integer *n,
+ doublecomplex *h__, integer *ldh, doublecomplex *w, doublecomplex *v,
+ doublecomplex *b, integer *ldb, doublereal *rwork, doublereal *eps3,
+ doublereal *smlnum, integer *info);
+
+/* Subroutine */ int zlaesy_(doublecomplex *a, doublecomplex *b,
+ doublecomplex *c__, doublecomplex *rt1, doublecomplex *rt2,
+ doublecomplex *evscal, doublecomplex *cs1, doublecomplex *sn1);
+
+/* Subroutine */ int zlaev2_(doublecomplex *a, doublecomplex *b,
+ doublecomplex *c__, doublereal *rt1, doublereal *rt2, doublereal *cs1,
+ doublecomplex *sn1);
+
+/* Subroutine */ int zlags2_(logical *upper, doublereal *a1, doublecomplex *
+ a2, doublereal *a3, doublereal *b1, doublecomplex *b2, doublereal *b3,
+ doublereal *csu, doublecomplex *snu, doublereal *csv, doublecomplex *
+ snv, doublereal *csq, doublecomplex *snq);
+
+/* Subroutine */ int zlagtm_(char *trans, integer *n, integer *nrhs,
+ doublereal *alpha, doublecomplex *dl, doublecomplex *d__,
+ doublecomplex *du, doublecomplex *x, integer *ldx, doublereal *beta,
+ doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *w,
+ integer *ldw, integer *info);
+
+/* Subroutine */ int zlahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
+ doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, integer *info);
+
+/* Subroutine */ int zlahrd_(integer *n, integer *k, integer *nb,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *t,
+ integer *ldt, doublecomplex *y, integer *ldy);
+
+/* Subroutine */ int zlaic1_(integer *job, integer *j, doublecomplex *x,
+ doublereal *sest, doublecomplex *w, doublecomplex *gamma, doublereal *
+ sestpr, doublecomplex *s, doublecomplex *c__);
+
+/* Subroutine */ int zlals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, doublecomplex *b, integer *ldb,
+ doublecomplex *bx, integer *ldbx, integer *perm, integer *givptr,
+ integer *givcol, integer *ldgcol, doublereal *givnum, integer *ldgnum,
+ doublereal *poles, doublereal *difl, doublereal *difr, doublereal *
+ z__, integer *k, doublereal *c__, doublereal *s, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zlalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, doublecomplex *b, integer *ldb, doublecomplex *bx,
+ integer *ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *
+ k, doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
+ poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
+ perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
+ rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zlapll_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublereal *ssmin);
+
+/* Subroutine */ int zlapmt_(logical *forwrd, integer *m, integer *n,
+ doublecomplex *x, integer *ldx, integer *k);
+
+/* Subroutine */ int zlaqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqge_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd,
+ doublereal *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqhb_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *s, doublereal *scond,
+ doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqhe_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *s, doublereal *scond, doublereal *amax,
+ char *equed);
+
+/* Subroutine */ int zlaqhp_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqp2_(integer *m, integer *n, integer *offset,
+ doublecomplex *a, integer *lda, integer *jpvt, doublecomplex *tau,
+ doublereal *vn1, doublereal *vn2, doublecomplex *work);
+
+/* Subroutine */ int zlaqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, doublecomplex *a, integer *lda, integer *jpvt,
+ doublecomplex *tau, doublereal *vn1, doublereal *vn2, doublecomplex *
+ auxv, doublecomplex *f, integer *ldf);
+
+/* Subroutine */ int zlaqsb_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *s, doublereal *scond,
+ doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqsp_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqsy_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *s, doublereal *scond, doublereal *amax,
+ char *equed);
+
+/* Subroutine */ int zlar1v_(integer *n, integer *b1, integer *bn, doublereal
+ *sigma, doublereal *d__, doublereal *l, doublereal *ld, doublereal *
+ lld, doublereal *gersch, doublecomplex *z__, doublereal *ztz,
+ doublereal *mingma, integer *r__, integer *isuppz, doublereal *work);
+
+/* Subroutine */ int zlar2v_(integer *n, doublecomplex *x, doublecomplex *y,
+ doublecomplex *z__, integer *incx, doublereal *c__, doublecomplex *s,
+ integer *incc);
+
+/* Subroutine */ int zlarcm_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc,
+ doublereal *rwork);
+
+/* Subroutine */ int zlarf_(char *side, integer *m, integer *n, doublecomplex
+ *v, integer *incv, doublecomplex *tau, doublecomplex *c__, integer *
+ ldc, doublecomplex *work);
+
+/* Subroutine */ int zlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublecomplex *v, integer
+ *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, integer *
+ ldc, doublecomplex *work, integer *ldwork);
+
+/* Subroutine */ int zlarfg_(integer *n, doublecomplex *alpha, doublecomplex *
+ x, integer *incx, doublecomplex *tau);
+
+/* Subroutine */ int zlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *
+ t, integer *ldt);
+
+/* Subroutine */ int zlarfx_(char *side, integer *m, integer *n,
+ doublecomplex *v, doublecomplex *tau, doublecomplex *c__, integer *
+ ldc, doublecomplex *work);
+
+/* Subroutine */ int zlargv_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublereal *c__, integer *incc);
+
+/* Subroutine */ int zlarnv_(integer *idist, integer *iseed, integer *n,
+ doublecomplex *x);
+
+/* Subroutine */ int zlarrv_(integer *n, doublereal *d__, doublereal *l,
+ integer *isplit, integer *m, doublereal *w, integer *iblock,
+ doublereal *gersch, doublereal *tol, doublecomplex *z__, integer *ldz,
+ integer *isuppz, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int zlartg_(doublecomplex *f, doublecomplex *g, doublereal *
+ cs, doublecomplex *sn, doublecomplex *r__);
+
+/* Subroutine */ int zlartv_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublereal *c__, doublecomplex *s,
+ integer *incc);
+
+/* Subroutine */ int zlarz_(char *side, integer *m, integer *n, integer *l,
+ doublecomplex *v, integer *incv, doublecomplex *tau, doublecomplex *
+ c__, integer *ldc, doublecomplex *work);
+
+/* Subroutine */ int zlarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, doublecomplex
+ *v, integer *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__,
+ integer *ldc, doublecomplex *work, integer *ldwork);
+
+/* Subroutine */ int zlarzt_(char *direct, char *storev, integer *n, integer *
+ k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *
+ t, integer *ldt);
+
+/* Subroutine */ int zlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int zlaset_(char *uplo, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *
+ lda);
+
+/* Subroutine */ int zlasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, doublereal *c__, doublereal *s, doublecomplex *a,
+ integer *lda);
+
+/* Subroutine */ int zlassq_(integer *n, doublecomplex *x, integer *incx,
+ doublereal *scale, doublereal *sumsq);
+
+/* Subroutine */ int zlaswp_(integer *n, doublecomplex *a, integer *lda,
+ integer *k1, integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *w,
+ integer *ldw, integer *info);
+
+/* Subroutine */ int zlatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, doublecomplex *ab, integer *ldab,
+ doublecomplex *x, doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int zlatdf_(integer *ijob, integer *n, doublecomplex *z__,
+ integer *ldz, doublecomplex *rhs, doublereal *rdsum, doublereal *
+ rdscal, integer *ipiv, integer *jpiv);
+
+/* Subroutine */ int zlatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublecomplex *ap, doublecomplex *x, doublereal *
+ scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int zlatrd_(char *uplo, integer *n, integer *nb,
+ doublecomplex *a, integer *lda, doublereal *e, doublecomplex *tau,
+ doublecomplex *w, integer *ldw);
+
+/* Subroutine */ int zlatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublecomplex *a, integer *lda, doublecomplex *x,
+ doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int zlatrz_(integer *m, integer *n, integer *l,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work);
+
+/* Subroutine */ int zlatzm_(char *side, integer *m, integer *n,
+ doublecomplex *v, integer *incv, doublecomplex *tau, doublecomplex *
+ c1, doublecomplex *c2, integer *ldc, doublecomplex *work);
+
+/* Subroutine */ int zlauu2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zlauum_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpbcon_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *anorm, doublereal *
+ rcond, doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpbequ_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *s, doublereal *scond,
+ doublereal *amax, integer *info);
+
+/* Subroutine */ int zpbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *
+ ldafb, doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int zpbstf_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, integer *info);
+
+/* Subroutine */ int zpbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublecomplex *ab, integer *ldab, doublecomplex *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int zpbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, doublecomplex *ab, integer *ldab, doublecomplex *afb,
+ integer *ldafb, char *equed, doublereal *s, doublecomplex *b, integer
+ *ldb, doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *
+ ferr, doublereal *berr, doublecomplex *work, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zpbtf2_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, integer *info);
+
+/* Subroutine */ int zpbtrf_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, integer *info);
+
+/* Subroutine */ int zpbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublecomplex *ab, integer *ldab, doublecomplex *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int zpocon_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpoequ_(integer *n, doublecomplex *a, integer *lda,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int zporfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int zposv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, char *equed, doublereal *s, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zpotf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpotrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpotri_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpotrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zppcon_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *anorm, doublereal *rcond, doublecomplex *work, doublereal
+ *rwork, integer *info);
+
+/* Subroutine */ int zppequ_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int zpprfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *afp, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zppsv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *ap, doublecomplex *afp, char *equed, doublereal *
+ s, doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpptrf_(char *uplo, integer *n, doublecomplex *ap,
+ integer *info);
+
+/* Subroutine */ int zpptri_(char *uplo, integer *n, doublecomplex *ap,
+ integer *info);
+
+/* Subroutine */ int zpptrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zptcon_(integer *n, doublereal *d__, doublecomplex *e,
+ doublereal *anorm, doublereal *rcond, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zptrfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublereal *df, doublecomplex *ef,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int zptsv_(integer *n, integer *nrhs, doublereal *d__,
+ doublecomplex *e, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zptsvx_(char *fact, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublereal *df, doublecomplex *ef,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpttrf_(integer *n, doublereal *d__, doublecomplex *e,
+ integer *info);
+
+/* Subroutine */ int zpttrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zptts2_(integer *iuplo, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zrot_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s);
+
+/* Subroutine */ int zspcon_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zspmv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex *
+ beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zspr_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *ap);
+
+/* Subroutine */ int zsprfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *afp, integer *ipiv, doublecomplex *
+ b, integer *ldb, doublecomplex *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zspsv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *ap, doublecomplex *afp, integer *ipiv,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsptrf_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int zsptri_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsptrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zstedc_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *lrwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int zstein_(integer *n, doublereal *d__, doublereal *e,
+ integer *m, doublereal *w, integer *iblock, integer *isplit,
+ doublecomplex *z__, integer *ldz, doublereal *work, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int zsteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int zsycon_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublereal *anorm, doublereal *rcond,
+ doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsymv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
+ doublecomplex *beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zsyr_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *a, integer *lda);
+
+/* Subroutine */ int zsyrfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsysv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zsysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *rcond, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsytf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zsytrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zsytri_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsytrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int ztbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, doublecomplex *ab, integer *ldab, doublereal *rcond,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int ztbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ztgevc_(char *side, char *howmny, logical *select,
+ integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer
+ *ldb, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *
+ ldvr, integer *mm, integer *m, doublecomplex *work, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int ztgex2_(logical *wantq, logical *wantz, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz,
+ integer *j1, integer *info);
+
+/* Subroutine */ int ztgexc_(logical *wantq, logical *wantz, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz,
+ integer *ifst, integer *ilst, integer *info);
+
+/* Subroutine */ int ztgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex *
+ beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *
+ ldz, integer *m, doublereal *pl, doublereal *pr, doublereal *dif,
+ doublecomplex *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int ztgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb, doublereal *tola,
+ doublereal *tolb, doublereal *alpha, doublereal *beta, doublecomplex *
+ u, integer *ldu, doublecomplex *v, integer *ldv, doublecomplex *q,
+ integer *ldq, doublecomplex *work, integer *ncycle, integer *info);
+
+/* Subroutine */ int ztgsna_(char *job, char *howmny, logical *select,
+ integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer
+ *ldb, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *
+ ldvr, doublereal *s, doublereal *dif, integer *mm, integer *m,
+ doublecomplex *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int ztgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *c__, integer *ldc, doublecomplex *d__, integer *ldd,
+ doublecomplex *e, integer *lde, doublecomplex *f, integer *ldf,
+ doublereal *scale, doublereal *rdsum, doublereal *rdscal, integer *
+ info);
+
+/* Subroutine */ int ztgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *c__, integer *ldc, doublecomplex *d__, integer *ldd,
+ doublecomplex *e, integer *lde, doublecomplex *f, integer *ldf,
+ doublereal *scale, doublereal *dif, doublecomplex *work, integer *
+ lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int ztpcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublecomplex *ap, doublereal *rcond, doublecomplex *work, doublereal
+ *rwork, integer *info);
+
+/* Subroutine */ int ztprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *ap, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztptri_(char *uplo, char *diag, integer *n,
+ doublecomplex *ap, integer *info);
+
+/* Subroutine */ int ztptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *ap, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int ztrcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *lda, doublereal *rcond, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztrevc_(char *side, char *howmny, logical *select,
+ integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, integer *mm, integer
+ *m, doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztrexc_(char *compq, integer *n, doublecomplex *t,
+ integer *ldt, doublecomplex *q, integer *ldq, integer *ifst, integer *
+ ilst, integer *info);
+
+/* Subroutine */ int ztrrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int ztrsen_(char *job, char *compq, logical *select, integer
+ *n, doublecomplex *t, integer *ldt, doublecomplex *q, integer *ldq,
+ doublecomplex *w, integer *m, doublereal *s, doublereal *sep,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int ztrsna_(char *job, char *howmny, logical *select,
+ integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, doublereal *s,
+ doublereal *sep, integer *mm, integer *m, doublecomplex *work,
+ integer *ldwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztrsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale,
+ integer *info);
+
+/* Subroutine */ int ztrti2_(char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ztrtri_(char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ztrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int ztzrqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, integer *info);
+
+/* Subroutine */ int ztzrzf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zung2l_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zung2r_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zungbr_(char *vect, integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zunghr_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungl2_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zunglq_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungql_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungqr_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungr2_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zungrq_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungtr_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunmbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zunmhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *a, integer *lda,
+ doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zunml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunmlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunmr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ info);
+
+/* Subroutine */ int zunmrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zunmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zupgtr_(char *uplo, integer *n, doublecomplex *ap,
+ doublecomplex *tau, doublecomplex *q, integer *ldq, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zupmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublecomplex *ap, doublecomplex *tau, doublecomplex *c__,
+ integer *ldc, doublecomplex *work, integer *info);
+
+#endif /* __CLAPACK_H */
diff --git a/jni/configure b/jni/configure
new file mode 100644
index 0000000..db5ab78
--- /dev/null
+++ b/jni/configure
@@ -0,0 +1,136 @@
+#!/bin/bash
+
+OS=`uname`
+ARCH=`uname -m`
+
+VERSION="dev"
+
+# standardise the OS and ARCH names
+if [ "$OS" = "Darwin" ] ; then
+ OS="apple"
+elif [ "$OS" = "Linux" ] ; then
+ OS="linux"
+elif [ "$OS" = "SunOS" ] ; then
+ OS="sun"
+else
+ echo "OS not supported"
+ exit 1
+fi
+
+if [ "$ARCH" = "x86" ] || [ "$ARCH" = "i686" ] || [ "$ARCH" = "i586" ] \
+ || [ "$ARCH" = "i486" ] || [ "$ARCH" = "i386" ] ; then
+ ARCH="x86"
+elif [ "$ARCH" = "Power Macintosh" ] ; then
+ ARCH="ppc"
+elif [ "$ARCH" = "amd64" ] || [ "$ARCH" = "x86_64" ] ; then
+ ARCH="x86_64"
+elif [ "$ARCH" = "sun4u" ] ; then
+ ARCH="sparc"
+else
+ echo "ARCH not supported"
+ exit 1
+fi
+
+if [ "$OS" = "apple" ] ; then
+ CC="gcc -Wall"
+ CPPFLAGS="$CPPFLAGS -I/System/Library/Frameworks/JavaVM.framework/Home/include"
+ CFLAGS="-fPIC -fno-common $CFLAGS"
+ LD="gcc -dynamiclib"
+ LDFLAGS="$LDFLAGS -framework JavaVM"
+ LIBPREPEND="lib"
+ LIBAPPEND="-apple-"${ARCH}".jnilib"
+ FC="g95"
+ FFLAGS="$CFLAGS"
+ LAPACK_INCLUDES="-I/System/Library/Frameworks/vecLib.framework/Headers"
+ # unfortunately OS X cannot build default multi-module libraries with fortran files
+ FORTRAN_LIBS="-lg95 -Wl,-single_module"
+ BLAS_LIBS="-framework veclib"
+ LAPACK_LIBS=""
+elif [ "$OS" = "linux" ] ; then
+ CC="gcc -Wall"
+ CPPFLAGS="$CPPFLAGS -I$JAVA_HOME/include -I$JAVA_HOME/include/linux"
+ CFLAGS="-fPIC $CFLAGS"
+ LD="gcc -shared"
+ LDFLAGS="$LDFLAGS -L$JAVA_HOME/lib"
+ LIBPREPEND="lib"
+ LIBAPPEND="-linux-"${ARCH}".so"
+ FC="gfortran"
+ FFLAGS="$CFLAGS"
+ LAPACK_INCLUDES=""
+ FORTRAN_LIBS="-lgfortran"
+ BLAS_LIBS="-lblas"
+ LAPACK_LIBS="-llapack"
+else
+ echo "OS not supported"
+ exit 1
+fi
+
+echo "Creating config for $OS $ARCH"
+
+echo "CC=$CC" > Makefile.incl
+echo "CPPFLAGS=$CPPFLAGS" >> Makefile.incl
+echo "CFLAGS=$CFLAGS" >> Makefile.incl
+echo "LD=$LD" >> Makefile.incl
+echo "LDFLAGS=$LDFLAGS" >> Makefile.incl
+echo "LIBPREPEND=$LIBPREPEND" >> Makefile.incl
+echo "LIBAPPEND=$LIBAPPEND" >> Makefile.incl
+echo "LAPACK_INCLUDES=$LAPACK_INCLUDES" >> Makefile.incl
+echo "BLAS_LIBS=$BLAS_LIBS" >> Makefile.incl
+echo "FORTRAN_LIBS=$FORTRAN_LIBS" >> Makefile.incl
+echo "LAPACK_LIBS=$LAPACK_LIBS" >> Makefile.incl
+echo "FC=$FC" >> Makefile.incl
+echo "FFLAGS=$FFLAGS" >> Makefile.incl
+
+echo "If you don't have a machine optimised BLAS/LAPACK, please see the comments in this file to compile your own, or install the atlas-base-dev package"
+
+# check if g95 is installed
+if [ ! -x "`which $FC 2>/dev/null`" ] ; then
+ echo "Fortran compiler required. Please install gfortran (sometimes called g95)."
+fi
+
+# if we are on a dev machine with a bin directory, use it, otherwise point to a jar
+if [ -d "../bin" ] ; then
+ echo "JLAPACK_JNI_CP=../bin" >> Makefile.incl
+else
+ echo "JLAPACK_JNI_CP=../netlib-java-$VERSION.jar:../lib/f2j/arpack-combined.jar" >> Makefile.incl
+fi
+
+# wget http://netlib.org/lapack/lapack-3.1.1.tgz
+# tar xfz lapack-3.1.1.tgz
+# cd lapack-3.1.1
+# cp make.inc.example make.inc
+# make FORTRAN="gfortran -fPIC" LOADER="gfortran -fPIC" OPTS="-fPIC -funroll-all-loops -O3" NOOPTS="-fPIC" lib
+# cd ..
+#
+# wget http://belnet.dl.sourceforge.net/sourceforge/math-atlas/atlas3.7.30.tar.bz2
+# tar xfj atlas3.7.30.tar.bz2
+# cd ATLAS
+# mkdir mybuild
+# cd mybuild
+# ../configure -Fa alg -fPIC --with-netlib-lapack=$PWD/../../lapack-3.1.1/lapack_LINUX.a
+# make
+# cd lib
+# make ptshared
+# cd ..
+# sudo make install
+# sudo install -m 755 lib/*.so /usr/local/atlas/lib/
+#
+# sudo ln -sf /usr/local/atlas/lib/libcblas.a /etc/alternatives/libblas-3.a
+# sudo ln -sf /usr/local/atlas/lib/libcblas.so /etc/alternatives/libblas-3.so
+# sudo ln -sf /usr/local/atlas/lib/liblapack.a /etc/alternatives/liblapack-3.a
+# sudo ln -sf /usr/local/atlas/lib/liblapack.so /etc/alternatives/liblapack-3.so
+# sudo ldconfig
+
+echo "You must download the files"
+echo " http://www.caam.rice.edu/software/ARPACK/SRC/arpack96.tar.gz"
+echo " http://www.caam.rice.edu/software/ARPACK/SRC/patch.tar.gz"
+echo "and extract them here if you want to have ARPACK support"
+
+if [ ! -f arpack96.tar.gz ] ; then
+ wget http://www.caam.rice.edu/software/ARPACK/SRC/arpack96.tar.gz
+fi
+if [ ! -f patch.tar.gz ] ; then
+ wget http://www.caam.rice.edu/software/ARPACK/SRC/patch.tar.gz
+fi
+tar xfz arpack96.tar.gz
+tar xfz patch.tar.gz
diff --git a/jni/f2c.h b/jni/f2c.h
new file mode 100644
index 0000000..b94ee7c
--- /dev/null
+++ b/jni/f2c.h
@@ -0,0 +1,223 @@
+/* f2c.h -- Standard Fortran to C header file */
+
+/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
+
+ - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+typedef long int integer;
+typedef unsigned long int uinteger;
+typedef char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef long int logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+#ifdef INTEGER_STAR_8 /* Adjust for integer*8. */
+typedef long long longint; /* system-dependent */
+typedef unsigned long long ulongint; /* system-dependent */
+#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
+#endif
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef long int flag;
+typedef long int ftnlen;
+typedef long int ftnint;
+#endif
+
+/*external read, write*/
+typedef struct
+{ flag cierr;
+ ftnint ciunit;
+ flag ciend;
+ char *cifmt;
+ ftnint cirec;
+} cilist;
+
+/*internal read, write*/
+typedef struct
+{ flag icierr;
+ char *iciunit;
+ flag iciend;
+ char *icifmt;
+ ftnint icirlen;
+ ftnint icirnum;
+} icilist;
+
+/*open*/
+typedef struct
+{ flag oerr;
+ ftnint ounit;
+ char *ofnm;
+ ftnlen ofnmlen;
+ char *osta;
+ char *oacc;
+ char *ofm;
+ ftnint orl;
+ char *oblnk;
+} olist;
+
+/*close*/
+typedef struct
+{ flag cerr;
+ ftnint cunit;
+ char *csta;
+} cllist;
+
+/*rewind, backspace, endfile*/
+typedef struct
+{ flag aerr;
+ ftnint aunit;
+} alist;
+
+/* inquire */
+typedef struct
+{ flag inerr;
+ ftnint inunit;
+ char *infile;
+ ftnlen infilen;
+ ftnint *inex; /*parameters in standard's order*/
+ ftnint *inopen;
+ ftnint *innum;
+ ftnint *innamed;
+ char *inname;
+ ftnlen innamlen;
+ char *inacc;
+ ftnlen inacclen;
+ char *inseq;
+ ftnlen inseqlen;
+ char *indir;
+ ftnlen indirlen;
+ char *infmt;
+ ftnlen infmtlen;
+ char *inform;
+ ftnint informlen;
+ char *inunf;
+ ftnlen inunflen;
+ ftnint *inrecl;
+ ftnint *innrec;
+ char *inblank;
+ ftnlen inblanklen;
+} inlist;
+
+#define VOID void
+
+union Multitype { /* for multiple entry points */
+ integer1 g;
+ shortint h;
+ integer i;
+ /* longint j; */
+ real r;
+ doublereal d;
+ complex c;
+ doublecomplex z;
+ };
+
+typedef union Multitype Multitype;
+
+/*typedef long int Long;*/ /* No longer used; formerly in Namelist */
+
+struct Vardesc { /* for Namelist */
+ char *name;
+ char *addr;
+ ftnlen *dims;
+ int type;
+ };
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+ char *name;
+ Vardesc **vars;
+ int nvars;
+ };
+typedef struct Namelist Namelist;
+
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#define dabs(x) (doublereal)abs(x)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b) ((a) >> (b) & 1)
+#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+typedef int /* Unknown procedure type */ (*U_fp)(...);
+typedef shortint (*J_fp)(...);
+typedef integer (*I_fp)(...);
+typedef real (*R_fp)(...);
+typedef doublereal (*D_fp)(...), (*E_fp)(...);
+typedef /* Complex */ VOID (*C_fp)(...);
+typedef /* Double Complex */ VOID (*Z_fp)(...);
+typedef logical (*L_fp)(...);
+typedef shortlogical (*K_fp)(...);
+typedef /* Character */ VOID (*H_fp)(...);
+typedef /* Subroutine */ int (*S_fp)(...);
+#else
+typedef int /* Unknown procedure type */ (*U_fp)();
+typedef shortint (*J_fp)();
+typedef integer (*I_fp)();
+typedef real (*R_fp)();
+typedef doublereal (*D_fp)(), (*E_fp)();
+typedef /* Complex */ VOID (*C_fp)();
+typedef /* Double Complex */ VOID (*Z_fp)();
+typedef logical (*L_fp)();
+typedef shortlogical (*K_fp)();
+typedef /* Character */ VOID (*H_fp)();
+typedef /* Subroutine */ int (*S_fp)();
+#endif
+/* E_fp is for real functions when -R is not specified */
+typedef VOID C_f; /* complex function */
+typedef VOID H_f; /* character function */
+typedef VOID Z_f; /* double complex function */
+typedef doublereal E_f; /* real function with -R not specified */
+
+/* undef any lower-case symbols that your C compiler predefines, e.g.: */
+
+#ifndef Skip_f2c_Undefs
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#undef unix
+#undef vax
+#endif
+#endif
diff --git a/jni/f2j_jni.c b/jni/f2j_jni.c
new file mode 100644
index 0000000..5ec3a4e
--- /dev/null
+++ b/jni/f2j_jni.c
@@ -0,0 +1,69 @@
+#include <jni.h>
+#include <cblas.h>
+
+enum CBLAS_TRANSPOSE getTrans(const char * fortranChar){
+ // enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113, AtlasConj=114};
+ // can be "N" or "T"
+ if (fortranChar[0] == 'N'){
+ return (enum CBLAS_TRANSPOSE) 111;
+ }
+ if (fortranChar[0] == 'T'){
+ return (enum CBLAS_TRANSPOSE) 112;
+ }
+ printf("ERROR in F2J JNI: getTrans() got %s", fortranChar);
+ return -1;
+}
+
+enum CBLAS_UPLO getUpLo(const char * fortranChar){
+ // enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
+ // can be "U" or "L"
+ if (fortranChar[0] == 'U'){
+ return (enum CBLAS_UPLO) 121;
+ }
+ if (fortranChar[0] == 'L'){
+ return (enum CBLAS_UPLO) 122;
+ }
+ printf("ERROR in F2J JNI: getUpLo() got %s", fortranChar);
+ return -1;
+}
+
+enum CBLAS_SIDE getSide(const char * fortranChar){
+ // enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};
+ // can be "L" or "R"
+ if (fortranChar[0] == 'L'){
+ return (enum CBLAS_SIDE) 141;
+ }
+ if (fortranChar[0] == 'R'){
+ return (enum CBLAS_SIDE) 142;
+ }
+ printf("ERROR in F2J JNI: getSide() got %s", fortranChar);
+ return -1;
+}
+
+enum CBLAS_DIAG getDiag(const char * fortranChar){
+ // enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
+ // can be "U" or "N"
+ if (fortranChar[0] == 'N'){
+ return (enum CBLAS_DIAG) 131;
+ }
+ if (fortranChar[0] == 'U'){
+ return (enum CBLAS_DIAG) 132;
+ }
+ printf("ERROR in F2J JNI: getDiag() got %s", fortranChar);
+ return -1;
+}
+
+inline void check_memory(JNIEnv * env, void * arg) {
+ if (arg != NULL) {
+ return;
+ }
+ /*
+ * WARNING: Memory leak
+ *
+ * This doesn't clean up successful allocations prior to throwing this exception.
+ * However, it's a pretty dire situation to be anyway and the client code is not
+ * expected to recover.
+ */
+ (*env)->ThrowNew(env, (*env)->FindClass(env, "java/lang/OutOfMemoryError"),
+ "Out of memory transferring array to native code in F2J JNI");
+}
\ No newline at end of file
diff --git a/jni/f2j_jni.h b/jni/f2j_jni.h
new file mode 100644
index 0000000..d4db06c
--- /dev/null
+++ b/jni/f2j_jni.h
@@ -0,0 +1,25 @@
+#include <jni.h>
+#include "f2c.h"
+#include <cblas.h>
+#include <clapack.h>
+#include "arpack.h"
+// this will be ignored if a system clapack.h was found first
+#include "clapack.h"
+
+// enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102 };
+// this is the ordering used by F2J
+#define F2J_JNI_ORDER (enum CBLAS_ORDER) 102
+
+// convenience methods for dealing with the CBLAS (not BLAS) specific enums
+// our API is using the Fortran-style char*[] system.
+
+enum CBLAS_TRANSPOSE getTrans(const char *);
+
+enum CBLAS_UPLO getUpLo(const char *);
+
+enum CBLAS_SIDE getSide(const char *);
+
+enum CBLAS_DIAG getDiag(const char *);
+
+/* Convenience method for checking if we ran out of memory */
+void check_memory(JNIEnv *, void *);
diff --git a/jni/org_netlib_arpack_NativeARPACK.c b/jni/org_netlib_arpack_NativeARPACK.c
new file mode 100644
index 0000000..28e10a5
--- /dev/null
+++ b/jni/org_netlib_arpack_NativeARPACK.c
@@ -0,0 +1,469 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+
+#include "f2j_jni.h"
+#include "org_netlib_arpack_NativeARPACK.h"
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_dnaupd (JNIEnv * env, jobject calling_obj, jobject arg1, jstring arg2, jint arg3, jstring arg4, jint arg5, jobject arg6, jdoubleArray arg7, jint arg9, jdoubleArray arg10, jint arg12, jintArray arg13, jintArray arg15, jdoubleArray arg17, jdoubleArray arg19, jint arg21, jobject arg22){
+ jclass jni_arg1Class = (*env)->GetObjectClass(env, arg1);
+ jfieldID jni_arg1Id = (*env)->GetFieldID(env, jni_arg1Class, "val", "I");
+ jint jni_arg1 = (*env)->GetIntField(env, arg1, jni_arg1Id);
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ char * jni_arg4 = (char *)(*env)->GetStringUTFChars(env, arg4, JNI_FALSE);
+ jclass jni_arg6Class = (*env)->GetObjectClass(env, arg6);
+ jfieldID jni_arg6Id = (*env)->GetFieldID(env, jni_arg6Class, "val", "D");
+ jdouble jni_arg6 = (*env)->GetDoubleField(env, arg6, jni_arg6Id);
+ jdouble * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ jdouble * jni_arg10 = (*env)->GetPrimitiveArrayCritical(env, arg10, JNI_FALSE);
+ check_memory(env, jni_arg10);
+ jint * jni_arg13 = (*env)->GetPrimitiveArrayCritical(env, arg13, JNI_FALSE);
+ check_memory(env, jni_arg13);
+ jint * jni_arg15 = (*env)->GetPrimitiveArrayCritical(env, arg15, JNI_FALSE);
+ check_memory(env, jni_arg15);
+ jdouble * jni_arg17 = (*env)->GetPrimitiveArrayCritical(env, arg17, JNI_FALSE);
+ check_memory(env, jni_arg17);
+ jdouble * jni_arg19 = (*env)->GetPrimitiveArrayCritical(env, arg19, JNI_FALSE);
+ check_memory(env, jni_arg19);
+ jclass jni_arg22Class = (*env)->GetObjectClass(env, arg22);
+ jfieldID jni_arg22Id = (*env)->GetFieldID(env, jni_arg22Class, "val", "I");
+ jint jni_arg22 = (*env)->GetIntField(env, arg22, jni_arg22Id);
+
+ dnaupd_(&jni_arg1, jni_arg2, &arg3, jni_arg4, &arg5, &jni_arg6, jni_arg7, &arg9, jni_arg10, &arg12, jni_arg13, jni_arg15, jni_arg17, jni_arg19, &arg21, &jni_arg22);
+
+ (*env)->SetIntField(env, arg1, jni_arg1Id, jni_arg1);
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ (*env)->ReleaseStringUTFChars(env, arg4, jni_arg4);
+ (*env)->SetDoubleField(env, arg6, jni_arg6Id, jni_arg6);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg10, jni_arg10, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg13, jni_arg13, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg15, jni_arg15, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg17, jni_arg17, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg19, jni_arg19, 0);
+ (*env)->SetIntField(env, arg22, jni_arg22Id, jni_arg22);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_dneupd (JNIEnv * env, jobject calling_obj, jboolean arg1, jstring arg2, jbooleanArray arg3, jdoubleArray arg5, jdoubleArray arg7, jdoubleArray arg9, jint arg11, jdouble arg12, jdouble arg13, jdoubleArray arg14, jstring arg16, jint arg17, jstring arg18, jobject arg19, jdouble arg20, jdoubleArray arg21, jint arg23, jdoubleArray arg24, jint arg26, jintArray arg27, jintArray arg29, jdoubleArray arg31, jdoubleArray arg33, jint arg35, [...]
+ logical jni_arg1 = (logical)arg1;
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ jboolean * jni_arg3Tmp = (*env)->GetPrimitiveArrayCritical(env, arg3, JNI_FALSE);
+ jint jni_arg3Size = (*env)->GetArrayLength(env, arg3);
+ logical jni_arg3[jni_arg3Size];
+ int jni_arg3i;
+ jdouble * jni_arg5 = (*env)->GetPrimitiveArrayCritical(env, arg5, JNI_FALSE);
+ check_memory(env, jni_arg5);
+ jdouble * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ jdouble * jni_arg9 = (*env)->GetPrimitiveArrayCritical(env, arg9, JNI_FALSE);
+ check_memory(env, jni_arg9);
+ jdouble * jni_arg14 = (*env)->GetPrimitiveArrayCritical(env, arg14, JNI_FALSE);
+ check_memory(env, jni_arg14);
+ char * jni_arg16 = (char *)(*env)->GetStringUTFChars(env, arg16, JNI_FALSE);
+ char * jni_arg18 = (char *)(*env)->GetStringUTFChars(env, arg18, JNI_FALSE);
+ jclass jni_arg19Class = (*env)->GetObjectClass(env, arg19);
+ jfieldID jni_arg19Id = (*env)->GetFieldID(env, jni_arg19Class, "val", "I");
+ jint jni_arg19 = (*env)->GetIntField(env, arg19, jni_arg19Id);
+ jdouble * jni_arg21 = (*env)->GetPrimitiveArrayCritical(env, arg21, JNI_FALSE);
+ check_memory(env, jni_arg21);
+ jdouble * jni_arg24 = (*env)->GetPrimitiveArrayCritical(env, arg24, JNI_FALSE);
+ check_memory(env, jni_arg24);
+ jint * jni_arg27 = (*env)->GetPrimitiveArrayCritical(env, arg27, JNI_FALSE);
+ check_memory(env, jni_arg27);
+ jint * jni_arg29 = (*env)->GetPrimitiveArrayCritical(env, arg29, JNI_FALSE);
+ check_memory(env, jni_arg29);
+ jdouble * jni_arg31 = (*env)->GetPrimitiveArrayCritical(env, arg31, JNI_FALSE);
+ check_memory(env, jni_arg31);
+ jdouble * jni_arg33 = (*env)->GetPrimitiveArrayCritical(env, arg33, JNI_FALSE);
+ check_memory(env, jni_arg33);
+ jclass jni_arg36Class = (*env)->GetObjectClass(env, arg36);
+ jfieldID jni_arg36Id = (*env)->GetFieldID(env, jni_arg36Class, "val", "I");
+ jint jni_arg36 = (*env)->GetIntField(env, arg36, jni_arg36Id);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3Tmp[jni_arg3i] == JNI_FALSE){
+ jni_arg3[jni_arg3i] = 0;
+ } else {
+ jni_arg3[jni_arg3i] = 1;
+ }
+ }
+
+ dneupd_(&jni_arg1, jni_arg2, jni_arg3, jni_arg5, jni_arg7, jni_arg9, &arg11, &arg12, &arg13, jni_arg14, jni_arg16, &arg17, jni_arg18, &jni_arg19, &arg20, jni_arg21, &arg23, jni_arg24, &arg26, jni_arg27, jni_arg29, jni_arg31, jni_arg33, &arg35, &jni_arg36);
+
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3[jni_arg3i] == 0){
+ jni_arg3Tmp[jni_arg3i] = JNI_FALSE;
+ } else {
+ jni_arg3Tmp[jni_arg3i] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, arg3, jni_arg3Tmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg5, jni_arg5, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg9, jni_arg9, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg14, jni_arg14, 0);
+ (*env)->ReleaseStringUTFChars(env, arg16, jni_arg16);
+ (*env)->ReleaseStringUTFChars(env, arg18, jni_arg18);
+ (*env)->SetIntField(env, arg19, jni_arg19Id, jni_arg19);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg21, jni_arg21, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg24, jni_arg24, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg27, jni_arg27, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg29, jni_arg29, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg31, jni_arg31, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg33, jni_arg33, 0);
+ (*env)->SetIntField(env, arg36, jni_arg36Id, jni_arg36);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_dsaupd (JNIEnv * env, jobject calling_obj, jobject arg1, jstring arg2, jint arg3, jstring arg4, jint arg5, jobject arg6, jdoubleArray arg7, jint arg9, jdoubleArray arg10, jint arg12, jintArray arg13, jintArray arg15, jdoubleArray arg17, jdoubleArray arg19, jint arg21, jobject arg22){
+ jclass jni_arg1Class = (*env)->GetObjectClass(env, arg1);
+ jfieldID jni_arg1Id = (*env)->GetFieldID(env, jni_arg1Class, "val", "I");
+ jint jni_arg1 = (*env)->GetIntField(env, arg1, jni_arg1Id);
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ char * jni_arg4 = (char *)(*env)->GetStringUTFChars(env, arg4, JNI_FALSE);
+ jclass jni_arg6Class = (*env)->GetObjectClass(env, arg6);
+ jfieldID jni_arg6Id = (*env)->GetFieldID(env, jni_arg6Class, "val", "D");
+ jdouble jni_arg6 = (*env)->GetDoubleField(env, arg6, jni_arg6Id);
+ jdouble * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ jdouble * jni_arg10 = (*env)->GetPrimitiveArrayCritical(env, arg10, JNI_FALSE);
+ check_memory(env, jni_arg10);
+ jint * jni_arg13 = (*env)->GetPrimitiveArrayCritical(env, arg13, JNI_FALSE);
+ check_memory(env, jni_arg13);
+ jint * jni_arg15 = (*env)->GetPrimitiveArrayCritical(env, arg15, JNI_FALSE);
+ check_memory(env, jni_arg15);
+ jdouble * jni_arg17 = (*env)->GetPrimitiveArrayCritical(env, arg17, JNI_FALSE);
+ check_memory(env, jni_arg17);
+ jdouble * jni_arg19 = (*env)->GetPrimitiveArrayCritical(env, arg19, JNI_FALSE);
+ check_memory(env, jni_arg19);
+ jclass jni_arg22Class = (*env)->GetObjectClass(env, arg22);
+ jfieldID jni_arg22Id = (*env)->GetFieldID(env, jni_arg22Class, "val", "I");
+ jint jni_arg22 = (*env)->GetIntField(env, arg22, jni_arg22Id);
+
+ dsaupd_(&jni_arg1, jni_arg2, &arg3, jni_arg4, &arg5, &jni_arg6, jni_arg7, &arg9, jni_arg10, &arg12, jni_arg13, jni_arg15, jni_arg17, jni_arg19, &arg21, &jni_arg22);
+
+ (*env)->SetIntField(env, arg1, jni_arg1Id, jni_arg1);
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ (*env)->ReleaseStringUTFChars(env, arg4, jni_arg4);
+ (*env)->SetDoubleField(env, arg6, jni_arg6Id, jni_arg6);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg10, jni_arg10, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg13, jni_arg13, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg15, jni_arg15, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg17, jni_arg17, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg19, jni_arg19, 0);
+ (*env)->SetIntField(env, arg22, jni_arg22Id, jni_arg22);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_dseupd (JNIEnv * env, jobject calling_obj, jboolean arg1, jstring arg2, jbooleanArray arg3, jdoubleArray arg5, jdoubleArray arg7, jint arg9, jdouble arg10, jstring arg11, jint arg12, jstring arg13, jobject arg14, jdouble arg15, jdoubleArray arg16, jint arg18, jdoubleArray arg19, jint arg21, jintArray arg22, jintArray arg24, jdoubleArray arg26, jdoubleArray arg28, jint arg30, jobject arg31){
+ logical jni_arg1 = (logical)arg1;
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ jboolean * jni_arg3Tmp = (*env)->GetPrimitiveArrayCritical(env, arg3, JNI_FALSE);
+ jint jni_arg3Size = (*env)->GetArrayLength(env, arg3);
+ logical jni_arg3[jni_arg3Size];
+ int jni_arg3i;
+ jdouble * jni_arg5 = (*env)->GetPrimitiveArrayCritical(env, arg5, JNI_FALSE);
+ check_memory(env, jni_arg5);
+ jdouble * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ char * jni_arg11 = (char *)(*env)->GetStringUTFChars(env, arg11, JNI_FALSE);
+ char * jni_arg13 = (char *)(*env)->GetStringUTFChars(env, arg13, JNI_FALSE);
+ jclass jni_arg14Class = (*env)->GetObjectClass(env, arg14);
+ jfieldID jni_arg14Id = (*env)->GetFieldID(env, jni_arg14Class, "val", "I");
+ jint jni_arg14 = (*env)->GetIntField(env, arg14, jni_arg14Id);
+ jdouble * jni_arg16 = (*env)->GetPrimitiveArrayCritical(env, arg16, JNI_FALSE);
+ check_memory(env, jni_arg16);
+ jdouble * jni_arg19 = (*env)->GetPrimitiveArrayCritical(env, arg19, JNI_FALSE);
+ check_memory(env, jni_arg19);
+ jint * jni_arg22 = (*env)->GetPrimitiveArrayCritical(env, arg22, JNI_FALSE);
+ check_memory(env, jni_arg22);
+ jint * jni_arg24 = (*env)->GetPrimitiveArrayCritical(env, arg24, JNI_FALSE);
+ check_memory(env, jni_arg24);
+ jdouble * jni_arg26 = (*env)->GetPrimitiveArrayCritical(env, arg26, JNI_FALSE);
+ check_memory(env, jni_arg26);
+ jdouble * jni_arg28 = (*env)->GetPrimitiveArrayCritical(env, arg28, JNI_FALSE);
+ check_memory(env, jni_arg28);
+ jclass jni_arg31Class = (*env)->GetObjectClass(env, arg31);
+ jfieldID jni_arg31Id = (*env)->GetFieldID(env, jni_arg31Class, "val", "I");
+ jint jni_arg31 = (*env)->GetIntField(env, arg31, jni_arg31Id);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3Tmp[jni_arg3i] == JNI_FALSE){
+ jni_arg3[jni_arg3i] = 0;
+ } else {
+ jni_arg3[jni_arg3i] = 1;
+ }
+ }
+
+ dseupd_(&jni_arg1, jni_arg2, jni_arg3, jni_arg5, jni_arg7, &arg9, &arg10, jni_arg11, &arg12, jni_arg13, &jni_arg14, &arg15, jni_arg16, &arg18, jni_arg19, &arg21, jni_arg22, jni_arg24, jni_arg26, jni_arg28, &arg30, &jni_arg31);
+
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3[jni_arg3i] == 0){
+ jni_arg3Tmp[jni_arg3i] = JNI_FALSE;
+ } else {
+ jni_arg3Tmp[jni_arg3i] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, arg3, jni_arg3Tmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg5, jni_arg5, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleaseStringUTFChars(env, arg11, jni_arg11);
+ (*env)->ReleaseStringUTFChars(env, arg13, jni_arg13);
+ (*env)->SetIntField(env, arg14, jni_arg14Id, jni_arg14);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg16, jni_arg16, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg19, jni_arg19, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg22, jni_arg22, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg24, jni_arg24, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg26, jni_arg26, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg28, jni_arg28, 0);
+ (*env)->SetIntField(env, arg31, jni_arg31Id, jni_arg31);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_snaupd (JNIEnv * env, jobject calling_obj, jobject arg1, jstring arg2, jint arg3, jstring arg4, jint arg5, jobject arg6, jfloatArray arg7, jint arg9, jfloatArray arg10, jint arg12, jintArray arg13, jintArray arg15, jfloatArray arg17, jfloatArray arg19, jint arg21, jobject arg22){
+ jclass jni_arg1Class = (*env)->GetObjectClass(env, arg1);
+ jfieldID jni_arg1Id = (*env)->GetFieldID(env, jni_arg1Class, "val", "I");
+ jint jni_arg1 = (*env)->GetIntField(env, arg1, jni_arg1Id);
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ char * jni_arg4 = (char *)(*env)->GetStringUTFChars(env, arg4, JNI_FALSE);
+ jclass jni_arg6Class = (*env)->GetObjectClass(env, arg6);
+ jfieldID jni_arg6Id = (*env)->GetFieldID(env, jni_arg6Class, "val", "D");
+ jfloat jni_arg6 = (*env)->GetFloatField(env, arg6, jni_arg6Id);
+ jfloat * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ jfloat * jni_arg10 = (*env)->GetPrimitiveArrayCritical(env, arg10, JNI_FALSE);
+ check_memory(env, jni_arg10);
+ jint * jni_arg13 = (*env)->GetPrimitiveArrayCritical(env, arg13, JNI_FALSE);
+ check_memory(env, jni_arg13);
+ jint * jni_arg15 = (*env)->GetPrimitiveArrayCritical(env, arg15, JNI_FALSE);
+ check_memory(env, jni_arg15);
+ jfloat * jni_arg17 = (*env)->GetPrimitiveArrayCritical(env, arg17, JNI_FALSE);
+ check_memory(env, jni_arg17);
+ jfloat * jni_arg19 = (*env)->GetPrimitiveArrayCritical(env, arg19, JNI_FALSE);
+ check_memory(env, jni_arg19);
+ jclass jni_arg22Class = (*env)->GetObjectClass(env, arg22);
+ jfieldID jni_arg22Id = (*env)->GetFieldID(env, jni_arg22Class, "val", "I");
+ jint jni_arg22 = (*env)->GetIntField(env, arg22, jni_arg22Id);
+
+ snaupd_(&jni_arg1, jni_arg2, &arg3, jni_arg4, &arg5, &jni_arg6, jni_arg7, &arg9, jni_arg10, &arg12, jni_arg13, jni_arg15, jni_arg17, jni_arg19, &arg21, &jni_arg22);
+
+ (*env)->SetIntField(env, arg1, jni_arg1Id, jni_arg1);
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ (*env)->ReleaseStringUTFChars(env, arg4, jni_arg4);
+ (*env)->SetFloatField(env, arg6, jni_arg6Id, jni_arg6);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg10, jni_arg10, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg13, jni_arg13, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg15, jni_arg15, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg17, jni_arg17, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg19, jni_arg19, 0);
+ (*env)->SetIntField(env, arg22, jni_arg22Id, jni_arg22);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_sneupd (JNIEnv * env, jobject calling_obj, jboolean arg1, jstring arg2, jbooleanArray arg3, jfloatArray arg5, jfloatArray arg7, jfloatArray arg9, jint arg11, jfloat arg12, jfloat arg13, jfloatArray arg14, jstring arg16, jint arg17, jstring arg18, jobject arg19, jfloat arg20, jfloatArray arg21, jint arg23, jfloatArray arg24, jint arg26, jintArray arg27, jintArray arg29, jfloatArray arg31, jfloatArray arg33, jint arg35, jobject arg36){
+ logical jni_arg1 = (logical)arg1;
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ jboolean * jni_arg3Tmp = (*env)->GetPrimitiveArrayCritical(env, arg3, JNI_FALSE);
+ jint jni_arg3Size = (*env)->GetArrayLength(env, arg3);
+ logical jni_arg3[jni_arg3Size];
+ int jni_arg3i;
+ jfloat * jni_arg5 = (*env)->GetPrimitiveArrayCritical(env, arg5, JNI_FALSE);
+ check_memory(env, jni_arg5);
+ jfloat * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ jfloat * jni_arg9 = (*env)->GetPrimitiveArrayCritical(env, arg9, JNI_FALSE);
+ check_memory(env, jni_arg9);
+ jfloat * jni_arg14 = (*env)->GetPrimitiveArrayCritical(env, arg14, JNI_FALSE);
+ check_memory(env, jni_arg14);
+ char * jni_arg16 = (char *)(*env)->GetStringUTFChars(env, arg16, JNI_FALSE);
+ char * jni_arg18 = (char *)(*env)->GetStringUTFChars(env, arg18, JNI_FALSE);
+ jclass jni_arg19Class = (*env)->GetObjectClass(env, arg19);
+ jfieldID jni_arg19Id = (*env)->GetFieldID(env, jni_arg19Class, "val", "I");
+ jint jni_arg19 = (*env)->GetIntField(env, arg19, jni_arg19Id);
+ jfloat * jni_arg21 = (*env)->GetPrimitiveArrayCritical(env, arg21, JNI_FALSE);
+ check_memory(env, jni_arg21);
+ jfloat * jni_arg24 = (*env)->GetPrimitiveArrayCritical(env, arg24, JNI_FALSE);
+ check_memory(env, jni_arg24);
+ jint * jni_arg27 = (*env)->GetPrimitiveArrayCritical(env, arg27, JNI_FALSE);
+ check_memory(env, jni_arg27);
+ jint * jni_arg29 = (*env)->GetPrimitiveArrayCritical(env, arg29, JNI_FALSE);
+ check_memory(env, jni_arg29);
+ jfloat * jni_arg31 = (*env)->GetPrimitiveArrayCritical(env, arg31, JNI_FALSE);
+ check_memory(env, jni_arg31);
+ jfloat * jni_arg33 = (*env)->GetPrimitiveArrayCritical(env, arg33, JNI_FALSE);
+ check_memory(env, jni_arg33);
+ jclass jni_arg36Class = (*env)->GetObjectClass(env, arg36);
+ jfieldID jni_arg36Id = (*env)->GetFieldID(env, jni_arg36Class, "val", "I");
+ jint jni_arg36 = (*env)->GetIntField(env, arg36, jni_arg36Id);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3Tmp[jni_arg3i] == JNI_FALSE){
+ jni_arg3[jni_arg3i] = 0;
+ } else {
+ jni_arg3[jni_arg3i] = 1;
+ }
+ }
+
+ sneupd_(&jni_arg1, jni_arg2, jni_arg3, jni_arg5, jni_arg7, jni_arg9, &arg11, &arg12, &arg13, jni_arg14, jni_arg16, &arg17, jni_arg18, &jni_arg19, &arg20, jni_arg21, &arg23, jni_arg24, &arg26, jni_arg27, jni_arg29, jni_arg31, jni_arg33, &arg35, &jni_arg36);
+
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3[jni_arg3i] == 0){
+ jni_arg3Tmp[jni_arg3i] = JNI_FALSE;
+ } else {
+ jni_arg3Tmp[jni_arg3i] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, arg3, jni_arg3Tmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg5, jni_arg5, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg9, jni_arg9, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg14, jni_arg14, 0);
+ (*env)->ReleaseStringUTFChars(env, arg16, jni_arg16);
+ (*env)->ReleaseStringUTFChars(env, arg18, jni_arg18);
+ (*env)->SetIntField(env, arg19, jni_arg19Id, jni_arg19);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg21, jni_arg21, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg24, jni_arg24, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg27, jni_arg27, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg29, jni_arg29, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg31, jni_arg31, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg33, jni_arg33, 0);
+ (*env)->SetIntField(env, arg36, jni_arg36Id, jni_arg36);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_ssaupd (JNIEnv * env, jobject calling_obj, jobject arg1, jstring arg2, jint arg3, jstring arg4, jint arg5, jobject arg6, jfloatArray arg7, jint arg9, jfloatArray arg10, jint arg12, jintArray arg13, jintArray arg15, jfloatArray arg17, jfloatArray arg19, jint arg21, jobject arg22){
+ jclass jni_arg1Class = (*env)->GetObjectClass(env, arg1);
+ jfieldID jni_arg1Id = (*env)->GetFieldID(env, jni_arg1Class, "val", "I");
+ jint jni_arg1 = (*env)->GetIntField(env, arg1, jni_arg1Id);
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ char * jni_arg4 = (char *)(*env)->GetStringUTFChars(env, arg4, JNI_FALSE);
+ jclass jni_arg6Class = (*env)->GetObjectClass(env, arg6);
+ jfieldID jni_arg6Id = (*env)->GetFieldID(env, jni_arg6Class, "val", "D");
+ jfloat jni_arg6 = (*env)->GetFloatField(env, arg6, jni_arg6Id);
+ jfloat * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ jfloat * jni_arg10 = (*env)->GetPrimitiveArrayCritical(env, arg10, JNI_FALSE);
+ check_memory(env, jni_arg10);
+ jint * jni_arg13 = (*env)->GetPrimitiveArrayCritical(env, arg13, JNI_FALSE);
+ check_memory(env, jni_arg13);
+ jint * jni_arg15 = (*env)->GetPrimitiveArrayCritical(env, arg15, JNI_FALSE);
+ check_memory(env, jni_arg15);
+ jfloat * jni_arg17 = (*env)->GetPrimitiveArrayCritical(env, arg17, JNI_FALSE);
+ check_memory(env, jni_arg17);
+ jfloat * jni_arg19 = (*env)->GetPrimitiveArrayCritical(env, arg19, JNI_FALSE);
+ check_memory(env, jni_arg19);
+ jclass jni_arg22Class = (*env)->GetObjectClass(env, arg22);
+ jfieldID jni_arg22Id = (*env)->GetFieldID(env, jni_arg22Class, "val", "I");
+ jint jni_arg22 = (*env)->GetIntField(env, arg22, jni_arg22Id);
+
+ ssaupd_(&jni_arg1, jni_arg2, &arg3, jni_arg4, &arg5, &jni_arg6, jni_arg7, &arg9, jni_arg10, &arg12, jni_arg13, jni_arg15, jni_arg17, jni_arg19, &arg21, &jni_arg22);
+
+ (*env)->SetIntField(env, arg1, jni_arg1Id, jni_arg1);
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ (*env)->ReleaseStringUTFChars(env, arg4, jni_arg4);
+ (*env)->SetFloatField(env, arg6, jni_arg6Id, jni_arg6);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg10, jni_arg10, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg13, jni_arg13, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg15, jni_arg15, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg17, jni_arg17, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg19, jni_arg19, 0);
+ (*env)->SetIntField(env, arg22, jni_arg22Id, jni_arg22);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_arpack_NativeARPACK_sseupd (JNIEnv * env, jobject calling_obj, jboolean arg1, jstring arg2, jbooleanArray arg3, jfloatArray arg5, jfloatArray arg7, jint arg9, jfloat arg10, jstring arg11, jint arg12, jstring arg13, jobject arg14, jfloat arg15, jfloatArray arg16, jint arg18, jfloatArray arg19, jint arg21, jintArray arg22, jintArray arg24, jfloatArray arg26, jfloatArray arg28, jint arg30, jobject arg31){
+ logical jni_arg1 = (logical)arg1;
+ char * jni_arg2 = (char *)(*env)->GetStringUTFChars(env, arg2, JNI_FALSE);
+ jboolean * jni_arg3Tmp = (*env)->GetPrimitiveArrayCritical(env, arg3, JNI_FALSE);
+ jint jni_arg3Size = (*env)->GetArrayLength(env, arg3);
+ logical jni_arg3[jni_arg3Size];
+ int jni_arg3i;
+ jfloat * jni_arg5 = (*env)->GetPrimitiveArrayCritical(env, arg5, JNI_FALSE);
+ check_memory(env, jni_arg5);
+ jfloat * jni_arg7 = (*env)->GetPrimitiveArrayCritical(env, arg7, JNI_FALSE);
+ check_memory(env, jni_arg7);
+ char * jni_arg11 = (char *)(*env)->GetStringUTFChars(env, arg11, JNI_FALSE);
+ char * jni_arg13 = (char *)(*env)->GetStringUTFChars(env, arg13, JNI_FALSE);
+ jclass jni_arg14Class = (*env)->GetObjectClass(env, arg14);
+ jfieldID jni_arg14Id = (*env)->GetFieldID(env, jni_arg14Class, "val", "I");
+ jint jni_arg14 = (*env)->GetIntField(env, arg14, jni_arg14Id);
+ jfloat * jni_arg16 = (*env)->GetPrimitiveArrayCritical(env, arg16, JNI_FALSE);
+ check_memory(env, jni_arg16);
+ jfloat * jni_arg19 = (*env)->GetPrimitiveArrayCritical(env, arg19, JNI_FALSE);
+ check_memory(env, jni_arg19);
+ jint * jni_arg22 = (*env)->GetPrimitiveArrayCritical(env, arg22, JNI_FALSE);
+ check_memory(env, jni_arg22);
+ jint * jni_arg24 = (*env)->GetPrimitiveArrayCritical(env, arg24, JNI_FALSE);
+ check_memory(env, jni_arg24);
+ jfloat * jni_arg26 = (*env)->GetPrimitiveArrayCritical(env, arg26, JNI_FALSE);
+ check_memory(env, jni_arg26);
+ jfloat * jni_arg28 = (*env)->GetPrimitiveArrayCritical(env, arg28, JNI_FALSE);
+ check_memory(env, jni_arg28);
+ jclass jni_arg31Class = (*env)->GetObjectClass(env, arg31);
+ jfieldID jni_arg31Id = (*env)->GetFieldID(env, jni_arg31Class, "val", "I");
+ jint jni_arg31 = (*env)->GetIntField(env, arg31, jni_arg31Id);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3Tmp[jni_arg3i] == JNI_FALSE){
+ jni_arg3[jni_arg3i] = 0;
+ } else {
+ jni_arg3[jni_arg3i] = 1;
+ }
+ }
+
+ sseupd_(&jni_arg1, jni_arg2, jni_arg3, jni_arg5, jni_arg7, &arg9, &arg10, jni_arg11, &arg12, jni_arg13, &jni_arg14, &arg15, jni_arg16, &arg18, jni_arg19, &arg21, jni_arg22, jni_arg24, jni_arg26, jni_arg28, &arg30, &jni_arg31);
+
+ (*env)->ReleaseStringUTFChars(env, arg2, jni_arg2);
+ for (jni_arg3i = 0 ; jni_arg3i < jni_arg3Size ; jni_arg3i++){
+ if (jni_arg3[jni_arg3i] == 0){
+ jni_arg3Tmp[jni_arg3i] = JNI_FALSE;
+ } else {
+ jni_arg3Tmp[jni_arg3i] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, arg3, jni_arg3Tmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg5, jni_arg5, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg7, jni_arg7, 0);
+ (*env)->ReleaseStringUTFChars(env, arg11, jni_arg11);
+ (*env)->ReleaseStringUTFChars(env, arg13, jni_arg13);
+ (*env)->SetIntField(env, arg14, jni_arg14Id, jni_arg14);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg16, jni_arg16, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg19, jni_arg19, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg22, jni_arg22, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg24, jni_arg24, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg26, jni_arg26, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, arg28, jni_arg28, 0);
+ (*env)->SetIntField(env, arg31, jni_arg31Id, jni_arg31);
+}
+
diff --git a/jni/org_netlib_blas_NativeBLAS.c b/jni/org_netlib_blas_NativeBLAS.c
new file mode 100644
index 0000000..024beb0
--- /dev/null
+++ b/jni/org_netlib_blas_NativeBLAS.c
@@ -0,0 +1,1154 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+
+#include "f2j_jni.h"
+#include "org_netlib_blas_NativeBLAS.h"
+
+JNIEXPORT jdouble JNICALL Java_org_netlib_blas_NativeBLAS_dasum (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble returnValue;
+
+ returnValue = cblas_dasum(n, jni_dx, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_daxpy (JNIEnv * env, jobject calling_obj, jint n, jdouble da, jdoubleArray dx, jint incx, jdoubleArray dy, jint incy){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble * jni_dy = (*env)->GetPrimitiveArrayCritical(env, dy, JNI_FALSE);
+ check_memory(env, jni_dy);
+
+ cblas_daxpy(n, da, jni_dx, incx, jni_dy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dy, jni_dy, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dcopy (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx, jdoubleArray dy, jint incy){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble * jni_dy = (*env)->GetPrimitiveArrayCritical(env, dy, JNI_FALSE);
+ check_memory(env, jni_dy);
+
+ cblas_dcopy(n, jni_dx, incx, jni_dy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dy, jni_dy, 0);
+}
+
+JNIEXPORT jdouble JNICALL Java_org_netlib_blas_NativeBLAS_ddot (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx, jdoubleArray dy, jint incy){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble * jni_dy = (*env)->GetPrimitiveArrayCritical(env, dy, JNI_FALSE);
+ check_memory(env, jni_dy);
+ jdouble returnValue;
+
+ returnValue = cblas_ddot(n, jni_dx, incx, jni_dy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dy, jni_dy, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dgbmv (JNIEnv * env, jobject calling_obj, jstring trans, jint m, jint n, jint kl, jint ku, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray x, jint incx, jdouble beta, jdoubleArray y, jint incy){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_dgbmv(F2J_JNI_ORDER, getTrans(jni_trans), m, n, kl, ku, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dgemm (JNIEnv * env, jobject calling_obj, jstring transa, jstring transb, jint m, jint n, jint k, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble beta, jdoubleArray c, jint Ldc){
+ char * jni_transa = (char *)(*env)->GetStringUTFChars(env, transa, JNI_FALSE);
+ char * jni_transb = (char *)(*env)->GetStringUTFChars(env, transb, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_dgemm(F2J_JNI_ORDER, getTrans(jni_transa), getTrans(jni_transb), m, n, k, alpha, jni_a, lda, jni_b, ldb, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, transa, jni_transa);
+ (*env)->ReleaseStringUTFChars(env, transb, jni_transb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dgemv (JNIEnv * env, jobject calling_obj, jstring trans, jint m, jint n, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray x, jint incx, jdouble beta, jdoubleArray y, jint incy){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_dgemv(F2J_JNI_ORDER, getTrans(jni_trans), m, n, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dger (JNIEnv * env, jobject calling_obj, jint m, jint n, jdouble alpha, jdoubleArray x, jint incx, jdoubleArray y, jint incy, jdoubleArray a, jint lda){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ cblas_dger(F2J_JNI_ORDER, m, n, alpha, jni_x, incx, jni_y, incy, jni_a, lda);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT jdouble JNICALL Java_org_netlib_blas_NativeBLAS_dnrm2 (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray x, jint incx){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble returnValue;
+
+ returnValue = cblas_dnrm2(n, jni_x, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_drot (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx, jdoubleArray dy, jint incy, jdouble c, jdouble s){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble * jni_dy = (*env)->GetPrimitiveArrayCritical(env, dy, JNI_FALSE);
+ check_memory(env, jni_dy);
+
+ cblas_drot(n, jni_dx, incx, jni_dy, incy, c, s);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dy, jni_dy, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_drotg (JNIEnv * env, jobject calling_obj, jobject da, jobject db, jobject c, jobject s){
+ jclass jni_daClass = (*env)->GetObjectClass(env, da);
+ jfieldID jni_daId = (*env)->GetFieldID(env, jni_daClass, "val", "D");
+ jdouble jni_da = (*env)->GetDoubleField(env, da, jni_daId);
+ jclass jni_dbClass = (*env)->GetObjectClass(env, db);
+ jfieldID jni_dbId = (*env)->GetFieldID(env, jni_dbClass, "val", "D");
+ jdouble jni_db = (*env)->GetDoubleField(env, db, jni_dbId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jdouble jni_c = (*env)->GetDoubleField(env, c, jni_cId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jdouble jni_s = (*env)->GetDoubleField(env, s, jni_sId);
+
+ cblas_drotg(&jni_da, &jni_db, &jni_c, &jni_s);
+
+ (*env)->SetDoubleField(env, da, jni_daId, jni_da);
+ (*env)->SetDoubleField(env, db, jni_dbId, jni_db);
+ (*env)->SetDoubleField(env, c, jni_cId, jni_c);
+ (*env)->SetDoubleField(env, s, jni_sId, jni_s);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_drotm (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx, jdoubleArray dy, jint incy, jdoubleArray dparam){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble * jni_dy = (*env)->GetPrimitiveArrayCritical(env, dy, JNI_FALSE);
+ check_memory(env, jni_dy);
+ jdouble * jni_dparam = (*env)->GetPrimitiveArrayCritical(env, dparam, JNI_FALSE);
+ check_memory(env, jni_dparam);
+
+ cblas_drotm(n, jni_dx, incx, jni_dy, incy, jni_dparam);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dy, jni_dy, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dparam, jni_dparam, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_drotmg (JNIEnv * env, jobject calling_obj, jobject dd1, jobject dd2, jobject dx1, jdouble dy1, jdoubleArray dparam){
+ jclass jni_dd1Class = (*env)->GetObjectClass(env, dd1);
+ jfieldID jni_dd1Id = (*env)->GetFieldID(env, jni_dd1Class, "val", "D");
+ jdouble jni_dd1 = (*env)->GetDoubleField(env, dd1, jni_dd1Id);
+ jclass jni_dd2Class = (*env)->GetObjectClass(env, dd2);
+ jfieldID jni_dd2Id = (*env)->GetFieldID(env, jni_dd2Class, "val", "D");
+ jdouble jni_dd2 = (*env)->GetDoubleField(env, dd2, jni_dd2Id);
+ jclass jni_dx1Class = (*env)->GetObjectClass(env, dx1);
+ jfieldID jni_dx1Id = (*env)->GetFieldID(env, jni_dx1Class, "val", "D");
+ jdouble jni_dx1 = (*env)->GetDoubleField(env, dx1, jni_dx1Id);
+ jdouble * jni_dparam = (*env)->GetPrimitiveArrayCritical(env, dparam, JNI_FALSE);
+ check_memory(env, jni_dparam);
+
+ cblas_drotmg(&jni_dd1, &jni_dd2, &jni_dx1, dy1, jni_dparam);
+
+ (*env)->SetDoubleField(env, dd1, jni_dd1Id, jni_dd1);
+ (*env)->SetDoubleField(env, dd2, jni_dd2Id, jni_dd2);
+ (*env)->SetDoubleField(env, dx1, jni_dx1Id, jni_dx1);
+ (*env)->ReleasePrimitiveArrayCritical(env, dparam, jni_dparam, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsbmv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint k, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray x, jint incx, jdouble beta, jdoubleArray y, jint incy){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_dsbmv(F2J_JNI_ORDER, getUpLo(jni_uplo), n, k, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dscal (JNIEnv * env, jobject calling_obj, jint n, jdouble da, jdoubleArray dx, jint incx){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+
+ cblas_dscal(n, da, jni_dx, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dspmv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdouble alpha, jdoubleArray ap, jdoubleArray x, jint incx, jdouble beta, jdoubleArray y, jint incy){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_dspmv(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_ap, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dspr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdouble alpha, jdoubleArray x, jint incx, jdoubleArray ap){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+
+ cblas_dspr(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_ap);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dspr2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdouble alpha, jdoubleArray x, jint incx, jdoubleArray y, jint incy, jdoubleArray ap){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+
+ cblas_dspr2(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_y, incy, jni_ap);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dswap (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx, jdoubleArray dy, jint incy){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jdouble * jni_dy = (*env)->GetPrimitiveArrayCritical(env, dy, JNI_FALSE);
+ check_memory(env, jni_dy);
+
+ cblas_dswap(n, jni_dx, incx, jni_dy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dy, jni_dy, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsymm (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jint m, jint n, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble beta, jdoubleArray c, jint Ldc){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_dsymm(F2J_JNI_ORDER, getSide(jni_side), getUpLo(jni_uplo), m, n, alpha, jni_a, lda, jni_b, ldb, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsymv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray x, jint incx, jdouble beta, jdoubleArray y, jint incy){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_dsymv(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsyr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdouble alpha, jdoubleArray x, jint incx, jdoubleArray a, jint lda){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ cblas_dsyr(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_a, lda);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsyr2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdouble alpha, jdoubleArray x, jint incx, jdoubleArray y, jint incy, jdoubleArray a, jint lda){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ cblas_dsyr2(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_y, incy, jni_a, lda);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsyr2k (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jint n, jint k, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble beta, jdoubleArray c, jint Ldc){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_dsyr2k(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), n, k, alpha, jni_a, lda, jni_b, ldb, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dsyrk (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jint n, jint k, jdouble alpha, jdoubleArray a, jint lda, jdouble beta, jdoubleArray c, jint Ldc){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_dsyrk(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), n, k, alpha, jni_a, lda, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtbmv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_dtbmv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, k, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtbsv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_dtbsv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, k, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtpmv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jdoubleArray ap, jdoubleArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_dtpmv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_ap, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtpsv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jdoubleArray ap, jdoubleArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_dtpsv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_ap, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtrmm (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring transa, jstring diag, jint m, jint n, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray b, jint ldb){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_transa = (char *)(*env)->GetStringUTFChars(env, transa, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ cblas_dtrmm(F2J_JNI_ORDER, getSide(jni_side), getUpLo(jni_uplo), getTrans(jni_transa), getDiag(jni_diag), m, n, alpha, jni_a, lda, jni_b, ldb);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, transa, jni_transa);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtrmv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jdoubleArray a, jint lda, jdoubleArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_dtrmv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtrsm (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring transa, jstring diag, jint m, jint n, jdouble alpha, jdoubleArray a, jint lda, jdoubleArray b, jint ldb){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_transa = (char *)(*env)->GetStringUTFChars(env, transa, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ cblas_dtrsm(F2J_JNI_ORDER, getSide(jni_side), getUpLo(jni_uplo), getTrans(jni_transa), getDiag(jni_diag), m, n, alpha, jni_a, lda, jni_b, ldb);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, transa, jni_transa);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_dtrsv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jdoubleArray a, jint lda, jdoubleArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_dtrsv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT jint JNICALL Java_org_netlib_blas_NativeBLAS_idamax (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dx, jint incx){
+ jdouble * jni_dx = (*env)->GetPrimitiveArrayCritical(env, dx, JNI_FALSE);
+ check_memory(env, jni_dx);
+ jint returnValue;
+
+ returnValue = cblas_idamax(n, jni_dx, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dx, jni_dx, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT jint JNICALL Java_org_netlib_blas_NativeBLAS_isamax (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jint returnValue;
+
+ returnValue = cblas_isamax(n, jni_sx, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT jfloat JNICALL Java_org_netlib_blas_NativeBLAS_sasum (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat returnValue;
+
+ returnValue = cblas_sasum(n, jni_sx, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_saxpy (JNIEnv * env, jobject calling_obj, jint n, jfloat sa, jfloatArray sx, jint incx, jfloatArray sy, jint incy){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+
+ cblas_saxpy(n, sa, jni_sx, incx, jni_sy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_scopy (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx, jfloatArray sy, jint incy){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+
+ cblas_scopy(n, jni_sx, incx, jni_sy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+}
+
+JNIEXPORT jfloat JNICALL Java_org_netlib_blas_NativeBLAS_sdot (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx, jfloatArray sy, jint incy){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+ jfloat returnValue;
+
+ returnValue = cblas_sdot(n, jni_sx, incx, jni_sy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT jfloat JNICALL Java_org_netlib_blas_NativeBLAS_sdsdot (JNIEnv * env, jobject calling_obj, jint n, jfloat sb, jfloatArray sx, jint incx, jfloatArray sy, jint incy){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+ jfloat returnValue;
+
+ returnValue = cblas_sdsdot(n, sb, jni_sx, incx, jni_sy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sgbmv (JNIEnv * env, jobject calling_obj, jstring trans, jint m, jint n, jint kl, jint ku, jfloat alpha, jfloatArray a, jint lda, jfloatArray x, jint incx, jfloat beta, jfloatArray y, jint incy){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_sgbmv(F2J_JNI_ORDER, getTrans(jni_trans), m, n, kl, ku, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sgemm (JNIEnv * env, jobject calling_obj, jstring transa, jstring transb, jint m, jint n, jint k, jfloat alpha, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat beta, jfloatArray c, jint Ldc){
+ char * jni_transa = (char *)(*env)->GetStringUTFChars(env, transa, JNI_FALSE);
+ char * jni_transb = (char *)(*env)->GetStringUTFChars(env, transb, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_sgemm(F2J_JNI_ORDER, getTrans(jni_transa), getTrans(jni_transb), m, n, k, alpha, jni_a, lda, jni_b, ldb, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, transa, jni_transa);
+ (*env)->ReleaseStringUTFChars(env, transb, jni_transb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sgemv (JNIEnv * env, jobject calling_obj, jstring trans, jint m, jint n, jfloat alpha, jfloatArray a, jint lda, jfloatArray x, jint incx, jfloat beta, jfloatArray y, jint incy){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_sgemv(F2J_JNI_ORDER, getTrans(jni_trans), m, n, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sger (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloat alpha, jfloatArray x, jint incx, jfloatArray y, jint incy, jfloatArray a, jint lda){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ cblas_sger(F2J_JNI_ORDER, m, n, alpha, jni_x, incx, jni_y, incy, jni_a, lda);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT jfloat JNICALL Java_org_netlib_blas_NativeBLAS_snrm2 (JNIEnv * env, jobject calling_obj, jint n, jfloatArray x, jint incx){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat returnValue;
+
+ returnValue = cblas_snrm2(n, jni_x, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_srot (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx, jfloatArray sy, jint incy, jfloat c, jfloat s){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+
+ cblas_srot(n, jni_sx, incx, jni_sy, incy, c, s);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_srotg (JNIEnv * env, jobject calling_obj, jobject sa, jobject sb, jobject c, jobject s){
+ jclass jni_saClass = (*env)->GetObjectClass(env, sa);
+ jfieldID jni_saId = (*env)->GetFieldID(env, jni_saClass, "val", "D");
+ jfloat jni_sa = (*env)->GetFloatField(env, sa, jni_saId);
+ jclass jni_sbClass = (*env)->GetObjectClass(env, sb);
+ jfieldID jni_sbId = (*env)->GetFieldID(env, jni_sbClass, "val", "D");
+ jfloat jni_sb = (*env)->GetFloatField(env, sb, jni_sbId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jfloat jni_c = (*env)->GetFloatField(env, c, jni_cId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jfloat jni_s = (*env)->GetFloatField(env, s, jni_sId);
+
+ cblas_srotg(&jni_sa, &jni_sb, &jni_c, &jni_s);
+
+ (*env)->SetFloatField(env, sa, jni_saId, jni_sa);
+ (*env)->SetFloatField(env, sb, jni_sbId, jni_sb);
+ (*env)->SetFloatField(env, c, jni_cId, jni_c);
+ (*env)->SetFloatField(env, s, jni_sId, jni_s);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_srotm (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx, jfloatArray sy, jint incy, jfloatArray sparam){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+ jfloat * jni_sparam = (*env)->GetPrimitiveArrayCritical(env, sparam, JNI_FALSE);
+ check_memory(env, jni_sparam);
+
+ cblas_srotm(n, jni_sx, incx, jni_sy, incy, jni_sparam);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sparam, jni_sparam, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_srotmg (JNIEnv * env, jobject calling_obj, jobject sd1, jobject sd2, jobject sx1, jfloat sy1, jfloatArray sparam){
+ jclass jni_sd1Class = (*env)->GetObjectClass(env, sd1);
+ jfieldID jni_sd1Id = (*env)->GetFieldID(env, jni_sd1Class, "val", "D");
+ jfloat jni_sd1 = (*env)->GetFloatField(env, sd1, jni_sd1Id);
+ jclass jni_sd2Class = (*env)->GetObjectClass(env, sd2);
+ jfieldID jni_sd2Id = (*env)->GetFieldID(env, jni_sd2Class, "val", "D");
+ jfloat jni_sd2 = (*env)->GetFloatField(env, sd2, jni_sd2Id);
+ jclass jni_sx1Class = (*env)->GetObjectClass(env, sx1);
+ jfieldID jni_sx1Id = (*env)->GetFieldID(env, jni_sx1Class, "val", "D");
+ jfloat jni_sx1 = (*env)->GetFloatField(env, sx1, jni_sx1Id);
+ jfloat * jni_sparam = (*env)->GetPrimitiveArrayCritical(env, sparam, JNI_FALSE);
+ check_memory(env, jni_sparam);
+
+ cblas_srotmg(&jni_sd1, &jni_sd2, &jni_sx1, sy1, jni_sparam);
+
+ (*env)->SetFloatField(env, sd1, jni_sd1Id, jni_sd1);
+ (*env)->SetFloatField(env, sd2, jni_sd2Id, jni_sd2);
+ (*env)->SetFloatField(env, sx1, jni_sx1Id, jni_sx1);
+ (*env)->ReleasePrimitiveArrayCritical(env, sparam, jni_sparam, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssbmv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint k, jfloat alpha, jfloatArray a, jint lda, jfloatArray x, jint incx, jfloat beta, jfloatArray y, jint incy){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_ssbmv(F2J_JNI_ORDER, getUpLo(jni_uplo), n, k, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sscal (JNIEnv * env, jobject calling_obj, jint n, jfloat sa, jfloatArray sx, jint incx){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+
+ cblas_sscal(n, sa, jni_sx, incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sspmv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloat alpha, jfloatArray ap, jfloatArray x, jint incx, jfloat beta, jfloatArray y, jint incy){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_sspmv(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_ap, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sspr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloat alpha, jfloatArray x, jint incx, jfloatArray ap){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+
+ cblas_sspr(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_ap);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sspr2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloat alpha, jfloatArray x, jint incx, jfloatArray y, jint incy, jfloatArray ap){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+
+ cblas_sspr2(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_y, incy, jni_ap);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_sswap (JNIEnv * env, jobject calling_obj, jint n, jfloatArray sx, jint incx, jfloatArray sy, jint incy){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+ jfloat * jni_sy = (*env)->GetPrimitiveArrayCritical(env, sy, JNI_FALSE);
+ check_memory(env, jni_sy);
+
+ cblas_sswap(n, jni_sx, incx, jni_sy, incy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sy, jni_sy, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssymm (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jint m, jint n, jfloat alpha, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat beta, jfloatArray c, jint Ldc){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_ssymm(F2J_JNI_ORDER, getSide(jni_side), getUpLo(jni_uplo), m, n, alpha, jni_a, lda, jni_b, ldb, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssymv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloat alpha, jfloatArray a, jint lda, jfloatArray x, jint incx, jfloat beta, jfloatArray y, jint incy){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ cblas_ssymv(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_a, lda, jni_x, incx, beta, jni_y, incy);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssyr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloat alpha, jfloatArray x, jint incx, jfloatArray a, jint lda){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ cblas_ssyr(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_a, lda);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssyr2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloat alpha, jfloatArray x, jint incx, jfloatArray y, jint incy, jfloatArray a, jint lda){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ cblas_ssyr2(F2J_JNI_ORDER, getUpLo(jni_uplo), n, alpha, jni_x, incx, jni_y, incy, jni_a, lda);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssyr2k (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jint n, jint k, jfloat alpha, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat beta, jfloatArray c, jint Ldc){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_ssyr2k(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), n, k, alpha, jni_a, lda, jni_b, ldb, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_ssyrk (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jint n, jint k, jfloat alpha, jfloatArray a, jint lda, jfloat beta, jfloatArray c, jint Ldc){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ cblas_ssyrk(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), n, k, alpha, jni_a, lda, beta, jni_c, Ldc);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_stbmv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint k, jfloatArray a, jint lda, jfloatArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_stbmv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, k, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_stbsv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint k, jfloatArray a, jint lda, jfloatArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_stbsv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, k, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_stpmv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jfloatArray ap, jfloatArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_stpmv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_ap, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_stpsv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jfloatArray ap, jfloatArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_stpsv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_ap, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_strmm (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring transa, jstring diag, jint m, jint n, jfloat alpha, jfloatArray a, jint lda, jfloatArray b, jint ldb){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_transa = (char *)(*env)->GetStringUTFChars(env, transa, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ cblas_strmm(F2J_JNI_ORDER, getSide(jni_side), getUpLo(jni_uplo), getTrans(jni_transa), getDiag(jni_diag), m, n, alpha, jni_a, lda, jni_b, ldb);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, transa, jni_transa);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_strmv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jfloatArray a, jint lda, jfloatArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_strmv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_strsm (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring transa, jstring diag, jint m, jint n, jfloat alpha, jfloatArray a, jint lda, jfloatArray b, jint ldb){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_transa = (char *)(*env)->GetStringUTFChars(env, transa, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ cblas_strsm(F2J_JNI_ORDER, getSide(jni_side), getUpLo(jni_uplo), getTrans(jni_transa), getDiag(jni_diag), m, n, alpha, jni_a, lda, jni_b, ldb);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, transa, jni_transa);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_blas_NativeBLAS_strsv (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jfloatArray a, jint lda, jfloatArray x, jint incx){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ cblas_strsv(F2J_JNI_ORDER, getUpLo(jni_uplo), getTrans(jni_trans), getDiag(jni_diag), n, jni_a, lda, jni_x, incx);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
diff --git a/jni/org_netlib_lapack_NativeLAPACK.c b/jni/org_netlib_lapack_NativeLAPACK.c
new file mode 100644
index 0000000..f64557f
--- /dev/null
+++ b/jni/org_netlib_lapack_NativeLAPACK.c
@@ -0,0 +1,17512 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+
+#include "f2j_jni.h"
+#include "org_netlib_lapack_NativeLAPACK.h"
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dbdsdc (JNIEnv * env, jobject calling_obj, jstring uplo, jstring compq, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray u, jint ldu, jdoubleArray vt, jint ldvt, jdoubleArray q, jintArray iq, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_iq = (*env)->GetPrimitiveArrayCritical(env, iq, JNI_FALSE);
+ check_memory(env, jni_iq);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dbdsdc_(jni_uplo, jni_compq, &n, jni_d, jni_e, jni_u, &ldu, jni_vt, &ldvt, jni_q, jni_iq, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iq, jni_iq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dbdsqr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint ncvt, jint nru, jint ncc, jdoubleArray d, jdoubleArray e, jdoubleArray vt, jint ldvt, jdoubleArray u, jint ldu, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dbdsqr_(jni_uplo, &n, &ncvt, &nru, &ncc, jni_d, jni_e, jni_vt, &ldvt, jni_u, &ldu, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ddisna (JNIEnv * env, jobject calling_obj, jstring job, jint m, jint n, jdoubleArray d, jdoubleArray sep, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_sep = (*env)->GetPrimitiveArrayCritical(env, sep, JNI_FALSE);
+ check_memory(env, jni_sep);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ddisna_(jni_job, &m, &n, jni_d, jni_sep, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sep, jni_sep, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbbrd (JNIEnv * env, jobject calling_obj, jstring vect, jint m, jint n, jint ncc, jint kl, jint ku, jdoubleArray ab, jint ldab, jdoubleArray d, jdoubleArray e, jdoubleArray q, jint ldq, jdoubleArray pt, jint ldpt, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_pt = (*env)->GetPrimitiveArrayCritical(env, pt, JNI_FALSE);
+ check_memory(env, jni_pt);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbbrd_(jni_vect, &m, &n, &ncc, &kl, &ku, jni_ab, &ldab, jni_d, jni_e, jni_q, &ldq, jni_pt, &ldpt, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, pt, jni_pt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbcon (JNIEnv * env, jobject calling_obj, jstring norm, jint n, jint kl, jint ku, jdoubleArray ab, jint ldab, jintArray ipiv, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbcon_(jni_norm, &n, &kl, &ku, jni_ab, &ldab, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbequ (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jdoubleArray ab, jint ldab, jdoubleArray r, jdoubleArray c, jobject rowcnd, jobject colcnd, jobject amax, jobject info){
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_rowcndClass = (*env)->GetObjectClass(env, rowcnd);
+ jfieldID jni_rowcndId = (*env)->GetFieldID(env, jni_rowcndClass, "val", "D");
+ jdouble jni_rowcnd = (*env)->GetDoubleField(env, rowcnd, jni_rowcndId);
+ jclass jni_colcndClass = (*env)->GetObjectClass(env, colcnd);
+ jfieldID jni_colcndId = (*env)->GetFieldID(env, jni_colcndClass, "val", "D");
+ jdouble jni_colcnd = (*env)->GetDoubleField(env, colcnd, jni_colcndId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jdouble jni_amax = (*env)->GetDoubleField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbequ_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_r, jni_c, &jni_rowcnd, &jni_colcnd, &jni_amax, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetDoubleField(env, rowcnd, jni_rowcndId, jni_rowcnd);
+ (*env)->SetDoubleField(env, colcnd, jni_colcndId, jni_colcnd);
+ (*env)->SetDoubleField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbrfs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint kl, jint ku, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray afb, jint ldafb, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbrfs_(jni_trans, &n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbsv (JNIEnv * env, jobject calling_obj, jint n, jint kl, jint ku, jint nrhs, jdoubleArray ab, jint ldab, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbsv_(&n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring trans, jint n, jint kl, jint ku, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray afb, jint ldafb, jintArray ipiv, jobject equed, jdoubleArray r, jdoubleArray c, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jdouble * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbsvx_(jni_fact, jni_trans, &n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_ipiv, jni_equed, jni_r, jni_c, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbtf2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jdoubleArray ab, jint ldab, jintArray ipiv, jobject info){
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbtf2_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbtrf (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jdoubleArray ab, jint ldab, jintArray ipiv, jobject info){
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbtrf_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgbtrs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint kl, jint ku, jint nrhs, jdoubleArray ab, jint ldab, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgbtrs_(jni_trans, &n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgebak (JNIEnv * env, jobject calling_obj, jstring job, jstring side, jint n, jint ilo, jint ihi, jdoubleArray scale, jint m, jdoubleArray v, jint ldv, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jdouble * jni_scale = (*env)->GetPrimitiveArrayCritical(env, scale, JNI_FALSE);
+ check_memory(env, jni_scale);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgebak_(jni_job, jni_side, &n, &ilo, &ihi, jni_scale, &m, jni_v, &ldv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, scale, jni_scale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgebal (JNIEnv * env, jobject calling_obj, jstring job, jint n, jdoubleArray a, jint lda, jobject ilo, jobject ihi, jdoubleArray scale, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jdouble * jni_scale = (*env)->GetPrimitiveArrayCritical(env, scale, JNI_FALSE);
+ check_memory(env, jni_scale);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgebal_(jni_job, &n, jni_a, &lda, &jni_ilo, &jni_ihi, jni_scale, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, scale, jni_scale, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgebd2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray d, jdoubleArray e, jdoubleArray tauq, jdoubleArray taup, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tauq = (*env)->GetPrimitiveArrayCritical(env, tauq, JNI_FALSE);
+ check_memory(env, jni_tauq);
+ jdouble * jni_taup = (*env)->GetPrimitiveArrayCritical(env, taup, JNI_FALSE);
+ check_memory(env, jni_taup);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgebd2_(&m, &n, jni_a, &lda, jni_d, jni_e, jni_tauq, jni_taup, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tauq, jni_tauq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taup, jni_taup, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgebrd (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray d, jdoubleArray e, jdoubleArray tauq, jdoubleArray taup, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tauq = (*env)->GetPrimitiveArrayCritical(env, tauq, JNI_FALSE);
+ check_memory(env, jni_tauq);
+ jdouble * jni_taup = (*env)->GetPrimitiveArrayCritical(env, taup, JNI_FALSE);
+ check_memory(env, jni_taup);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgebrd_(&m, &n, jni_a, &lda, jni_d, jni_e, jni_tauq, jni_taup, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tauq, jni_tauq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taup, jni_taup, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgecon (JNIEnv * env, jobject calling_obj, jstring norm, jint n, jdoubleArray a, jint lda, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgecon_(jni_norm, &n, jni_a, &lda, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeequ (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray r, jdoubleArray c, jobject rowcnd, jobject colcnd, jobject amax, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_rowcndClass = (*env)->GetObjectClass(env, rowcnd);
+ jfieldID jni_rowcndId = (*env)->GetFieldID(env, jni_rowcndClass, "val", "D");
+ jdouble jni_rowcnd = (*env)->GetDoubleField(env, rowcnd, jni_rowcndId);
+ jclass jni_colcndClass = (*env)->GetObjectClass(env, colcnd);
+ jfieldID jni_colcndId = (*env)->GetFieldID(env, jni_colcndClass, "val", "D");
+ jdouble jni_colcnd = (*env)->GetDoubleField(env, colcnd, jni_colcndId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jdouble jni_amax = (*env)->GetDoubleField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeequ_(&m, &n, jni_a, &lda, jni_r, jni_c, &jni_rowcnd, &jni_colcnd, &jni_amax, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetDoubleField(env, rowcnd, jni_rowcndId, jni_rowcnd);
+ (*env)->SetDoubleField(env, colcnd, jni_colcndId, jni_colcnd);
+ (*env)->SetDoubleField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeev (JNIEnv * env, jobject calling_obj, jstring jobvl, jstring jobvr, jint n, jdoubleArray a, jint lda, jdoubleArray wr, jdoubleArray wi, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jdouble * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeev_(jni_jobvl, jni_jobvr, &n, jni_a, &lda, jni_wr, jni_wi, jni_vl, &ldvl, jni_vr, &ldvr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeevx (JNIEnv * env, jobject calling_obj, jstring balanc, jstring jobvl, jstring jobvr, jstring sense, jint n, jdoubleArray a, jint lda, jdoubleArray wr, jdoubleArray wi, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jobject ilo, jobject ihi, jdoubleArray scale, jobject abnrm, jdoubleArray rconde, jdoubleArray rcondv, jdoubleArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_balanc = (char *)(*env)->GetStringUTFChars(env, balanc, JNI_FALSE);
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ char * jni_sense = (char *)(*env)->GetStringUTFChars(env, sense, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jdouble * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jdouble * jni_scale = (*env)->GetPrimitiveArrayCritical(env, scale, JNI_FALSE);
+ check_memory(env, jni_scale);
+ jclass jni_abnrmClass = (*env)->GetObjectClass(env, abnrm);
+ jfieldID jni_abnrmId = (*env)->GetFieldID(env, jni_abnrmClass, "val", "D");
+ jdouble jni_abnrm = (*env)->GetDoubleField(env, abnrm, jni_abnrmId);
+ jdouble * jni_rconde = (*env)->GetPrimitiveArrayCritical(env, rconde, JNI_FALSE);
+ check_memory(env, jni_rconde);
+ jdouble * jni_rcondv = (*env)->GetPrimitiveArrayCritical(env, rcondv, JNI_FALSE);
+ check_memory(env, jni_rcondv);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeevx_(jni_balanc, jni_jobvl, jni_jobvr, jni_sense, &n, jni_a, &lda, jni_wr, jni_wi, jni_vl, &ldvl, jni_vr, &ldvr, &jni_ilo, &jni_ihi, jni_scale, &jni_abnrm, jni_rconde, jni_rcondv, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, balanc, jni_balanc);
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleaseStringUTFChars(env, sense, jni_sense);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, scale, jni_scale, 0);
+ (*env)->SetDoubleField(env, abnrm, jni_abnrmId, jni_abnrm);
+ (*env)->ReleasePrimitiveArrayCritical(env, rconde, jni_rconde, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rcondv, jni_rcondv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgegs (JNIEnv * env, jobject calling_obj, jstring jobvsl, jstring jobvsr, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jdoubleArray vsl, jint ldvsl, jdoubleArray vsr, jint ldvsr, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobvsl = (char *)(*env)->GetStringUTFChars(env, jobvsl, JNI_FALSE);
+ char * jni_jobvsr = (char *)(*env)->GetStringUTFChars(env, jobvsr, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_vsl = (*env)->GetPrimitiveArrayCritical(env, vsl, JNI_FALSE);
+ check_memory(env, jni_vsl);
+ jdouble * jni_vsr = (*env)->GetPrimitiveArrayCritical(env, vsr, JNI_FALSE);
+ check_memory(env, jni_vsr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgegs_(jni_jobvsl, jni_jobvsr, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vsl, &ldvsl, jni_vsr, &ldvsr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvsl, jni_jobvsl);
+ (*env)->ReleaseStringUTFChars(env, jobvsr, jni_jobvsr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vsl, jni_vsl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vsr, jni_vsr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgegv (JNIEnv * env, jobject calling_obj, jstring jobvl, jstring jobvr, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgegv_(jni_jobvl, jni_jobvr, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vl, &ldvl, jni_vr, &ldvr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgehd2 (JNIEnv * env, jobject calling_obj, jint n, jint ilo, jint ihi, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgehd2_(&n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgehrd (JNIEnv * env, jobject calling_obj, jint n, jint ilo, jint ihi, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgehrd_(&n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgelq2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgelq2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgelqf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgelqf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgels (JNIEnv * env, jobject calling_obj, jstring trans, jint m, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray work, jint lwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgels_(jni_trans, &m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgelsd (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray s, jdouble rcond, jobject rank, jdoubleArray work, jint lwork, jintArray iwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgelsd_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_s, &rcond, &jni_rank, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgelss (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray s, jdouble rcond, jobject rank, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgelss_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_s, &rcond, &jni_rank, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgelsx (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jintArray jpvt, jdouble rcond, jobject rank, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgelsx_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_jpvt, &rcond, &jni_rank, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgelsy (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jintArray jpvt, jdouble rcond, jobject rank, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgelsy_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_jpvt, &rcond, &jni_rank, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeql2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeql2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeqlf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeqlf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeqp3 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jintArray jpvt, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeqp3_(&m, &n, jni_a, &lda, jni_jpvt, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeqpf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jintArray jpvt, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeqpf_(&m, &n, jni_a, &lda, jni_jpvt, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeqr2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeqr2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgeqrf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgeqrf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgerfs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray af, jint ldaf, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgerfs_(jni_trans, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgerq2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgerq2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgerqf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgerqf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgesc2 (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray a, jint lda, jdoubleArray rhs, jintArray ipiv, jintArray jpiv, jobject scale){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_rhs = (*env)->GetPrimitiveArrayCritical(env, rhs, JNI_FALSE);
+ check_memory(env, jni_rhs);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jint * jni_jpiv = (*env)->GetPrimitiveArrayCritical(env, jpiv, JNI_FALSE);
+ check_memory(env, jni_jpiv);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+
+ dgesc2_(&n, jni_a, &lda, jni_rhs, jni_ipiv, jni_jpiv, &jni_scale);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rhs, jni_rhs, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpiv, jni_jpiv, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgesdd (JNIEnv * env, jobject calling_obj, jstring jobz, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray s, jdoubleArray u, jint ldu, jdoubleArray vt, jint ldvt, jdoubleArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgesdd_(jni_jobz, &m, &n, jni_a, &lda, jni_s, jni_u, &ldu, jni_vt, &ldvt, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgesv (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgesv_(&n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgesvd (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobvt, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray s, jdoubleArray u, jint ldu, jdoubleArray vt, jint ldvt, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobvt = (char *)(*env)->GetStringUTFChars(env, jobvt, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgesvd_(jni_jobu, jni_jobvt, &m, &n, jni_a, &lda, jni_s, jni_u, &ldu, jni_vt, &ldvt, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobvt, jni_jobvt);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgesvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring trans, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray af, jint ldaf, jintArray ipiv, jobject equed, jdoubleArray r, jdoubleArray c, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jdouble * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgesvx_(jni_fact, jni_trans, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_equed, jni_r, jni_c, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgetc2 (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray a, jint lda, jintArray ipiv, jintArray jpiv, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jint * jni_jpiv = (*env)->GetPrimitiveArrayCritical(env, jpiv, JNI_FALSE);
+ check_memory(env, jni_jpiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgetc2_(&n, jni_a, &lda, jni_ipiv, jni_jpiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpiv, jni_jpiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgetf2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jintArray ipiv, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgetf2_(&m, &n, jni_a, &lda, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgetrf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jintArray ipiv, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgetrf_(&m, &n, jni_a, &lda, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgetri (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgetri_(&n, jni_a, &lda, jni_ipiv, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgetrs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgetrs_(jni_trans, &n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggbak (JNIEnv * env, jobject calling_obj, jstring job, jstring side, jint n, jint ilo, jint ihi, jdoubleArray lscale, jdoubleArray rscale, jint m, jdoubleArray v, jint ldv, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jdouble * jni_lscale = (*env)->GetPrimitiveArrayCritical(env, lscale, JNI_FALSE);
+ check_memory(env, jni_lscale);
+ jdouble * jni_rscale = (*env)->GetPrimitiveArrayCritical(env, rscale, JNI_FALSE);
+ check_memory(env, jni_rscale);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggbak_(jni_job, jni_side, &n, &ilo, &ihi, jni_lscale, jni_rscale, &m, jni_v, &ldv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, lscale, jni_lscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rscale, jni_rscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggbal (JNIEnv * env, jobject calling_obj, jstring job, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jobject ilo, jobject ihi, jdoubleArray lscale, jdoubleArray rscale, jdoubleArray work, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jdouble * jni_lscale = (*env)->GetPrimitiveArrayCritical(env, lscale, JNI_FALSE);
+ check_memory(env, jni_lscale);
+ jdouble * jni_rscale = (*env)->GetPrimitiveArrayCritical(env, rscale, JNI_FALSE);
+ check_memory(env, jni_rscale);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggbal_(jni_job, &n, jni_a, &lda, jni_b, &ldb, &jni_ilo, &jni_ihi, jni_lscale, jni_rscale, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, lscale, jni_lscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rscale, jni_rscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggev (JNIEnv * env, jobject calling_obj, jstring jobvl, jstring jobvr, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggev_(jni_jobvl, jni_jobvr, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vl, &ldvl, jni_vr, &ldvr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggevx (JNIEnv * env, jobject calling_obj, jstring balanc, jstring jobvl, jstring jobvr, jstring sense, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jobject ilo, jobject ihi, jdoubleArray lscale, jdoubleArray rscale, jobject abnrm, jobject bbnrm, jdoubleArray rconde, jdoubleArray rcondv, jdoubleArray [...]
+ char * jni_balanc = (char *)(*env)->GetStringUTFChars(env, balanc, JNI_FALSE);
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ char * jni_sense = (char *)(*env)->GetStringUTFChars(env, sense, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jdouble * jni_lscale = (*env)->GetPrimitiveArrayCritical(env, lscale, JNI_FALSE);
+ check_memory(env, jni_lscale);
+ jdouble * jni_rscale = (*env)->GetPrimitiveArrayCritical(env, rscale, JNI_FALSE);
+ check_memory(env, jni_rscale);
+ jclass jni_abnrmClass = (*env)->GetObjectClass(env, abnrm);
+ jfieldID jni_abnrmId = (*env)->GetFieldID(env, jni_abnrmClass, "val", "D");
+ jdouble jni_abnrm = (*env)->GetDoubleField(env, abnrm, jni_abnrmId);
+ jclass jni_bbnrmClass = (*env)->GetObjectClass(env, bbnrm);
+ jfieldID jni_bbnrmId = (*env)->GetFieldID(env, jni_bbnrmClass, "val", "D");
+ jdouble jni_bbnrm = (*env)->GetDoubleField(env, bbnrm, jni_bbnrmId);
+ jdouble * jni_rconde = (*env)->GetPrimitiveArrayCritical(env, rconde, JNI_FALSE);
+ check_memory(env, jni_rconde);
+ jdouble * jni_rcondv = (*env)->GetPrimitiveArrayCritical(env, rcondv, JNI_FALSE);
+ check_memory(env, jni_rcondv);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jboolean * jni_bworkTmp = (*env)->GetPrimitiveArrayCritical(env, bwork, JNI_FALSE);
+ jint jni_bworkSize = (*env)->GetArrayLength(env, bwork);
+ logical jni_bwork[jni_bworkSize];
+ int jni_bworki;
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_bworki = 0 ; jni_bworki < jni_bworkSize ; jni_bworki++){
+ if (jni_bworkTmp[jni_bworki] == JNI_FALSE){
+ jni_bwork[jni_bworki] = 0;
+ } else {
+ jni_bwork[jni_bworki] = 1;
+ }
+ }
+
+ dggevx_(jni_balanc, jni_jobvl, jni_jobvr, jni_sense, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vl, &ldvl, jni_vr, &ldvr, &jni_ilo, &jni_ihi, jni_lscale, jni_rscale, &jni_abnrm, &jni_bbnrm, jni_rconde, jni_rcondv, jni_work, &lwork, jni_iwork, jni_bwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, balanc, jni_balanc);
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleaseStringUTFChars(env, sense, jni_sense);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, lscale, jni_lscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rscale, jni_rscale, 0);
+ (*env)->SetDoubleField(env, abnrm, jni_abnrmId, jni_abnrm);
+ (*env)->SetDoubleField(env, bbnrm, jni_bbnrmId, jni_bbnrm);
+ (*env)->ReleasePrimitiveArrayCritical(env, rconde, jni_rconde, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rcondv, jni_rcondv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ for (jni_bworki = 0 ; jni_bworki < jni_bworkSize ; jni_bworki++){
+ if (jni_bwork[jni_bworki] == 0){
+ jni_bworkTmp[jni_bworki] = JNI_FALSE;
+ } else {
+ jni_bworkTmp[jni_bworki] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, bwork, jni_bworkTmp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggglm (JNIEnv * env, jobject calling_obj, jint n, jint m, jint p, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray d, jdoubleArray x, jdoubleArray y, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggglm_(&n, &m, &p, jni_a, &lda, jni_b, &ldb, jni_d, jni_x, jni_y, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgghrd (JNIEnv * env, jobject calling_obj, jstring compq, jstring compz, jint n, jint ilo, jint ihi, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray q, jint ldq, jdoubleArray z, jint ldz, jobject info){
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgghrd_(jni_compq, jni_compz, &n, &ilo, &ihi, jni_a, &lda, jni_b, &ldb, jni_q, &ldq, jni_z, &ldz, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgglse (JNIEnv * env, jobject calling_obj, jint m, jint n, jint p, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray c, jdoubleArray d, jdoubleArray x, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgglse_(&m, &n, &p, jni_a, &lda, jni_b, &ldb, jni_c, jni_d, jni_x, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggqrf (JNIEnv * env, jobject calling_obj, jint n, jint m, jint p, jdoubleArray a, jint lda, jdoubleArray taua, jdoubleArray b, jint ldb, jdoubleArray taub, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_taua = (*env)->GetPrimitiveArrayCritical(env, taua, JNI_FALSE);
+ check_memory(env, jni_taua);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_taub = (*env)->GetPrimitiveArrayCritical(env, taub, JNI_FALSE);
+ check_memory(env, jni_taub);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggqrf_(&n, &m, &p, jni_a, &lda, jni_taua, jni_b, &ldb, jni_taub, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taua, jni_taua, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taub, jni_taub, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggrqf (JNIEnv * env, jobject calling_obj, jint m, jint p, jint n, jdoubleArray a, jint lda, jdoubleArray taua, jdoubleArray b, jint ldb, jdoubleArray taub, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_taua = (*env)->GetPrimitiveArrayCritical(env, taua, JNI_FALSE);
+ check_memory(env, jni_taua);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_taub = (*env)->GetPrimitiveArrayCritical(env, taub, JNI_FALSE);
+ check_memory(env, jni_taub);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggrqf_(&m, &p, &n, jni_a, &lda, jni_taua, jni_b, &ldb, jni_taub, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taua, jni_taua, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taub, jni_taub, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggsvd (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobv, jstring jobq, jint m, jint n, jint p, jobject k, jobject l, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alpha, jdoubleArray beta, jdoubleArray u, jint ldu, jdoubleArray v, jint ldv, jdoubleArray q, jint ldq, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobv = (char *)(*env)->GetStringUTFChars(env, jobv, JNI_FALSE);
+ char * jni_jobq = (char *)(*env)->GetStringUTFChars(env, jobq, JNI_FALSE);
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jclass jni_lClass = (*env)->GetObjectClass(env, l);
+ jfieldID jni_lId = (*env)->GetFieldID(env, jni_lClass, "val", "I");
+ jint jni_l = (*env)->GetIntField(env, l, jni_lId);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alpha = (*env)->GetPrimitiveArrayCritical(env, alpha, JNI_FALSE);
+ check_memory(env, jni_alpha);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggsvd_(jni_jobu, jni_jobv, jni_jobq, &m, &n, &p, &jni_k, &jni_l, jni_a, &lda, jni_b, &ldb, jni_alpha, jni_beta, jni_u, &ldu, jni_v, &ldv, jni_q, &ldq, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobv, jni_jobv);
+ (*env)->ReleaseStringUTFChars(env, jobq, jni_jobq);
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->SetIntField(env, l, jni_lId, jni_l);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alpha, jni_alpha, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dggsvp (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobv, jstring jobq, jint m, jint p, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble tola, jdouble tolb, jobject k, jobject l, jdoubleArray u, jint ldu, jdoubleArray v, jint ldv, jdoubleArray q, jint ldq, jintArray iwork, jdoubleArray tau, jdoubleArray work, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobv = (char *)(*env)->GetStringUTFChars(env, jobv, JNI_FALSE);
+ char * jni_jobq = (char *)(*env)->GetStringUTFChars(env, jobq, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jclass jni_lClass = (*env)->GetObjectClass(env, l);
+ jfieldID jni_lId = (*env)->GetFieldID(env, jni_lClass, "val", "I");
+ jint jni_l = (*env)->GetIntField(env, l, jni_lId);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dggsvp_(jni_jobu, jni_jobv, jni_jobq, &m, &p, &n, jni_a, &lda, jni_b, &ldb, &tola, &tolb, &jni_k, &jni_l, jni_u, &ldu, jni_v, &ldv, jni_q, &ldq, jni_iwork, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobv, jni_jobv);
+ (*env)->ReleaseStringUTFChars(env, jobq, jni_jobq);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->SetIntField(env, l, jni_lId, jni_l);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgtcon (JNIEnv * env, jobject calling_obj, jstring norm, jint n, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray du2, jintArray ipiv, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgtcon_(jni_norm, &n, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgtrfs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray dlf, jdoubleArray df, jdoubleArray duf, jdoubleArray du2, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_dlf = (*env)->GetPrimitiveArrayCritical(env, dlf, JNI_FALSE);
+ check_memory(env, jni_dlf);
+ jdouble * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jdouble * jni_duf = (*env)->GetPrimitiveArrayCritical(env, duf, JNI_FALSE);
+ check_memory(env, jni_duf);
+ jdouble * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgtrfs_(jni_trans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_dlf, jni_df, jni_duf, jni_du2, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlf, jni_dlf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, duf, jni_duf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgtsv (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray b, jint ldb, jobject info){
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgtsv_(&n, &nrhs, jni_dl, jni_d, jni_du, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgtsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring trans, jint n, jint nrhs, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray dlf, jdoubleArray df, jdoubleArray duf, jdoubleArray du2, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_dlf = (*env)->GetPrimitiveArrayCritical(env, dlf, JNI_FALSE);
+ check_memory(env, jni_dlf);
+ jdouble * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jdouble * jni_duf = (*env)->GetPrimitiveArrayCritical(env, duf, JNI_FALSE);
+ check_memory(env, jni_duf);
+ jdouble * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgtsvx_(jni_fact, jni_trans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_dlf, jni_df, jni_duf, jni_du2, jni_ipiv, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlf, jni_dlf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, duf, jni_duf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgttrf (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray du2, jintArray ipiv, jobject info){
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgttrf_(&n, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgttrs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray du2, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dgttrs_(jni_trans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dgtts2 (JNIEnv * env, jobject calling_obj, jint itrans, jint n, jint nrhs, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray du2, jintArray ipiv, jdoubleArray b, jint ldb){
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ dgtts2_(&itrans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, jni_b, &ldb);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dhgeqz (JNIEnv * env, jobject calling_obj, jstring job, jstring compq, jstring compz, jint n, jint ilo, jint ihi, jdoubleArray h, jint ldh, jdoubleArray t, jint ldt, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jdoubleArray q, jint ldq, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jdouble * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dhgeqz_(jni_job, jni_compq, jni_compz, &n, &ilo, &ihi, jni_h, &ldh, jni_t, &ldt, jni_alphar, jni_alphai, jni_beta, jni_q, &ldq, jni_z, &ldz, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dhsein (JNIEnv * env, jobject calling_obj, jstring side, jstring eigsrc, jstring initv, jbooleanArray select, jint n, jdoubleArray h, jint ldh, jdoubleArray wr, jdoubleArray wi, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jint mm, jobject m, jdoubleArray work, jintArray ifaill, jintArray ifailr, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_eigsrc = (char *)(*env)->GetStringUTFChars(env, eigsrc, JNI_FALSE);
+ char * jni_initv = (char *)(*env)->GetStringUTFChars(env, initv, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jdouble * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jdouble * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_ifaill = (*env)->GetPrimitiveArrayCritical(env, ifaill, JNI_FALSE);
+ check_memory(env, jni_ifaill);
+ jint * jni_ifailr = (*env)->GetPrimitiveArrayCritical(env, ifailr, JNI_FALSE);
+ check_memory(env, jni_ifailr);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dhsein_(jni_side, jni_eigsrc, jni_initv, jni_select, &n, jni_h, &ldh, jni_wr, jni_wi, jni_vl, &ldvl, jni_vr, &ldvr, &mm, &jni_m, jni_work, jni_ifaill, jni_ifailr, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, eigsrc, jni_eigsrc);
+ (*env)->ReleaseStringUTFChars(env, initv, jni_initv);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifaill, jni_ifaill, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifailr, jni_ifailr, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dhseqr (JNIEnv * env, jobject calling_obj, jstring job, jstring compz, jint n, jint ilo, jint ihi, jdoubleArray h, jint ldh, jdoubleArray wr, jdoubleArray wi, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jdouble * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jdouble * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jdouble * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dhseqr_(jni_job, jni_compz, &n, &ilo, &ihi, jni_h, &ldh, jni_wr, jni_wi, jni_z, &ldz, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlabad (JNIEnv * env, jobject calling_obj, jobject small, jobject large){
+ jclass jni_smallClass = (*env)->GetObjectClass(env, small);
+ jfieldID jni_smallId = (*env)->GetFieldID(env, jni_smallClass, "val", "D");
+ jdouble jni_small = (*env)->GetDoubleField(env, small, jni_smallId);
+ jclass jni_largeClass = (*env)->GetObjectClass(env, large);
+ jfieldID jni_largeId = (*env)->GetFieldID(env, jni_largeClass, "val", "D");
+ jdouble jni_large = (*env)->GetDoubleField(env, large, jni_largeId);
+
+ dlabad_(&jni_small, &jni_large);
+
+ (*env)->SetDoubleField(env, small, jni_smallId, jni_small);
+ (*env)->SetDoubleField(env, large, jni_largeId, jni_large);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlabrd (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nb, jdoubleArray a, jint lda, jdoubleArray d, jdoubleArray e, jdoubleArray tauq, jdoubleArray taup, jdoubleArray x, jint ldx, jdoubleArray y, jint ldy){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tauq = (*env)->GetPrimitiveArrayCritical(env, tauq, JNI_FALSE);
+ check_memory(env, jni_tauq);
+ jdouble * jni_taup = (*env)->GetPrimitiveArrayCritical(env, taup, JNI_FALSE);
+ check_memory(env, jni_taup);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ dlabrd_(&m, &n, &nb, jni_a, &lda, jni_d, jni_e, jni_tauq, jni_taup, jni_x, &ldx, jni_y, &ldy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tauq, jni_tauq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taup, jni_taup, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlacon (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray v, jdoubleArray x, jintArray isgn, jobject est, jobject kase){
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jint * jni_isgn = (*env)->GetPrimitiveArrayCritical(env, isgn, JNI_FALSE);
+ check_memory(env, jni_isgn);
+ jclass jni_estClass = (*env)->GetObjectClass(env, est);
+ jfieldID jni_estId = (*env)->GetFieldID(env, jni_estClass, "val", "D");
+ jdouble jni_est = (*env)->GetDoubleField(env, est, jni_estId);
+ jclass jni_kaseClass = (*env)->GetObjectClass(env, kase);
+ jfieldID jni_kaseId = (*env)->GetFieldID(env, jni_kaseClass, "val", "I");
+ jint jni_kase = (*env)->GetIntField(env, kase, jni_kaseId);
+
+ dlacon_(&n, jni_v, jni_x, jni_isgn, &jni_est, &jni_kase);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isgn, jni_isgn, 0);
+ (*env)->SetDoubleField(env, est, jni_estId, jni_est);
+ (*env)->SetIntField(env, kase, jni_kaseId, jni_kase);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlacpy (JNIEnv * env, jobject calling_obj, jstring uplo, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ dlacpy_(jni_uplo, &m, &n, jni_a, &lda, jni_b, &ldb);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dladiv (JNIEnv * env, jobject calling_obj, jdouble a, jdouble b, jdouble c, jdouble d, jobject p, jobject q){
+ jclass jni_pClass = (*env)->GetObjectClass(env, p);
+ jfieldID jni_pId = (*env)->GetFieldID(env, jni_pClass, "val", "D");
+ jdouble jni_p = (*env)->GetDoubleField(env, p, jni_pId);
+ jclass jni_qClass = (*env)->GetObjectClass(env, q);
+ jfieldID jni_qId = (*env)->GetFieldID(env, jni_qClass, "val", "D");
+ jdouble jni_q = (*env)->GetDoubleField(env, q, jni_qId);
+
+ dladiv_(&a, &b, &c, &d, &jni_p, &jni_q);
+
+ (*env)->SetDoubleField(env, p, jni_pId, jni_p);
+ (*env)->SetDoubleField(env, q, jni_qId, jni_q);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlae2 (JNIEnv * env, jobject calling_obj, jdouble a, jdouble b, jdouble c, jobject rt1, jobject rt2){
+ jclass jni_rt1Class = (*env)->GetObjectClass(env, rt1);
+ jfieldID jni_rt1Id = (*env)->GetFieldID(env, jni_rt1Class, "val", "D");
+ jdouble jni_rt1 = (*env)->GetDoubleField(env, rt1, jni_rt1Id);
+ jclass jni_rt2Class = (*env)->GetObjectClass(env, rt2);
+ jfieldID jni_rt2Id = (*env)->GetFieldID(env, jni_rt2Class, "val", "D");
+ jdouble jni_rt2 = (*env)->GetDoubleField(env, rt2, jni_rt2Id);
+
+ dlae2_(&a, &b, &c, &jni_rt1, &jni_rt2);
+
+ (*env)->SetDoubleField(env, rt1, jni_rt1Id, jni_rt1);
+ (*env)->SetDoubleField(env, rt2, jni_rt2Id, jni_rt2);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaebz (JNIEnv * env, jobject calling_obj, jint ijob, jint nitmax, jint n, jint mmax, jint minp, jint nbmin, jdouble abstol, jdouble reltol, jdouble pivmin, jdoubleArray d, jdoubleArray e, jdoubleArray e2, jintArray nval, jdoubleArray ab, jdoubleArray c, jobject mout, jintArray nab, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_e2 = (*env)->GetPrimitiveArrayCritical(env, e2, JNI_FALSE);
+ check_memory(env, jni_e2);
+ jint * jni_nval = (*env)->GetPrimitiveArrayCritical(env, nval, JNI_FALSE);
+ check_memory(env, jni_nval);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_moutClass = (*env)->GetObjectClass(env, mout);
+ jfieldID jni_moutId = (*env)->GetFieldID(env, jni_moutClass, "val", "I");
+ jint jni_mout = (*env)->GetIntField(env, mout, jni_moutId);
+ jint * jni_nab = (*env)->GetPrimitiveArrayCritical(env, nab, JNI_FALSE);
+ check_memory(env, jni_nab);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaebz_(&ijob, &nitmax, &n, &mmax, &minp, &nbmin, &abstol, &reltol, &pivmin, jni_d, jni_e, jni_e2, jni_nval, jni_ab, jni_c, &jni_mout, jni_nab, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e2, jni_e2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, nval, jni_nval, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetIntField(env, mout, jni_moutId, jni_mout);
+ (*env)->ReleasePrimitiveArrayCritical(env, nab, jni_nab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed0 (JNIEnv * env, jobject calling_obj, jint icompq, jint qsiz, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray q, jint ldq, jdoubleArray qstore, jint ldqs, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_qstore = (*env)->GetPrimitiveArrayCritical(env, qstore, JNI_FALSE);
+ check_memory(env, jni_qstore);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed0_(&icompq, &qsiz, &n, jni_d, jni_e, jni_q, &ldq, jni_qstore, &ldqs, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, qstore, jni_qstore, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed1 (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray d, jdoubleArray q, jint ldq, jintArray indxq, jobject rho, jint cutpnt, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jdouble jni_rho = (*env)->GetDoubleField(env, rho, jni_rhoId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed1_(&n, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, &cutpnt, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetDoubleField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed2 (JNIEnv * env, jobject calling_obj, jobject k, jint n, jint n1, jdoubleArray d, jdoubleArray q, jint ldq, jintArray indxq, jobject rho, jdoubleArray z, jdoubleArray dlamda, jdoubleArray w, jdoubleArray q2, jintArray indx, jintArray indxc, jintArray indxp, jintArray coltyp, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jdouble jni_rho = (*env)->GetDoubleField(env, rho, jni_rhoId);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_q2 = (*env)->GetPrimitiveArrayCritical(env, q2, JNI_FALSE);
+ check_memory(env, jni_q2);
+ jint * jni_indx = (*env)->GetPrimitiveArrayCritical(env, indx, JNI_FALSE);
+ check_memory(env, jni_indx);
+ jint * jni_indxc = (*env)->GetPrimitiveArrayCritical(env, indxc, JNI_FALSE);
+ check_memory(env, jni_indxc);
+ jint * jni_indxp = (*env)->GetPrimitiveArrayCritical(env, indxp, JNI_FALSE);
+ check_memory(env, jni_indxp);
+ jint * jni_coltyp = (*env)->GetPrimitiveArrayCritical(env, coltyp, JNI_FALSE);
+ check_memory(env, jni_coltyp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed2_(&jni_k, &n, &n1, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, jni_z, jni_dlamda, jni_w, jni_q2, jni_indx, jni_indxc, jni_indxp, jni_coltyp, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetDoubleField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q2, jni_q2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indx, jni_indx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxc, jni_indxc, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxp, jni_indxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, coltyp, jni_coltyp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed3 (JNIEnv * env, jobject calling_obj, jint k, jint n, jint n1, jdoubleArray d, jdoubleArray q, jint ldq, jdouble rho, jdoubleArray dlamda, jdoubleArray q2, jintArray indx, jintArray ctot, jdoubleArray w, jdoubleArray s, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jdouble * jni_q2 = (*env)->GetPrimitiveArrayCritical(env, q2, JNI_FALSE);
+ check_memory(env, jni_q2);
+ jint * jni_indx = (*env)->GetPrimitiveArrayCritical(env, indx, JNI_FALSE);
+ check_memory(env, jni_indx);
+ jint * jni_ctot = (*env)->GetPrimitiveArrayCritical(env, ctot, JNI_FALSE);
+ check_memory(env, jni_ctot);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed3_(&k, &n, &n1, jni_d, jni_q, &ldq, &rho, jni_dlamda, jni_q2, jni_indx, jni_ctot, jni_w, jni_s, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q2, jni_q2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indx, jni_indx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ctot, jni_ctot, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed4 (JNIEnv * env, jobject calling_obj, jint n, jint i, jdoubleArray d, jdoubleArray z, jdoubleArray delta, jdouble rho, jobject dlam, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_dlamClass = (*env)->GetObjectClass(env, dlam);
+ jfieldID jni_dlamId = (*env)->GetFieldID(env, jni_dlamClass, "val", "D");
+ jdouble jni_dlam = (*env)->GetDoubleField(env, dlam, jni_dlamId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed4_(&n, &i, jni_d, jni_z, jni_delta, &rho, &jni_dlam, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetDoubleField(env, dlam, jni_dlamId, jni_dlam);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed5 (JNIEnv * env, jobject calling_obj, jint i, jdoubleArray d, jdoubleArray z, jdoubleArray delta, jdouble rho, jobject dlam){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_dlamClass = (*env)->GetObjectClass(env, dlam);
+ jfieldID jni_dlamId = (*env)->GetFieldID(env, jni_dlamClass, "val", "D");
+ jdouble jni_dlam = (*env)->GetDoubleField(env, dlam, jni_dlamId);
+
+ dlaed5_(&i, jni_d, jni_z, jni_delta, &rho, &jni_dlam);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetDoubleField(env, dlam, jni_dlamId, jni_dlam);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed6 (JNIEnv * env, jobject calling_obj, jint kniter, jboolean orgati, jdouble rho, jdoubleArray d, jdoubleArray z, jdouble finit, jobject tau, jobject info){
+ logical jni_orgati = (logical)orgati;
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_tauClass = (*env)->GetObjectClass(env, tau);
+ jfieldID jni_tauId = (*env)->GetFieldID(env, jni_tauClass, "val", "D");
+ jdouble jni_tau = (*env)->GetDoubleField(env, tau, jni_tauId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed6_(&kniter, &jni_orgati, &rho, jni_d, jni_z, &finit, &jni_tau, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetDoubleField(env, tau, jni_tauId, jni_tau);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed7 (JNIEnv * env, jobject calling_obj, jint icompq, jint n, jint qsiz, jint tlvls, jint curlvl, jint curpbm, jdoubleArray d, jdoubleArray q, jint ldq, jintArray indxq, jobject rho, jint cutpnt, jdoubleArray qstore, jintArray qptr, jintArray prmptr, jintArray perm, jintArray givptr, jintArray givcol, jdoubleArray givnum, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jdouble jni_rho = (*env)->GetDoubleField(env, rho, jni_rhoId);
+ jdouble * jni_qstore = (*env)->GetPrimitiveArrayCritical(env, qstore, JNI_FALSE);
+ check_memory(env, jni_qstore);
+ jint * jni_qptr = (*env)->GetPrimitiveArrayCritical(env, qptr, JNI_FALSE);
+ check_memory(env, jni_qptr);
+ jint * jni_prmptr = (*env)->GetPrimitiveArrayCritical(env, prmptr, JNI_FALSE);
+ check_memory(env, jni_prmptr);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed7_(&icompq, &n, &qsiz, &tlvls, &curlvl, &curpbm, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, &cutpnt, jni_qstore, jni_qptr, jni_prmptr, jni_perm, jni_givptr, jni_givcol, jni_givnum, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetDoubleField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, qstore, jni_qstore, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, qptr, jni_qptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, prmptr, jni_prmptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed8 (JNIEnv * env, jobject calling_obj, jint icompq, jobject k, jint n, jint qsiz, jdoubleArray d, jdoubleArray q, jint ldq, jintArray indxq, jobject rho, jint cutpnt, jdoubleArray z, jdoubleArray dlamda, jdoubleArray q2, jint ldq2, jdoubleArray w, jintArray perm, jobject givptr, jintArray givcol, jdoubleArray givnum, jintArray indxp, jintArray indx, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jdouble jni_rho = (*env)->GetDoubleField(env, rho, jni_rhoId);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jdouble * jni_q2 = (*env)->GetPrimitiveArrayCritical(env, q2, JNI_FALSE);
+ check_memory(env, jni_q2);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jclass jni_givptrClass = (*env)->GetObjectClass(env, givptr);
+ jfieldID jni_givptrId = (*env)->GetFieldID(env, jni_givptrClass, "val", "I");
+ jint jni_givptr = (*env)->GetIntField(env, givptr, jni_givptrId);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jint * jni_indxp = (*env)->GetPrimitiveArrayCritical(env, indxp, JNI_FALSE);
+ check_memory(env, jni_indxp);
+ jint * jni_indx = (*env)->GetPrimitiveArrayCritical(env, indx, JNI_FALSE);
+ check_memory(env, jni_indx);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed8_(&icompq, &jni_k, &n, &qsiz, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, &cutpnt, jni_z, jni_dlamda, jni_q2, &ldq2, jni_w, jni_perm, &jni_givptr, jni_givcol, jni_givnum, jni_indxp, jni_indx, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetDoubleField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q2, jni_q2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->SetIntField(env, givptr, jni_givptrId, jni_givptr);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxp, jni_indxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indx, jni_indx, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaed9 (JNIEnv * env, jobject calling_obj, jint k, jint kstart, jint kstop, jint n, jdoubleArray d, jdoubleArray q, jint ldq, jdouble rho, jdoubleArray dlamda, jdoubleArray w, jdoubleArray s, jint lds, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaed9_(&k, &kstart, &kstop, &n, jni_d, jni_q, &ldq, &rho, jni_dlamda, jni_w, jni_s, &lds, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaeda (JNIEnv * env, jobject calling_obj, jint n, jint tlvls, jint curlvl, jint curpbm, jintArray prmptr, jintArray perm, jintArray givptr, jintArray givcol, jdoubleArray givnum, jdoubleArray q, jintArray qptr, jdoubleArray z, jdoubleArray ztemp, jobject info){
+ jint * jni_prmptr = (*env)->GetPrimitiveArrayCritical(env, prmptr, JNI_FALSE);
+ check_memory(env, jni_prmptr);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_qptr = (*env)->GetPrimitiveArrayCritical(env, qptr, JNI_FALSE);
+ check_memory(env, jni_qptr);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_ztemp = (*env)->GetPrimitiveArrayCritical(env, ztemp, JNI_FALSE);
+ check_memory(env, jni_ztemp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaeda_(&n, &tlvls, &curlvl, &curpbm, jni_prmptr, jni_perm, jni_givptr, jni_givcol, jni_givnum, jni_q, jni_qptr, jni_z, jni_ztemp, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, prmptr, jni_prmptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, qptr, jni_qptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ztemp, jni_ztemp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaein (JNIEnv * env, jobject calling_obj, jboolean rightv, jboolean noinit, jint n, jdoubleArray h, jint ldh, jdouble wr, jdouble wi, jdoubleArray vr, jdoubleArray vi, jdoubleArray b, jint ldb, jdoubleArray work, jdouble eps3, jdouble smlnum, jdouble bignum, jobject info){
+ logical jni_rightv = (logical)rightv;
+ logical jni_noinit = (logical)noinit;
+ jdouble * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jdouble * jni_vi = (*env)->GetPrimitiveArrayCritical(env, vi, JNI_FALSE);
+ check_memory(env, jni_vi);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaein_(&jni_rightv, &jni_noinit, &n, jni_h, &ldh, &wr, &wi, jni_vr, jni_vi, jni_b, &ldb, jni_work, &eps3, &smlnum, &bignum, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vi, jni_vi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaev2 (JNIEnv * env, jobject calling_obj, jdouble a, jdouble b, jdouble c, jobject rt1, jobject rt2, jobject cs1, jobject sn1){
+ jclass jni_rt1Class = (*env)->GetObjectClass(env, rt1);
+ jfieldID jni_rt1Id = (*env)->GetFieldID(env, jni_rt1Class, "val", "D");
+ jdouble jni_rt1 = (*env)->GetDoubleField(env, rt1, jni_rt1Id);
+ jclass jni_rt2Class = (*env)->GetObjectClass(env, rt2);
+ jfieldID jni_rt2Id = (*env)->GetFieldID(env, jni_rt2Class, "val", "D");
+ jdouble jni_rt2 = (*env)->GetDoubleField(env, rt2, jni_rt2Id);
+ jclass jni_cs1Class = (*env)->GetObjectClass(env, cs1);
+ jfieldID jni_cs1Id = (*env)->GetFieldID(env, jni_cs1Class, "val", "D");
+ jdouble jni_cs1 = (*env)->GetDoubleField(env, cs1, jni_cs1Id);
+ jclass jni_sn1Class = (*env)->GetObjectClass(env, sn1);
+ jfieldID jni_sn1Id = (*env)->GetFieldID(env, jni_sn1Class, "val", "D");
+ jdouble jni_sn1 = (*env)->GetDoubleField(env, sn1, jni_sn1Id);
+
+ dlaev2_(&a, &b, &c, &jni_rt1, &jni_rt2, &jni_cs1, &jni_sn1);
+
+ (*env)->SetDoubleField(env, rt1, jni_rt1Id, jni_rt1);
+ (*env)->SetDoubleField(env, rt2, jni_rt2Id, jni_rt2);
+ (*env)->SetDoubleField(env, cs1, jni_cs1Id, jni_cs1);
+ (*env)->SetDoubleField(env, sn1, jni_sn1Id, jni_sn1);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaexc (JNIEnv * env, jobject calling_obj, jboolean wantq, jint n, jdoubleArray t, jint ldt, jdoubleArray q, jint ldq, jint j1, jint n1, jint n2, jdoubleArray work, jobject info){
+ logical jni_wantq = (logical)wantq;
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaexc_(&jni_wantq, &n, jni_t, &ldt, jni_q, &ldq, &j1, &n1, &n2, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlag2 (JNIEnv * env, jobject calling_obj, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble safmin, jobject scale1, jobject scale2, jobject wr1, jobject wr2, jobject wi){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_scale1Class = (*env)->GetObjectClass(env, scale1);
+ jfieldID jni_scale1Id = (*env)->GetFieldID(env, jni_scale1Class, "val", "D");
+ jdouble jni_scale1 = (*env)->GetDoubleField(env, scale1, jni_scale1Id);
+ jclass jni_scale2Class = (*env)->GetObjectClass(env, scale2);
+ jfieldID jni_scale2Id = (*env)->GetFieldID(env, jni_scale2Class, "val", "D");
+ jdouble jni_scale2 = (*env)->GetDoubleField(env, scale2, jni_scale2Id);
+ jclass jni_wr1Class = (*env)->GetObjectClass(env, wr1);
+ jfieldID jni_wr1Id = (*env)->GetFieldID(env, jni_wr1Class, "val", "D");
+ jdouble jni_wr1 = (*env)->GetDoubleField(env, wr1, jni_wr1Id);
+ jclass jni_wr2Class = (*env)->GetObjectClass(env, wr2);
+ jfieldID jni_wr2Id = (*env)->GetFieldID(env, jni_wr2Class, "val", "D");
+ jdouble jni_wr2 = (*env)->GetDoubleField(env, wr2, jni_wr2Id);
+ jclass jni_wiClass = (*env)->GetObjectClass(env, wi);
+ jfieldID jni_wiId = (*env)->GetFieldID(env, jni_wiClass, "val", "D");
+ jdouble jni_wi = (*env)->GetDoubleField(env, wi, jni_wiId);
+
+ dlag2_(jni_a, &lda, jni_b, &ldb, &safmin, &jni_scale1, &jni_scale2, &jni_wr1, &jni_wr2, &jni_wi);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetDoubleField(env, scale1, jni_scale1Id, jni_scale1);
+ (*env)->SetDoubleField(env, scale2, jni_scale2Id, jni_scale2);
+ (*env)->SetDoubleField(env, wr1, jni_wr1Id, jni_wr1);
+ (*env)->SetDoubleField(env, wr2, jni_wr2Id, jni_wr2);
+ (*env)->SetDoubleField(env, wi, jni_wiId, jni_wi);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlags2 (JNIEnv * env, jobject calling_obj, jboolean upper, jdouble a1, jdouble a2, jdouble a3, jdouble b1, jdouble b2, jdouble b3, jobject csu, jobject snu, jobject csv, jobject snv, jobject csq, jobject snq){
+ logical jni_upper = (logical)upper;
+ jclass jni_csuClass = (*env)->GetObjectClass(env, csu);
+ jfieldID jni_csuId = (*env)->GetFieldID(env, jni_csuClass, "val", "D");
+ jdouble jni_csu = (*env)->GetDoubleField(env, csu, jni_csuId);
+ jclass jni_snuClass = (*env)->GetObjectClass(env, snu);
+ jfieldID jni_snuId = (*env)->GetFieldID(env, jni_snuClass, "val", "D");
+ jdouble jni_snu = (*env)->GetDoubleField(env, snu, jni_snuId);
+ jclass jni_csvClass = (*env)->GetObjectClass(env, csv);
+ jfieldID jni_csvId = (*env)->GetFieldID(env, jni_csvClass, "val", "D");
+ jdouble jni_csv = (*env)->GetDoubleField(env, csv, jni_csvId);
+ jclass jni_snvClass = (*env)->GetObjectClass(env, snv);
+ jfieldID jni_snvId = (*env)->GetFieldID(env, jni_snvClass, "val", "D");
+ jdouble jni_snv = (*env)->GetDoubleField(env, snv, jni_snvId);
+ jclass jni_csqClass = (*env)->GetObjectClass(env, csq);
+ jfieldID jni_csqId = (*env)->GetFieldID(env, jni_csqClass, "val", "D");
+ jdouble jni_csq = (*env)->GetDoubleField(env, csq, jni_csqId);
+ jclass jni_snqClass = (*env)->GetObjectClass(env, snq);
+ jfieldID jni_snqId = (*env)->GetFieldID(env, jni_snqClass, "val", "D");
+ jdouble jni_snq = (*env)->GetDoubleField(env, snq, jni_snqId);
+
+ dlags2_(&jni_upper, &a1, &a2, &a3, &b1, &b2, &b3, &jni_csu, &jni_snu, &jni_csv, &jni_snv, &jni_csq, &jni_snq);
+
+ (*env)->SetDoubleField(env, csu, jni_csuId, jni_csu);
+ (*env)->SetDoubleField(env, snu, jni_snuId, jni_snu);
+ (*env)->SetDoubleField(env, csv, jni_csvId, jni_csv);
+ (*env)->SetDoubleField(env, snv, jni_snvId, jni_snv);
+ (*env)->SetDoubleField(env, csq, jni_csqId, jni_csq);
+ (*env)->SetDoubleField(env, snq, jni_snqId, jni_snq);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlagtf (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray a, jdouble lambda, jdoubleArray b, jdoubleArray c, jdouble tol, jdoubleArray d, jintArray in, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jint * jni_in = (*env)->GetPrimitiveArrayCritical(env, in, JNI_FALSE);
+ check_memory(env, jni_in);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlagtf_(&n, jni_a, &lambda, jni_b, jni_c, &tol, jni_d, jni_in, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, in, jni_in, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlagtm (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jdouble alpha, jdoubleArray dl, jdoubleArray d, jdoubleArray du, jdoubleArray x, jint ldx, jdouble beta, jdoubleArray b, jint ldb){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ dlagtm_(jni_trans, &n, &nrhs, &alpha, jni_dl, jni_d, jni_du, jni_x, &ldx, &beta, jni_b, &ldb);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlagts (JNIEnv * env, jobject calling_obj, jint job, jint n, jdoubleArray a, jdoubleArray b, jdoubleArray c, jdoubleArray d, jintArray in, jdoubleArray y, jobject tol, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jint * jni_in = (*env)->GetPrimitiveArrayCritical(env, in, JNI_FALSE);
+ check_memory(env, jni_in);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jclass jni_tolClass = (*env)->GetObjectClass(env, tol);
+ jfieldID jni_tolId = (*env)->GetFieldID(env, jni_tolClass, "val", "D");
+ jdouble jni_tol = (*env)->GetDoubleField(env, tol, jni_tolId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlagts_(&job, &n, jni_a, jni_b, jni_c, jni_d, jni_in, jni_y, &jni_tol, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, in, jni_in, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->SetDoubleField(env, tol, jni_tolId, jni_tol);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlagv2 (JNIEnv * env, jobject calling_obj, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jobject csl, jobject snl, jobject csr, jobject snr){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jclass jni_cslClass = (*env)->GetObjectClass(env, csl);
+ jfieldID jni_cslId = (*env)->GetFieldID(env, jni_cslClass, "val", "D");
+ jdouble jni_csl = (*env)->GetDoubleField(env, csl, jni_cslId);
+ jclass jni_snlClass = (*env)->GetObjectClass(env, snl);
+ jfieldID jni_snlId = (*env)->GetFieldID(env, jni_snlClass, "val", "D");
+ jdouble jni_snl = (*env)->GetDoubleField(env, snl, jni_snlId);
+ jclass jni_csrClass = (*env)->GetObjectClass(env, csr);
+ jfieldID jni_csrId = (*env)->GetFieldID(env, jni_csrClass, "val", "D");
+ jdouble jni_csr = (*env)->GetDoubleField(env, csr, jni_csrId);
+ jclass jni_snrClass = (*env)->GetObjectClass(env, snr);
+ jfieldID jni_snrId = (*env)->GetFieldID(env, jni_snrClass, "val", "D");
+ jdouble jni_snr = (*env)->GetDoubleField(env, snr, jni_snrId);
+
+ dlagv2_(jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, &jni_csl, &jni_snl, &jni_csr, &jni_snr);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->SetDoubleField(env, csl, jni_cslId, jni_csl);
+ (*env)->SetDoubleField(env, snl, jni_snlId, jni_snl);
+ (*env)->SetDoubleField(env, csr, jni_csrId, jni_csr);
+ (*env)->SetDoubleField(env, snr, jni_snrId, jni_snr);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlahqr (JNIEnv * env, jobject calling_obj, jboolean wantt, jboolean wantz, jint n, jint ilo, jint ihi, jdoubleArray h, jint ldh, jdoubleArray wr, jdoubleArray wi, jint iloz, jint ihiz, jdoubleArray z, jint ldz, jobject info){
+ logical jni_wantt = (logical)wantt;
+ logical jni_wantz = (logical)wantz;
+ jdouble * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jdouble * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jdouble * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlahqr_(&jni_wantt, &jni_wantz, &n, &ilo, &ihi, jni_h, &ldh, jni_wr, jni_wi, &iloz, &ihiz, jni_z, &ldz, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlahrd (JNIEnv * env, jobject calling_obj, jint n, jint k, jint nb, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray t, jint ldt, jdoubleArray y, jint ldy){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ dlahrd_(&n, &k, &nb, jni_a, &lda, jni_tau, jni_t, &ldt, jni_y, &ldy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaic1 (JNIEnv * env, jobject calling_obj, jint job, jint j, jdoubleArray x, jdouble sest, jdoubleArray w, jdouble gamma, jobject sestpr, jobject s, jobject c){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jclass jni_sestprClass = (*env)->GetObjectClass(env, sestpr);
+ jfieldID jni_sestprId = (*env)->GetFieldID(env, jni_sestprClass, "val", "D");
+ jdouble jni_sestpr = (*env)->GetDoubleField(env, sestpr, jni_sestprId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jdouble jni_s = (*env)->GetDoubleField(env, s, jni_sId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jdouble jni_c = (*env)->GetDoubleField(env, c, jni_cId);
+
+ dlaic1_(&job, &j, jni_x, &sest, jni_w, &gamma, &jni_sestpr, &jni_s, &jni_c);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->SetDoubleField(env, sestpr, jni_sestprId, jni_sestpr);
+ (*env)->SetDoubleField(env, s, jni_sId, jni_s);
+ (*env)->SetDoubleField(env, c, jni_cId, jni_c);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaln2 (JNIEnv * env, jobject calling_obj, jboolean ltrans, jint na, jint nw, jdouble smin, jdouble ca, jdoubleArray a, jint lda, jdouble d1, jdouble d2, jdoubleArray b, jint ldb, jdouble wr, jdouble wi, jdoubleArray x, jint ldx, jobject scale, jobject xnorm, jobject info){
+ logical jni_ltrans = (logical)ltrans;
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jclass jni_xnormClass = (*env)->GetObjectClass(env, xnorm);
+ jfieldID jni_xnormId = (*env)->GetFieldID(env, jni_xnormClass, "val", "D");
+ jdouble jni_xnorm = (*env)->GetDoubleField(env, xnorm, jni_xnormId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaln2_(&jni_ltrans, &na, &nw, &smin, &ca, jni_a, &lda, &d1, &d2, jni_b, &ldb, &wr, &wi, jni_x, &ldx, &jni_scale, &jni_xnorm, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetDoubleField(env, xnorm, jni_xnormId, jni_xnorm);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlals0 (JNIEnv * env, jobject calling_obj, jint icompq, jint nl, jint nr, jint sqre, jint nrhs, jdoubleArray b, jint ldb, jdoubleArray bx, jint ldbx, jintArray perm, jint givptr, jintArray givcol, jint ldgcol, jdoubleArray givnum, jint ldgnum, jdoubleArray poles, jdoubleArray difl, jdoubleArray difr, jdoubleArray z, jint k, jdouble c, jdouble s, jdoubleArray work, jobject info){
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_bx = (*env)->GetPrimitiveArrayCritical(env, bx, JNI_FALSE);
+ check_memory(env, jni_bx);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jdouble * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jdouble * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jdouble * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlals0_(&icompq, &nl, &nr, &sqre, &nrhs, jni_b, &ldb, jni_bx, &ldbx, jni_perm, &givptr, jni_givcol, &ldgcol, jni_givnum, &ldgnum, jni_poles, jni_difl, jni_difr, jni_z, &k, &c, &s, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bx, jni_bx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlalsa (JNIEnv * env, jobject calling_obj, jint icompq, jint smlsiz, jint n, jint nrhs, jdoubleArray b, jint ldb, jdoubleArray bx, jint ldbx, jdoubleArray u, jint ldu, jdoubleArray vt, jintArray k, jdoubleArray difl, jdoubleArray difr, jdoubleArray z, jdoubleArray poles, jintArray givptr, jintArray givcol, jint ldgcol, jintArray perm, jdoubleArray givnum, jdoubleArray c, jdoubleArray s, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_bx = (*env)->GetPrimitiveArrayCritical(env, bx, JNI_FALSE);
+ check_memory(env, jni_bx);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_k = (*env)->GetPrimitiveArrayCritical(env, k, JNI_FALSE);
+ check_memory(env, jni_k);
+ jdouble * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jdouble * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlalsa_(&icompq, &smlsiz, &n, &nrhs, jni_b, &ldb, jni_bx, &ldbx, jni_u, &ldu, jni_vt, jni_k, jni_difl, jni_difr, jni_z, jni_poles, jni_givptr, jni_givcol, &ldgcol, jni_perm, jni_givnum, jni_c, jni_s, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bx, jni_bx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, k, jni_k, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlalsd (JNIEnv * env, jobject calling_obj, jstring uplo, jint smlsiz, jint n, jint nrhs, jdoubleArray d, jdoubleArray e, jdoubleArray b, jint ldb, jdouble rcond, jobject rank, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlalsd_(jni_uplo, &smlsiz, &n, &nrhs, jni_d, jni_e, jni_b, &ldb, &rcond, &jni_rank, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlamrg (JNIEnv * env, jobject calling_obj, jint n1, jint n2, jdoubleArray a, jint dtrd1, jint dtrd2, jintArray index){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_index = (*env)->GetPrimitiveArrayCritical(env, index, JNI_FALSE);
+ check_memory(env, jni_index);
+
+ dlamrg_(&n1, &n2, jni_a, &dtrd1, &dtrd2, jni_index);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, index, jni_index, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlanv2 (JNIEnv * env, jobject calling_obj, jobject a, jobject b, jobject c, jobject d, jobject rt1r, jobject rt1i, jobject rt2r, jobject rt2i, jobject cs, jobject sn){
+ jclass jni_aClass = (*env)->GetObjectClass(env, a);
+ jfieldID jni_aId = (*env)->GetFieldID(env, jni_aClass, "val", "D");
+ jdouble jni_a = (*env)->GetDoubleField(env, a, jni_aId);
+ jclass jni_bClass = (*env)->GetObjectClass(env, b);
+ jfieldID jni_bId = (*env)->GetFieldID(env, jni_bClass, "val", "D");
+ jdouble jni_b = (*env)->GetDoubleField(env, b, jni_bId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jdouble jni_c = (*env)->GetDoubleField(env, c, jni_cId);
+ jclass jni_dClass = (*env)->GetObjectClass(env, d);
+ jfieldID jni_dId = (*env)->GetFieldID(env, jni_dClass, "val", "D");
+ jdouble jni_d = (*env)->GetDoubleField(env, d, jni_dId);
+ jclass jni_rt1rClass = (*env)->GetObjectClass(env, rt1r);
+ jfieldID jni_rt1rId = (*env)->GetFieldID(env, jni_rt1rClass, "val", "D");
+ jdouble jni_rt1r = (*env)->GetDoubleField(env, rt1r, jni_rt1rId);
+ jclass jni_rt1iClass = (*env)->GetObjectClass(env, rt1i);
+ jfieldID jni_rt1iId = (*env)->GetFieldID(env, jni_rt1iClass, "val", "D");
+ jdouble jni_rt1i = (*env)->GetDoubleField(env, rt1i, jni_rt1iId);
+ jclass jni_rt2rClass = (*env)->GetObjectClass(env, rt2r);
+ jfieldID jni_rt2rId = (*env)->GetFieldID(env, jni_rt2rClass, "val", "D");
+ jdouble jni_rt2r = (*env)->GetDoubleField(env, rt2r, jni_rt2rId);
+ jclass jni_rt2iClass = (*env)->GetObjectClass(env, rt2i);
+ jfieldID jni_rt2iId = (*env)->GetFieldID(env, jni_rt2iClass, "val", "D");
+ jdouble jni_rt2i = (*env)->GetDoubleField(env, rt2i, jni_rt2iId);
+ jclass jni_csClass = (*env)->GetObjectClass(env, cs);
+ jfieldID jni_csId = (*env)->GetFieldID(env, jni_csClass, "val", "D");
+ jdouble jni_cs = (*env)->GetDoubleField(env, cs, jni_csId);
+ jclass jni_snClass = (*env)->GetObjectClass(env, sn);
+ jfieldID jni_snId = (*env)->GetFieldID(env, jni_snClass, "val", "D");
+ jdouble jni_sn = (*env)->GetDoubleField(env, sn, jni_snId);
+
+ dlanv2_(&jni_a, &jni_b, &jni_c, &jni_d, &jni_rt1r, &jni_rt1i, &jni_rt2r, &jni_rt2i, &jni_cs, &jni_sn);
+
+ (*env)->SetDoubleField(env, a, jni_aId, jni_a);
+ (*env)->SetDoubleField(env, b, jni_bId, jni_b);
+ (*env)->SetDoubleField(env, c, jni_cId, jni_c);
+ (*env)->SetDoubleField(env, d, jni_dId, jni_d);
+ (*env)->SetDoubleField(env, rt1r, jni_rt1rId, jni_rt1r);
+ (*env)->SetDoubleField(env, rt1i, jni_rt1iId, jni_rt1i);
+ (*env)->SetDoubleField(env, rt2r, jni_rt2rId, jni_rt2r);
+ (*env)->SetDoubleField(env, rt2i, jni_rt2iId, jni_rt2i);
+ (*env)->SetDoubleField(env, cs, jni_csId, jni_cs);
+ (*env)->SetDoubleField(env, sn, jni_snId, jni_sn);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlapll (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray x, jint incx, jdoubleArray y, jint incy, jobject ssmin){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jclass jni_ssminClass = (*env)->GetObjectClass(env, ssmin);
+ jfieldID jni_ssminId = (*env)->GetFieldID(env, jni_ssminClass, "val", "D");
+ jdouble jni_ssmin = (*env)->GetDoubleField(env, ssmin, jni_ssminId);
+
+ dlapll_(&n, jni_x, &incx, jni_y, &incy, &jni_ssmin);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->SetDoubleField(env, ssmin, jni_ssminId, jni_ssmin);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlapmt (JNIEnv * env, jobject calling_obj, jboolean forwrd, jint m, jint n, jdoubleArray x, jint ldx, jintArray k){
+ logical jni_forwrd = (logical)forwrd;
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jint * jni_k = (*env)->GetPrimitiveArrayCritical(env, k, JNI_FALSE);
+ check_memory(env, jni_k);
+
+ dlapmt_(&jni_forwrd, &m, &n, jni_x, &ldx, jni_k);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, k, jni_k, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqgb (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jdoubleArray ab, jint ldab, jdoubleArray r, jdoubleArray c, jdouble rowcnd, jdouble colcnd, jdouble amax, jobject equed){
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ dlaqgb_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_r, jni_c, &rowcnd, &colcnd, &amax, jni_equed);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqge (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray r, jdoubleArray c, jdouble rowcnd, jdouble colcnd, jdouble amax, jobject equed){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ dlaqge_(&m, &n, jni_a, &lda, jni_r, jni_c, &rowcnd, &colcnd, &amax, jni_equed);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqp2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint offset, jdoubleArray a, jint lda, jintArray jpvt, jdoubleArray tau, jdoubleArray vn1, jdoubleArray vn2, jdoubleArray work){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_vn1 = (*env)->GetPrimitiveArrayCritical(env, vn1, JNI_FALSE);
+ check_memory(env, jni_vn1);
+ jdouble * jni_vn2 = (*env)->GetPrimitiveArrayCritical(env, vn2, JNI_FALSE);
+ check_memory(env, jni_vn2);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlaqp2_(&m, &n, &offset, jni_a, &lda, jni_jpvt, jni_tau, jni_vn1, jni_vn2, jni_work);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn1, jni_vn1, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn2, jni_vn2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqps (JNIEnv * env, jobject calling_obj, jint m, jint n, jint offset, jint nb, jobject kb, jdoubleArray a, jint lda, jintArray jpvt, jdoubleArray tau, jdoubleArray vn1, jdoubleArray vn2, jdoubleArray auxv, jdoubleArray f, jint ldf){
+ jclass jni_kbClass = (*env)->GetObjectClass(env, kb);
+ jfieldID jni_kbId = (*env)->GetFieldID(env, jni_kbClass, "val", "I");
+ jint jni_kb = (*env)->GetIntField(env, kb, jni_kbId);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_vn1 = (*env)->GetPrimitiveArrayCritical(env, vn1, JNI_FALSE);
+ check_memory(env, jni_vn1);
+ jdouble * jni_vn2 = (*env)->GetPrimitiveArrayCritical(env, vn2, JNI_FALSE);
+ check_memory(env, jni_vn2);
+ jdouble * jni_auxv = (*env)->GetPrimitiveArrayCritical(env, auxv, JNI_FALSE);
+ check_memory(env, jni_auxv);
+ jdouble * jni_f = (*env)->GetPrimitiveArrayCritical(env, f, JNI_FALSE);
+ check_memory(env, jni_f);
+
+ dlaqps_(&m, &n, &offset, &nb, &jni_kb, jni_a, &lda, jni_jpvt, jni_tau, jni_vn1, jni_vn2, jni_auxv, jni_f, &ldf);
+
+ (*env)->SetIntField(env, kb, jni_kbId, jni_kb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn1, jni_vn1, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn2, jni_vn2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, auxv, jni_auxv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, f, jni_f, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqsb (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray s, jdouble scond, jdouble amax, jobject equed){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ dlaqsb_(jni_uplo, &n, &kd, jni_ab, &ldab, jni_s, &scond, &amax, jni_equed);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqsp (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jdoubleArray s, jdouble scond, jdouble amax, jobject equed){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ dlaqsp_(jni_uplo, &n, jni_ap, jni_s, &scond, &amax, jni_equed);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqsy (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray s, jdouble scond, jdouble amax, jobject equed){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ dlaqsy_(jni_uplo, &n, jni_a, &lda, jni_s, &scond, &amax, jni_equed);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaqtr (JNIEnv * env, jobject calling_obj, jboolean ltran, jboolean lreal, jint n, jdoubleArray t, jint ldt, jdoubleArray b, jdouble w, jobject scale, jdoubleArray x, jdoubleArray work, jobject info){
+ logical jni_ltran = (logical)ltran;
+ logical jni_lreal = (logical)lreal;
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlaqtr_(&jni_ltran, &jni_lreal, &n, jni_t, &ldt, jni_b, &w, &jni_scale, jni_x, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlar2v (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray x, jdoubleArray y, jdoubleArray z, jint incx, jdoubleArray c, jdoubleArray s, jint incc){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+
+ dlar2v_(&n, jni_x, jni_y, jni_z, &incx, jni_c, jni_s, &incc);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarf (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jdoubleArray v, jint incv, jdouble tau, jdoubleArray c, jint Ldc, jdoubleArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlarf_(jni_side, &m, &n, jni_v, &incv, &tau, jni_c, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarfb (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jstring direct, jstring storev, jint m, jint n, jint k, jdoubleArray v, jint ldv, jdoubleArray t, jint ldt, jdoubleArray c, jint Ldc, jdoubleArray work, jint ldwork){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlarfb_(jni_side, jni_trans, jni_direct, jni_storev, &m, &n, &k, jni_v, &ldv, jni_t, &ldt, jni_c, &Ldc, jni_work, &ldwork);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarfg (JNIEnv * env, jobject calling_obj, jint n, jobject alpha, jdoubleArray x, jint incx, jobject tau){
+ jclass jni_alphaClass = (*env)->GetObjectClass(env, alpha);
+ jfieldID jni_alphaId = (*env)->GetFieldID(env, jni_alphaClass, "val", "D");
+ jdouble jni_alpha = (*env)->GetDoubleField(env, alpha, jni_alphaId);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_tauClass = (*env)->GetObjectClass(env, tau);
+ jfieldID jni_tauId = (*env)->GetFieldID(env, jni_tauClass, "val", "D");
+ jdouble jni_tau = (*env)->GetDoubleField(env, tau, jni_tauId);
+
+ dlarfg_(&n, &jni_alpha, jni_x, &incx, &jni_tau);
+
+ (*env)->SetDoubleField(env, alpha, jni_alphaId, jni_alpha);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, tau, jni_tauId, jni_tau);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarft (JNIEnv * env, jobject calling_obj, jstring direct, jstring storev, jint n, jint k, jdoubleArray v, jint ldv, jdoubleArray tau, jdoubleArray t, jint ldt){
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+
+ dlarft_(jni_direct, jni_storev, &n, &k, jni_v, &ldv, jni_tau, jni_t, &ldt);
+
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarfx (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jdoubleArray v, jdouble tau, jdoubleArray c, jint Ldc, jdoubleArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlarfx_(jni_side, &m, &n, jni_v, &tau, jni_c, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlargv (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray x, jint incx, jdoubleArray y, jint incy, jdoubleArray c, jint incc){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ dlargv_(&n, jni_x, &incx, jni_y, &incy, jni_c, &incc);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarnv (JNIEnv * env, jobject calling_obj, jint idist, jintArray iseed, jint n, jdoubleArray x){
+ jint * jni_iseed = (*env)->GetPrimitiveArrayCritical(env, iseed, JNI_FALSE);
+ check_memory(env, jni_iseed);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ dlarnv_(&idist, jni_iseed, &n, jni_x);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, iseed, jni_iseed, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlartg (JNIEnv * env, jobject calling_obj, jdouble f, jdouble g, jobject cs, jobject sn, jobject r){
+ jclass jni_csClass = (*env)->GetObjectClass(env, cs);
+ jfieldID jni_csId = (*env)->GetFieldID(env, jni_csClass, "val", "D");
+ jdouble jni_cs = (*env)->GetDoubleField(env, cs, jni_csId);
+ jclass jni_snClass = (*env)->GetObjectClass(env, sn);
+ jfieldID jni_snId = (*env)->GetFieldID(env, jni_snClass, "val", "D");
+ jdouble jni_sn = (*env)->GetDoubleField(env, sn, jni_snId);
+ jclass jni_rClass = (*env)->GetObjectClass(env, r);
+ jfieldID jni_rId = (*env)->GetFieldID(env, jni_rClass, "val", "D");
+ jdouble jni_r = (*env)->GetDoubleField(env, r, jni_rId);
+
+ dlartg_(&f, &g, &jni_cs, &jni_sn, &jni_r);
+
+ (*env)->SetDoubleField(env, cs, jni_csId, jni_cs);
+ (*env)->SetDoubleField(env, sn, jni_snId, jni_sn);
+ (*env)->SetDoubleField(env, r, jni_rId, jni_r);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlartv (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray x, jint incx, jdoubleArray y, jint incy, jdoubleArray c, jdoubleArray s, jint incc){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+
+ dlartv_(&n, jni_x, &incx, jni_y, &incy, jni_c, jni_s, &incc);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaruv (JNIEnv * env, jobject calling_obj, jintArray iseed, jint n, jdoubleArray x){
+ jint * jni_iseed = (*env)->GetPrimitiveArrayCritical(env, iseed, JNI_FALSE);
+ check_memory(env, jni_iseed);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ dlaruv_(jni_iseed, &n, jni_x);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, iseed, jni_iseed, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarz (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jint l, jdoubleArray v, jint incv, jdouble tau, jdoubleArray c, jint Ldc, jdoubleArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlarz_(jni_side, &m, &n, &l, jni_v, &incv, &tau, jni_c, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarzb (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jstring direct, jstring storev, jint m, jint n, jint k, jint l, jdoubleArray v, jint ldv, jdoubleArray t, jint ldt, jdoubleArray c, jint Ldc, jdoubleArray work, jint ldwork){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlarzb_(jni_side, jni_trans, jni_direct, jni_storev, &m, &n, &k, &l, jni_v, &ldv, jni_t, &ldt, jni_c, &Ldc, jni_work, &ldwork);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlarzt (JNIEnv * env, jobject calling_obj, jstring direct, jstring storev, jint n, jint k, jdoubleArray v, jint ldv, jdoubleArray tau, jdoubleArray t, jint ldt){
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+
+ dlarzt_(jni_direct, jni_storev, &n, &k, jni_v, &ldv, jni_tau, jni_t, &ldt);
+
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlas2 (JNIEnv * env, jobject calling_obj, jdouble f, jdouble g, jdouble h, jobject ssmin, jobject ssmax){
+ jclass jni_ssminClass = (*env)->GetObjectClass(env, ssmin);
+ jfieldID jni_ssminId = (*env)->GetFieldID(env, jni_ssminClass, "val", "D");
+ jdouble jni_ssmin = (*env)->GetDoubleField(env, ssmin, jni_ssminId);
+ jclass jni_ssmaxClass = (*env)->GetObjectClass(env, ssmax);
+ jfieldID jni_ssmaxId = (*env)->GetFieldID(env, jni_ssmaxClass, "val", "D");
+ jdouble jni_ssmax = (*env)->GetDoubleField(env, ssmax, jni_ssmaxId);
+
+ dlas2_(&f, &g, &h, &jni_ssmin, &jni_ssmax);
+
+ (*env)->SetDoubleField(env, ssmin, jni_ssminId, jni_ssmin);
+ (*env)->SetDoubleField(env, ssmax, jni_ssmaxId, jni_ssmax);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlascl (JNIEnv * env, jobject calling_obj, jstring type, jint kl, jint ku, jdouble cfrom, jdouble cto, jint m, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_type = (char *)(*env)->GetStringUTFChars(env, type, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlascl_(jni_type, &kl, &ku, &cfrom, &cto, &m, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, type, jni_type);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd0 (JNIEnv * env, jobject calling_obj, jint n, jint sqre, jdoubleArray d, jdoubleArray e, jdoubleArray u, jint ldu, jdoubleArray vt, jint ldvt, jint smlsiz, jintArray iwork, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd0_(&n, &sqre, jni_d, jni_e, jni_u, &ldu, jni_vt, &ldvt, &smlsiz, jni_iwork, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd1 (JNIEnv * env, jobject calling_obj, jint nl, jint nr, jint sqre, jdoubleArray d, jobject alpha, jobject beta, jdoubleArray u, jint ldu, jdoubleArray vt, jint ldvt, jintArray idxq, jintArray iwork, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jclass jni_alphaClass = (*env)->GetObjectClass(env, alpha);
+ jfieldID jni_alphaId = (*env)->GetFieldID(env, jni_alphaClass, "val", "D");
+ jdouble jni_alpha = (*env)->GetDoubleField(env, alpha, jni_alphaId);
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "D");
+ jdouble jni_beta = (*env)->GetDoubleField(env, beta, jni_betaId);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd1_(&nl, &nr, &sqre, jni_d, &jni_alpha, &jni_beta, jni_u, &ldu, jni_vt, &ldvt, jni_idxq, jni_iwork, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->SetDoubleField(env, alpha, jni_alphaId, jni_alpha);
+ (*env)->SetDoubleField(env, beta, jni_betaId, jni_beta);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd2 (JNIEnv * env, jobject calling_obj, jint nl, jint nr, jint sqre, jobject k, jdoubleArray d, jdoubleArray z, jdouble alpha, jdouble beta, jdoubleArray u, jint ldu, jdoubleArray vt, jint ldvt, jdoubleArray dsigma, jdoubleArray u2, jint ldu2, jdoubleArray vt2, jint ldvt2, jintArray idxp, jintArray idx, jintArray idxc, jintArray idxq, jintArray coltyp, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jdouble * jni_u2 = (*env)->GetPrimitiveArrayCritical(env, u2, JNI_FALSE);
+ check_memory(env, jni_u2);
+ jdouble * jni_vt2 = (*env)->GetPrimitiveArrayCritical(env, vt2, JNI_FALSE);
+ check_memory(env, jni_vt2);
+ jint * jni_idxp = (*env)->GetPrimitiveArrayCritical(env, idxp, JNI_FALSE);
+ check_memory(env, jni_idxp);
+ jint * jni_idx = (*env)->GetPrimitiveArrayCritical(env, idx, JNI_FALSE);
+ check_memory(env, jni_idx);
+ jint * jni_idxc = (*env)->GetPrimitiveArrayCritical(env, idxc, JNI_FALSE);
+ check_memory(env, jni_idxc);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_coltyp = (*env)->GetPrimitiveArrayCritical(env, coltyp, JNI_FALSE);
+ check_memory(env, jni_coltyp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd2_(&nl, &nr, &sqre, &jni_k, jni_d, jni_z, &alpha, &beta, jni_u, &ldu, jni_vt, &ldvt, jni_dsigma, jni_u2, &ldu2, jni_vt2, &ldvt2, jni_idxp, jni_idx, jni_idxc, jni_idxq, jni_coltyp, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u2, jni_u2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt2, jni_vt2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxp, jni_idxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idx, jni_idx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxc, jni_idxc, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, coltyp, jni_coltyp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd3 (JNIEnv * env, jobject calling_obj, jint nl, jint nr, jint sqre, jint k, jdoubleArray d, jdoubleArray q, jint ldq, jdoubleArray dsigma, jdoubleArray u, jint ldu, jdoubleArray u2, jint ldu2, jdoubleArray vt, jint ldvt, jdoubleArray vt2, jint ldvt2, jintArray idxc, jintArray ctot, jdoubleArray z, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_u2 = (*env)->GetPrimitiveArrayCritical(env, u2, JNI_FALSE);
+ check_memory(env, jni_u2);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_vt2 = (*env)->GetPrimitiveArrayCritical(env, vt2, JNI_FALSE);
+ check_memory(env, jni_vt2);
+ jint * jni_idxc = (*env)->GetPrimitiveArrayCritical(env, idxc, JNI_FALSE);
+ check_memory(env, jni_idxc);
+ jint * jni_ctot = (*env)->GetPrimitiveArrayCritical(env, ctot, JNI_FALSE);
+ check_memory(env, jni_ctot);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd3_(&nl, &nr, &sqre, &k, jni_d, jni_q, &ldq, jni_dsigma, jni_u, &ldu, jni_u2, &ldu2, jni_vt, &ldvt, jni_vt2, &ldvt2, jni_idxc, jni_ctot, jni_z, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u2, jni_u2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt2, jni_vt2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxc, jni_idxc, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ctot, jni_ctot, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd4 (JNIEnv * env, jobject calling_obj, jint n, jint i, jdoubleArray d, jdoubleArray z, jdoubleArray delta, jdouble rho, jobject sigma, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_sigmaClass = (*env)->GetObjectClass(env, sigma);
+ jfieldID jni_sigmaId = (*env)->GetFieldID(env, jni_sigmaClass, "val", "D");
+ jdouble jni_sigma = (*env)->GetDoubleField(env, sigma, jni_sigmaId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd4_(&n, &i, jni_d, jni_z, jni_delta, &rho, &jni_sigma, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetDoubleField(env, sigma, jni_sigmaId, jni_sigma);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd5 (JNIEnv * env, jobject calling_obj, jint i, jdoubleArray d, jdoubleArray z, jdoubleArray delta, jdouble rho, jobject dsigma, jdoubleArray work){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_dsigmaClass = (*env)->GetObjectClass(env, dsigma);
+ jfieldID jni_dsigmaId = (*env)->GetFieldID(env, jni_dsigmaClass, "val", "D");
+ jdouble jni_dsigma = (*env)->GetDoubleField(env, dsigma, jni_dsigmaId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlasd5_(&i, jni_d, jni_z, jni_delta, &rho, &jni_dsigma, jni_work);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetDoubleField(env, dsigma, jni_dsigmaId, jni_dsigma);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd6 (JNIEnv * env, jobject calling_obj, jint icompq, jint nl, jint nr, jint sqre, jdoubleArray d, jdoubleArray vf, jdoubleArray vl, jobject alpha, jobject beta, jintArray idxq, jintArray perm, jobject givptr, jintArray givcol, jint ldgcol, jdoubleArray givnum, jint ldgnum, jdoubleArray poles, jdoubleArray difl, jdoubleArray difr, jdoubleArray z, jobject k, jobject c, jobject s, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_vf = (*env)->GetPrimitiveArrayCritical(env, vf, JNI_FALSE);
+ check_memory(env, jni_vf);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jclass jni_alphaClass = (*env)->GetObjectClass(env, alpha);
+ jfieldID jni_alphaId = (*env)->GetFieldID(env, jni_alphaClass, "val", "D");
+ jdouble jni_alpha = (*env)->GetDoubleField(env, alpha, jni_alphaId);
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "D");
+ jdouble jni_beta = (*env)->GetDoubleField(env, beta, jni_betaId);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jclass jni_givptrClass = (*env)->GetObjectClass(env, givptr);
+ jfieldID jni_givptrId = (*env)->GetFieldID(env, jni_givptrClass, "val", "I");
+ jint jni_givptr = (*env)->GetIntField(env, givptr, jni_givptrId);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jdouble * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jdouble * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jdouble * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jdouble jni_c = (*env)->GetDoubleField(env, c, jni_cId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jdouble jni_s = (*env)->GetDoubleField(env, s, jni_sId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd6_(&icompq, &nl, &nr, &sqre, jni_d, jni_vf, jni_vl, &jni_alpha, &jni_beta, jni_idxq, jni_perm, &jni_givptr, jni_givcol, &ldgcol, jni_givnum, &ldgnum, jni_poles, jni_difl, jni_difr, jni_z, &jni_k, &jni_c, &jni_s, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vf, jni_vf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->SetDoubleField(env, alpha, jni_alphaId, jni_alpha);
+ (*env)->SetDoubleField(env, beta, jni_betaId, jni_beta);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->SetIntField(env, givptr, jni_givptrId, jni_givptr);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->SetDoubleField(env, c, jni_cId, jni_c);
+ (*env)->SetDoubleField(env, s, jni_sId, jni_s);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd7 (JNIEnv * env, jobject calling_obj, jint icompq, jint nl, jint nr, jint sqre, jobject k, jdoubleArray d, jdoubleArray z, jdoubleArray zw, jdoubleArray vf, jdoubleArray vfw, jdoubleArray vl, jdoubleArray vlw, jdouble alpha, jdouble beta, jdoubleArray dsigma, jintArray idx, jintArray idxp, jintArray idxq, jintArray perm, jobject givptr, jintArray givcol, jint ldgcol, jdoubleArray givnum, jint ldgnum, jobject c, jobject s, jo [...]
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_zw = (*env)->GetPrimitiveArrayCritical(env, zw, JNI_FALSE);
+ check_memory(env, jni_zw);
+ jdouble * jni_vf = (*env)->GetPrimitiveArrayCritical(env, vf, JNI_FALSE);
+ check_memory(env, jni_vf);
+ jdouble * jni_vfw = (*env)->GetPrimitiveArrayCritical(env, vfw, JNI_FALSE);
+ check_memory(env, jni_vfw);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vlw = (*env)->GetPrimitiveArrayCritical(env, vlw, JNI_FALSE);
+ check_memory(env, jni_vlw);
+ jdouble * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jint * jni_idx = (*env)->GetPrimitiveArrayCritical(env, idx, JNI_FALSE);
+ check_memory(env, jni_idx);
+ jint * jni_idxp = (*env)->GetPrimitiveArrayCritical(env, idxp, JNI_FALSE);
+ check_memory(env, jni_idxp);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jclass jni_givptrClass = (*env)->GetObjectClass(env, givptr);
+ jfieldID jni_givptrId = (*env)->GetFieldID(env, jni_givptrClass, "val", "I");
+ jint jni_givptr = (*env)->GetIntField(env, givptr, jni_givptrId);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jdouble jni_c = (*env)->GetDoubleField(env, c, jni_cId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jdouble jni_s = (*env)->GetDoubleField(env, s, jni_sId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd7_(&icompq, &nl, &nr, &sqre, &jni_k, jni_d, jni_z, jni_zw, jni_vf, jni_vfw, jni_vl, jni_vlw, &alpha, &beta, jni_dsigma, jni_idx, jni_idxp, jni_idxq, jni_perm, &jni_givptr, jni_givcol, &ldgcol, jni_givnum, &ldgnum, &jni_c, &jni_s, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, zw, jni_zw, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vf, jni_vf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vfw, jni_vfw, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vlw, jni_vlw, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idx, jni_idx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxp, jni_idxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->SetIntField(env, givptr, jni_givptrId, jni_givptr);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->SetDoubleField(env, c, jni_cId, jni_c);
+ (*env)->SetDoubleField(env, s, jni_sId, jni_s);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasd8 (JNIEnv * env, jobject calling_obj, jint icompq, jint k, jdoubleArray d, jdoubleArray z, jdoubleArray vf, jdoubleArray vl, jdoubleArray difl, jdoubleArray difr, jint lddifr, jdoubleArray dsigma, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_vf = (*env)->GetPrimitiveArrayCritical(env, vf, JNI_FALSE);
+ check_memory(env, jni_vf);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jdouble * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jdouble * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasd8_(&icompq, &k, jni_d, jni_z, jni_vf, jni_vl, jni_difl, jni_difr, &lddifr, jni_dsigma, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vf, jni_vf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasda (JNIEnv * env, jobject calling_obj, jint icompq, jint smlsiz, jint n, jint sqre, jdoubleArray d, jdoubleArray e, jdoubleArray u, jint ldu, jdoubleArray vt, jintArray k, jdoubleArray difl, jdoubleArray difr, jdoubleArray z, jdoubleArray poles, jintArray givptr, jintArray givcol, jint ldgcol, jintArray perm, jdoubleArray givnum, jdoubleArray c, jdoubleArray s, jdoubleArray work, jintArray iwork, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_k = (*env)->GetPrimitiveArrayCritical(env, k, JNI_FALSE);
+ check_memory(env, jni_k);
+ jdouble * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jdouble * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jdouble * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasda_(&icompq, &smlsiz, &n, &sqre, jni_d, jni_e, jni_u, &ldu, jni_vt, jni_k, jni_difl, jni_difr, jni_z, jni_poles, jni_givptr, jni_givcol, &ldgcol, jni_perm, jni_givnum, jni_c, jni_s, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, k, jni_k, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasdq (JNIEnv * env, jobject calling_obj, jstring uplo, jint sqre, jint n, jint ncvt, jint nru, jint ncc, jdoubleArray d, jdoubleArray e, jdoubleArray vt, jint ldvt, jdoubleArray u, jint ldu, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasdq_(jni_uplo, &sqre, &n, &ncvt, &nru, &ncc, jni_d, jni_e, jni_vt, &ldvt, jni_u, &ldu, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasdt (JNIEnv * env, jobject calling_obj, jint n, jobject lvl, jobject nd, jintArray inode, jintArray ndiml, jintArray ndimr, jint msub){
+ jclass jni_lvlClass = (*env)->GetObjectClass(env, lvl);
+ jfieldID jni_lvlId = (*env)->GetFieldID(env, jni_lvlClass, "val", "I");
+ jint jni_lvl = (*env)->GetIntField(env, lvl, jni_lvlId);
+ jclass jni_ndClass = (*env)->GetObjectClass(env, nd);
+ jfieldID jni_ndId = (*env)->GetFieldID(env, jni_ndClass, "val", "I");
+ jint jni_nd = (*env)->GetIntField(env, nd, jni_ndId);
+ jint * jni_inode = (*env)->GetPrimitiveArrayCritical(env, inode, JNI_FALSE);
+ check_memory(env, jni_inode);
+ jint * jni_ndiml = (*env)->GetPrimitiveArrayCritical(env, ndiml, JNI_FALSE);
+ check_memory(env, jni_ndiml);
+ jint * jni_ndimr = (*env)->GetPrimitiveArrayCritical(env, ndimr, JNI_FALSE);
+ check_memory(env, jni_ndimr);
+
+ dlasdt_(&n, &jni_lvl, &jni_nd, jni_inode, jni_ndiml, jni_ndimr, &msub);
+
+ (*env)->SetIntField(env, lvl, jni_lvlId, jni_lvl);
+ (*env)->SetIntField(env, nd, jni_ndId, jni_nd);
+ (*env)->ReleasePrimitiveArrayCritical(env, inode, jni_inode, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ndiml, jni_ndiml, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ndimr, jni_ndimr, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaset (JNIEnv * env, jobject calling_obj, jstring uplo, jint m, jint n, jdouble alpha, jdouble beta, jdoubleArray a, jint lda){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ dlaset_(jni_uplo, &m, &n, &alpha, &beta, jni_a, &lda);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasq1 (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasq1_(&n, jni_d, jni_e, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasq2 (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray z, jobject info){
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasq2_(&n, jni_z, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasq3 (JNIEnv * env, jobject calling_obj, jint i0, jobject n0, jdoubleArray z, jint pp, jobject dmin, jobject sigma, jobject desig, jobject qmax, jobject nfail, jobject iter, jobject ndiv, jboolean ieee){
+ jclass jni_n0Class = (*env)->GetObjectClass(env, n0);
+ jfieldID jni_n0Id = (*env)->GetFieldID(env, jni_n0Class, "val", "I");
+ jint jni_n0 = (*env)->GetIntField(env, n0, jni_n0Id);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_dminClass = (*env)->GetObjectClass(env, dmin);
+ jfieldID jni_dminId = (*env)->GetFieldID(env, jni_dminClass, "val", "D");
+ jdouble jni_dmin = (*env)->GetDoubleField(env, dmin, jni_dminId);
+ jclass jni_sigmaClass = (*env)->GetObjectClass(env, sigma);
+ jfieldID jni_sigmaId = (*env)->GetFieldID(env, jni_sigmaClass, "val", "D");
+ jdouble jni_sigma = (*env)->GetDoubleField(env, sigma, jni_sigmaId);
+ jclass jni_desigClass = (*env)->GetObjectClass(env, desig);
+ jfieldID jni_desigId = (*env)->GetFieldID(env, jni_desigClass, "val", "D");
+ jdouble jni_desig = (*env)->GetDoubleField(env, desig, jni_desigId);
+ jclass jni_qmaxClass = (*env)->GetObjectClass(env, qmax);
+ jfieldID jni_qmaxId = (*env)->GetFieldID(env, jni_qmaxClass, "val", "D");
+ jdouble jni_qmax = (*env)->GetDoubleField(env, qmax, jni_qmaxId);
+ jclass jni_nfailClass = (*env)->GetObjectClass(env, nfail);
+ jfieldID jni_nfailId = (*env)->GetFieldID(env, jni_nfailClass, "val", "I");
+ jint jni_nfail = (*env)->GetIntField(env, nfail, jni_nfailId);
+ jclass jni_iterClass = (*env)->GetObjectClass(env, iter);
+ jfieldID jni_iterId = (*env)->GetFieldID(env, jni_iterClass, "val", "I");
+ jint jni_iter = (*env)->GetIntField(env, iter, jni_iterId);
+ jclass jni_ndivClass = (*env)->GetObjectClass(env, ndiv);
+ jfieldID jni_ndivId = (*env)->GetFieldID(env, jni_ndivClass, "val", "I");
+ jint jni_ndiv = (*env)->GetIntField(env, ndiv, jni_ndivId);
+ logical jni_ieee = (logical)ieee;
+
+ dlasq3_(&i0, &jni_n0, jni_z, &pp, &jni_dmin, &jni_sigma, &jni_desig, &jni_qmax, &jni_nfail, &jni_iter, &jni_ndiv, &jni_ieee);
+
+ (*env)->SetIntField(env, n0, jni_n0Id, jni_n0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetDoubleField(env, dmin, jni_dminId, jni_dmin);
+ (*env)->SetDoubleField(env, sigma, jni_sigmaId, jni_sigma);
+ (*env)->SetDoubleField(env, desig, jni_desigId, jni_desig);
+ (*env)->SetDoubleField(env, qmax, jni_qmaxId, jni_qmax);
+ (*env)->SetIntField(env, nfail, jni_nfailId, jni_nfail);
+ (*env)->SetIntField(env, iter, jni_iterId, jni_iter);
+ (*env)->SetIntField(env, ndiv, jni_ndivId, jni_ndiv);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasq4 (JNIEnv * env, jobject calling_obj, jint i0, jint n0, jdoubleArray z, jint pp, jint n0in, jdouble dmin, jdouble dmin1, jdouble dmin2, jdouble dn, jdouble dn1, jdouble dn2, jobject tau, jobject ttype){
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_tauClass = (*env)->GetObjectClass(env, tau);
+ jfieldID jni_tauId = (*env)->GetFieldID(env, jni_tauClass, "val", "D");
+ jdouble jni_tau = (*env)->GetDoubleField(env, tau, jni_tauId);
+ jclass jni_ttypeClass = (*env)->GetObjectClass(env, ttype);
+ jfieldID jni_ttypeId = (*env)->GetFieldID(env, jni_ttypeClass, "val", "I");
+ jint jni_ttype = (*env)->GetIntField(env, ttype, jni_ttypeId);
+
+ dlasq4_(&i0, &n0, jni_z, &pp, &n0in, &dmin, &dmin1, &dmin2, &dn, &dn1, &dn2, &jni_tau, &jni_ttype);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetDoubleField(env, tau, jni_tauId, jni_tau);
+ (*env)->SetIntField(env, ttype, jni_ttypeId, jni_ttype);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasq5 (JNIEnv * env, jobject calling_obj, jint i0, jint n0, jdoubleArray z, jint pp, jdouble tau, jobject dmin, jobject dmin1, jobject dmin2, jobject dn, jobject dnm1, jobject dnm2, jboolean ieee){
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_dminClass = (*env)->GetObjectClass(env, dmin);
+ jfieldID jni_dminId = (*env)->GetFieldID(env, jni_dminClass, "val", "D");
+ jdouble jni_dmin = (*env)->GetDoubleField(env, dmin, jni_dminId);
+ jclass jni_dmin1Class = (*env)->GetObjectClass(env, dmin1);
+ jfieldID jni_dmin1Id = (*env)->GetFieldID(env, jni_dmin1Class, "val", "D");
+ jdouble jni_dmin1 = (*env)->GetDoubleField(env, dmin1, jni_dmin1Id);
+ jclass jni_dmin2Class = (*env)->GetObjectClass(env, dmin2);
+ jfieldID jni_dmin2Id = (*env)->GetFieldID(env, jni_dmin2Class, "val", "D");
+ jdouble jni_dmin2 = (*env)->GetDoubleField(env, dmin2, jni_dmin2Id);
+ jclass jni_dnClass = (*env)->GetObjectClass(env, dn);
+ jfieldID jni_dnId = (*env)->GetFieldID(env, jni_dnClass, "val", "D");
+ jdouble jni_dn = (*env)->GetDoubleField(env, dn, jni_dnId);
+ jclass jni_dnm1Class = (*env)->GetObjectClass(env, dnm1);
+ jfieldID jni_dnm1Id = (*env)->GetFieldID(env, jni_dnm1Class, "val", "D");
+ jdouble jni_dnm1 = (*env)->GetDoubleField(env, dnm1, jni_dnm1Id);
+ jclass jni_dnm2Class = (*env)->GetObjectClass(env, dnm2);
+ jfieldID jni_dnm2Id = (*env)->GetFieldID(env, jni_dnm2Class, "val", "D");
+ jdouble jni_dnm2 = (*env)->GetDoubleField(env, dnm2, jni_dnm2Id);
+ logical jni_ieee = (logical)ieee;
+
+ dlasq5_(&i0, &n0, jni_z, &pp, &tau, &jni_dmin, &jni_dmin1, &jni_dmin2, &jni_dn, &jni_dnm1, &jni_dnm2, &jni_ieee);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetDoubleField(env, dmin, jni_dminId, jni_dmin);
+ (*env)->SetDoubleField(env, dmin1, jni_dmin1Id, jni_dmin1);
+ (*env)->SetDoubleField(env, dmin2, jni_dmin2Id, jni_dmin2);
+ (*env)->SetDoubleField(env, dn, jni_dnId, jni_dn);
+ (*env)->SetDoubleField(env, dnm1, jni_dnm1Id, jni_dnm1);
+ (*env)->SetDoubleField(env, dnm2, jni_dnm2Id, jni_dnm2);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasq6 (JNIEnv * env, jobject calling_obj, jint i0, jint n0, jdoubleArray z, jint pp, jobject dmin, jobject dmin1, jobject dmin2, jobject dn, jobject dnm1, jobject dnm2){
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_dminClass = (*env)->GetObjectClass(env, dmin);
+ jfieldID jni_dminId = (*env)->GetFieldID(env, jni_dminClass, "val", "D");
+ jdouble jni_dmin = (*env)->GetDoubleField(env, dmin, jni_dminId);
+ jclass jni_dmin1Class = (*env)->GetObjectClass(env, dmin1);
+ jfieldID jni_dmin1Id = (*env)->GetFieldID(env, jni_dmin1Class, "val", "D");
+ jdouble jni_dmin1 = (*env)->GetDoubleField(env, dmin1, jni_dmin1Id);
+ jclass jni_dmin2Class = (*env)->GetObjectClass(env, dmin2);
+ jfieldID jni_dmin2Id = (*env)->GetFieldID(env, jni_dmin2Class, "val", "D");
+ jdouble jni_dmin2 = (*env)->GetDoubleField(env, dmin2, jni_dmin2Id);
+ jclass jni_dnClass = (*env)->GetObjectClass(env, dn);
+ jfieldID jni_dnId = (*env)->GetFieldID(env, jni_dnClass, "val", "D");
+ jdouble jni_dn = (*env)->GetDoubleField(env, dn, jni_dnId);
+ jclass jni_dnm1Class = (*env)->GetObjectClass(env, dnm1);
+ jfieldID jni_dnm1Id = (*env)->GetFieldID(env, jni_dnm1Class, "val", "D");
+ jdouble jni_dnm1 = (*env)->GetDoubleField(env, dnm1, jni_dnm1Id);
+ jclass jni_dnm2Class = (*env)->GetObjectClass(env, dnm2);
+ jfieldID jni_dnm2Id = (*env)->GetFieldID(env, jni_dnm2Class, "val", "D");
+ jdouble jni_dnm2 = (*env)->GetDoubleField(env, dnm2, jni_dnm2Id);
+
+ dlasq6_(&i0, &n0, jni_z, &pp, &jni_dmin, &jni_dmin1, &jni_dmin2, &jni_dn, &jni_dnm1, &jni_dnm2);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetDoubleField(env, dmin, jni_dminId, jni_dmin);
+ (*env)->SetDoubleField(env, dmin1, jni_dmin1Id, jni_dmin1);
+ (*env)->SetDoubleField(env, dmin2, jni_dmin2Id, jni_dmin2);
+ (*env)->SetDoubleField(env, dn, jni_dnId, jni_dn);
+ (*env)->SetDoubleField(env, dnm1, jni_dnm1Id, jni_dnm1);
+ (*env)->SetDoubleField(env, dnm2, jni_dnm2Id, jni_dnm2);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasr (JNIEnv * env, jobject calling_obj, jstring side, jstring pivot, jstring direct, jint m, jint n, jdoubleArray c, jdoubleArray s, jdoubleArray a, jint lda){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_pivot = (char *)(*env)->GetStringUTFChars(env, pivot, JNI_FALSE);
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ dlasr_(jni_side, jni_pivot, jni_direct, &m, &n, jni_c, jni_s, jni_a, &lda);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, pivot, jni_pivot);
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasrt (JNIEnv * env, jobject calling_obj, jstring id, jint n, jdoubleArray d, jobject info){
+ char * jni_id = (char *)(*env)->GetStringUTFChars(env, id, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasrt_(jni_id, &n, jni_d, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, id, jni_id);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlassq (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray x, jint incx, jobject scale, jobject sumsq){
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jclass jni_sumsqClass = (*env)->GetObjectClass(env, sumsq);
+ jfieldID jni_sumsqId = (*env)->GetFieldID(env, jni_sumsqClass, "val", "D");
+ jdouble jni_sumsq = (*env)->GetDoubleField(env, sumsq, jni_sumsqId);
+
+ dlassq_(&n, jni_x, &incx, &jni_scale, &jni_sumsq);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetDoubleField(env, sumsq, jni_sumsqId, jni_sumsq);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasv2 (JNIEnv * env, jobject calling_obj, jdouble f, jdouble g, jdouble h, jobject ssmin, jobject ssmax, jobject snr, jobject csr, jobject snl, jobject csl){
+ jclass jni_ssminClass = (*env)->GetObjectClass(env, ssmin);
+ jfieldID jni_ssminId = (*env)->GetFieldID(env, jni_ssminClass, "val", "D");
+ jdouble jni_ssmin = (*env)->GetDoubleField(env, ssmin, jni_ssminId);
+ jclass jni_ssmaxClass = (*env)->GetObjectClass(env, ssmax);
+ jfieldID jni_ssmaxId = (*env)->GetFieldID(env, jni_ssmaxClass, "val", "D");
+ jdouble jni_ssmax = (*env)->GetDoubleField(env, ssmax, jni_ssmaxId);
+ jclass jni_snrClass = (*env)->GetObjectClass(env, snr);
+ jfieldID jni_snrId = (*env)->GetFieldID(env, jni_snrClass, "val", "D");
+ jdouble jni_snr = (*env)->GetDoubleField(env, snr, jni_snrId);
+ jclass jni_csrClass = (*env)->GetObjectClass(env, csr);
+ jfieldID jni_csrId = (*env)->GetFieldID(env, jni_csrClass, "val", "D");
+ jdouble jni_csr = (*env)->GetDoubleField(env, csr, jni_csrId);
+ jclass jni_snlClass = (*env)->GetObjectClass(env, snl);
+ jfieldID jni_snlId = (*env)->GetFieldID(env, jni_snlClass, "val", "D");
+ jdouble jni_snl = (*env)->GetDoubleField(env, snl, jni_snlId);
+ jclass jni_cslClass = (*env)->GetObjectClass(env, csl);
+ jfieldID jni_cslId = (*env)->GetFieldID(env, jni_cslClass, "val", "D");
+ jdouble jni_csl = (*env)->GetDoubleField(env, csl, jni_cslId);
+
+ dlasv2_(&f, &g, &h, &jni_ssmin, &jni_ssmax, &jni_snr, &jni_csr, &jni_snl, &jni_csl);
+
+ (*env)->SetDoubleField(env, ssmin, jni_ssminId, jni_ssmin);
+ (*env)->SetDoubleField(env, ssmax, jni_ssmaxId, jni_ssmax);
+ (*env)->SetDoubleField(env, snr, jni_snrId, jni_snr);
+ (*env)->SetDoubleField(env, csr, jni_csrId, jni_csr);
+ (*env)->SetDoubleField(env, snl, jni_snlId, jni_snl);
+ (*env)->SetDoubleField(env, csl, jni_cslId, jni_csl);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlaswp (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray a, jint lda, jint k1, jint k2, jintArray ipiv, jint incx){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+
+ dlaswp_(&n, jni_a, &lda, &k1, &k2, jni_ipiv, &incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasy2 (JNIEnv * env, jobject calling_obj, jboolean ltranl, jboolean ltranr, jint isgn, jint n1, jint n2, jdoubleArray tl, jint ldtl, jdoubleArray tr, jint ldtr, jdoubleArray b, jint ldb, jobject scale, jdoubleArray x, jint ldx, jobject xnorm, jobject info){
+ logical jni_ltranl = (logical)ltranl;
+ logical jni_ltranr = (logical)ltranr;
+ jdouble * jni_tl = (*env)->GetPrimitiveArrayCritical(env, tl, JNI_FALSE);
+ check_memory(env, jni_tl);
+ jdouble * jni_tr = (*env)->GetPrimitiveArrayCritical(env, tr, JNI_FALSE);
+ check_memory(env, jni_tr);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_xnormClass = (*env)->GetObjectClass(env, xnorm);
+ jfieldID jni_xnormId = (*env)->GetFieldID(env, jni_xnormClass, "val", "D");
+ jdouble jni_xnorm = (*env)->GetDoubleField(env, xnorm, jni_xnormId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasy2_(&jni_ltranl, &jni_ltranr, &isgn, &n1, &n2, jni_tl, &ldtl, jni_tr, &ldtr, jni_b, &ldb, &jni_scale, jni_x, &ldx, &jni_xnorm, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, tl, jni_tl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tr, jni_tr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, xnorm, jni_xnormId, jni_xnorm);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlasyf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nb, jobject kb, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray w, jint ldw, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jclass jni_kbClass = (*env)->GetObjectClass(env, kb);
+ jfieldID jni_kbId = (*env)->GetFieldID(env, jni_kbClass, "val", "I");
+ jint jni_kb = (*env)->GetIntField(env, kb, jni_kbId);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlasyf_(jni_uplo, &n, &nb, &jni_kb, jni_a, &lda, jni_ipiv, jni_w, &ldw, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->SetIntField(env, kb, jni_kbId, jni_kb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatbs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jstring normin, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray x, jobject scale, jdoubleArray cnorm, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ char * jni_normin = (char *)(*env)->GetStringUTFChars(env, normin, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jdouble * jni_cnorm = (*env)->GetPrimitiveArrayCritical(env, cnorm, JNI_FALSE);
+ check_memory(env, jni_cnorm);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlatbs_(jni_uplo, jni_trans, jni_diag, jni_normin, &n, &kd, jni_ab, &ldab, jni_x, &jni_scale, jni_cnorm, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleaseStringUTFChars(env, normin, jni_normin);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, cnorm, jni_cnorm, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatdf (JNIEnv * env, jobject calling_obj, jint ijob, jint n, jdoubleArray z, jint ldz, jdoubleArray rhs, jobject rdsum, jobject rdscal, jintArray ipiv, jintArray jpiv){
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_rhs = (*env)->GetPrimitiveArrayCritical(env, rhs, JNI_FALSE);
+ check_memory(env, jni_rhs);
+ jclass jni_rdsumClass = (*env)->GetObjectClass(env, rdsum);
+ jfieldID jni_rdsumId = (*env)->GetFieldID(env, jni_rdsumClass, "val", "D");
+ jdouble jni_rdsum = (*env)->GetDoubleField(env, rdsum, jni_rdsumId);
+ jclass jni_rdscalClass = (*env)->GetObjectClass(env, rdscal);
+ jfieldID jni_rdscalId = (*env)->GetFieldID(env, jni_rdscalClass, "val", "D");
+ jdouble jni_rdscal = (*env)->GetDoubleField(env, rdscal, jni_rdscalId);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jint * jni_jpiv = (*env)->GetPrimitiveArrayCritical(env, jpiv, JNI_FALSE);
+ check_memory(env, jni_jpiv);
+
+ dlatdf_(&ijob, &n, jni_z, &ldz, jni_rhs, &jni_rdsum, &jni_rdscal, jni_ipiv, jni_jpiv);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rhs, jni_rhs, 0);
+ (*env)->SetDoubleField(env, rdsum, jni_rdsumId, jni_rdsum);
+ (*env)->SetDoubleField(env, rdscal, jni_rdscalId, jni_rdscal);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpiv, jni_jpiv, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatps (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jstring normin, jint n, jdoubleArray ap, jdoubleArray x, jobject scale, jdoubleArray cnorm, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ char * jni_normin = (char *)(*env)->GetStringUTFChars(env, normin, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jdouble * jni_cnorm = (*env)->GetPrimitiveArrayCritical(env, cnorm, JNI_FALSE);
+ check_memory(env, jni_cnorm);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlatps_(jni_uplo, jni_trans, jni_diag, jni_normin, &n, jni_ap, jni_x, &jni_scale, jni_cnorm, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleaseStringUTFChars(env, normin, jni_normin);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, cnorm, jni_cnorm, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatrd (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nb, jdoubleArray a, jint lda, jdoubleArray e, jdoubleArray tau, jdoubleArray w, jint ldw){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+
+ dlatrd_(jni_uplo, &n, &nb, jni_a, &lda, jni_e, jni_tau, jni_w, &ldw);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jstring normin, jint n, jdoubleArray a, jint lda, jdoubleArray x, jobject scale, jdoubleArray cnorm, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ char * jni_normin = (char *)(*env)->GetStringUTFChars(env, normin, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jdouble * jni_cnorm = (*env)->GetPrimitiveArrayCritical(env, cnorm, JNI_FALSE);
+ check_memory(env, jni_cnorm);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlatrs_(jni_uplo, jni_trans, jni_diag, jni_normin, &n, jni_a, &lda, jni_x, &jni_scale, jni_cnorm, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleaseStringUTFChars(env, normin, jni_normin);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, cnorm, jni_cnorm, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatrz (JNIEnv * env, jobject calling_obj, jint m, jint n, jint l, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlatrz_(&m, &n, &l, jni_a, &lda, jni_tau, jni_work);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlatzm (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jdoubleArray v, jint incv, jdouble tau, jdoubleArray c1, jdoubleArray c2, jint Ldc, jdoubleArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_c1 = (*env)->GetPrimitiveArrayCritical(env, c1, JNI_FALSE);
+ check_memory(env, jni_c1);
+ jdouble * jni_c2 = (*env)->GetPrimitiveArrayCritical(env, c2, JNI_FALSE);
+ check_memory(env, jni_c2);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ dlatzm_(jni_side, &m, &n, jni_v, &incv, &tau, jni_c1, jni_c2, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c1, jni_c1, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c2, jni_c2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlauu2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlauu2_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlauum (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dlauum_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dopgtr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jdoubleArray tau, jdoubleArray q, jint ldq, jdoubleArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dopgtr_(jni_uplo, &n, jni_ap, jni_tau, jni_q, &ldq, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dopmtr (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring trans, jint m, jint n, jdoubleArray ap, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dopmtr_(jni_side, jni_uplo, jni_trans, &m, &n, jni_ap, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorg2l (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorg2l_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorg2r (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorg2r_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgbr (JNIEnv * env, jobject calling_obj, jstring vect, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgbr_(jni_vect, &m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorghr (JNIEnv * env, jobject calling_obj, jint n, jint ilo, jint ihi, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorghr_(&n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgl2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgl2_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorglq (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorglq_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgql (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgql_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgqr (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgqr_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgr2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgr2_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgrq (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgrq_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorgtr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorgtr_(jni_uplo, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorm2l (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorm2l_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorm2r (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorm2r_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormbr (JNIEnv * env, jobject calling_obj, jstring vect, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormbr_(jni_vect, jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormhr (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint ilo, jint ihi, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormhr_(jni_side, jni_trans, &m, &n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dorml2 (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dorml2_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormlq (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormlq_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormql (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormql_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormqr (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormqr_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormr2 (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormr2_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormr3 (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jint l, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormr3_(jni_side, jni_trans, &m, &n, &k, &l, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormrq (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormrq_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormrz (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jint l, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormrz_(jni_side, jni_trans, &m, &n, &k, &l, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dormtr (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring trans, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray c, jint Ldc, jdoubleArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dormtr_(jni_side, jni_uplo, jni_trans, &m, &n, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbcon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbcon_(jni_uplo, &n, &kd, jni_ab, &ldab, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbequ (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray s, jobject scond, jobject amax, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_scondClass = (*env)->GetObjectClass(env, scond);
+ jfieldID jni_scondId = (*env)->GetFieldID(env, jni_scondClass, "val", "D");
+ jdouble jni_scond = (*env)->GetDoubleField(env, scond, jni_scondId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jdouble jni_amax = (*env)->GetDoubleField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbequ_(jni_uplo, &n, &kd, jni_ab, &ldab, jni_s, &jni_scond, &jni_amax, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetDoubleField(env, scond, jni_scondId, jni_scond);
+ (*env)->SetDoubleField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray afb, jint ldafb, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbrfs_(jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbstf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbstf_(jni_uplo, &n, &kd, jni_ab, &ldab, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbsv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbsv_(jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint kd, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray afb, jint ldafb, jobject equed, jdoubleArray s, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbsvx_(jni_fact, jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_equed, jni_s, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbtf2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbtf2_(jni_uplo, &n, &kd, jni_ab, &ldab, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbtrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbtrf_(jni_uplo, &n, &kd, jni_ab, &ldab, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpbtrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpbtrs_(jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpocon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpocon_(jni_uplo, &n, jni_a, &lda, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpoequ (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray a, jint lda, jdoubleArray s, jobject scond, jobject amax, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_scondClass = (*env)->GetObjectClass(env, scond);
+ jfieldID jni_scondId = (*env)->GetFieldID(env, jni_scondClass, "val", "D");
+ jdouble jni_scond = (*env)->GetDoubleField(env, scond, jni_scondId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jdouble jni_amax = (*env)->GetDoubleField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpoequ_(&n, jni_a, &lda, jni_s, &jni_scond, &jni_amax, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetDoubleField(env, scond, jni_scondId, jni_scond);
+ (*env)->SetDoubleField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dporfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray af, jint ldaf, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dporfs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dposv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dposv_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dposvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray af, jint ldaf, jobject equed, jdoubleArray s, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dposvx_(jni_fact, jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_equed, jni_s, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpotf2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpotf2_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpotrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpotrf_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpotri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpotri_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpotrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpotrs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dppcon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dppcon_(jni_uplo, &n, jni_ap, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dppequ (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jdoubleArray s, jobject scond, jobject amax, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_scondClass = (*env)->GetObjectClass(env, scond);
+ jfieldID jni_scondId = (*env)->GetFieldID(env, jni_scondClass, "val", "D");
+ jdouble jni_scond = (*env)->GetDoubleField(env, scond, jni_scondId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jdouble jni_amax = (*env)->GetDoubleField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dppequ_(jni_uplo, &n, jni_ap, jni_s, &jni_scond, &jni_amax, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetDoubleField(env, scond, jni_scondId, jni_scond);
+ (*env)->SetDoubleField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpprfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jdoubleArray afp, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpprfs_(jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dppsv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dppsv_(jni_uplo, &n, &nrhs, jni_ap, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dppsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jdoubleArray afp, jobject equed, jdoubleArray s, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dppsvx_(jni_fact, jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_equed, jni_s, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpptrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpptrf_(jni_uplo, &n, jni_ap, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpptri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpptri_(jni_uplo, &n, jni_ap, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpptrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpptrs_(jni_uplo, &n, &nrhs, jni_ap, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dptcon (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray d, jdoubleArray e, jdouble anorm, jobject rcond, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dptcon_(&n, jni_d, jni_e, &anorm, &jni_rcond, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpteqr (JNIEnv * env, jobject calling_obj, jstring compz, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpteqr_(jni_compz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dptrfs (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jdoubleArray d, jdoubleArray e, jdoubleArray df, jdoubleArray ef, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jdouble * jni_ef = (*env)->GetPrimitiveArrayCritical(env, ef, JNI_FALSE);
+ check_memory(env, jni_ef);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dptrfs_(&n, &nrhs, jni_d, jni_e, jni_df, jni_ef, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ef, jni_ef, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dptsv (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jdoubleArray d, jdoubleArray e, jdoubleArray b, jint ldb, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dptsv_(&n, &nrhs, jni_d, jni_e, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dptsvx (JNIEnv * env, jobject calling_obj, jstring fact, jint n, jint nrhs, jdoubleArray d, jdoubleArray e, jdoubleArray df, jdoubleArray ef, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jdouble * jni_ef = (*env)->GetPrimitiveArrayCritical(env, ef, JNI_FALSE);
+ check_memory(env, jni_ef);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dptsvx_(jni_fact, &n, &nrhs, jni_d, jni_e, jni_df, jni_ef, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ef, jni_ef, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpttrf (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray d, jdoubleArray e, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpttrf_(&n, jni_d, jni_e, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dpttrs (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jdoubleArray d, jdoubleArray e, jdoubleArray b, jint ldb, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dpttrs_(&n, &nrhs, jni_d, jni_e, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dptts2 (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jdoubleArray d, jdoubleArray e, jdoubleArray b, jint ldb){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ dptts2_(&n, &nrhs, jni_d, jni_e, jni_b, &ldb);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_drscl (JNIEnv * env, jobject calling_obj, jint n, jdouble sa, jdoubleArray sx, jint incx){
+ jdouble * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+
+ drscl_(&n, &sa, jni_sx, &incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbev (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbev_(jni_jobz, jni_uplo, &n, &kd, jni_ab, &ldab, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbevd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbevd_(jni_jobz, jni_uplo, &n, &kd, jni_ab, &ldab, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray q, jint ldq, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbevx_(jni_jobz, jni_range, jni_uplo, &n, &kd, jni_ab, &ldab, jni_q, &ldq, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbgst (JNIEnv * env, jobject calling_obj, jstring vect, jstring uplo, jint n, jint ka, jint kb, jdoubleArray ab, jint ldab, jdoubleArray bb, jint ldbb, jdoubleArray x, jint ldx, jdoubleArray work, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbgst_(jni_vect, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_x, &ldx, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbgv (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint ka, jint kb, jdoubleArray ab, jint ldab, jdoubleArray bb, jint ldbb, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbgv_(jni_jobz, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbgvd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint ka, jint kb, jdoubleArray ab, jint ldab, jdoubleArray bb, jint ldbb, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbgvd_(jni_jobz, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbgvx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jint ka, jint kb, jdoubleArray ab, jint ldab, jdoubleArray bb, jint ldbb, jdoubleArray q, jint ldq, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbgvx_(jni_jobz, jni_range, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_q, &ldq, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsbtrd (JNIEnv * env, jobject calling_obj, jstring vect, jstring uplo, jint n, jint kd, jdoubleArray ab, jint ldab, jdoubleArray d, jdoubleArray e, jdoubleArray q, jint ldq, jdoubleArray work, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsbtrd_(jni_vect, jni_uplo, &n, &kd, jni_ab, &ldab, jni_d, jni_e, jni_q, &ldq, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspcon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jintArray ipiv, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspcon_(jni_uplo, &n, jni_ap, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspev (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jdoubleArray ap, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspev_(jni_jobz, jni_uplo, &n, jni_ap, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspevd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jdoubleArray ap, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspevd_(jni_jobz, jni_uplo, &n, jni_ap, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jdoubleArray ap, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspevx_(jni_jobz, jni_range, jni_uplo, &n, jni_ap, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspgst (JNIEnv * env, jobject calling_obj, jint itype, jstring uplo, jint n, jdoubleArray ap, jdoubleArray bp, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspgst_(&itype, jni_uplo, &n, jni_ap, jni_bp, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspgv (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jdoubleArray ap, jdoubleArray bp, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspgv_(&itype, jni_jobz, jni_uplo, &n, jni_ap, jni_bp, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspgvd (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jdoubleArray ap, jdoubleArray bp, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspgvd_(&itype, jni_jobz, jni_uplo, &n, jni_ap, jni_bp, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspgvx (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring range, jstring uplo, jint n, jdoubleArray ap, jdoubleArray bp, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspgvx_(&itype, jni_jobz, jni_range, jni_uplo, &n, jni_ap, jni_bp, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsprfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jdoubleArray afp, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsprfs_(jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspsv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspsv_(jni_uplo, &n, &nrhs, jni_ap, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dspsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jdoubleArray afp, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dspsvx_(jni_fact, jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_ipiv, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsptrd (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jdoubleArray d, jdoubleArray e, jdoubleArray tau, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsptrd_(jni_uplo, &n, jni_ap, jni_d, jni_e, jni_tau, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsptrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jintArray ipiv, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsptrf_(jni_uplo, &n, jni_ap, jni_ipiv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsptri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray ap, jintArray ipiv, jdoubleArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsptri_(jni_uplo, &n, jni_ap, jni_ipiv, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsptrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray ap, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsptrs_(jni_uplo, &n, &nrhs, jni_ap, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstebz (JNIEnv * env, jobject calling_obj, jstring range, jstring order, jint n, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jdoubleArray d, jdoubleArray e, jobject m, jobject nsplit, jdoubleArray w, jintArray iblock, jintArray isplit, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_order = (char *)(*env)->GetStringUTFChars(env, order, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jclass jni_nsplitClass = (*env)->GetObjectClass(env, nsplit);
+ jfieldID jni_nsplitId = (*env)->GetFieldID(env, jni_nsplitClass, "val", "I");
+ jint jni_nsplit = (*env)->GetIntField(env, nsplit, jni_nsplitId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jint * jni_iblock = (*env)->GetPrimitiveArrayCritical(env, iblock, JNI_FALSE);
+ check_memory(env, jni_iblock);
+ jint * jni_isplit = (*env)->GetPrimitiveArrayCritical(env, isplit, JNI_FALSE);
+ check_memory(env, jni_isplit);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstebz_(jni_range, jni_order, &n, &vl, &vu, &il, &iu, &abstol, jni_d, jni_e, &jni_m, &jni_nsplit, jni_w, jni_iblock, jni_isplit, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, order, jni_order);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->SetIntField(env, nsplit, jni_nsplitId, jni_nsplit);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iblock, jni_iblock, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isplit, jni_isplit, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstedc (JNIEnv * env, jobject calling_obj, jstring compz, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstedc_(jni_compz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstegr (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jint n, jdoubleArray d, jdoubleArray e, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jintArray isuppz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jint * jni_isuppz = (*env)->GetPrimitiveArrayCritical(env, isuppz, JNI_FALSE);
+ check_memory(env, jni_isuppz);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstegr_(jni_jobz, jni_range, &n, jni_d, jni_e, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_isuppz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isuppz, jni_isuppz, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstein (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray d, jdoubleArray e, jint m, jdoubleArray w, jintArray iblock, jintArray isplit, jdoubleArray z, jint ldz, jdoubleArray work, jintArray iwork, jintArray ifail, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jint * jni_iblock = (*env)->GetPrimitiveArrayCritical(env, iblock, JNI_FALSE);
+ check_memory(env, jni_iblock);
+ jint * jni_isplit = (*env)->GetPrimitiveArrayCritical(env, isplit, JNI_FALSE);
+ check_memory(env, jni_isplit);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstein_(&n, jni_d, jni_e, &m, jni_w, jni_iblock, jni_isplit, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iblock, jni_iblock, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isplit, jni_isplit, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsteqr (JNIEnv * env, jobject calling_obj, jstring compz, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsteqr_(jni_compz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsterf (JNIEnv * env, jobject calling_obj, jint n, jdoubleArray d, jdoubleArray e, jobject info){
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsterf_(&n, jni_d, jni_e, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstev (JNIEnv * env, jobject calling_obj, jstring jobz, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray z, jint ldz, jdoubleArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstev_(jni_jobz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstevd (JNIEnv * env, jobject calling_obj, jstring jobz, jint n, jdoubleArray d, jdoubleArray e, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstevd_(jni_jobz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstevr (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jint n, jdoubleArray d, jdoubleArray e, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jintArray isuppz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jint * jni_isuppz = (*env)->GetPrimitiveArrayCritical(env, isuppz, JNI_FALSE);
+ check_memory(env, jni_isuppz);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstevr_(jni_jobz, jni_range, &n, jni_d, jni_e, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_isuppz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isuppz, jni_isuppz, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dstevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jint n, jdoubleArray d, jdoubleArray e, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dstevx_(jni_jobz, jni_range, &n, jni_d, jni_e, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsycon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jintArray ipiv, jdouble anorm, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsycon_(jni_uplo, &n, jni_a, &lda, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsyev (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray w, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsyev_(jni_jobz, jni_uplo, &n, jni_a, &lda, jni_w, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsyevd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray w, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsyevd_(jni_jobz, jni_uplo, &n, jni_a, &lda, jni_w, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsyevr (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jdoubleArray a, jint lda, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jintArray isuppz, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jint * jni_isuppz = (*env)->GetPrimitiveArrayCritical(env, isuppz, JNI_FALSE);
+ check_memory(env, jni_isuppz);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsyevr_(jni_jobz, jni_range, jni_uplo, &n, jni_a, &lda, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_isuppz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isuppz, jni_isuppz, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsyevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jdoubleArray a, jint lda, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsyevx_(jni_jobz, jni_range, jni_uplo, &n, jni_a, &lda, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsygs2 (JNIEnv * env, jobject calling_obj, jint itype, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsygs2_(&itype, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsygst (JNIEnv * env, jobject calling_obj, jint itype, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsygst_(&itype, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsygv (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray w, jdoubleArray work, jint lwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsygv_(&itype, jni_jobz, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, jni_w, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsygvd (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray w, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsygvd_(&itype, jni_jobz, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, jni_w, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsygvx (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring range, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble vl, jdouble vu, jint il, jint iu, jdouble abstol, jobject m, jdoubleArray w, jdoubleArray z, jint ldz, jdoubleArray work, jint lwork, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsygvx_(&itype, jni_jobz, jni_range, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsyrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray af, jint ldaf, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsyrfs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsysv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsysv_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsysvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray af, jint ldaf, jintArray ipiv, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jobject rcond, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsysvx_(jni_fact, jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsytd2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray d, jdoubleArray e, jdoubleArray tau, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsytd2_(jni_uplo, &n, jni_a, &lda, jni_d, jni_e, jni_tau, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsytf2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jintArray ipiv, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsytf2_(jni_uplo, &n, jni_a, &lda, jni_ipiv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsytrd (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jdoubleArray d, jdoubleArray e, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsytrd_(jni_uplo, &n, jni_a, &lda, jni_d, jni_e, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsytrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsytrf_(jni_uplo, &n, jni_a, &lda, jni_ipiv, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsytri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsytri_(jni_uplo, &n, jni_a, &lda, jni_ipiv, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dsytrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jdoubleArray a, jint lda, jintArray ipiv, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dsytrs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtbcon (JNIEnv * env, jobject calling_obj, jstring norm, jstring uplo, jstring diag, jint n, jint kd, jdoubleArray ab, jint ldab, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtbcon_(jni_norm, jni_uplo, jni_diag, &n, &kd, jni_ab, &ldab, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtbrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint kd, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtbrfs_(jni_uplo, jni_trans, jni_diag, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtbtrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint kd, jint nrhs, jdoubleArray ab, jint ldab, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtbtrs_(jni_uplo, jni_trans, jni_diag, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgevc (JNIEnv * env, jobject calling_obj, jstring side, jstring howmny, jbooleanArray select, jint n, jdoubleArray s, jint lds, jdoubleArray p, jint ldp, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jint mm, jobject m, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_p = (*env)->GetPrimitiveArrayCritical(env, p, JNI_FALSE);
+ check_memory(env, jni_p);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dtgevc_(jni_side, jni_howmny, jni_select, &n, jni_s, &lds, jni_p, &ldp, jni_vl, &ldvl, jni_vr, &ldvr, &mm, &jni_m, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, p, jni_p, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgex2 (JNIEnv * env, jobject calling_obj, jboolean wantq, jboolean wantz, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray q, jint ldq, jdoubleArray z, jint ldz, jint j1, jint n1, jint n2, jdoubleArray work, jint lwork, jobject info){
+ logical jni_wantq = (logical)wantq;
+ logical jni_wantz = (logical)wantz;
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtgex2_(&jni_wantq, &jni_wantz, &n, jni_a, &lda, jni_b, &ldb, jni_q, &ldq, jni_z, &ldz, &j1, &n1, &n2, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgexc (JNIEnv * env, jobject calling_obj, jboolean wantq, jboolean wantz, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray q, jint ldq, jdoubleArray z, jint ldz, jobject ifst, jobject ilst, jdoubleArray work, jint lwork, jobject info){
+ logical jni_wantq = (logical)wantq;
+ logical jni_wantz = (logical)wantz;
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_ifstClass = (*env)->GetObjectClass(env, ifst);
+ jfieldID jni_ifstId = (*env)->GetFieldID(env, jni_ifstClass, "val", "I");
+ jint jni_ifst = (*env)->GetIntField(env, ifst, jni_ifstId);
+ jclass jni_ilstClass = (*env)->GetObjectClass(env, ilst);
+ jfieldID jni_ilstId = (*env)->GetFieldID(env, jni_ilstClass, "val", "I");
+ jint jni_ilst = (*env)->GetIntField(env, ilst, jni_ilstId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtgexc_(&jni_wantq, &jni_wantz, &n, jni_a, &lda, jni_b, &ldb, jni_q, &ldq, jni_z, &ldz, &jni_ifst, &jni_ilst, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, ifst, jni_ifstId, jni_ifst);
+ (*env)->SetIntField(env, ilst, jni_ilstId, jni_ilst);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgsen (JNIEnv * env, jobject calling_obj, jint ijob, jboolean wantq, jboolean wantz, jbooleanArray select, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray alphar, jdoubleArray alphai, jdoubleArray beta, jdoubleArray q, jint ldq, jdoubleArray z, jint ldz, jobject m, jobject pl, jobject pr, jdoubleArray dif, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ logical jni_wantq = (logical)wantq;
+ logical jni_wantz = (logical)wantz;
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jdouble * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jclass jni_plClass = (*env)->GetObjectClass(env, pl);
+ jfieldID jni_plId = (*env)->GetFieldID(env, jni_plClass, "val", "D");
+ jdouble jni_pl = (*env)->GetDoubleField(env, pl, jni_plId);
+ jclass jni_prClass = (*env)->GetObjectClass(env, pr);
+ jfieldID jni_prId = (*env)->GetFieldID(env, jni_prClass, "val", "D");
+ jdouble jni_pr = (*env)->GetDoubleField(env, pr, jni_prId);
+ jdouble * jni_dif = (*env)->GetPrimitiveArrayCritical(env, dif, JNI_FALSE);
+ check_memory(env, jni_dif);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dtgsen_(&ijob, &jni_wantq, &jni_wantz, jni_select, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_q, &ldq, jni_z, &ldz, &jni_m, &jni_pl, &jni_pr, jni_dif, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->SetDoubleField(env, pl, jni_plId, jni_pl);
+ (*env)->SetDoubleField(env, pr, jni_prId, jni_pr);
+ (*env)->ReleasePrimitiveArrayCritical(env, dif, jni_dif, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgsja (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobv, jstring jobq, jint m, jint p, jint n, jint k, jint l, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdouble tola, jdouble tolb, jdoubleArray alpha, jdoubleArray beta, jdoubleArray u, jint ldu, jdoubleArray v, jint ldv, jdoubleArray q, jint ldq, jdoubleArray work, jobject ncycle, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobv = (char *)(*env)->GetStringUTFChars(env, jobv, JNI_FALSE);
+ char * jni_jobq = (char *)(*env)->GetStringUTFChars(env, jobq, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_alpha = (*env)->GetPrimitiveArrayCritical(env, alpha, JNI_FALSE);
+ check_memory(env, jni_alpha);
+ jdouble * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jdouble * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jdouble * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_ncycleClass = (*env)->GetObjectClass(env, ncycle);
+ jfieldID jni_ncycleId = (*env)->GetFieldID(env, jni_ncycleClass, "val", "I");
+ jint jni_ncycle = (*env)->GetIntField(env, ncycle, jni_ncycleId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtgsja_(jni_jobu, jni_jobv, jni_jobq, &m, &p, &n, &k, &l, jni_a, &lda, jni_b, &ldb, &tola, &tolb, jni_alpha, jni_beta, jni_u, &ldu, jni_v, &ldv, jni_q, &ldq, jni_work, &jni_ncycle, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobv, jni_jobv);
+ (*env)->ReleaseStringUTFChars(env, jobq, jni_jobq);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alpha, jni_alpha, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, ncycle, jni_ncycleId, jni_ncycle);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgsna (JNIEnv * env, jobject calling_obj, jstring job, jstring howmny, jbooleanArray select, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jdoubleArray s, jdoubleArray dif, jint mm, jobject m, jdoubleArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_dif = (*env)->GetPrimitiveArrayCritical(env, dif, JNI_FALSE);
+ check_memory(env, jni_dif);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dtgsna_(jni_job, jni_howmny, jni_select, &n, jni_a, &lda, jni_b, &ldb, jni_vl, &ldvl, jni_vr, &ldvr, jni_s, jni_dif, &mm, &jni_m, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dif, jni_dif, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgsy2 (JNIEnv * env, jobject calling_obj, jstring trans, jint ijob, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray c, jint Ldc, jdoubleArray d, jint ldd, jdoubleArray e, jint lde, jdoubleArray f, jint ldf, jobject scale, jobject rdsum, jobject rdscal, jintArray iwork, jobject pq, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_f = (*env)->GetPrimitiveArrayCritical(env, f, JNI_FALSE);
+ check_memory(env, jni_f);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jclass jni_rdsumClass = (*env)->GetObjectClass(env, rdsum);
+ jfieldID jni_rdsumId = (*env)->GetFieldID(env, jni_rdsumClass, "val", "D");
+ jdouble jni_rdsum = (*env)->GetDoubleField(env, rdsum, jni_rdsumId);
+ jclass jni_rdscalClass = (*env)->GetObjectClass(env, rdscal);
+ jfieldID jni_rdscalId = (*env)->GetFieldID(env, jni_rdscalClass, "val", "D");
+ jdouble jni_rdscal = (*env)->GetDoubleField(env, rdscal, jni_rdscalId);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_pqClass = (*env)->GetObjectClass(env, pq);
+ jfieldID jni_pqId = (*env)->GetFieldID(env, jni_pqClass, "val", "I");
+ jint jni_pq = (*env)->GetIntField(env, pq, jni_pqId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtgsy2_(jni_trans, &ijob, &m, &n, jni_a, &lda, jni_b, &ldb, jni_c, &Ldc, jni_d, &ldd, jni_e, &lde, jni_f, &ldf, &jni_scale, &jni_rdsum, &jni_rdscal, jni_iwork, &jni_pq, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, f, jni_f, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetDoubleField(env, rdsum, jni_rdsumId, jni_rdsum);
+ (*env)->SetDoubleField(env, rdscal, jni_rdscalId, jni_rdscal);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, pq, jni_pqId, jni_pq);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtgsyl (JNIEnv * env, jobject calling_obj, jstring trans, jint ijob, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray c, jint Ldc, jdoubleArray d, jint ldd, jdoubleArray e, jint lde, jdoubleArray f, jint ldf, jobject scale, jobject dif, jdoubleArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jdouble * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jdouble * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jdouble * jni_f = (*env)->GetPrimitiveArrayCritical(env, f, JNI_FALSE);
+ check_memory(env, jni_f);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jclass jni_difClass = (*env)->GetObjectClass(env, dif);
+ jfieldID jni_difId = (*env)->GetFieldID(env, jni_difClass, "val", "D");
+ jdouble jni_dif = (*env)->GetDoubleField(env, dif, jni_difId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtgsyl_(jni_trans, &ijob, &m, &n, jni_a, &lda, jni_b, &ldb, jni_c, &Ldc, jni_d, &ldd, jni_e, &lde, jni_f, &ldf, &jni_scale, &jni_dif, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, f, jni_f, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetDoubleField(env, dif, jni_difId, jni_dif);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtpcon (JNIEnv * env, jobject calling_obj, jstring norm, jstring uplo, jstring diag, jint n, jdoubleArray ap, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtpcon_(jni_norm, jni_uplo, jni_diag, &n, jni_ap, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtprfs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jdoubleArray ap, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtprfs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_ap, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtptri (JNIEnv * env, jobject calling_obj, jstring uplo, jstring diag, jint n, jdoubleArray ap, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtptri_(jni_uplo, jni_diag, &n, jni_ap, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtptrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jdoubleArray ap, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtptrs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_ap, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrcon (JNIEnv * env, jobject calling_obj, jstring norm, jstring uplo, jstring diag, jint n, jdoubleArray a, jint lda, jobject rcond, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jdouble jni_rcond = (*env)->GetDoubleField(env, rcond, jni_rcondId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrcon_(jni_norm, jni_uplo, jni_diag, &n, jni_a, &lda, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetDoubleField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrevc (JNIEnv * env, jobject calling_obj, jstring side, jstring howmny, jbooleanArray select, jint n, jdoubleArray t, jint ldt, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jint mm, jobject m, jdoubleArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dtrevc_(jni_side, jni_howmny, jni_select, &n, jni_t, &ldt, jni_vl, &ldvl, jni_vr, &ldvr, &mm, &jni_m, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrexc (JNIEnv * env, jobject calling_obj, jstring compq, jint n, jdoubleArray t, jint ldt, jdoubleArray q, jint ldq, jobject ifst, jobject ilst, jdoubleArray work, jobject info){
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jclass jni_ifstClass = (*env)->GetObjectClass(env, ifst);
+ jfieldID jni_ifstId = (*env)->GetFieldID(env, jni_ifstClass, "val", "I");
+ jint jni_ifst = (*env)->GetIntField(env, ifst, jni_ifstId);
+ jclass jni_ilstClass = (*env)->GetObjectClass(env, ilst);
+ jfieldID jni_ilstId = (*env)->GetFieldID(env, jni_ilstClass, "val", "I");
+ jint jni_ilst = (*env)->GetIntField(env, ilst, jni_ilstId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrexc_(jni_compq, &n, jni_t, &ldt, jni_q, &ldq, &jni_ifst, &jni_ilst, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->SetIntField(env, ifst, jni_ifstId, jni_ifst);
+ (*env)->SetIntField(env, ilst, jni_ilstId, jni_ilst);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray x, jint ldx, jdoubleArray ferr, jdoubleArray berr, jdoubleArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jdouble * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jdouble * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrrfs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrsen (JNIEnv * env, jobject calling_obj, jstring job, jstring compq, jbooleanArray select, jint n, jdoubleArray t, jint ldt, jdoubleArray q, jint ldq, jdoubleArray wr, jdoubleArray wi, jobject m, jobject s, jobject sep, jdoubleArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jdouble * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jdouble * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jdouble jni_s = (*env)->GetDoubleField(env, s, jni_sId);
+ jclass jni_sepClass = (*env)->GetObjectClass(env, sep);
+ jfieldID jni_sepId = (*env)->GetFieldID(env, jni_sepClass, "val", "D");
+ jdouble jni_sep = (*env)->GetDoubleField(env, sep, jni_sepId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dtrsen_(jni_job, jni_compq, jni_select, &n, jni_t, &ldt, jni_q, &ldq, jni_wr, jni_wi, &jni_m, &jni_s, &jni_sep, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->SetDoubleField(env, s, jni_sId, jni_s);
+ (*env)->SetDoubleField(env, sep, jni_sepId, jni_sep);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrsna (JNIEnv * env, jobject calling_obj, jstring job, jstring howmny, jbooleanArray select, jint n, jdoubleArray t, jint ldt, jdoubleArray vl, jint ldvl, jdoubleArray vr, jint ldvr, jdoubleArray s, jdoubleArray sep, jint mm, jobject m, jdoubleArray work, jint ldwork, jintArray iwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jdouble * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jdouble * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jdouble * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jdouble * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jdouble * jni_sep = (*env)->GetPrimitiveArrayCritical(env, sep, JNI_FALSE);
+ check_memory(env, jni_sep);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ dtrsna_(jni_job, jni_howmny, jni_select, &n, jni_t, &ldt, jni_vl, &ldvl, jni_vr, &ldvr, jni_s, jni_sep, &mm, &jni_m, jni_work, &ldwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sep, jni_sep, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrsyl (JNIEnv * env, jobject calling_obj, jstring trana, jstring tranb, jint isgn, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jdoubleArray c, jint Ldc, jobject scale, jobject info){
+ char * jni_trana = (char *)(*env)->GetStringUTFChars(env, trana, JNI_FALSE);
+ char * jni_tranb = (char *)(*env)->GetStringUTFChars(env, tranb, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jdouble * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jdouble jni_scale = (*env)->GetDoubleField(env, scale, jni_scaleId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrsyl_(jni_trana, jni_tranb, &isgn, &m, &n, jni_a, &lda, jni_b, &ldb, jni_c, &Ldc, &jni_scale, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trana, jni_trana);
+ (*env)->ReleaseStringUTFChars(env, tranb, jni_tranb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetDoubleField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrti2 (JNIEnv * env, jobject calling_obj, jstring uplo, jstring diag, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrti2_(jni_uplo, jni_diag, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrtri (JNIEnv * env, jobject calling_obj, jstring uplo, jstring diag, jint n, jdoubleArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrtri_(jni_uplo, jni_diag, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtrtrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jdoubleArray a, jint lda, jdoubleArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtrtrs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtzrqf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtzrqf_(&m, &n, jni_a, &lda, jni_tau, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dtzrzf (JNIEnv * env, jobject calling_obj, jint m, jint n, jdoubleArray a, jint lda, jdoubleArray tau, jdoubleArray work, jint lwork, jobject info){
+ jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jdouble * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jdouble * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ dtzrzf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT jint JNICALL Java_org_netlib_lapack_NativeLAPACK_ieeeck (JNIEnv * env, jobject calling_obj, jint ispec, jfloat zero, jfloat one){
+ jint returnValue;
+
+ returnValue = ieeeck_(&ispec, &zero, &one);
+
+
+ return returnValue;
+}
+
+JNIEXPORT jint JNICALL Java_org_netlib_lapack_NativeLAPACK_ilaenv (JNIEnv * env, jobject calling_obj, jint ispec, jstring name, jstring opts, jint n1, jint n2, jint n3, jint n4){
+ char * jni_name = (char *)(*env)->GetStringUTFChars(env, name, JNI_FALSE);
+ char * jni_opts = (char *)(*env)->GetStringUTFChars(env, opts, JNI_FALSE);
+ jint returnValue;
+
+ returnValue = ilaenv_(&ispec, jni_name, jni_opts, &n1, &n2, &n3, &n4, (*env)->GetStringLength(env, name), (*env)->GetStringLength(env, opts));
+
+ (*env)->ReleaseStringUTFChars(env, name, jni_name);
+ (*env)->ReleaseStringUTFChars(env, opts, jni_opts);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sbdsdc (JNIEnv * env, jobject calling_obj, jstring uplo, jstring compq, jint n, jfloatArray d, jfloatArray e, jfloatArray u, jint ldu, jfloatArray vt, jint ldvt, jfloatArray q, jintArray iq, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_iq = (*env)->GetPrimitiveArrayCritical(env, iq, JNI_FALSE);
+ check_memory(env, jni_iq);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sbdsdc_(jni_uplo, jni_compq, &n, jni_d, jni_e, jni_u, &ldu, jni_vt, &ldvt, jni_q, jni_iq, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iq, jni_iq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sbdsqr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint ncvt, jint nru, jint ncc, jfloatArray d, jfloatArray e, jfloatArray vt, jint ldvt, jfloatArray u, jint ldu, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sbdsqr_(jni_uplo, &n, &ncvt, &nru, &ncc, jni_d, jni_e, jni_vt, &ldvt, jni_u, &ldu, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sdisna (JNIEnv * env, jobject calling_obj, jstring job, jint m, jint n, jfloatArray d, jfloatArray sep, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_sep = (*env)->GetPrimitiveArrayCritical(env, sep, JNI_FALSE);
+ check_memory(env, jni_sep);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sdisna_(jni_job, &m, &n, jni_d, jni_sep, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sep, jni_sep, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbbrd (JNIEnv * env, jobject calling_obj, jstring vect, jint m, jint n, jint ncc, jint kl, jint ku, jfloatArray ab, jint ldab, jfloatArray d, jfloatArray e, jfloatArray q, jint ldq, jfloatArray pt, jint ldpt, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_pt = (*env)->GetPrimitiveArrayCritical(env, pt, JNI_FALSE);
+ check_memory(env, jni_pt);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbbrd_(jni_vect, &m, &n, &ncc, &kl, &ku, jni_ab, &ldab, jni_d, jni_e, jni_q, &ldq, jni_pt, &ldpt, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, pt, jni_pt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbcon (JNIEnv * env, jobject calling_obj, jstring norm, jint n, jint kl, jint ku, jfloatArray ab, jint ldab, jintArray ipiv, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbcon_(jni_norm, &n, &kl, &ku, jni_ab, &ldab, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbequ (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jfloatArray ab, jint ldab, jfloatArray r, jfloatArray c, jobject rowcnd, jobject colcnd, jobject amax, jobject info){
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_rowcndClass = (*env)->GetObjectClass(env, rowcnd);
+ jfieldID jni_rowcndId = (*env)->GetFieldID(env, jni_rowcndClass, "val", "D");
+ jfloat jni_rowcnd = (*env)->GetFloatField(env, rowcnd, jni_rowcndId);
+ jclass jni_colcndClass = (*env)->GetObjectClass(env, colcnd);
+ jfieldID jni_colcndId = (*env)->GetFieldID(env, jni_colcndClass, "val", "D");
+ jfloat jni_colcnd = (*env)->GetFloatField(env, colcnd, jni_colcndId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jfloat jni_amax = (*env)->GetFloatField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbequ_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_r, jni_c, &jni_rowcnd, &jni_colcnd, &jni_amax, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetFloatField(env, rowcnd, jni_rowcndId, jni_rowcnd);
+ (*env)->SetFloatField(env, colcnd, jni_colcndId, jni_colcnd);
+ (*env)->SetFloatField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbrfs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint kl, jint ku, jint nrhs, jfloatArray ab, jint ldab, jfloatArray afb, jint ldafb, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbrfs_(jni_trans, &n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbsv (JNIEnv * env, jobject calling_obj, jint n, jint kl, jint ku, jint nrhs, jfloatArray ab, jint ldab, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbsv_(&n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring trans, jint n, jint kl, jint ku, jint nrhs, jfloatArray ab, jint ldab, jfloatArray afb, jint ldafb, jintArray ipiv, jobject equed, jfloatArray r, jfloatArray c, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jfloat * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbsvx_(jni_fact, jni_trans, &n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_ipiv, jni_equed, jni_r, jni_c, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbtf2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jfloatArray ab, jint ldab, jintArray ipiv, jobject info){
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbtf2_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbtrf (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jfloatArray ab, jint ldab, jintArray ipiv, jobject info){
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbtrf_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgbtrs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint kl, jint ku, jint nrhs, jfloatArray ab, jint ldab, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgbtrs_(jni_trans, &n, &kl, &ku, &nrhs, jni_ab, &ldab, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgebak (JNIEnv * env, jobject calling_obj, jstring job, jstring side, jint n, jint ilo, jint ihi, jfloatArray scale, jint m, jfloatArray v, jint ldv, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jfloat * jni_scale = (*env)->GetPrimitiveArrayCritical(env, scale, JNI_FALSE);
+ check_memory(env, jni_scale);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgebak_(jni_job, jni_side, &n, &ilo, &ihi, jni_scale, &m, jni_v, &ldv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, scale, jni_scale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgebal (JNIEnv * env, jobject calling_obj, jstring job, jint n, jfloatArray a, jint lda, jobject ilo, jobject ihi, jfloatArray scale, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jfloat * jni_scale = (*env)->GetPrimitiveArrayCritical(env, scale, JNI_FALSE);
+ check_memory(env, jni_scale);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgebal_(jni_job, &n, jni_a, &lda, &jni_ilo, &jni_ihi, jni_scale, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, scale, jni_scale, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgebd2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray d, jfloatArray e, jfloatArray tauq, jfloatArray taup, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tauq = (*env)->GetPrimitiveArrayCritical(env, tauq, JNI_FALSE);
+ check_memory(env, jni_tauq);
+ jfloat * jni_taup = (*env)->GetPrimitiveArrayCritical(env, taup, JNI_FALSE);
+ check_memory(env, jni_taup);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgebd2_(&m, &n, jni_a, &lda, jni_d, jni_e, jni_tauq, jni_taup, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tauq, jni_tauq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taup, jni_taup, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgebrd (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray d, jfloatArray e, jfloatArray tauq, jfloatArray taup, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tauq = (*env)->GetPrimitiveArrayCritical(env, tauq, JNI_FALSE);
+ check_memory(env, jni_tauq);
+ jfloat * jni_taup = (*env)->GetPrimitiveArrayCritical(env, taup, JNI_FALSE);
+ check_memory(env, jni_taup);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgebrd_(&m, &n, jni_a, &lda, jni_d, jni_e, jni_tauq, jni_taup, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tauq, jni_tauq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taup, jni_taup, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgecon (JNIEnv * env, jobject calling_obj, jstring norm, jint n, jfloatArray a, jint lda, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgecon_(jni_norm, &n, jni_a, &lda, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeequ (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray r, jfloatArray c, jobject rowcnd, jobject colcnd, jobject amax, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_rowcndClass = (*env)->GetObjectClass(env, rowcnd);
+ jfieldID jni_rowcndId = (*env)->GetFieldID(env, jni_rowcndClass, "val", "D");
+ jfloat jni_rowcnd = (*env)->GetFloatField(env, rowcnd, jni_rowcndId);
+ jclass jni_colcndClass = (*env)->GetObjectClass(env, colcnd);
+ jfieldID jni_colcndId = (*env)->GetFieldID(env, jni_colcndClass, "val", "D");
+ jfloat jni_colcnd = (*env)->GetFloatField(env, colcnd, jni_colcndId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jfloat jni_amax = (*env)->GetFloatField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeequ_(&m, &n, jni_a, &lda, jni_r, jni_c, &jni_rowcnd, &jni_colcnd, &jni_amax, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetFloatField(env, rowcnd, jni_rowcndId, jni_rowcnd);
+ (*env)->SetFloatField(env, colcnd, jni_colcndId, jni_colcnd);
+ (*env)->SetFloatField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeev (JNIEnv * env, jobject calling_obj, jstring jobvl, jstring jobvr, jint n, jfloatArray a, jint lda, jfloatArray wr, jfloatArray wi, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jfloat * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeev_(jni_jobvl, jni_jobvr, &n, jni_a, &lda, jni_wr, jni_wi, jni_vl, &ldvl, jni_vr, &ldvr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeevx (JNIEnv * env, jobject calling_obj, jstring balanc, jstring jobvl, jstring jobvr, jstring sense, jint n, jfloatArray a, jint lda, jfloatArray wr, jfloatArray wi, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jobject ilo, jobject ihi, jfloatArray scale, jobject abnrm, jfloatArray rconde, jfloatArray rcondv, jfloatArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_balanc = (char *)(*env)->GetStringUTFChars(env, balanc, JNI_FALSE);
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ char * jni_sense = (char *)(*env)->GetStringUTFChars(env, sense, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jfloat * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jfloat * jni_scale = (*env)->GetPrimitiveArrayCritical(env, scale, JNI_FALSE);
+ check_memory(env, jni_scale);
+ jclass jni_abnrmClass = (*env)->GetObjectClass(env, abnrm);
+ jfieldID jni_abnrmId = (*env)->GetFieldID(env, jni_abnrmClass, "val", "D");
+ jfloat jni_abnrm = (*env)->GetFloatField(env, abnrm, jni_abnrmId);
+ jfloat * jni_rconde = (*env)->GetPrimitiveArrayCritical(env, rconde, JNI_FALSE);
+ check_memory(env, jni_rconde);
+ jfloat * jni_rcondv = (*env)->GetPrimitiveArrayCritical(env, rcondv, JNI_FALSE);
+ check_memory(env, jni_rcondv);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeevx_(jni_balanc, jni_jobvl, jni_jobvr, jni_sense, &n, jni_a, &lda, jni_wr, jni_wi, jni_vl, &ldvl, jni_vr, &ldvr, &jni_ilo, &jni_ihi, jni_scale, &jni_abnrm, jni_rconde, jni_rcondv, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, balanc, jni_balanc);
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleaseStringUTFChars(env, sense, jni_sense);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, scale, jni_scale, 0);
+ (*env)->SetFloatField(env, abnrm, jni_abnrmId, jni_abnrm);
+ (*env)->ReleasePrimitiveArrayCritical(env, rconde, jni_rconde, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rcondv, jni_rcondv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgegs (JNIEnv * env, jobject calling_obj, jstring jobvsl, jstring jobvsr, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jfloatArray vsl, jint ldvsl, jfloatArray vsr, jint ldvsr, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobvsl = (char *)(*env)->GetStringUTFChars(env, jobvsl, JNI_FALSE);
+ char * jni_jobvsr = (char *)(*env)->GetStringUTFChars(env, jobvsr, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_vsl = (*env)->GetPrimitiveArrayCritical(env, vsl, JNI_FALSE);
+ check_memory(env, jni_vsl);
+ jfloat * jni_vsr = (*env)->GetPrimitiveArrayCritical(env, vsr, JNI_FALSE);
+ check_memory(env, jni_vsr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgegs_(jni_jobvsl, jni_jobvsr, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vsl, &ldvsl, jni_vsr, &ldvsr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvsl, jni_jobvsl);
+ (*env)->ReleaseStringUTFChars(env, jobvsr, jni_jobvsr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vsl, jni_vsl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vsr, jni_vsr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgegv (JNIEnv * env, jobject calling_obj, jstring jobvl, jstring jobvr, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgegv_(jni_jobvl, jni_jobvr, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vl, &ldvl, jni_vr, &ldvr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgehd2 (JNIEnv * env, jobject calling_obj, jint n, jint ilo, jint ihi, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgehd2_(&n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgehrd (JNIEnv * env, jobject calling_obj, jint n, jint ilo, jint ihi, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgehrd_(&n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgelq2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgelq2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgelqf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgelqf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgels (JNIEnv * env, jobject calling_obj, jstring trans, jint m, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray work, jint lwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgels_(jni_trans, &m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgelsd (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray s, jfloat rcond, jobject rank, jfloatArray work, jint lwork, jintArray iwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgelsd_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_s, &rcond, &jni_rank, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgelss (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray s, jfloat rcond, jobject rank, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgelss_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_s, &rcond, &jni_rank, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgelsx (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jintArray jpvt, jfloat rcond, jobject rank, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgelsx_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_jpvt, &rcond, &jni_rank, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgelsy (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jintArray jpvt, jfloat rcond, jobject rank, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgelsy_(&m, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_jpvt, &rcond, &jni_rank, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeql2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeql2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeqlf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeqlf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeqp3 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jintArray jpvt, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeqp3_(&m, &n, jni_a, &lda, jni_jpvt, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeqpf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jintArray jpvt, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeqpf_(&m, &n, jni_a, &lda, jni_jpvt, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeqr2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeqr2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgeqrf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgeqrf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgerfs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray af, jint ldaf, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgerfs_(jni_trans, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgerq2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgerq2_(&m, &n, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgerqf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgerqf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgesc2 (JNIEnv * env, jobject calling_obj, jint n, jfloatArray a, jint lda, jfloatArray rhs, jintArray ipiv, jintArray jpiv, jobject scale){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_rhs = (*env)->GetPrimitiveArrayCritical(env, rhs, JNI_FALSE);
+ check_memory(env, jni_rhs);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jint * jni_jpiv = (*env)->GetPrimitiveArrayCritical(env, jpiv, JNI_FALSE);
+ check_memory(env, jni_jpiv);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+
+ sgesc2_(&n, jni_a, &lda, jni_rhs, jni_ipiv, jni_jpiv, &jni_scale);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rhs, jni_rhs, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpiv, jni_jpiv, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgesdd (JNIEnv * env, jobject calling_obj, jstring jobz, jint m, jint n, jfloatArray a, jint lda, jfloatArray s, jfloatArray u, jint ldu, jfloatArray vt, jint ldvt, jfloatArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgesdd_(jni_jobz, &m, &n, jni_a, &lda, jni_s, jni_u, &ldu, jni_vt, &ldvt, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgesv (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jfloatArray a, jint lda, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgesv_(&n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgesvd (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobvt, jint m, jint n, jfloatArray a, jint lda, jfloatArray s, jfloatArray u, jint ldu, jfloatArray vt, jint ldvt, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobvt = (char *)(*env)->GetStringUTFChars(env, jobvt, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgesvd_(jni_jobu, jni_jobvt, &m, &n, jni_a, &lda, jni_s, jni_u, &ldu, jni_vt, &ldvt, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobvt, jni_jobvt);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgesvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring trans, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray af, jint ldaf, jintArray ipiv, jobject equed, jfloatArray r, jfloatArray c, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jfloat * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgesvx_(jni_fact, jni_trans, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_equed, jni_r, jni_c, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgetc2 (JNIEnv * env, jobject calling_obj, jint n, jfloatArray a, jint lda, jintArray ipiv, jintArray jpiv, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jint * jni_jpiv = (*env)->GetPrimitiveArrayCritical(env, jpiv, JNI_FALSE);
+ check_memory(env, jni_jpiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgetc2_(&n, jni_a, &lda, jni_ipiv, jni_jpiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpiv, jni_jpiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgetf2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jintArray ipiv, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgetf2_(&m, &n, jni_a, &lda, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgetrf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jintArray ipiv, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgetrf_(&m, &n, jni_a, &lda, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgetri (JNIEnv * env, jobject calling_obj, jint n, jfloatArray a, jint lda, jintArray ipiv, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgetri_(&n, jni_a, &lda, jni_ipiv, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgetrs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jfloatArray a, jint lda, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgetrs_(jni_trans, &n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggbak (JNIEnv * env, jobject calling_obj, jstring job, jstring side, jint n, jint ilo, jint ihi, jfloatArray lscale, jfloatArray rscale, jint m, jfloatArray v, jint ldv, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jfloat * jni_lscale = (*env)->GetPrimitiveArrayCritical(env, lscale, JNI_FALSE);
+ check_memory(env, jni_lscale);
+ jfloat * jni_rscale = (*env)->GetPrimitiveArrayCritical(env, rscale, JNI_FALSE);
+ check_memory(env, jni_rscale);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggbak_(jni_job, jni_side, &n, &ilo, &ihi, jni_lscale, jni_rscale, &m, jni_v, &ldv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, lscale, jni_lscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rscale, jni_rscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggbal (JNIEnv * env, jobject calling_obj, jstring job, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jobject ilo, jobject ihi, jfloatArray lscale, jfloatArray rscale, jfloatArray work, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jfloat * jni_lscale = (*env)->GetPrimitiveArrayCritical(env, lscale, JNI_FALSE);
+ check_memory(env, jni_lscale);
+ jfloat * jni_rscale = (*env)->GetPrimitiveArrayCritical(env, rscale, JNI_FALSE);
+ check_memory(env, jni_rscale);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggbal_(jni_job, &n, jni_a, &lda, jni_b, &ldb, &jni_ilo, &jni_ihi, jni_lscale, jni_rscale, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, lscale, jni_lscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rscale, jni_rscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggev (JNIEnv * env, jobject calling_obj, jstring jobvl, jstring jobvr, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggev_(jni_jobvl, jni_jobvr, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vl, &ldvl, jni_vr, &ldvr, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggevx (JNIEnv * env, jobject calling_obj, jstring balanc, jstring jobvl, jstring jobvr, jstring sense, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jobject ilo, jobject ihi, jfloatArray lscale, jfloatArray rscale, jobject abnrm, jobject bbnrm, jfloatArray rconde, jfloatArray rcondv, jfloatArray work, jint [...]
+ char * jni_balanc = (char *)(*env)->GetStringUTFChars(env, balanc, JNI_FALSE);
+ char * jni_jobvl = (char *)(*env)->GetStringUTFChars(env, jobvl, JNI_FALSE);
+ char * jni_jobvr = (char *)(*env)->GetStringUTFChars(env, jobvr, JNI_FALSE);
+ char * jni_sense = (char *)(*env)->GetStringUTFChars(env, sense, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_iloClass = (*env)->GetObjectClass(env, ilo);
+ jfieldID jni_iloId = (*env)->GetFieldID(env, jni_iloClass, "val", "I");
+ jint jni_ilo = (*env)->GetIntField(env, ilo, jni_iloId);
+ jclass jni_ihiClass = (*env)->GetObjectClass(env, ihi);
+ jfieldID jni_ihiId = (*env)->GetFieldID(env, jni_ihiClass, "val", "I");
+ jint jni_ihi = (*env)->GetIntField(env, ihi, jni_ihiId);
+ jfloat * jni_lscale = (*env)->GetPrimitiveArrayCritical(env, lscale, JNI_FALSE);
+ check_memory(env, jni_lscale);
+ jfloat * jni_rscale = (*env)->GetPrimitiveArrayCritical(env, rscale, JNI_FALSE);
+ check_memory(env, jni_rscale);
+ jclass jni_abnrmClass = (*env)->GetObjectClass(env, abnrm);
+ jfieldID jni_abnrmId = (*env)->GetFieldID(env, jni_abnrmClass, "val", "D");
+ jfloat jni_abnrm = (*env)->GetFloatField(env, abnrm, jni_abnrmId);
+ jclass jni_bbnrmClass = (*env)->GetObjectClass(env, bbnrm);
+ jfieldID jni_bbnrmId = (*env)->GetFieldID(env, jni_bbnrmClass, "val", "D");
+ jfloat jni_bbnrm = (*env)->GetFloatField(env, bbnrm, jni_bbnrmId);
+ jfloat * jni_rconde = (*env)->GetPrimitiveArrayCritical(env, rconde, JNI_FALSE);
+ check_memory(env, jni_rconde);
+ jfloat * jni_rcondv = (*env)->GetPrimitiveArrayCritical(env, rcondv, JNI_FALSE);
+ check_memory(env, jni_rcondv);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jboolean * jni_bworkTmp = (*env)->GetPrimitiveArrayCritical(env, bwork, JNI_FALSE);
+ jint jni_bworkSize = (*env)->GetArrayLength(env, bwork);
+ logical jni_bwork[jni_bworkSize];
+ int jni_bworki;
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_bworki = 0 ; jni_bworki < jni_bworkSize ; jni_bworki++){
+ if (jni_bworkTmp[jni_bworki] == JNI_FALSE){
+ jni_bwork[jni_bworki] = 0;
+ } else {
+ jni_bwork[jni_bworki] = 1;
+ }
+ }
+
+ sggevx_(jni_balanc, jni_jobvl, jni_jobvr, jni_sense, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_vl, &ldvl, jni_vr, &ldvr, &jni_ilo, &jni_ihi, jni_lscale, jni_rscale, &jni_abnrm, &jni_bbnrm, jni_rconde, jni_rcondv, jni_work, &lwork, jni_iwork, jni_bwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, balanc, jni_balanc);
+ (*env)->ReleaseStringUTFChars(env, jobvl, jni_jobvl);
+ (*env)->ReleaseStringUTFChars(env, jobvr, jni_jobvr);
+ (*env)->ReleaseStringUTFChars(env, sense, jni_sense);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, ilo, jni_iloId, jni_ilo);
+ (*env)->SetIntField(env, ihi, jni_ihiId, jni_ihi);
+ (*env)->ReleasePrimitiveArrayCritical(env, lscale, jni_lscale, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rscale, jni_rscale, 0);
+ (*env)->SetFloatField(env, abnrm, jni_abnrmId, jni_abnrm);
+ (*env)->SetFloatField(env, bbnrm, jni_bbnrmId, jni_bbnrm);
+ (*env)->ReleasePrimitiveArrayCritical(env, rconde, jni_rconde, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rcondv, jni_rcondv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ for (jni_bworki = 0 ; jni_bworki < jni_bworkSize ; jni_bworki++){
+ if (jni_bwork[jni_bworki] == 0){
+ jni_bworkTmp[jni_bworki] = JNI_FALSE;
+ } else {
+ jni_bworkTmp[jni_bworki] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, bwork, jni_bworkTmp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggglm (JNIEnv * env, jobject calling_obj, jint n, jint m, jint p, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray d, jfloatArray x, jfloatArray y, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggglm_(&n, &m, &p, jni_a, &lda, jni_b, &ldb, jni_d, jni_x, jni_y, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgghrd (JNIEnv * env, jobject calling_obj, jstring compq, jstring compz, jint n, jint ilo, jint ihi, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray q, jint ldq, jfloatArray z, jint ldz, jobject info){
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgghrd_(jni_compq, jni_compz, &n, &ilo, &ihi, jni_a, &lda, jni_b, &ldb, jni_q, &ldq, jni_z, &ldz, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgglse (JNIEnv * env, jobject calling_obj, jint m, jint n, jint p, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray c, jfloatArray d, jfloatArray x, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgglse_(&m, &n, &p, jni_a, &lda, jni_b, &ldb, jni_c, jni_d, jni_x, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggqrf (JNIEnv * env, jobject calling_obj, jint n, jint m, jint p, jfloatArray a, jint lda, jfloatArray taua, jfloatArray b, jint ldb, jfloatArray taub, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_taua = (*env)->GetPrimitiveArrayCritical(env, taua, JNI_FALSE);
+ check_memory(env, jni_taua);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_taub = (*env)->GetPrimitiveArrayCritical(env, taub, JNI_FALSE);
+ check_memory(env, jni_taub);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggqrf_(&n, &m, &p, jni_a, &lda, jni_taua, jni_b, &ldb, jni_taub, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taua, jni_taua, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taub, jni_taub, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggrqf (JNIEnv * env, jobject calling_obj, jint m, jint p, jint n, jfloatArray a, jint lda, jfloatArray taua, jfloatArray b, jint ldb, jfloatArray taub, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_taua = (*env)->GetPrimitiveArrayCritical(env, taua, JNI_FALSE);
+ check_memory(env, jni_taua);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_taub = (*env)->GetPrimitiveArrayCritical(env, taub, JNI_FALSE);
+ check_memory(env, jni_taub);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggrqf_(&m, &p, &n, jni_a, &lda, jni_taua, jni_b, &ldb, jni_taub, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taua, jni_taua, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taub, jni_taub, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggsvd (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobv, jstring jobq, jint m, jint n, jint p, jobject k, jobject l, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alpha, jfloatArray beta, jfloatArray u, jint ldu, jfloatArray v, jint ldv, jfloatArray q, jint ldq, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobv = (char *)(*env)->GetStringUTFChars(env, jobv, JNI_FALSE);
+ char * jni_jobq = (char *)(*env)->GetStringUTFChars(env, jobq, JNI_FALSE);
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jclass jni_lClass = (*env)->GetObjectClass(env, l);
+ jfieldID jni_lId = (*env)->GetFieldID(env, jni_lClass, "val", "I");
+ jint jni_l = (*env)->GetIntField(env, l, jni_lId);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alpha = (*env)->GetPrimitiveArrayCritical(env, alpha, JNI_FALSE);
+ check_memory(env, jni_alpha);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggsvd_(jni_jobu, jni_jobv, jni_jobq, &m, &n, &p, &jni_k, &jni_l, jni_a, &lda, jni_b, &ldb, jni_alpha, jni_beta, jni_u, &ldu, jni_v, &ldv, jni_q, &ldq, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobv, jni_jobv);
+ (*env)->ReleaseStringUTFChars(env, jobq, jni_jobq);
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->SetIntField(env, l, jni_lId, jni_l);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alpha, jni_alpha, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sggsvp (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobv, jstring jobq, jint m, jint p, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat tola, jfloat tolb, jobject k, jobject l, jfloatArray u, jint ldu, jfloatArray v, jint ldv, jfloatArray q, jint ldq, jintArray iwork, jfloatArray tau, jfloatArray work, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobv = (char *)(*env)->GetStringUTFChars(env, jobv, JNI_FALSE);
+ char * jni_jobq = (char *)(*env)->GetStringUTFChars(env, jobq, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jclass jni_lClass = (*env)->GetObjectClass(env, l);
+ jfieldID jni_lId = (*env)->GetFieldID(env, jni_lClass, "val", "I");
+ jint jni_l = (*env)->GetIntField(env, l, jni_lId);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sggsvp_(jni_jobu, jni_jobv, jni_jobq, &m, &p, &n, jni_a, &lda, jni_b, &ldb, &tola, &tolb, &jni_k, &jni_l, jni_u, &ldu, jni_v, &ldv, jni_q, &ldq, jni_iwork, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobv, jni_jobv);
+ (*env)->ReleaseStringUTFChars(env, jobq, jni_jobq);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->SetIntField(env, l, jni_lId, jni_l);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgtcon (JNIEnv * env, jobject calling_obj, jstring norm, jint n, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray du2, jintArray ipiv, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgtcon_(jni_norm, &n, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgtrfs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray dlf, jfloatArray df, jfloatArray duf, jfloatArray du2, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_dlf = (*env)->GetPrimitiveArrayCritical(env, dlf, JNI_FALSE);
+ check_memory(env, jni_dlf);
+ jfloat * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jfloat * jni_duf = (*env)->GetPrimitiveArrayCritical(env, duf, JNI_FALSE);
+ check_memory(env, jni_duf);
+ jfloat * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgtrfs_(jni_trans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_dlf, jni_df, jni_duf, jni_du2, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlf, jni_dlf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, duf, jni_duf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgtsv (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray b, jint ldb, jobject info){
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgtsv_(&n, &nrhs, jni_dl, jni_d, jni_du, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgtsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring trans, jint n, jint nrhs, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray dlf, jfloatArray df, jfloatArray duf, jfloatArray du2, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_dlf = (*env)->GetPrimitiveArrayCritical(env, dlf, JNI_FALSE);
+ check_memory(env, jni_dlf);
+ jfloat * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jfloat * jni_duf = (*env)->GetPrimitiveArrayCritical(env, duf, JNI_FALSE);
+ check_memory(env, jni_duf);
+ jfloat * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgtsvx_(jni_fact, jni_trans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_dlf, jni_df, jni_duf, jni_du2, jni_ipiv, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlf, jni_dlf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, duf, jni_duf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgttrf (JNIEnv * env, jobject calling_obj, jint n, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray du2, jintArray ipiv, jobject info){
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgttrf_(&n, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgttrs (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray du2, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sgttrs_(jni_trans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sgtts2 (JNIEnv * env, jobject calling_obj, jint itrans, jint n, jint nrhs, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray du2, jintArray ipiv, jfloatArray b, jint ldb){
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_du2 = (*env)->GetPrimitiveArrayCritical(env, du2, JNI_FALSE);
+ check_memory(env, jni_du2);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ sgtts2_(&itrans, &n, &nrhs, jni_dl, jni_d, jni_du, jni_du2, jni_ipiv, jni_b, &ldb);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du2, jni_du2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_shgeqz (JNIEnv * env, jobject calling_obj, jstring job, jstring compq, jstring compz, jint n, jint ilo, jint ihi, jfloatArray h, jint ldh, jfloatArray t, jint ldt, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jfloatArray q, jint ldq, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jfloat * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ shgeqz_(jni_job, jni_compq, jni_compz, &n, &ilo, &ihi, jni_h, &ldh, jni_t, &ldt, jni_alphar, jni_alphai, jni_beta, jni_q, &ldq, jni_z, &ldz, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_shsein (JNIEnv * env, jobject calling_obj, jstring side, jstring eigsrc, jstring initv, jbooleanArray select, jint n, jfloatArray h, jint ldh, jfloatArray wr, jfloatArray wi, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jint mm, jobject m, jfloatArray work, jintArray ifaill, jintArray ifailr, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_eigsrc = (char *)(*env)->GetStringUTFChars(env, eigsrc, JNI_FALSE);
+ char * jni_initv = (char *)(*env)->GetStringUTFChars(env, initv, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jfloat * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jfloat * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_ifaill = (*env)->GetPrimitiveArrayCritical(env, ifaill, JNI_FALSE);
+ check_memory(env, jni_ifaill);
+ jint * jni_ifailr = (*env)->GetPrimitiveArrayCritical(env, ifailr, JNI_FALSE);
+ check_memory(env, jni_ifailr);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ shsein_(jni_side, jni_eigsrc, jni_initv, jni_select, &n, jni_h, &ldh, jni_wr, jni_wi, jni_vl, &ldvl, jni_vr, &ldvr, &mm, &jni_m, jni_work, jni_ifaill, jni_ifailr, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, eigsrc, jni_eigsrc);
+ (*env)->ReleaseStringUTFChars(env, initv, jni_initv);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifaill, jni_ifaill, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifailr, jni_ifailr, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_shseqr (JNIEnv * env, jobject calling_obj, jstring job, jstring compz, jint n, jint ilo, jint ihi, jfloatArray h, jint ldh, jfloatArray wr, jfloatArray wi, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jfloat * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jfloat * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jfloat * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ shseqr_(jni_job, jni_compz, &n, &ilo, &ihi, jni_h, &ldh, jni_wr, jni_wi, jni_z, &ldz, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slabad (JNIEnv * env, jobject calling_obj, jobject small, jobject large){
+ jclass jni_smallClass = (*env)->GetObjectClass(env, small);
+ jfieldID jni_smallId = (*env)->GetFieldID(env, jni_smallClass, "val", "D");
+ jfloat jni_small = (*env)->GetFloatField(env, small, jni_smallId);
+ jclass jni_largeClass = (*env)->GetObjectClass(env, large);
+ jfieldID jni_largeId = (*env)->GetFieldID(env, jni_largeClass, "val", "D");
+ jfloat jni_large = (*env)->GetFloatField(env, large, jni_largeId);
+
+ slabad_(&jni_small, &jni_large);
+
+ (*env)->SetFloatField(env, small, jni_smallId, jni_small);
+ (*env)->SetFloatField(env, large, jni_largeId, jni_large);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slabrd (JNIEnv * env, jobject calling_obj, jint m, jint n, jint nb, jfloatArray a, jint lda, jfloatArray d, jfloatArray e, jfloatArray tauq, jfloatArray taup, jfloatArray x, jint ldx, jfloatArray y, jint ldy){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tauq = (*env)->GetPrimitiveArrayCritical(env, tauq, JNI_FALSE);
+ check_memory(env, jni_tauq);
+ jfloat * jni_taup = (*env)->GetPrimitiveArrayCritical(env, taup, JNI_FALSE);
+ check_memory(env, jni_taup);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ slabrd_(&m, &n, &nb, jni_a, &lda, jni_d, jni_e, jni_tauq, jni_taup, jni_x, &ldx, jni_y, &ldy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tauq, jni_tauq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, taup, jni_taup, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slacon (JNIEnv * env, jobject calling_obj, jint n, jfloatArray v, jfloatArray x, jintArray isgn, jobject est, jobject kase){
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jint * jni_isgn = (*env)->GetPrimitiveArrayCritical(env, isgn, JNI_FALSE);
+ check_memory(env, jni_isgn);
+ jclass jni_estClass = (*env)->GetObjectClass(env, est);
+ jfieldID jni_estId = (*env)->GetFieldID(env, jni_estClass, "val", "D");
+ jfloat jni_est = (*env)->GetFloatField(env, est, jni_estId);
+ jclass jni_kaseClass = (*env)->GetObjectClass(env, kase);
+ jfieldID jni_kaseId = (*env)->GetFieldID(env, jni_kaseClass, "val", "I");
+ jint jni_kase = (*env)->GetIntField(env, kase, jni_kaseId);
+
+ slacon_(&n, jni_v, jni_x, jni_isgn, &jni_est, &jni_kase);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isgn, jni_isgn, 0);
+ (*env)->SetFloatField(env, est, jni_estId, jni_est);
+ (*env)->SetIntField(env, kase, jni_kaseId, jni_kase);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slacpy (JNIEnv * env, jobject calling_obj, jstring uplo, jint m, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ slacpy_(jni_uplo, &m, &n, jni_a, &lda, jni_b, &ldb);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sladiv (JNIEnv * env, jobject calling_obj, jfloat a, jfloat b, jfloat c, jfloat d, jobject p, jobject q){
+ jclass jni_pClass = (*env)->GetObjectClass(env, p);
+ jfieldID jni_pId = (*env)->GetFieldID(env, jni_pClass, "val", "D");
+ jfloat jni_p = (*env)->GetFloatField(env, p, jni_pId);
+ jclass jni_qClass = (*env)->GetObjectClass(env, q);
+ jfieldID jni_qId = (*env)->GetFieldID(env, jni_qClass, "val", "D");
+ jfloat jni_q = (*env)->GetFloatField(env, q, jni_qId);
+
+ sladiv_(&a, &b, &c, &d, &jni_p, &jni_q);
+
+ (*env)->SetFloatField(env, p, jni_pId, jni_p);
+ (*env)->SetFloatField(env, q, jni_qId, jni_q);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slae2 (JNIEnv * env, jobject calling_obj, jfloat a, jfloat b, jfloat c, jobject rt1, jobject rt2){
+ jclass jni_rt1Class = (*env)->GetObjectClass(env, rt1);
+ jfieldID jni_rt1Id = (*env)->GetFieldID(env, jni_rt1Class, "val", "D");
+ jfloat jni_rt1 = (*env)->GetFloatField(env, rt1, jni_rt1Id);
+ jclass jni_rt2Class = (*env)->GetObjectClass(env, rt2);
+ jfieldID jni_rt2Id = (*env)->GetFieldID(env, jni_rt2Class, "val", "D");
+ jfloat jni_rt2 = (*env)->GetFloatField(env, rt2, jni_rt2Id);
+
+ slae2_(&a, &b, &c, &jni_rt1, &jni_rt2);
+
+ (*env)->SetFloatField(env, rt1, jni_rt1Id, jni_rt1);
+ (*env)->SetFloatField(env, rt2, jni_rt2Id, jni_rt2);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaebz (JNIEnv * env, jobject calling_obj, jint ijob, jint nitmax, jint n, jint mmax, jint minp, jint nbmin, jfloat abstol, jfloat reltol, jfloat pivmin, jfloatArray d, jfloatArray e, jfloatArray e2, jintArray nval, jfloatArray ab, jfloatArray c, jobject mout, jintArray nab, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_e2 = (*env)->GetPrimitiveArrayCritical(env, e2, JNI_FALSE);
+ check_memory(env, jni_e2);
+ jint * jni_nval = (*env)->GetPrimitiveArrayCritical(env, nval, JNI_FALSE);
+ check_memory(env, jni_nval);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_moutClass = (*env)->GetObjectClass(env, mout);
+ jfieldID jni_moutId = (*env)->GetFieldID(env, jni_moutClass, "val", "I");
+ jint jni_mout = (*env)->GetIntField(env, mout, jni_moutId);
+ jint * jni_nab = (*env)->GetPrimitiveArrayCritical(env, nab, JNI_FALSE);
+ check_memory(env, jni_nab);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaebz_(&ijob, &nitmax, &n, &mmax, &minp, &nbmin, &abstol, &reltol, &pivmin, jni_d, jni_e, jni_e2, jni_nval, jni_ab, jni_c, &jni_mout, jni_nab, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e2, jni_e2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, nval, jni_nval, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetIntField(env, mout, jni_moutId, jni_mout);
+ (*env)->ReleasePrimitiveArrayCritical(env, nab, jni_nab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed0 (JNIEnv * env, jobject calling_obj, jint icompq, jint qsiz, jint n, jfloatArray d, jfloatArray e, jfloatArray q, jint ldq, jfloatArray qstore, jint ldqs, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_qstore = (*env)->GetPrimitiveArrayCritical(env, qstore, JNI_FALSE);
+ check_memory(env, jni_qstore);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed0_(&icompq, &qsiz, &n, jni_d, jni_e, jni_q, &ldq, jni_qstore, &ldqs, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, qstore, jni_qstore, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed1 (JNIEnv * env, jobject calling_obj, jint n, jfloatArray d, jfloatArray q, jint ldq, jintArray indxq, jobject rho, jint cutpnt, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jfloat jni_rho = (*env)->GetFloatField(env, rho, jni_rhoId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed1_(&n, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, &cutpnt, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetFloatField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed2 (JNIEnv * env, jobject calling_obj, jobject k, jint n, jint n1, jfloatArray d, jfloatArray q, jint ldq, jintArray indxq, jobject rho, jfloatArray z, jfloatArray dlamda, jfloatArray w, jfloatArray q2, jintArray indx, jintArray indxc, jintArray indxp, jintArray coltyp, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jfloat jni_rho = (*env)->GetFloatField(env, rho, jni_rhoId);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_q2 = (*env)->GetPrimitiveArrayCritical(env, q2, JNI_FALSE);
+ check_memory(env, jni_q2);
+ jint * jni_indx = (*env)->GetPrimitiveArrayCritical(env, indx, JNI_FALSE);
+ check_memory(env, jni_indx);
+ jint * jni_indxc = (*env)->GetPrimitiveArrayCritical(env, indxc, JNI_FALSE);
+ check_memory(env, jni_indxc);
+ jint * jni_indxp = (*env)->GetPrimitiveArrayCritical(env, indxp, JNI_FALSE);
+ check_memory(env, jni_indxp);
+ jint * jni_coltyp = (*env)->GetPrimitiveArrayCritical(env, coltyp, JNI_FALSE);
+ check_memory(env, jni_coltyp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed2_(&jni_k, &n, &n1, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, jni_z, jni_dlamda, jni_w, jni_q2, jni_indx, jni_indxc, jni_indxp, jni_coltyp, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetFloatField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q2, jni_q2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indx, jni_indx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxc, jni_indxc, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxp, jni_indxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, coltyp, jni_coltyp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed3 (JNIEnv * env, jobject calling_obj, jint k, jint n, jint n1, jfloatArray d, jfloatArray q, jint ldq, jfloat rho, jfloatArray dlamda, jfloatArray q2, jintArray indx, jintArray ctot, jfloatArray w, jfloatArray s, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jfloat * jni_q2 = (*env)->GetPrimitiveArrayCritical(env, q2, JNI_FALSE);
+ check_memory(env, jni_q2);
+ jint * jni_indx = (*env)->GetPrimitiveArrayCritical(env, indx, JNI_FALSE);
+ check_memory(env, jni_indx);
+ jint * jni_ctot = (*env)->GetPrimitiveArrayCritical(env, ctot, JNI_FALSE);
+ check_memory(env, jni_ctot);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed3_(&k, &n, &n1, jni_d, jni_q, &ldq, &rho, jni_dlamda, jni_q2, jni_indx, jni_ctot, jni_w, jni_s, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q2, jni_q2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indx, jni_indx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ctot, jni_ctot, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed4 (JNIEnv * env, jobject calling_obj, jint n, jint i, jfloatArray d, jfloatArray z, jfloatArray delta, jfloat rho, jobject dlam, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_dlamClass = (*env)->GetObjectClass(env, dlam);
+ jfieldID jni_dlamId = (*env)->GetFieldID(env, jni_dlamClass, "val", "D");
+ jfloat jni_dlam = (*env)->GetFloatField(env, dlam, jni_dlamId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed4_(&n, &i, jni_d, jni_z, jni_delta, &rho, &jni_dlam, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetFloatField(env, dlam, jni_dlamId, jni_dlam);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed5 (JNIEnv * env, jobject calling_obj, jint i, jfloatArray d, jfloatArray z, jfloatArray delta, jfloat rho, jobject dlam){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_dlamClass = (*env)->GetObjectClass(env, dlam);
+ jfieldID jni_dlamId = (*env)->GetFieldID(env, jni_dlamClass, "val", "D");
+ jfloat jni_dlam = (*env)->GetFloatField(env, dlam, jni_dlamId);
+
+ slaed5_(&i, jni_d, jni_z, jni_delta, &rho, &jni_dlam);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetFloatField(env, dlam, jni_dlamId, jni_dlam);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed6 (JNIEnv * env, jobject calling_obj, jint kniter, jboolean orgati, jfloat rho, jfloatArray d, jfloatArray z, jfloat finit, jobject tau, jobject info){
+ logical jni_orgati = (logical)orgati;
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_tauClass = (*env)->GetObjectClass(env, tau);
+ jfieldID jni_tauId = (*env)->GetFieldID(env, jni_tauClass, "val", "D");
+ jfloat jni_tau = (*env)->GetFloatField(env, tau, jni_tauId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed6_(&kniter, &jni_orgati, &rho, jni_d, jni_z, &finit, &jni_tau, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetFloatField(env, tau, jni_tauId, jni_tau);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed7 (JNIEnv * env, jobject calling_obj, jint icompq, jint n, jint qsiz, jint tlvls, jint curlvl, jint curpbm, jfloatArray d, jfloatArray q, jint ldq, jintArray indxq, jobject rho, jint cutpnt, jfloatArray qstore, jintArray qptr, jintArray prmptr, jintArray perm, jintArray givptr, jintArray givcol, jfloatArray givnum, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jfloat jni_rho = (*env)->GetFloatField(env, rho, jni_rhoId);
+ jfloat * jni_qstore = (*env)->GetPrimitiveArrayCritical(env, qstore, JNI_FALSE);
+ check_memory(env, jni_qstore);
+ jint * jni_qptr = (*env)->GetPrimitiveArrayCritical(env, qptr, JNI_FALSE);
+ check_memory(env, jni_qptr);
+ jint * jni_prmptr = (*env)->GetPrimitiveArrayCritical(env, prmptr, JNI_FALSE);
+ check_memory(env, jni_prmptr);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed7_(&icompq, &n, &qsiz, &tlvls, &curlvl, &curpbm, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, &cutpnt, jni_qstore, jni_qptr, jni_prmptr, jni_perm, jni_givptr, jni_givcol, jni_givnum, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetFloatField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, qstore, jni_qstore, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, qptr, jni_qptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, prmptr, jni_prmptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed8 (JNIEnv * env, jobject calling_obj, jint icompq, jobject k, jint n, jint qsiz, jfloatArray d, jfloatArray q, jint ldq, jintArray indxq, jobject rho, jint cutpnt, jfloatArray z, jfloatArray dlamda, jfloatArray q2, jint ldq2, jfloatArray w, jintArray perm, jobject givptr, jintArray givcol, jfloatArray givnum, jintArray indxp, jintArray indx, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_indxq = (*env)->GetPrimitiveArrayCritical(env, indxq, JNI_FALSE);
+ check_memory(env, jni_indxq);
+ jclass jni_rhoClass = (*env)->GetObjectClass(env, rho);
+ jfieldID jni_rhoId = (*env)->GetFieldID(env, jni_rhoClass, "val", "D");
+ jfloat jni_rho = (*env)->GetFloatField(env, rho, jni_rhoId);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jfloat * jni_q2 = (*env)->GetPrimitiveArrayCritical(env, q2, JNI_FALSE);
+ check_memory(env, jni_q2);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jclass jni_givptrClass = (*env)->GetObjectClass(env, givptr);
+ jfieldID jni_givptrId = (*env)->GetFieldID(env, jni_givptrClass, "val", "I");
+ jint jni_givptr = (*env)->GetIntField(env, givptr, jni_givptrId);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jint * jni_indxp = (*env)->GetPrimitiveArrayCritical(env, indxp, JNI_FALSE);
+ check_memory(env, jni_indxp);
+ jint * jni_indx = (*env)->GetPrimitiveArrayCritical(env, indx, JNI_FALSE);
+ check_memory(env, jni_indx);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed8_(&icompq, &jni_k, &n, &qsiz, jni_d, jni_q, &ldq, jni_indxq, &jni_rho, &cutpnt, jni_z, jni_dlamda, jni_q2, &ldq2, jni_w, jni_perm, &jni_givptr, jni_givcol, jni_givnum, jni_indxp, jni_indx, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxq, jni_indxq, 0);
+ (*env)->SetFloatField(env, rho, jni_rhoId, jni_rho);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q2, jni_q2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->SetIntField(env, givptr, jni_givptrId, jni_givptr);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indxp, jni_indxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, indx, jni_indx, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaed9 (JNIEnv * env, jobject calling_obj, jint k, jint kstart, jint kstop, jint n, jfloatArray d, jfloatArray q, jint ldq, jfloat rho, jfloatArray dlamda, jfloatArray w, jfloatArray s, jint lds, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_dlamda = (*env)->GetPrimitiveArrayCritical(env, dlamda, JNI_FALSE);
+ check_memory(env, jni_dlamda);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaed9_(&k, &kstart, &kstop, &n, jni_d, jni_q, &ldq, &rho, jni_dlamda, jni_w, jni_s, &lds, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dlamda, jni_dlamda, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaeda (JNIEnv * env, jobject calling_obj, jint n, jint tlvls, jint curlvl, jint curpbm, jintArray prmptr, jintArray perm, jintArray givptr, jintArray givcol, jfloatArray givnum, jfloatArray q, jintArray qptr, jfloatArray z, jfloatArray ztemp, jobject info){
+ jint * jni_prmptr = (*env)->GetPrimitiveArrayCritical(env, prmptr, JNI_FALSE);
+ check_memory(env, jni_prmptr);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jint * jni_qptr = (*env)->GetPrimitiveArrayCritical(env, qptr, JNI_FALSE);
+ check_memory(env, jni_qptr);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_ztemp = (*env)->GetPrimitiveArrayCritical(env, ztemp, JNI_FALSE);
+ check_memory(env, jni_ztemp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaeda_(&n, &tlvls, &curlvl, &curpbm, jni_prmptr, jni_perm, jni_givptr, jni_givcol, jni_givnum, jni_q, jni_qptr, jni_z, jni_ztemp, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, prmptr, jni_prmptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, qptr, jni_qptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ztemp, jni_ztemp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaein (JNIEnv * env, jobject calling_obj, jboolean rightv, jboolean noinit, jint n, jfloatArray h, jint ldh, jfloat wr, jfloat wi, jfloatArray vr, jfloatArray vi, jfloatArray b, jint ldb, jfloatArray work, jfloat eps3, jfloat smlnum, jfloat bignum, jobject info){
+ logical jni_rightv = (logical)rightv;
+ logical jni_noinit = (logical)noinit;
+ jfloat * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jfloat * jni_vi = (*env)->GetPrimitiveArrayCritical(env, vi, JNI_FALSE);
+ check_memory(env, jni_vi);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaein_(&jni_rightv, &jni_noinit, &n, jni_h, &ldh, &wr, &wi, jni_vr, jni_vi, jni_b, &ldb, jni_work, &eps3, &smlnum, &bignum, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vi, jni_vi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaev2 (JNIEnv * env, jobject calling_obj, jfloat a, jfloat b, jfloat c, jobject rt1, jobject rt2, jobject cs1, jobject sn1){
+ jclass jni_rt1Class = (*env)->GetObjectClass(env, rt1);
+ jfieldID jni_rt1Id = (*env)->GetFieldID(env, jni_rt1Class, "val", "D");
+ jfloat jni_rt1 = (*env)->GetFloatField(env, rt1, jni_rt1Id);
+ jclass jni_rt2Class = (*env)->GetObjectClass(env, rt2);
+ jfieldID jni_rt2Id = (*env)->GetFieldID(env, jni_rt2Class, "val", "D");
+ jfloat jni_rt2 = (*env)->GetFloatField(env, rt2, jni_rt2Id);
+ jclass jni_cs1Class = (*env)->GetObjectClass(env, cs1);
+ jfieldID jni_cs1Id = (*env)->GetFieldID(env, jni_cs1Class, "val", "D");
+ jfloat jni_cs1 = (*env)->GetFloatField(env, cs1, jni_cs1Id);
+ jclass jni_sn1Class = (*env)->GetObjectClass(env, sn1);
+ jfieldID jni_sn1Id = (*env)->GetFieldID(env, jni_sn1Class, "val", "D");
+ jfloat jni_sn1 = (*env)->GetFloatField(env, sn1, jni_sn1Id);
+
+ slaev2_(&a, &b, &c, &jni_rt1, &jni_rt2, &jni_cs1, &jni_sn1);
+
+ (*env)->SetFloatField(env, rt1, jni_rt1Id, jni_rt1);
+ (*env)->SetFloatField(env, rt2, jni_rt2Id, jni_rt2);
+ (*env)->SetFloatField(env, cs1, jni_cs1Id, jni_cs1);
+ (*env)->SetFloatField(env, sn1, jni_sn1Id, jni_sn1);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaexc (JNIEnv * env, jobject calling_obj, jboolean wantq, jint n, jfloatArray t, jint ldt, jfloatArray q, jint ldq, jint j1, jint n1, jint n2, jfloatArray work, jobject info){
+ logical jni_wantq = (logical)wantq;
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaexc_(&jni_wantq, &n, jni_t, &ldt, jni_q, &ldq, &j1, &n1, &n2, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slag2 (JNIEnv * env, jobject calling_obj, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat safmin, jobject scale1, jobject scale2, jobject wr1, jobject wr2, jobject wi){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_scale1Class = (*env)->GetObjectClass(env, scale1);
+ jfieldID jni_scale1Id = (*env)->GetFieldID(env, jni_scale1Class, "val", "D");
+ jfloat jni_scale1 = (*env)->GetFloatField(env, scale1, jni_scale1Id);
+ jclass jni_scale2Class = (*env)->GetObjectClass(env, scale2);
+ jfieldID jni_scale2Id = (*env)->GetFieldID(env, jni_scale2Class, "val", "D");
+ jfloat jni_scale2 = (*env)->GetFloatField(env, scale2, jni_scale2Id);
+ jclass jni_wr1Class = (*env)->GetObjectClass(env, wr1);
+ jfieldID jni_wr1Id = (*env)->GetFieldID(env, jni_wr1Class, "val", "D");
+ jfloat jni_wr1 = (*env)->GetFloatField(env, wr1, jni_wr1Id);
+ jclass jni_wr2Class = (*env)->GetObjectClass(env, wr2);
+ jfieldID jni_wr2Id = (*env)->GetFieldID(env, jni_wr2Class, "val", "D");
+ jfloat jni_wr2 = (*env)->GetFloatField(env, wr2, jni_wr2Id);
+ jclass jni_wiClass = (*env)->GetObjectClass(env, wi);
+ jfieldID jni_wiId = (*env)->GetFieldID(env, jni_wiClass, "val", "D");
+ jfloat jni_wi = (*env)->GetFloatField(env, wi, jni_wiId);
+
+ slag2_(jni_a, &lda, jni_b, &ldb, &safmin, &jni_scale1, &jni_scale2, &jni_wr1, &jni_wr2, &jni_wi);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetFloatField(env, scale1, jni_scale1Id, jni_scale1);
+ (*env)->SetFloatField(env, scale2, jni_scale2Id, jni_scale2);
+ (*env)->SetFloatField(env, wr1, jni_wr1Id, jni_wr1);
+ (*env)->SetFloatField(env, wr2, jni_wr2Id, jni_wr2);
+ (*env)->SetFloatField(env, wi, jni_wiId, jni_wi);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slags2 (JNIEnv * env, jobject calling_obj, jboolean upper, jfloat a1, jfloat a2, jfloat a3, jfloat b1, jfloat b2, jfloat b3, jobject csu, jobject snu, jobject csv, jobject snv, jobject csq, jobject snq){
+ logical jni_upper = (logical)upper;
+ jclass jni_csuClass = (*env)->GetObjectClass(env, csu);
+ jfieldID jni_csuId = (*env)->GetFieldID(env, jni_csuClass, "val", "D");
+ jfloat jni_csu = (*env)->GetFloatField(env, csu, jni_csuId);
+ jclass jni_snuClass = (*env)->GetObjectClass(env, snu);
+ jfieldID jni_snuId = (*env)->GetFieldID(env, jni_snuClass, "val", "D");
+ jfloat jni_snu = (*env)->GetFloatField(env, snu, jni_snuId);
+ jclass jni_csvClass = (*env)->GetObjectClass(env, csv);
+ jfieldID jni_csvId = (*env)->GetFieldID(env, jni_csvClass, "val", "D");
+ jfloat jni_csv = (*env)->GetFloatField(env, csv, jni_csvId);
+ jclass jni_snvClass = (*env)->GetObjectClass(env, snv);
+ jfieldID jni_snvId = (*env)->GetFieldID(env, jni_snvClass, "val", "D");
+ jfloat jni_snv = (*env)->GetFloatField(env, snv, jni_snvId);
+ jclass jni_csqClass = (*env)->GetObjectClass(env, csq);
+ jfieldID jni_csqId = (*env)->GetFieldID(env, jni_csqClass, "val", "D");
+ jfloat jni_csq = (*env)->GetFloatField(env, csq, jni_csqId);
+ jclass jni_snqClass = (*env)->GetObjectClass(env, snq);
+ jfieldID jni_snqId = (*env)->GetFieldID(env, jni_snqClass, "val", "D");
+ jfloat jni_snq = (*env)->GetFloatField(env, snq, jni_snqId);
+
+ slags2_(&jni_upper, &a1, &a2, &a3, &b1, &b2, &b3, &jni_csu, &jni_snu, &jni_csv, &jni_snv, &jni_csq, &jni_snq);
+
+ (*env)->SetFloatField(env, csu, jni_csuId, jni_csu);
+ (*env)->SetFloatField(env, snu, jni_snuId, jni_snu);
+ (*env)->SetFloatField(env, csv, jni_csvId, jni_csv);
+ (*env)->SetFloatField(env, snv, jni_snvId, jni_snv);
+ (*env)->SetFloatField(env, csq, jni_csqId, jni_csq);
+ (*env)->SetFloatField(env, snq, jni_snqId, jni_snq);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slagtf (JNIEnv * env, jobject calling_obj, jint n, jfloatArray a, jfloat lambda, jfloatArray b, jfloatArray c, jfloat tol, jfloatArray d, jintArray in, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jint * jni_in = (*env)->GetPrimitiveArrayCritical(env, in, JNI_FALSE);
+ check_memory(env, jni_in);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slagtf_(&n, jni_a, &lambda, jni_b, jni_c, &tol, jni_d, jni_in, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, in, jni_in, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slagtm (JNIEnv * env, jobject calling_obj, jstring trans, jint n, jint nrhs, jfloat alpha, jfloatArray dl, jfloatArray d, jfloatArray du, jfloatArray x, jint ldx, jfloat beta, jfloatArray b, jint ldb){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_dl = (*env)->GetPrimitiveArrayCritical(env, dl, JNI_FALSE);
+ check_memory(env, jni_dl);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_du = (*env)->GetPrimitiveArrayCritical(env, du, JNI_FALSE);
+ check_memory(env, jni_du);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ slagtm_(jni_trans, &n, &nrhs, &alpha, jni_dl, jni_d, jni_du, jni_x, &ldx, &beta, jni_b, &ldb);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, dl, jni_dl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, du, jni_du, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slagts (JNIEnv * env, jobject calling_obj, jint job, jint n, jfloatArray a, jfloatArray b, jfloatArray c, jfloatArray d, jintArray in, jfloatArray y, jobject tol, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jint * jni_in = (*env)->GetPrimitiveArrayCritical(env, in, JNI_FALSE);
+ check_memory(env, jni_in);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jclass jni_tolClass = (*env)->GetObjectClass(env, tol);
+ jfieldID jni_tolId = (*env)->GetFieldID(env, jni_tolClass, "val", "D");
+ jfloat jni_tol = (*env)->GetFloatField(env, tol, jni_tolId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slagts_(&job, &n, jni_a, jni_b, jni_c, jni_d, jni_in, jni_y, &jni_tol, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, in, jni_in, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->SetFloatField(env, tol, jni_tolId, jni_tol);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slagv2 (JNIEnv * env, jobject calling_obj, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jobject csl, jobject snl, jobject csr, jobject snr){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jclass jni_cslClass = (*env)->GetObjectClass(env, csl);
+ jfieldID jni_cslId = (*env)->GetFieldID(env, jni_cslClass, "val", "D");
+ jfloat jni_csl = (*env)->GetFloatField(env, csl, jni_cslId);
+ jclass jni_snlClass = (*env)->GetObjectClass(env, snl);
+ jfieldID jni_snlId = (*env)->GetFieldID(env, jni_snlClass, "val", "D");
+ jfloat jni_snl = (*env)->GetFloatField(env, snl, jni_snlId);
+ jclass jni_csrClass = (*env)->GetObjectClass(env, csr);
+ jfieldID jni_csrId = (*env)->GetFieldID(env, jni_csrClass, "val", "D");
+ jfloat jni_csr = (*env)->GetFloatField(env, csr, jni_csrId);
+ jclass jni_snrClass = (*env)->GetObjectClass(env, snr);
+ jfieldID jni_snrId = (*env)->GetFieldID(env, jni_snrClass, "val", "D");
+ jfloat jni_snr = (*env)->GetFloatField(env, snr, jni_snrId);
+
+ slagv2_(jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, &jni_csl, &jni_snl, &jni_csr, &jni_snr);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->SetFloatField(env, csl, jni_cslId, jni_csl);
+ (*env)->SetFloatField(env, snl, jni_snlId, jni_snl);
+ (*env)->SetFloatField(env, csr, jni_csrId, jni_csr);
+ (*env)->SetFloatField(env, snr, jni_snrId, jni_snr);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slahqr (JNIEnv * env, jobject calling_obj, jboolean wantt, jboolean wantz, jint n, jint ilo, jint ihi, jfloatArray h, jint ldh, jfloatArray wr, jfloatArray wi, jint iloz, jint ihiz, jfloatArray z, jint ldz, jobject info){
+ logical jni_wantt = (logical)wantt;
+ logical jni_wantz = (logical)wantz;
+ jfloat * jni_h = (*env)->GetPrimitiveArrayCritical(env, h, JNI_FALSE);
+ check_memory(env, jni_h);
+ jfloat * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jfloat * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slahqr_(&jni_wantt, &jni_wantz, &n, &ilo, &ihi, jni_h, &ldh, jni_wr, jni_wi, &iloz, &ihiz, jni_z, &ldz, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, h, jni_h, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slahrd (JNIEnv * env, jobject calling_obj, jint n, jint k, jint nb, jfloatArray a, jint lda, jfloatArray tau, jfloatArray t, jint ldt, jfloatArray y, jint ldy){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+
+ slahrd_(&n, &k, &nb, jni_a, &lda, jni_tau, jni_t, &ldt, jni_y, &ldy);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaic1 (JNIEnv * env, jobject calling_obj, jint job, jint j, jfloatArray x, jfloat sest, jfloatArray w, jfloat gamma, jobject sestpr, jobject s, jobject c){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jclass jni_sestprClass = (*env)->GetObjectClass(env, sestpr);
+ jfieldID jni_sestprId = (*env)->GetFieldID(env, jni_sestprClass, "val", "D");
+ jfloat jni_sestpr = (*env)->GetFloatField(env, sestpr, jni_sestprId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jfloat jni_s = (*env)->GetFloatField(env, s, jni_sId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jfloat jni_c = (*env)->GetFloatField(env, c, jni_cId);
+
+ slaic1_(&job, &j, jni_x, &sest, jni_w, &gamma, &jni_sestpr, &jni_s, &jni_c);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->SetFloatField(env, sestpr, jni_sestprId, jni_sestpr);
+ (*env)->SetFloatField(env, s, jni_sId, jni_s);
+ (*env)->SetFloatField(env, c, jni_cId, jni_c);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaln2 (JNIEnv * env, jobject calling_obj, jboolean ltrans, jint na, jint nw, jfloat smin, jfloat ca, jfloatArray a, jint lda, jfloat d1, jfloat d2, jfloatArray b, jint ldb, jfloat wr, jfloat wi, jfloatArray x, jint ldx, jobject scale, jobject xnorm, jobject info){
+ logical jni_ltrans = (logical)ltrans;
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jclass jni_xnormClass = (*env)->GetObjectClass(env, xnorm);
+ jfieldID jni_xnormId = (*env)->GetFieldID(env, jni_xnormClass, "val", "D");
+ jfloat jni_xnorm = (*env)->GetFloatField(env, xnorm, jni_xnormId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaln2_(&jni_ltrans, &na, &nw, &smin, &ca, jni_a, &lda, &d1, &d2, jni_b, &ldb, &wr, &wi, jni_x, &ldx, &jni_scale, &jni_xnorm, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetFloatField(env, xnorm, jni_xnormId, jni_xnorm);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slals0 (JNIEnv * env, jobject calling_obj, jint icompq, jint nl, jint nr, jint sqre, jint nrhs, jfloatArray b, jint ldb, jfloatArray bx, jint ldbx, jintArray perm, jint givptr, jintArray givcol, jint ldgcol, jfloatArray givnum, jint ldgnum, jfloatArray poles, jfloatArray difl, jfloatArray difr, jfloatArray z, jint k, jfloat c, jfloat s, jfloatArray work, jobject info){
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_bx = (*env)->GetPrimitiveArrayCritical(env, bx, JNI_FALSE);
+ check_memory(env, jni_bx);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jfloat * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jfloat * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jfloat * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slals0_(&icompq, &nl, &nr, &sqre, &nrhs, jni_b, &ldb, jni_bx, &ldbx, jni_perm, &givptr, jni_givcol, &ldgcol, jni_givnum, &ldgnum, jni_poles, jni_difl, jni_difr, jni_z, &k, &c, &s, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bx, jni_bx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slalsa (JNIEnv * env, jobject calling_obj, jint icompq, jint smlsiz, jint n, jint nrhs, jfloatArray b, jint ldb, jfloatArray bx, jint ldbx, jfloatArray u, jint ldu, jfloatArray vt, jintArray k, jfloatArray difl, jfloatArray difr, jfloatArray z, jfloatArray poles, jintArray givptr, jintArray givcol, jint ldgcol, jintArray perm, jfloatArray givnum, jfloatArray c, jfloatArray s, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_bx = (*env)->GetPrimitiveArrayCritical(env, bx, JNI_FALSE);
+ check_memory(env, jni_bx);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_k = (*env)->GetPrimitiveArrayCritical(env, k, JNI_FALSE);
+ check_memory(env, jni_k);
+ jfloat * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jfloat * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slalsa_(&icompq, &smlsiz, &n, &nrhs, jni_b, &ldb, jni_bx, &ldbx, jni_u, &ldu, jni_vt, jni_k, jni_difl, jni_difr, jni_z, jni_poles, jni_givptr, jni_givcol, &ldgcol, jni_perm, jni_givnum, jni_c, jni_s, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bx, jni_bx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, k, jni_k, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slalsd (JNIEnv * env, jobject calling_obj, jstring uplo, jint smlsiz, jint n, jint nrhs, jfloatArray d, jfloatArray e, jfloatArray b, jint ldb, jfloat rcond, jobject rank, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_rankClass = (*env)->GetObjectClass(env, rank);
+ jfieldID jni_rankId = (*env)->GetFieldID(env, jni_rankClass, "val", "I");
+ jint jni_rank = (*env)->GetIntField(env, rank, jni_rankId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slalsd_(jni_uplo, &smlsiz, &n, &nrhs, jni_d, jni_e, jni_b, &ldb, &rcond, &jni_rank, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, rank, jni_rankId, jni_rank);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slamrg (JNIEnv * env, jobject calling_obj, jint n1, jint n2, jfloatArray a, jint strd1, jint strd2, jintArray index){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_index = (*env)->GetPrimitiveArrayCritical(env, index, JNI_FALSE);
+ check_memory(env, jni_index);
+
+ slamrg_(&n1, &n2, jni_a, &strd1, &strd2, jni_index);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, index, jni_index, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slanv2 (JNIEnv * env, jobject calling_obj, jobject a, jobject b, jobject c, jobject d, jobject rt1r, jobject rt1i, jobject rt2r, jobject rt2i, jobject cs, jobject sn){
+ jclass jni_aClass = (*env)->GetObjectClass(env, a);
+ jfieldID jni_aId = (*env)->GetFieldID(env, jni_aClass, "val", "D");
+ jfloat jni_a = (*env)->GetFloatField(env, a, jni_aId);
+ jclass jni_bClass = (*env)->GetObjectClass(env, b);
+ jfieldID jni_bId = (*env)->GetFieldID(env, jni_bClass, "val", "D");
+ jfloat jni_b = (*env)->GetFloatField(env, b, jni_bId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jfloat jni_c = (*env)->GetFloatField(env, c, jni_cId);
+ jclass jni_dClass = (*env)->GetObjectClass(env, d);
+ jfieldID jni_dId = (*env)->GetFieldID(env, jni_dClass, "val", "D");
+ jfloat jni_d = (*env)->GetFloatField(env, d, jni_dId);
+ jclass jni_rt1rClass = (*env)->GetObjectClass(env, rt1r);
+ jfieldID jni_rt1rId = (*env)->GetFieldID(env, jni_rt1rClass, "val", "D");
+ jfloat jni_rt1r = (*env)->GetFloatField(env, rt1r, jni_rt1rId);
+ jclass jni_rt1iClass = (*env)->GetObjectClass(env, rt1i);
+ jfieldID jni_rt1iId = (*env)->GetFieldID(env, jni_rt1iClass, "val", "D");
+ jfloat jni_rt1i = (*env)->GetFloatField(env, rt1i, jni_rt1iId);
+ jclass jni_rt2rClass = (*env)->GetObjectClass(env, rt2r);
+ jfieldID jni_rt2rId = (*env)->GetFieldID(env, jni_rt2rClass, "val", "D");
+ jfloat jni_rt2r = (*env)->GetFloatField(env, rt2r, jni_rt2rId);
+ jclass jni_rt2iClass = (*env)->GetObjectClass(env, rt2i);
+ jfieldID jni_rt2iId = (*env)->GetFieldID(env, jni_rt2iClass, "val", "D");
+ jfloat jni_rt2i = (*env)->GetFloatField(env, rt2i, jni_rt2iId);
+ jclass jni_csClass = (*env)->GetObjectClass(env, cs);
+ jfieldID jni_csId = (*env)->GetFieldID(env, jni_csClass, "val", "D");
+ jfloat jni_cs = (*env)->GetFloatField(env, cs, jni_csId);
+ jclass jni_snClass = (*env)->GetObjectClass(env, sn);
+ jfieldID jni_snId = (*env)->GetFieldID(env, jni_snClass, "val", "D");
+ jfloat jni_sn = (*env)->GetFloatField(env, sn, jni_snId);
+
+ slanv2_(&jni_a, &jni_b, &jni_c, &jni_d, &jni_rt1r, &jni_rt1i, &jni_rt2r, &jni_rt2i, &jni_cs, &jni_sn);
+
+ (*env)->SetFloatField(env, a, jni_aId, jni_a);
+ (*env)->SetFloatField(env, b, jni_bId, jni_b);
+ (*env)->SetFloatField(env, c, jni_cId, jni_c);
+ (*env)->SetFloatField(env, d, jni_dId, jni_d);
+ (*env)->SetFloatField(env, rt1r, jni_rt1rId, jni_rt1r);
+ (*env)->SetFloatField(env, rt1i, jni_rt1iId, jni_rt1i);
+ (*env)->SetFloatField(env, rt2r, jni_rt2rId, jni_rt2r);
+ (*env)->SetFloatField(env, rt2i, jni_rt2iId, jni_rt2i);
+ (*env)->SetFloatField(env, cs, jni_csId, jni_cs);
+ (*env)->SetFloatField(env, sn, jni_snId, jni_sn);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slapll (JNIEnv * env, jobject calling_obj, jint n, jfloatArray x, jint incx, jfloatArray y, jint incy, jobject ssmin){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jclass jni_ssminClass = (*env)->GetObjectClass(env, ssmin);
+ jfieldID jni_ssminId = (*env)->GetFieldID(env, jni_ssminClass, "val", "D");
+ jfloat jni_ssmin = (*env)->GetFloatField(env, ssmin, jni_ssminId);
+
+ slapll_(&n, jni_x, &incx, jni_y, &incy, &jni_ssmin);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->SetFloatField(env, ssmin, jni_ssminId, jni_ssmin);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slapmt (JNIEnv * env, jobject calling_obj, jboolean forwrd, jint m, jint n, jfloatArray x, jint ldx, jintArray k){
+ logical jni_forwrd = (logical)forwrd;
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jint * jni_k = (*env)->GetPrimitiveArrayCritical(env, k, JNI_FALSE);
+ check_memory(env, jni_k);
+
+ slapmt_(&jni_forwrd, &m, &n, jni_x, &ldx, jni_k);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, k, jni_k, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqgb (JNIEnv * env, jobject calling_obj, jint m, jint n, jint kl, jint ku, jfloatArray ab, jint ldab, jfloatArray r, jfloatArray c, jfloat rowcnd, jfloat colcnd, jfloat amax, jobject equed){
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ slaqgb_(&m, &n, &kl, &ku, jni_ab, &ldab, jni_r, jni_c, &rowcnd, &colcnd, &amax, jni_equed);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqge (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray r, jfloatArray c, jfloat rowcnd, jfloat colcnd, jfloat amax, jobject equed){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_r = (*env)->GetPrimitiveArrayCritical(env, r, JNI_FALSE);
+ check_memory(env, jni_r);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ slaqge_(&m, &n, jni_a, &lda, jni_r, jni_c, &rowcnd, &colcnd, &amax, jni_equed);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, r, jni_r, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqp2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint offset, jfloatArray a, jint lda, jintArray jpvt, jfloatArray tau, jfloatArray vn1, jfloatArray vn2, jfloatArray work){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_vn1 = (*env)->GetPrimitiveArrayCritical(env, vn1, JNI_FALSE);
+ check_memory(env, jni_vn1);
+ jfloat * jni_vn2 = (*env)->GetPrimitiveArrayCritical(env, vn2, JNI_FALSE);
+ check_memory(env, jni_vn2);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slaqp2_(&m, &n, &offset, jni_a, &lda, jni_jpvt, jni_tau, jni_vn1, jni_vn2, jni_work);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn1, jni_vn1, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn2, jni_vn2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqps (JNIEnv * env, jobject calling_obj, jint m, jint n, jint offset, jint nb, jobject kb, jfloatArray a, jint lda, jintArray jpvt, jfloatArray tau, jfloatArray vn1, jfloatArray vn2, jfloatArray auxv, jfloatArray f, jint ldf){
+ jclass jni_kbClass = (*env)->GetObjectClass(env, kb);
+ jfieldID jni_kbId = (*env)->GetFieldID(env, jni_kbClass, "val", "I");
+ jint jni_kb = (*env)->GetIntField(env, kb, jni_kbId);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_jpvt = (*env)->GetPrimitiveArrayCritical(env, jpvt, JNI_FALSE);
+ check_memory(env, jni_jpvt);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_vn1 = (*env)->GetPrimitiveArrayCritical(env, vn1, JNI_FALSE);
+ check_memory(env, jni_vn1);
+ jfloat * jni_vn2 = (*env)->GetPrimitiveArrayCritical(env, vn2, JNI_FALSE);
+ check_memory(env, jni_vn2);
+ jfloat * jni_auxv = (*env)->GetPrimitiveArrayCritical(env, auxv, JNI_FALSE);
+ check_memory(env, jni_auxv);
+ jfloat * jni_f = (*env)->GetPrimitiveArrayCritical(env, f, JNI_FALSE);
+ check_memory(env, jni_f);
+
+ slaqps_(&m, &n, &offset, &nb, &jni_kb, jni_a, &lda, jni_jpvt, jni_tau, jni_vn1, jni_vn2, jni_auxv, jni_f, &ldf);
+
+ (*env)->SetIntField(env, kb, jni_kbId, jni_kb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpvt, jni_jpvt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn1, jni_vn1, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vn2, jni_vn2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, auxv, jni_auxv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, f, jni_f, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqsb (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray s, jfloat scond, jfloat amax, jobject equed){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ slaqsb_(jni_uplo, &n, &kd, jni_ab, &ldab, jni_s, &scond, &amax, jni_equed);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqsp (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jfloatArray s, jfloat scond, jfloat amax, jobject equed){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ slaqsp_(jni_uplo, &n, jni_ap, jni_s, &scond, &amax, jni_equed);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqsy (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray s, jfloat scond, jfloat amax, jobject equed){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+
+ slaqsy_(jni_uplo, &n, jni_a, &lda, jni_s, &scond, &amax, jni_equed);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaqtr (JNIEnv * env, jobject calling_obj, jboolean ltran, jboolean lreal, jint n, jfloatArray t, jint ldt, jfloatArray b, jfloat w, jobject scale, jfloatArray x, jfloatArray work, jobject info){
+ logical jni_ltran = (logical)ltran;
+ logical jni_lreal = (logical)lreal;
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slaqtr_(&jni_ltran, &jni_lreal, &n, jni_t, &ldt, jni_b, &w, &jni_scale, jni_x, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slar2v (JNIEnv * env, jobject calling_obj, jint n, jfloatArray x, jfloatArray y, jfloatArray z, jint incx, jfloatArray c, jfloatArray s, jint incc){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+
+ slar2v_(&n, jni_x, jni_y, jni_z, &incx, jni_c, jni_s, &incc);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarf (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jfloatArray v, jint incv, jfloat tau, jfloatArray c, jint Ldc, jfloatArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slarf_(jni_side, &m, &n, jni_v, &incv, &tau, jni_c, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarfb (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jstring direct, jstring storev, jint m, jint n, jint k, jfloatArray v, jint ldv, jfloatArray t, jint ldt, jfloatArray c, jint Ldc, jfloatArray work, jint ldwork){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slarfb_(jni_side, jni_trans, jni_direct, jni_storev, &m, &n, &k, jni_v, &ldv, jni_t, &ldt, jni_c, &Ldc, jni_work, &ldwork);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarfg (JNIEnv * env, jobject calling_obj, jint n, jobject alpha, jfloatArray x, jint incx, jobject tau){
+ jclass jni_alphaClass = (*env)->GetObjectClass(env, alpha);
+ jfieldID jni_alphaId = (*env)->GetFieldID(env, jni_alphaClass, "val", "D");
+ jfloat jni_alpha = (*env)->GetFloatField(env, alpha, jni_alphaId);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_tauClass = (*env)->GetObjectClass(env, tau);
+ jfieldID jni_tauId = (*env)->GetFieldID(env, jni_tauClass, "val", "D");
+ jfloat jni_tau = (*env)->GetFloatField(env, tau, jni_tauId);
+
+ slarfg_(&n, &jni_alpha, jni_x, &incx, &jni_tau);
+
+ (*env)->SetFloatField(env, alpha, jni_alphaId, jni_alpha);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, tau, jni_tauId, jni_tau);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarft (JNIEnv * env, jobject calling_obj, jstring direct, jstring storev, jint n, jint k, jfloatArray v, jint ldv, jfloatArray tau, jfloatArray t, jint ldt){
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+
+ slarft_(jni_direct, jni_storev, &n, &k, jni_v, &ldv, jni_tau, jni_t, &ldt);
+
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarfx (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jfloatArray v, jfloat tau, jfloatArray c, jint Ldc, jfloatArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slarfx_(jni_side, &m, &n, jni_v, &tau, jni_c, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slargv (JNIEnv * env, jobject calling_obj, jint n, jfloatArray x, jint incx, jfloatArray y, jint incy, jfloatArray c, jint incc){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+
+ slargv_(&n, jni_x, &incx, jni_y, &incy, jni_c, &incc);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarnv (JNIEnv * env, jobject calling_obj, jint idist, jintArray iseed, jint n, jfloatArray x){
+ jint * jni_iseed = (*env)->GetPrimitiveArrayCritical(env, iseed, JNI_FALSE);
+ check_memory(env, jni_iseed);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ slarnv_(&idist, jni_iseed, &n, jni_x);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, iseed, jni_iseed, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slartg (JNIEnv * env, jobject calling_obj, jfloat f, jfloat g, jobject cs, jobject sn, jobject r){
+ jclass jni_csClass = (*env)->GetObjectClass(env, cs);
+ jfieldID jni_csId = (*env)->GetFieldID(env, jni_csClass, "val", "D");
+ jfloat jni_cs = (*env)->GetFloatField(env, cs, jni_csId);
+ jclass jni_snClass = (*env)->GetObjectClass(env, sn);
+ jfieldID jni_snId = (*env)->GetFieldID(env, jni_snClass, "val", "D");
+ jfloat jni_sn = (*env)->GetFloatField(env, sn, jni_snId);
+ jclass jni_rClass = (*env)->GetObjectClass(env, r);
+ jfieldID jni_rId = (*env)->GetFieldID(env, jni_rClass, "val", "D");
+ jfloat jni_r = (*env)->GetFloatField(env, r, jni_rId);
+
+ slartg_(&f, &g, &jni_cs, &jni_sn, &jni_r);
+
+ (*env)->SetFloatField(env, cs, jni_csId, jni_cs);
+ (*env)->SetFloatField(env, sn, jni_snId, jni_sn);
+ (*env)->SetFloatField(env, r, jni_rId, jni_r);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slartv (JNIEnv * env, jobject calling_obj, jint n, jfloatArray x, jint incx, jfloatArray y, jint incy, jfloatArray c, jfloatArray s, jint incc){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
+ check_memory(env, jni_y);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+
+ slartv_(&n, jni_x, &incx, jni_y, &incy, jni_c, jni_s, &incc);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaruv (JNIEnv * env, jobject calling_obj, jintArray iseed, jint n, jfloatArray x){
+ jint * jni_iseed = (*env)->GetPrimitiveArrayCritical(env, iseed, JNI_FALSE);
+ check_memory(env, jni_iseed);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+
+ slaruv_(jni_iseed, &n, jni_x);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, iseed, jni_iseed, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarz (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jint l, jfloatArray v, jint incv, jfloat tau, jfloatArray c, jint Ldc, jfloatArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slarz_(jni_side, &m, &n, &l, jni_v, &incv, &tau, jni_c, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarzb (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jstring direct, jstring storev, jint m, jint n, jint k, jint l, jfloatArray v, jint ldv, jfloatArray t, jint ldt, jfloatArray c, jint Ldc, jfloatArray work, jint ldwork){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slarzb_(jni_side, jni_trans, jni_direct, jni_storev, &m, &n, &k, &l, jni_v, &ldv, jni_t, &ldt, jni_c, &Ldc, jni_work, &ldwork);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slarzt (JNIEnv * env, jobject calling_obj, jstring direct, jstring storev, jint n, jint k, jfloatArray v, jint ldv, jfloatArray tau, jfloatArray t, jint ldt){
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ char * jni_storev = (char *)(*env)->GetStringUTFChars(env, storev, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+
+ slarzt_(jni_direct, jni_storev, &n, &k, jni_v, &ldv, jni_tau, jni_t, &ldt);
+
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleaseStringUTFChars(env, storev, jni_storev);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slas2 (JNIEnv * env, jobject calling_obj, jfloat f, jfloat g, jfloat h, jobject ssmin, jobject ssmax){
+ jclass jni_ssminClass = (*env)->GetObjectClass(env, ssmin);
+ jfieldID jni_ssminId = (*env)->GetFieldID(env, jni_ssminClass, "val", "D");
+ jfloat jni_ssmin = (*env)->GetFloatField(env, ssmin, jni_ssminId);
+ jclass jni_ssmaxClass = (*env)->GetObjectClass(env, ssmax);
+ jfieldID jni_ssmaxId = (*env)->GetFieldID(env, jni_ssmaxClass, "val", "D");
+ jfloat jni_ssmax = (*env)->GetFloatField(env, ssmax, jni_ssmaxId);
+
+ slas2_(&f, &g, &h, &jni_ssmin, &jni_ssmax);
+
+ (*env)->SetFloatField(env, ssmin, jni_ssminId, jni_ssmin);
+ (*env)->SetFloatField(env, ssmax, jni_ssmaxId, jni_ssmax);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slascl (JNIEnv * env, jobject calling_obj, jstring type, jint kl, jint ku, jfloat cfrom, jfloat cto, jint m, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_type = (char *)(*env)->GetStringUTFChars(env, type, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slascl_(jni_type, &kl, &ku, &cfrom, &cto, &m, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, type, jni_type);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd0 (JNIEnv * env, jobject calling_obj, jint n, jint sqre, jfloatArray d, jfloatArray e, jfloatArray u, jint ldu, jfloatArray vt, jint ldvt, jint smlsiz, jintArray iwork, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd0_(&n, &sqre, jni_d, jni_e, jni_u, &ldu, jni_vt, &ldvt, &smlsiz, jni_iwork, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd1 (JNIEnv * env, jobject calling_obj, jint nl, jint nr, jint sqre, jfloatArray d, jobject alpha, jobject beta, jfloatArray u, jint ldu, jfloatArray vt, jint ldvt, jintArray idxq, jintArray iwork, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jclass jni_alphaClass = (*env)->GetObjectClass(env, alpha);
+ jfieldID jni_alphaId = (*env)->GetFieldID(env, jni_alphaClass, "val", "D");
+ jfloat jni_alpha = (*env)->GetFloatField(env, alpha, jni_alphaId);
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "D");
+ jfloat jni_beta = (*env)->GetFloatField(env, beta, jni_betaId);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd1_(&nl, &nr, &sqre, jni_d, &jni_alpha, &jni_beta, jni_u, &ldu, jni_vt, &ldvt, jni_idxq, jni_iwork, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->SetFloatField(env, alpha, jni_alphaId, jni_alpha);
+ (*env)->SetFloatField(env, beta, jni_betaId, jni_beta);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd2 (JNIEnv * env, jobject calling_obj, jint nl, jint nr, jint sqre, jobject k, jfloatArray d, jfloatArray z, jfloat alpha, jfloat beta, jfloatArray u, jint ldu, jfloatArray vt, jint ldvt, jfloatArray dsigma, jfloatArray u2, jint ldu2, jfloatArray vt2, jint ldvt2, jintArray idxp, jintArray idx, jintArray idxc, jintArray idxq, jintArray coltyp, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jfloat * jni_u2 = (*env)->GetPrimitiveArrayCritical(env, u2, JNI_FALSE);
+ check_memory(env, jni_u2);
+ jfloat * jni_vt2 = (*env)->GetPrimitiveArrayCritical(env, vt2, JNI_FALSE);
+ check_memory(env, jni_vt2);
+ jint * jni_idxp = (*env)->GetPrimitiveArrayCritical(env, idxp, JNI_FALSE);
+ check_memory(env, jni_idxp);
+ jint * jni_idx = (*env)->GetPrimitiveArrayCritical(env, idx, JNI_FALSE);
+ check_memory(env, jni_idx);
+ jint * jni_idxc = (*env)->GetPrimitiveArrayCritical(env, idxc, JNI_FALSE);
+ check_memory(env, jni_idxc);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_coltyp = (*env)->GetPrimitiveArrayCritical(env, coltyp, JNI_FALSE);
+ check_memory(env, jni_coltyp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd2_(&nl, &nr, &sqre, &jni_k, jni_d, jni_z, &alpha, &beta, jni_u, &ldu, jni_vt, &ldvt, jni_dsigma, jni_u2, &ldu2, jni_vt2, &ldvt2, jni_idxp, jni_idx, jni_idxc, jni_idxq, jni_coltyp, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u2, jni_u2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt2, jni_vt2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxp, jni_idxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idx, jni_idx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxc, jni_idxc, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, coltyp, jni_coltyp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd3 (JNIEnv * env, jobject calling_obj, jint nl, jint nr, jint sqre, jint k, jfloatArray d, jfloatArray q, jint ldq, jfloatArray dsigma, jfloatArray u, jint ldu, jfloatArray u2, jint ldu2, jfloatArray vt, jint ldvt, jfloatArray vt2, jint ldvt2, jintArray idxc, jintArray ctot, jfloatArray z, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_u2 = (*env)->GetPrimitiveArrayCritical(env, u2, JNI_FALSE);
+ check_memory(env, jni_u2);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_vt2 = (*env)->GetPrimitiveArrayCritical(env, vt2, JNI_FALSE);
+ check_memory(env, jni_vt2);
+ jint * jni_idxc = (*env)->GetPrimitiveArrayCritical(env, idxc, JNI_FALSE);
+ check_memory(env, jni_idxc);
+ jint * jni_ctot = (*env)->GetPrimitiveArrayCritical(env, ctot, JNI_FALSE);
+ check_memory(env, jni_ctot);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd3_(&nl, &nr, &sqre, &k, jni_d, jni_q, &ldq, jni_dsigma, jni_u, &ldu, jni_u2, &ldu2, jni_vt, &ldvt, jni_vt2, &ldvt2, jni_idxc, jni_ctot, jni_z, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u2, jni_u2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt2, jni_vt2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxc, jni_idxc, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ctot, jni_ctot, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd4 (JNIEnv * env, jobject calling_obj, jint n, jint i, jfloatArray d, jfloatArray z, jfloatArray delta, jfloat rho, jobject sigma, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_sigmaClass = (*env)->GetObjectClass(env, sigma);
+ jfieldID jni_sigmaId = (*env)->GetFieldID(env, jni_sigmaClass, "val", "D");
+ jfloat jni_sigma = (*env)->GetFloatField(env, sigma, jni_sigmaId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd4_(&n, &i, jni_d, jni_z, jni_delta, &rho, &jni_sigma, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetFloatField(env, sigma, jni_sigmaId, jni_sigma);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd5 (JNIEnv * env, jobject calling_obj, jint i, jfloatArray d, jfloatArray z, jfloatArray delta, jfloat rho, jobject dsigma, jfloatArray work){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_delta = (*env)->GetPrimitiveArrayCritical(env, delta, JNI_FALSE);
+ check_memory(env, jni_delta);
+ jclass jni_dsigmaClass = (*env)->GetObjectClass(env, dsigma);
+ jfieldID jni_dsigmaId = (*env)->GetFieldID(env, jni_dsigmaClass, "val", "D");
+ jfloat jni_dsigma = (*env)->GetFloatField(env, dsigma, jni_dsigmaId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slasd5_(&i, jni_d, jni_z, jni_delta, &rho, &jni_dsigma, jni_work);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, delta, jni_delta, 0);
+ (*env)->SetFloatField(env, dsigma, jni_dsigmaId, jni_dsigma);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd6 (JNIEnv * env, jobject calling_obj, jint icompq, jint nl, jint nr, jint sqre, jfloatArray d, jfloatArray vf, jfloatArray vl, jobject alpha, jobject beta, jintArray idxq, jintArray perm, jobject givptr, jintArray givcol, jint ldgcol, jfloatArray givnum, jint ldgnum, jfloatArray poles, jfloatArray difl, jfloatArray difr, jfloatArray z, jobject k, jobject c, jobject s, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_vf = (*env)->GetPrimitiveArrayCritical(env, vf, JNI_FALSE);
+ check_memory(env, jni_vf);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jclass jni_alphaClass = (*env)->GetObjectClass(env, alpha);
+ jfieldID jni_alphaId = (*env)->GetFieldID(env, jni_alphaClass, "val", "D");
+ jfloat jni_alpha = (*env)->GetFloatField(env, alpha, jni_alphaId);
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "D");
+ jfloat jni_beta = (*env)->GetFloatField(env, beta, jni_betaId);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jclass jni_givptrClass = (*env)->GetObjectClass(env, givptr);
+ jfieldID jni_givptrId = (*env)->GetFieldID(env, jni_givptrClass, "val", "I");
+ jint jni_givptr = (*env)->GetIntField(env, givptr, jni_givptrId);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jfloat * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jfloat * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jfloat * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jfloat jni_c = (*env)->GetFloatField(env, c, jni_cId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jfloat jni_s = (*env)->GetFloatField(env, s, jni_sId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd6_(&icompq, &nl, &nr, &sqre, jni_d, jni_vf, jni_vl, &jni_alpha, &jni_beta, jni_idxq, jni_perm, &jni_givptr, jni_givcol, &ldgcol, jni_givnum, &ldgnum, jni_poles, jni_difl, jni_difr, jni_z, &jni_k, &jni_c, &jni_s, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vf, jni_vf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->SetFloatField(env, alpha, jni_alphaId, jni_alpha);
+ (*env)->SetFloatField(env, beta, jni_betaId, jni_beta);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->SetIntField(env, givptr, jni_givptrId, jni_givptr);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->SetFloatField(env, c, jni_cId, jni_c);
+ (*env)->SetFloatField(env, s, jni_sId, jni_s);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd7 (JNIEnv * env, jobject calling_obj, jint icompq, jint nl, jint nr, jint sqre, jobject k, jfloatArray d, jfloatArray z, jfloatArray zw, jfloatArray vf, jfloatArray vfw, jfloatArray vl, jfloatArray vlw, jfloat alpha, jfloat beta, jfloatArray dsigma, jintArray idx, jintArray idxp, jintArray idxq, jintArray perm, jobject givptr, jintArray givcol, jint ldgcol, jfloatArray givnum, jint ldgnum, jobject c, jobject s, jobject info){
+ jclass jni_kClass = (*env)->GetObjectClass(env, k);
+ jfieldID jni_kId = (*env)->GetFieldID(env, jni_kClass, "val", "I");
+ jint jni_k = (*env)->GetIntField(env, k, jni_kId);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_zw = (*env)->GetPrimitiveArrayCritical(env, zw, JNI_FALSE);
+ check_memory(env, jni_zw);
+ jfloat * jni_vf = (*env)->GetPrimitiveArrayCritical(env, vf, JNI_FALSE);
+ check_memory(env, jni_vf);
+ jfloat * jni_vfw = (*env)->GetPrimitiveArrayCritical(env, vfw, JNI_FALSE);
+ check_memory(env, jni_vfw);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vlw = (*env)->GetPrimitiveArrayCritical(env, vlw, JNI_FALSE);
+ check_memory(env, jni_vlw);
+ jfloat * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jint * jni_idx = (*env)->GetPrimitiveArrayCritical(env, idx, JNI_FALSE);
+ check_memory(env, jni_idx);
+ jint * jni_idxp = (*env)->GetPrimitiveArrayCritical(env, idxp, JNI_FALSE);
+ check_memory(env, jni_idxp);
+ jint * jni_idxq = (*env)->GetPrimitiveArrayCritical(env, idxq, JNI_FALSE);
+ check_memory(env, jni_idxq);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jclass jni_givptrClass = (*env)->GetObjectClass(env, givptr);
+ jfieldID jni_givptrId = (*env)->GetFieldID(env, jni_givptrClass, "val", "I");
+ jint jni_givptr = (*env)->GetIntField(env, givptr, jni_givptrId);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jclass jni_cClass = (*env)->GetObjectClass(env, c);
+ jfieldID jni_cId = (*env)->GetFieldID(env, jni_cClass, "val", "D");
+ jfloat jni_c = (*env)->GetFloatField(env, c, jni_cId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jfloat jni_s = (*env)->GetFloatField(env, s, jni_sId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd7_(&icompq, &nl, &nr, &sqre, &jni_k, jni_d, jni_z, jni_zw, jni_vf, jni_vfw, jni_vl, jni_vlw, &alpha, &beta, jni_dsigma, jni_idx, jni_idxp, jni_idxq, jni_perm, &jni_givptr, jni_givcol, &ldgcol, jni_givnum, &ldgnum, &jni_c, &jni_s, &jni_info);
+
+ (*env)->SetIntField(env, k, jni_kId, jni_k);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, zw, jni_zw, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vf, jni_vf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vfw, jni_vfw, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vlw, jni_vlw, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idx, jni_idx, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxp, jni_idxp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, idxq, jni_idxq, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->SetIntField(env, givptr, jni_givptrId, jni_givptr);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->SetFloatField(env, c, jni_cId, jni_c);
+ (*env)->SetFloatField(env, s, jni_sId, jni_s);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasd8 (JNIEnv * env, jobject calling_obj, jint icompq, jint k, jfloatArray d, jfloatArray z, jfloatArray vf, jfloatArray vl, jfloatArray difl, jfloatArray difr, jint lddifr, jfloatArray dsigma, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_vf = (*env)->GetPrimitiveArrayCritical(env, vf, JNI_FALSE);
+ check_memory(env, jni_vf);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jfloat * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jfloat * jni_dsigma = (*env)->GetPrimitiveArrayCritical(env, dsigma, JNI_FALSE);
+ check_memory(env, jni_dsigma);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasd8_(&icompq, &k, jni_d, jni_z, jni_vf, jni_vl, jni_difl, jni_difr, &lddifr, jni_dsigma, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vf, jni_vf, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dsigma, jni_dsigma, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasda (JNIEnv * env, jobject calling_obj, jint icompq, jint smlsiz, jint n, jint sqre, jfloatArray d, jfloatArray e, jfloatArray u, jint ldu, jfloatArray vt, jintArray k, jfloatArray difl, jfloatArray difr, jfloatArray z, jfloatArray poles, jintArray givptr, jintArray givcol, jint ldgcol, jintArray perm, jfloatArray givnum, jfloatArray c, jfloatArray s, jfloatArray work, jintArray iwork, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jint * jni_k = (*env)->GetPrimitiveArrayCritical(env, k, JNI_FALSE);
+ check_memory(env, jni_k);
+ jfloat * jni_difl = (*env)->GetPrimitiveArrayCritical(env, difl, JNI_FALSE);
+ check_memory(env, jni_difl);
+ jfloat * jni_difr = (*env)->GetPrimitiveArrayCritical(env, difr, JNI_FALSE);
+ check_memory(env, jni_difr);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_poles = (*env)->GetPrimitiveArrayCritical(env, poles, JNI_FALSE);
+ check_memory(env, jni_poles);
+ jint * jni_givptr = (*env)->GetPrimitiveArrayCritical(env, givptr, JNI_FALSE);
+ check_memory(env, jni_givptr);
+ jint * jni_givcol = (*env)->GetPrimitiveArrayCritical(env, givcol, JNI_FALSE);
+ check_memory(env, jni_givcol);
+ jint * jni_perm = (*env)->GetPrimitiveArrayCritical(env, perm, JNI_FALSE);
+ check_memory(env, jni_perm);
+ jfloat * jni_givnum = (*env)->GetPrimitiveArrayCritical(env, givnum, JNI_FALSE);
+ check_memory(env, jni_givnum);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasda_(&icompq, &smlsiz, &n, &sqre, jni_d, jni_e, jni_u, &ldu, jni_vt, jni_k, jni_difl, jni_difr, jni_z, jni_poles, jni_givptr, jni_givcol, &ldgcol, jni_perm, jni_givnum, jni_c, jni_s, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, k, jni_k, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difl, jni_difl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, difr, jni_difr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, poles, jni_poles, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givptr, jni_givptr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givcol, jni_givcol, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, perm, jni_perm, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, givnum, jni_givnum, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasdq (JNIEnv * env, jobject calling_obj, jstring uplo, jint sqre, jint n, jint ncvt, jint nru, jint ncc, jfloatArray d, jfloatArray e, jfloatArray vt, jint ldvt, jfloatArray u, jint ldu, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_vt = (*env)->GetPrimitiveArrayCritical(env, vt, JNI_FALSE);
+ check_memory(env, jni_vt);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasdq_(jni_uplo, &sqre, &n, &ncvt, &nru, &ncc, jni_d, jni_e, jni_vt, &ldvt, jni_u, &ldu, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vt, jni_vt, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasdt (JNIEnv * env, jobject calling_obj, jint n, jobject lvl, jobject nd, jintArray inode, jintArray ndiml, jintArray ndimr, jint msub){
+ jclass jni_lvlClass = (*env)->GetObjectClass(env, lvl);
+ jfieldID jni_lvlId = (*env)->GetFieldID(env, jni_lvlClass, "val", "I");
+ jint jni_lvl = (*env)->GetIntField(env, lvl, jni_lvlId);
+ jclass jni_ndClass = (*env)->GetObjectClass(env, nd);
+ jfieldID jni_ndId = (*env)->GetFieldID(env, jni_ndClass, "val", "I");
+ jint jni_nd = (*env)->GetIntField(env, nd, jni_ndId);
+ jint * jni_inode = (*env)->GetPrimitiveArrayCritical(env, inode, JNI_FALSE);
+ check_memory(env, jni_inode);
+ jint * jni_ndiml = (*env)->GetPrimitiveArrayCritical(env, ndiml, JNI_FALSE);
+ check_memory(env, jni_ndiml);
+ jint * jni_ndimr = (*env)->GetPrimitiveArrayCritical(env, ndimr, JNI_FALSE);
+ check_memory(env, jni_ndimr);
+
+ slasdt_(&n, &jni_lvl, &jni_nd, jni_inode, jni_ndiml, jni_ndimr, &msub);
+
+ (*env)->SetIntField(env, lvl, jni_lvlId, jni_lvl);
+ (*env)->SetIntField(env, nd, jni_ndId, jni_nd);
+ (*env)->ReleasePrimitiveArrayCritical(env, inode, jni_inode, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ndiml, jni_ndiml, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ndimr, jni_ndimr, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaset (JNIEnv * env, jobject calling_obj, jstring uplo, jint m, jint n, jfloat alpha, jfloat beta, jfloatArray a, jint lda){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ slaset_(jni_uplo, &m, &n, &alpha, &beta, jni_a, &lda);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasq1 (JNIEnv * env, jobject calling_obj, jint n, jfloatArray d, jfloatArray e, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasq1_(&n, jni_d, jni_e, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasq2 (JNIEnv * env, jobject calling_obj, jint n, jfloatArray z, jobject info){
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasq2_(&n, jni_z, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasq3 (JNIEnv * env, jobject calling_obj, jint i0, jobject n0, jfloatArray z, jint pp, jobject dmin, jobject sigma, jobject desig, jobject qmax, jobject nfail, jobject iter, jobject ndiv, jboolean ieee){
+ jclass jni_n0Class = (*env)->GetObjectClass(env, n0);
+ jfieldID jni_n0Id = (*env)->GetFieldID(env, jni_n0Class, "val", "I");
+ jint jni_n0 = (*env)->GetIntField(env, n0, jni_n0Id);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_dminClass = (*env)->GetObjectClass(env, dmin);
+ jfieldID jni_dminId = (*env)->GetFieldID(env, jni_dminClass, "val", "D");
+ jfloat jni_dmin = (*env)->GetFloatField(env, dmin, jni_dminId);
+ jclass jni_sigmaClass = (*env)->GetObjectClass(env, sigma);
+ jfieldID jni_sigmaId = (*env)->GetFieldID(env, jni_sigmaClass, "val", "D");
+ jfloat jni_sigma = (*env)->GetFloatField(env, sigma, jni_sigmaId);
+ jclass jni_desigClass = (*env)->GetObjectClass(env, desig);
+ jfieldID jni_desigId = (*env)->GetFieldID(env, jni_desigClass, "val", "D");
+ jfloat jni_desig = (*env)->GetFloatField(env, desig, jni_desigId);
+ jclass jni_qmaxClass = (*env)->GetObjectClass(env, qmax);
+ jfieldID jni_qmaxId = (*env)->GetFieldID(env, jni_qmaxClass, "val", "D");
+ jfloat jni_qmax = (*env)->GetFloatField(env, qmax, jni_qmaxId);
+ jclass jni_nfailClass = (*env)->GetObjectClass(env, nfail);
+ jfieldID jni_nfailId = (*env)->GetFieldID(env, jni_nfailClass, "val", "I");
+ jint jni_nfail = (*env)->GetIntField(env, nfail, jni_nfailId);
+ jclass jni_iterClass = (*env)->GetObjectClass(env, iter);
+ jfieldID jni_iterId = (*env)->GetFieldID(env, jni_iterClass, "val", "I");
+ jint jni_iter = (*env)->GetIntField(env, iter, jni_iterId);
+ jclass jni_ndivClass = (*env)->GetObjectClass(env, ndiv);
+ jfieldID jni_ndivId = (*env)->GetFieldID(env, jni_ndivClass, "val", "I");
+ jint jni_ndiv = (*env)->GetIntField(env, ndiv, jni_ndivId);
+ logical jni_ieee = (logical)ieee;
+
+ slasq3_(&i0, &jni_n0, jni_z, &pp, &jni_dmin, &jni_sigma, &jni_desig, &jni_qmax, &jni_nfail, &jni_iter, &jni_ndiv, &jni_ieee);
+
+ (*env)->SetIntField(env, n0, jni_n0Id, jni_n0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetFloatField(env, dmin, jni_dminId, jni_dmin);
+ (*env)->SetFloatField(env, sigma, jni_sigmaId, jni_sigma);
+ (*env)->SetFloatField(env, desig, jni_desigId, jni_desig);
+ (*env)->SetFloatField(env, qmax, jni_qmaxId, jni_qmax);
+ (*env)->SetIntField(env, nfail, jni_nfailId, jni_nfail);
+ (*env)->SetIntField(env, iter, jni_iterId, jni_iter);
+ (*env)->SetIntField(env, ndiv, jni_ndivId, jni_ndiv);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasq4 (JNIEnv * env, jobject calling_obj, jint i0, jint n0, jfloatArray z, jint pp, jint n0in, jfloat dmin, jfloat dmin1, jfloat dmin2, jfloat dn, jfloat dn1, jfloat dn2, jobject tau, jobject ttype){
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_tauClass = (*env)->GetObjectClass(env, tau);
+ jfieldID jni_tauId = (*env)->GetFieldID(env, jni_tauClass, "val", "D");
+ jfloat jni_tau = (*env)->GetFloatField(env, tau, jni_tauId);
+ jclass jni_ttypeClass = (*env)->GetObjectClass(env, ttype);
+ jfieldID jni_ttypeId = (*env)->GetFieldID(env, jni_ttypeClass, "val", "I");
+ jint jni_ttype = (*env)->GetIntField(env, ttype, jni_ttypeId);
+
+ slasq4_(&i0, &n0, jni_z, &pp, &n0in, &dmin, &dmin1, &dmin2, &dn, &dn1, &dn2, &jni_tau, &jni_ttype);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetFloatField(env, tau, jni_tauId, jni_tau);
+ (*env)->SetIntField(env, ttype, jni_ttypeId, jni_ttype);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasq5 (JNIEnv * env, jobject calling_obj, jint i0, jint n0, jfloatArray z, jint pp, jfloat tau, jobject dmin, jobject dmin1, jobject dmin2, jobject dn, jobject dnm1, jobject dnm2, jboolean ieee){
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_dminClass = (*env)->GetObjectClass(env, dmin);
+ jfieldID jni_dminId = (*env)->GetFieldID(env, jni_dminClass, "val", "D");
+ jfloat jni_dmin = (*env)->GetFloatField(env, dmin, jni_dminId);
+ jclass jni_dmin1Class = (*env)->GetObjectClass(env, dmin1);
+ jfieldID jni_dmin1Id = (*env)->GetFieldID(env, jni_dmin1Class, "val", "D");
+ jfloat jni_dmin1 = (*env)->GetFloatField(env, dmin1, jni_dmin1Id);
+ jclass jni_dmin2Class = (*env)->GetObjectClass(env, dmin2);
+ jfieldID jni_dmin2Id = (*env)->GetFieldID(env, jni_dmin2Class, "val", "D");
+ jfloat jni_dmin2 = (*env)->GetFloatField(env, dmin2, jni_dmin2Id);
+ jclass jni_dnClass = (*env)->GetObjectClass(env, dn);
+ jfieldID jni_dnId = (*env)->GetFieldID(env, jni_dnClass, "val", "D");
+ jfloat jni_dn = (*env)->GetFloatField(env, dn, jni_dnId);
+ jclass jni_dnm1Class = (*env)->GetObjectClass(env, dnm1);
+ jfieldID jni_dnm1Id = (*env)->GetFieldID(env, jni_dnm1Class, "val", "D");
+ jfloat jni_dnm1 = (*env)->GetFloatField(env, dnm1, jni_dnm1Id);
+ jclass jni_dnm2Class = (*env)->GetObjectClass(env, dnm2);
+ jfieldID jni_dnm2Id = (*env)->GetFieldID(env, jni_dnm2Class, "val", "D");
+ jfloat jni_dnm2 = (*env)->GetFloatField(env, dnm2, jni_dnm2Id);
+ logical jni_ieee = (logical)ieee;
+
+ slasq5_(&i0, &n0, jni_z, &pp, &tau, &jni_dmin, &jni_dmin1, &jni_dmin2, &jni_dn, &jni_dnm1, &jni_dnm2, &jni_ieee);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetFloatField(env, dmin, jni_dminId, jni_dmin);
+ (*env)->SetFloatField(env, dmin1, jni_dmin1Id, jni_dmin1);
+ (*env)->SetFloatField(env, dmin2, jni_dmin2Id, jni_dmin2);
+ (*env)->SetFloatField(env, dn, jni_dnId, jni_dn);
+ (*env)->SetFloatField(env, dnm1, jni_dnm1Id, jni_dnm1);
+ (*env)->SetFloatField(env, dnm2, jni_dnm2Id, jni_dnm2);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasq6 (JNIEnv * env, jobject calling_obj, jint i0, jint n0, jfloatArray z, jint pp, jobject dmin, jobject dmin1, jobject dmin2, jobject dn, jobject dnm1, jobject dnm2){
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_dminClass = (*env)->GetObjectClass(env, dmin);
+ jfieldID jni_dminId = (*env)->GetFieldID(env, jni_dminClass, "val", "D");
+ jfloat jni_dmin = (*env)->GetFloatField(env, dmin, jni_dminId);
+ jclass jni_dmin1Class = (*env)->GetObjectClass(env, dmin1);
+ jfieldID jni_dmin1Id = (*env)->GetFieldID(env, jni_dmin1Class, "val", "D");
+ jfloat jni_dmin1 = (*env)->GetFloatField(env, dmin1, jni_dmin1Id);
+ jclass jni_dmin2Class = (*env)->GetObjectClass(env, dmin2);
+ jfieldID jni_dmin2Id = (*env)->GetFieldID(env, jni_dmin2Class, "val", "D");
+ jfloat jni_dmin2 = (*env)->GetFloatField(env, dmin2, jni_dmin2Id);
+ jclass jni_dnClass = (*env)->GetObjectClass(env, dn);
+ jfieldID jni_dnId = (*env)->GetFieldID(env, jni_dnClass, "val", "D");
+ jfloat jni_dn = (*env)->GetFloatField(env, dn, jni_dnId);
+ jclass jni_dnm1Class = (*env)->GetObjectClass(env, dnm1);
+ jfieldID jni_dnm1Id = (*env)->GetFieldID(env, jni_dnm1Class, "val", "D");
+ jfloat jni_dnm1 = (*env)->GetFloatField(env, dnm1, jni_dnm1Id);
+ jclass jni_dnm2Class = (*env)->GetObjectClass(env, dnm2);
+ jfieldID jni_dnm2Id = (*env)->GetFieldID(env, jni_dnm2Class, "val", "D");
+ jfloat jni_dnm2 = (*env)->GetFloatField(env, dnm2, jni_dnm2Id);
+
+ slasq6_(&i0, &n0, jni_z, &pp, &jni_dmin, &jni_dmin1, &jni_dmin2, &jni_dn, &jni_dnm1, &jni_dnm2);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetFloatField(env, dmin, jni_dminId, jni_dmin);
+ (*env)->SetFloatField(env, dmin1, jni_dmin1Id, jni_dmin1);
+ (*env)->SetFloatField(env, dmin2, jni_dmin2Id, jni_dmin2);
+ (*env)->SetFloatField(env, dn, jni_dnId, jni_dn);
+ (*env)->SetFloatField(env, dnm1, jni_dnm1Id, jni_dnm1);
+ (*env)->SetFloatField(env, dnm2, jni_dnm2Id, jni_dnm2);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasr (JNIEnv * env, jobject calling_obj, jstring side, jstring pivot, jstring direct, jint m, jint n, jfloatArray c, jfloatArray s, jfloatArray a, jint lda){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_pivot = (char *)(*env)->GetStringUTFChars(env, pivot, JNI_FALSE);
+ char * jni_direct = (char *)(*env)->GetStringUTFChars(env, direct, JNI_FALSE);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+
+ slasr_(jni_side, jni_pivot, jni_direct, &m, &n, jni_c, jni_s, jni_a, &lda);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, pivot, jni_pivot);
+ (*env)->ReleaseStringUTFChars(env, direct, jni_direct);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasrt (JNIEnv * env, jobject calling_obj, jstring id, jint n, jfloatArray d, jobject info){
+ char * jni_id = (char *)(*env)->GetStringUTFChars(env, id, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasrt_(jni_id, &n, jni_d, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, id, jni_id);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slassq (JNIEnv * env, jobject calling_obj, jint n, jfloatArray x, jint incx, jobject scale, jobject sumsq){
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jclass jni_sumsqClass = (*env)->GetObjectClass(env, sumsq);
+ jfieldID jni_sumsqId = (*env)->GetFieldID(env, jni_sumsqClass, "val", "D");
+ jfloat jni_sumsq = (*env)->GetFloatField(env, sumsq, jni_sumsqId);
+
+ slassq_(&n, jni_x, &incx, &jni_scale, &jni_sumsq);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetFloatField(env, sumsq, jni_sumsqId, jni_sumsq);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasv2 (JNIEnv * env, jobject calling_obj, jfloat f, jfloat g, jfloat h, jobject ssmin, jobject ssmax, jobject snr, jobject csr, jobject snl, jobject csl){
+ jclass jni_ssminClass = (*env)->GetObjectClass(env, ssmin);
+ jfieldID jni_ssminId = (*env)->GetFieldID(env, jni_ssminClass, "val", "D");
+ jfloat jni_ssmin = (*env)->GetFloatField(env, ssmin, jni_ssminId);
+ jclass jni_ssmaxClass = (*env)->GetObjectClass(env, ssmax);
+ jfieldID jni_ssmaxId = (*env)->GetFieldID(env, jni_ssmaxClass, "val", "D");
+ jfloat jni_ssmax = (*env)->GetFloatField(env, ssmax, jni_ssmaxId);
+ jclass jni_snrClass = (*env)->GetObjectClass(env, snr);
+ jfieldID jni_snrId = (*env)->GetFieldID(env, jni_snrClass, "val", "D");
+ jfloat jni_snr = (*env)->GetFloatField(env, snr, jni_snrId);
+ jclass jni_csrClass = (*env)->GetObjectClass(env, csr);
+ jfieldID jni_csrId = (*env)->GetFieldID(env, jni_csrClass, "val", "D");
+ jfloat jni_csr = (*env)->GetFloatField(env, csr, jni_csrId);
+ jclass jni_snlClass = (*env)->GetObjectClass(env, snl);
+ jfieldID jni_snlId = (*env)->GetFieldID(env, jni_snlClass, "val", "D");
+ jfloat jni_snl = (*env)->GetFloatField(env, snl, jni_snlId);
+ jclass jni_cslClass = (*env)->GetObjectClass(env, csl);
+ jfieldID jni_cslId = (*env)->GetFieldID(env, jni_cslClass, "val", "D");
+ jfloat jni_csl = (*env)->GetFloatField(env, csl, jni_cslId);
+
+ slasv2_(&f, &g, &h, &jni_ssmin, &jni_ssmax, &jni_snr, &jni_csr, &jni_snl, &jni_csl);
+
+ (*env)->SetFloatField(env, ssmin, jni_ssminId, jni_ssmin);
+ (*env)->SetFloatField(env, ssmax, jni_ssmaxId, jni_ssmax);
+ (*env)->SetFloatField(env, snr, jni_snrId, jni_snr);
+ (*env)->SetFloatField(env, csr, jni_csrId, jni_csr);
+ (*env)->SetFloatField(env, snl, jni_snlId, jni_snl);
+ (*env)->SetFloatField(env, csl, jni_cslId, jni_csl);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slaswp (JNIEnv * env, jobject calling_obj, jint n, jfloatArray a, jint lda, jint k1, jint k2, jintArray ipiv, jint incx){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+
+ slaswp_(&n, jni_a, &lda, &k1, &k2, jni_ipiv, &incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasy2 (JNIEnv * env, jobject calling_obj, jboolean ltranl, jboolean ltranr, jint isgn, jint n1, jint n2, jfloatArray tl, jint ldtl, jfloatArray tr, jint ldtr, jfloatArray b, jint ldb, jobject scale, jfloatArray x, jint ldx, jobject xnorm, jobject info){
+ logical jni_ltranl = (logical)ltranl;
+ logical jni_ltranr = (logical)ltranr;
+ jfloat * jni_tl = (*env)->GetPrimitiveArrayCritical(env, tl, JNI_FALSE);
+ check_memory(env, jni_tl);
+ jfloat * jni_tr = (*env)->GetPrimitiveArrayCritical(env, tr, JNI_FALSE);
+ check_memory(env, jni_tr);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_xnormClass = (*env)->GetObjectClass(env, xnorm);
+ jfieldID jni_xnormId = (*env)->GetFieldID(env, jni_xnormClass, "val", "D");
+ jfloat jni_xnorm = (*env)->GetFloatField(env, xnorm, jni_xnormId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasy2_(&jni_ltranl, &jni_ltranr, &isgn, &n1, &n2, jni_tl, &ldtl, jni_tr, &ldtr, jni_b, &ldb, &jni_scale, jni_x, &ldx, &jni_xnorm, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, tl, jni_tl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tr, jni_tr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, xnorm, jni_xnormId, jni_xnorm);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slasyf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nb, jobject kb, jfloatArray a, jint lda, jintArray ipiv, jfloatArray w, jint ldw, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jclass jni_kbClass = (*env)->GetObjectClass(env, kb);
+ jfieldID jni_kbId = (*env)->GetFieldID(env, jni_kbClass, "val", "I");
+ jint jni_kb = (*env)->GetIntField(env, kb, jni_kbId);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slasyf_(jni_uplo, &n, &nb, &jni_kb, jni_a, &lda, jni_ipiv, jni_w, &ldw, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->SetIntField(env, kb, jni_kbId, jni_kb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatbs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jstring normin, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray x, jobject scale, jfloatArray cnorm, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ char * jni_normin = (char *)(*env)->GetStringUTFChars(env, normin, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jfloat * jni_cnorm = (*env)->GetPrimitiveArrayCritical(env, cnorm, JNI_FALSE);
+ check_memory(env, jni_cnorm);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slatbs_(jni_uplo, jni_trans, jni_diag, jni_normin, &n, &kd, jni_ab, &ldab, jni_x, &jni_scale, jni_cnorm, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleaseStringUTFChars(env, normin, jni_normin);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, cnorm, jni_cnorm, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatdf (JNIEnv * env, jobject calling_obj, jint ijob, jint n, jfloatArray z, jint ldz, jfloatArray rhs, jobject rdsum, jobject rdscal, jintArray ipiv, jintArray jpiv){
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_rhs = (*env)->GetPrimitiveArrayCritical(env, rhs, JNI_FALSE);
+ check_memory(env, jni_rhs);
+ jclass jni_rdsumClass = (*env)->GetObjectClass(env, rdsum);
+ jfieldID jni_rdsumId = (*env)->GetFieldID(env, jni_rdsumClass, "val", "D");
+ jfloat jni_rdsum = (*env)->GetFloatField(env, rdsum, jni_rdsumId);
+ jclass jni_rdscalClass = (*env)->GetObjectClass(env, rdscal);
+ jfieldID jni_rdscalId = (*env)->GetFieldID(env, jni_rdscalClass, "val", "D");
+ jfloat jni_rdscal = (*env)->GetFloatField(env, rdscal, jni_rdscalId);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jint * jni_jpiv = (*env)->GetPrimitiveArrayCritical(env, jpiv, JNI_FALSE);
+ check_memory(env, jni_jpiv);
+
+ slatdf_(&ijob, &n, jni_z, &ldz, jni_rhs, &jni_rdsum, &jni_rdscal, jni_ipiv, jni_jpiv);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, rhs, jni_rhs, 0);
+ (*env)->SetFloatField(env, rdsum, jni_rdsumId, jni_rdsum);
+ (*env)->SetFloatField(env, rdscal, jni_rdscalId, jni_rdscal);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, jpiv, jni_jpiv, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatps (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jstring normin, jint n, jfloatArray ap, jfloatArray x, jobject scale, jfloatArray cnorm, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ char * jni_normin = (char *)(*env)->GetStringUTFChars(env, normin, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jfloat * jni_cnorm = (*env)->GetPrimitiveArrayCritical(env, cnorm, JNI_FALSE);
+ check_memory(env, jni_cnorm);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slatps_(jni_uplo, jni_trans, jni_diag, jni_normin, &n, jni_ap, jni_x, &jni_scale, jni_cnorm, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleaseStringUTFChars(env, normin, jni_normin);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, cnorm, jni_cnorm, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatrd (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nb, jfloatArray a, jint lda, jfloatArray e, jfloatArray tau, jfloatArray w, jint ldw){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+
+ slatrd_(jni_uplo, &n, &nb, jni_a, &lda, jni_e, jni_tau, jni_w, &ldw);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jstring normin, jint n, jfloatArray a, jint lda, jfloatArray x, jobject scale, jfloatArray cnorm, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ char * jni_normin = (char *)(*env)->GetStringUTFChars(env, normin, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jfloat * jni_cnorm = (*env)->GetPrimitiveArrayCritical(env, cnorm, JNI_FALSE);
+ check_memory(env, jni_cnorm);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slatrs_(jni_uplo, jni_trans, jni_diag, jni_normin, &n, jni_a, &lda, jni_x, &jni_scale, jni_cnorm, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleaseStringUTFChars(env, normin, jni_normin);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->ReleasePrimitiveArrayCritical(env, cnorm, jni_cnorm, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatrz (JNIEnv * env, jobject calling_obj, jint m, jint n, jint l, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slatrz_(&m, &n, &l, jni_a, &lda, jni_tau, jni_work);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slatzm (JNIEnv * env, jobject calling_obj, jstring side, jint m, jint n, jfloatArray v, jint incv, jfloat tau, jfloatArray c1, jfloatArray c2, jint Ldc, jfloatArray work){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_c1 = (*env)->GetPrimitiveArrayCritical(env, c1, JNI_FALSE);
+ check_memory(env, jni_c1);
+ jfloat * jni_c2 = (*env)->GetPrimitiveArrayCritical(env, c2, JNI_FALSE);
+ check_memory(env, jni_c2);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+
+ slatzm_(jni_side, &m, &n, jni_v, &incv, &tau, jni_c1, jni_c2, &Ldc, jni_work);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c1, jni_c1, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c2, jni_c2, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slauu2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slauu2_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slauum (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ slauum_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sopgtr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jfloatArray tau, jfloatArray q, jint ldq, jfloatArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sopgtr_(jni_uplo, &n, jni_ap, jni_tau, jni_q, &ldq, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sopmtr (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring trans, jint m, jint n, jfloatArray ap, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sopmtr_(jni_side, jni_uplo, jni_trans, &m, &n, jni_ap, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorg2l (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorg2l_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorg2r (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorg2r_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgbr (JNIEnv * env, jobject calling_obj, jstring vect, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgbr_(jni_vect, &m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorghr (JNIEnv * env, jobject calling_obj, jint n, jint ilo, jint ihi, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorghr_(&n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgl2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgl2_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorglq (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorglq_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgql (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgql_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgqr (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgqr_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgr2 (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgr2_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgrq (JNIEnv * env, jobject calling_obj, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgrq_(&m, &n, &k, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorgtr (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorgtr_(jni_uplo, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorm2l (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorm2l_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorm2r (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorm2r_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormbr (JNIEnv * env, jobject calling_obj, jstring vect, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormbr_(jni_vect, jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormhr (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint ilo, jint ihi, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormhr_(jni_side, jni_trans, &m, &n, &ilo, &ihi, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sorml2 (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sorml2_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormlq (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormlq_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormql (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormql_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormqr (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormqr_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormr2 (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormr2_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormr3 (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jint l, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormr3_(jni_side, jni_trans, &m, &n, &k, &l, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormrq (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormrq_(jni_side, jni_trans, &m, &n, &k, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormrz (JNIEnv * env, jobject calling_obj, jstring side, jstring trans, jint m, jint n, jint k, jint l, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormrz_(jni_side, jni_trans, &m, &n, &k, &l, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sormtr (JNIEnv * env, jobject calling_obj, jstring side, jstring uplo, jstring trans, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray c, jint Ldc, jfloatArray work, jint lwork, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sormtr_(jni_side, jni_uplo, jni_trans, &m, &n, jni_a, &lda, jni_tau, jni_c, &Ldc, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbcon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbcon_(jni_uplo, &n, &kd, jni_ab, &ldab, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbequ (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray s, jobject scond, jobject amax, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_scondClass = (*env)->GetObjectClass(env, scond);
+ jfieldID jni_scondId = (*env)->GetFieldID(env, jni_scondClass, "val", "D");
+ jfloat jni_scond = (*env)->GetFloatField(env, scond, jni_scondId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jfloat jni_amax = (*env)->GetFloatField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbequ_(jni_uplo, &n, &kd, jni_ab, &ldab, jni_s, &jni_scond, &jni_amax, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetFloatField(env, scond, jni_scondId, jni_scond);
+ (*env)->SetFloatField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jint nrhs, jfloatArray ab, jint ldab, jfloatArray afb, jint ldafb, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbrfs_(jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbstf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbstf_(jni_uplo, &n, &kd, jni_ab, &ldab, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbsv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jint nrhs, jfloatArray ab, jint ldab, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbsv_(jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint kd, jint nrhs, jfloatArray ab, jint ldab, jfloatArray afb, jint ldafb, jobject equed, jfloatArray s, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_afb = (*env)->GetPrimitiveArrayCritical(env, afb, JNI_FALSE);
+ check_memory(env, jni_afb);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbsvx_(jni_fact, jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_afb, &ldafb, jni_equed, jni_s, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afb, jni_afb, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbtf2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbtf2_(jni_uplo, &n, &kd, jni_ab, &ldab, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbtrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbtrf_(jni_uplo, &n, &kd, jni_ab, &ldab, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spbtrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint kd, jint nrhs, jfloatArray ab, jint ldab, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spbtrs_(jni_uplo, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spocon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spocon_(jni_uplo, &n, jni_a, &lda, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spoequ (JNIEnv * env, jobject calling_obj, jint n, jfloatArray a, jint lda, jfloatArray s, jobject scond, jobject amax, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_scondClass = (*env)->GetObjectClass(env, scond);
+ jfieldID jni_scondId = (*env)->GetFieldID(env, jni_scondClass, "val", "D");
+ jfloat jni_scond = (*env)->GetFloatField(env, scond, jni_scondId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jfloat jni_amax = (*env)->GetFloatField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spoequ_(&n, jni_a, &lda, jni_s, &jni_scond, &jni_amax, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetFloatField(env, scond, jni_scondId, jni_scond);
+ (*env)->SetFloatField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sporfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray af, jint ldaf, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sporfs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sposv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sposv_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sposvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray af, jint ldaf, jobject equed, jfloatArray s, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sposvx_(jni_fact, jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_equed, jni_s, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spotf2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spotf2_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spotrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spotrf_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spotri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spotri_(jni_uplo, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spotrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spotrs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sppcon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sppcon_(jni_uplo, &n, jni_ap, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sppequ (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jfloatArray s, jobject scond, jobject amax, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jclass jni_scondClass = (*env)->GetObjectClass(env, scond);
+ jfieldID jni_scondId = (*env)->GetFieldID(env, jni_scondClass, "val", "D");
+ jfloat jni_scond = (*env)->GetFloatField(env, scond, jni_scondId);
+ jclass jni_amaxClass = (*env)->GetObjectClass(env, amax);
+ jfieldID jni_amaxId = (*env)->GetFieldID(env, jni_amaxClass, "val", "D");
+ jfloat jni_amax = (*env)->GetFloatField(env, amax, jni_amaxId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sppequ_(jni_uplo, &n, jni_ap, jni_s, &jni_scond, &jni_amax, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->SetFloatField(env, scond, jni_scondId, jni_scond);
+ (*env)->SetFloatField(env, amax, jni_amaxId, jni_amax);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spprfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray ap, jfloatArray afp, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spprfs_(jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sppsv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray ap, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sppsv_(jni_uplo, &n, &nrhs, jni_ap, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sppsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jfloatArray ap, jfloatArray afp, jobject equed, jfloatArray s, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jclass jni_equedClass = (*env)->GetObjectClass(env, equed);
+ jfieldID jni_equedId = (*env)->GetFieldID(env, jni_equedClass, "val", "Ljava/lang/String;");
+ jstring jni_equedString = (jstring)((*env)->GetObjectField(env, equed, jni_equedId));
+ char * jni_equed = (char *)(*env)->GetStringUTFChars(env, jni_equedString, JNI_FALSE);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sppsvx_(jni_fact, jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_equed, jni_s, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ jstring jni_equedStringNew = (*env)->NewStringUTF(env, jni_equed);
+ (*env)->SetObjectField(env, equed, jni_equedId, jni_equedStringNew);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spptrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spptrf_(jni_uplo, &n, jni_ap, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spptri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spptri_(jni_uplo, &n, jni_ap, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spptrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray ap, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spptrs_(jni_uplo, &n, &nrhs, jni_ap, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sptcon (JNIEnv * env, jobject calling_obj, jint n, jfloatArray d, jfloatArray e, jfloat anorm, jobject rcond, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sptcon_(&n, jni_d, jni_e, &anorm, &jni_rcond, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spteqr (JNIEnv * env, jobject calling_obj, jstring compz, jint n, jfloatArray d, jfloatArray e, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spteqr_(jni_compz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sptrfs (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jfloatArray d, jfloatArray e, jfloatArray df, jfloatArray ef, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jfloat * jni_ef = (*env)->GetPrimitiveArrayCritical(env, ef, JNI_FALSE);
+ check_memory(env, jni_ef);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sptrfs_(&n, &nrhs, jni_d, jni_e, jni_df, jni_ef, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ef, jni_ef, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sptsv (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jfloatArray d, jfloatArray e, jfloatArray b, jint ldb, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sptsv_(&n, &nrhs, jni_d, jni_e, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sptsvx (JNIEnv * env, jobject calling_obj, jstring fact, jint n, jint nrhs, jfloatArray d, jfloatArray e, jfloatArray df, jfloatArray ef, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_df = (*env)->GetPrimitiveArrayCritical(env, df, JNI_FALSE);
+ check_memory(env, jni_df);
+ jfloat * jni_ef = (*env)->GetPrimitiveArrayCritical(env, ef, JNI_FALSE);
+ check_memory(env, jni_ef);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sptsvx_(jni_fact, &n, &nrhs, jni_d, jni_e, jni_df, jni_ef, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, df, jni_df, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ef, jni_ef, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spttrf (JNIEnv * env, jobject calling_obj, jint n, jfloatArray d, jfloatArray e, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spttrf_(&n, jni_d, jni_e, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_spttrs (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jfloatArray d, jfloatArray e, jfloatArray b, jint ldb, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ spttrs_(&n, &nrhs, jni_d, jni_e, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sptts2 (JNIEnv * env, jobject calling_obj, jint n, jint nrhs, jfloatArray d, jfloatArray e, jfloatArray b, jint ldb){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+
+ sptts2_(&n, &nrhs, jni_d, jni_e, jni_b, &ldb);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_srscl (JNIEnv * env, jobject calling_obj, jint n, jfloat sa, jfloatArray sx, jint incx){
+ jfloat * jni_sx = (*env)->GetPrimitiveArrayCritical(env, sx, JNI_FALSE);
+ check_memory(env, jni_sx);
+
+ srscl_(&n, &sa, jni_sx, &incx);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, sx, jni_sx, 0);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbev (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbev_(jni_jobz, jni_uplo, &n, &kd, jni_ab, &ldab, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbevd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbevd_(jni_jobz, jni_uplo, &n, &kd, jni_ab, &ldab, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray q, jint ldq, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbevx_(jni_jobz, jni_range, jni_uplo, &n, &kd, jni_ab, &ldab, jni_q, &ldq, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbgst (JNIEnv * env, jobject calling_obj, jstring vect, jstring uplo, jint n, jint ka, jint kb, jfloatArray ab, jint ldab, jfloatArray bb, jint ldbb, jfloatArray x, jint ldx, jfloatArray work, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbgst_(jni_vect, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_x, &ldx, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbgv (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint ka, jint kb, jfloatArray ab, jint ldab, jfloatArray bb, jint ldbb, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbgv_(jni_jobz, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbgvd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jint ka, jint kb, jfloatArray ab, jint ldab, jfloatArray bb, jint ldbb, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbgvd_(jni_jobz, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbgvx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jint ka, jint kb, jfloatArray ab, jint ldab, jfloatArray bb, jint ldbb, jfloatArray q, jint ldq, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_bb = (*env)->GetPrimitiveArrayCritical(env, bb, JNI_FALSE);
+ check_memory(env, jni_bb);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbgvx_(jni_jobz, jni_range, jni_uplo, &n, &ka, &kb, jni_ab, &ldab, jni_bb, &ldbb, jni_q, &ldq, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bb, jni_bb, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssbtrd (JNIEnv * env, jobject calling_obj, jstring vect, jstring uplo, jint n, jint kd, jfloatArray ab, jint ldab, jfloatArray d, jfloatArray e, jfloatArray q, jint ldq, jfloatArray work, jobject info){
+ char * jni_vect = (char *)(*env)->GetStringUTFChars(env, vect, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssbtrd_(jni_vect, jni_uplo, &n, &kd, jni_ab, &ldab, jni_d, jni_e, jni_q, &ldq, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, vect, jni_vect);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspcon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jintArray ipiv, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspcon_(jni_uplo, &n, jni_ap, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspev (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jfloatArray ap, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspev_(jni_jobz, jni_uplo, &n, jni_ap, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspevd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jfloatArray ap, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspevd_(jni_jobz, jni_uplo, &n, jni_ap, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jfloatArray ap, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspevx_(jni_jobz, jni_range, jni_uplo, &n, jni_ap, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspgst (JNIEnv * env, jobject calling_obj, jint itype, jstring uplo, jint n, jfloatArray ap, jfloatArray bp, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspgst_(&itype, jni_uplo, &n, jni_ap, jni_bp, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspgv (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jfloatArray ap, jfloatArray bp, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspgv_(&itype, jni_jobz, jni_uplo, &n, jni_ap, jni_bp, jni_w, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspgvd (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jfloatArray ap, jfloatArray bp, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspgvd_(&itype, jni_jobz, jni_uplo, &n, jni_ap, jni_bp, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspgvx (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring range, jstring uplo, jint n, jfloatArray ap, jfloatArray bp, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_bp = (*env)->GetPrimitiveArrayCritical(env, bp, JNI_FALSE);
+ check_memory(env, jni_bp);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspgvx_(&itype, jni_jobz, jni_range, jni_uplo, &n, jni_ap, jni_bp, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, bp, jni_bp, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssprfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray ap, jfloatArray afp, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssprfs_(jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspsv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray ap, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspsv_(jni_uplo, &n, &nrhs, jni_ap, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sspsvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jfloatArray ap, jfloatArray afp, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_afp = (*env)->GetPrimitiveArrayCritical(env, afp, JNI_FALSE);
+ check_memory(env, jni_afp);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sspsvx_(jni_fact, jni_uplo, &n, &nrhs, jni_ap, jni_afp, jni_ipiv, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, afp, jni_afp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssptrd (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jfloatArray d, jfloatArray e, jfloatArray tau, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssptrd_(jni_uplo, &n, jni_ap, jni_d, jni_e, jni_tau, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssptrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jintArray ipiv, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssptrf_(jni_uplo, &n, jni_ap, jni_ipiv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssptri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray ap, jintArray ipiv, jfloatArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssptri_(jni_uplo, &n, jni_ap, jni_ipiv, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssptrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray ap, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssptrs_(jni_uplo, &n, &nrhs, jni_ap, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstebz (JNIEnv * env, jobject calling_obj, jstring range, jstring order, jint n, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jfloatArray d, jfloatArray e, jobject m, jobject nsplit, jfloatArray w, jintArray iblock, jintArray isplit, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_order = (char *)(*env)->GetStringUTFChars(env, order, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jclass jni_nsplitClass = (*env)->GetObjectClass(env, nsplit);
+ jfieldID jni_nsplitId = (*env)->GetFieldID(env, jni_nsplitClass, "val", "I");
+ jint jni_nsplit = (*env)->GetIntField(env, nsplit, jni_nsplitId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jint * jni_iblock = (*env)->GetPrimitiveArrayCritical(env, iblock, JNI_FALSE);
+ check_memory(env, jni_iblock);
+ jint * jni_isplit = (*env)->GetPrimitiveArrayCritical(env, isplit, JNI_FALSE);
+ check_memory(env, jni_isplit);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstebz_(jni_range, jni_order, &n, &vl, &vu, &il, &iu, &abstol, jni_d, jni_e, &jni_m, &jni_nsplit, jni_w, jni_iblock, jni_isplit, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, order, jni_order);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->SetIntField(env, nsplit, jni_nsplitId, jni_nsplit);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iblock, jni_iblock, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isplit, jni_isplit, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstedc (JNIEnv * env, jobject calling_obj, jstring compz, jint n, jfloatArray d, jfloatArray e, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstedc_(jni_compz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstegr (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jint n, jfloatArray d, jfloatArray e, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jintArray isuppz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jint * jni_isuppz = (*env)->GetPrimitiveArrayCritical(env, isuppz, JNI_FALSE);
+ check_memory(env, jni_isuppz);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstegr_(jni_jobz, jni_range, &n, jni_d, jni_e, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_isuppz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isuppz, jni_isuppz, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstein (JNIEnv * env, jobject calling_obj, jint n, jfloatArray d, jfloatArray e, jint m, jfloatArray w, jintArray iblock, jintArray isplit, jfloatArray z, jint ldz, jfloatArray work, jintArray iwork, jintArray ifail, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jint * jni_iblock = (*env)->GetPrimitiveArrayCritical(env, iblock, JNI_FALSE);
+ check_memory(env, jni_iblock);
+ jint * jni_isplit = (*env)->GetPrimitiveArrayCritical(env, isplit, JNI_FALSE);
+ check_memory(env, jni_isplit);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstein_(&n, jni_d, jni_e, &m, jni_w, jni_iblock, jni_isplit, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iblock, jni_iblock, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isplit, jni_isplit, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssteqr (JNIEnv * env, jobject calling_obj, jstring compz, jint n, jfloatArray d, jfloatArray e, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_compz = (char *)(*env)->GetStringUTFChars(env, compz, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssteqr_(jni_compz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compz, jni_compz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssterf (JNIEnv * env, jobject calling_obj, jint n, jfloatArray d, jfloatArray e, jobject info){
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssterf_(&n, jni_d, jni_e, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstev (JNIEnv * env, jobject calling_obj, jstring jobz, jint n, jfloatArray d, jfloatArray e, jfloatArray z, jint ldz, jfloatArray work, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstev_(jni_jobz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstevd (JNIEnv * env, jobject calling_obj, jstring jobz, jint n, jfloatArray d, jfloatArray e, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstevd_(jni_jobz, &n, jni_d, jni_e, jni_z, &ldz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstevr (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jint n, jfloatArray d, jfloatArray e, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jintArray isuppz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jint * jni_isuppz = (*env)->GetPrimitiveArrayCritical(env, isuppz, JNI_FALSE);
+ check_memory(env, jni_isuppz);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstevr_(jni_jobz, jni_range, &n, jni_d, jni_e, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_isuppz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isuppz, jni_isuppz, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_sstevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jint n, jfloatArray d, jfloatArray e, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ sstevx_(jni_jobz, jni_range, &n, jni_d, jni_e, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssycon (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jintArray ipiv, jfloat anorm, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssycon_(jni_uplo, &n, jni_a, &lda, jni_ipiv, &anorm, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssyev (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray w, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssyev_(jni_jobz, jni_uplo, &n, jni_a, &lda, jni_w, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssyevd (JNIEnv * env, jobject calling_obj, jstring jobz, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray w, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssyevd_(jni_jobz, jni_uplo, &n, jni_a, &lda, jni_w, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssyevr (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jfloatArray a, jint lda, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jintArray isuppz, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jint * jni_isuppz = (*env)->GetPrimitiveArrayCritical(env, isuppz, JNI_FALSE);
+ check_memory(env, jni_isuppz);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssyevr_(jni_jobz, jni_range, jni_uplo, &n, jni_a, &lda, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_isuppz, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, isuppz, jni_isuppz, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssyevx (JNIEnv * env, jobject calling_obj, jstring jobz, jstring range, jstring uplo, jint n, jfloatArray a, jint lda, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssyevx_(jni_jobz, jni_range, jni_uplo, &n, jni_a, &lda, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssygs2 (JNIEnv * env, jobject calling_obj, jint itype, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssygs2_(&itype, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssygst (JNIEnv * env, jobject calling_obj, jint itype, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssygst_(&itype, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssygv (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray w, jfloatArray work, jint lwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssygv_(&itype, jni_jobz, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, jni_w, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssygvd (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray w, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssygvd_(&itype, jni_jobz, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, jni_w, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssygvx (JNIEnv * env, jobject calling_obj, jint itype, jstring jobz, jstring range, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat vl, jfloat vu, jint il, jint iu, jfloat abstol, jobject m, jfloatArray w, jfloatArray z, jint ldz, jfloatArray work, jint lwork, jintArray iwork, jintArray ifail, jobject info){
+ char * jni_jobz = (char *)(*env)->GetStringUTFChars(env, jobz, JNI_FALSE);
+ char * jni_range = (char *)(*env)->GetStringUTFChars(env, range, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_w = (*env)->GetPrimitiveArrayCritical(env, w, JNI_FALSE);
+ check_memory(env, jni_w);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jint * jni_ifail = (*env)->GetPrimitiveArrayCritical(env, ifail, JNI_FALSE);
+ check_memory(env, jni_ifail);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssygvx_(&itype, jni_jobz, jni_range, jni_uplo, &n, jni_a, &lda, jni_b, &ldb, &vl, &vu, &il, &iu, &abstol, &jni_m, jni_w, jni_z, &ldz, jni_work, &lwork, jni_iwork, jni_ifail, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobz, jni_jobz);
+ (*env)->ReleaseStringUTFChars(env, range, jni_range);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, w, jni_w, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ifail, jni_ifail, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssyrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray af, jint ldaf, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssyrfs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssysv (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssysv_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssysvx (JNIEnv * env, jobject calling_obj, jstring fact, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray af, jint ldaf, jintArray ipiv, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jobject rcond, jfloatArray ferr, jfloatArray berr, jfloatArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_fact = (char *)(*env)->GetStringUTFChars(env, fact, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_af = (*env)->GetPrimitiveArrayCritical(env, af, JNI_FALSE);
+ check_memory(env, jni_af);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssysvx_(jni_fact, jni_uplo, &n, &nrhs, jni_a, &lda, jni_af, &ldaf, jni_ipiv, jni_b, &ldb, jni_x, &ldx, &jni_rcond, jni_ferr, jni_berr, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, fact, jni_fact);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, af, jni_af, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssytd2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray d, jfloatArray e, jfloatArray tau, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssytd2_(jni_uplo, &n, jni_a, &lda, jni_d, jni_e, jni_tau, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssytf2 (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jintArray ipiv, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssytf2_(jni_uplo, &n, jni_a, &lda, jni_ipiv, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssytrd (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jfloatArray d, jfloatArray e, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssytrd_(jni_uplo, &n, jni_a, &lda, jni_d, jni_e, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssytrf (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jintArray ipiv, jfloatArray work, jint lwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssytrf_(jni_uplo, &n, jni_a, &lda, jni_ipiv, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssytri (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jfloatArray a, jint lda, jintArray ipiv, jfloatArray work, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssytri_(jni_uplo, &n, jni_a, &lda, jni_ipiv, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_ssytrs (JNIEnv * env, jobject calling_obj, jstring uplo, jint n, jint nrhs, jfloatArray a, jint lda, jintArray ipiv, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jint * jni_ipiv = (*env)->GetPrimitiveArrayCritical(env, ipiv, JNI_FALSE);
+ check_memory(env, jni_ipiv);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ ssytrs_(jni_uplo, &n, &nrhs, jni_a, &lda, jni_ipiv, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ipiv, jni_ipiv, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stbcon (JNIEnv * env, jobject calling_obj, jstring norm, jstring uplo, jstring diag, jint n, jint kd, jfloatArray ab, jint ldab, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stbcon_(jni_norm, jni_uplo, jni_diag, &n, &kd, jni_ab, &ldab, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stbrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint kd, jint nrhs, jfloatArray ab, jint ldab, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stbrfs_(jni_uplo, jni_trans, jni_diag, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stbtrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint kd, jint nrhs, jfloatArray ab, jint ldab, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ab = (*env)->GetPrimitiveArrayCritical(env, ab, JNI_FALSE);
+ check_memory(env, jni_ab);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stbtrs_(jni_uplo, jni_trans, jni_diag, &n, &kd, &nrhs, jni_ab, &ldab, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ab, jni_ab, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgevc (JNIEnv * env, jobject calling_obj, jstring side, jstring howmny, jbooleanArray select, jint n, jfloatArray s, jint lds, jfloatArray p, jint ldp, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jint mm, jobject m, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_p = (*env)->GetPrimitiveArrayCritical(env, p, JNI_FALSE);
+ check_memory(env, jni_p);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ stgevc_(jni_side, jni_howmny, jni_select, &n, jni_s, &lds, jni_p, &ldp, jni_vl, &ldvl, jni_vr, &ldvr, &mm, &jni_m, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, p, jni_p, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgex2 (JNIEnv * env, jobject calling_obj, jboolean wantq, jboolean wantz, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray q, jint ldq, jfloatArray z, jint ldz, jint j1, jint n1, jint n2, jfloatArray work, jint lwork, jobject info){
+ logical jni_wantq = (logical)wantq;
+ logical jni_wantz = (logical)wantz;
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stgex2_(&jni_wantq, &jni_wantz, &n, jni_a, &lda, jni_b, &ldb, jni_q, &ldq, jni_z, &ldz, &j1, &n1, &n2, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgexc (JNIEnv * env, jobject calling_obj, jboolean wantq, jboolean wantz, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray q, jint ldq, jfloatArray z, jint ldz, jobject ifst, jobject ilst, jfloatArray work, jint lwork, jobject info){
+ logical jni_wantq = (logical)wantq;
+ logical jni_wantz = (logical)wantz;
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_ifstClass = (*env)->GetObjectClass(env, ifst);
+ jfieldID jni_ifstId = (*env)->GetFieldID(env, jni_ifstClass, "val", "I");
+ jint jni_ifst = (*env)->GetIntField(env, ifst, jni_ifstId);
+ jclass jni_ilstClass = (*env)->GetObjectClass(env, ilst);
+ jfieldID jni_ilstId = (*env)->GetFieldID(env, jni_ilstClass, "val", "I");
+ jint jni_ilst = (*env)->GetIntField(env, ilst, jni_ilstId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stgexc_(&jni_wantq, &jni_wantz, &n, jni_a, &lda, jni_b, &ldb, jni_q, &ldq, jni_z, &ldz, &jni_ifst, &jni_ilst, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, ifst, jni_ifstId, jni_ifst);
+ (*env)->SetIntField(env, ilst, jni_ilstId, jni_ilst);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgsen (JNIEnv * env, jobject calling_obj, jint ijob, jboolean wantq, jboolean wantz, jbooleanArray select, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray alphar, jfloatArray alphai, jfloatArray beta, jfloatArray q, jint ldq, jfloatArray z, jint ldz, jobject m, jobject pl, jobject pr, jfloatArray dif, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ logical jni_wantq = (logical)wantq;
+ logical jni_wantz = (logical)wantz;
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alphar = (*env)->GetPrimitiveArrayCritical(env, alphar, JNI_FALSE);
+ check_memory(env, jni_alphar);
+ jfloat * jni_alphai = (*env)->GetPrimitiveArrayCritical(env, alphai, JNI_FALSE);
+ check_memory(env, jni_alphai);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_z = (*env)->GetPrimitiveArrayCritical(env, z, JNI_FALSE);
+ check_memory(env, jni_z);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jclass jni_plClass = (*env)->GetObjectClass(env, pl);
+ jfieldID jni_plId = (*env)->GetFieldID(env, jni_plClass, "val", "D");
+ jfloat jni_pl = (*env)->GetFloatField(env, pl, jni_plId);
+ jclass jni_prClass = (*env)->GetObjectClass(env, pr);
+ jfieldID jni_prId = (*env)->GetFieldID(env, jni_prClass, "val", "D");
+ jfloat jni_pr = (*env)->GetFloatField(env, pr, jni_prId);
+ jfloat * jni_dif = (*env)->GetPrimitiveArrayCritical(env, dif, JNI_FALSE);
+ check_memory(env, jni_dif);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ stgsen_(&ijob, &jni_wantq, &jni_wantz, jni_select, &n, jni_a, &lda, jni_b, &ldb, jni_alphar, jni_alphai, jni_beta, jni_q, &ldq, jni_z, &ldz, &jni_m, &jni_pl, &jni_pr, jni_dif, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphar, jni_alphar, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alphai, jni_alphai, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, z, jni_z, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->SetFloatField(env, pl, jni_plId, jni_pl);
+ (*env)->SetFloatField(env, pr, jni_prId, jni_pr);
+ (*env)->ReleasePrimitiveArrayCritical(env, dif, jni_dif, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgsja (JNIEnv * env, jobject calling_obj, jstring jobu, jstring jobv, jstring jobq, jint m, jint p, jint n, jint k, jint l, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloat tola, jfloat tolb, jfloatArray alpha, jfloatArray beta, jfloatArray u, jint ldu, jfloatArray v, jint ldv, jfloatArray q, jint ldq, jfloatArray work, jobject ncycle, jobject info){
+ char * jni_jobu = (char *)(*env)->GetStringUTFChars(env, jobu, JNI_FALSE);
+ char * jni_jobv = (char *)(*env)->GetStringUTFChars(env, jobv, JNI_FALSE);
+ char * jni_jobq = (char *)(*env)->GetStringUTFChars(env, jobq, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_alpha = (*env)->GetPrimitiveArrayCritical(env, alpha, JNI_FALSE);
+ check_memory(env, jni_alpha);
+ jfloat * jni_beta = (*env)->GetPrimitiveArrayCritical(env, beta, JNI_FALSE);
+ check_memory(env, jni_beta);
+ jfloat * jni_u = (*env)->GetPrimitiveArrayCritical(env, u, JNI_FALSE);
+ check_memory(env, jni_u);
+ jfloat * jni_v = (*env)->GetPrimitiveArrayCritical(env, v, JNI_FALSE);
+ check_memory(env, jni_v);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_ncycleClass = (*env)->GetObjectClass(env, ncycle);
+ jfieldID jni_ncycleId = (*env)->GetFieldID(env, jni_ncycleClass, "val", "I");
+ jint jni_ncycle = (*env)->GetIntField(env, ncycle, jni_ncycleId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stgsja_(jni_jobu, jni_jobv, jni_jobq, &m, &p, &n, &k, &l, jni_a, &lda, jni_b, &ldb, &tola, &tolb, jni_alpha, jni_beta, jni_u, &ldu, jni_v, &ldv, jni_q, &ldq, jni_work, &jni_ncycle, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, jobu, jni_jobu);
+ (*env)->ReleaseStringUTFChars(env, jobv, jni_jobv);
+ (*env)->ReleaseStringUTFChars(env, jobq, jni_jobq);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, alpha, jni_alpha, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, beta, jni_beta, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, u, jni_u, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, v, jni_v, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, ncycle, jni_ncycleId, jni_ncycle);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgsna (JNIEnv * env, jobject calling_obj, jstring job, jstring howmny, jbooleanArray select, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jfloatArray s, jfloatArray dif, jint mm, jobject m, jfloatArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_dif = (*env)->GetPrimitiveArrayCritical(env, dif, JNI_FALSE);
+ check_memory(env, jni_dif);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ stgsna_(jni_job, jni_howmny, jni_select, &n, jni_a, &lda, jni_b, &ldb, jni_vl, &ldvl, jni_vr, &ldvr, jni_s, jni_dif, &mm, &jni_m, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, dif, jni_dif, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgsy2 (JNIEnv * env, jobject calling_obj, jstring trans, jint ijob, jint m, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray c, jint Ldc, jfloatArray d, jint ldd, jfloatArray e, jint lde, jfloatArray f, jint ldf, jobject scale, jobject rdsum, jobject rdscal, jintArray iwork, jobject pq, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_f = (*env)->GetPrimitiveArrayCritical(env, f, JNI_FALSE);
+ check_memory(env, jni_f);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jclass jni_rdsumClass = (*env)->GetObjectClass(env, rdsum);
+ jfieldID jni_rdsumId = (*env)->GetFieldID(env, jni_rdsumClass, "val", "D");
+ jfloat jni_rdsum = (*env)->GetFloatField(env, rdsum, jni_rdsumId);
+ jclass jni_rdscalClass = (*env)->GetObjectClass(env, rdscal);
+ jfieldID jni_rdscalId = (*env)->GetFieldID(env, jni_rdscalClass, "val", "D");
+ jfloat jni_rdscal = (*env)->GetFloatField(env, rdscal, jni_rdscalId);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_pqClass = (*env)->GetObjectClass(env, pq);
+ jfieldID jni_pqId = (*env)->GetFieldID(env, jni_pqClass, "val", "I");
+ jint jni_pq = (*env)->GetIntField(env, pq, jni_pqId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stgsy2_(jni_trans, &ijob, &m, &n, jni_a, &lda, jni_b, &ldb, jni_c, &Ldc, jni_d, &ldd, jni_e, &lde, jni_f, &ldf, &jni_scale, &jni_rdsum, &jni_rdscal, jni_iwork, &jni_pq, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, f, jni_f, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetFloatField(env, rdsum, jni_rdsumId, jni_rdsum);
+ (*env)->SetFloatField(env, rdscal, jni_rdscalId, jni_rdscal);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, pq, jni_pqId, jni_pq);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stgsyl (JNIEnv * env, jobject calling_obj, jstring trans, jint ijob, jint m, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray c, jint Ldc, jfloatArray d, jint ldd, jfloatArray e, jint lde, jfloatArray f, jint ldf, jobject scale, jobject dif, jfloatArray work, jint lwork, jintArray iwork, jobject info){
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jfloat * jni_d = (*env)->GetPrimitiveArrayCritical(env, d, JNI_FALSE);
+ check_memory(env, jni_d);
+ jfloat * jni_e = (*env)->GetPrimitiveArrayCritical(env, e, JNI_FALSE);
+ check_memory(env, jni_e);
+ jfloat * jni_f = (*env)->GetPrimitiveArrayCritical(env, f, JNI_FALSE);
+ check_memory(env, jni_f);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jclass jni_difClass = (*env)->GetObjectClass(env, dif);
+ jfieldID jni_difId = (*env)->GetFieldID(env, jni_difClass, "val", "D");
+ jfloat jni_dif = (*env)->GetFloatField(env, dif, jni_difId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stgsyl_(jni_trans, &ijob, &m, &n, jni_a, &lda, jni_b, &ldb, jni_c, &Ldc, jni_d, &ldd, jni_e, &lde, jni_f, &ldf, &jni_scale, &jni_dif, jni_work, &lwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, d, jni_d, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, e, jni_e, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, f, jni_f, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetFloatField(env, dif, jni_difId, jni_dif);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stpcon (JNIEnv * env, jobject calling_obj, jstring norm, jstring uplo, jstring diag, jint n, jfloatArray ap, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stpcon_(jni_norm, jni_uplo, jni_diag, &n, jni_ap, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stprfs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jfloatArray ap, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stprfs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_ap, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stptri (JNIEnv * env, jobject calling_obj, jstring uplo, jstring diag, jint n, jfloatArray ap, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stptri_(jni_uplo, jni_diag, &n, jni_ap, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stptrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jfloatArray ap, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_ap = (*env)->GetPrimitiveArrayCritical(env, ap, JNI_FALSE);
+ check_memory(env, jni_ap);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stptrs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_ap, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, ap, jni_ap, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strcon (JNIEnv * env, jobject calling_obj, jstring norm, jstring uplo, jstring diag, jint n, jfloatArray a, jint lda, jobject rcond, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_norm = (char *)(*env)->GetStringUTFChars(env, norm, JNI_FALSE);
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_rcondClass = (*env)->GetObjectClass(env, rcond);
+ jfieldID jni_rcondId = (*env)->GetFieldID(env, jni_rcondClass, "val", "D");
+ jfloat jni_rcond = (*env)->GetFloatField(env, rcond, jni_rcondId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strcon_(jni_norm, jni_uplo, jni_diag, &n, jni_a, &lda, &jni_rcond, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, norm, jni_norm);
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetFloatField(env, rcond, jni_rcondId, jni_rcond);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strevc (JNIEnv * env, jobject calling_obj, jstring side, jstring howmny, jbooleanArray select, jint n, jfloatArray t, jint ldt, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jint mm, jobject m, jfloatArray work, jobject info){
+ char * jni_side = (char *)(*env)->GetStringUTFChars(env, side, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ strevc_(jni_side, jni_howmny, jni_select, &n, jni_t, &ldt, jni_vl, &ldvl, jni_vr, &ldvr, &mm, &jni_m, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, side, jni_side);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strexc (JNIEnv * env, jobject calling_obj, jstring compq, jint n, jfloatArray t, jint ldt, jfloatArray q, jint ldq, jobject ifst, jobject ilst, jfloatArray work, jobject info){
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jclass jni_ifstClass = (*env)->GetObjectClass(env, ifst);
+ jfieldID jni_ifstId = (*env)->GetFieldID(env, jni_ifstClass, "val", "I");
+ jint jni_ifst = (*env)->GetIntField(env, ifst, jni_ifstId);
+ jclass jni_ilstClass = (*env)->GetObjectClass(env, ilst);
+ jfieldID jni_ilstId = (*env)->GetFieldID(env, jni_ilstClass, "val", "I");
+ jint jni_ilst = (*env)->GetIntField(env, ilst, jni_ilstId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strexc_(jni_compq, &n, jni_t, &ldt, jni_q, &ldq, &jni_ifst, &jni_ilst, jni_work, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->SetIntField(env, ifst, jni_ifstId, jni_ifst);
+ (*env)->SetIntField(env, ilst, jni_ilstId, jni_ilst);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strrfs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray x, jint ldx, jfloatArray ferr, jfloatArray berr, jfloatArray work, jintArray iwork, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
+ check_memory(env, jni_x);
+ jfloat * jni_ferr = (*env)->GetPrimitiveArrayCritical(env, ferr, JNI_FALSE);
+ check_memory(env, jni_ferr);
+ jfloat * jni_berr = (*env)->GetPrimitiveArrayCritical(env, berr, JNI_FALSE);
+ check_memory(env, jni_berr);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strrfs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_a, &lda, jni_b, &ldb, jni_x, &ldx, jni_ferr, jni_berr, jni_work, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, ferr, jni_ferr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, berr, jni_berr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strsen (JNIEnv * env, jobject calling_obj, jstring job, jstring compq, jbooleanArray select, jint n, jfloatArray t, jint ldt, jfloatArray q, jint ldq, jfloatArray wr, jfloatArray wi, jobject m, jobject s, jobject sep, jfloatArray work, jint lwork, jintArray iwork, jint liwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_compq = (char *)(*env)->GetStringUTFChars(env, compq, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_q = (*env)->GetPrimitiveArrayCritical(env, q, JNI_FALSE);
+ check_memory(env, jni_q);
+ jfloat * jni_wr = (*env)->GetPrimitiveArrayCritical(env, wr, JNI_FALSE);
+ check_memory(env, jni_wr);
+ jfloat * jni_wi = (*env)->GetPrimitiveArrayCritical(env, wi, JNI_FALSE);
+ check_memory(env, jni_wi);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jclass jni_sClass = (*env)->GetObjectClass(env, s);
+ jfieldID jni_sId = (*env)->GetFieldID(env, jni_sClass, "val", "D");
+ jfloat jni_s = (*env)->GetFloatField(env, s, jni_sId);
+ jclass jni_sepClass = (*env)->GetObjectClass(env, sep);
+ jfieldID jni_sepId = (*env)->GetFieldID(env, jni_sepClass, "val", "D");
+ jfloat jni_sep = (*env)->GetFloatField(env, sep, jni_sepId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ strsen_(jni_job, jni_compq, jni_select, &n, jni_t, &ldt, jni_q, &ldq, jni_wr, jni_wi, &jni_m, &jni_s, &jni_sep, jni_work, &lwork, jni_iwork, &liwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, compq, jni_compq);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, q, jni_q, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wr, jni_wr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, wi, jni_wi, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->SetFloatField(env, s, jni_sId, jni_s);
+ (*env)->SetFloatField(env, sep, jni_sepId, jni_sep);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strsna (JNIEnv * env, jobject calling_obj, jstring job, jstring howmny, jbooleanArray select, jint n, jfloatArray t, jint ldt, jfloatArray vl, jint ldvl, jfloatArray vr, jint ldvr, jfloatArray s, jfloatArray sep, jint mm, jobject m, jfloatArray work, jint ldwork, jintArray iwork, jobject info){
+ char * jni_job = (char *)(*env)->GetStringUTFChars(env, job, JNI_FALSE);
+ char * jni_howmny = (char *)(*env)->GetStringUTFChars(env, howmny, JNI_FALSE);
+ jboolean * jni_selectTmp = (*env)->GetPrimitiveArrayCritical(env, select, JNI_FALSE);
+ jint jni_selectSize = (*env)->GetArrayLength(env, select);
+ logical jni_select[jni_selectSize];
+ int jni_selecti;
+ jfloat * jni_t = (*env)->GetPrimitiveArrayCritical(env, t, JNI_FALSE);
+ check_memory(env, jni_t);
+ jfloat * jni_vl = (*env)->GetPrimitiveArrayCritical(env, vl, JNI_FALSE);
+ check_memory(env, jni_vl);
+ jfloat * jni_vr = (*env)->GetPrimitiveArrayCritical(env, vr, JNI_FALSE);
+ check_memory(env, jni_vr);
+ jfloat * jni_s = (*env)->GetPrimitiveArrayCritical(env, s, JNI_FALSE);
+ check_memory(env, jni_s);
+ jfloat * jni_sep = (*env)->GetPrimitiveArrayCritical(env, sep, JNI_FALSE);
+ check_memory(env, jni_sep);
+ jclass jni_mClass = (*env)->GetObjectClass(env, m);
+ jfieldID jni_mId = (*env)->GetFieldID(env, jni_mClass, "val", "I");
+ jint jni_m = (*env)->GetIntField(env, m, jni_mId);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jint * jni_iwork = (*env)->GetPrimitiveArrayCritical(env, iwork, JNI_FALSE);
+ check_memory(env, jni_iwork);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_selectTmp[jni_selecti] == JNI_FALSE){
+ jni_select[jni_selecti] = 0;
+ } else {
+ jni_select[jni_selecti] = 1;
+ }
+ }
+
+ strsna_(jni_job, jni_howmny, jni_select, &n, jni_t, &ldt, jni_vl, &ldvl, jni_vr, &ldvr, jni_s, jni_sep, &mm, &jni_m, jni_work, &ldwork, jni_iwork, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, job, jni_job);
+ (*env)->ReleaseStringUTFChars(env, howmny, jni_howmny);
+ for (jni_selecti = 0 ; jni_selecti < jni_selectSize ; jni_selecti++){
+ if (jni_select[jni_selecti] == 0){
+ jni_selectTmp[jni_selecti] = JNI_FALSE;
+ } else {
+ jni_selectTmp[jni_selecti] = JNI_TRUE;
+ }
+ }
+ (*env)->ReleasePrimitiveArrayCritical(env, select, jni_selectTmp, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, t, jni_t, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vl, jni_vl, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, vr, jni_vr, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, s, jni_s, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, sep, jni_sep, 0);
+ (*env)->SetIntField(env, m, jni_mId, jni_m);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, iwork, jni_iwork, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strsyl (JNIEnv * env, jobject calling_obj, jstring trana, jstring tranb, jint isgn, jint m, jint n, jfloatArray a, jint lda, jfloatArray b, jint ldb, jfloatArray c, jint Ldc, jobject scale, jobject info){
+ char * jni_trana = (char *)(*env)->GetStringUTFChars(env, trana, JNI_FALSE);
+ char * jni_tranb = (char *)(*env)->GetStringUTFChars(env, tranb, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jfloat * jni_c = (*env)->GetPrimitiveArrayCritical(env, c, JNI_FALSE);
+ check_memory(env, jni_c);
+ jclass jni_scaleClass = (*env)->GetObjectClass(env, scale);
+ jfieldID jni_scaleId = (*env)->GetFieldID(env, jni_scaleClass, "val", "D");
+ jfloat jni_scale = (*env)->GetFloatField(env, scale, jni_scaleId);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strsyl_(jni_trana, jni_tranb, &isgn, &m, &n, jni_a, &lda, jni_b, &ldb, jni_c, &Ldc, &jni_scale, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, trana, jni_trana);
+ (*env)->ReleaseStringUTFChars(env, tranb, jni_tranb);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, c, jni_c, 0);
+ (*env)->SetFloatField(env, scale, jni_scaleId, jni_scale);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strti2 (JNIEnv * env, jobject calling_obj, jstring uplo, jstring diag, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strti2_(jni_uplo, jni_diag, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strtri (JNIEnv * env, jobject calling_obj, jstring uplo, jstring diag, jint n, jfloatArray a, jint lda, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strtri_(jni_uplo, jni_diag, &n, jni_a, &lda, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_strtrs (JNIEnv * env, jobject calling_obj, jstring uplo, jstring trans, jstring diag, jint n, jint nrhs, jfloatArray a, jint lda, jfloatArray b, jint ldb, jobject info){
+ char * jni_uplo = (char *)(*env)->GetStringUTFChars(env, uplo, JNI_FALSE);
+ char * jni_trans = (char *)(*env)->GetStringUTFChars(env, trans, JNI_FALSE);
+ char * jni_diag = (char *)(*env)->GetStringUTFChars(env, diag, JNI_FALSE);
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_b = (*env)->GetPrimitiveArrayCritical(env, b, JNI_FALSE);
+ check_memory(env, jni_b);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ strtrs_(jni_uplo, jni_trans, jni_diag, &n, &nrhs, jni_a, &lda, jni_b, &ldb, &jni_info);
+
+ (*env)->ReleaseStringUTFChars(env, uplo, jni_uplo);
+ (*env)->ReleaseStringUTFChars(env, trans, jni_trans);
+ (*env)->ReleaseStringUTFChars(env, diag, jni_diag);
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, b, jni_b, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stzrqf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stzrqf_(&m, &n, jni_a, &lda, jni_tau, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_stzrzf (JNIEnv * env, jobject calling_obj, jint m, jint n, jfloatArray a, jint lda, jfloatArray tau, jfloatArray work, jint lwork, jobject info){
+ jfloat * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);
+ check_memory(env, jni_a);
+ jfloat * jni_tau = (*env)->GetPrimitiveArrayCritical(env, tau, JNI_FALSE);
+ check_memory(env, jni_tau);
+ jfloat * jni_work = (*env)->GetPrimitiveArrayCritical(env, work, JNI_FALSE);
+ check_memory(env, jni_work);
+ jclass jni_infoClass = (*env)->GetObjectClass(env, info);
+ jfieldID jni_infoId = (*env)->GetFieldID(env, jni_infoClass, "val", "I");
+ jint jni_info = (*env)->GetIntField(env, info, jni_infoId);
+
+ stzrzf_(&m, &n, jni_a, &lda, jni_tau, jni_work, &lwork, &jni_info);
+
+ (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, tau, jni_tau, 0);
+ (*env)->ReleasePrimitiveArrayCritical(env, work, jni_work, 0);
+ (*env)->SetIntField(env, info, jni_infoId, jni_info);
+}
+
+JNIEXPORT jdouble JNICALL Java_org_netlib_lapack_NativeLAPACK_dlamch (JNIEnv * env, jobject calling_obj, jstring cmach){
+ char * jni_cmach = (char *)(*env)->GetStringUTFChars(env, cmach, JNI_FALSE);
+ jdouble returnValue;
+
+ returnValue = dlamch_(jni_cmach);
+
+ (*env)->ReleaseStringUTFChars(env, cmach, jni_cmach);
+
+ return returnValue;
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlamc1 (JNIEnv * env, jobject calling_obj, jobject beta, jobject t, jobject rnd, jobject ieee1){
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "I");
+ jint jni_beta = (*env)->GetIntField(env, beta, jni_betaId);
+ jclass jni_tClass = (*env)->GetObjectClass(env, t);
+ jfieldID jni_tId = (*env)->GetFieldID(env, jni_tClass, "val", "I");
+ jint jni_t = (*env)->GetIntField(env, t, jni_tId);
+ jclass jni_rndClass = (*env)->GetObjectClass(env, rnd);
+ jfieldID jni_rndId = (*env)->GetFieldID(env, jni_rndClass, "val", "I");
+ jboolean jni_rndBoolean = (*env)->GetBooleanField(env, rnd, jni_rndId);
+ logical jni_rnd = (logical)jni_rndBoolean;
+ jclass jni_ieee1Class = (*env)->GetObjectClass(env, ieee1);
+ jfieldID jni_ieee1Id = (*env)->GetFieldID(env, jni_ieee1Class, "val", "I");
+ jboolean jni_ieee1Boolean = (*env)->GetBooleanField(env, ieee1, jni_ieee1Id);
+ logical jni_ieee1 = (logical)jni_ieee1Boolean;
+
+ dlamc1_(&jni_beta, &jni_t, &jni_rnd, &jni_ieee1);
+
+ (*env)->SetIntField(env, beta, jni_betaId, jni_beta);
+ (*env)->SetIntField(env, t, jni_tId, jni_t);
+ (*env)->SetBooleanField(env, rnd, jni_rndId, (jboolean)jni_rnd);
+ (*env)->SetBooleanField(env, ieee1, jni_ieee1Id, (jboolean)jni_ieee1);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlamc2 (JNIEnv * env, jobject calling_obj, jobject beta, jobject t, jobject rnd, jobject eps, jobject emin, jobject rmin, jobject emax, jobject rmax){
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "I");
+ jint jni_beta = (*env)->GetIntField(env, beta, jni_betaId);
+ jclass jni_tClass = (*env)->GetObjectClass(env, t);
+ jfieldID jni_tId = (*env)->GetFieldID(env, jni_tClass, "val", "I");
+ jint jni_t = (*env)->GetIntField(env, t, jni_tId);
+ jclass jni_rndClass = (*env)->GetObjectClass(env, rnd);
+ jfieldID jni_rndId = (*env)->GetFieldID(env, jni_rndClass, "val", "I");
+ jboolean jni_rndBoolean = (*env)->GetBooleanField(env, rnd, jni_rndId);
+ logical jni_rnd = (logical)jni_rndBoolean;
+ jclass jni_epsClass = (*env)->GetObjectClass(env, eps);
+ jfieldID jni_epsId = (*env)->GetFieldID(env, jni_epsClass, "val", "D");
+ jdouble jni_eps = (*env)->GetDoubleField(env, eps, jni_epsId);
+ jclass jni_eminClass = (*env)->GetObjectClass(env, emin);
+ jfieldID jni_eminId = (*env)->GetFieldID(env, jni_eminClass, "val", "I");
+ jint jni_emin = (*env)->GetIntField(env, emin, jni_eminId);
+ jclass jni_rminClass = (*env)->GetObjectClass(env, rmin);
+ jfieldID jni_rminId = (*env)->GetFieldID(env, jni_rminClass, "val", "D");
+ jdouble jni_rmin = (*env)->GetDoubleField(env, rmin, jni_rminId);
+ jclass jni_emaxClass = (*env)->GetObjectClass(env, emax);
+ jfieldID jni_emaxId = (*env)->GetFieldID(env, jni_emaxClass, "val", "I");
+ jint jni_emax = (*env)->GetIntField(env, emax, jni_emaxId);
+ jclass jni_rmaxClass = (*env)->GetObjectClass(env, rmax);
+ jfieldID jni_rmaxId = (*env)->GetFieldID(env, jni_rmaxClass, "val", "D");
+ jdouble jni_rmax = (*env)->GetDoubleField(env, rmax, jni_rmaxId);
+
+ dlamc2_(&jni_beta, &jni_t, &jni_rnd, &jni_eps, &jni_emin, &jni_rmin, &jni_emax, &jni_rmax);
+
+ (*env)->SetIntField(env, beta, jni_betaId, jni_beta);
+ (*env)->SetIntField(env, t, jni_tId, jni_t);
+ (*env)->SetBooleanField(env, rnd, jni_rndId, (jboolean)jni_rnd);
+ (*env)->SetDoubleField(env, eps, jni_epsId, jni_eps);
+ (*env)->SetIntField(env, emin, jni_eminId, jni_emin);
+ (*env)->SetDoubleField(env, rmin, jni_rminId, jni_rmin);
+ (*env)->SetIntField(env, emax, jni_emaxId, jni_emax);
+ (*env)->SetDoubleField(env, rmax, jni_rmaxId, jni_rmax);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlamc4 (JNIEnv * env, jobject calling_obj, jobject emin, jdouble start, jint base){
+ jclass jni_eminClass = (*env)->GetObjectClass(env, emin);
+ jfieldID jni_eminId = (*env)->GetFieldID(env, jni_eminClass, "val", "I");
+ jint jni_emin = (*env)->GetIntField(env, emin, jni_eminId);
+
+ dlamc4_(&jni_emin, &start, &base);
+
+ (*env)->SetIntField(env, emin, jni_eminId, jni_emin);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_dlamc5 (JNIEnv * env, jobject calling_obj, jint beta, jint p, jint emin, jboolean ieee, jobject emax, jobject rmax){
+ logical jni_ieee = (logical)ieee;
+ jclass jni_emaxClass = (*env)->GetObjectClass(env, emax);
+ jfieldID jni_emaxId = (*env)->GetFieldID(env, jni_emaxClass, "val", "I");
+ jint jni_emax = (*env)->GetIntField(env, emax, jni_emaxId);
+ jclass jni_rmaxClass = (*env)->GetObjectClass(env, rmax);
+ jfieldID jni_rmaxId = (*env)->GetFieldID(env, jni_rmaxClass, "val", "D");
+ jdouble jni_rmax = (*env)->GetDoubleField(env, rmax, jni_rmaxId);
+
+ dlamc5_(&beta, &p, &emin, &jni_ieee, &jni_emax, &jni_rmax);
+
+ (*env)->SetIntField(env, emax, jni_emaxId, jni_emax);
+ (*env)->SetDoubleField(env, rmax, jni_rmaxId, jni_rmax);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slamc1 (JNIEnv * env, jobject calling_obj, jobject beta, jobject t, jobject rnd, jobject ieee1){
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "I");
+ jint jni_beta = (*env)->GetIntField(env, beta, jni_betaId);
+ jclass jni_tClass = (*env)->GetObjectClass(env, t);
+ jfieldID jni_tId = (*env)->GetFieldID(env, jni_tClass, "val", "I");
+ jint jni_t = (*env)->GetIntField(env, t, jni_tId);
+ jclass jni_rndClass = (*env)->GetObjectClass(env, rnd);
+ jfieldID jni_rndId = (*env)->GetFieldID(env, jni_rndClass, "val", "I");
+ jboolean jni_rndBoolean = (*env)->GetBooleanField(env, rnd, jni_rndId);
+ logical jni_rnd = (logical)jni_rndBoolean;
+ jclass jni_ieee1Class = (*env)->GetObjectClass(env, ieee1);
+ jfieldID jni_ieee1Id = (*env)->GetFieldID(env, jni_ieee1Class, "val", "I");
+ jboolean jni_ieee1Boolean = (*env)->GetBooleanField(env, ieee1, jni_ieee1Id);
+ logical jni_ieee1 = (logical)jni_ieee1Boolean;
+
+ slamc1_(&jni_beta, &jni_t, &jni_rnd, &jni_ieee1);
+
+ (*env)->SetIntField(env, beta, jni_betaId, jni_beta);
+ (*env)->SetIntField(env, t, jni_tId, jni_t);
+ (*env)->SetBooleanField(env, rnd, jni_rndId, (jboolean)jni_rnd);
+ (*env)->SetBooleanField(env, ieee1, jni_ieee1Id, (jboolean)jni_ieee1);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slamc2 (JNIEnv * env, jobject calling_obj, jobject beta, jobject t, jobject rnd, jobject eps, jobject emin, jobject rmin, jobject emax, jobject rmax){
+ jclass jni_betaClass = (*env)->GetObjectClass(env, beta);
+ jfieldID jni_betaId = (*env)->GetFieldID(env, jni_betaClass, "val", "I");
+ jint jni_beta = (*env)->GetIntField(env, beta, jni_betaId);
+ jclass jni_tClass = (*env)->GetObjectClass(env, t);
+ jfieldID jni_tId = (*env)->GetFieldID(env, jni_tClass, "val", "I");
+ jint jni_t = (*env)->GetIntField(env, t, jni_tId);
+ jclass jni_rndClass = (*env)->GetObjectClass(env, rnd);
+ jfieldID jni_rndId = (*env)->GetFieldID(env, jni_rndClass, "val", "I");
+ jboolean jni_rndBoolean = (*env)->GetBooleanField(env, rnd, jni_rndId);
+ logical jni_rnd = (logical)jni_rndBoolean;
+ jclass jni_epsClass = (*env)->GetObjectClass(env, eps);
+ jfieldID jni_epsId = (*env)->GetFieldID(env, jni_epsClass, "val", "D");
+ jfloat jni_eps = (*env)->GetFloatField(env, eps, jni_epsId);
+ jclass jni_eminClass = (*env)->GetObjectClass(env, emin);
+ jfieldID jni_eminId = (*env)->GetFieldID(env, jni_eminClass, "val", "I");
+ jint jni_emin = (*env)->GetIntField(env, emin, jni_eminId);
+ jclass jni_rminClass = (*env)->GetObjectClass(env, rmin);
+ jfieldID jni_rminId = (*env)->GetFieldID(env, jni_rminClass, "val", "D");
+ jfloat jni_rmin = (*env)->GetFloatField(env, rmin, jni_rminId);
+ jclass jni_emaxClass = (*env)->GetObjectClass(env, emax);
+ jfieldID jni_emaxId = (*env)->GetFieldID(env, jni_emaxClass, "val", "I");
+ jint jni_emax = (*env)->GetIntField(env, emax, jni_emaxId);
+ jclass jni_rmaxClass = (*env)->GetObjectClass(env, rmax);
+ jfieldID jni_rmaxId = (*env)->GetFieldID(env, jni_rmaxClass, "val", "D");
+ jfloat jni_rmax = (*env)->GetFloatField(env, rmax, jni_rmaxId);
+
+ slamc2_(&jni_beta, &jni_t, &jni_rnd, &jni_eps, &jni_emin, &jni_rmin, &jni_emax, &jni_rmax);
+
+ (*env)->SetIntField(env, beta, jni_betaId, jni_beta);
+ (*env)->SetIntField(env, t, jni_tId, jni_t);
+ (*env)->SetBooleanField(env, rnd, jni_rndId, (jboolean)jni_rnd);
+ (*env)->SetFloatField(env, eps, jni_epsId, jni_eps);
+ (*env)->SetIntField(env, emin, jni_eminId, jni_emin);
+ (*env)->SetFloatField(env, rmin, jni_rminId, jni_rmin);
+ (*env)->SetIntField(env, emax, jni_emaxId, jni_emax);
+ (*env)->SetFloatField(env, rmax, jni_rmaxId, jni_rmax);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slamc4 (JNIEnv * env, jobject calling_obj, jobject emin, jfloat start, jint base){
+ jclass jni_eminClass = (*env)->GetObjectClass(env, emin);
+ jfieldID jni_eminId = (*env)->GetFieldID(env, jni_eminClass, "val", "I");
+ jint jni_emin = (*env)->GetIntField(env, emin, jni_eminId);
+
+ slamc4_(&jni_emin, &start, &base);
+
+ (*env)->SetIntField(env, emin, jni_eminId, jni_emin);
+}
+
+JNIEXPORT void JNICALL Java_org_netlib_lapack_NativeLAPACK_slamc5 (JNIEnv * env, jobject calling_obj, jint beta, jint p, jint emin, jboolean ieee, jobject emax, jobject rmax){
+ logical jni_ieee = (logical)ieee;
+ jclass jni_emaxClass = (*env)->GetObjectClass(env, emax);
+ jfieldID jni_emaxId = (*env)->GetFieldID(env, jni_emaxClass, "val", "I");
+ jint jni_emax = (*env)->GetIntField(env, emax, jni_emaxId);
+ jclass jni_rmaxClass = (*env)->GetObjectClass(env, rmax);
+ jfieldID jni_rmaxId = (*env)->GetFieldID(env, jni_rmaxClass, "val", "D");
+ jfloat jni_rmax = (*env)->GetFloatField(env, rmax, jni_rmaxId);
+
+ slamc5_(&beta, &p, &emin, &jni_ieee, &jni_emax, &jni_rmax);
+
+ (*env)->SetIntField(env, emax, jni_emaxId, jni_emax);
+ (*env)->SetFloatField(env, rmax, jni_rmaxId, jni_rmax);
+}
+
diff --git a/legacy/pom.xml b/legacy/pom.xml
deleted file mode 100644
index ce29c17..0000000
--- a/legacy/pom.xml
+++ /dev/null
@@ -1,37 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <groupId>com.googlecode.netlib-java</groupId>
- <artifactId>netlib-java</artifactId>
- <packaging>jar</packaging>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>core</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/legacy/src/main/java/org/netlib/arpack/ARPACK.java b/legacy/src/main/java/org/netlib/arpack/ARPACK.java
deleted file mode 100644
index 1a5447b..0000000
--- a/legacy/src/main/java/org/netlib/arpack/ARPACK.java
+++ /dev/null
@@ -1,31 +0,0 @@
-package org.netlib.arpack;
-
-import lombok.AccessLevel;
-import lombok.Delegate;
-import lombok.NoArgsConstructor;
-import lombok.extern.java.Log;
-
-/**
- * @deprecated use {@link com.github.fommil.netlib.ARPACK}
- */
- at Deprecated
- at NoArgsConstructor(access = AccessLevel.PRIVATE)
- at Log
-public class ARPACK extends com.github.fommil.netlib.ARPACK {
-
- private static final ARPACK INSTANCE = new ARPACK();
-
- /**
- * @return
- * @deprecated use {@link com.github.fommil.netlib.BLAS#getInstance()}
- */
- @Deprecated
- public static ARPACK getInstance() {
- log.warning("this API is deprecated and will be removed. Instead, use com.github.fommil.netlib.ARPACK");
- return INSTANCE;
- }
-
- @Delegate
- private final com.github.fommil.netlib.ARPACK DELEGATE = com.github.fommil.netlib.ARPACK.getInstance();
-
-}
diff --git a/legacy/src/main/java/org/netlib/blas/BLAS.java b/legacy/src/main/java/org/netlib/blas/BLAS.java
deleted file mode 100644
index 011c0ab..0000000
--- a/legacy/src/main/java/org/netlib/blas/BLAS.java
+++ /dev/null
@@ -1,31 +0,0 @@
-package org.netlib.blas;
-
-import lombok.AccessLevel;
-import lombok.Delegate;
-import lombok.NoArgsConstructor;
-import lombok.extern.java.Log;
-
-/**
- * @deprecated use {@link com.github.fommil.netlib.BLAS}
- */
- at Deprecated
- at NoArgsConstructor(access = AccessLevel.PRIVATE)
- at Log
-public class BLAS extends com.github.fommil.netlib.BLAS {
-
- private static final BLAS INSTANCE = new BLAS();
-
- /**
- * @return
- * @deprecated use {@link com.github.fommil.netlib.BLAS#getInstance()}
- */
- @Deprecated
- public static BLAS getInstance() {
- log.warning("this API is deprecated and will be removed. Instead, use com.github.fommil.netlib.BLAS");
- return INSTANCE;
- }
-
- @Delegate
- private final com.github.fommil.netlib.BLAS DELEGATE = com.github.fommil.netlib.BLAS.getInstance();
-
-}
diff --git a/legacy/src/main/java/org/netlib/lapack/LAPACK.java b/legacy/src/main/java/org/netlib/lapack/LAPACK.java
deleted file mode 100644
index 6fb4f2f..0000000
--- a/legacy/src/main/java/org/netlib/lapack/LAPACK.java
+++ /dev/null
@@ -1,31 +0,0 @@
-package org.netlib.lapack;
-
-import lombok.AccessLevel;
-import lombok.Delegate;
-import lombok.NoArgsConstructor;
-import lombok.extern.java.Log;
-
-/**
- * @deprecated use {@link com.github.fommil.netlib.LAPACK}
- */
- at Deprecated
- at NoArgsConstructor(access = AccessLevel.PRIVATE)
- at Log
-public class LAPACK extends com.github.fommil.netlib.LAPACK {
-
- private static final LAPACK INSTANCE = new LAPACK();
-
- /**
- * @return
- * @deprecated use {@link com.github.fommil.netlib.LAPACK#getInstance()}
- */
- @Deprecated
- public static LAPACK getInstance() {
- log.warning("this API is deprecated and will be removed. Instead, use com.github.fommil.netlib.LAPACK");
- return INSTANCE;
- }
-
- @Delegate
- private final com.github.fommil.netlib.LAPACK DELEGATE = com.github.fommil.netlib.LAPACK.getInstance();
-
-}
diff --git a/lib/nblibraries.properties b/lib/nblibraries.properties
new file mode 100644
index 0000000..205566f
--- /dev/null
+++ b/lib/nblibraries.properties
@@ -0,0 +1,8 @@
+libs.f2j.classpath=\
+ ${base}/f2j/arpack-combo-0.1.jar
+libs.f2j.javadoc=\
+ ${base}/f2j/jlapack-0.8-javadoc.zip
+libs.junit.classpath=\
+ ${base}/junit/junit-3.8.2.jar
+libs.junit.javadoc=\
+ ${base}/junit/junit-3.8.2-api.zip
diff --git a/manifest.mf b/manifest.mf
new file mode 100644
index 0000000..328e8e5
--- /dev/null
+++ b/manifest.mf
@@ -0,0 +1,3 @@
+Manifest-Version: 1.0
+X-COMMENT: Main-Class will be added automatically by build
+
diff --git a/native_ref/java/pom.xml b/native_ref/java/pom.xml
deleted file mode 100644
index 708af44..0000000
--- a/native_ref/java/pom.xml
+++ /dev/null
@@ -1,92 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>native_ref-java</artifactId>
- <packaging>jar</packaging>
-
- <dependencies>
- <dependency>
- <groupId>com.github.fommil</groupId>
- <artifactId>jniloader</artifactId>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>core</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- </plugin>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <!--
- HACK: these override the parent executions of the same name
- and stop it from running.
- -->
- <id>blas</id>
- <goals>
- <goal>native-java</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/NativeRefBLAS.java</outputName>
- <scan>org.netlib.blas</scan>
- <implementing>com.github.fommil.netlib.BLAS</implementing>
- <extending>com.github.fommil.netlib.F2jBLAS</extending>
- <unsupported>${prefer.f2j}</unsupported>
- <natives>${natives}</natives>
- </configuration>
- </execution>
- <execution>
- <id>lapack</id>
- <goals>
- <goal>native-java</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/NativeRefLAPACK.java</outputName>
- <scan>org.netlib.lapack</scan>
- <implementing>com.github.fommil.netlib.LAPACK</implementing>
- <extending>com.github.fommil.netlib.F2jLAPACK</extending>
- <unsupported>${prefer.f2j}</unsupported>
- <natives>${natives}</natives>
- </configuration>
- </execution>
- <execution>
- <id>arpack</id>
- <goals>
- <goal>native-java</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/NativeRefARPACK.java</outputName>
- <scan>org.netlib.arpack</scan>
- <implementing>com.github.fommil.netlib.ARPACK</implementing>
- <extending>com.github.fommil.netlib.F2jARPACK</extending>
- <unsupported>${prefer.f2j}</unsupported>
- <natives>${natives}</natives>
- </configuration>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/osx-x86_64/pom.xml b/native_ref/osx-x86_64/pom.xml
deleted file mode 100644
index 2d1f4a3..0000000
--- a/native_ref/osx-x86_64/pom.xml
+++ /dev/null
@@ -1,95 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_ref-osx-x86_64</artifactId>
- <packaging>jnilib</packaging>
-
- <properties>
- <netlib.src>../../netlib</netlib.src>
- </properties>
-
- <!--
- NOTE: OS X does not come with a Fortran compiler.
- This configuration uses macports' distribution of gcc:
-
- sudo port install gfortran48
-
- To get the i5 AVX instructions, CLANG must be used for assembly
-
- http://stackoverflow.com/questions/9840207
-
- (although I haven't noticed much difference) with these extra GCC flags
-
- -Xassembler -w -march=corei7-avx -mtune=corei7-avx
- -->
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_ref-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>darwin</javahOS>
- <compilerExecutable>gcc-mp-4.8</compilerExecutable>
- <linkerExecutable>gcc-mp-4.8</linkerExecutable>
- <linkerMiddleOptions>
- <linkerMiddleOption>-dynamiclib</linkerMiddleOption>
- <linkerMiddleOption>-static-libgfortran</linkerMiddleOption>
- <linkerMiddleOption>/opt/local/lib/gcc48/libquadmath.a</linkerMiddleOption>
- <linkerMiddleOption>-static-libgcc</linkerMiddleOption>
- <linkerMiddleOption>-framework JavaVM</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-dead_strip</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-exported_symbol,_Java_*</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-x</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/pom.xml b/native_ref/pom.xml
deleted file mode 100644
index 6c9ad24..0000000
--- a/native_ref/pom.xml
+++ /dev/null
@@ -1,230 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>native_ref</artifactId>
- <packaging>pom</packaging>
-
- <modules>
- <module>java</module>
- <module>osx-x86_64</module>
- <module>win-i686</module>
- <module>win-x86_64</module>
- <!-- cross compiles are built separately on a Linux box... -->
- </modules>
-
- <properties>
- <natives>netlib-native_ref</natives>
- <!-- GEES etc needs an ill-defined callback -->
- <lapacke.callback>([ds](gees|gges|geesx|ggesx))</lapacke.callback>
- <!-- LSAME, SECOND etc are more efficient on the JVM -->
- <jvm.better>lsame|lsamen|second|dsecnd</jvm.better>
- <!-- LAPACK routines that do not have a named ARPACKE equivalent -->
- <lapacke.unsupported>(ieeeck|ilaenv|ilaver|iparmq|([sd](gbtf2|gebd2|gbtf2|gebd2|gegs|gegv|gehd2|gelsx|geql2|gerq2|gesc2|getc2|gtts2|isnan|labad|labrd|lacn2|lacon|ladiv|lae2|laebz|laed0|laed1|laed2|laed3|laed4|laed5|laed6|laed7|laed8|laed9|laeda|laein|laev2|laexc|lag2|lags2|lagtf|lagtm|lagts|lagv2|lahqr|lahr2|lahrd|laic1|laisnan|laln2|lals0|lalsa|lalsd|lamc1|lamc2|lamc3|lamc4|lamc5|lamrg|laneg|langb|langt|lanhs|lansb|lansp|lanst|lantb|lantp|lanv2|lapll|lapmt|laqgb|laqge|laqp2|laqp [...]
- <arpack.noprototypes>(dgetv0|dlaqrb|dmout|dnaitr|dnapps|dnaup2|dnconv|dneigh|dngets|dsaitr|dsapps|dsaup2|dsconv|dseigt|dsesrt|dsgets|dsortc|dsortr|dstatn|dstats|dstqrb|dvout|icnteq|icopy|iset|iswap|ivout|second|sgetv0|slaqrb|smout|snaitr|snapps|snaup2|snconv|sneigh|sngets|ssaitr|ssapps|ssaup2|ssconv|sseigt|ssesrt|ssgets|ssortc|ssortr|sstatn|sstats|sstqrb|svout)</arpack.noprototypes>
- <prefer.f2j>(${lapacke.callback}|${jvm.better}|${lapacke.unsupported}|${arpack.noprototypes})</prefer.f2j>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <classifier>javadoc</classifier>
- </dependency>
- </dependencies>
-
- <build>
- <pluginManagement>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- <goals>
- <goal>native-jni</goal>
- </goals>
- <configuration>
- <implementing>com.github.fommil.netlib.NativeRefBLAS</implementing>
- <outputDir>${project.build.directory}/netlib-native</outputDir>
- <outputName>com_github_fommil_netlib_NativeRefBLAS.c</outputName>
- <scan>org.netlib.blas</scan>
- <prefix>cblas_</prefix>
- <firstParam>CblasColMajor</firstParam>
- <noFirstParam>.*(dot|nrm2|asum|amax|swap|copy|rot|xpy|cal).*</noFirstParam>
- <exclude>${prefer.f2j}</exclude>
- <cblas_hack>true</cblas_hack>
- <includes>
- <param>cblas.h</param>
- </includes>
- </configuration>
- </execution>
- <execution>
- <id>lapack</id>
- <goals>
- <goal>native-jni</goal>
- </goals>
- <configuration>
- <implementing>com.github.fommil.netlib.NativeRefLAPACK</implementing>
- <outputDir>${project.build.directory}/netlib-native</outputDir>
- <outputName>com_github_fommil_netlib_NativeRefLAPACK.c</outputName>
- <scan>org.netlib.lapack</scan>
- <prefix>LAPACKE_</prefix>
- <suffix>_work</suffix>
- <firstParam>LAPACK_COL_MAJOR</firstParam>
- <noFirstParam>
- [sd](disna|gtcon|gttrf|lapy[23]|larfg|larnv|lasrt|ptcon|pttrf|stebz|sterf|lamch)
- </noFirstParam>
- <exclude>${prefer.f2j}</exclude>
- <extractChar>true</extractChar>
- <lapacke_hack>true</lapacke_hack>
- <includes>
- <param>lapacke.h</param>
- </includes>
- </configuration>
- </execution>
- <execution>
- <id>arpack</id>
- <goals>
- <goal>native-jni</goal>
- </goals>
- <configuration>
- <implementing>com.github.fommil.netlib.NativeRefARPACK</implementing>
- <outputDir>${project.build.directory}/netlib-native</outputDir>
- <outputName>com_github_fommil_netlib_NativeRefARPACK.c</outputName>
- <scan>org.netlib.arpack</scan>
- <suffix>_</suffix>
- <exclude>${prefer.f2j}</exclude>
- <extractChar>true</extractChar>
- <exclude>${prefer.f2j}</exclude>
- <fortran_hack>true</fortran_hack>
- <includes>
- <param>arpack.h</param>
- </includes>
- </configuration>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <configuration>
- <!-- numberOfConcurrentCompilation would be nice, but always fails :-( -->
- <!-- http://jira.codehaus.org/browse/MOJO-1955 -->
- <javahVerbose>true</javahVerbose>
- <javahClassNames>
- <javahClassName>com.github.fommil.netlib.NativeRefBLAS</javahClassName>
- <javahClassName>com.github.fommil.netlib.NativeRefLAPACK</javahClassName>
- <javahClassName>com.github.fommil.netlib.NativeRefARPACK</javahClassName>
- </javahClassNames>
- <compilerStartOptions>
- <compilerStartOption>-O3</compilerStartOption>
- </compilerStartOptions>
- <compilerMiddleOptions>
- <compilerMiddleOption>-Wall -fPIC -DADD_</compilerMiddleOption>
- <compilerMiddleOption>-fdata-sections</compilerMiddleOption>
- <compilerMiddleOption>-ffunction-sections</compilerMiddleOption>
- </compilerMiddleOptions>
- <linkerStartOptions>
- <linkerStartOption>-O3</linkerStartOption>
- </linkerStartOptions>
- <sources>
- <source>
- <directory>${project.build.directory}/netlib-native</directory>
- <includes>
- <include>*.c</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/JNI</directory>
- <includes>
- <include>*.c</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/BLAS</directory>
- <includes>
- <include>*.f</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/CBLAS</directory>
- <includes>
- <include>*.f</include>
- <include>*.c</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/LAPACK</directory>
- <includes>
- <include>*.f</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/LAPACKE</directory>
- <includes>
- <include>*.f</include>
- <include>*.c</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/ARPACK</directory>
- <includes>
- <include>*.f</include>
- </includes>
- </source>
- </sources>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- <phase>package</phase>
- <goals>
- <goal>jar</goal>
- </goals>
- <configuration>
- <classesDirectory>${project.build.directory}</classesDirectory>
- <includes>
- <include>${project.artifactId}.*</include>
- </includes>
- <classifier>natives</classifier>
- </configuration>
- </execution>
- <execution>
- <id>source</id>
- <phase>package</phase>
- <goals>
- <goal>jar</goal>
- </goals>
- <configuration>
- <classesDirectory>${project.build.directory}</classesDirectory>
- <includes>
- <include>netlib-native/**/*</include>
- <include>native/**/*</include>
- </includes>
- <classifier>sources</classifier>
- </configuration>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </pluginManagement>
- </build>
-</project>
diff --git a/native_ref/win-i686/pom.xml b/native_ref/win-i686/pom.xml
deleted file mode 100644
index b9b2777..0000000
--- a/native_ref/win-i686/pom.xml
+++ /dev/null
@@ -1,107 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_ref-win-i686</artifactId>
- <packaging>dll</packaging>
-
- <!--
- This build is cross-compiled from OS X using the official MinGW snapshot
- downloaded from (I used mingw-w64-bin_i686-darwin_20130622)
-
- http://sourceforge.net/projects/mingw-w64/
-
- with the Windows 32 bit JDK obtained as per
-
- http://www.oracle.com/technetwork/java/javase/downloads/jdk7-downloads-1880260.html
- http://stackoverflow.com/a/14617087/1041691
-
- mkdir java ; cd java
- # obtain the JDK via a browser
- WINEPREFIX=$PWD wine jdk-7u25-windows-i686.exe
- sudo mkdir -p /opt/win-i686
- sudo mv drive_c/Program\ Files\ (x86)/Java/jdk1.7.0_25 /opt/win-i686/jdk7
- -->
- <properties>
- <netlib.src>../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_ref-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <!-- WIN32 is a misnomer -->
- <javahOS>win32</javahOS>
- <jdkIncludePath>/opt/win-i686/jdk7/include</jdkIncludePath>
- <compilerExecutable>i686-w64-mingw32-gcc</compilerExecutable>
- <linkerExecutable>i686-w64-mingw32-gcc</linkerExecutable>
- <compilerEndOptions>
- <!-- silencing warnings because jint* int* are actually safe on this platform -->
- <compilerEndOption>-w</compilerEndOption>
- </compilerEndOptions>
- <linkerMiddleOptions>
-<!-- check binary link with
- i686-w64-mingw32-objdump -p target/netlib-native_ref-win-i686.dll | grep DLL
--->
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw32/mingw/lib/libgfortran.a</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw32/mingw/lib/libquadmath.a</linkerMiddleOption>
- <linkerMiddleOption>-static-libgcc</linkerMiddleOption>
- <!-- otherwise an "@..." symbol is added to the function name! -->
- <linkerMiddleOption>-Wl,--kill-at</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <!-- Ignored, see http://sourceforge.net/p/mingw/bugs/1134/ -->
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/win-x86_64/pom.xml b/native_ref/win-x86_64/pom.xml
deleted file mode 100644
index 9577f19..0000000
--- a/native_ref/win-x86_64/pom.xml
+++ /dev/null
@@ -1,106 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_ref-win-x86_64</artifactId>
- <packaging>dll</packaging>
-
- <!--
- This build is cross-compiled from OS X using the official MinGW snapshot
- downloaded from (I used mingw-w64-bin_x86_64-darwin_20130622)
-
- http://sourceforge.net/projects/mingw-w64/
-
- with the Windows 64 bit JDK obtained as per
-
- http://www.oracle.com/technetwork/java/javase/downloads/jdk7-downloads-1880260.html
- http://stackoverflow.com/a/14617087/1041691
-
- mkdir java ; cd java
- # obtain the JDK via a browser
- WINEPREFIX=$PWD wine jdk-7u25-windows-x64.exe
- sudo mkdir -p /opt/win-x86_64
- sudo mv drive_c/Program\ Files/Java/jdk1.7.0_25 /opt/win-x86_64/jdk7
- -->
- <properties>
- <netlib.src>../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_ref-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <!-- WIN32 is a misnomer -->
- <javahOS>win32</javahOS>
- <jdkIncludePath>/opt/win-x86_64/jdk7/include</jdkIncludePath>
- <compilerExecutable>x86_64-w64-mingw32-gcc</compilerExecutable>
- <linkerExecutable>x86_64-w64-mingw32-gcc</linkerExecutable>
- <compilerEndOptions>
- <!-- silencing warnings because jint* int* are actually safe on this platform -->
- <compilerEndOption>-w</compilerEndOption>
- </compilerEndOptions>
- <linkerMiddleOptions>
-<!-- check binary link with
- x86_64-w64-mingw32-objdump -p target/netlib-native_ref-win-x86_64.dll | grep DLL
- x86_64-w64-mingw32-nm -g target/netlib-native_ref-win-x86_64.dll
--->
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw64/mingw/lib/libgfortran.a</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw64/mingw/lib/libquadmath.a</linkerMiddleOption>
- <linkerMiddleOption>-static-libgcc</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <!-- Ignored, see http://sourceforge.net/p/mingw/bugs/1134/ -->
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/xbuilds/linux-armhf/pom.xml b/native_ref/xbuilds/linux-armhf/pom.xml
deleted file mode 100644
index 5139e11..0000000
--- a/native_ref/xbuilds/linux-armhf/pom.xml
+++ /dev/null
@@ -1,105 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref-xbuilds</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_ref-linux-armhf</artifactId>
- <packaging>so</packaging>
-
- <!--
- This is built using a custom cross compiler from Debian,
- using the "rpi" config file in this directory.
-
- http://elinux.org/RPi_Linaro_GCC_Compilation
- http://crosstool-ng.org
- http://stackoverflow.com/a/13384349/1041691
-
- (don't forget to use `CT_DEBUG_CT_SAVE_STEPS=1`)
-
- Note that although Ubuntu has a gnueabihf compiler, it
- is targeted a ludicrously niche ARMv7 chip that is not
- backwards compatible with the Raspberry Pi.
-
- And obtain a JDK for ARM from
-
- http://jdk8.java.net/download.html
-
- installed into
-
- /opt/gnueabihf-arm/jdk8
- -->
- <properties>
- <netlib.src>../../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_ref-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>linux</javahOS>
- <jdkIncludePath>/opt/gnueabihf-arm/jdk8/include</jdkIncludePath>
- <compilerExecutable>arm-rpi-linux-gnueabi-gcc</compilerExecutable>
- <linkerExecutable>arm-rpi-linux-gnueabi-gcc</linkerExecutable>
- <compilerStartOptions>
- <compilerStartOption>-Os</compilerStartOption>
- </compilerStartOptions>
- <linkerMiddleOptions>
-<!-- Inspect binary with
-arm-rpi-linux-gnueabi-readelf -a target/netlib-native_ref-linux-armhf.so | grep "Shared library:"
--->
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/xbuilds/linux-armhf/rpi b/native_ref/xbuilds/linux-armhf/rpi
deleted file mode 100644
index c6a3261..0000000
--- a/native_ref/xbuilds/linux-armhf/rpi
+++ /dev/null
@@ -1,567 +0,0 @@
-#
-# Automatically generated make config: don't edit
-# crosstool-NG 1.18.0 Configuration
-# Tue Aug 27 06:57:05 2013
-#
-CT_CONFIGURE_has_xz=y
-CT_CONFIGURE_has_svn=y
-CT_MODULES=y
-
-#
-# Paths and misc options
-#
-
-#
-# crosstool-NG behavior
-#
-# CT_OBSOLETE is not set
-CT_EXPERIMENTAL=y
-# CT_ALLOW_BUILD_AS_ROOT is not set
-# CT_DEBUG_CT is not set
-
-#
-# Paths
-#
-CT_LOCAL_TARBALLS_DIR=""
-CT_CUSTOM_LOCATION_ROOT_DIR=""
-CT_WORK_DIR="${CT_TOP_DIR}/.build"
-CT_PREFIX_DIR="${HOME}/x-tools/${CT_TARGET}"
-CT_INSTALL_DIR="${CT_PREFIX_DIR}"
-CT_RM_RF_PREFIX_DIR=y
-CT_REMOVE_DOCS=y
-CT_INSTALL_DIR_RO=y
-CT_STRIP_ALL_TOOLCHAIN_EXECUTABLES=y
-
-#
-# Downloading
-#
-# CT_FORBID_DOWNLOAD is not set
-# CT_FORCE_DOWNLOAD is not set
-CT_CONNECT_TIMEOUT=10
-# CT_ONLY_DOWNLOAD is not set
-# CT_USE_MIRROR is not set
-
-#
-# Extracting
-#
-# CT_FORCE_EXTRACT is not set
-CT_OVERIDE_CONFIG_GUESS_SUB=y
-# CT_ONLY_EXTRACT is not set
-CT_PATCH_BUNDLED=y
-# CT_PATCH_LOCAL is not set
-# CT_PATCH_BUNDLED_LOCAL is not set
-# CT_PATCH_LOCAL_BUNDLED is not set
-# CT_PATCH_BUNDLED_FALLBACK_LOCAL is not set
-# CT_PATCH_LOCAL_FALLBACK_BUNDLED is not set
-# CT_PATCH_NONE is not set
-CT_PATCH_ORDER="bundled"
-
-#
-# Build behavior
-#
-CT_PARALLEL_JOBS=2
-CT_LOAD=""
-CT_USE_PIPES=y
-CT_EXTRA_CFLAGS_FOR_BUILD=""
-CT_EXTRA_LDFLAGS_FOR_BUILD=""
-CT_EXTRA_CFLAGS_FOR_HOST=""
-CT_EXTRA_LDFLAGS_FOR_HOST=""
-# CT_CONFIG_SHELL_SH is not set
-# CT_CONFIG_SHELL_ASH is not set
-CT_CONFIG_SHELL_BASH=y
-# CT_CONFIG_SHELL_CUSTOM is not set
-CT_CONFIG_SHELL="${bash}"
-
-#
-# Logging
-#
-# CT_LOG_ERROR is not set
-# CT_LOG_WARN is not set
-CT_LOG_INFO=y
-# CT_LOG_EXTRA is not set
-# CT_LOG_ALL is not set
-# CT_LOG_DEBUG is not set
-CT_LOG_LEVEL_MAX="INFO"
-# CT_LOG_SEE_TOOLS_WARN is not set
-CT_LOG_PROGRESS_BAR=y
-CT_LOG_TO_FILE=y
-CT_LOG_FILE_COMPRESS=y
-
-#
-# Target options
-#
-CT_ARCH="arm"
-CT_ARCH_SUPPORTS_BOTH_MMU=y
-CT_ARCH_SUPPORTS_BOTH_ENDIAN=y
-CT_ARCH_SUPPORTS_32=y
-CT_ARCH_SUPPORTS_WITH_ARCH=y
-CT_ARCH_SUPPORTS_WITH_CPU=y
-CT_ARCH_SUPPORTS_WITH_TUNE=y
-CT_ARCH_SUPPORTS_WITH_FLOAT=y
-CT_ARCH_SUPPORTS_WITH_FPU=y
-CT_ARCH_SUPPORTS_SOFTFP=y
-CT_ARCH_DEFAULT_HAS_MMU=y
-CT_ARCH_DEFAULT_LE=y
-CT_ARCH_DEFAULT_32=y
-CT_ARCH_ARCH="armv6zk"
-CT_ARCH_CPU="arm1176jzf-s"
-CT_ARCH_TUNE="arm1176jzf-s"
-CT_ARCH_FPU="vfp"
-# CT_ARCH_BE is not set
-CT_ARCH_LE=y
-CT_ARCH_32=y
-CT_ARCH_BITNESS=32
-CT_ARCH_FLOAT_HW=y
-# CT_ARCH_FLOAT_SW is not set
-CT_TARGET_CFLAGS=""
-CT_TARGET_LDFLAGS=""
-# CT_ARCH_alpha is not set
-CT_ARCH_arm=y
-# CT_ARCH_avr32 is not set
-# CT_ARCH_blackfin is not set
-# CT_ARCH_m68k is not set
-# CT_ARCH_microblaze is not set
-# CT_ARCH_mips is not set
-# CT_ARCH_powerpc is not set
-# CT_ARCH_s390 is not set
-# CT_ARCH_sh is not set
-# CT_ARCH_sparc is not set
-# CT_ARCH_x86 is not set
-CT_ARCH_alpha_AVAILABLE=y
-CT_ARCH_arm_AVAILABLE=y
-CT_ARCH_avr32_AVAILABLE=y
-CT_ARCH_blackfin_AVAILABLE=y
-CT_ARCH_m68k_AVAILABLE=y
-CT_ARCH_microblaze_AVAILABLE=y
-CT_ARCH_mips_AVAILABLE=y
-CT_ARCH_powerpc_AVAILABLE=y
-CT_ARCH_s390_AVAILABLE=y
-CT_ARCH_sh_AVAILABLE=y
-CT_ARCH_sparc_AVAILABLE=y
-CT_ARCH_x86_AVAILABLE=y
-CT_ARCH_SUFFIX=""
-
-#
-# Generic target options
-#
-# CT_MULTILIB is not set
-CT_ARCH_USE_MMU=y
-CT_ARCH_ENDIAN="little"
-
-#
-# Target optimisations
-#
-# CT_ARCH_FLOAT_SOFTFP is not set
-CT_ARCH_FLOAT="hard"
-
-#
-# arm other options
-#
-CT_ARCH_ARM_MODE="arm"
-CT_ARCH_ARM_MODE_ARM=y
-# CT_ARCH_ARM_MODE_THUMB is not set
-# CT_ARCH_ARM_INTERWORKING is not set
-CT_ARCH_ARM_EABI_FORCE=y
-CT_ARCH_ARM_EABI=y
-# CT_ARCH_ARM_TUPLE_USE_EABIHF is not set
-
-#
-# Toolchain options
-#
-
-#
-# General toolchain options
-#
-CT_FORCE_SYSROOT=y
-CT_USE_SYSROOT=y
-CT_SYSROOT_NAME="sysroot"
-CT_SYSROOT_DIR_PREFIX=""
-CT_WANTS_STATIC_LINK=y
-# CT_STATIC_TOOLCHAIN is not set
-CT_TOOLCHAIN_PKGVERSION=""
-CT_TOOLCHAIN_BUGURL=""
-
-#
-# Tuple completion and aliasing
-#
-CT_TARGET_VENDOR="rpi"
-CT_TARGET_ALIAS_SED_EXPR=""
-CT_TARGET_ALIAS=""
-
-#
-# Toolchain type
-#
-# CT_NATIVE is not set
-CT_CROSS=y
-# CT_CROSS_NATIVE is not set
-# CT_CANADIAN is not set
-CT_TOOLCHAIN_TYPE="cross"
-
-#
-# Build system
-#
-CT_BUILD=""
-CT_BUILD_PREFIX=""
-CT_BUILD_SUFFIX=""
-
-#
-# Misc options
-#
-# CT_TOOLCHAIN_ENABLE_NLS is not set
-
-#
-# Operating System
-#
-CT_KERNEL_SUPPORTS_SHARED_LIBS=y
-CT_KERNEL="linux"
-CT_KERNEL_VERSION="3.6.11"
-# CT_KERNEL_bare_metal is not set
-CT_KERNEL_linux=y
-CT_KERNEL_bare_metal_AVAILABLE=y
-CT_KERNEL_linux_AVAILABLE=y
-# CT_KERNEL_V_3_7_3 is not set
-# CT_KERNEL_V_3_7_2 is not set
-# CT_KERNEL_V_3_7_1 is not set
-# CT_KERNEL_V_3_7 is not set
-CT_KERNEL_V_3_6=y
-# CT_KERNEL_V_3_5 is not set
-# CT_KERNEL_V_3_4 is not set
-# CT_KERNEL_V_3_3 is not set
-# CT_KERNEL_V_3_2 is not set
-# CT_KERNEL_V_3_1 is not set
-# CT_KERNEL_V_3_0 is not set
-# CT_KERNEL_V_2_6_39 is not set
-# CT_KERNEL_V_2_6_38 is not set
-# CT_KERNEL_V_2_6_37 is not set
-# CT_KERNEL_V_2_6_36 is not set
-# CT_KERNEL_V_2_6_33 is not set
-# CT_KERNEL_V_2_6_32 is not set
-# CT_KERNEL_V_2_6_31 is not set
-# CT_KERNEL_V_2_6_27 is not set
-# CT_KERNEL_LINUX_CUSTOM is not set
-CT_KERNEL_windows_AVAILABLE=y
-
-#
-# Common kernel options
-#
-CT_SHARED_LIBS=y
-
-#
-# linux other options
-#
-CT_KERNEL_LINUX_VERBOSITY_0=y
-# CT_KERNEL_LINUX_VERBOSITY_1 is not set
-# CT_KERNEL_LINUX_VERBOSITY_2 is not set
-CT_KERNEL_LINUX_VERBOSE_LEVEL=0
-CT_KERNEL_LINUX_INSTALL_CHECK=y
-
-#
-# Binary utilities
-#
-CT_ARCH_BINFMT_ELF=y
-CT_BINUTILS="binutils"
-CT_BINUTILS_binutils=y
-
-#
-# GNU binutils
-#
-# CT_BINUTILS_V_2_23_1 is not set
-CT_BINUTILS_V_2_22=y
-# CT_BINUTILS_V_2_21_53 is not set
-# CT_BINUTILS_V_2_21_1a is not set
-# CT_BINUTILS_V_2_20_1a is not set
-# CT_BINUTILS_V_2_19_1a is not set
-# CT_BINUTILS_V_2_18a is not set
-# CT_BINUTILS_CUSTOM is not set
-CT_BINUTILS_VERSION="2.22"
-CT_BINUTILS_2_22_or_later=y
-CT_BINUTILS_2_21_or_later=y
-CT_BINUTILS_2_20_or_later=y
-CT_BINUTILS_2_19_or_later=y
-CT_BINUTILS_2_18_or_later=y
-CT_BINUTILS_HAS_HASH_STYLE=y
-CT_BINUTILS_HAS_GOLD=y
-CT_BINUTILS_GOLD_SUPPORTS_ARCH=y
-CT_BINUTILS_HAS_PLUGINS=y
-CT_BINUTILS_HAS_PKGVERSION_BUGURL=y
-CT_BINUTILS_FORCE_LD_BFD=y
-CT_BINUTILS_LINKER_LD=y
-# CT_BINUTILS_LINKER_LD_GOLD is not set
-# CT_BINUTILS_LINKER_GOLD_LD is not set
-CT_BINUTILS_LINKERS_LIST="ld"
-CT_BINUTILS_LINKER_DEFAULT="bfd"
-# CT_BINUTILS_PLUGINS is not set
-CT_BINUTILS_EXTRA_CONFIG_ARRAY=""
-# CT_BINUTILS_FOR_TARGET is not set
-
-#
-# binutils other options
-#
-
-#
-# C compiler
-#
-CT_CC="gcc"
-CT_CC_VERSION="4.7.2"
-CT_CC_CORE_PASSES_NEEDED=y
-CT_CC_gcc=y
-# CT_CC_GCC_SHOW_LINARO is not set
-CT_CC_V_4_7_2=y
-# CT_CC_V_4_7_1 is not set
-# CT_CC_V_4_7_0 is not set
-# CT_CC_V_4_6_3 is not set
-# CT_CC_V_4_6_2 is not set
-# CT_CC_V_4_6_1 is not set
-# CT_CC_V_4_6_0 is not set
-# CT_CC_V_4_5_3 is not set
-# CT_CC_V_4_5_2 is not set
-# CT_CC_V_4_5_1 is not set
-# CT_CC_V_4_5_0 is not set
-# CT_CC_V_4_4_7 is not set
-# CT_CC_V_4_4_6 is not set
-# CT_CC_V_4_4_5 is not set
-# CT_CC_V_4_4_4 is not set
-# CT_CC_V_4_4_3 is not set
-# CT_CC_V_4_4_2 is not set
-# CT_CC_V_4_4_1 is not set
-# CT_CC_V_4_4_0 is not set
-# CT_CC_V_4_3_6 is not set
-# CT_CC_V_4_3_5 is not set
-# CT_CC_V_4_3_4 is not set
-# CT_CC_V_4_3_3 is not set
-# CT_CC_V_4_3_2 is not set
-# CT_CC_V_4_3_1 is not set
-# CT_CC_V_4_2_4 is not set
-# CT_CC_V_4_2_2 is not set
-# CT_CC_CUSTOM is not set
-CT_CC_GCC_4_2_or_later=y
-CT_CC_GCC_4_3_or_later=y
-CT_CC_GCC_4_4_or_later=y
-CT_CC_GCC_4_5_or_later=y
-CT_CC_GCC_4_6_or_later=y
-CT_CC_GCC_4_7=y
-CT_CC_GCC_4_7_or_later=y
-CT_CC_GCC_HAS_GRAPHITE=y
-CT_CC_GCC_HAS_LTO=y
-CT_CC_GCC_HAS_PKGVERSION_BUGURL=y
-CT_CC_GCC_HAS_BUILD_ID=y
-CT_CC_GCC_HAS_LNK_HASH_STYLE=y
-CT_CC_GCC_USE_GMP_MPFR=y
-CT_CC_GCC_USE_PPL_CLOOG=y
-CT_CC_GCC_USE_MPC=y
-CT_CC_GCC_HAS_LIBQUADMATH=y
-CT_CC_LANG_FORTRAN=y
-CT_CC_SUPPORT_CXX=y
-CT_CC_SUPPORT_FORTRAN=y
-CT_CC_SUPPORT_JAVA=y
-CT_CC_SUPPORT_ADA=y
-CT_CC_SUPPORT_OBJC=y
-CT_CC_SUPPORT_OBJCXX=y
-
-#
-# Additional supported languages:
-#
-CT_CC_LANG_CXX=y
-# CT_CC_LANG_JAVA is not set
-# CT_CC_LANG_ADA is not set
-# CT_CC_LANG_OBJC is not set
-# CT_CC_LANG_OBJCXX is not set
-CT_CC_LANG_OTHERS=""
-
-#
-# gcc other options
-#
-CT_CC_ENABLE_CXX_FLAGS=""
-CT_CC_CORE_EXTRA_CONFIG_ARRAY=""
-CT_CC_EXTRA_CONFIG_ARRAY="--with-float=hard"
-CT_CC_STATIC_LIBSTDCXX=y
-# CT_CC_GCC_SYSTEM_ZLIB is not set
-
-#
-# Optimisation features
-#
-CT_CC_GCC_USE_GRAPHITE=y
-CT_CC_GCC_USE_LTO=y
-
-#
-# Settings for libraries running on target
-#
-CT_CC_GCC_ENABLE_TARGET_OPTSPACE=y
-# CT_CC_GCC_LIBMUDFLAP is not set
-# CT_CC_GCC_LIBGOMP is not set
-# CT_CC_GCC_LIBSSP is not set
-# CT_CC_GCC_LIBQUADMATH is not set
-
-#
-# Misc. obscure options.
-#
-CT_CC_CXA_ATEXIT=y
-# CT_CC_GCC_DISABLE_PCH is not set
-CT_CC_GCC_SJLJ_EXCEPTIONS=m
-CT_CC_GCC_LDBL_128=m
-# CT_CC_GCC_BUILD_ID is not set
-CT_CC_GCC_LNK_HASH_STYLE_DEFAULT=y
-# CT_CC_GCC_LNK_HASH_STYLE_SYSV is not set
-# CT_CC_GCC_LNK_HASH_STYLE_GNU is not set
-# CT_CC_GCC_LNK_HASH_STYLE_BOTH is not set
-CT_CC_GCC_LNK_HASH_STYLE=""
-
-#
-# C-library
-#
-CT_LIBC="eglibc"
-CT_LIBC_VERSION="2_13"
-CT_LIBC_eglibc=y
-# CT_LIBC_glibc is not set
-# CT_LIBC_uClibc is not set
-CT_LIBC_eglibc_AVAILABLE=y
-# CT_LIBC_EGLIBC_V_2_17 is not set
-# CT_LIBC_EGLIBC_V_2_16 is not set
-# CT_LIBC_EGLIBC_V_2_15 is not set
-# CT_LIBC_EGLIBC_V_2_14 is not set
-CT_LIBC_EGLIBC_V_2_13=y
-# CT_LIBC_EGLIBC_V_2_12 is not set
-# CT_LIBC_EGLIBC_V_2_11 is not set
-# CT_LIBC_EGLIBC_V_2_10 is not set
-# CT_LIBC_EGLIBC_V_2_9 is not set
-# CT_LIBC_EGLIBC_V_TRUNK is not set
-CT_EGLIBC_REVISION="HEAD"
-# CT_EGLIBC_HTTP is not set
-# CT_EGLIBC_CHECKOUT is not set
-# CT_EGLIBC_OPT_SIZE is not set
-# CT_EGLIBC_CUSTOM_CONFIG is not set
-CT_LIBC_glibc_AVAILABLE=y
-CT_LIBC_mingw_AVAILABLE=y
-CT_LIBC_newlib_AVAILABLE=y
-CT_LIBC_none_AVAILABLE=y
-CT_LIBC_uClibc_AVAILABLE=y
-CT_LIBC_SUPPORT_THREADS_ANY=y
-CT_LIBC_SUPPORT_NPTL=y
-CT_LIBC_SUPPORT_LINUXTHREADS=y
-CT_THREADS="nptl"
-
-#
-# Common C library options
-#
-CT_THREADS_NPTL=y
-# CT_THREADS_LINUXTHREADS is not set
-CT_LIBC_XLDD=y
-
-#
-# eglibc other options
-#
-CT_LIBC_GLIBC_MAY_FORCE_PORTS=y
-CT_LIBC_glibc_familly=y
-CT_LIBC_GLIBC_EXTRA_CONFIG_ARRAY=""
-CT_LIBC_GLIBC_CONFIGPARMS=""
-CT_LIBC_GLIBC_EXTRA_CFLAGS=""
-CT_LIBC_EXTRA_CC_ARGS=""
-# CT_LIBC_ENABLE_FORTIFIED_BUILD is not set
-# CT_LIBC_DISABLE_VERSIONING is not set
-CT_LIBC_OLDEST_ABI=""
-CT_LIBC_GLIBC_FORCE_UNWIND=y
-CT_LIBC_GLIBC_USE_PORTS=y
-CT_LIBC_ADDONS_LIST=""
-
-#
-# WARNING !!!
-#
-
-#
-# For glibc >= 2.8, it can happen that the tarballs
-#
-
-#
-# for the addons are not available for download.
-#
-
-#
-# If that happens, bad luck... Try a previous version
-#
-
-#
-# or try again later... :-(
-#
-# CT_LIBC_LOCALES is not set
-# CT_LIBC_GLIBC_KERNEL_VERSION_NONE is not set
-CT_LIBC_GLIBC_KERNEL_VERSION_AS_HEADERS=y
-# CT_LIBC_GLIBC_KERNEL_VERSION_CHOSEN is not set
-CT_LIBC_GLIBC_MIN_KERNEL="3.6.11"
-
-#
-# Debug facilities
-#
-# CT_DEBUG_dmalloc is not set
-# CT_DEBUG_duma is not set
-# CT_DEBUG_gdb is not set
-# CT_DEBUG_ltrace is not set
-# CT_DEBUG_strace is not set
-
-#
-# Companion libraries
-#
-CT_COMPLIBS_NEEDED=y
-CT_GMP_NEEDED=y
-CT_MPFR_NEEDED=y
-CT_PPL_NEEDED=y
-CT_CLOOG_NEEDED=y
-CT_MPC_NEEDED=y
-CT_COMPLIBS=y
-CT_GMP=y
-CT_MPFR=y
-CT_PPL=y
-CT_CLOOG=y
-CT_MPC=y
-CT_GMP_V_5_0_2=y
-# CT_GMP_V_5_0_1 is not set
-# CT_GMP_V_4_3_2 is not set
-# CT_GMP_V_4_3_1 is not set
-# CT_GMP_V_4_3_0 is not set
-CT_GMP_VERSION="5.0.2"
-CT_MPFR_V_3_1_0=y
-# CT_MPFR_V_3_0_1 is not set
-# CT_MPFR_V_3_0_0 is not set
-# CT_MPFR_V_2_4_2 is not set
-# CT_MPFR_V_2_4_1 is not set
-# CT_MPFR_V_2_4_0 is not set
-CT_MPFR_VERSION="3.1.0"
-CT_PPL_V_0_11_2=y
-# CT_PPL_V_0_11_1 is not set
-# CT_PPL_V_0_11 is not set
-# CT_PPL_V_0_10_2 is not set
-CT_PPL_VERSION="0.11.2"
-CT_PPL_0_11=y
-CT_PPL_NEEDS_LIBPWL=y
-CT_CLOOG_V_0_15_11=y
-# CT_CLOOG_V_0_15_10 is not set
-# CT_CLOOG_V_0_15_9 is not set
-# CT_CLOOG_V_0_15_8 is not set
-# CT_CLOOG_V_0_15_7 is not set
-# CT_CLOOG_V_0_15_6 is not set
-CT_CLOOG_VERSION="0.15.11"
-CT_CLOOG_0_15_1x=y
-CT_CLOOG_NEEDS_AUTORECONF=y
-CT_MPC_V_0_9=y
-# CT_MPC_V_0_8_2 is not set
-# CT_MPC_V_0_8_1 is not set
-# CT_MPC_V_0_7 is not set
-CT_MPC_VERSION="0.9"
-
-#
-# Companion libraries common options
-#
-# CT_COMPLIBS_CHECK is not set
-
-#
-# Companion tools
-#
-
-#
-# READ HELP before you say 'Y' below !!!
-#
-# CT_COMP_TOOLS is not set
-
-#
-# Test suite
-#
-# CT_TEST_SUITE_GCC is not set
diff --git a/native_ref/xbuilds/linux-i686/pom.xml b/native_ref/xbuilds/linux-i686/pom.xml
deleted file mode 100644
index 239dc40..0000000
--- a/native_ref/xbuilds/linux-i686/pom.xml
+++ /dev/null
@@ -1,100 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref-xbuilds</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_ref-linux-i686</artifactId>
- <packaging>so</packaging>
-
- <!--
- This is built for Linux i686 on an x86_64 architecture.
-
- sudo apt-get install libc6-dev-i386 gfortran-multilib
-
- get the 32 bit JDK from
-
- http://www.oracle.com/technetwork/java/javase/downloads/jdk7-downloads-1880260.html
-
- and install into
-
- /opt/linux-i686/jdk7
-
- It is impossible to compile a library on Ubuntu that has static
- references to the fortran libraries, as the static fortran library
- has not been compiled with -fPIC. The only workaround would be
- to compile gcc from scratch, with the flags added, and then compile
- these natives. That is not a wise move.
- -->
- <properties>
- <netlib.src>../../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_ref-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>linux</javahOS>
- <jdkIncludePath>/opt/linux-i686/jdk7/include</jdkIncludePath>
- <compilerEndOptions>
- <compilerEndOption>-m32</compilerEndOption>
- </compilerEndOptions>
- <linkerEndOptions>
- <linkerEndOption>-m32</linkerEndOption>
- </linkerEndOptions>
- <linkerMiddleOptions>
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/xbuilds/linux-x86_64/pom.xml b/native_ref/xbuilds/linux-x86_64/pom.xml
deleted file mode 100644
index 9234761..0000000
--- a/native_ref/xbuilds/linux-x86_64/pom.xml
+++ /dev/null
@@ -1,87 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref-xbuilds</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_ref-linux-x86_64</artifactId>
- <packaging>so</packaging>
-
- <!--
- This is built natively for Linux x86_64 on an x86_64 architecture.
- Ubuntu Wheezy is best as it compiles for GLIBC_2.2.5 whereas Ubuntu
- requires the more recent GLIBC_2.13.
-
- sudo apt-get install gfortran openjdk-7-jdk
-
- It is impossible to compile a library on Ubuntu that has static
- references to the fortran libraries, as the static fortran library
- has not been compiled with -fPIC. The only workaround would be
- to compile gcc from scratch, with the flags added, and then compile
- these natives. That is not a wise move.
- -->
- <properties>
- <netlib.src>../../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_ref-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>linux</javahOS>
- <linkerMiddleOptions>
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_ref/xbuilds/pom.xml b/native_ref/xbuilds/pom.xml
deleted file mode 100644
index 3d62b2d..0000000
--- a/native_ref/xbuilds/pom.xml
+++ /dev/null
@@ -1,28 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <!--
- This is an artificial package that facilitates easy cross
- compiles for various targets from Linux (because OS X
- cross building doesn't work so well).
- -->
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_ref</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>native_ref-xbuilds</artifactId>
- <packaging>pom</packaging>
-
- <modules>
- <module>linux-x86_64</module>
- <module>linux-i686</module>
- <module>linux-armhf</module>
- </modules>
-
-</project>
diff --git a/native_system/java/pom.xml b/native_system/java/pom.xml
deleted file mode 100644
index 58c2e76..0000000
--- a/native_system/java/pom.xml
+++ /dev/null
@@ -1,92 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>native_system-java</artifactId>
- <packaging>jar</packaging>
-
- <dependencies>
- <dependency>
- <groupId>com.github.fommil</groupId>
- <artifactId>jniloader</artifactId>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>core</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- </plugin>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <!--
- HACK: these override the parent executions of the same name
- and stop it from running.
- -->
- <id>blas</id>
- <goals>
- <goal>native-java</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/NativeSystemBLAS.java</outputName>
- <scan>org.netlib.blas</scan>
- <implementing>com.github.fommil.netlib.BLAS</implementing>
- <extending>com.github.fommil.netlib.F2jBLAS</extending>
- <unsupported>${prefer.f2j}</unsupported>
- <natives>${natives}</natives>
- </configuration>
- </execution>
- <execution>
- <id>lapack</id>
- <goals>
- <goal>native-java</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/NativeSystemLAPACK.java</outputName>
- <scan>org.netlib.lapack</scan>
- <implementing>com.github.fommil.netlib.LAPACK</implementing>
- <extending>com.github.fommil.netlib.F2jLAPACK</extending>
- <unsupported>${prefer.f2j}</unsupported>
- <natives>${natives}</natives>
- </configuration>
- </execution>
- <execution>
- <id>arpack</id>
- <goals>
- <goal>native-java</goal>
- </goals>
- <configuration>
- <outputName>com/github/fommil/netlib/NativeSystemARPACK.java</outputName>
- <scan>org.netlib.arpack</scan>
- <implementing>com.github.fommil.netlib.ARPACK</implementing>
- <extending>com.github.fommil.netlib.F2jARPACK</extending>
- <unsupported>${prefer.f2j}</unsupported>
- <natives>${natives}</natives>
- </configuration>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/osx-x86_64/pom.xml b/native_system/osx-x86_64/pom.xml
deleted file mode 100644
index 75eed61..0000000
--- a/native_system/osx-x86_64/pom.xml
+++ /dev/null
@@ -1,99 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_system-osx-x86_64</artifactId>
- <packaging>jnilib</packaging>
-
- <properties>
- <netlib.src>../../netlib</netlib.src>
- </properties>
-
- <!--
- NOTE: OS X does not come with a Fortran compiler.
- This configuration uses macports' distribution of gcc:
-
- sudo port install gfortran48
-
- To get the i5 AVX instructions, CLANG must be used for assembly
-
- http://stackoverflow.com/questions/9840207
-
- (although I haven't noticed much difference) with these extra GCC flags
-
- -Xassembler -w -march=corei7-avx -mtune=corei7-avx
- -->
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_system-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>darwin</javahOS>
- <compilerExecutable>gcc-mp-4.8</compilerExecutable>
- <linkerExecutable>gcc-mp-4.8</linkerExecutable>
- <compilerEndOptions>
- <compilerEndOption>-I/System/Library/Frameworks/vecLib.framework/Headers</compilerEndOption>
- </compilerEndOptions>
- <linkerMiddleOptions>
- <linkerMiddleOption>-dynamiclib</linkerMiddleOption>
- <linkerMiddleOption>-static-libgfortran</linkerMiddleOption>
- <linkerMiddleOption>/opt/local/lib/gcc48/libquadmath.a</linkerMiddleOption>
- <linkerMiddleOption>-static-libgcc</linkerMiddleOption>
- <linkerMiddleOption>-framework JavaVM</linkerMiddleOption>
- <linkerMiddleOption>-framework veclib</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-dead_strip</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-exported_symbol,_Java_*</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-x</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/pom.xml b/native_system/pom.xml
deleted file mode 100644
index c83977f..0000000
--- a/native_system/pom.xml
+++ /dev/null
@@ -1,270 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <!--
- Uses a "system installed" BLAS/LAPACK.
- In reality, this means a BLAS/CBLAS in libblas.so
- and either LAPACK or the incompatible CLAPACK.
- We interface with CBLAS and LAPACKE, but can
- interface with BLAS/LAPACK directly in a pinch.
- -->
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>native_system</artifactId>
- <packaging>pom</packaging>
-
- <modules>
- <module>java</module>
- <module>osx-x86_64</module>
- <module>win-i686</module>
- <module>win-x86_64</module>
- <!-- cross compiles are built separately on a Linux box... -->
- </modules>
-
- <properties>
- <natives>netlib-native_system</natives>
- <!-- GEES etc needs an ill-defined callback -->
- <lapacke.callback>([ds](gees|gges|geesx|ggesx))</lapacke.callback>
- <!-- LSAME, SECOND etc are more efficient on the JVM -->
- <jvm.better>lsame|lsamen|second|dsecnd</jvm.better>
- <!-- LAPACK routines that do not have a named ARPACKE equivalent -->
- <lapacke.unsupported>(ieeeck|ilaenv|ilaver|iparmq|([sd](gbtf2|gebd2|gbtf2|gebd2|gegs|gegv|gehd2|gelsx|geql2|gerq2|gesc2|getc2|gtts2|isnan|labad|labrd|lacn2|lacon|ladiv|lae2|laebz|laed0|laed1|laed2|laed3|laed4|laed5|laed6|laed7|laed8|laed9|laeda|laein|laev2|laexc|lag2|lags2|lagtf|lagtm|lagts|lagv2|lahqr|lahr2|lahrd|laic1|laisnan|laln2|lals0|lalsa|lalsd|lamc1|lamc2|lamc3|lamc4|lamc5|lamrg|laneg|langb|langt|lanhs|lansb|lansp|lanst|lantb|lantp|lanv2|lapll|lapmt|laqgb|laqge|laqp2|laqp [...]
- <arpack.noprototypes>(dgetv0|dlaqrb|dmout|dnaitr|dnapps|dnaup2|dnconv|dneigh|dngets|dsaitr|dsapps|dsaup2|dsconv|dseigt|dsesrt|dsgets|dsortc|dsortr|dstatn|dstats|dstqrb|dvout|icnteq|icopy|iset|iswap|ivout|second|sgetv0|slaqrb|smout|snaitr|snapps|snaup2|snconv|sneigh|sngets|ssaitr|ssapps|ssaup2|ssconv|sseigt|ssesrt|ssgets|ssortc|ssortr|sstatn|sstats|sstqrb|svout)</arpack.noprototypes>
- <!-- not supported by OS X veclib -->
- <no.veclib.impl>(dbbcsd|dgemqrt|dgeqrfp|dgeqrt2|dgeqrt3|dgeqrt|dlagge|dlagsy|dlapmr|dlartgp|dlartgs|dlatms|dorbdb|dorcsd|dsyconv|dsyswapr|dsytri2|dsytri2x|dsytrs2|dtpmqrt|dtpqrt2|dtpqrt|dtprfb|sbbcsd|sgemqrt|sgeqrfp|sgeqrt2|sgeqrt3|sgeqrt|slagge|slagsy|slapmr|slartgp|slartgs|slatms|sorbdb|sorcsd|ssyconv|ssyswapr|ssytri2|ssytri2x|ssytrs2|stpmqrt|stpqrt2|stprfb)</no.veclib.impl>
- <prefer.f2j>(${lapacke.callback}|${jvm.better}|${lapacke.unsupported}|${arpack.noprototypes}|${no.veclib.impl})</prefer.f2j>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <classifier>javadoc</classifier>
- </dependency>
- </dependencies>
-
- <build>
- <pluginManagement>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- <goals>
- <goal>native-jni</goal>
- </goals>
- <configuration>
- <implementing>com.github.fommil.netlib.NativeSystemBLAS</implementing>
- <outputDir>${project.build.directory}/netlib-native</outputDir>
- <outputName>com_github_fommil_netlib_NativeSystemBLAS.c</outputName>
- <scan>org.netlib.blas</scan>
- <prefix>cblas_</prefix>
- <firstParam>CblasColMajor</firstParam>
- <noFirstParam>.*(dot|nrm2|asum|amax|swap|copy|rot|xpy|cal).*</noFirstParam>
- <exclude>${prefer.f2j}</exclude>
- <cblas_hack>true</cblas_hack>
- <includes>
- <param>cblas.h</param>
- </includes>
- </configuration>
- </execution>
- <execution>
- <id>lapack</id>
- <goals>
- <goal>native-jni</goal>
- </goals>
- <configuration>
- <implementing>com.github.fommil.netlib.NativeSystemLAPACK</implementing>
- <outputDir>${project.build.directory}/netlib-native</outputDir>
- <outputName>com_github_fommil_netlib_NativeSystemLAPACK.c</outputName>
- <scan>org.netlib.lapack</scan>
- <prefix>LAPACKE_</prefix>
- <suffix>_work</suffix>
- <firstParam>LAPACK_COL_MAJOR</firstParam>
- <noFirstParam>
- [sd](disna|gtcon|gttrf|lapy[23]|larfg|larnv|lasrt|ptcon|pttrf|stebz|sterf|lamch)
- </noFirstParam>
- <exclude>${prefer.f2j}</exclude>
- <extractChar>true</extractChar>
- <lapacke_hack>true</lapacke_hack>
- <includes>
- <param>lapacke.h</param>
- </includes>
- </configuration>
- </execution>
- <execution>
- <id>arpack</id>
- <goals>
- <goal>native-jni</goal>
- </goals>
- <configuration>
- <implementing>com.github.fommil.netlib.NativeSystemARPACK</implementing>
- <outputDir>${project.build.directory}/netlib-native</outputDir>
- <outputName>com_github_fommil_netlib_NativeSystemARPACK.c</outputName>
- <scan>org.netlib.arpack</scan>
- <suffix>_</suffix>
- <exclude>${prefer.f2j}</exclude>
- <extractChar>true</extractChar>
- <exclude>${prefer.f2j}</exclude>
- <fortran_hack>true</fortran_hack>
- <includes>
- <param>arpack.h</param>
- </includes>
- </configuration>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <configuration>
- <!-- numberOfConcurrentCompilation would be nice, but always fails :-( -->
- <!-- http://jira.codehaus.org/browse/MOJO-1955 -->
- <javahVerbose>true</javahVerbose>
- <javahClassNames>
- <javahClassName>com.github.fommil.netlib.NativeSystemBLAS</javahClassName>
- <javahClassName>com.github.fommil.netlib.NativeSystemLAPACK</javahClassName>
- <javahClassName>com.github.fommil.netlib.NativeSystemARPACK</javahClassName>
- </javahClassNames>
- <compilerStartOptions>
- <compilerStartOption>-O3</compilerStartOption>
- </compilerStartOptions>
- <compilerMiddleOptions>
- <compilerMiddleOption>-Wall -fPIC -DADD_</compilerMiddleOption>
- <compilerMiddleOption>-fdata-sections</compilerMiddleOption>
- <compilerMiddleOption>-ffunction-sections</compilerMiddleOption>
- </compilerMiddleOptions>
- <linkerStartOptions>
- <linkerStartOption>-O3</linkerStartOption>
- </linkerStartOptions>
- <sources>
- <source>
- <directory>${project.build.directory}/netlib-native</directory>
- <includes>
- <include>*.c</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/JNI</directory>
- <includes>
- <include>*.c</include>
- </includes>
- </source>
- <source>
- <directory>${netlib.src}/LAPACKE</directory>
- <includes>
- <include>**/*.f</include>
- <include>**/*.c</include>
- </includes>
- <excludes>
- <!-- yay for regex exclusion rules, oh wait... -->
- <!-- no.veclib.impl -->
- <exclude>**/*_dbbcsd*</exclude>
- <exclude>**/*_dgemqrt*</exclude>
- <exclude>**/*_dgeqrfp*</exclude>
- <exclude>**/*_dgeqrt2*</exclude>
- <exclude>**/*_dgeqrt3*</exclude>
- <exclude>**/*_dgeqrt*</exclude>
- <exclude>**/*_dlagge*</exclude>
- <exclude>**/*_dlagsy*</exclude>
- <exclude>**/*_dlapmr*</exclude>
- <exclude>**/*_dlartgp*</exclude>
- <exclude>**/*_dlartgs*</exclude>
- <exclude>**/*_dlatms*</exclude>
- <exclude>**/*_dorbdb*</exclude>
- <exclude>**/*_dorcsd*</exclude>
- <exclude>**/*_dsyconv*</exclude>
- <exclude>**/*_dsyswapr*</exclude>
- <exclude>**/*_dsytri2*</exclude>
- <exclude>**/*_dsytri2x*</exclude>
- <exclude>**/*_dsytrs2*</exclude>
- <exclude>**/*_dtpmqrt*</exclude>
- <exclude>**/*_dtpqrt2*</exclude>
- <exclude>**/*_dtpqrt*</exclude>
- <exclude>**/*_dtprfb*</exclude>
- <exclude>**/*_sbbcsd*</exclude>
- <exclude>**/*_sgemqrt*</exclude>
- <exclude>**/*_sgeqrfp*</exclude>
- <exclude>**/*_sgeqrt2*</exclude>
- <exclude>**/*_sgeqrt3*</exclude>
- <exclude>**/*_sgeqrt*</exclude>
- <exclude>**/*_slagge*</exclude>
- <exclude>**/*_slagsy*</exclude>
- <exclude>**/*_slapmr*</exclude>
- <exclude>**/*_slartgp*</exclude>
- <exclude>**/*_slartgs*</exclude>
- <exclude>**/*_slatms*</exclude>
- <exclude>**/*_sorbdb*</exclude>
- <exclude>**/*_sorcsd*</exclude>
- <exclude>**/*_ssyconv*</exclude>
- <exclude>**/*_ssyswapr*</exclude>
- <exclude>**/*_ssytri2*</exclude>
- <exclude>**/*_ssytri2x*</exclude>
- <exclude>**/*_ssytrs2*</exclude>
- <exclude>**/*_stpmqrt*</exclude>
- <exclude>**/*_stpqrt2*</exclude>
- <exclude>**/*_stprfb*</exclude>
- </excludes>
- </source>
- <source>
- <directory>${netlib.src}/ARPACK</directory>
- <includes>
- <include>*.f</include>
- </includes>
- </source>
- </sources>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- <phase>package</phase>
- <goals>
- <goal>jar</goal>
- </goals>
- <configuration>
- <classesDirectory>${project.build.directory}</classesDirectory>
- <includes>
- <include>${project.artifactId}.*</include>
- </includes>
- <classifier>natives</classifier>
- </configuration>
- </execution>
- <execution>
- <id>source</id>
- <phase>package</phase>
- <goals>
- <goal>jar</goal>
- </goals>
- <configuration>
- <classesDirectory>${project.build.directory}</classesDirectory>
- <includes>
- <include>netlib-native/**/*</include>
- <include>native/**/*</include>
- </includes>
- <classifier>sources</classifier>
- </configuration>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </pluginManagement>
- </build>
-</project>
diff --git a/native_system/win-i686/pom.xml b/native_system/win-i686/pom.xml
deleted file mode 100644
index c172db0..0000000
--- a/native_system/win-i686/pom.xml
+++ /dev/null
@@ -1,120 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_system-win-i686</artifactId>
- <packaging>dll</packaging>
-
- <!--
- This build is cross-compiled from OS X using the official MinGW snapshot
- downloaded from (I used mingw-w64-bin_i686-darwin_20130622)
-
- http://sourceforge.net/projects/mingw-w64/
-
- with the Windows 32 bit JDK obtained as per
-
- http://www.oracle.com/technetwork/java/javase/downloads/jdk7-downloads-1880260.html
- http://stackoverflow.com/a/14617087/1041691
-
- mkdir java ; cd java
- # obtain the JDK via a browser
- WINEPREFIX=$PWD wine jdk-7u25-windows-i686.exe
- sudo mkdir -p /opt/win-i686
- sudo mv drive_c/Program\ Files\ (x86)/Java/jdk1.7.0_25 /opt/win-i686/jdk7
-
-
- i686-w64-mingw32-gcc BLAS/*.f CBLAS/*.c CBLAS/*.f -shared -o libblas3.dll -lgfortran -DADD_ -Wl,DOUBLEDASHkill-at
- i686-w64-mingw32-gcc LAPACK/*.f -shared -o liblapack3.dll -lgfortran -L. -lblas3 -Wl,DOUBLEDASHkill-at
- sudo mv libblas3.dll liblapack3.dll /opt/win-i686/lib
- sudo cp CBLAS/*.h /opt/win-i686/include
-
- where DOUBLEDASH should be replaced with a double dash (not valid in XML comments)
-
- -->
- <properties>
- <netlib.src>../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_system-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <!-- WIN32 is a misnomer -->
- <javahOS>win32</javahOS>
- <jdkIncludePath>/opt/win-i686/jdk7/include</jdkIncludePath>
- <compilerExecutable>i686-w64-mingw32-gcc</compilerExecutable>
- <linkerExecutable>i686-w64-mingw32-gcc</linkerExecutable>
- <compilerEndOptions>
- <!-- silencing warnings because jint* int* are actually safe on this platform -->
- <compilerEndOption>-w</compilerEndOption>
- <compilerEndOption>-I/opt/win-i686/include</compilerEndOption>
- </compilerEndOptions>
- <linkerMiddleOptions>
-<!-- check binary link with
- i686-w64-mingw32-objdump -p target/netlib-native_system-win-i686.dll | grep DLL
--->
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-L/opt/win-i686/lib</linkerMiddleOption>
- <linkerMiddleOption>-lblas3</linkerMiddleOption>
- <linkerMiddleOption>-llapack3</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw32/mingw/lib/libgfortran.a</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw32/mingw/lib/libquadmath.a</linkerMiddleOption>
- <linkerMiddleOption>-static-libgcc</linkerMiddleOption>
- <!-- otherwise an "@..." symbol is added to the function name! -->
- <linkerMiddleOption>-Wl,--kill-at</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <!-- Ignored, see http://sourceforge.net/p/mingw/bugs/1134/ -->
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/win-x86_64/pom.xml b/native_system/win-x86_64/pom.xml
deleted file mode 100644
index 751f35b..0000000
--- a/native_system/win-x86_64/pom.xml
+++ /dev/null
@@ -1,118 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_system-win-x86_64</artifactId>
- <packaging>dll</packaging>
-
- <!--
- This build is cross-compiled from OS X using the official MinGW snapshot
- downloaded from (I used mingw-w64-bin_x86_64-darwin_20130622)
-
- http://sourceforge.net/projects/mingw-w64/
-
- with the Windows 64 bit JDK obtained as per
-
- http://www.oracle.com/technetwork/java/javase/downloads/jdk7-downloads-1880260.html
- http://stackoverflow.com/a/14617087/1041691
-
- mkdir java ; cd java
- # obtain the JDK via a browser
- WINEPREFIX=$PWD wine jdk-7u25-windows-x64.exe
- sudo mkdir -p /opt/win-x86_64
- sudo mv drive_c/Program\ Files/Java/jdk1.7.0_25 /opt/win-x86_64/jdk7
-
- There are no sensible pre-built binaries of BLAS for Windows
- (they are usually missing the CBLAS API)
- so we compile our own from the netlib folder
-
- x86_64-w64-mingw32-gcc BLAS/*.f CBLAS/*.c CBLAS/*.f -shared -o libblas3.dll -lgfortran -DADD_
- x86_64-w64-mingw32-gcc LAPACK/*.f -shared -o liblapack3.dll -lgfortran -L. -lblas3
- sudo mv libblas3.dll liblapack3.dll /opt/win-x86_64/lib
- sudo cp CBLAS/*.h /opt/win-x86_64/include
- -->
- <properties>
- <netlib.src>../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_system-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <!-- WIN32 is a misnomer -->
- <javahOS>win32</javahOS>
- <jdkIncludePath>/opt/win-x86_64/jdk7/include</jdkIncludePath>
- <compilerExecutable>x86_64-w64-mingw32-gcc</compilerExecutable>
- <linkerExecutable>x86_64-w64-mingw32-gcc</linkerExecutable>
- <compilerEndOptions>
- <!-- silencing warnings because jint* int* are actually safe on this platform -->
- <compilerEndOption>-w</compilerEndOption>
- <compilerEndOption>-I/opt/win-x86_64/include</compilerEndOption>
- </compilerEndOptions>
- <linkerMiddleOptions>
-<!-- check binary link with
- x86_64-w64-mingw32-objdump -p target/netlib-native_system-win-x86_64.dll | grep DLL
--->
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-L/opt/win-x86_64/lib</linkerMiddleOption>
- <linkerMiddleOption>-lblas3</linkerMiddleOption>
- <linkerMiddleOption>-llapack3</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw64/mingw/lib/libgfortran.a</linkerMiddleOption>
- <linkerMiddleOption>/opt/mingw64/mingw/lib/libquadmath.a</linkerMiddleOption>
- <linkerMiddleOption>-static-libgcc</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <!-- Ignored, see http://sourceforge.net/p/mingw/bugs/1134/ -->
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/xbuilds/linux-armhf/pom.xml b/native_system/xbuilds/linux-armhf/pom.xml
deleted file mode 100644
index cd8da39..0000000
--- a/native_system/xbuilds/linux-armhf/pom.xml
+++ /dev/null
@@ -1,118 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system-xbuilds</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_system-linux-armhf</artifactId>
- <packaging>so</packaging>
-
- <!--
- This is built using a custom cross compiler from Debian,
- using the "rpi" config file in this directory.
-
- http://elinux.org/RPi_Linaro_GCC_Compilation
- http://crosstool-ng.org
- http://stackoverflow.com/a/13384349/1041691
-
- (don't forget to use `CT_DEBUG_CT_SAVE_STEPS=1`)
-
- Note that although Ubuntu has a gnueabihf compiler, it
- is targeted a ludicrously niche ARMv7 chip that is not
- backwards compatible with the Raspberry Pi.
-
- And obtain a JDK for ARM from
-
- http://jdk8.java.net/download.html
-
- installed into
-
- /opt/gnueabihf-arm/jdk8
-
- along with the contents of
-
- for A in b/blas/libblas-dev_1.2.20110419-5_armhf.deb b/blas/libblas3_1.2.20110419-5_armhf.deb l/lapack/liblapack-dev_3.4.2%2bdfsg-1_armhf.deb l/lapack/liblapack3_3.4.2%2bdfsg-1_armhf.deb ; do
- curl -O "http://archive.raspbian.org/raspbian/pool/main/$A"
- ar vx `basename $A`
- sudo tar xfzv data.tar.gz -C /opt/gnueabihf-arm/
- done
- -->
- <properties>
- <netlib.src>../../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_system-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>linux</javahOS>
- <jdkIncludePath>/opt/gnueabihf-arm/jdk8/include</jdkIncludePath>
- <compilerExecutable>arm-rpi-linux-gnueabi-gcc</compilerExecutable>
- <linkerExecutable>arm-rpi-linux-gnueabi-gcc</linkerExecutable>
- <compilerStartOptions>
- <compilerStartOption>-Os</compilerStartOption>
- <compilerStartOption>-I/opt/gnueabihf-arm/usr/include/</compilerStartOption>
- </compilerStartOptions>
- <linkerMiddleOptions>
-<!-- Inspect binary with
-arm-rpi-linux-gnueabi-readelf -a target/netlib-native_system-linux-armhf.so | grep "Shared library:"
--->
- <linkerMiddleOption>-L/opt/gnueabihf-arm/usr/lib/libblas</linkerMiddleOption>
- <linkerMiddleOption>-L/opt/gnueabihf-arm/usr/lib/lapack</linkerMiddleOption>
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-lblas</linkerMiddleOption>
- <linkerMiddleOption>-llapack</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/xbuilds/linux-i686/pom.xml b/native_system/xbuilds/linux-i686/pom.xml
deleted file mode 100644
index 0e5753c..0000000
--- a/native_system/xbuilds/linux-i686/pom.xml
+++ /dev/null
@@ -1,118 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system-xbuilds</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_system-linux-i686</artifactId>
- <packaging>so</packaging>
-
- <!--
- This is built for Linux i686 on an x86_64 architecture.
-
- sudo apt-get install libc6-dev-i386 gfortran-multilib
-
- get the 32 bit JDK from
-
- http://www.oracle.com/technetwork/java/javase/downloads/jdk7-downloads-1880260.html
-
- and install into
-
- /opt/linux-i686/jdk7
-
- along with the contents of
-
- for A in b/blas/libblas-dev_1.2.20110419-5_i386.deb b/blas/libblas3_1.2.20110419-5_i386.deb l/lapack/liblapack3_3.4.1+dfsg-1+deb70u1_i386.deb l/lapack/liblapack-dev_3.4.1+dfsg-1+deb70u1_i386.deb ; do
- curl -O "http://mirrors.kernel.org/debian/pool/main/$A"
- ar vx `basename $A`
- sudo tar xfzv data.tar.gz -C /opt/linux-i686/
- done
-
- It is impossible to compile a library on Ubuntu that has static
- references to the fortran libraries, as the static fortran library
- has not been compiled with -fPIC. The only workaround would be
- to compile gcc from scratch, with the flags added, and then compile
- these natives. That is not a wise move.
-
- NOTE: on some Ubuntu systems, the libblas.so.3 and liblapack.so.3
- don't always exist. So you need to create them against the
- sudo ln -s libblas.so /usr/lib/libblas.so.3
- sudo ln -s liblapack.so /usr/lib/liblapack.so.3
- -->
- <properties>
- <netlib.src>../../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_system-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>linux</javahOS>
- <jdkIncludePath>/opt/linux-i686/jdk7/include</jdkIncludePath>
- <compilerEndOptions>
- <compilerEndOption>-m32</compilerEndOption>
- <compilerEndOption>-I/opt/linux-i686/usr/include/</compilerEndOption>
- </compilerEndOptions>
- <linkerEndOptions>
- <linkerEndOption>-m32</linkerEndOption>
- </linkerEndOptions>
- <linkerMiddleOptions>
- <linkerMiddleOption>-L/opt/linux-i686/usr/lib/libblas</linkerMiddleOption>
- <linkerMiddleOption>-L/opt/linux-i686/usr/lib/lapack</linkerMiddleOption>
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-lblas</linkerMiddleOption>
- <linkerMiddleOption>-llapack</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/xbuilds/linux-x86_64/pom.xml b/native_system/xbuilds/linux-x86_64/pom.xml
deleted file mode 100644
index 24468b3..0000000
--- a/native_system/xbuilds/linux-x86_64/pom.xml
+++ /dev/null
@@ -1,100 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system-xbuilds</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>netlib-native_system-linux-x86_64</artifactId>
- <packaging>so</packaging>
-
- <!--
- This is built natively for Linux x86_64 on an x86_64 architecture.
- Ubuntu Wheezy is best as it compiles for GLIBC_2.2.5 whereas Ubuntu
- requires the more recent GLIBC_2.13.
-
- sudo apt-get install gfortran openjdk-7-jdk libblas-dev liblapack-dev
-
- DO NOT INSTALL OPENBLAS at compile time or it will (unexplicably)
- be added to the link path.
-
- It is impossible to compile a library on Ubuntu that has static
- references to the fortran libraries, as the static fortran library
- has not been compiled with -fPIC. The only workaround would be
- to compile gcc from scratch, with the flags added, and then compile
- these natives. That is not a wise move.
-
- Don't forget to enable your optimised system libraries at runtime!
- (double dashes below... damn you XML!)
-
- sudo update-alternatives - -config libblas.so.3
- sudo update-alternatives - -config liblapack.so.3
-
- see https://wiki.debian.org/DebianScience/LinearAlgebraLibraries for more.
- -->
- <properties>
- <netlib.src>../../../netlib</netlib.src>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <artifactId>native_system-java</artifactId>
- <version>${project.parent.version}</version>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <executions>
- <execution>
- <id>blas</id>
- </execution>
- <execution>
- <id>lapack</id>
- </execution>
- <execution>
- <id>arpack</id>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <extensions>true</extensions>
- <configuration>
- <javahOS>linux</javahOS>
- <linkerMiddleOptions>
- <linkerMiddleOption>-shared</linkerMiddleOption>
- <linkerMiddleOption>-lgfortran</linkerMiddleOption>
- <linkerMiddleOption>-lblas</linkerMiddleOption>
- <linkerMiddleOption>-llapack</linkerMiddleOption>
- <linkerMiddleOption>-Wl,-s</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--version-script=${netlib.src}/symbol.map</linkerMiddleOption>
- <linkerMiddleOption>-Wl,--gc-sections</linkerMiddleOption>
- </linkerMiddleOptions>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <executions>
- <execution>
- <id>runtime</id>
- </execution>
- <execution>
- <id>source</id>
- </execution>
- </executions>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/native_system/xbuilds/pom.xml b/native_system/xbuilds/pom.xml
deleted file mode 100644
index 0de0062..0000000
--- a/native_system/xbuilds/pom.xml
+++ /dev/null
@@ -1,28 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <!--
- This is an artificial package that facilitates easy cross
- compiles for various targets from Linux (because OS X
- cross building doesn't work so well).
- -->
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>native_system</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>native_system-xbuilds</artifactId>
- <packaging>pom</packaging>
-
- <modules>
- <module>linux-x86_64</module>
- <module>linux-i686</module>
- <module>linux-armhf</module>
- </modules>
-
-</project>
diff --git a/nbproject/build-impl.xml b/nbproject/build-impl.xml
new file mode 100644
index 0000000..c1e8ddf
--- /dev/null
+++ b/nbproject/build-impl.xml
@@ -0,0 +1,1066 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!--
+*** GENERATED FROM project.xml - DO NOT EDIT ***
+*** EDIT ../build.xml INSTEAD ***
+
+For the purpose of easier reading the script
+is divided into following sections:
+
+ - initialization
+ - compilation
+ - jar
+ - execution
+ - debugging
+ - javadoc
+ - junit compilation
+ - junit execution
+ - junit debugging
+ - applet
+ - cleanup
+
+ -->
+<project xmlns:j2seproject1="http://www.netbeans.org/ns/j2se-project/1" xmlns:j2seproject3="http://www.netbeans.org/ns/j2se-project/3" xmlns:jaxrpc="http://www.netbeans.org/ns/j2se-project/jax-rpc" basedir=".." default="default" name="netlib-java-impl">
+ <fail message="Please build using Ant 1.7.1 or higher.">
+ <condition>
+ <not>
+ <antversion atleast="1.7.1"/>
+ </not>
+ </condition>
+ </fail>
+ <target depends="test,jar,javadoc" description="Build and test whole project." name="default"/>
+ <!--
+ ======================
+ INITIALIZATION SECTION
+ ======================
+ -->
+ <target name="-pre-init">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="-pre-init" name="-init-private">
+ <property file="nbproject/private/config.properties"/>
+ <property file="nbproject/private/configs/${config}.properties"/>
+ <property file="nbproject/private/private.properties"/>
+ </target>
+ <target name="-pre-init-libraries">
+ <property location="./lib/nblibraries.properties" name="libraries.path"/>
+ <dirname file="${libraries.path}" property="libraries.dir.nativedirsep"/>
+ <pathconvert dirsep="/" property="libraries.dir">
+ <path path="${libraries.dir.nativedirsep}"/>
+ </pathconvert>
+ <basename file="${libraries.path}" property="libraries.basename" suffix=".properties"/>
+ <available file="${libraries.dir}/${libraries.basename}-private.properties" property="private.properties.available"/>
+ </target>
+ <target depends="-pre-init-libraries" if="private.properties.available" name="-init-private-libraries">
+ <loadproperties encoding="ISO-8859-1" srcfile="${libraries.dir}/${libraries.basename}-private.properties">
+ <filterchain>
+ <replacestring from="$${base}" to="${libraries.dir}"/>
+ <escapeunicode/>
+ </filterchain>
+ </loadproperties>
+ </target>
+ <target depends="-pre-init,-init-private,-init-private-libraries" name="-init-libraries">
+ <loadproperties encoding="ISO-8859-1" srcfile="${libraries.path}">
+ <filterchain>
+ <replacestring from="$${base}" to="${libraries.dir}"/>
+ <escapeunicode/>
+ </filterchain>
+ </loadproperties>
+ </target>
+ <target depends="-pre-init,-init-private,-init-libraries" name="-init-user">
+ <property file="${user.properties.file}"/>
+ <!-- The two properties below are usually overridden -->
+ <!-- by the active platform. Just a fallback. -->
+ <property name="default.javac.source" value="1.4"/>
+ <property name="default.javac.target" value="1.4"/>
+ </target>
+ <target depends="-pre-init,-init-private,-init-libraries,-init-user" name="-init-project">
+ <property file="nbproject/configs/${config}.properties"/>
+ <property file="nbproject/project.properties"/>
+ </target>
+ <target depends="-pre-init,-init-private,-init-libraries,-init-user,-init-project,-init-macrodef-property" name="-do-init">
+ <available file="${manifest.file}" property="manifest.available"/>
+ <condition property="splashscreen.available">
+ <and>
+ <not>
+ <equals arg1="${application.splash}" arg2="" trim="true"/>
+ </not>
+ <available file="${application.splash}"/>
+ </and>
+ </condition>
+ <condition property="main.class.available">
+ <and>
+ <isset property="main.class"/>
+ <not>
+ <equals arg1="${main.class}" arg2="" trim="true"/>
+ </not>
+ </and>
+ </condition>
+ <condition property="manifest.available+main.class">
+ <and>
+ <isset property="manifest.available"/>
+ <isset property="main.class.available"/>
+ </and>
+ </condition>
+ <condition property="do.archive">
+ <not>
+ <istrue value="${jar.archive.disabled}"/>
+ </not>
+ </condition>
+ <condition property="do.mkdist">
+ <and>
+ <isset property="do.archive"/>
+ <isset property="libs.CopyLibs.classpath"/>
+ <not>
+ <istrue value="${mkdist.disabled}"/>
+ </not>
+ </and>
+ </condition>
+ <condition property="manifest.available+main.class+mkdist.available">
+ <and>
+ <istrue value="${manifest.available+main.class}"/>
+ <isset property="do.mkdist"/>
+ </and>
+ </condition>
+ <condition property="do.archive+manifest.available">
+ <and>
+ <isset property="manifest.available"/>
+ <istrue value="${do.archive}"/>
+ </and>
+ </condition>
+ <condition property="do.archive+main.class.available">
+ <and>
+ <isset property="main.class.available"/>
+ <istrue value="${do.archive}"/>
+ </and>
+ </condition>
+ <condition property="do.archive+splashscreen.available">
+ <and>
+ <isset property="splashscreen.available"/>
+ <istrue value="${do.archive}"/>
+ </and>
+ </condition>
+ <condition property="do.archive+manifest.available+main.class">
+ <and>
+ <istrue value="${manifest.available+main.class}"/>
+ <istrue value="${do.archive}"/>
+ </and>
+ </condition>
+ <condition property="manifest.available-mkdist.available">
+ <or>
+ <istrue value="${manifest.available}"/>
+ <isset property="do.mkdist"/>
+ </or>
+ </condition>
+ <condition property="manifest.available+main.class-mkdist.available">
+ <or>
+ <istrue value="${manifest.available+main.class}"/>
+ <isset property="do.mkdist"/>
+ </or>
+ </condition>
+ <condition property="have.tests">
+ <or>
+ <available file="${test.src.dir}"/>
+ </or>
+ </condition>
+ <condition property="have.sources">
+ <or>
+ <available file="${src.dir}"/>
+ </or>
+ </condition>
+ <condition property="netbeans.home+have.tests">
+ <and>
+ <isset property="netbeans.home"/>
+ <isset property="have.tests"/>
+ </and>
+ </condition>
+ <condition property="no.javadoc.preview">
+ <and>
+ <isset property="javadoc.preview"/>
+ <isfalse value="${javadoc.preview}"/>
+ </and>
+ </condition>
+ <property name="run.jvmargs" value=""/>
+ <property name="javac.compilerargs" value=""/>
+ <property name="work.dir" value="${basedir}"/>
+ <condition property="no.deps">
+ <and>
+ <istrue value="${no.dependencies}"/>
+ </and>
+ </condition>
+ <property name="javac.debug" value="true"/>
+ <property name="javadoc.preview" value="true"/>
+ <property name="application.args" value=""/>
+ <property name="source.encoding" value="${file.encoding}"/>
+ <property name="runtime.encoding" value="${source.encoding}"/>
+ <condition property="javadoc.encoding.used" value="${javadoc.encoding}">
+ <and>
+ <isset property="javadoc.encoding"/>
+ <not>
+ <equals arg1="${javadoc.encoding}" arg2=""/>
+ </not>
+ </and>
+ </condition>
+ <property name="javadoc.encoding.used" value="${source.encoding}"/>
+ <property name="includes" value="**"/>
+ <property name="excludes" value=""/>
+ <property name="do.depend" value="false"/>
+ <condition property="do.depend.true">
+ <istrue value="${do.depend}"/>
+ </condition>
+ <path id="endorsed.classpath.path" path="${endorsed.classpath}"/>
+ <condition else="" property="endorsed.classpath.cmd.line.arg" value="-Xbootclasspath/p:'${toString:endorsed.classpath.path}'">
+ <length length="0" string="${endorsed.classpath}" when="greater"/>
+ </condition>
+ <condition else="false" property="jdkBug6558476">
+ <and>
+ <matches pattern="1\.[56]" string="${java.specification.version}"/>
+ <not>
+ <os family="unix"/>
+ </not>
+ </and>
+ </condition>
+ <property name="javac.fork" value="${jdkBug6558476}"/>
+ <property name="jar.index" value="false"/>
+ <property name="jar.index.metainf" value="${jar.index}"/>
+ <available file="${meta.inf.dir}/persistence.xml" property="has.persistence.xml"/>
+ </target>
+ <target name="-post-init">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="-pre-init,-init-private,-init-libraries,-init-user,-init-project,-do-init" name="-init-check">
+ <fail unless="src.dir">Must set src.dir</fail>
+ <fail unless="test.src.dir">Must set test.src.dir</fail>
+ <fail unless="build.dir">Must set build.dir</fail>
+ <fail unless="dist.dir">Must set dist.dir</fail>
+ <fail unless="build.classes.dir">Must set build.classes.dir</fail>
+ <fail unless="dist.javadoc.dir">Must set dist.javadoc.dir</fail>
+ <fail unless="build.test.classes.dir">Must set build.test.classes.dir</fail>
+ <fail unless="build.test.results.dir">Must set build.test.results.dir</fail>
+ <fail unless="build.classes.excludes">Must set build.classes.excludes</fail>
+ <fail unless="dist.jar">Must set dist.jar</fail>
+ </target>
+ <target name="-init-macrodef-property">
+ <macrodef name="property" uri="http://www.netbeans.org/ns/j2se-project/1">
+ <attribute name="name"/>
+ <attribute name="value"/>
+ <sequential>
+ <property name="@{name}" value="${@{value}}"/>
+ </sequential>
+ </macrodef>
+ </target>
+ <target depends="-init-ap-cmdline-properties" if="ap.supported.internal" name="-init-macrodef-javac-with-processors">
+ <macrodef name="javac" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${src.dir}" name="srcdir"/>
+ <attribute default="${build.classes.dir}" name="destdir"/>
+ <attribute default="${javac.classpath}" name="classpath"/>
+ <attribute default="${javac.processorpath}" name="processorpath"/>
+ <attribute default="${build.generated.sources.dir}/ap-source-output" name="apgeneratedsrcdir"/>
+ <attribute default="${includes}" name="includes"/>
+ <attribute default="${excludes}" name="excludes"/>
+ <attribute default="${javac.debug}" name="debug"/>
+ <attribute default="${empty.dir}" name="sourcepath"/>
+ <attribute default="${empty.dir}" name="gensrcdir"/>
+ <element name="customize" optional="true"/>
+ <sequential>
+ <property location="${build.dir}/empty" name="empty.dir"/>
+ <mkdir dir="${empty.dir}"/>
+ <mkdir dir="@{apgeneratedsrcdir}"/>
+ <javac debug="@{debug}" deprecation="${javac.deprecation}" destdir="@{destdir}" encoding="${source.encoding}" excludes="@{excludes}" fork="${javac.fork}" includeantruntime="false" includes="@{includes}" source="${javac.source}" sourcepath="@{sourcepath}" srcdir="@{srcdir}" target="${javac.target}" tempdir="${java.io.tmpdir}">
+ <src>
+ <dirset dir="@{gensrcdir}" erroronmissingdir="false">
+ <include name="*"/>
+ </dirset>
+ </src>
+ <classpath>
+ <path path="@{classpath}"/>
+ </classpath>
+ <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
+ <compilerarg line="${javac.compilerargs}"/>
+ <compilerarg value="-processorpath"/>
+ <compilerarg path="@{processorpath}:${empty.dir}"/>
+ <compilerarg line="${ap.processors.internal}"/>
+ <compilerarg line="${annotation.processing.processor.options}"/>
+ <compilerarg value="-s"/>
+ <compilerarg path="@{apgeneratedsrcdir}"/>
+ <compilerarg line="${ap.proc.none.internal}"/>
+ <customize/>
+ </javac>
+ </sequential>
+ </macrodef>
+ </target>
+ <target depends="-init-ap-cmdline-properties" name="-init-macrodef-javac-without-processors" unless="ap.supported.internal">
+ <macrodef name="javac" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${src.dir}" name="srcdir"/>
+ <attribute default="${build.classes.dir}" name="destdir"/>
+ <attribute default="${javac.classpath}" name="classpath"/>
+ <attribute default="${javac.processorpath}" name="processorpath"/>
+ <attribute default="${build.generated.sources.dir}/ap-source-output" name="apgeneratedsrcdir"/>
+ <attribute default="${includes}" name="includes"/>
+ <attribute default="${excludes}" name="excludes"/>
+ <attribute default="${javac.debug}" name="debug"/>
+ <attribute default="${empty.dir}" name="sourcepath"/>
+ <attribute default="${empty.dir}" name="gensrcdir"/>
+ <element name="customize" optional="true"/>
+ <sequential>
+ <property location="${build.dir}/empty" name="empty.dir"/>
+ <mkdir dir="${empty.dir}"/>
+ <javac debug="@{debug}" deprecation="${javac.deprecation}" destdir="@{destdir}" encoding="${source.encoding}" excludes="@{excludes}" fork="${javac.fork}" includeantruntime="false" includes="@{includes}" source="${javac.source}" sourcepath="@{sourcepath}" srcdir="@{srcdir}" target="${javac.target}" tempdir="${java.io.tmpdir}">
+ <src>
+ <dirset dir="@{gensrcdir}" erroronmissingdir="false">
+ <include name="*"/>
+ </dirset>
+ </src>
+ <classpath>
+ <path path="@{classpath}"/>
+ </classpath>
+ <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
+ <compilerarg line="${javac.compilerargs}"/>
+ <customize/>
+ </javac>
+ </sequential>
+ </macrodef>
+ </target>
+ <target depends="-init-macrodef-javac-with-processors,-init-macrodef-javac-without-processors" name="-init-macrodef-javac">
+ <macrodef name="depend" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${src.dir}" name="srcdir"/>
+ <attribute default="${build.classes.dir}" name="destdir"/>
+ <attribute default="${javac.classpath}" name="classpath"/>
+ <sequential>
+ <depend cache="${build.dir}/depcache" destdir="@{destdir}" excludes="${excludes}" includes="${includes}" srcdir="@{srcdir}">
+ <classpath>
+ <path path="@{classpath}"/>
+ </classpath>
+ </depend>
+ </sequential>
+ </macrodef>
+ <macrodef name="force-recompile" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${build.classes.dir}" name="destdir"/>
+ <sequential>
+ <fail unless="javac.includes">Must set javac.includes</fail>
+ <pathconvert pathsep="${line.separator}" property="javac.includes.binary">
+ <path>
+ <filelist dir="@{destdir}" files="${javac.includes}"/>
+ </path>
+ <globmapper from="*.java" to="*.class"/>
+ </pathconvert>
+ <tempfile deleteonexit="true" property="javac.includesfile.binary"/>
+ <echo file="${javac.includesfile.binary}" message="${javac.includes.binary}"/>
+ <delete>
+ <files includesfile="${javac.includesfile.binary}"/>
+ </delete>
+ <delete>
+ <fileset file="${javac.includesfile.binary}"/>
+ </delete>
+ </sequential>
+ </macrodef>
+ </target>
+ <target name="-init-macrodef-junit">
+ <macrodef name="junit" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${includes}" name="includes"/>
+ <attribute default="${excludes}" name="excludes"/>
+ <attribute default="**" name="testincludes"/>
+ <sequential>
+ <property name="junit.forkmode" value="perTest"/>
+ <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" forkmode="${junit.forkmode}" showoutput="true" tempdir="${build.dir}">
+ <batchtest todir="${build.test.results.dir}">
+ <fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
+ <filename name="@{testincludes}"/>
+ </fileset>
+ </batchtest>
+ <classpath>
+ <path path="${run.test.classpath}"/>
+ </classpath>
+ <syspropertyset>
+ <propertyref prefix="test-sys-prop."/>
+ <mapper from="test-sys-prop.*" to="*" type="glob"/>
+ </syspropertyset>
+ <formatter type="brief" usefile="false"/>
+ <formatter type="xml"/>
+ <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
+ <jvmarg value="-ea"/>
+ <jvmarg line="${run.jvmargs}"/>
+ </junit>
+ </sequential>
+ </macrodef>
+ </target>
+ <target depends="-profile-pre-init, init, -profile-post-init, -profile-init-macrodef-profile, -profile-init-check" name="profile-init"/>
+ <target name="-profile-pre-init">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target name="-profile-post-init">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target name="-profile-init-macrodef-profile">
+ <macrodef name="resolve">
+ <attribute name="name"/>
+ <attribute name="value"/>
+ <sequential>
+ <property name="@{name}" value="${env.@{value}}"/>
+ </sequential>
+ </macrodef>
+ <macrodef name="profile">
+ <attribute default="${main.class}" name="classname"/>
+ <element name="customize" optional="true"/>
+ <sequential>
+ <property environment="env"/>
+ <resolve name="profiler.current.path" value="${profiler.info.pathvar}"/>
+ <java classname="@{classname}" dir="${profiler.info.dir}" fork="true" jvm="${profiler.info.jvm}">
+ <jvmarg value="${profiler.info.jvmargs.agent}"/>
+ <jvmarg line="${profiler.info.jvmargs}"/>
+ <env key="${profiler.info.pathvar}" path="${profiler.info.agentpath}:${profiler.current.path}"/>
+ <arg line="${application.args}"/>
+ <classpath>
+ <path path="${run.classpath}"/>
+ </classpath>
+ <syspropertyset>
+ <propertyref prefix="run-sys-prop."/>
+ <mapper from="run-sys-prop.*" to="*" type="glob"/>
+ </syspropertyset>
+ <customize/>
+ </java>
+ </sequential>
+ </macrodef>
+ </target>
+ <target depends="-profile-pre-init, init, -profile-post-init, -profile-init-macrodef-profile" name="-profile-init-check">
+ <fail unless="profiler.info.jvm">Must set JVM to use for profiling in profiler.info.jvm</fail>
+ <fail unless="profiler.info.jvmargs.agent">Must set profiler agent JVM arguments in profiler.info.jvmargs.agent</fail>
+ </target>
+ <target depends="-init-debug-args" name="-init-macrodef-nbjpda">
+ <macrodef name="nbjpdastart" uri="http://www.netbeans.org/ns/j2se-project/1">
+ <attribute default="${main.class}" name="name"/>
+ <attribute default="${debug.classpath}" name="classpath"/>
+ <attribute default="" name="stopclassname"/>
+ <sequential>
+ <nbjpdastart addressproperty="jpda.address" name="@{name}" stopclassname="@{stopclassname}" transport="${debug-transport}">
+ <classpath>
+ <path path="@{classpath}"/>
+ </classpath>
+ </nbjpdastart>
+ </sequential>
+ </macrodef>
+ <macrodef name="nbjpdareload" uri="http://www.netbeans.org/ns/j2se-project/1">
+ <attribute default="${build.classes.dir}" name="dir"/>
+ <sequential>
+ <nbjpdareload>
+ <fileset dir="@{dir}" includes="${fix.classes}">
+ <include name="${fix.includes}*.class"/>
+ </fileset>
+ </nbjpdareload>
+ </sequential>
+ </macrodef>
+ </target>
+ <target name="-init-debug-args">
+ <property name="version-output" value="java version "${ant.java.version}"/>
+ <condition property="have-jdk-older-than-1.4">
+ <or>
+ <contains string="${version-output}" substring="java version "1.0"/>
+ <contains string="${version-output}" substring="java version "1.1"/>
+ <contains string="${version-output}" substring="java version "1.2"/>
+ <contains string="${version-output}" substring="java version "1.3"/>
+ </or>
+ </condition>
+ <condition else="-Xdebug" property="debug-args-line" value="-Xdebug -Xnoagent -Djava.compiler=none">
+ <istrue value="${have-jdk-older-than-1.4}"/>
+ </condition>
+ <condition else="dt_socket" property="debug-transport-by-os" value="dt_shmem">
+ <os family="windows"/>
+ </condition>
+ <condition else="${debug-transport-by-os}" property="debug-transport" value="${debug.transport}">
+ <isset property="debug.transport"/>
+ </condition>
+ </target>
+ <target depends="-init-debug-args" name="-init-macrodef-debug">
+ <macrodef name="debug" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${main.class}" name="classname"/>
+ <attribute default="${debug.classpath}" name="classpath"/>
+ <element name="customize" optional="true"/>
+ <sequential>
+ <java classname="@{classname}" dir="${work.dir}" fork="true">
+ <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
+ <jvmarg line="${debug-args-line}"/>
+ <jvmarg value="-Xrunjdwp:transport=${debug-transport},address=${jpda.address}"/>
+ <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
+ <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
+ <jvmarg line="${run.jvmargs}"/>
+ <classpath>
+ <path path="@{classpath}"/>
+ </classpath>
+ <syspropertyset>
+ <propertyref prefix="run-sys-prop."/>
+ <mapper from="run-sys-prop.*" to="*" type="glob"/>
+ </syspropertyset>
+ <customize/>
+ </java>
+ </sequential>
+ </macrodef>
+ </target>
+ <target name="-init-macrodef-java">
+ <macrodef name="java" uri="http://www.netbeans.org/ns/j2se-project/1">
+ <attribute default="${main.class}" name="classname"/>
+ <attribute default="${run.classpath}" name="classpath"/>
+ <element name="customize" optional="true"/>
+ <sequential>
+ <java classname="@{classname}" dir="${work.dir}" fork="true">
+ <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
+ <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
+ <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
+ <jvmarg line="${run.jvmargs}"/>
+ <classpath>
+ <path path="@{classpath}"/>
+ </classpath>
+ <syspropertyset>
+ <propertyref prefix="run-sys-prop."/>
+ <mapper from="run-sys-prop.*" to="*" type="glob"/>
+ </syspropertyset>
+ <customize/>
+ </java>
+ </sequential>
+ </macrodef>
+ </target>
+ <target name="-init-macrodef-copylibs">
+ <macrodef name="copylibs" uri="http://www.netbeans.org/ns/j2se-project/3">
+ <attribute default="${manifest.file}" name="manifest"/>
+ <element name="customize" optional="true"/>
+ <sequential>
+ <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
+ <pathconvert property="run.classpath.without.build.classes.dir">
+ <path path="${run.classpath}"/>
+ <map from="${build.classes.dir.resolved}" to=""/>
+ </pathconvert>
+ <pathconvert pathsep=" " property="jar.classpath">
+ <path path="${run.classpath.without.build.classes.dir}"/>
+ <chainedmapper>
+ <flattenmapper/>
+ <globmapper from="*" to="lib/*"/>
+ </chainedmapper>
+ </pathconvert>
+ <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
+ <copylibs compress="${jar.compress}" index="${jar.index}" indexMetaInf="${jar.index.metainf}" jarfile="${dist.jar}" manifest="@{manifest}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
+ <fileset dir="${build.classes.dir}"/>
+ <manifest>
+ <attribute name="Class-Path" value="${jar.classpath}"/>
+ <customize/>
+ </manifest>
+ </copylibs>
+ </sequential>
+ </macrodef>
+ </target>
+ <target name="-init-presetdef-jar">
+ <presetdef name="jar" uri="http://www.netbeans.org/ns/j2se-project/1">
+ <jar compress="${jar.compress}" index="${jar.index}" jarfile="${dist.jar}">
+ <j2seproject1:fileset dir="${build.classes.dir}"/>
+ </jar>
+ </presetdef>
+ </target>
+ <target name="-init-ap-cmdline-properties">
+ <property name="annotation.processing.enabled" value="true"/>
+ <property name="annotation.processing.processors.list" value=""/>
+ <property name="annotation.processing.processor.options" value=""/>
+ <property name="annotation.processing.run.all.processors" value="true"/>
+ <property name="javac.processorpath" value="${javac.classpath}"/>
+ <property name="javac.test.processorpath" value="${javac.test.classpath}"/>
+ <condition property="ap.supported.internal" value="true">
+ <not>
+ <matches pattern="1\.[0-5](\..*)?" string="${javac.source}"/>
+ </not>
+ </condition>
+ </target>
+ <target depends="-init-ap-cmdline-properties" if="ap.supported.internal" name="-init-ap-cmdline-supported">
+ <condition else="" property="ap.processors.internal" value="-processor ${annotation.processing.processors.list}">
+ <isfalse value="${annotation.processing.run.all.processors}"/>
+ </condition>
+ <condition else="" property="ap.proc.none.internal" value="-proc:none">
+ <isfalse value="${annotation.processing.enabled}"/>
+ </condition>
+ </target>
+ <target depends="-init-ap-cmdline-properties,-init-ap-cmdline-supported" name="-init-ap-cmdline">
+ <property name="ap.cmd.line.internal" value=""/>
+ </target>
+ <target depends="-pre-init,-init-private,-init-libraries,-init-user,-init-project,-do-init,-post-init,-init-check,-init-macrodef-property,-init-macrodef-javac,-init-macrodef-junit,-init-macrodef-nbjpda,-init-macrodef-debug,-init-macrodef-java,-init-presetdef-jar,-init-ap-cmdline" name="init"/>
+ <!--
+ ===================
+ COMPILATION SECTION
+ ===================
+ -->
+ <target name="-deps-jar-init" unless="built-jar.properties">
+ <property location="${build.dir}/built-jar.properties" name="built-jar.properties"/>
+ <delete file="${built-jar.properties}" quiet="true"/>
+ </target>
+ <target if="already.built.jar.${basedir}" name="-warn-already-built-jar">
+ <echo level="warn" message="Cycle detected: netlib-java was already built"/>
+ </target>
+ <target depends="init,-deps-jar-init" name="deps-jar" unless="no.deps">
+ <mkdir dir="${build.dir}"/>
+ <touch file="${built-jar.properties}" verbose="false"/>
+ <property file="${built-jar.properties}" prefix="already.built.jar."/>
+ <antcall target="-warn-already-built-jar"/>
+ <propertyfile file="${built-jar.properties}">
+ <entry key="${basedir}" value=""/>
+ </propertyfile>
+ </target>
+ <target depends="init,-check-automatic-build,-clean-after-automatic-build" name="-verify-automatic-build"/>
+ <target depends="init" name="-check-automatic-build">
+ <available file="${build.classes.dir}/.netbeans_automatic_build" property="netbeans.automatic.build"/>
+ </target>
+ <target depends="init" if="netbeans.automatic.build" name="-clean-after-automatic-build">
+ <antcall target="clean"/>
+ </target>
+ <target depends="init,deps-jar" name="-pre-pre-compile">
+ <mkdir dir="${build.classes.dir}"/>
+ </target>
+ <target name="-pre-compile">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target if="do.depend.true" name="-compile-depend">
+ <pathconvert property="build.generated.subdirs">
+ <dirset dir="${build.generated.sources.dir}" erroronmissingdir="false">
+ <include name="*"/>
+ </dirset>
+ </pathconvert>
+ <j2seproject3:depend srcdir="${src.dir}:${build.generated.subdirs}"/>
+ </target>
+ <target depends="init,deps-jar,-pre-pre-compile,-pre-compile, -copy-persistence-xml,-compile-depend" if="have.sources" name="-do-compile">
+ <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
+ <copy todir="${build.classes.dir}">
+ <fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
+ </copy>
+ </target>
+ <target if="has.persistence.xml" name="-copy-persistence-xml">
+ <mkdir dir="${build.classes.dir}/META-INF"/>
+ <copy todir="${build.classes.dir}/META-INF">
+ <fileset dir="${meta.inf.dir}" includes="persistence.xml"/>
+ </copy>
+ </target>
+ <target name="-post-compile">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,deps-jar,-verify-automatic-build,-pre-pre-compile,-pre-compile,-do-compile,-post-compile" description="Compile project." name="compile"/>
+ <target name="-pre-compile-single">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,deps-jar,-pre-pre-compile" name="-do-compile-single">
+ <fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
+ <j2seproject3:force-recompile/>
+ <j2seproject3:javac excludes="" gensrcdir="${build.generated.sources.dir}" includes="${javac.includes}" sourcepath="${src.dir}"/>
+ </target>
+ <target name="-post-compile-single">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,deps-jar,-verify-automatic-build,-pre-pre-compile,-pre-compile-single,-do-compile-single,-post-compile-single" name="compile-single"/>
+ <!--
+ ====================
+ JAR BUILDING SECTION
+ ====================
+ -->
+ <target depends="init" name="-pre-pre-jar">
+ <dirname file="${dist.jar}" property="dist.jar.dir"/>
+ <mkdir dir="${dist.jar.dir}"/>
+ </target>
+ <target name="-pre-jar">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.archive" name="-do-jar-without-manifest" unless="manifest.available-mkdist.available">
+ <j2seproject1:jar/>
+ </target>
+ <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.archive+manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class-mkdist.available">
+ <j2seproject1:jar manifest="${manifest.file}"/>
+ </target>
+ <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.archive+manifest.available+main.class" name="-do-jar-with-mainclass" unless="manifest.available+main.class+mkdist.available">
+ <j2seproject1:jar manifest="${manifest.file}">
+ <j2seproject1:manifest>
+ <j2seproject1:attribute name="Main-Class" value="${main.class}"/>
+ </j2seproject1:manifest>
+ </j2seproject1:jar>
+ <echo level="info">To run this application from the command line without Ant, try:</echo>
+ <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
+ <property location="${dist.jar}" name="dist.jar.resolved"/>
+ <pathconvert property="run.classpath.with.dist.jar">
+ <path path="${run.classpath}"/>
+ <map from="${build.classes.dir.resolved}" to="${dist.jar.resolved}"/>
+ </pathconvert>
+ <echo level="info">java -cp "${run.classpath.with.dist.jar}" ${main.class}</echo>
+ </target>
+ <target depends="init" if="do.archive" name="-do-jar-with-libraries-create-manifest" unless="manifest.available">
+ <tempfile deleteonexit="true" destdir="${build.dir}" property="tmp.manifest.file"/>
+ <touch file="${tmp.manifest.file}" verbose="false"/>
+ </target>
+ <target depends="init" if="do.archive+manifest.available" name="-do-jar-with-libraries-copy-manifest">
+ <tempfile deleteonexit="true" destdir="${build.dir}" property="tmp.manifest.file"/>
+ <copy file="${manifest.file}" tofile="${tmp.manifest.file}"/>
+ </target>
+ <target depends="init,-do-jar-with-libraries-create-manifest,-do-jar-with-libraries-copy-manifest" if="do.archive+main.class.available" name="-do-jar-with-libraries-set-main">
+ <manifest file="${tmp.manifest.file}" mode="update">
+ <attribute name="Main-Class" value="${main.class}"/>
+ </manifest>
+ </target>
+ <target depends="init,-do-jar-with-libraries-create-manifest,-do-jar-with-libraries-copy-manifest" if="do.archive+splashscreen.available" name="-do-jar-with-libraries-set-splashscreen">
+ <basename file="${application.splash}" property="splashscreen.basename"/>
+ <mkdir dir="${build.classes.dir}/META-INF"/>
+ <copy failonerror="false" file="${application.splash}" todir="${build.classes.dir}/META-INF"/>
+ <manifest file="${tmp.manifest.file}" mode="update">
+ <attribute name="SplashScreen-Image" value="META-INF/${splashscreen.basename}"/>
+ </manifest>
+ </target>
+ <target depends="init,-init-macrodef-copylibs,compile,-pre-pre-jar,-pre-jar,-do-jar-with-libraries-create-manifest,-do-jar-with-libraries-copy-manifest,-do-jar-with-libraries-set-main,-do-jar-with-libraries-set-splashscreen" if="do.mkdist" name="-do-jar-with-libraries-pack">
+ <j2seproject3:copylibs manifest="${tmp.manifest.file}"/>
+ <echo level="info">To run this application from the command line without Ant, try:</echo>
+ <property location="${dist.jar}" name="dist.jar.resolved"/>
+ <echo level="info">java -jar "${dist.jar.resolved}"</echo>
+ </target>
+ <target depends="-do-jar-with-libraries-pack" if="do.archive" name="-do-jar-with-libraries-delete-manifest">
+ <delete>
+ <fileset file="${tmp.manifest.file}"/>
+ </delete>
+ </target>
+ <target depends="init,compile,-pre-pre-jar,-pre-jar,-do-jar-with-libraries-create-manifest,-do-jar-with-libraries-copy-manifest,-do-jar-with-libraries-set-main,-do-jar-with-libraries-set-splashscreen,-do-jar-with-libraries-pack,-do-jar-with-libraries-delete-manifest" name="-do-jar-with-libraries"/>
+ <target name="-post-jar">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,compile,-pre-jar,-do-jar-with-manifest,-do-jar-without-manifest,-do-jar-with-mainclass,-do-jar-with-libraries,-post-jar" description="Build JAR." name="jar"/>
+ <!--
+ =================
+ EXECUTION SECTION
+ =================
+ -->
+ <target depends="init,compile" description="Run a main class." name="run">
+ <j2seproject1:java>
+ <customize>
+ <arg line="${application.args}"/>
+ </customize>
+ </j2seproject1:java>
+ </target>
+ <target name="-do-not-recompile">
+ <property name="javac.includes.binary" value=""/>
+ </target>
+ <target depends="init,compile-single" name="run-single">
+ <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
+ <j2seproject1:java classname="${run.class}"/>
+ </target>
+ <target depends="init,compile-test-single" name="run-test-with-main">
+ <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
+ <j2seproject1:java classname="${run.class}" classpath="${run.test.classpath}"/>
+ </target>
+ <!--
+ =================
+ DEBUGGING SECTION
+ =================
+ -->
+ <target depends="init" if="netbeans.home" name="-debug-start-debugger">
+ <j2seproject1:nbjpdastart name="${debug.class}"/>
+ </target>
+ <target depends="init" if="netbeans.home" name="-debug-start-debugger-main-test">
+ <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${debug.class}"/>
+ </target>
+ <target depends="init,compile" name="-debug-start-debuggee">
+ <j2seproject3:debug>
+ <customize>
+ <arg line="${application.args}"/>
+ </customize>
+ </j2seproject3:debug>
+ </target>
+ <target depends="init,compile,-debug-start-debugger,-debug-start-debuggee" description="Debug project in IDE." if="netbeans.home" name="debug"/>
+ <target depends="init" if="netbeans.home" name="-debug-start-debugger-stepinto">
+ <j2seproject1:nbjpdastart stopclassname="${main.class}"/>
+ </target>
+ <target depends="init,compile,-debug-start-debugger-stepinto,-debug-start-debuggee" if="netbeans.home" name="debug-stepinto"/>
+ <target depends="init,compile-single" if="netbeans.home" name="-debug-start-debuggee-single">
+ <fail unless="debug.class">Must select one file in the IDE or set debug.class</fail>
+ <j2seproject3:debug classname="${debug.class}"/>
+ </target>
+ <target depends="init,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
+ <target depends="init,compile-test-single" if="netbeans.home" name="-debug-start-debuggee-main-test">
+ <fail unless="debug.class">Must select one file in the IDE or set debug.class</fail>
+ <j2seproject3:debug classname="${debug.class}" classpath="${debug.test.classpath}"/>
+ </target>
+ <target depends="init,compile-test-single,-debug-start-debugger-main-test,-debug-start-debuggee-main-test" if="netbeans.home" name="debug-test-with-main"/>
+ <target depends="init" name="-pre-debug-fix">
+ <fail unless="fix.includes">Must set fix.includes</fail>
+ <property name="javac.includes" value="${fix.includes}.java"/>
+ </target>
+ <target depends="init,-pre-debug-fix,compile-single" if="netbeans.home" name="-do-debug-fix">
+ <j2seproject1:nbjpdareload/>
+ </target>
+ <target depends="init,-pre-debug-fix,-do-debug-fix" if="netbeans.home" name="debug-fix"/>
+ <!--
+ =================
+ PROFILING SECTION
+ =================
+ -->
+ <target depends="profile-init,compile" description="Profile a project in the IDE." if="netbeans.home" name="profile">
+ <nbprofiledirect>
+ <classpath>
+ <path path="${run.classpath}"/>
+ </classpath>
+ </nbprofiledirect>
+ <profile/>
+ </target>
+ <target depends="profile-init,compile-single" description="Profile a selected class in the IDE." if="netbeans.home" name="profile-single">
+ <fail unless="profile.class">Must select one file in the IDE or set profile.class</fail>
+ <nbprofiledirect>
+ <classpath>
+ <path path="${run.classpath}"/>
+ </classpath>
+ </nbprofiledirect>
+ <profile classname="${profile.class}"/>
+ </target>
+ <!--
+ =========================
+ APPLET PROFILING SECTION
+ =========================
+ -->
+ <target depends="profile-init,compile-single" if="netbeans.home" name="profile-applet">
+ <nbprofiledirect>
+ <classpath>
+ <path path="${run.classpath}"/>
+ </classpath>
+ </nbprofiledirect>
+ <profile classname="sun.applet.AppletViewer">
+ <customize>
+ <arg value="${applet.url}"/>
+ </customize>
+ </profile>
+ </target>
+ <!--
+ =========================
+ TESTS PROFILING SECTION
+ =========================
+ -->
+ <target depends="profile-init,compile-test-single" if="netbeans.home" name="profile-test-single">
+ <nbprofiledirect>
+ <classpath>
+ <path path="${run.test.classpath}"/>
+ </classpath>
+ </nbprofiledirect>
+ <junit dir="${profiler.info.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" jvm="${profiler.info.jvm}" showoutput="true">
+ <env key="${profiler.info.pathvar}" path="${profiler.info.agentpath}:${profiler.current.path}"/>
+ <jvmarg value="${profiler.info.jvmargs.agent}"/>
+ <jvmarg line="${profiler.info.jvmargs}"/>
+ <test name="${profile.class}"/>
+ <classpath>
+ <path path="${run.test.classpath}"/>
+ </classpath>
+ <syspropertyset>
+ <propertyref prefix="test-sys-prop."/>
+ <mapper from="test-sys-prop.*" to="*" type="glob"/>
+ </syspropertyset>
+ <formatter type="brief" usefile="false"/>
+ <formatter type="xml"/>
+ </junit>
+ </target>
+ <!--
+ ===============
+ JAVADOC SECTION
+ ===============
+ -->
+ <target depends="init" if="have.sources" name="-javadoc-build">
+ <mkdir dir="${dist.javadoc.dir}"/>
+ <javadoc additionalparam="${javadoc.additionalparam}" author="${javadoc.author}" charset="UTF-8" destdir="${dist.javadoc.dir}" docencoding="UTF-8" encoding="${javadoc.encoding.used}" failonerror="true" noindex="${javadoc.noindex}" nonavbar="${javadoc.nonavbar}" notree="${javadoc.notree}" private="${javadoc.private}" source="${javac.source}" splitindex="${javadoc.splitindex}" use="${javadoc.use}" useexternalfile="true" version="${javadoc.version}" windowtitle="${javadoc.windowtitle}">
+ <classpath>
+ <path path="${javac.classpath}"/>
+ </classpath>
+ <fileset dir="${src.dir}" excludes="${excludes}" includes="${includes}">
+ <filename name="**/*.java"/>
+ </fileset>
+ <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
+ <include name="**/*.java"/>
+ </fileset>
+ </javadoc>
+ <copy todir="${dist.javadoc.dir}">
+ <fileset dir="${src.dir}" excludes="${excludes}" includes="${includes}">
+ <filename name="**/doc-files/**"/>
+ </fileset>
+ <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
+ <include name="**/doc-files/**"/>
+ </fileset>
+ </copy>
+ </target>
+ <target depends="init,-javadoc-build" if="netbeans.home" name="-javadoc-browse" unless="no.javadoc.preview">
+ <nbbrowse file="${dist.javadoc.dir}/index.html"/>
+ </target>
+ <target depends="init,-javadoc-build,-javadoc-browse" description="Build Javadoc." name="javadoc"/>
+ <!--
+ =========================
+ JUNIT COMPILATION SECTION
+ =========================
+ -->
+ <target depends="init,compile" if="have.tests" name="-pre-pre-compile-test">
+ <mkdir dir="${build.test.classes.dir}"/>
+ </target>
+ <target name="-pre-compile-test">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target if="do.depend.true" name="-compile-test-depend">
+ <j2seproject3:depend classpath="${javac.test.classpath}" destdir="${build.test.classes.dir}" srcdir="${test.src.dir}"/>
+ </target>
+ <target depends="init,deps-jar,compile,-pre-pre-compile-test,-pre-compile-test,-compile-test-depend" if="have.tests" name="-do-compile-test">
+ <j2seproject3:javac apgeneratedsrcdir="${build.test.classes.dir}" classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" processorpath="${javac.test.processorpath}" srcdir="${test.src.dir}"/>
+ <copy todir="${build.test.classes.dir}">
+ <fileset dir="${test.src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
+ </copy>
+ </target>
+ <target name="-post-compile-test">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,compile,-pre-pre-compile-test,-pre-compile-test,-do-compile-test,-post-compile-test" name="compile-test"/>
+ <target name="-pre-compile-test-single">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,deps-jar,compile,-pre-pre-compile-test,-pre-compile-test-single" if="have.tests" name="-do-compile-test-single">
+ <fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
+ <j2seproject3:force-recompile destdir="${build.test.classes.dir}"/>
+ <j2seproject3:javac apgeneratedsrcdir="${build.test.classes.dir}" classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" excludes="" includes="${javac.includes}" processorpath="${javac.test.processorpath}" sourcepath="${test.src.dir}" srcdir="${test.src.dir}"/>
+ <copy todir="${build.test.classes.dir}">
+ <fileset dir="${test.src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
+ </copy>
+ </target>
+ <target name="-post-compile-test-single">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,compile,-pre-pre-compile-test,-pre-compile-test-single,-do-compile-test-single,-post-compile-test-single" name="compile-test-single"/>
+ <!--
+ =======================
+ JUNIT EXECUTION SECTION
+ =======================
+ -->
+ <target depends="init" if="have.tests" name="-pre-test-run">
+ <mkdir dir="${build.test.results.dir}"/>
+ </target>
+ <target depends="init,compile-test,-pre-test-run" if="have.tests" name="-do-test-run">
+ <j2seproject3:junit testincludes="**/*Test.java"/>
+ </target>
+ <target depends="init,compile-test,-pre-test-run,-do-test-run" if="have.tests" name="-post-test-run">
+ <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
+ </target>
+ <target depends="init" if="have.tests" name="test-report"/>
+ <target depends="init" if="netbeans.home+have.tests" name="-test-browse"/>
+ <target depends="init,compile-test,-pre-test-run,-do-test-run,test-report,-post-test-run,-test-browse" description="Run unit tests." name="test"/>
+ <target depends="init" if="have.tests" name="-pre-test-run-single">
+ <mkdir dir="${build.test.results.dir}"/>
+ </target>
+ <target depends="init,compile-test-single,-pre-test-run-single" if="have.tests" name="-do-test-run-single">
+ <fail unless="test.includes">Must select some files in the IDE or set test.includes</fail>
+ <j2seproject3:junit excludes="" includes="${test.includes}"/>
+ </target>
+ <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single" if="have.tests" name="-post-test-run-single">
+ <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
+ </target>
+ <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single,-post-test-run-single" description="Run single unit test." name="test-single"/>
+ <!--
+ =======================
+ JUNIT DEBUGGING SECTION
+ =======================
+ -->
+ <target depends="init,compile-test" if="have.tests" name="-debug-start-debuggee-test">
+ <fail unless="test.class">Must select one file in the IDE or set test.class</fail>
+ <property location="${build.test.results.dir}/TEST-${test.class}.xml" name="test.report.file"/>
+ <delete file="${test.report.file}"/>
+ <mkdir dir="${build.test.results.dir}"/>
+ <j2seproject3:debug classname="org.apache.tools.ant.taskdefs.optional.junit.JUnitTestRunner" classpath="${ant.home}/lib/ant.jar:${ant.home}/lib/ant-junit.jar:${debug.test.classpath}">
+ <customize>
+ <syspropertyset>
+ <propertyref prefix="test-sys-prop."/>
+ <mapper from="test-sys-prop.*" to="*" type="glob"/>
+ </syspropertyset>
+ <arg value="${test.class}"/>
+ <arg value="showoutput=true"/>
+ <arg value="formatter=org.apache.tools.ant.taskdefs.optional.junit.BriefJUnitResultFormatter"/>
+ <arg value="formatter=org.apache.tools.ant.taskdefs.optional.junit.XMLJUnitResultFormatter,${test.report.file}"/>
+ </customize>
+ </j2seproject3:debug>
+ </target>
+ <target depends="init,compile-test" if="netbeans.home+have.tests" name="-debug-start-debugger-test">
+ <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${test.class}"/>
+ </target>
+ <target depends="init,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
+ <target depends="init,-pre-debug-fix,compile-test-single" if="netbeans.home" name="-do-debug-fix-test">
+ <j2seproject1:nbjpdareload dir="${build.test.classes.dir}"/>
+ </target>
+ <target depends="init,-pre-debug-fix,-do-debug-fix-test" if="netbeans.home" name="debug-fix-test"/>
+ <!--
+ =========================
+ APPLET EXECUTION SECTION
+ =========================
+ -->
+ <target depends="init,compile-single" name="run-applet">
+ <fail unless="applet.url">Must select one file in the IDE or set applet.url</fail>
+ <j2seproject1:java classname="sun.applet.AppletViewer">
+ <customize>
+ <arg value="${applet.url}"/>
+ </customize>
+ </j2seproject1:java>
+ </target>
+ <!--
+ =========================
+ APPLET DEBUGGING SECTION
+ =========================
+ -->
+ <target depends="init,compile-single" if="netbeans.home" name="-debug-start-debuggee-applet">
+ <fail unless="applet.url">Must select one file in the IDE or set applet.url</fail>
+ <j2seproject3:debug classname="sun.applet.AppletViewer">
+ <customize>
+ <arg value="${applet.url}"/>
+ </customize>
+ </j2seproject3:debug>
+ </target>
+ <target depends="init,compile-single,-debug-start-debugger,-debug-start-debuggee-applet" if="netbeans.home" name="debug-applet"/>
+ <!--
+ ===============
+ CLEANUP SECTION
+ ===============
+ -->
+ <target name="-deps-clean-init" unless="built-clean.properties">
+ <property location="${build.dir}/built-clean.properties" name="built-clean.properties"/>
+ <delete file="${built-clean.properties}" quiet="true"/>
+ </target>
+ <target if="already.built.clean.${basedir}" name="-warn-already-built-clean">
+ <echo level="warn" message="Cycle detected: netlib-java was already built"/>
+ </target>
+ <target depends="init,-deps-clean-init" name="deps-clean" unless="no.deps">
+ <mkdir dir="${build.dir}"/>
+ <touch file="${built-clean.properties}" verbose="false"/>
+ <property file="${built-clean.properties}" prefix="already.built.clean."/>
+ <antcall target="-warn-already-built-clean"/>
+ <propertyfile file="${built-clean.properties}">
+ <entry key="${basedir}" value=""/>
+ </propertyfile>
+ </target>
+ <target depends="init" name="-do-clean">
+ <delete dir="${build.dir}"/>
+ <delete dir="${dist.dir}" followsymlinks="false" includeemptydirs="true"/>
+ </target>
+ <target name="-post-clean">
+ <!-- Empty placeholder for easier customization. -->
+ <!-- You can override this target in the ../build.xml file. -->
+ </target>
+ <target depends="init,deps-clean,-do-clean,-post-clean" description="Clean build products." name="clean"/>
+ <target name="-check-call-dep">
+ <property file="${call.built.properties}" prefix="already.built."/>
+ <condition property="should.call.dep">
+ <not>
+ <isset property="already.built.${call.subproject}"/>
+ </not>
+ </condition>
+ </target>
+ <target depends="-check-call-dep" if="should.call.dep" name="-maybe-call-dep">
+ <ant antfile="${call.script}" inheritall="false" target="${call.target}">
+ <propertyset>
+ <propertyref prefix="transfer."/>
+ <mapper from="transfer.*" to="*" type="glob"/>
+ </propertyset>
+ </ant>
+ </target>
+</project>
diff --git a/nbproject/genfiles.properties b/nbproject/genfiles.properties
new file mode 100644
index 0000000..be52bc7
--- /dev/null
+++ b/nbproject/genfiles.properties
@@ -0,0 +1,8 @@
+build.xml.data.CRC32=39483e5f
+build.xml.script.CRC32=95985d7a
+build.xml.stylesheet.CRC32=be360661
+# This file is used by a NetBeans-based IDE to track changes in generated files such as build-impl.xml.
+# Do not edit this file. You may delete it but then the IDE will never regenerate such files for you.
+nbproject/build-impl.xml.data.CRC32=baced049
+nbproject/build-impl.xml.script.CRC32=f18f47bd
+nbproject/build-impl.xml.stylesheet.CRC32=0c01fd8e at 1.43.1.45
diff --git a/nbproject/private/private.properties b/nbproject/private/private.properties
new file mode 100644
index 0000000..9b80bcd
--- /dev/null
+++ b/nbproject/private/private.properties
@@ -0,0 +1 @@
+user.properties.file=/Users/samuel/.netbeans/7.0/build.properties
diff --git a/nbproject/project.properties b/nbproject/project.properties
new file mode 100644
index 0000000..321334b
--- /dev/null
+++ b/nbproject/project.properties
@@ -0,0 +1,64 @@
+application.title=org.netlib
+application.vendor=Samuel Halliday
+build.classes.dir=${build.dir}/classes
+build.classes.excludes=**/*.java,**/*.form
+# This directory is removed when the project is cleaned:
+build.dir=build
+build.generated.dir=${build.dir}/generated
+build.generated.sources.dir=${build.dir}/generated-sources
+# Only compile against the classpath explicitly listed here:
+build.sysclasspath=ignore
+build.test.classes.dir=${build.dir}/test/classes
+build.test.results.dir=${build.dir}/test/results
+debug.classpath=\
+ ${run.classpath}
+debug.test.classpath=\
+ ${run.test.classpath}
+# This directory is removed when the project is cleaned:
+dist.dir=dist
+dist.jar=${dist.dir}/netlib-java.jar
+dist.javadoc.dir=${dist.dir}/javadoc
+excludes=
+file.reference.org.netlib-src=src
+file.reference.org.netlib-tests=tests
+includes=**
+jar.compress=false
+javac.classpath=\
+ ${libs.f2j.classpath}
+# Space-separated list of extra javac options
+javac.compilerargs=
+javac.deprecation=false
+javac.source=1.5
+javac.target=1.5
+javac.test.classpath=\
+ ${javac.classpath}:\
+ ${build.classes.dir}:\
+ ${libs.junit.classpath}
+javadoc.additionalparam=
+javadoc.author=false
+javadoc.encoding=${source.encoding}
+javadoc.noindex=false
+javadoc.nonavbar=false
+javadoc.notree=false
+javadoc.private=false
+javadoc.splitindex=true
+javadoc.use=true
+javadoc.version=false
+javadoc.windowtitle=
+main.class=org.netlib.generate.JavaGenerator
+manifest.file=manifest.mf
+meta.inf.dir=${src.dir}/META-INF
+platform.active=default_platform
+run.classpath=\
+ ${javac.classpath}:\
+ ${build.classes.dir}
+# Space-separated list of JVM arguments used when running the project
+# (you may also define separate properties like run-sys-prop.name=value instead of -Dname=value
+# or test-sys-prop.name=value to set system properties for unit tests):
+run.jvmargs=-ea
+run.test.classpath=\
+ ${javac.test.classpath}:\
+ ${build.test.classes.dir}
+source.encoding=UTF-8
+src.dir=${file.reference.org.netlib-src}
+test.src.dir=${file.reference.org.netlib-tests}
diff --git a/nbproject/project.xml b/nbproject/project.xml
new file mode 100644
index 0000000..c60c58c
--- /dev/null
+++ b/nbproject/project.xml
@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<project xmlns="http://www.netbeans.org/ns/project/1">
+ <type>org.netbeans.modules.java.j2seproject</type>
+ <configuration>
+ <data xmlns="http://www.netbeans.org/ns/j2se-project/3">
+ <name>netlib-java</name>
+ <minimum-ant-version>1.6.5</minimum-ant-version>
+ <source-roots>
+ <root id="src.dir"/>
+ </source-roots>
+ <test-roots>
+ <root id="test.src.dir"/>
+ </test-roots>
+ </data>
+ <libraries xmlns="http://www.netbeans.org/ns/ant-project-libraries/1">
+ <definitions>./lib/nblibraries.properties</definitions>
+ </libraries>
+ </configuration>
+</project>
diff --git a/netlib/ARPACK/arpack.h b/netlib/ARPACK/arpack.h
deleted file mode 100644
index be34f3c..0000000
--- a/netlib/ARPACK/arpack.h
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- * This file has been extracted and edited from the ARPACK++ distribution
- * to define the Fortran routines for use in C. The obvious conversions
- * have been used, in agreement with the CBLAS mappings.
- */
-
-// double precision symmetric routines.
-
- void dsaupd_(int *ido, char *bmat, int *n, char *which,
- int *nev, double *tol, double *resid,
- int *ncv, double *V, int *ldv,
- int *iparam, int *ipntr, double *workd,
- double *workl, int *lworkl, int *info);
-
- void dseupd_(int *rvec, char *HowMny, int *select,
- double *d, double *Z, int *ldz,
- double *sigma, char *bmat, int *n,
- char *which, int *nev, double *tol,
- double *resid, int *ncv, double *V,
- int *ldv, int *iparam, int *ipntr,
- double *workd, double *workl,
- int *lworkl, int *info);
-
-// double precision nonsymmetric routines.
-
- void dnaupd_(int *ido, char *bmat, int *n, char *which,
- int *nev, double *tol, double *resid,
- int *ncv, double *V, int *ldv,
- int *iparam, int *ipntr, double *workd,
- double *workl, int *lworkl, int *info);
-
- void dneupd_(int *rvec, char *HowMny, int *select,
- double *dr, double *di, double *Z,
- int *ldz, double *sigmar,
- double *sigmai, double *workev,
- char *bmat, int *n, char *which,
- int *nev, double *tol, double *resid,
- int *ncv, double *V, int *ldv,
- int *iparam, int *ipntr,
- double *workd, double *workl,
- int *lworkl, int *info);
-
-// single precision symmetric routines.
-
- void ssaupd_(int *ido, char *bmat, int *n, char *which,
- int *nev, float *tol, float *resid,
- int *ncv, float *V, int *ldv,
- int *iparam, int *ipntr, float *workd,
- float *workl, int *lworkl, int *info);
-
- void sseupd_(int *rvec, char *HowMny, int *select,
- float *d, float *Z, int *ldz,
- float *sigma, char *bmat, int *n,
- char *which, int *nev, float *tol,
- float *resid, int *ncv, float *V,
- int *ldv, int *iparam, int *ipntr,
- float *workd, float *workl,
- int *lworkl, int *info);
-
-// single precision nonsymmetric routines.
-
- void snaupd_(int *ido, char *bmat, int *n, char *which,
- int *nev, float *tol, float *resid,
- int *ncv, float *V, int *ldv,
- int *iparam, int *ipntr, float *workd,
- float *workl, int *lworkl, int *info);
-
- void sneupd_(int *rvec, char *HowMny, int *select,
- float *dr, float *di, float *Z,
- int *ldz, float *sigmar,
- float *sigmai, float *workev, char *bmat,
- int *n, char *which, int *nev,
- float *tol, float *resid, int *ncv,
- float *V, int *ldv, int *iparam,
- int *ipntr, float *workd, float *workl,
- int *lworkl, int *info);
diff --git a/netlib/ARPACK/debug.h b/netlib/ARPACK/debug.h
deleted file mode 100644
index 5eb0bb1..0000000
--- a/netlib/ARPACK/debug.h
+++ /dev/null
@@ -1,16 +0,0 @@
-c
-c\SCCS Information: @(#)
-c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
-c
-c %---------------------------------%
-c | See debug.doc for documentation |
-c %---------------------------------%
- integer logfil, ndigit, mgetv0,
- & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
- & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
- & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
- common /debug/
- & logfil, ndigit, mgetv0,
- & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
- & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
- & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
diff --git a/netlib/ARPACK/dgetv0.f b/netlib/ARPACK/dgetv0.f
deleted file mode 100644
index 7c0869e..0000000
--- a/netlib/ARPACK/dgetv0.f
+++ /dev/null
@@ -1,419 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dgetv0
-c
-c\Description:
-c Generate a random initial residual vector for the Arnoldi process.
-c Force the residual vector to be in the range of the operator OP.
-c
-c\Usage:
-c call dgetv0
-c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
-c IPNTR, WORKD, IERR )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag. IDO must be zero on the first
-c call to dgetv0.
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c This is for the initialization phase to force the
-c starting vector into the range of OP.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c IDO = 99: done
-c -------------------------------------------------------------
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B in the (generalized)
-c eigenvalue problem A*x = lambda*B*x.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
-c
-c ITRY Integer. (INPUT)
-c ITRY counts the number of times that dgetv0 is called.
-c It should be set to 1 on the initial call to dgetv0.
-c
-c INITV Logical variable. (INPUT)
-c .TRUE. => the initial residual vector is given in RESID.
-c .FALSE. => generate a random initial residual vector.
-c
-c N Integer. (INPUT)
-c Dimension of the problem.
-c
-c J Integer. (INPUT)
-c Index of the residual vector to be generated, with respect to
-c the Arnoldi process. J > 1 in case of a "restart".
-c
-c V Double precision N by J array. (INPUT)
-c The first J-1 columns of V contain the current Arnoldi basis
-c if this is a "restart".
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
-c Initial residual vector to be generated. If RESID is
-c provided, force RESID into the range of the operator OP.
-c
-c RNORM Double precision scalar. (OUTPUT)
-c B-norm of the generated residual.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c
-c WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION).
-c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
-c
-c IERR Integer. (OUTPUT)
-c = 0: Normal exit.
-c = -1: Cannot generate a nontrivial restarted residual vector
-c in the range of the operator OP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine for vector output.
-c dlarnv LAPACK routine for generating a random vector.
-c dgemv Level 2 BLAS routine for matrix vector multiplication.
-c dcopy Level 1 BLAS that copies one vector to another.
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dgetv0
- & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
- & ipntr, workd, ierr )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1
- logical initv
- integer ido, ierr, itry, j, ldv, n
- Double precision
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Double precision
- & resid(n), v(ldv,j), workd(2*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- logical first, inits, orth
- integer idist, iseed(4), iter, msglvl, jj
- Double precision
- & rnorm0
- save first, iseed, inits, iter, msglvl, orth, rnorm0
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dlarnv, dvout, dcopy, dgemv, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & ddot, dnrm2
- external ddot, dnrm2
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs, sqrt
-c
-c %-----------------%
-c | Data Statements |
-c %-----------------%
-c
- data inits /.true./
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c
-c %-----------------------------------%
-c | Initialize the seed of the LAPACK |
-c | random number generator |
-c %-----------------------------------%
-c
- if (inits) then
- iseed(1) = 1
- iseed(2) = 3
- iseed(3) = 5
- iseed(4) = 7
- inits = .false.
- end if
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mgetv0
-c
- ierr = 0
- iter = 0
- first = .FALSE.
- orth = .FALSE.
-c
-c %-----------------------------------------------------%
-c | Possibly generate a random starting vector in RESID |
-c | Use a LAPACK random number generator used by the |
-c | matrix generation routines. |
-c | idist = 1: uniform (0,1) distribution; |
-c | idist = 2: uniform (-1,1) distribution; |
-c | idist = 3: normal (0,1) distribution; |
-c %-----------------------------------------------------%
-c
- if (.not.initv) then
- idist = 2
- call dlarnv (idist, iseed, n, resid)
- end if
-c
-c %----------------------------------------------------------%
-c | Force the starting vector into the range of OP to handle |
-c | the generalized problem when B is possibly (singular). |
-c %----------------------------------------------------------%
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nopx = nopx + 1
- ipntr(1) = 1
- ipntr(2) = n + 1
- call dcopy (n, resid, 1, workd, 1)
- ido = -1
- go to 9000
- end if
- end if
-c
-c %-----------------------------------------%
-c | Back from computing OP*(initial-vector) |
-c %-----------------------------------------%
-c
- if (first) go to 20
-c
-c %-----------------------------------------------%
-c | Back from computing B*(orthogonalized-vector) |
-c %-----------------------------------------------%
-c
- if (orth) go to 40
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvopx = tmvopx + (t3 - t2)
- end if
-c
-c %------------------------------------------------------%
-c | Starting vector is now in the range of OP; r = OP*r; |
-c | Compute B-norm of starting vector. |
-c %------------------------------------------------------%
-c
- call arscnd (t2)
- first = .TRUE.
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, workd(n+1), 1, resid, 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd, 1)
- end if
-c
- 20 continue
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- first = .FALSE.
- if (bmat .eq. 'G') then
- rnorm0 = ddot (n, resid, 1, workd, 1)
- rnorm0 = sqrt(abs(rnorm0))
- else if (bmat .eq. 'I') then
- rnorm0 = dnrm2(n, resid, 1)
- end if
- rnorm = rnorm0
-c
-c %---------------------------------------------%
-c | Exit if this is the very first Arnoldi step |
-c %---------------------------------------------%
-c
- if (j .eq. 1) go to 50
-c
-c %----------------------------------------------------------------
-c | Otherwise need to B-orthogonalize the starting vector against |
-c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
-c | This is the case where an invariant subspace is encountered |
-c | in the middle of the Arnoldi factorization. |
-c | |
-c | s = V^{T}*B*r; r = r - V*s; |
-c | |
-c | Stopping criteria used for iter. ref. is discussed in |
-c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
-c %---------------------------------------------------------------%
-c
- orth = .TRUE.
- 30 continue
-c
- call dgemv ('T', n, j-1, one, v, ldv, workd, 1,
- & zero, workd(n+1), 1)
- call dgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
- & one, resid, 1)
-c
-c %----------------------------------------------------------%
-c | Compute the B-norm of the orthogonalized starting vector |
-c %----------------------------------------------------------%
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(n+1), 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd, 1)
- end if
-c
- 40 continue
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- if (bmat .eq. 'G') then
- rnorm = ddot (n, resid, 1, workd, 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = dnrm2(n, resid, 1)
- end if
-c
-c %--------------------------------------%
-c | Check for further orthogonalization. |
-c %--------------------------------------%
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, 1, rnorm0, ndigit,
- & '_getv0: re-orthonalization ; rnorm0 is')
- call dvout (logfil, 1, rnorm, ndigit,
- & '_getv0: re-orthonalization ; rnorm is')
- end if
-c
- if (rnorm .gt. 0.717*rnorm0) go to 50
-c
- iter = iter + 1
- if (iter .le. 5) then
-c
-c %-----------------------------------%
-c | Perform iterative refinement step |
-c %-----------------------------------%
-c
- rnorm0 = rnorm
- go to 30
- else
-c
-c %------------------------------------%
-c | Iterative refinement step "failed" |
-c %------------------------------------%
-c
- do 45 jj = 1, n
- resid(jj) = zero
- 45 continue
- rnorm = zero
- ierr = -1
- end if
-c
- 50 continue
-c
- if (msglvl .gt. 0) then
- call dvout (logfil, 1, rnorm, ndigit,
- & '_getv0: B-norm of initial / restarted starting vector')
- end if
- if (msglvl .gt. 3) then
- call dvout (logfil, n, resid, ndigit,
- & '_getv0: initial / restarted starting vector')
- end if
- ido = 99
-c
- call arscnd (t1)
- tgetv0 = tgetv0 + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dgetv0 |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dlaqrb.f b/netlib/ARPACK/dlaqrb.f
deleted file mode 100644
index d851b86..0000000
--- a/netlib/ARPACK/dlaqrb.f
+++ /dev/null
@@ -1,521 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dlaqrb
-c
-c\Description:
-c Compute the eigenvalues and the Schur decomposition of an upper
-c Hessenberg submatrix in rows and columns ILO to IHI. Only the
-c last component of the Schur vectors are computed.
-c
-c This is mostly a modification of the LAPACK routine dlahqr.
-c
-c\Usage:
-c call dlaqrb
-c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO )
-c
-c\Arguments
-c WANTT Logical variable. (INPUT)
-c = .TRUE. : the full Schur form T is required;
-c = .FALSE.: only eigenvalues are required.
-c
-c N Integer. (INPUT)
-c The order of the matrix H. N >= 0.
-c
-c ILO Integer. (INPUT)
-c IHI Integer. (INPUT)
-c It is assumed that H is already upper quasi-triangular in
-c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-c ILO = 1). SLAQRB works primarily with the Hessenberg
-c submatrix in rows and columns ILO to IHI, but applies
-c transformations to all of H if WANTT is .TRUE..
-c 1 <= ILO <= max(1,IHI); IHI <= N.
-c
-c H Double precision array, dimension (LDH,N). (INPUT/OUTPUT)
-c On entry, the upper Hessenberg matrix H.
-c On exit, if WANTT is .TRUE., H is upper quasi-triangular in
-c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in
-c standard form. If WANTT is .FALSE., the contents of H are
-c unspecified on exit.
-c
-c LDH Integer. (INPUT)
-c The leading dimension of the array H. LDH >= max(1,N).
-c
-c WR Double precision array, dimension (N). (OUTPUT)
-c WI Double precision array, dimension (N). (OUTPUT)
-c The real and imaginary parts, respectively, of the computed
-c eigenvalues ILO to IHI are stored in the corresponding
-c elements of WR and WI. If two eigenvalues are computed as a
-c complex conjugate pair, they are stored in consecutive
-c elements of WR and WI, say the i-th and (i+1)th, with
-c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-c eigenvalues are stored in the same order as on the diagonal
-c of the Schur form returned in H, with WR(i) = H(i,i), and, if
-c H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-c
-c Z Double precision array, dimension (N). (OUTPUT)
-c On exit Z contains the last components of the Schur vectors.
-c
-c INFO Integer. (OUPUT)
-c = 0: successful exit
-c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI
-c in a total of 30*(IHI-ILO+1) iterations; if INFO = i,
-c elements i+1:ihi of WR and WI contain those eigenvalues
-c which have been successfully computed.
-c
-c\Remarks
-c 1. None.
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c dlabad LAPACK routine that computes machine constants.
-c dlamch LAPACK routine that determines machine constants.
-c dlanhs LAPACK routine that computes various norms of a matrix.
-c dlanv2 LAPACK routine that computes the Schur factorization of
-c 2 by 2 nonsymmetric matrix in standard form.
-c dlarfg LAPACK Householder reflection construction routine.
-c dcopy Level 1 BLAS that copies one vector to another.
-c drot Level 1 BLAS that applies a rotation to a 2 by 2 matrix.
-
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c Modified from the LAPACK routine dlahqr so that only the
-c last component of the Schur vectors are computed.
-c
-c\SCCS Information: @(#)
-c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c 1. None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dlaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi,
- & z, info )
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- logical wantt
- integer ihi, ilo, info, ldh, n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & h( ldh, * ), wi( * ), wr( * ), z( * )
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & zero, one, dat1, dat2
- parameter (zero = 0.0D+0, one = 1.0D+0, dat1 = 7.5D-1,
- & dat2 = -4.375D-1)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- integer i, i1, i2, itn, its, j, k, l, m, nh, nr
- Double precision
- & cs, h00, h10, h11, h12, h21, h22, h33, h33s,
- & h43h34, h44, h44s, ovfl, s, smlnum, sn, sum,
- & t1, t2, t3, tst1, ulp, unfl, v1, v2, v3
- Double precision
- & v( 3 ), work( 1 )
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlamch, dlanhs
- external dlamch, dlanhs
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy, dlabad, dlanv2, dlarfg, drot
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- info = 0
-c
-c %--------------------------%
-c | Quick return if possible |
-c %--------------------------%
-c
- if( n.eq.0 )
- & return
- if( ilo.eq.ihi ) then
- wr( ilo ) = h( ilo, ilo )
- wi( ilo ) = zero
- return
- end if
-c
-c %---------------------------------------------%
-c | Initialize the vector of last components of |
-c | the Schur vectors for accumulation. |
-c %---------------------------------------------%
-c
- do 5 j = 1, n-1
- z(j) = zero
- 5 continue
- z(n) = one
-c
- nh = ihi - ilo + 1
-c
-c %-------------------------------------------------------------%
-c | Set machine-dependent constants for the stopping criterion. |
-c | If norm(H) <= sqrt(OVFL), overflow should not occur. |
-c %-------------------------------------------------------------%
-c
- unfl = dlamch( 'safe minimum' )
- ovfl = one / unfl
- call dlabad( unfl, ovfl )
- ulp = dlamch( 'precision' )
- smlnum = unfl*( nh / ulp )
-c
-c %---------------------------------------------------------------%
-c | I1 and I2 are the indices of the first row and last column |
-c | of H to which transformations must be applied. If eigenvalues |
-c | only are computed, I1 and I2 are set inside the main loop. |
-c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. |
-c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. |
-c %---------------------------------------------------------------%
-c
- if( wantt ) then
- i1 = 1
- i2 = n
- do 8 i=1,i2-2
- h(i1+i+1,i) = zero
- 8 continue
- else
- do 9 i=1, ihi-ilo-1
- h(ilo+i+1,ilo+i-1) = zero
- 9 continue
- end if
-c
-c %---------------------------------------------------%
-c | ITN is the total number of QR iterations allowed. |
-c %---------------------------------------------------%
-c
- itn = 30*nh
-c
-c ------------------------------------------------------------------
-c The main loop begins here. I is the loop index and decreases from
-c IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-c with the active submatrix in rows and columns L to I.
-c Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-c H(L,L-1) is negligible so that the matrix splits.
-c ------------------------------------------------------------------
-c
- i = ihi
- 10 continue
- l = ilo
- if( i.lt.ilo )
- & go to 150
-
-c %--------------------------------------------------------------%
-c | Perform QR iterations on rows and columns ILO to I until a |
-c | submatrix of order 1 or 2 splits off at the bottom because a |
-c | subdiagonal element has become negligible. |
-c %--------------------------------------------------------------%
-
- do 130 its = 0, itn
-c
-c %----------------------------------------------%
-c | Look for a single small subdiagonal element. |
-c %----------------------------------------------%
-c
- do 20 k = i, l + 1, -1
- tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) )
- if( tst1.eq.zero )
- & tst1 = dlanhs( '1', i-l+1, h( l, l ), ldh, work )
- if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) )
- & go to 30
- 20 continue
- 30 continue
- l = k
- if( l.gt.ilo ) then
-c
-c %------------------------%
-c | H(L,L-1) is negligible |
-c %------------------------%
-c
- h( l, l-1 ) = zero
- end if
-c
-c %-------------------------------------------------------------%
-c | Exit from loop if a submatrix of order 1 or 2 has split off |
-c %-------------------------------------------------------------%
-c
- if( l.ge.i-1 )
- & go to 140
-c
-c %---------------------------------------------------------%
-c | Now the active submatrix is in rows and columns L to I. |
-c | If eigenvalues only are being computed, only the active |
-c | submatrix need be transformed. |
-c %---------------------------------------------------------%
-c
- if( .not.wantt ) then
- i1 = l
- i2 = i
- end if
-c
- if( its.eq.10 .or. its.eq.20 ) then
-c
-c %-------------------%
-c | Exceptional shift |
-c %-------------------%
-c
- s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) )
- h44 = dat1*s
- h33 = h44
- h43h34 = dat2*s*s
-c
- else
-c
-c %-----------------------------------------%
-c | Prepare to use Wilkinson's double shift |
-c %-----------------------------------------%
-c
- h44 = h( i, i )
- h33 = h( i-1, i-1 )
- h43h34 = h( i, i-1 )*h( i-1, i )
- end if
-c
-c %-----------------------------------------------------%
-c | Look for two consecutive small subdiagonal elements |
-c %-----------------------------------------------------%
-c
- do 40 m = i - 2, l, -1
-c
-c %---------------------------------------------------------%
-c | Determine the effect of starting the double-shift QR |
-c | iteration at row M, and see if this would make H(M,M-1) |
-c | negligible. |
-c %---------------------------------------------------------%
-c
- h11 = h( m, m )
- h22 = h( m+1, m+1 )
- h21 = h( m+1, m )
- h12 = h( m, m+1 )
- h44s = h44 - h11
- h33s = h33 - h11
- v1 = ( h33s*h44s-h43h34 ) / h21 + h12
- v2 = h22 - h11 - h33s - h44s
- v3 = h( m+2, m+1 )
- s = abs( v1 ) + abs( v2 ) + abs( v3 )
- v1 = v1 / s
- v2 = v2 / s
- v3 = v3 / s
- v( 1 ) = v1
- v( 2 ) = v2
- v( 3 ) = v3
- if( m.eq.l )
- & go to 50
- h00 = h( m-1, m-1 )
- h10 = h( m, m-1 )
- tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) )
- if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 )
- & go to 50
- 40 continue
- 50 continue
-c
-c %----------------------%
-c | Double-shift QR step |
-c %----------------------%
-c
- do 120 k = m, i - 1
-c
-c ------------------------------------------------------------
-c The first iteration of this loop determines a reflection G
-c from the vector V and applies it from left and right to H,
-c thus creating a nonzero bulge below the subdiagonal.
-c
-c Each subsequent iteration determines a reflection G to
-c restore the Hessenberg form in the (K-1)th column, and thus
-c chases the bulge one step toward the bottom of the active
-c submatrix. NR is the order of G.
-c ------------------------------------------------------------
-c
- nr = min( 3, i-k+1 )
- if( k.gt.m )
- & call dcopy( nr, h( k, k-1 ), 1, v, 1 )
- call dlarfg( nr, v( 1 ), v( 2 ), 1, t1 )
- if( k.gt.m ) then
- h( k, k-1 ) = v( 1 )
- h( k+1, k-1 ) = zero
- if( k.lt.i-1 )
- & h( k+2, k-1 ) = zero
- else if( m.gt.l ) then
- h( k, k-1 ) = -h( k, k-1 )
- end if
- v2 = v( 2 )
- t2 = t1*v2
- if( nr.eq.3 ) then
- v3 = v( 3 )
- t3 = t1*v3
-c
-c %------------------------------------------------%
-c | Apply G from the left to transform the rows of |
-c | the matrix in columns K to I2. |
-c %------------------------------------------------%
-c
- do 60 j = k, i2
- sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j )
- h( k, j ) = h( k, j ) - sum*t1
- h( k+1, j ) = h( k+1, j ) - sum*t2
- h( k+2, j ) = h( k+2, j ) - sum*t3
- 60 continue
-c
-c %----------------------------------------------------%
-c | Apply G from the right to transform the columns of |
-c | the matrix in rows I1 to min(K+3,I). |
-c %----------------------------------------------------%
-c
- do 70 j = i1, min( k+3, i )
- sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 )
- h( j, k ) = h( j, k ) - sum*t1
- h( j, k+1 ) = h( j, k+1 ) - sum*t2
- h( j, k+2 ) = h( j, k+2 ) - sum*t3
- 70 continue
-c
-c %----------------------------------%
-c | Accumulate transformations for Z |
-c %----------------------------------%
-c
- sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 )
- z( k ) = z( k ) - sum*t1
- z( k+1 ) = z( k+1 ) - sum*t2
- z( k+2 ) = z( k+2 ) - sum*t3
-
- else if( nr.eq.2 ) then
-c
-c %------------------------------------------------%
-c | Apply G from the left to transform the rows of |
-c | the matrix in columns K to I2. |
-c %------------------------------------------------%
-c
- do 90 j = k, i2
- sum = h( k, j ) + v2*h( k+1, j )
- h( k, j ) = h( k, j ) - sum*t1
- h( k+1, j ) = h( k+1, j ) - sum*t2
- 90 continue
-c
-c %----------------------------------------------------%
-c | Apply G from the right to transform the columns of |
-c | the matrix in rows I1 to min(K+3,I). |
-c %----------------------------------------------------%
-c
- do 100 j = i1, i
- sum = h( j, k ) + v2*h( j, k+1 )
- h( j, k ) = h( j, k ) - sum*t1
- h( j, k+1 ) = h( j, k+1 ) - sum*t2
- 100 continue
-c
-c %----------------------------------%
-c | Accumulate transformations for Z |
-c %----------------------------------%
-c
- sum = z( k ) + v2*z( k+1 )
- z( k ) = z( k ) - sum*t1
- z( k+1 ) = z( k+1 ) - sum*t2
- end if
- 120 continue
-
- 130 continue
-c
-c %-------------------------------------------------------%
-c | Failure to converge in remaining number of iterations |
-c %-------------------------------------------------------%
-c
- info = i
- return
-
- 140 continue
-
- if( l.eq.i ) then
-c
-c %------------------------------------------------------%
-c | H(I,I-1) is negligible: one eigenvalue has converged |
-c %------------------------------------------------------%
-c
- wr( i ) = h( i, i )
- wi( i ) = zero
-
- else if( l.eq.i-1 ) then
-c
-c %--------------------------------------------------------%
-c | H(I-1,I-2) is negligible; |
-c | a pair of eigenvalues have converged. |
-c | |
-c | Transform the 2-by-2 submatrix to standard Schur form, |
-c | and compute and store the eigenvalues. |
-c %--------------------------------------------------------%
-c
- call dlanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ),
- & h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ),
- & cs, sn )
-
- if( wantt ) then
-c
-c %-----------------------------------------------------%
-c | Apply the transformation to the rest of H and to Z, |
-c | as required. |
-c %-----------------------------------------------------%
-c
- if( i2.gt.i )
- & call drot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh,
- & cs, sn )
- call drot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn )
- sum = cs*z( i-1 ) + sn*z( i )
- z( i ) = cs*z( i ) - sn*z( i-1 )
- z( i-1 ) = sum
- end if
- end if
-c
-c %---------------------------------------------------------%
-c | Decrement number of remaining iterations, and return to |
-c | start of the main loop with new value of I. |
-c %---------------------------------------------------------%
-c
- itn = itn - its
- i = l - 1
- go to 10
-
- 150 continue
- return
-c
-c %---------------%
-c | End of dlaqrb |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dmout.f b/netlib/ARPACK/dmout.f
deleted file mode 100644
index 72edc04..0000000
--- a/netlib/ARPACK/dmout.f
+++ /dev/null
@@ -1,167 +0,0 @@
-*-----------------------------------------------------------------------
-* Routine: DMOUT
-*
-* Purpose: Real matrix output routine.
-*
-* Usage: CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
-*
-* Arguments
-* M - Number of rows of A. (Input)
-* N - Number of columns of A. (Input)
-* A - Real M by N matrix to be printed. (Input)
-* LDA - Leading dimension of A exactly as specified in the
-* dimension statement of the calling program. (Input)
-* IFMT - Format to be used in printing matrix A. (Input)
-* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
-* If IDIGIT .LT. 0, printing is done with 72 columns.
-* If IDIGIT .GT. 0, printing is done with 132 columns.
-*
-*-----------------------------------------------------------------------
-*
- SUBROUTINE DMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
-* ...
-* ... SPECIFICATIONS FOR ARGUMENTS
-* ...
-* ... SPECIFICATIONS FOR LOCAL VARIABLES
-* .. Scalar Arguments ..
- CHARACTER*( * ) IFMT
- INTEGER IDIGIT, LDA, LOUT, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-* .. Local Scalars ..
- CHARACTER*80 LINE
- INTEGER I, J, K1, K2, LLL, NDIGIT
-* ..
-* .. Local Arrays ..
- CHARACTER ICOL( 3 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC LEN, MIN, MIN0
-* ..
-* .. Data statements ..
- DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
- $ 'l' /
-* ..
-* .. Executable Statements ..
-* ...
-* ... FIRST EXECUTABLE STATEMENT
-*
- LLL = MIN( LEN( IFMT ), 80 )
- DO 10 I = 1, LLL
- LINE( I: I ) = '-'
- 10 CONTINUE
-*
- DO 20 I = LLL + 1, 80
- LINE( I: I ) = ' '
- 20 CONTINUE
-*
- WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
- 9999 FORMAT( / 1X, A, / 1X, A )
-*
- IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
- $ RETURN
- NDIGIT = IDIGIT
- IF( IDIGIT.EQ.0 )
- $ NDIGIT = 4
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
-*=======================================================================
-*
- IF( IDIGIT.LT.0 ) THEN
- NDIGIT = -IDIGIT
- IF( NDIGIT.LE.4 ) THEN
- DO 40 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
- DO 30 I = 1, M
- WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
- 30 CONTINUE
- 40 CONTINUE
-*
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 60 K1 = 1, N, 4
- K2 = MIN0( N, K1+3 )
- WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
- DO 50 I = 1, M
- WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
- 50 CONTINUE
- 60 CONTINUE
-*
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 80 K1 = 1, N, 3
- K2 = MIN0( N, K1+2 )
- WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
- DO 70 I = 1, M
- WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
- 70 CONTINUE
- 80 CONTINUE
-*
- ELSE
- DO 100 K1 = 1, N, 2
- K2 = MIN0( N, K1+1 )
- WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
- DO 90 I = 1, M
- WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
- 90 CONTINUE
- 100 CONTINUE
- END IF
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
-*=======================================================================
-*
- ELSE
- IF( NDIGIT.LE.4 ) THEN
- DO 120 K1 = 1, N, 10
- K2 = MIN0( N, K1+9 )
- WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
- DO 110 I = 1, M
- WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
- 110 CONTINUE
- 120 CONTINUE
-*
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 140 K1 = 1, N, 8
- K2 = MIN0( N, K1+7 )
- WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
- DO 130 I = 1, M
- WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
- 130 CONTINUE
- 140 CONTINUE
-*
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 160 K1 = 1, N, 6
- K2 = MIN0( N, K1+5 )
- WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
- DO 150 I = 1, M
- WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
- 150 CONTINUE
- 160 CONTINUE
-*
- ELSE
- DO 180 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
- DO 170 I = 1, M
- WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
- 170 CONTINUE
- 180 CONTINUE
- END IF
- END IF
- WRITE( LOUT, FMT = 9990 )
-*
- 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
- 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
- 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
- 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
- 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 )
- 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 )
- 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 )
- 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 )
- 9990 FORMAT( 1X, ' ' )
-*
- RETURN
- END
diff --git a/netlib/ARPACK/dnaitr.f b/netlib/ARPACK/dnaitr.f
deleted file mode 100644
index 1d8bf30..0000000
--- a/netlib/ARPACK/dnaitr.f
+++ /dev/null
@@ -1,840 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dnaitr
-c
-c\Description:
-c Reverse communication interface for applying NP additional steps to
-c a K step nonsymmetric Arnoldi factorization.
-c
-c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
-c
-c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
-c
-c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
-c
-c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
-c
-c where OP and B are as in dnaupd. The B-norm of r_{k+p} is also
-c computed and returned.
-c
-c\Usage:
-c call dnaitr
-c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
-c IPNTR, WORKD, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag.
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c This is for the restart phase to force the new
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y,
-c IPNTR(3) is the pointer into WORK for B * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c IDO = 99: done
-c -------------------------------------------------------------
-c When the routine is used in the "shift-and-invert" mode, the
-c vector B * Q is already available and do not need to be
-c recompute in forming OP * Q.
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B that defines the
-c semi-inner product for the operator OP. See dnaupd.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c K Integer. (INPUT)
-c Current size of V and H.
-c
-c NP Integer. (INPUT)
-c Number of additional Arnoldi steps to take.
-c
-c NB Integer. (INPUT)
-c Blocksize to be used in the recurrence.
-c Only work for NB = 1 right now. The goal is to have a
-c program that implement both the block and non-block method.
-c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
-c On INPUT: RESID contains the residual vector r_{k}.
-c On OUTPUT: RESID contains the residual vector r_{k+p}.
-c
-c RNORM Double precision scalar. (INPUT/OUTPUT)
-c B-norm of the starting residual on input.
-c B-norm of the updated residual r_{k+p} on output.
-c
-c V Double precision N by K+NP array. (INPUT/OUTPUT)
-c On INPUT: V contains the Arnoldi vectors in the first K
-c columns.
-c On OUTPUT: V contains the new NP Arnoldi vectors in the next
-c NP columns. The first K columns are unchanged.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Double precision (K+NP) by (K+NP) array. (INPUT/OUTPUT)
-c H is used to store the generated upper Hessenberg matrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORK for
-c vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in the
-c shift-and-invert mode. X is the current operand.
-c -------------------------------------------------------------
-c
-c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The calling program should not
-c use WORKD as temporary workspace during the iteration !!!!!!
-c On input, WORKD(1:N) = B*RESID and is used to save some
-c computation at the first step.
-c
-c INFO Integer. (OUTPUT)
-c = 0: Normal exit.
-c > 0: Size of the spanning invariant subspace of OP found.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c dgetv0 ARPACK routine to generate the initial vector.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dmout ARPACK utility routine that prints matrices
-c dvout ARPACK utility routine that prints vectors.
-c dlabad LAPACK routine that computes machine constants.
-c dlamch LAPACK routine that determines machine constants.
-c dlascl LAPACK routine for careful scaling of a matrix.
-c dlanhs LAPACK routine that computes various norms of a matrix.
-c dgemv Level 2 BLAS routine for matrix vector multiplication.
-c daxpy Level 1 BLAS that computes a vector triad.
-c dscal Level 1 BLAS that scales a vector.
-c dcopy Level 1 BLAS that copies one vector to another .
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c The algorithm implemented is:
-c
-c restart = .false.
-c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
-c r_{k} contains the initial residual vector even for k = 0;
-c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
-c computed by the calling program.
-c
-c betaj = rnorm ; p_{k+1} = B*r_{k} ;
-c For j = k+1, ..., k+np Do
-c 1) if ( betaj < tol ) stop or restart depending on j.
-c ( At present tol is zero )
-c if ( restart ) generate a new starting vector.
-c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
-c p_{j} = p_{j}/betaj
-c 3) r_{j} = OP*v_{j} where OP is defined as in dnaupd
-c For shift-invert mode p_{j} = B*v_{j} is already available.
-c wnorm = || OP*v_{j} ||
-c 4) Compute the j-th step residual vector.
-c w_{j} = V_{j}^T * B * OP * v_{j}
-c r_{j} = OP*v_{j} - V_{j} * w_{j}
-c H(:,j) = w_{j};
-c H(j,j-1) = rnorm
-c rnorm = || r_(j) ||
-c If (rnorm > 0.717*wnorm) accept step and go back to 1)
-c 5) Re-orthogonalization step:
-c s = V_{j}'*B*r_{j}
-c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
-c alphaj = alphaj + s_{j};
-c 6) Iterative refinement step:
-c If (rnorm1 > 0.717*rnorm) then
-c rnorm = rnorm1
-c accept step and go back to 1)
-c Else
-c rnorm = rnorm1
-c If this is the first time in step 6), go to 5)
-c Else r_{j} lies in the span of V_{j} numerically.
-c Set r_{j} = 0 and rnorm = 0; go to 1)
-c EndIf
-c End Do
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dnaitr
- & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
- & ipntr, workd, info)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1
- integer ido, info, k, ldh, ldv, n, nb, np
- Double precision
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Double precision
- & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- logical first, orth1, orth2, rstart, step3, step4
- integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
- & jj
- Double precision
- & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
- & wnorm
- save first, orth1, orth2, rstart, step3, step4,
- & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
- & betaj, rnorm1, smlnum, ulp, unfl, wnorm
-c
-c %-----------------------%
-c | Local Array Arguments |
-c %-----------------------%
-c
- Double precision
- & xtemp(2)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external daxpy, dcopy, dscal, dgemv, dgetv0, dlabad,
- & dvout, dmout, ivout, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & ddot, dnrm2, dlanhs, dlamch
- external ddot, dnrm2, dlanhs, dlamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs, sqrt
-c
-c %-----------------%
-c | Data statements |
-c %-----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
-c
-c %-----------------------------------------%
-c | Set machine-dependent constants for the |
-c | the splitting and deflation criterion. |
-c | If norm(H) <= sqrt(OVFL), |
-c | overflow should not occur. |
-c | REFERENCE: LAPACK subroutine dlahqr |
-c %-----------------------------------------%
-c
- unfl = dlamch( 'safe minimum' )
- ovfl = one / unfl
- call dlabad( unfl, ovfl )
- ulp = dlamch( 'precision' )
- smlnum = unfl*( n / ulp )
- first = .false.
- end if
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mnaitr
-c
-c %------------------------------%
-c | Initial call to this routine |
-c %------------------------------%
-c
- info = 0
- step3 = .false.
- step4 = .false.
- rstart = .false.
- orth1 = .false.
- orth2 = .false.
- j = k + 1
- ipj = 1
- irj = ipj + n
- ivj = irj + n
- end if
-c
-c %-------------------------------------------------%
-c | When in reverse communication mode one of: |
-c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
-c | will be .true. when .... |
-c | STEP3: return from computing OP*v_{j}. |
-c | STEP4: return from computing B-norm of OP*v_{j} |
-c | ORTH1: return from computing B-norm of r_{j+1} |
-c | ORTH2: return from computing B-norm of |
-c | correction to the residual vector. |
-c | RSTART: return from OP computations needed by |
-c | dgetv0. |
-c %-------------------------------------------------%
-c
- if (step3) go to 50
- if (step4) go to 60
- if (orth1) go to 70
- if (orth2) go to 90
- if (rstart) go to 30
-c
-c %-----------------------------%
-c | Else this is the first step |
-c %-----------------------------%
-c
-c %--------------------------------------------------------------%
-c | |
-c | A R N O L D I I T E R A T I O N L O O P |
-c | |
-c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
-c %--------------------------------------------------------------%
-
- 1000 continue
-c
- if (msglvl .gt. 1) then
- call ivout (logfil, 1, j, ndigit,
- & '_naitr: generating Arnoldi vector number')
- call dvout (logfil, 1, rnorm, ndigit,
- & '_naitr: B-norm of the current residual is')
- end if
-c
-c %---------------------------------------------------%
-c | STEP 1: Check if the B norm of j-th residual |
-c | vector is zero. Equivalent to determing whether |
-c | an exact j-step Arnoldi factorization is present. |
-c %---------------------------------------------------%
-c
- betaj = rnorm
- if (rnorm .gt. zero) go to 40
-c
-c %---------------------------------------------------%
-c | Invariant subspace found, generate a new starting |
-c | vector which is orthogonal to the current Arnoldi |
-c | basis and continue the iteration. |
-c %---------------------------------------------------%
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_naitr: ****** RESTART AT STEP ******')
- end if
-c
-c %---------------------------------------------%
-c | ITRY is the loop variable that controls the |
-c | maximum amount of times that a restart is |
-c | attempted. NRSTRT is used by stat.h |
-c %---------------------------------------------%
-c
- betaj = zero
- nrstrt = nrstrt + 1
- itry = 1
- 20 continue
- rstart = .true.
- ido = 0
- 30 continue
-c
-c %--------------------------------------%
-c | If in reverse communication mode and |
-c | RSTART = .true. flow returns here. |
-c %--------------------------------------%
-c
- call dgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
- & resid, rnorm, ipntr, workd, ierr)
- if (ido .ne. 99) go to 9000
- if (ierr .lt. 0) then
- itry = itry + 1
- if (itry .le. 3) go to 20
-c
-c %------------------------------------------------%
-c | Give up after several restart attempts. |
-c | Set INFO to the size of the invariant subspace |
-c | which spans OP and exit. |
-c %------------------------------------------------%
-c
- info = j - 1
- call arscnd (t1)
- tnaitr = tnaitr + (t1 - t0)
- ido = 99
- go to 9000
- end if
-c
- 40 continue
-c
-c %---------------------------------------------------------%
-c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
-c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
-c | when reciprocating a small RNORM, test against lower |
-c | machine bound. |
-c %---------------------------------------------------------%
-c
- call dcopy (n, resid, 1, v(1,j), 1)
- if (rnorm .ge. unfl) then
- temp1 = one / rnorm
- call dscal (n, temp1, v(1,j), 1)
- call dscal (n, temp1, workd(ipj), 1)
- else
-c
-c %-----------------------------------------%
-c | To scale both v_{j} and p_{j} carefully |
-c | use LAPACK routine SLASCL |
-c %-----------------------------------------%
-c
- call dlascl ('General', i, i, rnorm, one, n, 1,
- & v(1,j), n, infol)
- call dlascl ('General', i, i, rnorm, one, n, 1,
- & workd(ipj), n, infol)
- end if
-c
-c %------------------------------------------------------%
-c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
-c | Note that this is not quite yet r_{j}. See STEP 4 |
-c %------------------------------------------------------%
-c
- step3 = .true.
- nopx = nopx + 1
- call arscnd (t2)
- call dcopy (n, v(1,j), 1, workd(ivj), 1)
- ipntr(1) = ivj
- ipntr(2) = irj
- ipntr(3) = ipj
- ido = 1
-c
-c %-----------------------------------%
-c | Exit in order to compute OP*v_{j} |
-c %-----------------------------------%
-c
- go to 9000
- 50 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
-c | if step3 = .true. |
-c %----------------------------------%
-c
- call arscnd (t3)
- tmvopx = tmvopx + (t3 - t2)
-
- step3 = .false.
-c
-c %------------------------------------------%
-c | Put another copy of OP*v_{j} into RESID. |
-c %------------------------------------------%
-c
- call dcopy (n, workd(irj), 1, resid, 1)
-c
-c %---------------------------------------%
-c | STEP 4: Finish extending the Arnoldi |
-c | factorization to length j. |
-c %---------------------------------------%
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- step4 = .true.
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-------------------------------------%
-c | Exit in order to compute B*OP*v_{j} |
-c %-------------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd(ipj), 1)
- end if
- 60 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
-c | if step4 = .true. |
-c %----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- step4 = .false.
-c
-c %-------------------------------------%
-c | The following is needed for STEP 5. |
-c | Compute the B-norm of OP*v_{j}. |
-c %-------------------------------------%
-c
- if (bmat .eq. 'G') then
- wnorm = ddot (n, resid, 1, workd(ipj), 1)
- wnorm = sqrt(abs(wnorm))
- else if (bmat .eq. 'I') then
- wnorm = dnrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------%
-c | Compute the j-th residual corresponding |
-c | to the j step factorization. |
-c | Use Classical Gram Schmidt and compute: |
-c | w_{j} <- V_{j}^T * B * OP * v_{j} |
-c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
-c %-----------------------------------------%
-c
-c
-c %------------------------------------------%
-c | Compute the j Fourier coefficients w_{j} |
-c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
-c %------------------------------------------%
-c
- call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
- & zero, h(1,j), 1)
-c
-c %--------------------------------------%
-c | Orthogonalize r_{j} against V_{j}. |
-c | RESID contains OP*v_{j}. See STEP 3. |
-c %--------------------------------------%
-c
- call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
- & one, resid, 1)
-c
- if (j .gt. 1) h(j,j-1) = betaj
-c
- call arscnd (t4)
-c
- orth1 = .true.
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*r_{j} |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd(ipj), 1)
- end if
- 70 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH1 = .true. |
-c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- orth1 = .false.
-c
-c %------------------------------%
-c | Compute the B-norm of r_{j}. |
-c %------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm = ddot (n, resid, 1, workd(ipj), 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = dnrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------------------------%
-c | STEP 5: Re-orthogonalization / Iterative refinement phase |
-c | Maximum NITER_ITREF tries. |
-c | |
-c | s = V_{j}^T * B * r_{j} |
-c | r_{j} = r_{j} - V_{j}*s |
-c | alphaj = alphaj + s_{j} |
-c | |
-c | The stopping criteria used for iterative refinement is |
-c | discussed in Parlett's book SEP, page 107 and in Gragg & |
-c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
-c | Determine if we need to correct the residual. The goal is |
-c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
-c | The following test determines whether the sine of the |
-c | angle between OP*x and the computed residual is less |
-c | than or equal to 0.717. |
-c %-----------------------------------------------------------%
-c
- if (rnorm .gt. 0.717*wnorm) go to 100
- iter = 0
- nrorth = nrorth + 1
-c
-c %---------------------------------------------------%
-c | Enter the Iterative refinement phase. If further |
-c | refinement is necessary, loop back here. The loop |
-c | variable is ITER. Perform a step of Classical |
-c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
-c %---------------------------------------------------%
-c
- 80 continue
-c
- if (msglvl .gt. 2) then
- xtemp(1) = wnorm
- xtemp(2) = rnorm
- call dvout (logfil, 2, xtemp, ndigit,
- & '_naitr: re-orthonalization; wnorm and rnorm are')
- call dvout (logfil, j, h(1,j), ndigit,
- & '_naitr: j-th column of H')
- end if
-c
-c %----------------------------------------------------%
-c | Compute V_{j}^T * B * r_{j}. |
-c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
-c %----------------------------------------------------%
-c
- call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
- & zero, workd(irj), 1)
-c
-c %---------------------------------------------%
-c | Compute the correction to the residual: |
-c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
-c | The correction to H is v(:,1:J)*H(1:J,1:J) |
-c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
-c %---------------------------------------------%
-c
- call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
- & one, resid, 1)
- call daxpy (j, one, workd(irj), 1, h(1,j), 1)
-c
- orth2 = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-----------------------------------%
-c | Exit in order to compute B*r_{j}. |
-c | r_{j} is the corrected residual. |
-c %-----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd(ipj), 1)
- end if
- 90 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH2 = .true. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
-c %-----------------------------------------------------%
-c | Compute the B-norm of the corrected residual r_{j}. |
-c %-----------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm1 = ddot (n, resid, 1, workd(ipj), 1)
- rnorm1 = sqrt(abs(rnorm1))
- else if (bmat .eq. 'I') then
- rnorm1 = dnrm2(n, resid, 1)
- end if
-c
- if (msglvl .gt. 0 .and. iter .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_naitr: Iterative refinement for Arnoldi residual')
- if (msglvl .gt. 2) then
- xtemp(1) = rnorm
- xtemp(2) = rnorm1
- call dvout (logfil, 2, xtemp, ndigit,
- & '_naitr: iterative refinement ; rnorm and rnorm1 are')
- end if
- end if
-c
-c %-----------------------------------------%
-c | Determine if we need to perform another |
-c | step of re-orthogonalization. |
-c %-----------------------------------------%
-c
- if (rnorm1 .gt. 0.717*rnorm) then
-c
-c %---------------------------------------%
-c | No need for further refinement. |
-c | The cosine of the angle between the |
-c | corrected residual vector and the old |
-c | residual vector is greater than 0.717 |
-c | In other words the corrected residual |
-c | and the old residual vector share an |
-c | angle of less than arcCOS(0.717) |
-c %---------------------------------------%
-c
- rnorm = rnorm1
-c
- else
-c
-c %-------------------------------------------%
-c | Another step of iterative refinement step |
-c | is required. NITREF is used by stat.h |
-c %-------------------------------------------%
-c
- nitref = nitref + 1
- rnorm = rnorm1
- iter = iter + 1
- if (iter .le. 1) go to 80
-c
-c %-------------------------------------------------%
-c | Otherwise RESID is numerically in the span of V |
-c %-------------------------------------------------%
-c
- do 95 jj = 1, n
- resid(jj) = zero
- 95 continue
- rnorm = zero
- end if
-c
-c %----------------------------------------------%
-c | Branch here directly if iterative refinement |
-c | wasn't necessary or after at most NITER_REF |
-c | steps of iterative refinement. |
-c %----------------------------------------------%
-c
- 100 continue
-c
- rstart = .false.
- orth2 = .false.
-c
- call arscnd (t5)
- titref = titref + (t5 - t4)
-c
-c %------------------------------------%
-c | STEP 6: Update j = j+1; Continue |
-c %------------------------------------%
-c
- j = j + 1
- if (j .gt. k+np) then
- call arscnd (t1)
- tnaitr = tnaitr + (t1 - t0)
- ido = 99
- do 110 i = max(1,k), k+np-1
-c
-c %--------------------------------------------%
-c | Check for splitting and deflation. |
-c | Use a standard test as in the QR algorithm |
-c | REFERENCE: LAPACK subroutine dlahqr |
-c %--------------------------------------------%
-c
- tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
- if( tst1.eq.zero )
- & tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) )
- if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
- & h(i+1,i) = zero
- 110 continue
-c
- if (msglvl .gt. 2) then
- call dmout (logfil, k+np, k+np, h, ldh, ndigit,
- & '_naitr: Final upper Hessenberg matrix H of order K+NP')
- end if
-c
- go to 9000
- end if
-c
-c %--------------------------------------------------------%
-c | Loop back to extend the factorization by another step. |
-c %--------------------------------------------------------%
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dnaitr |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dnapps.f b/netlib/ARPACK/dnapps.f
deleted file mode 100644
index ccb6869..0000000
--- a/netlib/ARPACK/dnapps.f
+++ /dev/null
@@ -1,647 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dnapps
-c
-c\Description:
-c Given the Arnoldi factorization
-c
-c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
-c
-c apply NP implicit shifts resulting in
-c
-c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
-c
-c where Q is an orthogonal matrix which is the product of rotations
-c and reflections resulting from the NP bulge chage sweeps.
-c The updated Arnoldi factorization becomes:
-c
-c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
-c
-c\Usage:
-c call dnapps
-c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
-c WORKL, WORKD )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Problem size, i.e. size of matrix A.
-c
-c KEV Integer. (INPUT/OUTPUT)
-c KEV+NP is the size of the input matrix H.
-c KEV is the size of the updated matrix HNEW. KEV is only
-c updated on ouput when fewer than NP shifts are applied in
-c order to keep the conjugate pair together.
-c
-c NP Integer. (INPUT)
-c Number of implicit shifts to be applied.
-c
-c SHIFTR, Double precision array of length NP. (INPUT)
-c SHIFTI Real and imaginary part of the shifts to be applied.
-c Upon, entry to dnapps, the shifts must be sorted so that the
-c conjugate pairs are in consecutive locations.
-c
-c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
-c On INPUT, V contains the current KEV+NP Arnoldi vectors.
-c On OUTPUT, V contains the updated KEV Arnoldi vectors
-c in the first KEV columns of V.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
-c On INPUT, H contains the current KEV+NP by KEV+NP upper
-c Hessenber matrix of the Arnoldi factorization.
-c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
-c matrix in the KEV leading submatrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
-c On INPUT, RESID contains the the residual vector r_{k+p}.
-c On OUTPUT, RESID is the update residual vector rnew_{k}
-c in the first KEV locations.
-c
-c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
-c Work array used to accumulate the rotations and reflections
-c during the bulge chase sweep.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Double precision work array of length (KEV+NP). (WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end.
-c
-c WORKD Double precision work array of length 2*N. (WORKSPACE)
-c Distributed array used in the application of the accumulated
-c orthogonal matrix Q.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c
-c\Routines called:
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dmout ARPACK utility routine that prints matrices.
-c dvout ARPACK utility routine that prints vectors.
-c dlabad LAPACK routine that computes machine constants.
-c dlacpy LAPACK matrix copy routine.
-c dlamch LAPACK routine that determines machine constants.
-c dlanhs LAPACK routine that computes various norms of a matrix.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlarf LAPACK routine that applies Householder reflection to
-c a matrix.
-c dlarfg LAPACK Householder reflection construction routine.
-c dlartg LAPACK Givens rotation construction routine.
-c dlaset LAPACK matrix initialization routine.
-c dgemv Level 2 BLAS routine for matrix vector multiplication.
-c daxpy Level 1 BLAS that computes a vector triad.
-c dcopy Level 1 BLAS that copies one vector to another .
-c dscal Level 1 BLAS that scales a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2
-c
-c\Remarks
-c 1. In this version, each shift is applied to all the sublocks of
-c the Hessenberg matrix H and not just to the submatrix that it
-c comes from. Deflation as in LAPACK routine dlahqr (QR algorithm
-c for upper Hessenberg matrices ) is used.
-c The subdiagonals of H are enforced to be non-negative.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dnapps
- & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq,
- & workl, workd )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer kev, ldh, ldq, ldv, n, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
- & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
- logical cconj, first
- Double precision
- & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
- & sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
- save first, ovfl, smlnum, ulp, unfl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf,
- & dlaset, dlabad, arscnd, dlartg
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlamch, dlanhs, dlapy2
- external dlamch, dlanhs, dlapy2
-c
-c %----------------------%
-c | Intrinsics Functions |
-c %----------------------%
-c
- intrinsic abs, max, min
-c
-c %----------------%
-c | Data statments |
-c %----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
-c
-c %-----------------------------------------------%
-c | Set machine-dependent constants for the |
-c | stopping criterion. If norm(H) <= sqrt(OVFL), |
-c | overflow should not occur. |
-c | REFERENCE: LAPACK subroutine dlahqr |
-c %-----------------------------------------------%
-c
- unfl = dlamch( 'safe minimum' )
- ovfl = one / unfl
- call dlabad( unfl, ovfl )
- ulp = dlamch( 'precision' )
- smlnum = unfl*( n / ulp )
- first = .false.
- end if
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mnapps
- kplusp = kev + np
-c
-c %--------------------------------------------%
-c | Initialize Q to the identity to accumulate |
-c | the rotations and reflections |
-c %--------------------------------------------%
-c
- call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
-c
-c %----------------------------------------------%
-c | Quick return if there are no shifts to apply |
-c %----------------------------------------------%
-c
- if (np .eq. 0) go to 9000
-c
-c %----------------------------------------------%
-c | Chase the bulge with the application of each |
-c | implicit shift. Each shift is applied to the |
-c | whole matrix including each block. |
-c %----------------------------------------------%
-c
- cconj = .false.
- do 110 jj = 1, np
- sigmar = shiftr(jj)
- sigmai = shifti(jj)
-c
- if (msglvl .gt. 2 ) then
- call ivout (logfil, 1, jj, ndigit,
- & '_napps: shift number.')
- call dvout (logfil, 1, sigmar, ndigit,
- & '_napps: The real part of the shift ')
- call dvout (logfil, 1, sigmai, ndigit,
- & '_napps: The imaginary part of the shift ')
- end if
-c
-c %-------------------------------------------------%
-c | The following set of conditionals is necessary |
-c | in order that complex conjugate pairs of shifts |
-c | are applied together or not at all. |
-c %-------------------------------------------------%
-c
- if ( cconj ) then
-c
-c %-----------------------------------------%
-c | cconj = .true. means the previous shift |
-c | had non-zero imaginary part. |
-c %-----------------------------------------%
-c
- cconj = .false.
- go to 110
- else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
-c
-c %------------------------------------%
-c | Start of a complex conjugate pair. |
-c %------------------------------------%
-c
- cconj = .true.
- else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
-c
-c %----------------------------------------------%
-c | The last shift has a nonzero imaginary part. |
-c | Don't apply it; thus the order of the |
-c | compressed H is order KEV+1 since only np-1 |
-c | were applied. |
-c %----------------------------------------------%
-c
- kev = kev + 1
- go to 110
- end if
- istart = 1
- 20 continue
-c
-c %--------------------------------------------------%
-c | if sigmai = 0 then |
-c | Apply the jj-th shift ... |
-c | else |
-c | Apply the jj-th and (jj+1)-th together ... |
-c | (Note that jj < np at this point in the code) |
-c | end |
-c | to the current block of H. The next do loop |
-c | determines the current block ; |
-c %--------------------------------------------------%
-c
- do 30 i = istart, kplusp-1
-c
-c %----------------------------------------%
-c | Check for splitting and deflation. Use |
-c | a standard test as in the QR algorithm |
-c | REFERENCE: LAPACK subroutine dlahqr |
-c %----------------------------------------%
-c
- tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
- if( tst1.eq.zero )
- & tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl )
- if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, i, ndigit,
- & '_napps: matrix splitting at row/column no.')
- call ivout (logfil, 1, jj, ndigit,
- & '_napps: matrix splitting with shift number.')
- call dvout (logfil, 1, h(i+1,i), ndigit,
- & '_napps: off diagonal element.')
- end if
- iend = i
- h(i+1,i) = zero
- go to 40
- end if
- 30 continue
- iend = kplusp
- 40 continue
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, istart, ndigit,
- & '_napps: Start of current block ')
- call ivout (logfil, 1, iend, ndigit,
- & '_napps: End of current block ')
- end if
-c
-c %------------------------------------------------%
-c | No reason to apply a shift to block of order 1 |
-c %------------------------------------------------%
-c
- if ( istart .eq. iend ) go to 100
-c
-c %------------------------------------------------------%
-c | If istart + 1 = iend then no reason to apply a |
-c | complex conjugate pair of shifts on a 2 by 2 matrix. |
-c %------------------------------------------------------%
-c
- if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
- & go to 100
-c
- h11 = h(istart,istart)
- h21 = h(istart+1,istart)
- if ( abs( sigmai ) .le. zero ) then
-c
-c %---------------------------------------------%
-c | Real-valued shift ==> apply single shift QR |
-c %---------------------------------------------%
-c
- f = h11 - sigmar
- g = h21
-c
- do 80 i = istart, iend-1
-c
-c %-----------------------------------------------------%
-c | Contruct the plane rotation G to zero out the bulge |
-c %-----------------------------------------------------%
-c
- call dlartg (f, g, c, s, r)
- if (i .gt. istart) then
-c
-c %-------------------------------------------%
-c | The following ensures that h(1:iend-1,1), |
-c | the first iend-2 off diagonal of elements |
-c | H, remain non negative. |
-c %-------------------------------------------%
-c
- if (r .lt. zero) then
- r = -r
- c = -c
- s = -s
- end if
- h(i,i-1) = r
- h(i+1,i-1) = zero
- end if
-c
-c %---------------------------------------------%
-c | Apply rotation to the left of H; H <- G'*H |
-c %---------------------------------------------%
-c
- do 50 j = i, kplusp
- t = c*h(i,j) + s*h(i+1,j)
- h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
- h(i,j) = t
- 50 continue
-c
-c %---------------------------------------------%
-c | Apply rotation to the right of H; H <- H*G |
-c %---------------------------------------------%
-c
- do 60 j = 1, min(i+2,iend)
- t = c*h(j,i) + s*h(j,i+1)
- h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
- h(j,i) = t
- 60 continue
-c
-c %----------------------------------------------------%
-c | Accumulate the rotation in the matrix Q; Q <- Q*G |
-c %----------------------------------------------------%
-c
- do 70 j = 1, min( i+jj, kplusp )
- t = c*q(j,i) + s*q(j,i+1)
- q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
- q(j,i) = t
- 70 continue
-c
-c %---------------------------%
-c | Prepare for next rotation |
-c %---------------------------%
-c
- if (i .lt. iend-1) then
- f = h(i+1,i)
- g = h(i+2,i)
- end if
- 80 continue
-c
-c %-----------------------------------%
-c | Finished applying the real shift. |
-c %-----------------------------------%
-c
- else
-c
-c %----------------------------------------------------%
-c | Complex conjugate shifts ==> apply double shift QR |
-c %----------------------------------------------------%
-c
- h12 = h(istart,istart+1)
- h22 = h(istart+1,istart+1)
- h32 = h(istart+2,istart+1)
-c
-c %---------------------------------------------------------%
-c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
-c %---------------------------------------------------------%
-c
- s = 2.0*sigmar
- t = dlapy2 ( sigmar, sigmai )
- u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
- u(2) = h11 + h22 - s
- u(3) = h32
-c
- do 90 i = istart, iend-1
-c
- nr = min ( 3, iend-i+1 )
-c
-c %-----------------------------------------------------%
-c | Construct Householder reflector G to zero out u(1). |
-c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
-c %-----------------------------------------------------%
-c
- call dlarfg ( nr, u(1), u(2), 1, tau )
-c
- if (i .gt. istart) then
- h(i,i-1) = u(1)
- h(i+1,i-1) = zero
- if (i .lt. iend-1) h(i+2,i-1) = zero
- end if
- u(1) = one
-c
-c %--------------------------------------%
-c | Apply the reflector to the left of H |
-c %--------------------------------------%
-c
- call dlarf ('Left', nr, kplusp-i+1, u, 1, tau,
- & h(i,i), ldh, workl)
-c
-c %---------------------------------------%
-c | Apply the reflector to the right of H |
-c %---------------------------------------%
-c
- ir = min ( i+3, iend )
- call dlarf ('Right', ir, nr, u, 1, tau,
- & h(1,i), ldh, workl)
-c
-c %-----------------------------------------------------%
-c | Accumulate the reflector in the matrix Q; Q <- Q*G |
-c %-----------------------------------------------------%
-c
- call dlarf ('Right', kplusp, nr, u, 1, tau,
- & q(1,i), ldq, workl)
-c
-c %----------------------------%
-c | Prepare for next reflector |
-c %----------------------------%
-c
- if (i .lt. iend-1) then
- u(1) = h(i+1,i)
- u(2) = h(i+2,i)
- if (i .lt. iend-2) u(3) = h(i+3,i)
- end if
-c
- 90 continue
-c
-c %--------------------------------------------%
-c | Finished applying a complex pair of shifts |
-c | to the current block |
-c %--------------------------------------------%
-c
- end if
-c
- 100 continue
-c
-c %---------------------------------------------------------%
-c | Apply the same shift to the next block if there is any. |
-c %---------------------------------------------------------%
-c
- istart = iend + 1
- if (iend .lt. kplusp) go to 20
-c
-c %---------------------------------------------%
-c | Loop back to the top to get the next shift. |
-c %---------------------------------------------%
-c
- 110 continue
-c
-c %--------------------------------------------------%
-c | Perform a similarity transformation that makes |
-c | sure that H will have non negative sub diagonals |
-c %--------------------------------------------------%
-c
- do 120 j=1,kev
- if ( h(j+1,j) .lt. zero ) then
- call dscal( kplusp-j+1, -one, h(j+1,j), ldh )
- call dscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
- call dscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
- end if
- 120 continue
-c
- do 130 i = 1, kev
-c
-c %--------------------------------------------%
-c | Final check for splitting and deflation. |
-c | Use a standard test as in the QR algorithm |
-c | REFERENCE: LAPACK subroutine dlahqr |
-c %--------------------------------------------%
-c
- tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
- if( tst1.eq.zero )
- & tst1 = dlanhs( '1', kev, h, ldh, workl )
- if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
- & h(i+1,i) = zero
- 130 continue
-c
-c %-------------------------------------------------%
-c | Compute the (kev+1)-st column of (V*Q) and |
-c | temporarily store the result in WORKD(N+1:2*N). |
-c | This is needed in the residual update since we |
-c | cannot GUARANTEE that the corresponding entry |
-c | of H would be zero as in exact arithmetic. |
-c %-------------------------------------------------%
-c
- if (h(kev+1,kev) .gt. zero)
- & call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
- & workd(n+1), 1)
-c
-c %----------------------------------------------------------%
-c | Compute column 1 to kev of (V*Q) in backward order |
-c | taking advantage of the upper Hessenberg structure of Q. |
-c %----------------------------------------------------------%
-c
- do 140 i = 1, kev
- call dgemv ('N', n, kplusp-i+1, one, v, ldv,
- & q(1,kev-i+1), 1, zero, workd, 1)
- call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
- 140 continue
-c
-c %-------------------------------------------------%
-c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
-c %-------------------------------------------------%
-c
- call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
-c
-c %--------------------------------------------------------------%
-c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
-c %--------------------------------------------------------------%
-c
- if (h(kev+1,kev) .gt. zero)
- & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
-c
-c %-------------------------------------%
-c | Update the residual vector: |
-c | r <- sigmak*r + betak*v(:,kev+1) |
-c | where |
-c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
-c | betak = e_{kev+1}'*H*e_{kev} |
-c %-------------------------------------%
-c
- call dscal (n, q(kplusp,kev), resid, 1)
- if (h(kev+1,kev) .gt. zero)
- & call daxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, 1, q(kplusp,kev), ndigit,
- & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
- call dvout (logfil, 1, h(kev+1,kev), ndigit,
- & '_napps: betak = e_{kev+1}^T*H*e_{kev}')
- call ivout (logfil, 1, kev, ndigit,
- & '_napps: Order of the final Hessenberg matrix ')
- if (msglvl .gt. 2) then
- call dmout (logfil, kev, kev, h, ldh, ndigit,
- & '_napps: updated Hessenberg matrix H for next iteration')
- end if
-c
- end if
-c
- 9000 continue
- call arscnd (t1)
- tnapps = tnapps + (t1 - t0)
-c
- return
-c
-c %---------------%
-c | End of dnapps |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dnaup2.f b/netlib/ARPACK/dnaup2.f
deleted file mode 100644
index cb7431e..0000000
--- a/netlib/ARPACK/dnaup2.f
+++ /dev/null
@@ -1,846 +0,0 @@
-c\BeginDoc
-c
-c\Name: dnaup2
-c
-c\Description:
-c Intermediate level interface called by dnaupd .
-c
-c\Usage:
-c call dnaup2
-c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
-c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
-c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
-c
-c\Arguments
-c
-c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dnaupd .
-c MODE, ISHIFT, MXITER: see the definition of IPARAM in dnaupd .
-c
-c NP Integer. (INPUT/OUTPUT)
-c Contains the number of implicit shifts to apply during
-c each Arnoldi iteration.
-c If ISHIFT=1, NP is adjusted dynamically at each iteration
-c to accelerate convergence and prevent stagnation.
-c This is also roughly equal to the number of matrix-vector
-c products (involving the operator OP) per Arnoldi iteration.
-c The logic for adjusting is contained within the current
-c subroutine.
-c If ISHIFT=0, NP is the number of shifts the user needs
-c to provide via reverse comunication. 0 < NP < NCV-NEV.
-c NP may be less than NCV-NEV for two reasons. The first, is
-c to keep complex conjugate pairs of "wanted" Ritz values
-c together. The second, is that a leading block of the current
-c upper Hessenberg matrix has split off and contains "unwanted"
-c Ritz values.
-c Upon termination of the IRA iteration, NP contains the number
-c of "converged" wanted Ritz values.
-c
-c IUPD Integer. (INPUT)
-c IUPD .EQ. 0: use explicit restart instead implicit update.
-c IUPD .NE. 0: use implicit update.
-c
-c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
-c The Arnoldi basis vectors are returned in the first NEV
-c columns of V.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Double precision (NEV+NP) by (NEV+NP) array. (OUTPUT)
-c H is used to store the generated upper Hessenberg matrix
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RITZR, Double precision arrays of length NEV+NP. (OUTPUT)
-c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
-c imaginary) part of the computed Ritz values of OP.
-c
-c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
-c BOUNDS(1:NEV) contain the error bounds corresponding to
-c the computed Ritz values.
-c
-c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
-c Private (replicated) work array used to accumulate the
-c rotation in the shift application step.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Double precision work array of length at least
-c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. It is used in shifts calculation, shifts
-c application and convergence checking.
-c
-c On exit, the last 3*(NEV+NP) locations of WORKL contain
-c the Ritz values (real,imaginary) and associated Ritz
-c estimates of the current Hessenberg matrix. They are
-c listed in the same order as returned from dneigh .
-c
-c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
-c of WORKL are used in reverse communication to hold the user
-c supplied shifts.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD for
-c vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in the
-c shift-and-invert mode. X is the current operand.
-c -------------------------------------------------------------
-c
-c WORKD Double precision work array of length 3*N. (WORKSPACE)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration !!!!!!!!!!
-c See Data Distribution Note in DNAUPD.
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal return.
-c = 1: Maximum number of iterations taken.
-c All possible eigenvalues of OP has been found.
-c NP returns the number of converged Ritz values.
-c = 2: No shifts could be applied.
-c = -8: Error return from LAPACK eigenvalue calculation;
-c This should never happen.
-c = -9: Starting vector is zero.
-c = -9999: Could not build an Arnoldi factorization.
-c Size that was built in returned in NP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c dgetv0 ARPACK initial vector generation routine.
-c dnaitr ARPACK Arnoldi factorization routine.
-c dnapps ARPACK application of implicit shifts routine.
-c dnconv ARPACK convergence of Ritz values routine.
-c dneigh ARPACK compute Ritz values and error bounds routine.
-c dngets ARPACK reorder Ritz values and error bounds routine.
-c dsortc ARPACK sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dmout ARPACK utility routine that prints matrices
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dcopy Level 1 BLAS that copies one vector to another .
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dswap Level 1 BLAS that swaps two vectors.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2
-c
-c\Remarks
-c 1. None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dnaup2
- & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
- & q, ldq, workl, ipntr, workd, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
- & n, nev, np
- Double precision
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(13)
- Double precision
- & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
- & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
- & workd(3*n), workl( (nev+np)*(nev+np+3) )
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0 , zero = 0.0D+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character wprime*2
- logical cnorm , getv0, initv, update, ushift
- integer ierr , iter , j , kplusp, msglvl, nconv,
- & nevbef, nev0 , np0 , nptemp, numcnv
- Double precision
- & rnorm , temp , eps23
- save cnorm , getv0, initv, update, ushift,
- & rnorm , iter , eps23, kplusp, msglvl, nconv ,
- & nevbef, nev0 , np0 , numcnv
-c
-c %-----------------------%
-c | Local array arguments |
-c %-----------------------%
-c
- integer kp(4)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy , dgetv0 , dnaitr , dnconv , dneigh ,
- & dngets , dnapps , dvout , ivout , arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & ddot , dnrm2 , dlapy2 , dlamch
- external ddot , dnrm2 , dlapy2 , dlamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic min, max, abs, sqrt
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
- call arscnd (t0)
-c
- msglvl = mnaup2
-c
-c %-------------------------------------%
-c | Get the machine dependent constant. |
-c %-------------------------------------%
-c
- eps23 = dlamch ('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0 )
-c
- nev0 = nev
- np0 = np
-c
-c %-------------------------------------%
-c | kplusp is the bound on the largest |
-c | Lanczos factorization built. |
-c | nconv is the current number of |
-c | "converged" eigenvlues. |
-c | iter is the counter on the current |
-c | iteration step. |
-c %-------------------------------------%
-c
- kplusp = nev + np
- nconv = 0
- iter = 0
-c
-c %---------------------------------------%
-c | Set flags for computing the first NEV |
-c | steps of the Arnoldi factorization. |
-c %---------------------------------------%
-c
- getv0 = .true.
- update = .false.
- ushift = .false.
- cnorm = .false.
-c
- if (info .ne. 0) then
-c
-c %--------------------------------------------%
-c | User provides the initial residual vector. |
-c %--------------------------------------------%
-c
- initv = .true.
- info = 0
- else
- initv = .false.
- end if
- end if
-c
-c %---------------------------------------------%
-c | Get a possibly random starting vector and |
-c | force it into the range of the operator OP. |
-c %---------------------------------------------%
-c
- 10 continue
-c
- if (getv0) then
- call dgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
- & ipntr, workd, info)
-c
- if (ido .ne. 99) go to 9000
-c
- if (rnorm .eq. zero) then
-c
-c %-----------------------------------------%
-c | The initial vector is zero. Error exit. |
-c %-----------------------------------------%
-c
- info = -9
- go to 1100
- end if
- getv0 = .false.
- ido = 0
- end if
-c
-c %-----------------------------------%
-c | Back from reverse communication : |
-c | continue with update step |
-c %-----------------------------------%
-c
- if (update) go to 20
-c
-c %-------------------------------------------%
-c | Back from computing user specified shifts |
-c %-------------------------------------------%
-c
- if (ushift) go to 50
-c
-c %-------------------------------------%
-c | Back from computing residual norm |
-c | at the end of the current iteration |
-c %-------------------------------------%
-c
- if (cnorm) go to 100
-c
-c %----------------------------------------------------------%
-c | Compute the first NEV steps of the Arnoldi factorization |
-c %----------------------------------------------------------%
-c
- call dnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
-c
-c %--------------------------------------------------------------%
-c | |
-c | M A I N ARNOLDI I T E R A T I O N L O O P |
-c | Each iteration implicitly restarts the Arnoldi |
-c | factorization in place. |
-c | |
-c %--------------------------------------------------------------%
-c
- 1000 continue
-c
- iter = iter + 1
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, iter, ndigit,
- & '_naup2: **** Start of major iteration number ****')
- end if
-c
-c %-----------------------------------------------------------%
-c | Compute NP additional steps of the Arnoldi factorization. |
-c | Adjust NP since NEV might have been updated by last call |
-c | to the shift application routine dnapps . |
-c %-----------------------------------------------------------%
-c
- np = kplusp - nev
-c
- if (msglvl .gt. 1) then
- call ivout (logfil, 1, nev, ndigit,
- & '_naup2: The length of the current Arnoldi factorization')
- call ivout (logfil, 1, np, ndigit,
- & '_naup2: Extend the Arnoldi factorization by')
- end if
-c
-c %-----------------------------------------------------------%
-c | Compute NP additional steps of the Arnoldi factorization. |
-c %-----------------------------------------------------------%
-c
- ido = 0
- 20 continue
- update = .true.
-c
- call dnaitr (ido , bmat, n , nev, np , mode , resid,
- & rnorm, v , ldv, h , ldh, ipntr, workd,
- & info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
- update = .false.
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, 1, rnorm, ndigit,
- & '_naup2: Corresponding B-norm of the residual')
- end if
-c
-c %--------------------------------------------------------%
-c | Compute the eigenvalues and corresponding error bounds |
-c | of the current upper Hessenberg matrix. |
-c %--------------------------------------------------------%
-c
- call dneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds,
- & q, ldq, workl, ierr)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 1200
- end if
-c
-c %----------------------------------------------------%
-c | Make a copy of eigenvalues and corresponding error |
-c | bounds obtained from dneigh . |
-c %----------------------------------------------------%
-c
- call dcopy (kplusp, ritzr, 1, workl(kplusp**2+1), 1)
- call dcopy (kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
- call dcopy (kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
-c
-c %---------------------------------------------------%
-c | Select the wanted Ritz values and their bounds |
-c | to be used in the convergence test. |
-c | The wanted part of the spectrum and corresponding |
-c | error bounds are in the last NEV loc. of RITZR, |
-c | RITZI and BOUNDS respectively. The variables NEV |
-c | and NP may be updated if the NEV-th wanted Ritz |
-c | value has a non zero imaginary part. In this case |
-c | NEV is increased by one and NP decreased by one. |
-c | NOTE: The last two arguments of dngets are no |
-c | longer used as of version 2.1. |
-c %---------------------------------------------------%
-c
- nev = nev0
- np = np0
- numcnv = nev
- call dngets (ishift, which, nev, np, ritzr, ritzi,
- & bounds, workl, workl(np+1))
- if (nev .eq. nev0+1) numcnv = nev0+1
-c
-c %-------------------%
-c | Convergence test. |
-c %-------------------%
-c
- call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
- call dnconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
- & tol, nconv)
-c
- if (msglvl .gt. 2) then
- kp(1) = nev
- kp(2) = np
- kp(3) = numcnv
- kp(4) = nconv
- call ivout (logfil, 4, kp, ndigit,
- & '_naup2: NEV, NP, NUMCNV, NCONV are')
- call dvout (logfil, kplusp, ritzr, ndigit,
- & '_naup2: Real part of the eigenvalues of H')
- call dvout (logfil, kplusp, ritzi, ndigit,
- & '_naup2: Imaginary part of the eigenvalues of H')
- call dvout (logfil, kplusp, bounds, ndigit,
- & '_naup2: Ritz estimates of the current NCV Ritz values')
- end if
-c
-c %---------------------------------------------------------%
-c | Count the number of unwanted Ritz values that have zero |
-c | Ritz estimates. If any Ritz estimates are equal to zero |
-c | then a leading block of H of order equal to at least |
-c | the number of Ritz values with zero Ritz estimates has |
-c | split off. None of these Ritz values may be removed by |
-c | shifting. Decrease NP the number of shifts to apply. If |
-c | no shifts may be applied, then prepare to exit |
-c %---------------------------------------------------------%
-c
- nptemp = np
- do 30 j=1, nptemp
- if (bounds(j) .eq. zero) then
- np = np - 1
- nev = nev + 1
- end if
- 30 continue
-c
- if ( (nconv .ge. numcnv) .or.
- & (iter .gt. mxiter) .or.
- & (np .eq. 0) ) then
-c
- if (msglvl .gt. 4) then
- call dvout (logfil, kplusp, workl(kplusp**2+1), ndigit,
- & '_naup2: Real part of the eig computed by _neigh:')
- call dvout (logfil, kplusp, workl(kplusp**2+kplusp+1),
- & ndigit,
- & '_naup2: Imag part of the eig computed by _neigh:')
- call dvout (logfil, kplusp, workl(kplusp**2+kplusp*2+1),
- & ndigit,
- & '_naup2: Ritz eistmates computed by _neigh:')
- end if
-c
-c %------------------------------------------------%
-c | Prepare to exit. Put the converged Ritz values |
-c | and corresponding bounds in RITZ(1:NCONV) and |
-c | BOUNDS(1:NCONV) respectively. Then sort. Be |
-c | careful when NCONV > NP |
-c %------------------------------------------------%
-c
-c %------------------------------------------%
-c | Use h( 3,1 ) as storage to communicate |
-c | rnorm to _neupd if needed |
-c %------------------------------------------%
-
- h(3,1) = rnorm
-c
-c %----------------------------------------------%
-c | To be consistent with dngets , we first do a |
-c | pre-processing sort in order to keep complex |
-c | conjugate pairs together. This is similar |
-c | to the pre-processing sort used in dngets |
-c | except that the sort is done in the opposite |
-c | order. |
-c %----------------------------------------------%
-c
- if (which .eq. 'LM') wprime = 'SR'
- if (which .eq. 'SM') wprime = 'LR'
- if (which .eq. 'LR') wprime = 'SM'
- if (which .eq. 'SR') wprime = 'LM'
- if (which .eq. 'LI') wprime = 'SM'
- if (which .eq. 'SI') wprime = 'LM'
-c
- call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
-c
-c %----------------------------------------------%
-c | Now sort Ritz values so that converged Ritz |
-c | values appear within the first NEV locations |
-c | of ritzr, ritzi and bounds, and the most |
-c | desired one appears at the front. |
-c %----------------------------------------------%
-c
- if (which .eq. 'LM') wprime = 'SM'
- if (which .eq. 'SM') wprime = 'LM'
- if (which .eq. 'LR') wprime = 'SR'
- if (which .eq. 'SR') wprime = 'LR'
- if (which .eq. 'LI') wprime = 'SI'
- if (which .eq. 'SI') wprime = 'LI'
-c
- call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
-c
-c %--------------------------------------------------%
-c | Scale the Ritz estimate of each Ritz value |
-c | by 1 / max(eps23,magnitude of the Ritz value). |
-c %--------------------------------------------------%
-c
- do 35 j = 1, numcnv
- temp = max(eps23,dlapy2 (ritzr(j),
- & ritzi(j)))
- bounds(j) = bounds(j)/temp
- 35 continue
-c
-c %----------------------------------------------------%
-c | Sort the Ritz values according to the scaled Ritz |
-c | esitmates. This will push all the converged ones |
-c | towards the front of ritzr, ritzi, bounds |
-c | (in the case when NCONV < NEV.) |
-c %----------------------------------------------------%
-c
- wprime = 'LR'
- call dsortc (wprime, .true., numcnv, bounds, ritzr, ritzi)
-c
-c %----------------------------------------------%
-c | Scale the Ritz estimate back to its original |
-c | value. |
-c %----------------------------------------------%
-c
- do 40 j = 1, numcnv
- temp = max(eps23, dlapy2 (ritzr(j),
- & ritzi(j)))
- bounds(j) = bounds(j)*temp
- 40 continue
-c
-c %------------------------------------------------%
-c | Sort the converged Ritz values again so that |
-c | the "threshold" value appears at the front of |
-c | ritzr, ritzi and bound. |
-c %------------------------------------------------%
-c
- call dsortc (which, .true., nconv, ritzr, ritzi, bounds)
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, kplusp, ritzr, ndigit,
- & '_naup2: Sorted real part of the eigenvalues')
- call dvout (logfil, kplusp, ritzi, ndigit,
- & '_naup2: Sorted imaginary part of the eigenvalues')
- call dvout (logfil, kplusp, bounds, ndigit,
- & '_naup2: Sorted ritz estimates.')
- end if
-c
-c %------------------------------------%
-c | Max iterations have been exceeded. |
-c %------------------------------------%
-c
- if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
-c
-c %---------------------%
-c | No shifts to apply. |
-c %---------------------%
-c
- if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
-c
- np = nconv
- go to 1100
-c
- else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
-c
-c %-------------------------------------------------%
-c | Do not have all the requested eigenvalues yet. |
-c | To prevent possible stagnation, adjust the size |
-c | of NEV. |
-c %-------------------------------------------------%
-c
- nevbef = nev
- nev = nev + min(nconv, np/2)
- if (nev .eq. 1 .and. kplusp .ge. 6) then
- nev = kplusp / 2
- else if (nev .eq. 1 .and. kplusp .gt. 3) then
- nev = 2
- end if
-c %---- Scipy fix ------------------------------------------------
-c | We must keep nev below this value, as otherwise we can get
-c | np == 0 (note that dngets below can bump nev by 1). If np == 0,
-c | the next call to `dnaitr` will write out-of-bounds.
-c |
- if (nev .gt. kplusp - 2) then
- nev = kplusp - 2
- end if
-c |
-c %---- Scipy fix end --------------------------------------------
-c
- np = kplusp - nev
-c
-c %---------------------------------------%
-c | If the size of NEV was just increased |
-c | resort the eigenvalues. |
-c %---------------------------------------%
-c
- if (nevbef .lt. nev)
- & call dngets (ishift, which, nev, np, ritzr, ritzi,
- & bounds, workl, workl(np+1))
-c
- end if
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, nconv, ndigit,
- & '_naup2: no. of "converged" Ritz values at this iter.')
- if (msglvl .gt. 1) then
- kp(1) = nev
- kp(2) = np
- call ivout (logfil, 2, kp, ndigit,
- & '_naup2: NEV and NP are')
- call dvout (logfil, nev, ritzr(np+1), ndigit,
- & '_naup2: "wanted" Ritz values -- real part')
- call dvout (logfil, nev, ritzi(np+1), ndigit,
- & '_naup2: "wanted" Ritz values -- imag part')
- call dvout (logfil, nev, bounds(np+1), ndigit,
- & '_naup2: Ritz estimates of the "wanted" values ')
- end if
- end if
-c
- if (ishift .eq. 0) then
-c
-c %-------------------------------------------------------%
-c | User specified shifts: reverse comminucation to |
-c | compute the shifts. They are returned in the first |
-c | 2*NP locations of WORKL. |
-c %-------------------------------------------------------%
-c
- ushift = .true.
- ido = 3
- go to 9000
- end if
-c
- 50 continue
-c
-c %------------------------------------%
-c | Back from reverse communication; |
-c | User specified shifts are returned |
-c | in WORKL(1:2*NP) |
-c %------------------------------------%
-c
- ushift = .false.
-c
- if ( ishift .eq. 0 ) then
-c
-c %----------------------------------%
-c | Move the NP shifts from WORKL to |
-c | RITZR, RITZI to free up WORKL |
-c | for non-exact shift case. |
-c %----------------------------------%
-c
- call dcopy (np, workl, 1, ritzr, 1)
- call dcopy (np, workl(np+1), 1, ritzi, 1)
- end if
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, np, ndigit,
- & '_naup2: The number of shifts to apply ')
- call dvout (logfil, np, ritzr, ndigit,
- & '_naup2: Real part of the shifts')
- call dvout (logfil, np, ritzi, ndigit,
- & '_naup2: Imaginary part of the shifts')
- if ( ishift .eq. 1 )
- & call dvout (logfil, np, bounds, ndigit,
- & '_naup2: Ritz estimates of the shifts')
- end if
-c
-c %---------------------------------------------------------%
-c | Apply the NP implicit shifts by QR bulge chasing. |
-c | Each shift is applied to the whole upper Hessenberg |
-c | matrix H. |
-c | The first 2*N locations of WORKD are used as workspace. |
-c %---------------------------------------------------------%
-c
- call dnapps (n, nev, np, ritzr, ritzi, v, ldv,
- & h, ldh, resid, q, ldq, workl, workd)
-c
-c %---------------------------------------------%
-c | Compute the B-norm of the updated residual. |
-c | Keep B*RESID in WORKD(1:N) to be used in |
-c | the first step of the next call to dnaitr . |
-c %---------------------------------------------%
-c
- cnorm = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(n+1), 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*RESID |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd, 1)
- end if
-c
- 100 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(1:N) := B*RESID |
-c %----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- if (bmat .eq. 'G') then
- rnorm = ddot (n, resid, 1, workd, 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = dnrm2 (n, resid, 1)
- end if
- cnorm = .false.
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, 1, rnorm, ndigit,
- & '_naup2: B-norm of residual for compressed factorization')
- call dmout (logfil, nev, nev, h, ldh, ndigit,
- & '_naup2: Compressed upper Hessenberg matrix H')
- end if
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 1100 continue
-c
- mxiter = iter
- nev = numcnv
-c
- 1200 continue
- ido = 99
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- call arscnd (t1)
- tnaup2 = t1 - t0
-c
- 9000 continue
-c
-c %---------------%
-c | End of dnaup2 |
-c %---------------%
-c
- return
- end
diff --git a/netlib/ARPACK/dnaupd.f b/netlib/ARPACK/dnaupd.f
deleted file mode 100644
index 114a6d7..0000000
--- a/netlib/ARPACK/dnaupd.f
+++ /dev/null
@@ -1,693 +0,0 @@
-c\BeginDoc
-c
-c\Name: dnaupd
-c
-c\Description:
-c Reverse communication interface for the Implicitly Restarted Arnoldi
-c iteration. This subroutine computes approximations to a few eigenpairs
-c of a linear operator "OP" with respect to a semi-inner product defined by
-c a symmetric positive semi-definite real matrix B. B may be the identity
-c matrix. NOTE: If the linear operator "OP" is real and symmetric
-c with respect to the real positive semi-definite symmetric matrix B,
-c i.e. B*OP = (OP`)*B, then subroutine dsaupd should be used instead.
-c
-c The computed approximate eigenvalues are called Ritz values and
-c the corresponding approximate eigenvectors are called Ritz vectors.
-c
-c dnaupd is usually called iteratively to solve one of the
-c following problems:
-c
-c Mode 1: A*x = lambda*x.
-c ===> OP = A and B = I.
-c
-c Mode 2: A*x = lambda*M*x, M symmetric positive definite
-c ===> OP = inv[M]*A and B = M.
-c ===> (If M can be factored see remark 3 below)
-c
-c Mode 3: A*x = lambda*M*x, M symmetric semi-definite
-c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
-c ===> shift-and-invert mode (in real arithmetic)
-c If OP*x = amu*x, then
-c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
-c Note: If sigma is real, i.e. imaginary part of sigma is zero;
-c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
-c amu == 1/(lambda-sigma).
-c
-c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
-c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
-c ===> shift-and-invert mode (in real arithmetic)
-c If OP*x = amu*x, then
-c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
-c
-c Both mode 3 and 4 give the same enhancement to eigenvalues close to
-c the (complex) shift sigma. However, as lambda goes to infinity,
-c the operator OP in mode 4 dampens the eigenvalues more strongly than
-c does OP defined in mode 3.
-c
-c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
-c should be accomplished either by a direct method
-c using a sparse matrix factorization and solving
-c
-c [A - sigma*M]*w = v or M*w = v,
-c
-c or through an iterative method for solving these
-c systems. If an iterative method is used, the
-c convergence test must be more stringent than
-c the accuracy requirements for the eigenvalue
-c approximations.
-c
-c\Usage:
-c call dnaupd
-c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
-c IPNTR, WORKD, WORKL, LWORKL, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag. IDO must be zero on the first
-c call to dnaupd . IDO will be set internally to
-c indicate the type of operation to be performed. Control is
-c then given back to the calling routine which has the
-c responsibility to carry out the requested operation and call
-c dnaupd with the result. The operand is given in
-c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c This is for the initialization phase to force the
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c In mode 3 and 4, the vector B * X is already
-c available in WORKD(ipntr(3)). It does not
-c need to be recomputed in forming OP * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c IDO = 3: compute the IPARAM(8) real and imaginary parts
-c of the shifts where INPTR(14) is the pointer
-c into WORKL for placing the shifts. See Remark
-c 5 below.
-c IDO = 99: done
-c -------------------------------------------------------------
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B that defines the
-c semi-inner product for the operator OP.
-c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
-c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c WHICH Character*2. (INPUT)
-c 'LM' -> want the NEV eigenvalues of largest magnitude.
-c 'SM' -> want the NEV eigenvalues of smallest magnitude.
-c 'LR' -> want the NEV eigenvalues of largest real part.
-c 'SR' -> want the NEV eigenvalues of smallest real part.
-c 'LI' -> want the NEV eigenvalues of largest imaginary part.
-c 'SI' -> want the NEV eigenvalues of smallest imaginary part.
-c
-c NEV Integer. (INPUT)
-c Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
-c
-c TOL Double precision scalar. (INPUT/OUTPUT)
-c Stopping criterion: the relative accuracy of the Ritz value
-c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I))
-c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
-c DEFAULT = DLAMCH ('EPS') (machine precision as computed
-c by the LAPACK auxiliary subroutine DLAMCH ).
-c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
-c On INPUT:
-c If INFO .EQ. 0, a random initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c On OUTPUT:
-c RESID contains the final residual vector.
-c
-c NCV Integer. (INPUT)
-c Number of columns of the matrix V. NCV must satisfy the two
-c inequalities 2 <= NCV-NEV and NCV <= N.
-c This will indicate how many Arnoldi vectors are generated
-c at each iteration. After the startup phase in which NEV
-c Arnoldi vectors are generated, the algorithm generates
-c approximately NCV-NEV Arnoldi vectors at each subsequent update
-c iteration. Most of the cost in generating each Arnoldi vector is
-c in the matrix-vector operation OP*x.
-c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
-c values are kept together. (See remark 4 below)
-c
-c V Double precision array N by NCV. (OUTPUT)
-c Contains the final set of Arnoldi basis vectors.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling program.
-c
-c IPARAM Integer array of length 11. (INPUT/OUTPUT)
-c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
-c The shifts selected at each iteration are used to restart
-c the Arnoldi iteration in an implicit fashion.
-c -------------------------------------------------------------
-c ISHIFT = 0: the shifts are provided by the user via
-c reverse communication. The real and imaginary
-c parts of the NCV eigenvalues of the Hessenberg
-c matrix H are returned in the part of the WORKL
-c array corresponding to RITZR and RITZI. See remark
-c 5 below.
-c ISHIFT = 1: exact shifts with respect to the current
-c Hessenberg matrix H. This is equivalent to
-c restarting the iteration with a starting vector
-c that is a linear combination of approximate Schur
-c vectors associated with the "wanted" Ritz values.
-c -------------------------------------------------------------
-c
-c IPARAM(2) = No longer referenced.
-c
-c IPARAM(3) = MXITER
-c On INPUT: maximum number of Arnoldi update iterations allowed.
-c On OUTPUT: actual number of Arnoldi update iterations taken.
-c
-c IPARAM(4) = NB: blocksize to be used in the recurrence.
-c The code currently works only for NB = 1.
-c
-c IPARAM(5) = NCONV: number of "converged" Ritz values.
-c This represents the number of Ritz values that satisfy
-c the convergence criterion.
-c
-c IPARAM(6) = IUPD
-c No longer referenced. Implicit restarting is ALWAYS used.
-c
-c IPARAM(7) = MODE
-c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4; See under \Description of dnaupd for the
-c four modes available.
-c
-c IPARAM(8) = NP
-c When ido = 3 and the user provides shifts through reverse
-c communication (IPARAM(1)=0), dnaupd returns NP, the number
-c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
-c 5 below.
-c
-c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
-c OUTPUT: NUMOP = total number of OP*x operations,
-c NUMOPB = total number of B*x operations if BMAT='G',
-c NUMREO = total number of steps of re-orthogonalization.
-c
-c IPNTR Integer array of length 14. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD and WORKL
-c arrays for matrices/vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X in WORKD.
-c IPNTR(2): pointer to the current result vector Y in WORKD.
-c IPNTR(3): pointer to the vector B * X in WORKD when used in
-c the shift-and-invert mode.
-c IPNTR(4): pointer to the next available location in WORKL
-c that is untouched by the program.
-c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
-c H in WORKL.
-c IPNTR(6): pointer to the real part of the ritz value array
-c RITZR in WORKL.
-c IPNTR(7): pointer to the imaginary part of the ritz value array
-c RITZI in WORKL.
-c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
-c with the Ritz values located in RITZR and RITZI in WORKL.
-c
-c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
-c
-c Note: IPNTR(9:13) is only referenced by dneupd . See Remark 2 below.
-c
-c IPNTR(9): pointer to the real part of the NCV RITZ values of the
-c original system.
-c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
-c the original system.
-c IPNTR(11): pointer to the NCV corresponding error bounds.
-c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular
-c Schur matrix for H.
-c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors
-c of the upper Hessenberg matrix H. Only referenced by
-c dneupd if RVEC = .TRUE. See Remark 2 below.
-c -------------------------------------------------------------
-c
-c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration. Upon termination
-c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace
-c associated with the converged Ritz values is desired, see remark
-c 2 below, subroutine dneupd uses this output.
-c See Data Distribution Note below.
-c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. See Data Distribution Note below.
-c
-c LWORKL Integer. (INPUT)
-c LWORKL must be at least 3*NCV**2 + 6*NCV.
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal exit.
-c = 1: Maximum number of iterations taken.
-c All possible eigenvalues of OP has been found. IPARAM(5)
-c returns the number of wanted converged Ritz values.
-c = 2: No longer an informational error. Deprecated starting
-c with release 2 of ARPACK.
-c = 3: No shifts could be applied during a cycle of the
-c Implicitly restarted Arnoldi iteration. One possibility
-c is to increase the size of NCV relative to NEV.
-c See remark 4 below.
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
-c = -4: The maximum number of Arnoldi update iteration
-c must be greater than zero.
-c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work array is not sufficient.
-c = -8: Error return from LAPACK eigenvalue calculation;
-c = -9: Starting vector is zero.
-c = -10: IPARAM(7) must be 1,2,3,4.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
-c = -12: IPARAM(1) must be equal to 0 or 1.
-c = -9999: Could not build an Arnoldi factorization.
-c IPARAM(5) returns the size of the current Arnoldi
-c factorization.
-c
-c\Remarks
-c 1. The computed Ritz values are approximate eigenvalues of OP. The
-c selection of WHICH should be made with this in mind when
-c Mode = 3 and 4. After convergence, approximate eigenvalues of the
-c original problem may be obtained with the ARPACK subroutine dneupd .
-c
-c 2. If a basis for the invariant subspace corresponding to the converged Ritz
-c values is needed, the user must call dneupd immediately following
-c completion of dnaupd . This is new starting with release 2 of ARPACK.
-c
-c 3. If M can be factored into a Cholesky factorization M = LL`
-c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
-c linear systems should be solved with L and L` rather
-c than computing inverses. After convergence, an approximate
-c eigenvector z of the original problem is recovered by solving
-c L`z = x where x is a Ritz vector of OP.
-c
-c 4. At present there is no a-priori analysis to guide the selection
-c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2.
-c However, it is recommended that NCV .ge. 2*NEV+1. If many problems of
-c the same type are to be solved, one should experiment with increasing
-c NCV while keeping NEV fixed for a given test problem. This will
-c usually decrease the required number of OP*x operations but it
-c also increases the work and storage required to maintain the orthogonal
-c basis vectors. The optimal "cross-over" with respect to CPU time
-c is problem dependent and must be determined empirically.
-c See Chapter 8 of Reference 2 for further information.
-c
-c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
-c NP = IPARAM(8) real and imaginary parts of the shifts in locations
-c real part imaginary part
-c ----------------------- --------------
-c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
-c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
-c . .
-c . .
-c . .
-c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
-c
-c Only complex conjugate pairs of shifts may be applied and the pairs
-c must be placed in consecutive locations. The real part of the
-c eigenvalues of the current upper Hessenberg matrix are located in
-c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
-c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
-c according to the order defined by WHICH. The complex conjugate
-c pairs are kept together and the associated Ritz estimates are located in
-c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
-c
-c-----------------------------------------------------------------------
-c
-c\Data Distribution Note:
-c
-c Fortran-D syntax:
-c ================
-c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
-c decompose d1(n), d2(n,ncv)
-c align resid(i) with d1(i)
-c align v(i,j) with d2(i,j)
-c align workd(i) with d1(i) range (1:n)
-c align workd(i) with d1(i-n) range (n+1:2*n)
-c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
-c distribute d1(block), d2(block,:)
-c replicated workl(lworkl)
-c
-c Cray MPP syntax:
-c ===============
-c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
-c shared resid(block), v(block,:), workd(block,:)
-c replicated workl(lworkl)
-c
-c CM2/CM5 syntax:
-c ==============
-c
-c-----------------------------------------------------------------------
-c
-c include 'ex-nonsym.doc'
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
-c Real Matrices", Linear Algebra and its Applications, vol 88/89,
-c pp 575-595, (1987).
-c
-c\Routines called:
-c dnaup2 ARPACK routine that implements the Implicitly Restarted
-c Arnoldi Iteration.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/16/93: Version '1.1'
-c
-c\SCCS Information: @(#)
-c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
-c
-c\Remarks
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dnaupd
- & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam,
- & ipntr, workd, workl, lworkl, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ldv, lworkl, n, ncv, nev
- Double precision
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(11), ipntr(14)
- Double precision
- & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0 , zero = 0.0D+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer bounds, ierr, ih, iq, ishift, iupd, iw,
- & ldh, ldq, levec, mode, msglvl, mxiter, nb,
- & nev0, next, np, ritzi, ritzr, j
- save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
- & levec, mode, msglvl, mxiter, nb, nev0, next,
- & np, ritzi, ritzr
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dnaup2 , dvout , ivout, arscnd, dstatn
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlamch
- external dlamch
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call dstatn
- call arscnd (t0)
- msglvl = mnaupd
-c
-c %----------------%
-c | Error checking |
-c %----------------%
-c
- ierr = 0
- ishift = iparam(1)
-c levec = iparam(2)
- mxiter = iparam(3)
-c nb = iparam(4)
- nb = 1
-c
-c %--------------------------------------------%
-c | Revision 2 performs only implicit restart. |
-c %--------------------------------------------%
-c
- iupd = 1
- mode = iparam(7)
-c
- if (n .le. 0) then
- ierr = -1
- else if (nev .le. 0) then
- ierr = -2
- else if (ncv .le. nev+1 .or. ncv .gt. n) then
- ierr = -3
- else if (mxiter .le. 0) then
- ierr = -4
- else if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LR' .and.
- & which .ne. 'SR' .and.
- & which .ne. 'LI' .and.
- & which .ne. 'SI') then
- ierr = -5
- else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
- ierr = -6
- else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
- ierr = -7
- else if (mode .lt. 1 .or. mode .gt. 4) then
- ierr = -10
- else if (mode .eq. 1 .and. bmat .eq. 'G') then
- ierr = -11
- else if (ishift .lt. 0 .or. ishift .gt. 1) then
- ierr = -12
- end if
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- ido = 99
- go to 9000
- end if
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- if (nb .le. 0) nb = 1
- if (tol .le. zero) tol = dlamch ('EpsMach')
-c
-c %----------------------------------------------%
-c | NP is the number of additional steps to |
-c | extend the length NEV Lanczos factorization. |
-c | NEV0 is the local variable designating the |
-c | size of the invariant subspace desired. |
-c %----------------------------------------------%
-c
- np = ncv - nev
- nev0 = nev
-c
-c %-----------------------------%
-c | Zero out internal workspace |
-c %-----------------------------%
-c
- do 10 j = 1, 3*ncv**2 + 6*ncv
- workl(j) = zero
- 10 continue
-c
-c %-------------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:ncv*ncv) := generated Hessenberg matrix |
-c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
-c | parts of ritz values |
-c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
-c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
-c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
-c | The final workspace is needed by subroutine dneigh called |
-c | by dnaup2 . Subroutine dneigh calls LAPACK routines for |
-c | calculating eigenvalues and the last row of the eigenvector |
-c | matrix. |
-c %-------------------------------------------------------------%
-c
- ldh = ncv
- ldq = ncv
- ih = 1
- ritzr = ih + ldh*ncv
- ritzi = ritzr + ncv
- bounds = ritzi + ncv
- iq = bounds + ncv
- iw = iq + ldq*ncv
- next = iw + ncv**2 + 3*ncv
-c
- ipntr(4) = next
- ipntr(5) = ih
- ipntr(6) = ritzr
- ipntr(7) = ritzi
- ipntr(8) = bounds
- ipntr(14) = iw
-c
- end if
-c
-c %-------------------------------------------------------%
-c | Carry out the Implicitly restarted Arnoldi Iteration. |
-c %-------------------------------------------------------%
-c
- call dnaup2
- & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
- & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
- & ipntr, workd, info )
-c
-c %--------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP or shifts. |
-c %--------------------------------------------------%
-c
- if (ido .eq. 3) iparam(8) = np
- if (ido .ne. 99) go to 9000
-c
- iparam(3) = mxiter
- iparam(5) = np
- iparam(9) = nopx
- iparam(10) = nbx
- iparam(11) = nrorth
-c
-c %------------------------------------%
-c | Exit if there was an informational |
-c | error within dnaup2 . |
-c %------------------------------------%
-c
- if (info .lt. 0) go to 9000
- if (info .eq. 2) info = 3
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, mxiter, ndigit,
- & '_naupd: Number of update iterations taken')
- call ivout (logfil, 1, np, ndigit,
- & '_naupd: Number of wanted "converged" Ritz values')
- call dvout (logfil, np, workl(ritzr), ndigit,
- & '_naupd: Real part of the final Ritz values')
- call dvout (logfil, np, workl(ritzi), ndigit,
- & '_naupd: Imaginary part of the final Ritz values')
- call dvout (logfil, np, workl(bounds), ndigit,
- & '_naupd: Associated Ritz estimates')
- end if
-c
- call arscnd (t1)
- tnaupd = t1 - t0
-c
- if (msglvl .gt. 0) then
-c
-c %--------------------------------------------------------%
-c | Version Number & Version Date are defined in version.h |
-c %--------------------------------------------------------%
-c
- write (6,1000)
- write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
- & tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
- & tgetv0, tneigh, tngets, tnapps, tnconv, trvec
- 1000 format (//,
- & 5x, '=============================================',/
- & 5x, '= Nonsymmetric implicit Arnoldi update code =',/
- & 5x, '= Version Number: ', ' 2.4' , 21x, ' =',/
- & 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/
- & 5x, '=============================================',/
- & 5x, '= Summary of timing statistics =',/
- & 5x, '=============================================',//)
- 1100 format (
- & 5x, 'Total number update iterations = ', i5,/
- & 5x, 'Total number of OP*x operations = ', i5,/
- & 5x, 'Total number of B*x operations = ', i5,/
- & 5x, 'Total number of reorthogonalization steps = ', i5,/
- & 5x, 'Total number of iterative refinement steps = ', i5,/
- & 5x, 'Total number of restart steps = ', i5,/
- & 5x, 'Total time in user OP*x operation = ', f12.6,/
- & 5x, 'Total time in user B*x operation = ', f12.6,/
- & 5x, 'Total time in Arnoldi update routine = ', f12.6,/
- & 5x, 'Total time in naup2 routine = ', f12.6,/
- & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
- & 5x, 'Total time in reorthogonalization phase = ', f12.6,/
- & 5x, 'Total time in (re)start vector generation = ', f12.6,/
- & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
- & 5x, 'Total time in getting the shifts = ', f12.6,/
- & 5x, 'Total time in applying the shifts = ', f12.6,/
- & 5x, 'Total time in convergence testing = ', f12.6,/
- & 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
- end if
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of dnaupd |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dnconv.f b/netlib/ARPACK/dnconv.f
deleted file mode 100644
index 4ab737d..0000000
--- a/netlib/ARPACK/dnconv.f
+++ /dev/null
@@ -1,146 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dnconv
-c
-c\Description:
-c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine.
-c
-c\Usage:
-c call dnconv
-c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Number of Ritz values to check for convergence.
-c
-c RITZR, Double precision arrays of length N. (INPUT)
-c RITZI Real and imaginary parts of the Ritz values to be checked
-c for convergence.
-
-c BOUNDS Double precision array of length N. (INPUT)
-c Ritz estimates for the Ritz values in RITZR and RITZI.
-c
-c TOL Double precision scalar. (INPUT)
-c Desired backward error for a Ritz value to be considered
-c "converged".
-c
-c NCONV Integer scalar. (OUTPUT)
-c Number of "converged" Ritz values.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c arscnd ARPACK utility routine for timing.
-c dlamch LAPACK routine that determines machine constants.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\Remarks
-c 1. xxxx
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dnconv (n, ritzr, ritzi, bounds, tol, nconv)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer n, nconv
- Double precision
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-
- Double precision
- & ritzr(n), ritzi(n), bounds(n)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i
- Double precision
- & temp, eps23
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlapy2, dlamch
- external dlapy2, dlamch
-
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------------------------------------%
-c | Convergence test: unlike in the symmetric code, I am not |
-c | using things like refined error bounds and gap condition |
-c | because I don't know the exact equivalent concept. |
-c | |
-c | Instead the i-th Ritz value is considered "converged" when: |
-c | |
-c | bounds(i) .le. ( TOL * | ritz | ) |
-c | |
-c | for some appropriate choice of norm. |
-c %-------------------------------------------------------------%
-c
- call arscnd (t0)
-c
-c %---------------------------------%
-c | Get machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = dlamch('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0)
-c
- nconv = 0
- do 20 i = 1, n
- temp = max( eps23, dlapy2( ritzr(i), ritzi(i) ) )
- if (bounds(i) .le. tol*temp) nconv = nconv + 1
- 20 continue
-c
- call arscnd (t1)
- tnconv = tnconv + (t1 - t0)
-c
- return
-c
-c %---------------%
-c | End of dnconv |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dneigh.f b/netlib/ARPACK/dneigh.f
deleted file mode 100644
index 5a85bdb..0000000
--- a/netlib/ARPACK/dneigh.f
+++ /dev/null
@@ -1,314 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dneigh
-c
-c\Description:
-c Compute the eigenvalues of the current upper Hessenberg matrix
-c and the corresponding Ritz estimates given the current residual norm.
-c
-c\Usage:
-c call dneigh
-c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
-c
-c\Arguments
-c RNORM Double precision scalar. (INPUT)
-c Residual norm corresponding to the current upper Hessenberg
-c matrix H.
-c
-c N Integer. (INPUT)
-c Size of the matrix H.
-c
-c H Double precision N by N array. (INPUT)
-c H contains the current upper Hessenberg matrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RITZR, Double precision arrays of length N. (OUTPUT)
-c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
-c (respectively imaginary) parts of the eigenvalues of H.
-c
-c BOUNDS Double precision array of length N. (OUTPUT)
-c On output, BOUNDS contains the Ritz estimates associated with
-c the eigenvalues RITZR and RITZI. This is equal to RNORM
-c times the last components of the eigenvectors corresponding
-c to the eigenvalues in RITZR and RITZI.
-c
-c Q Double precision N by N array. (WORKSPACE)
-c Workspace needed to store the eigenvectors of H.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Double precision work array of length N**2 + 3*N. (WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. This is needed to keep the full Schur form
-c of H and also in the calculation of the eigenvectors of H.
-c
-c IERR Integer. (OUTPUT)
-c Error exit flag from dlaqrb or dtrevc.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c dlaqrb ARPACK routine to compute the real Schur form of an
-c upper Hessenberg matrix and last row of the Schur vectors.
-c arscnd ARPACK utility routine for timing.
-c dmout ARPACK utility routine that prints matrices
-c dvout ARPACK utility routine that prints vectors.
-c dlacpy LAPACK matrix copy routine.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dtrevc LAPACK routine to compute the eigenvectors of a matrix
-c in upper quasi-triangular form
-c dgemv Level 2 BLAS routine for matrix vector multiplication.
-c dcopy Level 1 BLAS that copies one vector to another .
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dscal Level 1 BLAS that scales a vector.
-c
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\Remarks
-c None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds,
- & q, ldq, workl, ierr)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer ierr, n, ldh, ldq
- Double precision
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
- & workl(n*(n+3))
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- logical select(1)
- integer i, iconj, msglvl
- Double precision
- & temp, vl(1)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy, dlacpy, dlaqrb, dtrevc, dvout, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mneigh
-c
- if (msglvl .gt. 2) then
- call dmout (logfil, n, n, h, ldh, ndigit,
- & '_neigh: Entering upper Hessenberg matrix H ')
- end if
-c
-c %-----------------------------------------------------------%
-c | 1. Compute the eigenvalues, the last components of the |
-c | corresponding Schur vectors and the full Schur form T |
-c | of the current upper Hessenberg matrix H. |
-c | dlaqrb returns the full Schur form of H in WORKL(1:N**2) |
-c | and the last components of the Schur vectors in BOUNDS. |
-c %-----------------------------------------------------------%
-c
- call dlacpy ('All', n, n, h, ldh, workl, n)
- call dlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
- & ierr)
- if (ierr .ne. 0) go to 9000
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, n, bounds, ndigit,
- & '_neigh: last row of the Schur matrix for H')
- end if
-c
-c %-----------------------------------------------------------%
-c | 2. Compute the eigenvectors of the full Schur form T and |
-c | apply the last components of the Schur vectors to get |
-c | the last components of the corresponding eigenvectors. |
-c | Remember that if the i-th and (i+1)-st eigenvalues are |
-c | complex conjugate pairs, then the real & imaginary part |
-c | of the eigenvector components are split across adjacent |
-c | columns of Q. |
-c %-----------------------------------------------------------%
-c
- call dtrevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
- & n, n, workl(n*n+1), ierr)
-c
- if (ierr .ne. 0) go to 9000
-c
-c %------------------------------------------------%
-c | Scale the returning eigenvectors so that their |
-c | euclidean norms are all one. LAPACK subroutine |
-c | dtrevc returns each eigenvector normalized so |
-c | that the element of largest magnitude has |
-c | magnitude 1; here the magnitude of a complex |
-c | number (x,y) is taken to be |x| + |y|. |
-c %------------------------------------------------%
-c
- iconj = 0
- do 10 i=1, n
- if ( abs( ritzi(i) ) .le. zero ) then
-c
-c %----------------------%
-c | Real eigenvalue case |
-c %----------------------%
-c
- temp = dnrm2( n, q(1,i), 1 )
- call dscal ( n, one / temp, q(1,i), 1 )
- else
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c | columns, we further normalize by the |
-c | square root of two. |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- temp = dlapy2( dnrm2( n, q(1,i), 1 ),
- & dnrm2( n, q(1,i+1), 1 ) )
- call dscal ( n, one / temp, q(1,i), 1 )
- call dscal ( n, one / temp, q(1,i+1), 1 )
- iconj = 1
- else
- iconj = 0
- end if
- end if
- 10 continue
-c
- call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, n, workl, ndigit,
- & '_neigh: Last row of the eigenvector matrix for H')
- end if
-c
-c %----------------------------%
-c | Compute the Ritz estimates |
-c %----------------------------%
-c
- iconj = 0
- do 20 i = 1, n
- if ( abs( ritzi(i) ) .le. zero ) then
-c
-c %----------------------%
-c | Real eigenvalue case |
-c %----------------------%
-c
- bounds(i) = rnorm * abs( workl(i) )
- else
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c | columns, we need to take the magnitude |
-c | of the last components of the two vectors |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- bounds(i) = rnorm * dlapy2( workl(i), workl(i+1) )
- bounds(i+1) = bounds(i)
- iconj = 1
- else
- iconj = 0
- end if
- end if
- 20 continue
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, n, ritzr, ndigit,
- & '_neigh: Real part of the eigenvalues of H')
- call dvout (logfil, n, ritzi, ndigit,
- & '_neigh: Imaginary part of the eigenvalues of H')
- call dvout (logfil, n, bounds, ndigit,
- & '_neigh: Ritz estimates for the eigenvalues of H')
- end if
-c
- call arscnd (t1)
- tneigh = tneigh + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dneigh |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dneupd.f b/netlib/ARPACK/dneupd.f
deleted file mode 100644
index b5c6d63..0000000
--- a/netlib/ARPACK/dneupd.f
+++ /dev/null
@@ -1,1068 +0,0 @@
-c\BeginDoc
-c
-c\Name: dneupd
-c
-c\Description:
-c
-c This subroutine returns the converged approximations to eigenvalues
-c of A*z = lambda*B*z and (optionally):
-c
-c (1) The corresponding approximate eigenvectors;
-c
-c (2) An orthonormal basis for the associated approximate
-c invariant subspace;
-c
-c (3) Both.
-c
-c There is negligible additional cost to obtain eigenvectors. An orthonormal
-c basis is always computed. There is an additional storage cost of n*nev
-c if both are requested (in this case a separate array Z must be supplied).
-c
-c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
-c are derived from approximate eigenvalues and eigenvectors of
-c of the linear operator OP prescribed by the MODE selection in the
-c call to DNAUPD . DNAUPD must be called before this routine is called.
-c These approximate eigenvalues and vectors are commonly called Ritz
-c values and Ritz vectors respectively. They are referred to as such
-c in the comments that follow. The computed orthonormal basis for the
-c invariant subspace corresponding to these Ritz values is referred to as a
-c Schur basis.
-c
-c See documentation in the header of the subroutine DNAUPD for
-c definition of OP as well as other terms and the relation of computed
-c Ritz values and Ritz vectors of OP with respect to the given problem
-c A*z = lambda*B*z. For a brief description, see definitions of
-c IPARAM(7), MODE and WHICH in the documentation of DNAUPD .
-c
-c\Usage:
-c call dneupd
-c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT,
-c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL,
-c LWORKL, INFO )
-c
-c\Arguments:
-c RVEC LOGICAL (INPUT)
-c Specifies whether a basis for the invariant subspace corresponding
-c to the converged Ritz value approximations for the eigenproblem
-c A*z = lambda*B*z is computed.
-c
-c RVEC = .FALSE. Compute Ritz values only.
-c
-c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
-c See Remarks below.
-c
-c HOWMNY Character*1 (INPUT)
-c Specifies the form of the basis for the invariant subspace
-c corresponding to the converged Ritz values that is to be computed.
-c
-c = 'A': Compute NEV Ritz vectors;
-c = 'P': Compute NEV Schur vectors;
-c = 'S': compute some of the Ritz vectors, specified
-c by the logical array SELECT.
-c
-c SELECT Logical array of dimension NCV. (INPUT)
-c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
-c computed. To select the Ritz vector corresponding to a
-c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE..
-c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace.
-c
-c DR Double precision array of dimension NEV+1. (OUTPUT)
-c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains
-c the real part of the Ritz approximations to the eigenvalues of
-c A*z = lambda*B*z.
-c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit:
-c DR contains the real part of the Ritz values of OP computed by
-c DNAUPD . A further computation must be performed by the user
-c to transform the Ritz values computed for OP by DNAUPD to those
-c of the original system A*z = lambda*B*z. See remark 3 below.
-c
-c DI Double precision array of dimension NEV+1. (OUTPUT)
-c On exit, DI contains the imaginary part of the Ritz value
-c approximations to the eigenvalues of A*z = lambda*B*z associated
-c with DR.
-c
-c NOTE: When Ritz values are complex, they will come in complex
-c conjugate pairs. If eigenvectors are requested, the
-c corresponding Ritz vectors will also come in conjugate
-c pairs and the real and imaginary parts of these are
-c represented in two consecutive columns of the array Z
-c (see below).
-c
-c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT)
-c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of
-c Z represent approximate eigenvectors (Ritz vectors) corresponding
-c to the NCONV=IPARAM(5) Ritz values for eigensystem
-c A*z = lambda*B*z.
-c
-c The complex Ritz vector associated with the Ritz value
-c with positive imaginary part is stored in two consecutive
-c columns. The first column holds the real part of the Ritz
-c vector and the second column holds the imaginary part. The
-c Ritz vector associated with the Ritz value with negative
-c imaginary part is simply the complex conjugate of the Ritz vector
-c associated with the positive imaginary part.
-c
-c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced.
-c
-c NOTE: If if RVEC = .TRUE. and a Schur basis is not required,
-c the array Z may be set equal to first NEV+1 columns of the Arnoldi
-c basis array V computed by DNAUPD . In this case the Arnoldi basis
-c will be destroyed and overwritten with the eigenvector basis.
-c
-c LDZ Integer. (INPUT)
-c The leading dimension of the array Z. If Ritz vectors are
-c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1.
-c
-c SIGMAR Double precision (INPUT)
-c If IPARAM(7) = 3 or 4, represents the real part of the shift.
-c Not referenced if IPARAM(7) = 1 or 2.
-c
-c SIGMAI Double precision (INPUT)
-c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift.
-c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below.
-c
-c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE)
-c
-c **** The remaining arguments MUST be the same as for the ****
-c **** call to DNAUPD that was just completed. ****
-c
-c NOTE: The remaining arguments
-c
-c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR,
-c WORKD, WORKL, LWORKL, INFO
-c
-c must be passed directly to DNEUPD following the last call
-c to DNAUPD . These arguments MUST NOT BE MODIFIED between
-c the the last call to DNAUPD and the call to DNEUPD .
-c
-c Three of these parameters (V, WORKL, INFO) are also output parameters:
-c
-c V Double precision N by NCV array. (INPUT/OUTPUT)
-c
-c Upon INPUT: the NCV columns of V contain the Arnoldi basis
-c vectors for OP as constructed by DNAUPD .
-c
-c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
-c contain approximate Schur vectors that span the
-c desired invariant subspace. See Remark 2 below.
-c
-c NOTE: If the array Z has been set equal to first NEV+1 columns
-c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
-c Arnoldi basis held by V has been overwritten by the desired
-c Ritz vectors. If a separate array Z has been passed then
-c the first NCONV=IPARAM(5) columns of V will contain approximate
-c Schur vectors that span the desired invariant subspace.
-c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
-c WORKL(1:ncv*ncv+3*ncv) contains information obtained in
-c dnaupd . They are not changed by dneupd .
-c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the
-c real and imaginary part of the untransformed Ritz values,
-c the upper quasi-triangular matrix for H, and the
-c associated matrix representation of the invariant subspace for H.
-c
-c Note: IPNTR(9:13) contains the pointer into WORKL for addresses
-c of the above information computed by dneupd .
-c -------------------------------------------------------------
-c IPNTR(9): pointer to the real part of the NCV RITZ values of the
-c original system.
-c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
-c the original system.
-c IPNTR(11): pointer to the NCV corresponding error bounds.
-c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular
-c Schur matrix for H.
-c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors
-c of the upper Hessenberg matrix H. Only referenced by
-c dneupd if RVEC = .TRUE. See Remark 2 below.
-c -------------------------------------------------------------
-c
-c INFO Integer. (OUTPUT)
-c Error flag on output.
-c
-c = 0: Normal exit.
-c
-c = 1: The Schur form computed by LAPACK routine dlahqr
-c could not be reordered by LAPACK routine dtrsen .
-c Re-enter subroutine dneupd with IPARAM(5)=NCV and
-c increase the size of the arrays DR and DI to have
-c dimension at least dimension NCV and allocate at least NCV
-c columns for Z. NOTE: Not necessary if Z and V share
-c the same space. Please notify the authors if this error
-c occurs.
-c
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
-c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work WORKL array is not sufficient.
-c = -8: Error return from calculation of a real Schur form.
-c Informational error from LAPACK routine dlahqr .
-c = -9: Error return from calculation of eigenvectors.
-c Informational error from LAPACK routine dtrevc .
-c = -10: IPARAM(7) must be 1,2,3,4.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
-c = -12: HOWMNY = 'S' not yet implemented
-c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
-c = -14: DNAUPD did not find any eigenvalues to sufficient
-c accuracy.
-c = -15: DNEUPD got a different count of the number of converged
-c Ritz values than DNAUPD got. This indicates the user
-c probably made an error in passing data from DNAUPD to
-c DNEUPD or that the data was modified before entering
-c DNEUPD
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
-c Real Matrices", Linear Algebra and its Applications, vol 88/89,
-c pp 575-595, (1987).
-c
-c\Routines called:
-c ivout ARPACK utility routine that prints integers.
-c dmout ARPACK utility routine that prints matrices
-c dvout ARPACK utility routine that prints vectors.
-c dgeqr2 LAPACK routine that computes the QR factorization of
-c a matrix.
-c dlacpy LAPACK matrix copy routine.
-c dlahqr LAPACK routine to compute the real Schur form of an
-c upper Hessenberg matrix.
-c dlamch LAPACK routine that determines machine constants.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK matrix initialization routine.
-c dorm2r LAPACK routine that applies an orthogonal matrix in
-c factored form.
-c dtrevc LAPACK routine to compute the eigenvectors of a matrix
-c in upper quasi-triangular form.
-c dtrsen LAPACK routine that re-orders the Schur form.
-c dtrmm Level 3 BLAS matrix times an upper triangular matrix.
-c dger Level 2 BLAS rank one update to a matrix.
-c dcopy Level 1 BLAS that copies one vector to another .
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dscal Level 1 BLAS that scales a vector.
-c
-c\Remarks
-c
-c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
-c
-c Let trans(X) denote the transpose of X.
-c
-c 2. Schur vectors are an orthogonal representation for the basis of
-c Ritz vectors. Thus, their numerical properties are often superior.
-c If RVEC = .TRUE. then the relationship
-c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and
-c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately
-c satisfied. Here T is the leading submatrix of order IPARAM(5) of the
-c real upper quasi-triangular matrix stored workl(ipntr(12)). That is,
-c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
-c each 2-by-2 diagonal block has its diagonal elements equal and its
-c off-diagonal elements of opposite sign. Corresponding to each 2-by-2
-c diagonal block is a complex conjugate pair of Ritz values. The real
-c Ritz values are stored on the diagonal of T.
-c
-c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must
-c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz
-c values computed by DNAUPD for OP to those of A*z = lambda*B*z.
-c Set RVEC = .true. and HOWMNY = 'A', and
-c compute
-c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0.
-c If DI(I) is not equal to zero and DI(I+1) = - D(I),
-c then the desired real and imaginary parts of the Ritz value are
-c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1),
-c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I),
-c respectively.
-c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and
-c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper
-c quasi-triangular matrix of order IPARAM(5) is computed. See remark
-c 2 above.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Chao Yang Houston, Texas
-c Dept. of Computational &
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
- subroutine dneupd (rvec , howmny, select, dr , di,
- & z , ldz , sigmar, sigmai, workev,
- & bmat , n , which , nev , tol,
- & resid, ncv , v , ldv , iparam,
- & ipntr, workd , workl , lworkl, info)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat, howmny, which*2
- logical rvec
- integer info, ldz, ldv, lworkl, n, ncv, nev
- Double precision
- & sigmar, sigmai, tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(11), ipntr(14)
- logical select(ncv)
- Double precision
- & dr(nev+1) , di(nev+1), resid(n) ,
- & v(ldv,ncv) , z(ldz,*) , workd(3*n),
- & workl(lworkl), workev(3*ncv)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0 , zero = 0.0D+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character type*6
- integer bounds, ierr , ih , ihbds ,
- & iheigr, iheigi, iconj , nconv ,
- & invsub, iuptri, iwev , iwork(1),
- & j , k , ldh , ldq ,
- & mode , msglvl, outncv, ritzr ,
- & ritzi , wri , wrr , irr ,
- & iri , ibd , ishift, numcnv ,
- & np , jj , nconv2
- logical reord
- Double precision
- & conds , rnorm, sep , temp,
- & vl(1,1), temp1, eps23
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy , dger , dgeqr2 , dlacpy ,
- & dlahqr , dlaset , dmout , dorm2r ,
- & dtrevc , dtrmm , dtrsen , dscal ,
- & dvout , ivout
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlapy2 , dnrm2 , dlamch , ddot
- external dlapy2 , dnrm2 , dlamch , ddot
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs, min, sqrt
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- msglvl = mneupd
- mode = iparam(7)
- nconv = iparam(5)
- info = 0
-c
-c %---------------------------------%
-c | Get machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = dlamch ('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0 )
-c
-c %--------------%
-c | Quick return |
-c %--------------%
-c
- ierr = 0
-c
- if (nconv .le. 0) then
- ierr = -14
- else if (n .le. 0) then
- ierr = -1
- else if (nev .le. 0) then
- ierr = -2
- else if (ncv .le. nev+1 .or. ncv .gt. n) then
- ierr = -3
- else if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LR' .and.
- & which .ne. 'SR' .and.
- & which .ne. 'LI' .and.
- & which .ne. 'SI') then
- ierr = -5
- else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
- ierr = -6
- else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
- ierr = -7
- else if ( (howmny .ne. 'A' .and.
- & howmny .ne. 'P' .and.
- & howmny .ne. 'S') .and. rvec ) then
- ierr = -13
- else if (howmny .eq. 'S' ) then
- ierr = -12
- end if
-c
- if (mode .eq. 1 .or. mode .eq. 2) then
- type = 'REGULR'
- else if (mode .eq. 3 .and. sigmai .eq. zero) then
- type = 'SHIFTI'
- else if (mode .eq. 3 ) then
- type = 'REALPT'
- else if (mode .eq. 4 ) then
- type = 'IMAGPT'
- else
- ierr = -10
- end if
- if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- go to 9000
- end if
-c
-c %--------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:ncv*ncv) := generated Hessenberg matrix |
-c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
-c | parts of ritz values |
-c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
-c %--------------------------------------------------------%
-c
-c %-----------------------------------------------------------%
-c | The following is used and set by DNEUPD . |
-c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed |
-c | real part of the Ritz values. |
-c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed |
-c | imaginary part of the Ritz values. |
-c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
-c | error bounds of the Ritz values |
-c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
-c | quasi-triangular matrix for H |
-c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
-c | associated matrix representation of the invariant |
-c | subspace for H. |
-c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
-c %-----------------------------------------------------------%
-c
- ih = ipntr(5)
- ritzr = ipntr(6)
- ritzi = ipntr(7)
- bounds = ipntr(8)
- ldh = ncv
- ldq = ncv
- iheigr = bounds + ldh
- iheigi = iheigr + ldh
- ihbds = iheigi + ldh
- iuptri = ihbds + ldh
- invsub = iuptri + ldh*ncv
- ipntr(9) = iheigr
- ipntr(10) = iheigi
- ipntr(11) = ihbds
- ipntr(12) = iuptri
- ipntr(13) = invsub
- wrr = 1
- wri = ncv + 1
- iwev = wri + ncv
-c
-c %-----------------------------------------%
-c | irr points to the REAL part of the Ritz |
-c | values computed by _neigh before |
-c | exiting _naup2. |
-c | iri points to the IMAGINARY part of the |
-c | Ritz values computed by _neigh |
-c | before exiting _naup2. |
-c | ibd points to the Ritz estimates |
-c | computed by _neigh before exiting |
-c | _naup2. |
-c %-----------------------------------------%
-c
- irr = ipntr(14)+ncv*ncv
- iri = irr+ncv
- ibd = iri+ncv
-c
-c %------------------------------------%
-c | RNORM is B-norm of the RESID(1:N). |
-c %------------------------------------%
-c
- rnorm = workl(ih+2)
- workl(ih+2) = zero
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(irr), ndigit,
- & '_neupd: Real part of Ritz values passed in from _NAUPD.')
- call dvout (logfil, ncv, workl(iri), ndigit,
- & '_neupd: Imag part of Ritz values passed in from _NAUPD.')
- call dvout (logfil, ncv, workl(ibd), ndigit,
- & '_neupd: Ritz estimates passed in from _NAUPD.')
- end if
-c
- if (rvec) then
-c
- reord = .false.
-c
-c %---------------------------------------------------%
-c | Use the temporary bounds array to store indices |
-c | These will be used to mark the select array later |
-c %---------------------------------------------------%
-c
- do 10 j = 1,ncv
- workl(bounds+j-1) = j
- select(j) = .false.
- 10 continue
-c
-c %-------------------------------------%
-c | Select the wanted Ritz values. |
-c | Sort the Ritz values so that the |
-c | wanted ones appear at the tailing |
-c | NEV positions of workl(irr) and |
-c | workl(iri). Move the corresponding |
-c | error estimates in workl(bound) |
-c | accordingly. |
-c %-------------------------------------%
-c
- np = ncv - nev
- ishift = 0
- call dngets (ishift , which , nev ,
- & np , workl(irr), workl(iri),
- & workl(bounds), workl , workl(np+1))
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(irr), ndigit,
- & '_neupd: Real part of Ritz values after calling _NGETS.')
- call dvout (logfil, ncv, workl(iri), ndigit,
- & '_neupd: Imag part of Ritz values after calling _NGETS.')
- call dvout (logfil, ncv, workl(bounds), ndigit,
- & '_neupd: Ritz value indices after calling _NGETS.')
- end if
-c
-c %-----------------------------------------------------%
-c | Record indices of the converged wanted Ritz values |
-c | Mark the select array for possible reordering |
-c %-----------------------------------------------------%
-c
- numcnv = 0
- do 11 j = 1,ncv
- temp1 = max(eps23,
- & dlapy2 ( workl(irr+ncv-j), workl(iri+ncv-j) ))
- jj = workl(bounds + ncv - j)
- if (numcnv .lt. nconv .and.
- & workl(ibd+jj-1) .le. tol*temp1) then
- select(jj) = .true.
- numcnv = numcnv + 1
- if (jj .gt. nconv) reord = .true.
- endif
- 11 continue
-c
-c %-----------------------------------------------------------%
-c | Check the count (numcnv) of converged Ritz values with |
-c | the number (nconv) reported by dnaupd. If these two |
-c | are different then there has probably been an error |
-c | caused by incorrect passing of the dnaupd data. |
-c %-----------------------------------------------------------%
-c
- if (msglvl .gt. 2) then
- call ivout(logfil, 1, numcnv, ndigit,
- & '_neupd: Number of specified eigenvalues')
- call ivout(logfil, 1, nconv, ndigit,
- & '_neupd: Number of "converged" eigenvalues')
- end if
-c
- if (numcnv .ne. nconv) then
- info = -15
- go to 9000
- end if
-c
-c %-----------------------------------------------------------%
-c | Call LAPACK routine dlahqr to compute the real Schur form |
-c | of the upper Hessenberg matrix returned by DNAUPD . |
-c | Make a copy of the upper Hessenberg matrix. |
-c | Initialize the Schur vector matrix Q to the identity. |
-c %-----------------------------------------------------------%
-c
- call dcopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1)
- call dlaset ('All', ncv, ncv,
- & zero , one, workl(invsub),
- & ldq)
- call dlahqr (.true., .true. , ncv,
- & 1 , ncv , workl(iuptri),
- & ldh , workl(iheigr), workl(iheigi),
- & 1 , ncv , workl(invsub),
- & ldq , ierr)
- call dcopy (ncv , workl(invsub+ncv-1), ldq,
- & workl(ihbds), 1)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 9000
- end if
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, ncv, workl(iheigr), ndigit,
- & '_neupd: Real part of the eigenvalues of H')
- call dvout (logfil, ncv, workl(iheigi), ndigit,
- & '_neupd: Imaginary part of the Eigenvalues of H')
- call dvout (logfil, ncv, workl(ihbds), ndigit,
- & '_neupd: Last row of the Schur vector matrix')
- if (msglvl .gt. 3) then
- call dmout (logfil , ncv, ncv ,
- & workl(iuptri), ldh, ndigit,
- & '_neupd: The upper quasi-triangular matrix ')
- end if
- end if
-c
- if (reord) then
-c
-c %-----------------------------------------------------%
-c | Reorder the computed upper quasi-triangular matrix. |
-c %-----------------------------------------------------%
-c
- call dtrsen ('None' , 'V' ,
- & select , ncv ,
- & workl(iuptri), ldh ,
- & workl(invsub), ldq ,
- & workl(iheigr), workl(iheigi),
- & nconv2 , conds ,
- & sep , workl(ihbds) ,
- & ncv , iwork ,
- & 1 , ierr)
-c
- if (nconv2 .lt. nconv) then
- nconv = nconv2
- end if
-
- if (ierr .eq. 1) then
- info = 1
- go to 9000
- end if
-c
-
- if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(iheigr), ndigit,
- & '_neupd: Real part of the eigenvalues of H--reordered')
- call dvout (logfil, ncv, workl(iheigi), ndigit,
- & '_neupd: Imag part of the eigenvalues of H--reordered')
- if (msglvl .gt. 3) then
- call dmout (logfil , ncv, ncv ,
- & workl(iuptri), ldq, ndigit,
- & '_neupd: Quasi-triangular matrix after re-ordering')
- end if
- end if
-c
- end if
-c
-c %---------------------------------------%
-c | Copy the last row of the Schur vector |
-c | into workl(ihbds). This will be used |
-c | to compute the Ritz estimates of |
-c | converged Ritz values. |
-c %---------------------------------------%
-c
- call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
-c
-c %----------------------------------------------------%
-c | Place the computed eigenvalues of H into DR and DI |
-c | if a spectral transformation was not used. |
-c %----------------------------------------------------%
-c
- if (type .eq. 'REGULR') then
- call dcopy (nconv, workl(iheigr), 1, dr, 1)
- call dcopy (nconv, workl(iheigi), 1, di, 1)
- end if
-c
-c %----------------------------------------------------------%
-c | Compute the QR factorization of the matrix representing |
-c | the wanted invariant subspace located in the first NCONV |
-c | columns of workl(invsub,ldq). |
-c %----------------------------------------------------------%
-c
- call dgeqr2 (ncv, nconv , workl(invsub),
- & ldq, workev, workev(ncv+1),
- & ierr)
-c
-c %---------------------------------------------------------%
-c | * Postmultiply V by Q using dorm2r . |
-c | * Copy the first NCONV columns of VQ into Z. |
-c | * Postmultiply Z by R. |
-c | The N by NCONV matrix Z is now a matrix representation |
-c | of the approximate invariant subspace associated with |
-c | the Ritz values in workl(iheigr) and workl(iheigi) |
-c | The first NCONV columns of V are now approximate Schur |
-c | vectors associated with the real upper quasi-triangular |
-c | matrix of order NCONV in workl(iuptri) |
-c %---------------------------------------------------------%
-c
- call dorm2r ('Right', 'Notranspose', n ,
- & ncv , nconv , workl(invsub),
- & ldq , workev , v ,
- & ldv , workd(n+1) , ierr)
- call dlacpy ('All', n, nconv, v, ldv, z, ldz)
-c
- do 20 j=1, nconv
-c
-c %---------------------------------------------------%
-c | Perform both a column and row scaling if the |
-c | diagonal element of workl(invsub,ldq) is negative |
-c | I'm lazy and don't take advantage of the upper |
-c | quasi-triangular form of workl(iuptri,ldq) |
-c | Note that since Q is orthogonal, R is a diagonal |
-c | matrix consisting of plus or minus ones |
-c %---------------------------------------------------%
-c
- if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then
- call dscal (nconv, -one, workl(iuptri+j-1), ldq)
- call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
- end if
-c
- 20 continue
-c
- if (howmny .eq. 'A') then
-c
-c %--------------------------------------------%
-c | Compute the NCONV wanted eigenvectors of T |
-c | located in workl(iuptri,ldq). |
-c %--------------------------------------------%
-c
- do 30 j=1, ncv
- if (j .le. nconv) then
- select(j) = .true.
- else
- select(j) = .false.
- end if
- 30 continue
-c
- call dtrevc ('Right', 'Select' , select ,
- & ncv , workl(iuptri), ldq ,
- & vl , 1 , workl(invsub),
- & ldq , ncv , outncv ,
- & workev , ierr)
-c
- if (ierr .ne. 0) then
- info = -9
- go to 9000
- end if
-c
-c %------------------------------------------------%
-c | Scale the returning eigenvectors so that their |
-c | Euclidean norms are all one. LAPACK subroutine |
-c | dtrevc returns each eigenvector normalized so |
-c | that the element of largest magnitude has |
-c | magnitude 1; |
-c %------------------------------------------------%
-c
- iconj = 0
- do 40 j=1, nconv
-c
- if ( workl(iheigi+j-1) .eq. zero ) then
-c
-c %----------------------%
-c | real eigenvalue case |
-c %----------------------%
-c
- temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 )
- call dscal ( ncv, one / temp,
- & workl(invsub+(j-1)*ldq), 1 )
-c
- else
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c | columns, we further normalize by the |
-c | square root of two. |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- temp = dlapy2 (dnrm2 (ncv,
- & workl(invsub+(j-1)*ldq),
- & 1),
- & dnrm2 (ncv,
- & workl(invsub+j*ldq),
- & 1))
- call dscal (ncv, one/temp,
- & workl(invsub+(j-1)*ldq), 1 )
- call dscal (ncv, one/temp,
- & workl(invsub+j*ldq), 1 )
- iconj = 1
- else
- iconj = 0
- end if
-c
- end if
-c
- 40 continue
-c
- call dgemv ('T', ncv, nconv, one, workl(invsub),
- & ldq, workl(ihbds), 1, zero, workev, 1)
-c
- iconj = 0
- do 45 j=1, nconv
- if (workl(iheigi+j-1) .ne. zero) then
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- workev(j) = dlapy2 (workev(j), workev(j+1))
- workev(j+1) = workev(j)
- iconj = 1
- else
- iconj = 0
- end if
- end if
- 45 continue
-c
- if (msglvl .gt. 2) then
- call dcopy (ncv, workl(invsub+ncv-1), ldq,
- & workl(ihbds), 1)
- call dvout (logfil, ncv, workl(ihbds), ndigit,
- & '_neupd: Last row of the eigenvector matrix for T')
- if (msglvl .gt. 3) then
- call dmout (logfil, ncv, ncv, workl(invsub), ldq,
- & ndigit, '_neupd: The eigenvector matrix for T')
- end if
- end if
-c
-c %---------------------------------------%
-c | Copy Ritz estimates into workl(ihbds) |
-c %---------------------------------------%
-c
- call dcopy (nconv, workev, 1, workl(ihbds), 1)
-c
-c %---------------------------------------------------------%
-c | Compute the QR factorization of the eigenvector matrix |
-c | associated with leading portion of T in the first NCONV |
-c | columns of workl(invsub,ldq). |
-c %---------------------------------------------------------%
-c
- call dgeqr2 (ncv, nconv , workl(invsub),
- & ldq, workev, workev(ncv+1),
- & ierr)
-c
-c %----------------------------------------------%
-c | * Postmultiply Z by Q. |
-c | * Postmultiply Z by R. |
-c | The N by NCONV matrix Z is now contains the |
-c | Ritz vectors associated with the Ritz values |
-c | in workl(iheigr) and workl(iheigi). |
-c %----------------------------------------------%
-c
- call dorm2r ('Right', 'Notranspose', n ,
- & ncv , nconv , workl(invsub),
- & ldq , workev , z ,
- & ldz , workd(n+1) , ierr)
-c
- call dtrmm ('Right' , 'Upper' , 'No transpose',
- & 'Non-unit', n , nconv ,
- & one , workl(invsub), ldq ,
- & z , ldz)
-c
- end if
-c
- else
-c
-c %------------------------------------------------------%
-c | An approximate invariant subspace is not needed. |
-c | Place the Ritz values computed DNAUPD into DR and DI |
-c %------------------------------------------------------%
-c
- call dcopy (nconv, workl(ritzr), 1, dr, 1)
- call dcopy (nconv, workl(ritzi), 1, di, 1)
- call dcopy (nconv, workl(ritzr), 1, workl(iheigr), 1)
- call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1)
- call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1)
- end if
-c
-c %------------------------------------------------%
-c | Transform the Ritz values and possibly vectors |
-c | and corresponding error bounds of OP to those |
-c | of A*x = lambda*B*x. |
-c %------------------------------------------------%
-c
- if (type .eq. 'REGULR') then
-c
- if (rvec)
- & call dscal (ncv, rnorm, workl(ihbds), 1)
-c
- else
-c
-c %---------------------------------------%
-c | A spectral transformation was used. |
-c | * Determine the Ritz estimates of the |
-c | Ritz values in the original system. |
-c %---------------------------------------%
-c
- if (type .eq. 'SHIFTI') then
-c
- if (rvec)
- & call dscal (ncv, rnorm, workl(ihbds), 1)
-c
- do 50 k=1, ncv
- temp = dlapy2 ( workl(iheigr+k-1),
- & workl(iheigi+k-1) )
- workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
- & / temp / temp
- 50 continue
-c
- else if (type .eq. 'REALPT') then
-c
- do 60 k=1, ncv
- 60 continue
-c
- else if (type .eq. 'IMAGPT') then
-c
- do 70 k=1, ncv
- 70 continue
-c
- end if
-c
-c %-----------------------------------------------------------%
-c | * Transform the Ritz values back to the original system. |
-c | For TYPE = 'SHIFTI' the transformation is |
-c | lambda = 1/theta + sigma |
-c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
-c | Rayleigh quotients or a projection. See remark 3 above.|
-c | NOTES: |
-c | *The Ritz vectors are not affected by the transformation. |
-c %-----------------------------------------------------------%
-c
- if (type .eq. 'SHIFTI') then
-c
- do 80 k=1, ncv
- temp = dlapy2 ( workl(iheigr+k-1),
- & workl(iheigi+k-1) )
- workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp
- & + sigmar
- workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp
- & + sigmai
- 80 continue
-c
- call dcopy (nconv, workl(iheigr), 1, dr, 1)
- call dcopy (nconv, workl(iheigi), 1, di, 1)
-c
- else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then
-c
- call dcopy (nconv, workl(iheigr), 1, dr, 1)
- call dcopy (nconv, workl(iheigi), 1, di, 1)
-c
- end if
-c
- end if
-c
- if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
- call dvout (logfil, nconv, dr, ndigit,
- & '_neupd: Untransformed real part of the Ritz valuess.')
- call dvout (logfil, nconv, di, ndigit,
- & '_neupd: Untransformed imag part of the Ritz valuess.')
- call dvout (logfil, nconv, workl(ihbds), ndigit,
- & '_neupd: Ritz estimates of untransformed Ritz values.')
- else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
- call dvout (logfil, nconv, dr, ndigit,
- & '_neupd: Real parts of converged Ritz values.')
- call dvout (logfil, nconv, di, ndigit,
- & '_neupd: Imag parts of converged Ritz values.')
- call dvout (logfil, nconv, workl(ihbds), ndigit,
- & '_neupd: Associated Ritz estimates.')
- end if
-c
-c %-------------------------------------------------%
-c | Eigenvector Purification step. Formally perform |
-c | one of inverse subspace iteration. Only used |
-c | for MODE = 2. |
-c %-------------------------------------------------%
-c
- if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
-c
-c %------------------------------------------------%
-c | Purify the computed Ritz vectors by adding a |
-c | little bit of the residual vector: |
-c | T |
-c | resid(:)*( e s ) / theta |
-c | NCV |
-c | where H s = s theta. Remember that when theta |
-c | has nonzero imaginary part, the corresponding |
-c | Ritz vector is stored across two columns of Z. |
-c %------------------------------------------------%
-c
- iconj = 0
- do 110 j=1, nconv
- if (workl(iheigi+j-1) .eq. zero) then
- workev(j) = workl(invsub+(j-1)*ldq+ncv-1) /
- & workl(iheigr+j-1)
- else if (iconj .eq. 0) then
- temp = dlapy2 ( workl(iheigr+j-1), workl(iheigi+j-1) )
- workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) *
- & workl(iheigr+j-1) +
- & workl(invsub+j*ldq+ncv-1) *
- & workl(iheigi+j-1) ) / temp / temp
- workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
- & workl(iheigr+j-1) -
- & workl(invsub+(j-1)*ldq+ncv-1) *
- & workl(iheigi+j-1) ) / temp / temp
- iconj = 1
- else
- iconj = 0
- end if
- 110 continue
-c
-c %---------------------------------------%
-c | Perform a rank one update to Z and |
-c | purify all the Ritz vectors together. |
-c %---------------------------------------%
-c
- call dger (n, nconv, one, resid, 1, workev, 1, z, ldz)
-c
- end if
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of DNEUPD |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dngets.f b/netlib/ARPACK/dngets.f
deleted file mode 100644
index 4c93a6d..0000000
--- a/netlib/ARPACK/dngets.f
+++ /dev/null
@@ -1,231 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dngets
-c
-c\Description:
-c Given the eigenvalues of the upper Hessenberg matrix H,
-c computes the NP shifts AMU that are zeros of the polynomial of
-c degree NP which filters out components of the unwanted eigenvectors
-c corresponding to the AMU's based on some given criteria.
-c
-c NOTE: call this even in the case of user specified shifts in order
-c to sort the eigenvalues, and error bounds of H for later use.
-c
-c\Usage:
-c call dngets
-c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
-c
-c\Arguments
-c ISHIFT Integer. (INPUT)
-c Method for selecting the implicit shifts at each iteration.
-c ISHIFT = 0: user specified shifts
-c ISHIFT = 1: exact shift with respect to the matrix H.
-c
-c WHICH Character*2. (INPUT)
-c Shift selection criteria.
-c 'LM' -> want the KEV eigenvalues of largest magnitude.
-c 'SM' -> want the KEV eigenvalues of smallest magnitude.
-c 'LR' -> want the KEV eigenvalues of largest real part.
-c 'SR' -> want the KEV eigenvalues of smallest real part.
-c 'LI' -> want the KEV eigenvalues of largest imaginary part.
-c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
-c
-c KEV Integer. (INPUT/OUTPUT)
-c INPUT: KEV+NP is the size of the matrix H.
-c OUTPUT: Possibly increases KEV by one to keep complex conjugate
-c pairs together.
-c
-c NP Integer. (INPUT/OUTPUT)
-c Number of implicit shifts to be computed.
-c OUTPUT: Possibly decreases NP by one to keep complex conjugate
-c pairs together.
-c
-c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT)
-c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
-c parts of the eigenvalues of H.
-c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
-c eigenvalues are in the first NP locations and the wanted
-c portion is in the last KEV locations. When exact shifts are
-c selected, the unwanted part corresponds to the shifts to
-c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
-c are further sorted so that the ones with largest Ritz values
-c are first.
-c
-c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
-c Error bounds corresponding to the ordering in RITZ.
-c
-c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
-c
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c dsortc ARPACK sorting routine.
-c dcopy Level 1 BLAS that copies one vector to another .
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\Remarks
-c 1. xxxx
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dngets ( ishift, which, kev, np, ritzr, ritzi, bounds,
- & shiftr, shifti )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- integer ishift, kev, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
- & shiftr(1), shifti(1)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0, zero = 0.0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer msglvl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy, dsortc, arscnd
-c
-c %----------------------%
-c | Intrinsics Functions |
-c %----------------------%
-c
- intrinsic abs
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mngets
-c
-c %----------------------------------------------------%
-c | LM, SM, LR, SR, LI, SI case. |
-c | Sort the eigenvalues of H into the desired order |
-c | and apply the resulting order to BOUNDS. |
-c | The eigenvalues are sorted so that the wanted part |
-c | are always in the last KEV locations. |
-c | We first do a pre-processing sort in order to keep |
-c | complex conjugate pairs together |
-c %----------------------------------------------------%
-c
- if (which .eq. 'LM') then
- call dsortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'SM') then
- call dsortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'LR') then
- call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'SR') then
- call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'LI') then
- call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'SI') then
- call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
- end if
-c
- call dsortc (which, .true., kev+np, ritzr, ritzi, bounds)
-c
-c %-------------------------------------------------------%
-c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
-c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
-c | Accordingly decrease NP by one. In other words keep |
-c | complex conjugate pairs together. |
-c %-------------------------------------------------------%
-c
- if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
- & .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
- np = np - 1
- kev = kev + 1
- end if
-c
- if ( ishift .eq. 1 ) then
-c
-c %-------------------------------------------------------%
-c | Sort the unwanted Ritz values used as shifts so that |
-c | the ones with largest Ritz estimates are first |
-c | This will tend to minimize the effects of the |
-c | forward instability of the iteration when they shifts |
-c | are applied in subroutine dnapps. |
-c | Be careful and use 'SR' since we want to sort BOUNDS! |
-c %-------------------------------------------------------%
-c
- call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi )
- end if
-c
- call arscnd (t1)
- tngets = tngets + (t1 - t0)
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is')
- call ivout (logfil, 1, np, ndigit, '_ngets: NP is')
- call dvout (logfil, kev+np, ritzr, ndigit,
- & '_ngets: Eigenvalues of current H matrix -- real part')
- call dvout (logfil, kev+np, ritzi, ndigit,
- & '_ngets: Eigenvalues of current H matrix -- imag part')
- call dvout (logfil, kev+np, bounds, ndigit,
- & '_ngets: Ritz estimates of the current KEV+NP Ritz values')
- end if
-c
- return
-c
-c %---------------%
-c | End of dngets |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsaitr.f b/netlib/ARPACK/dsaitr.f
deleted file mode 100644
index c38dfe0..0000000
--- a/netlib/ARPACK/dsaitr.f
+++ /dev/null
@@ -1,853 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsaitr
-c
-c\Description:
-c Reverse communication interface for applying NP additional steps to
-c a K step symmetric Arnoldi factorization.
-c
-c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
-c
-c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
-c
-c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
-c
-c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
-c
-c where OP and B are as in dsaupd. The B-norm of r_{k+p} is also
-c computed and returned.
-c
-c\Usage:
-c call dsaitr
-c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
-c IPNTR, WORKD, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag.
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c This is for the restart phase to force the new
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y,
-c IPNTR(3) is the pointer into WORK for B * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c IDO = 99: done
-c -------------------------------------------------------------
-c When the routine is used in the "shift-and-invert" mode, the
-c vector B * Q is already available and does not need to be
-c recomputed in forming OP * Q.
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of matrix B that defines the
-c semi-inner product for the operator OP. See dsaupd.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c K Integer. (INPUT)
-c Current order of H and the number of columns of V.
-c
-c NP Integer. (INPUT)
-c Number of additional Arnoldi steps to take.
-c
-c MODE Integer. (INPUT)
-c Signifies which form for "OP". If MODE=2 then
-c a reduction in the number of B matrix vector multiplies
-c is possible since the B-norm of OP*x is equivalent to
-c the inv(B)-norm of A*x.
-c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
-c On INPUT: RESID contains the residual vector r_{k}.
-c On OUTPUT: RESID contains the residual vector r_{k+p}.
-c
-c RNORM Double precision scalar. (INPUT/OUTPUT)
-c On INPUT the B-norm of r_{k}.
-c On OUTPUT the B-norm of the updated residual r_{k+p}.
-c
-c V Double precision N by K+NP array. (INPUT/OUTPUT)
-c On INPUT: V contains the Arnoldi vectors in the first K
-c columns.
-c On OUTPUT: V contains the new NP Arnoldi vectors in the next
-c NP columns. The first K columns are unchanged.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT)
-c H is used to store the generated symmetric tridiagonal matrix
-c with the subdiagonal in the first column starting at H(2,1)
-c and the main diagonal in the second column.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORK for
-c vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in the
-c shift-and-invert mode. X is the current operand.
-c -------------------------------------------------------------
-c
-c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The calling program should not
-c use WORKD as temporary workspace during the iteration !!!!!!
-c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
-c with the K step Arnoldi factorization. Used to save some
-c computation at the first step.
-c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
-c with the K+NP step Arnoldi factorization.
-c
-c INFO Integer. (OUTPUT)
-c = 0: Normal exit.
-c > 0: Size of an invariant subspace of OP is found that is
-c less than K + NP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c dgetv0 ARPACK routine to generate the initial vector.
-c ivout ARPACK utility routine that prints integers.
-c dmout ARPACK utility routine that prints matrices.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c dlascl LAPACK routine for careful scaling of a matrix.
-c dgemv Level 2 BLAS routine for matrix vector multiplication.
-c daxpy Level 1 BLAS that computes a vector triad.
-c dscal Level 1 BLAS that scales a vector.
-c dcopy Level 1 BLAS that copies one vector to another .
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/93: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2
-c
-c\Remarks
-c The algorithm implemented is:
-c
-c restart = .false.
-c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
-c r_{k} contains the initial residual vector even for k = 0;
-c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
-c computed by the calling program.
-c
-c betaj = rnorm ; p_{k+1} = B*r_{k} ;
-c For j = k+1, ..., k+np Do
-c 1) if ( betaj < tol ) stop or restart depending on j.
-c if ( restart ) generate a new starting vector.
-c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
-c p_{j} = p_{j}/betaj
-c 3) r_{j} = OP*v_{j} where OP is defined as in dsaupd
-c For shift-invert mode p_{j} = B*v_{j} is already available.
-c wnorm = || OP*v_{j} ||
-c 4) Compute the j-th step residual vector.
-c w_{j} = V_{j}^T * B * OP * v_{j}
-c r_{j} = OP*v_{j} - V_{j} * w_{j}
-c alphaj <- j-th component of w_{j}
-c rnorm = || r_{j} ||
-c betaj+1 = rnorm
-c If (rnorm > 0.717*wnorm) accept step and go back to 1)
-c 5) Re-orthogonalization step:
-c s = V_{j}'*B*r_{j}
-c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
-c alphaj = alphaj + s_{j};
-c 6) Iterative refinement step:
-c If (rnorm1 > 0.717*rnorm) then
-c rnorm = rnorm1
-c accept step and go back to 1)
-c Else
-c rnorm = rnorm1
-c If this is the first time in step 6), go to 5)
-c Else r_{j} lies in the span of V_{j} numerically.
-c Set r_{j} = 0 and rnorm = 0; go to 1)
-c EndIf
-c End Do
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsaitr
- & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
- & ipntr, workd, info)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1
- integer ido, info, k, ldh, ldv, n, mode, np
- Double precision
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Double precision
- & h(ldh,2), resid(n), v(ldv,k+np), workd(3*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- logical first, orth1, orth2, rstart, step3, step4
- integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl,
- & infol, jj
- Double precision
- & rnorm1, wnorm, safmin, temp1
- save orth1, orth2, rstart, step3, step4,
- & ierr, ipj, irj, ivj, iter, itry, j, msglvl,
- & rnorm1, safmin, wnorm
-c
-c %-----------------------%
-c | Local Array Arguments |
-c %-----------------------%
-c
- Double precision
- & xtemp(2)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external daxpy, dcopy, dscal, dgemv, dgetv0, dvout, dmout,
- & dlascl, ivout, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & ddot, dnrm2, dlamch
- external ddot, dnrm2, dlamch
-c
-c %-----------------%
-c | Data statements |
-c %-----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
- first = .false.
-c
-c %--------------------------------%
-c | safmin = safe minimum is such |
-c | that 1/sfmin does not overflow |
-c %--------------------------------%
-c
- safmin = dlamch('safmin')
- end if
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msaitr
-c
-c %------------------------------%
-c | Initial call to this routine |
-c %------------------------------%
-c
- info = 0
- step3 = .false.
- step4 = .false.
- rstart = .false.
- orth1 = .false.
- orth2 = .false.
-c
-c %--------------------------------%
-c | Pointer to the current step of |
-c | the factorization to build |
-c %--------------------------------%
-c
- j = k + 1
-c
-c %------------------------------------------%
-c | Pointers used for reverse communication |
-c | when using WORKD. |
-c %------------------------------------------%
-c
- ipj = 1
- irj = ipj + n
- ivj = irj + n
- end if
-c
-c %-------------------------------------------------%
-c | When in reverse communication mode one of: |
-c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
-c | will be .true. |
-c | STEP3: return from computing OP*v_{j}. |
-c | STEP4: return from computing B-norm of OP*v_{j} |
-c | ORTH1: return from computing B-norm of r_{j+1} |
-c | ORTH2: return from computing B-norm of |
-c | correction to the residual vector. |
-c | RSTART: return from OP computations needed by |
-c | dgetv0. |
-c %-------------------------------------------------%
-c
- if (step3) go to 50
- if (step4) go to 60
- if (orth1) go to 70
- if (orth2) go to 90
- if (rstart) go to 30
-c
-c %------------------------------%
-c | Else this is the first step. |
-c %------------------------------%
-c
-c %--------------------------------------------------------------%
-c | |
-c | A R N O L D I I T E R A T I O N L O O P |
-c | |
-c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
-c %--------------------------------------------------------------%
-c
- 1000 continue
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, j, ndigit,
- & '_saitr: generating Arnoldi vector no.')
- call dvout (logfil, 1, rnorm, ndigit,
- & '_saitr: B-norm of the current residual =')
- end if
-c
-c %---------------------------------------------------------%
-c | Check for exact zero. Equivalent to determing whether a |
-c | j-step Arnoldi factorization is present. |
-c %---------------------------------------------------------%
-c
- if (rnorm .gt. zero) go to 40
-c
-c %---------------------------------------------------%
-c | Invariant subspace found, generate a new starting |
-c | vector which is orthogonal to the current Arnoldi |
-c | basis and continue the iteration. |
-c %---------------------------------------------------%
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_saitr: ****** restart at step ******')
- end if
-c
-c %---------------------------------------------%
-c | ITRY is the loop variable that controls the |
-c | maximum amount of times that a restart is |
-c | attempted. NRSTRT is used by stat.h |
-c %---------------------------------------------%
-c
- nrstrt = nrstrt + 1
- itry = 1
- 20 continue
- rstart = .true.
- ido = 0
- 30 continue
-c
-c %--------------------------------------%
-c | If in reverse communication mode and |
-c | RSTART = .true. flow returns here. |
-c %--------------------------------------%
-c
- call dgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
- & resid, rnorm, ipntr, workd, ierr)
- if (ido .ne. 99) go to 9000
- if (ierr .lt. 0) then
- itry = itry + 1
- if (itry .le. 3) go to 20
-c
-c %------------------------------------------------%
-c | Give up after several restart attempts. |
-c | Set INFO to the size of the invariant subspace |
-c | which spans OP and exit. |
-c %------------------------------------------------%
-c
- info = j - 1
- call arscnd (t1)
- tsaitr = tsaitr + (t1 - t0)
- ido = 99
- go to 9000
- end if
-c
- 40 continue
-c
-c %---------------------------------------------------------%
-c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
-c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
-c | when reciprocating a small RNORM, test against lower |
-c | machine bound. |
-c %---------------------------------------------------------%
-c
- call dcopy (n, resid, 1, v(1,j), 1)
- if (rnorm .ge. safmin) then
- temp1 = one / rnorm
- call dscal (n, temp1, v(1,j), 1)
- call dscal (n, temp1, workd(ipj), 1)
- else
-c
-c %-----------------------------------------%
-c | To scale both v_{j} and p_{j} carefully |
-c | use LAPACK routine SLASCL |
-c %-----------------------------------------%
-c
- call dlascl ('General', i, i, rnorm, one, n, 1,
- & v(1,j), n, infol)
- call dlascl ('General', i, i, rnorm, one, n, 1,
- & workd(ipj), n, infol)
- end if
-c
-c %------------------------------------------------------%
-c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
-c | Note that this is not quite yet r_{j}. See STEP 4 |
-c %------------------------------------------------------%
-c
- step3 = .true.
- nopx = nopx + 1
- call arscnd (t2)
- call dcopy (n, v(1,j), 1, workd(ivj), 1)
- ipntr(1) = ivj
- ipntr(2) = irj
- ipntr(3) = ipj
- ido = 1
-c
-c %-----------------------------------%
-c | Exit in order to compute OP*v_{j} |
-c %-----------------------------------%
-c
- go to 9000
- 50 continue
-c
-c %-----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
-c %-----------------------------------%
-c
- call arscnd (t3)
- tmvopx = tmvopx + (t3 - t2)
-c
- step3 = .false.
-c
-c %------------------------------------------%
-c | Put another copy of OP*v_{j} into RESID. |
-c %------------------------------------------%
-c
- call dcopy (n, workd(irj), 1, resid, 1)
-c
-c %-------------------------------------------%
-c | STEP 4: Finish extending the symmetric |
-c | Arnoldi to length j. If MODE = 2 |
-c | then B*OP = B*inv(B)*A = A and |
-c | we don't need to compute B*OP. |
-c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
-c | assumed to have A*v_{j}. |
-c %-------------------------------------------%
-c
- if (mode .eq. 2) go to 65
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- step4 = .true.
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-------------------------------------%
-c | Exit in order to compute B*OP*v_{j} |
-c %-------------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy(n, resid, 1 , workd(ipj), 1)
- end if
- 60 continue
-c
-c %-----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
-c %-----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- step4 = .false.
-c
-c %-------------------------------------%
-c | The following is needed for STEP 5. |
-c | Compute the B-norm of OP*v_{j}. |
-c %-------------------------------------%
-c
- 65 continue
- if (mode .eq. 2) then
-c
-c %----------------------------------%
-c | Note that the B-norm of OP*v_{j} |
-c | is the inv(B)-norm of A*v_{j}. |
-c %----------------------------------%
-c
- wnorm = ddot (n, resid, 1, workd(ivj), 1)
- wnorm = sqrt(abs(wnorm))
- else if (bmat .eq. 'G') then
- wnorm = ddot (n, resid, 1, workd(ipj), 1)
- wnorm = sqrt(abs(wnorm))
- else if (bmat .eq. 'I') then
- wnorm = dnrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------%
-c | Compute the j-th residual corresponding |
-c | to the j step factorization. |
-c | Use Classical Gram Schmidt and compute: |
-c | w_{j} <- V_{j}^T * B * OP * v_{j} |
-c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
-c %-----------------------------------------%
-c
-c
-c %------------------------------------------%
-c | Compute the j Fourier coefficients w_{j} |
-c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
-c %------------------------------------------%
-c
- if (mode .ne. 2 ) then
- call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
- & workd(irj), 1)
- else if (mode .eq. 2) then
- call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
- & workd(irj), 1)
- end if
-c
-c %--------------------------------------%
-c | Orthgonalize r_{j} against V_{j}. |
-c | RESID contains OP*v_{j}. See STEP 3. |
-c %--------------------------------------%
-c
- call dgemv('N', n, j, -one, v, ldv, workd(irj), 1, one,
- & resid, 1)
-c
-c %--------------------------------------%
-c | Extend H to have j rows and columns. |
-c %--------------------------------------%
-c
- h(j,2) = workd(irj + j - 1)
- if (j .eq. 1 .or. rstart) then
- h(j,1) = zero
- else
- h(j,1) = rnorm
- end if
- call arscnd (t4)
-c
- orth1 = .true.
- iter = 0
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*r_{j} |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd(ipj), 1)
- end if
- 70 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH1 = .true. |
-c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- orth1 = .false.
-c
-c %------------------------------%
-c | Compute the B-norm of r_{j}. |
-c %------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm = ddot (n, resid, 1, workd(ipj), 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = dnrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------------------------%
-c | STEP 5: Re-orthogonalization / Iterative refinement phase |
-c | Maximum NITER_ITREF tries. |
-c | |
-c | s = V_{j}^T * B * r_{j} |
-c | r_{j} = r_{j} - V_{j}*s |
-c | alphaj = alphaj + s_{j} |
-c | |
-c | The stopping criteria used for iterative refinement is |
-c | discussed in Parlett's book SEP, page 107 and in Gragg & |
-c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
-c | Determine if we need to correct the residual. The goal is |
-c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
-c %-----------------------------------------------------------%
-c
- if (rnorm .gt. 0.717*wnorm) go to 100
- nrorth = nrorth + 1
-c
-c %---------------------------------------------------%
-c | Enter the Iterative refinement phase. If further |
-c | refinement is necessary, loop back here. The loop |
-c | variable is ITER. Perform a step of Classical |
-c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
-c %---------------------------------------------------%
-c
- 80 continue
-c
- if (msglvl .gt. 2) then
- xtemp(1) = wnorm
- xtemp(2) = rnorm
- call dvout (logfil, 2, xtemp, ndigit,
- & '_saitr: re-orthonalization ; wnorm and rnorm are')
- end if
-c
-c %----------------------------------------------------%
-c | Compute V_{j}^T * B * r_{j}. |
-c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
-c %----------------------------------------------------%
-c
- call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
- & zero, workd(irj), 1)
-c
-c %----------------------------------------------%
-c | Compute the correction to the residual: |
-c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
-c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
-c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
-c | H(j,j) is updated. |
-c %----------------------------------------------%
-c
- call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
- & one, resid, 1)
-c
- if (j .eq. 1 .or. rstart) h(j,1) = zero
- h(j,2) = h(j,2) + workd(irj + j - 1)
-c
- orth2 = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-----------------------------------%
-c | Exit in order to compute B*r_{j}. |
-c | r_{j} is the corrected residual. |
-c %-----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd(ipj), 1)
- end if
- 90 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH2 = .true. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
-c %-----------------------------------------------------%
-c | Compute the B-norm of the corrected residual r_{j}. |
-c %-----------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm1 = ddot (n, resid, 1, workd(ipj), 1)
- rnorm1 = sqrt(abs(rnorm1))
- else if (bmat .eq. 'I') then
- rnorm1 = dnrm2(n, resid, 1)
- end if
-c
- if (msglvl .gt. 0 .and. iter .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_saitr: Iterative refinement for Arnoldi residual')
- if (msglvl .gt. 2) then
- xtemp(1) = rnorm
- xtemp(2) = rnorm1
- call dvout (logfil, 2, xtemp, ndigit,
- & '_saitr: iterative refinement ; rnorm and rnorm1 are')
- end if
- end if
-c
-c %-----------------------------------------%
-c | Determine if we need to perform another |
-c | step of re-orthogonalization. |
-c %-----------------------------------------%
-c
- if (rnorm1 .gt. 0.717*rnorm) then
-c
-c %--------------------------------%
-c | No need for further refinement |
-c %--------------------------------%
-c
- rnorm = rnorm1
-c
- else
-c
-c %-------------------------------------------%
-c | Another step of iterative refinement step |
-c | is required. NITREF is used by stat.h |
-c %-------------------------------------------%
-c
- nitref = nitref + 1
- rnorm = rnorm1
- iter = iter + 1
- if (iter .le. 1) go to 80
-c
-c %-------------------------------------------------%
-c | Otherwise RESID is numerically in the span of V |
-c %-------------------------------------------------%
-c
- do 95 jj = 1, n
- resid(jj) = zero
- 95 continue
- rnorm = zero
- end if
-c
-c %----------------------------------------------%
-c | Branch here directly if iterative refinement |
-c | wasn't necessary or after at most NITER_REF |
-c | steps of iterative refinement. |
-c %----------------------------------------------%
-c
- 100 continue
-c
- rstart = .false.
- orth2 = .false.
-c
- call arscnd (t5)
- titref = titref + (t5 - t4)
-c
-c %----------------------------------------------------------%
-c | Make sure the last off-diagonal element is non negative |
-c | If not perform a similarity transformation on H(1:j,1:j) |
-c | and scale v(:,j) by -1. |
-c %----------------------------------------------------------%
-c
- if (h(j,1) .lt. zero) then
- h(j,1) = -h(j,1)
- if ( j .lt. k+np) then
- call dscal(n, -one, v(1,j+1), 1)
- else
- call dscal(n, -one, resid, 1)
- end if
- end if
-c
-c %------------------------------------%
-c | STEP 6: Update j = j+1; Continue |
-c %------------------------------------%
-c
- j = j + 1
- if (j .gt. k+np) then
- call arscnd (t1)
- tsaitr = tsaitr + (t1 - t0)
- ido = 99
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, k+np, h(1,2), ndigit,
- & '_saitr: main diagonal of matrix H of step K+NP.')
- if (k+np .gt. 1) then
- call dvout (logfil, k+np-1, h(2,1), ndigit,
- & '_saitr: sub diagonal of matrix H of step K+NP.')
- end if
- end if
-c
- go to 9000
- end if
-c
-c %--------------------------------------------------------%
-c | Loop back to extend the factorization by another step. |
-c %--------------------------------------------------------%
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dsaitr |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsapps.f b/netlib/ARPACK/dsapps.f
deleted file mode 100644
index bfdba9e..0000000
--- a/netlib/ARPACK/dsapps.f
+++ /dev/null
@@ -1,516 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsapps
-c
-c\Description:
-c Given the Arnoldi factorization
-c
-c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
-c
-c apply NP shifts implicitly resulting in
-c
-c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
-c
-c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
-c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
-c factorization becomes:
-c
-c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
-c
-c\Usage:
-c call dsapps
-c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Problem size, i.e. dimension of matrix A.
-c
-c KEV Integer. (INPUT)
-c INPUT: KEV+NP is the size of the input matrix H.
-c OUTPUT: KEV is the size of the updated matrix HNEW.
-c
-c NP Integer. (INPUT)
-c Number of implicit shifts to be applied.
-c
-c SHIFT Double precision array of length NP. (INPUT)
-c The shifts to be applied.
-c
-c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
-c INPUT: V contains the current KEV+NP Arnoldi vectors.
-c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
-c are in the first KEV columns of V.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT)
-c INPUT: H contains the symmetric tridiagonal matrix of the
-c Arnoldi factorization with the subdiagonal in the 1st column
-c starting at H(2,1) and the main diagonal in the 2nd column.
-c OUTPUT: H contains the updated tridiagonal matrix in the
-c KEV leading submatrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RESID Double precision array of length (N). (INPUT/OUTPUT)
-c INPUT: RESID contains the the residual vector r_{k+p}.
-c OUTPUT: RESID is the updated residual vector rnew_{k}.
-c
-c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
-c Work array used to accumulate the rotations during the bulge
-c chase sweep.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKD Double precision work array of length 2*N. (WORKSPACE)
-c Distributed array used in the application of the accumulated
-c orthogonal matrix Q.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c dlartg LAPACK Givens rotation construction routine.
-c dlacpy LAPACK matrix copy routine.
-c dlaset LAPACK matrix initialization routine.
-c dgemv Level 2 BLAS routine for matrix vector multiplication.
-c daxpy Level 1 BLAS that computes a vector triad.
-c dcopy Level 1 BLAS that copies one vector to another.
-c dscal Level 1 BLAS that scales a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/16/93: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2
-c
-c\Remarks
-c 1. In this version, each shift is applied to all the subblocks of
-c the tridiagonal matrix H and not just to the submatrix that it
-c comes from. This routine assumes that the subdiagonal elements
-c of H that are stored in h(1:kev+np,1) are nonegative upon input
-c and enforce this condition upon output. This version incorporates
-c deflation. See code for documentation.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsapps
- & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer kev, ldh, ldq, ldv, n, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
- & v(ldv,kev+np), workd(2*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, iend, istart, itop, j, jj, kplusp, msglvl
- logical first
- Double precision
- & a1, a2, a3, a4, big, c, epsmch, f, g, r, s
- save epsmch, first
-c
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, dvout,
- & ivout, arscnd, dgemv
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlamch
- external dlamch
-c
-c %----------------------%
-c | Intrinsics Functions |
-c %----------------------%
-c
- intrinsic abs
-c
-c %----------------%
-c | Data statments |
-c %----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
- epsmch = dlamch('Epsilon-Machine')
- first = .false.
- end if
- itop = 1
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msapps
-c
- kplusp = kev + np
-c
-c %----------------------------------------------%
-c | Initialize Q to the identity matrix of order |
-c | kplusp used to accumulate the rotations. |
-c %----------------------------------------------%
-c
- call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
-c
-c %----------------------------------------------%
-c | Quick return if there are no shifts to apply |
-c %----------------------------------------------%
-c
- if (np .eq. 0) go to 9000
-c
-c %----------------------------------------------------------%
-c | Apply the np shifts implicitly. Apply each shift to the |
-c | whole matrix and not just to the submatrix from which it |
-c | comes. |
-c %----------------------------------------------------------%
-c
- do 90 jj = 1, np
-c
- istart = itop
-c
-c %----------------------------------------------------------%
-c | Check for splitting and deflation. Currently we consider |
-c | an off-diagonal element h(i+1,1) negligible if |
-c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
-c | for i=1:KEV+NP-1. |
-c | If above condition tests true then we set h(i+1,1) = 0. |
-c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
-c %----------------------------------------------------------%
-c
- 20 continue
-c
-c %------------------------------------------------%
-c | The following loop exits early if we encounter |
-c | a negligible off diagonal element. |
-c %------------------------------------------------%
-c
- do 30 i = istart, kplusp-1
- big = abs(h(i,2)) + abs(h(i+1,2))
- if (h(i+1,1) .le. epsmch*big) then
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, i, ndigit,
- & '_sapps: deflation at row/column no.')
- call ivout (logfil, 1, jj, ndigit,
- & '_sapps: occured before shift number.')
- call dvout (logfil, 1, h(i+1,1), ndigit,
- & '_sapps: the corresponding off diagonal element')
- end if
- h(i+1,1) = zero
- iend = i
- go to 40
- end if
- 30 continue
- iend = kplusp
- 40 continue
-c
- if (istart .lt. iend) then
-c
-c %--------------------------------------------------------%
-c | Construct the plane rotation G'(istart,istart+1,theta) |
-c | that attempts to drive h(istart+1,1) to zero. |
-c %--------------------------------------------------------%
-c
- f = h(istart,2) - shift(jj)
- g = h(istart+1,1)
- call dlartg (f, g, c, s, r)
-c
-c %-------------------------------------------------------%
-c | Apply rotation to the left and right of H; |
-c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
-c | This will create a "bulge". |
-c %-------------------------------------------------------%
-c
- a1 = c*h(istart,2) + s*h(istart+1,1)
- a2 = c*h(istart+1,1) + s*h(istart+1,2)
- a4 = c*h(istart+1,2) - s*h(istart+1,1)
- a3 = c*h(istart+1,1) - s*h(istart,2)
- h(istart,2) = c*a1 + s*a2
- h(istart+1,2) = c*a4 - s*a3
- h(istart+1,1) = c*a3 + s*a4
-c
-c %----------------------------------------------------%
-c | Accumulate the rotation in the matrix Q; Q <- Q*G |
-c %----------------------------------------------------%
-c
- do 60 j = 1, min(istart+jj,kplusp)
- a1 = c*q(j,istart) + s*q(j,istart+1)
- q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
- q(j,istart) = a1
- 60 continue
-c
-c
-c %----------------------------------------------%
-c | The following loop chases the bulge created. |
-c | Note that the previous rotation may also be |
-c | done within the following loop. But it is |
-c | kept separate to make the distinction among |
-c | the bulge chasing sweeps and the first plane |
-c | rotation designed to drive h(istart+1,1) to |
-c | zero. |
-c %----------------------------------------------%
-c
- do 70 i = istart+1, iend-1
-c
-c %----------------------------------------------%
-c | Construct the plane rotation G'(i,i+1,theta) |
-c | that zeros the i-th bulge that was created |
-c | by G(i-1,i,theta). g represents the bulge. |
-c %----------------------------------------------%
-c
- f = h(i,1)
- g = s*h(i+1,1)
-c
-c %----------------------------------%
-c | Final update with G(i-1,i,theta) |
-c %----------------------------------%
-c
- h(i+1,1) = c*h(i+1,1)
- call dlartg (f, g, c, s, r)
-c
-c %-------------------------------------------%
-c | The following ensures that h(1:iend-1,1), |
-c | the first iend-2 off diagonal of elements |
-c | H, remain non negative. |
-c %-------------------------------------------%
-c
- if (r .lt. zero) then
- r = -r
- c = -c
- s = -s
- end if
-c
-c %--------------------------------------------%
-c | Apply rotation to the left and right of H; |
-c | H <- G * H * G', where G = G(i,i+1,theta) |
-c %--------------------------------------------%
-c
- h(i,1) = r
-c
- a1 = c*h(i,2) + s*h(i+1,1)
- a2 = c*h(i+1,1) + s*h(i+1,2)
- a3 = c*h(i+1,1) - s*h(i,2)
- a4 = c*h(i+1,2) - s*h(i+1,1)
-c
- h(i,2) = c*a1 + s*a2
- h(i+1,2) = c*a4 - s*a3
- h(i+1,1) = c*a3 + s*a4
-c
-c %----------------------------------------------------%
-c | Accumulate the rotation in the matrix Q; Q <- Q*G |
-c %----------------------------------------------------%
-c
- do 50 j = 1, min( i+jj, kplusp )
- a1 = c*q(j,i) + s*q(j,i+1)
- q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
- q(j,i) = a1
- 50 continue
-c
- 70 continue
-c
- end if
-c
-c %--------------------------%
-c | Update the block pointer |
-c %--------------------------%
-c
- istart = iend + 1
-c
-c %------------------------------------------%
-c | Make sure that h(iend,1) is non-negative |
-c | If not then set h(iend,1) <-- -h(iend,1) |
-c | and negate the last column of Q. |
-c | We have effectively carried out a |
-c | similarity on transformation H |
-c %------------------------------------------%
-c
- if (h(iend,1) .lt. zero) then
- h(iend,1) = -h(iend,1)
- call dscal(kplusp, -one, q(1,iend), 1)
- end if
-c
-c %--------------------------------------------------------%
-c | Apply the same shift to the next block if there is any |
-c %--------------------------------------------------------%
-c
- if (iend .lt. kplusp) go to 20
-c
-c %-----------------------------------------------------%
-c | Check if we can increase the the start of the block |
-c %-----------------------------------------------------%
-c
- do 80 i = itop, kplusp-1
- if (h(i+1,1) .gt. zero) go to 90
- itop = itop + 1
- 80 continue
-c
-c %-----------------------------------%
-c | Finished applying the jj-th shift |
-c %-----------------------------------%
-c
- 90 continue
-c
-c %------------------------------------------%
-c | All shifts have been applied. Check for |
-c | more possible deflation that might occur |
-c | after the last shift is applied. |
-c %------------------------------------------%
-c
- do 100 i = itop, kplusp-1
- big = abs(h(i,2)) + abs(h(i+1,2))
- if (h(i+1,1) .le. epsmch*big) then
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, i, ndigit,
- & '_sapps: deflation at row/column no.')
- call dvout (logfil, 1, h(i+1,1), ndigit,
- & '_sapps: the corresponding off diagonal element')
- end if
- h(i+1,1) = zero
- end if
- 100 continue
-c
-c %-------------------------------------------------%
-c | Compute the (kev+1)-st column of (V*Q) and |
-c | temporarily store the result in WORKD(N+1:2*N). |
-c | This is not necessary if h(kev+1,1) = 0. |
-c %-------------------------------------------------%
-c
- if ( h(kev+1,1) .gt. zero )
- & call dgemv ('N', n, kplusp, one, v, ldv,
- & q(1,kev+1), 1, zero, workd(n+1), 1)
-c
-c %-------------------------------------------------------%
-c | Compute column 1 to kev of (V*Q) in backward order |
-c | taking advantage that Q is an upper triangular matrix |
-c | with lower bandwidth np. |
-c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
-c %-------------------------------------------------------%
-c
- do 130 i = 1, kev
- call dgemv ('N', n, kplusp-i+1, one, v, ldv,
- & q(1,kev-i+1), 1, zero, workd, 1)
- call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
- 130 continue
-c
-c %-------------------------------------------------%
-c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
-c %-------------------------------------------------%
-c
- call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
-c
-c %--------------------------------------------%
-c | Copy the (kev+1)-st column of (V*Q) in the |
-c | appropriate place if h(kev+1,1) .ne. zero. |
-c %--------------------------------------------%
-c
- if ( h(kev+1,1) .gt. zero )
- & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
-c
-c %-------------------------------------%
-c | Update the residual vector: |
-c | r <- sigmak*r + betak*v(:,kev+1) |
-c | where |
-c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
-c | betak = e_{kev+1}'*H*e_{kev} |
-c %-------------------------------------%
-c
- call dscal (n, q(kplusp,kev), resid, 1)
- if (h(kev+1,1) .gt. zero)
- & call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, 1, q(kplusp,kev), ndigit,
- & '_sapps: sigmak of the updated residual vector')
- call dvout (logfil, 1, h(kev+1,1), ndigit,
- & '_sapps: betak of the updated residual vector')
- call dvout (logfil, kev, h(1,2), ndigit,
- & '_sapps: updated main diagonal of H for next iteration')
- if (kev .gt. 1) then
- call dvout (logfil, kev-1, h(2,1), ndigit,
- & '_sapps: updated sub diagonal of H for next iteration')
- end if
- end if
-c
- call arscnd (t1)
- tsapps = tsapps + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dsapps |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsaup2.f b/netlib/ARPACK/dsaup2.f
deleted file mode 100644
index f2c896e..0000000
--- a/netlib/ARPACK/dsaup2.f
+++ /dev/null
@@ -1,850 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsaup2
-c
-c\Description:
-c Intermediate level interface called by dsaupd.
-c
-c\Usage:
-c call dsaup2
-c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
-c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
-c IPNTR, WORKD, INFO )
-c
-c\Arguments
-c
-c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dsaupd.
-c MODE, ISHIFT, MXITER: see the definition of IPARAM in dsaupd.
-c
-c NP Integer. (INPUT/OUTPUT)
-c Contains the number of implicit shifts to apply during
-c each Arnoldi/Lanczos iteration.
-c If ISHIFT=1, NP is adjusted dynamically at each iteration
-c to accelerate convergence and prevent stagnation.
-c This is also roughly equal to the number of matrix-vector
-c products (involving the operator OP) per Arnoldi iteration.
-c The logic for adjusting is contained within the current
-c subroutine.
-c If ISHIFT=0, NP is the number of shifts the user needs
-c to provide via reverse comunication. 0 < NP < NCV-NEV.
-c NP may be less than NCV-NEV since a leading block of the current
-c upper Tridiagonal matrix has split off and contains "unwanted"
-c Ritz values.
-c Upon termination of the IRA iteration, NP contains the number
-c of "converged" wanted Ritz values.
-c
-c IUPD Integer. (INPUT)
-c IUPD .EQ. 0: use explicit restart instead implicit update.
-c IUPD .NE. 0: use implicit update.
-c
-c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
-c The Lanczos basis vectors.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Double precision (NEV+NP) by 2 array. (OUTPUT)
-c H is used to store the generated symmetric tridiagonal matrix
-c The subdiagonal is stored in the first column of H starting
-c at H(2,1). The main diagonal is stored in the arscnd column
-c of H starting at H(1,2). If dsaup2 converges store the
-c B-norm of the final residual vector in H(1,1).
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RITZ Double precision array of length NEV+NP. (OUTPUT)
-c RITZ(1:NEV) contains the computed Ritz values of OP.
-c
-c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
-c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
-c
-c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
-c Private (replicated) work array used to accumulate the
-c rotation in the shift application step.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. It is used in the computation of the
-c tridiagonal eigenvalue problem, the calculation and
-c application of the shifts and convergence checking.
-c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
-c of WORKL are used in reverse communication to hold the user
-c supplied shifts.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD for
-c vectors used by the Lanczos iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in one of
-c the spectral transformation modes. X is the current
-c operand.
-c -------------------------------------------------------------
-c
-c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Lanczos iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration !!!!!!!!!!
-c See Data Distribution Note in dsaupd.
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal return.
-c = 1: All possible eigenvalues of OP has been found.
-c NP returns the size of the invariant subspace
-c spanning the operator OP.
-c = 2: No shifts could be applied.
-c = -8: Error return from trid. eigenvalue calculation;
-c This should never happen.
-c = -9: Starting vector is zero.
-c = -9999: Could not build an Lanczos factorization.
-c Size that was built in returned in NP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
-c 1980.
-c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
-c Computer Physics Communications, 53 (1989), pp 169-179.
-c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
-c Implement the Spectral Transformation", Math. Comp., 48 (1987),
-c pp 663-673.
-c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
-c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
-c SIAM J. Matr. Anal. Apps., January (1993).
-c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
-c for Updating the QR decomposition", ACM TOMS, December 1990,
-c Volume 16 Number 4, pp 369-377.
-c
-c\Routines called:
-c dgetv0 ARPACK initial vector generation routine.
-c dsaitr ARPACK Lanczos factorization routine.
-c dsapps ARPACK application of implicit shifts routine.
-c dsconv ARPACK convergence of Ritz values routine.
-c dseigt ARPACK compute Ritz values and error bounds routine.
-c dsgets ARPACK reorder Ritz values and error bounds routine.
-c dsortr ARPACK sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c dcopy Level 1 BLAS that copies one vector to another.
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dscal Level 1 BLAS that scales a vector.
-c dswap Level 1 BLAS that swaps two vectors.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.4'
-c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq)
-c
-c\SCCS Information: @(#)
-c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsaup2
- & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
- & q, ldq, workl, ipntr, workd, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
- & n, mode, nev, np
- Double precision
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Double precision
- & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
- & ritz(nev+np), v(ldv,nev+np), workd(3*n),
- & workl(3*(nev+np))
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character wprime*2
- logical cnorm, getv0, initv, update, ushift
- integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0,
- & np0, nptemp, nevd2, nevm2, kp(3)
- Double precision
- & rnorm, temp, eps23
- save cnorm, getv0, initv, update, ushift,
- & iter, kplusp, msglvl, nconv, nev0, np0,
- & rnorm, eps23
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy, dgetv0, dsaitr, dscal, dsconv, dseigt, dsgets,
- & dsapps, dsortr, dvout, ivout, arscnd, dswap
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & ddot, dnrm2, dlamch
- external ddot, dnrm2, dlamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic min
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msaup2
-c
-c %---------------------------------%
-c | Set machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = dlamch('Epsilon-Machine')
- eps23 = eps23**(2.0D+0/3.0D+0)
-c
-c %-------------------------------------%
-c | nev0 and np0 are integer variables |
-c | hold the initial values of NEV & NP |
-c %-------------------------------------%
-c
- nev0 = nev
- np0 = np
-c
-c %-------------------------------------%
-c | kplusp is the bound on the largest |
-c | Lanczos factorization built. |
-c | nconv is the current number of |
-c | "converged" eigenvlues. |
-c | iter is the counter on the current |
-c | iteration step. |
-c %-------------------------------------%
-c
- kplusp = nev0 + np0
- nconv = 0
- iter = 0
-c
-c %--------------------------------------------%
-c | Set flags for computing the first NEV steps |
-c | of the Lanczos factorization. |
-c %--------------------------------------------%
-c
- getv0 = .true.
- update = .false.
- ushift = .false.
- cnorm = .false.
-c
- if (info .ne. 0) then
-c
-c %--------------------------------------------%
-c | User provides the initial residual vector. |
-c %--------------------------------------------%
-c
- initv = .true.
- info = 0
- else
- initv = .false.
- end if
- end if
-c
-c %---------------------------------------------%
-c | Get a possibly random starting vector and |
-c | force it into the range of the operator OP. |
-c %---------------------------------------------%
-c
- 10 continue
-c
- if (getv0) then
- call dgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
- & ipntr, workd, info)
-c
- if (ido .ne. 99) go to 9000
-c
- if (rnorm .eq. zero) then
-c
-c %-----------------------------------------%
-c | The initial vector is zero. Error exit. |
-c %-----------------------------------------%
-c
- info = -9
- go to 1200
- end if
- getv0 = .false.
- ido = 0
- end if
-c
-c %------------------------------------------------------------%
-c | Back from reverse communication: continue with update step |
-c %------------------------------------------------------------%
-c
- if (update) go to 20
-c
-c %-------------------------------------------%
-c | Back from computing user specified shifts |
-c %-------------------------------------------%
-c
- if (ushift) go to 50
-c
-c %-------------------------------------%
-c | Back from computing residual norm |
-c | at the end of the current iteration |
-c %-------------------------------------%
-c
- if (cnorm) go to 100
-c
-c %----------------------------------------------------------%
-c | Compute the first NEV steps of the Lanczos factorization |
-c %----------------------------------------------------------%
-c
- call dsaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
-c
-c %-----------------------------------------------------%
-c | dsaitr was unable to build an Lanczos factorization |
-c | of length NEV0. INFO is returned with the size of |
-c | the factorization built. Exit main loop. |
-c %-----------------------------------------------------%
-c
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
-c
-c %--------------------------------------------------------------%
-c | |
-c | M A I N LANCZOS I T E R A T I O N L O O P |
-c | Each iteration implicitly restarts the Lanczos |
-c | factorization in place. |
-c | |
-c %--------------------------------------------------------------%
-c
- 1000 continue
-c
- iter = iter + 1
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, iter, ndigit,
- & '_saup2: **** Start of major iteration number ****')
- end if
- if (msglvl .gt. 1) then
- call ivout (logfil, 1, nev, ndigit,
- & '_saup2: The length of the current Lanczos factorization')
- call ivout (logfil, 1, np, ndigit,
- & '_saup2: Extend the Lanczos factorization by')
- end if
-c
-c %------------------------------------------------------------%
-c | Compute NP additional steps of the Lanczos factorization. |
-c %------------------------------------------------------------%
-c
- ido = 0
- 20 continue
- update = .true.
-c
- call dsaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v,
- & ldv, h, ldh, ipntr, workd, info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
-c
-c %-----------------------------------------------------%
-c | dsaitr was unable to build an Lanczos factorization |
-c | of length NEV0+NP0. INFO is returned with the size |
-c | of the factorization built. Exit main loop. |
-c %-----------------------------------------------------%
-c
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
- update = .false.
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, 1, rnorm, ndigit,
- & '_saup2: Current B-norm of residual for factorization')
- end if
-c
-c %--------------------------------------------------------%
-c | Compute the eigenvalues and corresponding error bounds |
-c | of the current symmetric tridiagonal matrix. |
-c %--------------------------------------------------------%
-c
- call dseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, ierr)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 1200
- end if
-c
-c %----------------------------------------------------%
-c | Make a copy of eigenvalues and corresponding error |
-c | bounds obtained from _seigt. |
-c %----------------------------------------------------%
-c
- call dcopy(kplusp, ritz, 1, workl(kplusp+1), 1)
- call dcopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
-c
-c %---------------------------------------------------%
-c | Select the wanted Ritz values and their bounds |
-c | to be used in the convergence test. |
-c | The selection is based on the requested number of |
-c | eigenvalues instead of the current NEV and NP to |
-c | prevent possible misconvergence. |
-c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
-c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
-c %---------------------------------------------------%
-c
- nev = nev0
- np = np0
- call dsgets (ishift, which, nev, np, ritz, bounds, workl)
-c
-c %-------------------%
-c | Convergence test. |
-c %-------------------%
-c
- call dcopy (nev, bounds(np+1), 1, workl(np+1), 1)
- call dsconv (nev, ritz(np+1), workl(np+1), tol, nconv)
-c
- if (msglvl .gt. 2) then
- kp(1) = nev
- kp(2) = np
- kp(3) = nconv
- call ivout (logfil, 3, kp, ndigit,
- & '_saup2: NEV, NP, NCONV are')
- call dvout (logfil, kplusp, ritz, ndigit,
- & '_saup2: The eigenvalues of H')
- call dvout (logfil, kplusp, bounds, ndigit,
- & '_saup2: Ritz estimates of the current NCV Ritz values')
- end if
-c
-c %---------------------------------------------------------%
-c | Count the number of unwanted Ritz values that have zero |
-c | Ritz estimates. If any Ritz estimates are equal to zero |
-c | then a leading block of H of order equal to at least |
-c | the number of Ritz values with zero Ritz estimates has |
-c | split off. None of these Ritz values may be removed by |
-c | shifting. Decrease NP the number of shifts to apply. If |
-c | no shifts may be applied, then prepare to exit |
-c %---------------------------------------------------------%
-c
- nptemp = np
- do 30 j=1, nptemp
- if (bounds(j) .eq. zero) then
- np = np - 1
- nev = nev + 1
- end if
- 30 continue
-c
- if ( (nconv .ge. nev0) .or.
- & (iter .gt. mxiter) .or.
- & (np .eq. 0) ) then
-c
-c %------------------------------------------------%
-c | Prepare to exit. Put the converged Ritz values |
-c | and corresponding bounds in RITZ(1:NCONV) and |
-c | BOUNDS(1:NCONV) respectively. Then sort. Be |
-c | careful when NCONV > NP since we don't want to |
-c | swap overlapping locations. |
-c %------------------------------------------------%
-c
- if (which .eq. 'BE') then
-c
-c %-----------------------------------------------------%
-c | Both ends of the spectrum are requested. |
-c | Sort the eigenvalues into algebraically decreasing |
-c | order first then swap low end of the spectrum next |
-c | to high end in appropriate locations. |
-c | NOTE: when np < floor(nev/2) be careful not to swap |
-c | overlapping locations. |
-c %-----------------------------------------------------%
-c
- wprime = 'SA'
- call dsortr (wprime, .true., kplusp, ritz, bounds)
- nevd2 = nev0 / 2
- nevm2 = nev0 - nevd2
- if ( nev .gt. 1 ) then
- call dswap ( min(nevd2,np), ritz(nevm2+1), 1,
- & ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1)
- call dswap ( min(nevd2,np), bounds(nevm2+1), 1,
- & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1)
- end if
-c
- else
-c
-c %--------------------------------------------------%
-c | LM, SM, LA, SA case. |
-c | Sort the eigenvalues of H into the an order that |
-c | is opposite to WHICH, and apply the resulting |
-c | order to BOUNDS. The eigenvalues are sorted so |
-c | that the wanted part are always within the first |
-c | NEV locations. |
-c %--------------------------------------------------%
-c
- if (which .eq. 'LM') wprime = 'SM'
- if (which .eq. 'SM') wprime = 'LM'
- if (which .eq. 'LA') wprime = 'SA'
- if (which .eq. 'SA') wprime = 'LA'
-c
- call dsortr (wprime, .true., kplusp, ritz, bounds)
-c
- end if
-c
-c %--------------------------------------------------%
-c | Scale the Ritz estimate of each Ritz value |
-c | by 1 / max(eps23,magnitude of the Ritz value). |
-c %--------------------------------------------------%
-c
- do 35 j = 1, nev0
- temp = max( eps23, abs(ritz(j)) )
- bounds(j) = bounds(j)/temp
- 35 continue
-c
-c %----------------------------------------------------%
-c | Sort the Ritz values according to the scaled Ritz |
-c | esitmates. This will push all the converged ones |
-c | towards the front of ritzr, ritzi, bounds |
-c | (in the case when NCONV < NEV.) |
-c %----------------------------------------------------%
-c
- wprime = 'LA'
- call dsortr(wprime, .true., nev0, bounds, ritz)
-c
-c %----------------------------------------------%
-c | Scale the Ritz estimate back to its original |
-c | value. |
-c %----------------------------------------------%
-c
- do 40 j = 1, nev0
- temp = max( eps23, abs(ritz(j)) )
- bounds(j) = bounds(j)*temp
- 40 continue
-c
-c %--------------------------------------------------%
-c | Sort the "converged" Ritz values again so that |
-c | the "threshold" values and their associated Ritz |
-c | estimates appear at the appropriate position in |
-c | ritz and bound. |
-c %--------------------------------------------------%
-c
- if (which .eq. 'BE') then
-c
-c %------------------------------------------------%
-c | Sort the "converged" Ritz values in increasing |
-c | order. The "threshold" values are in the |
-c | middle. |
-c %------------------------------------------------%
-c
- wprime = 'LA'
- call dsortr(wprime, .true., nconv, ritz, bounds)
-c
- else
-c
-c %----------------------------------------------%
-c | In LM, SM, LA, SA case, sort the "converged" |
-c | Ritz values according to WHICH so that the |
-c | "threshold" value appears at the front of |
-c | ritz. |
-c %----------------------------------------------%
-
- call dsortr(which, .true., nconv, ritz, bounds)
-c
- end if
-c
-c %------------------------------------------%
-c | Use h( 1,1 ) as storage to communicate |
-c | rnorm to _seupd if needed |
-c %------------------------------------------%
-c
- h(1,1) = rnorm
-c
- if (msglvl .gt. 1) then
- call dvout (logfil, kplusp, ritz, ndigit,
- & '_saup2: Sorted Ritz values.')
- call dvout (logfil, kplusp, bounds, ndigit,
- & '_saup2: Sorted ritz estimates.')
- end if
-c
-c %------------------------------------%
-c | Max iterations have been exceeded. |
-c %------------------------------------%
-c
- if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
-c
-c %---------------------%
-c | No shifts to apply. |
-c %---------------------%
-c
- if (np .eq. 0 .and. nconv .lt. nev0) info = 2
-c
- np = nconv
- go to 1100
-c
- else if (nconv .lt. nev .and. ishift .eq. 1) then
-c
-c %---------------------------------------------------%
-c | Do not have all the requested eigenvalues yet. |
-c | To prevent possible stagnation, adjust the number |
-c | of Ritz values and the shifts. |
-c %---------------------------------------------------%
-c
- nevbef = nev
- nev = nev + min (nconv, np/2)
- if (nev .eq. 1 .and. kplusp .ge. 6) then
- nev = kplusp / 2
- else if (nev .eq. 1 .and. kplusp .gt. 2) then
- nev = 2
- end if
- np = kplusp - nev
-c
-c %---------------------------------------%
-c | If the size of NEV was just increased |
-c | resort the eigenvalues. |
-c %---------------------------------------%
-c
- if (nevbef .lt. nev)
- & call dsgets (ishift, which, nev, np, ritz, bounds,
- & workl)
-c
- end if
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, nconv, ndigit,
- & '_saup2: no. of "converged" Ritz values at this iter.')
- if (msglvl .gt. 1) then
- kp(1) = nev
- kp(2) = np
- call ivout (logfil, 2, kp, ndigit,
- & '_saup2: NEV and NP are')
- call dvout (logfil, nev, ritz(np+1), ndigit,
- & '_saup2: "wanted" Ritz values.')
- call dvout (logfil, nev, bounds(np+1), ndigit,
- & '_saup2: Ritz estimates of the "wanted" values ')
- end if
- end if
-
-c
- if (ishift .eq. 0) then
-c
-c %-----------------------------------------------------%
-c | User specified shifts: reverse communication to |
-c | compute the shifts. They are returned in the first |
-c | NP locations of WORKL. |
-c %-----------------------------------------------------%
-c
- ushift = .true.
- ido = 3
- go to 9000
- end if
-c
- 50 continue
-c
-c %------------------------------------%
-c | Back from reverse communication; |
-c | User specified shifts are returned |
-c | in WORKL(1:*NP) |
-c %------------------------------------%
-c
- ushift = .false.
-c
-c
-c %---------------------------------------------------------%
-c | Move the NP shifts to the first NP locations of RITZ to |
-c | free up WORKL. This is for the non-exact shift case; |
-c | in the exact shift case, dsgets already handles this. |
-c %---------------------------------------------------------%
-c
- if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1)
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, np, ndigit,
- & '_saup2: The number of shifts to apply ')
- call dvout (logfil, np, workl, ndigit,
- & '_saup2: shifts selected')
- if (ishift .eq. 1) then
- call dvout (logfil, np, bounds, ndigit,
- & '_saup2: corresponding Ritz estimates')
- end if
- end if
-c
-c %---------------------------------------------------------%
-c | Apply the NP0 implicit shifts by QR bulge chasing. |
-c | Each shift is applied to the entire tridiagonal matrix. |
-c | The first 2*N locations of WORKD are used as workspace. |
-c | After dsapps is done, we have a Lanczos |
-c | factorization of length NEV. |
-c %---------------------------------------------------------%
-c
- call dsapps (n, nev, np, ritz, v, ldv, h, ldh, resid, q, ldq,
- & workd)
-c
-c %---------------------------------------------%
-c | Compute the B-norm of the updated residual. |
-c | Keep B*RESID in WORKD(1:N) to be used in |
-c | the first step of the next call to dsaitr. |
-c %---------------------------------------------%
-c
- cnorm = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call dcopy (n, resid, 1, workd(n+1), 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*RESID |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call dcopy (n, resid, 1, workd, 1)
- end if
-c
- 100 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(1:N) := B*RESID |
-c %----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- if (bmat .eq. 'G') then
- rnorm = ddot (n, resid, 1, workd, 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = dnrm2(n, resid, 1)
- end if
- cnorm = .false.
- 130 continue
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, 1, rnorm, ndigit,
- & '_saup2: B-norm of residual for NEV factorization')
- call dvout (logfil, nev, h(1,2), ndigit,
- & '_saup2: main diagonal of compressed H matrix')
- call dvout (logfil, nev-1, h(2,1), ndigit,
- & '_saup2: subdiagonal of compressed H matrix')
- end if
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 1100 continue
-c
- mxiter = iter
- nev = nconv
-c
- 1200 continue
- ido = 99
-c
-c %------------%
-c | Error exit |
-c %------------%
-c
- call arscnd (t1)
- tsaup2 = t1 - t0
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dsaup2 |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsaupd.f b/netlib/ARPACK/dsaupd.f
deleted file mode 100644
index 1fbc14c..0000000
--- a/netlib/ARPACK/dsaupd.f
+++ /dev/null
@@ -1,690 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsaupd
-c
-c\Description:
-c
-c Reverse communication interface for the Implicitly Restarted Arnoldi
-c Iteration. For symmetric problems this reduces to a variant of the Lanczos
-c method. This method has been designed to compute approximations to a
-c few eigenpairs of a linear operator OP that is real and symmetric
-c with respect to a real positive semi-definite symmetric matrix B,
-c i.e.
-c
-c B*OP = (OP`)*B.
-c
-c Another way to express this condition is
-c
-c < x,OPy > = < OPx,y > where < z,w > = z`Bw .
-c
-c In the standard eigenproblem B is the identity matrix.
-c ( A` denotes transpose of A)
-c
-c The computed approximate eigenvalues are called Ritz values and
-c the corresponding approximate eigenvectors are called Ritz vectors.
-c
-c dsaupd is usually called iteratively to solve one of the
-c following problems:
-c
-c Mode 1: A*x = lambda*x, A symmetric
-c ===> OP = A and B = I.
-c
-c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
-c ===> OP = inv[M]*A and B = M.
-c ===> (If M can be factored see remark 3 below)
-c
-c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
-c ===> OP = (inv[K - sigma*M])*M and B = M.
-c ===> Shift-and-Invert mode
-c
-c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
-c KG symmetric indefinite
-c ===> OP = (inv[K - sigma*KG])*K and B = K.
-c ===> Buckling mode
-c
-c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
-c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
-c ===> Cayley transformed mode
-c
-c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
-c should be accomplished either by a direct method
-c using a sparse matrix factorization and solving
-c
-c [A - sigma*M]*w = v or M*w = v,
-c
-c or through an iterative method for solving these
-c systems. If an iterative method is used, the
-c convergence test must be more stringent than
-c the accuracy requirements for the eigenvalue
-c approximations.
-c
-c\Usage:
-c call dsaupd
-c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
-c IPNTR, WORKD, WORKL, LWORKL, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag. IDO must be zero on the first
-c call to dsaupd . IDO will be set internally to
-c indicate the type of operation to be performed. Control is
-c then given back to the calling routine which has the
-c responsibility to carry out the requested operation and call
-c dsaupd with the result. The operand is given in
-c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
-c (If Mode = 2 see remark 5 below)
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c This is for the initialization phase to force the
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c In mode 3,4 and 5, the vector B * X is already
-c available in WORKD(ipntr(3)). It does not
-c need to be recomputed in forming OP * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c IDO = 3: compute the IPARAM(8) shifts where
-c IPNTR(11) is the pointer into WORKL for
-c placing the shifts. See remark 6 below.
-c IDO = 99: done
-c -------------------------------------------------------------
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B that defines the
-c semi-inner product for the operator OP.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c WHICH Character*2. (INPUT)
-c Specify which of the Ritz values of OP to compute.
-c
-c 'LA' - compute the NEV largest (algebraic) eigenvalues.
-c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
-c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
-c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
-c 'BE' - compute NEV eigenvalues, half from each end of the
-c spectrum. When NEV is odd, compute one more from the
-c high end than from the low end.
-c (see remark 1 below)
-c
-c NEV Integer. (INPUT)
-c Number of eigenvalues of OP to be computed. 0 < NEV < N.
-c
-c TOL Double precision scalar. (INPUT)
-c Stopping criterion: the relative accuracy of the Ritz value
-c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)).
-c If TOL .LE. 0. is passed a default is set:
-c DEFAULT = DLAMCH ('EPS') (machine precision as computed
-c by the LAPACK auxiliary subroutine DLAMCH ).
-c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
-c On INPUT:
-c If INFO .EQ. 0, a random initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c On OUTPUT:
-c RESID contains the final residual vector.
-c
-c NCV Integer. (INPUT)
-c Number of columns of the matrix V (less than or equal to N).
-c This will indicate how many Lanczos vectors are generated
-c at each iteration. After the startup phase in which NEV
-c Lanczos vectors are generated, the algorithm generates
-c NCV-NEV Lanczos vectors at each subsequent update iteration.
-c Most of the cost in generating each Lanczos vector is in the
-c matrix-vector product OP*x. (See remark 4 below).
-c
-c V Double precision N by NCV array. (OUTPUT)
-c The NCV columns of V contain the Lanczos basis vectors.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c IPARAM Integer array of length 11. (INPUT/OUTPUT)
-c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
-c The shifts selected at each iteration are used to restart
-c the Arnoldi iteration in an implicit fashion.
-c -------------------------------------------------------------
-c ISHIFT = 0: the shifts are provided by the user via
-c reverse communication. The NCV eigenvalues of
-c the current tridiagonal matrix T are returned in
-c the part of WORKL array corresponding to RITZ.
-c See remark 6 below.
-c ISHIFT = 1: exact shifts with respect to the reduced
-c tridiagonal matrix T. This is equivalent to
-c restarting the iteration with a starting vector
-c that is a linear combination of Ritz vectors
-c associated with the "wanted" Ritz values.
-c -------------------------------------------------------------
-c
-c IPARAM(2) = LEVEC
-c No longer referenced. See remark 2 below.
-c
-c IPARAM(3) = MXITER
-c On INPUT: maximum number of Arnoldi update iterations allowed.
-c On OUTPUT: actual number of Arnoldi update iterations taken.
-c
-c IPARAM(4) = NB: blocksize to be used in the recurrence.
-c The code currently works only for NB = 1.
-c
-c IPARAM(5) = NCONV: number of "converged" Ritz values.
-c This represents the number of Ritz values that satisfy
-c the convergence criterion.
-c
-c IPARAM(6) = IUPD
-c No longer referenced. Implicit restarting is ALWAYS used.
-c
-c IPARAM(7) = MODE
-c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4,5; See under \Description of dsaupd for the
-c five modes available.
-c
-c IPARAM(8) = NP
-c When ido = 3 and the user provides shifts through reverse
-c communication (IPARAM(1)=0), dsaupd returns NP, the number
-c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
-c 6 below.
-c
-c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
-c OUTPUT: NUMOP = total number of OP*x operations,
-c NUMOPB = total number of B*x operations if BMAT='G',
-c NUMREO = total number of steps of re-orthogonalization.
-c
-c IPNTR Integer array of length 11. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD and WORKL
-c arrays for matrices/vectors used by the Lanczos iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X in WORKD.
-c IPNTR(2): pointer to the current result vector Y in WORKD.
-c IPNTR(3): pointer to the vector B * X in WORKD when used in
-c the shift-and-invert mode.
-c IPNTR(4): pointer to the next available location in WORKL
-c that is untouched by the program.
-c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
-c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
-c IPNTR(7): pointer to the Ritz estimates in array WORKL associated
-c with the Ritz values located in RITZ in WORKL.
-c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below.
-c
-c Note: IPNTR(8:10) is only referenced by dseupd . See Remark 2.
-c IPNTR(8): pointer to the NCV RITZ values of the original system.
-c IPNTR(9): pointer to the NCV corresponding error bounds.
-c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors
-c of the tridiagonal matrix T. Only referenced by
-c dseupd if RVEC = .TRUE. See Remarks.
-c -------------------------------------------------------------
-c
-c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration. Upon termination
-c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired
-c subroutine dseupd uses this output.
-c See Data Distribution Note below.
-c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. See Data Distribution Note below.
-c
-c LWORKL Integer. (INPUT)
-c LWORKL must be at least NCV**2 + 8*NCV .
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal exit.
-c = 1: Maximum number of iterations taken.
-c All possible eigenvalues of OP has been found. IPARAM(5)
-c returns the number of wanted converged Ritz values.
-c = 2: No longer an informational error. Deprecated starting
-c with release 2 of ARPACK.
-c = 3: No shifts could be applied during a cycle of the
-c Implicitly restarted Arnoldi iteration. One possibility
-c is to increase the size of NCV relative to NEV.
-c See remark 4 below.
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV must be greater than NEV and less than or equal to N.
-c = -4: The maximum number of Arnoldi update iterations allowed
-c must be greater than zero.
-c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work array WORKL is not sufficient.
-c = -8: Error return from trid. eigenvalue calculation;
-c Informatinal error from LAPACK routine dsteqr .
-c = -9: Starting vector is zero.
-c = -10: IPARAM(7) must be 1,2,3,4,5.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
-c = -12: IPARAM(1) must be equal to 0 or 1.
-c = -13: NEV and WHICH = 'BE' are incompatable.
-c = -9999: Could not build an Arnoldi factorization.
-c IPARAM(5) returns the size of the current Arnoldi
-c factorization. The user is advised to check that
-c enough workspace and array storage has been allocated.
-c
-c
-c\Remarks
-c 1. The converged Ritz values are always returned in ascending
-c algebraic order. The computed Ritz values are approximate
-c eigenvalues of OP. The selection of WHICH should be made
-c with this in mind when Mode = 3,4,5. After convergence,
-c approximate eigenvalues of the original problem may be obtained
-c with the ARPACK subroutine dseupd .
-c
-c 2. If the Ritz vectors corresponding to the converged Ritz values
-c are needed, the user must call dseupd immediately following completion
-c of dsaupd . This is new starting with version 2.1 of ARPACK.
-c
-c 3. If M can be factored into a Cholesky factorization M = LL`
-c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
-c linear systems should be solved with L and L` rather
-c than computing inverses. After convergence, an approximate
-c eigenvector z of the original problem is recovered by solving
-c L`z = x where x is a Ritz vector of OP.
-c
-c 4. At present there is no a-priori analysis to guide the selection
-c of NCV relative to NEV. The only formal requrement is that NCV > NEV.
-c However, it is recommended that NCV .ge. 2*NEV. If many problems of
-c the same type are to be solved, one should experiment with increasing
-c NCV while keeping NEV fixed for a given test problem. This will
-c usually decrease the required number of OP*x operations but it
-c also increases the work and storage required to maintain the orthogonal
-c basis vectors. The optimal "cross-over" with respect to CPU time
-c is problem dependent and must be determined empirically.
-c
-c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
-c must do the following. When IDO = 1, Y = OP * X is to be computed.
-c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
-c must overwrite X with A*X. Y is then the solution to the linear set
-c of equations B*Y = A*X.
-c
-c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
-c NP = IPARAM(8) shifts in locations:
-c 1 WORKL(IPNTR(11))
-c 2 WORKL(IPNTR(11)+1)
-c .
-c .
-c .
-c NP WORKL(IPNTR(11)+NP-1).
-c
-c The eigenvalues of the current tridiagonal matrix are located in
-c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
-c order defined by WHICH. The associated Ritz estimates are located in
-c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
-c
-c-----------------------------------------------------------------------
-c
-c\Data Distribution Note:
-c
-c Fortran-D syntax:
-c ================
-c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
-c DECOMPOSE D1(N), D2(N,NCV)
-c ALIGN RESID(I) with D1(I)
-c ALIGN V(I,J) with D2(I,J)
-c ALIGN WORKD(I) with D1(I) range (1:N)
-c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
-c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
-c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
-c REPLICATED WORKL(LWORKL)
-c
-c Cray MPP syntax:
-c ===============
-c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
-c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
-c REPLICATED WORKL(LWORKL)
-c
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
-c 1980.
-c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
-c Computer Physics Communications, 53 (1989), pp 169-179.
-c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
-c Implement the Spectral Transformation", Math. Comp., 48 (1987),
-c pp 663-673.
-c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
-c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
-c SIAM J. Matr. Anal. Apps., January (1993).
-c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
-c for Updating the QR decomposition", ACM TOMS, December 1990,
-c Volume 16 Number 4, pp 369-377.
-c 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral
-c Transformations in a k-Step Arnoldi Method". In Preparation.
-c
-c\Routines called:
-c dsaup2 ARPACK routine that implements the Implicitly Restarted
-c Arnoldi Iteration.
-c dstats ARPACK routine that initialize timing and other statistics
-c variables.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
-c
-c\Remarks
-c 1. None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsaupd
- & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam,
- & ipntr, workd, workl, lworkl, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ldv, lworkl, n, ncv, nev
- Double precision
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(11), ipntr(11)
- Double precision
- & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0 , zero = 0.0D+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer bounds, ierr, ih, iq, ishift, iupd, iw,
- & ldh, ldq, msglvl, mxiter, mode, nb,
- & nev0, next, np, ritz, j
- save bounds, ierr, ih, iq, ishift, iupd, iw,
- & ldh, ldq, msglvl, mxiter, mode, nb,
- & nev0, next, np, ritz
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dsaup2 , dvout , ivout, arscnd, dstats
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlamch
- external dlamch
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call dstats
- call arscnd (t0)
- msglvl = msaupd
-c
- ierr = 0
- ishift = iparam(1)
- mxiter = iparam(3)
-c nb = iparam(4)
- nb = 1
-c
-c %--------------------------------------------%
-c | Revision 2 performs only implicit restart. |
-c %--------------------------------------------%
-c
- iupd = 1
- mode = iparam(7)
-c
-c %----------------%
-c | Error checking |
-c %----------------%
-c
- if (n .le. 0) then
- ierr = -1
- else if (nev .le. 0) then
- ierr = -2
- else if (ncv .le. nev .or. ncv .gt. n) then
- ierr = -3
- end if
-c
-c %----------------------------------------------%
-c | NP is the number of additional steps to |
-c | extend the length NEV Lanczos factorization. |
-c %----------------------------------------------%
-c
- np = ncv - nev
-c
- if (mxiter .le. 0) ierr = -4
- if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LA' .and.
- & which .ne. 'SA' .and.
- & which .ne. 'BE') ierr = -5
- if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
-c
- if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
- if (mode .lt. 1 .or. mode .gt. 5) then
- ierr = -10
- else if (mode .eq. 1 .and. bmat .eq. 'G') then
- ierr = -11
- else if (ishift .lt. 0 .or. ishift .gt. 1) then
- ierr = -12
- else if (nev .eq. 1 .and. which .eq. 'BE') then
- ierr = -13
- end if
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- ido = 99
- go to 9000
- end if
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- if (nb .le. 0) nb = 1
- if (tol .le. zero) tol = dlamch ('EpsMach')
-c
-c %----------------------------------------------%
-c | NP is the number of additional steps to |
-c | extend the length NEV Lanczos factorization. |
-c | NEV0 is the local variable designating the |
-c | size of the invariant subspace desired. |
-c %----------------------------------------------%
-c
- np = ncv - nev
- nev0 = nev
-c
-c %-----------------------------%
-c | Zero out internal workspace |
-c %-----------------------------%
-c
- do 10 j = 1, ncv**2 + 8*ncv
- workl(j) = zero
- 10 continue
-c
-c %-------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:2*ncv) := generated tridiagonal matrix |
-c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
-c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
-c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
-c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
-c %-------------------------------------------------------%
-c
- ldh = ncv
- ldq = ncv
- ih = 1
- ritz = ih + 2*ldh
- bounds = ritz + ncv
- iq = bounds + ncv
- iw = iq + ncv**2
- next = iw + 3*ncv
-c
- ipntr(4) = next
- ipntr(5) = ih
- ipntr(6) = ritz
- ipntr(7) = bounds
- ipntr(11) = iw
- end if
-c
-c %-------------------------------------------------------%
-c | Carry out the Implicitly restarted Lanczos Iteration. |
-c %-------------------------------------------------------%
-c
- call dsaup2
- & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz),
- & workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd,
- & info )
-c
-c %--------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP or shifts. |
-c %--------------------------------------------------%
-c
- if (ido .eq. 3) iparam(8) = np
- if (ido .ne. 99) go to 9000
-c
- iparam(3) = mxiter
- iparam(5) = np
- iparam(9) = nopx
- iparam(10) = nbx
- iparam(11) = nrorth
-c
-c %------------------------------------%
-c | Exit if there was an informational |
-c | error within dsaup2 . |
-c %------------------------------------%
-c
- if (info .lt. 0) go to 9000
- if (info .eq. 2) info = 3
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, mxiter, ndigit,
- & '_saupd: number of update iterations taken')
- call ivout (logfil, 1, np, ndigit,
- & '_saupd: number of "converged" Ritz values')
- call dvout (logfil, np, workl(Ritz), ndigit,
- & '_saupd: final Ritz values')
- call dvout (logfil, np, workl(Bounds), ndigit,
- & '_saupd: corresponding error bounds')
- end if
-c
- call arscnd (t1)
- tsaupd = t1 - t0
-c
- if (msglvl .gt. 0) then
-c
-c %--------------------------------------------------------%
-c | Version Number & Version Date are defined in version.h |
-c %--------------------------------------------------------%
-c
- write (6,1000)
- write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
- & tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
- & tgetv0, tseigt, tsgets, tsapps, tsconv
- 1000 format (//,
- & 5x, '==========================================',/
- & 5x, '= Symmetric implicit Arnoldi update code =',/
- & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/
- & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/
- & 5x, '==========================================',/
- & 5x, '= Summary of timing statistics =',/
- & 5x, '==========================================',//)
- 1100 format (
- & 5x, 'Total number update iterations = ', i5,/
- & 5x, 'Total number of OP*x operations = ', i5,/
- & 5x, 'Total number of B*x operations = ', i5,/
- & 5x, 'Total number of reorthogonalization steps = ', i5,/
- & 5x, 'Total number of iterative refinement steps = ', i5,/
- & 5x, 'Total number of restart steps = ', i5,/
- & 5x, 'Total time in user OP*x operation = ', f12.6,/
- & 5x, 'Total time in user B*x operation = ', f12.6,/
- & 5x, 'Total time in Arnoldi update routine = ', f12.6,/
- & 5x, 'Total time in saup2 routine = ', f12.6,/
- & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
- & 5x, 'Total time in reorthogonalization phase = ', f12.6,/
- & 5x, 'Total time in (re)start vector generation = ', f12.6,/
- & 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
- & 5x, 'Total time in getting the shifts = ', f12.6,/
- & 5x, 'Total time in applying the shifts = ', f12.6,/
- & 5x, 'Total time in convergence testing = ', f12.6)
- end if
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of dsaupd |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsconv.f b/netlib/ARPACK/dsconv.f
deleted file mode 100644
index f31dee7..0000000
--- a/netlib/ARPACK/dsconv.f
+++ /dev/null
@@ -1,138 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsconv
-c
-c\Description:
-c Convergence testing for the symmetric Arnoldi eigenvalue routine.
-c
-c\Usage:
-c call dsconv
-c ( N, RITZ, BOUNDS, TOL, NCONV )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Number of Ritz values to check for convergence.
-c
-c RITZ Double precision array of length N. (INPUT)
-c The Ritz values to be checked for convergence.
-c
-c BOUNDS Double precision array of length N. (INPUT)
-c Ritz estimates associated with the Ritz values in RITZ.
-c
-c TOL Double precision scalar. (INPUT)
-c Desired relative accuracy for a Ritz value to be considered
-c "converged".
-c
-c NCONV Integer scalar. (OUTPUT)
-c Number of "converged" Ritz values.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Routines called:
-c arscnd ARPACK utility routine for timing.
-c dlamch LAPACK routine that determines machine constants.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\Remarks
-c 1. Starting with version 2.4, this routine no longer uses the
-c Parlett strategy using the gap conditions.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsconv (n, ritz, bounds, tol, nconv)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer n, nconv
- Double precision
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & ritz(n), bounds(n)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i
- Double precision
- & temp, eps23
-c
-c %-------------------%
-c | External routines |
-c %-------------------%
-c
- Double precision
- & dlamch
- external dlamch
-
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- call arscnd (t0)
-c
- eps23 = dlamch('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0)
-c
- nconv = 0
- do 10 i = 1, n
-c
-c %-----------------------------------------------------%
-c | The i-th Ritz value is considered "converged" |
-c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) |
-c %-----------------------------------------------------%
-c
- temp = max( eps23, abs(ritz(i)) )
- if ( bounds(i) .le. tol*temp ) then
- nconv = nconv + 1
- end if
-c
- 10 continue
-c
- call arscnd (t1)
- tsconv = tsconv + (t1 - t0)
-c
- return
-c
-c %---------------%
-c | End of dsconv |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dseigt.f b/netlib/ARPACK/dseigt.f
deleted file mode 100644
index cb78a89..0000000
--- a/netlib/ARPACK/dseigt.f
+++ /dev/null
@@ -1,181 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dseigt
-c
-c\Description:
-c Compute the eigenvalues of the current symmetric tridiagonal matrix
-c and the corresponding error bounds given the current residual norm.
-c
-c\Usage:
-c call dseigt
-c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
-c
-c\Arguments
-c RNORM Double precision scalar. (INPUT)
-c RNORM contains the residual norm corresponding to the current
-c symmetric tridiagonal matrix H.
-c
-c N Integer. (INPUT)
-c Size of the symmetric tridiagonal matrix H.
-c
-c H Double precision N by 2 array. (INPUT)
-c H contains the symmetric tridiagonal matrix with the
-c subdiagonal in the first column starting at H(2,1) and the
-c main diagonal in second column.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c EIG Double precision array of length N. (OUTPUT)
-c On output, EIG contains the N eigenvalues of H possibly
-c unsorted. The BOUNDS arrays are returned in the
-c same sorted order as EIG.
-c
-c BOUNDS Double precision array of length N. (OUTPUT)
-c On output, BOUNDS contains the error estimates corresponding
-c to the eigenvalues EIG. This is equal to RNORM times the
-c last components of the eigenvectors corresponding to the
-c eigenvalues in EIG.
-c
-c WORKL Double precision work array of length 3*N. (WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end.
-c
-c IERR Integer. (OUTPUT)
-c Error exit flag from dstqrb.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c dstqrb ARPACK routine that computes the eigenvalues and the
-c last components of the eigenvectors of a symmetric
-c and tridiagonal matrix.
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dcopy Level 1 BLAS that copies one vector to another.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dseigt
- & ( rnorm, n, h, ldh, eig, bounds, workl, ierr )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer ierr, ldh, n
- Double precision
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & eig(n), bounds(n), h(ldh,2), workl(3*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & zero
- parameter (zero = 0.0D+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, k, msglvl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy, dstqrb, dvout, arscnd
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mseigt
-c
- if (msglvl .gt. 0) then
- call dvout (logfil, n, h(1,2), ndigit,
- & '_seigt: main diagonal of matrix H')
- if (n .gt. 1) then
- call dvout (logfil, n-1, h(2,1), ndigit,
- & '_seigt: sub diagonal of matrix H')
- end if
- end if
-c
- call dcopy (n, h(1,2), 1, eig, 1)
- call dcopy (n-1, h(2,1), 1, workl, 1)
- call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
- if (ierr .ne. 0) go to 9000
- if (msglvl .gt. 1) then
- call dvout (logfil, n, bounds, ndigit,
- & '_seigt: last row of the eigenvector matrix for H')
- end if
-c
-c %-----------------------------------------------%
-c | Finally determine the error bounds associated |
-c | with the n Ritz values of H. |
-c %-----------------------------------------------%
-c
- do 30 k = 1, n
- bounds(k) = rnorm*abs(bounds(k))
- 30 continue
-c
- call arscnd (t1)
- tseigt = tseigt + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dseigt |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsesrt.f b/netlib/ARPACK/dsesrt.f
deleted file mode 100644
index 2b4ca8c..0000000
--- a/netlib/ARPACK/dsesrt.f
+++ /dev/null
@@ -1,217 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsesrt
-c
-c\Description:
-c Sort the array X in the order specified by WHICH and optionally
-c apply the permutation to the columns of the matrix A.
-c
-c\Usage:
-c call dsesrt
-c ( WHICH, APPLY, N, X, NA, A, LDA)
-c
-c\Arguments
-c WHICH Character*2. (Input)
-c 'LM' -> X is sorted into increasing order of magnitude.
-c 'SM' -> X is sorted into decreasing order of magnitude.
-c 'LA' -> X is sorted into increasing order of algebraic.
-c 'SA' -> X is sorted into decreasing order of algebraic.
-c
-c APPLY Logical. (Input)
-c APPLY = .TRUE. -> apply the sorted order to A.
-c APPLY = .FALSE. -> do not apply the sorted order to A.
-c
-c N Integer. (INPUT)
-c Dimension of the array X.
-c
-c X Double precision array of length N. (INPUT/OUTPUT)
-c The array to be sorted.
-c
-c NA Integer. (INPUT)
-c Number of rows of the matrix A.
-c
-c A Double precision array of length NA by N. (INPUT/OUTPUT)
-c
-c LDA Integer. (INPUT)
-c Leading dimension of A.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Routines
-c dswap Level 1 BLAS that swaps the contents of two vectors.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.1'.
-c Adapted from the sort routine in LANSO and
-c the ARPACK code dsortr
-c
-c\SCCS Information: @(#)
-c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsesrt (which, apply, n, x, na, a, lda)
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- logical apply
- integer lda, n, na
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & x(0:n-1), a(lda, 0:n-1)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, igap, j
- Double precision
- & temp
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dswap
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- igap = n / 2
-c
- if (which .eq. 'SA') then
-c
-c X is sorted into decreasing order of algebraic.
-c
- 10 continue
- if (igap .eq. 0) go to 9000
- do 30 i = igap, n-1
- j = i-igap
- 20 continue
-c
- if (j.lt.0) go to 30
-c
- if (x(j).lt.x(j+igap)) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 30
- endif
- j = j-igap
- go to 20
- 30 continue
- igap = igap / 2
- go to 10
-c
- else if (which .eq. 'SM') then
-c
-c X is sorted into decreasing order of magnitude.
-c
- 40 continue
- if (igap .eq. 0) go to 9000
- do 60 i = igap, n-1
- j = i-igap
- 50 continue
-c
- if (j.lt.0) go to 60
-c
- if (abs(x(j)).lt.abs(x(j+igap))) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 60
- endif
- j = j-igap
- go to 50
- 60 continue
- igap = igap / 2
- go to 40
-c
- else if (which .eq. 'LA') then
-c
-c X is sorted into increasing order of algebraic.
-c
- 70 continue
- if (igap .eq. 0) go to 9000
- do 90 i = igap, n-1
- j = i-igap
- 80 continue
-c
- if (j.lt.0) go to 90
-c
- if (x(j).gt.x(j+igap)) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 90
- endif
- j = j-igap
- go to 80
- 90 continue
- igap = igap / 2
- go to 70
-c
- else if (which .eq. 'LM') then
-c
-c X is sorted into increasing order of magnitude.
-c
- 100 continue
- if (igap .eq. 0) go to 9000
- do 120 i = igap, n-1
- j = i-igap
- 110 continue
-c
- if (j.lt.0) go to 120
-c
- if (abs(x(j)).gt.abs(x(j+igap))) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 120
- endif
- j = j-igap
- go to 110
- 120 continue
- igap = igap / 2
- go to 100
- end if
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dsesrt |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dseupd.f b/netlib/ARPACK/dseupd.f
deleted file mode 100644
index c18ef22..0000000
--- a/netlib/ARPACK/dseupd.f
+++ /dev/null
@@ -1,867 +0,0 @@
-c\BeginDoc
-c
-c\Name: dseupd
-c
-c\Description:
-c
-c This subroutine returns the converged approximations to eigenvalues
-c of A*z = lambda*B*z and (optionally):
-c
-c (1) the corresponding approximate eigenvectors,
-c
-c (2) an orthonormal (Lanczos) basis for the associated approximate
-c invariant subspace,
-c
-c (3) Both.
-c
-c There is negligible additional cost to obtain eigenvectors. An orthonormal
-c (Lanczos) basis is always computed. There is an additional storage cost
-c of n*nev if both are requested (in this case a separate array Z must be
-c supplied).
-c
-c These quantities are obtained from the Lanczos factorization computed
-c by DSAUPD for the linear operator OP prescribed by the MODE selection
-c (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before
-c this routine is called. These approximate eigenvalues and vectors are
-c commonly called Ritz values and Ritz vectors respectively. They are
-c referred to as such in the comments that follow. The computed orthonormal
-c basis for the invariant subspace corresponding to these Ritz values is
-c referred to as a Lanczos basis.
-c
-c See documentation in the header of the subroutine DSAUPD for a definition
-c of OP as well as other terms and the relation of computed Ritz values
-c and vectors of OP with respect to the given problem A*z = lambda*B*z.
-c
-c The approximate eigenvalues of the original problem are returned in
-c ascending algebraic order. The user may elect to call this routine
-c once for each desired Ritz vector and store it peripherally if desired.
-c There is also the option of computing a selected set of these vectors
-c with a single call.
-c
-c\Usage:
-c call dseupd
-c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
-c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
-c
-c RVEC LOGICAL (INPUT)
-c Specifies whether Ritz vectors corresponding to the Ritz value
-c approximations to the eigenproblem A*z = lambda*B*z are computed.
-c
-c RVEC = .FALSE. Compute Ritz values only.
-c
-c RVEC = .TRUE. Compute Ritz vectors.
-c
-c HOWMNY Character*1 (INPUT)
-c Specifies how many Ritz vectors are wanted and the form of Z
-c the matrix of Ritz vectors. See remark 1 below.
-c = 'A': compute NEV Ritz vectors;
-c = 'S': compute some of the Ritz vectors, specified
-c by the logical array SELECT.
-c
-c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE)
-c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
-c computed. To select the Ritz vector corresponding to a
-c Ritz value D(j), SELECT(j) must be set to .TRUE..
-c If HOWMNY = 'A' , SELECT is used as a workspace for
-c reordering the Ritz values.
-c
-c D Double precision array of dimension NEV. (OUTPUT)
-c On exit, D contains the Ritz value approximations to the
-c eigenvalues of A*z = lambda*B*z. The values are returned
-c in ascending order. If IPARAM(7) = 3,4,5 then D represents
-c the Ritz values of OP computed by dsaupd transformed to
-c those of the original eigensystem A*z = lambda*B*z. If
-c IPARAM(7) = 1,2 then the Ritz values of OP are the same
-c as the those of A*z = lambda*B*z.
-c
-c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT)
-c On exit, Z contains the B-orthonormal Ritz vectors of the
-c eigensystem A*z = lambda*B*z corresponding to the Ritz
-c value approximations.
-c If RVEC = .FALSE. then Z is not referenced.
-c NOTE: The array Z may be set equal to first NEV columns of the
-c Arnoldi/Lanczos basis array V computed by DSAUPD .
-c
-c LDZ Integer. (INPUT)
-c The leading dimension of the array Z. If Ritz vectors are
-c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1.
-c
-c SIGMA Double precision (INPUT)
-c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if
-c IPARAM(7) = 1 or 2.
-c
-c
-c **** The remaining arguments MUST be the same as for the ****
-c **** call to DSAUPD that was just completed. ****
-c
-c NOTE: The remaining arguments
-c
-c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR,
-c WORKD, WORKL, LWORKL, INFO
-c
-c must be passed directly to DSEUPD following the last call
-c to DSAUPD . These arguments MUST NOT BE MODIFIED between
-c the the last call to DSAUPD and the call to DSEUPD .
-c
-c Two of these parameters (WORKL, INFO) are also output parameters:
-c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
-c WORKL(1:4*ncv) contains information obtained in
-c dsaupd . They are not changed by dseupd .
-c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the
-c untransformed Ritz values, the computed error estimates,
-c and the associated eigenvector matrix of H.
-c
-c Note: IPNTR(8:10) contains the pointer into WORKL for addresses
-c of the above information computed by dseupd .
-c -------------------------------------------------------------
-c IPNTR(8): pointer to the NCV RITZ values of the original system.
-c IPNTR(9): pointer to the NCV corresponding error bounds.
-c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors
-c of the tridiagonal matrix T. Only referenced by
-c dseupd if RVEC = .TRUE. See Remarks.
-c -------------------------------------------------------------
-c
-c INFO Integer. (OUTPUT)
-c Error flag on output.
-c = 0: Normal exit.
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV must be greater than NEV and less than or equal to N.
-c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work WORKL array is not sufficient.
-c = -8: Error return from trid. eigenvalue calculation;
-c Information error from LAPACK routine dsteqr .
-c = -9: Starting vector is zero.
-c = -10: IPARAM(7) must be 1,2,3,4,5.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
-c = -12: NEV and WHICH = 'BE' are incompatible.
-c = -14: DSAUPD did not find any eigenvalues to sufficient
-c accuracy.
-c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true.
-c = -16: HOWMNY = 'S' not yet implemented
-c = -17: DSEUPD got a different count of the number of converged
-c Ritz values than DSAUPD got. This indicates the user
-c probably made an error in passing data from DSAUPD to
-c DSEUPD or that the data was modified before entering
-c DSEUPD .
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
-c 1980.
-c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
-c Computer Physics Communications, 53 (1989), pp 169-179.
-c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
-c Implement the Spectral Transformation", Math. Comp., 48 (1987),
-c pp 663-673.
-c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
-c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
-c SIAM J. Matr. Anal. Apps., January (1993).
-c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
-c for Updating the QR decomposition", ACM TOMS, December 1990,
-c Volume 16 Number 4, pp 369-377.
-c
-c\Remarks
-c 1. The converged Ritz values are always returned in increasing
-c (algebraic) order.
-c
-c 2. Currently only HOWMNY = 'A' is implemented. It is included at this
-c stage for the user who wants to incorporate it.
-c
-c\Routines called:
-c dsesrt ARPACK routine that sorts an array X, and applies the
-c corresponding permutation to a matrix A.
-c dsortr dsortr ARPACK sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c dvout ARPACK utility routine that prints vectors.
-c dgeqr2 LAPACK routine that computes the QR factorization of
-c a matrix.
-c dlacpy LAPACK matrix copy routine.
-c dlamch LAPACK routine that determines machine constants.
-c dorm2r LAPACK routine that applies an orthogonal matrix in
-c factored form.
-c dsteqr LAPACK routine that computes eigenvalues and eigenvectors
-c of a tridiagonal matrix.
-c dger Level 2 BLAS rank one update to a matrix.
-c dcopy Level 1 BLAS that copies one vector to another .
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dscal Level 1 BLAS that scales a vector.
-c dswap Level 1 BLAS that swaps the contents of two vectors.
-
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Chao Yang Houston, Texas
-c Dept. of Computational &
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
- subroutine dseupd (rvec , howmny, select, d ,
- & z , ldz , sigma , bmat ,
- & n , which , nev , tol ,
- & resid , ncv , v , ldv ,
- & iparam, ipntr , workd , workl,
- & lworkl, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat, howmny, which*2
- logical rvec
- integer info, ldz, ldv, lworkl, n, ncv, nev
- Double precision
- & sigma, tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(7), ipntr(11)
- logical select(ncv)
- Double precision
- & d(nev) , resid(n) , v(ldv,ncv),
- & z(ldz, nev), workd(2*n), workl(lworkl)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0 , zero = 0.0D+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character type*6
- integer bounds , ierr , ih , ihb , ihd ,
- & iq , iw , j , k , ldh ,
- & ldq , mode , msglvl, nconv , next ,
- & ritz , irz , ibd , np , ishift,
- & leftptr, rghtptr, numcnv, jj
- Double precision
- & bnorm2 , rnorm, temp, temp1, eps23
- logical reord
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dcopy , dger , dgeqr2 , dlacpy , dorm2r , dscal ,
- & dsesrt , dsteqr , dswap , dvout , ivout , dsortr
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dnrm2 , dlamch
- external dnrm2 , dlamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic min
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- msglvl = mseupd
- mode = iparam(7)
- nconv = iparam(5)
- info = 0
-c
-c %--------------%
-c | Quick return |
-c %--------------%
-c
- if (nconv .eq. 0) go to 9000
- ierr = 0
-c
- if (nconv .le. 0) ierr = -14
- if (n .le. 0) ierr = -1
- if (nev .le. 0) ierr = -2
- if (ncv .le. nev .or. ncv .gt. n) ierr = -3
- if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LA' .and.
- & which .ne. 'SA' .and.
- & which .ne. 'BE') ierr = -5
- if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
- if ( (howmny .ne. 'A' .and.
- & howmny .ne. 'P' .and.
- & howmny .ne. 'S') .and. rvec )
- & ierr = -15
- if (rvec .and. howmny .eq. 'S') ierr = -16
-c
- if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
-c
- if (mode .eq. 1 .or. mode .eq. 2) then
- type = 'REGULR'
- else if (mode .eq. 3 ) then
- type = 'SHIFTI'
- else if (mode .eq. 4 ) then
- type = 'BUCKLE'
- else if (mode .eq. 5 ) then
- type = 'CAYLEY'
- else
- ierr = -10
- end if
- if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
- if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- go to 9000
- end if
-c
-c %-------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:2*ncv) := generated tridiagonal matrix H |
-c | The subdiagonal is stored in workl(2:ncv). |
-c | The dead spot is workl(1) but upon exiting |
-c | dsaupd stores the B-norm of the last residual |
-c | vector in workl(1). We use this !!! |
-c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
-c | The wanted values are in the first NCONV spots. |
-c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates |
-c | The wanted values are in the first NCONV spots. |
-c | NOTE: workl(1:4*ncv) is set by dsaupd and is not |
-c | modified by dseupd . |
-c %-------------------------------------------------------%
-c
-c %-------------------------------------------------------%
-c | The following is used and set by dseupd . |
-c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during |
-c | computation of the eigenvectors of H. Stores |
-c | the diagonal of H. Upon EXIT contains the NCV |
-c | Ritz values of the original system. The first |
-c | NCONV spots have the wanted values. If MODE = |
-c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
-c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
-c | computation of the eigenvectors of H. Stores |
-c | the subdiagonal of H. Upon EXIT contains the |
-c | NCV corresponding Ritz estimates of the |
-c | original system. The first NCONV spots have the |
-c | wanted values. If MODE = 1,2 then will equal |
-c | workl(3*ncv+1:4*ncv). |
-c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is |
-c | the eigenvector matrix for H as returned by |
-c | dsteqr . Not referenced if RVEC = .False. |
-c | Ordering follows that of workl(4*ncv+1:5*ncv) |
-c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := |
-c | Workspace. Needed by dsteqr and by dseupd . |
-c | GRAND total of NCV*(NCV+8) locations. |
-c %-------------------------------------------------------%
-c
-c
- ih = ipntr(5)
- ritz = ipntr(6)
- bounds = ipntr(7)
- ldh = ncv
- ldq = ncv
- ihd = bounds + ldh
- ihb = ihd + ldh
- iq = ihb + ldh
- iw = iq + ldh*ncv
- next = iw + 2*ncv
- ipntr(4) = next
- ipntr(8) = ihd
- ipntr(9) = ihb
- ipntr(10) = iq
-c
-c %----------------------------------------%
-c | irz points to the Ritz values computed |
-c | by _seigt before exiting _saup2. |
-c | ibd points to the Ritz estimates |
-c | computed by _seigt before exiting |
-c | _saup2. |
-c %----------------------------------------%
-c
- irz = ipntr(11)+ncv
- ibd = irz+ncv
-c
-c
-c %---------------------------------%
-c | Set machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = dlamch ('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0 )
-c
-c %---------------------------------------%
-c | RNORM is B-norm of the RESID(1:N). |
-c | BNORM2 is the 2 norm of B*RESID(1:N). |
-c | Upon exit of dsaupd WORKD(1:N) has |
-c | B*RESID(1:N). |
-c %---------------------------------------%
-c
- rnorm = workl(ih)
- if (bmat .eq. 'I') then
- bnorm2 = rnorm
- else if (bmat .eq. 'G') then
- bnorm2 = dnrm2 (n, workd, 1)
- end if
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(irz), ndigit,
- & '_seupd: Ritz values passed in from _SAUPD.')
- call dvout (logfil, ncv, workl(ibd), ndigit,
- & '_seupd: Ritz estimates passed in from _SAUPD.')
- end if
-c
- if (rvec) then
-c
- reord = .false.
-c
-c %---------------------------------------------------%
-c | Use the temporary bounds array to store indices |
-c | These will be used to mark the select array later |
-c %---------------------------------------------------%
-c
- do 10 j = 1,ncv
- workl(bounds+j-1) = j
- select(j) = .false.
- 10 continue
-c
-c %-------------------------------------%
-c | Select the wanted Ritz values. |
-c | Sort the Ritz values so that the |
-c | wanted ones appear at the tailing |
-c | NEV positions of workl(irr) and |
-c | workl(iri). Move the corresponding |
-c | error estimates in workl(bound) |
-c | accordingly. |
-c %-------------------------------------%
-c
- np = ncv - nev
- ishift = 0
- call dsgets (ishift, which , nev ,
- & np , workl(irz) , workl(bounds),
- & workl)
-c
- if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(irz), ndigit,
- & '_seupd: Ritz values after calling _SGETS.')
- call dvout (logfil, ncv, workl(bounds), ndigit,
- & '_seupd: Ritz value indices after calling _SGETS.')
- end if
-c
-c %-----------------------------------------------------%
-c | Record indices of the converged wanted Ritz values |
-c | Mark the select array for possible reordering |
-c %-----------------------------------------------------%
-c
- numcnv = 0
- do 11 j = 1,ncv
- temp1 = max(eps23, abs(workl(irz+ncv-j)) )
- jj = workl(bounds + ncv - j)
- if (numcnv .lt. nconv .and.
- & workl(ibd+jj-1) .le. tol*temp1) then
- select(jj) = .true.
- numcnv = numcnv + 1
- if (jj .gt. nconv) reord = .true.
- endif
- 11 continue
-c
-c %-----------------------------------------------------------%
-c | Check the count (numcnv) of converged Ritz values with |
-c | the number (nconv) reported by _saupd. If these two |
-c | are different then there has probably been an error |
-c | caused by incorrect passing of the _saupd data. |
-c %-----------------------------------------------------------%
-c
- if (msglvl .gt. 2) then
- call ivout(logfil, 1, numcnv, ndigit,
- & '_seupd: Number of specified eigenvalues')
- call ivout(logfil, 1, nconv, ndigit,
- & '_seupd: Number of "converged" eigenvalues')
- end if
-c
- if (numcnv .ne. nconv) then
- info = -17
- go to 9000
- end if
-c
-c %-----------------------------------------------------------%
-c | Call LAPACK routine _steqr to compute the eigenvalues and |
-c | eigenvectors of the final symmetric tridiagonal matrix H. |
-c | Initialize the eigenvector matrix Q to the identity. |
-c %-----------------------------------------------------------%
-c
- call dcopy (ncv-1, workl(ih+1), 1, workl(ihb), 1)
- call dcopy (ncv, workl(ih+ldh), 1, workl(ihd), 1)
-c
- call dsteqr ('Identity', ncv, workl(ihd), workl(ihb),
- & workl(iq) , ldq, workl(iw), ierr)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 9000
- end if
-c
- if (msglvl .gt. 1) then
- call dcopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
- call dvout (logfil, ncv, workl(ihd), ndigit,
- & '_seupd: NCV Ritz values of the final H matrix')
- call dvout (logfil, ncv, workl(iw), ndigit,
- & '_seupd: last row of the eigenvector matrix for H')
- end if
-c
- if (reord) then
-c
-c %---------------------------------------------%
-c | Reordered the eigenvalues and eigenvectors |
-c | computed by _steqr so that the "converged" |
-c | eigenvalues appear in the first NCONV |
-c | positions of workl(ihd), and the associated |
-c | eigenvectors appear in the first NCONV |
-c | columns. |
-c %---------------------------------------------%
-c
- leftptr = 1
- rghtptr = ncv
-c
- if (ncv .eq. 1) go to 30
-c
- 20 if (select(leftptr)) then
-c
-c %-------------------------------------------%
-c | Search, from the left, for the first Ritz |
-c | value that has not converged. |
-c %-------------------------------------------%
-c
- leftptr = leftptr + 1
-c
- else if ( .not. select(rghtptr)) then
-c
-c %----------------------------------------------%
-c | Search, from the right, the first Ritz value |
-c | that has converged. |
-c %----------------------------------------------%
-c
- rghtptr = rghtptr - 1
-c
- else
-c
-c %----------------------------------------------%
-c | Swap the Ritz value on the left that has not |
-c | converged with the Ritz value on the right |
-c | that has converged. Swap the associated |
-c | eigenvector of the tridiagonal matrix H as |
-c | well. |
-c %----------------------------------------------%
-c
- temp = workl(ihd+leftptr-1)
- workl(ihd+leftptr-1) = workl(ihd+rghtptr-1)
- workl(ihd+rghtptr-1) = temp
- call dcopy (ncv, workl(iq+ncv*(leftptr-1)), 1,
- & workl(iw), 1)
- call dcopy (ncv, workl(iq+ncv*(rghtptr-1)), 1,
- & workl(iq+ncv*(leftptr-1)), 1)
- call dcopy (ncv, workl(iw), 1,
- & workl(iq+ncv*(rghtptr-1)), 1)
- leftptr = leftptr + 1
- rghtptr = rghtptr - 1
-c
- end if
-c
- if (leftptr .lt. rghtptr) go to 20
-c
- end if
-c
- 30 if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(ihd), ndigit,
- & '_seupd: The eigenvalues of H--reordered')
- end if
-c
-c %----------------------------------------%
-c | Load the converged Ritz values into D. |
-c %----------------------------------------%
-c
- call dcopy (nconv, workl(ihd), 1, d, 1)
-c
- else
-c
-c %-----------------------------------------------------%
-c | Ritz vectors not required. Load Ritz values into D. |
-c %-----------------------------------------------------%
-c
- call dcopy (nconv, workl(ritz), 1, d, 1)
- call dcopy (ncv, workl(ritz), 1, workl(ihd), 1)
-c
- end if
-c
-c %------------------------------------------------------------------%
-c | Transform the Ritz values and possibly vectors and corresponding |
-c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
-c | (and corresponding data) are returned in ascending order. |
-c %------------------------------------------------------------------%
-c
- if (type .eq. 'REGULR') then
-c
-c %---------------------------------------------------------%
-c | Ascending sort of wanted Ritz values, vectors and error |
-c | bounds. Not necessary if only Ritz values are desired. |
-c %---------------------------------------------------------%
-c
- if (rvec) then
- call dsesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq)
- else
- call dcopy (ncv, workl(bounds), 1, workl(ihb), 1)
- end if
-c
- else
-c
-c %-------------------------------------------------------------%
-c | * Make a copy of all the Ritz values. |
-c | * Transform the Ritz values back to the original system. |
-c | For TYPE = 'SHIFTI' the transformation is |
-c | lambda = 1/theta + sigma |
-c | For TYPE = 'BUCKLE' the transformation is |
-c | lambda = sigma * theta / ( theta - 1 ) |
-c | For TYPE = 'CAYLEY' the transformation is |
-c | lambda = sigma * (theta + 1) / (theta - 1 ) |
-c | where the theta are the Ritz values returned by dsaupd . |
-c | NOTES: |
-c | *The Ritz vectors are not affected by the transformation. |
-c | They are only reordered. |
-c %-------------------------------------------------------------%
-c
- call dcopy (ncv, workl(ihd), 1, workl(iw), 1)
- if (type .eq. 'SHIFTI') then
- do 40 k=1, ncv
- workl(ihd+k-1) = one / workl(ihd+k-1) + sigma
- 40 continue
- else if (type .eq. 'BUCKLE') then
- do 50 k=1, ncv
- workl(ihd+k-1) = sigma * workl(ihd+k-1) /
- & (workl(ihd+k-1) - one)
- 50 continue
- else if (type .eq. 'CAYLEY') then
- do 60 k=1, ncv
- workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
- & (workl(ihd+k-1) - one)
- 60 continue
- end if
-c
-c %-------------------------------------------------------------%
-c | * Store the wanted NCONV lambda values into D. |
-c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) |
-c | into ascending order and apply sort to the NCONV theta |
-c | values in the transformed system. We will need this to |
-c | compute Ritz estimates in the original system. |
-c | * Finally sort the lambda`s into ascending order and apply |
-c | to Ritz vectors if wanted. Else just sort lambda`s into |
-c | ascending order. |
-c | NOTES: |
-c | *workl(iw:iw+ncv-1) contain the theta ordered so that they |
-c | match the ordering of the lambda. We`ll use them again for |
-c | Ritz vector purification. |
-c %-------------------------------------------------------------%
-c
- call dcopy (nconv, workl(ihd), 1, d, 1)
- call dsortr ('LA', .true., nconv, workl(ihd), workl(iw))
- if (rvec) then
- call dsesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq)
- else
- call dcopy (ncv, workl(bounds), 1, workl(ihb), 1)
- call dscal (ncv, bnorm2/rnorm, workl(ihb), 1)
- call dsortr ('LA', .true., nconv, d, workl(ihb))
- end if
-c
- end if
-c
-c %------------------------------------------------%
-c | Compute the Ritz vectors. Transform the wanted |
-c | eigenvectors of the symmetric tridiagonal H by |
-c | the Lanczos basis matrix V. |
-c %------------------------------------------------%
-c
- if (rvec .and. howmny .eq. 'A') then
-c
-c %----------------------------------------------------------%
-c | Compute the QR factorization of the matrix representing |
-c | the wanted invariant subspace located in the first NCONV |
-c | columns of workl(iq,ldq). |
-c %----------------------------------------------------------%
-c
- call dgeqr2 (ncv, nconv , workl(iq) ,
- & ldq, workl(iw+ncv), workl(ihb),
- & ierr)
-c
-c %--------------------------------------------------------%
-c | * Postmultiply V by Q. |
-c | * Copy the first NCONV columns of VQ into Z. |
-c | The N by NCONV matrix Z is now a matrix representation |
-c | of the approximate invariant subspace associated with |
-c | the Ritz values in workl(ihd). |
-c %--------------------------------------------------------%
-c
- call dorm2r ('Right', 'Notranspose', n ,
- & ncv , nconv , workl(iq),
- & ldq , workl(iw+ncv), v ,
- & ldv , workd(n+1) , ierr)
- call dlacpy ('All', n, nconv, v, ldv, z, ldz)
-c
-c %-----------------------------------------------------%
-c | In order to compute the Ritz estimates for the Ritz |
-c | values in both systems, need the last row of the |
-c | eigenvector matrix. Remember, it`s in factored form |
-c %-----------------------------------------------------%
-c
- do 65 j = 1, ncv-1
- workl(ihb+j-1) = zero
- 65 continue
- workl(ihb+ncv-1) = one
- call dorm2r ('Left', 'Transpose' , ncv ,
- & 1 , nconv , workl(iq) ,
- & ldq , workl(iw+ncv), workl(ihb),
- & ncv , temp , ierr)
-c
-c %-----------------------------------------------------%
-c | Make a copy of the last row into |
-c | workl(iw+ncv:iw+2*ncv), as it is needed again in |
-c | the Ritz vector purification step below |
-c %-----------------------------------------------------%
-c
- do 67 j = 1, nconv
- workl(iw+ncv+j-1) = workl(ihb+j-1)
- 67 continue
-
- else if (rvec .and. howmny .eq. 'S') then
-c
-c Not yet implemented. See remark 2 above.
-c
- end if
-c
- if (type .eq. 'REGULR' .and. rvec) then
-c
- do 70 j=1, ncv
- workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
- 70 continue
-c
- else if (type .ne. 'REGULR' .and. rvec) then
-c
-c %-------------------------------------------------%
-c | * Determine Ritz estimates of the theta. |
-c | If RVEC = .true. then compute Ritz estimates |
-c | of the theta. |
-c | If RVEC = .false. then copy Ritz estimates |
-c | as computed by dsaupd . |
-c | * Determine Ritz estimates of the lambda. |
-c %-------------------------------------------------%
-c
- call dscal (ncv, bnorm2, workl(ihb), 1)
- if (type .eq. 'SHIFTI') then
-c
- do 80 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1) )
- & / workl(iw+k-1)**2
- 80 continue
-c
- else if (type .eq. 'BUCKLE') then
-c
- do 90 k=1, ncv
- workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) )
- & / (workl(iw+k-1)-one )**2
- 90 continue
-c
- else if (type .eq. 'CAYLEY') then
-c
- do 100 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1)
- & / workl(iw+k-1)*(workl(iw+k-1)-one) )
- 100 continue
-c
- end if
-c
- end if
-c
- if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
- call dvout (logfil, nconv, d, ndigit,
- & '_seupd: Untransformed converged Ritz values')
- call dvout (logfil, nconv, workl(ihb), ndigit,
- & '_seupd: Ritz estimates of the untransformed Ritz values')
- else if (msglvl .gt. 1) then
- call dvout (logfil, nconv, d, ndigit,
- & '_seupd: Converged Ritz values')
- call dvout (logfil, nconv, workl(ihb), ndigit,
- & '_seupd: Associated Ritz estimates')
- end if
-c
-c %-------------------------------------------------%
-c | Ritz vector purification step. Formally perform |
-c | one of inverse subspace iteration. Only used |
-c | for MODE = 3,4,5. See reference 7 |
-c %-------------------------------------------------%
-c
- if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then
-c
- do 110 k=0, nconv-1
- workl(iw+k) = workl(iw+ncv+k)
- & / workl(iw+k)
- 110 continue
-c
- else if (rvec .and. type .eq. 'BUCKLE') then
-c
- do 120 k=0, nconv-1
- workl(iw+k) = workl(iw+ncv+k)
- & / (workl(iw+k)-one)
- 120 continue
-c
- end if
-c
- if (type .ne. 'REGULR')
- & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of dseupd |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsgets.f b/netlib/ARPACK/dsgets.f
deleted file mode 100644
index 61129f9..0000000
--- a/netlib/ARPACK/dsgets.f
+++ /dev/null
@@ -1,219 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsgets
-c
-c\Description:
-c Given the eigenvalues of the symmetric tridiagonal matrix H,
-c computes the NP shifts AMU that are zeros of the polynomial of
-c degree NP which filters out components of the unwanted eigenvectors
-c corresponding to the AMU's based on some given criteria.
-c
-c NOTE: This is called even in the case of user specified shifts in
-c order to sort the eigenvalues, and error bounds of H for later use.
-c
-c\Usage:
-c call dsgets
-c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
-c
-c\Arguments
-c ISHIFT Integer. (INPUT)
-c Method for selecting the implicit shifts at each iteration.
-c ISHIFT = 0: user specified shifts
-c ISHIFT = 1: exact shift with respect to the matrix H.
-c
-c WHICH Character*2. (INPUT)
-c Shift selection criteria.
-c 'LM' -> KEV eigenvalues of largest magnitude are retained.
-c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
-c 'LA' -> KEV eigenvalues of largest value are retained.
-c 'SA' -> KEV eigenvalues of smallest value are retained.
-c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
-c If KEV is odd, compute one more from the high end.
-c
-c KEV Integer. (INPUT)
-c KEV+NP is the size of the matrix H.
-c
-c NP Integer. (INPUT)
-c Number of implicit shifts to be computed.
-c
-c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT)
-c On INPUT, RITZ contains the eigenvalues of H.
-c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
-c are in the first NP locations and the wanted part is in
-c the last KEV locations. When exact shifts are selected, the
-c unwanted part corresponds to the shifts to be applied.
-c
-c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
-c Error bounds corresponding to the ordering in RITZ.
-c
-c SHIFTS Double precision array of length NP. (INPUT/OUTPUT)
-c On INPUT: contains the user specified shifts if ISHIFT = 0.
-c On OUTPUT: contains the shifts sorted into decreasing order
-c of magnitude with respect to the Ritz estimates contained in
-c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c dsortr ARPACK utility sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dcopy Level 1 BLAS that copies one vector to another.
-c dswap Level 1 BLAS that swaps the contents of two vectors.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/93: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\Remarks
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsgets ( ishift, which, kev, np, ritz, bounds, shifts )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- integer ishift, kev, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & bounds(kev+np), ritz(kev+np), shifts(np)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Double precision
- & one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer kevd2, msglvl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external dswap, dcopy, dsortr, arscnd
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic max, min
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msgets
-c
- if (which .eq. 'BE') then
-c
-c %-----------------------------------------------------%
-c | Both ends of the spectrum are requested. |
-c | Sort the eigenvalues into algebraically increasing |
-c | order first then swap high end of the spectrum next |
-c | to low end in appropriate locations. |
-c | NOTE: when np < floor(kev/2) be careful not to swap |
-c | overlapping locations. |
-c %-----------------------------------------------------%
-c
- call dsortr ('LA', .true., kev+np, ritz, bounds)
- kevd2 = kev / 2
- if ( kev .gt. 1 ) then
- call dswap ( min(kevd2,np), ritz, 1,
- & ritz( max(kevd2,np)+1 ), 1)
- call dswap ( min(kevd2,np), bounds, 1,
- & bounds( max(kevd2,np)+1 ), 1)
- end if
-c
- else
-c
-c %----------------------------------------------------%
-c | LM, SM, LA, SA case. |
-c | Sort the eigenvalues of H into the desired order |
-c | and apply the resulting order to BOUNDS. |
-c | The eigenvalues are sorted so that the wanted part |
-c | are always in the last KEV locations. |
-c %----------------------------------------------------%
-c
- call dsortr (which, .true., kev+np, ritz, bounds)
- end if
-c
- if (ishift .eq. 1 .and. np .gt. 0) then
-c
-c %-------------------------------------------------------%
-c | Sort the unwanted Ritz values used as shifts so that |
-c | the ones with largest Ritz estimates are first. |
-c | This will tend to minimize the effects of the |
-c | forward instability of the iteration when the shifts |
-c | are applied in subroutine dsapps. |
-c %-------------------------------------------------------%
-c
- call dsortr ('SM', .true., np, bounds, ritz)
- call dcopy (np, ritz, 1, shifts, 1)
- end if
-c
- call arscnd (t1)
- tsgets = tsgets + (t1 - t0)
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is')
- call ivout (logfil, 1, np, ndigit, '_sgets: NP is')
- call dvout (logfil, kev+np, ritz, ndigit,
- & '_sgets: Eigenvalues of current H matrix')
- call dvout (logfil, kev+np, bounds, ndigit,
- & '_sgets: Associated Ritz estimates')
- end if
-c
- return
-c
-c %---------------%
-c | End of dsgets |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsortc.f b/netlib/ARPACK/dsortc.f
deleted file mode 100644
index 91af30f..0000000
--- a/netlib/ARPACK/dsortc.f
+++ /dev/null
@@ -1,344 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsortc
-c
-c\Description:
-c Sorts the complex array in XREAL and XIMAG into the order
-c specified by WHICH and optionally applies the permutation to the
-c real array Y. It is assumed that if an element of XIMAG is
-c nonzero, then its negative is also an element. In other words,
-c both members of a complex conjugate pair are to be sorted and the
-c pairs are kept adjacent to each other.
-c
-c\Usage:
-c call dsortc
-c ( WHICH, APPLY, N, XREAL, XIMAG, Y )
-c
-c\Arguments
-c WHICH Character*2. (Input)
-c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude.
-c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude.
-c 'LR' -> sort XREAL into increasing order of algebraic.
-c 'SR' -> sort XREAL into decreasing order of algebraic.
-c 'LI' -> sort XIMAG into increasing order of magnitude.
-c 'SI' -> sort XIMAG into decreasing order of magnitude.
-c NOTE: If an element of XIMAG is non-zero, then its negative
-c is also an element.
-c
-c APPLY Logical. (Input)
-c APPLY = .TRUE. -> apply the sorted order to array Y.
-c APPLY = .FALSE. -> do not apply the sorted order to array Y.
-c
-c N Integer. (INPUT)
-c Size of the arrays.
-c
-c XREAL, Double precision array of length N. (INPUT/OUTPUT)
-c XIMAG Real and imaginary part of the array to be sorted.
-c
-c Y Double precision array of length N. (INPUT/OUTPUT)
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c Adapted from the sort routine in LANSO.
-c
-c\SCCS Information: @(#)
-c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsortc (which, apply, n, xreal, ximag, y)
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- logical apply
- integer n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & xreal(0:n-1), ximag(0:n-1), y(0:n-1)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, igap, j
- Double precision
- & temp, temp1, temp2
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Double precision
- & dlapy2
- external dlapy2
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- igap = n / 2
-c
- if (which .eq. 'LM') then
-c
-c %------------------------------------------------------%
-c | Sort XREAL,XIMAG into increasing order of magnitude. |
-c %------------------------------------------------------%
-c
- 10 continue
- if (igap .eq. 0) go to 9000
-c
- do 30 i = igap, n-1
- j = i-igap
- 20 continue
-c
- if (j.lt.0) go to 30
-c
- temp1 = dlapy2(xreal(j),ximag(j))
- temp2 = dlapy2(xreal(j+igap),ximag(j+igap))
-c
- if (temp1.gt.temp2) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 30
- end if
- j = j-igap
- go to 20
- 30 continue
- igap = igap / 2
- go to 10
-c
- else if (which .eq. 'SM') then
-c
-c %------------------------------------------------------%
-c | Sort XREAL,XIMAG into decreasing order of magnitude. |
-c %------------------------------------------------------%
-c
- 40 continue
- if (igap .eq. 0) go to 9000
-c
- do 60 i = igap, n-1
- j = i-igap
- 50 continue
-c
- if (j .lt. 0) go to 60
-c
- temp1 = dlapy2(xreal(j),ximag(j))
- temp2 = dlapy2(xreal(j+igap),ximag(j+igap))
-c
- if (temp1.lt.temp2) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 60
- endif
- j = j-igap
- go to 50
- 60 continue
- igap = igap / 2
- go to 40
-c
- else if (which .eq. 'LR') then
-c
-c %------------------------------------------------%
-c | Sort XREAL into increasing order of algebraic. |
-c %------------------------------------------------%
-c
- 70 continue
- if (igap .eq. 0) go to 9000
-c
- do 90 i = igap, n-1
- j = i-igap
- 80 continue
-c
- if (j.lt.0) go to 90
-c
- if (xreal(j).gt.xreal(j+igap)) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 90
- endif
- j = j-igap
- go to 80
- 90 continue
- igap = igap / 2
- go to 70
-c
- else if (which .eq. 'SR') then
-c
-c %------------------------------------------------%
-c | Sort XREAL into decreasing order of algebraic. |
-c %------------------------------------------------%
-c
- 100 continue
- if (igap .eq. 0) go to 9000
- do 120 i = igap, n-1
- j = i-igap
- 110 continue
-c
- if (j.lt.0) go to 120
-c
- if (xreal(j).lt.xreal(j+igap)) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 120
- endif
- j = j-igap
- go to 110
- 120 continue
- igap = igap / 2
- go to 100
-c
- else if (which .eq. 'LI') then
-c
-c %------------------------------------------------%
-c | Sort XIMAG into increasing order of magnitude. |
-c %------------------------------------------------%
-c
- 130 continue
- if (igap .eq. 0) go to 9000
- do 150 i = igap, n-1
- j = i-igap
- 140 continue
-c
- if (j.lt.0) go to 150
-c
- if (abs(ximag(j)).gt.abs(ximag(j+igap))) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 150
- endif
- j = j-igap
- go to 140
- 150 continue
- igap = igap / 2
- go to 130
-c
- else if (which .eq. 'SI') then
-c
-c %------------------------------------------------%
-c | Sort XIMAG into decreasing order of magnitude. |
-c %------------------------------------------------%
-c
- 160 continue
- if (igap .eq. 0) go to 9000
- do 180 i = igap, n-1
- j = i-igap
- 170 continue
-c
- if (j.lt.0) go to 180
-c
- if (abs(ximag(j)).lt.abs(ximag(j+igap))) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 180
- endif
- j = j-igap
- go to 170
- 180 continue
- igap = igap / 2
- go to 160
- end if
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dsortc |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dsortr.f b/netlib/ARPACK/dsortr.f
deleted file mode 100644
index 3903b81..0000000
--- a/netlib/ARPACK/dsortr.f
+++ /dev/null
@@ -1,218 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dsortr
-c
-c\Description:
-c Sort the array X1 in the order specified by WHICH and optionally
-c applies the permutation to the array X2.
-c
-c\Usage:
-c call dsortr
-c ( WHICH, APPLY, N, X1, X2 )
-c
-c\Arguments
-c WHICH Character*2. (Input)
-c 'LM' -> X1 is sorted into increasing order of magnitude.
-c 'SM' -> X1 is sorted into decreasing order of magnitude.
-c 'LA' -> X1 is sorted into increasing order of algebraic.
-c 'SA' -> X1 is sorted into decreasing order of algebraic.
-c
-c APPLY Logical. (Input)
-c APPLY = .TRUE. -> apply the sorted order to X2.
-c APPLY = .FALSE. -> do not apply the sorted order to X2.
-c
-c N Integer. (INPUT)
-c Size of the arrays.
-c
-c X1 Double precision array of length N. (INPUT/OUTPUT)
-c The array to be sorted.
-c
-c X2 Double precision array of length N. (INPUT/OUTPUT)
-c Only referenced if APPLY = .TRUE.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/16/93: Version ' 2.1'.
-c Adapted from the sort routine in LANSO.
-c
-c\SCCS Information: @(#)
-c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dsortr (which, apply, n, x1, x2)
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- logical apply
- integer n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & x1(0:n-1), x2(0:n-1)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, igap, j
- Double precision
- & temp
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- igap = n / 2
-c
- if (which .eq. 'SA') then
-c
-c X1 is sorted into decreasing order of algebraic.
-c
- 10 continue
- if (igap .eq. 0) go to 9000
- do 30 i = igap, n-1
- j = i-igap
- 20 continue
-c
- if (j.lt.0) go to 30
-c
- if (x1(j).lt.x1(j+igap)) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 30
- endif
- j = j-igap
- go to 20
- 30 continue
- igap = igap / 2
- go to 10
-c
- else if (which .eq. 'SM') then
-c
-c X1 is sorted into decreasing order of magnitude.
-c
- 40 continue
- if (igap .eq. 0) go to 9000
- do 60 i = igap, n-1
- j = i-igap
- 50 continue
-c
- if (j.lt.0) go to 60
-c
- if (abs(x1(j)).lt.abs(x1(j+igap))) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 60
- endif
- j = j-igap
- go to 50
- 60 continue
- igap = igap / 2
- go to 40
-c
- else if (which .eq. 'LA') then
-c
-c X1 is sorted into increasing order of algebraic.
-c
- 70 continue
- if (igap .eq. 0) go to 9000
- do 90 i = igap, n-1
- j = i-igap
- 80 continue
-c
- if (j.lt.0) go to 90
-c
- if (x1(j).gt.x1(j+igap)) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 90
- endif
- j = j-igap
- go to 80
- 90 continue
- igap = igap / 2
- go to 70
-c
- else if (which .eq. 'LM') then
-c
-c X1 is sorted into increasing order of magnitude.
-c
- 100 continue
- if (igap .eq. 0) go to 9000
- do 120 i = igap, n-1
- j = i-igap
- 110 continue
-c
- if (j.lt.0) go to 120
-c
- if (abs(x1(j)).gt.abs(x1(j+igap))) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 120
- endif
- j = j-igap
- go to 110
- 120 continue
- igap = igap / 2
- go to 100
- end if
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of dsortr |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dstatn.f b/netlib/ARPACK/dstatn.f
deleted file mode 100644
index 244df1a..0000000
--- a/netlib/ARPACK/dstatn.f
+++ /dev/null
@@ -1,61 +0,0 @@
-c
-c %---------------------------------------------%
-c | Initialize statistic and timing information |
-c | for nonsymmetric Arnoldi code. |
-c %---------------------------------------------%
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2
-c
- subroutine dstatn
-c
-c %--------------------------------%
-c | See stat.doc for documentation |
-c %--------------------------------%
-c
- include 'stat.h'
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- nopx = 0
- nbx = 0
- nrorth = 0
- nitref = 0
- nrstrt = 0
-c
- tnaupd = 0.0D+0
- tnaup2 = 0.0D+0
- tnaitr = 0.0D+0
- tneigh = 0.0D+0
- tngets = 0.0D+0
- tnapps = 0.0D+0
- tnconv = 0.0D+0
- titref = 0.0D+0
- tgetv0 = 0.0D+0
- trvec = 0.0D+0
-c
-c %----------------------------------------------------%
-c | User time including reverse communication overhead |
-c %----------------------------------------------------%
-c
- tmvopx = 0.0D+0
- tmvbx = 0.0D+0
-c
- return
-c
-c
-c %---------------%
-c | End of dstatn |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dstats.f b/netlib/ARPACK/dstats.f
deleted file mode 100644
index 84f74b4..0000000
--- a/netlib/ARPACK/dstats.f
+++ /dev/null
@@ -1,47 +0,0 @@
-c
-c\SCCS Information: @(#)
-c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2
-c %---------------------------------------------%
-c | Initialize statistic and timing information |
-c | for symmetric Arnoldi code. |
-c %---------------------------------------------%
-
- subroutine dstats
-
-c %--------------------------------%
-c | See stat.doc for documentation |
-c %--------------------------------%
- include 'stat.h'
-
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-
- nopx = 0
- nbx = 0
- nrorth = 0
- nitref = 0
- nrstrt = 0
-
- tsaupd = 0.0D+0
- tsaup2 = 0.0D+0
- tsaitr = 0.0D+0
- tseigt = 0.0D+0
- tsgets = 0.0D+0
- tsapps = 0.0D+0
- tsconv = 0.0D+0
- titref = 0.0D+0
- tgetv0 = 0.0D+0
- trvec = 0.0D+0
-
-c %----------------------------------------------------%
-c | User time including reverse communication overhead |
-c %----------------------------------------------------%
- tmvopx = 0.0D+0
- tmvbx = 0.0D+0
-
- return
-c
-c End of dstats
-c
- end
diff --git a/netlib/ARPACK/dstqrb.f b/netlib/ARPACK/dstqrb.f
deleted file mode 100644
index 9fef543..0000000
--- a/netlib/ARPACK/dstqrb.f
+++ /dev/null
@@ -1,594 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: dstqrb
-c
-c\Description:
-c Computes all eigenvalues and the last component of the eigenvectors
-c of a symmetric tridiagonal matrix using the implicit QL or QR method.
-c
-c This is mostly a modification of the LAPACK routine dsteqr.
-c See Remarks.
-c
-c\Usage:
-c call dstqrb
-c ( N, D, E, Z, WORK, INFO )
-c
-c\Arguments
-c N Integer. (INPUT)
-c The number of rows and columns in the matrix. N >= 0.
-c
-c D Double precision array, dimension (N). (INPUT/OUTPUT)
-c On entry, D contains the diagonal elements of the
-c tridiagonal matrix.
-c On exit, D contains the eigenvalues, in ascending order.
-c If an error exit is made, the eigenvalues are correct
-c for indices 1,2,...,INFO-1, but they are unordered and
-c may not be the smallest eigenvalues of the matrix.
-c
-c E Double precision array, dimension (N-1). (INPUT/OUTPUT)
-c On entry, E contains the subdiagonal elements of the
-c tridiagonal matrix in positions 1 through N-1.
-c On exit, E has been destroyed.
-c
-c Z Double precision array, dimension (N). (OUTPUT)
-c On exit, Z contains the last row of the orthonormal
-c eigenvector matrix of the symmetric tridiagonal matrix.
-c If an error exit is made, Z contains the last row of the
-c eigenvector matrix associated with the stored eigenvalues.
-c
-c WORK Double precision array, dimension (max(1,2*N-2)). (WORKSPACE)
-c Workspace used in accumulating the transformation for
-c computing the last components of the eigenvectors.
-c
-c INFO Integer. (OUTPUT)
-c = 0: normal return.
-c < 0: if INFO = -i, the i-th argument had an illegal value.
-c > 0: if INFO = +i, the i-th eigenvalue has not converged
-c after a total of 30*N iterations.
-c
-c\Remarks
-c 1. None.
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c daxpy Level 1 BLAS that computes a vector triad.
-c dcopy Level 1 BLAS that copies one vector to another.
-c dswap Level 1 BLAS that swaps the contents of two vectors.
-c lsame LAPACK character comparison routine.
-c dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2
-c symmetric matrix.
-c dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric
-c matrix.
-c dlamch LAPACK routine that determines machine constants.
-c dlanst LAPACK routine that computes the norm of a matrix.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlartg LAPACK Givens rotation construction routine.
-c dlascl LAPACK routine for careful scaling of a matrix.
-c dlaset LAPACK matrix initialization routine.
-c dlasr LAPACK routine that applies an orthogonal transformation to
-c a matrix.
-c dlasrt LAPACK sorting routine.
-c dsteqr LAPACK routine that computes eigenvalues and eigenvectors
-c of a symmetric tridiagonal matrix.
-c xerbla LAPACK error handler routine.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c 1. Starting with version 2.5, this routine is a modified version
-c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted,
-c only commeted out and new lines inserted.
-c All lines commented out have "c$$$" at the beginning.
-c Note that the LAPACK version 1.0 subroutine SSTEQR contained
-c bugs.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine dstqrb ( n, d, e, z, work, info )
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer info, n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Double precision
- & d( n ), e( n-1 ), z( n ), work( 2*n-2 )
-c
-c .. parameters ..
- Double precision
- & zero, one, two, three
- parameter ( zero = 0.0D+0, one = 1.0D+0,
- & two = 2.0D+0, three = 3.0D+0 )
- integer maxit
- parameter ( maxit = 30 )
-c ..
-c .. local scalars ..
- integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend,
- & lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1,
- & nm1, nmaxit
- Double precision
- & anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2,
- & s, safmax, safmin, ssfmax, ssfmin, tst
-c ..
-c .. external functions ..
- logical lsame
- Double precision
- & dlamch, dlanst, dlapy2
- external lsame, dlamch, dlanst, dlapy2
-c ..
-c .. external subroutines ..
- external dlae2, dlaev2, dlartg, dlascl, dlaset, dlasr,
- & dlasrt, dswap, xerbla
-c ..
-c .. intrinsic functions ..
- intrinsic abs, max, sign, sqrt
-c ..
-c .. executable statements ..
-c
-c test the input parameters.
-c
- info = 0
-c
-c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN
-c$$$ ICOMPZ = 0
-c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-c$$$ ICOMPZ = 1
-c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-c$$$ ICOMPZ = 2
-c$$$ ELSE
-c$$$ ICOMPZ = -1
-c$$$ END IF
-c$$$ IF( ICOMPZ.LT.0 ) THEN
-c$$$ INFO = -1
-c$$$ ELSE IF( N.LT.0 ) THEN
-c$$$ INFO = -2
-c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
-c$$$ $ N ) ) ) THEN
-c$$$ INFO = -6
-c$$$ END IF
-c$$$ IF( INFO.NE.0 ) THEN
-c$$$ CALL XERBLA( 'SSTEQR', -INFO )
-c$$$ RETURN
-c$$$ END IF
-c
-c *** New starting with version 2.5 ***
-c
- icompz = 2
-c *************************************
-c
-c quick return if possible
-c
- if( n.eq.0 )
- $ return
-c
- if( n.eq.1 ) then
- if( icompz.eq.2 ) z( 1 ) = one
- return
- end if
-c
-c determine the unit roundoff and over/underflow thresholds.
-c
- eps = dlamch( 'e' )
- eps2 = eps**2
- safmin = dlamch( 's' )
- safmax = one / safmin
- ssfmax = sqrt( safmax ) / three
- ssfmin = sqrt( safmin ) / eps2
-c
-c compute the eigenvalues and eigenvectors of the tridiagonal
-c matrix.
-c
-c$$ if( icompz.eq.2 )
-c$$$ $ call dlaset( 'full', n, n, zero, one, z, ldz )
-c
-c *** New starting with version 2.5 ***
-c
- if ( icompz .eq. 2 ) then
- do 5 j = 1, n-1
- z(j) = zero
- 5 continue
- z( n ) = one
- end if
-c *************************************
-c
- nmaxit = n*maxit
- jtot = 0
-c
-c determine where the matrix splits and choose ql or qr iteration
-c for each block, according to whether top or bottom diagonal
-c element is smaller.
-c
- l1 = 1
- nm1 = n - 1
-c
- 10 continue
- if( l1.gt.n )
- $ go to 160
- if( l1.gt.1 )
- $ e( l1-1 ) = zero
- if( l1.le.nm1 ) then
- do 20 m = l1, nm1
- tst = abs( e( m ) )
- if( tst.eq.zero )
- $ go to 30
- if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+
- $ 1 ) ) ) )*eps ) then
- e( m ) = zero
- go to 30
- end if
- 20 continue
- end if
- m = n
-c
- 30 continue
- l = l1
- lsv = l
- lend = m
- lendsv = lend
- l1 = m + 1
- if( lend.eq.l )
- $ go to 10
-c
-c scale submatrix in rows and columns l to lend
-c
- anorm = dlanst( 'i', lend-l+1, d( l ), e( l ) )
- iscale = 0
- if( anorm.eq.zero )
- $ go to 10
- if( anorm.gt.ssfmax ) then
- iscale = 1
- call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n,
- $ info )
- call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n,
- $ info )
- else if( anorm.lt.ssfmin ) then
- iscale = 2
- call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n,
- $ info )
- call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n,
- $ info )
- end if
-c
-c choose between ql and qr iteration
-c
- if( abs( d( lend ) ).lt.abs( d( l ) ) ) then
- lend = lsv
- l = lendsv
- end if
-c
- if( lend.gt.l ) then
-c
-c ql iteration
-c
-c look for small subdiagonal element.
-c
- 40 continue
- if( l.ne.lend ) then
- lendm1 = lend - 1
- do 50 m = l, lendm1
- tst = abs( e( m ) )**2
- if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+
- $ safmin )go to 60
- 50 continue
- end if
-c
- m = lend
-c
- 60 continue
- if( m.lt.lend )
- $ e( m ) = zero
- p = d( l )
- if( m.eq.l )
- $ go to 80
-c
-c if remaining matrix is 2-by-2, use dlae2 or dlaev2
-c to compute its eigensystem.
-c
- if( m.eq.l+1 ) then
- if( icompz.gt.0 ) then
- call dlaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s )
- work( l ) = c
- work( n-1+l ) = s
-c$$$ call dlasr( 'r', 'v', 'b', n, 2, work( l ),
-c$$$ $ work( n-1+l ), z( 1, l ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- tst = z(l+1)
- z(l+1) = c*tst - s*z(l)
- z(l) = s*tst + c*z(l)
-c *************************************
- else
- call dlae2( d( l ), e( l ), d( l+1 ), rt1, rt2 )
- end if
- d( l ) = rt1
- d( l+1 ) = rt2
- e( l ) = zero
- l = l + 2
- if( l.le.lend )
- $ go to 40
- go to 140
- end if
-c
- if( jtot.eq.nmaxit )
- $ go to 140
- jtot = jtot + 1
-c
-c form shift.
-c
- g = ( d( l+1 )-p ) / ( two*e( l ) )
- r = dlapy2( g, one )
- g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) )
-c
- s = one
- c = one
- p = zero
-c
-c inner loop
-c
- mm1 = m - 1
- do 70 i = mm1, l, -1
- f = s*e( i )
- b = c*e( i )
- call dlartg( g, f, c, s, r )
- if( i.ne.m-1 )
- $ e( i+1 ) = r
- g = d( i+1 ) - p
- r = ( d( i )-g )*s + two*c*b
- p = s*r
- d( i+1 ) = g + p
- g = c*r - b
-c
-c if eigenvectors are desired, then save rotations.
-c
- if( icompz.gt.0 ) then
- work( i ) = c
- work( n-1+i ) = -s
- end if
-c
- 70 continue
-c
-c if eigenvectors are desired, then apply saved rotations.
-c
- if( icompz.gt.0 ) then
- mm = m - l + 1
-c$$$ call dlasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ),
-c$$$ $ z( 1, l ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- call dlasr( 'r', 'v', 'b', 1, mm, work( l ),
- & work( n-1+l ), z( l ), 1 )
-c *************************************
- end if
-c
- d( l ) = d( l ) - p
- e( l ) = g
- go to 40
-c
-c eigenvalue found.
-c
- 80 continue
- d( l ) = p
-c
- l = l + 1
- if( l.le.lend )
- $ go to 40
- go to 140
-c
- else
-c
-c qr iteration
-c
-c look for small superdiagonal element.
-c
- 90 continue
- if( l.ne.lend ) then
- lendp1 = lend + 1
- do 100 m = l, lendp1, -1
- tst = abs( e( m-1 ) )**2
- if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+
- $ safmin )go to 110
- 100 continue
- end if
-c
- m = lend
-c
- 110 continue
- if( m.gt.lend )
- $ e( m-1 ) = zero
- p = d( l )
- if( m.eq.l )
- $ go to 130
-c
-c if remaining matrix is 2-by-2, use dlae2 or dlaev2
-c to compute its eigensystem.
-c
- if( m.eq.l-1 ) then
- if( icompz.gt.0 ) then
- call dlaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s )
-c$$$ work( m ) = c
-c$$$ work( n-1+m ) = s
-c$$$ call dlasr( 'r', 'v', 'f', n, 2, work( m ),
-c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- tst = z(l)
- z(l) = c*tst - s*z(l-1)
- z(l-1) = s*tst + c*z(l-1)
-c *************************************
- else
- call dlae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 )
- end if
- d( l-1 ) = rt1
- d( l ) = rt2
- e( l-1 ) = zero
- l = l - 2
- if( l.ge.lend )
- $ go to 90
- go to 140
- end if
-c
- if( jtot.eq.nmaxit )
- $ go to 140
- jtot = jtot + 1
-c
-c form shift.
-c
- g = ( d( l-1 )-p ) / ( two*e( l-1 ) )
- r = dlapy2( g, one )
- g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) )
-c
- s = one
- c = one
- p = zero
-c
-c inner loop
-c
- lm1 = l - 1
- do 120 i = m, lm1
- f = s*e( i )
- b = c*e( i )
- call dlartg( g, f, c, s, r )
- if( i.ne.m )
- $ e( i-1 ) = r
- g = d( i ) - p
- r = ( d( i+1 )-g )*s + two*c*b
- p = s*r
- d( i ) = g + p
- g = c*r - b
-c
-c if eigenvectors are desired, then save rotations.
-c
- if( icompz.gt.0 ) then
- work( i ) = c
- work( n-1+i ) = s
- end if
-c
- 120 continue
-c
-c if eigenvectors are desired, then apply saved rotations.
-c
- if( icompz.gt.0 ) then
- mm = l - m + 1
-c$$$ call dlasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ),
-c$$$ $ z( 1, m ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- call dlasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ),
- & z( m ), 1 )
-c *************************************
- end if
-c
- d( l ) = d( l ) - p
- e( lm1 ) = g
- go to 90
-c
-c eigenvalue found.
-c
- 130 continue
- d( l ) = p
-c
- l = l - 1
- if( l.ge.lend )
- $ go to 90
- go to 140
-c
- end if
-c
-c undo scaling if necessary
-c
- 140 continue
- if( iscale.eq.1 ) then
- call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1,
- $ d( lsv ), n, info )
- call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ),
- $ n, info )
- else if( iscale.eq.2 ) then
- call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1,
- $ d( lsv ), n, info )
- call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ),
- $ n, info )
- end if
-c
-c check for no convergence to an eigenvalue after a total
-c of n*maxit iterations.
-c
- if( jtot.lt.nmaxit )
- $ go to 10
- do 150 i = 1, n - 1
- if( e( i ).ne.zero )
- $ info = info + 1
- 150 continue
- go to 190
-c
-c order eigenvalues and eigenvectors.
-c
- 160 continue
- if( icompz.eq.0 ) then
-c
-c use quick sort
-c
- call dlasrt( 'i', n, d, info )
-c
- else
-c
-c use selection sort to minimize swaps of eigenvectors
-c
- do 180 ii = 2, n
- i = ii - 1
- k = i
- p = d( i )
- do 170 j = ii, n
- if( d( j ).lt.p ) then
- k = j
- p = d( j )
- end if
- 170 continue
- if( k.ne.i ) then
- d( k ) = d( i )
- d( i ) = p
-c$$$ call dswap( n, z( 1, i ), 1, z( 1, k ), 1 )
-c *** New starting with version 2.5 ***
-c
- p = z(k)
- z(k) = z(i)
- z(i) = p
-c *************************************
- end if
- 180 continue
- end if
-c
- 190 continue
- return
-c
-c %---------------%
-c | End of dstqrb |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/dvout.f b/netlib/ARPACK/dvout.f
deleted file mode 100644
index 4138e52..0000000
--- a/netlib/ARPACK/dvout.f
+++ /dev/null
@@ -1,122 +0,0 @@
-*-----------------------------------------------------------------------
-* Routine: DVOUT
-*
-* Purpose: Real vector output routine.
-*
-* Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT)
-*
-* Arguments
-* N - Length of array SX. (Input)
-* SX - Real array to be printed. (Input)
-* IFMT - Format to be used in printing array SX. (Input)
-* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
-* If IDIGIT .LT. 0, printing is done with 72 columns.
-* If IDIGIT .GT. 0, printing is done with 132 columns.
-*
-*-----------------------------------------------------------------------
-*
- SUBROUTINE DVOUT( LOUT, N, SX, IDIGIT, IFMT )
-* ...
-* ... SPECIFICATIONS FOR ARGUMENTS
-* ...
-* ... SPECIFICATIONS FOR LOCAL VARIABLES
-* .. Scalar Arguments ..
- CHARACTER*( * ) IFMT
- INTEGER IDIGIT, LOUT, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION SX( * )
-* ..
-* .. Local Scalars ..
- CHARACTER*80 LINE
- INTEGER I, K1, K2, LLL, NDIGIT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC LEN, MIN, MIN0
-* ..
-* .. Executable Statements ..
-* ...
-* ... FIRST EXECUTABLE STATEMENT
-*
-*
- LLL = MIN( LEN( IFMT ), 80 )
- DO 10 I = 1, LLL
- LINE( I: I ) = '-'
- 10 CONTINUE
-*
- DO 20 I = LLL + 1, 80
- LINE( I: I ) = ' '
- 20 CONTINUE
-*
- WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
- 9999 FORMAT( / 1X, A, / 1X, A )
-*
- IF( N.LE.0 )
- $ RETURN
- NDIGIT = IDIGIT
- IF( IDIGIT.EQ.0 )
- $ NDIGIT = 4
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
-*=======================================================================
-*
- IF( IDIGIT.LT.0 ) THEN
- NDIGIT = -IDIGIT
- IF( NDIGIT.LE.4 ) THEN
- DO 30 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
- 30 CONTINUE
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 40 K1 = 1, N, 4
- K2 = MIN0( N, K1+3 )
- WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
- 40 CONTINUE
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 50 K1 = 1, N, 3
- K2 = MIN0( N, K1+2 )
- WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
- 50 CONTINUE
- ELSE
- DO 60 K1 = 1, N, 2
- K2 = MIN0( N, K1+1 )
- WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
- 60 CONTINUE
- END IF
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
-*=======================================================================
-*
- ELSE
- IF( NDIGIT.LE.4 ) THEN
- DO 70 K1 = 1, N, 10
- K2 = MIN0( N, K1+9 )
- WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
- 70 CONTINUE
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 80 K1 = 1, N, 8
- K2 = MIN0( N, K1+7 )
- WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
- 80 CONTINUE
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 90 K1 = 1, N, 6
- K2 = MIN0( N, K1+5 )
- WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
- 90 CONTINUE
- ELSE
- DO 100 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
- 100 CONTINUE
- END IF
- END IF
- WRITE( LOUT, FMT = 9994 )
- RETURN
- 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
- 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
- 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
- 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
- 9994 FORMAT( 1X, ' ' )
- END
diff --git a/netlib/ARPACK/icnteq.f b/netlib/ARPACK/icnteq.f
deleted file mode 100644
index dc345f9..0000000
--- a/netlib/ARPACK/icnteq.f
+++ /dev/null
@@ -1,18 +0,0 @@
-c
-c-----------------------------------------------------------------------
-c
-c Count the number of elements equal to a specified integer value.
-c
- integer function icnteq (n, array, value)
-c
- integer n, value
- integer array(*)
-c
- k = 0
- do 10 i = 1, n
- if (array(i) .eq. value) k = k + 1
- 10 continue
- icnteq = k
-c
- return
- end
diff --git a/netlib/ARPACK/icopy.f b/netlib/ARPACK/icopy.f
deleted file mode 100644
index f9e8c11..0000000
--- a/netlib/ARPACK/icopy.f
+++ /dev/null
@@ -1,77 +0,0 @@
-*--------------------------------------------------------------------
-*\Documentation
-*
-*\Name: ICOPY
-*
-*\Description:
-* ICOPY copies an integer vector lx to an integer vector ly.
-*
-*\Usage:
-* call icopy ( n, lx, inc, ly, incy )
-*
-*\Arguments:
-* n integer (input)
-* On entry, n is the number of elements of lx to be
-c copied to ly.
-*
-* lx integer array (input)
-* On entry, lx is the integer vector to be copied.
-*
-* incx integer (input)
-* On entry, incx is the increment between elements of lx.
-*
-* ly integer array (input)
-* On exit, ly is the integer vector that contains the
-* copy of lx.
-*
-* incy integer (input)
-* On entry, incy is the increment between elements of ly.
-*
-*\Enddoc
-*
-*--------------------------------------------------------------------
-*
- subroutine icopy( n, lx, incx, ly, incy )
-*
-* ----------------------------
-* Specifications for arguments
-* ----------------------------
- integer incx, incy, n
- integer lx( 1 ), ly( 1 )
-*
-* ----------------------------------
-* Specifications for local variables
-* ----------------------------------
- integer i, ix, iy
-*
-* --------------------------
-* First executable statement
-* --------------------------
- if( n.le.0 )
- $ return
- if( incx.eq.1 .and. incy.eq.1 )
- $ go to 20
-c
-c.....code for unequal increments or equal increments
-c not equal to 1
- ix = 1
- iy = 1
- if( incx.lt.0 )
- $ ix = ( -n+1 )*incx + 1
- if( incy.lt.0 )
- $ iy = ( -n+1 )*incy + 1
- do 10 i = 1, n
- ly( iy ) = lx( ix )
- ix = ix + incx
- iy = iy + incy
- 10 continue
- return
-c
-c.....code for both increments equal to 1
-c
- 20 continue
- do 30 i = 1, n
- ly( i ) = lx( i )
- 30 continue
- return
- end
diff --git a/netlib/ARPACK/iset.f b/netlib/ARPACK/iset.f
deleted file mode 100644
index cb690bc..0000000
--- a/netlib/ARPACK/iset.f
+++ /dev/null
@@ -1,16 +0,0 @@
-c
-c-----------------------------------------------------------------------
-c
-c Only work with increment equal to 1 right now.
-c
- subroutine iset (n, value, array, inc)
-c
- integer n, value, inc
- integer array(*)
-c
- do 10 i = 1, n
- array(i) = value
- 10 continue
-c
- return
- end
diff --git a/netlib/ARPACK/iswap.f b/netlib/ARPACK/iswap.f
deleted file mode 100644
index 088798d..0000000
--- a/netlib/ARPACK/iswap.f
+++ /dev/null
@@ -1,55 +0,0 @@
- subroutine iswap (n,sx,incx,sy,incy)
-c
-c interchanges two vectors.
-c uses unrolled loops for increments equal to 1.
-c jack dongarra, linpack, 3/11/78.
-c
- integer sx(1),sy(1),stemp
- integer i,incx,incy,ix,iy,m,mp1,n
-c
- if(n.le.0)return
- if(incx.eq.1.and.incy.eq.1)go to 20
-c
-c code for unequal increments or equal increments not equal
-c to 1
-c
- ix = 1
- iy = 1
- if(incx.lt.0)ix = (-n+1)*incx + 1
- if(incy.lt.0)iy = (-n+1)*incy + 1
- do 10 i = 1,n
- stemp = sx(ix)
- sx(ix) = sy(iy)
- sy(iy) = stemp
- ix = ix + incx
- iy = iy + incy
- 10 continue
- return
-c
-c code for both increments equal to 1
-c
-c
-c clean-up loop
-c
- 20 m = mod(n,3)
- if( m .eq. 0 ) go to 40
- do 30 i = 1,m
- stemp = sx(i)
- sx(i) = sy(i)
- sy(i) = stemp
- 30 continue
- if( n .lt. 3 ) return
- 40 mp1 = m + 1
- do 50 i = mp1,n,3
- stemp = sx(i)
- sx(i) = sy(i)
- sy(i) = stemp
- stemp = sx(i + 1)
- sx(i + 1) = sy(i + 1)
- sy(i + 1) = stemp
- stemp = sx(i + 2)
- sx(i + 2) = sy(i + 2)
- sy(i + 2) = stemp
- 50 continue
- return
- end
diff --git a/netlib/ARPACK/ivout.f b/netlib/ARPACK/ivout.f
deleted file mode 100644
index e97118a..0000000
--- a/netlib/ARPACK/ivout.f
+++ /dev/null
@@ -1,120 +0,0 @@
-C-----------------------------------------------------------------------
-C Routine: IVOUT
-C
-C Purpose: Integer vector output routine.
-C
-C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT)
-C
-C Arguments
-C N - Length of array IX. (Input)
-C IX - Integer array to be printed. (Input)
-C IFMT - Format to be used in printing array IX. (Input)
-C IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
-C If IDIGIT .LT. 0, printing is done with 72 columns.
-C If IDIGIT .GT. 0, printing is done with 132 columns.
-C
-C-----------------------------------------------------------------------
-C
- SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT)
-C ...
-C ... SPECIFICATIONS FOR ARGUMENTS
- INTEGER IX(*), N, IDIGIT, LOUT
- CHARACTER IFMT*(*)
-C ...
-C ... SPECIFICATIONS FOR LOCAL VARIABLES
- INTEGER I, NDIGIT, K1, K2, LLL
- CHARACTER*80 LINE
-* ...
-* ... SPECIFICATIONS INTRINSICS
- INTRINSIC MIN
-*
-C
- LLL = MIN ( LEN ( IFMT ), 80 )
- DO 1 I = 1, LLL
- LINE(I:I) = '-'
- 1 CONTINUE
-C
- DO 2 I = LLL+1, 80
- LINE(I:I) = ' '
- 2 CONTINUE
-C
- WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
- 2000 FORMAT ( /1X, A /1X, A )
-C
- IF (N .LE. 0) RETURN
- NDIGIT = IDIGIT
- IF (IDIGIT .EQ. 0) NDIGIT = 4
-C
-C=======================================================================
-C CODE FOR OUTPUT USING 72 COLUMNS FORMAT
-C=======================================================================
-C
- IF (IDIGIT .LT. 0) THEN
-C
- NDIGIT = -IDIGIT
- IF (NDIGIT .LE. 4) THEN
- DO 10 K1 = 1, N, 10
- K2 = MIN0(N,K1+9)
- WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
- 10 CONTINUE
-C
- ELSE IF (NDIGIT .LE. 6) THEN
- DO 30 K1 = 1, N, 7
- K2 = MIN0(N,K1+6)
- WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
- 30 CONTINUE
-C
- ELSE IF (NDIGIT .LE. 10) THEN
- DO 50 K1 = 1, N, 5
- K2 = MIN0(N,K1+4)
- WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
- 50 CONTINUE
-C
- ELSE
- DO 70 K1 = 1, N, 3
- K2 = MIN0(N,K1+2)
- WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
- 70 CONTINUE
- END IF
-C
-C=======================================================================
-C CODE FOR OUTPUT USING 132 COLUMNS FORMAT
-C=======================================================================
-C
- ELSE
-C
- IF (NDIGIT .LE. 4) THEN
- DO 90 K1 = 1, N, 20
- K2 = MIN0(N,K1+19)
- WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
- 90 CONTINUE
-C
- ELSE IF (NDIGIT .LE. 6) THEN
- DO 110 K1 = 1, N, 15
- K2 = MIN0(N,K1+14)
- WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
- 110 CONTINUE
-C
- ELSE IF (NDIGIT .LE. 10) THEN
- DO 130 K1 = 1, N, 10
- K2 = MIN0(N,K1+9)
- WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
- 130 CONTINUE
-C
- ELSE
- DO 150 K1 = 1, N, 7
- K2 = MIN0(N,K1+6)
- WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
- 150 CONTINUE
- END IF
- END IF
- WRITE (LOUT,1004)
-C
- 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
- 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
- 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
- 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
- 1004 FORMAT(1X,' ')
-C
- RETURN
- END
diff --git a/netlib/ARPACK/second.f b/netlib/ARPACK/second.f
deleted file mode 100644
index 66d3f6f..0000000
--- a/netlib/ARPACK/second.f
+++ /dev/null
@@ -1,36 +0,0 @@
- SUBROUTINE ARSCND( T )
-*
- REAL T
-*
-* -- LAPACK auxiliary routine (preliminary version) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* July 26, 1991
-*
-* Purpose
-* =======
-*
-* SECOND returns the user time for a process in seconds.
-* This version gets the time from the system function ETIME.
-*
-* .. Local Scalars ..
- REAL T1
-* ..
-* .. Local Arrays ..
- REAL TARRAY( 2 )
-* ..
-* .. External Functions ..
- REAL ETIME
- INTRINSIC ETIME
-* ..
-* .. Executable Statements ..
-*
-
- T1 = ETIME( TARRAY )
- T = TARRAY( 1 )
-
- RETURN
-*
-* End of ARSCND
-*
- END
diff --git a/netlib/ARPACK/sgetv0.f b/netlib/ARPACK/sgetv0.f
deleted file mode 100644
index a60cdbe..0000000
--- a/netlib/ARPACK/sgetv0.f
+++ /dev/null
@@ -1,419 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: sgetv0
-c
-c\Description:
-c Generate a random initial residual vector for the Arnoldi process.
-c Force the residual vector to be in the range of the operator OP.
-c
-c\Usage:
-c call sgetv0
-c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
-c IPNTR, WORKD, IERR )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag. IDO must be zero on the first
-c call to sgetv0.
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c This is for the initialization phase to force the
-c starting vector into the range of OP.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c IDO = 99: done
-c -------------------------------------------------------------
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B in the (generalized)
-c eigenvalue problem A*x = lambda*B*x.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
-c
-c ITRY Integer. (INPUT)
-c ITRY counts the number of times that sgetv0 is called.
-c It should be set to 1 on the initial call to sgetv0.
-c
-c INITV Logical variable. (INPUT)
-c .TRUE. => the initial residual vector is given in RESID.
-c .FALSE. => generate a random initial residual vector.
-c
-c N Integer. (INPUT)
-c Dimension of the problem.
-c
-c J Integer. (INPUT)
-c Index of the residual vector to be generated, with respect to
-c the Arnoldi process. J > 1 in case of a "restart".
-c
-c V Real N by J array. (INPUT)
-c The first J-1 columns of V contain the current Arnoldi basis
-c if this is a "restart".
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c RESID Real array of length N. (INPUT/OUTPUT)
-c Initial residual vector to be generated. If RESID is
-c provided, force RESID into the range of the operator OP.
-c
-c RNORM Real scalar. (OUTPUT)
-c B-norm of the generated residual.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c
-c WORKD Real work array of length 2*N. (REVERSE COMMUNICATION).
-c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
-c
-c IERR Integer. (OUTPUT)
-c = 0: Normal exit.
-c = -1: Cannot generate a nontrivial restarted residual vector
-c in the range of the operator OP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine for vector output.
-c slarnv LAPACK routine for generating a random vector.
-c sgemv Level 2 BLAS routine for matrix vector multiplication.
-c scopy Level 1 BLAS that copies one vector to another.
-c sdot Level 1 BLAS that computes the scalar product of two vectors.
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine sgetv0
- & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
- & ipntr, workd, ierr )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1
- logical initv
- integer ido, ierr, itry, j, ldv, n
- Real
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Real
- & resid(n), v(ldv,j), workd(2*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- logical first, inits, orth
- integer idist, iseed(4), iter, msglvl, jj
- Real
- & rnorm0
- save first, iseed, inits, iter, msglvl, orth, rnorm0
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external slarnv, svout, scopy, sgemv, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & sdot, snrm2
- external sdot, snrm2
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs, sqrt
-c
-c %-----------------%
-c | Data Statements |
-c %-----------------%
-c
- data inits /.true./
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c
-c %-----------------------------------%
-c | Initialize the seed of the LAPACK |
-c | random number generator |
-c %-----------------------------------%
-c
- if (inits) then
- iseed(1) = 1
- iseed(2) = 3
- iseed(3) = 5
- iseed(4) = 7
- inits = .false.
- end if
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mgetv0
-c
- ierr = 0
- iter = 0
- first = .FALSE.
- orth = .FALSE.
-c
-c %-----------------------------------------------------%
-c | Possibly generate a random starting vector in RESID |
-c | Use a LAPACK random number generator used by the |
-c | matrix generation routines. |
-c | idist = 1: uniform (0,1) distribution; |
-c | idist = 2: uniform (-1,1) distribution; |
-c | idist = 3: normal (0,1) distribution; |
-c %-----------------------------------------------------%
-c
- if (.not.initv) then
- idist = 2
- call slarnv (idist, iseed, n, resid)
- end if
-c
-c %----------------------------------------------------------%
-c | Force the starting vector into the range of OP to handle |
-c | the generalized problem when B is possibly (singular). |
-c %----------------------------------------------------------%
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nopx = nopx + 1
- ipntr(1) = 1
- ipntr(2) = n + 1
- call scopy (n, resid, 1, workd, 1)
- ido = -1
- go to 9000
- end if
- end if
-c
-c %-----------------------------------------%
-c | Back from computing OP*(initial-vector) |
-c %-----------------------------------------%
-c
- if (first) go to 20
-c
-c %-----------------------------------------------%
-c | Back from computing B*(orthogonalized-vector) |
-c %-----------------------------------------------%
-c
- if (orth) go to 40
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvopx = tmvopx + (t3 - t2)
- end if
-c
-c %------------------------------------------------------%
-c | Starting vector is now in the range of OP; r = OP*r; |
-c | Compute B-norm of starting vector. |
-c %------------------------------------------------------%
-c
- call arscnd (t2)
- first = .TRUE.
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, workd(n+1), 1, resid, 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd, 1)
- end if
-c
- 20 continue
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- first = .FALSE.
- if (bmat .eq. 'G') then
- rnorm0 = sdot (n, resid, 1, workd, 1)
- rnorm0 = sqrt(abs(rnorm0))
- else if (bmat .eq. 'I') then
- rnorm0 = snrm2(n, resid, 1)
- end if
- rnorm = rnorm0
-c
-c %---------------------------------------------%
-c | Exit if this is the very first Arnoldi step |
-c %---------------------------------------------%
-c
- if (j .eq. 1) go to 50
-c
-c %----------------------------------------------------------------
-c | Otherwise need to B-orthogonalize the starting vector against |
-c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
-c | This is the case where an invariant subspace is encountered |
-c | in the middle of the Arnoldi factorization. |
-c | |
-c | s = V^{T}*B*r; r = r - V*s; |
-c | |
-c | Stopping criteria used for iter. ref. is discussed in |
-c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
-c %---------------------------------------------------------------%
-c
- orth = .TRUE.
- 30 continue
-c
- call sgemv ('T', n, j-1, one, v, ldv, workd, 1,
- & zero, workd(n+1), 1)
- call sgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
- & one, resid, 1)
-c
-c %----------------------------------------------------------%
-c | Compute the B-norm of the orthogonalized starting vector |
-c %----------------------------------------------------------%
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(n+1), 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd, 1)
- end if
-c
- 40 continue
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- if (bmat .eq. 'G') then
- rnorm = sdot (n, resid, 1, workd, 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = snrm2(n, resid, 1)
- end if
-c
-c %--------------------------------------%
-c | Check for further orthogonalization. |
-c %--------------------------------------%
-c
- if (msglvl .gt. 2) then
- call svout (logfil, 1, rnorm0, ndigit,
- & '_getv0: re-orthonalization ; rnorm0 is')
- call svout (logfil, 1, rnorm, ndigit,
- & '_getv0: re-orthonalization ; rnorm is')
- end if
-c
- if (rnorm .gt. 0.717*rnorm0) go to 50
-c
- iter = iter + 1
- if (iter .le. 5) then
-c
-c %-----------------------------------%
-c | Perform iterative refinement step |
-c %-----------------------------------%
-c
- rnorm0 = rnorm
- go to 30
- else
-c
-c %------------------------------------%
-c | Iterative refinement step "failed" |
-c %------------------------------------%
-c
- do 45 jj = 1, n
- resid(jj) = zero
- 45 continue
- rnorm = zero
- ierr = -1
- end if
-c
- 50 continue
-c
- if (msglvl .gt. 0) then
- call svout (logfil, 1, rnorm, ndigit,
- & '_getv0: B-norm of initial / restarted starting vector')
- end if
- if (msglvl .gt. 3) then
- call svout (logfil, n, resid, ndigit,
- & '_getv0: initial / restarted starting vector')
- end if
- ido = 99
-c
- call arscnd (t1)
- tgetv0 = tgetv0 + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of sgetv0 |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/slaqrb.f b/netlib/ARPACK/slaqrb.f
deleted file mode 100644
index e967b18..0000000
--- a/netlib/ARPACK/slaqrb.f
+++ /dev/null
@@ -1,521 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: slaqrb
-c
-c\Description:
-c Compute the eigenvalues and the Schur decomposition of an upper
-c Hessenberg submatrix in rows and columns ILO to IHI. Only the
-c last component of the Schur vectors are computed.
-c
-c This is mostly a modification of the LAPACK routine slahqr.
-c
-c\Usage:
-c call slaqrb
-c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO )
-c
-c\Arguments
-c WANTT Logical variable. (INPUT)
-c = .TRUE. : the full Schur form T is required;
-c = .FALSE.: only eigenvalues are required.
-c
-c N Integer. (INPUT)
-c The order of the matrix H. N >= 0.
-c
-c ILO Integer. (INPUT)
-c IHI Integer. (INPUT)
-c It is assumed that H is already upper quasi-triangular in
-c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-c ILO = 1). SLAQRB works primarily with the Hessenberg
-c submatrix in rows and columns ILO to IHI, but applies
-c transformations to all of H if WANTT is .TRUE..
-c 1 <= ILO <= max(1,IHI); IHI <= N.
-c
-c H Real array, dimension (LDH,N). (INPUT/OUTPUT)
-c On entry, the upper Hessenberg matrix H.
-c On exit, if WANTT is .TRUE., H is upper quasi-triangular in
-c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in
-c standard form. If WANTT is .FALSE., the contents of H are
-c unspecified on exit.
-c
-c LDH Integer. (INPUT)
-c The leading dimension of the array H. LDH >= max(1,N).
-c
-c WR Real array, dimension (N). (OUTPUT)
-c WI Real array, dimension (N). (OUTPUT)
-c The real and imaginary parts, respectively, of the computed
-c eigenvalues ILO to IHI are stored in the corresponding
-c elements of WR and WI. If two eigenvalues are computed as a
-c complex conjugate pair, they are stored in consecutive
-c elements of WR and WI, say the i-th and (i+1)th, with
-c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-c eigenvalues are stored in the same order as on the diagonal
-c of the Schur form returned in H, with WR(i) = H(i,i), and, if
-c H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-c
-c Z Real array, dimension (N). (OUTPUT)
-c On exit Z contains the last components of the Schur vectors.
-c
-c INFO Integer. (OUPUT)
-c = 0: successful exit
-c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI
-c in a total of 30*(IHI-ILO+1) iterations; if INFO = i,
-c elements i+1:ihi of WR and WI contain those eigenvalues
-c which have been successfully computed.
-c
-c\Remarks
-c 1. None.
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c slabad LAPACK routine that computes machine constants.
-c slamch LAPACK routine that determines machine constants.
-c slanhs LAPACK routine that computes various norms of a matrix.
-c slanv2 LAPACK routine that computes the Schur factorization of
-c 2 by 2 nonsymmetric matrix in standard form.
-c slarfg LAPACK Householder reflection construction routine.
-c scopy Level 1 BLAS that copies one vector to another.
-c srot Level 1 BLAS that applies a rotation to a 2 by 2 matrix.
-
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c Modified from the LAPACK routine slahqr so that only the
-c last component of the Schur vectors are computed.
-c
-c\SCCS Information: @(#)
-c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c 1. None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine slaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi,
- & z, info )
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- logical wantt
- integer ihi, ilo, info, ldh, n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & h( ldh, * ), wi( * ), wr( * ), z( * )
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & zero, one, dat1, dat2
- parameter (zero = 0.0E+0, one = 1.0E+0, dat1 = 7.5E-1,
- & dat2 = -4.375E-1)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- integer i, i1, i2, itn, its, j, k, l, m, nh, nr
- Real
- & cs, h00, h10, h11, h12, h21, h22, h33, h33s,
- & h43h34, h44, h44s, ovfl, s, smlnum, sn, sum,
- & t1, t2, t3, tst1, ulp, unfl, v1, v2, v3
- Real
- & v( 3 ), work( 1 )
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slamch, slanhs
- external slamch, slanhs
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy, slabad, slanv2, slarfg, srot
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- info = 0
-c
-c %--------------------------%
-c | Quick return if possible |
-c %--------------------------%
-c
- if( n.eq.0 )
- & return
- if( ilo.eq.ihi ) then
- wr( ilo ) = h( ilo, ilo )
- wi( ilo ) = zero
- return
- end if
-c
-c %---------------------------------------------%
-c | Initialize the vector of last components of |
-c | the Schur vectors for accumulation. |
-c %---------------------------------------------%
-c
- do 5 j = 1, n-1
- z(j) = zero
- 5 continue
- z(n) = one
-c
- nh = ihi - ilo + 1
-c
-c %-------------------------------------------------------------%
-c | Set machine-dependent constants for the stopping criterion. |
-c | If norm(H) <= sqrt(OVFL), overflow should not occur. |
-c %-------------------------------------------------------------%
-c
- unfl = slamch( 'safe minimum' )
- ovfl = one / unfl
- call slabad( unfl, ovfl )
- ulp = slamch( 'precision' )
- smlnum = unfl*( nh / ulp )
-c
-c %---------------------------------------------------------------%
-c | I1 and I2 are the indices of the first row and last column |
-c | of H to which transformations must be applied. If eigenvalues |
-c | only are computed, I1 and I2 are set inside the main loop. |
-c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. |
-c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. |
-c %---------------------------------------------------------------%
-c
- if( wantt ) then
- i1 = 1
- i2 = n
- do 8 i=1,i2-2
- h(i1+i+1,i) = zero
- 8 continue
- else
- do 9 i=1, ihi-ilo-1
- h(ilo+i+1,ilo+i-1) = zero
- 9 continue
- end if
-c
-c %---------------------------------------------------%
-c | ITN is the total number of QR iterations allowed. |
-c %---------------------------------------------------%
-c
- itn = 30*nh
-c
-c ------------------------------------------------------------------
-c The main loop begins here. I is the loop index and decreases from
-c IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-c with the active submatrix in rows and columns L to I.
-c Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-c H(L,L-1) is negligible so that the matrix splits.
-c ------------------------------------------------------------------
-c
- i = ihi
- 10 continue
- l = ilo
- if( i.lt.ilo )
- & go to 150
-
-c %--------------------------------------------------------------%
-c | Perform QR iterations on rows and columns ILO to I until a |
-c | submatrix of order 1 or 2 splits off at the bottom because a |
-c | subdiagonal element has become negligible. |
-c %--------------------------------------------------------------%
-
- do 130 its = 0, itn
-c
-c %----------------------------------------------%
-c | Look for a single small subdiagonal element. |
-c %----------------------------------------------%
-c
- do 20 k = i, l + 1, -1
- tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) )
- if( tst1.eq.zero )
- & tst1 = slanhs( '1', i-l+1, h( l, l ), ldh, work )
- if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) )
- & go to 30
- 20 continue
- 30 continue
- l = k
- if( l.gt.ilo ) then
-c
-c %------------------------%
-c | H(L,L-1) is negligible |
-c %------------------------%
-c
- h( l, l-1 ) = zero
- end if
-c
-c %-------------------------------------------------------------%
-c | Exit from loop if a submatrix of order 1 or 2 has split off |
-c %-------------------------------------------------------------%
-c
- if( l.ge.i-1 )
- & go to 140
-c
-c %---------------------------------------------------------%
-c | Now the active submatrix is in rows and columns L to I. |
-c | If eigenvalues only are being computed, only the active |
-c | submatrix need be transformed. |
-c %---------------------------------------------------------%
-c
- if( .not.wantt ) then
- i1 = l
- i2 = i
- end if
-c
- if( its.eq.10 .or. its.eq.20 ) then
-c
-c %-------------------%
-c | Exceptional shift |
-c %-------------------%
-c
- s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) )
- h44 = dat1*s
- h33 = h44
- h43h34 = dat2*s*s
-c
- else
-c
-c %-----------------------------------------%
-c | Prepare to use Wilkinson's double shift |
-c %-----------------------------------------%
-c
- h44 = h( i, i )
- h33 = h( i-1, i-1 )
- h43h34 = h( i, i-1 )*h( i-1, i )
- end if
-c
-c %-----------------------------------------------------%
-c | Look for two consecutive small subdiagonal elements |
-c %-----------------------------------------------------%
-c
- do 40 m = i - 2, l, -1
-c
-c %---------------------------------------------------------%
-c | Determine the effect of starting the double-shift QR |
-c | iteration at row M, and see if this would make H(M,M-1) |
-c | negligible. |
-c %---------------------------------------------------------%
-c
- h11 = h( m, m )
- h22 = h( m+1, m+1 )
- h21 = h( m+1, m )
- h12 = h( m, m+1 )
- h44s = h44 - h11
- h33s = h33 - h11
- v1 = ( h33s*h44s-h43h34 ) / h21 + h12
- v2 = h22 - h11 - h33s - h44s
- v3 = h( m+2, m+1 )
- s = abs( v1 ) + abs( v2 ) + abs( v3 )
- v1 = v1 / s
- v2 = v2 / s
- v3 = v3 / s
- v( 1 ) = v1
- v( 2 ) = v2
- v( 3 ) = v3
- if( m.eq.l )
- & go to 50
- h00 = h( m-1, m-1 )
- h10 = h( m, m-1 )
- tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) )
- if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 )
- & go to 50
- 40 continue
- 50 continue
-c
-c %----------------------%
-c | Double-shift QR step |
-c %----------------------%
-c
- do 120 k = m, i - 1
-c
-c ------------------------------------------------------------
-c The first iteration of this loop determines a reflection G
-c from the vector V and applies it from left and right to H,
-c thus creating a nonzero bulge below the subdiagonal.
-c
-c Each subsequent iteration determines a reflection G to
-c restore the Hessenberg form in the (K-1)th column, and thus
-c chases the bulge one step toward the bottom of the active
-c submatrix. NR is the order of G.
-c ------------------------------------------------------------
-c
- nr = min( 3, i-k+1 )
- if( k.gt.m )
- & call scopy( nr, h( k, k-1 ), 1, v, 1 )
- call slarfg( nr, v( 1 ), v( 2 ), 1, t1 )
- if( k.gt.m ) then
- h( k, k-1 ) = v( 1 )
- h( k+1, k-1 ) = zero
- if( k.lt.i-1 )
- & h( k+2, k-1 ) = zero
- else if( m.gt.l ) then
- h( k, k-1 ) = -h( k, k-1 )
- end if
- v2 = v( 2 )
- t2 = t1*v2
- if( nr.eq.3 ) then
- v3 = v( 3 )
- t3 = t1*v3
-c
-c %------------------------------------------------%
-c | Apply G from the left to transform the rows of |
-c | the matrix in columns K to I2. |
-c %------------------------------------------------%
-c
- do 60 j = k, i2
- sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j )
- h( k, j ) = h( k, j ) - sum*t1
- h( k+1, j ) = h( k+1, j ) - sum*t2
- h( k+2, j ) = h( k+2, j ) - sum*t3
- 60 continue
-c
-c %----------------------------------------------------%
-c | Apply G from the right to transform the columns of |
-c | the matrix in rows I1 to min(K+3,I). |
-c %----------------------------------------------------%
-c
- do 70 j = i1, min( k+3, i )
- sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 )
- h( j, k ) = h( j, k ) - sum*t1
- h( j, k+1 ) = h( j, k+1 ) - sum*t2
- h( j, k+2 ) = h( j, k+2 ) - sum*t3
- 70 continue
-c
-c %----------------------------------%
-c | Accumulate transformations for Z |
-c %----------------------------------%
-c
- sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 )
- z( k ) = z( k ) - sum*t1
- z( k+1 ) = z( k+1 ) - sum*t2
- z( k+2 ) = z( k+2 ) - sum*t3
-
- else if( nr.eq.2 ) then
-c
-c %------------------------------------------------%
-c | Apply G from the left to transform the rows of |
-c | the matrix in columns K to I2. |
-c %------------------------------------------------%
-c
- do 90 j = k, i2
- sum = h( k, j ) + v2*h( k+1, j )
- h( k, j ) = h( k, j ) - sum*t1
- h( k+1, j ) = h( k+1, j ) - sum*t2
- 90 continue
-c
-c %----------------------------------------------------%
-c | Apply G from the right to transform the columns of |
-c | the matrix in rows I1 to min(K+3,I). |
-c %----------------------------------------------------%
-c
- do 100 j = i1, i
- sum = h( j, k ) + v2*h( j, k+1 )
- h( j, k ) = h( j, k ) - sum*t1
- h( j, k+1 ) = h( j, k+1 ) - sum*t2
- 100 continue
-c
-c %----------------------------------%
-c | Accumulate transformations for Z |
-c %----------------------------------%
-c
- sum = z( k ) + v2*z( k+1 )
- z( k ) = z( k ) - sum*t1
- z( k+1 ) = z( k+1 ) - sum*t2
- end if
- 120 continue
-
- 130 continue
-c
-c %-------------------------------------------------------%
-c | Failure to converge in remaining number of iterations |
-c %-------------------------------------------------------%
-c
- info = i
- return
-
- 140 continue
-
- if( l.eq.i ) then
-c
-c %------------------------------------------------------%
-c | H(I,I-1) is negligible: one eigenvalue has converged |
-c %------------------------------------------------------%
-c
- wr( i ) = h( i, i )
- wi( i ) = zero
-
- else if( l.eq.i-1 ) then
-c
-c %--------------------------------------------------------%
-c | H(I-1,I-2) is negligible; |
-c | a pair of eigenvalues have converged. |
-c | |
-c | Transform the 2-by-2 submatrix to standard Schur form, |
-c | and compute and store the eigenvalues. |
-c %--------------------------------------------------------%
-c
- call slanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ),
- & h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ),
- & cs, sn )
-
- if( wantt ) then
-c
-c %-----------------------------------------------------%
-c | Apply the transformation to the rest of H and to Z, |
-c | as required. |
-c %-----------------------------------------------------%
-c
- if( i2.gt.i )
- & call srot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh,
- & cs, sn )
- call srot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn )
- sum = cs*z( i-1 ) + sn*z( i )
- z( i ) = cs*z( i ) - sn*z( i-1 )
- z( i-1 ) = sum
- end if
- end if
-c
-c %---------------------------------------------------------%
-c | Decrement number of remaining iterations, and return to |
-c | start of the main loop with new value of I. |
-c %---------------------------------------------------------%
-c
- itn = itn - its
- i = l - 1
- go to 10
-
- 150 continue
- return
-c
-c %---------------%
-c | End of slaqrb |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/smout.f b/netlib/ARPACK/smout.f
deleted file mode 100644
index 8d90bf2..0000000
--- a/netlib/ARPACK/smout.f
+++ /dev/null
@@ -1,157 +0,0 @@
-*-----------------------------------------------------------------------
-* Routine: SMOUT
-*
-* Purpose: Real matrix output routine.
-*
-* Usage: CALL SMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
-*
-* Arguments
-* M - Number of rows of A. (Input)
-* N - Number of columns of A. (Input)
-* A - Real M by N matrix to be printed. (Input)
-* LDA - Leading dimension of A exactly as specified in the
-* dimension statement of the calling program. (Input)
-* IFMT - Format to be used in printing matrix A. (Input)
-* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
-* If IDIGIT .LT. 0, printing is done with 72 columns.
-* If IDIGIT .GT. 0, printing is done with 132 columns.
-*
-*-----------------------------------------------------------------------
-*
- SUBROUTINE SMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
-* ...
-* ... SPECIFICATIONS FOR ARGUMENTS
- INTEGER M, N, IDIGIT, LDA, LOUT
- REAL A( LDA, * )
- CHARACTER IFMT*( * )
-* ...
-* ... SPECIFICATIONS FOR LOCAL VARIABLES
- INTEGER I, J, NDIGIT, K1, K2, LLL
- CHARACTER*1 ICOL( 3 )
- CHARACTER*80 LINE
-* ...
-* ... SPECIFICATIONS INTRINSICS
- INTRINSIC MIN
-*
- DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
- $ 'l' /
-* ...
-* ... FIRST EXECUTABLE STATEMENT
-*
- LLL = MIN( LEN( IFMT ), 80 )
- DO 10 I = 1, LLL
- LINE( I: I ) = '-'
- 10 CONTINUE
-*
- DO 20 I = LLL + 1, 80
- LINE( I: I ) = ' '
- 20 CONTINUE
-*
- WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
- 9999 FORMAT( / 1X, A / 1X, A )
-*
- IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
- $ RETURN
- NDIGIT = IDIGIT
- IF( IDIGIT.EQ.0 )
- $ NDIGIT = 4
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
-*=======================================================================
-*
- IF( IDIGIT.LT.0 ) THEN
- NDIGIT = -IDIGIT
- IF( NDIGIT.LE.4 ) THEN
- DO 40 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
- DO 30 I = 1, M
- WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
- 30 CONTINUE
- 40 CONTINUE
-*
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 60 K1 = 1, N, 4
- K2 = MIN0( N, K1+3 )
- WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
- DO 50 I = 1, M
- WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
- 50 CONTINUE
- 60 CONTINUE
-*
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 80 K1 = 1, N, 3
- K2 = MIN0( N, K1+2 )
- WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
- DO 70 I = 1, M
- WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
- 70 CONTINUE
- 80 CONTINUE
-*
- ELSE
- DO 100 K1 = 1, N, 2
- K2 = MIN0( N, K1+1 )
- WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
- DO 90 I = 1, M
- WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
- 90 CONTINUE
- 100 CONTINUE
- END IF
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
-*=======================================================================
-*
- ELSE
- IF( NDIGIT.LE.4 ) THEN
- DO 120 K1 = 1, N, 10
- K2 = MIN0( N, K1+9 )
- WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
- DO 110 I = 1, M
- WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
- 110 CONTINUE
- 120 CONTINUE
-*
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 140 K1 = 1, N, 8
- K2 = MIN0( N, K1+7 )
- WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
- DO 130 I = 1, M
- WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
- 130 CONTINUE
- 140 CONTINUE
-*
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 160 K1 = 1, N, 6
- K2 = MIN0( N, K1+5 )
- WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
- DO 150 I = 1, M
- WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
- 150 CONTINUE
- 160 CONTINUE
-*
- ELSE
- DO 180 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
- DO 170 I = 1, M
- WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
- 170 CONTINUE
- 180 CONTINUE
- END IF
- END IF
- WRITE( LOUT, 9990 )
-*
- 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
- 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
- 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
- 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
- 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P10E12.3 )
- 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P8E14.5 )
- 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P6E18.9 )
- 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P5E22.13 )
- 9990 FORMAT( 1X, ' ' )
-*
- RETURN
- END
diff --git a/netlib/ARPACK/snaitr.f b/netlib/ARPACK/snaitr.f
deleted file mode 100644
index 1a35d44..0000000
--- a/netlib/ARPACK/snaitr.f
+++ /dev/null
@@ -1,840 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: snaitr
-c
-c\Description:
-c Reverse communication interface for applying NP additional steps to
-c a K step nonsymmetric Arnoldi factorization.
-c
-c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
-c
-c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
-c
-c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
-c
-c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
-c
-c where OP and B are as in snaupd. The B-norm of r_{k+p} is also
-c computed and returned.
-c
-c\Usage:
-c call snaitr
-c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
-c IPNTR, WORKD, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag.
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c This is for the restart phase to force the new
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y,
-c IPNTR(3) is the pointer into WORK for B * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c IDO = 99: done
-c -------------------------------------------------------------
-c When the routine is used in the "shift-and-invert" mode, the
-c vector B * Q is already available and do not need to be
-c recompute in forming OP * Q.
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B that defines the
-c semi-inner product for the operator OP. See snaupd.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c K Integer. (INPUT)
-c Current size of V and H.
-c
-c NP Integer. (INPUT)
-c Number of additional Arnoldi steps to take.
-c
-c NB Integer. (INPUT)
-c Blocksize to be used in the recurrence.
-c Only work for NB = 1 right now. The goal is to have a
-c program that implement both the block and non-block method.
-c
-c RESID Real array of length N. (INPUT/OUTPUT)
-c On INPUT: RESID contains the residual vector r_{k}.
-c On OUTPUT: RESID contains the residual vector r_{k+p}.
-c
-c RNORM Real scalar. (INPUT/OUTPUT)
-c B-norm of the starting residual on input.
-c B-norm of the updated residual r_{k+p} on output.
-c
-c V Real N by K+NP array. (INPUT/OUTPUT)
-c On INPUT: V contains the Arnoldi vectors in the first K
-c columns.
-c On OUTPUT: V contains the new NP Arnoldi vectors in the next
-c NP columns. The first K columns are unchanged.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Real (K+NP) by (K+NP) array. (INPUT/OUTPUT)
-c H is used to store the generated upper Hessenberg matrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORK for
-c vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in the
-c shift-and-invert mode. X is the current operand.
-c -------------------------------------------------------------
-c
-c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The calling program should not
-c use WORKD as temporary workspace during the iteration !!!!!!
-c On input, WORKD(1:N) = B*RESID and is used to save some
-c computation at the first step.
-c
-c INFO Integer. (OUTPUT)
-c = 0: Normal exit.
-c > 0: Size of the spanning invariant subspace of OP found.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c sgetv0 ARPACK routine to generate the initial vector.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c smout ARPACK utility routine that prints matrices
-c svout ARPACK utility routine that prints vectors.
-c slabad LAPACK routine that computes machine constants.
-c slamch LAPACK routine that determines machine constants.
-c slascl LAPACK routine for careful scaling of a matrix.
-c slanhs LAPACK routine that computes various norms of a matrix.
-c sgemv Level 2 BLAS routine for matrix vector multiplication.
-c saxpy Level 1 BLAS that computes a vector triad.
-c sscal Level 1 BLAS that scales a vector.
-c scopy Level 1 BLAS that copies one vector to another .
-c sdot Level 1 BLAS that computes the scalar product of two vectors.
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c The algorithm implemented is:
-c
-c restart = .false.
-c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
-c r_{k} contains the initial residual vector even for k = 0;
-c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
-c computed by the calling program.
-c
-c betaj = rnorm ; p_{k+1} = B*r_{k} ;
-c For j = k+1, ..., k+np Do
-c 1) if ( betaj < tol ) stop or restart depending on j.
-c ( At present tol is zero )
-c if ( restart ) generate a new starting vector.
-c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
-c p_{j} = p_{j}/betaj
-c 3) r_{j} = OP*v_{j} where OP is defined as in snaupd
-c For shift-invert mode p_{j} = B*v_{j} is already available.
-c wnorm = || OP*v_{j} ||
-c 4) Compute the j-th step residual vector.
-c w_{j} = V_{j}^T * B * OP * v_{j}
-c r_{j} = OP*v_{j} - V_{j} * w_{j}
-c H(:,j) = w_{j};
-c H(j,j-1) = rnorm
-c rnorm = || r_(j) ||
-c If (rnorm > 0.717*wnorm) accept step and go back to 1)
-c 5) Re-orthogonalization step:
-c s = V_{j}'*B*r_{j}
-c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
-c alphaj = alphaj + s_{j};
-c 6) Iterative refinement step:
-c If (rnorm1 > 0.717*rnorm) then
-c rnorm = rnorm1
-c accept step and go back to 1)
-c Else
-c rnorm = rnorm1
-c If this is the first time in step 6), go to 5)
-c Else r_{j} lies in the span of V_{j} numerically.
-c Set r_{j} = 0 and rnorm = 0; go to 1)
-c EndIf
-c End Do
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine snaitr
- & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
- & ipntr, workd, info)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1
- integer ido, info, k, ldh, ldv, n, nb, np
- Real
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Real
- & h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- logical first, orth1, orth2, rstart, step3, step4
- integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
- & jj
- Real
- & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
- & wnorm
- save first, orth1, orth2, rstart, step3, step4,
- & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
- & betaj, rnorm1, smlnum, ulp, unfl, wnorm
-c
-c %-----------------------%
-c | Local Array Arguments |
-c %-----------------------%
-c
- Real
- & xtemp(2)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external saxpy, scopy, sscal, sgemv, sgetv0, slabad,
- & svout, smout, ivout, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & sdot, snrm2, slanhs, slamch
- external sdot, snrm2, slanhs, slamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs, sqrt
-c
-c %-----------------%
-c | Data statements |
-c %-----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
-c
-c %-----------------------------------------%
-c | Set machine-dependent constants for the |
-c | the splitting and deflation criterion. |
-c | If norm(H) <= sqrt(OVFL), |
-c | overflow should not occur. |
-c | REFERENCE: LAPACK subroutine slahqr |
-c %-----------------------------------------%
-c
- unfl = slamch( 'safe minimum' )
- ovfl = one / unfl
- call slabad( unfl, ovfl )
- ulp = slamch( 'precision' )
- smlnum = unfl*( n / ulp )
- first = .false.
- end if
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mnaitr
-c
-c %------------------------------%
-c | Initial call to this routine |
-c %------------------------------%
-c
- info = 0
- step3 = .false.
- step4 = .false.
- rstart = .false.
- orth1 = .false.
- orth2 = .false.
- j = k + 1
- ipj = 1
- irj = ipj + n
- ivj = irj + n
- end if
-c
-c %-------------------------------------------------%
-c | When in reverse communication mode one of: |
-c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
-c | will be .true. when .... |
-c | STEP3: return from computing OP*v_{j}. |
-c | STEP4: return from computing B-norm of OP*v_{j} |
-c | ORTH1: return from computing B-norm of r_{j+1} |
-c | ORTH2: return from computing B-norm of |
-c | correction to the residual vector. |
-c | RSTART: return from OP computations needed by |
-c | sgetv0. |
-c %-------------------------------------------------%
-c
- if (step3) go to 50
- if (step4) go to 60
- if (orth1) go to 70
- if (orth2) go to 90
- if (rstart) go to 30
-c
-c %-----------------------------%
-c | Else this is the first step |
-c %-----------------------------%
-c
-c %--------------------------------------------------------------%
-c | |
-c | A R N O L D I I T E R A T I O N L O O P |
-c | |
-c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
-c %--------------------------------------------------------------%
-
- 1000 continue
-c
- if (msglvl .gt. 1) then
- call ivout (logfil, 1, j, ndigit,
- & '_naitr: generating Arnoldi vector number')
- call svout (logfil, 1, rnorm, ndigit,
- & '_naitr: B-norm of the current residual is')
- end if
-c
-c %---------------------------------------------------%
-c | STEP 1: Check if the B norm of j-th residual |
-c | vector is zero. Equivalent to determing whether |
-c | an exact j-step Arnoldi factorization is present. |
-c %---------------------------------------------------%
-c
- betaj = rnorm
- if (rnorm .gt. zero) go to 40
-c
-c %---------------------------------------------------%
-c | Invariant subspace found, generate a new starting |
-c | vector which is orthogonal to the current Arnoldi |
-c | basis and continue the iteration. |
-c %---------------------------------------------------%
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_naitr: ****** RESTART AT STEP ******')
- end if
-c
-c %---------------------------------------------%
-c | ITRY is the loop variable that controls the |
-c | maximum amount of times that a restart is |
-c | attempted. NRSTRT is used by stat.h |
-c %---------------------------------------------%
-c
- betaj = zero
- nrstrt = nrstrt + 1
- itry = 1
- 20 continue
- rstart = .true.
- ido = 0
- 30 continue
-c
-c %--------------------------------------%
-c | If in reverse communication mode and |
-c | RSTART = .true. flow returns here. |
-c %--------------------------------------%
-c
- call sgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
- & resid, rnorm, ipntr, workd, ierr)
- if (ido .ne. 99) go to 9000
- if (ierr .lt. 0) then
- itry = itry + 1
- if (itry .le. 3) go to 20
-c
-c %------------------------------------------------%
-c | Give up after several restart attempts. |
-c | Set INFO to the size of the invariant subspace |
-c | which spans OP and exit. |
-c %------------------------------------------------%
-c
- info = j - 1
- call arscnd (t1)
- tnaitr = tnaitr + (t1 - t0)
- ido = 99
- go to 9000
- end if
-c
- 40 continue
-c
-c %---------------------------------------------------------%
-c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
-c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
-c | when reciprocating a small RNORM, test against lower |
-c | machine bound. |
-c %---------------------------------------------------------%
-c
- call scopy (n, resid, 1, v(1,j), 1)
- if (rnorm .ge. unfl) then
- temp1 = one / rnorm
- call sscal (n, temp1, v(1,j), 1)
- call sscal (n, temp1, workd(ipj), 1)
- else
-c
-c %-----------------------------------------%
-c | To scale both v_{j} and p_{j} carefully |
-c | use LAPACK routine SLASCL |
-c %-----------------------------------------%
-c
- call slascl ('General', i, i, rnorm, one, n, 1,
- & v(1,j), n, infol)
- call slascl ('General', i, i, rnorm, one, n, 1,
- & workd(ipj), n, infol)
- end if
-c
-c %------------------------------------------------------%
-c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
-c | Note that this is not quite yet r_{j}. See STEP 4 |
-c %------------------------------------------------------%
-c
- step3 = .true.
- nopx = nopx + 1
- call arscnd (t2)
- call scopy (n, v(1,j), 1, workd(ivj), 1)
- ipntr(1) = ivj
- ipntr(2) = irj
- ipntr(3) = ipj
- ido = 1
-c
-c %-----------------------------------%
-c | Exit in order to compute OP*v_{j} |
-c %-----------------------------------%
-c
- go to 9000
- 50 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
-c | if step3 = .true. |
-c %----------------------------------%
-c
- call arscnd (t3)
- tmvopx = tmvopx + (t3 - t2)
-
- step3 = .false.
-c
-c %------------------------------------------%
-c | Put another copy of OP*v_{j} into RESID. |
-c %------------------------------------------%
-c
- call scopy (n, workd(irj), 1, resid, 1)
-c
-c %---------------------------------------%
-c | STEP 4: Finish extending the Arnoldi |
-c | factorization to length j. |
-c %---------------------------------------%
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- step4 = .true.
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-------------------------------------%
-c | Exit in order to compute B*OP*v_{j} |
-c %-------------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd(ipj), 1)
- end if
- 60 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
-c | if step4 = .true. |
-c %----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- step4 = .false.
-c
-c %-------------------------------------%
-c | The following is needed for STEP 5. |
-c | Compute the B-norm of OP*v_{j}. |
-c %-------------------------------------%
-c
- if (bmat .eq. 'G') then
- wnorm = sdot (n, resid, 1, workd(ipj), 1)
- wnorm = sqrt(abs(wnorm))
- else if (bmat .eq. 'I') then
- wnorm = snrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------%
-c | Compute the j-th residual corresponding |
-c | to the j step factorization. |
-c | Use Classical Gram Schmidt and compute: |
-c | w_{j} <- V_{j}^T * B * OP * v_{j} |
-c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
-c %-----------------------------------------%
-c
-c
-c %------------------------------------------%
-c | Compute the j Fourier coefficients w_{j} |
-c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
-c %------------------------------------------%
-c
- call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
- & zero, h(1,j), 1)
-c
-c %--------------------------------------%
-c | Orthogonalize r_{j} against V_{j}. |
-c | RESID contains OP*v_{j}. See STEP 3. |
-c %--------------------------------------%
-c
- call sgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
- & one, resid, 1)
-c
- if (j .gt. 1) h(j,j-1) = betaj
-c
- call arscnd (t4)
-c
- orth1 = .true.
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*r_{j} |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd(ipj), 1)
- end if
- 70 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH1 = .true. |
-c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- orth1 = .false.
-c
-c %------------------------------%
-c | Compute the B-norm of r_{j}. |
-c %------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm = sdot (n, resid, 1, workd(ipj), 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = snrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------------------------%
-c | STEP 5: Re-orthogonalization / Iterative refinement phase |
-c | Maximum NITER_ITREF tries. |
-c | |
-c | s = V_{j}^T * B * r_{j} |
-c | r_{j} = r_{j} - V_{j}*s |
-c | alphaj = alphaj + s_{j} |
-c | |
-c | The stopping criteria used for iterative refinement is |
-c | discussed in Parlett's book SEP, page 107 and in Gragg & |
-c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
-c | Determine if we need to correct the residual. The goal is |
-c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
-c | The following test determines whether the sine of the |
-c | angle between OP*x and the computed residual is less |
-c | than or equal to 0.717. |
-c %-----------------------------------------------------------%
-c
- if (rnorm .gt. 0.717*wnorm) go to 100
- iter = 0
- nrorth = nrorth + 1
-c
-c %---------------------------------------------------%
-c | Enter the Iterative refinement phase. If further |
-c | refinement is necessary, loop back here. The loop |
-c | variable is ITER. Perform a step of Classical |
-c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
-c %---------------------------------------------------%
-c
- 80 continue
-c
- if (msglvl .gt. 2) then
- xtemp(1) = wnorm
- xtemp(2) = rnorm
- call svout (logfil, 2, xtemp, ndigit,
- & '_naitr: re-orthonalization; wnorm and rnorm are')
- call svout (logfil, j, h(1,j), ndigit,
- & '_naitr: j-th column of H')
- end if
-c
-c %----------------------------------------------------%
-c | Compute V_{j}^T * B * r_{j}. |
-c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
-c %----------------------------------------------------%
-c
- call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
- & zero, workd(irj), 1)
-c
-c %---------------------------------------------%
-c | Compute the correction to the residual: |
-c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
-c | The correction to H is v(:,1:J)*H(1:J,1:J) |
-c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
-c %---------------------------------------------%
-c
- call sgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
- & one, resid, 1)
- call saxpy (j, one, workd(irj), 1, h(1,j), 1)
-c
- orth2 = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-----------------------------------%
-c | Exit in order to compute B*r_{j}. |
-c | r_{j} is the corrected residual. |
-c %-----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd(ipj), 1)
- end if
- 90 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH2 = .true. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
-c %-----------------------------------------------------%
-c | Compute the B-norm of the corrected residual r_{j}. |
-c %-----------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm1 = sdot (n, resid, 1, workd(ipj), 1)
- rnorm1 = sqrt(abs(rnorm1))
- else if (bmat .eq. 'I') then
- rnorm1 = snrm2(n, resid, 1)
- end if
-c
- if (msglvl .gt. 0 .and. iter .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_naitr: Iterative refinement for Arnoldi residual')
- if (msglvl .gt. 2) then
- xtemp(1) = rnorm
- xtemp(2) = rnorm1
- call svout (logfil, 2, xtemp, ndigit,
- & '_naitr: iterative refinement ; rnorm and rnorm1 are')
- end if
- end if
-c
-c %-----------------------------------------%
-c | Determine if we need to perform another |
-c | step of re-orthogonalization. |
-c %-----------------------------------------%
-c
- if (rnorm1 .gt. 0.717*rnorm) then
-c
-c %---------------------------------------%
-c | No need for further refinement. |
-c | The cosine of the angle between the |
-c | corrected residual vector and the old |
-c | residual vector is greater than 0.717 |
-c | In other words the corrected residual |
-c | and the old residual vector share an |
-c | angle of less than arcCOS(0.717) |
-c %---------------------------------------%
-c
- rnorm = rnorm1
-c
- else
-c
-c %-------------------------------------------%
-c | Another step of iterative refinement step |
-c | is required. NITREF is used by stat.h |
-c %-------------------------------------------%
-c
- nitref = nitref + 1
- rnorm = rnorm1
- iter = iter + 1
- if (iter .le. 1) go to 80
-c
-c %-------------------------------------------------%
-c | Otherwise RESID is numerically in the span of V |
-c %-------------------------------------------------%
-c
- do 95 jj = 1, n
- resid(jj) = zero
- 95 continue
- rnorm = zero
- end if
-c
-c %----------------------------------------------%
-c | Branch here directly if iterative refinement |
-c | wasn't necessary or after at most NITER_REF |
-c | steps of iterative refinement. |
-c %----------------------------------------------%
-c
- 100 continue
-c
- rstart = .false.
- orth2 = .false.
-c
- call arscnd (t5)
- titref = titref + (t5 - t4)
-c
-c %------------------------------------%
-c | STEP 6: Update j = j+1; Continue |
-c %------------------------------------%
-c
- j = j + 1
- if (j .gt. k+np) then
- call arscnd (t1)
- tnaitr = tnaitr + (t1 - t0)
- ido = 99
- do 110 i = max(1,k), k+np-1
-c
-c %--------------------------------------------%
-c | Check for splitting and deflation. |
-c | Use a standard test as in the QR algorithm |
-c | REFERENCE: LAPACK subroutine slahqr |
-c %--------------------------------------------%
-c
- tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
- if( tst1.eq.zero )
- & tst1 = slanhs( '1', k+np, h, ldh, workd(n+1) )
- if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
- & h(i+1,i) = zero
- 110 continue
-c
- if (msglvl .gt. 2) then
- call smout (logfil, k+np, k+np, h, ldh, ndigit,
- & '_naitr: Final upper Hessenberg matrix H of order K+NP')
- end if
-c
- go to 9000
- end if
-c
-c %--------------------------------------------------------%
-c | Loop back to extend the factorization by another step. |
-c %--------------------------------------------------------%
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of snaitr |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/snapps.f b/netlib/ARPACK/snapps.f
deleted file mode 100644
index 6316005..0000000
--- a/netlib/ARPACK/snapps.f
+++ /dev/null
@@ -1,647 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: snapps
-c
-c\Description:
-c Given the Arnoldi factorization
-c
-c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
-c
-c apply NP implicit shifts resulting in
-c
-c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
-c
-c where Q is an orthogonal matrix which is the product of rotations
-c and reflections resulting from the NP bulge chage sweeps.
-c The updated Arnoldi factorization becomes:
-c
-c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
-c
-c\Usage:
-c call snapps
-c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
-c WORKL, WORKD )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Problem size, i.e. size of matrix A.
-c
-c KEV Integer. (INPUT/OUTPUT)
-c KEV+NP is the size of the input matrix H.
-c KEV is the size of the updated matrix HNEW. KEV is only
-c updated on ouput when fewer than NP shifts are applied in
-c order to keep the conjugate pair together.
-c
-c NP Integer. (INPUT)
-c Number of implicit shifts to be applied.
-c
-c SHIFTR, Real array of length NP. (INPUT)
-c SHIFTI Real and imaginary part of the shifts to be applied.
-c Upon, entry to snapps, the shifts must be sorted so that the
-c conjugate pairs are in consecutive locations.
-c
-c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
-c On INPUT, V contains the current KEV+NP Arnoldi vectors.
-c On OUTPUT, V contains the updated KEV Arnoldi vectors
-c in the first KEV columns of V.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Real (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
-c On INPUT, H contains the current KEV+NP by KEV+NP upper
-c Hessenber matrix of the Arnoldi factorization.
-c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
-c matrix in the KEV leading submatrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RESID Real array of length N. (INPUT/OUTPUT)
-c On INPUT, RESID contains the the residual vector r_{k+p}.
-c On OUTPUT, RESID is the update residual vector rnew_{k}
-c in the first KEV locations.
-c
-c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
-c Work array used to accumulate the rotations and reflections
-c during the bulge chase sweep.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Real work array of length (KEV+NP). (WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end.
-c
-c WORKD Real work array of length 2*N. (WORKSPACE)
-c Distributed array used in the application of the accumulated
-c orthogonal matrix Q.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c
-c\Routines called:
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c smout ARPACK utility routine that prints matrices.
-c svout ARPACK utility routine that prints vectors.
-c slabad LAPACK routine that computes machine constants.
-c slacpy LAPACK matrix copy routine.
-c slamch LAPACK routine that determines machine constants.
-c slanhs LAPACK routine that computes various norms of a matrix.
-c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c slarf LAPACK routine that applies Householder reflection to
-c a matrix.
-c slarfg LAPACK Householder reflection construction routine.
-c slartg LAPACK Givens rotation construction routine.
-c slaset LAPACK matrix initialization routine.
-c sgemv Level 2 BLAS routine for matrix vector multiplication.
-c saxpy Level 1 BLAS that computes a vector triad.
-c scopy Level 1 BLAS that copies one vector to another .
-c sscal Level 1 BLAS that scales a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2
-c
-c\Remarks
-c 1. In this version, each shift is applied to all the sublocks of
-c the Hessenberg matrix H and not just to the submatrix that it
-c comes from. Deflation as in LAPACK routine slahqr (QR algorithm
-c for upper Hessenberg matrices ) is used.
-c The subdiagonals of H are enforced to be non-negative.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine snapps
- & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq,
- & workl, workd )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer kev, ldh, ldq, ldv, n, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
- & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
- logical cconj, first
- Real
- & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
- & sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
- save first, ovfl, smlnum, ulp, unfl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external saxpy, scopy, sscal, slacpy, slarfg, slarf,
- & slaset, slabad, arscnd, slartg
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slamch, slanhs, slapy2
- external slamch, slanhs, slapy2
-c
-c %----------------------%
-c | Intrinsics Functions |
-c %----------------------%
-c
- intrinsic abs, max, min
-c
-c %----------------%
-c | Data statments |
-c %----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
-c
-c %-----------------------------------------------%
-c | Set machine-dependent constants for the |
-c | stopping criterion. If norm(H) <= sqrt(OVFL), |
-c | overflow should not occur. |
-c | REFERENCE: LAPACK subroutine slahqr |
-c %-----------------------------------------------%
-c
- unfl = slamch( 'safe minimum' )
- ovfl = one / unfl
- call slabad( unfl, ovfl )
- ulp = slamch( 'precision' )
- smlnum = unfl*( n / ulp )
- first = .false.
- end if
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mnapps
- kplusp = kev + np
-c
-c %--------------------------------------------%
-c | Initialize Q to the identity to accumulate |
-c | the rotations and reflections |
-c %--------------------------------------------%
-c
- call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
-c
-c %----------------------------------------------%
-c | Quick return if there are no shifts to apply |
-c %----------------------------------------------%
-c
- if (np .eq. 0) go to 9000
-c
-c %----------------------------------------------%
-c | Chase the bulge with the application of each |
-c | implicit shift. Each shift is applied to the |
-c | whole matrix including each block. |
-c %----------------------------------------------%
-c
- cconj = .false.
- do 110 jj = 1, np
- sigmar = shiftr(jj)
- sigmai = shifti(jj)
-c
- if (msglvl .gt. 2 ) then
- call ivout (logfil, 1, jj, ndigit,
- & '_napps: shift number.')
- call svout (logfil, 1, sigmar, ndigit,
- & '_napps: The real part of the shift ')
- call svout (logfil, 1, sigmai, ndigit,
- & '_napps: The imaginary part of the shift ')
- end if
-c
-c %-------------------------------------------------%
-c | The following set of conditionals is necessary |
-c | in order that complex conjugate pairs of shifts |
-c | are applied together or not at all. |
-c %-------------------------------------------------%
-c
- if ( cconj ) then
-c
-c %-----------------------------------------%
-c | cconj = .true. means the previous shift |
-c | had non-zero imaginary part. |
-c %-----------------------------------------%
-c
- cconj = .false.
- go to 110
- else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
-c
-c %------------------------------------%
-c | Start of a complex conjugate pair. |
-c %------------------------------------%
-c
- cconj = .true.
- else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
-c
-c %----------------------------------------------%
-c | The last shift has a nonzero imaginary part. |
-c | Don't apply it; thus the order of the |
-c | compressed H is order KEV+1 since only np-1 |
-c | were applied. |
-c %----------------------------------------------%
-c
- kev = kev + 1
- go to 110
- end if
- istart = 1
- 20 continue
-c
-c %--------------------------------------------------%
-c | if sigmai = 0 then |
-c | Apply the jj-th shift ... |
-c | else |
-c | Apply the jj-th and (jj+1)-th together ... |
-c | (Note that jj < np at this point in the code) |
-c | end |
-c | to the current block of H. The next do loop |
-c | determines the current block ; |
-c %--------------------------------------------------%
-c
- do 30 i = istart, kplusp-1
-c
-c %----------------------------------------%
-c | Check for splitting and deflation. Use |
-c | a standard test as in the QR algorithm |
-c | REFERENCE: LAPACK subroutine slahqr |
-c %----------------------------------------%
-c
- tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
- if( tst1.eq.zero )
- & tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl )
- if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, i, ndigit,
- & '_napps: matrix splitting at row/column no.')
- call ivout (logfil, 1, jj, ndigit,
- & '_napps: matrix splitting with shift number.')
- call svout (logfil, 1, h(i+1,i), ndigit,
- & '_napps: off diagonal element.')
- end if
- iend = i
- h(i+1,i) = zero
- go to 40
- end if
- 30 continue
- iend = kplusp
- 40 continue
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, istart, ndigit,
- & '_napps: Start of current block ')
- call ivout (logfil, 1, iend, ndigit,
- & '_napps: End of current block ')
- end if
-c
-c %------------------------------------------------%
-c | No reason to apply a shift to block of order 1 |
-c %------------------------------------------------%
-c
- if ( istart .eq. iend ) go to 100
-c
-c %------------------------------------------------------%
-c | If istart + 1 = iend then no reason to apply a |
-c | complex conjugate pair of shifts on a 2 by 2 matrix. |
-c %------------------------------------------------------%
-c
- if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
- & go to 100
-c
- h11 = h(istart,istart)
- h21 = h(istart+1,istart)
- if ( abs( sigmai ) .le. zero ) then
-c
-c %---------------------------------------------%
-c | Real-valued shift ==> apply single shift QR |
-c %---------------------------------------------%
-c
- f = h11 - sigmar
- g = h21
-c
- do 80 i = istart, iend-1
-c
-c %-----------------------------------------------------%
-c | Contruct the plane rotation G to zero out the bulge |
-c %-----------------------------------------------------%
-c
- call slartg (f, g, c, s, r)
- if (i .gt. istart) then
-c
-c %-------------------------------------------%
-c | The following ensures that h(1:iend-1,1), |
-c | the first iend-2 off diagonal of elements |
-c | H, remain non negative. |
-c %-------------------------------------------%
-c
- if (r .lt. zero) then
- r = -r
- c = -c
- s = -s
- end if
- h(i,i-1) = r
- h(i+1,i-1) = zero
- end if
-c
-c %---------------------------------------------%
-c | Apply rotation to the left of H; H <- G'*H |
-c %---------------------------------------------%
-c
- do 50 j = i, kplusp
- t = c*h(i,j) + s*h(i+1,j)
- h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
- h(i,j) = t
- 50 continue
-c
-c %---------------------------------------------%
-c | Apply rotation to the right of H; H <- H*G |
-c %---------------------------------------------%
-c
- do 60 j = 1, min(i+2,iend)
- t = c*h(j,i) + s*h(j,i+1)
- h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
- h(j,i) = t
- 60 continue
-c
-c %----------------------------------------------------%
-c | Accumulate the rotation in the matrix Q; Q <- Q*G |
-c %----------------------------------------------------%
-c
- do 70 j = 1, min( i+jj, kplusp )
- t = c*q(j,i) + s*q(j,i+1)
- q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
- q(j,i) = t
- 70 continue
-c
-c %---------------------------%
-c | Prepare for next rotation |
-c %---------------------------%
-c
- if (i .lt. iend-1) then
- f = h(i+1,i)
- g = h(i+2,i)
- end if
- 80 continue
-c
-c %-----------------------------------%
-c | Finished applying the real shift. |
-c %-----------------------------------%
-c
- else
-c
-c %----------------------------------------------------%
-c | Complex conjugate shifts ==> apply double shift QR |
-c %----------------------------------------------------%
-c
- h12 = h(istart,istart+1)
- h22 = h(istart+1,istart+1)
- h32 = h(istart+2,istart+1)
-c
-c %---------------------------------------------------------%
-c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
-c %---------------------------------------------------------%
-c
- s = 2.0*sigmar
- t = slapy2 ( sigmar, sigmai )
- u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
- u(2) = h11 + h22 - s
- u(3) = h32
-c
- do 90 i = istart, iend-1
-c
- nr = min ( 3, iend-i+1 )
-c
-c %-----------------------------------------------------%
-c | Construct Householder reflector G to zero out u(1). |
-c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
-c %-----------------------------------------------------%
-c
- call slarfg ( nr, u(1), u(2), 1, tau )
-c
- if (i .gt. istart) then
- h(i,i-1) = u(1)
- h(i+1,i-1) = zero
- if (i .lt. iend-1) h(i+2,i-1) = zero
- end if
- u(1) = one
-c
-c %--------------------------------------%
-c | Apply the reflector to the left of H |
-c %--------------------------------------%
-c
- call slarf ('Left', nr, kplusp-i+1, u, 1, tau,
- & h(i,i), ldh, workl)
-c
-c %---------------------------------------%
-c | Apply the reflector to the right of H |
-c %---------------------------------------%
-c
- ir = min ( i+3, iend )
- call slarf ('Right', ir, nr, u, 1, tau,
- & h(1,i), ldh, workl)
-c
-c %-----------------------------------------------------%
-c | Accumulate the reflector in the matrix Q; Q <- Q*G |
-c %-----------------------------------------------------%
-c
- call slarf ('Right', kplusp, nr, u, 1, tau,
- & q(1,i), ldq, workl)
-c
-c %----------------------------%
-c | Prepare for next reflector |
-c %----------------------------%
-c
- if (i .lt. iend-1) then
- u(1) = h(i+1,i)
- u(2) = h(i+2,i)
- if (i .lt. iend-2) u(3) = h(i+3,i)
- end if
-c
- 90 continue
-c
-c %--------------------------------------------%
-c | Finished applying a complex pair of shifts |
-c | to the current block |
-c %--------------------------------------------%
-c
- end if
-c
- 100 continue
-c
-c %---------------------------------------------------------%
-c | Apply the same shift to the next block if there is any. |
-c %---------------------------------------------------------%
-c
- istart = iend + 1
- if (iend .lt. kplusp) go to 20
-c
-c %---------------------------------------------%
-c | Loop back to the top to get the next shift. |
-c %---------------------------------------------%
-c
- 110 continue
-c
-c %--------------------------------------------------%
-c | Perform a similarity transformation that makes |
-c | sure that H will have non negative sub diagonals |
-c %--------------------------------------------------%
-c
- do 120 j=1,kev
- if ( h(j+1,j) .lt. zero ) then
- call sscal( kplusp-j+1, -one, h(j+1,j), ldh )
- call sscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
- call sscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
- end if
- 120 continue
-c
- do 130 i = 1, kev
-c
-c %--------------------------------------------%
-c | Final check for splitting and deflation. |
-c | Use a standard test as in the QR algorithm |
-c | REFERENCE: LAPACK subroutine slahqr |
-c %--------------------------------------------%
-c
- tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
- if( tst1.eq.zero )
- & tst1 = slanhs( '1', kev, h, ldh, workl )
- if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
- & h(i+1,i) = zero
- 130 continue
-c
-c %-------------------------------------------------%
-c | Compute the (kev+1)-st column of (V*Q) and |
-c | temporarily store the result in WORKD(N+1:2*N). |
-c | This is needed in the residual update since we |
-c | cannot GUARANTEE that the corresponding entry |
-c | of H would be zero as in exact arithmetic. |
-c %-------------------------------------------------%
-c
- if (h(kev+1,kev) .gt. zero)
- & call sgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
- & workd(n+1), 1)
-c
-c %----------------------------------------------------------%
-c | Compute column 1 to kev of (V*Q) in backward order |
-c | taking advantage of the upper Hessenberg structure of Q. |
-c %----------------------------------------------------------%
-c
- do 140 i = 1, kev
- call sgemv ('N', n, kplusp-i+1, one, v, ldv,
- & q(1,kev-i+1), 1, zero, workd, 1)
- call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
- 140 continue
-c
-c %-------------------------------------------------%
-c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
-c %-------------------------------------------------%
-c
- call slacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
-c
-c %--------------------------------------------------------------%
-c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
-c %--------------------------------------------------------------%
-c
- if (h(kev+1,kev) .gt. zero)
- & call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
-c
-c %-------------------------------------%
-c | Update the residual vector: |
-c | r <- sigmak*r + betak*v(:,kev+1) |
-c | where |
-c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
-c | betak = e_{kev+1}'*H*e_{kev} |
-c %-------------------------------------%
-c
- call sscal (n, q(kplusp,kev), resid, 1)
- if (h(kev+1,kev) .gt. zero)
- & call saxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
-c
- if (msglvl .gt. 1) then
- call svout (logfil, 1, q(kplusp,kev), ndigit,
- & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
- call svout (logfil, 1, h(kev+1,kev), ndigit,
- & '_napps: betak = e_{kev+1}^T*H*e_{kev}')
- call ivout (logfil, 1, kev, ndigit,
- & '_napps: Order of the final Hessenberg matrix ')
- if (msglvl .gt. 2) then
- call smout (logfil, kev, kev, h, ldh, ndigit,
- & '_napps: updated Hessenberg matrix H for next iteration')
- end if
-c
- end if
-c
- 9000 continue
- call arscnd (t1)
- tnapps = tnapps + (t1 - t0)
-c
- return
-c
-c %---------------%
-c | End of snapps |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/snaup2.f b/netlib/ARPACK/snaup2.f
deleted file mode 100644
index fbe951b..0000000
--- a/netlib/ARPACK/snaup2.f
+++ /dev/null
@@ -1,847 +0,0 @@
-c\BeginDoc
-c
-c\Name: snaup2
-c
-c\Description:
-c Intermediate level interface called by snaupd.
-c
-c\Usage:
-c call snaup2
-c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
-c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
-c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
-c
-c\Arguments
-c
-c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in snaupd.
-c MODE, ISHIFT, MXITER: see the definition of IPARAM in snaupd.
-c
-c NP Integer. (INPUT/OUTPUT)
-c Contains the number of implicit shifts to apply during
-c each Arnoldi iteration.
-c If ISHIFT=1, NP is adjusted dynamically at each iteration
-c to accelerate convergence and prevent stagnation.
-c This is also roughly equal to the number of matrix-vector
-c products (involving the operator OP) per Arnoldi iteration.
-c The logic for adjusting is contained within the current
-c subroutine.
-c If ISHIFT=0, NP is the number of shifts the user needs
-c to provide via reverse comunication. 0 < NP < NCV-NEV.
-c NP may be less than NCV-NEV for two reasons. The first, is
-c to keep complex conjugate pairs of "wanted" Ritz values
-c together. The second, is that a leading block of the current
-c upper Hessenberg matrix has split off and contains "unwanted"
-c Ritz values.
-c Upon termination of the IRA iteration, NP contains the number
-c of "converged" wanted Ritz values.
-c
-c IUPD Integer. (INPUT)
-c IUPD .EQ. 0: use explicit restart instead implicit update.
-c IUPD .NE. 0: use implicit update.
-c
-c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
-c The Arnoldi basis vectors are returned in the first NEV
-c columns of V.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Real (NEV+NP) by (NEV+NP) array. (OUTPUT)
-c H is used to store the generated upper Hessenberg matrix
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RITZR, Real arrays of length NEV+NP. (OUTPUT)
-c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
-c imaginary) part of the computed Ritz values of OP.
-c
-c BOUNDS Real array of length NEV+NP. (OUTPUT)
-c BOUNDS(1:NEV) contain the error bounds corresponding to
-c the computed Ritz values.
-c
-c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
-c Private (replicated) work array used to accumulate the
-c rotation in the shift application step.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Real work array of length at least
-c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. It is used in shifts calculation, shifts
-c application and convergence checking.
-c
-c On exit, the last 3*(NEV+NP) locations of WORKL contain
-c the Ritz values (real,imaginary) and associated Ritz
-c estimates of the current Hessenberg matrix. They are
-c listed in the same order as returned from sneigh.
-c
-c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
-c of WORKL are used in reverse communication to hold the user
-c supplied shifts.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD for
-c vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in the
-c shift-and-invert mode. X is the current operand.
-c -------------------------------------------------------------
-c
-c WORKD Real work array of length 3*N. (WORKSPACE)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration !!!!!!!!!!
-c See Data Distribution Note in DNAUPD.
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal return.
-c = 1: Maximum number of iterations taken.
-c All possible eigenvalues of OP has been found.
-c NP returns the number of converged Ritz values.
-c = 2: No shifts could be applied.
-c = -8: Error return from LAPACK eigenvalue calculation;
-c This should never happen.
-c = -9: Starting vector is zero.
-c = -9999: Could not build an Arnoldi factorization.
-c Size that was built in returned in NP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c sgetv0 ARPACK initial vector generation routine.
-c snaitr ARPACK Arnoldi factorization routine.
-c snapps ARPACK application of implicit shifts routine.
-c snconv ARPACK convergence of Ritz values routine.
-c sneigh ARPACK compute Ritz values and error bounds routine.
-c sngets ARPACK reorder Ritz values and error bounds routine.
-c ssortc ARPACK sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c smout ARPACK utility routine that prints matrices
-c svout ARPACK utility routine that prints vectors.
-c slamch LAPACK routine that determines machine constants.
-c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c scopy Level 1 BLAS that copies one vector to another .
-c sdot Level 1 BLAS that computes the scalar product of two vectors.
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c sswap Level 1 BLAS that swaps two vectors.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2
-c
-c\Remarks
-c 1. None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine snaup2
- & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
- & q, ldq, workl, ipntr, workd, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
- & n, nev, np
- Real
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(13)
- Real
- & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
- & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
- & workd(3*n), workl( (nev+np)*(nev+np+3) )
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0 , zero = 0.0E+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character wprime*2
- logical cnorm , getv0, initv, update, ushift
- integer ierr , iter , j , kplusp, msglvl, nconv,
- & nevbef, nev0 , np0 , nptemp, numcnv
- Real
- & rnorm , temp , eps23
- save cnorm , getv0, initv, update, ushift,
- & rnorm , iter , eps23, kplusp, msglvl, nconv ,
- & nevbef, nev0 , np0 , numcnv
-c
-c %-----------------------%
-c | Local array arguments |
-c %-----------------------%
-c
- integer kp(4)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy , sgetv0, snaitr, snconv, sneigh,
- & sngets, snapps, svout , ivout , arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & sdot, snrm2, slapy2, slamch
- external sdot, snrm2, slapy2, slamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic min, max, abs, sqrt
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
- call arscnd (t0)
-c
- msglvl = mnaup2
-c
-c %-------------------------------------%
-c | Get the machine dependent constant. |
-c %-------------------------------------%
-c
- eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0 )
-c
- nev0 = nev
- np0 = np
-c
-c %-------------------------------------%
-c | kplusp is the bound on the largest |
-c | Lanczos factorization built. |
-c | nconv is the current number of |
-c | "converged" eigenvlues. |
-c | iter is the counter on the current |
-c | iteration step. |
-c %-------------------------------------%
-c
- kplusp = nev + np
- nconv = 0
- iter = 0
-c
-c %---------------------------------------%
-c | Set flags for computing the first NEV |
-c | steps of the Arnoldi factorization. |
-c %---------------------------------------%
-c
- getv0 = .true.
- update = .false.
- ushift = .false.
- cnorm = .false.
-c
- if (info .ne. 0) then
-c
-c %--------------------------------------------%
-c | User provides the initial residual vector. |
-c %--------------------------------------------%
-c
- initv = .true.
- info = 0
- else
- initv = .false.
- end if
- end if
-c
-c %---------------------------------------------%
-c | Get a possibly random starting vector and |
-c | force it into the range of the operator OP. |
-c %---------------------------------------------%
-c
- 10 continue
-c
- if (getv0) then
- call sgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
- & ipntr, workd, info)
-c
- if (ido .ne. 99) go to 9000
-c
- if (rnorm .eq. zero) then
-c
-c %-----------------------------------------%
-c | The initial vector is zero. Error exit. |
-c %-----------------------------------------%
-c
- info = -9
- go to 1100
- end if
- getv0 = .false.
- ido = 0
- end if
-c
-c %-----------------------------------%
-c | Back from reverse communication : |
-c | continue with update step |
-c %-----------------------------------%
-c
- if (update) go to 20
-c
-c %-------------------------------------------%
-c | Back from computing user specified shifts |
-c %-------------------------------------------%
-c
- if (ushift) go to 50
-c
-c %-------------------------------------%
-c | Back from computing residual norm |
-c | at the end of the current iteration |
-c %-------------------------------------%
-c
- if (cnorm) go to 100
-c
-c %----------------------------------------------------------%
-c | Compute the first NEV steps of the Arnoldi factorization |
-c %----------------------------------------------------------%
-c
- call snaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
-c
-c %--------------------------------------------------------------%
-c | |
-c | M A I N ARNOLDI I T E R A T I O N L O O P |
-c | Each iteration implicitly restarts the Arnoldi |
-c | factorization in place. |
-c | |
-c %--------------------------------------------------------------%
-c
- 1000 continue
-c
- iter = iter + 1
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, iter, ndigit,
- & '_naup2: **** Start of major iteration number ****')
- end if
-c
-c %-----------------------------------------------------------%
-c | Compute NP additional steps of the Arnoldi factorization. |
-c | Adjust NP since NEV might have been updated by last call |
-c | to the shift application routine snapps. |
-c %-----------------------------------------------------------%
-c
- np = kplusp - nev
-c
- if (msglvl .gt. 1) then
- call ivout (logfil, 1, nev, ndigit,
- & '_naup2: The length of the current Arnoldi factorization')
- call ivout (logfil, 1, np, ndigit,
- & '_naup2: Extend the Arnoldi factorization by')
- end if
-c
-c %-----------------------------------------------------------%
-c | Compute NP additional steps of the Arnoldi factorization. |
-c %-----------------------------------------------------------%
-c
- ido = 0
- 20 continue
- update = .true.
-c
- call snaitr (ido , bmat, n , nev, np , mode , resid,
- & rnorm, v , ldv, h , ldh, ipntr, workd,
- & info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
- update = .false.
-c
- if (msglvl .gt. 1) then
- call svout (logfil, 1, rnorm, ndigit,
- & '_naup2: Corresponding B-norm of the residual')
- end if
-c
-c %--------------------------------------------------------%
-c | Compute the eigenvalues and corresponding error bounds |
-c | of the current upper Hessenberg matrix. |
-c %--------------------------------------------------------%
-c
- call sneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds,
- & q, ldq, workl, ierr)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 1200
- end if
-c
-c %----------------------------------------------------%
-c | Make a copy of eigenvalues and corresponding error |
-c | bounds obtained from sneigh. |
-c %----------------------------------------------------%
-c
- call scopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1)
- call scopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
- call scopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
-c
-c %---------------------------------------------------%
-c | Select the wanted Ritz values and their bounds |
-c | to be used in the convergence test. |
-c | The wanted part of the spectrum and corresponding |
-c | error bounds are in the last NEV loc. of RITZR, |
-c | RITZI and BOUNDS respectively. The variables NEV |
-c | and NP may be updated if the NEV-th wanted Ritz |
-c | value has a non zero imaginary part. In this case |
-c | NEV is increased by one and NP decreased by one. |
-c | NOTE: The last two arguments of sngets are no |
-c | longer used as of version 2.1. |
-c %---------------------------------------------------%
-c
- nev = nev0
- np = np0
- numcnv = nev
- call sngets (ishift, which, nev, np, ritzr, ritzi,
- & bounds, workl, workl(np+1))
- if (nev .eq. nev0+1) numcnv = nev0+1
-c
-c %-------------------%
-c | Convergence test. |
-c %-------------------%
-c
- call scopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
- call snconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
- & tol, nconv)
-c
- if (msglvl .gt. 2) then
- kp(1) = nev
- kp(2) = np
- kp(3) = numcnv
- kp(4) = nconv
- call ivout (logfil, 4, kp, ndigit,
- & '_naup2: NEV, NP, NUMCNV, NCONV are')
- call svout (logfil, kplusp, ritzr, ndigit,
- & '_naup2: Real part of the eigenvalues of H')
- call svout (logfil, kplusp, ritzi, ndigit,
- & '_naup2: Imaginary part of the eigenvalues of H')
- call svout (logfil, kplusp, bounds, ndigit,
- & '_naup2: Ritz estimates of the current NCV Ritz values')
- end if
-c
-c %---------------------------------------------------------%
-c | Count the number of unwanted Ritz values that have zero |
-c | Ritz estimates. If any Ritz estimates are equal to zero |
-c | then a leading block of H of order equal to at least |
-c | the number of Ritz values with zero Ritz estimates has |
-c | split off. None of these Ritz values may be removed by |
-c | shifting. Decrease NP the number of shifts to apply. If |
-c | no shifts may be applied, then prepare to exit |
-c %---------------------------------------------------------%
-c
- nptemp = np
- do 30 j=1, nptemp
- if (bounds(j) .eq. zero) then
- np = np - 1
- nev = nev + 1
- end if
- 30 continue
-c
- if ( (nconv .ge. numcnv) .or.
- & (iter .gt. mxiter) .or.
- & (np .eq. 0) ) then
-c
- if (msglvl .gt. 4) then
- call svout(logfil, kplusp, workl(kplusp**2+1), ndigit,
- & '_naup2: Real part of the eig computed by _neigh:')
- call svout(logfil, kplusp, workl(kplusp**2+kplusp+1),
- & ndigit,
- & '_naup2: Imag part of the eig computed by _neigh:')
- call svout(logfil, kplusp, workl(kplusp**2+kplusp*2+1),
- & ndigit,
- & '_naup2: Ritz eistmates computed by _neigh:')
- end if
-c
-c %------------------------------------------------%
-c | Prepare to exit. Put the converged Ritz values |
-c | and corresponding bounds in RITZ(1:NCONV) and |
-c | BOUNDS(1:NCONV) respectively. Then sort. Be |
-c | careful when NCONV > NP |
-c %------------------------------------------------%
-c
-c %------------------------------------------%
-c | Use h( 3,1 ) as storage to communicate |
-c | rnorm to _neupd if needed |
-c %------------------------------------------%
-
- h(3,1) = rnorm
-c
-c %----------------------------------------------%
-c | To be consistent with sngets, we first do a |
-c | pre-processing sort in order to keep complex |
-c | conjugate pairs together. This is similar |
-c | to the pre-processing sort used in sngets |
-c | except that the sort is done in the opposite |
-c | order. |
-c %----------------------------------------------%
-c
- if (which .eq. 'LM') wprime = 'SR'
- if (which .eq. 'SM') wprime = 'LR'
- if (which .eq. 'LR') wprime = 'SM'
- if (which .eq. 'SR') wprime = 'LM'
- if (which .eq. 'LI') wprime = 'SM'
- if (which .eq. 'SI') wprime = 'LM'
-c
- call ssortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
-c
-c %----------------------------------------------%
-c | Now sort Ritz values so that converged Ritz |
-c | values appear within the first NEV locations |
-c | of ritzr, ritzi and bounds, and the most |
-c | desired one appears at the front. |
-c %----------------------------------------------%
-c
- if (which .eq. 'LM') wprime = 'SM'
- if (which .eq. 'SM') wprime = 'LM'
- if (which .eq. 'LR') wprime = 'SR'
- if (which .eq. 'SR') wprime = 'LR'
- if (which .eq. 'LI') wprime = 'SI'
- if (which .eq. 'SI') wprime = 'LI'
-c
- call ssortc(wprime, .true., kplusp, ritzr, ritzi, bounds)
-c
-c %--------------------------------------------------%
-c | Scale the Ritz estimate of each Ritz value |
-c | by 1 / max(eps23,magnitude of the Ritz value). |
-c %--------------------------------------------------%
-c
- do 35 j = 1, numcnv
- temp = max(eps23,slapy2(ritzr(j),
- & ritzi(j)))
- bounds(j) = bounds(j)/temp
- 35 continue
-c
-c %----------------------------------------------------%
-c | Sort the Ritz values according to the scaled Ritz |
-c | esitmates. This will push all the converged ones |
-c | towards the front of ritzr, ritzi, bounds |
-c | (in the case when NCONV < NEV.) |
-c %----------------------------------------------------%
-c
- wprime = 'LR'
- call ssortc(wprime, .true., numcnv, bounds, ritzr, ritzi)
-c
-c %----------------------------------------------%
-c | Scale the Ritz estimate back to its original |
-c | value. |
-c %----------------------------------------------%
-c
- do 40 j = 1, numcnv
- temp = max(eps23, slapy2(ritzr(j),
- & ritzi(j)))
- bounds(j) = bounds(j)*temp
- 40 continue
-c
-c %------------------------------------------------%
-c | Sort the converged Ritz values again so that |
-c | the "threshold" value appears at the front of |
-c | ritzr, ritzi and bound. |
-c %------------------------------------------------%
-c
- call ssortc(which, .true., nconv, ritzr, ritzi, bounds)
-c
- if (msglvl .gt. 1) then
- call svout (logfil, kplusp, ritzr, ndigit,
- & '_naup2: Sorted real part of the eigenvalues')
- call svout (logfil, kplusp, ritzi, ndigit,
- & '_naup2: Sorted imaginary part of the eigenvalues')
- call svout (logfil, kplusp, bounds, ndigit,
- & '_naup2: Sorted ritz estimates.')
- end if
-c
-c %------------------------------------%
-c | Max iterations have been exceeded. |
-c %------------------------------------%
-c
- if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
-c
-c %---------------------%
-c | No shifts to apply. |
-c %---------------------%
-c
- if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
-c
- np = nconv
- go to 1100
-c
- else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
-c
-c %-------------------------------------------------%
-c | Do not have all the requested eigenvalues yet. |
-c | To prevent possible stagnation, adjust the size |
-c | of NEV. |
-c %-------------------------------------------------%
-c
- nevbef = nev
- nev = nev + min(nconv, np/2)
- if (nev .eq. 1 .and. kplusp .ge. 6) then
- nev = kplusp / 2
- else if (nev .eq. 1 .and. kplusp .gt. 3) then
- nev = 2
- end if
-c %---- Scipy fix ------------------------------------------------
-c | We must keep nev below this value, as otherwise we can get
-c | np == 0 (note that sngets below can bump nev by 1). If np == 0,
-c | the next call to `snaitr` will write out-of-bounds.
-c |
- if (nev .gt. kplusp - 2) then
- nev = kplusp - 2
- end if
-c |
-c %---- Scipy fix end --------------------------------------------
-
-c
- np = kplusp - nev
-c
-c %---------------------------------------%
-c | If the size of NEV was just increased |
-c | resort the eigenvalues. |
-c %---------------------------------------%
-c
- if (nevbef .lt. nev)
- & call sngets (ishift, which, nev, np, ritzr, ritzi,
- & bounds, workl, workl(np+1))
-c
- end if
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, nconv, ndigit,
- & '_naup2: no. of "converged" Ritz values at this iter.')
- if (msglvl .gt. 1) then
- kp(1) = nev
- kp(2) = np
- call ivout (logfil, 2, kp, ndigit,
- & '_naup2: NEV and NP are')
- call svout (logfil, nev, ritzr(np+1), ndigit,
- & '_naup2: "wanted" Ritz values -- real part')
- call svout (logfil, nev, ritzi(np+1), ndigit,
- & '_naup2: "wanted" Ritz values -- imag part')
- call svout (logfil, nev, bounds(np+1), ndigit,
- & '_naup2: Ritz estimates of the "wanted" values ')
- end if
- end if
-c
- if (ishift .eq. 0) then
-c
-c %-------------------------------------------------------%
-c | User specified shifts: reverse comminucation to |
-c | compute the shifts. They are returned in the first |
-c | 2*NP locations of WORKL. |
-c %-------------------------------------------------------%
-c
- ushift = .true.
- ido = 3
- go to 9000
- end if
-c
- 50 continue
-c
-c %------------------------------------%
-c | Back from reverse communication; |
-c | User specified shifts are returned |
-c | in WORKL(1:2*NP) |
-c %------------------------------------%
-c
- ushift = .false.
-c
- if ( ishift .eq. 0 ) then
-c
-c %----------------------------------%
-c | Move the NP shifts from WORKL to |
-c | RITZR, RITZI to free up WORKL |
-c | for non-exact shift case. |
-c %----------------------------------%
-c
- call scopy (np, workl, 1, ritzr, 1)
- call scopy (np, workl(np+1), 1, ritzi, 1)
- end if
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, np, ndigit,
- & '_naup2: The number of shifts to apply ')
- call svout (logfil, np, ritzr, ndigit,
- & '_naup2: Real part of the shifts')
- call svout (logfil, np, ritzi, ndigit,
- & '_naup2: Imaginary part of the shifts')
- if ( ishift .eq. 1 )
- & call svout (logfil, np, bounds, ndigit,
- & '_naup2: Ritz estimates of the shifts')
- end if
-c
-c %---------------------------------------------------------%
-c | Apply the NP implicit shifts by QR bulge chasing. |
-c | Each shift is applied to the whole upper Hessenberg |
-c | matrix H. |
-c | The first 2*N locations of WORKD are used as workspace. |
-c %---------------------------------------------------------%
-c
- call snapps (n, nev, np, ritzr, ritzi, v, ldv,
- & h, ldh, resid, q, ldq, workl, workd)
-c
-c %---------------------------------------------%
-c | Compute the B-norm of the updated residual. |
-c | Keep B*RESID in WORKD(1:N) to be used in |
-c | the first step of the next call to snaitr. |
-c %---------------------------------------------%
-c
- cnorm = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(n+1), 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*RESID |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd, 1)
- end if
-c
- 100 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(1:N) := B*RESID |
-c %----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- if (bmat .eq. 'G') then
- rnorm = sdot (n, resid, 1, workd, 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = snrm2(n, resid, 1)
- end if
- cnorm = .false.
-c
- if (msglvl .gt. 2) then
- call svout (logfil, 1, rnorm, ndigit,
- & '_naup2: B-norm of residual for compressed factorization')
- call smout (logfil, nev, nev, h, ldh, ndigit,
- & '_naup2: Compressed upper Hessenberg matrix H')
- end if
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 1100 continue
-c
- mxiter = iter
- nev = numcnv
-c
- 1200 continue
- ido = 99
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- call arscnd (t1)
- tnaup2 = t1 - t0
-c
- 9000 continue
-c
-c %---------------%
-c | End of snaup2 |
-c %---------------%
-c
- return
- end
diff --git a/netlib/ARPACK/snaupd.f b/netlib/ARPACK/snaupd.f
deleted file mode 100644
index e856bcf..0000000
--- a/netlib/ARPACK/snaupd.f
+++ /dev/null
@@ -1,693 +0,0 @@
-c\BeginDoc
-c
-c\Name: snaupd
-c
-c\Description:
-c Reverse communication interface for the Implicitly Restarted Arnoldi
-c iteration. This subroutine computes approximations to a few eigenpairs
-c of a linear operator "OP" with respect to a semi-inner product defined by
-c a symmetric positive semi-definite real matrix B. B may be the identity
-c matrix. NOTE: If the linear operator "OP" is real and symmetric
-c with respect to the real positive semi-definite symmetric matrix B,
-c i.e. B*OP = (OP`)*B, then subroutine ssaupd should be used instead.
-c
-c The computed approximate eigenvalues are called Ritz values and
-c the corresponding approximate eigenvectors are called Ritz vectors.
-c
-c snaupd is usually called iteratively to solve one of the
-c following problems:
-c
-c Mode 1: A*x = lambda*x.
-c ===> OP = A and B = I.
-c
-c Mode 2: A*x = lambda*M*x, M symmetric positive definite
-c ===> OP = inv[M]*A and B = M.
-c ===> (If M can be factored see remark 3 below)
-c
-c Mode 3: A*x = lambda*M*x, M symmetric semi-definite
-c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
-c ===> shift-and-invert mode (in real arithmetic)
-c If OP*x = amu*x, then
-c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
-c Note: If sigma is real, i.e. imaginary part of sigma is zero;
-c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
-c amu == 1/(lambda-sigma).
-c
-c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
-c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
-c ===> shift-and-invert mode (in real arithmetic)
-c If OP*x = amu*x, then
-c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
-c
-c Both mode 3 and 4 give the same enhancement to eigenvalues close to
-c the (complex) shift sigma. However, as lambda goes to infinity,
-c the operator OP in mode 4 dampens the eigenvalues more strongly than
-c does OP defined in mode 3.
-c
-c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
-c should be accomplished either by a direct method
-c using a sparse matrix factorization and solving
-c
-c [A - sigma*M]*w = v or M*w = v,
-c
-c or through an iterative method for solving these
-c systems. If an iterative method is used, the
-c convergence test must be more stringent than
-c the accuracy requirements for the eigenvalue
-c approximations.
-c
-c\Usage:
-c call snaupd
-c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
-c IPNTR, WORKD, WORKL, LWORKL, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag. IDO must be zero on the first
-c call to snaupd. IDO will be set internally to
-c indicate the type of operation to be performed. Control is
-c then given back to the calling routine which has the
-c responsibility to carry out the requested operation and call
-c snaupd with the result. The operand is given in
-c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c This is for the initialization phase to force the
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c In mode 3 and 4, the vector B * X is already
-c available in WORKD(ipntr(3)). It does not
-c need to be recomputed in forming OP * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c IDO = 3: compute the IPARAM(8) real and imaginary parts
-c of the shifts where INPTR(14) is the pointer
-c into WORKL for placing the shifts. See Remark
-c 5 below.
-c IDO = 99: done
-c -------------------------------------------------------------
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B that defines the
-c semi-inner product for the operator OP.
-c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
-c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c WHICH Character*2. (INPUT)
-c 'LM' -> want the NEV eigenvalues of largest magnitude.
-c 'SM' -> want the NEV eigenvalues of smallest magnitude.
-c 'LR' -> want the NEV eigenvalues of largest real part.
-c 'SR' -> want the NEV eigenvalues of smallest real part.
-c 'LI' -> want the NEV eigenvalues of largest imaginary part.
-c 'SI' -> want the NEV eigenvalues of smallest imaginary part.
-c
-c NEV Integer. (INPUT)
-c Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
-c
-c TOL Real scalar. (INPUT)
-c Stopping criterion: the relative accuracy of the Ritz value
-c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I))
-c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
-c DEFAULT = SLAMCH('EPS') (machine precision as computed
-c by the LAPACK auxiliary subroutine SLAMCH).
-c
-c RESID Real array of length N. (INPUT/OUTPUT)
-c On INPUT:
-c If INFO .EQ. 0, a random initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c On OUTPUT:
-c RESID contains the final residual vector.
-c
-c NCV Integer. (INPUT)
-c Number of columns of the matrix V. NCV must satisfy the two
-c inequalities 2 <= NCV-NEV and NCV <= N.
-c This will indicate how many Arnoldi vectors are generated
-c at each iteration. After the startup phase in which NEV
-c Arnoldi vectors are generated, the algorithm generates
-c approximately NCV-NEV Arnoldi vectors at each subsequent update
-c iteration. Most of the cost in generating each Arnoldi vector is
-c in the matrix-vector operation OP*x.
-c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
-c values are kept together. (See remark 4 below)
-c
-c V Real array N by NCV. (OUTPUT)
-c Contains the final set of Arnoldi basis vectors.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling program.
-c
-c IPARAM Integer array of length 11. (INPUT/OUTPUT)
-c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
-c The shifts selected at each iteration are used to restart
-c the Arnoldi iteration in an implicit fashion.
-c -------------------------------------------------------------
-c ISHIFT = 0: the shifts are provided by the user via
-c reverse communication. The real and imaginary
-c parts of the NCV eigenvalues of the Hessenberg
-c matrix H are returned in the part of the WORKL
-c array corresponding to RITZR and RITZI. See remark
-c 5 below.
-c ISHIFT = 1: exact shifts with respect to the current
-c Hessenberg matrix H. This is equivalent to
-c restarting the iteration with a starting vector
-c that is a linear combination of approximate Schur
-c vectors associated with the "wanted" Ritz values.
-c -------------------------------------------------------------
-c
-c IPARAM(2) = No longer referenced.
-c
-c IPARAM(3) = MXITER
-c On INPUT: maximum number of Arnoldi update iterations allowed.
-c On OUTPUT: actual number of Arnoldi update iterations taken.
-c
-c IPARAM(4) = NB: blocksize to be used in the recurrence.
-c The code currently works only for NB = 1.
-c
-c IPARAM(5) = NCONV: number of "converged" Ritz values.
-c This represents the number of Ritz values that satisfy
-c the convergence criterion.
-c
-c IPARAM(6) = IUPD
-c No longer referenced. Implicit restarting is ALWAYS used.
-c
-c IPARAM(7) = MODE
-c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4; See under \Description of snaupd for the
-c four modes available.
-c
-c IPARAM(8) = NP
-c When ido = 3 and the user provides shifts through reverse
-c communication (IPARAM(1)=0), snaupd returns NP, the number
-c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
-c 5 below.
-c
-c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
-c OUTPUT: NUMOP = total number of OP*x operations,
-c NUMOPB = total number of B*x operations if BMAT='G',
-c NUMREO = total number of steps of re-orthogonalization.
-c
-c IPNTR Integer array of length 14. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD and WORKL
-c arrays for matrices/vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X in WORKD.
-c IPNTR(2): pointer to the current result vector Y in WORKD.
-c IPNTR(3): pointer to the vector B * X in WORKD when used in
-c the shift-and-invert mode.
-c IPNTR(4): pointer to the next available location in WORKL
-c that is untouched by the program.
-c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
-c H in WORKL.
-c IPNTR(6): pointer to the real part of the ritz value array
-c RITZR in WORKL.
-c IPNTR(7): pointer to the imaginary part of the ritz value array
-c RITZI in WORKL.
-c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
-c with the Ritz values located in RITZR and RITZI in WORKL.
-c
-c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
-c
-c Note: IPNTR(9:13) is only referenced by sneupd. See Remark 2 below.
-c
-c IPNTR(9): pointer to the real part of the NCV RITZ values of the
-c original system.
-c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
-c the original system.
-c IPNTR(11): pointer to the NCV corresponding error bounds.
-c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular
-c Schur matrix for H.
-c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors
-c of the upper Hessenberg matrix H. Only referenced by
-c sneupd if RVEC = .TRUE. See Remark 2 below.
-c -------------------------------------------------------------
-c
-c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration. Upon termination
-c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace
-c associated with the converged Ritz values is desired, see remark
-c 2 below, subroutine sneupd uses this output.
-c See Data Distribution Note below.
-c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. See Data Distribution Note below.
-c
-c LWORKL Integer. (INPUT)
-c LWORKL must be at least 3*NCV**2 + 6*NCV.
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal exit.
-c = 1: Maximum number of iterations taken.
-c All possible eigenvalues of OP has been found. IPARAM(5)
-c returns the number of wanted converged Ritz values.
-c = 2: No longer an informational error. Deprecated starting
-c with release 2 of ARPACK.
-c = 3: No shifts could be applied during a cycle of the
-c Implicitly restarted Arnoldi iteration. One possibility
-c is to increase the size of NCV relative to NEV.
-c See remark 4 below.
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
-c = -4: The maximum number of Arnoldi update iteration
-c must be greater than zero.
-c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work array is not sufficient.
-c = -8: Error return from LAPACK eigenvalue calculation;
-c = -9: Starting vector is zero.
-c = -10: IPARAM(7) must be 1,2,3,4.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
-c = -12: IPARAM(1) must be equal to 0 or 1.
-c = -9999: Could not build an Arnoldi factorization.
-c IPARAM(5) returns the size of the current Arnoldi
-c factorization.
-c
-c\Remarks
-c 1. The computed Ritz values are approximate eigenvalues of OP. The
-c selection of WHICH should be made with this in mind when
-c Mode = 3 and 4. After convergence, approximate eigenvalues of the
-c original problem may be obtained with the ARPACK subroutine sneupd.
-c
-c 2. If a basis for the invariant subspace corresponding to the converged Ritz
-c values is needed, the user must call sneupd immediately following
-c completion of snaupd. This is new starting with release 2 of ARPACK.
-c
-c 3. If M can be factored into a Cholesky factorization M = LL`
-c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
-c linear systems should be solved with L and L` rather
-c than computing inverses. After convergence, an approximate
-c eigenvector z of the original problem is recovered by solving
-c L`z = x where x is a Ritz vector of OP.
-c
-c 4. At present there is no a-priori analysis to guide the selection
-c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2.
-c However, it is recommended that NCV .ge. 2*NEV+1. If many problems of
-c the same type are to be solved, one should experiment with increasing
-c NCV while keeping NEV fixed for a given test problem. This will
-c usually decrease the required number of OP*x operations but it
-c also increases the work and storage required to maintain the orthogonal
-c basis vectors. The optimal "cross-over" with respect to CPU time
-c is problem dependent and must be determined empirically.
-c See Chapter 8 of Reference 2 for further information.
-c
-c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
-c NP = IPARAM(8) real and imaginary parts of the shifts in locations
-c real part imaginary part
-c ----------------------- --------------
-c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
-c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
-c . .
-c . .
-c . .
-c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
-c
-c Only complex conjugate pairs of shifts may be applied and the pairs
-c must be placed in consecutive locations. The real part of the
-c eigenvalues of the current upper Hessenberg matrix are located in
-c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
-c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
-c according to the order defined by WHICH. The complex conjugate
-c pairs are kept together and the associated Ritz estimates are located in
-c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
-c
-c-----------------------------------------------------------------------
-c
-c\Data Distribution Note:
-c
-c Fortran-D syntax:
-c ================
-c Real resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
-c decompose d1(n), d2(n,ncv)
-c align resid(i) with d1(i)
-c align v(i,j) with d2(i,j)
-c align workd(i) with d1(i) range (1:n)
-c align workd(i) with d1(i-n) range (n+1:2*n)
-c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
-c distribute d1(block), d2(block,:)
-c replicated workl(lworkl)
-c
-c Cray MPP syntax:
-c ===============
-c Real resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
-c shared resid(block), v(block,:), workd(block,:)
-c replicated workl(lworkl)
-c
-c CM2/CM5 syntax:
-c ==============
-c
-c-----------------------------------------------------------------------
-c
-c include 'ex-nonsym.doc'
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
-c Real Matrices", Linear Algebra and its Applications, vol 88/89,
-c pp 575-595, (1987).
-c
-c\Routines called:
-c snaup2 ARPACK routine that implements the Implicitly Restarted
-c Arnoldi Iteration.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine that prints vectors.
-c slamch LAPACK routine that determines machine constants.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/16/93: Version '1.1'
-c
-c\SCCS Information: @(#)
-c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
-c
-c\Remarks
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine snaupd
- & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam,
- & ipntr, workd, workl, lworkl, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ldv, lworkl, n, ncv, nev
- Real
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(11), ipntr(14)
- Real
- & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0 , zero = 0.0E+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer bounds, ierr, ih, iq, ishift, iupd, iw,
- & ldh, ldq, levec, mode, msglvl, mxiter, nb,
- & nev0, next, np, ritzi, ritzr, j
- save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
- & levec, mode, msglvl, mxiter, nb, nev0, next,
- & np, ritzi, ritzr
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external snaup2, svout, ivout, arscnd, sstatn
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slamch
- external slamch
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call sstatn
- call arscnd (t0)
- msglvl = mnaupd
-c
-c %----------------%
-c | Error checking |
-c %----------------%
-c
- ierr = 0
- ishift = iparam(1)
-c levec = iparam(2)
- mxiter = iparam(3)
-c nb = iparam(4)
- nb = 1
-c
-c %--------------------------------------------%
-c | Revision 2 performs only implicit restart. |
-c %--------------------------------------------%
-c
- iupd = 1
- mode = iparam(7)
-c
- if (n .le. 0) then
- ierr = -1
- else if (nev .le. 0) then
- ierr = -2
- else if (ncv .le. nev+1 .or. ncv .gt. n) then
- ierr = -3
- else if (mxiter .le. 0) then
- ierr = -4
- else if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LR' .and.
- & which .ne. 'SR' .and.
- & which .ne. 'LI' .and.
- & which .ne. 'SI') then
- ierr = -5
- else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
- ierr = -6
- else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
- ierr = -7
- else if (mode .lt. 1 .or. mode .gt. 4) then
- ierr = -10
- else if (mode .eq. 1 .and. bmat .eq. 'G') then
- ierr = -11
- else if (ishift .lt. 0 .or. ishift .gt. 1) then
- ierr = -12
- end if
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- ido = 99
- go to 9000
- end if
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- if (nb .le. 0) nb = 1
- if (tol .le. zero) tol = slamch('EpsMach')
-c
-c %----------------------------------------------%
-c | NP is the number of additional steps to |
-c | extend the length NEV Lanczos factorization. |
-c | NEV0 is the local variable designating the |
-c | size of the invariant subspace desired. |
-c %----------------------------------------------%
-c
- np = ncv - nev
- nev0 = nev
-c
-c %-----------------------------%
-c | Zero out internal workspace |
-c %-----------------------------%
-c
- do 10 j = 1, 3*ncv**2 + 6*ncv
- workl(j) = zero
- 10 continue
-c
-c %-------------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:ncv*ncv) := generated Hessenberg matrix |
-c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
-c | parts of ritz values |
-c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
-c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
-c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
-c | The final workspace is needed by subroutine sneigh called |
-c | by snaup2. Subroutine sneigh calls LAPACK routines for |
-c | calculating eigenvalues and the last row of the eigenvector |
-c | matrix. |
-c %-------------------------------------------------------------%
-c
- ldh = ncv
- ldq = ncv
- ih = 1
- ritzr = ih + ldh*ncv
- ritzi = ritzr + ncv
- bounds = ritzi + ncv
- iq = bounds + ncv
- iw = iq + ldq*ncv
- next = iw + ncv**2 + 3*ncv
-c
- ipntr(4) = next
- ipntr(5) = ih
- ipntr(6) = ritzr
- ipntr(7) = ritzi
- ipntr(8) = bounds
- ipntr(14) = iw
-c
- end if
-c
-c %-------------------------------------------------------%
-c | Carry out the Implicitly restarted Arnoldi Iteration. |
-c %-------------------------------------------------------%
-c
- call snaup2
- & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
- & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
- & ipntr, workd, info )
-c
-c %--------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP or shifts. |
-c %--------------------------------------------------%
-c
- if (ido .eq. 3) iparam(8) = np
- if (ido .ne. 99) go to 9000
-c
- iparam(3) = mxiter
- iparam(5) = np
- iparam(9) = nopx
- iparam(10) = nbx
- iparam(11) = nrorth
-c
-c %------------------------------------%
-c | Exit if there was an informational |
-c | error within snaup2. |
-c %------------------------------------%
-c
- if (info .lt. 0) go to 9000
- if (info .eq. 2) info = 3
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, mxiter, ndigit,
- & '_naupd: Number of update iterations taken')
- call ivout (logfil, 1, np, ndigit,
- & '_naupd: Number of wanted "converged" Ritz values')
- call svout (logfil, np, workl(ritzr), ndigit,
- & '_naupd: Real part of the final Ritz values')
- call svout (logfil, np, workl(ritzi), ndigit,
- & '_naupd: Imaginary part of the final Ritz values')
- call svout (logfil, np, workl(bounds), ndigit,
- & '_naupd: Associated Ritz estimates')
- end if
-c
- call arscnd (t1)
- tnaupd = t1 - t0
-c
- if (msglvl .gt. 0) then
-c
-c %--------------------------------------------------------%
-c | Version Number & Version Date are defined in version.h |
-c %--------------------------------------------------------%
-c
- write (6,1000)
- write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
- & tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
- & tgetv0, tneigh, tngets, tnapps, tnconv, trvec
- 1000 format (//,
- & 5x, '=============================================',/
- & 5x, '= Nonsymmetric implicit Arnoldi update code =',/
- & 5x, '= Version Number: ', ' 2.4' , 21x, ' =',/
- & 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/
- & 5x, '=============================================',/
- & 5x, '= Summary of timing statistics =',/
- & 5x, '=============================================',//)
- 1100 format (
- & 5x, 'Total number update iterations = ', i5,/
- & 5x, 'Total number of OP*x operations = ', i5,/
- & 5x, 'Total number of B*x operations = ', i5,/
- & 5x, 'Total number of reorthogonalization steps = ', i5,/
- & 5x, 'Total number of iterative refinement steps = ', i5,/
- & 5x, 'Total number of restart steps = ', i5,/
- & 5x, 'Total time in user OP*x operation = ', f12.6,/
- & 5x, 'Total time in user B*x operation = ', f12.6,/
- & 5x, 'Total time in Arnoldi update routine = ', f12.6,/
- & 5x, 'Total time in naup2 routine = ', f12.6,/
- & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
- & 5x, 'Total time in reorthogonalization phase = ', f12.6,/
- & 5x, 'Total time in (re)start vector generation = ', f12.6,/
- & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
- & 5x, 'Total time in getting the shifts = ', f12.6,/
- & 5x, 'Total time in applying the shifts = ', f12.6,/
- & 5x, 'Total time in convergence testing = ', f12.6,/
- & 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
- end if
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of snaupd |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/snconv.f b/netlib/ARPACK/snconv.f
deleted file mode 100644
index 2ea7b1e..0000000
--- a/netlib/ARPACK/snconv.f
+++ /dev/null
@@ -1,146 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: snconv
-c
-c\Description:
-c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine.
-c
-c\Usage:
-c call snconv
-c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Number of Ritz values to check for convergence.
-c
-c RITZR, Real arrays of length N. (INPUT)
-c RITZI Real and imaginary parts of the Ritz values to be checked
-c for convergence.
-
-c BOUNDS Real array of length N. (INPUT)
-c Ritz estimates for the Ritz values in RITZR and RITZI.
-c
-c TOL Real scalar. (INPUT)
-c Desired backward error for a Ritz value to be considered
-c "converged".
-c
-c NCONV Integer scalar. (OUTPUT)
-c Number of "converged" Ritz values.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c arscnd ARPACK utility routine for timing.
-c slamch LAPACK routine that determines machine constants.
-c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\Remarks
-c 1. xxxx
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine snconv (n, ritzr, ritzi, bounds, tol, nconv)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer n, nconv
- Real
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-
- Real
- & ritzr(n), ritzi(n), bounds(n)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i
- Real
- & temp, eps23
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slapy2, slamch
- external slapy2, slamch
-
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------------------------------------%
-c | Convergence test: unlike in the symmetric code, I am not |
-c | using things like refined error bounds and gap condition |
-c | because I don't know the exact equivalent concept. |
-c | |
-c | Instead the i-th Ritz value is considered "converged" when: |
-c | |
-c | bounds(i) .le. ( TOL * | ritz | ) |
-c | |
-c | for some appropriate choice of norm. |
-c %-------------------------------------------------------------%
-c
- call arscnd (t0)
-c
-c %---------------------------------%
-c | Get machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0)
-c
- nconv = 0
- do 20 i = 1, n
- temp = max( eps23, slapy2( ritzr(i), ritzi(i) ) )
- if (bounds(i) .le. tol*temp) nconv = nconv + 1
- 20 continue
-c
- call arscnd (t1)
- tnconv = tnconv + (t1 - t0)
-c
- return
-c
-c %---------------%
-c | End of snconv |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sneigh.f b/netlib/ARPACK/sneigh.f
deleted file mode 100644
index 3b34222..0000000
--- a/netlib/ARPACK/sneigh.f
+++ /dev/null
@@ -1,314 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: sneigh
-c
-c\Description:
-c Compute the eigenvalues of the current upper Hessenberg matrix
-c and the corresponding Ritz estimates given the current residual norm.
-c
-c\Usage:
-c call sneigh
-c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
-c
-c\Arguments
-c RNORM Real scalar. (INPUT)
-c Residual norm corresponding to the current upper Hessenberg
-c matrix H.
-c
-c N Integer. (INPUT)
-c Size of the matrix H.
-c
-c H Real N by N array. (INPUT)
-c H contains the current upper Hessenberg matrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RITZR, Real arrays of length N. (OUTPUT)
-c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
-c (respectively imaginary) parts of the eigenvalues of H.
-c
-c BOUNDS Real array of length N. (OUTPUT)
-c On output, BOUNDS contains the Ritz estimates associated with
-c the eigenvalues RITZR and RITZI. This is equal to RNORM
-c times the last components of the eigenvectors corresponding
-c to the eigenvalues in RITZR and RITZI.
-c
-c Q Real N by N array. (WORKSPACE)
-c Workspace needed to store the eigenvectors of H.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Real work array of length N**2 + 3*N. (WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. This is needed to keep the full Schur form
-c of H and also in the calculation of the eigenvectors of H.
-c
-c IERR Integer. (OUTPUT)
-c Error exit flag from slaqrb or strevc.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c slaqrb ARPACK routine to compute the real Schur form of an
-c upper Hessenberg matrix and last row of the Schur vectors.
-c arscnd ARPACK utility routine for timing.
-c smout ARPACK utility routine that prints matrices
-c svout ARPACK utility routine that prints vectors.
-c slacpy LAPACK matrix copy routine.
-c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c strevc LAPACK routine to compute the eigenvectors of a matrix
-c in upper quasi-triangular form
-c sgemv Level 2 BLAS routine for matrix vector multiplication.
-c scopy Level 1 BLAS that copies one vector to another .
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c sscal Level 1 BLAS that scales a vector.
-c
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\Remarks
-c None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine sneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds,
- & q, ldq, workl, ierr)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer ierr, n, ldh, ldq
- Real
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
- & workl(n*(n+3))
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %------------------------%
-c | Local Scalars & Arrays |
-c %------------------------%
-c
- logical select(1)
- integer i, iconj, msglvl
- Real
- & temp, vl(1)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy, slacpy, slaqrb, strevc, svout, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slapy2, snrm2
- external slapy2, snrm2
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mneigh
-c
- if (msglvl .gt. 2) then
- call smout (logfil, n, n, h, ldh, ndigit,
- & '_neigh: Entering upper Hessenberg matrix H ')
- end if
-c
-c %-----------------------------------------------------------%
-c | 1. Compute the eigenvalues, the last components of the |
-c | corresponding Schur vectors and the full Schur form T |
-c | of the current upper Hessenberg matrix H. |
-c | slaqrb returns the full Schur form of H in WORKL(1:N**2) |
-c | and the last components of the Schur vectors in BOUNDS. |
-c %-----------------------------------------------------------%
-c
- call slacpy ('All', n, n, h, ldh, workl, n)
- call slaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
- & ierr)
- if (ierr .ne. 0) go to 9000
-c
- if (msglvl .gt. 1) then
- call svout (logfil, n, bounds, ndigit,
- & '_neigh: last row of the Schur matrix for H')
- end if
-c
-c %-----------------------------------------------------------%
-c | 2. Compute the eigenvectors of the full Schur form T and |
-c | apply the last components of the Schur vectors to get |
-c | the last components of the corresponding eigenvectors. |
-c | Remember that if the i-th and (i+1)-st eigenvalues are |
-c | complex conjugate pairs, then the real & imaginary part |
-c | of the eigenvector components are split across adjacent |
-c | columns of Q. |
-c %-----------------------------------------------------------%
-c
- call strevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
- & n, n, workl(n*n+1), ierr)
-c
- if (ierr .ne. 0) go to 9000
-c
-c %------------------------------------------------%
-c | Scale the returning eigenvectors so that their |
-c | euclidean norms are all one. LAPACK subroutine |
-c | strevc returns each eigenvector normalized so |
-c | that the element of largest magnitude has |
-c | magnitude 1; here the magnitude of a complex |
-c | number (x,y) is taken to be |x| + |y|. |
-c %------------------------------------------------%
-c
- iconj = 0
- do 10 i=1, n
- if ( abs( ritzi(i) ) .le. zero ) then
-c
-c %----------------------%
-c | Real eigenvalue case |
-c %----------------------%
-c
- temp = snrm2( n, q(1,i), 1 )
- call sscal ( n, one / temp, q(1,i), 1 )
- else
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c | columns, we further normalize by the |
-c | square root of two. |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- temp = slapy2( snrm2( n, q(1,i), 1 ),
- & snrm2( n, q(1,i+1), 1 ) )
- call sscal ( n, one / temp, q(1,i), 1 )
- call sscal ( n, one / temp, q(1,i+1), 1 )
- iconj = 1
- else
- iconj = 0
- end if
- end if
- 10 continue
-c
- call sgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
-c
- if (msglvl .gt. 1) then
- call svout (logfil, n, workl, ndigit,
- & '_neigh: Last row of the eigenvector matrix for H')
- end if
-c
-c %----------------------------%
-c | Compute the Ritz estimates |
-c %----------------------------%
-c
- iconj = 0
- do 20 i = 1, n
- if ( abs( ritzi(i) ) .le. zero ) then
-c
-c %----------------------%
-c | Real eigenvalue case |
-c %----------------------%
-c
- bounds(i) = rnorm * abs( workl(i) )
- else
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c | columns, we need to take the magnitude |
-c | of the last components of the two vectors |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- bounds(i) = rnorm * slapy2( workl(i), workl(i+1) )
- bounds(i+1) = bounds(i)
- iconj = 1
- else
- iconj = 0
- end if
- end if
- 20 continue
-c
- if (msglvl .gt. 2) then
- call svout (logfil, n, ritzr, ndigit,
- & '_neigh: Real part of the eigenvalues of H')
- call svout (logfil, n, ritzi, ndigit,
- & '_neigh: Imaginary part of the eigenvalues of H')
- call svout (logfil, n, bounds, ndigit,
- & '_neigh: Ritz estimates for the eigenvalues of H')
- end if
-c
- call arscnd (t1)
- tneigh = tneigh + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of sneigh |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sneupd.f b/netlib/ARPACK/sneupd.f
deleted file mode 100644
index 1f86d11..0000000
--- a/netlib/ARPACK/sneupd.f
+++ /dev/null
@@ -1,1067 +0,0 @@
-c\BeginDoc
-c
-c\Name: sneupd
-c
-c\Description:
-c
-c This subroutine returns the converged approximations to eigenvalues
-c of A*z = lambda*B*z and (optionally):
-c
-c (1) The corresponding approximate eigenvectors;
-c
-c (2) An orthonormal basis for the associated approximate
-c invariant subspace;
-c
-c (3) Both.
-c
-c There is negligible additional cost to obtain eigenvectors. An orthonormal
-c basis is always computed. There is an additional storage cost of n*nev
-c if both are requested (in this case a separate array Z must be supplied).
-c
-c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
-c are derived from approximate eigenvalues and eigenvectors of
-c of the linear operator OP prescribed by the MODE selection in the
-c call to SNAUPD. SNAUPD must be called before this routine is called.
-c These approximate eigenvalues and vectors are commonly called Ritz
-c values and Ritz vectors respectively. They are referred to as such
-c in the comments that follow. The computed orthonormal basis for the
-c invariant subspace corresponding to these Ritz values is referred to as a
-c Schur basis.
-c
-c See documentation in the header of the subroutine SNAUPD for
-c definition of OP as well as other terms and the relation of computed
-c Ritz values and Ritz vectors of OP with respect to the given problem
-c A*z = lambda*B*z. For a brief description, see definitions of
-c IPARAM(7), MODE and WHICH in the documentation of SNAUPD.
-c
-c\Usage:
-c call sneupd
-c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT,
-c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL,
-c LWORKL, INFO )
-c
-c\Arguments:
-c RVEC LOGICAL (INPUT)
-c Specifies whether a basis for the invariant subspace corresponding
-c to the converged Ritz value approximations for the eigenproblem
-c A*z = lambda*B*z is computed.
-c
-c RVEC = .FALSE. Compute Ritz values only.
-c
-c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
-c See Remarks below.
-c
-c HOWMNY Character*1 (INPUT)
-c Specifies the form of the basis for the invariant subspace
-c corresponding to the converged Ritz values that is to be computed.
-c
-c = 'A': Compute NEV Ritz vectors;
-c = 'P': Compute NEV Schur vectors;
-c = 'S': compute some of the Ritz vectors, specified
-c by the logical array SELECT.
-c
-c SELECT Logical array of dimension NCV. (INPUT)
-c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
-c computed. To select the Ritz vector corresponding to a
-c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE..
-c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace.
-c
-c DR Real array of dimension NEV+1. (OUTPUT)
-c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains
-c the real part of the Ritz approximations to the eigenvalues of
-c A*z = lambda*B*z.
-c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit:
-c DR contains the real part of the Ritz values of OP computed by
-c SNAUPD. A further computation must be performed by the user
-c to transform the Ritz values computed for OP by SNAUPD to those
-c of the original system A*z = lambda*B*z. See remark 3 below.
-c
-c DI Real array of dimension NEV+1. (OUTPUT)
-c On exit, DI contains the imaginary part of the Ritz value
-c approximations to the eigenvalues of A*z = lambda*B*z associated
-c with DR.
-c
-c NOTE: When Ritz values are complex, they will come in complex
-c conjugate pairs. If eigenvectors are requested, the
-c corresponding Ritz vectors will also come in conjugate
-c pairs and the real and imaginary parts of these are
-c represented in two consecutive columns of the array Z
-c (see below).
-c
-c Z Real N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT)
-c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of
-c Z represent approximate eigenvectors (Ritz vectors) corresponding
-c to the NCONV=IPARAM(5) Ritz values for eigensystem
-c A*z = lambda*B*z.
-c
-c The complex Ritz vector associated with the Ritz value
-c with positive imaginary part is stored in two consecutive
-c columns. The first column holds the real part of the Ritz
-c vector and the second column holds the imaginary part. The
-c Ritz vector associated with the Ritz value with negative
-c imaginary part is simply the complex conjugate of the Ritz vector
-c associated with the positive imaginary part.
-c
-c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced.
-c
-c NOTE: If if RVEC = .TRUE. and a Schur basis is not required,
-c the array Z may be set equal to first NEV+1 columns of the Arnoldi
-c basis array V computed by SNAUPD. In this case the Arnoldi basis
-c will be destroyed and overwritten with the eigenvector basis.
-c
-c LDZ Integer. (INPUT)
-c The leading dimension of the array Z. If Ritz vectors are
-c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1.
-c
-c SIGMAR Real (INPUT)
-c If IPARAM(7) = 3 or 4, represents the real part of the shift.
-c Not referenced if IPARAM(7) = 1 or 2.
-c
-c SIGMAI Real (INPUT)
-c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift.
-c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below.
-c
-c WORKEV Real work array of dimension 3*NCV. (WORKSPACE)
-c
-c **** The remaining arguments MUST be the same as for the ****
-c **** call to SNAUPD that was just completed. ****
-c
-c NOTE: The remaining arguments
-c
-c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR,
-c WORKD, WORKL, LWORKL, INFO
-c
-c must be passed directly to SNEUPD following the last call
-c to SNAUPD. These arguments MUST NOT BE MODIFIED between
-c the the last call to SNAUPD and the call to SNEUPD.
-c
-c Three of these parameters (V, WORKL, INFO) are also output parameters:
-c
-c V Real N by NCV array. (INPUT/OUTPUT)
-c
-c Upon INPUT: the NCV columns of V contain the Arnoldi basis
-c vectors for OP as constructed by SNAUPD .
-c
-c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
-c contain approximate Schur vectors that span the
-c desired invariant subspace. See Remark 2 below.
-c
-c NOTE: If the array Z has been set equal to first NEV+1 columns
-c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
-c Arnoldi basis held by V has been overwritten by the desired
-c Ritz vectors. If a separate array Z has been passed then
-c the first NCONV=IPARAM(5) columns of V will contain approximate
-c Schur vectors that span the desired invariant subspace.
-c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
-c WORKL(1:ncv*ncv+3*ncv) contains information obtained in
-c snaupd. They are not changed by sneupd.
-c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the
-c real and imaginary part of the untransformed Ritz values,
-c the upper quasi-triangular matrix for H, and the
-c associated matrix representation of the invariant subspace for H.
-c
-c Note: IPNTR(9:13) contains the pointer into WORKL for addresses
-c of the above information computed by sneupd.
-c -------------------------------------------------------------
-c IPNTR(9): pointer to the real part of the NCV RITZ values of the
-c original system.
-c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
-c the original system.
-c IPNTR(11): pointer to the NCV corresponding error bounds.
-c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular
-c Schur matrix for H.
-c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors
-c of the upper Hessenberg matrix H. Only referenced by
-c sneupd if RVEC = .TRUE. See Remark 2 below.
-c -------------------------------------------------------------
-c
-c INFO Integer. (OUTPUT)
-c Error flag on output.
-c
-c = 0: Normal exit.
-c
-c = 1: The Schur form computed by LAPACK routine slahqr
-c could not be reordered by LAPACK routine strsen.
-c Re-enter subroutine sneupd with IPARAM(5)=NCV and
-c increase the size of the arrays DR and DI to have
-c dimension at least dimension NCV and allocate at least NCV
-c columns for Z. NOTE: Not necessary if Z and V share
-c the same space. Please notify the authors if this error
-c occurs.
-c
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
-c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work WORKL array is not sufficient.
-c = -8: Error return from calculation of a real Schur form.
-c Informational error from LAPACK routine slahqr.
-c = -9: Error return from calculation of eigenvectors.
-c Informational error from LAPACK routine strevc.
-c = -10: IPARAM(7) must be 1,2,3,4.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
-c = -12: HOWMNY = 'S' not yet implemented
-c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
-c = -14: SNAUPD did not find any eigenvalues to sufficient
-c accuracy.
-c = -15: DNEUPD got a different count of the number of converged
-c Ritz values than DNAUPD got. This indicates the user
-c probably made an error in passing data from DNAUPD to
-c DNEUPD or that the data was modified before entering
-c DNEUPD
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
-c Real Matrices", Linear Algebra and its Applications, vol 88/89,
-c pp 575-595, (1987).
-c
-c\Routines called:
-c ivout ARPACK utility routine that prints integers.
-c smout ARPACK utility routine that prints matrices
-c svout ARPACK utility routine that prints vectors.
-c sgeqr2 LAPACK routine that computes the QR factorization of
-c a matrix.
-c slacpy LAPACK matrix copy routine.
-c slahqr LAPACK routine to compute the real Schur form of an
-c upper Hessenberg matrix.
-c slamch LAPACK routine that determines machine constants.
-c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c slaset LAPACK matrix initialization routine.
-c sorm2r LAPACK routine that applies an orthogonal matrix in
-c factored form.
-c strevc LAPACK routine to compute the eigenvectors of a matrix
-c in upper quasi-triangular form.
-c strsen LAPACK routine that re-orders the Schur form.
-c strmm Level 3 BLAS matrix times an upper triangular matrix.
-c sger Level 2 BLAS rank one update to a matrix.
-c scopy Level 1 BLAS that copies one vector to another .
-c sdot Level 1 BLAS that computes the scalar product of two vectors.
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c sscal Level 1 BLAS that scales a vector.
-c
-c\Remarks
-c
-c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
-c
-c Let trans(X) denote the transpose of X.
-c
-c 2. Schur vectors are an orthogonal representation for the basis of
-c Ritz vectors. Thus, their numerical properties are often superior.
-c If RVEC = .TRUE. then the relationship
-c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and
-c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately
-c satisfied. Here T is the leading submatrix of order IPARAM(5) of the
-c real upper quasi-triangular matrix stored workl(ipntr(12)). That is,
-c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
-c each 2-by-2 diagonal block has its diagonal elements equal and its
-c off-diagonal elements of opposite sign. Corresponding to each 2-by-2
-c diagonal block is a complex conjugate pair of Ritz values. The real
-c Ritz values are stored on the diagonal of T.
-c
-c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must
-c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz
-c values computed by SNAUPD for OP to those of A*z = lambda*B*z.
-c Set RVEC = .true. and HOWMNY = 'A', and
-c compute
-c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0.
-c If DI(I) is not equal to zero and DI(I+1) = - D(I),
-c then the desired real and imaginary parts of the Ritz value are
-c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1),
-c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I),
-c respectively.
-c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and
-c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper
-c quasi-triangular matrix of order IPARAM(5) is computed. See remark
-c 2 above.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Chao Yang Houston, Texas
-c Dept. of Computational &
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
- subroutine sneupd(rvec , howmny, select, dr , di,
- & z , ldz , sigmar, sigmai, workev,
- & bmat , n , which , nev , tol,
- & resid, ncv , v , ldv , iparam,
- & ipntr, workd , workl , lworkl, info)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat, howmny, which*2
- logical rvec
- integer info, ldz, ldv, lworkl, n, ncv, nev
- Real
- & sigmar, sigmai, tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(11), ipntr(14)
- logical select(ncv)
- Real
- & dr(nev+1) , di(nev+1), resid(n) ,
- & v(ldv,ncv) , z(ldz,*) , workd(3*n),
- & workl(lworkl), workev(3*ncv)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0 , zero = 0.0E+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character type*6
- integer bounds, ierr , ih , ihbds ,
- & iheigr, iheigi, iconj , nconv ,
- & invsub, iuptri, iwev , iwork(1),
- & j , k , ldh , ldq ,
- & mode , msglvl, outncv, ritzr ,
- & ritzi , wri , wrr , irr ,
- & iri , ibd , ishift, numcnv ,
- & np , jj , nconv2
- logical reord
- Real
- & conds , rnorm, sep , temp,
- & vl(1,1), temp1, eps23
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy , sger , sgeqr2, slacpy,
- & slahqr, slaset, smout , sorm2r,
- & strevc, strmm , strsen, sscal ,
- & svout , ivout
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slapy2, snrm2, slamch, sdot
- external slapy2, snrm2, slamch, sdot
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs, min, sqrt
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- msglvl = mneupd
- mode = iparam(7)
- nconv = iparam(5)
- info = 0
-c
-c %---------------------------------%
-c | Get machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0 )
-c
-c %--------------%
-c | Quick return |
-c %--------------%
-c
- ierr = 0
-c
- if (nconv .le. 0) then
- ierr = -14
- else if (n .le. 0) then
- ierr = -1
- else if (nev .le. 0) then
- ierr = -2
- else if (ncv .le. nev+1 .or. ncv .gt. n) then
- ierr = -3
- else if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LR' .and.
- & which .ne. 'SR' .and.
- & which .ne. 'LI' .and.
- & which .ne. 'SI') then
- ierr = -5
- else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
- ierr = -6
- else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
- ierr = -7
- else if ( (howmny .ne. 'A' .and.
- & howmny .ne. 'P' .and.
- & howmny .ne. 'S') .and. rvec ) then
- ierr = -13
- else if (howmny .eq. 'S' ) then
- ierr = -12
- end if
-c
- if (mode .eq. 1 .or. mode .eq. 2) then
- type = 'REGULR'
- else if (mode .eq. 3 .and. sigmai .eq. zero) then
- type = 'SHIFTI'
- else if (mode .eq. 3 ) then
- type = 'REALPT'
- else if (mode .eq. 4 ) then
- type = 'IMAGPT'
- else
- ierr = -10
- end if
- if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- go to 9000
- end if
-c
-c %--------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:ncv*ncv) := generated Hessenberg matrix |
-c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
-c | parts of ritz values |
-c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
-c %--------------------------------------------------------%
-c
-c %-----------------------------------------------------------%
-c | The following is used and set by SNEUPD. |
-c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed |
-c | real part of the Ritz values. |
-c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed |
-c | imaginary part of the Ritz values. |
-c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
-c | error bounds of the Ritz values |
-c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
-c | quasi-triangular matrix for H |
-c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
-c | associated matrix representation of the invariant |
-c | subspace for H. |
-c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
-c %-----------------------------------------------------------%
-c
- ih = ipntr(5)
- ritzr = ipntr(6)
- ritzi = ipntr(7)
- bounds = ipntr(8)
- ldh = ncv
- ldq = ncv
- iheigr = bounds + ldh
- iheigi = iheigr + ldh
- ihbds = iheigi + ldh
- iuptri = ihbds + ldh
- invsub = iuptri + ldh*ncv
- ipntr(9) = iheigr
- ipntr(10) = iheigi
- ipntr(11) = ihbds
- ipntr(12) = iuptri
- ipntr(13) = invsub
- wrr = 1
- wri = ncv + 1
- iwev = wri + ncv
-c
-c %-----------------------------------------%
-c | irr points to the REAL part of the Ritz |
-c | values computed by _neigh before |
-c | exiting _naup2. |
-c | iri points to the IMAGINARY part of the |
-c | Ritz values computed by _neigh |
-c | before exiting _naup2. |
-c | ibd points to the Ritz estimates |
-c | computed by _neigh before exiting |
-c | _naup2. |
-c %-----------------------------------------%
-c
- irr = ipntr(14)+ncv*ncv
- iri = irr+ncv
- ibd = iri+ncv
-c
-c %------------------------------------%
-c | RNORM is B-norm of the RESID(1:N). |
-c %------------------------------------%
-c
- rnorm = workl(ih+2)
- workl(ih+2) = zero
-c
- if (msglvl .gt. 2) then
- call svout(logfil, ncv, workl(irr), ndigit,
- & '_neupd: Real part of Ritz values passed in from _NAUPD.')
- call svout(logfil, ncv, workl(iri), ndigit,
- & '_neupd: Imag part of Ritz values passed in from _NAUPD.')
- call svout(logfil, ncv, workl(ibd), ndigit,
- & '_neupd: Ritz estimates passed in from _NAUPD.')
- end if
-c
- if (rvec) then
-c
- reord = .false.
-c
-c %---------------------------------------------------%
-c | Use the temporary bounds array to store indices |
-c | These will be used to mark the select array later |
-c %---------------------------------------------------%
-c
- do 10 j = 1,ncv
- workl(bounds+j-1) = j
- select(j) = .false.
- 10 continue
-c
-c %-------------------------------------%
-c | Select the wanted Ritz values. |
-c | Sort the Ritz values so that the |
-c | wanted ones appear at the tailing |
-c | NEV positions of workl(irr) and |
-c | workl(iri). Move the corresponding |
-c | error estimates in workl(bound) |
-c | accordingly. |
-c %-------------------------------------%
-c
- np = ncv - nev
- ishift = 0
- call sngets(ishift , which , nev ,
- & np , workl(irr), workl(iri),
- & workl(bounds), workl , workl(np+1))
-c
- if (msglvl .gt. 2) then
- call svout(logfil, ncv, workl(irr), ndigit,
- & '_neupd: Real part of Ritz values after calling _NGETS.')
- call svout(logfil, ncv, workl(iri), ndigit,
- & '_neupd: Imag part of Ritz values after calling _NGETS.')
- call svout(logfil, ncv, workl(bounds), ndigit,
- & '_neupd: Ritz value indices after calling _NGETS.')
- end if
-c
-c %-----------------------------------------------------%
-c | Record indices of the converged wanted Ritz values |
-c | Mark the select array for possible reordering |
-c %-----------------------------------------------------%
-c
- numcnv = 0
- do 11 j = 1,ncv
- temp1 = max(eps23,
- & slapy2( workl(irr+ncv-j), workl(iri+ncv-j) ))
- jj = workl(bounds + ncv - j)
- if (numcnv .lt. nconv .and.
- & workl(ibd+jj-1) .le. tol*temp1) then
- select(jj) = .true.
- numcnv = numcnv + 1
- if (jj .gt. nconv) reord = .true.
- endif
- 11 continue
-c
-c %-----------------------------------------------------------%
-c | Check the count (numcnv) of converged Ritz values with |
-c | the number (nconv) reported by dnaupd. If these two |
-c | are different then there has probably been an error |
-c | caused by incorrect passing of the dnaupd data. |
-c %-----------------------------------------------------------%
-c
- if (msglvl .gt. 2) then
- call ivout(logfil, 1, numcnv, ndigit,
- & '_neupd: Number of specified eigenvalues')
- call ivout(logfil, 1, nconv, ndigit,
- & '_neupd: Number of "converged" eigenvalues')
- end if
-c
- if (numcnv .ne. nconv) then
- info = -15
- go to 9000
- end if
-c
-c %-----------------------------------------------------------%
-c | Call LAPACK routine slahqr to compute the real Schur form |
-c | of the upper Hessenberg matrix returned by SNAUPD. |
-c | Make a copy of the upper Hessenberg matrix. |
-c | Initialize the Schur vector matrix Q to the identity. |
-c %-----------------------------------------------------------%
-c
- call scopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1)
- call slaset('All', ncv, ncv,
- & zero , one, workl(invsub),
- & ldq)
- call slahqr(.true., .true. , ncv,
- & 1 , ncv , workl(iuptri),
- & ldh , workl(iheigr), workl(iheigi),
- & 1 , ncv , workl(invsub),
- & ldq , ierr)
- call scopy(ncv , workl(invsub+ncv-1), ldq,
- & workl(ihbds), 1)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 9000
- end if
-c
- if (msglvl .gt. 1) then
- call svout(logfil, ncv, workl(iheigr), ndigit,
- & '_neupd: Real part of the eigenvalues of H')
- call svout(logfil, ncv, workl(iheigi), ndigit,
- & '_neupd: Imaginary part of the Eigenvalues of H')
- call svout(logfil, ncv, workl(ihbds), ndigit,
- & '_neupd: Last row of the Schur vector matrix')
- if (msglvl .gt. 3) then
- call smout(logfil , ncv, ncv ,
- & workl(iuptri), ldh, ndigit,
- & '_neupd: The upper quasi-triangular matrix ')
- end if
- end if
-c
- if (reord) then
-c
-c %-----------------------------------------------------%
-c | Reorder the computed upper quasi-triangular matrix. |
-c %-----------------------------------------------------%
-c
- call strsen('None' , 'V' ,
- & select , ncv ,
- & workl(iuptri), ldh ,
- & workl(invsub), ldq ,
- & workl(iheigr), workl(iheigi),
- & nconv2 , conds ,
- & sep , workl(ihbds) ,
- & ncv , iwork ,
- & 1 , ierr)
-c
- if (nconv2 .lt. nconv) then
- nconv = nconv2
- end if
-
- if (ierr .eq. 1) then
- info = 1
- go to 9000
- end if
-c
- if (msglvl .gt. 2) then
- call svout(logfil, ncv, workl(iheigr), ndigit,
- & '_neupd: Real part of the eigenvalues of H--reordered')
- call svout(logfil, ncv, workl(iheigi), ndigit,
- & '_neupd: Imag part of the eigenvalues of H--reordered')
- if (msglvl .gt. 3) then
- call smout(logfil , ncv, ncv ,
- & workl(iuptri), ldq, ndigit,
- & '_neupd: Quasi-triangular matrix after re-ordering')
- end if
- end if
-c
- end if
-c
-c %---------------------------------------%
-c | Copy the last row of the Schur vector |
-c | into workl(ihbds). This will be used |
-c | to compute the Ritz estimates of |
-c | converged Ritz values. |
-c %---------------------------------------%
-c
- call scopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
-c
-c %----------------------------------------------------%
-c | Place the computed eigenvalues of H into DR and DI |
-c | if a spectral transformation was not used. |
-c %----------------------------------------------------%
-c
- if (type .eq. 'REGULR') then
- call scopy(nconv, workl(iheigr), 1, dr, 1)
- call scopy(nconv, workl(iheigi), 1, di, 1)
- end if
-c
-c %----------------------------------------------------------%
-c | Compute the QR factorization of the matrix representing |
-c | the wanted invariant subspace located in the first NCONV |
-c | columns of workl(invsub,ldq). |
-c %----------------------------------------------------------%
-c
- call sgeqr2(ncv, nconv , workl(invsub),
- & ldq, workev, workev(ncv+1),
- & ierr)
-c
-c %---------------------------------------------------------%
-c | * Postmultiply V by Q using sorm2r. |
-c | * Copy the first NCONV columns of VQ into Z. |
-c | * Postmultiply Z by R. |
-c | The N by NCONV matrix Z is now a matrix representation |
-c | of the approximate invariant subspace associated with |
-c | the Ritz values in workl(iheigr) and workl(iheigi) |
-c | The first NCONV columns of V are now approximate Schur |
-c | vectors associated with the real upper quasi-triangular |
-c | matrix of order NCONV in workl(iuptri) |
-c %---------------------------------------------------------%
-c
- call sorm2r('Right', 'Notranspose', n ,
- & ncv , nconv , workl(invsub),
- & ldq , workev , v ,
- & ldv , workd(n+1) , ierr)
- call slacpy('All', n, nconv, v, ldv, z, ldz)
-c
- do 20 j=1, nconv
-c
-c %---------------------------------------------------%
-c | Perform both a column and row scaling if the |
-c | diagonal element of workl(invsub,ldq) is negative |
-c | I'm lazy and don't take advantage of the upper |
-c | quasi-triangular form of workl(iuptri,ldq) |
-c | Note that since Q is orthogonal, R is a diagonal |
-c | matrix consisting of plus or minus ones |
-c %---------------------------------------------------%
-c
- if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then
- call sscal(nconv, -one, workl(iuptri+j-1), ldq)
- call sscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1)
- end if
-c
- 20 continue
-c
- if (howmny .eq. 'A') then
-c
-c %--------------------------------------------%
-c | Compute the NCONV wanted eigenvectors of T |
-c | located in workl(iuptri,ldq). |
-c %--------------------------------------------%
-c
- do 30 j=1, ncv
- if (j .le. nconv) then
- select(j) = .true.
- else
- select(j) = .false.
- end if
- 30 continue
-c
- call strevc('Right', 'Select' , select ,
- & ncv , workl(iuptri), ldq ,
- & vl , 1 , workl(invsub),
- & ldq , ncv , outncv ,
- & workev , ierr)
-c
- if (ierr .ne. 0) then
- info = -9
- go to 9000
- end if
-c
-c %------------------------------------------------%
-c | Scale the returning eigenvectors so that their |
-c | Euclidean norms are all one. LAPACK subroutine |
-c | strevc returns each eigenvector normalized so |
-c | that the element of largest magnitude has |
-c | magnitude 1; |
-c %------------------------------------------------%
-c
- iconj = 0
- do 40 j=1, nconv
-c
- if ( workl(iheigi+j-1) .eq. zero ) then
-c
-c %----------------------%
-c | real eigenvalue case |
-c %----------------------%
-c
- temp = snrm2( ncv, workl(invsub+(j-1)*ldq), 1 )
- call sscal( ncv, one / temp,
- & workl(invsub+(j-1)*ldq), 1 )
-c
- else
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c | columns, we further normalize by the |
-c | square root of two. |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- temp = slapy2(snrm2(ncv,
- & workl(invsub+(j-1)*ldq),
- & 1),
- & snrm2(ncv,
- & workl(invsub+j*ldq),
- & 1))
- call sscal(ncv, one/temp,
- & workl(invsub+(j-1)*ldq), 1 )
- call sscal(ncv, one/temp,
- & workl(invsub+j*ldq), 1 )
- iconj = 1
- else
- iconj = 0
- end if
-c
- end if
-c
- 40 continue
-c
- call sgemv('T', ncv, nconv, one, workl(invsub),
- & ldq, workl(ihbds), 1, zero, workev, 1)
-c
- iconj = 0
- do 45 j=1, nconv
- if (workl(iheigi+j-1) .ne. zero) then
-c
-c %-------------------------------------------%
-c | Complex conjugate pair case. Note that |
-c | since the real and imaginary part of |
-c | the eigenvector are stored in consecutive |
-c %-------------------------------------------%
-c
- if (iconj .eq. 0) then
- workev(j) = slapy2(workev(j), workev(j+1))
- workev(j+1) = workev(j)
- iconj = 1
- else
- iconj = 0
- end if
- end if
- 45 continue
-c
- if (msglvl .gt. 2) then
- call scopy(ncv, workl(invsub+ncv-1), ldq,
- & workl(ihbds), 1)
- call svout(logfil, ncv, workl(ihbds), ndigit,
- & '_neupd: Last row of the eigenvector matrix for T')
- if (msglvl .gt. 3) then
- call smout(logfil, ncv, ncv, workl(invsub), ldq,
- & ndigit, '_neupd: The eigenvector matrix for T')
- end if
- end if
-c
-c %---------------------------------------%
-c | Copy Ritz estimates into workl(ihbds) |
-c %---------------------------------------%
-c
- call scopy(nconv, workev, 1, workl(ihbds), 1)
-c
-c %---------------------------------------------------------%
-c | Compute the QR factorization of the eigenvector matrix |
-c | associated with leading portion of T in the first NCONV |
-c | columns of workl(invsub,ldq). |
-c %---------------------------------------------------------%
-c
- call sgeqr2(ncv, nconv , workl(invsub),
- & ldq, workev, workev(ncv+1),
- & ierr)
-c
-c %----------------------------------------------%
-c | * Postmultiply Z by Q. |
-c | * Postmultiply Z by R. |
-c | The N by NCONV matrix Z is now contains the |
-c | Ritz vectors associated with the Ritz values |
-c | in workl(iheigr) and workl(iheigi). |
-c %----------------------------------------------%
-c
- call sorm2r('Right', 'Notranspose', n ,
- & ncv , nconv , workl(invsub),
- & ldq , workev , z ,
- & ldz , workd(n+1) , ierr)
-c
- call strmm('Right' , 'Upper' , 'No transpose',
- & 'Non-unit', n , nconv ,
- & one , workl(invsub), ldq ,
- & z , ldz)
-c
- end if
-c
- else
-c
-c %------------------------------------------------------%
-c | An approximate invariant subspace is not needed. |
-c | Place the Ritz values computed SNAUPD into DR and DI |
-c %------------------------------------------------------%
-c
- call scopy(nconv, workl(ritzr), 1, dr, 1)
- call scopy(nconv, workl(ritzi), 1, di, 1)
- call scopy(nconv, workl(ritzr), 1, workl(iheigr), 1)
- call scopy(nconv, workl(ritzi), 1, workl(iheigi), 1)
- call scopy(nconv, workl(bounds), 1, workl(ihbds), 1)
- end if
-c
-c %------------------------------------------------%
-c | Transform the Ritz values and possibly vectors |
-c | and corresponding error bounds of OP to those |
-c | of A*x = lambda*B*x. |
-c %------------------------------------------------%
-c
- if (type .eq. 'REGULR') then
-c
- if (rvec)
- & call sscal(ncv, rnorm, workl(ihbds), 1)
-c
- else
-c
-c %---------------------------------------%
-c | A spectral transformation was used. |
-c | * Determine the Ritz estimates of the |
-c | Ritz values in the original system. |
-c %---------------------------------------%
-c
- if (type .eq. 'SHIFTI') then
-c
- if (rvec)
- & call sscal(ncv, rnorm, workl(ihbds), 1)
-c
- do 50 k=1, ncv
- temp = slapy2( workl(iheigr+k-1),
- & workl(iheigi+k-1) )
- workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
- & / temp / temp
- 50 continue
-c
- else if (type .eq. 'REALPT') then
-c
- do 60 k=1, ncv
- 60 continue
-c
- else if (type .eq. 'IMAGPT') then
-c
- do 70 k=1, ncv
- 70 continue
-c
- end if
-c
-c %-----------------------------------------------------------%
-c | * Transform the Ritz values back to the original system. |
-c | For TYPE = 'SHIFTI' the transformation is |
-c | lambda = 1/theta + sigma |
-c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
-c | Rayleigh quotients or a projection. See remark 3 above.|
-c | NOTES: |
-c | *The Ritz vectors are not affected by the transformation. |
-c %-----------------------------------------------------------%
-c
- if (type .eq. 'SHIFTI') then
-c
- do 80 k=1, ncv
- temp = slapy2( workl(iheigr+k-1),
- & workl(iheigi+k-1) )
- workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp
- & + sigmar
- workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp
- & + sigmai
- 80 continue
-c
- call scopy(nconv, workl(iheigr), 1, dr, 1)
- call scopy(nconv, workl(iheigi), 1, di, 1)
-c
- else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then
-c
- call scopy(nconv, workl(iheigr), 1, dr, 1)
- call scopy(nconv, workl(iheigi), 1, di, 1)
-c
- end if
-c
- end if
-c
- if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
- call svout(logfil, nconv, dr, ndigit,
- & '_neupd: Untransformed real part of the Ritz valuess.')
- call svout (logfil, nconv, di, ndigit,
- & '_neupd: Untransformed imag part of the Ritz valuess.')
- call svout(logfil, nconv, workl(ihbds), ndigit,
- & '_neupd: Ritz estimates of untransformed Ritz values.')
- else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
- call svout(logfil, nconv, dr, ndigit,
- & '_neupd: Real parts of converged Ritz values.')
- call svout (logfil, nconv, di, ndigit,
- & '_neupd: Imag parts of converged Ritz values.')
- call svout(logfil, nconv, workl(ihbds), ndigit,
- & '_neupd: Associated Ritz estimates.')
- end if
-c
-c %-------------------------------------------------%
-c | Eigenvector Purification step. Formally perform |
-c | one of inverse subspace iteration. Only used |
-c | for MODE = 2. |
-c %-------------------------------------------------%
-c
- if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
-c
-c %------------------------------------------------%
-c | Purify the computed Ritz vectors by adding a |
-c | little bit of the residual vector: |
-c | T |
-c | resid(:)*( e s ) / theta |
-c | NCV |
-c | where H s = s theta. Remember that when theta |
-c | has nonzero imaginary part, the corresponding |
-c | Ritz vector is stored across two columns of Z. |
-c %------------------------------------------------%
-c
- iconj = 0
- do 110 j=1, nconv
- if (workl(iheigi+j-1) .eq. zero) then
- workev(j) = workl(invsub+(j-1)*ldq+ncv-1) /
- & workl(iheigr+j-1)
- else if (iconj .eq. 0) then
- temp = slapy2( workl(iheigr+j-1), workl(iheigi+j-1) )
- workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) *
- & workl(iheigr+j-1) +
- & workl(invsub+j*ldq+ncv-1) *
- & workl(iheigi+j-1) ) / temp / temp
- workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
- & workl(iheigr+j-1) -
- & workl(invsub+(j-1)*ldq+ncv-1) *
- & workl(iheigi+j-1) ) / temp / temp
- iconj = 1
- else
- iconj = 0
- end if
- 110 continue
-c
-c %---------------------------------------%
-c | Perform a rank one update to Z and |
-c | purify all the Ritz vectors together. |
-c %---------------------------------------%
-c
- call sger(n, nconv, one, resid, 1, workev, 1, z, ldz)
-c
- end if
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of SNEUPD |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sngets.f b/netlib/ARPACK/sngets.f
deleted file mode 100644
index a045224..0000000
--- a/netlib/ARPACK/sngets.f
+++ /dev/null
@@ -1,231 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: sngets
-c
-c\Description:
-c Given the eigenvalues of the upper Hessenberg matrix H,
-c computes the NP shifts AMU that are zeros of the polynomial of
-c degree NP which filters out components of the unwanted eigenvectors
-c corresponding to the AMU's based on some given criteria.
-c
-c NOTE: call this even in the case of user specified shifts in order
-c to sort the eigenvalues, and error bounds of H for later use.
-c
-c\Usage:
-c call sngets
-c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
-c
-c\Arguments
-c ISHIFT Integer. (INPUT)
-c Method for selecting the implicit shifts at each iteration.
-c ISHIFT = 0: user specified shifts
-c ISHIFT = 1: exact shift with respect to the matrix H.
-c
-c WHICH Character*2. (INPUT)
-c Shift selection criteria.
-c 'LM' -> want the KEV eigenvalues of largest magnitude.
-c 'SM' -> want the KEV eigenvalues of smallest magnitude.
-c 'LR' -> want the KEV eigenvalues of largest real part.
-c 'SR' -> want the KEV eigenvalues of smallest real part.
-c 'LI' -> want the KEV eigenvalues of largest imaginary part.
-c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
-c
-c KEV Integer. (INPUT/OUTPUT)
-c INPUT: KEV+NP is the size of the matrix H.
-c OUTPUT: Possibly increases KEV by one to keep complex conjugate
-c pairs together.
-c
-c NP Integer. (INPUT/OUTPUT)
-c Number of implicit shifts to be computed.
-c OUTPUT: Possibly decreases NP by one to keep complex conjugate
-c pairs together.
-c
-c RITZR, Real array of length KEV+NP. (INPUT/OUTPUT)
-c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
-c parts of the eigenvalues of H.
-c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
-c eigenvalues are in the first NP locations and the wanted
-c portion is in the last KEV locations. When exact shifts are
-c selected, the unwanted part corresponds to the shifts to
-c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
-c are further sorted so that the ones with largest Ritz values
-c are first.
-c
-c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
-c Error bounds corresponding to the ordering in RITZ.
-c
-c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
-c
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c ssortc ARPACK sorting routine.
-c scopy Level 1 BLAS that copies one vector to another .
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\Remarks
-c 1. xxxx
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine sngets ( ishift, which, kev, np, ritzr, ritzi, bounds,
- & shiftr, shifti )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- integer ishift, kev, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
- & shiftr(1), shifti(1)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0, zero = 0.0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer msglvl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy, ssortc, arscnd
-c
-c %----------------------%
-c | Intrinsics Functions |
-c %----------------------%
-c
- intrinsic abs
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mngets
-c
-c %----------------------------------------------------%
-c | LM, SM, LR, SR, LI, SI case. |
-c | Sort the eigenvalues of H into the desired order |
-c | and apply the resulting order to BOUNDS. |
-c | The eigenvalues are sorted so that the wanted part |
-c | are always in the last KEV locations. |
-c | We first do a pre-processing sort in order to keep |
-c | complex conjugate pairs together |
-c %----------------------------------------------------%
-c
- if (which .eq. 'LM') then
- call ssortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'SM') then
- call ssortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'LR') then
- call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'SR') then
- call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'LI') then
- call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
- else if (which .eq. 'SI') then
- call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
- end if
-c
- call ssortc (which, .true., kev+np, ritzr, ritzi, bounds)
-c
-c %-------------------------------------------------------%
-c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
-c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
-c | Accordingly decrease NP by one. In other words keep |
-c | complex conjugate pairs together. |
-c %-------------------------------------------------------%
-c
- if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
- & .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
- np = np - 1
- kev = kev + 1
- end if
-c
- if ( ishift .eq. 1 ) then
-c
-c %-------------------------------------------------------%
-c | Sort the unwanted Ritz values used as shifts so that |
-c | the ones with largest Ritz estimates are first |
-c | This will tend to minimize the effects of the |
-c | forward instability of the iteration when they shifts |
-c | are applied in subroutine snapps. |
-c | Be careful and use 'SR' since we want to sort BOUNDS! |
-c %-------------------------------------------------------%
-c
- call ssortc ( 'SR', .true., np, bounds, ritzr, ritzi )
- end if
-c
- call arscnd (t1)
- tngets = tngets + (t1 - t0)
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is')
- call ivout (logfil, 1, np, ndigit, '_ngets: NP is')
- call svout (logfil, kev+np, ritzr, ndigit,
- & '_ngets: Eigenvalues of current H matrix -- real part')
- call svout (logfil, kev+np, ritzi, ndigit,
- & '_ngets: Eigenvalues of current H matrix -- imag part')
- call svout (logfil, kev+np, bounds, ndigit,
- & '_ngets: Ritz estimates of the current KEV+NP Ritz values')
- end if
-c
- return
-c
-c %---------------%
-c | End of sngets |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssaitr.f b/netlib/ARPACK/ssaitr.f
deleted file mode 100644
index bcce17f..0000000
--- a/netlib/ARPACK/ssaitr.f
+++ /dev/null
@@ -1,853 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssaitr
-c
-c\Description:
-c Reverse communication interface for applying NP additional steps to
-c a K step symmetric Arnoldi factorization.
-c
-c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
-c
-c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
-c
-c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
-c
-c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
-c
-c where OP and B are as in ssaupd. The B-norm of r_{k+p} is also
-c computed and returned.
-c
-c\Usage:
-c call ssaitr
-c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
-c IPNTR, WORKD, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag.
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c This is for the restart phase to force the new
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y,
-c IPNTR(3) is the pointer into WORK for B * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORK for X,
-c IPNTR(2) is the pointer into WORK for Y.
-c IDO = 99: done
-c -------------------------------------------------------------
-c When the routine is used in the "shift-and-invert" mode, the
-c vector B * Q is already available and does not need to be
-c recomputed in forming OP * Q.
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of matrix B that defines the
-c semi-inner product for the operator OP. See ssaupd.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c K Integer. (INPUT)
-c Current order of H and the number of columns of V.
-c
-c NP Integer. (INPUT)
-c Number of additional Arnoldi steps to take.
-c
-c MODE Integer. (INPUT)
-c Signifies which form for "OP". If MODE=2 then
-c a reduction in the number of B matrix vector multiplies
-c is possible since the B-norm of OP*x is equivalent to
-c the inv(B)-norm of A*x.
-c
-c RESID Real array of length N. (INPUT/OUTPUT)
-c On INPUT: RESID contains the residual vector r_{k}.
-c On OUTPUT: RESID contains the residual vector r_{k+p}.
-c
-c RNORM Real scalar. (INPUT/OUTPUT)
-c On INPUT the B-norm of r_{k}.
-c On OUTPUT the B-norm of the updated residual r_{k+p}.
-c
-c V Real N by K+NP array. (INPUT/OUTPUT)
-c On INPUT: V contains the Arnoldi vectors in the first K
-c columns.
-c On OUTPUT: V contains the new NP Arnoldi vectors in the next
-c NP columns. The first K columns are unchanged.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Real (K+NP) by 2 array. (INPUT/OUTPUT)
-c H is used to store the generated symmetric tridiagonal matrix
-c with the subdiagonal in the first column starting at H(2,1)
-c and the main diagonal in the second column.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORK for
-c vectors used by the Arnoldi iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in the
-c shift-and-invert mode. X is the current operand.
-c -------------------------------------------------------------
-c
-c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The calling program should not
-c use WORKD as temporary workspace during the iteration !!!!!!
-c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
-c with the K step Arnoldi factorization. Used to save some
-c computation at the first step.
-c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
-c with the K+NP step Arnoldi factorization.
-c
-c INFO Integer. (OUTPUT)
-c = 0: Normal exit.
-c > 0: Size of an invariant subspace of OP is found that is
-c less than K + NP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c sgetv0 ARPACK routine to generate the initial vector.
-c ivout ARPACK utility routine that prints integers.
-c smout ARPACK utility routine that prints matrices.
-c svout ARPACK utility routine that prints vectors.
-c slamch LAPACK routine that determines machine constants.
-c slascl LAPACK routine for careful scaling of a matrix.
-c sgemv Level 2 BLAS routine for matrix vector multiplication.
-c saxpy Level 1 BLAS that computes a vector triad.
-c sscal Level 1 BLAS that scales a vector.
-c scopy Level 1 BLAS that copies one vector to another .
-c sdot Level 1 BLAS that computes the scalar product of two vectors.
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/93: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2
-c
-c\Remarks
-c The algorithm implemented is:
-c
-c restart = .false.
-c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
-c r_{k} contains the initial residual vector even for k = 0;
-c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
-c computed by the calling program.
-c
-c betaj = rnorm ; p_{k+1} = B*r_{k} ;
-c For j = k+1, ..., k+np Do
-c 1) if ( betaj < tol ) stop or restart depending on j.
-c if ( restart ) generate a new starting vector.
-c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
-c p_{j} = p_{j}/betaj
-c 3) r_{j} = OP*v_{j} where OP is defined as in ssaupd
-c For shift-invert mode p_{j} = B*v_{j} is already available.
-c wnorm = || OP*v_{j} ||
-c 4) Compute the j-th step residual vector.
-c w_{j} = V_{j}^T * B * OP * v_{j}
-c r_{j} = OP*v_{j} - V_{j} * w_{j}
-c alphaj <- j-th component of w_{j}
-c rnorm = || r_{j} ||
-c betaj+1 = rnorm
-c If (rnorm > 0.717*wnorm) accept step and go back to 1)
-c 5) Re-orthogonalization step:
-c s = V_{j}'*B*r_{j}
-c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
-c alphaj = alphaj + s_{j};
-c 6) Iterative refinement step:
-c If (rnorm1 > 0.717*rnorm) then
-c rnorm = rnorm1
-c accept step and go back to 1)
-c Else
-c rnorm = rnorm1
-c If this is the first time in step 6), go to 5)
-c Else r_{j} lies in the span of V_{j} numerically.
-c Set r_{j} = 0 and rnorm = 0; go to 1)
-c EndIf
-c End Do
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssaitr
- & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
- & ipntr, workd, info)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1
- integer ido, info, k, ldh, ldv, n, mode, np
- Real
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Real
- & h(ldh,2), resid(n), v(ldv,k+np), workd(3*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- logical first, orth1, orth2, rstart, step3, step4
- integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl,
- & infol, jj
- Real
- & rnorm1, wnorm, safmin, temp1
- save orth1, orth2, rstart, step3, step4,
- & ierr, ipj, irj, ivj, iter, itry, j, msglvl,
- & rnorm1, safmin, wnorm
-c
-c %-----------------------%
-c | Local Array Arguments |
-c %-----------------------%
-c
- Real
- & xtemp(2)
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external saxpy, scopy, sscal, sgemv, sgetv0, svout, smout,
- & slascl, ivout, arscnd
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & sdot, snrm2, slamch
- external sdot, snrm2, slamch
-c
-c %-----------------%
-c | Data statements |
-c %-----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
- first = .false.
-c
-c %--------------------------------%
-c | safmin = safe minimum is such |
-c | that 1/sfmin does not overflow |
-c %--------------------------------%
-c
- safmin = slamch('safmin')
- end if
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msaitr
-c
-c %------------------------------%
-c | Initial call to this routine |
-c %------------------------------%
-c
- info = 0
- step3 = .false.
- step4 = .false.
- rstart = .false.
- orth1 = .false.
- orth2 = .false.
-c
-c %--------------------------------%
-c | Pointer to the current step of |
-c | the factorization to build |
-c %--------------------------------%
-c
- j = k + 1
-c
-c %------------------------------------------%
-c | Pointers used for reverse communication |
-c | when using WORKD. |
-c %------------------------------------------%
-c
- ipj = 1
- irj = ipj + n
- ivj = irj + n
- end if
-c
-c %-------------------------------------------------%
-c | When in reverse communication mode one of: |
-c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
-c | will be .true. |
-c | STEP3: return from computing OP*v_{j}. |
-c | STEP4: return from computing B-norm of OP*v_{j} |
-c | ORTH1: return from computing B-norm of r_{j+1} |
-c | ORTH2: return from computing B-norm of |
-c | correction to the residual vector. |
-c | RSTART: return from OP computations needed by |
-c | sgetv0. |
-c %-------------------------------------------------%
-c
- if (step3) go to 50
- if (step4) go to 60
- if (orth1) go to 70
- if (orth2) go to 90
- if (rstart) go to 30
-c
-c %------------------------------%
-c | Else this is the first step. |
-c %------------------------------%
-c
-c %--------------------------------------------------------------%
-c | |
-c | A R N O L D I I T E R A T I O N L O O P |
-c | |
-c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
-c %--------------------------------------------------------------%
-c
- 1000 continue
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, j, ndigit,
- & '_saitr: generating Arnoldi vector no.')
- call svout (logfil, 1, rnorm, ndigit,
- & '_saitr: B-norm of the current residual =')
- end if
-c
-c %---------------------------------------------------------%
-c | Check for exact zero. Equivalent to determing whether a |
-c | j-step Arnoldi factorization is present. |
-c %---------------------------------------------------------%
-c
- if (rnorm .gt. zero) go to 40
-c
-c %---------------------------------------------------%
-c | Invariant subspace found, generate a new starting |
-c | vector which is orthogonal to the current Arnoldi |
-c | basis and continue the iteration. |
-c %---------------------------------------------------%
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_saitr: ****** restart at step ******')
- end if
-c
-c %---------------------------------------------%
-c | ITRY is the loop variable that controls the |
-c | maximum amount of times that a restart is |
-c | attempted. NRSTRT is used by stat.h |
-c %---------------------------------------------%
-c
- nrstrt = nrstrt + 1
- itry = 1
- 20 continue
- rstart = .true.
- ido = 0
- 30 continue
-c
-c %--------------------------------------%
-c | If in reverse communication mode and |
-c | RSTART = .true. flow returns here. |
-c %--------------------------------------%
-c
- call sgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
- & resid, rnorm, ipntr, workd, ierr)
- if (ido .ne. 99) go to 9000
- if (ierr .lt. 0) then
- itry = itry + 1
- if (itry .le. 3) go to 20
-c
-c %------------------------------------------------%
-c | Give up after several restart attempts. |
-c | Set INFO to the size of the invariant subspace |
-c | which spans OP and exit. |
-c %------------------------------------------------%
-c
- info = j - 1
- call arscnd (t1)
- tsaitr = tsaitr + (t1 - t0)
- ido = 99
- go to 9000
- end if
-c
- 40 continue
-c
-c %---------------------------------------------------------%
-c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
-c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
-c | when reciprocating a small RNORM, test against lower |
-c | machine bound. |
-c %---------------------------------------------------------%
-c
- call scopy (n, resid, 1, v(1,j), 1)
- if (rnorm .ge. safmin) then
- temp1 = one / rnorm
- call sscal (n, temp1, v(1,j), 1)
- call sscal (n, temp1, workd(ipj), 1)
- else
-c
-c %-----------------------------------------%
-c | To scale both v_{j} and p_{j} carefully |
-c | use LAPACK routine SLASCL |
-c %-----------------------------------------%
-c
- call slascl ('General', i, i, rnorm, one, n, 1,
- & v(1,j), n, infol)
- call slascl ('General', i, i, rnorm, one, n, 1,
- & workd(ipj), n, infol)
- end if
-c
-c %------------------------------------------------------%
-c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
-c | Note that this is not quite yet r_{j}. See STEP 4 |
-c %------------------------------------------------------%
-c
- step3 = .true.
- nopx = nopx + 1
- call arscnd (t2)
- call scopy (n, v(1,j), 1, workd(ivj), 1)
- ipntr(1) = ivj
- ipntr(2) = irj
- ipntr(3) = ipj
- ido = 1
-c
-c %-----------------------------------%
-c | Exit in order to compute OP*v_{j} |
-c %-----------------------------------%
-c
- go to 9000
- 50 continue
-c
-c %-----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
-c %-----------------------------------%
-c
- call arscnd (t3)
- tmvopx = tmvopx + (t3 - t2)
-c
- step3 = .false.
-c
-c %------------------------------------------%
-c | Put another copy of OP*v_{j} into RESID. |
-c %------------------------------------------%
-c
- call scopy (n, workd(irj), 1, resid, 1)
-c
-c %-------------------------------------------%
-c | STEP 4: Finish extending the symmetric |
-c | Arnoldi to length j. If MODE = 2 |
-c | then B*OP = B*inv(B)*A = A and |
-c | we don't need to compute B*OP. |
-c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
-c | assumed to have A*v_{j}. |
-c %-------------------------------------------%
-c
- if (mode .eq. 2) go to 65
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- step4 = .true.
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-------------------------------------%
-c | Exit in order to compute B*OP*v_{j} |
-c %-------------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy(n, resid, 1 , workd(ipj), 1)
- end if
- 60 continue
-c
-c %-----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
-c %-----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- step4 = .false.
-c
-c %-------------------------------------%
-c | The following is needed for STEP 5. |
-c | Compute the B-norm of OP*v_{j}. |
-c %-------------------------------------%
-c
- 65 continue
- if (mode .eq. 2) then
-c
-c %----------------------------------%
-c | Note that the B-norm of OP*v_{j} |
-c | is the inv(B)-norm of A*v_{j}. |
-c %----------------------------------%
-c
- wnorm = sdot (n, resid, 1, workd(ivj), 1)
- wnorm = sqrt(abs(wnorm))
- else if (bmat .eq. 'G') then
- wnorm = sdot (n, resid, 1, workd(ipj), 1)
- wnorm = sqrt(abs(wnorm))
- else if (bmat .eq. 'I') then
- wnorm = snrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------%
-c | Compute the j-th residual corresponding |
-c | to the j step factorization. |
-c | Use Classical Gram Schmidt and compute: |
-c | w_{j} <- V_{j}^T * B * OP * v_{j} |
-c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
-c %-----------------------------------------%
-c
-c
-c %------------------------------------------%
-c | Compute the j Fourier coefficients w_{j} |
-c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
-c %------------------------------------------%
-c
- if (mode .ne. 2 ) then
- call sgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
- & workd(irj), 1)
- else if (mode .eq. 2) then
- call sgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
- & workd(irj), 1)
- end if
-c
-c %--------------------------------------%
-c | Orthgonalize r_{j} against V_{j}. |
-c | RESID contains OP*v_{j}. See STEP 3. |
-c %--------------------------------------%
-c
- call sgemv('N', n, j, -one, v, ldv, workd(irj), 1, one,
- & resid, 1)
-c
-c %--------------------------------------%
-c | Extend H to have j rows and columns. |
-c %--------------------------------------%
-c
- h(j,2) = workd(irj + j - 1)
- if (j .eq. 1 .or. rstart) then
- h(j,1) = zero
- else
- h(j,1) = rnorm
- end if
- call arscnd (t4)
-c
- orth1 = .true.
- iter = 0
-c
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*r_{j} |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd(ipj), 1)
- end if
- 70 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH1 = .true. |
-c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- orth1 = .false.
-c
-c %------------------------------%
-c | Compute the B-norm of r_{j}. |
-c %------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm = sdot (n, resid, 1, workd(ipj), 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = snrm2(n, resid, 1)
- end if
-c
-c %-----------------------------------------------------------%
-c | STEP 5: Re-orthogonalization / Iterative refinement phase |
-c | Maximum NITER_ITREF tries. |
-c | |
-c | s = V_{j}^T * B * r_{j} |
-c | r_{j} = r_{j} - V_{j}*s |
-c | alphaj = alphaj + s_{j} |
-c | |
-c | The stopping criteria used for iterative refinement is |
-c | discussed in Parlett's book SEP, page 107 and in Gragg & |
-c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
-c | Determine if we need to correct the residual. The goal is |
-c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
-c %-----------------------------------------------------------%
-c
- if (rnorm .gt. 0.717*wnorm) go to 100
- nrorth = nrorth + 1
-c
-c %---------------------------------------------------%
-c | Enter the Iterative refinement phase. If further |
-c | refinement is necessary, loop back here. The loop |
-c | variable is ITER. Perform a step of Classical |
-c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
-c %---------------------------------------------------%
-c
- 80 continue
-c
- if (msglvl .gt. 2) then
- xtemp(1) = wnorm
- xtemp(2) = rnorm
- call svout (logfil, 2, xtemp, ndigit,
- & '_saitr: re-orthonalization ; wnorm and rnorm are')
- end if
-c
-c %----------------------------------------------------%
-c | Compute V_{j}^T * B * r_{j}. |
-c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
-c %----------------------------------------------------%
-c
- call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
- & zero, workd(irj), 1)
-c
-c %----------------------------------------------%
-c | Compute the correction to the residual: |
-c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
-c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
-c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
-c | H(j,j) is updated. |
-c %----------------------------------------------%
-c
- call sgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
- & one, resid, 1)
-c
- if (j .eq. 1 .or. rstart) h(j,1) = zero
- h(j,2) = h(j,2) + workd(irj + j - 1)
-c
- orth2 = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(irj), 1)
- ipntr(1) = irj
- ipntr(2) = ipj
- ido = 2
-c
-c %-----------------------------------%
-c | Exit in order to compute B*r_{j}. |
-c | r_{j} is the corrected residual. |
-c %-----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd(ipj), 1)
- end if
- 90 continue
-c
-c %---------------------------------------------------%
-c | Back from reverse communication if ORTH2 = .true. |
-c %---------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
-c %-----------------------------------------------------%
-c | Compute the B-norm of the corrected residual r_{j}. |
-c %-----------------------------------------------------%
-c
- if (bmat .eq. 'G') then
- rnorm1 = sdot (n, resid, 1, workd(ipj), 1)
- rnorm1 = sqrt(abs(rnorm1))
- else if (bmat .eq. 'I') then
- rnorm1 = snrm2(n, resid, 1)
- end if
-c
- if (msglvl .gt. 0 .and. iter .gt. 0) then
- call ivout (logfil, 1, j, ndigit,
- & '_saitr: Iterative refinement for Arnoldi residual')
- if (msglvl .gt. 2) then
- xtemp(1) = rnorm
- xtemp(2) = rnorm1
- call svout (logfil, 2, xtemp, ndigit,
- & '_saitr: iterative refinement ; rnorm and rnorm1 are')
- end if
- end if
-c
-c %-----------------------------------------%
-c | Determine if we need to perform another |
-c | step of re-orthogonalization. |
-c %-----------------------------------------%
-c
- if (rnorm1 .gt. 0.717*rnorm) then
-c
-c %--------------------------------%
-c | No need for further refinement |
-c %--------------------------------%
-c
- rnorm = rnorm1
-c
- else
-c
-c %-------------------------------------------%
-c | Another step of iterative refinement step |
-c | is required. NITREF is used by stat.h |
-c %-------------------------------------------%
-c
- nitref = nitref + 1
- rnorm = rnorm1
- iter = iter + 1
- if (iter .le. 1) go to 80
-c
-c %-------------------------------------------------%
-c | Otherwise RESID is numerically in the span of V |
-c %-------------------------------------------------%
-c
- do 95 jj = 1, n
- resid(jj) = zero
- 95 continue
- rnorm = zero
- end if
-c
-c %----------------------------------------------%
-c | Branch here directly if iterative refinement |
-c | wasn't necessary or after at most NITER_REF |
-c | steps of iterative refinement. |
-c %----------------------------------------------%
-c
- 100 continue
-c
- rstart = .false.
- orth2 = .false.
-c
- call arscnd (t5)
- titref = titref + (t5 - t4)
-c
-c %----------------------------------------------------------%
-c | Make sure the last off-diagonal element is non negative |
-c | If not perform a similarity transformation on H(1:j,1:j) |
-c | and scale v(:,j) by -1. |
-c %----------------------------------------------------------%
-c
- if (h(j,1) .lt. zero) then
- h(j,1) = -h(j,1)
- if ( j .lt. k+np) then
- call sscal(n, -one, v(1,j+1), 1)
- else
- call sscal(n, -one, resid, 1)
- end if
- end if
-c
-c %------------------------------------%
-c | STEP 6: Update j = j+1; Continue |
-c %------------------------------------%
-c
- j = j + 1
- if (j .gt. k+np) then
- call arscnd (t1)
- tsaitr = tsaitr + (t1 - t0)
- ido = 99
-c
- if (msglvl .gt. 1) then
- call svout (logfil, k+np, h(1,2), ndigit,
- & '_saitr: main diagonal of matrix H of step K+NP.')
- if (k+np .gt. 1) then
- call svout (logfil, k+np-1, h(2,1), ndigit,
- & '_saitr: sub diagonal of matrix H of step K+NP.')
- end if
- end if
-c
- go to 9000
- end if
-c
-c %--------------------------------------------------------%
-c | Loop back to extend the factorization by another step. |
-c %--------------------------------------------------------%
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of ssaitr |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssapps.f b/netlib/ARPACK/ssapps.f
deleted file mode 100644
index 6012dbf..0000000
--- a/netlib/ARPACK/ssapps.f
+++ /dev/null
@@ -1,516 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssapps
-c
-c\Description:
-c Given the Arnoldi factorization
-c
-c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
-c
-c apply NP shifts implicitly resulting in
-c
-c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
-c
-c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
-c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
-c factorization becomes:
-c
-c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
-c
-c\Usage:
-c call ssapps
-c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Problem size, i.e. dimension of matrix A.
-c
-c KEV Integer. (INPUT)
-c INPUT: KEV+NP is the size of the input matrix H.
-c OUTPUT: KEV is the size of the updated matrix HNEW.
-c
-c NP Integer. (INPUT)
-c Number of implicit shifts to be applied.
-c
-c SHIFT Real array of length NP. (INPUT)
-c The shifts to be applied.
-c
-c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
-c INPUT: V contains the current KEV+NP Arnoldi vectors.
-c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
-c are in the first KEV columns of V.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Real (KEV+NP) by 2 array. (INPUT/OUTPUT)
-c INPUT: H contains the symmetric tridiagonal matrix of the
-c Arnoldi factorization with the subdiagonal in the 1st column
-c starting at H(2,1) and the main diagonal in the 2nd column.
-c OUTPUT: H contains the updated tridiagonal matrix in the
-c KEV leading submatrix.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RESID Real array of length (N). (INPUT/OUTPUT)
-c INPUT: RESID contains the the residual vector r_{k+p}.
-c OUTPUT: RESID is the updated residual vector rnew_{k}.
-c
-c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
-c Work array used to accumulate the rotations during the bulge
-c chase sweep.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKD Real work array of length 2*N. (WORKSPACE)
-c Distributed array used in the application of the accumulated
-c orthogonal matrix Q.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c
-c\Routines called:
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine that prints vectors.
-c slamch LAPACK routine that determines machine constants.
-c slartg LAPACK Givens rotation construction routine.
-c slacpy LAPACK matrix copy routine.
-c slaset LAPACK matrix initialization routine.
-c sgemv Level 2 BLAS routine for matrix vector multiplication.
-c saxpy Level 1 BLAS that computes a vector triad.
-c scopy Level 1 BLAS that copies one vector to another.
-c sscal Level 1 BLAS that scales a vector.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/16/93: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2
-c
-c\Remarks
-c 1. In this version, each shift is applied to all the subblocks of
-c the tridiagonal matrix H and not just to the submatrix that it
-c comes from. This routine assumes that the subdiagonal elements
-c of H that are stored in h(1:kev+np,1) are nonegative upon input
-c and enforce this condition upon output. This version incorporates
-c deflation. See code for documentation.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssapps
- & ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer kev, ldh, ldq, ldv, n, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
- & v(ldv,kev+np), workd(2*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, iend, istart, itop, j, jj, kplusp, msglvl
- logical first
- Real
- & a1, a2, a3, a4, big, c, epsmch, f, g, r, s
- save epsmch, first
-c
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external saxpy, scopy, sscal, slacpy, slartg, slaset, svout,
- & ivout, arscnd, sgemv
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slamch
- external slamch
-c
-c %----------------------%
-c | Intrinsics Functions |
-c %----------------------%
-c
- intrinsic abs
-c
-c %----------------%
-c | Data statments |
-c %----------------%
-c
- data first / .true. /
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (first) then
- epsmch = slamch('Epsilon-Machine')
- first = .false.
- end if
- itop = 1
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msapps
-c
- kplusp = kev + np
-c
-c %----------------------------------------------%
-c | Initialize Q to the identity matrix of order |
-c | kplusp used to accumulate the rotations. |
-c %----------------------------------------------%
-c
- call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
-c
-c %----------------------------------------------%
-c | Quick return if there are no shifts to apply |
-c %----------------------------------------------%
-c
- if (np .eq. 0) go to 9000
-c
-c %----------------------------------------------------------%
-c | Apply the np shifts implicitly. Apply each shift to the |
-c | whole matrix and not just to the submatrix from which it |
-c | comes. |
-c %----------------------------------------------------------%
-c
- do 90 jj = 1, np
-c
- istart = itop
-c
-c %----------------------------------------------------------%
-c | Check for splitting and deflation. Currently we consider |
-c | an off-diagonal element h(i+1,1) negligible if |
-c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
-c | for i=1:KEV+NP-1. |
-c | If above condition tests true then we set h(i+1,1) = 0. |
-c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
-c %----------------------------------------------------------%
-c
- 20 continue
-c
-c %------------------------------------------------%
-c | The following loop exits early if we encounter |
-c | a negligible off diagonal element. |
-c %------------------------------------------------%
-c
- do 30 i = istart, kplusp-1
- big = abs(h(i,2)) + abs(h(i+1,2))
- if (h(i+1,1) .le. epsmch*big) then
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, i, ndigit,
- & '_sapps: deflation at row/column no.')
- call ivout (logfil, 1, jj, ndigit,
- & '_sapps: occured before shift number.')
- call svout (logfil, 1, h(i+1,1), ndigit,
- & '_sapps: the corresponding off diagonal element')
- end if
- h(i+1,1) = zero
- iend = i
- go to 40
- end if
- 30 continue
- iend = kplusp
- 40 continue
-c
- if (istart .lt. iend) then
-c
-c %--------------------------------------------------------%
-c | Construct the plane rotation G'(istart,istart+1,theta) |
-c | that attempts to drive h(istart+1,1) to zero. |
-c %--------------------------------------------------------%
-c
- f = h(istart,2) - shift(jj)
- g = h(istart+1,1)
- call slartg (f, g, c, s, r)
-c
-c %-------------------------------------------------------%
-c | Apply rotation to the left and right of H; |
-c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
-c | This will create a "bulge". |
-c %-------------------------------------------------------%
-c
- a1 = c*h(istart,2) + s*h(istart+1,1)
- a2 = c*h(istart+1,1) + s*h(istart+1,2)
- a4 = c*h(istart+1,2) - s*h(istart+1,1)
- a3 = c*h(istart+1,1) - s*h(istart,2)
- h(istart,2) = c*a1 + s*a2
- h(istart+1,2) = c*a4 - s*a3
- h(istart+1,1) = c*a3 + s*a4
-c
-c %----------------------------------------------------%
-c | Accumulate the rotation in the matrix Q; Q <- Q*G |
-c %----------------------------------------------------%
-c
- do 60 j = 1, min(istart+jj,kplusp)
- a1 = c*q(j,istart) + s*q(j,istart+1)
- q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
- q(j,istart) = a1
- 60 continue
-c
-c
-c %----------------------------------------------%
-c | The following loop chases the bulge created. |
-c | Note that the previous rotation may also be |
-c | done within the following loop. But it is |
-c | kept separate to make the distinction among |
-c | the bulge chasing sweeps and the first plane |
-c | rotation designed to drive h(istart+1,1) to |
-c | zero. |
-c %----------------------------------------------%
-c
- do 70 i = istart+1, iend-1
-c
-c %----------------------------------------------%
-c | Construct the plane rotation G'(i,i+1,theta) |
-c | that zeros the i-th bulge that was created |
-c | by G(i-1,i,theta). g represents the bulge. |
-c %----------------------------------------------%
-c
- f = h(i,1)
- g = s*h(i+1,1)
-c
-c %----------------------------------%
-c | Final update with G(i-1,i,theta) |
-c %----------------------------------%
-c
- h(i+1,1) = c*h(i+1,1)
- call slartg (f, g, c, s, r)
-c
-c %-------------------------------------------%
-c | The following ensures that h(1:iend-1,1), |
-c | the first iend-2 off diagonal of elements |
-c | H, remain non negative. |
-c %-------------------------------------------%
-c
- if (r .lt. zero) then
- r = -r
- c = -c
- s = -s
- end if
-c
-c %--------------------------------------------%
-c | Apply rotation to the left and right of H; |
-c | H <- G * H * G', where G = G(i,i+1,theta) |
-c %--------------------------------------------%
-c
- h(i,1) = r
-c
- a1 = c*h(i,2) + s*h(i+1,1)
- a2 = c*h(i+1,1) + s*h(i+1,2)
- a3 = c*h(i+1,1) - s*h(i,2)
- a4 = c*h(i+1,2) - s*h(i+1,1)
-c
- h(i,2) = c*a1 + s*a2
- h(i+1,2) = c*a4 - s*a3
- h(i+1,1) = c*a3 + s*a4
-c
-c %----------------------------------------------------%
-c | Accumulate the rotation in the matrix Q; Q <- Q*G |
-c %----------------------------------------------------%
-c
- do 50 j = 1, min( i+jj, kplusp )
- a1 = c*q(j,i) + s*q(j,i+1)
- q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
- q(j,i) = a1
- 50 continue
-c
- 70 continue
-c
- end if
-c
-c %--------------------------%
-c | Update the block pointer |
-c %--------------------------%
-c
- istart = iend + 1
-c
-c %------------------------------------------%
-c | Make sure that h(iend,1) is non-negative |
-c | If not then set h(iend,1) <-- -h(iend,1) |
-c | and negate the last column of Q. |
-c | We have effectively carried out a |
-c | similarity on transformation H |
-c %------------------------------------------%
-c
- if (h(iend,1) .lt. zero) then
- h(iend,1) = -h(iend,1)
- call sscal(kplusp, -one, q(1,iend), 1)
- end if
-c
-c %--------------------------------------------------------%
-c | Apply the same shift to the next block if there is any |
-c %--------------------------------------------------------%
-c
- if (iend .lt. kplusp) go to 20
-c
-c %-----------------------------------------------------%
-c | Check if we can increase the the start of the block |
-c %-----------------------------------------------------%
-c
- do 80 i = itop, kplusp-1
- if (h(i+1,1) .gt. zero) go to 90
- itop = itop + 1
- 80 continue
-c
-c %-----------------------------------%
-c | Finished applying the jj-th shift |
-c %-----------------------------------%
-c
- 90 continue
-c
-c %------------------------------------------%
-c | All shifts have been applied. Check for |
-c | more possible deflation that might occur |
-c | after the last shift is applied. |
-c %------------------------------------------%
-c
- do 100 i = itop, kplusp-1
- big = abs(h(i,2)) + abs(h(i+1,2))
- if (h(i+1,1) .le. epsmch*big) then
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, i, ndigit,
- & '_sapps: deflation at row/column no.')
- call svout (logfil, 1, h(i+1,1), ndigit,
- & '_sapps: the corresponding off diagonal element')
- end if
- h(i+1,1) = zero
- end if
- 100 continue
-c
-c %-------------------------------------------------%
-c | Compute the (kev+1)-st column of (V*Q) and |
-c | temporarily store the result in WORKD(N+1:2*N). |
-c | This is not necessary if h(kev+1,1) = 0. |
-c %-------------------------------------------------%
-c
- if ( h(kev+1,1) .gt. zero )
- & call sgemv ('N', n, kplusp, one, v, ldv,
- & q(1,kev+1), 1, zero, workd(n+1), 1)
-c
-c %-------------------------------------------------------%
-c | Compute column 1 to kev of (V*Q) in backward order |
-c | taking advantage that Q is an upper triangular matrix |
-c | with lower bandwidth np. |
-c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
-c %-------------------------------------------------------%
-c
- do 130 i = 1, kev
- call sgemv ('N', n, kplusp-i+1, one, v, ldv,
- & q(1,kev-i+1), 1, zero, workd, 1)
- call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
- 130 continue
-c
-c %-------------------------------------------------%
-c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
-c %-------------------------------------------------%
-c
- call slacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
-c
-c %--------------------------------------------%
-c | Copy the (kev+1)-st column of (V*Q) in the |
-c | appropriate place if h(kev+1,1) .ne. zero. |
-c %--------------------------------------------%
-c
- if ( h(kev+1,1) .gt. zero )
- & call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
-c
-c %-------------------------------------%
-c | Update the residual vector: |
-c | r <- sigmak*r + betak*v(:,kev+1) |
-c | where |
-c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
-c | betak = e_{kev+1}'*H*e_{kev} |
-c %-------------------------------------%
-c
- call sscal (n, q(kplusp,kev), resid, 1)
- if (h(kev+1,1) .gt. zero)
- & call saxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
-c
- if (msglvl .gt. 1) then
- call svout (logfil, 1, q(kplusp,kev), ndigit,
- & '_sapps: sigmak of the updated residual vector')
- call svout (logfil, 1, h(kev+1,1), ndigit,
- & '_sapps: betak of the updated residual vector')
- call svout (logfil, kev, h(1,2), ndigit,
- & '_sapps: updated main diagonal of H for next iteration')
- if (kev .gt. 1) then
- call svout (logfil, kev-1, h(2,1), ndigit,
- & '_sapps: updated sub diagonal of H for next iteration')
- end if
- end if
-c
- call arscnd (t1)
- tsapps = tsapps + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of ssapps |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssaup2.f b/netlib/ARPACK/ssaup2.f
deleted file mode 100644
index 60e6766..0000000
--- a/netlib/ARPACK/ssaup2.f
+++ /dev/null
@@ -1,850 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssaup2
-c
-c\Description:
-c Intermediate level interface called by ssaupd.
-c
-c\Usage:
-c call ssaup2
-c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
-c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
-c IPNTR, WORKD, INFO )
-c
-c\Arguments
-c
-c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in ssaupd.
-c MODE, ISHIFT, MXITER: see the definition of IPARAM in ssaupd.
-c
-c NP Integer. (INPUT/OUTPUT)
-c Contains the number of implicit shifts to apply during
-c each Arnoldi/Lanczos iteration.
-c If ISHIFT=1, NP is adjusted dynamically at each iteration
-c to accelerate convergence and prevent stagnation.
-c This is also roughly equal to the number of matrix-vector
-c products (involving the operator OP) per Arnoldi iteration.
-c The logic for adjusting is contained within the current
-c subroutine.
-c If ISHIFT=0, NP is the number of shifts the user needs
-c to provide via reverse comunication. 0 < NP < NCV-NEV.
-c NP may be less than NCV-NEV since a leading block of the current
-c upper Tridiagonal matrix has split off and contains "unwanted"
-c Ritz values.
-c Upon termination of the IRA iteration, NP contains the number
-c of "converged" wanted Ritz values.
-c
-c IUPD Integer. (INPUT)
-c IUPD .EQ. 0: use explicit restart instead implicit update.
-c IUPD .NE. 0: use implicit update.
-c
-c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
-c The Lanczos basis vectors.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c H Real (NEV+NP) by 2 array. (OUTPUT)
-c H is used to store the generated symmetric tridiagonal matrix
-c The subdiagonal is stored in the first column of H starting
-c at H(2,1). The main diagonal is stored in the second column
-c of H starting at H(1,2). If ssaup2 converges store the
-c B-norm of the final residual vector in H(1,1).
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c RITZ Real array of length NEV+NP. (OUTPUT)
-c RITZ(1:NEV) contains the computed Ritz values of OP.
-c
-c BOUNDS Real array of length NEV+NP. (OUTPUT)
-c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
-c
-c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
-c Private (replicated) work array used to accumulate the
-c rotation in the shift application step.
-c
-c LDQ Integer. (INPUT)
-c Leading dimension of Q exactly as declared in the calling
-c program.
-c
-c WORKL Real array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. It is used in the computation of the
-c tridiagonal eigenvalue problem, the calculation and
-c application of the shifts and convergence checking.
-c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
-c of WORKL are used in reverse communication to hold the user
-c supplied shifts.
-c
-c IPNTR Integer array of length 3. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD for
-c vectors used by the Lanczos iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X.
-c IPNTR(2): pointer to the current result vector Y.
-c IPNTR(3): pointer to the vector B * X when used in one of
-c the spectral transformation modes. X is the current
-c operand.
-c -------------------------------------------------------------
-c
-c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Lanczos iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration !!!!!!!!!!
-c See Data Distribution Note in ssaupd.
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal return.
-c = 1: All possible eigenvalues of OP has been found.
-c NP returns the size of the invariant subspace
-c spanning the operator OP.
-c = 2: No shifts could be applied.
-c = -8: Error return from trid. eigenvalue calculation;
-c This should never happen.
-c = -9: Starting vector is zero.
-c = -9999: Could not build an Lanczos factorization.
-c Size that was built in returned in NP.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
-c 1980.
-c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
-c Computer Physics Communications, 53 (1989), pp 169-179.
-c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
-c Implement the Spectral Transformation", Math. Comp., 48 (1987),
-c pp 663-673.
-c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
-c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
-c SIAM J. Matr. Anal. Apps., January (1993).
-c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
-c for Updating the QR decomposition", ACM TOMS, December 1990,
-c Volume 16 Number 4, pp 369-377.
-c
-c\Routines called:
-c sgetv0 ARPACK initial vector generation routine.
-c ssaitr ARPACK Lanczos factorization routine.
-c ssapps ARPACK application of implicit shifts routine.
-c ssconv ARPACK convergence of Ritz values routine.
-c sseigt ARPACK compute Ritz values and error bounds routine.
-c ssgets ARPACK reorder Ritz values and error bounds routine.
-c ssortr ARPACK sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine that prints vectors.
-c slamch LAPACK routine that determines machine constants.
-c scopy Level 1 BLAS that copies one vector to another.
-c sdot Level 1 BLAS that computes the scalar product of two vectors.
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c sscal Level 1 BLAS that scales a vector.
-c sswap Level 1 BLAS that swaps two vectors.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.4'
-c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq)
-c
-c\SCCS Information: @(#)
-c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssaup2
- & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
- & q, ldq, workl, ipntr, workd, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
- & n, mode, nev, np
- Real
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer ipntr(3)
- Real
- & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
- & ritz(nev+np), v(ldv,nev+np), workd(3*n),
- & workl(3*(nev+np))
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character wprime*2
- logical cnorm, getv0, initv, update, ushift
- integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0,
- & np0, nptemp, nevd2, nevm2, kp(3)
- Real
- & rnorm, temp, eps23
- save cnorm, getv0, initv, update, ushift,
- & iter, kplusp, msglvl, nconv, nev0, np0,
- & rnorm, eps23
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy, sgetv0, ssaitr, sscal, ssconv, sseigt, ssgets,
- & ssapps, ssortr, svout, ivout, arscnd, sswap
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & sdot, snrm2, slamch
- external sdot, snrm2, slamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic min
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msaup2
-c
-c %---------------------------------%
-c | Set machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0/3.0E+0)
-c
-c %-------------------------------------%
-c | nev0 and np0 are integer variables |
-c | hold the initial values of NEV & NP |
-c %-------------------------------------%
-c
- nev0 = nev
- np0 = np
-c
-c %-------------------------------------%
-c | kplusp is the bound on the largest |
-c | Lanczos factorization built. |
-c | nconv is the current number of |
-c | "converged" eigenvlues. |
-c | iter is the counter on the current |
-c | iteration step. |
-c %-------------------------------------%
-c
- kplusp = nev0 + np0
- nconv = 0
- iter = 0
-c
-c %--------------------------------------------%
-c | Set flags for computing the first NEV steps |
-c | of the Lanczos factorization. |
-c %--------------------------------------------%
-c
- getv0 = .true.
- update = .false.
- ushift = .false.
- cnorm = .false.
-c
- if (info .ne. 0) then
-c
-c %--------------------------------------------%
-c | User provides the initial residual vector. |
-c %--------------------------------------------%
-c
- initv = .true.
- info = 0
- else
- initv = .false.
- end if
- end if
-c
-c %---------------------------------------------%
-c | Get a possibly random starting vector and |
-c | force it into the range of the operator OP. |
-c %---------------------------------------------%
-c
- 10 continue
-c
- if (getv0) then
- call sgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
- & ipntr, workd, info)
-c
- if (ido .ne. 99) go to 9000
-c
- if (rnorm .eq. zero) then
-c
-c %-----------------------------------------%
-c | The initial vector is zero. Error exit. |
-c %-----------------------------------------%
-c
- info = -9
- go to 1200
- end if
- getv0 = .false.
- ido = 0
- end if
-c
-c %------------------------------------------------------------%
-c | Back from reverse communication: continue with update step |
-c %------------------------------------------------------------%
-c
- if (update) go to 20
-c
-c %-------------------------------------------%
-c | Back from computing user specified shifts |
-c %-------------------------------------------%
-c
- if (ushift) go to 50
-c
-c %-------------------------------------%
-c | Back from computing residual norm |
-c | at the end of the current iteration |
-c %-------------------------------------%
-c
- if (cnorm) go to 100
-c
-c %----------------------------------------------------------%
-c | Compute the first NEV steps of the Lanczos factorization |
-c %----------------------------------------------------------%
-c
- call ssaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
-c
-c %-----------------------------------------------------%
-c | ssaitr was unable to build an Lanczos factorization |
-c | of length NEV0. INFO is returned with the size of |
-c | the factorization built. Exit main loop. |
-c %-----------------------------------------------------%
-c
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
-c
-c %--------------------------------------------------------------%
-c | |
-c | M A I N LANCZOS I T E R A T I O N L O O P |
-c | Each iteration implicitly restarts the Lanczos |
-c | factorization in place. |
-c | |
-c %--------------------------------------------------------------%
-c
- 1000 continue
-c
- iter = iter + 1
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, iter, ndigit,
- & '_saup2: **** Start of major iteration number ****')
- end if
- if (msglvl .gt. 1) then
- call ivout (logfil, 1, nev, ndigit,
- & '_saup2: The length of the current Lanczos factorization')
- call ivout (logfil, 1, np, ndigit,
- & '_saup2: Extend the Lanczos factorization by')
- end if
-c
-c %------------------------------------------------------------%
-c | Compute NP additional steps of the Lanczos factorization. |
-c %------------------------------------------------------------%
-c
- ido = 0
- 20 continue
- update = .true.
-c
- call ssaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v,
- & ldv, h, ldh, ipntr, workd, info)
-c
-c %---------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP and possibly B |
-c %---------------------------------------------------%
-c
- if (ido .ne. 99) go to 9000
-c
- if (info .gt. 0) then
-c
-c %-----------------------------------------------------%
-c | ssaitr was unable to build an Lanczos factorization |
-c | of length NEV0+NP0. INFO is returned with the size |
-c | of the factorization built. Exit main loop. |
-c %-----------------------------------------------------%
-c
- np = info
- mxiter = iter
- info = -9999
- go to 1200
- end if
- update = .false.
-c
- if (msglvl .gt. 1) then
- call svout (logfil, 1, rnorm, ndigit,
- & '_saup2: Current B-norm of residual for factorization')
- end if
-c
-c %--------------------------------------------------------%
-c | Compute the eigenvalues and corresponding error bounds |
-c | of the current symmetric tridiagonal matrix. |
-c %--------------------------------------------------------%
-c
- call sseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, ierr)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 1200
- end if
-c
-c %----------------------------------------------------%
-c | Make a copy of eigenvalues and corresponding error |
-c | bounds obtained from _seigt. |
-c %----------------------------------------------------%
-c
- call scopy(kplusp, ritz, 1, workl(kplusp+1), 1)
- call scopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
-c
-c %---------------------------------------------------%
-c | Select the wanted Ritz values and their bounds |
-c | to be used in the convergence test. |
-c | The selection is based on the requested number of |
-c | eigenvalues instead of the current NEV and NP to |
-c | prevent possible misconvergence. |
-c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
-c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
-c %---------------------------------------------------%
-c
- nev = nev0
- np = np0
- call ssgets (ishift, which, nev, np, ritz, bounds, workl)
-c
-c %-------------------%
-c | Convergence test. |
-c %-------------------%
-c
- call scopy (nev, bounds(np+1), 1, workl(np+1), 1)
- call ssconv (nev, ritz(np+1), workl(np+1), tol, nconv)
-c
- if (msglvl .gt. 2) then
- kp(1) = nev
- kp(2) = np
- kp(3) = nconv
- call ivout (logfil, 3, kp, ndigit,
- & '_saup2: NEV, NP, NCONV are')
- call svout (logfil, kplusp, ritz, ndigit,
- & '_saup2: The eigenvalues of H')
- call svout (logfil, kplusp, bounds, ndigit,
- & '_saup2: Ritz estimates of the current NCV Ritz values')
- end if
-c
-c %---------------------------------------------------------%
-c | Count the number of unwanted Ritz values that have zero |
-c | Ritz estimates. If any Ritz estimates are equal to zero |
-c | then a leading block of H of order equal to at least |
-c | the number of Ritz values with zero Ritz estimates has |
-c | split off. None of these Ritz values may be removed by |
-c | shifting. Decrease NP the number of shifts to apply. If |
-c | no shifts may be applied, then prepare to exit |
-c %---------------------------------------------------------%
-c
- nptemp = np
- do 30 j=1, nptemp
- if (bounds(j) .eq. zero) then
- np = np - 1
- nev = nev + 1
- end if
- 30 continue
-c
- if ( (nconv .ge. nev0) .or.
- & (iter .gt. mxiter) .or.
- & (np .eq. 0) ) then
-c
-c %------------------------------------------------%
-c | Prepare to exit. Put the converged Ritz values |
-c | and corresponding bounds in RITZ(1:NCONV) and |
-c | BOUNDS(1:NCONV) respectively. Then sort. Be |
-c | careful when NCONV > NP since we don't want to |
-c | swap overlapping locations. |
-c %------------------------------------------------%
-c
- if (which .eq. 'BE') then
-c
-c %-----------------------------------------------------%
-c | Both ends of the spectrum are requested. |
-c | Sort the eigenvalues into algebraically decreasing |
-c | order first then swap low end of the spectrum next |
-c | to high end in appropriate locations. |
-c | NOTE: when np < floor(nev/2) be careful not to swap |
-c | overlapping locations. |
-c %-----------------------------------------------------%
-c
- wprime = 'SA'
- call ssortr (wprime, .true., kplusp, ritz, bounds)
- nevd2 = nev0 / 2
- nevm2 = nev0 - nevd2
- if ( nev .gt. 1 ) then
- call sswap ( min(nevd2,np), ritz(nevm2+1), 1,
- & ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1)
- call sswap ( min(nevd2,np), bounds(nevm2+1), 1,
- & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1)
- end if
-c
- else
-c
-c %--------------------------------------------------%
-c | LM, SM, LA, SA case. |
-c | Sort the eigenvalues of H into the an order that |
-c | is opposite to WHICH, and apply the resulting |
-c | order to BOUNDS. The eigenvalues are sorted so |
-c | that the wanted part are always within the first |
-c | NEV locations. |
-c %--------------------------------------------------%
-c
- if (which .eq. 'LM') wprime = 'SM'
- if (which .eq. 'SM') wprime = 'LM'
- if (which .eq. 'LA') wprime = 'SA'
- if (which .eq. 'SA') wprime = 'LA'
-c
- call ssortr (wprime, .true., kplusp, ritz, bounds)
-c
- end if
-c
-c %--------------------------------------------------%
-c | Scale the Ritz estimate of each Ritz value |
-c | by 1 / max(eps23,magnitude of the Ritz value). |
-c %--------------------------------------------------%
-c
- do 35 j = 1, nev0
- temp = max( eps23, abs(ritz(j)) )
- bounds(j) = bounds(j)/temp
- 35 continue
-c
-c %----------------------------------------------------%
-c | Sort the Ritz values according to the scaled Ritz |
-c | esitmates. This will push all the converged ones |
-c | towards the front of ritzr, ritzi, bounds |
-c | (in the case when NCONV < NEV.) |
-c %----------------------------------------------------%
-c
- wprime = 'LA'
- call ssortr(wprime, .true., nev0, bounds, ritz)
-c
-c %----------------------------------------------%
-c | Scale the Ritz estimate back to its original |
-c | value. |
-c %----------------------------------------------%
-c
- do 40 j = 1, nev0
- temp = max( eps23, abs(ritz(j)) )
- bounds(j) = bounds(j)*temp
- 40 continue
-c
-c %--------------------------------------------------%
-c | Sort the "converged" Ritz values again so that |
-c | the "threshold" values and their associated Ritz |
-c | estimates appear at the appropriate position in |
-c | ritz and bound. |
-c %--------------------------------------------------%
-c
- if (which .eq. 'BE') then
-c
-c %------------------------------------------------%
-c | Sort the "converged" Ritz values in increasing |
-c | order. The "threshold" values are in the |
-c | middle. |
-c %------------------------------------------------%
-c
- wprime = 'LA'
- call ssortr(wprime, .true., nconv, ritz, bounds)
-c
- else
-c
-c %----------------------------------------------%
-c | In LM, SM, LA, SA case, sort the "converged" |
-c | Ritz values according to WHICH so that the |
-c | "threshold" value appears at the front of |
-c | ritz. |
-c %----------------------------------------------%
-
- call ssortr(which, .true., nconv, ritz, bounds)
-c
- end if
-c
-c %------------------------------------------%
-c | Use h( 1,1 ) as storage to communicate |
-c | rnorm to _seupd if needed |
-c %------------------------------------------%
-c
- h(1,1) = rnorm
-c
- if (msglvl .gt. 1) then
- call svout (logfil, kplusp, ritz, ndigit,
- & '_saup2: Sorted Ritz values.')
- call svout (logfil, kplusp, bounds, ndigit,
- & '_saup2: Sorted ritz estimates.')
- end if
-c
-c %------------------------------------%
-c | Max iterations have been exceeded. |
-c %------------------------------------%
-c
- if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
-c
-c %---------------------%
-c | No shifts to apply. |
-c %---------------------%
-c
- if (np .eq. 0 .and. nconv .lt. nev0) info = 2
-c
- np = nconv
- go to 1100
-c
- else if (nconv .lt. nev .and. ishift .eq. 1) then
-c
-c %---------------------------------------------------%
-c | Do not have all the requested eigenvalues yet. |
-c | To prevent possible stagnation, adjust the number |
-c | of Ritz values and the shifts. |
-c %---------------------------------------------------%
-c
- nevbef = nev
- nev = nev + min (nconv, np/2)
- if (nev .eq. 1 .and. kplusp .ge. 6) then
- nev = kplusp / 2
- else if (nev .eq. 1 .and. kplusp .gt. 2) then
- nev = 2
- end if
- np = kplusp - nev
-c
-c %---------------------------------------%
-c | If the size of NEV was just increased |
-c | resort the eigenvalues. |
-c %---------------------------------------%
-c
- if (nevbef .lt. nev)
- & call ssgets (ishift, which, nev, np, ritz, bounds,
- & workl)
-c
- end if
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, nconv, ndigit,
- & '_saup2: no. of "converged" Ritz values at this iter.')
- if (msglvl .gt. 1) then
- kp(1) = nev
- kp(2) = np
- call ivout (logfil, 2, kp, ndigit,
- & '_saup2: NEV and NP are')
- call svout (logfil, nev, ritz(np+1), ndigit,
- & '_saup2: "wanted" Ritz values.')
- call svout (logfil, nev, bounds(np+1), ndigit,
- & '_saup2: Ritz estimates of the "wanted" values ')
- end if
- end if
-
-c
- if (ishift .eq. 0) then
-c
-c %-----------------------------------------------------%
-c | User specified shifts: reverse communication to |
-c | compute the shifts. They are returned in the first |
-c | NP locations of WORKL. |
-c %-----------------------------------------------------%
-c
- ushift = .true.
- ido = 3
- go to 9000
- end if
-c
- 50 continue
-c
-c %------------------------------------%
-c | Back from reverse communication; |
-c | User specified shifts are returned |
-c | in WORKL(1:*NP) |
-c %------------------------------------%
-c
- ushift = .false.
-c
-c
-c %---------------------------------------------------------%
-c | Move the NP shifts to the first NP locations of RITZ to |
-c | free up WORKL. This is for the non-exact shift case; |
-c | in the exact shift case, ssgets already handles this. |
-c %---------------------------------------------------------%
-c
- if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1)
-c
- if (msglvl .gt. 2) then
- call ivout (logfil, 1, np, ndigit,
- & '_saup2: The number of shifts to apply ')
- call svout (logfil, np, workl, ndigit,
- & '_saup2: shifts selected')
- if (ishift .eq. 1) then
- call svout (logfil, np, bounds, ndigit,
- & '_saup2: corresponding Ritz estimates')
- end if
- end if
-c
-c %---------------------------------------------------------%
-c | Apply the NP0 implicit shifts by QR bulge chasing. |
-c | Each shift is applied to the entire tridiagonal matrix. |
-c | The first 2*N locations of WORKD are used as workspace. |
-c | After ssapps is done, we have a Lanczos |
-c | factorization of length NEV. |
-c %---------------------------------------------------------%
-c
- call ssapps (n, nev, np, ritz, v, ldv, h, ldh, resid, q, ldq,
- & workd)
-c
-c %---------------------------------------------%
-c | Compute the B-norm of the updated residual. |
-c | Keep B*RESID in WORKD(1:N) to be used in |
-c | the first step of the next call to ssaitr. |
-c %---------------------------------------------%
-c
- cnorm = .true.
- call arscnd (t2)
- if (bmat .eq. 'G') then
- nbx = nbx + 1
- call scopy (n, resid, 1, workd(n+1), 1)
- ipntr(1) = n + 1
- ipntr(2) = 1
- ido = 2
-c
-c %----------------------------------%
-c | Exit in order to compute B*RESID |
-c %----------------------------------%
-c
- go to 9000
- else if (bmat .eq. 'I') then
- call scopy (n, resid, 1, workd, 1)
- end if
-c
- 100 continue
-c
-c %----------------------------------%
-c | Back from reverse communication; |
-c | WORKD(1:N) := B*RESID |
-c %----------------------------------%
-c
- if (bmat .eq. 'G') then
- call arscnd (t3)
- tmvbx = tmvbx + (t3 - t2)
- end if
-c
- if (bmat .eq. 'G') then
- rnorm = sdot (n, resid, 1, workd, 1)
- rnorm = sqrt(abs(rnorm))
- else if (bmat .eq. 'I') then
- rnorm = snrm2(n, resid, 1)
- end if
- cnorm = .false.
- 130 continue
-c
- if (msglvl .gt. 2) then
- call svout (logfil, 1, rnorm, ndigit,
- & '_saup2: B-norm of residual for NEV factorization')
- call svout (logfil, nev, h(1,2), ndigit,
- & '_saup2: main diagonal of compressed H matrix')
- call svout (logfil, nev-1, h(2,1), ndigit,
- & '_saup2: subdiagonal of compressed H matrix')
- end if
-c
- go to 1000
-c
-c %---------------------------------------------------------------%
-c | |
-c | E N D O F M A I N I T E R A T I O N L O O P |
-c | |
-c %---------------------------------------------------------------%
-c
- 1100 continue
-c
- mxiter = iter
- nev = nconv
-c
- 1200 continue
- ido = 99
-c
-c %------------%
-c | Error exit |
-c %------------%
-c
- call arscnd (t1)
- tsaup2 = t1 - t0
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of ssaup2 |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssaupd.f b/netlib/ARPACK/ssaupd.f
deleted file mode 100644
index 876ce46..0000000
--- a/netlib/ARPACK/ssaupd.f
+++ /dev/null
@@ -1,690 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssaupd
-c
-c\Description:
-c
-c Reverse communication interface for the Implicitly Restarted Arnoldi
-c Iteration. For symmetric problems this reduces to a variant of the Lanczos
-c method. This method has been designed to compute approximations to a
-c few eigenpairs of a linear operator OP that is real and symmetric
-c with respect to a real positive semi-definite symmetric matrix B,
-c i.e.
-c
-c B*OP = (OP`)*B.
-c
-c Another way to express this condition is
-c
-c < x,OPy > = < OPx,y > where < z,w > = z`Bw .
-c
-c In the standard eigenproblem B is the identity matrix.
-c ( A` denotes transpose of A)
-c
-c The computed approximate eigenvalues are called Ritz values and
-c the corresponding approximate eigenvectors are called Ritz vectors.
-c
-c ssaupd is usually called iteratively to solve one of the
-c following problems:
-c
-c Mode 1: A*x = lambda*x, A symmetric
-c ===> OP = A and B = I.
-c
-c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
-c ===> OP = inv[M]*A and B = M.
-c ===> (If M can be factored see remark 3 below)
-c
-c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
-c ===> OP = (inv[K - sigma*M])*M and B = M.
-c ===> Shift-and-Invert mode
-c
-c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
-c KG symmetric indefinite
-c ===> OP = (inv[K - sigma*KG])*K and B = K.
-c ===> Buckling mode
-c
-c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
-c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
-c ===> Cayley transformed mode
-c
-c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
-c should be accomplished either by a direct method
-c using a sparse matrix factorization and solving
-c
-c [A - sigma*M]*w = v or M*w = v,
-c
-c or through an iterative method for solving these
-c systems. If an iterative method is used, the
-c convergence test must be more stringent than
-c the accuracy requirements for the eigenvalue
-c approximations.
-c
-c\Usage:
-c call ssaupd
-c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
-c IPNTR, WORKD, WORKL, LWORKL, INFO )
-c
-c\Arguments
-c IDO Integer. (INPUT/OUTPUT)
-c Reverse communication flag. IDO must be zero on the first
-c call to ssaupd. IDO will be set internally to
-c indicate the type of operation to be performed. Control is
-c then given back to the calling routine which has the
-c responsibility to carry out the requested operation and call
-c ssaupd with the result. The operand is given in
-c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
-c (If Mode = 2 see remark 5 below)
-c -------------------------------------------------------------
-c IDO = 0: first call to the reverse communication interface
-c IDO = -1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c This is for the initialization phase to force the
-c starting vector into the range of OP.
-c IDO = 1: compute Y = OP * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c In mode 3,4 and 5, the vector B * X is already
-c available in WORKD(ipntr(3)). It does not
-c need to be recomputed in forming OP * X.
-c IDO = 2: compute Y = B * X where
-c IPNTR(1) is the pointer into WORKD for X,
-c IPNTR(2) is the pointer into WORKD for Y.
-c IDO = 3: compute the IPARAM(8) shifts where
-c IPNTR(11) is the pointer into WORKL for
-c placing the shifts. See remark 6 below.
-c IDO = 99: done
-c -------------------------------------------------------------
-c
-c BMAT Character*1. (INPUT)
-c BMAT specifies the type of the matrix B that defines the
-c semi-inner product for the operator OP.
-c B = 'I' -> standard eigenvalue problem A*x = lambda*x
-c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
-c
-c N Integer. (INPUT)
-c Dimension of the eigenproblem.
-c
-c WHICH Character*2. (INPUT)
-c Specify which of the Ritz values of OP to compute.
-c
-c 'LA' - compute the NEV largest (algebraic) eigenvalues.
-c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
-c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
-c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
-c 'BE' - compute NEV eigenvalues, half from each end of the
-c spectrum. When NEV is odd, compute one more from the
-c high end than from the low end.
-c (see remark 1 below)
-c
-c NEV Integer. (INPUT)
-c Number of eigenvalues of OP to be computed. 0 < NEV < N.
-c
-c TOL Real scalar. (INPUT)
-c Stopping criterion: the relative accuracy of the Ritz value
-c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)).
-c If TOL .LE. 0. is passed a default is set:
-c DEFAULT = SLAMCH('EPS') (machine precision as computed
-c by the LAPACK auxiliary subroutine SLAMCH).
-c
-c RESID Real array of length N. (INPUT/OUTPUT)
-c On INPUT:
-c If INFO .EQ. 0, a random initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c On OUTPUT:
-c RESID contains the final residual vector.
-c
-c NCV Integer. (INPUT)
-c Number of columns of the matrix V (less than or equal to N).
-c This will indicate how many Lanczos vectors are generated
-c at each iteration. After the startup phase in which NEV
-c Lanczos vectors are generated, the algorithm generates
-c NCV-NEV Lanczos vectors at each subsequent update iteration.
-c Most of the cost in generating each Lanczos vector is in the
-c matrix-vector product OP*x. (See remark 4 below).
-c
-c V Real N by NCV array. (OUTPUT)
-c The NCV columns of V contain the Lanczos basis vectors.
-c
-c LDV Integer. (INPUT)
-c Leading dimension of V exactly as declared in the calling
-c program.
-c
-c IPARAM Integer array of length 11. (INPUT/OUTPUT)
-c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
-c The shifts selected at each iteration are used to restart
-c the Arnoldi iteration in an implicit fashion.
-c -------------------------------------------------------------
-c ISHIFT = 0: the shifts are provided by the user via
-c reverse communication. The NCV eigenvalues of
-c the current tridiagonal matrix T are returned in
-c the part of WORKL array corresponding to RITZ.
-c See remark 6 below.
-c ISHIFT = 1: exact shifts with respect to the reduced
-c tridiagonal matrix T. This is equivalent to
-c restarting the iteration with a starting vector
-c that is a linear combination of Ritz vectors
-c associated with the "wanted" Ritz values.
-c -------------------------------------------------------------
-c
-c IPARAM(2) = LEVEC
-c No longer referenced. See remark 2 below.
-c
-c IPARAM(3) = MXITER
-c On INPUT: maximum number of Arnoldi update iterations allowed.
-c On OUTPUT: actual number of Arnoldi update iterations taken.
-c
-c IPARAM(4) = NB: blocksize to be used in the recurrence.
-c The code currently works only for NB = 1.
-c
-c IPARAM(5) = NCONV: number of "converged" Ritz values.
-c This represents the number of Ritz values that satisfy
-c the convergence criterion.
-c
-c IPARAM(6) = IUPD
-c No longer referenced. Implicit restarting is ALWAYS used.
-c
-c IPARAM(7) = MODE
-c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4,5; See under \Description of ssaupd for the
-c five modes available.
-c
-c IPARAM(8) = NP
-c When ido = 3 and the user provides shifts through reverse
-c communication (IPARAM(1)=0), ssaupd returns NP, the number
-c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
-c 6 below.
-c
-c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
-c OUTPUT: NUMOP = total number of OP*x operations,
-c NUMOPB = total number of B*x operations if BMAT='G',
-c NUMREO = total number of steps of re-orthogonalization.
-c
-c IPNTR Integer array of length 11. (OUTPUT)
-c Pointer to mark the starting locations in the WORKD and WORKL
-c arrays for matrices/vectors used by the Lanczos iteration.
-c -------------------------------------------------------------
-c IPNTR(1): pointer to the current operand vector X in WORKD.
-c IPNTR(2): pointer to the current result vector Y in WORKD.
-c IPNTR(3): pointer to the vector B * X in WORKD when used in
-c the shift-and-invert mode.
-c IPNTR(4): pointer to the next available location in WORKL
-c that is untouched by the program.
-c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
-c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
-c IPNTR(7): pointer to the Ritz estimates in array WORKL associated
-c with the Ritz values located in RITZ in WORKL.
-c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below.
-c
-c Note: IPNTR(8:10) is only referenced by sseupd. See Remark 2.
-c IPNTR(8): pointer to the NCV RITZ values of the original system.
-c IPNTR(9): pointer to the NCV corresponding error bounds.
-c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors
-c of the tridiagonal matrix T. Only referenced by
-c sseupd if RVEC = .TRUE. See Remarks.
-c -------------------------------------------------------------
-c
-c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
-c Distributed array to be used in the basic Arnoldi iteration
-c for reverse communication. The user should not use WORKD
-c as temporary workspace during the iteration. Upon termination
-c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired
-c subroutine sseupd uses this output.
-c See Data Distribution Note below.
-c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end. See Data Distribution Note below.
-c
-c LWORKL Integer. (INPUT)
-c LWORKL must be at least NCV**2 + 8*NCV .
-c
-c INFO Integer. (INPUT/OUTPUT)
-c If INFO .EQ. 0, a randomly initial residual vector is used.
-c If INFO .NE. 0, RESID contains the initial residual vector,
-c possibly from a previous run.
-c Error flag on output.
-c = 0: Normal exit.
-c = 1: Maximum number of iterations taken.
-c All possible eigenvalues of OP has been found. IPARAM(5)
-c returns the number of wanted converged Ritz values.
-c = 2: No longer an informational error. Deprecated starting
-c with release 2 of ARPACK.
-c = 3: No shifts could be applied during a cycle of the
-c Implicitly restarted Arnoldi iteration. One possibility
-c is to increase the size of NCV relative to NEV.
-c See remark 4 below.
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV must be greater than NEV and less than or equal to N.
-c = -4: The maximum number of Arnoldi update iterations allowed
-c must be greater than zero.
-c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work array WORKL is not sufficient.
-c = -8: Error return from trid. eigenvalue calculation;
-c Informatinal error from LAPACK routine ssteqr.
-c = -9: Starting vector is zero.
-c = -10: IPARAM(7) must be 1,2,3,4,5.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
-c = -12: IPARAM(1) must be equal to 0 or 1.
-c = -13: NEV and WHICH = 'BE' are incompatable.
-c = -9999: Could not build an Arnoldi factorization.
-c IPARAM(5) returns the size of the current Arnoldi
-c factorization. The user is advised to check that
-c enough workspace and array storage has been allocated.
-c
-c
-c\Remarks
-c 1. The converged Ritz values are always returned in ascending
-c algebraic order. The computed Ritz values are approximate
-c eigenvalues of OP. The selection of WHICH should be made
-c with this in mind when Mode = 3,4,5. After convergence,
-c approximate eigenvalues of the original problem may be obtained
-c with the ARPACK subroutine sseupd.
-c
-c 2. If the Ritz vectors corresponding to the converged Ritz values
-c are needed, the user must call sseupd immediately following completion
-c of ssaupd. This is new starting with version 2.1 of ARPACK.
-c
-c 3. If M can be factored into a Cholesky factorization M = LL`
-c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
-c linear systems should be solved with L and L` rather
-c than computing inverses. After convergence, an approximate
-c eigenvector z of the original problem is recovered by solving
-c L`z = x where x is a Ritz vector of OP.
-c
-c 4. At present there is no a-priori analysis to guide the selection
-c of NCV relative to NEV. The only formal requrement is that NCV > NEV.
-c However, it is recommended that NCV .ge. 2*NEV. If many problems of
-c the same type are to be solved, one should experiment with increasing
-c NCV while keeping NEV fixed for a given test problem. This will
-c usually decrease the required number of OP*x operations but it
-c also increases the work and storage required to maintain the orthogonal
-c basis vectors. The optimal "cross-over" with respect to CPU time
-c is problem dependent and must be determined empirically.
-c
-c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
-c must do the following. When IDO = 1, Y = OP * X is to be computed.
-c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
-c must overwrite X with A*X. Y is then the solution to the linear set
-c of equations B*Y = A*X.
-c
-c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
-c NP = IPARAM(8) shifts in locations:
-c 1 WORKL(IPNTR(11))
-c 2 WORKL(IPNTR(11)+1)
-c .
-c .
-c .
-c NP WORKL(IPNTR(11)+NP-1).
-c
-c The eigenvalues of the current tridiagonal matrix are located in
-c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
-c order defined by WHICH. The associated Ritz estimates are located in
-c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
-c
-c-----------------------------------------------------------------------
-c
-c\Data Distribution Note:
-c
-c Fortran-D syntax:
-c ================
-c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
-c DECOMPOSE D1(N), D2(N,NCV)
-c ALIGN RESID(I) with D1(I)
-c ALIGN V(I,J) with D2(I,J)
-c ALIGN WORKD(I) with D1(I) range (1:N)
-c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
-c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
-c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
-c REPLICATED WORKL(LWORKL)
-c
-c Cray MPP syntax:
-c ===============
-c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
-c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
-c REPLICATED WORKL(LWORKL)
-c
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
-c 1980.
-c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
-c Computer Physics Communications, 53 (1989), pp 169-179.
-c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
-c Implement the Spectral Transformation", Math. Comp., 48 (1987),
-c pp 663-673.
-c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
-c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
-c SIAM J. Matr. Anal. Apps., January (1993).
-c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
-c for Updating the QR decomposition", ACM TOMS, December 1990,
-c Volume 16 Number 4, pp 369-377.
-c 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral
-c Transformations in a k-Step Arnoldi Method". In Preparation.
-c
-c\Routines called:
-c ssaup2 ARPACK routine that implements the Implicitly Restarted
-c Arnoldi Iteration.
-c sstats ARPACK routine that initialize timing and other statistics
-c variables.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine that prints vectors.
-c slamch LAPACK routine that determines machine constants.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
-c
-c\Remarks
-c 1. None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssaupd
- & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam,
- & ipntr, workd, workl, lworkl, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat*1, which*2
- integer ido, info, ldv, lworkl, n, ncv, nev
- Real
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(11), ipntr(11)
- Real
- & resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0 , zero = 0.0E+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer bounds, ierr, ih, iq, ishift, iupd, iw,
- & ldh, ldq, msglvl, mxiter, mode, nb,
- & nev0, next, np, ritz, j
- save bounds, ierr, ih, iq, ishift, iupd, iw,
- & ldh, ldq, msglvl, mxiter, mode, nb,
- & nev0, next, np, ritz
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external ssaup2, svout, ivout, arscnd, sstats
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slamch
- external slamch
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- if (ido .eq. 0) then
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call sstats
- call arscnd (t0)
- msglvl = msaupd
-c
- ierr = 0
- ishift = iparam(1)
- mxiter = iparam(3)
-c nb = iparam(4)
- nb = 1
-c
-c %--------------------------------------------%
-c | Revision 2 performs only implicit restart. |
-c %--------------------------------------------%
-c
- iupd = 1
- mode = iparam(7)
-c
-c %----------------%
-c | Error checking |
-c %----------------%
-c
- if (n .le. 0) then
- ierr = -1
- else if (nev .le. 0) then
- ierr = -2
- else if (ncv .le. nev .or. ncv .gt. n) then
- ierr = -3
- end if
-c
-c %----------------------------------------------%
-c | NP is the number of additional steps to |
-c | extend the length NEV Lanczos factorization. |
-c %----------------------------------------------%
-c
- np = ncv - nev
-c
- if (mxiter .le. 0) ierr = -4
- if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LA' .and.
- & which .ne. 'SA' .and.
- & which .ne. 'BE') ierr = -5
- if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
-c
- if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
- if (mode .lt. 1 .or. mode .gt. 5) then
- ierr = -10
- else if (mode .eq. 1 .and. bmat .eq. 'G') then
- ierr = -11
- else if (ishift .lt. 0 .or. ishift .gt. 1) then
- ierr = -12
- else if (nev .eq. 1 .and. which .eq. 'BE') then
- ierr = -13
- end if
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- ido = 99
- go to 9000
- end if
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- if (nb .le. 0) nb = 1
- if (tol .le. zero) tol = slamch('EpsMach')
-c
-c %----------------------------------------------%
-c | NP is the number of additional steps to |
-c | extend the length NEV Lanczos factorization. |
-c | NEV0 is the local variable designating the |
-c | size of the invariant subspace desired. |
-c %----------------------------------------------%
-c
- np = ncv - nev
- nev0 = nev
-c
-c %-----------------------------%
-c | Zero out internal workspace |
-c %-----------------------------%
-c
- do 10 j = 1, ncv**2 + 8*ncv
- workl(j) = zero
- 10 continue
-c
-c %-------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:2*ncv) := generated tridiagonal matrix |
-c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
-c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
-c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
-c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
-c %-------------------------------------------------------%
-c
- ldh = ncv
- ldq = ncv
- ih = 1
- ritz = ih + 2*ldh
- bounds = ritz + ncv
- iq = bounds + ncv
- iw = iq + ncv**2
- next = iw + 3*ncv
-c
- ipntr(4) = next
- ipntr(5) = ih
- ipntr(6) = ritz
- ipntr(7) = bounds
- ipntr(11) = iw
- end if
-c
-c %-------------------------------------------------------%
-c | Carry out the Implicitly restarted Lanczos Iteration. |
-c %-------------------------------------------------------%
-c
- call ssaup2
- & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
- & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz),
- & workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd,
- & info )
-c
-c %--------------------------------------------------%
-c | ido .ne. 99 implies use of reverse communication |
-c | to compute operations involving OP or shifts. |
-c %--------------------------------------------------%
-c
- if (ido .eq. 3) iparam(8) = np
- if (ido .ne. 99) go to 9000
-c
- iparam(3) = mxiter
- iparam(5) = np
- iparam(9) = nopx
- iparam(10) = nbx
- iparam(11) = nrorth
-c
-c %------------------------------------%
-c | Exit if there was an informational |
-c | error within ssaup2. |
-c %------------------------------------%
-c
- if (info .lt. 0) go to 9000
- if (info .eq. 2) info = 3
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, mxiter, ndigit,
- & '_saupd: number of update iterations taken')
- call ivout (logfil, 1, np, ndigit,
- & '_saupd: number of "converged" Ritz values')
- call svout (logfil, np, workl(Ritz), ndigit,
- & '_saupd: final Ritz values')
- call svout (logfil, np, workl(Bounds), ndigit,
- & '_saupd: corresponding error bounds')
- end if
-c
- call arscnd (t1)
- tsaupd = t1 - t0
-c
- if (msglvl .gt. 0) then
-c
-c %--------------------------------------------------------%
-c | Version Number & Version Date are defined in version.h |
-c %--------------------------------------------------------%
-c
- write (6,1000)
- write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
- & tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
- & tgetv0, tseigt, tsgets, tsapps, tsconv
- 1000 format (//,
- & 5x, '==========================================',/
- & 5x, '= Symmetric implicit Arnoldi update code =',/
- & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/
- & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/
- & 5x, '==========================================',/
- & 5x, '= Summary of timing statistics =',/
- & 5x, '==========================================',//)
- 1100 format (
- & 5x, 'Total number update iterations = ', i5,/
- & 5x, 'Total number of OP*x operations = ', i5,/
- & 5x, 'Total number of B*x operations = ', i5,/
- & 5x, 'Total number of reorthogonalization steps = ', i5,/
- & 5x, 'Total number of iterative refinement steps = ', i5,/
- & 5x, 'Total number of restart steps = ', i5,/
- & 5x, 'Total time in user OP*x operation = ', f12.6,/
- & 5x, 'Total time in user B*x operation = ', f12.6,/
- & 5x, 'Total time in Arnoldi update routine = ', f12.6,/
- & 5x, 'Total time in saup2 routine = ', f12.6,/
- & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
- & 5x, 'Total time in reorthogonalization phase = ', f12.6,/
- & 5x, 'Total time in (re)start vector generation = ', f12.6,/
- & 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
- & 5x, 'Total time in getting the shifts = ', f12.6,/
- & 5x, 'Total time in applying the shifts = ', f12.6,/
- & 5x, 'Total time in convergence testing = ', f12.6)
- end if
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of ssaupd |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssconv.f b/netlib/ARPACK/ssconv.f
deleted file mode 100644
index 3542c8c..0000000
--- a/netlib/ARPACK/ssconv.f
+++ /dev/null
@@ -1,138 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssconv
-c
-c\Description:
-c Convergence testing for the symmetric Arnoldi eigenvalue routine.
-c
-c\Usage:
-c call ssconv
-c ( N, RITZ, BOUNDS, TOL, NCONV )
-c
-c\Arguments
-c N Integer. (INPUT)
-c Number of Ritz values to check for convergence.
-c
-c RITZ Real array of length N. (INPUT)
-c The Ritz values to be checked for convergence.
-c
-c BOUNDS Real array of length N. (INPUT)
-c Ritz estimates associated with the Ritz values in RITZ.
-c
-c TOL Real scalar. (INPUT)
-c Desired relative accuracy for a Ritz value to be considered
-c "converged".
-c
-c NCONV Integer scalar. (OUTPUT)
-c Number of "converged" Ritz values.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Routines called:
-c arscnd ARPACK utility routine for timing.
-c slamch LAPACK routine that determines machine constants.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\Remarks
-c 1. Starting with version 2.4, this routine no longer uses the
-c Parlett strategy using the gap conditions.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssconv (n, ritz, bounds, tol, nconv)
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer n, nconv
- Real
- & tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & ritz(n), bounds(n)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i
- Real
- & temp, eps23
-c
-c %-------------------%
-c | External routines |
-c %-------------------%
-c
- Real
- & slamch
- external slamch
-
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic abs
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- call arscnd (t0)
-c
- eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0)
-c
- nconv = 0
- do 10 i = 1, n
-c
-c %-----------------------------------------------------%
-c | The i-th Ritz value is considered "converged" |
-c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) |
-c %-----------------------------------------------------%
-c
- temp = max( eps23, abs(ritz(i)) )
- if ( bounds(i) .le. tol*temp ) then
- nconv = nconv + 1
- end if
-c
- 10 continue
-c
- call arscnd (t1)
- tsconv = tsconv + (t1 - t0)
-c
- return
-c
-c %---------------%
-c | End of ssconv |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sseigt.f b/netlib/ARPACK/sseigt.f
deleted file mode 100644
index b77a6ea..0000000
--- a/netlib/ARPACK/sseigt.f
+++ /dev/null
@@ -1,181 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: sseigt
-c
-c\Description:
-c Compute the eigenvalues of the current symmetric tridiagonal matrix
-c and the corresponding error bounds given the current residual norm.
-c
-c\Usage:
-c call sseigt
-c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
-c
-c\Arguments
-c RNORM Real scalar. (INPUT)
-c RNORM contains the residual norm corresponding to the current
-c symmetric tridiagonal matrix H.
-c
-c N Integer. (INPUT)
-c Size of the symmetric tridiagonal matrix H.
-c
-c H Real N by 2 array. (INPUT)
-c H contains the symmetric tridiagonal matrix with the
-c subdiagonal in the first column starting at H(2,1) and the
-c main diagonal in second column.
-c
-c LDH Integer. (INPUT)
-c Leading dimension of H exactly as declared in the calling
-c program.
-c
-c EIG Real array of length N. (OUTPUT)
-c On output, EIG contains the N eigenvalues of H possibly
-c unsorted. The BOUNDS arrays are returned in the
-c same sorted order as EIG.
-c
-c BOUNDS Real array of length N. (OUTPUT)
-c On output, BOUNDS contains the error estimates corresponding
-c to the eigenvalues EIG. This is equal to RNORM times the
-c last components of the eigenvectors corresponding to the
-c eigenvalues in EIG.
-c
-c WORKL Real work array of length 3*N. (WORKSPACE)
-c Private (replicated) array on each PE or array allocated on
-c the front end.
-c
-c IERR Integer. (OUTPUT)
-c Error exit flag from sstqrb.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c sstqrb ARPACK routine that computes the eigenvalues and the
-c last components of the eigenvectors of a symmetric
-c and tridiagonal matrix.
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine that prints vectors.
-c scopy Level 1 BLAS that copies one vector to another.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.4'
-c
-c\SCCS Information: @(#)
-c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c None
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine sseigt
- & ( rnorm, n, h, ldh, eig, bounds, workl, ierr )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer ierr, ldh, n
- Real
- & rnorm
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & eig(n), bounds(n), h(ldh,2), workl(3*n)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & zero
- parameter (zero = 0.0E+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, k, msglvl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy, sstqrb, svout, arscnd
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = mseigt
-c
- if (msglvl .gt. 0) then
- call svout (logfil, n, h(1,2), ndigit,
- & '_seigt: main diagonal of matrix H')
- if (n .gt. 1) then
- call svout (logfil, n-1, h(2,1), ndigit,
- & '_seigt: sub diagonal of matrix H')
- end if
- end if
-c
- call scopy (n, h(1,2), 1, eig, 1)
- call scopy (n-1, h(2,1), 1, workl, 1)
- call sstqrb (n, eig, workl, bounds, workl(n+1), ierr)
- if (ierr .ne. 0) go to 9000
- if (msglvl .gt. 1) then
- call svout (logfil, n, bounds, ndigit,
- & '_seigt: last row of the eigenvector matrix for H')
- end if
-c
-c %-----------------------------------------------%
-c | Finally determine the error bounds associated |
-c | with the n Ritz values of H. |
-c %-----------------------------------------------%
-c
- do 30 k = 1, n
- bounds(k) = rnorm*abs(bounds(k))
- 30 continue
-c
- call arscnd (t1)
- tseigt = tseigt + (t1 - t0)
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of sseigt |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssesrt.f b/netlib/ARPACK/ssesrt.f
deleted file mode 100644
index 36e8787..0000000
--- a/netlib/ARPACK/ssesrt.f
+++ /dev/null
@@ -1,217 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssesrt
-c
-c\Description:
-c Sort the array X in the order specified by WHICH and optionally
-c apply the permutation to the columns of the matrix A.
-c
-c\Usage:
-c call ssesrt
-c ( WHICH, APPLY, N, X, NA, A, LDA)
-c
-c\Arguments
-c WHICH Character*2. (Input)
-c 'LM' -> X is sorted into increasing order of magnitude.
-c 'SM' -> X is sorted into decreasing order of magnitude.
-c 'LA' -> X is sorted into increasing order of algebraic.
-c 'SA' -> X is sorted into decreasing order of algebraic.
-c
-c APPLY Logical. (Input)
-c APPLY = .TRUE. -> apply the sorted order to A.
-c APPLY = .FALSE. -> do not apply the sorted order to A.
-c
-c N Integer. (INPUT)
-c Dimension of the array X.
-c
-c X Real array of length N. (INPUT/OUTPUT)
-c The array to be sorted.
-c
-c NA Integer. (INPUT)
-c Number of rows of the matrix A.
-c
-c A Real array of length NA by N. (INPUT/OUTPUT)
-c
-c LDA Integer. (INPUT)
-c Leading dimension of A.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Routines
-c sswap Level 1 BLAS that swaps the contents of two vectors.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.1'.
-c Adapted from the sort routine in LANSO and
-c the ARPACK code ssortr
-c
-c\SCCS Information: @(#)
-c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssesrt (which, apply, n, x, na, a, lda)
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- logical apply
- integer lda, n, na
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & x(0:n-1), a(lda, 0:n-1)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, igap, j
- Real
- & temp
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external sswap
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- igap = n / 2
-c
- if (which .eq. 'SA') then
-c
-c X is sorted into decreasing order of algebraic.
-c
- 10 continue
- if (igap .eq. 0) go to 9000
- do 30 i = igap, n-1
- j = i-igap
- 20 continue
-c
- if (j.lt.0) go to 30
-c
- if (x(j).lt.x(j+igap)) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 30
- endif
- j = j-igap
- go to 20
- 30 continue
- igap = igap / 2
- go to 10
-c
- else if (which .eq. 'SM') then
-c
-c X is sorted into decreasing order of magnitude.
-c
- 40 continue
- if (igap .eq. 0) go to 9000
- do 60 i = igap, n-1
- j = i-igap
- 50 continue
-c
- if (j.lt.0) go to 60
-c
- if (abs(x(j)).lt.abs(x(j+igap))) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 60
- endif
- j = j-igap
- go to 50
- 60 continue
- igap = igap / 2
- go to 40
-c
- else if (which .eq. 'LA') then
-c
-c X is sorted into increasing order of algebraic.
-c
- 70 continue
- if (igap .eq. 0) go to 9000
- do 90 i = igap, n-1
- j = i-igap
- 80 continue
-c
- if (j.lt.0) go to 90
-c
- if (x(j).gt.x(j+igap)) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 90
- endif
- j = j-igap
- go to 80
- 90 continue
- igap = igap / 2
- go to 70
-c
- else if (which .eq. 'LM') then
-c
-c X is sorted into increasing order of magnitude.
-c
- 100 continue
- if (igap .eq. 0) go to 9000
- do 120 i = igap, n-1
- j = i-igap
- 110 continue
-c
- if (j.lt.0) go to 120
-c
- if (abs(x(j)).gt.abs(x(j+igap))) then
- temp = x(j)
- x(j) = x(j+igap)
- x(j+igap) = temp
- if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
- else
- go to 120
- endif
- j = j-igap
- go to 110
- 120 continue
- igap = igap / 2
- go to 100
- end if
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of ssesrt |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sseupd.f b/netlib/ARPACK/sseupd.f
deleted file mode 100644
index 9349d11..0000000
--- a/netlib/ARPACK/sseupd.f
+++ /dev/null
@@ -1,867 +0,0 @@
-c\BeginDoc
-c
-c\Name: sseupd
-c
-c\Description:
-c
-c This subroutine returns the converged approximations to eigenvalues
-c of A*z = lambda*B*z and (optionally):
-c
-c (1) the corresponding approximate eigenvectors,
-c
-c (2) an orthonormal (Lanczos) basis for the associated approximate
-c invariant subspace,
-c
-c (3) Both.
-c
-c There is negligible additional cost to obtain eigenvectors. An orthonormal
-c (Lanczos) basis is always computed. There is an additional storage cost
-c of n*nev if both are requested (in this case a separate array Z must be
-c supplied).
-c
-c These quantities are obtained from the Lanczos factorization computed
-c by SSAUPD for the linear operator OP prescribed by the MODE selection
-c (see IPARAM(7) in SSAUPD documentation.) SSAUPD must be called before
-c this routine is called. These approximate eigenvalues and vectors are
-c commonly called Ritz values and Ritz vectors respectively. They are
-c referred to as such in the comments that follow. The computed orthonormal
-c basis for the invariant subspace corresponding to these Ritz values is
-c referred to as a Lanczos basis.
-c
-c See documentation in the header of the subroutine SSAUPD for a definition
-c of OP as well as other terms and the relation of computed Ritz values
-c and vectors of OP with respect to the given problem A*z = lambda*B*z.
-c
-c The approximate eigenvalues of the original problem are returned in
-c ascending algebraic order. The user may elect to call this routine
-c once for each desired Ritz vector and store it peripherally if desired.
-c There is also the option of computing a selected set of these vectors
-c with a single call.
-c
-c\Usage:
-c call sseupd
-c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
-c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
-c
-c RVEC LOGICAL (INPUT)
-c Specifies whether Ritz vectors corresponding to the Ritz value
-c approximations to the eigenproblem A*z = lambda*B*z are computed.
-c
-c RVEC = .FALSE. Compute Ritz values only.
-c
-c RVEC = .TRUE. Compute Ritz vectors.
-c
-c HOWMNY Character*1 (INPUT)
-c Specifies how many Ritz vectors are wanted and the form of Z
-c the matrix of Ritz vectors. See remark 1 below.
-c = 'A': compute NEV Ritz vectors;
-c = 'S': compute some of the Ritz vectors, specified
-c by the logical array SELECT.
-c
-c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE)
-c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
-c computed. To select the Ritz vector corresponding to a
-c Ritz value D(j), SELECT(j) must be set to .TRUE..
-c If HOWMNY = 'A' , SELECT is used as a workspace for
-c reordering the Ritz values.
-c
-c D Real array of dimension NEV. (OUTPUT)
-c On exit, D contains the Ritz value approximations to the
-c eigenvalues of A*z = lambda*B*z. The values are returned
-c in ascending order. If IPARAM(7) = 3,4,5 then D represents
-c the Ritz values of OP computed by ssaupd transformed to
-c those of the original eigensystem A*z = lambda*B*z. If
-c IPARAM(7) = 1,2 then the Ritz values of OP are the same
-c as the those of A*z = lambda*B*z.
-c
-c Z Real N by NEV array if HOWMNY = 'A'. (OUTPUT)
-c On exit, Z contains the B-orthonormal Ritz vectors of the
-c eigensystem A*z = lambda*B*z corresponding to the Ritz
-c value approximations.
-c If RVEC = .FALSE. then Z is not referenced.
-c NOTE: The array Z may be set equal to first NEV columns of the
-c Arnoldi/Lanczos basis array V computed by SSAUPD.
-c
-c LDZ Integer. (INPUT)
-c The leading dimension of the array Z. If Ritz vectors are
-c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1.
-c
-c SIGMA Real (INPUT)
-c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if
-c IPARAM(7) = 1 or 2.
-c
-c
-c **** The remaining arguments MUST be the same as for the ****
-c **** call to SSAUPD that was just completed. ****
-c
-c NOTE: The remaining arguments
-c
-c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR,
-c WORKD, WORKL, LWORKL, INFO
-c
-c must be passed directly to SSEUPD following the last call
-c to SSAUPD. These arguments MUST NOT BE MODIFIED between
-c the the last call to SSAUPD and the call to SSEUPD.
-c
-c Two of these parameters (WORKL, INFO) are also output parameters:
-c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
-c WORKL(1:4*ncv) contains information obtained in
-c ssaupd. They are not changed by sseupd.
-c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the
-c untransformed Ritz values, the computed error estimates,
-c and the associated eigenvector matrix of H.
-c
-c Note: IPNTR(8:10) contains the pointer into WORKL for addresses
-c of the above information computed by sseupd.
-c -------------------------------------------------------------
-c IPNTR(8): pointer to the NCV RITZ values of the original system.
-c IPNTR(9): pointer to the NCV corresponding error bounds.
-c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors
-c of the tridiagonal matrix T. Only referenced by
-c sseupd if RVEC = .TRUE. See Remarks.
-c -------------------------------------------------------------
-c
-c INFO Integer. (OUTPUT)
-c Error flag on output.
-c = 0: Normal exit.
-c = -1: N must be positive.
-c = -2: NEV must be positive.
-c = -3: NCV must be greater than NEV and less than or equal to N.
-c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.
-c = -6: BMAT must be one of 'I' or 'G'.
-c = -7: Length of private work WORKL array is not sufficient.
-c = -8: Error return from trid. eigenvalue calculation;
-c Information error from LAPACK routine ssteqr.
-c = -9: Starting vector is zero.
-c = -10: IPARAM(7) must be 1,2,3,4,5.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
-c = -12: NEV and WHICH = 'BE' are incompatible.
-c = -14: SSAUPD did not find any eigenvalues to sufficient
-c accuracy.
-c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true.
-c = -16: HOWMNY = 'S' not yet implemented
-c = -17: SSEUPD got a different count of the number of converged
-c Ritz values than SSAUPD got. This indicates the user
-c probably made an error in passing data from SSAUPD to
-c SSEUPD or that the data was modified before entering
-c SSEUPD.
-c
-c\BeginLib
-c
-c\References:
-c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
-c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
-c pp 357-385.
-c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
-c Restarted Arnoldi Iteration", Rice University Technical Report
-c TR95-13, Department of Computational and Applied Mathematics.
-c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
-c 1980.
-c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
-c Computer Physics Communications, 53 (1989), pp 169-179.
-c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
-c Implement the Spectral Transformation", Math. Comp., 48 (1987),
-c pp 663-673.
-c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
-c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
-c SIAM J. Matr. Anal. Apps., January (1993).
-c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
-c for Updating the QR decomposition", ACM TOMS, December 1990,
-c Volume 16 Number 4, pp 369-377.
-c
-c\Remarks
-c 1. The converged Ritz values are always returned in increasing
-c (algebraic) order.
-c
-c 2. Currently only HOWMNY = 'A' is implemented. It is included at this
-c stage for the user who wants to incorporate it.
-c
-c\Routines called:
-c ssesrt ARPACK routine that sorts an array X, and applies the
-c corresponding permutation to a matrix A.
-c ssortr ssortr ARPACK sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c svout ARPACK utility routine that prints vectors.
-c sgeqr2 LAPACK routine that computes the QR factorization of
-c a matrix.
-c slacpy LAPACK matrix copy routine.
-c slamch LAPACK routine that determines machine constants.
-c sorm2r LAPACK routine that applies an orthogonal matrix in
-c factored form.
-c ssteqr LAPACK routine that computes eigenvalues and eigenvectors
-c of a tridiagonal matrix.
-c sger Level 2 BLAS rank one update to a matrix.
-c scopy Level 1 BLAS that copies one vector to another .
-c snrm2 Level 1 BLAS that computes the norm of a vector.
-c sscal Level 1 BLAS that scales a vector.
-c sswap Level 1 BLAS that swaps the contents of two vectors.
-
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Chao Yang Houston, Texas
-c Dept. of Computational &
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/15/93: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
- subroutine sseupd(rvec , howmny, select, d ,
- & z , ldz , sigma , bmat ,
- & n , which , nev , tol ,
- & resid , ncv , v , ldv ,
- & iparam, ipntr , workd , workl,
- & lworkl, info )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character bmat, howmny, which*2
- logical rvec
- integer info, ldz, ldv, lworkl, n, ncv, nev
- Real
- & sigma, tol
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- integer iparam(7), ipntr(11)
- logical select(ncv)
- Real
- & d(nev) , resid(n) , v(ldv,ncv),
- & z(ldz, nev), workd(2*n), workl(lworkl)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0 , zero = 0.0E+0 )
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- character type*6
- integer bounds , ierr , ih , ihb , ihd ,
- & iq , iw , j , k , ldh ,
- & ldq , mode , msglvl, nconv , next ,
- & ritz , irz , ibd , np , ishift,
- & leftptr, rghtptr, numcnv, jj
- Real
- & bnorm2 , rnorm, temp, temp1, eps23
- logical reord
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external scopy , sger , sgeqr2, slacpy, sorm2r, sscal,
- & ssesrt, ssteqr, sswap , svout , ivout , ssortr
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & snrm2, slamch
- external snrm2, slamch
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic min
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %------------------------%
-c | Set default parameters |
-c %------------------------%
-c
- msglvl = mseupd
- mode = iparam(7)
- nconv = iparam(5)
- info = 0
-c
-c %--------------%
-c | Quick return |
-c %--------------%
-c
- if (nconv .eq. 0) go to 9000
- ierr = 0
-c
- if (nconv .le. 0) ierr = -14
- if (n .le. 0) ierr = -1
- if (nev .le. 0) ierr = -2
- if (ncv .le. nev .or. ncv .gt. n) ierr = -3
- if (which .ne. 'LM' .and.
- & which .ne. 'SM' .and.
- & which .ne. 'LA' .and.
- & which .ne. 'SA' .and.
- & which .ne. 'BE') ierr = -5
- if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
- if ( (howmny .ne. 'A' .and.
- & howmny .ne. 'P' .and.
- & howmny .ne. 'S') .and. rvec )
- & ierr = -15
- if (rvec .and. howmny .eq. 'S') ierr = -16
-c
- if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
-c
- if (mode .eq. 1 .or. mode .eq. 2) then
- type = 'REGULR'
- else if (mode .eq. 3 ) then
- type = 'SHIFTI'
- else if (mode .eq. 4 ) then
- type = 'BUCKLE'
- else if (mode .eq. 5 ) then
- type = 'CAYLEY'
- else
- ierr = -10
- end if
- if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
- if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
-c
-c %------------%
-c | Error Exit |
-c %------------%
-c
- if (ierr .ne. 0) then
- info = ierr
- go to 9000
- end if
-c
-c %-------------------------------------------------------%
-c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
-c | etc... and the remaining workspace. |
-c | Also update pointer to be used on output. |
-c | Memory is laid out as follows: |
-c | workl(1:2*ncv) := generated tridiagonal matrix H |
-c | The subdiagonal is stored in workl(2:ncv). |
-c | The dead spot is workl(1) but upon exiting |
-c | ssaupd stores the B-norm of the last residual |
-c | vector in workl(1). We use this !!! |
-c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
-c | The wanted values are in the first NCONV spots. |
-c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates |
-c | The wanted values are in the first NCONV spots. |
-c | NOTE: workl(1:4*ncv) is set by ssaupd and is not |
-c | modified by sseupd. |
-c %-------------------------------------------------------%
-c
-c %-------------------------------------------------------%
-c | The following is used and set by sseupd. |
-c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during |
-c | computation of the eigenvectors of H. Stores |
-c | the diagonal of H. Upon EXIT contains the NCV |
-c | Ritz values of the original system. The first |
-c | NCONV spots have the wanted values. If MODE = |
-c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
-c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
-c | computation of the eigenvectors of H. Stores |
-c | the subdiagonal of H. Upon EXIT contains the |
-c | NCV corresponding Ritz estimates of the |
-c | original system. The first NCONV spots have the |
-c | wanted values. If MODE = 1,2 then will equal |
-c | workl(3*ncv+1:4*ncv). |
-c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is |
-c | the eigenvector matrix for H as returned by |
-c | ssteqr. Not referenced if RVEC = .False. |
-c | Ordering follows that of workl(4*ncv+1:5*ncv) |
-c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := |
-c | Workspace. Needed by ssteqr and by sseupd. |
-c | GRAND total of NCV*(NCV+8) locations. |
-c %-------------------------------------------------------%
-c
-c
- ih = ipntr(5)
- ritz = ipntr(6)
- bounds = ipntr(7)
- ldh = ncv
- ldq = ncv
- ihd = bounds + ldh
- ihb = ihd + ldh
- iq = ihb + ldh
- iw = iq + ldh*ncv
- next = iw + 2*ncv
- ipntr(4) = next
- ipntr(8) = ihd
- ipntr(9) = ihb
- ipntr(10) = iq
-c
-c %----------------------------------------%
-c | irz points to the Ritz values computed |
-c | by _seigt before exiting _saup2. |
-c | ibd points to the Ritz estimates |
-c | computed by _seigt before exiting |
-c | _saup2. |
-c %----------------------------------------%
-c
- irz = ipntr(11)+ncv
- ibd = irz+ncv
-c
-c
-c %---------------------------------%
-c | Set machine dependent constant. |
-c %---------------------------------%
-c
- eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0 )
-c
-c %---------------------------------------%
-c | RNORM is B-norm of the RESID(1:N). |
-c | BNORM2 is the 2 norm of B*RESID(1:N). |
-c | Upon exit of ssaupd WORKD(1:N) has |
-c | B*RESID(1:N). |
-c %---------------------------------------%
-c
- rnorm = workl(ih)
- if (bmat .eq. 'I') then
- bnorm2 = rnorm
- else if (bmat .eq. 'G') then
- bnorm2 = snrm2(n, workd, 1)
- end if
-c
- if (msglvl .gt. 2) then
- call svout(logfil, ncv, workl(irz), ndigit,
- & '_seupd: Ritz values passed in from _SAUPD.')
- call svout(logfil, ncv, workl(ibd), ndigit,
- & '_seupd: Ritz estimates passed in from _SAUPD.')
- end if
-c
- if (rvec) then
-c
- reord = .false.
-c
-c %---------------------------------------------------%
-c | Use the temporary bounds array to store indices |
-c | These will be used to mark the select array later |
-c %---------------------------------------------------%
-c
- do 10 j = 1,ncv
- workl(bounds+j-1) = j
- select(j) = .false.
- 10 continue
-c
-c %-------------------------------------%
-c | Select the wanted Ritz values. |
-c | Sort the Ritz values so that the |
-c | wanted ones appear at the tailing |
-c | NEV positions of workl(irr) and |
-c | workl(iri). Move the corresponding |
-c | error estimates in workl(bound) |
-c | accordingly. |
-c %-------------------------------------%
-c
- np = ncv - nev
- ishift = 0
- call ssgets(ishift, which , nev ,
- & np , workl(irz) , workl(bounds),
- & workl)
-c
- if (msglvl .gt. 2) then
- call svout(logfil, ncv, workl(irz), ndigit,
- & '_seupd: Ritz values after calling _SGETS.')
- call svout(logfil, ncv, workl(bounds), ndigit,
- & '_seupd: Ritz value indices after calling _SGETS.')
- end if
-c
-c %-----------------------------------------------------%
-c | Record indices of the converged wanted Ritz values |
-c | Mark the select array for possible reordering |
-c %-----------------------------------------------------%
-c
- numcnv = 0
- do 11 j = 1,ncv
- temp1 = max(eps23, abs(workl(irz+ncv-j)) )
- jj = workl(bounds + ncv - j)
- if (numcnv .lt. nconv .and.
- & workl(ibd+jj-1) .le. tol*temp1) then
- select(jj) = .true.
- numcnv = numcnv + 1
- if (jj .gt. nconv) reord = .true.
- endif
- 11 continue
-c
-c %-----------------------------------------------------------%
-c | Check the count (numcnv) of converged Ritz values with |
-c | the number (nconv) reported by _saupd. If these two |
-c | are different then there has probably been an error |
-c | caused by incorrect passing of the _saupd data. |
-c %-----------------------------------------------------------%
-c
- if (msglvl .gt. 2) then
- call ivout(logfil, 1, numcnv, ndigit,
- & '_seupd: Number of specified eigenvalues')
- call ivout(logfil, 1, nconv, ndigit,
- & '_seupd: Number of "converged" eigenvalues')
- end if
-c
- if (numcnv .ne. nconv) then
- info = -17
- go to 9000
- end if
-c
-c %-----------------------------------------------------------%
-c | Call LAPACK routine _steqr to compute the eigenvalues and |
-c | eigenvectors of the final symmetric tridiagonal matrix H. |
-c | Initialize the eigenvector matrix Q to the identity. |
-c %-----------------------------------------------------------%
-c
- call scopy(ncv-1, workl(ih+1), 1, workl(ihb), 1)
- call scopy(ncv, workl(ih+ldh), 1, workl(ihd), 1)
-c
- call ssteqr('Identity', ncv, workl(ihd), workl(ihb),
- & workl(iq) , ldq, workl(iw), ierr)
-c
- if (ierr .ne. 0) then
- info = -8
- go to 9000
- end if
-c
- if (msglvl .gt. 1) then
- call scopy(ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
- call svout(logfil, ncv, workl(ihd), ndigit,
- & '_seupd: NCV Ritz values of the final H matrix')
- call svout(logfil, ncv, workl(iw), ndigit,
- & '_seupd: last row of the eigenvector matrix for H')
- end if
-c
- if (reord) then
-c
-c %---------------------------------------------%
-c | Reordered the eigenvalues and eigenvectors |
-c | computed by _steqr so that the "converged" |
-c | eigenvalues appear in the first NCONV |
-c | positions of workl(ihd), and the associated |
-c | eigenvectors appear in the first NCONV |
-c | columns. |
-c %---------------------------------------------%
-c
- leftptr = 1
- rghtptr = ncv
-c
- if (ncv .eq. 1) go to 30
-c
- 20 if (select(leftptr)) then
-c
-c %-------------------------------------------%
-c | Search, from the left, for the first Ritz |
-c | value that has not converged. |
-c %-------------------------------------------%
-c
- leftptr = leftptr + 1
-c
- else if ( .not. select(rghtptr)) then
-c
-c %----------------------------------------------%
-c | Search, from the right, the first Ritz value |
-c | that has converged. |
-c %----------------------------------------------%
-c
- rghtptr = rghtptr - 1
-c
- else
-c
-c %----------------------------------------------%
-c | Swap the Ritz value on the left that has not |
-c | converged with the Ritz value on the right |
-c | that has converged. Swap the associated |
-c | eigenvector of the tridiagonal matrix H as |
-c | well. |
-c %----------------------------------------------%
-c
- temp = workl(ihd+leftptr-1)
- workl(ihd+leftptr-1) = workl(ihd+rghtptr-1)
- workl(ihd+rghtptr-1) = temp
- call scopy(ncv, workl(iq+ncv*(leftptr-1)), 1,
- & workl(iw), 1)
- call scopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
- & workl(iq+ncv*(leftptr-1)), 1)
- call scopy(ncv, workl(iw), 1,
- & workl(iq+ncv*(rghtptr-1)), 1)
- leftptr = leftptr + 1
- rghtptr = rghtptr - 1
-c
- end if
-c
- if (leftptr .lt. rghtptr) go to 20
-c
- end if
-c
- 30 if (msglvl .gt. 2) then
- call svout (logfil, ncv, workl(ihd), ndigit,
- & '_seupd: The eigenvalues of H--reordered')
- end if
-c
-c %----------------------------------------%
-c | Load the converged Ritz values into D. |
-c %----------------------------------------%
-c
- call scopy(nconv, workl(ihd), 1, d, 1)
-c
- else
-c
-c %-----------------------------------------------------%
-c | Ritz vectors not required. Load Ritz values into D. |
-c %-----------------------------------------------------%
-c
- call scopy(nconv, workl(ritz), 1, d, 1)
- call scopy(ncv, workl(ritz), 1, workl(ihd), 1)
-c
- end if
-c
-c %------------------------------------------------------------------%
-c | Transform the Ritz values and possibly vectors and corresponding |
-c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
-c | (and corresponding data) are returned in ascending order. |
-c %------------------------------------------------------------------%
-c
- if (type .eq. 'REGULR') then
-c
-c %---------------------------------------------------------%
-c | Ascending sort of wanted Ritz values, vectors and error |
-c | bounds. Not necessary if only Ritz values are desired. |
-c %---------------------------------------------------------%
-c
- if (rvec) then
- call ssesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
- else
- call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
- end if
-c
- else
-c
-c %-------------------------------------------------------------%
-c | * Make a copy of all the Ritz values. |
-c | * Transform the Ritz values back to the original system. |
-c | For TYPE = 'SHIFTI' the transformation is |
-c | lambda = 1/theta + sigma |
-c | For TYPE = 'BUCKLE' the transformation is |
-c | lambda = sigma * theta / ( theta - 1 ) |
-c | For TYPE = 'CAYLEY' the transformation is |
-c | lambda = sigma * (theta + 1) / (theta - 1 ) |
-c | where the theta are the Ritz values returned by ssaupd. |
-c | NOTES: |
-c | *The Ritz vectors are not affected by the transformation. |
-c | They are only reordered. |
-c %-------------------------------------------------------------%
-c
- call scopy (ncv, workl(ihd), 1, workl(iw), 1)
- if (type .eq. 'SHIFTI') then
- do 40 k=1, ncv
- workl(ihd+k-1) = one / workl(ihd+k-1) + sigma
- 40 continue
- else if (type .eq. 'BUCKLE') then
- do 50 k=1, ncv
- workl(ihd+k-1) = sigma * workl(ihd+k-1) /
- & (workl(ihd+k-1) - one)
- 50 continue
- else if (type .eq. 'CAYLEY') then
- do 60 k=1, ncv
- workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
- & (workl(ihd+k-1) - one)
- 60 continue
- end if
-c
-c %-------------------------------------------------------------%
-c | * Store the wanted NCONV lambda values into D. |
-c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) |
-c | into ascending order and apply sort to the NCONV theta |
-c | values in the transformed system. We will need this to |
-c | compute Ritz estimates in the original system. |
-c | * Finally sort the lambda`s into ascending order and apply |
-c | to Ritz vectors if wanted. Else just sort lambda`s into |
-c | ascending order. |
-c | NOTES: |
-c | *workl(iw:iw+ncv-1) contain the theta ordered so that they |
-c | match the ordering of the lambda. We`ll use them again for |
-c | Ritz vector purification. |
-c %-------------------------------------------------------------%
-c
- call scopy(nconv, workl(ihd), 1, d, 1)
- call ssortr('LA', .true., nconv, workl(ihd), workl(iw))
- if (rvec) then
- call ssesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
- else
- call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
- call sscal(ncv, bnorm2/rnorm, workl(ihb), 1)
- call ssortr('LA', .true., nconv, d, workl(ihb))
- end if
-c
- end if
-c
-c %------------------------------------------------%
-c | Compute the Ritz vectors. Transform the wanted |
-c | eigenvectors of the symmetric tridiagonal H by |
-c | the Lanczos basis matrix V. |
-c %------------------------------------------------%
-c
- if (rvec .and. howmny .eq. 'A') then
-c
-c %----------------------------------------------------------%
-c | Compute the QR factorization of the matrix representing |
-c | the wanted invariant subspace located in the first NCONV |
-c | columns of workl(iq,ldq). |
-c %----------------------------------------------------------%
-c
- call sgeqr2(ncv, nconv , workl(iq) ,
- & ldq, workl(iw+ncv), workl(ihb),
- & ierr)
-c
-c %--------------------------------------------------------%
-c | * Postmultiply V by Q. |
-c | * Copy the first NCONV columns of VQ into Z. |
-c | The N by NCONV matrix Z is now a matrix representation |
-c | of the approximate invariant subspace associated with |
-c | the Ritz values in workl(ihd). |
-c %--------------------------------------------------------%
-c
- call sorm2r('Right', 'Notranspose', n ,
- & ncv , nconv , workl(iq),
- & ldq , workl(iw+ncv), v ,
- & ldv , workd(n+1) , ierr)
- call slacpy('All', n, nconv, v, ldv, z, ldz)
-c
-c %-----------------------------------------------------%
-c | In order to compute the Ritz estimates for the Ritz |
-c | values in both systems, need the last row of the |
-c | eigenvector matrix. Remember, it`s in factored form |
-c %-----------------------------------------------------%
-c
- do 65 j = 1, ncv-1
- workl(ihb+j-1) = zero
- 65 continue
- workl(ihb+ncv-1) = one
- call sorm2r('Left', 'Transpose' , ncv ,
- & 1 , nconv , workl(iq) ,
- & ldq , workl(iw+ncv), workl(ihb),
- & ncv , temp , ierr)
-c
-c %-----------------------------------------------------%
-c | Make a copy of the last row into |
-c | workl(iw+ncv:iw+2*ncv), as it is needed again in |
-c | the Ritz vector purification step below |
-c %-----------------------------------------------------%
-c
- do 67 j = 1, nconv
- workl(iw+ncv+j-1) = workl(ihb+j-1)
- 67 continue
-
- else if (rvec .and. howmny .eq. 'S') then
-c
-c Not yet implemented. See remark 2 above.
-c
- end if
-c
- if (type .eq. 'REGULR' .and. rvec) then
-c
- do 70 j=1, ncv
- workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
- 70 continue
-c
- else if (type .ne. 'REGULR' .and. rvec) then
-c
-c %-------------------------------------------------%
-c | * Determine Ritz estimates of the theta. |
-c | If RVEC = .true. then compute Ritz estimates |
-c | of the theta. |
-c | If RVEC = .false. then copy Ritz estimates |
-c | as computed by ssaupd. |
-c | * Determine Ritz estimates of the lambda. |
-c %-------------------------------------------------%
-c
- call sscal (ncv, bnorm2, workl(ihb), 1)
- if (type .eq. 'SHIFTI') then
-c
- do 80 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1) )
- & / workl(iw+k-1)**2
- 80 continue
-c
- else if (type .eq. 'BUCKLE') then
-c
- do 90 k=1, ncv
- workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) )
- & / (workl(iw+k-1)-one )**2
- 90 continue
-c
- else if (type .eq. 'CAYLEY') then
-c
- do 100 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1)
- & / workl(iw+k-1)*(workl(iw+k-1)-one) )
- 100 continue
-c
- end if
-c
- end if
-c
- if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
- call svout(logfil, nconv, d, ndigit,
- & '_seupd: Untransformed converged Ritz values')
- call svout(logfil, nconv, workl(ihb), ndigit,
- & '_seupd: Ritz estimates of the untransformed Ritz values')
- else if (msglvl .gt. 1) then
- call svout(logfil, nconv, d, ndigit,
- & '_seupd: Converged Ritz values')
- call svout(logfil, nconv, workl(ihb), ndigit,
- & '_seupd: Associated Ritz estimates')
- end if
-c
-c %-------------------------------------------------%
-c | Ritz vector purification step. Formally perform |
-c | one of inverse subspace iteration. Only used |
-c | for MODE = 3,4,5. See reference 7 |
-c %-------------------------------------------------%
-c
- if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then
-c
- do 110 k=0, nconv-1
- workl(iw+k) = workl(iw+ncv+k)
- & / workl(iw+k)
- 110 continue
-c
- else if (rvec .and. type .eq. 'BUCKLE') then
-c
- do 120 k=0, nconv-1
- workl(iw+k) = workl(iw+ncv+k)
- & / (workl(iw+k)-one)
- 120 continue
-c
- end if
-c
- if (type .ne. 'REGULR')
- & call sger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
-c
- 9000 continue
-c
- return
-c
-c %---------------%
-c | End of sseupd|
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssgets.f b/netlib/ARPACK/ssgets.f
deleted file mode 100644
index 5591549..0000000
--- a/netlib/ARPACK/ssgets.f
+++ /dev/null
@@ -1,219 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssgets
-c
-c\Description:
-c Given the eigenvalues of the symmetric tridiagonal matrix H,
-c computes the NP shifts AMU that are zeros of the polynomial of
-c degree NP which filters out components of the unwanted eigenvectors
-c corresponding to the AMU's based on some given criteria.
-c
-c NOTE: This is called even in the case of user specified shifts in
-c order to sort the eigenvalues, and error bounds of H for later use.
-c
-c\Usage:
-c call ssgets
-c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
-c
-c\Arguments
-c ISHIFT Integer. (INPUT)
-c Method for selecting the implicit shifts at each iteration.
-c ISHIFT = 0: user specified shifts
-c ISHIFT = 1: exact shift with respect to the matrix H.
-c
-c WHICH Character*2. (INPUT)
-c Shift selection criteria.
-c 'LM' -> KEV eigenvalues of largest magnitude are retained.
-c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
-c 'LA' -> KEV eigenvalues of largest value are retained.
-c 'SA' -> KEV eigenvalues of smallest value are retained.
-c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
-c If KEV is odd, compute one more from the high end.
-c
-c KEV Integer. (INPUT)
-c KEV+NP is the size of the matrix H.
-c
-c NP Integer. (INPUT)
-c Number of implicit shifts to be computed.
-c
-c RITZ Real array of length KEV+NP. (INPUT/OUTPUT)
-c On INPUT, RITZ contains the eigenvalues of H.
-c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
-c are in the first NP locations and the wanted part is in
-c the last KEV locations. When exact shifts are selected, the
-c unwanted part corresponds to the shifts to be applied.
-c
-c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
-c Error bounds corresponding to the ordering in RITZ.
-c
-c SHIFTS Real array of length NP. (INPUT/OUTPUT)
-c On INPUT: contains the user specified shifts if ISHIFT = 0.
-c On OUTPUT: contains the shifts sorted into decreasing order
-c of magnitude with respect to the Ritz estimates contained in
-c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c ssortr ARPACK utility sorting routine.
-c ivout ARPACK utility routine that prints integers.
-c arscnd ARPACK utility routine for timing.
-c svout ARPACK utility routine that prints vectors.
-c scopy Level 1 BLAS that copies one vector to another.
-c sswap Level 1 BLAS that swaps the contents of two vectors.
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/93: Version ' 2.1'
-c
-c\SCCS Information: @(#)
-c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\Remarks
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssgets ( ishift, which, kev, np, ritz, bounds, shifts )
-c
-c %----------------------------------------------------%
-c | Include files for debugging and timing information |
-c %----------------------------------------------------%
-c
- include 'debug.h'
- include 'stat.h'
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- integer ishift, kev, np
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & bounds(kev+np), ritz(kev+np), shifts(np)
-c
-c %------------%
-c | Parameters |
-c %------------%
-c
- Real
- & one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer kevd2, msglvl
-c
-c %----------------------%
-c | External Subroutines |
-c %----------------------%
-c
- external sswap, scopy, ssortr, arscnd
-c
-c %---------------------%
-c | Intrinsic Functions |
-c %---------------------%
-c
- intrinsic max, min
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
-c %-------------------------------%
-c | Initialize timing statistics |
-c | & message level for debugging |
-c %-------------------------------%
-c
- call arscnd (t0)
- msglvl = msgets
-c
- if (which .eq. 'BE') then
-c
-c %-----------------------------------------------------%
-c | Both ends of the spectrum are requested. |
-c | Sort the eigenvalues into algebraically increasing |
-c | order first then swap high end of the spectrum next |
-c | to low end in appropriate locations. |
-c | NOTE: when np < floor(kev/2) be careful not to swap |
-c | overlapping locations. |
-c %-----------------------------------------------------%
-c
- call ssortr ('LA', .true., kev+np, ritz, bounds)
- kevd2 = kev / 2
- if ( kev .gt. 1 ) then
- call sswap ( min(kevd2,np), ritz, 1,
- & ritz( max(kevd2,np)+1 ), 1)
- call sswap ( min(kevd2,np), bounds, 1,
- & bounds( max(kevd2,np)+1 ), 1)
- end if
-c
- else
-c
-c %----------------------------------------------------%
-c | LM, SM, LA, SA case. |
-c | Sort the eigenvalues of H into the desired order |
-c | and apply the resulting order to BOUNDS. |
-c | The eigenvalues are sorted so that the wanted part |
-c | are always in the last KEV locations. |
-c %----------------------------------------------------%
-c
- call ssortr (which, .true., kev+np, ritz, bounds)
- end if
-c
- if (ishift .eq. 1 .and. np .gt. 0) then
-c
-c %-------------------------------------------------------%
-c | Sort the unwanted Ritz values used as shifts so that |
-c | the ones with largest Ritz estimates are first. |
-c | This will tend to minimize the effects of the |
-c | forward instability of the iteration when the shifts |
-c | are applied in subroutine ssapps. |
-c %-------------------------------------------------------%
-c
- call ssortr ('SM', .true., np, bounds, ritz)
- call scopy (np, ritz, 1, shifts, 1)
- end if
-c
- call arscnd (t1)
- tsgets = tsgets + (t1 - t0)
-c
- if (msglvl .gt. 0) then
- call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is')
- call ivout (logfil, 1, np, ndigit, '_sgets: NP is')
- call svout (logfil, kev+np, ritz, ndigit,
- & '_sgets: Eigenvalues of current H matrix')
- call svout (logfil, kev+np, bounds, ndigit,
- & '_sgets: Associated Ritz estimates')
- end if
-c
- return
-c
-c %---------------%
-c | End of ssgets |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssortc.f b/netlib/ARPACK/ssortc.f
deleted file mode 100644
index dba628f..0000000
--- a/netlib/ARPACK/ssortc.f
+++ /dev/null
@@ -1,344 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssortc
-c
-c\Description:
-c Sorts the complex array in XREAL and XIMAG into the order
-c specified by WHICH and optionally applies the permutation to the
-c real array Y. It is assumed that if an element of XIMAG is
-c nonzero, then its negative is also an element. In other words,
-c both members of a complex conjugate pair are to be sorted and the
-c pairs are kept adjacent to each other.
-c
-c\Usage:
-c call ssortc
-c ( WHICH, APPLY, N, XREAL, XIMAG, Y )
-c
-c\Arguments
-c WHICH Character*2. (Input)
-c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude.
-c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude.
-c 'LR' -> sort XREAL into increasing order of algebraic.
-c 'SR' -> sort XREAL into decreasing order of algebraic.
-c 'LI' -> sort XIMAG into increasing order of magnitude.
-c 'SI' -> sort XIMAG into decreasing order of magnitude.
-c NOTE: If an element of XIMAG is non-zero, then its negative
-c is also an element.
-c
-c APPLY Logical. (Input)
-c APPLY = .TRUE. -> apply the sorted order to array Y.
-c APPLY = .FALSE. -> do not apply the sorted order to array Y.
-c
-c N Integer. (INPUT)
-c Size of the arrays.
-c
-c XREAL, Real array of length N. (INPUT/OUTPUT)
-c XIMAG Real and imaginary part of the array to be sorted.
-c
-c Y Real array of length N. (INPUT/OUTPUT)
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c xx/xx/92: Version ' 2.1'
-c Adapted from the sort routine in LANSO.
-c
-c\SCCS Information: @(#)
-c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssortc (which, apply, n, xreal, ximag, y)
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- logical apply
- integer n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & xreal(0:n-1), ximag(0:n-1), y(0:n-1)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, igap, j
- Real
- & temp, temp1, temp2
-c
-c %--------------------%
-c | External Functions |
-c %--------------------%
-c
- Real
- & slapy2
- external slapy2
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- igap = n / 2
-c
- if (which .eq. 'LM') then
-c
-c %------------------------------------------------------%
-c | Sort XREAL,XIMAG into increasing order of magnitude. |
-c %------------------------------------------------------%
-c
- 10 continue
- if (igap .eq. 0) go to 9000
-c
- do 30 i = igap, n-1
- j = i-igap
- 20 continue
-c
- if (j.lt.0) go to 30
-c
- temp1 = slapy2(xreal(j),ximag(j))
- temp2 = slapy2(xreal(j+igap),ximag(j+igap))
-c
- if (temp1.gt.temp2) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 30
- end if
- j = j-igap
- go to 20
- 30 continue
- igap = igap / 2
- go to 10
-c
- else if (which .eq. 'SM') then
-c
-c %------------------------------------------------------%
-c | Sort XREAL,XIMAG into decreasing order of magnitude. |
-c %------------------------------------------------------%
-c
- 40 continue
- if (igap .eq. 0) go to 9000
-c
- do 60 i = igap, n-1
- j = i-igap
- 50 continue
-c
- if (j .lt. 0) go to 60
-c
- temp1 = slapy2(xreal(j),ximag(j))
- temp2 = slapy2(xreal(j+igap),ximag(j+igap))
-c
- if (temp1.lt.temp2) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 60
- endif
- j = j-igap
- go to 50
- 60 continue
- igap = igap / 2
- go to 40
-c
- else if (which .eq. 'LR') then
-c
-c %------------------------------------------------%
-c | Sort XREAL into increasing order of algebraic. |
-c %------------------------------------------------%
-c
- 70 continue
- if (igap .eq. 0) go to 9000
-c
- do 90 i = igap, n-1
- j = i-igap
- 80 continue
-c
- if (j.lt.0) go to 90
-c
- if (xreal(j).gt.xreal(j+igap)) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 90
- endif
- j = j-igap
- go to 80
- 90 continue
- igap = igap / 2
- go to 70
-c
- else if (which .eq. 'SR') then
-c
-c %------------------------------------------------%
-c | Sort XREAL into decreasing order of algebraic. |
-c %------------------------------------------------%
-c
- 100 continue
- if (igap .eq. 0) go to 9000
- do 120 i = igap, n-1
- j = i-igap
- 110 continue
-c
- if (j.lt.0) go to 120
-c
- if (xreal(j).lt.xreal(j+igap)) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 120
- endif
- j = j-igap
- go to 110
- 120 continue
- igap = igap / 2
- go to 100
-c
- else if (which .eq. 'LI') then
-c
-c %------------------------------------------------%
-c | Sort XIMAG into increasing order of magnitude. |
-c %------------------------------------------------%
-c
- 130 continue
- if (igap .eq. 0) go to 9000
- do 150 i = igap, n-1
- j = i-igap
- 140 continue
-c
- if (j.lt.0) go to 150
-c
- if (abs(ximag(j)).gt.abs(ximag(j+igap))) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 150
- endif
- j = j-igap
- go to 140
- 150 continue
- igap = igap / 2
- go to 130
-c
- else if (which .eq. 'SI') then
-c
-c %------------------------------------------------%
-c | Sort XIMAG into decreasing order of magnitude. |
-c %------------------------------------------------%
-c
- 160 continue
- if (igap .eq. 0) go to 9000
- do 180 i = igap, n-1
- j = i-igap
- 170 continue
-c
- if (j.lt.0) go to 180
-c
- if (abs(ximag(j)).lt.abs(ximag(j+igap))) then
- temp = xreal(j)
- xreal(j) = xreal(j+igap)
- xreal(j+igap) = temp
-c
- temp = ximag(j)
- ximag(j) = ximag(j+igap)
- ximag(j+igap) = temp
-c
- if (apply) then
- temp = y(j)
- y(j) = y(j+igap)
- y(j+igap) = temp
- end if
- else
- go to 180
- endif
- j = j-igap
- go to 170
- 180 continue
- igap = igap / 2
- go to 160
- end if
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of ssortc |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/ssortr.f b/netlib/ARPACK/ssortr.f
deleted file mode 100644
index 267b125..0000000
--- a/netlib/ARPACK/ssortr.f
+++ /dev/null
@@ -1,218 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: ssortr
-c
-c\Description:
-c Sort the array X1 in the order specified by WHICH and optionally
-c applies the permutation to the array X2.
-c
-c\Usage:
-c call ssortr
-c ( WHICH, APPLY, N, X1, X2 )
-c
-c\Arguments
-c WHICH Character*2. (Input)
-c 'LM' -> X1 is sorted into increasing order of magnitude.
-c 'SM' -> X1 is sorted into decreasing order of magnitude.
-c 'LA' -> X1 is sorted into increasing order of algebraic.
-c 'SA' -> X1 is sorted into decreasing order of algebraic.
-c
-c APPLY Logical. (Input)
-c APPLY = .TRUE. -> apply the sorted order to X2.
-c APPLY = .FALSE. -> do not apply the sorted order to X2.
-c
-c N Integer. (INPUT)
-c Size of the arrays.
-c
-c X1 Real array of length N. (INPUT/OUTPUT)
-c The array to be sorted.
-c
-c X2 Real array of length N. (INPUT/OUTPUT)
-c Only referenced if APPLY = .TRUE.
-c
-c\EndDoc
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\Revision history:
-c 12/16/93: Version ' 2.1'.
-c Adapted from the sort routine in LANSO.
-c
-c\SCCS Information: @(#)
-c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine ssortr (which, apply, n, x1, x2)
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- character*2 which
- logical apply
- integer n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & x1(0:n-1), x2(0:n-1)
-c
-c %---------------%
-c | Local Scalars |
-c %---------------%
-c
- integer i, igap, j
- Real
- & temp
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- igap = n / 2
-c
- if (which .eq. 'SA') then
-c
-c X1 is sorted into decreasing order of algebraic.
-c
- 10 continue
- if (igap .eq. 0) go to 9000
- do 30 i = igap, n-1
- j = i-igap
- 20 continue
-c
- if (j.lt.0) go to 30
-c
- if (x1(j).lt.x1(j+igap)) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 30
- endif
- j = j-igap
- go to 20
- 30 continue
- igap = igap / 2
- go to 10
-c
- else if (which .eq. 'SM') then
-c
-c X1 is sorted into decreasing order of magnitude.
-c
- 40 continue
- if (igap .eq. 0) go to 9000
- do 60 i = igap, n-1
- j = i-igap
- 50 continue
-c
- if (j.lt.0) go to 60
-c
- if (abs(x1(j)).lt.abs(x1(j+igap))) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 60
- endif
- j = j-igap
- go to 50
- 60 continue
- igap = igap / 2
- go to 40
-c
- else if (which .eq. 'LA') then
-c
-c X1 is sorted into increasing order of algebraic.
-c
- 70 continue
- if (igap .eq. 0) go to 9000
- do 90 i = igap, n-1
- j = i-igap
- 80 continue
-c
- if (j.lt.0) go to 90
-c
- if (x1(j).gt.x1(j+igap)) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 90
- endif
- j = j-igap
- go to 80
- 90 continue
- igap = igap / 2
- go to 70
-c
- else if (which .eq. 'LM') then
-c
-c X1 is sorted into increasing order of magnitude.
-c
- 100 continue
- if (igap .eq. 0) go to 9000
- do 120 i = igap, n-1
- j = i-igap
- 110 continue
-c
- if (j.lt.0) go to 120
-c
- if (abs(x1(j)).gt.abs(x1(j+igap))) then
- temp = x1(j)
- x1(j) = x1(j+igap)
- x1(j+igap) = temp
- if (apply) then
- temp = x2(j)
- x2(j) = x2(j+igap)
- x2(j+igap) = temp
- end if
- else
- go to 120
- endif
- j = j-igap
- go to 110
- 120 continue
- igap = igap / 2
- go to 100
- end if
-c
- 9000 continue
- return
-c
-c %---------------%
-c | End of ssortr |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sstatn.f b/netlib/ARPACK/sstatn.f
deleted file mode 100644
index cdf2883..0000000
--- a/netlib/ARPACK/sstatn.f
+++ /dev/null
@@ -1,61 +0,0 @@
-c
-c %---------------------------------------------%
-c | Initialize statistic and timing information |
-c | for nonsymmetric Arnoldi code. |
-c %---------------------------------------------%
-c
-c\Author
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2
-c
- subroutine sstatn
-c
-c %--------------------------------%
-c | See stat.doc for documentation |
-c %--------------------------------%
-c
- include 'stat.h'
-c
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-c
- nopx = 0
- nbx = 0
- nrorth = 0
- nitref = 0
- nrstrt = 0
-c
- tnaupd = 0.0E+0
- tnaup2 = 0.0E+0
- tnaitr = 0.0E+0
- tneigh = 0.0E+0
- tngets = 0.0E+0
- tnapps = 0.0E+0
- tnconv = 0.0E+0
- titref = 0.0E+0
- tgetv0 = 0.0E+0
- trvec = 0.0E+0
-c
-c %----------------------------------------------------%
-c | User time including reverse communication overhead |
-c %----------------------------------------------------%
-c
- tmvopx = 0.0E+0
- tmvbx = 0.0E+0
-c
- return
-c
-c
-c %---------------%
-c | End of sstatn |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/sstats.f b/netlib/ARPACK/sstats.f
deleted file mode 100644
index 86109dc..0000000
--- a/netlib/ARPACK/sstats.f
+++ /dev/null
@@ -1,47 +0,0 @@
-c
-c\SCCS Information: @(#)
-c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2
-c %---------------------------------------------%
-c | Initialize statistic and timing information |
-c | for symmetric Arnoldi code. |
-c %---------------------------------------------%
-
- subroutine sstats
-
-c %--------------------------------%
-c | See stat.doc for documentation |
-c %--------------------------------%
- include 'stat.h'
-
-c %-----------------------%
-c | Executable Statements |
-c %-----------------------%
-
- nopx = 0
- nbx = 0
- nrorth = 0
- nitref = 0
- nrstrt = 0
-
- tsaupd = 0.0E+0
- tsaup2 = 0.0E+0
- tsaitr = 0.0E+0
- tseigt = 0.0E+0
- tsgets = 0.0E+0
- tsapps = 0.0E+0
- tsconv = 0.0E+0
- titref = 0.0E+0
- tgetv0 = 0.0E+0
- trvec = 0.0E+0
-
-c %----------------------------------------------------%
-c | User time including reverse communication overhead |
-c %----------------------------------------------------%
- tmvopx = 0.0E+0
- tmvbx = 0.0E+0
-
- return
-c
-c End of sstats
-c
- end
diff --git a/netlib/ARPACK/sstqrb.f b/netlib/ARPACK/sstqrb.f
deleted file mode 100644
index 9fd1e19..0000000
--- a/netlib/ARPACK/sstqrb.f
+++ /dev/null
@@ -1,594 +0,0 @@
-c-----------------------------------------------------------------------
-c\BeginDoc
-c
-c\Name: sstqrb
-c
-c\Description:
-c Computes all eigenvalues and the last component of the eigenvectors
-c of a symmetric tridiagonal matrix using the implicit QL or QR method.
-c
-c This is mostly a modification of the LAPACK routine ssteqr.
-c See Remarks.
-c
-c\Usage:
-c call sstqrb
-c ( N, D, E, Z, WORK, INFO )
-c
-c\Arguments
-c N Integer. (INPUT)
-c The number of rows and columns in the matrix. N >= 0.
-c
-c D Real array, dimension (N). (INPUT/OUTPUT)
-c On entry, D contains the diagonal elements of the
-c tridiagonal matrix.
-c On exit, D contains the eigenvalues, in ascending order.
-c If an error exit is made, the eigenvalues are correct
-c for indices 1,2,...,INFO-1, but they are unordered and
-c may not be the smallest eigenvalues of the matrix.
-c
-c E Real array, dimension (N-1). (INPUT/OUTPUT)
-c On entry, E contains the subdiagonal elements of the
-c tridiagonal matrix in positions 1 through N-1.
-c On exit, E has been destroyed.
-c
-c Z Real array, dimension (N). (OUTPUT)
-c On exit, Z contains the last row of the orthonormal
-c eigenvector matrix of the symmetric tridiagonal matrix.
-c If an error exit is made, Z contains the last row of the
-c eigenvector matrix associated with the stored eigenvalues.
-c
-c WORK Real array, dimension (max(1,2*N-2)). (WORKSPACE)
-c Workspace used in accumulating the transformation for
-c computing the last components of the eigenvectors.
-c
-c INFO Integer. (OUTPUT)
-c = 0: normal return.
-c < 0: if INFO = -i, the i-th argument had an illegal value.
-c > 0: if INFO = +i, the i-th eigenvalue has not converged
-c after a total of 30*N iterations.
-c
-c\Remarks
-c 1. None.
-c
-c-----------------------------------------------------------------------
-c
-c\BeginLib
-c
-c\Local variables:
-c xxxxxx real
-c
-c\Routines called:
-c saxpy Level 1 BLAS that computes a vector triad.
-c scopy Level 1 BLAS that copies one vector to another.
-c sswap Level 1 BLAS that swaps the contents of two vectors.
-c lsame LAPACK character comparison routine.
-c slae2 LAPACK routine that computes the eigenvalues of a 2-by-2
-c symmetric matrix.
-c slaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric
-c matrix.
-c slamch LAPACK routine that determines machine constants.
-c slanst LAPACK routine that computes the norm of a matrix.
-c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c slartg LAPACK Givens rotation construction routine.
-c slascl LAPACK routine for careful scaling of a matrix.
-c slaset LAPACK matrix initialization routine.
-c slasr LAPACK routine that applies an orthogonal transformation to
-c a matrix.
-c slasrt LAPACK sorting routine.
-c ssteqr LAPACK routine that computes eigenvalues and eigenvectors
-c of a symmetric tridiagonal matrix.
-c xerbla LAPACK error handler routine.
-c
-c\Authors
-c Danny Sorensen Phuong Vu
-c Richard Lehoucq CRPC / Rice University
-c Dept. of Computational & Houston, Texas
-c Applied Mathematics
-c Rice University
-c Houston, Texas
-c
-c\SCCS Information: @(#)
-c FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2
-c
-c\Remarks
-c 1. Starting with version 2.5, this routine is a modified version
-c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted,
-c only commeted out and new lines inserted.
-c All lines commented out have "c$$$" at the beginning.
-c Note that the LAPACK version 1.0 subroutine SSTEQR contained
-c bugs.
-c
-c\EndLib
-c
-c-----------------------------------------------------------------------
-c
- subroutine sstqrb ( n, d, e, z, work, info )
-c
-c %------------------%
-c | Scalar Arguments |
-c %------------------%
-c
- integer info, n
-c
-c %-----------------%
-c | Array Arguments |
-c %-----------------%
-c
- Real
- & d( n ), e( n-1 ), z( n ), work( 2*n-2 )
-c
-c .. parameters ..
- Real
- & zero, one, two, three
- parameter ( zero = 0.0E+0, one = 1.0E+0,
- & two = 2.0E+0, three = 3.0E+0 )
- integer maxit
- parameter ( maxit = 30 )
-c ..
-c .. local scalars ..
- integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend,
- & lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1,
- & nm1, nmaxit
- Real
- & anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2,
- & s, safmax, safmin, ssfmax, ssfmin, tst
-c ..
-c .. external functions ..
- logical lsame
- Real
- & slamch, slanst, slapy2
- external lsame, slamch, slanst, slapy2
-c ..
-c .. external subroutines ..
- external slae2, slaev2, slartg, slascl, slaset, slasr,
- & slasrt, sswap, xerbla
-c ..
-c .. intrinsic functions ..
- intrinsic abs, max, sign, sqrt
-c ..
-c .. executable statements ..
-c
-c test the input parameters.
-c
- info = 0
-c
-c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN
-c$$$ ICOMPZ = 0
-c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-c$$$ ICOMPZ = 1
-c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-c$$$ ICOMPZ = 2
-c$$$ ELSE
-c$$$ ICOMPZ = -1
-c$$$ END IF
-c$$$ IF( ICOMPZ.LT.0 ) THEN
-c$$$ INFO = -1
-c$$$ ELSE IF( N.LT.0 ) THEN
-c$$$ INFO = -2
-c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
-c$$$ $ N ) ) ) THEN
-c$$$ INFO = -6
-c$$$ END IF
-c$$$ IF( INFO.NE.0 ) THEN
-c$$$ CALL XERBLA( 'SSTEQR', -INFO )
-c$$$ RETURN
-c$$$ END IF
-c
-c *** New starting with version 2.5 ***
-c
- icompz = 2
-c *************************************
-c
-c quick return if possible
-c
- if( n.eq.0 )
- $ return
-c
- if( n.eq.1 ) then
- if( icompz.eq.2 ) z( 1 ) = one
- return
- end if
-c
-c determine the unit roundoff and over/underflow thresholds.
-c
- eps = slamch( 'e' )
- eps2 = eps**2
- safmin = slamch( 's' )
- safmax = one / safmin
- ssfmax = sqrt( safmax ) / three
- ssfmin = sqrt( safmin ) / eps2
-c
-c compute the eigenvalues and eigenvectors of the tridiagonal
-c matrix.
-c
-c$$ if( icompz.eq.2 )
-c$$$ $ call slaset( 'full', n, n, zero, one, z, ldz )
-c
-c *** New starting with version 2.5 ***
-c
- if ( icompz .eq. 2 ) then
- do 5 j = 1, n-1
- z(j) = zero
- 5 continue
- z( n ) = one
- end if
-c *************************************
-c
- nmaxit = n*maxit
- jtot = 0
-c
-c determine where the matrix splits and choose ql or qr iteration
-c for each block, according to whether top or bottom diagonal
-c element is smaller.
-c
- l1 = 1
- nm1 = n - 1
-c
- 10 continue
- if( l1.gt.n )
- $ go to 160
- if( l1.gt.1 )
- $ e( l1-1 ) = zero
- if( l1.le.nm1 ) then
- do 20 m = l1, nm1
- tst = abs( e( m ) )
- if( tst.eq.zero )
- $ go to 30
- if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+
- $ 1 ) ) ) )*eps ) then
- e( m ) = zero
- go to 30
- end if
- 20 continue
- end if
- m = n
-c
- 30 continue
- l = l1
- lsv = l
- lend = m
- lendsv = lend
- l1 = m + 1
- if( lend.eq.l )
- $ go to 10
-c
-c scale submatrix in rows and columns l to lend
-c
- anorm = slanst( 'i', lend-l+1, d( l ), e( l ) )
- iscale = 0
- if( anorm.eq.zero )
- $ go to 10
- if( anorm.gt.ssfmax ) then
- iscale = 1
- call slascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n,
- $ info )
- call slascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n,
- $ info )
- else if( anorm.lt.ssfmin ) then
- iscale = 2
- call slascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n,
- $ info )
- call slascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n,
- $ info )
- end if
-c
-c choose between ql and qr iteration
-c
- if( abs( d( lend ) ).lt.abs( d( l ) ) ) then
- lend = lsv
- l = lendsv
- end if
-c
- if( lend.gt.l ) then
-c
-c ql iteration
-c
-c look for small subdiagonal element.
-c
- 40 continue
- if( l.ne.lend ) then
- lendm1 = lend - 1
- do 50 m = l, lendm1
- tst = abs( e( m ) )**2
- if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+
- $ safmin )go to 60
- 50 continue
- end if
-c
- m = lend
-c
- 60 continue
- if( m.lt.lend )
- $ e( m ) = zero
- p = d( l )
- if( m.eq.l )
- $ go to 80
-c
-c if remaining matrix is 2-by-2, use slae2 or slaev2
-c to compute its eigensystem.
-c
- if( m.eq.l+1 ) then
- if( icompz.gt.0 ) then
- call slaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s )
- work( l ) = c
- work( n-1+l ) = s
-c$$$ call slasr( 'r', 'v', 'b', n, 2, work( l ),
-c$$$ $ work( n-1+l ), z( 1, l ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- tst = z(l+1)
- z(l+1) = c*tst - s*z(l)
- z(l) = s*tst + c*z(l)
-c *************************************
- else
- call slae2( d( l ), e( l ), d( l+1 ), rt1, rt2 )
- end if
- d( l ) = rt1
- d( l+1 ) = rt2
- e( l ) = zero
- l = l + 2
- if( l.le.lend )
- $ go to 40
- go to 140
- end if
-c
- if( jtot.eq.nmaxit )
- $ go to 140
- jtot = jtot + 1
-c
-c form shift.
-c
- g = ( d( l+1 )-p ) / ( two*e( l ) )
- r = slapy2( g, one )
- g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) )
-c
- s = one
- c = one
- p = zero
-c
-c inner loop
-c
- mm1 = m - 1
- do 70 i = mm1, l, -1
- f = s*e( i )
- b = c*e( i )
- call slartg( g, f, c, s, r )
- if( i.ne.m-1 )
- $ e( i+1 ) = r
- g = d( i+1 ) - p
- r = ( d( i )-g )*s + two*c*b
- p = s*r
- d( i+1 ) = g + p
- g = c*r - b
-c
-c if eigenvectors are desired, then save rotations.
-c
- if( icompz.gt.0 ) then
- work( i ) = c
- work( n-1+i ) = -s
- end if
-c
- 70 continue
-c
-c if eigenvectors are desired, then apply saved rotations.
-c
- if( icompz.gt.0 ) then
- mm = m - l + 1
-c$$$ call slasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ),
-c$$$ $ z( 1, l ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- call slasr( 'r', 'v', 'b', 1, mm, work( l ),
- & work( n-1+l ), z( l ), 1 )
-c *************************************
- end if
-c
- d( l ) = d( l ) - p
- e( l ) = g
- go to 40
-c
-c eigenvalue found.
-c
- 80 continue
- d( l ) = p
-c
- l = l + 1
- if( l.le.lend )
- $ go to 40
- go to 140
-c
- else
-c
-c qr iteration
-c
-c look for small superdiagonal element.
-c
- 90 continue
- if( l.ne.lend ) then
- lendp1 = lend + 1
- do 100 m = l, lendp1, -1
- tst = abs( e( m-1 ) )**2
- if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+
- $ safmin )go to 110
- 100 continue
- end if
-c
- m = lend
-c
- 110 continue
- if( m.gt.lend )
- $ e( m-1 ) = zero
- p = d( l )
- if( m.eq.l )
- $ go to 130
-c
-c if remaining matrix is 2-by-2, use slae2 or slaev2
-c to compute its eigensystem.
-c
- if( m.eq.l-1 ) then
- if( icompz.gt.0 ) then
- call slaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s )
-c$$$ work( m ) = c
-c$$$ work( n-1+m ) = s
-c$$$ call slasr( 'r', 'v', 'f', n, 2, work( m ),
-c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- tst = z(l)
- z(l) = c*tst - s*z(l-1)
- z(l-1) = s*tst + c*z(l-1)
-c *************************************
- else
- call slae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 )
- end if
- d( l-1 ) = rt1
- d( l ) = rt2
- e( l-1 ) = zero
- l = l - 2
- if( l.ge.lend )
- $ go to 90
- go to 140
- end if
-c
- if( jtot.eq.nmaxit )
- $ go to 140
- jtot = jtot + 1
-c
-c form shift.
-c
- g = ( d( l-1 )-p ) / ( two*e( l-1 ) )
- r = slapy2( g, one )
- g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) )
-c
- s = one
- c = one
- p = zero
-c
-c inner loop
-c
- lm1 = l - 1
- do 120 i = m, lm1
- f = s*e( i )
- b = c*e( i )
- call slartg( g, f, c, s, r )
- if( i.ne.m )
- $ e( i-1 ) = r
- g = d( i ) - p
- r = ( d( i+1 )-g )*s + two*c*b
- p = s*r
- d( i ) = g + p
- g = c*r - b
-c
-c if eigenvectors are desired, then save rotations.
-c
- if( icompz.gt.0 ) then
- work( i ) = c
- work( n-1+i ) = s
- end if
-c
- 120 continue
-c
-c if eigenvectors are desired, then apply saved rotations.
-c
- if( icompz.gt.0 ) then
- mm = l - m + 1
-c$$$ call slasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ),
-c$$$ $ z( 1, m ), ldz )
-c
-c *** New starting with version 2.5 ***
-c
- call slasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ),
- & z( m ), 1 )
-c *************************************
- end if
-c
- d( l ) = d( l ) - p
- e( lm1 ) = g
- go to 90
-c
-c eigenvalue found.
-c
- 130 continue
- d( l ) = p
-c
- l = l - 1
- if( l.ge.lend )
- $ go to 90
- go to 140
-c
- end if
-c
-c undo scaling if necessary
-c
- 140 continue
- if( iscale.eq.1 ) then
- call slascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1,
- $ d( lsv ), n, info )
- call slascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ),
- $ n, info )
- else if( iscale.eq.2 ) then
- call slascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1,
- $ d( lsv ), n, info )
- call slascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ),
- $ n, info )
- end if
-c
-c check for no convergence to an eigenvalue after a total
-c of n*maxit iterations.
-c
- if( jtot.lt.nmaxit )
- $ go to 10
- do 150 i = 1, n - 1
- if( e( i ).ne.zero )
- $ info = info + 1
- 150 continue
- go to 190
-c
-c order eigenvalues and eigenvectors.
-c
- 160 continue
- if( icompz.eq.0 ) then
-c
-c use quick sort
-c
- call slasrt( 'i', n, d, info )
-c
- else
-c
-c use selection sort to minimize swaps of eigenvectors
-c
- do 180 ii = 2, n
- i = ii - 1
- k = i
- p = d( i )
- do 170 j = ii, n
- if( d( j ).lt.p ) then
- k = j
- p = d( j )
- end if
- 170 continue
- if( k.ne.i ) then
- d( k ) = d( i )
- d( i ) = p
-c$$$ call sswap( n, z( 1, i ), 1, z( 1, k ), 1 )
-c *** New starting with version 2.5 ***
-c
- p = z(k)
- z(k) = z(i)
- z(i) = p
-c *************************************
- end if
- 180 continue
- end if
-c
- 190 continue
- return
-c
-c %---------------%
-c | End of sstqrb |
-c %---------------%
-c
- end
diff --git a/netlib/ARPACK/stat.h b/netlib/ARPACK/stat.h
deleted file mode 100644
index 66a8e9f..0000000
--- a/netlib/ARPACK/stat.h
+++ /dev/null
@@ -1,21 +0,0 @@
-c %--------------------------------%
-c | See stat.doc for documentation |
-c %--------------------------------%
-c
-c\SCCS Information: @(#)
-c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2
-c
- real t0, t1, t2, t3, t4, t5
- save t0, t1, t2, t3, t4, t5
-c
- integer nopx, nbx, nrorth, nitref, nrstrt
- real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
- & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
- & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
- & tmvopx, tmvbx, tgetv0, titref, trvec
- common /timing/
- & nopx, nbx, nrorth, nitref, nrstrt,
- & tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
- & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
- & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
- & tmvopx, tmvbx, tgetv0, titref, trvec
diff --git a/netlib/ARPACK/svout.f b/netlib/ARPACK/svout.f
deleted file mode 100644
index 4363b92..0000000
--- a/netlib/ARPACK/svout.f
+++ /dev/null
@@ -1,112 +0,0 @@
-*-----------------------------------------------------------------------
-* Routine: SVOUT
-*
-* Purpose: Real vector output routine.
-*
-* Usage: CALL SVOUT (LOUT, N, SX, IDIGIT, IFMT)
-*
-* Arguments
-* N - Length of array SX. (Input)
-* SX - Real array to be printed. (Input)
-* IFMT - Format to be used in printing array SX. (Input)
-* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
-* If IDIGIT .LT. 0, printing is done with 72 columns.
-* If IDIGIT .GT. 0, printing is done with 132 columns.
-*
-*-----------------------------------------------------------------------
-*
- SUBROUTINE SVOUT( LOUT, N, SX, IDIGIT, IFMT )
-* ...
-* ... SPECIFICATIONS FOR ARGUMENTS
- INTEGER N, IDIGIT, LOUT
- REAL SX( * )
- CHARACTER IFMT*( * )
-* ...
-* ... SPECIFICATIONS FOR LOCAL VARIABLES
- INTEGER I, NDIGIT, K1, K2, LLL
- CHARACTER*80 LINE
-* ...
-* ... FIRST EXECUTABLE STATEMENT
-*
-*
- LLL = MIN( LEN( IFMT ), 80 )
- DO 10 I = 1, LLL
- LINE( I: I ) = '-'
- 10 CONTINUE
-*
- DO 20 I = LLL + 1, 80
- LINE( I: I ) = ' '
- 20 CONTINUE
-*
- WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
- 9999 FORMAT( / 1X, A / 1X, A )
-*
- IF( N.LE.0 )
- $ RETURN
- NDIGIT = IDIGIT
- IF( IDIGIT.EQ.0 )
- $ NDIGIT = 4
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
-*=======================================================================
-*
- IF( IDIGIT.LT.0 ) THEN
- NDIGIT = -IDIGIT
- IF( NDIGIT.LE.4 ) THEN
- DO 30 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
- 30 CONTINUE
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 40 K1 = 1, N, 4
- K2 = MIN0( N, K1+3 )
- WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
- 40 CONTINUE
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 50 K1 = 1, N, 3
- K2 = MIN0( N, K1+2 )
- WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
- 50 CONTINUE
- ELSE
- DO 60 K1 = 1, N, 2
- K2 = MIN0( N, K1+1 )
- WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
- 60 CONTINUE
- END IF
-*
-*=======================================================================
-* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
-*=======================================================================
-*
- ELSE
- IF( NDIGIT.LE.4 ) THEN
- DO 70 K1 = 1, N, 10
- K2 = MIN0( N, K1+9 )
- WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
- 70 CONTINUE
- ELSE IF( NDIGIT.LE.6 ) THEN
- DO 80 K1 = 1, N, 8
- K2 = MIN0( N, K1+7 )
- WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
- 80 CONTINUE
- ELSE IF( NDIGIT.LE.10 ) THEN
- DO 90 K1 = 1, N, 6
- K2 = MIN0( N, K1+5 )
- WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
- 90 CONTINUE
- ELSE
- DO 100 K1 = 1, N, 5
- K2 = MIN0( N, K1+4 )
- WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
- 100 CONTINUE
- END IF
- END IF
- WRITE( LOUT, 9994 )
- RETURN
- 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P10E12.3 )
- 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P8E14.5 )
- 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P6E18.9 )
- 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P5E24.13 )
- 9994 FORMAT( 1X, ' ' )
- END
diff --git a/netlib/ARPACK/version.h b/netlib/ARPACK/version.h
deleted file mode 100644
index ecdd9b3..0000000
--- a/netlib/ARPACK/version.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/*
-
- In the current version, the parameter KAPPA in the Kahan's test
- for orthogonality is set to 0.717, the same as used by Gragg & Reichel.
- However computational experience indicates that this is a little too
- strict and will frequently force reorthogonalization when it is not
- necessary to do so.
-
- Also the "moving boundary" idea is not currently activated in the nonsymmetric
- code since it is not conclusive that it's the right thing to do all the time.
- Requires further investigation.
-
- As of 02/01/93 Richard Lehoucq assumes software control of the codes from
- Phuong Vu. On 03/01/93 all the *.F files were migrated SCCS. The 1.1 version
- of codes are those received from Phuong Vu. The frozen version of 07/08/92
- is now considered version 1.1.
-
- Version 2.1 contains two new symmetric routines, sesrt and seupd.
- Changes as well as bug fixes for version 1.1 codes that were only corrected
- for programming bugs are version 1.2. These 1.2 versions will also be in version 2.1.
- Subroutine [d,s]saupd now requires slightly more workspace. See [d,s]saupd for the
- details.
-
- \SCCS Information: @(#)
- FILE: version.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
-
- */
-
-#define VERSION_NUMBER ' 2.1'
-#define VERSION_DATE ' 11/15/95'
diff --git a/netlib/BLAS/dasum.f b/netlib/BLAS/dasum.f
deleted file mode 100644
index e673554..0000000
--- a/netlib/BLAS/dasum.f
+++ /dev/null
@@ -1,66 +0,0 @@
- DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DASUM takes the sum of the absolute values.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS,MOD
-* ..
- DASUM = 0.0d0
- DTEMP = 0.0d0
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,6)
- IF (M.NE.0) THEN
- DO I = 1,M
- DTEMP = DTEMP + DABS(DX(I))
- END DO
- IF (N.LT.6) THEN
- DASUM = DTEMP
- RETURN
- END IF
- END IF
- MP1 = M + 1
- DO I = MP1,N,6
- DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) +
- $ DABS(DX(I+2)) + DABS(DX(I+3)) +
- $ DABS(DX(I+4)) + DABS(DX(I+5))
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- DTEMP = DTEMP + DABS(DX(I))
- END DO
- END IF
- DASUM = DTEMP
- RETURN
- END
diff --git a/netlib/BLAS/daxpy.f b/netlib/BLAS/daxpy.f
deleted file mode 100644
index ddc7449..0000000
--- a/netlib/BLAS/daxpy.f
+++ /dev/null
@@ -1,69 +0,0 @@
- SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
-* .. Scalar Arguments ..
- DOUBLE PRECISION DA
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DAXPY constant times a vector plus a vector.
-* uses unrolled loops for increments equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (DA.EQ.0.0d0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,4)
- IF (M.NE.0) THEN
- DO I = 1,M
- DY(I) = DY(I) + DA*DX(I)
- END DO
- END IF
- IF (N.LT.4) RETURN
- MP1 = M + 1
- DO I = MP1,N,4
- DY(I) = DY(I) + DA*DX(I)
- DY(I+1) = DY(I+1) + DA*DX(I+1)
- DY(I+2) = DY(I+2) + DA*DX(I+2)
- DY(I+3) = DY(I+3) + DA*DX(I+3)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DY(IY) = DY(IY) + DA*DX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/dcabs1.f b/netlib/BLAS/dcabs1.f
deleted file mode 100644
index 4d5fb69..0000000
--- a/netlib/BLAS/dcabs1.f
+++ /dev/null
@@ -1,18 +0,0 @@
- DOUBLE PRECISION FUNCTION DCABS1(Z)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX Z
-* ..
-* ..
-* Purpose
-* =======
-*
-* DCABS1 computes absolute value of a double complex number
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC ABS,DBLE,DIMAG
-*
- DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
- RETURN
- END
diff --git a/netlib/BLAS/dcopy.f b/netlib/BLAS/dcopy.f
deleted file mode 100644
index a441450..0000000
--- a/netlib/BLAS/dcopy.f
+++ /dev/null
@@ -1,70 +0,0 @@
- SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DCOPY copies a vector, x, to a vector, y.
-* uses unrolled loops for increments equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,7)
- IF (M.NE.0) THEN
- DO I = 1,M
- DY(I) = DX(I)
- END DO
- IF (N.LT.7) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,7
- DY(I) = DX(I)
- DY(I+1) = DX(I+1)
- DY(I+2) = DX(I+2)
- DY(I+3) = DX(I+3)
- DY(I+4) = DX(I+4)
- DY(I+5) = DX(I+5)
- DY(I+6) = DX(I+6)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DY(IY) = DX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/ddot.f b/netlib/BLAS/ddot.f
deleted file mode 100644
index 33719ee..0000000
--- a/netlib/BLAS/ddot.f
+++ /dev/null
@@ -1,72 +0,0 @@
- DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DDOT forms the dot product of two vectors.
-* uses unrolled loops for increments equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- DDOT = 0.0d0
- DTEMP = 0.0d0
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- DTEMP = DTEMP + DX(I)*DY(I)
- END DO
- IF (N.LT.5) THEN
- DDOT=DTEMP
- RETURN
- END IF
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) +
- $ DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DTEMP = DTEMP + DX(IX)*DY(IY)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- DDOT = DTEMP
- RETURN
- END
diff --git a/netlib/BLAS/dgbmv.f b/netlib/BLAS/dgbmv.f
deleted file mode 100644
index 1fd5a58..0000000
--- a/netlib/BLAS/dgbmv.f
+++ /dev/null
@@ -1,302 +0,0 @@
- SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,KL,KU,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DGBMV performs one of the matrix-vector operations
-*
-* y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are vectors and A is an
-* m by n band matrix, with kl sub-diagonals and ku super-diagonals.
-*
-* Arguments
-* ==========
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*
-* TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
-*
-* TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* KL - INTEGER.
-* On entry, KL specifies the number of sub-diagonals of the
-* matrix A. KL must satisfy 0 .le. KL.
-* Unchanged on exit.
-*
-* KU - INTEGER.
-* On entry, KU specifies the number of super-diagonals of the
-* matrix A. KU must satisfy 0 .le. KU.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry, the leading ( kl + ku + 1 ) by n part of the
-* array A must contain the matrix of coefficients, supplied
-* column by column, with the leading diagonal of the matrix in
-* row ( ku + 1 ) of the array, the first super-diagonal
-* starting at position 2 in row ku, the first sub-diagonal
-* starting at position 1 in row ( ku + 2 ), and so on.
-* Elements in the array A that do not correspond to elements
-* in the band matrix (such as the top left ku by ku triangle)
-* are not referenced.
-* The following program segment will transfer a band matrix
-* from conventional full matrix storage to band storage:
-*
-* DO 20, J = 1, N
-* K = KU + 1 - J
-* DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
-* A( K + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( kl + ku + 1 ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of DIMENSION at least
-* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-* Before entry, the incremented array Y must contain the
-* vector y. On exit, Y is overwritten by the updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (KL.LT.0) THEN
- INFO = 4
- ELSE IF (KU.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (KL+KU+1)) THEN
- INFO = 8
- ELSE IF (INCX.EQ.0) THEN
- INFO = 10
- ELSE IF (INCY.EQ.0) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the band part of A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- KUP1 = KU + 1
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- K = KUP1 - J
- DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
- Y(I) = Y(I) + TEMP*A(K+I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- K = KUP1 - J
- DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
- Y(IY) = Y(IY) + TEMP*A(K+I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- IF (J.GT.KU) KY = KY + INCY
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A**T*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = ZERO
- K = KUP1 - J
- DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
- TEMP = TEMP + A(K+I,J)*X(I)
- 90 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 100 CONTINUE
- ELSE
- DO 120 J = 1,N
- TEMP = ZERO
- IX = KX
- K = KUP1 - J
- DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
- TEMP = TEMP + A(K+I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- IF (J.GT.KU) KX = KX + INCX
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGBMV .
-*
- END
diff --git a/netlib/BLAS/dgemm.f b/netlib/BLAS/dgemm.f
deleted file mode 100644
index 7ac8c46..0000000
--- a/netlib/BLAS/dgemm.f
+++ /dev/null
@@ -1,316 +0,0 @@
- SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,M,N
- CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* DGEMM performs one of the matrix-matrix operations
-*
-* C := alpha*op( A )*op( B ) + beta*C,
-*
-* where op( X ) is one of
-*
-* op( X ) = X or op( X ) = X**T,
-*
-* alpha and beta are scalars, and A, B and C are matrices, with op( A )
-* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
-*
-* Arguments
-* ==========
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n', op( A ) = A.
-*
-* TRANSA = 'T' or 't', op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c', op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* TRANSB - CHARACTER*1.
-* On entry, TRANSB specifies the form of op( B ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSB = 'N' or 'n', op( B ) = B.
-*
-* TRANSB = 'T' or 't', op( B ) = B**T.
-*
-* TRANSB = 'C' or 'c', op( B ) = B**T.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix
-* op( A ) and of the matrix C. M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix
-* op( B ) and the number of columns of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry, K specifies the number of columns of the matrix
-* op( A ) and the number of rows of the matrix op( B ). K must
-* be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANSA = 'N' or 'n', and is m otherwise.
-* Before entry with TRANSA = 'N' or 'n', the leading m by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by m part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANSA = 'N' or 'n' then
-* LDA must be at least max( 1, m ), otherwise LDA must be at
-* least max( 1, k ).
-* Unchanged on exit.
-*
-* B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
-* n when TRANSB = 'N' or 'n', and is k otherwise.
-* Before entry with TRANSB = 'N' or 'n', the leading k by n
-* part of the array B must contain the matrix B, otherwise
-* the leading n by k part of the array B must contain the
-* matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. When TRANSB = 'N' or 'n' then
-* LDB must be at least max( 1, k ), otherwise LDB must be at
-* least max( 1, n ).
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then C need not be set on input.
-* Unchanged on exit.
-*
-* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-* Before entry, the leading m 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 array C is overwritten by the m by n matrix
-* ( alpha*op( A )*op( B ) + beta*C ).
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
- LOGICAL NOTA,NOTB
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Set NOTA and NOTB as true if A and B respectively are not
-* transposed and set NROWA, NCOLA and NROWB as the number of rows
-* and columns of A and the number of rows of B respectively.
-*
- NOTA = LSAME(TRANSA,'N')
- NOTB = LSAME(TRANSB,'N')
- IF (NOTA) THEN
- NROWA = M
- NCOLA = K
- ELSE
- NROWA = K
- NCOLA = M
- END IF
- IF (NOTB) THEN
- NROWB = K
- ELSE
- NROWB = N
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
- + (.NOT.LSAME(TRANSA,'T'))) THEN
- INFO = 1
- ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
- + (.NOT.LSAME(TRANSB,'T'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 8
- ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
- INFO = 10
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGEMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And if alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (NOTB) THEN
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- DO 90 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 50 I = 1,M
- C(I,J) = ZERO
- 50 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 60 I = 1,M
- C(I,J) = BETA*C(I,J)
- 60 CONTINUE
- END IF
- DO 80 L = 1,K
- IF (B(L,J).NE.ZERO) THEN
- TEMP = ALPHA*B(L,J)
- DO 70 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 70 CONTINUE
- END IF
- 80 CONTINUE
- 90 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B + beta*C
-*
- DO 120 J = 1,N
- DO 110 I = 1,M
- TEMP = ZERO
- DO 100 L = 1,K
- TEMP = TEMP + A(L,I)*B(L,J)
- 100 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- ELSE
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B**T + beta*C
-*
- DO 170 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 130 I = 1,M
- C(I,J) = ZERO
- 130 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 140 I = 1,M
- C(I,J) = BETA*C(I,J)
- 140 CONTINUE
- END IF
- DO 160 L = 1,K
- IF (B(J,L).NE.ZERO) THEN
- TEMP = ALPHA*B(J,L)
- DO 150 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 150 CONTINUE
- END IF
- 160 CONTINUE
- 170 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B**T + beta*C
-*
- DO 200 J = 1,N
- DO 190 I = 1,M
- TEMP = ZERO
- DO 180 L = 1,K
- TEMP = TEMP + A(L,I)*B(J,L)
- 180 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 190 CONTINUE
- 200 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGEMM .
-*
- END
diff --git a/netlib/BLAS/dgemv.f b/netlib/BLAS/dgemv.f
deleted file mode 100644
index a412594..0000000
--- a/netlib/BLAS/dgemv.f
+++ /dev/null
@@ -1,265 +0,0 @@
- SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DGEMV performs one of the matrix-vector operations
-*
-* y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are vectors and A is an
-* m by n matrix.
-*
-* Arguments
-* ==========
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*
-* TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
-*
-* TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry, the leading m by n part of the array A must
-* contain the matrix of coefficients.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of DIMENSION at least
-* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-* Before entry with BETA non-zero, the incremented array Y
-* must contain the vector y. On exit, Y is overwritten by the
-* updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- ELSE IF (INCY.EQ.0) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGEMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- DO 50 I = 1,M
- Y(I) = Y(I) + TEMP*A(I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- DO 70 I = 1,M
- Y(IY) = Y(IY) + TEMP*A(I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A**T*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = ZERO
- DO 90 I = 1,M
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 100 CONTINUE
- ELSE
- DO 120 J = 1,N
- TEMP = ZERO
- IX = KX
- DO 110 I = 1,M
- TEMP = TEMP + A(I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGEMV .
-*
- END
diff --git a/netlib/BLAS/dger.f b/netlib/BLAS/dger.f
deleted file mode 100644
index 1d95257..0000000
--- a/netlib/BLAS/dger.f
+++ /dev/null
@@ -1,162 +0,0 @@
- SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DGER performs the rank 1 operation
-*
-* A := alpha*x*y**T + A,
-*
-* where alpha is a scalar, x is an m element vector, y is an n element
-* vector and A is an m by n matrix.
-*
-* Arguments
-* ==========
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( m - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the m
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry, the leading m by n part of the array A must
-* contain the matrix of coefficients. On exit, A is
-* overwritten by the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JY,KX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (M.LT.0) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGER ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (INCY.GT.0) THEN
- JY = 1
- ELSE
- JY = 1 - (N-1)*INCY
- END IF
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- DO 10 I = 1,M
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- JY = JY + INCY
- 20 CONTINUE
- ELSE
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (M-1)*INCX
- END IF
- DO 40 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- IX = KX
- DO 30 I = 1,M
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JY = JY + INCY
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DGER .
-*
- END
diff --git a/netlib/BLAS/dnrm2.f b/netlib/BLAS/dnrm2.f
deleted file mode 100644
index 480c912..0000000
--- a/netlib/BLAS/dnrm2.f
+++ /dev/null
@@ -1,67 +0,0 @@
- DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DNRM2 returns the euclidean norm of a vector via the function
-* name, so that
-*
-* DNRM2 := sqrt( x'*x )
-*
-* Further Details
-* ===============
-*
-* -- This version written on 25-October-1982.
-* Modified on 14-October-1993 to inline the call to DLASSQ.
-* Sven Hammarling, Nag Ltd.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
- INTEGER IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,SQRT
-* ..
- IF (N.LT.1 .OR. INCX.LT.1) THEN
- NORM = ZERO
- ELSE IF (N.EQ.1) THEN
- NORM = ABS(X(1))
- ELSE
- SCALE = ZERO
- SSQ = ONE
-* The following loop is equivalent to this call to the LAPACK
-* auxiliary routine:
-* CALL DLASSQ( N, X, INCX, SCALE, SSQ )
-*
- DO 10 IX = 1,1 + (N-1)*INCX,INCX
- IF (X(IX).NE.ZERO) THEN
- ABSXI = ABS(X(IX))
- IF (SCALE.LT.ABSXI) THEN
- SSQ = ONE + SSQ* (SCALE/ABSXI)**2
- SCALE = ABSXI
- ELSE
- SSQ = SSQ + (ABSXI/SCALE)**2
- END IF
- END IF
- 10 CONTINUE
- NORM = SCALE*SQRT(SSQ)
- END IF
-*
- DNRM2 = NORM
- RETURN
-*
-* End of DNRM2.
-*
- END
diff --git a/netlib/BLAS/drot.f b/netlib/BLAS/drot.f
deleted file mode 100644
index a02bda3..0000000
--- a/netlib/BLAS/drot.f
+++ /dev/null
@@ -1,55 +0,0 @@
- SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
-* .. Scalar Arguments ..
- DOUBLE PRECISION C,S
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DROT applies a plane rotation.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,IX,IY
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
- DO I = 1,N
- DTEMP = C*DX(I) + S*DY(I)
- DY(I) = C*DY(I) - S*DX(I)
- DX(I) = DTEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DTEMP = C*DX(IX) + S*DY(IY)
- DY(IY) = C*DY(IY) - S*DX(IX)
- DX(IX) = DTEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/drotg.f b/netlib/BLAS/drotg.f
deleted file mode 100644
index 3819f47..0000000
--- a/netlib/BLAS/drotg.f
+++ /dev/null
@@ -1,44 +0,0 @@
- SUBROUTINE DROTG(DA,DB,C,S)
-* .. Scalar Arguments ..
- DOUBLE PRECISION C,DA,DB,S
-* ..
-*
-* Purpose
-* =======
-*
-* DROTG construct givens plane rotation.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION R,ROE,SCALE,Z
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS,DSIGN,DSQRT
-* ..
- ROE = DB
- IF (DABS(DA).GT.DABS(DB)) ROE = DA
- SCALE = DABS(DA) + DABS(DB)
- IF (SCALE.EQ.0.0d0) THEN
- C = 1.0d0
- S = 0.0d0
- R = 0.0d0
- Z = 0.0d0
- ELSE
- R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
- R = DSIGN(1.0d0,ROE)*R
- C = DA/R
- S = DB/R
- Z = 1.0d0
- IF (DABS(DA).GT.DABS(DB)) Z = S
- IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
- END IF
- DA = R
- DB = Z
- RETURN
- END
diff --git a/netlib/BLAS/drotm.f b/netlib/BLAS/drotm.f
deleted file mode 100644
index a245116..0000000
--- a/netlib/BLAS/drotm.f
+++ /dev/null
@@ -1,142 +0,0 @@
- SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
-*
-* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
-* (DY**T)
-*
-* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
-* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
-* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
-*
-* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
-*
-* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
-* H=( ) ( ) ( ) ( )
-* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
-* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
-*
-* Arguments
-* =========
-*
-* N (input) INTEGER
-* number of elements in input vector(s)
-*
-* DX (input/output) DOUBLE PRECISION array, dimension N
-* double precision vector with N elements
-*
-* INCX (input) INTEGER
-* storage spacing between elements of DX
-*
-* DY (input/output) DOUBLE PRECISION array, dimension N
-* double precision vector with N elements
-*
-* INCY (input) INTEGER
-* storage spacing between elements of DY
-*
-* DPARAM (input/output) DOUBLE PRECISION array, dimension 5
-* DPARAM(1)=DFLAG
-* DPARAM(2)=DH11
-* DPARAM(3)=DH21
-* DPARAM(4)=DH12
-* DPARAM(5)=DH22
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
- INTEGER I,KX,KY,NSTEPS
-* ..
-* .. Data statements ..
- DATA ZERO,TWO/0.D0,2.D0/
-* ..
-*
- DFLAG = DPARAM(1)
- IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
- IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
-*
- NSTEPS = N*INCX
- IF (DFLAG.LT.ZERO) THEN
- DH11 = DPARAM(2)
- DH12 = DPARAM(4)
- DH21 = DPARAM(3)
- DH22 = DPARAM(5)
- DO I = 1,NSTEPS,INCX
- W = DX(I)
- Z = DY(I)
- DX(I) = W*DH11 + Z*DH12
- DY(I) = W*DH21 + Z*DH22
- END DO
- ELSE IF (DFLAG.EQ.ZERO) THEN
- DH12 = DPARAM(4)
- DH21 = DPARAM(3)
- DO I = 1,NSTEPS,INCX
- W = DX(I)
- Z = DY(I)
- DX(I) = W + Z*DH12
- DY(I) = W*DH21 + Z
- END DO
- ELSE
- DH11 = DPARAM(2)
- DH22 = DPARAM(5)
- DO I = 1,NSTEPS,INCX
- W = DX(I)
- Z = DY(I)
- DX(I) = W*DH11 + Z
- DY(I) = -W + DH22*Z
- END DO
- END IF
- ELSE
- KX = 1
- KY = 1
- IF (INCX.LT.0) KX = 1 + (1-N)*INCX
- IF (INCY.LT.0) KY = 1 + (1-N)*INCY
-*
- IF (DFLAG.LT.ZERO) THEN
- DH11 = DPARAM(2)
- DH12 = DPARAM(4)
- DH21 = DPARAM(3)
- DH22 = DPARAM(5)
- DO I = 1,N
- W = DX(KX)
- Z = DY(KY)
- DX(KX) = W*DH11 + Z*DH12
- DY(KY) = W*DH21 + Z*DH22
- KX = KX + INCX
- KY = KY + INCY
- END DO
- ELSE IF (DFLAG.EQ.ZERO) THEN
- DH12 = DPARAM(4)
- DH21 = DPARAM(3)
- DO I = 1,N
- W = DX(KX)
- Z = DY(KY)
- DX(KX) = W + Z*DH12
- DY(KY) = W*DH21 + Z
- KX = KX + INCX
- KY = KY + INCY
- END DO
- ELSE
- DH11 = DPARAM(2)
- DH22 = DPARAM(5)
- DO I = 1,N
- W = DX(KX)
- Z = DY(KY)
- DX(KX) = W*DH11 + Z
- DY(KY) = -W + DH22*Z
- KX = KX + INCX
- KY = KY + INCY
- END DO
- END IF
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/drotmg.f b/netlib/BLAS/drotmg.f
deleted file mode 100644
index ca5de11..0000000
--- a/netlib/BLAS/drotmg.f
+++ /dev/null
@@ -1,196 +0,0 @@
- SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
-* .. Scalar Arguments ..
- DOUBLE PRECISION DD1,DD2,DX1,DY1
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DPARAM(5)
-* ..
-*
-* Purpose
-* =======
-*
-* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
-* THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*
-* DY2)**T.
-* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
-*
-* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
-*
-* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
-* H=( ) ( ) ( ) ( )
-* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
-* LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
-* RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
-* VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
-*
-* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
-* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
-* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
-*
-*
-* Arguments
-* =========
-*
-* DD1 (input/output) DOUBLE PRECISION
-*
-* DD2 (input/output) DOUBLE PRECISION
-*
-* DX1 (input/output) DOUBLE PRECISION
-*
-* DY1 (input) DOUBLE PRECISION
-*
-* DPARAM (input/output) DOUBLE PRECISION array, dimension 5
-* DPARAM(1)=DFLAG
-* DPARAM(2)=DH11
-* DPARAM(3)=DH21
-* DPARAM(4)=DH12
-* DPARAM(5)=DH22
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
- $ DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS
-* ..
-* .. Data statements ..
-*
- DATA ZERO,ONE,TWO/0.D0,1.D0,2.D0/
- DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
-* ..
-
- IF (DD1.LT.ZERO) THEN
-* GO ZERO-H-D-AND-DX1..
- DFLAG = -ONE
- DH11 = ZERO
- DH12 = ZERO
- DH21 = ZERO
- DH22 = ZERO
-*
- DD1 = ZERO
- DD2 = ZERO
- DX1 = ZERO
- ELSE
-* CASE-DD1-NONNEGATIVE
- DP2 = DD2*DY1
- IF (DP2.EQ.ZERO) THEN
- DFLAG = -TWO
- DPARAM(1) = DFLAG
- RETURN
- END IF
-* REGULAR-CASE..
- DP1 = DD1*DX1
- DQ2 = DP2*DY1
- DQ1 = DP1*DX1
-*
- IF (DABS(DQ1).GT.DABS(DQ2)) THEN
- DH21 = -DY1/DX1
- DH12 = DP2/DP1
-*
- DU = ONE - DH12*DH21
-*
- IF (DU.GT.ZERO) THEN
- DFLAG = ZERO
- DD1 = DD1/DU
- DD2 = DD2/DU
- DX1 = DX1*DU
- END IF
- ELSE
-
- IF (DQ2.LT.ZERO) THEN
-* GO ZERO-H-D-AND-DX1..
- DFLAG = -ONE
- DH11 = ZERO
- DH12 = ZERO
- DH21 = ZERO
- DH22 = ZERO
-*
- DD1 = ZERO
- DD2 = ZERO
- DX1 = ZERO
- ELSE
- DFLAG = ONE
- DH11 = DP1/DP2
- DH22 = DX1/DY1
- DU = ONE + DH11*DH22
- DTEMP = DD2/DU
- DD2 = DD1/DU
- DD1 = DTEMP
- DX1 = DY1*DU
- END IF
- END IF
-
-* PROCEDURE..SCALE-CHECK
- IF (DD1.NE.ZERO) THEN
- DO WHILE ((DD1.LE.RGAMSQ) .OR. (DD1.GE.GAMSQ))
- IF (DFLAG.EQ.ZERO) THEN
- DH11 = ONE
- DH22 = ONE
- DFLAG = -ONE
- ELSE
- DH21 = -ONE
- DH12 = ONE
- DFLAG = -ONE
- END IF
- IF (DD1.LE.RGAMSQ) THEN
- DD1 = DD1*GAM**2
- DX1 = DX1/GAM
- DH11 = DH11/GAM
- DH12 = DH12/GAM
- ELSE
- DD1 = DD1/GAM**2
- DX1 = DX1*GAM
- DH11 = DH11*GAM
- DH12 = DH12*GAM
- END IF
- ENDDO
- END IF
-
- IF (DD2.NE.ZERO) THEN
- DO WHILE ( (DABS(DD2).LE.RGAMSQ) .OR. (DABS(DD2).GE.GAMSQ) )
- IF (DFLAG.EQ.ZERO) THEN
- DH11 = ONE
- DH22 = ONE
- DFLAG = -ONE
- ELSE
- DH21 = -ONE
- DH12 = ONE
- DFLAG = -ONE
- END IF
- IF (DABS(DD2).LE.RGAMSQ) THEN
- DD2 = DD2*GAM**2
- DH21 = DH21/GAM
- DH22 = DH22/GAM
- ELSE
- DD2 = DD2/GAM**2
- DH21 = DH21*GAM
- DH22 = DH22*GAM
- END IF
- END DO
- END IF
-
- END IF
-
- IF (DFLAG.LT.ZERO) THEN
- DPARAM(2) = DH11
- DPARAM(3) = DH21
- DPARAM(4) = DH12
- DPARAM(5) = DH22
- ELSE IF (DFLAG.EQ.ZERO) THEN
- DPARAM(3) = DH21
- DPARAM(4) = DH12
- ELSE
- DPARAM(2) = DH11
- DPARAM(5) = DH22
- END IF
-
- 260 CONTINUE
- DPARAM(1) = DFLAG
- RETURN
- END
-
-
-
-
diff --git a/netlib/BLAS/dsbmv.f b/netlib/BLAS/dsbmv.f
deleted file mode 100644
index e797351..0000000
--- a/netlib/BLAS/dsbmv.f
+++ /dev/null
@@ -1,307 +0,0 @@
- SUBROUTINE DSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,K,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSBMV performs the matrix-vector operation
-*
-* y := alpha*A*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are n element vectors and
-* A is an n by n symmetric band matrix, with k super-diagonals.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the band matrix A is being supplied as
-* follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* being supplied.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* being supplied.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry, K specifies the number of super-diagonals of the
-* matrix A. K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the symmetric matrix, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer the upper
-* triangular part of a symmetric band matrix from conventional
-* full matrix storage to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the symmetric matrix, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer the lower
-* triangular part of a symmetric band matrix from conventional
-* full matrix storage to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the
-* vector y. On exit, Y is overwritten by the updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (K.LT.0) THEN
- INFO = 3
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- ELSE IF (INCY.EQ.0) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of the array A
-* are accessed sequentially with one pass through A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when upper triangle of A is stored.
-*
- KPLUS1 = K + 1
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- L = KPLUS1 - J
- DO 50 I = MAX(1,J-K),J - 1
- Y(I) = Y(I) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(I)
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- L = KPLUS1 - J
- DO 70 I = MAX(1,J-K),J - 1
- Y(IY) = Y(IY) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- IF (J.GT.K) THEN
- KX = KX + INCX
- KY = KY + INCY
- END IF
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when lower triangle of A is stored.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*A(1,J)
- L = 1 - J
- DO 90 I = J + 1,MIN(N,J+K)
- Y(I) = Y(I) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(I)
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*A(1,J)
- L = 1 - J
- IX = JX
- IY = JY
- DO 110 I = J + 1,MIN(N,J+K)
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSBMV .
-*
- END
diff --git a/netlib/BLAS/dscal.f b/netlib/BLAS/dscal.f
deleted file mode 100644
index 986c24e..0000000
--- a/netlib/BLAS/dscal.f
+++ /dev/null
@@ -1,64 +0,0 @@
- SUBROUTINE DSCAL(N,DA,DX,INCX)
-* .. Scalar Arguments ..
- DOUBLE PRECISION DA
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSCAL scales a vector by a constant.
-* uses unrolled loops for increment equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- DX(I) = DA*DX(I)
- END DO
- IF (N.LT.5) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- DX(I) = DA*DX(I)
- DX(I+1) = DA*DX(I+1)
- DX(I+2) = DA*DX(I+2)
- DX(I+3) = DA*DX(I+3)
- DX(I+4) = DA*DX(I+4)
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- DX(I) = DA*DX(I)
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/dsdot.f b/netlib/BLAS/dsdot.f
deleted file mode 100644
index 8f8ebfd..0000000
--- a/netlib/BLAS/dsdot.f
+++ /dev/null
@@ -1,98 +0,0 @@
- DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* AUTHORS
-* =======
-* Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
-* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
-*
-* Purpose
-* =======
-* Compute the inner product of two vectors with extended
-* precision accumulation and result.
-*
-* Returns D.P. dot product accumulated in D.P., for S.P. SX and SY
-* DSDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY),
-* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
-* defined in a similar way using INCY.
-*
-* Arguments
-* =========
-*
-* N (input) INTEGER
-* number of elements in input vector(s)
-*
-* SX (input) REAL array, dimension(N)
-* single precision vector with N elements
-*
-* INCX (input) INTEGER
-* storage spacing between elements of SX
-*
-* SY (input) REAL array, dimension(N)
-* single precision vector with N elements
-*
-* INCY (input) INTEGER
-* storage spacing between elements of SY
-*
-* DSDOT (output) DOUBLE PRECISION
-* DSDOT double precision dot product (zero if N.LE.0)
-*
-* Further Details
-* ===============
-*
-* REFERENCES
-*
-* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
-* Krogh, Basic linear algebra subprograms for Fortran
-* usage, Algorithm No. 539, Transactions on Mathematical
-* Software 5, 3 (September 1979), pp. 308-323.
-*
-* REVISION HISTORY (YYMMDD)
-*
-* 791001 DATE WRITTEN
-* 890831 Modified array declarations. (WRB)
-* 890831 REVISION DATE from Version 3.2
-* 891214 Prologue converted to Version 4.0 format. (BAB)
-* 920310 Corrected definition of LX in DESCRIPTION. (WRB)
-* 920501 Reformatted the REFERENCES section. (WRB)
-* 070118 Reformat to LAPACK style (JL)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,KX,KY,NS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE
-* ..
- DSDOT = 0.0D0
- IF (N.LE.0) RETURN
- IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN
-*
-* Code for equal, positive, non-unit increments.
-*
- NS = N*INCX
- DO I = 1,NS,INCX
- DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
- END DO
- ELSE
-*
-* Code for unequal or nonpositive increments.
-*
- KX = 1
- KY = 1
- IF (INCX.LT.0) KX = 1 + (1-N)*INCX
- IF (INCY.LT.0) KY = 1 + (1-N)*INCY
- DO I = 1,N
- DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
- KX = KX + INCX
- KY = KY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/dspmv.f b/netlib/BLAS/dspmv.f
deleted file mode 100644
index 4067b0e..0000000
--- a/netlib/BLAS/dspmv.f
+++ /dev/null
@@ -1,266 +0,0 @@
- SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP(*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSPMV performs the matrix-vector operation
-*
-* y := alpha*A*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are n element vectors and
-* A is an n by n symmetric matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the matrix A is supplied in the packed
-* array AP as follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* supplied in AP.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* supplied in AP.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* AP - DOUBLE PRECISION array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
-* and a( 2, 2 ) respectively, and so on.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
-* and a( 3, 1 ) respectively, and so on.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y. On exit, Y is overwritten by the updated
-* vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 6
- ELSE IF (INCY.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSPMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of the array AP
-* are accessed sequentially with one pass through AP.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- KK = 1
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when AP contains the upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- K = KK
- DO 50 I = 1,J - 1
- Y(I) = Y(I) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(I)
- K = K + 1
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
- KK = KK + J
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- DO 70 K = KK,KK + J - 2
- Y(IY) = Y(IY) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + J
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when AP contains the lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*AP(KK)
- K = KK + 1
- DO 90 I = J + 1,N
- Y(I) = Y(I) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(I)
- K = K + 1
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- KK = KK + (N-J+1)
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*AP(KK)
- IX = JX
- IY = JY
- DO 110 K = KK + 1,KK + N - J
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + (N-J+1)
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSPMV .
-*
- END
diff --git a/netlib/BLAS/dspr.f b/netlib/BLAS/dspr.f
deleted file mode 100644
index 64567fc..0000000
--- a/netlib/BLAS/dspr.f
+++ /dev/null
@@ -1,202 +0,0 @@
- SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER INCX,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP(*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSPR performs the symmetric rank 1 operation
-*
-* A := alpha*x*x**T + A,
-*
-* where alpha is a real scalar, x is an n element vector and A is an
-* n by n symmetric matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the matrix A is supplied in the packed
-* array AP as follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* supplied in AP.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* supplied in AP.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* AP - DOUBLE PRECISION array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
-* and a( 2, 2 ) respectively, and so on. On exit, the array
-* AP is overwritten by the upper triangular part of the
-* updated matrix.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
-* and a( 3, 1 ) respectively, and so on. On exit, the array
-* AP is overwritten by the lower triangular part of the
-* updated matrix.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,K,KK,KX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSPR ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set the start point in X if the increment is not unity.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of the array AP
-* are accessed sequentially with one pass through AP.
-*
- KK = 1
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when upper triangle is stored in AP.
-*
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- K = KK
- DO 10 I = 1,J
- AP(K) = AP(K) + X(I)*TEMP
- K = K + 1
- 10 CONTINUE
- END IF
- KK = KK + J
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = KX
- DO 30 K = KK,KK + J - 1
- AP(K) = AP(K) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JX = JX + INCX
- KK = KK + J
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when lower triangle is stored in AP.
-*
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- K = KK
- DO 50 I = J,N
- AP(K) = AP(K) + X(I)*TEMP
- K = K + 1
- 50 CONTINUE
- END IF
- KK = KK + N - J + 1
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = JX
- DO 70 K = KK,KK + N - J
- AP(K) = AP(K) + X(IX)*TEMP
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- KK = KK + N - J + 1
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSPR .
-*
- END
diff --git a/netlib/BLAS/dspr2.f b/netlib/BLAS/dspr2.f
deleted file mode 100644
index 22900ad..0000000
--- a/netlib/BLAS/dspr2.f
+++ /dev/null
@@ -1,233 +0,0 @@
- SUBROUTINE DSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER INCX,INCY,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP(*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSPR2 performs the symmetric rank 2 operation
-*
-* A := alpha*x*y**T + alpha*y*x**T + A,
-*
-* where alpha is a scalar, x and y are n element vectors and A is an
-* n by n symmetric matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the matrix A is supplied in the packed
-* array AP as follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* supplied in AP.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* supplied in AP.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* AP - DOUBLE PRECISION array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
-* and a( 2, 2 ) respectively, and so on. On exit, the array
-* AP is overwritten by the upper triangular part of the
-* updated matrix.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
-* and a( 3, 1 ) respectively, and so on. On exit, the array
-* AP is overwritten by the lower triangular part of the
-* updated matrix.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSPR2 ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set up the start points in X and Y if the increments are not both
-* unity.
-*
- IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
- JX = KX
- JY = KY
- END IF
-*
-* Start the operations. In this version the elements of the array AP
-* are accessed sequentially with one pass through AP.
-*
- KK = 1
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when upper triangle is stored in AP.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 20 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- K = KK
- DO 10 I = 1,J
- AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
- K = K + 1
- 10 CONTINUE
- END IF
- KK = KK + J
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = KX
- IY = KY
- DO 30 K = KK,KK + J - 1
- AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 30 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + J
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when lower triangle is stored in AP.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- K = KK
- DO 50 I = J,N
- AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
- K = K + 1
- 50 CONTINUE
- END IF
- KK = KK + N - J + 1
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = JX
- IY = JY
- DO 70 K = KK,KK + N - J
- AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + N - J + 1
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSPR2 .
-*
- END
diff --git a/netlib/BLAS/dswap.f b/netlib/BLAS/dswap.f
deleted file mode 100644
index 93db05c..0000000
--- a/netlib/BLAS/dswap.f
+++ /dev/null
@@ -1,77 +0,0 @@
- SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* interchanges two vectors.
-* uses unrolled loops for increments equal one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,3)
- IF (M.NE.0) THEN
- DO I = 1,M
- DTEMP = DX(I)
- DX(I) = DY(I)
- DY(I) = DTEMP
- END DO
- IF (N.LT.3) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,3
- DTEMP = DX(I)
- DX(I) = DY(I)
- DY(I) = DTEMP
- DTEMP = DX(I+1)
- DX(I+1) = DY(I+1)
- DY(I+1) = DTEMP
- DTEMP = DX(I+2)
- DX(I+2) = DY(I+2)
- DY(I+2) = DTEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DTEMP = DX(IX)
- DX(IX) = DY(IY)
- DY(IY) = DTEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/dsymm.f b/netlib/BLAS/dsymm.f
deleted file mode 100644
index d9d3c96..0000000
--- a/netlib/BLAS/dsymm.f
+++ /dev/null
@@ -1,297 +0,0 @@
- SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER LDA,LDB,LDC,M,N
- CHARACTER SIDE,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSYMM performs one of the matrix-matrix operations
-*
-* C := alpha*A*B + beta*C,
-*
-* or
-*
-* C := alpha*B*A + beta*C,
-*
-* where alpha and beta are scalars, A is a symmetric matrix and B and
-* C are m by n matrices.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether the symmetric matrix A
-* appears on the left or right in the operation as follows:
-*
-* SIDE = 'L' or 'l' C := alpha*A*B + beta*C,
-*
-* SIDE = 'R' or 'r' C := alpha*B*A + beta*C,
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the symmetric matrix A is to be
-* referenced as follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of the
-* symmetric matrix is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of the
-* symmetric matrix is to be referenced.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix C.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix C.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-* m when SIDE = 'L' or 'l' and is n otherwise.
-* Before entry with SIDE = 'L' or 'l', the m by m part of
-* the array A must contain the symmetric matrix, such that
-* when UPLO = 'U' or 'u', the leading m by m upper triangular
-* part of the array A must contain the upper triangular part
-* of the symmetric matrix and the strictly lower triangular
-* part of A is not referenced, and when UPLO = 'L' or 'l',
-* the leading m by m lower triangular part of the array A
-* must contain the lower triangular part of the symmetric
-* matrix and the strictly upper triangular part of A is not
-* referenced.
-* Before entry with SIDE = 'R' or 'r', the n by n part of
-* the array A must contain the symmetric matrix, such that
-* when UPLO = 'U' or 'u', the leading n by n upper triangular
-* part of the array A must contain the upper triangular part
-* of the symmetric matrix and the strictly lower triangular
-* part of A is not referenced, and when UPLO = 'L' or 'l',
-* the leading n by n lower triangular part of the array A
-* must contain the lower triangular part of the symmetric
-* matrix and the strictly upper triangular part of A is not
-* referenced.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), otherwise LDA must be at
-* least max( 1, n ).
-* Unchanged on exit.
-*
-* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then C need not be set on input.
-* Unchanged on exit.
-*
-* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-* Before entry, the leading m 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 array C is overwritten by the m by n updated
-* matrix.
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,J,K,NROWA
- LOGICAL UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Set NROWA as the number of rows of A.
-*
- IF (LSAME(SIDE,'L')) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- UPPER = LSAME(UPLO,'U')
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 7
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 9
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 12
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSYMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSAME(SIDE,'L')) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- IF (UPPER) THEN
- DO 70 J = 1,N
- DO 60 I = 1,M
- TEMP1 = ALPHA*B(I,J)
- TEMP2 = ZERO
- DO 50 K = 1,I - 1
- C(K,J) = C(K,J) + TEMP1*A(K,I)
- TEMP2 = TEMP2 + B(K,J)*A(K,I)
- 50 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
- + ALPHA*TEMP2
- END IF
- 60 CONTINUE
- 70 CONTINUE
- ELSE
- DO 100 J = 1,N
- DO 90 I = M,1,-1
- TEMP1 = ALPHA*B(I,J)
- TEMP2 = ZERO
- DO 80 K = I + 1,M
- C(K,J) = C(K,J) + TEMP1*A(K,I)
- TEMP2 = TEMP2 + B(K,J)*A(K,I)
- 80 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
- + ALPHA*TEMP2
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form C := alpha*B*A + beta*C.
-*
- DO 170 J = 1,N
- TEMP1 = ALPHA*A(J,J)
- IF (BETA.EQ.ZERO) THEN
- DO 110 I = 1,M
- C(I,J) = TEMP1*B(I,J)
- 110 CONTINUE
- ELSE
- DO 120 I = 1,M
- C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
- 120 CONTINUE
- END IF
- DO 140 K = 1,J - 1
- IF (UPPER) THEN
- TEMP1 = ALPHA*A(K,J)
- ELSE
- TEMP1 = ALPHA*A(J,K)
- END IF
- DO 130 I = 1,M
- C(I,J) = C(I,J) + TEMP1*B(I,K)
- 130 CONTINUE
- 140 CONTINUE
- DO 160 K = J + 1,N
- IF (UPPER) THEN
- TEMP1 = ALPHA*A(J,K)
- ELSE
- TEMP1 = ALPHA*A(K,J)
- END IF
- DO 150 I = 1,M
- C(I,J) = C(I,J) + TEMP1*B(I,K)
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSYMM .
-*
- END
diff --git a/netlib/BLAS/dsymv.f b/netlib/BLAS/dsymv.f
deleted file mode 100644
index 5fa4341..0000000
--- a/netlib/BLAS/dsymv.f
+++ /dev/null
@@ -1,266 +0,0 @@
- SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSYMV performs the matrix-vector operation
-*
-* y := alpha*A*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are n element vectors and
-* A is an n by n symmetric matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array A is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of A
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of A
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of A is not referenced.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y. On exit, Y is overwritten by the updated
-* vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 5
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- ELSE IF (INCY.EQ.0) THEN
- INFO = 10
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSYMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when A is stored in upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- DO 50 I = 1,J - 1
- Y(I) = Y(I) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(I)
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*A(J,J) + ALPHA*TEMP2
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- DO 70 I = 1,J - 1
- Y(IY) = Y(IY) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*A(J,J) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when A is stored in lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*A(J,J)
- DO 90 I = J + 1,N
- Y(I) = Y(I) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(I)
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*A(J,J)
- IX = JX
- IY = JY
- DO 110 I = J + 1,N
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSYMV .
-*
- END
diff --git a/netlib/BLAS/dsyr.f b/netlib/BLAS/dsyr.f
deleted file mode 100644
index 5cc4bcb..0000000
--- a/netlib/BLAS/dsyr.f
+++ /dev/null
@@ -1,202 +0,0 @@
- SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER INCX,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSYR performs the symmetric rank 1 operation
-*
-* A := alpha*x*x**T + A,
-*
-* where alpha is a real scalar, x is an n element vector and A is an
-* n by n symmetric matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array A is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of A
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of A
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of A is not referenced. On exit, the
-* upper triangular part of the array A is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of A is not referenced. On exit, the
-* lower triangular part of the array A is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSYR ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set the start point in X if the increment is not unity.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when A is stored in upper triangle.
-*
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- DO 10 I = 1,J
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = KX
- DO 30 I = 1,J
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JX = JX + INCX
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when A is stored in lower triangle.
-*
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- DO 50 I = J,N
- A(I,J) = A(I,J) + X(I)*TEMP
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = JX
- DO 70 I = J,N
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSYR .
-*
- END
diff --git a/netlib/BLAS/dsyr2.f b/netlib/BLAS/dsyr2.f
deleted file mode 100644
index b2b2f3d..0000000
--- a/netlib/BLAS/dsyr2.f
+++ /dev/null
@@ -1,233 +0,0 @@
- SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER INCX,INCY,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSYR2 performs the symmetric rank 2 operation
-*
-* A := alpha*x*y**T + alpha*y*x**T + A,
-*
-* where alpha is a scalar, x and y are n element vectors and A is an n
-* by n symmetric matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array A is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of A
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of A
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of A is not referenced. On exit, the
-* upper triangular part of the array A is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of A is not referenced. On exit, the
-* lower triangular part of the array A is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSYR2 ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set up the start points in X and Y if the increments are not both
-* unity.
-*
- IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
- JX = KX
- JY = KY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when A is stored in the upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 20 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- DO 10 I = 1,J
- A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = KX
- IY = KY
- DO 30 I = 1,J
- A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 30 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when A is stored in the lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- DO 50 I = J,N
- A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = JX
- IY = JY
- DO 70 I = J,N
- A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSYR2 .
-*
- END
diff --git a/netlib/BLAS/dsyr2k.f b/netlib/BLAS/dsyr2k.f
deleted file mode 100644
index 7289b05..0000000
--- a/netlib/BLAS/dsyr2k.f
+++ /dev/null
@@ -1,329 +0,0 @@
- SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,N
- CHARACTER TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSYR2K performs one of the symmetric rank 2k operations
-*
-* C := alpha*A*B**T + alpha*B*A**T + beta*C,
-*
-* or
-*
-* C := alpha*A**T*B + alpha*B**T*A + beta*C,
-*
-* where alpha and beta are scalars, C is an n by n symmetric matrix
-* and A and B are n by k matrices in the first case and k by n
-* matrices in the second case.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array C is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of C
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of C
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' C := alpha*A*B**T + alpha*B*A**T +
-* beta*C.
-*
-* TRANS = 'T' or 't' C := alpha*A**T*B + alpha*B**T*A +
-* beta*C.
-*
-* TRANS = 'C' or 'c' C := alpha*A**T*B + alpha*B**T*A +
-* beta*C.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with TRANS = 'N' or 'n', K specifies the number
-* of columns of the matrices A and B, and on entry with
-* TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
-* of rows of the matrices A and B. K must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANS = 'N' or 'n', and is n otherwise.
-* Before entry with TRANS = 'N' or 'n', the leading n by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by n part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDA must be at least max( 1, n ), otherwise LDA must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
-* k when TRANS = 'N' or 'n', and is n otherwise.
-* Before entry with TRANS = 'N' or 'n', the leading n by k
-* part of the array B must contain the matrix B, otherwise
-* the leading k by n part of the array B must contain the
-* matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDB must be at least max( 1, n ), otherwise LDB must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array C must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of C is not referenced. On exit, the
-* upper triangular part of the array C is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array C must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of C is not referenced. On exit, the
-* lower triangular part of the array C is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP1,TEMP2
- INTEGER I,INFO,J,L,NROWA
- LOGICAL UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Test the input parameters.
-*
- IF (LSAME(TRANS,'N')) THEN
- NROWA = N
- ELSE
- NROWA = K
- END IF
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 1
- ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
- + (.NOT.LSAME(TRANS,'T')) .AND.
- + (.NOT.LSAME(TRANS,'C'))) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (K.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 7
- ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDC.LT.MAX(1,N)) THEN
- INFO = 12
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSYR2K',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
- + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (UPPER) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,J
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,J
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- IF (BETA.EQ.ZERO) THEN
- DO 60 J = 1,N
- DO 50 I = J,N
- C(I,J) = ZERO
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 I = J,N
- C(I,J) = BETA*C(I,J)
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form C := alpha*A*B**T + alpha*B*A**T + C.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 90 I = 1,J
- C(I,J) = ZERO
- 90 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 100 I = 1,J
- C(I,J) = BETA*C(I,J)
- 100 CONTINUE
- END IF
- DO 120 L = 1,K
- IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
- TEMP1 = ALPHA*B(J,L)
- TEMP2 = ALPHA*A(J,L)
- DO 110 I = 1,J
- C(I,J) = C(I,J) + A(I,L)*TEMP1 +
- + B(I,L)*TEMP2
- 110 CONTINUE
- END IF
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 180 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 140 I = J,N
- C(I,J) = ZERO
- 140 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 150 I = J,N
- C(I,J) = BETA*C(I,J)
- 150 CONTINUE
- END IF
- DO 170 L = 1,K
- IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
- TEMP1 = ALPHA*B(J,L)
- TEMP2 = ALPHA*A(J,L)
- DO 160 I = J,N
- C(I,J) = C(I,J) + A(I,L)*TEMP1 +
- + B(I,L)*TEMP2
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- END IF
- ELSE
-*
-* Form C := alpha*A**T*B + alpha*B**T*A + C.
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- DO 200 I = 1,J
- TEMP1 = ZERO
- TEMP2 = ZERO
- DO 190 L = 1,K
- TEMP1 = TEMP1 + A(L,I)*B(L,J)
- TEMP2 = TEMP2 + B(L,I)*A(L,J)
- 190 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
- + ALPHA*TEMP2
- END IF
- 200 CONTINUE
- 210 CONTINUE
- ELSE
- DO 240 J = 1,N
- DO 230 I = J,N
- TEMP1 = ZERO
- TEMP2 = ZERO
- DO 220 L = 1,K
- TEMP1 = TEMP1 + A(L,I)*B(L,J)
- TEMP2 = TEMP2 + B(L,I)*A(L,J)
- 220 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
- + ALPHA*TEMP2
- END IF
- 230 CONTINUE
- 240 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSYR2K.
-*
- END
diff --git a/netlib/BLAS/dsyrk.f b/netlib/BLAS/dsyrk.f
deleted file mode 100644
index 00fb33a..0000000
--- a/netlib/BLAS/dsyrk.f
+++ /dev/null
@@ -1,298 +0,0 @@
- SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER K,LDA,LDC,N
- CHARACTER TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* DSYRK performs one of the symmetric rank k operations
-*
-* C := alpha*A*A**T + beta*C,
-*
-* or
-*
-* C := alpha*A**T*A + beta*C,
-*
-* where alpha and beta are scalars, C is an n by n symmetric matrix
-* and A is an n by k matrix in the first case and a k by n matrix
-* in the second case.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array C is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of C
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of C
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' C := alpha*A*A**T + beta*C.
-*
-* TRANS = 'T' or 't' C := alpha*A**T*A + beta*C.
-*
-* TRANS = 'C' or 'c' C := alpha*A**T*A + beta*C.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with TRANS = 'N' or 'n', K specifies the number
-* of columns of the matrix A, and on entry with
-* TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
-* of rows of the matrix A. K must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANS = 'N' or 'n', and is n otherwise.
-* Before entry with TRANS = 'N' or 'n', the leading n by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by n part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDA must be at least max( 1, n ), otherwise LDA must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* BETA - DOUBLE PRECISION.
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array C must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of C is not referenced. On exit, the
-* upper triangular part of the array C is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array C must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of C is not referenced. On exit, the
-* lower triangular part of the array C is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,L,NROWA
- LOGICAL UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Test the input parameters.
-*
- IF (LSAME(TRANS,'N')) THEN
- NROWA = N
- ELSE
- NROWA = K
- END IF
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 1
- ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
- + (.NOT.LSAME(TRANS,'T')) .AND.
- + (.NOT.LSAME(TRANS,'C'))) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (K.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 7
- ELSE IF (LDC.LT.MAX(1,N)) THEN
- INFO = 10
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DSYRK ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
- + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (UPPER) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,J
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,J
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- IF (BETA.EQ.ZERO) THEN
- DO 60 J = 1,N
- DO 50 I = J,N
- C(I,J) = ZERO
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 I = J,N
- C(I,J) = BETA*C(I,J)
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form C := alpha*A*A**T + beta*C.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 90 I = 1,J
- C(I,J) = ZERO
- 90 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 100 I = 1,J
- C(I,J) = BETA*C(I,J)
- 100 CONTINUE
- END IF
- DO 120 L = 1,K
- IF (A(J,L).NE.ZERO) THEN
- TEMP = ALPHA*A(J,L)
- DO 110 I = 1,J
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 110 CONTINUE
- END IF
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 180 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 140 I = J,N
- C(I,J) = ZERO
- 140 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 150 I = J,N
- C(I,J) = BETA*C(I,J)
- 150 CONTINUE
- END IF
- DO 170 L = 1,K
- IF (A(J,L).NE.ZERO) THEN
- TEMP = ALPHA*A(J,L)
- DO 160 I = J,N
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- END IF
- ELSE
-*
-* Form C := alpha*A**T*A + beta*C.
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- DO 200 I = 1,J
- TEMP = ZERO
- DO 190 L = 1,K
- TEMP = TEMP + A(L,I)*A(L,J)
- 190 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 200 CONTINUE
- 210 CONTINUE
- ELSE
- DO 240 J = 1,N
- DO 230 I = J,N
- TEMP = ZERO
- DO 220 L = 1,K
- TEMP = TEMP + A(L,I)*A(L,J)
- 220 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 230 CONTINUE
- 240 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSYRK .
-*
- END
diff --git a/netlib/BLAS/dtbmv.f b/netlib/BLAS/dtbmv.f
deleted file mode 100644
index 4f8778a..0000000
--- a/netlib/BLAS/dtbmv.f
+++ /dev/null
@@ -1,336 +0,0 @@
- SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,K,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTBMV performs one of the matrix-vector operations
-*
-* x := A*x, or x := A**T*x,
-*
-* where x is an n element vector and A is an n by n unit, or non-unit,
-* upper or lower triangular band matrix, with ( k + 1 ) diagonals.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with UPLO = 'U' or 'u', K specifies the number of
-* super-diagonals of the matrix A.
-* On entry with UPLO = 'L' or 'l', K specifies the number of
-* sub-diagonals of the matrix A.
-* K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer an upper
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer a lower
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Note that when DIAG = 'U' or 'u' the elements of the array A
-* corresponding to the diagonal elements of the matrix are not
-* referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 7
- ELSE IF (INCX.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- L = KPLUS1 - J
- DO 10 I = MAX(1,J-K),J - 1
- X(I) = X(I) + TEMP*A(L+I,J)
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J)
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- L = KPLUS1 - J
- DO 30 I = MAX(1,J-K),J - 1
- X(IX) = X(IX) + TEMP*A(L+I,J)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J)
- END IF
- JX = JX + INCX
- IF (J.GT.K) KX = KX + INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- L = 1 - J
- DO 50 I = MIN(N,J+K),J + 1,-1
- X(I) = X(I) + TEMP*A(L+I,J)
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(1,J)
- END IF
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- L = 1 - J
- DO 70 I = MIN(N,J+K),J + 1,-1
- X(IX) = X(IX) + TEMP*A(L+I,J)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(1,J)
- END IF
- JX = JX - INCX
- IF ((N-J).GE.K) KX = KX - INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- L = KPLUS1 - J
- IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
- DO 90 I = J - 1,MAX(1,J-K),-1
- TEMP = TEMP + A(L+I,J)*X(I)
- 90 CONTINUE
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- KX = KX - INCX
- IX = KX
- L = KPLUS1 - J
- IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
- DO 110 I = J - 1,MAX(1,J-K),-1
- TEMP = TEMP + A(L+I,J)*X(IX)
- IX = IX - INCX
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- L = 1 - J
- IF (NOUNIT) TEMP = TEMP*A(1,J)
- DO 130 I = J + 1,MIN(N,J+K)
- TEMP = TEMP + A(L+I,J)*X(I)
- 130 CONTINUE
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- KX = KX + INCX
- IX = KX
- L = 1 - J
- IF (NOUNIT) TEMP = TEMP*A(1,J)
- DO 150 I = J + 1,MIN(N,J+K)
- TEMP = TEMP + A(L+I,J)*X(IX)
- IX = IX + INCX
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTBMV .
-*
- END
diff --git a/netlib/BLAS/dtbsv.f b/netlib/BLAS/dtbsv.f
deleted file mode 100644
index 621c1ec..0000000
--- a/netlib/BLAS/dtbsv.f
+++ /dev/null
@@ -1,339 +0,0 @@
- SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,K,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTBSV solves one of the systems of equations
-*
-* A*x = b, or A**T*x = b,
-*
-* where b and x are n element vectors and A is an n by n unit, or
-* non-unit, upper or lower triangular band matrix, with ( k + 1 )
-* diagonals.
-*
-* No test for singularity or near-singularity is included in this
-* routine. Such tests must be performed before calling this routine.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A**T*x = b.
-*
-* TRANS = 'C' or 'c' A**T*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with UPLO = 'U' or 'u', K specifies the number of
-* super-diagonals of the matrix A.
-* On entry with UPLO = 'L' or 'l', K specifies the number of
-* sub-diagonals of the matrix A.
-* K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer an upper
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer a lower
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Note that when DIAG = 'U' or 'u' the elements of the array A
-* corresponding to the diagonal elements of the matrix are not
-* referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 7
- ELSE IF (INCX.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTBSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed by sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- L = KPLUS1 - J
- IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
- TEMP = X(J)
- DO 10 I = J - 1,MAX(1,J-K),-1
- X(I) = X(I) - TEMP*A(L+I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 40 J = N,1,-1
- KX = KX - INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = KPLUS1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
- TEMP = X(JX)
- DO 30 I = J - 1,MAX(1,J-K),-1
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX - INCX
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- L = 1 - J
- IF (NOUNIT) X(J) = X(J)/A(1,J)
- TEMP = X(J)
- DO 50 I = J + 1,MIN(N,J+K)
- X(I) = X(I) - TEMP*A(L+I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- KX = KX + INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = 1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(1,J)
- TEMP = X(JX)
- DO 70 I = J + 1,MIN(N,J+K)
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T)*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- L = KPLUS1 - J
- DO 90 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- L = KPLUS1 - J
- DO 110 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- X(JX) = TEMP
- JX = JX + INCX
- IF (J.GT.K) KX = KX + INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- L = 1 - J
- DO 130 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(I)
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- L = 1 - J
- DO 150 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- X(JX) = TEMP
- JX = JX - INCX
- IF ((N-J).GE.K) KX = KX - INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTBSV .
-*
- END
diff --git a/netlib/BLAS/dtpmv.f b/netlib/BLAS/dtpmv.f
deleted file mode 100644
index 1def763..0000000
--- a/netlib/BLAS/dtpmv.f
+++ /dev/null
@@ -1,294 +0,0 @@
- SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP(*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTPMV performs one of the matrix-vector operations
-*
-* x := A*x, or x := A**T*x,
-*
-* where x is an n element vector and A is an n by n unit, or non-unit,
-* upper or lower triangular matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* AP - DOUBLE PRECISION array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
-* respectively, and so on.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
-* respectively, and so on.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,K,KK,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTPMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of AP are
-* accessed sequentially with one pass through AP.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x:= A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- K = KK
- DO 10 I = 1,J - 1
- X(I) = X(I) + TEMP*AP(K)
- K = K + 1
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*AP(KK+J-1)
- END IF
- KK = KK + J
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 30 K = KK,KK + J - 2
- X(IX) = X(IX) + TEMP*AP(K)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1)
- END IF
- JX = JX + INCX
- KK = KK + J
- 40 CONTINUE
- END IF
- ELSE
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- K = KK
- DO 50 I = N,J + 1,-1
- X(I) = X(I) + TEMP*AP(K)
- K = K - 1
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*AP(KK-N+J)
- END IF
- KK = KK - (N-J+1)
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 70 K = KK,KK - (N- (J+1)),-1
- X(IX) = X(IX) + TEMP*AP(K)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J)
- END IF
- JX = JX - INCX
- KK = KK - (N-J+1)
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- K = KK - 1
- DO 90 I = J - 1,1,-1
- TEMP = TEMP + AP(K)*X(I)
- K = K - 1
- 90 CONTINUE
- X(J) = TEMP
- KK = KK - J
- 100 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- DO 110 K = KK - 1,KK - J + 1,-1
- IX = IX - INCX
- TEMP = TEMP + AP(K)*X(IX)
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- KK = KK - J
- 120 CONTINUE
- END IF
- ELSE
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- K = KK + 1
- DO 130 I = J + 1,N
- TEMP = TEMP + AP(K)*X(I)
- K = K + 1
- 130 CONTINUE
- X(J) = TEMP
- KK = KK + (N-J+1)
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- DO 150 K = KK + 1,KK + N - J
- IX = IX + INCX
- TEMP = TEMP + AP(K)*X(IX)
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- KK = KK + (N-J+1)
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTPMV .
-*
- END
diff --git a/netlib/BLAS/dtpsv.f b/netlib/BLAS/dtpsv.f
deleted file mode 100644
index 49b6523..0000000
--- a/netlib/BLAS/dtpsv.f
+++ /dev/null
@@ -1,296 +0,0 @@
- SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP(*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTPSV solves one of the systems of equations
-*
-* A*x = b, or A**T*x = b,
-*
-* where b and x are n element vectors and A is an n by n unit, or
-* non-unit, upper or lower triangular matrix, supplied in packed form.
-*
-* No test for singularity or near-singularity is included in this
-* routine. Such tests must be performed before calling this routine.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A**T*x = b.
-*
-* TRANS = 'C' or 'c' A**T*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* AP - DOUBLE PRECISION array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
-* respectively, and so on.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
-* respectively, and so on.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,K,KK,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTPSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of AP are
-* accessed sequentially with one pass through AP.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/AP(KK)
- TEMP = X(J)
- K = KK - 1
- DO 10 I = J - 1,1,-1
- X(I) = X(I) - TEMP*AP(K)
- K = K - 1
- 10 CONTINUE
- END IF
- KK = KK - J
- 20 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 40 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/AP(KK)
- TEMP = X(JX)
- IX = JX
- DO 30 K = KK - 1,KK - J + 1,-1
- IX = IX - INCX
- X(IX) = X(IX) - TEMP*AP(K)
- 30 CONTINUE
- END IF
- JX = JX - INCX
- KK = KK - J
- 40 CONTINUE
- END IF
- ELSE
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/AP(KK)
- TEMP = X(J)
- K = KK + 1
- DO 50 I = J + 1,N
- X(I) = X(I) - TEMP*AP(K)
- K = K + 1
- 50 CONTINUE
- END IF
- KK = KK + (N-J+1)
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/AP(KK)
- TEMP = X(JX)
- IX = JX
- DO 70 K = KK + 1,KK + N - J
- IX = IX + INCX
- X(IX) = X(IX) - TEMP*AP(K)
- 70 CONTINUE
- END IF
- JX = JX + INCX
- KK = KK + (N-J+1)
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- K = KK
- DO 90 I = 1,J - 1
- TEMP = TEMP - AP(K)*X(I)
- K = K + 1
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
- X(J) = TEMP
- KK = KK + J
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- DO 110 K = KK,KK + J - 2
- TEMP = TEMP - AP(K)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
- X(JX) = TEMP
- JX = JX + INCX
- KK = KK + J
- 120 CONTINUE
- END IF
- ELSE
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- K = KK
- DO 130 I = N,J + 1,-1
- TEMP = TEMP - AP(K)*X(I)
- K = K - 1
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
- X(J) = TEMP
- KK = KK - (N-J+1)
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- DO 150 K = KK,KK - (N- (J+1)),-1
- TEMP = TEMP - AP(K)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
- X(JX) = TEMP
- JX = JX - INCX
- KK = KK - (N-J+1)
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTPSV .
-*
- END
diff --git a/netlib/BLAS/dtrmm.f b/netlib/BLAS/dtrmm.f
deleted file mode 100644
index fc03769..0000000
--- a/netlib/BLAS/dtrmm.f
+++ /dev/null
@@ -1,349 +0,0 @@
- SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTRMM performs one of the matrix-matrix operations
-*
-* B := alpha*op( A )*B, or B := alpha*B*op( A ),
-*
-* where alpha is a scalar, B is an m by n matrix, A is a unit, or
-* non-unit, upper or lower triangular matrix and op( A ) is one of
-*
-* op( A ) = A or op( A ) = A**T.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether op( A ) multiplies B from
-* the left or right as follows:
-*
-* SIDE = 'L' or 'l' B := alpha*op( A )*B.
-*
-* SIDE = 'R' or 'r' B := alpha*B*op( A ).
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix A is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n' op( A ) = A.
-*
-* TRANSA = 'T' or 't' op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c' op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit triangular
-* as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of B. M must be at
-* least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of B. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha. When alpha is
-* zero then A is not referenced and B need not be set before
-* entry.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
-* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
-* Before entry with UPLO = 'U' or 'u', the leading k by k
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading k by k
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-* then LDA must be at least max( 1, n ).
-* Unchanged on exit.
-*
-* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the matrix B, and on exit is overwritten by the
-* transformed matrix.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*A*B.
-*
- IF (UPPER) THEN
- DO 50 J = 1,N
- DO 40 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- TEMP = ALPHA*B(K,J)
- DO 30 I = 1,K - 1
- B(I,J) = B(I,J) + TEMP*A(I,K)
- 30 CONTINUE
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- B(K,J) = TEMP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- TEMP = ALPHA*B(K,J)
- B(K,J) = TEMP
- IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
- DO 60 I = K + 1,M
- B(I,J) = B(I,J) + TEMP*A(I,K)
- 60 CONTINUE
- END IF
- 70 CONTINUE
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*A**T*B.
-*
- IF (UPPER) THEN
- DO 110 J = 1,N
- DO 100 I = M,1,-1
- TEMP = B(I,J)
- IF (NOUNIT) TEMP = TEMP*A(I,I)
- DO 90 K = 1,I - 1
- TEMP = TEMP + A(K,I)*B(K,J)
- 90 CONTINUE
- B(I,J) = ALPHA*TEMP
- 100 CONTINUE
- 110 CONTINUE
- ELSE
- DO 140 J = 1,N
- DO 130 I = 1,M
- TEMP = B(I,J)
- IF (NOUNIT) TEMP = TEMP*A(I,I)
- DO 120 K = I + 1,M
- TEMP = TEMP + A(K,I)*B(K,J)
- 120 CONTINUE
- B(I,J) = ALPHA*TEMP
- 130 CONTINUE
- 140 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*A.
-*
- IF (UPPER) THEN
- DO 180 J = N,1,-1
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 150 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 150 CONTINUE
- DO 170 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- TEMP = ALPHA*A(K,J)
- DO 160 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- ELSE
- DO 220 J = 1,N
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 190 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 190 CONTINUE
- DO 210 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- TEMP = ALPHA*A(K,J)
- DO 200 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- 220 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*A**T.
-*
- IF (UPPER) THEN
- DO 260 K = 1,N
- DO 240 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = ALPHA*A(J,K)
- DO 230 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- IF (TEMP.NE.ONE) THEN
- DO 250 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- ELSE
- DO 300 K = N,1,-1
- DO 280 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = ALPHA*A(J,K)
- DO 270 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 270 CONTINUE
- END IF
- 280 CONTINUE
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- IF (TEMP.NE.ONE) THEN
- DO 290 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 290 CONTINUE
- END IF
- 300 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRMM .
-*
- END
diff --git a/netlib/BLAS/dtrmv.f b/netlib/BLAS/dtrmv.f
deleted file mode 100644
index 5356cbb..0000000
--- a/netlib/BLAS/dtrmv.f
+++ /dev/null
@@ -1,282 +0,0 @@
- SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTRMV performs one of the matrix-vector operations
-*
-* x := A*x, or x := A**T*x,
-*
-* where x is an n element vector and A is an n by n unit, or non-unit,
-* upper or lower triangular matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- DO 10 I = 1,J - 1
- X(I) = X(I) + TEMP*A(I,J)
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(J,J)
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 30 I = 1,J - 1
- X(IX) = X(IX) + TEMP*A(I,J)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(J,J)
- END IF
- JX = JX + INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- DO 50 I = N,J + 1,-1
- X(I) = X(I) + TEMP*A(I,J)
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(J,J)
- END IF
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 70 I = N,J + 1,-1
- X(IX) = X(IX) + TEMP*A(I,J)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(J,J)
- END IF
- JX = JX - INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 90 I = J - 1,1,-1
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 110 I = J - 1,1,-1
- IX = IX - INCX
- TEMP = TEMP + A(I,J)*X(IX)
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 130 I = J + 1,N
- TEMP = TEMP + A(I,J)*X(I)
- 130 CONTINUE
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 150 I = J + 1,N
- IX = IX + INCX
- TEMP = TEMP + A(I,J)*X(IX)
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRMV .
-*
- END
diff --git a/netlib/BLAS/dtrsm.f b/netlib/BLAS/dtrsm.f
deleted file mode 100644
index dec5c8d..0000000
--- a/netlib/BLAS/dtrsm.f
+++ /dev/null
@@ -1,376 +0,0 @@
- SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTRSM solves one of the matrix equations
-*
-* op( A )*X = alpha*B, or X*op( A ) = alpha*B,
-*
-* where alpha is a scalar, X and B are m by n matrices, A is a unit, or
-* non-unit, upper or lower triangular matrix and op( A ) is one of
-*
-* op( A ) = A or op( A ) = A**T.
-*
-* The matrix X is overwritten on B.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether op( A ) appears on the left
-* or right of X as follows:
-*
-* SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*
-* SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix A is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n' op( A ) = A.
-*
-* TRANSA = 'T' or 't' op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c' op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit triangular
-* as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of B. M must be at
-* least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of B. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha. When alpha is
-* zero then A is not referenced and B need not be set before
-* entry.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
-* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
-* Before entry with UPLO = 'U' or 'u', the leading k by k
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading k by k
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-* then LDA must be at least max( 1, n ).
-* Unchanged on exit.
-*
-* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the right-hand side matrix B, and on exit is
-* overwritten by the solution matrix X.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRSM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*inv( A )*B.
-*
- IF (UPPER) THEN
- DO 60 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 30 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 30 CONTINUE
- END IF
- DO 50 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 40 I = 1,K - 1
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 40 CONTINUE
- END IF
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 100 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 70 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 70 CONTINUE
- END IF
- DO 90 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 80 I = K + 1,M
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 80 CONTINUE
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*inv( A**T )*B.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- DO 120 I = 1,M
- TEMP = ALPHA*B(I,J)
- DO 110 K = 1,I - 1
- TEMP = TEMP - A(K,I)*B(K,J)
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 160 J = 1,N
- DO 150 I = M,1,-1
- TEMP = ALPHA*B(I,J)
- DO 140 K = I + 1,M
- TEMP = TEMP - A(K,I)*B(K,J)
- 140 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 150 CONTINUE
- 160 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*inv( A ).
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 170 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 170 CONTINUE
- END IF
- DO 190 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- DO 180 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 180 CONTINUE
- END IF
- 190 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 200 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- ELSE
- DO 260 J = N,1,-1
- IF (ALPHA.NE.ONE) THEN
- DO 220 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 220 CONTINUE
- END IF
- DO 240 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- DO 230 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 250 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*inv( A**T ).
-*
- IF (UPPER) THEN
- DO 310 K = N,1,-1
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 270 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 270 CONTINUE
- END IF
- DO 290 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 280 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 280 CONTINUE
- END IF
- 290 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 300 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 300 CONTINUE
- END IF
- 310 CONTINUE
- ELSE
- DO 360 K = 1,N
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 320 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 320 CONTINUE
- END IF
- DO 340 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 330 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 330 CONTINUE
- END IF
- 340 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 350 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 350 CONTINUE
- END IF
- 360 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRSM .
-*
- END
diff --git a/netlib/BLAS/dtrsv.f b/netlib/BLAS/dtrsv.f
deleted file mode 100644
index f901e69..0000000
--- a/netlib/BLAS/dtrsv.f
+++ /dev/null
@@ -1,282 +0,0 @@
- SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DTRSV solves one of the systems of equations
-*
-* A*x = b, or A**T*x = b,
-*
-* where b and x are n element vectors and A is an n by n unit, or
-* non-unit, upper or lower triangular matrix.
-*
-* No test for singularity or near-singularity is included in this
-* routine. Such tests must be performed before calling this routine.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A**T*x = b.
-*
-* TRANS = 'C' or 'c' A**T*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 10 I = J - 1,1,-1
- X(I) = X(I) - TEMP*A(I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 40 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 30 I = J - 1,1,-1
- IX = IX - INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 50 I = J + 1,N
- X(I) = X(I) - TEMP*A(I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 70 I = J + 1,N
- IX = IX + INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- DO 90 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- DO 110 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(JX) = TEMP
- JX = JX + INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- DO 130 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(I)
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- DO 150 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(JX) = TEMP
- JX = JX - INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRSV .
-*
- END
diff --git a/netlib/BLAS/dzasum.f b/netlib/BLAS/dzasum.f
deleted file mode 100644
index a5c440c..0000000
--- a/netlib/BLAS/dzasum.f
+++ /dev/null
@@ -1,52 +0,0 @@
- DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX ZX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DZASUM takes the sum of the absolute values.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION STEMP
- INTEGER I,NINCX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DCABS1
- EXTERNAL DCABS1
-* ..
- DZASUM = 0.0d0
- STEMP = 0.0d0
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- DO I = 1,N
- STEMP = STEMP + DCABS1(ZX(I))
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- STEMP = STEMP + DCABS1(ZX(I))
- END DO
- END IF
- DZASUM = STEMP
- RETURN
- END
diff --git a/netlib/BLAS/dznrm2.f b/netlib/BLAS/dznrm2.f
deleted file mode 100644
index 71b5674..0000000
--- a/netlib/BLAS/dznrm2.f
+++ /dev/null
@@ -1,74 +0,0 @@
- DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DZNRM2 returns the euclidean norm of a vector via the function
-* name, so that
-*
-* DZNRM2 := sqrt( x**H*x )
-*
-* Further Details
-* ===============
-*
-* -- This version written on 25-October-1982.
-* Modified on 14-October-1993 to inline the call to ZLASSQ.
-* Sven Hammarling, Nag Ltd.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION NORM,SCALE,SSQ,TEMP
- INTEGER IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,DBLE,DIMAG,SQRT
-* ..
- IF (N.LT.1 .OR. INCX.LT.1) THEN
- NORM = ZERO
- ELSE
- SCALE = ZERO
- SSQ = ONE
-* The following loop is equivalent to this call to the LAPACK
-* auxiliary routine:
-* CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
-*
- DO 10 IX = 1,1 + (N-1)*INCX,INCX
- IF (DBLE(X(IX)).NE.ZERO) THEN
- TEMP = ABS(DBLE(X(IX)))
- IF (SCALE.LT.TEMP) THEN
- SSQ = ONE + SSQ* (SCALE/TEMP)**2
- SCALE = TEMP
- ELSE
- SSQ = SSQ + (TEMP/SCALE)**2
- END IF
- END IF
- IF (DIMAG(X(IX)).NE.ZERO) THEN
- TEMP = ABS(DIMAG(X(IX)))
- IF (SCALE.LT.TEMP) THEN
- SSQ = ONE + SSQ* (SCALE/TEMP)**2
- SCALE = TEMP
- ELSE
- SSQ = SSQ + (TEMP/SCALE)**2
- END IF
- END IF
- 10 CONTINUE
- NORM = SCALE*SQRT(SSQ)
- END IF
-*
- DZNRM2 = NORM
- RETURN
-*
-* End of DZNRM2.
-*
- END
diff --git a/netlib/BLAS/icamax.f b/netlib/BLAS/icamax.f
deleted file mode 100644
index 2c941f9..0000000
--- a/netlib/BLAS/icamax.f
+++ /dev/null
@@ -1,62 +0,0 @@
- INTEGER FUNCTION ICAMAX(N,CX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- COMPLEX CX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* ICAMAX finds the index of element having max. absolute value.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL SMAX
- INTEGER I,IX
-* ..
-* .. External Functions ..
- REAL SCABS1
- EXTERNAL SCABS1
-* ..
- ICAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- ICAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- SMAX = SCABS1(CX(1))
- DO I = 2,N
- IF (SCABS1(CX(I)).GT.SMAX) THEN
- ICAMAX = I
- SMAX = SCABS1(CX(I))
- END IF
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- IX = 1
- SMAX = SCABS1(CX(1))
- IX = IX + INCX
- DO I = 2,N
- IF (SCABS1(CX(IX)).GT.SMAX) THEN
- ICAMAX = I
- SMAX = SCABS1(CX(IX))
- END IF
- IX = IX + INCX
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/idamax.f b/netlib/BLAS/idamax.f
deleted file mode 100644
index 2cc0f9a..0000000
--- a/netlib/BLAS/idamax.f
+++ /dev/null
@@ -1,61 +0,0 @@
- INTEGER FUNCTION IDAMAX(N,DX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* IDAMAX finds the index of element having max. absolute value.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DMAX
- INTEGER I,IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS
-* ..
- IDAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- IDAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- DMAX = DABS(DX(1))
- DO I = 2,N
- IF (DABS(DX(I)).GT.DMAX) THEN
- IDAMAX = I
- DMAX = DABS(DX(I))
- END IF
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- IX = 1
- DMAX = DABS(DX(1))
- IX = IX + INCX
- DO I = 2,N
- IF (DABS(DX(IX)).GT.DMAX) THEN
- IDAMAX = I
- DMAX = DABS(DX(IX))
- END IF
- IX = IX + INCX
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/isamax.f b/netlib/BLAS/isamax.f
deleted file mode 100644
index 26a98dd..0000000
--- a/netlib/BLAS/isamax.f
+++ /dev/null
@@ -1,61 +0,0 @@
- INTEGER FUNCTION ISAMAX(N,SX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- REAL SX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* ISAMAX finds the index of element having max. absolute value.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL SMAX
- INTEGER I,IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
- ISAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- ISAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- SMAX = ABS(SX(1))
- DO I = 2,N
- IF (ABS(SX(I)).GT.SMAX) THEN
- ISAMAX = I
- SMAX = ABS(SX(I))
- END IF
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- IX = 1
- SMAX = ABS(SX(1))
- IX = IX + INCX
- DO I = 2,N
- IF (ABS(SX(IX)).GT.SMAX) THEN
- ISAMAX = I
- SMAX = ABS(SX(IX))
- END IF
- IX = IX + INCX
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/izamax.f b/netlib/BLAS/izamax.f
deleted file mode 100644
index af14fb1..0000000
--- a/netlib/BLAS/izamax.f
+++ /dev/null
@@ -1,62 +0,0 @@
- INTEGER FUNCTION IZAMAX(N,ZX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX ZX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* IZAMAX finds the index of element having max. absolute value.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, 1/15/85.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DMAX
- INTEGER I,IX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DCABS1
- EXTERNAL DCABS1
-* ..
- IZAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- IZAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- DMAX = DCABS1(ZX(1))
- DO I = 2,N
- IF (DCABS1(ZX(I)).GT.DMAX) THEN
- IZAMAX = I
- DMAX = DCABS1(ZX(I))
- END IF
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- IX = 1
- DMAX = DCABS1(ZX(1))
- IX = IX + INCX
- DO I = 2,N
- IF (DCABS1(ZX(IX)).GT.DMAX) THEN
- IZAMAX = I
- DMAX = DCABS1(ZX(IX))
- END IF
- IX = IX + INCX
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/lsame.f b/netlib/BLAS/lsame.f
deleted file mode 100644
index f536902..0000000
--- a/netlib/BLAS/lsame.f
+++ /dev/null
@@ -1,85 +0,0 @@
- LOGICAL FUNCTION LSAME(CA,CB)
-*
-* -- LAPACK auxiliary routine (version 3.1) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2006
-*
-* .. Scalar Arguments ..
- CHARACTER CA,CB
-* ..
-*
-* Purpose
-* =======
-*
-* LSAME returns .TRUE. if CA is the same letter as CB regardless of
-* case.
-*
-* Arguments
-* =========
-*
-* CA (input) CHARACTER*1
-*
-* CB (input) CHARACTER*1
-* CA and CB specify the single characters to be compared.
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC ICHAR
-* ..
-* .. Local Scalars ..
- INTEGER INTA,INTB,ZCODE
-* ..
-*
-* Test if the characters are equal
-*
- LSAME = CA .EQ. CB
- IF (LSAME) RETURN
-*
-* Now test for equivalence if both characters are alphabetic.
-*
- ZCODE = ICHAR('Z')
-*
-* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
-* machines, on which ICHAR returns a value with bit 8 set.
-* ICHAR('A') on Prime machines returns 193 which is the same as
-* ICHAR('A') on an EBCDIC machine.
-*
- INTA = ICHAR(CA)
- INTB = ICHAR(CB)
-*
- IF (ZCODE.EQ.90 .OR. ZCODE.EQ.122) THEN
-*
-* ASCII is assumed - ZCODE is the ASCII code of either lower or
-* upper case 'Z'.
-*
- IF (INTA.GE.97 .AND. INTA.LE.122) INTA = INTA - 32
- IF (INTB.GE.97 .AND. INTB.LE.122) INTB = INTB - 32
-*
- ELSE IF (ZCODE.EQ.233 .OR. ZCODE.EQ.169) THEN
-*
-* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
-* upper case 'Z'.
-*
- IF (INTA.GE.129 .AND. INTA.LE.137 .OR.
- + INTA.GE.145 .AND. INTA.LE.153 .OR.
- + INTA.GE.162 .AND. INTA.LE.169) INTA = INTA + 64
- IF (INTB.GE.129 .AND. INTB.LE.137 .OR.
- + INTB.GE.145 .AND. INTB.LE.153 .OR.
- + INTB.GE.162 .AND. INTB.LE.169) INTB = INTB + 64
-*
- ELSE IF (ZCODE.EQ.218 .OR. ZCODE.EQ.250) THEN
-*
-* ASCII is assumed, on Prime machines - ZCODE is the ASCII code
-* plus 128 of either lower or upper case 'Z'.
-*
- IF (INTA.GE.225 .AND. INTA.LE.250) INTA = INTA - 32
- IF (INTB.GE.225 .AND. INTB.LE.250) INTB = INTB - 32
- END IF
- LSAME = INTA .EQ. INTB
-*
-* RETURN
-*
-* End of LSAME
-*
- END
diff --git a/netlib/BLAS/sasum.f b/netlib/BLAS/sasum.f
deleted file mode 100644
index 1e3f7db..0000000
--- a/netlib/BLAS/sasum.f
+++ /dev/null
@@ -1,67 +0,0 @@
- REAL FUNCTION SASUM(N,SX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- REAL SX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SASUM takes the sum of the absolute values.
-* uses unrolled loops for increment equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL STEMP
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,MOD
-* ..
- SASUM = 0.0e0
- STEMP = 0.0e0
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,6)
- IF (M.NE.0) THEN
- DO I = 1,M
- STEMP = STEMP + ABS(SX(I))
- END DO
- IF (N.LT.6) THEN
- SASUM = STEMP
- RETURN
- END IF
- END IF
- MP1 = M + 1
- DO I = MP1,N,6
- STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) +
- $ ABS(SX(I+2)) + ABS(SX(I+3)) +
- $ ABS(SX(I+4)) + ABS(SX(I+5))
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- STEMP = STEMP + ABS(SX(I))
- END DO
- END IF
- SASUM = STEMP
- RETURN
- END
diff --git a/netlib/BLAS/saxpy.f b/netlib/BLAS/saxpy.f
deleted file mode 100644
index c0d8b3a..0000000
--- a/netlib/BLAS/saxpy.f
+++ /dev/null
@@ -1,69 +0,0 @@
- SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
-* .. Scalar Arguments ..
- REAL SA
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SAXPY constant times a vector plus a vector.
-* uses unrolled loops for increments equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (SA.EQ.0.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,4)
- IF (M.NE.0) THEN
- DO I = 1,M
- SY(I) = SY(I) + SA*SX(I)
- END DO
- END IF
- IF (N.LT.4) RETURN
- MP1 = M + 1
- DO I = MP1,N,4
- SY(I) = SY(I) + SA*SX(I)
- SY(I+1) = SY(I+1) + SA*SX(I+1)
- SY(I+2) = SY(I+2) + SA*SX(I+2)
- SY(I+3) = SY(I+3) + SA*SX(I+3)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- SY(IY) = SY(IY) + SA*SX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/scabs1.f b/netlib/BLAS/scabs1.f
deleted file mode 100644
index eccb9f6..0000000
--- a/netlib/BLAS/scabs1.f
+++ /dev/null
@@ -1,18 +0,0 @@
- REAL FUNCTION SCABS1(Z)
-* .. Scalar Arguments ..
- COMPLEX Z
-* ..
-*
-* Purpose
-* =======
-*
-* SCABS1 computes absolute value of a complex number
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC ABS,AIMAG,REAL
-* ..
- SCABS1 = ABS(REAL(Z)) + ABS(AIMAG(Z))
- RETURN
- END
diff --git a/netlib/BLAS/scasum.f b/netlib/BLAS/scasum.f
deleted file mode 100644
index d090110..0000000
--- a/netlib/BLAS/scasum.f
+++ /dev/null
@@ -1,52 +0,0 @@
- REAL FUNCTION SCASUM(N,CX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- COMPLEX CX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SCASUM takes the sum of the absolute values of a complex vector and
-* returns a single precision result.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL STEMP
- INTEGER I,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,AIMAG,REAL
-* ..
- SCASUM = 0.0e0
- STEMP = 0.0e0
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- DO I = 1,N
- STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
- END DO
- END IF
- SCASUM = STEMP
- RETURN
- END
diff --git a/netlib/BLAS/scnrm2.f b/netlib/BLAS/scnrm2.f
deleted file mode 100644
index 1738c31..0000000
--- a/netlib/BLAS/scnrm2.f
+++ /dev/null
@@ -1,74 +0,0 @@
- REAL FUNCTION SCNRM2(N,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- COMPLEX X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SCNRM2 returns the euclidean norm of a vector via the function
-* name, so that
-*
-* SCNRM2 := sqrt( x**H*x )
-*
-* Further Details
-* ===============
-*
-* -- This version written on 25-October-1982.
-* Modified on 14-October-1993 to inline the call to CLASSQ.
-* Sven Hammarling, Nag Ltd.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL NORM,SCALE,SSQ,TEMP
- INTEGER IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,AIMAG,REAL,SQRT
-* ..
- IF (N.LT.1 .OR. INCX.LT.1) THEN
- NORM = ZERO
- ELSE
- SCALE = ZERO
- SSQ = ONE
-* The following loop is equivalent to this call to the LAPACK
-* auxiliary routine:
-* CALL CLASSQ( N, X, INCX, SCALE, SSQ )
-*
- DO 10 IX = 1,1 + (N-1)*INCX,INCX
- IF (REAL(X(IX)).NE.ZERO) THEN
- TEMP = ABS(REAL(X(IX)))
- IF (SCALE.LT.TEMP) THEN
- SSQ = ONE + SSQ* (SCALE/TEMP)**2
- SCALE = TEMP
- ELSE
- SSQ = SSQ + (TEMP/SCALE)**2
- END IF
- END IF
- IF (AIMAG(X(IX)).NE.ZERO) THEN
- TEMP = ABS(AIMAG(X(IX)))
- IF (SCALE.LT.TEMP) THEN
- SSQ = ONE + SSQ* (SCALE/TEMP)**2
- SCALE = TEMP
- ELSE
- SSQ = SSQ + (TEMP/SCALE)**2
- END IF
- END IF
- 10 CONTINUE
- NORM = SCALE*SQRT(SSQ)
- END IF
-*
- SCNRM2 = NORM
- RETURN
-*
-* End of SCNRM2.
-*
- END
diff --git a/netlib/BLAS/scopy.f b/netlib/BLAS/scopy.f
deleted file mode 100644
index 905a64c..0000000
--- a/netlib/BLAS/scopy.f
+++ /dev/null
@@ -1,70 +0,0 @@
- SUBROUTINE SCOPY(N,SX,INCX,SY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SCOPY copies a vector, x, to a vector, y.
-* uses unrolled loops for increments equal to 1.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,7)
- IF (M.NE.0) THEN
- DO I = 1,M
- SY(I) = SX(I)
- END DO
- IF (N.LT.7) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,7
- SY(I) = SX(I)
- SY(I+1) = SX(I+1)
- SY(I+2) = SX(I+2)
- SY(I+3) = SX(I+3)
- SY(I+4) = SX(I+4)
- SY(I+5) = SX(I+5)
- SY(I+6) = SX(I+6)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- SY(IY) = SX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/sdot.f b/netlib/BLAS/sdot.f
deleted file mode 100644
index 4629bbb..0000000
--- a/netlib/BLAS/sdot.f
+++ /dev/null
@@ -1,72 +0,0 @@
- REAL FUNCTION SDOT(N,SX,INCX,SY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SDOT forms the dot product of two vectors.
-* uses unrolled loops for increments equal to one.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL STEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- STEMP = 0.0e0
- SDOT = 0.0e0
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- STEMP = STEMP + SX(I)*SY(I)
- END DO
- IF (N.LT.5) THEN
- SDOT=STEMP
- RETURN
- END IF
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- STEMP = STEMP + SX(I)*SY(I) + SX(I+1)*SY(I+1) +
- $ SX(I+2)*SY(I+2) + SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- STEMP = STEMP + SX(IX)*SY(IY)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- SDOT = STEMP
- RETURN
- END
diff --git a/netlib/BLAS/sdsdot.f b/netlib/BLAS/sdsdot.f
deleted file mode 100644
index b84a6c5..0000000
--- a/netlib/BLAS/sdsdot.f
+++ /dev/null
@@ -1,109 +0,0 @@
- REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY)
-* .. Scalar Arguments ..
- REAL SB
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* PURPOSE
-* =======
-*
-* Compute the inner product of two vectors with extended
-* precision accumulation.
-*
-* Returns S.P. result with dot product accumulated in D.P.
-* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
-* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
-* defined in a similar way using INCY.
-*
-* AUTHOR
-* ======
-* Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
-* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
-*
-* ARGUMENTS
-* =========
-*
-* N (input) INTEGER
-* number of elements in input vector(s)
-*
-* SB (input) REAL
-* single precision scalar to be added to inner product
-*
-* SX (input) REAL array, dimension (N)
-* single precision vector with N elements
-*
-* INCX (input) INTEGER
-* storage spacing between elements of SX
-*
-* SY (input) REAL array, dimension (N)
-* single precision vector with N elements
-*
-* INCY (input) INTEGER
-* storage spacing between elements of SY
-*
-* SDSDOT (output) REAL
-* single precision dot product (SB if N .LE. 0)
-*
-* Further Details
-* ===============
-*
-* REFERENCES
-*
-* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
-* Krogh, Basic linear algebra subprograms for Fortran
-* usage, Algorithm No. 539, Transactions on Mathematical
-* Software 5, 3 (September 1979), pp. 308-323.
-*
-* REVISION HISTORY (YYMMDD)
-*
-* 791001 DATE WRITTEN
-* 890531 Changed all specific intrinsics to generic. (WRB)
-* 890831 Modified array declarations. (WRB)
-* 890831 REVISION DATE from Version 3.2
-* 891214 Prologue converted to Version 4.0 format. (BAB)
-* 920310 Corrected definition of LX in DESCRIPTION. (WRB)
-* 920501 Reformatted the REFERENCES section. (WRB)
-* 070118 Reformat to LAPACK coding style
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DSDOT
- INTEGER I,KX,KY,NS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE
-* ..
- DSDOT = SB
- IF (N.LE.0) THEN
- SDSDOT = DSDOT
- RETURN
- END IF
- IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN
-*
-* Code for equal and positive increments.
-*
- NS = N*INCX
- DO I = 1,NS,INCX
- DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
- END DO
- ELSE
-*
-* Code for unequal or nonpositive increments.
-*
- KX = 1
- KY = 1
- IF (INCX.LT.0) KX = 1 + (1-N)*INCX
- IF (INCY.LT.0) KY = 1 + (1-N)*INCY
- DO I = 1,N
- DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
- KX = KX + INCX
- KY = KY + INCY
- END DO
- END IF
- SDSDOT = DSDOT
- RETURN
- END
diff --git a/netlib/BLAS/sgbmv.f b/netlib/BLAS/sgbmv.f
deleted file mode 100644
index 9c81731..0000000
--- a/netlib/BLAS/sgbmv.f
+++ /dev/null
@@ -1,302 +0,0 @@
- SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER INCX,INCY,KL,KU,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SGBMV performs one of the matrix-vector operations
-*
-* y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are vectors and A is an
-* m by n band matrix, with kl sub-diagonals and ku super-diagonals.
-*
-* Arguments
-* ==========
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*
-* TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
-*
-* TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* KL - INTEGER.
-* On entry, KL specifies the number of sub-diagonals of the
-* matrix A. KL must satisfy 0 .le. KL.
-* Unchanged on exit.
-*
-* KU - INTEGER.
-* On entry, KU specifies the number of super-diagonals of the
-* matrix A. KU must satisfy 0 .le. KU.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry, the leading ( kl + ku + 1 ) by n part of the
-* array A must contain the matrix of coefficients, supplied
-* column by column, with the leading diagonal of the matrix in
-* row ( ku + 1 ) of the array, the first super-diagonal
-* starting at position 2 in row ku, the first sub-diagonal
-* starting at position 1 in row ( ku + 2 ), and so on.
-* Elements in the array A that do not correspond to elements
-* in the band matrix (such as the top left ku by ku triangle)
-* are not referenced.
-* The following program segment will transfer a band matrix
-* from conventional full matrix storage to band storage:
-*
-* DO 20, J = 1, N
-* K = KU + 1 - J
-* DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
-* A( K + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( kl + ku + 1 ).
-* Unchanged on exit.
-*
-* X - REAL array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - REAL array of DIMENSION at least
-* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-* Before entry, the incremented array Y must contain the
-* vector y. On exit, Y is overwritten by the updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (KL.LT.0) THEN
- INFO = 4
- ELSE IF (KU.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (KL+KU+1)) THEN
- INFO = 8
- ELSE IF (INCX.EQ.0) THEN
- INFO = 10
- ELSE IF (INCY.EQ.0) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SGBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the band part of A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- KUP1 = KU + 1
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- K = KUP1 - J
- DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
- Y(I) = Y(I) + TEMP*A(K+I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- K = KUP1 - J
- DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
- Y(IY) = Y(IY) + TEMP*A(K+I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- IF (J.GT.KU) KY = KY + INCY
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A**T*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = ZERO
- K = KUP1 - J
- DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
- TEMP = TEMP + A(K+I,J)*X(I)
- 90 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 100 CONTINUE
- ELSE
- DO 120 J = 1,N
- TEMP = ZERO
- IX = KX
- K = KUP1 - J
- DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
- TEMP = TEMP + A(K+I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- IF (J.GT.KU) KX = KX + INCX
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SGBMV .
-*
- END
diff --git a/netlib/BLAS/sgemm.f b/netlib/BLAS/sgemm.f
deleted file mode 100644
index 36c00d0..0000000
--- a/netlib/BLAS/sgemm.f
+++ /dev/null
@@ -1,316 +0,0 @@
- SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,M,N
- CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* SGEMM performs one of the matrix-matrix operations
-*
-* C := alpha*op( A )*op( B ) + beta*C,
-*
-* where op( X ) is one of
-*
-* op( X ) = X or op( X ) = X**T,
-*
-* alpha and beta are scalars, and A, B and C are matrices, with op( A )
-* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
-*
-* Arguments
-* ==========
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n', op( A ) = A.
-*
-* TRANSA = 'T' or 't', op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c', op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* TRANSB - CHARACTER*1.
-* On entry, TRANSB specifies the form of op( B ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSB = 'N' or 'n', op( B ) = B.
-*
-* TRANSB = 'T' or 't', op( B ) = B**T.
-*
-* TRANSB = 'C' or 'c', op( B ) = B**T.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix
-* op( A ) and of the matrix C. M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix
-* op( B ) and the number of columns of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry, K specifies the number of columns of the matrix
-* op( A ) and the number of rows of the matrix op( B ). K must
-* be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANSA = 'N' or 'n', and is m otherwise.
-* Before entry with TRANSA = 'N' or 'n', the leading m by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by m part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANSA = 'N' or 'n' then
-* LDA must be at least max( 1, m ), otherwise LDA must be at
-* least max( 1, k ).
-* Unchanged on exit.
-*
-* B - REAL array of DIMENSION ( LDB, kb ), where kb is
-* n when TRANSB = 'N' or 'n', and is k otherwise.
-* Before entry with TRANSB = 'N' or 'n', the leading k by n
-* part of the array B must contain the matrix B, otherwise
-* the leading n by k part of the array B must contain the
-* matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. When TRANSB = 'N' or 'n' then
-* LDB must be at least max( 1, k ), otherwise LDB must be at
-* least max( 1, n ).
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then C need not be set on input.
-* Unchanged on exit.
-*
-* C - REAL array of DIMENSION ( LDC, n ).
-* Before entry, the leading m 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 array C is overwritten by the m by n matrix
-* ( alpha*op( A )*op( B ) + beta*C ).
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
- LOGICAL NOTA,NOTB
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Set NOTA and NOTB as true if A and B respectively are not
-* transposed and set NROWA, NCOLA and NROWB as the number of rows
-* and columns of A and the number of rows of B respectively.
-*
- NOTA = LSAME(TRANSA,'N')
- NOTB = LSAME(TRANSB,'N')
- IF (NOTA) THEN
- NROWA = M
- NCOLA = K
- ELSE
- NROWA = K
- NCOLA = M
- END IF
- IF (NOTB) THEN
- NROWB = K
- ELSE
- NROWB = N
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
- + (.NOT.LSAME(TRANSA,'T'))) THEN
- INFO = 1
- ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
- + (.NOT.LSAME(TRANSB,'T'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 8
- ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
- INFO = 10
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SGEMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And if alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (NOTB) THEN
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- DO 90 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 50 I = 1,M
- C(I,J) = ZERO
- 50 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 60 I = 1,M
- C(I,J) = BETA*C(I,J)
- 60 CONTINUE
- END IF
- DO 80 L = 1,K
- IF (B(L,J).NE.ZERO) THEN
- TEMP = ALPHA*B(L,J)
- DO 70 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 70 CONTINUE
- END IF
- 80 CONTINUE
- 90 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B + beta*C
-*
- DO 120 J = 1,N
- DO 110 I = 1,M
- TEMP = ZERO
- DO 100 L = 1,K
- TEMP = TEMP + A(L,I)*B(L,J)
- 100 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- ELSE
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B**T + beta*C
-*
- DO 170 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 130 I = 1,M
- C(I,J) = ZERO
- 130 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 140 I = 1,M
- C(I,J) = BETA*C(I,J)
- 140 CONTINUE
- END IF
- DO 160 L = 1,K
- IF (B(J,L).NE.ZERO) THEN
- TEMP = ALPHA*B(J,L)
- DO 150 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 150 CONTINUE
- END IF
- 160 CONTINUE
- 170 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B**T + beta*C
-*
- DO 200 J = 1,N
- DO 190 I = 1,M
- TEMP = ZERO
- DO 180 L = 1,K
- TEMP = TEMP + A(L,I)*B(J,L)
- 180 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 190 CONTINUE
- 200 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SGEMM .
-*
- END
diff --git a/netlib/BLAS/sgemv.f b/netlib/BLAS/sgemv.f
deleted file mode 100644
index afae269..0000000
--- a/netlib/BLAS/sgemv.f
+++ /dev/null
@@ -1,265 +0,0 @@
- SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER INCX,INCY,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SGEMV performs one of the matrix-vector operations
-*
-* y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are vectors and A is an
-* m by n matrix.
-*
-* Arguments
-* ==========
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*
-* TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
-*
-* TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry, the leading m by n part of the array A must
-* contain the matrix of coefficients.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* X - REAL array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - REAL array of DIMENSION at least
-* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-* Before entry with BETA non-zero, the incremented array Y
-* must contain the vector y. On exit, Y is overwritten by the
-* updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- ELSE IF (INCY.EQ.0) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SGEMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- DO 50 I = 1,M
- Y(I) = Y(I) + TEMP*A(I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- DO 70 I = 1,M
- Y(IY) = Y(IY) + TEMP*A(I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A**T*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = ZERO
- DO 90 I = 1,M
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 100 CONTINUE
- ELSE
- DO 120 J = 1,N
- TEMP = ZERO
- IX = KX
- DO 110 I = 1,M
- TEMP = TEMP + A(I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SGEMV .
-*
- END
diff --git a/netlib/BLAS/sger.f b/netlib/BLAS/sger.f
deleted file mode 100644
index 828b745..0000000
--- a/netlib/BLAS/sger.f
+++ /dev/null
@@ -1,162 +0,0 @@
- SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SGER performs the rank 1 operation
-*
-* A := alpha*x*y**T + A,
-*
-* where alpha is a scalar, x is an m element vector, y is an n element
-* vector and A is an m by n matrix.
-*
-* Arguments
-* ==========
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( m - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the m
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry, the leading m by n part of the array A must
-* contain the matrix of coefficients. On exit, A is
-* overwritten by the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JY,KX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (M.LT.0) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SGER ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (INCY.GT.0) THEN
- JY = 1
- ELSE
- JY = 1 - (N-1)*INCY
- END IF
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- DO 10 I = 1,M
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- JY = JY + INCY
- 20 CONTINUE
- ELSE
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (M-1)*INCX
- END IF
- DO 40 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- IX = KX
- DO 30 I = 1,M
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JY = JY + INCY
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SGER .
-*
- END
diff --git a/netlib/BLAS/snrm2.f b/netlib/BLAS/snrm2.f
deleted file mode 100644
index 1c336da..0000000
--- a/netlib/BLAS/snrm2.f
+++ /dev/null
@@ -1,67 +0,0 @@
- REAL FUNCTION SNRM2(N,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- REAL X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SNRM2 returns the euclidean norm of a vector via the function
-* name, so that
-*
-* SNRM2 := sqrt( x'*x ).
-*
-* Further Details
-* ===============
-*
-* -- This version written on 25-October-1982.
-* Modified on 14-October-1993 to inline the call to SLASSQ.
-* Sven Hammarling, Nag Ltd.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL ABSXI,NORM,SCALE,SSQ
- INTEGER IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,SQRT
-* ..
- IF (N.LT.1 .OR. INCX.LT.1) THEN
- NORM = ZERO
- ELSE IF (N.EQ.1) THEN
- NORM = ABS(X(1))
- ELSE
- SCALE = ZERO
- SSQ = ONE
-* The following loop is equivalent to this call to the LAPACK
-* auxiliary routine:
-* CALL SLASSQ( N, X, INCX, SCALE, SSQ )
-*
- DO 10 IX = 1,1 + (N-1)*INCX,INCX
- IF (X(IX).NE.ZERO) THEN
- ABSXI = ABS(X(IX))
- IF (SCALE.LT.ABSXI) THEN
- SSQ = ONE + SSQ* (SCALE/ABSXI)**2
- SCALE = ABSXI
- ELSE
- SSQ = SSQ + (ABSXI/SCALE)**2
- END IF
- END IF
- 10 CONTINUE
- NORM = SCALE*SQRT(SSQ)
- END IF
-*
- SNRM2 = NORM
- RETURN
-*
-* End of SNRM2.
-*
- END
diff --git a/netlib/BLAS/srot.f b/netlib/BLAS/srot.f
deleted file mode 100644
index b53b0fd..0000000
--- a/netlib/BLAS/srot.f
+++ /dev/null
@@ -1,55 +0,0 @@
- SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S)
-* .. Scalar Arguments ..
- REAL C,S
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* applies a plane rotation.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL STEMP
- INTEGER I,IX,IY
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
- DO I = 1,N
- STEMP = C*SX(I) + S*SY(I)
- SY(I) = C*SY(I) - S*SX(I)
- SX(I) = STEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- STEMP = C*SX(IX) + S*SY(IY)
- SY(IY) = C*SY(IY) - S*SX(IX)
- SX(IX) = STEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/srotg.f b/netlib/BLAS/srotg.f
deleted file mode 100644
index 4f4258b..0000000
--- a/netlib/BLAS/srotg.f
+++ /dev/null
@@ -1,44 +0,0 @@
- SUBROUTINE SROTG(SA,SB,C,S)
-* .. Scalar Arguments ..
- REAL C,S,SA,SB
-* ..
-*
-* Purpose
-* =======
-*
-* SROTG construct givens plane rotation.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL R,ROE,SCALE,Z
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,SIGN,SQRT
-* ..
- ROE = SB
- IF (ABS(SA).GT.ABS(SB)) ROE = SA
- SCALE = ABS(SA) + ABS(SB)
- IF (SCALE.EQ.0.0) THEN
- C = 1.0
- S = 0.0
- R = 0.0
- Z = 0.0
- ELSE
- R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2)
- R = SIGN(1.0,ROE)*R
- C = SA/R
- S = SB/R
- Z = 1.0
- IF (ABS(SA).GT.ABS(SB)) Z = S
- IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C
- END IF
- SA = R
- SB = Z
- RETURN
- END
diff --git a/netlib/BLAS/srotm.f b/netlib/BLAS/srotm.f
deleted file mode 100644
index 4eeaa4f..0000000
--- a/netlib/BLAS/srotm.f
+++ /dev/null
@@ -1,143 +0,0 @@
- SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SPARAM(5),SX(*),SY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
-*
-* (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
-* (SX**T)
-*
-* SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
-* LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
-* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
-*
-* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
-*
-* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
-* H=( ) ( ) ( ) ( )
-* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
-* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
-*
-*
-* Arguments
-* =========
-*
-* N (input) INTEGER
-* number of elements in input vector(s)
-*
-* SX (input/output) REAL array, dimension N
-* double precision vector with N elements
-*
-* INCX (input) INTEGER
-* storage spacing between elements of SX
-*
-* SY (input/output) REAL array, dimension N
-* double precision vector with N elements
-*
-* INCY (input) INTEGER
-* storage spacing between elements of SY
-*
-* SPARAM (input/output) REAL array, dimension 5
-* SPARAM(1)=SFLAG
-* SPARAM(2)=SH11
-* SPARAM(3)=SH21
-* SPARAM(4)=SH12
-* SPARAM(5)=SH22
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
- INTEGER I,KX,KY,NSTEPS
-* ..
-* .. Data statements ..
- DATA ZERO,TWO/0.E0,2.E0/
-* ..
-*
- SFLAG = SPARAM(1)
- IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) RETURN
- IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
-*
- NSTEPS = N*INCX
- IF (SFLAG.LT.ZERO) THEN
- SH11 = SPARAM(2)
- SH12 = SPARAM(4)
- SH21 = SPARAM(3)
- SH22 = SPARAM(5)
- DO I = 1,NSTEPS,INCX
- W = SX(I)
- Z = SY(I)
- SX(I) = W*SH11 + Z*SH12
- SY(I) = W*SH21 + Z*SH22
- END DO
- ELSE IF (SFLAG.EQ.ZERO) THEN
- SH12 = SPARAM(4)
- SH21 = SPARAM(3)
- DO I = 1,NSTEPS,INCX
- W = SX(I)
- Z = SY(I)
- SX(I) = W + Z*SH12
- SY(I) = W*SH21 + Z
- END DO
- ELSE
- SH11 = SPARAM(2)
- SH22 = SPARAM(5)
- DO I = 1,NSTEPS,INCX
- W = SX(I)
- Z = SY(I)
- SX(I) = W*SH11 + Z
- SY(I) = -W + SH22*Z
- END DO
- END IF
- ELSE
- KX = 1
- KY = 1
- IF (INCX.LT.0) KX = 1 + (1-N)*INCX
- IF (INCY.LT.0) KY = 1 + (1-N)*INCY
-*
- IF (SFLAG.LT.ZERO) THEN
- SH11 = SPARAM(2)
- SH12 = SPARAM(4)
- SH21 = SPARAM(3)
- SH22 = SPARAM(5)
- DO I = 1,N
- W = SX(KX)
- Z = SY(KY)
- SX(KX) = W*SH11 + Z*SH12
- SY(KY) = W*SH21 + Z*SH22
- KX = KX + INCX
- KY = KY + INCY
- END DO
- ELSE IF (SFLAG.EQ.ZERO) THEN
- SH12 = SPARAM(4)
- SH21 = SPARAM(3)
- DO I = 1,N
- W = SX(KX)
- Z = SY(KY)
- SX(KX) = W + Z*SH12
- SY(KY) = W*SH21 + Z
- KX = KX + INCX
- KY = KY + INCY
- END DO
- ELSE
- SH11 = SPARAM(2)
- SH22 = SPARAM(5)
- DO I = 1,N
- W = SX(KX)
- Z = SY(KY)
- SX(KX) = W*SH11 + Z
- SY(KY) = -W + SH22*Z
- KX = KX + INCX
- KY = KY + INCY
- END DO
- END IF
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/srotmg.f b/netlib/BLAS/srotmg.f
deleted file mode 100644
index 4a64e68..0000000
--- a/netlib/BLAS/srotmg.f
+++ /dev/null
@@ -1,198 +0,0 @@
- SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM)
-* .. Scalar Arguments ..
- REAL SD1,SD2,SX1,SY1
-* ..
-* .. Array Arguments ..
- REAL SPARAM(5)
-* ..
-*
-* Purpose
-* =======
-*
-* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
-* THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)*
-* SY2)**T.
-* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
-*
-* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
-*
-* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
-* H=( ) ( ) ( ) ( )
-* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
-* LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22
-* RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE
-* VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.)
-*
-* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
-* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
-* OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
-*
-*
-* Arguments
-* =========
-*
-*
-* SD1 (input/output) REAL
-*
-* SD2 (input/output) REAL
-*
-* SX1 (input/output) REAL
-*
-* SY1 (input) REAL
-*
-*
-* SPARAM (input/output) REAL array, dimension 5
-* SPARAM(1)=SFLAG
-* SPARAM(2)=SH11
-* SPARAM(3)=SH21
-* SPARAM(4)=SH12
-* SPARAM(5)=SH22
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL GAM,GAMSQ,ONE,RGAMSQ,SFLAG,SH11,SH12,SH21,SH22,SP1,SP2,SQ1,
- $ SQ2,STEMP,SU,TWO,ZERO
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Data statements ..
-*
- DATA ZERO,ONE,TWO/0.E0,1.E0,2.E0/
- DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/
-* ..
-
- IF (SD1.LT.ZERO) THEN
-* GO ZERO-H-D-AND-SX1..
- SFLAG = -ONE
- SH11 = ZERO
- SH12 = ZERO
- SH21 = ZERO
- SH22 = ZERO
-*
- SD1 = ZERO
- SD2 = ZERO
- SX1 = ZERO
- ELSE
-* CASE-SD1-NONNEGATIVE
- SP2 = SD2*SY1
- IF (SP2.EQ.ZERO) THEN
- SFLAG = -TWO
- SPARAM(1) = SFLAG
- RETURN
- END IF
-* REGULAR-CASE..
- SP1 = SD1*SX1
- SQ2 = SP2*SY1
- SQ1 = SP1*SX1
-*
- IF (ABS(SQ1).GT.ABS(SQ2)) THEN
- SH21 = -SY1/SX1
- SH12 = SP2/SP1
-*
- SU = ONE - SH12*SH21
-*
- IF (SU.GT.ZERO) THEN
- SFLAG = ZERO
- SD1 = SD1/SU
- SD2 = SD2/SU
- SX1 = SX1*SU
- END IF
- ELSE
-
- IF (SQ2.LT.ZERO) THEN
-* GO ZERO-H-D-AND-SX1..
- SFLAG = -ONE
- SH11 = ZERO
- SH12 = ZERO
- SH21 = ZERO
- SH22 = ZERO
-*
- SD1 = ZERO
- SD2 = ZERO
- SX1 = ZERO
- ELSE
- SFLAG = ONE
- SH11 = SP1/SP2
- SH22 = SX1/SY1
- SU = ONE + SH11*SH22
- STEMP = SD2/SU
- SD2 = SD1/SU
- SD1 = STEMP
- SX1 = SY1*SU
- END IF
- END IF
-
-* PROCESURE..SCALE-CHECK
- IF (SD1.NE.ZERO) THEN
- DO WHILE ((SD1.LE.RGAMSQ) .OR. (SD1.GE.GAMSQ))
- IF (SFLAG.EQ.ZERO) THEN
- SH11 = ONE
- SH22 = ONE
- SFLAG = -ONE
- ELSE
- SH21 = -ONE
- SH12 = ONE
- SFLAG = -ONE
- END IF
- IF (SD1.LE.RGAMSQ) THEN
- SD1 = SD1*GAM**2
- SX1 = SX1/GAM
- SH11 = SH11/GAM
- SH12 = SH12/GAM
- ELSE
- SD1 = SD1/GAM**2
- SX1 = SX1*GAM
- SH11 = SH11*GAM
- SH12 = SH12*GAM
- END IF
- ENDDO
- END IF
-
- IF (SD2.NE.ZERO) THEN
- DO WHILE ( (ABS(SD2).LE.RGAMSQ) .OR. (ABS(SD2).GE.GAMSQ) )
- IF (SFLAG.EQ.ZERO) THEN
- SH11 = ONE
- SH22 = ONE
- SFLAG = -ONE
- ELSE
- SH21 = -ONE
- SH12 = ONE
- SFLAG = -ONE
- END IF
- IF (ABS(SD2).LE.RGAMSQ) THEN
- SD2 = SD2*GAM**2
- SH21 = SH21/GAM
- SH22 = SH22/GAM
- ELSE
- SD2 = SD2/GAM**2
- SH21 = SH21*GAM
- SH22 = SH22*GAM
- END IF
- END DO
- END IF
-
- END IF
-
- IF (SFLAG.LT.ZERO) THEN
- SPARAM(2) = SH11
- SPARAM(3) = SH21
- SPARAM(4) = SH12
- SPARAM(5) = SH22
- ELSE IF (SFLAG.EQ.ZERO) THEN
- SPARAM(3) = SH21
- SPARAM(4) = SH12
- ELSE
- SPARAM(2) = SH11
- SPARAM(5) = SH22
- END IF
-
- 260 CONTINUE
- SPARAM(1) = SFLAG
- RETURN
- END
-
-
-
-
diff --git a/netlib/BLAS/ssbmv.f b/netlib/BLAS/ssbmv.f
deleted file mode 100644
index 88b4adc..0000000
--- a/netlib/BLAS/ssbmv.f
+++ /dev/null
@@ -1,307 +0,0 @@
- SUBROUTINE SSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER INCX,INCY,K,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSBMV performs the matrix-vector operation
-*
-* y := alpha*A*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are n element vectors and
-* A is an n by n symmetric band matrix, with k super-diagonals.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the band matrix A is being supplied as
-* follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* being supplied.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* being supplied.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry, K specifies the number of super-diagonals of the
-* matrix A. K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the symmetric matrix, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer the upper
-* triangular part of a symmetric band matrix from conventional
-* full matrix storage to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the symmetric matrix, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer the lower
-* triangular part of a symmetric band matrix from conventional
-* full matrix storage to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - REAL array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* Y - REAL array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the
-* vector y. On exit, Y is overwritten by the updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (K.LT.0) THEN
- INFO = 3
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- ELSE IF (INCY.EQ.0) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of the array A
-* are accessed sequentially with one pass through A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when upper triangle of A is stored.
-*
- KPLUS1 = K + 1
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- L = KPLUS1 - J
- DO 50 I = MAX(1,J-K),J - 1
- Y(I) = Y(I) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(I)
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- L = KPLUS1 - J
- DO 70 I = MAX(1,J-K),J - 1
- Y(IY) = Y(IY) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- IF (J.GT.K) THEN
- KX = KX + INCX
- KY = KY + INCY
- END IF
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when lower triangle of A is stored.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*A(1,J)
- L = 1 - J
- DO 90 I = J + 1,MIN(N,J+K)
- Y(I) = Y(I) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(I)
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*A(1,J)
- L = 1 - J
- IX = JX
- IY = JY
- DO 110 I = J + 1,MIN(N,J+K)
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*A(L+I,J)
- TEMP2 = TEMP2 + A(L+I,J)*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSBMV .
-*
- END
diff --git a/netlib/BLAS/sscal.f b/netlib/BLAS/sscal.f
deleted file mode 100644
index dd0a68d..0000000
--- a/netlib/BLAS/sscal.f
+++ /dev/null
@@ -1,64 +0,0 @@
- SUBROUTINE SSCAL(N,SA,SX,INCX)
-* .. Scalar Arguments ..
- REAL SA
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- REAL SX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* scales a vector by a constant.
-* uses unrolled loops for increment equal to 1.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- SX(I) = SA*SX(I)
- END DO
- IF (N.LT.5) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- SX(I) = SA*SX(I)
- SX(I+1) = SA*SX(I+1)
- SX(I+2) = SA*SX(I+2)
- SX(I+3) = SA*SX(I+3)
- SX(I+4) = SA*SX(I+4)
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- SX(I) = SA*SX(I)
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/sspmv.f b/netlib/BLAS/sspmv.f
deleted file mode 100644
index c951851..0000000
--- a/netlib/BLAS/sspmv.f
+++ /dev/null
@@ -1,266 +0,0 @@
- SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER INCX,INCY,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL AP(*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSPMV performs the matrix-vector operation
-*
-* y := alpha*A*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are n element vectors and
-* A is an n by n symmetric matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the matrix A is supplied in the packed
-* array AP as follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* supplied in AP.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* supplied in AP.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* AP - REAL array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
-* and a( 2, 2 ) respectively, and so on.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
-* and a( 3, 1 ) respectively, and so on.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y. On exit, Y is overwritten by the updated
-* vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 6
- ELSE IF (INCY.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSPMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of the array AP
-* are accessed sequentially with one pass through AP.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- KK = 1
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when AP contains the upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- K = KK
- DO 50 I = 1,J - 1
- Y(I) = Y(I) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(I)
- K = K + 1
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
- KK = KK + J
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- DO 70 K = KK,KK + J - 2
- Y(IY) = Y(IY) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + J
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when AP contains the lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*AP(KK)
- K = KK + 1
- DO 90 I = J + 1,N
- Y(I) = Y(I) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(I)
- K = K + 1
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- KK = KK + (N-J+1)
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*AP(KK)
- IX = JX
- IY = JY
- DO 110 K = KK + 1,KK + N - J
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*AP(K)
- TEMP2 = TEMP2 + AP(K)*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + (N-J+1)
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSPMV .
-*
- END
diff --git a/netlib/BLAS/sspr.f b/netlib/BLAS/sspr.f
deleted file mode 100644
index 6c2a21c..0000000
--- a/netlib/BLAS/sspr.f
+++ /dev/null
@@ -1,202 +0,0 @@
- SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER INCX,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL AP(*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSPR performs the symmetric rank 1 operation
-*
-* A := alpha*x*x**T + A,
-*
-* where alpha is a real scalar, x is an n element vector and A is an
-* n by n symmetric matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the matrix A is supplied in the packed
-* array AP as follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* supplied in AP.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* supplied in AP.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* AP - REAL array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
-* and a( 2, 2 ) respectively, and so on. On exit, the array
-* AP is overwritten by the upper triangular part of the
-* updated matrix.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
-* and a( 3, 1 ) respectively, and so on. On exit, the array
-* AP is overwritten by the lower triangular part of the
-* updated matrix.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,K,KK,KX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSPR ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set the start point in X if the increment is not unity.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of the array AP
-* are accessed sequentially with one pass through AP.
-*
- KK = 1
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when upper triangle is stored in AP.
-*
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- K = KK
- DO 10 I = 1,J
- AP(K) = AP(K) + X(I)*TEMP
- K = K + 1
- 10 CONTINUE
- END IF
- KK = KK + J
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = KX
- DO 30 K = KK,KK + J - 1
- AP(K) = AP(K) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JX = JX + INCX
- KK = KK + J
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when lower triangle is stored in AP.
-*
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- K = KK
- DO 50 I = J,N
- AP(K) = AP(K) + X(I)*TEMP
- K = K + 1
- 50 CONTINUE
- END IF
- KK = KK + N - J + 1
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = JX
- DO 70 K = KK,KK + N - J
- AP(K) = AP(K) + X(IX)*TEMP
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- KK = KK + N - J + 1
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSPR .
-*
- END
diff --git a/netlib/BLAS/sspr2.f b/netlib/BLAS/sspr2.f
deleted file mode 100644
index 5183107..0000000
--- a/netlib/BLAS/sspr2.f
+++ /dev/null
@@ -1,233 +0,0 @@
- SUBROUTINE SSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER INCX,INCY,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL AP(*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSPR2 performs the symmetric rank 2 operation
-*
-* A := alpha*x*y**T + alpha*y*x**T + A,
-*
-* where alpha is a scalar, x and y are n element vectors and A is an
-* n by n symmetric matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the matrix A is supplied in the packed
-* array AP as follows:
-*
-* UPLO = 'U' or 'u' The upper triangular part of A is
-* supplied in AP.
-*
-* UPLO = 'L' or 'l' The lower triangular part of A is
-* supplied in AP.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* AP - REAL array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
-* and a( 2, 2 ) respectively, and so on. On exit, the array
-* AP is overwritten by the upper triangular part of the
-* updated matrix.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular part of the symmetric matrix
-* packed sequentially, column by column, so that AP( 1 )
-* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
-* and a( 3, 1 ) respectively, and so on. On exit, the array
-* AP is overwritten by the lower triangular part of the
-* updated matrix.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSPR2 ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set up the start points in X and Y if the increments are not both
-* unity.
-*
- IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
- JX = KX
- JY = KY
- END IF
-*
-* Start the operations. In this version the elements of the array AP
-* are accessed sequentially with one pass through AP.
-*
- KK = 1
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when upper triangle is stored in AP.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 20 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- K = KK
- DO 10 I = 1,J
- AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
- K = K + 1
- 10 CONTINUE
- END IF
- KK = KK + J
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = KX
- IY = KY
- DO 30 K = KK,KK + J - 1
- AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 30 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + J
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when lower triangle is stored in AP.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- K = KK
- DO 50 I = J,N
- AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
- K = K + 1
- 50 CONTINUE
- END IF
- KK = KK + N - J + 1
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = JX
- IY = JY
- DO 70 K = KK,KK + N - J
- AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- KK = KK + N - J + 1
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSPR2 .
-*
- END
diff --git a/netlib/BLAS/sswap.f b/netlib/BLAS/sswap.f
deleted file mode 100644
index e1a75f4..0000000
--- a/netlib/BLAS/sswap.f
+++ /dev/null
@@ -1,77 +0,0 @@
- SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* interchanges two vectors.
-* uses unrolled loops for increments equal to 1.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL STEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,3)
- IF (M.NE.0) THEN
- DO I = 1,M
- STEMP = SX(I)
- SX(I) = SY(I)
- SY(I) = STEMP
- END DO
- IF (N.LT.3) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,3
- STEMP = SX(I)
- SX(I) = SY(I)
- SY(I) = STEMP
- STEMP = SX(I+1)
- SX(I+1) = SY(I+1)
- SY(I+1) = STEMP
- STEMP = SX(I+2)
- SX(I+2) = SY(I+2)
- SY(I+2) = STEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- STEMP = SX(IX)
- SX(IX) = SY(IY)
- SY(IY) = STEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/BLAS/ssymm.f b/netlib/BLAS/ssymm.f
deleted file mode 100644
index 5182672..0000000
--- a/netlib/BLAS/ssymm.f
+++ /dev/null
@@ -1,297 +0,0 @@
- SUBROUTINE SSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER LDA,LDB,LDC,M,N
- CHARACTER SIDE,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSYMM performs one of the matrix-matrix operations
-*
-* C := alpha*A*B + beta*C,
-*
-* or
-*
-* C := alpha*B*A + beta*C,
-*
-* where alpha and beta are scalars, A is a symmetric matrix and B and
-* C are m by n matrices.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether the symmetric matrix A
-* appears on the left or right in the operation as follows:
-*
-* SIDE = 'L' or 'l' C := alpha*A*B + beta*C,
-*
-* SIDE = 'R' or 'r' C := alpha*B*A + beta*C,
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the symmetric matrix A is to be
-* referenced as follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of the
-* symmetric matrix is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of the
-* symmetric matrix is to be referenced.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix C.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix C.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, ka ), where ka is
-* m when SIDE = 'L' or 'l' and is n otherwise.
-* Before entry with SIDE = 'L' or 'l', the m by m part of
-* the array A must contain the symmetric matrix, such that
-* when UPLO = 'U' or 'u', the leading m by m upper triangular
-* part of the array A must contain the upper triangular part
-* of the symmetric matrix and the strictly lower triangular
-* part of A is not referenced, and when UPLO = 'L' or 'l',
-* the leading m by m lower triangular part of the array A
-* must contain the lower triangular part of the symmetric
-* matrix and the strictly upper triangular part of A is not
-* referenced.
-* Before entry with SIDE = 'R' or 'r', the n by n part of
-* the array A must contain the symmetric matrix, such that
-* when UPLO = 'U' or 'u', the leading n by n upper triangular
-* part of the array A must contain the upper triangular part
-* of the symmetric matrix and the strictly lower triangular
-* part of A is not referenced, and when UPLO = 'L' or 'l',
-* the leading n by n lower triangular part of the array A
-* must contain the lower triangular part of the symmetric
-* matrix and the strictly upper triangular part of A is not
-* referenced.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), otherwise LDA must be at
-* least max( 1, n ).
-* Unchanged on exit.
-*
-* B - REAL array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then C need not be set on input.
-* Unchanged on exit.
-*
-* C - REAL array of DIMENSION ( LDC, n ).
-* Before entry, the leading m 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 array C is overwritten by the m by n updated
-* matrix.
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,J,K,NROWA
- LOGICAL UPPER
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Set NROWA as the number of rows of A.
-*
- IF (LSAME(SIDE,'L')) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- UPPER = LSAME(UPLO,'U')
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 7
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 9
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 12
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSYMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSAME(SIDE,'L')) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- IF (UPPER) THEN
- DO 70 J = 1,N
- DO 60 I = 1,M
- TEMP1 = ALPHA*B(I,J)
- TEMP2 = ZERO
- DO 50 K = 1,I - 1
- C(K,J) = C(K,J) + TEMP1*A(K,I)
- TEMP2 = TEMP2 + B(K,J)*A(K,I)
- 50 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
- + ALPHA*TEMP2
- END IF
- 60 CONTINUE
- 70 CONTINUE
- ELSE
- DO 100 J = 1,N
- DO 90 I = M,1,-1
- TEMP1 = ALPHA*B(I,J)
- TEMP2 = ZERO
- DO 80 K = I + 1,M
- C(K,J) = C(K,J) + TEMP1*A(K,I)
- TEMP2 = TEMP2 + B(K,J)*A(K,I)
- 80 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
- + ALPHA*TEMP2
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form C := alpha*B*A + beta*C.
-*
- DO 170 J = 1,N
- TEMP1 = ALPHA*A(J,J)
- IF (BETA.EQ.ZERO) THEN
- DO 110 I = 1,M
- C(I,J) = TEMP1*B(I,J)
- 110 CONTINUE
- ELSE
- DO 120 I = 1,M
- C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
- 120 CONTINUE
- END IF
- DO 140 K = 1,J - 1
- IF (UPPER) THEN
- TEMP1 = ALPHA*A(K,J)
- ELSE
- TEMP1 = ALPHA*A(J,K)
- END IF
- DO 130 I = 1,M
- C(I,J) = C(I,J) + TEMP1*B(I,K)
- 130 CONTINUE
- 140 CONTINUE
- DO 160 K = J + 1,N
- IF (UPPER) THEN
- TEMP1 = ALPHA*A(J,K)
- ELSE
- TEMP1 = ALPHA*A(K,J)
- END IF
- DO 150 I = 1,M
- C(I,J) = C(I,J) + TEMP1*B(I,K)
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSYMM .
-*
- END
diff --git a/netlib/BLAS/ssymv.f b/netlib/BLAS/ssymv.f
deleted file mode 100644
index a43bd9b..0000000
--- a/netlib/BLAS/ssymv.f
+++ /dev/null
@@ -1,266 +0,0 @@
- SUBROUTINE SSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER INCX,INCY,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSYMV performs the matrix-vector operation
-*
-* y := alpha*A*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are n element vectors and
-* A is an n by n symmetric matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array A is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of A
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of A
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of A is not referenced.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y. On exit, Y is overwritten by the updated
-* vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 5
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- ELSE IF (INCY.EQ.0) THEN
- INFO = 10
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSYMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when A is stored in upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- DO 50 I = 1,J - 1
- Y(I) = Y(I) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(I)
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*A(J,J) + ALPHA*TEMP2
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- DO 70 I = 1,J - 1
- Y(IY) = Y(IY) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*A(J,J) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when A is stored in lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*A(J,J)
- DO 90 I = J + 1,N
- Y(I) = Y(I) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(I)
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*A(J,J)
- IX = JX
- IY = JY
- DO 110 I = J + 1,N
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + A(I,J)*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSYMV .
-*
- END
diff --git a/netlib/BLAS/ssyr.f b/netlib/BLAS/ssyr.f
deleted file mode 100644
index 1a54600..0000000
--- a/netlib/BLAS/ssyr.f
+++ /dev/null
@@ -1,202 +0,0 @@
- SUBROUTINE SSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER INCX,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSYR performs the symmetric rank 1 operation
-*
-* A := alpha*x*x**T + A,
-*
-* where alpha is a real scalar, x is an n element vector and A is an
-* n by n symmetric matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array A is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of A
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of A
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of A is not referenced. On exit, the
-* upper triangular part of the array A is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of A is not referenced. On exit, the
-* lower triangular part of the array A is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,KX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSYR ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set the start point in X if the increment is not unity.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when A is stored in upper triangle.
-*
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- DO 10 I = 1,J
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = KX
- DO 30 I = 1,J
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JX = JX + INCX
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when A is stored in lower triangle.
-*
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = ALPHA*X(J)
- DO 50 I = J,N
- A(I,J) = A(I,J) + X(I)*TEMP
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IX = JX
- DO 70 I = J,N
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSYR .
-*
- END
diff --git a/netlib/BLAS/ssyr2.f b/netlib/BLAS/ssyr2.f
deleted file mode 100644
index 545cfe5..0000000
--- a/netlib/BLAS/ssyr2.f
+++ /dev/null
@@ -1,233 +0,0 @@
- SUBROUTINE SSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER INCX,INCY,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSYR2 performs the symmetric rank 2 operation
-*
-* A := alpha*x*y**T + alpha*y*x**T + A,
-*
-* where alpha is a scalar, x and y are n element vectors and A is an n
-* by n symmetric matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array A is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of A
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of A
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of A is not referenced. On exit, the
-* upper triangular part of the array A is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of A is not referenced. On exit, the
-* lower triangular part of the array A is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSYR2 ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set up the start points in X and Y if the increments are not both
-* unity.
-*
- IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
- JX = KX
- JY = KY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when A is stored in the upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 20 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- DO 10 I = 1,J
- A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = KX
- IY = KY
- DO 30 I = 1,J
- A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 30 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when A is stored in the lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(J)
- TEMP2 = ALPHA*X(J)
- DO 50 I = J,N
- A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*Y(JY)
- TEMP2 = ALPHA*X(JX)
- IX = JX
- IY = JY
- DO 70 I = J,N
- A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- JY = JY + INCY
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSYR2 .
-*
- END
diff --git a/netlib/BLAS/ssyr2k.f b/netlib/BLAS/ssyr2k.f
deleted file mode 100644
index c9f44aa..0000000
--- a/netlib/BLAS/ssyr2k.f
+++ /dev/null
@@ -1,329 +0,0 @@
- SUBROUTINE SSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,N
- CHARACTER TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSYR2K performs one of the symmetric rank 2k operations
-*
-* C := alpha*A*B**T + alpha*B*A**T + beta*C,
-*
-* or
-*
-* C := alpha*A**T*B + alpha*B**T*A + beta*C,
-*
-* where alpha and beta are scalars, C is an n by n symmetric matrix
-* and A and B are n by k matrices in the first case and k by n
-* matrices in the second case.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array C is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of C
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of C
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' C := alpha*A*B**T + alpha*B*A**T +
-* beta*C.
-*
-* TRANS = 'T' or 't' C := alpha*A**T*B + alpha*B**T*A +
-* beta*C.
-*
-* TRANS = 'C' or 'c' C := alpha*A**T*B + alpha*B**T*A +
-* beta*C.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with TRANS = 'N' or 'n', K specifies the number
-* of columns of the matrices A and B, and on entry with
-* TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
-* of rows of the matrices A and B. K must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANS = 'N' or 'n', and is n otherwise.
-* Before entry with TRANS = 'N' or 'n', the leading n by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by n part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDA must be at least max( 1, n ), otherwise LDA must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* B - REAL array of DIMENSION ( LDB, kb ), where kb is
-* k when TRANS = 'N' or 'n', and is n otherwise.
-* Before entry with TRANS = 'N' or 'n', the leading n by k
-* part of the array B must contain the matrix B, otherwise
-* the leading k by n part of the array B must contain the
-* matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDB must be at least max( 1, n ), otherwise LDB must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* C - REAL array of DIMENSION ( LDC, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array C must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of C is not referenced. On exit, the
-* upper triangular part of the array C is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array C must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of C is not referenced. On exit, the
-* lower triangular part of the array C is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP1,TEMP2
- INTEGER I,INFO,J,L,NROWA
- LOGICAL UPPER
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Test the input parameters.
-*
- IF (LSAME(TRANS,'N')) THEN
- NROWA = N
- ELSE
- NROWA = K
- END IF
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 1
- ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
- + (.NOT.LSAME(TRANS,'T')) .AND.
- + (.NOT.LSAME(TRANS,'C'))) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (K.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 7
- ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDC.LT.MAX(1,N)) THEN
- INFO = 12
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSYR2K',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
- + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (UPPER) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,J
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,J
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- IF (BETA.EQ.ZERO) THEN
- DO 60 J = 1,N
- DO 50 I = J,N
- C(I,J) = ZERO
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 I = J,N
- C(I,J) = BETA*C(I,J)
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form C := alpha*A*B**T + alpha*B*A**T + C.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 90 I = 1,J
- C(I,J) = ZERO
- 90 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 100 I = 1,J
- C(I,J) = BETA*C(I,J)
- 100 CONTINUE
- END IF
- DO 120 L = 1,K
- IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
- TEMP1 = ALPHA*B(J,L)
- TEMP2 = ALPHA*A(J,L)
- DO 110 I = 1,J
- C(I,J) = C(I,J) + A(I,L)*TEMP1 +
- + B(I,L)*TEMP2
- 110 CONTINUE
- END IF
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 180 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 140 I = J,N
- C(I,J) = ZERO
- 140 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 150 I = J,N
- C(I,J) = BETA*C(I,J)
- 150 CONTINUE
- END IF
- DO 170 L = 1,K
- IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
- TEMP1 = ALPHA*B(J,L)
- TEMP2 = ALPHA*A(J,L)
- DO 160 I = J,N
- C(I,J) = C(I,J) + A(I,L)*TEMP1 +
- + B(I,L)*TEMP2
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- END IF
- ELSE
-*
-* Form C := alpha*A**T*B + alpha*B**T*A + C.
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- DO 200 I = 1,J
- TEMP1 = ZERO
- TEMP2 = ZERO
- DO 190 L = 1,K
- TEMP1 = TEMP1 + A(L,I)*B(L,J)
- TEMP2 = TEMP2 + B(L,I)*A(L,J)
- 190 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
- + ALPHA*TEMP2
- END IF
- 200 CONTINUE
- 210 CONTINUE
- ELSE
- DO 240 J = 1,N
- DO 230 I = J,N
- TEMP1 = ZERO
- TEMP2 = ZERO
- DO 220 L = 1,K
- TEMP1 = TEMP1 + A(L,I)*B(L,J)
- TEMP2 = TEMP2 + B(L,I)*A(L,J)
- 220 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
- ELSE
- C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
- + ALPHA*TEMP2
- END IF
- 230 CONTINUE
- 240 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSYR2K.
-*
- END
diff --git a/netlib/BLAS/ssyrk.f b/netlib/BLAS/ssyrk.f
deleted file mode 100644
index 33b7296..0000000
--- a/netlib/BLAS/ssyrk.f
+++ /dev/null
@@ -1,298 +0,0 @@
- SUBROUTINE SSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER K,LDA,LDC,N
- CHARACTER TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* SSYRK performs one of the symmetric rank k operations
-*
-* C := alpha*A*A**T + beta*C,
-*
-* or
-*
-* C := alpha*A**T*A + beta*C,
-*
-* where alpha and beta are scalars, C is an n by n symmetric matrix
-* and A is an n by k matrix in the first case and a k by n matrix
-* in the second case.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array C is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of C
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of C
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' C := alpha*A*A**T + beta*C.
-*
-* TRANS = 'T' or 't' C := alpha*A**T*A + beta*C.
-*
-* TRANS = 'C' or 'c' C := alpha*A**T*A + beta*C.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with TRANS = 'N' or 'n', K specifies the number
-* of columns of the matrix A, and on entry with
-* TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
-* of rows of the matrix A. K must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANS = 'N' or 'n', and is n otherwise.
-* Before entry with TRANS = 'N' or 'n', the leading n by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by n part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDA must be at least max( 1, n ), otherwise LDA must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* BETA - REAL .
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* C - REAL array of DIMENSION ( LDC, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array C must contain the upper
-* triangular part of the symmetric matrix and the strictly
-* lower triangular part of C is not referenced. On exit, the
-* upper triangular part of the array C is overwritten by the
-* upper triangular part of the updated matrix.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array C must contain the lower
-* triangular part of the symmetric matrix and the strictly
-* upper triangular part of C is not referenced. On exit, the
-* lower triangular part of the array C is overwritten by the
-* lower triangular part of the updated matrix.
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,J,L,NROWA
- LOGICAL UPPER
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Test the input parameters.
-*
- IF (LSAME(TRANS,'N')) THEN
- NROWA = N
- ELSE
- NROWA = K
- END IF
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 1
- ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
- + (.NOT.LSAME(TRANS,'T')) .AND.
- + (.NOT.LSAME(TRANS,'C'))) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (K.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 7
- ELSE IF (LDC.LT.MAX(1,N)) THEN
- INFO = 10
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SSYRK ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
- + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (UPPER) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,J
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,J
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- IF (BETA.EQ.ZERO) THEN
- DO 60 J = 1,N
- DO 50 I = J,N
- C(I,J) = ZERO
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 I = J,N
- C(I,J) = BETA*C(I,J)
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form C := alpha*A*A**T + beta*C.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 90 I = 1,J
- C(I,J) = ZERO
- 90 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 100 I = 1,J
- C(I,J) = BETA*C(I,J)
- 100 CONTINUE
- END IF
- DO 120 L = 1,K
- IF (A(J,L).NE.ZERO) THEN
- TEMP = ALPHA*A(J,L)
- DO 110 I = 1,J
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 110 CONTINUE
- END IF
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 180 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 140 I = J,N
- C(I,J) = ZERO
- 140 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 150 I = J,N
- C(I,J) = BETA*C(I,J)
- 150 CONTINUE
- END IF
- DO 170 L = 1,K
- IF (A(J,L).NE.ZERO) THEN
- TEMP = ALPHA*A(J,L)
- DO 160 I = J,N
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- END IF
- ELSE
-*
-* Form C := alpha*A**T*A + beta*C.
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- DO 200 I = 1,J
- TEMP = ZERO
- DO 190 L = 1,K
- TEMP = TEMP + A(L,I)*A(L,J)
- 190 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 200 CONTINUE
- 210 CONTINUE
- ELSE
- DO 240 J = 1,N
- DO 230 I = J,N
- TEMP = ZERO
- DO 220 L = 1,K
- TEMP = TEMP + A(L,I)*A(L,J)
- 220 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 230 CONTINUE
- 240 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSYRK .
-*
- END
diff --git a/netlib/BLAS/stbmv.f b/netlib/BLAS/stbmv.f
deleted file mode 100644
index 7446b4e..0000000
--- a/netlib/BLAS/stbmv.f
+++ /dev/null
@@ -1,336 +0,0 @@
- SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,K,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* STBMV performs one of the matrix-vector operations
-*
-* x := A*x, or x := A**T*x,
-*
-* where x is an n element vector and A is an n by n unit, or non-unit,
-* upper or lower triangular band matrix, with ( k + 1 ) diagonals.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with UPLO = 'U' or 'u', K specifies the number of
-* super-diagonals of the matrix A.
-* On entry with UPLO = 'L' or 'l', K specifies the number of
-* sub-diagonals of the matrix A.
-* K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer an upper
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer a lower
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Note that when DIAG = 'U' or 'u' the elements of the array A
-* corresponding to the diagonal elements of the matrix are not
-* referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 7
- ELSE IF (INCX.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- L = KPLUS1 - J
- DO 10 I = MAX(1,J-K),J - 1
- X(I) = X(I) + TEMP*A(L+I,J)
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J)
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- L = KPLUS1 - J
- DO 30 I = MAX(1,J-K),J - 1
- X(IX) = X(IX) + TEMP*A(L+I,J)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J)
- END IF
- JX = JX + INCX
- IF (J.GT.K) KX = KX + INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- L = 1 - J
- DO 50 I = MIN(N,J+K),J + 1,-1
- X(I) = X(I) + TEMP*A(L+I,J)
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(1,J)
- END IF
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- L = 1 - J
- DO 70 I = MIN(N,J+K),J + 1,-1
- X(IX) = X(IX) + TEMP*A(L+I,J)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(1,J)
- END IF
- JX = JX - INCX
- IF ((N-J).GE.K) KX = KX - INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- L = KPLUS1 - J
- IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
- DO 90 I = J - 1,MAX(1,J-K),-1
- TEMP = TEMP + A(L+I,J)*X(I)
- 90 CONTINUE
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- KX = KX - INCX
- IX = KX
- L = KPLUS1 - J
- IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
- DO 110 I = J - 1,MAX(1,J-K),-1
- TEMP = TEMP + A(L+I,J)*X(IX)
- IX = IX - INCX
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- L = 1 - J
- IF (NOUNIT) TEMP = TEMP*A(1,J)
- DO 130 I = J + 1,MIN(N,J+K)
- TEMP = TEMP + A(L+I,J)*X(I)
- 130 CONTINUE
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- KX = KX + INCX
- IX = KX
- L = 1 - J
- IF (NOUNIT) TEMP = TEMP*A(1,J)
- DO 150 I = J + 1,MIN(N,J+K)
- TEMP = TEMP + A(L+I,J)*X(IX)
- IX = IX + INCX
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STBMV .
-*
- END
diff --git a/netlib/BLAS/stbsv.f b/netlib/BLAS/stbsv.f
deleted file mode 100644
index d6d247e..0000000
--- a/netlib/BLAS/stbsv.f
+++ /dev/null
@@ -1,339 +0,0 @@
- SUBROUTINE STBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,K,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* STBSV solves one of the systems of equations
-*
-* A*x = b, or A**T*x = b,
-*
-* where b and x are n element vectors and A is an n by n unit, or
-* non-unit, upper or lower triangular band matrix, with ( k + 1 )
-* diagonals.
-*
-* No test for singularity or near-singularity is included in this
-* routine. Such tests must be performed before calling this routine.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A**T*x = b.
-*
-* TRANS = 'C' or 'c' A**T*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with UPLO = 'U' or 'u', K specifies the number of
-* super-diagonals of the matrix A.
-* On entry with UPLO = 'L' or 'l', K specifies the number of
-* sub-diagonals of the matrix A.
-* K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer an upper
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer a lower
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Note that when DIAG = 'U' or 'u' the elements of the array A
-* corresponding to the diagonal elements of the matrix are not
-* referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 7
- ELSE IF (INCX.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STBSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed by sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- L = KPLUS1 - J
- IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
- TEMP = X(J)
- DO 10 I = J - 1,MAX(1,J-K),-1
- X(I) = X(I) - TEMP*A(L+I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 40 J = N,1,-1
- KX = KX - INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = KPLUS1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
- TEMP = X(JX)
- DO 30 I = J - 1,MAX(1,J-K),-1
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX - INCX
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- L = 1 - J
- IF (NOUNIT) X(J) = X(J)/A(1,J)
- TEMP = X(J)
- DO 50 I = J + 1,MIN(N,J+K)
- X(I) = X(I) - TEMP*A(L+I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- KX = KX + INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = 1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(1,J)
- TEMP = X(JX)
- DO 70 I = J + 1,MIN(N,J+K)
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T)*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- L = KPLUS1 - J
- DO 90 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- L = KPLUS1 - J
- DO 110 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- X(JX) = TEMP
- JX = JX + INCX
- IF (J.GT.K) KX = KX + INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- L = 1 - J
- DO 130 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(I)
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- L = 1 - J
- DO 150 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- X(JX) = TEMP
- JX = JX - INCX
- IF ((N-J).GE.K) KX = KX - INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STBSV .
-*
- END
diff --git a/netlib/BLAS/stpmv.f b/netlib/BLAS/stpmv.f
deleted file mode 100644
index 573288e..0000000
--- a/netlib/BLAS/stpmv.f
+++ /dev/null
@@ -1,294 +0,0 @@
- SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL AP(*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* STPMV performs one of the matrix-vector operations
-*
-* x := A*x, or x := A**T*x,
-*
-* where x is an n element vector and A is an n by n unit, or non-unit,
-* upper or lower triangular matrix, supplied in packed form.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* AP - REAL array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
-* respectively, and so on.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
-* respectively, and so on.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,K,KK,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STPMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of AP are
-* accessed sequentially with one pass through AP.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x:= A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- K = KK
- DO 10 I = 1,J - 1
- X(I) = X(I) + TEMP*AP(K)
- K = K + 1
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*AP(KK+J-1)
- END IF
- KK = KK + J
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 30 K = KK,KK + J - 2
- X(IX) = X(IX) + TEMP*AP(K)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1)
- END IF
- JX = JX + INCX
- KK = KK + J
- 40 CONTINUE
- END IF
- ELSE
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- K = KK
- DO 50 I = N,J + 1,-1
- X(I) = X(I) + TEMP*AP(K)
- K = K - 1
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*AP(KK-N+J)
- END IF
- KK = KK - (N-J+1)
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 70 K = KK,KK - (N- (J+1)),-1
- X(IX) = X(IX) + TEMP*AP(K)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J)
- END IF
- JX = JX - INCX
- KK = KK - (N-J+1)
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- K = KK - 1
- DO 90 I = J - 1,1,-1
- TEMP = TEMP + AP(K)*X(I)
- K = K - 1
- 90 CONTINUE
- X(J) = TEMP
- KK = KK - J
- 100 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- DO 110 K = KK - 1,KK - J + 1,-1
- IX = IX - INCX
- TEMP = TEMP + AP(K)*X(IX)
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- KK = KK - J
- 120 CONTINUE
- END IF
- ELSE
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- K = KK + 1
- DO 130 I = J + 1,N
- TEMP = TEMP + AP(K)*X(I)
- K = K + 1
- 130 CONTINUE
- X(J) = TEMP
- KK = KK + (N-J+1)
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*AP(KK)
- DO 150 K = KK + 1,KK + N - J
- IX = IX + INCX
- TEMP = TEMP + AP(K)*X(IX)
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- KK = KK + (N-J+1)
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STPMV .
-*
- END
diff --git a/netlib/BLAS/stpsv.f b/netlib/BLAS/stpsv.f
deleted file mode 100644
index aca8a7f..0000000
--- a/netlib/BLAS/stpsv.f
+++ /dev/null
@@ -1,296 +0,0 @@
- SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL AP(*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* STPSV solves one of the systems of equations
-*
-* A*x = b, or A**T*x = b,
-*
-* where b and x are n element vectors and A is an n by n unit, or
-* non-unit, upper or lower triangular matrix, supplied in packed form.
-*
-* No test for singularity or near-singularity is included in this
-* routine. Such tests must be performed before calling this routine.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A**T*x = b.
-*
-* TRANS = 'C' or 'c' A**T*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* AP - REAL array of DIMENSION at least
-* ( ( n*( n + 1 ) )/2 ).
-* Before entry with UPLO = 'U' or 'u', the array AP must
-* contain the upper triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
-* respectively, and so on.
-* Before entry with UPLO = 'L' or 'l', the array AP must
-* contain the lower triangular matrix packed sequentially,
-* column by column, so that AP( 1 ) contains a( 1, 1 ),
-* AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
-* respectively, and so on.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,K,KK,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STPSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of AP are
-* accessed sequentially with one pass through AP.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/AP(KK)
- TEMP = X(J)
- K = KK - 1
- DO 10 I = J - 1,1,-1
- X(I) = X(I) - TEMP*AP(K)
- K = K - 1
- 10 CONTINUE
- END IF
- KK = KK - J
- 20 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 40 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/AP(KK)
- TEMP = X(JX)
- IX = JX
- DO 30 K = KK - 1,KK - J + 1,-1
- IX = IX - INCX
- X(IX) = X(IX) - TEMP*AP(K)
- 30 CONTINUE
- END IF
- JX = JX - INCX
- KK = KK - J
- 40 CONTINUE
- END IF
- ELSE
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/AP(KK)
- TEMP = X(J)
- K = KK + 1
- DO 50 I = J + 1,N
- X(I) = X(I) - TEMP*AP(K)
- K = K + 1
- 50 CONTINUE
- END IF
- KK = KK + (N-J+1)
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/AP(KK)
- TEMP = X(JX)
- IX = JX
- DO 70 K = KK + 1,KK + N - J
- IX = IX + INCX
- X(IX) = X(IX) - TEMP*AP(K)
- 70 CONTINUE
- END IF
- JX = JX + INCX
- KK = KK + (N-J+1)
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KK = 1
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- K = KK
- DO 90 I = 1,J - 1
- TEMP = TEMP - AP(K)*X(I)
- K = K + 1
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
- X(J) = TEMP
- KK = KK + J
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- DO 110 K = KK,KK + J - 2
- TEMP = TEMP - AP(K)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
- X(JX) = TEMP
- JX = JX + INCX
- KK = KK + J
- 120 CONTINUE
- END IF
- ELSE
- KK = (N* (N+1))/2
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- K = KK
- DO 130 I = N,J + 1,-1
- TEMP = TEMP - AP(K)*X(I)
- K = K - 1
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
- X(J) = TEMP
- KK = KK - (N-J+1)
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- DO 150 K = KK,KK - (N- (J+1)),-1
- TEMP = TEMP - AP(K)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
- X(JX) = TEMP
- JX = JX - INCX
- KK = KK - (N-J+1)
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STPSV .
-*
- END
diff --git a/netlib/BLAS/strmm.f b/netlib/BLAS/strmm.f
deleted file mode 100644
index 9d76a16..0000000
--- a/netlib/BLAS/strmm.f
+++ /dev/null
@@ -1,349 +0,0 @@
- SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*)
-* ..
-*
-* Purpose
-* =======
-*
-* STRMM performs one of the matrix-matrix operations
-*
-* B := alpha*op( A )*B, or B := alpha*B*op( A ),
-*
-* where alpha is a scalar, B is an m by n matrix, A is a unit, or
-* non-unit, upper or lower triangular matrix and op( A ) is one of
-*
-* op( A ) = A or op( A ) = A**T.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether op( A ) multiplies B from
-* the left or right as follows:
-*
-* SIDE = 'L' or 'l' B := alpha*op( A )*B.
-*
-* SIDE = 'R' or 'r' B := alpha*B*op( A ).
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix A is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n' op( A ) = A.
-*
-* TRANSA = 'T' or 't' op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c' op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit triangular
-* as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of B. M must be at
-* least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of B. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha. When alpha is
-* zero then A is not referenced and B need not be set before
-* entry.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, k ), where k is m
-* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
-* Before entry with UPLO = 'U' or 'u', the leading k by k
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading k by k
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-* then LDA must be at least max( 1, n ).
-* Unchanged on exit.
-*
-* B - REAL array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the matrix B, and on exit is overwritten by the
-* transformed matrix.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STRMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*A*B.
-*
- IF (UPPER) THEN
- DO 50 J = 1,N
- DO 40 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- TEMP = ALPHA*B(K,J)
- DO 30 I = 1,K - 1
- B(I,J) = B(I,J) + TEMP*A(I,K)
- 30 CONTINUE
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- B(K,J) = TEMP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- TEMP = ALPHA*B(K,J)
- B(K,J) = TEMP
- IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
- DO 60 I = K + 1,M
- B(I,J) = B(I,J) + TEMP*A(I,K)
- 60 CONTINUE
- END IF
- 70 CONTINUE
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*A**T*B.
-*
- IF (UPPER) THEN
- DO 110 J = 1,N
- DO 100 I = M,1,-1
- TEMP = B(I,J)
- IF (NOUNIT) TEMP = TEMP*A(I,I)
- DO 90 K = 1,I - 1
- TEMP = TEMP + A(K,I)*B(K,J)
- 90 CONTINUE
- B(I,J) = ALPHA*TEMP
- 100 CONTINUE
- 110 CONTINUE
- ELSE
- DO 140 J = 1,N
- DO 130 I = 1,M
- TEMP = B(I,J)
- IF (NOUNIT) TEMP = TEMP*A(I,I)
- DO 120 K = I + 1,M
- TEMP = TEMP + A(K,I)*B(K,J)
- 120 CONTINUE
- B(I,J) = ALPHA*TEMP
- 130 CONTINUE
- 140 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*A.
-*
- IF (UPPER) THEN
- DO 180 J = N,1,-1
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 150 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 150 CONTINUE
- DO 170 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- TEMP = ALPHA*A(K,J)
- DO 160 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- ELSE
- DO 220 J = 1,N
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 190 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 190 CONTINUE
- DO 210 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- TEMP = ALPHA*A(K,J)
- DO 200 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- 220 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*A**T.
-*
- IF (UPPER) THEN
- DO 260 K = 1,N
- DO 240 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = ALPHA*A(J,K)
- DO 230 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- IF (TEMP.NE.ONE) THEN
- DO 250 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- ELSE
- DO 300 K = N,1,-1
- DO 280 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = ALPHA*A(J,K)
- DO 270 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 270 CONTINUE
- END IF
- 280 CONTINUE
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- IF (TEMP.NE.ONE) THEN
- DO 290 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 290 CONTINUE
- END IF
- 300 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STRMM .
-*
- END
diff --git a/netlib/BLAS/strmv.f b/netlib/BLAS/strmv.f
deleted file mode 100644
index f20cfa2..0000000
--- a/netlib/BLAS/strmv.f
+++ /dev/null
@@ -1,282 +0,0 @@
- SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* STRMV performs one of the matrix-vector operations
-*
-* x := A*x, or x := A**T*x,
-*
-* where x is an n element vector and A is an n by n unit, or non-unit,
-* upper or lower triangular matrix.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STRMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- DO 10 I = 1,J - 1
- X(I) = X(I) + TEMP*A(I,J)
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(J,J)
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 30 I = 1,J - 1
- X(IX) = X(IX) + TEMP*A(I,J)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(J,J)
- END IF
- JX = JX + INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- DO 50 I = N,J + 1,-1
- X(I) = X(I) + TEMP*A(I,J)
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(J,J)
- END IF
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 70 I = N,J + 1,-1
- X(IX) = X(IX) + TEMP*A(I,J)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(J,J)
- END IF
- JX = JX - INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 90 I = J - 1,1,-1
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 110 I = J - 1,1,-1
- IX = IX - INCX
- TEMP = TEMP + A(I,J)*X(IX)
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 130 I = J + 1,N
- TEMP = TEMP + A(I,J)*X(I)
- 130 CONTINUE
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 150 I = J + 1,N
- IX = IX + INCX
- TEMP = TEMP + A(I,J)*X(IX)
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STRMV .
-*
- END
diff --git a/netlib/BLAS/strsm.f b/netlib/BLAS/strsm.f
deleted file mode 100644
index 8888069..0000000
--- a/netlib/BLAS/strsm.f
+++ /dev/null
@@ -1,376 +0,0 @@
- SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*)
-* ..
-*
-* Purpose
-* =======
-*
-* STRSM solves one of the matrix equations
-*
-* op( A )*X = alpha*B, or X*op( A ) = alpha*B,
-*
-* where alpha is a scalar, X and B are m by n matrices, A is a unit, or
-* non-unit, upper or lower triangular matrix and op( A ) is one of
-*
-* op( A ) = A or op( A ) = A**T.
-*
-* The matrix X is overwritten on B.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether op( A ) appears on the left
-* or right of X as follows:
-*
-* SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*
-* SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix A is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n' op( A ) = A.
-*
-* TRANSA = 'T' or 't' op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c' op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit triangular
-* as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of B. M must be at
-* least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of B. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* ALPHA - REAL .
-* On entry, ALPHA specifies the scalar alpha. When alpha is
-* zero then A is not referenced and B need not be set before
-* entry.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, k ), where k is m
-* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
-* Before entry with UPLO = 'U' or 'u', the leading k by k
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading k by k
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-* then LDA must be at least max( 1, n ).
-* Unchanged on exit.
-*
-* B - REAL array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the right-hand side matrix B, and on exit is
-* overwritten by the solution matrix X.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STRSM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*inv( A )*B.
-*
- IF (UPPER) THEN
- DO 60 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 30 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 30 CONTINUE
- END IF
- DO 50 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 40 I = 1,K - 1
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 40 CONTINUE
- END IF
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 100 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 70 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 70 CONTINUE
- END IF
- DO 90 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 80 I = K + 1,M
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 80 CONTINUE
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*inv( A**T )*B.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- DO 120 I = 1,M
- TEMP = ALPHA*B(I,J)
- DO 110 K = 1,I - 1
- TEMP = TEMP - A(K,I)*B(K,J)
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 160 J = 1,N
- DO 150 I = M,1,-1
- TEMP = ALPHA*B(I,J)
- DO 140 K = I + 1,M
- TEMP = TEMP - A(K,I)*B(K,J)
- 140 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 150 CONTINUE
- 160 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*inv( A ).
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 170 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 170 CONTINUE
- END IF
- DO 190 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- DO 180 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 180 CONTINUE
- END IF
- 190 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 200 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- ELSE
- DO 260 J = N,1,-1
- IF (ALPHA.NE.ONE) THEN
- DO 220 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 220 CONTINUE
- END IF
- DO 240 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- DO 230 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 250 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*inv( A**T ).
-*
- IF (UPPER) THEN
- DO 310 K = N,1,-1
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 270 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 270 CONTINUE
- END IF
- DO 290 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 280 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 280 CONTINUE
- END IF
- 290 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 300 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 300 CONTINUE
- END IF
- 310 CONTINUE
- ELSE
- DO 360 K = 1,N
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 320 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 320 CONTINUE
- END IF
- DO 340 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 330 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 330 CONTINUE
- END IF
- 340 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 350 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 350 CONTINUE
- END IF
- 360 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STRSM .
-*
- END
diff --git a/netlib/BLAS/strsv.f b/netlib/BLAS/strsv.f
deleted file mode 100644
index 02420fb..0000000
--- a/netlib/BLAS/strsv.f
+++ /dev/null
@@ -1,284 +0,0 @@
- SUBROUTINE STRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* STRSV solves one of the systems of equations
-*
-* A*x = b, or A**T*x = b,
-*
-* where b and x are n element vectors and A is an n by n unit, or
-* non-unit, upper or lower triangular matrix.
-*
-* No test for singularity or near-singularity is included in this
-* routine. Such tests must be performed before calling this routine.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A**T*x = b.
-*
-* TRANS = 'C' or 'c' A**T*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* A - REAL array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - REAL array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STRSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 10 I = J - 1,1,-1
- X(I) = X(I) - TEMP*A(I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 40 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 30 I = J - 1,1,-1
- IX = IX - INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 50 I = J + 1,N
- X(I) = X(I) - TEMP*A(I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 70 I = J + 1,N
- IX = IX + INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- DO 90 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- DO 110 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(JX) = TEMP
- JX = JX + INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- DO 130 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(I)
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- DO 150 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(JX) = TEMP
- JX = JX - INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STRSV .
-*
- END
diff --git a/netlib/BLAS/xerbla.f b/netlib/BLAS/xerbla.f
deleted file mode 100644
index 3a84150..0000000
--- a/netlib/BLAS/xerbla.f
+++ /dev/null
@@ -1,48 +0,0 @@
- SUBROUTINE XERBLA( SRNAME, INFO )
-*
-* -- LAPACK auxiliary routine (preliminary version) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2006
-*
-* .. Scalar Arguments ..
- CHARACTER*(*) SRNAME
- INTEGER INFO
-* ..
-*
-* Purpose
-* =======
-*
-* XERBLA is an error handler for the LAPACK routines.
-* It is called by an LAPACK routine if an input parameter has an
-* invalid value. A message is printed and execution stops.
-*
-* Installers may consider modifying the STOP statement in order to
-* call system-specific exception-handling facilities.
-*
-* Arguments
-* =========
-*
-* SRNAME (input) CHARACTER*(*)
-* The name of the routine which called XERBLA.
-*
-* INFO (input) INTEGER
-* The position of the invalid parameter in the parameter list
-* of the calling routine.
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC LEN_TRIM
-* ..
-* .. Executable Statements ..
-*
- WRITE( *, FMT = 9999 )SRNAME( 1:LEN_TRIM( SRNAME ) ), INFO
-*
- STOP
-*
- 9999 FORMAT( ' ** On entry to ', A, ' parameter number ', I2, ' had ',
- $ 'an illegal value' )
-*
-* End of XERBLA
-*
- END
diff --git a/netlib/CBLAS/cblas.h b/netlib/CBLAS/cblas.h
deleted file mode 100644
index f91557e..0000000
--- a/netlib/CBLAS/cblas.h
+++ /dev/null
@@ -1,575 +0,0 @@
-#ifndef CBLAS_H
-#define CBLAS_H
-#include <stddef.h>
-
-/*
- * Enumerated and derived types
- */
-#define CBLAS_INDEX size_t /* this may vary between platforms */
-
-enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102};
-enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113};
-enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
-enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
-enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*
- * ===========================================================================
- * Prototypes for level 1 BLAS functions (complex are recast as routines)
- * ===========================================================================
- */
-float cblas_sdsdot(const int N, const float alpha, const float *X,
- const int incX, const float *Y, const int incY);
-double cblas_dsdot(const int N, const float *X, const int incX, const float *Y,
- const int incY);
-float cblas_sdot(const int N, const float *X, const int incX,
- const float *Y, const int incY);
-double cblas_ddot(const int N, const double *X, const int incX,
- const double *Y, const int incY);
-
-/*
- * Functions having prefixes Z and C only
- */
-void cblas_cdotu_sub(const int N, const void *X, const int incX,
- const void *Y, const int incY, void *dotu);
-void cblas_cdotc_sub(const int N, const void *X, const int incX,
- const void *Y, const int incY, void *dotc);
-
-void cblas_zdotu_sub(const int N, const void *X, const int incX,
- const void *Y, const int incY, void *dotu);
-void cblas_zdotc_sub(const int N, const void *X, const int incX,
- const void *Y, const int incY, void *dotc);
-
-
-/*
- * Functions having prefixes S D SC DZ
- */
-float cblas_snrm2(const int N, const float *X, const int incX);
-float cblas_sasum(const int N, const float *X, const int incX);
-
-double cblas_dnrm2(const int N, const double *X, const int incX);
-double cblas_dasum(const int N, const double *X, const int incX);
-
-float cblas_scnrm2(const int N, const void *X, const int incX);
-float cblas_scasum(const int N, const void *X, const int incX);
-
-double cblas_dznrm2(const int N, const void *X, const int incX);
-double cblas_dzasum(const int N, const void *X, const int incX);
-
-
-/*
- * Functions having standard 4 prefixes (S D C Z)
- */
-CBLAS_INDEX cblas_isamax(const int N, const float *X, const int incX);
-CBLAS_INDEX cblas_idamax(const int N, const double *X, const int incX);
-CBLAS_INDEX cblas_icamax(const int N, const void *X, const int incX);
-CBLAS_INDEX cblas_izamax(const int N, const void *X, const int incX);
-
-/*
- * ===========================================================================
- * Prototypes for level 1 BLAS routines
- * ===========================================================================
- */
-
-/*
- * Routines with standard 4 prefixes (s, d, c, z)
- */
-void cblas_sswap(const int N, float *X, const int incX,
- float *Y, const int incY);
-void cblas_scopy(const int N, const float *X, const int incX,
- float *Y, const int incY);
-void cblas_saxpy(const int N, const float alpha, const float *X,
- const int incX, float *Y, const int incY);
-
-void cblas_dswap(const int N, double *X, const int incX,
- double *Y, const int incY);
-void cblas_dcopy(const int N, const double *X, const int incX,
- double *Y, const int incY);
-void cblas_daxpy(const int N, const double alpha, const double *X,
- const int incX, double *Y, const int incY);
-
-void cblas_cswap(const int N, void *X, const int incX,
- void *Y, const int incY);
-void cblas_ccopy(const int N, const void *X, const int incX,
- void *Y, const int incY);
-void cblas_caxpy(const int N, const void *alpha, const void *X,
- const int incX, void *Y, const int incY);
-
-void cblas_zswap(const int N, void *X, const int incX,
- void *Y, const int incY);
-void cblas_zcopy(const int N, const void *X, const int incX,
- void *Y, const int incY);
-void cblas_zaxpy(const int N, const void *alpha, const void *X,
- const int incX, void *Y, const int incY);
-
-
-/*
- * Routines with S and D prefix only
- */
-void cblas_srotg(float *a, float *b, float *c, float *s);
-void cblas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P);
-void cblas_srot(const int N, float *X, const int incX,
- float *Y, const int incY, const float c, const float s);
-void cblas_srotm(const int N, float *X, const int incX,
- float *Y, const int incY, const float *P);
-
-void cblas_drotg(double *a, double *b, double *c, double *s);
-void cblas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P);
-void cblas_drot(const int N, double *X, const int incX,
- double *Y, const int incY, const double c, const double s);
-void cblas_drotm(const int N, double *X, const int incX,
- double *Y, const int incY, const double *P);
-
-
-/*
- * Routines with S D C Z CS and ZD prefixes
- */
-void cblas_sscal(const int N, const float alpha, float *X, const int incX);
-void cblas_dscal(const int N, const double alpha, double *X, const int incX);
-void cblas_cscal(const int N, const void *alpha, void *X, const int incX);
-void cblas_zscal(const int N, const void *alpha, void *X, const int incX);
-void cblas_csscal(const int N, const float alpha, void *X, const int incX);
-void cblas_zdscal(const int N, const double alpha, void *X, const int incX);
-
-/*
- * ===========================================================================
- * Prototypes for level 2 BLAS
- * ===========================================================================
- */
-
-/*
- * Routines with standard 4 prefixes (S, D, C, Z)
- */
-void cblas_sgemv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const float alpha, const float *A, const int lda,
- const float *X, const int incX, const float beta,
- float *Y, const int incY);
-void cblas_sgbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const int KL, const int KU, const float alpha,
- const float *A, const int lda, const float *X,
- const int incX, const float beta, float *Y, const int incY);
-void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *A, const int lda,
- float *X, const int incX);
-void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const float *A, const int lda,
- float *X, const int incX);
-void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *Ap, float *X, const int incX);
-void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *A, const int lda, float *X,
- const int incX);
-void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const float *A, const int lda,
- float *X, const int incX);
-void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *Ap, float *X, const int incX);
-
-void cblas_dgemv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const double alpha, const double *A, const int lda,
- const double *X, const int incX, const double beta,
- double *Y, const int incY);
-void cblas_dgbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const int KL, const int KU, const double alpha,
- const double *A, const int lda, const double *X,
- const int incX, const double beta, double *Y, const int incY);
-void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *A, const int lda,
- double *X, const int incX);
-void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const double *A, const int lda,
- double *X, const int incX);
-void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *Ap, double *X, const int incX);
-void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *A, const int lda, double *X,
- const int incX);
-void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const double *A, const int lda,
- double *X, const int incX);
-void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *Ap, double *X, const int incX);
-
-void cblas_cgemv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- const void *X, const int incX, const void *beta,
- void *Y, const int incY);
-void cblas_cgbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const int KL, const int KU, const void *alpha,
- const void *A, const int lda, const void *X,
- const int incX, const void *beta, void *Y, const int incY);
-void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *A, const int lda,
- void *X, const int incX);
-void cblas_ctbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const void *A, const int lda,
- void *X, const int incX);
-void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *Ap, void *X, const int incX);
-void cblas_ctrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *A, const int lda, void *X,
- const int incX);
-void cblas_ctbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const void *A, const int lda,
- void *X, const int incX);
-void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *Ap, void *X, const int incX);
-
-void cblas_zgemv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- const void *X, const int incX, const void *beta,
- void *Y, const int incY);
-void cblas_zgbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const int KL, const int KU, const void *alpha,
- const void *A, const int lda, const void *X,
- const int incX, const void *beta, void *Y, const int incY);
-void cblas_ztrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *A, const int lda,
- void *X, const int incX);
-void cblas_ztbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const void *A, const int lda,
- void *X, const int incX);
-void cblas_ztpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *Ap, void *X, const int incX);
-void cblas_ztrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *A, const int lda, void *X,
- const int incX);
-void cblas_ztbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const void *A, const int lda,
- void *X, const int incX);
-void cblas_ztpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const void *Ap, void *X, const int incX);
-
-
-/*
- * Routines with S and D prefixes only
- */
-void cblas_ssymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *A,
- const int lda, const float *X, const int incX,
- const float beta, float *Y, const int incY);
-void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const int K, const float alpha, const float *A,
- const int lda, const float *X, const int incX,
- const float beta, float *Y, const int incY);
-void cblas_sspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *Ap,
- const float *X, const int incX,
- const float beta, float *Y, const int incY);
-void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
- const float alpha, const float *X, const int incX,
- const float *Y, const int incY, float *A, const int lda);
-void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, float *A, const int lda);
-void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, float *Ap);
-void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, const float *Y, const int incY, float *A,
- const int lda);
-void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, const float *Y, const int incY, float *A);
-
-void cblas_dsymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *A,
- const int lda, const double *X, const int incX,
- const double beta, double *Y, const int incY);
-void cblas_dsbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const int K, const double alpha, const double *A,
- const int lda, const double *X, const int incX,
- const double beta, double *Y, const int incY);
-void cblas_dspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *Ap,
- const double *X, const int incX,
- const double beta, double *Y, const int incY);
-void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
- const double alpha, const double *X, const int incX,
- const double *Y, const int incY, double *A, const int lda);
-void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, double *A, const int lda);
-void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, double *Ap);
-void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, const double *Y, const int incY, double *A,
- const int lda);
-void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, const double *Y, const int incY, double *A);
-
-
-/*
- * Routines with C and Z prefixes only
- */
-void cblas_chemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const void *alpha, const void *A,
- const int lda, const void *X, const int incX,
- const void *beta, void *Y, const int incY);
-void cblas_chbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const int K, const void *alpha, const void *A,
- const int lda, const void *X, const int incX,
- const void *beta, void *Y, const int incY);
-void cblas_chpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const void *alpha, const void *Ap,
- const void *X, const int incX,
- const void *beta, void *Y, const int incY);
-void cblas_cgeru(const enum CBLAS_ORDER order, const int M, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *A, const int lda);
-void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *A, const int lda);
-void cblas_cher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const void *X, const int incX,
- void *A, const int lda);
-void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const void *X,
- const int incX, void *A);
-void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *A, const int lda);
-void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *Ap);
-
-void cblas_zhemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const void *alpha, const void *A,
- const int lda, const void *X, const int incX,
- const void *beta, void *Y, const int incY);
-void cblas_zhbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const int K, const void *alpha, const void *A,
- const int lda, const void *X, const int incX,
- const void *beta, void *Y, const int incY);
-void cblas_zhpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const void *alpha, const void *Ap,
- const void *X, const int incX,
- const void *beta, void *Y, const int incY);
-void cblas_zgeru(const enum CBLAS_ORDER order, const int M, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *A, const int lda);
-void cblas_zgerc(const enum CBLAS_ORDER order, const int M, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *A, const int lda);
-void cblas_zher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const void *X, const int incX,
- void *A, const int lda);
-void cblas_zhpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const void *X,
- const int incX, void *A);
-void cblas_zher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *A, const int lda);
-void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
- const void *alpha, const void *X, const int incX,
- const void *Y, const int incY, void *Ap);
-
-/*
- * ===========================================================================
- * Prototypes for level 3 BLAS
- * ===========================================================================
- */
-
-/*
- * Routines with standard 4 prefixes (S, D, C, Z)
- */
-void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const float alpha, const float *A,
- const int lda, const float *B, const int ldb,
- const float beta, float *C, const int ldc);
-void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const float alpha, const float *A, const int lda,
- const float *B, const int ldb, const float beta,
- float *C, const int ldc);
-void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const float alpha, const float *A, const int lda,
- const float beta, float *C, const int ldc);
-void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const float alpha, const float *A, const int lda,
- const float *B, const int ldb, const float beta,
- float *C, const int ldc);
-void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const float alpha, const float *A, const int lda,
- float *B, const int ldb);
-void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const float alpha, const float *A, const int lda,
- float *B, const int ldb);
-
-void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const double alpha, const double *A,
- const int lda, const double *B, const int ldb,
- const double beta, double *C, const int ldc);
-void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const double alpha, const double *A, const int lda,
- const double *B, const int ldb, const double beta,
- double *C, const int ldc);
-void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const double alpha, const double *A, const int lda,
- const double beta, double *C, const int ldc);
-void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const double alpha, const double *A, const int lda,
- const double *B, const int ldb, const double beta,
- double *C, const int ldc);
-void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const double alpha, const double *A, const int lda,
- double *B, const int ldb);
-void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const double alpha, const double *A, const int lda,
- double *B, const int ldb);
-
-void cblas_cgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const void *alpha, const void *A,
- const int lda, const void *B, const int ldb,
- const void *beta, void *C, const int ldc);
-void cblas_csymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const void *beta,
- void *C, const int ldc);
-void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const void *alpha, const void *A, const int lda,
- const void *beta, void *C, const int ldc);
-void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const void *beta,
- void *C, const int ldc);
-void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- void *B, const int ldb);
-void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- void *B, const int ldb);
-
-void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const void *alpha, const void *A,
- const int lda, const void *B, const int ldb,
- const void *beta, void *C, const int ldc);
-void cblas_zsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const void *beta,
- void *C, const int ldc);
-void cblas_zsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const void *alpha, const void *A, const int lda,
- const void *beta, void *C, const int ldc);
-void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const void *beta,
- void *C, const int ldc);
-void cblas_ztrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- void *B, const int ldb);
-void cblas_ztrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- void *B, const int ldb);
-
-
-/*
- * Routines with prefixes C and Z only
- */
-void cblas_chemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const void *beta,
- void *C, const int ldc);
-void cblas_cherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const float alpha, const void *A, const int lda,
- const float beta, void *C, const int ldc);
-void cblas_cher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const float beta,
- void *C, const int ldc);
-
-void cblas_zhemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const void *beta,
- void *C, const int ldc);
-void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const double alpha, const void *A, const int lda,
- const double beta, void *C, const int ldc);
-void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const void *alpha, const void *A, const int lda,
- const void *B, const int ldb, const double beta,
- void *C, const int ldc);
-
-void cblas_xerbla(int p, const char *rout, const char *form, ...);
-
-#ifdef __cplusplus
-}
-#endif
-#endif
diff --git a/netlib/CBLAS/cblas_dasum.c b/netlib/CBLAS/cblas_dasum.c
deleted file mode 100644
index 1a3667f..0000000
--- a/netlib/CBLAS/cblas_dasum.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_dasum.c
- *
- * The program is a C interface to dasum.
- * It calls the fortran wrapper before calling dasum.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-double cblas_dasum( const int N, const double *X, const int incX)
-{
- double asum;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_dasum_sub( &F77_N, X, &F77_incX, &asum);
- return asum;
-}
diff --git a/netlib/CBLAS/cblas_daxpy.c b/netlib/CBLAS/cblas_daxpy.c
deleted file mode 100644
index 3678137..0000000
--- a/netlib/CBLAS/cblas_daxpy.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_daxpy.c
- *
- * The program is a C interface to daxpy.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_daxpy( const int N, const double alpha, const double *X,
- const int incX, double *Y, const int incY)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_daxpy( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY);
-}
diff --git a/netlib/CBLAS/cblas_dcopy.c b/netlib/CBLAS/cblas_dcopy.c
deleted file mode 100644
index 422a55e..0000000
--- a/netlib/CBLAS/cblas_dcopy.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_dcopy.c
- *
- * The program is a C interface to dcopy.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dcopy( const int N, const double *X,
- const int incX, double *Y, const int incY)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_dcopy( &F77_N, X, &F77_incX, Y, &F77_incY);
-}
diff --git a/netlib/CBLAS/cblas_ddot.c b/netlib/CBLAS/cblas_ddot.c
deleted file mode 100644
index d773434..0000000
--- a/netlib/CBLAS/cblas_ddot.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * cblas_ddot.c
- *
- * The program is a C interface to ddot.
- * It calls the fortran wrapper before calling ddot.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-double cblas_ddot( const int N, const double *X,
- const int incX, const double *Y, const int incY)
-{
- double dot;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_ddot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
- return dot;
-}
diff --git a/netlib/CBLAS/cblas_dgbmv.c b/netlib/CBLAS/cblas_dgbmv.c
deleted file mode 100644
index 33c481d..0000000
--- a/netlib/CBLAS/cblas_dgbmv.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*
- *
- * cblas_dgbmv.c
- * This program is a C interface to dgbmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dgbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const int KL, const int KU,
- const double alpha, const double *A, const int lda,
- const double *X, const int incX, const double beta,
- double *Y, const int incY)
-{
- char TA;
-#ifdef F77_CHAR
- F77_CHAR F77_TA;
-#else
- #define F77_TA &TA
-#endif
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
- F77_INT F77_KL=KL,F77_KU=KU;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_KL KL
- #define F77_KU KU
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_dgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, &alpha,
- A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_dgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha,
- A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_dgbmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
-}
diff --git a/netlib/CBLAS/cblas_dgemm.c b/netlib/CBLAS/cblas_dgemm.c
deleted file mode 100644
index d02ac16..0000000
--- a/netlib/CBLAS/cblas_dgemm.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*
- *
- * cblas_dgemm.c
- * This program is a C interface to dgemm.
- * Written by Keita Teranishi
- * 4/8/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const double alpha, const double *A,
- const int lda, const double *B, const int ldb,
- const double beta, double *C, const int ldc)
-{
- char TA, TB;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_TB;
-#else
- #define F77_TA &TA
- #define F77_TB &TB
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_ldb ldb
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if(TransA == CblasTrans) TA='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if(TransB == CblasTrans) TB='T';
- else if ( TransB == CblasConjTrans ) TB='C';
- else if ( TransB == CblasNoTrans ) TB='N';
- else
- {
- cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- F77_TB = C2F_CHAR(&TB);
- #endif
-
- F77_dgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A,
- &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if(TransA == CblasTrans) TB='T';
- else if ( TransA == CblasConjTrans ) TB='C';
- else if ( TransA == CblasNoTrans ) TB='N';
- else
- {
- cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if(TransB == CblasTrans) TA='T';
- else if ( TransB == CblasConjTrans ) TA='C';
- else if ( TransB == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- F77_TB = C2F_CHAR(&TB);
- #endif
-
- F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B,
- &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
- }
- else cblas_xerbla(1, "cblas_dgemm", "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dgemv.c b/netlib/CBLAS/cblas_dgemv.c
deleted file mode 100644
index 9062f3e..0000000
--- a/netlib/CBLAS/cblas_dgemv.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*
- *
- * cblas_dgemv.c
- * This program is a C interface to dgemv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dgemv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const double alpha, const double *A, const int lda,
- const double *X, const int incX, const double beta,
- double *Y, const int incY)
-{
- char TA;
-#ifdef F77_CHAR
- F77_CHAR F77_TA;
-#else
- #define F77_TA &TA
-#endif
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_dgemv(F77_TA, &F77_M, &F77_N, &alpha, A, &F77_lda, X, &F77_incX,
- &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_dgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_dgemv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dger.c b/netlib/CBLAS/cblas_dger.c
deleted file mode 100644
index b2b805b..0000000
--- a/netlib/CBLAS/cblas_dger.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- *
- * cblas_dger.c
- * This program is a C interface to dger.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
- const double alpha, const double *X, const int incX,
- const double *Y, const int incY, double *A, const int lda)
-{
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
- #define F77_lda lda
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- F77_dger( &F77_M, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
- &F77_lda);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- F77_dger( &F77_N, &F77_M ,&alpha, Y, &F77_incY, X, &F77_incX, A,
- &F77_lda);
-
- }
- else cblas_xerbla(1, "cblas_dger", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dnrm2.c b/netlib/CBLAS/cblas_dnrm2.c
deleted file mode 100644
index fe46ad4..0000000
--- a/netlib/CBLAS/cblas_dnrm2.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_dnrm2.c
- *
- * The program is a C interface to dnrm2.
- * It calls the fortranwrapper before calling dnrm2.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-double cblas_dnrm2( const int N, const double *X, const int incX)
-{
- double nrm2;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_dnrm2_sub( &F77_N, X, &F77_incX, &nrm2);
- return nrm2;
-}
diff --git a/netlib/CBLAS/cblas_drot.c b/netlib/CBLAS/cblas_drot.c
deleted file mode 100644
index 51dc4ad..0000000
--- a/netlib/CBLAS/cblas_drot.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_drot.c
- *
- * The program is a C interface to drot.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_drot(const int N, double *X, const int incX,
- double *Y, const int incY, const double c, const double s)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_drot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s);
- return;
-}
diff --git a/netlib/CBLAS/cblas_drotg.c b/netlib/CBLAS/cblas_drotg.c
deleted file mode 100644
index 0cbbd8b..0000000
--- a/netlib/CBLAS/cblas_drotg.c
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * cblas_drotg.c
- *
- * The program is a C interface to drotg.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_drotg( double *a, double *b, double *c, double *s)
-{
- F77_drotg(a,b,c,s);
-}
diff --git a/netlib/CBLAS/cblas_drotm.c b/netlib/CBLAS/cblas_drotm.c
deleted file mode 100644
index ebe20ad..0000000
--- a/netlib/CBLAS/cblas_drotm.c
+++ /dev/null
@@ -1,14 +0,0 @@
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_drotm( const int N, double *X, const int incX, double *Y,
- const int incY, const double *P)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_drotm( &F77_N, X, &F77_incX, Y, &F77_incY, P);
-}
diff --git a/netlib/CBLAS/cblas_drotmg.c b/netlib/CBLAS/cblas_drotmg.c
deleted file mode 100644
index 13a2208..0000000
--- a/netlib/CBLAS/cblas_drotmg.c
+++ /dev/null
@@ -1,15 +0,0 @@
-/*
- * cblas_drotmg.c
- *
- * The program is a C interface to drotmg.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_drotmg( double *d1, double *d2, double *b1,
- const double b2, double *p)
-{
- F77_drotmg(d1,d2,b1,&b2,p);
-}
diff --git a/netlib/CBLAS/cblas_dsbmv.c b/netlib/CBLAS/cblas_dsbmv.c
deleted file mode 100644
index 95b6182..0000000
--- a/netlib/CBLAS/cblas_dsbmv.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*
- *
- * cblas_dsbmv.c
- * This program is a C interface to dsbmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_UPLO Uplo, const int N, const int K,
- const double alpha, const double *A, const int lda,
- const double *X, const int incX, const double beta,
- double *Y, const int incY)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha,
- A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_dsbmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dscal.c b/netlib/CBLAS/cblas_dscal.c
deleted file mode 100644
index bd04de7..0000000
--- a/netlib/CBLAS/cblas_dscal.c
+++ /dev/null
@@ -1,21 +0,0 @@
-/*
- * cblas_dscal.c
- *
- * The program is a C interface to dscal.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dscal( const int N, const double alpha, double *X,
- const int incX)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_dscal( &F77_N, &alpha, X, &F77_incX);
-}
diff --git a/netlib/CBLAS/cblas_dsdot.c b/netlib/CBLAS/cblas_dsdot.c
deleted file mode 100644
index 52cd877..0000000
--- a/netlib/CBLAS/cblas_dsdot.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * cblas_dsdot.c
- *
- * The program is a C interface to dsdot.
- * It calls fthe fortran wrapper before calling dsdot.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-double cblas_dsdot( const int N, const float *X,
- const int incX, const float *Y, const int incY)
-{
- double dot;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_dsdot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
- return dot;
-}
diff --git a/netlib/CBLAS/cblas_dspmv.c b/netlib/CBLAS/cblas_dspmv.c
deleted file mode 100644
index dd1544f..0000000
--- a/netlib/CBLAS/cblas_dspmv.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- *
- * cblas_dspmv.c
- * This program is a C interface to dspmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dspmv(const enum CBLAS_ORDER order,
- const enum CBLAS_UPLO Uplo, const int N,
- const double alpha, const double *AP,
- const double *X, const int incX, const double beta,
- double *Y, const int incY)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dspmv(F77_UL, &F77_N, &alpha, AP, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dspmv(F77_UL, &F77_N, &alpha,
- AP, X,&F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_dspmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dspr.c b/netlib/CBLAS/cblas_dspr.c
deleted file mode 100644
index c630039..0000000
--- a/netlib/CBLAS/cblas_dspr.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*
- *
- * cblas_dspr.c
- * This program is a C interface to dspr.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, double *Ap)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
- } else cblas_xerbla(1, "cblas_dspr", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dspr2.c b/netlib/CBLAS/cblas_dspr2.c
deleted file mode 100644
index 4f1e780..0000000
--- a/netlib/CBLAS/cblas_dspr2.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*
- * cblas_dspr2.c
- * The program is a C interface to dspr2.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, const double *Y, const int incY, double *A)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
- } else cblas_xerbla(1, "cblas_dspr2", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dswap.c b/netlib/CBLAS/cblas_dswap.c
deleted file mode 100644
index 9ae5bb9..0000000
--- a/netlib/CBLAS/cblas_dswap.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_dswap.c
- *
- * The program is a C interface to dswap.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dswap( const int N, double *X, const int incX, double *Y,
- const int incY)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_dswap( &F77_N, X, &F77_incX, Y, &F77_incY);
-}
diff --git a/netlib/CBLAS/cblas_dsymm.c b/netlib/CBLAS/cblas_dsymm.c
deleted file mode 100644
index 8b50e9a..0000000
--- a/netlib/CBLAS/cblas_dsymm.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*
- *
- * cblas_dsymm.c
- * This program is a C interface to dsymm.
- * Written by Keita Teranishi
- * 4/8/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const double alpha, const double *A, const int lda,
- const double *B, const int ldb, const double beta,
- double *C, const int ldc)
-{
- char SD, UL;
-#ifdef F77_CHAR
- F77_CHAR F77_SD, F77_UL;
-#else
- #define F77_SD &SD
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_ldb ldb
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if( Side == CblasRight) SD='R';
- else if ( Side == CblasLeft ) SD='L';
- else
- {
- cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_SD = C2F_CHAR(&SD);
- #endif
-
- F77_dsymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda,
- B, &F77_ldb, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Side == CblasRight) SD='L';
- else if ( Side == CblasLeft ) SD='R';
- else
- {
- cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_SD = C2F_CHAR(&SD);
- #endif
-
- F77_dsymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B,
- &F77_ldb, &beta, C, &F77_ldc);
- }
- else cblas_xerbla(1, "cblas_dsymm","Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dsymv.c b/netlib/CBLAS/cblas_dsymv.c
deleted file mode 100644
index 020adc9..0000000
--- a/netlib/CBLAS/cblas_dsymv.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- *
- * cblas_dsymv.c
- * This program is a C interface to dsymv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsymv(const enum CBLAS_ORDER order,
- const enum CBLAS_UPLO Uplo, const int N,
- const double alpha, const double *A, const int lda,
- const double *X, const int incX, const double beta,
- double *Y, const int incY)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dsymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dsymv(F77_UL, &F77_N, &alpha,
- A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_dsymv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dsyr.c b/netlib/CBLAS/cblas_dsyr.c
deleted file mode 100644
index 0d20083..0000000
--- a/netlib/CBLAS/cblas_dsyr.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
- *
- * cblas_dsyr.c
- * This program is a C interface to dsyr.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, double *A, const int lda)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_lda=lda;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_lda lda
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
- } else cblas_xerbla(1, "cblas_dsyr", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dsyr2.c b/netlib/CBLAS/cblas_dsyr2.c
deleted file mode 100644
index fe4a292..0000000
--- a/netlib/CBLAS/cblas_dsyr2.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- *
- * cblas_dsyr2.c
- * This program is a C interface to dsyr2.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const double alpha, const double *X,
- const int incX, const double *Y, const int incY, double *A,
- const int lda)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77__lda=lda;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
- #define F77_lda lda
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
- &F77_lda);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
- &F77_lda);
- } else cblas_xerbla(1, "cblas_dsyr2", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dsyr2k.c b/netlib/CBLAS/cblas_dsyr2k.c
deleted file mode 100644
index e50dc11..0000000
--- a/netlib/CBLAS/cblas_dsyr2k.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*
- *
- * cblas_dsyr2k.c
- * This program is a C interface to dsyr2k.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const double alpha, const double *A, const int lda,
- const double *B, const int ldb, const double beta,
- double *C, const int ldc)
-{
- char UL, TR;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL;
-#else
- #define F77_TR &TR
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_ldb ldb
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
-
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(2, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Trans == CblasTrans) TR ='T';
- else if ( Trans == CblasConjTrans ) TR='C';
- else if ( Trans == CblasNoTrans ) TR='N';
- else
- {
- cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
- B, &F77_ldb, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Trans == CblasTrans) TR ='N';
- else if ( Trans == CblasConjTrans ) TR='N';
- else if ( Trans == CblasNoTrans ) TR='T';
- else
- {
- cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B,
- &F77_ldb, &beta, C, &F77_ldc);
- }
- else cblas_xerbla(1, "cblas_dsyr2k","Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dsyrk.c b/netlib/CBLAS/cblas_dsyrk.c
deleted file mode 100644
index 469f930..0000000
--- a/netlib/CBLAS/cblas_dsyrk.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*
- *
- * cblas_dsyrk.c
- * This program is a C interface to dsyrk.
- * Written by Keita Teranishi
- * 4/8/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const double alpha, const double *A, const int lda,
- const double beta, double *C, const int ldc)
-{
- char UL, TR;
-#ifdef F77_CHAR
- F77_CHAR F77_TR, F77_UL;
-#else
- #define F77_TR &TR
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_K=K, F77_lda=lda;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
-
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(2, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Trans == CblasTrans) TR ='T';
- else if ( Trans == CblasConjTrans ) TR='C';
- else if ( Trans == CblasNoTrans ) TR='N';
- else
- {
- cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
- &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Trans == CblasTrans) TR ='N';
- else if ( Trans == CblasConjTrans ) TR='N';
- else if ( Trans == CblasNoTrans ) TR='T';
- else
- {
- cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
- &beta, C, &F77_ldc);
- }
- else cblas_xerbla(1, "cblas_dsyrk","Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
-
diff --git a/netlib/CBLAS/cblas_dtbmv.c b/netlib/CBLAS/cblas_dtbmv.c
deleted file mode 100644
index 491f11d..0000000
--- a/netlib/CBLAS/cblas_dtbmv.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*
- * cblas_dtbmv.c
- * The program is a C interface to dtbmv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const double *A, const int lda,
- double *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
-
- }
- else cblas_xerbla(1, "cblas_dtbmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
-}
diff --git a/netlib/CBLAS/cblas_dtbsv.c b/netlib/CBLAS/cblas_dtbsv.c
deleted file mode 100644
index 664822f..0000000
--- a/netlib/CBLAS/cblas_dtbsv.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*
- * cblas_dtbsv.c
- * The program is a C interface to dtbsv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const double *A, const int lda,
- double *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else cblas_xerbla(1, "cblas_dtbsv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dtpmv.c b/netlib/CBLAS/cblas_dtpmv.c
deleted file mode 100644
index 5b96a2b..0000000
--- a/netlib/CBLAS/cblas_dtpmv.c
+++ /dev/null
@@ -1,117 +0,0 @@
-/*
- * cblas_dtpmv.c
- * The program is a C interface to dtpmv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *Ap, double *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
- }
- else cblas_xerbla(1, "cblas_dtpmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dtpsv.c b/netlib/CBLAS/cblas_dtpsv.c
deleted file mode 100644
index 5555c21..0000000
--- a/netlib/CBLAS/cblas_dtpsv.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/*
- * cblas_dtpsv.c
- * The program is a C interface to dtpsv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *Ap, double *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
-
- }
- else cblas_xerbla(1, "cblas_dtpsv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dtrmm.c b/netlib/CBLAS/cblas_dtrmm.c
deleted file mode 100644
index 32a5d2b..0000000
--- a/netlib/CBLAS/cblas_dtrmm.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/*
- *
- * cblas_dtrmm.c
- * This program is a C interface to dtrmm.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const double alpha, const double *A, const int lda,
- double *B, const int ldb)
-{
- char UL, TA, SD, DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_SD &SD
- #define F77_DI &DI
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_ldb ldb
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if( Side == CblasRight) SD='R';
- else if ( Side == CblasLeft ) SD='L';
- else
- {
- cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( TransA == CblasTrans) TA ='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit ) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Side == CblasRight) SD='L';
- else if ( Side == CblasLeft ) SD='R';
- else
- {
- cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( TransA == CblasTrans) TA ='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit ) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb);
- }
- else cblas_xerbla(1, "cblas_dtrmm", "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dtrmv.c b/netlib/CBLAS/cblas_dtrmv.c
deleted file mode 100644
index cce1507..0000000
--- a/netlib/CBLAS/cblas_dtrmv.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*
- *
- * cblas_dtrmv.c
- * This program is a C interface to sgemv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *A, const int lda,
- double *X, const int incX)
-
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- } else cblas_xerbla(1, "cblas_dtrmv", "Illegal order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dtrsm.c b/netlib/CBLAS/cblas_dtrsm.c
deleted file mode 100644
index 4f47cb1..0000000
--- a/netlib/CBLAS/cblas_dtrsm.c
+++ /dev/null
@@ -1,153 +0,0 @@
-/*
- *
- * cblas_dtrsm.c
- * This program is a C interface to dtrsm.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const double alpha, const double *A, const int lda,
- double *B, const int ldb)
-
-{
- char UL, TA, SD, DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_SD &SD
- #define F77_DI &DI
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_ldb ldb
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if ( Side == CblasRight) SD='R';
- else if ( Side == CblasLeft ) SD='L';
- else
- {
- cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if ( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower) UL='L';
- else
- {
- cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if ( TransA == CblasTrans ) TA='T';
- else if ( TransA == CblasConjTrans) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if ( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha,
- A, &F77_lda, B, &F77_ldb);
- }
- else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if ( Side == CblasRight) SD='L';
- else if ( Side == CblasLeft ) SD='R';
- else
- {
- cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if ( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if ( TransA == CblasTrans ) TA='T';
- else if ( TransA == CblasConjTrans) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if ( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
- &F77_lda, B, &F77_ldb);
- }
- else cblas_xerbla(1, "cblas_dtrsm","Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dtrsv.c b/netlib/CBLAS/cblas_dtrsv.c
deleted file mode 100644
index 7299d17..0000000
--- a/netlib/CBLAS/cblas_dtrsv.c
+++ /dev/null
@@ -1,121 +0,0 @@
-/*
- * cblas_dtrsv.c
- * The program is a C interface to dtrsv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const double *A, const int lda, double *X,
- const int incX)
-
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else cblas_xerbla(1, "cblas_dtrsv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_dzasum.c b/netlib/CBLAS/cblas_dzasum.c
deleted file mode 100644
index b32f573..0000000
--- a/netlib/CBLAS/cblas_dzasum.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_dzasum.c
- *
- * The program is a C interface to dzasum.
- * It calls the fortran wrapper before calling dzasum.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-double cblas_dzasum( const int N, const void *X, const int incX)
-{
- double asum;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_dzasum_sub( &F77_N, X, &F77_incX, &asum);
- return asum;
-}
diff --git a/netlib/CBLAS/cblas_dznrm2.c b/netlib/CBLAS/cblas_dznrm2.c
deleted file mode 100644
index dfa2bfc..0000000
--- a/netlib/CBLAS/cblas_dznrm2.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_dznrm2.c
- *
- * The program is a C interface to dznrm2.
- * It calls the fortran wrapper before calling dznrm2.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-double cblas_dznrm2( const int N, const void *X, const int incX)
-{
- double nrm2;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_dznrm2_sub( &F77_N, X, &F77_incX, &nrm2);
- return nrm2;
-}
diff --git a/netlib/CBLAS/cblas_f77.h b/netlib/CBLAS/cblas_f77.h
deleted file mode 100644
index 18435cd..0000000
--- a/netlib/CBLAS/cblas_f77.h
+++ /dev/null
@@ -1,701 +0,0 @@
-/*
- * cblas_f77.h
- * Written by Keita Teranishi
- *
- * Updated by Jeff Horner
- * Merged cblas_f77.h and cblas_fortran_header.h
- */
-
-#ifndef CBLAS_F77_H
-#define CBLAS_f77_H
-
-#ifdef CRAY
- #include <fortran.h>
- #define F77_CHAR _fcd
- #define C2F_CHAR(a) ( _cptofcd( (a), 1 ) )
- #define C2F_STR(a, i) ( _cptofcd( (a), (i) ) )
- #define F77_STRLEN(a) (_fcdlen)
-#endif
-
-#ifdef WeirdNEC
- #define F77_INT long
-#endif
-
-#ifdef F77_CHAR
- #define FCHAR F77_CHAR
-#else
- #define FCHAR char *
-#endif
-
-#ifdef F77_INT
- #define FINT const F77_INT *
- #define FINT2 F77_INT *
-#else
- #define FINT const int *
- #define FINT2 int *
-#endif
-
-#if defined(ADD_)
-/*
- * Level 1 BLAS
- */
-#define F77_xerbla xerbla_
- #define F77_srotg srotg_
- #define F77_srotmg srotmg_
- #define F77_srot srot_
- #define F77_srotm srotm_
- #define F77_drotg drotg_
- #define F77_drotmg drotmg_
- #define F77_drot drot_
- #define F77_drotm drotm_
- #define F77_sswap sswap_
- #define F77_scopy scopy_
- #define F77_saxpy saxpy_
- #define F77_isamax_sub isamaxsub_
- #define F77_dswap dswap_
- #define F77_dcopy dcopy_
- #define F77_daxpy daxpy_
- #define F77_idamax_sub idamaxsub_
- #define F77_cswap cswap_
- #define F77_ccopy ccopy_
- #define F77_caxpy caxpy_
- #define F77_icamax_sub icamaxsub_
- #define F77_zswap zswap_
- #define F77_zcopy zcopy_
- #define F77_zaxpy zaxpy_
- #define F77_izamax_sub izamaxsub_
- #define F77_sdot_sub sdotsub_
- #define F77_ddot_sub ddotsub_
- #define F77_dsdot_sub dsdotsub_
- #define F77_sscal sscal_
- #define F77_dscal dscal_
- #define F77_cscal cscal_
- #define F77_zscal zscal_
- #define F77_csscal csscal_
- #define F77_zdscal zdscal_
- #define F77_cdotu_sub cdotusub_
- #define F77_cdotc_sub cdotcsub_
- #define F77_zdotu_sub zdotusub_
- #define F77_zdotc_sub zdotcsub_
- #define F77_snrm2_sub snrm2sub_
- #define F77_sasum_sub sasumsub_
- #define F77_dnrm2_sub dnrm2sub_
- #define F77_dasum_sub dasumsub_
- #define F77_scnrm2_sub scnrm2sub_
- #define F77_scasum_sub scasumsub_
- #define F77_dznrm2_sub dznrm2sub_
- #define F77_dzasum_sub dzasumsub_
- #define F77_sdsdot_sub sdsdotsub_
-/*
- * Level 2 BLAS
- */
- #define F77_ssymv ssymv_
- #define F77_ssbmv ssbmv_
- #define F77_sspmv sspmv_
- #define F77_sger sger_
- #define F77_ssyr ssyr_
- #define F77_sspr sspr_
- #define F77_ssyr2 ssyr2_
- #define F77_sspr2 sspr2_
- #define F77_dsymv dsymv_
- #define F77_dsbmv dsbmv_
- #define F77_dspmv dspmv_
- #define F77_dger dger_
- #define F77_dsyr dsyr_
- #define F77_dspr dspr_
- #define F77_dsyr2 dsyr2_
- #define F77_dspr2 dspr2_
- #define F77_chemv chemv_
- #define F77_chbmv chbmv_
- #define F77_chpmv chpmv_
- #define F77_cgeru cgeru_
- #define F77_cgerc cgerc_
- #define F77_cher cher_
- #define F77_chpr chpr_
- #define F77_cher2 cher2_
- #define F77_chpr2 chpr2_
- #define F77_zhemv zhemv_
- #define F77_zhbmv zhbmv_
- #define F77_zhpmv zhpmv_
- #define F77_zgeru zgeru_
- #define F77_zgerc zgerc_
- #define F77_zher zher_
- #define F77_zhpr zhpr_
- #define F77_zher2 zher2_
- #define F77_zhpr2 zhpr2_
- #define F77_sgemv sgemv_
- #define F77_sgbmv sgbmv_
- #define F77_strmv strmv_
- #define F77_stbmv stbmv_
- #define F77_stpmv stpmv_
- #define F77_strsv strsv_
- #define F77_stbsv stbsv_
- #define F77_stpsv stpsv_
- #define F77_dgemv dgemv_
- #define F77_dgbmv dgbmv_
- #define F77_dtrmv dtrmv_
- #define F77_dtbmv dtbmv_
- #define F77_dtpmv dtpmv_
- #define F77_dtrsv dtrsv_
- #define F77_dtbsv dtbsv_
- #define F77_dtpsv dtpsv_
- #define F77_cgemv cgemv_
- #define F77_cgbmv cgbmv_
- #define F77_ctrmv ctrmv_
- #define F77_ctbmv ctbmv_
- #define F77_ctpmv ctpmv_
- #define F77_ctrsv ctrsv_
- #define F77_ctbsv ctbsv_
- #define F77_ctpsv ctpsv_
- #define F77_zgemv zgemv_
- #define F77_zgbmv zgbmv_
- #define F77_ztrmv ztrmv_
- #define F77_ztbmv ztbmv_
- #define F77_ztpmv ztpmv_
- #define F77_ztrsv ztrsv_
- #define F77_ztbsv ztbsv_
- #define F77_ztpsv ztpsv_
-/*
- * Level 3 BLAS
- */
- #define F77_chemm chemm_
- #define F77_cherk cherk_
- #define F77_cher2k cher2k_
- #define F77_zhemm zhemm_
- #define F77_zherk zherk_
- #define F77_zher2k zher2k_
- #define F77_sgemm sgemm_
- #define F77_ssymm ssymm_
- #define F77_ssyrk ssyrk_
- #define F77_ssyr2k ssyr2k_
- #define F77_strmm strmm_
- #define F77_strsm strsm_
- #define F77_dgemm dgemm_
- #define F77_dsymm dsymm_
- #define F77_dsyrk dsyrk_
- #define F77_dsyr2k dsyr2k_
- #define F77_dtrmm dtrmm_
- #define F77_dtrsm dtrsm_
- #define F77_cgemm cgemm_
- #define F77_csymm csymm_
- #define F77_csyrk csyrk_
- #define F77_csyr2k csyr2k_
- #define F77_ctrmm ctrmm_
- #define F77_ctrsm ctrsm_
- #define F77_zgemm zgemm_
- #define F77_zsymm zsymm_
- #define F77_zsyrk zsyrk_
- #define F77_zsyr2k zsyr2k_
- #define F77_ztrmm ztrmm_
- #define F77_ztrsm ztrsm_
-#elif defined(UPCASE)
-/*
- * Level 1 BLAS
- */
-#define F77_xerbla XERBLA
- #define F77_srotg SROTG
- #define F77_srotmg SROTMG
- #define F77_srot SROT
- #define F77_srotm SROTM
- #define F77_drotg DROTG
- #define F77_drotmg DROTMG
- #define F77_drot DROT
- #define F77_drotm DROTM
- #define F77_sswap SSWAP
- #define F77_scopy SCOPY
- #define F77_saxpy SAXPY
- #define F77_isamax_sub ISAMAXSUB
- #define F77_dswap DSWAP
- #define F77_dcopy DCOPY
- #define F77_daxpy DAXPY
- #define F77_idamax_sub IDAMAXSUB
- #define F77_cswap CSWAP
- #define F77_ccopy CCOPY
- #define F77_caxpy CAXPY
- #define F77_icamax_sub ICAMAXSUB
- #define F77_zswap ZSWAP
- #define F77_zcopy ZCOPY
- #define F77_zaxpy ZAXPY
- #define F77_izamax_sub IZAMAXSUB
- #define F77_sdot_sub SDOTSUB
- #define F77_ddot_sub DDOTSUB
- #define F77_dsdot_sub DSDOTSUB
- #define F77_sscal SSCAL
- #define F77_dscal DSCAL
- #define F77_cscal CSCAL
- #define F77_zscal ZSCAL
- #define F77_csscal CSSCAL
- #define F77_zdscal ZDSCAL
- #define F77_cdotu_sub CDOTUSUB
- #define F77_cdotc_sub CDOTCSUB
- #define F77_zdotu_sub ZDOTUSUB
- #define F77_zdotc_sub ZDOTCSUB
- #define F77_snrm2_sub SNRM2SUB
- #define F77_sasum_sub SASUMSUB
- #define F77_dnrm2_sub DNRM2SUB
- #define F77_dasum_sub DASUMSUB
- #define F77_scnrm2_sub SCNRM2SUB
- #define F77_scasum_sub SCASUMSUB
- #define F77_dznrm2_sub DZNRM2SUB
- #define F77_dzasum_sub DZASUMSUB
- #define F77_sdsdot_sub SDSDOTSUB
-/*
- * Level 2 BLAS
- */
- #define F77_ssymv SSYMV
- #define F77_ssbmv SSBMV
- #define F77_sspmv SSPMV
- #define F77_sger SGER
- #define F77_ssyr SSYR
- #define F77_sspr SSPR
- #define F77_ssyr2 SSYR2
- #define F77_sspr2 SSPR2
- #define F77_dsymv DSYMV
- #define F77_dsbmv DSBMV
- #define F77_dspmv DSPMV
- #define F77_dger DGER
- #define F77_dsyr DSYR
- #define F77_dspr DSPR
- #define F77_dsyr2 DSYR2
- #define F77_dspr2 DSPR2
- #define F77_chemv CHEMV
- #define F77_chbmv CHBMV
- #define F77_chpmv CHPMV
- #define F77_cgeru CGERU
- #define F77_cgerc CGERC
- #define F77_cher CHER
- #define F77_chpr CHPR
- #define F77_cher2 CHER2
- #define F77_chpr2 CHPR2
- #define F77_zhemv ZHEMV
- #define F77_zhbmv ZHBMV
- #define F77_zhpmv ZHPMV
- #define F77_zgeru ZGERU
- #define F77_zgerc ZGERC
- #define F77_zher ZHER
- #define F77_zhpr ZHPR
- #define F77_zher2 ZHER2
- #define F77_zhpr2 ZHPR2
- #define F77_sgemv SGEMV
- #define F77_sgbmv SGBMV
- #define F77_strmv STRMV
- #define F77_stbmv STBMV
- #define F77_stpmv STPMV
- #define F77_strsv STRSV
- #define F77_stbsv STBSV
- #define F77_stpsv STPSV
- #define F77_dgemv DGEMV
- #define F77_dgbmv DGBMV
- #define F77_dtrmv DTRMV
- #define F77_dtbmv DTBMV
- #define F77_dtpmv DTPMV
- #define F77_dtrsv DTRSV
- #define F77_dtbsv DTBSV
- #define F77_dtpsv DTPSV
- #define F77_cgemv CGEMV
- #define F77_cgbmv CGBMV
- #define F77_ctrmv CTRMV
- #define F77_ctbmv CTBMV
- #define F77_ctpmv CTPMV
- #define F77_ctrsv CTRSV
- #define F77_ctbsv CTBSV
- #define F77_ctpsv CTPSV
- #define F77_zgemv ZGEMV
- #define F77_zgbmv ZGBMV
- #define F77_ztrmv ZTRMV
- #define F77_ztbmv ZTBMV
- #define F77_ztpmv ZTPMV
- #define F77_ztrsv ZTRSV
- #define F77_ztbsv ZTBSV
- #define F77_ztpsv ZTPSV
-/*
- * Level 3 BLAS
- */
- #define F77_chemm CHEMM
- #define F77_cherk CHERK
- #define F77_cher2k CHER2K
- #define F77_zhemm ZHEMM
- #define F77_zherk ZHERK
- #define F77_zher2k ZHER2K
- #define F77_sgemm SGEMM
- #define F77_ssymm SSYMM
- #define F77_ssyrk SSYRK
- #define F77_ssyr2k SSYR2K
- #define F77_strmm STRMM
- #define F77_strsm STRSM
- #define F77_dgemm DGEMM
- #define F77_dsymm DSYMM
- #define F77_dsyrk DSYRK
- #define F77_dsyr2k DSYR2K
- #define F77_dtrmm DTRMM
- #define F77_dtrsm DTRSM
- #define F77_cgemm CGEMM
- #define F77_csymm CSYMM
- #define F77_csyrk CSYRK
- #define F77_csyr2k CSYR2K
- #define F77_ctrmm CTRMM
- #define F77_ctrsm CTRSM
- #define F77_zgemm ZGEMM
- #define F77_zsymm ZSYMM
- #define F77_zsyrk ZSYRK
- #define F77_zsyr2k ZSYR2K
- #define F77_ztrmm ZTRMM
- #define F77_ztrsm ZTRSM
-#elif defined(NOCHANGE)
-/*
- * Level 1 BLAS
- */
-#define F77_xerbla xerbla
- #define F77_srotg srotg
- #define F77_srotmg srotmg
- #define F77_srot srot
- #define F77_srotm srotm
- #define F77_drotg drotg
- #define F77_drotmg drotmg
- #define F77_drot drot
- #define F77_drotm drotm
- #define F77_sswap sswap
- #define F77_scopy scopy
- #define F77_saxpy saxpy
- #define F77_isamax_sub isamaxsub
- #define F77_dswap dswap
- #define F77_dcopy dcopy
- #define F77_daxpy daxpy
- #define F77_idamax_sub idamaxsub
- #define F77_cswap cswap
- #define F77_ccopy ccopy
- #define F77_caxpy caxpy
- #define F77_icamax_sub icamaxsub
- #define F77_zswap zswap
- #define F77_zcopy zcopy
- #define F77_zaxpy zaxpy
- #define F77_izamax_sub izamaxsub
- #define F77_sdot_sub sdotsub
- #define F77_ddot_sub ddotsub
- #define F77_dsdot_sub dsdotsub
- #define F77_sscal sscal
- #define F77_dscal dscal
- #define F77_cscal cscal
- #define F77_zscal zscal
- #define F77_csscal csscal
- #define F77_zdscal zdscal
- #define F77_cdotu_sub cdotusub
- #define F77_cdotc_sub cdotcsub
- #define F77_zdotu_sub zdotusub
- #define F77_zdotc_sub zdotcsub
- #define F77_snrm2_sub snrm2sub
- #define F77_sasum_sub sasumsub
- #define F77_dnrm2_sub dnrm2sub
- #define F77_dasum_sub dasumsub
- #define F77_scnrm2_sub scnrm2sub
- #define F77_scasum_sub scasumsub
- #define F77_dznrm2_sub dznrm2sub
- #define F77_dzasum_sub dzasumsub
- #define F77_sdsdot_sub sdsdotsub
-/*
- * Level 2 BLAS
- */
- #define F77_ssymv ssymv
- #define F77_ssbmv ssbmv
- #define F77_sspmv sspmv
- #define F77_sger sger
- #define F77_ssyr ssyr
- #define F77_sspr sspr
- #define F77_ssyr2 ssyr2
- #define F77_sspr2 sspr2
- #define F77_dsymv dsymv
- #define F77_dsbmv dsbmv
- #define F77_dspmv dspmv
- #define F77_dger dger
- #define F77_dsyr dsyr
- #define F77_dspr dspr
- #define F77_dsyr2 dsyr2
- #define F77_dspr2 dspr2
- #define F77_chemv chemv
- #define F77_chbmv chbmv
- #define F77_chpmv chpmv
- #define F77_cgeru cgeru
- #define F77_cgerc cgerc
- #define F77_cher cher
- #define F77_chpr chpr
- #define F77_cher2 cher2
- #define F77_chpr2 chpr2
- #define F77_zhemv zhemv
- #define F77_zhbmv zhbmv
- #define F77_zhpmv zhpmv
- #define F77_zgeru zgeru
- #define F77_zgerc zgerc
- #define F77_zher zher
- #define F77_zhpr zhpr
- #define F77_zher2 zher2
- #define F77_zhpr2 zhpr2
- #define F77_sgemv sgemv
- #define F77_sgbmv sgbmv
- #define F77_strmv strmv
- #define F77_stbmv stbmv
- #define F77_stpmv stpmv
- #define F77_strsv strsv
- #define F77_stbsv stbsv
- #define F77_stpsv stpsv
- #define F77_dgemv dgemv
- #define F77_dgbmv dgbmv
- #define F77_dtrmv dtrmv
- #define F77_dtbmv dtbmv
- #define F77_dtpmv dtpmv
- #define F77_dtrsv dtrsv
- #define F77_dtbsv dtbsv
- #define F77_dtpsv dtpsv
- #define F77_cgemv cgemv
- #define F77_cgbmv cgbmv
- #define F77_ctrmv ctrmv
- #define F77_ctbmv ctbmv
- #define F77_ctpmv ctpmv
- #define F77_ctrsv ctrsv
- #define F77_ctbsv ctbsv
- #define F77_ctpsv ctpsv
- #define F77_zgemv zgemv
- #define F77_zgbmv zgbmv
- #define F77_ztrmv ztrmv
- #define F77_ztbmv ztbmv
- #define F77_ztpmv ztpmv
- #define F77_ztrsv ztrsv
- #define F77_ztbsv ztbsv
- #define F77_ztpsv ztpsv
-/*
- * Level 3 BLAS
- */
- #define F77_chemm chemm
- #define F77_cherk cherk
- #define F77_cher2k cher2k
- #define F77_zhemm zhemm
- #define F77_zherk zherk
- #define F77_zher2k zher2k
- #define F77_sgemm sgemm
- #define F77_ssymm ssymm
- #define F77_ssyrk ssyrk
- #define F77_ssyr2k ssyr2k
- #define F77_strmm strmm
- #define F77_strsm strsm
- #define F77_dgemm dgemm
- #define F77_dsymm dsymm
- #define F77_dsyrk dsyrk
- #define F77_dsyr2k dsyr2k
- #define F77_dtrmm dtrmm
- #define F77_dtrsm dtrsm
- #define F77_cgemm cgemm
- #define F77_csymm csymm
- #define F77_csyrk csyrk
- #define F77_csyr2k csyr2k
- #define F77_ctrmm ctrmm
- #define F77_ctrsm ctrsm
- #define F77_zgemm zgemm
- #define F77_zsymm zsymm
- #define F77_zsyrk zsyrk
- #define F77_zsyr2k zsyr2k
- #define F77_ztrmm ztrmm
- #define F77_ztrsm ztrsm
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
- void F77_xerbla(FCHAR, void *);
-/*
- * Level 1 Fortran Prototypes
- */
-
-/* Single Precision */
-
- void F77_srot(FINT, float *, FINT, float *, FINT, const float *, const float *);
- void F77_srotg(float *,float *,float *,float *);
- void F77_srotm( FINT, float *, FINT, float *, FINT, const float *);
- void F77_srotmg(float *,float *,float *,const float *, float *);
- void F77_sswap( FINT, float *, FINT, float *, FINT);
- void F77_scopy( FINT, const float *, FINT, float *, FINT);
- void F77_saxpy( FINT, const float *, const float *, FINT, float *, FINT);
- void F77_sdot_sub(FINT, const float *, FINT, const float *, FINT, float *);
- void F77_sdsdot_sub( FINT, const float *, const float *, FINT, const float *, FINT, float *);
- void F77_sscal( FINT, const float *, float *, FINT);
- void F77_snrm2_sub( FINT, const float *, FINT, float *);
- void F77_sasum_sub( FINT, const float *, FINT, float *);
- void F77_isamax_sub( FINT, const float * , FINT, FINT2);
-
-/* Double Precision */
-
- void F77_drot(FINT, double *, FINT, double *, FINT, const double *, const double *);
- void F77_drotg(double *,double *,double *,double *);
- void F77_drotm( FINT, double *, FINT, double *, FINT, const double *);
- void F77_drotmg(double *,double *,double *,const double *, double *);
- void F77_dswap( FINT, double *, FINT, double *, FINT);
- void F77_dcopy( FINT, const double *, FINT, double *, FINT);
- void F77_daxpy( FINT, const double *, const double *, FINT, double *, FINT);
- void F77_dswap( FINT, double *, FINT, double *, FINT);
- void F77_dsdot_sub(FINT, const float *, FINT, const float *, FINT, double *);
- void F77_ddot_sub( FINT, const double *, FINT, const double *, FINT, double *);
- void F77_dscal( FINT, const double *, double *, FINT);
- void F77_dnrm2_sub( FINT, const double *, FINT, double *);
- void F77_dasum_sub( FINT, const double *, FINT, double *);
- void F77_idamax_sub( FINT, const double * , FINT, FINT2);
-
-/* Single Complex Precision */
-
- void F77_cswap( FINT, void *, FINT, void *, FINT);
- void F77_ccopy( FINT, const void *, FINT, void *, FINT);
- void F77_caxpy( FINT, const void *, const void *, FINT, void *, FINT);
- void F77_cswap( FINT, void *, FINT, void *, FINT);
- void F77_cdotc_sub( FINT, const void *, FINT, const void *, FINT, void *);
- void F77_cdotu_sub( FINT, const void *, FINT, const void *, FINT, void *);
- void F77_cscal( FINT, const void *, void *, FINT);
- void F77_icamax_sub( FINT, const void *, FINT, FINT2);
- void F77_csscal( FINT, const float *, void *, FINT);
- void F77_scnrm2_sub( FINT, const void *, FINT, float *);
- void F77_scasum_sub( FINT, const void *, FINT, float *);
-
-/* Double Complex Precision */
-
- void F77_zswap( FINT, void *, FINT, void *, FINT);
- void F77_zcopy( FINT, const void *, FINT, void *, FINT);
- void F77_zaxpy( FINT, const void *, const void *, FINT, void *, FINT);
- void F77_zswap( FINT, void *, FINT, void *, FINT);
- void F77_zdotc_sub( FINT, const void *, FINT, const void *, FINT, void *);
- void F77_zdotu_sub( FINT, const void *, FINT, const void *, FINT, void *);
- void F77_zdscal( FINT, const double *, void *, FINT);
- void F77_zscal( FINT, const void *, void *, FINT);
- void F77_dznrm2_sub( FINT, const void *, FINT, double *);
- void F77_dzasum_sub( FINT, const void *, FINT, double *);
- void F77_izamax_sub( FINT, const void *, FINT, FINT2);
-
-/*
- * Level 2 Fortran Prototypes
- */
-
-/* Single Precision */
-
- void F77_sgemv(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_sgbmv(FCHAR, FINT, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_ssymv(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_ssbmv(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_sspmv(FCHAR, FINT, const float *, const float *, const float *, FINT, const float *, float *, FINT);
- void F77_strmv( FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT);
- void F77_stbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT);
- void F77_strsv( FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT);
- void F77_stbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT);
- void F77_stpmv( FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT);
- void F77_stpsv( FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT);
- void F77_sger( FINT, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT);
- void F77_ssyr(FCHAR, FINT, const float *, const float *, FINT, float *, FINT);
- void F77_sspr(FCHAR, FINT, const float *, const float *, FINT, float *);
- void F77_sspr2(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *);
- void F77_ssyr2(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT);
-
-/* Double Precision */
-
- void F77_dgemv(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dgbmv(FCHAR, FINT, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dsymv(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dsbmv(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dspmv(FCHAR, FINT, const double *, const double *, const double *, FINT, const double *, double *, FINT);
- void F77_dtrmv( FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT);
- void F77_dtbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT);
- void F77_dtrsv( FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT);
- void F77_dtbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT);
- void F77_dtpmv( FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT);
- void F77_dtpsv( FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT);
- void F77_dger( FINT, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT);
- void F77_dsyr(FCHAR, FINT, const double *, const double *, FINT, double *, FINT);
- void F77_dspr(FCHAR, FINT, const double *, const double *, FINT, double *);
- void F77_dspr2(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *);
- void F77_dsyr2(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT);
-
-/* Single Complex Precision */
-
- void F77_cgemv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_cgbmv(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_chemv(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_chbmv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_chpmv(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT);
- void F77_ctrmv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
- void F77_ctbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
- void F77_ctpmv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT);
- void F77_ctrsv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
- void F77_ctbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
- void F77_ctpsv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT);
- void F77_cgerc( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
- void F77_cgeru( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
- void F77_cher(FCHAR, FINT, const float *, const void *, FINT, void *, FINT);
- void F77_cher2(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
- void F77_chpr(FCHAR, FINT, const float *, const void *, FINT, void *);
- void F77_chpr2(FCHAR, FINT, const float *, const void *, FINT, const void *, FINT, void *);
-
-/* Double Complex Precision */
-
- void F77_zgemv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_zgbmv(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_zhemv(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_zhbmv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
- void F77_zhpmv(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT);
- void F77_ztrmv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
- void F77_ztbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
- void F77_ztpmv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT);
- void F77_ztrsv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
- void F77_ztbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
- void F77_ztpsv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT);
- void F77_zgerc( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
- void F77_zgeru( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
- void F77_zher(FCHAR, FINT, const double *, const void *, FINT, void *, FINT);
- void F77_zher2(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
- void F77_zhpr(FCHAR, FINT, const double *, const void *, FINT, void *);
- void F77_zhpr2(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void *);
-
-/*
- * Level 3 Fortran Prototypes
- */
-
-/* Single Precision */
-
- void F77_sgemm(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_ssymm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_ssyrk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT);
- void F77_ssyr2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_strmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
- void F77_strsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
-
-/* Double Precision */
-
- void F77_dgemm(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dsymm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dsyrk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT);
- void F77_dsyr2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_dtrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
- void F77_dtrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
-
-/* Single Complex Precision */
-
- void F77_cgemm(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_csymm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_chemm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_csyrk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT);
- void F77_cherk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT);
- void F77_csyr2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_cher2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
- void F77_ctrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
- void F77_ctrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
-
-/* Double Complex Precision */
-
- void F77_zgemm(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_zsymm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_zhemm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_zsyrk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT);
- void F77_zherk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT);
- void F77_zsyr2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_zher2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
- void F77_ztrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
- void F77_ztrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CBLAS_F77_H */
diff --git a/netlib/CBLAS/cblas_globals.c b/netlib/CBLAS/cblas_globals.c
deleted file mode 100644
index ebcd74d..0000000
--- a/netlib/CBLAS/cblas_globals.c
+++ /dev/null
@@ -1,2 +0,0 @@
-int CBLAS_CallFromC=0;
-int RowMajorStrg=0;
diff --git a/netlib/CBLAS/cblas_icamax.c b/netlib/CBLAS/cblas_icamax.c
deleted file mode 100644
index f0cdbdb..0000000
--- a/netlib/CBLAS/cblas_icamax.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_icamax.c
- *
- * The program is a C interface to icamax.
- * It calls the fortran wrapper before calling icamax.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-CBLAS_INDEX cblas_icamax( const int N, const void *X, const int incX)
-{
- int iamax;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_icamax_sub( &F77_N, X, &F77_incX, &iamax);
- return iamax ? iamax-1 : 0;
-}
diff --git a/netlib/CBLAS/cblas_idamax.c b/netlib/CBLAS/cblas_idamax.c
deleted file mode 100644
index abb70b5..0000000
--- a/netlib/CBLAS/cblas_idamax.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_idamax.c
- *
- * The program is a C interface to idamax.
- * It calls the fortran wrapper before calling idamax.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-CBLAS_INDEX cblas_idamax( const int N, const double *X, const int incX)
-{
- int iamax;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_idamax_sub( &F77_N, X, &F77_incX, &iamax);
- return iamax ? iamax-1 : 0;
-}
diff --git a/netlib/CBLAS/cblas_isamax.c b/netlib/CBLAS/cblas_isamax.c
deleted file mode 100644
index bfd74e8..0000000
--- a/netlib/CBLAS/cblas_isamax.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_isamax.c
- *
- * The program is a C interface to isamax.
- * It calls the fortran wrapper before calling isamax.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-CBLAS_INDEX cblas_isamax( const int N, const float *X, const int incX)
-{
- int iamax;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_isamax_sub( &F77_N, X, &F77_incX, &iamax);
- return iamax ? iamax-1 : 0;
-}
diff --git a/netlib/CBLAS/cblas_izamax.c b/netlib/CBLAS/cblas_izamax.c
deleted file mode 100644
index 21fdc39..0000000
--- a/netlib/CBLAS/cblas_izamax.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_izamax.c
- *
- * The program is a C interface to izamax.
- * It calls the fortran wrapper before calling izamax.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-CBLAS_INDEX cblas_izamax( const int N, const void *X, const int incX)
-{
- int iamax;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_izamax_sub( &F77_N, X, &F77_incX, &iamax);
- return (iamax ? iamax-1 : 0);
-}
diff --git a/netlib/CBLAS/cblas_sasum.c b/netlib/CBLAS/cblas_sasum.c
deleted file mode 100644
index 7d4c32c..0000000
--- a/netlib/CBLAS/cblas_sasum.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_sasum.c
- *
- * The program is a C interface to sasum.
- * It calls the fortran wrapper before calling sasum.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-float cblas_sasum( const int N, const float *X, const int incX)
-{
- float asum;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_sasum_sub( &F77_N, X, &F77_incX, &asum);
- return asum;
-}
diff --git a/netlib/CBLAS/cblas_saxpy.c b/netlib/CBLAS/cblas_saxpy.c
deleted file mode 100644
index 2eee8e0..0000000
--- a/netlib/CBLAS/cblas_saxpy.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_saxpy.c
- *
- * The program is a C interface to saxpy.
- * It calls the fortran wrapper before calling saxpy.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_saxpy( const int N, const float alpha, const float *X,
- const int incX, float *Y, const int incY)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_saxpy( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY);
-}
diff --git a/netlib/CBLAS/cblas_scasum.c b/netlib/CBLAS/cblas_scasum.c
deleted file mode 100644
index e1fa530..0000000
--- a/netlib/CBLAS/cblas_scasum.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_scasum.c
- *
- * The program is a C interface to scasum.
- * It calls the fortran wrapper before calling scasum.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-float cblas_scasum( const int N, const void *X, const int incX)
-{
- float asum;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_scasum_sub( &F77_N, X, &F77_incX, &asum);
- return asum;
-}
diff --git a/netlib/CBLAS/cblas_scnrm2.c b/netlib/CBLAS/cblas_scnrm2.c
deleted file mode 100644
index fa48454..0000000
--- a/netlib/CBLAS/cblas_scnrm2.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_scnrm2.c
- *
- * The program is a C interface to scnrm2.
- * It calls the fortran wrapper before calling scnrm2.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-float cblas_scnrm2( const int N, const void *X, const int incX)
-{
- float nrm2;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_scnrm2_sub( &F77_N, X, &F77_incX, &nrm2);
- return nrm2;
-}
diff --git a/netlib/CBLAS/cblas_scopy.c b/netlib/CBLAS/cblas_scopy.c
deleted file mode 100644
index 7796959..0000000
--- a/netlib/CBLAS/cblas_scopy.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_scopy.c
- *
- * The program is a C interface to scopy.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_scopy( const int N, const float *X,
- const int incX, float *Y, const int incY)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_scopy( &F77_N, X, &F77_incX, Y, &F77_incY);
-}
diff --git a/netlib/CBLAS/cblas_sdot.c b/netlib/CBLAS/cblas_sdot.c
deleted file mode 100644
index baf8592..0000000
--- a/netlib/CBLAS/cblas_sdot.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * cblas_sdot.c
- *
- * The program is a C interface to sdot.
- * It calls the fortran wrapper before calling sdot.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-float cblas_sdot( const int N, const float *X,
- const int incX, const float *Y, const int incY)
-{
- float dot;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_sdot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
- return dot;
-}
diff --git a/netlib/CBLAS/cblas_sdsdot.c b/netlib/CBLAS/cblas_sdsdot.c
deleted file mode 100644
index b824849..0000000
--- a/netlib/CBLAS/cblas_sdsdot.c
+++ /dev/null
@@ -1,25 +0,0 @@
-/*
- * cblas_sdsdot.c
- *
- * The program is a C interface to sdsdot.
- * It calls the fortran wrapper before calling sdsdot.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-float cblas_sdsdot( const int N, const float alpha, const float *X,
- const int incX, const float *Y, const int incY)
-{
- float dot;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_sdsdot_sub( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, &dot);
- return dot;
-}
diff --git a/netlib/CBLAS/cblas_sgbmv.c b/netlib/CBLAS/cblas_sgbmv.c
deleted file mode 100644
index 0af607f..0000000
--- a/netlib/CBLAS/cblas_sgbmv.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*
- *
- * cblas_sgbmv.c
- * This program is a C interface to sgbmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sgbmv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const int KL, const int KU,
- const float alpha, const float *A, const int lda,
- const float *X, const int incX, const float beta,
- float *Y, const int incY)
-{
- char TA;
-#ifdef F77_CHAR
- F77_CHAR F77_TA;
-#else
- #define F77_TA &TA
-#endif
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
- F77_INT F77_KL=KL,F77_KU=KU;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_KL KL
- #define F77_KU KU
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_sgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, &alpha,
- A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_sgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha,
- A ,&F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_sgbmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_sgemm.c b/netlib/CBLAS/cblas_sgemm.c
deleted file mode 100644
index 73a06e5..0000000
--- a/netlib/CBLAS/cblas_sgemm.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*
- *
- * cblas_sgemm.c
- * This program is a C interface to sgemm.
- * Written by Keita Teranishi
- * 4/8/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const float alpha, const float *A,
- const int lda, const float *B, const int ldb,
- const float beta, float *C, const int ldc)
-{
- char TA, TB;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_TB;
-#else
- #define F77_TA &TA
- #define F77_TB &TB
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_ldb ldb
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if( Order == CblasColMajor )
- {
- if(TransA == CblasTrans) TA='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(2, "cblas_sgemm",
- "Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if(TransB == CblasTrans) TB='T';
- else if ( TransB == CblasConjTrans ) TB='C';
- else if ( TransB == CblasNoTrans ) TB='N';
- else
- {
- cblas_xerbla(3, "cblas_sgemm",
- "Illegal TransB setting, %d\n", TransB);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- F77_TB = C2F_CHAR(&TB);
- #endif
-
- F77_sgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if(TransA == CblasTrans) TB='T';
- else if ( TransA == CblasConjTrans ) TB='C';
- else if ( TransA == CblasNoTrans ) TB='N';
- else
- {
- cblas_xerbla(2, "cblas_sgemm",
- "Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if(TransB == CblasTrans) TA='T';
- else if ( TransB == CblasConjTrans ) TA='C';
- else if ( TransB == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(2, "cblas_sgemm",
- "Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- F77_TB = C2F_CHAR(&TB);
- #endif
-
- F77_sgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
- } else
- cblas_xerbla(1, "cblas_sgemm",
- "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
-}
diff --git a/netlib/CBLAS/cblas_sgemv.c b/netlib/CBLAS/cblas_sgemv.c
deleted file mode 100644
index 45b7196..0000000
--- a/netlib/CBLAS/cblas_sgemv.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*
- *
- * cblas_sgemv.c
- * This program is a C interface to sgemv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sgemv(const enum CBLAS_ORDER order,
- const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
- const float alpha, const float *A, const int lda,
- const float *X, const int incX, const float beta,
- float *Y, const int incY)
-{
- char TA;
-#ifdef F77_CHAR
- F77_CHAR F77_TA;
-#else
- #define F77_TA &TA
-#endif
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
- #define F77_incY incY
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(2, "cblas_sgemv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_sgemv(F77_TA, &F77_M, &F77_N, &alpha, A, &F77_lda, X, &F77_incX,
- &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(2, "cblas_sgemv", "Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_TA = C2F_CHAR(&TA);
- #endif
- F77_sgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_sgemv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_sger.c b/netlib/CBLAS/cblas_sger.c
deleted file mode 100644
index 368940c..0000000
--- a/netlib/CBLAS/cblas_sger.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- *
- * cblas_sger.c
- * This program is a C interface to sger.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
- const float alpha, const float *X, const int incX,
- const float *Y, const int incY, float *A, const int lda)
-{
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
- #define F77_lda lda
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- F77_sger( &F77_M, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
- &F77_lda);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- F77_sger( &F77_N, &F77_M, &alpha, Y, &F77_incY, X, &F77_incX, A,
- &F77_lda);
- }
- else cblas_xerbla(1, "cblas_sger", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_snrm2.c b/netlib/CBLAS/cblas_snrm2.c
deleted file mode 100644
index 18161b4..0000000
--- a/netlib/CBLAS/cblas_snrm2.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * cblas_snrm2.c
- *
- * The program is a C interface to snrm2.
- * It calls the fortran wrapper before calling snrm2.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-float cblas_snrm2( const int N, const float *X, const int incX)
-{
- float nrm2;
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_snrm2_sub( &F77_N, X, &F77_incX, &nrm2);
- return nrm2;
-}
diff --git a/netlib/CBLAS/cblas_srot.c b/netlib/CBLAS/cblas_srot.c
deleted file mode 100644
index cbd1c8c..0000000
--- a/netlib/CBLAS/cblas_srot.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_srot.c
- *
- * The program is a C interface to srot.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_srot( const int N, float *X, const int incX, float *Y,
- const int incY, const float c, const float s)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_srot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s);
-}
diff --git a/netlib/CBLAS/cblas_srotg.c b/netlib/CBLAS/cblas_srotg.c
deleted file mode 100644
index f646004..0000000
--- a/netlib/CBLAS/cblas_srotg.c
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * cblas_srotg.c
- *
- * The program is a C interface to srotg.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_srotg( float *a, float *b, float *c, float *s)
-{
- F77_srotg(a,b,c,s);
-}
diff --git a/netlib/CBLAS/cblas_srotm.c b/netlib/CBLAS/cblas_srotm.c
deleted file mode 100644
index 4967464..0000000
--- a/netlib/CBLAS/cblas_srotm.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_srotm.c
- *
- * The program is a C interface to srotm.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_srotm( const int N, float *X, const int incX, float *Y,
- const int incY, const float *P)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_srotm( &F77_N, X, &F77_incX, Y, &F77_incY, P);
-}
diff --git a/netlib/CBLAS/cblas_srotmg.c b/netlib/CBLAS/cblas_srotmg.c
deleted file mode 100644
index 04f978b..0000000
--- a/netlib/CBLAS/cblas_srotmg.c
+++ /dev/null
@@ -1,15 +0,0 @@
-/*
- * cblas_srotmg.c
- *
- * The program is a C interface to srotmg.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_srotmg( float *d1, float *d2, float *b1,
- const float b2, float *p)
-{
- F77_srotmg(d1,d2,b1,&b2,p);
-}
diff --git a/netlib/CBLAS/cblas_ssbmv.c b/netlib/CBLAS/cblas_ssbmv.c
deleted file mode 100644
index 7a18630..0000000
--- a/netlib/CBLAS/cblas_ssbmv.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- *
- * cblas_ssbmv.c
- * This program is a C interface to ssbmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const int K, const float alpha, const float *A,
- const int lda, const float *X, const int incX,
- const float beta, float *Y, const int incY)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
-
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_ssbmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_sscal.c b/netlib/CBLAS/cblas_sscal.c
deleted file mode 100644
index 1f09abe..0000000
--- a/netlib/CBLAS/cblas_sscal.c
+++ /dev/null
@@ -1,21 +0,0 @@
-/*
- * cblas_sscal.c
- *
- * The program is a C interface to sscal.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sscal( const int N, const float alpha, float *X,
- const int incX)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- F77_sscal( &F77_N, &alpha, X, &F77_incX);
-}
diff --git a/netlib/CBLAS/cblas_sspmv.c b/netlib/CBLAS/cblas_sspmv.c
deleted file mode 100644
index aa4a287..0000000
--- a/netlib/CBLAS/cblas_sspmv.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*
- *
- * cblas_sspmv.c
- * This program is a C interface to sspmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sspmv(const enum CBLAS_ORDER order,
- const enum CBLAS_UPLO Uplo, const int N,
- const float alpha, const float *AP,
- const float *X, const int incX, const float beta,
- float *Y, const int incY)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_sspmv(F77_UL, &F77_N, &alpha, AP, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_sspmv(F77_UL, &F77_N, &alpha,
- AP, X,&F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_sspmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
-}
diff --git a/netlib/CBLAS/cblas_sspr.c b/netlib/CBLAS/cblas_sspr.c
deleted file mode 100644
index c8517ac..0000000
--- a/netlib/CBLAS/cblas_sspr.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*
- *
- * cblas_sspr.c
- * This program is a C interface to sspr.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, float *Ap)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
- } else cblas_xerbla(1, "cblas_sspr", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_sspr2.c b/netlib/CBLAS/cblas_sspr2.c
deleted file mode 100644
index 4f5afcd..0000000
--- a/netlib/CBLAS/cblas_sspr2.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
- *
- * cblas_sspr2.c
- * This program is a C interface to sspr2.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, const float *Y, const int incY, float *A)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
- } else cblas_xerbla(1, "cblas_sspr2", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
-}
diff --git a/netlib/CBLAS/cblas_sswap.c b/netlib/CBLAS/cblas_sswap.c
deleted file mode 100644
index b74d846..0000000
--- a/netlib/CBLAS/cblas_sswap.c
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * cblas_sswap.c
- *
- * The program is a C interface to sswap.
- *
- * Written by Keita Teranishi. 2/11/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_sswap( const int N, float *X, const int incX, float *Y,
- const int incY)
-{
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
-#endif
- F77_sswap( &F77_N, X, &F77_incX, Y, &F77_incY);
-}
diff --git a/netlib/CBLAS/cblas_ssymm.c b/netlib/CBLAS/cblas_ssymm.c
deleted file mode 100644
index a3b1601..0000000
--- a/netlib/CBLAS/cblas_ssymm.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*
- *
- * cblas_ssymm.c
- * This program is a C interface to ssymm.
- * Written by Keita Teranishi
- * 4/8/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const int M, const int N,
- const float alpha, const float *A, const int lda,
- const float *B, const int ldb, const float beta,
- float *C, const int ldc)
-{
- char SD, UL;
-#ifdef F77_CHAR
- F77_CHAR F77_SD, F77_UL;
-#else
- #define F77_SD &SD
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_ldb ldb
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if( Side == CblasRight) SD='R';
- else if ( Side == CblasLeft ) SD='L';
- else
- {
- cblas_xerbla(2, "cblas_ssymm",
- "Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(3, "cblas_ssymm",
- "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_SD = C2F_CHAR(&SD);
- #endif
-
- F77_ssymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Side == CblasRight) SD='L';
- else if ( Side == CblasLeft ) SD='R';
- else
- {
- cblas_xerbla(2, "cblas_ssymm",
- "Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_ssymm",
- "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_SD = C2F_CHAR(&SD);
- #endif
-
- F77_ssymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
- } else cblas_xerbla(1, "cblas_ssymm",
- "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_ssymv.c b/netlib/CBLAS/cblas_ssymv.c
deleted file mode 100644
index 89f5cc0..0000000
--- a/netlib/CBLAS/cblas_ssymv.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- *
- * cblas_ssymv.c
- * This program is a C interface to ssymv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssymv(const enum CBLAS_ORDER order,
- const enum CBLAS_UPLO Uplo, const int N,
- const float alpha, const float *A, const int lda,
- const float *X, const int incX, const float beta,
- float *Y, const int incY)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
-#else
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
- #define F77_incY incY
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_ssymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X,
- &F77_incX, &beta, Y, &F77_incY);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_ssymv(F77_UL, &F77_N, &alpha,
- A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
- }
- else cblas_xerbla(1, "cblas_ssymv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_ssyr.c b/netlib/CBLAS/cblas_ssyr.c
deleted file mode 100644
index 4e58dba..0000000
--- a/netlib/CBLAS/cblas_ssyr.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*
- *
- * cblas_ssyr.c
- * This program is a C interface to ssyr.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, float *A, const int lda)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_lda=lda;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_lda lda
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
- } else cblas_xerbla(1, "cblas_ssyr", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_ssyr2.c b/netlib/CBLAS/cblas_ssyr2.c
deleted file mode 100644
index 1d990cd..0000000
--- a/netlib/CBLAS/cblas_ssyr2.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- *
- * cblas_ssyr2.c
- * This program is a C interface to ssyr2.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const int N, const float alpha, const float *X,
- const int incX, const float *Y, const int incY, float *A,
- const int lda)
-{
- char UL;
-#ifdef F77_CHAR
- F77_CHAR F77_UL;
-#else
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77__lda=lda;
-#else
- #define F77_N N
- #define F77_incX incX
- #define F77_incY incY
- #define F77_lda lda
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasLower) UL = 'L';
- else if (Uplo == CblasUpper) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
-
- F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
- &F77_lda);
-
- } else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasLower) UL = 'U';
- else if (Uplo == CblasUpper) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo );
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- #endif
- F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
- &F77_lda);
- } else cblas_xerbla(1, "cblas_ssyr2", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_ssyr2k.c b/netlib/CBLAS/cblas_ssyr2k.c
deleted file mode 100644
index 871dd21..0000000
--- a/netlib/CBLAS/cblas_ssyr2k.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*
- *
- * cblas_ssyr2k.c
- * This program is a C interface to ssyr2k.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const float alpha, const float *A, const int lda,
- const float *B, const int ldb, const float beta,
- float *C, const int ldc)
-{
- char UL, TR;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL;
-#else
- #define F77_TR &TR
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_ldb ldb
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
-
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(2, "cblas_ssyr2k",
- "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Trans == CblasTrans) TR ='T';
- else if ( Trans == CblasConjTrans ) TR='C';
- else if ( Trans == CblasNoTrans ) TR='N';
- else
- {
- cblas_xerbla(3, "cblas_ssyr2k",
- "Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_ssyr2k",
- "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Trans == CblasTrans) TR ='N';
- else if ( Trans == CblasConjTrans ) TR='N';
- else if ( Trans == CblasNoTrans ) TR='T';
- else
- {
- cblas_xerbla(3, "cblas_ssyr2k",
- "Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
- } else cblas_xerbla(1, "cblas_ssyr2k",
- "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_ssyrk.c b/netlib/CBLAS/cblas_ssyrk.c
deleted file mode 100644
index 4992c9b..0000000
--- a/netlib/CBLAS/cblas_ssyrk.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*
- *
- * cblas_ssyrk.c
- * This program is a C interface to ssyrk.
- * Written by Keita Teranishi
- * 4/8/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
- const float alpha, const float *A, const int lda,
- const float beta, float *C, const int ldc)
-{
- char UL, TR;
-#ifdef F77_CHAR
- F77_CHAR F77_TR, F77_UL;
-#else
- #define F77_TR &TR
- #define F77_UL &UL
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=N, F77_K=K, F77_lda=lda;
- F77_INT F77_ldc=ldc;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_ldc ldc
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
-
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(2, "cblas_ssyrk",
- "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Trans == CblasTrans) TR ='T';
- else if ( Trans == CblasConjTrans ) TR='C';
- else if ( Trans == CblasNoTrans ) TR='N';
- else
- {
- cblas_xerbla(3, "cblas_ssyrk",
- "Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_ssyrk",
- "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Trans == CblasTrans) TR ='N';
- else if ( Trans == CblasConjTrans ) TR='N';
- else if ( Trans == CblasNoTrans ) TR='T';
- else
- {
- cblas_xerbla(3, "cblas_ssyrk",
- "Illegal Trans setting, %d\n", Trans);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TR = C2F_CHAR(&TR);
- #endif
-
- F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
- } else cblas_xerbla(1, "cblas_ssyrk",
- "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
-
diff --git a/netlib/CBLAS/cblas_stbmv.c b/netlib/CBLAS/cblas_stbmv.c
deleted file mode 100644
index 9e84bc0..0000000
--- a/netlib/CBLAS/cblas_stbmv.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*
- * cblas_stbmv.c
- * This program is a C interface to stbmv.
- * Written by Keita Teranishi
- * 3/3/1998
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-
-void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const float *A, const int lda,
- float *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else cblas_xerbla(1, "cblas_stbmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_stbsv.c b/netlib/CBLAS/cblas_stbsv.c
deleted file mode 100644
index fc19089..0000000
--- a/netlib/CBLAS/cblas_stbsv.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*
- * cblas_stbsv.c
- * The program is a C interface to stbsv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const int K, const float *A, const int lda,
- float *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_K K
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
- &F77_incX);
- }
- else cblas_xerbla(1, "cblas_stbsv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_stpmv.c b/netlib/CBLAS/cblas_stpmv.c
deleted file mode 100644
index 8f7fd6a..0000000
--- a/netlib/CBLAS/cblas_stpmv.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/*
- *
- * cblas_stpmv.c
- * This program is a C interface to stpmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *Ap, float *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
- }
- else cblas_xerbla(1, "cblas_stpmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_stpsv.c b/netlib/CBLAS/cblas_stpsv.c
deleted file mode 100644
index acc5f1d..0000000
--- a/netlib/CBLAS/cblas_stpsv.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/*
- * cblas_stpsv.c
- * The program is a C interface to stpsv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *Ap, float *X, const int incX)
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
-
- }
- else cblas_xerbla(1, "cblas_stpsv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_strmm.c b/netlib/CBLAS/cblas_strmm.c
deleted file mode 100644
index 9f8ce19..0000000
--- a/netlib/CBLAS/cblas_strmm.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/*
- *
- * cblas_strmm.c
- * This program is a C interface to strmm.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const float alpha, const float *A, const int lda,
- float *B, const int ldb)
-{
- char UL, TA, SD, DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_SD &SD
- #define F77_DI &DI
-#endif
-
-#ifdef F77_INT
- F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_ldb ldb
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if( Side == CblasRight) SD='R';
- else if ( Side == CblasLeft ) SD='L';
- else
- {
- cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(3, "cblas_strmm","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( TransA == CblasTrans) TA ='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_strmm","Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit ) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_strmm", "Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Side == CblasRight) SD='L';
- else if ( Side == CblasLeft ) SD='R';
- else
- {
- cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_strmm", "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( TransA == CblasTrans) TA ='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_strmm", "Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit ) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_strmm","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-#ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
-#endif
- F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
- &F77_lda, B, &F77_ldb);
- }
- else cblas_xerbla(1, "cblas_strmm", "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_strmv.c b/netlib/CBLAS/cblas_strmv.c
deleted file mode 100644
index 5a85b1d..0000000
--- a/netlib/CBLAS/cblas_strmv.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*
- *
- * cblas_strmv.c
- * This program is a C interface to strmv.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *A, const int lda,
- float *X, const int incX)
-
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else cblas_xerbla(1, "cblas_strmv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_strsm.c b/netlib/CBLAS/cblas_strsm.c
deleted file mode 100644
index 5dc3e0b..0000000
--- a/netlib/CBLAS/cblas_strsm.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/*
- *
- * cblas_strsm.c
- * This program is a C interface to strsm.
- * Written by Keita Teranishi
- * 4/6/1998
- *
- */
-
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
- const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_DIAG Diag, const int M, const int N,
- const float alpha, const float *A, const int lda,
- float *B, const int ldb)
-
-{
- char UL, TA, SD, DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_SD &SD
- #define F77_DI &DI
-#endif
-
-#ifdef F77_INT
- F77_INT F77_N=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
-#else
- #define F77_M M
- #define F77_N N
- #define F77_lda lda
- #define F77_ldb ldb
-#endif
-
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
- CBLAS_CallFromC = 1;
-
- if( Order == CblasColMajor )
- {
- if( Side == CblasRight) SD='R';
- else if ( Side == CblasLeft ) SD='L';
- else
- {
- cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Uplo == CblasUpper) UL='U';
- else if ( Uplo == CblasLower ) UL='L';
- else
- {
- cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( TransA == CblasTrans) TA ='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit ) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
- } else if (Order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if( Side == CblasRight) SD='L';
- else if ( Side == CblasLeft ) SD='R';
- else
- {
- cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Uplo == CblasUpper) UL='L';
- else if ( Uplo == CblasLower ) UL='U';
- else
- {
- cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( TransA == CblasTrans) TA ='T';
- else if ( TransA == CblasConjTrans ) TA='C';
- else if ( TransA == CblasNoTrans ) TA='N';
- else
- {
- cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if( Diag == CblasUnit ) DI='U';
- else if ( Diag == CblasNonUnit ) DI='N';
- else
- {
- cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_SD = C2F_CHAR(&SD);
- F77_DI = C2F_CHAR(&DI);
- #endif
-
- F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb);
- }
- else cblas_xerbla(1, "cblas_strsm", "Illegal Order setting, %d\n", Order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_strsv.c b/netlib/CBLAS/cblas_strsv.c
deleted file mode 100644
index a0509ae..0000000
--- a/netlib/CBLAS/cblas_strsv.c
+++ /dev/null
@@ -1,121 +0,0 @@
-/*
- * cblas_strsv.c
- * The program is a C interface to strsv.
- *
- * Keita Teranishi 5/20/98
- *
- */
-#include "cblas.h"
-#include "cblas_f77.h"
-void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
- const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
- const int N, const float *A, const int lda, float *X,
- const int incX)
-
-{
- char TA;
- char UL;
- char DI;
-#ifdef F77_CHAR
- F77_CHAR F77_TA, F77_UL, F77_DI;
-#else
- #define F77_TA &TA
- #define F77_UL &UL
- #define F77_DI &DI
-#endif
-#ifdef F77_INT
- F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
-#else
- #define F77_N N
- #define F77_lda lda
- #define F77_incX incX
-#endif
- extern int CBLAS_CallFromC;
- extern int RowMajorStrg;
- RowMajorStrg = 0;
-
- CBLAS_CallFromC = 1;
- if (order == CblasColMajor)
- {
- if (Uplo == CblasUpper) UL = 'U';
- else if (Uplo == CblasLower) UL = 'L';
- else
- {
- cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (TransA == CblasNoTrans) TA = 'N';
- else if (TransA == CblasTrans) TA = 'T';
- else if (TransA == CblasConjTrans) TA = 'C';
- else
- {
- cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else if (order == CblasRowMajor)
- {
- RowMajorStrg = 1;
- if (Uplo == CblasUpper) UL = 'L';
- else if (Uplo == CblasLower) UL = 'U';
- else
- {
- cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (TransA == CblasNoTrans) TA = 'T';
- else if (TransA == CblasTrans) TA = 'N';
- else if (TransA == CblasConjTrans) TA = 'N';
- else
- {
- cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
-
- if (Diag == CblasUnit) DI = 'U';
- else if (Diag == CblasNonUnit) DI = 'N';
- else
- {
- cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
- }
- #ifdef F77_CHAR
- F77_UL = C2F_CHAR(&UL);
- F77_TA = C2F_CHAR(&TA);
- F77_DI = C2F_CHAR(&DI);
- #endif
- F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
- &F77_incX);
- }
- else cblas_xerbla(1, "cblas_strsv", "Illegal Order setting, %d\n", order);
- CBLAS_CallFromC = 0;
- RowMajorStrg = 0;
- return;
-}
diff --git a/netlib/CBLAS/cblas_xerbla.c b/netlib/CBLAS/cblas_xerbla.c
deleted file mode 100644
index 3a2bfe6..0000000
--- a/netlib/CBLAS/cblas_xerbla.c
+++ /dev/null
@@ -1,68 +0,0 @@
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <stdarg.h>
-#include "cblas.h"
-#include "cblas_f77.h"
-
-void cblas_xerbla(int info, const char *rout, const char *form, ...)
-{
- extern int RowMajorStrg;
- char empty[1] = "";
- va_list argptr;
-
- va_start(argptr, form);
-
- if (RowMajorStrg)
- {
- if (strstr(rout,"gemm") != 0)
- {
- if (info == 5 ) info = 4;
- else if (info == 4 ) info = 5;
- else if (info == 11) info = 9;
- else if (info == 9 ) info = 11;
- }
- else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
- {
- if (info == 5 ) info = 4;
- else if (info == 4 ) info = 5;
- }
- else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0)
- {
- if (info == 7 ) info = 6;
- else if (info == 6 ) info = 7;
- }
- else if (strstr(rout,"gemv") != 0)
- {
- if (info == 4) info = 3;
- else if (info == 3) info = 4;
- }
- else if (strstr(rout,"gbmv") != 0)
- {
- if (info == 4) info = 3;
- else if (info == 3) info = 4;
- else if (info == 6) info = 5;
- else if (info == 5) info = 6;
- }
- else if (strstr(rout,"ger") != 0)
- {
- if (info == 3) info = 2;
- else if (info == 2) info = 3;
- else if (info == 8) info = 6;
- else if (info == 6) info = 8;
- }
- else if ( (strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0)
- && strstr(rout,"her2k") == 0 )
- {
- if (info == 8) info = 6;
- else if (info == 6) info = 8;
- }
- }
- if (info)
- fprintf(stderr, "Parameter %d to routine %s was incorrect\n", info, rout);
- vfprintf(stderr, form, argptr);
- va_end(argptr);
- if (info && !info)
- F77_xerbla(empty, &info); /* Force link of our F77 error handler */
- exit(-1);
-}
diff --git a/netlib/CBLAS/dasumsub.f b/netlib/CBLAS/dasumsub.f
deleted file mode 100644
index 3d64d17..0000000
--- a/netlib/CBLAS/dasumsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c dasumsun.f
-c
-c The program is a fortran wrapper for dasum..
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine dasumsub(n,x,incx,asum)
-c
- external dasum
- double precision dasum,asum
- integer n,incx
- double precision x(*)
-c
- asum=dasum(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/ddotsub.f b/netlib/CBLAS/ddotsub.f
deleted file mode 100644
index 205f3b4..0000000
--- a/netlib/CBLAS/ddotsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c ddotsub.f
-c
-c The program is a fortran wrapper for ddot.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine ddotsub(n,x,incx,y,incy,dot)
-c
- external ddot
- double precision ddot
- integer n,incx,incy
- double precision x(*),y(*),dot
-c
- dot=ddot(n,x,incx,y,incy)
- return
- end
diff --git a/netlib/CBLAS/dnrm2sub.f b/netlib/CBLAS/dnrm2sub.f
deleted file mode 100644
index 88f17db..0000000
--- a/netlib/CBLAS/dnrm2sub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c dnrm2sub.f
-c
-c The program is a fortran wrapper for dnrm2.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine dnrm2sub(n,x,incx,nrm2)
-c
- external dnrm2
- double precision dnrm2,nrm2
- integer n,incx
- double precision x(*)
-c
- nrm2=dnrm2(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/dsdotsub.f b/netlib/CBLAS/dsdotsub.f
deleted file mode 100644
index e7e872c..0000000
--- a/netlib/CBLAS/dsdotsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c dsdotsub.f
-c
-c The program is a fortran wrapper for dsdot.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine dsdotsub(n,x,incx,y,incy,dot)
-c
- external dsdot
- double precision dsdot,dot
- integer n,incx,incy
- real x(*),y(*)
-c
- dot=dsdot(n,x,incx,y,incy)
- return
- end
diff --git a/netlib/CBLAS/dzasumsub.f b/netlib/CBLAS/dzasumsub.f
deleted file mode 100644
index 9aaf163..0000000
--- a/netlib/CBLAS/dzasumsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c dzasumsub.f
-c
-c The program is a fortran wrapper for dzasum.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine dzasumsub(n,x,incx,asum)
-c
- external dzasum
- double precision dzasum,asum
- integer n,incx
- double complex x(*)
-c
- asum=dzasum(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/dznrm2sub.f b/netlib/CBLAS/dznrm2sub.f
deleted file mode 100644
index 45dc599..0000000
--- a/netlib/CBLAS/dznrm2sub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c dznrm2sub.f
-c
-c The program is a fortran wrapper for dznrm2.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine dznrm2sub(n,x,incx,nrm2)
-c
- external dznrm2
- double precision dznrm2,nrm2
- integer n,incx
- double complex x(*)
-c
- nrm2=dznrm2(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/icamaxsub.f b/netlib/CBLAS/icamaxsub.f
deleted file mode 100644
index 3f47071..0000000
--- a/netlib/CBLAS/icamaxsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c icamaxsub.f
-c
-c The program is a fortran wrapper for icamax.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine icamaxsub(n,x,incx,iamax)
-c
- external icamax
- integer icamax,iamax
- integer n,incx
- complex x(*)
-c
- iamax=icamax(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/idamaxsub.f b/netlib/CBLAS/idamaxsub.f
deleted file mode 100644
index 3c1ee5c..0000000
--- a/netlib/CBLAS/idamaxsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c icamaxsub.f
-c
-c The program is a fortran wrapper for idamax.
-c Witten by Keita Teranishi. 2/22/1998
-c
- subroutine idamaxsub(n,x,incx,iamax)
-c
- external idamax
- integer idamax,iamax
- integer n,incx
- double precision x(*)
-c
- iamax=idamax(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/isamaxsub.f b/netlib/CBLAS/isamaxsub.f
deleted file mode 100644
index 0faf42f..0000000
--- a/netlib/CBLAS/isamaxsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c isamaxsub.f
-c
-c The program is a fortran wrapper for isamax.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine isamaxsub(n,x,incx,iamax)
-c
- external isamax
- integer isamax,iamax
- integer n,incx
- real x(*)
-c
- iamax=isamax(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/izamaxsub.f b/netlib/CBLAS/izamaxsub.f
deleted file mode 100644
index 5b15855..0000000
--- a/netlib/CBLAS/izamaxsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c izamaxsub.f
-c
-c The program is a fortran wrapper for izamax.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine izamaxsub(n,x,incx,iamax)
-c
- external izamax
- integer izamax,iamax
- integer n,incx
- double complex x(*)
-c
- iamax=izamax(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/sasumsub.f b/netlib/CBLAS/sasumsub.f
deleted file mode 100644
index 955f11e..0000000
--- a/netlib/CBLAS/sasumsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c sasumsub.f
-c
-c The program is a fortran wrapper for sasum.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine sasumsub(n,x,incx,asum)
-c
- external sasum
- real sasum,asum
- integer n,incx
- real x(*)
-c
- asum=sasum(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/scasumsub.f b/netlib/CBLAS/scasumsub.f
deleted file mode 100644
index 077ace6..0000000
--- a/netlib/CBLAS/scasumsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c scasumsub.f
-c
-c The program is a fortran wrapper for scasum.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine scasumsub(n,x,incx,asum)
-c
- external scasum
- real scasum,asum
- integer n,incx
- complex x(*)
-c
- asum=scasum(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/scnrm2sub.f b/netlib/CBLAS/scnrm2sub.f
deleted file mode 100644
index 7242c97..0000000
--- a/netlib/CBLAS/scnrm2sub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c scnrm2sub.f
-c
-c The program is a fortran wrapper for scnrm2.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine scnrm2sub(n,x,incx,nrm2)
-c
- external scnrm2
- real scnrm2,nrm2
- integer n,incx
- complex x(*)
-c
- nrm2=scnrm2(n,x,incx)
- return
- end
diff --git a/netlib/CBLAS/sdotsub.f b/netlib/CBLAS/sdotsub.f
deleted file mode 100644
index e1af3c9..0000000
--- a/netlib/CBLAS/sdotsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c sdotsub.f
-c
-c The program is a fortran wrapper for sdot.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine sdotsub(n,x,incx,y,incy,dot)
-c
- external sdot
- real sdot
- integer n,incx,incy
- real x(*),y(*),dot
-c
- dot=sdot(n,x,incx,y,incy)
- return
- end
diff --git a/netlib/CBLAS/sdsdotsub.f b/netlib/CBLAS/sdsdotsub.f
deleted file mode 100644
index 80008e9..0000000
--- a/netlib/CBLAS/sdsdotsub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c sdsdotsub.f
-c
-c The program is a fortran wrapper for sdsdot.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine sdsdotsub(n,x,incx,y,incy,dot)
-c
- external sdsdot
- real sdsdot,dot
- integer n,incx,incy
- real x(*),y(*)
-c
- dot=sdsdot(n,x,incx,y,incy)
- return
- end
diff --git a/netlib/CBLAS/snrm2sub.f b/netlib/CBLAS/snrm2sub.f
deleted file mode 100644
index 871a6e4..0000000
--- a/netlib/CBLAS/snrm2sub.f
+++ /dev/null
@@ -1,15 +0,0 @@
-c snrm2sub.f
-c
-c The program is a fortran wrapper for snrm2.
-c Witten by Keita Teranishi. 2/11/1998
-c
- subroutine snrm2sub(n,x,incx,nrm2)
-c
- external snrm2
- real snrm2,nrm2
- integer n,incx
- real x(*)
-c
- nrm2=snrm2(n,x,incx)
- return
- end
diff --git a/netlib/JNI/netlib-jni.c b/netlib/JNI/netlib-jni.c
deleted file mode 100644
index bea7262..0000000
--- a/netlib/JNI/netlib-jni.c
+++ /dev/null
@@ -1,95 +0,0 @@
-#include <netlib-jni.h>
-#include <cblas.h>
-
-// these CBLAS get* helpers are really irritating because
-// the first thing the cblas_ methods do is to do a reverse
-// lookup for the char and then pass it to the fortran lib!
-
-enum CBLAS_TRANSPOSE getCblasTrans(const char * fortranChar) {
- switch (fortranChar[0]) {
- case 'N': return CblasNoTrans;
- case 'n': return CblasNoTrans;
- case 'T': return CblasTrans;
- case 't': return CblasTrans;
- default: return -1;
- }
-}
-
-enum CBLAS_UPLO getCblasUpLo(const char * fortranChar) {
- switch (fortranChar[0]) {
- case 'U': return CblasUpper;
- case 'u': return CblasUpper;
- case 'L': return CblasLower;
- case 'l': return CblasLower;
- default: return -1;
- }
-}
-
-enum CBLAS_SIDE getCblasSide(const char * fortranChar) {
- switch (fortranChar[0]) {
- case 'L': return CblasLeft;
- case 'l': return CblasLeft;
- case 'R': return CblasRight;
- case 'r': return CblasRight;
- default: return -1;
- }
-}
-
-enum CBLAS_DIAG getCblasDiag(const char * fortranChar) {
- switch (fortranChar[0]) {
- case 'N': return CblasNonUnit;
- case 'n': return CblasNonUnit;
- case 'U': return CblasUnit;
- case 'u': return CblasUnit;
- default: return -1;
- }
-}
-
-inline void check_memory(JNIEnv * env, void * arg) {
- if (arg != NULL) {
- return;
- }
- /*
- * WARNING: Memory leak
- *
- * This doesn't clean up successful allocations prior to throwing this exception.
- * However, it's a pretty dire situation to be anyway and the client code is not
- * expected to recover.
- */
- (*env)->ThrowNew(env, (*env)->FindClass(env, "java/lang/OutOfMemoryError"),
- "Out of memory transferring array to native code in F2J JNI");
-}
-
-inline int jboolean2int(jboolean b) {
- switch (b) {
- case JNI_TRUE: return 1;
- default: return 0;
- }
-}
-
-inline jboolean int2jboolean(int i) {
- switch (i) {
- case 1: return JNI_TRUE;
- default: return JNI_FALSE;
- }
-}
-
-
-int* jbooleanArray2intArray(JNIEnv * env, jboolean * a, jint size) {
- int * j = (int*) malloc(size * sizeof(int));
- check_memory(env, j);
-
- int i;
- for (i = 0 ; i < size ; i++) {
- j[i] = jboolean2int(a[i]);
- }
- return j;
-}
-
-void intArray2jbooleanArray(int * a, jboolean * b, jint size) {
- int i;
- for (i = 0 ; i < size ; i++) {
- b[i] = int2jboolean(a[i]);
- }
-}
-
diff --git a/netlib/JNI/netlib-jni.h b/netlib/JNI/netlib-jni.h
deleted file mode 100644
index 99cb7d9..0000000
--- a/netlib/JNI/netlib-jni.h
+++ /dev/null
@@ -1,27 +0,0 @@
-#include <stdlib.h>
-#include <jni.h>
-
-typedef jobject jfloatw;
-typedef jobject jdoublew;
-typedef jobject jintw;
-typedef jobject jstringw;
-typedef jobject jbooleanw;
-
-
-// convenience methods for dealing with the CBLAS (not BLAS) specific enums
-// our API is using the Fortran-style char* system.
-enum CBLAS_TRANSPOSE getCblasTrans(const char *);
-enum CBLAS_UPLO getCblasUpLo(const char *);
-enum CBLAS_SIDE getCblasSide(const char *);
-enum CBLAS_DIAG getCblasDiag(const char *);
-
-
-/* Convenience for checking if we ran out of memory */
-void check_memory(JNIEnv *, void *);
-
-
-/* Convenience for converting between jboolean (Java Boolean) and int (Fortran LOGICAL). */
-int jboolean2int(jboolean b);
-jboolean int2jboolean(int i);
-int* jbooleanArray2intArray(JNIEnv * env, jboolean * a, jint size);
-void intArray2jbooleanArray(int * a, jboolean * b, jint size);
diff --git a/netlib/LAPACK/VARIANTS/cholesky/RL/dpotrf.f b/netlib/LAPACK/VARIANTS/cholesky/RL/dpotrf.f
deleted file mode 100644
index ce323b4..0000000
--- a/netlib/LAPACK/VARIANTS/cholesky/RL/dpotrf.f
+++ /dev/null
@@ -1,242 +0,0 @@
-C> \brief \b DPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> DPOTRF computes the Cholesky factorization of a real symmetric
-C> positive definite matrix A.
-C>
-C> The factorization has the form
-C> A = U**T * U, if UPLO = 'U', or
-C> A = L * L**T, if UPLO = 'L',
-C> where U is an upper triangular matrix and L is lower triangular.
-C>
-C> This is the right looking block version of the algorithm, calling Level 3 BLAS.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] UPLO
-C> \verbatim
-C> UPLO is CHARACTER*1
-C> = 'U': Upper triangle of A is stored;
-C> = 'L': Lower triangle of A is stored.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The order of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is DOUBLE PRECISION array, dimension (LDA,N)
-C> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-C> N-by-N upper triangular part of A contains the upper
-C> triangular part of the matrix A, and the strictly lower
-C> triangular part of A is not referenced. If UPLO = 'L', the
-C> leading N-by-N lower triangular part of A contains the lower
-C> triangular part of the matrix A, and the strictly upper
-C> triangular part of A is not referenced.
-C> \endverbatim
-C> \verbatim
-C> On exit, if INFO = 0, the factor U or L from the Cholesky
-C> factorization A = U**T*U or A = L*L**T.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,N).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, the leading minor of order i is not
-C> positive definite, and the factorization could not be
-C> completed.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsPOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DPOTF2, DSYRK, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- CALL DPOTF2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code.
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U'*U.
-*
- DO 10 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
-
- CALL DPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
-
- IF( INFO.NE.0 )
- $ GO TO 30
-
- IF( J+JB.LE.N ) THEN
-*
-* Updating the trailing submatrix.
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
- $ JB, N-J-JB+1, ONE, A( J, J ), LDA,
- $ A( J, J+JB ), LDA )
- CALL DSYRK( 'Upper', 'Transpose', N-J-JB+1, JB, -ONE,
- $ A( J, J+JB ), LDA,
- $ ONE, A( J+JB, J+JB ), LDA )
- END IF
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization A = L*L'.
-*
- DO 20 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
-
- CALL DPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
-
- IF( INFO.NE.0 )
- $ GO TO 30
-
- IF( J+JB.LE.N ) THEN
-*
-* Updating the trailing submatrix.
-*
- CALL DTRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
- $ N-J-JB+1, JB, ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
-
- CALL DSYRK( 'Lower', 'No Transpose', N-J-JB+1, JB,
- $ -ONE, A( J+JB, J ), LDA,
- $ ONE, A( J+JB, J+JB ), LDA )
- END IF
- 20 CONTINUE
- END IF
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = INFO + J - 1
-*
- 40 CONTINUE
- RETURN
-*
-* End of DPOTRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/cholesky/RL/spotrf.f b/netlib/LAPACK/VARIANTS/cholesky/RL/spotrf.f
deleted file mode 100644
index 21b0b41..0000000
--- a/netlib/LAPACK/VARIANTS/cholesky/RL/spotrf.f
+++ /dev/null
@@ -1,242 +0,0 @@
-C> \brief \b SPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> SPOTRF computes the Cholesky factorization of a real symmetric
-C> positive definite matrix A.
-C>
-C> The factorization has the form
-C> A = U**T * U, if UPLO = 'U', or
-C> A = L * L**T, if UPLO = 'L',
-C> where U is an upper triangular matrix and L is lower triangular.
-C>
-C> This is the right looking block version of the algorithm, calling Level 3 BLAS.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] UPLO
-C> \verbatim
-C> UPLO is CHARACTER*1
-C> = 'U': Upper triangle of A is stored;
-C> = 'L': Lower triangle of A is stored.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The order of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is REAL array, dimension (LDA,N)
-C> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-C> N-by-N upper triangular part of A contains the upper
-C> triangular part of the matrix A, and the strictly lower
-C> triangular part of A is not referenced. If UPLO = 'L', the
-C> leading N-by-N lower triangular part of A contains the lower
-C> triangular part of the matrix A, and the strictly upper
-C> triangular part of A is not referenced.
-C> \endverbatim
-C> \verbatim
-C> On exit, if INFO = 0, the factor U or L from the Cholesky
-C> factorization A = U**T*U or A = L*L**T.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,N).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, the leading minor of order i is not
-C> positive definite, and the factorization could not be
-C> completed.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SPOTF2, SSYRK, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- CALL SPOTF2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code.
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U'*U.
-*
- DO 10 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
-
- CALL SPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
-
- IF( INFO.NE.0 )
- $ GO TO 30
-
- IF( J+JB.LE.N ) THEN
-*
-* Updating the trailing submatrix.
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
- $ JB, N-J-JB+1, ONE, A( J, J ), LDA,
- $ A( J, J+JB ), LDA )
- CALL SSYRK( 'Upper', 'Transpose', N-J-JB+1, JB, -ONE,
- $ A( J, J+JB ), LDA,
- $ ONE, A( J+JB, J+JB ), LDA )
- END IF
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization A = L*L'.
-*
- DO 20 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
-
- CALL SPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
-
- IF( INFO.NE.0 )
- $ GO TO 30
-
- IF( J+JB.LE.N ) THEN
-*
-* Updating the trailing submatrix.
-*
- CALL STRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
- $ N-J-JB+1, JB, ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
-
- CALL SSYRK( 'Lower', 'No Transpose', N-J-JB+1, JB,
- $ -ONE, A( J+JB, J ), LDA,
- $ ONE, A( J+JB, J+JB ), LDA )
- END IF
- 20 CONTINUE
- END IF
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = INFO + J - 1
-*
- 40 CONTINUE
- RETURN
-*
-* End of SPOTRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/cholesky/TOP/dpotrf.f b/netlib/LAPACK/VARIANTS/cholesky/TOP/dpotrf.f
deleted file mode 100644
index c91669b..0000000
--- a/netlib/LAPACK/VARIANTS/cholesky/TOP/dpotrf.f
+++ /dev/null
@@ -1,238 +0,0 @@
-C> \brief \b DPOTRF VARIANT: top-looking block version of the algorithm, calling Level 3 BLAS.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> DPOTRF computes the Cholesky factorization of a real symmetric
-C> positive definite matrix A.
-C>
-C> The factorization has the form
-C> A = U**T * U, if UPLO = 'U', or
-C> A = L * L**T, if UPLO = 'L',
-C> where U is an upper triangular matrix and L is lower triangular.
-C>
-C> This is the top-looking block version of the algorithm, calling Level 3 BLAS.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] UPLO
-C> \verbatim
-C> UPLO is CHARACTER*1
-C> = 'U': Upper triangle of A is stored;
-C> = 'L': Lower triangle of A is stored.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The order of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is DOUBLE PRECISION array, dimension (LDA,N)
-C> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-C> N-by-N upper triangular part of A contains the upper
-C> triangular part of the matrix A, and the strictly lower
-C> triangular part of A is not referenced. If UPLO = 'L', the
-C> leading N-by-N lower triangular part of A contains the lower
-C> triangular part of the matrix A, and the strictly upper
-C> triangular part of A is not referenced.
-C> \endverbatim
-C> \verbatim
-C> On exit, if INFO = 0, the factor U or L from the Cholesky
-C> factorization A = U**T*U or A = L*L**T.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,N).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, the leading minor of order i is not
-C> positive definite, and the factorization could not be
-C> completed.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsPOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DPOTF2, DSYRK, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- CALL DPOTF2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code.
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U'*U.
-*
- DO 10 J = 1, N, NB
-
- JB = MIN( NB, N-J+1 )
-*
-* Compute the current block.
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
- $ J-1, JB, ONE, A( 1, 1 ), LDA,
- $ A( 1, J ), LDA )
-
- CALL DSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
- $ A( 1, J ), LDA,
- $ ONE, A( J, J ), LDA )
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- CALL DPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
-
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization A = L*L'.
-*
- DO 20 J = 1, N, NB
-
- JB = MIN( NB, N-J+1 )
-*
-* Compute the current block.
-*
- CALL DTRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
- $ JB, J-1, ONE, A( 1, 1 ), LDA,
- $ A( J, 1 ), LDA )
-
- CALL DSYRK( 'Lower', 'No Transpose', JB, J-1,
- $ -ONE, A( J, 1 ), LDA,
- $ ONE, A( J, J ), LDA )
-
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- CALL DPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
-
- 20 CONTINUE
- END IF
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = INFO + J - 1
-*
- 40 CONTINUE
- RETURN
-*
-* End of DPOTRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/cholesky/TOP/spotrf.f b/netlib/LAPACK/VARIANTS/cholesky/TOP/spotrf.f
deleted file mode 100644
index 4a46f72..0000000
--- a/netlib/LAPACK/VARIANTS/cholesky/TOP/spotrf.f
+++ /dev/null
@@ -1,237 +0,0 @@
-C> \brief \b SPOTRF VARIANT: top-looking block version of the algorithm, calling Level 3 BLAS.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> SPOTRF computes the Cholesky factorization of a real symmetric
-C> positive definite matrix A.
-C>
-C> The factorization has the form
-C> A = U**T * U, if UPLO = 'U', or
-C> A = L * L**T, if UPLO = 'L',
-C> where U is an upper triangular matrix and L is lower triangular.
-C>
-C> This is the top-looking block version of the algorithm, calling Level 3 BLAS.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] UPLO
-C> \verbatim
-C> UPLO is CHARACTER*1
-C> = 'U': Upper triangle of A is stored;
-C> = 'L': Lower triangle of A is stored.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The order of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is REAL array, dimension (LDA,N)
-C> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-C> N-by-N upper triangular part of A contains the upper
-C> triangular part of the matrix A, and the strictly lower
-C> triangular part of A is not referenced. If UPLO = 'L', the
-C> leading N-by-N lower triangular part of A contains the lower
-C> triangular part of the matrix A, and the strictly upper
-C> triangular part of A is not referenced.
-C> \endverbatim
-C> \verbatim
-C> On exit, if INFO = 0, the factor U or L from the Cholesky
-C> factorization A = U**T*U or A = L*L**T.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,N).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, the leading minor of order i is not
-C> positive definite, and the factorization could not be
-C> completed.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOTRF ( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SPOTF2, SSYRK, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- CALL SPOTF2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code.
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U'*U.
-*
- DO 10 J = 1, N, NB
-
- JB = MIN( NB, N-J+1 )
-*
-* Compute the current block.
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
- $ J-1, JB, ONE, A( 1, 1 ), LDA,
- $ A( 1, J ), LDA )
-
- CALL SSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
- $ A( 1, J ), LDA,
- $ ONE, A( J, J ), LDA )
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- CALL SPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
-
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization A = L*L'.
-*
- DO 20 J = 1, N, NB
-
- JB = MIN( NB, N-J+1 )
-*
-* Compute the current block.
-*
- CALL STRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
- $ JB, J-1, ONE, A( 1, 1 ), LDA,
- $ A( J, 1 ), LDA )
-
- CALL SSYRK( 'Lower', 'No Transpose', JB, J-1,
- $ -ONE, A( J, 1 ), LDA,
- $ ONE, A( J, J ), LDA )
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- CALL SPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
-
- 20 CONTINUE
- END IF
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = INFO + J - 1
-*
- 40 CONTINUE
- RETURN
-*
-* End of SPOTRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/lu/CR/dgetrf.f b/netlib/LAPACK/VARIANTS/lu/CR/dgetrf.f
deleted file mode 100644
index d638156..0000000
--- a/netlib/LAPACK/VARIANTS/lu/CR/dgetrf.f
+++ /dev/null
@@ -1,223 +0,0 @@
-C> \brief \b DGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> DGETRF computes an LU factorization of a general M-by-N matrix A
-C> using partial pivoting with row interchanges.
-C>
-C> The factorization has the form
-C> A = P * L * U
-C> where P is a permutation matrix, L is lower triangular with unit
-C> diagonal elements (lower trapezoidal if m > n), and U is upper
-C> triangular (upper trapezoidal if m < n).
-C>
-C> This is the Crout Level 3 BLAS version of the algorithm.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is DOUBLE PRECISION array, dimension (LDA,N)
-C> On entry, the M-by-N matrix to be factored.
-C> On exit, the factors L and U from the factorization
-C> A = P*L*U; the unit diagonal elements of L are not stored.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] IPIV
-C> \verbatim
-C> IPIV is INTEGER array, dimension (min(M,N))
-C> The pivot indices; for 1 <= i <= min(M,N), row i of the
-C> matrix was interchanged with row IPIV(i).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-C> has been completed, but the factor U is exactly
-C> singular, and division by zero will occur if it is used
-C> to solve a system of equations.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGETF2, DLASWP, DTRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL DGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Update current block.
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ M-J+1, JB, J-1, -ONE,
- $ A( J, 1 ), LDA, A( 1, J ), LDA, ONE,
- $ A( J, J ), LDA )
-
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to column 1:J-1
-*
- CALL DLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF ( J+JB.LE.N ) THEN
-*
-* Apply interchanges to column J+JB:N
-*
- CALL DLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ JB, N-J-JB+1, J-1, -ONE,
- $ A( J, 1 ), LDA, A( 1, J+JB ), LDA, ONE,
- $ A( J, J+JB ), LDA )
-*
-* Compute block row of U.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, N-J-JB+1, ONE, A( J, J ), LDA,
- $ A( J, J+JB ), LDA )
- END IF
-
- 20 CONTINUE
-
- END IF
- RETURN
-*
-* End of DGETRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/lu/CR/sgetrf.f b/netlib/LAPACK/VARIANTS/lu/CR/sgetrf.f
deleted file mode 100644
index d5aeae4..0000000
--- a/netlib/LAPACK/VARIANTS/lu/CR/sgetrf.f
+++ /dev/null
@@ -1,223 +0,0 @@
-C> \brief \b SGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> SGETRF computes an LU factorization of a general M-by-N matrix A
-C> using partial pivoting with row interchanges.
-C>
-C> The factorization has the form
-C> A = P * L * U
-C> where P is a permutation matrix, L is lower triangular with unit
-C> diagonal elements (lower trapezoidal if m > n), and U is upper
-C> triangular (upper trapezoidal if m < n).
-C>
-C> This is the Crout Level 3 BLAS version of the algorithm.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is REAL array, dimension (LDA,N)
-C> On entry, the M-by-N matrix to be factored.
-C> On exit, the factors L and U from the factorization
-C> A = P*L*U; the unit diagonal elements of L are not stored.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] IPIV
-C> \verbatim
-C> IPIV is INTEGER array, dimension (min(M,N))
-C> The pivot indices; for 1 <= i <= min(M,N), row i of the
-C> matrix was interchanged with row IPIV(i).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-C> has been completed, but the factor U is exactly
-C> singular, and division by zero will occur if it is used
-C> to solve a system of equations.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGETF2, SLASWP, STRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL SGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Update current block.
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ M-J+1, JB, J-1, -ONE,
- $ A( J, 1 ), LDA, A( 1, J ), LDA, ONE,
- $ A( J, J ), LDA )
-
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL SGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to column 1:J-1
-*
- CALL SLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF ( J+JB.LE.N ) THEN
-*
-* Apply interchanges to column J+JB:N
-*
- CALL SLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ JB, N-J-JB+1, J-1, -ONE,
- $ A( J, 1 ), LDA, A( 1, J+JB ), LDA, ONE,
- $ A( J, J+JB ), LDA )
-*
-* Compute block row of U.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, N-J-JB+1, ONE, A( J, J ), LDA,
- $ A( J, J+JB ), LDA )
- END IF
-
- 20 CONTINUE
-
- END IF
- RETURN
-*
-* End of SGETRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/lu/LL/dgetrf.f b/netlib/LAPACK/VARIANTS/lu/LL/dgetrf.f
deleted file mode 100644
index 3df00dc..0000000
--- a/netlib/LAPACK/VARIANTS/lu/LL/dgetrf.f
+++ /dev/null
@@ -1,247 +0,0 @@
-C> \brief \b DGETRF VARIANT: left-looking Level 3 BLAS version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> DGETRF computes an LU factorization of a general M-by-N matrix A
-C> using partial pivoting with row interchanges.
-C>
-C> The factorization has the form
-C> A = P * L * U
-C> where P is a permutation matrix, L is lower triangular with unit
-C> diagonal elements (lower trapezoidal if m > n), and U is upper
-C> triangular (upper trapezoidal if m < n).
-C>
-C> This is the left-looking Level 3 BLAS version of the algorithm.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is DOUBLE PRECISION array, dimension (LDA,N)
-C> On entry, the M-by-N matrix to be factored.
-C> On exit, the factors L and U from the factorization
-C> A = P*L*U; the unit diagonal elements of L are not stored.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] IPIV
-C> \verbatim
-C> IPIV is INTEGER array, dimension (min(M,N))
-C> The pivot indices; for 1 <= i <= min(M,N), row i of the
-C> matrix was interchanged with row IPIV(i).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-C> has been completed, but the factor U is exactly
-C> singular, and division by zero will occur if it is used
-C> to solve a system of equations.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, K, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGETF2, DLASWP, DTRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL DGETF2( M, N, A, LDA, IPIV, INFO )
-
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Update before factoring the current panel
-*
- DO 30 K = 1, J-NB, NB
-*
-* Apply interchanges to rows K:K+NB-1.
-*
- CALL DLASWP( JB, A(1, J), LDA, K, K+NB-1, IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ NB, JB, ONE, A( K, K ), LDA,
- $ A( K, J ), LDA )
-*
-* Update trailing submatrix.
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ M-K-NB+1, JB, NB, -ONE,
- $ A( K+NB, K ), LDA, A( K, J ), LDA, ONE,
- $ A( K+NB, J ), LDA )
- 30 CONTINUE
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
- 20 CONTINUE
-
-*
-* Apply interchanges to the left-overs
-*
- DO 40 K = 1, MIN( M, N ), NB
- CALL DLASWP( K-1, A( 1, 1 ), LDA, K,
- $ MIN (K+NB-1, MIN ( M, N )), IPIV, 1 )
- 40 CONTINUE
-*
-* Apply update to the M+1:N columns when N > M
-*
- IF ( N.GT.M ) THEN
-
- CALL DLASWP( N-M, A(1, M+1), LDA, 1, M, IPIV, 1 )
-
- DO 50 K = 1, M, NB
-
- JB = MIN( M-K+1, NB )
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, N-M, ONE, A( K, K ), LDA,
- $ A( K, M+1 ), LDA )
-
-*
- IF ( K+NB.LE.M ) THEN
- CALL DGEMM( 'No transpose', 'No transpose',
- $ M-K-NB+1, N-M, NB, -ONE,
- $ A( K+NB, K ), LDA, A( K, M+1 ), LDA, ONE,
- $ A( K+NB, M+1 ), LDA )
- END IF
- 50 CONTINUE
- END IF
-*
- END IF
- RETURN
-*
-* End of DGETRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/lu/LL/sgetrf.f b/netlib/LAPACK/VARIANTS/lu/LL/sgetrf.f
deleted file mode 100644
index c36d8e7..0000000
--- a/netlib/LAPACK/VARIANTS/lu/LL/sgetrf.f
+++ /dev/null
@@ -1,248 +0,0 @@
-C> \brief \b SGETRF VARIANT: left-looking Level 3 BLAS version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> SGETRF computes an LU factorization of a general M-by-N matrix A
-C> using partial pivoting with row interchanges.
-C>
-C> The factorization has the form
-C> A = P * L * U
-C> where P is a permutation matrix, L is lower triangular with unit
-C> diagonal elements (lower trapezoidal if m > n), and U is upper
-C> triangular (upper trapezoidal if m < n).
-C>
-C> This is the left-looking Level 3 BLAS version of the algorithm.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is REAL array, dimension (LDA,N)
-C> On entry, the M-by-N matrix to be factored.
-C> On exit, the factors L and U from the factorization
-C> A = P*L*U; the unit diagonal elements of L are not stored.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] IPIV
-C> \verbatim
-C> IPIV is INTEGER array, dimension (min(M,N))
-C> The pivot indices; for 1 <= i <= min(M,N), row i of the
-C> matrix was interchanged with row IPIV(i).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-C> has been completed, but the factor U is exactly
-C> singular, and division by zero will occur if it is used
-C> to solve a system of equations.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRF ( M, N, A, LDA, IPIV, INFO)
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, K, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGETF2, SLASWP, STRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL SGETF2( M, N, A, LDA, IPIV, INFO )
-
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-*
-* Update before factoring the current panel
-*
- DO 30 K = 1, J-NB, NB
-*
-* Apply interchanges to rows K:K+NB-1.
-*
- CALL SLASWP( JB, A(1, J), LDA, K, K+NB-1, IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ NB, JB, ONE, A( K, K ), LDA,
- $ A( K, J ), LDA )
-*
-* Update trailing submatrix.
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ M-K-NB+1, JB, NB, -ONE,
- $ A( K+NB, K ), LDA, A( K, J ), LDA, ONE,
- $ A( K+NB, J ), LDA )
- 30 CONTINUE
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL SGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
- 20 CONTINUE
-
-*
-* Apply interchanges to the left-overs
-*
- DO 40 K = 1, MIN( M, N ), NB
- CALL SLASWP( K-1, A( 1, 1 ), LDA, K,
- $ MIN (K+NB-1, MIN ( M, N )), IPIV, 1 )
- 40 CONTINUE
-*
-* Apply update to the M+1:N columns when N > M
-*
- IF ( N.GT.M ) THEN
-
- CALL SLASWP( N-M, A(1, M+1), LDA, 1, M, IPIV, 1 )
-
- DO 50 K = 1, M, NB
-
- JB = MIN( M-K+1, NB )
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, N-M, ONE, A( K, K ), LDA,
- $ A( K, M+1 ), LDA )
-
-*
- IF ( K+NB.LE.M ) THEN
- CALL SGEMM( 'No transpose', 'No transpose',
- $ M-K-NB+1, N-M, NB, -ONE,
- $ A( K+NB, K ), LDA, A( K, M+1 ), LDA, ONE,
- $ A( K+NB, M+1 ), LDA )
- END IF
- 50 CONTINUE
- END IF
-*
- END IF
- RETURN
-*
-* End of SGETRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/lu/REC/dgetrf.f b/netlib/LAPACK/VARIANTS/lu/REC/dgetrf.f
deleted file mode 100644
index 318c166..0000000
--- a/netlib/LAPACK/VARIANTS/lu/REC/dgetrf.f
+++ /dev/null
@@ -1,277 +0,0 @@
-C> \brief \b DGETRF VARIANT: iterative version of Sivan Toledo's recursive LU algorithm
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> DGETRF computes an LU factorization of a general M-by-N matrix A
-C> using partial pivoting with row interchanges.
-C>
-C> The factorization has the form
-C> A = P * L * U
-C> where P is a permutation matrix, L is lower triangular with unit
-C> diagonal elements (lower trapezoidal if m > n), and U is upper
-C> triangular (upper trapezoidal if m < n).
-C>
-C> This code implements an iterative version of Sivan Toledo's recursive
-C> LU algorithm[1]. For square matrices, this iterative versions should
-C> be within a factor of two of the optimum number of memory transfers.
-C>
-C> The pattern is as follows, with the large blocks of U being updated
-C> in one call to DTRSM, and the dotted lines denoting sections that
-C> have had all pending permutations applied:
-C>
-C> 1 2 3 4 5 6 7 8
-C> +-+-+---+-------+------
-C> | |1| | |
-C> |.+-+ 2 | |
-C> | | | | |
-C> |.|.+-+-+ 4 |
-C> | | | |1| |
-C> | | |.+-+ |
-C> | | | | | |
-C> |.|.|.|.+-+-+---+ 8
-C> | | | | | |1| |
-C> | | | | |.+-+ 2 |
-C> | | | | | | | |
-C> | | | | |.|.+-+-+
-C> | | | | | | | |1|
-C> | | | | | | |.+-+
-C> | | | | | | | | |
-C> |.|.|.|.|.|.|.|.+-----
-C> | | | | | | | | |
-C>
-C> The 1-2-1-4-1-2-1-8-... pattern is the position of the last 1 bit in
-C> the binary expansion of the current column. Each Schur update is
-C> applied as soon as the necessary portion of U is available.
-C>
-C> [1] Toledo, S. 1997. Locality of Reference in LU Decomposition with
-C> Partial Pivoting. SIAM J. Matrix Anal. Appl. 18, 4 (Oct. 1997),
-C> 1065-1081. http://dx.doi.org/10.1137/S0895479896297744
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is DOUBLE PRECISION array, dimension (LDA,N)
-C> On entry, the M-by-N matrix to be factored.
-C> On exit, the factors L and U from the factorization
-C> A = P*L*U; the unit diagonal elements of L are not stored.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] IPIV
-C> \verbatim
-C> IPIV is INTEGER array, dimension (min(M,N))
-C> The pivot indices; for 1 <= i <= min(M,N), row i of the
-C> matrix was interchanged with row IPIV(i).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-C> has been completed, but the factor U is exactly
-C> singular, and division by zero will occur if it is used
-C> to solve a system of equations.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.X) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO, NEGONE
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
- PARAMETER ( NEGONE = -1.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION SFMIN, TMP
- INTEGER I, J, JP, NSTEP, NTOPIV, NPIVED, KAHEAD
- INTEGER KSTART, IPIVSTART, JPIVSTART, KCOLS
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER IDAMAX
- LOGICAL DISNAN
- EXTERNAL DLAMCH, IDAMAX, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DTRSM, DSCAL, XERBLA, DLASWP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, IAND
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = DLAMCH( 'S' )
-*
- NSTEP = MIN( M, N )
- DO J = 1, NSTEP
- KAHEAD = IAND( J, -J )
- KSTART = J + 1 - KAHEAD
- KCOLS = MIN( KAHEAD, M-J )
-*
-* Find pivot.
-*
- JP = J - 1 + IDAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
-
-* Permute just this column.
- IF (JP .NE. J) THEN
- TMP = A( J, J )
- A( J, J ) = A( JP, J )
- A( JP, J ) = TMP
- END IF
-
-* Apply pending permutations to L
- NTOPIV = 1
- IPIVSTART = J
- JPIVSTART = J - NTOPIV
- DO WHILE ( NTOPIV .LT. KAHEAD )
- CALL DLASWP( NTOPIV, A( 1, JPIVSTART ), LDA, IPIVSTART, J,
- $ IPIV, 1 )
- IPIVSTART = IPIVSTART - NTOPIV;
- NTOPIV = NTOPIV * 2;
- JPIVSTART = JPIVSTART - NTOPIV;
- END DO
-
-* Permute U block to match L
- CALL DLASWP( KCOLS, A( 1,J+1 ), LDA, KSTART, J, IPIV, 1 )
-
-* Factor the current column
- IF( A( J, J ).NE.ZERO .AND. .NOT.DISNAN( A( J, J ) ) ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL DSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- END DO
- END IF
- ELSE IF( A( J,J ) .EQ. ZERO .AND. INFO .EQ. 0 ) THEN
- INFO = J
- END IF
-
-* Solve for U block.
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', KAHEAD,
- $ KCOLS, ONE, A( KSTART, KSTART ), LDA,
- $ A( KSTART, J+1 ), LDA )
-* Schur complement.
- CALL DGEMM( 'No transpose', 'No transpose', M-J,
- $ KCOLS, KAHEAD, NEGONE, A( J+1, KSTART ), LDA,
- $ A( KSTART, J+1 ), LDA, ONE, A( J+1, J+1 ), LDA )
- END DO
-
-* Handle pivot permutations on the way out of the recursion
- NPIVED = IAND( NSTEP, -NSTEP )
- J = NSTEP - NPIVED
- DO WHILE ( J .GT. 0 )
- NTOPIV = IAND( J, -J )
- CALL DLASWP( NTOPIV, A( 1, J-NTOPIV+1 ), LDA, J+1, NSTEP,
- $ IPIV, 1 )
- J = J - NTOPIV
- END DO
-
-* If short and wide, handle the rest of the columns.
- IF ( M .LT. N ) THEN
- CALL DLASWP( N-M, A( 1, M+KCOLS+1 ), LDA, 1, M, IPIV, 1 )
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', M,
- $ N-M, ONE, A, LDA, A( 1,M+KCOLS+1 ), LDA )
- END IF
-
- RETURN
-*
-* End of DGETRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/lu/REC/sgetrf.f b/netlib/LAPACK/VARIANTS/lu/REC/sgetrf.f
deleted file mode 100644
index 9df7d5b..0000000
--- a/netlib/LAPACK/VARIANTS/lu/REC/sgetrf.f
+++ /dev/null
@@ -1,277 +0,0 @@
-C> \brief \b SGETRF VARIANT: iterative version of Sivan Toledo's recursive LU algorithm
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> SGETRF computes an LU factorization of a general M-by-N matrix A
-C> using partial pivoting with row interchanges.
-C>
-C> The factorization has the form
-C> A = P * L * U
-C> where P is a permutation matrix, L is lower triangular with unit
-C> diagonal elements (lower trapezoidal if m > n), and U is upper
-C> triangular (upper trapezoidal if m < n).
-C>
-C> This code implements an iterative version of Sivan Toledo's recursive
-C> LU algorithm[1]. For square matrices, this iterative versions should
-C> be within a factor of two of the optimum number of memory transfers.
-C>
-C> The pattern is as follows, with the large blocks of U being updated
-C> in one call to STRSM, and the dotted lines denoting sections that
-C> have had all pending permutations applied:
-C>
-C> 1 2 3 4 5 6 7 8
-C> +-+-+---+-------+------
-C> | |1| | |
-C> |.+-+ 2 | |
-C> | | | | |
-C> |.|.+-+-+ 4 |
-C> | | | |1| |
-C> | | |.+-+ |
-C> | | | | | |
-C> |.|.|.|.+-+-+---+ 8
-C> | | | | | |1| |
-C> | | | | |.+-+ 2 |
-C> | | | | | | | |
-C> | | | | |.|.+-+-+
-C> | | | | | | | |1|
-C> | | | | | | |.+-+
-C> | | | | | | | | |
-C> |.|.|.|.|.|.|.|.+-----
-C> | | | | | | | | |
-C>
-C> The 1-2-1-4-1-2-1-8-... pattern is the position of the last 1 bit in
-C> the binary expansion of the current column. Each Schur update is
-C> applied as soon as the necessary portion of U is available.
-C>
-C> [1] Toledo, S. 1997. Locality of Reference in LU Decomposition with
-C> Partial Pivoting. SIAM J. Matrix Anal. Appl. 18, 4 (Oct. 1997),
-C> 1065-1081. http://dx.doi.org/10.1137/S0895479896297744
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is REAL array, dimension (LDA,N)
-C> On entry, the M-by-N matrix to be factored.
-C> On exit, the factors L and U from the factorization
-C> A = P*L*U; the unit diagonal elements of L are not stored.
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] IPIV
-C> \verbatim
-C> IPIV is INTEGER array, dimension (min(M,N))
-C> The pivot indices; for 1 <= i <= min(M,N), row i of the
-C> matrix was interchanged with row IPIV(i).
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-C> has been completed, but the factor U is exactly
-C> singular, and division by zero will occur if it is used
-C> to solve a system of equations.
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.X) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO, NEGONE
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
- PARAMETER ( NEGONE = -1.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL SFMIN, TMP
- INTEGER I, J, JP, NSTEP, NTOPIV, NPIVED, KAHEAD
- INTEGER KSTART, IPIVSTART, JPIVSTART, KCOLS
-* ..
-* .. External Functions ..
- REAL SLAMCH
- INTEGER ISAMAX
- LOGICAL SISNAN
- EXTERNAL SLAMCH, ISAMAX, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL STRSM, SSCAL, XERBLA, SLASWP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, IAND
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = SLAMCH( 'S' )
-*
- NSTEP = MIN( M, N )
- DO J = 1, NSTEP
- KAHEAD = IAND( J, -J )
- KSTART = J + 1 - KAHEAD
- KCOLS = MIN( KAHEAD, M-J )
-*
-* Find pivot.
-*
- JP = J - 1 + ISAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
-
-! Permute just this column.
- IF (JP .NE. J) THEN
- TMP = A( J, J )
- A( J, J ) = A( JP, J )
- A( JP, J ) = TMP
- END IF
-
-! Apply pending permutations to L
- NTOPIV = 1
- IPIVSTART = J
- JPIVSTART = J - NTOPIV
- DO WHILE ( NTOPIV .LT. KAHEAD )
- CALL SLASWP( NTOPIV, A( 1, JPIVSTART ), LDA, IPIVSTART, J,
- $ IPIV, 1 )
- IPIVSTART = IPIVSTART - NTOPIV;
- NTOPIV = NTOPIV * 2;
- JPIVSTART = JPIVSTART - NTOPIV;
- END DO
-
-! Permute U block to match L
- CALL SLASWP( KCOLS, A( 1,J+1 ), LDA, KSTART, J, IPIV, 1 )
-
-! Factor the current column
- IF( A( J, J ).NE.ZERO .AND. .NOT.SISNAN( A( J, J ) ) ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL SSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- END DO
- END IF
- ELSE IF( A( J,J ) .EQ. ZERO .AND. INFO .EQ. 0 ) THEN
- INFO = J
- END IF
-
-! Solve for U block.
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', KAHEAD,
- $ KCOLS, ONE, A( KSTART, KSTART ), LDA,
- $ A( KSTART, J+1 ), LDA )
-! Schur complement.
- CALL SGEMM( 'No transpose', 'No transpose', M-J,
- $ KCOLS, KAHEAD, NEGONE, A( J+1, KSTART ), LDA,
- $ A( KSTART, J+1 ), LDA, ONE, A( J+1, J+1 ), LDA )
- END DO
-
-! Handle pivot permutations on the way out of the recursion
- NPIVED = IAND( NSTEP, -NSTEP )
- J = NSTEP - NPIVED
- DO WHILE ( J .GT. 0 )
- NTOPIV = IAND( J, -J )
- CALL SLASWP( NTOPIV, A( 1, J-NTOPIV+1 ), LDA, J+1, NSTEP,
- $ IPIV, 1 )
- J = J - NTOPIV
- END DO
-
-! If short and wide, handle the rest of the columns.
- IF ( M .LT. N ) THEN
- CALL SLASWP( N-M, A( 1, M+KCOLS+1 ), LDA, 1, M, IPIV, 1 )
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', M,
- $ N-M, ONE, A, LDA, A( 1,M+KCOLS+1 ), LDA )
- END IF
-
- RETURN
-*
-* End of SGETRF
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/qr/LL/dgeqrf.f b/netlib/LAPACK/VARIANTS/qr/LL/dgeqrf.f
deleted file mode 100644
index b6fa5ac..0000000
--- a/netlib/LAPACK/VARIANTS/qr/LL/dgeqrf.f
+++ /dev/null
@@ -1,417 +0,0 @@
-C> \brief \b DGEQRF VARIANT: left-looking Level 3 BLAS version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQRF ( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> DGEQRF computes a QR factorization of a real M-by-N matrix A:
-C> A = Q * R.
-C>
-C> This is the left-looking Level 3 BLAS version of the algorithm.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is DOUBLE PRECISION array, dimension (LDA,N)
-C> On entry, the M-by-N matrix A.
-C> On exit, the elements on and above the diagonal of the array
-C> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-C> upper triangular if m >= n); the elements below the diagonal,
-C> with the array TAU, represent the orthogonal matrix Q as a
-C> product of min(m,n) elementary reflectors (see Further
-C> Details).
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] TAU
-C> \verbatim
-C> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-C> The scalar factors of the elementary reflectors (see Further
-C> Details).
-C> \endverbatim
-C>
-C> \param[out] WORK
-C> \verbatim
-C> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-C> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-C> \endverbatim
-C>
-C> \param[in] LWORK
-C> \verbatim
-C> LWORK is INTEGER
-C> \endverbatim
-C> \verbatim
-C> The dimension of the array WORK. The dimension can be divided into three parts.
-C> \endverbatim
-C> \verbatim
-C> 1) The part for the triangular factor T. If the very last T is not bigger
-C> than any of the rest, then this part is NB x ceiling(K/NB), otherwise,
-C> NB x (K-NT), where K = min(M,N) and NT is the dimension of the very last T
-C> \endverbatim
-C> \verbatim
-C> 2) The part for the very last T when T is bigger than any of the rest T.
-C> The size of this part is NT x NT, where NT = K - ceiling ((K-NX)/NB) x NB,
-C> where K = min(M,N), NX is calculated by
-C> NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
-C> \endverbatim
-C> \verbatim
-C> 3) The part for dlarfb is of size max((N-M)*K, (N-M)*NB, K*NB, NB*NB)
-C> \endverbatim
-C> \verbatim
-C> So LWORK = part1 + part2 + part3
-C> \endverbatim
-C> \verbatim
-C> If LWORK = -1, then a workspace query is assumed; the routine
-C> only calculates the optimal size of the WORK array, returns
-C> this value as the first entry of the WORK array, and no error
-C> message related to LWORK is issued by XERBLA.
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* Further Details
-* ===============
-C>\details \b Further \b Details
-C> \verbatim
-C>
-C> The matrix Q is represented as a product of elementary reflectors
-C>
-C> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-C>
-C> Each H(i) has the form
-C>
-C> H(i) = I - tau * v * v'
-C>
-C> where tau is a real scalar, and v is a real vector with
-C> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-C> and tau in TAU(i).
-C>
-C> \endverbatim
-C>
-* =====================================================================
- SUBROUTINE DGEQRF ( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, K, LWKOPT, NB,
- $ NBMIN, NX, LBWORK, NT, LLWORK
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQR2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SCEIL
- EXTERNAL ILAENV, SCEIL
-* ..
-* .. Executable Statements ..
-
- INFO = 0
- NBMIN = 2
- NX = 0
- IWS = N
- K = MIN( M, N )
- NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
- END IF
-*
-* Get NT, the size of the very last T, which is the left-over from in-between K-NX and K to K, eg.:
-*
-* NB=3 2NB=6 K=10
-* | | |
-* 1--2--3--4--5--6--7--8--9--10
-* | \________/
-* K-NX=5 NT=4
-*
-* So here 4 x 4 is the last T stored in the workspace
-*
- NT = K-SCEIL(REAL(K-NX)/REAL(NB))*NB
-
-*
-* optimal workspace = space for dlarfb + space for normal T's + space for the last T
-*
- LLWORK = MAX (MAX((N-M)*K, (N-M)*NB), MAX(K*NB, NB*NB))
- LLWORK = SCEIL(REAL(LLWORK)/REAL(NB))
-
- IF ( NT.GT.NB ) THEN
-
- LBWORK = K-NT
-*
-* Optimal workspace for dlarfb = MAX(1,N)*NT
-*
- LWKOPT = (LBWORK+LLWORK)*NB
- WORK( 1 ) = (LWKOPT+NT*NT)
-
- ELSE
-
- LBWORK = SCEIL(REAL(K)/REAL(NB))*NB
- LWKOPT = (LBWORK+LLWORK-NB)*NB
- WORK( 1 ) = LWKOPT
-
- END IF
-
-*
-* Test the input arguments
-*
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- IF ( NT.LE.NB ) THEN
- IWS = (LBWORK+LLWORK-NB)*NB
- ELSE
- IWS = (LBWORK+LLWORK)*NB+NT*NT
- END IF
-
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- IF ( NT.LE.NB ) THEN
- NB = LWORK / (LLWORK+(LBWORK-NB))
- ELSE
- NB = (LWORK-NT*NT)/(LBWORK+LLWORK)
- END IF
-
- NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Update the current column using old T's
-*
- DO 20 J = 1, I - NB, NB
-*
-* Apply H' to A(J:M,I:I+IB-1) from the left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, IB, NB,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, I ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ IB)
-
-20 CONTINUE
-*
-* Compute the QR factorization of the current block
-* A(I:M,I:I+IB-1)
-*
- CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ),
- $ WORK(LBWORK*NB+NT*NT+1), IINFO )
-
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ),
- $ WORK(I), LBWORK )
-*
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K ) THEN
-
- IF ( I .NE. 1 ) THEN
-
- DO 30 J = 1, I - NB, NB
-*
-* Apply H' to A(J:M,I:K) from the left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, K-I+1, NB,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, I ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ K-I+1)
-30 CONTINUE
-
- CALL DGEQR2( M-I+1, K-I+1, A( I, I ), LDA, TAU( I ),
- $ WORK(LBWORK*NB+NT*NT+1),IINFO )
-
- ELSE
-*
-* Use unblocked code to factor the last or only block.
-*
- CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ),
- $ WORK,IINFO )
-
- END IF
- END IF
-
-
-*
-* Apply update to the column M+1:N when N > M
-*
- IF ( M.LT.N .AND. I.NE.1) THEN
-*
-* Form the last triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- IF ( NT .LE. NB ) THEN
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, K-I+1,
- $ A( I, I ), LDA, TAU( I ), WORK(I), LBWORK )
- ELSE
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, K-I+1,
- $ A( I, I ), LDA, TAU( I ),
- $ WORK(LBWORK*NB+1), NT )
- END IF
-
-*
-* Apply H' to A(1:M,M+1:N) from the left
-*
- DO 40 J = 1, K-NX, NB
-
- IB = MIN( K-J+1, NB )
-
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, N-M, IB,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ N-M)
-
-40 CONTINUE
-
- IF ( NT.LE.NB ) THEN
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, N-M, K-J+1,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ N-M)
- ELSE
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, N-M, K-J+1,
- $ A( J, J ), LDA,
- $ WORK(LBWORK*NB+1),
- $ NT, A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ N-M)
- END IF
-
- END IF
-
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGEQRF
-*
- END
-
diff --git a/netlib/LAPACK/VARIANTS/qr/LL/sceil.f b/netlib/LAPACK/VARIANTS/qr/LL/sceil.f
deleted file mode 100644
index 397b7df..0000000
--- a/netlib/LAPACK/VARIANTS/qr/LL/sceil.f
+++ /dev/null
@@ -1,87 +0,0 @@
-C> \brief \b SCEIL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SCEIL( A )
-*
-* .. Scalar Arguments ..
-* REAL A
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
-* INTRINSIC INT
-* ..
-* .. Executable Statements ..*
-*
-* IF (A-INT(A).EQ.0) THEN
-* SCEIL = A
-* ELSE IF (A.GT.0) THEN
-* SCEIL = INT(A)+1;
-* ELSE
-* SCEIL = INT(A)
-* END IF
-*
-* RETURN
-*
-* END
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsOTHERcomputational
-*
-* =====================================================================
- REAL FUNCTION SCEIL( A )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..*
- REAL A
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC INT
-* ..
-* .. Executable Statements ..*
-*
- IF (A-INT(A).EQ.0) THEN
- SCEIL = A
- ELSE IF (A.GT.0) THEN
- SCEIL = INT(A)+1;
- ELSE
- SCEIL = INT(A)
- END IF
-
- RETURN
-*
- END
diff --git a/netlib/LAPACK/VARIANTS/qr/LL/sgeqrf.f b/netlib/LAPACK/VARIANTS/qr/LL/sgeqrf.f
deleted file mode 100644
index 1d22897..0000000
--- a/netlib/LAPACK/VARIANTS/qr/LL/sgeqrf.f
+++ /dev/null
@@ -1,416 +0,0 @@
-C> \brief \b SGEQRF VARIANT: left-looking Level 3 BLAS version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQRF ( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* Purpose
-* =======
-*
-C>\details \b Purpose:
-C>\verbatim
-C>
-C> SGEQRF computes a QR factorization of a real M-by-N matrix A:
-C> A = Q * R.
-C>
-C> This is the left-looking Level 3 BLAS version of the algorithm.
-C>
-C>\endverbatim
-*
-* Arguments:
-* ==========
-*
-C> \param[in] M
-C> \verbatim
-C> M is INTEGER
-C> The number of rows of the matrix A. M >= 0.
-C> \endverbatim
-C>
-C> \param[in] N
-C> \verbatim
-C> N is INTEGER
-C> The number of columns of the matrix A. N >= 0.
-C> \endverbatim
-C>
-C> \param[in,out] A
-C> \verbatim
-C> A is REAL array, dimension (LDA,N)
-C> On entry, the M-by-N matrix A.
-C> On exit, the elements on and above the diagonal of the array
-C> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-C> upper triangular if m >= n); the elements below the diagonal,
-C> with the array TAU, represent the orthogonal matrix Q as a
-C> product of min(m,n) elementary reflectors (see Further
-C> Details).
-C> \endverbatim
-C>
-C> \param[in] LDA
-C> \verbatim
-C> LDA is INTEGER
-C> The leading dimension of the array A. LDA >= max(1,M).
-C> \endverbatim
-C>
-C> \param[out] TAU
-C> \verbatim
-C> TAU is REAL array, dimension (min(M,N))
-C> The scalar factors of the elementary reflectors (see Further
-C> Details).
-C> \endverbatim
-C>
-C> \param[out] WORK
-C> \verbatim
-C> WORK is REAL array, dimension (MAX(1,LWORK))
-C> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-C> \endverbatim
-C>
-C> \param[in] LWORK
-C> \verbatim
-C> LWORK is INTEGER
-C> \endverbatim
-C> \verbatim
-C> The dimension of the array WORK. The dimension can be divided into three parts.
-C> \endverbatim
-C> \verbatim
-C> 1) The part for the triangular factor T. If the very last T is not bigger
-C> than any of the rest, then this part is NB x ceiling(K/NB), otherwise,
-C> NB x (K-NT), where K = min(M,N) and NT is the dimension of the very last T
-C> \endverbatim
-C> \verbatim
-C> 2) The part for the very last T when T is bigger than any of the rest T.
-C> The size of this part is NT x NT, where NT = K - ceiling ((K-NX)/NB) x NB,
-C> where K = min(M,N), NX is calculated by
-C> NX = MAX( 0, ILAENV( 3, 'SGEQRF', ' ', M, N, -1, -1 ) )
-C> \endverbatim
-C> \verbatim
-C> 3) The part for dlarfb is of size max((N-M)*K, (N-M)*NB, K*NB, NB*NB)
-C> \endverbatim
-C> \verbatim
-C> So LWORK = part1 + part2 + part3
-C> \endverbatim
-C> \verbatim
-C> If LWORK = -1, then a workspace query is assumed; the routine
-C> only calculates the optimal size of the WORK array, returns
-C> this value as the first entry of the WORK array, and no error
-C> message related to LWORK is issued by XERBLA.
-C> \endverbatim
-C>
-C> \param[out] INFO
-C> \verbatim
-C> INFO is INTEGER
-C> = 0: successful exit
-C> < 0: if INFO = -i, the i-th argument had an illegal value
-C> \endverbatim
-C>
-*
-* Authors:
-* ========
-*
-C> \author Univ. of Tennessee
-C> \author Univ. of California Berkeley
-C> \author Univ. of Colorado Denver
-C> \author NAG Ltd.
-*
-C> \date November 2011
-*
-C> \ingroup variantsGEcomputational
-*
-* Further Details
-* ===============
-C>\details \b Further \b Details
-C> \verbatim
-C>
-C> The matrix Q is represented as a product of elementary reflectors
-C>
-C> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-C>
-C> Each H(i) has the form
-C>
-C> H(i) = I - tau * v * v'
-C>
-C> where tau is a real scalar, and v is a real vector with
-C> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-C> and tau in TAU(i).
-C>
-C> \endverbatim
-C>
-* =====================================================================
- SUBROUTINE SGEQRF ( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, K, LWKOPT, NB,
- $ NBMIN, NX, LBWORK, NT, LLWORK
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQR2, SLARFB, SLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SCEIL
- EXTERNAL ILAENV, SCEIL
-* ..
-* .. Executable Statements ..
-
- INFO = 0
- NBMIN = 2
- NX = 0
- IWS = N
- K = MIN( M, N )
- NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
-
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGEQRF', ' ', M, N, -1, -1 ) )
- END IF
-*
-* Get NT, the size of the very last T, which is the left-over from in-between K-NX and K to K, eg.:
-*
-* NB=3 2NB=6 K=10
-* | | |
-* 1--2--3--4--5--6--7--8--9--10
-* | \________/
-* K-NX=5 NT=4
-*
-* So here 4 x 4 is the last T stored in the workspace
-*
- NT = K-SCEIL(REAL(K-NX)/REAL(NB))*NB
-
-*
-* optimal workspace = space for dlarfb + space for normal T's + space for the last T
-*
- LLWORK = MAX (MAX((N-M)*K, (N-M)*NB), MAX(K*NB, NB*NB))
- LLWORK = SCEIL(REAL(LLWORK)/REAL(NB))
-
- IF ( NT.GT.NB ) THEN
-
- LBWORK = K-NT
-*
-* Optimal workspace for dlarfb = MAX(1,N)*NT
-*
- LWKOPT = (LBWORK+LLWORK)*NB
- WORK( 1 ) = (LWKOPT+NT*NT)
-
- ELSE
-
- LBWORK = SCEIL(REAL(K)/REAL(NB))*NB
- LWKOPT = (LBWORK+LLWORK-NB)*NB
- WORK( 1 ) = LWKOPT
-
- END IF
-
-*
-* Test the input arguments
-*
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- IF ( NT.LE.NB ) THEN
- IWS = (LBWORK+LLWORK-NB)*NB
- ELSE
- IWS = (LBWORK+LLWORK)*NB+NT*NT
- END IF
-
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- IF ( NT.LE.NB ) THEN
- NB = LWORK / (LLWORK+(LBWORK-NB))
- ELSE
- NB = (LWORK-NT*NT)/(LBWORK+LLWORK)
- END IF
-
- NBMIN = MAX( 2, ILAENV( 2, 'SGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Update the current column using old T's
-*
- DO 20 J = 1, I - NB, NB
-*
-* Apply H' to A(J:M,I:I+IB-1) from the left
-*
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, IB, NB,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, I ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ IB)
-
-20 CONTINUE
-*
-* Compute the QR factorization of the current block
-* A(I:M,I:I+IB-1)
-*
- CALL SGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ),
- $ WORK(LBWORK*NB+NT*NT+1), IINFO )
-
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ),
- $ WORK(I), LBWORK )
-*
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K ) THEN
-
- IF ( I .NE. 1 ) THEN
-
- DO 30 J = 1, I - NB, NB
-*
-* Apply H' to A(J:M,I:K) from the left
-*
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, K-I+1, NB,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, I ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ K-I+1)
-30 CONTINUE
-
- CALL SGEQR2( M-I+1, K-I+1, A( I, I ), LDA, TAU( I ),
- $ WORK(LBWORK*NB+NT*NT+1),IINFO )
-
- ELSE
-*
-* Use unblocked code to factor the last or only block.
-*
- CALL SGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ),
- $ WORK,IINFO )
-
- END IF
- END IF
-
-
-*
-* Apply update to the column M+1:N when N > M
-*
- IF ( M.LT.N .AND. I.NE.1) THEN
-*
-* Form the last triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- IF ( NT .LE. NB ) THEN
- CALL SLARFT( 'Forward', 'Columnwise', M-I+1, K-I+1,
- $ A( I, I ), LDA, TAU( I ), WORK(I), LBWORK )
- ELSE
- CALL SLARFT( 'Forward', 'Columnwise', M-I+1, K-I+1,
- $ A( I, I ), LDA, TAU( I ),
- $ WORK(LBWORK*NB+1), NT )
- END IF
-
-*
-* Apply H' to A(1:M,M+1:N) from the left
-*
- DO 40 J = 1, K-NX, NB
-
- IB = MIN( K-J+1, NB )
-
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, N-M, IB,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ N-M)
-
-40 CONTINUE
-
- IF ( NT.LE.NB ) THEN
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, N-M, K-J+1,
- $ A( J, J ), LDA, WORK(J), LBWORK,
- $ A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ N-M)
- ELSE
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-J+1, N-M, K-J+1,
- $ A( J, J ), LDA,
- $ WORK(LBWORK*NB+1),
- $ NT, A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
- $ N-M)
- END IF
-
- END IF
-
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGEQRF
-*
- END
diff --git a/netlib/LAPACK/chla_transtype.f b/netlib/LAPACK/chla_transtype.f
deleted file mode 100644
index 00ba4f5..0000000
--- a/netlib/LAPACK/chla_transtype.f
+++ /dev/null
@@ -1,91 +0,0 @@
-*> \brief \b CHLA_TRANSTYPE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download CHLA_TRANSTYPE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chla_transtype.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chla_transtype.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chla_transtype.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* CHARACTER*1 FUNCTION CHLA_TRANSTYPE( TRANS )
-*
-* .. Scalar Arguments ..
-* INTEGER TRANS
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine translates from a BLAST-specified integer constant to
-*> the character string specifying a transposition operation.
-*>
-*> CHLA_TRANSTYPE returns an CHARACTER*1. If CHLA_TRANSTYPE is 'X',
-*> then input is not an integer indicating a transposition operator.
-*> Otherwise CHLA_TRANSTYPE returns the constant value corresponding to
-*> TRANS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- CHARACTER*1 FUNCTION CHLA_TRANSTYPE( TRANS )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER TRANS
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_NO_TRANS, BLAS_TRANS, BLAS_CONJ_TRANS
- PARAMETER ( BLAS_NO_TRANS = 111, BLAS_TRANS = 112,
- $ BLAS_CONJ_TRANS = 113 )
-* ..
-* .. Executable Statements ..
- IF( TRANS.EQ.BLAS_NO_TRANS ) THEN
- CHLA_TRANSTYPE = 'N'
- ELSE IF( TRANS.EQ.BLAS_TRANS ) THEN
- CHLA_TRANSTYPE = 'T'
- ELSE IF( TRANS.EQ.BLAS_CONJ_TRANS ) THEN
- CHLA_TRANSTYPE = 'C'
- ELSE
- CHLA_TRANSTYPE = 'X'
- END IF
- RETURN
-*
-* End of CHLA_TRANSTYPE
-*
- END
diff --git a/netlib/LAPACK/dbbcsd.f b/netlib/LAPACK/dbbcsd.f
deleted file mode 100644
index 479168e..0000000
--- a/netlib/LAPACK/dbbcsd.f
+++ /dev/null
@@ -1,1077 +0,0 @@
-*> \brief \b DBBCSD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DBBCSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dbbcsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dbbcsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dbbcsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q,
-* THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T,
-* V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
-* B22D, B22E, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS
-* INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B11D( * ), B11E( * ), B12D( * ), B12E( * ),
-* $ B21D( * ), B21E( * ), B22D( * ), B22E( * ),
-* $ PHI( * ), THETA( * ), WORK( * )
-* DOUBLE PRECISION U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
-* $ V2T( LDV2T, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DBBCSD computes the CS decomposition of an orthogonal matrix in
-*> bidiagonal-block form,
-*>
-*>
-*> [ B11 | B12 0 0 ]
-*> [ 0 | 0 -I 0 ]
-*> X = [----------------]
-*> [ B21 | B22 0 0 ]
-*> [ 0 | 0 0 I ]
-*>
-*> [ C | -S 0 0 ]
-*> [ U1 | ] [ 0 | 0 -I 0 ] [ V1 | ]**T
-*> = [---------] [---------------] [---------] .
-*> [ | U2 ] [ S | C 0 0 ] [ | V2 ]
-*> [ 0 | 0 0 I ]
-*>
-*> X is M-by-M, its top-left block is P-by-Q, and Q must be no larger
-*> than P, M-P, or M-Q. (If Q is not the smallest index, then X must be
-*> transposed and/or permuted. This can be done in constant time using
-*> the TRANS and SIGNS options. See DORCSD for details.)
-*>
-*> The bidiagonal matrices B11, B12, B21, and B22 are represented
-*> implicitly by angles THETA(1:Q) and PHI(1:Q-1).
-*>
-*> The orthogonal matrices U1, U2, V1T, and V2T are input/output.
-*> The input matrices are pre- or post-multiplied by the appropriate
-*> singular vector matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU1
-*> \verbatim
-*> JOBU1 is CHARACTER
-*> = 'Y': U1 is updated;
-*> otherwise: U1 is not updated.
-*> \endverbatim
-*>
-*> \param[in] JOBU2
-*> \verbatim
-*> JOBU2 is CHARACTER
-*> = 'Y': U2 is updated;
-*> otherwise: U2 is not updated.
-*> \endverbatim
-*>
-*> \param[in] JOBV1T
-*> \verbatim
-*> JOBV1T is CHARACTER
-*> = 'Y': V1T is updated;
-*> otherwise: V1T is not updated.
-*> \endverbatim
-*>
-*> \param[in] JOBV2T
-*> \verbatim
-*> JOBV2T is CHARACTER
-*> = 'Y': V2T is updated;
-*> otherwise: V2T is not updated.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER
-*> = 'T': X, U1, U2, V1T, and V2T are stored in row-major
-*> order;
-*> otherwise: X, U1, U2, V1T, and V2T are stored in column-
-*> major order.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows and columns in X, the orthogonal matrix in
-*> bidiagonal-block form.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows in the top-left block of X. 0 <= P <= M.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is INTEGER
-*> The number of columns in the top-left block of X.
-*> 0 <= Q <= MIN(P,M-P,M-Q).
-*> \endverbatim
-*>
-*> \param[in,out] THETA
-*> \verbatim
-*> THETA is DOUBLE PRECISION array, dimension (Q)
-*> On entry, the angles THETA(1),...,THETA(Q) that, along with
-*> PHI(1), ...,PHI(Q-1), define the matrix in bidiagonal-block
-*> form. On exit, the angles whose cosines and sines define the
-*> diagonal blocks in the CS decomposition.
-*> \endverbatim
-*>
-*> \param[in,out] PHI
-*> \verbatim
-*> PHI is DOUBLE PRECISION array, dimension (Q-1)
-*> The angles PHI(1),...,PHI(Q-1) that, along with THETA(1),...,
-*> THETA(Q), define the matrix in bidiagonal-block form.
-*> \endverbatim
-*>
-*> \param[in,out] U1
-*> \verbatim
-*> U1 is DOUBLE PRECISION array, dimension (LDU1,P)
-*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied
-*> by the left singular vector matrix common to [ B11 ; 0 ] and
-*> [ B12 0 0 ; 0 -I 0 0 ].
-*> \endverbatim
-*>
-*> \param[in] LDU1
-*> \verbatim
-*> LDU1 is INTEGER
-*> The leading dimension of the array U1.
-*> \endverbatim
-*>
-*> \param[in,out] U2
-*> \verbatim
-*> U2 is DOUBLE PRECISION array, dimension (LDU2,M-P)
-*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is
-*> postmultiplied by the left singular vector matrix common to
-*> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ].
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of the array U2.
-*> \endverbatim
-*>
-*> \param[in,out] V1T
-*> \verbatim
-*> V1T is DOUBLE PRECISION array, dimension (LDV1T,Q)
-*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied
-*> by the transpose of the right singular vector
-*> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ].
-*> \endverbatim
-*>
-*> \param[in] LDV1T
-*> \verbatim
-*> LDV1T is INTEGER
-*> The leading dimension of the array V1T.
-*> \endverbatim
-*>
-*> \param[in,out] V2T
-*> \verbatim
-*> V2T is DOUBLE PRECISION array, dimenison (LDV2T,M-Q)
-*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is
-*> premultiplied by the transpose of the right
-*> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and
-*> [ B22 0 0 ; 0 0 I ].
-*> \endverbatim
-*>
-*> \param[in] LDV2T
-*> \verbatim
-*> LDV2T is INTEGER
-*> The leading dimension of the array V2T.
-*> \endverbatim
-*>
-*> \param[out] B11D
-*> \verbatim
-*> B11D is DOUBLE PRECISION array, dimension (Q)
-*> When DBBCSD converges, B11D contains the cosines of THETA(1),
-*> ..., THETA(Q). If DBBCSD fails to converge, then B11D
-*> contains the diagonal of the partially reduced top-left
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B11E
-*> \verbatim
-*> B11E is DOUBLE PRECISION array, dimension (Q-1)
-*> When DBBCSD converges, B11E contains zeros. If DBBCSD fails
-*> to converge, then B11E contains the superdiagonal of the
-*> partially reduced top-left block.
-*> \endverbatim
-*>
-*> \param[out] B12D
-*> \verbatim
-*> B12D is DOUBLE PRECISION array, dimension (Q)
-*> When DBBCSD converges, B12D contains the negative sines of
-*> THETA(1), ..., THETA(Q). If DBBCSD fails to converge, then
-*> B12D contains the diagonal of the partially reduced top-right
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B12E
-*> \verbatim
-*> B12E is DOUBLE PRECISION array, dimension (Q-1)
-*> When DBBCSD converges, B12E contains zeros. If DBBCSD fails
-*> to converge, then B12E contains the subdiagonal of the
-*> partially reduced top-right block.
-*> \endverbatim
-*>
-*> \param[out] B21D
-*> \verbatim
-*> B21D is DOUBLE PRECISION array, dimension (Q)
-*> When CBBCSD converges, B21D contains the negative sines of
-*> THETA(1), ..., THETA(Q). If CBBCSD fails to converge, then
-*> B21D contains the diagonal of the partially reduced bottom-left
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B21E
-*> \verbatim
-*> B21E is DOUBLE PRECISION array, dimension (Q-1)
-*> When CBBCSD converges, B21E contains zeros. If CBBCSD fails
-*> to converge, then B21E contains the subdiagonal of the
-*> partially reduced bottom-left block.
-*> \endverbatim
-*>
-*> \param[out] B22D
-*> \verbatim
-*> B22D is DOUBLE PRECISION array, dimension (Q)
-*> When CBBCSD converges, B22D contains the negative sines of
-*> THETA(1), ..., THETA(Q). If CBBCSD fails to converge, then
-*> B22D contains the diagonal of the partially reduced bottom-right
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B22E
-*> \verbatim
-*> B22E is DOUBLE PRECISION array, dimension (Q-1)
-*> When CBBCSD converges, B22E contains zeros. If CBBCSD fails
-*> to converge, then B22E contains the subdiagonal of the
-*> partially reduced bottom-right block.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= MAX(1,8*Q).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the WORK array,
-*> returns this value as the first entry of the work array, and
-*> no error message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if DBBCSD did not converge, INFO specifies the number
-*> of nonzero entries in PHI, and B11D, B11E, etc.,
-*> contain the partially reduced matrix.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLMUL DOUBLE PRECISION, default = MAX(10,MIN(100,EPS**(-1/8)))
-*> TOLMUL controls the convergence criterion of the QR loop.
-*> Angles THETA(i), PHI(i) are rounded to 0 or PI/2 when they
-*> are within TOLMUL*EPS of either bound.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
-*> Algorithms, 50(1):33-65, 2009.
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q,
- $ THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T,
- $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
- $ B22D, B22E, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS
- INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B11D( * ), B11E( * ), B12D( * ), B12E( * ),
- $ B21D( * ), B21E( * ), B22D( * ), B22E( * ),
- $ PHI( * ), THETA( * ), WORK( * )
- DOUBLE PRECISION U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
- $ V2T( LDV2T, * )
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- INTEGER MAXITR
- PARAMETER ( MAXITR = 6 )
- DOUBLE PRECISION HUNDRED, MEIGHTH, ONE, PIOVER2, TEN, ZERO
- PARAMETER ( HUNDRED = 100.0D0, MEIGHTH = -0.125D0,
- $ ONE = 1.0D0, PIOVER2 = 1.57079632679489662D0,
- $ TEN = 10.0D0, ZERO = 0.0D0 )
- DOUBLE PRECISION NEGONECOMPLEX
- PARAMETER ( NEGONECOMPLEX = -1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLMAJOR, LQUERY, RESTART11, RESTART12,
- $ RESTART21, RESTART22, WANTU1, WANTU2, WANTV1T,
- $ WANTV2T
- INTEGER I, IMIN, IMAX, ITER, IU1CS, IU1SN, IU2CS,
- $ IU2SN, IV1TCS, IV1TSN, IV2TCS, IV2TSN, J,
- $ LWORKMIN, LWORKOPT, MAXIT, MINI
- DOUBLE PRECISION B11BULGE, B12BULGE, B21BULGE, B22BULGE, DUMMY,
- $ EPS, MU, NU, R, SIGMA11, SIGMA21,
- $ TEMP, THETAMAX, THETAMIN, THRESH, TOL, TOLMUL,
- $ UNFL, X1, X2, Y1, Y2
-*
-* .. External Subroutines ..
- EXTERNAL DLASR, DSCAL, DSWAP, DLARTGP, DLARTGS, DLAS2,
- $ XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- LOGICAL LSAME
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, ATAN2, COS, MAX, MIN, SIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-*
- INFO = 0
- LQUERY = LWORK .EQ. -1
- WANTU1 = LSAME( JOBU1, 'Y' )
- WANTU2 = LSAME( JOBU2, 'Y' )
- WANTV1T = LSAME( JOBV1T, 'Y' )
- WANTV2T = LSAME( JOBV2T, 'Y' )
- COLMAJOR = .NOT. LSAME( TRANS, 'T' )
-*
- IF( M .LT. 0 ) THEN
- INFO = -6
- ELSE IF( P .LT. 0 .OR. P .GT. M ) THEN
- INFO = -7
- ELSE IF( Q .LT. 0 .OR. Q .GT. M ) THEN
- INFO = -8
- ELSE IF( Q .GT. P .OR. Q .GT. M-P .OR. Q .GT. M-Q ) THEN
- INFO = -8
- ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN
- INFO = -12
- ELSE IF( WANTU2 .AND. LDU2 .LT. M-P ) THEN
- INFO = -14
- ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN
- INFO = -16
- ELSE IF( WANTV2T .AND. LDV2T .LT. M-Q ) THEN
- INFO = -18
- END IF
-*
-* Quick return if Q = 0
-*
- IF( INFO .EQ. 0 .AND. Q .EQ. 0 ) THEN
- LWORKMIN = 1
- WORK(1) = LWORKMIN
- RETURN
- END IF
-*
-* Compute workspace
-*
- IF( INFO .EQ. 0 ) THEN
- IU1CS = 1
- IU1SN = IU1CS + Q
- IU2CS = IU1SN + Q
- IU2SN = IU2CS + Q
- IV1TCS = IU2SN + Q
- IV1TSN = IV1TCS + Q
- IV2TCS = IV1TSN + Q
- IV2TSN = IV2TCS + Q
- LWORKOPT = IV2TSN + Q - 1
- LWORKMIN = LWORKOPT
- WORK(1) = LWORKOPT
- IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN
- INFO = -28
- END IF
- END IF
-*
- IF( INFO .NE. 0 ) THEN
- CALL XERBLA( 'DBBCSD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'Epsilon' )
- UNFL = DLAMCH( 'Safe minimum' )
- TOLMUL = MAX( TEN, MIN( HUNDRED, EPS**MEIGHTH ) )
- TOL = TOLMUL*EPS
- THRESH = MAX( TOL, MAXITR*Q*Q*UNFL )
-*
-* Test for negligible sines or cosines
-*
- DO I = 1, Q
- IF( THETA(I) .LT. THRESH ) THEN
- THETA(I) = ZERO
- ELSE IF( THETA(I) .GT. PIOVER2-THRESH ) THEN
- THETA(I) = PIOVER2
- END IF
- END DO
- DO I = 1, Q-1
- IF( PHI(I) .LT. THRESH ) THEN
- PHI(I) = ZERO
- ELSE IF( PHI(I) .GT. PIOVER2-THRESH ) THEN
- PHI(I) = PIOVER2
- END IF
- END DO
-*
-* Initial deflation
-*
- IMAX = Q
- DO WHILE( ( IMAX .GT. 1 ) .AND. ( PHI(IMAX-1) .EQ. ZERO ) )
- IMAX = IMAX - 1
- END DO
- IMIN = IMAX - 1
- IF ( IMIN .GT. 1 ) THEN
- DO WHILE( PHI(IMIN-1) .NE. ZERO )
- IMIN = IMIN - 1
- IF ( IMIN .LE. 1 ) EXIT
- END DO
- END IF
-*
-* Initialize iteration counter
-*
- MAXIT = MAXITR*Q*Q
- ITER = 0
-*
-* Begin main iteration loop
-*
- DO WHILE( IMAX .GT. 1 )
-*
-* Compute the matrix entries
-*
- B11D(IMIN) = COS( THETA(IMIN) )
- B21D(IMIN) = -SIN( THETA(IMIN) )
- DO I = IMIN, IMAX - 1
- B11E(I) = -SIN( THETA(I) ) * SIN( PHI(I) )
- B11D(I+1) = COS( THETA(I+1) ) * COS( PHI(I) )
- B12D(I) = SIN( THETA(I) ) * COS( PHI(I) )
- B12E(I) = COS( THETA(I+1) ) * SIN( PHI(I) )
- B21E(I) = -COS( THETA(I) ) * SIN( PHI(I) )
- B21D(I+1) = -SIN( THETA(I+1) ) * COS( PHI(I) )
- B22D(I) = COS( THETA(I) ) * COS( PHI(I) )
- B22E(I) = -SIN( THETA(I+1) ) * SIN( PHI(I) )
- END DO
- B12D(IMAX) = SIN( THETA(IMAX) )
- B22D(IMAX) = COS( THETA(IMAX) )
-*
-* Abort if not converging; otherwise, increment ITER
-*
- IF( ITER .GT. MAXIT ) THEN
- INFO = 0
- DO I = 1, Q
- IF( PHI(I) .NE. ZERO )
- $ INFO = INFO + 1
- END DO
- RETURN
- END IF
-*
- ITER = ITER + IMAX - IMIN
-*
-* Compute shifts
-*
- THETAMAX = THETA(IMIN)
- THETAMIN = THETA(IMIN)
- DO I = IMIN+1, IMAX
- IF( THETA(I) > THETAMAX )
- $ THETAMAX = THETA(I)
- IF( THETA(I) < THETAMIN )
- $ THETAMIN = THETA(I)
- END DO
-*
- IF( THETAMAX .GT. PIOVER2 - THRESH ) THEN
-*
-* Zero on diagonals of B11 and B22; induce deflation with a
-* zero shift
-*
- MU = ZERO
- NU = ONE
-*
- ELSE IF( THETAMIN .LT. THRESH ) THEN
-*
-* Zero on diagonals of B12 and B22; induce deflation with a
-* zero shift
-*
- MU = ONE
- NU = ZERO
-*
- ELSE
-*
-* Compute shifts for B11 and B21 and use the lesser
-*
- CALL DLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), SIGMA11,
- $ DUMMY )
- CALL DLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), SIGMA21,
- $ DUMMY )
-*
- IF( SIGMA11 .LE. SIGMA21 ) THEN
- MU = SIGMA11
- NU = SQRT( ONE - MU**2 )
- IF( MU .LT. THRESH ) THEN
- MU = ZERO
- NU = ONE
- END IF
- ELSE
- NU = SIGMA21
- MU = SQRT( 1.0 - NU**2 )
- IF( NU .LT. THRESH ) THEN
- MU = ONE
- NU = ZERO
- END IF
- END IF
- END IF
-*
-* Rotate to produce bulges in B11 and B21
-*
- IF( MU .LE. NU ) THEN
- CALL DLARTGS( B11D(IMIN), B11E(IMIN), MU,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1) )
- ELSE
- CALL DLARTGS( B21D(IMIN), B21E(IMIN), NU,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1) )
- END IF
-*
- TEMP = WORK(IV1TCS+IMIN-1)*B11D(IMIN) +
- $ WORK(IV1TSN+IMIN-1)*B11E(IMIN)
- B11E(IMIN) = WORK(IV1TCS+IMIN-1)*B11E(IMIN) -
- $ WORK(IV1TSN+IMIN-1)*B11D(IMIN)
- B11D(IMIN) = TEMP
- B11BULGE = WORK(IV1TSN+IMIN-1)*B11D(IMIN+1)
- B11D(IMIN+1) = WORK(IV1TCS+IMIN-1)*B11D(IMIN+1)
- TEMP = WORK(IV1TCS+IMIN-1)*B21D(IMIN) +
- $ WORK(IV1TSN+IMIN-1)*B21E(IMIN)
- B21E(IMIN) = WORK(IV1TCS+IMIN-1)*B21E(IMIN) -
- $ WORK(IV1TSN+IMIN-1)*B21D(IMIN)
- B21D(IMIN) = TEMP
- B21BULGE = WORK(IV1TSN+IMIN-1)*B21D(IMIN+1)
- B21D(IMIN+1) = WORK(IV1TCS+IMIN-1)*B21D(IMIN+1)
-*
-* Compute THETA(IMIN)
-*
- THETA( IMIN ) = ATAN2( SQRT( B21D(IMIN)**2+B21BULGE**2 ),
- $ SQRT( B11D(IMIN)**2+B11BULGE**2 ) )
-*
-* Chase the bulges in B11(IMIN+1,IMIN) and B21(IMIN+1,IMIN)
-*
- IF( B11D(IMIN)**2+B11BULGE**2 .GT. THRESH**2 ) THEN
- CALL DLARTGP( B11BULGE, B11D(IMIN), WORK(IU1SN+IMIN-1),
- $ WORK(IU1CS+IMIN-1), R )
- ELSE IF( MU .LE. NU ) THEN
- CALL DLARTGS( B11E( IMIN ), B11D( IMIN + 1 ), MU,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1) )
- ELSE
- CALL DLARTGS( B12D( IMIN ), B12E( IMIN ), NU,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1) )
- END IF
- IF( B21D(IMIN)**2+B21BULGE**2 .GT. THRESH**2 ) THEN
- CALL DLARTGP( B21BULGE, B21D(IMIN), WORK(IU2SN+IMIN-1),
- $ WORK(IU2CS+IMIN-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL DLARTGS( B21E( IMIN ), B21D( IMIN + 1 ), NU,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1) )
- ELSE
- CALL DLARTGS( B22D(IMIN), B22E(IMIN), MU,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1) )
- END IF
- WORK(IU2CS+IMIN-1) = -WORK(IU2CS+IMIN-1)
- WORK(IU2SN+IMIN-1) = -WORK(IU2SN+IMIN-1)
-*
- TEMP = WORK(IU1CS+IMIN-1)*B11E(IMIN) +
- $ WORK(IU1SN+IMIN-1)*B11D(IMIN+1)
- B11D(IMIN+1) = WORK(IU1CS+IMIN-1)*B11D(IMIN+1) -
- $ WORK(IU1SN+IMIN-1)*B11E(IMIN)
- B11E(IMIN) = TEMP
- IF( IMAX .GT. IMIN+1 ) THEN
- B11BULGE = WORK(IU1SN+IMIN-1)*B11E(IMIN+1)
- B11E(IMIN+1) = WORK(IU1CS+IMIN-1)*B11E(IMIN+1)
- END IF
- TEMP = WORK(IU1CS+IMIN-1)*B12D(IMIN) +
- $ WORK(IU1SN+IMIN-1)*B12E(IMIN)
- B12E(IMIN) = WORK(IU1CS+IMIN-1)*B12E(IMIN) -
- $ WORK(IU1SN+IMIN-1)*B12D(IMIN)
- B12D(IMIN) = TEMP
- B12BULGE = WORK(IU1SN+IMIN-1)*B12D(IMIN+1)
- B12D(IMIN+1) = WORK(IU1CS+IMIN-1)*B12D(IMIN+1)
- TEMP = WORK(IU2CS+IMIN-1)*B21E(IMIN) +
- $ WORK(IU2SN+IMIN-1)*B21D(IMIN+1)
- B21D(IMIN+1) = WORK(IU2CS+IMIN-1)*B21D(IMIN+1) -
- $ WORK(IU2SN+IMIN-1)*B21E(IMIN)
- B21E(IMIN) = TEMP
- IF( IMAX .GT. IMIN+1 ) THEN
- B21BULGE = WORK(IU2SN+IMIN-1)*B21E(IMIN+1)
- B21E(IMIN+1) = WORK(IU2CS+IMIN-1)*B21E(IMIN+1)
- END IF
- TEMP = WORK(IU2CS+IMIN-1)*B22D(IMIN) +
- $ WORK(IU2SN+IMIN-1)*B22E(IMIN)
- B22E(IMIN) = WORK(IU2CS+IMIN-1)*B22E(IMIN) -
- $ WORK(IU2SN+IMIN-1)*B22D(IMIN)
- B22D(IMIN) = TEMP
- B22BULGE = WORK(IU2SN+IMIN-1)*B22D(IMIN+1)
- B22D(IMIN+1) = WORK(IU2CS+IMIN-1)*B22D(IMIN+1)
-*
-* Inner loop: chase bulges from B11(IMIN,IMIN+2),
-* B12(IMIN,IMIN+1), B21(IMIN,IMIN+2), and B22(IMIN,IMIN+1) to
-* bottom-right
-*
- DO I = IMIN+1, IMAX-1
-*
-* Compute PHI(I-1)
-*
- X1 = SIN(THETA(I-1))*B11E(I-1) + COS(THETA(I-1))*B21E(I-1)
- X2 = SIN(THETA(I-1))*B11BULGE + COS(THETA(I-1))*B21BULGE
- Y1 = SIN(THETA(I-1))*B12D(I-1) + COS(THETA(I-1))*B22D(I-1)
- Y2 = SIN(THETA(I-1))*B12BULGE + COS(THETA(I-1))*B22BULGE
-*
- PHI(I-1) = ATAN2( SQRT(X1**2+X2**2), SQRT(Y1**2+Y2**2) )
-*
-* Determine if there are bulges to chase or if a new direct
-* summand has been reached
-*
- RESTART11 = B11E(I-1)**2 + B11BULGE**2 .LE. THRESH**2
- RESTART21 = B21E(I-1)**2 + B21BULGE**2 .LE. THRESH**2
- RESTART12 = B12D(I-1)**2 + B12BULGE**2 .LE. THRESH**2
- RESTART22 = B22D(I-1)**2 + B22BULGE**2 .LE. THRESH**2
-*
-* If possible, chase bulges from B11(I-1,I+1), B12(I-1,I),
-* B21(I-1,I+1), and B22(I-1,I). If necessary, restart bulge-
-* chasing by applying the original shift again.
-*
- IF( .NOT. RESTART11 .AND. .NOT. RESTART21 ) THEN
- CALL DLARTGP( X2, X1, WORK(IV1TSN+I-1), WORK(IV1TCS+I-1),
- $ R )
- ELSE IF( .NOT. RESTART11 .AND. RESTART21 ) THEN
- CALL DLARTGP( B11BULGE, B11E(I-1), WORK(IV1TSN+I-1),
- $ WORK(IV1TCS+I-1), R )
- ELSE IF( RESTART11 .AND. .NOT. RESTART21 ) THEN
- CALL DLARTGP( B21BULGE, B21E(I-1), WORK(IV1TSN+I-1),
- $ WORK(IV1TCS+I-1), R )
- ELSE IF( MU .LE. NU ) THEN
- CALL DLARTGS( B11D(I), B11E(I), MU, WORK(IV1TCS+I-1),
- $ WORK(IV1TSN+I-1) )
- ELSE
- CALL DLARTGS( B21D(I), B21E(I), NU, WORK(IV1TCS+I-1),
- $ WORK(IV1TSN+I-1) )
- END IF
- WORK(IV1TCS+I-1) = -WORK(IV1TCS+I-1)
- WORK(IV1TSN+I-1) = -WORK(IV1TSN+I-1)
- IF( .NOT. RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL DLARTGP( Y2, Y1, WORK(IV2TSN+I-1-1),
- $ WORK(IV2TCS+I-1-1), R )
- ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN
- CALL DLARTGP( B12BULGE, B12D(I-1), WORK(IV2TSN+I-1-1),
- $ WORK(IV2TCS+I-1-1), R )
- ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL DLARTGP( B22BULGE, B22D(I-1), WORK(IV2TSN+I-1-1),
- $ WORK(IV2TCS+I-1-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL DLARTGS( B12E(I-1), B12D(I), NU, WORK(IV2TCS+I-1-1),
- $ WORK(IV2TSN+I-1-1) )
- ELSE
- CALL DLARTGS( B22E(I-1), B22D(I), MU, WORK(IV2TCS+I-1-1),
- $ WORK(IV2TSN+I-1-1) )
- END IF
-*
- TEMP = WORK(IV1TCS+I-1)*B11D(I) + WORK(IV1TSN+I-1)*B11E(I)
- B11E(I) = WORK(IV1TCS+I-1)*B11E(I) -
- $ WORK(IV1TSN+I-1)*B11D(I)
- B11D(I) = TEMP
- B11BULGE = WORK(IV1TSN+I-1)*B11D(I+1)
- B11D(I+1) = WORK(IV1TCS+I-1)*B11D(I+1)
- TEMP = WORK(IV1TCS+I-1)*B21D(I) + WORK(IV1TSN+I-1)*B21E(I)
- B21E(I) = WORK(IV1TCS+I-1)*B21E(I) -
- $ WORK(IV1TSN+I-1)*B21D(I)
- B21D(I) = TEMP
- B21BULGE = WORK(IV1TSN+I-1)*B21D(I+1)
- B21D(I+1) = WORK(IV1TCS+I-1)*B21D(I+1)
- TEMP = WORK(IV2TCS+I-1-1)*B12E(I-1) +
- $ WORK(IV2TSN+I-1-1)*B12D(I)
- B12D(I) = WORK(IV2TCS+I-1-1)*B12D(I) -
- $ WORK(IV2TSN+I-1-1)*B12E(I-1)
- B12E(I-1) = TEMP
- B12BULGE = WORK(IV2TSN+I-1-1)*B12E(I)
- B12E(I) = WORK(IV2TCS+I-1-1)*B12E(I)
- TEMP = WORK(IV2TCS+I-1-1)*B22E(I-1) +
- $ WORK(IV2TSN+I-1-1)*B22D(I)
- B22D(I) = WORK(IV2TCS+I-1-1)*B22D(I) -
- $ WORK(IV2TSN+I-1-1)*B22E(I-1)
- B22E(I-1) = TEMP
- B22BULGE = WORK(IV2TSN+I-1-1)*B22E(I)
- B22E(I) = WORK(IV2TCS+I-1-1)*B22E(I)
-*
-* Compute THETA(I)
-*
- X1 = COS(PHI(I-1))*B11D(I) + SIN(PHI(I-1))*B12E(I-1)
- X2 = COS(PHI(I-1))*B11BULGE + SIN(PHI(I-1))*B12BULGE
- Y1 = COS(PHI(I-1))*B21D(I) + SIN(PHI(I-1))*B22E(I-1)
- Y2 = COS(PHI(I-1))*B21BULGE + SIN(PHI(I-1))*B22BULGE
-*
- THETA(I) = ATAN2( SQRT(Y1**2+Y2**2), SQRT(X1**2+X2**2) )
-*
-* Determine if there are bulges to chase or if a new direct
-* summand has been reached
-*
- RESTART11 = B11D(I)**2 + B11BULGE**2 .LE. THRESH**2
- RESTART12 = B12E(I-1)**2 + B12BULGE**2 .LE. THRESH**2
- RESTART21 = B21D(I)**2 + B21BULGE**2 .LE. THRESH**2
- RESTART22 = B22E(I-1)**2 + B22BULGE**2 .LE. THRESH**2
-*
-* If possible, chase bulges from B11(I+1,I), B12(I+1,I-1),
-* B21(I+1,I), and B22(I+1,I-1). If necessary, restart bulge-
-* chasing by applying the original shift again.
-*
- IF( .NOT. RESTART11 .AND. .NOT. RESTART12 ) THEN
- CALL DLARTGP( X2, X1, WORK(IU1SN+I-1), WORK(IU1CS+I-1),
- $ R )
- ELSE IF( .NOT. RESTART11 .AND. RESTART12 ) THEN
- CALL DLARTGP( B11BULGE, B11D(I), WORK(IU1SN+I-1),
- $ WORK(IU1CS+I-1), R )
- ELSE IF( RESTART11 .AND. .NOT. RESTART12 ) THEN
- CALL DLARTGP( B12BULGE, B12E(I-1), WORK(IU1SN+I-1),
- $ WORK(IU1CS+I-1), R )
- ELSE IF( MU .LE. NU ) THEN
- CALL DLARTGS( B11E(I), B11D(I+1), MU, WORK(IU1CS+I-1),
- $ WORK(IU1SN+I-1) )
- ELSE
- CALL DLARTGS( B12D(I), B12E(I), NU, WORK(IU1CS+I-1),
- $ WORK(IU1SN+I-1) )
- END IF
- IF( .NOT. RESTART21 .AND. .NOT. RESTART22 ) THEN
- CALL DLARTGP( Y2, Y1, WORK(IU2SN+I-1), WORK(IU2CS+I-1),
- $ R )
- ELSE IF( .NOT. RESTART21 .AND. RESTART22 ) THEN
- CALL DLARTGP( B21BULGE, B21D(I), WORK(IU2SN+I-1),
- $ WORK(IU2CS+I-1), R )
- ELSE IF( RESTART21 .AND. .NOT. RESTART22 ) THEN
- CALL DLARTGP( B22BULGE, B22E(I-1), WORK(IU2SN+I-1),
- $ WORK(IU2CS+I-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL DLARTGS( B21E(I), B21E(I+1), NU, WORK(IU2CS+I-1),
- $ WORK(IU2SN+I-1) )
- ELSE
- CALL DLARTGS( B22D(I), B22E(I), MU, WORK(IU2CS+I-1),
- $ WORK(IU2SN+I-1) )
- END IF
- WORK(IU2CS+I-1) = -WORK(IU2CS+I-1)
- WORK(IU2SN+I-1) = -WORK(IU2SN+I-1)
-*
- TEMP = WORK(IU1CS+I-1)*B11E(I) + WORK(IU1SN+I-1)*B11D(I+1)
- B11D(I+1) = WORK(IU1CS+I-1)*B11D(I+1) -
- $ WORK(IU1SN+I-1)*B11E(I)
- B11E(I) = TEMP
- IF( I .LT. IMAX - 1 ) THEN
- B11BULGE = WORK(IU1SN+I-1)*B11E(I+1)
- B11E(I+1) = WORK(IU1CS+I-1)*B11E(I+1)
- END IF
- TEMP = WORK(IU2CS+I-1)*B21E(I) + WORK(IU2SN+I-1)*B21D(I+1)
- B21D(I+1) = WORK(IU2CS+I-1)*B21D(I+1) -
- $ WORK(IU2SN+I-1)*B21E(I)
- B21E(I) = TEMP
- IF( I .LT. IMAX - 1 ) THEN
- B21BULGE = WORK(IU2SN+I-1)*B21E(I+1)
- B21E(I+1) = WORK(IU2CS+I-1)*B21E(I+1)
- END IF
- TEMP = WORK(IU1CS+I-1)*B12D(I) + WORK(IU1SN+I-1)*B12E(I)
- B12E(I) = WORK(IU1CS+I-1)*B12E(I) - WORK(IU1SN+I-1)*B12D(I)
- B12D(I) = TEMP
- B12BULGE = WORK(IU1SN+I-1)*B12D(I+1)
- B12D(I+1) = WORK(IU1CS+I-1)*B12D(I+1)
- TEMP = WORK(IU2CS+I-1)*B22D(I) + WORK(IU2SN+I-1)*B22E(I)
- B22E(I) = WORK(IU2CS+I-1)*B22E(I) - WORK(IU2SN+I-1)*B22D(I)
- B22D(I) = TEMP
- B22BULGE = WORK(IU2SN+I-1)*B22D(I+1)
- B22D(I+1) = WORK(IU2CS+I-1)*B22D(I+1)
-*
- END DO
-*
-* Compute PHI(IMAX-1)
-*
- X1 = SIN(THETA(IMAX-1))*B11E(IMAX-1) +
- $ COS(THETA(IMAX-1))*B21E(IMAX-1)
- Y1 = SIN(THETA(IMAX-1))*B12D(IMAX-1) +
- $ COS(THETA(IMAX-1))*B22D(IMAX-1)
- Y2 = SIN(THETA(IMAX-1))*B12BULGE + COS(THETA(IMAX-1))*B22BULGE
-*
- PHI(IMAX-1) = ATAN2( ABS(X1), SQRT(Y1**2+Y2**2) )
-*
-* Chase bulges from B12(IMAX-1,IMAX) and B22(IMAX-1,IMAX)
-*
- RESTART12 = B12D(IMAX-1)**2 + B12BULGE**2 .LE. THRESH**2
- RESTART22 = B22D(IMAX-1)**2 + B22BULGE**2 .LE. THRESH**2
-*
- IF( .NOT. RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL DLARTGP( Y2, Y1, WORK(IV2TSN+IMAX-1-1),
- $ WORK(IV2TCS+IMAX-1-1), R )
- ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN
- CALL DLARTGP( B12BULGE, B12D(IMAX-1), WORK(IV2TSN+IMAX-1-1),
- $ WORK(IV2TCS+IMAX-1-1), R )
- ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL DLARTGP( B22BULGE, B22D(IMAX-1), WORK(IV2TSN+IMAX-1-1),
- $ WORK(IV2TCS+IMAX-1-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL DLARTGS( B12E(IMAX-1), B12D(IMAX), NU,
- $ WORK(IV2TCS+IMAX-1-1), WORK(IV2TSN+IMAX-1-1) )
- ELSE
- CALL DLARTGS( B22E(IMAX-1), B22D(IMAX), MU,
- $ WORK(IV2TCS+IMAX-1-1), WORK(IV2TSN+IMAX-1-1) )
- END IF
-*
- TEMP = WORK(IV2TCS+IMAX-1-1)*B12E(IMAX-1) +
- $ WORK(IV2TSN+IMAX-1-1)*B12D(IMAX)
- B12D(IMAX) = WORK(IV2TCS+IMAX-1-1)*B12D(IMAX) -
- $ WORK(IV2TSN+IMAX-1-1)*B12E(IMAX-1)
- B12E(IMAX-1) = TEMP
- TEMP = WORK(IV2TCS+IMAX-1-1)*B22E(IMAX-1) +
- $ WORK(IV2TSN+IMAX-1-1)*B22D(IMAX)
- B22D(IMAX) = WORK(IV2TCS+IMAX-1-1)*B22D(IMAX) -
- $ WORK(IV2TSN+IMAX-1-1)*B22E(IMAX-1)
- B22E(IMAX-1) = TEMP
-*
-* Update singular vectors
-*
- IF( WANTU1 ) THEN
- IF( COLMAJOR ) THEN
- CALL DLASR( 'R', 'V', 'F', P, IMAX-IMIN+1,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1),
- $ U1(1,IMIN), LDU1 )
- ELSE
- CALL DLASR( 'L', 'V', 'F', IMAX-IMIN+1, P,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1),
- $ U1(IMIN,1), LDU1 )
- END IF
- END IF
- IF( WANTU2 ) THEN
- IF( COLMAJOR ) THEN
- CALL DLASR( 'R', 'V', 'F', M-P, IMAX-IMIN+1,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1),
- $ U2(1,IMIN), LDU2 )
- ELSE
- CALL DLASR( 'L', 'V', 'F', IMAX-IMIN+1, M-P,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1),
- $ U2(IMIN,1), LDU2 )
- END IF
- END IF
- IF( WANTV1T ) THEN
- IF( COLMAJOR ) THEN
- CALL DLASR( 'L', 'V', 'F', IMAX-IMIN+1, Q,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1),
- $ V1T(IMIN,1), LDV1T )
- ELSE
- CALL DLASR( 'R', 'V', 'F', Q, IMAX-IMIN+1,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1),
- $ V1T(1,IMIN), LDV1T )
- END IF
- END IF
- IF( WANTV2T ) THEN
- IF( COLMAJOR ) THEN
- CALL DLASR( 'L', 'V', 'F', IMAX-IMIN+1, M-Q,
- $ WORK(IV2TCS+IMIN-1), WORK(IV2TSN+IMIN-1),
- $ V2T(IMIN,1), LDV2T )
- ELSE
- CALL DLASR( 'R', 'V', 'F', M-Q, IMAX-IMIN+1,
- $ WORK(IV2TCS+IMIN-1), WORK(IV2TSN+IMIN-1),
- $ V2T(1,IMIN), LDV2T )
- END IF
- END IF
-*
-* Fix signs on B11(IMAX-1,IMAX) and B21(IMAX-1,IMAX)
-*
- IF( B11E(IMAX-1)+B21E(IMAX-1) .GT. 0 ) THEN
- B11D(IMAX) = -B11D(IMAX)
- B21D(IMAX) = -B21D(IMAX)
- IF( WANTV1T ) THEN
- IF( COLMAJOR ) THEN
- CALL DSCAL( Q, NEGONECOMPLEX, V1T(IMAX,1), LDV1T )
- ELSE
- CALL DSCAL( Q, NEGONECOMPLEX, V1T(1,IMAX), 1 )
- END IF
- END IF
- END IF
-*
-* Compute THETA(IMAX)
-*
- X1 = COS(PHI(IMAX-1))*B11D(IMAX) +
- $ SIN(PHI(IMAX-1))*B12E(IMAX-1)
- Y1 = COS(PHI(IMAX-1))*B21D(IMAX) +
- $ SIN(PHI(IMAX-1))*B22E(IMAX-1)
-*
- THETA(IMAX) = ATAN2( ABS(Y1), ABS(X1) )
-*
-* Fix signs on B11(IMAX,IMAX), B12(IMAX,IMAX-1), B21(IMAX,IMAX),
-* and B22(IMAX,IMAX-1)
-*
- IF( B11D(IMAX)+B12E(IMAX-1) .LT. 0 ) THEN
- B12D(IMAX) = -B12D(IMAX)
- IF( WANTU1 ) THEN
- IF( COLMAJOR ) THEN
- CALL DSCAL( P, NEGONECOMPLEX, U1(1,IMAX), 1 )
- ELSE
- CALL DSCAL( P, NEGONECOMPLEX, U1(IMAX,1), LDU1 )
- END IF
- END IF
- END IF
- IF( B21D(IMAX)+B22E(IMAX-1) .GT. 0 ) THEN
- B22D(IMAX) = -B22D(IMAX)
- IF( WANTU2 ) THEN
- IF( COLMAJOR ) THEN
- CALL DSCAL( M-P, NEGONECOMPLEX, U2(1,IMAX), 1 )
- ELSE
- CALL DSCAL( M-P, NEGONECOMPLEX, U2(IMAX,1), LDU2 )
- END IF
- END IF
- END IF
-*
-* Fix signs on B12(IMAX,IMAX) and B22(IMAX,IMAX)
-*
- IF( B12D(IMAX)+B22D(IMAX) .LT. 0 ) THEN
- IF( WANTV2T ) THEN
- IF( COLMAJOR ) THEN
- CALL DSCAL( M-Q, NEGONECOMPLEX, V2T(IMAX,1), LDV2T )
- ELSE
- CALL DSCAL( M-Q, NEGONECOMPLEX, V2T(1,IMAX), 1 )
- END IF
- END IF
- END IF
-*
-* Test for negligible sines or cosines
-*
- DO I = IMIN, IMAX
- IF( THETA(I) .LT. THRESH ) THEN
- THETA(I) = ZERO
- ELSE IF( THETA(I) .GT. PIOVER2-THRESH ) THEN
- THETA(I) = PIOVER2
- END IF
- END DO
- DO I = IMIN, IMAX-1
- IF( PHI(I) .LT. THRESH ) THEN
- PHI(I) = ZERO
- ELSE IF( PHI(I) .GT. PIOVER2-THRESH ) THEN
- PHI(I) = PIOVER2
- END IF
- END DO
-*
-* Deflate
-*
- IF (IMAX .GT. 1) THEN
- DO WHILE( PHI(IMAX-1) .EQ. ZERO )
- IMAX = IMAX - 1
- IF (IMAX .LE. 1) EXIT
- END DO
- END IF
- IF( IMIN .GT. IMAX - 1 )
- $ IMIN = IMAX - 1
- IF (IMIN .GT. 1) THEN
- DO WHILE (PHI(IMIN-1) .NE. ZERO)
- IMIN = IMIN - 1
- IF (IMIN .LE. 1) EXIT
- END DO
- END IF
-*
-* Repeat main iteration loop
-*
- END DO
-*
-* Postprocessing: order THETA from least to greatest
-*
- DO I = 1, Q
-*
- MINI = I
- THETAMIN = THETA(I)
- DO J = I+1, Q
- IF( THETA(J) .LT. THETAMIN ) THEN
- MINI = J
- THETAMIN = THETA(J)
- END IF
- END DO
-*
- IF( MINI .NE. I ) THEN
- THETA(MINI) = THETA(I)
- THETA(I) = THETAMIN
- IF( COLMAJOR ) THEN
- IF( WANTU1 )
- $ CALL DSWAP( P, U1(1,I), 1, U1(1,MINI), 1 )
- IF( WANTU2 )
- $ CALL DSWAP( M-P, U2(1,I), 1, U2(1,MINI), 1 )
- IF( WANTV1T )
- $ CALL DSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), LDV1T )
- IF( WANTV2T )
- $ CALL DSWAP( M-Q, V2T(I,1), LDV2T, V2T(MINI,1),
- $ LDV2T )
- ELSE
- IF( WANTU1 )
- $ CALL DSWAP( P, U1(I,1), LDU1, U1(MINI,1), LDU1 )
- IF( WANTU2 )
- $ CALL DSWAP( M-P, U2(I,1), LDU2, U2(MINI,1), LDU2 )
- IF( WANTV1T )
- $ CALL DSWAP( Q, V1T(1,I), 1, V1T(1,MINI), 1 )
- IF( WANTV2T )
- $ CALL DSWAP( M-Q, V2T(1,I), 1, V2T(1,MINI), 1 )
- END IF
- END IF
-*
- END DO
-*
- RETURN
-*
-* End of DBBCSD
-*
- END
-
diff --git a/netlib/LAPACK/dbdsdc.f b/netlib/LAPACK/dbdsdc.f
deleted file mode 100644
index 2c572f1..0000000
--- a/netlib/LAPACK/dbdsdc.f
+++ /dev/null
@@ -1,521 +0,0 @@
-*> \brief \b DBDSDC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DBDSDC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dbdsdc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dbdsdc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dbdsdc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, UPLO
-* INTEGER INFO, LDU, LDVT, N
-* ..
-* .. Array Arguments ..
-* INTEGER IQ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), Q( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DBDSDC computes the singular value decomposition (SVD) of a real
-*> N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
-*> using a divide and conquer method, where S is a diagonal matrix
-*> with non-negative diagonal elements (the singular values of B), and
-*> U and VT are orthogonal matrices of left and right singular vectors,
-*> respectively. DBDSDC can be used to compute all singular values,
-*> and optionally, singular vectors or singular vectors in compact form.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none. See DLASD3 for details.
-*>
-*> The code currently calls DLASDQ if singular values only are desired.
-*> However, it can be slightly modified to compute singular values
-*> using the divide and conquer method.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': B is upper bidiagonal.
-*> = 'L': B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> Specifies whether singular vectors are to be computed
-*> as follows:
-*> = 'N': Compute singular values only;
-*> = 'P': Compute singular values and compute singular
-*> vectors in compact form;
-*> = 'I': Compute singular values and singular vectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the bidiagonal matrix B.
-*> On exit, if INFO=0, the singular values of B.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the elements of E contain the offdiagonal
-*> elements of the bidiagonal matrix whose SVD is desired.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,N)
-*> If COMPQ = 'I', then:
-*> On exit, if INFO = 0, U contains the left singular vectors
-*> of the bidiagonal matrix.
-*> For other values of COMPQ, U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1.
-*> If singular vectors are desired, then LDU >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT,N)
-*> If COMPQ = 'I', then:
-*> On exit, if INFO = 0, VT**T contains the right singular
-*> vectors of the bidiagonal matrix.
-*> For other values of COMPQ, VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1.
-*> If singular vectors are desired, then LDVT >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ)
-*> If COMPQ = 'P', then:
-*> On exit, if INFO = 0, Q and IQ contain the left
-*> and right singular vectors in a compact form,
-*> requiring O(N log N) space instead of 2*N**2.
-*> In particular, Q contains all the DOUBLE PRECISION data in
-*> LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
-*> words of memory, where SMLSIZ is returned by ILAENV and
-*> is equal to the maximum size of the subproblems at the
-*> bottom of the computation tree (usually about 25).
-*> For other values of COMPQ, Q is not referenced.
-*> \endverbatim
-*>
-*> \param[out] IQ
-*> \verbatim
-*> IQ is INTEGER array, dimension (LDIQ)
-*> If COMPQ = 'P', then:
-*> On exit, if INFO = 0, Q and IQ contain the left
-*> and right singular vectors in a compact form,
-*> requiring O(N log N) space instead of 2*N**2.
-*> In particular, IQ contains all INTEGER data in
-*> LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
-*> words of memory, where SMLSIZ is returned by ILAENV and
-*> is equal to the maximum size of the subproblems at the
-*> bottom of the computation tree (usually about 25).
-*> For other values of COMPQ, IQ is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> If COMPQ = 'N' then LWORK >= (4 * N).
-*> If COMPQ = 'P' then LWORK >= (6 * N).
-*> If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute a singular value.
-*> The update process of divide and conquer failed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, UPLO
- INTEGER INFO, LDU, LDVT, N
-* ..
-* .. Array Arguments ..
- INTEGER IQ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), Q( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-* Changed dimension statement in comment describing E from (N) to
-* (N-1). Sven, 17 Feb 05.
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER DIFL, DIFR, GIVCOL, GIVNUM, GIVPTR, I, IC,
- $ ICOMPQ, IERR, II, IS, IU, IUPLO, IVT, J, K, KK,
- $ MLVL, NM1, NSIZE, PERM, POLES, QSTART, SMLSIZ,
- $ SMLSZP, SQRE, START, WSTART, Z
- DOUBLE PRECISION CS, EPS, ORGNRM, P, R, SN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA, DLASDQ,
- $ DLASET, DLASR, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, LOG, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IUPLO = 0
- IF( LSAME( UPLO, 'U' ) )
- $ IUPLO = 1
- IF( LSAME( UPLO, 'L' ) )
- $ IUPLO = 2
- IF( LSAME( COMPQ, 'N' ) ) THEN
- ICOMPQ = 0
- ELSE IF( LSAME( COMPQ, 'P' ) ) THEN
- ICOMPQ = 1
- ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
- ICOMPQ = 2
- ELSE
- ICOMPQ = -1
- END IF
- IF( IUPLO.EQ.0 ) THEN
- INFO = -1
- ELSE IF( ICOMPQ.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ( LDU.LT.1 ) .OR. ( ( ICOMPQ.EQ.2 ) .AND. ( LDU.LT.
- $ N ) ) ) THEN
- INFO = -7
- ELSE IF( ( LDVT.LT.1 ) .OR. ( ( ICOMPQ.EQ.2 ) .AND. ( LDVT.LT.
- $ N ) ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DBDSDC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- SMLSIZ = ILAENV( 9, 'DBDSDC', ' ', 0, 0, 0, 0 )
- IF( N.EQ.1 ) THEN
- IF( ICOMPQ.EQ.1 ) THEN
- Q( 1 ) = SIGN( ONE, D( 1 ) )
- Q( 1+SMLSIZ*N ) = ONE
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- U( 1, 1 ) = SIGN( ONE, D( 1 ) )
- VT( 1, 1 ) = ONE
- END IF
- D( 1 ) = ABS( D( 1 ) )
- RETURN
- END IF
- NM1 = N - 1
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left
-*
- WSTART = 1
- QSTART = 3
- IF( ICOMPQ.EQ.1 ) THEN
- CALL DCOPY( N, D, 1, Q( 1 ), 1 )
- CALL DCOPY( N-1, E, 1, Q( N+1 ), 1 )
- END IF
- IF( IUPLO.EQ.2 ) THEN
- QSTART = 5
- WSTART = 2*N - 1
- DO 10 I = 1, N - 1
- CALL DLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( ICOMPQ.EQ.1 ) THEN
- Q( I+2*N ) = CS
- Q( I+3*N ) = SN
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- WORK( I ) = CS
- WORK( NM1+I ) = -SN
- END IF
- 10 CONTINUE
- END IF
-*
-* If ICOMPQ = 0, use DLASDQ to compute the singular values.
-*
- IF( ICOMPQ.EQ.0 ) THEN
- CALL DLASDQ( 'U', 0, N, 0, 0, 0, D, E, VT, LDVT, U, LDU, U,
- $ LDU, WORK( WSTART ), INFO )
- GO TO 40
- END IF
-*
-* If N is smaller than the minimum divide size SMLSIZ, then solve
-* the problem with another solver.
-*
- IF( N.LE.SMLSIZ ) THEN
- IF( ICOMPQ.EQ.2 ) THEN
- CALL DLASET( 'A', N, N, ZERO, ONE, U, LDU )
- CALL DLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
- CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
- $ LDU, WORK( WSTART ), INFO )
- ELSE IF( ICOMPQ.EQ.1 ) THEN
- IU = 1
- IVT = IU + N
- CALL DLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
- $ N )
- CALL DLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
- $ N )
- CALL DLASDQ( 'U', 0, N, N, N, 0, D, E,
- $ Q( IVT+( QSTART-1 )*N ), N,
- $ Q( IU+( QSTART-1 )*N ), N,
- $ Q( IU+( QSTART-1 )*N ), N, WORK( WSTART ),
- $ INFO )
- END IF
- GO TO 40
- END IF
-*
- IF( ICOMPQ.EQ.2 ) THEN
- CALL DLASET( 'A', N, N, ZERO, ONE, U, LDU )
- CALL DLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
- END IF
-*
-* Scale.
-*
- ORGNRM = DLANST( 'M', N, D, E )
- IF( ORGNRM.EQ.ZERO )
- $ RETURN
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, IERR )
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, NM1, 1, E, NM1, IERR )
-*
- EPS = (0.9D+0)*DLAMCH( 'Epsilon' )
-*
- MLVL = INT( LOG( DBLE( N ) / DBLE( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1
- SMLSZP = SMLSIZ + 1
-*
- IF( ICOMPQ.EQ.1 ) THEN
- IU = 1
- IVT = 1 + SMLSIZ
- DIFL = IVT + SMLSZP
- DIFR = DIFL + MLVL
- Z = DIFR + MLVL*2
- IC = Z + MLVL
- IS = IC + 1
- POLES = IS + 1
- GIVNUM = POLES + 2*MLVL
-*
- K = 1
- GIVPTR = 2
- PERM = 3
- GIVCOL = PERM + MLVL
- END IF
-*
- DO 20 I = 1, N
- IF( ABS( D( I ) ).LT.EPS ) THEN
- D( I ) = SIGN( EPS, D( I ) )
- END IF
- 20 CONTINUE
-*
- START = 1
- SQRE = 0
-*
- DO 30 I = 1, NM1
- IF( ( ABS( E( I ) ).LT.EPS ) .OR. ( I.EQ.NM1 ) ) THEN
-*
-* Subproblem found. First determine its size and then
-* apply divide and conquer on it.
-*
- IF( I.LT.NM1 ) THEN
-*
-* A subproblem with E(I) small for I < NM1.
-*
- NSIZE = I - START + 1
- ELSE IF( ABS( E( I ) ).GE.EPS ) THEN
-*
-* A subproblem with E(NM1) not too small but I = NM1.
-*
- NSIZE = N - START + 1
- ELSE
-*
-* A subproblem with E(NM1) small. This implies an
-* 1-by-1 subproblem at D(N). Solve this 1-by-1 problem
-* first.
-*
- NSIZE = I - START + 1
- IF( ICOMPQ.EQ.2 ) THEN
- U( N, N ) = SIGN( ONE, D( N ) )
- VT( N, N ) = ONE
- ELSE IF( ICOMPQ.EQ.1 ) THEN
- Q( N+( QSTART-1 )*N ) = SIGN( ONE, D( N ) )
- Q( N+( SMLSIZ+QSTART-1 )*N ) = ONE
- END IF
- D( N ) = ABS( D( N ) )
- END IF
- IF( ICOMPQ.EQ.2 ) THEN
- CALL DLASD0( NSIZE, SQRE, D( START ), E( START ),
- $ U( START, START ), LDU, VT( START, START ),
- $ LDVT, SMLSIZ, IWORK, WORK( WSTART ), INFO )
- ELSE
- CALL DLASDA( ICOMPQ, SMLSIZ, NSIZE, SQRE, D( START ),
- $ E( START ), Q( START+( IU+QSTART-2 )*N ), N,
- $ Q( START+( IVT+QSTART-2 )*N ),
- $ IQ( START+K*N ), Q( START+( DIFL+QSTART-2 )*
- $ N ), Q( START+( DIFR+QSTART-2 )*N ),
- $ Q( START+( Z+QSTART-2 )*N ),
- $ Q( START+( POLES+QSTART-2 )*N ),
- $ IQ( START+GIVPTR*N ), IQ( START+GIVCOL*N ),
- $ N, IQ( START+PERM*N ),
- $ Q( START+( GIVNUM+QSTART-2 )*N ),
- $ Q( START+( IC+QSTART-2 )*N ),
- $ Q( START+( IS+QSTART-2 )*N ),
- $ WORK( WSTART ), IWORK, INFO )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- START = I + 1
- END IF
- 30 CONTINUE
-*
-* Unscale
-*
- CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, IERR )
- 40 CONTINUE
-*
-* Use Selection Sort to minimize swaps of singular vectors
-*
- DO 60 II = 2, N
- I = II - 1
- KK = I
- P = D( I )
- DO 50 J = II, N
- IF( D( J ).GT.P ) THEN
- KK = J
- P = D( J )
- END IF
- 50 CONTINUE
- IF( KK.NE.I ) THEN
- D( KK ) = D( I )
- D( I ) = P
- IF( ICOMPQ.EQ.1 ) THEN
- IQ( I ) = KK
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- CALL DSWAP( N, U( 1, I ), 1, U( 1, KK ), 1 )
- CALL DSWAP( N, VT( I, 1 ), LDVT, VT( KK, 1 ), LDVT )
- END IF
- ELSE IF( ICOMPQ.EQ.1 ) THEN
- IQ( I ) = I
- END IF
- 60 CONTINUE
-*
-* If ICOMPQ = 1, use IQ(N,1) as the indicator for UPLO
-*
- IF( ICOMPQ.EQ.1 ) THEN
- IF( IUPLO.EQ.1 ) THEN
- IQ( N ) = 1
- ELSE
- IQ( N ) = 0
- END IF
- END IF
-*
-* If B is lower bidiagonal, update U by those Givens rotations
-* which rotated B to be upper bidiagonal
-*
- IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
- $ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
-*
- RETURN
-*
-* End of DBDSDC
-*
- END
diff --git a/netlib/LAPACK/dbdsqr.f b/netlib/LAPACK/dbdsqr.f
deleted file mode 100644
index 007e997..0000000
--- a/netlib/LAPACK/dbdsqr.f
+++ /dev/null
@@ -1,850 +0,0 @@
-*> \brief \b DBDSQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DBDSQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dbdsqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dbdsqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dbdsqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
-* LDU, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DBDSQR computes the singular values and, optionally, the right and/or
-*> left singular vectors from the singular value decomposition (SVD) of
-*> a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
-*> zero-shift QR algorithm. The SVD of B has the form
-*>
-*> B = Q * S * P**T
-*>
-*> where S is the diagonal matrix of singular values, Q is an orthogonal
-*> matrix of left singular vectors, and P is an orthogonal matrix of
-*> right singular vectors. If left singular vectors are requested, this
-*> subroutine actually returns U*Q instead of Q, and, if right singular
-*> vectors are requested, this subroutine returns P**T*VT instead of
-*> P**T, for given real input matrices U and VT. When U and VT are the
-*> orthogonal matrices that reduce a general matrix A to bidiagonal
-*> form: A = U*B*VT, as computed by DGEBRD, then
-*>
-*> A = (U*Q) * S * (P**T*VT)
-*>
-*> is the SVD of A. Optionally, the subroutine may also compute Q**T*C
-*> for a given real input matrix C.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices With
-*> Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
-*> LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
-*> no. 5, pp. 873-912, Sept 1990) and
-*> "Accurate singular values and differential qd algorithms," by
-*> B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
-*> Department, University of California at Berkeley, July 1992
-*> for a detailed description of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': B is upper bidiagonal;
-*> = 'L': B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCVT
-*> \verbatim
-*> NCVT is INTEGER
-*> The number of columns of the matrix VT. NCVT >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRU
-*> \verbatim
-*> NRU is INTEGER
-*> The number of rows of the matrix U. NRU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> The number of columns of the matrix C. NCC >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the bidiagonal matrix B.
-*> On exit, if INFO=0, the singular values of B in decreasing
-*> order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the N-1 offdiagonal elements of the bidiagonal
-*> matrix B.
-*> On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
-*> will contain the diagonal and superdiagonal elements of a
-*> bidiagonal matrix orthogonally equivalent to the one given
-*> as input.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT, NCVT)
-*> On entry, an N-by-NCVT matrix VT.
-*> On exit, VT is overwritten by P**T * VT.
-*> Not referenced if NCVT = 0.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT.
-*> LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU, N)
-*> On entry, an NRU-by-N matrix U.
-*> On exit, U is overwritten by U * Q.
-*> Not referenced if NRU = 0.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,NRU).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC, NCC)
-*> On entry, an N-by-NCC matrix C.
-*> On exit, C is overwritten by Q**T * C.
-*> Not referenced if NCC = 0.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C.
-*> LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: If INFO = -i, the i-th argument had an illegal value
-*> > 0:
-*> if NCVT = NRU = NCC = 0,
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 30*N
-*> iterations (in inner while loop)
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> else NCVT = NRU = NCC = 0,
-*> the algorithm did not converge; D and E contain the
-*> elements of a bidiagonal matrix which is orthogonally
-*> similar to the input matrix B; if INFO = i, i
-*> elements of E have not converged to zero.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLMUL DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
-*> TOLMUL controls the convergence criterion of the QR loop.
-*> If it is positive, TOLMUL*EPS is the desired relative
-*> precision in the computed singular values.
-*> If it is negative, abs(TOLMUL*EPS*sigma_max) is the
-*> desired absolute accuracy in the computed singular
-*> values (corresponds to relative accuracy
-*> abs(TOLMUL*EPS) in the largest singular value.
-*> abs(TOLMUL) should be between 1 and 1/EPS, and preferably
-*> between 10 (for fast convergence) and .1/EPS
-*> (for there to be some accuracy in the results).
-*> Default is to lose at either one eighth or 2 of the
-*> available decimal digits in each computed singular value
-*> (whichever is smaller).
-*>
-*> MAXITR INTEGER, default = 6
-*> MAXITR controls the maximum number of passes of the
-*> algorithm through its inner loop. The algorithms stops
-*> (and so fails to converge) if the number of passes
-*> through the inner loop exceeds MAXITR*N**2.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
- $ LDU, C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION NEGONE
- PARAMETER ( NEGONE = -1.0D0 )
- DOUBLE PRECISION HNDRTH
- PARAMETER ( HNDRTH = 0.01D0 )
- DOUBLE PRECISION TEN
- PARAMETER ( TEN = 10.0D0 )
- DOUBLE PRECISION HNDRD
- PARAMETER ( HNDRD = 100.0D0 )
- DOUBLE PRECISION MEIGTH
- PARAMETER ( MEIGTH = -0.125D0 )
- INTEGER MAXITR
- PARAMETER ( MAXITR = 6 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, ROTATE
- INTEGER I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
- $ NM12, NM13, OLDLL, OLDM
- DOUBLE PRECISION ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
- $ OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
- $ SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
- $ SN, THRESH, TOL, TOLMUL, UNFL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARTG, DLAS2, DLASQ1, DLASR, DLASV2, DROT,
- $ DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NCVT.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -5
- ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
- $ ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
- INFO = -9
- ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
- INFO = -11
- ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
- $ ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DBDSQR', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
- IF( N.EQ.1 )
- $ GO TO 160
-*
-* ROTATE is true if any singular vectors desired, false otherwise
-*
- ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
-*
-* If no singular vectors desired, use qd algorithm
-*
- IF( .NOT.ROTATE ) THEN
- CALL DLASQ1( N, D, E, WORK, INFO )
-*
-* If INFO equals 2, dqds didn't finish, try to finish
-*
- IF( INFO .NE. 2 ) RETURN
- INFO = 0
- END IF
-*
- NM1 = N - 1
- NM12 = NM1 + NM1
- NM13 = NM12 + NM1
- IDIR = 0
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'Epsilon' )
- UNFL = DLAMCH( 'Safe minimum' )
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left
-*
- IF( LOWER ) THEN
- DO 10 I = 1, N - 1
- CALL DLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- WORK( I ) = CS
- WORK( NM1+I ) = SN
- 10 CONTINUE
-*
-* Update singular vectors if desired
-*
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U,
- $ LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C,
- $ LDC )
- END IF
-*
-* Compute singular values to relative accuracy TOL
-* (By setting TOL to be negative, algorithm will compute
-* singular values to absolute accuracy ABS(TOL)*norm(input matrix))
-*
- TOLMUL = MAX( TEN, MIN( HNDRD, EPS**MEIGTH ) )
- TOL = TOLMUL*EPS
-*
-* Compute approximate maximum, minimum singular values
-*
- SMAX = ZERO
- DO 20 I = 1, N
- SMAX = MAX( SMAX, ABS( D( I ) ) )
- 20 CONTINUE
- DO 30 I = 1, N - 1
- SMAX = MAX( SMAX, ABS( E( I ) ) )
- 30 CONTINUE
- SMINL = ZERO
- IF( TOL.GE.ZERO ) THEN
-*
-* Relative accuracy desired
-*
- SMINOA = ABS( D( 1 ) )
- IF( SMINOA.EQ.ZERO )
- $ GO TO 50
- MU = SMINOA
- DO 40 I = 2, N
- MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
- SMINOA = MIN( SMINOA, MU )
- IF( SMINOA.EQ.ZERO )
- $ GO TO 50
- 40 CONTINUE
- 50 CONTINUE
- SMINOA = SMINOA / SQRT( DBLE( N ) )
- THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
- ELSE
-*
-* Absolute accuracy desired
-*
- THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
- END IF
-*
-* Prepare for main iteration loop for the singular values
-* (MAXIT is the maximum number of passes through the inner
-* loop permitted before nonconvergence signalled.)
-*
- MAXIT = MAXITR*N*N
- ITER = 0
- OLDLL = -1
- OLDM = -1
-*
-* M points to last element of unconverged part of matrix
-*
- M = N
-*
-* Begin main iteration loop
-*
- 60 CONTINUE
-*
-* Check for convergence or exceeding iteration count
-*
- IF( M.LE.1 )
- $ GO TO 160
- IF( ITER.GT.MAXIT )
- $ GO TO 200
-*
-* Find diagonal block of matrix to work on
-*
- IF( TOL.LT.ZERO .AND. ABS( D( M ) ).LE.THRESH )
- $ D( M ) = ZERO
- SMAX = ABS( D( M ) )
- SMIN = SMAX
- DO 70 LLL = 1, M - 1
- LL = M - LLL
- ABSS = ABS( D( LL ) )
- ABSE = ABS( E( LL ) )
- IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
- $ D( LL ) = ZERO
- IF( ABSE.LE.THRESH )
- $ GO TO 80
- SMIN = MIN( SMIN, ABSS )
- SMAX = MAX( SMAX, ABSS, ABSE )
- 70 CONTINUE
- LL = 0
- GO TO 90
- 80 CONTINUE
- E( LL ) = ZERO
-*
-* Matrix splits since E(LL) = 0
-*
- IF( LL.EQ.M-1 ) THEN
-*
-* Convergence of bottom singular value, return to top of loop
-*
- M = M - 1
- GO TO 60
- END IF
- 90 CONTINUE
- LL = LL + 1
-*
-* E(LL) through E(M-1) are nonzero, E(LL-1) is zero
-*
- IF( LL.EQ.M-1 ) THEN
-*
-* 2 by 2 block, handle separately
-*
- CALL DLASV2( D( M-1 ), E( M-1 ), D( M ), SIGMN, SIGMX, SINR,
- $ COSR, SINL, COSL )
- D( M-1 ) = SIGMX
- E( M-1 ) = ZERO
- D( M ) = SIGMN
-*
-* Compute singular vectors, if desired
-*
- IF( NCVT.GT.0 )
- $ CALL DROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR,
- $ SINR )
- IF( NRU.GT.0 )
- $ CALL DROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
- IF( NCC.GT.0 )
- $ CALL DROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
- $ SINL )
- M = M - 2
- GO TO 60
- END IF
-*
-* If working on new submatrix, choose shift direction
-* (from larger end diagonal element towards smaller)
-*
- IF( LL.GT.OLDM .OR. M.LT.OLDLL ) THEN
- IF( ABS( D( LL ) ).GE.ABS( D( M ) ) ) THEN
-*
-* Chase bulge from top (big end) to bottom (small end)
-*
- IDIR = 1
- ELSE
-*
-* Chase bulge from bottom (big end) to top (small end)
-*
- IDIR = 2
- END IF
- END IF
-*
-* Apply convergence tests
-*
- IF( IDIR.EQ.1 ) THEN
-*
-* Run convergence test in forward direction
-* First apply standard test to bottom of matrix
-*
- IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
- $ ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
- E( M-1 ) = ZERO
- GO TO 60
- END IF
-*
- IF( TOL.GE.ZERO ) THEN
-*
-* If relative accuracy desired,
-* apply convergence criterion forward
-*
- MU = ABS( D( LL ) )
- SMINL = MU
- DO 100 LLL = LL, M - 1
- IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
- E( LLL ) = ZERO
- GO TO 60
- END IF
- MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
- SMINL = MIN( SMINL, MU )
- 100 CONTINUE
- END IF
-*
- ELSE
-*
-* Run convergence test in backward direction
-* First apply standard test to top of matrix
-*
- IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
- $ ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
- E( LL ) = ZERO
- GO TO 60
- END IF
-*
- IF( TOL.GE.ZERO ) THEN
-*
-* If relative accuracy desired,
-* apply convergence criterion backward
-*
- MU = ABS( D( M ) )
- SMINL = MU
- DO 110 LLL = M - 1, LL, -1
- IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
- E( LLL ) = ZERO
- GO TO 60
- END IF
- MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
- SMINL = MIN( SMINL, MU )
- 110 CONTINUE
- END IF
- END IF
- OLDLL = LL
- OLDM = M
-*
-* Compute shift. First, test if shifting would ruin relative
-* accuracy, and if so set the shift to zero.
-*
- IF( TOL.GE.ZERO .AND. N*TOL*( SMINL / SMAX ).LE.
- $ MAX( EPS, HNDRTH*TOL ) ) THEN
-*
-* Use a zero shift to avoid loss of relative accuracy
-*
- SHIFT = ZERO
- ELSE
-*
-* Compute the shift from 2-by-2 block at end of matrix
-*
- IF( IDIR.EQ.1 ) THEN
- SLL = ABS( D( LL ) )
- CALL DLAS2( D( M-1 ), E( M-1 ), D( M ), SHIFT, R )
- ELSE
- SLL = ABS( D( M ) )
- CALL DLAS2( D( LL ), E( LL ), D( LL+1 ), SHIFT, R )
- END IF
-*
-* Test if shift negligible, and if so set to zero
-*
- IF( SLL.GT.ZERO ) THEN
- IF( ( SHIFT / SLL )**2.LT.EPS )
- $ SHIFT = ZERO
- END IF
- END IF
-*
-* Increment iteration count
-*
- ITER = ITER + M - LL
-*
-* If SHIFT = 0, do simplified QR iteration
-*
- IF( SHIFT.EQ.ZERO ) THEN
- IF( IDIR.EQ.1 ) THEN
-*
-* Chase bulge from top to bottom
-* Save cosines and sines for later singular vector updates
-*
- CS = ONE
- OLDCS = ONE
- DO 120 I = LL, M - 1
- CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
- IF( I.GT.LL )
- $ E( I-1 ) = OLDSN*R
- CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
- WORK( I-LL+1 ) = CS
- WORK( I-LL+1+NM1 ) = SN
- WORK( I-LL+1+NM12 ) = OLDCS
- WORK( I-LL+1+NM13 ) = OLDSN
- 120 CONTINUE
- H = D( M )*CS
- D( M ) = H*OLDCS
- E( M-1 ) = H*OLDSN
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
- $ WORK( N ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
- $ WORK( NM13+1 ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
- $ WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( M-1 ) ).LE.THRESH )
- $ E( M-1 ) = ZERO
-*
- ELSE
-*
-* Chase bulge from bottom to top
-* Save cosines and sines for later singular vector updates
-*
- CS = ONE
- OLDCS = ONE
- DO 130 I = M, LL + 1, -1
- CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
- IF( I.LT.M )
- $ E( I ) = OLDSN*R
- CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
- WORK( I-LL ) = CS
- WORK( I-LL+NM1 ) = -SN
- WORK( I-LL+NM12 ) = OLDCS
- WORK( I-LL+NM13 ) = -OLDSN
- 130 CONTINUE
- H = D( LL )*CS
- D( LL ) = H*OLDCS
- E( LL ) = H*OLDSN
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
- $ WORK( NM13+1 ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
- $ WORK( N ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
- $ WORK( N ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( LL ) ).LE.THRESH )
- $ E( LL ) = ZERO
- END IF
- ELSE
-*
-* Use nonzero shift
-*
- IF( IDIR.EQ.1 ) THEN
-*
-* Chase bulge from top to bottom
-* Save cosines and sines for later singular vector updates
-*
- F = ( ABS( D( LL ) )-SHIFT )*
- $ ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
- G = E( LL )
- DO 140 I = LL, M - 1
- CALL DLARTG( F, G, COSR, SINR, R )
- IF( I.GT.LL )
- $ E( I-1 ) = R
- F = COSR*D( I ) + SINR*E( I )
- E( I ) = COSR*E( I ) - SINR*D( I )
- G = SINR*D( I+1 )
- D( I+1 ) = COSR*D( I+1 )
- CALL DLARTG( F, G, COSL, SINL, R )
- D( I ) = R
- F = COSL*E( I ) + SINL*D( I+1 )
- D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
- IF( I.LT.M-1 ) THEN
- G = SINL*E( I+1 )
- E( I+1 ) = COSL*E( I+1 )
- END IF
- WORK( I-LL+1 ) = COSR
- WORK( I-LL+1+NM1 ) = SINR
- WORK( I-LL+1+NM12 ) = COSL
- WORK( I-LL+1+NM13 ) = SINL
- 140 CONTINUE
- E( M-1 ) = F
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
- $ WORK( N ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
- $ WORK( NM13+1 ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
- $ WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( M-1 ) ).LE.THRESH )
- $ E( M-1 ) = ZERO
-*
- ELSE
-*
-* Chase bulge from bottom to top
-* Save cosines and sines for later singular vector updates
-*
- F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
- $ D( M ) )
- G = E( M-1 )
- DO 150 I = M, LL + 1, -1
- CALL DLARTG( F, G, COSR, SINR, R )
- IF( I.LT.M )
- $ E( I ) = R
- F = COSR*D( I ) + SINR*E( I-1 )
- E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
- G = SINR*D( I-1 )
- D( I-1 ) = COSR*D( I-1 )
- CALL DLARTG( F, G, COSL, SINL, R )
- D( I ) = R
- F = COSL*E( I-1 ) + SINL*D( I-1 )
- D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
- IF( I.GT.LL+1 ) THEN
- G = SINL*E( I-2 )
- E( I-2 ) = COSL*E( I-2 )
- END IF
- WORK( I-LL ) = COSR
- WORK( I-LL+NM1 ) = -SINR
- WORK( I-LL+NM12 ) = COSL
- WORK( I-LL+NM13 ) = -SINL
- 150 CONTINUE
- E( LL ) = F
-*
-* Test convergence
-*
- IF( ABS( E( LL ) ).LE.THRESH )
- $ E( LL ) = ZERO
-*
-* Update singular vectors if desired
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
- $ WORK( NM13+1 ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
- $ WORK( N ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
- $ WORK( N ), C( LL, 1 ), LDC )
- END IF
- END IF
-*
-* QR iteration finished, go back and check convergence
-*
- GO TO 60
-*
-* All singular values converged, so make them positive
-*
- 160 CONTINUE
- DO 170 I = 1, N
- IF( D( I ).LT.ZERO ) THEN
- D( I ) = -D( I )
-*
-* Change sign of singular vectors, if desired
-*
- IF( NCVT.GT.0 )
- $ CALL DSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
- END IF
- 170 CONTINUE
-*
-* Sort the singular values into decreasing order (insertion sort on
-* singular values, but only one transposition per singular vector)
-*
- DO 190 I = 1, N - 1
-*
-* Scan for smallest D(I)
-*
- ISUB = 1
- SMIN = D( 1 )
- DO 180 J = 2, N + 1 - I
- IF( D( J ).LE.SMIN ) THEN
- ISUB = J
- SMIN = D( J )
- END IF
- 180 CONTINUE
- IF( ISUB.NE.N+1-I ) THEN
-*
-* Swap singular values and vectors
-*
- D( ISUB ) = D( N+1-I )
- D( N+1-I ) = SMIN
- IF( NCVT.GT.0 )
- $ CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
- $ LDVT )
- IF( NRU.GT.0 )
- $ CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
- IF( NCC.GT.0 )
- $ CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
- END IF
- 190 CONTINUE
- GO TO 220
-*
-* Maximum number of iterations exceeded, failure to converge
-*
- 200 CONTINUE
- INFO = 0
- DO 210 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 210 CONTINUE
- 220 CONTINUE
- RETURN
-*
-* End of DBDSQR
-*
- END
diff --git a/netlib/LAPACK/ddisna.f b/netlib/LAPACK/ddisna.f
deleted file mode 100644
index 60952f6..0000000
--- a/netlib/LAPACK/ddisna.f
+++ /dev/null
@@ -1,245 +0,0 @@
-*> \brief \b DDISNA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DDISNA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ddisna.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ddisna.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ddisna.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DDISNA( JOB, M, N, D, SEP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER INFO, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), SEP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DDISNA computes the reciprocal condition numbers for the eigenvectors
-*> of a real symmetric or complex Hermitian matrix or for the left or
-*> right singular vectors of a general m-by-n matrix. The reciprocal
-*> condition number is the 'gap' between the corresponding eigenvalue or
-*> singular value and the nearest other one.
-*>
-*> The bound on the error, measured by angle in radians, in the I-th
-*> computed vector is given by
-*>
-*> DLAMCH( 'E' ) * ( ANORM / SEP( I ) )
-*>
-*> where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
-*> to be smaller than DLAMCH( 'E' )*ANORM in order to limit the size of
-*> the error bound.
-*>
-*> DDISNA may also be used to compute error bounds for eigenvectors of
-*> the generalized symmetric definite eigenproblem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies for which problem the reciprocal condition numbers
-*> should be computed:
-*> = 'E': the eigenvectors of a symmetric/Hermitian matrix;
-*> = 'L': the left singular vectors of a general matrix;
-*> = 'R': the right singular vectors of a general matrix.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> If JOB = 'L' or 'R', the number of columns of the matrix,
-*> in which case N >= 0. Ignored if JOB = 'E'.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (M) if JOB = 'E'
-*> dimension (min(M,N)) if JOB = 'L' or 'R'
-*> The eigenvalues (if JOB = 'E') or singular values (if JOB =
-*> 'L' or 'R') of the matrix, in either increasing or decreasing
-*> order. If singular values, they must be non-negative.
-*> \endverbatim
-*>
-*> \param[out] SEP
-*> \verbatim
-*> SEP is DOUBLE PRECISION array, dimension (M) if JOB = 'E'
-*> dimension (min(M,N)) if JOB = 'L' or 'R'
-*> The reciprocal condition numbers of the vectors.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DDISNA( JOB, M, N, D, SEP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER INFO, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), SEP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DECR, EIGEN, INCR, LEFT, RIGHT, SING
- INTEGER I, K
- DOUBLE PRECISION ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- EIGEN = LSAME( JOB, 'E' )
- LEFT = LSAME( JOB, 'L' )
- RIGHT = LSAME( JOB, 'R' )
- SING = LEFT .OR. RIGHT
- IF( EIGEN ) THEN
- K = M
- ELSE IF( SING ) THEN
- K = MIN( M, N )
- END IF
- IF( .NOT.EIGEN .AND. .NOT.SING ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( K.LT.0 ) THEN
- INFO = -3
- ELSE
- INCR = .TRUE.
- DECR = .TRUE.
- DO 10 I = 1, K - 1
- IF( INCR )
- $ INCR = INCR .AND. D( I ).LE.D( I+1 )
- IF( DECR )
- $ DECR = DECR .AND. D( I ).GE.D( I+1 )
- 10 CONTINUE
- IF( SING .AND. K.GT.0 ) THEN
- IF( INCR )
- $ INCR = INCR .AND. ZERO.LE.D( 1 )
- IF( DECR )
- $ DECR = DECR .AND. D( K ).GE.ZERO
- END IF
- IF( .NOT.( INCR .OR. DECR ) )
- $ INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DDISNA', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 )
- $ RETURN
-*
-* Compute reciprocal condition numbers
-*
- IF( K.EQ.1 ) THEN
- SEP( 1 ) = DLAMCH( 'O' )
- ELSE
- OLDGAP = ABS( D( 2 )-D( 1 ) )
- SEP( 1 ) = OLDGAP
- DO 20 I = 2, K - 1
- NEWGAP = ABS( D( I+1 )-D( I ) )
- SEP( I ) = MIN( OLDGAP, NEWGAP )
- OLDGAP = NEWGAP
- 20 CONTINUE
- SEP( K ) = OLDGAP
- END IF
- IF( SING ) THEN
- IF( ( LEFT .AND. M.GT.N ) .OR. ( RIGHT .AND. M.LT.N ) ) THEN
- IF( INCR )
- $ SEP( 1 ) = MIN( SEP( 1 ), D( 1 ) )
- IF( DECR )
- $ SEP( K ) = MIN( SEP( K ), D( K ) )
- END IF
- END IF
-*
-* Ensure that reciprocal condition numbers are not less than
-* threshold, in order to limit the size of the error bound
-*
- EPS = DLAMCH( 'E' )
- SAFMIN = DLAMCH( 'S' )
- ANORM = MAX( ABS( D( 1 ) ), ABS( D( K ) ) )
- IF( ANORM.EQ.ZERO ) THEN
- THRESH = EPS
- ELSE
- THRESH = MAX( EPS*ANORM, SAFMIN )
- END IF
- DO 30 I = 1, K
- SEP( I ) = MAX( SEP( I ), THRESH )
- 30 CONTINUE
-*
- RETURN
-*
-* End of DDISNA
-*
- END
diff --git a/netlib/LAPACK/dgbbrd.f b/netlib/LAPACK/dgbbrd.f
deleted file mode 100644
index 3d11411..0000000
--- a/netlib/LAPACK/dgbbrd.f
+++ /dev/null
@@ -1,547 +0,0 @@
-*> \brief \b DGBBRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBBRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbbrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbbrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbbrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q,
-* LDQ, PT, LDPT, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER VECT
-* INTEGER INFO, KL, KU, LDAB, LDC, LDPT, LDQ, M, N, NCC
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), C( LDC, * ), D( * ), E( * ),
-* $ PT( LDPT, * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBBRD reduces a real general m-by-n band matrix A to upper
-*> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*>
-*> The routine computes B, and optionally forms Q or P**T, or computes
-*> Q**T*C for a given matrix C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> Specifies whether or not the matrices Q and P**T are to be
-*> formed.
-*> = 'N': do not form Q or P**T;
-*> = 'Q': form Q only;
-*> = 'P': form P**T only;
-*> = 'B': form both.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> The number of columns of the matrix C. NCC >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals of the matrix A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals of the matrix A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the m-by-n band matrix A, stored in rows 1 to
-*> KL+KU+1. The j-th column of A is stored in the j-th column of
-*> the array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
-*> On exit, A is overwritten by values generated during the
-*> reduction.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B.
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (min(M,N)-1)
-*> The superdiagonal elements of the bidiagonal matrix B.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,M)
-*> If VECT = 'Q' or 'B', the m-by-m orthogonal matrix Q.
-*> If VECT = 'N' or 'P', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] PT
-*> \verbatim
-*> PT is DOUBLE PRECISION array, dimension (LDPT,N)
-*> If VECT = 'P' or 'B', the n-by-n orthogonal matrix P'.
-*> If VECT = 'N' or 'Q', the array PT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDPT
-*> \verbatim
-*> LDPT is INTEGER
-*> The leading dimension of the array PT.
-*> LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,NCC)
-*> On entry, an m-by-ncc matrix C.
-*> On exit, C is overwritten by Q**T*C.
-*> C is not referenced if NCC = 0.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C.
-*> LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*max(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q,
- $ LDQ, PT, LDPT, C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER VECT
- INTEGER INFO, KL, KU, LDAB, LDC, LDPT, LDQ, M, N, NCC
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), C( LDC, * ), D( * ), E( * ),
- $ PT( LDPT, * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTB, WANTC, WANTPT, WANTQ
- INTEGER I, INCA, J, J1, J2, KB, KB1, KK, KLM, KLU1,
- $ KUN, L, MINMN, ML, ML0, MN, MU, MU0, NR, NRT
- DOUBLE PRECISION RA, RB, RC, RS
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARGV, DLARTG, DLARTV, DLASET, DROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTB = LSAME( VECT, 'B' )
- WANTQ = LSAME( VECT, 'Q' ) .OR. WANTB
- WANTPT = LSAME( VECT, 'P' ) .OR. WANTB
- WANTC = NCC.GT.0
- KLU1 = KL + KU + 1
- INFO = 0
- IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. .NOT.LSAME( VECT, 'N' ) )
- $ THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -4
- ELSE IF( KL.LT.0 ) THEN
- INFO = -5
- ELSE IF( KU.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KLU1 ) THEN
- INFO = -8
- ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. LDQ.LT.MAX( 1, M ) ) THEN
- INFO = -12
- ELSE IF( LDPT.LT.1 .OR. WANTPT .AND. LDPT.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDC.LT.1 .OR. WANTC .AND. LDC.LT.MAX( 1, M ) ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBBRD', -INFO )
- RETURN
- END IF
-*
-* Initialize Q and P**T to the unit matrix, if needed
-*
- IF( WANTQ )
- $ CALL DLASET( 'Full', M, M, ZERO, ONE, Q, LDQ )
- IF( WANTPT )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, PT, LDPT )
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- MINMN = MIN( M, N )
-*
- IF( KL+KU.GT.1 ) THEN
-*
-* Reduce to upper bidiagonal form if KU > 0; if KU = 0, reduce
-* first to lower bidiagonal form and then transform to upper
-* bidiagonal
-*
- IF( KU.GT.0 ) THEN
- ML0 = 1
- MU0 = 2
- ELSE
- ML0 = 2
- MU0 = 1
- END IF
-*
-* Wherever possible, plane rotations are generated and applied in
-* vector operations of length NR over the index set J1:J2:KLU1.
-*
-* The sines of the plane rotations are stored in WORK(1:max(m,n))
-* and the cosines in WORK(max(m,n)+1:2*max(m,n)).
-*
- MN = MAX( M, N )
- KLM = MIN( M-1, KL )
- KUN = MIN( N-1, KU )
- KB = KLM + KUN
- KB1 = KB + 1
- INCA = KB1*LDAB
- NR = 0
- J1 = KLM + 2
- J2 = 1 - KUN
-*
- DO 90 I = 1, MINMN
-*
-* Reduce i-th column and i-th row of matrix to bidiagonal form
-*
- ML = KLM + 1
- MU = KUN + 1
- DO 80 KK = 1, KB
- J1 = J1 + KB
- J2 = J2 + KB
-*
-* generate plane rotations to annihilate nonzero elements
-* which have been created below the band
-*
- IF( NR.GT.0 )
- $ CALL DLARGV( NR, AB( KLU1, J1-KLM-1 ), INCA,
- $ WORK( J1 ), KB1, WORK( MN+J1 ), KB1 )
-*
-* apply plane rotations from the left
-*
- DO 10 L = 1, KB
- IF( J2-KLM+L-1.GT.N ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), INCA,
- $ AB( KLU1-L+1, J1-KLM+L-1 ), INCA,
- $ WORK( MN+J1 ), WORK( J1 ), KB1 )
- 10 CONTINUE
-*
- IF( ML.GT.ML0 ) THEN
- IF( ML.LE.M-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i+ml-1,i)
-* within the band, and apply rotation from the left
-*
- CALL DLARTG( AB( KU+ML-1, I ), AB( KU+ML, I ),
- $ WORK( MN+I+ML-1 ), WORK( I+ML-1 ),
- $ RA )
- AB( KU+ML-1, I ) = RA
- IF( I.LT.N )
- $ CALL DROT( MIN( KU+ML-2, N-I ),
- $ AB( KU+ML-2, I+1 ), LDAB-1,
- $ AB( KU+ML-1, I+1 ), LDAB-1,
- $ WORK( MN+I+ML-1 ), WORK( I+ML-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KB1
- END IF
-*
- IF( WANTQ ) THEN
-*
-* accumulate product of plane rotations in Q
-*
- DO 20 J = J1, J2, KB1
- CALL DROT( M, Q( 1, J-1 ), 1, Q( 1, J ), 1,
- $ WORK( MN+J ), WORK( J ) )
- 20 CONTINUE
- END IF
-*
- IF( WANTC ) THEN
-*
-* apply plane rotations to C
-*
- DO 30 J = J1, J2, KB1
- CALL DROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), LDC,
- $ WORK( MN+J ), WORK( J ) )
- 30 CONTINUE
- END IF
-*
- IF( J2+KUN.GT.N ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KB1
- END IF
-*
- DO 40 J = J1, J2, KB1
-*
-* create nonzero element a(j-1,j+ku) above the band
-* and store it in WORK(n+1:2*n)
-*
- WORK( J+KUN ) = WORK( J )*AB( 1, J+KUN )
- AB( 1, J+KUN ) = WORK( MN+J )*AB( 1, J+KUN )
- 40 CONTINUE
-*
-* generate plane rotations to annihilate nonzero elements
-* which have been generated above the band
-*
- IF( NR.GT.0 )
- $ CALL DLARGV( NR, AB( 1, J1+KUN-1 ), INCA,
- $ WORK( J1+KUN ), KB1, WORK( MN+J1+KUN ),
- $ KB1 )
-*
-* apply plane rotations from the right
-*
- DO 50 L = 1, KB
- IF( J2+L-1.GT.M ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L+1, J1+KUN-1 ), INCA,
- $ AB( L, J1+KUN ), INCA,
- $ WORK( MN+J1+KUN ), WORK( J1+KUN ),
- $ KB1 )
- 50 CONTINUE
-*
- IF( ML.EQ.ML0 .AND. MU.GT.MU0 ) THEN
- IF( MU.LE.N-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i,i+mu-1)
-* within the band, and apply rotation from the right
-*
- CALL DLARTG( AB( KU-MU+3, I+MU-2 ),
- $ AB( KU-MU+2, I+MU-1 ),
- $ WORK( MN+I+MU-1 ), WORK( I+MU-1 ),
- $ RA )
- AB( KU-MU+3, I+MU-2 ) = RA
- CALL DROT( MIN( KL+MU-2, M-I ),
- $ AB( KU-MU+4, I+MU-2 ), 1,
- $ AB( KU-MU+3, I+MU-1 ), 1,
- $ WORK( MN+I+MU-1 ), WORK( I+MU-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KB1
- END IF
-*
- IF( WANTPT ) THEN
-*
-* accumulate product of plane rotations in P**T
-*
- DO 60 J = J1, J2, KB1
- CALL DROT( N, PT( J+KUN-1, 1 ), LDPT,
- $ PT( J+KUN, 1 ), LDPT, WORK( MN+J+KUN ),
- $ WORK( J+KUN ) )
- 60 CONTINUE
- END IF
-*
- IF( J2+KB.GT.M ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KB1
- END IF
-*
- DO 70 J = J1, J2, KB1
-*
-* create nonzero element a(j+kl+ku,j+ku-1) below the
-* band and store it in WORK(1:n)
-*
- WORK( J+KB ) = WORK( J+KUN )*AB( KLU1, J+KUN )
- AB( KLU1, J+KUN ) = WORK( MN+J+KUN )*AB( KLU1, J+KUN )
- 70 CONTINUE
-*
- IF( ML.GT.ML0 ) THEN
- ML = ML - 1
- ELSE
- MU = MU - 1
- END IF
- 80 CONTINUE
- 90 CONTINUE
- END IF
-*
- IF( KU.EQ.0 .AND. KL.GT.0 ) THEN
-*
-* A has been reduced to lower bidiagonal form
-*
-* Transform lower bidiagonal form to upper bidiagonal by applying
-* plane rotations from the left, storing diagonal elements in D
-* and off-diagonal elements in E
-*
- DO 100 I = 1, MIN( M-1, N )
- CALL DLARTG( AB( 1, I ), AB( 2, I ), RC, RS, RA )
- D( I ) = RA
- IF( I.LT.N ) THEN
- E( I ) = RS*AB( 1, I+1 )
- AB( 1, I+1 ) = RC*AB( 1, I+1 )
- END IF
- IF( WANTQ )
- $ CALL DROT( M, Q( 1, I ), 1, Q( 1, I+1 ), 1, RC, RS )
- IF( WANTC )
- $ CALL DROT( NCC, C( I, 1 ), LDC, C( I+1, 1 ), LDC, RC,
- $ RS )
- 100 CONTINUE
- IF( M.LE.N )
- $ D( M ) = AB( 1, M )
- ELSE IF( KU.GT.0 ) THEN
-*
-* A has been reduced to upper bidiagonal form
-*
- IF( M.LT.N ) THEN
-*
-* Annihilate a(m,m+1) by applying plane rotations from the
-* right, storing diagonal elements in D and off-diagonal
-* elements in E
-*
- RB = AB( KU, M+1 )
- DO 110 I = M, 1, -1
- CALL DLARTG( AB( KU+1, I ), RB, RC, RS, RA )
- D( I ) = RA
- IF( I.GT.1 ) THEN
- RB = -RS*AB( KU, I )
- E( I-1 ) = RC*AB( KU, I )
- END IF
- IF( WANTPT )
- $ CALL DROT( N, PT( I, 1 ), LDPT, PT( M+1, 1 ), LDPT,
- $ RC, RS )
- 110 CONTINUE
- ELSE
-*
-* Copy off-diagonal elements to E and diagonal elements to D
-*
- DO 120 I = 1, MINMN - 1
- E( I ) = AB( KU, I+1 )
- 120 CONTINUE
- DO 130 I = 1, MINMN
- D( I ) = AB( KU+1, I )
- 130 CONTINUE
- END IF
- ELSE
-*
-* A is diagonal. Set elements of E to zero and copy diagonal
-* elements to D.
-*
- DO 140 I = 1, MINMN - 1
- E( I ) = ZERO
- 140 CONTINUE
- DO 150 I = 1, MINMN
- D( I ) = AB( 1, I )
- 150 CONTINUE
- END IF
- RETURN
-*
-* End of DGBBRD
-*
- END
diff --git a/netlib/LAPACK/dgbcon.f b/netlib/LAPACK/dgbcon.f
deleted file mode 100644
index bf6933f..0000000
--- a/netlib/LAPACK/dgbcon.f
+++ /dev/null
@@ -1,311 +0,0 @@
-*> \brief \b DGBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, KL, KU, LDAB, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBCON estimates the reciprocal of the condition number of a real
-*> general band matrix A, in either the 1-norm or the infinity-norm,
-*> using the LU factorization computed by DGBTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, KL, KU, LDAB, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, ONENRM
- CHARACTER NORMIN
- INTEGER IX, J, JP, KASE, KASE1, KD, LM
- DOUBLE PRECISION AINVNM, SCALE, SMLNUM, T
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLACN2, DLATBS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the norm of inv(A).
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KD = KL + KU + 1
- LNOTI = KL.GT.0
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(L).
-*
- IF( LNOTI ) THEN
- DO 20 J = 1, N - 1
- LM = MIN( KL, N-J )
- JP = IPIV( J )
- T = WORK( JP )
- IF( JP.NE.J ) THEN
- WORK( JP ) = WORK( J )
- WORK( J ) = T
- END IF
- CALL DAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 )
- 20 CONTINUE
- END IF
-*
-* Multiply by inv(U).
-*
- CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),
- $ INFO )
- ELSE
-*
-* Multiply by inv(U**T).
-*
- CALL DLATBS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),
- $ INFO )
-*
-* Multiply by inv(L**T).
-*
- IF( LNOTI ) THEN
- DO 30 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- WORK( J ) = WORK( J ) - DDOT( LM, AB( KD+1, J ), 1,
- $ WORK( J+1 ), 1 )
- JP = IPIV( J )
- IF( JP.NE.J ) THEN
- T = WORK( JP )
- WORK( JP ) = WORK( J )
- WORK( J ) = T
- END IF
- 30 CONTINUE
- END IF
- END IF
-*
-* Divide X by 1/SCALE if doing so will not cause overflow.
-*
- NORMIN = 'Y'
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 40
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 40 CONTINUE
- RETURN
-*
-* End of DGBCON
-*
- END
diff --git a/netlib/LAPACK/dgbequ.f b/netlib/LAPACK/dgbequ.f
deleted file mode 100644
index cc94fdb..0000000
--- a/netlib/LAPACK/dgbequ.f
+++ /dev/null
@@ -1,324 +0,0 @@
-*> \brief \b DGBEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBEQU computes row and column scalings intended to equilibrate an
-*> M-by-N band matrix A and reduce its condition number. R returns the
-*> row scale factors and C the column scale factors, chosen to try to
-*> make the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
-*>
-*> R(i) and C(j) are restricted to be between SMLNUM = smallest safe
-*> number and BIGNUM = largest safe number. Use of these scaling
-*> factors is not guaranteed to reduce the condition number of A but
-*> works well in practice.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th
-*> column of A is stored in the j-th column of the array AB as
-*> follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> If INFO = 0, or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, KD
- DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- KD = KU + 1
- DO 30 J = 1, N
- DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- R( I ) = MAX( R( I ), ABS( AB( KD+I-J, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I))
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- KD = KU + 1
- DO 90 J = 1, N
- DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- C( J ) = MAX( C( J ), ABS( AB( KD+I-J, J ) )*R( I ) )
- 80 CONTINUE
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J))
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of DGBEQU
-*
- END
diff --git a/netlib/LAPACK/dgbequb.f b/netlib/LAPACK/dgbequb.f
deleted file mode 100644
index 6be6027..0000000
--- a/netlib/LAPACK/dgbequb.f
+++ /dev/null
@@ -1,340 +0,0 @@
-*> \brief \b DGBEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBEQUB computes row and column scalings intended to equilibrate an
-*> M-by-N matrix A and reduce its condition number. R returns the row
-*> scale factors and C the column scale factors, chosen to try to make
-*> the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
-*> the radix.
-*>
-*> R(i) and C(j) are restricted to be a power of the radix between
-*> SMLNUM = smallest safe number and BIGNUM = largest safe number. Use
-*> of these scaling factors is not guaranteed to reduce the condition
-*> number of A but works well in practice.
-*>
-*> This routine differs from DGEEQU by restricting the scaling factors
-*> to a power of the radix. Baring over- and underflow, scaling by
-*> these factors introduces no additional rounding errors. However, the
-*> scaled entries' magnitured are no longer approximately 1 but lie
-*> between sqrt(radix) and 1/sqrt(radix).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, KD
- DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM, RADIX, LOGRDX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, LOG
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBEQUB', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants. Assume SMLNUM is a power of the radix.
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- RADIX = DLAMCH( 'B' )
- LOGRDX = LOG(RADIX)
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- KD = KU + 1
- DO 30 J = 1, N
- DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- R( I ) = MAX( R( I ), ABS( AB( KD+I-J, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
- DO I = 1, M
- IF( R( I ).GT.ZERO ) THEN
- R( I ) = RADIX**INT( LOG( R( I ) ) / LOGRDX )
- END IF
- END DO
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I)).
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors.
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- C( J ) = MAX( C( J ), ABS( AB( KD+I-J, J ) )*R( I ) )
- 80 CONTINUE
- IF( C( J ).GT.ZERO ) THEN
- C( J ) = RADIX**INT( LOG( C( J ) ) / LOGRDX )
- END IF
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J)).
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of DGBEQUB
-*
- END
diff --git a/netlib/LAPACK/dgbrfs.f b/netlib/LAPACK/dgbrfs.f
deleted file mode 100644
index 39d9198..0000000
--- a/netlib/LAPACK/dgbrfs.f
+++ /dev/null
@@ -1,464 +0,0 @@
-*> \brief \b DGBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
-* IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is banded, and provides
-*> error bounds and backward error estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The original band matrix A, stored in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGBTRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DGBTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
- $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANST
- INTEGER COUNT, I, J, K, KASE, KK, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGBMV, DGBTRS, DLACN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -7
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -9
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = MIN( KL+KU+2, N+1 )
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), 1,
- $ ONE, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(op(A))*abs(X) + abs(B).
-*
- IF( NOTRAN ) THEN
- DO 50 K = 1, N
- KK = KU + 1 - K
- XK = ABS( X( K, J ) )
- DO 40 I = MAX( 1, K-KU ), MIN( N, K+KL )
- WORK( I ) = WORK( I ) + ABS( AB( KK+I, K ) )*XK
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- KK = KU + 1 - K
- DO 60 I = MAX( 1, K-KU ), MIN( N, K+KL )
- S = S + ABS( AB( KK+I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DGBTRS( TRANST, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 110 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 120 CONTINUE
- CALL DGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DGBRFS
-*
- END
diff --git a/netlib/LAPACK/dgbsv.f b/netlib/LAPACK/dgbsv.f
deleted file mode 100644
index 93769d3..0000000
--- a/netlib/LAPACK/dgbsv.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief <b> DGBSV computes the solution to system of linear equations A * X = B for GB matrices</b> (simple driver)
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBSV computes the solution to a real system of linear equations
-*> A * X = B, where A is a band matrix of order N with KL subdiagonals
-*> and KU superdiagonals, and X and B are N-by-NRHS matrices.
-*>
-*> The LU decomposition with partial pivoting and row interchanges is
-*> used to factor A as A = L * U, where L is a product of permutation
-*> and unit lower triangular matrices with KL subdiagonals, and U is
-*> upper triangular with KL+KU superdiagonals. The factored form of A
-*> is then used to solve the system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL DGBTRF, DGBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( KL.LT.0 ) THEN
- INFO = -2
- ELSE IF( KU.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of the band matrix A.
-*
- CALL DGBTRF( N, N, KL, KU, AB, LDAB, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV,
- $ B, LDB, INFO )
- END IF
- RETURN
-*
-* End of DGBSV
-*
- END
diff --git a/netlib/LAPACK/dgbsvx.f b/netlib/LAPACK/dgbsvx.f
deleted file mode 100644
index f6911b2..0000000
--- a/netlib/LAPACK/dgbsvx.f
+++ /dev/null
@@ -1,642 +0,0 @@
-*> \brief <b> DGBSVX computes the solution to system of linear equations A * X = B for GB matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
-* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
-* RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, TRANS
-* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), C( * ), FERR( * ), R( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBSVX uses the LU factorization to compute the solution to a real
-*> system of linear equations A * X = B, A**T * X = B, or A**H * X = B,
-*> where A is a band matrix of order N with KL subdiagonals and KU
-*> superdiagonals, and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed by this subroutine:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
-*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*> or diag(C)*B (if TRANS = 'T' or 'C').
-*>
-*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*> matrix A (after equilibration if FACT = 'E') as
-*> A = L * U,
-*> where L is a product of permutation and unit lower triangular
-*> matrices with KL subdiagonals, and U is upper triangular with
-*> KL+KU superdiagonals.
-*>
-*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*> that it solves the original system before equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFB and IPIV contain the factored form of
-*> A. If EQUED is not 'N', the matrix A has been
-*> equilibrated with scaling factors given by R and C.
-*> AB, AFB, and IPIV are not modified.
-*> = 'N': The matrix A will be copied to AFB and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFB and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*>
-*> If FACT = 'F' and EQUED is not 'N', then A must have been
-*> equilibrated by the scaling factors in R and/or C. AB is not
-*> modified if FACT = 'F' or 'N', or if FACT = 'E' and
-*> EQUED = 'N' on exit.
-*>
-*> On exit, if EQUED .ne. 'N', A is scaled as follows:
-*> EQUED = 'R': A := diag(R) * A
-*> EQUED = 'C': A := A * diag(C)
-*> EQUED = 'B': A := diag(R) * A * diag(C).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in,out] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> If FACT = 'F', then AFB is an input argument and on entry
-*> contains details of the LU factorization of the band matrix
-*> A, as computed by DGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
-*> the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFB is an output argument and on exit
-*> returns details of the LU factorization of A.
-*>
-*> If FACT = 'E', then AFB is an output argument and on exit
-*> returns details of the LU factorization of the equilibrated
-*> matrix A (see the description of AB for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the factorization A = L*U
-*> as computed by DGBTRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = L*U
-*> of the equilibrated matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (N)
-*> The row scale factors for A. If EQUED = 'R' or 'B', A is
-*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*> is not accessed. R is an input argument if FACT = 'F';
-*> otherwise, R is an output argument. If FACT = 'F' and
-*> EQUED = 'R' or 'B', each element of R must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A. If EQUED = 'C' or 'B', A is
-*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*> is not accessed. C is an input argument if FACT = 'F';
-*> otherwise, C is an output argument. If FACT = 'F' and
-*> EQUED = 'C' or 'B', each element of C must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit,
-*> if EQUED = 'N', B is not modified;
-*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*> diag(R)*B;
-*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*> overwritten by diag(C)*B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*> to the original system of equations. Note that A and B are
-*> modified on exit if EQUED .ne. 'N', and the solution to the
-*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*> and EQUED = 'R' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> On exit, WORK(1) contains the reciprocal pivot growth
-*> factor norm(A)/norm(U). The "max absolute element" norm is
-*> used. If WORK(1) is much less than 1, then the stability
-*> of the LU factorization of the (equilibrated) matrix A
-*> could be poor. This also means that the solution X, condition
-*> estimator RCOND, and forward error bound FERR could be
-*> unreliable. If factorization fails with 0<INFO<=N, then
-*> WORK(1) contains the reciprocal pivot growth factor for the
-*> leading INFO columns of A.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution and error bounds
-*> could not be computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGBsolve
-*
-* =====================================================================
- SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
- $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
- $ RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, TRANS
- INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), C( * ), FERR( * ), R( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
- CHARACTER NORM
- INTEGER I, INFEQU, J, J1, J2
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
- $ ROWCND, RPVGRW, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGB, DLANTB
- EXTERNAL LSAME, DLAMCH, DLANGB, DLANTB
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGBCON, DGBEQU, DGBRFS, DGBTRF, DGBTRS,
- $ DLACPY, DLAQGB, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- ROWEQU = .FALSE.
- COLEQU = .FALSE.
- ELSE
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KL.LT.0 ) THEN
- INFO = -4
- ELSE IF( KU.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -8
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -10
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -12
- ELSE
- IF( ROWEQU ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 10 J = 1, N
- RCMIN = MIN( RCMIN, R( J ) )
- RCMAX = MAX( RCMAX, R( J ) )
- 10 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -13
- ELSE IF( N.GT.0 ) THEN
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- ROWCND = ONE
- END IF
- END IF
- IF( COLEQU .AND. INFO.EQ.0 ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 20 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 20 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -14
- ELSE IF( N.GT.0 ) THEN
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- COLCND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -16
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -18
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, EQUED )
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( NOTRAN ) THEN
- IF( ROWEQU ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = R( I )*B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( COLEQU ) THEN
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- B( I, J ) = C( I )*B( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the LU factorization of the band matrix A.
-*
- DO 70 J = 1, N
- J1 = MAX( J-KU, 1 )
- J2 = MIN( J+KL, N )
- CALL DCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1,
- $ AFB( KL+KU+1-J+J1, J ), 1 )
- 70 CONTINUE
-*
- CALL DGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 ) THEN
-*
-* Compute the reciprocal pivot growth factor of the
-* leading rank-deficient INFO columns of A.
-*
- ANORM = ZERO
- DO 90 J = 1, INFO
- DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- ANORM = MAX( ANORM, ABS( AB( I, J ) ) )
- 80 CONTINUE
- 90 CONTINUE
- RPVGRW = DLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ),
- $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB,
- $ WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = ANORM / RPVGRW
- END IF
- WORK( 1 ) = RPVGRW
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A and the
-* reciprocal pivot growth factor RPVGRW.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = DLANGB( NORM, N, KL, KU, AB, LDAB, WORK )
- RPVGRW = DLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = DLANGB( 'M', N, KL, KU, AB, LDAB, WORK ) / RPVGRW
- END IF
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX,
- $ INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV,
- $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( NOTRAN ) THEN
- IF( COLEQU ) THEN
- DO 110 J = 1, NRHS
- DO 100 I = 1, N
- X( I, J ) = C( I )*X( I, J )
- 100 CONTINUE
- 110 CONTINUE
- DO 120 J = 1, NRHS
- FERR( J ) = FERR( J ) / COLCND
- 120 CONTINUE
- END IF
- ELSE IF( ROWEQU ) THEN
- DO 140 J = 1, NRHS
- DO 130 I = 1, N
- X( I, J ) = R( I )*X( I, J )
- 130 CONTINUE
- 140 CONTINUE
- DO 150 J = 1, NRHS
- FERR( J ) = FERR( J ) / ROWCND
- 150 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- WORK( 1 ) = RPVGRW
- RETURN
-*
-* End of DGBSVX
-*
- END
diff --git a/netlib/LAPACK/dgbtf2.f b/netlib/LAPACK/dgbtf2.f
deleted file mode 100644
index dc1fd99..0000000
--- a/netlib/LAPACK/dgbtf2.f
+++ /dev/null
@@ -1,277 +0,0 @@
-*> \brief \b DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbtf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbtf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbtf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBTF2 computes an LU factorization of a real m-by-n band matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U, because of fill-in resulting from the row
-*> interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, JP, JU, KM, KV
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- EXTERNAL IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGER, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in.
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero.
-*
- DO 20 J = KU + 2, MIN( KV, N )
- DO 10 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* JU is the index of the last column affected by the current stage
-* of the factorization.
-*
- JU = 1
-*
- DO 40 J = 1, MIN( M, N )
-*
-* Set fill-in elements in column J+KV to zero.
-*
- IF( J+KV.LE.N ) THEN
- DO 30 I = 1, KL
- AB( I, J+KV ) = ZERO
- 30 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-J )
- JP = IDAMAX( KM+1, AB( KV+1, J ), 1 )
- IPIV( J ) = JP + J - 1
- IF( AB( KV+JP, J ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( J+KU+JP-1, N ) )
-*
-* Apply interchange to columns J to JU.
-*
- IF( JP.NE.1 )
- $ CALL DSWAP( JU-J+1, AB( KV+JP, J ), LDAB-1,
- $ AB( KV+1, J ), LDAB-1 )
-*
- IF( KM.GT.0 ) THEN
-*
-* Compute multipliers.
-*
- CALL DSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 )
-*
-* Update trailing submatrix within the band.
-*
- IF( JU.GT.J )
- $ CALL DGER( KM, JU-J, -ONE, AB( KV+2, J ), 1,
- $ AB( KV, J+1 ), LDAB-1, AB( KV+1, J+1 ),
- $ LDAB-1 )
- END IF
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = J
- END IF
- 40 CONTINUE
- RETURN
-*
-* End of DGBTF2
-*
- END
diff --git a/netlib/LAPACK/dgbtrf.f b/netlib/LAPACK/dgbtrf.f
deleted file mode 100644
index 653f8e3..0000000
--- a/netlib/LAPACK/dgbtrf.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief \b DGBTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbtrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbtrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbtrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBTRF computes an LU factorization of a real m-by-n band matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> This is the blocked version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
- INTEGER NBMAX, LDWORK
- PARAMETER ( NBMAX = 64, LDWORK = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I2, I3, II, IP, J, J2, J3, JB, JJ, JM, JP,
- $ JU, K2, KM, KV, NB, NW
- DOUBLE PRECISION TEMP
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION WORK13( LDWORK, NBMAX ),
- $ WORK31( LDWORK, NBMAX )
-* ..
-* .. External Functions ..
- INTEGER IDAMAX, ILAENV
- EXTERNAL IDAMAX, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGBTF2, DGEMM, DGER, DLASWP, DSCAL,
- $ DSWAP, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment
-*
- NB = ILAENV( 1, 'DGBTRF', ' ', M, N, KL, KU )
-*
-* The block size must not exceed the limit set by the size of the
-* local arrays WORK13 and WORK31.
-*
- NB = MIN( NB, NBMAX )
-*
- IF( NB.LE.1 .OR. NB.GT.KL ) THEN
-*
-* Use unblocked code
-*
- CALL DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
- ELSE
-*
-* Use blocked code
-*
-* Zero the superdiagonal elements of the work array WORK13
-*
- DO 20 J = 1, NB
- DO 10 I = 1, J - 1
- WORK13( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Zero the subdiagonal elements of the work array WORK31
-*
- DO 40 J = 1, NB
- DO 30 I = J + 1, NB
- WORK31( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero
-*
- DO 60 J = KU + 2, MIN( KV, N )
- DO 50 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
-* JU is the index of the last column affected by the current
-* stage of the factorization
-*
- JU = 1
-*
- DO 180 J = 1, MIN( M, N ), NB
- JB = MIN( NB, MIN( M, N )-J+1 )
-*
-* The active part of the matrix is partitioned
-*
-* A11 A12 A13
-* A21 A22 A23
-* A31 A32 A33
-*
-* Here A11, A21 and A31 denote the current block of JB columns
-* which is about to be factorized. The number of rows in the
-* partitioning are JB, I2, I3 respectively, and the numbers
-* of columns are JB, J2, J3. The superdiagonal elements of A13
-* and the subdiagonal elements of A31 lie outside the band.
-*
- I2 = MIN( KL-JB, M-J-JB+1 )
- I3 = MIN( JB, M-J-KL+1 )
-*
-* J2 and J3 are computed after JU has been updated.
-*
-* Factorize the current block of JB columns
-*
- DO 80 JJ = J, J + JB - 1
-*
-* Set fill-in elements in column JJ+KV to zero
-*
- IF( JJ+KV.LE.N ) THEN
- DO 70 I = 1, KL
- AB( I, JJ+KV ) = ZERO
- 70 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-JJ )
- JP = IDAMAX( KM+1, AB( KV+1, JJ ), 1 )
- IPIV( JJ ) = JP + JJ - J
- IF( AB( KV+JP, JJ ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( JJ+KU+JP-1, N ) )
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to J+JB-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
- CALL DSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange affects columns J to JJ-1 of A31
-* which are stored in the work array WORK31
-*
- CALL DSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- CALL DSWAP( J+JB-JJ, AB( KV+1, JJ ), LDAB-1,
- $ AB( KV+JP, JJ ), LDAB-1 )
- END IF
- END IF
-*
-* Compute multipliers
-*
- CALL DSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ),
- $ 1 )
-*
-* Update trailing submatrix within the band and within
-* the current block. JM is the index of the last column
-* which needs to be updated.
-*
- JM = MIN( JU, J+JB-1 )
- IF( JM.GT.JJ )
- $ CALL DGER( KM, JM-JJ, -ONE, AB( KV+2, JJ ), 1,
- $ AB( KV, JJ+1 ), LDAB-1,
- $ AB( KV+1, JJ+1 ), LDAB-1 )
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = JJ
- END IF
-*
-* Copy current column of A31 into the work array WORK31
-*
- NW = MIN( JJ-J+1, I3 )
- IF( NW.GT.0 )
- $ CALL DCOPY( NW, AB( KV+KL+1-JJ+J, JJ ), 1,
- $ WORK31( 1, JJ-J+1 ), 1 )
- 80 CONTINUE
- IF( J+JB.LE.N ) THEN
-*
-* Apply the row interchanges to the other blocks.
-*
- J2 = MIN( JU-J+1, KV ) - JB
- J3 = MAX( 0, JU-J-KV+1 )
-*
-* Use DLASWP to apply the row interchanges to A12, A22, and
-* A32.
-*
- CALL DLASWP( J2, AB( KV+1-JB, J+JB ), LDAB-1, 1, JB,
- $ IPIV( J ), 1 )
-*
-* Adjust the pivot indices.
-*
- DO 90 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 90 CONTINUE
-*
-* Apply the row interchanges to A13, A23, and A33
-* columnwise.
-*
- K2 = J - 1 + JB + J2
- DO 110 I = 1, J3
- JJ = K2 + I
- DO 100 II = J + I - 1, J + JB - 1
- IP = IPIV( II )
- IF( IP.NE.II ) THEN
- TEMP = AB( KV+1+II-JJ, JJ )
- AB( KV+1+II-JJ, JJ ) = AB( KV+1+IP-JJ, JJ )
- AB( KV+1+IP-JJ, JJ ) = TEMP
- END IF
- 100 CONTINUE
- 110 CONTINUE
-*
-* Update the relevant part of the trailing submatrix
-*
- IF( J2.GT.0 ) THEN
-*
-* Update A12
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J2, ONE, AB( KV+1, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A22
-*
- CALL DGEMM( 'No transpose', 'No transpose', I2, J2,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+1, J+JB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A32
-*
- CALL DGEMM( 'No transpose', 'No transpose', I3, J2,
- $ JB, -ONE, WORK31, LDWORK,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+KL+1-JB, J+JB ), LDAB-1 )
- END IF
- END IF
-*
- IF( J3.GT.0 ) THEN
-*
-* Copy the lower triangle of A13 into the work array
-* WORK13
-*
- DO 130 JJ = 1, J3
- DO 120 II = JJ, JB
- WORK13( II, JJ ) = AB( II-JJ+1, JJ+J+KV-1 )
- 120 CONTINUE
- 130 CONTINUE
-*
-* Update A13 in the work array
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J3, ONE, AB( KV+1, J ), LDAB-1,
- $ WORK13, LDWORK )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A23
-*
- CALL DGEMM( 'No transpose', 'No transpose', I2, J3,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ),
- $ LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A33
-*
- CALL DGEMM( 'No transpose', 'No transpose', I3, J3,
- $ JB, -ONE, WORK31, LDWORK, WORK13,
- $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 )
- END IF
-*
-* Copy the lower triangle of A13 back into place
-*
- DO 150 JJ = 1, J3
- DO 140 II = JJ, JB
- AB( II-JJ+1, JJ+J+KV-1 ) = WORK13( II, JJ )
- 140 CONTINUE
- 150 CONTINUE
- END IF
- ELSE
-*
-* Adjust the pivot indices.
-*
- DO 160 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 160 CONTINUE
- END IF
-*
-* Partially undo the interchanges in the current block to
-* restore the upper triangular form of A31 and copy the upper
-* triangle of A31 back into place
-*
- DO 170 JJ = J + JB - 1, J, -1
- JP = IPIV( JJ ) - JJ + 1
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to JJ-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
-* The interchange does not affect A31
-*
- CALL DSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange does affect A31
-*
- CALL DSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- END IF
- END IF
-*
-* Copy the current column of A31 back into place
-*
- NW = MIN( I3, JJ-J+1 )
- IF( NW.GT.0 )
- $ CALL DCOPY( NW, WORK31( 1, JJ-J+1 ), 1,
- $ AB( KV+KL+1-JJ+J, JJ ), 1 )
- 170 CONTINUE
- 180 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DGBTRF
-*
- END
diff --git a/netlib/LAPACK/dgbtrs.f b/netlib/LAPACK/dgbtrs.f
deleted file mode 100644
index f34ae75..0000000
--- a/netlib/LAPACK/dgbtrs.f
+++ /dev/null
@@ -1,269 +0,0 @@
-*> \brief \b DGBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGBTRS solves a system of linear equations
-*> A * X = B or A**T * X = B
-*> with a general band matrix A using the LU factorization computed
-*> by DGBTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, NOTRAN
- INTEGER I, J, KD, L, LM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DSWAP, DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.( 2*KL+KU+1 ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- KD = KU + KL + 1
- LNOTI = KL.GT.0
-*
- IF( NOTRAN ) THEN
-*
-* Solve A*X = B.
-*
-* Solve L*X = B, overwriting B with X.
-*
-* L is represented as a product of permutations and unit lower
-* triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
-* where each transformation L(i) is a rank-one modification of
-* the identity matrix.
-*
- IF( LNOTI ) THEN
- DO 10 J = 1, N - 1
- LM = MIN( KL, N-J )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- CALL DGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ),
- $ LDB, B( J+1, 1 ), LDB )
- 10 CONTINUE
- END IF
-*
- DO 20 I = 1, NRHS
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU,
- $ AB, LDAB, B( 1, I ), 1 )
- 20 CONTINUE
-*
- ELSE
-*
-* Solve A**T*X = B.
-*
- DO 30 I = 1, NRHS
-*
-* Solve U**T*X = B, overwriting B with X.
-*
- CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB,
- $ LDAB, B( 1, I ), 1 )
- 30 CONTINUE
-*
-* Solve L**T*X = B, overwriting B with X.
-*
- IF( LNOTI ) THEN
- DO 40 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- CALL DGEMV( 'Transpose', LM, NRHS, -ONE, B( J+1, 1 ),
- $ LDB, AB( KD+1, J ), 1, ONE, B( J, 1 ), LDB )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DGBTRS
-*
- END
diff --git a/netlib/LAPACK/dgebak.f b/netlib/LAPACK/dgebak.f
deleted file mode 100644
index 276a298..0000000
--- a/netlib/LAPACK/dgebak.f
+++ /dev/null
@@ -1,268 +0,0 @@
-*> \brief \b DGEBAK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBAK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebak.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebak.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebak.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB, SIDE
-* INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION SCALE( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEBAK forms the right or left eigenvectors of a real general matrix
-*> by backward transformation on the computed eigenvectors of the
-*> balanced matrix output by DGEBAL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the type of backward transformation required:
-*> = 'N', do nothing, return immediately;
-*> = 'P', do backward transformation for permutation only;
-*> = 'S', do backward transformation for scaling only;
-*> = 'B', do backward transformations for both permutation and
-*> scaling.
-*> JOB must be the same as the argument JOB supplied to DGEBAL.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': V contains right eigenvectors;
-*> = 'L': V contains left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrix V. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> The integers ILO and IHI determined by DGEBAL.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutation and scaling factors, as returned
-*> by DGEBAL.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix V. M >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,M)
-*> On entry, the matrix of right or left eigenvectors to be
-*> transformed, as returned by DHSEIN or DTREVC.
-*> On exit, V is overwritten by the transformed eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB, SIDE
- INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION SCALE( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFTV, RIGHTV
- INTEGER I, II, K
- DOUBLE PRECISION S
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters
-*
- RIGHTV = LSAME( SIDE, 'R' )
- LEFTV = LSAME( SIDE, 'L' )
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -7
- ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEBAK', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( M.EQ.0 )
- $ RETURN
- IF( LSAME( JOB, 'N' ) )
- $ RETURN
-*
- IF( ILO.EQ.IHI )
- $ GO TO 30
-*
-* Backward balance
-*
- IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
- IF( RIGHTV ) THEN
- DO 10 I = ILO, IHI
- S = SCALE( I )
- CALL DSCAL( M, S, V( I, 1 ), LDV )
- 10 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
- DO 20 I = ILO, IHI
- S = ONE / SCALE( I )
- CALL DSCAL( M, S, V( I, 1 ), LDV )
- 20 CONTINUE
- END IF
-*
- END IF
-*
-* Backward permutation
-*
-* For I = ILO-1 step -1 until 1,
-* IHI+1 step 1 until N do --
-*
- 30 CONTINUE
- IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
- IF( RIGHTV ) THEN
- DO 40 II = 1, N
- I = II
- IF( I.GE.ILO .AND. I.LE.IHI )
- $ GO TO 40
- IF( I.LT.ILO )
- $ I = ILO - II
- K = SCALE( I )
- IF( K.EQ.I )
- $ GO TO 40
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 40 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
- DO 50 II = 1, N
- I = II
- IF( I.GE.ILO .AND. I.LE.IHI )
- $ GO TO 50
- IF( I.LT.ILO )
- $ I = ILO - II
- K = SCALE( I )
- IF( K.EQ.I )
- $ GO TO 50
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 50 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGEBAK
-*
- END
diff --git a/netlib/LAPACK/dgebal.f b/netlib/LAPACK/dgebal.f
deleted file mode 100644
index 5d7ed03..0000000
--- a/netlib/LAPACK/dgebal.f
+++ /dev/null
@@ -1,405 +0,0 @@
-*> \brief \b DGEBAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBAL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebal.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebal.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebal.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), SCALE( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEBAL balances a general real matrix A. This involves, first,
-*> permuting A by a similarity transformation to isolate eigenvalues
-*> in the first 1 to ILO-1 and last IHI+1 to N elements on the
-*> diagonal; and second, applying a diagonal similarity transformation
-*> to rows and columns ILO to IHI to make the rows and columns as
-*> close in norm as possible. Both steps are optional.
-*>
-*> Balancing may reduce the 1-norm of the matrix, and improve the
-*> accuracy of the computed eigenvalues and/or eigenvectors.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the operations to be performed on A:
-*> = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
-*> for i = 1,...,N;
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE array, dimension (LDA,N)
-*> On entry, the input matrix A.
-*> On exit, A is overwritten by the balanced matrix.
-*> If JOB = 'N', A is not referenced.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are set to integers such that on exit
-*> A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
-*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE array, dimension (N)
-*> Details of the permutations and scaling factors applied to
-*> A. If P(j) is the index of the row and column interchanged
-*> with row and column j and D(j) is the scaling factor
-*> applied to row and column j, then
-*> SCALE(j) = P(j) for j = 1,...,ILO-1
-*> = D(j) for j = ILO,...,IHI
-*> = P(j) for j = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The permutations consist of row and column interchanges which put
-*> the matrix in the form
-*>
-*> ( T1 X Y )
-*> P A P = ( 0 B Z )
-*> ( 0 0 T2 )
-*>
-*> where T1 and T2 are upper triangular matrices whose eigenvalues lie
-*> along the diagonal. The column indices ILO and IHI mark the starting
-*> and ending columns of the submatrix B. Balancing consists of applying
-*> a diagonal similarity transformation inv(D) * B * D to make the
-*> 1-norms of each row of B and its corresponding column nearly equal.
-*> The output matrix is
-*>
-*> ( T1 X*D Y )
-*> ( 0 inv(D)*B*D inv(D)*Z ).
-*> ( 0 0 T2 )
-*>
-*> Information about the permutations P and the diagonal matrix D is
-*> returned in the vector SCALE.
-*>
-*> This subroutine is based on the EISPACK routine BALANC.
-*>
-*> Modified by Tzu-Yi Chen, Computer Science Division, University of
-*> California at Berkeley, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), SCALE( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION SCLFAC
- PARAMETER ( SCLFAC = 2.0D+0 )
- DOUBLE PRECISION FACTOR
- PARAMETER ( FACTOR = 0.95D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOCONV
- INTEGER I, ICA, IEXC, IRA, J, K, L, M
- DOUBLE PRECISION C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
- $ SFMIN2
-* ..
-* .. External Functions ..
- LOGICAL DISNAN, LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL DISNAN, LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEBAL', -INFO )
- RETURN
- END IF
-*
- K = 1
- L = N
-*
- IF( N.EQ.0 )
- $ GO TO 210
-*
- IF( LSAME( JOB, 'N' ) ) THEN
- DO 10 I = 1, N
- SCALE( I ) = ONE
- 10 CONTINUE
- GO TO 210
- END IF
-*
- IF( LSAME( JOB, 'S' ) )
- $ GO TO 120
-*
-* Permutation to isolate eigenvalues if possible
-*
- GO TO 50
-*
-* Row and column exchange.
-*
- 20 CONTINUE
- SCALE( M ) = J
- IF( J.EQ.M )
- $ GO TO 30
-*
- CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
- CALL DSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
-*
- 30 CONTINUE
- GO TO ( 40, 80 )IEXC
-*
-* Search for rows isolating an eigenvalue and push them down.
-*
- 40 CONTINUE
- IF( L.EQ.1 )
- $ GO TO 210
- L = L - 1
-*
- 50 CONTINUE
- DO 70 J = L, 1, -1
-*
- DO 60 I = 1, L
- IF( I.EQ.J )
- $ GO TO 60
- IF( A( J, I ).NE.ZERO )
- $ GO TO 70
- 60 CONTINUE
-*
- M = L
- IEXC = 1
- GO TO 20
- 70 CONTINUE
-*
- GO TO 90
-*
-* Search for columns isolating an eigenvalue and push them left.
-*
- 80 CONTINUE
- K = K + 1
-*
- 90 CONTINUE
- DO 110 J = K, L
-*
- DO 100 I = K, L
- IF( I.EQ.J )
- $ GO TO 100
- IF( A( I, J ).NE.ZERO )
- $ GO TO 110
- 100 CONTINUE
-*
- M = K
- IEXC = 2
- GO TO 20
- 110 CONTINUE
-*
- 120 CONTINUE
- DO 130 I = K, L
- SCALE( I ) = ONE
- 130 CONTINUE
-*
- IF( LSAME( JOB, 'P' ) )
- $ GO TO 210
-*
-* Balance the submatrix in rows K to L.
-*
-* Iterative loop for norm reduction
-*
- SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' )
- SFMAX1 = ONE / SFMIN1
- SFMIN2 = SFMIN1*SCLFAC
- SFMAX2 = ONE / SFMIN2
- 140 CONTINUE
- NOCONV = .FALSE.
-*
- DO 200 I = K, L
- C = ZERO
- R = ZERO
-*
- DO 150 J = K, L
- IF( J.EQ.I )
- $ GO TO 150
- C = C + ABS( A( J, I ) )
- R = R + ABS( A( I, J ) )
- 150 CONTINUE
- ICA = IDAMAX( L, A( 1, I ), 1 )
- CA = ABS( A( ICA, I ) )
- IRA = IDAMAX( N-K+1, A( I, K ), LDA )
- RA = ABS( A( I, IRA+K-1 ) )
-*
-* Guard against zero C or R due to underflow.
-*
- IF( C.EQ.ZERO .OR. R.EQ.ZERO )
- $ GO TO 200
- G = R / SCLFAC
- F = ONE
- S = C + R
- 160 CONTINUE
- IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
- $ MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
- IF( DISNAN( C+F+CA+R+G+RA ) ) THEN
-*
-* Exit if NaN to avoid infinite loop
-*
- INFO = -3
- CALL XERBLA( 'DGEBAL', -INFO )
- RETURN
- END IF
- F = F*SCLFAC
- C = C*SCLFAC
- CA = CA*SCLFAC
- R = R / SCLFAC
- G = G / SCLFAC
- RA = RA / SCLFAC
- GO TO 160
-*
- 170 CONTINUE
- G = C / SCLFAC
- 180 CONTINUE
- IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
- $ MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
- F = F / SCLFAC
- C = C / SCLFAC
- G = G / SCLFAC
- CA = CA / SCLFAC
- R = R*SCLFAC
- RA = RA*SCLFAC
- GO TO 180
-*
-* Now balance.
-*
- 190 CONTINUE
- IF( ( C+R ).GE.FACTOR*S )
- $ GO TO 200
- IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
- IF( F*SCALE( I ).LE.SFMIN1 )
- $ GO TO 200
- END IF
- IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
- IF( SCALE( I ).GE.SFMAX1 / F )
- $ GO TO 200
- END IF
- G = ONE / F
- SCALE( I ) = SCALE( I )*F
- NOCONV = .TRUE.
-*
- CALL DSCAL( N-K+1, G, A( I, K ), LDA )
- CALL DSCAL( L, F, A( 1, I ), 1 )
-*
- 200 CONTINUE
-*
- IF( NOCONV )
- $ GO TO 140
-*
- 210 CONTINUE
- ILO = K
- IHI = L
-*
- RETURN
-*
-* End of DGEBAL
-*
- END
diff --git a/netlib/LAPACK/dgebd2.f b/netlib/LAPACK/dgebd2.f
deleted file mode 100644
index 4b4dcc9..0000000
--- a/netlib/LAPACK/dgebd2.f
+++ /dev/null
@@ -1,320 +0,0 @@
-*> \brief \b DGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEBD2 reduces a real general m by n matrix A to upper or lower
-*> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*>
-*> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n general matrix to be reduced.
-*> On exit,
-*> if m >= n, the diagonal and the first superdiagonal are
-*> overwritten with the upper bidiagonal matrix B; the
-*> elements below the diagonal, with the array TAUQ, represent
-*> the orthogonal matrix Q as a product of elementary
-*> reflectors, and the elements above the first superdiagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors;
-*> if m < n, the diagonal and the first subdiagonal are
-*> overwritten with the lower bidiagonal matrix B; the
-*> elements below the first subdiagonal, with the array TAUQ,
-*> represent the orthogonal matrix Q as a product of
-*> elementary reflectors, and the elements above the diagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (min(M,N)-1)
-*> The off-diagonal elements of the bidiagonal matrix B:
-*> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (max(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> If m >= n,
-*>
-*> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n,
-*>
-*> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The contents of A on exit are illustrated by the following examples:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
-*> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
-*> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
-*> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
-*> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
-*> ( v1 v2 v3 v4 v5 )
-*>
-*> where d and e denote diagonal and off-diagonal elements of B, vi
-*> denotes an element of the vector defining H(i), and ui an element of
-*> the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DGEBD2', -INFO )
- RETURN
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* Reduce to upper bidiagonal form
-*
- DO 10 I = 1, N
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAUQ( I ) )
- D( I ) = A( I, I )
- A( I, I ) = ONE
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- IF( I.LT.N )
- $ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = D( I )
-*
- IF( I.LT.N ) THEN
-*
-* Generate elementary reflector G(i) to annihilate
-* A(i,i+2:n)
-*
- CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
- $ LDA, TAUP( I ) )
- E( I ) = A( I, I+1 )
- A( I, I+1 ) = ONE
-*
-* Apply G(i) to A(i+1:m,i+1:n) from the right
-*
- CALL DLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
- $ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
- A( I, I+1 ) = E( I )
- ELSE
- TAUP( I ) = ZERO
- END IF
- 10 CONTINUE
- ELSE
-*
-* Reduce to lower bidiagonal form
-*
- DO 20 I = 1, M
-*
-* Generate elementary reflector G(i) to annihilate A(i,i+1:n)
-*
- CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAUP( I ) )
- D( I ) = A( I, I )
- A( I, I ) = ONE
-*
-* Apply G(i) to A(i+1:m,i:n) from the right
-*
- IF( I.LT.M )
- $ CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
- $ TAUP( I ), A( I+1, I ), LDA, WORK )
- A( I, I ) = D( I )
-*
- IF( I.LT.M ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(i+2:m,i)
-*
- CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
- $ TAUQ( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Apply H(i) to A(i+1:m,i+1:n) from the left
-*
- CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
- $ A( I+1, I+1 ), LDA, WORK )
- A( I+1, I ) = E( I )
- ELSE
- TAUQ( I ) = ZERO
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DGEBD2
-*
- END
diff --git a/netlib/LAPACK/dgebrd.f b/netlib/LAPACK/dgebrd.f
deleted file mode 100644
index 6cb61f0..0000000
--- a/netlib/LAPACK/dgebrd.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b DGEBRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEBRD reduces a general real M-by-N matrix A to upper or lower
-*> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*>
-*> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N general matrix to be reduced.
-*> On exit,
-*> if m >= n, the diagonal and the first superdiagonal are
-*> overwritten with the upper bidiagonal matrix B; the
-*> elements below the diagonal, with the array TAUQ, represent
-*> the orthogonal matrix Q as a product of elementary
-*> reflectors, and the elements above the first superdiagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors;
-*> if m < n, the diagonal and the first subdiagonal are
-*> overwritten with the lower bidiagonal matrix B; the
-*> elements below the first subdiagonal, with the array TAUQ,
-*> represent the orthogonal matrix Q as a product of
-*> elementary reflectors, and the elements above the diagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (min(M,N)-1)
-*> The off-diagonal elements of the bidiagonal matrix B:
-*> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,M,N).
-*> For optimum performance LWORK >= (M+N)*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> If m >= n,
-*>
-*> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n,
-*>
-*> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The contents of A on exit are illustrated by the following examples:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
-*> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
-*> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
-*> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
-*> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
-*> ( v1 v2 v3 v4 v5 )
-*>
-*> where d and e denote diagonal and off-diagonal elements of B, vi
-*> denotes an element of the vector defining H(i), and ui an element of
-*> the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- DOUBLE PRECISION WS
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
- LWKOPT = ( M+N )*NB
- WORK( 1 ) = DBLE( LWKOPT )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DGEBRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- MINMN = MIN( M, N )
- IF( MINMN.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- WS = MAX( M, N )
- LDWRKX = M
- LDWRKY = N
-*
- IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
-*
-* Set the crossover point NX.
-*
- NX = MAX( NB, ILAENV( 3, 'DGEBRD', ' ', M, N, -1, -1 ) )
-*
-* Determine when to switch from blocked to unblocked code.
-*
- IF( NX.LT.MINMN ) THEN
- WS = ( M+N )*NB
- IF( LWORK.LT.WS ) THEN
-*
-* Not enough work space for the optimal NB, consider using
-* a smaller block size.
-*
- NBMIN = ILAENV( 2, 'DGEBRD', ' ', M, N, -1, -1 )
- IF( LWORK.GE.( M+N )*NBMIN ) THEN
- NB = LWORK / ( M+N )
- ELSE
- NB = 1
- NX = MINMN
- END IF
- END IF
- END IF
- ELSE
- NX = MINMN
- END IF
-*
- DO 30 I = 1, MINMN - NX, NB
-*
-* Reduce rows and columns i:i+nb-1 to bidiagonal form and return
-* the matrices X and Y which are needed to update the unreduced
-* part of the matrix
-*
- CALL DLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
- $ TAUQ( I ), TAUP( I ), WORK, LDWRKX,
- $ WORK( LDWRKX*NB+1 ), LDWRKY )
-*
-* Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
-* of the form A := A - V*Y**T - X*U**T
-*
- CALL DGEMM( 'No transpose', 'Transpose', M-I-NB+1, N-I-NB+1,
- $ NB, -ONE, A( I+NB, I ), LDA,
- $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
- $ A( I+NB, I+NB ), LDA )
- CALL DGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1,
- $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
- $ ONE, A( I+NB, I+NB ), LDA )
-*
-* Copy diagonal and off-diagonal elements of B back into A
-*
- IF( M.GE.N ) THEN
- DO 10 J = I, I + NB - 1
- A( J, J ) = D( J )
- A( J, J+1 ) = E( J )
- 10 CONTINUE
- ELSE
- DO 20 J = I, I + NB - 1
- A( J, J ) = D( J )
- A( J+1, J ) = E( J )
- 20 CONTINUE
- END IF
- 30 CONTINUE
-*
-* Use unblocked code to reduce the remainder of the matrix
-*
- CALL DGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
- $ TAUQ( I ), TAUP( I ), WORK, IINFO )
- WORK( 1 ) = WS
- RETURN
-*
-* End of DGEBRD
-*
- END
diff --git a/netlib/LAPACK/dgecon.f b/netlib/LAPACK/dgecon.f
deleted file mode 100644
index df9d8e1..0000000
--- a/netlib/LAPACK/dgecon.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DGECON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGECON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgecon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgecon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgecon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGECON estimates the reciprocal of the condition number of a general
-*> real matrix A, in either the 1-norm or the infinity-norm, using
-*> the LU factorization computed by DGETRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, LDA, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ONENRM
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- DOUBLE PRECISION AINVNM, SCALE, SL, SMLNUM, SU
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATRS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGECON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the norm of inv(A).
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(L).
-*
- CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
- $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
-*
-* Multiply by inv(U).
-*
- CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(U**T).
-*
- CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SU, WORK( 3*N+1 ), INFO )
-*
-* Multiply by inv(L**T).
-*
- CALL DLATRS( 'Lower', 'Transpose', 'Unit', NORMIN, N, A,
- $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Divide X by 1/(SL*SU) if doing so will not cause overflow.
-*
- SCALE = SL*SU
- NORMIN = 'Y'
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of DGECON
-*
- END
diff --git a/netlib/LAPACK/dgeequ.f b/netlib/LAPACK/dgeequ.f
deleted file mode 100644
index a93af8f..0000000
--- a/netlib/LAPACK/dgeequ.f
+++ /dev/null
@@ -1,304 +0,0 @@
-*> \brief \b DGEEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEEQU computes row and column scalings intended to equilibrate an
-*> M-by-N matrix A and reduce its condition number. R returns the row
-*> scale factors and C the column scale factors, chosen to try to make
-*> the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
-*>
-*> R(i) and C(j) are restricted to be between SMLNUM = smallest safe
-*> number and BIGNUM = largest safe number. Use of these scaling
-*> factors is not guaranteed to reduce the condition number of A but
-*> works well in practice.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The M-by-N matrix whose equilibration factors are
-*> to be computed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I))
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = 1, M
- C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
- 80 CONTINUE
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J))
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of DGEEQU
-*
- END
diff --git a/netlib/LAPACK/dgeequb.f b/netlib/LAPACK/dgeequb.f
deleted file mode 100644
index c9dd481..0000000
--- a/netlib/LAPACK/dgeequb.f
+++ /dev/null
@@ -1,321 +0,0 @@
-*> \brief \b DGEEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEEQUB( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEEQUB computes row and column scalings intended to equilibrate an
-*> M-by-N matrix A and reduce its condition number. R returns the row
-*> scale factors and C the column scale factors, chosen to try to make
-*> the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
-*> the radix.
-*>
-*> R(i) and C(j) are restricted to be a power of the radix between
-*> SMLNUM = smallest safe number and BIGNUM = largest safe number. Use
-*> of these scaling factors is not guaranteed to reduce the condition
-*> number of A but works well in practice.
-*>
-*> This routine differs from DGEEQU by restricting the scaling factors
-*> to a power of the radix. Baring over- and underflow, scaling by
-*> these factors introduces no additional rounding errors. However, the
-*> scaled entries' magnitured are no longer approximately 1 but lie
-*> between sqrt(radix) and 1/sqrt(radix).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The M-by-N matrix whose equilibration factors are
-*> to be computed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGEEQUB( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM, RADIX, LOGRDX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, LOG
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEEQUB', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants. Assume SMLNUM is a power of the radix.
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- RADIX = DLAMCH( 'B' )
- LOGRDX = LOG( RADIX )
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
- DO I = 1, M
- IF( R( I ).GT.ZERO ) THEN
- R( I ) = RADIX**INT( LOG( R( I ) ) / LOGRDX )
- END IF
- END DO
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I)).
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = 1, M
- C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
- 80 CONTINUE
- IF( C( J ).GT.ZERO ) THEN
- C( J ) = RADIX**INT( LOG( C( J ) ) / LOGRDX )
- END IF
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J)).
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of DGEEQUB
-*
- END
diff --git a/netlib/LAPACK/dgees.f b/netlib/LAPACK/dgees.f
deleted file mode 100644
index cb5794b..0000000
--- a/netlib/LAPACK/dgees.f
+++ /dev/null
@@ -1,535 +0,0 @@
-*> \brief <b> DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEES + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgees.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgees.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgees.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
-* VS, LDVS, WORK, LWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVS, SORT
-* INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
-* $ WR( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELECT
-* EXTERNAL SELECT
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEES computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues, the real Schur form T, and, optionally, the matrix of
-*> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
-*>
-*> Optionally, it also orders the eigenvalues on the diagonal of the
-*> real Schur form so that selected eigenvalues are at the top left.
-*> The leading columns of Z then form an orthonormal basis for the
-*> invariant subspace corresponding to the selected eigenvalues.
-*>
-*> A matrix is in real Schur form if it is upper quasi-triangular with
-*> 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
-*> form
-*> [ a b ]
-*> [ c a ]
-*>
-*> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVS
-*> \verbatim
-*> JOBVS is CHARACTER*1
-*> = 'N': Schur vectors are not computed;
-*> = 'V': Schur vectors are computed.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELECT).
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is a LOGICAL FUNCTION of two DOUBLE PRECISION arguments
-*> SELECT must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'S', SELECT is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> If SORT = 'N', SELECT is not referenced.
-*> An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
-*> SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
-*> conjugate pair of eigenvalues is selected, then both complex
-*> eigenvalues are selected.
-*> Note that a selected complex eigenvalue may no longer
-*> satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
-*> ordering may change the value of complex eigenvalues
-*> (especially if the eigenvalue is ill-conditioned); in this
-*> case INFO is set to N+2 (see INFO below).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten by its real Schur form T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELECT is true. (Complex conjugate
-*> pairs for which SELECT is true for either
-*> eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues in the same order
-*> that they appear on the diagonal of the output Schur form T.
-*> Complex conjugate pairs of eigenvalues will appear
-*> consecutively with the eigenvalue having the positive
-*> imaginary part first.
-*> \endverbatim
-*>
-*> \param[out] VS
-*> \verbatim
-*> VS is DOUBLE PRECISION array, dimension (LDVS,N)
-*> If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
-*> vectors.
-*> If JOBVS = 'N', VS is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVS
-*> \verbatim
-*> LDVS is INTEGER
-*> The leading dimension of the array VS. LDVS >= 1; if
-*> JOBVS = 'V', LDVS >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N).
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, and i is
-*> <= N: the QR algorithm failed to compute all the
-*> eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
-*> contain those eigenvalues which have converged; if
-*> JOBVS = 'V', VS contains the matrix which reduces A
-*> to its partially converged Schur form.
-*> = N+1: the eigenvalues could not be reordered because some
-*> eigenvalues were too close to separate (the problem
-*> is very ill-conditioned);
-*> = N+2: after reordering, roundoff changed values of some
-*> complex eigenvalues so that leading eigenvalues in
-*> the Schur form no longer satisfy SELECT=.TRUE. This
-*> could also be caused by underflow due to scaling.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
- $ VS, LDVS, WORK, LWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVS, SORT
- INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
- $ WR( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELECT
- EXTERNAL SELECT
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
- $ WANTVS
- INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
- $ IHI, ILO, INXT, IP, ITAU, IWRK, MAXWRK, MINWRK
- DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER IDUM( 1 )
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
- $ DLABAD, DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVS = LSAME( JOBVS, 'V' )
- WANTST = LSAME( SORT, 'S' )
- IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by DHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
- MINWRK = 3*N
-*
- CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
- $ WORK, -1, IEVAL )
- HSWORK = WORK( 1 )
-*
- IF( .NOT.WANTVS ) THEN
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- ELSE
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'DORGHR', ' ', N, 1, N, -1 ) )
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- END IF
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEES ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (Workspace: need N)
-*
- IBAL = 1
- CALL DGEBAL( 'P', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = N + IBAL
- IWRK = N + ITAU
- CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVS ) THEN
-*
-* Copy Householder vectors to VS
-*
- CALL DLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-* Generate orthogonal matrix in VS
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
- END IF
-*
- SDIM = 0
-*
-* Perform QR iteration, accumulating Schur vectors in VS if desired
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
- $ WORK( IWRK ), LWORK-IWRK+1, IEVAL )
- IF( IEVAL.GT.0 )
- $ INFO = IEVAL
-*
-* Sort eigenvalues if desired
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
- IF( SCALEA ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
- END IF
- DO 10 I = 1, N
- BWORK( I ) = SELECT( WR( I ), WI( I ) )
- 10 CONTINUE
-*
-* Reorder eigenvalues and transform Schur vectors
-* (Workspace: none needed)
-*
- CALL DTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
- $ SDIM, S, SEP, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
- $ ICOND )
- IF( ICOND.GT.0 )
- $ INFO = N + ICOND
- END IF
-*
- IF( WANTVS ) THEN
-*
-* Undo balancing
-* (Workspace: need N)
-*
- CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
- $ IERR )
- END IF
-*
- IF( SCALEA ) THEN
-*
-* Undo scaling for the Schur form of A
-*
- CALL DLASCL( 'H', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
- CALL DCOPY( N, A, LDA+1, WR, 1 )
- IF( CSCALE.EQ.SMLNUM ) THEN
-*
-* If scaling back towards underflow, adjust WI if an
-* offdiagonal element of a 2-by-2 block in the Schur form
-* underflows.
-*
- IF( IEVAL.GT.0 ) THEN
- I1 = IEVAL + 1
- I2 = IHI - 1
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI,
- $ MAX( ILO-1, 1 ), IERR )
- ELSE IF( WANTST ) THEN
- I1 = 1
- I2 = N - 1
- ELSE
- I1 = ILO
- I2 = IHI - 1
- END IF
- INXT = I1 - 1
- DO 20 I = I1, I2
- IF( I.LT.INXT )
- $ GO TO 20
- IF( WI( I ).EQ.ZERO ) THEN
- INXT = I + 1
- ELSE
- IF( A( I+1, I ).EQ.ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- ELSE IF( A( I+1, I ).NE.ZERO .AND. A( I, I+1 ).EQ.
- $ ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- IF( I.GT.1 )
- $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
- IF( N.GT.I+1 )
- $ CALL DSWAP( N-I-1, A( I, I+2 ), LDA,
- $ A( I+1, I+2 ), LDA )
- IF( WANTVS ) THEN
- CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
- END IF
- A( I, I+1 ) = A( I+1, I )
- A( I+1, I ) = ZERO
- END IF
- INXT = I + 2
- END IF
- 20 CONTINUE
- END IF
-*
-* Undo scaling for the imaginary part of the eigenvalues
-*
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
- $ WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
- END IF
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
-*
-* Check if reordering successful
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 30 I = 1, N
- CURSL = SELECT( WR( I ), WI( I ) )
- IF( WI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 30 CONTINUE
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGEES
-*
- END
diff --git a/netlib/LAPACK/dgeesx.f b/netlib/LAPACK/dgeesx.f
deleted file mode 100644
index 2a3e963..0000000
--- a/netlib/LAPACK/dgeesx.f
+++ /dev/null
@@ -1,649 +0,0 @@
-*> \brief <b> DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEESX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeesx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeesx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeesx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
-* WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
-* IWORK, LIWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVS, SENSE, SORT
-* INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
-* DOUBLE PRECISION RCONDE, RCONDV
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
-* $ WR( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELECT
-* EXTERNAL SELECT
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEESX computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues, the real Schur form T, and, optionally, the matrix of
-*> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
-*>
-*> Optionally, it also orders the eigenvalues on the diagonal of the
-*> real Schur form so that selected eigenvalues are at the top left;
-*> computes a reciprocal condition number for the average of the
-*> selected eigenvalues (RCONDE); and computes a reciprocal condition
-*> number for the right invariant subspace corresponding to the
-*> selected eigenvalues (RCONDV). The leading columns of Z form an
-*> orthonormal basis for this invariant subspace.
-*>
-*> For further explanation of the reciprocal condition numbers RCONDE
-*> and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
-*> these quantities are called s and sep respectively).
-*>
-*> A real matrix is in real Schur form if it is upper quasi-triangular
-*> with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
-*> the form
-*> [ a b ]
-*> [ c a ]
-*>
-*> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVS
-*> \verbatim
-*> JOBVS is CHARACTER*1
-*> = 'N': Schur vectors are not computed;
-*> = 'V': Schur vectors are computed.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELECT).
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments
-*> SELECT must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'S', SELECT is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> If SORT = 'N', SELECT is not referenced.
-*> An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
-*> SELECT(WR(j),WI(j)) is true; i.e., if either one of a
-*> complex conjugate pair of eigenvalues is selected, then both
-*> are. Note that a selected complex eigenvalue may no longer
-*> satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
-*> ordering may change the value of complex eigenvalues
-*> (especially if the eigenvalue is ill-conditioned); in this
-*> case INFO may be set to N+3 (see INFO below).
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N': None are computed;
-*> = 'E': Computed for average of selected eigenvalues only;
-*> = 'V': Computed for selected right invariant subspace only;
-*> = 'B': Computed for both.
-*> If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A is overwritten by its real Schur form T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELECT is true. (Complex conjugate
-*> pairs for which SELECT is true for either
-*> eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> WR and WI contain the real and imaginary parts, respectively,
-*> of the computed eigenvalues, in the same order that they
-*> appear on the diagonal of the output Schur form T. Complex
-*> conjugate pairs of eigenvalues appear consecutively with the
-*> eigenvalue having the positive imaginary part first.
-*> \endverbatim
-*>
-*> \param[out] VS
-*> \verbatim
-*> VS is DOUBLE PRECISION array, dimension (LDVS,N)
-*> If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
-*> vectors.
-*> If JOBVS = 'N', VS is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVS
-*> \verbatim
-*> LDVS is INTEGER
-*> The leading dimension of the array VS. LDVS >= 1, and if
-*> JOBVS = 'V', LDVS >= N.
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is DOUBLE PRECISION
-*> If SENSE = 'E' or 'B', RCONDE contains the reciprocal
-*> condition number for the average of the selected eigenvalues.
-*> Not referenced if SENSE = 'N' or 'V'.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is DOUBLE PRECISION
-*> If SENSE = 'V' or 'B', RCONDV contains the reciprocal
-*> condition number for the selected right invariant subspace.
-*> Not referenced if SENSE = 'N' or 'E'.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N).
-*> Also, if SENSE = 'E' or 'V' or 'B',
-*> LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
-*> selected eigenvalues computed by this routine. Note that
-*> N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
-*> returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
-*> 'B' this may not be large enough.
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates upper bounds on the optimal sizes of the
-*> arrays WORK and IWORK, returns these values as the first
-*> entries of the WORK and IWORK arrays, and no error messages
-*> related to LWORK or LIWORK are issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
-*> Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
-*> only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
-*> may not be large enough.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates upper bounds on the optimal sizes of
-*> the arrays WORK and IWORK, returns these values as the first
-*> entries of the WORK and IWORK arrays, and no error messages
-*> related to LWORK or LIWORK are issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, and i is
-*> <= N: the QR algorithm failed to compute all the
-*> eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
-*> contain those eigenvalues which have converged; if
-*> JOBVS = 'V', VS contains the transformation which
-*> reduces A to its partially converged Schur form.
-*> = N+1: the eigenvalues could not be reordered because some
-*> eigenvalues were too close to separate (the problem
-*> is very ill-conditioned);
-*> = N+2: after reordering, roundoff changed values of some
-*> complex eigenvalues so that leading eigenvalues in
-*> the Schur form no longer satisfy SELECT=.TRUE. This
-*> could also be caused by underflow due to scaling.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
- $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
- $ IWORK, LIWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVS, SENSE, SORT
- INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
- DOUBLE PRECISION RCONDE, RCONDV
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
- $ WR( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELECT
- EXTERNAL SELECT
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
- $ WANTSE, WANTSN, WANTST, WANTSV, WANTVS
- INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
- $ IHI, ILO, INXT, IP, ITAU, IWRK, LIWRK, LWRK,
- $ MAXWRK, MINWRK
- DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
- $ DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- WANTVS = LSAME( JOBVS, 'V' )
- WANTST = LSAME( SORT, 'S' )
- WANTSN = LSAME( SENSE, 'N' )
- WANTSE = LSAME( SENSE, 'E' )
- WANTSV = LSAME( SENSE, 'V' )
- WANTSB = LSAME( SENSE, 'B' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
- $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
- INFO = -12
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "RWorkspace:" describe the
-* minimal amount of real workspace needed at that point in the
-* code, as well as the preferred amount for good performance.
-* IWorkspace refers to integer workspace.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by DHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.
-* If SENSE = 'E', 'V' or 'B', then the amount of workspace needed
-* depends on SDIM, which is computed by the routine DTRSEN later
-* in the code.)
-*
- IF( INFO.EQ.0 ) THEN
- LIWRK = 1
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- LWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
- MINWRK = 3*N
-*
- CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
- $ WORK, -1, IEVAL )
- HSWORK = WORK( 1 )
-*
- IF( .NOT.WANTVS ) THEN
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- ELSE
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'DORGHR', ' ', N, 1, N, -1 ) )
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- END IF
- LWRK = MAXWRK
- IF( .NOT.WANTSN )
- $ LWRK = MAX( LWRK, N + ( N*N )/2 )
- IF( WANTSV .OR. WANTSB )
- $ LIWRK = ( N*N )/4
- END IF
- IWORK( 1 ) = LIWRK
- WORK( 1 ) = LWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -16
- ELSE IF( LIWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -18
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEESX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (RWorkspace: need N)
-*
- IBAL = 1
- CALL DGEBAL( 'P', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (RWorkspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = N + IBAL
- IWRK = N + ITAU
- CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVS ) THEN
-*
-* Copy Householder vectors to VS
-*
- CALL DLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-* Generate orthogonal matrix in VS
-* (RWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
- END IF
-*
- SDIM = 0
-*
-* Perform QR iteration, accumulating Schur vectors in VS if desired
-* (RWorkspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
- $ WORK( IWRK ), LWORK-IWRK+1, IEVAL )
- IF( IEVAL.GT.0 )
- $ INFO = IEVAL
-*
-* Sort eigenvalues if desired
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
- IF( SCALEA ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
- END IF
- DO 10 I = 1, N
- BWORK( I ) = SELECT( WR( I ), WI( I ) )
- 10 CONTINUE
-*
-* Reorder eigenvalues, transform Schur vectors, and compute
-* reciprocal condition numbers
-* (RWorkspace: if SENSE is not 'N', need N+2*SDIM*(N-SDIM)
-* otherwise, need N )
-* (IWorkspace: if SENSE is 'V' or 'B', need SDIM*(N-SDIM)
-* otherwise, need 0 )
-*
- CALL DTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
- $ SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1,
- $ IWORK, LIWORK, ICOND )
- IF( .NOT.WANTSN )
- $ MAXWRK = MAX( MAXWRK, N+2*SDIM*( N-SDIM ) )
- IF( ICOND.EQ.-15 ) THEN
-*
-* Not enough real workspace
-*
- INFO = -16
- ELSE IF( ICOND.EQ.-17 ) THEN
-*
-* Not enough integer workspace
-*
- INFO = -18
- ELSE IF( ICOND.GT.0 ) THEN
-*
-* DTRSEN failed to reorder or to restore standard Schur form
-*
- INFO = ICOND + N
- END IF
- END IF
-*
- IF( WANTVS ) THEN
-*
-* Undo balancing
-* (RWorkspace: need N)
-*
- CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
- $ IERR )
- END IF
-*
- IF( SCALEA ) THEN
-*
-* Undo scaling for the Schur form of A
-*
- CALL DLASCL( 'H', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
- CALL DCOPY( N, A, LDA+1, WR, 1 )
- IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN
- DUM( 1 ) = RCONDV
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
- RCONDV = DUM( 1 )
- END IF
- IF( CSCALE.EQ.SMLNUM ) THEN
-*
-* If scaling back towards underflow, adjust WI if an
-* offdiagonal element of a 2-by-2 block in the Schur form
-* underflows.
-*
- IF( IEVAL.GT.0 ) THEN
- I1 = IEVAL + 1
- I2 = IHI - 1
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- ELSE IF( WANTST ) THEN
- I1 = 1
- I2 = N - 1
- ELSE
- I1 = ILO
- I2 = IHI - 1
- END IF
- INXT = I1 - 1
- DO 20 I = I1, I2
- IF( I.LT.INXT )
- $ GO TO 20
- IF( WI( I ).EQ.ZERO ) THEN
- INXT = I + 1
- ELSE
- IF( A( I+1, I ).EQ.ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- ELSE IF( A( I+1, I ).NE.ZERO .AND. A( I, I+1 ).EQ.
- $ ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- IF( I.GT.1 )
- $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
- IF( N.GT.I+1 )
- $ CALL DSWAP( N-I-1, A( I, I+2 ), LDA,
- $ A( I+1, I+2 ), LDA )
- CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
- A( I, I+1 ) = A( I+1, I )
- A( I+1, I ) = ZERO
- END IF
- INXT = I + 2
- END IF
- 20 CONTINUE
- END IF
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
- $ WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
- END IF
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
-*
-* Check if reordering successful
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 30 I = 1, N
- CURSL = SELECT( WR( I ), WI( I ) )
- IF( WI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 30 CONTINUE
- END IF
-*
- WORK( 1 ) = MAXWRK
- IF( WANTSV .OR. WANTSB ) THEN
- IWORK( 1 ) = MAX( 1, SDIM*( N-SDIM ) )
- ELSE
- IWORK( 1 ) = 1
- END IF
-*
- RETURN
-*
-* End of DGEESX
-*
- END
diff --git a/netlib/LAPACK/dgeev.f b/netlib/LAPACK/dgeev.f
deleted file mode 100644
index dd60db6..0000000
--- a/netlib/LAPACK/dgeev.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief <b> DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
-* LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEEV computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues and, optionally, the left and/or right eigenvectors.
-*>
-*> The right eigenvector v(j) of A satisfies
-*> A * v(j) = lambda(j) * v(j)
-*> where lambda(j) is its eigenvalue.
-*> The left eigenvector u(j) of A satisfies
-*> u(j)**H * A = lambda(j) * u(j)**H
-*> where u(j)**H denotes the conjugate-transpose of u(j).
-*>
-*> The computed eigenvectors are normalized to have Euclidean norm
-*> equal to 1 and largest component real.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': left eigenvectors of A are not computed;
-*> = 'V': left eigenvectors of A are computed.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': right eigenvectors of A are not computed;
-*> = 'V': right eigenvectors of A are computed.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues. Complex
-*> conjugate pairs of eigenvalues appear consecutively
-*> with the eigenvalue having the positive imaginary part
-*> first.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order
-*> as their eigenvalues.
-*> If JOBVL = 'N', VL is not referenced.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j),
-*> the j-th column of VL.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1; if
-*> JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order
-*> as their eigenvalues.
-*> If JOBVR = 'N', VR is not referenced.
-*> If the j-th eigenvalue is real, then v(j) = VR(:,j),
-*> the j-th column of VR.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
-*> v(j+1) = VR(:,j) - i*VR(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1; if
-*> JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N), and
-*> if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
-*> performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the QR algorithm failed to compute all the
-*> eigenvalues, and no eigenvectors have been computed;
-*> elements i+1:N of WR and WI contain eigenvalues which
-*> have converged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
- $ LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
- CHARACTER SIDE
- INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
- $ MAXWRK, MINWRK, NOUT
- DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
- $ SN
-* ..
-* .. Local Arrays ..
- LOGICAL SELECT( 1 )
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
- $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX, ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2
- EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, DLAPY2,
- $ DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVL = LSAME( JOBVL, 'V' )
- WANTVR = LSAME( JOBVR, 'V' )
- IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
- INFO = -9
- ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by DHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
- IF( WANTVL ) THEN
- MINWRK = 4*N
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'DORGHR', ' ', N, 1, N, -1 ) )
- CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- MAXWRK = MAX( MAXWRK, 4*N )
- ELSE IF( WANTVR ) THEN
- MINWRK = 4*N
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'DORGHR', ' ', N, 1, N, -1 ) )
- CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- MAXWRK = MAX( MAXWRK, 4*N )
- ELSE
- MINWRK = 3*N
- CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Balance the matrix
-* (Workspace: need N)
-*
- IBAL = 1
- CALL DGEBAL( 'B', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = IBAL + N
- IWRK = ITAU + N
- CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVL ) THEN
-*
-* Want left eigenvectors
-* Copy Householder vectors to VL
-*
- SIDE = 'L'
- CALL DLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-* Generate orthogonal matrix in VL
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VL
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- IF( WANTVR ) THEN
-*
-* Want left and right eigenvectors
-* Copy Schur vectors to VR
-*
- SIDE = 'B'
- CALL DLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
- END IF
-*
- ELSE IF( WANTVR ) THEN
-*
-* Want right eigenvectors
-* Copy Householder vectors to VR
-*
- SIDE = 'R'
- CALL DLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-* Generate orthogonal matrix in VR
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VR
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- ELSE
-*
-* Compute eigenvalues only
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
- END IF
-*
-* If INFO > 0 from DHSEQR, then quit
-*
- IF( INFO.GT.0 )
- $ GO TO 50
-*
- IF( WANTVL .OR. WANTVR ) THEN
-*
-* Compute left and/or right eigenvectors
-* (Workspace: need 4*N)
-*
- CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ N, NOUT, WORK( IWRK ), IERR )
- END IF
-*
- IF( WANTVL ) THEN
-*
-* Undo balancing of left eigenvectors
-* (Workspace: need N)
-*
- CALL DGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL,
- $ IERR )
-*
-* Normalize left eigenvectors and make largest component real
-*
- DO 20 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / DNRM2( N, VL( 1, I ), 1 )
- CALL DSCAL( N, SCL, VL( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / DLAPY2( DNRM2( N, VL( 1, I ), 1 ),
- $ DNRM2( N, VL( 1, I+1 ), 1 ) )
- CALL DSCAL( N, SCL, VL( 1, I ), 1 )
- CALL DSCAL( N, SCL, VL( 1, I+1 ), 1 )
- DO 10 K = 1, N
- WORK( IWRK+K-1 ) = VL( K, I )**2 + VL( K, I+1 )**2
- 10 CONTINUE
- K = IDAMAX( N, WORK( IWRK ), 1 )
- CALL DLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R )
- CALL DROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN )
- VL( K, I+1 ) = ZERO
- END IF
- 20 CONTINUE
- END IF
-*
- IF( WANTVR ) THEN
-*
-* Undo balancing of right eigenvectors
-* (Workspace: need N)
-*
- CALL DGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR,
- $ IERR )
-*
-* Normalize right eigenvectors and make largest component real
-*
- DO 40 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / DNRM2( N, VR( 1, I ), 1 )
- CALL DSCAL( N, SCL, VR( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / DLAPY2( DNRM2( N, VR( 1, I ), 1 ),
- $ DNRM2( N, VR( 1, I+1 ), 1 ) )
- CALL DSCAL( N, SCL, VR( 1, I ), 1 )
- CALL DSCAL( N, SCL, VR( 1, I+1 ), 1 )
- DO 30 K = 1, N
- WORK( IWRK+K-1 ) = VR( K, I )**2 + VR( K, I+1 )**2
- 30 CONTINUE
- K = IDAMAX( N, WORK( IWRK ), 1 )
- CALL DLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R )
- CALL DROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN )
- VR( K, I+1 ) = ZERO
- END IF
- 40 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 50 CONTINUE
- IF( SCALEA ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- IF( INFO.GT.0 ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- END IF
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGEEV
-*
- END
diff --git a/netlib/LAPACK/dgeevx.f b/netlib/LAPACK/dgeevx.f
deleted file mode 100644
index 81f30f9..0000000
--- a/netlib/LAPACK/dgeevx.f
+++ /dev/null
@@ -1,681 +0,0 @@
-*> \brief <b> DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
-* VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
-* RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER BALANC, JOBVL, JOBVR, SENSE
-* INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
-* DOUBLE PRECISION ABNRM
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), RCONDE( * ), RCONDV( * ),
-* $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEEVX computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues and, optionally, the left and/or right eigenvectors.
-*>
-*> Optionally also, it computes a balancing transformation to improve
-*> the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
-*> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
-*> (RCONDE), and reciprocal condition numbers for the right
-*> eigenvectors (RCONDV).
-*>
-*> The right eigenvector v(j) of A satisfies
-*> A * v(j) = lambda(j) * v(j)
-*> where lambda(j) is its eigenvalue.
-*> The left eigenvector u(j) of A satisfies
-*> u(j)**H * A = lambda(j) * u(j)**H
-*> where u(j)**H denotes the conjugate-transpose of u(j).
-*>
-*> The computed eigenvectors are normalized to have Euclidean norm
-*> equal to 1 and largest component real.
-*>
-*> Balancing a matrix means permuting the rows and columns to make it
-*> more nearly upper triangular, and applying a diagonal similarity
-*> transformation D * A * D**(-1), where D is a diagonal matrix, to
-*> make its rows and columns closer in norm and the condition numbers
-*> of its eigenvalues and eigenvectors smaller. The computed
-*> reciprocal condition numbers correspond to the balanced matrix.
-*> Permuting rows and columns will not change the condition numbers
-*> (in exact arithmetic) but diagonal scaling will. For further
-*> explanation of balancing, see section 4.10.2 of the LAPACK
-*> Users' Guide.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] BALANC
-*> \verbatim
-*> BALANC is CHARACTER*1
-*> Indicates how the input matrix should be diagonally scaled
-*> and/or permuted to improve the conditioning of its
-*> eigenvalues.
-*> = 'N': Do not diagonally scale or permute;
-*> = 'P': Perform permutations to make the matrix more nearly
-*> upper triangular. Do not diagonally scale;
-*> = 'S': Diagonally scale the matrix, i.e. replace A by
-*> D*A*D**(-1), where D is a diagonal matrix chosen
-*> to make the rows and columns of A more equal in
-*> norm. Do not permute;
-*> = 'B': Both diagonally scale and permute A.
-*>
-*> Computed reciprocal condition numbers will be for the matrix
-*> after balancing and/or permuting. Permuting does not change
-*> condition numbers (in exact arithmetic), but balancing does.
-*> \endverbatim
-*>
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': left eigenvectors of A are not computed;
-*> = 'V': left eigenvectors of A are computed.
-*> If SENSE = 'E' or 'B', JOBVL must = 'V'.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': right eigenvectors of A are not computed;
-*> = 'V': right eigenvectors of A are computed.
-*> If SENSE = 'E' or 'B', JOBVR must = 'V'.
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N': None are computed;
-*> = 'E': Computed for eigenvalues only;
-*> = 'V': Computed for right eigenvectors only;
-*> = 'B': Computed for eigenvalues and right eigenvectors.
-*>
-*> If SENSE = 'E' or 'B', both left and right eigenvectors
-*> must also be computed (JOBVL = 'V' and JOBVR = 'V').
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten. If JOBVL = 'V' or
-*> JOBVR = 'V', A contains the real Schur form of the balanced
-*> version of the input matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues. Complex
-*> conjugate pairs of eigenvalues will appear consecutively
-*> with the eigenvalue having the positive imaginary part
-*> first.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order
-*> as their eigenvalues.
-*> If JOBVL = 'N', VL is not referenced.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j),
-*> the j-th column of VL.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1; if
-*> JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order
-*> as their eigenvalues.
-*> If JOBVR = 'N', VR is not referenced.
-*> If the j-th eigenvalue is real, then v(j) = VR(:,j),
-*> the j-th column of VR.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
-*> v(j+1) = VR(:,j) - i*VR(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are integer values determined when A was
-*> balanced. The balanced A(i,j) = 0 if I > J and
-*> J = 1,...,ILO-1 or I = IHI+1,...,N.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> when balancing A. If P(j) is the index of the row and column
-*> interchanged with row and column j, and D(j) is the scaling
-*> factor applied to row and column j, then
-*> SCALE(J) = P(J), for J = 1,...,ILO-1
-*> = D(J), for J = ILO,...,IHI
-*> = P(J) for J = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] ABNRM
-*> \verbatim
-*> ABNRM is DOUBLE PRECISION
-*> The one-norm of the balanced matrix (the maximum
-*> of the sum of absolute values of elements of any column).
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is DOUBLE PRECISION array, dimension (N)
-*> RCONDE(j) is the reciprocal condition number of the j-th
-*> eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is DOUBLE PRECISION array, dimension (N)
-*> RCONDV(j) is the reciprocal condition number of the j-th
-*> right eigenvector.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. If SENSE = 'N' or 'E',
-*> LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
-*> LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*N-2)
-*> If SENSE = 'N' or 'E', not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the QR algorithm failed to compute all the
-*> eigenvalues, and no eigenvectors or condition numbers
-*> have been computed; elements 1:ILO-1 and i+1:N of WR
-*> and WI contain eigenvalues which have converged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
- $ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
- $ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER BALANC, JOBVL, JOBVR, SENSE
- INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
- DOUBLE PRECISION ABNRM
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), RCONDE( * ), RCONDV( * ),
- $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
- $ WNTSNN, WNTSNV
- CHARACTER JOB, SIDE
- INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK,
- $ MINWRK, NOUT
- DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
- $ SN
-* ..
-* .. Local Arrays ..
- LOGICAL SELECT( 1 )
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
- $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
- $ DTRSNA, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX, ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2
- EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, DLAPY2,
- $ DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVL = LSAME( JOBVL, 'V' )
- WANTVR = LSAME( JOBVR, 'V' )
- WNTSNN = LSAME( SENSE, 'N' )
- WNTSNE = LSAME( SENSE, 'E' )
- WNTSNV = LSAME( SENSE, 'V' )
- WNTSNB = LSAME( SENSE, 'B' )
- IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
- $ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
- $ THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR.
- $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND.
- $ WANTVR ) ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
- INFO = -11
- ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
- INFO = -13
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by DHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
-*
- IF( WANTVL ) THEN
- CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
- $ WORK, -1, INFO )
- ELSE IF( WANTVR ) THEN
- CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- ELSE
- IF( WNTSNN ) THEN
- CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR,
- $ LDVR, WORK, -1, INFO )
- ELSE
- CALL DHSEQR( 'S', 'N', N, 1, N, A, LDA, WR, WI, VR,
- $ LDVR, WORK, -1, INFO )
- END IF
- END IF
- HSWORK = WORK( 1 )
-*
- IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
- MINWRK = 2*N
- IF( .NOT.WNTSNN )
- $ MINWRK = MAX( MINWRK, N*N+6*N )
- MAXWRK = MAX( MAXWRK, HSWORK )
- IF( .NOT.WNTSNN )
- $ MAXWRK = MAX( MAXWRK, N*N + 6*N )
- ELSE
- MINWRK = 3*N
- IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) )
- $ MINWRK = MAX( MINWRK, N*N + 6*N )
- MAXWRK = MAX( MAXWRK, HSWORK )
- MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'DORGHR',
- $ ' ', N, 1, N, -1 ) )
- IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) )
- $ MAXWRK = MAX( MAXWRK, N*N + 6*N )
- MAXWRK = MAX( MAXWRK, 3*N )
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -21
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEEVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ICOND = 0
- ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Balance the matrix and compute ABNRM
-*
- CALL DGEBAL( BALANC, N, A, LDA, ILO, IHI, SCALE, IERR )
- ABNRM = DLANGE( '1', N, N, A, LDA, DUM )
- IF( SCALEA ) THEN
- DUM( 1 ) = ABNRM
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
- ABNRM = DUM( 1 )
- END IF
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- ITAU = 1
- IWRK = ITAU + N
- CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVL ) THEN
-*
-* Want left eigenvectors
-* Copy Householder vectors to VL
-*
- SIDE = 'L'
- CALL DLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-* Generate orthogonal matrix in VL
-* (Workspace: need 2*N-1, prefer N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VL
-* (Workspace: need 1, prefer HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- IF( WANTVR ) THEN
-*
-* Want left and right eigenvectors
-* Copy Schur vectors to VR
-*
- SIDE = 'B'
- CALL DLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
- END IF
-*
- ELSE IF( WANTVR ) THEN
-*
-* Want right eigenvectors
-* Copy Householder vectors to VR
-*
- SIDE = 'R'
- CALL DLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-* Generate orthogonal matrix in VR
-* (Workspace: need 2*N-1, prefer N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VR
-* (Workspace: need 1, prefer HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- ELSE
-*
-* Compute eigenvalues only
-* If condition numbers desired, compute Schur form
-*
- IF( WNTSNN ) THEN
- JOB = 'E'
- ELSE
- JOB = 'S'
- END IF
-*
-* (Workspace: need 1, prefer HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
- END IF
-*
-* If INFO > 0 from DHSEQR, then quit
-*
- IF( INFO.GT.0 )
- $ GO TO 50
-*
- IF( WANTVL .OR. WANTVR ) THEN
-*
-* Compute left and/or right eigenvectors
-* (Workspace: need 3*N)
-*
- CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ N, NOUT, WORK( IWRK ), IERR )
- END IF
-*
-* Compute condition numbers if desired
-* (Workspace: need N*N+6*N unless SENSE = 'E')
-*
- IF( .NOT.WNTSNN ) THEN
- CALL DTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, IWORK,
- $ ICOND )
- END IF
-*
- IF( WANTVL ) THEN
-*
-* Undo balancing of left eigenvectors
-*
- CALL DGEBAK( BALANC, 'L', N, ILO, IHI, SCALE, N, VL, LDVL,
- $ IERR )
-*
-* Normalize left eigenvectors and make largest component real
-*
- DO 20 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / DNRM2( N, VL( 1, I ), 1 )
- CALL DSCAL( N, SCL, VL( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / DLAPY2( DNRM2( N, VL( 1, I ), 1 ),
- $ DNRM2( N, VL( 1, I+1 ), 1 ) )
- CALL DSCAL( N, SCL, VL( 1, I ), 1 )
- CALL DSCAL( N, SCL, VL( 1, I+1 ), 1 )
- DO 10 K = 1, N
- WORK( K ) = VL( K, I )**2 + VL( K, I+1 )**2
- 10 CONTINUE
- K = IDAMAX( N, WORK, 1 )
- CALL DLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R )
- CALL DROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN )
- VL( K, I+1 ) = ZERO
- END IF
- 20 CONTINUE
- END IF
-*
- IF( WANTVR ) THEN
-*
-* Undo balancing of right eigenvectors
-*
- CALL DGEBAK( BALANC, 'R', N, ILO, IHI, SCALE, N, VR, LDVR,
- $ IERR )
-*
-* Normalize right eigenvectors and make largest component real
-*
- DO 40 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / DNRM2( N, VR( 1, I ), 1 )
- CALL DSCAL( N, SCL, VR( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / DLAPY2( DNRM2( N, VR( 1, I ), 1 ),
- $ DNRM2( N, VR( 1, I+1 ), 1 ) )
- CALL DSCAL( N, SCL, VR( 1, I ), 1 )
- CALL DSCAL( N, SCL, VR( 1, I+1 ), 1 )
- DO 30 K = 1, N
- WORK( K ) = VR( K, I )**2 + VR( K, I+1 )**2
- 30 CONTINUE
- K = IDAMAX( N, WORK, 1 )
- CALL DLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R )
- CALL DROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN )
- VR( K, I+1 ) = ZERO
- END IF
- 40 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 50 CONTINUE
- IF( SCALEA ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- IF( INFO.EQ.0 ) THEN
- IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 )
- $ CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N,
- $ IERR )
- ELSE
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- END IF
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGEEVX
-*
- END
diff --git a/netlib/LAPACK/dgegs.f b/netlib/LAPACK/dgegs.f
deleted file mode 100644
index 95faf08..0000000
--- a/netlib/LAPACK/dgegs.f
+++ /dev/null
@@ -1,541 +0,0 @@
-*> \brief <b> DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgegs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgegs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR,
-* ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVSL, JOBVSR
-* INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
-* $ VSR( LDVSR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine DGGES.
-*>
-*> DGEGS computes the eigenvalues, real Schur form, and, optionally,
-*> left and or/right Schur vectors of a real matrix pair (A,B).
-*> Given two square matrices A and B, the generalized real Schur
-*> factorization has the form
-*>
-*> A = Q*S*Z**T, B = Q*T*Z**T
-*>
-*> where Q and Z are orthogonal matrices, T is upper triangular, and S
-*> is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
-*> blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
-*> of eigenvalues of (A,B). The columns of Q are the left Schur vectors
-*> and the columns of Z are the right Schur vectors.
-*>
-*> If only the eigenvalues of (A,B) are needed, the driver routine
-*> DGEGV should be used instead. See DGEGV for a description of the
-*> eigenvalues of the generalized nonsymmetric eigenvalue problem
-*> (GNEP).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVSL
-*> \verbatim
-*> JOBVSL is CHARACTER*1
-*> = 'N': do not compute the left Schur vectors;
-*> = 'V': compute the left Schur vectors (returned in VSL).
-*> \endverbatim
-*>
-*> \param[in] JOBVSR
-*> \verbatim
-*> JOBVSR is CHARACTER*1
-*> = 'N': do not compute the right Schur vectors;
-*> = 'V': compute the right Schur vectors (returned in VSR).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VSL, and VSR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the matrix A.
-*> On exit, the upper quasi-triangular matrix S from the
-*> generalized real Schur factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the matrix B.
-*> On exit, the upper triangular matrix T from the generalized
-*> real Schur factorization.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> The real parts of each scalar alpha defining an eigenvalue
-*> of GNEP.
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> The imaginary parts of each scalar alpha defining an
-*> eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
-*> eigenvalue is real; if positive, then the j-th and (j+1)-st
-*> eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) = -ALPHAI(j).
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> The scalars beta that define the eigenvalues of GNEP.
-*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*> beta = BETA(j) represent the j-th eigenvalue of the matrix
-*> pair (A,B), in one of the forms lambda = alpha/beta or
-*> mu = beta/alpha. Since either lambda or mu may overflow,
-*> they should not, in general, be computed.
-*> \endverbatim
-*>
-*> \param[out] VSL
-*> \verbatim
-*> VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
-*> If JOBVSL = 'V', the matrix of left Schur vectors Q.
-*> Not referenced if JOBVSL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSL
-*> \verbatim
-*> LDVSL is INTEGER
-*> The leading dimension of the matrix VSL. LDVSL >=1, and
-*> if JOBVSL = 'V', LDVSL >= N.
-*> \endverbatim
-*>
-*> \param[out] VSR
-*> \verbatim
-*> VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
-*> If JOBVSR = 'V', the matrix of right Schur vectors Z.
-*> Not referenced if JOBVSR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSR
-*> \verbatim
-*> LDVSR is INTEGER
-*> The leading dimension of the matrix VSR. LDVSR >= 1, and
-*> if JOBVSR = 'V', LDVSR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,4*N).
-*> For good performance, LWORK must generally be larger.
-*> To compute the optimal value of LWORK, call ILAENV to get
-*> blocksizes (for DGEQRF, DORMQR, and DORGQR.) Then compute:
-*> NB -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR
-*> The optimal LWORK is 2*N + N*(NB+1).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. (A,B) are not in Schur
-*> form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*> be correct for j=INFO+1,...,N.
-*> > N: errors that usually indicate LAPACK problems:
-*> =N+1: error return from DGGBAL
-*> =N+2: error return from DGEQRF
-*> =N+3: error return from DORMQR
-*> =N+4: error return from DORGQR
-*> =N+5: error return from DGGHRD
-*> =N+6: error return from DHGEQZ (other than failed
-*> iteration)
-*> =N+7: error return from DGGBAK (computing VSL)
-*> =N+8: error return from DGGBAK (computing VSR)
-*> =N+9: error return from DLASCL (various places)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR,
- $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVSL, JOBVSR
- INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
- $ VSR( LDVSR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILVSL, ILVSR, LQUERY
- INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT, ILO,
- $ IRIGHT, IROWS, ITAU, IWORK, LOPT, LWKMIN,
- $ LWKOPT, NB, NB1, NB2, NB3
- DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
- $ SAFMIN, SMLNUM
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
- $ DLASCL, DLASET, DORGQR, DORMQR, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVSL, 'N' ) ) THEN
- IJOBVL = 1
- ILVSL = .FALSE.
- ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
- IJOBVL = 2
- ILVSL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVSL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVSR, 'N' ) ) THEN
- IJOBVR = 1
- ILVSR = .FALSE.
- ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
- IJOBVR = 2
- ILVSR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVSR = .FALSE.
- END IF
-*
-* Test the input arguments
-*
- LWKMIN = MAX( 4*N, 1 )
- LWKOPT = LWKMIN
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- INFO = 0
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
- INFO = -12
- ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -16
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB1 = ILAENV( 1, 'DGEQRF', ' ', N, N, -1, -1 )
- NB2 = ILAENV( 1, 'DORMQR', ' ', N, N, N, -1 )
- NB3 = ILAENV( 1, 'DORGQR', ' ', N, N, N, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LOPT = 2*N + N*( NB+1 )
- WORK( 1 ) = LOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEGS ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
- SAFMIN = DLAMCH( 'S' )
- SMLNUM = N*SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
-*
- IF( ILBSCL ) THEN
- CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
-* Permute the matrix to make it more nearly triangular
-* Workspace layout: (2*N words -- "work..." not actually used)
-* left_permutation, right_permutation, work...
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWORK = IRIGHT + N
- CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWORK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 1
- GO TO 10
- END IF
-*
-* Reduce B to triangular form, and initialize VSL and/or VSR
-* Workspace layout: ("work..." must have at least N words)
-* left_permutation, right_permutation, tau, work...
-*
- IROWS = IHI + 1 - ILO
- ICOLS = N + 1 - ILO
- ITAU = IWORK
- IWORK = ITAU + IROWS
- CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 2
- GO TO 10
- END IF
-*
- CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWORK ),
- $ LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 3
- GO TO 10
- END IF
-*
- IF( ILVSL ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
- CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VSL( ILO+1, ILO ), LDVSL )
- CALL DORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
- $ WORK( ITAU ), WORK( IWORK ), LWORK+1-IWORK,
- $ IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 4
- GO TO 10
- END IF
- END IF
-*
- IF( ILVSR )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-* Reduce to generalized Hessenberg form
-*
- CALL DGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
- $ LDVSL, VSR, LDVSR, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 5
- GO TO 10
- END IF
-*
-* Perform QZ algorithm, computing Schur vectors if desired
-* Workspace layout: ("work..." must have at least 1 word)
-* left_permutation, right_permutation, work...
-*
- IWORK = ITAU
- CALL DHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- IF( IINFO.GT.0 .AND. IINFO.LE.N ) THEN
- INFO = IINFO
- ELSE IF( IINFO.GT.N .AND. IINFO.LE.2*N ) THEN
- INFO = IINFO - N
- ELSE
- INFO = N + 6
- END IF
- GO TO 10
- END IF
-*
-* Apply permutation to VSL and VSR
-*
- IF( ILVSL ) THEN
- CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSL, LDVSL, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 7
- GO TO 10
- END IF
- END IF
- IF( ILVSR ) THEN
- CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSR, LDVSR, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 8
- GO TO 10
- END IF
- END IF
-*
-* Undo scaling
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- CALL DLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHAR, N,
- $ IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- CALL DLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHAI, N,
- $ IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
- IF( ILBSCL ) THEN
- 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 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
- 10 CONTINUE
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DGEGS
-*
- END
diff --git a/netlib/LAPACK/dgegv.f b/netlib/LAPACK/dgegv.f
deleted file mode 100644
index c687c41..0000000
--- a/netlib/LAPACK/dgegv.f
+++ /dev/null
@@ -1,769 +0,0 @@
-*> \brief <b> DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgegv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgegv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-* BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine DGGEV.
-*>
-*> DGEGV computes the eigenvalues and, optionally, the left and/or right
-*> eigenvectors of a real matrix pair (A,B).
-*> Given two square matrices A and B,
-*> the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
-*> eigenvalues lambda and corresponding (non-zero) eigenvectors x such
-*> that
-*>
-*> A*x = lambda*B*x.
-*>
-*> An alternate form is to find the eigenvalues mu and corresponding
-*> eigenvectors y such that
-*>
-*> mu*A*y = B*y.
-*>
-*> These two forms are equivalent with mu = 1/lambda and x = y if
-*> neither lambda nor mu is zero. In order to deal with the case that
-*> lambda or mu is zero or small, two values alpha and beta are returned
-*> for each eigenvalue, such that lambda = alpha/beta and
-*> mu = beta/alpha.
-*>
-*> The vectors x and y in the above equations are right eigenvectors of
-*> the matrix pair (A,B). Vectors u and v satisfying
-*>
-*> u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
-*>
-*> are left eigenvectors of (A,B).
-*>
-*> Note: this routine performs "full balancing" on A and B
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': do not compute the left generalized eigenvectors;
-*> = 'V': compute the left generalized eigenvectors (returned
-*> in VL).
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': do not compute the right generalized eigenvectors;
-*> = 'V': compute the right generalized eigenvectors (returned
-*> in VR).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VL, and VR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the matrix A.
-*> If JOBVL = 'V' or JOBVR = 'V', then on exit A
-*> contains the real Schur form of A from the generalized Schur
-*> factorization of the pair (A,B) after balancing.
-*> If no eigenvectors were computed, then only the diagonal
-*> blocks from the Schur form will be correct. See DGGHRD and
-*> DHGEQZ for details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the matrix B.
-*> If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
-*> upper triangular matrix obtained from B in the generalized
-*> Schur factorization of the pair (A,B) after balancing.
-*> If no eigenvectors were computed, then only those elements of
-*> B corresponding to the diagonal blocks from the Schur form of
-*> A will be correct. See DGGHRD and DHGEQZ for details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> The real parts of each scalar alpha defining an eigenvalue of
-*> GNEP.
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> The imaginary parts of each scalar alpha defining an
-*> eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
-*> eigenvalue is real; if positive, then the j-th and
-*> (j+1)-st eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) = -ALPHAI(j).
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> The scalars beta that define the eigenvalues of GNEP.
-*>
-*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*> beta = BETA(j) represent the j-th eigenvalue of the matrix
-*> pair (A,B), in one of the forms lambda = alpha/beta or
-*> mu = beta/alpha. Since either lambda or mu may overflow,
-*> they should not, in general, be computed.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored
-*> in the columns of VL, in the same order as their eigenvalues.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j).
-*> If the j-th and (j+1)-st eigenvalues form a complex conjugate
-*> pair, then
-*> u(j) = VL(:,j) + i*VL(:,j+1)
-*> and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*>
-*> Each eigenvector is scaled so that its largest component has
-*> abs(real part) + abs(imag. part) = 1, except for eigenvectors
-*> corresponding to an eigenvalue with alpha = beta = 0, which
-*> are set to zero.
-*> Not referenced if JOBVL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the matrix VL. LDVL >= 1, and
-*> if JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors x(j) are stored
-*> in the columns of VR, in the same order as their eigenvalues.
-*> If the j-th eigenvalue is real, then x(j) = VR(:,j).
-*> If the j-th and (j+1)-st eigenvalues form a complex conjugate
-*> pair, then
-*> x(j) = VR(:,j) + i*VR(:,j+1)
-*> and
-*> x(j+1) = VR(:,j) - i*VR(:,j+1).
-*>
-*> Each eigenvector is scaled so that its largest component has
-*> abs(real part) + abs(imag. part) = 1, except for eigenvalues
-*> corresponding to an eigenvalue with alpha = beta = 0, which
-*> are set to zero.
-*> Not referenced if JOBVR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the matrix VR. LDVR >= 1, and
-*> if JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,8*N).
-*> For good performance, LWORK must generally be larger.
-*> To compute the optimal value of LWORK, call ILAENV to get
-*> blocksizes (for DGEQRF, DORMQR, and DORGQR.) Then compute:
-*> NB -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR;
-*> The optimal LWORK is:
-*> 2*N + MAX( 6*N, N*(NB+1) ).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. No eigenvectors have been
-*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*> should be correct for j=INFO+1,...,N.
-*> > N: errors that usually indicate LAPACK problems:
-*> =N+1: error return from DGGBAL
-*> =N+2: error return from DGEQRF
-*> =N+3: error return from DORMQR
-*> =N+4: error return from DORGQR
-*> =N+5: error return from DGGHRD
-*> =N+6: error return from DHGEQZ (other than failed
-*> iteration)
-*> =N+7: error return from DTGEVC
-*> =N+8: error return from DGGBAK (computing VL)
-*> =N+9: error return from DGGBAK (computing VR)
-*> =N+10: error return from DLASCL (various calls)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Balancing
-*> ---------
-*>
-*> This driver calls DGGBAL to both permute and scale rows and columns
-*> of A and B. The permutations PL and PR are chosen so that PL*A*PR
-*> and PL*B*R will be upper triangular except for the diagonal blocks
-*> A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
-*> possible. The diagonal scaling matrices DL and DR are chosen so
-*> that the pair DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
-*> one (except for the elements that start out zero.)
-*>
-*> After the eigenvalues and eigenvectors of the balanced matrices
-*> have been computed, DGGBAK transforms the eigenvectors back to what
-*> they would have been (in perfect arithmetic) if they had not been
-*> balanced.
-*>
-*> Contents of A and B on Exit
-*> -------- -- - --- - -- ----
-*>
-*> If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
-*> both), then on exit the arrays A and B will contain the real Schur
-*> form[*] of the "balanced" versions of A and B. If no eigenvectors
-*> are computed, then only the diagonal blocks will be correct.
-*>
-*> [*] See DHGEQZ, DGEGS, or read the book "Matrix Computations",
-*> by Golub & van Loan, pub. by Johns Hopkins U. Press.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
- $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILIMIT, ILV, ILVL, ILVR, LQUERY
- CHARACTER CHTEMP
- INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT, ILO,
- $ IN, IRIGHT, IROWS, ITAU, IWORK, JC, JR, LOPT,
- $ LWKMIN, LWKOPT, NB, NB1, NB2, NB3
- DOUBLE PRECISION ABSAI, ABSAR, ABSB, ANRM, ANRM1, ANRM2, BNRM,
- $ BNRM1, BNRM2, EPS, ONEPLS, SAFMAX, SAFMIN,
- $ SALFAI, SALFAR, SBETA, SCALE, TEMP
-* ..
-* .. Local Arrays ..
- LOGICAL LDUMMA( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
- $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVL, 'N' ) ) THEN
- IJOBVL = 1
- ILVL = .FALSE.
- ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
- IJOBVL = 2
- ILVL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVR, 'N' ) ) THEN
- IJOBVR = 1
- ILVR = .FALSE.
- ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
- IJOBVR = 2
- ILVR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVR = .FALSE.
- END IF
- ILV = ILVL .OR. ILVR
-*
-* Test the input arguments
-*
- LWKMIN = MAX( 8*N, 1 )
- LWKOPT = LWKMIN
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- INFO = 0
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
- INFO = -12
- ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -16
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB1 = ILAENV( 1, 'DGEQRF', ' ', N, N, -1, -1 )
- NB2 = ILAENV( 1, 'DORMQR', ' ', N, N, N, -1 )
- NB3 = ILAENV( 1, 'DORGQR', ' ', N, N, N, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LOPT = 2*N + MAX( 6*N, N*( NB+1 ) )
- WORK( 1 ) = LOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEGV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
- SAFMIN = DLAMCH( 'S' )
- SAFMIN = SAFMIN + SAFMIN
- SAFMAX = ONE / SAFMIN
- ONEPLS = ONE + ( 4*EPS )
-*
-* Scale A
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
- ANRM1 = ANRM
- ANRM2 = ONE
- IF( ANRM.LT.ONE ) THEN
- IF( SAFMAX*ANRM.LT.ONE ) THEN
- ANRM1 = SAFMIN
- ANRM2 = SAFMAX*ANRM
- END IF
- END IF
-*
- IF( ANRM.GT.ZERO ) THEN
- CALL DLASCL( 'G', -1, -1, ANRM, ONE, N, N, A, LDA, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 10
- RETURN
- END IF
- END IF
-*
-* Scale B
-*
- BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
- BNRM1 = BNRM
- BNRM2 = ONE
- IF( BNRM.LT.ONE ) THEN
- IF( SAFMAX*BNRM.LT.ONE ) THEN
- BNRM1 = SAFMIN
- BNRM2 = SAFMAX*BNRM
- END IF
- END IF
-*
- IF( BNRM.GT.ZERO ) THEN
- CALL DLASCL( 'G', -1, -1, BNRM, ONE, N, N, B, LDB, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 10
- RETURN
- END IF
- END IF
-*
-* Permute the matrix to make it more nearly triangular
-* Workspace layout: (8*N words -- "work" requires 6*N words)
-* left_permutation, right_permutation, work...
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWORK = IRIGHT + N
- CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWORK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 1
- GO TO 120
- END IF
-*
-* Reduce B to triangular form, and initialize VL and/or VR
-* Workspace layout: ("work..." must have at least N words)
-* left_permutation, right_permutation, tau, work...
-*
- IROWS = IHI + 1 - ILO
- IF( ILV ) THEN
- ICOLS = N + 1 - ILO
- ELSE
- ICOLS = IROWS
- END IF
- ITAU = IWORK
- IWORK = ITAU + IROWS
- CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 2
- GO TO 120
- END IF
-*
- CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWORK ),
- $ LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 3
- GO TO 120
- END IF
-*
- IF( ILVL ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
- CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VL( ILO+1, ILO ), LDVL )
- CALL DORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
- $ WORK( ITAU ), WORK( IWORK ), LWORK+1-IWORK,
- $ IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 4
- GO TO 120
- END IF
- END IF
-*
- IF( ILVR )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-* Reduce to generalized Hessenberg form
-*
- IF( ILV ) THEN
-*
-* Eigenvectors requested -- work on whole matrix.
-*
- CALL DGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, IINFO )
- ELSE
- CALL DGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
- $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IINFO )
- END IF
- IF( IINFO.NE.0 ) THEN
- INFO = N + 5
- GO TO 120
- END IF
-*
-* Perform QZ algorithm
-* Workspace layout: ("work..." must have at least 1 word)
-* left_permutation, right_permutation, work...
-*
- IWORK = ITAU
- IF( ILV ) THEN
- CHTEMP = 'S'
- ELSE
- CHTEMP = 'E'
- END IF
- CALL DHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- IF( IINFO.GT.0 .AND. IINFO.LE.N ) THEN
- INFO = IINFO
- ELSE IF( IINFO.GT.N .AND. IINFO.LE.2*N ) THEN
- INFO = IINFO - N
- ELSE
- INFO = N + 6
- END IF
- GO TO 120
- END IF
-*
- IF( ILV ) THEN
-*
-* Compute Eigenvectors (DTGEVC requires 6*N words of workspace)
-*
- IF( ILVL ) THEN
- IF( ILVR ) THEN
- CHTEMP = 'B'
- ELSE
- CHTEMP = 'L'
- END IF
- ELSE
- CHTEMP = 'R'
- END IF
-*
- CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
- $ VR, LDVR, N, IN, WORK( IWORK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 7
- GO TO 120
- END IF
-*
-* Undo balancing on VL and VR, rescale
-*
- IF( ILVL ) THEN
- CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VL, LDVL, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 8
- GO TO 120
- END IF
- DO 50 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 50
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 10 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
- 10 CONTINUE
- ELSE
- DO 20 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
- $ ABS( VL( JR, JC+1 ) ) )
- 20 CONTINUE
- END IF
- IF( TEMP.LT.SAFMIN )
- $ GO TO 50
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 30 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- 30 CONTINUE
- ELSE
- DO 40 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
- 40 CONTINUE
- END IF
- 50 CONTINUE
- END IF
- IF( ILVR ) THEN
- CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VR, LDVR, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- GO TO 120
- END IF
- DO 100 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 100
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 60 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
- 60 CONTINUE
- ELSE
- DO 70 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
- $ ABS( VR( JR, JC+1 ) ) )
- 70 CONTINUE
- END IF
- IF( TEMP.LT.SAFMIN )
- $ GO TO 100
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 80 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- 80 CONTINUE
- ELSE
- DO 90 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- END IF
-*
-* End of eigenvector calculation
-*
- END IF
-*
-* Undo scaling in alpha, beta
-*
-* Note: this does not give the alpha and beta for the unscaled
-* problem.
-*
-* Un-scaling is limited to avoid underflow in alpha and beta
-* if they are significant.
-*
- DO 110 JC = 1, N
- ABSAR = ABS( ALPHAR( JC ) )
- ABSAI = ABS( ALPHAI( JC ) )
- ABSB = ABS( BETA( JC ) )
- SALFAR = ANRM*ALPHAR( JC )
- SALFAI = ANRM*ALPHAI( JC )
- SBETA = BNRM*BETA( JC )
- ILIMIT = .FALSE.
- SCALE = ONE
-*
-* Check for significant underflow in ALPHAI
-*
- IF( ABS( SALFAI ).LT.SAFMIN .AND. ABSAI.GE.
- $ MAX( SAFMIN, EPS*ABSAR, EPS*ABSB ) ) THEN
- ILIMIT = .TRUE.
- SCALE = ( ONEPLS*SAFMIN / ANRM1 ) /
- $ MAX( ONEPLS*SAFMIN, ANRM2*ABSAI )
-*
- ELSE IF( SALFAI.EQ.ZERO ) THEN
-*
-* If insignificant underflow in ALPHAI, then make the
-* conjugate eigenvalue real.
-*
- IF( ALPHAI( JC ).LT.ZERO .AND. JC.GT.1 ) THEN
- ALPHAI( JC-1 ) = ZERO
- ELSE IF( ALPHAI( JC ).GT.ZERO .AND. JC.LT.N ) THEN
- ALPHAI( JC+1 ) = ZERO
- END IF
- END IF
-*
-* Check for significant underflow in ALPHAR
-*
- IF( ABS( SALFAR ).LT.SAFMIN .AND. ABSAR.GE.
- $ MAX( SAFMIN, EPS*ABSAI, EPS*ABSB ) ) THEN
- ILIMIT = .TRUE.
- SCALE = MAX( SCALE, ( ONEPLS*SAFMIN / ANRM1 ) /
- $ MAX( ONEPLS*SAFMIN, ANRM2*ABSAR ) )
- END IF
-*
-* Check for significant underflow in BETA
-*
- IF( ABS( SBETA ).LT.SAFMIN .AND. ABSB.GE.
- $ MAX( SAFMIN, EPS*ABSAR, EPS*ABSAI ) ) THEN
- ILIMIT = .TRUE.
- SCALE = MAX( SCALE, ( ONEPLS*SAFMIN / BNRM1 ) /
- $ MAX( ONEPLS*SAFMIN, BNRM2*ABSB ) )
- END IF
-*
-* Check for possible overflow when limiting scaling
-*
- IF( ILIMIT ) THEN
- TEMP = ( SCALE*SAFMIN )*MAX( ABS( SALFAR ), ABS( SALFAI ),
- $ ABS( SBETA ) )
- IF( TEMP.GT.ONE )
- $ SCALE = SCALE / TEMP
- IF( SCALE.LT.ONE )
- $ ILIMIT = .FALSE.
- END IF
-*
-* Recompute un-scaled ALPHAR, ALPHAI, BETA if necessary.
-*
- IF( ILIMIT ) THEN
- SALFAR = ( SCALE*ALPHAR( JC ) )*ANRM
- SALFAI = ( SCALE*ALPHAI( JC ) )*ANRM
- SBETA = ( SCALE*BETA( JC ) )*BNRM
- END IF
- ALPHAR( JC ) = SALFAR
- ALPHAI( JC ) = SALFAI
- BETA( JC ) = SBETA
- 110 CONTINUE
-*
- 120 CONTINUE
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DGEGV
-*
- END
diff --git a/netlib/LAPACK/dgehd2.f b/netlib/LAPACK/dgehd2.f
deleted file mode 100644
index 089fad1..0000000
--- a/netlib/LAPACK/dgehd2.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEHD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgehd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgehd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgehd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
-*> an orthogonal similarity transformation: Q**T * A * Q = H .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that A is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to DGEBAL; otherwise they should be
-*> set to 1 and N respectively. See Further Details.
-*> 1 <= ILO <= IHI <= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the n by n general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> elements below the first subdiagonal, with the array TAU,
-*> represent the orthogonal matrix Q as a product of elementary
-*> reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of (ihi-ilo) elementary
-*> reflectors
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*> exit in A(i+2:ihi,i), and tau in TAU(i).
-*>
-*> The contents of A are illustrated by the following example, with
-*> n = 7, ilo = 2 and ihi = 6:
-*>
-*> on entry, on exit,
-*>
-*> ( a a a a a a a ) ( a a h h h h a )
-*> ( a a a a a a ) ( a h h h h a )
-*> ( a a a a a a ) ( h h h h h h )
-*> ( a a a a a a ) ( v2 h h h h h )
-*> ( a a a a a a ) ( v2 v3 h h h h )
-*> ( a a a a a a ) ( v2 v3 v4 h h h )
-*> ( a ) ( a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEHD2', -INFO )
- RETURN
- END IF
-*
- DO 10 I = ILO, IHI - 1
-*
-* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
-*
- CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAU( I ) )
- AII = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Apply H(i) to A(1:ihi,i+1:ihi) from the right
-*
- CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
- $ A( 1, I+1 ), LDA, WORK )
-*
-* Apply H(i) to A(i+1:ihi,i+1:n) from the left
-*
- CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
- $ A( I+1, I+1 ), LDA, WORK )
-*
- A( I+1, I ) = AII
- 10 CONTINUE
-*
- RETURN
-*
-* End of DGEHD2
-*
- END
diff --git a/netlib/LAPACK/dgehrd.f b/netlib/LAPACK/dgehrd.f
deleted file mode 100644
index 0dda2e2..0000000
--- a/netlib/LAPACK/dgehrd.f
+++ /dev/null
@@ -1,352 +0,0 @@
-*> \brief \b DGEHRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEHRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgehrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgehrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgehrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEHRD reduces a real general matrix A to upper Hessenberg form H by
-*> an orthogonal similarity transformation: Q**T * A * Q = H .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that A is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to DGEBAL; otherwise they should be
-*> set to 1 and N respectively. See Further Details.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> elements below the first subdiagonal, with the array TAU,
-*> represent the orthogonal matrix Q as a product of elementary
-*> reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
-*> zero.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of (ihi-ilo) elementary
-*> reflectors
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*> exit in A(i+2:ihi,i), and tau in TAU(i).
-*>
-*> The contents of A are illustrated by the following example, with
-*> n = 7, ilo = 2 and ihi = 6:
-*>
-*> on entry, on exit,
-*>
-*> ( a a a a a a a ) ( a a h h h h a )
-*> ( a a a a a a ) ( a h h h h a )
-*> ( a a a a a a ) ( h h h h h h )
-*> ( a a a a a a ) ( v2 h h h h h )
-*> ( a a a a a a ) ( v2 v3 h h h h )
-*> ( a a a a a a ) ( v2 v3 v4 h h h )
-*> ( a ) ( a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*>
-*> This file is a slight modification of LAPACK-3.0's DGEHRD
-*> subroutine incorporating improvements proposed by Quintana-Orti and
-*> Van de Geijn (2006). (See DLAHR2.)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0,
- $ ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, LDWORK, LWKOPT, NB,
- $ NBMIN, NH, NX
- DOUBLE PRECISION EI
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEHRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
-*
- DO 10 I = 1, ILO - 1
- TAU( I ) = ZERO
- 10 CONTINUE
- DO 20 I = MAX( 1, IHI ), N - 1
- TAU( I ) = ZERO
- 20 CONTINUE
-*
-* Quick return if possible
-*
- NH = IHI - ILO + 1
- IF( NH.LE.1 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
-* Determine the block size
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
- NBMIN = 2
- IWS = 1
- IF( NB.GT.1 .AND. NB.LT.NH ) THEN
-*
-* Determine when to cross over from blocked to unblocked code
-* (last block is always handled by unblocked code)
-*
- NX = MAX( NB, ILAENV( 3, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
- IF( NX.LT.NH ) THEN
-*
-* Determine if workspace is large enough for blocked code
-*
- IWS = N*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: determine the
-* minimum value of NB, and reduce NB or force use of
-* unblocked code
-*
- NBMIN = MAX( 2, ILAENV( 2, 'DGEHRD', ' ', N, ILO, IHI,
- $ -1 ) )
- IF( LWORK.GE.N*NBMIN ) THEN
- NB = LWORK / N
- ELSE
- NB = 1
- END IF
- END IF
- END IF
- END IF
- LDWORK = N
-*
- IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN
-*
-* Use unblocked code below
-*
- I = ILO
-*
- ELSE
-*
-* Use blocked code
-*
- DO 40 I = ILO, IHI - 1 - NX, NB
- IB = MIN( NB, IHI-I )
-*
-* Reduce columns i:i+ib-1 to Hessenberg form, returning the
-* matrices V and T of the block reflector H = I - V*T*V**T
-* which performs the reduction, and also the matrix Y = A*V*T
-*
- CALL DLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,
- $ WORK, LDWORK )
-*
-* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
-* right, computing A := A - Y * V**T. V(i+ib,ib-1) must be set
-* to 1
-*
- EI = A( I+IB, I+IB-1 )
- A( I+IB, I+IB-1 ) = ONE
- CALL DGEMM( 'No transpose', 'Transpose',
- $ IHI, IHI-I-IB+1,
- $ IB, -ONE, WORK, LDWORK, A( I+IB, I ), LDA, ONE,
- $ A( 1, I+IB ), LDA )
- A( I+IB, I+IB-1 ) = EI
-*
-* Apply the block reflector H to A(1:i,i+1:i+ib-1) from the
-* right
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose',
- $ 'Unit', I, IB-1,
- $ ONE, A( I+1, I ), LDA, WORK, LDWORK )
- DO 30 J = 0, IB-2
- CALL DAXPY( I, -ONE, WORK( LDWORK*J+1 ), 1,
- $ A( 1, I+J+1 ), 1 )
- 30 CONTINUE
-*
-* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
-* left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise',
- $ IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT,
- $ A( I+1, I+IB ), LDA, WORK, LDWORK )
- 40 CONTINUE
- END IF
-*
-* Use unblocked code to reduce the rest of the matrix
-*
- CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
- WORK( 1 ) = IWS
-*
- RETURN
-*
-* End of DGEHRD
-*
- END
diff --git a/netlib/LAPACK/dgejsv.f b/netlib/LAPACK/dgejsv.f
deleted file mode 100644
index 29bc23b..0000000
--- a/netlib/LAPACK/dgejsv.f
+++ /dev/null
@@ -1,1777 +0,0 @@
-*> \brief \b DGEJSV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEJSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgejsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgejsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgejsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
-* M, N, A, LDA, SVA, U, LDU, V, LDV,
-* WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* IMPLICIT NONE
-* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), SVA( N ), U( LDU, * ), V( LDV, * ),
-* $ WORK( LWORK )
-* INTEGER IWORK( * )
-* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEJSV computes the singular value decomposition (SVD) of a real M-by-N
-*> matrix [A], where M >= N. The SVD of [A] is written as
-*>
-*> [A] = [U] * [SIGMA] * [V]^t,
-*>
-*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N
-*> diagonal elements, [U] is an M-by-N (or M-by-M) orthonormal matrix, and
-*> [V] is an N-by-N orthogonal matrix. The diagonal elements of [SIGMA] are
-*> the singular values of [A]. The columns of [U] and [V] are the left and
-*> the right singular vectors of [A], respectively. The matrices [U] and [V]
-*> are computed and stored in the arrays U and V, respectively. The diagonal
-*> of [SIGMA] is computed and stored in the array SVA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBA
-*> \verbatim
-*> JOBA is CHARACTER*1
-*> Specifies the level of accuracy:
-*> = 'C': This option works well (high relative accuracy) if A = B * D,
-*> with well-conditioned B and arbitrary diagonal matrix D.
-*> The accuracy cannot be spoiled by COLUMN scaling. The
-*> accuracy of the computed output depends on the condition of
-*> B, and the procedure aims at the best theoretical accuracy.
-*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is
-*> bounded by f(M,N)*epsilon* cond(B), independent of D.
-*> The input matrix is preprocessed with the QRF with column
-*> pivoting. This initial preprocessing and preconditioning by
-*> a rank revealing QR factorization is common for all values of
-*> JOBA. Additional actions are specified as follows:
-*> = 'E': Computation as with 'C' with an additional estimate of the
-*> condition number of B. It provides a realistic error bound.
-*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings
-*> D1, D2, and well-conditioned matrix C, this option gives
-*> higher accuracy than the 'C' option. If the structure of the
-*> input matrix is not known, and relative accuracy is
-*> desirable, then this option is advisable. The input matrix A
-*> is preprocessed with QR factorization with FULL (row and
-*> column) pivoting.
-*> = 'G' Computation as with 'F' with an additional estimate of the
-*> condition number of B, where A=D*B. If A has heavily weighted
-*> rows, then using this condition number gives too pessimistic
-*> error bound.
-*> = 'A': Small singular values are the noise and the matrix is treated
-*> as numerically rank defficient. The error in the computed
-*> singular values is bounded by f(m,n)*epsilon*||A||.
-*> The computed SVD A = U * S * V^t restores A up to
-*> f(m,n)*epsilon*||A||.
-*> This gives the procedure the licence to discard (set to zero)
-*> all singular values below N*epsilon*||A||.
-*> = 'R': Similar as in 'A'. Rank revealing property of the initial
-*> QR factorization is used do reveal (using triangular factor)
-*> a gap sigma_{r+1} < epsilon * sigma_r in which case the
-*> numerical RANK is declared to be r. The SVD is computed with
-*> absolute error bounds, but more accurately than with 'A'.
-*> \endverbatim
-*>
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies whether to compute the columns of U:
-*> = 'U': N columns of U are returned in the array U.
-*> = 'F': full set of M left sing. vectors is returned in the array U.
-*> = 'W': U may be used as workspace of length M*N. See the description
-*> of U.
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether to compute the matrix V:
-*> = 'V': N columns of V are returned in the array V; Jacobi rotations
-*> are not explicitly accumulated.
-*> = 'J': N columns of V are returned in the array V, but they are
-*> computed as the product of Jacobi rotations. This option is
-*> allowed only if JOBU .NE. 'N', i.e. in computing the full SVD.
-*> = 'W': V may be used as workspace of length N*N. See the description
-*> of V.
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBR
-*> \verbatim
-*> JOBR is CHARACTER*1
-*> Specifies the RANGE for the singular values. Issues the licence to
-*> set to zero small positive singular values if they are outside
-*> specified range. If A .NE. 0 is scaled so that the largest singular
-*> value of c*A is around DSQRT(BIG), BIG=SLAMCH('O'), then JOBR issues
-*> the licence to kill columns of A whose norm in c*A is less than
-*> DSQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN,
-*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E').
-*> = 'N': Do not kill small columns of c*A. This option assumes that
-*> BLAS and QR factorizations and triangular solvers are
-*> implemented to work in that range. If the condition of A
-*> is greater than BIG, use DGESVJ.
-*> = 'R': RESTRICTED range for sigma(c*A) is [DSQRT(SFMIN), DSQRT(BIG)]
-*> (roughly, as described above). This option is recommended.
-*> ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*> For computing the singular values in the FULL range [SFMIN,BIG]
-*> use DGESVJ.
-*> \endverbatim
-*>
-*> \param[in] JOBT
-*> \verbatim
-*> JOBT is CHARACTER*1
-*> If the matrix is square then the procedure may determine to use
-*> transposed A if A^t seems to be better with respect to convergence.
-*> If the matrix is not square, JOBT is ignored. This is subject to
-*> changes in the future.
-*> The decision is based on two values of entropy over the adjoint
-*> orbit of A^t * A. See the descriptions of WORK(6) and WORK(7).
-*> = 'T': transpose if entropy test indicates possibly faster
-*> convergence of Jacobi process if A^t is taken as input. If A is
-*> replaced with A^t, then the row pivoting is included automatically.
-*> = 'N': do not speculate.
-*> This option can be used to compute only the singular values, or the
-*> full SVD (U, SIGMA and V). For only one set of singular vectors
-*> (U or V), the caller should provide both U and V, as one of the
-*> matrices is used as workspace if the matrix A is transposed.
-*> The implementer can easily remove this constraint and make the
-*> code more complicated. See the descriptions of U and V.
-*> \endverbatim
-*>
-*> \param[in] JOBP
-*> \verbatim
-*> JOBP is CHARACTER*1
-*> Issues the licence to introduce structured perturbations to drown
-*> denormalized numbers. This licence should be active if the
-*> denormals are poorly implemented, causing slow computation,
-*> especially in cases of fast convergence (!). For details see [1,2].
-*> For the sake of simplicity, this perturbations are included only
-*> when the full SVD or only the singular values are requested. The
-*> implementer/user can easily add the perturbation for the cases of
-*> computing one set of singular vectors.
-*> = 'P': introduce perturbation
-*> = 'N': do not perturb
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] SVA
-*> \verbatim
-*> SVA is DOUBLE PRECISION array, dimension (N)
-*> On exit,
-*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the
-*> computation SVA contains Euclidean column norms of the
-*> iterated matrices in the array A.
-*> - For WORK(1) .NE. WORK(2): The singular values of A are
-*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if
-*> sigma_max(A) overflows or if small singular values have been
-*> saved from underflow by scaling the input matrix A.
-*> - If JOBR='R' then some of the singular values may be returned
-*> as exact zeros obtained by "set to zero" because they are
-*> below the numerical rank threshold or are denormalized numbers.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension ( LDU, N )
-*> If JOBU = 'U', then U contains on exit the M-by-N matrix of
-*> the left singular vectors.
-*> If JOBU = 'F', then U contains on exit the M-by-M matrix of
-*> the left singular vectors, including an ONB
-*> of the orthogonal complement of the Range(A).
-*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N),
-*> then U is used as workspace if the procedure
-*> replaces A with A^t. In that case, [V] is computed
-*> in U as left singular vectors of A^t and then
-*> copied back to the V array. This 'W' option is just
-*> a reminder to the caller that in this case U is
-*> reserved as workspace of length N*N.
-*> If JOBU = 'N' U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U, LDU >= 1.
-*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension ( LDV, N )
-*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of
-*> the right singular vectors;
-*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N),
-*> then V is used as workspace if the pprocedure
-*> replaces A with A^t. In that case, [U] is computed
-*> in V as right singular vectors of A^t and then
-*> copied back to the U array. This 'W' option is just
-*> a reminder to the caller that in this case V is
-*> reserved as workspace of length N*N.
-*> If JOBV = 'N' V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV >= 1.
-*> If JOBV = 'V' or 'J' or 'W', then LDV >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension at least LWORK.
-*> On exit, if N.GT.0 .AND. M.GT.0 (else not referenced),
-*> WORK(1) = SCALE = WORK(2) / WORK(1) is the scaling factor such
-*> that SCALE*SVA(1:N) are the computed singular values
-*> of A. (See the description of SVA().)
-*> WORK(2) = See the description of WORK(1).
-*> WORK(3) = SCONDA is an estimate for the condition number of
-*> column equilibrated A. (If JOBA .EQ. 'E' or 'G')
-*> SCONDA is an estimate of DSQRT(||(R^t * R)^(-1)||_1).
-*> It is computed using DPOCON. It holds
-*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
-*> where R is the triangular factor from the QRF of A.
-*> However, if R is truncated and the numerical rank is
-*> determined to be strictly smaller than N, SCONDA is
-*> returned as -1, thus indicating that the smallest
-*> singular values might be lost.
-*>
-*> If full SVD is needed, the following two condition numbers are
-*> useful for the analysis of the algorithm. They are provied for
-*> a developer/implementer who is familiar with the details of
-*> the method.
-*>
-*> WORK(4) = an estimate of the scaled condition number of the
-*> triangular factor in the first QR factorization.
-*> WORK(5) = an estimate of the scaled condition number of the
-*> triangular factor in the second QR factorization.
-*> The following two parameters are computed if JOBT .EQ. 'T'.
-*> They are provided for a developer/implementer who is familiar
-*> with the details of the method.
-*>
-*> WORK(6) = the entropy of A^t*A :: this is the Shannon entropy
-*> of diag(A^t*A) / Trace(A^t*A) taken as point in the
-*> probability simplex.
-*> WORK(7) = the entropy of A*A^t.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> Length of WORK to confirm proper allocation of work space.
-*> LWORK depends on the job:
-*>
-*> If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and
-*> -> .. no scaled condition estimate required (JOBE.EQ.'N'):
-*> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement.
-*> ->> For optimal performance (blocked code) the optimal value
-*> is LWORK >= max(2*M+N,3*N+(N+1)*NB,7). Here NB is the optimal
-*> block size for DGEQP3 and DGEQRF.
-*> In general, optimal LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), 7).
-*> -> .. an estimate of the scaled condition number of A is
-*> required (JOBA='E', 'G'). In this case, LWORK is the maximum
-*> of the above and N*N+4*N, i.e. LWORK >= max(2*M+N,N*N+4*N,7).
-*> ->> For optimal performance (blocked code) the optimal value
-*> is LWORK >= max(2*M+N,3*N+(N+1)*NB, N*N+4*N, 7).
-*> In general, the optimal length LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF),
-*> N+N*N+LWORK(DPOCON),7).
-*>
-*> If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'),
-*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7).
-*> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7),
-*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQ,
-*> DORMLQ. In general, the optimal length LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3), N+LWORK(DPOCON),
-*> N+LWORK(DGELQ), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)).
-*>
-*> If SIGMA and the left singular vectors are needed
-*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7).
-*> -> For optimal performance:
-*> if JOBU.EQ.'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7),
-*> if JOBU.EQ.'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7),
-*> where NB is the optimal block size for DGEQP3, DGEQRF, DORMQR.
-*> In general, the optimal length LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON),
-*> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)).
-*> Here LWORK(DORMQR) equals N*NB (for JOBU.EQ.'U') or
-*> M*NB (for JOBU.EQ.'F').
-*>
-*> If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and
-*> -> if JOBV.EQ.'V'
-*> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N).
-*> -> if JOBV.EQ.'J' the minimal requirement is
-*> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6).
-*> -> For optimal performance, LWORK should be additionally
-*> larger than N+M*NB, where NB is the optimal block size
-*> for DORMQR.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension M+3*N.
-*> On exit,
-*> IWORK(1) = the numerical rank determined after the initial
-*> QR factorization with pivoting. See the descriptions
-*> of JOBA and JOBR.
-*> IWORK(2) = the number of the computed nonzero singular values
-*> IWORK(3) = if nonzero, a warning message:
-*> If IWORK(3).EQ.1 then some of the column norms of A
-*> were denormalized floats. The requested high accuracy
-*> is not warranted by the data.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value.
-*> = 0 : successfull exit;
-*> > 0 : DGEJSV did not converge in the maximal allowed number
-*> of sweeps. The computed values may be inaccurate.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEsing
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> DGEJSV implements a preconditioned Jacobi SVD algorithm. It uses DGEQP3,
-*> DGEQRF, and DGELQF as preprocessors and preconditioners. Optionally, an
-*> additional row pivoting can be used as a preprocessor, which in some
-*> cases results in much higher accuracy. An example is matrix A with the
-*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned
-*> diagonal matrices and C is well-conditioned matrix. In that case, complete
-*> pivoting in the first QR factorizations provides accuracy dependent on the
-*> condition number of C, and independent of D1, D2. Such higher accuracy is
-*> not completely understood theoretically, but it works well in practice.
-*> Further, if A can be written as A = B*D, with well-conditioned B and some
-*> diagonal D, then the high accuracy is guaranteed, both theoretically and
-*> in software, independent of D. For more details see [1], [2].
-*> The computational range for the singular values can be the full range
-*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS
-*> & LAPACK routines called by DGEJSV are implemented to work in that range.
-*> If that is not the case, then the restriction for safe computation with
-*> the singular values in the range of normalized IEEE numbers is that the
-*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not
-*> overflow. This code (DGEJSV) is best used in this restricted range,
-*> meaning that singular values of magnitude below ||A||_2 / DLAMCH('O') are
-*> returned as zeros. See JOBR for details on this.
-*> Further, this implementation is somewhat slower than the one described
-*> in [1,2] due to replacement of some non-LAPACK components, and because
-*> the choice of some tuning parameters in the iterative part (DGESVJ) is
-*> left to the implementer on a particular machine.
-*> The rank revealing QR factorization (in this code: DGEQP3) should be
-*> implemented as in [3]. We have a new version of DGEQP3 under development
-*> that is more robust than the current one in LAPACK, with a cleaner cut in
-*> rank defficient cases. It will be available in the SIGMA library [4].
-*> If M is much larger than N, it is obvious that the inital QRF with
-*> column pivoting can be preprocessed by the QRF without pivoting. That
-*> well known trick is not used in DGEJSV because in some cases heavy row
-*> weighting can be treated with complete pivoting. The overhead in cases
-*> M much larger than N is then only due to pivoting, but the benefits in
-*> terms of accuracy have prevailed. The implementer/user can incorporate
-*> this extra QRF step easily. The implementer can also improve data movement
-*> (matrix transpose, matrix copy, matrix transposed copy) - this
-*> implementation of DGEJSV uses only the simplest, naive data movement.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.
-*> LAPACK Working note 169.
-*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.
-*> LAPACK Working note 170.
-*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR
-*> factorization software - a case study.
-*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28.
-*> LAPACK Working note 176.
-*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,
-*> QSVD, (H,K)-SVD computations.
-*> Department of Mathematics, University of Zagreb, 2008.
-*> \endverbatim
-*
-*> \par Bugs, examples and comments:
-* =================================
-*>
-*> Please report all bugs and send interesting examples and/or comments to
-*> drmac at math.hr. Thank you.
-*>
-* =====================================================================
- SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
- $ M, N, A, LDA, SVA, U, LDU, V, LDV,
- $ WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- IMPLICIT NONE
- INTEGER INFO, LDA, LDU, LDV, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), SVA( N ), U( LDU, * ), V( LDV, * ),
- $ WORK( LWORK )
- INTEGER IWORK( * )
- CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
-* ..
-*
-* ===========================================================================
-*
-* .. Local Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, COND_OK,
- $ CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, MAXPRJ, SCALEM,
- $ SCONDA, SFMIN, SMALL, TEMP1, USCAL1, USCAL2, XSC
- INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING
- LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LSVEC,
- $ L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN,
- $ NOSCAL, ROWPIV, RSVEC, TRANSP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS, DLOG, DMAX1, DMIN1, DBLE,
- $ MAX0, MIN0, IDNINT, DSIGN, DSQRT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DNRM2
- INTEGER IDAMAX
- LOGICAL LSAME
- EXTERNAL IDAMAX, LSAME, DLAMCH, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGELQF, DGEQP3, DGEQRF, DLACPY, DLASCL,
- $ DLASET, DLASSQ, DLASWP, DORGQR, DORMLQ,
- $ DORMQR, DPOCON, DSCAL, DSWAP, DTRSM, XERBLA
-*
- EXTERNAL DGESVJ
-* ..
-*
-* Test the input arguments
-*
- LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' )
- JRACC = LSAME( JOBV, 'J' )
- RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC
- ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' )
- L2RANK = LSAME( JOBA, 'R' )
- L2ABER = LSAME( JOBA, 'A' )
- ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' )
- L2TRAN = LSAME( JOBT, 'T' )
- L2KILL = LSAME( JOBR, 'R' )
- DEFR = LSAME( JOBR, 'N' )
- L2PERT = LSAME( JOBP, 'P' )
-*
- IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR.
- $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN
- INFO = - 1
- ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR.
- $ LSAME( JOBU, 'W' )) ) THEN
- INFO = - 2
- ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR.
- $ LSAME( JOBV, 'W' )) .OR. ( JRACC .AND. (.NOT.LSVEC) ) ) THEN
- INFO = - 3
- ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN
- INFO = - 4
- ELSE IF ( .NOT. ( L2TRAN .OR. LSAME( JOBT, 'N' ) ) ) THEN
- INFO = - 5
- ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN
- INFO = - 6
- ELSE IF ( M .LT. 0 ) THEN
- INFO = - 7
- ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN
- INFO = - 8
- ELSE IF ( LDA .LT. M ) THEN
- INFO = - 10
- ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN
- INFO = - 13
- ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN
- INFO = - 14
- ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND.
- & (LWORK .LT. MAX0(7,4*N+1,2*M+N))) .OR.
- & (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND.
- & (LWORK .LT. MAX0(7,4*N+N*N,2*M+N))) .OR.
- & (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1)))
- & .OR.
- & (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1)))
- & .OR.
- & (LSVEC .AND. RSVEC .AND. (.NOT.JRACC) .AND.
- & (LWORK.LT.MAX0(2*M+N,6*N+2*N*N)))
- & .OR. (LSVEC .AND. RSVEC .AND. JRACC .AND.
- & LWORK.LT.MAX0(2*M+N,4*N+N*N,2*N+N*N+6)))
- & THEN
- INFO = - 17
- ELSE
-* #:)
- INFO = 0
- END IF
-*
- IF ( INFO .NE. 0 ) THEN
-* #:(
- CALL XERBLA( 'DGEJSV', - INFO )
- RETURN
- END IF
-*
-* Quick return for void matrix (Y3K safe)
-* #:)
- IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN
-*
-* Determine whether the matrix U should be M x N or M x M
-*
- IF ( LSVEC ) THEN
- N1 = N
- IF ( LSAME( JOBU, 'F' ) ) N1 = M
- END IF
-*
-* Set numerical parameters
-*
-*! NOTE: Make sure DLAMCH() does not fail on the target architecture.
-*
- EPSLN = DLAMCH('Epsilon')
- SFMIN = DLAMCH('SafeMinimum')
- SMALL = SFMIN / EPSLN
- BIG = DLAMCH('O')
-* BIG = ONE / SFMIN
-*
-* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N
-*
-*(!) If necessary, scale SVA() to protect the largest norm from
-* overflow. It is possible that this scaling pushes the smallest
-* column norm left from the underflow threshold (extreme case).
-*
- SCALEM = ONE / DSQRT(DBLE(M)*DBLE(N))
- NOSCAL = .TRUE.
- GOSCAL = .TRUE.
- DO 1874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A(1,p), 1, AAPP, AAQQ )
- IF ( AAPP .GT. BIG ) THEN
- INFO = - 9
- CALL XERBLA( 'DGEJSV', -INFO )
- RETURN
- END IF
- AAQQ = DSQRT(AAQQ)
- IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN
- SVA(p) = AAPP * AAQQ
- ELSE
- NOSCAL = .FALSE.
- SVA(p) = AAPP * ( AAQQ * SCALEM )
- IF ( GOSCAL ) THEN
- GOSCAL = .FALSE.
- CALL DSCAL( p-1, SCALEM, SVA, 1 )
- END IF
- END IF
- 1874 CONTINUE
-*
- IF ( NOSCAL ) SCALEM = ONE
-*
- AAPP = ZERO
- AAQQ = BIG
- DO 4781 p = 1, N
- AAPP = DMAX1( AAPP, SVA(p) )
- IF ( SVA(p) .NE. ZERO ) AAQQ = DMIN1( AAQQ, SVA(p) )
- 4781 CONTINUE
-*
-* Quick return for zero M x N matrix
-* #:)
- IF ( AAPP .EQ. ZERO ) THEN
- IF ( LSVEC ) CALL DLASET( 'G', M, N1, ZERO, ONE, U, LDU )
- IF ( RSVEC ) CALL DLASET( 'G', N, N, ZERO, ONE, V, LDV )
- WORK(1) = ONE
- WORK(2) = ONE
- IF ( ERREST ) WORK(3) = ONE
- IF ( LSVEC .AND. RSVEC ) THEN
- WORK(4) = ONE
- WORK(5) = ONE
- END IF
- IF ( L2TRAN ) THEN
- WORK(6) = ZERO
- WORK(7) = ZERO
- END IF
- IWORK(1) = 0
- IWORK(2) = 0
- IWORK(3) = 0
- RETURN
- END IF
-*
-* Issue warning if denormalized column norms detected. Override the
-* high relative accuracy request. Issue licence to kill columns
-* (set them to zero) whose norm is less than sigma_max / BIG (roughly).
-* #:(
- WARNING = 0
- IF ( AAQQ .LE. SFMIN ) THEN
- L2RANK = .TRUE.
- L2KILL = .TRUE.
- WARNING = 1
- END IF
-*
-* Quick return for one-column matrix
-* #:)
- IF ( N .EQ. 1 ) THEN
-*
- IF ( LSVEC ) THEN
- CALL DLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR )
- CALL DLACPY( 'A', M, 1, A, LDA, U, LDU )
-* computing all M left singular vectors of the M x 1 matrix
- IF ( N1 .NE. N ) THEN
- CALL DGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N,IERR )
- CALL DORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N,IERR )
- CALL DCOPY( M, A(1,1), 1, U(1,1), 1 )
- END IF
- END IF
- IF ( RSVEC ) THEN
- V(1,1) = ONE
- END IF
- IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN
- SVA(1) = SVA(1) / SCALEM
- SCALEM = ONE
- END IF
- WORK(1) = ONE / SCALEM
- WORK(2) = ONE
- IF ( SVA(1) .NE. ZERO ) THEN
- IWORK(1) = 1
- IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN
- IWORK(2) = 1
- ELSE
- IWORK(2) = 0
- END IF
- ELSE
- IWORK(1) = 0
- IWORK(2) = 0
- END IF
- IF ( ERREST ) WORK(3) = ONE
- IF ( LSVEC .AND. RSVEC ) THEN
- WORK(4) = ONE
- WORK(5) = ONE
- END IF
- IF ( L2TRAN ) THEN
- WORK(6) = ZERO
- WORK(7) = ZERO
- END IF
- RETURN
-*
- END IF
-*
- TRANSP = .FALSE.
- L2TRAN = L2TRAN .AND. ( M .EQ. N )
-*
- AATMAX = -ONE
- AATMIN = BIG
- IF ( ROWPIV .OR. L2TRAN ) THEN
-*
-* Compute the row norms, needed to determine row pivoting sequence
-* (in the case of heavily row weighted A, row pivoting is strongly
-* advised) and to collect information needed to compare the
-* structures of A * A^t and A^t * A (in the case L2TRAN.EQ..TRUE.).
-*
- IF ( L2TRAN ) THEN
- DO 1950 p = 1, M
- XSC = ZERO
- TEMP1 = ONE
- CALL DLASSQ( N, A(p,1), LDA, XSC, TEMP1 )
-* DLASSQ gets both the ell_2 and the ell_infinity norm
-* in one pass through the vector
- WORK(M+N+p) = XSC * SCALEM
- WORK(N+p) = XSC * (SCALEM*DSQRT(TEMP1))
- AATMAX = DMAX1( AATMAX, WORK(N+p) )
- IF (WORK(N+p) .NE. ZERO) AATMIN = DMIN1(AATMIN,WORK(N+p))
- 1950 CONTINUE
- ELSE
- DO 1904 p = 1, M
- WORK(M+N+p) = SCALEM*DABS( A(p,IDAMAX(N,A(p,1),LDA)) )
- AATMAX = DMAX1( AATMAX, WORK(M+N+p) )
- AATMIN = DMIN1( AATMIN, WORK(M+N+p) )
- 1904 CONTINUE
- END IF
-*
- END IF
-*
-* For square matrix A try to determine whether A^t would be better
-* input for the preconditioned Jacobi SVD, with faster convergence.
-* The decision is based on an O(N) function of the vector of column
-* and row norms of A, based on the Shannon entropy. This should give
-* the right choice in most cases when the difference actually matters.
-* It may fail and pick the slower converging side.
-*
- ENTRA = ZERO
- ENTRAT = ZERO
- IF ( L2TRAN ) THEN
-*
- XSC = ZERO
- TEMP1 = ONE
- CALL DLASSQ( N, SVA, 1, XSC, TEMP1 )
- TEMP1 = ONE / TEMP1
-*
- ENTRA = ZERO
- DO 1113 p = 1, N
- BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1
- IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1)
- 1113 CONTINUE
- ENTRA = - ENTRA / DLOG(DBLE(N))
-*
-* Now, SVA().^2/Trace(A^t * A) is a point in the probability simplex.
-* It is derived from the diagonal of A^t * A. Do the same with the
-* diagonal of A * A^t, compute the entropy of the corresponding
-* probability distribution. Note that A * A^t and A^t * A have the
-* same trace.
-*
- ENTRAT = ZERO
- DO 1114 p = N+1, N+M
- BIG1 = ( ( WORK(p) / XSC )**2 ) * TEMP1
- IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1)
- 1114 CONTINUE
- ENTRAT = - ENTRAT / DLOG(DBLE(M))
-*
-* Analyze the entropies and decide A or A^t. Smaller entropy
-* usually means better input for the algorithm.
-*
- TRANSP = ( ENTRAT .LT. ENTRA )
-*
-* If A^t is better than A, transpose A.
-*
- IF ( TRANSP ) THEN
-* In an optimal implementation, this trivial transpose
-* should be replaced with faster transpose.
- DO 1115 p = 1, N - 1
- DO 1116 q = p + 1, N
- TEMP1 = A(q,p)
- A(q,p) = A(p,q)
- A(p,q) = TEMP1
- 1116 CONTINUE
- 1115 CONTINUE
- DO 1117 p = 1, N
- WORK(M+N+p) = SVA(p)
- SVA(p) = WORK(N+p)
- 1117 CONTINUE
- TEMP1 = AAPP
- AAPP = AATMAX
- AATMAX = TEMP1
- TEMP1 = AAQQ
- AAQQ = AATMIN
- AATMIN = TEMP1
- KILL = LSVEC
- LSVEC = RSVEC
- RSVEC = KILL
- IF ( LSVEC ) N1 = N
-*
- ROWPIV = .TRUE.
- END IF
-*
- END IF
-* END IF L2TRAN
-*
-* Scale the matrix so that its maximal singular value remains less
-* than DSQRT(BIG) -- the matrix is scaled so that its maximal column
-* has Euclidean norm equal to DSQRT(BIG/N). The only reason to keep
-* DSQRT(BIG) instead of BIG is the fact that DGEJSV uses LAPACK and
-* BLAS routines that, in some implementations, are not capable of
-* working in the full interval [SFMIN,BIG] and that they may provoke
-* overflows in the intermediate results. If the singular values spread
-* from SFMIN to BIG, then DGESVJ will compute them. So, in that case,
-* one should use DGESVJ instead of DGEJSV.
-*
- BIG1 = DSQRT( BIG )
- TEMP1 = DSQRT( BIG / DBLE(N) )
-*
- CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR )
- IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN
- AAQQ = ( AAQQ / AAPP ) * TEMP1
- ELSE
- AAQQ = ( AAQQ * TEMP1 ) / AAPP
- END IF
- TEMP1 = TEMP1 * SCALEM
- CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR )
-*
-* To undo scaling at the end of this procedure, multiply the
-* computed singular values with USCAL2 / USCAL1.
-*
- USCAL1 = TEMP1
- USCAL2 = AAPP
-*
- IF ( L2KILL ) THEN
-* L2KILL enforces computation of nonzero singular values in
-* the restricted range of condition number of the initial A,
-* sigma_max(A) / sigma_min(A) approx. DSQRT(BIG)/DSQRT(SFMIN).
- XSC = DSQRT( SFMIN )
- ELSE
- XSC = SMALL
-*
-* Now, if the condition number of A is too big,
-* sigma_max(A) / sigma_min(A) .GT. DSQRT(BIG/N) * EPSLN / SFMIN,
-* as a precaution measure, the full SVD is computed using DGESVJ
-* with accumulated Jacobi rotations. This provides numerically
-* more robust computation, at the cost of slightly increased run
-* time. Depending on the concrete implementation of BLAS and LAPACK
-* (i.e. how they behave in presence of extreme ill-conditioning) the
-* implementor may decide to remove this switch.
- IF ( ( AAQQ.LT.DSQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN
- JRACC = .TRUE.
- END IF
-*
- END IF
- IF ( AAQQ .LT. XSC ) THEN
- DO 700 p = 1, N
- IF ( SVA(p) .LT. XSC ) THEN
- CALL DLASET( 'A', M, 1, ZERO, ZERO, A(1,p), LDA )
- SVA(p) = ZERO
- END IF
- 700 CONTINUE
- END IF
-*
-* Preconditioning using QR factorization with pivoting
-*
- IF ( ROWPIV ) THEN
-* Optional row permutation (Bjoerck row pivoting):
-* A result by Cox and Higham shows that the Bjoerck's
-* row pivoting combined with standard column pivoting
-* has similar effect as Powell-Reid complete pivoting.
-* The ell-infinity norms of A are made nonincreasing.
- DO 1952 p = 1, M - 1
- q = IDAMAX( M-p+1, WORK(M+N+p), 1 ) + p - 1
- IWORK(2*N+p) = q
- IF ( p .NE. q ) THEN
- TEMP1 = WORK(M+N+p)
- WORK(M+N+p) = WORK(M+N+q)
- WORK(M+N+q) = TEMP1
- END IF
- 1952 CONTINUE
- CALL DLASWP( N, A, LDA, 1, M-1, IWORK(2*N+1), 1 )
- END IF
-*
-* End of the preparation phase (scaling, optional sorting and
-* transposing, optional flushing of small columns).
-*
-* Preconditioning
-*
-* If the full SVD is needed, the right singular vectors are computed
-* from a matrix equation, and for that we need theoretical analysis
-* of the Businger-Golub pivoting. So we use DGEQP3 as the first RR QRF.
-* In all other cases the first RR QRF can be chosen by other criteria
-* (eg speed by replacing global with restricted window pivoting, such
-* as in SGEQPX from TOMS # 782). Good results will be obtained using
-* SGEQPX with properly (!) chosen numerical parameters.
-* Any improvement of DGEQP3 improves overal performance of DGEJSV.
-*
-* A * P1 = Q1 * [ R1^t 0]^t:
- DO 1963 p = 1, N
-* .. all columns are free columns
- IWORK(p) = 0
- 1963 CONTINUE
- CALL DGEQP3( M,N,A,LDA, IWORK,WORK, WORK(N+1),LWORK-N, IERR )
-*
-* The upper triangular matrix R1 from the first QRF is inspected for
-* rank deficiency and possibilities for deflation, or possible
-* ill-conditioning. Depending on the user specified flag L2RANK,
-* the procedure explores possibilities to reduce the numerical
-* rank by inspecting the computed upper triangular factor. If
-* L2RANK or L2ABER are up, then DGEJSV will compute the SVD of
-* A + dA, where ||dA|| <= f(M,N)*EPSLN.
-*
- NR = 1
- IF ( L2ABER ) THEN
-* Standard absolute error bound suffices. All sigma_i with
-* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an
-* agressive enforcement of lower numerical rank by introducing a
-* backward error of the order of N*EPSLN*||A||.
- TEMP1 = DSQRT(DBLE(N))*EPSLN
- DO 3001 p = 2, N
- IF ( DABS(A(p,p)) .GE. (TEMP1*DABS(A(1,1))) ) THEN
- NR = NR + 1
- ELSE
- GO TO 3002
- END IF
- 3001 CONTINUE
- 3002 CONTINUE
- ELSE IF ( L2RANK ) THEN
-* .. similarly as above, only slightly more gentle (less agressive).
-* Sudden drop on the diagonal of R1 is used as the criterion for
-* close-to-rank-defficient.
- TEMP1 = DSQRT(SFMIN)
- DO 3401 p = 2, N
- IF ( ( DABS(A(p,p)) .LT. (EPSLN*DABS(A(p-1,p-1))) ) .OR.
- $ ( DABS(A(p,p)) .LT. SMALL ) .OR.
- $ ( L2KILL .AND. (DABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402
- NR = NR + 1
- 3401 CONTINUE
- 3402 CONTINUE
-*
- ELSE
-* The goal is high relative accuracy. However, if the matrix
-* has high scaled condition number the relative accuracy is in
-* general not feasible. Later on, a condition number estimator
-* will be deployed to estimate the scaled condition number.
-* Here we just remove the underflowed part of the triangular
-* factor. This prevents the situation in which the code is
-* working hard to get the accuracy not warranted by the data.
- TEMP1 = DSQRT(SFMIN)
- DO 3301 p = 2, N
- IF ( ( DABS(A(p,p)) .LT. SMALL ) .OR.
- $ ( L2KILL .AND. (DABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302
- NR = NR + 1
- 3301 CONTINUE
- 3302 CONTINUE
-*
- END IF
-*
- ALMORT = .FALSE.
- IF ( NR .EQ. N ) THEN
- MAXPRJ = ONE
- DO 3051 p = 2, N
- TEMP1 = DABS(A(p,p)) / SVA(IWORK(p))
- MAXPRJ = DMIN1( MAXPRJ, TEMP1 )
- 3051 CONTINUE
- IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE.
- END IF
-*
-*
- SCONDA = - ONE
- CONDR1 = - ONE
- CONDR2 = - ONE
-*
- IF ( ERREST ) THEN
- IF ( N .EQ. NR ) THEN
- IF ( RSVEC ) THEN
-* .. V is available as workspace
- CALL DLACPY( 'U', N, N, A, LDA, V, LDV )
- DO 3053 p = 1, N
- TEMP1 = SVA(IWORK(p))
- CALL DSCAL( p, ONE/TEMP1, V(1,p), 1 )
- 3053 CONTINUE
- CALL DPOCON( 'U', N, V, LDV, ONE, TEMP1,
- $ WORK(N+1), IWORK(2*N+M+1), IERR )
- ELSE IF ( LSVEC ) THEN
-* .. U is available as workspace
- CALL DLACPY( 'U', N, N, A, LDA, U, LDU )
- DO 3054 p = 1, N
- TEMP1 = SVA(IWORK(p))
- CALL DSCAL( p, ONE/TEMP1, U(1,p), 1 )
- 3054 CONTINUE
- CALL DPOCON( 'U', N, U, LDU, ONE, TEMP1,
- $ WORK(N+1), IWORK(2*N+M+1), IERR )
- ELSE
- CALL DLACPY( 'U', N, N, A, LDA, WORK(N+1), N )
- DO 3052 p = 1, N
- TEMP1 = SVA(IWORK(p))
- CALL DSCAL( p, ONE/TEMP1, WORK(N+(p-1)*N+1), 1 )
- 3052 CONTINUE
-* .. the columns of R are scaled to have unit Euclidean lengths.
- CALL DPOCON( 'U', N, WORK(N+1), N, ONE, TEMP1,
- $ WORK(N+N*N+1), IWORK(2*N+M+1), IERR )
- END IF
- SCONDA = ONE / DSQRT(TEMP1)
-* SCONDA is an estimate of DSQRT(||(R^t * R)^(-1)||_1).
-* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
- ELSE
- SCONDA = - ONE
- END IF
- END IF
-*
- L2PERT = L2PERT .AND. ( DABS( A(1,1)/A(NR,NR) ) .GT. DSQRT(BIG1) )
-* If there is no violent scaling, artificial perturbation is not needed.
-*
-* Phase 3:
-*
- IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN
-*
-* Singular Values only
-*
-* .. transpose A(1:NR,1:N)
- DO 1946 p = 1, MIN0( N-1, NR )
- CALL DCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 )
- 1946 CONTINUE
-*
-* The following two DO-loops introduce small relative perturbation
-* into the strict upper triangle of the lower triangular matrix.
-* Small entries below the main diagonal are also changed.
-* This modification is useful if the computing environment does not
-* provide/allow FLUSH TO ZERO underflow, for it prevents many
-* annoying denormalized numbers in case of strongly scaled matrices.
-* The perturbation is structured so that it does not introduce any
-* new perturbation of the singular values, and it does not destroy
-* the job done by the preconditioner.
-* The licence for this perturbation is in the variable L2PERT, which
-* should be .FALSE. if FLUSH TO ZERO underflow is active.
-*
- IF ( .NOT. ALMORT ) THEN
-*
- IF ( L2PERT ) THEN
-* XSC = DSQRT(SMALL)
- XSC = EPSLN / DBLE(N)
- DO 4947 q = 1, NR
- TEMP1 = XSC*DABS(A(q,q))
- DO 4949 p = 1, N
- IF ( ( (p.GT.q) .AND. (DABS(A(p,q)).LE.TEMP1) )
- $ .OR. ( p .LT. q ) )
- $ A(p,q) = DSIGN( TEMP1, A(p,q) )
- 4949 CONTINUE
- 4947 CONTINUE
- ELSE
- CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, A(1,2),LDA )
- END IF
-*
-* .. second preconditioning using the QR factorization
-*
- CALL DGEQRF( N,NR, A,LDA, WORK, WORK(N+1),LWORK-N, IERR )
-*
-* .. and transpose upper to lower triangular
- DO 1948 p = 1, NR - 1
- CALL DCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 )
- 1948 CONTINUE
-*
- END IF
-*
-* Row-cyclic Jacobi SVD algorithm with column pivoting
-*
-* .. again some perturbation (a "background noise") is added
-* to drown denormals
- IF ( L2PERT ) THEN
-* XSC = DSQRT(SMALL)
- XSC = EPSLN / DBLE(N)
- DO 1947 q = 1, NR
- TEMP1 = XSC*DABS(A(q,q))
- DO 1949 p = 1, NR
- IF ( ( (p.GT.q) .AND. (DABS(A(p,q)).LE.TEMP1) )
- $ .OR. ( p .LT. q ) )
- $ A(p,q) = DSIGN( TEMP1, A(p,q) )
- 1949 CONTINUE
- 1947 CONTINUE
- ELSE
- CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), LDA )
- END IF
-*
-* .. and one-sided Jacobi rotations are started on a lower
-* triangular matrix (plus perturbation which is ignored in
-* the part which destroys triangular form (confusing?!))
-*
- CALL DGESVJ( 'L', 'NoU', 'NoV', NR, NR, A, LDA, SVA,
- $ N, V, LDV, WORK, LWORK, INFO )
-*
- SCALEM = WORK(1)
- NUMRANK = IDNINT(WORK(2))
-*
-*
- ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN
-*
-* -> Singular Values and Right Singular Vectors <-
-*
- IF ( ALMORT ) THEN
-*
-* .. in this case NR equals N
- DO 1998 p = 1, NR
- CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
- 1998 CONTINUE
- CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
-*
- CALL DGESVJ( 'L','U','N', N, NR, V,LDV, SVA, NR, A,LDA,
- $ WORK, LWORK, INFO )
- SCALEM = WORK(1)
- NUMRANK = IDNINT(WORK(2))
-
- ELSE
-*
-* .. two more QR factorizations ( one QRF is not enough, two require
-* accumulated product of Jacobi rotations, three are perfect )
-*
- CALL DLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), LDA )
- CALL DGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, IERR)
- CALL DLACPY( 'Lower', NR, NR, A, LDA, V, LDV )
- CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
- CALL DGEQRF( NR, NR, V, LDV, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
- DO 8998 p = 1, NR
- CALL DCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 )
- 8998 CONTINUE
- CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
-*
- CALL DGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U,
- $ LDU, WORK(N+1), LWORK, INFO )
- SCALEM = WORK(N+1)
- NUMRANK = IDNINT(WORK(N+2))
- IF ( NR .LT. N ) THEN
- CALL DLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), LDV )
- CALL DLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), LDV )
- CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), LDV )
- END IF
-*
- CALL DORMLQ( 'Left', 'Transpose', N, N, NR, A, LDA, WORK,
- $ V, LDV, WORK(N+1), LWORK-N, IERR )
-*
- END IF
-*
- DO 8991 p = 1, N
- CALL DCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA )
- 8991 CONTINUE
- CALL DLACPY( 'All', N, N, A, LDA, V, LDV )
-*
- IF ( TRANSP ) THEN
- CALL DLACPY( 'All', N, N, V, LDV, U, LDU )
- END IF
-*
- ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN
-*
-* .. Singular Values and Left Singular Vectors ..
-*
-* .. second preconditioning step to avoid need to accumulate
-* Jacobi rotations in the Jacobi iterations.
- DO 1965 p = 1, NR
- CALL DCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 )
- 1965 CONTINUE
- CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU )
-*
- CALL DGEQRF( N, NR, U, LDU, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
-*
- DO 1967 p = 1, NR - 1
- CALL DCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 )
- 1967 CONTINUE
- CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU )
-*
- CALL DGESVJ( 'Lower', 'U', 'N', NR,NR, U, LDU, SVA, NR, A,
- $ LDA, WORK(N+1), LWORK-N, INFO )
- SCALEM = WORK(N+1)
- NUMRANK = IDNINT(WORK(N+2))
-*
- IF ( NR .LT. M ) THEN
- CALL DLASET( 'A', M-NR, NR,ZERO, ZERO, U(NR+1,1), LDU )
- IF ( NR .LT. N1 ) THEN
- CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), LDU )
- CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), LDU )
- END IF
- END IF
-*
- CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
-*
- IF ( ROWPIV )
- $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
- DO 1974 p = 1, N1
- XSC = ONE / DNRM2( M, U(1,p), 1 )
- CALL DSCAL( M, XSC, U(1,p), 1 )
- 1974 CONTINUE
-*
- IF ( TRANSP ) THEN
- CALL DLACPY( 'All', N, N, U, LDU, V, LDV )
- END IF
-*
- ELSE
-*
-* .. Full SVD ..
-*
- IF ( .NOT. JRACC ) THEN
-*
- IF ( .NOT. ALMORT ) THEN
-*
-* Second Preconditioning Step (QRF [with pivoting])
-* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is
-* equivalent to an LQF CALL. Since in many libraries the QRF
-* seems to be better optimized than the LQF, we do explicit
-* transpose and use the QRF. This is subject to changes in an
-* optimized implementation of DGEJSV.
-*
- DO 1968 p = 1, NR
- CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
- 1968 CONTINUE
-*
-* .. the following two loops perturb small entries to avoid
-* denormals in the second QR factorization, where they are
-* as good as zeros. This is done to avoid painfully slow
-* computation with denormals. The relative size of the perturbation
-* is a parameter that can be changed by the implementer.
-* This perturbation device will be obsolete on machines with
-* properly implemented arithmetic.
-* To switch it off, set L2PERT=.FALSE. To remove it from the
-* code, remove the action under L2PERT=.TRUE., leave the ELSE part.
-* The following two loops should be blocked and fused with the
-* transposed copy above.
-*
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL)
- DO 2969 q = 1, NR
- TEMP1 = XSC*DABS( V(q,q) )
- DO 2968 p = 1, N
- IF ( ( p .GT. q ) .AND. ( DABS(V(p,q)) .LE. TEMP1 )
- $ .OR. ( p .LT. q ) )
- $ V(p,q) = DSIGN( TEMP1, V(p,q) )
- IF ( p .LT. q ) V(p,q) = - V(p,q)
- 2968 CONTINUE
- 2969 CONTINUE
- ELSE
- CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
- END IF
-*
-* Estimate the row scaled condition number of R1
-* (If R1 is rectangular, N > NR, then the condition number
-* of the leading NR x NR submatrix is estimated.)
-*
- CALL DLACPY( 'L', NR, NR, V, LDV, WORK(2*N+1), NR )
- DO 3950 p = 1, NR
- TEMP1 = DNRM2(NR-p+1,WORK(2*N+(p-1)*NR+p),1)
- CALL DSCAL(NR-p+1,ONE/TEMP1,WORK(2*N+(p-1)*NR+p),1)
- 3950 CONTINUE
- CALL DPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1,
- $ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR)
- CONDR1 = ONE / DSQRT(TEMP1)
-* .. here need a second oppinion on the condition number
-* .. then assume worst case scenario
-* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N)
-* more conservative <=> CONDR1 .LT. DSQRT(DBLE(N))
-*
- COND_OK = DSQRT(DBLE(NR))
-*[TP] COND_OK is a tuning parameter.
-
- IF ( CONDR1 .LT. COND_OK ) THEN
-* .. the second QRF without pivoting. Note: in an optimized
-* implementation, this QRF should be implemented as the QRF
-* of a lower triangular matrix.
-* R1^t = Q2 * R2
- CALL DGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
-*
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL)/EPSLN
- DO 3959 p = 2, NR
- DO 3958 q = 1, p - 1
- TEMP1 = XSC * DMIN1(DABS(V(p,p)),DABS(V(q,q)))
- IF ( DABS(V(q,p)) .LE. TEMP1 )
- $ V(q,p) = DSIGN( TEMP1, V(q,p) )
- 3958 CONTINUE
- 3959 CONTINUE
- END IF
-*
- IF ( NR .NE. N )
- $ CALL DLACPY( 'A', N, NR, V, LDV, WORK(2*N+1), N )
-* .. save ...
-*
-* .. this transposed copy should be better than naive
- DO 1969 p = 1, NR - 1
- CALL DCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 )
- 1969 CONTINUE
-*
- CONDR2 = CONDR1
-*
- ELSE
-*
-* .. ill-conditioned case: second QRF with pivoting
-* Note that windowed pivoting would be equaly good
-* numerically, and more run-time efficient. So, in
-* an optimal implementation, the next call to DGEQP3
-* should be replaced with eg. CALL SGEQPX (ACM TOMS #782)
-* with properly (carefully) chosen parameters.
-*
-* R1^t * P2 = Q2 * R2
- DO 3003 p = 1, NR
- IWORK(N+p) = 0
- 3003 CONTINUE
- CALL DGEQP3( N, NR, V, LDV, IWORK(N+1), WORK(N+1),
- $ WORK(2*N+1), LWORK-2*N, IERR )
-** CALL DGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1),
-** $ LWORK-2*N, IERR )
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL)
- DO 3969 p = 2, NR
- DO 3968 q = 1, p - 1
- TEMP1 = XSC * DMIN1(DABS(V(p,p)),DABS(V(q,q)))
- IF ( DABS(V(q,p)) .LE. TEMP1 )
- $ V(q,p) = DSIGN( TEMP1, V(q,p) )
- 3968 CONTINUE
- 3969 CONTINUE
- END IF
-*
- CALL DLACPY( 'A', N, NR, V, LDV, WORK(2*N+1), N )
-*
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL)
- DO 8970 p = 2, NR
- DO 8971 q = 1, p - 1
- TEMP1 = XSC * DMIN1(DABS(V(p,p)),DABS(V(q,q)))
- V(p,q) = - DSIGN( TEMP1, V(q,p) )
- 8971 CONTINUE
- 8970 CONTINUE
- ELSE
- CALL DLASET( 'L',NR-1,NR-1,ZERO,ZERO,V(2,1),LDV )
- END IF
-* Now, compute R2 = L3 * Q3, the LQ factorization.
- CALL DGELQF( NR, NR, V, LDV, WORK(2*N+N*NR+1),
- $ WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR )
-* .. and estimate the condition number
- CALL DLACPY( 'L',NR,NR,V,LDV,WORK(2*N+N*NR+NR+1),NR )
- DO 4950 p = 1, NR
- TEMP1 = DNRM2( p, WORK(2*N+N*NR+NR+p), NR )
- CALL DSCAL( p, ONE/TEMP1, WORK(2*N+N*NR+NR+p), NR )
- 4950 CONTINUE
- CALL DPOCON( 'L',NR,WORK(2*N+N*NR+NR+1),NR,ONE,TEMP1,
- $ WORK(2*N+N*NR+NR+NR*NR+1),IWORK(M+2*N+1),IERR )
- CONDR2 = ONE / DSQRT(TEMP1)
-*
- IF ( CONDR2 .GE. COND_OK ) THEN
-* .. save the Householder vectors used for Q3
-* (this overwrittes the copy of R2, as it will not be
-* needed in this branch, but it does not overwritte the
-* Huseholder vectors of Q2.).
- CALL DLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N )
-* .. and the rest of the information on Q3 is in
-* WORK(2*N+N*NR+1:2*N+N*NR+N)
- END IF
-*
- END IF
-*
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL)
- DO 4968 q = 2, NR
- TEMP1 = XSC * V(q,q)
- DO 4969 p = 1, q - 1
-* V(p,q) = - DSIGN( TEMP1, V(q,p) )
- V(p,q) = - DSIGN( TEMP1, V(p,q) )
- 4969 CONTINUE
- 4968 CONTINUE
- ELSE
- CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV )
- END IF
-*
-* Second preconditioning finished; continue with Jacobi SVD
-* The input matrix is lower trinagular.
-*
-* Recover the right singular vectors as solution of a well
-* conditioned triangular matrix equation.
-*
- IF ( CONDR1 .LT. COND_OK ) THEN
-*
- CALL DGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U,
- $ LDU,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,INFO )
- SCALEM = WORK(2*N+N*NR+NR+1)
- NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2))
- DO 3970 p = 1, NR
- CALL DCOPY( NR, V(1,p), 1, U(1,p), 1 )
- CALL DSCAL( NR, SVA(p), V(1,p), 1 )
- 3970 CONTINUE
-
-* .. pick the right matrix equation and solve it
-*
- IF ( NR .EQ. N ) THEN
-* :)) .. best case, R1 is inverted. The solution of this matrix
-* equation is Q2*V2 = the product of the Jacobi rotations
-* used in DGESVJ, premultiplied with the orthogonal matrix
-* from the second QR factorization.
- CALL DTRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V,LDV )
- ELSE
-* .. R1 is well conditioned, but non-square. Transpose(R2)
-* is inverted to get the product of the Jacobi rotations
-* used in DGESVJ. The Q-factor from the second QR
-* factorization is then built in explicitly.
- CALL DTRSM('L','U','T','N',NR,NR,ONE,WORK(2*N+1),
- $ N,V,LDV)
- IF ( NR .LT. N ) THEN
- CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV)
- CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV)
- CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV)
- END IF
- CALL DORMQR('L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR)
- END IF
-*
- ELSE IF ( CONDR2 .LT. COND_OK ) THEN
-*
-* :) .. the input matrix A is very likely a relative of
-* the Kahan matrix :)
-* The matrix R2 is inverted. The solution of the matrix equation
-* is Q3^T*V3 = the product of the Jacobi rotations (appplied to
-* the lower triangular L3 from the LQ factorization of
-* R2=L3*Q3), pre-multiplied with the transposed Q3.
- CALL DGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U,
- $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO )
- SCALEM = WORK(2*N+N*NR+NR+1)
- NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2))
- DO 3870 p = 1, NR
- CALL DCOPY( NR, V(1,p), 1, U(1,p), 1 )
- CALL DSCAL( NR, SVA(p), U(1,p), 1 )
- 3870 CONTINUE
- CALL DTRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U,LDU)
-* .. apply the permutation from the second QR factorization
- DO 873 q = 1, NR
- DO 872 p = 1, NR
- WORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
- 872 CONTINUE
- DO 874 p = 1, NR
- U(p,q) = WORK(2*N+N*NR+NR+p)
- 874 CONTINUE
- 873 CONTINUE
- IF ( NR .LT. N ) THEN
- CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV )
- CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV )
- CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV )
- END IF
- CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
- ELSE
-* Last line of defense.
-* #:( This is a rather pathological case: no scaled condition
-* improvement after two pivoted QR factorizations. Other
-* possibility is that the rank revealing QR factorization
-* or the condition estimator has failed, or the COND_OK
-* is set very close to ONE (which is unnecessary). Normally,
-* this branch should never be executed, but in rare cases of
-* failure of the RRQR or condition estimator, the last line of
-* defense ensures that DGEJSV completes the task.
-* Compute the full SVD of L3 using DGESVJ with explicit
-* accumulation of Jacobi rotations.
- CALL DGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U,
- $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO )
- SCALEM = WORK(2*N+N*NR+NR+1)
- NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2))
- IF ( NR .LT. N ) THEN
- CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV )
- CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV )
- CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV )
- END IF
- CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
-*
- CALL DORMLQ( 'L', 'T', NR, NR, NR, WORK(2*N+1), N,
- $ WORK(2*N+N*NR+1), U, LDU, WORK(2*N+N*NR+NR+1),
- $ LWORK-2*N-N*NR-NR, IERR )
- DO 773 q = 1, NR
- DO 772 p = 1, NR
- WORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
- 772 CONTINUE
- DO 774 p = 1, NR
- U(p,q) = WORK(2*N+N*NR+NR+p)
- 774 CONTINUE
- 773 CONTINUE
-*
- END IF
-*
-* Permute the rows of V using the (column) permutation from the
-* first QRF. Also, scale the columns to make them unit in
-* Euclidean norm. This applies to all cases.
-*
- TEMP1 = DSQRT(DBLE(N)) * EPSLN
- DO 1972 q = 1, N
- DO 972 p = 1, N
- WORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
- 972 CONTINUE
- DO 973 p = 1, N
- V(p,q) = WORK(2*N+N*NR+NR+p)
- 973 CONTINUE
- XSC = ONE / DNRM2( N, V(1,q), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL DSCAL( N, XSC, V(1,q), 1 )
- 1972 CONTINUE
-* At this moment, V contains the right singular vectors of A.
-* Next, assemble the left singular vector matrix U (M x N).
- IF ( NR .LT. M ) THEN
- CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU )
- IF ( NR .LT. N1 ) THEN
- CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU)
- CALL DLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1),LDU)
- END IF
- END IF
-*
-* The Q matrix from the first QRF is built into the left singular
-* matrix U. This applies to all cases.
-*
- CALL DORMQR( 'Left', 'No_Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
-
-* The columns of U are normalized. The cost is O(M*N) flops.
- TEMP1 = DSQRT(DBLE(M)) * EPSLN
- DO 1973 p = 1, NR
- XSC = ONE / DNRM2( M, U(1,p), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL DSCAL( M, XSC, U(1,p), 1 )
- 1973 CONTINUE
-*
-* If the initial QRF is computed with row pivoting, the left
-* singular vectors must be adjusted.
-*
- IF ( ROWPIV )
- $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
- ELSE
-*
-* .. the initial matrix A has almost orthogonal columns and
-* the second QRF is not needed
-*
- CALL DLACPY( 'Upper', N, N, A, LDA, WORK(N+1), N )
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL)
- DO 5970 p = 2, N
- TEMP1 = XSC * WORK( N + (p-1)*N + p )
- DO 5971 q = 1, p - 1
- WORK(N+(q-1)*N+p)=-DSIGN(TEMP1,WORK(N+(p-1)*N+q))
- 5971 CONTINUE
- 5970 CONTINUE
- ELSE
- CALL DLASET( 'Lower',N-1,N-1,ZERO,ZERO,WORK(N+2),N )
- END IF
-*
- CALL DGESVJ( 'Upper', 'U', 'N', N, N, WORK(N+1), N, SVA,
- $ N, U, LDU, WORK(N+N*N+1), LWORK-N-N*N, INFO )
-*
- SCALEM = WORK(N+N*N+1)
- NUMRANK = IDNINT(WORK(N+N*N+2))
- DO 6970 p = 1, N
- CALL DCOPY( N, WORK(N+(p-1)*N+1), 1, U(1,p), 1 )
- CALL DSCAL( N, SVA(p), WORK(N+(p-1)*N+1), 1 )
- 6970 CONTINUE
-*
- CALL DTRSM( 'Left', 'Upper', 'NoTrans', 'No UD', N, N,
- $ ONE, A, LDA, WORK(N+1), N )
- DO 6972 p = 1, N
- CALL DCOPY( N, WORK(N+p), N, V(IWORK(p),1), LDV )
- 6972 CONTINUE
- TEMP1 = DSQRT(DBLE(N))*EPSLN
- DO 6971 p = 1, N
- XSC = ONE / DNRM2( N, V(1,p), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL DSCAL( N, XSC, V(1,p), 1 )
- 6971 CONTINUE
-*
-* Assemble the left singular vector matrix U (M x N).
-*
- IF ( N .LT. M ) THEN
- CALL DLASET( 'A', M-N, N, ZERO, ZERO, U(N+1,1), LDU )
- IF ( N .LT. N1 ) THEN
- CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU )
- CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU )
- END IF
- END IF
- CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
- TEMP1 = DSQRT(DBLE(M))*EPSLN
- DO 6973 p = 1, N1
- XSC = ONE / DNRM2( M, U(1,p), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL DSCAL( M, XSC, U(1,p), 1 )
- 6973 CONTINUE
-*
- IF ( ROWPIV )
- $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
- END IF
-*
-* end of the >> almost orthogonal case << in the full SVD
-*
- ELSE
-*
-* This branch deploys a preconditioned Jacobi SVD with explicitly
-* accumulated rotations. It is included as optional, mainly for
-* experimental purposes. It does perfom well, and can also be used.
-* In this implementation, this branch will be automatically activated
-* if the condition number sigma_max(A) / sigma_min(A) is predicted
-* to be greater than the overflow threshold. This is because the
-* a posteriori computation of the singular vectors assumes robust
-* implementation of BLAS and some LAPACK procedures, capable of working
-* in presence of extreme values. Since that is not always the case, ...
-*
- DO 7968 p = 1, NR
- CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
- 7968 CONTINUE
-*
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL/EPSLN)
- DO 5969 q = 1, NR
- TEMP1 = XSC*DABS( V(q,q) )
- DO 5968 p = 1, N
- IF ( ( p .GT. q ) .AND. ( DABS(V(p,q)) .LE. TEMP1 )
- $ .OR. ( p .LT. q ) )
- $ V(p,q) = DSIGN( TEMP1, V(p,q) )
- IF ( p .LT. q ) V(p,q) = - V(p,q)
- 5968 CONTINUE
- 5969 CONTINUE
- ELSE
- CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
- END IF
-
- CALL DGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
- CALL DLACPY( 'L', N, NR, V, LDV, WORK(2*N+1), N )
-*
- DO 7969 p = 1, NR
- CALL DCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 )
- 7969 CONTINUE
-
- IF ( L2PERT ) THEN
- XSC = DSQRT(SMALL/EPSLN)
- DO 9970 q = 2, NR
- DO 9971 p = 1, q - 1
- TEMP1 = XSC * DMIN1(DABS(U(p,p)),DABS(U(q,q)))
- U(p,q) = - DSIGN( TEMP1, U(q,p) )
- 9971 CONTINUE
- 9970 CONTINUE
- ELSE
- CALL DLASET('U', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU )
- END IF
-
- CALL DGESVJ( 'G', 'U', 'V', NR, NR, U, LDU, SVA,
- $ N, V, LDV, WORK(2*N+N*NR+1), LWORK-2*N-N*NR, INFO )
- SCALEM = WORK(2*N+N*NR+1)
- NUMRANK = IDNINT(WORK(2*N+N*NR+2))
-
- IF ( NR .LT. N ) THEN
- CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV )
- CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV )
- CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV )
- END IF
-
- CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
-*
-* Permute the rows of V using the (column) permutation from the
-* first QRF. Also, scale the columns to make them unit in
-* Euclidean norm. This applies to all cases.
-*
- TEMP1 = DSQRT(DBLE(N)) * EPSLN
- DO 7972 q = 1, N
- DO 8972 p = 1, N
- WORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
- 8972 CONTINUE
- DO 8973 p = 1, N
- V(p,q) = WORK(2*N+N*NR+NR+p)
- 8973 CONTINUE
- XSC = ONE / DNRM2( N, V(1,q), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL DSCAL( N, XSC, V(1,q), 1 )
- 7972 CONTINUE
-*
-* At this moment, V contains the right singular vectors of A.
-* Next, assemble the left singular vector matrix U (M x N).
-*
- IF ( NR .LT. M ) THEN
- CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU )
- IF ( NR .LT. N1 ) THEN
- CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1),LDU )
- CALL DLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU )
- END IF
- END IF
-*
- CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
-*
- IF ( ROWPIV )
- $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
-*
- END IF
- IF ( TRANSP ) THEN
-* .. swap U and V because the procedure worked on A^t
- DO 6974 p = 1, N
- CALL DSWAP( N, U(1,p), 1, V(1,p), 1 )
- 6974 CONTINUE
- END IF
-*
- END IF
-* end of the full SVD
-*
-* Undo scaling, if necessary (and possible)
-*
- IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN
- CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR )
- USCAL1 = ONE
- USCAL2 = ONE
- END IF
-*
- IF ( NR .LT. N ) THEN
- DO 3004 p = NR+1, N
- SVA(p) = ZERO
- 3004 CONTINUE
- END IF
-*
- WORK(1) = USCAL2 * SCALEM
- WORK(2) = USCAL1
- IF ( ERREST ) WORK(3) = SCONDA
- IF ( LSVEC .AND. RSVEC ) THEN
- WORK(4) = CONDR1
- WORK(5) = CONDR2
- END IF
- IF ( L2TRAN ) THEN
- WORK(6) = ENTRA
- WORK(7) = ENTRAT
- END IF
-*
- IWORK(1) = NR
- IWORK(2) = NUMRANK
- IWORK(3) = WARNING
-*
- RETURN
-* ..
-* .. END OF DGEJSV
-* ..
- END
-*
diff --git a/netlib/LAPACK/dgelq2.f b/netlib/LAPACK/dgelq2.f
deleted file mode 100644
index 0d64ba5..0000000
--- a/netlib/LAPACK/dgelq2.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b DGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELQ2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelq2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelq2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelq2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELQ2 computes an LQ factorization of a real m by n matrix A:
-*> A = L * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and below the diagonal of the array
-*> contain the m by min(m,n) lower trapezoidal matrix L (L is
-*> lower triangular if m <= n); the elements above the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELQ2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i,i+1:n)
-*
- CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAU( I ) )
- IF( I.LT.M ) THEN
-*
-* Apply H(i) to A(i+1:m,i:n) from the right
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
- $ A( I+1, I ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGELQ2
-*
- END
diff --git a/netlib/LAPACK/dgelqf.f b/netlib/LAPACK/dgelqf.f
deleted file mode 100644
index d27b04a..0000000
--- a/netlib/LAPACK/dgelqf.f
+++ /dev/null
@@ -1,269 +0,0 @@
-*> \brief \b DGELQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELQF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELQF computes an LQ factorization of a real M-by-N matrix A:
-*> A = L * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and below the diagonal of the array
-*> contain the m-by-min(m,n) lower trapezoidal matrix L (L is
-*> lower triangular if m <= n); the elements above the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGELQ2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGELQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGELQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the LQ factorization of the current block
-* A(i:i+ib-1,i:n)
-*
- CALL DGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.M ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(i+ib:m,i:n) from the right
-*
- CALL DLARFB( 'Right', 'No transpose', 'Forward',
- $ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
- $ LDA, WORK, LDWORK, A( I+IB, I ), LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL DGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGELQF
-*
- END
diff --git a/netlib/LAPACK/dgels.f b/netlib/LAPACK/dgels.f
deleted file mode 100644
index 3d3cb88..0000000
--- a/netlib/LAPACK/dgels.f
+++ /dev/null
@@ -1,504 +0,0 @@
-*> \brief <b> DGELS solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgels.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgels.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgels.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, or its transpose, using a QR or LQ
-*> factorization of A. It is assumed that A has full rank.
-*>
-*> The following options are provided:
-*>
-*> 1. If TRANS = 'N' and m >= n: find the least squares solution of
-*> an overdetermined system, i.e., solve the least squares problem
-*> minimize || B - A*X ||.
-*>
-*> 2. If TRANS = 'N' and m < n: find the minimum norm solution of
-*> an underdetermined system A * X = B.
-*>
-*> 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
-*> an undetermined system A**T * X = B.
-*>
-*> 4. If TRANS = 'T' and m < n: find the least squares solution of
-*> an overdetermined system, i.e., solve the least squares problem
-*> minimize || B - A**T * X ||.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': the linear system involves A;
-*> = 'T': the linear system involves A**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of
-*> columns of the matrices B and X. NRHS >=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if M >= N, A is overwritten by details of its QR
-*> factorization as returned by DGEQRF;
-*> if M < N, A is overwritten by details of its LQ
-*> factorization as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the matrix B of right hand side vectors, stored
-*> columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
-*> if TRANS = 'T'.
-*> On exit, if INFO = 0, B is overwritten by the solution
-*> vectors, stored columnwise:
-*> if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
-*> squares solution vectors; the residual sum of squares for the
-*> solution in each column is given by the sum of squares of
-*> elements N+1 to M in that column;
-*> if TRANS = 'N' and m < n, rows 1 to N of B contain the
-*> minimum norm solution vectors;
-*> if TRANS = 'T' and m >= n, rows 1 to M of B contain the
-*> minimum norm solution vectors;
-*> if TRANS = 'T' and m < n, rows 1 to M of B contain the
-*> least squares solution vectors; the residual sum of squares
-*> for the solution in each column is given by the sum of
-*> squares of elements M+1 to N in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= MAX(1,M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= max( 1, MN + max( MN, NRHS ) ).
-*> For optimal performance,
-*> LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
-*> where MN = min(M,N) and NB is the optimum block size.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of the
-*> triangular factor of A is zero, so that A does not have
-*> full rank; the least squares solution could not be
-*> computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, TPSD
- INTEGER BROW, I, IASCL, IBSCL, J, MN, NB, SCLLEN, WSIZE
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION RWORK( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DGELQF, DGEQRF, DLASCL, DLASET, DORMLQ, DORMQR,
- $ DTRTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.MAX( 1, MN+MAX( MN, NRHS ) ) .AND. .NOT.LQUERY )
- $ THEN
- INFO = -10
- END IF
-*
-* Figure out optimal block size
-*
- IF( INFO.EQ.0 .OR. INFO.EQ.-10 ) THEN
-*
- TPSD = .TRUE.
- IF( LSAME( TRANS, 'N' ) )
- $ TPSD = .FALSE.
-*
- IF( M.GE.N ) THEN
- NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- IF( TPSD ) THEN
- NB = MAX( NB, ILAENV( 1, 'DORMQR', 'LN', M, NRHS, N,
- $ -1 ) )
- ELSE
- NB = MAX( NB, ILAENV( 1, 'DORMQR', 'LT', M, NRHS, N,
- $ -1 ) )
- END IF
- ELSE
- NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- IF( TPSD ) THEN
- NB = MAX( NB, ILAENV( 1, 'DORMLQ', 'LT', N, NRHS, M,
- $ -1 ) )
- ELSE
- NB = MAX( NB, ILAENV( 1, 'DORMLQ', 'LN', N, NRHS, M,
- $ -1 ) )
- END IF
- END IF
-*
- WSIZE = MAX( 1, MN+MAX( MN, NRHS )*NB )
- WORK( 1 ) = DBLE( WSIZE )
-*
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELS ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- CALL DLASET( 'Full', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- RETURN
- END IF
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Scale A, B if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, RWORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- GO TO 50
- END IF
-*
- BROW = M
- IF( TPSD )
- $ BROW = N
- BNRM = DLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, 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, BROW, NRHS, B, LDB,
- $ INFO )
- IBSCL = 2
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* compute QR factorization of A
-*
- CALL DGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least N, optimally N*NB
-*
- IF( .NOT.TPSD ) THEN
-*
-* Least-Squares Problem min || A * X - B ||
-*
-* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
-*
- CALL DORMQR( 'Left', 'Transpose', M, NRHS, N, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
-* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
-*
- CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
- SCLLEN = N
-*
- ELSE
-*
-* Overdetermined system of equations A**T * X = B
-*
-* B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
-*
- CALL DTRTRS( 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
-* B(N+1:M,1:NRHS) = ZERO
-*
- DO 20 J = 1, NRHS
- DO 10 I = N + 1, M
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
-*
- CALL DORMQR( 'Left', 'No transpose', M, NRHS, N, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
- SCLLEN = M
-*
- END IF
-*
- ELSE
-*
-* Compute LQ factorization of A
-*
- CALL DGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least M, optimally M*NB.
-*
- IF( .NOT.TPSD ) THEN
-*
-* underdetermined system of equations A * X = B
-*
-* B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
-*
- CALL DTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
-* B(M+1:N,1:NRHS) = 0
-*
- DO 40 J = 1, NRHS
- DO 30 I = M + 1, N
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
-*
- CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
- SCLLEN = N
-*
- ELSE
-*
-* overdetermined system min || A**T * X - B ||
-*
-* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
-*
- CALL DORMLQ( 'Left', 'No transpose', N, NRHS, M, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
-* B(1:M,1:NRHS) := inv(L**T) * B(1:M,1:NRHS)
-*
- CALL DTRTRS( 'Lower', 'Transpose', 'Non-unit', M, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
- SCLLEN = M
-*
- END IF
-*
- END IF
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- ELSE IF( IASCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- END IF
- IF( IBSCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- END IF
-*
- 50 CONTINUE
- WORK( 1 ) = DBLE( WSIZE )
-*
- RETURN
-*
-* End of DGELS
-*
- END
diff --git a/netlib/LAPACK/dgelsd.f b/netlib/LAPACK/dgelsd.f
deleted file mode 100644
index 7629071..0000000
--- a/netlib/LAPACK/dgelsd.f
+++ /dev/null
@@ -1,629 +0,0 @@
-*> \brief <b> DGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
-* WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELSD computes the minimum-norm solution to a real linear least
-*> squares problem:
-*> minimize 2-norm(| b - A*x |)
-*> using the singular value decomposition (SVD) of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*>
-*> The problem is solved in three steps:
-*> (1) Reduce the coefficient matrix A to bidiagonal form with
-*> Householder transformations, reducing the original problem
-*> into a "bidiagonal least squares problem" (BLS)
-*> (2) Solve the BLS using a divide and conquer approach.
-*> (3) Apply back all the Householder tranformations to solve
-*> the original least squares problem.
-*>
-*> The effective rank of A is determined by treating as zero those
-*> singular values which are less than RCOND times the largest singular
-*> value.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A has been destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, B is overwritten by the N-by-NRHS solution
-*> matrix X. If m >= n and RANK = n, the residual
-*> sum-of-squares for the solution in the i-th column is given
-*> by the sum of squares of elements n+1:m in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,max(M,N)).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (min(M,N))
-*> The singular values of A in decreasing order.
-*> The condition number of A in the 2-norm = S(1)/S(min(m,n)).
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> RCOND is used to determine the effective rank of A.
-*> Singular values S(i) <= RCOND*S(1) are treated as zero.
-*> If RCOND < 0, machine precision is used instead.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the number of singular values
-*> which are greater than RCOND*S(1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK must be at least 1.
-*> The exact minimum amount of workspace needed depends on M,
-*> N and NRHS. As long as LWORK is at least
-*> 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
-*> if M is greater than or equal to N or
-*> 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
-*> if M is less than N, the code will execute correctly.
-*> SMLSIZ is returned by ILAENV and is equal to the maximum
-*> size of the subproblems at the bottom of the computation
-*> tree (usually about 25), and
-*> NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> LIWORK >= max(1, 3 * MINMN * NLVL + 11 * MINMN),
-*> where MINMN = MIN( M,N ).
-*> On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: the algorithm for computing the SVD failed to converge;
-*> if INFO = i, i off-diagonal elements of an intermediate
-*> bidiagonal form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
- $ WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
- $ LDWORK, LIWORK, MAXMN, MAXWRK, MINMN, MINWRK,
- $ MM, MNTHR, NLVL, NWORK, SMLSIZ, WLALSD
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEBRD, DGELQF, DGEQRF, DLABAD, DLACPY, DLALSD,
- $ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, INT, LOG, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- MINMN = MIN( M, N )
- MAXMN = MAX( M, N )
- MNTHR = ILAENV( 6, 'DGELSD', ' ', M, N, NRHS, -1 )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, MAXMN ) ) THEN
- INFO = -7
- END IF
-*
- SMLSIZ = ILAENV( 9, 'DGELSD', ' ', 0, 0, 0, 0 )
-*
-* Compute workspace.
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- MINWRK = 1
- LIWORK = 1
- MINMN = MAX( 1, MINMN )
- NLVL = MAX( INT( LOG( DBLE( MINMN ) / DBLE( SMLSIZ+1 ) ) /
- $ LOG( TWO ) ) + 1, 0 )
-*
- IF( INFO.EQ.0 ) THEN
- MAXWRK = 0
- LIWORK = 3*MINMN*NLVL + 11*MINMN
- MM = M
- IF( M.GE.N .AND. M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than columns.
-*
- MM = N
- MAXWRK = MAX( MAXWRK, N+N*ILAENV( 1, 'DGEQRF', ' ', M, N,
- $ -1, -1 ) )
- MAXWRK = MAX( MAXWRK, N+NRHS*
- $ ILAENV( 1, 'DORMQR', 'LT', M, NRHS, N, -1 ) )
- END IF
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined.
-*
- MAXWRK = MAX( MAXWRK, 3*N+( MM+N )*
- $ ILAENV( 1, 'DGEBRD', ' ', MM, N, -1, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*N+NRHS*
- $ ILAENV( 1, 'DORMBR', 'QLT', MM, NRHS, N, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
- $ ILAENV( 1, 'DORMBR', 'PLN', N, NRHS, N, -1 ) )
- WLALSD = 9*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS+(SMLSIZ+1)**2
- MAXWRK = MAX( MAXWRK, 3*N+WLALSD )
- MINWRK = MAX( 3*N+MM, 3*N+NRHS, 3*N+WLALSD )
- END IF
- IF( N.GT.M ) THEN
- WLALSD = 9*M+2*M*SMLSIZ+8*M*NLVL+M*NRHS+(SMLSIZ+1)**2
- IF( N.GE.MNTHR ) THEN
-*
-* Path 2a - underdetermined, with many more columns
-* than rows.
-*
- MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- MAXWRK = MAX( MAXWRK, M*M+4*M+2*M*
- $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M+4*M+NRHS*
- $ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M+4*M+( M-1 )*
- $ ILAENV( 1, 'DORMBR', 'PLN', M, NRHS, M, -1 ) )
- IF( NRHS.GT.1 ) THEN
- MAXWRK = MAX( MAXWRK, M*M+M+M*NRHS )
- ELSE
- MAXWRK = MAX( MAXWRK, M*M+2*M )
- END IF
- MAXWRK = MAX( MAXWRK, M+NRHS*
- $ ILAENV( 1, 'DORMLQ', 'LT', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M+4*M+WLALSD )
-! XXX: Ensure the Path 2a case below is triggered. The workspace
-! calculation should use queries for all routines eventually.
- MAXWRK = MAX( MAXWRK,
- $ 4*M+M*M+MAX( M, 2*M-4, NRHS, N-3*M ) )
- ELSE
-*
-* Path 2 - remaining underdetermined cases.
-*
- MAXWRK = 3*M + ( N+M )*ILAENV( 1, 'DGEBRD', ' ', M, N,
- $ -1, -1 )
- MAXWRK = MAX( MAXWRK, 3*M+NRHS*
- $ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, N, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PLN', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*M+WLALSD )
- END IF
- MINWRK = MAX( 3*M+NRHS, 3*M+M, 3*M+WLALSD )
- END IF
- MINWRK = MIN( MINWRK, MAXWRK )
- WORK( 1 ) = MAXWRK
- IWORK( 1 ) = LIWORK
-
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELSD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- GO TO 10
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters.
-*
- EPS = DLAMCH( 'P' )
- SFMIN = DLAMCH( 'S' )
- SMLNUM = SFMIN / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Scale A if max entry outside range [SMLNUM,BIGNUM].
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM.
-*
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM.
-*
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- CALL DLASET( 'F', MINMN, 1, ZERO, ZERO, S, 1 )
- RANK = 0
- GO TO 10
- END IF
-*
-* Scale B if max entry outside range [SMLNUM,BIGNUM].
-*
- BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM.
-*
- 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 )
- IBSCL = 2
- END IF
-*
-* If M < N make sure certain entries of B are zero.
-*
- IF( M.LT.N )
- $ CALL DLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
-*
-* Overdetermined case.
-*
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined.
-*
- MM = M
- IF( M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than columns.
-*
- MM = N
- ITAU = 1
- NWORK = ITAU + N
-*
-* Compute A=Q*R.
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Multiply B by transpose(Q).
-* (Workspace: need N+NRHS, prefer N+NRHS*NB)
-*
- CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
-* Zero out below R.
-*
- IF( N.GT.1 ) THEN
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- END IF
- END IF
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in A.
-* (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
-*
- CALL DGEBRD( MM, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of R.
-* (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
-*
- CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
-* Solve the bidiagonal least squares problem.
-*
- CALL DLALSD( 'U', SMLSIZ, N, NRHS, S, WORK( IE ), B, LDB,
- $ RCOND, RANK, WORK( NWORK ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- GO TO 10
- END IF
-*
-* Multiply B by right bidiagonalizing vectors of R.
-*
- CALL DORMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
- ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+
- $ MAX( M, 2*M-4, NRHS, N-3*M, WLALSD ) ) THEN
-*
-* Path 2a - underdetermined, with many more columns than rows
-* and sufficient workspace for an efficient algorithm.
-*
- LDWORK = M
- IF( LWORK.GE.MAX( 4*M+M*LDA+MAX( M, 2*M-4, NRHS, N-3*M ),
- $ M*LDA+M+M*NRHS, 4*M+M*LDA+WLALSD ) )LDWORK = LDA
- ITAU = 1
- NWORK = M + 1
-*
-* Compute A=L*Q.
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
- IL = NWORK
-*
-* Copy L to WORK(IL), zeroing out above its diagonal.
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWORK )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( IL+LDWORK ),
- $ LDWORK )
- IE = IL + LDWORK*M
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IL).
-* (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IL ), LDWORK, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of L.
-* (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
-*
- CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, WORK( IL ), LDWORK,
- $ WORK( ITAUQ ), B, LDB, WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Solve the bidiagonal least squares problem.
-*
- CALL DLALSD( 'U', SMLSIZ, M, NRHS, S, WORK( IE ), B, LDB,
- $ RCOND, RANK, WORK( NWORK ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- GO TO 10
- END IF
-*
-* Multiply B by right bidiagonalizing vectors of L.
-*
- CALL DORMBR( 'P', 'L', 'N', M, NRHS, M, WORK( IL ), LDWORK,
- $ WORK( ITAUP ), B, LDB, WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Zero out below first M rows of B.
-*
- CALL DLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
- NWORK = ITAU + M
-*
-* Multiply transpose(Q) by B.
-* (Workspace: need M+NRHS, prefer M+NRHS*NB)
-*
- CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
- ELSE
-*
-* Path 2 - remaining underdetermined cases.
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize A.
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors.
-* (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
-*
- CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
-* Solve the bidiagonal least squares problem.
-*
- CALL DLALSD( 'L', SMLSIZ, M, NRHS, S, WORK( IE ), B, LDB,
- $ RCOND, RANK, WORK( NWORK ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- GO TO 10
- END IF
-*
-* Multiply B by right bidiagonalizing vectors of A.
-*
- CALL DORMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
- END IF
-*
-* Undo scaling.
-*
- IF( IASCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
- CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- ELSE IF( IASCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
- CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- END IF
- IF( IBSCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 10 CONTINUE
- WORK( 1 ) = MAXWRK
- IWORK( 1 ) = LIWORK
- RETURN
-*
-* End of DGELSD
-*
- END
diff --git a/netlib/LAPACK/dgelss.f b/netlib/LAPACK/dgelss.f
deleted file mode 100644
index 843f319..0000000
--- a/netlib/LAPACK/dgelss.f
+++ /dev/null
@@ -1,747 +0,0 @@
-*> \brief <b> DGELSS solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELSS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelss.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelss.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelss.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELSS computes the minimum norm solution to a real linear least
-*> squares problem:
-*>
-*> Minimize 2-norm(| b - A*x |).
-*>
-*> using the singular value decomposition (SVD) of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
-*> X.
-*>
-*> The effective rank of A is determined by treating as zero those
-*> singular values which are less than RCOND times the largest singular
-*> value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the first min(m,n) rows of A are overwritten with
-*> its right singular vectors, stored rowwise.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, B is overwritten by the N-by-NRHS solution
-*> matrix X. If m >= n and RANK = n, the residual
-*> sum-of-squares for the solution in the i-th column is given
-*> by the sum of squares of elements n+1:m in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,max(M,N)).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (min(M,N))
-*> The singular values of A in decreasing order.
-*> The condition number of A in the 2-norm = S(1)/S(min(m,n)).
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> RCOND is used to determine the effective rank of A.
-*> Singular values S(i) <= RCOND*S(1) are treated as zero.
-*> If RCOND < 0, machine precision is used instead.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the number of singular values
-*> which are greater than RCOND*S(1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 1, and also:
-*> LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: the algorithm for computing the SVD failed to converge;
-*> if INFO = i, i off-diagonal elements of an intermediate
-*> bidiagonal form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER BDSPAC, BL, CHUNK, I, IASCL, IBSCL, IE, IL,
- $ ITAU, ITAUP, ITAUQ, IWORK, LDWORK, MAXMN,
- $ MAXWRK, MINMN, MINWRK, MM, MNTHR
- INTEGER LWORK_DGEQRF, LWORK_DORMQR, LWORK_DGEBRD,
- $ LWORK_DORMBR, LWORK_DORGBR, LWORK_DORMLQ,
- $ LWORK_DGELQF
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM, THR
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, DGEMV,
- $ DGEQRF, DLABAD, DLACPY, DLASCL, DLASET, DORGBR,
- $ DORMBR, DORMLQ, DORMQR, DRSCL, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- MAXMN = MAX( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, MAXMN ) ) THEN
- INFO = -7
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( MINMN.GT.0 ) THEN
- MM = M
- MNTHR = ILAENV( 6, 'DGELSS', ' ', M, N, NRHS, -1 )
- IF( M.GE.N .AND. M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than
-* columns
-*
-* Compute space needed for DGEQRF
- CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
- LWORK_DGEQRF=DUM(1)
-* Compute space needed for DORMQR
- CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, DUM(1), B,
- $ LDB, DUM(1), -1, INFO )
- LWORK_DORMQR=DUM(1)
- MM = N
- MAXWRK = MAX( MAXWRK, N + LWORK_DGEQRF )
- MAXWRK = MAX( MAXWRK, N + LWORK_DORMQR )
- END IF
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined
-*
-* Compute workspace needed for DBDSQR
-*
- BDSPAC = MAX( 1, 5*N )
-* Compute space needed for DGEBRD
- CALL DGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, INFO )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORMBR
- CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1),
- $ B, LDB, DUM(1), -1, INFO )
- LWORK_DORMBR=DUM(1)
-* Compute space needed for DORGBR
- CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, INFO )
- LWORK_DORGBR=DUM(1)
-* Compute total workspace needed
- MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD )
- MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORMBR )
- MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MAXWRK = MAX( MAXWRK, N*NRHS )
- MINWRK = MAX( 3*N + MM, 3*N + NRHS, BDSPAC )
- MAXWRK = MAX( MINWRK, MAXWRK )
- END IF
- IF( N.GT.M ) THEN
-*
-* Compute workspace needed for DBDSQR
-*
- BDSPAC = MAX( 1, 5*M )
- MINWRK = MAX( 3*M+NRHS, 3*M+N, BDSPAC )
- IF( N.GE.MNTHR ) THEN
-*
-* Path 2a - underdetermined, with many more columns
-* than rows
-*
-* Compute space needed for DGELQF
- CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1),
- $ -1, INFO )
- LWORK_DGELQF=DUM(1)
-* Compute space needed for DGEBRD
- CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, INFO )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORMBR
- CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA,
- $ DUM(1), B, LDB, DUM(1), -1, INFO )
- LWORK_DORMBR=DUM(1)
-* Compute space needed for DORGBR
- CALL DORGBR( 'P', M, M, M, A, LDA, DUM(1),
- $ DUM(1), -1, INFO )
- LWORK_DORGBR=DUM(1)
-* Compute space needed for DORMLQ
- CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, DUM(1),
- $ B, LDB, DUM(1), -1, INFO )
- LWORK_DORMLQ=DUM(1)
-* Compute total workspace needed
- MAXWRK = M + LWORK_DGELQF
- MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DGEBRD )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DORMBR )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DORGBR )
- MAXWRK = MAX( MAXWRK, M*M + M + BDSPAC )
- IF( NRHS.GT.1 ) THEN
- MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS )
- ELSE
- MAXWRK = MAX( MAXWRK, M*M + 2*M )
- END IF
- MAXWRK = MAX( MAXWRK, M + LWORK_DORMLQ )
- ELSE
-*
-* Path 2 - underdetermined
-*
-* Compute space needed for DGEBRD
- CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, INFO )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORMBR
- CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, A, LDA,
- $ DUM(1), B, LDB, DUM(1), -1, INFO )
- LWORK_DORMBR=DUM(1)
-* Compute space needed for DORGBR
- CALL DORGBR( 'P', M, N, M, A, LDA, DUM(1),
- $ DUM(1), -1, INFO )
- LWORK_DORGBR=DUM(1)
- MAXWRK = 3*M + LWORK_DGEBRD
- MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORMBR )
- MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MAXWRK = MAX( MAXWRK, N*NRHS )
- END IF
- END IF
- MAXWRK = MAX( MINWRK, MAXWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELSS', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters
-*
- EPS = DLAMCH( 'P' )
- SFMIN = DLAMCH( 'S' )
- SMLNUM = SFMIN / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- CALL DLASET( 'F', MINMN, 1, ZERO, ZERO, S, MINMN )
- RANK = 0
- GO TO 70
- END IF
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- 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 )
- IBSCL = 2
- END IF
-*
-* Overdetermined case
-*
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined
-*
- MM = M
- IF( M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than columns
-*
- MM = N
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
-*
-* Multiply B by transpose(Q)
-* (Workspace: need N+NRHS, prefer N+NRHS*NB)
-*
- CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-* Zero out below R
-*
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- END IF
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
-*
- CALL DGEBRD( MM, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of R
-* (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
-*
- CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-* Generate right bidiagonalizing vectors of R in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, INFO )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration
-* multiply B by transpose of left singular vectors
-* compute right singular vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, 0, NRHS, S, WORK( IE ), A, LDA, DUM,
- $ 1, B, LDB, WORK( IWORK ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 70
-*
-* Multiply B by reciprocals of singular values
-*
- THR = MAX( RCOND*S( 1 ), SFMIN )
- IF( RCOND.LT.ZERO )
- $ THR = MAX( EPS*S( 1 ), SFMIN )
- RANK = 0
- DO 10 I = 1, N
- IF( S( I ).GT.THR ) THEN
- CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB )
- RANK = RANK + 1
- ELSE
- CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- END IF
- 10 CONTINUE
-*
-* Multiply B by right singular vectors
-* (Workspace: need N, prefer N*NRHS)
-*
- IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN
- CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, ZERO,
- $ WORK, LDB )
- CALL DLACPY( 'G', N, NRHS, WORK, LDB, B, LDB )
- ELSE IF( NRHS.GT.1 ) THEN
- CHUNK = LWORK / N
- DO 20 I = 1, NRHS, CHUNK
- BL = MIN( NRHS-I+1, CHUNK )
- CALL DGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, I ),
- $ LDB, ZERO, WORK, N )
- CALL DLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
- 20 CONTINUE
- ELSE
- CALL DGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
- CALL DCOPY( N, WORK, 1, B, 1 )
- END IF
-*
- ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+
- $ MAX( M, 2*M-4, NRHS, N-3*M ) ) THEN
-*
-* Path 2a - underdetermined, with many more columns than rows
-* and sufficient workspace for an efficient algorithm
-*
- LDWORK = M
- IF( LWORK.GE.MAX( 4*M+M*LDA+MAX( M, 2*M-4, NRHS, N-3*M ),
- $ M*LDA+M+M*NRHS ) )LDWORK = LDA
- ITAU = 1
- IWORK = M + 1
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
- IL = IWORK
-*
-* Copy L to WORK(IL), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWORK )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( IL+LDWORK ),
- $ LDWORK )
- IE = IL + LDWORK*M
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IL)
-* (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IL ), LDWORK, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of L
-* (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
-*
- CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, WORK( IL ), LDWORK,
- $ WORK( ITAUQ ), B, LDB, WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
-*
-* Generate right bidiagonalizing vectors of R in WORK(IL)
-* (Workspace: need M*M+5*M-1, prefer M*M+4*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, INFO )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration,
-* computing right singular vectors of L in WORK(IL) and
-* multiplying B by transpose of left singular vectors
-* (Workspace: need M*M+M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, NRHS, S, WORK( IE ), WORK( IL ),
- $ LDWORK, A, LDA, B, LDB, WORK( IWORK ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 70
-*
-* Multiply B by reciprocals of singular values
-*
- THR = MAX( RCOND*S( 1 ), SFMIN )
- IF( RCOND.LT.ZERO )
- $ THR = MAX( EPS*S( 1 ), SFMIN )
- RANK = 0
- DO 30 I = 1, M
- IF( S( I ).GT.THR ) THEN
- CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB )
- RANK = RANK + 1
- ELSE
- CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- END IF
- 30 CONTINUE
- IWORK = IE
-*
-* Multiply B by right singular vectors of L in WORK(IL)
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NRHS)
-*
- IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN
- CALL DGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), LDWORK,
- $ B, LDB, ZERO, WORK( IWORK ), LDB )
- CALL DLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB )
- ELSE IF( NRHS.GT.1 ) THEN
- CHUNK = ( LWORK-IWORK+1 ) / M
- DO 40 I = 1, NRHS, CHUNK
- BL = MIN( NRHS-I+1, CHUNK )
- CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
- CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
- $ LDB )
- 40 CONTINUE
- ELSE
- CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
- $ 1, ZERO, WORK( IWORK ), 1 )
- CALL DCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
- END IF
-*
-* Zero out below first M rows of B
-*
- CALL DLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
- IWORK = ITAU + M
-*
-* Multiply transpose(Q) by B
-* (Workspace: need M+NRHS, prefer M+NRHS*NB)
-*
- CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
- ELSE
-*
-* Path 2 - remaining underdetermined cases
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors
-* (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
-*
- CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-* Generate right bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, INFO )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration,
-* computing right singular vectors of A in A and
-* multiplying B by transpose of left singular vectors
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, N, 0, NRHS, S, WORK( IE ), A, LDA, DUM,
- $ 1, B, LDB, WORK( IWORK ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 70
-*
-* Multiply B by reciprocals of singular values
-*
- THR = MAX( RCOND*S( 1 ), SFMIN )
- IF( RCOND.LT.ZERO )
- $ THR = MAX( EPS*S( 1 ), SFMIN )
- RANK = 0
- DO 50 I = 1, M
- IF( S( I ).GT.THR ) THEN
- CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB )
- RANK = RANK + 1
- ELSE
- CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- END IF
- 50 CONTINUE
-*
-* Multiply B by right singular vectors of A
-* (Workspace: need N, prefer N*NRHS)
-*
- IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN
- CALL DGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, ZERO,
- $ WORK, LDB )
- CALL DLACPY( 'F', N, NRHS, WORK, LDB, B, LDB )
- ELSE IF( NRHS.GT.1 ) THEN
- CHUNK = LWORK / N
- DO 60 I = 1, NRHS, CHUNK
- BL = MIN( NRHS-I+1, CHUNK )
- CALL DGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, I ),
- $ LDB, ZERO, WORK, N )
- CALL DLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
- 60 CONTINUE
- ELSE
- CALL DGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
- CALL DCOPY( N, WORK, 1, B, 1 )
- END IF
- END IF
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
- CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- ELSE IF( IASCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
- CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- END IF
- IF( IBSCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 70 CONTINUE
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGELSS
-*
- END
diff --git a/netlib/LAPACK/dgelsx.f b/netlib/LAPACK/dgelsx.f
deleted file mode 100644
index 788cce1..0000000
--- a/netlib/LAPACK/dgelsx.f
+++ /dev/null
@@ -1,435 +0,0 @@
-*> \brief <b> DGELSX solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelsx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelsx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, M, N, NRHS, RANK
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine DGELSY.
-*>
-*> DGELSX computes the minimum-norm solution to a real linear least
-*> squares problem:
-*> minimize || A * X - B ||
-*> using a complete orthogonal factorization of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*>
-*> The routine first computes a QR factorization with column pivoting:
-*> A * P = Q * [ R11 R12 ]
-*> [ 0 R22 ]
-*> with R11 defined as the largest leading submatrix whose estimated
-*> condition number is less than 1/RCOND. The order of R11, RANK,
-*> is the effective rank of A.
-*>
-*> Then, R22 is considered to be negligible, and R12 is annihilated
-*> by orthogonal transformations from the right, arriving at the
-*> complete orthogonal factorization:
-*> A * P = Q * [ T11 0 ] * Z
-*> [ 0 0 ]
-*> The minimum-norm solution is then
-*> X = P * Z**T [ inv(T11)*Q1**T*B ]
-*> [ 0 ]
-*> where Q1 consists of the first RANK columns of Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of
-*> columns of matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A has been overwritten by details of its
-*> complete orthogonal factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, the N-by-NRHS solution matrix X.
-*> If m >= n and RANK = n, the residual sum-of-squares for
-*> the solution in the i-th column is given by the sum of
-*> squares of elements N+1:M in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M,N).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is an
-*> initial column, otherwise it is a free column. Before
-*> the QR factorization of A, all initial columns are
-*> permuted to the leading positions; only the remaining
-*> free columns are moved as a result of column pivoting
-*> during the factorization.
-*> On exit, if JPVT(i) = k, then the i-th column of A*P
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> RCOND is used to determine the effective rank of A, which
-*> is defined as the order of the largest leading triangular
-*> submatrix R11 in the QR factorization with pivoting of A,
-*> whose estimated condition number < 1/RCOND.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the order of the submatrix
-*> R11. This is the same as the order of the submatrix T11
-*> in the complete orthogonal factorization of A.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
- $ WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, M, N, NRHS, RANK
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER IMAX, IMIN
- PARAMETER ( IMAX = 1, IMIN = 2 )
- DOUBLE PRECISION ZERO, ONE, DONE, NTDONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, DONE = ZERO,
- $ NTDONE = ONE )
-* ..
-* .. Local Scalars ..
- INTEGER I, IASCL, IBSCL, ISMAX, ISMIN, J, K, MN
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
- $ SMAXPR, SMIN, SMINPR, SMLNUM, T1, T2
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQPF, DLAIC1, DLASCL, DLASET, DLATZM, DORM2R,
- $ DTRSM, DTZRQF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- MN = MIN( M, N )
- ISMIN = MN + 1
- ISMAX = 2*MN + 1
-*
-* Test the input arguments.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELSX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Scale A, B if max elements outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- RANK = 0
- GO TO 100
- END IF
-*
- BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- 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 )
- 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 )
-*
-* workspace 3*N. Details of Householder rotations stored
-* in WORK(1:MN).
-*
-* Determine RANK using incremental condition estimation
-*
- WORK( ISMIN ) = ONE
- WORK( ISMAX ) = ONE
- SMAX = ABS( A( 1, 1 ) )
- SMIN = SMAX
- IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
- RANK = 0
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- GO TO 100
- ELSE
- RANK = 1
- END IF
-*
- 10 CONTINUE
- IF( RANK.LT.MN ) THEN
- I = RANK + 1
- CALL DLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
- $ A( I, I ), SMINPR, S1, C1 )
- CALL DLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
- $ A( I, I ), SMAXPR, S2, C2 )
-*
- IF( SMAXPR*RCOND.LE.SMINPR ) THEN
- DO 20 I = 1, RANK
- WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
- WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
- 20 CONTINUE
- WORK( ISMIN+RANK ) = C1
- WORK( ISMAX+RANK ) = C2
- SMIN = SMINPR
- SMAX = SMAXPR
- RANK = RANK + 1
- GO TO 10
- END IF
- END IF
-*
-* Logically partition R = [ R11 R12 ]
-* [ 0 R22 ]
-* where R11 = R(1:RANK,1:RANK)
-*
-* [R11,R12] = [ T11, 0 ] * Y
-*
- IF( RANK.LT.N )
- $ CALL DTZRQF( RANK, N, A, LDA, WORK( MN+1 ), INFO )
-*
-* Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-* 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 )
-*
-* workspace NRHS
-*
-* B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS)
-*
- CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK,
- $ NRHS, ONE, A, LDA, B, LDB )
-*
- DO 40 I = RANK + 1, N
- DO 30 J = 1, NRHS
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* B(1:N,1:NRHS) := Y**T * B(1:N,1:NRHS)
-*
- IF( RANK.LT.N ) THEN
- DO 50 I = 1, RANK
- CALL DLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), LDA,
- $ WORK( MN+I ), B( I, 1 ), B( RANK+1, 1 ), LDB,
- $ WORK( 2*MN+1 ) )
- 50 CONTINUE
- END IF
-*
-* workspace NRHS
-*
-* B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
- DO 90 J = 1, NRHS
- DO 60 I = 1, N
- WORK( 2*MN+I ) = NTDONE
- 60 CONTINUE
- DO 80 I = 1, N
- IF( WORK( 2*MN+I ).EQ.NTDONE ) THEN
- IF( JPVT( I ).NE.I ) THEN
- K = I
- T1 = B( K, J )
- T2 = B( JPVT( K ), J )
- 70 CONTINUE
- B( JPVT( K ), J ) = T1
- WORK( 2*MN+K ) = DONE
- T1 = T2
- K = JPVT( K )
- T2 = B( JPVT( K ), J )
- IF( JPVT( K ).NE.I )
- $ GO TO 70
- B( I, J ) = T1
- WORK( 2*MN+K ) = DONE
- END IF
- END IF
- 80 CONTINUE
- 90 CONTINUE
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- 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( '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 )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 100 CONTINUE
-*
- RETURN
-*
-* End of DGELSX
-*
- END
diff --git a/netlib/LAPACK/dgelsy.f b/netlib/LAPACK/dgelsy.f
deleted file mode 100644
index 87bc23c..0000000
--- a/netlib/LAPACK/dgelsy.f
+++ /dev/null
@@ -1,479 +0,0 @@
-*> \brief <b> DGELSY solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELSY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelsy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelsy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelsy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELSY computes the minimum-norm solution to a real linear least
-*> squares problem:
-*> minimize || A * X - B ||
-*> using a complete orthogonal factorization of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*>
-*> The routine first computes a QR factorization with column pivoting:
-*> A * P = Q * [ R11 R12 ]
-*> [ 0 R22 ]
-*> with R11 defined as the largest leading submatrix whose estimated
-*> condition number is less than 1/RCOND. The order of R11, RANK,
-*> is the effective rank of A.
-*>
-*> Then, R22 is considered to be negligible, and R12 is annihilated
-*> by orthogonal transformations from the right, arriving at the
-*> complete orthogonal factorization:
-*> A * P = Q * [ T11 0 ] * Z
-*> [ 0 0 ]
-*> The minimum-norm solution is then
-*> X = P * Z**T [ inv(T11)*Q1**T*B ]
-*> [ 0 ]
-*> where Q1 consists of the first RANK columns of Q.
-*>
-*> This routine is basically identical to the original xGELSX except
-*> three differences:
-*> o The call to the subroutine xGEQPF has been substituted by the
-*> the call to the subroutine xGEQP3. This subroutine is a Blas-3
-*> version of the QR factorization with column pivoting.
-*> o Matrix B (the right hand side) is updated with Blas-3.
-*> o The permutation of matrix B (the right hand side) is faster and
-*> more simple.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of
-*> columns of matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A has been overwritten by details of its
-*> complete orthogonal factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M,N).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*> to the front of AP, otherwise column i is a free column.
-*> On exit, if JPVT(i) = k, then the i-th column of AP
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> RCOND is used to determine the effective rank of A, which
-*> is defined as the order of the largest leading triangular
-*> submatrix R11 in the QR factorization with pivoting of A,
-*> whose estimated condition number < 1/RCOND.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the order of the submatrix
-*> R11. This is the same as the order of the submatrix T11
-*> in the complete orthogonal factorization of A.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> The unblocked strategy requires that:
-*> LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
-*> where MN = min( M, N ).
-*> The block algorithm requires that:
-*> LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
-*> where NB is an upper bound on the blocksize returned
-*> by ILAENV for the routines DGEQP3, DTZRZF, STZRQF, DORMQR,
-*> and DORMRZ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: If INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA \n
-*> E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
-*>
-* =====================================================================
- SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER IMAX, IMIN
- PARAMETER ( IMAX = 1, IMIN = 2 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IASCL, IBSCL, ISMAX, ISMIN, J, LWKMIN,
- $ LWKOPT, MN, NB, NB1, NB2, NB3, NB4
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
- $ SMAXPR, SMIN, SMINPR, SMLNUM, WSIZE
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL ILAENV, DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEQP3, DLABAD, DLAIC1, DLASCL, DLASET,
- $ DORMQR, DORMRZ, DTRSM, DTZRZF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- MN = MIN( M, N )
- ISMIN = MN + 1
- ISMAX = 2*MN + 1
-*
-* Test the input arguments.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
- INFO = -7
- END IF
-*
-* Figure out optimal block size
-*
- IF( INFO.EQ.0 ) THEN
- IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
- LWKMIN = 1
- LWKOPT = 1
- ELSE
- NB1 = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- NB2 = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
- NB3 = ILAENV( 1, 'DORMQR', ' ', M, N, NRHS, -1 )
- NB4 = ILAENV( 1, 'DORMRQ', ' ', M, N, NRHS, -1 )
- NB = MAX( NB1, NB2, NB3, NB4 )
- LWKMIN = MN + MAX( 2*MN, N + 1, MN + NRHS )
- LWKOPT = MAX( LWKMIN,
- $ MN + 2*N + NB*( N + 1 ), 2*MN + NB*NRHS )
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELSY', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Scale A, B if max entries outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- RANK = 0
- GO TO 70
- END IF
-*
- BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- 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 )
- IBSCL = 2
- END IF
-*
-* Compute QR factorization with column pivoting of A:
-* A * P = Q * R
-*
- CALL DGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
- $ LWORK-MN, INFO )
- WSIZE = MN + WORK( MN+1 )
-*
-* workspace: MN+2*N+NB*(N+1).
-* Details of Householder rotations stored in WORK(1:MN).
-*
-* Determine RANK using incremental condition estimation
-*
- WORK( ISMIN ) = ONE
- WORK( ISMAX ) = ONE
- SMAX = ABS( A( 1, 1 ) )
- SMIN = SMAX
- IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
- RANK = 0
- CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- GO TO 70
- ELSE
- RANK = 1
- END IF
-*
- 10 CONTINUE
- IF( RANK.LT.MN ) THEN
- I = RANK + 1
- CALL DLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
- $ A( I, I ), SMINPR, S1, C1 )
- CALL DLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
- $ A( I, I ), SMAXPR, S2, C2 )
-*
- IF( SMAXPR*RCOND.LE.SMINPR ) THEN
- DO 20 I = 1, RANK
- WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
- WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
- 20 CONTINUE
- WORK( ISMIN+RANK ) = C1
- WORK( ISMAX+RANK ) = C2
- SMIN = SMINPR
- SMAX = SMAXPR
- RANK = RANK + 1
- GO TO 10
- END IF
- END IF
-*
-* workspace: 3*MN.
-*
-* Logically partition R = [ R11 R12 ]
-* [ 0 R22 ]
-* where R11 = R(1:RANK,1:RANK)
-*
-* [R11,R12] = [ T11, 0 ] * Y
-*
- IF( RANK.LT.N )
- $ CALL DTZRZF( RANK, N, A, LDA, WORK( MN+1 ), WORK( 2*MN+1 ),
- $ LWORK-2*MN, INFO )
-*
-* workspace: 2*MN.
-* Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
-*
- CALL DORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
- $ B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
- WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) )
-*
-* workspace: 2*MN+NB*NRHS.
-*
-* B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS)
-*
- CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK,
- $ NRHS, ONE, A, LDA, B, LDB )
-*
- DO 40 J = 1, NRHS
- DO 30 I = RANK + 1, N
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* B(1:N,1:NRHS) := Y**T * B(1:N,1:NRHS)
-*
- IF( RANK.LT.N ) THEN
- CALL DORMRZ( 'Left', 'Transpose', N, NRHS, RANK, N-RANK, A,
- $ LDA, WORK( MN+1 ), B, LDB, WORK( 2*MN+1 ),
- $ LWORK-2*MN, INFO )
- END IF
-*
-* workspace: 2*MN+NRHS.
-*
-* B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- WORK( JPVT( I ) ) = B( I, J )
- 50 CONTINUE
- CALL DCOPY( N, WORK( 1 ), 1, B( 1, J ), 1 )
- 60 CONTINUE
-*
-* workspace: N.
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- 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( '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 )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 70 CONTINUE
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DGELSY
-*
- END
diff --git a/netlib/LAPACK/dgemqrt.f b/netlib/LAPACK/dgemqrt.f
deleted file mode 100644
index 99b3968..0000000
--- a/netlib/LAPACK/dgemqrt.f
+++ /dev/null
@@ -1,291 +0,0 @@
-*> \brief \b DGEMQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEMQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgemqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
-* C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDV, LDC, M, N, NB, LDT
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEMQRT overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q C C Q
-*> TRANS = 'T': Q**T C C Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of K
-*> elementary reflectors:
-*>
-*> Q = H(1) H(2) . . . H(K) = I - V T V**T
-*>
-*> generated using the compact WY representation as returned by DGEQRT.
-*>
-*> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size used for the storage of T. K >= NB >= 1.
-*> This must be the same value of NB used to generate T
-*> in CGEQRT.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> CGEQRT in the first K columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The upper triangular factors of the block reflectors
-*> as returned by CGEQRT, stored as a NB-by-N matrix.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q C, Q**T C, C Q**T or C Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array. The dimension of
-*> WORK is N*NB if SIDE = 'L', or M*NB if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
- $ C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDV, LDC, M, N, NB, LDT
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, LDWORK, KF, Q
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DLARFB
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* .. Test the input arguments ..
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- RIGHT = LSAME( SIDE, 'R' )
- TRAN = LSAME( TRANS, 'T' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
- IF( LEFT ) THEN
- LDWORK = MAX( 1, N )
- Q = M
- ELSE IF ( RIGHT ) THEN
- LDWORK = MAX( 1, M )
- Q = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
- INFO = -1
- ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN
- INFO = -5
- ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN
- INFO = -6
- ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
- INFO = -8
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -10
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEMQRT', -INFO )
- RETURN
- END IF
-*
-* .. Quick return if possible ..
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
-*
- IF( LEFT .AND. TRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- CALL DLARFB( 'L', 'T', 'F', 'C', M-I+1, N, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( I, 1 ), LDC, WORK, LDWORK )
- END DO
-*
- ELSE IF( RIGHT .AND. NOTRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- CALL DLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( 1, I ), LDC, WORK, LDWORK )
- END DO
-*
- ELSE IF( LEFT .AND. NOTRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- CALL DLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( I, 1 ), LDC, WORK, LDWORK )
- END DO
-*
- ELSE IF( RIGHT .AND. TRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- CALL DLARFB( 'R', 'T', 'F', 'C', M, N-I+1, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( 1, I ), LDC, WORK, LDWORK )
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of DGEMQRT
-*
- END
diff --git a/netlib/LAPACK/dgeql2.f b/netlib/LAPACK/dgeql2.f
deleted file mode 100644
index 25651cd..0000000
--- a/netlib/LAPACK/dgeql2.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief \b DGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeql2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeql2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeql2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQL2 computes a QL factorization of a real m by n matrix A:
-*> A = Q * L.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, if m >= n, the lower triangle of the subarray
-*> A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
-*> if m <= n, the elements on and below the (n-m)-th
-*> superdiagonal contain the m by n lower trapezoidal matrix L;
-*> the remaining elements, with the array TAU, represent the
-*> orthogonal matrix Q as a product of elementary reflectors
-*> (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
-*> A(1:m-k+i-1,n-k+i), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQL2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = K, 1, -1
-*
-* Generate elementary reflector H(i) to annihilate
-* A(1:m-k+i-1,n-k+i)
-*
- CALL DLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
- $ TAU( I ) )
-*
-* Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left
-*
- AII = A( M-K+I, N-K+I )
- A( M-K+I, N-K+I ) = ONE
- CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ),
- $ A, LDA, WORK )
- A( M-K+I, N-K+I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DGEQL2
-*
- END
diff --git a/netlib/LAPACK/dgeqlf.f b/netlib/LAPACK/dgeqlf.f
deleted file mode 100644
index 1efeba1..0000000
--- a/netlib/LAPACK/dgeqlf.f
+++ /dev/null
@@ -1,287 +0,0 @@
-*> \brief \b DGEQLF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQLF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqlf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqlf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqlf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQLF computes a QL factorization of a real M-by-N matrix A:
-*> A = Q * L.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if m >= n, the lower triangle of the subarray
-*> A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
-*> if m <= n, the elements on and below the (n-m)-th
-*> superdiagonal contain the M-by-N lower trapezoidal matrix L;
-*> the remaining elements, with the array TAU, represent the
-*> orthogonal matrix Q as a product of elementary reflectors
-*> (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
-*> A(1:m-k+i-1,n-k+i), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
- $ MU, NB, NBMIN, NU, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQL2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'DGEQLF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQLF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 1
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGEQLF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGEQLF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially.
-* The last kk columns are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
- DO 10 I = K - KK + KI + 1, K - KK + 1, -NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QL factorization of the current block
-* A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1)
-*
- CALL DGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ),
- $ WORK, IINFO )
- IF( N-K+I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
- $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Backward',
- $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
- $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- MU = M - K + I + NB - 1
- NU = N - K + I + NB - 1
- ELSE
- MU = M
- NU = N
- END IF
-*
-* Use unblocked code to factor the last or only block
-*
- IF( MU.GT.0 .AND. NU.GT.0 )
- $ CALL DGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGEQLF
-*
- END
diff --git a/netlib/LAPACK/dgeqp3.f b/netlib/LAPACK/dgeqp3.f
deleted file mode 100644
index 62a172f..0000000
--- a/netlib/LAPACK/dgeqp3.f
+++ /dev/null
@@ -1,367 +0,0 @@
-*> \brief \b DGEQP3
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQP3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqp3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqp3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqp3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQP3 computes a QR factorization with column pivoting of a
-*> matrix A: A*P = Q*R using Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the upper triangle of the array contains the
-*> min(M,N)-by-N upper trapezoidal matrix R; the elements below
-*> the diagonal, together with the array TAU, represent the
-*> orthogonal matrix Q as a product of min(M,N) elementary
-*> reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(J).ne.0, the J-th column of A is permuted
-*> to the front of A*P (a leading column); if JPVT(J)=0,
-*> the J-th column of A is a free column.
-*> On exit, if JPVT(J)=K, then the J-th column of A*P was the
-*> the K-th column of A.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO=0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 3*N+1.
-*> For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real/complex vector
-*> with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
-*> A(i+1:m,i), and tau in TAU(i).
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*> X. Sun, Computer Science Dept., Duke University, USA
-*>
-* =====================================================================
- SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER INB, INBMIN, IXOVER
- PARAMETER ( INB = 1, INBMIN = 2, IXOVER = 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
- $ NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DLAQP2, DLAQPS, DORMQR, DSWAP, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DNRM2
- EXTERNAL ILAENV, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-* ====================
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- MINMN = MIN( M, N )
- IF( MINMN.EQ.0 ) THEN
- IWS = 1
- LWKOPT = 1
- ELSE
- IWS = 3*N + 1
- NB = ILAENV( INB, 'DGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = 2*N + ( N + 1 )*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQP3', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( MINMN.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Move initial columns up front.
-*
- NFXD = 1
- DO 10 J = 1, N
- IF( JPVT( J ).NE.0 ) THEN
- IF( J.NE.NFXD ) THEN
- CALL DSWAP( M, A( 1, J ), 1, A( 1, NFXD ), 1 )
- JPVT( J ) = JPVT( NFXD )
- JPVT( NFXD ) = J
- ELSE
- JPVT( J ) = J
- END IF
- NFXD = NFXD + 1
- ELSE
- JPVT( J ) = J
- END IF
- 10 CONTINUE
- NFXD = NFXD - 1
-*
-* Factorize fixed columns
-* =======================
-*
-* Compute the QR factorization of fixed columns and update
-* remaining columns.
-*
- IF( NFXD.GT.0 ) THEN
- NA = MIN( M, NFXD )
-*CC CALL DGEQR2( M, NA, A, LDA, TAU, WORK, INFO )
- CALL DGEQRF( M, NA, A, LDA, TAU, WORK, LWORK, INFO )
- IWS = MAX( IWS, INT( WORK( 1 ) ) )
- IF( NA.LT.N ) THEN
-*CC CALL DORM2R( 'Left', 'Transpose', M, N-NA, NA, A, LDA,
-*CC $ TAU, A( 1, NA+1 ), LDA, WORK, INFO )
- CALL DORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, TAU,
- $ A( 1, NA+1 ), LDA, WORK, LWORK, INFO )
- IWS = MAX( IWS, INT( WORK( 1 ) ) )
- END IF
- END IF
-*
-* Factorize free columns
-* ======================
-*
- IF( NFXD.LT.MINMN ) THEN
-*
- SM = M - NFXD
- SN = N - NFXD
- SMINMN = MINMN - NFXD
-*
-* Determine the block size.
-*
- NB = ILAENV( INB, 'DGEQRF', ' ', SM, SN, -1, -1 )
- NBMIN = 2
- NX = 0
-*
- IF( ( NB.GT.1 ) .AND. ( NB.LT.SMINMN ) ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( IXOVER, 'DGEQRF', ' ', SM, SN, -1,
- $ -1 ) )
-*
-*
- IF( NX.LT.SMINMN ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- MINWS = 2*SN + ( SN+1 )*NB
- IWS = MAX( IWS, MINWS )
- IF( LWORK.LT.MINWS ) THEN
-*
-* Not enough workspace to use optimal NB: Reduce NB and
-* determine the minimum value of NB.
-*
- NB = ( LWORK-2*SN ) / ( SN+1 )
- NBMIN = MAX( 2, ILAENV( INBMIN, 'DGEQRF', ' ', SM, SN,
- $ -1, -1 ) )
-*
-*
- END IF
- END IF
- END IF
-*
-* Initialize partial column norms. The first N elements of work
-* store the exact column norms.
-*
- DO 20 J = NFXD + 1, N
- WORK( J ) = DNRM2( SM, A( NFXD+1, J ), 1 )
- WORK( N+J ) = WORK( J )
- 20 CONTINUE
-*
- IF( ( NB.GE.NBMIN ) .AND. ( NB.LT.SMINMN ) .AND.
- $ ( NX.LT.SMINMN ) ) THEN
-*
-* Use blocked code initially.
-*
- J = NFXD + 1
-*
-* Compute factorization: while loop.
-*
-*
- TOPBMN = MINMN - NX
- 30 CONTINUE
- IF( J.LE.TOPBMN ) THEN
- JB = MIN( NB, TOPBMN-J+1 )
-*
-* Factorize JB columns among columns J:N.
-*
- CALL DLAQPS( M, N-J+1, J-1, JB, FJB, A( 1, J ), LDA,
- $ JPVT( J ), TAU( J ), WORK( J ), WORK( N+J ),
- $ WORK( 2*N+1 ), WORK( 2*N+JB+1 ), N-J+1 )
-*
- J = J + FJB
- GO TO 30
- END IF
- ELSE
- J = NFXD + 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
-*
- IF( J.LE.MINMN )
- $ CALL DLAQP2( M, N-J+1, J-1, A( 1, J ), LDA, JPVT( J ),
- $ TAU( J ), WORK( J ), WORK( N+J ),
- $ WORK( 2*N+1 ) )
-*
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGEQP3
-*
- END
diff --git a/netlib/LAPACK/dgeqpf.f b/netlib/LAPACK/dgeqpf.f
deleted file mode 100644
index bc5b91c..0000000
--- a/netlib/LAPACK/dgeqpf.f
+++ /dev/null
@@ -1,306 +0,0 @@
-*> \brief \b DGEQPF
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqpf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqpf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine DGEQP3.
-*>
-*> DGEQPF computes a QR factorization with column pivoting of a
-*> real M-by-N matrix A: A*P = Q*R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the upper triangle of the array contains the
-*> min(M,N)-by-N upper triangular matrix R; the elements
-*> below the diagonal, together with the array TAU,
-*> represent the orthogonal matrix Q as a product of
-*> min(m,n) elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*> to the front of A*P (a leading column); if JPVT(i) = 0,
-*> the i-th column of A is a free column.
-*> On exit, if JPVT(i) = k, then the i-th column of A*P
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(n)
-*>
-*> Each H(i) has the form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
-*>
-*> The matrix P is represented in jpvt as follows: If
-*> jpvt(j) = i
-*> then the jth column of P is the ith canonical unit vector.
-*>
-*> Partial column norm updating strategy modified by
-*> Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*> University of Zagreb, Croatia.
-*> -- April 2011 --
-*> For more details see LAPACK Working Note 176.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ITEMP, J, MA, MN, PVT
- DOUBLE PRECISION AII, TEMP, TEMP2, TOL3Z
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQR2, DLARF, DLARFG, DORM2R, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DNRM2
- EXTERNAL IDAMAX, DLAMCH, DNRM2
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQPF', -INFO )
- RETURN
- END IF
-*
- MN = MIN( M, N )
- TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-* Move initial columns up front
-*
- ITEMP = 1
- DO 10 I = 1, N
- IF( JPVT( I ).NE.0 ) THEN
- IF( I.NE.ITEMP ) THEN
- CALL DSWAP( M, A( 1, I ), 1, A( 1, ITEMP ), 1 )
- JPVT( I ) = JPVT( ITEMP )
- JPVT( ITEMP ) = I
- ELSE
- JPVT( I ) = I
- END IF
- ITEMP = ITEMP + 1
- ELSE
- JPVT( I ) = I
- END IF
- 10 CONTINUE
- ITEMP = ITEMP - 1
-*
-* Compute the QR factorization and update remaining columns
-*
- IF( ITEMP.GT.0 ) THEN
- 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 )
- END IF
- END IF
-*
- IF( ITEMP.LT.MN ) THEN
-*
-* Initialize partial column norms. The first n elements of
-* work store the exact column norms.
-*
- DO 20 I = ITEMP + 1, N
- WORK( I ) = DNRM2( M-ITEMP, A( ITEMP+1, I ), 1 )
- WORK( N+I ) = WORK( I )
- 20 CONTINUE
-*
-* Compute factorization
-*
- DO 40 I = ITEMP + 1, MN
-*
-* Determine ith pivot column and swap if necessary
-*
- PVT = ( I-1 ) + IDAMAX( N-I+1, WORK( I ), 1 )
-*
- IF( PVT.NE.I ) THEN
- CALL DSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
- ITEMP = JPVT( PVT )
- JPVT( PVT ) = JPVT( I )
- JPVT( I ) = ITEMP
- WORK( PVT ) = WORK( I )
- WORK( N+PVT ) = WORK( N+I )
- END IF
-*
-* 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 ) )
- ELSE
- CALL DLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) )
- END IF
-*
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK( 2*N+1 ) )
- A( I, I ) = AII
- END IF
-*
-* Update partial column norms
-*
- DO 30 J = I + 1, N
- IF( WORK( J ).NE.ZERO ) THEN
-*
-* NOTE: The following 4 lines follow from the analysis in
-* Lapack Working Note 176.
-*
- TEMP = ABS( A( I, J ) ) / WORK( J )
- TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
- TEMP2 = TEMP*( WORK( J ) / WORK( N+J ) )**2
- IF( TEMP2 .LE. TOL3Z ) THEN
- IF( M-I.GT.0 ) THEN
- WORK( J ) = DNRM2( M-I, A( I+1, J ), 1 )
- WORK( N+J ) = WORK( J )
- ELSE
- WORK( J ) = ZERO
- WORK( N+J ) = ZERO
- END IF
- ELSE
- WORK( J ) = WORK( J )*SQRT( TEMP )
- END IF
- END IF
- 30 CONTINUE
-*
- 40 CONTINUE
- END IF
- RETURN
-*
-* End of DGEQPF
-*
- END
diff --git a/netlib/LAPACK/dgeqr2.f b/netlib/LAPACK/dgeqr2.f
deleted file mode 100644
index 8e63db8..0000000
--- a/netlib/LAPACK/dgeqr2.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQR2 computes a QR factorization of a real m by n matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(m,n) by n upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQR2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAU( I ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGEQR2
-*
- END
diff --git a/netlib/LAPACK/dgeqr2p.f b/netlib/LAPACK/dgeqr2p.f
deleted file mode 100644
index 19a779a..0000000
--- a/netlib/LAPACK/dgeqr2p.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b DGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQR2P + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqr2p.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqr2p.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqr2p.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQR2 computes a QR factorization of a real m by n matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(m,n) by n upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFGP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQR2P', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFGP( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAU( I ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGEQR2P
-*
- END
diff --git a/netlib/LAPACK/dgeqrf.f b/netlib/LAPACK/dgeqrf.f
deleted file mode 100644
index 2990257..0000000
--- a/netlib/LAPACK/dgeqrf.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b DGEQRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQRF computes a QR factorization of a real M-by-N matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of min(m,n) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQR2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block
-* A(i:m,i:i+ib-1)
-*
- CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i:m,i+ib:n) from the left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGEQRF
-*
- END
diff --git a/netlib/LAPACK/dgeqrfp.f b/netlib/LAPACK/dgeqrfp.f
deleted file mode 100644
index 07811b9..0000000
--- a/netlib/LAPACK/dgeqrfp.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b DGEQRFP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQRFP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqrfp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqrfp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqrfp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQRFP computes a QR factorization of a real M-by-N matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of min(m,n) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRFP', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block
-* A(i:m,i:i+ib-1)
-*
- CALL DGEQR2P( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i:m,i+ib:n) from the left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL DGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGEQRFP
-*
- END
diff --git a/netlib/LAPACK/dgeqrt.f b/netlib/LAPACK/dgeqrt.f
deleted file mode 100644
index 91dfad1..0000000
--- a/netlib/LAPACK/dgeqrt.f
+++ /dev/null
@@ -1,218 +0,0 @@
-*> \brief \b DGEQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDT, M, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQRT computes a blocked QR factorization of a real M-by-N matrix A
-*> using the compact WY representation of Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size to be used in the blocked QR. MIN(M,N) >= NB >= 1.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if M >= N); the elements below the diagonal
-*> are the columns of V.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,MIN(M,N))
-*> The upper triangular block reflectors stored in compact form
-*> as a sequence of upper triangular blocks. See below
-*> for further details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (NB*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
-*>
-*> V = ( 1 )
-*> ( v1 1 )
-*> ( v1 v2 1 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> where the vi's represent the vectors which define H(i), which are returned
-*> in the matrix A. The 1's along the diagonal of V are not stored in A.
-*>
-*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
-*>
-*> T = (T1 T2 ... TB).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDT, M, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- INTEGER I, IB, IINFO, K
- LOGICAL USE_RECURSIVE_QR
- PARAMETER( USE_RECURSIVE_QR=.TRUE. )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRT2, DGEQRT3, DLARFB, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NB.LT.1 .OR. NB.GT.MIN(M,N) ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) RETURN
-*
-* Blocked loop of length K
-*
- DO I = 1, K, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block A(I:M,I:I+IB-1)
-*
- IF( USE_RECURSIVE_QR ) THEN
- CALL DGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO )
- ELSE
- CALL DGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO )
- END IF
- IF( I+IB.LE.N ) THEN
-*
-* Update by applying H**T to A(I:M,I+IB:N) from the left
-*
- CALL DLARFB( 'L', 'T', 'F', 'C', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, T( 1, I ), LDT,
- $ A( I, I+IB ), LDA, WORK , N-I-IB+1 )
- END IF
- END DO
- RETURN
-*
-* End of DGEQRT
-*
- END
diff --git a/netlib/LAPACK/dgeqrt2.f b/netlib/LAPACK/dgeqrt2.f
deleted file mode 100644
index 399d563..0000000
--- a/netlib/LAPACK/dgeqrt2.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b DGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQRT2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqrt2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqrt2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqrt2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQRT2( M, N, A, LDA, T, LDT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDT, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), T( LDT, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQRT2 computes a QR factorization of a real M-by-N matrix A,
-*> using the compact WY representation of Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= N.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the real M-by-N matrix A. On exit, the elements on and
-*> above the diagonal contain the N-by-N upper triangular matrix R; the
-*> elements below the diagonal are the columns of V. See below for
-*> further details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The N-by-N upper triangular factor of the block reflector.
-*> The elements on and above the diagonal contain the block
-*> reflector T; the elements below the diagonal are not used.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
-*>
-*> V = ( 1 )
-*> ( v1 1 )
-*> ( v1 v2 1 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> where the vi's represent the vectors which define H(i), which are returned
-*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
-*> block reflector H is then given by
-*>
-*> H = I - V * T * V**T
-*>
-*> where V**T is the transpose of V.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQRT2( M, N, A, LDA, T, LDT, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDT, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), T( LDT, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER( ONE = 1.0D+00, ZERO = 0.0D+00 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII, ALPHA
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFG, DGEMV, DGER, DTRMV, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRT2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO I = 1, K
-*
-* Generate elem. refl. H(i) to annihilate A(i+1:m,i), tau(I) -> T(I,1)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ T( I, 1 ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(I:M,I+1:N) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
-*
-* W(1:N-I) := A(I:M,I+1:N)^H * A(I:M,I) [W = T(:,N)]
-*
- CALL DGEMV( 'T',M-I+1, N-I, ONE, A( I, I+1 ), LDA,
- $ A( I, I ), 1, ZERO, T( 1, N ), 1 )
-*
-* A(I:M,I+1:N) = A(I:m,I+1:N) + alpha*A(I:M,I)*W(1:N-1)^H
-*
- ALPHA = -(T( I, 1 ))
- CALL DGER( M-I+1, N-I, ALPHA, A( I, I ), 1,
- $ T( 1, N ), 1, A( I, I+1 ), LDA )
- A( I, I ) = AII
- END IF
- END DO
-*
- DO I = 2, N
- AII = A( I, I )
- A( I, I ) = ONE
-*
-* T(1:I-1,I) := alpha * A(I:M,1:I-1)**T * A(I:M,I)
-*
- ALPHA = -T( I, 1 )
- CALL DGEMV( 'T', M-I+1, I-1, ALPHA, A( I, 1 ), LDA,
- $ A( I, I ), 1, ZERO, T( 1, I ), 1 )
- A( I, I ) = AII
-*
-* T(1:I-1,I) := T(1:I-1,1:I-1) * T(1:I-1,I)
-*
- CALL DTRMV( 'U', 'N', 'N', I-1, T, LDT, T( 1, I ), 1 )
-*
-* T(I,I) = tau(I)
-*
- T( I, I ) = T( I, 1 )
- T( I, 1) = ZERO
- END DO
-
-*
-* End of DGEQRT2
-*
- END
diff --git a/netlib/LAPACK/dgeqrt3.f b/netlib/LAPACK/dgeqrt3.f
deleted file mode 100644
index c5f57a2..0000000
--- a/netlib/LAPACK/dgeqrt3.f
+++ /dev/null
@@ -1,257 +0,0 @@
-*> \brief \b DGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQRT3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqrt3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqrt3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqrt3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* RECURSIVE SUBROUTINE DGEQRT3( M, N, A, LDA, T, LDT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LDT
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), T( LDT, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQRT3 recursively computes a QR factorization of a real M-by-N
-*> matrix A, using the compact WY representation of Q.
-*>
-*> Based on the algorithm of Elmroth and Gustavson,
-*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= N.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the real M-by-N matrix A. On exit, the elements on and
-*> above the diagonal contain the N-by-N upper triangular matrix R; the
-*> elements below the diagonal are the columns of V. See below for
-*> further details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The N-by-N upper triangular factor of the block reflector.
-*> The elements on and above the diagonal contain the block
-*> reflector T; the elements below the diagonal are not used.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
-*>
-*> V = ( 1 )
-*> ( v1 1 )
-*> ( v1 v2 1 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> where the vi's represent the vectors which define H(i), which are returned
-*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
-*> block reflector H is then given by
-*>
-*> H = I - V * T * V**T
-*>
-*> where V**T is the transpose of V.
-*>
-*> For details of the algorithm, see Elmroth and Gustavson (cited above).
-*> \endverbatim
-*>
-* =====================================================================
- RECURSIVE SUBROUTINE DGEQRT3( M, N, A, LDA, T, LDT, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N, LDT
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), T( LDT, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+00 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, J, J1, N1, N2, IINFO
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFG, DTRMM, DGEMM, XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N .LT. 0 ) THEN
- INFO = -2
- ELSE IF( M .LT. N ) THEN
- INFO = -1
- ELSE IF( LDA .LT. MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LDT .LT. MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRT3', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
-*
-* Compute Householder transform when N=1
-*
- CALL DLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T )
-*
- ELSE
-*
-* Otherwise, split A into blocks...
-*
- N1 = N/2
- N2 = N-N1
- J1 = MIN( N1+1, N )
- I1 = MIN( N+1, M )
-*
-* Compute A(1:M,1:N1) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
-*
- CALL DGEQRT3( M, N1, A, LDA, T, LDT, IINFO )
-*
-* Compute A(1:M,J1:N) = Q1^H A(1:M,J1:N) [workspace: T(1:N1,J1:N)]
-*
- DO J=1,N2
- DO I=1,N1
- T( I, J+N1 ) = A( I, J+N1 )
- END DO
- END DO
- CALL DTRMM( 'L', 'L', 'T', 'U', N1, N2, ONE,
- & A, LDA, T( 1, J1 ), LDT )
-*
- CALL DGEMM( 'T', 'N', N1, N2, M-N1, ONE, A( J1, 1 ), LDA,
- & A( J1, J1 ), LDA, ONE, T( 1, J1 ), LDT)
-*
- CALL DTRMM( 'L', 'U', 'T', 'N', N1, N2, ONE,
- & T, LDT, T( 1, J1 ), LDT )
-*
- CALL DGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( J1, 1 ), LDA,
- & T( 1, J1 ), LDT, ONE, A( J1, J1 ), LDA )
-*
- CALL DTRMM( 'L', 'L', 'N', 'U', N1, N2, ONE,
- & A, LDA, T( 1, J1 ), LDT )
-*
- DO J=1,N2
- DO I=1,N1
- A( I, J+N1 ) = A( I, J+N1 ) - T( I, J+N1 )
- END DO
- END DO
-*
-* Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
-*
- CALL DGEQRT3( M-N1, N2, A( J1, J1 ), LDA,
- & T( J1, J1 ), LDT, IINFO )
-*
-* Compute T3 = T(1:N1,J1:N) = -T1 Y1^H Y2 T2
-*
- DO I=1,N1
- DO J=1,N2
- T( I, J+N1 ) = (A( J+N1, I ))
- END DO
- END DO
-*
- CALL DTRMM( 'R', 'L', 'N', 'U', N1, N2, ONE,
- & A( J1, J1 ), LDA, T( 1, J1 ), LDT )
-*
- CALL DGEMM( 'T', 'N', N1, N2, M-N, ONE, A( I1, 1 ), LDA,
- & A( I1, J1 ), LDA, ONE, T( 1, J1 ), LDT )
-*
- CALL DTRMM( 'L', 'U', 'N', 'N', N1, N2, -ONE, T, LDT,
- & T( 1, J1 ), LDT )
-*
- CALL DTRMM( 'R', 'U', 'N', 'N', N1, N2, ONE,
- & T( J1, J1 ), LDT, T( 1, J1 ), LDT )
-*
-* Y = (Y1,Y2); R = [ R1 A(1:N1,J1:N) ]; T = [T1 T3]
-* [ 0 R2 ] [ 0 T2]
-*
- END IF
-*
- RETURN
-*
-* End of DGEQRT3
-*
- END
diff --git a/netlib/LAPACK/dgerfs.f b/netlib/LAPACK/dgerfs.f
deleted file mode 100644
index 9a48db9..0000000
--- a/netlib/LAPACK/dgerfs.f
+++ /dev/null
@@ -1,438 +0,0 @@
-*> \brief \b DGERFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGERFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgerfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgerfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgerfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
-* X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGERFS improves the computed solution to a system of linear
-*> equations and provides error bounds and backward error estimates for
-*> the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The original N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DGETRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
- $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANST
- INTEGER COUNT, I, J, K, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DGETRS, DLACN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGERFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(op(A))*abs(X) + abs(B).
-*
- IF( NOTRAN ) THEN
- DO 50 K = 1, N
- XK = ABS( X( K, J ) )
- DO 40 I = 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- DO 60 I = 1, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK( N+1 ),
- $ N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DGERFS
-*
- END
diff --git a/netlib/LAPACK/dgerq2.f b/netlib/LAPACK/dgerq2.f
deleted file mode 100644
index 310e80c..0000000
--- a/netlib/LAPACK/dgerq2.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief \b DGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGERQ2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgerq2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgerq2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgerq2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGERQ2 computes an RQ factorization of a real m by n matrix A:
-*> A = R * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, if m <= n, the upper triangle of the subarray
-*> A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
-*> if m >= n, the elements on and above the (m-n)-th subdiagonal
-*> contain the m by n upper trapezoidal matrix R; the remaining
-*> elements, with the array TAU, represent the orthogonal matrix
-*> Q as a product of elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*> A(m-k+i,1:n-k+i-1), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGERQ2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = K, 1, -1
-*
-* Generate elementary reflector H(i) to annihilate
-* A(m-k+i,1:n-k+i-1)
-*
- CALL DLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
- $ TAU( I ) )
-*
-* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
-*
- AII = A( M-K+I, N-K+I )
- A( M-K+I, N-K+I ) = ONE
- CALL DLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
- $ TAU( I ), A, LDA, WORK )
- A( M-K+I, N-K+I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DGERQ2
-*
- END
diff --git a/netlib/LAPACK/dgerqf.f b/netlib/LAPACK/dgerqf.f
deleted file mode 100644
index 033913d..0000000
--- a/netlib/LAPACK/dgerqf.f
+++ /dev/null
@@ -1,287 +0,0 @@
-*> \brief \b DGERQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGERQF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgerqf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgerqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgerqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGERQF computes an RQ factorization of a real M-by-N matrix A:
-*> A = R * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if m <= n, the upper triangle of the subarray
-*> A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
-*> if m >= n, the elements on and above the (m-n)-th subdiagonal
-*> contain the M-by-N upper trapezoidal matrix R;
-*> the remaining elements, with the array TAU, represent the
-*> orthogonal matrix Q as a product of min(m,n) elementary
-*> reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*> A(m-k+i,1:n-k+i-1), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
- $ MU, NB, NBMIN, NU, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGERQ2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGERQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 1
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGERQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGERQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially.
-* The last kk rows are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
- DO 10 I = K - KK + KI + 1, K - KK + 1, -NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the RQ factorization of the current block
-* A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1)
-*
- CALL DGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ),
- $ WORK, IINFO )
- IF( M-K+I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
- $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
-*
- CALL DLARFB( 'Right', 'No transpose', 'Backward',
- $ 'Rowwise', M-K+I-1, N-K+I+IB-1, IB,
- $ A( M-K+I, 1 ), LDA, WORK, LDWORK, A, LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- MU = M - K + I + NB - 1
- NU = N - K + I + NB - 1
- ELSE
- MU = M
- NU = N
- END IF
-*
-* Use unblocked code to factor the last or only block
-*
- IF( MU.GT.0 .AND. NU.GT.0 )
- $ CALL DGERQ2( MU, NU, A, LDA, TAU, WORK, IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGERQF
-*
- END
diff --git a/netlib/LAPACK/dgesc2.f b/netlib/LAPACK/dgesc2.f
deleted file mode 100644
index 75c0607..0000000
--- a/netlib/LAPACK/dgesc2.f
+++ /dev/null
@@ -1,201 +0,0 @@
-*> \brief \b DGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESC2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesc2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesc2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesc2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), JPIV( * )
-* DOUBLE PRECISION A( LDA, * ), RHS( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGESC2 solves a system of linear equations
-*>
-*> A * X = scale* RHS
-*>
-*> with a general N-by-N matrix A using the LU factorization with
-*> complete pivoting computed by DGETC2.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the LU part of the factorization of the n-by-n
-*> matrix A computed by DGETC2: A = P * L * U * Q
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] RHS
-*> \verbatim
-*> RHS is DOUBLE PRECISION array, dimension (N).
-*> On entry, the right hand side vector b.
-*> On exit, the solution vector X.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= i <= N, row i of the
-*> matrix has been interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] JPIV
-*> \verbatim
-*> JPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= j <= N, column j of the
-*> matrix has been interchanged with column JPIV(j).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On exit, SCALE contains the scale factor. SCALE is chosen
-*> 0 <= SCALE <= 1 to prevent owerflow in the solution.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
- SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- DOUBLE PRECISION A( LDA, * ), RHS( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, TWO
- PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASWP, DSCAL
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL IDAMAX, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Set constant to control owerflow
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Apply permutations IPIV to RHS
-*
- CALL DLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
-*
-* Solve for L part
-*
- DO 20 I = 1, N - 1
- DO 10 J = I + 1, N
- RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
- 10 CONTINUE
- 20 CONTINUE
-*
-* Solve for U part
-*
- SCALE = ONE
-*
-* Check for scaling
-*
- I = IDAMAX( N, RHS, 1 )
- IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
- TEMP = ( ONE / TWO ) / ABS( RHS( I ) )
- CALL DSCAL( N, TEMP, RHS( 1 ), 1 )
- SCALE = SCALE*TEMP
- END IF
-*
- DO 40 I = N, 1, -1
- TEMP = ONE / A( I, I )
- RHS( I ) = RHS( I )*TEMP
- DO 30 J = I + 1, N
- RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Apply permutations JPIV to the solution (RHS)
-*
- CALL DLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
- RETURN
-*
-* End of DGESC2
-*
- END
diff --git a/netlib/LAPACK/dgesdd.f b/netlib/LAPACK/dgesdd.f
deleted file mode 100644
index 31a811a..0000000
--- a/netlib/LAPACK/dgesdd.f
+++ /dev/null
@@ -1,1431 +0,0 @@
-*> \brief \b DGESDD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESDD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesdd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesdd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesdd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
-* LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ
-* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGESDD computes the singular value decomposition (SVD) of a real
-*> M-by-N matrix A, optionally computing the left and right singular
-*> vectors. If singular vectors are desired, it uses a
-*> divide-and-conquer algorithm.
-*>
-*> The SVD is written
-*>
-*> A = U * SIGMA * transpose(V)
-*>
-*> where SIGMA is an M-by-N matrix which is zero except for its
-*> min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
-*> V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
-*> are the singular values of A; they are real and non-negative, and
-*> are returned in descending order. The first min(m,n) columns of
-*> U and V are the left and right singular vectors of A.
-*>
-*> Note that the routine returns VT = V**T, not V.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> Specifies options for computing all or part of the matrix U:
-*> = 'A': all M columns of U and all N rows of V**T are
-*> returned in the arrays U and VT;
-*> = 'S': the first min(M,N) columns of U and the first
-*> min(M,N) rows of V**T are returned in the arrays U
-*> and VT;
-*> = 'O': If M >= N, the first N columns of U are overwritten
-*> on the array A and all rows of V**T are returned in
-*> the array VT;
-*> otherwise, all columns of U are returned in the
-*> array U and the first M rows of V**T are overwritten
-*> in the array A;
-*> = 'N': no columns of U or rows of V**T are computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if JOBZ = 'O', A is overwritten with the first N columns
-*> of U (the left singular vectors, stored
-*> columnwise) if M >= N;
-*> A is overwritten with the first M rows
-*> of V**T (the right singular vectors, stored
-*> rowwise) otherwise.
-*> if JOBZ .ne. 'O', the contents of A are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (min(M,N))
-*> The singular values of A, sorted so that S(i) >= S(i+1).
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,UCOL)
-*> UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
-*> UCOL = min(M,N) if JOBZ = 'S'.
-*> If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
-*> orthogonal matrix U;
-*> if JOBZ = 'S', U contains the first min(M,N) columns of U
-*> (the left singular vectors, stored columnwise);
-*> if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1; if
-*> JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT,N)
-*> If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
-*> N-by-N orthogonal matrix V**T;
-*> if JOBZ = 'S', VT contains the first min(M,N) rows of
-*> V**T (the right singular vectors, stored rowwise);
-*> if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1; if
-*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
-*> if JOBZ = 'S', LDVT >= min(M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 1.
-*> If JOBZ = 'N',
-*> LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)).
-*> If JOBZ = 'O',
-*> LWORK >= 3*min(M,N) +
-*> max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
-*> If JOBZ = 'S' or 'A'
-*> LWORK >= 3*min(M,N) +
-*> max(max(M,N),4*min(M,N)*min(M,N)+3*min(M,N)+max(M,N)).
-*> For good performance, LWORK should generally be larger.
-*> If LWORK = -1 but other input arguments are legal, WORK(1)
-*> returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (8*min(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: DBDSDC did not converge, updating process failed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEsing
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
- $ LWORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ
- INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IL,
- $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT,
- $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK,
- $ MNTHR, NWORK, WRKBL
- DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER IDUM( 1 )
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DBDSDC, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY,
- $ DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL DLAMCH, DLANGE, ILAENV, LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- WNTQA = LSAME( JOBZ, 'A' )
- WNTQS = LSAME( JOBZ, 'S' )
- WNTQAS = WNTQA .OR. WNTQS
- WNTQO = LSAME( JOBZ, 'O' )
- WNTQN = LSAME( JOBZ, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDU.LT.1 .OR. ( WNTQAS .AND. LDU.LT.M ) .OR.
- $ ( WNTQO .AND. M.LT.N .AND. LDU.LT.M ) ) THEN
- INFO = -8
- ELSE IF( LDVT.LT.1 .OR. ( WNTQA .AND. LDVT.LT.N ) .OR.
- $ ( WNTQS .AND. LDVT.LT.MINMN ) .OR.
- $ ( WNTQO .AND. M.GE.N .AND. LDVT.LT.N ) ) THEN
- INFO = -10
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-* Compute space needed for DBDSDC
-*
- MNTHR = INT( MINMN*11.0D0 / 6.0D0 )
- IF( WNTQN ) THEN
- BDSPAC = 7*N
- ELSE
- BDSPAC = 3*N*N + 4*N
- END IF
- IF( M.GE.MNTHR ) THEN
- IF( WNTQN ) THEN
-*
-* Path 1 (M much larger than N, JOBZ='N')
-*
- WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+N )
- MINWRK = BDSPAC + N
- ELSE IF( WNTQO ) THEN
-*
-* Path 2 (M much larger than N, JOBZ='O')
-*
- WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
- $ N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + 2*N*N
- MINWRK = BDSPAC + 2*N*N + 3*N
- ELSE IF( WNTQS ) THEN
-*
-* Path 3 (M much larger than N, JOBZ='S')
-*
- WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
- $ N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 3*N
- ELSE IF( WNTQA ) THEN
-*
-* Path 4 (M much larger than N, JOBZ='A')
-*
- WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
- $ M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 2*N + M
- END IF
- ELSE
-*
-* Path 5 (M at least N, but not much larger)
-*
- WRKBL = 3*N + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1,
- $ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- ELSE IF( WNTQO ) THEN
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + M*N
- MINWRK = 3*N + MAX( M, N*N+BDSPAC )
- ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*N+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( MAXWRK, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- END IF
- END IF
- ELSE IF( MINMN.GT.0 ) THEN
-*
-* Compute space needed for DBDSDC
-*
- MNTHR = INT( MINMN*11.0D0 / 6.0D0 )
- IF( WNTQN ) THEN
- BDSPAC = 7*M
- ELSE
- BDSPAC = 3*M*M + 4*M
- END IF
- IF( N.GE.MNTHR ) THEN
- IF( WNTQN ) THEN
-*
-* Path 1t (N much larger than M, JOBZ='N')
-*
- WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+M )
- MINWRK = BDSPAC + M
- ELSE IF( WNTQO ) THEN
-*
-* Path 2t (N much larger than M, JOBZ='O')
-*
- WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
- $ N, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + 2*M*M
- MINWRK = BDSPAC + 2*M*M + 3*M
- ELSE IF( WNTQS ) THEN
-*
-* Path 3t (N much larger than M, JOBZ='S')
-*
- WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
- $ N, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
- ELSE IF( WNTQA ) THEN
-*
-* Path 4t (N much larger than M, JOBZ='A')
-*
- WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
- $ N, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
- END IF
- ELSE
-*
-* Path 5t (N greater than M, but not much larger)
-*
- WRKBL = 3*M + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1,
- $ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- ELSE IF( WNTQO ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + M*N
- MINWRK = 3*M + MAX( N, M*M+BDSPAC )
- ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- END IF
- END IF
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESDD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, DUM )
- ISCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ISCL = 1
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ISCL = 1
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* A has at least as many rows as columns. If A has sufficiently
-* more rows than columns, first reduce using the QR
-* decomposition (if sufficient workspace available)
-*
- IF( M.GE.MNTHR ) THEN
-*
- IF( WNTQN ) THEN
-*
-* Path 1 (M much larger than N, JOBZ='N')
-* No singular vectors to be computed
-*
- ITAU = 1
- NWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Zero out below R
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- NWORK = IE + N
-*
-* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need N+BDSPAC)
-*
- CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
-*
- ELSE IF( WNTQO ) THEN
-*
-* Path 2 (M much larger than N, JOBZ = 'O')
-* N left singular vectors to be overwritten on A and
-* N right singular vectors to be computed in VT
-*
- IR = 1
-*
-* WORK(IR) is LDWRKR by N
-*
- IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN
- LDWRKR = LDA
- ELSE
- LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N
- END IF
- ITAU = IR + LDWRKR*N
- NWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in VT, copying result to WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* WORK(IU) is N by N
-*
- IU = NWORK
- NWORK = IU + N*N
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in WORK(IU) and computing right
-* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
- $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite WORK(IU) by left singular vectors of R
-* and VT by right singular vectors of R
-* (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in WORK(IR) and copying to A
-* (Workspace: need 2*N*N, prefer N*N+M*N)
-*
- DO 10 I = 1, M, LDWRKR
- CHUNK = MIN( M-I+1, LDWRKR )
- CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IU ), N, ZERO, WORK( IR ),
- $ LDWRKR )
- CALL DLACPY( 'F', CHUNK, N, WORK( IR ), LDWRKR,
- $ A( I, 1 ), LDA )
- 10 CONTINUE
-*
- ELSE IF( WNTQS ) THEN
-*
-* Path 3 (M much larger than N, JOBZ='S')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IR = 1
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- ITAU = IR + LDWRKR*N
- NWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagoal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of R and VT
-* by right singular vectors of R
-* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
- CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in U
-* (Workspace: need N*N)
-*
- CALL DLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR )
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA, WORK( IR ),
- $ LDWRKR, ZERO, U, LDU )
-*
- ELSE IF( WNTQA ) THEN
-*
-* Path 4 (M much larger than N, JOBZ='A')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IU = 1
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- ITAU = IU + LDWRKU*N
- NWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Produce R in A, zeroing out other entries
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in WORK(IU) and computing right
-* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
- $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite WORK(IU) by left singular vectors of R and VT
-* by right singular vectors of R
-* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', N, N, N, A, LDA,
- $ WORK( ITAUQ ), WORK( IU ), LDWRKU,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ),
- $ LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- END IF
-*
- ELSE
-*
-* M .LT. MNTHR
-*
-* Path 5 (M at least N, but not much larger)
-* Reduce to bidiagonal form without QR decomposition
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- IF( WNTQN ) THEN
-*
-* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need N+BDSPAC)
-*
- CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
- ELSE IF( WNTQO ) THEN
- IU = NWORK
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
-*
-* WORK( IU ) is M by N
-*
- LDWRKU = M
- NWORK = IU + LDWRKU*N
- CALL DLASET( 'F', M, N, ZERO, ZERO, WORK( IU ),
- $ LDWRKU )
- ELSE
-*
-* WORK( IU ) is N by N
-*
- LDWRKU = N
- NWORK = IU + LDWRKU*N
-*
-* WORK(IR) is LDWRKR by N
-*
- IR = NWORK
- LDWRKR = ( LWORK-N*N-3*N ) / N
- END IF
- NWORK = IU + LDWRKU*N
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in WORK(IU) and computing right
-* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ),
- $ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ),
- $ IWORK, INFO )
-*
-* Overwrite VT by right singular vectors of A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
-*
-* Overwrite WORK(IU) by left singular vectors of A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), WORK( IU ), LDWRKU,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Copy left singular vectors of A from WORK(IU) to A
-*
- CALL DLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA )
- ELSE
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by left singular vectors of
-* bidiagonal matrix in WORK(IU), storing result in
-* WORK(IR) and copying to A
-* (Workspace: need 2*N*N, prefer N*N+M*N)
-*
- DO 20 I = 1, M, LDWRKR
- CHUNK = MIN( M-I+1, LDWRKR )
- CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IU ), LDWRKU, ZERO,
- $ WORK( IR ), LDWRKR )
- CALL DLACPY( 'F', CHUNK, N, WORK( IR ), LDWRKR,
- $ A( I, 1 ), LDA )
- 20 CONTINUE
- END IF
-*
- ELSE IF( WNTQS ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
-*
- CALL DLASET( 'F', M, N, ZERO, ZERO, U, LDU )
- CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
-*
- CALL DLASET( 'F', M, M, ZERO, ZERO, U, LDU )
- CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Set the right corner of U to identity matrix
-*
- IF( M.GT.N ) THEN
- CALL DLASET( 'F', M-N, M-N, ZERO, ONE, U( N+1, N+1 ),
- $ LDU )
- END IF
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', N, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- END IF
-*
- END IF
-*
- ELSE
-*
-* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition (if
-* sufficient workspace available)
-*
- IF( N.GE.MNTHR ) THEN
-*
- IF( WNTQN ) THEN
-*
-* Path 1t (N much larger than M, JOBZ='N')
-* No singular vectors to be computed
-*
- ITAU = 1
- NWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Zero out above L
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- NWORK = IE + M
-*
-* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need M+BDSPAC)
-*
- CALL DBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
-*
- ELSE IF( WNTQO ) THEN
-*
-* Path 2t (N much larger than M, JOBZ='O')
-* M right singular vectors to be overwritten on A and
-* M left singular vectors to be computed in U
-*
- IVT = 1
-*
-* IVT is M by M
-*
- IL = IVT + M*M
- IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN
-*
-* WORK(IL) is M by N
-*
- LDWRKL = M
- CHUNK = N
- ELSE
- LDWRKL = M
- CHUNK = ( LWORK-M*M ) / M
- END IF
- ITAU = IL + LDWRKL*M
- NWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy L to WORK(IL), zeroing about above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IL+LDWRKL ), LDWRKL )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IL)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U, and computing right singular
-* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
- $ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ),
- $ IWORK, INFO )
-*
-* Overwrite U by left singular vectors of L and WORK(IVT)
-* by right singular vectors of L
-* (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUP ), WORK( IVT ), M,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply right singular vectors of L in WORK(IVT) by Q
-* in A, storing result in WORK(IL) and copying to A
-* (Workspace: need 2*M*M, prefer M*M+M*N)
-*
- DO 30 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M,
- $ A( 1, I ), LDA, ZERO, WORK( IL ), LDWRKL )
- CALL DLACPY( 'F', M, BLK, WORK( IL ), LDWRKL,
- $ A( 1, I ), LDA )
- 30 CONTINUE
-*
- ELSE IF( WNTQS ) THEN
-*
-* Path 3t (N much larger than M, JOBZ='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IL = 1
-*
-* WORK(IL) is M by M
-*
- LDWRKL = M
- ITAU = IL + LDWRKL*M
- NWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy L to WORK(IL), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IL+LDWRKL ), LDWRKL )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of L and VT
-* by right singular vectors of L
-* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply right singular vectors of L in WORK(IL) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL )
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), LDWRKL,
- $ A, LDA, ZERO, VT, LDVT )
-*
- ELSE IF( WNTQA ) THEN
-*
-* Path 4t (N much larger than M, JOBZ='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IVT = 1
-*
-* WORK(IVT) is M by M
-*
- LDWKVT = M
- ITAU = IVT + LDWKVT*M
- NWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Produce L in A, zeroing out other entries
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
-*
- CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
- $ WORK( IVT ), LDWKVT, DUM, IDUM,
- $ WORK( NWORK ), IWORK, INFO )
-*
-* Overwrite U by left singular vectors of L and WORK(IVT)
-* by right singular vectors of L
-* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, M, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', M, M, M, A, LDA,
- $ WORK( ITAUP ), WORK( IVT ), LDWKVT,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply right singular vectors of L in WORK(IVT) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT,
- $ VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- END IF
-*
- ELSE
-*
-* N .LT. MNTHR
-*
-* Path 5t (N greater than M, but not much larger)
-* Reduce to bidiagonal form without LQ decomposition
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- IF( WNTQN ) THEN
-*
-* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need M+BDSPAC)
-*
- CALL DBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
- ELSE IF( WNTQO ) THEN
- LDWKVT = M
- IVT = NWORK
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
-*
-* WORK( IVT ) is M by N
-*
- CALL DLASET( 'F', M, N, ZERO, ZERO, WORK( IVT ),
- $ LDWKVT )
- NWORK = IVT + LDWKVT*N
- ELSE
-*
-* WORK( IVT ) is M by M
-*
- NWORK = IVT + LDWKVT*M
- IL = NWORK
-*
-* WORK(IL) is M by CHUNK
-*
- CHUNK = ( LWORK-M*M-3*M ) / M
- END IF
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU,
- $ WORK( IVT ), LDWKVT, DUM, IDUM,
- $ WORK( NWORK ), IWORK, INFO )
-*
-* Overwrite U by left singular vectors of A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
-*
-* Overwrite WORK(IVT) by left singular vectors of A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), WORK( IVT ), LDWKVT,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Copy right singular vectors of A from WORK(IVT) to A
-*
- CALL DLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA )
- ELSE
-*
-* Generate P**T in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by right singular vectors of
-* bidiagonal matrix in WORK(IVT), storing result in
-* WORK(IL) and copying to A
-* (Workspace: need 2*M*M, prefer M*M+M*N)
-*
- DO 40 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ),
- $ LDWKVT, A( 1, I ), LDA, ZERO,
- $ WORK( IL ), M )
- CALL DLACPY( 'F', M, BLK, WORK( IL ), M, A( 1, I ),
- $ LDA )
- 40 CONTINUE
- END IF
- ELSE IF( WNTQS ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
-*
- CALL DLASET( 'F', M, N, ZERO, ZERO, VT, LDVT )
- CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need 3*M, prefer 2*M+M*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
-*
- CALL DLASET( 'F', N, N, ZERO, ZERO, VT, LDVT )
- CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Set the right corner of VT to identity matrix
-*
- IF( N.GT.M ) THEN
- CALL DLASET( 'F', N-M, N-M, ZERO, ONE, VT( M+1, M+1 ),
- $ LDVT )
- END IF
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need 2*M+N, prefer 2*M+N*NB)
-*
- CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL DORMBR( 'P', 'R', 'T', N, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- END IF
-*
- END IF
-*
- END IF
-*
-* Undo scaling if necessary
-*
- IF( ISCL.EQ.1 ) THEN
- IF( ANRM.GT.BIGNUM )
- $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( ANRM.LT.SMLNUM )
- $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- END IF
-*
-* Return optimal workspace in WORK(1)
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of DGESDD
-*
- END
diff --git a/netlib/LAPACK/dgesv.f b/netlib/LAPACK/dgesv.f
deleted file mode 100644
index 8d47f83..0000000
--- a/netlib/LAPACK/dgesv.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief <b> DGESV computes the solution to system of linear equations A * X = B for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGESV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*>
-*> The LU decomposition with partial pivoting and row interchanges is
-*> used to factor A as
-*> A = P * L * U,
-*> where P is a permutation matrix, L is unit lower triangular, and U is
-*> upper triangular. The factored form of A is then used to solve the
-*> system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N coefficient matrix A.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL DGETRF, DGETRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of A.
-*
- CALL DGETRF( N, N, A, LDA, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
- $ INFO )
- END IF
- RETURN
-*
-* End of DGESV
-*
- END
diff --git a/netlib/LAPACK/dgesvd.f b/netlib/LAPACK/dgesvd.f
deleted file mode 100644
index 898570b..0000000
--- a/netlib/LAPACK/dgesvd.f
+++ /dev/null
@@ -1,3493 +0,0 @@
-*> \brief <b> DGESVD computes the singular value decomposition (SVD) for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU, JOBVT
-* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGESVD computes the singular value decomposition (SVD) of a real
-*> M-by-N matrix A, optionally computing the left and/or right singular
-*> vectors. The SVD is written
-*>
-*> A = U * SIGMA * transpose(V)
-*>
-*> where SIGMA is an M-by-N matrix which is zero except for its
-*> min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
-*> V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
-*> are the singular values of A; they are real and non-negative, and
-*> are returned in descending order. The first min(m,n) columns of
-*> U and V are the left and right singular vectors of A.
-*>
-*> Note that the routine returns V**T, not V.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies options for computing all or part of the matrix U:
-*> = 'A': all M columns of U are returned in array U:
-*> = 'S': the first min(m,n) columns of U (the left singular
-*> vectors) are returned in the array U;
-*> = 'O': the first min(m,n) columns of U (the left singular
-*> vectors) are overwritten on the array A;
-*> = 'N': no columns of U (no left singular vectors) are
-*> computed.
-*> \endverbatim
-*>
-*> \param[in] JOBVT
-*> \verbatim
-*> JOBVT is CHARACTER*1
-*> Specifies options for computing all or part of the matrix
-*> V**T:
-*> = 'A': all N rows of V**T are returned in the array VT;
-*> = 'S': the first min(m,n) rows of V**T (the right singular
-*> vectors) are returned in the array VT;
-*> = 'O': the first min(m,n) rows of V**T (the right singular
-*> vectors) are overwritten on the array A;
-*> = 'N': no rows of V**T (no right singular vectors) are
-*> computed.
-*>
-*> JOBVT and JOBU cannot both be 'O'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if JOBU = 'O', A is overwritten with the first min(m,n)
-*> columns of U (the left singular vectors,
-*> stored columnwise);
-*> if JOBVT = 'O', A is overwritten with the first min(m,n)
-*> rows of V**T (the right singular vectors,
-*> stored rowwise);
-*> if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
-*> are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (min(M,N))
-*> The singular values of A, sorted so that S(i) >= S(i+1).
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,UCOL)
-*> (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
-*> If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
-*> if JOBU = 'S', U contains the first min(m,n) columns of U
-*> (the left singular vectors, stored columnwise);
-*> if JOBU = 'N' or 'O', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1; if
-*> JOBU = 'S' or 'A', LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT,N)
-*> If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
-*> V**T;
-*> if JOBVT = 'S', VT contains the first min(m,n) rows of
-*> V**T (the right singular vectors, stored rowwise);
-*> if JOBVT = 'N' or 'O', VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1; if
-*> JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
-*> if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
-*> superdiagonal elements of an upper bidiagonal matrix B
-*> whose diagonal is in S (not necessarily sorted). B
-*> satisfies A = U * B * VT, so it has the same singular values
-*> as A, and singular vectors related by U and VT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code):
-*> - PATH 1 (M much larger than N, JOBU='N')
-*> - PATH 1t (N much larger than M, JOBVT='N')
-*> LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) for the other paths
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if DBDSQR did not converge, INFO specifies how many
-*> superdiagonals of an intermediate bidiagonal form B
-*> did not converge to zero. See the description of WORK
-*> above for details.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEsing
-*
-* =====================================================================
- SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
- $ VT, LDVT, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU, JOBVT
- INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
- $ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
- $ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
- $ NRVT, WRKBL
- INTEGER LWORK_DGEQRF, LWORK_DORGQR_N, LWORK_DORGQR_M,
- $ LWORK_DGEBRD, LWORK_DORGBR_P, LWORK_DORGBR_Q,
- $ LWORK_DGELQF, LWORK_DORGLQ_N, LWORK_DORGLQ_M
- DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DBDSQR, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY,
- $ DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- WNTUA = LSAME( JOBU, 'A' )
- WNTUS = LSAME( JOBU, 'S' )
- WNTUAS = WNTUA .OR. WNTUS
- WNTUO = LSAME( JOBU, 'O' )
- WNTUN = LSAME( JOBU, 'N' )
- WNTVA = LSAME( JOBVT, 'A' )
- WNTVS = LSAME( JOBVT, 'S' )
- WNTVAS = WNTVA .OR. WNTVS
- WNTVO = LSAME( JOBVT, 'O' )
- WNTVN = LSAME( JOBVT, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
- $ ( WNTVO .AND. WNTUO ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
- INFO = -9
- ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
- $ ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-* Compute space needed for DBDSQR
-*
- MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
- BDSPAC = 5*N
-* Compute space needed for DGEQRF
- CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DGEQRF=DUM(1)
-* Compute space needed for DORGQR
- CALL DORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGQR_N=DUM(1)
- CALL DORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGQR_M=DUM(1)
-* Compute space needed for DGEBRD
- CALL DGEBRD( N, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORGBR P
- CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
-* Compute space needed for DORGBR Q
- CALL DORGBR( 'Q', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
-*
- IF( M.GE.MNTHR ) THEN
- IF( WNTUN ) THEN
-*
-* Path 1 (M much larger than N, JOBU='N')
-*
- MAXWRK = N + LWORK_DGEQRF
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DGEBRD )
- IF( WNTVO .OR. WNTVAS )
- $ MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 4*N, BDSPAC )
- ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-* Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVN ) THEN
-*
-* Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVO ) THEN
-*
-* Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVAS ) THEN
-*
-* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVN ) THEN
-*
-* Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVO ) THEN
-*
-* Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVAS ) THEN
-*
-* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- END IF
- ELSE
-*
-* Path 10 (M at least N, but not much larger)
-*
- CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
- MAXWRK = 3*N + LWORK_DGEBRD
- IF( WNTUS .OR. WNTUO ) THEN
- CALL DORGBR( 'Q', M, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q )
- END IF
- IF( WNTUA ) THEN
- CALL DORGBR( 'Q', M, M, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q )
- END IF
- IF( .NOT.WNTVN ) THEN
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P )
- END IF
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 3*N+M, BDSPAC )
- END IF
- ELSE IF( MINMN.GT.0 ) THEN
-*
-* Compute space needed for DBDSQR
-*
- MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
- BDSPAC = 5*M
-* Compute space needed for DGELQF
- CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DGELQF=DUM(1)
-* Compute space needed for DORGLQ
- CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGLQ_N=DUM(1)
- CALL DORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGLQ_M=DUM(1)
-* Compute space needed for DGEBRD
- CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORGBR P
- CALL DORGBR( 'P', M, M, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
-* Compute space needed for DORGBR Q
- CALL DORGBR( 'Q', M, M, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
- IF( N.GE.MNTHR ) THEN
- IF( WNTVN ) THEN
-*
-* Path 1t(N much larger than M, JOBVT='N')
-*
- MAXWRK = M + LWORK_DGELQF
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DGEBRD )
- IF( WNTUO .OR. WNTUAS )
- $ MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 4*M, BDSPAC )
- ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-* Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-* Path 3t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='O')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUN ) THEN
-*
-* Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUO ) THEN
-*
-* Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUAS ) THEN
-*
-* Path 6t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='S')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUN ) THEN
-*
-* Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUO ) THEN
-*
-* Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUAS ) THEN
-*
-* Path 9t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='A')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- END IF
- ELSE
-*
-* Path 10t(N greater than M, but not much larger)
-*
- CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
- MAXWRK = 3*M + LWORK_DGEBRD
- IF( WNTVS .OR. WNTVO ) THEN
-* Compute space needed for DORGBR P
- CALL DORGBR( 'P', M, N, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P )
- END IF
- IF( WNTVA ) THEN
- CALL DORGBR( 'P', N, N, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P )
- END IF
- IF( .NOT.WNTUN ) THEN
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q )
- END IF
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 3*M+N, BDSPAC )
- END IF
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, DUM )
- ISCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ISCL = 1
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ISCL = 1
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* A has at least as many rows as columns. If A has sufficiently
-* more rows than columns, first reduce using the QR
-* decomposition (if sufficient workspace available)
-*
- IF( M.GE.MNTHR ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 1 (M much larger than N, JOBU='N')
-* No left singular vectors to be computed
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Zero out below R
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- NCVT = 0
- IF( WNTVO .OR. WNTVAS ) THEN
-*
-* If right singular vectors desired, generate P'.
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- NCVT = N
- END IF
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in A if desired
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA,
- $ DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
-* If right singular vectors desired in VT, copy them there
-*
- IF( WNTVAS )
- $ CALL DLACPY( 'F', N, N, A, LDA, VT, LDVT )
-*
- ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-* Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-* N left singular vectors to be overwritten on A and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N, WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-* WORK(IU) is LDA by N, WORK(IR) is N by N
-*
- LDWRKU = LDA
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is LDWRKU by N, WORK(IR) is N by N
-*
- LDWRKU = ( LWORK-N*N-N ) / N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IR) and zero out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing R
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1,
- $ WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + N
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in WORK(IU) and copying to A
-* (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
- DO 10 I = 1, M, LDWRKU
- CHUNK = MIN( M-I+1, LDWRKU )
- CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IR ), LDWRKR, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
- $ A( I, 1 ), LDA )
- 10 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing A
-* (Workspace: need 4*N, prefer 3*N+N*NB)
-*
- CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1,
- $ A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
-* N left singular vectors to be overwritten on A and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is LDWRKU by N and WORK(IR) is N by N
-*
- LDWRKU = ( LWORK-N*N-N ) / N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT, copying result to WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
-*
-* Generate left vectors bidiagonalizing R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in VT
-* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR) and computing right
-* singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT,
- $ WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + N
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in WORK(IU) and copying to A
-* (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
- DO 20 I = 1, M, LDWRKU
- CHUNK = MIN( M-I+1, LDWRKU )
- CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IR ), LDWRKR, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
- $ A( I, 1 ), LDA )
- 20 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
-*
-* Generate Q in A
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in A by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), A, LDA, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT,
- $ A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTUS ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-* N left singular vectors to be computed in U and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IR) is LDA by N
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IR+1 ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
- $ 1, WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in U
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IR ), LDWRKR, ZERO, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
- $ 1, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVO ) THEN
-*
-* Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is N by N and WORK(IR) is N by N
-*
- LDWRKU = N
- IR = IU + LDWRKU*N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*N*N+4*N,
-* prefer 2*N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*N*N+4*N-1,
-* prefer 2*N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in WORK(IR)
-* (Workspace: need 2*N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, WORK( IU ),
- $ LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in U
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
-* Copy right singular vectors of R to A
-* (Workspace: need N*N)
-*
- CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
- $ LDA, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVAS ) THEN
-*
-* Path 6 (M much larger than N, JOBU='S', JOBVT='S'
-* or 'A')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- END IF
- ITAU = IU + LDWRKU*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to VT
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
- $ LDVT )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need N*N+4*N-1,
-* prefer N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
- $ LDVT, WORK( IU ), LDWRKU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in U
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in VT
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- ELSE IF( WNTUA ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-* M left singular vectors to be computed in U and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IR) is LDA by N
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IR+1 ), LDWRKR )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
- $ 1, WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IR), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IR ), LDWRKR, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in A
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
- $ 1, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVO ) THEN
-*
-* Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is N by N and WORK(IR) is N by N
-*
- LDWRKU = N
- IR = IU + LDWRKU*N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*N*N+4*N,
-* prefer 2*N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*N*N+4*N-1,
-* prefer 2*N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in WORK(IR)
-* (Workspace: need 2*N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, WORK( IU ),
- $ LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-* Copy right singular vectors of R from WORK(IR) to A
-*
- CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in A
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
- $ LDA, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVAS ) THEN
-*
-* Path 9 (M much larger than N, JOBU='A', JOBVT='S'
-* or 'A')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- END IF
- ITAU = IU + LDWRKU*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to VT
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
- $ LDVT )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need N*N+4*N-1,
-* prefer N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
- $ LDVT, WORK( IU ), LDWRKU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R from A to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in VT
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* M .LT. MNTHR
-*
-* Path 10 (M at least N, but not much larger)
-* Reduce to bidiagonal form without QR decomposition
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUAS ) THEN
-*
-* If left singular vectors desired in U, copy result to U
-* and generate left bidiagonalizing vectors in U
-* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB)
-*
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
- IF( WNTUS )
- $ NCU = N
- IF( WNTUA )
- $ NCU = M
- CALL DORGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVAS ) THEN
-*
-* If right singular vectors desired in VT, copy result to
-* VT and generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTUO ) THEN
-*
-* If left singular vectors desired in A, generate left
-* bidiagonalizing vectors in A
-* (Workspace: need 4*N, prefer 3*N+N*NB)
-*
- CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVO ) THEN
-*
-* If right singular vectors desired in A, generate right
-* bidiagonalizing vectors in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + N
- IF( WNTUAS .OR. WNTUO )
- $ NRU = M
- IF( WNTUN )
- $ NRU = 0
- IF( WNTVAS .OR. WNTVO )
- $ NCVT = N
- IF( WNTVN )
- $ NCVT = 0
- IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in A and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
- END IF
-*
- END IF
-*
- ELSE
-*
-* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition (if
-* sufficient workspace available)
-*
- IF( N.GE.MNTHR ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 1t(N much larger than M, JOBVT='N')
-* No right singular vectors to be computed
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Zero out above L
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUO .OR. WNTUAS ) THEN
-*
-* If left singular vectors desired, generate Q
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + M
- NRU = 0
- IF( WNTUO .OR. WNTUAS )
- $ NRU = M
-*
-* Perform bidiagonal QR iteration, computing left singular
-* vectors of A in A if desired
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A,
- $ LDA, DUM, 1, WORK( IWORK ), INFO )
-*
-* If left singular vectors desired in U, copy them there
-*
- IF( WNTUAS )
- $ CALL DLACPY( 'F', M, M, A, LDA, U, LDU )
-*
- ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-* Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-* M right singular vectors to be overwritten on A and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is M by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
- LDWRKU = M
- CHUNK = ( LWORK-M*M-M ) / M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IR) and zero out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing L
-* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + M
-*
-* Multiply right singular vectors of L in WORK(IR) by Q
-* in A, storing result in WORK(IU) and copying to A
-* (Workspace: need M*M+2*M, prefer M*M+M*N+M)
-*
- DO 30 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
- $ LDWRKR, A( 1, I ), LDA, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
- $ A( 1, I ), LDA )
- 30 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA,
- $ DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
-* M right singular vectors to be overwritten on A and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is M by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
- LDWRKU = M
- CHUNK = ( LWORK-M*M-M ) / M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing about above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U, copying result to WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
-*
-* Generate right vectors bidiagonalizing L in WORK(IR)
-* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing L in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U, and computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + M
-*
-* Multiply right singular vectors of L in WORK(IR) by Q
-* in A, storing result in WORK(IU) and copying to A
-* (Workspace: need M*M+2*M, prefer M*M+M*N+M))
-*
- DO 40 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
- $ LDWRKR, A( 1, I ), LDA, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
- $ A( 1, I ), LDA )
- 40 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
-*
-* Generate Q in A
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in A
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), A, LDA, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing L in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTVS ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-* M right singular vectors to be computed in VT and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IR) is LDA by M
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is M by M
-*
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IR), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing L in
-* WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IR) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
- $ LDWRKR, A, LDA, ZERO, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy result to VT
-*
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
- $ LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUO ) THEN
-*
-* Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is M by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by M and WORK(IR) is M by M
-*
- LDWRKU = M
- IR = IU + LDWRKU*M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*M*M+4*M,
-* prefer 2*M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*M*M+4*M-1,
-* prefer 2*M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in WORK(IR) and computing
-* right singular vectors of L in WORK(IU)
-* (Workspace: need 2*M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, WORK( IR ),
- $ LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
-* Copy left singular vectors of L to A
-* (Workspace: need M*M)
-*
- CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors of L in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, compute left
-* singular vectors of A in A and compute right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUAS ) THEN
-*
-* Path 6t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is LDA by M
-*
- LDWRKU = M
- END IF
- ITAU = IU + LDWRKU*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
- $ LDU )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need M*M+4*M-1,
-* prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U and computing right
-* singular vectors of L in WORK(IU)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in U by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- ELSE IF( WNTVA ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-* N right singular vectors to be computed in VT and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IR) is LDA by M
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is M by M
-*
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Copy L to WORK(IR), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in VT
-* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need M*M+4*M-1,
-* prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IR) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
- $ LDWRKR, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in A by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
- $ LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUO ) THEN
-*
-* Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is M by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by M and WORK(IR) is M by M
-*
- LDWRKU = M
- IR = IU + LDWRKU*M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*M*M+4*M,
-* prefer 2*M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*M*M+4*M-1,
-* prefer 2*M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in WORK(IR) and computing
-* right singular vectors of L in WORK(IU)
-* (Workspace: need 2*M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, WORK( IR ),
- $ LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-* Copy left singular vectors of A from WORK(IR) to A
-*
- CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in A by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUAS ) THEN
-*
-* Path 9t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IU) is LDA by M
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is M by M
-*
- LDWRKU = M
- END IF
- ITAU = IU + LDWRKU*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
- $ LDU )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U and computing right
-* singular vectors of L in WORK(IU)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in U by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N .LT. MNTHR
-*
-* Path 10t(N greater than M, but not much larger)
-* Reduce to bidiagonal form without LQ decomposition
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUAS ) THEN
-*
-* If left singular vectors desired in U, copy result to U
-* and generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVAS ) THEN
-*
-* If right singular vectors desired in VT, copy result to
-* VT and generate right bidiagonalizing vectors in VT
-* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB)
-*
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
- IF( WNTVA )
- $ NRVT = N
- IF( WNTVS )
- $ NRVT = M
- CALL DORGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTUO ) THEN
-*
-* If left singular vectors desired in A, generate left
-* bidiagonalizing vectors in A
-* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
- CALL DORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVO ) THEN
-*
-* If right singular vectors desired in A, generate right
-* bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + M
- IF( WNTUAS .OR. WNTUO )
- $ NRU = M
- IF( WNTUN )
- $ NRU = 0
- IF( WNTVAS .OR. WNTVO )
- $ NCVT = N
- IF( WNTVN )
- $ NCVT = 0
- IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in A and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
- END IF
-*
- END IF
-*
- END IF
-*
-* If DBDSQR failed to converge, copy unconverged superdiagonals
-* to WORK( 2:MINMN )
-*
- IF( INFO.NE.0 ) THEN
- IF( IE.GT.2 ) THEN
- DO 50 I = 1, MINMN - 1
- WORK( I+1 ) = WORK( I+IE-1 )
- 50 CONTINUE
- END IF
- IF( IE.LT.2 ) THEN
- DO 60 I = MINMN - 1, 1, -1
- WORK( I+1 ) = WORK( I+IE-1 )
- 60 CONTINUE
- END IF
- END IF
-*
-* Undo scaling if necessary
-*
- IF( ISCL.EQ.1 ) THEN
- IF( ANRM.GT.BIGNUM )
- $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
- $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
- $ MINMN, IERR )
- IF( ANRM.LT.SMLNUM )
- $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
- $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
- $ MINMN, IERR )
- END IF
-*
-* Return optimal workspace in WORK(1)
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of DGESVD
-*
- END
diff --git a/netlib/LAPACK/dgesvj.f b/netlib/LAPACK/dgesvj.f
deleted file mode 100644
index 9364a3d..0000000
--- a/netlib/LAPACK/dgesvj.f
+++ /dev/null
@@ -1,1613 +0,0 @@
-*> \brief \b DGESVJ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESVJ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesvj.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesvj.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesvj.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
-* LDV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDV, LWORK, M, MV, N
-* CHARACTER*1 JOBA, JOBU, JOBV
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), SVA( N ), V( LDV, * ),
-* $ WORK( LWORK )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGESVJ computes the singular value decomposition (SVD) of a real
-*> M-by-N matrix A, where M >= N. The SVD of A is written as
-*> [++] [xx] [x0] [xx]
-*> A = U * SIGMA * V^t, [++] = [xx] * [ox] * [xx]
-*> [++] [xx]
-*> where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal
-*> matrix, and V is an N-by-N orthogonal matrix. The diagonal elements
-*> of SIGMA are the singular values of A. The columns of U and V are the
-*> left and the right singular vectors of A, respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBA
-*> \verbatim
-*> JOBA is CHARACTER* 1
-*> Specifies the structure of A.
-*> = 'L': The input matrix A is lower triangular;
-*> = 'U': The input matrix A is upper triangular;
-*> = 'G': The input matrix A is general M-by-N matrix, M >= N.
-*> \endverbatim
-*>
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies whether to compute the left singular vectors
-*> (columns of U):
-*> = 'U': The left singular vectors corresponding to the nonzero
-*> singular values are computed and returned in the leading
-*> columns of A. See more details in the description of A.
-*> The default numerical orthogonality threshold is set to
-*> approximately TOL=CTOL*EPS, CTOL=DSQRT(M), EPS=DLAMCH('E').
-*> = 'C': Analogous to JOBU='U', except that user can control the
-*> level of numerical orthogonality of the computed left
-*> singular vectors. TOL can be set to TOL = CTOL*EPS, where
-*> CTOL is given on input in the array WORK.
-*> No CTOL smaller than ONE is allowed. CTOL greater
-*> than 1 / EPS is meaningless. The option 'C'
-*> can be used if M*EPS is satisfactory orthogonality
-*> of the computed left singular vectors, so CTOL=M could
-*> save few sweeps of Jacobi rotations.
-*> See the descriptions of A and WORK(1).
-*> = 'N': The matrix U is not computed. However, see the
-*> description of A.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether to compute the right singular vectors, that
-*> is, the matrix V:
-*> = 'V' : the matrix V is computed and returned in the array V
-*> = 'A' : the Jacobi rotations are applied to the MV-by-N
-*> array V. In other words, the right singular vector
-*> matrix V is not computed explicitly, instead it is
-*> applied to an MV-by-N matrix initially stored in the
-*> first MV rows of V.
-*> = 'N' : the matrix V is not computed and the array V is not
-*> referenced
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. 1/DLAMCH('E') > M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A.
-*> M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit :
-*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C' :
-*> If INFO .EQ. 0 :
-*> RANKA orthonormal columns of U are returned in the
-*> leading RANKA columns of the array A. Here RANKA <= N
-*> is the number of computed singular values of A that are
-*> above the underflow threshold DLAMCH('S'). The singular
-*> vectors corresponding to underflowed or zero singular
-*> values are not computed. The value of RANKA is returned
-*> in the array WORK as RANKA=NINT(WORK(2)). Also see the
-*> descriptions of SVA and WORK. The computed columns of U
-*> are mutually numerically orthogonal up to approximately
-*> TOL=DSQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'),
-*> see the description of JOBU.
-*> If INFO .GT. 0 :
-*> the procedure DGESVJ did not converge in the given number
-*> of iterations (sweeps). In that case, the computed
-*> columns of U may not be orthogonal up to TOL. The output
-*> U (stored in A), SIGMA (given by the computed singular
-*> values in SVA(1:N)) and V is still a decomposition of the
-*> input matrix A in the sense that the residual
-*> ||A-SCALE*U*SIGMA*V^T||_2 / ||A||_2 is small.
-*>
-*> If JOBU .EQ. 'N' :
-*> If INFO .EQ. 0 :
-*> Note that the left singular vectors are 'for free' in the
-*> one-sided Jacobi SVD algorithm. However, if only the
-*> singular values are needed, the level of numerical
-*> orthogonality of U is not an issue and iterations are
-*> stopped when the columns of the iterated matrix are
-*> numerically orthogonal up to approximately M*EPS. Thus,
-*> on exit, A contains the columns of U scaled with the
-*> corresponding singular values.
-*> If INFO .GT. 0 :
-*> the procedure DGESVJ did not converge in the given number
-*> of iterations (sweeps).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] SVA
-*> \verbatim
-*> SVA is DOUBLE PRECISION array, dimension (N)
-*> On exit :
-*> If INFO .EQ. 0 :
-*> depending on the value SCALE = WORK(1), we have:
-*> If SCALE .EQ. ONE :
-*> SVA(1:N) contains the computed singular values of A.
-*> During the computation SVA contains the Euclidean column
-*> norms of the iterated matrices in the array A.
-*> If SCALE .NE. ONE :
-*> The singular values of A are SCALE*SVA(1:N), and this
-*> factored representation is due to the fact that some of the
-*> singular values of A might underflow or overflow.
-*> If INFO .GT. 0 :
-*> the procedure DGESVJ did not converge in the given number of
-*> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate.
-*> \endverbatim
-*>
-*> \param[in] MV
-*> \verbatim
-*> MV is INTEGER
-*> If JOBV .EQ. 'A', then the product of Jacobi rotations in DGESVJ
-*> is applied to the first MV rows of V. See the description of JOBV.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,N)
-*> If JOBV = 'V', then V contains on exit the N-by-N matrix of
-*> the right singular vectors;
-*> If JOBV = 'A', then V contains the product of the computed right
-*> singular vector matrix and the initial matrix in
-*> the array V.
-*> If JOBV = 'N', then V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV .GE. 1.
-*> If JOBV .EQ. 'V', then LDV .GE. max(1,N).
-*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) .
-*> \endverbatim
-*>
-*> \param[in,out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension max(4,M+N).
-*> On entry :
-*> If JOBU .EQ. 'C' :
-*> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
-*> The process stops if all columns of A are mutually
-*> orthogonal up to CTOL*EPS, EPS=DLAMCH('E').
-*> It is required that CTOL >= ONE, i.e. it is not
-*> allowed to force the routine to obtain orthogonality
-*> below EPS.
-*> On exit :
-*> WORK(1) = SCALE is the scaling factor such that SCALE*SVA(1:N)
-*> are the computed singular values of A.
-*> (See description of SVA().)
-*> WORK(2) = NINT(WORK(2)) is the number of the computed nonzero
-*> singular values.
-*> WORK(3) = NINT(WORK(3)) is the number of the computed singular
-*> values that are larger than the underflow threshold.
-*> WORK(4) = NINT(WORK(4)) is the number of sweeps of Jacobi
-*> rotations needed for numerical convergence.
-*> WORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep.
-*> This is useful information in cases when DGESVJ did
-*> not converge, as it can be used to estimate whether
-*> the output is stil useful and for post festum analysis.
-*> WORK(6) = the largest absolute value over all sines of the
-*> Jacobi rotation angles in the last sweep. It can be
-*> useful for a post festum analysis.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> length of WORK, WORK >= MAX(6,M+N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit.
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value
-*> > 0 : DGESVJ did not converge in the maximal allowed number (30)
-*> of sweeps. The output may still be useful. See the
-*> description of WORK.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The orthogonal N-by-N matrix V is obtained as a product of Jacobi plane
-*> rotations. The rotations are implemented as fast scaled rotations of
-*> Anda and Park [1]. In the case of underflow of the Jacobi angle, a
-*> modified Jacobi transformation of Drmac [4] is used. Pivot strategy uses
-*> column interchanges of de Rijk [2]. The relative accuracy of the computed
-*> singular values and the accuracy of the computed singular vectors (in
-*> angle metric) is as guaranteed by the theory of Demmel and Veselic [3].
-*> The condition number that determines the accuracy in the full rank case
-*> is essentially min_{D=diag} kappa(A*D), where kappa(.) is the
-*> spectral condition number. The best performance of this Jacobi SVD
-*> procedure is achieved if used in an accelerated version of Drmac and
-*> Veselic [5,6], and it is the kernel routine in the SIGMA library [7].
-*> Some tunning parameters (marked with [TP]) are available for the
-*> implementer.
-*> The computational range for the nonzero singular values is the machine
-*> number interval ( UNDERFLOW , OVERFLOW ). In extreme cases, even
-*> denormalized singular values can be computed with the corresponding
-*> gradual loss of accurate digits.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> \verbatim
-*>
-*> ============
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] A. A. Anda and H. Park: Fast plane rotations with dynamic scaling.
-*> SIAM J. matrix Anal. Appl., Vol. 15 (1994), pp. 162-174.
-*> [2] P. P. M. De Rijk: A one-sided Jacobi algorithm for computing the
-*> singular value decomposition on a vector computer.
-*> SIAM J. Sci. Stat. Comp., Vol. 10 (1998), pp. 359-371.
-*> [3] J. Demmel and K. Veselic: Jacobi method is more accurate than QR.
-*> [4] Z. Drmac: Implementation of Jacobi rotations for accurate singular
-*> value computation in floating point arithmetic.
-*> SIAM J. Sci. Comp., Vol. 18 (1997), pp. 1200-1222.
-*> [5] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.
-*> LAPACK Working note 169.
-*> [6] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.
-*> LAPACK Working note 170.
-*> [7] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,
-*> QSVD, (H,K)-SVD computations.
-*> Department of Mathematics, University of Zagreb, 2008.
-*> \endverbatim
-*
-*> \par Bugs, examples and comments:
-* =================================
-*>
-*> \verbatim
-*> ===========================
-*> Please report all bugs and send interesting test examples and comments to
-*> drmac at math.hr. Thank you.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
- $ LDV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDV, LWORK, M, MV, N
- CHARACTER*1 JOBA, JOBU, JOBV
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), SVA( N ), V( LDV, * ),
- $ WORK( LWORK )
-* ..
-*
-* =====================================================================
-*
-* .. Local Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0)
- INTEGER NSWEEP
- PARAMETER ( NSWEEP = 30 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
- $ BIGTHETA, CS, CTOL, EPSLN, LARGE, MXAAPQ,
- $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
- $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA,
- $ THSIGN, TOL
- INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
- $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
- $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
- $ SWBAND
- LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK,
- $ RSVEC, UCTOL, UPPER
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION FASTR( 5 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS, DMAX1, DMIN1, DBLE, MIN0, DSIGN, DSQRT
-* ..
-* .. External Functions ..
-* ..
-* from BLAS
- DOUBLE PRECISION DDOT, DNRM2
- EXTERNAL DDOT, DNRM2
- INTEGER IDAMAX
- EXTERNAL IDAMAX
-* from LAPACK
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
-* ..
-* from BLAS
- EXTERNAL DAXPY, DCOPY, DROTM, DSCAL, DSWAP
-* from LAPACK
- EXTERNAL DLASCL, DLASET, DLASSQ, XERBLA
-*
- EXTERNAL DGSVJ0, DGSVJ1
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- LSVEC = LSAME( JOBU, 'U' )
- UCTOL = LSAME( JOBU, 'C' )
- RSVEC = LSAME( JOBV, 'V' )
- APPLV = LSAME( JOBV, 'A' )
- UPPER = LSAME( JOBA, 'U' )
- LOWER = LSAME( JOBA, 'L' )
-*
- IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN
- INFO = -5
- ELSE IF( LDA.LT.M ) THEN
- INFO = -7
- ELSE IF( MV.LT.0 ) THEN
- INFO = -9
- ELSE IF( ( RSVEC .AND. ( LDV.LT.N ) ) .OR.
- $ ( APPLV .AND. ( LDV.LT.MV ) ) ) THEN
- INFO = -11
- ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN
- INFO = -12
- ELSE IF( LWORK.LT.MAX0( M+N, 6 ) ) THEN
- INFO = -13
- ELSE
- INFO = 0
- END IF
-*
-* #:(
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESVJ', -INFO )
- RETURN
- END IF
-*
-* #:) Quick return for void matrix
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN
-*
-* Set numerical parameters
-* The stopping criterion for Jacobi rotations is
-*
-* max_{i<>j}|A(:,i)^T * A(:,j)|/(||A(:,i)||*||A(:,j)||) < CTOL*EPS
-*
-* where EPS is the round-off and CTOL is defined as follows:
-*
- IF( UCTOL ) THEN
-* ... user controlled
- CTOL = WORK( 1 )
- ELSE
-* ... default
- IF( LSVEC .OR. RSVEC .OR. APPLV ) THEN
- CTOL = DSQRT( DBLE( M ) )
- ELSE
- CTOL = DBLE( M )
- END IF
- END IF
-* ... and the machine dependent parameters are
-*[!] (Make sure that DLAMCH() works properly on the target machine.)
-*
- EPSLN = DLAMCH( 'Epsilon' )
- ROOTEPS = DSQRT( EPSLN )
- SFMIN = DLAMCH( 'SafeMinimum' )
- ROOTSFMIN = DSQRT( SFMIN )
- SMALL = SFMIN / EPSLN
- BIG = DLAMCH( 'Overflow' )
-* BIG = ONE / SFMIN
- ROOTBIG = ONE / ROOTSFMIN
- LARGE = BIG / DSQRT( DBLE( M*N ) )
- BIGTHETA = ONE / ROOTEPS
-*
- TOL = CTOL*EPSLN
- ROOTTOL = DSQRT( TOL )
-*
- IF( DBLE( M )*EPSLN.GE.ONE ) THEN
- INFO = -4
- CALL XERBLA( 'DGESVJ', -INFO )
- RETURN
- END IF
-*
-* Initialize the right singular vector matrix.
-*
- IF( RSVEC ) THEN
- MVL = N
- CALL DLASET( 'A', MVL, N, ZERO, ONE, V, LDV )
- ELSE IF( APPLV ) THEN
- MVL = MV
- END IF
- RSVEC = RSVEC .OR. APPLV
-*
-* Initialize SVA( 1:N ) = ( ||A e_i||_2, i = 1:N )
-*(!) If necessary, scale A to protect the largest singular value
-* from overflow. It is possible that saving the largest singular
-* value destroys the information about the small ones.
-* This initial scaling is almost minimal in the sense that the
-* goal is to make sure that no column norm overflows, and that
-* DSQRT(N)*max_i SVA(i) does not overflow. If INFinite entries
-* in A are detected, the procedure returns with INFO=-6.
-*
- SKL= ONE / DSQRT( DBLE( M )*DBLE( N ) )
- NOSCALE = .TRUE.
- GOSCALE = .TRUE.
-*
- IF( LOWER ) THEN
-* the input matrix is M-by-N lower triangular (trapezoidal)
- DO 1874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL DLASSQ( M-p+1, A( p, p ), 1, AAPP, AAQQ )
- IF( AAPP.GT.BIG ) THEN
- INFO = -6
- CALL XERBLA( 'DGESVJ', -INFO )
- RETURN
- END IF
- AAQQ = DSQRT( AAQQ )
- IF( ( AAPP.LT.( BIG / AAQQ ) ) .AND. NOSCALE ) THEN
- SVA( p ) = AAPP*AAQQ
- ELSE
- NOSCALE = .FALSE.
- SVA( p ) = AAPP*( AAQQ*SKL)
- IF( GOSCALE ) THEN
- GOSCALE = .FALSE.
- DO 1873 q = 1, p - 1
- SVA( q ) = SVA( q )*SKL
- 1873 CONTINUE
- END IF
- END IF
- 1874 CONTINUE
- ELSE IF( UPPER ) THEN
-* the input matrix is M-by-N upper triangular (trapezoidal)
- DO 2874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL DLASSQ( p, A( 1, p ), 1, AAPP, AAQQ )
- IF( AAPP.GT.BIG ) THEN
- INFO = -6
- CALL XERBLA( 'DGESVJ', -INFO )
- RETURN
- END IF
- AAQQ = DSQRT( AAQQ )
- IF( ( AAPP.LT.( BIG / AAQQ ) ) .AND. NOSCALE ) THEN
- SVA( p ) = AAPP*AAQQ
- ELSE
- NOSCALE = .FALSE.
- SVA( p ) = AAPP*( AAQQ*SKL)
- IF( GOSCALE ) THEN
- GOSCALE = .FALSE.
- DO 2873 q = 1, p - 1
- SVA( q ) = SVA( q )*SKL
- 2873 CONTINUE
- END IF
- END IF
- 2874 CONTINUE
- ELSE
-* the input matrix is M-by-N general dense
- DO 3874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A( 1, p ), 1, AAPP, AAQQ )
- IF( AAPP.GT.BIG ) THEN
- INFO = -6
- CALL XERBLA( 'DGESVJ', -INFO )
- RETURN
- END IF
- AAQQ = DSQRT( AAQQ )
- IF( ( AAPP.LT.( BIG / AAQQ ) ) .AND. NOSCALE ) THEN
- SVA( p ) = AAPP*AAQQ
- ELSE
- NOSCALE = .FALSE.
- SVA( p ) = AAPP*( AAQQ*SKL)
- IF( GOSCALE ) THEN
- GOSCALE = .FALSE.
- DO 3873 q = 1, p - 1
- SVA( q ) = SVA( q )*SKL
- 3873 CONTINUE
- END IF
- END IF
- 3874 CONTINUE
- END IF
-*
- IF( NOSCALE )SKL= ONE
-*
-* Move the smaller part of the spectrum from the underflow threshold
-*(!) Start by determining the position of the nonzero entries of the
-* array SVA() relative to ( SFMIN, BIG ).
-*
- AAPP = ZERO
- AAQQ = BIG
- DO 4781 p = 1, N
- IF( SVA( p ).NE.ZERO )AAQQ = DMIN1( AAQQ, SVA( p ) )
- AAPP = DMAX1( AAPP, SVA( p ) )
- 4781 CONTINUE
-*
-* #:) Quick return for zero matrix
-*
- IF( AAPP.EQ.ZERO ) THEN
- IF( LSVEC )CALL DLASET( 'G', M, N, ZERO, ONE, A, LDA )
- WORK( 1 ) = ONE
- WORK( 2 ) = ZERO
- WORK( 3 ) = ZERO
- WORK( 4 ) = ZERO
- WORK( 5 ) = ZERO
- WORK( 6 ) = ZERO
- RETURN
- END IF
-*
-* #:) Quick return for one-column matrix
-*
- IF( N.EQ.1 ) THEN
- IF( LSVEC )CALL DLASCL( 'G', 0, 0, SVA( 1 ), SKL, M, 1,
- $ A( 1, 1 ), LDA, IERR )
- WORK( 1 ) = ONE / SKL
- IF( SVA( 1 ).GE.SFMIN ) THEN
- WORK( 2 ) = ONE
- ELSE
- WORK( 2 ) = ZERO
- END IF
- WORK( 3 ) = ZERO
- WORK( 4 ) = ZERO
- WORK( 5 ) = ZERO
- WORK( 6 ) = ZERO
- RETURN
- END IF
-*
-* Protect small singular values from underflow, and try to
-* avoid underflows/overflows in computing Jacobi rotations.
-*
- SN = DSQRT( SFMIN / EPSLN )
- TEMP1 = DSQRT( BIG / DBLE( N ) )
- IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR.
- $ ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN
- TEMP1 = DMIN1( BIG, TEMP1 / AAPP )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN
- TEMP1 = DMIN1( SN / AAQQ, BIG / ( AAPP*DSQRT( DBLE( N ) ) ) )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN
- TEMP1 = DMAX1( SN / AAQQ, TEMP1 / AAPP )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN
- TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DBLE( N ) )*AAPP ) )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE
- TEMP1 = ONE
- END IF
-*
-* Scale, if necessary
-*
- IF( TEMP1.NE.ONE ) THEN
- CALL DLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR )
- END IF
- SKL= TEMP1*SKL
- IF( SKL.NE.ONE ) THEN
- CALL DLASCL( JOBA, 0, 0, ONE, SKL, M, N, A, LDA, IERR )
- SKL= ONE / SKL
- END IF
-*
-* Row-cyclic Jacobi SVD algorithm with column pivoting
-*
- EMPTSW = ( N*( N-1 ) ) / 2
- NOTROT = 0
- FASTR( 1 ) = ZERO
-*
-* A is represented in factored form A = A * diag(WORK), where diag(WORK)
-* is initialized to identity. WORK is updated during fast scaled
-* rotations.
-*
- DO 1868 q = 1, N
- WORK( q ) = ONE
- 1868 CONTINUE
-*
-*
- SWBAND = 3
-*[TP] SWBAND is a tuning parameter [TP]. It is meaningful and effective
-* if DGESVJ is used as a computational routine in the preconditioned
-* Jacobi SVD algorithm DGESVJ. For sweeps i=1:SWBAND the procedure
-* works on pivots inside a band-like region around the diagonal.
-* The boundaries are determined dynamically, based on the number of
-* pivots above a threshold.
-*
- KBL = MIN0( 8, N )
-*[TP] KBL is a tuning parameter that defines the tile size in the
-* tiling of the p-q loops of pivot pairs. In general, an optimal
-* value of KBL depends on the matrix dimensions and on the
-* parameters of the computer's memory.
-*
- NBL = N / KBL
- IF( ( NBL*KBL ).NE.N )NBL = NBL + 1
-*
- BLSKIP = KBL**2
-*[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
-*
- ROWSKIP = MIN0( 5, KBL )
-*[TP] ROWSKIP is a tuning parameter.
-*
- LKAHEAD = 1
-*[TP] LKAHEAD is a tuning parameter.
-*
-* Quasi block transformations, using the lower (upper) triangular
-* structure of the input matrix. The quasi-block-cycling usually
-* invokes cubic convergence. Big part of this cycle is done inside
-* canonical subspaces of dimensions less than M.
-*
- IF( ( LOWER .OR. UPPER ) .AND. ( N.GT.MAX0( 64, 4*KBL ) ) ) THEN
-*[TP] The number of partition levels and the actual partition are
-* tuning parameters.
- N4 = N / 4
- N2 = N / 2
- N34 = 3*N4
- IF( APPLV ) THEN
- q = 0
- ELSE
- q = 1
- END IF
-*
- IF( LOWER ) THEN
-*
-* This works very well on lower triangular matrices, in particular
-* in the framework of the preconditioned Jacobi SVD (xGEJSV).
-* The idea is simple:
-* [+ 0 0 0] Note that Jacobi transformations of [0 0]
-* [+ + 0 0] [0 0]
-* [+ + x 0] actually work on [x 0] [x 0]
-* [+ + x x] [x x]. [x x]
-*
- CALL DGSVJ0( JOBV, M-N34, N-N34, A( N34+1, N34+1 ), LDA,
- $ WORK( N34+1 ), SVA( N34+1 ), MVL,
- $ V( N34*q+1, N34+1 ), LDV, EPSLN, SFMIN, TOL,
- $ 2, WORK( N+1 ), LWORK-N, IERR )
-*
- CALL DGSVJ0( JOBV, M-N2, N34-N2, A( N2+1, N2+1 ), LDA,
- $ WORK( N2+1 ), SVA( N2+1 ), MVL,
- $ V( N2*q+1, N2+1 ), LDV, EPSLN, SFMIN, TOL, 2,
- $ WORK( N+1 ), LWORK-N, IERR )
-*
- CALL DGSVJ1( JOBV, M-N2, N-N2, N4, A( N2+1, N2+1 ), LDA,
- $ WORK( N2+1 ), SVA( N2+1 ), MVL,
- $ V( N2*q+1, N2+1 ), LDV, EPSLN, SFMIN, TOL, 1,
- $ WORK( N+1 ), LWORK-N, IERR )
-*
- CALL DGSVJ0( JOBV, M-N4, N2-N4, A( N4+1, N4+1 ), LDA,
- $ WORK( N4+1 ), SVA( N4+1 ), MVL,
- $ V( N4*q+1, N4+1 ), LDV, EPSLN, SFMIN, TOL, 1,
- $ WORK( N+1 ), LWORK-N, IERR )
-*
- CALL DGSVJ0( JOBV, M, N4, A, LDA, WORK, SVA, MVL, V, LDV,
- $ EPSLN, SFMIN, TOL, 1, WORK( N+1 ), LWORK-N,
- $ IERR )
-*
- CALL DGSVJ1( JOBV, M, N2, N4, A, LDA, WORK, SVA, MVL, V,
- $ LDV, EPSLN, SFMIN, TOL, 1, WORK( N+1 ),
- $ LWORK-N, IERR )
-*
-*
- ELSE IF( UPPER ) THEN
-*
-*
- CALL DGSVJ0( JOBV, N4, N4, A, LDA, WORK, SVA, MVL, V, LDV,
- $ EPSLN, SFMIN, TOL, 2, WORK( N+1 ), LWORK-N,
- $ IERR )
-*
- CALL DGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, WORK( N4+1 ),
- $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV,
- $ EPSLN, SFMIN, TOL, 1, WORK( N+1 ), LWORK-N,
- $ IERR )
-*
- CALL DGSVJ1( JOBV, N2, N2, N4, A, LDA, WORK, SVA, MVL, V,
- $ LDV, EPSLN, SFMIN, TOL, 1, WORK( N+1 ),
- $ LWORK-N, IERR )
-*
- CALL DGSVJ0( JOBV, N2+N4, N4, A( 1, N2+1 ), LDA,
- $ WORK( N2+1 ), SVA( N2+1 ), MVL,
- $ V( N2*q+1, N2+1 ), LDV, EPSLN, SFMIN, TOL, 1,
- $ WORK( N+1 ), LWORK-N, IERR )
-
- END IF
-*
- END IF
-*
-* .. Row-cyclic pivot strategy with de Rijk's pivoting ..
-*
- DO 1993 i = 1, NSWEEP
-*
-* .. go go go ...
-*
- MXAAPQ = ZERO
- MXSINJ = ZERO
- ISWROT = 0
-*
- NOTROT = 0
- PSKIPPED = 0
-*
-* Each sweep is unrolled using KBL-by-KBL tiles over the pivot pairs
-* 1 <= p < q <= N. This is the first step toward a blocked implementation
-* of the rotations. New implementation, based on block transformations,
-* is under development.
-*
- DO 2000 ibr = 1, NBL
-*
- igl = ( ibr-1 )*KBL + 1
-*
- DO 1002 ir1 = 0, MIN0( LKAHEAD, NBL-ibr )
-*
- igl = igl + ir1*KBL
-*
- DO 2001 p = igl, MIN0( igl+KBL-1, N-1 )
-*
-* .. de Rijk's pivoting
-*
- q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- CALL DSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL DSWAP( MVL, V( 1, p ), 1,
- $ V( 1, q ), 1 )
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = WORK( p )
- WORK( p ) = WORK( q )
- WORK( q ) = TEMP1
- END IF
-*
- IF( ir1.EQ.0 ) THEN
-*
-* Column norms are periodically updated by explicit
-* norm computation.
-* Caveat:
-* Unfortunately, some BLAS implementations compute DNRM2(M,A(1,p),1)
-* as DSQRT(DDOT(M,A(1,p),1,A(1,p),1)), which may cause the result to
-* overflow for ||A(:,p)||_2 > DSQRT(overflow_threshold), and to
-* underflow for ||A(:,p)||_2 < DSQRT(underflow_threshold).
-* Hence, DNRM2 cannot be trusted, not even in the case when
-* the true norm is far from the under(over)flow boundaries.
-* If properly implemented DNRM2 is available, the IF-THEN-ELSE
-* below should read "AAPP = DNRM2( M, A(1,p), 1 ) * WORK(p)".
-*
- IF( ( SVA( p ).LT.ROOTBIG ) .AND.
- $ ( SVA( p ).GT.ROOTSFMIN ) ) THEN
- SVA( p ) = DNRM2( M, A( 1, p ), 1 )*WORK( p )
- ELSE
- TEMP1 = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, TEMP1, AAPP )
- SVA( p ) = TEMP1*DSQRT( AAPP )*WORK( p )
- END IF
- AAPP = SVA( p )
- ELSE
- AAPP = SVA( p )
- END IF
-*
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2002 q = p + 1, MIN0( igl+KBL-1, N )
-*
- AAQQ = SVA( q )
-*
- IF( AAQQ.GT.ZERO ) THEN
-*
- AAPP0 = AAPP
- IF( AAQQ.GE.ONE ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL DCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAPP,
- $ WORK( p ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = DDOT( M, WORK( N+1 ), 1,
- $ A( 1, q ), 1 )*WORK( q ) / AAQQ
- END IF
- ELSE
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL DCOPY( M, A( 1, q ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ,
- $ WORK( q ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = DDOT( M, WORK( N+1 ), 1,
- $ A( 1, p ), 1 )*WORK( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( DABS( AAPQ ).GT.TOL ) THEN
-*
-* .. rotate
-*[RTD] ROTATED = ROTATED + ONE
-*
- IF( ir1.EQ.0 ) THEN
- NOTROT = 0
- PSKIPPED = 0
- ISWROT = ISWROT + 1
- END IF
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*DABS(AQOAP-APOAQ)/AAPQ
-*
- IF( DABS( THETA ).GT.BIGTHETA ) THEN
-*
- T = HALF / THETA
- FASTR( 3 ) = T*WORK( p ) / WORK( q )
- FASTR( 4 ) = -T*WORK( q ) /
- $ WORK( p )
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, DABS( T ) )
-*
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -DSIGN( ONE, AAPQ )
- T = ONE / ( THETA+THSIGN*
- $ DSQRT( ONE+THETA*THETA ) )
- CS = DSQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
-*
- MXSINJ = DMAX1( MXSINJ, DABS( SN ) )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = WORK( p ) / WORK( q )
- AQOAP = WORK( q ) / WORK( p )
- IF( WORK( p ).GE.ONE ) THEN
- IF( WORK( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q )*CS
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- END IF
- ELSE
- IF( WORK( q ).GE.ONE ) THEN
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- ELSE
- IF( WORK( p ).GE.WORK( q ) )
- $ THEN
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-* .. have to use modified Gram-Schmidt like transformation
- CALL DCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE, M,
- $ 1, WORK( N+1 ), LDA,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE, M,
- $ 1, A( 1, q ), LDA, IERR )
- TEMP1 = -AAPQ*WORK( p ) / WORK( q )
- CALL DAXPY( M, TEMP1, WORK( N+1 ), 1,
- $ A( 1, q ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAQQ, M,
- $ 1, A( 1, q ), LDA, IERR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q), SVA(p)
-* recompute SVA(q), SVA(p).
-*
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = DNRM2( M, A( 1, q ), 1 )*
- $ WORK( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*DSQRT( AAQQ )*WORK( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 ).LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = DNRM2( M, A( 1, p ), 1 )*
- $ WORK( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*DSQRT( AAPP )*WORK( p )
- END IF
- SVA( p ) = AAPP
- END IF
-*
- ELSE
-* A(:,p) and A(:,q) already numerically orthogonal
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
-*[RTD] SKIPPED = SKIPPED + 1
- PSKIPPED = PSKIPPED + 1
- END IF
- ELSE
-* A(:,q) is zero column
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- IF( ir1.EQ.0 )AAPP = -AAPP
- NOTROT = 0
- GO TO 2103
- END IF
-*
- 2002 CONTINUE
-* END q-LOOP
-*
- 2103 CONTINUE
-* bailed out of q-loop
-*
- SVA( p ) = AAPP
-*
- ELSE
- SVA( p ) = AAPP
- IF( ( ir1.EQ.0 ) .AND. ( AAPP.EQ.ZERO ) )
- $ NOTROT = NOTROT + MIN0( igl+KBL-1, N ) - p
- END IF
-*
- 2001 CONTINUE
-* end of the p-loop
-* end of doing the block ( ibr, ibr )
- 1002 CONTINUE
-* end of ir1-loop
-*
-* ... go to the off diagonal blocks
-*
- igl = ( ibr-1 )*KBL + 1
-*
- DO 2010 jbc = ibr + 1, NBL
-*
- jgl = ( jbc-1 )*KBL + 1
-*
-* doing the block at ( ibr, jbc )
-*
- IJBLSK = 0
- DO 2100 p = igl, MIN0( igl+KBL-1, N )
-*
- AAPP = SVA( p )
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2200 q = jgl, MIN0( jgl+KBL-1, N )
-*
- AAQQ = SVA( q )
- IF( AAQQ.GT.ZERO ) THEN
- AAPP0 = AAPP
-*
-* .. M x 2 Jacobi SVD ..
-*
-* Safe Gram matrix computation
-*
- IF( AAQQ.GE.ONE ) THEN
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- ELSE
- ROTOK = ( SMALL*AAQQ ).LE.AAPP
- END IF
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL DCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAPP,
- $ WORK( p ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = DDOT( M, WORK( N+1 ), 1,
- $ A( 1, q ), 1 )*WORK( q ) / AAQQ
- END IF
- ELSE
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- ELSE
- ROTOK = AAQQ.LE.( AAPP / SMALL )
- END IF
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL DCOPY( M, A( 1, q ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ,
- $ WORK( q ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = DDOT( M, WORK( N+1 ), 1,
- $ A( 1, p ), 1 )*WORK( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( DABS( AAPQ ).GT.TOL ) THEN
- NOTROT = 0
-*[RTD] ROTATED = ROTATED + 1
- PSKIPPED = 0
- ISWROT = ISWROT + 1
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*DABS(AQOAP-APOAQ)/AAPQ
- IF( AAQQ.GT.AAPP0 )THETA = -THETA
-*
- IF( DABS( THETA ).GT.BIGTHETA ) THEN
- T = HALF / THETA
- FASTR( 3 ) = T*WORK( p ) / WORK( q )
- FASTR( 4 ) = -T*WORK( q ) /
- $ WORK( p )
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, DABS( T ) )
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -DSIGN( ONE, AAPQ )
- IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
- T = ONE / ( THETA+THSIGN*
- $ DSQRT( ONE+THETA*THETA ) )
- CS = DSQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
- MXSINJ = DMAX1( MXSINJ, DABS( SN ) )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = WORK( p ) / WORK( q )
- AQOAP = WORK( q ) / WORK( p )
- IF( WORK( p ).GE.ONE ) THEN
-*
- IF( WORK( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q )*CS
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- END IF
- ELSE
- IF( WORK( q ).GE.ONE ) THEN
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- ELSE
- IF( WORK( p ).GE.WORK( q ) )
- $ THEN
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
- IF( AAPP.GT.AAQQ ) THEN
- CALL DCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, WORK( N+1 ), LDA,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*WORK( p ) / WORK( q )
- CALL DAXPY( M, TEMP1, WORK( N+1 ),
- $ 1, A( 1, q ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAQQ,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- ELSE
- CALL DCOPY( M, A( 1, q ), 1,
- $ WORK( N+1 ), 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, WORK( N+1 ), LDA,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*WORK( q ) / WORK( p )
- CALL DAXPY( M, TEMP1, WORK( N+1 ),
- $ 1, A( 1, p ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAPP,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- SVA( p ) = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- END IF
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q)
-* .. recompute SVA(q)
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = DNRM2( M, A( 1, q ), 1 )*
- $ WORK( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*DSQRT( AAQQ )*WORK( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = DNRM2( M, A( 1, p ), 1 )*
- $ WORK( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*DSQRT( AAPP )*WORK( p )
- END IF
- SVA( p ) = AAPP
- END IF
-* end of OK rotation
- ELSE
- NOTROT = NOTROT + 1
-*[RTD] SKIPPED = SKIPPED + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND. ( IJBLSK.GE.BLSKIP ) )
- $ THEN
- SVA( p ) = AAPP
- NOTROT = 0
- GO TO 2011
- END IF
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- AAPP = -AAPP
- NOTROT = 0
- GO TO 2203
- END IF
-*
- 2200 CONTINUE
-* end of the q-loop
- 2203 CONTINUE
-*
- SVA( p ) = AAPP
-*
- ELSE
-*
- IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
- $ MIN0( jgl+KBL-1, N ) - jgl + 1
- IF( AAPP.LT.ZERO )NOTROT = 0
-*
- END IF
-*
- 2100 CONTINUE
-* end of the p-loop
- 2010 CONTINUE
-* end of the jbc-loop
- 2011 CONTINUE
-*2011 bailed out of the jbc-loop
- DO 2012 p = igl, MIN0( igl+KBL-1, N )
- SVA( p ) = DABS( SVA( p ) )
- 2012 CONTINUE
-***
- 2000 CONTINUE
-*2000 :: end of the ibr-loop
-*
-* .. update SVA(N)
- IF( ( SVA( N ).LT.ROOTBIG ) .AND. ( SVA( N ).GT.ROOTSFMIN ) )
- $ THEN
- SVA( N ) = DNRM2( M, A( 1, N ), 1 )*WORK( N )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, N ), 1, T, AAPP )
- SVA( N ) = T*DSQRT( AAPP )*WORK( N )
- END IF
-*
-* Additional steering devices
-*
- IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
- $ ( ISWROT.LE.N ) ) )SWBAND = i
-*
- IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )*
- $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
- GO TO 1994
- END IF
-*
- IF( NOTROT.GE.EMPTSW )GO TO 1994
-*
- 1993 CONTINUE
-* end i=1:NSWEEP loop
-*
-* #:( Reaching this point means that the procedure has not converged.
- INFO = NSWEEP - 1
- GO TO 1995
-*
- 1994 CONTINUE
-* #:) Reaching this point means numerical convergence after the i-th
-* sweep.
-*
- INFO = 0
-* #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
-*
-* Sort the singular values and find how many are above
-* the underflow threshold.
-*
- N2 = 0
- N4 = 0
- DO 5991 p = 1, N - 1
- q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = WORK( p )
- WORK( p ) = WORK( q )
- WORK( q ) = TEMP1
- CALL DSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL DSWAP( MVL, V( 1, p ), 1, V( 1, q ), 1 )
- END IF
- IF( SVA( p ).NE.ZERO ) THEN
- N4 = N4 + 1
- IF( SVA( p )*SKL.GT.SFMIN )N2 = N2 + 1
- END IF
- 5991 CONTINUE
- IF( SVA( N ).NE.ZERO ) THEN
- N4 = N4 + 1
- IF( SVA( N )*SKL.GT.SFMIN )N2 = N2 + 1
- END IF
-*
-* Normalize the left singular vectors.
-*
- IF( LSVEC .OR. UCTOL ) THEN
- DO 1998 p = 1, N2
- CALL DSCAL( M, WORK( p ) / SVA( p ), A( 1, p ), 1 )
- 1998 CONTINUE
- END IF
-*
-* Scale the product of Jacobi rotations (assemble the fast rotations).
-*
- IF( RSVEC ) THEN
- IF( APPLV ) THEN
- DO 2398 p = 1, N
- CALL DSCAL( MVL, WORK( p ), V( 1, p ), 1 )
- 2398 CONTINUE
- ELSE
- DO 2399 p = 1, N
- TEMP1 = ONE / DNRM2( MVL, V( 1, p ), 1 )
- CALL DSCAL( MVL, TEMP1, V( 1, p ), 1 )
- 2399 CONTINUE
- END IF
- END IF
-*
-* Undo scaling, if necessary (and possible).
- IF( ( ( SKL.GT.ONE ) .AND. ( SVA( 1 ).LT.( BIG / SKL) ) )
- $ .OR. ( ( SKL.LT.ONE ) .AND. ( SVA( MAX( N2, 1 ) ) .GT.
- $ ( SFMIN / SKL) ) ) ) THEN
- DO 2400 p = 1, N
- SVA( P ) = SKL*SVA( P )
- 2400 CONTINUE
- SKL= ONE
- END IF
-*
- WORK( 1 ) = SKL
-* The singular values of A are SKL*SVA(1:N). If SKL.NE.ONE
-* then some of the singular values may overflow or underflow and
-* the spectrum is given in this factored representation.
-*
- WORK( 2 ) = DBLE( N4 )
-* N4 is the number of computed nonzero singular values of A.
-*
- WORK( 3 ) = DBLE( N2 )
-* N2 is the number of singular values of A greater than SFMIN.
-* If N2<N, SVA(N2:N) contains ZEROS and/or denormalized numbers
-* that may carry some information.
-*
- WORK( 4 ) = DBLE( i )
-* i is the index of the last sweep before declaring convergence.
-*
- WORK( 5 ) = MXAAPQ
-* MXAAPQ is the largest absolute value of scaled pivots in the
-* last sweep
-*
- WORK( 6 ) = MXSINJ
-* MXSINJ is the largest absolute value of the sines of Jacobi angles
-* in the last sweep
-*
- RETURN
-* ..
-* .. END OF DGESVJ
-* ..
- END
diff --git a/netlib/LAPACK/dgesvx.f b/netlib/LAPACK/dgesvx.f
deleted file mode 100644
index aac2053..0000000
--- a/netlib/LAPACK/dgesvx.f
+++ /dev/null
@@ -1,602 +0,0 @@
-*> \brief <b> DGESVX computes the solution to system of linear equations A * X = B for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
-* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, TRANS
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), C( * ), FERR( * ), R( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGESVX uses the LU factorization to compute the solution to a real
-*> system of linear equations
-*> A * X = B,
-*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
-*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*> or diag(C)*B (if TRANS = 'T' or 'C').
-*>
-*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*> matrix A (after equilibration if FACT = 'E') as
-*> A = P * L * U,
-*> where P is a permutation matrix, L is a unit lower triangular
-*> matrix, and U is upper triangular.
-*>
-*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*> that it solves the original system before equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AF and IPIV contain the factored form of A.
-*> If EQUED is not 'N', the matrix A has been
-*> equilibrated with scaling factors given by R and C.
-*> A, AF, and IPIV are not modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
-*> not 'N', then A must have been equilibrated by the scaling
-*> factors in R and/or C. A is not modified if FACT = 'F' or
-*> 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if EQUED .ne. 'N', A is scaled as follows:
-*> EQUED = 'R': A := diag(R) * A
-*> EQUED = 'C': A := A * diag(C)
-*> EQUED = 'B': A := diag(R) * A * diag(C).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the factors L and U from the factorization
-*> A = P*L*U as computed by DGETRF. If EQUED .ne. 'N', then
-*> AF is the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the factors L and U from the factorization A = P*L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then AF is an output argument and on exit
-*> returns the factors L and U from the factorization A = P*L*U
-*> of the equilibrated matrix A (see the description of A for
-*> the form of the equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the factorization A = P*L*U
-*> as computed by DGETRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = P*L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = P*L*U
-*> of the equilibrated matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (N)
-*> The row scale factors for A. If EQUED = 'R' or 'B', A is
-*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*> is not accessed. R is an input argument if FACT = 'F';
-*> otherwise, R is an output argument. If FACT = 'F' and
-*> EQUED = 'R' or 'B', each element of R must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A. If EQUED = 'C' or 'B', A is
-*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*> is not accessed. C is an input argument if FACT = 'F';
-*> otherwise, C is an output argument. If FACT = 'F' and
-*> EQUED = 'C' or 'B', each element of C must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit,
-*> if EQUED = 'N', B is not modified;
-*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*> diag(R)*B;
-*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*> overwritten by diag(C)*B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*> to the original system of equations. Note that A and B are
-*> modified on exit if EQUED .ne. 'N', and the solution to the
-*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*> and EQUED = 'R' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> On exit, WORK(1) contains the reciprocal pivot growth
-*> factor norm(A)/norm(U). The "max absolute element" norm is
-*> used. If WORK(1) is much less than 1, then the stability
-*> of the LU factorization of the (equilibrated) matrix A
-*> could be poor. This also means that the solution X, condition
-*> estimator RCOND, and forward error bound FERR could be
-*> unreliable. If factorization fails with 0<INFO<=N, then
-*> WORK(1) contains the reciprocal pivot growth factor for the
-*> leading INFO columns of A.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization has
-*> been completed, but the factor U is exactly
-*> singular, so the solution and error bounds
-*> could not be computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
- $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, TRANS
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), C( * ), FERR( * ), R( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
- CHARACTER NORM
- INTEGER I, INFEQU, J
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
- $ ROWCND, RPVGRW, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGE, DLANTR
- EXTERNAL LSAME, DLAMCH, DLANGE, DLANTR
-* ..
-* .. External Subroutines ..
- EXTERNAL DGECON, DGEEQU, DGERFS, DGETRF, DGETRS, DLACPY,
- $ DLAQGE, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- ROWEQU = .FALSE.
- COLEQU = .FALSE.
- ELSE
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -10
- ELSE
- IF( ROWEQU ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 10 J = 1, N
- RCMIN = MIN( RCMIN, R( J ) )
- RCMAX = MAX( RCMAX, R( J ) )
- 10 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -11
- ELSE IF( N.GT.0 ) THEN
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- ROWCND = ONE
- END IF
- END IF
- IF( COLEQU .AND. INFO.EQ.0 ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 20 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 20 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -12
- ELSE IF( N.GT.0 ) THEN
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- COLCND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -16
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ EQUED )
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( NOTRAN ) THEN
- IF( ROWEQU ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = R( I )*B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( COLEQU ) THEN
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- B( I, J ) = C( I )*B( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the LU factorization of A.
-*
- CALL DLACPY( 'Full', N, N, A, LDA, AF, LDAF )
- CALL DGETRF( N, N, AF, LDAF, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 ) THEN
-*
-* Compute the reciprocal pivot growth factor of the
-* leading rank-deficient INFO columns of A.
-*
- RPVGRW = DLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF,
- $ WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = DLANGE( 'M', N, INFO, A, LDA, WORK ) / RPVGRW
- END IF
- WORK( 1 ) = RPVGRW
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A and the
-* reciprocal pivot growth factor RPVGRW.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = DLANGE( NORM, N, N, A, LDA, WORK )
- RPVGRW = DLANTR( 'M', 'U', 'N', N, N, AF, LDAF, WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = DLANGE( 'M', N, N, A, LDA, WORK ) / RPVGRW
- END IF
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( NOTRAN ) THEN
- IF( COLEQU ) THEN
- DO 80 J = 1, NRHS
- DO 70 I = 1, N
- X( I, J ) = C( I )*X( I, J )
- 70 CONTINUE
- 80 CONTINUE
- DO 90 J = 1, NRHS
- FERR( J ) = FERR( J ) / COLCND
- 90 CONTINUE
- END IF
- ELSE IF( ROWEQU ) THEN
- DO 110 J = 1, NRHS
- DO 100 I = 1, N
- X( I, J ) = R( I )*X( I, J )
- 100 CONTINUE
- 110 CONTINUE
- DO 120 J = 1, NRHS
- FERR( J ) = FERR( J ) / ROWCND
- 120 CONTINUE
- END IF
-*
- WORK( 1 ) = RPVGRW
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
- RETURN
-*
-* End of DGESVX
-*
- END
diff --git a/netlib/LAPACK/dgetc2.f b/netlib/LAPACK/dgetc2.f
deleted file mode 100644
index 6ae1a20..0000000
--- a/netlib/LAPACK/dgetc2.f
+++ /dev/null
@@ -1,211 +0,0 @@
-*> \brief \b DGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETC2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetc2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetc2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetc2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), JPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGETC2 computes an LU factorization with complete pivoting of the
-*> n-by-n matrix A. The factorization has the form A = P * L * U * Q,
-*> where P and Q are permutation matrices, L is lower triangular with
-*> unit diagonal elements and U is upper triangular.
-*>
-*> This is the Level 2 BLAS algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the n-by-n matrix A to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U*Q; the unit diagonal elements of L are not stored.
-*> If U(k, k) appears to be less than SMIN, U(k, k) is given the
-*> value of SMIN, i.e., giving a nonsingular perturbed system.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension(N).
-*> The pivot indices; for 1 <= i <= N, row i of the
-*> matrix has been interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] JPIV
-*> \verbatim
-*> JPIV is INTEGER array, dimension(N).
-*> The pivot indices; for 1 <= j <= N, column j of the
-*> matrix has been interchanged with column JPIV(j).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = k, U(k, k) is likely to produce owerflow if
-*> we try to solve for x in Ax = b. So U is perturbed to
-*> avoid the overflow.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
- SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IP, IPV, J, JP, JPV
- DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGER, DSWAP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Set constants to control overflow
-*
- INFO = 0
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Factorize A using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- DO 40 I = 1, N - 1
-*
-* Find max element in matrix A
-*
- XMAX = ZERO
- DO 20 IP = I, N
- DO 10 JP = I, N
- IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
- XMAX = ABS( A( IP, JP ) )
- IPV = IP
- JPV = JP
- END IF
- 10 CONTINUE
- 20 CONTINUE
- IF( I.EQ.1 )
- $ SMIN = MAX( EPS*XMAX, SMLNUM )
-*
-* Swap rows
-*
- IF( IPV.NE.I )
- $ CALL DSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA )
- IPIV( I ) = IPV
-*
-* Swap columns
-*
- IF( JPV.NE.I )
- $ CALL DSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 )
- JPIV( I ) = JPV
-*
-* Check for singularity
-*
- IF( ABS( A( I, I ) ).LT.SMIN ) THEN
- INFO = I
- A( I, I ) = SMIN
- END IF
- DO 30 J = I + 1, N
- A( J, I ) = A( J, I ) / A( I, I )
- 30 CONTINUE
- CALL DGER( N-I, N-I, -ONE, A( I+1, I ), 1, A( I, I+1 ), LDA,
- $ A( I+1, I+1 ), LDA )
- 40 CONTINUE
-*
- IF( ABS( A( N, N ) ).LT.SMIN ) THEN
- INFO = N
- A( N, N ) = SMIN
- END IF
-*
- RETURN
-*
-* End of DGETC2
-*
- END
diff --git a/netlib/LAPACK/dgetf2.f b/netlib/LAPACK/dgetf2.f
deleted file mode 100644
index 649d067..0000000
--- a/netlib/LAPACK/dgetf2.f
+++ /dev/null
@@ -1,213 +0,0 @@
-*> \brief \b DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGETF2 computes an LU factorization of a general m-by-n matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> The factorization has the form
-*> A = P * L * U
-*> where P is a permutation matrix, L is lower triangular with unit
-*> diagonal elements (lower trapezoidal if m > n), and U is upper
-*> triangular (upper trapezoidal if m < n).
-*>
-*> This is the right-looking Level 2 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION SFMIN
- INTEGER I, J, JP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER IDAMAX
- EXTERNAL DLAMCH, IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGER, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = DLAMCH('S')
-*
- DO 10 J = 1, MIN( M, N )
-*
-* Find pivot and test for singularity.
-*
- JP = J - 1 + IDAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
- IF( A( JP, J ).NE.ZERO ) THEN
-*
-* Apply the interchange to columns 1:N.
-*
- IF( JP.NE.J )
- $ CALL DSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-* Compute elements J+1:M of J-th column.
-*
- IF( J.LT.M ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL DSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO 20 I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- 20 CONTINUE
- END IF
- END IF
-*
- ELSE IF( INFO.EQ.0 ) THEN
-*
- INFO = J
- END IF
-*
- IF( J.LT.MIN( M, N ) ) THEN
-*
-* Update trailing submatrix.
-*
- CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,
- $ A( J+1, J+1 ), LDA )
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGETF2
-*
- END
diff --git a/netlib/LAPACK/dgetrf.f b/netlib/LAPACK/dgetrf.f
deleted file mode 100644
index 45bb97f..0000000
--- a/netlib/LAPACK/dgetrf.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DGETRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGETRF computes an LU factorization of a general M-by-N matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> The factorization has the form
-*> A = P * L * U
-*> where P is a permutation matrix, L is lower triangular with unit
-*> diagonal elements (lower trapezoidal if m > n), and U is upper
-*> triangular (upper trapezoidal if m < n).
-*>
-*> This is the right-looking Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGETF2, DLASWP, DTRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL DGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to columns 1:J-1.
-*
- CALL DLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF( J+JB.LE.N ) THEN
-*
-* Apply interchanges to columns J+JB:N.
-*
- CALL DLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
- $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
- $ LDA )
- IF( J+JB.LE.M ) THEN
-*
-* Update trailing submatrix.
-*
- CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1,
- $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
- $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
- $ LDA )
- END IF
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DGETRF
-*
- END
diff --git a/netlib/LAPACK/dgetri.f b/netlib/LAPACK/dgetri.f
deleted file mode 100644
index ad5324c..0000000
--- a/netlib/LAPACK/dgetri.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DGETRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGETRI computes the inverse of a matrix using the LU factorization
-*> computed by DGETRF.
-*>
-*> This method inverts U and then computes inv(A) by solving the system
-*> inv(A)*L = inv(U) for inv(A).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the factors L and U from the factorization
-*> A = P*L*U as computed by DGETRF.
-*> On exit, if INFO = 0, the inverse of the original matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimal performance LWORK >= N*NB, where NB is
-*> the optimal blocksize returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
-*> singular and its inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
- $ NBMIN, NN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGEMV, DSWAP, DTRSM, DTRTRI, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRI', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form inv(U). If INFO > 0 from DTRTRI, then U is singular,
-* and the inverse is not computed.
-*
- CALL DTRTRI( 'Upper', 'Non-unit', N, A, LDA, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
- NBMIN = 2
- LDWORK = N
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
- IWS = MAX( LDWORK*NB, 1 )
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGETRI', ' ', N, -1, -1, -1 ) )
- END IF
- ELSE
- IWS = N
- END IF
-*
-* Solve the equation inv(A)*L = inv(U) for inv(A).
-*
- IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- DO 20 J = N, 1, -1
-*
-* Copy current column of L to WORK and replace with zeros.
-*
- DO 10 I = J + 1, N
- WORK( I ) = A( I, J )
- A( I, J ) = ZERO
- 10 CONTINUE
-*
-* Compute current column of inv(A).
-*
- IF( J.LT.N )
- $ CALL DGEMV( 'No transpose', N, N-J, -ONE, A( 1, J+1 ),
- $ LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 )
- 20 CONTINUE
- ELSE
-*
-* Use blocked code.
-*
- NN = ( ( N-1 ) / NB )*NB + 1
- DO 50 J = NN, 1, -NB
- JB = MIN( NB, N-J+1 )
-*
-* Copy current block column of L to WORK and replace with
-* zeros.
-*
- DO 40 JJ = J, J + JB - 1
- DO 30 I = JJ + 1, N
- WORK( I+( JJ-J )*LDWORK ) = A( I, JJ )
- A( I, JJ ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Compute current block column of inv(A).
-*
- IF( J+JB.LE.N )
- $ CALL DGEMM( 'No transpose', 'No transpose', N, JB,
- $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA,
- $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA )
- CALL DTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB,
- $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA )
- 50 CONTINUE
- END IF
-*
-* Apply column interchanges.
-*
- DO 60 J = N - 1, 1, -1
- JP = IPIV( J )
- IF( JP.NE.J )
- $ CALL DSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
- 60 CONTINUE
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGETRI
-*
- END
diff --git a/netlib/LAPACK/dgetrs.f b/netlib/LAPACK/dgetrs.f
deleted file mode 100644
index 02e9832..0000000
--- a/netlib/LAPACK/dgetrs.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DGETRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGETRS solves a system of linear equations
-*> A * X = B or A**T * X = B
-*> with a general N-by-N matrix A using the LU factorization computed
-*> by DGETRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASWP, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * X = B.
-*
-* Apply row interchanges to the right hand sides.
-*
- CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A**T * X = B.
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
- $ A, LDA, B, LDB )
-*
-* Apply row interchanges to the solution vectors.
-*
- CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
- END IF
-*
- RETURN
-*
-* End of DGETRS
-*
- END
diff --git a/netlib/LAPACK/dggbak.f b/netlib/LAPACK/dggbak.f
deleted file mode 100644
index 3949247..0000000
--- a/netlib/LAPACK/dggbak.f
+++ /dev/null
@@ -1,306 +0,0 @@
-*> \brief \b DGGBAK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGBAK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggbak.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggbak.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggbak.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
-* LDV, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB, SIDE
-* INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION LSCALE( * ), RSCALE( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGBAK forms the right or left eigenvectors of a real generalized
-*> eigenvalue problem A*x = lambda*B*x, by backward transformation on
-*> the computed eigenvectors of the balanced pair of matrices output by
-*> DGGBAL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the type of backward transformation required:
-*> = 'N': do nothing, return immediately;
-*> = 'P': do backward transformation for permutation only;
-*> = 'S': do backward transformation for scaling only;
-*> = 'B': do backward transformations for both permutation and
-*> scaling.
-*> JOB must be the same as the argument JOB supplied to DGGBAL.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': V contains right eigenvectors;
-*> = 'L': V contains left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrix V. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> The integers ILO and IHI determined by DGGBAL.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in] LSCALE
-*> \verbatim
-*> LSCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and/or scaling factors applied
-*> to the left side of A and B, as returned by DGGBAL.
-*> \endverbatim
-*>
-*> \param[in] RSCALE
-*> \verbatim
-*> RSCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and/or scaling factors applied
-*> to the right side of A and B, as returned by DGGBAL.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix V. M >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,M)
-*> On entry, the matrix of right or left eigenvectors to be
-*> transformed, as returned by DTGEVC.
-*> On exit, V is overwritten by the transformed eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the matrix V. LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> See R.C. Ward, Balancing the generalized eigenvalue problem,
-*> SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
- $ LDV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB, SIDE
- INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION LSCALE( * ), RSCALE( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFTV, RIGHTV
- INTEGER I, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- RIGHTV = LSAME( SIDE, 'R' )
- LEFTV = LSAME( SIDE, 'L' )
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 ) THEN
- INFO = -4
- ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
- INFO = -4
- ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
- $ THEN
- INFO = -5
- ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -8
- ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGBAK', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( M.EQ.0 )
- $ RETURN
- IF( LSAME( JOB, 'N' ) )
- $ RETURN
-*
- IF( ILO.EQ.IHI )
- $ GO TO 30
-*
-* Backward balance
-*
- IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-* Backward transformation on right eigenvectors
-*
- IF( RIGHTV ) THEN
- DO 10 I = ILO, IHI
- CALL DSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
- 10 CONTINUE
- END IF
-*
-* Backward transformation on left eigenvectors
-*
- IF( LEFTV ) THEN
- DO 20 I = ILO, IHI
- CALL DSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
- 20 CONTINUE
- END IF
- END IF
-*
-* Backward permutation
-*
- 30 CONTINUE
- IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-* Backward permutation on right eigenvectors
-*
- IF( RIGHTV ) THEN
- IF( ILO.EQ.1 )
- $ GO TO 50
-*
- DO 40 I = ILO - 1, 1, -1
- K = RSCALE( I )
- IF( K.EQ.I )
- $ GO TO 40
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 40 CONTINUE
-*
- 50 CONTINUE
- IF( IHI.EQ.N )
- $ GO TO 70
- DO 60 I = IHI + 1, N
- K = RSCALE( I )
- IF( K.EQ.I )
- $ GO TO 60
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 60 CONTINUE
- END IF
-*
-* Backward permutation on left eigenvectors
-*
- 70 CONTINUE
- IF( LEFTV ) THEN
- IF( ILO.EQ.1 )
- $ GO TO 90
- DO 80 I = ILO - 1, 1, -1
- K = LSCALE( I )
- IF( K.EQ.I )
- $ GO TO 80
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 80 CONTINUE
-*
- 90 CONTINUE
- IF( IHI.EQ.N )
- $ GO TO 110
- DO 100 I = IHI + 1, N
- K = LSCALE( I )
- IF( K.EQ.I )
- $ GO TO 100
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 100 CONTINUE
- END IF
- END IF
-*
- 110 CONTINUE
-*
- RETURN
-*
-* End of DGGBAK
-*
- END
diff --git a/netlib/LAPACK/dggbal.f b/netlib/LAPACK/dggbal.f
deleted file mode 100644
index 6e05a74..0000000
--- a/netlib/LAPACK/dggbal.f
+++ /dev/null
@@ -1,559 +0,0 @@
-*> \brief \b DGGBAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGBAL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggbal.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggbal.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggbal.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
-* RSCALE, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER IHI, ILO, INFO, LDA, LDB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), LSCALE( * ),
-* $ RSCALE( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGBAL balances a pair of general real matrices (A,B). This
-*> involves, first, permuting A and B by similarity transformations to
-*> isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
-*> elements on the diagonal; and second, applying a diagonal similarity
-*> transformation to rows and columns ILO to IHI to make the rows
-*> and columns as close in norm as possible. Both steps are optional.
-*>
-*> Balancing may reduce the 1-norm of the matrices, and improve the
-*> accuracy of the computed eigenvalues and/or eigenvectors in the
-*> generalized eigenvalue problem A*x = lambda*B*x.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the operations to be performed on A and B:
-*> = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
-*> and RSCALE(I) = 1.0 for i = 1,...,N.
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the input matrix A.
-*> On exit, A is overwritten by the balanced matrix.
-*> If JOB = 'N', A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the input matrix B.
-*> On exit, B is overwritten by the balanced matrix.
-*> If JOB = 'N', B is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are set to integers such that on exit
-*> A(i,j) = 0 and B(i,j) = 0 if i > j and
-*> j = 1,...,ILO-1 or i = IHI+1,...,N.
-*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] LSCALE
-*> \verbatim
-*> LSCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the left side of A and B. If P(j) is the index of the
-*> row interchanged with row j, and D(j)
-*> is the scaling factor applied to row j, then
-*> LSCALE(j) = P(j) for J = 1,...,ILO-1
-*> = D(j) for J = ILO,...,IHI
-*> = P(j) for J = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] RSCALE
-*> \verbatim
-*> RSCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the right side of A and B. If P(j) is the index of the
-*> column interchanged with column j, and D(j)
-*> is the scaling factor applied to column j, then
-*> LSCALE(j) = P(j) for J = 1,...,ILO-1
-*> = D(j) for J = ILO,...,IHI
-*> = P(j) for J = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (lwork)
-*> lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
-*> at least 1 when JOB = 'N' or 'P'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> See R.C. WARD, Balancing the generalized eigenvalue problem,
-*> SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
- $ RSCALE, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), LSCALE( * ),
- $ RSCALE( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION THREE, SCLFAC
- PARAMETER ( THREE = 3.0D+0, SCLFAC = 1.0D+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ICAB, IFLOW, IP1, IR, IRAB, IT, J, JC, JP1,
- $ K, KOUNT, L, LCAB, LM1, LRAB, LSFMAX, LSFMIN,
- $ M, NR, NRP2
- DOUBLE PRECISION ALPHA, BASL, BETA, CAB, CMAX, COEF, COEF2,
- $ COEF5, COR, EW, EWC, GAMMA, PGAMMA, RAB, SFMAX,
- $ SFMIN, SUM, T, TA, TB, TC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, LOG10, MAX, MIN, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGBAL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- ILO = 1
- IHI = N
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- ILO = 1
- IHI = N
- LSCALE( 1 ) = ONE
- RSCALE( 1 ) = ONE
- RETURN
- END IF
-*
- IF( LSAME( JOB, 'N' ) ) THEN
- ILO = 1
- IHI = N
- DO 10 I = 1, N
- LSCALE( I ) = ONE
- RSCALE( I ) = ONE
- 10 CONTINUE
- RETURN
- END IF
-*
- K = 1
- L = N
- IF( LSAME( JOB, 'S' ) )
- $ GO TO 190
-*
- GO TO 30
-*
-* Permute the matrices A and B to isolate the eigenvalues.
-*
-* Find row with one nonzero in columns 1 through L
-*
- 20 CONTINUE
- L = LM1
- IF( L.NE.1 )
- $ GO TO 30
-*
- RSCALE( 1 ) = ONE
- LSCALE( 1 ) = ONE
- GO TO 190
-*
- 30 CONTINUE
- LM1 = L - 1
- DO 80 I = L, 1, -1
- DO 40 J = 1, LM1
- JP1 = J + 1
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 50
- 40 CONTINUE
- J = L
- GO TO 70
-*
- 50 CONTINUE
- DO 60 J = JP1, L
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 80
- 60 CONTINUE
- J = JP1 - 1
-*
- 70 CONTINUE
- M = L
- IFLOW = 1
- GO TO 160
- 80 CONTINUE
- GO TO 100
-*
-* Find column with one nonzero in rows K through N
-*
- 90 CONTINUE
- K = K + 1
-*
- 100 CONTINUE
- DO 150 J = K, L
- DO 110 I = K, LM1
- IP1 = I + 1
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 120
- 110 CONTINUE
- I = L
- GO TO 140
- 120 CONTINUE
- DO 130 I = IP1, L
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 150
- 130 CONTINUE
- I = IP1 - 1
- 140 CONTINUE
- M = K
- IFLOW = 2
- GO TO 160
- 150 CONTINUE
- GO TO 190
-*
-* Permute rows M and I
-*
- 160 CONTINUE
- LSCALE( M ) = I
- IF( I.EQ.M )
- $ GO TO 170
- CALL DSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
- CALL DSWAP( N-K+1, B( I, K ), LDB, B( M, K ), LDB )
-*
-* Permute columns M and J
-*
- 170 CONTINUE
- RSCALE( M ) = J
- IF( J.EQ.M )
- $ GO TO 180
- CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
- CALL DSWAP( L, B( 1, J ), 1, B( 1, M ), 1 )
-*
- 180 CONTINUE
- GO TO ( 20, 90 )IFLOW
-*
- 190 CONTINUE
- ILO = K
- IHI = L
-*
- IF( LSAME( JOB, 'P' ) ) THEN
- DO 195 I = ILO, IHI
- LSCALE( I ) = ONE
- RSCALE( I ) = ONE
- 195 CONTINUE
- RETURN
- END IF
-*
- IF( ILO.EQ.IHI )
- $ RETURN
-*
-* Balance the submatrix in rows ILO to IHI.
-*
- NR = IHI - ILO + 1
- DO 200 I = ILO, IHI
- RSCALE( I ) = ZERO
- LSCALE( I ) = ZERO
-*
- WORK( I ) = ZERO
- WORK( I+N ) = ZERO
- WORK( I+2*N ) = ZERO
- WORK( I+3*N ) = ZERO
- WORK( I+4*N ) = ZERO
- WORK( I+5*N ) = ZERO
- 200 CONTINUE
-*
-* Compute right side vector in resulting linear equations
-*
- BASL = LOG10( SCLFAC )
- DO 240 I = ILO, IHI
- DO 230 J = ILO, IHI
- TB = B( I, J )
- TA = A( I, J )
- IF( TA.EQ.ZERO )
- $ GO TO 210
- TA = LOG10( ABS( TA ) ) / BASL
- 210 CONTINUE
- IF( TB.EQ.ZERO )
- $ GO TO 220
- TB = LOG10( ABS( TB ) ) / BASL
- 220 CONTINUE
- WORK( I+4*N ) = WORK( I+4*N ) - TA - TB
- WORK( J+5*N ) = WORK( J+5*N ) - TA - TB
- 230 CONTINUE
- 240 CONTINUE
-*
- COEF = ONE / DBLE( 2*NR )
- COEF2 = COEF*COEF
- COEF5 = HALF*COEF2
- NRP2 = NR + 2
- BETA = ZERO
- IT = 1
-*
-* Start generalized conjugate gradient iteration
-*
- 250 CONTINUE
-*
- GAMMA = DDOT( NR, WORK( ILO+4*N ), 1, WORK( ILO+4*N ), 1 ) +
- $ DDOT( NR, WORK( ILO+5*N ), 1, WORK( ILO+5*N ), 1 )
-*
- EW = ZERO
- EWC = ZERO
- DO 260 I = ILO, IHI
- EW = EW + WORK( I+4*N )
- EWC = EWC + WORK( I+5*N )
- 260 CONTINUE
-*
- GAMMA = COEF*GAMMA - COEF2*( EW**2+EWC**2 ) - COEF5*( EW-EWC )**2
- IF( GAMMA.EQ.ZERO )
- $ GO TO 350
- IF( IT.NE.1 )
- $ BETA = GAMMA / PGAMMA
- T = COEF5*( EWC-THREE*EW )
- TC = COEF5*( EW-THREE*EWC )
-*
- CALL DSCAL( NR, BETA, WORK( ILO ), 1 )
- CALL DSCAL( NR, BETA, WORK( ILO+N ), 1 )
-*
- CALL DAXPY( NR, COEF, WORK( ILO+4*N ), 1, WORK( ILO+N ), 1 )
- CALL DAXPY( NR, COEF, WORK( ILO+5*N ), 1, WORK( ILO ), 1 )
-*
- DO 270 I = ILO, IHI
- WORK( I ) = WORK( I ) + TC
- WORK( I+N ) = WORK( I+N ) + T
- 270 CONTINUE
-*
-* Apply matrix to vector
-*
- DO 300 I = ILO, IHI
- KOUNT = 0
- SUM = ZERO
- DO 290 J = ILO, IHI
- IF( A( I, J ).EQ.ZERO )
- $ GO TO 280
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( J )
- 280 CONTINUE
- IF( B( I, J ).EQ.ZERO )
- $ GO TO 290
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( J )
- 290 CONTINUE
- WORK( I+2*N ) = DBLE( KOUNT )*WORK( I+N ) + SUM
- 300 CONTINUE
-*
- DO 330 J = ILO, IHI
- KOUNT = 0
- SUM = ZERO
- DO 320 I = ILO, IHI
- IF( A( I, J ).EQ.ZERO )
- $ GO TO 310
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( I+N )
- 310 CONTINUE
- IF( B( I, J ).EQ.ZERO )
- $ GO TO 320
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( I+N )
- 320 CONTINUE
- WORK( J+3*N ) = DBLE( KOUNT )*WORK( J ) + SUM
- 330 CONTINUE
-*
- SUM = DDOT( NR, WORK( ILO+N ), 1, WORK( ILO+2*N ), 1 ) +
- $ DDOT( NR, WORK( ILO ), 1, WORK( ILO+3*N ), 1 )
- ALPHA = GAMMA / SUM
-*
-* Determine correction to current iteration
-*
- CMAX = ZERO
- DO 340 I = ILO, IHI
- COR = ALPHA*WORK( I+N )
- IF( ABS( COR ).GT.CMAX )
- $ CMAX = ABS( COR )
- LSCALE( I ) = LSCALE( I ) + COR
- COR = ALPHA*WORK( I )
- IF( ABS( COR ).GT.CMAX )
- $ CMAX = ABS( COR )
- RSCALE( I ) = RSCALE( I ) + COR
- 340 CONTINUE
- IF( CMAX.LT.HALF )
- $ GO TO 350
-*
- CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 )
- CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 )
-*
- PGAMMA = GAMMA
- IT = IT + 1
- IF( IT.LE.NRP2 )
- $ GO TO 250
-*
-* End generalized conjugate gradient iteration
-*
- 350 CONTINUE
- SFMIN = DLAMCH( 'S' )
- SFMAX = ONE / SFMIN
- LSFMIN = INT( LOG10( SFMIN ) / BASL+ONE )
- LSFMAX = INT( LOG10( SFMAX ) / BASL )
- DO 360 I = ILO, IHI
- IRAB = IDAMAX( N-ILO+1, A( I, ILO ), LDA )
- RAB = ABS( A( I, IRAB+ILO-1 ) )
- IRAB = IDAMAX( N-ILO+1, B( I, ILO ), LDB )
- RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
- LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
- IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
- IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB )
- LSCALE( I ) = SCLFAC**IR
- ICAB = IDAMAX( IHI, A( 1, I ), 1 )
- CAB = ABS( A( ICAB, I ) )
- ICAB = IDAMAX( IHI, B( 1, I ), 1 )
- CAB = MAX( CAB, ABS( B( ICAB, I ) ) )
- LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE )
- JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) )
- JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB )
- RSCALE( I ) = SCLFAC**JC
- 360 CONTINUE
-*
-* Row scaling of matrices A and B
-*
- DO 370 I = ILO, IHI
- CALL DSCAL( N-ILO+1, LSCALE( I ), A( I, ILO ), LDA )
- CALL DSCAL( N-ILO+1, LSCALE( I ), B( I, ILO ), LDB )
- 370 CONTINUE
-*
-* Column scaling of matrices A and B
-*
- DO 380 J = ILO, IHI
- CALL DSCAL( IHI, RSCALE( J ), A( 1, J ), 1 )
- CALL DSCAL( IHI, RSCALE( J ), B( 1, J ), 1 )
- 380 CONTINUE
-*
- RETURN
-*
-* End of DGGBAL
-*
- END
diff --git a/netlib/LAPACK/dgges.f b/netlib/LAPACK/dgges.f
deleted file mode 100644
index 76d6d39..0000000
--- a/netlib/LAPACK/dgges.f
+++ /dev/null
@@ -1,682 +0,0 @@
-*> \brief <b> DGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGES + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgges.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgges.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgges.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
-* SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
-* LDVSR, WORK, LWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVSL, JOBVSR, SORT
-* INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
-* $ VSR( LDVSR, * ), WORK( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELCTG
-* EXTERNAL SELCTG
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
-*> the generalized eigenvalues, the generalized real Schur form (S,T),
-*> optionally, the left and/or right matrices of Schur vectors (VSL and
-*> VSR). This gives the generalized Schur factorization
-*>
-*> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
-*>
-*> Optionally, it also orders the eigenvalues so that a selected cluster
-*> of eigenvalues appears in the leading diagonal blocks of the upper
-*> quasi-triangular matrix S and the upper triangular matrix T.The
-*> leading columns of VSL and VSR then form an orthonormal basis for the
-*> corresponding left and right eigenspaces (deflating subspaces).
-*>
-*> (If only the generalized eigenvalues are needed, use the driver
-*> DGGEV instead, which is faster.)
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
-*> or a ratio alpha/beta = w, such that A - w*B is singular. It is
-*> usually represented as the pair (alpha,beta), as there is a
-*> reasonable interpretation for beta=0 or both being zero.
-*>
-*> A pair of matrices (S,T) is in generalized real Schur form if T is
-*> upper triangular with non-negative diagonal and S is block upper
-*> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
-*> to real generalized eigenvalues, while 2-by-2 blocks of S will be
-*> "standardized" by making the corresponding elements of T have the
-*> form:
-*> [ a 0 ]
-*> [ 0 b ]
-*>
-*> and the pair of corresponding 2-by-2 blocks in S and T will have a
-*> complex conjugate pair of generalized eigenvalues.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVSL
-*> \verbatim
-*> JOBVSL is CHARACTER*1
-*> = 'N': do not compute the left Schur vectors;
-*> = 'V': compute the left Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVSR
-*> \verbatim
-*> JOBVSR is CHARACTER*1
-*> = 'N': do not compute the right Schur vectors;
-*> = 'V': compute the right Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the generalized Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELCTG);
-*> \endverbatim
-*>
-*> \param[in] SELCTG
-*> \verbatim
-*> SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
-*> SELCTG must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'N', SELCTG is not referenced.
-*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
-*> SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
-*> one of a complex conjugate pair of eigenvalues is selected,
-*> then both complex eigenvalues are selected.
-*>
-*> Note that in the ill-conditioned case, a selected complex
-*> eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
-*> BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
-*> in this case.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VSL, and VSR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the first of the pair of matrices.
-*> On exit, A has been overwritten by its generalized Schur
-*> form S.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the second of the pair of matrices.
-*> On exit, B has been overwritten by its generalized Schur
-*> form T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELCTG is true. (Complex conjugate pairs for which
-*> SELCTG is true for either eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
-*> and BETA(j),j=1,...,N are the diagonals of the complex Schur
-*> form (S,T) that would result if the 2-by-2 diagonal blocks of
-*> the real Schur form of (A,B) were further reduced to
-*> triangular form using 2-by-2 complex unitary transformations.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio.
-*> However, ALPHAR and ALPHAI will be always less than and
-*> usually comparable with norm(A) in magnitude, and BETA always
-*> less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VSL
-*> \verbatim
-*> VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
-*> If JOBVSL = 'V', VSL will contain the left Schur vectors.
-*> Not referenced if JOBVSL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSL
-*> \verbatim
-*> LDVSL is INTEGER
-*> The leading dimension of the matrix VSL. LDVSL >=1, and
-*> if JOBVSL = 'V', LDVSL >= N.
-*> \endverbatim
-*>
-*> \param[out] VSR
-*> \verbatim
-*> VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
-*> If JOBVSR = 'V', VSR will contain the right Schur vectors.
-*> Not referenced if JOBVSR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSR
-*> \verbatim
-*> LDVSR is INTEGER
-*> The leading dimension of the matrix VSR. LDVSR >= 1, and
-*> if JOBVSR = 'V', LDVSR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N = 0, LWORK >= 1, else LWORK >= 8*N+16.
-*> For good performance , LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. (A,B) are not in Schur
-*> form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*> be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in DHGEQZ.
-*> =N+2: after reordering, roundoff changed values of
-*> some complex eigenvalues so that leading
-*> eigenvalues in the Generalized Schur form no
-*> longer satisfy SELCTG=.TRUE. This could also
-*> be caused due to scaling.
-*> =N+3: reordering failed in DTGSEN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
- $ SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
- $ LDVSR, WORK, LWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVSL, JOBVSR, SORT
- INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
- $ VSR( LDVSR, * ), WORK( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELCTG
- EXTERNAL SELCTG
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, LST2SL, WANTST
- INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
- $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, MAXWRK,
- $ MINWRK
- DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
- $ PVSR, SAFMAX, SAFMIN, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER IDUM( 1 )
- DOUBLE PRECISION DIF( 2 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
- $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVSL, 'N' ) ) THEN
- IJOBVL = 1
- ILVSL = .FALSE.
- ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
- IJOBVL = 2
- ILVSL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVSL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVSR, 'N' ) ) THEN
- IJOBVR = 1
- ILVSR = .FALSE.
- ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
- IJOBVR = 2
- ILVSR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVSR = .FALSE.
- END IF
-*
- WANTST = LSAME( SORT, 'S' )
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
- INFO = -15
- ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
- INFO = -17
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.GT.0 )THEN
- MINWRK = MAX( 8*N, 6*N + 16 )
- MAXWRK = MINWRK - N +
- $ N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 )
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'DORMQR', ' ', N, 1, N, -1 ) )
- IF( ILVSL ) THEN
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) )
- END IF
- ELSE
- MINWRK = 1
- MAXWRK = 1
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -19
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGES ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SAFMIN = DLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- SMLNUM = SQRT( SAFMIN ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (Workspace: need 6*N + 2*N space for storing balancing factors)
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWRK = IRIGHT + N
- CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB)
-*
- IROWS = IHI + 1 - ILO
- ICOLS = N + 1 - ILO
- ITAU = IWRK
- IWRK = ITAU + IROWS
- CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to matrix A
-* (Workspace: need N, prefer N*NB)
-*
- CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VSL
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVSL ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
- IF( IROWS.GT.1 ) THEN
- CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VSL( ILO+1, ILO ), LDVSL )
- END IF
- CALL DORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
-* Initialize VSR
-*
- IF( ILVSR )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- CALL DGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
- $ LDVSL, VSR, LDVSR, IERR )
-*
-* Perform QZ algorithm, computing Schur vectors if desired
-* (Workspace: need N)
-*
- IWRK = ITAU
- CALL DHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 50
- END IF
-*
-* Sort eigenvalues ALPHA/BETA if desired
-* (Workspace: need 4*N+16 )
-*
- SDIM = 0
- IF( WANTST ) THEN
-*
-* Undo scaling on eigenvalues before SELCTGing
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
- $ IERR )
- END IF
- IF( ILBSCL )
- $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-*
-* Select eigenvalues
-*
- DO 10 I = 1, N
- BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- 10 CONTINUE
-*
- CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR,
- $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL,
- $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
- $ IERR )
- IF( IERR.EQ.1 )
- $ INFO = N + 3
-*
- END IF
-*
-* Apply back-permutation to VSL and VSR
-* (Workspace: none needed)
-*
- IF( ILVSL )
- $ CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSL, LDVSL, IERR )
-*
- IF( ILVSR )
- $ CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSR, LDVSR, IERR )
-*
-* Check if unscaling would cause over/underflow, if so, rescale
-* (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
-* B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
-*
- IF( ILASCL ) THEN
- DO 20 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( ALPHAR( I ) / SAFMAX ).GT.( ANRMTO / ANRM ) .OR.
- $ ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) ) THEN
- WORK( 1 ) = ABS( A( I, I ) / ALPHAR( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- ELSE IF( ( ALPHAI( I ) / SAFMAX ).GT.
- $ ( ANRMTO / ANRM ) .OR.
- $ ( SAFMIN / ALPHAI( I ) ).GT.( ANRM / ANRMTO ) )
- $ THEN
- WORK( 1 ) = ABS( A( I, I+1 ) / ALPHAI( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 20 CONTINUE
- END IF
-*
- IF( ILBSCL ) THEN
- DO 30 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( BETA( I ) / SAFMAX ).GT.( BNRMTO / BNRM ) .OR.
- $ ( SAFMIN / BETA( I ) ).GT.( BNRM / BNRMTO ) ) THEN
- WORK( 1 ) = ABS( B( I, I ) / BETA( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 30 CONTINUE
- END IF
-*
-* Undo scaling
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL DLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
- CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- IF( WANTST ) THEN
-*
-* Check if reordering is correct
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 40 I = 1, N
- CURSL = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- IF( ALPHAI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 40 CONTINUE
-*
- END IF
-*
- 50 CONTINUE
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of DGGES
-*
- END
diff --git a/netlib/LAPACK/dggesx.f b/netlib/LAPACK/dggesx.f
deleted file mode 100644
index 3f8a391..0000000
--- a/netlib/LAPACK/dggesx.f
+++ /dev/null
@@ -1,820 +0,0 @@
-*> \brief <b> DGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGESX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggesx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggesx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggesx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA,
-* B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL,
-* VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK,
-* LIWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVSL, JOBVSR, SENSE, SORT
-* INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LIWORK, LWORK, N,
-* $ SDIM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), RCONDE( 2 ),
-* $ RCONDV( 2 ), VSL( LDVSL, * ), VSR( LDVSR, * ),
-* $ WORK( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELCTG
-* EXTERNAL SELCTG
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGESX computes for a pair of N-by-N real nonsymmetric matrices
-*> (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
-*> optionally, the left and/or right matrices of Schur vectors (VSL and
-*> VSR). This gives the generalized Schur factorization
-*>
-*> (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )
-*>
-*> Optionally, it also orders the eigenvalues so that a selected cluster
-*> of eigenvalues appears in the leading diagonal blocks of the upper
-*> quasi-triangular matrix S and the upper triangular matrix T; computes
-*> a reciprocal condition number for the average of the selected
-*> eigenvalues (RCONDE); and computes a reciprocal condition number for
-*> the right and left deflating subspaces corresponding to the selected
-*> eigenvalues (RCONDV). The leading columns of VSL and VSR then form
-*> an orthonormal basis for the corresponding left and right eigenspaces
-*> (deflating subspaces).
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
-*> or a ratio alpha/beta = w, such that A - w*B is singular. It is
-*> usually represented as the pair (alpha,beta), as there is a
-*> reasonable interpretation for beta=0 or for both being zero.
-*>
-*> A pair of matrices (S,T) is in generalized real Schur form if T is
-*> upper triangular with non-negative diagonal and S is block upper
-*> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
-*> to real generalized eigenvalues, while 2-by-2 blocks of S will be
-*> "standardized" by making the corresponding elements of T have the
-*> form:
-*> [ a 0 ]
-*> [ 0 b ]
-*>
-*> and the pair of corresponding 2-by-2 blocks in S and T will have a
-*> complex conjugate pair of generalized eigenvalues.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVSL
-*> \verbatim
-*> JOBVSL is CHARACTER*1
-*> = 'N': do not compute the left Schur vectors;
-*> = 'V': compute the left Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVSR
-*> \verbatim
-*> JOBVSR is CHARACTER*1
-*> = 'N': do not compute the right Schur vectors;
-*> = 'V': compute the right Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the generalized Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELCTG).
-*> \endverbatim
-*>
-*> \param[in] SELCTG
-*> \verbatim
-*> SELCTG is procedure) LOGICAL FUNCTION of three DOUBLE PRECISION arguments
-*> SELCTG must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'N', SELCTG is not referenced.
-*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
-*> SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
-*> one of a complex conjugate pair of eigenvalues is selected,
-*> then both complex eigenvalues are selected.
-*> Note that a selected complex eigenvalue may no longer satisfy
-*> SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
-*> since ordering may change the value of complex eigenvalues
-*> (especially if the eigenvalue is ill-conditioned), in this
-*> case INFO is set to N+3.
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N' : None are computed;
-*> = 'E' : Computed for average of selected eigenvalues only;
-*> = 'V' : Computed for selected deflating subspaces only;
-*> = 'B' : Computed for both.
-*> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VSL, and VSR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the first of the pair of matrices.
-*> On exit, A has been overwritten by its generalized Schur
-*> form S.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the second of the pair of matrices.
-*> On exit, B has been overwritten by its generalized Schur
-*> form T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELCTG is true. (Complex conjugate pairs for which
-*> SELCTG is true for either eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
-*> and BETA(j),j=1,...,N are the diagonals of the complex Schur
-*> form (S,T) that would result if the 2-by-2 diagonal blocks of
-*> the real Schur form of (A,B) were further reduced to
-*> triangular form using 2-by-2 complex unitary transformations.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio.
-*> However, ALPHAR and ALPHAI will be always less than and
-*> usually comparable with norm(A) in magnitude, and BETA always
-*> less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VSL
-*> \verbatim
-*> VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
-*> If JOBVSL = 'V', VSL will contain the left Schur vectors.
-*> Not referenced if JOBVSL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSL
-*> \verbatim
-*> LDVSL is INTEGER
-*> The leading dimension of the matrix VSL. LDVSL >=1, and
-*> if JOBVSL = 'V', LDVSL >= N.
-*> \endverbatim
-*>
-*> \param[out] VSR
-*> \verbatim
-*> VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
-*> If JOBVSR = 'V', VSR will contain the right Schur vectors.
-*> Not referenced if JOBVSR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSR
-*> \verbatim
-*> LDVSR is INTEGER
-*> The leading dimension of the matrix VSR. LDVSR >= 1, and
-*> if JOBVSR = 'V', LDVSR >= N.
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is DOUBLE PRECISION array, dimension ( 2 )
-*> If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
-*> reciprocal condition numbers for the average of the selected
-*> eigenvalues.
-*> Not referenced if SENSE = 'N' or 'V'.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is DOUBLE PRECISION array, dimension ( 2 )
-*> If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
-*> reciprocal condition numbers for the selected deflating
-*> subspaces.
-*> Not referenced if SENSE = 'N' or 'E'.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
-*> LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
-*> LWORK >= max( 8*N, 6*N+16 ).
-*> Note that 2*SDIM*(N-SDIM) <= N*N/2.
-*> Note also that an error is only returned if
-*> LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
-*> this may not be large enough.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the bound on the optimal size of the WORK
-*> array and the minimum size of the IWORK array, returns these
-*> values as the first entries of the WORK and IWORK arrays, and
-*> no error message related to LWORK or LIWORK is issued by
-*> XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
-*> LIWORK >= N+6.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the bound on the optimal size of the
-*> WORK array and the minimum size of the IWORK array, returns
-*> these values as the first entries of the WORK and IWORK
-*> arrays, and no error message related to LWORK or LIWORK is
-*> issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. (A,B) are not in Schur
-*> form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*> be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in DHGEQZ
-*> =N+2: after reordering, roundoff changed values of
-*> some complex eigenvalues so that leading
-*> eigenvalues in the Generalized Schur form no
-*> longer satisfy SELCTG=.TRUE. This could also
-*> be caused due to scaling.
-*> =N+3: reordering failed in DTGSEN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> An approximate (asymptotic) bound on the average absolute error of
-*> the selected eigenvalues is
-*>
-*> EPS * norm((A, B)) / RCONDE( 1 ).
-*>
-*> An approximate (asymptotic) bound on the maximum angular error in
-*> the computed deflating subspaces is
-*>
-*> EPS * norm((A, B)) / RCONDV( 2 ).
-*>
-*> See LAPACK User's Guide, section 4.11 for more information.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA,
- $ B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL,
- $ VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK,
- $ LIWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVSL, JOBVSR, SENSE, SORT
- INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LIWORK, LWORK, N,
- $ SDIM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), RCONDE( 2 ),
- $ RCONDV( 2 ), VSL( LDVSL, * ), VSR( LDVSR, * ),
- $ WORK( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELCTG
- EXTERNAL SELCTG
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, LST2SL, WANTSB, WANTSE, WANTSN, WANTST,
- $ WANTSV
- INTEGER I, ICOLS, IERR, IHI, IJOB, IJOBVL, IJOBVR,
- $ ILEFT, ILO, IP, IRIGHT, IROWS, ITAU, IWRK,
- $ LIWMIN, LWRK, MAXWRK, MINWRK
- DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PL,
- $ PR, SAFMAX, SAFMIN, SMLNUM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DIF( 2 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
- $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVSL, 'N' ) ) THEN
- IJOBVL = 1
- ILVSL = .FALSE.
- ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
- IJOBVL = 2
- ILVSL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVSL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVSR, 'N' ) ) THEN
- IJOBVR = 1
- ILVSR = .FALSE.
- ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
- IJOBVR = 2
- ILVSR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVSR = .FALSE.
- END IF
-*
- WANTST = LSAME( SORT, 'S' )
- WANTSN = LSAME( SENSE, 'N' )
- WANTSE = LSAME( SENSE, 'E' )
- WANTSV = LSAME( SENSE, 'V' )
- WANTSB = LSAME( SENSE, 'B' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
- IF( WANTSN ) THEN
- IJOB = 0
- ELSE IF( WANTSE ) THEN
- IJOB = 1
- ELSE IF( WANTSV ) THEN
- IJOB = 2
- ELSE IF( WANTSB ) THEN
- IJOB = 4
- END IF
-*
-* Test the input arguments
-*
- INFO = 0
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
- $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN
- INFO = -5
- ELSE IF( N.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
- INFO = -16
- ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
- INFO = -18
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.GT.0) THEN
- MINWRK = MAX( 8*N, 6*N + 16 )
- MAXWRK = MINWRK - N +
- $ N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 )
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'DORMQR', ' ', N, 1, N, -1 ) )
- IF( ILVSL ) THEN
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) )
- END IF
- LWRK = MAXWRK
- IF( IJOB.GE.1 )
- $ LWRK = MAX( LWRK, N*N/2 )
- ELSE
- MINWRK = 1
- MAXWRK = 1
- LWRK = 1
- END IF
- WORK( 1 ) = LWRK
- IF( WANTSN .OR. N.EQ.0 ) THEN
- LIWMIN = 1
- ELSE
- LIWMIN = N + 6
- END IF
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -22
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -24
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGESX', -INFO )
- RETURN
- ELSE IF (LQUERY) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SAFMIN = DLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- SMLNUM = SQRT( SAFMIN ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (Workspace: need 6*N + 2*N for permutation parameters)
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWRK = IRIGHT + N
- CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB)
-*
- IROWS = IHI + 1 - ILO
- ICOLS = N + 1 - ILO
- ITAU = IWRK
- IWRK = ITAU + IROWS
- CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to matrix A
-* (Workspace: need N, prefer N*NB)
-*
- CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VSL
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVSL ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
- IF( IROWS.GT.1 ) THEN
- CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VSL( ILO+1, ILO ), LDVSL )
- END IF
- CALL DORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
-* Initialize VSR
-*
- IF( ILVSR )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- CALL DGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
- $ LDVSL, VSR, LDVSR, IERR )
-*
- SDIM = 0
-*
-* Perform QZ algorithm, computing Schur vectors if desired
-* (Workspace: need N)
-*
- IWRK = ITAU
- CALL DHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 60
- END IF
-*
-* Sort eigenvalues ALPHA/BETA and compute the reciprocal of
-* condition number(s)
-* (Workspace: If IJOB >= 1, need MAX( 8*(N+1), 2*SDIM*(N-SDIM) )
-* otherwise, need 8*(N+1) )
-*
- IF( WANTST ) THEN
-*
-* Undo scaling on eigenvalues before SELCTGing
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
- $ IERR )
- END IF
- IF( ILBSCL )
- $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-*
-* Select eigenvalues
-*
- DO 10 I = 1, N
- BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- 10 CONTINUE
-*
-* Reorder eigenvalues, transform Generalized Schur vectors, and
-* compute reciprocal condition numbers
-*
- CALL DTGSEN( IJOB, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ SDIM, PL, PR, DIF, WORK( IWRK ), LWORK-IWRK+1,
- $ IWORK, LIWORK, IERR )
-*
- IF( IJOB.GE.1 )
- $ MAXWRK = MAX( MAXWRK, 2*SDIM*( N-SDIM ) )
- IF( IERR.EQ.-22 ) THEN
-*
-* not enough real workspace
-*
- INFO = -22
- ELSE
- IF( IJOB.EQ.1 .OR. IJOB.EQ.4 ) THEN
- RCONDE( 1 ) = PL
- RCONDE( 2 ) = PR
- END IF
- IF( IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
- RCONDV( 1 ) = DIF( 1 )
- RCONDV( 2 ) = DIF( 2 )
- END IF
- IF( IERR.EQ.1 )
- $ INFO = N + 3
- END IF
-*
- END IF
-*
-* Apply permutation to VSL and VSR
-* (Workspace: none needed)
-*
- IF( ILVSL )
- $ CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSL, LDVSL, IERR )
-*
- IF( ILVSR )
- $ CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSR, LDVSR, IERR )
-*
-* Check if unscaling would cause over/underflow, if so, rescale
-* (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
-* B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
-*
- IF( ILASCL ) THEN
- DO 20 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( ALPHAR( I ) / SAFMAX ).GT.( ANRMTO / ANRM ) .OR.
- $ ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) ) THEN
- WORK( 1 ) = ABS( A( I, I ) / ALPHAR( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- ELSE IF( ( ALPHAI( I ) / SAFMAX ).GT.
- $ ( ANRMTO / ANRM ) .OR.
- $ ( SAFMIN / ALPHAI( I ) ).GT.( ANRM / ANRMTO ) )
- $ THEN
- WORK( 1 ) = ABS( A( I, I+1 ) / ALPHAI( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 20 CONTINUE
- END IF
-*
- IF( ILBSCL ) THEN
- DO 30 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( BETA( I ) / SAFMAX ).GT.( BNRMTO / BNRM ) .OR.
- $ ( SAFMIN / BETA( I ) ).GT.( BNRM / BNRMTO ) ) THEN
- WORK( 1 ) = ABS( B( I, I ) / BETA( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 30 CONTINUE
- END IF
-*
-* Undo scaling
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL DLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
- CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- IF( WANTST ) THEN
-*
-* Check if reordering is correct
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 50 I = 1, N
- CURSL = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- IF( ALPHAI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 50 CONTINUE
-*
- END IF
-*
- 60 CONTINUE
-*
- WORK( 1 ) = MAXWRK
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DGGESX
-*
- END
diff --git a/netlib/LAPACK/dggev.f b/netlib/LAPACK/dggev.f
deleted file mode 100644
index 1840af2..0000000
--- a/netlib/LAPACK/dggev.f
+++ /dev/null
@@ -1,592 +0,0 @@
-*> \brief <b> DGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-* BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
-*> the generalized eigenvalues, and optionally, the left and/or right
-*> generalized eigenvectors.
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar
-*> lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
-*> singular. It is usually represented as the pair (alpha,beta), as
-*> there is a reasonable interpretation for beta=0, and even for both
-*> being zero.
-*>
-*> The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> A * v(j) = lambda(j) * B * v(j).
-*>
-*> The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> u(j)**H * A = lambda(j) * u(j)**H * B .
-*>
-*> where u(j)**H is the conjugate-transpose of u(j).
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': do not compute the left generalized eigenvectors;
-*> = 'V': compute the left generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': do not compute the right generalized eigenvectors;
-*> = 'V': compute the right generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VL, and VR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the matrix A in the pair (A,B).
-*> On exit, A has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the matrix B in the pair (A,B).
-*> On exit, B has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. If ALPHAI(j) is zero, then
-*> the j-th eigenvalue is real; if positive, then the j-th and
-*> (j+1)-st eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio
-*> alpha/beta. However, ALPHAR and ALPHAI will be always less
-*> than and usually comparable with norm(A) in magnitude, and
-*> BETA always less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> u(j) = VL(:,j), the j-th column of VL. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
-*> Each eigenvector is scaled so the largest component has
-*> abs(real part)+abs(imag. part)=1.
-*> Not referenced if JOBVL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the matrix VL. LDVL >= 1, and
-*> if JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> v(j) = VR(:,j), the j-th column of VR. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
-*> Each eigenvector is scaled so the largest component has
-*> abs(real part)+abs(imag. part)=1.
-*> Not referenced if JOBVR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the matrix VR. LDVR >= 1, and
-*> if JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,8*N).
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. No eigenvectors have been
-*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*> should be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in DHGEQZ.
-*> =N+2: error return from DTGEVC.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
- $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
- CHARACTER CHTEMP
- INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
- $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, MAXWRK,
- $ MINWRK
- DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
- $ SMLNUM, TEMP
-* ..
-* .. Local Arrays ..
- LOGICAL LDUMMA( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
- $ DLACPY,DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVL, 'N' ) ) THEN
- IJOBVL = 1
- ILVL = .FALSE.
- ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
- IJOBVL = 2
- ILVL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVR, 'N' ) ) THEN
- IJOBVR = 1
- ILVR = .FALSE.
- ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
- IJOBVR = 2
- ILVR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVR = .FALSE.
- END IF
- ILV = ILVL .OR. ILVR
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
- INFO = -12
- ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
- INFO = -14
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV. The workspace is
-* computed assuming ILO = 1 and IHI = N, the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = MAX( 1, 8*N )
- MAXWRK = MAX( 1, N*( 7 +
- $ ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) ) )
- MAXWRK = MAX( MAXWRK, N*( 7 +
- $ ILAENV( 1, 'DORMQR', ' ', N, 1, N, 0 ) ) )
- IF( ILVL ) THEN
- MAXWRK = MAX( MAXWRK, N*( 7 +
- $ ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) ) )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -16
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute the matrices A, B to isolate eigenvalues if possible
-* (Workspace: need 6*N)
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWRK = IRIGHT + N
- CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB)
-*
- IROWS = IHI + 1 - ILO
- IF( ILV ) THEN
- ICOLS = N + 1 - ILO
- ELSE
- ICOLS = IROWS
- END IF
- ITAU = IWRK
- IWRK = ITAU + IROWS
- CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to matrix A
-* (Workspace: need N, prefer N*NB)
-*
- CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VL
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVL ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
- IF( IROWS.GT.1 ) THEN
- CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VL( ILO+1, ILO ), LDVL )
- END IF
- CALL DORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
-* Initialize VR
-*
- IF( ILVR )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- IF( ILV ) THEN
-*
-* Eigenvectors requested -- work on whole matrix.
-*
- CALL DGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, IERR )
- ELSE
- CALL DGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
- $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
- END IF
-*
-* Perform QZ algorithm (Compute eigenvalues, and optionally, the
-* Schur forms and Schur vectors)
-* (Workspace: need N)
-*
- IWRK = ITAU
- IF( ILV ) THEN
- CHTEMP = 'S'
- ELSE
- CHTEMP = 'E'
- END IF
- CALL DHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 110
- END IF
-*
-* Compute Eigenvectors
-* (Workspace: need 6*N)
-*
- IF( ILV ) THEN
- IF( ILVL ) THEN
- IF( ILVR ) THEN
- CHTEMP = 'B'
- ELSE
- CHTEMP = 'L'
- END IF
- ELSE
- CHTEMP = 'R'
- END IF
- CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
- $ VR, LDVR, N, IN, WORK( IWRK ), IERR )
- IF( IERR.NE.0 ) THEN
- INFO = N + 2
- GO TO 110
- END IF
-*
-* Undo balancing on VL and VR and normalization
-* (Workspace: none needed)
-*
- IF( ILVL ) THEN
- CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VL, LDVL, IERR )
- DO 50 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 50
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 10 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
- 10 CONTINUE
- ELSE
- DO 20 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
- $ ABS( VL( JR, JC+1 ) ) )
- 20 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 50
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 30 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- 30 CONTINUE
- ELSE
- DO 40 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
- 40 CONTINUE
- END IF
- 50 CONTINUE
- END IF
- IF( ILVR ) THEN
- CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VR, LDVR, IERR )
- DO 100 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 100
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 60 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
- 60 CONTINUE
- ELSE
- DO 70 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
- $ ABS( VR( JR, JC+1 ) ) )
- 70 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 100
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 80 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- 80 CONTINUE
- ELSE
- DO 90 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- END IF
-*
-* End of eigenvector calculation
-*
- END IF
-*
-* Undo scaling if necessary
-*
- 110 CONTINUE
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGGEV
-*
- END
diff --git a/netlib/LAPACK/dggevx.f b/netlib/LAPACK/dggevx.f
deleted file mode 100644
index ebf9f2c..0000000
--- a/netlib/LAPACK/dggevx.f
+++ /dev/null
@@ -1,868 +0,0 @@
-*> \brief <b> DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB,
-* ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO,
-* IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE,
-* RCONDV, WORK, LWORK, IWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER BALANC, JOBVL, JOBVR, SENSE
-* INTEGER IHI, ILO, INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* DOUBLE PRECISION ABNRM, BBNRM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), LSCALE( * ),
-* $ RCONDE( * ), RCONDV( * ), RSCALE( * ),
-* $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
-*> the generalized eigenvalues, and optionally, the left and/or right
-*> generalized eigenvectors.
-*>
-*> Optionally also, it computes a balancing transformation to improve
-*> the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
-*> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
-*> the eigenvalues (RCONDE), and reciprocal condition numbers for the
-*> right eigenvectors (RCONDV).
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar
-*> lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
-*> singular. It is usually represented as the pair (alpha,beta), as
-*> there is a reasonable interpretation for beta=0, and even for both
-*> being zero.
-*>
-*> The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> A * v(j) = lambda(j) * B * v(j) .
-*>
-*> The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> u(j)**H * A = lambda(j) * u(j)**H * B.
-*>
-*> where u(j)**H is the conjugate-transpose of u(j).
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] BALANC
-*> \verbatim
-*> BALANC is CHARACTER*1
-*> Specifies the balance option to be performed.
-*> = 'N': do not diagonally scale or permute;
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> Computed reciprocal condition numbers will be for the
-*> matrices after permuting and/or balancing. Permuting does
-*> not change condition numbers (in exact arithmetic), but
-*> balancing does.
-*> \endverbatim
-*>
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': do not compute the left generalized eigenvectors;
-*> = 'V': compute the left generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': do not compute the right generalized eigenvectors;
-*> = 'V': compute the right generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N': none are computed;
-*> = 'E': computed for eigenvalues only;
-*> = 'V': computed for eigenvectors only;
-*> = 'B': computed for eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VL, and VR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the matrix A in the pair (A,B).
-*> On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
-*> or both, then A contains the first part of the real Schur
-*> form of the "balanced" versions of the input A and B.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the matrix B in the pair (A,B).
-*> On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
-*> or both, then B contains the second part of the real Schur
-*> form of the "balanced" versions of the input A and B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. If ALPHAI(j) is zero, then
-*> the j-th eigenvalue is real; if positive, then the j-th and
-*> (j+1)-st eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio
-*> ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
-*> than and usually comparable with norm(A) in magnitude, and
-*> BETA always less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> u(j) = VL(:,j), the j-th column of VL. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
-*> Each eigenvector will be scaled so the largest component have
-*> abs(real part) + abs(imag. part) = 1.
-*> Not referenced if JOBVL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the matrix VL. LDVL >= 1, and
-*> if JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> v(j) = VR(:,j), the j-th column of VR. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
-*> Each eigenvector will be scaled so the largest component have
-*> abs(real part) + abs(imag. part) = 1.
-*> Not referenced if JOBVR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the matrix VR. LDVR >= 1, and
-*> if JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are integer values such that on exit
-*> A(i,j) = 0 and B(i,j) = 0 if i > j and
-*> j = 1,...,ILO-1 or i = IHI+1,...,N.
-*> If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] LSCALE
-*> \verbatim
-*> LSCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the left side of A and B. If PL(j) is the index of the
-*> row interchanged with row j, and DL(j) is the scaling
-*> factor applied to row j, then
-*> LSCALE(j) = PL(j) for j = 1,...,ILO-1
-*> = DL(j) for j = ILO,...,IHI
-*> = PL(j) for j = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] RSCALE
-*> \verbatim
-*> RSCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the right side of A and B. If PR(j) is the index of the
-*> column interchanged with column j, and DR(j) is the scaling
-*> factor applied to column j, then
-*> RSCALE(j) = PR(j) for j = 1,...,ILO-1
-*> = DR(j) for j = ILO,...,IHI
-*> = PR(j) for j = IHI+1,...,N
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] ABNRM
-*> \verbatim
-*> ABNRM is DOUBLE PRECISION
-*> The one-norm of the balanced matrix A.
-*> \endverbatim
-*>
-*> \param[out] BBNRM
-*> \verbatim
-*> BBNRM is DOUBLE PRECISION
-*> The one-norm of the balanced matrix B.
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is DOUBLE PRECISION array, dimension (N)
-*> If SENSE = 'E' or 'B', the reciprocal condition numbers of
-*> the eigenvalues, stored in consecutive elements of the array.
-*> For a complex conjugate pair of eigenvalues two consecutive
-*> elements of RCONDE are set to the same value. Thus RCONDE(j),
-*> RCONDV(j), and the j-th columns of VL and VR all correspond
-*> to the j-th eigenpair.
-*> If SENSE = 'N or 'V', RCONDE is not referenced.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is DOUBLE PRECISION array, dimension (N)
-*> If SENSE = 'V' or 'B', the estimated reciprocal condition
-*> numbers of the eigenvectors, stored in consecutive elements
-*> of the array. For a complex eigenvector two consecutive
-*> elements of RCONDV are set to the same value. If the
-*> eigenvalues cannot be reordered to compute RCONDV(j),
-*> RCONDV(j) is set to 0; this can only occur when the true
-*> value would be very small anyway.
-*> If SENSE = 'N' or 'E', RCONDV is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,2*N).
-*> If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
-*> LWORK >= max(1,6*N).
-*> If SENSE = 'E' or 'B', LWORK >= max(1,10*N).
-*> If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N+6)
-*> If SENSE = 'E', IWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> If SENSE = 'N', BWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. No eigenvectors have been
-*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*> should be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in DHGEQZ.
-*> =N+2: error return from DTGEVC.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Balancing a matrix pair (A,B) includes, first, permuting rows and
-*> columns to isolate eigenvalues, second, applying diagonal similarity
-*> transformation to the rows and columns to make the rows and columns
-*> as close in norm as possible. The computed reciprocal condition
-*> numbers correspond to the balanced matrix. Permuting rows and columns
-*> will not change the condition numbers (in exact arithmetic) but
-*> diagonal scaling will. For further explanation of balancing, see
-*> section 4.11.1.2 of LAPACK Users' Guide.
-*>
-*> An approximate error bound on the chordal distance between the i-th
-*> computed generalized eigenvalue w and the corresponding exact
-*> eigenvalue lambda is
-*>
-*> chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)
-*>
-*> An approximate error bound for the angle between the i-th computed
-*> eigenvector VL(i) or VR(i) is given by
-*>
-*> EPS * norm(ABNRM, BBNRM) / DIF(i).
-*>
-*> For further explanation of the reciprocal condition numbers RCONDE
-*> and RCONDV, see section 4.11 of LAPACK User's Guide.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO,
- $ IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE,
- $ RCONDV, WORK, LWORK, IWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER BALANC, JOBVL, JOBVR, SENSE
- INTEGER IHI, ILO, INFO, LDA, LDB, LDVL, LDVR, LWORK, N
- DOUBLE PRECISION ABNRM, BBNRM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), LSCALE( * ),
- $ RCONDE( * ), RCONDV( * ), RSCALE( * ),
- $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY, NOSCL,
- $ PAIR, WANTSB, WANTSE, WANTSN, WANTSV
- CHARACTER CHTEMP
- INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
- $ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK,
- $ MINWRK, MM
- DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
- $ SMLNUM, TEMP
-* ..
-* .. Local Arrays ..
- LOGICAL LDUMMA( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
- $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
- $ DTGSNA, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVL, 'N' ) ) THEN
- IJOBVL = 1
- ILVL = .FALSE.
- ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
- IJOBVL = 2
- ILVL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVR, 'N' ) ) THEN
- IJOBVR = 1
- ILVR = .FALSE.
- ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
- IJOBVR = 2
- ILVR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVR = .FALSE.
- END IF
- ILV = ILVL .OR. ILVR
-*
- NOSCL = LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'P' )
- WANTSN = LSAME( SENSE, 'N' )
- WANTSE = LSAME( SENSE, 'E' )
- WANTSV = LSAME( SENSE, 'V' )
- WANTSB = LSAME( SENSE, 'B' )
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
- $ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
- $ THEN
- INFO = -1
- ELSE IF( IJOBVL.LE.0 ) THEN
- INFO = -2
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -3
- ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSB .OR. WANTSV ) )
- $ THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
- INFO = -16
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV. The workspace is
-* computed assuming ILO = 1 and IHI = N, the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- IF( NOSCL .AND. .NOT.ILV ) THEN
- MINWRK = 2*N
- ELSE
- MINWRK = 6*N
- END IF
- IF( WANTSE .OR. WANTSB ) THEN
- MINWRK = 10*N
- END IF
- IF( WANTSV .OR. WANTSB ) THEN
- MINWRK = MAX( MINWRK, 2*N*( N + 4 ) + 16 )
- END IF
- MAXWRK = MINWRK
- MAXWRK = MAX( MAXWRK,
- $ N + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) )
- MAXWRK = MAX( MAXWRK,
- $ N + N*ILAENV( 1, 'DORMQR', ' ', N, 1, N, 0 ) )
- IF( ILVL ) THEN
- MAXWRK = MAX( MAXWRK, N +
- $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, 0 ) )
- END IF
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -26
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGEVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute and/or balance the matrix pair (A,B)
-* (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise)
-*
- CALL DGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
- $ WORK, IERR )
-*
-* Compute ABNRM and BBNRM
-*
- ABNRM = DLANGE( '1', N, N, A, LDA, WORK( 1 ) )
- IF( ILASCL ) THEN
- WORK( 1 ) = ABNRM
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, 1, 1, WORK( 1 ), 1,
- $ IERR )
- ABNRM = WORK( 1 )
- END IF
-*
- BBNRM = DLANGE( '1', N, N, B, LDB, WORK( 1 ) )
- IF( ILBSCL ) THEN
- WORK( 1 ) = BBNRM
- CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, 1, 1, WORK( 1 ), 1,
- $ IERR )
- BBNRM = WORK( 1 )
- END IF
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB )
-*
- IROWS = IHI + 1 - ILO
- IF( ILV .OR. .NOT.WANTSN ) THEN
- ICOLS = N + 1 - ILO
- ELSE
- ICOLS = IROWS
- END IF
- ITAU = 1
- IWRK = ITAU + IROWS
- CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to A
-* (Workspace: need N, prefer N*NB)
-*
- CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VL and/or VR
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVL ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
- IF( IROWS.GT.1 ) THEN
- CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VL( ILO+1, ILO ), LDVL )
- END IF
- CALL DORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
- IF( ILVR )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- IF( ILV .OR. .NOT.WANTSN ) THEN
-*
-* Eigenvectors requested -- work on whole matrix.
-*
- CALL DGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, IERR )
- ELSE
- CALL DGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
- $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
- END IF
-*
-* Perform QZ algorithm (Compute eigenvalues, and optionally, the
-* Schur forms and Schur vectors)
-* (Workspace: need N)
-*
- IF( ILV .OR. .NOT.WANTSN ) THEN
- CHTEMP = 'S'
- ELSE
- CHTEMP = 'E'
- END IF
-*
- CALL DHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK,
- $ LWORK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 130
- END IF
-*
-* Compute Eigenvectors and estimate condition numbers if desired
-* (Workspace: DTGEVC: need 6*N
-* DTGSNA: need 2*N*(N+2)+16 if SENSE = 'V' or 'B',
-* need N otherwise )
-*
- IF( ILV .OR. .NOT.WANTSN ) THEN
- IF( ILV ) THEN
- IF( ILVL ) THEN
- IF( ILVR ) THEN
- CHTEMP = 'B'
- ELSE
- CHTEMP = 'L'
- END IF
- ELSE
- CHTEMP = 'R'
- END IF
-*
- CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, N, IN, WORK, IERR )
- IF( IERR.NE.0 ) THEN
- INFO = N + 2
- GO TO 130
- END IF
- END IF
-*
- IF( .NOT.WANTSN ) THEN
-*
-* compute eigenvectors (DTGEVC) and estimate condition
-* numbers (DTGSNA). Note that the definition of the condition
-* number is not invariant under transformation (u,v) to
-* (Q*u, Z*v), where (u,v) are eigenvectors of the generalized
-* Schur form (S,T), Q and Z are orthogonal matrices. In order
-* to avoid using extra 2*N*N workspace, we have to recalculate
-* eigenvectors and estimate one condition numbers at a time.
-*
- PAIR = .FALSE.
- DO 20 I = 1, N
-*
- IF( PAIR ) THEN
- PAIR = .FALSE.
- GO TO 20
- END IF
- MM = 1
- IF( I.LT.N ) THEN
- IF( A( I+1, I ).NE.ZERO ) THEN
- PAIR = .TRUE.
- MM = 2
- END IF
- END IF
-*
- DO 10 J = 1, N
- BWORK( J ) = .FALSE.
- 10 CONTINUE
- IF( MM.EQ.1 ) THEN
- BWORK( I ) = .TRUE.
- ELSE IF( MM.EQ.2 ) THEN
- BWORK( I ) = .TRUE.
- BWORK( I+1 ) = .TRUE.
- END IF
-*
- IWRK = MM*N + 1
- IWRK1 = IWRK + MM*N
-*
-* Compute a pair of left and right eigenvectors.
-* (compute workspace: need up to 4*N + 6*N)
-*
- IF( WANTSE .OR. WANTSB ) THEN
- CALL DTGEVC( 'B', 'S', BWORK, N, A, LDA, B, LDB,
- $ WORK( 1 ), N, WORK( IWRK ), N, MM, M,
- $ WORK( IWRK1 ), IERR )
- IF( IERR.NE.0 ) THEN
- INFO = N + 2
- GO TO 130
- END IF
- END IF
-*
- CALL DTGSNA( SENSE, 'S', BWORK, N, A, LDA, B, LDB,
- $ WORK( 1 ), N, WORK( IWRK ), N, RCONDE( I ),
- $ RCONDV( I ), MM, M, WORK( IWRK1 ),
- $ LWORK-IWRK1+1, IWORK, IERR )
-*
- 20 CONTINUE
- END IF
- END IF
-*
-* Undo balancing on VL and VR and normalization
-* (Workspace: none needed)
-*
- IF( ILVL ) THEN
- CALL DGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, VL,
- $ LDVL, IERR )
-*
- DO 70 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 70
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 30 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
- 30 CONTINUE
- ELSE
- DO 40 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
- $ ABS( VL( JR, JC+1 ) ) )
- 40 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 70
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 50 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- 50 CONTINUE
- ELSE
- DO 60 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
- 60 CONTINUE
- END IF
- 70 CONTINUE
- END IF
- IF( ILVR ) THEN
- CALL DGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, VR,
- $ LDVR, IERR )
- DO 120 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 120
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 80 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
- 80 CONTINUE
- ELSE
- DO 90 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
- $ ABS( VR( JR, JC+1 ) ) )
- 90 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 120
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 100 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- 100 CONTINUE
- ELSE
- DO 110 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 130 CONTINUE
-*
- IF( ILASCL ) THEN
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGGEVX
-*
- END
diff --git a/netlib/LAPACK/dggglm.f b/netlib/LAPACK/dggglm.f
deleted file mode 100644
index 3cee32b..0000000
--- a/netlib/LAPACK/dggglm.f
+++ /dev/null
@@ -1,348 +0,0 @@
-*> \brief <b> DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGGLM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggglm.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggglm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggglm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
-* $ X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGGLM solves a general Gauss-Markov linear model (GLM) problem:
-*>
-*> minimize || y ||_2 subject to d = A*x + B*y
-*> x
-*>
-*> where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
-*> given N-vector. It is assumed that M <= N <= M+P, and
-*>
-*> rank(A) = M and rank( A B ) = N.
-*>
-*> Under these assumptions, the constrained equation is always
-*> consistent, and there is a unique solution x and a minimal 2-norm
-*> solution y, which is obtained using a generalized QR factorization
-*> of the matrices (A, B) given by
-*>
-*> A = Q*(R), B = Q*T*Z.
-*> (0)
-*>
-*> In particular, if matrix B is square nonsingular, then the problem
-*> GLM is equivalent to the following weighted linear least squares
-*> problem
-*>
-*> minimize || inv(B)*(d-A*x) ||_2
-*> x
-*>
-*> where inv(B) denotes the inverse of B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix A. 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of columns of the matrix B. P >= N-M.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,M)
-*> On entry, the N-by-M matrix A.
-*> On exit, the upper triangular part of the array A contains
-*> the M-by-M upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,P)
-*> On entry, the N-by-P matrix B.
-*> On exit, if N <= P, the upper triangle of the subarray
-*> B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
-*> if N > P, the elements on and above the (N-P)th subdiagonal
-*> contain the N-by-P upper trapezoidal matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D is the left hand side of the GLM equation.
-*> On exit, D is destroyed.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (P)
-*>
-*> On exit, X and Y are the solutions of the GLM problem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N+M+P).
-*> For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
-*> where NB is an upper bound for the optimal blocksizes for
-*> DGEQRF, SGERQF, DORMQR and SORMRQ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1: the upper triangular factor R associated with A in the
-*> generalized QR factorization of the pair (A, B) is
-*> singular, so that rank(A) < M; the least squares
-*> solution could not be computed.
-*> = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal
-*> factor T associated with B in the generalized QR
-*> factorization of the pair (A, B) is singular, so that
-*> rank( A B ) < N; the least squares solution could not
-*> be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
- $ X( * ), Y( * )
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, LOPT, LWKMIN, LWKOPT, NB, NB1, NB2, NB3,
- $ NB4, NP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMV, DGGQRF, DORMQR, DORMRQ, DTRTRS,
- $ XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NP = MIN( N, P )
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 .OR. M.GT.N ) THEN
- INFO = -2
- ELSE IF( P.LT.0 .OR. P.LT.N-M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
-*
-* Calculate workspace
-*
- IF( INFO.EQ.0) THEN
- IF( N.EQ.0 ) THEN
- LWKMIN = 1
- LWKOPT = 1
- ELSE
- NB1 = ILAENV( 1, 'DGEQRF', ' ', N, M, -1, -1 )
- NB2 = ILAENV( 1, 'DGERQF', ' ', N, M, -1, -1 )
- NB3 = ILAENV( 1, 'DORMQR', ' ', N, M, P, -1 )
- NB4 = ILAENV( 1, 'DORMRQ', ' ', N, M, P, -1 )
- NB = MAX( NB1, NB2, NB3, NB4 )
- LWKMIN = M + N + P
- LWKOPT = M + NP + MAX( N, P )*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGGLM', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Compute the GQR factorization of matrices A and B:
-*
-* Q**T*A = ( R11 ) M, Q**T*B*Z**T = ( T11 T12 ) M
-* ( 0 ) N-M ( 0 T22 ) N-M
-* M M+P-N N-M
-*
-* where R11 and T22 are upper triangular, and Q and Z are
-* orthogonal.
-*
- CALL DGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ),
- $ WORK( M+NP+1 ), LWORK-M-NP, INFO )
- LOPT = WORK( M+NP+1 )
-*
-* Update left-hand-side vector d = Q**T*d = ( d1 ) M
-* ( d2 ) N-M
-*
- CALL DORMQR( 'Left', 'Transpose', N, 1, M, A, LDA, WORK, D,
- $ MAX( 1, N ), WORK( M+NP+1 ), LWORK-M-NP, INFO )
- LOPT = MAX( LOPT, INT( WORK( M+NP+1 ) ) )
-*
-* Solve T22*y2 = d2 for y2
-*
- IF( N.GT.M ) THEN
- CALL DTRTRS( 'Upper', 'No transpose', 'Non unit', N-M, 1,
- $ B( M+1, M+P-N+1 ), LDB, D( M+1 ), N-M, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
- CALL DCOPY( N-M, D( M+1 ), 1, Y( M+P-N+1 ), 1 )
- END IF
-*
-* Set y1 = 0
-*
- DO 10 I = 1, M + P - N
- Y( I ) = ZERO
- 10 CONTINUE
-*
-* Update d1 = d1 - T12*y2
-*
- CALL DGEMV( 'No transpose', M, N-M, -ONE, B( 1, M+P-N+1 ), LDB,
- $ Y( M+P-N+1 ), 1, ONE, D, 1 )
-*
-* Solve triangular system: R11*x = d1
-*
- IF( M.GT.0 ) THEN
- CALL DTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, LDA,
- $ D, M, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 2
- RETURN
- END IF
-*
-* Copy D to X
-*
- CALL DCOPY( M, D, 1, X, 1 )
- END IF
-*
-* Backward transformation y = Z**T *y
-*
- CALL DORMRQ( 'Left', 'Transpose', P, 1, NP,
- $ B( MAX( 1, N-P+1 ), 1 ), LDB, WORK( M+1 ), Y,
- $ MAX( 1, P ), WORK( M+NP+1 ), LWORK-M-NP, INFO )
- WORK( 1 ) = M + NP + MAX( LOPT, INT( WORK( M+NP+1 ) ) )
-*
- RETURN
-*
-* End of DGGGLM
-*
- END
diff --git a/netlib/LAPACK/dgghrd.f b/netlib/LAPACK/dgghrd.f
deleted file mode 100644
index 3157af8..0000000
--- a/netlib/LAPACK/dgghrd.f
+++ /dev/null
@@ -1,361 +0,0 @@
-*> \brief \b DGGHRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGHRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgghrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgghrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgghrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
-* LDQ, Z, LDZ, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, COMPZ
-* INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGHRD reduces a pair of real matrices (A,B) to generalized upper
-*> Hessenberg form using orthogonal transformations, where A is a
-*> general matrix and B is upper triangular. The form of the
-*> generalized eigenvalue problem is
-*> A*x = lambda*B*x,
-*> and B is typically made upper triangular by computing its QR
-*> factorization and moving the orthogonal matrix Q to the left side
-*> of the equation.
-*>
-*> This subroutine simultaneously reduces A to a Hessenberg matrix H:
-*> Q**T*A*Z = H
-*> and transforms B to another upper triangular matrix T:
-*> Q**T*B*Z = T
-*> in order to reduce the problem to its standard form
-*> H*y = lambda*T*y
-*> where y = Z**T*x.
-*>
-*> The orthogonal matrices Q and Z are determined as products of Givens
-*> rotations. They may either be formed explicitly, or they may be
-*> postmultiplied into input matrices Q1 and Z1, so that
-*>
-*> Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
-*>
-*> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
-*>
-*> If Q1 is the orthogonal matrix from the QR factorization of B in the
-*> original equation A*x = lambda*B*x, then DGGHRD reduces the original
-*> problem to generalized Hessenberg form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'N': do not compute Q;
-*> = 'I': Q is initialized to the unit matrix, and the
-*> orthogonal matrix Q is returned;
-*> = 'V': Q must contain an orthogonal matrix Q1 on entry,
-*> and the product Q1*Q is returned.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': do not compute Z;
-*> = 'I': Z is initialized to the unit matrix, and the
-*> orthogonal matrix Z is returned;
-*> = 'V': Z must contain an orthogonal matrix Z1 on entry,
-*> and the product Z1*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI mark the rows and columns of A which are to be
-*> reduced. It is assumed that A is already upper triangular
-*> in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
-*> normally set by a previous call to DGGBAL; otherwise they
-*> should be set to 1 and N respectively.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the N-by-N general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> rest is set to zero.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the N-by-N upper triangular matrix B.
-*> On exit, the upper triangular matrix T = Q**T B Z. The
-*> elements below the diagonal are set to zero.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> On entry, if COMPQ = 'V', the orthogonal matrix Q1,
-*> typically from the QR factorization of B.
-*> On exit, if COMPQ='I', the orthogonal matrix Q, and if
-*> COMPQ = 'V', the product Q1*Q.
-*> Not referenced if COMPQ='N'.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix Z1.
-*> On exit, if COMPZ='I', the orthogonal matrix Z, and if
-*> COMPZ = 'V', the product Z1*Z.
-*> Not referenced if COMPZ='N'.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z.
-*> LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine reduces A to Hessenberg and B to triangular form by
-*> an unblocked reduction, as described in _Matrix_Computations_,
-*> by Golub and Van Loan (Johns Hopkins Press.)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
- $ LDQ, Z, LDZ, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, COMPZ
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILQ, ILZ
- INTEGER ICOMPQ, ICOMPZ, JCOL, JROW
- DOUBLE PRECISION C, S, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARTG, DLASET, DROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode COMPQ
-*
- IF( LSAME( COMPQ, 'N' ) ) THEN
- ILQ = .FALSE.
- ICOMPQ = 1
- ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 2
- ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 3
- ELSE
- ICOMPQ = 0
- END IF
-*
-* Decode COMPZ
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ILZ = .FALSE.
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 2
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 3
- ELSE
- ICOMPZ = 0
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( ICOMPQ.LE.0 ) THEN
- INFO = -1
- ELSE IF( ICOMPZ.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 ) THEN
- INFO = -4
- ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( ( ILQ .AND. LDQ.LT.N ) .OR. LDQ.LT.1 ) THEN
- INFO = -11
- ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGHRD', -INFO )
- RETURN
- END IF
-*
-* Initialize Q and Z if desired.
-*
- IF( ICOMPQ.EQ.3 )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
- IF( ICOMPZ.EQ.3 )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Zero out lower triangle of B
-*
- DO 20 JCOL = 1, N - 1
- DO 10 JROW = JCOL + 1, N
- B( JROW, JCOL ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Reduce A and B
-*
- DO 40 JCOL = ILO, IHI - 2
-*
- DO 30 JROW = IHI, JCOL + 2, -1
-*
-* Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL)
-*
- TEMP = A( JROW-1, JCOL )
- CALL DLARTG( TEMP, A( JROW, JCOL ), C, S,
- $ A( JROW-1, JCOL ) )
- A( JROW, JCOL ) = ZERO
- CALL DROT( N-JCOL, A( JROW-1, JCOL+1 ), LDA,
- $ A( JROW, JCOL+1 ), LDA, C, S )
- CALL DROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB,
- $ B( JROW, JROW-1 ), LDB, C, S )
- IF( ILQ )
- $ CALL DROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, S )
-*
-* Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1)
-*
- TEMP = B( JROW, JROW )
- CALL DLARTG( TEMP, B( JROW, JROW-1 ), C, S,
- $ B( JROW, JROW ) )
- B( JROW, JROW-1 ) = ZERO
- CALL DROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S )
- CALL DROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C,
- $ S )
- IF( ILZ )
- $ CALL DROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S )
- 30 CONTINUE
- 40 CONTINUE
-*
- RETURN
-*
-* End of DGGHRD
-*
- END
diff --git a/netlib/LAPACK/dgglse.f b/netlib/LAPACK/dgglse.f
deleted file mode 100644
index 429c798..0000000
--- a/netlib/LAPACK/dgglse.f
+++ /dev/null
@@ -1,354 +0,0 @@
-*> \brief <b> DGGLSE solves overdetermined or underdetermined systems for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGLSE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgglse.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgglse.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgglse.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( * ), D( * ),
-* $ WORK( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGLSE solves the linear equality-constrained least squares (LSE)
-*> problem:
-*>
-*> minimize || c - A*x ||_2 subject to B*x = d
-*>
-*> where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
-*> M-vector, and d is a given P-vector. It is assumed that
-*> P <= N <= M+P, and
-*>
-*> rank(B) = P and rank( (A) ) = N.
-*> ( (B) )
-*>
-*> These conditions ensure that the LSE problem has a unique solution,
-*> which is obtained using a generalized RQ factorization of the
-*> matrices (B, A) given by
-*>
-*> B = (0 R)*Q, A = Z*T*Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. 0 <= P <= N <= M+P.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, the upper triangle of the subarray B(1:P,N-P+1:N)
-*> contains the P-by-P upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (M)
-*> On entry, C contains the right hand side vector for the
-*> least squares part of the LSE problem.
-*> On exit, the residual sum of squares for the solution
-*> is given by the sum of squares of elements N-P+1 to M of
-*> vector C.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (P)
-*> On entry, D contains the right hand side vector for the
-*> constrained equation.
-*> On exit, D is destroyed.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On exit, X is the solution of the LSE problem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M+N+P).
-*> For optimum performance LWORK >= P+min(M,N)+max(M,N)*NB,
-*> where NB is an upper bound for the optimal blocksizes for
-*> DGEQRF, SGERQF, DORMQR and SORMRQ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1: the upper triangular factor R associated with B in the
-*> generalized RQ factorization of the pair (B, A) is
-*> singular, so that rank(B) < P; the least squares
-*> solution could not be computed.
-*> = 2: the (N-P) by (N-P) part of the upper trapezoidal factor
-*> T associated with A in the generalized RQ factorization
-*> of the pair (B, A) is singular, so that
-*> rank( (A) ) < N; the least squares solution could not
-*> ( (B) )
-*> be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERsolve
-*
-* =====================================================================
- SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( * ), D( * ),
- $ WORK( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LOPT, LWKMIN, LWKOPT, MN, NB, NB1, NB2, NB3,
- $ NB4, NR
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DGGRQF, DORMQR, DORMRQ,
- $ DTRMV, DTRTRS, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( P.LT.0 .OR. P.GT.N .OR. P.LT.N-M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -7
- END IF
-*
-* Calculate workspace
-*
- IF( INFO.EQ.0) THEN
- IF( N.EQ.0 ) THEN
- LWKMIN = 1
- LWKOPT = 1
- ELSE
- NB1 = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- NB2 = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
- NB3 = ILAENV( 1, 'DORMQR', ' ', M, N, P, -1 )
- NB4 = ILAENV( 1, 'DORMRQ', ' ', M, N, P, -1 )
- NB = MAX( NB1, NB2, NB3, NB4 )
- LWKMIN = M + N + P
- LWKOPT = P + MN + MAX( M, N )*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGLSE', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Compute the GRQ factorization of matrices B and A:
-*
-* B*Q**T = ( 0 T12 ) P Z**T*A*Q**T = ( R11 R12 ) N-P
-* N-P P ( 0 R22 ) M+P-N
-* N-P P
-*
-* where T12 and R11 are upper triangular, and Q and Z are
-* orthogonal.
-*
- CALL DGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ),
- $ WORK( P+MN+1 ), LWORK-P-MN, INFO )
- LOPT = WORK( P+MN+1 )
-*
-* Update c = Z**T *c = ( c1 ) N-P
-* ( c2 ) M+P-N
-*
- CALL DORMQR( 'Left', 'Transpose', M, 1, MN, A, LDA, WORK( P+1 ),
- $ C, MAX( 1, M ), WORK( P+MN+1 ), LWORK-P-MN, INFO )
- LOPT = MAX( LOPT, INT( WORK( P+MN+1 ) ) )
-*
-* Solve T12*x2 = d for x2
-*
- IF( P.GT.0 ) THEN
- CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', P, 1,
- $ B( 1, N-P+1 ), LDB, D, P, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Put the solution in X
-*
- CALL DCOPY( P, D, 1, X( N-P+1 ), 1 )
-*
-* Update c1
-*
- CALL DGEMV( 'No transpose', N-P, P, -ONE, A( 1, N-P+1 ), LDA,
- $ D, 1, ONE, C, 1 )
- END IF
-*
-* Solve R11*x1 = c1 for x1
-*
- IF( N.GT.P ) THEN
- CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N-P, 1,
- $ A, LDA, C, N-P, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 2
- RETURN
- END IF
-*
-* Put the solutions in X
-*
- CALL DCOPY( N-P, C, 1, X, 1 )
- END IF
-*
-* Compute the residual vector:
-*
- IF( M.LT.N ) THEN
- NR = M + P - N
- IF( NR.GT.0 )
- $ CALL DGEMV( 'No transpose', NR, N-M, -ONE, A( N-P+1, M+1 ),
- $ LDA, D( NR+1 ), 1, ONE, C( N-P+1 ), 1 )
- ELSE
- NR = P
- END IF
- IF( NR.GT.0 ) THEN
- CALL DTRMV( 'Upper', 'No transpose', 'Non unit', NR,
- $ A( N-P+1, N-P+1 ), LDA, D, 1 )
- CALL DAXPY( NR, -ONE, D, 1, C( N-P+1 ), 1 )
- END IF
-*
-* Backward transformation x = Q**T*x
-*
- CALL DORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), X,
- $ N, WORK( P+MN+1 ), LWORK-P-MN, INFO )
- WORK( 1 ) = P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) )
-*
- RETURN
-*
-* End of DGGLSE
-*
- END
diff --git a/netlib/LAPACK/dggqrf.f b/netlib/LAPACK/dggqrf.f
deleted file mode 100644
index ea0c04c..0000000
--- a/netlib/LAPACK/dggqrf.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b DGGQRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGQRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggqrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggqrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggqrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGQRF computes a generalized QR factorization of an N-by-M matrix A
-*> and an N-by-P matrix B:
-*>
-*> A = Q*R, B = Q*T*Z,
-*>
-*> where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
-*> matrix, and R and T assume one of the forms:
-*>
-*> if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
-*> ( 0 ) N-M N M-N
-*> M
-*>
-*> where R11 is upper triangular, and
-*>
-*> if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
-*> P-N N ( T21 ) P
-*> P
-*>
-*> where T12 or T21 is upper triangular.
-*>
-*> In particular, if B is square and nonsingular, the GQR factorization
-*> of A and B implicitly gives the QR factorization of inv(B)*A:
-*>
-*> inv(B)*A = Z**T*(inv(T)*R)
-*>
-*> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the
-*> transpose of the matrix Z.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of columns of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,M)
-*> On entry, the N-by-M matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(N,M)-by-M upper trapezoidal matrix R (R is
-*> upper triangular if N >= M); the elements below the diagonal,
-*> with the array TAUA, represent the orthogonal matrix Q as a
-*> product of min(N,M) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAUA
-*> \verbatim
-*> TAUA is DOUBLE PRECISION array, dimension (min(N,M))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q (see Further Details).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,P)
-*> On entry, the N-by-P matrix B.
-*> On exit, if N <= P, the upper triangle of the subarray
-*> B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
-*> if N > P, the elements on and above the (N-P)-th subdiagonal
-*> contain the N-by-P upper trapezoidal matrix T; the remaining
-*> elements, with the array TAUB, represent the orthogonal
-*> matrix Z as a product of elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAUB
-*> \verbatim
-*> TAUB is DOUBLE PRECISION array, dimension (min(N,P))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Z (see Further Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N,M,P).
-*> For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
-*> where NB1 is the optimal blocksize for the QR factorization
-*> of an N-by-M matrix, NB2 is the optimal blocksize for the
-*> RQ factorization of an N-by-P matrix, and NB3 is the optimal
-*> blocksize for a call of DORMQR.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(n,m).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taua * v * v**T
-*>
-*> where taua is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
-*> and taua in TAUA(i).
-*> To form Q explicitly, use LAPACK subroutine DORGQR.
-*> To use Q to update another matrix, use LAPACK subroutine DORMQR.
-*>
-*> The matrix Z is represented as a product of elementary reflectors
-*>
-*> Z = H(1) H(2) . . . H(k), where k = min(n,p).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taub * v * v**T
-*>
-*> where taub is a real scalar, and v is a real vector with
-*> v(p-k+i+1:p) = 0 and v(p-k+i) = 1; v(1:p-k+i-1) is stored on exit in
-*> B(n-k+i,1:p-k+i-1), and taub in TAUB(i).
-*> To form Z explicitly, use LAPACK subroutine DORGRQ.
-*> To use Z to update another matrix, use LAPACK subroutine DORMRQ.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LOPT, LWKOPT, NB, NB1, NB2, NB3
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGERQF, DORMQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB1 = ILAENV( 1, 'DGEQRF', ' ', N, M, -1, -1 )
- NB2 = ILAENV( 1, 'DGERQF', ' ', N, P, -1, -1 )
- NB3 = ILAENV( 1, 'DORMQR', ' ', N, M, P, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LWKOPT = MAX( N, M, P )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( P.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.MAX( 1, N, M, P ) .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* QR factorization of N-by-M matrix A: A = Q*R
-*
- CALL DGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
- LOPT = WORK( 1 )
-*
-* Update B := Q**T*B.
-*
- CALL DORMQR( 'Left', 'Transpose', N, P, MIN( N, M ), A, LDA, TAUA,
- $ B, LDB, WORK, LWORK, INFO )
- LOPT = MAX( LOPT, INT( WORK( 1 ) ) )
-*
-* RQ factorization of N-by-P matrix B: B = T*Z.
-*
- CALL DGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
- WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) )
-*
- RETURN
-*
-* End of DGGQRF
-*
- END
diff --git a/netlib/LAPACK/dggrqf.f b/netlib/LAPACK/dggrqf.f
deleted file mode 100644
index 86267a1..0000000
--- a/netlib/LAPACK/dggrqf.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b DGGRQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGGRQF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggrqf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggrqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggrqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGRQF computes a generalized RQ factorization of an M-by-N matrix A
-*> and a P-by-N matrix B:
-*>
-*> A = R*Q, B = Z*T*Q,
-*>
-*> where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
-*> matrix, and R and T assume one of the forms:
-*>
-*> if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
-*> N-M M ( R21 ) N
-*> N
-*>
-*> where R12 or R21 is upper triangular, and
-*>
-*> if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
-*> ( 0 ) P-N P N-P
-*> N
-*>
-*> where T11 is upper triangular.
-*>
-*> In particular, if B is square and nonsingular, the GRQ factorization
-*> of A and B implicitly gives the RQ factorization of A*inv(B):
-*>
-*> A*inv(B) = (R*inv(T))*Z**T
-*>
-*> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the
-*> transpose of the matrix Z.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, if M <= N, the upper triangle of the subarray
-*> A(1:M,N-M+1:N) contains the M-by-M upper triangular matrix R;
-*> if M > N, the elements on and above the (M-N)-th subdiagonal
-*> contain the M-by-N upper trapezoidal matrix R; the remaining
-*> elements, with the array TAUA, represent the orthogonal
-*> matrix Q as a product of elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAUA
-*> \verbatim
-*> TAUA is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q (see Further Details).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(P,N)-by-N upper trapezoidal matrix T (T is
-*> upper triangular if P >= N); the elements below the diagonal,
-*> with the array TAUB, represent the orthogonal matrix Z as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[out] TAUB
-*> \verbatim
-*> TAUB is DOUBLE PRECISION array, dimension (min(P,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Z (see Further Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N,M,P).
-*> For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
-*> where NB1 is the optimal blocksize for the RQ factorization
-*> of an M-by-N matrix, NB2 is the optimal blocksize for the
-*> QR factorization of a P-by-N matrix, and NB3 is the optimal
-*> blocksize for a call of DORMRQ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INF0= -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taua * v * v**T
-*>
-*> where taua is a real scalar, and v is a real vector with
-*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*> A(m-k+i,1:n-k+i-1), and taua in TAUA(i).
-*> To form Q explicitly, use LAPACK subroutine DORGRQ.
-*> To use Q to update another matrix, use LAPACK subroutine DORMRQ.
-*>
-*> The matrix Z is represented as a product of elementary reflectors
-*>
-*> Z = H(1) H(2) . . . H(k), where k = min(p,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taub * v * v**T
-*>
-*> where taub is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i),
-*> and taub in TAUB(i).
-*> To form Z explicitly, use LAPACK subroutine DORGQR.
-*> To use Z to update another matrix, use LAPACK subroutine DORMQR.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LOPT, LWKOPT, NB, NB1, NB2, NB3
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQRF, DGERQF, DORMRQ, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB1 = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
- NB2 = ILAENV( 1, 'DGEQRF', ' ', P, N, -1, -1 )
- NB3 = ILAENV( 1, 'DORMRQ', ' ', M, N, P, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LWKOPT = MAX( N, M, P )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( P.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.MAX( 1, M, P, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGRQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* RQ factorization of M-by-N matrix A: A = R*Q
-*
- CALL DGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
- LOPT = WORK( 1 )
-*
-* Update B := B*Q**T
-*
- CALL DORMRQ( 'Right', 'Transpose', P, N, MIN( M, N ),
- $ A( MAX( 1, M-N+1 ), 1 ), LDA, TAUA, B, LDB, WORK,
- $ LWORK, INFO )
- LOPT = MAX( LOPT, INT( WORK( 1 ) ) )
-*
-* QR factorization of P-by-N matrix B: B = Z*T
-*
- CALL DGEQRF( P, N, B, LDB, TAUB, WORK, LWORK, INFO )
- WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) )
-*
- RETURN
-*
-* End of DGGRQF
-*
- END
diff --git a/netlib/LAPACK/dggsvd.f b/netlib/LAPACK/dggsvd.f
deleted file mode 100644
index 17dac94..0000000
--- a/netlib/LAPACK/dggsvd.f
+++ /dev/null
@@ -1,462 +0,0 @@
-*> \brief <b> DGGSVD computes the singular value decomposition (SVD) for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggsvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggsvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
-* LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBQ, JOBU, JOBV
-* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), ALPHA( * ), B( LDB, * ),
-* $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
-* $ V( LDV, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGSVD computes the generalized singular value decomposition (GSVD)
-*> of an M-by-N real matrix A and P-by-N real matrix B:
-*>
-*> U**T*A*Q = D1*( 0 R ), V**T*B*Q = D2*( 0 R )
-*>
-*> where U, V and Q are orthogonal matrices.
-*> Let K+L = the effective numerical rank of the matrix (A**T,B**T)**T,
-*> then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
-*> D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
-*> following structures, respectively:
-*>
-*> If M-K-L >= 0,
-*>
-*> K L
-*> D1 = K ( I 0 )
-*> L ( 0 C )
-*> M-K-L ( 0 0 )
-*>
-*> K L
-*> D2 = L ( 0 S )
-*> P-L ( 0 0 )
-*>
-*> N-K-L K L
-*> ( 0 R ) = K ( 0 R11 R12 )
-*> L ( 0 0 R22 )
-*>
-*> where
-*>
-*> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
-*> S = diag( BETA(K+1), ... , BETA(K+L) ),
-*> C**2 + S**2 = I.
-*>
-*> R is stored in A(1:K+L,N-K-L+1:N) on exit.
-*>
-*> If M-K-L < 0,
-*>
-*> K M-K K+L-M
-*> D1 = K ( I 0 0 )
-*> M-K ( 0 C 0 )
-*>
-*> K M-K K+L-M
-*> D2 = M-K ( 0 S 0 )
-*> K+L-M ( 0 0 I )
-*> P-L ( 0 0 0 )
-*>
-*> N-K-L K M-K K+L-M
-*> ( 0 R ) = K ( 0 R11 R12 R13 )
-*> M-K ( 0 0 R22 R23 )
-*> K+L-M ( 0 0 0 R33 )
-*>
-*> where
-*>
-*> C = diag( ALPHA(K+1), ... , ALPHA(M) ),
-*> S = diag( BETA(K+1), ... , BETA(M) ),
-*> C**2 + S**2 = I.
-*>
-*> (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
-*> ( 0 R22 R23 )
-*> in B(M-K+1:L,N+M-K-L+1:N) on exit.
-*>
-*> The routine computes C, S, R, and optionally the orthogonal
-*> transformation matrices U, V and Q.
-*>
-*> In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
-*> A and B implicitly gives the SVD of A*inv(B):
-*> A*inv(B) = U*(D1*inv(D2))*V**T.
-*> If ( A**T,B**T)**T has orthonormal columns, then the GSVD of A and B is
-*> also equal to the CS decomposition of A and B. Furthermore, the GSVD
-*> can be used to derive the solution of the eigenvalue problem:
-*> A**T*A x = lambda* B**T*B x.
-*> In some literature, the GSVD of A and B is presented in the form
-*> U**T*A*X = ( 0 D1 ), V**T*B*X = ( 0 D2 )
-*> where U and V are orthogonal and X is nonsingular, D1 and D2 are
-*> ``diagonal''. The former GSVD form can be converted to the latter
-*> form by taking the nonsingular matrix X as
-*>
-*> X = Q*( I 0 )
-*> ( 0 inv(R) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> = 'U': Orthogonal matrix U is computed;
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> = 'V': Orthogonal matrix V is computed;
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBQ
-*> \verbatim
-*> JOBQ is CHARACTER*1
-*> = 'Q': Orthogonal matrix Q is computed;
-*> = 'N': Q is not computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> \endverbatim
-*>
-*> \param[out] L
-*> \verbatim
-*> L is INTEGER
-*>
-*> On exit, K and L specify the dimension of the subblocks
-*> described in Purpose.
-*> K + L = effective numerical rank of (A**T,B**T)**T.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A contains the triangular matrix R, or part of R.
-*> See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, B contains the triangular matrix R if M-K-L < 0.
-*> See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*>
-*> On exit, ALPHA and BETA contain the generalized singular
-*> value pairs of A and B;
-*> ALPHA(1:K) = 1,
-*> BETA(1:K) = 0,
-*> and if M-K-L >= 0,
-*> ALPHA(K+1:K+L) = C,
-*> BETA(K+1:K+L) = S,
-*> or if M-K-L < 0,
-*> ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
-*> BETA(K+1:M) =S, BETA(M+1:K+L) =1
-*> and
-*> ALPHA(K+L+1:N) = 0
-*> BETA(K+L+1:N) = 0
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,M)
-*> If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
-*> If JOBU = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,M) if
-*> JOBU = 'U'; LDU >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,P)
-*> If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
-*> If JOBV = 'N', V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,P) if
-*> JOBV = 'V'; LDV >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
-*> If JOBQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N) if
-*> JOBQ = 'Q'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (max(3*N,M,P)+N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> On exit, IWORK stores the sorting information. More
-*> precisely, the following loop will sort ALPHA
-*> for I = K+1, min(M,K+L)
-*> swap ALPHA(I) and ALPHA(IWORK(I))
-*> endfor
-*> such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, the Jacobi-type procedure failed to
-*> converge. For further details, see subroutine DTGSJA.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLA DOUBLE PRECISION
-*> TOLB DOUBLE PRECISION
-*> TOLA and TOLB are the thresholds to determine the effective
-*> rank of (A',B')**T. Generally, they are set to
-*> TOLA = MAX(M,N)*norm(A)*MAZHEPS,
-*> TOLB = MAX(P,N)*norm(B)*MAZHEPS.
-*> The size of TOLA and TOLB may affect the size of backward
-*> errors of the decomposition.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERsing
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
- $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBQ, JOBU, JOBV
- INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
- $ V( LDV, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL WANTQ, WANTU, WANTV
- INTEGER I, IBND, ISUB, J, NCYCLE
- DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGGSVP, DTGSJA, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTU = LSAME( JOBU, 'U' )
- WANTV = LSAME( JOBV, 'V' )
- WANTQ = LSAME( JOBQ, 'Q' )
-*
- INFO = 0
- IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( P.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -12
- ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
- INFO = -16
- ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
- INFO = -18
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -20
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGSVD', -INFO )
- RETURN
- END IF
-*
-* Compute the Frobenius norm of matrices A and B
-*
- ANORM = DLANGE( '1', M, N, A, LDA, WORK )
- BNORM = DLANGE( '1', P, N, B, LDB, WORK )
-*
-* Get machine precision and set up threshold for determining
-* the effective numerical rank of the matrices A and B.
-*
- ULP = DLAMCH( 'Precision' )
- UNFL = DLAMCH( 'Safe Minimum' )
- TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP
- TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP
-*
-* Preprocessing
-*
- CALL DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA,
- $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK,
- $ WORK( N+1 ), INFO )
-*
-* Compute the GSVD of two upper "triangular" matrices
-*
- CALL DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, LDB,
- $ TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
- $ WORK, NCYCLE, INFO )
-*
-* Sort the singular values and store the pivot indices in IWORK
-* Copy ALPHA to WORK, then sort ALPHA in WORK
-*
- CALL DCOPY( N, ALPHA, 1, WORK, 1 )
- IBND = MIN( L, M-K )
- DO 20 I = 1, IBND
-*
-* Scan for largest ALPHA(K+I)
-*
- ISUB = I
- SMAX = WORK( K+I )
- DO 10 J = I + 1, IBND
- TEMP = WORK( K+J )
- IF( TEMP.GT.SMAX ) THEN
- ISUB = J
- SMAX = TEMP
- END IF
- 10 CONTINUE
- IF( ISUB.NE.I ) THEN
- WORK( K+ISUB ) = WORK( K+I )
- WORK( K+I ) = SMAX
- IWORK( K+I ) = K + ISUB
- ELSE
- IWORK( K+I ) = K + I
- END IF
- 20 CONTINUE
-*
- RETURN
-*
-* End of DGGSVD
-*
- END
diff --git a/netlib/LAPACK/dggsvp.f b/netlib/LAPACK/dggsvp.f
deleted file mode 100644
index 567133d..0000000
--- a/netlib/LAPACK/dggsvp.f
+++ /dev/null
@@ -1,520 +0,0 @@
-*> \brief \b DGGSVP
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggsvp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggsvp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
-* TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
-* IWORK, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBQ, JOBU, JOBV
-* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
-* DOUBLE PRECISION TOLA, TOLB
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGGSVP computes orthogonal matrices U, V and Q such that
-*>
-*> N-K-L K L
-*> U**T*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
-*> L ( 0 0 A23 )
-*> M-K-L ( 0 0 0 )
-*>
-*> N-K-L K L
-*> = K ( 0 A12 A13 ) if M-K-L < 0;
-*> M-K ( 0 0 A23 )
-*>
-*> N-K-L K L
-*> V**T*B*Q = L ( 0 0 B13 )
-*> P-L ( 0 0 0 )
-*>
-*> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
-*> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
-*> otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
-*> numerical rank of the (M+P)-by-N matrix (A**T,B**T)**T.
-*>
-*> This decomposition is the preprocessing step for computing the
-*> Generalized Singular Value Decomposition (GSVD), see subroutine
-*> DGGSVD.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> = 'U': Orthogonal matrix U is computed;
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> = 'V': Orthogonal matrix V is computed;
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBQ
-*> \verbatim
-*> JOBQ is CHARACTER*1
-*> = 'Q': Orthogonal matrix Q is computed;
-*> = 'N': Q is not computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A contains the triangular (or trapezoidal) matrix
-*> described in the Purpose section.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, B contains the triangular matrix described in
-*> the Purpose section.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[in] TOLA
-*> \verbatim
-*> TOLA is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] TOLB
-*> \verbatim
-*> TOLB is DOUBLE PRECISION
-*>
-*> TOLA and TOLB are the thresholds to determine the effective
-*> numerical rank of matrix B and a subblock of A. Generally,
-*> they are set to
-*> TOLA = MAX(M,N)*norm(A)*MACHEPS,
-*> TOLB = MAX(P,N)*norm(B)*MACHEPS.
-*> The size of TOLA and TOLB may affect the size of backward
-*> errors of the decomposition.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> \endverbatim
-*>
-*> \param[out] L
-*> \verbatim
-*> L is INTEGER
-*>
-*> On exit, K and L specify the dimension of the subblocks
-*> described in Purpose section.
-*> K + L = effective numerical rank of (A**T,B**T)**T.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,M)
-*> If JOBU = 'U', U contains the orthogonal matrix U.
-*> If JOBU = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,M) if
-*> JOBU = 'U'; LDU >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,P)
-*> If JOBV = 'V', V contains the orthogonal matrix V.
-*> If JOBV = 'N', V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,P) if
-*> JOBV = 'V'; LDV >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> If JOBQ = 'Q', Q contains the orthogonal matrix Q.
-*> If JOBQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N) if
-*> JOBQ = 'Q'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (max(3*N,M,P))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> The subroutine uses LAPACK subroutine DGEQPF for the QR factorization
-*> with column pivoting to detect the effective numerical rank of the
-*> a matrix. It may be replaced by a better rank determination strategy.
-*>
-* =====================================================================
- SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
- $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
- $ IWORK, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBQ, JOBU, JOBV
- INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
- DOUBLE PRECISION TOLA, TOLB
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL FORWRD, WANTQ, WANTU, WANTV
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQPF, DGEQR2, DGERQ2, DLACPY, DLAPMT, DLASET,
- $ DORG2R, DORM2R, DORMR2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTU = LSAME( JOBU, 'U' )
- WANTV = LSAME( JOBV, 'V' )
- WANTQ = LSAME( JOBQ, 'Q' )
- FORWRD = .TRUE.
-*
- INFO = 0
- IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( P.LT.0 ) THEN
- INFO = -5
- ELSE IF( N.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -10
- ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
- INFO = -16
- ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
- INFO = -18
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -20
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGGSVP', -INFO )
- RETURN
- END IF
-*
-* QR with column pivoting of B: B*P = V*( S11 S12 )
-* ( 0 0 )
-*
- DO 10 I = 1, N
- IWORK( I ) = 0
- 10 CONTINUE
- CALL DGEQPF( P, N, B, LDB, IWORK, TAU, WORK, INFO )
-*
-* Update A := A*P
-*
- CALL DLAPMT( FORWRD, M, N, A, LDA, IWORK )
-*
-* Determine the effective rank of matrix B.
-*
- L = 0
- DO 20 I = 1, MIN( P, N )
- IF( ABS( B( I, I ) ).GT.TOLB )
- $ L = L + 1
- 20 CONTINUE
-*
- IF( WANTV ) THEN
-*
-* Copy the details of V, and form V.
-*
- CALL DLASET( 'Full', P, P, ZERO, ZERO, V, LDV )
- IF( P.GT.1 )
- $ CALL DLACPY( 'Lower', P-1, N, B( 2, 1 ), LDB, V( 2, 1 ),
- $ LDV )
- CALL DORG2R( P, P, MIN( P, N ), V, LDV, TAU, WORK, INFO )
- END IF
-*
-* Clean up B
-*
- DO 40 J = 1, L - 1
- DO 30 I = J + 1, L
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- IF( P.GT.L )
- $ CALL DLASET( 'Full', P-L, N, ZERO, ZERO, B( L+1, 1 ), LDB )
-*
- IF( WANTQ ) THEN
-*
-* Set Q = I and Update Q := Q*P
-*
- CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
- CALL DLAPMT( FORWRD, N, N, Q, LDQ, IWORK )
- END IF
-*
- IF( P.GE.L .AND. N.NE.L ) THEN
-*
-* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z
-*
- CALL DGERQ2( L, N, B, LDB, TAU, WORK, INFO )
-*
-* Update A := A*Z**T
-*
- CALL DORMR2( 'Right', 'Transpose', M, N, L, B, LDB, TAU, A,
- $ LDA, WORK, INFO )
-*
- IF( WANTQ ) THEN
-*
-* Update Q := Q*Z**T
-*
- CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q,
- $ LDQ, WORK, INFO )
- END IF
-*
-* Clean up B
-*
- CALL DLASET( 'Full', L, N-L, ZERO, ZERO, B, LDB )
- DO 60 J = N - L + 1, N
- DO 50 I = J - N + L + 1, L
- B( I, J ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
- END IF
-*
-* Let N-L L
-* A = ( A11 A12 ) M,
-*
-* then the following does the complete QR decomposition of A11:
-*
-* A11 = U*( 0 T12 )*P1**T
-* ( 0 0 )
-*
- DO 70 I = 1, N - L
- IWORK( I ) = 0
- 70 CONTINUE
- CALL DGEQPF( M, N-L, A, LDA, IWORK, TAU, WORK, INFO )
-*
-* Determine the effective rank of A11
-*
- K = 0
- DO 80 I = 1, MIN( M, N-L )
- IF( ABS( A( I, I ) ).GT.TOLA )
- $ K = K + 1
- 80 CONTINUE
-*
-* Update A12 := U**T*A12, where A12 = A( 1:M, N-L+1:N )
-*
- CALL DORM2R( 'Left', 'Transpose', M, L, MIN( M, N-L ), A, LDA,
- $ TAU, A( 1, N-L+1 ), LDA, WORK, INFO )
-*
- IF( WANTU ) THEN
-*
-* Copy the details of U, and form U
-*
- 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 )
- END IF
-*
- IF( WANTQ ) THEN
-*
-* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1
-*
- CALL DLAPMT( FORWRD, N, N-L, Q, LDQ, IWORK )
- END IF
-*
-* Clean up A: set the strictly lower triangular part of
-* A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0.
-*
- DO 100 J = 1, K - 1
- DO 90 I = J + 1, K
- A( I, J ) = ZERO
- 90 CONTINUE
- 100 CONTINUE
- IF( M.GT.K )
- $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA )
-*
- IF( N-L.GT.K ) THEN
-*
-* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1
-*
- CALL DGERQ2( K, N-L, A, LDA, TAU, WORK, INFO )
-*
- IF( WANTQ ) THEN
-*
-* 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 )
- END IF
-*
-* Clean up A
-*
- CALL DLASET( 'Full', K, N-L-K, ZERO, ZERO, A, LDA )
- DO 120 J = N - L - K + 1, N - L
- DO 110 I = J - N + L + K + 1, K
- A( I, J ) = ZERO
- 110 CONTINUE
- 120 CONTINUE
-*
- END IF
-*
- IF( M.GT.K ) THEN
-*
-* QR factorization of A( K+1:M,N-L+1:N )
-*
- CALL DGEQR2( M-K, L, A( K+1, N-L+1 ), LDA, TAU, WORK, INFO )
-*
- IF( WANTU ) THEN
-*
-* 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 )
- END IF
-*
-* Clean up
-*
- DO 140 J = N - L + 1, N
- DO 130 I = J - N + K + L + 1, M
- A( I, J ) = ZERO
- 130 CONTINUE
- 140 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of DGGSVP
-*
- END
diff --git a/netlib/LAPACK/dgsvj0.f b/netlib/LAPACK/dgsvj0.f
deleted file mode 100644
index bc0dd50..0000000
--- a/netlib/LAPACK/dgsvj0.f
+++ /dev/null
@@ -1,1078 +0,0 @@
-*> \brief \b DGSVJ0 pre-processor for the routine sgesvj.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGSVJ0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgsvj0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgsvj0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgsvj0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
-* SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDV, LWORK, M, MV, N, NSWEEP
-* DOUBLE PRECISION EPS, SFMIN, TOL
-* CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), SVA( N ), D( N ), V( LDV, * ),
-* $ WORK( LWORK )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGSVJ0 is called from DGESVJ as a pre-processor and that is its main
-*> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but
-*> it does not check convergence (stopping criterion). Few tuning
-*> parameters (marked by [TP]) are available for the implementer.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether the output from this procedure is used
-*> to compute the matrix V:
-*> = 'V': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the N-by-N array V.
-*> (See the description of V.)
-*> = 'A': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the MV-by-N array V.
-*> (See the descriptions of MV and V.)
-*> = 'N': the Jacobi rotations are not accumulated.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A.
-*> M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, M-by-N matrix A, such that A*diag(D) represents
-*> the input matrix.
-*> On exit,
-*> A_onexit * D_onexit represents the input matrix A*diag(D)
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of D, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The array D accumulates the scaling factors from the fast scaled
-*> Jacobi rotations.
-*> On entry, A*diag(D) represents the input matrix.
-*> On exit, A_onexit*diag(D_onexit) represents the input matrix
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of A, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in,out] SVA
-*> \verbatim
-*> SVA is DOUBLE PRECISION array, dimension (N)
-*> On entry, SVA contains the Euclidean norms of the columns of
-*> the matrix A*diag(D).
-*> On exit, SVA contains the Euclidean norms of the columns of
-*> the matrix onexit*diag(D_onexit).
-*> \endverbatim
-*>
-*> \param[in] MV
-*> \verbatim
-*> MV is INTEGER
-*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then MV is not referenced.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,N)
-*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV >= 1.
-*> If JOBV = 'V', LDV .GE. N.
-*> If JOBV = 'A', LDV .GE. MV.
-*> \endverbatim
-*>
-*> \param[in] EPS
-*> \verbatim
-*> EPS is DOUBLE PRECISION
-*> EPS = DLAMCH('Epsilon')
-*> \endverbatim
-*>
-*> \param[in] SFMIN
-*> \verbatim
-*> SFMIN is DOUBLE PRECISION
-*> SFMIN = DLAMCH('Safe Minimum')
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is DOUBLE PRECISION
-*> TOL is the threshold for Jacobi rotations. For a pair
-*> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is
-*> applied only if DABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL.
-*> \endverbatim
-*>
-*> \param[in] NSWEEP
-*> \verbatim
-*> NSWEEP is INTEGER
-*> NSWEEP is the number of sweeps of Jacobi rotations to be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> LWORK is the dimension of WORK. LWORK .GE. M.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit.
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> DGSVJ0 is used just to enable DGESVJ to call a simplified version of
-*> itself to work on a submatrix of the original matrix.
-*>
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*>
-*> \par Bugs, Examples and Comments:
-* =================================
-*>
-*> Please report all bugs and send interesting test examples and comments to
-*> drmac at math.hr. Thank you.
-*
-* =====================================================================
- SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
- $ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDV, LWORK, M, MV, N, NSWEEP
- DOUBLE PRECISION EPS, SFMIN, TOL
- CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), SVA( N ), D( N ), V( LDV, * ),
- $ WORK( LWORK )
-* ..
-*
-* =====================================================================
-*
-* .. Local Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
- $ BIGTHETA, CS, MXAAPQ, MXSINJ, ROOTBIG, ROOTEPS,
- $ ROOTSFMIN, ROOTTOL, SMALL, SN, T, TEMP1, THETA,
- $ THSIGN
- INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
- $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, NBL,
- $ NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND
- LOGICAL APPLV, ROTOK, RSVEC
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION FASTR( 5 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS, DMAX1, DBLE, MIN0, DSIGN, DSQRT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DDOT, DNRM2
- INTEGER IDAMAX
- LOGICAL LSAME
- EXTERNAL IDAMAX, LSAME, DDOT, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- APPLV = LSAME( JOBV, 'A' )
- RSVEC = LSAME( JOBV, 'V' )
- IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN
- INFO = -3
- ELSE IF( LDA.LT.M ) THEN
- INFO = -5
- ELSE IF( ( RSVEC.OR.APPLV ) .AND. ( MV.LT.0 ) ) THEN
- INFO = -8
- ELSE IF( ( RSVEC.AND.( LDV.LT.N ) ).OR.
- $ ( APPLV.AND.( LDV.LT.MV ) ) ) THEN
- INFO = -10
- ELSE IF( TOL.LE.EPS ) THEN
- INFO = -13
- ELSE IF( NSWEEP.LT.0 ) THEN
- INFO = -14
- ELSE IF( LWORK.LT.M ) THEN
- INFO = -16
- ELSE
- INFO = 0
- END IF
-*
-* #:(
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGSVJ0', -INFO )
- RETURN
- END IF
-*
- IF( RSVEC ) THEN
- MVL = N
- ELSE IF( APPLV ) THEN
- MVL = MV
- END IF
- RSVEC = RSVEC .OR. APPLV
-
- ROOTEPS = DSQRT( EPS )
- ROOTSFMIN = DSQRT( SFMIN )
- SMALL = SFMIN / EPS
- BIG = ONE / SFMIN
- ROOTBIG = ONE / ROOTSFMIN
- BIGTHETA = ONE / ROOTEPS
- ROOTTOL = DSQRT( TOL )
-*
-* -#- Row-cyclic Jacobi SVD algorithm with column pivoting -#-
-*
- EMPTSW = ( N*( N-1 ) ) / 2
- NOTROT = 0
- FASTR( 1 ) = ZERO
-*
-* -#- Row-cyclic pivot strategy with de Rijk's pivoting -#-
-*
-
- SWBAND = 0
-*[TP] SWBAND is a tuning parameter. It is meaningful and effective
-* if SGESVJ is used as a computational routine in the preconditioned
-* Jacobi SVD algorithm SGESVJ. For sweeps i=1:SWBAND the procedure
-* ......
-
- KBL = MIN0( 8, N )
-*[TP] KBL is a tuning parameter that defines the tile size in the
-* tiling of the p-q loops of pivot pairs. In general, an optimal
-* value of KBL depends on the matrix dimensions and on the
-* parameters of the computer's memory.
-*
- NBL = N / KBL
- IF( ( NBL*KBL ).NE.N )NBL = NBL + 1
-
- BLSKIP = ( KBL**2 ) + 1
-*[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
-
- ROWSKIP = MIN0( 5, KBL )
-*[TP] ROWSKIP is a tuning parameter.
-
- LKAHEAD = 1
-*[TP] LKAHEAD is a tuning parameter.
- SWBAND = 0
- PSKIPPED = 0
-*
- DO 1993 i = 1, NSWEEP
-* .. go go go ...
-*
- MXAAPQ = ZERO
- MXSINJ = ZERO
- ISWROT = 0
-*
- NOTROT = 0
- PSKIPPED = 0
-*
- DO 2000 ibr = 1, NBL
-
- igl = ( ibr-1 )*KBL + 1
-*
- DO 1002 ir1 = 0, MIN0( LKAHEAD, NBL-ibr )
-*
- igl = igl + ir1*KBL
-*
- DO 2001 p = igl, MIN0( igl+KBL-1, N-1 )
-
-* .. de Rijk's pivoting
- q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- CALL DSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL DSWAP( MVL, V( 1, p ), 1,
- $ V( 1, q ), 1 )
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = D( p )
- D( p ) = D( q )
- D( q ) = TEMP1
- END IF
-*
- IF( ir1.EQ.0 ) THEN
-*
-* Column norms are periodically updated by explicit
-* norm computation.
-* Caveat:
-* Some BLAS implementations compute DNRM2(M,A(1,p),1)
-* as DSQRT(DDOT(M,A(1,p),1,A(1,p),1)), which may result in
-* overflow for ||A(:,p)||_2 > DSQRT(overflow_threshold), and
-* undeflow for ||A(:,p)||_2 < DSQRT(underflow_threshold).
-* Hence, DNRM2 cannot be trusted, not even in the case when
-* the true norm is far from the under(over)flow boundaries.
-* If properly implemented DNRM2 is available, the IF-THEN-ELSE
-* below should read "AAPP = DNRM2( M, A(1,p), 1 ) * D(p)".
-*
- IF( ( SVA( p ).LT.ROOTBIG ) .AND.
- $ ( SVA( p ).GT.ROOTSFMIN ) ) THEN
- SVA( p ) = DNRM2( M, A( 1, p ), 1 )*D( p )
- ELSE
- TEMP1 = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, TEMP1, AAPP )
- SVA( p ) = TEMP1*DSQRT( AAPP )*D( p )
- END IF
- AAPP = SVA( p )
- ELSE
- AAPP = SVA( p )
- END IF
-
-*
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2002 q = p + 1, MIN0( igl+KBL-1, N )
-*
- AAQQ = SVA( q )
-
- IF( AAQQ.GT.ZERO ) THEN
-*
- AAPP0 = AAPP
- IF( AAQQ.GE.ONE ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL DCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, D( p ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = DDOT( M, WORK, 1, A( 1, q ),
- $ 1 )*D( q ) / AAQQ
- END IF
- ELSE
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL DCOPY( M, A( 1, q ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ, D( q ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = DDOT( M, WORK, 1, A( 1, p ),
- $ 1 )*D( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( DABS( AAPQ ).GT.TOL ) THEN
-*
-* .. rotate
-* ROTATED = ROTATED + ONE
-*
- IF( ir1.EQ.0 ) THEN
- NOTROT = 0
- PSKIPPED = 0
- ISWROT = ISWROT + 1
- END IF
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*DABS( AQOAP-APOAQ )/AAPQ
-*
- IF( DABS( THETA ).GT.BIGTHETA ) THEN
-*
- T = HALF / THETA
- FASTR( 3 ) = T*D( p ) / D( q )
- FASTR( 4 ) = -T*D( q ) / D( p )
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, DABS( T ) )
-*
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -DSIGN( ONE, AAPQ )
- T = ONE / ( THETA+THSIGN*
- $ DSQRT( ONE+THETA*THETA ) )
- CS = DSQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
-*
- MXSINJ = DMAX1( MXSINJ, DABS( SN ) )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = D( p ) / D( q )
- AQOAP = D( q ) / D( p )
- IF( D( p ).GE.ONE ) THEN
- IF( D( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- D( p ) = D( p )*CS
- D( q ) = D( q )*CS
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- END IF
- ELSE
- IF( D( q ).GE.ONE ) THEN
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- ELSE
- IF( D( p ).GE.D( q ) ) THEN
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-* .. have to use modified Gram-Schmidt like transformation
- CALL DCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE, M,
- $ 1, WORK, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE, M,
- $ 1, A( 1, q ), LDA, IERR )
- TEMP1 = -AAPQ*D( p ) / D( q )
- CALL DAXPY( M, TEMP1, WORK, 1,
- $ A( 1, q ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAQQ, M,
- $ 1, A( 1, q ), LDA, IERR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q), SVA(p)
-* recompute SVA(q), SVA(p).
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = DNRM2( M, A( 1, q ), 1 )*
- $ D( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*DSQRT( AAQQ )*D( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 ).LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = DNRM2( M, A( 1, p ), 1 )*
- $ D( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*DSQRT( AAPP )*D( p )
- END IF
- SVA( p ) = AAPP
- END IF
-*
- ELSE
-* A(:,p) and A(:,q) already numerically orthogonal
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- END IF
- ELSE
-* A(:,q) is zero column
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- IF( ir1.EQ.0 )AAPP = -AAPP
- NOTROT = 0
- GO TO 2103
- END IF
-*
- 2002 CONTINUE
-* END q-LOOP
-*
- 2103 CONTINUE
-* bailed out of q-loop
-
- SVA( p ) = AAPP
-
- ELSE
- SVA( p ) = AAPP
- IF( ( ir1.EQ.0 ) .AND. ( AAPP.EQ.ZERO ) )
- $ NOTROT = NOTROT + MIN0( igl+KBL-1, N ) - p
- END IF
-*
- 2001 CONTINUE
-* end of the p-loop
-* end of doing the block ( ibr, ibr )
- 1002 CONTINUE
-* end of ir1-loop
-*
-*........................................................
-* ... go to the off diagonal blocks
-*
- igl = ( ibr-1 )*KBL + 1
-*
- DO 2010 jbc = ibr + 1, NBL
-*
- jgl = ( jbc-1 )*KBL + 1
-*
-* doing the block at ( ibr, jbc )
-*
- IJBLSK = 0
- DO 2100 p = igl, MIN0( igl+KBL-1, N )
-*
- AAPP = SVA( p )
-*
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2200 q = jgl, MIN0( jgl+KBL-1, N )
-*
- AAQQ = SVA( q )
-*
- IF( AAQQ.GT.ZERO ) THEN
- AAPP0 = AAPP
-*
-* -#- M x 2 Jacobi SVD -#-
-*
-* -#- Safe Gram matrix computation -#-
-*
- IF( AAQQ.GE.ONE ) THEN
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- ELSE
- ROTOK = ( SMALL*AAQQ ).LE.AAPP
- END IF
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL DCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, D( p ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = DDOT( M, WORK, 1, A( 1, q ),
- $ 1 )*D( q ) / AAQQ
- END IF
- ELSE
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- ELSE
- ROTOK = AAQQ.LE.( AAPP / SMALL )
- END IF
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL DCOPY( M, A( 1, q ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ, D( q ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = DDOT( M, WORK, 1, A( 1, p ),
- $ 1 )*D( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( DABS( AAPQ ).GT.TOL ) THEN
- NOTROT = 0
-* ROTATED = ROTATED + 1
- PSKIPPED = 0
- ISWROT = ISWROT + 1
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*DABS( AQOAP-APOAQ )/AAPQ
- IF( AAQQ.GT.AAPP0 )THETA = -THETA
-*
- IF( DABS( THETA ).GT.BIGTHETA ) THEN
- T = HALF / THETA
- FASTR( 3 ) = T*D( p ) / D( q )
- FASTR( 4 ) = -T*D( q ) / D( p )
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, DABS( T ) )
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -DSIGN( ONE, AAPQ )
- IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
- T = ONE / ( THETA+THSIGN*
- $ DSQRT( ONE+THETA*THETA ) )
- CS = DSQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
- MXSINJ = DMAX1( MXSINJ, DABS( SN ) )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = D( p ) / D( q )
- AQOAP = D( q ) / D( p )
- IF( D( p ).GE.ONE ) THEN
-*
- IF( D( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- D( p ) = D( p )*CS
- D( q ) = D( q )*CS
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- END IF
- ELSE
- IF( D( q ).GE.ONE ) THEN
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- ELSE
- IF( D( p ).GE.D( q ) ) THEN
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
- IF( AAPP.GT.AAQQ ) THEN
- CALL DCOPY( M, A( 1, p ), 1, WORK,
- $ 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( p ) / D( q )
- CALL DAXPY( M, TEMP1, WORK, 1,
- $ A( 1, q ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAQQ,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- ELSE
- CALL DCOPY( M, A( 1, q ), 1, WORK,
- $ 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( q ) / D( p )
- CALL DAXPY( M, TEMP1, WORK, 1,
- $ A( 1, p ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAPP,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- SVA( p ) = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- END IF
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q)
-* .. recompute SVA(q)
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = DNRM2( M, A( 1, q ), 1 )*
- $ D( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*DSQRT( AAQQ )*D( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = DNRM2( M, A( 1, p ), 1 )*
- $ D( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*DSQRT( AAPP )*D( p )
- END IF
- SVA( p ) = AAPP
- END IF
-* end of OK rotation
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND. ( IJBLSK.GE.BLSKIP ) )
- $ THEN
- SVA( p ) = AAPP
- NOTROT = 0
- GO TO 2011
- END IF
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- AAPP = -AAPP
- NOTROT = 0
- GO TO 2203
- END IF
-*
- 2200 CONTINUE
-* end of the q-loop
- 2203 CONTINUE
-*
- SVA( p ) = AAPP
-*
- ELSE
- IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
- $ MIN0( jgl+KBL-1, N ) - jgl + 1
- IF( AAPP.LT.ZERO )NOTROT = 0
- END IF
-
- 2100 CONTINUE
-* end of the p-loop
- 2010 CONTINUE
-* end of the jbc-loop
- 2011 CONTINUE
-*2011 bailed out of the jbc-loop
- DO 2012 p = igl, MIN0( igl+KBL-1, N )
- SVA( p ) = DABS( SVA( p ) )
- 2012 CONTINUE
-*
- 2000 CONTINUE
-*2000 :: end of the ibr-loop
-*
-* .. update SVA(N)
- IF( ( SVA( N ).LT.ROOTBIG ) .AND. ( SVA( N ).GT.ROOTSFMIN ) )
- $ THEN
- SVA( N ) = DNRM2( M, A( 1, N ), 1 )*D( N )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, N ), 1, T, AAPP )
- SVA( N ) = T*DSQRT( AAPP )*D( N )
- END IF
-*
-* Additional steering devices
-*
- IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
- $ ( ISWROT.LE.N ) ) )SWBAND = i
-*
- IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DBLE( N )*TOL ) .AND.
- $ ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
- GO TO 1994
- END IF
-*
- IF( NOTROT.GE.EMPTSW )GO TO 1994
-
- 1993 CONTINUE
-* end i=1:NSWEEP loop
-* #:) Reaching this point means that the procedure has comleted the given
-* number of iterations.
- INFO = NSWEEP - 1
- GO TO 1995
- 1994 CONTINUE
-* #:) Reaching this point means that during the i-th sweep all pivots were
-* below the given tolerance, causing early exit.
-*
- INFO = 0
-* #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
-*
-* Sort the vector D.
- DO 5991 p = 1, N - 1
- q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = D( p )
- D( p ) = D( q )
- D( q ) = TEMP1
- CALL DSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL DSWAP( MVL, V( 1, p ), 1, V( 1, q ), 1 )
- END IF
- 5991 CONTINUE
-*
- RETURN
-* ..
-* .. END OF DGSVJ0
-* ..
- END
diff --git a/netlib/LAPACK/dgsvj1.f b/netlib/LAPACK/dgsvj1.f
deleted file mode 100644
index 1c5efeb..0000000
--- a/netlib/LAPACK/dgsvj1.f
+++ /dev/null
@@ -1,783 +0,0 @@
-*> \brief \b DGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGSVJ1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgsvj1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgsvj1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgsvj1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
-* EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION EPS, SFMIN, TOL
-* INTEGER INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP
-* CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( N ), SVA( N ), V( LDV, * ),
-* $ WORK( LWORK )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGSVJ1 is called from SGESVJ as a pre-processor and that is its main
-*> purpose. It applies Jacobi rotations in the same way as SGESVJ does, but
-*> it targets only particular pivots and it does not check convergence
-*> (stopping criterion). Few tunning parameters (marked by [TP]) are
-*> available for the implementer.
-*>
-*> Further Details
-*> ~~~~~~~~~~~~~~~
-*> DGSVJ1 applies few sweeps of Jacobi rotations in the column space of
-*> the input M-by-N matrix A. The pivot pairs are taken from the (1,2)
-*> off-diagonal block in the corresponding N-by-N Gram matrix A^T * A. The
-*> block-entries (tiles) of the (1,2) off-diagonal block are marked by the
-*> [x]'s in the following scheme:
-*>
-*> | * * * [x] [x] [x]|
-*> | * * * [x] [x] [x]| Row-cycling in the nblr-by-nblc [x] blocks.
-*> | * * * [x] [x] [x]| Row-cyclic pivoting inside each [x] block.
-*> |[x] [x] [x] * * * |
-*> |[x] [x] [x] * * * |
-*> |[x] [x] [x] * * * |
-*>
-*> In terms of the columns of A, the first N1 columns are rotated 'against'
-*> the remaining N-N1 columns, trying to increase the angle between the
-*> corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is
-*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parmeter.
-*> The number of sweeps is given in NSWEEP and the orthogonality threshold
-*> is given in TOL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether the output from this procedure is used
-*> to compute the matrix V:
-*> = 'V': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the N-by-N array V.
-*> (See the description of V.)
-*> = 'A': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the MV-by-N array V.
-*> (See the descriptions of MV and V.)
-*> = 'N': the Jacobi rotations are not accumulated.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A.
-*> M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> N1 specifies the 2 x 2 block partition, the first N1 columns are
-*> rotated 'against' the remaining N-N1 columns of A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, M-by-N matrix A, such that A*diag(D) represents
-*> the input matrix.
-*> On exit,
-*> A_onexit * D_onexit represents the input matrix A*diag(D)
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of N1, D, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The array D accumulates the scaling factors from the fast scaled
-*> Jacobi rotations.
-*> On entry, A*diag(D) represents the input matrix.
-*> On exit, A_onexit*diag(D_onexit) represents the input matrix
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of N1, A, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in,out] SVA
-*> \verbatim
-*> SVA is DOUBLE PRECISION array, dimension (N)
-*> On entry, SVA contains the Euclidean norms of the columns of
-*> the matrix A*diag(D).
-*> On exit, SVA contains the Euclidean norms of the columns of
-*> the matrix onexit*diag(D_onexit).
-*> \endverbatim
-*>
-*> \param[in] MV
-*> \verbatim
-*> MV is INTEGER
-*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then MV is not referenced.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,N)
-*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV >= 1.
-*> If JOBV = 'V', LDV .GE. N.
-*> If JOBV = 'A', LDV .GE. MV.
-*> \endverbatim
-*>
-*> \param[in] EPS
-*> \verbatim
-*> EPS is DOUBLE PRECISION
-*> EPS = DLAMCH('Epsilon')
-*> \endverbatim
-*>
-*> \param[in] SFMIN
-*> \verbatim
-*> SFMIN is DOUBLE PRECISION
-*> SFMIN = DLAMCH('Safe Minimum')
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is DOUBLE PRECISION
-*> TOL is the threshold for Jacobi rotations. For a pair
-*> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is
-*> applied only if DABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL.
-*> \endverbatim
-*>
-*> \param[in] NSWEEP
-*> \verbatim
-*> NSWEEP is INTEGER
-*> NSWEEP is the number of sweeps of Jacobi rotations to be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> LWORK is the dimension of WORK. LWORK .GE. M.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit.
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*
-* =====================================================================
- SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
- $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION EPS, SFMIN, TOL
- INTEGER INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP
- CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( N ), SVA( N ), V( LDV, * ),
- $ WORK( LWORK )
-* ..
-*
-* =====================================================================
-*
-* .. Local Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
- $ BIGTHETA, CS, LARGE, MXAAPQ, MXSINJ, ROOTBIG,
- $ ROOTEPS, ROOTSFMIN, ROOTTOL, SMALL, SN, T,
- $ TEMP1, THETA, THSIGN
- INTEGER BLSKIP, EMPTSW, i, ibr, igl, IERR, IJBLSK,
- $ ISWROT, jbc, jgl, KBL, MVL, NOTROT, nblc, nblr,
- $ p, PSKIPPED, q, ROWSKIP, SWBAND
- LOGICAL APPLV, ROTOK, RSVEC
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION FASTR( 5 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS, DMAX1, DBLE, MIN0, DSIGN, DSQRT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DDOT, DNRM2
- INTEGER IDAMAX
- LOGICAL LSAME
- EXTERNAL IDAMAX, LSAME, DDOT, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- APPLV = LSAME( JOBV, 'A' )
- RSVEC = LSAME( JOBV, 'V' )
- IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN
- INFO = -3
- ELSE IF( N1.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.M ) THEN
- INFO = -6
- ELSE IF( ( RSVEC.OR.APPLV ) .AND. ( MV.LT.0 ) ) THEN
- INFO = -9
- ELSE IF( ( RSVEC.AND.( LDV.LT.N ) ).OR.
- $ ( APPLV.AND.( LDV.LT.MV ) ) ) THEN
- INFO = -11
- ELSE IF( TOL.LE.EPS ) THEN
- INFO = -14
- ELSE IF( NSWEEP.LT.0 ) THEN
- INFO = -15
- ELSE IF( LWORK.LT.M ) THEN
- INFO = -17
- ELSE
- INFO = 0
- END IF
-*
-* #:(
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGSVJ1', -INFO )
- RETURN
- END IF
-*
- IF( RSVEC ) THEN
- MVL = N
- ELSE IF( APPLV ) THEN
- MVL = MV
- END IF
- RSVEC = RSVEC .OR. APPLV
-
- ROOTEPS = DSQRT( EPS )
- ROOTSFMIN = DSQRT( SFMIN )
- SMALL = SFMIN / EPS
- BIG = ONE / SFMIN
- ROOTBIG = ONE / ROOTSFMIN
- LARGE = BIG / DSQRT( DBLE( M*N ) )
- BIGTHETA = ONE / ROOTEPS
- ROOTTOL = DSQRT( TOL )
-*
-* .. Initialize the right singular vector matrix ..
-*
-* RSVEC = LSAME( JOBV, 'Y' )
-*
- EMPTSW = N1*( N-N1 )
- NOTROT = 0
- FASTR( 1 ) = ZERO
-*
-* .. Row-cyclic pivot strategy with de Rijk's pivoting ..
-*
- KBL = MIN0( 8, N )
- NBLR = N1 / KBL
- IF( ( NBLR*KBL ).NE.N1 )NBLR = NBLR + 1
-
-* .. the tiling is nblr-by-nblc [tiles]
-
- NBLC = ( N-N1 ) / KBL
- IF( ( NBLC*KBL ).NE.( N-N1 ) )NBLC = NBLC + 1
- BLSKIP = ( KBL**2 ) + 1
-*[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
-
- ROWSKIP = MIN0( 5, KBL )
-*[TP] ROWSKIP is a tuning parameter.
- SWBAND = 0
-*[TP] SWBAND is a tuning parameter. It is meaningful and effective
-* if SGESVJ is used as a computational routine in the preconditioned
-* Jacobi SVD algorithm SGESVJ.
-*
-*
-* | * * * [x] [x] [x]|
-* | * * * [x] [x] [x]| Row-cycling in the nblr-by-nblc [x] blocks.
-* | * * * [x] [x] [x]| Row-cyclic pivoting inside each [x] block.
-* |[x] [x] [x] * * * |
-* |[x] [x] [x] * * * |
-* |[x] [x] [x] * * * |
-*
-*
- DO 1993 i = 1, NSWEEP
-* .. go go go ...
-*
- MXAAPQ = ZERO
- MXSINJ = ZERO
- ISWROT = 0
-*
- NOTROT = 0
- PSKIPPED = 0
-*
- DO 2000 ibr = 1, NBLR
-
- igl = ( ibr-1 )*KBL + 1
-*
-*
-*........................................................
-* ... go to the off diagonal blocks
-
- igl = ( ibr-1 )*KBL + 1
-
- DO 2010 jbc = 1, NBLC
-
- jgl = N1 + ( jbc-1 )*KBL + 1
-
-* doing the block at ( ibr, jbc )
-
- IJBLSK = 0
- DO 2100 p = igl, MIN0( igl+KBL-1, N1 )
-
- AAPP = SVA( p )
-
- IF( AAPP.GT.ZERO ) THEN
-
- PSKIPPED = 0
-
- DO 2200 q = jgl, MIN0( jgl+KBL-1, N )
-*
- AAQQ = SVA( q )
-
- IF( AAQQ.GT.ZERO ) THEN
- AAPP0 = AAPP
-*
-* .. M x 2 Jacobi SVD ..
-*
-* .. Safe Gram matrix computation ..
-*
- IF( AAQQ.GE.ONE ) THEN
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- ELSE
- ROTOK = ( SMALL*AAQQ ).LE.AAPP
- END IF
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL DCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, D( p ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = DDOT( M, WORK, 1, A( 1, q ),
- $ 1 )*D( q ) / AAQQ
- END IF
- ELSE
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- ELSE
- ROTOK = AAQQ.LE.( AAPP / SMALL )
- END IF
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL DCOPY( M, A( 1, q ), 1, WORK, 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ, D( q ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = DDOT( M, WORK, 1, A( 1, p ),
- $ 1 )*D( p ) / AAPP
- END IF
- END IF
-
- MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) )
-
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( DABS( AAPQ ).GT.TOL ) THEN
- NOTROT = 0
-* ROTATED = ROTATED + 1
- PSKIPPED = 0
- ISWROT = ISWROT + 1
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*DABS(AQOAP-APOAQ) / AAPQ
- IF( AAQQ.GT.AAPP0 )THETA = -THETA
-
- IF( DABS( THETA ).GT.BIGTHETA ) THEN
- T = HALF / THETA
- FASTR( 3 ) = T*D( p ) / D( q )
- FASTR( 4 ) = -T*D( q ) / D( p )
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, DABS( T ) )
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -DSIGN( ONE, AAPQ )
- IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
- T = ONE / ( THETA+THSIGN*
- $ DSQRT( ONE+THETA*THETA ) )
- CS = DSQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
- MXSINJ = DMAX1( MXSINJ, DABS( SN ) )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-
- APOAQ = D( p ) / D( q )
- AQOAP = D( q ) / D( p )
- IF( D( p ).GE.ONE ) THEN
-*
- IF( D( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- D( p ) = D( p )*CS
- D( q ) = D( q )*CS
- CALL DROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL DROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- END IF
- ELSE
- IF( D( q ).GE.ONE ) THEN
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- IF( RSVEC ) THEN
- CALL DAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- ELSE
- IF( D( p ).GE.D( q ) ) THEN
- CALL DAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL DAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL DAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL DAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL DAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL DAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL DAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-
- ELSE
- IF( AAPP.GT.AAQQ ) THEN
- CALL DCOPY( M, A( 1, p ), 1, WORK,
- $ 1 )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( p ) / D( q )
- CALL DAXPY( M, TEMP1, WORK, 1,
- $ A( 1, q ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAQQ,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- ELSE
- CALL DCOPY( M, A( 1, q ), 1, WORK,
- $ 1 )
- CALL DLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL DLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( q ) / D( p )
- CALL DAXPY( M, TEMP1, WORK, 1,
- $ A( 1, p ), 1 )
- CALL DLASCL( 'G', 0, 0, ONE, AAPP,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- SVA( p ) = AAPP*DSQRT( DMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = DMAX1( MXSINJ, SFMIN )
- END IF
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q)
-* .. recompute SVA(q)
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = DNRM2( M, A( 1, q ), 1 )*
- $ D( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL DLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*DSQRT( AAQQ )*D( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = DNRM2( M, A( 1, p ), 1 )*
- $ D( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*DSQRT( AAPP )*D( p )
- END IF
- SVA( p ) = AAPP
- END IF
-* end of OK rotation
- ELSE
- NOTROT = NOTROT + 1
-* SKIPPED = SKIPPED + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
-
-* IF ( NOTROT .GE. EMPTSW ) GO TO 2011
- IF( ( i.LE.SWBAND ) .AND. ( IJBLSK.GE.BLSKIP ) )
- $ THEN
- SVA( p ) = AAPP
- NOTROT = 0
- GO TO 2011
- END IF
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- AAPP = -AAPP
- NOTROT = 0
- GO TO 2203
- END IF
-
-*
- 2200 CONTINUE
-* end of the q-loop
- 2203 CONTINUE
-
- SVA( p ) = AAPP
-*
- ELSE
- IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
- $ MIN0( jgl+KBL-1, N ) - jgl + 1
- IF( AAPP.LT.ZERO )NOTROT = 0
-*** IF ( NOTROT .GE. EMPTSW ) GO TO 2011
- END IF
-
- 2100 CONTINUE
-* end of the p-loop
- 2010 CONTINUE
-* end of the jbc-loop
- 2011 CONTINUE
-*2011 bailed out of the jbc-loop
- DO 2012 p = igl, MIN0( igl+KBL-1, N )
- SVA( p ) = DABS( SVA( p ) )
- 2012 CONTINUE
-*** IF ( NOTROT .GE. EMPTSW ) GO TO 1994
- 2000 CONTINUE
-*2000 :: end of the ibr-loop
-*
-* .. update SVA(N)
- IF( ( SVA( N ).LT.ROOTBIG ) .AND. ( SVA( N ).GT.ROOTSFMIN ) )
- $ THEN
- SVA( N ) = DNRM2( M, A( 1, N ), 1 )*D( N )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL DLASSQ( M, A( 1, N ), 1, T, AAPP )
- SVA( N ) = T*DSQRT( AAPP )*D( N )
- END IF
-*
-* Additional steering devices
-*
- IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
- $ ( ISWROT.LE.N ) ) )SWBAND = i
-
- IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DBLE( N )*TOL ) .AND.
- $ ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
- GO TO 1994
- END IF
-
-*
- IF( NOTROT.GE.EMPTSW )GO TO 1994
-
- 1993 CONTINUE
-* end i=1:NSWEEP loop
-* #:) Reaching this point means that the procedure has completed the given
-* number of sweeps.
- INFO = NSWEEP - 1
- GO TO 1995
- 1994 CONTINUE
-* #:) Reaching this point means that during the i-th sweep all pivots were
-* below the given threshold, causing early exit.
-
- INFO = 0
-* #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
-*
-* Sort the vector D
-*
- DO 5991 p = 1, N - 1
- q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = D( p )
- D( p ) = D( q )
- D( q ) = TEMP1
- CALL DSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL DSWAP( MVL, V( 1, p ), 1, V( 1, q ), 1 )
- END IF
- 5991 CONTINUE
-*
- RETURN
-* ..
-* .. END OF DGSVJ1
-* ..
- END
diff --git a/netlib/LAPACK/dgtcon.f b/netlib/LAPACK/dgtcon.f
deleted file mode 100644
index 8dca24f..0000000
--- a/netlib/LAPACK/dgtcon.f
+++ /dev/null
@@ -1,255 +0,0 @@
-*> \brief \b DGTCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTCON estimates the reciprocal of the condition number of a real
-*> tridiagonal matrix A using the LU factorization as computed by
-*> DGTTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A as computed by DGTTRF.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTcomputational
-*
-* =====================================================================
- SUBROUTINE DGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ONENRM
- INTEGER I, KASE, KASE1
- DOUBLE PRECISION AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGTTRS, DLACN2, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that D(1:N) is non-zero.
-*
- DO 10 I = 1, N
- IF( D( I ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
-*
- AINVNM = ZERO
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 20 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(U)*inv(L).
-*
- CALL DGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
- $ WORK, N, INFO )
- ELSE
-*
-* Multiply by inv(L**T)*inv(U**T).
-*
- CALL DGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK,
- $ N, INFO )
- END IF
- GO TO 20
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of DGTCON
-*
- END
diff --git a/netlib/LAPACK/dgtrfs.f b/netlib/LAPACK/dgtrfs.f
deleted file mode 100644
index 9c27fb2..0000000
--- a/netlib/LAPACK/dgtrfs.f
+++ /dev/null
@@ -1,474 +0,0 @@
-*> \brief \b DGTRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
-* IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is tridiagonal, and provides
-*> error bounds and backward error estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) superdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DLF
-*> \verbatim
-*> DLF is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A as computed by DGTTRF.
-*> \endverbatim
-*>
-*> \param[in] DF
-*> \verbatim
-*> DF is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DUF
-*> \verbatim
-*> DUF is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DGTTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTcomputational
-*
-* =====================================================================
- SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
- $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANSN, TRANST
- INTEGER COUNT, I, J, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGTTRS, DLACN2, DLAGTM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -15
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANSN = 'N'
- TRANST = 'T'
- ELSE
- TRANSN = 'T'
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = 4
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 110 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE,
- $ WORK( N+1 ), N )
-*
-* Compute abs(op(A))*abs(x) + abs(b) for use in the backward
-* error bound.
-*
- IF( NOTRAN ) THEN
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) )
- ELSE
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) ) +
- $ ABS( DU( 1 )*X( 2, J ) )
- DO 30 I = 2, N - 1
- WORK( I ) = ABS( B( I, J ) ) +
- $ ABS( DL( I-1 )*X( I-1, J ) ) +
- $ ABS( D( I )*X( I, J ) ) +
- $ ABS( DU( I )*X( I+1, J ) )
- 30 CONTINUE
- WORK( N ) = ABS( B( N, J ) ) +
- $ ABS( DL( N-1 )*X( N-1, J ) ) +
- $ ABS( D( N )*X( N, J ) )
- END IF
- ELSE
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) )
- ELSE
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) ) +
- $ ABS( DL( 1 )*X( 2, J ) )
- DO 40 I = 2, N - 1
- WORK( I ) = ABS( B( I, J ) ) +
- $ ABS( DU( I-1 )*X( I-1, J ) ) +
- $ ABS( D( I )*X( I, J ) ) +
- $ ABS( DL( I )*X( I+1, J ) )
- 40 CONTINUE
- WORK( N ) = ABS( B( N, J ) ) +
- $ ABS( DU( N-1 )*X( N-1, J ) ) +
- $ ABS( D( N )*X( N, J ) )
- END IF
- END IF
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- S = ZERO
- DO 50 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 50 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 60 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 60 CONTINUE
-*
- KASE = 0
- 70 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- DO 80 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 80 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 90 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 90 CONTINUE
- CALL DGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- END IF
- GO TO 70
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 100 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 100 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 110 CONTINUE
-*
- RETURN
-*
-* End of DGTRFS
-*
- END
diff --git a/netlib/LAPACK/dgtsv.f b/netlib/LAPACK/dgtsv.f
deleted file mode 100644
index ff344d9..0000000
--- a/netlib/LAPACK/dgtsv.f
+++ /dev/null
@@ -1,333 +0,0 @@
-*> \brief <b> DGTSV computes the solution to system of linear equations A * X = B for GT matrices <b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTSV solves the equation
-*>
-*> A*X = B,
-*>
-*> where A is an n by n tridiagonal matrix, by Gaussian elimination with
-*> partial pivoting.
-*>
-*> Note that the equation A**T*X = B may be solved by interchanging the
-*> order of the arguments DU and DL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-2) elements of the
-*> second super-diagonal of the upper triangular matrix U from
-*> the LU factorization of A, in DL(1), ..., DL(n-2).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of U.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N by NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N by NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero, and the solution
-*> has not been computed. The factorization has not been
-*> completed unless i = N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTsolve
-*
-* =====================================================================
- SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION FACT, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTSV ', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( NRHS.EQ.1 ) THEN
- DO 10 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
- ELSE
- INFO = I
- RETURN
- END IF
- DL( I ) = ZERO
- ELSE
-*
-* Interchange rows I and I+1
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DL( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DL( I )
- DU( I ) = TEMP
- TEMP = B( I, 1 )
- B( I, 1 ) = B( I+1, 1 )
- B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
- END IF
- 10 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
- ELSE
- INFO = I
- RETURN
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DU( I ) = TEMP
- TEMP = B( I, 1 )
- B( I, 1 ) = B( I+1, 1 )
- B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
- END IF
- END IF
- IF( D( N ).EQ.ZERO ) THEN
- INFO = N
- RETURN
- END IF
- ELSE
- DO 40 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- DO 20 J = 1, NRHS
- B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
- 20 CONTINUE
- ELSE
- INFO = I
- RETURN
- END IF
- DL( I ) = ZERO
- ELSE
-*
-* Interchange rows I and I+1
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DL( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DL( I )
- DU( I ) = TEMP
- DO 30 J = 1, NRHS
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - FACT*B( I+1, J )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- DO 50 J = 1, NRHS
- B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
- 50 CONTINUE
- ELSE
- INFO = I
- RETURN
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DU( I ) = TEMP
- DO 60 J = 1, NRHS
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - FACT*B( I+1, J )
- 60 CONTINUE
- END IF
- END IF
- IF( D( N ).EQ.ZERO ) THEN
- INFO = N
- RETURN
- END IF
- END IF
-*
-* Back solve with the matrix U from the factorization.
-*
- IF( NRHS.LE.2 ) THEN
- J = 1
- 70 CONTINUE
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
- DO 80 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
- $ B( I+2, J ) ) / D( I )
- 80 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
- ELSE
- DO 100 J = 1, NRHS
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 90 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
- $ B( I+2, J ) ) / D( I )
- 90 CONTINUE
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DGTSV
-*
- END
diff --git a/netlib/LAPACK/dgtsvx.f b/netlib/LAPACK/dgtsvx.f
deleted file mode 100644
index 1dd8210..0000000
--- a/netlib/LAPACK/dgtsvx.f
+++ /dev/null
@@ -1,414 +0,0 @@
-*> \brief <b> DGTSVX computes the solution to system of linear equations A * X = B for GT matrices <b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
-* DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, TRANS
-* INTEGER INFO, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTSVX uses the LU factorization to compute the solution to a real
-*> system of linear equations A * X = B or A**T * X = B,
-*> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
-*> matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
-*> as A = L * U, where L is a product of permutation and unit lower
-*> bidiagonal matrices and U is upper triangular with nonzeros in
-*> only the main diagonal and first two superdiagonals.
-*>
-*> 2. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
-*> form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
-*> will not be modified.
-*> = 'N': The matrix will be copied to DLF, DF, and DUF
-*> and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) superdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in,out] DLF
-*> \verbatim
-*> DLF is DOUBLE PRECISION array, dimension (N-1)
-*> If FACT = 'F', then DLF is an input argument and on entry
-*> contains the (n-1) multipliers that define the matrix L from
-*> the LU factorization of A as computed by DGTTRF.
-*>
-*> If FACT = 'N', then DLF is an output argument and on exit
-*> contains the (n-1) multipliers that define the matrix L from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DF
-*> \verbatim
-*> DF is DOUBLE PRECISION array, dimension (N)
-*> If FACT = 'F', then DF is an input argument and on entry
-*> contains the n diagonal elements of the upper triangular
-*> matrix U from the LU factorization of A.
-*>
-*> If FACT = 'N', then DF is an output argument and on exit
-*> contains the n diagonal elements of the upper triangular
-*> matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DUF
-*> \verbatim
-*> DUF is DOUBLE PRECISION array, dimension (N-1)
-*> If FACT = 'F', then DUF is an input argument and on entry
-*> contains the (n-1) elements of the first superdiagonal of U.
-*>
-*> If FACT = 'N', then DUF is an output argument and on exit
-*> contains the (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in,out] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> If FACT = 'F', then DU2 is an input argument and on entry
-*> contains the (n-2) elements of the second superdiagonal of
-*> U.
-*>
-*> If FACT = 'N', then DU2 is an output argument and on exit
-*> contains the (n-2) elements of the second superdiagonal of
-*> U.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the LU factorization of A as
-*> computed by DGTTRF.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the LU factorization of A;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
-*> a row interchange was not required.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization
-*> has not been completed unless i = N, but the
-*> factor U is exactly singular, so the solution
-*> and error bounds could not be computed.
-*> RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTsolve
-*
-* =====================================================================
- SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
- $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, TRANS
- INTEGER INFO, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT, NOTRAN
- CHARACTER NORM
- DOUBLE PRECISION ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGT
- EXTERNAL LSAME, DLAMCH, DLANGT
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGTCON, DGTRFS, DGTTRF, DGTTRS, DLACPY,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the LU factorization of A.
-*
- CALL DCOPY( N, D, 1, DF, 1 )
- IF( N.GT.1 ) THEN
- CALL DCOPY( N-1, DL, 1, DLF, 1 )
- CALL DCOPY( N-1, DU, 1, DUF, 1 )
- END IF
- CALL DGTTRF( N, DLF, DF, DUF, DU2, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = DLANGT( NORM, N, DL, D, DU )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DGTTRS( TRANS, N, NRHS, DLF, DF, DUF, DU2, IPIV, X, LDX,
- $ INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV,
- $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DGTSVX
-*
- END
diff --git a/netlib/LAPACK/dgttrf.f b/netlib/LAPACK/dgttrf.f
deleted file mode 100644
index e742b88..0000000
--- a/netlib/LAPACK/dgttrf.f
+++ /dev/null
@@ -1,237 +0,0 @@
-*> \brief \b DGTTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgttrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgttrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgttrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTTRF computes an LU factorization of a real tridiagonal matrix A
-*> using elimination with partial pivoting and row interchanges.
-*>
-*> The factorization has the form
-*> A = L * U
-*> where L is a product of permutation and unit lower bidiagonal
-*> matrices and U is upper triangular with nonzeros in only the main
-*> diagonal and first two superdiagonals.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-1) multipliers that
-*> define the matrix L from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of the
-*> upper triangular matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> On exit, DU2 is overwritten by the (n-2) elements of the
-*> second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTcomputational
-*
-* =====================================================================
- SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION FACT, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DGTTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize IPIV(i) = i and DU2(I) = 0
-*
- DO 10 I = 1, N
- IPIV( I ) = I
- 10 CONTINUE
- DO 20 I = 1, N - 2
- DU2( I ) = ZERO
- 20 CONTINUE
-*
- DO 30 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required, eliminate DL(I)
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
-*
-* Interchange rows I and I+1, eliminate DL(I)
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- DU2( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DU( I+1 )
- IPIV( I ) = I + 1
- END IF
- 30 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- IPIV( I ) = I + 1
- END IF
- END IF
-*
-* Check for a zero on the diagonal of U.
-*
- DO 40 I = 1, N
- IF( D( I ).EQ.ZERO ) THEN
- INFO = I
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of DGTTRF
-*
- END
diff --git a/netlib/LAPACK/dgttrs.f b/netlib/LAPACK/dgttrs.f
deleted file mode 100644
index 4d8fc04..0000000
--- a/netlib/LAPACK/dgttrs.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief \b DGTTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgttrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgttrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgttrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTTRS solves one of the systems of equations
-*> A*X = B or A**T*X = B,
-*> with a tridiagonal matrix A using the LU factorization computed
-*> by DGTTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTcomputational
-*
-* =====================================================================
- SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER ITRANS, J, JB, NB
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGTTS2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
- IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
- $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Decode TRANS
-*
- IF( NOTRAN ) THEN
- ITRANS = 0
- ELSE
- ITRANS = 1
- END IF
-*
-* Determine the number of right-hand sides to solve at a time.
-*
- IF( NRHS.EQ.1 ) THEN
- NB = 1
- ELSE
- NB = MAX( 1, ILAENV( 1, 'DGTTRS', TRANS, N, NRHS, -1, -1 ) )
- END IF
-*
- IF( NB.GE.NRHS ) THEN
- CALL DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
- ELSE
- DO 10 J = 1, NRHS, NB
- JB = MIN( NRHS-J+1, NB )
- CALL DGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
- $ LDB )
- 10 CONTINUE
- END IF
-*
-* End of DGTTRS
-*
- END
diff --git a/netlib/LAPACK/dgtts2.f b/netlib/LAPACK/dgtts2.f
deleted file mode 100644
index c313a75..0000000
--- a/netlib/LAPACK/dgtts2.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b DGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTTS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtts2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtts2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtts2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* .. Scalar Arguments ..
-* INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGTTS2 solves one of the systems of equations
-*> A*X = B or A**T*X = B,
-*> with a tridiagonal matrix A using the LU factorization computed
-*> by DGTTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITRANS
-*> \verbatim
-*> ITRANS is INTEGER
-*> Specifies the form of the system of equations.
-*> = 0: A * X = B (No transpose)
-*> = 1: A**T* X = B (Transpose)
-*> = 2: A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGTcomputational
-*
-* =====================================================================
- SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IP, J
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( ITRANS.EQ.0 ) THEN
-*
-* Solve A*X = B using the LU factorization of A,
-* overwriting each right hand side vector with its solution.
-*
- IF( NRHS.LE.1 ) THEN
- J = 1
- 10 CONTINUE
-*
-* Solve L*x = b.
-*
- DO 20 I = 1, N - 1
- IP = IPIV( I )
- TEMP = B( I+1-IP+I, J ) - DL( I )*B( IP, J )
- B( I, J ) = B( IP, J )
- B( I+1, J ) = TEMP
- 20 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 30 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 30 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 10
- END IF
- ELSE
- DO 60 J = 1, NRHS
-*
-* Solve L*x = b.
-*
- DO 40 I = 1, N - 1
- IF( IPIV( I ).EQ.I ) THEN
- B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
- ELSE
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - DL( I )*B( I, J )
- END IF
- 40 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 50 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- ELSE
-*
-* Solve A**T * X = B.
-*
- IF( NRHS.LE.1 ) THEN
-*
-* Solve U**T*x = b.
-*
- J = 1
- 70 CONTINUE
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 80 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
- $ B( I-2, J ) ) / D( I )
- 80 CONTINUE
-*
-* Solve L**T*x = b.
-*
- DO 90 I = N - 1, 1, -1
- IP = IPIV( I )
- TEMP = B( I, J ) - DL( I )*B( I+1, J )
- B( I, J ) = B( IP, J )
- B( IP, J ) = TEMP
- 90 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
-*
- ELSE
- DO 120 J = 1, NRHS
-*
-* Solve U**T*x = b.
-*
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 100 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
- $ DU2( I-2 )*B( I-2, J ) ) / D( I )
- 100 CONTINUE
- DO 110 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DL( I )*TEMP
- B( I, J ) = TEMP
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- END IF
-*
-* End of DGTTS2
-*
- END
diff --git a/netlib/LAPACK/dhgeqz.f b/netlib/LAPACK/dhgeqz.f
deleted file mode 100644
index f6989aa..0000000
--- a/netlib/LAPACK/dhgeqz.f
+++ /dev/null
@@ -1,1357 +0,0 @@
-*> \brief \b DHGEQZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DHGEQZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dhgeqz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dhgeqz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dhgeqz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
-* ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, COMPZ, JOB
-* INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION ALPHAI( * ), ALPHAR( * ), BETA( * ),
-* $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DHGEQZ computes the eigenvalues of a real matrix pair (H,T),
-*> where H is an upper Hessenberg matrix and T is upper triangular,
-*> using the double-shift QZ method.
-*> Matrix pairs of this type are produced by the reduction to
-*> generalized upper Hessenberg form of a real matrix pair (A,B):
-*>
-*> A = Q1*H*Z1**T, B = Q1*T*Z1**T,
-*>
-*> as computed by DGGHRD.
-*>
-*> If JOB='S', then the Hessenberg-triangular pair (H,T) is
-*> also reduced to generalized Schur form,
-*>
-*> H = Q*S*Z**T, T = Q*P*Z**T,
-*>
-*> where Q and Z are orthogonal matrices, P is an upper triangular
-*> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
-*> diagonal blocks.
-*>
-*> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
-*> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
-*> eigenvalues.
-*>
-*> Additionally, the 2-by-2 upper triangular diagonal blocks of P
-*> corresponding to 2-by-2 blocks of S are reduced to positive diagonal
-*> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
-*> P(j,j) > 0, and P(j+1,j+1) > 0.
-*>
-*> Optionally, the orthogonal matrix Q from the generalized Schur
-*> factorization may be postmultiplied into an input matrix Q1, and the
-*> orthogonal matrix Z may be postmultiplied into an input matrix Z1.
-*> If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced
-*> the matrix pair (A,B) to generalized upper Hessenberg form, then the
-*> output matrices Q1*Q and Z1*Z are the orthogonal factors from the
-*> generalized Schur factorization of (A,B):
-*>
-*> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
-*>
-*> To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
-*> of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
-*> complex and beta real.
-*> If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
-*> generalized nonsymmetric eigenvalue problem (GNEP)
-*> A*x = lambda*B*x
-*> and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
-*> alternate form of the GNEP
-*> mu*A*y = B*y.
-*> Real eigenvalues can be read directly from the generalized Schur
-*> form:
-*> alpha = S(i,i), beta = P(i,i).
-*>
-*> Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
-*> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
-*> pp. 241--256.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> = 'E': Compute eigenvalues only;
-*> = 'S': Compute eigenvalues and the Schur form.
-*> \endverbatim
-*>
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'N': Left Schur vectors (Q) are not computed;
-*> = 'I': Q is initialized to the unit matrix and the matrix Q
-*> of left Schur vectors of (H,T) is returned;
-*> = 'V': Q must contain an orthogonal matrix Q1 on entry and
-*> the product Q1*Q is returned.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Right Schur vectors (Z) are not computed;
-*> = 'I': Z is initialized to the unit matrix and the matrix Z
-*> of right Schur vectors of (H,T) is returned;
-*> = 'V': Z must contain an orthogonal matrix Z1 on entry and
-*> the product Z1*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices H, T, Q, and Z. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI mark the rows and columns of H which are in
-*> Hessenberg form. It is assumed that A is already upper
-*> triangular in rows and columns 1:ILO-1 and IHI+1:N.
-*> If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH, N)
-*> On entry, the N-by-N upper Hessenberg matrix H.
-*> On exit, if JOB = 'S', H contains the upper quasi-triangular
-*> matrix S from the generalized Schur factorization.
-*> If JOB = 'E', the diagonal blocks of H match those of S, but
-*> the rest of H is unspecified.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT, N)
-*> On entry, the N-by-N upper triangular matrix T.
-*> On exit, if JOB = 'S', T contains the upper triangular
-*> matrix P from the generalized Schur factorization;
-*> 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
-*> are reduced to positive diagonal form, i.e., if H(j+1,j) is
-*> non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
-*> T(j+1,j+1) > 0.
-*> If JOB = 'E', the diagonal blocks of T match those of P, but
-*> the rest of T is unspecified.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> The real parts of each scalar alpha defining an eigenvalue
-*> of GNEP.
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> The imaginary parts of each scalar alpha defining an
-*> eigenvalue of GNEP.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*> The scalars beta that define the eigenvalues of GNEP.
-*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*> beta = BETA(j) represent the j-th eigenvalue of the matrix
-*> pair (A,B), in one of the forms lambda = alpha/beta or
-*> mu = beta/alpha. Since either lambda or mu may overflow,
-*> they should not, in general, be computed.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
-*> the reduction of (A,B) to generalized Hessenberg form.
-*> On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
-*> vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
-*> of left Schur vectors of (A,B).
-*> Not referenced if COMPZ = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1.
-*> If COMPQ='V' or 'I', then LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
-*> the reduction of (A,B) to generalized Hessenberg form.
-*> On exit, if COMPZ = 'I', the orthogonal matrix of
-*> right Schur vectors of (H,T), and if COMPZ = 'V', the
-*> orthogonal matrix of right Schur vectors of (A,B).
-*> Not referenced if COMPZ = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If COMPZ='V' or 'I', then LDZ >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1,...,N: the QZ iteration did not converge. (H,T) is not
-*> in Schur form, but ALPHAR(i), ALPHAI(i), and
-*> BETA(i), i=INFO+1,...,N should be correct.
-*> = N+1,...,2*N: the shift calculation failed. (H,T) is not
-*> in Schur form, but ALPHAR(i), ALPHAI(i), and
-*> BETA(i), i=INFO-N+1,...,N should be correct.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Iteration counters:
-*>
-*> JITER -- counts iterations.
-*> IITER -- counts iterations run since ILAST was last
-*> changed. This is therefore reset only when a 1-by-1 or
-*> 2-by-2 block deflates off the bottom.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
- $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION ALPHAI( * ), ALPHAR( * ), BETA( * ),
- $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* $ SAFETY = 1.0E+0 )
- DOUBLE PRECISION HALF, ZERO, ONE, SAFETY
- PARAMETER ( HALF = 0.5D+0, ZERO = 0.0D+0, ONE = 1.0D+0,
- $ SAFETY = 1.0D+2 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ,
- $ LQUERY
- INTEGER ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
- $ ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
- $ JR, MAXIT
- DOUBLE PRECISION A11, A12, A1I, A1R, A21, A22, A2I, A2R, AD11,
- $ AD11L, AD12, AD12L, AD21, AD21L, AD22, AD22L,
- $ AD32L, AN, ANORM, ASCALE, ATOL, B11, B1A, B1I,
- $ B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
- $ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
- $ CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
- $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T1,
- $ TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
- $ U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
- $ WR2
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION V( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANHS, DLAPY2, DLAPY3
- EXTERNAL LSAME, DLAMCH, DLANHS, DLAPY2, DLAPY3
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAG2, DLARFG, DLARTG, DLASET, DLASV2, DROT,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode JOB, COMPQ, COMPZ
-*
- IF( LSAME( JOB, 'E' ) ) THEN
- ILSCHR = .FALSE.
- ISCHUR = 1
- ELSE IF( LSAME( JOB, 'S' ) ) THEN
- ILSCHR = .TRUE.
- ISCHUR = 2
- ELSE
- ISCHUR = 0
- END IF
-*
- IF( LSAME( COMPQ, 'N' ) ) THEN
- ILQ = .FALSE.
- ICOMPQ = 1
- ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 2
- ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 3
- ELSE
- ICOMPQ = 0
- END IF
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ILZ = .FALSE.
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 2
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 3
- ELSE
- ICOMPZ = 0
- END IF
-*
-* Check Argument Values
-*
- INFO = 0
- WORK( 1 ) = MAX( 1, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( ISCHUR.EQ.0 ) THEN
- INFO = -1
- ELSE IF( ICOMPQ.EQ.0 ) THEN
- INFO = -2
- ELSE IF( ICOMPZ.EQ.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( ILO.LT.1 ) THEN
- INFO = -5
- ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
- INFO = -6
- ELSE IF( LDH.LT.N ) THEN
- INFO = -8
- ELSE IF( LDT.LT.N ) THEN
- INFO = -10
- ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
- INFO = -15
- ELSE IF( LDZ.LT.1 .OR. ( ILZ .AND. LDZ.LT.N ) ) THEN
- INFO = -17
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -19
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DHGEQZ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- WORK( 1 ) = DBLE( 1 )
- RETURN
- END IF
-*
-* Initialize Q and Z
-*
- IF( ICOMPQ.EQ.3 )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
- IF( ICOMPZ.EQ.3 )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-* Machine Constants
-*
- IN = IHI + 1 - ILO
- SAFMIN = DLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
- ANORM = DLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
- BNORM = DLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
- ATOL = MAX( SAFMIN, ULP*ANORM )
- BTOL = MAX( SAFMIN, ULP*BNORM )
- ASCALE = ONE / MAX( SAFMIN, ANORM )
- BSCALE = ONE / MAX( SAFMIN, BNORM )
-*
-* Set Eigenvalues IHI+1:N
-*
- DO 30 J = IHI + 1, N
- IF( T( J, J ).LT.ZERO ) THEN
- IF( ILSCHR ) THEN
- DO 10 JR = 1, J
- H( JR, J ) = -H( JR, J )
- T( JR, J ) = -T( JR, J )
- 10 CONTINUE
- ELSE
- H( J, J ) = -H( J, J )
- T( J, J ) = -T( J, J )
- END IF
- IF( ILZ ) THEN
- DO 20 JR = 1, N
- Z( JR, J ) = -Z( JR, J )
- 20 CONTINUE
- END IF
- END IF
- ALPHAR( J ) = H( J, J )
- ALPHAI( J ) = ZERO
- BETA( J ) = T( J, J )
- 30 CONTINUE
-*
-* If IHI < ILO, skip QZ steps
-*
- IF( IHI.LT.ILO )
- $ GO TO 380
-*
-* MAIN QZ ITERATION LOOP
-*
-* Initialize dynamic indices
-*
-* Eigenvalues ILAST+1:N have been found.
-* Column operations modify rows IFRSTM:whatever.
-* Row operations modify columns whatever:ILASTM.
-*
-* If only eigenvalues are being computed, then
-* IFRSTM is the row of the last splitting row above row ILAST;
-* this is always at least ILO.
-* IITER counts iterations since the last eigenvalue was found,
-* to tell when to use an extraordinary shift.
-* MAXIT is the maximum number of QZ sweeps allowed.
-*
- ILAST = IHI
- IF( ILSCHR ) THEN
- IFRSTM = 1
- ILASTM = N
- ELSE
- IFRSTM = ILO
- ILASTM = IHI
- END IF
- IITER = 0
- ESHIFT = ZERO
- MAXIT = 30*( IHI-ILO+1 )
-*
- DO 360 JITER = 1, MAXIT
-*
-* Split the matrix if possible.
-*
-* Two tests:
-* 1: H(j,j-1)=0 or j=ILO
-* 2: T(j,j)=0
-*
- IF( ILAST.EQ.ILO ) THEN
-*
-* Special case: j=ILAST
-*
- GO TO 80
- ELSE
- IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- H( ILAST, ILAST-1 ) = ZERO
- GO TO 80
- END IF
- END IF
-*
- IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
- T( ILAST, ILAST ) = ZERO
- GO TO 70
- END IF
-*
-* General case: j<ILAST
-*
- DO 60 J = ILAST - 1, ILO, -1
-*
-* Test 1: for H(j,j-1)=0 or j=ILO
-*
- IF( J.EQ.ILO ) THEN
- ILAZRO = .TRUE.
- ELSE
- IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
- H( J, J-1 ) = ZERO
- ILAZRO = .TRUE.
- ELSE
- ILAZRO = .FALSE.
- END IF
- END IF
-*
-* Test 2: for T(j,j)=0
-*
- IF( ABS( T( J, J ) ).LT.BTOL ) THEN
- T( J, J ) = ZERO
-*
-* Test 1a: Check for 2 consecutive small subdiagonals in A
-*
- ILAZR2 = .FALSE.
- IF( .NOT.ILAZRO ) THEN
- TEMP = ABS( H( J, J-1 ) )
- TEMP2 = ABS( H( J, J ) )
- TEMPR = MAX( TEMP, TEMP2 )
- IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
- TEMP = TEMP / TEMPR
- TEMP2 = TEMP2 / TEMPR
- END IF
- IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
- $ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
- END IF
-*
-* If both tests pass (1 & 2), i.e., the leading diagonal
-* element of B in the block is zero, split a 1x1 block off
-* at the top. (I.e., at the J-th row/column) The leading
-* diagonal element of the remainder can also be zero, so
-* this may have to be done repeatedly.
-*
- IF( ILAZRO .OR. ILAZR2 ) THEN
- DO 40 JCH = J, ILAST - 1
- TEMP = H( JCH, JCH )
- CALL DLARTG( TEMP, H( JCH+1, JCH ), C, S,
- $ H( JCH, JCH ) )
- H( JCH+1, JCH ) = ZERO
- CALL DROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
- $ H( JCH+1, JCH+1 ), LDH, C, S )
- CALL DROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
- $ T( JCH+1, JCH+1 ), LDT, C, S )
- IF( ILQ )
- $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
- $ C, S )
- IF( ILAZR2 )
- $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
- ILAZR2 = .FALSE.
- IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
- IF( JCH+1.GE.ILAST ) THEN
- GO TO 80
- ELSE
- IFIRST = JCH + 1
- GO TO 110
- END IF
- END IF
- T( JCH+1, JCH+1 ) = ZERO
- 40 CONTINUE
- GO TO 70
- ELSE
-*
-* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
-* Then process as in the case T(ILAST,ILAST)=0
-*
- DO 50 JCH = J, ILAST - 1
- TEMP = T( JCH, JCH+1 )
- CALL DLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
- $ T( JCH, JCH+1 ) )
- T( JCH+1, JCH+1 ) = ZERO
- IF( JCH.LT.ILASTM-1 )
- $ CALL DROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
- $ T( JCH+1, JCH+2 ), LDT, C, S )
- CALL DROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
- $ H( JCH+1, JCH-1 ), LDH, C, S )
- IF( ILQ )
- $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
- $ C, S )
- TEMP = H( JCH+1, JCH )
- CALL DLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
- $ H( JCH+1, JCH ) )
- H( JCH+1, JCH-1 ) = ZERO
- CALL DROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
- $ H( IFRSTM, JCH-1 ), 1, C, S )
- CALL DROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
- $ T( IFRSTM, JCH-1 ), 1, C, S )
- IF( ILZ )
- $ CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
- $ C, S )
- 50 CONTINUE
- GO TO 70
- END IF
- ELSE IF( ILAZRO ) THEN
-*
-* Only test 1 passed -- work on J:ILAST
-*
- IFIRST = J
- GO TO 110
- END IF
-*
-* Neither test passed -- try next J
-*
- 60 CONTINUE
-*
-* (Drop-through is "impossible")
-*
- INFO = N + 1
- GO TO 420
-*
-* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
-* 1x1 block.
-*
- 70 CONTINUE
- TEMP = H( ILAST, ILAST )
- CALL DLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
- $ H( ILAST, ILAST ) )
- H( ILAST, ILAST-1 ) = ZERO
- CALL DROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
- $ H( IFRSTM, ILAST-1 ), 1, C, S )
- CALL DROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
- $ T( IFRSTM, ILAST-1 ), 1, C, S )
- IF( ILZ )
- $ CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
-*
-* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
-* and BETA
-*
- 80 CONTINUE
- IF( T( ILAST, ILAST ).LT.ZERO ) THEN
- IF( ILSCHR ) THEN
- DO 90 J = IFRSTM, ILAST
- H( J, ILAST ) = -H( J, ILAST )
- T( J, ILAST ) = -T( J, ILAST )
- 90 CONTINUE
- ELSE
- H( ILAST, ILAST ) = -H( ILAST, ILAST )
- T( ILAST, ILAST ) = -T( ILAST, ILAST )
- END IF
- IF( ILZ ) THEN
- DO 100 J = 1, N
- Z( J, ILAST ) = -Z( J, ILAST )
- 100 CONTINUE
- END IF
- END IF
- ALPHAR( ILAST ) = H( ILAST, ILAST )
- ALPHAI( ILAST ) = ZERO
- BETA( ILAST ) = T( ILAST, ILAST )
-*
-* Go to next block -- exit if finished.
-*
- ILAST = ILAST - 1
- IF( ILAST.LT.ILO )
- $ GO TO 380
-*
-* Reset counters
-*
- IITER = 0
- ESHIFT = ZERO
- IF( .NOT.ILSCHR ) THEN
- ILASTM = ILAST
- IF( IFRSTM.GT.ILAST )
- $ IFRSTM = ILO
- END IF
- GO TO 350
-*
-* QZ step
-*
-* This iteration only involves rows/columns IFIRST:ILAST. We
-* assume IFIRST < ILAST, and that the diagonal of B is non-zero.
-*
- 110 CONTINUE
- IITER = IITER + 1
- IF( .NOT.ILSCHR ) THEN
- IFRSTM = IFIRST
- END IF
-*
-* Compute single shifts.
-*
-* At this point, IFIRST < ILAST, and the diagonal elements of
-* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
-* magnitude)
-*
- IF( ( IITER / 10 )*10.EQ.IITER ) THEN
-*
-* Exceptional shift. Chosen for no particularly good reason.
-* (Single shift only.)
-*
- IF( ( DBLE( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
- $ ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
- ESHIFT = ESHIFT + H( ILAST, ILAST-1 ) /
- $ T( ILAST-1, ILAST-1 )
- ELSE
- ESHIFT = ESHIFT + ONE / ( SAFMIN*DBLE( MAXIT ) )
- END IF
- S1 = ONE
- WR = ESHIFT
-*
- ELSE
-*
-* Shifts based on the generalized eigenvalues of the
-* bottom-right 2x2 block of A and B. The first eigenvalue
-* returned by DLAG2 is the Wilkinson shift (AEP p.512),
-*
- CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
- $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
- $ S2, WR, WR2, WI )
-*
- TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
- IF( WI.NE.ZERO )
- $ GO TO 200
- END IF
-*
-* Fiddle with shift to avoid overflow
-*
- TEMP = MIN( ASCALE, ONE )*( HALF*SAFMAX )
- IF( S1.GT.TEMP ) THEN
- SCALE = TEMP / S1
- ELSE
- SCALE = ONE
- END IF
-*
- TEMP = MIN( BSCALE, ONE )*( HALF*SAFMAX )
- IF( ABS( WR ).GT.TEMP )
- $ SCALE = MIN( SCALE, TEMP / ABS( WR ) )
- S1 = SCALE*S1
- WR = SCALE*WR
-*
-* Now check for two consecutive small subdiagonals.
-*
- DO 120 J = ILAST - 1, IFIRST + 1, -1
- ISTART = J
- TEMP = ABS( S1*H( J, J-1 ) )
- TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
- TEMPR = MAX( TEMP, TEMP2 )
- IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
- TEMP = TEMP / TEMPR
- TEMP2 = TEMP2 / TEMPR
- END IF
- IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
- $ TEMP2 )GO TO 130
- 120 CONTINUE
-*
- ISTART = IFIRST
- 130 CONTINUE
-*
-* Do an implicit single-shift QZ sweep.
-*
-* Initial Q
-*
- TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
- TEMP2 = S1*H( ISTART+1, ISTART )
- CALL DLARTG( TEMP, TEMP2, C, S, TEMPR )
-*
-* Sweep
-*
- DO 190 J = ISTART, ILAST - 1
- IF( J.GT.ISTART ) THEN
- TEMP = H( J, J-1 )
- CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
- H( J+1, J-1 ) = ZERO
- END IF
-*
- DO 140 JC = J, ILASTM
- TEMP = C*H( J, JC ) + S*H( J+1, JC )
- H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
- H( J, JC ) = TEMP
- TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
- T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
- T( J, JC ) = TEMP2
- 140 CONTINUE
- IF( ILQ ) THEN
- DO 150 JR = 1, N
- TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
- Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
- Q( JR, J ) = TEMP
- 150 CONTINUE
- END IF
-*
- TEMP = T( J+1, J+1 )
- CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
- T( J+1, J ) = ZERO
-*
- DO 160 JR = IFRSTM, MIN( J+2, ILAST )
- TEMP = C*H( JR, J+1 ) + S*H( JR, J )
- H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
- H( JR, J+1 ) = TEMP
- 160 CONTINUE
- DO 170 JR = IFRSTM, J
- TEMP = C*T( JR, J+1 ) + S*T( JR, J )
- T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
- T( JR, J+1 ) = TEMP
- 170 CONTINUE
- IF( ILZ ) THEN
- DO 180 JR = 1, N
- TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
- Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
- Z( JR, J+1 ) = TEMP
- 180 CONTINUE
- END IF
- 190 CONTINUE
-*
- GO TO 350
-*
-* Use Francis double-shift
-*
-* Note: the Francis double-shift should work with real shifts,
-* but only if the block is at least 3x3.
-* This code may break if this point is reached with
-* a 2x2 block with real eigenvalues.
-*
- 200 CONTINUE
- IF( IFIRST+1.EQ.ILAST ) THEN
-*
-* Special case -- 2x2 block with complex eigenvectors
-*
-* Step 1: Standardize, that is, rotate so that
-*
-* ( B11 0 )
-* B = ( ) with B11 non-negative.
-* ( 0 B22 )
-*
- CALL DLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
- $ T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
-*
- IF( B11.LT.ZERO ) THEN
- CR = -CR
- SR = -SR
- B11 = -B11
- B22 = -B22
- END IF
-*
- CALL DROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
- $ H( ILAST, ILAST-1 ), LDH, CL, SL )
- CALL DROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
- $ H( IFRSTM, ILAST ), 1, CR, SR )
-*
- IF( ILAST.LT.ILASTM )
- $ CALL DROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
- $ T( ILAST, ILAST+1 ), LDT, CL, SL )
- IF( IFRSTM.LT.ILAST-1 )
- $ CALL DROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
- $ T( IFRSTM, ILAST ), 1, CR, SR )
-*
- IF( ILQ )
- $ CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
- $ SL )
- IF( ILZ )
- $ CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
- $ SR )
-*
- T( ILAST-1, ILAST-1 ) = B11
- T( ILAST-1, ILAST ) = ZERO
- T( ILAST, ILAST-1 ) = ZERO
- T( ILAST, ILAST ) = B22
-*
-* If B22 is negative, negate column ILAST
-*
- IF( B22.LT.ZERO ) THEN
- DO 210 J = IFRSTM, ILAST
- H( J, ILAST ) = -H( J, ILAST )
- T( J, ILAST ) = -T( J, ILAST )
- 210 CONTINUE
-*
- IF( ILZ ) THEN
- DO 220 J = 1, N
- Z( J, ILAST ) = -Z( J, ILAST )
- 220 CONTINUE
- END IF
- B22 = -B22
- END IF
-*
-* Step 2: Compute ALPHAR, ALPHAI, and BETA (see refs.)
-*
-* Recompute shift
-*
- CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
- $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
- $ TEMP, WR, TEMP2, WI )
-*
-* If standardization has perturbed the shift onto real line,
-* do another (real single-shift) QR step.
-*
- IF( WI.EQ.ZERO )
- $ GO TO 350
- S1INV = ONE / S1
-*
-* Do EISPACK (QZVAL) computation of alpha and beta
-*
- A11 = H( ILAST-1, ILAST-1 )
- A21 = H( ILAST, ILAST-1 )
- A12 = H( ILAST-1, ILAST )
- A22 = H( ILAST, ILAST )
-*
-* Compute complex Givens rotation on right
-* (Assume some element of C = (sA - wB) > unfl )
-* __
-* (sA - wB) ( CZ -SZ )
-* ( SZ CZ )
-*
- C11R = S1*A11 - WR*B11
- C11I = -WI*B11
- C12 = S1*A12
- C21 = S1*A21
- C22R = S1*A22 - WR*B22
- C22I = -WI*B22
-*
- IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
- $ ABS( C22R )+ABS( C22I ) ) THEN
- T1 = DLAPY3( C12, C11R, C11I )
- CZ = C12 / T1
- SZR = -C11R / T1
- SZI = -C11I / T1
- ELSE
- CZ = DLAPY2( C22R, C22I )
- IF( CZ.LE.SAFMIN ) THEN
- CZ = ZERO
- SZR = ONE
- SZI = ZERO
- ELSE
- TEMPR = C22R / CZ
- TEMPI = C22I / CZ
- T1 = DLAPY2( CZ, C21 )
- CZ = CZ / T1
- SZR = -C21*TEMPR / T1
- SZI = C21*TEMPI / T1
- END IF
- END IF
-*
-* Compute Givens rotation on left
-*
-* ( CQ SQ )
-* ( __ ) A or B
-* ( -SQ CQ )
-*
- AN = ABS( A11 ) + ABS( A12 ) + ABS( A21 ) + ABS( A22 )
- BN = ABS( B11 ) + ABS( B22 )
- WABS = ABS( WR ) + ABS( WI )
- IF( S1*AN.GT.WABS*BN ) THEN
- CQ = CZ*B11
- SQR = SZR*B22
- SQI = -SZI*B22
- ELSE
- A1R = CZ*A11 + SZR*A12
- A1I = SZI*A12
- A2R = CZ*A21 + SZR*A22
- A2I = SZI*A22
- CQ = DLAPY2( A1R, A1I )
- IF( CQ.LE.SAFMIN ) THEN
- CQ = ZERO
- SQR = ONE
- SQI = ZERO
- ELSE
- TEMPR = A1R / CQ
- TEMPI = A1I / CQ
- SQR = TEMPR*A2R + TEMPI*A2I
- SQI = TEMPI*A2R - TEMPR*A2I
- END IF
- END IF
- T1 = DLAPY3( CQ, SQR, SQI )
- CQ = CQ / T1
- SQR = SQR / T1
- SQI = SQI / T1
-*
-* Compute diagonal elements of QBZ
-*
- TEMPR = SQR*SZR - SQI*SZI
- TEMPI = SQR*SZI + SQI*SZR
- B1R = CQ*CZ*B11 + TEMPR*B22
- B1I = TEMPI*B22
- B1A = DLAPY2( B1R, B1I )
- B2R = CQ*CZ*B22 + TEMPR*B11
- B2I = -TEMPI*B11
- B2A = DLAPY2( B2R, B2I )
-*
-* Normalize so beta > 0, and Im( alpha1 ) > 0
-*
- BETA( ILAST-1 ) = B1A
- BETA( ILAST ) = B2A
- ALPHAR( ILAST-1 ) = ( WR*B1A )*S1INV
- ALPHAI( ILAST-1 ) = ( WI*B1A )*S1INV
- ALPHAR( ILAST ) = ( WR*B2A )*S1INV
- ALPHAI( ILAST ) = -( WI*B2A )*S1INV
-*
-* Step 3: Go to next block -- exit if finished.
-*
- ILAST = IFIRST - 1
- IF( ILAST.LT.ILO )
- $ GO TO 380
-*
-* Reset counters
-*
- IITER = 0
- ESHIFT = ZERO
- IF( .NOT.ILSCHR ) THEN
- ILASTM = ILAST
- IF( IFRSTM.GT.ILAST )
- $ IFRSTM = ILO
- END IF
- GO TO 350
- ELSE
-*
-* Usual case: 3x3 or larger block, using Francis implicit
-* double-shift
-*
-* 2
-* Eigenvalue equation is w - c w + d = 0,
-*
-* -1 2 -1
-* so compute 1st column of (A B ) - c A B + d
-* using the formula in QZIT (from EISPACK)
-*
-* We assume that the block is at least 3x3
-*
- AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
- $ ( BSCALE*T( ILAST, ILAST ) )
- AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
- $ ( BSCALE*T( ILAST, ILAST ) )
- U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
- AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
- $ ( BSCALE*T( IFIRST, IFIRST ) )
- AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
- $ ( BSCALE*T( IFIRST, IFIRST ) )
- AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
- $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
- AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
- $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
- AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
- $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
- U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
-*
- V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
- $ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
- V( 2 ) = ( ( AD22L-AD11L )-AD21L*U12L-( AD11-AD11L )-
- $ ( AD22-AD11L )+AD21*U12 )*AD21L
- V( 3 ) = AD32L*AD21L
-*
- ISTART = IFIRST
-*
- CALL DLARFG( 3, V( 1 ), V( 2 ), 1, TAU )
- V( 1 ) = ONE
-*
-* Sweep
-*
- DO 290 J = ISTART, ILAST - 2
-*
-* All but last elements: use 3x3 Householder transforms.
-*
-* Zero (j-1)st column of A
-*
- IF( J.GT.ISTART ) THEN
- V( 1 ) = H( J, J-1 )
- V( 2 ) = H( J+1, J-1 )
- V( 3 ) = H( J+2, J-1 )
-*
- CALL DLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
- V( 1 ) = ONE
- H( J+1, J-1 ) = ZERO
- H( J+2, J-1 ) = ZERO
- END IF
-*
- DO 230 JC = J, ILASTM
- TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
- $ H( J+2, JC ) )
- H( J, JC ) = H( J, JC ) - TEMP
- H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
- H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
- TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
- $ T( J+2, JC ) )
- T( J, JC ) = T( J, JC ) - TEMP2
- T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
- T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
- 230 CONTINUE
- IF( ILQ ) THEN
- DO 240 JR = 1, N
- TEMP = TAU*( Q( JR, J )+V( 2 )*Q( JR, J+1 )+V( 3 )*
- $ Q( JR, J+2 ) )
- Q( JR, J ) = Q( JR, J ) - TEMP
- Q( JR, J+1 ) = Q( JR, J+1 ) - TEMP*V( 2 )
- Q( JR, J+2 ) = Q( JR, J+2 ) - TEMP*V( 3 )
- 240 CONTINUE
- END IF
-*
-* Zero j-th column of B (see DLAGBC for details)
-*
-* Swap rows to pivot
-*
- ILPIVT = .FALSE.
- TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
- TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
- IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
- SCALE = ZERO
- U1 = ONE
- U2 = ZERO
- GO TO 250
- ELSE IF( TEMP.GE.TEMP2 ) THEN
- W11 = T( J+1, J+1 )
- W21 = T( J+2, J+1 )
- W12 = T( J+1, J+2 )
- W22 = T( J+2, J+2 )
- U1 = T( J+1, J )
- U2 = T( J+2, J )
- ELSE
- W21 = T( J+1, J+1 )
- W11 = T( J+2, J+1 )
- W22 = T( J+1, J+2 )
- W12 = T( J+2, J+2 )
- U2 = T( J+1, J )
- U1 = T( J+2, J )
- END IF
-*
-* Swap columns if nec.
-*
- IF( ABS( W12 ).GT.ABS( W11 ) ) THEN
- ILPIVT = .TRUE.
- TEMP = W12
- TEMP2 = W22
- W12 = W11
- W22 = W21
- W11 = TEMP
- W21 = TEMP2
- END IF
-*
-* LU-factor
-*
- TEMP = W21 / W11
- U2 = U2 - TEMP*U1
- W22 = W22 - TEMP*W12
- W21 = ZERO
-*
-* Compute SCALE
-*
- SCALE = ONE
- IF( ABS( W22 ).LT.SAFMIN ) THEN
- SCALE = ZERO
- U2 = ONE
- U1 = -W12 / W11
- GO TO 250
- END IF
- IF( ABS( W22 ).LT.ABS( U2 ) )
- $ SCALE = ABS( W22 / U2 )
- IF( ABS( W11 ).LT.ABS( U1 ) )
- $ SCALE = MIN( SCALE, ABS( W11 / U1 ) )
-*
-* Solve
-*
- U2 = ( SCALE*U2 ) / W22
- U1 = ( SCALE*U1-W12*U2 ) / W11
-*
- 250 CONTINUE
- IF( ILPIVT ) THEN
- TEMP = U2
- U2 = U1
- U1 = TEMP
- END IF
-*
-* Compute Householder Vector
-*
- T1 = SQRT( SCALE**2+U1**2+U2**2 )
- TAU = ONE + SCALE / T1
- VS = -ONE / ( SCALE+T1 )
- V( 1 ) = ONE
- V( 2 ) = VS*U1
- V( 3 ) = VS*U2
-*
-* Apply transformations from the right.
-*
- DO 260 JR = IFRSTM, MIN( J+3, ILAST )
- TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
- $ H( JR, J+2 ) )
- H( JR, J ) = H( JR, J ) - TEMP
- H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
- H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
- 260 CONTINUE
- DO 270 JR = IFRSTM, J + 2
- TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
- $ T( JR, J+2 ) )
- T( JR, J ) = T( JR, J ) - TEMP
- T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
- T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
- 270 CONTINUE
- IF( ILZ ) THEN
- DO 280 JR = 1, N
- TEMP = TAU*( Z( JR, J )+V( 2 )*Z( JR, J+1 )+V( 3 )*
- $ Z( JR, J+2 ) )
- Z( JR, J ) = Z( JR, J ) - TEMP
- Z( JR, J+1 ) = Z( JR, J+1 ) - TEMP*V( 2 )
- Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
- 280 CONTINUE
- END IF
- T( J+1, J ) = ZERO
- T( J+2, J ) = ZERO
- 290 CONTINUE
-*
-* Last elements: Use Givens rotations
-*
-* Rotations from the left
-*
- J = ILAST - 1
- TEMP = H( J, J-1 )
- CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
- H( J+1, J-1 ) = ZERO
-*
- DO 300 JC = J, ILASTM
- TEMP = C*H( J, JC ) + S*H( J+1, JC )
- H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
- H( J, JC ) = TEMP
- TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
- T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
- T( J, JC ) = TEMP2
- 300 CONTINUE
- IF( ILQ ) THEN
- DO 310 JR = 1, N
- TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
- Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
- Q( JR, J ) = TEMP
- 310 CONTINUE
- END IF
-*
-* Rotations from the right.
-*
- TEMP = T( J+1, J+1 )
- CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
- T( J+1, J ) = ZERO
-*
- DO 320 JR = IFRSTM, ILAST
- TEMP = C*H( JR, J+1 ) + S*H( JR, J )
- H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
- H( JR, J+1 ) = TEMP
- 320 CONTINUE
- DO 330 JR = IFRSTM, ILAST - 1
- TEMP = C*T( JR, J+1 ) + S*T( JR, J )
- T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
- T( JR, J+1 ) = TEMP
- 330 CONTINUE
- IF( ILZ ) THEN
- DO 340 JR = 1, N
- TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
- Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
- Z( JR, J+1 ) = TEMP
- 340 CONTINUE
- END IF
-*
-* End of Double-Shift code
-*
- END IF
-*
- GO TO 350
-*
-* End of iteration loop
-*
- 350 CONTINUE
- 360 CONTINUE
-*
-* Drop-through = non-convergence
-*
- INFO = ILAST
- GO TO 420
-*
-* Successful completion of all QZ steps
-*
- 380 CONTINUE
-*
-* Set Eigenvalues 1:ILO-1
-*
- DO 410 J = 1, ILO - 1
- IF( T( J, J ).LT.ZERO ) THEN
- IF( ILSCHR ) THEN
- DO 390 JR = 1, J
- H( JR, J ) = -H( JR, J )
- T( JR, J ) = -T( JR, J )
- 390 CONTINUE
- ELSE
- H( J, J ) = -H( J, J )
- T( J, J ) = -T( J, J )
- END IF
- IF( ILZ ) THEN
- DO 400 JR = 1, N
- Z( JR, J ) = -Z( JR, J )
- 400 CONTINUE
- END IF
- END IF
- ALPHAR( J ) = H( J, J )
- ALPHAI( J ) = ZERO
- BETA( J ) = T( J, J )
- 410 CONTINUE
-*
-* Normal Termination
-*
- INFO = 0
-*
-* Exit (other than argument error) -- return optimal workspace size
-*
- 420 CONTINUE
- WORK( 1 ) = DBLE( N )
- RETURN
-*
-* End of DHGEQZ
-*
- END
diff --git a/netlib/LAPACK/dhsein.f b/netlib/LAPACK/dhsein.f
deleted file mode 100644
index d239a0e..0000000
--- a/netlib/LAPACK/dhsein.f
+++ /dev/null
@@ -1,526 +0,0 @@
-*> \brief \b DHSEIN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DHSEIN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dhsein.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dhsein.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dhsein.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI,
-* VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL,
-* IFAILR, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EIGSRC, INITV, SIDE
-* INTEGER INFO, LDH, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IFAILL( * ), IFAILR( * )
-* DOUBLE PRECISION H( LDH, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DHSEIN uses inverse iteration to find specified right and/or left
-*> eigenvectors of a real upper Hessenberg matrix H.
-*>
-*> The right eigenvector x and the left eigenvector y of the matrix H
-*> corresponding to an eigenvalue w are defined by:
-*>
-*> H * x = w * x, y**h * H = w * y**h
-*>
-*> where y**h denotes the conjugate transpose of the vector y.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] EIGSRC
-*> \verbatim
-*> EIGSRC is CHARACTER*1
-*> Specifies the source of eigenvalues supplied in (WR,WI):
-*> = 'Q': the eigenvalues were found using DHSEQR; thus, if
-*> H has zero subdiagonal elements, and so is
-*> block-triangular, then the j-th eigenvalue can be
-*> assumed to be an eigenvalue of the block containing
-*> the j-th row/column. This property allows DHSEIN to
-*> perform inverse iteration on just one diagonal block.
-*> = 'N': no assumptions are made on the correspondence
-*> between eigenvalues and diagonal blocks. In this
-*> case, DHSEIN must always perform inverse iteration
-*> using the whole matrix H.
-*> \endverbatim
-*>
-*> \param[in] INITV
-*> \verbatim
-*> INITV is CHARACTER*1
-*> = 'N': no initial vectors are supplied;
-*> = 'U': user-supplied initial vectors are stored in the arrays
-*> VL and/or VR.
-*> \endverbatim
-*>
-*> \param[in,out] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> Specifies the eigenvectors to be computed. To select the
-*> real eigenvector corresponding to a real eigenvalue WR(j),
-*> SELECT(j) must be set to .TRUE.. To select the complex
-*> eigenvector corresponding to a complex eigenvalue
-*> (WR(j),WI(j)), with complex conjugate (WR(j+1),WI(j+1)),
-*> either SELECT(j) or SELECT(j+1) or both must be set to
-*> .TRUE.; then on exit SELECT(j) is .TRUE. and SELECT(j+1) is
-*> .FALSE..
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> The upper Hessenberg matrix H.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*>
-*> On entry, the real and imaginary parts of the eigenvalues of
-*> H; a complex conjugate pair of eigenvalues must be stored in
-*> consecutive elements of WR and WI.
-*> On exit, WR may have been altered since close eigenvalues
-*> are perturbed slightly in searching for independent
-*> eigenvectors.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,MM)
-*> On entry, if INITV = 'U' and SIDE = 'L' or 'B', VL must
-*> contain starting vectors for the inverse iteration for the
-*> left eigenvectors; the starting vector for each eigenvector
-*> must be in the same column(s) in which the eigenvector will
-*> be stored.
-*> On exit, if SIDE = 'L' or 'B', the left eigenvectors
-*> specified by SELECT will be stored consecutively in the
-*> columns of VL, in the same order as their eigenvalues. A
-*> complex eigenvector corresponding to a complex eigenvalue is
-*> stored in two consecutive columns, the first holding the real
-*> part and the second the imaginary part.
-*> If SIDE = 'R', VL is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL.
-*> LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,MM)
-*> On entry, if INITV = 'U' and SIDE = 'R' or 'B', VR must
-*> contain starting vectors for the inverse iteration for the
-*> right eigenvectors; the starting vector for each eigenvector
-*> must be in the same column(s) in which the eigenvector will
-*> be stored.
-*> On exit, if SIDE = 'R' or 'B', the right eigenvectors
-*> specified by SELECT will be stored consecutively in the
-*> columns of VR, in the same order as their eigenvalues. A
-*> complex eigenvector corresponding to a complex eigenvalue is
-*> stored in two consecutive columns, the first holding the real
-*> part and the second the imaginary part.
-*> If SIDE = 'L', VR is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR.
-*> LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR required to
-*> store the eigenvectors; each selected real eigenvector
-*> occupies one column and each selected complex eigenvector
-*> occupies two columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ((N+2)*N)
-*> \endverbatim
-*>
-*> \param[out] IFAILL
-*> \verbatim
-*> IFAILL is INTEGER array, dimension (MM)
-*> If SIDE = 'L' or 'B', IFAILL(i) = j > 0 if the left
-*> eigenvector in the i-th column of VL (corresponding to the
-*> eigenvalue w(j)) failed to converge; IFAILL(i) = 0 if the
-*> eigenvector converged satisfactorily. If the i-th and (i+1)th
-*> columns of VL hold a complex eigenvector, then IFAILL(i) and
-*> IFAILL(i+1) are set to the same value.
-*> If SIDE = 'R', IFAILL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] IFAILR
-*> \verbatim
-*> IFAILR is INTEGER array, dimension (MM)
-*> If SIDE = 'R' or 'B', IFAILR(i) = j > 0 if the right
-*> eigenvector in the i-th column of VR (corresponding to the
-*> eigenvalue w(j)) failed to converge; IFAILR(i) = 0 if the
-*> eigenvector converged satisfactorily. If the i-th and (i+1)th
-*> columns of VR hold a complex eigenvector, then IFAILR(i) and
-*> IFAILR(i+1) are set to the same value.
-*> If SIDE = 'L', IFAILR is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, i is the number of eigenvectors which
-*> failed to converge; see IFAILL and IFAILR for further
-*> details.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Each eigenvector is normalized so that the element of largest
-*> magnitude has magnitude 1; here the magnitude of a complex number
-*> (x,y) is taken to be |x|+|y|.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI,
- $ VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL,
- $ IFAILR, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER EIGSRC, INITV, SIDE
- INTEGER INFO, LDH, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IFAILL( * ), IFAILR( * )
- DOUBLE PRECISION H( LDH, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BOTHV, FROMQR, LEFTV, NOINIT, PAIR, RIGHTV
- INTEGER I, IINFO, K, KL, KLN, KR, KSI, KSR, LDWORK
- DOUBLE PRECISION BIGNUM, EPS3, HNORM, SMLNUM, ULP, UNFL, WKI,
- $ WKR
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANHS
- EXTERNAL LSAME, DLAMCH, DLANHS
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAEIN, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters.
-*
- BOTHV = LSAME( SIDE, 'B' )
- RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
- LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
- FROMQR = LSAME( EIGSRC, 'Q' )
-*
- NOINIT = LSAME( INITV, 'N' )
-*
-* Set M to the number of columns required to store the selected
-* eigenvectors, and standardize the array SELECT.
-*
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- SELECT( K ) = .FALSE.
- ELSE
- IF( WI( K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) ) THEN
- SELECT( K ) = .TRUE.
- M = M + 2
- END IF
- END IF
- END IF
- 10 CONTINUE
-*
- INFO = 0
- IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -1
- ELSE IF( .NOT.FROMQR .AND. .NOT.LSAME( EIGSRC, 'N' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOINIT .AND. .NOT.LSAME( INITV, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
- INFO = -11
- ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
- INFO = -13
- ELSE IF( MM.LT.M ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DHSEIN', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set machine-dependent constants.
-*
- UNFL = DLAMCH( 'Safe minimum' )
- ULP = DLAMCH( 'Precision' )
- SMLNUM = UNFL*( N / ULP )
- BIGNUM = ( ONE-ULP ) / SMLNUM
-*
- LDWORK = N + 1
-*
- KL = 1
- KLN = 0
- IF( FROMQR ) THEN
- KR = 0
- ELSE
- KR = N
- END IF
- KSR = 1
-*
- DO 120 K = 1, N
- IF( SELECT( K ) ) THEN
-*
-* Compute eigenvector(s) corresponding to W(K).
-*
- IF( FROMQR ) THEN
-*
-* If affiliation of eigenvalues is known, check whether
-* the matrix splits.
-*
-* Determine KL and KR such that 1 <= KL <= K <= KR <= N
-* and H(KL,KL-1) and H(KR+1,KR) are zero (or KL = 1 or
-* KR = N).
-*
-* Then inverse iteration can be performed with the
-* submatrix H(KL:N,KL:N) for a left eigenvector, and with
-* the submatrix H(1:KR,1:KR) for a right eigenvector.
-*
- DO 20 I = K, KL + 1, -1
- IF( H( I, I-1 ).EQ.ZERO )
- $ GO TO 30
- 20 CONTINUE
- 30 CONTINUE
- KL = I
- IF( K.GT.KR ) THEN
- DO 40 I = K, N - 1
- IF( H( I+1, I ).EQ.ZERO )
- $ GO TO 50
- 40 CONTINUE
- 50 CONTINUE
- KR = I
- END IF
- END IF
-*
- IF( KL.NE.KLN ) THEN
- KLN = KL
-*
-* Compute infinity-norm of submatrix H(KL:KR,KL:KR) if it
-* has not ben computed before.
-*
- HNORM = DLANHS( 'I', KR-KL+1, H( KL, KL ), LDH, WORK )
- IF( HNORM.GT.ZERO ) THEN
- EPS3 = HNORM*ULP
- ELSE
- EPS3 = SMLNUM
- END IF
- END IF
-*
-* Perturb eigenvalue if it is close to any previous
-* selected eigenvalues affiliated to the submatrix
-* H(KL:KR,KL:KR). Close roots are modified by EPS3.
-*
- WKR = WR( K )
- WKI = WI( K )
- 60 CONTINUE
- DO 70 I = K - 1, KL, -1
- IF( SELECT( I ) .AND. ABS( WR( I )-WKR )+
- $ ABS( WI( I )-WKI ).LT.EPS3 ) THEN
- WKR = WKR + EPS3
- GO TO 60
- END IF
- 70 CONTINUE
- WR( K ) = WKR
-*
- PAIR = WKI.NE.ZERO
- IF( PAIR ) THEN
- KSI = KSR + 1
- ELSE
- KSI = KSR
- END IF
- IF( LEFTV ) THEN
-*
-* Compute left eigenvector.
-*
- CALL DLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), LDH,
- $ WKR, WKI, VL( KL, KSR ), VL( KL, KSI ),
- $ WORK, LDWORK, WORK( N*N+N+1 ), EPS3, SMLNUM,
- $ BIGNUM, IINFO )
- IF( IINFO.GT.0 ) THEN
- IF( PAIR ) THEN
- INFO = INFO + 2
- ELSE
- INFO = INFO + 1
- END IF
- IFAILL( KSR ) = K
- IFAILL( KSI ) = K
- ELSE
- IFAILL( KSR ) = 0
- IFAILL( KSI ) = 0
- END IF
- DO 80 I = 1, KL - 1
- VL( I, KSR ) = ZERO
- 80 CONTINUE
- IF( PAIR ) THEN
- DO 90 I = 1, KL - 1
- VL( I, KSI ) = ZERO
- 90 CONTINUE
- END IF
- END IF
- IF( RIGHTV ) THEN
-*
-* Compute right eigenvector.
-*
- CALL DLAEIN( .TRUE., NOINIT, KR, H, LDH, WKR, WKI,
- $ VR( 1, KSR ), VR( 1, KSI ), WORK, LDWORK,
- $ WORK( N*N+N+1 ), EPS3, SMLNUM, BIGNUM,
- $ IINFO )
- IF( IINFO.GT.0 ) THEN
- IF( PAIR ) THEN
- INFO = INFO + 2
- ELSE
- INFO = INFO + 1
- END IF
- IFAILR( KSR ) = K
- IFAILR( KSI ) = K
- ELSE
- IFAILR( KSR ) = 0
- IFAILR( KSI ) = 0
- END IF
- DO 100 I = KR + 1, N
- VR( I, KSR ) = ZERO
- 100 CONTINUE
- IF( PAIR ) THEN
- DO 110 I = KR + 1, N
- VR( I, KSI ) = ZERO
- 110 CONTINUE
- END IF
- END IF
-*
- IF( PAIR ) THEN
- KSR = KSR + 2
- ELSE
- KSR = KSR + 1
- END IF
- END IF
- 120 CONTINUE
-*
- RETURN
-*
-* End of DHSEIN
-*
- END
diff --git a/netlib/LAPACK/dhseqr.f b/netlib/LAPACK/dhseqr.f
deleted file mode 100644
index 3ee16ca..0000000
--- a/netlib/LAPACK/dhseqr.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief \b DHSEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DHSEQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dhseqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dhseqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dhseqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
-* LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
-* CHARACTER COMPZ, JOB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DHSEQR computes the eigenvalues of a Hessenberg matrix H
-*> and, optionally, the matrices T and Z from the Schur decomposition
-*> H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*> Schur form), and Z is the orthogonal matrix of Schur vectors.
-*>
-*> Optionally Z may be postmultiplied into an input orthogonal
-*> matrix Q so that this routine can give the Schur factorization
-*> of a matrix A which has been reduced to the Hessenberg form H
-*> by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> = 'E': compute eigenvalues only;
-*> = 'S': compute eigenvalues and the Schur form T.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': no Schur vectors are computed;
-*> = 'I': Z is initialized to the unit matrix and the matrix Z
-*> of Schur vectors of H is returned;
-*> = 'V': Z must contain an orthogonal matrix Q on entry, and
-*> the product Q*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to DGEBAL, and then passed to ZGEHRD
-*> when the matrix output by DGEBAL is reduced to Hessenberg
-*> form. Otherwise ILO and IHI should be set to 1 and N
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and JOB = 'S', then H contains the
-*> upper quasi-triangular matrix T from the Schur decomposition
-*> (the Schur form); 2-by-2 diagonal blocks (corresponding to
-*> complex conjugate pairs of eigenvalues) are returned in
-*> standard form, with H(i,i) = H(i+1,i+1) and
-*> H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
-*> contents of H are unspecified on exit. (The output value of
-*> H when INFO.GT.0 is given under the description of INFO
-*> below.)
-*>
-*> Unlike earlier versions of DHSEQR, this subroutine may
-*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
-*> or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*>
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues. If two eigenvalues are computed as a complex
-*> conjugate pair, they are stored in consecutive elements of
-*> WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
-*> WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
-*> the same order as on the diagonal of the Schur form returned
-*> in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
-*> diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> If COMPZ = 'N', Z is not referenced.
-*> If COMPZ = 'I', on entry Z need not be set and on exit,
-*> if INFO = 0, Z contains the orthogonal matrix Z of the Schur
-*> vectors of H. If COMPZ = 'V', on entry Z must contain an
-*> N-by-N matrix Q, which is assumed to be equal to the unit
-*> matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
-*> if INFO = 0, Z contains Q*Z.
-*> Normally Q is the orthogonal matrix generated by DORGHR
-*> after the call to DGEHRD which formed the Hessenberg matrix
-*> H. (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if COMPZ = 'I' or
-*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient and delivers very good and sometimes
-*> optimal performance. However, LWORK as large as 11*N
-*> may be required for optimal performance. A workspace
-*> query is recommended to determine the optimal workspace
-*> size.
-*>
-*> If LWORK = -1, then DHSEQR does a workspace query.
-*> In this case, DHSEQR checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .LT. 0: if INFO = -i, the i-th argument had an illegal
-*> value
-*> .GT. 0: if INFO = i, DHSEQR failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and JOB = 'E', then on exit, the
-*> remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and JOB = 'S', then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is an orthogonal matrix. The final
-*> value of H is upper Hessenberg and quasi-triangular
-*> in rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and COMPZ = 'V', then on exit
-*>
-*> (final value of Z) = (initial value of Z)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of JOB.)
-*>
-*> If INFO .GT. 0 and COMPZ = 'I', then on exit
-*> (final value of Z) = U
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of JOB.)
-*>
-*> If INFO .GT. 0 and COMPZ = 'N', then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Default values supplied by
-*> ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
-*> It is suggested that these defaults be adjusted in order
-*> to attain best performance in each particular
-*> computational environment.
-*>
-*> ISPEC=12: The DLAHQR vs DLAQR0 crossover point.
-*> Default: 75. (Must be at least 11.)
-*>
-*> ISPEC=13: Recommended deflation window size.
-*> This depends on ILO, IHI and NS. NS is the
-*> number of simultaneous shifts returned
-*> by ILAENV(ISPEC=15). (See ISPEC=15 below.)
-*> The default for (IHI-ILO+1).LE.500 is NS.
-*> The default for (IHI-ILO+1).GT.500 is 3*NS/2.
-*>
-*> ISPEC=14: Nibble crossover point. (See IPARMQ for
-*> details.) Default: 14% of deflation window
-*> size.
-*>
-*> ISPEC=15: Number of simultaneous shifts in a multishift
-*> QR iteration.
-*>
-*> If IHI-ILO+1 is ...
-*>
-*> greater than ...but less ... the
-*> or equal to ... than default is
-*>
-*> 1 30 NS = 2(+)
-*> 30 60 NS = 4(+)
-*> 60 150 NS = 10(+)
-*> 150 590 NS = **
-*> 590 3000 NS = 64
-*> 3000 6000 NS = 128
-*> 6000 infinity NS = 256
-*>
-*> (+) By default some or all matrices of this order
-*> are passed to the implicit double shift routine
-*> DLAHQR and this parameter is ignored. See
-*> ISPEC=12 above and comments in IPARMQ for
-*> details.
-*>
-*> (**) The asterisks (**) indicate an ad-hoc
-*> function of N increasing from 10 to 64.
-*>
-*> ISPEC=16: Select structured matrix multiply.
-*> If the number of simultaneous shifts (specified
-*> by ISPEC=15) is less than 14, then the default
-*> for ISPEC=16 is 0. Otherwise the default for
-*> ISPEC=16 is 2.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-* =====================================================================
- SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
- $ LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
- CHARACTER COMPZ, JOB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . DLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== NL allocates some local workspace to help small matrices
-* . through a rare DLAHQR failure. NL .GT. NTINY = 11 is
-* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom-
-* . mended. (The default value of NMIN is 75.) Using NL = 49
-* . allows up to six simultaneous shifts and a 16-by-16
-* . deflation window. ====
- INTEGER NL
- PARAMETER ( NL = 49 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION HL( NL, NL ), WORKL( NL )
-* ..
-* .. Local Scalars ..
- INTEGER I, KBOT, NMIN
- LOGICAL INITZ, LQUERY, WANTT, WANTZ
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- LOGICAL LSAME
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAHQR, DLAQR0, DLASET, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* ==== Decode and check the input parameters. ====
-*
- WANTT = LSAME( JOB, 'S' )
- INITZ = LSAME( COMPZ, 'I' )
- WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
- WORK( 1 ) = DBLE( MAX( 1, N ) )
- LQUERY = LWORK.EQ.-1
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -5
- ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.NE.0 ) THEN
-*
-* ==== Quick return in case of invalid argument. ====
-*
- CALL XERBLA( 'DHSEQR', -INFO )
- RETURN
-*
- ELSE IF( N.EQ.0 ) THEN
-*
-* ==== Quick return in case N = 0; nothing to do. ====
-*
- RETURN
-*
- ELSE IF( LQUERY ) THEN
-*
-* ==== Quick return in case of a workspace query ====
-*
- CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, WORK, LWORK, INFO )
-* ==== Ensure reported workspace size is backward-compatible with
-* . previous LAPACK versions. ====
- WORK( 1 ) = MAX( DBLE( MAX( 1, N ) ), WORK( 1 ) )
- RETURN
-*
- ELSE
-*
-* ==== copy eigenvalues isolated by DGEBAL ====
-*
- DO 10 I = 1, ILO - 1
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- 10 CONTINUE
- DO 20 I = IHI + 1, N
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- 20 CONTINUE
-*
-* ==== Initialize Z, if requested ====
-*
- IF( INITZ )
- $ CALL DLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
-*
-* ==== Quick return if possible ====
-*
- IF( ILO.EQ.IHI ) THEN
- WR( ILO ) = H( ILO, ILO )
- WI( ILO ) = ZERO
- RETURN
- END IF
-*
-* ==== DLAHQR/DLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'DHSEQR', JOB( : 1 ) // COMPZ( : 1 ), N,
- $ ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== DLAQR0 for big matrices; DLAHQR for small ones ====
-*
- IF( N.GT.NMIN ) THEN
- CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, WORK, LWORK, INFO )
- ELSE
-*
-* ==== Small matrix ====
-*
- CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, INFO )
-*
- IF( INFO.GT.0 ) THEN
-*
-* ==== A rare DLAHQR failure! DLAQR0 sometimes succeeds
-* . when DLAHQR fails. ====
-*
- KBOT = INFO
-*
- IF( N.GE.NL ) THEN
-*
-* ==== Larger matrices have enough subdiagonal scratch
-* . space to call DLAQR0 directly. ====
-*
- CALL DLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, WR,
- $ WI, ILO, IHI, Z, LDZ, WORK, LWORK, INFO )
-*
- ELSE
-*
-* ==== Tiny matrices don't have enough subdiagonal
-* . scratch space to benefit from DLAQR0. Hence,
-* . tiny matrices must be copied into a larger
-* . array before calling DLAQR0. ====
-*
- CALL DLACPY( 'A', N, N, H, LDH, HL, NL )
- HL( N+1, N ) = ZERO
- CALL DLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
- $ NL )
- CALL DLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, WR,
- $ WI, ILO, IHI, Z, LDZ, WORKL, NL, INFO )
- IF( WANTT .OR. INFO.NE.0 )
- $ CALL DLACPY( 'A', N, N, HL, NL, H, LDH )
- END IF
- END IF
- END IF
-*
-* ==== Clear out the trash, if necessary. ====
-*
- IF( ( WANTT .OR. INFO.NE.0 ) .AND. N.GT.2 )
- $ CALL DLASET( 'L', N-2, N-2, ZERO, ZERO, H( 3, 1 ), LDH )
-*
-* ==== Ensure reported workspace size is backward-compatible with
-* . previous LAPACK versions. ====
-*
- WORK( 1 ) = MAX( DBLE( MAX( 1, N ) ), WORK( 1 ) )
- END IF
-*
-* ==== End of DHSEQR ====
-*
- END
diff --git a/netlib/LAPACK/disnan.f b/netlib/LAPACK/disnan.f
deleted file mode 100644
index 355b827..0000000
--- a/netlib/LAPACK/disnan.f
+++ /dev/null
@@ -1,80 +0,0 @@
-*> \brief \b DISNAN tests input for NaN.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DISNAN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/disnan.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/disnan.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/disnan.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION DISNAN( DIN )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION DIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DISNAN returns .TRUE. if its argument is NaN, and .FALSE.
-*> otherwise. To be replaced by the Fortran 2003 intrinsic in the
-*> future.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIN
-*> \verbatim
-*> DIN is DOUBLE PRECISION
-*> Input to test for NaN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION DISNAN( DIN )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION DIN
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL DLAISNAN
- EXTERNAL DLAISNAN
-* ..
-* .. Executable Statements ..
- DISNAN = DLAISNAN(DIN,DIN)
- RETURN
- END
diff --git a/netlib/LAPACK/dla_gbamv.f b/netlib/LAPACK/dla_gbamv.f
deleted file mode 100644
index 4774556..0000000
--- a/netlib/LAPACK/dla_gbamv.f
+++ /dev/null
@@ -1,411 +0,0 @@
-*> \brief \b DLA_GBAMV performs a matrix-vector operation to calculate error bounds.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_GBAMV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gbamv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gbamv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gbamv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
-* INCX, BETA, Y, INCY )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA, BETA
-* INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_GBAMV performs one of the matrix-vector operations
-*>
-*> y := alpha*abs(A)*abs(x) + beta*abs(y),
-*> or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
-*>
-*> where alpha and beta are scalars, x and y are vectors and A is an
-*> m by n matrix.
-*>
-*> This function is primarily used in calculating error bounds.
-*> To protect against underflow during evaluation, components in
-*> the resulting vector are perturbed away from zero by (N+1)
-*> times the underflow threshold. To prevent unnecessarily large
-*> errors for block-structure embedded in general matrices,
-*> "symbolically" zero components are not perturbed. A zero
-*> entry is considered "symbolic" if all multiplications involved
-*> in computing that entry have at least one zero multiplicand.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is INTEGER
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
-*> BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*> BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array of DIMENSION ( LDAB, n )
-*> Before entry, the leading m by n part of the array AB must
-*> contain the matrix of coefficients.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> On entry, LDA specifies the first dimension of AB as declared
-*> in the calling (sub) program. LDAB must be at least
-*> max( 1, m ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension
-*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension
-*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> Unchanged on exit.
-*>
-*> Level 2 Blas routine.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
- $ INCX, BETA, Y, INCY )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA, BETA
- INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL SYMB_ZERO
- DOUBLE PRECISION TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DLAMCH
- DOUBLE PRECISION DLAMCH
-* ..
-* .. External Functions ..
- EXTERNAL ILATRANS
- INTEGER ILATRANS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'C' ) ) ) ) THEN
- INFO = 1
- ELSE IF( M.LT.0 )THEN
- INFO = 2
- ELSE IF( N.LT.0 )THEN
- INFO = 3
- ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
- INFO = 4
- ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
- INFO = 5
- ELSE IF( LDAB.LT.KL+KU+1 )THEN
- INFO = 6
- ELSE IF( INCX.EQ.0 )THEN
- INFO = 8
- ELSE IF( INCY.EQ.0 )THEN
- INFO = 11
- END IF
- IF( INFO.NE.0 )THEN
- CALL XERBLA( 'DLA_GBAMV ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
- $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
- $ RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF( INCX.GT.0 )THEN
- KX = 1
- ELSE
- KX = 1 - ( LENX - 1 )*INCX
- END IF
- IF( INCY.GT.0 )THEN
- KY = 1
- ELSE
- KY = 1 - ( LENY - 1 )*INCY
- END IF
-*
-* Set SAFE1 essentially to be the underflow threshold times the
-* number of additions in each row.
-*
- SAFE1 = DLAMCH( 'Safe minimum' )
- SAFE1 = (N+1)*SAFE1
-*
-* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
-*
-* The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
-* the inexact flag. Still doesn't help change the iteration order
-* to per-column.
-*
- KD = KU + 1
- KE = KL + 1
- IY = KY
- IF ( INCX.EQ.1 ) THEN
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KD+I-J, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KE-I+J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
- IY = IY + INCY
- END DO
- END IF
- ELSE
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KD+I-J, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KE-I+J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
-
- END IF
-*
- RETURN
-*
-* End of DLA_GBAMV
-*
- END
diff --git a/netlib/LAPACK/dla_gbrcond.f b/netlib/LAPACK/dla_gbrcond.f
deleted file mode 100644
index 9c52475..0000000
--- a/netlib/LAPACK/dla_gbrcond.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b DLA_GBRCOND estimates the Skeel condition number for a general banded matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_GBRCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gbrcond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gbrcond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gbrcond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB,
-* AFB, LDAFB, IPIV, CMODE, C,
-* INFO, WORK, IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER N, LDAB, LDAFB, INFO, KL, KU, CMODE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * ), IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ),
-* $ C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_GBRCOND Estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate Transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from the factorization A = P*L*U
-*> as computed by DGBTRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (5*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB,
- $ AFB, LDAFB, IPIV, CMODE, C,
- $ INFO, WORK, IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER N, LDAB, LDAFB, INFO, KL, KU, CMODE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * ), IPIV( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ),
- $ C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRANS
- INTEGER KASE, I, J, KD, KE
- DOUBLE PRECISION AINVNM, TMP
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DGBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- DLA_GBRCOND = 0.0D+0
-*
- INFO = 0
- NOTRANS = LSAME( TRANS, 'N' )
- IF ( .NOT. NOTRANS .AND. .NOT. LSAME(TRANS, 'T')
- $ .AND. .NOT. LSAME(TRANS, 'C') ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLA_GBRCOND', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 ) THEN
- DLA_GBRCOND = 1.0D+0
- RETURN
- END IF
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- KD = KU + 1
- KE = KL + 1
- IF ( NOTRANS ) THEN
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KD+I-J, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KD+I-J, J ) )
- END DO
- ELSE
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KD+I-J, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KE-I+J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KE-I+J, I ) )
- END DO
- ELSE
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KE-I+J, I ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- END IF
-*
-* Estimate the norm of inv(op(A)).
-*
- AINVNM = 0.0D+0
-
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
-
- IF ( NOTRANS ) THEN
- CALL DGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB,
- $ IPIV, WORK, N, INFO )
- ELSE
- CALL DGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK, N, INFO )
- END IF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF ( NOTRANS ) THEN
- CALL DGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK, N, INFO )
- ELSE
- CALL DGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB,
- $ IPIV, WORK, N, INFO )
- END IF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0D+0 )
- $ DLA_GBRCOND = ( 1.0D+0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/dla_gbrpvgrw.f b/netlib/LAPACK/dla_gbrpvgrw.f
deleted file mode 100644
index c446687..0000000
--- a/netlib/LAPACK/dla_gbrpvgrw.f
+++ /dev/null
@@ -1,160 +0,0 @@
-*> \brief \b DLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_GBRPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gbrpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gbrpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gbrpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_GBRPVGRW( N, KL, KU, NCOLS, AB,
-* LDAB, AFB, LDAFB )
-*
-* .. Scalar Arguments ..
-* INTEGER N, KL, KU, NCOLS, LDAB, LDAFB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_GBRPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCOLS
-*> \verbatim
-*> NCOLS is INTEGER
-*> The number of columns of the matrix A. NCOLS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_GBRPVGRW( N, KL, KU, NCOLS, AB,
- $ LDAB, AFB, LDAFB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, KL, KU, NCOLS, LDAB, LDAFB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J, KD
- DOUBLE PRECISION AMAX, UMAX, RPVGRW
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- RPVGRW = 1.0D+0
-
- KD = KU + 1
- DO J = 1, NCOLS
- AMAX = 0.0D+0
- UMAX = 0.0D+0
- DO I = MAX( J-KU, 1 ), MIN( J+KL, N )
- AMAX = MAX( ABS( AB( KD+I-J, J)), AMAX )
- END DO
- DO I = MAX( J-KU, 1 ), J
- UMAX = MAX( ABS( AFB( KD+I-J, J ) ), UMAX )
- END DO
- IF ( UMAX /= 0.0D+0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- DLA_GBRPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/dla_geamv.f b/netlib/LAPACK/dla_geamv.f
deleted file mode 100644
index 1c97dcb..0000000
--- a/netlib/LAPACK/dla_geamv.f
+++ /dev/null
@@ -1,396 +0,0 @@
-*> \brief \b DLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_GEAMV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_geamv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_geamv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_geamv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
-* Y, INCY )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA, BETA
-* INTEGER INCX, INCY, LDA, M, N, TRANS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_GEAMV performs one of the matrix-vector operations
-*>
-*> y := alpha*abs(A)*abs(x) + beta*abs(y),
-*> or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
-*>
-*> where alpha and beta are scalars, x and y are vectors and A is an
-*> m by n matrix.
-*>
-*> This function is primarily used in calculating error bounds.
-*> To protect against underflow during evaluation, components in
-*> the resulting vector are perturbed away from zero by (N+1)
-*> times the underflow threshold. To prevent unnecessarily large
-*> errors for block-structure embedded in general matrices,
-*> "symbolically" zero components are not perturbed. A zero
-*> entry is considered "symbolic" if all multiplications involved
-*> in computing that entry have at least one zero multiplicand.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is INTEGER
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
-*> BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*> BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n )
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, m ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension
-*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION
-*> Array of DIMENSION at least
-*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> Unchanged on exit.
-*>
-*> Level 2 Blas routine.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
- $ Y, INCY )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA, BETA
- INTEGER INCX, INCY, LDA, M, N, TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL SYMB_ZERO
- DOUBLE PRECISION TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DLAMCH
- DOUBLE PRECISION DLAMCH
-* ..
-* .. External Functions ..
- EXTERNAL ILATRANS
- INTEGER ILATRANS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'C' )) ) ) THEN
- INFO = 1
- ELSE IF( M.LT.0 )THEN
- INFO = 2
- ELSE IF( N.LT.0 )THEN
- INFO = 3
- ELSE IF( LDA.LT.MAX( 1, M ) )THEN
- INFO = 6
- ELSE IF( INCX.EQ.0 )THEN
- INFO = 8
- ELSE IF( INCY.EQ.0 )THEN
- INFO = 11
- END IF
- IF( INFO.NE.0 )THEN
- CALL XERBLA( 'DLA_GEAMV ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
- $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
- $ RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF( INCX.GT.0 )THEN
- KX = 1
- ELSE
- KX = 1 - ( LENX - 1 )*INCX
- END IF
- IF( INCY.GT.0 )THEN
- KY = 1
- ELSE
- KY = 1 - ( LENY - 1 )*INCY
- END IF
-*
-* Set SAFE1 essentially to be the underflow threshold times the
-* number of additions in each row.
-*
- SAFE1 = DLAMCH( 'Safe minimum' )
- SAFE1 = (N+1)*SAFE1
-*
-* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
-*
-* The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
-* the inexact flag. Still doesn't help change the iteration order
-* to per-column.
-*
- IY = KY
- IF ( INCX.EQ.1 ) THEN
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, LENX
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, LENX
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
- ELSE
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = 1, LENX
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF (.NOT.SYMB_ZERO)
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = 1, LENX
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF (.NOT.SYMB_ZERO)
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
-
- END IF
-*
- RETURN
-*
-* End of DLA_GEAMV
-*
- END
diff --git a/netlib/LAPACK/dla_gercond.f b/netlib/LAPACK/dla_gercond.f
deleted file mode 100644
index c8092e0..0000000
--- a/netlib/LAPACK/dla_gercond.f
+++ /dev/null
@@ -1,329 +0,0 @@
-*> \brief \b DLA_GERCOND estimates the Skeel condition number for a general matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_GERCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gercond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gercond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gercond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_GERCOND ( TRANS, N, A, LDA, AF,
-* LDAF, IPIV, CMODE, C,
-* INFO, WORK, IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ),
-* $ C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_GERCOND estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate Transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The factors L and U from the factorization
-*> A = P*L*U as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from the factorization A = P*L*U
-*> as computed by DGETRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_GERCOND ( TRANS, N, A, LDA, AF,
- $ LDAF, IPIV, CMODE, C,
- $ INFO, WORK, IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ),
- $ C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRANS
- INTEGER KASE, I, J
- DOUBLE PRECISION AINVNM, TMP
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DGETRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- DLA_GERCOND = 0.0D+0
-*
- INFO = 0
- NOTRANS = LSAME( TRANS, 'N' )
- IF ( .NOT. NOTRANS .AND. .NOT. LSAME(TRANS, 'T')
- $ .AND. .NOT. LSAME(TRANS, 'C') ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLA_GERCOND', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 ) THEN
- DLA_GERCOND = 1.0D+0
- RETURN
- END IF
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- IF (NOTRANS) THEN
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( I, J ) )
- END DO
- ELSE
- DO J = 1, N
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( J, I ) )
- END DO
- ELSE
- DO J = 1, N
- TMP = TMP + ABS( A( J, I ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- END IF
-*
-* Estimate the norm of inv(op(A)).
-*
- AINVNM = 0.0D+0
-
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK(I) = WORK(I) * WORK(2*N+I)
- END DO
-
- IF (NOTRANS) THEN
- CALL DGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- ELSE
- CALL DGETRS( 'Transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- END IF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF (NOTRANS) THEN
- CALL DGETRS( 'Transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- ELSE
- CALL DGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- END IF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0D+0 )
- $ DLA_GERCOND = ( 1.0D+0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/dla_gerpvgrw.f b/netlib/LAPACK/dla_gerpvgrw.f
deleted file mode 100644
index fe57be3..0000000
--- a/netlib/LAPACK/dla_gerpvgrw.f
+++ /dev/null
@@ -1,142 +0,0 @@
-*> \brief \b DLA_GERPVGRW
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_GERPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gerpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gerpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gerpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_GERPVGRW( N, NCOLS, A, LDA, AF,
-* LDAF )
-*
-* .. Scalar Arguments ..
-* INTEGER N, NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*>
-*> DLA_GERPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCOLS
-*> \verbatim
-*> NCOLS is INTEGER
-*> The number of columns of the matrix A. NCOLS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The factors L and U from the factorization
-*> A = P*L*U as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_GERPVGRW( N, NCOLS, A, LDA, AF,
- $ LDAF )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER N, NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION AMAX, UMAX, RPVGRW
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- RPVGRW = 1.0D+0
-
- DO J = 1, NCOLS
- AMAX = 0.0D+0
- UMAX = 0.0D+0
- DO I = 1, N
- AMAX = MAX( ABS( A( I, J ) ), AMAX )
- END DO
- DO I = 1, J
- UMAX = MAX( ABS( AF( I, J ) ), UMAX )
- END DO
- IF ( UMAX /= 0.0D+0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- DLA_GERPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/dla_lin_berr.f b/netlib/LAPACK/dla_lin_berr.f
deleted file mode 100644
index 7f2e825..0000000
--- a/netlib/LAPACK/dla_lin_berr.f
+++ /dev/null
@@ -1,153 +0,0 @@
-*> \brief \b DLA_LIN_BERR computes a component-wise relative backward error.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_LIN_BERR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_lin_berr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_lin_berr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_lin_berr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR )
-*
-* .. Scalar Arguments ..
-* INTEGER N, NZ, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AYB( N, NRHS ), BERR( NRHS )
-* DOUBLE PRECISION RES( N, NRHS )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_LIN_BERR computes component-wise relative backward error from
-*> the formula
-*> max(i) ( abs(R(i)) / ( abs(op(A_s))*abs(Y) + abs(B_s) )(i) )
-*> where abs(Z) is the component-wise absolute value of the matrix
-*> or vector Z.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NZ
-*> \verbatim
-*> NZ is INTEGER
-*> We add (NZ+1)*SLAMCH( 'Safe minimum' ) to R(i) in the numerator to
-*> guard against spuriously zero residuals. Default value is N.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices AYB, RES, and BERR. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] RES
-*> \verbatim
-*> RES is DOUBLE PRECISION array, dimension (N,NRHS)
-*> The residual matrix, i.e., the matrix R in the relative backward
-*> error formula above.
-*> \endverbatim
-*>
-*> \param[in] AYB
-*> \verbatim
-*> AYB is DOUBLE PRECISION array, dimension (N, NRHS)
-*> The denominator in the relative backward error formula above, i.e.,
-*> the matrix abs(op(A_s))*abs(Y) + abs(B_s). The matrices A, Y, and B
-*> are from iterative refinement (see dla_gerfsx_extended.f).
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The component-wise relative backward error from the formula above.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, NZ, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AYB( N, NRHS ), BERR( NRHS )
- DOUBLE PRECISION RES( N, NRHS )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION TMP
- INTEGER I, J
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- EXTERNAL DLAMCH
- DOUBLE PRECISION DLAMCH
- DOUBLE PRECISION SAFE1
-* ..
-* .. Executable Statements ..
-*
-* Adding SAFE1 to the numerator guards against spuriously zero
-* residuals. A similar safeguard is in the SLA_yyAMV routine used
-* to compute AYB.
-*
- SAFE1 = DLAMCH( 'Safe minimum' )
- SAFE1 = (NZ+1)*SAFE1
-
- DO J = 1, NRHS
- BERR(J) = 0.0D+0
- DO I = 1, N
- IF (AYB(I,J) .NE. 0.0D+0) THEN
- TMP = (SAFE1+ABS(RES(I,J)))/AYB(I,J)
- BERR(J) = MAX( BERR(J), TMP )
- END IF
-*
-* If AYB is exactly 0.0 (and if computed by SLA_yyAMV), then we know
-* the true residual also must be exactly 0.0.
-*
- END DO
- END DO
- END
diff --git a/netlib/LAPACK/dla_porcond.f b/netlib/LAPACK/dla_porcond.f
deleted file mode 100644
index 08e755f..0000000
--- a/netlib/LAPACK/dla_porcond.f
+++ /dev/null
@@ -1,329 +0,0 @@
-*> \brief \b DLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_PORCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_porcond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_porcond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_porcond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_PORCOND( UPLO, N, A, LDA, AF, LDAF,
-* CMODE, C, INFO, WORK,
-* IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER N, LDA, LDAF, INFO, CMODE
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ),
-* $ C( * )
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_PORCOND Estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_PORCOND( UPLO, N, A, LDA, AF, LDAF,
- $ CMODE, C, INFO, WORK,
- $ IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER N, LDA, LDAF, INFO, CMODE
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ),
- $ C( * )
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER KASE, I, J
- DOUBLE PRECISION AINVNM, TMP
- LOGICAL UP
-* ..
-* .. Array Arguments ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- EXTERNAL LSAME, IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DPOTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- DLA_PORCOND = 0.0D+0
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLA_PORCOND', -INFO )
- RETURN
- END IF
-
- IF( N.EQ.0 ) THEN
- DLA_PORCOND = 1.0D+0
- RETURN
- END IF
- UP = .FALSE.
- IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- IF ( UP ) THEN
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( J ,I ) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ENDIF
-*
-* Estimate the norm of inv(op(A)).
-*
- AINVNM = 0.0D+0
-
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
-
- IF (UP) THEN
- CALL DPOTRS( 'Upper', N, 1, AF, LDAF, WORK, N, INFO )
- ELSE
- CALL DPOTRS( 'Lower', N, 1, AF, LDAF, WORK, N, INFO )
- ENDIF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF ( UP ) THEN
- CALL DPOTRS( 'Upper', N, 1, AF, LDAF, WORK, N, INFO )
- ELSE
- CALL DPOTRS( 'Lower', N, 1, AF, LDAF, WORK, N, INFO )
- ENDIF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0D+0 )
- $ DLA_PORCOND = ( 1.0D+0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/dla_porpvgrw.f b/netlib/LAPACK/dla_porpvgrw.f
deleted file mode 100644
index 3aee98d..0000000
--- a/netlib/LAPACK/dla_porpvgrw.f
+++ /dev/null
@@ -1,210 +0,0 @@
-*> \brief \b DLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_PORPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_porpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_porpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_porpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF,
-* LDAF, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER*1 UPLO
-* INTEGER NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*>
-*> DLA_PORPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] NCOLS
-*> \verbatim
-*> NCOLS is INTEGER
-*> The number of columns of the matrix A. NCOLS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF,
- $ LDAF, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER*1 UPLO
- INTEGER NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION AMAX, UMAX, RPVGRW
- LOGICAL UPPER
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- EXTERNAL LSAME, DLASET
- LOGICAL LSAME
-* ..
-* .. Executable Statements ..
-*
- UPPER = LSAME( 'Upper', UPLO )
-*
-* DPOTRF will have factored only the NCOLSxNCOLS leading minor, so
-* we restrict the growth search to that minor and use only the first
-* 2*NCOLS workspace entries.
-*
- RPVGRW = 1.0D+0
- DO I = 1, 2*NCOLS
- WORK( I ) = 0.0D+0
- END DO
-*
-* Find the max magnitude entry of each column.
-*
- IF ( UPPER ) THEN
- DO J = 1, NCOLS
- DO I = 1, J
- WORK( NCOLS+J ) =
- $ MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
- END DO
- END DO
- ELSE
- DO J = 1, NCOLS
- DO I = J, NCOLS
- WORK( NCOLS+J ) =
- $ MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
- END DO
- END DO
- END IF
-*
-* Now find the max magnitude entry of each column of the factor in
-* AF. No pivoting, so no permutations.
-*
- IF ( LSAME( 'Upper', UPLO ) ) THEN
- DO J = 1, NCOLS
- DO I = 1, J
- WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
- END DO
- END DO
- ELSE
- DO J = 1, NCOLS
- DO I = J, NCOLS
- WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
- END DO
- END DO
- END IF
-*
-* Compute the *inverse* of the max element growth factor. Dividing
-* by zero would imply the largest entry of the factor's column is
-* zero. Than can happen when either the column of A is zero or
-* massive pivots made the factor underflow to zero. Neither counts
-* as growth in itself, so simply ignore terms with zero
-* denominators.
-*
- IF ( LSAME( 'Upper', UPLO ) ) THEN
- DO I = 1, NCOLS
- UMAX = WORK( I )
- AMAX = WORK( NCOLS+I )
- IF ( UMAX /= 0.0D+0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- ELSE
- DO I = 1, NCOLS
- UMAX = WORK( I )
- AMAX = WORK( NCOLS+I )
- IF ( UMAX /= 0.0D+0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- END IF
-
- DLA_PORPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/dla_syamv.f b/netlib/LAPACK/dla_syamv.f
deleted file mode 100644
index f1ee81a..0000000
--- a/netlib/LAPACK/dla_syamv.f
+++ /dev/null
@@ -1,417 +0,0 @@
-*> \brief \b DLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_SYAMV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_syamv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_syamv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_syamv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
-* INCY )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA, BETA
-* INTEGER INCX, INCY, LDA, N, UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_SYAMV performs the matrix-vector operation
-*>
-*> y := alpha*abs(A)*abs(x) + beta*abs(y),
-*>
-*> where alpha and beta are scalars, x and y are vectors and A is an
-*> n by n symmetric matrix.
-*>
-*> This function is primarily used in calculating error bounds.
-*> To protect against underflow during evaluation, components in
-*> the resulting vector are perturbed away from zero by (N+1)
-*> times the underflow threshold. To prevent unnecessarily large
-*> errors for block-structure embedded in general matrices,
-*> "symbolically" zero components are not perturbed. A zero
-*> entry is considered "symbolic" if all multiplications involved
-*> in computing that entry have at least one zero multiplicand.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is INTEGER
-*> On entry, UPLO specifies whether the upper or lower
-*> triangular part of the array A is to be referenced as
-*> follows:
-*>
-*> UPLO = BLAS_UPPER Only the upper triangular part of A
-*> is to be referenced.
-*>
-*> UPLO = BLAS_LOWER Only the lower triangular part of A
-*> is to be referenced.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION .
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, n ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension
-*> ( 1 + ( n - 1 )*abs( INCX ) )
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION .
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension
-*> ( 1 + ( n - 1 )*abs( INCY ) )
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> -- Modified for the absolute-value product, April 2006
-*> Jason Riedy, UC Berkeley
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
- $ INCY )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA, BETA
- INTEGER INCX, INCY, LDA, N, UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL SYMB_ZERO
- DOUBLE PRECISION TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DLAMCH
- DOUBLE PRECISION DLAMCH
-* ..
-* .. External Functions ..
- EXTERNAL ILAUPLO
- INTEGER ILAUPLO
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ( UPLO.NE.ILAUPLO( 'U' ) .AND.
- $ UPLO.NE.ILAUPLO( 'L' ) ) THEN
- INFO = 1
- ELSE IF( N.LT.0 )THEN
- INFO = 2
- ELSE IF( LDA.LT.MAX( 1, N ) )THEN
- INFO = 5
- ELSE IF( INCX.EQ.0 )THEN
- INFO = 7
- ELSE IF( INCY.EQ.0 )THEN
- INFO = 10
- END IF
- IF( INFO.NE.0 )THEN
- CALL XERBLA( 'DSYMV ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
- $ RETURN
-*
-* Set up the start points in X and Y.
-*
- IF( INCX.GT.0 )THEN
- KX = 1
- ELSE
- KX = 1 - ( N - 1 )*INCX
- END IF
- IF( INCY.GT.0 )THEN
- KY = 1
- ELSE
- KY = 1 - ( N - 1 )*INCY
- END IF
-*
-* Set SAFE1 essentially to be the underflow threshold times the
-* number of additions in each row.
-*
- SAFE1 = DLAMCH( 'Safe minimum' )
- SAFE1 = (N+1)*SAFE1
-*
-* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
-*
-* The O(N^2) SYMB_ZERO tests could be replaced by O(N) queries to
-* the inexact flag. Still doesn't help change the iteration order
-* to per-column.
-*
- IY = KY
- IF ( INCX.EQ.1 ) THEN
- IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- DO J = I+1, N
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- DO J = I+1, N
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
- ELSE
- IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- JX = KX
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- DO J = I+1, N
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0D+0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- JX = KX
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- DO J = I+1, N
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
-
- END IF
-*
- RETURN
-*
-* End of DLA_SYAMV
-*
- END
diff --git a/netlib/LAPACK/dla_syrcond.f b/netlib/LAPACK/dla_syrcond.f
deleted file mode 100644
index 03e075a..0000000
--- a/netlib/LAPACK/dla_syrcond.f
+++ /dev/null
@@ -1,342 +0,0 @@
-*> \brief \b DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_SYRCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_syrcond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_syrcond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_syrcond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF,
-* IPIV, CMODE, C, INFO, WORK,
-* IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments
-* INTEGER IWORK( * ), IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ), C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_SYRCOND estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF,
- $ IPIV, CMODE, C, INFO, WORK,
- $ IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments
- INTEGER IWORK( * ), IPIV( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ), C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- CHARACTER NORMIN
- INTEGER KASE, I, J
- DOUBLE PRECISION AINVNM, SMLNUM, TMP
- LOGICAL UP
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATRS, DRSCL, XERBLA, DSYTRS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- DLA_SYRCOND = 0.0D+0
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLA_SYRCOND', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 ) THEN
- DLA_SYRCOND = 1.0D+0
- RETURN
- END IF
- UP = .FALSE.
- IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- IF ( UP ) THEN
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0D+0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( I, J) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ENDIF
-*
-* Estimate the norm of inv(op(A)).
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
- AINVNM = 0.0D+0
- NORMIN = 'N'
-
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
-
- IF ( UP ) THEN
- CALL DSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ELSE
- CALL DSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ENDIF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF ( UP ) THEN
- CALL DSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ELSE
- CALL DSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ENDIF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
-*
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0D+0 )
- $ DLA_SYRCOND = ( 1.0D+0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/dla_syrpvgrw.f b/netlib/LAPACK/dla_syrpvgrw.f
deleted file mode 100644
index 45cfb44..0000000
--- a/netlib/LAPACK/dla_syrpvgrw.f
+++ /dev/null
@@ -1,320 +0,0 @@
-*> \brief \b DLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_SYRPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_syrpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_syrpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_syrpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF,
-* LDAF, IPIV, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER*1 UPLO
-* INTEGER N, INFO, LDA, LDAF
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*>
-*> DLA_SYRPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> The value of INFO returned from DSYTRF, .i.e., the pivot in
-*> column INFO is exactly 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF,
- $ LDAF, IPIV, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER*1 UPLO
- INTEGER N, INFO, LDA, LDAF
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER NCOLS, I, J, K, KP
- DOUBLE PRECISION AMAX, UMAX, RPVGRW, TMP
- LOGICAL UPPER
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- EXTERNAL LSAME, DLASET
- LOGICAL LSAME
-* ..
-* .. Executable Statements ..
-*
- UPPER = LSAME( 'Upper', UPLO )
- IF ( INFO.EQ.0 ) THEN
- IF ( UPPER ) THEN
- NCOLS = 1
- ELSE
- NCOLS = N
- END IF
- ELSE
- NCOLS = INFO
- END IF
-
- RPVGRW = 1.0D+0
- DO I = 1, 2*N
- WORK( I ) = 0.0D+0
- END DO
-*
-* Find the max magnitude entry of each column of A. Compute the max
-* for all N columns so we can apply the pivot permutation while
-* looping below. Assume a full factorization is the common case.
-*
- IF ( UPPER ) THEN
- DO J = 1, N
- DO I = 1, J
- WORK( N+I ) = MAX( ABS( A( I, J ) ), WORK( N+I ) )
- WORK( N+J ) = MAX( ABS( A( I, J ) ), WORK( N+J ) )
- END DO
- END DO
- ELSE
- DO J = 1, N
- DO I = J, N
- WORK( N+I ) = MAX( ABS( A( I, J ) ), WORK( N+I ) )
- WORK( N+J ) = MAX( ABS( A( I, J ) ), WORK( N+J ) )
- END DO
- END DO
- END IF
-*
-* Now find the max magnitude entry of each column of U or L. Also
-* permute the magnitudes of A above so they're in the same order as
-* the factor.
-*
-* The iteration orders and permutations were copied from dsytrs.
-* Calls to SSWAP would be severe overkill.
-*
- IF ( UPPER ) THEN
- K = N
- DO WHILE ( K .LT. NCOLS .AND. K.GT.0 )
- IF ( IPIV( K ).GT.0 ) THEN
-! 1x1 pivot
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- DO I = 1, K
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- END DO
- K = K - 1
- ELSE
-! 2x2 pivot
- KP = -IPIV( K )
- TMP = WORK( N+K-1 )
- WORK( N+K-1 ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- DO I = 1, K-1
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- WORK( K-1 ) = MAX( ABS( AF( I, K-1 ) ), WORK( K-1 ) )
- END DO
- WORK( K ) = MAX( ABS( AF( K, K ) ), WORK( K ) )
- K = K - 2
- END IF
- END DO
- K = NCOLS
- DO WHILE ( K .LE. N )
- IF ( IPIV( K ).GT.0 ) THEN
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- K = K + 1
- ELSE
- KP = -IPIV( K )
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- K = K + 2
- END IF
- END DO
- ELSE
- K = 1
- DO WHILE ( K .LE. NCOLS )
- IF ( IPIV( K ).GT.0 ) THEN
-! 1x1 pivot
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- DO I = K, N
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- END DO
- K = K + 1
- ELSE
-! 2x2 pivot
- KP = -IPIV( K )
- TMP = WORK( N+K+1 )
- WORK( N+K+1 ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- DO I = K+1, N
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- WORK( K+1 ) = MAX( ABS( AF(I, K+1 ) ), WORK( K+1 ) )
- END DO
- WORK( K ) = MAX( ABS( AF( K, K ) ), WORK( K ) )
- K = K + 2
- END IF
- END DO
- K = NCOLS
- DO WHILE ( K .GE. 1 )
- IF ( IPIV( K ).GT.0 ) THEN
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- K = K - 1
- ELSE
- KP = -IPIV( K )
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- K = K - 2
- ENDIF
- END DO
- END IF
-*
-* Compute the *inverse* of the max element growth factor. Dividing
-* by zero would imply the largest entry of the factor's column is
-* zero. Than can happen when either the column of A is zero or
-* massive pivots made the factor underflow to zero. Neither counts
-* as growth in itself, so simply ignore terms with zero
-* denominators.
-*
- IF ( UPPER ) THEN
- DO I = NCOLS, N
- UMAX = WORK( I )
- AMAX = WORK( N+I )
- IF ( UMAX /= 0.0D+0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- ELSE
- DO I = 1, NCOLS
- UMAX = WORK( I )
- AMAX = WORK( N+I )
- IF ( UMAX /= 0.0D+0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- END IF
-
- DLA_SYRPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/dla_wwaddw.f b/netlib/LAPACK/dla_wwaddw.f
deleted file mode 100644
index 6b75095..0000000
--- a/netlib/LAPACK/dla_wwaddw.f
+++ /dev/null
@@ -1,111 +0,0 @@
-*> \brief \b DLA_WWADDW adds a vector into a doubled-single vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLA_WWADDW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_wwaddw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_wwaddw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_wwaddw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLA_WWADDW( N, X, Y, W )
-*
-* .. Scalar Arguments ..
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * ), Y( * ), W( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLA_WWADDW adds a vector W into a doubled-single vector (X, Y).
-*>
-*> This works for all extant IBM's hex and binary floating point
-*> arithmetics, but not for decimal.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of vectors X, Y, and W.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> The first part of the doubled-single accumulation vector.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (N)
-*> The second part of the doubled-single accumulation vector.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The vector to be added.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLA_WWADDW( N, X, Y, W )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * ), Y( * ), W( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION S
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
- DO 10 I = 1, N
- S = X(I) + W(I)
- S = (S + S) - S
- Y(I) = ((X(I) - S) + W(I)) + Y(I)
- X(I) = S
- 10 CONTINUE
- RETURN
- END
diff --git a/netlib/LAPACK/dlabad.f b/netlib/LAPACK/dlabad.f
deleted file mode 100644
index 9eda3c9..0000000
--- a/netlib/LAPACK/dlabad.f
+++ /dev/null
@@ -1,105 +0,0 @@
-*> \brief \b DLABAD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLABAD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlabad.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlabad.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlabad.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLABAD( SMALL, LARGE )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION LARGE, SMALL
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLABAD takes as input the values computed by DLAMCH for underflow and
-*> overflow, and returns the square root of each of these values if the
-*> log of LARGE is sufficiently large. This subroutine is intended to
-*> identify machines with a large exponent range, such as the Crays, and
-*> redefine the underflow and overflow limits to be the square roots of
-*> the values computed by DLAMCH. This subroutine is needed because
-*> DLAMCH does not compensate for poor arithmetic in the upper half of
-*> the exponent range, as is found on a Cray.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] SMALL
-*> \verbatim
-*> SMALL is DOUBLE PRECISION
-*> On entry, the underflow threshold as computed by DLAMCH.
-*> On exit, if LOG10(LARGE) is sufficiently large, the square
-*> root of SMALL, otherwise unchanged.
-*> \endverbatim
-*>
-*> \param[in,out] LARGE
-*> \verbatim
-*> LARGE is DOUBLE PRECISION
-*> On entry, the overflow threshold as computed by DLAMCH.
-*> On exit, if LOG10(LARGE) is sufficiently large, the square
-*> root of LARGE, otherwise unchanged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLABAD( SMALL, LARGE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION LARGE, SMALL
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC LOG10, SQRT
-* ..
-* .. Executable Statements ..
-*
-* If it looks like we're on a Cray, take the square root of
-* SMALL and LARGE to avoid overflow and underflow problems.
-*
- IF( LOG10( LARGE ).GT.2000.D0 ) THEN
- SMALL = SQRT( SMALL )
- LARGE = SQRT( LARGE )
- END IF
-*
- RETURN
-*
-* End of DLABAD
-*
- END
diff --git a/netlib/LAPACK/dlabrd.f b/netlib/LAPACK/dlabrd.f
deleted file mode 100644
index 72d1481..0000000
--- a/netlib/LAPACK/dlabrd.f
+++ /dev/null
@@ -1,381 +0,0 @@
-*> \brief \b DLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLABRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlabrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlabrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlabrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
-* LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDX, LDY, M, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLABRD reduces the first NB rows and columns of a real general
-*> m by n matrix A to upper or lower bidiagonal form by an orthogonal
-*> transformation Q**T * A * P, and returns the matrices X and Y which
-*> are needed to apply the transformation to the unreduced part of A.
-*>
-*> If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
-*> bidiagonal form.
-*>
-*> This is an auxiliary routine called by DGEBRD
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of leading rows and columns of A to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n general matrix to be reduced.
-*> On exit, the first NB rows and columns of the matrix are
-*> overwritten; the rest of the array is unchanged.
-*> If m >= n, elements on and below the diagonal in the first NB
-*> columns, with the array TAUQ, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; and
-*> elements above the diagonal in the first NB rows, with the
-*> array TAUP, represent the orthogonal matrix P as a product
-*> of elementary reflectors.
-*> If m < n, elements below the diagonal in the first NB
-*> columns, with the array TAUQ, represent the orthogonal
-*> matrix Q as a product of elementary reflectors, and
-*> elements on and above the diagonal in the first NB rows,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (NB)
-*> The diagonal elements of the first NB rows and columns of
-*> the reduced matrix. D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (NB)
-*> The off-diagonal elements of the first NB rows and columns of
-*> the reduced matrix.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (NB)
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is DOUBLE PRECISION array, dimension (NB)
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NB)
-*> The m-by-nb matrix X required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (LDY,NB)
-*> The n-by-nb matrix Y required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors.
-*>
-*> If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
-*> A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
-*> A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
-*> A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
-*> A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The elements of the vectors v and u together form the m-by-nb matrix
-*> V and the nb-by-n matrix U**T which are needed, with X and Y, to apply
-*> the transformation to the unreduced part of the matrix, using a block
-*> update of the form: A := A - V*Y**T - X*U**T.
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with nb = 2:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
-*> ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
-*> ( v1 v2 a a a ) ( v1 1 a a a a )
-*> ( v1 v2 a a a ) ( v1 v2 a a a a )
-*> ( v1 v2 a a a ) ( v1 v2 a a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix which is unchanged,
-*> vi denotes an element of the vector defining H(i), and ui an element
-*> of the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
- $ LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDX, LDY, M, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DLARFG, DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
- IF( M.GE.N ) THEN
-*
-* Reduce to upper bidiagonal form
-*
- DO 10 I = 1, NB
-*
-* Update A(i:m,i)
-*
- CALL DGEMV( 'No transpose', M-I+1, I-1, -ONE, A( I, 1 ),
- $ LDA, Y( I, 1 ), LDY, ONE, A( I, I ), 1 )
- CALL DGEMV( 'No transpose', M-I+1, I-1, -ONE, X( I, 1 ),
- $ LDX, A( 1, I ), 1, ONE, A( I, I ), 1 )
-*
-* Generate reflection Q(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAUQ( I ) )
- D( I ) = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = ONE
-*
-* Compute Y(i+1:n,i)
-*
- CALL DGEMV( 'Transpose', M-I+1, N-I, ONE, A( I, I+1 ),
- $ LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), LDA,
- $ A( I, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
- $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), LDX,
- $ A( I, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
- $ LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-*
-* Update A(i,i+1:n)
-*
- CALL DGEMV( 'No transpose', N-I, I, -ONE, Y( I+1, 1 ),
- $ LDY, A( I, 1 ), LDA, ONE, A( I, I+1 ), LDA )
- CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
- $ LDA, X( I, 1 ), LDX, ONE, A( I, I+1 ), LDA )
-*
-* Generate reflection P(i) to annihilate A(i,i+2:n)
-*
- CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
- $ LDA, TAUP( I ) )
- E( I ) = A( I, I+1 )
- A( I, I+1 ) = ONE
-*
-* Compute X(i+1:m,i)
-*
- CALL DGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), LDY,
- $ A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ),
- $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
- $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Reduce to lower bidiagonal form
-*
- DO 20 I = 1, NB
-*
-* Update A(i,i:n)
-*
- CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ),
- $ LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA )
- CALL DGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), LDA,
- $ X( I, 1 ), LDX, ONE, A( I, I ), LDA )
-*
-* Generate reflection P(i) to annihilate A(i,i+1:n)
-*
- CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAUP( I ) )
- D( I ) = A( I, I )
- IF( I.LT.M ) THEN
- A( I, I ) = ONE
-*
-* Compute X(i+1:m,i)
-*
- CALL DGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ),
- $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), LDY,
- $ A( I, I ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ),
- $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
- $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-*
-* Update A(i+1:m,i)
-*
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ),
- $ LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
-*
-* Generate reflection Q(i) to annihilate A(i+2:m,i)
-*
- CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
- $ TAUQ( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Compute Y(i+1:n,i)
-*
- CALL DGEMV( 'Transpose', M-I, N-I, ONE, A( I+1, I+1 ),
- $ LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
- $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), LDX,
- $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), LDA,
- $ Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DLABRD
-*
- END
diff --git a/netlib/LAPACK/dlacn2.f b/netlib/LAPACK/dlacn2.f
deleted file mode 100644
index 9dd3c85..0000000
--- a/netlib/LAPACK/dlacn2.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLACN2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacn2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacn2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacn2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-* .. Scalar Arguments ..
-* INTEGER KASE, N
-* DOUBLE PRECISION EST
-* ..
-* .. Array Arguments ..
-* INTEGER ISGN( * ), ISAVE( 3 )
-* DOUBLE PRECISION V( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLACN2 estimates the 1-norm of a square, real matrix A.
-*> Reverse communication is used for evaluating matrix-vector products.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 1.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (N)
-*> On the final return, V = A*W, where EST = norm(V)/norm(W)
-*> (W is not returned).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On an intermediate return, X should be overwritten by
-*> A * X, if KASE=1,
-*> A**T * X, if KASE=2,
-*> and DLACN2 must be re-called with all the other parameters
-*> unchanged.
-*> \endverbatim
-*>
-*> \param[out] ISGN
-*> \verbatim
-*> ISGN is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] EST
-*> \verbatim
-*> EST is DOUBLE PRECISION
-*> On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
-*> unchanged from the previous call to DLACN2.
-*> On exit, EST is an estimate (a lower bound) for norm(A).
-*> \endverbatim
-*>
-*> \param[in,out] KASE
-*> \verbatim
-*> KASE is INTEGER
-*> On the initial call to DLACN2, KASE should be 0.
-*> On an intermediate return, KASE will be 1 or 2, indicating
-*> whether X should be overwritten by A * X or A**T * X.
-*> On the final return from DLACN2, KASE will again be 0.
-*> \endverbatim
-*>
-*> \param[in,out] ISAVE
-*> \verbatim
-*> ISAVE is INTEGER array, dimension (3)
-*> ISAVE is used to save variables between calls to DLACN2
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Originally named SONEST, dated March 16, 1988.
-*>
-*> This is a thread safe version of DLACON, which uses the array ISAVE
-*> in place of a SAVE statement, as follows:
-*>
-*> DLACON DLACN2
-*> JUMP ISAVE(1)
-*> J ISAVE(2)
-*> ITER ISAVE(3)
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham, University of Manchester
-*
-*> \par References:
-* ================
-*>
-*> N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*> a real or complex matrix, with applications to condition estimation",
-*> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*>
-* =====================================================================
- SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER KASE, N
- DOUBLE PRECISION EST
-* ..
-* .. Array Arguments ..
- INTEGER ISGN( * ), ISAVE( 3 )
- DOUBLE PRECISION V( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, JLAST
- DOUBLE PRECISION ALTSGN, ESTOLD, TEMP
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM
- EXTERNAL IDAMAX, DASUM
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, NINT, SIGN
-* ..
-* .. Executable Statements ..
-*
- IF( KASE.EQ.0 ) THEN
- DO 10 I = 1, N
- X( I ) = ONE / DBLE( N )
- 10 CONTINUE
- KASE = 1
- ISAVE( 1 ) = 1
- RETURN
- END IF
-*
- GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 )
-*
-* ................ ENTRY (ISAVE( 1 ) = 1)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
-*
- 20 CONTINUE
- IF( N.EQ.1 ) THEN
- V( 1 ) = X( 1 )
- EST = ABS( V( 1 ) )
-* ... QUIT
- GO TO 150
- END IF
- EST = DASUM( N, X, 1 )
-*
- DO 30 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 30 CONTINUE
- KASE = 2
- ISAVE( 1 ) = 2
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 2)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 40 CONTINUE
- ISAVE( 2 ) = IDAMAX( N, X, 1 )
- ISAVE( 3 ) = 2
-*
-* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
- 50 CONTINUE
- DO 60 I = 1, N
- X( I ) = ZERO
- 60 CONTINUE
- X( ISAVE( 2 ) ) = ONE
- KASE = 1
- ISAVE( 1 ) = 3
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 3)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 70 CONTINUE
- CALL DCOPY( N, X, 1, V, 1 )
- ESTOLD = EST
- EST = DASUM( N, V, 1 )
- DO 80 I = 1, N
- IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
- $ GO TO 90
- 80 CONTINUE
-* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- GO TO 120
-*
- 90 CONTINUE
-* TEST FOR CYCLING.
- IF( EST.LE.ESTOLD )
- $ GO TO 120
-*
- DO 100 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 100 CONTINUE
- KASE = 2
- ISAVE( 1 ) = 4
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 4)
-* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 110 CONTINUE
- JLAST = ISAVE( 2 )
- ISAVE( 2 ) = IDAMAX( N, X, 1 )
- IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
- $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN
- ISAVE( 3 ) = ISAVE( 3 ) + 1
- GO TO 50
- END IF
-*
-* ITERATION COMPLETE. FINAL STAGE.
-*
- 120 CONTINUE
- ALTSGN = ONE
- DO 130 I = 1, N
- X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
- ALTSGN = -ALTSGN
- 130 CONTINUE
- KASE = 1
- ISAVE( 1 ) = 5
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 5)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 140 CONTINUE
- TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
- IF( TEMP.GT.EST ) THEN
- CALL DCOPY( N, X, 1, V, 1 )
- EST = TEMP
- END IF
-*
- 150 CONTINUE
- KASE = 0
- RETURN
-*
-* End of DLACN2
-*
- END
diff --git a/netlib/LAPACK/dlacon.f b/netlib/LAPACK/dlacon.f
deleted file mode 100644
index fa98ac5..0000000
--- a/netlib/LAPACK/dlacon.f
+++ /dev/null
@@ -1,275 +0,0 @@
-*> \brief \b DLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLACON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE )
-*
-* .. Scalar Arguments ..
-* INTEGER KASE, N
-* DOUBLE PRECISION EST
-* ..
-* .. Array Arguments ..
-* INTEGER ISGN( * )
-* DOUBLE PRECISION V( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLACON estimates the 1-norm of a square, real matrix A.
-*> Reverse communication is used for evaluating matrix-vector products.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 1.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (N)
-*> On the final return, V = A*W, where EST = norm(V)/norm(W)
-*> (W is not returned).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On an intermediate return, X should be overwritten by
-*> A * X, if KASE=1,
-*> A**T * X, if KASE=2,
-*> and DLACON must be re-called with all the other parameters
-*> unchanged.
-*> \endverbatim
-*>
-*> \param[out] ISGN
-*> \verbatim
-*> ISGN is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] EST
-*> \verbatim
-*> EST is DOUBLE PRECISION
-*> On entry with KASE = 1 or 2 and JUMP = 3, EST should be
-*> unchanged from the previous call to DLACON.
-*> On exit, EST is an estimate (a lower bound) for norm(A).
-*> \endverbatim
-*>
-*> \param[in,out] KASE
-*> \verbatim
-*> KASE is INTEGER
-*> On the initial call to DLACON, KASE should be 0.
-*> On an intermediate return, KASE will be 1 or 2, indicating
-*> whether X should be overwritten by A * X or A**T * X.
-*> On the final return from DLACON, KASE will again be 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham, University of Manchester. \n
-*> Originally named SONEST, dated March 16, 1988.
-*
-*> \par References:
-* ================
-*>
-*> N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*> a real or complex matrix, with applications to condition estimation",
-*> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*>
-* =====================================================================
- SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER KASE, N
- DOUBLE PRECISION EST
-* ..
-* .. Array Arguments ..
- INTEGER ISGN( * )
- DOUBLE PRECISION V( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ITER, J, JLAST, JUMP
- DOUBLE PRECISION ALTSGN, ESTOLD, TEMP
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM
- EXTERNAL IDAMAX, DASUM
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, NINT, SIGN
-* ..
-* .. Save statement ..
- SAVE
-* ..
-* .. Executable Statements ..
-*
- IF( KASE.EQ.0 ) THEN
- DO 10 I = 1, N
- X( I ) = ONE / DBLE( N )
- 10 CONTINUE
- KASE = 1
- JUMP = 1
- RETURN
- END IF
-*
- GO TO ( 20, 40, 70, 110, 140 )JUMP
-*
-* ................ ENTRY (JUMP = 1)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
-*
- 20 CONTINUE
- IF( N.EQ.1 ) THEN
- V( 1 ) = X( 1 )
- EST = ABS( V( 1 ) )
-* ... QUIT
- GO TO 150
- END IF
- EST = DASUM( N, X, 1 )
-*
- DO 30 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 30 CONTINUE
- KASE = 2
- JUMP = 2
- RETURN
-*
-* ................ ENTRY (JUMP = 2)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 40 CONTINUE
- J = IDAMAX( N, X, 1 )
- ITER = 2
-*
-* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
- 50 CONTINUE
- DO 60 I = 1, N
- X( I ) = ZERO
- 60 CONTINUE
- X( J ) = ONE
- KASE = 1
- JUMP = 3
- RETURN
-*
-* ................ ENTRY (JUMP = 3)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 70 CONTINUE
- CALL DCOPY( N, X, 1, V, 1 )
- ESTOLD = EST
- EST = DASUM( N, V, 1 )
- DO 80 I = 1, N
- IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
- $ GO TO 90
- 80 CONTINUE
-* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- GO TO 120
-*
- 90 CONTINUE
-* TEST FOR CYCLING.
- IF( EST.LE.ESTOLD )
- $ GO TO 120
-*
- DO 100 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 100 CONTINUE
- KASE = 2
- JUMP = 4
- RETURN
-*
-* ................ ENTRY (JUMP = 4)
-* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 110 CONTINUE
- JLAST = J
- J = IDAMAX( N, X, 1 )
- IF( ( X( JLAST ).NE.ABS( X( J ) ) ) .AND. ( ITER.LT.ITMAX ) ) THEN
- ITER = ITER + 1
- GO TO 50
- END IF
-*
-* ITERATION COMPLETE. FINAL STAGE.
-*
- 120 CONTINUE
- ALTSGN = ONE
- DO 130 I = 1, N
- X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
- ALTSGN = -ALTSGN
- 130 CONTINUE
- KASE = 1
- JUMP = 5
- RETURN
-*
-* ................ ENTRY (JUMP = 5)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 140 CONTINUE
- TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
- IF( TEMP.GT.EST ) THEN
- CALL DCOPY( N, X, 1, V, 1 )
- EST = TEMP
- END IF
-*
- 150 CONTINUE
- KASE = 0
- RETURN
-*
-* End of DLACON
-*
- END
diff --git a/netlib/LAPACK/dlacpy.f b/netlib/LAPACK/dlacpy.f
deleted file mode 100644
index a9a23c9..0000000
--- a/netlib/LAPACK/dlacpy.f
+++ /dev/null
@@ -1,156 +0,0 @@
-*> \brief \b DLACPY copies all or part of one two-dimensional array to another.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLACPY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacpy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacpy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacpy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, LDB, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLACPY copies all or part of a two-dimensional matrix A to another
-*> matrix B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies the part of the matrix A to be copied to B.
-*> = 'U': Upper triangular part
-*> = 'L': Lower triangular part
-*> Otherwise: All of the matrix A
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A. If UPLO = 'U', only the upper triangle
-*> or trapezoid is accessed; if UPLO = 'L', only the lower
-*> triangle or trapezoid is accessed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On exit, B = A in the locations specified by UPLO.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, LDB, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, MIN( J, M )
- B( I, J ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
- DO 40 J = 1, N
- DO 30 I = J, M
- B( I, J ) = A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 J = 1, N
- DO 50 I = 1, M
- B( I, J ) = A( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- RETURN
-*
-* End of DLACPY
-*
- END
diff --git a/netlib/LAPACK/dladiv.f b/netlib/LAPACK/dladiv.f
deleted file mode 100644
index 306a6b0..0000000
--- a/netlib/LAPACK/dladiv.f
+++ /dev/null
@@ -1,128 +0,0 @@
-*> \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLADIV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dladiv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dladiv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dladiv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLADIV( A, B, C, D, P, Q )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION A, B, C, D, P, Q
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLADIV performs complex division in real arithmetic
-*>
-*> a + i*b
-*> p + i*q = ---------
-*> c + i*d
-*>
-*> The algorithm is due to Robert L. Smith and can be found
-*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION
-*> The scalars a, b, c, and d in the above expression.
-*> \endverbatim
-*>
-*> \param[out] P
-*> \verbatim
-*> P is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION
-*> The scalars p and q in the above expression.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLADIV( A, B, C, D, P, Q )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B, C, D, P, Q
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION E, F
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( ABS( D ).LT.ABS( C ) ) THEN
- E = D / C
- F = C + D*E
- P = ( A+B*E ) / F
- Q = ( B-A*E ) / F
- ELSE
- E = C / D
- F = D + C*E
- P = ( B+A*E ) / F
- Q = ( -A+B*E ) / F
- END IF
-*
- RETURN
-*
-* End of DLADIV
-*
- END
diff --git a/netlib/LAPACK/dlae2.f b/netlib/LAPACK/dlae2.f
deleted file mode 100644
index 302eeaa..0000000
--- a/netlib/LAPACK/dlae2.f
+++ /dev/null
@@ -1,185 +0,0 @@
-*> \brief \b DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAE2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlae2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlae2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlae2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAE2( A, B, C, RT1, RT2 )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION A, B, C, RT1, RT2
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
-*> [ A B ]
-*> [ B C ].
-*> On return, RT1 is the eigenvalue of larger absolute value, and RT2
-*> is the eigenvalue of smaller absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION
-*> The (1,2) and (2,1) elements of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] RT1
-*> \verbatim
-*> RT1 is DOUBLE PRECISION
-*> The eigenvalue of larger absolute value.
-*> \endverbatim
-*>
-*> \param[out] RT2
-*> \verbatim
-*> RT2 is DOUBLE PRECISION
-*> The eigenvalue of smaller absolute value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> RT1 is accurate to a few ulps barring over/underflow.
-*>
-*> RT2 may be inaccurate if there is massive cancellation in the
-*> determinant A*C-B*B; higher precision or correctly rounded or
-*> correctly truncated arithmetic would be needed to compute RT2
-*> accurately in all cases.
-*>
-*> Overflow is possible only if RT1 is within a factor of 5 of overflow.
-*> Underflow is harmless if the input data is 0 or exceeds
-*> underflow_threshold / macheps.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAE2( A, B, C, RT1, RT2 )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B, C, RT1, RT2
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AB, ACMN, ACMX, ADF, DF, RT, SM, TB
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Compute the eigenvalues
-*
- SM = A + C
- DF = A - C
- ADF = ABS( DF )
- TB = B + B
- AB = ABS( TB )
- IF( ABS( A ).GT.ABS( C ) ) THEN
- ACMX = A
- ACMN = C
- ELSE
- ACMX = C
- ACMN = A
- END IF
- IF( ADF.GT.AB ) THEN
- RT = ADF*SQRT( ONE+( AB / ADF )**2 )
- ELSE IF( ADF.LT.AB ) THEN
- RT = AB*SQRT( ONE+( ADF / AB )**2 )
- ELSE
-*
-* Includes case AB=ADF=0
-*
- RT = AB*SQRT( TWO )
- END IF
- IF( SM.LT.ZERO ) THEN
- RT1 = HALF*( SM-RT )
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE IF( SM.GT.ZERO ) THEN
- RT1 = HALF*( SM+RT )
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE
-*
-* Includes case RT1 = RT2 = 0
-*
- RT1 = HALF*RT
- RT2 = -HALF*RT
- END IF
- RETURN
-*
-* End of DLAE2
-*
- END
diff --git a/netlib/LAPACK/dlaebz.f b/netlib/LAPACK/dlaebz.f
deleted file mode 100644
index 64ced89..0000000
--- a/netlib/LAPACK/dlaebz.f
+++ /dev/null
@@ -1,649 +0,0 @@
-*> \brief \b DLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAEBZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaebz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaebz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaebz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAEBZ( IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL,
-* RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT,
-* NAB, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IJOB, INFO, MINP, MMAX, MOUT, N, NBMIN, NITMAX
-* DOUBLE PRECISION ABSTOL, PIVMIN, RELTOL
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * ), NAB( MMAX, * ), NVAL( * )
-* DOUBLE PRECISION AB( MMAX, * ), C( * ), D( * ), E( * ), E2( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAEBZ contains the iteration loops which compute and use the
-*> function N(w), which is the count of eigenvalues of a symmetric
-*> tridiagonal matrix T less than or equal to its argument w. It
-*> performs a choice of two types of loops:
-*>
-*> IJOB=1, followed by
-*> IJOB=2: It takes as input a list of intervals and returns a list of
-*> sufficiently small intervals whose union contains the same
-*> eigenvalues as the union of the original intervals.
-*> The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
-*> The output interval (AB(j,1),AB(j,2)] will contain
-*> eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
-*>
-*> IJOB=3: It performs a binary search in each input interval
-*> (AB(j,1),AB(j,2)] for a point w(j) such that
-*> N(w(j))=NVAL(j), and uses C(j) as the starting point of
-*> the search. If such a w(j) is found, then on output
-*> AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
-*> (AB(j,1),AB(j,2)] will be a small interval containing the
-*> point where N(w) jumps through NVAL(j), unless that point
-*> lies outside the initial interval.
-*>
-*> Note that the intervals are in all cases half-open intervals,
-*> i.e., of the form (a,b] , which includes b but not a .
-*>
-*> To avoid underflow, the matrix should be scaled so that its largest
-*> element is no greater than overflow**(1/2) * underflow**(1/4)
-*> in absolute value. To assure the most accurate computation
-*> of small eigenvalues, the matrix should be scaled to be
-*> not much smaller than that, either.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966
-*>
-*> Note: the arguments are, in general, *not* checked for unreasonable
-*> values.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies what is to be done:
-*> = 1: Compute NAB for the initial intervals.
-*> = 2: Perform bisection iteration to find eigenvalues of T.
-*> = 3: Perform bisection iteration to invert N(w), i.e.,
-*> to find a point which has a specified number of
-*> eigenvalues of T to its left.
-*> Other values will cause DLAEBZ to return with INFO=-1.
-*> \endverbatim
-*>
-*> \param[in] NITMAX
-*> \verbatim
-*> NITMAX is INTEGER
-*> The maximum number of "levels" of bisection to be
-*> performed, i.e., an interval of width W will not be made
-*> smaller than 2^(-NITMAX) * W. If not all intervals
-*> have converged after NITMAX iterations, then INFO is set
-*> to the number of non-converged intervals.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension n of the tridiagonal matrix T. It must be at
-*> least 1.
-*> \endverbatim
-*>
-*> \param[in] MMAX
-*> \verbatim
-*> MMAX is INTEGER
-*> The maximum number of intervals. If more than MMAX intervals
-*> are generated, then DLAEBZ will quit with INFO=MMAX+1.
-*> \endverbatim
-*>
-*> \param[in] MINP
-*> \verbatim
-*> MINP is INTEGER
-*> The initial number of intervals. It may not be greater than
-*> MMAX.
-*> \endverbatim
-*>
-*> \param[in] NBMIN
-*> \verbatim
-*> NBMIN is INTEGER
-*> The smallest number of intervals that should be processed
-*> using a vector loop. If zero, then only the scalar loop
-*> will be used.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The minimum (absolute) width of an interval. When an
-*> interval is narrower than ABSTOL, or than RELTOL times the
-*> larger (in magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. This must be at least
-*> zero.
-*> \endverbatim
-*>
-*> \param[in] RELTOL
-*> \verbatim
-*> RELTOL is DOUBLE PRECISION
-*> The minimum relative width of an interval. When an interval
-*> is narrower than ABSTOL, or than RELTOL times the larger (in
-*> magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. Note: this should
-*> always be at least radix*machine epsilon.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum absolute value of a "pivot" in the Sturm
-*> sequence loop.
-*> This must be at least max |e(j)**2|*safe_min and at
-*> least safe_min, where safe_min is at least
-*> the smallest number that can divide one without overflow.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> The offdiagonal elements of the tridiagonal matrix T in
-*> positions 1 through N-1. E(N) is arbitrary.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is DOUBLE PRECISION array, dimension (N)
-*> The squares of the offdiagonal elements of the tridiagonal
-*> matrix T. E2(N) is ignored.
-*> \endverbatim
-*>
-*> \param[in,out] NVAL
-*> \verbatim
-*> NVAL is INTEGER array, dimension (MINP)
-*> If IJOB=1 or 2, not referenced.
-*> If IJOB=3, the desired values of N(w). The elements of NVAL
-*> will be reordered to correspond with the intervals in AB.
-*> Thus, NVAL(j) on output will not, in general be the same as
-*> NVAL(j) on input, but it will correspond with the interval
-*> (AB(j,1),AB(j,2)] on output.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (MMAX,2)
-*> The endpoints of the intervals. AB(j,1) is a(j), the left
-*> endpoint of the j-th interval, and AB(j,2) is b(j), the
-*> right endpoint of the j-th interval. The input intervals
-*> will, in general, be modified, split, and reordered by the
-*> calculation.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (MMAX)
-*> If IJOB=1, ignored.
-*> If IJOB=2, workspace.
-*> If IJOB=3, then on input C(j) should be initialized to the
-*> first search point in the binary search.
-*> \endverbatim
-*>
-*> \param[out] MOUT
-*> \verbatim
-*> MOUT is INTEGER
-*> If IJOB=1, the number of eigenvalues in the intervals.
-*> If IJOB=2 or 3, the number of intervals output.
-*> If IJOB=3, MOUT will equal MINP.
-*> \endverbatim
-*>
-*> \param[in,out] NAB
-*> \verbatim
-*> NAB is INTEGER array, dimension (MMAX,2)
-*> If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)).
-*> If IJOB=2, then on input, NAB(i,j) should be set. It must
-*> satisfy the condition:
-*> N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)),
-*> which means that in interval i only eigenvalues
-*> NAB(i,1)+1,...,NAB(i,2) will be considered. Usually,
-*> NAB(i,j)=N(AB(i,j)), from a previous call to DLAEBZ with
-*> IJOB=1.
-*> On output, NAB(i,j) will contain
-*> max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of
-*> the input interval that the output interval
-*> (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the
-*> the input values of NAB(k,1) and NAB(k,2).
-*> If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)),
-*> unless N(w) > NVAL(i) for all search points w , in which
-*> case NAB(i,1) will not be modified, i.e., the output
-*> value will be the same as the input value (modulo
-*> reorderings -- see NVAL and AB), or unless N(w) < NVAL(i)
-*> for all search points w , in which case NAB(i,2) will
-*> not be modified. Normally, NAB should be set to some
-*> distinctive value(s) before DLAEBZ is called.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MMAX)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MMAX)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: All intervals converged.
-*> = 1--MMAX: The last INFO intervals did not converge.
-*> = MMAX+1: More than MMAX intervals were generated.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine is intended to be called only by other LAPACK
-*> routines, thus the interface is less user-friendly. It is intended
-*> for two purposes:
-*>
-*> (a) finding eigenvalues. In this case, DLAEBZ should have one or
-*> more initial intervals set up in AB, and DLAEBZ should be called
-*> with IJOB=1. This sets up NAB, and also counts the eigenvalues.
-*> Intervals with no eigenvalues would usually be thrown out at
-*> this point. Also, if not all the eigenvalues in an interval i
-*> are desired, NAB(i,1) can be increased or NAB(i,2) decreased.
-*> For example, set NAB(i,1)=NAB(i,2)-1 to get the largest
-*> eigenvalue. DLAEBZ is then called with IJOB=2 and MMAX
-*> no smaller than the value of MOUT returned by the call with
-*> IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1
-*> through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the
-*> tolerance specified by ABSTOL and RELTOL.
-*>
-*> (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l).
-*> In this case, start with a Gershgorin interval (a,b). Set up
-*> AB to contain 2 search intervals, both initially (a,b). One
-*> NVAL element should contain f-1 and the other should contain l
-*> , while C should contain a and b, resp. NAB(i,1) should be -1
-*> and NAB(i,2) should be N+1, to flag an error if the desired
-*> interval does not lie in (a,b). DLAEBZ is then called with
-*> IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals --
-*> j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while
-*> if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r
-*> >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and
-*> N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and
-*> w(l-r)=...=w(l+k) are handled similarly.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAEBZ( IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL,
- $ RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT,
- $ NAB, WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IJOB, INFO, MINP, MMAX, MOUT, N, NBMIN, NITMAX
- DOUBLE PRECISION ABSTOL, PIVMIN, RELTOL
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * ), NAB( MMAX, * ), NVAL( * )
- DOUBLE PRECISION AB( MMAX, * ), C( * ), D( * ), E( * ), E2( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, TWO, HALF
- PARAMETER ( ZERO = 0.0D0, TWO = 2.0D0,
- $ HALF = 1.0D0 / TWO )
-* ..
-* .. Local Scalars ..
- INTEGER ITMP1, ITMP2, J, JI, JIT, JP, KF, KFNEW, KL,
- $ KLNEW
- DOUBLE PRECISION TMP1, TMP2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Check for Errors
-*
- INFO = 0
- IF( IJOB.LT.1 .OR. IJOB.GT.3 ) THEN
- INFO = -1
- RETURN
- END IF
-*
-* Initialize NAB
-*
- IF( IJOB.EQ.1 ) THEN
-*
-* Compute the number of eigenvalues in the initial intervals.
-*
- MOUT = 0
- DO 30 JI = 1, MINP
- DO 20 JP = 1, 2
- TMP1 = D( 1 ) - AB( JI, JP )
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- NAB( JI, JP ) = 0
- IF( TMP1.LE.ZERO )
- $ NAB( JI, JP ) = 1
-*
- DO 10 J = 2, N
- TMP1 = D( J ) - E2( J-1 ) / TMP1 - AB( JI, JP )
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- IF( TMP1.LE.ZERO )
- $ NAB( JI, JP ) = NAB( JI, JP ) + 1
- 10 CONTINUE
- 20 CONTINUE
- MOUT = MOUT + NAB( JI, 2 ) - NAB( JI, 1 )
- 30 CONTINUE
- RETURN
- END IF
-*
-* Initialize for loop
-*
-* KF and KL have the following meaning:
-* Intervals 1,...,KF-1 have converged.
-* Intervals KF,...,KL still need to be refined.
-*
- KF = 1
- KL = MINP
-*
-* If IJOB=2, initialize C.
-* If IJOB=3, use the user-supplied starting point.
-*
- IF( IJOB.EQ.2 ) THEN
- DO 40 JI = 1, MINP
- C( JI ) = HALF*( AB( JI, 1 )+AB( JI, 2 ) )
- 40 CONTINUE
- END IF
-*
-* Iteration loop
-*
- DO 130 JIT = 1, NITMAX
-*
-* Loop over intervals
-*
- IF( KL-KF+1.GE.NBMIN .AND. NBMIN.GT.0 ) THEN
-*
-* Begin of Parallel Version of the loop
-*
- DO 60 JI = KF, KL
-*
-* Compute N(c), the number of eigenvalues less than c
-*
- WORK( JI ) = D( 1 ) - C( JI )
- IWORK( JI ) = 0
- IF( WORK( JI ).LE.PIVMIN ) THEN
- IWORK( JI ) = 1
- WORK( JI ) = MIN( WORK( JI ), -PIVMIN )
- END IF
-*
- DO 50 J = 2, N
- WORK( JI ) = D( J ) - E2( J-1 ) / WORK( JI ) - C( JI )
- IF( WORK( JI ).LE.PIVMIN ) THEN
- IWORK( JI ) = IWORK( JI ) + 1
- WORK( JI ) = MIN( WORK( JI ), -PIVMIN )
- END IF
- 50 CONTINUE
- 60 CONTINUE
-*
- IF( IJOB.LE.2 ) THEN
-*
-* IJOB=2: Choose all intervals containing eigenvalues.
-*
- KLNEW = KL
- DO 70 JI = KF, KL
-*
-* Insure that N(w) is monotone
-*
- IWORK( JI ) = MIN( NAB( JI, 2 ),
- $ MAX( NAB( JI, 1 ), IWORK( JI ) ) )
-*
-* Update the Queue -- add intervals if both halves
-* contain eigenvalues.
-*
- IF( IWORK( JI ).EQ.NAB( JI, 2 ) ) THEN
-*
-* No eigenvalue in the upper interval:
-* just use the lower interval.
-*
- AB( JI, 2 ) = C( JI )
-*
- ELSE IF( IWORK( JI ).EQ.NAB( JI, 1 ) ) THEN
-*
-* No eigenvalue in the lower interval:
-* just use the upper interval.
-*
- AB( JI, 1 ) = C( JI )
- ELSE
- KLNEW = KLNEW + 1
- IF( KLNEW.LE.MMAX ) THEN
-*
-* Eigenvalue in both intervals -- add upper to
-* queue.
-*
- AB( KLNEW, 2 ) = AB( JI, 2 )
- NAB( KLNEW, 2 ) = NAB( JI, 2 )
- AB( KLNEW, 1 ) = C( JI )
- NAB( KLNEW, 1 ) = IWORK( JI )
- AB( JI, 2 ) = C( JI )
- NAB( JI, 2 ) = IWORK( JI )
- ELSE
- INFO = MMAX + 1
- END IF
- END IF
- 70 CONTINUE
- IF( INFO.NE.0 )
- $ RETURN
- KL = KLNEW
- ELSE
-*
-* IJOB=3: Binary search. Keep only the interval containing
-* w s.t. N(w) = NVAL
-*
- DO 80 JI = KF, KL
- IF( IWORK( JI ).LE.NVAL( JI ) ) THEN
- AB( JI, 1 ) = C( JI )
- NAB( JI, 1 ) = IWORK( JI )
- END IF
- IF( IWORK( JI ).GE.NVAL( JI ) ) THEN
- AB( JI, 2 ) = C( JI )
- NAB( JI, 2 ) = IWORK( JI )
- END IF
- 80 CONTINUE
- END IF
-*
- ELSE
-*
-* End of Parallel Version of the loop
-*
-* Begin of Serial Version of the loop
-*
- KLNEW = KL
- DO 100 JI = KF, KL
-*
-* Compute N(w), the number of eigenvalues less than w
-*
- TMP1 = C( JI )
- TMP2 = D( 1 ) - TMP1
- ITMP1 = 0
- IF( TMP2.LE.PIVMIN ) THEN
- ITMP1 = 1
- TMP2 = MIN( TMP2, -PIVMIN )
- END IF
-*
- DO 90 J = 2, N
- TMP2 = D( J ) - E2( J-1 ) / TMP2 - TMP1
- IF( TMP2.LE.PIVMIN ) THEN
- ITMP1 = ITMP1 + 1
- TMP2 = MIN( TMP2, -PIVMIN )
- END IF
- 90 CONTINUE
-*
- IF( IJOB.LE.2 ) THEN
-*
-* IJOB=2: Choose all intervals containing eigenvalues.
-*
-* Insure that N(w) is monotone
-*
- ITMP1 = MIN( NAB( JI, 2 ),
- $ MAX( NAB( JI, 1 ), ITMP1 ) )
-*
-* Update the Queue -- add intervals if both halves
-* contain eigenvalues.
-*
- IF( ITMP1.EQ.NAB( JI, 2 ) ) THEN
-*
-* No eigenvalue in the upper interval:
-* just use the lower interval.
-*
- AB( JI, 2 ) = TMP1
-*
- ELSE IF( ITMP1.EQ.NAB( JI, 1 ) ) THEN
-*
-* No eigenvalue in the lower interval:
-* just use the upper interval.
-*
- AB( JI, 1 ) = TMP1
- ELSE IF( KLNEW.LT.MMAX ) THEN
-*
-* Eigenvalue in both intervals -- add upper to queue.
-*
- KLNEW = KLNEW + 1
- AB( KLNEW, 2 ) = AB( JI, 2 )
- NAB( KLNEW, 2 ) = NAB( JI, 2 )
- AB( KLNEW, 1 ) = TMP1
- NAB( KLNEW, 1 ) = ITMP1
- AB( JI, 2 ) = TMP1
- NAB( JI, 2 ) = ITMP1
- ELSE
- INFO = MMAX + 1
- RETURN
- END IF
- ELSE
-*
-* IJOB=3: Binary search. Keep only the interval
-* containing w s.t. N(w) = NVAL
-*
- IF( ITMP1.LE.NVAL( JI ) ) THEN
- AB( JI, 1 ) = TMP1
- NAB( JI, 1 ) = ITMP1
- END IF
- IF( ITMP1.GE.NVAL( JI ) ) THEN
- AB( JI, 2 ) = TMP1
- NAB( JI, 2 ) = ITMP1
- END IF
- END IF
- 100 CONTINUE
- KL = KLNEW
-*
- END IF
-*
-* Check for convergence
-*
- KFNEW = KF
- DO 110 JI = KF, KL
- TMP1 = ABS( AB( JI, 2 )-AB( JI, 1 ) )
- TMP2 = MAX( ABS( AB( JI, 2 ) ), ABS( AB( JI, 1 ) ) )
- IF( TMP1.LT.MAX( ABSTOL, PIVMIN, RELTOL*TMP2 ) .OR.
- $ NAB( JI, 1 ).GE.NAB( JI, 2 ) ) THEN
-*
-* Converged -- Swap with position KFNEW,
-* then increment KFNEW
-*
- IF( JI.GT.KFNEW ) THEN
- TMP1 = AB( JI, 1 )
- TMP2 = AB( JI, 2 )
- ITMP1 = NAB( JI, 1 )
- ITMP2 = NAB( JI, 2 )
- AB( JI, 1 ) = AB( KFNEW, 1 )
- AB( JI, 2 ) = AB( KFNEW, 2 )
- NAB( JI, 1 ) = NAB( KFNEW, 1 )
- NAB( JI, 2 ) = NAB( KFNEW, 2 )
- AB( KFNEW, 1 ) = TMP1
- AB( KFNEW, 2 ) = TMP2
- NAB( KFNEW, 1 ) = ITMP1
- NAB( KFNEW, 2 ) = ITMP2
- IF( IJOB.EQ.3 ) THEN
- ITMP1 = NVAL( JI )
- NVAL( JI ) = NVAL( KFNEW )
- NVAL( KFNEW ) = ITMP1
- END IF
- END IF
- KFNEW = KFNEW + 1
- END IF
- 110 CONTINUE
- KF = KFNEW
-*
-* Choose Midpoints
-*
- DO 120 JI = KF, KL
- C( JI ) = HALF*( AB( JI, 1 )+AB( JI, 2 ) )
- 120 CONTINUE
-*
-* If no more intervals to refine, quit.
-*
- IF( KF.GT.KL )
- $ GO TO 140
- 130 CONTINUE
-*
-* Converged
-*
- 140 CONTINUE
- INFO = MAX( KL+1-KF, 0 )
- MOUT = KL
-*
- RETURN
-*
-* End of DLAEBZ
-*
- END
diff --git a/netlib/LAPACK/dlaed0.f b/netlib/LAPACK/dlaed0.f
deleted file mode 100644
index d8d7f53..0000000
--- a/netlib/LAPACK/dlaed0.f
+++ /dev/null
@@ -1,434 +0,0 @@
-*> \brief \b DLAED0 used by sstedc. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), Q( LDQ, * ), QSTORE( LDQS, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED0 computes all eigenvalues and corresponding eigenvectors of a
-*> symmetric tridiagonal matrix using the divide and conquer method.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> = 0: Compute eigenvalues only.
-*> = 1: Compute eigenvectors of original dense symmetric matrix
-*> also. On entry, Q contains the orthogonal matrix used
-*> to reduce the original matrix to tridiagonal form.
-*> = 2: Compute eigenvalues and eigenvectors of tridiagonal
-*> matrix.
-*> \endverbatim
-*>
-*> \param[in] QSIZ
-*> \verbatim
-*> QSIZ is INTEGER
-*> The dimension of the orthogonal matrix used to reduce
-*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the main diagonal of the tridiagonal matrix.
-*> On exit, its eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> On entry, Q must contain an N-by-N orthogonal matrix.
-*> If ICOMPQ = 0 Q is not referenced.
-*> If ICOMPQ = 1 On entry, Q is a subset of the columns of the
-*> orthogonal matrix used to reduce the full
-*> matrix to tridiagonal form corresponding to
-*> the subset of the full matrix which is being
-*> decomposed at this time.
-*> If ICOMPQ = 2 On entry, Q will be the identity matrix.
-*> On exit, Q contains the eigenvectors of the
-*> tridiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. If eigenvectors are
-*> desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
-*> \endverbatim
-*>
-*> \param[out] QSTORE
-*> \verbatim
-*> QSTORE is DOUBLE PRECISION array, dimension (LDQS, N)
-*> Referenced only when ICOMPQ = 1. Used to store parts of
-*> the eigenvector matrix when the updating matrix multiplies
-*> take place.
-*> \endverbatim
-*>
-*> \param[in] LDQS
-*> \verbatim
-*> LDQS is INTEGER
-*> The leading dimension of the array QSTORE. If ICOMPQ = 1,
-*> then LDQS >= max(1,N). In any case, LDQS >= 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> If ICOMPQ = 0 or 1, the dimension of WORK must be at least
-*> 1 + 3*N + 2*N*lg N + 3*N**2
-*> ( lg( N ) = smallest integer k
-*> such that 2^k >= N )
-*> If ICOMPQ = 2, the dimension of WORK must be at least
-*> 4*N + N**2.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array,
-*> If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
-*> 6 + 6*N + 5*N*lg N.
-*> ( lg( N ) = smallest integer k
-*> such that 2^k >= N )
-*> If ICOMPQ = 2, the dimension of IWORK must be at least
-*> 3 + 5*N.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute an eigenvalue while
-*> working on the submatrix lying in rows and columns
-*> INFO/(N+1) through mod(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), Q( LDQ, * ), QSTORE( LDQS, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.D0, ONE = 1.D0, TWO = 2.D0 )
-* ..
-* .. Local Scalars ..
- INTEGER CURLVL, CURPRB, CURR, I, IGIVCL, IGIVNM,
- $ IGIVPT, INDXQ, IPERM, IPRMPT, IQ, IQPTR, IWREM,
- $ J, K, LGN, MATSIZ, MSD2, SMLSIZ, SMM1, SPM1,
- $ SPM2, SUBMAT, SUBPBS, TLVLS
- DOUBLE PRECISION TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DLACPY, DLAED1, DLAED7, DSTEQR,
- $ XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, LOG, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.2 ) THEN
- INFO = -1
- ELSE IF( ( ICOMPQ.EQ.1 ) .AND. ( QSIZ.LT.MAX( 0, N ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDQS.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED0', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- SMLSIZ = ILAENV( 9, 'DLAED0', ' ', 0, 0, 0, 0 )
-*
-* Determine the size and placement of the submatrices, and save in
-* the leading elements of IWORK.
-*
- IWORK( 1 ) = N
- SUBPBS = 1
- TLVLS = 0
- 10 CONTINUE
- IF( IWORK( SUBPBS ).GT.SMLSIZ ) THEN
- DO 20 J = SUBPBS, 1, -1
- IWORK( 2*J ) = ( IWORK( J )+1 ) / 2
- IWORK( 2*J-1 ) = IWORK( J ) / 2
- 20 CONTINUE
- TLVLS = TLVLS + 1
- SUBPBS = 2*SUBPBS
- GO TO 10
- END IF
- DO 30 J = 2, SUBPBS
- IWORK( J ) = IWORK( J ) + IWORK( J-1 )
- 30 CONTINUE
-*
-* Divide the matrix into SUBPBS submatrices of size at most SMLSIZ+1
-* using rank-1 modifications (cuts).
-*
- SPM1 = SUBPBS - 1
- DO 40 I = 1, SPM1
- SUBMAT = IWORK( I ) + 1
- SMM1 = SUBMAT - 1
- D( SMM1 ) = D( SMM1 ) - ABS( E( SMM1 ) )
- D( SUBMAT ) = D( SUBMAT ) - ABS( E( SMM1 ) )
- 40 CONTINUE
-*
- INDXQ = 4*N + 3
- IF( ICOMPQ.NE.2 ) THEN
-*
-* Set up workspaces for eigenvalues only/accumulate new vectors
-* routine
-*
- TEMP = LOG( DBLE( N ) ) / LOG( TWO )
- LGN = INT( TEMP )
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IPRMPT = INDXQ + N + 1
- IPERM = IPRMPT + N*LGN
- IQPTR = IPERM + N*LGN
- IGIVPT = IQPTR + N + 2
- IGIVCL = IGIVPT + N*LGN
-*
- IGIVNM = 1
- IQ = IGIVNM + 2*N*LGN
- IWREM = IQ + N**2 + 1
-*
-* Initialize pointers
-*
- DO 50 I = 0, SUBPBS
- IWORK( IPRMPT+I ) = 1
- IWORK( IGIVPT+I ) = 1
- 50 CONTINUE
- IWORK( IQPTR ) = 1
- END IF
-*
-* Solve each submatrix eigenproblem at the bottom of the divide and
-* conquer tree.
-*
- CURR = 0
- DO 70 I = 0, SPM1
- IF( I.EQ.0 ) THEN
- SUBMAT = 1
- MATSIZ = IWORK( 1 )
- ELSE
- SUBMAT = IWORK( I ) + 1
- MATSIZ = IWORK( I+1 ) - IWORK( I )
- END IF
- IF( ICOMPQ.EQ.2 ) THEN
- CALL DSTEQR( 'I', MATSIZ, D( SUBMAT ), E( SUBMAT ),
- $ Q( SUBMAT, SUBMAT ), LDQ, WORK, INFO )
- IF( INFO.NE.0 )
- $ GO TO 130
- ELSE
- CALL DSTEQR( 'I', MATSIZ, D( SUBMAT ), E( SUBMAT ),
- $ WORK( IQ-1+IWORK( IQPTR+CURR ) ), MATSIZ, WORK,
- $ INFO )
- IF( INFO.NE.0 )
- $ GO TO 130
- IF( ICOMPQ.EQ.1 ) THEN
- CALL DGEMM( 'N', 'N', QSIZ, MATSIZ, MATSIZ, ONE,
- $ Q( 1, SUBMAT ), LDQ, WORK( IQ-1+IWORK( IQPTR+
- $ CURR ) ), MATSIZ, ZERO, QSTORE( 1, SUBMAT ),
- $ LDQS )
- END IF
- IWORK( IQPTR+CURR+1 ) = IWORK( IQPTR+CURR ) + MATSIZ**2
- CURR = CURR + 1
- END IF
- K = 1
- DO 60 J = SUBMAT, IWORK( I+1 )
- IWORK( INDXQ+J ) = K
- K = K + 1
- 60 CONTINUE
- 70 CONTINUE
-*
-* Successively merge eigensystems of adjacent submatrices
-* into eigensystem for the corresponding larger matrix.
-*
-* while ( SUBPBS > 1 )
-*
- CURLVL = 1
- 80 CONTINUE
- IF( SUBPBS.GT.1 ) THEN
- SPM2 = SUBPBS - 2
- DO 90 I = 0, SPM2, 2
- IF( I.EQ.0 ) THEN
- SUBMAT = 1
- MATSIZ = IWORK( 2 )
- MSD2 = IWORK( 1 )
- CURPRB = 0
- ELSE
- SUBMAT = IWORK( I ) + 1
- MATSIZ = IWORK( I+2 ) - IWORK( I )
- MSD2 = MATSIZ / 2
- CURPRB = CURPRB + 1
- END IF
-*
-* Merge lower order eigensystems (of size MSD2 and MATSIZ - MSD2)
-* into an eigensystem of size MATSIZ.
-* DLAED1 is used only for the full eigensystem of a tridiagonal
-* matrix.
-* DLAED7 handles the cases in which eigenvalues only or eigenvalues
-* and eigenvectors of a full symmetric matrix (which was reduced to
-* tridiagonal form) are desired.
-*
- IF( ICOMPQ.EQ.2 ) THEN
- CALL DLAED1( MATSIZ, D( SUBMAT ), Q( SUBMAT, SUBMAT ),
- $ LDQ, IWORK( INDXQ+SUBMAT ),
- $ E( SUBMAT+MSD2-1 ), MSD2, WORK,
- $ IWORK( SUBPBS+1 ), INFO )
- ELSE
- CALL DLAED7( ICOMPQ, MATSIZ, QSIZ, TLVLS, CURLVL, CURPRB,
- $ D( SUBMAT ), QSTORE( 1, SUBMAT ), LDQS,
- $ IWORK( INDXQ+SUBMAT ), E( SUBMAT+MSD2-1 ),
- $ MSD2, WORK( IQ ), IWORK( IQPTR ),
- $ IWORK( IPRMPT ), IWORK( IPERM ),
- $ IWORK( IGIVPT ), IWORK( IGIVCL ),
- $ WORK( IGIVNM ), WORK( IWREM ),
- $ IWORK( SUBPBS+1 ), INFO )
- END IF
- IF( INFO.NE.0 )
- $ GO TO 130
- IWORK( I / 2+1 ) = IWORK( I+2 )
- 90 CONTINUE
- SUBPBS = SUBPBS / 2
- CURLVL = CURLVL + 1
- GO TO 80
- END IF
-*
-* end while
-*
-* Re-merge the eigenvalues/vectors which were deflated at the final
-* merge step.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- DO 100 I = 1, N
- J = IWORK( INDXQ+I )
- WORK( I ) = D( J )
- CALL DCOPY( QSIZ, QSTORE( 1, J ), 1, Q( 1, I ), 1 )
- 100 CONTINUE
- CALL DCOPY( N, WORK, 1, D, 1 )
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- DO 110 I = 1, N
- J = IWORK( INDXQ+I )
- WORK( I ) = D( J )
- CALL DCOPY( N, Q( 1, J ), 1, WORK( N*I+1 ), 1 )
- 110 CONTINUE
- CALL DCOPY( N, WORK, 1, D, 1 )
- CALL DLACPY( 'A', N, N, WORK( N+1 ), N, Q, LDQ )
- ELSE
- DO 120 I = 1, N
- J = IWORK( INDXQ+I )
- WORK( I ) = D( J )
- 120 CONTINUE
- CALL DCOPY( N, WORK, 1, D, 1 )
- END IF
- GO TO 140
-*
- 130 CONTINUE
- INFO = SUBMAT*( N+1 ) + SUBMAT + MATSIZ - 1
-*
- 140 CONTINUE
- RETURN
-*
-* End of DLAED0
-*
- END
diff --git a/netlib/LAPACK/dlaed1.f b/netlib/LAPACK/dlaed1.f
deleted file mode 100644
index c37c1d2..0000000
--- a/netlib/LAPACK/dlaed1.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b DLAED1 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CUTPNT, INFO, LDQ, N
-* DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
-* INTEGER INDXQ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED1 computes the updated eigensystem of a diagonal
-*> matrix after modification by a rank-one symmetric matrix. This
-*> routine is used only for the eigenproblem which requires all
-*> eigenvalues and eigenvectors of a tridiagonal matrix. DLAED7 handles
-*> the case in which eigenvalues only or eigenvalues and eigenvectors
-*> of a full symmetric matrix (which was reduced to tridiagonal form)
-*> are desired.
-*>
-*> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out)
-*>
-*> where Z = Q**T*u, u is a vector of length N with ones in the
-*> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
-*>
-*> The eigenvectors of the original matrix are stored in Q, and the
-*> eigenvalues are in D. The algorithm consists of three stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple eigenvalues or if there is a zero in
-*> the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine DLAED2.
-*>
-*> The second stage consists of calculating the updated
-*> eigenvalues. This is done by finding the roots of the secular
-*> equation via the routine DLAED4 (as called by DLAED3).
-*> This routine also calculates the eigenvectors of the current
-*> problem.
-*>
-*> The final stage consists of computing the updated eigenvectors
-*> directly using the updated eigenvalues. The eigenvectors for
-*> the current problem are multiplied with the eigenvectors from
-*> the overall problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the eigenvalues of the rank-1-perturbed matrix.
-*> On exit, the eigenvalues of the repaired matrix.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, the eigenvectors of the rank-1-perturbed matrix.
-*> On exit, the eigenvectors of the repaired tridiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> On entry, the permutation which separately sorts the two
-*> subproblems in D into ascending order.
-*> On exit, the permutation which will reintegrate the
-*> subproblems back into sorted order,
-*> i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The subdiagonal entry used to create the rank-1 modification.
-*> \endverbatim
-*>
-*> \param[in] CUTPNT
-*> \verbatim
-*> CUTPNT is INTEGER
-*> The location of the last eigenvalue in the leading sub-matrix.
-*> min(1,N) <= CUTPNT <= N/2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N + N**2)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CUTPNT, INFO, LDQ, N
- DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
- INTEGER INDXQ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER COLTYP, I, IDLMDA, INDX, INDXC, INDXP, IQ2, IS,
- $ IW, IZ, K, N1, N2, ZPP1
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAED2, DLAED3, DLAMRG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( MIN( 1, N / 2 ).GT.CUTPNT .OR. ( N / 2 ).LT.CUTPNT ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED1', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* The following values are integer pointers which indicate
-* the portion of the workspace
-* used by a particular array in DLAED2 and DLAED3.
-*
- IZ = 1
- IDLMDA = IZ + N
- IW = IDLMDA + N
- IQ2 = IW + N
-*
- INDX = 1
- INDXC = INDX + N
- COLTYP = INDXC + N
- INDXP = COLTYP + N
-*
-*
-* Form the z-vector which consists of the last row of Q_1 and the
-* first row of Q_2.
-*
- CALL DCOPY( CUTPNT, Q( CUTPNT, 1 ), LDQ, WORK( IZ ), 1 )
- ZPP1 = CUTPNT + 1
- CALL DCOPY( N-CUTPNT, Q( ZPP1, ZPP1 ), LDQ, WORK( IZ+CUTPNT ), 1 )
-*
-* Deflate eigenvalues.
-*
- CALL DLAED2( K, N, CUTPNT, D, Q, LDQ, INDXQ, RHO, WORK( IZ ),
- $ WORK( IDLMDA ), WORK( IW ), WORK( IQ2 ),
- $ IWORK( INDX ), IWORK( INDXC ), IWORK( INDXP ),
- $ IWORK( COLTYP ), INFO )
-*
- IF( INFO.NE.0 )
- $ GO TO 20
-*
-* Solve Secular Equation.
-*
- IF( K.NE.0 ) THEN
- IS = ( IWORK( COLTYP )+IWORK( COLTYP+1 ) )*CUTPNT +
- $ ( IWORK( COLTYP+1 )+IWORK( COLTYP+2 ) )*( N-CUTPNT ) + IQ2
- CALL DLAED3( K, N, CUTPNT, D, Q, LDQ, RHO, WORK( IDLMDA ),
- $ WORK( IQ2 ), IWORK( INDXC ), IWORK( COLTYP ),
- $ WORK( IW ), WORK( IS ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 20
-*
-* Prepare the INDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL DLAMRG( N1, N2, D, 1, -1, INDXQ )
- ELSE
- DO 10 I = 1, N
- INDXQ( I ) = I
- 10 CONTINUE
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of DLAED1
-*
- END
diff --git a/netlib/LAPACK/dlaed2.f b/netlib/LAPACK/dlaed2.f
deleted file mode 100644
index a75d72a..0000000
--- a/netlib/LAPACK/dlaed2.f
+++ /dev/null
@@ -1,539 +0,0 @@
-*> \brief \b DLAED2 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W,
-* Q2, INDX, INDXC, INDXP, COLTYP, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDQ, N, N1
-* DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
-* INTEGER COLTYP( * ), INDX( * ), INDXC( * ), INDXP( * ),
-* $ INDXQ( * )
-* DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
-* $ W( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED2 merges the two sets of eigenvalues together into a single
-*> sorted set. Then it tries to deflate the size of the problem.
-*> There are two ways in which deflation can occur: when two or more
-*> eigenvalues are close together or if there is a tiny entry in the
-*> Z vector. For each such occurrence the order of the related secular
-*> equation problem is reduced by one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> The number of non-deflated eigenvalues, and the order of the
-*> related secular equation. 0 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The location of the last eigenvalue in the leading sub-matrix.
-*> min(1,N) <= N1 <= N/2.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D contains the eigenvalues of the two submatrices to
-*> be combined.
-*> On exit, D contains the trailing (N-K) updated eigenvalues
-*> (those which were deflated) sorted into increasing order.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> On entry, Q contains the eigenvectors of two submatrices in
-*> the two square blocks with corners at (1,1), (N1,N1)
-*> and (N1+1, N1+1), (N,N).
-*> On exit, Q contains the trailing (N-K) updated eigenvectors
-*> (those which were deflated) in its last N-K columns.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> The permutation which separately sorts the two sub-problems
-*> in D into ascending order. Note that elements in the second
-*> half of this permutation must first have N1 added to their
-*> values. Destroyed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> On entry, the off-diagonal element associated with the rank-1
-*> cut which originally split the two submatrices which are now
-*> being recombined.
-*> On exit, RHO has been modified to the value required by
-*> DLAED3.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (N)
-*> On entry, Z contains the updating vector (the last
-*> row of the first sub-eigenvector matrix and the first row of
-*> the second sub-eigenvector matrix).
-*> On exit, the contents of Z have been destroyed by the updating
-*> process.
-*> \endverbatim
-*>
-*> \param[out] DLAMDA
-*> \verbatim
-*> DLAMDA is DOUBLE PRECISION array, dimension (N)
-*> A copy of the first K eigenvalues which will be used by
-*> DLAED3 to form the secular equation.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first k values of the final deflation-altered z-vector
-*> which will be passed to DLAED3.
-*> \endverbatim
-*>
-*> \param[out] Q2
-*> \verbatim
-*> Q2 is DOUBLE PRECISION array, dimension (N1**2+(N-N1)**2)
-*> A copy of the first K eigenvectors which will be used by
-*> DLAED3 in a matrix multiply (DGEMM) to solve for the new
-*> eigenvectors.
-*> \endverbatim
-*>
-*> \param[out] INDX
-*> \verbatim
-*> INDX is INTEGER array, dimension (N)
-*> The permutation used to sort the contents of DLAMDA into
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] INDXC
-*> \verbatim
-*> INDXC is INTEGER array, dimension (N)
-*> The permutation used to arrange the columns of the deflated
-*> Q matrix into three groups: the first group contains non-zero
-*> elements only at and above N1, the second contains
-*> non-zero elements only below N1, and the third is dense.
-*> \endverbatim
-*>
-*> \param[out] INDXP
-*> \verbatim
-*> INDXP is INTEGER array, dimension (N)
-*> The permutation used to place deflated values of D at the end
-*> of the array. INDXP(1:K) points to the nondeflated D-values
-*> and INDXP(K+1:N) points to the deflated eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] COLTYP
-*> \verbatim
-*> COLTYP is INTEGER array, dimension (N)
-*> During execution, a label which will indicate which of the
-*> following types a column in the Q2 matrix is:
-*> 1 : non-zero in the upper half only;
-*> 2 : dense;
-*> 3 : non-zero in the lower half only;
-*> 4 : deflated.
-*> On exit, COLTYP(i) is the number of columns of type i,
-*> for i=1 to 4 only.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W,
- $ Q2, INDX, INDXC, INDXP, COLTYP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDQ, N, N1
- DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
- INTEGER COLTYP( * ), INDX( * ), INDXC( * ), INDXP( * ),
- $ INDXQ( * )
- DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
- $ W( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION MONE, ZERO, ONE, TWO, EIGHT
- PARAMETER ( MONE = -1.0D0, ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, EIGHT = 8.0D0 )
-* ..
-* .. Local Arrays ..
- INTEGER CTOT( 4 ), PSM( 4 )
-* ..
-* .. Local Scalars ..
- INTEGER CT, I, IMAX, IQ1, IQ2, J, JMAX, JS, K2, N1P1,
- $ N2, NJ, PJ
- DOUBLE PRECISION C, EPS, S, T, TAU, TOL
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL IDAMAX, DLAMCH, DLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DLAMRG, DROT, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( MIN( 1, ( N / 2 ) ).GT.N1 .OR. ( N / 2 ).LT.N1 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- N2 = N - N1
- N1P1 = N1 + 1
-*
- IF( RHO.LT.ZERO ) THEN
- CALL DSCAL( N2, MONE, Z( N1P1 ), 1 )
- END IF
-*
-* Normalize z so that norm(z) = 1. Since z is the concatenation of
-* two normalized vectors, norm2(z) = sqrt(2).
-*
- T = ONE / SQRT( TWO )
- CALL DSCAL( N, T, Z, 1 )
-*
-* RHO = ABS( norm(z)**2 * RHO )
-*
- RHO = ABS( TWO*RHO )
-*
-* Sort the eigenvalues into increasing order
-*
- DO 10 I = N1P1, N
- INDXQ( I ) = INDXQ( I ) + N1
- 10 CONTINUE
-*
-* re-integrate the deflated parts from the last pass
-*
- DO 20 I = 1, N
- DLAMDA( I ) = D( INDXQ( I ) )
- 20 CONTINUE
- CALL DLAMRG( N1, N2, DLAMDA, 1, 1, INDXC )
- DO 30 I = 1, N
- INDX( I ) = INDXQ( INDXC( I ) )
- 30 CONTINUE
-*
-* Calculate the allowable deflation tolerance
-*
- IMAX = IDAMAX( N, Z, 1 )
- JMAX = IDAMAX( N, D, 1 )
- EPS = DLAMCH( 'Epsilon' )
- TOL = EIGHT*EPS*MAX( ABS( D( JMAX ) ), ABS( Z( IMAX ) ) )
-*
-* If the rank-1 modifier is small enough, no more needs to be done
-* except to reorganize Q so that its columns correspond with the
-* elements in D.
-*
- IF( RHO*ABS( Z( IMAX ) ).LE.TOL ) THEN
- K = 0
- IQ2 = 1
- DO 40 J = 1, N
- I = INDX( J )
- CALL DCOPY( N, Q( 1, I ), 1, Q2( IQ2 ), 1 )
- DLAMDA( J ) = D( I )
- IQ2 = IQ2 + N
- 40 CONTINUE
- CALL DLACPY( 'A', N, N, Q2, N, Q, LDQ )
- CALL DCOPY( N, DLAMDA, 1, D, 1 )
- GO TO 190
- END IF
-*
-* If there are multiple eigenvalues then the problem deflates. Here
-* the number of equal eigenvalues are found. As each equal
-* eigenvalue is found, an elementary reflector is computed to rotate
-* the corresponding eigensubspace so that the corresponding
-* components of Z are zero in this new basis.
-*
- DO 50 I = 1, N1
- COLTYP( I ) = 1
- 50 CONTINUE
- DO 60 I = N1P1, N
- COLTYP( I ) = 3
- 60 CONTINUE
-*
-*
- K = 0
- K2 = N + 1
- DO 70 J = 1, N
- NJ = INDX( J )
- IF( RHO*ABS( Z( NJ ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- COLTYP( NJ ) = 4
- INDXP( K2 ) = NJ
- IF( J.EQ.N )
- $ GO TO 100
- ELSE
- PJ = NJ
- GO TO 80
- END IF
- 70 CONTINUE
- 80 CONTINUE
- J = J + 1
- NJ = INDX( J )
- IF( J.GT.N )
- $ GO TO 100
- IF( RHO*ABS( Z( NJ ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- COLTYP( NJ ) = 4
- INDXP( K2 ) = NJ
- ELSE
-*
-* Check if eigenvalues are close enough to allow deflation.
-*
- S = Z( PJ )
- C = Z( NJ )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = DLAPY2( C, S )
- T = D( NJ ) - D( PJ )
- C = C / TAU
- S = -S / TAU
- IF( ABS( T*C*S ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- Z( NJ ) = TAU
- Z( PJ ) = ZERO
- IF( COLTYP( NJ ).NE.COLTYP( PJ ) )
- $ COLTYP( NJ ) = 2
- COLTYP( PJ ) = 4
- CALL DROT( N, Q( 1, PJ ), 1, Q( 1, NJ ), 1, C, S )
- T = D( PJ )*C**2 + D( NJ )*S**2
- D( NJ ) = D( PJ )*S**2 + D( NJ )*C**2
- D( PJ ) = T
- K2 = K2 - 1
- I = 1
- 90 CONTINUE
- IF( K2+I.LE.N ) THEN
- IF( D( PJ ).LT.D( INDXP( K2+I ) ) ) THEN
- INDXP( K2+I-1 ) = INDXP( K2+I )
- INDXP( K2+I ) = PJ
- I = I + 1
- GO TO 90
- ELSE
- INDXP( K2+I-1 ) = PJ
- END IF
- ELSE
- INDXP( K2+I-1 ) = PJ
- END IF
- PJ = NJ
- ELSE
- K = K + 1
- DLAMDA( K ) = D( PJ )
- W( K ) = Z( PJ )
- INDXP( K ) = PJ
- PJ = NJ
- END IF
- END IF
- GO TO 80
- 100 CONTINUE
-*
-* Record the last eigenvalue.
-*
- K = K + 1
- DLAMDA( K ) = D( PJ )
- W( K ) = Z( PJ )
- INDXP( K ) = PJ
-*
-* Count up the total number of the various types of columns, then
-* form a permutation which positions the four column types into
-* four uniform groups (although one or more of these groups may be
-* empty).
-*
- DO 110 J = 1, 4
- CTOT( J ) = 0
- 110 CONTINUE
- DO 120 J = 1, N
- CT = COLTYP( J )
- CTOT( CT ) = CTOT( CT ) + 1
- 120 CONTINUE
-*
-* PSM(*) = Position in SubMatrix (of types 1 through 4)
-*
- PSM( 1 ) = 1
- PSM( 2 ) = 1 + CTOT( 1 )
- PSM( 3 ) = PSM( 2 ) + CTOT( 2 )
- PSM( 4 ) = PSM( 3 ) + CTOT( 3 )
- K = N - CTOT( 4 )
-*
-* Fill out the INDXC array so that the permutation which it induces
-* will place all type-1 columns first, all type-2 columns next,
-* then all type-3's, and finally all type-4's.
-*
- DO 130 J = 1, N
- JS = INDXP( J )
- CT = COLTYP( JS )
- INDX( PSM( CT ) ) = JS
- INDXC( PSM( CT ) ) = J
- PSM( CT ) = PSM( CT ) + 1
- 130 CONTINUE
-*
-* Sort the eigenvalues and corresponding eigenvectors into DLAMDA
-* and Q2 respectively. The eigenvalues/vectors which were not
-* deflated go into the first K slots of DLAMDA and Q2 respectively,
-* while those which were deflated go into the last N - K slots.
-*
- I = 1
- IQ1 = 1
- IQ2 = 1 + ( CTOT( 1 )+CTOT( 2 ) )*N1
- DO 140 J = 1, CTOT( 1 )
- JS = INDX( I )
- CALL DCOPY( N1, Q( 1, JS ), 1, Q2( IQ1 ), 1 )
- Z( I ) = D( JS )
- I = I + 1
- IQ1 = IQ1 + N1
- 140 CONTINUE
-*
- DO 150 J = 1, CTOT( 2 )
- JS = INDX( I )
- CALL DCOPY( N1, Q( 1, JS ), 1, Q2( IQ1 ), 1 )
- CALL DCOPY( N2, Q( N1+1, JS ), 1, Q2( IQ2 ), 1 )
- Z( I ) = D( JS )
- I = I + 1
- IQ1 = IQ1 + N1
- IQ2 = IQ2 + N2
- 150 CONTINUE
-*
- DO 160 J = 1, CTOT( 3 )
- JS = INDX( I )
- CALL DCOPY( N2, Q( N1+1, JS ), 1, Q2( IQ2 ), 1 )
- Z( I ) = D( JS )
- I = I + 1
- IQ2 = IQ2 + N2
- 160 CONTINUE
-*
- IQ1 = IQ2
- DO 170 J = 1, CTOT( 4 )
- JS = INDX( I )
- CALL DCOPY( N, Q( 1, JS ), 1, Q2( IQ2 ), 1 )
- IQ2 = IQ2 + N
- Z( I ) = D( JS )
- I = I + 1
- 170 CONTINUE
-*
-* The deflated eigenvalues and their corresponding vectors go back
-* into the last N - K slots of D and Q respectively.
-*
- IF( K.LT.N ) THEN
- CALL DLACPY( 'A', N, CTOT( 4 ), Q2( IQ1 ), N,
- $ Q( 1, K+1 ), LDQ )
- CALL DCOPY( N-K, Z( K+1 ), 1, D( K+1 ), 1 )
- END IF
-*
-* Copy CTOT into COLTYP for referencing in DLAED3.
-*
- DO 180 J = 1, 4
- COLTYP( J ) = CTOT( J )
- 180 CONTINUE
-*
- 190 CONTINUE
- RETURN
-*
-* End of DLAED2
-*
- END
diff --git a/netlib/LAPACK/dlaed3.f b/netlib/LAPACK/dlaed3.f
deleted file mode 100644
index 411d0f8..0000000
--- a/netlib/LAPACK/dlaed3.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b DLAED3 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
-* CTOT, W, S, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDQ, N, N1
-* DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
-* INTEGER CTOT( * ), INDX( * )
-* DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
-* $ S( * ), W( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED3 finds the roots of the secular equation, as defined by the
-*> values in D, W, and RHO, between 1 and K. It makes the
-*> appropriate calls to DLAED4 and then updates the eigenvectors by
-*> multiplying the matrix of eigenvectors of the pair of eigensystems
-*> being combined by the matrix of eigenvectors of the K-by-K system
-*> which is solved here.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of terms in the rational function to be solved by
-*> DLAED4. K >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the Q matrix.
-*> N >= K (deflation may result in N>K).
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The location of the last eigenvalue in the leading submatrix.
-*> min(1,N) <= N1 <= N/2.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> D(I) contains the updated eigenvalues for
-*> 1 <= I <= K.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> Initially the first K columns are used as workspace.
-*> On output the columns 1 to K contain
-*> the updated eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The value of the parameter in the rank one update equation.
-*> RHO >= 0 required.
-*> \endverbatim
-*>
-*> \param[in,out] DLAMDA
-*> \verbatim
-*> DLAMDA is DOUBLE PRECISION array, dimension (K)
-*> The first K elements of this array contain the old roots
-*> of the deflated updating problem. These are the poles
-*> of the secular equation. May be changed on output by
-*> having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
-*> Cray-2, or Cray C-90, as described above.
-*> \endverbatim
-*>
-*> \param[in] Q2
-*> \verbatim
-*> Q2 is DOUBLE PRECISION array, dimension (LDQ2, N)
-*> The first K columns of this matrix contain the non-deflated
-*> eigenvectors for the split problem.
-*> \endverbatim
-*>
-*> \param[in] INDX
-*> \verbatim
-*> INDX is INTEGER array, dimension (N)
-*> The permutation used to arrange the columns of the deflated
-*> Q matrix into three groups (see DLAED2).
-*> The rows of the eigenvectors found by DLAED4 must be likewise
-*> permuted before the matrix multiply can take place.
-*> \endverbatim
-*>
-*> \param[in] CTOT
-*> \verbatim
-*> CTOT is INTEGER array, dimension (4)
-*> A count of the total number of the various types of columns
-*> in Q, as described in INDX. The fourth column type is any
-*> column which has been deflated.
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (K)
-*> The first K elements of this array contain the components
-*> of the deflation-adjusted updating vector. Destroyed on
-*> output.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N1 + 1)*K
-*> Will contain the eigenvectors of the repaired matrix which
-*> will be multiplied by the previously accumulated eigenvectors
-*> to update the system.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
- $ CTOT, W, S, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDQ, N, N1
- DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
- INTEGER CTOT( * ), INDX( * )
- DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
- $ S( * ), W( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, II, IQ2, J, N12, N2, N23
- DOUBLE PRECISION TEMP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3, DNRM2
- EXTERNAL DLAMC3, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DLACPY, DLAED4, DLASET, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( K.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.K ) THEN
- INFO = -2
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED3', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 )
- $ RETURN
-*
-* Modify values DLAMDA(i) to make sure all DLAMDA(i)-DLAMDA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DLAMDA(I) by 2*DLAMDA(I)-DLAMDA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DLAMDA(I) if it is 1; this makes the subsequent
-* subtractions DLAMDA(I)-DLAMDA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DLAMDA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DLAMDA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 10 I = 1, K
- DLAMDA( I ) = DLAMC3( DLAMDA( I ), DLAMDA( I ) ) - DLAMDA( I )
- 10 CONTINUE
-*
- DO 20 J = 1, K
- CALL DLAED4( K, J, DLAMDA, W, Q( 1, J ), RHO, D( J ), INFO )
-*
-* If the zero finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 )
- $ GO TO 120
- 20 CONTINUE
-*
- IF( K.EQ.1 )
- $ GO TO 110
- IF( K.EQ.2 ) THEN
- DO 30 J = 1, K
- W( 1 ) = Q( 1, J )
- W( 2 ) = Q( 2, J )
- II = INDX( 1 )
- Q( 1, J ) = W( II )
- II = INDX( 2 )
- Q( 2, J ) = W( II )
- 30 CONTINUE
- GO TO 110
- END IF
-*
-* Compute updated W.
-*
- CALL DCOPY( K, W, 1, S, 1 )
-*
-* Initialize W(I) = Q(I,I)
-*
- CALL DCOPY( K, Q, LDQ+1, W, 1 )
- DO 60 J = 1, K
- DO 40 I = 1, J - 1
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 40 CONTINUE
- DO 50 I = J + 1, K
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 50 CONTINUE
- 60 CONTINUE
- DO 70 I = 1, K
- W( I ) = SIGN( SQRT( -W( I ) ), S( I ) )
- 70 CONTINUE
-*
-* Compute eigenvectors of the modified rank-1 modification.
-*
- DO 100 J = 1, K
- DO 80 I = 1, K
- S( I ) = W( I ) / Q( I, J )
- 80 CONTINUE
- TEMP = DNRM2( K, S, 1 )
- DO 90 I = 1, K
- II = INDX( I )
- Q( I, J ) = S( II ) / TEMP
- 90 CONTINUE
- 100 CONTINUE
-*
-* Compute the updated eigenvectors.
-*
- 110 CONTINUE
-*
- N2 = N - N1
- N12 = CTOT( 1 ) + CTOT( 2 )
- N23 = CTOT( 2 ) + CTOT( 3 )
-*
- CALL DLACPY( 'A', N23, K, Q( CTOT( 1 )+1, 1 ), LDQ, S, N23 )
- IQ2 = N1*N12 + 1
- IF( N23.NE.0 ) THEN
- CALL DGEMM( 'N', 'N', N2, K, N23, ONE, Q2( IQ2 ), N2, S, N23,
- $ ZERO, Q( N1+1, 1 ), LDQ )
- ELSE
- CALL DLASET( 'A', N2, K, ZERO, ZERO, Q( N1+1, 1 ), LDQ )
- END IF
-*
- CALL DLACPY( 'A', N12, K, Q, LDQ, S, N12 )
- IF( N12.NE.0 ) THEN
- CALL DGEMM( 'N', 'N', N1, K, N12, ONE, Q2, N1, S, N12, ZERO, Q,
- $ LDQ )
- ELSE
- CALL DLASET( 'A', N1, K, ZERO, ZERO, Q( 1, 1 ), LDQ )
- END IF
-*
-*
- 120 CONTINUE
- RETURN
-*
-* End of DLAED3
-*
- END
diff --git a/netlib/LAPACK/dlaed4.f b/netlib/LAPACK/dlaed4.f
deleted file mode 100644
index c898b5b..0000000
--- a/netlib/LAPACK/dlaed4.f
+++ /dev/null
@@ -1,917 +0,0 @@
-*> \brief \b DLAED4 used by sstedc. Finds a single root of the secular equation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER I, INFO, N
-* DOUBLE PRECISION DLAM, RHO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DELTA( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the I-th updated eigenvalue of a symmetric
-*> rank-one modification to a diagonal matrix whose elements are
-*> given in the array d, and that
-*>
-*> D(i) < D(j) for i < j
-*>
-*> and that RHO > 0. This is arranged by the calling routine, and is
-*> no loss in generality. The rank-one modified system is thus
-*>
-*> diag( D ) + RHO * Z * Z_transpose.
-*>
-*> where we assume the Euclidean norm of Z is 1.
-*>
-*> The method consists of approximating the rational functions in the
-*> secular equation by simpler interpolating rational functions.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of all arrays.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. 1 <= I <= N.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The original eigenvalues. It is assumed that they are in
-*> order, D(I) < D(J) for I < J.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (N)
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is DOUBLE PRECISION array, dimension (N)
-*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th
-*> component. If N = 1, then DELTA(1) = 1. If N = 2, see DLAED5
-*> for detail. The vector DELTA contains the information necessary
-*> to construct the eigenvectors by DLAED3 and DLAED9.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] DLAM
-*> \verbatim
-*> DLAM is DOUBLE PRECISION
-*> The computed lambda_I, the I-th updated eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = 1, the updating process failed.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> Logical variable ORGATI (origin-at-i?) is used for distinguishing
-*> whether D(i) or D(i+1) is treated as the origin.
-*>
-*> ORGATI = .true. origin at i
-*> ORGATI = .false. origin at i+1
-*>
-*> Logical variable SWTCH3 (switch-for-3-poles?) is for noting
-*> if we are working with THREE poles!
-*>
-*> MAXIT is the maximum number of iterations allowed for each
-*> eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I, INFO, N
- DOUBLE PRECISION DLAM, RHO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DELTA( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 30 )
- DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR, EIGHT, TEN
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ THREE = 3.0D0, FOUR = 4.0D0, EIGHT = 8.0D0,
- $ TEN = 10.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ORGATI, SWTCH, SWTCH3
- INTEGER II, IIM1, IIP1, IP1, ITER, J, NITER
- DOUBLE PRECISION A, B, C, DEL, DLTLB, DLTUB, DPHI, DPSI, DW,
- $ EPS, ERRETM, ETA, MIDPT, PHI, PREW, PSI,
- $ RHOINV, TAU, TEMP, TEMP1, W
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION ZZ( 3 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAED5, DLAED6
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Since this routine is called in an inner loop, we do no argument
-* checking.
-*
-* Quick return for N=1 and 2.
-*
- INFO = 0
- IF( N.EQ.1 ) THEN
-*
-* Presumably, I=1 upon entry
-*
- DLAM = D( 1 ) + RHO*Z( 1 )*Z( 1 )
- DELTA( 1 ) = ONE
- RETURN
- END IF
- IF( N.EQ.2 ) THEN
- CALL DLAED5( I, D, Z, DELTA, RHO, DLAM )
- RETURN
- END IF
-*
-* Compute machine epsilon
-*
- EPS = DLAMCH( 'Epsilon' )
- RHOINV = ONE / RHO
-*
-* The case I = N
-*
- IF( I.EQ.N ) THEN
-*
-* Initialize some basic variables
-*
- II = N - 1
- NITER = 1
-*
-* Calculate initial guess
-*
- MIDPT = RHO / TWO
-*
-* If ||Z||_2 is not one, then TEMP should be set to
-* RHO * ||Z||_2^2 / TWO
-*
- DO 10 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - MIDPT
- 10 CONTINUE
-*
- PSI = ZERO
- DO 20 J = 1, N - 2
- PSI = PSI + Z( J )*Z( J ) / DELTA( J )
- 20 CONTINUE
-*
- C = RHOINV + PSI
- W = C + Z( II )*Z( II ) / DELTA( II ) +
- $ Z( N )*Z( N ) / DELTA( N )
-*
- IF( W.LE.ZERO ) THEN
- TEMP = Z( N-1 )*Z( N-1 ) / ( D( N )-D( N-1 )+RHO ) +
- $ Z( N )*Z( N ) / RHO
- IF( C.LE.TEMP ) THEN
- TAU = RHO
- ELSE
- DEL = D( N ) - D( N-1 )
- A = -C*DEL + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DEL
- IF( A.LT.ZERO ) THEN
- TAU = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
- END IF
-*
-* It can be proved that
-* D(N)+RHO/2 <= LAMBDA(N) < D(N)+TAU <= D(N)+RHO
-*
- DLTLB = MIDPT
- DLTUB = RHO
- ELSE
- DEL = D( N ) - D( N-1 )
- A = -C*DEL + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DEL
- IF( A.LT.ZERO ) THEN
- TAU = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
-*
-* It can be proved that
-* D(N) < D(N)+TAU < LAMBDA(N) < D(N)+RHO/2
-*
- DLTLB = ZERO
- DLTUB = MIDPT
- END IF
-*
- DO 30 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - TAU
- 30 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 40 J = 1, II
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 40 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / DELTA( N )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +
- $ ABS( TAU )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- DLAM = D( I ) + TAU
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- C = W - DELTA( N-1 )*DPSI - DELTA( N )*DPHI
- A = ( DELTA( N-1 )+DELTA( N ) )*W -
- $ DELTA( N-1 )*DELTA( N )*( DPSI+DPHI )
- B = DELTA( N-1 )*DELTA( N )*W
- IF( C.LT.ZERO )
- $ C = ABS( C )
- IF( C.EQ.ZERO ) THEN
-* ETA = B/A
-* ETA = RHO - TAU
- ETA = DLTUB - TAU
- ELSE IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
- DO 50 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 50 CONTINUE
-*
- TAU = TAU + ETA
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 60 J = 1, II
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 60 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / DELTA( N )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +
- $ ABS( TAU )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Main loop to update the values of the array DELTA
-*
- ITER = NITER + 1
-*
- DO 90 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- DLAM = D( I ) + TAU
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- C = W - DELTA( N-1 )*DPSI - DELTA( N )*DPHI
- A = ( DELTA( N-1 )+DELTA( N ) )*W -
- $ DELTA( N-1 )*DELTA( N )*( DPSI+DPHI )
- B = DELTA( N-1 )*DELTA( N )*W
- IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
- DO 70 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 70 CONTINUE
-*
- TAU = TAU + ETA
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 80 J = 1, II
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 80 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / DELTA( N )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +
- $ ABS( TAU )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
- 90 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
- DLAM = D( I ) + TAU
- GO TO 250
-*
-* End for the case I = N
-*
- ELSE
-*
-* The case for I < N
-*
- NITER = 1
- IP1 = I + 1
-*
-* Calculate initial guess
-*
- DEL = D( IP1 ) - D( I )
- MIDPT = DEL / TWO
- DO 100 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - MIDPT
- 100 CONTINUE
-*
- PSI = ZERO
- DO 110 J = 1, I - 1
- PSI = PSI + Z( J )*Z( J ) / DELTA( J )
- 110 CONTINUE
-*
- PHI = ZERO
- DO 120 J = N, I + 2, -1
- PHI = PHI + Z( J )*Z( J ) / DELTA( J )
- 120 CONTINUE
- C = RHOINV + PSI + PHI
- W = C + Z( I )*Z( I ) / DELTA( I ) +
- $ Z( IP1 )*Z( IP1 ) / DELTA( IP1 )
-*
- IF( W.GT.ZERO ) THEN
-*
-* d(i)< the ith eigenvalue < (d(i)+d(i+1))/2
-*
-* We choose d(i) as origin.
-*
- ORGATI = .TRUE.
- A = C*DEL + Z( I )*Z( I ) + Z( IP1 )*Z( IP1 )
- B = Z( I )*Z( I )*DEL
- IF( A.GT.ZERO ) THEN
- TAU = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- ELSE
- TAU = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- END IF
- DLTLB = ZERO
- DLTUB = MIDPT
- ELSE
-*
-* (d(i)+d(i+1))/2 <= the ith eigenvalue < d(i+1)
-*
-* We choose d(i+1) as origin.
-*
- ORGATI = .FALSE.
- A = C*DEL - Z( I )*Z( I ) - Z( IP1 )*Z( IP1 )
- B = Z( IP1 )*Z( IP1 )*DEL
- IF( A.LT.ZERO ) THEN
- TAU = TWO*B / ( A-SQRT( ABS( A*A+FOUR*B*C ) ) )
- ELSE
- TAU = -( A+SQRT( ABS( A*A+FOUR*B*C ) ) ) / ( TWO*C )
- END IF
- DLTLB = -MIDPT
- DLTUB = ZERO
- END IF
-*
- IF( ORGATI ) THEN
- DO 130 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - TAU
- 130 CONTINUE
- ELSE
- DO 140 J = 1, N
- DELTA( J ) = ( D( J )-D( IP1 ) ) - TAU
- 140 CONTINUE
- END IF
- IF( ORGATI ) THEN
- II = I
- ELSE
- II = I + 1
- END IF
- IIM1 = II - 1
- IIP1 = II + 1
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 150 J = 1, IIM1
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 150 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 160 J = N, IIP1, -1
- TEMP = Z( J ) / DELTA( J )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 160 CONTINUE
-*
- W = RHOINV + PHI + PSI
-*
-* W is the value of the secular function with
-* its ii-th element removed.
-*
- SWTCH3 = .FALSE.
- IF( ORGATI ) THEN
- IF( W.LT.ZERO )
- $ SWTCH3 = .TRUE.
- ELSE
- IF( W.GT.ZERO )
- $ SWTCH3 = .TRUE.
- END IF
- IF( II.EQ.1 .OR. II.EQ.N )
- $ SWTCH3 = .FALSE.
-*
- TEMP = Z( II ) / DELTA( II )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = W + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV +
- $ THREE*ABS( TEMP ) + ABS( TAU )*DW
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- IF( ORGATI ) THEN
- DLAM = D( I ) + TAU
- ELSE
- DLAM = D( IP1 ) + TAU
- END IF
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- IF( .NOT.SWTCH3 ) THEN
- IF( ORGATI ) THEN
- C = W - DELTA( IP1 )*DW - ( D( I )-D( IP1 ) )*
- $ ( Z( I ) / DELTA( I ) )**2
- ELSE
- C = W - DELTA( I )*DW - ( D( IP1 )-D( I ) )*
- $ ( Z( IP1 ) / DELTA( IP1 ) )**2
- END IF
- A = ( DELTA( I )+DELTA( IP1 ) )*W -
- $ DELTA( I )*DELTA( IP1 )*DW
- B = DELTA( I )*DELTA( IP1 )*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DELTA( IP1 )*DELTA( IP1 )*
- $ ( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) + DELTA( I )*DELTA( I )*
- $ ( DPSI+DPHI )
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- TEMP = RHOINV + PSI + PHI
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DELTA( IIM1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIP1 )*( DPSI+DPHI ) -
- $ ( D( IIM1 )-D( IIP1 ) )*TEMP1
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- ZZ( 3 ) = DELTA( IIP1 )*DELTA( IIP1 )*
- $ ( ( DPSI-TEMP1 )+DPHI )
- ELSE
- TEMP1 = Z( IIP1 ) / DELTA( IIP1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIM1 )*( DPSI+DPHI ) -
- $ ( D( IIP1 )-D( IIM1 ) )*TEMP1
- ZZ( 1 ) = DELTA( IIM1 )*DELTA( IIM1 )*
- $ ( DPSI+( DPHI-TEMP1 ) )
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- ZZ( 2 ) = Z( II )*Z( II )
- CALL DLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, ETA,
- $ INFO )
- IF( INFO.NE.0 )
- $ GO TO 250
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
-*
- PREW = W
-*
- DO 180 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 180 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 190 J = 1, IIM1
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 190 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 200 J = N, IIP1, -1
- TEMP = Z( J ) / DELTA( J )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 200 CONTINUE
-*
- TEMP = Z( II ) / DELTA( II )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV +
- $ THREE*ABS( TEMP ) + ABS( TAU+ETA )*DW
-*
- SWTCH = .FALSE.
- IF( ORGATI ) THEN
- IF( -W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- ELSE
- IF( W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- END IF
-*
- TAU = TAU + ETA
-*
-* Main loop to update the values of the array DELTA
-*
- ITER = NITER + 1
-*
- DO 240 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- IF( ORGATI ) THEN
- DLAM = D( I ) + TAU
- ELSE
- DLAM = D( IP1 ) + TAU
- END IF
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- IF( .NOT.SWTCH3 ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- C = W - DELTA( IP1 )*DW -
- $ ( D( I )-D( IP1 ) )*( Z( I ) / DELTA( I ) )**2
- ELSE
- C = W - DELTA( I )*DW - ( D( IP1 )-D( I ) )*
- $ ( Z( IP1 ) / DELTA( IP1 ) )**2
- END IF
- ELSE
- TEMP = Z( II ) / DELTA( II )
- IF( ORGATI ) THEN
- DPSI = DPSI + TEMP*TEMP
- ELSE
- DPHI = DPHI + TEMP*TEMP
- END IF
- C = W - DELTA( I )*DPSI - DELTA( IP1 )*DPHI
- END IF
- A = ( DELTA( I )+DELTA( IP1 ) )*W -
- $ DELTA( I )*DELTA( IP1 )*DW
- B = DELTA( I )*DELTA( IP1 )*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DELTA( IP1 )*
- $ DELTA( IP1 )*( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) +
- $ DELTA( I )*DELTA( I )*( DPSI+DPHI )
- END IF
- ELSE
- A = DELTA( I )*DELTA( I )*DPSI +
- $ DELTA( IP1 )*DELTA( IP1 )*DPHI
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- TEMP = RHOINV + PSI + PHI
- IF( SWTCH ) THEN
- C = TEMP - DELTA( IIM1 )*DPSI - DELTA( IIP1 )*DPHI
- ZZ( 1 ) = DELTA( IIM1 )*DELTA( IIM1 )*DPSI
- ZZ( 3 ) = DELTA( IIP1 )*DELTA( IIP1 )*DPHI
- ELSE
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DELTA( IIM1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIP1 )*( DPSI+DPHI ) -
- $ ( D( IIM1 )-D( IIP1 ) )*TEMP1
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- ZZ( 3 ) = DELTA( IIP1 )*DELTA( IIP1 )*
- $ ( ( DPSI-TEMP1 )+DPHI )
- ELSE
- TEMP1 = Z( IIP1 ) / DELTA( IIP1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIM1 )*( DPSI+DPHI ) -
- $ ( D( IIP1 )-D( IIM1 ) )*TEMP1
- ZZ( 1 ) = DELTA( IIM1 )*DELTA( IIM1 )*
- $ ( DPSI+( DPHI-TEMP1 ) )
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- END IF
- CALL DLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, ETA,
- $ INFO )
- IF( INFO.NE.0 )
- $ GO TO 250
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
-*
- DO 210 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 210 CONTINUE
-*
- TAU = TAU + ETA
- PREW = W
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 220 J = 1, IIM1
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 220 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 230 J = N, IIP1, -1
- TEMP = Z( J ) / DELTA( J )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 230 CONTINUE
-*
- TEMP = Z( II ) / DELTA( II )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV +
- $ THREE*ABS( TEMP ) + ABS( TAU )*DW
- IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN )
- $ SWTCH = .NOT.SWTCH
-*
- 240 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
- IF( ORGATI ) THEN
- DLAM = D( I ) + TAU
- ELSE
- DLAM = D( IP1 ) + TAU
- END IF
-*
- END IF
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of DLAED4
-*
- END
diff --git a/netlib/LAPACK/dlaed5.f b/netlib/LAPACK/dlaed5.f
deleted file mode 100644
index 3ac9aa1..0000000
--- a/netlib/LAPACK/dlaed5.f
+++ /dev/null
@@ -1,189 +0,0 @@
-*> \brief \b DLAED5 used by sstedc. Solves the 2-by-2 secular equation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM )
-*
-* .. Scalar Arguments ..
-* INTEGER I
-* DOUBLE PRECISION DLAM, RHO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( 2 ), DELTA( 2 ), Z( 2 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the I-th eigenvalue of a symmetric rank-one
-*> modification of a 2-by-2 diagonal matrix
-*>
-*> diag( D ) + RHO * Z * transpose(Z) .
-*>
-*> The diagonal elements in the array D are assumed to satisfy
-*>
-*> D(i) < D(j) for i < j .
-*>
-*> We also assume RHO > 0 and that the Euclidean norm of the vector
-*> Z is one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. I = 1 or I = 2.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (2)
-*> The original eigenvalues. We assume D(1) < D(2).
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (2)
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is DOUBLE PRECISION array, dimension (2)
-*> The vector DELTA contains the information necessary
-*> to construct the eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] DLAM
-*> \verbatim
-*> DLAM is DOUBLE PRECISION
-*> The computed lambda_I, the I-th updated eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I
- DOUBLE PRECISION DLAM, RHO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( 2 ), DELTA( 2 ), Z( 2 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, FOUR
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ FOUR = 4.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION B, C, DEL, TAU, TEMP, W
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- DEL = D( 2 ) - D( 1 )
- IF( I.EQ.1 ) THEN
- W = ONE + TWO*RHO*( Z( 2 )*Z( 2 )-Z( 1 )*Z( 1 ) ) / DEL
- IF( W.GT.ZERO ) THEN
- B = DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 1 )*Z( 1 )*DEL
-*
-* B > ZERO, always
-*
- TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) )
- DLAM = D( 1 ) + TAU
- DELTA( 1 ) = -Z( 1 ) / TAU
- DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
- ELSE
- B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DEL
- IF( B.GT.ZERO ) THEN
- TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) )
- ELSE
- TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO
- END IF
- DLAM = D( 2 ) + TAU
- DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
- DELTA( 2 ) = -Z( 2 ) / TAU
- END IF
- TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
- DELTA( 1 ) = DELTA( 1 ) / TEMP
- DELTA( 2 ) = DELTA( 2 ) / TEMP
- ELSE
-*
-* Now I=2
-*
- B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DEL
- IF( B.GT.ZERO ) THEN
- TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO
- ELSE
- TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) )
- END IF
- DLAM = D( 2 ) + TAU
- DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
- DELTA( 2 ) = -Z( 2 ) / TAU
- TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
- DELTA( 1 ) = DELTA( 1 ) / TEMP
- DELTA( 2 ) = DELTA( 2 ) / TEMP
- END IF
- RETURN
-*
-* End OF DLAED5
-*
- END
diff --git a/netlib/LAPACK/dlaed6.f b/netlib/LAPACK/dlaed6.f
deleted file mode 100644
index 1ce4932..0000000
--- a/netlib/LAPACK/dlaed6.f
+++ /dev/null
@@ -1,409 +0,0 @@
-*> \brief \b DLAED6 used by sstedc. Computes one Newton step in solution of the secular equation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL ORGATI
-* INTEGER INFO, KNITER
-* DOUBLE PRECISION FINIT, RHO, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( 3 ), Z( 3 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED6 computes the positive or negative root (closest to the origin)
-*> of
-*> z(1) z(2) z(3)
-*> f(x) = rho + --------- + ---------- + ---------
-*> d(1)-x d(2)-x d(3)-x
-*>
-*> It is assumed that
-*>
-*> if ORGATI = .true. the root is between d(2) and d(3);
-*> otherwise it is between d(1) and d(2)
-*>
-*> This routine will be called by DLAED4 when necessary. In most cases,
-*> the root sought is the smallest in magnitude, though it might not be
-*> in some extremely rare situations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] KNITER
-*> \verbatim
-*> KNITER is INTEGER
-*> Refer to DLAED4 for its significance.
-*> \endverbatim
-*>
-*> \param[in] ORGATI
-*> \verbatim
-*> ORGATI is LOGICAL
-*> If ORGATI is true, the needed root is between d(2) and
-*> d(3); otherwise it is between d(1) and d(2). See
-*> DLAED4 for further details.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> Refer to the equation f(x) above.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (3)
-*> D satisfies d(1) < d(2) < d(3).
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (3)
-*> Each of the elements in z must be positive.
-*> \endverbatim
-*>
-*> \param[in] FINIT
-*> \verbatim
-*> FINIT is DOUBLE PRECISION
-*> The value of f at 0. It is more accurate than the one
-*> evaluated inside this routine (if someone wants to do
-*> so).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The root of the equation f(x).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = 1, failure to converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> 10/02/03: This version has a few statements commented out for thread
-*> safety (machine parameters are computed on each entry). SJH.
-*>
-*> 05/10/06: Modified from a new version of Ren-Cang Li, use
-*> Gragg-Thornton-Warner cubic convergent scheme for better stability.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL ORGATI
- INTEGER INFO, KNITER
- DOUBLE PRECISION FINIT, RHO, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( 3 ), Z( 3 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 40 )
- DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR, EIGHT
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ THREE = 3.0D0, FOUR = 4.0D0, EIGHT = 8.0D0 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DSCALE( 3 ), ZSCALE( 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL SCALE
- INTEGER I, ITER, NITER
- DOUBLE PRECISION A, B, BASE, C, DDF, DF, EPS, ERRETM, ETA, F,
- $ FC, SCLFAC, SCLINV, SMALL1, SMALL2, SMINV1,
- $ SMINV2, TEMP, TEMP1, TEMP2, TEMP3, TEMP4,
- $ LBD, UBD
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
- IF( ORGATI ) THEN
- LBD = D(2)
- UBD = D(3)
- ELSE
- LBD = D(1)
- UBD = D(2)
- END IF
- IF( FINIT .LT. ZERO )THEN
- LBD = ZERO
- ELSE
- UBD = ZERO
- END IF
-*
- NITER = 1
- TAU = ZERO
- IF( KNITER.EQ.2 ) THEN
- IF( ORGATI ) THEN
- TEMP = ( D( 3 )-D( 2 ) ) / TWO
- C = RHO + Z( 1 ) / ( ( D( 1 )-D( 2 ) )-TEMP )
- A = C*( D( 2 )+D( 3 ) ) + Z( 2 ) + Z( 3 )
- B = C*D( 2 )*D( 3 ) + Z( 2 )*D( 3 ) + Z( 3 )*D( 2 )
- ELSE
- TEMP = ( D( 1 )-D( 2 ) ) / TWO
- C = RHO + Z( 3 ) / ( ( D( 3 )-D( 2 ) )-TEMP )
- A = C*( D( 1 )+D( 2 ) ) + Z( 1 ) + Z( 2 )
- B = C*D( 1 )*D( 2 ) + Z( 1 )*D( 2 ) + Z( 2 )*D( 1 )
- END IF
- TEMP = MAX( ABS( A ), ABS( B ), ABS( C ) )
- A = A / TEMP
- B = B / TEMP
- C = C / TEMP
- IF( C.EQ.ZERO ) THEN
- TAU = B / A
- ELSE IF( A.LE.ZERO ) THEN
- TAU = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- TAU = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- IF( TAU .LT. LBD .OR. TAU .GT. UBD )
- $ TAU = ( LBD+UBD )/TWO
- IF( D(1).EQ.TAU .OR. D(2).EQ.TAU .OR. D(3).EQ.TAU ) THEN
- TAU = ZERO
- ELSE
- TEMP = FINIT + TAU*Z(1)/( D(1)*( D( 1 )-TAU ) ) +
- $ TAU*Z(2)/( D(2)*( D( 2 )-TAU ) ) +
- $ TAU*Z(3)/( D(3)*( D( 3 )-TAU ) )
- IF( TEMP .LE. ZERO )THEN
- LBD = TAU
- ELSE
- UBD = TAU
- END IF
- IF( ABS( FINIT ).LE.ABS( TEMP ) )
- $ TAU = ZERO
- END IF
- END IF
-*
-* get machine parameters for possible scaling to avoid overflow
-*
-* modified by Sven: parameters SMALL1, SMINV1, SMALL2,
-* SMINV2, EPS are not SAVEd anymore between one call to the
-* others but recomputed at each call
-*
- EPS = DLAMCH( 'Epsilon' )
- BASE = DLAMCH( 'Base' )
- SMALL1 = BASE**( INT( LOG( DLAMCH( 'SafMin' ) ) / LOG( BASE ) /
- $ THREE ) )
- SMINV1 = ONE / SMALL1
- SMALL2 = SMALL1*SMALL1
- SMINV2 = SMINV1*SMINV1
-*
-* Determine if scaling of inputs necessary to avoid overflow
-* when computing 1/TEMP**3
-*
- IF( ORGATI ) THEN
- TEMP = MIN( ABS( D( 2 )-TAU ), ABS( D( 3 )-TAU ) )
- ELSE
- TEMP = MIN( ABS( D( 1 )-TAU ), ABS( D( 2 )-TAU ) )
- END IF
- SCALE = .FALSE.
- IF( TEMP.LE.SMALL1 ) THEN
- SCALE = .TRUE.
- IF( TEMP.LE.SMALL2 ) THEN
-*
-* Scale up by power of radix nearest 1/SAFMIN**(2/3)
-*
- SCLFAC = SMINV2
- SCLINV = SMALL2
- ELSE
-*
-* Scale up by power of radix nearest 1/SAFMIN**(1/3)
-*
- SCLFAC = SMINV1
- SCLINV = SMALL1
- END IF
-*
-* Scaling up safe because D, Z, TAU scaled elsewhere to be O(1)
-*
- DO 10 I = 1, 3
- DSCALE( I ) = D( I )*SCLFAC
- ZSCALE( I ) = Z( I )*SCLFAC
- 10 CONTINUE
- TAU = TAU*SCLFAC
- LBD = LBD*SCLFAC
- UBD = UBD*SCLFAC
- ELSE
-*
-* Copy D and Z to DSCALE and ZSCALE
-*
- DO 20 I = 1, 3
- DSCALE( I ) = D( I )
- ZSCALE( I ) = Z( I )
- 20 CONTINUE
- END IF
-*
- FC = ZERO
- DF = ZERO
- DDF = ZERO
- DO 30 I = 1, 3
- TEMP = ONE / ( DSCALE( I )-TAU )
- TEMP1 = ZSCALE( I )*TEMP
- TEMP2 = TEMP1*TEMP
- TEMP3 = TEMP2*TEMP
- FC = FC + TEMP1 / DSCALE( I )
- DF = DF + TEMP2
- DDF = DDF + TEMP3
- 30 CONTINUE
- F = FINIT + TAU*FC
-*
- IF( ABS( F ).LE.ZERO )
- $ GO TO 60
- IF( F .LE. ZERO )THEN
- LBD = TAU
- ELSE
- UBD = TAU
- END IF
-*
-* Iteration begins -- Use Gragg-Thornton-Warner cubic convergent
-* scheme
-*
-* It is not hard to see that
-*
-* 1) Iterations will go up monotonically
-* if FINIT < 0;
-*
-* 2) Iterations will go down monotonically
-* if FINIT > 0.
-*
- ITER = NITER + 1
-*
- DO 50 NITER = ITER, MAXIT
-*
- IF( ORGATI ) THEN
- TEMP1 = DSCALE( 2 ) - TAU
- TEMP2 = DSCALE( 3 ) - TAU
- ELSE
- TEMP1 = DSCALE( 1 ) - TAU
- TEMP2 = DSCALE( 2 ) - TAU
- END IF
- A = ( TEMP1+TEMP2 )*F - TEMP1*TEMP2*DF
- B = TEMP1*TEMP2*F
- C = F - ( TEMP1+TEMP2 )*DF + TEMP1*TEMP2*DDF
- TEMP = MAX( ABS( A ), ABS( B ), ABS( C ) )
- A = A / TEMP
- B = B / TEMP
- C = C / TEMP
- IF( C.EQ.ZERO ) THEN
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- IF( F*ETA.GE.ZERO ) THEN
- ETA = -F / DF
- END IF
-*
- TAU = TAU + ETA
- IF( TAU .LT. LBD .OR. TAU .GT. UBD )
- $ TAU = ( LBD + UBD )/TWO
-*
- FC = ZERO
- ERRETM = ZERO
- DF = ZERO
- DDF = ZERO
- DO 40 I = 1, 3
- IF ( ( DSCALE( I )-TAU ).NE.ZERO ) THEN
- TEMP = ONE / ( DSCALE( I )-TAU )
- TEMP1 = ZSCALE( I )*TEMP
- TEMP2 = TEMP1*TEMP
- TEMP3 = TEMP2*TEMP
- TEMP4 = TEMP1 / DSCALE( I )
- FC = FC + TEMP4
- ERRETM = ERRETM + ABS( TEMP4 )
- DF = DF + TEMP2
- DDF = DDF + TEMP3
- ELSE
- GO TO 60
- END IF
- 40 CONTINUE
- F = FINIT + TAU*FC
- ERRETM = EIGHT*( ABS( FINIT )+ABS( TAU )*ERRETM ) +
- $ ABS( TAU )*DF
- IF( ABS( F ).LE.EPS*ERRETM )
- $ GO TO 60
- IF( F .LE. ZERO )THEN
- LBD = TAU
- ELSE
- UBD = TAU
- END IF
- 50 CONTINUE
- INFO = 1
- 60 CONTINUE
-*
-* Undo scaling
-*
- IF( SCALE )
- $ TAU = TAU*SCLINV
- RETURN
-*
-* End of DLAED6
-*
- END
diff --git a/netlib/LAPACK/dlaed7.f b/netlib/LAPACK/dlaed7.f
deleted file mode 100644
index 972c1bc..0000000
--- a/netlib/LAPACK/dlaed7.f
+++ /dev/null
@@ -1,407 +0,0 @@
-*> \brief \b DLAED7 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED7 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed7.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed7.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed7.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
-* LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR,
-* PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N,
-* $ QSIZ, TLVLS
-* DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ),
-* $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * )
-* DOUBLE PRECISION D( * ), GIVNUM( 2, * ), Q( LDQ, * ),
-* $ QSTORE( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED7 computes the updated eigensystem of a diagonal
-*> matrix after modification by a rank-one symmetric matrix. This
-*> routine is used only for the eigenproblem which requires all
-*> eigenvalues and optionally eigenvectors of a dense symmetric matrix
-*> that has been reduced to tridiagonal form. DLAED1 handles
-*> the case in which all eigenvalues and eigenvectors of a symmetric
-*> tridiagonal matrix are desired.
-*>
-*> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out)
-*>
-*> where Z = Q**Tu, u is a vector of length N with ones in the
-*> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
-*>
-*> The eigenvectors of the original matrix are stored in Q, and the
-*> eigenvalues are in D. The algorithm consists of three stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple eigenvalues or if there is a zero in
-*> the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine DLAED8.
-*>
-*> The second stage consists of calculating the updated
-*> eigenvalues. This is done by finding the roots of the secular
-*> equation via the routine DLAED4 (as called by DLAED9).
-*> This routine also calculates the eigenvectors of the current
-*> problem.
-*>
-*> The final stage consists of computing the updated eigenvectors
-*> directly using the updated eigenvalues. The eigenvectors for
-*> the current problem are multiplied with the eigenvectors from
-*> the overall problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> = 0: Compute eigenvalues only.
-*> = 1: Compute eigenvectors of original dense symmetric matrix
-*> also. On entry, Q contains the orthogonal matrix used
-*> to reduce the original matrix to tridiagonal form.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] QSIZ
-*> \verbatim
-*> QSIZ is INTEGER
-*> The dimension of the orthogonal matrix used to reduce
-*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
-*> \endverbatim
-*>
-*> \param[in] TLVLS
-*> \verbatim
-*> TLVLS is INTEGER
-*> The total number of merging levels in the overall divide and
-*> conquer tree.
-*> \endverbatim
-*>
-*> \param[in] CURLVL
-*> \verbatim
-*> CURLVL is INTEGER
-*> The current level in the overall merge routine,
-*> 0 <= CURLVL <= TLVLS.
-*> \endverbatim
-*>
-*> \param[in] CURPBM
-*> \verbatim
-*> CURPBM is INTEGER
-*> The current problem in the current level in the overall
-*> merge routine (counting from upper left to lower right).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the eigenvalues of the rank-1-perturbed matrix.
-*> On exit, the eigenvalues of the repaired matrix.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> On entry, the eigenvectors of the rank-1-perturbed matrix.
-*> On exit, the eigenvectors of the repaired tridiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> The permutation which will reintegrate the subproblem just
-*> solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
-*> will be in ascending order.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The subdiagonal element used to create the rank-1
-*> modification.
-*> \endverbatim
-*>
-*> \param[in] CUTPNT
-*> \verbatim
-*> CUTPNT is INTEGER
-*> Contains the location of the last eigenvalue in the leading
-*> sub-matrix. min(1,N) <= CUTPNT <= N.
-*> \endverbatim
-*>
-*> \param[in,out] QSTORE
-*> \verbatim
-*> QSTORE is DOUBLE PRECISION array, dimension (N**2+1)
-*> Stores eigenvectors of submatrices encountered during
-*> divide and conquer, packed together. QPTR points to
-*> beginning of the submatrices.
-*> \endverbatim
-*>
-*> \param[in,out] QPTR
-*> \verbatim
-*> QPTR is INTEGER array, dimension (N+2)
-*> List of indices pointing to beginning of submatrices stored
-*> in QSTORE. The submatrices are numbered starting at the
-*> bottom left of the divide and conquer tree, from left to
-*> right and bottom to top.
-*> \endverbatim
-*>
-*> \param[in] PRMPTR
-*> \verbatim
-*> PRMPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in PERM a
-*> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
-*> indicates the size of the permutation and also the size of
-*> the full, non-deflated problem.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension (N lg N)
-*> Contains the permutations (from deflation and sorting) to be
-*> applied to each eigenblock.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in GIVCOL a
-*> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
-*> indicates the number of Givens rotations.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension (2, N lg N)
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension (2, N lg N)
-*> Each number indicates the S value to be used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N+2*QSIZ*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
- $ LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR,
- $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N,
- $ QSIZ, TLVLS
- DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ),
- $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * )
- DOUBLE PRECISION D( * ), GIVNUM( 2, * ), Q( LDQ, * ),
- $ QSTORE( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER COLTYP, CURR, I, IDLMDA, INDX, INDXC, INDXP,
- $ IQ2, IS, IW, IZ, K, LDQ2, N1, N2, PTR
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLAED8, DLAED9, DLAEDA, DLAMRG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ICOMPQ.EQ.1 .AND. QSIZ.LT.N ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( MIN( 1, N ).GT.CUTPNT .OR. N.LT.CUTPNT ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED7', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* The following values are for bookkeeping purposes only. They are
-* integer pointers which indicate the portion of the workspace
-* used by a particular array in DLAED8 and DLAED9.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- LDQ2 = QSIZ
- ELSE
- LDQ2 = N
- END IF
-*
- IZ = 1
- IDLMDA = IZ + N
- IW = IDLMDA + N
- IQ2 = IW + N
- IS = IQ2 + N*LDQ2
-*
- INDX = 1
- INDXC = INDX + N
- COLTYP = INDXC + N
- INDXP = COLTYP + N
-*
-* Form the z-vector which consists of the last row of Q_1 and the
-* first row of Q_2.
-*
- PTR = 1 + 2**TLVLS
- DO 10 I = 1, CURLVL - 1
- PTR = PTR + 2**( TLVLS-I )
- 10 CONTINUE
- CURR = PTR + CURPBM
- CALL DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
- $ GIVCOL, GIVNUM, QSTORE, QPTR, WORK( IZ ),
- $ WORK( IZ+N ), INFO )
-*
-* When solving the final problem, we no longer need the stored data,
-* so we will overwrite the data from this level onto the previously
-* used storage space.
-*
- IF( CURLVL.EQ.TLVLS ) THEN
- QPTR( CURR ) = 1
- PRMPTR( CURR ) = 1
- GIVPTR( CURR ) = 1
- END IF
-*
-* Sort and Deflate eigenvalues.
-*
- CALL DLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, CUTPNT,
- $ WORK( IZ ), WORK( IDLMDA ), WORK( IQ2 ), LDQ2,
- $ WORK( IW ), PERM( PRMPTR( CURR ) ), GIVPTR( CURR+1 ),
- $ GIVCOL( 1, GIVPTR( CURR ) ),
- $ GIVNUM( 1, GIVPTR( CURR ) ), IWORK( INDXP ),
- $ IWORK( INDX ), INFO )
- PRMPTR( CURR+1 ) = PRMPTR( CURR ) + N
- GIVPTR( CURR+1 ) = GIVPTR( CURR+1 ) + GIVPTR( CURR )
-*
-* Solve Secular Equation.
-*
- IF( K.NE.0 ) THEN
- CALL DLAED9( K, 1, K, N, D, WORK( IS ), K, RHO, WORK( IDLMDA ),
- $ WORK( IW ), QSTORE( QPTR( CURR ) ), K, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
- IF( ICOMPQ.EQ.1 ) THEN
- CALL DGEMM( 'N', 'N', QSIZ, K, K, ONE, WORK( IQ2 ), LDQ2,
- $ QSTORE( QPTR( CURR ) ), K, ZERO, Q, LDQ )
- END IF
- QPTR( CURR+1 ) = QPTR( CURR ) + K**2
-*
-* Prepare the INDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL DLAMRG( N1, N2, D, 1, -1, INDXQ )
- ELSE
- QPTR( CURR+1 ) = QPTR( CURR )
- DO 20 I = 1, N
- INDXQ( I ) = I
- 20 CONTINUE
- END IF
-*
- 30 CONTINUE
- RETURN
-*
-* End of DLAED7
-*
- END
diff --git a/netlib/LAPACK/dlaed8.f b/netlib/LAPACK/dlaed8.f
deleted file mode 100644
index 42b4ea1..0000000
--- a/netlib/LAPACK/dlaed8.f
+++ /dev/null
@@ -1,524 +0,0 @@
-*> \brief \b DLAED8 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED8 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed8.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed8.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed8.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO,
-* CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR,
-* GIVCOL, GIVNUM, INDXP, INDX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N,
-* $ QSIZ
-* DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ),
-* $ INDXQ( * ), PERM( * )
-* DOUBLE PRECISION D( * ), DLAMDA( * ), GIVNUM( 2, * ),
-* $ Q( LDQ, * ), Q2( LDQ2, * ), W( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED8 merges the two sets of eigenvalues together into a single
-*> sorted set. Then it tries to deflate the size of the problem.
-*> There are two ways in which deflation can occur: when two or more
-*> eigenvalues are close together or if there is a tiny element in the
-*> Z vector. For each such occurrence the order of the related secular
-*> equation problem is reduced by one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> = 0: Compute eigenvalues only.
-*> = 1: Compute eigenvectors of original dense symmetric matrix
-*> also. On entry, Q contains the orthogonal matrix used
-*> to reduce the original matrix to tridiagonal form.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> The number of non-deflated eigenvalues, and the order of the
-*> related secular equation.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] QSIZ
-*> \verbatim
-*> QSIZ is INTEGER
-*> The dimension of the orthogonal matrix used to reduce
-*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the eigenvalues of the two submatrices to be
-*> combined. On exit, the trailing (N-K) updated eigenvalues
-*> (those which were deflated) sorted into increasing order.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> If ICOMPQ = 0, Q is not referenced. Otherwise,
-*> on entry, Q contains the eigenvectors of the partially solved
-*> system which has been previously updated in matrix
-*> multiplies with other partially solved eigensystems.
-*> On exit, Q contains the trailing (N-K) updated eigenvectors
-*> (those which were deflated) in its last N-K columns.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> The permutation which separately sorts the two sub-problems
-*> in D into ascending order. Note that elements in the second
-*> half of this permutation must first have CUTPNT added to
-*> their values in order to be accurate.
-*> \endverbatim
-*>
-*> \param[in,out] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> On entry, the off-diagonal element associated with the rank-1
-*> cut which originally split the two submatrices which are now
-*> being recombined.
-*> On exit, RHO has been modified to the value required by
-*> DLAED3.
-*> \endverbatim
-*>
-*> \param[in] CUTPNT
-*> \verbatim
-*> CUTPNT is INTEGER
-*> The location of the last eigenvalue in the leading
-*> sub-matrix. min(1,N) <= CUTPNT <= N.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (N)
-*> On entry, Z contains the updating vector (the last row of
-*> the first sub-eigenvector matrix and the first row of the
-*> second sub-eigenvector matrix).
-*> On exit, the contents of Z are destroyed by the updating
-*> process.
-*> \endverbatim
-*>
-*> \param[out] DLAMDA
-*> \verbatim
-*> DLAMDA is DOUBLE PRECISION array, dimension (N)
-*> A copy of the first K eigenvalues which will be used by
-*> DLAED3 to form the secular equation.
-*> \endverbatim
-*>
-*> \param[out] Q2
-*> \verbatim
-*> Q2 is DOUBLE PRECISION array, dimension (LDQ2,N)
-*> If ICOMPQ = 0, Q2 is not referenced. Otherwise,
-*> a copy of the first K eigenvectors which will be used by
-*> DLAED7 in a matrix multiply (DGEMM) to update the new
-*> eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDQ2
-*> \verbatim
-*> LDQ2 is INTEGER
-*> The leading dimension of the array Q2. LDQ2 >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first k values of the final deflation-altered z-vector and
-*> will be passed to DLAED3.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension (N)
-*> The permutations (from deflation and sorting) to be applied
-*> to each eigenblock.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension (2, N)
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension (2, N)
-*> Each number indicates the S value to be used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[out] INDXP
-*> \verbatim
-*> INDXP is INTEGER array, dimension (N)
-*> The permutation used to place deflated values of D at the end
-*> of the array. INDXP(1:K) points to the nondeflated D-values
-*> and INDXP(K+1:N) points to the deflated eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] INDX
-*> \verbatim
-*> INDX is INTEGER array, dimension (N)
-*> The permutation used to sort the contents of D into ascending
-*> order.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO,
- $ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR,
- $ GIVCOL, GIVNUM, INDXP, INDX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N,
- $ QSIZ
- DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ),
- $ INDXQ( * ), PERM( * )
- DOUBLE PRECISION D( * ), DLAMDA( * ), GIVNUM( 2, * ),
- $ Q( LDQ, * ), Q2( LDQ2, * ), W( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION MONE, ZERO, ONE, TWO, EIGHT
- PARAMETER ( MONE = -1.0D0, ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, EIGHT = 8.0D0 )
-* ..
-* .. Local Scalars ..
-*
- INTEGER I, IMAX, J, JLAM, JMAX, JP, K2, N1, N1P1, N2
- DOUBLE PRECISION C, EPS, S, T, TAU, TOL
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL IDAMAX, DLAMCH, DLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DLAMRG, DROT, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ICOMPQ.EQ.1 .AND. QSIZ.LT.N ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( CUTPNT.LT.MIN( 1, N ) .OR. CUTPNT.GT.N ) THEN
- INFO = -10
- ELSE IF( LDQ2.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED8', -INFO )
- RETURN
- END IF
-*
-* Need to initialize GIVPTR to O here in case of quick exit
-* to prevent an unspecified code behavior (usually sigfault)
-* when IWORK array on entry to *stedc is not zeroed
-* (or at least some IWORK entries which used in *laed7 for GIVPTR).
-*
- GIVPTR = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- N1 = CUTPNT
- N2 = N - N1
- N1P1 = N1 + 1
-*
- IF( RHO.LT.ZERO ) THEN
- CALL DSCAL( N2, MONE, Z( N1P1 ), 1 )
- END IF
-*
-* Normalize z so that norm(z) = 1
-*
- T = ONE / SQRT( TWO )
- DO 10 J = 1, N
- INDX( J ) = J
- 10 CONTINUE
- CALL DSCAL( N, T, Z, 1 )
- RHO = ABS( TWO*RHO )
-*
-* Sort the eigenvalues into increasing order
-*
- DO 20 I = CUTPNT + 1, N
- INDXQ( I ) = INDXQ( I ) + CUTPNT
- 20 CONTINUE
- DO 30 I = 1, N
- DLAMDA( I ) = D( INDXQ( I ) )
- W( I ) = Z( INDXQ( I ) )
- 30 CONTINUE
- I = 1
- J = CUTPNT + 1
- CALL DLAMRG( N1, N2, DLAMDA, 1, 1, INDX )
- DO 40 I = 1, N
- D( I ) = DLAMDA( INDX( I ) )
- Z( I ) = W( INDX( I ) )
- 40 CONTINUE
-*
-* Calculate the allowable deflation tolerence
-*
- IMAX = IDAMAX( N, Z, 1 )
- JMAX = IDAMAX( N, D, 1 )
- EPS = DLAMCH( 'Epsilon' )
- TOL = EIGHT*EPS*ABS( D( JMAX ) )
-*
-* If the rank-1 modifier is small enough, no more needs to be done
-* except to reorganize Q so that its columns correspond with the
-* elements in D.
-*
- IF( RHO*ABS( Z( IMAX ) ).LE.TOL ) THEN
- K = 0
- IF( ICOMPQ.EQ.0 ) THEN
- DO 50 J = 1, N
- PERM( J ) = INDXQ( INDX( J ) )
- 50 CONTINUE
- ELSE
- DO 60 J = 1, N
- PERM( J ) = INDXQ( INDX( J ) )
- CALL DCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 )
- 60 CONTINUE
- CALL DLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ),
- $ LDQ )
- END IF
- RETURN
- END IF
-*
-* If there are multiple eigenvalues then the problem deflates. Here
-* the number of equal eigenvalues are found. As each equal
-* eigenvalue is found, an elementary reflector is computed to rotate
-* the corresponding eigensubspace so that the corresponding
-* components of Z are zero in this new basis.
-*
- K = 0
- K2 = N + 1
- DO 70 J = 1, N
- IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- INDXP( K2 ) = J
- IF( J.EQ.N )
- $ GO TO 110
- ELSE
- JLAM = J
- GO TO 80
- END IF
- 70 CONTINUE
- 80 CONTINUE
- J = J + 1
- IF( J.GT.N )
- $ GO TO 100
- IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- INDXP( K2 ) = J
- ELSE
-*
-* Check if eigenvalues are close enough to allow deflation.
-*
- S = Z( JLAM )
- C = Z( J )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = DLAPY2( C, S )
- T = D( J ) - D( JLAM )
- C = C / TAU
- S = -S / TAU
- IF( ABS( T*C*S ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- Z( J ) = TAU
- Z( JLAM ) = ZERO
-*
-* Record the appropriate Givens rotation
-*
- GIVPTR = GIVPTR + 1
- GIVCOL( 1, GIVPTR ) = INDXQ( INDX( JLAM ) )
- GIVCOL( 2, GIVPTR ) = INDXQ( INDX( J ) )
- GIVNUM( 1, GIVPTR ) = C
- GIVNUM( 2, GIVPTR ) = S
- IF( ICOMPQ.EQ.1 ) THEN
- CALL DROT( QSIZ, Q( 1, INDXQ( INDX( JLAM ) ) ), 1,
- $ Q( 1, INDXQ( INDX( J ) ) ), 1, C, S )
- END IF
- T = D( JLAM )*C*C + D( J )*S*S
- D( J ) = D( JLAM )*S*S + D( J )*C*C
- D( JLAM ) = T
- K2 = K2 - 1
- I = 1
- 90 CONTINUE
- IF( K2+I.LE.N ) THEN
- IF( D( JLAM ).LT.D( INDXP( K2+I ) ) ) THEN
- INDXP( K2+I-1 ) = INDXP( K2+I )
- INDXP( K2+I ) = JLAM
- I = I + 1
- GO TO 90
- ELSE
- INDXP( K2+I-1 ) = JLAM
- END IF
- ELSE
- INDXP( K2+I-1 ) = JLAM
- END IF
- JLAM = J
- ELSE
- K = K + 1
- W( K ) = Z( JLAM )
- DLAMDA( K ) = D( JLAM )
- INDXP( K ) = JLAM
- JLAM = J
- END IF
- END IF
- GO TO 80
- 100 CONTINUE
-*
-* Record the last eigenvalue.
-*
- K = K + 1
- W( K ) = Z( JLAM )
- DLAMDA( K ) = D( JLAM )
- INDXP( K ) = JLAM
-*
- 110 CONTINUE
-*
-* Sort the eigenvalues and corresponding eigenvectors into DLAMDA
-* and Q2 respectively. The eigenvalues/vectors which were not
-* deflated go into the first K slots of DLAMDA and Q2 respectively,
-* while those which were deflated go into the last N - K slots.
-*
- IF( ICOMPQ.EQ.0 ) THEN
- DO 120 J = 1, N
- JP = INDXP( J )
- DLAMDA( J ) = D( JP )
- PERM( J ) = INDXQ( INDX( JP ) )
- 120 CONTINUE
- ELSE
- DO 130 J = 1, N
- JP = INDXP( J )
- DLAMDA( J ) = D( JP )
- PERM( J ) = INDXQ( INDX( JP ) )
- CALL DCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 )
- 130 CONTINUE
- END IF
-*
-* The deflated eigenvalues and their corresponding vectors go back
-* into the last N - K slots of D and Q respectively.
-*
- IF( K.LT.N ) THEN
- IF( ICOMPQ.EQ.0 ) THEN
- CALL DCOPY( N-K, DLAMDA( K+1 ), 1, D( K+1 ), 1 )
- ELSE
- CALL DCOPY( N-K, DLAMDA( K+1 ), 1, D( K+1 ), 1 )
- CALL DLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2,
- $ Q( 1, K+1 ), LDQ )
- END IF
- END IF
-*
- RETURN
-*
-* End of DLAED8
-*
- END
diff --git a/netlib/LAPACK/dlaed9.f b/netlib/LAPACK/dlaed9.f
deleted file mode 100644
index 8aa0687..0000000
--- a/netlib/LAPACK/dlaed9.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b DLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAED9 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed9.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed9.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed9.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
-* S, LDS, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N
-* DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), S( LDS, * ),
-* $ W( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAED9 finds the roots of the secular equation, as defined by the
-*> values in D, Z, and RHO, between KSTART and KSTOP. It makes the
-*> appropriate calls to DLAED4 and then stores the new matrix of
-*> eigenvectors for use in calculating the next level of Z vectors.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of terms in the rational function to be solved by
-*> DLAED4. K >= 0.
-*> \endverbatim
-*>
-*> \param[in] KSTART
-*> \verbatim
-*> KSTART is INTEGER
-*> \endverbatim
-*>
-*> \param[in] KSTOP
-*> \verbatim
-*> KSTOP is INTEGER
-*> The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
-*> are to be computed. 1 <= KSTART <= KSTOP <= K.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the Q matrix.
-*> N >= K (delation may result in N > K).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> D(I) contains the updated eigenvalues
-*> for KSTART <= I <= KSTOP.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The value of the parameter in the rank one update equation.
-*> RHO >= 0 required.
-*> \endverbatim
-*>
-*> \param[in] DLAMDA
-*> \verbatim
-*> DLAMDA is DOUBLE PRECISION array, dimension (K)
-*> The first K elements of this array contain the old roots
-*> of the deflated updating problem. These are the poles
-*> of the secular equation.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (K)
-*> The first K elements of this array contain the components
-*> of the deflation-adjusted updating vector.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (LDS, K)
-*> Will contain the eigenvectors of the repaired matrix which
-*> will be stored for subsequent Z vector calculation and
-*> multiplied by the previously accumulated eigenvectors
-*> to update the system.
-*> \endverbatim
-*>
-*> \param[in] LDS
-*> \verbatim
-*> LDS is INTEGER
-*> The leading dimension of S. LDS >= max( 1, K ).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
- $ S, LDS, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N
- DOUBLE PRECISION RHO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), S( LDS, * ),
- $ W( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION TEMP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3, DNRM2
- EXTERNAL DLAMC3, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAED4, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( K.LT.0 ) THEN
- INFO = -1
- ELSE IF( KSTART.LT.1 .OR. KSTART.GT.MAX( 1, K ) ) THEN
- INFO = -2
- ELSE IF( MAX( 1, KSTOP ).LT.KSTART .OR. KSTOP.GT.MAX( 1, K ) )
- $ THEN
- INFO = -3
- ELSE IF( N.LT.K ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDS.LT.MAX( 1, K ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAED9', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 )
- $ RETURN
-*
-* Modify values DLAMDA(i) to make sure all DLAMDA(i)-DLAMDA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DLAMDA(I) by 2*DLAMDA(I)-DLAMDA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DLAMDA(I) if it is 1; this makes the subsequent
-* subtractions DLAMDA(I)-DLAMDA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DLAMDA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DLAMDA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 10 I = 1, N
- DLAMDA( I ) = DLAMC3( DLAMDA( I ), DLAMDA( I ) ) - DLAMDA( I )
- 10 CONTINUE
-*
- DO 20 J = KSTART, KSTOP
- CALL DLAED4( K, J, DLAMDA, W, Q( 1, J ), RHO, D( J ), INFO )
-*
-* If the zero finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 )
- $ GO TO 120
- 20 CONTINUE
-*
- IF( K.EQ.1 .OR. K.EQ.2 ) THEN
- DO 40 I = 1, K
- DO 30 J = 1, K
- S( J, I ) = Q( J, I )
- 30 CONTINUE
- 40 CONTINUE
- GO TO 120
- END IF
-*
-* Compute updated W.
-*
- CALL DCOPY( K, W, 1, S, 1 )
-*
-* Initialize W(I) = Q(I,I)
-*
- CALL DCOPY( K, Q, LDQ+1, W, 1 )
- DO 70 J = 1, K
- DO 50 I = 1, J - 1
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 50 CONTINUE
- DO 60 I = J + 1, K
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 60 CONTINUE
- 70 CONTINUE
- DO 80 I = 1, K
- W( I ) = SIGN( SQRT( -W( I ) ), S( I, 1 ) )
- 80 CONTINUE
-*
-* Compute eigenvectors of the modified rank-1 modification.
-*
- DO 110 J = 1, K
- DO 90 I = 1, K
- Q( I, J ) = W( I ) / Q( I, J )
- 90 CONTINUE
- TEMP = DNRM2( K, Q( 1, J ), 1 )
- DO 100 I = 1, K
- S( I, J ) = Q( I, J ) / TEMP
- 100 CONTINUE
- 110 CONTINUE
-*
- 120 CONTINUE
- RETURN
-*
-* End of DLAED9
-*
- END
diff --git a/netlib/LAPACK/dlaeda.f b/netlib/LAPACK/dlaeda.f
deleted file mode 100644
index 749a7c3..0000000
--- a/netlib/LAPACK/dlaeda.f
+++ /dev/null
@@ -1,308 +0,0 @@
-*> \brief \b DLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAEDA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaeda.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaeda.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaeda.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
-* GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CURLVL, CURPBM, INFO, N, TLVLS
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( 2, * ), GIVPTR( * ), PERM( * ),
-* $ PRMPTR( * ), QPTR( * )
-* DOUBLE PRECISION GIVNUM( 2, * ), Q( * ), Z( * ), ZTEMP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAEDA computes the Z vector corresponding to the merge step in the
-*> CURLVLth step of the merge process with TLVLS steps for the CURPBMth
-*> problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] TLVLS
-*> \verbatim
-*> TLVLS is INTEGER
-*> The total number of merging levels in the overall divide and
-*> conquer tree.
-*> \endverbatim
-*>
-*> \param[in] CURLVL
-*> \verbatim
-*> CURLVL is INTEGER
-*> The current level in the overall merge routine,
-*> 0 <= curlvl <= tlvls.
-*> \endverbatim
-*>
-*> \param[in] CURPBM
-*> \verbatim
-*> CURPBM is INTEGER
-*> The current problem in the current level in the overall
-*> merge routine (counting from upper left to lower right).
-*> \endverbatim
-*>
-*> \param[in] PRMPTR
-*> \verbatim
-*> PRMPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in PERM a
-*> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
-*> indicates the size of the permutation and incidentally the
-*> size of the full, non-deflated problem.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension (N lg N)
-*> Contains the permutations (from deflation and sorting) to be
-*> applied to each eigenblock.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in GIVCOL a
-*> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
-*> indicates the number of Givens rotations.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension (2, N lg N)
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension (2, N lg N)
-*> Each number indicates the S value to be used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (N**2)
-*> Contains the square eigenblocks from previous levels, the
-*> starting positions for blocks are given by QPTR.
-*> \endverbatim
-*>
-*> \param[in] QPTR
-*> \verbatim
-*> QPTR is INTEGER array, dimension (N+2)
-*> Contains a list of pointers which indicate where in Q an
-*> eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
-*> the size of the block.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (N)
-*> On output this vector contains the updating vector (the last
-*> row of the first sub-eigenvector matrix and the first row of
-*> the second sub-eigenvector matrix).
-*> \endverbatim
-*>
-*> \param[out] ZTEMP
-*> \verbatim
-*> ZTEMP is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
- $ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CURLVL, CURPBM, INFO, N, TLVLS
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( 2, * ), GIVPTR( * ), PERM( * ),
- $ PRMPTR( * ), QPTR( * )
- DOUBLE PRECISION GIVNUM( 2, * ), Q( * ), Z( * ), ZTEMP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER BSIZ1, BSIZ2, CURR, I, K, MID, PSIZ1, PSIZ2,
- $ PTR, ZPTR1
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMV, DROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, INT, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAEDA', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine location of first number in second half.
-*
- MID = N / 2 + 1
-*
-* Gather last/first rows of appropriate eigenblocks into center of Z
-*
- PTR = 1
-*
-* Determine location of lowest level subproblem in the full storage
-* scheme
-*
- CURR = PTR + CURPBM*2**CURLVL + 2**( CURLVL-1 ) - 1
-*
-* Determine size of these matrices. We add HALF to the value of
-* the SQRT in case the machine underestimates one of these square
-* roots.
-*
- BSIZ1 = INT( HALF+SQRT( DBLE( QPTR( CURR+1 )-QPTR( CURR ) ) ) )
- BSIZ2 = INT( HALF+SQRT( DBLE( QPTR( CURR+2 )-QPTR( CURR+1 ) ) ) )
- DO 10 K = 1, MID - BSIZ1 - 1
- Z( K ) = ZERO
- 10 CONTINUE
- CALL DCOPY( BSIZ1, Q( QPTR( CURR )+BSIZ1-1 ), BSIZ1,
- $ Z( MID-BSIZ1 ), 1 )
- CALL DCOPY( BSIZ2, Q( QPTR( CURR+1 ) ), BSIZ2, Z( MID ), 1 )
- DO 20 K = MID + BSIZ2, N
- Z( K ) = ZERO
- 20 CONTINUE
-*
-* Loop through remaining levels 1 -> CURLVL applying the Givens
-* rotations and permutation and then multiplying the center matrices
-* against the current Z.
-*
- PTR = 2**TLVLS + 1
- DO 70 K = 1, CURLVL - 1
- CURR = PTR + CURPBM*2**( CURLVL-K ) + 2**( CURLVL-K-1 ) - 1
- PSIZ1 = PRMPTR( CURR+1 ) - PRMPTR( CURR )
- PSIZ2 = PRMPTR( CURR+2 ) - PRMPTR( CURR+1 )
- ZPTR1 = MID - PSIZ1
-*
-* Apply Givens at CURR and CURR+1
-*
- DO 30 I = GIVPTR( CURR ), GIVPTR( CURR+1 ) - 1
- CALL DROT( 1, Z( ZPTR1+GIVCOL( 1, I )-1 ), 1,
- $ Z( ZPTR1+GIVCOL( 2, I )-1 ), 1, GIVNUM( 1, I ),
- $ GIVNUM( 2, I ) )
- 30 CONTINUE
- DO 40 I = GIVPTR( CURR+1 ), GIVPTR( CURR+2 ) - 1
- CALL DROT( 1, Z( MID-1+GIVCOL( 1, I ) ), 1,
- $ Z( MID-1+GIVCOL( 2, I ) ), 1, GIVNUM( 1, I ),
- $ GIVNUM( 2, I ) )
- 40 CONTINUE
- PSIZ1 = PRMPTR( CURR+1 ) - PRMPTR( CURR )
- PSIZ2 = PRMPTR( CURR+2 ) - PRMPTR( CURR+1 )
- DO 50 I = 0, PSIZ1 - 1
- ZTEMP( I+1 ) = Z( ZPTR1+PERM( PRMPTR( CURR )+I )-1 )
- 50 CONTINUE
- DO 60 I = 0, PSIZ2 - 1
- ZTEMP( PSIZ1+I+1 ) = Z( MID+PERM( PRMPTR( CURR+1 )+I )-1 )
- 60 CONTINUE
-*
-* Multiply Blocks at CURR and CURR+1
-*
-* Determine size of these matrices. We add HALF to the value of
-* the SQRT in case the machine underestimates one of these
-* square roots.
-*
- BSIZ1 = INT( HALF+SQRT( DBLE( QPTR( CURR+1 )-QPTR( CURR ) ) ) )
- BSIZ2 = INT( HALF+SQRT( DBLE( QPTR( CURR+2 )-QPTR( CURR+
- $ 1 ) ) ) )
- IF( BSIZ1.GT.0 ) THEN
- CALL DGEMV( 'T', BSIZ1, BSIZ1, ONE, Q( QPTR( CURR ) ),
- $ BSIZ1, ZTEMP( 1 ), 1, ZERO, Z( ZPTR1 ), 1 )
- END IF
- CALL DCOPY( PSIZ1-BSIZ1, ZTEMP( BSIZ1+1 ), 1, Z( ZPTR1+BSIZ1 ),
- $ 1 )
- IF( BSIZ2.GT.0 ) THEN
- CALL DGEMV( 'T', BSIZ2, BSIZ2, ONE, Q( QPTR( CURR+1 ) ),
- $ BSIZ2, ZTEMP( PSIZ1+1 ), 1, ZERO, Z( MID ), 1 )
- END IF
- CALL DCOPY( PSIZ2-BSIZ2, ZTEMP( PSIZ1+BSIZ2+1 ), 1,
- $ Z( MID+BSIZ2 ), 1 )
-*
- PTR = PTR + 2**( TLVLS-K )
- 70 CONTINUE
-*
- RETURN
-*
-* End of DLAEDA
-*
- END
diff --git a/netlib/LAPACK/dlaein.f b/netlib/LAPACK/dlaein.f
deleted file mode 100644
index d4be36c..0000000
--- a/netlib/LAPACK/dlaein.f
+++ /dev/null
@@ -1,632 +0,0 @@
-*> \brief \b DLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAEIN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaein.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaein.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaein.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B,
-* LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL NOINIT, RIGHTV
-* INTEGER INFO, LDB, LDH, N
-* DOUBLE PRECISION BIGNUM, EPS3, SMLNUM, WI, WR
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), H( LDH, * ), VI( * ), VR( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAEIN uses inverse iteration to find a right or left eigenvector
-*> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg
-*> matrix H.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RIGHTV
-*> \verbatim
-*> RIGHTV is LOGICAL
-*> = .TRUE. : compute right eigenvector;
-*> = .FALSE.: compute left eigenvector.
-*> \endverbatim
-*>
-*> \param[in] NOINIT
-*> \verbatim
-*> NOINIT is LOGICAL
-*> = .TRUE. : no initial vector supplied in (VR,VI).
-*> = .FALSE.: initial vector supplied in (VR,VI).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> The upper Hessenberg matrix H.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION
-*> The real and imaginary parts of the eigenvalue of H whose
-*> corresponding right or left eigenvector is to be computed.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] VI
-*> \verbatim
-*> VI is DOUBLE PRECISION array, dimension (N)
-*> On entry, if NOINIT = .FALSE. and WI = 0.0, VR must contain
-*> a real starting vector for inverse iteration using the real
-*> eigenvalue WR; if NOINIT = .FALSE. and WI.ne.0.0, VR and VI
-*> must contain the real and imaginary parts of a complex
-*> starting vector for inverse iteration using the complex
-*> eigenvalue (WR,WI); otherwise VR and VI need not be set.
-*> On exit, if WI = 0.0 (real eigenvalue), VR contains the
-*> computed real eigenvector; if WI.ne.0.0 (complex eigenvalue),
-*> VR and VI contain the real and imaginary parts of the
-*> computed complex eigenvector. The eigenvector is normalized
-*> so that the component of largest magnitude has magnitude 1;
-*> here the magnitude of a complex number (x,y) is taken to be
-*> |x| + |y|.
-*> VI is not referenced if WI = 0.0.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= N+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in] EPS3
-*> \verbatim
-*> EPS3 is DOUBLE PRECISION
-*> A small machine-dependent value which is used to perturb
-*> close eigenvalues, and to replace zero pivots.
-*> \endverbatim
-*>
-*> \param[in] SMLNUM
-*> \verbatim
-*> SMLNUM is DOUBLE PRECISION
-*> A machine-dependent value close to the underflow threshold.
-*> \endverbatim
-*>
-*> \param[in] BIGNUM
-*> \verbatim
-*> BIGNUM is DOUBLE PRECISION
-*> A machine-dependent value close to the overflow threshold.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: inverse iteration did not converge; VR is set to the
-*> last iterate, and so is VI if WI.ne.0.0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B,
- $ LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL NOINIT, RIGHTV
- INTEGER INFO, LDB, LDH, N
- DOUBLE PRECISION BIGNUM, EPS3, SMLNUM, WI, WR
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), H( LDH, * ), VI( * ), VR( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TENTH
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TENTH = 1.0D-1 )
-* ..
-* .. Local Scalars ..
- CHARACTER NORMIN, TRANS
- INTEGER I, I1, I2, I3, IERR, ITS, J
- DOUBLE PRECISION ABSBII, ABSBJJ, EI, EJ, GROWTO, NORM, NRMSML,
- $ REC, ROOTN, SCALE, TEMP, VCRIT, VMAX, VNORM, W,
- $ W1, X, XI, XR, Y
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DLAPY2, DNRM2
- EXTERNAL IDAMAX, DASUM, DLAPY2, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLADIV, DLATRS, DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* GROWTO is the threshold used in the acceptance test for an
-* eigenvector.
-*
- ROOTN = SQRT( DBLE( N ) )
- GROWTO = TENTH / ROOTN
- NRMSML = MAX( ONE, EPS3*ROOTN )*SMLNUM
-*
-* Form B = H - (WR,WI)*I (except that the subdiagonal elements and
-* the imaginary parts of the diagonal elements are not stored).
-*
- DO 20 J = 1, N
- DO 10 I = 1, J - 1
- B( I, J ) = H( I, J )
- 10 CONTINUE
- B( J, J ) = H( J, J ) - WR
- 20 CONTINUE
-*
- IF( WI.EQ.ZERO ) THEN
-*
-* Real eigenvalue.
-*
- IF( NOINIT ) THEN
-*
-* Set initial vector.
-*
- DO 30 I = 1, N
- VR( I ) = EPS3
- 30 CONTINUE
- ELSE
-*
-* Scale supplied initial vector.
-*
- VNORM = DNRM2( N, VR, 1 )
- CALL DSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), VR,
- $ 1 )
- END IF
-*
- IF( RIGHTV ) THEN
-*
-* LU decomposition with partial pivoting of B, replacing zero
-* pivots by EPS3.
-*
- DO 60 I = 1, N - 1
- EI = H( I+1, I )
- IF( ABS( B( I, I ) ).LT.ABS( EI ) ) THEN
-*
-* Interchange rows and eliminate.
-*
- X = B( I, I ) / EI
- B( I, I ) = EI
- DO 40 J = I + 1, N
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - X*TEMP
- B( I, J ) = TEMP
- 40 CONTINUE
- ELSE
-*
-* Eliminate without interchange.
-*
- IF( B( I, I ).EQ.ZERO )
- $ B( I, I ) = EPS3
- X = EI / B( I, I )
- IF( X.NE.ZERO ) THEN
- DO 50 J = I + 1, N
- B( I+1, J ) = B( I+1, J ) - X*B( I, J )
- 50 CONTINUE
- END IF
- END IF
- 60 CONTINUE
- IF( B( N, N ).EQ.ZERO )
- $ B( N, N ) = EPS3
-*
- TRANS = 'N'
-*
- ELSE
-*
-* UL decomposition with partial pivoting of B, replacing zero
-* pivots by EPS3.
-*
- DO 90 J = N, 2, -1
- EJ = H( J, J-1 )
- IF( ABS( B( J, J ) ).LT.ABS( EJ ) ) THEN
-*
-* Interchange columns and eliminate.
-*
- X = B( J, J ) / EJ
- B( J, J ) = EJ
- DO 70 I = 1, J - 1
- TEMP = B( I, J-1 )
- B( I, J-1 ) = B( I, J ) - X*TEMP
- B( I, J ) = TEMP
- 70 CONTINUE
- ELSE
-*
-* Eliminate without interchange.
-*
- IF( B( J, J ).EQ.ZERO )
- $ B( J, J ) = EPS3
- X = EJ / B( J, J )
- IF( X.NE.ZERO ) THEN
- DO 80 I = 1, J - 1
- B( I, J-1 ) = B( I, J-1 ) - X*B( I, J )
- 80 CONTINUE
- END IF
- END IF
- 90 CONTINUE
- IF( B( 1, 1 ).EQ.ZERO )
- $ B( 1, 1 ) = EPS3
-*
- TRANS = 'T'
-*
- END IF
-*
- NORMIN = 'N'
- DO 110 ITS = 1, N
-*
-* Solve U*x = scale*v for a right eigenvector
-* or U**T*x = scale*v for a left eigenvector,
-* overwriting x on v.
-*
- CALL DLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB,
- $ VR, SCALE, WORK, IERR )
- NORMIN = 'Y'
-*
-* Test for sufficient growth in the norm of v.
-*
- VNORM = DASUM( N, VR, 1 )
- IF( VNORM.GE.GROWTO*SCALE )
- $ GO TO 120
-*
-* Choose new orthogonal starting vector and try again.
-*
- TEMP = EPS3 / ( ROOTN+ONE )
- VR( 1 ) = EPS3
- DO 100 I = 2, N
- VR( I ) = TEMP
- 100 CONTINUE
- VR( N-ITS+1 ) = VR( N-ITS+1 ) - EPS3*ROOTN
- 110 CONTINUE
-*
-* Failure to find eigenvector in N iterations.
-*
- INFO = 1
-*
- 120 CONTINUE
-*
-* Normalize eigenvector.
-*
- I = IDAMAX( N, VR, 1 )
- CALL DSCAL( N, ONE / ABS( VR( I ) ), VR, 1 )
- ELSE
-*
-* Complex eigenvalue.
-*
- IF( NOINIT ) THEN
-*
-* Set initial vector.
-*
- DO 130 I = 1, N
- VR( I ) = EPS3
- VI( I ) = ZERO
- 130 CONTINUE
- ELSE
-*
-* Scale supplied initial vector.
-*
- NORM = DLAPY2( DNRM2( N, VR, 1 ), DNRM2( N, VI, 1 ) )
- REC = ( EPS3*ROOTN ) / MAX( NORM, NRMSML )
- CALL DSCAL( N, REC, VR, 1 )
- CALL DSCAL( N, REC, VI, 1 )
- END IF
-*
- IF( RIGHTV ) THEN
-*
-* LU decomposition with partial pivoting of B, replacing zero
-* pivots by EPS3.
-*
-* The imaginary part of the (i,j)-th element of U is stored in
-* B(j+1,i).
-*
- B( 2, 1 ) = -WI
- DO 140 I = 2, N
- B( I+1, 1 ) = ZERO
- 140 CONTINUE
-*
- DO 170 I = 1, N - 1
- ABSBII = DLAPY2( B( I, I ), B( I+1, I ) )
- EI = H( I+1, I )
- IF( ABSBII.LT.ABS( EI ) ) THEN
-*
-* Interchange rows and eliminate.
-*
- XR = B( I, I ) / EI
- XI = B( I+1, I ) / EI
- B( I, I ) = EI
- B( I+1, I ) = ZERO
- DO 150 J = I + 1, N
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - XR*TEMP
- B( J+1, I+1 ) = B( J+1, I ) - XI*TEMP
- B( I, J ) = TEMP
- B( J+1, I ) = ZERO
- 150 CONTINUE
- B( I+2, I ) = -WI
- B( I+1, I+1 ) = B( I+1, I+1 ) - XI*WI
- B( I+2, I+1 ) = B( I+2, I+1 ) + XR*WI
- ELSE
-*
-* Eliminate without interchanging rows.
-*
- IF( ABSBII.EQ.ZERO ) THEN
- B( I, I ) = EPS3
- B( I+1, I ) = ZERO
- ABSBII = EPS3
- END IF
- EI = ( EI / ABSBII ) / ABSBII
- XR = B( I, I )*EI
- XI = -B( I+1, I )*EI
- DO 160 J = I + 1, N
- B( I+1, J ) = B( I+1, J ) - XR*B( I, J ) +
- $ XI*B( J+1, I )
- B( J+1, I+1 ) = -XR*B( J+1, I ) - XI*B( I, J )
- 160 CONTINUE
- B( I+2, I+1 ) = B( I+2, I+1 ) - WI
- END IF
-*
-* Compute 1-norm of offdiagonal elements of i-th row.
-*
- WORK( I ) = DASUM( N-I, B( I, I+1 ), LDB ) +
- $ DASUM( N-I, B( I+2, I ), 1 )
- 170 CONTINUE
- IF( B( N, N ).EQ.ZERO .AND. B( N+1, N ).EQ.ZERO )
- $ B( N, N ) = EPS3
- WORK( N ) = ZERO
-*
- I1 = N
- I2 = 1
- I3 = -1
- ELSE
-*
-* UL decomposition with partial pivoting of conjg(B),
-* replacing zero pivots by EPS3.
-*
-* The imaginary part of the (i,j)-th element of U is stored in
-* B(j+1,i).
-*
- B( N+1, N ) = WI
- DO 180 J = 1, N - 1
- B( N+1, J ) = ZERO
- 180 CONTINUE
-*
- DO 210 J = N, 2, -1
- EJ = H( J, J-1 )
- ABSBJJ = DLAPY2( B( J, J ), B( J+1, J ) )
- IF( ABSBJJ.LT.ABS( EJ ) ) THEN
-*
-* Interchange columns and eliminate
-*
- XR = B( J, J ) / EJ
- XI = B( J+1, J ) / EJ
- B( J, J ) = EJ
- B( J+1, J ) = ZERO
- DO 190 I = 1, J - 1
- TEMP = B( I, J-1 )
- B( I, J-1 ) = B( I, J ) - XR*TEMP
- B( J, I ) = B( J+1, I ) - XI*TEMP
- B( I, J ) = TEMP
- B( J+1, I ) = ZERO
- 190 CONTINUE
- B( J+1, J-1 ) = WI
- B( J-1, J-1 ) = B( J-1, J-1 ) + XI*WI
- B( J, J-1 ) = B( J, J-1 ) - XR*WI
- ELSE
-*
-* Eliminate without interchange.
-*
- IF( ABSBJJ.EQ.ZERO ) THEN
- B( J, J ) = EPS3
- B( J+1, J ) = ZERO
- ABSBJJ = EPS3
- END IF
- EJ = ( EJ / ABSBJJ ) / ABSBJJ
- XR = B( J, J )*EJ
- XI = -B( J+1, J )*EJ
- DO 200 I = 1, J - 1
- B( I, J-1 ) = B( I, J-1 ) - XR*B( I, J ) +
- $ XI*B( J+1, I )
- B( J, I ) = -XR*B( J+1, I ) - XI*B( I, J )
- 200 CONTINUE
- B( J, J-1 ) = B( J, J-1 ) + WI
- END IF
-*
-* Compute 1-norm of offdiagonal elements of j-th column.
-*
- WORK( J ) = DASUM( J-1, B( 1, J ), 1 ) +
- $ DASUM( J-1, B( J+1, 1 ), LDB )
- 210 CONTINUE
- IF( B( 1, 1 ).EQ.ZERO .AND. B( 2, 1 ).EQ.ZERO )
- $ B( 1, 1 ) = EPS3
- WORK( 1 ) = ZERO
-*
- I1 = 1
- I2 = N
- I3 = 1
- END IF
-*
- DO 270 ITS = 1, N
- SCALE = ONE
- VMAX = ONE
- VCRIT = BIGNUM
-*
-* Solve U*(xr,xi) = scale*(vr,vi) for a right eigenvector,
-* or U**T*(xr,xi) = scale*(vr,vi) for a left eigenvector,
-* overwriting (xr,xi) on (vr,vi).
-*
- DO 250 I = I1, I2, I3
-*
- IF( WORK( I ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N, REC, VR, 1 )
- CALL DSCAL( N, REC, VI, 1 )
- SCALE = SCALE*REC
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- XR = VR( I )
- XI = VI( I )
- IF( RIGHTV ) THEN
- DO 220 J = I + 1, N
- XR = XR - B( I, J )*VR( J ) + B( J+1, I )*VI( J )
- XI = XI - B( I, J )*VI( J ) - B( J+1, I )*VR( J )
- 220 CONTINUE
- ELSE
- DO 230 J = 1, I - 1
- XR = XR - B( J, I )*VR( J ) + B( I+1, J )*VI( J )
- XI = XI - B( J, I )*VI( J ) - B( I+1, J )*VR( J )
- 230 CONTINUE
- END IF
-*
- W = ABS( B( I, I ) ) + ABS( B( I+1, I ) )
- IF( W.GT.SMLNUM ) THEN
- IF( W.LT.ONE ) THEN
- W1 = ABS( XR ) + ABS( XI )
- IF( W1.GT.W*BIGNUM ) THEN
- REC = ONE / W1
- CALL DSCAL( N, REC, VR, 1 )
- CALL DSCAL( N, REC, VI, 1 )
- XR = VR( I )
- XI = VI( I )
- SCALE = SCALE*REC
- VMAX = VMAX*REC
- END IF
- END IF
-*
-* Divide by diagonal element of B.
-*
- CALL DLADIV( XR, XI, B( I, I ), B( I+1, I ), VR( I ),
- $ VI( I ) )
- VMAX = MAX( ABS( VR( I ) )+ABS( VI( I ) ), VMAX )
- VCRIT = BIGNUM / VMAX
- ELSE
- DO 240 J = 1, N
- VR( J ) = ZERO
- VI( J ) = ZERO
- 240 CONTINUE
- VR( I ) = ONE
- VI( I ) = ONE
- SCALE = ZERO
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
- 250 CONTINUE
-*
-* Test for sufficient growth in the norm of (VR,VI).
-*
- VNORM = DASUM( N, VR, 1 ) + DASUM( N, VI, 1 )
- IF( VNORM.GE.GROWTO*SCALE )
- $ GO TO 280
-*
-* Choose a new orthogonal starting vector and try again.
-*
- Y = EPS3 / ( ROOTN+ONE )
- VR( 1 ) = EPS3
- VI( 1 ) = ZERO
-*
- DO 260 I = 2, N
- VR( I ) = Y
- VI( I ) = ZERO
- 260 CONTINUE
- VR( N-ITS+1 ) = VR( N-ITS+1 ) - EPS3*ROOTN
- 270 CONTINUE
-*
-* Failure to find eigenvector in N iterations
-*
- INFO = 1
-*
- 280 CONTINUE
-*
-* Normalize eigenvector.
-*
- VNORM = ZERO
- DO 290 I = 1, N
- VNORM = MAX( VNORM, ABS( VR( I ) )+ABS( VI( I ) ) )
- 290 CONTINUE
- CALL DSCAL( N, ONE / VNORM, VR, 1 )
- CALL DSCAL( N, ONE / VNORM, VI, 1 )
-*
- END IF
-*
- RETURN
-*
-* End of DLAEIN
-*
- END
diff --git a/netlib/LAPACK/dlaev2.f b/netlib/LAPACK/dlaev2.f
deleted file mode 100644
index 2e333dd..0000000
--- a/netlib/LAPACK/dlaev2.f
+++ /dev/null
@@ -1,238 +0,0 @@
-*> \brief \b DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAEV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaev2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaev2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaev2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION A, B, C, CS1, RT1, RT2, SN1
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
-*> [ A B ]
-*> [ B C ].
-*> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
-*> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
-*> eigenvector for RT1, giving the decomposition
-*>
-*> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
-*> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION
-*> The (1,2) element and the conjugate of the (2,1) element of
-*> the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] RT1
-*> \verbatim
-*> RT1 is DOUBLE PRECISION
-*> The eigenvalue of larger absolute value.
-*> \endverbatim
-*>
-*> \param[out] RT2
-*> \verbatim
-*> RT2 is DOUBLE PRECISION
-*> The eigenvalue of smaller absolute value.
-*> \endverbatim
-*>
-*> \param[out] CS1
-*> \verbatim
-*> CS1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] SN1
-*> \verbatim
-*> SN1 is DOUBLE PRECISION
-*> The vector (CS1, SN1) is a unit right eigenvector for RT1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> RT1 is accurate to a few ulps barring over/underflow.
-*>
-*> RT2 may be inaccurate if there is massive cancellation in the
-*> determinant A*C-B*B; higher precision or correctly rounded or
-*> correctly truncated arithmetic would be needed to compute RT2
-*> accurately in all cases.
-*>
-*> CS1 and SN1 are accurate to a few ulps barring over/underflow.
-*>
-*> Overflow is possible only if RT1 is within a factor of 5 of overflow.
-*> Underflow is harmless if the input data is 0 or exceeds
-*> underflow_threshold / macheps.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B, C, CS1, RT1, RT2, SN1
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- INTEGER SGN1, SGN2
- DOUBLE PRECISION AB, ACMN, ACMX, ACS, ADF, CS, CT, DF, RT, SM,
- $ TB, TN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Compute the eigenvalues
-*
- SM = A + C
- DF = A - C
- ADF = ABS( DF )
- TB = B + B
- AB = ABS( TB )
- IF( ABS( A ).GT.ABS( C ) ) THEN
- ACMX = A
- ACMN = C
- ELSE
- ACMX = C
- ACMN = A
- END IF
- IF( ADF.GT.AB ) THEN
- RT = ADF*SQRT( ONE+( AB / ADF )**2 )
- ELSE IF( ADF.LT.AB ) THEN
- RT = AB*SQRT( ONE+( ADF / AB )**2 )
- ELSE
-*
-* Includes case AB=ADF=0
-*
- RT = AB*SQRT( TWO )
- END IF
- IF( SM.LT.ZERO ) THEN
- RT1 = HALF*( SM-RT )
- SGN1 = -1
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE IF( SM.GT.ZERO ) THEN
- RT1 = HALF*( SM+RT )
- SGN1 = 1
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE
-*
-* Includes case RT1 = RT2 = 0
-*
- RT1 = HALF*RT
- RT2 = -HALF*RT
- SGN1 = 1
- END IF
-*
-* Compute the eigenvector
-*
- IF( DF.GE.ZERO ) THEN
- CS = DF + RT
- SGN2 = 1
- ELSE
- CS = DF - RT
- SGN2 = -1
- END IF
- ACS = ABS( CS )
- IF( ACS.GT.AB ) THEN
- CT = -TB / CS
- SN1 = ONE / SQRT( ONE+CT*CT )
- CS1 = CT*SN1
- ELSE
- IF( AB.EQ.ZERO ) THEN
- CS1 = ONE
- SN1 = ZERO
- ELSE
- TN = -CS / TB
- CS1 = ONE / SQRT( ONE+TN*TN )
- SN1 = TN*CS1
- END IF
- END IF
- IF( SGN1.EQ.SGN2 ) THEN
- TN = CS1
- CS1 = -SN1
- SN1 = TN
- END IF
- RETURN
-*
-* End of DLAEV2
-*
- END
diff --git a/netlib/LAPACK/dlaexc.f b/netlib/LAPACK/dlaexc.f
deleted file mode 100644
index ef2d66e..0000000
--- a/netlib/LAPACK/dlaexc.f
+++ /dev/null
@@ -1,436 +0,0 @@
-*> \brief \b DLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form, by an orthogonal similarity transformation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAEXC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaexc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaexc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaexc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ
-* INTEGER INFO, J1, LDQ, LDT, N, N1, N2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
-*> an upper quasi-triangular matrix T by an orthogonal similarity
-*> transformation.
-*>
-*> T must be in Schur canonical form, that is, block upper triangular
-*> with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
-*> has its diagonal elemnts equal and its off-diagonal elements of
-*> opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> = .TRUE. : accumulate the transformation in the matrix Q;
-*> = .FALSE.: do not accumulate the transformation.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> canonical form.
-*> On exit, the updated matrix T, again in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
-*> On exit, if WANTQ is .TRUE., the updated matrix Q.
-*> If WANTQ is .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in] J1
-*> \verbatim
-*> J1 is INTEGER
-*> The index of the first row of the first block T11.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The order of the first block T11. N1 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> The order of the second block T22. N2 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: the transformed matrix T would be too far from Schur
-*> form; the blocks are not swapped and T and Q are
-*> unchanged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ
- INTEGER INFO, J1, LDQ, LDT, N, N1, N2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TEN
- PARAMETER ( TEN = 1.0D+1 )
- INTEGER LDD, LDX
- PARAMETER ( LDD = 4, LDX = 2 )
-* ..
-* .. Local Scalars ..
- INTEGER IERR, J2, J3, J4, K, ND
- DOUBLE PRECISION CS, DNORM, EPS, SCALE, SMLNUM, SN, T11, T22,
- $ T33, TAU, TAU1, TAU2, TEMP, THRESH, WI1, WI2,
- $ WR1, WR2, XNORM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION D( LDD, 4 ), U( 3 ), U1( 3 ), U2( 3 ),
- $ X( LDX, 2 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLANV2, DLARFG, DLARFX, DLARTG, DLASY2,
- $ DROT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. N1.EQ.0 .OR. N2.EQ.0 )
- $ RETURN
- IF( J1+N1.GT.N )
- $ RETURN
-*
- J2 = J1 + 1
- J3 = J1 + 2
- J4 = J1 + 3
-*
- IF( N1.EQ.1 .AND. N2.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- T11 = T( J1, J1 )
- T22 = T( J2, J2 )
-*
-* Determine the transformation to perform the interchange.
-*
- CALL DLARTG( T( J1, J2 ), T22-T11, CS, SN, TEMP )
-*
-* Apply transformation to the matrix T.
-*
- IF( J3.LE.N )
- $ CALL DROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, CS,
- $ SN )
- CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
-*
- T( J1, J1 ) = T22
- T( J2, J2 ) = T11
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
- END IF
-*
- ELSE
-*
-* Swapping involves at least one 2-by-2 block.
-*
-* Copy the diagonal block of order N1+N2 to the local array D
-* and compute its norm.
-*
- ND = N1 + N2
- CALL DLACPY( 'Full', ND, ND, T( J1, J1 ), LDT, D, LDD )
- DNORM = DLANGE( 'Max', ND, ND, D, LDD, WORK )
-*
-* Compute machine-dependent threshold for test for accepting
-* swap.
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- THRESH = MAX( TEN*EPS*DNORM, SMLNUM )
-*
-* Solve T11*X - X*T22 = scale*T12 for X.
-*
- CALL DLASY2( .FALSE., .FALSE., -1, N1, N2, D, LDD,
- $ D( N1+1, N1+1 ), LDD, D( 1, N1+1 ), LDD, SCALE, X,
- $ LDX, XNORM, IERR )
-*
-* Swap the adjacent diagonal blocks.
-*
- K = N1 + N1 + N2 - 3
- GO TO ( 10, 20, 30 )K
-*
- 10 CONTINUE
-*
-* N1 = 1, N2 = 2: generate elementary reflector H so that:
-*
-* ( scale, X11, X12 ) H = ( 0, 0, * )
-*
- U( 1 ) = SCALE
- U( 2 ) = X( 1, 1 )
- U( 3 ) = X( 1, 2 )
- CALL DLARFG( 3, U( 3 ), U, 1, TAU )
- U( 3 ) = ONE
- T11 = T( J1, J1 )
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL DLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
- CALL DLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 3,
- $ 3 )-T11 ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL DLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, WORK )
- CALL DLARFX( 'R', J2, 3, U, TAU, T( 1, J1 ), LDT, WORK )
-*
- T( J3, J1 ) = ZERO
- T( J3, J2 ) = ZERO
- T( J3, J3 ) = T11
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
- END IF
- GO TO 40
-*
- 20 CONTINUE
-*
-* N1 = 2, N2 = 1: generate elementary reflector H so that:
-*
-* H ( -X11 ) = ( * )
-* ( -X21 ) = ( 0 )
-* ( scale ) = ( 0 )
-*
- U( 1 ) = -X( 1, 1 )
- U( 2 ) = -X( 2, 1 )
- U( 3 ) = SCALE
- CALL DLARFG( 3, U( 1 ), U( 2 ), 1, TAU )
- U( 1 ) = ONE
- T33 = T( J3, J3 )
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL DLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
- CALL DLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 2, 1 ) ), ABS( D( 3, 1 ) ), ABS( D( 1,
- $ 1 )-T33 ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL DLARFX( 'R', J3, 3, U, TAU, T( 1, J1 ), LDT, WORK )
- CALL DLARFX( 'L', 3, N-J1, U, TAU, T( J1, J2 ), LDT, WORK )
-*
- T( J1, J1 ) = T33
- T( J2, J1 ) = ZERO
- T( J3, J1 ) = ZERO
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
- END IF
- GO TO 40
-*
- 30 CONTINUE
-*
-* N1 = 2, N2 = 2: generate elementary reflectors H(1) and H(2) so
-* that:
-*
-* H(2) H(1) ( -X11 -X12 ) = ( * * )
-* ( -X21 -X22 ) ( 0 * )
-* ( scale 0 ) ( 0 0 )
-* ( 0 scale ) ( 0 0 )
-*
- U1( 1 ) = -X( 1, 1 )
- U1( 2 ) = -X( 2, 1 )
- U1( 3 ) = SCALE
- CALL DLARFG( 3, U1( 1 ), U1( 2 ), 1, TAU1 )
- U1( 1 ) = ONE
-*
- TEMP = -TAU1*( X( 1, 2 )+U1( 2 )*X( 2, 2 ) )
- U2( 1 ) = -TEMP*U1( 2 ) - X( 2, 2 )
- U2( 2 ) = -TEMP*U1( 3 )
- U2( 3 ) = SCALE
- CALL DLARFG( 3, U2( 1 ), U2( 2 ), 1, TAU2 )
- U2( 1 ) = ONE
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL DLARFX( 'L', 3, 4, U1, TAU1, D, LDD, WORK )
- CALL DLARFX( 'R', 4, 3, U1, TAU1, D, LDD, WORK )
- CALL DLARFX( 'L', 3, 4, U2, TAU2, D( 2, 1 ), LDD, WORK )
- CALL DLARFX( 'R', 4, 3, U2, TAU2, D( 1, 2 ), LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 4, 1 ) ),
- $ ABS( D( 4, 2 ) ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL DLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, WORK )
- CALL DLARFX( 'R', J4, 3, U1, TAU1, T( 1, J1 ), LDT, WORK )
- CALL DLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, WORK )
- CALL DLARFX( 'R', J4, 3, U2, TAU2, T( 1, J2 ), LDT, WORK )
-*
- T( J3, J1 ) = ZERO
- T( J3, J2 ) = ZERO
- T( J4, J1 ) = ZERO
- T( J4, J2 ) = ZERO
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DLARFX( 'R', N, 3, U1, TAU1, Q( 1, J1 ), LDQ, WORK )
- CALL DLARFX( 'R', N, 3, U2, TAU2, Q( 1, J2 ), LDQ, WORK )
- END IF
-*
- 40 CONTINUE
-*
- IF( N2.EQ.2 ) THEN
-*
-* Standardize new 2-by-2 block T11
-*
- CALL DLANV2( T( J1, J1 ), T( J1, J2 ), T( J2, J1 ),
- $ T( J2, J2 ), WR1, WI1, WR2, WI2, CS, SN )
- CALL DROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), LDT,
- $ CS, SN )
- CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
- IF( WANTQ )
- $ CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
- END IF
-*
- IF( N1.EQ.2 ) THEN
-*
-* Standardize new 2-by-2 block T22
-*
- J3 = J1 + N2
- J4 = J3 + 1
- CALL DLANV2( T( J3, J3 ), T( J3, J4 ), T( J4, J3 ),
- $ T( J4, J4 ), WR1, WI1, WR2, WI2, CS, SN )
- IF( J3+2.LE.N )
- $ CALL DROT( N-J3-1, T( J3, J3+2 ), LDT, T( J4, J3+2 ),
- $ LDT, CS, SN )
- CALL DROT( J3-1, T( 1, J3 ), 1, T( 1, J4 ), 1, CS, SN )
- IF( WANTQ )
- $ CALL DROT( N, Q( 1, J3 ), 1, Q( 1, J4 ), 1, CS, SN )
- END IF
-*
- END IF
- RETURN
-*
-* Exit with INFO = 1 if swap was rejected.
-*
- 50 CONTINUE
- INFO = 1
- RETURN
-*
-* End of DLAEXC
-*
- END
diff --git a/netlib/LAPACK/dlag2.f b/netlib/LAPACK/dlag2.f
deleted file mode 100644
index a941b94..0000000
--- a/netlib/LAPACK/dlag2.f
+++ /dev/null
@@ -1,379 +0,0 @@
-*> \brief \b DLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary to avoid over-/underflow.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAG2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlag2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlag2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlag2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
-* WR2, WI )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDB
-* DOUBLE PRECISION SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
-*> problem A - w B, with scaling as necessary to avoid over-/underflow.
-*>
-*> The scaling factor "s" results in a modified eigenvalue equation
-*>
-*> s A - w B
-*>
-*> where s is a non-negative scaling factor chosen so that w, w B,
-*> and s A do not overflow and, if possible, do not underflow, either.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, 2)
-*> On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
-*> is less than 1/SAFMIN. Entries less than
-*> sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= 2.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, 2)
-*> On entry, the 2 x 2 upper triangular matrix B. It is
-*> assumed that the one-norm of B is less than 1/SAFMIN. The
-*> diagonals should be at least sqrt(SAFMIN) times the largest
-*> element of B (in absolute value); if a diagonal is smaller
-*> than that, then +/- sqrt(SAFMIN) will be used instead of
-*> that diagonal.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= 2.
-*> \endverbatim
-*>
-*> \param[in] SAFMIN
-*> \verbatim
-*> SAFMIN is DOUBLE PRECISION
-*> The smallest positive number s.t. 1/SAFMIN does not
-*> overflow. (This should always be DLAMCH('S') -- it is an
-*> argument in order to avoid having to call DLAMCH frequently.)
-*> \endverbatim
-*>
-*> \param[out] SCALE1
-*> \verbatim
-*> SCALE1 is DOUBLE PRECISION
-*> A scaling factor used to avoid over-/underflow in the
-*> eigenvalue equation which defines the first eigenvalue. If
-*> the eigenvalues are complex, then the eigenvalues are
-*> ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
-*> exponent range of the machine), SCALE1=SCALE2, and SCALE1
-*> will always be positive. If the eigenvalues are real, then
-*> the first (real) eigenvalue is WR1 / SCALE1 , but this may
-*> overflow or underflow, and in fact, SCALE1 may be zero or
-*> less than the underflow threshhold if the exact eigenvalue
-*> is sufficiently large.
-*> \endverbatim
-*>
-*> \param[out] SCALE2
-*> \verbatim
-*> SCALE2 is DOUBLE PRECISION
-*> A scaling factor used to avoid over-/underflow in the
-*> eigenvalue equation which defines the second eigenvalue. If
-*> the eigenvalues are complex, then SCALE2=SCALE1. If the
-*> eigenvalues are real, then the second (real) eigenvalue is
-*> WR2 / SCALE2 , but this may overflow or underflow, and in
-*> fact, SCALE2 may be zero or less than the underflow
-*> threshhold if the exact eigenvalue is sufficiently large.
-*> \endverbatim
-*>
-*> \param[out] WR1
-*> \verbatim
-*> WR1 is DOUBLE PRECISION
-*> If the eigenvalue is real, then WR1 is SCALE1 times the
-*> eigenvalue closest to the (2,2) element of A B**(-1). If the
-*> eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
-*> part of the eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] WR2
-*> \verbatim
-*> WR2 is DOUBLE PRECISION
-*> If the eigenvalue is real, then WR2 is SCALE2 times the
-*> other eigenvalue. If the eigenvalue is complex, then
-*> WR1=WR2 is SCALE1 times the real part of the eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION
-*> If the eigenvalue is real, then WI is zero. If the
-*> eigenvalue is complex, then WI is SCALE1 times the imaginary
-*> part of the eigenvalues. WI will always be non-negative.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
- $ WR2, WI )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDB
- DOUBLE PRECISION SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = ONE / TWO )
- DOUBLE PRECISION FUZZY1
- PARAMETER ( FUZZY1 = ONE+1.0D-5 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION A11, A12, A21, A22, ABI22, ANORM, AS11, AS12,
- $ AS22, ASCALE, B11, B12, B22, BINV11, BINV22,
- $ BMIN, BNORM, BSCALE, BSIZE, C1, C2, C3, C4, C5,
- $ DIFF, DISCR, PP, QQ, R, RTMAX, RTMIN, S1, S2,
- $ SAFMAX, SHIFT, SS, SUM, WABS, WBIG, WDET,
- $ WSCALE, WSIZE, WSMALL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
- RTMIN = SQRT( SAFMIN )
- RTMAX = ONE / RTMIN
- SAFMAX = ONE / SAFMIN
-*
-* Scale A
-*
- ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
- $ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
- ASCALE = ONE / ANORM
- A11 = ASCALE*A( 1, 1 )
- A21 = ASCALE*A( 2, 1 )
- A12 = ASCALE*A( 1, 2 )
- A22 = ASCALE*A( 2, 2 )
-*
-* Perturb B if necessary to insure non-singularity
-*
- B11 = B( 1, 1 )
- B12 = B( 1, 2 )
- B22 = B( 2, 2 )
- BMIN = RTMIN*MAX( ABS( B11 ), ABS( B12 ), ABS( B22 ), RTMIN )
- IF( ABS( B11 ).LT.BMIN )
- $ B11 = SIGN( BMIN, B11 )
- IF( ABS( B22 ).LT.BMIN )
- $ B22 = SIGN( BMIN, B22 )
-*
-* Scale B
-*
- BNORM = MAX( ABS( B11 ), ABS( B12 )+ABS( B22 ), SAFMIN )
- BSIZE = MAX( ABS( B11 ), ABS( B22 ) )
- BSCALE = ONE / BSIZE
- B11 = B11*BSCALE
- B12 = B12*BSCALE
- B22 = B22*BSCALE
-*
-* Compute larger eigenvalue by method described by C. van Loan
-*
-* ( AS is A shifted by -SHIFT*B )
-*
- BINV11 = ONE / B11
- BINV22 = ONE / B22
- S1 = A11*BINV11
- S2 = A22*BINV22
- IF( ABS( S1 ).LE.ABS( S2 ) ) THEN
- AS12 = A12 - S1*B12
- AS22 = A22 - S1*B22
- SS = A21*( BINV11*BINV22 )
- ABI22 = AS22*BINV22 - SS*B12
- PP = HALF*ABI22
- SHIFT = S1
- ELSE
- AS12 = A12 - S2*B12
- AS11 = A11 - S2*B11
- SS = A21*( BINV11*BINV22 )
- ABI22 = -SS*B12
- PP = HALF*( AS11*BINV11+ABI22 )
- SHIFT = S2
- END IF
- QQ = SS*AS12
- IF( ABS( PP*RTMIN ).GE.ONE ) THEN
- DISCR = ( RTMIN*PP )**2 + QQ*SAFMIN
- R = SQRT( ABS( DISCR ) )*RTMAX
- ELSE
- IF( PP**2+ABS( QQ ).LE.SAFMIN ) THEN
- DISCR = ( RTMAX*PP )**2 + QQ*SAFMAX
- R = SQRT( ABS( DISCR ) )*RTMIN
- ELSE
- DISCR = PP**2 + QQ
- R = SQRT( ABS( DISCR ) )
- END IF
- END IF
-*
-* Note: the test of R in the following IF is to cover the case when
-* DISCR is small and negative and is flushed to zero during
-* the calculation of R. On machines which have a consistent
-* flush-to-zero threshhold and handle numbers above that
-* threshhold correctly, it would not be necessary.
-*
- IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN
- SUM = PP + SIGN( R, PP )
- DIFF = PP - SIGN( R, PP )
- WBIG = SHIFT + SUM
-*
-* Compute smaller eigenvalue
-*
- WSMALL = SHIFT + DIFF
- IF( HALF*ABS( WBIG ).GT.MAX( ABS( WSMALL ), SAFMIN ) ) THEN
- WDET = ( A11*A22-A12*A21 )*( BINV11*BINV22 )
- WSMALL = WDET / WBIG
- END IF
-*
-* Choose (real) eigenvalue closest to 2,2 element of A*B**(-1)
-* for WR1.
-*
- IF( PP.GT.ABI22 ) THEN
- WR1 = MIN( WBIG, WSMALL )
- WR2 = MAX( WBIG, WSMALL )
- ELSE
- WR1 = MAX( WBIG, WSMALL )
- WR2 = MIN( WBIG, WSMALL )
- END IF
- WI = ZERO
- ELSE
-*
-* Complex eigenvalues
-*
- WR1 = SHIFT + PP
- WR2 = WR1
- WI = R
- END IF
-*
-* Further scaling to avoid underflow and overflow in computing
-* SCALE1 and overflow in computing w*B.
-*
-* This scale factor (WSCALE) is bounded from above using C1 and C2,
-* and from below using C3 and C4.
-* C1 implements the condition s A must never overflow.
-* C2 implements the condition w B must never overflow.
-* C3, with C2,
-* implement the condition that s A - w B must never overflow.
-* C4 implements the condition s should not underflow.
-* C5 implements the condition max(s,|w|) should be at least 2.
-*
- C1 = BSIZE*( SAFMIN*MAX( ONE, ASCALE ) )
- C2 = SAFMIN*MAX( ONE, BNORM )
- C3 = BSIZE*SAFMIN
- IF( ASCALE.LE.ONE .AND. BSIZE.LE.ONE ) THEN
- C4 = MIN( ONE, ( ASCALE / SAFMIN )*BSIZE )
- ELSE
- C4 = ONE
- END IF
- IF( ASCALE.LE.ONE .OR. BSIZE.LE.ONE ) THEN
- C5 = MIN( ONE, ASCALE*BSIZE )
- ELSE
- C5 = ONE
- END IF
-*
-* Scale first eigenvalue
-*
- WABS = ABS( WR1 ) + ABS( WI )
- WSIZE = MAX( SAFMIN, C1, FUZZY1*( WABS*C2+C3 ),
- $ MIN( C4, HALF*MAX( WABS, C5 ) ) )
- IF( WSIZE.NE.ONE ) THEN
- WSCALE = ONE / WSIZE
- IF( WSIZE.GT.ONE ) THEN
- SCALE1 = ( MAX( ASCALE, BSIZE )*WSCALE )*
- $ MIN( ASCALE, BSIZE )
- ELSE
- SCALE1 = ( MIN( ASCALE, BSIZE )*WSCALE )*
- $ MAX( ASCALE, BSIZE )
- END IF
- WR1 = WR1*WSCALE
- IF( WI.NE.ZERO ) THEN
- WI = WI*WSCALE
- WR2 = WR1
- SCALE2 = SCALE1
- END IF
- ELSE
- SCALE1 = ASCALE*BSIZE
- SCALE2 = SCALE1
- END IF
-*
-* Scale second eigenvalue (if real)
-*
- IF( WI.EQ.ZERO ) THEN
- WSIZE = MAX( SAFMIN, C1, FUZZY1*( ABS( WR2 )*C2+C3 ),
- $ MIN( C4, HALF*MAX( ABS( WR2 ), C5 ) ) )
- IF( WSIZE.NE.ONE ) THEN
- WSCALE = ONE / WSIZE
- IF( WSIZE.GT.ONE ) THEN
- SCALE2 = ( MAX( ASCALE, BSIZE )*WSCALE )*
- $ MIN( ASCALE, BSIZE )
- ELSE
- SCALE2 = ( MIN( ASCALE, BSIZE )*WSCALE )*
- $ MAX( ASCALE, BSIZE )
- END IF
- WR2 = WR2*WSCALE
- ELSE
- SCALE2 = ASCALE*BSIZE
- END IF
- END IF
-*
-* End of DLAG2
-*
- RETURN
- END
diff --git a/netlib/LAPACK/dlag2s.f b/netlib/LAPACK/dlag2s.f
deleted file mode 100644
index 3cf27db..0000000
--- a/netlib/LAPACK/dlag2s.f
+++ /dev/null
@@ -1,152 +0,0 @@
-*> \brief \b DLAG2S converts a double precision matrix to a single precision matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAG2S + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlag2s.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlag2s.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlag2s.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAG2S( M, N, A, LDA, SA, LDSA, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDSA, M, N
-* ..
-* .. Array Arguments ..
-* REAL SA( LDSA, * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE
-*> PRECISION matrix, A.
-*>
-*> RMAX is the overflow for the SINGLE PRECISION arithmetic
-*> DLAG2S checks that all the entries of A are between -RMAX and
-*> RMAX. If not the convertion is aborted and a flag is raised.
-*>
-*> This is an auxiliary routine so there is no argument checking.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of lines of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N coefficient matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] SA
-*> \verbatim
-*> SA is REAL array, dimension (LDSA,N)
-*> On exit, if INFO=0, the M-by-N coefficient matrix SA; if
-*> INFO>0, the content of SA is unspecified.
-*> \endverbatim
-*>
-*> \param[in] LDSA
-*> \verbatim
-*> LDSA is INTEGER
-*> The leading dimension of the array SA. LDSA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> = 1: an entry of the matrix A is greater than the SINGLE
-*> PRECISION overflow threshold, in this case, the content
-*> of SA in exit is unspecified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAG2S( M, N, A, LDA, SA, LDSA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDSA, M, N
-* ..
-* .. Array Arguments ..
- REAL SA( LDSA, * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION RMAX
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Executable Statements ..
-*
- RMAX = SLAMCH( 'O' )
- DO 20 J = 1, N
- DO 10 I = 1, M
- IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) ) THEN
- INFO = 1
- GO TO 30
- END IF
- SA( I, J ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- INFO = 0
- 30 CONTINUE
- RETURN
-*
-* End of DLAG2S
-*
- END
diff --git a/netlib/LAPACK/dlagge.f b/netlib/LAPACK/dlagge.f
deleted file mode 100644
index 34d4800..0000000
--- a/netlib/LAPACK/dlagge.f
+++ /dev/null
@@ -1,357 +0,0 @@
-*> \brief \b DLAGGE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGGE generates a real general m by n matrix A, by pre- and post-
-*> multiplying a real diagonal matrix D with random orthogonal matrices:
-*> A = U*D*V. The lower and upper bandwidths may then be reduced to
-*> kl and ku by additional orthogonal transformations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of nonzero subdiagonals within the band of A.
-*> 0 <= KL <= M-1.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of nonzero superdiagonals within the band of A.
-*> 0 <= KU <= N-1.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> The diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The generated m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= M.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M+N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION TAU, WA, WB, WN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DLARNV, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SIGN
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DNRM2
- EXTERNAL DNRM2
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -7
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DLAGGE', -INFO )
- RETURN
- END IF
-*
-* initialize A to diagonal matrix
-*
- DO 20 J = 1, N
- DO 10 I = 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- DO 30 I = 1, MIN( M, N )
- A( I, I ) = D( I )
- 30 CONTINUE
-*
-* pre- and post-multiply A by random orthogonal matrices
-*
- DO 40 I = MIN( M, N ), 1, -1
- IF( I.LT.M ) THEN
-*
-* generate random reflection
-*
- CALL DLARNV( 3, ISEED, M-I+1, WORK )
- WN = DNRM2( M-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL DSCAL( M-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* multiply A(i:m,i:n) by random reflection from the left
-*
- CALL DGEMV( 'Transpose', M-I+1, N-I+1, ONE, A( I, I ), LDA,
- $ WORK, 1, ZERO, WORK( M+1 ), 1 )
- CALL DGER( M-I+1, N-I+1, -TAU, WORK, 1, WORK( M+1 ), 1,
- $ A( I, I ), LDA )
- END IF
- IF( I.LT.N ) THEN
-*
-* generate random reflection
-*
- CALL DLARNV( 3, ISEED, N-I+1, WORK )
- WN = DNRM2( N-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* multiply A(i:m,i:n) by random reflection from the right
-*
- CALL DGEMV( 'No transpose', M-I+1, N-I+1, ONE, A( I, I ),
- $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 )
- CALL DGER( M-I+1, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1,
- $ A( I, I ), LDA )
- END IF
- 40 CONTINUE
-*
-* Reduce number of subdiagonals to KL and number of superdiagonals
-* to KU
-*
- DO 70 I = 1, MAX( M-1-KL, N-1-KU )
- IF( KL.LE.KU ) THEN
-*
-* annihilate subdiagonal elements first (necessary if KL = 0)
-*
- IF( I.LE.MIN( M-1-KL, N ) ) THEN
-*
-* generate reflection to annihilate A(kl+i+1:m,i)
-*
- WN = DNRM2( M-KL-I+1, A( KL+I, I ), 1 )
- WA = SIGN( WN, A( KL+I, I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( KL+I, I ) + WA
- CALL DSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 )
- A( KL+I, I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(kl+i:m,i+1:n) from the left
-*
- CALL DGEMV( 'Transpose', M-KL-I+1, N-I, ONE,
- $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO,
- $ WORK, 1 )
- CALL DGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1,
- $ A( KL+I, I+1 ), LDA )
- A( KL+I, I ) = -WA
- END IF
-*
- IF( I.LE.MIN( N-1-KU, M ) ) THEN
-*
-* generate reflection to annihilate A(i,ku+i+1:n)
-*
- WN = DNRM2( N-KU-I+1, A( I, KU+I ), LDA )
- WA = SIGN( WN, A( I, KU+I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( I, KU+I ) + WA
- CALL DSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA )
- A( I, KU+I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(i+1:m,ku+i:n) from the right
-*
- CALL DGEMV( 'No transpose', M-I, N-KU-I+1, ONE,
- $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO,
- $ WORK, 1 )
- CALL DGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ),
- $ LDA, A( I+1, KU+I ), LDA )
- A( I, KU+I ) = -WA
- END IF
- ELSE
-*
-* annihilate superdiagonal elements first (necessary if
-* KU = 0)
-*
- IF( I.LE.MIN( N-1-KU, M ) ) THEN
-*
-* generate reflection to annihilate A(i,ku+i+1:n)
-*
- WN = DNRM2( N-KU-I+1, A( I, KU+I ), LDA )
- WA = SIGN( WN, A( I, KU+I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( I, KU+I ) + WA
- CALL DSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA )
- A( I, KU+I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(i+1:m,ku+i:n) from the right
-*
- CALL DGEMV( 'No transpose', M-I, N-KU-I+1, ONE,
- $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO,
- $ WORK, 1 )
- CALL DGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ),
- $ LDA, A( I+1, KU+I ), LDA )
- A( I, KU+I ) = -WA
- END IF
-*
- IF( I.LE.MIN( M-1-KL, N ) ) THEN
-*
-* generate reflection to annihilate A(kl+i+1:m,i)
-*
- WN = DNRM2( M-KL-I+1, A( KL+I, I ), 1 )
- WA = SIGN( WN, A( KL+I, I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( KL+I, I ) + WA
- CALL DSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 )
- A( KL+I, I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(kl+i:m,i+1:n) from the left
-*
- CALL DGEMV( 'Transpose', M-KL-I+1, N-I, ONE,
- $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO,
- $ WORK, 1 )
- CALL DGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1,
- $ A( KL+I, I+1 ), LDA )
- A( KL+I, I ) = -WA
- END IF
- END IF
-*
- DO 50 J = KL + I + 1, M
- A( J, I ) = ZERO
- 50 CONTINUE
-*
- DO 60 J = KU + I + 1, N
- A( I, J ) = ZERO
- 60 CONTINUE
- 70 CONTINUE
- RETURN
-*
-* End of DLAGGE
-*
- END
diff --git a/netlib/LAPACK/dlags2.f b/netlib/LAPACK/dlags2.f
deleted file mode 100644
index 0f7cc85..0000000
--- a/netlib/LAPACK/dlags2.f
+++ /dev/null
@@ -1,362 +0,0 @@
-*> \brief \b DLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAGS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlags2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlags2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlags2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
-* SNV, CSQ, SNQ )
-*
-* .. Scalar Arguments ..
-* LOGICAL UPPER
-* DOUBLE PRECISION A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
-* $ SNU, SNV
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
-*> that if ( UPPER ) then
-*>
-*> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 )
-*> ( 0 A3 ) ( x x )
-*> and
-*> V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 )
-*> ( 0 B3 ) ( x x )
-*>
-*> or if ( .NOT.UPPER ) then
-*>
-*> U**T *A*Q = U**T *( A1 0 )*Q = ( x x )
-*> ( A2 A3 ) ( 0 x )
-*> and
-*> V**T*B*Q = V**T*( B1 0 )*Q = ( x x )
-*> ( B2 B3 ) ( 0 x )
-*>
-*> The rows of the transformed A and B are parallel, where
-*>
-*> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
-*> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
-*>
-*> Z**T denotes the transpose of Z.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPPER
-*> \verbatim
-*> UPPER is LOGICAL
-*> = .TRUE.: the input matrices A and B are upper triangular.
-*> = .FALSE.: the input matrices A and B are lower triangular.
-*> \endverbatim
-*>
-*> \param[in] A1
-*> \verbatim
-*> A1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] A2
-*> \verbatim
-*> A2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] A3
-*> \verbatim
-*> A3 is DOUBLE PRECISION
-*> On entry, A1, A2 and A3 are elements of the input 2-by-2
-*> upper (lower) triangular matrix A.
-*> \endverbatim
-*>
-*> \param[in] B1
-*> \verbatim
-*> B1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] B2
-*> \verbatim
-*> B2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] B3
-*> \verbatim
-*> B3 is DOUBLE PRECISION
-*> On entry, B1, B2 and B3 are elements of the input 2-by-2
-*> upper (lower) triangular matrix B.
-*> \endverbatim
-*>
-*> \param[out] CSU
-*> \verbatim
-*> CSU is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] SNU
-*> \verbatim
-*> SNU is DOUBLE PRECISION
-*> The desired orthogonal matrix U.
-*> \endverbatim
-*>
-*> \param[out] CSV
-*> \verbatim
-*> CSV is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] SNV
-*> \verbatim
-*> SNV is DOUBLE PRECISION
-*> The desired orthogonal matrix V.
-*> \endverbatim
-*>
-*> \param[out] CSQ
-*> \verbatim
-*> CSQ is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] SNQ
-*> \verbatim
-*> SNQ is DOUBLE PRECISION
-*> The desired orthogonal matrix Q.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
- $ SNV, CSQ, SNQ )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL UPPER
- DOUBLE PRECISION A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
- $ SNU, SNV
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION A, AUA11, AUA12, AUA21, AUA22, AVB11, AVB12,
- $ AVB21, AVB22, B, C, CSL, CSR, D, R, S1, S2,
- $ SNL, SNR, UA11, UA11R, UA12, UA21, UA22, UA22R,
- $ VB11, VB11R, VB12, VB21, VB22, VB22R
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARTG, DLASV2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( UPPER ) THEN
-*
-* Input matrices A and B are upper triangular matrices
-*
-* Form matrix C = A*adj(B) = ( a b )
-* ( 0 d )
-*
- A = A1*B3
- D = A3*B1
- B = A2*B1 - A1*B2
-*
-* The SVD of real 2-by-2 triangular C
-*
-* ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 )
-* ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T )
-*
- CALL DLASV2( A, B, D, S1, S2, SNR, CSR, SNL, CSL )
-*
- IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) )
- $ THEN
-*
-* Compute the (1,1) and (1,2) elements of U**T *A and V**T *B,
-* and (1,2) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA11R = CSL*A1
- UA12 = CSL*A2 + SNL*A3
-*
- VB11R = CSR*B1
- VB12 = CSR*B2 + SNR*B3
-*
- AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 )
- AVB12 = ABS( CSR )*ABS( B2 ) + ABS( SNR )*ABS( B3 )
-*
-* zero (1,2) elements of U**T *A and V**T *B
-*
- IF( ( ABS( UA11R )+ABS( UA12 ) ).NE.ZERO ) THEN
- IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 /
- $ ( ABS( VB11R )+ABS( VB12 ) ) ) THEN
- CALL DLARTG( -UA11R, UA12, CSQ, SNQ, R )
- ELSE
- CALL DLARTG( -VB11R, VB12, CSQ, SNQ, R )
- END IF
- ELSE
- CALL DLARTG( -VB11R, VB12, CSQ, SNQ, R )
- END IF
-*
- CSU = CSL
- SNU = -SNL
- CSV = CSR
- SNV = -SNR
-*
- ELSE
-*
-* Compute the (2,1) and (2,2) elements of U**T *A and V**T *B,
-* and (2,2) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA21 = -SNL*A1
- UA22 = -SNL*A2 + CSL*A3
-*
- VB21 = -SNR*B1
- VB22 = -SNR*B2 + CSR*B3
-*
- AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 )
- AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 )
-*
-* zero (2,2) elements of U**T*A and V**T*B, and then swap.
-*
- IF( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN
- IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 /
- $ ( ABS( VB21 )+ABS( VB22 ) ) ) THEN
- CALL DLARTG( -UA21, UA22, CSQ, SNQ, R )
- ELSE
- CALL DLARTG( -VB21, VB22, CSQ, SNQ, R )
- END IF
- ELSE
- CALL DLARTG( -VB21, VB22, CSQ, SNQ, R )
- END IF
-*
- CSU = SNL
- SNU = CSL
- CSV = SNR
- SNV = CSR
-*
- END IF
-*
- ELSE
-*
-* Input matrices A and B are lower triangular matrices
-*
-* Form matrix C = A*adj(B) = ( a 0 )
-* ( c d )
-*
- A = A1*B3
- D = A3*B1
- C = A2*B3 - A3*B2
-*
-* The SVD of real 2-by-2 triangular C
-*
-* ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 )
-* ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T )
-*
- CALL DLASV2( A, C, D, S1, S2, SNR, CSR, SNL, CSL )
-*
- IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) )
- $ THEN
-*
-* Compute the (2,1) and (2,2) elements of U**T *A and V**T *B,
-* and (2,1) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA21 = -SNR*A1 + CSR*A2
- UA22R = CSR*A3
-*
- VB21 = -SNL*B1 + CSL*B2
- VB22R = CSL*B3
-*
- AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 )
- AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 )
-*
-* zero (2,1) elements of U**T *A and V**T *B.
-*
- IF( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN
- IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 /
- $ ( ABS( VB21 )+ABS( VB22R ) ) ) THEN
- CALL DLARTG( UA22R, UA21, CSQ, SNQ, R )
- ELSE
- CALL DLARTG( VB22R, VB21, CSQ, SNQ, R )
- END IF
- ELSE
- CALL DLARTG( VB22R, VB21, CSQ, SNQ, R )
- END IF
-*
- CSU = CSR
- SNU = -SNR
- CSV = CSL
- SNV = -SNL
-*
- ELSE
-*
-* Compute the (1,1) and (1,2) elements of U**T *A and V**T *B,
-* and (1,1) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA11 = CSR*A1 + SNR*A2
- UA12 = SNR*A3
-*
- VB11 = CSL*B1 + SNL*B2
- VB12 = SNL*B3
-*
- AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 )
- AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 )
-*
-* zero (1,1) elements of U**T*A and V**T*B, and then swap.
-*
- IF( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN
- IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 /
- $ ( ABS( VB11 )+ABS( VB12 ) ) ) THEN
- CALL DLARTG( UA12, UA11, CSQ, SNQ, R )
- ELSE
- CALL DLARTG( VB12, VB11, CSQ, SNQ, R )
- END IF
- ELSE
- CALL DLARTG( VB12, VB11, CSQ, SNQ, R )
- END IF
-*
- CSU = SNR
- SNU = CSR
- CSV = SNL
- SNV = CSL
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DLAGS2
-*
- END
diff --git a/netlib/LAPACK/dlagsy.f b/netlib/LAPACK/dlagsy.f
deleted file mode 100644
index b5c4881..0000000
--- a/netlib/LAPACK/dlagsy.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DLAGSY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGSY generates a real symmetric matrix A, by pre- and post-
-*> multiplying a real diagonal matrix D with a random orthogonal matrix:
-*> A = U*D*U'. The semi-bandwidth may then be reduced to k by additional
-*> orthogonal transformations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of nonzero subdiagonals within the band of A.
-*> 0 <= K <= N-1.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The generated n by n symmetric matrix A (the full matrix is
-*> stored).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= N.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, HALF
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, HALF = 0.5D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION ALPHA, TAU, WA, WB, WN
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DGEMV, DGER, DLARNV, DSCAL, DSYMV,
- $ DSYR2, XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DDOT, DNRM2
- EXTERNAL DDOT, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( K.LT.0 .OR. K.GT.N-1 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DLAGSY', -INFO )
- RETURN
- END IF
-*
-* initialize lower triangle of A to diagonal matrix
-*
- DO 20 J = 1, N
- DO 10 I = J + 1, N
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- DO 30 I = 1, N
- A( I, I ) = D( I )
- 30 CONTINUE
-*
-* Generate lower triangle of symmetric matrix
-*
- DO 40 I = N - 1, 1, -1
-*
-* generate random reflection
-*
- CALL DLARNV( 3, ISEED, N-I+1, WORK )
- WN = DNRM2( N-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply random reflection to A(i:n,i:n) from the left
-* and the right
-*
-* compute y := tau * A * u
-*
- CALL DSYMV( 'Lower', N-I+1, TAU, A( I, I ), LDA, WORK, 1, ZERO,
- $ WORK( N+1 ), 1 )
-*
-* compute v := y - 1/2 * tau * ( y, u ) * u
-*
- ALPHA = -HALF*TAU*DDOT( N-I+1, WORK( N+1 ), 1, WORK, 1 )
- CALL DAXPY( N-I+1, ALPHA, WORK, 1, WORK( N+1 ), 1 )
-*
-* apply the transformation as a rank-2 update to A(i:n,i:n)
-*
- CALL DSYR2( 'Lower', N-I+1, -ONE, WORK, 1, WORK( N+1 ), 1,
- $ A( I, I ), LDA )
- 40 CONTINUE
-*
-* Reduce number of subdiagonals to K
-*
- DO 60 I = 1, N - 1 - K
-*
-* generate reflection to annihilate A(k+i+1:n,i)
-*
- WN = DNRM2( N-K-I+1, A( K+I, I ), 1 )
- WA = SIGN( WN, A( K+I, I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( K+I, I ) + WA
- CALL DSCAL( N-K-I, ONE / WB, A( K+I+1, I ), 1 )
- A( K+I, I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(k+i:n,i+1:k+i-1) from the left
-*
- CALL DGEMV( 'Transpose', N-K-I+1, K-1, ONE, A( K+I, I+1 ), LDA,
- $ A( K+I, I ), 1, ZERO, WORK, 1 )
- CALL DGER( N-K-I+1, K-1, -TAU, A( K+I, I ), 1, WORK, 1,
- $ A( K+I, I+1 ), LDA )
-*
-* apply reflection to A(k+i:n,k+i:n) from the left and the right
-*
-* compute y := tau * A * u
-*
- CALL DSYMV( 'Lower', N-K-I+1, TAU, A( K+I, K+I ), LDA,
- $ A( K+I, I ), 1, ZERO, WORK, 1 )
-*
-* compute v := y - 1/2 * tau * ( y, u ) * u
-*
- ALPHA = -HALF*TAU*DDOT( N-K-I+1, WORK, 1, A( K+I, I ), 1 )
- CALL DAXPY( N-K-I+1, ALPHA, A( K+I, I ), 1, WORK, 1 )
-*
-* apply symmetric rank-2 update to A(k+i:n,k+i:n)
-*
- CALL DSYR2( 'Lower', N-K-I+1, -ONE, A( K+I, I ), 1, WORK, 1,
- $ A( K+I, K+I ), LDA )
-*
- A( K+I, I ) = -WA
- DO 50 J = K + I + 1, N
- A( J, I ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
-* Store full symmetric matrix
-*
- DO 80 J = 1, N
- DO 70 I = J + 1, N
- A( J, I ) = A( I, J )
- 70 CONTINUE
- 80 CONTINUE
- RETURN
-*
-* End of DLAGSY
-*
- END
diff --git a/netlib/LAPACK/dlagtf.f b/netlib/LAPACK/dlagtf.f
deleted file mode 100644
index ba7b229..0000000
--- a/netlib/LAPACK/dlagtf.f
+++ /dev/null
@@ -1,266 +0,0 @@
-*> \brief \b DLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAGTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagtf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagtf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagtf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* DOUBLE PRECISION LAMBDA, TOL
-* ..
-* .. Array Arguments ..
-* INTEGER IN( * )
-* DOUBLE PRECISION A( * ), B( * ), C( * ), D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
-*> tridiagonal matrix and lambda is a scalar, as
-*>
-*> T - lambda*I = PLU,
-*>
-*> where P is a permutation matrix, L is a unit lower tridiagonal matrix
-*> with at most one non-zero sub-diagonal elements per column and U is
-*> an upper triangular matrix with at most two non-zero super-diagonal
-*> elements per column.
-*>
-*> The factorization is obtained by Gaussian elimination with partial
-*> pivoting and implicit row scaling.
-*>
-*> The parameter LAMBDA is included in the routine so that DLAGTF may
-*> be used, in conjunction with DLAGTS, to obtain eigenvectors of T by
-*> inverse iteration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (N)
-*> On entry, A must contain the diagonal elements of T.
-*>
-*> On exit, A is overwritten by the n diagonal elements of the
-*> upper triangular matrix U of the factorization of T.
-*> \endverbatim
-*>
-*> \param[in] LAMBDA
-*> \verbatim
-*> LAMBDA is DOUBLE PRECISION
-*> On entry, the scalar lambda.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, B must contain the (n-1) super-diagonal elements of
-*> T.
-*>
-*> On exit, B is overwritten by the (n-1) super-diagonal
-*> elements of the matrix U of the factorization of T.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, C must contain the (n-1) sub-diagonal elements of
-*> T.
-*>
-*> On exit, C is overwritten by the (n-1) sub-diagonal elements
-*> of the matrix L of the factorization of T.
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is DOUBLE PRECISION
-*> On entry, a relative tolerance used to indicate whether or
-*> not the matrix (T - lambda*I) is nearly singular. TOL should
-*> normally be chose as approximately the largest relative error
-*> in the elements of T. For example, if the elements of T are
-*> correct to about 4 significant figures, then TOL should be
-*> set to about 5*10**(-4). If TOL is supplied as less than eps,
-*> where eps is the relative machine precision, then the value
-*> eps is used in place of TOL.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N-2)
-*> On exit, D is overwritten by the (n-2) second super-diagonal
-*> elements of the matrix U of the factorization of T.
-*> \endverbatim
-*>
-*> \param[out] IN
-*> \verbatim
-*> IN is INTEGER array, dimension (N)
-*> On exit, IN contains details of the permutation matrix P. If
-*> an interchange occurred at the kth step of the elimination,
-*> then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
-*> returns the smallest positive integer j such that
-*>
-*> abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
-*>
-*> where norm( A(j) ) denotes the sum of the absolute values of
-*> the jth row of the matrix A. If no such j exists then IN(n)
-*> is returned as zero. If IN(n) is returned as positive, then a
-*> diagonal element of U is small, indicating that
-*> (T - lambda*I) is singular or nearly singular,
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit
-*> .lt. 0: if INFO = -k, the kth argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
- DOUBLE PRECISION LAMBDA, TOL
-* ..
-* .. Array Arguments ..
- INTEGER IN( * )
- DOUBLE PRECISION A( * ), B( * ), C( * ), D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER K
- DOUBLE PRECISION EPS, MULT, PIV1, PIV2, SCALE1, SCALE2, TEMP, TL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DLAGTF', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- A( 1 ) = A( 1 ) - LAMBDA
- IN( N ) = 0
- IF( N.EQ.1 ) THEN
- IF( A( 1 ).EQ.ZERO )
- $ IN( 1 ) = 1
- RETURN
- END IF
-*
- EPS = DLAMCH( 'Epsilon' )
-*
- TL = MAX( TOL, EPS )
- SCALE1 = ABS( A( 1 ) ) + ABS( B( 1 ) )
- DO 10 K = 1, N - 1
- A( K+1 ) = A( K+1 ) - LAMBDA
- SCALE2 = ABS( C( K ) ) + ABS( A( K+1 ) )
- IF( K.LT.( N-1 ) )
- $ SCALE2 = SCALE2 + ABS( B( K+1 ) )
- IF( A( K ).EQ.ZERO ) THEN
- PIV1 = ZERO
- ELSE
- PIV1 = ABS( A( K ) ) / SCALE1
- END IF
- IF( C( K ).EQ.ZERO ) THEN
- IN( K ) = 0
- PIV2 = ZERO
- SCALE1 = SCALE2
- IF( K.LT.( N-1 ) )
- $ D( K ) = ZERO
- ELSE
- PIV2 = ABS( C( K ) ) / SCALE2
- IF( PIV2.LE.PIV1 ) THEN
- IN( K ) = 0
- SCALE1 = SCALE2
- C( K ) = C( K ) / A( K )
- A( K+1 ) = A( K+1 ) - C( K )*B( K )
- IF( K.LT.( N-1 ) )
- $ D( K ) = ZERO
- ELSE
- IN( K ) = 1
- MULT = A( K ) / C( K )
- A( K ) = C( K )
- TEMP = A( K+1 )
- A( K+1 ) = B( K ) - MULT*TEMP
- IF( K.LT.( N-1 ) ) THEN
- D( K ) = B( K+1 )
- B( K+1 ) = -MULT*D( K )
- END IF
- B( K ) = TEMP
- C( K ) = MULT
- END IF
- END IF
- IF( ( MAX( PIV1, PIV2 ).LE.TL ) .AND. ( IN( N ).EQ.0 ) )
- $ IN( N ) = K
- 10 CONTINUE
- IF( ( ABS( A( N ) ).LE.SCALE1*TL ) .AND. ( IN( N ).EQ.0 ) )
- $ IN( N ) = N
-*
- RETURN
-*
-* End of DLAGTF
-*
- END
diff --git a/netlib/LAPACK/dlagtm.f b/netlib/LAPACK/dlagtm.f
deleted file mode 100644
index 0908f1f..0000000
--- a/netlib/LAPACK/dlagtm.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b DLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAGTM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagtm.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagtm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagtm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
-* B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER LDB, LDX, N, NRHS
-* DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGTM performs a matrix-vector product of the form
-*>
-*> B := alpha * A * X + beta * B
-*>
-*> where A is a tridiagonal matrix of order N, B and X are N by NRHS
-*> matrices, and alpha and beta are real scalars, each of which may be
-*> 0., 1., or -1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': No transpose, B := alpha * A * X + beta * B
-*> = 'T': Transpose, B := alpha * A'* X + beta * B
-*> = 'C': Conjugate transpose = Transpose
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices X and B.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
-*> it is assumed to be 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) sub-diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) super-diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> The N by NRHS matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(N,1).
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
-*> it is assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N by NRHS matrix B.
-*> On exit, B is overwritten by the matrix expression
-*> B := alpha * A * X + beta * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(N,1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
- $ B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER LDB, LDX, N, NRHS
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Multiply B by BETA if BETA.NE.1.
-*
- IF( BETA.EQ.ZERO ) THEN
- DO 20 J = 1, NRHS
- DO 10 I = 1, N
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( BETA.EQ.-ONE ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = -B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
-*
- IF( ALPHA.EQ.ONE ) THEN
- IF( LSAME( TRANS, 'N' ) ) THEN
-*
-* Compute B := B + A*X
-*
- DO 60 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
- $ DU( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
- $ D( N )*X( N, J )
- DO 50 I = 2, N - 1
- B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
- $ D( I )*X( I, J ) + DU( I )*X( I+1, J )
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
-*
-* Compute B := B + A**T*X
-*
- DO 80 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
- $ DL( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
- $ D( N )*X( N, J )
- DO 70 I = 2, N - 1
- B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
- $ D( I )*X( I, J ) + DL( I )*X( I+1, J )
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
- ELSE IF( ALPHA.EQ.-ONE ) THEN
- IF( LSAME( TRANS, 'N' ) ) THEN
-*
-* Compute B := B - A*X
-*
- DO 100 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
- $ DU( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
- $ D( N )*X( N, J )
- DO 90 I = 2, N - 1
- B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
- $ D( I )*X( I, J ) - DU( I )*X( I+1, J )
- 90 CONTINUE
- END IF
- 100 CONTINUE
- ELSE
-*
-* Compute B := B - A**T*X
-*
- DO 120 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
- $ DL( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
- $ D( N )*X( N, J )
- DO 110 I = 2, N - 1
- B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
- $ D( I )*X( I, J ) - DL( I )*X( I+1, J )
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DLAGTM
-*
- END
diff --git a/netlib/LAPACK/dlagts.f b/netlib/LAPACK/dlagts.f
deleted file mode 100644
index 8eb28ff..0000000
--- a/netlib/LAPACK/dlagts.f
+++ /dev/null
@@ -1,383 +0,0 @@
-*> \brief \b DLAGTS solves the system of equations (T-λI)x = y or (T-λI)Tx = y,where T is a general tridiagonal matrix and λ a scalar, using the LU factorization computed by slagtf.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAGTS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagts.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagts.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagts.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGTS( JOB, N, A, B, C, D, IN, Y, TOL, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, JOB, N
-* DOUBLE PRECISION TOL
-* ..
-* .. Array Arguments ..
-* INTEGER IN( * )
-* DOUBLE PRECISION A( * ), B( * ), C( * ), D( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGTS may be used to solve one of the systems of equations
-*>
-*> (T - lambda*I)*x = y or (T - lambda*I)**T*x = y,
-*>
-*> where T is an n by n tridiagonal matrix, for x, following the
-*> factorization of (T - lambda*I) as
-*>
-*> (T - lambda*I) = P*L*U ,
-*>
-*> by routine DLAGTF. The choice of equation to be solved is
-*> controlled by the argument JOB, and in each case there is an option
-*> to perturb zero or very small diagonal elements of U, this option
-*> being intended for use in applications such as inverse iteration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is INTEGER
-*> Specifies the job to be performed by DLAGTS as follows:
-*> = 1: The equations (T - lambda*I)x = y are to be solved,
-*> but diagonal elements of U are not to be perturbed.
-*> = -1: The equations (T - lambda*I)x = y are to be solved
-*> and, if overflow would otherwise occur, the diagonal
-*> elements of U are to be perturbed. See argument TOL
-*> below.
-*> = 2: The equations (T - lambda*I)**Tx = y are to be solved,
-*> but diagonal elements of U are not to be perturbed.
-*> = -2: The equations (T - lambda*I)**Tx = y are to be solved
-*> and, if overflow would otherwise occur, the diagonal
-*> elements of U are to be perturbed. See argument TOL
-*> below.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (N)
-*> On entry, A must contain the diagonal elements of U as
-*> returned from DLAGTF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, B must contain the first super-diagonal elements of
-*> U as returned from DLAGTF.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, C must contain the sub-diagonal elements of L as
-*> returned from DLAGTF.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N-2)
-*> On entry, D must contain the second super-diagonal elements
-*> of U as returned from DLAGTF.
-*> \endverbatim
-*>
-*> \param[in] IN
-*> \verbatim
-*> IN is INTEGER array, dimension (N)
-*> On entry, IN must contain details of the matrix P as returned
-*> from DLAGTF.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (N)
-*> On entry, the right hand side vector y.
-*> On exit, Y is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[in,out] TOL
-*> \verbatim
-*> TOL is DOUBLE PRECISION
-*> On entry, with JOB .lt. 0, TOL should be the minimum
-*> perturbation to be made to very small diagonal elements of U.
-*> TOL should normally be chosen as about eps*norm(U), where eps
-*> is the relative machine precision, but if TOL is supplied as
-*> non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
-*> If JOB .gt. 0 then TOL is not referenced.
-*>
-*> On exit, TOL is changed as described above, only if TOL is
-*> non-positive on entry. Otherwise TOL is unchanged.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit
-*> .lt. 0: if INFO = -i, the i-th argument had an illegal value
-*> .gt. 0: overflow would occur when computing the INFO(th)
-*> element of the solution vector x. This can only occur
-*> when JOB is supplied as positive and either means
-*> that a diagonal element of U is very small, or that
-*> the elements of the right-hand side vector y are very
-*> large.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAGTS( JOB, N, A, B, C, D, IN, Y, TOL, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, JOB, N
- DOUBLE PRECISION TOL
-* ..
-* .. Array Arguments ..
- INTEGER IN( * )
- DOUBLE PRECISION A( * ), B( * ), C( * ), D( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER K
- DOUBLE PRECISION ABSAK, AK, BIGNUM, EPS, PERT, SFMIN, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SIGN
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( ( ABS( JOB ).GT.2 ) .OR. ( JOB.EQ.0 ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAGTS', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- EPS = DLAMCH( 'Epsilon' )
- SFMIN = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SFMIN
-*
- IF( JOB.LT.0 ) THEN
- IF( TOL.LE.ZERO ) THEN
- TOL = ABS( A( 1 ) )
- IF( N.GT.1 )
- $ TOL = MAX( TOL, ABS( A( 2 ) ), ABS( B( 1 ) ) )
- DO 10 K = 3, N
- TOL = MAX( TOL, ABS( A( K ) ), ABS( B( K-1 ) ),
- $ ABS( D( K-2 ) ) )
- 10 CONTINUE
- TOL = TOL*EPS
- IF( TOL.EQ.ZERO )
- $ TOL = EPS
- END IF
- END IF
-*
- IF( ABS( JOB ).EQ.1 ) THEN
- DO 20 K = 2, N
- IF( IN( K-1 ).EQ.0 ) THEN
- Y( K ) = Y( K ) - C( K-1 )*Y( K-1 )
- ELSE
- TEMP = Y( K-1 )
- Y( K-1 ) = Y( K )
- Y( K ) = TEMP - C( K-1 )*Y( K )
- END IF
- 20 CONTINUE
- IF( JOB.EQ.1 ) THEN
- DO 30 K = N, 1, -1
- IF( K.LE.N-2 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 ) - D( K )*Y( K+2 )
- ELSE IF( K.EQ.N-1 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- INFO = K
- RETURN
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- INFO = K
- RETURN
- END IF
- END IF
- Y( K ) = TEMP / AK
- 30 CONTINUE
- ELSE
- DO 50 K = N, 1, -1
- IF( K.LE.N-2 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 ) - D( K )*Y( K+2 )
- ELSE IF( K.EQ.N-1 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- PERT = SIGN( TOL, AK )
- 40 CONTINUE
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 40
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 40
- END IF
- END IF
- Y( K ) = TEMP / AK
- 50 CONTINUE
- END IF
- ELSE
-*
-* Come to here if JOB = 2 or -2
-*
- IF( JOB.EQ.2 ) THEN
- DO 60 K = 1, N
- IF( K.GE.3 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 ) - D( K-2 )*Y( K-2 )
- ELSE IF( K.EQ.2 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- INFO = K
- RETURN
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- INFO = K
- RETURN
- END IF
- END IF
- Y( K ) = TEMP / AK
- 60 CONTINUE
- ELSE
- DO 80 K = 1, N
- IF( K.GE.3 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 ) - D( K-2 )*Y( K-2 )
- ELSE IF( K.EQ.2 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- PERT = SIGN( TOL, AK )
- 70 CONTINUE
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 70
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 70
- END IF
- END IF
- Y( K ) = TEMP / AK
- 80 CONTINUE
- END IF
-*
- DO 90 K = N, 2, -1
- IF( IN( K-1 ).EQ.0 ) THEN
- Y( K-1 ) = Y( K-1 ) - C( K-1 )*Y( K )
- ELSE
- TEMP = Y( K-1 )
- Y( K-1 ) = Y( K )
- Y( K ) = TEMP - C( K-1 )*Y( K )
- END IF
- 90 CONTINUE
- END IF
-*
-* End of DLAGTS
-*
- END
diff --git a/netlib/LAPACK/dlagv2.f b/netlib/LAPACK/dlagv2.f
deleted file mode 100644
index f52801f..0000000
--- a/netlib/LAPACK/dlagv2.f
+++ /dev/null
@@ -1,374 +0,0 @@
-*> \brief \b DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 matrix pencil (A,B) where B is upper triangular.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAGV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagv2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagv2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagv2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
-* CSR, SNR )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDB
-* DOUBLE PRECISION CSL, CSR, SNL, SNR
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
-* $ B( LDB, * ), BETA( 2 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAGV2 computes the Generalized Schur factorization of a real 2-by-2
-*> matrix pencil (A,B) where B is upper triangular. This routine
-*> computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
-*> SNR such that
-*>
-*> 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
-*> types), then
-*>
-*> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
-*> [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
-*>
-*> [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
-*> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
-*>
-*> 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
-*> then
-*>
-*> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
-*> [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
-*>
-*> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
-*> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
-*>
-*> where b11 >= b22 > 0.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, 2)
-*> On entry, the 2 x 2 matrix A.
-*> On exit, A is overwritten by the ``A-part'' of the
-*> generalized Schur form.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> THe leading dimension of the array A. LDA >= 2.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, 2)
-*> On entry, the upper triangular 2 x 2 matrix B.
-*> On exit, B is overwritten by the ``B-part'' of the
-*> generalized Schur form.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> THe leading dimension of the array B. LDB >= 2.
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (2)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (2)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (2)
-*> (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
-*> pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
-*> be zero.
-*> \endverbatim
-*>
-*> \param[out] CSL
-*> \verbatim
-*> CSL is DOUBLE PRECISION
-*> The cosine of the left rotation matrix.
-*> \endverbatim
-*>
-*> \param[out] SNL
-*> \verbatim
-*> SNL is DOUBLE PRECISION
-*> The sine of the left rotation matrix.
-*> \endverbatim
-*>
-*> \param[out] CSR
-*> \verbatim
-*> CSR is DOUBLE PRECISION
-*> The cosine of the right rotation matrix.
-*> \endverbatim
-*>
-*> \param[out] SNR
-*> \verbatim
-*> SNR is DOUBLE PRECISION
-*> The sine of the right rotation matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
- $ CSR, SNR )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDB
- DOUBLE PRECISION CSL, CSR, SNL, SNR
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
- $ B( LDB, * ), BETA( 2 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ANORM, ASCALE, BNORM, BSCALE, H1, H2, H3, QQ,
- $ R, RR, SAFMIN, SCALE1, SCALE2, T, ULP, WI, WR1,
- $ WR2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAG2, DLARTG, DLASV2, DROT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL DLAMCH, DLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- SAFMIN = DLAMCH( 'S' )
- ULP = DLAMCH( 'P' )
-*
-* Scale A
-*
- ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
- $ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
- ASCALE = ONE / ANORM
- A( 1, 1 ) = ASCALE*A( 1, 1 )
- A( 1, 2 ) = ASCALE*A( 1, 2 )
- A( 2, 1 ) = ASCALE*A( 2, 1 )
- A( 2, 2 ) = ASCALE*A( 2, 2 )
-*
-* Scale B
-*
- BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 1, 2 ) )+ABS( B( 2, 2 ) ),
- $ SAFMIN )
- BSCALE = ONE / BNORM
- B( 1, 1 ) = BSCALE*B( 1, 1 )
- B( 1, 2 ) = BSCALE*B( 1, 2 )
- B( 2, 2 ) = BSCALE*B( 2, 2 )
-*
-* Check if A can be deflated
-*
- IF( ABS( A( 2, 1 ) ).LE.ULP ) THEN
- CSL = ONE
- SNL = ZERO
- CSR = ONE
- SNR = ZERO
- A( 2, 1 ) = ZERO
- B( 2, 1 ) = ZERO
- WI = ZERO
-*
-* Check if B is singular
-*
- ELSE IF( ABS( B( 1, 1 ) ).LE.ULP ) THEN
- CALL DLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
- CSR = ONE
- SNR = ZERO
- CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
- CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
- A( 2, 1 ) = ZERO
- B( 1, 1 ) = ZERO
- B( 2, 1 ) = ZERO
- WI = ZERO
-*
- ELSE IF( ABS( B( 2, 2 ) ).LE.ULP ) THEN
- CALL DLARTG( A( 2, 2 ), A( 2, 1 ), CSR, SNR, T )
- SNR = -SNR
- CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
- CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
- CSL = ONE
- SNL = ZERO
- A( 2, 1 ) = ZERO
- B( 2, 1 ) = ZERO
- B( 2, 2 ) = ZERO
- WI = ZERO
-*
- ELSE
-*
-* B is nonsingular, first compute the eigenvalues of (A,B)
-*
- CALL DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2,
- $ WI )
-*
- IF( WI.EQ.ZERO ) THEN
-*
-* two real eigenvalues, compute s*A-w*B
-*
- H1 = SCALE1*A( 1, 1 ) - WR1*B( 1, 1 )
- H2 = SCALE1*A( 1, 2 ) - WR1*B( 1, 2 )
- H3 = SCALE1*A( 2, 2 ) - WR1*B( 2, 2 )
-*
- RR = DLAPY2( H1, H2 )
- QQ = DLAPY2( SCALE1*A( 2, 1 ), H3 )
-*
- IF( RR.GT.QQ ) THEN
-*
-* find right rotation matrix to zero 1,1 element of
-* (sA - wB)
-*
- CALL DLARTG( H2, H1, CSR, SNR, T )
-*
- ELSE
-*
-* find right rotation matrix to zero 2,1 element of
-* (sA - wB)
-*
- CALL DLARTG( H3, SCALE1*A( 2, 1 ), CSR, SNR, T )
-*
- END IF
-*
- SNR = -SNR
- CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
- CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-*
-* compute inf norms of A and B
-*
- H1 = MAX( ABS( A( 1, 1 ) )+ABS( A( 1, 2 ) ),
- $ ABS( A( 2, 1 ) )+ABS( A( 2, 2 ) ) )
- H2 = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
- $ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
-*
- IF( ( SCALE1*H1 ).GE.ABS( WR1 )*H2 ) THEN
-*
-* find left rotation matrix Q to zero out B(2,1)
-*
- CALL DLARTG( B( 1, 1 ), B( 2, 1 ), CSL, SNL, R )
-*
- ELSE
-*
-* find left rotation matrix Q to zero out A(2,1)
-*
- CALL DLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
-*
- END IF
-*
- CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
- CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
-*
- A( 2, 1 ) = ZERO
- B( 2, 1 ) = ZERO
-*
- ELSE
-*
-* a pair of complex conjugate eigenvalues
-* first compute the SVD of the matrix B
-*
- CALL DLASV2( B( 1, 1 ), B( 1, 2 ), B( 2, 2 ), R, T, SNR,
- $ CSR, SNL, CSL )
-*
-* Form (A,B) := Q(A,B)Z**T where Q is left rotation matrix and
-* Z is right rotation matrix computed from DLASV2
-*
- CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
- CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
- CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
- CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-*
- B( 2, 1 ) = ZERO
- B( 1, 2 ) = ZERO
-*
- END IF
-*
- END IF
-*
-* Unscaling
-*
- A( 1, 1 ) = ANORM*A( 1, 1 )
- A( 2, 1 ) = ANORM*A( 2, 1 )
- A( 1, 2 ) = ANORM*A( 1, 2 )
- A( 2, 2 ) = ANORM*A( 2, 2 )
- B( 1, 1 ) = BNORM*B( 1, 1 )
- B( 2, 1 ) = BNORM*B( 2, 1 )
- B( 1, 2 ) = BNORM*B( 1, 2 )
- B( 2, 2 ) = BNORM*B( 2, 2 )
-*
- IF( WI.EQ.ZERO ) THEN
- ALPHAR( 1 ) = A( 1, 1 )
- ALPHAR( 2 ) = A( 2, 2 )
- ALPHAI( 1 ) = ZERO
- ALPHAI( 2 ) = ZERO
- BETA( 1 ) = B( 1, 1 )
- BETA( 2 ) = B( 2, 2 )
- ELSE
- ALPHAR( 1 ) = ANORM*WR1 / SCALE1 / BNORM
- ALPHAI( 1 ) = ANORM*WI / SCALE1 / BNORM
- ALPHAR( 2 ) = ALPHAR( 1 )
- ALPHAI( 2 ) = -ALPHAI( 1 )
- BETA( 1 ) = ONE
- BETA( 2 ) = ONE
- END IF
-*
- RETURN
-*
-* End of DLAGV2
-*
- END
diff --git a/netlib/LAPACK/dlahilb.f b/netlib/LAPACK/dlahilb.f
deleted file mode 100644
index 5106d9d..0000000
--- a/netlib/LAPACK/dlahilb.f
+++ /dev/null
@@ -1,225 +0,0 @@
-C> \brief \b DLAHILB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER N, NRHS, LDA, LDX, LDB, INFO
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA, N), X(LDX, NRHS), B(LDB, NRHS), WORK(N)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAHILB generates an N by N scaled Hilbert matrix in A along with
-*> NRHS right-hand sides in B and solutions in X such that A*X=B.
-*>
-*> The Hilbert matrix is scaled by M = LCM(1, 2, ..., 2*N-1) so that all
-*> entries are integers. The right-hand sides are the first NRHS
-*> columns of M * the identity matrix, and the solutions are the
-*> first NRHS columns of the inverse Hilbert matrix.
-*>
-*> The condition number of the Hilbert matrix grows exponentially with
-*> its size, roughly as O(e ** (3.5*N)). Additionally, the inverse
-*> Hilbert matrices beyond a relatively small dimension cannot be
-*> generated exactly without extra precision. Precision is exhausted
-*> when the largest entry in the inverse Hilbert matrix is greater than
-*> 2 to the power of the number of bits in the fraction of the data type
-*> used plus one, which is 24 for single precision.
-*>
-*> In single, the generated solution is exact for N <= 6 and has
-*> small componentwise error for 7 <= N <= 11.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The requested number of right-hand sides.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> The generated scaled Hilbert matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= N.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX, NRHS)
-*> The generated exact solutions. Currently, the first NRHS
-*> columns of the inverse Hilbert matrix.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= N.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, NRHS)
-*> The generated right-hand sides. Currently, the first NRHS
-*> columns of LCM(1, 2, ..., 2*N-1) * the identity matrix.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: N is too large; the data is still generated but may not
-*> be not exact.
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
-*
-* -- LAPACK test routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER N, NRHS, LDA, LDX, LDB, INFO
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA, N), X(LDX, NRHS), B(LDB, NRHS), WORK(N)
-* ..
-*
-* =====================================================================
-* .. Local Scalars ..
- INTEGER TM, TI, R
- INTEGER M
- INTEGER I, J
- COMPLEX*16 TMP
-
-* .. Parameters ..
-* NMAX_EXACT the largest dimension where the generated data is
-* exact.
-* NMAX_APPROX the largest dimension where the generated data has
-* a small componentwise relative error.
- INTEGER NMAX_EXACT, NMAX_APPROX
- PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11)
-
-* ..
-* .. External Functions
- EXTERNAL DLASET
- INTRINSIC DBLE
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF (N .LT. 0 .OR. N .GT. NMAX_APPROX) THEN
- INFO = -1
- ELSE IF (NRHS .LT. 0) THEN
- INFO = -2
- ELSE IF (LDA .LT. N) THEN
- INFO = -4
- ELSE IF (LDX .LT. N) THEN
- INFO = -6
- ELSE IF (LDB .LT. N) THEN
- INFO = -8
- END IF
- IF (INFO .LT. 0) THEN
- CALL XERBLA('DLAHILB', -INFO)
- RETURN
- END IF
- IF (N .GT. NMAX_EXACT) THEN
- INFO = 1
- END IF
-
-* Compute M = the LCM of the integers [1, 2*N-1]. The largest
-* reasonable N is small enough that integers suffice (up to N = 11).
- M = 1
- DO I = 2, (2*N-1)
- TM = M
- TI = I
- R = MOD(TM, TI)
- DO WHILE (R .NE. 0)
- TM = TI
- TI = R
- R = MOD(TM, TI)
- END DO
- M = (M / TI) * I
- END DO
-
-* Generate the scaled Hilbert matrix in A
- DO J = 1, N
- DO I = 1, N
- A(I, J) = DBLE(M) / (I + J - 1)
- END DO
- END DO
-
-* Generate matrix B as simply the first NRHS columns of M * the
-* identity.
- TMP = DBLE(M)
- CALL DLASET('Full', N, NRHS, 0.0D+0, TMP, B, LDB)
-
-* Generate the true solutions in X. Because B = the first NRHS
-* columns of M*I, the true solutions are just the first NRHS columns
-* of the inverse Hilbert matrix.
- WORK(1) = N
- DO J = 2, N
- WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) )
- $ * (N +J -1)
- END DO
-
- DO J = 1, NRHS
- DO I = 1, N
- X(I, J) = (WORK(I)*WORK(J)) / (I + J - 1)
- END DO
- END DO
-
- END
-
diff --git a/netlib/LAPACK/dlahqr.f b/netlib/LAPACK/dlahqr.f
deleted file mode 100644
index 9da6b0f..0000000
--- a/netlib/LAPACK/dlahqr.f
+++ /dev/null
@@ -1,611 +0,0 @@
-*> \brief \b DLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAHQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlahqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlahqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlahqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAHQR is an auxiliary routine called by DHSEQR to update the
-*> eigenvalues and Schur decomposition already computed by DHSEQR, by
-*> dealing with the Hessenberg submatrix in rows and columns ILO to
-*> IHI.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper quasi-triangular in
-*> rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-*> ILO = 1). DLAHQR works primarily with the Hessenberg
-*> submatrix in rows and columns ILO to IHI, but applies
-*> transformations to all of H if WANTT is .TRUE..
-*> 1 <= ILO <= max(1,IHI); IHI <= N.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO is zero and if WANTT is .TRUE., H is upper
-*> quasi-triangular in rows and columns ILO:IHI, with any
-*> 2-by-2 diagonal blocks in standard form. If INFO is zero
-*> and WANTT is .FALSE., the contents of H are unspecified on
-*> exit. The output state of H if INFO is nonzero is given
-*> below under the description of INFO.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues ILO to IHI are stored in the corresponding
-*> elements of WR and WI. If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-*> eigenvalues are stored in the same order as on the diagonal
-*> of the Schur form returned in H, with WR(i) = H(i,i), and, if
-*> H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-*> WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> If WANTZ is .TRUE., on entry Z must contain the current
-*> matrix Z of transformations accumulated by DHSEQR, and on
-*> exit Z has been updated; transformations are applied only to
-*> the submatrix Z(ILOZ:IHIZ,ILO:IHI).
-*> If WANTZ is .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: If INFO = i, DLAHQR failed to compute all the
-*> eigenvalues ILO to IHI in a total of 30 iterations
-*> per eigenvalue; elements i+1:ihi of WR and WI
-*> contain those eigenvalues which have been
-*> successfully computed.
-*>
-*> If INFO .GT. 0 and WANTT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the
-*> eigenvalues of the upper Hessenberg matrix rows
-*> and columns ILO thorugh INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*> (*) (initial value of H)*U = U*(final value of H)
-*> where U is an orthognal matrix. The final
-*> value of H is upper Hessenberg and triangular in
-*> rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*> (final value of Z) = (initial value of Z)*U
-*> where U is the orthogonal matrix in (*)
-*> (regardless of the value of WANTT.)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> 02-96 Based on modifications by
-*> David Day, Sandia National Laboratory, USA
-*>
-*> 12-04 Further modifications by
-*> Ralph Byers, University of Kansas, USA
-*> This is a modified version of DLAHQR from LAPACK version 3.0.
-*> It is (1) more robust against overflow and underflow and
-*> (2) adopts the more conservative Ahues & Tisseur stopping
-*> criterion (LAWN 122, 1997).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-* ..
-*
-* =========================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 30 )
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0, TWO = 2.0d0 )
- DOUBLE PRECISION DAT1, DAT2
- PARAMETER ( DAT1 = 3.0d0 / 4.0d0, DAT2 = -0.4375d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S,
- $ H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX,
- $ SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST,
- $ ULP, V2, V3
- INTEGER I, I1, I2, ITS, J, K, L, M, NH, NR, NZ
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION V( 3 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLABAD, DLANV2, DLARFG, DROT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( ILO.EQ.IHI ) THEN
- WR( ILO ) = H( ILO, ILO )
- WI( ILO ) = ZERO
- RETURN
- END IF
-*
-* ==== clear out the trash ====
- DO 10 J = ILO, IHI - 3
- H( J+2, J ) = ZERO
- H( J+3, J ) = ZERO
- 10 CONTINUE
- IF( ILO.LE.IHI-2 )
- $ H( IHI, IHI-2 ) = ZERO
-*
- NH = IHI - ILO + 1
- NZ = IHIZ - ILOZ + 1
-*
-* Set machine-dependent constants for the stopping criterion.
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( NH ) / ULP )
-*
-* I1 and I2 are the indices of the first row and last column of H
-* to which transformations must be applied. If eigenvalues only are
-* being computed, I1 and I2 are set inside the main loop.
-*
- IF( WANTT ) THEN
- I1 = 1
- I2 = N
- END IF
-*
-* The main loop begins here. I is the loop index and decreases from
-* IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-* with the active submatrix in rows and columns L to I.
-* Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-* H(L,L-1) is negligible so that the matrix splits.
-*
- I = IHI
- 20 CONTINUE
- L = ILO
- IF( I.LT.ILO )
- $ GO TO 160
-*
-* Perform QR iterations on rows and columns ILO to I until a
-* submatrix of order 1 or 2 splits off at the bottom because a
-* subdiagonal element has become negligible.
-*
- DO 140 ITS = 0, ITMAX
-*
-* Look for a single small subdiagonal element.
-*
- DO 30 K = I, L + 1, -1
- IF( ABS( H( K, K-1 ) ).LE.SMLNUM )
- $ GO TO 40
- TST = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) )
- IF( TST.EQ.ZERO ) THEN
- IF( K-2.GE.ILO )
- $ TST = TST + ABS( H( K-1, K-2 ) )
- IF( K+1.LE.IHI )
- $ TST = TST + ABS( H( K+1, K ) )
- END IF
-* ==== The following is a conservative small subdiagonal
-* . deflation criterion due to Ahues & Tisseur (LAWN 122,
-* . 1997). It has better mathematical foundation and
-* . improves accuracy in some cases. ====
- IF( ABS( H( K, K-1 ) ).LE.ULP*TST ) THEN
- AB = MAX( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
- BA = MIN( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
- AA = MAX( ABS( H( K, K ) ),
- $ ABS( H( K-1, K-1 )-H( K, K ) ) )
- BB = MIN( ABS( H( K, K ) ),
- $ ABS( H( K-1, K-1 )-H( K, K ) ) )
- S = AA + AB
- IF( BA*( AB / S ).LE.MAX( SMLNUM,
- $ ULP*( BB*( AA / S ) ) ) )GO TO 40
- END IF
- 30 CONTINUE
- 40 CONTINUE
- L = K
- IF( L.GT.ILO ) THEN
-*
-* H(L,L-1) is negligible
-*
- H( L, L-1 ) = ZERO
- END IF
-*
-* Exit from loop if a submatrix of order 1 or 2 has split off.
-*
- IF( L.GE.I-1 )
- $ GO TO 150
-*
-* Now the active submatrix is in rows and columns L to I. If
-* eigenvalues only are being computed, only the active submatrix
-* need be transformed.
-*
- IF( .NOT.WANTT ) THEN
- I1 = L
- I2 = I
- END IF
-*
- IF( ITS.EQ.10 ) THEN
-*
-* Exceptional shift.
-*
- S = ABS( H( L+1, L ) ) + ABS( H( L+2, L+1 ) )
- H11 = DAT1*S + H( L, L )
- H12 = DAT2*S
- H21 = S
- H22 = H11
- ELSE IF( ITS.EQ.20 ) THEN
-*
-* Exceptional shift.
-*
- S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- H11 = DAT1*S + H( I, I )
- H12 = DAT2*S
- H21 = S
- H22 = H11
- ELSE
-*
-* Prepare to use Francis' double shift
-* (i.e. 2nd degree generalized Rayleigh quotient)
-*
- H11 = H( I-1, I-1 )
- H21 = H( I, I-1 )
- H12 = H( I-1, I )
- H22 = H( I, I )
- END IF
- S = ABS( H11 ) + ABS( H12 ) + ABS( H21 ) + ABS( H22 )
- IF( S.EQ.ZERO ) THEN
- RT1R = ZERO
- RT1I = ZERO
- RT2R = ZERO
- RT2I = ZERO
- ELSE
- H11 = H11 / S
- H21 = H21 / S
- H12 = H12 / S
- H22 = H22 / S
- TR = ( H11+H22 ) / TWO
- DET = ( H11-TR )*( H22-TR ) - H12*H21
- RTDISC = SQRT( ABS( DET ) )
- IF( DET.GE.ZERO ) THEN
-*
-* ==== complex conjugate shifts ====
-*
- RT1R = TR*S
- RT2R = RT1R
- RT1I = RTDISC*S
- RT2I = -RT1I
- ELSE
-*
-* ==== real shifts (use only one of them) ====
-*
- RT1R = TR + RTDISC
- RT2R = TR - RTDISC
- IF( ABS( RT1R-H22 ).LE.ABS( RT2R-H22 ) ) THEN
- RT1R = RT1R*S
- RT2R = RT1R
- ELSE
- RT2R = RT2R*S
- RT1R = RT2R
- END IF
- RT1I = ZERO
- RT2I = ZERO
- END IF
- END IF
-*
-* Look for two consecutive small subdiagonal elements.
-*
- DO 50 M = I - 2, L, -1
-* Determine the effect of starting the double-shift QR
-* iteration at row M, and see if this would make H(M,M-1)
-* negligible. (The following uses scaling to avoid
-* overflows and most underflows.)
-*
- H21S = H( M+1, M )
- S = ABS( H( M, M )-RT2R ) + ABS( RT2I ) + ABS( H21S )
- H21S = H( M+1, M ) / S
- V( 1 ) = H21S*H( M, M+1 ) + ( H( M, M )-RT1R )*
- $ ( ( H( M, M )-RT2R ) / S ) - RT1I*( RT2I / S )
- V( 2 ) = H21S*( H( M, M )+H( M+1, M+1 )-RT1R-RT2R )
- V( 3 ) = H21S*H( M+2, M+1 )
- S = ABS( V( 1 ) ) + ABS( V( 2 ) ) + ABS( V( 3 ) )
- V( 1 ) = V( 1 ) / S
- V( 2 ) = V( 2 ) / S
- V( 3 ) = V( 3 ) / S
- IF( M.EQ.L )
- $ GO TO 60
- IF( ABS( H( M, M-1 ) )*( ABS( V( 2 ) )+ABS( V( 3 ) ) ).LE.
- $ ULP*ABS( V( 1 ) )*( ABS( H( M-1, M-1 ) )+ABS( H( M,
- $ M ) )+ABS( H( M+1, M+1 ) ) ) )GO TO 60
- 50 CONTINUE
- 60 CONTINUE
-*
-* Double-shift QR step
-*
- DO 130 K = M, I - 1
-*
-* The first iteration of this loop determines a reflection G
-* from the vector V and applies it from left and right to H,
-* thus creating a nonzero bulge below the subdiagonal.
-*
-* Each subsequent iteration determines a reflection G to
-* restore the Hessenberg form in the (K-1)th column, and thus
-* chases the bulge one step toward the bottom of the active
-* submatrix. NR is the order of G.
-*
- NR = MIN( 3, I-K+1 )
- IF( K.GT.M )
- $ CALL DCOPY( NR, H( K, K-1 ), 1, V, 1 )
- CALL DLARFG( NR, V( 1 ), V( 2 ), 1, T1 )
- IF( K.GT.M ) THEN
- H( K, K-1 ) = V( 1 )
- H( K+1, K-1 ) = ZERO
- IF( K.LT.I-1 )
- $ H( K+2, K-1 ) = ZERO
- ELSE IF( M.GT.L ) THEN
-* ==== Use the following instead of
-* . H( K, K-1 ) = -H( K, K-1 ) to
-* . avoid a bug when v(2) and v(3)
-* . underflow. ====
- H( K, K-1 ) = H( K, K-1 )*( ONE-T1 )
- END IF
- V2 = V( 2 )
- T2 = T1*V2
- IF( NR.EQ.3 ) THEN
- V3 = V( 3 )
- T3 = T1*V3
-*
-* Apply G from the left to transform the rows of the matrix
-* in columns K to I2.
-*
- DO 70 J = K, I2
- SUM = H( K, J ) + V2*H( K+1, J ) + V3*H( K+2, J )
- H( K, J ) = H( K, J ) - SUM*T1
- H( K+1, J ) = H( K+1, J ) - SUM*T2
- H( K+2, J ) = H( K+2, J ) - SUM*T3
- 70 CONTINUE
-*
-* Apply G from the right to transform the columns of the
-* matrix in rows I1 to min(K+3,I).
-*
- DO 80 J = I1, MIN( K+3, I )
- SUM = H( J, K ) + V2*H( J, K+1 ) + V3*H( J, K+2 )
- H( J, K ) = H( J, K ) - SUM*T1
- H( J, K+1 ) = H( J, K+1 ) - SUM*T2
- H( J, K+2 ) = H( J, K+2 ) - SUM*T3
- 80 CONTINUE
-*
- IF( WANTZ ) THEN
-*
-* Accumulate transformations in the matrix Z
-*
- DO 90 J = ILOZ, IHIZ
- SUM = Z( J, K ) + V2*Z( J, K+1 ) + V3*Z( J, K+2 )
- Z( J, K ) = Z( J, K ) - SUM*T1
- Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
- Z( J, K+2 ) = Z( J, K+2 ) - SUM*T3
- 90 CONTINUE
- END IF
- ELSE IF( NR.EQ.2 ) THEN
-*
-* Apply G from the left to transform the rows of the matrix
-* in columns K to I2.
-*
- DO 100 J = K, I2
- SUM = H( K, J ) + V2*H( K+1, J )
- H( K, J ) = H( K, J ) - SUM*T1
- H( K+1, J ) = H( K+1, J ) - SUM*T2
- 100 CONTINUE
-*
-* Apply G from the right to transform the columns of the
-* matrix in rows I1 to min(K+3,I).
-*
- DO 110 J = I1, I
- SUM = H( J, K ) + V2*H( J, K+1 )
- H( J, K ) = H( J, K ) - SUM*T1
- H( J, K+1 ) = H( J, K+1 ) - SUM*T2
- 110 CONTINUE
-*
- IF( WANTZ ) THEN
-*
-* Accumulate transformations in the matrix Z
-*
- DO 120 J = ILOZ, IHIZ
- SUM = Z( J, K ) + V2*Z( J, K+1 )
- Z( J, K ) = Z( J, K ) - SUM*T1
- Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
- 120 CONTINUE
- END IF
- END IF
- 130 CONTINUE
-*
- 140 CONTINUE
-*
-* Failure to converge in remaining number of iterations
-*
- INFO = I
- RETURN
-*
- 150 CONTINUE
-*
- IF( L.EQ.I ) THEN
-*
-* H(I,I-1) is negligible: one eigenvalue has converged.
-*
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- ELSE IF( L.EQ.I-1 ) THEN
-*
-* H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
-*
-* Transform the 2-by-2 submatrix to standard Schur form,
-* and compute and store the eigenvalues.
-*
- CALL DLANV2( H( I-1, I-1 ), H( I-1, I ), H( I, I-1 ),
- $ H( I, I ), WR( I-1 ), WI( I-1 ), WR( I ), WI( I ),
- $ CS, SN )
-*
- IF( WANTT ) THEN
-*
-* Apply the transformation to the rest of H.
-*
- IF( I2.GT.I )
- $ CALL DROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH,
- $ CS, SN )
- CALL DROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN )
- END IF
- IF( WANTZ ) THEN
-*
-* Apply the transformation to Z.
-*
- CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN )
- END IF
- END IF
-*
-* return to start of the main loop with new value of I.
-*
- I = L - 1
- GO TO 20
-*
- 160 CONTINUE
- RETURN
-*
-* End of DLAHQR
-*
- END
diff --git a/netlib/LAPACK/dlahr2.f b/netlib/LAPACK/dlahr2.f
deleted file mode 100644
index 9d15979..0000000
--- a/netlib/LAPACK/dlahr2.f
+++ /dev/null
@@ -1,326 +0,0 @@
-*> \brief \b DLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAHR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlahr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlahr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlahr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ),
-* $ Y( LDY, NB )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
-*> matrix A so that elements below the k-th subdiagonal are zero. The
-*> reduction is performed by an orthogonal similarity transformation
-*> Q**T * A * Q. The routine returns the matrices V and T which determine
-*> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T.
-*>
-*> This is an auxiliary routine called by DGEHRD.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The offset for the reduction. Elements below the k-th
-*> subdiagonal in the first NB columns are reduced to zero.
-*> K < N.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N-K+1)
-*> On entry, the n-by-(n-k+1) general matrix A.
-*> On exit, the elements on and above the k-th subdiagonal in
-*> the first NB columns are overwritten with the corresponding
-*> elements of the reduced matrix; the elements below the k-th
-*> subdiagonal, with the array TAU, represent the matrix Q as a
-*> product of elementary reflectors. The other columns of A are
-*> unchanged. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (NB)
-*> The scalar factors of the elementary reflectors. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NB)
-*> The upper triangular matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (LDY,NB)
-*> The n-by-nb matrix Y.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of nb elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*> A(i+k+1:n,i), and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*> V which is needed, with T and Y, to apply the transformation to the
-*> unreduced part of the matrix, using an update of the form:
-*> A := (I - V*T*V**T) * (A - Y*V**T).
-*>
-*> The contents of A on exit are illustrated by the following example
-*> with n = 7, k = 3 and nb = 2:
-*>
-*> ( a a a a a )
-*> ( a a a a a )
-*> ( a a a a a )
-*> ( h h a a a )
-*> ( v1 h a a a )
-*> ( v1 v2 a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*>
-*> This subroutine is a slight modification of LAPACK-3.0's DLAHRD
-*> incorporating improvements proposed by Quintana-Orti and Van de
-*> Gejin. Note that the entries of A(1:K,2:NB) differ from those
-*> returned by the original LAPACK-3.0's DLAHRD routine. (This
-*> subroutine is not backward compatible with LAPACK-3.0's DLAHRD.)
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> Gregorio Quintana-Orti and Robert van de Geijn, "Improving the
-*> performance of reduction to Hessenberg form," ACM Transactions on
-*> Mathematical Software, 32(2):180-194, June 2006.
-*>
-* =====================================================================
- SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ),
- $ Y( LDY, NB )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0,
- $ ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION EI
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMM, DGEMV, DLACPY,
- $ DLARFG, DSCAL, DTRMM, DTRMV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, NB
- IF( I.GT.1 ) THEN
-*
-* Update A(K+1:N,I)
-*
-* Update I-th column of A - Y * V**T
-*
- CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY,
- $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 )
-*
-* Apply I - V * T**T * V**T to this column (call it b) from the
-* left, using the last column of T as workspace
-*
-* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
-* ( V2 ) ( b2 )
-*
-* where V1 is unit lower triangular
-*
-* 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 )
-*
-* w := w + V2**T * b2
-*
- CALL DGEMV( 'Transpose', N-K-I+1, I-1,
- $ ONE, A( K+I, 1 ),
- $ LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-* w := T**T * w
-*
- 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 )
-*
-* b1 := b1 - V1*w
-*
- CALL DTRMV( 'Lower', 'NO TRANSPOSE',
- $ 'UNIT', I-1,
- $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
- CALL DAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
- A( K+I-1, I-1 ) = EI
- END IF
-*
-* Generate the elementary reflector H(I) to annihilate
-* A(K+I+1:N,I)
-*
- CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
- $ TAU( I ) )
- EI = A( K+I, I )
- A( K+I, I ) = ONE
-*
-* Compute Y(K+1:N,I)
-*
- CALL DGEMV( 'NO TRANSPOSE', N-K, N-K-I+1,
- $ ONE, A( K+1, I+1 ),
- $ LDA, A( K+I, I ), 1, ZERO, Y( K+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-K, I-1, -ONE,
- $ Y( K+1, 1 ), LDY,
- $ T( 1, I ), 1, ONE, Y( K+1, I ), 1 )
- CALL DSCAL( N-K, TAU( I ), Y( K+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 )
- T( I, I ) = TAU( I )
-*
- 10 CONTINUE
- A( K+NB, NB ) = EI
-*
-* Compute Y(1:K,1:NB)
-*
- CALL DLACPY( 'ALL', K, NB, A( 1, 2 ), LDA, Y, LDY )
- CALL DTRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE',
- $ 'UNIT', K, NB,
- $ ONE, A( K+1, 1 ), LDA, Y, LDY )
- IF( N.GT.K+NB )
- $ CALL DGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K,
- $ NB, N-K-NB, ONE,
- $ A( 1, 2+NB ), LDA, A( K+1+NB, 1 ), LDA, ONE, Y,
- $ LDY )
- CALL DTRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE',
- $ 'NON-UNIT', K, NB,
- $ ONE, T, LDT, Y, LDY )
-*
- RETURN
-*
-* End of DLAHR2
-*
- END
diff --git a/netlib/LAPACK/dlahrd.f b/netlib/LAPACK/dlahrd.f
deleted file mode 100644
index 77e123b..0000000
--- a/netlib/LAPACK/dlahrd.f
+++ /dev/null
@@ -1,288 +0,0 @@
-*> \brief \b DLAHRD reduces the first nb columns of a general rectangular matrix A so that elements below the k-th subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A.
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlahrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlahrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ),
-* $ Y( LDY, NB )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
-*> matrix A so that elements below the k-th subdiagonal are zero. The
-*> reduction is performed by an orthogonal similarity transformation
-*> Q**T * A * Q. The routine returns the matrices V and T which determine
-*> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T.
-*>
-*> This is an OBSOLETE auxiliary routine.
-*> This routine will be 'deprecated' in a future release.
-*> Please use the new routine DLAHR2 instead.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The offset for the reduction. Elements below the k-th
-*> subdiagonal in the first NB columns are reduced to zero.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N-K+1)
-*> On entry, the n-by-(n-k+1) general matrix A.
-*> On exit, the elements on and above the k-th subdiagonal in
-*> the first NB columns are overwritten with the corresponding
-*> elements of the reduced matrix; the elements below the k-th
-*> subdiagonal, with the array TAU, represent the matrix Q as a
-*> product of elementary reflectors. The other columns of A are
-*> unchanged. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (NB)
-*> The scalar factors of the elementary reflectors. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NB)
-*> The upper triangular matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (LDY,NB)
-*> The n-by-nb matrix Y.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of nb elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*> A(i+k+1:n,i), and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*> V which is needed, with T and Y, to apply the transformation to the
-*> unreduced part of the matrix, using an update of the form:
-*> A := (I - V*T*V**T) * (A - Y*V**T).
-*>
-*> The contents of A on exit are illustrated by the following example
-*> with n = 7, k = 3 and nb = 2:
-*>
-*> ( a h a a a )
-*> ( a h a a a )
-*> ( a h a a a )
-*> ( h h a a a )
-*> ( v1 h a a a )
-*> ( v1 v2 a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ),
- $ Y( LDY, NB )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION EI
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DLARFG, DSCAL, DTRMV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, NB
- IF( I.GT.1 ) THEN
-*
-* Update A(1:n,i)
-*
-* Compute i-th column of A - Y * V**T
-*
- CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY,
- $ A( K+I-1, 1 ), LDA, ONE, A( 1, I ), 1 )
-*
-* Apply I - V * T**T * V**T to this column (call it b) from the
-* left, using the last column of T as workspace
-*
-* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
-* ( V2 ) ( b2 )
-*
-* where V1 is unit lower triangular
-*
-* 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 )
-*
-* w := w + V2**T *b2
-*
- CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ),
- $ LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-* w := T**T *w
-*
- 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 )
-*
-* b1 := b1 - V1*w
-*
- CALL DTRMV( 'Lower', 'No transpose', 'Unit', I-1,
- $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
- CALL DAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
- A( K+I-1, I-1 ) = EI
- END IF
-*
-* Generate the elementary reflector H(i) to annihilate
-* A(k+i+1:n,i)
-*
- CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
- $ TAU( I ) )
- EI = A( K+I, I )
- A( K+I, I ) = ONE
-*
-* 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 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 )
- T( I, I ) = TAU( I )
-*
- 10 CONTINUE
- A( K+NB, NB ) = EI
-*
- RETURN
-*
-* End of DLAHRD
-*
- END
diff --git a/netlib/LAPACK/dlaic1.f b/netlib/LAPACK/dlaic1.f
deleted file mode 100644
index e5841c3..0000000
--- a/netlib/LAPACK/dlaic1.f
+++ /dev/null
@@ -1,367 +0,0 @@
-*> \brief \b DLAIC1 applies one step of incremental condition estimation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAIC1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaic1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaic1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaic1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
-*
-* .. Scalar Arguments ..
-* INTEGER J, JOB
-* DOUBLE PRECISION C, GAMMA, S, SEST, SESTPR
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION W( J ), X( J )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAIC1 applies one step of incremental condition estimation in
-*> its simplest version:
-*>
-*> Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
-*> lower triangular matrix L, such that
-*> twonorm(L*x) = sest
-*> Then DLAIC1 computes sestpr, s, c such that
-*> the vector
-*> [ s*x ]
-*> xhat = [ c ]
-*> is an approximate singular vector of
-*> [ L 0 ]
-*> Lhat = [ w**T gamma ]
-*> in the sense that
-*> twonorm(Lhat*xhat) = sestpr.
-*>
-*> Depending on JOB, an estimate for the largest or smallest singular
-*> value is computed.
-*>
-*> Note that [s c]**T and sestpr**2 is an eigenpair of the system
-*>
-*> diag(sest*sest, 0) + [alpha gamma] * [ alpha ]
-*> [ gamma ]
-*>
-*> where alpha = x**T*w.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is INTEGER
-*> = 1: an estimate for the largest singular value is computed.
-*> = 2: an estimate for the smallest singular value is computed.
-*> \endverbatim
-*>
-*> \param[in] J
-*> \verbatim
-*> J is INTEGER
-*> Length of X and W
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (J)
-*> The j-vector x.
-*> \endverbatim
-*>
-*> \param[in] SEST
-*> \verbatim
-*> SEST is DOUBLE PRECISION
-*> Estimated singular value of j by j matrix L
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (J)
-*> The j-vector w.
-*> \endverbatim
-*>
-*> \param[in] GAMMA
-*> \verbatim
-*> GAMMA is DOUBLE PRECISION
-*> The diagonal element gamma.
-*> \endverbatim
-*>
-*> \param[out] SESTPR
-*> \verbatim
-*> SESTPR is DOUBLE PRECISION
-*> Estimated singular value of (j+1) by (j+1) matrix Lhat.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION
-*> Sine needed in forming xhat.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> Cosine needed in forming xhat.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER J, JOB
- DOUBLE PRECISION C, GAMMA, S, SEST, SESTPR
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION W( J ), X( J )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
- DOUBLE PRECISION HALF, FOUR
- PARAMETER ( HALF = 0.5D0, FOUR = 4.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ABSALP, ABSEST, ABSGAM, ALPHA, B, COSINE, EPS,
- $ NORMA, S1, S2, SINE, T, TEST, TMP, ZETA1, ZETA2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SIGN, SQRT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DDOT, DLAMCH
- EXTERNAL DDOT, DLAMCH
-* ..
-* .. Executable Statements ..
-*
- EPS = DLAMCH( 'Epsilon' )
- ALPHA = DDOT( J, X, 1, W, 1 )
-*
- ABSALP = ABS( ALPHA )
- ABSGAM = ABS( GAMMA )
- ABSEST = ABS( SEST )
-*
- IF( JOB.EQ.1 ) THEN
-*
-* Estimating largest singular value
-*
-* special cases
-*
- IF( SEST.EQ.ZERO ) THEN
- S1 = MAX( ABSGAM, ABSALP )
- IF( S1.EQ.ZERO ) THEN
- S = ZERO
- C = ONE
- SESTPR = ZERO
- ELSE
- S = ALPHA / S1
- C = GAMMA / S1
- TMP = SQRT( S*S+C*C )
- S = S / TMP
- C = C / TMP
- SESTPR = S1*TMP
- END IF
- RETURN
- ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
- S = ONE
- C = ZERO
- TMP = MAX( ABSEST, ABSALP )
- S1 = ABSEST / TMP
- S2 = ABSALP / TMP
- SESTPR = TMP*SQRT( S1*S1+S2*S2 )
- RETURN
- ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
- S1 = ABSGAM
- S2 = ABSEST
- IF( S1.LE.S2 ) THEN
- S = ONE
- C = ZERO
- SESTPR = S2
- ELSE
- S = ZERO
- C = ONE
- SESTPR = S1
- END IF
- RETURN
- ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
- S1 = ABSGAM
- S2 = ABSALP
- IF( S1.LE.S2 ) THEN
- TMP = S1 / S2
- S = SQRT( ONE+TMP*TMP )
- SESTPR = S2*S
- C = ( GAMMA / S2 ) / S
- S = SIGN( ONE, ALPHA ) / S
- ELSE
- TMP = S2 / S1
- C = SQRT( ONE+TMP*TMP )
- SESTPR = S1*C
- S = ( ALPHA / S1 ) / C
- C = SIGN( ONE, GAMMA ) / C
- END IF
- RETURN
- ELSE
-*
-* normal case
-*
- ZETA1 = ALPHA / ABSEST
- ZETA2 = GAMMA / ABSEST
-*
- B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
- C = ZETA1*ZETA1
- IF( B.GT.ZERO ) THEN
- T = C / ( B+SQRT( B*B+C ) )
- ELSE
- T = SQRT( B*B+C ) - B
- END IF
-*
- SINE = -ZETA1 / T
- COSINE = -ZETA2 / ( ONE+T )
- TMP = SQRT( SINE*SINE+COSINE*COSINE )
- S = SINE / TMP
- C = COSINE / TMP
- SESTPR = SQRT( T+ONE )*ABSEST
- RETURN
- END IF
-*
- ELSE IF( JOB.EQ.2 ) THEN
-*
-* Estimating smallest singular value
-*
-* special cases
-*
- IF( SEST.EQ.ZERO ) THEN
- SESTPR = ZERO
- IF( MAX( ABSGAM, ABSALP ).EQ.ZERO ) THEN
- SINE = ONE
- COSINE = ZERO
- ELSE
- SINE = -GAMMA
- COSINE = ALPHA
- END IF
- S1 = MAX( ABS( SINE ), ABS( COSINE ) )
- S = SINE / S1
- C = COSINE / S1
- TMP = SQRT( S*S+C*C )
- S = S / TMP
- C = C / TMP
- RETURN
- ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
- S = ZERO
- C = ONE
- SESTPR = ABSGAM
- RETURN
- ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
- S1 = ABSGAM
- S2 = ABSEST
- IF( S1.LE.S2 ) THEN
- S = ZERO
- C = ONE
- SESTPR = S1
- ELSE
- S = ONE
- C = ZERO
- SESTPR = S2
- END IF
- RETURN
- ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
- S1 = ABSGAM
- S2 = ABSALP
- IF( S1.LE.S2 ) THEN
- TMP = S1 / S2
- C = SQRT( ONE+TMP*TMP )
- SESTPR = ABSEST*( TMP / C )
- S = -( GAMMA / S2 ) / C
- C = SIGN( ONE, ALPHA ) / C
- ELSE
- TMP = S2 / S1
- S = SQRT( ONE+TMP*TMP )
- SESTPR = ABSEST / S
- C = ( ALPHA / S1 ) / S
- S = -SIGN( ONE, GAMMA ) / S
- END IF
- RETURN
- ELSE
-*
-* normal case
-*
- ZETA1 = ALPHA / ABSEST
- ZETA2 = GAMMA / ABSEST
-*
- NORMA = MAX( ONE+ZETA1*ZETA1+ABS( ZETA1*ZETA2 ),
- $ ABS( ZETA1*ZETA2 )+ZETA2*ZETA2 )
-*
-* See if root is closer to zero or to ONE
-*
- TEST = ONE + TWO*( ZETA1-ZETA2 )*( ZETA1+ZETA2 )
- IF( TEST.GE.ZERO ) THEN
-*
-* root is close to zero, compute directly
-*
- B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
- C = ZETA2*ZETA2
- T = C / ( B+SQRT( ABS( B*B-C ) ) )
- SINE = ZETA1 / ( ONE-T )
- COSINE = -ZETA2 / T
- SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
- ELSE
-*
-* root is closer to ONE, shift by that amount
-*
- B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
- C = ZETA1*ZETA1
- IF( B.GE.ZERO ) THEN
- T = -C / ( B+SQRT( B*B+C ) )
- ELSE
- T = B - SQRT( B*B+C )
- END IF
- SINE = -ZETA1 / T
- COSINE = -ZETA2 / ( ONE+T )
- SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
- END IF
- TMP = SQRT( SINE*SINE+COSINE*COSINE )
- S = SINE / TMP
- C = COSINE / TMP
- RETURN
-*
- END IF
- END IF
- RETURN
-*
-* End of DLAIC1
-*
- END
diff --git a/netlib/LAPACK/dlaisnan.f b/netlib/LAPACK/dlaisnan.f
deleted file mode 100644
index 58595c5..0000000
--- a/netlib/LAPACK/dlaisnan.f
+++ /dev/null
@@ -1,91 +0,0 @@
-*> \brief \b DLAISNAN tests input for NaN by comparing two arguments for inequality.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAISNAN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaisnan.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaisnan.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaisnan.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION DIN1, DIN2
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is not for general use. It exists solely to avoid
-*> over-optimization in DISNAN.
-*>
-*> DLAISNAN checks for NaNs by comparing its two arguments for
-*> inequality. NaN is the only floating-point value where NaN != NaN
-*> returns .TRUE. To check for NaNs, pass the same variable as both
-*> arguments.
-*>
-*> A compiler must assume that the two arguments are
-*> not the same variable, and the test will not be optimized away.
-*> Interprocedural or whole-program optimization may delete this
-*> test. The ISNAN functions will be replaced by the correct
-*> Fortran 03 intrinsic once the intrinsic is widely available.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIN1
-*> \verbatim
-*> DIN1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] DIN2
-*> \verbatim
-*> DIN2 is DOUBLE PRECISION
-*> Two numbers to compare for inequality.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION DIN1, DIN2
-* ..
-*
-* =====================================================================
-*
-* .. Executable Statements ..
- DLAISNAN = (DIN1.NE.DIN2)
- RETURN
- END
diff --git a/netlib/LAPACK/dlakf2.f b/netlib/LAPACK/dlakf2.f
deleted file mode 100644
index 01da0bf..0000000
--- a/netlib/LAPACK/dlakf2.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b DLAKF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDZ, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDA, * ), D( LDA, * ),
-* $ E( LDA, * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Form the 2*M*N by 2*M*N matrix
-*>
-*> Z = [ kron(In, A) -kron(B', Im) ]
-*> [ kron(In, D) -kron(E', Im) ],
-*>
-*> where In is the identity matrix of size n and X' is the transpose
-*> of X. kron(X, Y) is the Kronecker product between the matrices X
-*> and Y.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Size of matrix, must be >= 1.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Size of matrix, must be >= 1.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION, dimension ( LDA, M )
-*> The matrix A in the output matrix Z.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A, B, D, and E. ( LDA >= M+N )
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION, dimension ( LDA, N )
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION, dimension ( LDA, M )
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION, dimension ( LDA, N )
-*>
-*> The matrices used in forming the output matrix Z.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION, dimension ( LDZ, 2*M*N )
-*> The resultant Kronecker M*N*2 by M*N*2 matrix (see above.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of Z. ( LDZ >= 2*M*N )
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDZ, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDA, * ), D( LDA, * ),
- $ E( LDA, * ), Z( LDZ, * )
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IK, J, JK, L, MN, MN2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASET
-* ..
-* .. Executable Statements ..
-*
-* Initialize Z
-*
- MN = M*N
- MN2 = 2*MN
- CALL DLASET( 'Full', MN2, MN2, ZERO, ZERO, Z, LDZ )
-*
- IK = 1
- DO 50 L = 1, N
-*
-* form kron(In, A)
-*
- DO 20 I = 1, M
- DO 10 J = 1, M
- Z( IK+I-1, IK+J-1 ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
-*
-* form kron(In, D)
-*
- DO 40 I = 1, M
- DO 30 J = 1, M
- Z( IK+MN+I-1, IK+J-1 ) = D( I, J )
- 30 CONTINUE
- 40 CONTINUE
-*
- IK = IK + M
- 50 CONTINUE
-*
- IK = 1
- DO 90 L = 1, N
- JK = MN + 1
-*
- DO 80 J = 1, N
-*
-* form -kron(B', Im)
-*
- DO 60 I = 1, M
- Z( IK+I-1, JK+I-1 ) = -B( J, L )
- 60 CONTINUE
-*
-* form -kron(E', Im)
-*
- DO 70 I = 1, M
- Z( IK+MN+I-1, JK+I-1 ) = -E( J, L )
- 70 CONTINUE
-*
- JK = JK + M
- 80 CONTINUE
-*
- IK = IK + M
- 90 CONTINUE
-*
- RETURN
-*
-* End of DLAKF2
-*
- END
diff --git a/netlib/LAPACK/dlaln2.f b/netlib/LAPACK/dlaln2.f
deleted file mode 100644
index 23629b7..0000000
--- a/netlib/LAPACK/dlaln2.f
+++ /dev/null
@@ -1,611 +0,0 @@
-*> \brief \b DLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLALN2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaln2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaln2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaln2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
-* LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LTRANS
-* INTEGER INFO, LDA, LDB, LDX, NA, NW
-* DOUBLE PRECISION CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLALN2 solves a system of the form (ca A - w D ) X = s B
-*> or (ca A**T - w D) X = s B with possible scaling ("s") and
-*> perturbation of A. (A**T means A-transpose.)
-*>
-*> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
-*> real diagonal matrix, w is a real or complex value, and X and B are
-*> NA x 1 matrices -- real if w is real, complex if w is complex. NA
-*> may be 1 or 2.
-*>
-*> If w is complex, X and B are represented as NA x 2 matrices,
-*> the first column of each being the real part and the second
-*> being the imaginary part.
-*>
-*> "s" is a scaling factor (.LE. 1), computed by DLALN2, which is
-*> so chosen that X can be computed without overflow. X is further
-*> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
-*> than overflow.
-*>
-*> If both singular values of (ca A - w D) are less than SMIN,
-*> SMIN*identity will be used instead of (ca A - w D). If only one
-*> singular value is less than SMIN, one element of (ca A - w D) will be
-*> perturbed enough to make the smallest singular value roughly SMIN.
-*> If both singular values are at least SMIN, (ca A - w D) will not be
-*> perturbed. In any case, the perturbation will be at most some small
-*> multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
-*> are computed by infinity-norm approximations, and thus will only be
-*> correct to a factor of 2 or so.
-*>
-*> Note: all input quantities are assumed to be smaller than overflow
-*> by a reasonable factor. (See BIGNUM.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRANS
-*> \verbatim
-*> LTRANS is LOGICAL
-*> =.TRUE.: A-transpose will be used.
-*> =.FALSE.: A will be used (not transposed.)
-*> \endverbatim
-*>
-*> \param[in] NA
-*> \verbatim
-*> NA is INTEGER
-*> The size of the matrix A. It may (only) be 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> 1 if "w" is real, 2 if "w" is complex. It may only be 1
-*> or 2.
-*> \endverbatim
-*>
-*> \param[in] SMIN
-*> \verbatim
-*> SMIN is DOUBLE PRECISION
-*> The desired lower bound on the singular values of A. This
-*> should be a safe distance away from underflow or overflow,
-*> say, between (underflow/machine precision) and (machine
-*> precision * overflow ). (See BIGNUM and ULP.)
-*> \endverbatim
-*>
-*> \param[in] CA
-*> \verbatim
-*> CA is DOUBLE PRECISION
-*> The coefficient c, which A is multiplied by.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,NA)
-*> The NA x NA matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[in] D1
-*> \verbatim
-*> D1 is DOUBLE PRECISION
-*> The 1,1 element in the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] D2
-*> \verbatim
-*> D2 is DOUBLE PRECISION
-*> The 2,2 element in the diagonal matrix D. Not used if NW=1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NW)
-*> The NA x NW matrix B (right-hand side). If NW=2 ("w" is
-*> complex), column 1 contains the real part of B and column 2
-*> contains the imaginary part.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[in] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION
-*> The real part of the scalar "w".
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION
-*> The imaginary part of the scalar "w". Not used if NW=1.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NW)
-*> The NA x NW matrix X (unknowns), as computed by DLALN2.
-*> If NW=2 ("w" is complex), on exit, column 1 will contain
-*> the real part of X and column 2 will contain the imaginary
-*> part.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of X. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scale factor that B must be multiplied by to insure
-*> that overflow does not occur when computing X. Thus,
-*> (ca A - w D) X will be SCALE*B, not B (ignoring
-*> perturbations of A.) It will be at most 1.
-*> \endverbatim
-*>
-*> \param[out] XNORM
-*> \verbatim
-*> XNORM is DOUBLE PRECISION
-*> The infinity-norm of X, when X is regarded as an NA x NW
-*> real matrix.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> An error flag. It will be set to zero if no error occurs,
-*> a negative number if an argument is in error, or a positive
-*> number if ca A - w D had to be perturbed.
-*> The possible values are:
-*> = 0: No error occurred, and (ca A - w D) did not have to be
-*> perturbed.
-*> = 1: (ca A - w D) had to be perturbed to make its smallest
-*> (or only) singular value greater than SMIN.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
- $ LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL LTRANS
- INTEGER INFO, LDA, LDB, LDX, NA, NW
- DOUBLE PRECISION CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER ICMAX, J
- DOUBLE PRECISION BBND, BI1, BI2, BIGNUM, BNORM, BR1, BR2, CI21,
- $ CI22, CMAX, CNORM, CR21, CR22, CSI, CSR, LI21,
- $ LR21, SMINI, SMLNUM, TEMP, U22ABS, UI11, UI11R,
- $ UI12, UI12S, UI22, UR11, UR11R, UR12, UR12S,
- $ UR22, XI1, XI2, XR1, XR2
-* ..
-* .. Local Arrays ..
- LOGICAL RSWAP( 4 ), ZSWAP( 4 )
- INTEGER IPIVOT( 4, 4 )
- DOUBLE PRECISION CI( 2, 2 ), CIV( 4 ), CR( 2, 2 ), CRV( 4 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLADIV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Equivalences ..
- EQUIVALENCE ( CI( 1, 1 ), CIV( 1 ) ),
- $ ( CR( 1, 1 ), CRV( 1 ) )
-* ..
-* .. Data statements ..
- DATA ZSWAP / .FALSE., .FALSE., .TRUE., .TRUE. /
- DATA RSWAP / .FALSE., .TRUE., .FALSE., .TRUE. /
- DATA IPIVOT / 1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2, 4,
- $ 3, 2, 1 /
-* ..
-* .. Executable Statements ..
-*
-* Compute BIGNUM
-*
- SMLNUM = TWO*DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- SMINI = MAX( SMIN, SMLNUM )
-*
-* Don't check for input errors
-*
- INFO = 0
-*
-* Standard Initializations
-*
- SCALE = ONE
-*
- IF( NA.EQ.1 ) THEN
-*
-* 1 x 1 (i.e., scalar) system C X = B
-*
- IF( NW.EQ.1 ) THEN
-*
-* Real 1x1 system.
-*
-* C = ca A - w D
-*
- CSR = CA*A( 1, 1 ) - WR*D1
- CNORM = ABS( CSR )
-*
-* If | C | < SMINI, use C = SMINI
-*
- IF( CNORM.LT.SMINI ) THEN
- CSR = SMINI
- CNORM = SMINI
- INFO = 1
- END IF
-*
-* Check scaling for X = B / C
-*
- BNORM = ABS( B( 1, 1 ) )
- IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*CNORM )
- $ SCALE = ONE / BNORM
- END IF
-*
-* Compute X
-*
- X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / CSR
- XNORM = ABS( X( 1, 1 ) )
- ELSE
-*
-* Complex 1x1 system (w is complex)
-*
-* C = ca A - w D
-*
- CSR = CA*A( 1, 1 ) - WR*D1
- CSI = -WI*D1
- CNORM = ABS( CSR ) + ABS( CSI )
-*
-* If | C | < SMINI, use C = SMINI
-*
- IF( CNORM.LT.SMINI ) THEN
- CSR = SMINI
- CSI = ZERO
- CNORM = SMINI
- INFO = 1
- END IF
-*
-* Check scaling for X = B / C
-*
- BNORM = ABS( B( 1, 1 ) ) + ABS( B( 1, 2 ) )
- IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*CNORM )
- $ SCALE = ONE / BNORM
- END IF
-*
-* Compute X
-*
- CALL DLADIV( SCALE*B( 1, 1 ), SCALE*B( 1, 2 ), CSR, CSI,
- $ X( 1, 1 ), X( 1, 2 ) )
- XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- END IF
-*
- ELSE
-*
-* 2x2 System
-*
-* Compute the real part of C = ca A - w D (or ca A**T - w D )
-*
- CR( 1, 1 ) = CA*A( 1, 1 ) - WR*D1
- CR( 2, 2 ) = CA*A( 2, 2 ) - WR*D2
- IF( LTRANS ) THEN
- CR( 1, 2 ) = CA*A( 2, 1 )
- CR( 2, 1 ) = CA*A( 1, 2 )
- ELSE
- CR( 2, 1 ) = CA*A( 2, 1 )
- CR( 1, 2 ) = CA*A( 1, 2 )
- END IF
-*
- IF( NW.EQ.1 ) THEN
-*
-* Real 2x2 system (w is real)
-*
-* Find the largest element in C
-*
- CMAX = ZERO
- ICMAX = 0
-*
- DO 10 J = 1, 4
- IF( ABS( CRV( J ) ).GT.CMAX ) THEN
- CMAX = ABS( CRV( J ) )
- ICMAX = J
- END IF
- 10 CONTINUE
-*
-* If norm(C) < SMINI, use SMINI*identity.
-*
- IF( CMAX.LT.SMINI ) THEN
- BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 2, 1 ) ) )
- IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*SMINI )
- $ SCALE = ONE / BNORM
- END IF
- TEMP = SCALE / SMINI
- X( 1, 1 ) = TEMP*B( 1, 1 )
- X( 2, 1 ) = TEMP*B( 2, 1 )
- XNORM = TEMP*BNORM
- INFO = 1
- RETURN
- END IF
-*
-* Gaussian elimination with complete pivoting.
-*
- UR11 = CRV( ICMAX )
- CR21 = CRV( IPIVOT( 2, ICMAX ) )
- UR12 = CRV( IPIVOT( 3, ICMAX ) )
- CR22 = CRV( IPIVOT( 4, ICMAX ) )
- UR11R = ONE / UR11
- LR21 = UR11R*CR21
- UR22 = CR22 - UR12*LR21
-*
-* If smaller pivot < SMINI, use SMINI
-*
- IF( ABS( UR22 ).LT.SMINI ) THEN
- UR22 = SMINI
- INFO = 1
- END IF
- IF( RSWAP( ICMAX ) ) THEN
- BR1 = B( 2, 1 )
- BR2 = B( 1, 1 )
- ELSE
- BR1 = B( 1, 1 )
- BR2 = B( 2, 1 )
- END IF
- BR2 = BR2 - LR21*BR1
- BBND = MAX( ABS( BR1*( UR22*UR11R ) ), ABS( BR2 ) )
- IF( BBND.GT.ONE .AND. ABS( UR22 ).LT.ONE ) THEN
- IF( BBND.GE.BIGNUM*ABS( UR22 ) )
- $ SCALE = ONE / BBND
- END IF
-*
- XR2 = ( BR2*SCALE ) / UR22
- XR1 = ( SCALE*BR1 )*UR11R - XR2*( UR11R*UR12 )
- IF( ZSWAP( ICMAX ) ) THEN
- X( 1, 1 ) = XR2
- X( 2, 1 ) = XR1
- ELSE
- X( 1, 1 ) = XR1
- X( 2, 1 ) = XR2
- END IF
- XNORM = MAX( ABS( XR1 ), ABS( XR2 ) )
-*
-* Further scaling if norm(A) norm(X) > overflow
-*
- IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
- IF( XNORM.GT.BIGNUM / CMAX ) THEN
- TEMP = CMAX / BIGNUM
- X( 1, 1 ) = TEMP*X( 1, 1 )
- X( 2, 1 ) = TEMP*X( 2, 1 )
- XNORM = TEMP*XNORM
- SCALE = TEMP*SCALE
- END IF
- END IF
- ELSE
-*
-* Complex 2x2 system (w is complex)
-*
-* Find the largest element in C
-*
- CI( 1, 1 ) = -WI*D1
- CI( 2, 1 ) = ZERO
- CI( 1, 2 ) = ZERO
- CI( 2, 2 ) = -WI*D2
- CMAX = ZERO
- ICMAX = 0
-*
- DO 20 J = 1, 4
- IF( ABS( CRV( J ) )+ABS( CIV( J ) ).GT.CMAX ) THEN
- CMAX = ABS( CRV( J ) ) + ABS( CIV( J ) )
- ICMAX = J
- END IF
- 20 CONTINUE
-*
-* If norm(C) < SMINI, use SMINI*identity.
-*
- IF( CMAX.LT.SMINI ) THEN
- BNORM = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
- $ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
- IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*SMINI )
- $ SCALE = ONE / BNORM
- END IF
- TEMP = SCALE / SMINI
- X( 1, 1 ) = TEMP*B( 1, 1 )
- X( 2, 1 ) = TEMP*B( 2, 1 )
- X( 1, 2 ) = TEMP*B( 1, 2 )
- X( 2, 2 ) = TEMP*B( 2, 2 )
- XNORM = TEMP*BNORM
- INFO = 1
- RETURN
- END IF
-*
-* Gaussian elimination with complete pivoting.
-*
- UR11 = CRV( ICMAX )
- UI11 = CIV( ICMAX )
- CR21 = CRV( IPIVOT( 2, ICMAX ) )
- CI21 = CIV( IPIVOT( 2, ICMAX ) )
- UR12 = CRV( IPIVOT( 3, ICMAX ) )
- UI12 = CIV( IPIVOT( 3, ICMAX ) )
- CR22 = CRV( IPIVOT( 4, ICMAX ) )
- CI22 = CIV( IPIVOT( 4, ICMAX ) )
- IF( ICMAX.EQ.1 .OR. ICMAX.EQ.4 ) THEN
-*
-* Code when off-diagonals of pivoted C are real
-*
- IF( ABS( UR11 ).GT.ABS( UI11 ) ) THEN
- TEMP = UI11 / UR11
- UR11R = ONE / ( UR11*( ONE+TEMP**2 ) )
- UI11R = -TEMP*UR11R
- ELSE
- TEMP = UR11 / UI11
- UI11R = -ONE / ( UI11*( ONE+TEMP**2 ) )
- UR11R = -TEMP*UI11R
- END IF
- LR21 = CR21*UR11R
- LI21 = CR21*UI11R
- UR12S = UR12*UR11R
- UI12S = UR12*UI11R
- UR22 = CR22 - UR12*LR21
- UI22 = CI22 - UR12*LI21
- ELSE
-*
-* Code when diagonals of pivoted C are real
-*
- UR11R = ONE / UR11
- UI11R = ZERO
- LR21 = CR21*UR11R
- LI21 = CI21*UR11R
- UR12S = UR12*UR11R
- UI12S = UI12*UR11R
- UR22 = CR22 - UR12*LR21 + UI12*LI21
- UI22 = -UR12*LI21 - UI12*LR21
- END IF
- U22ABS = ABS( UR22 ) + ABS( UI22 )
-*
-* If smaller pivot < SMINI, use SMINI
-*
- IF( U22ABS.LT.SMINI ) THEN
- UR22 = SMINI
- UI22 = ZERO
- INFO = 1
- END IF
- IF( RSWAP( ICMAX ) ) THEN
- BR2 = B( 1, 1 )
- BR1 = B( 2, 1 )
- BI2 = B( 1, 2 )
- BI1 = B( 2, 2 )
- ELSE
- BR1 = B( 1, 1 )
- BR2 = B( 2, 1 )
- BI1 = B( 1, 2 )
- BI2 = B( 2, 2 )
- END IF
- BR2 = BR2 - LR21*BR1 + LI21*BI1
- BI2 = BI2 - LI21*BR1 - LR21*BI1
- BBND = MAX( ( ABS( BR1 )+ABS( BI1 ) )*
- $ ( U22ABS*( ABS( UR11R )+ABS( UI11R ) ) ),
- $ ABS( BR2 )+ABS( BI2 ) )
- IF( BBND.GT.ONE .AND. U22ABS.LT.ONE ) THEN
- IF( BBND.GE.BIGNUM*U22ABS ) THEN
- SCALE = ONE / BBND
- BR1 = SCALE*BR1
- BI1 = SCALE*BI1
- BR2 = SCALE*BR2
- BI2 = SCALE*BI2
- END IF
- END IF
-*
- CALL DLADIV( BR2, BI2, UR22, UI22, XR2, XI2 )
- XR1 = UR11R*BR1 - UI11R*BI1 - UR12S*XR2 + UI12S*XI2
- XI1 = UI11R*BR1 + UR11R*BI1 - UI12S*XR2 - UR12S*XI2
- IF( ZSWAP( ICMAX ) ) THEN
- X( 1, 1 ) = XR2
- X( 2, 1 ) = XR1
- X( 1, 2 ) = XI2
- X( 2, 2 ) = XI1
- ELSE
- X( 1, 1 ) = XR1
- X( 2, 1 ) = XR2
- X( 1, 2 ) = XI1
- X( 2, 2 ) = XI2
- END IF
- XNORM = MAX( ABS( XR1 )+ABS( XI1 ), ABS( XR2 )+ABS( XI2 ) )
-*
-* Further scaling if norm(A) norm(X) > overflow
-*
- IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
- IF( XNORM.GT.BIGNUM / CMAX ) THEN
- TEMP = CMAX / BIGNUM
- X( 1, 1 ) = TEMP*X( 1, 1 )
- X( 2, 1 ) = TEMP*X( 2, 1 )
- X( 1, 2 ) = TEMP*X( 1, 2 )
- X( 2, 2 ) = TEMP*X( 2, 2 )
- XNORM = TEMP*XNORM
- SCALE = TEMP*SCALE
- END IF
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DLALN2
-*
- END
diff --git a/netlib/LAPACK/dlals0.f b/netlib/LAPACK/dlals0.f
deleted file mode 100644
index 5ded3d2..0000000
--- a/netlib/LAPACK/dlals0.f
+++ /dev/null
@@ -1,502 +0,0 @@
-*> \brief \b DLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLALS0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlals0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlals0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlals0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
-* PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
-* POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL,
-* $ LDGNUM, NL, NR, NRHS, SQRE
-* DOUBLE PRECISION C, S
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), PERM( * )
-* DOUBLE PRECISION B( LDB, * ), BX( LDBX, * ), DIFL( * ),
-* $ DIFR( LDGNUM, * ), GIVNUM( LDGNUM, * ),
-* $ POLES( LDGNUM, * ), WORK( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLALS0 applies back the multiplying factors of either the left or the
-*> right singular vector matrix of a diagonal matrix appended by a row
-*> to the right hand side matrix B in solving the least squares problem
-*> using the divide-and-conquer SVD approach.
-*>
-*> For the left singular vector matrix, three types of orthogonal
-*> matrices are involved:
-*>
-*> (1L) Givens rotations: the number of such rotations is GIVPTR; the
-*> pairs of columns/rows they were applied to are stored in GIVCOL;
-*> and the C- and S-values of these rotations are stored in GIVNUM.
-*>
-*> (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
-*> row, and for J=2:N, PERM(J)-th row of B is to be moved to the
-*> J-th row.
-*>
-*> (3L) The left singular vector matrix of the remaining matrix.
-*>
-*> For the right singular vector matrix, four types of orthogonal
-*> matrices are involved:
-*>
-*> (1R) The right singular vector matrix of the remaining matrix.
-*>
-*> (2R) If SQRE = 1, one extra Givens rotation to generate the right
-*> null space.
-*>
-*> (3R) The inverse transformation of (2L).
-*>
-*> (4R) The inverse transformation of (1L).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed in
-*> factored form:
-*> = 0: Left singular vector matrix.
-*> = 1: Right singular vector matrix.
-*> \endverbatim
-*>
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has row dimension N = NL + NR + 1,
-*> and column dimension M = N + SQRE.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of columns of B and BX. NRHS must be at least 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension ( LDB, NRHS )
-*> On input, B contains the right hand sides of the least
-*> squares problem in rows 1 through M. On output, B contains
-*> the solution X in rows 1 through N.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB must be at least
-*> max(1,MAX( M, N ) ).
-*> \endverbatim
-*>
-*> \param[out] BX
-*> \verbatim
-*> BX is DOUBLE PRECISION array, dimension ( LDBX, NRHS )
-*> \endverbatim
-*>
-*> \param[in] LDBX
-*> \verbatim
-*> LDBX is INTEGER
-*> The leading dimension of BX.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( N )
-*> The permutations (from deflation and sorting) applied
-*> to the two blocks.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
-*> Each pair of numbers indicates a pair of rows/columns
-*> involved in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER
-*> The leading dimension of GIVCOL, must be at least N.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
-*> Each number indicates the C or S value used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] LDGNUM
-*> \verbatim
-*> LDGNUM is INTEGER
-*> The leading dimension of arrays DIFR, POLES and
-*> GIVNUM, must be at least K.
-*> \endverbatim
-*>
-*> \param[in] POLES
-*> \verbatim
-*> POLES is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
-*> On entry, POLES(1:K, 1) contains the new singular
-*> values obtained from solving the secular equation, and
-*> POLES(1:K, 2) is an array containing the poles in the secular
-*> equation.
-*> \endverbatim
-*>
-*> \param[in] DIFL
-*> \verbatim
-*> DIFL is DOUBLE PRECISION array, dimension ( K ).
-*> On entry, DIFL(I) is the distance between I-th updated
-*> (undeflated) singular value and the I-th (undeflated) old
-*> singular value.
-*> \endverbatim
-*>
-*> \param[in] DIFR
-*> \verbatim
-*> DIFR is DOUBLE PRECISION array, dimension ( LDGNUM, 2 ).
-*> On entry, DIFR(I, 1) contains the distances between I-th
-*> updated (undeflated) singular value and the I+1-th
-*> (undeflated) old singular value. And DIFR(I, 2) is the
-*> normalizing factor for the I-th right singular vector.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( K )
-*> Contain the components of the deflation-adjusted updating row
-*> vector.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix,
-*> This is the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> C contains garbage if SQRE =0 and the C-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION
-*> S contains garbage if SQRE =0 and the S-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( K )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
- $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
- $ POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL,
- $ LDGNUM, NL, NR, NRHS, SQRE
- DOUBLE PRECISION C, S
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), PERM( * )
- DOUBLE PRECISION B( LDB, * ), BX( LDBX, * ), DIFL( * ),
- $ DIFR( LDGNUM, * ), GIVNUM( LDGNUM, * ),
- $ POLES( LDGNUM, * ), WORK( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO, NEGONE
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0, NEGONE = -1.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, M, N, NLP1
- DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DROT, DSCAL,
- $ XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3, DNRM2
- EXTERNAL DLAMC3, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( NL.LT.1 ) THEN
- INFO = -2
- ELSE IF( NR.LT.1 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- END IF
-*
- N = NL + NR + 1
-*
- IF( NRHS.LT.1 ) THEN
- INFO = -5
- ELSE IF( LDB.LT.N ) THEN
- INFO = -7
- ELSE IF( LDBX.LT.N ) THEN
- INFO = -9
- ELSE IF( GIVPTR.LT.0 ) THEN
- INFO = -11
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -13
- ELSE IF( LDGNUM.LT.N ) THEN
- INFO = -15
- ELSE IF( K.LT.1 ) THEN
- INFO = -20
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLALS0', -INFO )
- RETURN
- END IF
-*
- M = N + SQRE
- NLP1 = NL + 1
-*
- IF( ICOMPQ.EQ.0 ) THEN
-*
-* Apply back orthogonal transformations from the left.
-*
-* Step (1L): apply back the Givens rotations performed.
-*
- DO 10 I = 1, GIVPTR
- CALL DROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB,
- $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ),
- $ GIVNUM( I, 1 ) )
- 10 CONTINUE
-*
-* Step (2L): permute rows of B.
-*
- CALL DCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX )
- DO 20 I = 2, N
- CALL DCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX )
- 20 CONTINUE
-*
-* Step (3L): apply the inverse of the left singular vector
-* matrix to BX.
-*
- IF( K.EQ.1 ) THEN
- CALL DCOPY( NRHS, BX, LDBX, B, LDB )
- IF( Z( 1 ).LT.ZERO ) THEN
- CALL DSCAL( NRHS, NEGONE, B, LDB )
- END IF
- ELSE
- DO 50 J = 1, K
- DIFLJ = DIFL( J )
- DJ = POLES( J, 1 )
- DSIGJ = -POLES( J, 2 )
- IF( J.LT.K ) THEN
- DIFRJ = -DIFR( J, 1 )
- DSIGJP = -POLES( J+1, 2 )
- END IF
- IF( ( Z( J ).EQ.ZERO ) .OR. ( POLES( J, 2 ).EQ.ZERO ) )
- $ THEN
- WORK( J ) = ZERO
- ELSE
- WORK( J ) = -POLES( J, 2 )*Z( J ) / DIFLJ /
- $ ( POLES( J, 2 )+DJ )
- END IF
- DO 30 I = 1, J - 1
- IF( ( Z( I ).EQ.ZERO ) .OR.
- $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = POLES( I, 2 )*Z( I ) /
- $ ( DLAMC3( POLES( I, 2 ), DSIGJ )-
- $ DIFLJ ) / ( POLES( I, 2 )+DJ )
- END IF
- 30 CONTINUE
- DO 40 I = J + 1, K
- IF( ( Z( I ).EQ.ZERO ) .OR.
- $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = POLES( I, 2 )*Z( I ) /
- $ ( DLAMC3( POLES( I, 2 ), DSIGJP )+
- $ DIFRJ ) / ( POLES( I, 2 )+DJ )
- END IF
- 40 CONTINUE
- WORK( 1 ) = NEGONE
- TEMP = DNRM2( K, WORK, 1 )
- CALL DGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO,
- $ B( J, 1 ), LDB )
- CALL DLASCL( 'G', 0, 0, TEMP, ONE, 1, NRHS, B( J, 1 ),
- $ LDB, INFO )
- 50 CONTINUE
- END IF
-*
-* Move the deflated rows of BX to B also.
-*
- IF( K.LT.MAX( M, N ) )
- $ CALL DLACPY( 'A', N-K, NRHS, BX( K+1, 1 ), LDBX,
- $ B( K+1, 1 ), LDB )
- ELSE
-*
-* Apply back the right orthogonal transformations.
-*
-* Step (1R): apply back the new right singular vector matrix
-* to B.
-*
- IF( K.EQ.1 ) THEN
- CALL DCOPY( NRHS, B, LDB, BX, LDBX )
- ELSE
- DO 80 J = 1, K
- DSIGJ = POLES( J, 2 )
- IF( Z( J ).EQ.ZERO ) THEN
- WORK( J ) = ZERO
- ELSE
- WORK( J ) = -Z( J ) / DIFL( J ) /
- $ ( DSIGJ+POLES( J, 1 ) ) / DIFR( J, 2 )
- END IF
- DO 60 I = 1, J - 1
- IF( Z( J ).EQ.ZERO ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I+1,
- $ 2 ) )-DIFR( I, 1 ) ) /
- $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
- END IF
- 60 CONTINUE
- DO 70 I = J + 1, K
- IF( Z( J ).EQ.ZERO ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I,
- $ 2 ) )-DIFL( I ) ) /
- $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
- END IF
- 70 CONTINUE
- CALL DGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO,
- $ BX( J, 1 ), LDBX )
- 80 CONTINUE
- END IF
-*
-* Step (2R): if SQRE = 1, apply back the rotation that is
-* related to the right null space of the subproblem.
-*
- IF( SQRE.EQ.1 ) THEN
- CALL DCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX )
- CALL DROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S )
- END IF
- IF( K.LT.MAX( M, N ) )
- $ CALL DLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ),
- $ LDBX )
-*
-* Step (3R): permute rows of B.
-*
- CALL DCOPY( NRHS, BX( 1, 1 ), LDBX, B( NLP1, 1 ), LDB )
- IF( SQRE.EQ.1 ) THEN
- CALL DCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB )
- END IF
- DO 90 I = 2, N
- CALL DCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB )
- 90 CONTINUE
-*
-* Step (4R): apply back the Givens rotations performed.
-*
- DO 100 I = GIVPTR, 1, -1
- CALL DROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB,
- $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ),
- $ -GIVNUM( I, 1 ) )
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DLALS0
-*
- END
diff --git a/netlib/LAPACK/dlalsa.f b/netlib/LAPACK/dlalsa.f
deleted file mode 100644
index 10de07d..0000000
--- a/netlib/LAPACK/dlalsa.f
+++ /dev/null
@@ -1,495 +0,0 @@
-*> \brief \b DLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLALSA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlalsa.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlalsa.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlalsa.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
-* LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
-* GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
-* $ SMLSIZ
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
-* $ K( * ), PERM( LDGCOL, * )
-* DOUBLE PRECISION B( LDB, * ), BX( LDBX, * ), C( * ),
-* $ DIFL( LDU, * ), DIFR( LDU, * ),
-* $ GIVNUM( LDU, * ), POLES( LDU, * ), S( * ),
-* $ U( LDU, * ), VT( LDU, * ), WORK( * ),
-* $ Z( LDU, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLALSA is an itermediate step in solving the least squares problem
-*> by computing the SVD of the coefficient matrix in compact form (The
-*> singular vectors are computed as products of simple orthorgonal
-*> matrices.).
-*>
-*> If ICOMPQ = 0, DLALSA applies the inverse of the left singular vector
-*> matrix of an upper bidiagonal matrix to the right hand side; and if
-*> ICOMPQ = 1, DLALSA applies the right singular vector matrix to the
-*> right hand side. The singular vector matrices were generated in
-*> compact form by DLALSA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether the left or the right singular vector
-*> matrix is involved.
-*> = 0: Left singular vector matrix
-*> = 1: Right singular vector matrix
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> The maximum size of the subproblems at the bottom of the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The row and column dimensions of the upper bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of columns of B and BX. NRHS must be at least 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension ( LDB, NRHS )
-*> On input, B contains the right hand sides of the least
-*> squares problem in rows 1 through M.
-*> On output, B contains the solution X in rows 1 through N.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B in the calling subprogram.
-*> LDB must be at least max(1,MAX( M, N ) ).
-*> \endverbatim
-*>
-*> \param[out] BX
-*> \verbatim
-*> BX is DOUBLE PRECISION array, dimension ( LDBX, NRHS )
-*> On exit, the result of applying the left or right singular
-*> vector matrix to B.
-*> \endverbatim
-*>
-*> \param[in] LDBX
-*> \verbatim
-*> LDBX is INTEGER
-*> The leading dimension of BX.
-*> \endverbatim
-*>
-*> \param[in] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension ( LDU, SMLSIZ ).
-*> On entry, U contains the left singular vector matrices of all
-*> subproblems at the bottom level.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER, LDU = > N.
-*> The leading dimension of arrays U, VT, DIFL, DIFR,
-*> POLES, GIVNUM, and Z.
-*> \endverbatim
-*>
-*> \param[in] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension ( LDU, SMLSIZ+1 ).
-*> On entry, VT**T contains the right singular vector matrices of
-*> all subproblems at the bottom level.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER array, dimension ( N ).
-*> \endverbatim
-*>
-*> \param[in] DIFL
-*> \verbatim
-*> DIFL is DOUBLE PRECISION array, dimension ( LDU, NLVL ).
-*> where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
-*> \endverbatim
-*>
-*> \param[in] DIFR
-*> \verbatim
-*> DIFR is DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
-*> On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
-*> distances between singular values on the I-th level and
-*> singular values on the (I -1)-th level, and DIFR(*, 2 * I)
-*> record the normalizing factors of the right singular vectors
-*> matrices of subproblems on I-th level.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( LDU, NLVL ).
-*> On entry, Z(1, I) contains the components of the deflation-
-*> adjusted updating row vector for subproblems on the I-th
-*> level.
-*> \endverbatim
-*>
-*> \param[in] POLES
-*> \verbatim
-*> POLES is DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
-*> On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
-*> singular values involved in the secular equations on the I-th
-*> level.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array, dimension ( N ).
-*> On entry, GIVPTR( I ) records the number of Givens
-*> rotations performed on the I-th problem on the computation
-*> tree.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
-*> On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
-*> locations of Givens rotations performed on the I-th level on
-*> the computation tree.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER, LDGCOL = > N.
-*> The leading dimension of arrays GIVCOL and PERM.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( LDGCOL, NLVL ).
-*> On entry, PERM(*, I) records permutations done on the I-th
-*> level of the computation tree.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
-*> On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
-*> values of Givens rotations performed on the I-th level on the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension ( N ).
-*> On entry, if the I-th subproblem is not square,
-*> C( I ) contains the C-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension ( N ).
-*> On entry, if the I-th subproblem is not square,
-*> S( I ) contains the S-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array.
-*> The dimension must be at least N.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array.
-*> The dimension must be at least 3 * N
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
- $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
- $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
- $ SMLSIZ
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
- $ K( * ), PERM( LDGCOL, * )
- DOUBLE PRECISION B( LDB, * ), BX( LDBX, * ), C( * ),
- $ DIFL( LDU, * ), DIFR( LDU, * ),
- $ GIVNUM( LDU, * ), POLES( LDU, * ), S( * ),
- $ U( LDU, * ), VT( LDU, * ), WORK( * ),
- $ Z( LDU, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, IC, IM1, INODE, J, LF, LL, LVL, LVL2,
- $ ND, NDB1, NDIML, NDIMR, NL, NLF, NLP1, NLVL,
- $ NR, NRF, NRP1, SQRE
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DLALS0, DLASDT, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( SMLSIZ.LT.3 ) THEN
- INFO = -2
- ELSE IF( N.LT.SMLSIZ ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.1 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.N ) THEN
- INFO = -6
- ELSE IF( LDBX.LT.N ) THEN
- INFO = -8
- ELSE IF( LDU.LT.N ) THEN
- INFO = -10
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -19
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLALSA', -INFO )
- RETURN
- END IF
-*
-* Book-keeping and setting up the computation tree.
-*
- INODE = 1
- NDIML = INODE + N
- NDIMR = NDIML + N
-*
- CALL DLASDT( N, NLVL, ND, IWORK( INODE ), IWORK( NDIML ),
- $ IWORK( NDIMR ), SMLSIZ )
-*
-* The following code applies back the left singular vector factors.
-* For applying back the right singular vector factors, go to 50.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- GO TO 50
- END IF
-*
-* The nodes on the bottom level of the tree were solved
-* by DLASDQ. The corresponding left and right singular vector
-* matrices are in explicit form. First apply back the left
-* singular vector matrices.
-*
- NDB1 = ( ND+1 ) / 2
- DO 10 I = NDB1, ND
-*
-* IC : center row of each node
-* NL : number of rows of left subproblem
-* NR : number of rows of right subproblem
-* NLF: starting row of the left subproblem
-* NRF: starting row of the right subproblem
-*
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NR = IWORK( NDIMR+I1 )
- NLF = IC - NL
- NRF = IC + 1
- CALL DGEMM( 'T', 'N', NL, NRHS, NL, ONE, U( NLF, 1 ), LDU,
- $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
- CALL DGEMM( 'T', 'N', NR, NRHS, NR, ONE, U( NRF, 1 ), LDU,
- $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
- 10 CONTINUE
-*
-* Next copy the rows of B that correspond to unchanged rows
-* in the bidiagonal matrix to BX.
-*
- DO 20 I = 1, ND
- IC = IWORK( INODE+I-1 )
- CALL DCOPY( NRHS, B( IC, 1 ), LDB, BX( IC, 1 ), LDBX )
- 20 CONTINUE
-*
-* Finally go through the left singular vector matrices of all
-* the other subproblems bottom-up on the tree.
-*
- J = 2**NLVL
- SQRE = 0
-*
- DO 40 LVL = NLVL, 1, -1
- LVL2 = 2*LVL - 1
-*
-* find the first node LF and last node LL on
-* the current level LVL
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 30 I = LF, LL
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- NRF = IC + 1
- J = J - 1
- CALL DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX,
- $ B( NLF, 1 ), LDB, PERM( NLF, LVL ),
- $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
- $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ),
- $ DIFL( NLF, LVL ), DIFR( NLF, LVL2 ),
- $ Z( NLF, LVL ), K( J ), C( J ), S( J ), WORK,
- $ INFO )
- 30 CONTINUE
- 40 CONTINUE
- GO TO 90
-*
-* ICOMPQ = 1: applying back the right singular vector factors.
-*
- 50 CONTINUE
-*
-* First now go through the right singular vector matrices of all
-* the tree nodes top-down.
-*
- J = 0
- DO 70 LVL = 1, NLVL
- LVL2 = 2*LVL - 1
-*
-* Find the first node LF and last node LL on
-* the current level LVL.
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 60 I = LL, LF, -1
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- NRF = IC + 1
- IF( I.EQ.LL ) THEN
- SQRE = 0
- ELSE
- SQRE = 1
- END IF
- J = J + 1
- CALL DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB,
- $ BX( NLF, 1 ), LDBX, PERM( NLF, LVL ),
- $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
- $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ),
- $ DIFL( NLF, LVL ), DIFR( NLF, LVL2 ),
- $ Z( NLF, LVL ), K( J ), C( J ), S( J ), WORK,
- $ INFO )
- 60 CONTINUE
- 70 CONTINUE
-*
-* The nodes on the bottom level of the tree were solved
-* by DLASDQ. The corresponding right singular vector
-* matrices are in explicit form. Apply them back.
-*
- NDB1 = ( ND+1 ) / 2
- DO 80 I = NDB1, ND
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NR = IWORK( NDIMR+I1 )
- NLP1 = NL + 1
- IF( I.EQ.ND ) THEN
- NRP1 = NR
- ELSE
- NRP1 = NR + 1
- END IF
- NLF = IC - NL
- NRF = IC + 1
- CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU,
- $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
- CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU,
- $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
- 80 CONTINUE
-*
- 90 CONTINUE
-*
- RETURN
-*
-* End of DLALSA
-*
- END
diff --git a/netlib/LAPACK/dlalsd.f b/netlib/LAPACK/dlalsd.f
deleted file mode 100644
index 50b4d74..0000000
--- a/netlib/LAPACK/dlalsd.f
+++ /dev/null
@@ -1,523 +0,0 @@
-*> \brief \b DLALSD uses the singular value decomposition of A to solve the least squares problem.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLALSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlalsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlalsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlalsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND,
-* RANK, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS, RANK, SMLSIZ
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION B( LDB, * ), D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLALSD uses the singular value decomposition of A to solve the least
-*> squares problem of finding X to minimize the Euclidean norm of each
-*> column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
-*> are N-by-NRHS. The solution X overwrites B.
-*>
-*> The singular values of A smaller than RCOND times the largest
-*> singular value are treated as zero in solving the least squares
-*> problem; in this case a minimum norm solution is returned.
-*> The actual singular values are returned in D in ascending order.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': D and E define an upper bidiagonal matrix.
-*> = 'L': D and E define a lower bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> The maximum size of the subproblems at the bottom of the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the bidiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of columns of B. NRHS must be at least 1.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry D contains the main diagonal of the bidiagonal
-*> matrix. On exit, if INFO = 0, D contains its singular values.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> Contains the super-diagonal entries of the bidiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On input, B contains the right hand sides of the least
-*> squares problem. On output, B contains the solution X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B in the calling subprogram.
-*> LDB must be at least max(1,N).
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The singular values of A less than or equal to RCOND times
-*> the largest singular value are treated as zero in solving
-*> the least squares problem. If RCOND is negative,
-*> machine precision is used instead.
-*> For example, if diag(S)*X=B were the least squares problem,
-*> where diag(S) is a diagonal matrix of singular values, the
-*> solution would be X(i) = B(i) / S(i) if S(i) is greater than
-*> RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
-*> RCOND*max(S).
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The number of singular values of A greater than RCOND times
-*> the largest singular value.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension at least
-*> (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
-*> where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension at least
-*> (3*N*NLVL + 11*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute a singular value while
-*> working on the submatrix lying in rows and columns
-*> INFO/(N+1) through MOD(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND,
- $ RANK, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS, RANK, SMLSIZ
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION B( LDB, * ), D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER BX, BXST, C, DIFL, DIFR, GIVCOL, GIVNUM,
- $ GIVPTR, I, ICMPQ1, ICMPQ2, IWK, J, K, NLVL,
- $ NM1, NSIZE, NSUB, NWORK, PERM, POLES, S, SIZEI,
- $ SMLSZP, SQRE, ST, ST1, U, VT, Z
- DOUBLE PRECISION CS, EPS, ORGNRM, R, RCND, SN, TOL
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL IDAMAX, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DLACPY, DLALSA, DLARTG, DLASCL,
- $ DLASDA, DLASDQ, DLASET, DLASRT, DROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, LOG, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.1 ) THEN
- INFO = -4
- ELSE IF( ( LDB.LT.1 ) .OR. ( LDB.LT.N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLALSD', -INFO )
- RETURN
- END IF
-*
- EPS = DLAMCH( 'Epsilon' )
-*
-* Set up the tolerance.
-*
- IF( ( RCOND.LE.ZERO ) .OR. ( RCOND.GE.ONE ) ) THEN
- RCND = EPS
- ELSE
- RCND = RCOND
- END IF
-*
- RANK = 0
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- IF( D( 1 ).EQ.ZERO ) THEN
- CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, B, LDB )
- ELSE
- RANK = 1
- CALL DLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO )
- D( 1 ) = ABS( D( 1 ) )
- END IF
- RETURN
- END IF
-*
-* Rotate the matrix if it is lower bidiagonal.
-*
- IF( UPLO.EQ.'L' ) THEN
- DO 10 I = 1, N - 1
- CALL DLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( NRHS.EQ.1 ) THEN
- CALL DROT( 1, B( I, 1 ), 1, B( I+1, 1 ), 1, CS, SN )
- ELSE
- WORK( I*2-1 ) = CS
- WORK( I*2 ) = SN
- END IF
- 10 CONTINUE
- IF( NRHS.GT.1 ) THEN
- DO 30 I = 1, NRHS
- DO 20 J = 1, N - 1
- CS = WORK( J*2-1 )
- SN = WORK( J*2 )
- CALL DROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN )
- 20 CONTINUE
- 30 CONTINUE
- END IF
- END IF
-*
-* Scale.
-*
- NM1 = N - 1
- ORGNRM = DLANST( 'M', N, D, E )
- IF( ORGNRM.EQ.ZERO ) THEN
- CALL DLASET( 'A', N, NRHS, ZERO, ZERO, B, LDB )
- RETURN
- END IF
-*
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, INFO )
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, NM1, 1, E, NM1, INFO )
-*
-* If N is smaller than the minimum divide size SMLSIZ, then solve
-* the problem with another solver.
-*
- IF( N.LE.SMLSIZ ) THEN
- NWORK = 1 + N*N
- CALL DLASET( 'A', N, N, ZERO, ONE, WORK, N )
- CALL DLASDQ( 'U', 0, N, N, 0, NRHS, D, E, WORK, N, WORK, N, B,
- $ LDB, WORK( NWORK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- TOL = RCND*ABS( D( IDAMAX( N, D, 1 ) ) )
- DO 40 I = 1, N
- IF( D( I ).LE.TOL ) THEN
- CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- ELSE
- CALL DLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ),
- $ LDB, INFO )
- RANK = RANK + 1
- END IF
- 40 CONTINUE
- CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, ZERO,
- $ WORK( NWORK ), N )
- CALL DLACPY( 'A', N, NRHS, WORK( NWORK ), N, B, LDB )
-*
-* Unscale.
-*
- CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
- CALL DLASRT( 'D', N, D, INFO )
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, N, NRHS, B, LDB, INFO )
-*
- RETURN
- END IF
-*
-* Book-keeping and setting up some constants.
-*
- NLVL = INT( LOG( DBLE( N ) / DBLE( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1
-*
- SMLSZP = SMLSIZ + 1
-*
- U = 1
- VT = 1 + SMLSIZ*N
- DIFL = VT + SMLSZP*N
- DIFR = DIFL + NLVL*N
- Z = DIFR + NLVL*N*2
- C = Z + NLVL*N
- S = C + N
- POLES = S + N
- GIVNUM = POLES + 2*NLVL*N
- BX = GIVNUM + 2*NLVL*N
- NWORK = BX + N*NRHS
-*
- SIZEI = 1 + N
- K = SIZEI + N
- GIVPTR = K + N
- PERM = GIVPTR + N
- GIVCOL = PERM + NLVL*N
- IWK = GIVCOL + NLVL*N*2
-*
- ST = 1
- SQRE = 0
- ICMPQ1 = 1
- ICMPQ2 = 0
- NSUB = 0
-*
- DO 50 I = 1, N
- IF( ABS( D( I ) ).LT.EPS ) THEN
- D( I ) = SIGN( EPS, D( I ) )
- END IF
- 50 CONTINUE
-*
- DO 60 I = 1, NM1
- IF( ( ABS( E( I ) ).LT.EPS ) .OR. ( I.EQ.NM1 ) ) THEN
- NSUB = NSUB + 1
- IWORK( NSUB ) = ST
-*
-* Subproblem found. First determine its size and then
-* apply divide and conquer on it.
-*
- IF( I.LT.NM1 ) THEN
-*
-* A subproblem with E(I) small for I < NM1.
-*
- NSIZE = I - ST + 1
- IWORK( SIZEI+NSUB-1 ) = NSIZE
- ELSE IF( ABS( E( I ) ).GE.EPS ) THEN
-*
-* A subproblem with E(NM1) not too small but I = NM1.
-*
- NSIZE = N - ST + 1
- IWORK( SIZEI+NSUB-1 ) = NSIZE
- ELSE
-*
-* A subproblem with E(NM1) small. This implies an
-* 1-by-1 subproblem at D(N), which is not solved
-* explicitly.
-*
- NSIZE = I - ST + 1
- IWORK( SIZEI+NSUB-1 ) = NSIZE
- NSUB = NSUB + 1
- IWORK( NSUB ) = N
- IWORK( SIZEI+NSUB-1 ) = 1
- CALL DCOPY( NRHS, B( N, 1 ), LDB, WORK( BX+NM1 ), N )
- END IF
- ST1 = ST - 1
- IF( NSIZE.EQ.1 ) THEN
-*
-* This is a 1-by-1 subproblem and is not solved
-* explicitly.
-*
- CALL DCOPY( NRHS, B( ST, 1 ), LDB, WORK( BX+ST1 ), N )
- ELSE IF( NSIZE.LE.SMLSIZ ) THEN
-*
-* This is a small subproblem and is solved by DLASDQ.
-*
- CALL DLASET( 'A', NSIZE, NSIZE, ZERO, ONE,
- $ WORK( VT+ST1 ), N )
- CALL DLASDQ( 'U', 0, NSIZE, NSIZE, 0, NRHS, D( ST ),
- $ E( ST ), WORK( VT+ST1 ), N, WORK( NWORK ),
- $ N, B( ST, 1 ), LDB, WORK( NWORK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- CALL DLACPY( 'A', NSIZE, NRHS, B( ST, 1 ), LDB,
- $ WORK( BX+ST1 ), N )
- ELSE
-*
-* A large problem. Solve it using divide and conquer.
-*
- CALL DLASDA( ICMPQ1, SMLSIZ, NSIZE, SQRE, D( ST ),
- $ E( ST ), WORK( U+ST1 ), N, WORK( VT+ST1 ),
- $ IWORK( K+ST1 ), WORK( DIFL+ST1 ),
- $ WORK( DIFR+ST1 ), WORK( Z+ST1 ),
- $ WORK( POLES+ST1 ), IWORK( GIVPTR+ST1 ),
- $ IWORK( GIVCOL+ST1 ), N, IWORK( PERM+ST1 ),
- $ WORK( GIVNUM+ST1 ), WORK( C+ST1 ),
- $ WORK( S+ST1 ), WORK( NWORK ), IWORK( IWK ),
- $ INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- BXST = BX + ST1
- CALL DLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, B( ST, 1 ),
- $ LDB, WORK( BXST ), N, WORK( U+ST1 ), N,
- $ WORK( VT+ST1 ), IWORK( K+ST1 ),
- $ WORK( DIFL+ST1 ), WORK( DIFR+ST1 ),
- $ WORK( Z+ST1 ), WORK( POLES+ST1 ),
- $ IWORK( GIVPTR+ST1 ), IWORK( GIVCOL+ST1 ), N,
- $ IWORK( PERM+ST1 ), WORK( GIVNUM+ST1 ),
- $ WORK( C+ST1 ), WORK( S+ST1 ), WORK( NWORK ),
- $ IWORK( IWK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- END IF
- ST = I + 1
- END IF
- 60 CONTINUE
-*
-* Apply the singular values and treat the tiny ones as zero.
-*
- TOL = RCND*ABS( D( IDAMAX( N, D, 1 ) ) )
-*
- DO 70 I = 1, N
-*
-* Some of the elements in D can be negative because 1-by-1
-* subproblems were not solved explicitly.
-*
- IF( ABS( D( I ) ).LE.TOL ) THEN
- CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, WORK( BX+I-1 ), N )
- ELSE
- RANK = RANK + 1
- CALL DLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS,
- $ WORK( BX+I-1 ), N, INFO )
- END IF
- D( I ) = ABS( D( I ) )
- 70 CONTINUE
-*
-* Now apply back the right singular vectors.
-*
- ICMPQ2 = 1
- DO 80 I = 1, NSUB
- ST = IWORK( I )
- ST1 = ST - 1
- NSIZE = IWORK( SIZEI+I-1 )
- BXST = BX + ST1
- IF( NSIZE.EQ.1 ) THEN
- CALL DCOPY( NRHS, WORK( BXST ), N, B( ST, 1 ), LDB )
- ELSE IF( NSIZE.LE.SMLSIZ ) THEN
- CALL DGEMM( 'T', 'N', NSIZE, NRHS, NSIZE, ONE,
- $ WORK( VT+ST1 ), N, WORK( BXST ), N, ZERO,
- $ B( ST, 1 ), LDB )
- ELSE
- CALL DLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N,
- $ B( ST, 1 ), LDB, WORK( U+ST1 ), N,
- $ WORK( VT+ST1 ), IWORK( K+ST1 ),
- $ WORK( DIFL+ST1 ), WORK( DIFR+ST1 ),
- $ WORK( Z+ST1 ), WORK( POLES+ST1 ),
- $ IWORK( GIVPTR+ST1 ), IWORK( GIVCOL+ST1 ), N,
- $ IWORK( PERM+ST1 ), WORK( GIVNUM+ST1 ),
- $ WORK( C+ST1 ), WORK( S+ST1 ), WORK( NWORK ),
- $ IWORK( IWK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- END IF
- 80 CONTINUE
-*
-* Unscale and sort the singular values.
-*
- CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
- CALL DLASRT( 'D', N, D, INFO )
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, N, NRHS, B, LDB, INFO )
-*
- RETURN
-*
-* End of DLALSD
-*
- END
diff --git a/netlib/LAPACK/dlamch.f b/netlib/LAPACK/dlamch.f
deleted file mode 100644
index eb307e5..0000000
--- a/netlib/LAPACK/dlamch.f
+++ /dev/null
@@ -1,189 +0,0 @@
-*> \brief \b DLAMCH
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAMCH determines double precision machine parameters.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] CMACH
-*> \verbatim
-*> Specifies the value to be returned by DLAMCH:
-*> = 'E' or 'e', DLAMCH := eps
-*> = 'S' or 's , DLAMCH := sfmin
-*> = 'B' or 'b', DLAMCH := base
-*> = 'P' or 'p', DLAMCH := eps*base
-*> = 'N' or 'n', DLAMCH := t
-*> = 'R' or 'r', DLAMCH := rnd
-*> = 'M' or 'm', DLAMCH := emin
-*> = 'U' or 'u', DLAMCH := rmin
-*> = 'L' or 'l', DLAMCH := emax
-*> = 'O' or 'o', DLAMCH := rmax
-*> where
-*> eps = relative machine precision
-*> sfmin = safe minimum, such that 1/sfmin does not overflow
-*> base = base of the machine
-*> prec = eps*base
-*> t = number of (base) digits in the mantissa
-*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
-*> emin = minimum exponent before (gradual) underflow
-*> rmin = underflow threshold - base**(emin-1)
-*> emax = largest exponent before overflow
-*> rmax = overflow threshold - (base**emax)*(1-eps)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER CMACH
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
- $ MINEXPONENT, RADIX, TINY
-* ..
-* .. Executable Statements ..
-*
-*
-* Assume rounding, not chopping. Always.
-*
- RND = ONE
-*
- IF( ONE.EQ.RND ) THEN
- EPS = EPSILON(ZERO) * 0.5
- ELSE
- EPS = EPSILON(ZERO)
- END IF
-*
- IF( LSAME( CMACH, 'E' ) ) THEN
- RMACH = EPS
- ELSE IF( LSAME( CMACH, 'S' ) ) THEN
- SFMIN = TINY(ZERO)
- SMALL = ONE / HUGE(ZERO)
- IF( SMALL.GE.SFMIN ) THEN
-*
-* Use SMALL plus a bit, to avoid the possibility of rounding
-* causing overflow when computing 1/sfmin.
-*
- SFMIN = SMALL*( ONE+EPS )
- END IF
- RMACH = SFMIN
- ELSE IF( LSAME( CMACH, 'B' ) ) THEN
- RMACH = RADIX(ZERO)
- ELSE IF( LSAME( CMACH, 'P' ) ) THEN
- RMACH = EPS * RADIX(ZERO)
- ELSE IF( LSAME( CMACH, 'N' ) ) THEN
- RMACH = DIGITS(ZERO)
- ELSE IF( LSAME( CMACH, 'R' ) ) THEN
- RMACH = RND
- ELSE IF( LSAME( CMACH, 'M' ) ) THEN
- RMACH = MINEXPONENT(ZERO)
- ELSE IF( LSAME( CMACH, 'U' ) ) THEN
- RMACH = tiny(zero)
- ELSE IF( LSAME( CMACH, 'L' ) ) THEN
- RMACH = MAXEXPONENT(ZERO)
- ELSE IF( LSAME( CMACH, 'O' ) ) THEN
- RMACH = HUGE(ZERO)
- ELSE
- RMACH = ZERO
- END IF
-*
- DLAMCH = RMACH
- RETURN
-*
-* End of DLAMCH
-*
- END
-************************************************************************
-*> \brief \b DLAMC3
-*> \details
-*> \b Purpose:
-*> \verbatim
-*> DLAMC3 is intended to force A and B to be stored prior to doing
-*> the addition of A and B , for use in situations where optimizers
-*> might hold one of these in a register.
-*> \endverbatim
-*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
-*> \date November 2011
-*> \ingroup auxOTHERauxiliary
-*>
-*> \param[in] A
-*> \verbatim
-*> A is a DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is a DOUBLE PRECISION
-*> The values A and B.
-*> \endverbatim
-*>
- DOUBLE PRECISION FUNCTION DLAMC3( A, B )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2010
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B
-* ..
-* =====================================================================
-*
-* .. Executable Statements ..
-*
- DLAMC3 = A + B
-*
- RETURN
-*
-* End of DLAMC3
-*
- END
-*
-************************************************************************
diff --git a/netlib/LAPACK/dlamrg.f b/netlib/LAPACK/dlamrg.f
deleted file mode 100644
index 7126053..0000000
--- a/netlib/LAPACK/dlamrg.f
+++ /dev/null
@@ -1,171 +0,0 @@
-*> \brief \b DLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAMRG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlamrg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlamrg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlamrg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
-*
-* .. Scalar Arguments ..
-* INTEGER DTRD1, DTRD2, N1, N2
-* ..
-* .. Array Arguments ..
-* INTEGER INDEX( * )
-* DOUBLE PRECISION A( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAMRG will create a permutation list which will merge the elements
-*> of A (which is composed of two independently sorted sets) into a
-*> single set which is sorted in ascending order.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> These arguements contain the respective lengths of the two
-*> sorted lists to be merged.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (N1+N2)
-*> The first N1 elements of A contain a list of numbers which
-*> are sorted in either ascending or descending order. Likewise
-*> for the final N2 elements.
-*> \endverbatim
-*>
-*> \param[in] DTRD1
-*> \verbatim
-*> DTRD1 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] DTRD2
-*> \verbatim
-*> DTRD2 is INTEGER
-*> These are the strides to be taken through the array A.
-*> Allowable strides are 1 and -1. They indicate whether a
-*> subset of A is sorted in ascending (DTRDx = 1) or descending
-*> (DTRDx = -1) order.
-*> \endverbatim
-*>
-*> \param[out] INDEX
-*> \verbatim
-*> INDEX is INTEGER array, dimension (N1+N2)
-*> On exit this array will contain a permutation such that
-*> if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
-*> sorted in ascending order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER DTRD1, DTRD2, N1, N2
-* ..
-* .. Array Arguments ..
- INTEGER INDEX( * )
- DOUBLE PRECISION A( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IND1, IND2, N1SV, N2SV
-* ..
-* .. Executable Statements ..
-*
- N1SV = N1
- N2SV = N2
- IF( DTRD1.GT.0 ) THEN
- IND1 = 1
- ELSE
- IND1 = N1
- END IF
- IF( DTRD2.GT.0 ) THEN
- IND2 = 1 + N1
- ELSE
- IND2 = N1 + N2
- END IF
- I = 1
-* while ( (N1SV > 0) & (N2SV > 0) )
- 10 CONTINUE
- IF( N1SV.GT.0 .AND. N2SV.GT.0 ) THEN
- IF( A( IND1 ).LE.A( IND2 ) ) THEN
- INDEX( I ) = IND1
- I = I + 1
- IND1 = IND1 + DTRD1
- N1SV = N1SV - 1
- ELSE
- INDEX( I ) = IND2
- I = I + 1
- IND2 = IND2 + DTRD2
- N2SV = N2SV - 1
- END IF
- GO TO 10
- END IF
-* end while
- IF( N1SV.EQ.0 ) THEN
- DO 20 N1SV = 1, N2SV
- INDEX( I ) = IND2
- I = I + 1
- IND2 = IND2 + DTRD2
- 20 CONTINUE
- ELSE
-* N2SV .EQ. 0
- DO 30 N2SV = 1, N1SV
- INDEX( I ) = IND1
- I = I + 1
- IND1 = IND1 + DTRD1
- 30 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DLAMRG
-*
- END
diff --git a/netlib/LAPACK/dlaneg.f b/netlib/LAPACK/dlaneg.f
deleted file mode 100644
index bfeb976..0000000
--- a/netlib/LAPACK/dlaneg.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b DLANEG computes the Sturm count.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANEG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaneg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaneg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaneg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION DLANEG( N, D, LLD, SIGMA, PIVMIN, R )
-*
-* .. Scalar Arguments ..
-* INTEGER N, R
-* DOUBLE PRECISION PIVMIN, SIGMA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), LLD( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANEG computes the Sturm count, the number of negative pivots
-*> encountered while factoring tridiagonal T - sigma I = L D L^T.
-*> This implementation works directly on the factors without forming
-*> the tridiagonal matrix T. The Sturm count is also the number of
-*> eigenvalues of T less than sigma.
-*>
-*> This routine is called from DLARRB.
-*>
-*> The current routine does not use the PIVMIN parameter but rather
-*> requires IEEE-754 propagation of Infinities and NaNs. This
-*> routine also has no input range restrictions but does require
-*> default exception handling such that x/0 produces Inf when x is
-*> non-zero, and Inf/Inf produces NaN. For more information, see:
-*>
-*> Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
-*> Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
-*> Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
-*> (Tech report version in LAWN 172 with the same title.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] LLD
-*> \verbatim
-*> LLD is DOUBLE PRECISION array, dimension (N-1)
-*> The (N-1) elements L(i)*L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> Shift amount in T - sigma I = L D L^T.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot in the Sturm sequence. May be used
-*> when zero pivots are encountered on non-IEEE-754
-*> architectures.
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is INTEGER
-*> The twist index for the twisted factorization that is used
-*> for the negcount.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA \n
-*> Jason Riedy, University of California, Berkeley, USA \n
-*>
-* =====================================================================
- INTEGER FUNCTION DLANEG( N, D, LLD, SIGMA, PIVMIN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, R
- DOUBLE PRECISION PIVMIN, SIGMA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), LLD( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* Some architectures propagate Infinities and NaNs very slowly, so
-* the code computes counts in BLKLEN chunks. Then a NaN can
-* propagate at most BLKLEN columns before being detected. This is
-* not a general tuning parameter; it needs only to be just large
-* enough that the overhead is tiny in common cases.
- INTEGER BLKLEN
- PARAMETER ( BLKLEN = 128 )
-* ..
-* .. Local Scalars ..
- INTEGER BJ, J, NEG1, NEG2, NEGCNT
- DOUBLE PRECISION BSAV, DMINUS, DPLUS, GAMMA, P, T, TMP
- LOGICAL SAWNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN, MAX
-* ..
-* .. External Functions ..
- LOGICAL DISNAN
- EXTERNAL DISNAN
-* ..
-* .. Executable Statements ..
-
- NEGCNT = 0
-
-* I) upper part: L D L^T - SIGMA I = L+ D+ L+^T
- T = -SIGMA
- DO 210 BJ = 1, R-1, BLKLEN
- NEG1 = 0
- BSAV = T
- DO 21 J = BJ, MIN(BJ+BLKLEN-1, R-1)
- DPLUS = D( J ) + T
- IF( DPLUS.LT.ZERO ) NEG1 = NEG1 + 1
- TMP = T / DPLUS
- T = TMP * LLD( J ) - SIGMA
- 21 CONTINUE
- SAWNAN = DISNAN( T )
-* Run a slower version of the above loop if a NaN is detected.
-* A NaN should occur only with a zero pivot after an infinite
-* pivot. In that case, substituting 1 for T/DPLUS is the
-* correct limit.
- IF( SAWNAN ) THEN
- NEG1 = 0
- T = BSAV
- DO 22 J = BJ, MIN(BJ+BLKLEN-1, R-1)
- DPLUS = D( J ) + T
- IF( DPLUS.LT.ZERO ) NEG1 = NEG1 + 1
- TMP = T / DPLUS
- IF (DISNAN(TMP)) TMP = ONE
- T = TMP * LLD(J) - SIGMA
- 22 CONTINUE
- END IF
- NEGCNT = NEGCNT + NEG1
- 210 CONTINUE
-*
-* II) lower part: L D L^T - SIGMA I = U- D- U-^T
- P = D( N ) - SIGMA
- DO 230 BJ = N-1, R, -BLKLEN
- NEG2 = 0
- BSAV = P
- DO 23 J = BJ, MAX(BJ-BLKLEN+1, R), -1
- DMINUS = LLD( J ) + P
- IF( DMINUS.LT.ZERO ) NEG2 = NEG2 + 1
- TMP = P / DMINUS
- P = TMP * D( J ) - SIGMA
- 23 CONTINUE
- SAWNAN = DISNAN( P )
-* As above, run a slower version that substitutes 1 for Inf/Inf.
-*
- IF( SAWNAN ) THEN
- NEG2 = 0
- P = BSAV
- DO 24 J = BJ, MAX(BJ-BLKLEN+1, R), -1
- DMINUS = LLD( J ) + P
- IF( DMINUS.LT.ZERO ) NEG2 = NEG2 + 1
- TMP = P / DMINUS
- IF (DISNAN(TMP)) TMP = ONE
- P = TMP * D(J) - SIGMA
- 24 CONTINUE
- END IF
- NEGCNT = NEGCNT + NEG2
- 230 CONTINUE
-*
-* III) Twist index
-* T was shifted by SIGMA initially.
- GAMMA = (T + SIGMA) + P
- IF( GAMMA.LT.ZERO ) NEGCNT = NEGCNT+1
-
- DLANEG = NEGCNT
- END
diff --git a/netlib/LAPACK/dlangb.f b/netlib/LAPACK/dlangb.f
deleted file mode 100644
index 87116ee..0000000
--- a/netlib/LAPACK/dlangb.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANGB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlangb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlangb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlangb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANGB( NORM, N, KL, KU, AB, LDAB,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER KL, KU, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANGB returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of an
-*> n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
-*> \endverbatim
-*>
-*> \return DLANGB
-*> \verbatim
-*>
-*> DLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANGB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANGB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of sub-diagonals of the matrix A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of super-diagonals of the matrix A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th
-*> column of A is stored in the j-th column of the array AB as
-*> follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGBauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANGB( NORM, N, KL, KU, AB, LDAB,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER KL, KU, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K, L
- DOUBLE PRECISION SCALE, SUM, VALUE, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- TEMP = ABS( AB( I, J ) )
- IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 30 CONTINUE
- IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, N
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- K = KU + 1 - J
- DO 60 I = MAX( 1, J-KU ), MIN( N, J+KL )
- WORK( I ) = WORK( I ) + ABS( AB( K+I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, N
- TEMP = WORK( I )
- IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- L = MAX( 1, J-KU )
- K = KU + 1 - J + L
- CALL DLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANGB = VALUE
- RETURN
-*
-* End of DLANGB
-*
- END
diff --git a/netlib/LAPACK/dlange.f b/netlib/LAPACK/dlange.f
deleted file mode 100644
index bec815d..0000000
--- a/netlib/LAPACK/dlange.f
+++ /dev/null
@@ -1,211 +0,0 @@
-*> \brief \b DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANGE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlange.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlange.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlange.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANGE returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real matrix A.
-*> \endverbatim
-*>
-*> \return DLANGE
-*> \verbatim
-*>
-*> DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANGE as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0. When M = 0,
-*> DLANGE is set to zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0. When N = 0,
-*> DLANGE is set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION SCALE, SUM, VALUE, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( MIN( M, N ).EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = 1, M
- TEMP = ABS( A( I, J ) )
- IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = 1, M
- SUM = SUM + ABS( A( I, J ) )
- 30 CONTINUE
- IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, M
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- DO 60 I = 1, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, M
- TEMP = WORK( I )
- IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANGE = VALUE
- RETURN
-*
-* End of DLANGE
-*
- END
diff --git a/netlib/LAPACK/dlangt.f b/netlib/LAPACK/dlangt.f
deleted file mode 100644
index fb89baf..0000000
--- a/netlib/LAPACK/dlangt.f
+++ /dev/null
@@ -1,208 +0,0 @@
-*> \brief \b DLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANGT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlangt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlangt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlangt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DL( * ), DU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANGT returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \return DLANGT
-*> \verbatim
-*>
-*> DLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANGT as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANGT is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) sub-diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) super-diagonal elements of A.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DL( * ), DU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION ANORM, SCALE, SUM, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- ANORM = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- ANORM = ABS( D( N ) )
- DO 10 I = 1, N - 1
- IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) )
- $ ANORM = ABS(DL(I))
- IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) )
- $ ANORM = ABS(D(I))
- IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) )
- $ ANORM = ABS(DU(I))
- 10 CONTINUE
- ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN
-*
-* Find norm1(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) )
- TEMP = ABS( D( N ) )+ABS( DU( N-1 ) )
- IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
- DO 20 I = 2, N - 1
- TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) )
- IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
- 20 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) )
- TEMP = ABS( D( N ) )+ABS( DL( N-1 ) )
- IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
- DO 30 I = 2, N - 1
- TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) )
- IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
- 30 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- CALL DLASSQ( N, D, 1, SCALE, SUM )
- IF( N.GT.1 ) THEN
- CALL DLASSQ( N-1, DL, 1, SCALE, SUM )
- CALL DLASSQ( N-1, DU, 1, SCALE, SUM )
- END IF
- ANORM = SCALE*SQRT( SUM )
- END IF
-*
- DLANGT = ANORM
- RETURN
-*
-* End of DLANGT
-*
- END
diff --git a/netlib/LAPACK/dlanhs.f b/netlib/LAPACK/dlanhs.f
deleted file mode 100644
index 35c0637..0000000
--- a/netlib/LAPACK/dlanhs.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANHS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanhs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanhs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanhs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANHS returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> Hessenberg matrix A.
-*> \endverbatim
-*>
-*> \return DLANHS
-*> \verbatim
-*>
-*> DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANHS as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANHS is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The n by n upper Hessenberg matrix A; the part of A below the
-*> first sub-diagonal is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(N,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = 1, MIN( N, J+1 )
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = 1, MIN( N, J+1 )
- SUM = SUM + ABS( A( I, J ) )
- 30 CONTINUE
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, N
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- DO 60 I = 1, MIN( N, J+1 )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANHS = VALUE
- RETURN
-*
-* End of DLANHS
-*
- END
diff --git a/netlib/LAPACK/dlansb.f b/netlib/LAPACK/dlansb.f
deleted file mode 100644
index a5417f5..0000000
--- a/netlib/LAPACK/dlansb.f
+++ /dev/null
@@ -1,258 +0,0 @@
-*> \brief \b DLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANSB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, UPLO
-* INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANSB returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of an
-*> n by n symmetric band matrix A, with k super-diagonals.
-*> \endverbatim
-*>
-*> \return DLANSB
-*> \verbatim
-*>
-*> DLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANSB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> band matrix A is supplied.
-*> = 'U': Upper triangular part is supplied
-*> = 'L': Lower triangular part is supplied
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANSB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of super-diagonals or sub-diagonals of the
-*> band matrix A. K >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangle of the symmetric band matrix A,
-*> stored in the first K+1 rows of AB. The j-th column of A is
-*> stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= K+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, UPLO
- INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
- DOUBLE PRECISION ABSA, SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = MAX( K+2-J, 1 ), K + 1
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = 1, MIN( N+1-J, K+1 )
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- SUM = ZERO
- L = K + 1 - J
- DO 50 I = MAX( 1, J-K ), J - 1
- ABSA = ABS( AB( L+I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 50 CONTINUE
- WORK( J ) = SUM + ABS( AB( K+1, J ) )
- 60 CONTINUE
- DO 70 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- ELSE
- DO 80 I = 1, N
- WORK( I ) = ZERO
- 80 CONTINUE
- DO 100 J = 1, N
- SUM = WORK( J ) + ABS( AB( 1, J ) )
- L = 1 - J
- DO 90 I = J + 1, MIN( N, J+K )
- ABSA = ABS( AB( L+I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 90 CONTINUE
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 100 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- IF( K.GT.0 ) THEN
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 2, N
- CALL DLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
- $ 1, SCALE, SUM )
- 110 CONTINUE
- L = K + 1
- ELSE
- DO 120 J = 1, N - 1
- CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
- $ SUM )
- 120 CONTINUE
- L = 1
- END IF
- SUM = 2*SUM
- ELSE
- L = 1
- END IF
- CALL DLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM )
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANSB = VALUE
- RETURN
-*
-* End of DLANSB
-*
- END
diff --git a/netlib/LAPACK/dlansf.f b/netlib/LAPACK/dlansf.f
deleted file mode 100644
index cac7b02..0000000
--- a/netlib/LAPACK/dlansf.f
+++ /dev/null
@@ -1,963 +0,0 @@
-*> \brief \b DLANSF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix in RFP format.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANSF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, TRANSR, UPLO
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: * ), WORK( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANSF returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric matrix A in RFP format.
-*> \endverbatim
-*>
-*> \return DLANSF
-*> \verbatim
-*>
-*> DLANSF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANSF as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> Specifies whether the RFP format of A is normal or
-*> transposed format.
-*> = 'N': RFP format is Normal;
-*> = 'T': RFP format is Transpose.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the RFP matrix A came from
-*> an upper or lower triangular matrix as follows:
-*> = 'U': RFP A came from an upper triangular matrix;
-*> = 'L': RFP A came from a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANSF is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( N*(N+1)/2 );
-*> On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
-*> part of the symmetric matrix A stored in RFP format. See the
-*> "Notes" below for more details.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, TRANSR, UPLO
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: * ), WORK( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA
- DOUBLE PRECISION SCALE, S, VALUE, AA, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- DLANSF = ZERO
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- DLANSF = ABS( A(0) )
- RETURN
- END IF
-*
-* set noe = 1 if n is odd. if n is even set noe=0
-*
- NOE = 1
- IF( MOD( N, 2 ).EQ.0 )
- $ NOE = 0
-*
-* set ifm = 0 when form='T or 't' and 1 otherwise
-*
- IFM = 1
- IF( LSAME( TRANSR, 'T' ) )
- $ IFM = 0
-*
-* set ilu = 0 when uplo='U or 'u' and 1 otherwise
-*
- ILU = 1
- IF( LSAME( UPLO, 'U' ) )
- $ ILU = 0
-*
-* set lda = (n+1)/2 when ifm = 0
-* set lda = n when ifm = 1 and noe = 1
-* set lda = n+1 when ifm = 1 and noe = 0
-*
- IF( IFM.EQ.1 ) THEN
- IF( NOE.EQ.1 ) THEN
- LDA = N
- ELSE
-* noe=0
- LDA = N + 1
- END IF
- ELSE
-* ifm=0
- LDA = ( N+1 ) / 2
- END IF
-*
- IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- K = ( N+1 ) / 2
- VALUE = ZERO
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( IFM.EQ.1 ) THEN
-* A is n by k
- DO J = 0, K - 1
- DO I = 0, N - 1
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- ELSE
-* xpose case; A is k by n
- DO J = 0, N - 1
- DO I = 0, K - 1
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- END IF
- ELSE
-* n is even
- IF( IFM.EQ.1 ) THEN
-* A is n+1 by k
- DO J = 0, K - 1
- DO I = 0, N
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- ELSE
-* xpose case; A is k by n+1
- DO J = 0, N
- DO I = 0, K - 1
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- IF( IFM.EQ.1 ) THEN
- K = N / 2
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( ILU.EQ.0 ) THEN
- DO I = 0, K - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K
- S = ZERO
- DO I = 0, K + J - 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(i,j+k)
- S = S + AA
- WORK( I ) = WORK( I ) + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- WORK( J+K ) = S + AA
- IF( I.EQ.K+K )
- $ GO TO 10
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = WORK( J ) + AA
- S = ZERO
- DO L = J + 1, K - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- 10 CONTINUE
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu = 1
- K = K + 1
-* k=(n+1)/2 for n odd and ilu=1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = K - 1, 0, -1
- S = ZERO
- DO I = 0, J - 2
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,i+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + AA
- END DO
- IF( J.GT.0 ) THEN
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + S
-* i=j
- I = I + 1
- END IF
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = AA
- S = ZERO
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- ELSE
-* n is even
- IF( ILU.EQ.0 ) THEN
- DO I = 0, K - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K - 1
- S = ZERO
- DO I = 0, K + J - 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(i,j+k)
- S = S + AA
- WORK( I ) = WORK( I ) + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- WORK( J+K ) = S + AA
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = WORK( J ) + AA
- S = ZERO
- DO L = J + 1, K - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu = 1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = K - 1, 0, -1
- S = ZERO
- DO I = 0, J - 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,i+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + S
-* i=j
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = AA
- S = ZERO
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- END IF
- ELSE
-* ifm=0
- K = N / 2
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( ILU.EQ.0 ) THEN
- N1 = K
-* n/2
- K = K + 1
-* k is the row size and lda
- DO I = N1, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, N1 - 1
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,n1+i)
- WORK( I+N1 ) = WORK( I+N1 ) + AA
- S = S + AA
- END DO
- WORK( J ) = S
- END DO
-* j=n1=k-1 is special
- S = ABS( A( 0+J*LDA ) )
-* A(k-1,k-1)
- DO I = 1, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,i+n1)
- WORK( I+N1 ) = WORK( I+N1 ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- DO J = K, N - 1
- S = ZERO
- DO I = 0, J - K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(i,j-k)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=j-k
- AA = ABS( A( I+J*LDA ) )
-* A(j-k,j-k)
- S = S + AA
- WORK( J-K ) = WORK( J-K ) + S
- I = I + 1
- S = ABS( A( I+J*LDA ) )
-* A(j,j)
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,l)
- WORK( L ) = WORK( L ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu=1
- K = K + 1
-* k=(n+1)/2 for n odd and ilu=1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K - 2
-* process
- S = ZERO
- DO I = 0, J - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* i=j so process of A(j,j)
- S = S + AA
- WORK( J ) = S
-* is initialised here
- I = I + 1
-* i=j process A(j+k,j+k)
- AA = ABS( A( I+J*LDA ) )
- S = AA
- DO L = K + J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(l,k+j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( K+J ) = WORK( K+J ) + S
- END DO
-* j=k-1 is special :process col A(k-1,0:k-1)
- S = ZERO
- DO I = 0, K - 2
- AA = ABS( A( I+J*LDA ) )
-* A(k,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=k-1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,k-1)
- S = S + AA
- WORK( I ) = S
-* done with col j=k+1
- DO J = K, N - 1
-* process col j of A = A(j,0:k-1)
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- ELSE
-* n is even
- IF( ILU.EQ.0 ) THEN
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K - 1
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,i+k)
- WORK( I+K ) = WORK( I+K ) + AA
- S = S + AA
- END DO
- WORK( J ) = S
- END DO
-* j=k
- AA = ABS( A( 0+J*LDA ) )
-* A(k,k)
- S = AA
- DO I = 1, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(k,k+i)
- WORK( I+K ) = WORK( I+K ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- DO J = K + 1, N - 1
- S = ZERO
- DO I = 0, J - 2 - K
- AA = ABS( A( I+J*LDA ) )
-* A(i,j-k-1)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=j-1-k
- AA = ABS( A( I+J*LDA ) )
-* A(j-k-1,j-k-1)
- S = S + AA
- WORK( J-K-1 ) = WORK( J-K-1 ) + S
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,j)
- S = AA
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,l)
- WORK( L ) = WORK( L ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
-* j=n
- S = ZERO
- DO I = 0, K - 2
- AA = ABS( A( I+J*LDA ) )
-* A(i,k-1)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=k-1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,k-1)
- S = S + AA
- WORK( I ) = WORK( I ) + S
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu=1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
-* j=0 is special :process col A(k:n-1,k)
- S = ABS( A( 0 ) )
-* A(k,k)
- DO I = 1, K - 1
- AA = ABS( A( I ) )
-* A(k+i,k)
- WORK( I+K ) = WORK( I+K ) + AA
- S = S + AA
- END DO
- WORK( K ) = WORK( K ) + S
- DO J = 1, K - 1
-* process
- S = ZERO
- DO I = 0, J - 2
- AA = ABS( A( I+J*LDA ) )
-* A(j-1,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* i=j-1 so process of A(j-1,j-1)
- S = S + AA
- WORK( J-1 ) = S
-* is initialised here
- I = I + 1
-* i=j process A(j+k,j+k)
- AA = ABS( A( I+J*LDA ) )
- S = AA
- DO L = K + J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(l,k+j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( K+J ) = WORK( K+J ) + S
- END DO
-* j=k is special :process col A(k,0:k-1)
- S = ZERO
- DO I = 0, K - 2
- AA = ABS( A( I+J*LDA ) )
-* A(k,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=k-1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,k-1)
- S = S + AA
- WORK( I ) = S
-* done with col j=k+1
- DO J = K + 1, N
-* process col j-1 of A = A(j-1,0:k-1)
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j-1,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- WORK( J-1 ) = WORK( J-1 ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- K = ( N+1 ) / 2
- SCALE = ZERO
- S = ONE
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( IFM.EQ.1 ) THEN
-* A is normal
- IF( ILU.EQ.0 ) THEN
-* A is upper
- DO J = 0, K - 3
- CALL DLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S )
-* L at A(k,0)
- END DO
- DO J = 0, K - 1
- CALL DLASSQ( K+J-1, A( 0+J*LDA ), 1, SCALE, S )
-* trap U at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K-1, A( K ), LDA+1, SCALE, S )
-* tri L at A(k,0)
- CALL DLASSQ( K, A( K-1 ), LDA+1, SCALE, S )
-* tri U at A(k-1,0)
- ELSE
-* ilu=1 & A is lower
- DO J = 0, K - 1
- CALL DLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S )
-* trap L at A(0,0)
- END DO
- DO J = 0, K - 2
- CALL DLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S )
-* U at A(0,1)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri L at A(0,0)
- CALL DLASSQ( K-1, A( 0+LDA ), LDA+1, SCALE, S )
-* tri U at A(0,1)
- END IF
- ELSE
-* A is xpose
- IF( ILU.EQ.0 ) THEN
-* A**T is upper
- DO J = 1, K - 2
- CALL DLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S )
-* U at A(0,k)
- END DO
- DO J = 0, K - 2
- CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k-1 rect. at A(0,0)
- END DO
- DO J = 0, K - 2
- CALL DLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1,
- $ SCALE, S )
-* L at A(0,k-1)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S )
-* tri U at A(0,k)
- CALL DLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S )
-* tri L at A(0,k-1)
- ELSE
-* A**T is lower
- DO J = 1, K - 1
- CALL DLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
-* U at A(0,0)
- END DO
- DO J = K, N - 1
- CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k-1 rect. at A(0,k)
- END DO
- DO J = 0, K - 3
- CALL DLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S )
-* L at A(1,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri U at A(0,0)
- CALL DLASSQ( K-1, A( 1 ), LDA+1, SCALE, S )
-* tri L at A(1,0)
- END IF
- END IF
- ELSE
-* n is even
- IF( IFM.EQ.1 ) THEN
-* A is normal
- IF( ILU.EQ.0 ) THEN
-* A is upper
- DO J = 0, K - 2
- CALL DLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S )
-* L at A(k+1,0)
- END DO
- DO J = 0, K - 1
- CALL DLASSQ( K+J, A( 0+J*LDA ), 1, SCALE, S )
-* trap U at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K, A( K+1 ), LDA+1, SCALE, S )
-* tri L at A(k+1,0)
- CALL DLASSQ( K, A( K ), LDA+1, SCALE, S )
-* tri U at A(k,0)
- ELSE
-* ilu=1 & A is lower
- DO J = 0, K - 1
- CALL DLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S )
-* trap L at A(1,0)
- END DO
- DO J = 1, K - 1
- CALL DLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
-* U at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K, A( 1 ), LDA+1, SCALE, S )
-* tri L at A(1,0)
- CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri U at A(0,0)
- END IF
- ELSE
-* A is xpose
- IF( ILU.EQ.0 ) THEN
-* A**T is upper
- DO J = 1, K - 1
- CALL DLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S )
-* U at A(0,k+1)
- END DO
- DO J = 0, K - 1
- CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k rect. at A(0,0)
- END DO
- DO J = 0, K - 2
- CALL DLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE,
- $ S )
-* L at A(0,k)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S )
-* tri U at A(0,k+1)
- CALL DLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S )
-* tri L at A(0,k)
- ELSE
-* A**T is lower
- DO J = 1, K - 1
- CALL DLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S )
-* U at A(0,1)
- END DO
- DO J = K + 1, N
- CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k rect. at A(0,k+1)
- END DO
- DO J = 0, K - 2
- CALL DLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S )
-* L at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL DLASSQ( K, A( LDA ), LDA+1, SCALE, S )
-* tri L at A(0,1)
- CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri U at A(0,0)
- END IF
- END IF
- END IF
- VALUE = SCALE*SQRT( S )
- END IF
-*
- DLANSF = VALUE
- RETURN
-*
-* End of DLANSF
-*
- END
diff --git a/netlib/LAPACK/dlansp.f b/netlib/LAPACK/dlansp.f
deleted file mode 100644
index 60ed215..0000000
--- a/netlib/LAPACK/dlansp.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANSP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANSP( NORM, UPLO, N, AP, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, UPLO
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANSP returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric matrix A, supplied in packed form.
-*> \endverbatim
-*>
-*> \return DLANSP
-*> \verbatim
-*>
-*> DLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANSP as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is supplied.
-*> = 'U': Upper triangular part of A is supplied
-*> = 'L': Lower triangular part of A is supplied
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANSP is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANSP( NORM, UPLO, N, AP, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, UPLO
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K
- DOUBLE PRECISION ABSA, SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- K = 1
- DO 20 J = 1, N
- DO 10 I = K, K + J - 1
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- K = K + J
- 20 CONTINUE
- ELSE
- K = 1
- DO 40 J = 1, N
- DO 30 I = K, K + N - J
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- K = K + N - J + 1
- 40 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- VALUE = ZERO
- K = 1
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- SUM = ZERO
- DO 50 I = 1, J - 1
- ABSA = ABS( AP( K ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- K = K + 1
- 50 CONTINUE
- WORK( J ) = SUM + ABS( AP( K ) )
- K = K + 1
- 60 CONTINUE
- DO 70 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- ELSE
- DO 80 I = 1, N
- WORK( I ) = ZERO
- 80 CONTINUE
- DO 100 J = 1, N
- SUM = WORK( J ) + ABS( AP( K ) )
- K = K + 1
- DO 90 I = J + 1, N
- ABSA = ABS( AP( K ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- K = K + 1
- 90 CONTINUE
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 100 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- K = 2
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 2, N
- CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM )
- K = K + J
- 110 CONTINUE
- ELSE
- DO 120 J = 1, N - 1
- CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM )
- K = K + N - J + 1
- 120 CONTINUE
- END IF
- SUM = 2*SUM
- K = 1
- DO 130 I = 1, N
- IF( AP( K ).NE.ZERO ) THEN
- ABSA = ABS( AP( K ) )
- IF( SCALE.LT.ABSA ) THEN
- SUM = ONE + SUM*( SCALE / ABSA )**2
- SCALE = ABSA
- ELSE
- SUM = SUM + ( ABSA / SCALE )**2
- END IF
- END IF
- IF( LSAME( UPLO, 'U' ) ) THEN
- K = K + I + 1
- ELSE
- K = K + N - I + 1
- END IF
- 130 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANSP = VALUE
- RETURN
-*
-* End of DLANSP
-*
- END
diff --git a/netlib/LAPACK/dlanst.f b/netlib/LAPACK/dlanst.f
deleted file mode 100644
index 213b06a..0000000
--- a/netlib/LAPACK/dlanst.f
+++ /dev/null
@@ -1,186 +0,0 @@
-*> \brief \b DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANST returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \return DLANST
-*> \verbatim
-*>
-*> DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANST as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANST is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) sub-diagonal or super-diagonal elements of A.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION ANORM, SCALE, SUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- ANORM = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- ANORM = ABS( D( N ) )
- DO 10 I = 1, N - 1
- SUM = ABS( D( I ) )
- IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
- SUM = ABS( E( I ) )
- IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
- 10 CONTINUE
- ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR.
- $ LSAME( NORM, 'I' ) ) THEN
-*
-* Find norm1(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = ABS( D( 1 ) )+ABS( E( 1 ) )
- SUM = ABS( E( N-1 ) )+ABS( D( N ) )
- IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
- DO 20 I = 2, N - 1
- SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) )
- IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
- 20 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- IF( N.GT.1 ) THEN
- CALL DLASSQ( N-1, E, 1, SCALE, SUM )
- SUM = 2*SUM
- END IF
- CALL DLASSQ( N, D, 1, SCALE, SUM )
- ANORM = SCALE*SQRT( SUM )
- END IF
-*
- DLANST = ANORM
- RETURN
-*
-* End of DLANST
-*
- END
diff --git a/netlib/LAPACK/dlansy.f b/netlib/LAPACK/dlansy.f
deleted file mode 100644
index bc70ab8..0000000
--- a/netlib/LAPACK/dlansy.f
+++ /dev/null
@@ -1,241 +0,0 @@
-*> \brief \b DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANSY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, UPLO
-* INTEGER LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANSY returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric matrix A.
-*> \endverbatim
-*>
-*> \return DLANSY
-*> \verbatim
-*>
-*> DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANSY as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is to be referenced.
-*> = 'U': Upper triangular part of A is referenced
-*> = 'L': Lower triangular part of A is referenced
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANSY is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading n by n
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading n by n lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(N,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, UPLO
- INTEGER LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION ABSA, SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, J
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = J, N
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- SUM = ZERO
- DO 50 I = 1, J - 1
- ABSA = ABS( A( I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 50 CONTINUE
- WORK( J ) = SUM + ABS( A( J, J ) )
- 60 CONTINUE
- DO 70 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- ELSE
- DO 80 I = 1, N
- WORK( I ) = ZERO
- 80 CONTINUE
- DO 100 J = 1, N
- SUM = WORK( J ) + ABS( A( J, J ) )
- DO 90 I = J + 1, N
- ABSA = ABS( A( I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 90 CONTINUE
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 100 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 2, N
- CALL DLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
- 110 CONTINUE
- ELSE
- DO 120 J = 1, N - 1
- CALL DLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
- 120 CONTINUE
- END IF
- SUM = 2*SUM
- CALL DLASSQ( N, A, LDA+1, SCALE, SUM )
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANSY = VALUE
- RETURN
-*
-* End of DLANSY
-*
- END
diff --git a/netlib/LAPACK/dlantb.f b/netlib/LAPACK/dlantb.f
deleted file mode 100644
index 28ca46a..0000000
--- a/netlib/LAPACK/dlantb.f
+++ /dev/null
@@ -1,361 +0,0 @@
-*> \brief \b DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANTB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
-* LDAB, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANTB returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of an
-*> n by n triangular band matrix A, with ( k + 1 ) diagonals.
-*> \endverbatim
-*>
-*> \return DLANTB
-*> \verbatim
-*>
-*> DLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANTB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANTB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals of the matrix A if UPLO = 'L'.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first k+1 rows of AB. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
-*> Note that when DIAG = 'U', the elements of the array AB
-*> corresponding to the diagonal elements of the matrix A are
-*> not referenced, but are assumed to be one.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= K+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
- $ LDAB, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J, L
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = MAX( K+2-J, 1 ), K
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = 2, MIN( N+1-J, K+1 )
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = MAX( K+2-J, 1 ), K + 1
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = 1, MIN( N+1-J, K+1 )
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 90 I = MAX( K+2-J, 1 ), K
- SUM = SUM + ABS( AB( I, J ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = MAX( K+2-J, 1 ), K + 1
- SUM = SUM + ABS( AB( I, J ) )
- 100 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = 2, MIN( N+1-J, K+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = 1, MIN( N+1-J, K+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 130 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, N
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- L = K + 1 - J
- DO 160 I = MAX( 1, J-K ), J - 1
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO 180 I = 1, N
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- L = K + 1 - J
- DO 190 I = MAX( 1, J-K ), J
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 230 J = 1, N
- L = 1 - J
- DO 220 I = J + 1, MIN( N, J+K )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 220 CONTINUE
- 230 CONTINUE
- ELSE
- DO 240 I = 1, N
- WORK( I ) = ZERO
- 240 CONTINUE
- DO 260 J = 1, N
- L = 1 - J
- DO 250 I = J, MIN( N, J+K )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 250 CONTINUE
- 260 CONTINUE
- END IF
- END IF
- DO 270 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 270 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- IF( K.GT.0 ) THEN
- DO 280 J = 2, N
- CALL DLASSQ( MIN( J-1, K ),
- $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE,
- $ SUM )
- 280 CONTINUE
- END IF
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 290 J = 1, N
- CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
- $ 1, SCALE, SUM )
- 290 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- IF( K.GT.0 ) THEN
- DO 300 J = 1, N - 1
- CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
- $ SUM )
- 300 CONTINUE
- END IF
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 310 J = 1, N
- CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
- $ SUM )
- 310 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANTB = VALUE
- RETURN
-*
-* End of DLANTB
-*
- END
diff --git a/netlib/LAPACK/dlantp.f b/netlib/LAPACK/dlantp.f
deleted file mode 100644
index ae4a669..0000000
--- a/netlib/LAPACK/dlantp.f
+++ /dev/null
@@ -1,355 +0,0 @@
-*> \brief \b DLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANTP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANTP returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> triangular matrix A, supplied in packed form.
-*> \endverbatim
-*>
-*> \return DLANTP
-*> \verbatim
-*>
-*> DLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANTP as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANTP is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> Note that when DIAG = 'U', the elements of the array AP
-*> corresponding to the diagonal elements of the matrix A are
-*> not referenced, but are assumed to be one.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J, K
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- K = 1
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = K, K + J - 2
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- K = K + J
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = K + 1, K + N - J
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- K = K + N - J + 1
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = K, K + J - 1
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 50 CONTINUE
- K = K + J
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = K, K + N - J
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- K = K + N - J + 1
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- K = 1
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 90 I = K, K + J - 2
- SUM = SUM + ABS( AP( I ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = K, K + J - 1
- SUM = SUM + ABS( AP( I ) )
- 100 CONTINUE
- END IF
- K = K + J
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = K + 1, K + N - J
- SUM = SUM + ABS( AP( I ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = K, K + N - J
- SUM = SUM + ABS( AP( I ) )
- 130 CONTINUE
- END IF
- K = K + N - J + 1
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- K = 1
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, N
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- DO 160 I = 1, J - 1
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 160 CONTINUE
- K = K + 1
- 170 CONTINUE
- ELSE
- DO 180 I = 1, N
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- DO 190 I = 1, J
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 230 J = 1, N
- K = K + 1
- DO 220 I = J + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 220 CONTINUE
- 230 CONTINUE
- ELSE
- DO 240 I = 1, N
- WORK( I ) = ZERO
- 240 CONTINUE
- DO 260 J = 1, N
- DO 250 I = J, N
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 250 CONTINUE
- 260 CONTINUE
- END IF
- END IF
- VALUE = ZERO
- DO 270 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 270 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- K = 2
- DO 280 J = 2, N
- CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM )
- K = K + J
- 280 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- K = 1
- DO 290 J = 1, N
- CALL DLASSQ( J, AP( K ), 1, SCALE, SUM )
- K = K + J
- 290 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- K = 2
- DO 300 J = 1, N - 1
- CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM )
- K = K + N - J + 1
- 300 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- K = 1
- DO 310 J = 1, N
- CALL DLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )
- K = K + N - J + 1
- 310 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANTP = VALUE
- RETURN
-*
-* End of DLANTP
-*
- END
diff --git a/netlib/LAPACK/dlantr.f b/netlib/LAPACK/dlantr.f
deleted file mode 100644
index 6088e8c..0000000
--- a/netlib/LAPACK/dlantr.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b DLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANTR returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> trapezoidal or triangular matrix A.
-*> \endverbatim
-*>
-*> \return DLANTR
-*> \verbatim
-*>
-*> DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANTR as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower trapezoidal.
-*> = 'U': Upper trapezoidal
-*> = 'L': Lower trapezoidal
-*> Note that A is triangular instead of trapezoidal if M = N.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A has unit diagonal.
-*> = 'N': Non-unit diagonal
-*> = 'U': Unit diagonal
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0, and if
-*> UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0, and if
-*> UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The trapezoidal matrix A (A is triangular if M = N).
-*> If UPLO = 'U', the leading m by n upper trapezoidal part of
-*> the array A contains the upper trapezoidal matrix, and the
-*> strictly lower triangular part of A is not referenced.
-*> If UPLO = 'L', the leading m by n lower trapezoidal part of
-*> the array A contains the lower trapezoidal matrix, and the
-*> strictly upper triangular part of A is not referenced. Note
-*> that when DIAG = 'U', the diagonal elements of A are not
-*> referenced and are assumed to be one.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- EXTERNAL LSAME, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( MIN( M, N ).EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, MIN( M, J-1 )
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = J + 1, M
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = 1, MIN( M, J )
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = J, M
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
- SUM = ONE
- DO 90 I = 1, J - 1
- SUM = SUM + ABS( A( I, J ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = 1, MIN( M, J )
- SUM = SUM + ABS( A( I, J ) )
- 100 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = J + 1, M
- SUM = SUM + ABS( A( I, J ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = J, M
- SUM = SUM + ABS( A( I, J ) )
- 130 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, M
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- DO 160 I = 1, MIN( M, J-1 )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO 180 I = 1, M
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- DO 190 I = 1, MIN( M, J )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 220 I = N + 1, M
- WORK( I ) = ZERO
- 220 CONTINUE
- DO 240 J = 1, N
- DO 230 I = J + 1, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 230 CONTINUE
- 240 CONTINUE
- ELSE
- DO 250 I = 1, M
- WORK( I ) = ZERO
- 250 CONTINUE
- DO 270 J = 1, N
- DO 260 I = J, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 260 CONTINUE
- 270 CONTINUE
- END IF
- END IF
- VALUE = ZERO
- DO 280 I = 1, M
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
- 280 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = MIN( M, N )
- DO 290 J = 2, N
- CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
- 290 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 300 J = 1, N
- CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
- 300 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = MIN( M, N )
- DO 310 J = 1, N
- CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
- $ SUM )
- 310 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 320 J = 1, N
- CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
- 320 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANTR = VALUE
- RETURN
-*
-* End of DLANTR
-*
- END
diff --git a/netlib/LAPACK/dlanv2.f b/netlib/LAPACK/dlanv2.f
deleted file mode 100644
index 26c6b11..0000000
--- a/netlib/LAPACK/dlanv2.f
+++ /dev/null
@@ -1,289 +0,0 @@
-*> \brief \b DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanv2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanv2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanv2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
-*> matrix in standard form:
-*>
-*> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
-*> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
-*>
-*> where either
-*> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
-*> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
-*> conjugate eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION
-*> On entry, the elements of the input matrix.
-*> On exit, they are overwritten by the elements of the
-*> standardised Schur form.
-*> \endverbatim
-*>
-*> \param[out] RT1R
-*> \verbatim
-*> RT1R is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] RT1I
-*> \verbatim
-*> RT1I is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] RT2R
-*> \verbatim
-*> RT2R is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] RT2I
-*> \verbatim
-*> RT2I is DOUBLE PRECISION
-*> The real and imaginary parts of the eigenvalues. If the
-*> eigenvalues are a complex conjugate pair, RT1I > 0.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is DOUBLE PRECISION
-*> Parameters of the rotation matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by V. Sima, Research Institute for Informatics, Bucharest,
-*> Romania, to reduce the risk of cancellation errors,
-*> when computing real eigenvalues, and to ensure, if possible, that
-*> abs(RT1R) >= abs(RT2R).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION MULTPL
- PARAMETER ( MULTPL = 4.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
- $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL DLAMCH, DLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
- EPS = DLAMCH( 'P' )
- IF( C.EQ.ZERO ) THEN
- CS = ONE
- SN = ZERO
- GO TO 10
-*
- ELSE IF( B.EQ.ZERO ) THEN
-*
-* Swap rows and columns
-*
- CS = ZERO
- SN = ONE
- TEMP = D
- D = A
- A = TEMP
- B = -C
- C = ZERO
- GO TO 10
- ELSE IF( ( A-D ).EQ.ZERO .AND. SIGN( ONE, B ).NE.SIGN( ONE, C ) )
- $ THEN
- CS = ONE
- SN = ZERO
- GO TO 10
- ELSE
-*
- TEMP = A - D
- P = HALF*TEMP
- BCMAX = MAX( ABS( B ), ABS( C ) )
- BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
- SCALE = MAX( ABS( P ), BCMAX )
- Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
-*
-* If Z is of the order of the machine accuracy, postpone the
-* decision on the nature of eigenvalues
-*
- IF( Z.GE.MULTPL*EPS ) THEN
-*
-* Real eigenvalues. Compute A and D.
-*
- Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
- A = D + Z
- D = D - ( BCMAX / Z )*BCMIS
-*
-* Compute B and the rotation matrix
-*
- TAU = DLAPY2( C, Z )
- CS = Z / TAU
- SN = C / TAU
- B = B - C
- C = ZERO
- ELSE
-*
-* Complex eigenvalues, or real (almost) equal eigenvalues.
-* Make diagonal elements equal.
-*
- SIGMA = B + C
- TAU = DLAPY2( SIGMA, TEMP )
- CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
- SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
-*
-* Compute [ AA BB ] = [ A B ] [ CS -SN ]
-* [ CC DD ] [ C D ] [ SN CS ]
-*
- AA = A*CS + B*SN
- BB = -A*SN + B*CS
- CC = C*CS + D*SN
- DD = -C*SN + D*CS
-*
-* Compute [ A B ] = [ CS SN ] [ AA BB ]
-* [ C D ] [-SN CS ] [ CC DD ]
-*
- A = AA*CS + CC*SN
- B = BB*CS + DD*SN
- C = -AA*SN + CC*CS
- D = -BB*SN + DD*CS
-*
- TEMP = HALF*( A+D )
- A = TEMP
- D = TEMP
-*
- IF( C.NE.ZERO ) THEN
- IF( B.NE.ZERO ) THEN
- IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
-*
-* Real eigenvalues: reduce to upper triangular form
-*
- SAB = SQRT( ABS( B ) )
- SAC = SQRT( ABS( C ) )
- P = SIGN( SAB*SAC, C )
- TAU = ONE / SQRT( ABS( B+C ) )
- A = TEMP + P
- D = TEMP - P
- B = B - C
- C = ZERO
- CS1 = SAB*TAU
- SN1 = SAC*TAU
- TEMP = CS*CS1 - SN*SN1
- SN = CS*SN1 + SN*CS1
- CS = TEMP
- END IF
- ELSE
- B = -C
- C = ZERO
- TEMP = CS
- CS = -SN
- SN = TEMP
- END IF
- END IF
- END IF
-*
- END IF
-*
- 10 CONTINUE
-*
-* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
-*
- RT1R = A
- RT2R = D
- IF( C.EQ.ZERO ) THEN
- RT1I = ZERO
- RT2I = ZERO
- ELSE
- RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) )
- RT2I = -RT1I
- END IF
- RETURN
-*
-* End of DLANV2
-*
- END
diff --git a/netlib/LAPACK/dlapll.f b/netlib/LAPACK/dlapll.f
deleted file mode 100644
index 6c5cbed..0000000
--- a/netlib/LAPACK/dlapll.f
+++ /dev/null
@@ -1,165 +0,0 @@
-*> \brief \b DLAPLL measures the linear dependence of two vectors.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAPLL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapll.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapll.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapll.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAPLL( N, X, INCX, Y, INCY, SSMIN )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, INCY, N
-* DOUBLE PRECISION SSMIN
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given two column vectors X and Y, let
-*>
-*> A = ( X Y ).
-*>
-*> The subroutine first computes the QR factorization of A = Q*R,
-*> and then computes the SVD of the 2-by-2 upper triangular matrix R.
-*> The smaller singular value of R is returned in SSMIN, which is used
-*> as the measurement of the linear dependency of the vectors X and Y.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of the vectors X and Y.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCX)
-*> On entry, X contains the N-vector X.
-*> On exit, X is overwritten.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCY)
-*> On entry, Y contains the N-vector Y.
-*> On exit, Y is overwritten.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> The increment between successive elements of Y. INCY > 0.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is DOUBLE PRECISION
-*> The smallest singular value of the N-by-2 matrix A = ( X Y ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAPLL( N, X, INCX, Y, INCY, SSMIN )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, INCY, N
- DOUBLE PRECISION SSMIN
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION A11, A12, A22, C, SSMAX, TAU
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DDOT
- EXTERNAL DDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLARFG, DLAS2
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- SSMIN = ZERO
- RETURN
- END IF
-*
-* Compute the QR factorization of the N-by-2 matrix ( X Y )
-*
- CALL DLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
- A11 = X( 1 )
- X( 1 ) = ONE
-*
- C = -TAU*DDOT( N, X, INCX, Y, INCY )
- CALL DAXPY( N, C, X, INCX, Y, INCY )
-*
- CALL DLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
-*
- A12 = Y( 1 )
- A22 = Y( 1+INCY )
-*
-* Compute the SVD of 2-by-2 Upper triangular matrix.
-*
- CALL DLAS2( A11, A12, A22, SSMIN, SSMAX )
-*
- RETURN
-*
-* End of DLAPLL
-*
- END
diff --git a/netlib/LAPACK/dlapmr.f b/netlib/LAPACK/dlapmr.f
deleted file mode 100644
index f228c3e..0000000
--- a/netlib/LAPACK/dlapmr.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DLAPMR rearranges rows of a matrix as specified by a permutation vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAPMR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapmr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapmr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapmr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
-*
-* .. Scalar Arguments ..
-* LOGICAL FORWRD
-* INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER K( * )
-* DOUBLE PRECISION X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAPMR rearranges the rows of the M by N matrix X as specified
-*> by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
-*> If FORWRD = .TRUE., forward permutation:
-*>
-*> X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
-*>
-*> If FORWRD = .FALSE., backward permutation:
-*>
-*> X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FORWRD
-*> \verbatim
-*> FORWRD is LOGICAL
-*> = .TRUE., forward permutation
-*> = .FALSE., backward permutation
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,N)
-*> On entry, the M by N matrix X.
-*> On exit, X contains the permuted matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X, LDX >= MAX(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] K
-*> \verbatim
-*> K is INTEGER array, dimension (M)
-*> On entry, K contains the permutation vector. K is used as
-*> internal workspace, but reset to its original value on
-*> output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL FORWRD
- INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
- INTEGER K( * )
- DOUBLE PRECISION X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IN, J, JJ
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
- IF( M.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, M
- K( I ) = -K( I )
- 10 CONTINUE
-*
- IF( FORWRD ) THEN
-*
-* Forward permutation
-*
- DO 50 I = 1, M
-*
- IF( K( I ).GT.0 )
- $ GO TO 40
-*
- J = I
- K( J ) = -K( J )
- IN = K( J )
-*
- 20 CONTINUE
- IF( K( IN ).GT.0 )
- $ GO TO 40
-*
- DO 30 JJ = 1, N
- TEMP = X( J, JJ )
- X( J, JJ ) = X( IN, JJ )
- X( IN, JJ ) = TEMP
- 30 CONTINUE
-*
- K( IN ) = -K( IN )
- J = IN
- IN = K( IN )
- GO TO 20
-*
- 40 CONTINUE
-*
- 50 CONTINUE
-*
- ELSE
-*
-* Backward permutation
-*
- DO 90 I = 1, M
-*
- IF( K( I ).GT.0 )
- $ GO TO 80
-*
- K( I ) = -K( I )
- J = K( I )
- 60 CONTINUE
- IF( J.EQ.I )
- $ GO TO 80
-*
- DO 70 JJ = 1, N
- TEMP = X( I, JJ )
- X( I, JJ ) = X( J, JJ )
- X( J, JJ ) = TEMP
- 70 CONTINUE
-*
- K( J ) = -K( J )
- J = K( J )
- GO TO 60
-*
- 80 CONTINUE
-*
- 90 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of ZLAPMT
-*
- END
-
diff --git a/netlib/LAPACK/dlapmt.f b/netlib/LAPACK/dlapmt.f
deleted file mode 100644
index 9c01fbc..0000000
--- a/netlib/LAPACK/dlapmt.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b DLAPMT performs a forward or backward permutation of the columns of a matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAPMT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapmt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapmt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapmt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
-*
-* .. Scalar Arguments ..
-* LOGICAL FORWRD
-* INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER K( * )
-* DOUBLE PRECISION X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAPMT rearranges the columns of the M by N matrix X as specified
-*> by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
-*> If FORWRD = .TRUE., forward permutation:
-*>
-*> X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
-*>
-*> If FORWRD = .FALSE., backward permutation:
-*>
-*> X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FORWRD
-*> \verbatim
-*> FORWRD is LOGICAL
-*> = .TRUE., forward permutation
-*> = .FALSE., backward permutation
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,N)
-*> On entry, the M by N matrix X.
-*> On exit, X contains the permuted matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X, LDX >= MAX(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] K
-*> \verbatim
-*> K is INTEGER array, dimension (N)
-*> On entry, K contains the permutation vector. K is used as
-*> internal workspace, but reset to its original value on
-*> output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL FORWRD
- INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
- INTEGER K( * )
- DOUBLE PRECISION X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, II, IN, J
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, N
- K( I ) = -K( I )
- 10 CONTINUE
-*
- IF( FORWRD ) THEN
-*
-* Forward permutation
-*
- DO 50 I = 1, N
-*
- IF( K( I ).GT.0 )
- $ GO TO 40
-*
- J = I
- K( J ) = -K( J )
- IN = K( J )
-*
- 20 CONTINUE
- IF( K( IN ).GT.0 )
- $ GO TO 40
-*
- DO 30 II = 1, M
- TEMP = X( II, J )
- X( II, J ) = X( II, IN )
- X( II, IN ) = TEMP
- 30 CONTINUE
-*
- K( IN ) = -K( IN )
- J = IN
- IN = K( IN )
- GO TO 20
-*
- 40 CONTINUE
-*
- 50 CONTINUE
-*
- ELSE
-*
-* Backward permutation
-*
- DO 90 I = 1, N
-*
- IF( K( I ).GT.0 )
- $ GO TO 80
-*
- K( I ) = -K( I )
- J = K( I )
- 60 CONTINUE
- IF( J.EQ.I )
- $ GO TO 80
-*
- DO 70 II = 1, M
- TEMP = X( II, I )
- X( II, I ) = X( II, J )
- X( II, J ) = TEMP
- 70 CONTINUE
-*
- K( J ) = -K( J )
- J = K( J )
- GO TO 60
-*
- 80 CONTINUE
-*
- 90 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of DLAPMT
-*
- END
diff --git a/netlib/LAPACK/dlapy2.f b/netlib/LAPACK/dlapy2.f
deleted file mode 100644
index d43b0d5..0000000
--- a/netlib/LAPACK/dlapy2.f
+++ /dev/null
@@ -1,104 +0,0 @@
-*> \brief \b DLAPY2 returns sqrt(x2+y2).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAPY2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION X, Y
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
-*> overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION
-*> X and Y specify the values x and y.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION X, Y
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION W, XABS, YABS, Z
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- XABS = ABS( X )
- YABS = ABS( Y )
- W = MAX( XABS, YABS )
- Z = MIN( XABS, YABS )
- IF( Z.EQ.ZERO ) THEN
- DLAPY2 = W
- ELSE
- DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
- END IF
- RETURN
-*
-* End of DLAPY2
-*
- END
diff --git a/netlib/LAPACK/dlapy3.f b/netlib/LAPACK/dlapy3.f
deleted file mode 100644
index 23feecc..0000000
--- a/netlib/LAPACK/dlapy3.f
+++ /dev/null
@@ -1,111 +0,0 @@
-*> \brief \b DLAPY3 returns sqrt(x2+y2+z2).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAPY3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION X, Y, Z
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
-*> unnecessary overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION
-*> X, Y and Z specify the values x, y and z.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION X, Y, Z
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION W, XABS, YABS, ZABS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- XABS = ABS( X )
- YABS = ABS( Y )
- ZABS = ABS( Z )
- W = MAX( XABS, YABS, ZABS )
- IF( W.EQ.ZERO ) THEN
-* W can be zero for max(0,nan,0)
-* adding all three entries together will make sure
-* NaN will not disappear.
- DLAPY3 = XABS + YABS + ZABS
- ELSE
- DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
- $ ( ZABS / W )**2 )
- END IF
- RETURN
-*
-* End of DLAPY3
-*
- END
diff --git a/netlib/LAPACK/dlaqgb.f b/netlib/LAPACK/dlaqgb.f
deleted file mode 100644
index d5c2f47..0000000
--- a/netlib/LAPACK/dlaqgb.f
+++ /dev/null
@@ -1,256 +0,0 @@
-*> \brief \b DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQGB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqgb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqgb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqgb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED
-* INTEGER KL, KU, LDAB, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQGB equilibrates a general M by N band matrix A with KL
-*> subdiagonals and KU superdiagonals using the row and scaling factors
-*> in the vectors R and C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, the equilibrated matrix, in the same storage format
-*> as A. See EQUED for the form of the equilibrated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDA >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> The row scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> Ratio of the smallest R(i) to the largest R(i).
-*> \endverbatim
-*>
-*> \param[in] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> Ratio of the smallest C(i) to the largest C(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if row or column scaling
-*> should be done based on the ratio of the row or column scaling
-*> factors. If ROWCND < THRESH, row scaling is done, and if
-*> COLCND < THRESH, column scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if row scaling
-*> should be done based on the absolute size of the largest matrix
-*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGBauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED
- INTEGER KL, KU, LDAB, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
- $ THEN
-*
-* No row scaling
-*
- IF( COLCND.GE.THRESH ) THEN
-*
-* No column scaling
-*
- EQUED = 'N'
- ELSE
-*
-* Column scaling
-*
- DO 20 J = 1, N
- CJ = C( J )
- DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
- 10 CONTINUE
- 20 CONTINUE
- EQUED = 'C'
- END IF
- ELSE IF( COLCND.GE.THRESH ) THEN
-*
-* Row scaling, no column scaling
-*
- DO 40 J = 1, N
- DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
- 30 CONTINUE
- 40 CONTINUE
- EQUED = 'R'
- ELSE
-*
-* Row and column scaling
-*
- DO 60 J = 1, N
- CJ = C( J )
- DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
- 50 CONTINUE
- 60 CONTINUE
- EQUED = 'B'
- END IF
-*
- RETURN
-*
-* End of DLAQGB
-*
- END
diff --git a/netlib/LAPACK/dlaqge.f b/netlib/LAPACK/dlaqge.f
deleted file mode 100644
index 6e4f039..0000000
--- a/netlib/LAPACK/dlaqge.f
+++ /dev/null
@@ -1,236 +0,0 @@
-*> \brief \b DLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQGE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqge.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqge.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqge.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED
-* INTEGER LDA, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQGE equilibrates a general M by N matrix A using the row and
-*> column scaling factors in the vectors R and C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M by N matrix A.
-*> On exit, the equilibrated matrix. See EQUED for the form of
-*> the equilibrated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> The row scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> Ratio of the smallest R(i) to the largest R(i).
-*> \endverbatim
-*>
-*> \param[in] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> Ratio of the smallest C(i) to the largest C(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if row or column scaling
-*> should be done based on the ratio of the row or column scaling
-*> factors. If ROWCND < THRESH, row scaling is done, and if
-*> COLCND < THRESH, column scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if row scaling
-*> should be done based on the absolute size of the largest matrix
-*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED
- INTEGER LDA, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
- $ THEN
-*
-* No row scaling
-*
- IF( COLCND.GE.THRESH ) THEN
-*
-* No column scaling
-*
- EQUED = 'N'
- ELSE
-*
-* Column scaling
-*
- DO 20 J = 1, N
- CJ = C( J )
- DO 10 I = 1, M
- A( I, J ) = CJ*A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- EQUED = 'C'
- END IF
- ELSE IF( COLCND.GE.THRESH ) THEN
-*
-* Row scaling, no column scaling
-*
- DO 40 J = 1, N
- DO 30 I = 1, M
- A( I, J ) = R( I )*A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- EQUED = 'R'
- ELSE
-*
-* Row and column scaling
-*
- DO 60 J = 1, N
- CJ = C( J )
- DO 50 I = 1, M
- A( I, J ) = CJ*R( I )*A( I, J )
- 50 CONTINUE
- 60 CONTINUE
- EQUED = 'B'
- END IF
-*
- RETURN
-*
-* End of DLAQGE
-*
- END
diff --git a/netlib/LAPACK/dlaqp2.f b/netlib/LAPACK/dlaqp2.f
deleted file mode 100644
index 0c04436..0000000
--- a/netlib/LAPACK/dlaqp2.f
+++ /dev/null
@@ -1,262 +0,0 @@
-*> \brief \b DLAQP2 computes a QR factorization with column pivoting of the matrix block.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQP2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqp2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqp2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqp2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
-* WORK )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, M, N, OFFSET
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQP2 computes a QR factorization with column pivoting of
-*> the block A(OFFSET+1:M,1:N).
-*> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> The number of rows of the matrix A that must be pivoted
-*> but no factorized. OFFSET >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
-*> the triangular factor obtained; the elements in block
-*> A(OFFSET+1:M,1:N) below the diagonal, together with the
-*> array TAU, represent the orthogonal matrix Q as a product of
-*> elementary reflectors. Block A(1:OFFSET,1:N) has been
-*> accordingly pivoted, but no factorized.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*> to the front of A*P (a leading column); if JPVT(i) = 0,
-*> the i-th column of A is a free column.
-*> On exit, if JPVT(i) = k, then the i-th column of A*P
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in,out] VN1
-*> \verbatim
-*> VN1 is DOUBLE PRECISION array, dimension (N)
-*> The vector with the partial column norms.
-*> \endverbatim
-*>
-*> \param[in,out] VN2
-*> \verbatim
-*> VN2 is DOUBLE PRECISION array, dimension (N)
-*> The vector with the exact column norms.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*> X. Sun, Computer Science Dept., Duke University, USA
-*> \n
-*> Partial column norm updating strategy modified on April 2011
-*> Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*> University of Zagreb, Croatia.
-*
-*> \par References:
-* ================
-*>
-*> LAPACK Working Note 176
-*
-*> \htmlonly
-*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a>
-*> \endhtmlonly
-*
-* =====================================================================
- SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, M, N, OFFSET
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- DOUBLE PRECISION A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ITEMP, J, MN, OFFPI, PVT
- DOUBLE PRECISION AII, TEMP, TEMP2, TOL3Z
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, DSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DNRM2
- EXTERNAL IDAMAX, DLAMCH, DNRM2
-* ..
-* .. Executable Statements ..
-*
- MN = MIN( M-OFFSET, N )
- TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-* Compute factorization.
-*
- DO 20 I = 1, MN
-*
- OFFPI = OFFSET + I
-*
-* Determine ith pivot column and swap if necessary.
-*
- PVT = ( I-1 ) + IDAMAX( N-I+1, VN1( I ), 1 )
-*
- IF( PVT.NE.I ) THEN
- CALL DSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
- ITEMP = JPVT( PVT )
- JPVT( PVT ) = JPVT( I )
- JPVT( I ) = ITEMP
- VN1( PVT ) = VN1( I )
- VN2( PVT ) = VN2( I )
- END IF
-*
-* Generate elementary reflector H(i).
-*
- IF( OFFPI.LT.M ) THEN
- CALL DLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1,
- $ TAU( I ) )
- ELSE
- CALL DLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) )
- END IF
-*
- IF( I.LE.N ) THEN
-*
-* Apply H(i)**T to A(offset+i:m,i+1:n) from the left.
-*
- AII = A( OFFPI, I )
- A( OFFPI, I ) = ONE
- CALL DLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
- $ TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) )
- A( OFFPI, I ) = AII
- END IF
-*
-* Update partial column norms.
-*
- DO 10 J = I + 1, N
- IF( VN1( J ).NE.ZERO ) THEN
-*
-* NOTE: The following 4 lines follow from the analysis in
-* Lapack Working Note 176.
-*
- TEMP = ONE - ( ABS( A( OFFPI, J ) ) / VN1( J ) )**2
- TEMP = MAX( TEMP, ZERO )
- TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
- IF( TEMP2 .LE. TOL3Z ) THEN
- IF( OFFPI.LT.M ) THEN
- VN1( J ) = DNRM2( M-OFFPI, A( OFFPI+1, J ), 1 )
- VN2( J ) = VN1( J )
- ELSE
- VN1( J ) = ZERO
- VN2( J ) = ZERO
- END IF
- ELSE
- VN1( J ) = VN1( J )*SQRT( TEMP )
- END IF
- END IF
- 10 CONTINUE
-*
- 20 CONTINUE
-*
- RETURN
-*
-* End of DLAQP2
-*
- END
diff --git a/netlib/LAPACK/dlaqps.f b/netlib/LAPACK/dlaqps.f
deleted file mode 100644
index 2521bf6..0000000
--- a/netlib/LAPACK/dlaqps.f
+++ /dev/null
@@ -1,358 +0,0 @@
-*> \brief \b DLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQPS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqps.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqps.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqps.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
-* VN2, AUXV, F, LDF )
-*
-* .. Scalar Arguments ..
-* INTEGER KB, LDA, LDF, M, N, NB, OFFSET
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* DOUBLE PRECISION A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
-* $ VN1( * ), VN2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQPS computes a step of QR factorization with column pivoting
-*> of a real M-by-N matrix A by using Blas-3. It tries to factorize
-*> NB columns from A starting from the row OFFSET+1, and updates all
-*> of the matrix with Blas-3 xGEMM.
-*>
-*> In some cases, due to catastrophic cancellations, it cannot
-*> factorize NB columns. Hence, the actual number of factorized
-*> columns is returned in KB.
-*>
-*> Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> The number of rows of A that have been factorized in
-*> previous steps.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to factorize.
-*> \endverbatim
-*>
-*> \param[out] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of columns actually factorized.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, block A(OFFSET+1:M,1:KB) is the triangular
-*> factor obtained and block A(1:OFFSET,1:N) has been
-*> accordingly pivoted, but no factorized.
-*> The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
-*> been updated.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> JPVT(I) = K <==> Column K of the full matrix A has been
-*> permuted into position I in AP.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (KB)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in,out] VN1
-*> \verbatim
-*> VN1 is DOUBLE PRECISION array, dimension (N)
-*> The vector with the partial column norms.
-*> \endverbatim
-*>
-*> \param[in,out] VN2
-*> \verbatim
-*> VN2 is DOUBLE PRECISION array, dimension (N)
-*> The vector with the exact column norms.
-*> \endverbatim
-*>
-*> \param[in,out] AUXV
-*> \verbatim
-*> AUXV is DOUBLE PRECISION array, dimension (NB)
-*> Auxiliar vector.
-*> \endverbatim
-*>
-*> \param[in,out] F
-*> \verbatim
-*> F is DOUBLE PRECISION array, dimension (LDF,NB)
-*> Matrix F**T = L*Y**T*A.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of the array F. LDF >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*> X. Sun, Computer Science Dept., Duke University, USA
-*> \n
-*> Partial column norm updating strategy modified on April 2011
-*> Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*> University of Zagreb, Croatia.
-*
-*> \par References:
-* ================
-*>
-*> LAPACK Working Note 176
-*
-*> \htmlonly
-*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a>
-*> \endhtmlonly
-*
-* =====================================================================
- SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
- $ VN2, AUXV, F, LDF )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER KB, LDA, LDF, M, N, NB, OFFSET
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- DOUBLE PRECISION A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
- $ VN1( * ), VN2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER ITEMP, J, K, LASTRK, LSTICC, PVT, RK
- DOUBLE PRECISION AKK, TEMP, TEMP2, TOL3Z
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGEMV, DLARFG, DSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, NINT, SQRT
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DNRM2
- EXTERNAL IDAMAX, DLAMCH, DNRM2
-* ..
-* .. Executable Statements ..
-*
- LASTRK = MIN( M, N+OFFSET )
- LSTICC = 0
- K = 0
- TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-* Beginning of while loop.
-*
- 10 CONTINUE
- IF( ( K.LT.NB ) .AND. ( LSTICC.EQ.0 ) ) THEN
- K = K + 1
- RK = OFFSET + K
-*
-* Determine ith pivot column and swap if necessary
-*
- PVT = ( K-1 ) + IDAMAX( N-K+1, VN1( K ), 1 )
- IF( PVT.NE.K ) THEN
- CALL DSWAP( M, A( 1, PVT ), 1, A( 1, K ), 1 )
- CALL DSWAP( K-1, F( PVT, 1 ), LDF, F( K, 1 ), LDF )
- ITEMP = JPVT( PVT )
- JPVT( PVT ) = JPVT( K )
- JPVT( K ) = ITEMP
- VN1( PVT ) = VN1( K )
- VN2( PVT ) = VN2( K )
- END IF
-*
-* Apply previous Householder reflectors to column K:
-* A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)**T.
-*
- IF( K.GT.1 ) THEN
- CALL DGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, 1 ),
- $ LDA, F( K, 1 ), LDF, ONE, A( RK, K ), 1 )
- END IF
-*
-* Generate elementary reflector H(k).
-*
- IF( RK.LT.M ) THEN
- CALL DLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) )
- ELSE
- CALL DLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) )
- END IF
-*
- AKK = A( RK, K )
- A( RK, K ) = ONE
-*
-* Compute Kth column of F:
-*
-* Compute F(K+1:N,K) := tau(K)*A(RK:M,K+1:N)**T*A(RK:M,K).
-*
- IF( K.LT.N ) THEN
- CALL DGEMV( 'Transpose', M-RK+1, N-K, TAU( K ),
- $ A( RK, K+1 ), LDA, A( RK, K ), 1, ZERO,
- $ F( K+1, K ), 1 )
- END IF
-*
-* Padding F(1:K,K) with zeros.
-*
- DO 20 J = 1, K
- F( J, K ) = ZERO
- 20 CONTINUE
-*
-* Incremental updating of F:
-* F(1:N,K) := F(1:N,K) - tau(K)*F(1:N,1:K-1)*A(RK:M,1:K-1)**T
-* *A(RK:M,K).
-*
- IF( K.GT.1 ) THEN
- CALL DGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, 1 ),
- $ LDA, A( RK, K ), 1, ZERO, AUXV( 1 ), 1 )
-*
- CALL DGEMV( 'No transpose', N, K-1, ONE, F( 1, 1 ), LDF,
- $ AUXV( 1 ), 1, ONE, F( 1, K ), 1 )
- END IF
-*
-* Update the current row of A:
-* A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**T.
-*
- IF( K.LT.N ) THEN
- CALL DGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), LDF,
- $ A( RK, 1 ), LDA, ONE, A( RK, K+1 ), LDA )
- END IF
-*
-* Update partial column norms.
-*
- IF( RK.LT.LASTRK ) THEN
- DO 30 J = K + 1, N
- IF( VN1( J ).NE.ZERO ) THEN
-*
-* NOTE: The following 4 lines follow from the analysis in
-* Lapack Working Note 176.
-*
- TEMP = ABS( A( RK, J ) ) / VN1( J )
- TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
- TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
- IF( TEMP2 .LE. TOL3Z ) THEN
- VN2( J ) = DBLE( LSTICC )
- LSTICC = J
- ELSE
- VN1( J ) = VN1( J )*SQRT( TEMP )
- END IF
- END IF
- 30 CONTINUE
- END IF
-*
- A( RK, K ) = AKK
-*
-* End of while loop.
-*
- GO TO 10
- END IF
- KB = K
- RK = OFFSET + KB
-*
-* Apply the block reflector to the rest of the matrix:
-* A(OFFSET+KB+1:M,KB+1:N) := A(OFFSET+KB+1:M,KB+1:N) -
-* A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**T.
-*
- IF( KB.LT.MIN( N, M-OFFSET ) ) THEN
- CALL DGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, -ONE,
- $ A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, ONE,
- $ A( RK+1, KB+1 ), LDA )
- END IF
-*
-* Recomputation of difficult columns.
-*
- 40 CONTINUE
- IF( LSTICC.GT.0 ) THEN
- ITEMP = NINT( VN2( LSTICC ) )
- VN1( LSTICC ) = DNRM2( M-RK, A( RK+1, LSTICC ), 1 )
-*
-* NOTE: The computation of VN1( LSTICC ) relies on the fact that
-* SNRM2 does not fail on vectors with norm below the value of
-* SQRT(DLAMCH('S'))
-*
- VN2( LSTICC ) = VN1( LSTICC )
- LSTICC = ITEMP
- GO TO 40
- END IF
-*
- RETURN
-*
-* End of DLAQPS
-*
- END
diff --git a/netlib/LAPACK/dlaqr0.f b/netlib/LAPACK/dlaqr0.f
deleted file mode 100644
index 2a3b1db..0000000
--- a/netlib/LAPACK/dlaqr0.f
+++ /dev/null
@@ -1,740 +0,0 @@
-*> \brief \b DLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQR0 computes the eigenvalues of a Hessenberg matrix H
-*> and, optionally, the matrices T and Z from the Schur decomposition
-*> H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*> Schur form), and Z is the orthogonal matrix of Schur vectors.
-*>
-*> Optionally Z may be postmultiplied into an input orthogonal
-*> matrix Q so that this routine can give the Schur factorization
-*> of a matrix A which has been reduced to the Hessenberg form H
-*> by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*> previous call to DGEBAL, and then passed to DGEHRD when the
-*> matrix output by DGEBAL is reduced to Hessenberg form.
-*> Otherwise, ILO and IHI should be set to 1 and N,
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*> the upper quasi-triangular matrix T from the Schur
-*> decomposition (the Schur form); 2-by-2 diagonal blocks
-*> (corresponding to complex conjugate pairs of eigenvalues)
-*> are returned in standard form, with H(i,i) = H(i+1,i+1)
-*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*> .FALSE., then the contents of H are unspecified on exit.
-*> (The output value of H when INFO.GT.0 is given under the
-*> description of INFO below.)
-*>
-*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (IHI)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (IHI)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI)
-*> and WI(ILO:IHI). If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*> the eigenvalues are stored in the same order as on the
-*> diagonal of the Schur form returned in H, with
-*> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*> block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,IHI)
-*> If WANTZ is .FALSE., then Z is not referenced.
-*> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*> orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*> (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if WANTZ is .TRUE.
-*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension LWORK
-*> On exit, if LWORK = -1, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient, but LWORK typically as large as 6*N may
-*> be required for optimal performance. A workspace query
-*> to determine the optimal workspace size is recommended.
-*>
-*> If LWORK = -1, then DLAQR0 does a workspace query.
-*> In this case, DLAQR0 checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: if INFO = i, DLAQR0 failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is an orthogonal matrix. The final
-*> value of H is upper Hessenberg and quasi-triangular
-*> in rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*>
-*> (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of WANTT.)
-*>
-*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*> accessed.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-*
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . DLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== Exceptional deflation windows: try to cure rare
-* . slow convergence by varying the size of the
-* . deflation window after KEXNW iterations. ====
- INTEGER KEXNW
- PARAMETER ( KEXNW = 5 )
-*
-* ==== Exceptional shifts: try to cure rare slow convergence
-* . with ad-hoc exceptional shifts every KEXSH iterations.
-* . ====
- INTEGER KEXSH
- PARAMETER ( KEXSH = 6 )
-*
-* ==== The constants WILK1 and WILK2 are used to form the
-* . exceptional shifts. ====
- DOUBLE PRECISION WILK1, WILK2
- PARAMETER ( WILK1 = 0.75d0, WILK2 = -0.4375d0 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, CC, CS, DD, SN, SS, SWAP
- INTEGER I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
- $ KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
- $ LWKOPT, NDEC, NDFL, NH, NHO, NIBBLE, NMIN, NS,
- $ NSMAX, NSR, NVE, NW, NWMAX, NWR, NWUPBD
- LOGICAL SORTED
- CHARACTER JBCMPZ*2
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION ZDUM( 1, 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR3, DLAQR4, DLAQR5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD
-* ..
-* .. Executable Statements ..
- INFO = 0
-*
-* ==== Quick return for N = 0: nothing to do. ====
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
- IF( N.LE.NTINY ) THEN
-*
-* ==== Tiny matrices must use DLAHQR. ====
-*
- LWKOPT = 1
- IF( LWORK.NE.-1 )
- $ CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
- ELSE
-*
-* ==== Use small bulge multi-shift QR with aggressive early
-* . deflation on larger-than-tiny matrices. ====
-*
-* ==== Hope for the best. ====
-*
- INFO = 0
-*
-* ==== Set up job flags for ILAENV. ====
-*
- IF( WANTT ) THEN
- JBCMPZ( 1: 1 ) = 'S'
- ELSE
- JBCMPZ( 1: 1 ) = 'E'
- END IF
- IF( WANTZ ) THEN
- JBCMPZ( 2: 2 ) = 'V'
- ELSE
- JBCMPZ( 2: 2 ) = 'N'
- END IF
-*
-* ==== NWR = recommended deflation window size. At this
-* . point, N .GT. NTINY = 11, so there is enough
-* . subdiagonal workspace for NWR.GE.2 as required.
-* . (In fact, there is enough subdiagonal space for
-* . NWR.GE.3.) ====
-*
- NWR = ILAENV( 13, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NWR = MAX( 2, NWR )
- NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-*
-* ==== NSR = recommended number of simultaneous shifts.
-* . At this point N .GT. NTINY = 11, so there is at
-* . enough subdiagonal workspace for NSR to be even
-* . and greater than or equal to two as required. ====
-*
- NSR = ILAENV( 15, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
- NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-* ==== Estimate optimal workspace ====
-*
-* ==== Workspace query call to DLAQR3 ====
-*
- CALL DLAQR3( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
- $ N, H, LDH, WORK, -1 )
-*
-* ==== Optimal workspace = MAX(DLAQR5, DLAQR3) ====
-*
- LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== DLAHQR/DLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== Nibble crossover point ====
-*
- NIBBLE = ILAENV( 14, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NIBBLE = MAX( 0, NIBBLE )
-*
-* ==== Accumulate reflections during ttswp? Use block
-* . 2-by-2 structure during matrix-matrix multiply? ====
-*
- KACC22 = ILAENV( 16, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- KACC22 = MAX( 0, KACC22 )
- KACC22 = MIN( 2, KACC22 )
-*
-* ==== NWMAX = the largest possible deflation window for
-* . which there is sufficient workspace. ====
-*
- NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
- NW = NWMAX
-*
-* ==== NSMAX = the Largest number of simultaneous shifts
-* . for which there is sufficient workspace. ====
-*
- NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
- NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-* ==== NDFL: an iteration count restarted at deflation. ====
-*
- NDFL = 1
-*
-* ==== ITMAX = iteration limit ====
-*
- ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-* ==== Last row and column in the active block ====
-*
- KBOT = IHI
-*
-* ==== Main Loop ====
-*
- DO 80 IT = 1, ITMAX
-*
-* ==== Done when KBOT falls below ILO ====
-*
- IF( KBOT.LT.ILO )
- $ GO TO 90
-*
-* ==== Locate active block ====
-*
- DO 10 K = KBOT, ILO + 1, -1
- IF( H( K, K-1 ).EQ.ZERO )
- $ GO TO 20
- 10 CONTINUE
- K = ILO
- 20 CONTINUE
- KTOP = K
-*
-* ==== Select deflation window size:
-* . Typical Case:
-* . If possible and advisable, nibble the entire
-* . active block. If not, use size MIN(NWR,NWMAX)
-* . or MIN(NWR+1,NWMAX) depending upon which has
-* . the smaller corresponding subdiagonal entry
-* . (a heuristic).
-* .
-* . Exceptional Case:
-* . If there have been no deflations in KEXNW or
-* . more iterations, then vary the deflation window
-* . size. At first, because, larger windows are,
-* . in general, more powerful than smaller ones,
-* . rapidly increase the window to the maximum possible.
-* . Then, gradually reduce the window size. ====
-*
- NH = KBOT - KTOP + 1
- NWUPBD = MIN( NH, NWMAX )
- IF( NDFL.LT.KEXNW ) THEN
- NW = MIN( NWUPBD, NWR )
- ELSE
- NW = MIN( NWUPBD, 2*NW )
- END IF
- IF( NW.LT.NWMAX ) THEN
- IF( NW.GE.NH-1 ) THEN
- NW = NH
- ELSE
- KWTOP = KBOT - NW + 1
- IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
- $ ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
- END IF
- END IF
- IF( NDFL.LT.KEXNW ) THEN
- NDEC = -1
- ELSE IF( NDEC.GE.0 .OR. NW.GE.NWUPBD ) THEN
- NDEC = NDEC + 1
- IF( NW-NDEC.LT.2 )
- $ NDEC = 0
- NW = NW - NDEC
- END IF
-*
-* ==== Aggressive early deflation:
-* . split workspace under the subdiagonal into
-* . - an nw-by-nw work array V in the lower
-* . left-hand-corner,
-* . - an NW-by-at-least-NW-but-more-is-better
-* . (NW-by-NHO) horizontal work array along
-* . the bottom edge,
-* . - an at-least-NW-but-more-is-better (NHV-by-NW)
-* . vertical work array along the left-hand-edge.
-* . ====
-*
- KV = N - NW + 1
- KT = NW + 1
- NHO = ( N-NW-1 ) - KT + 1
- KWV = NW + 2
- NVE = ( N-NW ) - KWV + 1
-*
-* ==== Aggressive early deflation ====
-*
- CALL DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
- $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
- $ WORK, LWORK )
-*
-* ==== Adjust KBOT accounting for new deflations. ====
-*
- KBOT = KBOT - LD
-*
-* ==== KS points to the shifts. ====
-*
- KS = KBOT - LS + 1
-*
-* ==== Skip an expensive QR sweep if there is a (partly
-* . heuristic) reason to expect that many eigenvalues
-* . will deflate without it. Here, the QR sweep is
-* . skipped if many eigenvalues have just been deflated
-* . or if the remaining active block is small.
-*
- IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
- $ KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-* ==== NS = nominal number of simultaneous shifts.
-* . This may be lowered (slightly) if DLAQR3
-* . did not provide that many shifts. ====
-*
- NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
- NS = NS - MOD( NS, 2 )
-*
-* ==== If there have been no deflations
-* . in a multiple of KEXSH iterations,
-* . then try exceptional shifts.
-* . Otherwise use shifts provided by
-* . DLAQR3 above or from the eigenvalues
-* . of a trailing principal submatrix. ====
-*
- IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
- KS = KBOT - NS + 1
- DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
- SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- AA = WILK1*SS + H( I, I )
- BB = SS
- CC = WILK2*SS
- DD = AA
- CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
- $ WR( I ), WI( I ), CS, SN )
- 30 CONTINUE
- IF( KS.EQ.KTOP ) THEN
- WR( KS+1 ) = H( KS+1, KS+1 )
- WI( KS+1 ) = ZERO
- WR( KS ) = WR( KS+1 )
- WI( KS ) = WI( KS+1 )
- END IF
- ELSE
-*
-* ==== Got NS/2 or fewer shifts? Use DLAQR4 or
-* . DLAHQR on a trailing principal submatrix to
-* . get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-* . there is enough space below the subdiagonal
-* . to fit an NS-by-NS scratch array.) ====
-*
- IF( KBOT-KS+1.LE.NS / 2 ) THEN
- KS = KBOT - NS + 1
- KT = N - NS + 1
- CALL DLACPY( 'A', NS, NS, H( KS, KS ), LDH,
- $ H( KT, 1 ), LDH )
- IF( NS.GT.NMIN ) THEN
- CALL DLAQR4( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ),
- $ WI( KS ), 1, 1, ZDUM, 1, WORK,
- $ LWORK, INF )
- ELSE
- CALL DLAHQR( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ),
- $ WI( KS ), 1, 1, ZDUM, 1, INF )
- END IF
- KS = KS + INF
-*
-* ==== In case of a rare QR failure use
-* . eigenvalues of the trailing 2-by-2
-* . principal submatrix. ====
-*
- IF( KS.GE.KBOT ) THEN
- AA = H( KBOT-1, KBOT-1 )
- CC = H( KBOT, KBOT-1 )
- BB = H( KBOT-1, KBOT )
- DD = H( KBOT, KBOT )
- CALL DLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
- $ WI( KBOT-1 ), WR( KBOT ),
- $ WI( KBOT ), CS, SN )
- KS = KBOT - 1
- END IF
- END IF
-*
- IF( KBOT-KS+1.GT.NS ) THEN
-*
-* ==== Sort the shifts (Helps a little)
-* . Bubble sort keeps complex conjugate
-* . pairs together. ====
-*
- SORTED = .false.
- DO 50 K = KBOT, KS + 1, -1
- IF( SORTED )
- $ GO TO 60
- SORTED = .true.
- DO 40 I = KS, K - 1
- IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
- $ ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
- SORTED = .false.
-*
- SWAP = WR( I )
- WR( I ) = WR( I+1 )
- WR( I+1 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I+1 )
- WI( I+1 ) = SWAP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* ==== Shuffle shifts into pairs of real shifts
-* . and pairs of complex conjugate shifts
-* . assuming complex conjugate shifts are
-* . already adjacent to one another. (Yes,
-* . they are.) ====
-*
- DO 70 I = KBOT, KS + 2, -2
- IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
- SWAP = WR( I )
- WR( I ) = WR( I-1 )
- WR( I-1 ) = WR( I-2 )
- WR( I-2 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I-1 )
- WI( I-1 ) = WI( I-2 )
- WI( I-2 ) = SWAP
- END IF
- 70 CONTINUE
- END IF
-*
-* ==== If there are only two shifts and both are
-* . real, then use only one. ====
-*
- IF( KBOT-KS+1.EQ.2 ) THEN
- IF( WI( KBOT ).EQ.ZERO ) THEN
- IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
- $ ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
- WR( KBOT-1 ) = WR( KBOT )
- ELSE
- WR( KBOT ) = WR( KBOT-1 )
- END IF
- END IF
- END IF
-*
-* ==== Use up to NS of the the smallest magnatiude
-* . shifts. If there aren't NS shifts available,
-* . then use them all, possibly dropping one to
-* . make the number of shifts even. ====
-*
- NS = MIN( NS, KBOT-KS+1 )
- NS = NS - MOD( NS, 2 )
- KS = KBOT - NS + 1
-*
-* ==== Small-bulge multi-shift QR sweep:
-* . split workspace under the subdiagonal into
-* . - a KDU-by-KDU work array U in the lower
-* . left-hand-corner,
-* . - a KDU-by-at-least-KDU-but-more-is-better
-* . (KDU-by-NHo) horizontal work array WH along
-* . the bottom edge,
-* . - and an at-least-KDU-but-more-is-better-by-KDU
-* . (NVE-by-KDU) vertical work WV arrow along
-* . the left-hand-edge. ====
-*
- KDU = 3*NS - 3
- KU = N - KDU + 1
- KWH = KDU + 1
- NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
- KWV = KDU + 4
- NVE = N - KDU - KWV + 1
-*
-* ==== Small-bulge multi-shift QR sweep ====
-*
- CALL DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
- $ WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
- $ LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
- $ H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
- END IF
-*
-* ==== Note progress (or the lack of it). ====
-*
- IF( LD.GT.0 ) THEN
- NDFL = 1
- ELSE
- NDFL = NDFL + 1
- END IF
-*
-* ==== End of main loop ====
- 80 CONTINUE
-*
-* ==== Iteration limit exceeded. Set INFO to show where
-* . the problem occurred and exit. ====
-*
- INFO = KBOT
- 90 CONTINUE
- END IF
-*
-* ==== Return the optimal value of LWORK. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR0 ====
-*
- END
diff --git a/netlib/LAPACK/dlaqr1.f b/netlib/LAPACK/dlaqr1.f
deleted file mode 100644
index df4fb68..0000000
--- a/netlib/LAPACK/dlaqr1.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief \b DLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION SI1, SI2, SR1, SR2
-* INTEGER LDH, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), V( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a
-*> scalar multiple of the first column of the product
-*>
-*> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
-*>
-*> scaling to avoid overflows and most underflows. It
-*> is assumed that either
-*>
-*> 1) sr1 = sr2 and si1 = -si2
-*> or
-*> 2) si1 = si2 = 0.
-*>
-*> This is useful for starting double implicit shift bulges
-*> in the QR algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is integer
-*> Order of the matrix H. N must be either 2 or 3.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION array of dimension (LDH,N)
-*> The 2-by-2 or 3-by-3 matrix H in (*).
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> The leading dimension of H as declared in
-*> the calling procedure. LDH.GE.N
-*> \endverbatim
-*>
-*> \param[in] SR1
-*> \verbatim
-*> SR1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] SI1
-*> \verbatim
-*> SI1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] SR2
-*> \verbatim
-*> SR2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] SI2
-*> \verbatim
-*> SI2 is DOUBLE PRECISION
-*> The shifts in (*).
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array of dimension N
-*> A scalar multiple of the first column of the
-*> matrix K in (*).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION SI1, SI2, SR1, SR2
- INTEGER LDH, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), V( * )
-* ..
-*
-* ================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION H21S, H31S, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
- IF( N.EQ.2 ) THEN
- S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) )
- IF( S.EQ.ZERO ) THEN
- V( 1 ) = ZERO
- V( 2 ) = ZERO
- ELSE
- H21S = H( 2, 1 ) / S
- V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )*
- $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S )
- V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 )
- END IF
- ELSE
- S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) +
- $ ABS( H( 3, 1 ) )
- IF( S.EQ.ZERO ) THEN
- V( 1 ) = ZERO
- V( 2 ) = ZERO
- V( 3 ) = ZERO
- ELSE
- H21S = H( 2, 1 ) / S
- H31S = H( 3, 1 ) / S
- V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) -
- $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S
- V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) +
- $ H( 2, 3 )*H31S
- V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) +
- $ H21S*H( 3, 2 )
- END IF
- END IF
- END
diff --git a/netlib/LAPACK/dlaqr2.f b/netlib/LAPACK/dlaqr2.f
deleted file mode 100644
index 21c2d3a..0000000
--- a/netlib/LAPACK/dlaqr2.f
+++ /dev/null
@@ -1,684 +0,0 @@
-*> \brief \b DLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-* LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQR2 is identical to DLAQR3 except that it avoids
-*> recursion by calling DLAHQR instead of DLAQR4.
-*>
-*> Aggressive early deflation:
-*>
-*> This subroutine accepts as input an upper Hessenberg matrix
-*> H and performs an orthogonal similarity transformation
-*> designed to detect and deflate fully converged eigenvalues from
-*> a trailing principal submatrix. On output H has been over-
-*> written by a new Hessenberg matrix that is a perturbation of
-*> an orthogonal similarity transformation of H. It is to be
-*> hoped that the final version of H has many zero subdiagonal
-*> entries.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> If .TRUE., then the Hessenberg matrix H is fully updated
-*> so that the quasi-triangular Schur factor may be
-*> computed (in cooperation with the calling subroutine).
-*> If .FALSE., then only enough of H is updated to preserve
-*> the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> If .TRUE., then the orthogonal matrix Z is updated so
-*> so that the orthogonal Schur factor may be computed
-*> (in cooperation with the calling subroutine).
-*> If .FALSE., then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H and (if WANTZ is .TRUE.) the
-*> order of the orthogonal matrix Z.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is INTEGER
-*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*> KBOT and KTOP together determine an isolated block
-*> along the diagonal of the Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is INTEGER
-*> It is assumed without a check that either
-*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
-*> determine an isolated block along the diagonal of the
-*> Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On input the initial N-by-N section of H stores the
-*> Hessenberg matrix undergoing aggressive early deflation.
-*> On output H has been transformed by an orthogonal
-*> similarity transformation, perturbed, and the returned
-*> to Hessenberg form that (it is to be hoped) has some
-*> zero subdiagonal entries.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> Leading dimension of H just as declared in the calling
-*> subroutine. N .LE. LDH
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> IF WANTZ is .TRUE., then on output, the orthogonal
-*> similarity transformation mentioned above has been
-*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ is .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer
-*> The leading dimension of Z just as declared in the
-*> calling subroutine. 1 .LE. LDZ.
-*> \endverbatim
-*>
-*> \param[out] NS
-*> \verbatim
-*> NS is integer
-*> The number of unconverged (ie approximate) eigenvalues
-*> returned in SR and SI that may be used as shifts by the
-*> calling subroutine.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is integer
-*> The number of converged eigenvalues uncovered by this
-*> subroutine.
-*> \endverbatim
-*>
-*> \param[out] SR
-*> \verbatim
-*> SR is DOUBLE PRECISION array, dimension (KBOT)
-*> \endverbatim
-*>
-*> \param[out] SI
-*> \verbatim
-*> SI is DOUBLE PRECISION array, dimension (KBOT)
-*> On output, the real and imaginary parts of approximate
-*> eigenvalues that may be used for shifts are stored in
-*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*> The real and imaginary parts of converged eigenvalues
-*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*> SI(KBOT-ND+1) through SI(KBOT), respectively.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,NW)
-*> An NW-by-NW work array.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> The leading dimension of V just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> The number of columns of T. NH.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NW)
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is integer
-*> The leading dimension of T just as declared in the
-*> calling subroutine. NW .LE. LDT
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer
-*> The number of rows of work array WV available for
-*> workspace. NV.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is DOUBLE PRECISION array, dimension (LDWV,NW)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer
-*> The leading dimension of W just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, WORK(1) is set to an estimate of the optimal value
-*> of LWORK for the given values of N, NW, KTOP and KBOT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer
-*> The dimension of the work array WORK. LWORK = 2*NW
-*> suffices, but greater efficiency may result from larger
-*> values of LWORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; DLAQR2
-*> only estimates the optimal workspace size for the given
-*> values of N, NW, KTOP and KBOT. The estimate is returned
-*> in WORK(1). No error message related to LWORK is issued
-*> by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
- $ LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
- $ LDZ, LWORK, N, ND, NH, NS, NV, NW
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
- $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
- $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
- INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
- $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2,
- $ LWKOPT
- LOGICAL BULGE, SORTED
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
- $ DLANV2, DLARF, DLARFG, DLASET, DORMHR, DTREXC
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* ==== Estimate optimal workspace. ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- IF( JW.LE.2 ) THEN
- LWKOPT = 1
- ELSE
-*
-* ==== Workspace query call to DGEHRD ====
-*
- CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
- LWK1 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to DORMHR ====
-*
- CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
- $ WORK, -1, INFO )
- LWK2 = INT( WORK( 1 ) )
-*
-* ==== Optimal workspace ====
-*
- LWKOPT = JW + MAX( LWK1, LWK2 )
- END IF
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== Nothing to do ...
-* ... for an empty active block ... ====
- NS = 0
- ND = 0
- WORK( 1 ) = ONE
- IF( KTOP.GT.KBOT )
- $ RETURN
-* ... nor for an empty deflation window. ====
- IF( NW.LT.1 )
- $ RETURN
-*
-* ==== Machine constants ====
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-* ==== Setup deflation window ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- KWTOP = KBOT - JW + 1
- IF( KWTOP.EQ.KTOP ) THEN
- S = ZERO
- ELSE
- S = H( KWTOP, KWTOP-1 )
- END IF
-*
- IF( KBOT.EQ.KWTOP ) THEN
-*
-* ==== 1-by-1 deflation window: not much to do ====
-*
- SR( KWTOP ) = H( KWTOP, KWTOP )
- SI( KWTOP ) = ZERO
- NS = 1
- ND = 0
- IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
- $ THEN
- NS = 0
- ND = 1
- IF( KWTOP.GT.KTOP )
- $ H( KWTOP, KWTOP-1 ) = ZERO
- END IF
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
-* ==== Convert to spike-triangular form. (In case of a
-* . rare QR failure, this routine continues to do
-* . aggressive early deflation using that part of
-* . the deflation window that converged using INFQR
-* . here and there to keep track.) ====
-*
- CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
- CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
- CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
- CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, INFQR )
-*
-* ==== DTREXC needs a clean margin near the diagonal ====
-*
- DO 10 J = 1, JW - 3
- T( J+2, J ) = ZERO
- T( J+3, J ) = ZERO
- 10 CONTINUE
- IF( JW.GT.2 )
- $ T( JW, JW-2 ) = ZERO
-*
-* ==== Deflation detection loop ====
-*
- NS = JW
- ILST = INFQR + 1
- 20 CONTINUE
- IF( ILST.LE.NS ) THEN
- IF( NS.EQ.1 ) THEN
- BULGE = .FALSE.
- ELSE
- BULGE = T( NS, NS-1 ).NE.ZERO
- END IF
-*
-* ==== Small spike tip test for deflation ====
-*
- IF( .NOT.BULGE ) THEN
-*
-* ==== Real eigenvalue ====
-*
- FOO = ABS( T( NS, NS ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 1
- ELSE
-*
-* ==== Undeflatable. Move it up out of the way.
-* . (DTREXC can not fail in this case.) ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 1
- END IF
- ELSE
-*
-* ==== Complex conjugate pair ====
-*
- FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
- $ SQRT( ABS( T( NS-1, NS ) ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
- $ MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 2
- ELSE
-*
-* ==== Undeflatable. Move them up out of the way.
-* . Fortunately, DTREXC does the right thing with
-* . ILST in case of a rare exchange failure. ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 2
- END IF
- END IF
-*
-* ==== End deflation detection loop ====
-*
- GO TO 20
- END IF
-*
-* ==== Return to Hessenberg form ====
-*
- IF( NS.EQ.0 )
- $ S = ZERO
-*
- IF( NS.LT.JW ) THEN
-*
-* ==== sorting diagonal blocks of T improves accuracy for
-* . graded matrices. Bubble sort deals well with
-* . exchange failures. ====
-*
- SORTED = .false.
- I = NS + 1
- 30 CONTINUE
- IF( SORTED )
- $ GO TO 50
- SORTED = .true.
-*
- KEND = I - 1
- I = INFQR + 1
- IF( I.EQ.NS ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- 40 CONTINUE
- IF( K.LE.KEND ) THEN
- IF( K.EQ.I+1 ) THEN
- EVI = ABS( T( I, I ) )
- ELSE
- EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
- $ SQRT( ABS( T( I, I+1 ) ) )
- END IF
-*
- IF( K.EQ.KEND ) THEN
- EVK = ABS( T( K, K ) )
- ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
- EVK = ABS( T( K, K ) )
- ELSE
- EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
- $ SQRT( ABS( T( K, K+1 ) ) )
- END IF
-*
- IF( EVI.GE.EVK ) THEN
- I = K
- ELSE
- SORTED = .false.
- IFST = I
- ILST = K
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- IF( INFO.EQ.0 ) THEN
- I = ILST
- ELSE
- I = K
- END IF
- END IF
- IF( I.EQ.KEND ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- GO TO 40
- END IF
- GO TO 30
- 50 CONTINUE
- END IF
-*
-* ==== Restore shift/eigenvalue array from T ====
-*
- I = JW
- 60 CONTINUE
- IF( I.GE.INFQR+1 ) THEN
- IF( I.EQ.INFQR+1 ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE
- AA = T( I-1, I-1 )
- CC = T( I, I-1 )
- BB = T( I-1, I )
- DD = T( I, I )
- CALL DLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
- $ SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
- $ SI( KWTOP+I-1 ), CS, SN )
- I = I - 2
- END IF
- GO TO 60
- END IF
-*
- IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
- IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-* ==== Reflect spike back into lower triangle ====
-*
- CALL DCOPY( NS, V, LDV, WORK, 1 )
- BETA = WORK( 1 )
- CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
- CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
- $ WORK( JW+1 ) )
-*
- CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
- $ LWORK-JW, INFO )
- END IF
-*
-* ==== Copy updated reduced window into place ====
-*
- IF( KWTOP.GT.1 )
- $ H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
- CALL DLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
- CALL DCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
- $ LDH+1 )
-*
-* ==== Accumulate orthogonal matrix in order update
-* . H and Z, if requested. ====
-*
- IF( NS.GT.1 .AND. S.NE.ZERO )
- $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
- $ WORK( JW+1 ), LWORK-JW, INFO )
-*
-* ==== Update vertical slab in H ====
-*
- IF( WANTT ) THEN
- LTOP = 1
- ELSE
- LTOP = KTOP
- END IF
- DO 70 KROW = LTOP, KWTOP - 1, NV
- KLN = MIN( NV, KWTOP-KROW )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
- $ LDH, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
- 70 CONTINUE
-*
-* ==== Update horizontal slab in H ====
-*
- IF( WANTT ) THEN
- DO 80 KCOL = KBOT + 1, N, NH
- KLN = MIN( NH, N-KCOL+1 )
- CALL DGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
- $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
- CALL DLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
- $ LDH )
- 80 CONTINUE
- END IF
-*
-* ==== Update vertical slab in Z ====
-*
- IF( WANTZ ) THEN
- DO 90 KROW = ILOZ, IHIZ, NV
- KLN = MIN( NV, IHIZ-KROW+1 )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
- $ LDZ, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
- $ LDZ )
- 90 CONTINUE
- END IF
- END IF
-*
-* ==== Return the number of deflations ... ====
-*
- ND = JW - NS
-*
-* ==== ... and the number of shifts. (Subtracting
-* . INFQR from the spike length takes care
-* . of the case of a rare QR failure while
-* . calculating eigenvalues of the deflation
-* . window.) ====
-*
- NS = NS - INFQR
-*
-* ==== Return optimal workspace. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR2 ====
-*
- END
diff --git a/netlib/LAPACK/dlaqr3.f b/netlib/LAPACK/dlaqr3.f
deleted file mode 100644
index aac01a4..0000000
--- a/netlib/LAPACK/dlaqr3.f
+++ /dev/null
@@ -1,695 +0,0 @@
-*> \brief \b DLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-* LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Aggressive early deflation:
-*>
-*> DLAQR3 accepts as input an upper Hessenberg matrix
-*> H and performs an orthogonal similarity transformation
-*> designed to detect and deflate fully converged eigenvalues from
-*> a trailing principal submatrix. On output H has been over-
-*> written by a new Hessenberg matrix that is a perturbation of
-*> an orthogonal similarity transformation of H. It is to be
-*> hoped that the final version of H has many zero subdiagonal
-*> entries.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> If .TRUE., then the Hessenberg matrix H is fully updated
-*> so that the quasi-triangular Schur factor may be
-*> computed (in cooperation with the calling subroutine).
-*> If .FALSE., then only enough of H is updated to preserve
-*> the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> If .TRUE., then the orthogonal matrix Z is updated so
-*> so that the orthogonal Schur factor may be computed
-*> (in cooperation with the calling subroutine).
-*> If .FALSE., then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H and (if WANTZ is .TRUE.) the
-*> order of the orthogonal matrix Z.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is INTEGER
-*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*> KBOT and KTOP together determine an isolated block
-*> along the diagonal of the Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is INTEGER
-*> It is assumed without a check that either
-*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
-*> determine an isolated block along the diagonal of the
-*> Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On input the initial N-by-N section of H stores the
-*> Hessenberg matrix undergoing aggressive early deflation.
-*> On output H has been transformed by an orthogonal
-*> similarity transformation, perturbed, and the returned
-*> to Hessenberg form that (it is to be hoped) has some
-*> zero subdiagonal entries.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> Leading dimension of H just as declared in the calling
-*> subroutine. N .LE. LDH
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> IF WANTZ is .TRUE., then on output, the orthogonal
-*> similarity transformation mentioned above has been
-*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ is .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer
-*> The leading dimension of Z just as declared in the
-*> calling subroutine. 1 .LE. LDZ.
-*> \endverbatim
-*>
-*> \param[out] NS
-*> \verbatim
-*> NS is integer
-*> The number of unconverged (ie approximate) eigenvalues
-*> returned in SR and SI that may be used as shifts by the
-*> calling subroutine.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is integer
-*> The number of converged eigenvalues uncovered by this
-*> subroutine.
-*> \endverbatim
-*>
-*> \param[out] SR
-*> \verbatim
-*> SR is DOUBLE PRECISION array, dimension (KBOT)
-*> \endverbatim
-*>
-*> \param[out] SI
-*> \verbatim
-*> SI is DOUBLE PRECISION array, dimension (KBOT)
-*> On output, the real and imaginary parts of approximate
-*> eigenvalues that may be used for shifts are stored in
-*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*> The real and imaginary parts of converged eigenvalues
-*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*> SI(KBOT-ND+1) through SI(KBOT), respectively.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,NW)
-*> An NW-by-NW work array.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> The leading dimension of V just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> The number of columns of T. NH.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NW)
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is integer
-*> The leading dimension of T just as declared in the
-*> calling subroutine. NW .LE. LDT
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer
-*> The number of rows of work array WV available for
-*> workspace. NV.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is DOUBLE PRECISION array, dimension (LDWV,NW)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer
-*> The leading dimension of W just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, WORK(1) is set to an estimate of the optimal value
-*> of LWORK for the given values of N, NW, KTOP and KBOT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer
-*> The dimension of the work array WORK. LWORK = 2*NW
-*> suffices, but greater efficiency may result from larger
-*> values of LWORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; DLAQR3
-*> only estimates the optimal workspace size for the given
-*> values of N, NW, KTOP and KBOT. The estimate is returned
-*> in WORK(1). No error message related to LWORK is issued
-*> by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
- $ LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
- $ LDZ, LWORK, N, ND, NH, NS, NV, NW
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
- $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
- $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
- INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
- $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
- $ LWKOPT, NMIN
- LOGICAL BULGE, SORTED
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER ILAENV
- EXTERNAL DLAMCH, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
- $ DLANV2, DLAQR4, DLARF, DLARFG, DLASET, DORMHR,
- $ DTREXC
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* ==== Estimate optimal workspace. ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- IF( JW.LE.2 ) THEN
- LWKOPT = 1
- ELSE
-*
-* ==== Workspace query call to DGEHRD ====
-*
- CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
- LWK1 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to DORMHR ====
-*
- CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
- $ WORK, -1, INFO )
- LWK2 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to DLAQR4 ====
-*
- CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, JW,
- $ V, LDV, WORK, -1, INFQR )
- LWK3 = INT( WORK( 1 ) )
-*
-* ==== Optimal workspace ====
-*
- LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
- END IF
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== Nothing to do ...
-* ... for an empty active block ... ====
- NS = 0
- ND = 0
- WORK( 1 ) = ONE
- IF( KTOP.GT.KBOT )
- $ RETURN
-* ... nor for an empty deflation window. ====
- IF( NW.LT.1 )
- $ RETURN
-*
-* ==== Machine constants ====
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-* ==== Setup deflation window ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- KWTOP = KBOT - JW + 1
- IF( KWTOP.EQ.KTOP ) THEN
- S = ZERO
- ELSE
- S = H( KWTOP, KWTOP-1 )
- END IF
-*
- IF( KBOT.EQ.KWTOP ) THEN
-*
-* ==== 1-by-1 deflation window: not much to do ====
-*
- SR( KWTOP ) = H( KWTOP, KWTOP )
- SI( KWTOP ) = ZERO
- NS = 1
- ND = 0
- IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
- $ THEN
- NS = 0
- ND = 1
- IF( KWTOP.GT.KTOP )
- $ H( KWTOP, KWTOP-1 ) = ZERO
- END IF
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
-* ==== Convert to spike-triangular form. (In case of a
-* . rare QR failure, this routine continues to do
-* . aggressive early deflation using that part of
-* . the deflation window that converged using INFQR
-* . here and there to keep track.) ====
-*
- CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
- CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
- CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
- NMIN = ILAENV( 12, 'DLAQR3', 'SV', JW, 1, JW, LWORK )
- IF( JW.GT.NMIN ) THEN
- CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, WORK, LWORK, INFQR )
- ELSE
- CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, INFQR )
- END IF
-*
-* ==== DTREXC needs a clean margin near the diagonal ====
-*
- DO 10 J = 1, JW - 3
- T( J+2, J ) = ZERO
- T( J+3, J ) = ZERO
- 10 CONTINUE
- IF( JW.GT.2 )
- $ T( JW, JW-2 ) = ZERO
-*
-* ==== Deflation detection loop ====
-*
- NS = JW
- ILST = INFQR + 1
- 20 CONTINUE
- IF( ILST.LE.NS ) THEN
- IF( NS.EQ.1 ) THEN
- BULGE = .FALSE.
- ELSE
- BULGE = T( NS, NS-1 ).NE.ZERO
- END IF
-*
-* ==== Small spike tip test for deflation ====
-*
- IF( .NOT. BULGE ) THEN
-*
-* ==== Real eigenvalue ====
-*
- FOO = ABS( T( NS, NS ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 1
- ELSE
-*
-* ==== Undeflatable. Move it up out of the way.
-* . (DTREXC can not fail in this case.) ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 1
- END IF
- ELSE
-*
-* ==== Complex conjugate pair ====
-*
- FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
- $ SQRT( ABS( T( NS-1, NS ) ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
- $ MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 2
- ELSE
-*
-* ==== Undeflatable. Move them up out of the way.
-* . Fortunately, DTREXC does the right thing with
-* . ILST in case of a rare exchange failure. ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 2
- END IF
- END IF
-*
-* ==== End deflation detection loop ====
-*
- GO TO 20
- END IF
-*
-* ==== Return to Hessenberg form ====
-*
- IF( NS.EQ.0 )
- $ S = ZERO
-*
- IF( NS.LT.JW ) THEN
-*
-* ==== sorting diagonal blocks of T improves accuracy for
-* . graded matrices. Bubble sort deals well with
-* . exchange failures. ====
-*
- SORTED = .false.
- I = NS + 1
- 30 CONTINUE
- IF( SORTED )
- $ GO TO 50
- SORTED = .true.
-*
- KEND = I - 1
- I = INFQR + 1
- IF( I.EQ.NS ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- 40 CONTINUE
- IF( K.LE.KEND ) THEN
- IF( K.EQ.I+1 ) THEN
- EVI = ABS( T( I, I ) )
- ELSE
- EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
- $ SQRT( ABS( T( I, I+1 ) ) )
- END IF
-*
- IF( K.EQ.KEND ) THEN
- EVK = ABS( T( K, K ) )
- ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
- EVK = ABS( T( K, K ) )
- ELSE
- EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
- $ SQRT( ABS( T( K, K+1 ) ) )
- END IF
-*
- IF( EVI.GE.EVK ) THEN
- I = K
- ELSE
- SORTED = .false.
- IFST = I
- ILST = K
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- IF( INFO.EQ.0 ) THEN
- I = ILST
- ELSE
- I = K
- END IF
- END IF
- IF( I.EQ.KEND ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- GO TO 40
- END IF
- GO TO 30
- 50 CONTINUE
- END IF
-*
-* ==== Restore shift/eigenvalue array from T ====
-*
- I = JW
- 60 CONTINUE
- IF( I.GE.INFQR+1 ) THEN
- IF( I.EQ.INFQR+1 ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE
- AA = T( I-1, I-1 )
- CC = T( I, I-1 )
- BB = T( I-1, I )
- DD = T( I, I )
- CALL DLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
- $ SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
- $ SI( KWTOP+I-1 ), CS, SN )
- I = I - 2
- END IF
- GO TO 60
- END IF
-*
- IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
- IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-* ==== Reflect spike back into lower triangle ====
-*
- CALL DCOPY( NS, V, LDV, WORK, 1 )
- BETA = WORK( 1 )
- CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
- CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
- $ WORK( JW+1 ) )
-*
- CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
- $ LWORK-JW, INFO )
- END IF
-*
-* ==== Copy updated reduced window into place ====
-*
- IF( KWTOP.GT.1 )
- $ H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
- CALL DLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
- CALL DCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
- $ LDH+1 )
-*
-* ==== Accumulate orthogonal matrix in order update
-* . H and Z, if requested. ====
-*
- IF( NS.GT.1 .AND. S.NE.ZERO )
- $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
- $ WORK( JW+1 ), LWORK-JW, INFO )
-*
-* ==== Update vertical slab in H ====
-*
- IF( WANTT ) THEN
- LTOP = 1
- ELSE
- LTOP = KTOP
- END IF
- DO 70 KROW = LTOP, KWTOP - 1, NV
- KLN = MIN( NV, KWTOP-KROW )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
- $ LDH, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
- 70 CONTINUE
-*
-* ==== Update horizontal slab in H ====
-*
- IF( WANTT ) THEN
- DO 80 KCOL = KBOT + 1, N, NH
- KLN = MIN( NH, N-KCOL+1 )
- CALL DGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
- $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
- CALL DLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
- $ LDH )
- 80 CONTINUE
- END IF
-*
-* ==== Update vertical slab in Z ====
-*
- IF( WANTZ ) THEN
- DO 90 KROW = ILOZ, IHIZ, NV
- KLN = MIN( NV, IHIZ-KROW+1 )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
- $ LDZ, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
- $ LDZ )
- 90 CONTINUE
- END IF
- END IF
-*
-* ==== Return the number of deflations ... ====
-*
- ND = JW - NS
-*
-* ==== ... and the number of shifts. (Subtracting
-* . INFQR from the spike length takes care
-* . of the case of a rare QR failure while
-* . calculating eigenvalues of the deflation
-* . window.) ====
-*
- NS = NS - INFQR
-*
-* ==== Return optimal workspace. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR3 ====
-*
- END
diff --git a/netlib/LAPACK/dlaqr4.f b/netlib/LAPACK/dlaqr4.f
deleted file mode 100644
index 6898dfa..0000000
--- a/netlib/LAPACK/dlaqr4.f
+++ /dev/null
@@ -1,739 +0,0 @@
-*> \brief \b DLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQR4 implements one level of recursion for DLAQR0.
-*> It is a complete implementation of the small bulge multi-shift
-*> QR algorithm. It may be called by DLAQR0 and, for large enough
-*> deflation window size, it may be called by DLAQR3. This
-*> subroutine is identical to DLAQR0 except that it calls DLAQR2
-*> instead of DLAQR3.
-*>
-*> DLAQR4 computes the eigenvalues of a Hessenberg matrix H
-*> and, optionally, the matrices T and Z from the Schur decomposition
-*> H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*> Schur form), and Z is the orthogonal matrix of Schur vectors.
-*>
-*> Optionally Z may be postmultiplied into an input orthogonal
-*> matrix Q so that this routine can give the Schur factorization
-*> of a matrix A which has been reduced to the Hessenberg form H
-*> by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*> previous call to DGEBAL, and then passed to DGEHRD when the
-*> matrix output by DGEBAL is reduced to Hessenberg form.
-*> Otherwise, ILO and IHI should be set to 1 and N,
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*> the upper quasi-triangular matrix T from the Schur
-*> decomposition (the Schur form); 2-by-2 diagonal blocks
-*> (corresponding to complex conjugate pairs of eigenvalues)
-*> are returned in standard form, with H(i,i) = H(i+1,i+1)
-*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*> .FALSE., then the contents of H are unspecified on exit.
-*> (The output value of H when INFO.GT.0 is given under the
-*> description of INFO below.)
-*>
-*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (IHI)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (IHI)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI)
-*> and WI(ILO:IHI). If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*> the eigenvalues are stored in the same order as on the
-*> diagonal of the Schur form returned in H, with
-*> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*> block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,IHI)
-*> If WANTZ is .FALSE., then Z is not referenced.
-*> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*> orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*> (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if WANTZ is .TRUE.
-*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension LWORK
-*> On exit, if LWORK = -1, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient, but LWORK typically as large as 6*N may
-*> be required for optimal performance. A workspace query
-*> to determine the optimal workspace size is recommended.
-*>
-*> If LWORK = -1, then DLAQR4 does a workspace query.
-*> In this case, DLAQR4 checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: if INFO = i, DLAQR4 failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is a orthogonal matrix. The final
-*> value of H is upper Hessenberg and triangular in
-*> rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*>
-*> (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of WANTT.)
-*>
-*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*>
-* =====================================================================
- SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . DLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== Exceptional deflation windows: try to cure rare
-* . slow convergence by varying the size of the
-* . deflation window after KEXNW iterations. ====
- INTEGER KEXNW
- PARAMETER ( KEXNW = 5 )
-*
-* ==== Exceptional shifts: try to cure rare slow convergence
-* . with ad-hoc exceptional shifts every KEXSH iterations.
-* . ====
- INTEGER KEXSH
- PARAMETER ( KEXSH = 6 )
-*
-* ==== The constants WILK1 and WILK2 are used to form the
-* . exceptional shifts. ====
- DOUBLE PRECISION WILK1, WILK2
- PARAMETER ( WILK1 = 0.75d0, WILK2 = -0.4375d0 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, CC, CS, DD, SN, SS, SWAP
- INTEGER I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
- $ KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
- $ LWKOPT, NDEC, NDFL, NH, NHO, NIBBLE, NMIN, NS,
- $ NSMAX, NSR, NVE, NW, NWMAX, NWR, NWUPBD
- LOGICAL SORTED
- CHARACTER JBCMPZ*2
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION ZDUM( 1, 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR2, DLAQR5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD
-* ..
-* .. Executable Statements ..
- INFO = 0
-*
-* ==== Quick return for N = 0: nothing to do. ====
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
- IF( N.LE.NTINY ) THEN
-*
-* ==== Tiny matrices must use DLAHQR. ====
-*
- LWKOPT = 1
- IF( LWORK.NE.-1 )
- $ CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
- ELSE
-*
-* ==== Use small bulge multi-shift QR with aggressive early
-* . deflation on larger-than-tiny matrices. ====
-*
-* ==== Hope for the best. ====
-*
- INFO = 0
-*
-* ==== Set up job flags for ILAENV. ====
-*
- IF( WANTT ) THEN
- JBCMPZ( 1: 1 ) = 'S'
- ELSE
- JBCMPZ( 1: 1 ) = 'E'
- END IF
- IF( WANTZ ) THEN
- JBCMPZ( 2: 2 ) = 'V'
- ELSE
- JBCMPZ( 2: 2 ) = 'N'
- END IF
-*
-* ==== NWR = recommended deflation window size. At this
-* . point, N .GT. NTINY = 11, so there is enough
-* . subdiagonal workspace for NWR.GE.2 as required.
-* . (In fact, there is enough subdiagonal space for
-* . NWR.GE.3.) ====
-*
- NWR = ILAENV( 13, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NWR = MAX( 2, NWR )
- NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-*
-* ==== NSR = recommended number of simultaneous shifts.
-* . At this point N .GT. NTINY = 11, so there is at
-* . enough subdiagonal workspace for NSR to be even
-* . and greater than or equal to two as required. ====
-*
- NSR = ILAENV( 15, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
- NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-* ==== Estimate optimal workspace ====
-*
-* ==== Workspace query call to DLAQR2 ====
-*
- CALL DLAQR2( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
- $ N, H, LDH, WORK, -1 )
-*
-* ==== Optimal workspace = MAX(DLAQR5, DLAQR2) ====
-*
- LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== DLAHQR/DLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== Nibble crossover point ====
-*
- NIBBLE = ILAENV( 14, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NIBBLE = MAX( 0, NIBBLE )
-*
-* ==== Accumulate reflections during ttswp? Use block
-* . 2-by-2 structure during matrix-matrix multiply? ====
-*
- KACC22 = ILAENV( 16, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- KACC22 = MAX( 0, KACC22 )
- KACC22 = MIN( 2, KACC22 )
-*
-* ==== NWMAX = the largest possible deflation window for
-* . which there is sufficient workspace. ====
-*
- NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
- NW = NWMAX
-*
-* ==== NSMAX = the Largest number of simultaneous shifts
-* . for which there is sufficient workspace. ====
-*
- NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
- NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-* ==== NDFL: an iteration count restarted at deflation. ====
-*
- NDFL = 1
-*
-* ==== ITMAX = iteration limit ====
-*
- ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-* ==== Last row and column in the active block ====
-*
- KBOT = IHI
-*
-* ==== Main Loop ====
-*
- DO 80 IT = 1, ITMAX
-*
-* ==== Done when KBOT falls below ILO ====
-*
- IF( KBOT.LT.ILO )
- $ GO TO 90
-*
-* ==== Locate active block ====
-*
- DO 10 K = KBOT, ILO + 1, -1
- IF( H( K, K-1 ).EQ.ZERO )
- $ GO TO 20
- 10 CONTINUE
- K = ILO
- 20 CONTINUE
- KTOP = K
-*
-* ==== Select deflation window size:
-* . Typical Case:
-* . If possible and advisable, nibble the entire
-* . active block. If not, use size MIN(NWR,NWMAX)
-* . or MIN(NWR+1,NWMAX) depending upon which has
-* . the smaller corresponding subdiagonal entry
-* . (a heuristic).
-* .
-* . Exceptional Case:
-* . If there have been no deflations in KEXNW or
-* . more iterations, then vary the deflation window
-* . size. At first, because, larger windows are,
-* . in general, more powerful than smaller ones,
-* . rapidly increase the window to the maximum possible.
-* . Then, gradually reduce the window size. ====
-*
- NH = KBOT - KTOP + 1
- NWUPBD = MIN( NH, NWMAX )
- IF( NDFL.LT.KEXNW ) THEN
- NW = MIN( NWUPBD, NWR )
- ELSE
- NW = MIN( NWUPBD, 2*NW )
- END IF
- IF( NW.LT.NWMAX ) THEN
- IF( NW.GE.NH-1 ) THEN
- NW = NH
- ELSE
- KWTOP = KBOT - NW + 1
- IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
- $ ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
- END IF
- END IF
- IF( NDFL.LT.KEXNW ) THEN
- NDEC = -1
- ELSE IF( NDEC.GE.0 .OR. NW.GE.NWUPBD ) THEN
- NDEC = NDEC + 1
- IF( NW-NDEC.LT.2 )
- $ NDEC = 0
- NW = NW - NDEC
- END IF
-*
-* ==== Aggressive early deflation:
-* . split workspace under the subdiagonal into
-* . - an nw-by-nw work array V in the lower
-* . left-hand-corner,
-* . - an NW-by-at-least-NW-but-more-is-better
-* . (NW-by-NHO) horizontal work array along
-* . the bottom edge,
-* . - an at-least-NW-but-more-is-better (NHV-by-NW)
-* . vertical work array along the left-hand-edge.
-* . ====
-*
- KV = N - NW + 1
- KT = NW + 1
- NHO = ( N-NW-1 ) - KT + 1
- KWV = NW + 2
- NVE = ( N-NW ) - KWV + 1
-*
-* ==== Aggressive early deflation ====
-*
- CALL DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
- $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
- $ WORK, LWORK )
-*
-* ==== Adjust KBOT accounting for new deflations. ====
-*
- KBOT = KBOT - LD
-*
-* ==== KS points to the shifts. ====
-*
- KS = KBOT - LS + 1
-*
-* ==== Skip an expensive QR sweep if there is a (partly
-* . heuristic) reason to expect that many eigenvalues
-* . will deflate without it. Here, the QR sweep is
-* . skipped if many eigenvalues have just been deflated
-* . or if the remaining active block is small.
-*
- IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
- $ KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-* ==== NS = nominal number of simultaneous shifts.
-* . This may be lowered (slightly) if DLAQR2
-* . did not provide that many shifts. ====
-*
- NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
- NS = NS - MOD( NS, 2 )
-*
-* ==== If there have been no deflations
-* . in a multiple of KEXSH iterations,
-* . then try exceptional shifts.
-* . Otherwise use shifts provided by
-* . DLAQR2 above or from the eigenvalues
-* . of a trailing principal submatrix. ====
-*
- IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
- KS = KBOT - NS + 1
- DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
- SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- AA = WILK1*SS + H( I, I )
- BB = SS
- CC = WILK2*SS
- DD = AA
- CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
- $ WR( I ), WI( I ), CS, SN )
- 30 CONTINUE
- IF( KS.EQ.KTOP ) THEN
- WR( KS+1 ) = H( KS+1, KS+1 )
- WI( KS+1 ) = ZERO
- WR( KS ) = WR( KS+1 )
- WI( KS ) = WI( KS+1 )
- END IF
- ELSE
-*
-* ==== Got NS/2 or fewer shifts? Use DLAHQR
-* . on a trailing principal submatrix to
-* . get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-* . there is enough space below the subdiagonal
-* . to fit an NS-by-NS scratch array.) ====
-*
- IF( KBOT-KS+1.LE.NS / 2 ) THEN
- KS = KBOT - NS + 1
- KT = N - NS + 1
- CALL DLACPY( 'A', NS, NS, H( KS, KS ), LDH,
- $ H( KT, 1 ), LDH )
- CALL DLAHQR( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ), WI( KS ),
- $ 1, 1, ZDUM, 1, INF )
- KS = KS + INF
-*
-* ==== In case of a rare QR failure use
-* . eigenvalues of the trailing 2-by-2
-* . principal submatrix. ====
-*
- IF( KS.GE.KBOT ) THEN
- AA = H( KBOT-1, KBOT-1 )
- CC = H( KBOT, KBOT-1 )
- BB = H( KBOT-1, KBOT )
- DD = H( KBOT, KBOT )
- CALL DLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
- $ WI( KBOT-1 ), WR( KBOT ),
- $ WI( KBOT ), CS, SN )
- KS = KBOT - 1
- END IF
- END IF
-*
- IF( KBOT-KS+1.GT.NS ) THEN
-*
-* ==== Sort the shifts (Helps a little)
-* . Bubble sort keeps complex conjugate
-* . pairs together. ====
-*
- SORTED = .false.
- DO 50 K = KBOT, KS + 1, -1
- IF( SORTED )
- $ GO TO 60
- SORTED = .true.
- DO 40 I = KS, K - 1
- IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
- $ ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
- SORTED = .false.
-*
- SWAP = WR( I )
- WR( I ) = WR( I+1 )
- WR( I+1 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I+1 )
- WI( I+1 ) = SWAP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* ==== Shuffle shifts into pairs of real shifts
-* . and pairs of complex conjugate shifts
-* . assuming complex conjugate shifts are
-* . already adjacent to one another. (Yes,
-* . they are.) ====
-*
- DO 70 I = KBOT, KS + 2, -2
- IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
- SWAP = WR( I )
- WR( I ) = WR( I-1 )
- WR( I-1 ) = WR( I-2 )
- WR( I-2 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I-1 )
- WI( I-1 ) = WI( I-2 )
- WI( I-2 ) = SWAP
- END IF
- 70 CONTINUE
- END IF
-*
-* ==== If there are only two shifts and both are
-* . real, then use only one. ====
-*
- IF( KBOT-KS+1.EQ.2 ) THEN
- IF( WI( KBOT ).EQ.ZERO ) THEN
- IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
- $ ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
- WR( KBOT-1 ) = WR( KBOT )
- ELSE
- WR( KBOT ) = WR( KBOT-1 )
- END IF
- END IF
- END IF
-*
-* ==== Use up to NS of the the smallest magnatiude
-* . shifts. If there aren't NS shifts available,
-* . then use them all, possibly dropping one to
-* . make the number of shifts even. ====
-*
- NS = MIN( NS, KBOT-KS+1 )
- NS = NS - MOD( NS, 2 )
- KS = KBOT - NS + 1
-*
-* ==== Small-bulge multi-shift QR sweep:
-* . split workspace under the subdiagonal into
-* . - a KDU-by-KDU work array U in the lower
-* . left-hand-corner,
-* . - a KDU-by-at-least-KDU-but-more-is-better
-* . (KDU-by-NHo) horizontal work array WH along
-* . the bottom edge,
-* . - and an at-least-KDU-but-more-is-better-by-KDU
-* . (NVE-by-KDU) vertical work WV arrow along
-* . the left-hand-edge. ====
-*
- KDU = 3*NS - 3
- KU = N - KDU + 1
- KWH = KDU + 1
- NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
- KWV = KDU + 4
- NVE = N - KDU - KWV + 1
-*
-* ==== Small-bulge multi-shift QR sweep ====
-*
- CALL DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
- $ WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
- $ LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
- $ H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
- END IF
-*
-* ==== Note progress (or the lack of it). ====
-*
- IF( LD.GT.0 ) THEN
- NDFL = 1
- ELSE
- NDFL = NDFL + 1
- END IF
-*
-* ==== End of main loop ====
- 80 CONTINUE
-*
-* ==== Iteration limit exceeded. Set INFO to show where
-* . the problem occurred and exit. ====
-*
- INFO = KBOT
- 90 CONTINUE
- END IF
-*
-* ==== Return the optimal value of LWORK. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR4 ====
-*
- END
diff --git a/netlib/LAPACK/dlaqr5.f b/netlib/LAPACK/dlaqr5.f
deleted file mode 100644
index 37ce6f6..0000000
--- a/netlib/LAPACK/dlaqr5.f
+++ /dev/null
@@ -1,921 +0,0 @@
-*> \brief \b DLAQR5 performs a single small-bulge multi-shift QR sweep.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
-* SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
-* LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
-* $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
-* $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQR5, called by DLAQR0, performs a
-*> single small-bulge multi-shift QR sweep.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is logical scalar
-*> WANTT = .true. if the quasi-triangular Schur factor
-*> is being computed. WANTT is set to .false. otherwise.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is logical scalar
-*> WANTZ = .true. if the orthogonal Schur factor is being
-*> computed. WANTZ is set to .false. otherwise.
-*> \endverbatim
-*>
-*> \param[in] KACC22
-*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
-*> Specifies the computation mode of far-from-diagonal
-*> orthogonal updates.
-*> = 0: DLAQR5 does not accumulate reflections and does not
-*> use matrix-matrix multiply to update far-from-diagonal
-*> matrix entries.
-*> = 1: DLAQR5 accumulates reflections and uses matrix-matrix
-*> multiply to update the far-from-diagonal matrix entries.
-*> = 2: DLAQR5 accumulates reflections, uses matrix-matrix
-*> multiply to update the far-from-diagonal matrix entries,
-*> and takes advantage of 2-by-2 block structure during
-*> matrix multiplies.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is integer scalar
-*> N is the order of the Hessenberg matrix H upon which this
-*> subroutine operates.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is integer scalar
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is integer scalar
-*> These are the first and last rows and columns of an
-*> isolated diagonal block upon which the QR sweep is to be
-*> applied. It is assumed without a check that
-*> either KTOP = 1 or H(KTOP,KTOP-1) = 0
-*> and
-*> either KBOT = N or H(KBOT+1,KBOT) = 0.
-*> \endverbatim
-*>
-*> \param[in] NSHFTS
-*> \verbatim
-*> NSHFTS is integer scalar
-*> NSHFTS gives the number of simultaneous shifts. NSHFTS
-*> must be positive and even.
-*> \endverbatim
-*>
-*> \param[in,out] SR
-*> \verbatim
-*> SR is DOUBLE PRECISION array of size (NSHFTS)
-*> \endverbatim
-*>
-*> \param[in,out] SI
-*> \verbatim
-*> SI is DOUBLE PRECISION array of size (NSHFTS)
-*> SR contains the real parts and SI contains the imaginary
-*> parts of the NSHFTS shifts of origin that define the
-*> multi-shift QR sweep. On output SR and SI may be
-*> reordered.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array of size (LDH,N)
-*> On input H contains a Hessenberg matrix. On output a
-*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
-*> to the isolated diagonal block in rows and columns KTOP
-*> through KBOT.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer scalar
-*> LDH is the leading dimension of H just as declared in the
-*> calling procedure. LDH.GE.MAX(1,N).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array of size (LDZ,IHI)
-*> If WANTZ = .TRUE., then the QR Sweep orthogonal
-*> similarity transformation is accumulated into
-*> Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ = .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer scalar
-*> LDA is the leading dimension of Z just as declared in
-*> the calling procedure. LDZ.GE.N.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array of size (LDV,NSHFTS/2)
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> LDV is the leading dimension of V as declared in the
-*> calling procedure. LDV.GE.3.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array of size
-*> (LDU,3*NSHFTS-3)
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is integer scalar
-*> LDU is the leading dimension of U just as declared in the
-*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> NH is the number of columns in array WH available for
-*> workspace. NH.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WH
-*> \verbatim
-*> WH is DOUBLE PRECISION array of size (LDWH,NH)
-*> \endverbatim
-*>
-*> \param[in] LDWH
-*> \verbatim
-*> LDWH is integer scalar
-*> Leading dimension of WH just as declared in the
-*> calling procedure. LDWH.GE.3*NSHFTS-3.
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer scalar
-*> NV is the number of rows in WV agailable for workspace.
-*> NV.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is DOUBLE PRECISION array of size
-*> (LDWV,3*NSHFTS-3)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer scalar
-*> LDWV is the leading dimension of WV as declared in the
-*> in the calling subroutine. LDWV.GE.NV.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*>
-* =====================================================================
- SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
- $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
- $ LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
- $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
- $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ALPHA, BETA, H11, H12, H21, H22, REFSUM,
- $ SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2,
- $ ULP
- INTEGER I, I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN,
- $ JROW, JTOP, K, K1, KDU, KMS, KNZ, KRCOL, KZS,
- $ M, M22, MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL,
- $ NS, NU
- LOGICAL ACCUM, BLK22, BMP22
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
-*
- INTRINSIC ABS, DBLE, MAX, MIN, MOD
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION VT( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLABAD, DLACPY, DLAQR1, DLARFG, DLASET,
- $ DTRMM
-* ..
-* .. Executable Statements ..
-*
-* ==== If there are no shifts, then there is nothing to do. ====
-*
- IF( NSHFTS.LT.2 )
- $ RETURN
-*
-* ==== If the active block is empty or 1-by-1, then there
-* . is nothing to do. ====
-*
- IF( KTOP.GE.KBOT )
- $ RETURN
-*
-* ==== Shuffle shifts into pairs of real shifts and pairs
-* . of complex conjugate shifts assuming complex
-* . conjugate shifts are already adjacent to one
-* . another. ====
-*
- DO 10 I = 1, NSHFTS - 2, 2
- IF( SI( I ).NE.-SI( I+1 ) ) THEN
-*
- SWAP = SR( I )
- SR( I ) = SR( I+1 )
- SR( I+1 ) = SR( I+2 )
- SR( I+2 ) = SWAP
-*
- SWAP = SI( I )
- SI( I ) = SI( I+1 )
- SI( I+1 ) = SI( I+2 )
- SI( I+2 ) = SWAP
- END IF
- 10 CONTINUE
-*
-* ==== NSHFTS is supposed to be even, but if it is odd,
-* . then simply reduce it by one. The shuffle above
-* . ensures that the dropped shift is real and that
-* . the remaining shifts are paired. ====
-*
- NS = NSHFTS - MOD( NSHFTS, 2 )
-*
-* ==== Machine constants for deflation ====
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-* ==== Use accumulated reflections to update far-from-diagonal
-* . entries ? ====
-*
- ACCUM = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )
-*
-* ==== If so, exploit the 2-by-2 block structure? ====
-*
- BLK22 = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )
-*
-* ==== clear trash ====
-*
- IF( KTOP+2.LE.KBOT )
- $ H( KTOP+2, KTOP ) = ZERO
-*
-* ==== NBMPS = number of 2-shift bulges in the chain ====
-*
- NBMPS = NS / 2
-*
-* ==== KDU = width of slab ====
-*
- KDU = 6*NBMPS - 3
-*
-* ==== Create and chase chains of NBMPS bulges ====
-*
- DO 220 INCOL = 3*( 1-NBMPS ) + KTOP - 1, KBOT - 2, 3*NBMPS - 2
- NDCOL = INCOL + KDU
- IF( ACCUM )
- $ CALL DLASET( 'ALL', KDU, KDU, ZERO, ONE, U, LDU )
-*
-* ==== Near-the-diagonal bulge chase. The following loop
-* . performs the near-the-diagonal part of a small bulge
-* . multi-shift QR sweep. Each 6*NBMPS-2 column diagonal
-* . chunk extends from column INCOL to column NDCOL
-* . (including both column INCOL and column NDCOL). The
-* . following loop chases a 3*NBMPS column long chain of
-* . NBMPS bulges 3*NBMPS-2 columns to the right. (INCOL
-* . may be less than KTOP and and NDCOL may be greater than
-* . KBOT indicating phantom columns from which to chase
-* . bulges before they are actually introduced or to which
-* . to chase bulges beyond column KBOT.) ====
-*
- DO 150 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )
-*
-* ==== Bulges number MTOP to MBOT are active double implicit
-* . shift bulges. There may or may not also be small
-* . 2-by-2 bulge, if there is room. The inactive bulges
-* . (if any) must wait until the active bulges have moved
-* . down the diagonal to make room. The phantom matrix
-* . paradigm described above helps keep track. ====
-*
- MTOP = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )
- MBOT = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )
- M22 = MBOT + 1
- BMP22 = ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ.
- $ ( KBOT-2 )
-*
-* ==== Generate reflections to chase the chain right
-* . one column. (The minimum value of K is KTOP-1.) ====
-*
- DO 20 M = MTOP, MBOT
- K = KRCOL + 3*( M-1 )
- IF( K.EQ.KTOP-1 ) THEN
- CALL DLAQR1( 3, H( KTOP, KTOP ), LDH, SR( 2*M-1 ),
- $ SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
- $ V( 1, M ) )
- ALPHA = V( 1, M )
- CALL DLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )
- ELSE
- BETA = H( K+1, K )
- V( 2, M ) = H( K+2, K )
- V( 3, M ) = H( K+3, K )
- CALL DLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )
-*
-* ==== A Bulge may collapse because of vigilant
-* . deflation or destructive underflow. In the
-* . underflow case, try the two-small-subdiagonals
-* . trick to try to reinflate the bulge. ====
-*
- IF( H( K+3, K ).NE.ZERO .OR. H( K+3, K+1 ).NE.
- $ ZERO .OR. H( K+3, K+2 ).EQ.ZERO ) THEN
-*
-* ==== Typical case: not collapsed (yet). ====
-*
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- ELSE
-*
-* ==== Atypical case: collapsed. Attempt to
-* . reintroduce ignoring H(K+1,K) and H(K+2,K).
-* . If the fill resulting from the new
-* . reflector is too large, then abandon it.
-* . Otherwise, use the new one. ====
-*
- CALL DLAQR1( 3, H( K+1, K+1 ), LDH, SR( 2*M-1 ),
- $ SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
- $ VT )
- ALPHA = VT( 1 )
- CALL DLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
- REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
- $ H( K+2, K ) )
-*
- IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
- $ ABS( REFSUM*VT( 3 ) ).GT.ULP*
- $ ( ABS( H( K, K ) )+ABS( H( K+1,
- $ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
-*
-* ==== Starting a new bulge here would
-* . create non-negligible fill. Use
-* . the old one with trepidation. ====
-*
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- ELSE
-*
-* ==== Stating a new bulge here would
-* . create only negligible fill.
-* . Replace the old reflector with
-* . the new one. ====
-*
- H( K+1, K ) = H( K+1, K ) - REFSUM
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- V( 1, M ) = VT( 1 )
- V( 2, M ) = VT( 2 )
- V( 3, M ) = VT( 3 )
- END IF
- END IF
- END IF
- 20 CONTINUE
-*
-* ==== Generate a 2-by-2 reflection, if needed. ====
-*
- K = KRCOL + 3*( M22-1 )
- IF( BMP22 ) THEN
- IF( K.EQ.KTOP-1 ) THEN
- CALL DLAQR1( 2, H( K+1, K+1 ), LDH, SR( 2*M22-1 ),
- $ SI( 2*M22-1 ), SR( 2*M22 ), SI( 2*M22 ),
- $ V( 1, M22 ) )
- BETA = V( 1, M22 )
- CALL DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
- ELSE
- BETA = H( K+1, K )
- V( 2, M22 ) = H( K+2, K )
- CALL DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- END IF
- END IF
-*
-* ==== Multiply H by reflections from the left ====
-*
- IF( ACCUM ) THEN
- JBOT = MIN( NDCOL, KBOT )
- ELSE IF( WANTT ) THEN
- JBOT = N
- ELSE
- JBOT = KBOT
- END IF
- DO 40 J = MAX( KTOP, KRCOL ), JBOT
- MEND = MIN( MBOT, ( J-KRCOL+2 ) / 3 )
- DO 30 M = MTOP, MEND
- K = KRCOL + 3*( M-1 )
- REFSUM = V( 1, M )*( H( K+1, J )+V( 2, M )*
- $ H( K+2, J )+V( 3, M )*H( K+3, J ) )
- H( K+1, J ) = H( K+1, J ) - REFSUM
- H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
- H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
- 30 CONTINUE
- 40 CONTINUE
- IF( BMP22 ) THEN
- K = KRCOL + 3*( M22-1 )
- DO 50 J = MAX( K+1, KTOP ), JBOT
- REFSUM = V( 1, M22 )*( H( K+1, J )+V( 2, M22 )*
- $ H( K+2, J ) )
- H( K+1, J ) = H( K+1, J ) - REFSUM
- H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
- 50 CONTINUE
- END IF
-*
-* ==== Multiply H by reflections from the right.
-* . Delay filling in the last row until the
-* . vigilant deflation check is complete. ====
-*
- IF( ACCUM ) THEN
- JTOP = MAX( KTOP, INCOL )
- ELSE IF( WANTT ) THEN
- JTOP = 1
- ELSE
- JTOP = KTOP
- END IF
- DO 90 M = MTOP, MBOT
- IF( V( 1, M ).NE.ZERO ) THEN
- K = KRCOL + 3*( M-1 )
- DO 60 J = JTOP, MIN( KBOT, K+3 )
- REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )*
- $ H( J, K+2 )+V( 3, M )*H( J, K+3 ) )
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
- H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M )
- H( J, K+3 ) = H( J, K+3 ) - REFSUM*V( 3, M )
- 60 CONTINUE
-*
- IF( ACCUM ) THEN
-*
-* ==== Accumulate U. (If necessary, update Z later
-* . with with an efficient matrix-matrix
-* . multiply.) ====
-*
- KMS = K - INCOL
- DO 70 J = MAX( 1, KTOP-INCOL ), KDU
- REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )*
- $ U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M )
- U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*V( 3, M )
- 70 CONTINUE
- ELSE IF( WANTZ ) THEN
-*
-* ==== U is not accumulated, so update Z
-* . now by multiplying by reflections
-* . from the right. ====
-*
- DO 80 J = ILOZ, IHIZ
- REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )*
- $ Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M )
- Z( J, K+3 ) = Z( J, K+3 ) - REFSUM*V( 3, M )
- 80 CONTINUE
- END IF
- END IF
- 90 CONTINUE
-*
-* ==== Special case: 2-by-2 reflection (if needed) ====
-*
- K = KRCOL + 3*( M22-1 )
- IF( BMP22 ) THEN
- IF ( V( 1, M22 ).NE.ZERO ) THEN
- DO 100 J = JTOP, MIN( KBOT, K+3 )
- REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
- $ H( J, K+2 ) )
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
- H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )
- 100 CONTINUE
-*
- IF( ACCUM ) THEN
- KMS = K - INCOL
- DO 110 J = MAX( 1, KTOP-INCOL ), KDU
- REFSUM = V( 1, M22 )*( U( J, KMS+1 )+
- $ V( 2, M22 )*U( J, KMS+2 ) )
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U( J, KMS+2 ) = U( J, KMS+2 ) -
- $ REFSUM*V( 2, M22 )
- 110 CONTINUE
- ELSE IF( WANTZ ) THEN
- DO 120 J = ILOZ, IHIZ
- REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*
- $ Z( J, K+2 ) )
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )
- 120 CONTINUE
- END IF
- END IF
- END IF
-*
-* ==== Vigilant deflation check ====
-*
- MSTART = MTOP
- IF( KRCOL+3*( MSTART-1 ).LT.KTOP )
- $ MSTART = MSTART + 1
- MEND = MBOT
- IF( BMP22 )
- $ MEND = MEND + 1
- IF( KRCOL.EQ.KBOT-2 )
- $ MEND = MEND + 1
- DO 130 M = MSTART, MEND
- K = MIN( KBOT-1, KRCOL+3*( M-1 ) )
-*
-* ==== The following convergence test requires that
-* . the tradition small-compared-to-nearby-diagonals
-* . criterion and the Ahues & Tisseur (LAWN 122, 1997)
-* . criteria both be satisfied. The latter improves
-* . accuracy in some examples. Falling back on an
-* . alternate convergence criterion when TST1 or TST2
-* . is zero (as done here) is traditional but probably
-* . unnecessary. ====
-*
- IF( H( K+1, K ).NE.ZERO ) THEN
- TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
- IF( TST1.EQ.ZERO ) THEN
- IF( K.GE.KTOP+1 )
- $ TST1 = TST1 + ABS( H( K, K-1 ) )
- IF( K.GE.KTOP+2 )
- $ TST1 = TST1 + ABS( H( K, K-2 ) )
- IF( K.GE.KTOP+3 )
- $ TST1 = TST1 + ABS( H( K, K-3 ) )
- IF( K.LE.KBOT-2 )
- $ TST1 = TST1 + ABS( H( K+2, K+1 ) )
- IF( K.LE.KBOT-3 )
- $ TST1 = TST1 + ABS( H( K+3, K+1 ) )
- IF( K.LE.KBOT-4 )
- $ TST1 = TST1 + ABS( H( K+4, K+1 ) )
- END IF
- IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
- $ THEN
- H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
- H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
- H11 = MAX( ABS( H( K+1, K+1 ) ),
- $ ABS( H( K, K )-H( K+1, K+1 ) ) )
- H22 = MIN( ABS( H( K+1, K+1 ) ),
- $ ABS( H( K, K )-H( K+1, K+1 ) ) )
- SCL = H11 + H12
- TST2 = H22*( H11 / SCL )
-*
- IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
- $ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
- END IF
- END IF
- 130 CONTINUE
-*
-* ==== Fill in the last row of each bulge. ====
-*
- MEND = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
- DO 140 M = MTOP, MEND
- K = KRCOL + 3*( M-1 )
- REFSUM = V( 1, M )*V( 3, M )*H( K+4, K+3 )
- H( K+4, K+1 ) = -REFSUM
- H( K+4, K+2 ) = -REFSUM*V( 2, M )
- H( K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*V( 3, M )
- 140 CONTINUE
-*
-* ==== End of near-the-diagonal bulge chase. ====
-*
- 150 CONTINUE
-*
-* ==== Use U (if accumulated) to update far-from-diagonal
-* . entries in H. If required, use U to update Z as
-* . well. ====
-*
- IF( ACCUM ) THEN
- IF( WANTT ) THEN
- JTOP = 1
- JBOT = N
- ELSE
- JTOP = KTOP
- JBOT = KBOT
- END IF
- IF( ( .NOT.BLK22 ) .OR. ( INCOL.LT.KTOP ) .OR.
- $ ( NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN
-*
-* ==== Updates not exploiting the 2-by-2 block
-* . structure of U. K1 and NU keep track of
-* . the location and size of U in the special
-* . cases of introducing bulges and chasing
-* . bulges off the bottom. In these special
-* . cases and in case the number of shifts
-* . is NS = 2, there is no 2-by-2 block
-* . structure to exploit. ====
-*
- K1 = MAX( 1, KTOP-INCOL )
- NU = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1
-*
-* ==== Horizontal Multiply ====
-*
- DO 160 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
- JLEN = MIN( NH, JBOT-JCOL+1 )
- CALL DGEMM( 'C', 'N', NU, JLEN, NU, ONE, U( K1, K1 ),
- $ LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH,
- $ LDWH )
- CALL DLACPY( 'ALL', NU, JLEN, WH, LDWH,
- $ H( INCOL+K1, JCOL ), LDH )
- 160 CONTINUE
-*
-* ==== Vertical multiply ====
-*
- DO 170 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV
- JLEN = MIN( NV, MAX( KTOP, INCOL )-JROW )
- CALL DGEMM( 'N', 'N', JLEN, NU, NU, ONE,
- $ H( JROW, INCOL+K1 ), LDH, U( K1, K1 ),
- $ LDU, ZERO, WV, LDWV )
- CALL DLACPY( 'ALL', JLEN, NU, WV, LDWV,
- $ H( JROW, INCOL+K1 ), LDH )
- 170 CONTINUE
-*
-* ==== Z multiply (also vertical) ====
-*
- IF( WANTZ ) THEN
- DO 180 JROW = ILOZ, IHIZ, NV
- JLEN = MIN( NV, IHIZ-JROW+1 )
- CALL DGEMM( 'N', 'N', JLEN, NU, NU, ONE,
- $ Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ),
- $ LDU, ZERO, WV, LDWV )
- CALL DLACPY( 'ALL', JLEN, NU, WV, LDWV,
- $ Z( JROW, INCOL+K1 ), LDZ )
- 180 CONTINUE
- END IF
- ELSE
-*
-* ==== Updates exploiting U's 2-by-2 block structure.
-* . (I2, I4, J2, J4 are the last rows and columns
-* . of the blocks.) ====
-*
- I2 = ( KDU+1 ) / 2
- I4 = KDU
- J2 = I4 - I2
- J4 = KDU
-*
-* ==== KZS and KNZ deal with the band of zeros
-* . along the diagonal of one of the triangular
-* . blocks. ====
-*
- KZS = ( J4-J2 ) - ( NS+1 )
- KNZ = NS + 1
-*
-* ==== Horizontal multiply ====
-*
- DO 190 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
- JLEN = MIN( NH, JBOT-JCOL+1 )
-*
-* ==== Copy bottom of H to top+KZS of scratch ====
-* (The first KZS rows get multiplied by zero.) ====
-*
- CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),
- $ LDH, WH( KZS+1, 1 ), LDWH )
-*
-* ==== Multiply by U21**T ====
-*
- CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
- CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,
- $ U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
- $ LDWH )
-*
-* ==== Multiply top of H by U11**T ====
-*
- CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,
- $ H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
-*
-* ==== Copy top of H to bottom of WH ====
-*
- CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,
- $ WH( I2+1, 1 ), LDWH )
-*
-* ==== Multiply by U21**T ====
-*
- CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,
- $ U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
-*
-* ==== Multiply by U22 ====
-*
- CALL DGEMM( 'C', 'N', I4-I2, JLEN, J4-J2, ONE,
- $ U( J2+1, I2+1 ), LDU,
- $ H( INCOL+1+J2, JCOL ), LDH, ONE,
- $ WH( I2+1, 1 ), LDWH )
-*
-* ==== Copy it back ====
-*
- CALL DLACPY( 'ALL', KDU, JLEN, WH, LDWH,
- $ H( INCOL+1, JCOL ), LDH )
- 190 CONTINUE
-*
-* ==== Vertical multiply ====
-*
- DO 200 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
- JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )
-*
-* ==== Copy right of H to scratch (the first KZS
-* . columns get multiplied by zero) ====
-*
- CALL DLACPY( 'ALL', JLEN, KNZ, H( JROW, INCOL+1+J2 ),
- $ LDH, WV( 1, 1+KZS ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
- CALL DTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
- $ U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
- $ LDWV )
-*
-* ==== Multiply by U11 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I2, J2, ONE,
- $ H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV,
- $ LDWV )
-*
-* ==== Copy left of H to right of scratch ====
-*
- CALL DLACPY( 'ALL', JLEN, J2, H( JROW, INCOL+1 ), LDH,
- $ WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
- $ U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U22 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
- $ H( JROW, INCOL+1+J2 ), LDH,
- $ U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ),
- $ LDWV )
-*
-* ==== Copy it back ====
-*
- CALL DLACPY( 'ALL', JLEN, KDU, WV, LDWV,
- $ H( JROW, INCOL+1 ), LDH )
- 200 CONTINUE
-*
-* ==== Multiply Z (also vertical) ====
-*
- IF( WANTZ ) THEN
- DO 210 JROW = ILOZ, IHIZ, NV
- JLEN = MIN( NV, IHIZ-JROW+1 )
-*
-* ==== Copy right of Z to left of scratch (first
-* . KZS columns get multiplied by zero) ====
-*
- CALL DLACPY( 'ALL', JLEN, KNZ,
- $ Z( JROW, INCOL+1+J2 ), LDZ,
- $ WV( 1, 1+KZS ), LDWV )
-*
-* ==== Multiply by U12 ====
-*
- CALL DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV,
- $ LDWV )
- CALL DTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
- $ U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
- $ LDWV )
-*
-* ==== Multiply by U11 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I2, J2, ONE,
- $ Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE,
- $ WV, LDWV )
-*
-* ==== Copy left of Z to right of scratch ====
-*
- CALL DLACPY( 'ALL', JLEN, J2, Z( JROW, INCOL+1 ),
- $ LDZ, WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
- $ U( 1, I2+1 ), LDU, WV( 1, 1+I2 ),
- $ LDWV )
-*
-* ==== Multiply by U22 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
- $ Z( JROW, INCOL+1+J2 ), LDZ,
- $ U( J2+1, I2+1 ), LDU, ONE,
- $ WV( 1, 1+I2 ), LDWV )
-*
-* ==== Copy the result back to Z ====
-*
- CALL DLACPY( 'ALL', JLEN, KDU, WV, LDWV,
- $ Z( JROW, INCOL+1 ), LDZ )
- 210 CONTINUE
- END IF
- END IF
- END IF
- 220 CONTINUE
-*
-* ==== End of DLAQR5 ====
-*
- END
diff --git a/netlib/LAPACK/dlaqsb.f b/netlib/LAPACK/dlaqsb.f
deleted file mode 100644
index b15ea6b..0000000
--- a/netlib/LAPACK/dlaqsb.f
+++ /dev/null
@@ -1,226 +0,0 @@
-*> \brief \b DLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQSB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqsb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqsb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqsb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, UPLO
-* INTEGER KD, LDAB, N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQSB equilibrates a symmetric band matrix A using the scaling
-*> factors in the vector S.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> The scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> Ratio of the smallest S(i) to the largest S(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies whether or not equilibration was done.
-*> = 'N': No equilibration.
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if scaling should be done
-*> based on the ratio of the scaling factors. If SCOND < THRESH,
-*> scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if scaling should
-*> be done based on the absolute size of the largest matrix element.
-*> If AMAX > LARGE or AMAX < SMALL, scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, UPLO
- INTEGER KD, LDAB, N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
-*
-* No equilibration
-*
- EQUED = 'N'
- ELSE
-*
-* Replace A by diag(S) * A * diag(S).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Upper triangle of A is stored in band format.
-*
- DO 20 J = 1, N
- CJ = S( J )
- DO 10 I = MAX( 1, J-KD ), J
- AB( KD+1+I-J, J ) = CJ*S( I )*AB( KD+1+I-J, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
-*
-* Lower triangle of A is stored.
-*
- DO 40 J = 1, N
- CJ = S( J )
- DO 30 I = J, MIN( N, J+KD )
- AB( 1+I-J, J ) = CJ*S( I )*AB( 1+I-J, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- EQUED = 'Y'
- END IF
-*
- RETURN
-*
-* End of DLAQSB
-*
- END
diff --git a/netlib/LAPACK/dlaqsp.f b/netlib/LAPACK/dlaqsp.f
deleted file mode 100644
index 67ceb46..0000000
--- a/netlib/LAPACK/dlaqsp.f
+++ /dev/null
@@ -1,212 +0,0 @@
-*> \brief \b DLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQSP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqsp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqsp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqsp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, UPLO
-* INTEGER N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQSP equilibrates a symmetric matrix A using the scaling factors
-*> in the vector S.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the equilibrated matrix: diag(S) * A * diag(S), in
-*> the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> The scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> Ratio of the smallest S(i) to the largest S(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies whether or not equilibration was done.
-*> = 'N': No equilibration.
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if scaling should be done
-*> based on the ratio of the scaling factors. If SCOND < THRESH,
-*> scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if scaling should
-*> be done based on the absolute size of the largest matrix element.
-*> If AMAX > LARGE or AMAX < SMALL, scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, UPLO
- INTEGER N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, JC
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
-*
-* No equilibration
-*
- EQUED = 'N'
- ELSE
-*
-* Replace A by diag(S) * A * diag(S).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Upper triangle of A is stored.
-*
- JC = 1
- DO 20 J = 1, N
- CJ = S( J )
- DO 10 I = 1, J
- AP( JC+I-1 ) = CJ*S( I )*AP( JC+I-1 )
- 10 CONTINUE
- JC = JC + J
- 20 CONTINUE
- ELSE
-*
-* Lower triangle of A is stored.
-*
- JC = 1
- DO 40 J = 1, N
- CJ = S( J )
- DO 30 I = J, N
- AP( JC+I-J ) = CJ*S( I )*AP( JC+I-J )
- 30 CONTINUE
- JC = JC + N - J + 1
- 40 CONTINUE
- END IF
- EQUED = 'Y'
- END IF
-*
- RETURN
-*
-* End of DLAQSP
-*
- END
diff --git a/netlib/LAPACK/dlaqsy.f b/netlib/LAPACK/dlaqsy.f
deleted file mode 100644
index 83ecf8c..0000000
--- a/netlib/LAPACK/dlaqsy.f
+++ /dev/null
@@ -1,216 +0,0 @@
-*> \brief \b DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQSY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqsy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqsy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqsy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, UPLO
-* INTEGER LDA, N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQSY equilibrates a symmetric matrix A using the scaling factors
-*> in the vector S.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if EQUED = 'Y', the equilibrated matrix:
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(N,1).
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> The scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> Ratio of the smallest S(i) to the largest S(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies whether or not equilibration was done.
-*> = 'N': No equilibration.
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if scaling should be done
-*> based on the ratio of the scaling factors. If SCOND < THRESH,
-*> scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if scaling should
-*> be done based on the absolute size of the largest matrix element.
-*> If AMAX > LARGE or AMAX < SMALL, scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, UPLO
- INTEGER LDA, N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
-*
-* No equilibration
-*
- EQUED = 'N'
- ELSE
-*
-* Replace A by diag(S) * A * diag(S).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Upper triangle of A is stored.
-*
- DO 20 J = 1, N
- CJ = S( J )
- DO 10 I = 1, J
- A( I, J ) = CJ*S( I )*A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
-*
-* Lower triangle of A is stored.
-*
- DO 40 J = 1, N
- CJ = S( J )
- DO 30 I = J, N
- A( I, J ) = CJ*S( I )*A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- EQUED = 'Y'
- END IF
-*
- RETURN
-*
-* End of DLAQSY
-*
- END
diff --git a/netlib/LAPACK/dlaqtr.f b/netlib/LAPACK/dlaqtr.f
deleted file mode 100644
index 189f5f8..0000000
--- a/netlib/LAPACK/dlaqtr.f
+++ /dev/null
@@ -1,748 +0,0 @@
-*> \brief \b DLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LREAL, LTRAN
-* INTEGER INFO, LDT, N
-* DOUBLE PRECISION SCALE, W
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( * ), T( LDT, * ), WORK( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQTR solves the real quasi-triangular system
-*>
-*> op(T)*p = scale*c, if LREAL = .TRUE.
-*>
-*> or the complex quasi-triangular systems
-*>
-*> op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
-*>
-*> in real arithmetic, where T is upper quasi-triangular.
-*> If LREAL = .FALSE., then the first diagonal block of T must be
-*> 1 by 1, B is the specially structured matrix
-*>
-*> B = [ b(1) b(2) ... b(n) ]
-*> [ w ]
-*> [ w ]
-*> [ . ]
-*> [ w ]
-*>
-*> op(A) = A or A**T, A**T denotes the transpose of
-*> matrix A.
-*>
-*> On input, X = [ c ]. On output, X = [ p ].
-*> [ d ] [ q ]
-*>
-*> This subroutine is designed for the condition number estimation
-*> in routine DTRSNA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRAN
-*> \verbatim
-*> LTRAN is LOGICAL
-*> On entry, LTRAN specifies the option of conjugate transpose:
-*> = .FALSE., op(T+i*B) = T+i*B,
-*> = .TRUE., op(T+i*B) = (T+i*B)**T.
-*> \endverbatim
-*>
-*> \param[in] LREAL
-*> \verbatim
-*> LREAL is LOGICAL
-*> On entry, LREAL specifies the input matrix structure:
-*> = .FALSE., the input is complex
-*> = .TRUE., the input is real
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of T+i*B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> On entry, T contains a matrix in Schur canonical form.
-*> If LREAL = .FALSE., then the first diagonal block of T mu
-*> be 1 by 1.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the matrix T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (N)
-*> On entry, B contains the elements to form the matrix
-*> B as described above.
-*> If LREAL = .TRUE., B is not referenced.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is DOUBLE PRECISION
-*> On entry, W is the diagonal element of the matrix B.
-*> If LREAL = .TRUE., W is not referenced.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On exit, SCALE is the scale factor.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (2*N)
-*> On entry, X contains the right hand side of the system.
-*> On exit, X is overwritten by the solution.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO is set to
-*> 0: successful exit.
-*> 1: the some diagonal 1 by 1 block has been perturbed by
-*> a small number SMIN to keep nonsingularity.
-*> 2: the some diagonal 2 by 2 block has been perturbed by
-*> a small number in DLALN2 to keep nonsingularity.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL LREAL, LTRAN
- INTEGER INFO, LDT, N
- DOUBLE PRECISION SCALE, W
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( * ), T( LDT, * ), WORK( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER I, IERR, J, J1, J2, JNEXT, K, N1, N2
- DOUBLE PRECISION BIGNUM, EPS, REC, SCALOC, SI, SMIN, SMINW,
- $ SMLNUM, SR, TJJ, TMP, XJ, XMAX, XNORM, Z
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION D( 2, 2 ), V( 2, 2 )
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH, DLANGE
- EXTERNAL IDAMAX, DASUM, DDOT, DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLADIV, DLALN2, DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Do not test the input parameters for errors
-*
- NOTRAN = .NOT.LTRAN
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
-*
- XNORM = DLANGE( 'M', N, N, T, LDT, D )
- IF( .NOT.LREAL )
- $ XNORM = MAX( XNORM, ABS( W ), DLANGE( 'M', N, 1, B, N, D ) )
- SMIN = MAX( SMLNUM, EPS*XNORM )
-*
-* Compute 1-norm of each column of strictly upper triangular
-* part of T to control overflow in triangular solver.
-*
- WORK( 1 ) = ZERO
- DO 10 J = 2, N
- WORK( J ) = DASUM( J-1, T( 1, J ), 1 )
- 10 CONTINUE
-*
- IF( .NOT.LREAL ) THEN
- DO 20 I = 2, N
- WORK( I ) = WORK( I ) + ABS( B( I ) )
- 20 CONTINUE
- END IF
-*
- N2 = 2*N
- N1 = N
- IF( .NOT.LREAL )
- $ N1 = N2
- K = IDAMAX( N1, X, 1 )
- XMAX = ABS( X( K ) )
- SCALE = ONE
-*
- IF( XMAX.GT.BIGNUM ) THEN
- SCALE = BIGNUM / XMAX
- CALL DSCAL( N1, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( LREAL ) THEN
-*
- IF( NOTRAN ) THEN
-*
-* Solve T*p = scale*c
-*
- JNEXT = N
- DO 30 J = N, 1, -1
- IF( J.GT.JNEXT )
- $ GO TO 30
- J1 = J
- J2 = J
- JNEXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNEXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* Meet 1 by 1 diagonal block
-*
-* Scale to avoid overflow when computing
-* x(j) = b(j)/T(j,j)
-*
- XJ = ABS( X( J1 ) )
- TJJ = ABS( T( J1, J1 ) )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMIN ) THEN
- TMP = SMIN
- TJJ = SMIN
- INFO = 1
- END IF
-*
- IF( XJ.EQ.ZERO )
- $ GO TO 30
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J1 ) = X( J1 ) / TMP
- XJ = ABS( X( J1 ) )
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j1 of T.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( WORK( J1 ).GT.( BIGNUM-XMAX )*REC ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
- IF( J1.GT.1 ) THEN
- CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- K = IDAMAX( J1-1, X, 1 )
- XMAX = ABS( X( K ) )
- END IF
-*
- ELSE
-*
-* Meet 2 by 2 diagonal block
-*
-* Call 2 by 2 linear system solve, to take
-* care of possible overflow by scaling factor.
-*
- D( 1, 1 ) = X( J1 )
- D( 2, 1 ) = X( J2 )
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, ZERO, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL DSCAL( N, SCALOC, X, 1 )
- SCALE = SCALE*SCALOC
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
-*
-* Scale V(1,1) (= X(J1)) and/or V(2,1) (=X(J2))
-* to avoid overflow in updating right-hand side.
-*
- XJ = MAX( ABS( V( 1, 1 ) ), ABS( V( 2, 1 ) ) )
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( MAX( WORK( J1 ), WORK( J2 ) ).GT.
- $ ( BIGNUM-XMAX )*REC ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Update right-hand side
-*
- IF( J1.GT.1 ) THEN
- CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- CALL DAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 )
- K = IDAMAX( J1-1, X, 1 )
- XMAX = ABS( X( K ) )
- END IF
-*
- END IF
-*
- 30 CONTINUE
-*
- ELSE
-*
-* Solve T**T*p = scale*c
-*
- JNEXT = 1
- DO 40 J = 1, N
- IF( J.LT.JNEXT )
- $ GO TO 40
- J1 = J
- J2 = J
- JNEXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNEXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1 by 1 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side element by inner product.
-*
- XJ = ABS( X( J1 ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( WORK( J1 ).GT.( BIGNUM-XJ )*REC ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- X( J1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X, 1 )
-*
- XJ = ABS( X( J1 ) )
- TJJ = ABS( T( J1, J1 ) )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMIN ) THEN
- TMP = SMIN
- TJJ = SMIN
- INFO = 1
- END IF
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J1 ) = X( J1 ) / TMP
- XMAX = MAX( XMAX, ABS( X( J1 ) ) )
-*
- ELSE
-*
-* 2 by 2 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side elements by inner product.
-*
- XJ = MAX( ABS( X( J1 ) ), ABS( X( J2 ) ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( MAX( WORK( J2 ), WORK( J1 ) ).GT.( BIGNUM-XJ )*
- $ REC ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- D( 1, 1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X,
- $ 1 )
- D( 2, 1 ) = X( J2 ) - DDOT( J1-1, T( 1, J2 ), 1, X,
- $ 1 )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, ZERO, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL DSCAL( N, SCALOC, X, 1 )
- SCALE = SCALE*SCALOC
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
- XMAX = MAX( ABS( X( J1 ) ), ABS( X( J2 ) ), XMAX )
-*
- END IF
- 40 CONTINUE
- END IF
-*
- ELSE
-*
- SMINW = MAX( EPS*ABS( W ), SMIN )
- IF( NOTRAN ) THEN
-*
-* Solve (T + iB)*(p+iq) = c+id
-*
- JNEXT = N
- DO 70 J = N, 1, -1
- IF( J.GT.JNEXT )
- $ GO TO 70
- J1 = J
- J2 = J
- JNEXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNEXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1 by 1 diagonal block
-*
-* Scale if necessary to avoid overflow in division
-*
- Z = W
- IF( J1.EQ.1 )
- $ Z = B( 1 )
- XJ = ABS( X( J1 ) ) + ABS( X( N+J1 ) )
- TJJ = ABS( T( J1, J1 ) ) + ABS( Z )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMINW ) THEN
- TMP = SMINW
- TJJ = SMINW
- INFO = 1
- END IF
-*
- IF( XJ.EQ.ZERO )
- $ GO TO 70
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL DSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- CALL DLADIV( X( J1 ), X( N+J1 ), TMP, Z, SR, SI )
- X( J1 ) = SR
- X( N+J1 ) = SI
- XJ = ABS( X( J1 ) ) + ABS( X( N+J1 ) )
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j1 of T.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( WORK( J1 ).GT.( BIGNUM-XMAX )*REC ) THEN
- CALL DSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
-*
- IF( J1.GT.1 ) THEN
- CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- CALL DAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
-*
- X( 1 ) = X( 1 ) + B( J1 )*X( N+J1 )
- X( N+1 ) = X( N+1 ) - B( J1 )*X( J1 )
-*
- XMAX = ZERO
- DO 50 K = 1, J1 - 1
- XMAX = MAX( XMAX, ABS( X( K ) )+
- $ ABS( X( K+N ) ) )
- 50 CONTINUE
- END IF
-*
- ELSE
-*
-* Meet 2 by 2 diagonal block
-*
- D( 1, 1 ) = X( J1 )
- D( 2, 1 ) = X( J2 )
- D( 1, 2 ) = X( N+J1 )
- D( 2, 2 ) = X( N+J2 )
- CALL DLALN2( .FALSE., 2, 2, SMINW, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, -W, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL DSCAL( 2*N, SCALOC, X, 1 )
- SCALE = SCALOC*SCALE
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
- X( N+J1 ) = V( 1, 2 )
- X( N+J2 ) = V( 2, 2 )
-*
-* Scale X(J1), .... to avoid overflow in
-* updating right hand side.
-*
- XJ = MAX( ABS( V( 1, 1 ) )+ABS( V( 1, 2 ) ),
- $ ABS( V( 2, 1 ) )+ABS( V( 2, 2 ) ) )
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( MAX( WORK( J1 ), WORK( J2 ) ).GT.
- $ ( BIGNUM-XMAX )*REC ) THEN
- CALL DSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Update the right-hand side.
-*
- IF( J1.GT.1 ) THEN
- CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- CALL DAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 )
-*
- CALL DAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
- CALL DAXPY( J1-1, -X( N+J2 ), T( 1, J2 ), 1,
- $ X( N+1 ), 1 )
-*
- X( 1 ) = X( 1 ) + B( J1 )*X( N+J1 ) +
- $ B( J2 )*X( N+J2 )
- X( N+1 ) = X( N+1 ) - B( J1 )*X( J1 ) -
- $ B( J2 )*X( J2 )
-*
- XMAX = ZERO
- DO 60 K = 1, J1 - 1
- XMAX = MAX( ABS( X( K ) )+ABS( X( K+N ) ),
- $ XMAX )
- 60 CONTINUE
- END IF
-*
- END IF
- 70 CONTINUE
-*
- ELSE
-*
-* Solve (T + iB)**T*(p+iq) = c+id
-*
- JNEXT = 1
- DO 80 J = 1, N
- IF( J.LT.JNEXT )
- $ GO TO 80
- J1 = J
- J2 = J
- JNEXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNEXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1 by 1 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side element by inner product.
-*
- XJ = ABS( X( J1 ) ) + ABS( X( J1+N ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( WORK( J1 ).GT.( BIGNUM-XJ )*REC ) THEN
- CALL DSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- X( J1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X, 1 )
- X( N+J1 ) = X( N+J1 ) - DDOT( J1-1, T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
- IF( J1.GT.1 ) THEN
- X( J1 ) = X( J1 ) - B( J1 )*X( N+1 )
- X( N+J1 ) = X( N+J1 ) + B( J1 )*X( 1 )
- END IF
- XJ = ABS( X( J1 ) ) + ABS( X( J1+N ) )
-*
- Z = W
- IF( J1.EQ.1 )
- $ Z = B( 1 )
-*
-* Scale if necessary to avoid overflow in
-* complex division
-*
- TJJ = ABS( T( J1, J1 ) ) + ABS( Z )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMINW ) THEN
- TMP = SMINW
- TJJ = SMINW
- INFO = 1
- END IF
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL DSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- CALL DLADIV( X( J1 ), X( N+J1 ), TMP, -Z, SR, SI )
- X( J1 ) = SR
- X( J1+N ) = SI
- XMAX = MAX( ABS( X( J1 ) )+ABS( X( J1+N ) ), XMAX )
-*
- ELSE
-*
-* 2 by 2 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side element by inner product.
-*
- XJ = MAX( ABS( X( J1 ) )+ABS( X( N+J1 ) ),
- $ ABS( X( J2 ) )+ABS( X( N+J2 ) ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( MAX( WORK( J1 ), WORK( J2 ) ).GT.
- $ ( BIGNUM-XJ ) / XMAX ) THEN
- CALL DSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- D( 1, 1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X,
- $ 1 )
- D( 2, 1 ) = X( J2 ) - DDOT( J1-1, T( 1, J2 ), 1, X,
- $ 1 )
- D( 1, 2 ) = X( N+J1 ) - DDOT( J1-1, T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
- D( 2, 2 ) = X( N+J2 ) - DDOT( J1-1, T( 1, J2 ), 1,
- $ X( N+1 ), 1 )
- D( 1, 1 ) = D( 1, 1 ) - B( J1 )*X( N+1 )
- D( 2, 1 ) = D( 2, 1 ) - B( J2 )*X( N+1 )
- D( 1, 2 ) = D( 1, 2 ) + B( J1 )*X( 1 )
- D( 2, 2 ) = D( 2, 2 ) + B( J2 )*X( 1 )
-*
- CALL DLALN2( .TRUE., 2, 2, SMINW, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, W, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL DSCAL( N2, SCALOC, X, 1 )
- SCALE = SCALOC*SCALE
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
- X( N+J1 ) = V( 1, 2 )
- X( N+J2 ) = V( 2, 2 )
- XMAX = MAX( ABS( X( J1 ) )+ABS( X( N+J1 ) ),
- $ ABS( X( J2 ) )+ABS( X( N+J2 ) ), XMAX )
-*
- END IF
-*
- 80 CONTINUE
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DLAQTR
-*
- END
diff --git a/netlib/LAPACK/dlar1v.f b/netlib/LAPACK/dlar1v.f
deleted file mode 100644
index 1234328..0000000
--- a/netlib/LAPACK/dlar1v.f
+++ /dev/null
@@ -1,486 +0,0 @@
-*> \brief \b DLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAR1V + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlar1v.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlar1v.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlar1v.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD,
-* PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA,
-* R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTNC
-* INTEGER B1, BN, N, NEGCNT, R
-* DOUBLE PRECISION GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID,
-* $ RQCORR, ZTZ
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * )
-* DOUBLE PRECISION D( * ), L( * ), LD( * ), LLD( * ),
-* $ WORK( * )
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAR1V computes the (scaled) r-th column of the inverse of
-*> the sumbmatrix in rows B1 through BN of the tridiagonal matrix
-*> L D L**T - sigma I. When sigma is close to an eigenvalue, the
-*> computed vector is an accurate eigenvector. Usually, r corresponds
-*> to the index where the eigenvector is largest in magnitude.
-*> The following steps accomplish this computation :
-*> (a) Stationary qd transform, L D L**T - sigma I = L(+) D(+) L(+)**T,
-*> (b) Progressive qd transform, L D L**T - sigma I = U(-) D(-) U(-)**T,
-*> (c) Computation of the diagonal elements of the inverse of
-*> L D L**T - sigma I by combining the above transforms, and choosing
-*> r as the index where the diagonal of the inverse is (one of the)
-*> largest in magnitude.
-*> (d) Computation of the (scaled) r-th column of the inverse using the
-*> twisted factorization obtained by combining the top part of the
-*> the stationary and the bottom part of the progressive transform.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix L D L**T.
-*> \endverbatim
-*>
-*> \param[in] B1
-*> \verbatim
-*> B1 is INTEGER
-*> First index of the submatrix of L D L**T.
-*> \endverbatim
-*>
-*> \param[in] BN
-*> \verbatim
-*> BN is INTEGER
-*> Last index of the submatrix of L D L**T.
-*> \endverbatim
-*>
-*> \param[in] LAMBDA
-*> \verbatim
-*> LAMBDA is DOUBLE PRECISION
-*> The shift. In order to compute an accurate eigenvector,
-*> LAMBDA should be a good approximation to an eigenvalue
-*> of L D L**T.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal matrix
-*> L, in elements 1 to N-1.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] LD
-*> \verbatim
-*> LD is DOUBLE PRECISION array, dimension (N-1)
-*> The n-1 elements L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] LLD
-*> \verbatim
-*> LLD is DOUBLE PRECISION array, dimension (N-1)
-*> The n-1 elements L(i)*L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[in] GAPTOL
-*> \verbatim
-*> GAPTOL is DOUBLE PRECISION
-*> Tolerance that indicates when eigenvector entries are negligible
-*> w.r.t. their contribution to the residual.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (N)
-*> On input, all entries of Z must be set to 0.
-*> On output, Z contains the (scaled) r-th column of the
-*> inverse. The scaling is such that Z(R) equals 1.
-*> \endverbatim
-*>
-*> \param[in] WANTNC
-*> \verbatim
-*> WANTNC is LOGICAL
-*> Specifies whether NEGCNT has to be computed.
-*> \endverbatim
-*>
-*> \param[out] NEGCNT
-*> \verbatim
-*> NEGCNT is INTEGER
-*> If WANTNC is .TRUE. then NEGCNT = the number of pivots < pivmin
-*> in the matrix factorization L D L**T, and NEGCNT = -1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] ZTZ
-*> \verbatim
-*> ZTZ is DOUBLE PRECISION
-*> The square of the 2-norm of Z.
-*> \endverbatim
-*>
-*> \param[out] MINGMA
-*> \verbatim
-*> MINGMA is DOUBLE PRECISION
-*> The reciprocal of the largest (in magnitude) diagonal
-*> element of the inverse of L D L**T - sigma I.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is INTEGER
-*> The twist index for the twisted factorization used to
-*> compute Z.
-*> On input, 0 <= R <= N. If R is input as 0, R is set to
-*> the index where (L D L**T - sigma I)^{-1} is largest
-*> in magnitude. If 1 <= R <= N, R is unchanged.
-*> On output, R contains the twist index used to compute Z.
-*> Ideally, R designates the position of the maximum entry in the
-*> eigenvector.
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension (2)
-*> The support of the vector in Z, i.e., the vector Z is
-*> nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
-*> \endverbatim
-*>
-*> \param[out] NRMINV
-*> \verbatim
-*> NRMINV is DOUBLE PRECISION
-*> NRMINV = 1/SQRT( ZTZ )
-*> \endverbatim
-*>
-*> \param[out] RESID
-*> \verbatim
-*> RESID is DOUBLE PRECISION
-*> The residual of the FP vector.
-*> RESID = ABS( MINGMA )/SQRT( ZTZ )
-*> \endverbatim
-*>
-*> \param[out] RQCORR
-*> \verbatim
-*> RQCORR is DOUBLE PRECISION
-*> The Rayleigh Quotient correction to LAMBDA.
-*> RQCORR = MINGMA*TMP
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD,
- $ PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA,
- $ R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL WANTNC
- INTEGER B1, BN, N, NEGCNT, R
- DOUBLE PRECISION GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID,
- $ RQCORR, ZTZ
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * )
- DOUBLE PRECISION D( * ), L( * ), LD( * ), LLD( * ),
- $ WORK( * )
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-
-* ..
-* .. Local Scalars ..
- LOGICAL SAWNAN1, SAWNAN2
- INTEGER I, INDLPL, INDP, INDS, INDUMN, NEG1, NEG2, R1,
- $ R2
- DOUBLE PRECISION DMINUS, DPLUS, EPS, S, TMP
-* ..
-* .. External Functions ..
- LOGICAL DISNAN
- DOUBLE PRECISION DLAMCH
- EXTERNAL DISNAN, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- EPS = DLAMCH( 'Precision' )
-
-
- IF( R.EQ.0 ) THEN
- R1 = B1
- R2 = BN
- ELSE
- R1 = R
- R2 = R
- END IF
-
-* Storage for LPLUS
- INDLPL = 0
-* Storage for UMINUS
- INDUMN = N
- INDS = 2*N + 1
- INDP = 3*N + 1
-
- IF( B1.EQ.1 ) THEN
- WORK( INDS ) = ZERO
- ELSE
- WORK( INDS+B1-1 ) = LLD( B1-1 )
- END IF
-
-*
-* Compute the stationary transform (using the differential form)
-* until the index R2.
-*
- SAWNAN1 = .FALSE.
- NEG1 = 0
- S = WORK( INDS+B1-1 ) - LAMBDA
- DO 50 I = B1, R1 - 1
- DPLUS = D( I ) + S
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- IF(DPLUS.LT.ZERO) NEG1 = NEG1 + 1
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- S = WORK( INDS+I ) - LAMBDA
- 50 CONTINUE
- SAWNAN1 = DISNAN( S )
- IF( SAWNAN1 ) GOTO 60
- DO 51 I = R1, R2 - 1
- DPLUS = D( I ) + S
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- S = WORK( INDS+I ) - LAMBDA
- 51 CONTINUE
- SAWNAN1 = DISNAN( S )
-*
- 60 CONTINUE
- IF( SAWNAN1 ) THEN
-* Runs a slower version of the above loop if a NaN is detected
- NEG1 = 0
- S = WORK( INDS+B1-1 ) - LAMBDA
- DO 70 I = B1, R1 - 1
- DPLUS = D( I ) + S
- IF(ABS(DPLUS).LT.PIVMIN) DPLUS = -PIVMIN
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- IF(DPLUS.LT.ZERO) NEG1 = NEG1 + 1
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- IF( WORK( INDLPL+I ).EQ.ZERO )
- $ WORK( INDS+I ) = LLD( I )
- S = WORK( INDS+I ) - LAMBDA
- 70 CONTINUE
- DO 71 I = R1, R2 - 1
- DPLUS = D( I ) + S
- IF(ABS(DPLUS).LT.PIVMIN) DPLUS = -PIVMIN
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- IF( WORK( INDLPL+I ).EQ.ZERO )
- $ WORK( INDS+I ) = LLD( I )
- S = WORK( INDS+I ) - LAMBDA
- 71 CONTINUE
- END IF
-*
-* Compute the progressive transform (using the differential form)
-* until the index R1
-*
- SAWNAN2 = .FALSE.
- NEG2 = 0
- WORK( INDP+BN-1 ) = D( BN ) - LAMBDA
- DO 80 I = BN - 1, R1, -1
- DMINUS = LLD( I ) + WORK( INDP+I )
- TMP = D( I ) / DMINUS
- IF(DMINUS.LT.ZERO) NEG2 = NEG2 + 1
- WORK( INDUMN+I ) = L( I )*TMP
- WORK( INDP+I-1 ) = WORK( INDP+I )*TMP - LAMBDA
- 80 CONTINUE
- TMP = WORK( INDP+R1-1 )
- SAWNAN2 = DISNAN( TMP )
-
- IF( SAWNAN2 ) THEN
-* Runs a slower version of the above loop if a NaN is detected
- NEG2 = 0
- DO 100 I = BN-1, R1, -1
- DMINUS = LLD( I ) + WORK( INDP+I )
- IF(ABS(DMINUS).LT.PIVMIN) DMINUS = -PIVMIN
- TMP = D( I ) / DMINUS
- IF(DMINUS.LT.ZERO) NEG2 = NEG2 + 1
- WORK( INDUMN+I ) = L( I )*TMP
- WORK( INDP+I-1 ) = WORK( INDP+I )*TMP - LAMBDA
- IF( TMP.EQ.ZERO )
- $ WORK( INDP+I-1 ) = D( I ) - LAMBDA
- 100 CONTINUE
- END IF
-*
-* Find the index (from R1 to R2) of the largest (in magnitude)
-* diagonal element of the inverse
-*
- MINGMA = WORK( INDS+R1-1 ) + WORK( INDP+R1-1 )
- IF( MINGMA.LT.ZERO ) NEG1 = NEG1 + 1
- IF( WANTNC ) THEN
- NEGCNT = NEG1 + NEG2
- ELSE
- NEGCNT = -1
- ENDIF
- IF( ABS(MINGMA).EQ.ZERO )
- $ MINGMA = EPS*WORK( INDS+R1-1 )
- R = R1
- DO 110 I = R1, R2 - 1
- TMP = WORK( INDS+I ) + WORK( INDP+I )
- IF( TMP.EQ.ZERO )
- $ TMP = EPS*WORK( INDS+I )
- IF( ABS( TMP ).LE.ABS( MINGMA ) ) THEN
- MINGMA = TMP
- R = I + 1
- END IF
- 110 CONTINUE
-*
-* Compute the FP vector: solve N^T v = e_r
-*
- ISUPPZ( 1 ) = B1
- ISUPPZ( 2 ) = BN
- Z( R ) = ONE
- ZTZ = ONE
-*
-* Compute the FP vector upwards from R
-*
- IF( .NOT.SAWNAN1 .AND. .NOT.SAWNAN2 ) THEN
- DO 210 I = R-1, B1, -1
- Z( I ) = -( WORK( INDLPL+I )*Z( I+1 ) )
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I ) = ZERO
- ISUPPZ( 1 ) = I + 1
- GOTO 220
- ENDIF
- ZTZ = ZTZ + Z( I )*Z( I )
- 210 CONTINUE
- 220 CONTINUE
- ELSE
-* Run slower loop if NaN occurred.
- DO 230 I = R - 1, B1, -1
- IF( Z( I+1 ).EQ.ZERO ) THEN
- Z( I ) = -( LD( I+1 ) / LD( I ) )*Z( I+2 )
- ELSE
- Z( I ) = -( WORK( INDLPL+I )*Z( I+1 ) )
- END IF
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I ) = ZERO
- ISUPPZ( 1 ) = I + 1
- GO TO 240
- END IF
- ZTZ = ZTZ + Z( I )*Z( I )
- 230 CONTINUE
- 240 CONTINUE
- ENDIF
-
-* Compute the FP vector downwards from R in blocks of size BLKSIZ
- IF( .NOT.SAWNAN1 .AND. .NOT.SAWNAN2 ) THEN
- DO 250 I = R, BN-1
- Z( I+1 ) = -( WORK( INDUMN+I )*Z( I ) )
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I+1 ) = ZERO
- ISUPPZ( 2 ) = I
- GO TO 260
- END IF
- ZTZ = ZTZ + Z( I+1 )*Z( I+1 )
- 250 CONTINUE
- 260 CONTINUE
- ELSE
-* Run slower loop if NaN occurred.
- DO 270 I = R, BN - 1
- IF( Z( I ).EQ.ZERO ) THEN
- Z( I+1 ) = -( LD( I-1 ) / LD( I ) )*Z( I-1 )
- ELSE
- Z( I+1 ) = -( WORK( INDUMN+I )*Z( I ) )
- END IF
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I+1 ) = ZERO
- ISUPPZ( 2 ) = I
- GO TO 280
- END IF
- ZTZ = ZTZ + Z( I+1 )*Z( I+1 )
- 270 CONTINUE
- 280 CONTINUE
- END IF
-*
-* Compute quantities for convergence test
-*
- TMP = ONE / ZTZ
- NRMINV = SQRT( TMP )
- RESID = ABS( MINGMA )*NRMINV
- RQCORR = MINGMA*TMP
-*
-*
- RETURN
-*
-* End of DLAR1V
-*
- END
diff --git a/netlib/LAPACK/dlar2v.f b/netlib/LAPACK/dlar2v.f
deleted file mode 100644
index a6766ba..0000000
--- a/netlib/LAPACK/dlar2v.f
+++ /dev/null
@@ -1,157 +0,0 @@
-*> \brief \b DLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAR2V + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlar2v.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlar2v.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlar2v.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAR2V( N, X, Y, Z, INCX, C, S, INCC )
-*
-* .. Scalar Arguments ..
-* INTEGER INCC, INCX, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( * ), S( * ), X( * ), Y( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAR2V applies a vector of real plane rotations from both sides to
-*> a sequence of 2-by-2 real symmetric matrices, defined by the elements
-*> of the vectors x, y and z. For i = 1,2,...,n
-*>
-*> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) )
-*> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of plane rotations to be applied.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCX)
-*> The vector x.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCX)
-*> The vector y.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCX)
-*> The vector z.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X, Y and Z. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
-*> The cosines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
-*> The sines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCC
-*> \verbatim
-*> INCC is INTEGER
-*> The increment between elements of C and S. INCC > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAR2V( N, X, Y, Z, INCX, C, S, INCC )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCC, INCX, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( * ), S( * ), X( * ), Y( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IC, IX
- DOUBLE PRECISION CI, SI, T1, T2, T3, T4, T5, T6, XI, YI, ZI
-* ..
-* .. Executable Statements ..
-*
- IX = 1
- IC = 1
- DO 10 I = 1, N
- XI = X( IX )
- YI = Y( IX )
- ZI = Z( IX )
- CI = C( IC )
- SI = S( IC )
- T1 = SI*ZI
- T2 = CI*ZI
- T3 = T2 - SI*XI
- T4 = T2 + SI*YI
- T5 = CI*XI + T1
- T6 = CI*YI - T1
- X( IX ) = CI*T5 + SI*T4
- Y( IX ) = CI*T6 - SI*T3
- Z( IX ) = CI*T4 - SI*T5
- IX = IX + INCX
- IC = IC + INCC
- 10 CONTINUE
-*
-* End of DLAR2V
-*
- RETURN
- END
diff --git a/netlib/LAPACK/dlaran.f b/netlib/LAPACK/dlaran.f
deleted file mode 100644
index 6dbb051..0000000
--- a/netlib/LAPACK/dlaran.f
+++ /dev/null
@@ -1,146 +0,0 @@
-*> \brief \b DLARAN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLARAN( ISEED )
-*
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARAN returns a random real number from a uniform (0,1)
-*> distribution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup list_temp
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine uses a multiplicative congruential method with modulus
-*> 2**48 and multiplier 33952834046453 (see G.S.Fishman,
-*> 'Multiplicative congruential random number generators with modulus
-*> 2**b: an exhaustive analysis for b = 32 and a partial analysis for
-*> b = 48', Math. Comp. 189, pp 331-344, 1990).
-*>
-*> 48-bit integers are stored in 4 integer array elements with 12 bits
-*> per element. Hence the routine is portable across machines with
-*> integers of 32 bits or more.
-*> \endverbatim
-*>
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLARAN( ISEED )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER M1, M2, M3, M4
- PARAMETER ( M1 = 494, M2 = 322, M3 = 2508, M4 = 2549 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- INTEGER IPW2
- DOUBLE PRECISION R
- PARAMETER ( IPW2 = 4096, R = ONE / IPW2 )
-* ..
-* .. Local Scalars ..
- INTEGER IT1, IT2, IT3, IT4
- DOUBLE PRECISION RNDOUT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MOD
-* ..
-* .. Executable Statements ..
- 10 CONTINUE
-*
-* multiply the seed by the multiplier modulo 2**48
-*
- IT4 = ISEED( 4 )*M4
- IT3 = IT4 / IPW2
- IT4 = IT4 - IPW2*IT3
- IT3 = IT3 + ISEED( 3 )*M4 + ISEED( 4 )*M3
- IT2 = IT3 / IPW2
- IT3 = IT3 - IPW2*IT2
- IT2 = IT2 + ISEED( 2 )*M4 + ISEED( 3 )*M3 + ISEED( 4 )*M2
- IT1 = IT2 / IPW2
- IT2 = IT2 - IPW2*IT1
- IT1 = IT1 + ISEED( 1 )*M4 + ISEED( 2 )*M3 + ISEED( 3 )*M2 +
- $ ISEED( 4 )*M1
- IT1 = MOD( IT1, IPW2 )
-*
-* return updated seed
-*
- ISEED( 1 ) = IT1
- ISEED( 2 ) = IT2
- ISEED( 3 ) = IT3
- ISEED( 4 ) = IT4
-*
-* convert 48-bit integer to a real number in the interval (0,1)
-*
- RNDOUT = R*( DBLE( IT1 )+R*( DBLE( IT2 )+R*( DBLE( IT3 )+R*
- $ ( DBLE( IT4 ) ) ) ) )
-*
- IF (RNDOUT.EQ.1.0D+0) THEN
-* If a real number has n bits of precision, and the first
-* n bits of the 48-bit integer above happen to be all 1 (which
-* will occur about once every 2**n calls), then DLARAN will
-* be rounded to exactly 1.0.
-* Since DLARAN is not supposed to return exactly 0.0 or 1.0
-* (and some callers of DLARAN, such as CLARND, depend on that),
-* the statistically correct thing to do in this situation is
-* simply to iterate again.
-* N.B. the case DLARAN = 0.0 should not be possible.
-*
- GOTO 10
- END IF
-*
- DLARAN = RNDOUT
- RETURN
-*
-* End of DLARAN
-*
- END
diff --git a/netlib/LAPACK/dlarf.f b/netlib/LAPACK/dlarf.f
deleted file mode 100644
index 80dca69..0000000
--- a/netlib/LAPACK/dlarf.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b DLARF applies an elementary reflector to a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, LDC, M, N
-* DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARF applies a real elementary reflector H to a real m by n matrix
-*> C, from either the left or the right. H is represented in the form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar and v is a real vector.
-*>
-*> If tau = 0, then H is taken to be the unit matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*> The vector v in the representation of H. V is not used if
-*> TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, LDC, M, N
- DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL APPLYLEFT
- INTEGER I, LASTV, LASTC
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILADLR, ILADLC
- EXTERNAL LSAME, ILADLR, ILADLC
-* ..
-* .. Executable Statements ..
-*
- APPLYLEFT = LSAME( SIDE, 'L' )
- LASTV = 0
- LASTC = 0
- IF( TAU.NE.ZERO ) THEN
-! Set up variables for scanning V. LASTV begins pointing to the end
-! of V.
- IF( APPLYLEFT ) THEN
- LASTV = M
- ELSE
- LASTV = N
- END IF
- IF( INCV.GT.0 ) THEN
- I = 1 + (LASTV-1) * INCV
- ELSE
- I = 1
- END IF
-! Look for the last non-zero row in V.
- DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
- LASTV = LASTV - 1
- I = I - INCV
- END DO
- IF( APPLYLEFT ) THEN
-! Scan for the last non-zero column in C(1:lastv,:).
- LASTC = ILADLC(LASTV, N, C, LDC)
- ELSE
-! Scan for the last non-zero row in C(:,1:lastv).
- LASTC = ILADLR(M, LASTV, C, LDC)
- END IF
- END IF
-! Note that lastc.eq.0 renders the BLAS operations null; no special
-! case is needed at this level.
- IF( APPLYLEFT ) THEN
-*
-* Form H * C
-*
- IF( LASTV.GT.0 ) THEN
-*
-* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
-*
- CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
- $ ZERO, WORK, 1 )
-*
-* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
-*
- CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
- END IF
- ELSE
-*
-* Form C * H
-*
- IF( LASTV.GT.0 ) THEN
-*
-* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
-*
- CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
- $ V, INCV, ZERO, WORK, 1 )
-*
-* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
-*
- CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
- END IF
- END IF
- RETURN
-*
-* End of DLARF
-*
- END
diff --git a/netlib/LAPACK/dlarfb.f b/netlib/LAPACK/dlarfb.f
deleted file mode 100644
index 1721847..0000000
--- a/netlib/LAPACK/dlarfb.f
+++ /dev/null
@@ -1,758 +0,0 @@
-*> \brief \b DLARFB applies a block reflector or its transpose to a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
-* T, LDT, C, LDC, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
-* $ WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARFB applies a real block reflector H or its transpose H**T to a
-*> real m by n matrix C, from either the left or the right.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H**T from the Left
-*> = 'R': apply H or H**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'T': apply H**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = '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
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columnwise
-*> = 'R': Rowwise
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T (= the number of elementary
-*> reflectors whose product defines the block reflector).
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*> (LDV,N) if STOREV = 'R' and SIDE = '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' and SIDE = 'L', LDV >= max(1,M);
-*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*> if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The triangular k by k matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LDWORK,K)
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= max(1,N);
-*> if SIDE = 'R', LDWORK >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \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; the corresponding
-*> array elements are modified but restored on exit. The rest of the
-*> array is not used.
-*>
-*> 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 DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
- $ T, LDT, C, LDC, WORK, LDWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
- $ WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST
- INTEGER I, J, LASTV, LASTC, lastv2
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILADLR, ILADLC
- EXTERNAL LSAME, ILADLR, ILADLC
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DTRMM
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
- IF( LSAME( TRANS, 'N' ) ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-* Let V = ( V1 ) (first K rows)
-* ( V2 )
-* where V1 is unit lower triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILADLR( M, K, V, LDV ) )
- LASTC = ILADLC( LASTV, N, C, LDC )
-*
-* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
-*
-* W := C1**T
-*
- DO 10 J = 1, K
- CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 10 CONTINUE
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2**T *V2
-*
- CALL DGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - V2 * W**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTV-K, LASTC, K,
- $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
- $ C( K+1, 1 ), LDC )
- END IF
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W**T
-*
- DO 30 J = 1, K
- DO 20 I = 1, LASTC
- C( J, I ) = C( J, I ) - WORK( I, J )
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILADLR( N, K, V, LDV ) )
- LASTC = ILADLR( M, LASTV, C, LDC )
-*
-* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
-*
-* W := C1
-*
- DO 40 J = 1, K
- CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
- 40 CONTINUE
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2 * V2
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - W * V2**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, LASTV-K, K,
- $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
- $ C( 1, K+1 ), LDC )
- END IF
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 60 J = 1, K
- DO 50 I = 1, LASTC
- C( I, J ) = C( I, J ) - WORK( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- ELSE
-*
-* Let V = ( V1 )
-* ( V2 ) (last K rows)
-* where V2 is unit upper triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTC = ILADLC( M, N, C, LDC )
-*
-* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
-*
-* W := C2**T
-*
- DO 70 J = 1, K
- CALL DCOPY( LASTC, C( M-K+J, 1 ), LDC,
- $ WORK( 1, J ), 1 )
- 70 CONTINUE
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
- $ WORK, LDWORK )
- IF( M.GT.K ) THEN
-*
-* W := W + C1**T*V1
-*
- CALL DGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V * W**T
-*
- IF( M.GT.K ) THEN
-*
-* C1 := C1 - V1 * W**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W**T
-*
- DO 90 J = 1, K
- DO 80 I = 1, LASTC
- C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
- 80 CONTINUE
- 90 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTC = ILADLR( M, N, C, LDC )
-*
-* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
-*
-* W := C2
-*
- DO 100 J = 1, K
- CALL DCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
- 100 CONTINUE
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
- $ WORK, LDWORK )
- IF( N.GT.K ) THEN
-*
-* W := W + C1 * V1
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V**T
-*
- IF( N.GT.K ) THEN
-*
-* C1 := C1 - W * V1**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W
-*
- DO 120 J = 1, K
- DO 110 I = 1, LASTC
- C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J)
- 110 CONTINUE
- 120 CONTINUE
- END IF
- END IF
-*
- ELSE IF( LSAME( STOREV, 'R' ) ) THEN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-* Let V = ( V1 V2 ) (V1: first K columns)
-* where V1 is unit upper triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILADLC( K, M, V, LDV ) )
- LASTC = ILADLC( LASTV, N, C, LDC )
-*
-* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
-*
-* W := C1**T
-*
- DO 130 J = 1, K
- CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 130 CONTINUE
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2**T*V2**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V**T * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - V2**T * W**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTV-K, LASTC, K,
- $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
- $ ONE, C( K+1, 1 ), LDC )
- END IF
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W**T
-*
- DO 150 J = 1, K
- DO 140 I = 1, LASTC
- C( J, I ) = C( J, I ) - WORK( I, J )
- 140 CONTINUE
- 150 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILADLC( K, N, V, LDV ) )
- LASTC = ILADLR( M, LASTV, C, LDC )
-*
-* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
-*
-* W := C1
-*
- DO 160 J = 1, K
- CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
- 160 CONTINUE
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2 * V2**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - W * V2
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K,
- $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
- $ ONE, C( 1, K+1 ), LDC )
- END IF
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 180 J = 1, K
- DO 170 I = 1, LASTC
- C( I, J ) = C( I, J ) - WORK( I, J )
- 170 CONTINUE
- 180 CONTINUE
-*
- END IF
-*
- ELSE
-*
-* Let V = ( V1 V2 ) (V2: last K columns)
-* where V2 is unit lower triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTC = ILADLC( M, N, C, LDC )
-*
-* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
-*
-* W := C2**T
-*
- DO 190 J = 1, K
- CALL DCOPY( LASTC, C( M-K+J, 1 ), LDC,
- $ WORK( 1, J ), 1 )
- 190 CONTINUE
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
- $ WORK, LDWORK )
- IF( M.GT.K ) THEN
-*
-* W := W + C1**T * V1**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V**T * W**T
-*
- IF( M.GT.K ) THEN
-*
-* C1 := C1 - V1**T * W**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W**T
-*
- DO 210 J = 1, K
- DO 200 I = 1, LASTC
- C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
- 200 CONTINUE
- 210 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTC = ILADLR( M, N, C, LDC )
-*
-* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
-*
-* W := C2
-*
- DO 220 J = 1, K
- CALL DCOPY( LASTC, C( 1, N-K+J ), 1,
- $ WORK( 1, J ), 1 )
- 220 CONTINUE
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
- $ WORK, LDWORK )
- IF( N.GT.K ) THEN
-*
-* W := W + C1 * V1**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V
-*
- IF( N.GT.K ) THEN
-*
-* C1 := C1 - W * V1
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
- $ WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 240 J = 1, K
- DO 230 I = 1, LASTC
- C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J)
- 230 CONTINUE
- 240 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
- RETURN
-*
-* End of DLARFB
-*
- END
diff --git a/netlib/LAPACK/dlarfg.f b/netlib/LAPACK/dlarfg.f
deleted file mode 100644
index ce91d33..0000000
--- a/netlib/LAPACK/dlarfg.f
+++ /dev/null
@@ -1,196 +0,0 @@
-*> \brief \b DLARFG generates an elementary reflector (Householder matrix).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION ALPHA, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARFG generates a real elementary reflector H of order n, such
-*> that
-*>
-*> H * ( alpha ) = ( beta ), H**T * H = I.
-*> ( x ) ( 0 )
-*>
-*> where alpha and beta are scalars, and x is an (n-1)-element real
-*> vector. H is represented in the form
-*>
-*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
-*> ( v )
-*>
-*> where tau is a real scalar and v is a real (n-1)-element
-*> vector.
-*>
-*> If the elements of x are all zero, then tau = 0 and H is taken to be
-*> the unit matrix.
-*>
-*> Otherwise 1 <= tau <= 2.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the elementary reflector.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, the value alpha.
-*> On exit, it is overwritten with the value beta.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension
-*> (1+(N-2)*abs(INCX))
-*> On entry, the vector x.
-*> On exit, it is overwritten with the vector v.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION ALPHA, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J, KNT
- DOUBLE PRECISION BETA, RSAFMN, SAFMIN, XNORM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2, DNRM2
- EXTERNAL DLAMCH, DLAPY2, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.1 ) THEN
- TAU = ZERO
- RETURN
- END IF
-*
- XNORM = DNRM2( N-1, X, INCX )
-*
- IF( XNORM.EQ.ZERO ) THEN
-*
-* H = I
-*
- TAU = ZERO
- ELSE
-*
-* general case
-*
- BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
- SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
- KNT = 0
- IF( ABS( BETA ).LT.SAFMIN ) THEN
-*
-* XNORM, BETA may be inaccurate; scale X and recompute them
-*
- RSAFMN = ONE / SAFMIN
- 10 CONTINUE
- KNT = KNT + 1
- CALL DSCAL( N-1, RSAFMN, X, INCX )
- BETA = BETA*RSAFMN
- ALPHA = ALPHA*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN )
- $ GO TO 10
-*
-* New BETA is at most 1, at least SAFMIN
-*
- XNORM = DNRM2( N-1, X, INCX )
- BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
- END IF
- TAU = ( BETA-ALPHA ) / BETA
- CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
-*
-* If ALPHA is subnormal, it may lose relative accuracy
-*
- DO 20 J = 1, KNT
- BETA = BETA*SAFMIN
- 20 CONTINUE
- ALPHA = BETA
- END IF
-*
- RETURN
-*
-* End of DLARFG
-*
- END
diff --git a/netlib/LAPACK/dlarfgp.f b/netlib/LAPACK/dlarfgp.f
deleted file mode 100644
index a1fd936..0000000
--- a/netlib/LAPACK/dlarfgp.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b DLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFGP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfgp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfgp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfgp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION ALPHA, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARFGP generates a real elementary reflector H of order n, such
-*> that
-*>
-*> H * ( alpha ) = ( beta ), H**T * H = I.
-*> ( x ) ( 0 )
-*>
-*> where alpha and beta are scalars, beta is non-negative, and x is
-*> an (n-1)-element real vector. H is represented in the form
-*>
-*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
-*> ( v )
-*>
-*> where tau is a real scalar and v is a real (n-1)-element
-*> vector.
-*>
-*> If the elements of x are all zero, then tau = 0 and H is taken to be
-*> the unit matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the elementary reflector.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, the value alpha.
-*> On exit, it is overwritten with the value beta.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension
-*> (1+(N-2)*abs(INCX))
-*> On entry, the vector x.
-*> On exit, it is overwritten with the vector v.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION ALPHA, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION TWO, ONE, ZERO
- PARAMETER ( TWO = 2.0D+0, ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J, KNT
- DOUBLE PRECISION BETA, BIGNUM, SAVEALPHA, SMLNUM, XNORM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2, DNRM2
- EXTERNAL DLAMCH, DLAPY2, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- TAU = ZERO
- RETURN
- END IF
-*
- XNORM = DNRM2( N-1, X, INCX )
-*
- IF( XNORM.EQ.ZERO ) THEN
-*
-* H = [+/-1, 0; I], sign chosen so ALPHA >= 0
-*
- IF( ALPHA.GE.ZERO ) THEN
-* When TAU.eq.ZERO, the vector is special-cased to be
-* all zeros in the application routines. We do not need
-* to clear it.
- TAU = ZERO
- ELSE
-* However, the application routines rely on explicit
-* zero checks when TAU.ne.ZERO, and we must clear X.
- TAU = TWO
- DO J = 1, N-1
- X( 1 + (J-1)*INCX ) = 0
- END DO
- ALPHA = -ALPHA
- END IF
- ELSE
-*
-* general case
-*
- BETA = SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
- SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'E' )
- KNT = 0
- IF( ABS( BETA ).LT.SMLNUM ) THEN
-*
-* XNORM, BETA may be inaccurate; scale X and recompute them
-*
- BIGNUM = ONE / SMLNUM
- 10 CONTINUE
- KNT = KNT + 1
- CALL DSCAL( N-1, BIGNUM, X, INCX )
- BETA = BETA*BIGNUM
- ALPHA = ALPHA*BIGNUM
- IF( ABS( BETA ).LT.SMLNUM )
- $ GO TO 10
-*
-* New BETA is at most 1, at least SMLNUM
-*
- XNORM = DNRM2( N-1, X, INCX )
- BETA = SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
- END IF
- SAVEALPHA = ALPHA
- ALPHA = ALPHA + BETA
- IF( BETA.LT.ZERO ) THEN
- BETA = -BETA
- TAU = -ALPHA / BETA
- ELSE
- ALPHA = XNORM * (XNORM/ALPHA)
- TAU = ALPHA / BETA
- ALPHA = -ALPHA
- END IF
-*
- IF ( ABS(TAU).LE.SMLNUM ) THEN
-*
-* In the case where the computed TAU ends up being a denormalized number,
-* it loses relative accuracy. This is a BIG problem. Solution: flush TAU
-* to ZERO. This explains the next IF statement.
-*
-* (Bug report provided by Pat Quillen from MathWorks on Jul 29, 2009.)
-* (Thanks Pat. Thanks MathWorks.)
-*
- IF( SAVEALPHA.GE.ZERO ) THEN
- TAU = ZERO
- ELSE
- TAU = TWO
- DO J = 1, N-1
- X( 1 + (J-1)*INCX ) = 0
- END DO
- BETA = -SAVEALPHA
- END IF
-*
- ELSE
-*
-* This is the general case.
-*
- CALL DSCAL( N-1, ONE / ALPHA, X, INCX )
-*
- END IF
-*
-* If BETA is subnormal, it may lose relative accuracy
-*
- DO 20 J = 1, KNT
- BETA = BETA*SMLNUM
- 20 CONTINUE
- ALPHA = BETA
- END IF
-*
- RETURN
-*
-* End of DLARFGP
-*
- END
diff --git a/netlib/LAPACK/dlarft.f b/netlib/LAPACK/dlarft.f
deleted file mode 100644
index bc1b53b..0000000
--- a/netlib/LAPACK/dlarft.f
+++ /dev/null
@@ -1,326 +0,0 @@
-*> \brief \b DLARFT forms the triangular factor T of a block reflector H = I - vtvH
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFT + dependencies
-*> <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>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, STOREV
-* INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARFT forms the triangular factor T of a real block reflector H
-*> of order n, which is defined as a product of k elementary reflectors.
-*>
-*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
-*>
-*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
-*>
-*> If STOREV = 'C', the vector which defines the elementary reflector
-*> H(i) is stored in the i-th column of the array V, and
-*>
-*> H = I - V * T * V**T
-*>
-*> If STOREV = 'R', the vector which defines the elementary reflector
-*> H(i) is stored in the i-th row of the array V, and
-*>
-*> H = I - V**T * T * V
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Specifies the order in which the elementary reflectors are
-*> multiplied to form the block reflector:
-*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*> \endverbatim
-*>
-*> \param[in] STOREV
-*> \verbatim
-*> STOREV is CHARACTER*1
-*> Specifies how the vectors which define the elementary
-*> reflectors are stored (see also Further Details):
-*> = 'C': columnwise
-*> = 'R': rowwise
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the block reflector H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the triangular factor T (= the number of
-*> elementary reflectors). K >= 1.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,N) if STOREV = 'R'
-*> The matrix V. See further details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The k by k triangular factor T of the block reflector.
-*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*> lower triangular. The rest of the array is not used.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \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 (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, STOREV
- INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, PREVLASTV, LASTV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DTRMV
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
- PREVLASTV = N
- DO I = 1, K
- PREVLASTV = MAX( I, PREVLASTV )
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO J = 1, I
- T( J, I ) = ZERO
- END DO
- ELSE
-*
-* general case
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
-* Skip any trailing zeros.
- DO LASTV = N, I+1, -1
- IF( V( LASTV, I ).NE.ZERO ) EXIT
- END DO
- DO J = 1, I-1
- T( J, I ) = -TAU( I ) * V( I , J )
- END DO
- J = MIN( LASTV, PREVLASTV )
-*
-* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i)
-*
- CALL DGEMV( 'Transpose', J-I, I-1, -TAU( I ),
- $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE,
- $ T( 1, I ), 1 )
- ELSE
-* Skip any trailing zeros.
- DO LASTV = N, I+1, -1
- IF( V( I, LASTV ).NE.ZERO ) EXIT
- END DO
- DO J = 1, I-1
- T( J, I ) = -TAU( I ) * V( J , I )
- END DO
- J = MIN( LASTV, PREVLASTV )
-*
-* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T
-*
- CALL DGEMV( 'No transpose', I-1, J-I, -TAU( I ),
- $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, ONE,
- $ T( 1, I ), 1 )
- END IF
-*
-* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
-*
- CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
- $ LDT, T( 1, I ), 1 )
- T( I, I ) = TAU( I )
- IF( I.GT.1 ) THEN
- PREVLASTV = MAX( PREVLASTV, LASTV )
- ELSE
- PREVLASTV = LASTV
- END IF
- END IF
- END DO
- ELSE
- PREVLASTV = 1
- DO I = K, 1, -1
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO J = I, K
- T( J, I ) = ZERO
- END DO
- ELSE
-*
-* general case
-*
- IF( I.LT.K ) THEN
- IF( LSAME( STOREV, 'C' ) ) THEN
-* Skip any leading zeros.
- DO LASTV = 1, I-1
- IF( V( LASTV, I ).NE.ZERO ) EXIT
- END DO
- DO J = I+1, K
- T( J, I ) = -TAU( I ) * V( N-K+I , J )
- END DO
- J = MAX( LASTV, PREVLASTV )
-*
-* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i)
-*
- CALL DGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ),
- $ V( J, I+1 ), LDV, V( J, I ), 1, ONE,
- $ T( I+1, I ), 1 )
- ELSE
-* Skip any leading zeros.
- DO LASTV = 1, I-1
- IF( V( I, LASTV ).NE.ZERO ) EXIT
- END DO
- DO J = I+1, K
- T( J, I ) = -TAU( I ) * V( J, N-K+I )
- END DO
- J = MAX( LASTV, PREVLASTV )
-*
-* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T
-*
- CALL DGEMV( 'No transpose', K-I, N-K+I-J,
- $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV,
- $ ONE, T( I+1, I ), 1 )
- END IF
-*
-* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
-*
- CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
- $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
- IF( I.GT.1 ) THEN
- PREVLASTV = MIN( PREVLASTV, LASTV )
- ELSE
- PREVLASTV = LASTV
- END IF
- END IF
- T( I, I ) = TAU( I )
- END IF
- END DO
- END IF
- RETURN
-*
-* End of DLARFT
-*
- END
diff --git a/netlib/LAPACK/dlarfx.f b/netlib/LAPACK/dlarfx.f
deleted file mode 100644
index 47491dc..0000000
--- a/netlib/LAPACK/dlarfx.f
+++ /dev/null
@@ -1,697 +0,0 @@
-*> \brief \b DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER LDC, M, N
-* DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARFX applies a real elementary reflector H to a real m by n
-*> matrix C, from either the left or the right. H is represented in the
-*> form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar and v is a real vector.
-*>
-*> If tau = 0, then H is taken to be the unit matrix
-*>
-*> This version uses inline code if H has order < 11.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
-*> or (N) if SIDE = 'R'
-*> The vector v in the representation of H.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDA >= (1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> WORK is not referenced if H has order < 11.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER LDC, M, N
- DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J
- DOUBLE PRECISION SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
- $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF
-* ..
-* .. Executable Statements ..
-*
- IF( TAU.EQ.ZERO )
- $ RETURN
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C, where H has order m.
-*
- GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
- $ 170, 190 )M
-*
-* Code for general M
-*
- CALL DLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
- GO TO 410
- 10 CONTINUE
-*
-* Special code for 1 x 1 Householder
-*
- T1 = ONE - TAU*V( 1 )*V( 1 )
- DO 20 J = 1, N
- C( 1, J ) = T1*C( 1, J )
- 20 CONTINUE
- GO TO 410
- 30 CONTINUE
-*
-* Special code for 2 x 2 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- DO 40 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- 40 CONTINUE
- GO TO 410
- 50 CONTINUE
-*
-* Special code for 3 x 3 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- DO 60 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- 60 CONTINUE
- GO TO 410
- 70 CONTINUE
-*
-* Special code for 4 x 4 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- DO 80 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- 80 CONTINUE
- GO TO 410
- 90 CONTINUE
-*
-* Special code for 5 x 5 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- DO 100 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- 100 CONTINUE
- GO TO 410
- 110 CONTINUE
-*
-* Special code for 6 x 6 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- DO 120 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- 120 CONTINUE
- GO TO 410
- 130 CONTINUE
-*
-* Special code for 7 x 7 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- DO 140 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- 140 CONTINUE
- GO TO 410
- 150 CONTINUE
-*
-* Special code for 8 x 8 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- DO 160 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- 160 CONTINUE
- GO TO 410
- 170 CONTINUE
-*
-* Special code for 9 x 9 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- DO 180 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- C( 9, J ) = C( 9, J ) - SUM*T9
- 180 CONTINUE
- GO TO 410
- 190 CONTINUE
-*
-* Special code for 10 x 10 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- V10 = V( 10 )
- T10 = TAU*V10
- DO 200 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
- $ V10*C( 10, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- C( 9, J ) = C( 9, J ) - SUM*T9
- C( 10, J ) = C( 10, J ) - SUM*T10
- 200 CONTINUE
- GO TO 410
- ELSE
-*
-* Form C * H, where H has order n.
-*
- GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
- $ 370, 390 )N
-*
-* Code for general N
-*
- CALL DLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
- GO TO 410
- 210 CONTINUE
-*
-* Special code for 1 x 1 Householder
-*
- T1 = ONE - TAU*V( 1 )*V( 1 )
- DO 220 J = 1, M
- C( J, 1 ) = T1*C( J, 1 )
- 220 CONTINUE
- GO TO 410
- 230 CONTINUE
-*
-* Special code for 2 x 2 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- DO 240 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- 240 CONTINUE
- GO TO 410
- 250 CONTINUE
-*
-* Special code for 3 x 3 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- DO 260 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- 260 CONTINUE
- GO TO 410
- 270 CONTINUE
-*
-* Special code for 4 x 4 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- DO 280 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- 280 CONTINUE
- GO TO 410
- 290 CONTINUE
-*
-* Special code for 5 x 5 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- DO 300 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- 300 CONTINUE
- GO TO 410
- 310 CONTINUE
-*
-* Special code for 6 x 6 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- DO 320 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- 320 CONTINUE
- GO TO 410
- 330 CONTINUE
-*
-* Special code for 7 x 7 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- DO 340 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- 340 CONTINUE
- GO TO 410
- 350 CONTINUE
-*
-* Special code for 8 x 8 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- DO 360 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- 360 CONTINUE
- GO TO 410
- 370 CONTINUE
-*
-* Special code for 9 x 9 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- DO 380 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- C( J, 9 ) = C( J, 9 ) - SUM*T9
- 380 CONTINUE
- GO TO 410
- 390 CONTINUE
-*
-* Special code for 10 x 10 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- V10 = V( 10 )
- T10 = TAU*V10
- DO 400 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
- $ V10*C( J, 10 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- C( J, 9 ) = C( J, 9 ) - SUM*T9
- C( J, 10 ) = C( J, 10 ) - SUM*T10
- 400 CONTINUE
- GO TO 410
- END IF
- 410 CONTINUE
- RETURN
-*
-* End of DLARFX
-*
- END
diff --git a/netlib/LAPACK/dlarge.f b/netlib/LAPACK/dlarge.f
deleted file mode 100644
index 075cdac..0000000
--- a/netlib/LAPACK/dlarge.f
+++ /dev/null
@@ -1,174 +0,0 @@
-*> \brief \b DLARGE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARGE( N, A, LDA, ISEED, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARGE pre- and post-multiplies a real general n by n matrix A
-*> with a random orthogonal matrix: A = U*D*U'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the original n by n matrix A.
-*> On exit, A is overwritten by U*A*U' for some random
-*> orthogonal matrix U.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= N.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLARGE( N, A, LDA, ISEED, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION TAU, WA, WB, WN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DLARNV, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DNRM2
- EXTERNAL DNRM2
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DLARGE', -INFO )
- RETURN
- END IF
-*
-* pre- and post-multiply A by random orthogonal matrix
-*
- DO 10 I = N, 1, -1
-*
-* generate random reflection
-*
- CALL DLARNV( 3, ISEED, N-I+1, WORK )
- WN = DNRM2( N-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* multiply A(i:n,1:n) by random reflection from the left
-*
- CALL DGEMV( 'Transpose', N-I+1, N, ONE, A( I, 1 ), LDA, WORK,
- $ 1, ZERO, WORK( N+1 ), 1 )
- CALL DGER( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
- $ LDA )
-*
-* multiply A(1:n,i:n) by random reflection from the right
-*
- CALL DGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
- $ WORK, 1, ZERO, WORK( N+1 ), 1 )
- CALL DGER( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
- $ LDA )
- 10 CONTINUE
- RETURN
-*
-* End of DLARGE
-*
- END
diff --git a/netlib/LAPACK/dlargv.f b/netlib/LAPACK/dlargv.f
deleted file mode 100644
index 9ef68f2..0000000
--- a/netlib/LAPACK/dlargv.f
+++ /dev/null
@@ -1,167 +0,0 @@
-*> \brief \b DLARGV generates a vector of plane rotations with real cosines and real sines.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlargv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlargv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlargv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARGV( N, X, INCX, Y, INCY, C, INCC )
-*
-* .. Scalar Arguments ..
-* INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARGV generates a vector of real plane rotations, determined by
-*> elements of the real vectors x and y. For i = 1,2,...,n
-*>
-*> ( c(i) s(i) ) ( x(i) ) = ( a(i) )
-*> ( -s(i) c(i) ) ( y(i) ) = ( 0 )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of plane rotations to be generated.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCX)
-*> On entry, the vector x.
-*> On exit, x(i) is overwritten by a(i), for i = 1,...,n.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCY)
-*> On entry, the vector y.
-*> On exit, the sines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> The increment between elements of Y. INCY > 0.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
-*> The cosines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCC
-*> \verbatim
-*> INCC is INTEGER
-*> The increment between elements of C. INCC > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARGV( N, X, INCX, Y, INCY, C, INCC )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IC, IX, IY
- DOUBLE PRECISION F, G, T, TT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IX = 1
- IY = 1
- IC = 1
- DO 10 I = 1, N
- F = X( IX )
- G = Y( IY )
- IF( G.EQ.ZERO ) THEN
- C( IC ) = ONE
- ELSE IF( F.EQ.ZERO ) THEN
- C( IC ) = ZERO
- Y( IY ) = ONE
- X( IX ) = G
- ELSE IF( ABS( F ).GT.ABS( G ) ) THEN
- T = G / F
- TT = SQRT( ONE+T*T )
- C( IC ) = ONE / TT
- Y( IY ) = T*C( IC )
- X( IX ) = F*TT
- ELSE
- T = F / G
- TT = SQRT( ONE+T*T )
- Y( IY ) = ONE / TT
- C( IC ) = T*Y( IY )
- X( IX ) = G*TT
- END IF
- IC = IC + INCC
- IY = IY + INCY
- IX = IX + INCX
- 10 CONTINUE
- RETURN
-*
-* End of DLARGV
-*
- END
diff --git a/netlib/LAPACK/dlarnd.f b/netlib/LAPACK/dlarnd.f
deleted file mode 100644
index ee0f830..0000000
--- a/netlib/LAPACK/dlarnd.f
+++ /dev/null
@@ -1,133 +0,0 @@
-*> \brief \b DLARND
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLARND( IDIST, ISEED )
-*
-* .. Scalar Arguments ..
-* INTEGER IDIST
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARND returns a random real number from a uniform or normal
-*> distribution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> Specifies the distribution of the random numbers:
-*> = 1: uniform (0,1)
-*> = 2: uniform (-1,1)
-*> = 3: normal (0,1)
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine calls the auxiliary routine DLARAN to generate a random
-*> real number from a uniform (0,1) distribution. The Box-Muller method
-*> is used to transform numbers from a uniform to a normal distribution.
-*> \endverbatim
-*>
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLARND( IDIST, ISEED )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IDIST
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, TWO
- PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
- DOUBLE PRECISION TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION T1, T2
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLARAN
- EXTERNAL DLARAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC COS, LOG, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Generate a real random number from a uniform (0,1) distribution
-*
- T1 = DLARAN( ISEED )
-*
- IF( IDIST.EQ.1 ) THEN
-*
-* uniform (0,1)
-*
- DLARND = T1
- ELSE IF( IDIST.EQ.2 ) THEN
-*
-* uniform (-1,1)
-*
- DLARND = TWO*T1 - ONE
- ELSE IF( IDIST.EQ.3 ) THEN
-*
-* normal (0,1)
-*
- T2 = DLARAN( ISEED )
- DLARND = SQRT( -TWO*LOG( T1 ) )*COS( TWOPI*T2 )
- END IF
- RETURN
-*
-* End of DLARND
-*
- END
diff --git a/netlib/LAPACK/dlarnv.f b/netlib/LAPACK/dlarnv.f
deleted file mode 100644
index 04af112..0000000
--- a/netlib/LAPACK/dlarnv.f
+++ /dev/null
@@ -1,178 +0,0 @@
-*> \brief \b DLARNV returns a vector of random numbers from a uniform or normal distribution.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARNV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarnv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarnv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarnv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARNV( IDIST, ISEED, N, X )
-*
-* .. Scalar Arguments ..
-* INTEGER IDIST, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARNV returns a vector of n random real numbers from a uniform or
-*> normal distribution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> Specifies the distribution of the random numbers:
-*> = 1: uniform (0,1)
-*> = 2: uniform (-1,1)
-*> = 3: normal (0,1)
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of random numbers to be generated.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> The generated random numbers.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine calls the auxiliary routine DLARUV to generate random
-*> real numbers from a uniform (0,1) distribution, in batches of up to
-*> 128 using vectorisable code. The Box-Muller method is used to
-*> transform numbers from a uniform to a normal distribution.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARNV( IDIST, ISEED, N, X )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IDIST, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, TWO
- PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
- INTEGER LV
- PARAMETER ( LV = 128 )
- DOUBLE PRECISION TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IL, IL2, IV
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION U( LV )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC COS, LOG, MIN, SQRT
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARUV
-* ..
-* .. Executable Statements ..
-*
- DO 40 IV = 1, N, LV / 2
- IL = MIN( LV / 2, N-IV+1 )
- IF( IDIST.EQ.3 ) THEN
- IL2 = 2*IL
- ELSE
- IL2 = IL
- END IF
-*
-* Call DLARUV to generate IL2 numbers from a uniform (0,1)
-* distribution (IL2 <= LV)
-*
- CALL DLARUV( ISEED, IL2, U )
-*
- IF( IDIST.EQ.1 ) THEN
-*
-* Copy generated numbers
-*
- DO 10 I = 1, IL
- X( IV+I-1 ) = U( I )
- 10 CONTINUE
- ELSE IF( IDIST.EQ.2 ) THEN
-*
-* Convert generated numbers to uniform (-1,1) distribution
-*
- DO 20 I = 1, IL
- X( IV+I-1 ) = TWO*U( I ) - ONE
- 20 CONTINUE
- ELSE IF( IDIST.EQ.3 ) THEN
-*
-* Convert generated numbers to normal (0,1) distribution
-*
- DO 30 I = 1, IL
- X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
- $ COS( TWOPI*U( 2*I ) )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- RETURN
-*
-* End of DLARNV
-*
- END
diff --git a/netlib/LAPACK/dlaror.f b/netlib/LAPACK/dlaror.f
deleted file mode 100644
index 5be36bd..0000000
--- a/netlib/LAPACK/dlaror.f
+++ /dev/null
@@ -1,304 +0,0 @@
-*> \brief \b DLAROR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER INIT, SIDE
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION A( LDA, * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAROR pre- or post-multiplies an M by N matrix A by a random
-*> orthogonal matrix U, overwriting A. A may optionally be initialized
-*> to the identity matrix before multiplying by U. U is generated using
-*> the method of G.W. Stewart (SIAM J. Numer. Anal. 17, 1980, 403-409).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> Specifies whether A is multiplied on the left or right by U.
-*> = 'L': Multiply A on the left (premultiply) by U
-*> = 'R': Multiply A on the right (postmultiply) by U'
-*> = 'C' or 'T': Multiply A on the left by U and the right
-*> by U' (Here, U' means U-transpose.)
-*> \endverbatim
-*>
-*> \param[in] INIT
-*> \verbatim
-*> INIT is CHARACTER*1
-*> Specifies whether or not A should be initialized to the
-*> identity matrix.
-*> = 'I': Initialize A to (a section of) the identity matrix
-*> before applying U.
-*> = 'N': No initialization. Apply U to the input matrix A.
-*>
-*> INIT = 'I' may be used to generate square or rectangular
-*> orthogonal matrices:
-*>
-*> For M = N and SIDE = 'L' or 'R', the rows will be orthogonal
-*> to each other, as will the columns.
-*>
-*> If M < N, SIDE = 'R' produces a dense matrix whose rows are
-*> orthogonal and whose columns are not, while SIDE = 'L'
-*> produces a matrix whose rows are orthogonal, and whose first
-*> M columns are orthogonal, and whose remaining columns are
-*> zero.
-*>
-*> If M > N, SIDE = 'L' produces a dense matrix whose columns
-*> are orthogonal and whose rows are not, while SIDE = 'R'
-*> produces a matrix whose columns are orthogonal, and whose
-*> first M rows are orthogonal, and whose remaining rows are
-*> zero.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the array A.
-*> On exit, overwritten by U A ( if SIDE = 'L' ),
-*> or by A U ( if SIDE = 'R' ),
-*> or by U A U' ( if SIDE = 'C' or 'T').
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry ISEED specifies the seed of the random number
-*> generator. The array elements should be between 0 and 4095;
-*> if not they will be reduced mod 4096. Also, ISEED(4) must
-*> be odd. The random number generator uses a linear
-*> congruential sequence limited to small integers, and so
-*> should produce machine independent random numbers. The
-*> values of ISEED are changed on exit, and can be used in the
-*> next call to DLAROR to continue the same random number
-*> sequence.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (3*MAX( M, N ))
-*> Workspace of length
-*> 2*M + N if SIDE = 'L',
-*> 2*N + M if SIDE = 'R',
-*> 3*N if SIDE = 'C' or 'T'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> An error flag. It is set to:
-*> = 0: normal return
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> = 1: if the random numbers generated by DLARND are bad.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER INIT, SIDE
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION A( LDA, * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TOOSML
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0,
- $ TOOSML = 1.0D-20 )
-* ..
-* .. Local Scalars ..
- INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
- DOUBLE PRECISION FACTOR, XNORM, XNORMS
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLARND, DNRM2
- EXTERNAL LSAME, DLARND, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DLASET, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.EQ.0 .OR. M.EQ.0 )
- $ RETURN
-*
- ITYPE = 0
- IF( LSAME( SIDE, 'L' ) ) THEN
- ITYPE = 1
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
- ITYPE = 2
- ELSE IF( LSAME( SIDE, 'C' ) .OR. LSAME( SIDE, 'T' ) ) THEN
- ITYPE = 3
- END IF
-*
-* Check for argument errors.
-*
- IF( ITYPE.EQ.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN
- INFO = -4
- ELSE IF( LDA.LT.M ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAROR', -INFO )
- RETURN
- END IF
-*
- IF( ITYPE.EQ.1 ) THEN
- NXFRM = M
- ELSE
- NXFRM = N
- END IF
-*
-* Initialize A to the identity matrix if desired
-*
- IF( LSAME( INIT, 'I' ) )
- $ CALL DLASET( 'Full', M, N, ZERO, ONE, A, LDA )
-*
-* If no rotation possible, multiply by random +/-1
-*
-* Compute rotation by computing Householder transformations
-* H(2), H(3), ..., H(nhouse)
-*
- DO 10 J = 1, NXFRM
- X( J ) = ZERO
- 10 CONTINUE
-*
- DO 30 IXFRM = 2, NXFRM
- KBEG = NXFRM - IXFRM + 1
-*
-* Generate independent normal( 0, 1 ) random numbers
-*
- DO 20 J = KBEG, NXFRM
- X( J ) = DLARND( 3, ISEED )
- 20 CONTINUE
-*
-* Generate a Householder transformation from the random vector X
-*
- XNORM = DNRM2( IXFRM, X( KBEG ), 1 )
- XNORMS = SIGN( XNORM, X( KBEG ) )
- X( KBEG+NXFRM ) = SIGN( ONE, -X( KBEG ) )
- FACTOR = XNORMS*( XNORMS+X( KBEG ) )
- IF( ABS( FACTOR ).LT.TOOSML ) THEN
- INFO = 1
- CALL XERBLA( 'DLAROR', INFO )
- RETURN
- ELSE
- FACTOR = ONE / FACTOR
- END IF
- X( KBEG ) = X( KBEG ) + XNORMS
-*
-* Apply Householder transformation to A
-*
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN
-*
-* Apply H(k) from the left.
-*
- CALL DGEMV( 'T', IXFRM, N, ONE, A( KBEG, 1 ), LDA,
- $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 )
- CALL DGER( IXFRM, N, -FACTOR, X( KBEG ), 1, X( 2*NXFRM+1 ),
- $ 1, A( KBEG, 1 ), LDA )
-*
- END IF
-*
- IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN
-*
-* Apply H(k) from the right.
-*
- CALL DGEMV( 'N', M, IXFRM, ONE, A( 1, KBEG ), LDA,
- $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 )
- CALL DGER( M, IXFRM, -FACTOR, X( 2*NXFRM+1 ), 1, X( KBEG ),
- $ 1, A( 1, KBEG ), LDA )
-*
- END IF
- 30 CONTINUE
-*
- X( 2*NXFRM ) = SIGN( ONE, DLARND( 3, ISEED ) )
-*
-* Scale the matrix A by D.
-*
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN
- DO 40 IROW = 1, M
- CALL DSCAL( N, X( NXFRM+IROW ), A( IROW, 1 ), LDA )
- 40 CONTINUE
- END IF
-*
- IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN
- DO 50 JCOL = 1, N
- CALL DSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 )
- 50 CONTINUE
- END IF
- RETURN
-*
-* End of DLAROR
-*
- END
diff --git a/netlib/LAPACK/dlarot.f b/netlib/LAPACK/dlarot.f
deleted file mode 100644
index 3e5917c..0000000
--- a/netlib/LAPACK/dlarot.f
+++ /dev/null
@@ -1,317 +0,0 @@
-*> \brief \b DLAROT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
-* XRIGHT )
-*
-* .. Scalar Arguments ..
-* LOGICAL LLEFT, LRIGHT, LROWS
-* INTEGER LDA, NL
-* DOUBLE PRECISION C, S, XLEFT, XRIGHT
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAROT applies a (Givens) rotation to two adjacent rows or
-*> columns, where one element of the first and/or last column/row
-*> for use on matrices stored in some format other than GE, so
-*> that elements of the matrix may be used or modified for which
-*> no array element is provided.
-*>
-*> One example is a symmetric matrix in SB format (bandwidth=4), for
-*> which UPLO='L': Two adjacent rows will have the format:
-*>
-*> row j: C> C> C> C> C> . . . .
-*> row j+1: C> C> C> C> C> . . . .
-*>
-*> '*' indicates elements for which storage is provided,
-*> '.' indicates elements for which no storage is provided, but
-*> are not necessarily zero; their values are determined by
-*> symmetry. ' ' indicates elements which are necessarily zero,
-*> and have no storage provided.
-*>
-*> Those columns which have two '*'s can be handled by DROT.
-*> Those columns which have no '*'s can be ignored, since as long
-*> as the Givens rotations are carefully applied to preserve
-*> symmetry, their values are determined.
-*> Those columns which have one '*' have to be handled separately,
-*> by using separate variables "p" and "q":
-*>
-*> row j: C> C> C> C> C> p . . .
-*> row j+1: q C> C> C> C> C> . . . .
-*>
-*> The element p would have to be set correctly, then that column
-*> is rotated, setting p to its new value. The next call to
-*> DLAROT would rotate columns j and j+1, using p, and restore
-*> symmetry. The element q would start out being zero, and be
-*> made non-zero by the rotation. Later, rotations would presumably
-*> be chosen to zero q out.
-*>
-*> Typical Calling Sequences: rotating the i-th and (i+1)-st rows.
-*> ------- ------- ---------
-*>
-*> General dense matrix:
-*>
-*> CALL DLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S,
-*> A(i,1),LDA, DUMMY, DUMMY)
-*>
-*> General banded matrix in GB format:
-*>
-*> j = MAX(1, i-KL )
-*> NL = MIN( N, i+KU+1 ) + 1-j
-*> CALL DLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S,
-*> A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT )
-*>
-*> [ note that i+1-j is just MIN(i,KL+1) ]
-*>
-*> Symmetric banded matrix in SY format, bandwidth K,
-*> lower triangle only:
-*>
-*> j = MAX(1, i-K )
-*> NL = MIN( K+1, i ) + 1
-*> CALL DLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S,
-*> A(i,j), LDA, XLEFT, XRIGHT )
-*>
-*> Same, but upper triangle only:
-*>
-*> NL = MIN( K+1, N-i ) + 1
-*> CALL DLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S,
-*> A(i,i), LDA, XLEFT, XRIGHT )
-*>
-*> Symmetric banded matrix in SB format, bandwidth K,
-*> lower triangle only:
-*>
-*> [ same as for SY, except:]
-*> . . . .
-*> A(i+1-j,j), LDA-1, XLEFT, XRIGHT )
-*>
-*> [ note that i+1-j is just MIN(i,K+1) ]
-*>
-*> Same, but upper triangle only:
-*> . . .
-*> A(K+1,i), LDA-1, XLEFT, XRIGHT )
-*>
-*> Rotating columns is just the transpose of rotating rows, except
-*> for GB and SB: (rotating columns i and i+1)
-*>
-*> GB:
-*> j = MAX(1, i-KU )
-*> NL = MIN( N, i+KL+1 ) + 1-j
-*> CALL DLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S,
-*> A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM )
-*>
-*> [note that KU+j+1-i is just MAX(1,KU+2-i)]
-*>
-*> SB: (upper triangle)
-*>
-*> . . . . . .
-*> A(K+j+1-i,i),LDA-1, XTOP, XBOTTM )
-*>
-*> SB: (lower triangle)
-*>
-*> . . . . . .
-*> A(1,i),LDA-1, XTOP, XBOTTM )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \verbatim
-*> LROWS - LOGICAL
-*> If .TRUE., then DLAROT will rotate two rows. If .FALSE.,
-*> then it will rotate two columns.
-*> Not modified.
-*>
-*> LLEFT - LOGICAL
-*> If .TRUE., then XLEFT will be used instead of the
-*> corresponding element of A for the first element in the
-*> second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.)
-*> If .FALSE., then the corresponding element of A will be
-*> used.
-*> Not modified.
-*>
-*> LRIGHT - LOGICAL
-*> If .TRUE., then XRIGHT will be used instead of the
-*> corresponding element of A for the last element in the
-*> first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If
-*> .FALSE., then the corresponding element of A will be used.
-*> Not modified.
-*>
-*> NL - INTEGER
-*> The length of the rows (if LROWS=.TRUE.) or columns (if
-*> LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are
-*> used, the columns/rows they are in should be included in
-*> NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at
-*> least 2. The number of rows/columns to be rotated
-*> exclusive of those involving XLEFT and/or XRIGHT may
-*> not be negative, i.e., NL minus how many of LLEFT and
-*> LRIGHT are .TRUE. must be at least zero; if not, XERBLA
-*> will be called.
-*> Not modified.
-*>
-*> C, S - DOUBLE PRECISION
-*> Specify the Givens rotation to be applied. If LROWS is
-*> true, then the matrix ( c s )
-*> (-s c ) is applied from the left;
-*> if false, then the transpose thereof is applied from the
-*> right. For a Givens rotation, C**2 + S**2 should be 1,
-*> but this is not checked.
-*> Not modified.
-*>
-*> A - DOUBLE PRECISION array.
-*> The array containing the rows/columns to be rotated. The
-*> first element of A should be the upper left element to
-*> be rotated.
-*> Read and modified.
-*>
-*> LDA - INTEGER
-*> The "effective" leading dimension of A. If A contains
-*> a matrix stored in GE or SY format, then this is just
-*> the leading dimension of A as dimensioned in the calling
-*> routine. If A contains a matrix stored in band (GB or SB)
-*> format, then this should be *one less* than the leading
-*> dimension used in the calling routine. Thus, if
-*> A were dimensioned A(LDA,*) in DLAROT, then A(1,j) would
-*> be the j-th element in the first of the two rows
-*> to be rotated, and A(2,j) would be the j-th in the second,
-*> regardless of how the array may be stored in the calling
-*> routine. [A cannot, however, actually be dimensioned thus,
-*> since for band format, the row number may exceed LDA, which
-*> is not legal FORTRAN.]
-*> If LROWS=.TRUE., then LDA must be at least 1, otherwise
-*> it must be at least NL minus the number of .TRUE. values
-*> in XLEFT and XRIGHT.
-*> Not modified.
-*>
-*> XLEFT - DOUBLE PRECISION
-*> If LLEFT is .TRUE., then XLEFT will be used and modified
-*> instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
-*> (if LROWS=.FALSE.).
-*> Read and modified.
-*>
-*> XRIGHT - DOUBLE PRECISION
-*> If LRIGHT is .TRUE., then XRIGHT will be used and modified
-*> instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
-*> (if LROWS=.FALSE.).
-*> Read and modified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
- $ XRIGHT )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL LLEFT, LRIGHT, LROWS
- INTEGER LDA, NL
- DOUBLE PRECISION C, S, XLEFT, XRIGHT
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER IINC, INEXT, IX, IY, IYT, NT
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION XT( 2 ), YT( 2 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DROT, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Set up indices, arrays for ends
-*
- IF( LROWS ) THEN
- IINC = LDA
- INEXT = 1
- ELSE
- IINC = 1
- INEXT = LDA
- END IF
-*
- IF( LLEFT ) THEN
- NT = 1
- IX = 1 + IINC
- IY = 2 + LDA
- XT( 1 ) = A( 1 )
- YT( 1 ) = XLEFT
- ELSE
- NT = 0
- IX = 1
- IY = 1 + INEXT
- END IF
-*
- IF( LRIGHT ) THEN
- IYT = 1 + INEXT + ( NL-1 )*IINC
- NT = NT + 1
- XT( NT ) = XRIGHT
- YT( NT ) = A( IYT )
- END IF
-*
-* Check for errors
-*
- IF( NL.LT.NT ) THEN
- CALL XERBLA( 'DLAROT', 4 )
- RETURN
- END IF
- IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN
- CALL XERBLA( 'DLAROT', 8 )
- RETURN
- END IF
-*
-* Rotate
-*
- CALL DROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S )
- CALL DROT( NT, XT, 1, YT, 1, C, S )
-*
-* Stuff values back into XLEFT, XRIGHT, etc.
-*
- IF( LLEFT ) THEN
- A( 1 ) = XT( 1 )
- XLEFT = YT( 1 )
- END IF
-*
- IF( LRIGHT ) THEN
- XRIGHT = XT( NT )
- A( IYT ) = YT( NT )
- END IF
-*
- RETURN
-*
-* End of DLAROT
-*
- END
diff --git a/netlib/LAPACK/dlarra.f b/netlib/LAPACK/dlarra.f
deleted file mode 100644
index c78e8d0..0000000
--- a/netlib/LAPACK/dlarra.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DLARRA computes the splitting points with the specified threshold.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarra.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarra.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarra.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM,
-* NSPLIT, ISPLIT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N, NSPLIT
-* DOUBLE PRECISION SPLTOL, TNRM
-* ..
-* .. Array Arguments ..
-* INTEGER ISPLIT( * )
-* DOUBLE PRECISION D( * ), E( * ), E2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Compute the splitting points with threshold SPLTOL.
-*> DLARRA sets any "small" off-diagonal elements to zero.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal
-*> matrix T.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, the first (N-1) entries contain the subdiagonal
-*> elements of the tridiagonal matrix T; E(N) need not be set.
-*> On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
-*> are set to zero, the other entries of E are untouched.
-*> \endverbatim
-*>
-*> \param[in,out] E2
-*> \verbatim
-*> E2 is DOUBLE PRECISION array, dimension (N)
-*> On entry, the first (N-1) entries contain the SQUARES of the
-*> subdiagonal elements of the tridiagonal matrix T;
-*> E2(N) need not be set.
-*> On exit, the entries E2( ISPLIT( I ) ),
-*> 1 <= I <= NSPLIT, have been set to zero
-*> \endverbatim
-*>
-*> \param[in] SPLTOL
-*> \verbatim
-*> SPLTOL is DOUBLE PRECISION
-*> The threshold for splitting. Two criteria can be used:
-*> SPLTOL<0 : criterion based on absolute off-diagonal value
-*> SPLTOL>0 : criterion that preserves relative accuracy
-*> \endverbatim
-*>
-*> \param[in] TNRM
-*> \verbatim
-*> TNRM is DOUBLE PRECISION
-*> The norm of the matrix.
-*> \endverbatim
-*>
-*> \param[out] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of blocks T splits into. 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[out] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into blocks.
-*> The first block consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM,
- $ NSPLIT, ISPLIT, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N, NSPLIT
- DOUBLE PRECISION SPLTOL, TNRM
-* ..
-* .. Array Arguments ..
- INTEGER ISPLIT( * )
- DOUBLE PRECISION D( * ), E( * ), E2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION EABS, TMP1
-
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-
-* Compute splitting points
- NSPLIT = 1
- IF(SPLTOL.LT.ZERO) THEN
-* Criterion based on absolute off-diagonal value
- TMP1 = ABS(SPLTOL)* TNRM
- DO 9 I = 1, N-1
- EABS = ABS( E(I) )
- IF( EABS .LE. TMP1) THEN
- E(I) = ZERO
- E2(I) = ZERO
- ISPLIT( NSPLIT ) = I
- NSPLIT = NSPLIT + 1
- END IF
- 9 CONTINUE
- ELSE
-* Criterion that guarantees relative accuracy
- DO 10 I = 1, N-1
- EABS = ABS( E(I) )
- IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) )
- $ THEN
- E(I) = ZERO
- E2(I) = ZERO
- ISPLIT( NSPLIT ) = I
- NSPLIT = NSPLIT + 1
- END IF
- 10 CONTINUE
- ENDIF
- ISPLIT( NSPLIT ) = N
-
- RETURN
-*
-* End of DLARRA
-*
- END
diff --git a/netlib/LAPACK/dlarrb.f b/netlib/LAPACK/dlarrb.f
deleted file mode 100644
index f02c6d1..0000000
--- a/netlib/LAPACK/dlarrb.f
+++ /dev/null
@@ -1,401 +0,0 @@
-*> \brief \b DLARRB provides limited bisection to locate eigenvalues for more accuracy.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
-* RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
-* PIVMIN, SPDIAM, TWIST, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
-* DOUBLE PRECISION PIVMIN, RTOL1, RTOL2, SPDIAM
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION D( * ), LLD( * ), W( * ),
-* $ WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given the relatively robust representation(RRR) L D L^T, DLARRB
-*> does "limited" bisection to refine the eigenvalues of L D L^T,
-*> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
-*> guesses for these eigenvalues are input in W, the corresponding estimate
-*> of the error in these guesses and their gaps are input in WERR
-*> and WGAP, respectively. During bisection, intervals
-*> [left, right] are maintained by storing their mid-points and
-*> semi-widths in the arrays W and WERR respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] LLD
-*> \verbatim
-*> LLD is DOUBLE PRECISION array, dimension (N-1)
-*> The (N-1) elements L(i)*L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] IFIRST
-*> \verbatim
-*> IFIRST is INTEGER
-*> The index of the first eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] ILAST
-*> \verbatim
-*> ILAST is INTEGER
-*> The index of the last eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] RTOL1
-*> \verbatim
-*> RTOL1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] RTOL2
-*> \verbatim
-*> RTOL2 is DOUBLE PRECISION
-*> Tolerance for the convergence of the bisection intervals.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
-*> where GAP is the (estimated) distance to the nearest
-*> eigenvalue.
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFSET
-*> through ILAST-OFFSET elements of these arrays are to be used.
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
-*> estimates of the eigenvalues of L D L^T indexed IFIRST throug
-*> ILAST.
-*> On output, these estimates are refined.
-*> \endverbatim
-*>
-*> \param[in,out] WGAP
-*> \verbatim
-*> WGAP is DOUBLE PRECISION array, dimension (N-1)
-*> On input, the (estimated) gaps between consecutive
-*> eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap between
-*> eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST
-*> then WGAP(IFIRST-OFFSET) must be set to ZERO.
-*> On output, these gaps are refined.
-*> \endverbatim
-*>
-*> \param[in,out] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION array, dimension (N)
-*> On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are
-*> the errors in the estimates of the corresponding elements in W.
-*> On output, these errors are refined.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[in] SPDIAM
-*> \verbatim
-*> SPDIAM is DOUBLE PRECISION
-*> The spectral diameter of the matrix.
-*> \endverbatim
-*>
-*> \param[in] TWIST
-*> \verbatim
-*> TWIST is INTEGER
-*> The twist index for the twisted factorization that is used
-*> for the negcount.
-*> TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L+^T
-*> TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U-^T
-*> TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(r) N(r)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error flag.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
- $ RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
- $ PIVMIN, SPDIAM, TWIST, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
- DOUBLE PRECISION PIVMIN, RTOL1, RTOL2, SPDIAM
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION D( * ), LLD( * ), W( * ),
- $ WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, TWO, HALF
- PARAMETER ( ZERO = 0.0D0, TWO = 2.0D0,
- $ HALF = 0.5D0 )
- INTEGER MAXITR
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, II, IP, ITER, K, NEGCNT, NEXT, NINT,
- $ OLNINT, PREV, R
- DOUBLE PRECISION BACK, CVRGD, GAP, LEFT, LGAP, MID, MNWDTH,
- $ RGAP, RIGHT, TMP, WIDTH
-* ..
-* .. External Functions ..
- INTEGER DLANEG
- EXTERNAL DLANEG
-*
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
- MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- MNWDTH = TWO * PIVMIN
-*
- R = TWIST
- IF((R.LT.1).OR.(R.GT.N)) R = N
-*
-* Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ].
-* The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while
-* Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 )
-* for an unconverged interval is set to the index of the next unconverged
-* interval, and is -1 or 0 for a converged interval. Thus a linked
-* list of unconverged intervals is set up.
-*
- I1 = IFIRST
-* The number of unconverged intervals
- NINT = 0
-* The last unconverged interval found
- PREV = 0
-
- RGAP = WGAP( I1-OFFSET )
- DO 75 I = I1, ILAST
- K = 2*I
- II = I - OFFSET
- LEFT = W( II ) - WERR( II )
- RIGHT = W( II ) + WERR( II )
- LGAP = RGAP
- RGAP = WGAP( II )
- GAP = MIN( LGAP, RGAP )
-
-* Make sure that [LEFT,RIGHT] contains the desired eigenvalue
-* Compute negcount from dstqds facto L+D+L+^T = L D L^T - LEFT
-*
-* Do while( NEGCNT(LEFT).GT.I-1 )
-*
- BACK = WERR( II )
- 20 CONTINUE
- NEGCNT = DLANEG( N, D, LLD, LEFT, PIVMIN, R )
- IF( NEGCNT.GT.I-1 ) THEN
- LEFT = LEFT - BACK
- BACK = TWO*BACK
- GO TO 20
- END IF
-*
-* Do while( NEGCNT(RIGHT).LT.I )
-* Compute negcount from dstqds facto L+D+L+^T = L D L^T - RIGHT
-*
- BACK = WERR( II )
- 50 CONTINUE
-
- NEGCNT = DLANEG( N, D, LLD, RIGHT, PIVMIN, R )
- IF( NEGCNT.LT.I ) THEN
- RIGHT = RIGHT + BACK
- BACK = TWO*BACK
- GO TO 50
- END IF
- WIDTH = HALF*ABS( LEFT - RIGHT )
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
- CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
- IF( WIDTH.LE.CVRGD .OR. WIDTH.LE.MNWDTH ) THEN
-* This interval has already converged and does not need refinement.
-* (Note that the gaps might change through refining the
-* eigenvalues, however, they can only get bigger.)
-* Remove it from the list.
- IWORK( K-1 ) = -1
-* Make sure that I1 always points to the first unconverged interval
- IF((I.EQ.I1).AND.(I.LT.ILAST)) I1 = I + 1
- IF((PREV.GE.I1).AND.(I.LE.ILAST)) IWORK( 2*PREV-1 ) = I + 1
- ELSE
-* unconverged interval found
- PREV = I
- NINT = NINT + 1
- IWORK( K-1 ) = I + 1
- IWORK( K ) = NEGCNT
- END IF
- WORK( K-1 ) = LEFT
- WORK( K ) = RIGHT
- 75 CONTINUE
-
-*
-* Do while( NINT.GT.0 ), i.e. there are still unconverged intervals
-* and while (ITER.LT.MAXITR)
-*
- ITER = 0
- 80 CONTINUE
- PREV = I1 - 1
- I = I1
- OLNINT = NINT
-
- DO 100 IP = 1, OLNINT
- K = 2*I
- II = I - OFFSET
- RGAP = WGAP( II )
- LGAP = RGAP
- IF(II.GT.1) LGAP = WGAP( II-1 )
- GAP = MIN( LGAP, RGAP )
- NEXT = IWORK( K-1 )
- LEFT = WORK( K-1 )
- RIGHT = WORK( K )
- MID = HALF*( LEFT + RIGHT )
-
-* semiwidth of interval
- WIDTH = RIGHT - MID
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
- CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
- IF( ( WIDTH.LE.CVRGD ) .OR. ( WIDTH.LE.MNWDTH ).OR.
- $ ( ITER.EQ.MAXITR ) )THEN
-* reduce number of unconverged intervals
- NINT = NINT - 1
-* Mark interval as converged.
- IWORK( K-1 ) = 0
- IF( I1.EQ.I ) THEN
- I1 = NEXT
- ELSE
-* Prev holds the last unconverged interval previously examined
- IF(PREV.GE.I1) IWORK( 2*PREV-1 ) = NEXT
- END IF
- I = NEXT
- GO TO 100
- END IF
- PREV = I
-*
-* Perform one bisection step
-*
- NEGCNT = DLANEG( N, D, LLD, MID, PIVMIN, R )
- IF( NEGCNT.LE.I-1 ) THEN
- WORK( K-1 ) = MID
- ELSE
- WORK( K ) = MID
- END IF
- I = NEXT
- 100 CONTINUE
- ITER = ITER + 1
-* do another loop if there are still unconverged intervals
-* However, in the last iteration, all intervals are accepted
-* since this is the best we can do.
- IF( ( NINT.GT.0 ).AND.(ITER.LE.MAXITR) ) GO TO 80
-*
-*
-* At this point, all the intervals have converged
- DO 110 I = IFIRST, ILAST
- K = 2*I
- II = I - OFFSET
-* All intervals marked by '0' have been refined.
- IF( IWORK( K-1 ).EQ.0 ) THEN
- W( II ) = HALF*( WORK( K-1 )+WORK( K ) )
- WERR( II ) = WORK( K ) - W( II )
- END IF
- 110 CONTINUE
-*
- DO 111 I = IFIRST+1, ILAST
- K = 2*I
- II = I - OFFSET
- WGAP( II-1 ) = MAX( ZERO,
- $ W(II) - WERR (II) - W( II-1 ) - WERR( II-1 ))
- 111 CONTINUE
-
- RETURN
-*
-* End of DLARRB
-*
- END
diff --git a/netlib/LAPACK/dlarrc.f b/netlib/LAPACK/dlarrc.f
deleted file mode 100644
index f093563..0000000
--- a/netlib/LAPACK/dlarrc.f
+++ /dev/null
@@ -1,243 +0,0 @@
-*> \brief \b DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
-* EIGCNT, LCNT, RCNT, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBT
-* INTEGER EIGCNT, INFO, LCNT, N, RCNT
-* DOUBLE PRECISION PIVMIN, VL, VU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Find the number of eigenvalues of the symmetric tridiagonal matrix T
-*> that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
-*> if JOBT = 'L'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBT
-*> \verbatim
-*> JOBT is CHARACTER*1
-*> = 'T': Compute Sturm count for matrix T.
-*> = 'L': Compute Sturm count for matrix L D L^T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> The lower and upper bounds for the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
-*> JOBT = 'L': The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
-*> JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[out] EIGCNT
-*> \verbatim
-*> EIGCNT is INTEGER
-*> The number of eigenvalues of the symmetric tridiagonal matrix T
-*> that are in the interval (VL,VU]
-*> \endverbatim
-*>
-*> \param[out] LCNT
-*> \verbatim
-*> LCNT is INTEGER
-*> \endverbatim
-*>
-*> \param[out] RCNT
-*> \verbatim
-*> RCNT is INTEGER
-*> The left and right negcounts of the interval.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
- $ EIGCNT, LCNT, RCNT, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBT
- INTEGER EIGCNT, INFO, LCNT, N, RCNT
- DOUBLE PRECISION PIVMIN, VL, VU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- LOGICAL MATT
- DOUBLE PRECISION LPIVOT, RPIVOT, SL, SU, TMP, TMP2
-
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- LCNT = 0
- RCNT = 0
- EIGCNT = 0
- MATT = LSAME( JOBT, 'T' )
-
-
- IF (MATT) THEN
-* Sturm sequence count on T
- LPIVOT = D( 1 ) - VL
- RPIVOT = D( 1 ) - VU
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- DO 10 I = 1, N-1
- TMP = E(I)**2
- LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
- RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- 10 CONTINUE
- ELSE
-* Sturm sequence count on L D L^T
- SL = -VL
- SU = -VU
- DO 20 I = 1, N - 1
- LPIVOT = D( I ) + SL
- RPIVOT = D( I ) + SU
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- TMP = E(I) * D(I) * E(I)
-*
- TMP2 = TMP / LPIVOT
- IF( TMP2.EQ.ZERO ) THEN
- SL = TMP - VL
- ELSE
- SL = SL*TMP2 - VL
- END IF
-*
- TMP2 = TMP / RPIVOT
- IF( TMP2.EQ.ZERO ) THEN
- SU = TMP - VU
- ELSE
- SU = SU*TMP2 - VU
- END IF
- 20 CONTINUE
- LPIVOT = D( N ) + SL
- RPIVOT = D( N ) + SU
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- ENDIF
- EIGCNT = RCNT - LCNT
-
- RETURN
-*
-* end of DLARRC
-*
- END
diff --git a/netlib/LAPACK/dlarrd.f b/netlib/LAPACK/dlarrd.f
deleted file mode 100644
index 65cdbe9..0000000
--- a/netlib/LAPACK/dlarrd.f
+++ /dev/null
@@ -1,855 +0,0 @@
-*> \brief \b DLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS,
-* RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
-* M, W, WERR, WL, WU, IBLOCK, INDEXW,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ORDER, RANGE
-* INTEGER IL, INFO, IU, M, N, NSPLIT
-* DOUBLE PRECISION PIVMIN, RELTOL, VL, VU, WL, WU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), INDEXW( * ),
-* $ ISPLIT( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), E2( * ),
-* $ GERS( * ), W( * ), WERR( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARRD computes the eigenvalues of a symmetric tridiagonal
-*> matrix T to suitable accuracy. This is an auxiliary code to be
-*> called from DSTEMR.
-*> The user may ask for all eigenvalues, all eigenvalues
-*> in the half-open interval (VL, VU], or the IL-th through IU-th
-*> eigenvalues.
-*>
-*> To avoid overflow, the matrix must be scaled so that its
-*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
-*> accuracy, it should not be much smaller than that.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': ("All") all eigenvalues will be found.
-*> = 'V': ("Value") all eigenvalues in the half-open interval
-*> (VL, VU] will be found.
-*> = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
-*> entire matrix) will be found.
-*> \endverbatim
-*>
-*> \param[in] ORDER
-*> \verbatim
-*> ORDER is CHARACTER*1
-*> = 'B': ("By Block") the eigenvalues will be grouped by
-*> split-off block (see IBLOCK, ISPLIT) and
-*> ordered from smallest to largest within
-*> the block.
-*> = 'E': ("Entire matrix")
-*> the eigenvalues for the entire matrix
-*> will be ordered from smallest to
-*> largest.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. Eigenvalues less than or equal
-*> to VL, or greater than VU, will not be returned. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] GERS
-*> \verbatim
-*> GERS is DOUBLE PRECISION array, dimension (2*N)
-*> The N Gerschgorin intervals (the i-th Gerschgorin interval
-*> is (GERS(2*i-1), GERS(2*i)).
-*> \endverbatim
-*>
-*> \param[in] RELTOL
-*> \verbatim
-*> RELTOL is DOUBLE PRECISION
-*> The minimum relative width of an interval. When an interval
-*> is narrower than RELTOL times the larger (in
-*> magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. Note: this should
-*> always be at least radix*machine epsilon.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) squared off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot allowed in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[in] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of diagonal blocks in the matrix T.
-*> 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[in] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into submatrices.
-*> The first submatrix consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> (Only the first NSPLIT elements will actually be used, but
-*> since the user cannot know a priori what value NSPLIT will
-*> have, N words must be reserved for ISPLIT.)
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The actual number of eigenvalues found. 0 <= M <= N.
-*> (See also the description of INFO=2,3.)
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On exit, the first M elements of W will contain the
-*> eigenvalue approximations. DLARRD computes an interval
-*> I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
-*> approximation is given as the interval midpoint
-*> W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
-*> WERR(j) = abs( a_j - b_j)/2
-*> \endverbatim
-*>
-*> \param[out] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION array, dimension (N)
-*> The error bound on the corresponding eigenvalue approximation
-*> in W.
-*> \endverbatim
-*>
-*> \param[out] WL
-*> \verbatim
-*> WL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] WU
-*> \verbatim
-*> WU is DOUBLE PRECISION
-*> The interval (WL, WU] contains all the wanted eigenvalues.
-*> If RANGE='V', then WL=VL and WU=VU.
-*> If RANGE='A', then WL and WU are the global Gerschgorin bounds
-*> on the spectrum.
-*> If RANGE='I', then WL and WU are computed by DLAEBZ from the
-*> index range specified.
-*> \endverbatim
-*>
-*> \param[out] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> At each row/column j where E(j) is zero or small, the
-*> matrix T is considered to split into a block diagonal
-*> matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
-*> block (from 1 to the number of blocks) the eigenvalue W(i)
-*> belongs. (DLARRD may use the remaining N-M elements as
-*> workspace.)
-*> \endverbatim
-*>
-*> \param[out] INDEXW
-*> \verbatim
-*> INDEXW is INTEGER array, dimension (N)
-*> The indices of the eigenvalues within each block (submatrix);
-*> for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
-*> i-th eigenvalue W(i) is the j-th eigenvalue in block k.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: some or all of the eigenvalues failed to converge or
-*> were not computed:
-*> =1 or 3: Bisection failed to converge for some
-*> eigenvalues; these eigenvalues are flagged by a
-*> negative block number. The effect is that the
-*> eigenvalues may not be as accurate as the
-*> absolute and relative tolerances. This is
-*> generally caused by unexpectedly inaccurate
-*> arithmetic.
-*> =2 or 3: RANGE='I' only: Not all of the eigenvalues
-*> IL:IU were found.
-*> Effect: M < IU+1-IL
-*> Cause: non-monotonic arithmetic, causing the
-*> Sturm sequence to be non-monotonic.
-*> Cure: recalculate, using RANGE='A', and pick
-*> out eigenvalues IL:IU. In some cases,
-*> increasing the PARAMETER "FUDGE" may
-*> make things work.
-*> = 4: RANGE='I', and the Gershgorin interval
-*> initially used was too small. No eigenvalues
-*> were computed.
-*> Probable cause: your machine has sloppy
-*> floating-point arithmetic.
-*> Cure: Increase the PARAMETER "FUDGE",
-*> recompile, and try again.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> FUDGE DOUBLE PRECISION, default = 2
-*> A "fudge factor" to widen the Gershgorin intervals. Ideally,
-*> a value of 1 should work, but on machines with sloppy
-*> arithmetic, this needs to be larger. The default for
-*> publicly released versions should be large enough to handle
-*> the worst machine around. Note that this has no effect
-*> on accuracy of the solution.
-*> \endverbatim
-*>
-*> \par Contributors:
-* ==================
-*>
-*> W. Kahan, University of California, Berkeley, USA \n
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA \n
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS,
- $ RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
- $ M, W, WERR, WL, WU, IBLOCK, INDEXW,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER ORDER, RANGE
- INTEGER IL, INFO, IU, M, N, NSPLIT
- DOUBLE PRECISION PIVMIN, RELTOL, VL, VU, WL, WU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), INDEXW( * ),
- $ ISPLIT( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), E2( * ),
- $ GERS( * ), W( * ), WERR( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, HALF, FUDGE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, HALF = ONE/TWO,
- $ FUDGE = TWO )
- INTEGER ALLRNG, VALRNG, INDRNG
- PARAMETER ( ALLRNG = 1, VALRNG = 2, INDRNG = 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL NCNVRG, TOOFEW
- INTEGER I, IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
- $ IM, IN, IOFF, IOUT, IRANGE, ITMAX, ITMP1,
- $ ITMP2, IW, IWOFF, J, JBLK, JDISC, JE, JEE, NB,
- $ NWL, NWU
- DOUBLE PRECISION ATOLI, EPS, GL, GU, RTOLI, TMP1, TMP2,
- $ TNORM, UFLOW, WKILL, WLU, WUL
-
-* ..
-* .. Local Arrays ..
- INTEGER IDUMMA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, ILAENV, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAEBZ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Decode RANGE
-*
- IF( LSAME( RANGE, 'A' ) ) THEN
- IRANGE = ALLRNG
- ELSE IF( LSAME( RANGE, 'V' ) ) THEN
- IRANGE = VALRNG
- ELSE IF( LSAME( RANGE, 'I' ) ) THEN
- IRANGE = INDRNG
- ELSE
- IRANGE = 0
- END IF
-*
-* Check for Errors
-*
- IF( IRANGE.LE.0 ) THEN
- INFO = -1
- ELSE IF( .NOT.(LSAME(ORDER,'B').OR.LSAME(ORDER,'E')) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( IRANGE.EQ.VALRNG ) THEN
- IF( VL.GE.VU )
- $ INFO = -5
- ELSE IF( IRANGE.EQ.INDRNG .AND.
- $ ( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) ) THEN
- INFO = -6
- ELSE IF( IRANGE.EQ.INDRNG .AND.
- $ ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
-
-* Initialize error flags
- INFO = 0
- NCNVRG = .FALSE.
- TOOFEW = .FALSE.
-
-* Quick return if possible
- M = 0
- IF( N.EQ.0 ) RETURN
-
-* Simplification:
- IF( IRANGE.EQ.INDRNG .AND. IL.EQ.1 .AND. IU.EQ.N ) IRANGE = 1
-
-* Get machine constants
- EPS = DLAMCH( 'P' )
- UFLOW = DLAMCH( 'U' )
-
-
-* Special Case when N=1
-* Treat case of 1x1 matrix for quick return
- IF( N.EQ.1 ) THEN
- IF( (IRANGE.EQ.ALLRNG).OR.
- $ ((IRANGE.EQ.VALRNG).AND.(D(1).GT.VL).AND.(D(1).LE.VU)).OR.
- $ ((IRANGE.EQ.INDRNG).AND.(IL.EQ.1).AND.(IU.EQ.1)) ) THEN
- M = 1
- W(1) = D(1)
-* The computation error of the eigenvalue is zero
- WERR(1) = ZERO
- IBLOCK( 1 ) = 1
- INDEXW( 1 ) = 1
- ENDIF
- RETURN
- END IF
-
-* NB is the minimum vector length for vector bisection, or 0
-* if only scalar is to be done.
- NB = ILAENV( 1, 'DSTEBZ', ' ', N, -1, -1, -1 )
- IF( NB.LE.1 ) NB = 0
-
-* Find global spectral radius
- GL = D(1)
- GU = D(1)
- DO 5 I = 1,N
- GL = MIN( GL, GERS( 2*I - 1))
- GU = MAX( GU, GERS(2*I) )
- 5 CONTINUE
-* Compute global Gerschgorin bounds and spectral diameter
- TNORM = MAX( ABS( GL ), ABS( GU ) )
- GL = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN
- GU = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN
-* [JAN/28/2009] remove the line below since SPDIAM variable not use
-* SPDIAM = GU - GL
-* Input arguments for DLAEBZ:
-* The relative tolerance. An interval (a,b] lies within
-* "relative tolerance" if b-a < RELTOL*max(|a|,|b|),
- RTOLI = RELTOL
-* Set the absolute tolerance for interval convergence to zero to force
-* interval convergence based on relative size of the interval.
-* This is dangerous because intervals might not converge when RELTOL is
-* small. But at least a very small number should be selected so that for
-* strongly graded matrices, the code can get relatively accurate
-* eigenvalues.
- ATOLI = FUDGE*TWO*UFLOW + FUDGE*TWO*PIVMIN
-
- IF( IRANGE.EQ.INDRNG ) THEN
-
-* RANGE='I': Compute an interval containing eigenvalues
-* IL through IU. The initial interval [GL,GU] from the global
-* Gerschgorin bounds GL and GU is refined by DLAEBZ.
- ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- WORK( N+1 ) = GL
- WORK( N+2 ) = GL
- WORK( N+3 ) = GU
- WORK( N+4 ) = GU
- WORK( N+5 ) = GL
- WORK( N+6 ) = GU
- IWORK( 1 ) = -1
- IWORK( 2 ) = -1
- IWORK( 3 ) = N + 1
- IWORK( 4 ) = N + 1
- IWORK( 5 ) = IL - 1
- IWORK( 6 ) = IU
-*
- CALL DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN,
- $ D, E, E2, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
- $ IWORK, W, IBLOCK, IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = IINFO
- RETURN
- END IF
-* On exit, output intervals may not be ordered by ascending negcount
- IF( IWORK( 6 ).EQ.IU ) THEN
- WL = WORK( N+1 )
- WLU = WORK( N+3 )
- NWL = IWORK( 1 )
- WU = WORK( N+4 )
- WUL = WORK( N+2 )
- NWU = IWORK( 4 )
- ELSE
- WL = WORK( N+2 )
- WLU = WORK( N+4 )
- NWL = IWORK( 2 )
- WU = WORK( N+3 )
- WUL = WORK( N+1 )
- NWU = IWORK( 3 )
- END IF
-* On exit, the interval [WL, WLU] contains a value with negcount NWL,
-* and [WUL, WU] contains a value with negcount NWU.
- IF( NWL.LT.0 .OR. NWL.GE.N .OR. NWU.LT.1 .OR. NWU.GT.N ) THEN
- INFO = 4
- RETURN
- END IF
-
- ELSEIF( IRANGE.EQ.VALRNG ) THEN
- WL = VL
- WU = VU
-
- ELSEIF( IRANGE.EQ.ALLRNG ) THEN
- WL = GL
- WU = GU
- ENDIF
-
-
-
-* Find Eigenvalues -- Loop Over blocks and recompute NWL and NWU.
-* NWL accumulates the number of eigenvalues .le. WL,
-* NWU accumulates the number of eigenvalues .le. WU
- M = 0
- IEND = 0
- INFO = 0
- NWL = 0
- NWU = 0
-*
- DO 70 JBLK = 1, NSPLIT
- IOFF = IEND
- IBEGIN = IOFF + 1
- IEND = ISPLIT( JBLK )
- IN = IEND - IOFF
-*
- IF( IN.EQ.1 ) THEN
-* 1x1 block
- IF( WL.GE.D( IBEGIN )-PIVMIN )
- $ NWL = NWL + 1
- IF( WU.GE.D( IBEGIN )-PIVMIN )
- $ NWU = NWU + 1
- IF( IRANGE.EQ.ALLRNG .OR.
- $ ( WL.LT.D( IBEGIN )-PIVMIN
- $ .AND. WU.GE. D( IBEGIN )-PIVMIN ) ) THEN
- M = M + 1
- W( M ) = D( IBEGIN )
- WERR(M) = ZERO
-* The gap for a single block doesn't matter for the later
-* algorithm and is assigned an arbitrary large value
- IBLOCK( M ) = JBLK
- INDEXW( M ) = 1
- END IF
-
-* Disabled 2x2 case because of a failure on the following matrix
-* RANGE = 'I', IL = IU = 4
-* Original Tridiagonal, d = [
-* -0.150102010615740E+00
-* -0.849897989384260E+00
-* -0.128208148052635E-15
-* 0.128257718286320E-15
-* ];
-* e = [
-* -0.357171383266986E+00
-* -0.180411241501588E-15
-* -0.175152352710251E-15
-* ];
-*
-* ELSE IF( IN.EQ.2 ) THEN
-** 2x2 block
-* DISC = SQRT( (HALF*(D(IBEGIN)-D(IEND)))**2 + E(IBEGIN)**2 )
-* TMP1 = HALF*(D(IBEGIN)+D(IEND))
-* L1 = TMP1 - DISC
-* IF( WL.GE. L1-PIVMIN )
-* $ NWL = NWL + 1
-* IF( WU.GE. L1-PIVMIN )
-* $ NWU = NWU + 1
-* IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L1-PIVMIN .AND. WU.GE.
-* $ L1-PIVMIN ) ) THEN
-* M = M + 1
-* W( M ) = L1
-** The uncertainty of eigenvalues of a 2x2 matrix is very small
-* WERR( M ) = EPS * ABS( W( M ) ) * TWO
-* IBLOCK( M ) = JBLK
-* INDEXW( M ) = 1
-* ENDIF
-* L2 = TMP1 + DISC
-* IF( WL.GE. L2-PIVMIN )
-* $ NWL = NWL + 1
-* IF( WU.GE. L2-PIVMIN )
-* $ NWU = NWU + 1
-* IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L2-PIVMIN .AND. WU.GE.
-* $ L2-PIVMIN ) ) THEN
-* M = M + 1
-* W( M ) = L2
-** The uncertainty of eigenvalues of a 2x2 matrix is very small
-* WERR( M ) = EPS * ABS( W( M ) ) * TWO
-* IBLOCK( M ) = JBLK
-* INDEXW( M ) = 2
-* ENDIF
- ELSE
-* General Case - block of size IN >= 2
-* Compute local Gerschgorin interval and use it as the initial
-* interval for DLAEBZ
- GU = D( IBEGIN )
- GL = D( IBEGIN )
- TMP1 = ZERO
-
- DO 40 J = IBEGIN, IEND
- GL = MIN( GL, GERS( 2*J - 1))
- GU = MAX( GU, GERS(2*J) )
- 40 CONTINUE
-* [JAN/28/2009]
-* change SPDIAM by TNORM in lines 2 and 3 thereafter
-* line 1: remove computation of SPDIAM (not useful anymore)
-* SPDIAM = GU - GL
-* GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN
-* GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN
- GL = GL - FUDGE*TNORM*EPS*IN - FUDGE*PIVMIN
- GU = GU + FUDGE*TNORM*EPS*IN + FUDGE*PIVMIN
-*
- IF( IRANGE.GT.1 ) THEN
- IF( GU.LT.WL ) THEN
-* the local block contains none of the wanted eigenvalues
- NWL = NWL + IN
- NWU = NWU + IN
- GO TO 70
- END IF
-* refine search interval if possible, only range (WL,WU] matters
- GL = MAX( GL, WL )
- GU = MIN( GU, WU )
- IF( GL.GE.GU )
- $ GO TO 70
- END IF
-
-* Find negcount of initial interval boundaries GL and GU
- WORK( N+1 ) = GL
- WORK( N+IN+1 ) = GU
- CALL DLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = IINFO
- RETURN
- END IF
-*
- NWL = NWL + IWORK( 1 )
- NWU = NWU + IWORK( IN+1 )
- IWOFF = M - IWORK( 1 )
-
-* Compute Eigenvalues
- ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = IINFO
- RETURN
- END IF
-*
-* Copy eigenvalues into W and IBLOCK
-* Use -JBLK for block number for unconverged eigenvalues.
-* Loop over the number of output intervals from DLAEBZ
- DO 60 J = 1, IOUT
-* eigenvalue approximation is middle point of interval
- TMP1 = HALF*( WORK( J+N )+WORK( J+IN+N ) )
-* semi length of error interval
- TMP2 = HALF*ABS( WORK( J+N )-WORK( J+IN+N ) )
- IF( J.GT.IOUT-IINFO ) THEN
-* Flag non-convergence.
- NCNVRG = .TRUE.
- IB = -JBLK
- ELSE
- IB = JBLK
- END IF
- DO 50 JE = IWORK( J ) + 1 + IWOFF,
- $ IWORK( J+IN ) + IWOFF
- W( JE ) = TMP1
- WERR( JE ) = TMP2
- INDEXW( JE ) = JE - IWOFF
- IBLOCK( JE ) = IB
- 50 CONTINUE
- 60 CONTINUE
-*
- M = M + IM
- END IF
- 70 CONTINUE
-
-* If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
-* If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
- IF( IRANGE.EQ.INDRNG ) THEN
- IDISCL = IL - 1 - NWL
- IDISCU = NWU - IU
-*
- IF( IDISCL.GT.0 ) THEN
- IM = 0
- DO 80 JE = 1, M
-* Remove some of the smallest eigenvalues from the left so that
-* at the end IDISCL =0. Move all eigenvalues up to the left.
- IF( W( JE ).LE.WLU .AND. IDISCL.GT.0 ) THEN
- IDISCL = IDISCL - 1
- ELSE
- IM = IM + 1
- W( IM ) = W( JE )
- WERR( IM ) = WERR( JE )
- INDEXW( IM ) = INDEXW( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 80 CONTINUE
- M = IM
- END IF
- IF( IDISCU.GT.0 ) THEN
-* Remove some of the largest eigenvalues from the right so that
-* at the end IDISCU =0. Move all eigenvalues up to the left.
- IM=M+1
- DO 81 JE = M, 1, -1
- IF( W( JE ).GE.WUL .AND. IDISCU.GT.0 ) THEN
- IDISCU = IDISCU - 1
- ELSE
- IM = IM - 1
- W( IM ) = W( JE )
- WERR( IM ) = WERR( JE )
- INDEXW( IM ) = INDEXW( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 81 CONTINUE
- JEE = 0
- DO 82 JE = IM, M
- JEE = JEE + 1
- W( JEE ) = W( JE )
- WERR( JEE ) = WERR( JE )
- INDEXW( JEE ) = INDEXW( JE )
- IBLOCK( JEE ) = IBLOCK( JE )
- 82 CONTINUE
- M = M-IM+1
- END IF
-
- IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
-* Code to deal with effects of bad arithmetic. (If N(w) is
-* monotone non-decreasing, this should never happen.)
-* Some low eigenvalues to be discarded are not in (WL,WLU],
-* or high eigenvalues to be discarded are not in (WUL,WU]
-* so just kill off the smallest IDISCL/largest IDISCU
-* eigenvalues, by marking the corresponding IBLOCK = 0
- IF( IDISCL.GT.0 ) THEN
- WKILL = WU
- DO 100 JDISC = 1, IDISCL
- IW = 0
- DO 90 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).LT.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 90 CONTINUE
- IBLOCK( IW ) = 0
- 100 CONTINUE
- END IF
- IF( IDISCU.GT.0 ) THEN
- WKILL = WL
- DO 120 JDISC = 1, IDISCU
- IW = 0
- DO 110 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).GE.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 110 CONTINUE
- IBLOCK( IW ) = 0
- 120 CONTINUE
- END IF
-* Now erase all eigenvalues with IBLOCK set to zero
- IM = 0
- DO 130 JE = 1, M
- IF( IBLOCK( JE ).NE.0 ) THEN
- IM = IM + 1
- W( IM ) = W( JE )
- WERR( IM ) = WERR( JE )
- INDEXW( IM ) = INDEXW( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 130 CONTINUE
- M = IM
- END IF
- IF( IDISCL.LT.0 .OR. IDISCU.LT.0 ) THEN
- TOOFEW = .TRUE.
- END IF
- END IF
-*
- IF(( IRANGE.EQ.ALLRNG .AND. M.NE.N ).OR.
- $ ( IRANGE.EQ.INDRNG .AND. M.NE.IU-IL+1 ) ) THEN
- TOOFEW = .TRUE.
- END IF
-
-* If ORDER='B', do nothing the eigenvalues are already sorted by
-* block.
-* If ORDER='E', sort the eigenvalues from smallest to largest
-
- IF( LSAME(ORDER,'E') .AND. NSPLIT.GT.1 ) THEN
- DO 150 JE = 1, M - 1
- IE = 0
- TMP1 = W( JE )
- DO 140 J = JE + 1, M
- IF( W( J ).LT.TMP1 ) THEN
- IE = J
- TMP1 = W( J )
- END IF
- 140 CONTINUE
- IF( IE.NE.0 ) THEN
- TMP2 = WERR( IE )
- ITMP1 = IBLOCK( IE )
- ITMP2 = INDEXW( IE )
- W( IE ) = W( JE )
- WERR( IE ) = WERR( JE )
- IBLOCK( IE ) = IBLOCK( JE )
- INDEXW( IE ) = INDEXW( JE )
- W( JE ) = TMP1
- WERR( JE ) = TMP2
- IBLOCK( JE ) = ITMP1
- INDEXW( JE ) = ITMP2
- END IF
- 150 CONTINUE
- END IF
-*
- INFO = 0
- IF( NCNVRG )
- $ INFO = INFO + 1
- IF( TOOFEW )
- $ INFO = INFO + 2
- RETURN
-*
-* End of DLARRD
-*
- END
diff --git a/netlib/LAPACK/dlarre.f b/netlib/LAPACK/dlarre.f
deleted file mode 100644
index e7eea10..0000000
--- a/netlib/LAPACK/dlarre.f
+++ /dev/null
@@ -1,891 +0,0 @@
-*> \brief \b DLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduced block Ti, finds base representations and eigenvalues.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarre.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarre.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarre.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2,
-* RTOL1, RTOL2, SPLTOL, NSPLIT, ISPLIT, M,
-* W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER RANGE
-* INTEGER IL, INFO, IU, M, N, NSPLIT
-* DOUBLE PRECISION PIVMIN, RTOL1, RTOL2, SPLTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * ),
-* $ INDEXW( * )
-* DOUBLE PRECISION D( * ), E( * ), E2( * ), GERS( * ),
-* $ W( * ),WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> To find the desired eigenvalues of a given real symmetric
-*> tridiagonal matrix T, DLARRE sets any "small" off-diagonal
-*> elements to zero, and for each unreduced block T_i, it finds
-*> (a) a suitable shift at one end of the block's spectrum,
-*> (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
-*> (c) eigenvalues of each L_i D_i L_i^T.
-*> The representations and eigenvalues found are then used by
-*> DSTEMR to compute the eigenvectors of T.
-*> The accuracy varies depending on whether bisection is used to
-*> find a few eigenvalues or the dqds algorithm (subroutine DLASQ2) to
-*> conpute all and then discard any unwanted one.
-*> As an added benefit, DLARRE also outputs the n
-*> Gerschgorin intervals for the matrices L_i D_i L_i^T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': ("All") all eigenvalues will be found.
-*> = 'V': ("Value") all eigenvalues in the half-open interval
-*> (VL, VU] will be found.
-*> = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
-*> entire matrix) will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds for the eigenvalues.
-*> Eigenvalues less than or equal to VL, or greater than VU,
-*> will not be returned. VL < VU.
-*> If RANGE='I' or ='A', DLARRE computes bounds on the desired
-*> part of the spectrum.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal
-*> matrix T.
-*> On exit, the N diagonal elements of the diagonal
-*> matrices D_i.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, the first (N-1) entries contain the subdiagonal
-*> elements of the tridiagonal matrix T; E(N) need not be set.
-*> On exit, E contains the subdiagonal elements of the unit
-*> bidiagonal matrices L_i. The entries E( ISPLIT( I ) ),
-*> 1 <= I <= NSPLIT, contain the base points sigma_i on output.
-*> \endverbatim
-*>
-*> \param[in,out] E2
-*> \verbatim
-*> E2 is DOUBLE PRECISION array, dimension (N)
-*> On entry, the first (N-1) entries contain the SQUARES of the
-*> subdiagonal elements of the tridiagonal matrix T;
-*> E2(N) need not be set.
-*> On exit, the entries E2( ISPLIT( I ) ),
-*> 1 <= I <= NSPLIT, have been set to zero
-*> \endverbatim
-*>
-*> \param[in] RTOL1
-*> \verbatim
-*> RTOL1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] RTOL2
-*> \verbatim
-*> RTOL2 is DOUBLE PRECISION
-*> Parameters for bisection.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
-*> \endverbatim
-*>
-*> \param[in] SPLTOL
-*> \verbatim
-*> SPLTOL is DOUBLE PRECISION
-*> The threshold for splitting.
-*> \endverbatim
-*>
-*> \param[out] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of blocks T splits into. 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[out] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into blocks.
-*> The first block consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues (of all L_i D_i L_i^T)
-*> found.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the eigenvalues. The
-*> eigenvalues of each of the blocks, L_i D_i L_i^T, are
-*> sorted in ascending order ( DLARRE may use the
-*> remaining N-M elements as workspace).
-*> \endverbatim
-*>
-*> \param[out] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION array, dimension (N)
-*> The error bound on the corresponding eigenvalue in W.
-*> \endverbatim
-*>
-*> \param[out] WGAP
-*> \verbatim
-*> WGAP is DOUBLE PRECISION array, dimension (N)
-*> The separation from the right neighbor eigenvalue in W.
-*> The gap is only with respect to the eigenvalues of the same block
-*> as each block has its own representation tree.
-*> Exception: at the right end of a block we store the left gap
-*> \endverbatim
-*>
-*> \param[out] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> The indices of the blocks (submatrices) associated with the
-*> corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
-*> W(i) belongs to the first block from the top, =2 if W(i)
-*> belongs to the second block, etc.
-*> \endverbatim
-*>
-*> \param[out] INDEXW
-*> \verbatim
-*> INDEXW is INTEGER array, dimension (N)
-*> The indices of the eigenvalues within each block (submatrix);
-*> for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
-*> i-th eigenvalue W(i) is the 10-th eigenvalue in block 2
-*> \endverbatim
-*>
-*> \param[out] GERS
-*> \verbatim
-*> GERS is DOUBLE PRECISION array, dimension (2*N)
-*> The N Gerschgorin intervals (the i-th Gerschgorin interval
-*> is (GERS(2*i-1), GERS(2*i)).
-*> \endverbatim
-*>
-*> \param[out] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (6*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: A problem occured in DLARRE.
-*> < 0: One of the called subroutines signaled an internal problem.
-*> Needs inspection of the corresponding parameter IINFO
-*> for further information.
-*>
-*> =-1: Problem in DLARRD.
-*> = 2: No base representation could be found in MAXTRY iterations.
-*> Increasing MAXTRY and recompilation might be a remedy.
-*> =-3: Problem in DLARRB when computing the refined root
-*> representation for DLASQ2.
-*> =-4: Problem in DLARRB when preforming bisection on the
-*> desired part of the spectrum.
-*> =-5: Problem in DLASQ2.
-*> =-6: Problem in DLASQ2.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The base representations are required to suffer very little
-*> element growth and consequently define all their eigenvalues to
-*> high relative accuracy.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA \n
-*>
-* =====================================================================
- SUBROUTINE DLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2,
- $ RTOL1, RTOL2, SPLTOL, NSPLIT, ISPLIT, M,
- $ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER RANGE
- INTEGER IL, INFO, IU, M, N, NSPLIT
- DOUBLE PRECISION PIVMIN, RTOL1, RTOL2, SPLTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * ),
- $ INDEXW( * )
- DOUBLE PRECISION D( * ), E( * ), E2( * ), GERS( * ),
- $ W( * ),WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION FAC, FOUR, FOURTH, FUDGE, HALF, HNDRD,
- $ MAXGROWTH, ONE, PERT, TWO, ZERO
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, FOUR=4.0D0,
- $ HNDRD = 100.0D0,
- $ PERT = 8.0D0,
- $ HALF = ONE/TWO, FOURTH = ONE/FOUR, FAC= HALF,
- $ MAXGROWTH = 64.0D0, FUDGE = 2.0D0 )
- INTEGER MAXTRY, ALLRNG, INDRNG, VALRNG
- PARAMETER ( MAXTRY = 6, ALLRNG = 1, INDRNG = 2,
- $ VALRNG = 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL FORCEB, NOREP, USEDQD
- INTEGER CNT, CNT1, CNT2, I, IBEGIN, IDUM, IEND, IINFO,
- $ IN, INDL, INDU, IRANGE, J, JBLK, MB, MM,
- $ WBEGIN, WEND
- DOUBLE PRECISION AVGAP, BSRTOL, CLWDTH, DMAX, DPIVOT, EABS,
- $ EMAX, EOLD, EPS, GL, GU, ISLEFT, ISRGHT, RTL,
- $ RTOL, S1, S2, SAFMIN, SGNDEF, SIGMA, SPDIAM,
- $ TAU, TMP, TMP1
-
-
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH, LSAME
-
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLARNV, DLARRA, DLARRB, DLARRC, DLARRD,
- $ DLASQ2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-
-* ..
-* .. Executable Statements ..
-*
-
- INFO = 0
-
-*
-* Decode RANGE
-*
- IF( LSAME( RANGE, 'A' ) ) THEN
- IRANGE = ALLRNG
- ELSE IF( LSAME( RANGE, 'V' ) ) THEN
- IRANGE = VALRNG
- ELSE IF( LSAME( RANGE, 'I' ) ) THEN
- IRANGE = INDRNG
- END IF
-
- M = 0
-
-* Get machine constants
- SAFMIN = DLAMCH( 'S' )
- EPS = DLAMCH( 'P' )
-
-* Set parameters
- RTL = SQRT(EPS)
- BSRTOL = SQRT(EPS)
-
-* Treat case of 1x1 matrix for quick return
- IF( N.EQ.1 ) THEN
- IF( (IRANGE.EQ.ALLRNG).OR.
- $ ((IRANGE.EQ.VALRNG).AND.(D(1).GT.VL).AND.(D(1).LE.VU)).OR.
- $ ((IRANGE.EQ.INDRNG).AND.(IL.EQ.1).AND.(IU.EQ.1)) ) THEN
- M = 1
- W(1) = D(1)
-* The computation error of the eigenvalue is zero
- WERR(1) = ZERO
- WGAP(1) = ZERO
- IBLOCK( 1 ) = 1
- INDEXW( 1 ) = 1
- GERS(1) = D( 1 )
- GERS(2) = D( 1 )
- ENDIF
-* store the shift for the initial RRR, which is zero in this case
- E(1) = ZERO
- RETURN
- END IF
-
-* General case: tridiagonal matrix of order > 1
-*
-* Init WERR, WGAP. Compute Gerschgorin intervals and spectral diameter.
-* Compute maximum off-diagonal entry and pivmin.
- GL = D(1)
- GU = D(1)
- EOLD = ZERO
- EMAX = ZERO
- E(N) = ZERO
- DO 5 I = 1,N
- WERR(I) = ZERO
- WGAP(I) = ZERO
- EABS = ABS( E(I) )
- IF( EABS .GE. EMAX ) THEN
- EMAX = EABS
- END IF
- TMP1 = EABS + EOLD
- GERS( 2*I-1) = D(I) - TMP1
- GL = MIN( GL, GERS( 2*I - 1))
- GERS( 2*I ) = D(I) + TMP1
- GU = MAX( GU, GERS(2*I) )
- EOLD = EABS
- 5 CONTINUE
-* The minimum pivot allowed in the Sturm sequence for T
- PIVMIN = SAFMIN * MAX( ONE, EMAX**2 )
-* Compute spectral diameter. The Gerschgorin bounds give an
-* estimate that is wrong by at most a factor of SQRT(2)
- SPDIAM = GU - GL
-
-* Compute splitting points
- CALL DLARRA( N, D, E, E2, SPLTOL, SPDIAM,
- $ NSPLIT, ISPLIT, IINFO )
-
-* Can force use of bisection instead of faster DQDS.
-* Option left in the code for future multisection work.
- FORCEB = .FALSE.
-
-* Initialize USEDQD, DQDS should be used for ALLRNG unless someone
-* explicitly wants bisection.
- USEDQD = (( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB))
-
- IF( (IRANGE.EQ.ALLRNG) .AND. (.NOT. FORCEB) ) THEN
-* Set interval [VL,VU] that contains all eigenvalues
- VL = GL
- VU = GU
- ELSE
-* We call DLARRD to find crude approximations to the eigenvalues
-* in the desired range. In case IRANGE = INDRNG, we also obtain the
-* interval (VL,VU] that contains all the wanted eigenvalues.
-* An interval [LEFT,RIGHT] has converged if
-* RIGHT-LEFT.LT.RTOL*MAX(ABS(LEFT),ABS(RIGHT))
-* DLARRD needs a WORK of size 4*N, IWORK of size 3*N
- CALL DLARRD( RANGE, 'B', N, VL, VU, IL, IU, GERS,
- $ BSRTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
- $ MM, W, WERR, VL, VU, IBLOCK, INDEXW,
- $ WORK, IWORK, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
-* Make sure that the entries M+1 to N in W, WERR, IBLOCK, INDEXW are 0
- DO 14 I = MM+1,N
- W( I ) = ZERO
- WERR( I ) = ZERO
- IBLOCK( I ) = 0
- INDEXW( I ) = 0
- 14 CONTINUE
- END IF
-
-
-***
-* Loop over unreduced blocks
- IBEGIN = 1
- WBEGIN = 1
- DO 170 JBLK = 1, NSPLIT
- IEND = ISPLIT( JBLK )
- IN = IEND - IBEGIN + 1
-
-* 1 X 1 block
- IF( IN.EQ.1 ) THEN
- IF( (IRANGE.EQ.ALLRNG).OR.( (IRANGE.EQ.VALRNG).AND.
- $ ( D( IBEGIN ).GT.VL ).AND.( D( IBEGIN ).LE.VU ) )
- $ .OR. ( (IRANGE.EQ.INDRNG).AND.(IBLOCK(WBEGIN).EQ.JBLK))
- $ ) THEN
- M = M + 1
- W( M ) = D( IBEGIN )
- WERR(M) = ZERO
-* The gap for a single block doesn't matter for the later
-* algorithm and is assigned an arbitrary large value
- WGAP(M) = ZERO
- IBLOCK( M ) = JBLK
- INDEXW( M ) = 1
- WBEGIN = WBEGIN + 1
- ENDIF
-* E( IEND ) holds the shift for the initial RRR
- E( IEND ) = ZERO
- IBEGIN = IEND + 1
- GO TO 170
- END IF
-*
-* Blocks of size larger than 1x1
-*
-* E( IEND ) will hold the shift for the initial RRR, for now set it =0
- E( IEND ) = ZERO
-*
-* Find local outer bounds GL,GU for the block
- GL = D(IBEGIN)
- GU = D(IBEGIN)
- DO 15 I = IBEGIN , IEND
- GL = MIN( GERS( 2*I-1 ), GL )
- GU = MAX( GERS( 2*I ), GU )
- 15 CONTINUE
- SPDIAM = GU - GL
-
- IF(.NOT. ((IRANGE.EQ.ALLRNG).AND.(.NOT.FORCEB)) ) THEN
-* Count the number of eigenvalues in the current block.
- MB = 0
- DO 20 I = WBEGIN,MM
- IF( IBLOCK(I).EQ.JBLK ) THEN
- MB = MB+1
- ELSE
- GOTO 21
- ENDIF
- 20 CONTINUE
- 21 CONTINUE
-
- IF( MB.EQ.0) THEN
-* No eigenvalue in the current block lies in the desired range
-* E( IEND ) holds the shift for the initial RRR
- E( IEND ) = ZERO
- IBEGIN = IEND + 1
- GO TO 170
- ELSE
-
-* Decide whether dqds or bisection is more efficient
- USEDQD = ( (MB .GT. FAC*IN) .AND. (.NOT.FORCEB) )
- WEND = WBEGIN + MB - 1
-* Calculate gaps for the current block
-* In later stages, when representations for individual
-* eigenvalues are different, we use SIGMA = E( IEND ).
- SIGMA = ZERO
- DO 30 I = WBEGIN, WEND - 1
- WGAP( I ) = MAX( ZERO,
- $ W(I+1)-WERR(I+1) - (W(I)+WERR(I)) )
- 30 CONTINUE
- WGAP( WEND ) = MAX( ZERO,
- $ VU - SIGMA - (W( WEND )+WERR( WEND )))
-* Find local index of the first and last desired evalue.
- INDL = INDEXW(WBEGIN)
- INDU = INDEXW( WEND )
- ENDIF
- ENDIF
- IF(( (IRANGE.EQ.ALLRNG) .AND. (.NOT. FORCEB) ).OR.USEDQD) THEN
-* Case of DQDS
-* Find approximations to the extremal eigenvalues of the block
- CALL DLARRK( IN, 1, GL, GU, D(IBEGIN),
- $ E2(IBEGIN), PIVMIN, RTL, TMP, TMP1, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
- ISLEFT = MAX(GL, TMP - TMP1
- $ - HNDRD * EPS* ABS(TMP - TMP1))
-
- CALL DLARRK( IN, IN, GL, GU, D(IBEGIN),
- $ E2(IBEGIN), PIVMIN, RTL, TMP, TMP1, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
- ISRGHT = MIN(GU, TMP + TMP1
- $ + HNDRD * EPS * ABS(TMP + TMP1))
-* Improve the estimate of the spectral diameter
- SPDIAM = ISRGHT - ISLEFT
- ELSE
-* Case of bisection
-* Find approximations to the wanted extremal eigenvalues
- ISLEFT = MAX(GL, W(WBEGIN) - WERR(WBEGIN)
- $ - HNDRD * EPS*ABS(W(WBEGIN)- WERR(WBEGIN) ))
- ISRGHT = MIN(GU,W(WEND) + WERR(WEND)
- $ + HNDRD * EPS * ABS(W(WEND)+ WERR(WEND)))
- ENDIF
-
-
-* Decide whether the base representation for the current block
-* L_JBLK D_JBLK L_JBLK^T = T_JBLK - sigma_JBLK I
-* should be on the left or the right end of the current block.
-* The strategy is to shift to the end which is "more populated"
-* Furthermore, decide whether to use DQDS for the computation of
-* the eigenvalue approximations at the end of DLARRE or bisection.
-* dqds is chosen if all eigenvalues are desired or the number of
-* eigenvalues to be computed is large compared to the blocksize.
- IF( ( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB) ) THEN
-* If all the eigenvalues have to be computed, we use dqd
- USEDQD = .TRUE.
-* INDL is the local index of the first eigenvalue to compute
- INDL = 1
- INDU = IN
-* MB = number of eigenvalues to compute
- MB = IN
- WEND = WBEGIN + MB - 1
-* Define 1/4 and 3/4 points of the spectrum
- S1 = ISLEFT + FOURTH * SPDIAM
- S2 = ISRGHT - FOURTH * SPDIAM
- ELSE
-* DLARRD has computed IBLOCK and INDEXW for each eigenvalue
-* approximation.
-* choose sigma
- IF( USEDQD ) THEN
- S1 = ISLEFT + FOURTH * SPDIAM
- S2 = ISRGHT - FOURTH * SPDIAM
- ELSE
- TMP = MIN(ISRGHT,VU) - MAX(ISLEFT,VL)
- S1 = MAX(ISLEFT,VL) + FOURTH * TMP
- S2 = MIN(ISRGHT,VU) - FOURTH * TMP
- ENDIF
- ENDIF
-
-* Compute the negcount at the 1/4 and 3/4 points
- IF(MB.GT.1) THEN
- CALL DLARRC( 'T', IN, S1, S2, D(IBEGIN),
- $ E(IBEGIN), PIVMIN, CNT, CNT1, CNT2, IINFO)
- ENDIF
-
- IF(MB.EQ.1) THEN
- SIGMA = GL
- SGNDEF = ONE
- ELSEIF( CNT1 - INDL .GE. INDU - CNT2 ) THEN
- IF( ( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB) ) THEN
- SIGMA = MAX(ISLEFT,GL)
- ELSEIF( USEDQD ) THEN
-* use Gerschgorin bound as shift to get pos def matrix
-* for dqds
- SIGMA = ISLEFT
- ELSE
-* use approximation of the first desired eigenvalue of the
-* block as shift
- SIGMA = MAX(ISLEFT,VL)
- ENDIF
- SGNDEF = ONE
- ELSE
- IF( ( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB) ) THEN
- SIGMA = MIN(ISRGHT,GU)
- ELSEIF( USEDQD ) THEN
-* use Gerschgorin bound as shift to get neg def matrix
-* for dqds
- SIGMA = ISRGHT
- ELSE
-* use approximation of the first desired eigenvalue of the
-* block as shift
- SIGMA = MIN(ISRGHT,VU)
- ENDIF
- SGNDEF = -ONE
- ENDIF
-
-
-* An initial SIGMA has been chosen that will be used for computing
-* T - SIGMA I = L D L^T
-* Define the increment TAU of the shift in case the initial shift
-* needs to be refined to obtain a factorization with not too much
-* element growth.
- IF( USEDQD ) THEN
-* The initial SIGMA was to the outer end of the spectrum
-* the matrix is definite and we need not retreat.
- TAU = SPDIAM*EPS*N + TWO*PIVMIN
- TAU = MAX( TAU,TWO*EPS*ABS(SIGMA) )
- ELSE
- IF(MB.GT.1) THEN
- CLWDTH = W(WEND) + WERR(WEND) - W(WBEGIN) - WERR(WBEGIN)
- AVGAP = ABS(CLWDTH / DBLE(WEND-WBEGIN))
- IF( SGNDEF.EQ.ONE ) THEN
- TAU = HALF*MAX(WGAP(WBEGIN),AVGAP)
- TAU = MAX(TAU,WERR(WBEGIN))
- ELSE
- TAU = HALF*MAX(WGAP(WEND-1),AVGAP)
- TAU = MAX(TAU,WERR(WEND))
- ENDIF
- ELSE
- TAU = WERR(WBEGIN)
- ENDIF
- ENDIF
-*
- DO 80 IDUM = 1, MAXTRY
-* Compute L D L^T factorization of tridiagonal matrix T - sigma I.
-* Store D in WORK(1:IN), L in WORK(IN+1:2*IN), and reciprocals of
-* pivots in WORK(2*IN+1:3*IN)
- DPIVOT = D( IBEGIN ) - SIGMA
- WORK( 1 ) = DPIVOT
- DMAX = ABS( WORK(1) )
- J = IBEGIN
- DO 70 I = 1, IN - 1
- WORK( 2*IN+I ) = ONE / WORK( I )
- TMP = E( J )*WORK( 2*IN+I )
- WORK( IN+I ) = TMP
- DPIVOT = ( D( J+1 )-SIGMA ) - TMP*E( J )
- WORK( I+1 ) = DPIVOT
- DMAX = MAX( DMAX, ABS(DPIVOT) )
- J = J + 1
- 70 CONTINUE
-* check for element growth
- IF( DMAX .GT. MAXGROWTH*SPDIAM ) THEN
- NOREP = .TRUE.
- ELSE
- NOREP = .FALSE.
- ENDIF
- IF( USEDQD .AND. .NOT.NOREP ) THEN
-* Ensure the definiteness of the representation
-* All entries of D (of L D L^T) must have the same sign
- DO 71 I = 1, IN
- TMP = SGNDEF*WORK( I )
- IF( TMP.LT.ZERO ) NOREP = .TRUE.
- 71 CONTINUE
- ENDIF
- IF(NOREP) THEN
-* Note that in the case of IRANGE=ALLRNG, we use the Gerschgorin
-* shift which makes the matrix definite. So we should end up
-* here really only in the case of IRANGE = VALRNG or INDRNG.
- IF( IDUM.EQ.MAXTRY-1 ) THEN
- IF( SGNDEF.EQ.ONE ) THEN
-* The fudged Gerschgorin shift should succeed
- SIGMA =
- $ GL - FUDGE*SPDIAM*EPS*N - FUDGE*TWO*PIVMIN
- ELSE
- SIGMA =
- $ GU + FUDGE*SPDIAM*EPS*N + FUDGE*TWO*PIVMIN
- END IF
- ELSE
- SIGMA = SIGMA - SGNDEF * TAU
- TAU = TWO * TAU
- END IF
- ELSE
-* an initial RRR is found
- GO TO 83
- END IF
- 80 CONTINUE
-* if the program reaches this point, no base representation could be
-* found in MAXTRY iterations.
- INFO = 2
- RETURN
-
- 83 CONTINUE
-* At this point, we have found an initial base representation
-* T - SIGMA I = L D L^T with not too much element growth.
-* Store the shift.
- E( IEND ) = SIGMA
-* Store D and L.
- CALL DCOPY( IN, WORK, 1, D( IBEGIN ), 1 )
- CALL DCOPY( IN-1, WORK( IN+1 ), 1, E( IBEGIN ), 1 )
-
-
- IF(MB.GT.1 ) THEN
-*
-* Perturb each entry of the base representation by a small
-* (but random) relative amount to overcome difficulties with
-* glued matrices.
-*
- DO 122 I = 1, 4
- ISEED( I ) = 1
- 122 CONTINUE
-
- CALL DLARNV(2, ISEED, 2*IN-1, WORK(1))
- DO 125 I = 1,IN-1
- D(IBEGIN+I-1) = D(IBEGIN+I-1)*(ONE+EPS*PERT*WORK(I))
- E(IBEGIN+I-1) = E(IBEGIN+I-1)*(ONE+EPS*PERT*WORK(IN+I))
- 125 CONTINUE
- D(IEND) = D(IEND)*(ONE+EPS*FOUR*WORK(IN))
-*
- ENDIF
-*
-* Don't update the Gerschgorin intervals because keeping track
-* of the updates would be too much work in DLARRV.
-* We update W instead and use it to locate the proper Gerschgorin
-* intervals.
-
-* Compute the required eigenvalues of L D L' by bisection or dqds
- IF ( .NOT.USEDQD ) THEN
-* If DLARRD has been used, shift the eigenvalue approximations
-* according to their representation. This is necessary for
-* a uniform DLARRV since dqds computes eigenvalues of the
-* shifted representation. In DLARRV, W will always hold the
-* UNshifted eigenvalue approximation.
- DO 134 J=WBEGIN,WEND
- W(J) = W(J) - SIGMA
- WERR(J) = WERR(J) + ABS(W(J)) * EPS
- 134 CONTINUE
-* call DLARRB to reduce eigenvalue error of the approximations
-* from DLARRD
- DO 135 I = IBEGIN, IEND-1
- WORK( I ) = D( I ) * E( I )**2
- 135 CONTINUE
-* use bisection to find EV from INDL to INDU
- CALL DLARRB(IN, D(IBEGIN), WORK(IBEGIN),
- $ INDL, INDU, RTOL1, RTOL2, INDL-1,
- $ W(WBEGIN), WGAP(WBEGIN), WERR(WBEGIN),
- $ WORK( 2*N+1 ), IWORK, PIVMIN, SPDIAM,
- $ IN, IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = -4
- RETURN
- END IF
-* DLARRB computes all gaps correctly except for the last one
-* Record distance to VU/GU
- WGAP( WEND ) = MAX( ZERO,
- $ ( VU-SIGMA ) - ( W( WEND ) + WERR( WEND ) ) )
- DO 138 I = INDL, INDU
- M = M + 1
- IBLOCK(M) = JBLK
- INDEXW(M) = I
- 138 CONTINUE
- ELSE
-* Call dqds to get all eigs (and then possibly delete unwanted
-* eigenvalues).
-* Note that dqds finds the eigenvalues of the L D L^T representation
-* of T to high relative accuracy. High relative accuracy
-* might be lost when the shift of the RRR is subtracted to obtain
-* the eigenvalues of T. However, T is not guaranteed to define its
-* eigenvalues to high relative accuracy anyway.
-* Set RTOL to the order of the tolerance used in DLASQ2
-* This is an ESTIMATED error, the worst case bound is 4*N*EPS
-* which is usually too large and requires unnecessary work to be
-* done by bisection when computing the eigenvectors
- RTOL = LOG(DBLE(IN)) * FOUR * EPS
- J = IBEGIN
- DO 140 I = 1, IN - 1
- WORK( 2*I-1 ) = ABS( D( J ) )
- WORK( 2*I ) = E( J )*E( J )*WORK( 2*I-1 )
- J = J + 1
- 140 CONTINUE
- WORK( 2*IN-1 ) = ABS( D( IEND ) )
- WORK( 2*IN ) = ZERO
- CALL DLASQ2( IN, WORK, IINFO )
- IF( IINFO .NE. 0 ) THEN
-* If IINFO = -5 then an index is part of a tight cluster
-* and should be changed. The index is in IWORK(1) and the
-* gap is in WORK(N+1)
- INFO = -5
- RETURN
- ELSE
-* Test that all eigenvalues are positive as expected
- DO 149 I = 1, IN
- IF( WORK( I ).LT.ZERO ) THEN
- INFO = -6
- RETURN
- ENDIF
- 149 CONTINUE
- END IF
- IF( SGNDEF.GT.ZERO ) THEN
- DO 150 I = INDL, INDU
- M = M + 1
- W( M ) = WORK( IN-I+1 )
- IBLOCK( M ) = JBLK
- INDEXW( M ) = I
- 150 CONTINUE
- ELSE
- DO 160 I = INDL, INDU
- M = M + 1
- W( M ) = -WORK( I )
- IBLOCK( M ) = JBLK
- INDEXW( M ) = I
- 160 CONTINUE
- END IF
-
- DO 165 I = M - MB + 1, M
-* the value of RTOL below should be the tolerance in DLASQ2
- WERR( I ) = RTOL * ABS( W(I) )
- 165 CONTINUE
- DO 166 I = M - MB + 1, M - 1
-* compute the right gap between the intervals
- WGAP( I ) = MAX( ZERO,
- $ W(I+1)-WERR(I+1) - (W(I)+WERR(I)) )
- 166 CONTINUE
- WGAP( M ) = MAX( ZERO,
- $ ( VU-SIGMA ) - ( W( M ) + WERR( M ) ) )
- END IF
-* proceed with next block
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- 170 CONTINUE
-*
-
- RETURN
-*
-* end of DLARRE
-*
- END
diff --git a/netlib/LAPACK/dlarrf.f b/netlib/LAPACK/dlarrf.f
deleted file mode 100644
index 51c25d7..0000000
--- a/netlib/LAPACK/dlarrf.f
+++ /dev/null
@@ -1,487 +0,0 @@
-*> \brief \b DLARRF finds a new relatively robust representation such that at least one of the eigenvalues is relatively isolated.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRF( N, D, L, LD, CLSTRT, CLEND,
-* W, WGAP, WERR,
-* SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA,
-* DPLUS, LPLUS, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CLSTRT, CLEND, INFO, N
-* DOUBLE PRECISION CLGAPL, CLGAPR, PIVMIN, SIGMA, SPDIAM
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DPLUS( * ), L( * ), LD( * ),
-* $ LPLUS( * ), W( * ), WGAP( * ), WERR( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given the initial representation L D L^T and its cluster of close
-*> eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
-*> W( CLEND ), DLARRF finds a new relatively robust representation
-*> L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
-*> eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix (subblock, if the matrix splitted).
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is DOUBLE PRECISION array, dimension (N-1)
-*> The (N-1) subdiagonal elements of the unit bidiagonal
-*> matrix L.
-*> \endverbatim
-*>
-*> \param[in] LD
-*> \verbatim
-*> LD is DOUBLE PRECISION array, dimension (N-1)
-*> The (N-1) elements L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] CLSTRT
-*> \verbatim
-*> CLSTRT is INTEGER
-*> The index of the first eigenvalue in the cluster.
-*> \endverbatim
-*>
-*> \param[in] CLEND
-*> \verbatim
-*> CLEND is INTEGER
-*> The index of the last eigenvalue in the cluster.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension
-*> dimension is >= (CLEND-CLSTRT+1)
-*> The eigenvalue APPROXIMATIONS of L D L^T in ascending order.
-*> W( CLSTRT ) through W( CLEND ) form the cluster of relatively
-*> close eigenalues.
-*> \endverbatim
-*>
-*> \param[in,out] WGAP
-*> \verbatim
-*> WGAP is DOUBLE PRECISION array, dimension
-*> dimension is >= (CLEND-CLSTRT+1)
-*> The separation from the right neighbor eigenvalue in W.
-*> \endverbatim
-*>
-*> \param[in] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION array, dimension
-*> dimension is >= (CLEND-CLSTRT+1)
-*> WERR contain the semiwidth of the uncertainty
-*> interval of the corresponding eigenvalue APPROXIMATION in W
-*> \endverbatim
-*>
-*> \param[in] SPDIAM
-*> \verbatim
-*> SPDIAM is DOUBLE PRECISION
-*> estimate of the spectral diameter obtained from the
-*> Gerschgorin intervals
-*> \endverbatim
-*>
-*> \param[in] CLGAPL
-*> \verbatim
-*> CLGAPL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] CLGAPR
-*> \verbatim
-*> CLGAPR is DOUBLE PRECISION
-*> absolute gap on each end of the cluster.
-*> Set by the calling routine to protect against shifts too close
-*> to eigenvalues outside the cluster.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot allowed in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> The shift used to form L(+) D(+) L(+)^T.
-*> \endverbatim
-*>
-*> \param[out] DPLUS
-*> \verbatim
-*> DPLUS is DOUBLE PRECISION array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D(+).
-*> \endverbatim
-*>
-*> \param[out] LPLUS
-*> \verbatim
-*> LPLUS is DOUBLE PRECISION array, dimension (N-1)
-*> The first (N-1) elements of LPLUS contain the subdiagonal
-*> elements of the unit bidiagonal matrix L(+).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Signals processing OK (=0) or failure (=1)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRF( N, D, L, LD, CLSTRT, CLEND,
- $ W, WGAP, WERR,
- $ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA,
- $ DPLUS, LPLUS, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CLSTRT, CLEND, INFO, N
- DOUBLE PRECISION CLGAPL, CLGAPR, PIVMIN, SIGMA, SPDIAM
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DPLUS( * ), L( * ), LD( * ),
- $ LPLUS( * ), W( * ), WGAP( * ), WERR( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION FOUR, MAXGROWTH1, MAXGROWTH2, ONE, QUART, TWO
- PARAMETER ( ONE = 1.0D0, TWO = 2.0D0, FOUR = 4.0D0,
- $ QUART = 0.25D0,
- $ MAXGROWTH1 = 8.D0,
- $ MAXGROWTH2 = 8.D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DORRR1, FORCER, NOFAIL, SAWNAN1, SAWNAN2, TRYRRR1
- INTEGER I, INDX, KTRY, KTRYMAX, SLEFT, SRIGHT, SHIFT
- PARAMETER ( KTRYMAX = 1, SLEFT = 1, SRIGHT = 2 )
- DOUBLE PRECISION AVGAP, BESTSHIFT, CLWDTH, EPS, FACT, FAIL,
- $ FAIL2, GROWTHBOUND, LDELTA, LDMAX, LSIGMA,
- $ MAX1, MAX2, MINGAP, OLDP, PROD, RDELTA, RDMAX,
- $ RRR1, RRR2, RSIGMA, S, SMLGROWTH, TMP, ZNM2
-* ..
-* .. External Functions ..
- LOGICAL DISNAN
- DOUBLE PRECISION DLAMCH
- EXTERNAL DISNAN, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- FACT = DBLE(2**KTRYMAX)
- EPS = DLAMCH( 'Precision' )
- SHIFT = 0
- FORCER = .FALSE.
-
-
-* Note that we cannot guarantee that for any of the shifts tried,
-* the factorization has a small or even moderate element growth.
-* There could be Ritz values at both ends of the cluster and despite
-* backing off, there are examples where all factorizations tried
-* (in IEEE mode, allowing zero pivots & infinities) have INFINITE
-* element growth.
-* For this reason, we should use PIVMIN in this subroutine so that at
-* least the L D L^T factorization exists. It can be checked afterwards
-* whether the element growth caused bad residuals/orthogonality.
-
-* Decide whether the code should accept the best among all
-* representations despite large element growth or signal INFO=1
- NOFAIL = .TRUE.
-*
-
-* Compute the average gap length of the cluster
- CLWDTH = ABS(W(CLEND)-W(CLSTRT)) + WERR(CLEND) + WERR(CLSTRT)
- AVGAP = CLWDTH / DBLE(CLEND-CLSTRT)
- MINGAP = MIN(CLGAPL, CLGAPR)
-* Initial values for shifts to both ends of cluster
- LSIGMA = MIN(W( CLSTRT ),W( CLEND )) - WERR( CLSTRT )
- RSIGMA = MAX(W( CLSTRT ),W( CLEND )) + WERR( CLEND )
-
-* Use a small fudge to make sure that we really shift to the outside
- LSIGMA = LSIGMA - ABS(LSIGMA)* FOUR * EPS
- RSIGMA = RSIGMA + ABS(RSIGMA)* FOUR * EPS
-
-* Compute upper bounds for how much to back off the initial shifts
- LDMAX = QUART * MINGAP + TWO * PIVMIN
- RDMAX = QUART * MINGAP + TWO * PIVMIN
-
- LDELTA = MAX(AVGAP,WGAP( CLSTRT ))/FACT
- RDELTA = MAX(AVGAP,WGAP( CLEND-1 ))/FACT
-*
-* Initialize the record of the best representation found
-*
- S = DLAMCH( 'S' )
- SMLGROWTH = ONE / S
- FAIL = DBLE(N-1)*MINGAP/(SPDIAM*EPS)
- FAIL2 = DBLE(N-1)*MINGAP/(SPDIAM*SQRT(EPS))
- BESTSHIFT = LSIGMA
-*
-* while (KTRY <= KTRYMAX)
- KTRY = 0
- GROWTHBOUND = MAXGROWTH1*SPDIAM
-
- 5 CONTINUE
- SAWNAN1 = .FALSE.
- SAWNAN2 = .FALSE.
-* Ensure that we do not back off too much of the initial shifts
- LDELTA = MIN(LDMAX,LDELTA)
- RDELTA = MIN(RDMAX,RDELTA)
-
-* Compute the element growth when shifting to both ends of the cluster
-* accept the shift if there is no element growth at one of the two ends
-
-* Left end
- S = -LSIGMA
- DPLUS( 1 ) = D( 1 ) + S
- IF(ABS(DPLUS(1)).LT.PIVMIN) THEN
- DPLUS(1) = -PIVMIN
-* Need to set SAWNAN1 because refined RRR test should not be used
-* in this case
- SAWNAN1 = .TRUE.
- ENDIF
- MAX1 = ABS( DPLUS( 1 ) )
- DO 6 I = 1, N - 1
- LPLUS( I ) = LD( I ) / DPLUS( I )
- S = S*LPLUS( I )*L( I ) - LSIGMA
- DPLUS( I+1 ) = D( I+1 ) + S
- IF(ABS(DPLUS(I+1)).LT.PIVMIN) THEN
- DPLUS(I+1) = -PIVMIN
-* Need to set SAWNAN1 because refined RRR test should not be used
-* in this case
- SAWNAN1 = .TRUE.
- ENDIF
- MAX1 = MAX( MAX1,ABS(DPLUS(I+1)) )
- 6 CONTINUE
- SAWNAN1 = SAWNAN1 .OR. DISNAN( MAX1 )
-
- IF( FORCER .OR.
- $ (MAX1.LE.GROWTHBOUND .AND. .NOT.SAWNAN1 ) ) THEN
- SIGMA = LSIGMA
- SHIFT = SLEFT
- GOTO 100
- ENDIF
-
-* Right end
- S = -RSIGMA
- WORK( 1 ) = D( 1 ) + S
- IF(ABS(WORK(1)).LT.PIVMIN) THEN
- WORK(1) = -PIVMIN
-* Need to set SAWNAN2 because refined RRR test should not be used
-* in this case
- SAWNAN2 = .TRUE.
- ENDIF
- MAX2 = ABS( WORK( 1 ) )
- DO 7 I = 1, N - 1
- WORK( N+I ) = LD( I ) / WORK( I )
- S = S*WORK( N+I )*L( I ) - RSIGMA
- WORK( I+1 ) = D( I+1 ) + S
- IF(ABS(WORK(I+1)).LT.PIVMIN) THEN
- WORK(I+1) = -PIVMIN
-* Need to set SAWNAN2 because refined RRR test should not be used
-* in this case
- SAWNAN2 = .TRUE.
- ENDIF
- MAX2 = MAX( MAX2,ABS(WORK(I+1)) )
- 7 CONTINUE
- SAWNAN2 = SAWNAN2 .OR. DISNAN( MAX2 )
-
- IF( FORCER .OR.
- $ (MAX2.LE.GROWTHBOUND .AND. .NOT.SAWNAN2 ) ) THEN
- SIGMA = RSIGMA
- SHIFT = SRIGHT
- GOTO 100
- ENDIF
-* If we are at this point, both shifts led to too much element growth
-
-* Record the better of the two shifts (provided it didn't lead to NaN)
- IF(SAWNAN1.AND.SAWNAN2) THEN
-* both MAX1 and MAX2 are NaN
- GOTO 50
- ELSE
- IF( .NOT.SAWNAN1 ) THEN
- INDX = 1
- IF(MAX1.LE.SMLGROWTH) THEN
- SMLGROWTH = MAX1
- BESTSHIFT = LSIGMA
- ENDIF
- ENDIF
- IF( .NOT.SAWNAN2 ) THEN
- IF(SAWNAN1 .OR. MAX2.LE.MAX1) INDX = 2
- IF(MAX2.LE.SMLGROWTH) THEN
- SMLGROWTH = MAX2
- BESTSHIFT = RSIGMA
- ENDIF
- ENDIF
- ENDIF
-
-* If we are here, both the left and the right shift led to
-* element growth. If the element growth is moderate, then
-* we may still accept the representation, if it passes a
-* refined test for RRR. This test supposes that no NaN occurred.
-* Moreover, we use the refined RRR test only for isolated clusters.
- IF((CLWDTH.LT.MINGAP/DBLE(128)) .AND.
- $ (MIN(MAX1,MAX2).LT.FAIL2)
- $ .AND.(.NOT.SAWNAN1).AND.(.NOT.SAWNAN2)) THEN
- DORRR1 = .TRUE.
- ELSE
- DORRR1 = .FALSE.
- ENDIF
- TRYRRR1 = .TRUE.
- IF( TRYRRR1 .AND. DORRR1 ) THEN
- IF(INDX.EQ.1) THEN
- TMP = ABS( DPLUS( N ) )
- ZNM2 = ONE
- PROD = ONE
- OLDP = ONE
- DO 15 I = N-1, 1, -1
- IF( PROD .LE. EPS ) THEN
- PROD =
- $ ((DPLUS(I+1)*WORK(N+I+1))/(DPLUS(I)*WORK(N+I)))*OLDP
- ELSE
- PROD = PROD*ABS(WORK(N+I))
- END IF
- OLDP = PROD
- ZNM2 = ZNM2 + PROD**2
- TMP = MAX( TMP, ABS( DPLUS( I ) * PROD ))
- 15 CONTINUE
- RRR1 = TMP/( SPDIAM * SQRT( ZNM2 ) )
- IF (RRR1.LE.MAXGROWTH2) THEN
- SIGMA = LSIGMA
- SHIFT = SLEFT
- GOTO 100
- ENDIF
- ELSE IF(INDX.EQ.2) THEN
- TMP = ABS( WORK( N ) )
- ZNM2 = ONE
- PROD = ONE
- OLDP = ONE
- DO 16 I = N-1, 1, -1
- IF( PROD .LE. EPS ) THEN
- PROD = ((WORK(I+1)*LPLUS(I+1))/(WORK(I)*LPLUS(I)))*OLDP
- ELSE
- PROD = PROD*ABS(LPLUS(I))
- END IF
- OLDP = PROD
- ZNM2 = ZNM2 + PROD**2
- TMP = MAX( TMP, ABS( WORK( I ) * PROD ))
- 16 CONTINUE
- RRR2 = TMP/( SPDIAM * SQRT( ZNM2 ) )
- IF (RRR2.LE.MAXGROWTH2) THEN
- SIGMA = RSIGMA
- SHIFT = SRIGHT
- GOTO 100
- ENDIF
- END IF
- ENDIF
-
- 50 CONTINUE
-
- IF (KTRY.LT.KTRYMAX) THEN
-* If we are here, both shifts failed also the RRR test.
-* Back off to the outside
- LSIGMA = MAX( LSIGMA - LDELTA,
- $ LSIGMA - LDMAX)
- RSIGMA = MIN( RSIGMA + RDELTA,
- $ RSIGMA + RDMAX )
- LDELTA = TWO * LDELTA
- RDELTA = TWO * RDELTA
- KTRY = KTRY + 1
- GOTO 5
- ELSE
-* None of the representations investigated satisfied our
-* criteria. Take the best one we found.
- IF((SMLGROWTH.LT.FAIL).OR.NOFAIL) THEN
- LSIGMA = BESTSHIFT
- RSIGMA = BESTSHIFT
- FORCER = .TRUE.
- GOTO 5
- ELSE
- INFO = 1
- RETURN
- ENDIF
- END IF
-
- 100 CONTINUE
- IF (SHIFT.EQ.SLEFT) THEN
- ELSEIF (SHIFT.EQ.SRIGHT) THEN
-* store new L and D back into DPLUS, LPLUS
- CALL DCOPY( N, WORK, 1, DPLUS, 1 )
- CALL DCOPY( N-1, WORK(N+1), 1, LPLUS, 1 )
- ENDIF
-
- RETURN
-*
-* End of DLARRF
-*
- END
diff --git a/netlib/LAPACK/dlarrj.f b/netlib/LAPACK/dlarrj.f
deleted file mode 100644
index 7fb5cbf..0000000
--- a/netlib/LAPACK/dlarrj.f
+++ /dev/null
@@ -1,373 +0,0 @@
-*> \brief \b DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRJ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrj.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrj.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrj.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
-* RTOL, OFFSET, W, WERR, WORK, IWORK,
-* PIVMIN, SPDIAM, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IFIRST, ILAST, INFO, N, OFFSET
-* DOUBLE PRECISION PIVMIN, RTOL, SPDIAM
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION D( * ), E2( * ), W( * ),
-* $ WERR( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given the initial eigenvalue approximations of T, DLARRJ
-*> does bisection to refine the eigenvalues of T,
-*> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
-*> guesses for these eigenvalues are input in W, the corresponding estimate
-*> of the error in these guesses in WERR. During bisection, intervals
-*> [left, right] are maintained by storing their mid-points and
-*> semi-widths in the arrays W and WERR respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The N diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is DOUBLE PRECISION array, dimension (N-1)
-*> The Squares of the (N-1) subdiagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] IFIRST
-*> \verbatim
-*> IFIRST is INTEGER
-*> The index of the first eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] ILAST
-*> \verbatim
-*> ILAST is INTEGER
-*> The index of the last eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] RTOL
-*> \verbatim
-*> RTOL is DOUBLE PRECISION
-*> Tolerance for the convergence of the bisection intervals.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
-*> through ILAST-OFFSET elements of these arrays are to be used.
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
-*> estimates of the eigenvalues of L D L^T indexed IFIRST through
-*> ILAST.
-*> On output, these estimates are refined.
-*> \endverbatim
-*>
-*> \param[in,out] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION array, dimension (N)
-*> On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are
-*> the errors in the estimates of the corresponding elements in W.
-*> On output, these errors are refined.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[in] SPDIAM
-*> \verbatim
-*> SPDIAM is DOUBLE PRECISION
-*> The spectral diameter of T.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error flag.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
- $ RTOL, OFFSET, W, WERR, WORK, IWORK,
- $ PIVMIN, SPDIAM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IFIRST, ILAST, INFO, N, OFFSET
- DOUBLE PRECISION PIVMIN, RTOL, SPDIAM
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION D( * ), E2( * ), W( * ),
- $ WERR( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, HALF
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ HALF = 0.5D0 )
- INTEGER MAXITR
-* ..
-* .. Local Scalars ..
- INTEGER CNT, I, I1, I2, II, ITER, J, K, NEXT, NINT,
- $ OLNINT, P, PREV, SAVI1
- DOUBLE PRECISION DPLUS, FAC, LEFT, MID, RIGHT, S, TMP, WIDTH
-*
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
- MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
-*
-* Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ].
-* The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while
-* Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 )
-* for an unconverged interval is set to the index of the next unconverged
-* interval, and is -1 or 0 for a converged interval. Thus a linked
-* list of unconverged intervals is set up.
-*
-
- I1 = IFIRST
- I2 = ILAST
-* The number of unconverged intervals
- NINT = 0
-* The last unconverged interval found
- PREV = 0
- DO 75 I = I1, I2
- K = 2*I
- II = I - OFFSET
- LEFT = W( II ) - WERR( II )
- MID = W(II)
- RIGHT = W( II ) + WERR( II )
- WIDTH = RIGHT - MID
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
-
-* The following test prevents the test of converged intervals
- IF( WIDTH.LT.RTOL*TMP ) THEN
-* This interval has already converged and does not need refinement.
-* (Note that the gaps might change through refining the
-* eigenvalues, however, they can only get bigger.)
-* Remove it from the list.
- IWORK( K-1 ) = -1
-* Make sure that I1 always points to the first unconverged interval
- IF((I.EQ.I1).AND.(I.LT.I2)) I1 = I + 1
- IF((PREV.GE.I1).AND.(I.LE.I2)) IWORK( 2*PREV-1 ) = I + 1
- ELSE
-* unconverged interval found
- PREV = I
-* Make sure that [LEFT,RIGHT] contains the desired eigenvalue
-*
-* Do while( CNT(LEFT).GT.I-1 )
-*
- FAC = ONE
- 20 CONTINUE
- CNT = 0
- S = LEFT
- DPLUS = D( 1 ) - S
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- DO 30 J = 2, N
- DPLUS = D( J ) - S - E2( J-1 )/DPLUS
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- 30 CONTINUE
- IF( CNT.GT.I-1 ) THEN
- LEFT = LEFT - WERR( II )*FAC
- FAC = TWO*FAC
- GO TO 20
- END IF
-*
-* Do while( CNT(RIGHT).LT.I )
-*
- FAC = ONE
- 50 CONTINUE
- CNT = 0
- S = RIGHT
- DPLUS = D( 1 ) - S
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- DO 60 J = 2, N
- DPLUS = D( J ) - S - E2( J-1 )/DPLUS
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- 60 CONTINUE
- IF( CNT.LT.I ) THEN
- RIGHT = RIGHT + WERR( II )*FAC
- FAC = TWO*FAC
- GO TO 50
- END IF
- NINT = NINT + 1
- IWORK( K-1 ) = I + 1
- IWORK( K ) = CNT
- END IF
- WORK( K-1 ) = LEFT
- WORK( K ) = RIGHT
- 75 CONTINUE
-
-
- SAVI1 = I1
-*
-* Do while( NINT.GT.0 ), i.e. there are still unconverged intervals
-* and while (ITER.LT.MAXITR)
-*
- ITER = 0
- 80 CONTINUE
- PREV = I1 - 1
- I = I1
- OLNINT = NINT
-
- DO 100 P = 1, OLNINT
- K = 2*I
- II = I - OFFSET
- NEXT = IWORK( K-1 )
- LEFT = WORK( K-1 )
- RIGHT = WORK( K )
- MID = HALF*( LEFT + RIGHT )
-
-* semiwidth of interval
- WIDTH = RIGHT - MID
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
-
- IF( ( WIDTH.LT.RTOL*TMP ) .OR.
- $ (ITER.EQ.MAXITR) )THEN
-* reduce number of unconverged intervals
- NINT = NINT - 1
-* Mark interval as converged.
- IWORK( K-1 ) = 0
- IF( I1.EQ.I ) THEN
- I1 = NEXT
- ELSE
-* Prev holds the last unconverged interval previously examined
- IF(PREV.GE.I1) IWORK( 2*PREV-1 ) = NEXT
- END IF
- I = NEXT
- GO TO 100
- END IF
- PREV = I
-*
-* Perform one bisection step
-*
- CNT = 0
- S = MID
- DPLUS = D( 1 ) - S
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- DO 90 J = 2, N
- DPLUS = D( J ) - S - E2( J-1 )/DPLUS
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- 90 CONTINUE
- IF( CNT.LE.I-1 ) THEN
- WORK( K-1 ) = MID
- ELSE
- WORK( K ) = MID
- END IF
- I = NEXT
-
- 100 CONTINUE
- ITER = ITER + 1
-* do another loop if there are still unconverged intervals
-* However, in the last iteration, all intervals are accepted
-* since this is the best we can do.
- IF( ( NINT.GT.0 ).AND.(ITER.LE.MAXITR) ) GO TO 80
-*
-*
-* At this point, all the intervals have converged
- DO 110 I = SAVI1, ILAST
- K = 2*I
- II = I - OFFSET
-* All intervals marked by '0' have been refined.
- IF( IWORK( K-1 ).EQ.0 ) THEN
- W( II ) = HALF*( WORK( K-1 )+WORK( K ) )
- WERR( II ) = WORK( K ) - W( II )
- END IF
- 110 CONTINUE
-*
-
- RETURN
-*
-* End of DLARRJ
-*
- END
diff --git a/netlib/LAPACK/dlarrk.f b/netlib/LAPACK/dlarrk.f
deleted file mode 100644
index c649cc9..0000000
--- a/netlib/LAPACK/dlarrk.f
+++ /dev/null
@@ -1,249 +0,0 @@
-*> \brief \b DLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrk.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrk.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrk.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRK( N, IW, GL, GU,
-* D, E2, PIVMIN, RELTOL, W, WERR, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, IW, N
-* DOUBLE PRECISION PIVMIN, RELTOL, GL, GU, W, WERR
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARRK computes one eigenvalue of a symmetric tridiagonal
-*> matrix T to suitable accuracy. This is an auxiliary code to be
-*> called from DSTEMR.
-*>
-*> To avoid overflow, the matrix must be scaled so that its
-*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
-*> accuracy, it should not be much smaller than that.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] IW
-*> \verbatim
-*> IW is INTEGER
-*> The index of the eigenvalues to be returned.
-*> \endverbatim
-*>
-*> \param[in] GL
-*> \verbatim
-*> GL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] GU
-*> \verbatim
-*> GU is DOUBLE PRECISION
-*> An upper and a lower bound on the eigenvalue.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) squared off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot allowed in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[in] RELTOL
-*> \verbatim
-*> RELTOL is DOUBLE PRECISION
-*> The minimum relative width of an interval. When an interval
-*> is narrower than RELTOL times the larger (in
-*> magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. Note: this should
-*> always be at least radix*machine epsilon.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION
-*> The error bound on the corresponding eigenvalue approximation
-*> in W.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Eigenvalue converged
-*> = -1: Eigenvalue did NOT converge
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> FUDGE DOUBLE PRECISION, default = 2
-*> A "fudge factor" to widen the Gershgorin intervals.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARRK( N, IW, GL, GU,
- $ D, E2, PIVMIN, RELTOL, W, WERR, INFO)
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, IW, N
- DOUBLE PRECISION PIVMIN, RELTOL, GL, GU, W, WERR
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION FUDGE, HALF, TWO, ZERO
- PARAMETER ( HALF = 0.5D0, TWO = 2.0D0,
- $ FUDGE = TWO, ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IT, ITMAX, NEGCNT
- DOUBLE PRECISION ATOLI, EPS, LEFT, MID, RIGHT, RTOLI, TMP1,
- $ TMP2, TNORM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX
-* ..
-* .. Executable Statements ..
-*
-* Get machine constants
- EPS = DLAMCH( 'P' )
-
- TNORM = MAX( ABS( GL ), ABS( GU ) )
- RTOLI = RELTOL
- ATOLI = FUDGE*TWO*PIVMIN
-
- ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
-
- INFO = -1
-
- LEFT = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN
- RIGHT = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN
- IT = 0
-
- 10 CONTINUE
-*
-* Check if interval converged or maximum number of iterations reached
-*
- TMP1 = ABS( RIGHT - LEFT )
- TMP2 = MAX( ABS(RIGHT), ABS(LEFT) )
- IF( TMP1.LT.MAX( ATOLI, PIVMIN, RTOLI*TMP2 ) ) THEN
- INFO = 0
- GOTO 30
- ENDIF
- IF(IT.GT.ITMAX)
- $ GOTO 30
-
-*
-* Count number of negative pivots for mid-point
-*
- IT = IT + 1
- MID = HALF * (LEFT + RIGHT)
- NEGCNT = 0
- TMP1 = D( 1 ) - MID
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- IF( TMP1.LE.ZERO )
- $ NEGCNT = NEGCNT + 1
-*
- DO 20 I = 2, N
- TMP1 = D( I ) - E2( I-1 ) / TMP1 - MID
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- IF( TMP1.LE.ZERO )
- $ NEGCNT = NEGCNT + 1
- 20 CONTINUE
-
- IF(NEGCNT.GE.IW) THEN
- RIGHT = MID
- ELSE
- LEFT = MID
- ENDIF
- GOTO 10
-
- 30 CONTINUE
-*
-* Converged or maximum number of iterations reached
-*
- W = HALF * (LEFT + RIGHT)
- WERR = HALF * ABS( RIGHT - LEFT )
-
- RETURN
-*
-* End of DLARRK
-*
- END
diff --git a/netlib/LAPACK/dlarrr.f b/netlib/LAPACK/dlarrr.f
deleted file mode 100644
index add58e6..0000000
--- a/netlib/LAPACK/dlarrr.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRR( N, D, E, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER N, INFO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Perform tests to decide whether the symmetric tridiagonal matrix T
-*> warrants expensive computations which guarantee high relative accuracy
-*> in the eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The N diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, the first (N-1) entries contain the subdiagonal
-*> elements of the tridiagonal matrix T; E(N) is set to ZERO.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> INFO = 0(default) : the matrix warrants computations preserving
-*> relative accuracy.
-*> INFO = 1 : the matrix warrants computations guaranteeing
-*> only absolute accuracy.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRR( N, D, E, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, INFO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, RELCOND
- PARAMETER ( ZERO = 0.0D0,
- $ RELCOND = 0.999D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- LOGICAL YESREL
- DOUBLE PRECISION EPS, SAFMIN, SMLNUM, RMIN, TMP, TMP2,
- $ OFFDIG, OFFDIG2
-
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* As a default, do NOT go for relative-accuracy preserving computations.
- INFO = 1
-
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- RMIN = SQRT( SMLNUM )
-
-* Tests for relative accuracy
-*
-* Test for scaled diagonal dominance
-* Scale the diagonal entries to one and check whether the sum of the
-* off-diagonals is less than one
-*
-* The sdd relative error bounds have a 1/(1- 2*x) factor in them,
-* x = max(OFFDIG + OFFDIG2), so when x is close to 1/2, no relative
-* accuracy is promised. In the notation of the code fragment below,
-* 1/(1 - (OFFDIG + OFFDIG2)) is the condition number.
-* We don't think it is worth going into "sdd mode" unless the relative
-* condition number is reasonable, not 1/macheps.
-* The threshold should be compatible with other thresholds used in the
-* code. We set OFFDIG + OFFDIG2 <= .999 =: RELCOND, it corresponds
-* to losing at most 3 decimal digits: 1 / (1 - (OFFDIG + OFFDIG2)) <= 1000
-* instead of the current OFFDIG + OFFDIG2 < 1
-*
- YESREL = .TRUE.
- OFFDIG = ZERO
- TMP = SQRT(ABS(D(1)))
- IF (TMP.LT.RMIN) YESREL = .FALSE.
- IF(.NOT.YESREL) GOTO 11
- DO 10 I = 2, N
- TMP2 = SQRT(ABS(D(I)))
- IF (TMP2.LT.RMIN) YESREL = .FALSE.
- IF(.NOT.YESREL) GOTO 11
- OFFDIG2 = ABS(E(I-1))/(TMP*TMP2)
- IF(OFFDIG+OFFDIG2.GE.RELCOND) YESREL = .FALSE.
- IF(.NOT.YESREL) GOTO 11
- TMP = TMP2
- OFFDIG = OFFDIG2
- 10 CONTINUE
- 11 CONTINUE
-
- IF( YESREL ) THEN
- INFO = 0
- RETURN
- ELSE
- ENDIF
-*
-
-*
-* *** MORE TO BE IMPLEMENTED ***
-*
-
-*
-* Test if the lower bidiagonal matrix L from T = L D L^T
-* (zero shift facto) is well conditioned
-*
-
-*
-* Test if the upper bidiagonal matrix U from T = U D U^T
-* (zero shift facto) is well conditioned.
-* In this case, the matrix needs to be flipped and, at the end
-* of the eigenvector computation, the flip needs to be applied
-* to the computed eigenvectors (and the support)
-*
-
-*
- RETURN
-*
-* END OF DLARRR
-*
- END
diff --git a/netlib/LAPACK/dlarrv.f b/netlib/LAPACK/dlarrv.f
deleted file mode 100644
index 729561f..0000000
--- a/netlib/LAPACK/dlarrv.f
+++ /dev/null
@@ -1,1028 +0,0 @@
-*> \brief \b DLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARRV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARRV( N, VL, VU, D, L, PIVMIN,
-* ISPLIT, M, DOL, DOU, MINRGP,
-* RTOL1, RTOL2, W, WERR, WGAP,
-* IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER DOL, DOU, INFO, LDZ, M, N
-* DOUBLE PRECISION MINRGP, PIVMIN, RTOL1, RTOL2, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), INDEXW( * ), ISPLIT( * ),
-* $ ISUPPZ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), GERS( * ), L( * ), W( * ), WERR( * ),
-* $ WGAP( * ), WORK( * )
-* DOUBLE PRECISION Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARRV computes the eigenvectors of the tridiagonal matrix
-*> T = L D L**T given L, D and APPROXIMATIONS to the eigenvalues of L D L**T.
-*> The input eigenvalues should have been computed by DLARRE.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> Lower and upper bounds of the interval that contains the desired
-*> eigenvalues. VL < VU. Needed to compute gaps on the left or right
-*> end of the extremal eigenvalues in the desired RANGE.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the N diagonal elements of the diagonal matrix D.
-*> On exit, D may be overwritten.
-*> \endverbatim
-*>
-*> \param[in,out] L
-*> \verbatim
-*> L is DOUBLE PRECISION array, dimension (N)
-*> On entry, the (N-1) subdiagonal elements of the unit
-*> bidiagonal matrix L are in elements 1 to N-1 of L
-*> (if the matrix is not splitted.) At the end of each block
-*> is stored the corresponding shift as given by DLARRE.
-*> On exit, L is overwritten.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is DOUBLE PRECISION
-*> The minimum pivot allowed in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[in] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into blocks.
-*> The first block consists of rows/columns 1 to
-*> ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
-*> through ISPLIT( 2 ), etc.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of input eigenvalues. 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[in] DOL
-*> \verbatim
-*> DOL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] DOU
-*> \verbatim
-*> DOU is INTEGER
-*> If the user wants to compute only selected eigenvectors from all
-*> the eigenvalues supplied, he can specify an index range DOL:DOU.
-*> Or else the setting DOL=1, DOU=M should be applied.
-*> Note that DOL and DOU refer to the order in which the eigenvalues
-*> are stored in W.
-*> If the user wants to compute only selected eigenpairs, then
-*> the columns DOL-1 to DOU+1 of the eigenvector space Z contain the
-*> computed eigenvectors. All other columns of Z are set to zero.
-*> \endverbatim
-*>
-*> \param[in] MINRGP
-*> \verbatim
-*> MINRGP is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] RTOL1
-*> \verbatim
-*> RTOL1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] RTOL2
-*> \verbatim
-*> RTOL2 is DOUBLE PRECISION
-*> Parameters for bisection.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements of W contain the APPROXIMATE eigenvalues for
-*> which eigenvectors are to be computed. The eigenvalues
-*> should be grouped by split-off block and ordered from
-*> smallest to largest within the block ( The output array
-*> W from DLARRE is expected here ). Furthermore, they are with
-*> respect to the shift of the corresponding root representation
-*> for their block. On exit, W holds the eigenvalues of the
-*> UNshifted matrix.
-*> \endverbatim
-*>
-*> \param[in,out] WERR
-*> \verbatim
-*> WERR is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the semiwidth of the uncertainty
-*> interval of the corresponding eigenvalue in W
-*> \endverbatim
-*>
-*> \param[in,out] WGAP
-*> \verbatim
-*> WGAP is DOUBLE PRECISION array, dimension (N)
-*> The separation from the right neighbor eigenvalue in W.
-*> \endverbatim
-*>
-*> \param[in] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> The indices of the blocks (submatrices) associated with the
-*> corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
-*> W(i) belongs to the first block from the top, =2 if W(i)
-*> belongs to the second block, etc.
-*> \endverbatim
-*>
-*> \param[in] INDEXW
-*> \verbatim
-*> INDEXW is INTEGER array, dimension (N)
-*> The indices of the eigenvalues within each block (submatrix);
-*> for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
-*> i-th eigenvalue W(i) is the 10-th eigenvalue in the second block.
-*> \endverbatim
-*>
-*> \param[in] GERS
-*> \verbatim
-*> GERS is DOUBLE PRECISION array, dimension (2*N)
-*> The N Gerschgorin intervals (the i-th Gerschgorin interval
-*> is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should
-*> be computed from the original UNshifted matrix.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
-*> If INFO = 0, the first M columns of Z contain the
-*> orthonormal eigenvectors of the matrix T
-*> corresponding to the input eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The I-th eigenvector
-*> is nonzero only in elements ISUPPZ( 2*I-1 ) through
-*> ISUPPZ( 2*I ).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (12*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (7*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*>
-*> > 0: A problem occured in DLARRV.
-*> < 0: One of the called subroutines signaled an internal problem.
-*> Needs inspection of the corresponding parameter IINFO
-*> for further information.
-*>
-*> =-1: Problem in DLARRB when refining a child's eigenvalues.
-*> =-2: Problem in DLARRF when computing the RRR of a child.
-*> When a child is inside a tight cluster, it can be difficult
-*> to find an RRR. A partial remedy from the user's point of
-*> view is to make the parameter MINRGP smaller and recompile.
-*> However, as the orthogonality of the computed vectors is
-*> proportional to 1/MINRGP, the user should be aware that
-*> he might be trading in precision when he decreases MINRGP.
-*> =-3: Problem in DLARRB when refining a single eigenvalue
-*> after the Rayleigh correction was rejected.
-*> = 5: The Rayleigh Quotient Iteration failed to converge to
-*> full accuracy in MAXITR steps.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DLARRV( N, VL, VU, D, L, PIVMIN,
- $ ISPLIT, M, DOL, DOU, MINRGP,
- $ RTOL1, RTOL2, W, WERR, WGAP,
- $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER DOL, DOU, INFO, LDZ, M, N
- DOUBLE PRECISION MINRGP, PIVMIN, RTOL1, RTOL2, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), INDEXW( * ), ISPLIT( * ),
- $ ISUPPZ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), GERS( * ), L( * ), W( * ), WERR( * ),
- $ WGAP( * ), WORK( * )
- DOUBLE PRECISION Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXITR
- PARAMETER ( MAXITR = 10 )
- DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR, HALF
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, THREE = 3.0D0,
- $ FOUR = 4.0D0, HALF = 0.5D0)
-* ..
-* .. Local Scalars ..
- LOGICAL ESKIP, NEEDBS, STP2II, TRYRQC, USEDBS, USEDRQ
- INTEGER DONE, I, IBEGIN, IDONE, IEND, II, IINDC1,
- $ IINDC2, IINDR, IINDWK, IINFO, IM, IN, INDEIG,
- $ INDLD, INDLLD, INDWRK, ISUPMN, ISUPMX, ITER,
- $ ITMP1, J, JBLK, K, MINIWSIZE, MINWSIZE, NCLUS,
- $ NDEPTH, NEGCNT, NEWCLS, NEWFST, NEWFTT, NEWLST,
- $ NEWSIZ, OFFSET, OLDCLS, OLDFST, OLDIEN, OLDLST,
- $ OLDNCL, P, PARITY, Q, WBEGIN, WEND, WINDEX,
- $ WINDMN, WINDPL, ZFROM, ZTO, ZUSEDL, ZUSEDU,
- $ ZUSEDW
- DOUBLE PRECISION BSTRES, BSTW, EPS, FUDGE, GAP, GAPTOL, GL, GU,
- $ LAMBDA, LEFT, LGAP, MINGMA, NRMINV, RESID,
- $ RGAP, RIGHT, RQCORR, RQTOL, SAVGAP, SGNDEF,
- $ SIGMA, SPDIAM, SSIGMA, TAU, TMP, TOL, ZTZ
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAR1V, DLARRB, DLARRF, DLASET,
- $ DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN
-* ..
-* .. Executable Statements ..
-* ..
-
-* The first N entries of WORK are reserved for the eigenvalues
- INDLD = N+1
- INDLLD= 2*N+1
- INDWRK= 3*N+1
- MINWSIZE = 12 * N
-
- DO 5 I= 1,MINWSIZE
- WORK( I ) = ZERO
- 5 CONTINUE
-
-* IWORK(IINDR+1:IINDR+N) hold the twist indices R for the
-* factorization used to compute the FP vector
- IINDR = 0
-* IWORK(IINDC1+1:IINC2+N) are used to store the clusters of the current
-* layer and the one above.
- IINDC1 = N
- IINDC2 = 2*N
- IINDWK = 3*N + 1
-
- MINIWSIZE = 7 * N
- DO 10 I= 1,MINIWSIZE
- IWORK( I ) = 0
- 10 CONTINUE
-
- ZUSEDL = 1
- IF(DOL.GT.1) THEN
-* Set lower bound for use of Z
- ZUSEDL = DOL-1
- ENDIF
- ZUSEDU = M
- IF(DOU.LT.M) THEN
-* Set lower bound for use of Z
- ZUSEDU = DOU+1
- ENDIF
-* The width of the part of Z that is used
- ZUSEDW = ZUSEDU - ZUSEDL + 1
-
-
- CALL DLASET( 'Full', N, ZUSEDW, ZERO, ZERO,
- $ Z(1,ZUSEDL), LDZ )
-
- EPS = DLAMCH( 'Precision' )
- RQTOL = TWO * EPS
-*
-* Set expert flags for standard code.
- TRYRQC = .TRUE.
-
- IF((DOL.EQ.1).AND.(DOU.EQ.M)) THEN
- ELSE
-* Only selected eigenpairs are computed. Since the other evalues
-* are not refined by RQ iteration, bisection has to compute to full
-* accuracy.
- RTOL1 = FOUR * EPS
- RTOL2 = FOUR * EPS
- ENDIF
-
-* The entries WBEGIN:WEND in W, WERR, WGAP correspond to the
-* desired eigenvalues. The support of the nonzero eigenvector
-* entries is contained in the interval IBEGIN:IEND.
-* Remark that if k eigenpairs are desired, then the eigenvectors
-* are stored in k contiguous columns of Z.
-
-* DONE is the number of eigenvectors already computed
- DONE = 0
- IBEGIN = 1
- WBEGIN = 1
- DO 170 JBLK = 1, IBLOCK( M )
- IEND = ISPLIT( JBLK )
- SIGMA = L( IEND )
-* Find the eigenvectors of the submatrix indexed IBEGIN
-* through IEND.
- WEND = WBEGIN - 1
- 15 CONTINUE
- IF( WEND.LT.M ) THEN
- IF( IBLOCK( WEND+1 ).EQ.JBLK ) THEN
- WEND = WEND + 1
- GO TO 15
- END IF
- END IF
- IF( WEND.LT.WBEGIN ) THEN
- IBEGIN = IEND + 1
- GO TO 170
- ELSEIF( (WEND.LT.DOL).OR.(WBEGIN.GT.DOU) ) THEN
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- GO TO 170
- END IF
-
-* Find local spectral diameter of the block
- GL = GERS( 2*IBEGIN-1 )
- GU = GERS( 2*IBEGIN )
- DO 20 I = IBEGIN+1 , IEND
- GL = MIN( GERS( 2*I-1 ), GL )
- GU = MAX( GERS( 2*I ), GU )
- 20 CONTINUE
- SPDIAM = GU - GL
-
-* OLDIEN is the last index of the previous block
- OLDIEN = IBEGIN - 1
-* Calculate the size of the current block
- IN = IEND - IBEGIN + 1
-* The number of eigenvalues in the current block
- IM = WEND - WBEGIN + 1
-
-* This is for a 1x1 block
- IF( IBEGIN.EQ.IEND ) THEN
- DONE = DONE+1
- Z( IBEGIN, WBEGIN ) = ONE
- ISUPPZ( 2*WBEGIN-1 ) = IBEGIN
- ISUPPZ( 2*WBEGIN ) = IBEGIN
- W( WBEGIN ) = W( WBEGIN ) + SIGMA
- WORK( WBEGIN ) = W( WBEGIN )
- IBEGIN = IEND + 1
- WBEGIN = WBEGIN + 1
- GO TO 170
- END IF
-
-* The desired (shifted) eigenvalues are stored in W(WBEGIN:WEND)
-* Note that these can be approximations, in this case, the corresp.
-* entries of WERR give the size of the uncertainty interval.
-* The eigenvalue approximations will be refined when necessary as
-* high relative accuracy is required for the computation of the
-* corresponding eigenvectors.
- CALL DCOPY( IM, W( WBEGIN ), 1,
- $ WORK( WBEGIN ), 1 )
-
-* We store in W the eigenvalue approximations w.r.t. the original
-* matrix T.
- DO 30 I=1,IM
- W(WBEGIN+I-1) = W(WBEGIN+I-1)+SIGMA
- 30 CONTINUE
-
-
-* NDEPTH is the current depth of the representation tree
- NDEPTH = 0
-* PARITY is either 1 or 0
- PARITY = 1
-* NCLUS is the number of clusters for the next level of the
-* representation tree, we start with NCLUS = 1 for the root
- NCLUS = 1
- IWORK( IINDC1+1 ) = 1
- IWORK( IINDC1+2 ) = IM
-
-* IDONE is the number of eigenvectors already computed in the current
-* block
- IDONE = 0
-* loop while( IDONE.LT.IM )
-* generate the representation tree for the current block and
-* compute the eigenvectors
- 40 CONTINUE
- IF( IDONE.LT.IM ) THEN
-* This is a crude protection against infinitely deep trees
- IF( NDEPTH.GT.M ) THEN
- INFO = -2
- RETURN
- ENDIF
-* breadth first processing of the current level of the representation
-* tree: OLDNCL = number of clusters on current level
- OLDNCL = NCLUS
-* reset NCLUS to count the number of child clusters
- NCLUS = 0
-*
- PARITY = 1 - PARITY
- IF( PARITY.EQ.0 ) THEN
- OLDCLS = IINDC1
- NEWCLS = IINDC2
- ELSE
- OLDCLS = IINDC2
- NEWCLS = IINDC1
- END IF
-* Process the clusters on the current level
- DO 150 I = 1, OLDNCL
- J = OLDCLS + 2*I
-* OLDFST, OLDLST = first, last index of current cluster.
-* cluster indices start with 1 and are relative
-* to WBEGIN when accessing W, WGAP, WERR, Z
- OLDFST = IWORK( J-1 )
- OLDLST = IWORK( J )
- IF( NDEPTH.GT.0 ) THEN
-* Retrieve relatively robust representation (RRR) of cluster
-* that has been computed at the previous level
-* The RRR is stored in Z and overwritten once the eigenvectors
-* have been computed or when the cluster is refined
-
- IF((DOL.EQ.1).AND.(DOU.EQ.M)) THEN
-* Get representation from location of the leftmost evalue
-* of the cluster
- J = WBEGIN + OLDFST - 1
- ELSE
- IF(WBEGIN+OLDFST-1.LT.DOL) THEN
-* Get representation from the left end of Z array
- J = DOL - 1
- ELSEIF(WBEGIN+OLDFST-1.GT.DOU) THEN
-* Get representation from the right end of Z array
- J = DOU
- ELSE
- J = WBEGIN + OLDFST - 1
- ENDIF
- ENDIF
- CALL DCOPY( IN, Z( IBEGIN, J ), 1, D( IBEGIN ), 1 )
- CALL DCOPY( IN-1, Z( IBEGIN, J+1 ), 1, L( IBEGIN ),
- $ 1 )
- SIGMA = Z( IEND, J+1 )
-
-* Set the corresponding entries in Z to zero
- CALL DLASET( 'Full', IN, 2, ZERO, ZERO,
- $ Z( IBEGIN, J), LDZ )
- END IF
-
-* Compute DL and DLL of current RRR
- DO 50 J = IBEGIN, IEND-1
- TMP = D( J )*L( J )
- WORK( INDLD-1+J ) = TMP
- WORK( INDLLD-1+J ) = TMP*L( J )
- 50 CONTINUE
-
- IF( NDEPTH.GT.0 ) THEN
-* P and Q are index of the first and last eigenvalue to compute
-* within the current block
- P = INDEXW( WBEGIN-1+OLDFST )
- Q = INDEXW( WBEGIN-1+OLDLST )
-* Offset for the arrays WORK, WGAP and WERR, i.e., the P-OFFSET
-* through the Q-OFFSET elements of these arrays are to be used.
-* OFFSET = P-OLDFST
- OFFSET = INDEXW( WBEGIN ) - 1
-* perform limited bisection (if necessary) to get approximate
-* eigenvalues to the precision needed.
- CALL DLARRB( IN, D( IBEGIN ),
- $ WORK(INDLLD+IBEGIN-1),
- $ P, Q, RTOL1, RTOL2, OFFSET,
- $ WORK(WBEGIN),WGAP(WBEGIN),WERR(WBEGIN),
- $ WORK( INDWRK ), IWORK( IINDWK ),
- $ PIVMIN, SPDIAM, IN, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
-* We also recompute the extremal gaps. W holds all eigenvalues
-* of the unshifted matrix and must be used for computation
-* of WGAP, the entries of WORK might stem from RRRs with
-* different shifts. The gaps from WBEGIN-1+OLDFST to
-* WBEGIN-1+OLDLST are correctly computed in DLARRB.
-* However, we only allow the gaps to become greater since
-* this is what should happen when we decrease WERR
- IF( OLDFST.GT.1) THEN
- WGAP( WBEGIN+OLDFST-2 ) =
- $ MAX(WGAP(WBEGIN+OLDFST-2),
- $ W(WBEGIN+OLDFST-1)-WERR(WBEGIN+OLDFST-1)
- $ - W(WBEGIN+OLDFST-2)-WERR(WBEGIN+OLDFST-2) )
- ENDIF
- IF( WBEGIN + OLDLST -1 .LT. WEND ) THEN
- WGAP( WBEGIN+OLDLST-1 ) =
- $ MAX(WGAP(WBEGIN+OLDLST-1),
- $ W(WBEGIN+OLDLST)-WERR(WBEGIN+OLDLST)
- $ - W(WBEGIN+OLDLST-1)-WERR(WBEGIN+OLDLST-1) )
- ENDIF
-* Each time the eigenvalues in WORK get refined, we store
-* the newly found approximation with all shifts applied in W
- DO 53 J=OLDFST,OLDLST
- W(WBEGIN+J-1) = WORK(WBEGIN+J-1)+SIGMA
- 53 CONTINUE
- END IF
-
-* Process the current node.
- NEWFST = OLDFST
- DO 140 J = OLDFST, OLDLST
- IF( J.EQ.OLDLST ) THEN
-* we are at the right end of the cluster, this is also the
-* boundary of the child cluster
- NEWLST = J
- ELSE IF ( WGAP( WBEGIN + J -1).GE.
- $ MINRGP* ABS( WORK(WBEGIN + J -1) ) ) THEN
-* the right relative gap is big enough, the child cluster
-* (NEWFST,..,NEWLST) is well separated from the following
- NEWLST = J
- ELSE
-* inside a child cluster, the relative gap is not
-* big enough.
- GOTO 140
- END IF
-
-* Compute size of child cluster found
- NEWSIZ = NEWLST - NEWFST + 1
-
-* NEWFTT is the place in Z where the new RRR or the computed
-* eigenvector is to be stored
- IF((DOL.EQ.1).AND.(DOU.EQ.M)) THEN
-* Store representation at location of the leftmost evalue
-* of the cluster
- NEWFTT = WBEGIN + NEWFST - 1
- ELSE
- IF(WBEGIN+NEWFST-1.LT.DOL) THEN
-* Store representation at the left end of Z array
- NEWFTT = DOL - 1
- ELSEIF(WBEGIN+NEWFST-1.GT.DOU) THEN
-* Store representation at the right end of Z array
- NEWFTT = DOU
- ELSE
- NEWFTT = WBEGIN + NEWFST - 1
- ENDIF
- ENDIF
-
- IF( NEWSIZ.GT.1) THEN
-*
-* Current child is not a singleton but a cluster.
-* Compute and store new representation of child.
-*
-*
-* Compute left and right cluster gap.
-*
-* LGAP and RGAP are not computed from WORK because
-* the eigenvalue approximations may stem from RRRs
-* different shifts. However, W hold all eigenvalues
-* of the unshifted matrix. Still, the entries in WGAP
-* have to be computed from WORK since the entries
-* in W might be of the same order so that gaps are not
-* exhibited correctly for very close eigenvalues.
- IF( NEWFST.EQ.1 ) THEN
- LGAP = MAX( ZERO,
- $ W(WBEGIN)-WERR(WBEGIN) - VL )
- ELSE
- LGAP = WGAP( WBEGIN+NEWFST-2 )
- ENDIF
- RGAP = WGAP( WBEGIN+NEWLST-1 )
-*
-* Compute left- and rightmost eigenvalue of child
-* to high precision in order to shift as close
-* as possible and obtain as large relative gaps
-* as possible
-*
- DO 55 K =1,2
- IF(K.EQ.1) THEN
- P = INDEXW( WBEGIN-1+NEWFST )
- ELSE
- P = INDEXW( WBEGIN-1+NEWLST )
- ENDIF
- OFFSET = INDEXW( WBEGIN ) - 1
- CALL DLARRB( IN, D(IBEGIN),
- $ WORK( INDLLD+IBEGIN-1 ),P,P,
- $ RQTOL, RQTOL, OFFSET,
- $ WORK(WBEGIN),WGAP(WBEGIN),
- $ WERR(WBEGIN),WORK( INDWRK ),
- $ IWORK( IINDWK ), PIVMIN, SPDIAM,
- $ IN, IINFO )
- 55 CONTINUE
-*
- IF((WBEGIN+NEWLST-1.LT.DOL).OR.
- $ (WBEGIN+NEWFST-1.GT.DOU)) THEN
-* if the cluster contains no desired eigenvalues
-* skip the computation of that branch of the rep. tree
-*
-* We could skip before the refinement of the extremal
-* eigenvalues of the child, but then the representation
-* tree could be different from the one when nothing is
-* skipped. For this reason we skip at this place.
- IDONE = IDONE + NEWLST - NEWFST + 1
- GOTO 139
- ENDIF
-*
-* Compute RRR of child cluster.
-* Note that the new RRR is stored in Z
-*
-* DLARRF needs LWORK = 2*N
- CALL DLARRF( IN, D( IBEGIN ), L( IBEGIN ),
- $ WORK(INDLD+IBEGIN-1),
- $ NEWFST, NEWLST, WORK(WBEGIN),
- $ WGAP(WBEGIN), WERR(WBEGIN),
- $ SPDIAM, LGAP, RGAP, PIVMIN, TAU,
- $ Z(IBEGIN, NEWFTT),Z(IBEGIN, NEWFTT+1),
- $ WORK( INDWRK ), IINFO )
- IF( IINFO.EQ.0 ) THEN
-* a new RRR for the cluster was found by DLARRF
-* update shift and store it
- SSIGMA = SIGMA + TAU
- Z( IEND, NEWFTT+1 ) = SSIGMA
-* WORK() are the midpoints and WERR() the semi-width
-* Note that the entries in W are unchanged.
- DO 116 K = NEWFST, NEWLST
- FUDGE =
- $ THREE*EPS*ABS(WORK(WBEGIN+K-1))
- WORK( WBEGIN + K - 1 ) =
- $ WORK( WBEGIN + K - 1) - TAU
- FUDGE = FUDGE +
- $ FOUR*EPS*ABS(WORK(WBEGIN+K-1))
-* Fudge errors
- WERR( WBEGIN + K - 1 ) =
- $ WERR( WBEGIN + K - 1 ) + FUDGE
-* Gaps are not fudged. Provided that WERR is small
-* when eigenvalues are close, a zero gap indicates
-* that a new representation is needed for resolving
-* the cluster. A fudge could lead to a wrong decision
-* of judging eigenvalues 'separated' which in
-* reality are not. This could have a negative impact
-* on the orthogonality of the computed eigenvectors.
- 116 CONTINUE
-
- NCLUS = NCLUS + 1
- K = NEWCLS + 2*NCLUS
- IWORK( K-1 ) = NEWFST
- IWORK( K ) = NEWLST
- ELSE
- INFO = -2
- RETURN
- ENDIF
- ELSE
-*
-* Compute eigenvector of singleton
-*
- ITER = 0
-*
- TOL = FOUR * LOG(DBLE(IN)) * EPS
-*
- K = NEWFST
- WINDEX = WBEGIN + K - 1
- WINDMN = MAX(WINDEX - 1,1)
- WINDPL = MIN(WINDEX + 1,M)
- LAMBDA = WORK( WINDEX )
- DONE = DONE + 1
-* Check if eigenvector computation is to be skipped
- IF((WINDEX.LT.DOL).OR.
- $ (WINDEX.GT.DOU)) THEN
- ESKIP = .TRUE.
- GOTO 125
- ELSE
- ESKIP = .FALSE.
- ENDIF
- LEFT = WORK( WINDEX ) - WERR( WINDEX )
- RIGHT = WORK( WINDEX ) + WERR( WINDEX )
- INDEIG = INDEXW( WINDEX )
-* Note that since we compute the eigenpairs for a child,
-* all eigenvalue approximations are w.r.t the same shift.
-* In this case, the entries in WORK should be used for
-* computing the gaps since they exhibit even very small
-* differences in the eigenvalues, as opposed to the
-* entries in W which might "look" the same.
-
- IF( K .EQ. 1) THEN
-* In the case RANGE='I' and with not much initial
-* accuracy in LAMBDA and VL, the formula
-* LGAP = MAX( ZERO, (SIGMA - VL) + LAMBDA )
-* can lead to an overestimation of the left gap and
-* thus to inadequately early RQI 'convergence'.
-* Prevent this by forcing a small left gap.
- LGAP = EPS*MAX(ABS(LEFT),ABS(RIGHT))
- ELSE
- LGAP = WGAP(WINDMN)
- ENDIF
- IF( K .EQ. IM) THEN
-* In the case RANGE='I' and with not much initial
-* accuracy in LAMBDA and VU, the formula
-* can lead to an overestimation of the right gap and
-* thus to inadequately early RQI 'convergence'.
-* Prevent this by forcing a small right gap.
- RGAP = EPS*MAX(ABS(LEFT),ABS(RIGHT))
- ELSE
- RGAP = WGAP(WINDEX)
- ENDIF
- GAP = MIN( LGAP, RGAP )
- IF(( K .EQ. 1).OR.(K .EQ. IM)) THEN
-* The eigenvector support can become wrong
-* because significant entries could be cut off due to a
-* large GAPTOL parameter in LAR1V. Prevent this.
- GAPTOL = ZERO
- ELSE
- GAPTOL = GAP * EPS
- ENDIF
- ISUPMN = IN
- ISUPMX = 1
-* Update WGAP so that it holds the minimum gap
-* to the left or the right. This is crucial in the
-* case where bisection is used to ensure that the
-* eigenvalue is refined up to the required precision.
-* The correct value is restored afterwards.
- SAVGAP = WGAP(WINDEX)
- WGAP(WINDEX) = GAP
-* We want to use the Rayleigh Quotient Correction
-* as often as possible since it converges quadratically
-* when we are close enough to the desired eigenvalue.
-* However, the Rayleigh Quotient can have the wrong sign
-* and lead us away from the desired eigenvalue. In this
-* case, the best we can do is to use bisection.
- USEDBS = .FALSE.
- USEDRQ = .FALSE.
-* Bisection is initially turned off unless it is forced
- NEEDBS = .NOT.TRYRQC
- 120 CONTINUE
-* Check if bisection should be used to refine eigenvalue
- IF(NEEDBS) THEN
-* Take the bisection as new iterate
- USEDBS = .TRUE.
- ITMP1 = IWORK( IINDR+WINDEX )
- OFFSET = INDEXW( WBEGIN ) - 1
- CALL DLARRB( IN, D(IBEGIN),
- $ WORK(INDLLD+IBEGIN-1),INDEIG,INDEIG,
- $ ZERO, TWO*EPS, OFFSET,
- $ WORK(WBEGIN),WGAP(WBEGIN),
- $ WERR(WBEGIN),WORK( INDWRK ),
- $ IWORK( IINDWK ), PIVMIN, SPDIAM,
- $ ITMP1, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -3
- RETURN
- ENDIF
- LAMBDA = WORK( WINDEX )
-* Reset twist index from inaccurate LAMBDA to
-* force computation of true MINGMA
- IWORK( IINDR+WINDEX ) = 0
- ENDIF
-* Given LAMBDA, compute the eigenvector.
- CALL DLAR1V( IN, 1, IN, LAMBDA, D( IBEGIN ),
- $ L( IBEGIN ), WORK(INDLD+IBEGIN-1),
- $ WORK(INDLLD+IBEGIN-1),
- $ PIVMIN, GAPTOL, Z( IBEGIN, WINDEX ),
- $ .NOT.USEDBS, NEGCNT, ZTZ, MINGMA,
- $ IWORK( IINDR+WINDEX ), ISUPPZ( 2*WINDEX-1 ),
- $ NRMINV, RESID, RQCORR, WORK( INDWRK ) )
- IF(ITER .EQ. 0) THEN
- BSTRES = RESID
- BSTW = LAMBDA
- ELSEIF(RESID.LT.BSTRES) THEN
- BSTRES = RESID
- BSTW = LAMBDA
- ENDIF
- ISUPMN = MIN(ISUPMN,ISUPPZ( 2*WINDEX-1 ))
- ISUPMX = MAX(ISUPMX,ISUPPZ( 2*WINDEX ))
- ITER = ITER + 1
-
-* sin alpha <= |resid|/gap
-* Note that both the residual and the gap are
-* proportional to the matrix, so ||T|| doesn't play
-* a role in the quotient
-
-*
-* Convergence test for Rayleigh-Quotient iteration
-* (omitted when Bisection has been used)
-*
- IF( RESID.GT.TOL*GAP .AND. ABS( RQCORR ).GT.
- $ RQTOL*ABS( LAMBDA ) .AND. .NOT. USEDBS)
- $ THEN
-* We need to check that the RQCORR update doesn't
-* move the eigenvalue away from the desired one and
-* towards a neighbor. -> protection with bisection
- IF(INDEIG.LE.NEGCNT) THEN
-* The wanted eigenvalue lies to the left
- SGNDEF = -ONE
- ELSE
-* The wanted eigenvalue lies to the right
- SGNDEF = ONE
- ENDIF
-* We only use the RQCORR if it improves the
-* the iterate reasonably.
- IF( ( RQCORR*SGNDEF.GE.ZERO )
- $ .AND.( LAMBDA + RQCORR.LE. RIGHT)
- $ .AND.( LAMBDA + RQCORR.GE. LEFT)
- $ ) THEN
- USEDRQ = .TRUE.
-* Store new midpoint of bisection interval in WORK
- IF(SGNDEF.EQ.ONE) THEN
-* The current LAMBDA is on the left of the true
-* eigenvalue
- LEFT = LAMBDA
-* We prefer to assume that the error estimate
-* is correct. We could make the interval not
-* as a bracket but to be modified if the RQCORR
-* chooses to. In this case, the RIGHT side should
-* be modified as follows:
-* RIGHT = MAX(RIGHT, LAMBDA + RQCORR)
- ELSE
-* The current LAMBDA is on the right of the true
-* eigenvalue
- RIGHT = LAMBDA
-* See comment about assuming the error estimate is
-* correct above.
-* LEFT = MIN(LEFT, LAMBDA + RQCORR)
- ENDIF
- WORK( WINDEX ) =
- $ HALF * (RIGHT + LEFT)
-* Take RQCORR since it has the correct sign and
-* improves the iterate reasonably
- LAMBDA = LAMBDA + RQCORR
-* Update width of error interval
- WERR( WINDEX ) =
- $ HALF * (RIGHT-LEFT)
- ELSE
- NEEDBS = .TRUE.
- ENDIF
- IF(RIGHT-LEFT.LT.RQTOL*ABS(LAMBDA)) THEN
-* The eigenvalue is computed to bisection accuracy
-* compute eigenvector and stop
- USEDBS = .TRUE.
- GOTO 120
- ELSEIF( ITER.LT.MAXITR ) THEN
- GOTO 120
- ELSEIF( ITER.EQ.MAXITR ) THEN
- NEEDBS = .TRUE.
- GOTO 120
- ELSE
- INFO = 5
- RETURN
- END IF
- ELSE
- STP2II = .FALSE.
- IF(USEDRQ .AND. USEDBS .AND.
- $ BSTRES.LE.RESID) THEN
- LAMBDA = BSTW
- STP2II = .TRUE.
- ENDIF
- IF (STP2II) THEN
-* improve error angle by second step
- CALL DLAR1V( IN, 1, IN, LAMBDA,
- $ D( IBEGIN ), L( IBEGIN ),
- $ WORK(INDLD+IBEGIN-1),
- $ WORK(INDLLD+IBEGIN-1),
- $ PIVMIN, GAPTOL, Z( IBEGIN, WINDEX ),
- $ .NOT.USEDBS, NEGCNT, ZTZ, MINGMA,
- $ IWORK( IINDR+WINDEX ),
- $ ISUPPZ( 2*WINDEX-1 ),
- $ NRMINV, RESID, RQCORR, WORK( INDWRK ) )
- ENDIF
- WORK( WINDEX ) = LAMBDA
- END IF
-*
-* Compute FP-vector support w.r.t. whole matrix
-*
- ISUPPZ( 2*WINDEX-1 ) = ISUPPZ( 2*WINDEX-1 )+OLDIEN
- ISUPPZ( 2*WINDEX ) = ISUPPZ( 2*WINDEX )+OLDIEN
- ZFROM = ISUPPZ( 2*WINDEX-1 )
- ZTO = ISUPPZ( 2*WINDEX )
- ISUPMN = ISUPMN + OLDIEN
- ISUPMX = ISUPMX + OLDIEN
-* Ensure vector is ok if support in the RQI has changed
- IF(ISUPMN.LT.ZFROM) THEN
- DO 122 II = ISUPMN,ZFROM-1
- Z( II, WINDEX ) = ZERO
- 122 CONTINUE
- ENDIF
- IF(ISUPMX.GT.ZTO) THEN
- DO 123 II = ZTO+1,ISUPMX
- Z( II, WINDEX ) = ZERO
- 123 CONTINUE
- ENDIF
- CALL DSCAL( ZTO-ZFROM+1, NRMINV,
- $ Z( ZFROM, WINDEX ), 1 )
- 125 CONTINUE
-* Update W
- W( WINDEX ) = LAMBDA+SIGMA
-* Recompute the gaps on the left and right
-* But only allow them to become larger and not
-* smaller (which can only happen through "bad"
-* cancellation and doesn't reflect the theory
-* where the initial gaps are underestimated due
-* to WERR being too crude.)
- IF(.NOT.ESKIP) THEN
- IF( K.GT.1) THEN
- WGAP( WINDMN ) = MAX( WGAP(WINDMN),
- $ W(WINDEX)-WERR(WINDEX)
- $ - W(WINDMN)-WERR(WINDMN) )
- ENDIF
- IF( WINDEX.LT.WEND ) THEN
- WGAP( WINDEX ) = MAX( SAVGAP,
- $ W( WINDPL )-WERR( WINDPL )
- $ - W( WINDEX )-WERR( WINDEX) )
- ENDIF
- ENDIF
- IDONE = IDONE + 1
- ENDIF
-* here ends the code for the current child
-*
- 139 CONTINUE
-* Proceed to any remaining child nodes
- NEWFST = J + 1
- 140 CONTINUE
- 150 CONTINUE
- NDEPTH = NDEPTH + 1
- GO TO 40
- END IF
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- 170 CONTINUE
-*
-
- RETURN
-*
-* End of DLARRV
-*
- END
diff --git a/netlib/LAPACK/dlarscl2.f b/netlib/LAPACK/dlarscl2.f
deleted file mode 100644
index b191246..0000000
--- a/netlib/LAPACK/dlarscl2.f
+++ /dev/null
@@ -1,119 +0,0 @@
-*> \brief \b DLARSCL2 performs reciprocal diagonal scaling on a vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARSCL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarscl2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarscl2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarscl2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARSCL2 ( M, N, D, X, LDX )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARSCL2 performs a reciprocal diagonal scaling on an vector:
-*> x <-- inv(D) * x
-*> where the diagonal matrix D is stored as a vector.
-*>
-*> Eventually to be replaced by BLAS_dge_diag_scale in the new BLAS
-*> standard.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of D and X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of D and X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (M)
-*> Diagonal matrix D, stored as a vector of length M.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,N)
-*> On entry, the vector X to be scaled by D.
-*> On exit, the scaled vector.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the vector X. LDX >= 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLARSCL2 ( M, N, D, X, LDX )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
- DO J = 1, N
- DO I = 1, M
- X( I, J ) = X( I, J ) / D( I )
- END DO
- END DO
-
- RETURN
- END
diff --git a/netlib/LAPACK/dlartg.f b/netlib/LAPACK/dlartg.f
deleted file mode 100644
index bf74c43..0000000
--- a/netlib/LAPACK/dlartg.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DLARTG generates a plane rotation with real cosine and real sine.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARTG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARTG( F, G, CS, SN, R )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION CS, F, G, R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARTG generate a plane rotation so that
-*>
-*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
-*> [ -SN CS ] [ G ] [ 0 ]
-*>
-*> This is a slower, more accurate version of the BLAS1 routine DROTG,
-*> with the following other differences:
-*> F and G are unchanged on return.
-*> If G=0, then CS=1 and SN=0.
-*> If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
-*> floating point operations (saves work in DBDSQR when
-*> there are zeros on the diagonal).
-*>
-*> If F exceeds G in magnitude, CS will be positive.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The first component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The second component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is DOUBLE PRECISION
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is DOUBLE PRECISION
-*> The sine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION
-*> The nonzero component of the rotated vector.
-*>
-*> This version has a few statements commented out for thread safety
-*> (machine parameters are computed on each entry). 10 feb 03, SJH.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARTG( F, G, CS, SN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION CS, F, G, R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
-* LOGICAL FIRST
- INTEGER COUNT, I
- DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, SQRT
-* ..
-* .. Save statement ..
-* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
-* ..
-* .. Data statements ..
-* DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* IF( FIRST ) THEN
- SAFMIN = DLAMCH( 'S' )
- EPS = DLAMCH( 'E' )
- SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
- $ LOG( DLAMCH( 'B' ) ) / TWO )
- SAFMX2 = ONE / SAFMN2
-* FIRST = .FALSE.
-* END IF
- IF( G.EQ.ZERO ) THEN
- CS = ONE
- SN = ZERO
- R = F
- ELSE IF( F.EQ.ZERO ) THEN
- CS = ZERO
- SN = ONE
- R = G
- ELSE
- F1 = F
- G1 = G
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 ) THEN
- COUNT = 0
- 10 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMN2
- G1 = G1*SAFMN2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 )
- $ GO TO 10
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 20 I = 1, COUNT
- R = R*SAFMX2
- 20 CONTINUE
- ELSE IF( SCALE.LE.SAFMN2 ) THEN
- COUNT = 0
- 30 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMX2
- G1 = G1*SAFMX2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.LE.SAFMN2 )
- $ GO TO 30
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 40 I = 1, COUNT
- R = R*SAFMN2
- 40 CONTINUE
- ELSE
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- END IF
- IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
- CS = -CS
- SN = -SN
- R = -R
- END IF
- END IF
- RETURN
-*
-* End of DLARTG
-*
- END
diff --git a/netlib/LAPACK/dlartgp.f b/netlib/LAPACK/dlartgp.f
deleted file mode 100644
index 3f947a8..0000000
--- a/netlib/LAPACK/dlartgp.f
+++ /dev/null
@@ -1,202 +0,0 @@
-*> \brief \b DLARTGP generates a plane rotation so that the diagonal is nonnegative.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARTGP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartgp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartgp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartgp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARTGP( F, G, CS, SN, R )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION CS, F, G, R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARTGP generates a plane rotation so that
-*>
-*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
-*> [ -SN CS ] [ G ] [ 0 ]
-*>
-*> This is a slower, more accurate version of the Level 1 BLAS routine DROTG,
-*> with the following other differences:
-*> F and G are unchanged on return.
-*> If G=0, then CS=(+/-)1 and SN=0.
-*> If F=0 and (G .ne. 0), then CS=0 and SN=(+/-)1.
-*>
-*> The sign is chosen so that R >= 0.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The first component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The second component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is DOUBLE PRECISION
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is DOUBLE PRECISION
-*> The sine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION
-*> The nonzero component of the rotated vector.
-*>
-*> This version has a few statements commented out for thread safety
-*> (machine parameters are computed on each entry). 10 feb 03, SJH.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARTGP( F, G, CS, SN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION CS, F, G, R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
-* LOGICAL FIRST
- INTEGER COUNT, I
- DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, SIGN, SQRT
-* ..
-* .. Save statement ..
-* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
-* ..
-* .. Data statements ..
-* DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* IF( FIRST ) THEN
- SAFMIN = DLAMCH( 'S' )
- EPS = DLAMCH( 'E' )
- SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
- $ LOG( DLAMCH( 'B' ) ) / TWO )
- SAFMX2 = ONE / SAFMN2
-* FIRST = .FALSE.
-* END IF
- IF( G.EQ.ZERO ) THEN
- CS = SIGN( ONE, F )
- SN = ZERO
- R = ABS( F )
- ELSE IF( F.EQ.ZERO ) THEN
- CS = ZERO
- SN = SIGN( ONE, G )
- R = ABS( G )
- ELSE
- F1 = F
- G1 = G
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 ) THEN
- COUNT = 0
- 10 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMN2
- G1 = G1*SAFMN2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 )
- $ GO TO 10
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 20 I = 1, COUNT
- R = R*SAFMX2
- 20 CONTINUE
- ELSE IF( SCALE.LE.SAFMN2 ) THEN
- COUNT = 0
- 30 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMX2
- G1 = G1*SAFMX2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.LE.SAFMN2 )
- $ GO TO 30
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 40 I = 1, COUNT
- R = R*SAFMN2
- 40 CONTINUE
- ELSE
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- END IF
- IF( R.LT.ZERO ) THEN
- CS = -CS
- SN = -SN
- R = -R
- END IF
- END IF
- RETURN
-*
-* End of DLARTGP
-*
- END
diff --git a/netlib/LAPACK/dlartgs.f b/netlib/LAPACK/dlartgs.f
deleted file mode 100644
index 5a821a2..0000000
--- a/netlib/LAPACK/dlartgs.f
+++ /dev/null
@@ -1,158 +0,0 @@
-*> \brief \b DLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARTGS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartgs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartgs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartgs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION CS, SIGMA, SN, X, Y
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARTGS generates a plane rotation designed to introduce a bulge in
-*> Golub-Reinsch-style implicit QR iteration for the bidiagonal SVD
-*> problem. X and Y are the top-row entries, and SIGMA is the shift.
-*> The computed CS and SN define a plane rotation satisfying
-*>
-*> [ CS SN ] . [ X^2 - SIGMA ] = [ R ],
-*> [ -SN CS ] [ X * Y ] [ 0 ]
-*>
-*> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the
-*> rotation is by PI/2.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION
-*> The (1,1) entry of an upper bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION
-*> The (1,2) entry of an upper bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> The shift.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is DOUBLE PRECISION
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is DOUBLE PRECISION
-*> The sine of the rotation.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION CS, SIGMA, SN, X, Y
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION NEGONE, ONE, ZERO
- PARAMETER ( NEGONE = -1.0D0, ONE = 1.0D0, ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION R, S, THRESH, W, Z
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* .. Executable Statements ..
-*
- THRESH = DLAMCH('E')
-*
-* Compute the first column of B**T*B - SIGMA^2*I, up to a scale
-* factor.
-*
- IF( (SIGMA .EQ. ZERO .AND. ABS(X) .LT. THRESH) .OR.
- $ (ABS(X) .EQ. SIGMA .AND. Y .EQ. ZERO) ) THEN
- Z = ZERO
- W = ZERO
- ELSE IF( SIGMA .EQ. ZERO ) THEN
- IF( X .GE. ZERO ) THEN
- Z = X
- W = Y
- ELSE
- Z = -X
- W = -Y
- END IF
- ELSE IF( ABS(X) .LT. THRESH ) THEN
- Z = -SIGMA*SIGMA
- W = ZERO
- ELSE
- IF( X .GE. ZERO ) THEN
- S = ONE
- ELSE
- S = NEGONE
- END IF
- Z = S * (ABS(X)-SIGMA) * (S+SIGMA/X)
- W = S * Y
- END IF
-*
-* Generate the rotation.
-* CALL DLARTGP( Z, W, CS, SN, R ) might seem more natural;
-* reordering the arguments ensures that if Z = 0 then the rotation
-* is by PI/2.
-*
- CALL DLARTGP( W, Z, SN, CS, R )
-*
- RETURN
-*
-* End DLARTGS
-*
- END
-
diff --git a/netlib/LAPACK/dlartv.f b/netlib/LAPACK/dlartv.f
deleted file mode 100644
index f9aa2ae..0000000
--- a/netlib/LAPACK/dlartv.f
+++ /dev/null
@@ -1,147 +0,0 @@
-*> \brief \b DLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair of vectors.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARTV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARTV( N, X, INCX, Y, INCY, C, S, INCC )
-*
-* .. Scalar Arguments ..
-* INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( * ), S( * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARTV applies a vector of real plane rotations to elements of the
-*> real vectors x and y. For i = 1,2,...,n
-*>
-*> ( x(i) ) := ( c(i) s(i) ) ( x(i) )
-*> ( y(i) ) ( -s(i) c(i) ) ( y(i) )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of plane rotations to be applied.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCX)
-*> The vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array,
-*> dimension (1+(N-1)*INCY)
-*> The vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> The increment between elements of Y. INCY > 0.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
-*> The cosines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
-*> The sines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCC
-*> \verbatim
-*> INCC is INTEGER
-*> The increment between elements of C and S. INCC > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARTV( N, X, INCX, Y, INCY, C, S, INCC )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( * ), S( * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IC, IX, IY
- DOUBLE PRECISION XI, YI
-* ..
-* .. Executable Statements ..
-*
- IX = 1
- IY = 1
- IC = 1
- DO 10 I = 1, N
- XI = X( IX )
- YI = Y( IY )
- X( IX ) = C( IC )*XI + S( IC )*YI
- Y( IY ) = C( IC )*YI - S( IC )*XI
- IX = IX + INCX
- IY = IY + INCY
- IC = IC + INCC
- 10 CONTINUE
- RETURN
-*
-* End of DLARTV
-*
- END
diff --git a/netlib/LAPACK/dlaruv.f b/netlib/LAPACK/dlaruv.f
deleted file mode 100644
index d9012c6..0000000
--- a/netlib/LAPACK/dlaruv.f
+++ /dev/null
@@ -1,446 +0,0 @@
-*> \brief \b DLARUV returns a vector of n random real numbers from a uniform distribution.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARUV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaruv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaruv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaruv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARUV( ISEED, N, X )
-*
-* .. Scalar Arguments ..
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION X( N )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARUV returns a vector of n random real numbers from a uniform (0,1)
-*> distribution (n <= 128).
-*>
-*> This is an auxiliary routine called by DLARNV and ZLARNV.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of random numbers to be generated. N <= 128.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> The generated random numbers.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine uses a multiplicative congruential method with modulus
-*> 2**48 and multiplier 33952834046453 (see G.S.Fishman,
-*> 'Multiplicative congruential random number generators with modulus
-*> 2**b: an exhaustive analysis for b = 32 and a partial analysis for
-*> b = 48', Math. Comp. 189, pp 331-344, 1990).
-*>
-*> 48-bit integers are stored in 4 integer array elements with 12 bits
-*> per element. Hence the routine is portable across machines with
-*> integers of 32 bits or more.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARUV( ISEED, N, X )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION X( N )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- INTEGER LV, IPW2
- DOUBLE PRECISION R
- PARAMETER ( LV = 128, IPW2 = 4096, R = ONE / IPW2 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, I2, I3, I4, IT1, IT2, IT3, IT4, J
-* ..
-* .. Local Arrays ..
- INTEGER MM( LV, 4 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MIN, MOD
-* ..
-* .. Data statements ..
- DATA ( MM( 1, J ), J = 1, 4 ) / 494, 322, 2508,
- $ 2549 /
- DATA ( MM( 2, J ), J = 1, 4 ) / 2637, 789, 3754,
- $ 1145 /
- DATA ( MM( 3, J ), J = 1, 4 ) / 255, 1440, 1766,
- $ 2253 /
- DATA ( MM( 4, J ), J = 1, 4 ) / 2008, 752, 3572,
- $ 305 /
- DATA ( MM( 5, J ), J = 1, 4 ) / 1253, 2859, 2893,
- $ 3301 /
- DATA ( MM( 6, J ), J = 1, 4 ) / 3344, 123, 307,
- $ 1065 /
- DATA ( MM( 7, J ), J = 1, 4 ) / 4084, 1848, 1297,
- $ 3133 /
- DATA ( MM( 8, J ), J = 1, 4 ) / 1739, 643, 3966,
- $ 2913 /
- DATA ( MM( 9, J ), J = 1, 4 ) / 3143, 2405, 758,
- $ 3285 /
- DATA ( MM( 10, J ), J = 1, 4 ) / 3468, 2638, 2598,
- $ 1241 /
- DATA ( MM( 11, J ), J = 1, 4 ) / 688, 2344, 3406,
- $ 1197 /
- DATA ( MM( 12, J ), J = 1, 4 ) / 1657, 46, 2922,
- $ 3729 /
- DATA ( MM( 13, J ), J = 1, 4 ) / 1238, 3814, 1038,
- $ 2501 /
- DATA ( MM( 14, J ), J = 1, 4 ) / 3166, 913, 2934,
- $ 1673 /
- DATA ( MM( 15, J ), J = 1, 4 ) / 1292, 3649, 2091,
- $ 541 /
- DATA ( MM( 16, J ), J = 1, 4 ) / 3422, 339, 2451,
- $ 2753 /
- DATA ( MM( 17, J ), J = 1, 4 ) / 1270, 3808, 1580,
- $ 949 /
- DATA ( MM( 18, J ), J = 1, 4 ) / 2016, 822, 1958,
- $ 2361 /
- DATA ( MM( 19, J ), J = 1, 4 ) / 154, 2832, 2055,
- $ 1165 /
- DATA ( MM( 20, J ), J = 1, 4 ) / 2862, 3078, 1507,
- $ 4081 /
- DATA ( MM( 21, J ), J = 1, 4 ) / 697, 3633, 1078,
- $ 2725 /
- DATA ( MM( 22, J ), J = 1, 4 ) / 1706, 2970, 3273,
- $ 3305 /
- DATA ( MM( 23, J ), J = 1, 4 ) / 491, 637, 17,
- $ 3069 /
- DATA ( MM( 24, J ), J = 1, 4 ) / 931, 2249, 854,
- $ 3617 /
- DATA ( MM( 25, J ), J = 1, 4 ) / 1444, 2081, 2916,
- $ 3733 /
- DATA ( MM( 26, J ), J = 1, 4 ) / 444, 4019, 3971,
- $ 409 /
- DATA ( MM( 27, J ), J = 1, 4 ) / 3577, 1478, 2889,
- $ 2157 /
- DATA ( MM( 28, J ), J = 1, 4 ) / 3944, 242, 3831,
- $ 1361 /
- DATA ( MM( 29, J ), J = 1, 4 ) / 2184, 481, 2621,
- $ 3973 /
- DATA ( MM( 30, J ), J = 1, 4 ) / 1661, 2075, 1541,
- $ 1865 /
- DATA ( MM( 31, J ), J = 1, 4 ) / 3482, 4058, 893,
- $ 2525 /
- DATA ( MM( 32, J ), J = 1, 4 ) / 657, 622, 736,
- $ 1409 /
- DATA ( MM( 33, J ), J = 1, 4 ) / 3023, 3376, 3992,
- $ 3445 /
- DATA ( MM( 34, J ), J = 1, 4 ) / 3618, 812, 787,
- $ 3577 /
- DATA ( MM( 35, J ), J = 1, 4 ) / 1267, 234, 2125,
- $ 77 /
- DATA ( MM( 36, J ), J = 1, 4 ) / 1828, 641, 2364,
- $ 3761 /
- DATA ( MM( 37, J ), J = 1, 4 ) / 164, 4005, 2460,
- $ 2149 /
- DATA ( MM( 38, J ), J = 1, 4 ) / 3798, 1122, 257,
- $ 1449 /
- DATA ( MM( 39, J ), J = 1, 4 ) / 3087, 3135, 1574,
- $ 3005 /
- DATA ( MM( 40, J ), J = 1, 4 ) / 2400, 2640, 3912,
- $ 225 /
- DATA ( MM( 41, J ), J = 1, 4 ) / 2870, 2302, 1216,
- $ 85 /
- DATA ( MM( 42, J ), J = 1, 4 ) / 3876, 40, 3248,
- $ 3673 /
- DATA ( MM( 43, J ), J = 1, 4 ) / 1905, 1832, 3401,
- $ 3117 /
- DATA ( MM( 44, J ), J = 1, 4 ) / 1593, 2247, 2124,
- $ 3089 /
- DATA ( MM( 45, J ), J = 1, 4 ) / 1797, 2034, 2762,
- $ 1349 /
- DATA ( MM( 46, J ), J = 1, 4 ) / 1234, 2637, 149,
- $ 2057 /
- DATA ( MM( 47, J ), J = 1, 4 ) / 3460, 1287, 2245,
- $ 413 /
- DATA ( MM( 48, J ), J = 1, 4 ) / 328, 1691, 166,
- $ 65 /
- DATA ( MM( 49, J ), J = 1, 4 ) / 2861, 496, 466,
- $ 1845 /
- DATA ( MM( 50, J ), J = 1, 4 ) / 1950, 1597, 4018,
- $ 697 /
- DATA ( MM( 51, J ), J = 1, 4 ) / 617, 2394, 1399,
- $ 3085 /
- DATA ( MM( 52, J ), J = 1, 4 ) / 2070, 2584, 190,
- $ 3441 /
- DATA ( MM( 53, J ), J = 1, 4 ) / 3331, 1843, 2879,
- $ 1573 /
- DATA ( MM( 54, J ), J = 1, 4 ) / 769, 336, 153,
- $ 3689 /
- DATA ( MM( 55, J ), J = 1, 4 ) / 1558, 1472, 2320,
- $ 2941 /
- DATA ( MM( 56, J ), J = 1, 4 ) / 2412, 2407, 18,
- $ 929 /
- DATA ( MM( 57, J ), J = 1, 4 ) / 2800, 433, 712,
- $ 533 /
- DATA ( MM( 58, J ), J = 1, 4 ) / 189, 2096, 2159,
- $ 2841 /
- DATA ( MM( 59, J ), J = 1, 4 ) / 287, 1761, 2318,
- $ 4077 /
- DATA ( MM( 60, J ), J = 1, 4 ) / 2045, 2810, 2091,
- $ 721 /
- DATA ( MM( 61, J ), J = 1, 4 ) / 1227, 566, 3443,
- $ 2821 /
- DATA ( MM( 62, J ), J = 1, 4 ) / 2838, 442, 1510,
- $ 2249 /
- DATA ( MM( 63, J ), J = 1, 4 ) / 209, 41, 449,
- $ 2397 /
- DATA ( MM( 64, J ), J = 1, 4 ) / 2770, 1238, 1956,
- $ 2817 /
- DATA ( MM( 65, J ), J = 1, 4 ) / 3654, 1086, 2201,
- $ 245 /
- DATA ( MM( 66, J ), J = 1, 4 ) / 3993, 603, 3137,
- $ 1913 /
- DATA ( MM( 67, J ), J = 1, 4 ) / 192, 840, 3399,
- $ 1997 /
- DATA ( MM( 68, J ), J = 1, 4 ) / 2253, 3168, 1321,
- $ 3121 /
- DATA ( MM( 69, J ), J = 1, 4 ) / 3491, 1499, 2271,
- $ 997 /
- DATA ( MM( 70, J ), J = 1, 4 ) / 2889, 1084, 3667,
- $ 1833 /
- DATA ( MM( 71, J ), J = 1, 4 ) / 2857, 3438, 2703,
- $ 2877 /
- DATA ( MM( 72, J ), J = 1, 4 ) / 2094, 2408, 629,
- $ 1633 /
- DATA ( MM( 73, J ), J = 1, 4 ) / 1818, 1589, 2365,
- $ 981 /
- DATA ( MM( 74, J ), J = 1, 4 ) / 688, 2391, 2431,
- $ 2009 /
- DATA ( MM( 75, J ), J = 1, 4 ) / 1407, 288, 1113,
- $ 941 /
- DATA ( MM( 76, J ), J = 1, 4 ) / 634, 26, 3922,
- $ 2449 /
- DATA ( MM( 77, J ), J = 1, 4 ) / 3231, 512, 2554,
- $ 197 /
- DATA ( MM( 78, J ), J = 1, 4 ) / 815, 1456, 184,
- $ 2441 /
- DATA ( MM( 79, J ), J = 1, 4 ) / 3524, 171, 2099,
- $ 285 /
- DATA ( MM( 80, J ), J = 1, 4 ) / 1914, 1677, 3228,
- $ 1473 /
- DATA ( MM( 81, J ), J = 1, 4 ) / 516, 2657, 4012,
- $ 2741 /
- DATA ( MM( 82, J ), J = 1, 4 ) / 164, 2270, 1921,
- $ 3129 /
- DATA ( MM( 83, J ), J = 1, 4 ) / 303, 2587, 3452,
- $ 909 /
- DATA ( MM( 84, J ), J = 1, 4 ) / 2144, 2961, 3901,
- $ 2801 /
- DATA ( MM( 85, J ), J = 1, 4 ) / 3480, 1970, 572,
- $ 421 /
- DATA ( MM( 86, J ), J = 1, 4 ) / 119, 1817, 3309,
- $ 4073 /
- DATA ( MM( 87, J ), J = 1, 4 ) / 3357, 676, 3171,
- $ 2813 /
- DATA ( MM( 88, J ), J = 1, 4 ) / 837, 1410, 817,
- $ 2337 /
- DATA ( MM( 89, J ), J = 1, 4 ) / 2826, 3723, 3039,
- $ 1429 /
- DATA ( MM( 90, J ), J = 1, 4 ) / 2332, 2803, 1696,
- $ 1177 /
- DATA ( MM( 91, J ), J = 1, 4 ) / 2089, 3185, 1256,
- $ 1901 /
- DATA ( MM( 92, J ), J = 1, 4 ) / 3780, 184, 3715,
- $ 81 /
- DATA ( MM( 93, J ), J = 1, 4 ) / 1700, 663, 2077,
- $ 1669 /
- DATA ( MM( 94, J ), J = 1, 4 ) / 3712, 499, 3019,
- $ 2633 /
- DATA ( MM( 95, J ), J = 1, 4 ) / 150, 3784, 1497,
- $ 2269 /
- DATA ( MM( 96, J ), J = 1, 4 ) / 2000, 1631, 1101,
- $ 129 /
- DATA ( MM( 97, J ), J = 1, 4 ) / 3375, 1925, 717,
- $ 1141 /
- DATA ( MM( 98, J ), J = 1, 4 ) / 1621, 3912, 51,
- $ 249 /
- DATA ( MM( 99, J ), J = 1, 4 ) / 3090, 1398, 981,
- $ 3917 /
- DATA ( MM( 100, J ), J = 1, 4 ) / 3765, 1349, 1978,
- $ 2481 /
- DATA ( MM( 101, J ), J = 1, 4 ) / 1149, 1441, 1813,
- $ 3941 /
- DATA ( MM( 102, J ), J = 1, 4 ) / 3146, 2224, 3881,
- $ 2217 /
- DATA ( MM( 103, J ), J = 1, 4 ) / 33, 2411, 76,
- $ 2749 /
- DATA ( MM( 104, J ), J = 1, 4 ) / 3082, 1907, 3846,
- $ 3041 /
- DATA ( MM( 105, J ), J = 1, 4 ) / 2741, 3192, 3694,
- $ 1877 /
- DATA ( MM( 106, J ), J = 1, 4 ) / 359, 2786, 1682,
- $ 345 /
- DATA ( MM( 107, J ), J = 1, 4 ) / 3316, 382, 124,
- $ 2861 /
- DATA ( MM( 108, J ), J = 1, 4 ) / 1749, 37, 1660,
- $ 1809 /
- DATA ( MM( 109, J ), J = 1, 4 ) / 185, 759, 3997,
- $ 3141 /
- DATA ( MM( 110, J ), J = 1, 4 ) / 2784, 2948, 479,
- $ 2825 /
- DATA ( MM( 111, J ), J = 1, 4 ) / 2202, 1862, 1141,
- $ 157 /
- DATA ( MM( 112, J ), J = 1, 4 ) / 2199, 3802, 886,
- $ 2881 /
- DATA ( MM( 113, J ), J = 1, 4 ) / 1364, 2423, 3514,
- $ 3637 /
- DATA ( MM( 114, J ), J = 1, 4 ) / 1244, 2051, 1301,
- $ 1465 /
- DATA ( MM( 115, J ), J = 1, 4 ) / 2020, 2295, 3604,
- $ 2829 /
- DATA ( MM( 116, J ), J = 1, 4 ) / 3160, 1332, 1888,
- $ 2161 /
- DATA ( MM( 117, J ), J = 1, 4 ) / 2785, 1832, 1836,
- $ 3365 /
- DATA ( MM( 118, J ), J = 1, 4 ) / 2772, 2405, 1990,
- $ 361 /
- DATA ( MM( 119, J ), J = 1, 4 ) / 1217, 3638, 2058,
- $ 2685 /
- DATA ( MM( 120, J ), J = 1, 4 ) / 1822, 3661, 692,
- $ 3745 /
- DATA ( MM( 121, J ), J = 1, 4 ) / 1245, 327, 1194,
- $ 2325 /
- DATA ( MM( 122, J ), J = 1, 4 ) / 2252, 3660, 20,
- $ 3609 /
- DATA ( MM( 123, J ), J = 1, 4 ) / 3904, 716, 3285,
- $ 3821 /
- DATA ( MM( 124, J ), J = 1, 4 ) / 2774, 1842, 2046,
- $ 3537 /
- DATA ( MM( 125, J ), J = 1, 4 ) / 997, 3987, 2107,
- $ 517 /
- DATA ( MM( 126, J ), J = 1, 4 ) / 2573, 1368, 3508,
- $ 3017 /
- DATA ( MM( 127, J ), J = 1, 4 ) / 1148, 1848, 3525,
- $ 2141 /
- DATA ( MM( 128, J ), J = 1, 4 ) / 545, 2366, 3801,
- $ 1537 /
-* ..
-* .. Executable Statements ..
-*
- I1 = ISEED( 1 )
- I2 = ISEED( 2 )
- I3 = ISEED( 3 )
- I4 = ISEED( 4 )
-*
- DO 10 I = 1, MIN( N, LV )
-*
- 20 CONTINUE
-*
-* Multiply the seed by i-th power of the multiplier modulo 2**48
-*
- IT4 = I4*MM( I, 4 )
- IT3 = IT4 / IPW2
- IT4 = IT4 - IPW2*IT3
- IT3 = IT3 + I3*MM( I, 4 ) + I4*MM( I, 3 )
- IT2 = IT3 / IPW2
- IT3 = IT3 - IPW2*IT2
- IT2 = IT2 + I2*MM( I, 4 ) + I3*MM( I, 3 ) + I4*MM( I, 2 )
- IT1 = IT2 / IPW2
- IT2 = IT2 - IPW2*IT1
- IT1 = IT1 + I1*MM( I, 4 ) + I2*MM( I, 3 ) + I3*MM( I, 2 ) +
- $ I4*MM( I, 1 )
- IT1 = MOD( IT1, IPW2 )
-*
-* Convert 48-bit integer to a real number in the interval (0,1)
-*
- X( I ) = R*( DBLE( IT1 )+R*( DBLE( IT2 )+R*( DBLE( IT3 )+R*
- $ DBLE( IT4 ) ) ) )
-*
- IF (X( I ).EQ.1.0D0) THEN
-* If a real number has n bits of precision, and the first
-* n bits of the 48-bit integer above happen to be all 1 (which
-* will occur about once every 2**n calls), then X( I ) will
-* be rounded to exactly 1.0.
-* Since X( I ) is not supposed to return exactly 0.0 or 1.0,
-* the statistically correct thing to do in this situation is
-* simply to iterate again.
-* N.B. the case X( I ) = 0.0 should not be possible.
- I1 = I1 + 2
- I2 = I2 + 2
- I3 = I3 + 2
- I4 = I4 + 2
- GOTO 20
- END IF
-*
- 10 CONTINUE
-*
-* Return final value of seed
-*
- ISEED( 1 ) = IT1
- ISEED( 2 ) = IT2
- ISEED( 3 ) = IT3
- ISEED( 4 ) = IT4
- RETURN
-*
-* End of DLARUV
-*
- END
diff --git a/netlib/LAPACK/dlarz.f b/netlib/LAPACK/dlarz.f
deleted file mode 100644
index 08a57ec..0000000
--- a/netlib/LAPACK/dlarz.f
+++ /dev/null
@@ -1,236 +0,0 @@
-*> \brief \b DLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, L, LDC, M, N
-* DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARZ applies a real elementary reflector H to a real M-by-N
-*> matrix C, from either the left or the right. H is represented in the
-*> form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar and v is a real vector.
-*>
-*> If tau = 0, then H is taken to be the unit matrix.
-*>
-*>
-*> H is a product of k elementary reflectors as returned by DTZRZF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of entries of the vector V containing
-*> the meaningful part of the Householder vectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (1+(L-1)*abs(INCV))
-*> The vector v in the representation of H as returned by
-*> DTZRZF. V is not used if TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, L, LDC, M, N
- DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C
-*
- IF( TAU.NE.ZERO ) THEN
-*
-* w( 1:n ) = C( 1, 1:n )
-*
- CALL DCOPY( N, C, LDC, WORK, 1 )
-*
-* w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )**T * v( 1:l )
-*
- CALL DGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V,
- $ INCV, ONE, WORK, 1 )
-*
-* C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
-*
- CALL DAXPY( N, -TAU, WORK, 1, C, LDC )
-*
-* C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-* tau * v( 1:l ) * w( 1:n )**T
-*
- CALL DGER( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
- $ LDC )
- END IF
-*
- ELSE
-*
-* Form C * H
-*
- IF( TAU.NE.ZERO ) THEN
-*
-* w( 1:m ) = C( 1:m, 1 )
-*
- CALL DCOPY( M, C, 1, WORK, 1 )
-*
-* w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
-*
- CALL DGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
- $ V, INCV, ONE, WORK, 1 )
-*
-* C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
-*
- CALL DAXPY( M, -TAU, WORK, 1, C, 1 )
-*
-* C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-* tau * w( 1:m ) * v( 1:l )**T
-*
- CALL DGER( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
- $ LDC )
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DLARZ
-*
- END
diff --git a/netlib/LAPACK/dlarzb.f b/netlib/LAPACK/dlarzb.f
deleted file mode 100644
index 93c1bd1..0000000
--- a/netlib/LAPACK/dlarzb.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b DLARZB applies a block reflector or its transpose to a general matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARZB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarzb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarzb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarzb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
-* LDV, T, LDT, C, LDC, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, L, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
-* $ WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARZB applies a real block reflector H or its transpose H**T to
-*> a real distributed M-by-N C from the left or the right.
-*>
-*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H**T from the Left
-*> = 'R': apply H or H**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'C': apply H**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
-*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*> \endverbatim
-*>
-*> \param[in] STOREV
-*> \verbatim
-*> STOREV is CHARACTER*1
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columnwise (not supported yet)
-*> = 'R': Rowwise
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T (= the number of elementary
-*> reflectors whose product defines the block reflector).
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix V containing the
-*> meaningful part of the Householder reflectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,NV).
-*> If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The triangular K-by-K matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LDWORK,K)
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= max(1,N);
-*> if SIDE = 'R', LDWORK >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
- $ LDV, T, LDT, C, LDC, WORK, LDWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, L, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
- $ WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST
- INTEGER I, INFO, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DTRMM, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
-* Check for currently supported options
-*
- INFO = 0
- IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLARZB', -INFO )
- RETURN
- END IF
-*
- IF( LSAME( TRANS, 'N' ) ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C
-*
-* W( 1:n, 1:k ) = C( 1:k, 1:n )**T
-*
- DO 10 J = 1, K
- CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 10 CONTINUE
-*
-* W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
-* C( m-l+1:m, 1:n )**T * V( 1:k, 1:l )**T
-*
- IF( L.GT.0 )
- $ CALL DGEMM( 'Transpose', 'Transpose', N, K, L, ONE,
- $ C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-* W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T or W( 1:m, 1:k ) * T
-*
- CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
- $ LDT, WORK, LDWORK )
-*
-* C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**T
-*
- DO 30 J = 1, N
- DO 20 I = 1, K
- C( I, J ) = C( I, J ) - WORK( J, I )
- 20 CONTINUE
- 30 CONTINUE
-*
-* C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-* V( 1:k, 1:l )**T * W( 1:n, 1:k )**T
-*
- IF( L.GT.0 )
- $ CALL DGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
- $ WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T
-*
-* W( 1:m, 1:k ) = C( 1:m, 1:k )
-*
- DO 40 J = 1, K
- CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
- 40 CONTINUE
-*
-* W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
-* C( 1:m, n-l+1:n ) * V( 1:k, 1:l )**T
-*
- IF( L.GT.0 )
- $ CALL DGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
- $ C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-* W( 1:m, 1:k ) = W( 1:m, 1:k ) * T or W( 1:m, 1:k ) * T**T
-*
- CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
- $ LDT, WORK, LDWORK )
-*
-* C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
-*
- DO 60 J = 1, K
- DO 50 I = 1, M
- C( I, J ) = C( I, J ) - WORK( I, J )
- 50 CONTINUE
- 60 CONTINUE
-*
-* C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-* W( 1:m, 1:k ) * V( 1:k, 1:l )
-*
- IF( L.GT.0 )
- $ CALL DGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
- $ WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
-*
- END IF
-*
- RETURN
-*
-* End of DLARZB
-*
- END
diff --git a/netlib/LAPACK/dlarzt.f b/netlib/LAPACK/dlarzt.f
deleted file mode 100644
index f76c593..0000000
--- a/netlib/LAPACK/dlarzt.f
+++ /dev/null
@@ -1,264 +0,0 @@
-*> \brief \b DLARZT forms the triangular factor T of a block reflector H = I - vtvH.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARZT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarzt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarzt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarzt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARZT( 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
-*>
-*> DLARZT 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
-*>
-*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*> \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, not supported yet)
-*> = '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 (not supported yet)
-*> = '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,out] 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.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \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; the corresponding
-*> array elements are modified but restored on exit. The rest of the
-*> array is not used.
-*>
-*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
-*>
-*> ______V_____
-*> ( v1 v2 v3 ) / \
-*> ( v1 v2 v3 ) ( v1 v1 v1 v1 v1 . . . . 1 )
-*> V = ( v1 v2 v3 ) ( v2 v2 v2 v2 v2 . . . 1 )
-*> ( v1 v2 v3 ) ( v3 v3 v3 v3 v3 . . 1 )
-*> ( v1 v2 v3 )
-*> . . .
-*> . . .
-*> 1 . .
-*> 1 .
-*> 1
-*>
-*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
-*>
-*> ______V_____
-*> 1 / \
-*> . 1 ( 1 . . . . v1 v1 v1 v1 v1 )
-*> . . 1 ( . 1 . . . v2 v2 v2 v2 v2 )
-*> . . . ( . . 1 . . v3 v3 v3 v3 v3 )
-*> . . .
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*> V = ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, STOREV
- INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DTRMV, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Check for currently supported options
-*
- INFO = 0
- IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLARZT', -INFO )
- RETURN
- END IF
-*
- DO 20 I = K, 1, -1
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO 10 J = I, K
- T( J, I ) = ZERO
- 10 CONTINUE
- ELSE
-*
-* general case
-*
- IF( I.LT.K ) THEN
-*
-* T(i+1:k,i) = - tau(i) * V(i+1:k,1:n) * V(i,1:n)**T
-*
- CALL DGEMV( 'No transpose', K-I, N, -TAU( I ),
- $ V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
- $ T( I+1, I ), 1 )
-*
-* 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 )
- END IF
- T( I, I ) = TAU( I )
- END IF
- 20 CONTINUE
- RETURN
-*
-* End of DLARZT
-*
- END
diff --git a/netlib/LAPACK/dlas2.f b/netlib/LAPACK/dlas2.f
deleted file mode 100644
index 81077f9..0000000
--- a/netlib/LAPACK/dlas2.f
+++ /dev/null
@@ -1,183 +0,0 @@
-*> \brief \b DLAS2 computes singular values of a 2-by-2 triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlas2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlas2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlas2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION F, G, H, SSMAX, SSMIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAS2 computes the singular values of the 2-by-2 matrix
-*> [ F G ]
-*> [ 0 H ].
-*> On return, SSMIN is the smaller singular value and SSMAX is the
-*> larger singular value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The (1,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is DOUBLE PRECISION
-*> The smaller singular value.
-*> \endverbatim
-*>
-*> \param[out] SSMAX
-*> \verbatim
-*> SSMAX is DOUBLE PRECISION
-*> The larger singular value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Barring over/underflow, all output quantities are correct to within
-*> a few units in the last place (ulps), even in the absence of a guard
-*> digit in addition/subtraction.
-*>
-*> In IEEE arithmetic, the code works correctly if one matrix element is
-*> infinite.
-*>
-*> Overflow will not occur unless the largest singular value itself
-*> overflows, or is within a few ulps of overflow. (On machines with
-*> partial overflow, like the Cray, overflow may occur if the largest
-*> singular value is within a factor of 2 of overflow.)
-*>
-*> Underflow is harmless if underflow is gradual. Otherwise, results
-*> may correspond to a matrix modified by perturbations of size near
-*> the underflow threshold.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION F, G, H, SSMAX, SSMIN
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- FA = ABS( F )
- GA = ABS( G )
- HA = ABS( H )
- FHMN = MIN( FA, HA )
- FHMX = MAX( FA, HA )
- IF( FHMN.EQ.ZERO ) THEN
- SSMIN = ZERO
- IF( FHMX.EQ.ZERO ) THEN
- SSMAX = GA
- ELSE
- SSMAX = MAX( FHMX, GA )*SQRT( ONE+
- $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
- END IF
- ELSE
- IF( GA.LT.FHMX ) THEN
- AS = ONE + FHMN / FHMX
- AT = ( FHMX-FHMN ) / FHMX
- AU = ( GA / FHMX )**2
- C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
- SSMIN = FHMN*C
- SSMAX = FHMX / C
- ELSE
- AU = FHMX / GA
- IF( AU.EQ.ZERO ) THEN
-*
-* Avoid possible harmful underflow if exponent range
-* asymmetric (true SSMIN may not underflow even if
-* AU underflows)
-*
- SSMIN = ( FHMN*FHMX ) / GA
- SSMAX = GA
- ELSE
- AS = ONE + FHMN / FHMX
- AT = ( FHMX-FHMN ) / FHMX
- C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
- $ SQRT( ONE+( AT*AU )**2 ) )
- SSMIN = ( FHMN*C )*AU
- SSMIN = SSMIN + SSMIN
- SSMAX = GA / ( C+C )
- END IF
- END IF
- END IF
- RETURN
-*
-* End of DLAS2
-*
- END
diff --git a/netlib/LAPACK/dlascl.f b/netlib/LAPACK/dlascl.f
deleted file mode 100644
index 9b9b33c..0000000
--- a/netlib/LAPACK/dlascl.f
+++ /dev/null
@@ -1,364 +0,0 @@
-*> \brief \b DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASCL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlascl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlascl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlascl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TYPE
-* INTEGER INFO, KL, KU, LDA, M, N
-* DOUBLE PRECISION CFROM, CTO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASCL multiplies the M by N real matrix A by the real scalar
-*> CTO/CFROM. This is done without over/underflow as long as the final
-*> result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
-*> A may be full, upper triangular, lower triangular, upper Hessenberg,
-*> or banded.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TYPE
-*> \verbatim
-*> TYPE is CHARACTER*1
-*> TYPE indices the storage type of the input matrix.
-*> = 'G': A is a full matrix.
-*> = 'L': A is a lower triangular matrix.
-*> = 'U': A is an upper triangular matrix.
-*> = 'H': A is an upper Hessenberg matrix.
-*> = 'B': A is a symmetric band matrix with lower bandwidth KL
-*> and upper bandwidth KU and with the only the lower
-*> half stored.
-*> = 'Q': A is a symmetric band matrix with lower bandwidth KL
-*> and upper bandwidth KU and with the only the upper
-*> half stored.
-*> = 'Z': A is a band matrix with lower bandwidth KL and upper
-*> bandwidth KU. See DGBTRF for storage details.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The lower bandwidth of A. Referenced only if TYPE = 'B',
-*> 'Q' or 'Z'.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The upper bandwidth of A. Referenced only if TYPE = 'B',
-*> 'Q' or 'Z'.
-*> \endverbatim
-*>
-*> \param[in] CFROM
-*> \verbatim
-*> CFROM is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] CTO
-*> \verbatim
-*> CTO is DOUBLE PRECISION
-*>
-*> The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
-*> without over/underflow if the final result CTO*A(I,J)/CFROM
-*> can be represented without over/underflow. CFROM must be
-*> nonzero.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The matrix to be multiplied by CTO/CFROM. See TYPE for the
-*> storage type.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> 0 - successful exit
-*> <0 - if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TYPE
- INTEGER INFO, KL, KU, LDA, M, N
- DOUBLE PRECISION CFROM, CTO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DONE
- INTEGER I, ITYPE, J, K1, K2, K3, K4
- DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
-*
- IF( LSAME( TYPE, 'G' ) ) THEN
- ITYPE = 0
- ELSE IF( LSAME( TYPE, 'L' ) ) THEN
- ITYPE = 1
- ELSE IF( LSAME( TYPE, 'U' ) ) THEN
- ITYPE = 2
- ELSE IF( LSAME( TYPE, 'H' ) ) THEN
- ITYPE = 3
- ELSE IF( LSAME( TYPE, 'B' ) ) THEN
- ITYPE = 4
- ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
- ITYPE = 5
- ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
- ITYPE = 6
- ELSE
- ITYPE = -1
- END IF
-*
- IF( ITYPE.EQ.-1 ) THEN
- INFO = -1
- ELSE IF( CFROM.EQ.ZERO .OR. DISNAN(CFROM) ) THEN
- INFO = -4
- ELSE IF( DISNAN(CTO) ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -6
- ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
- $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
- INFO = -7
- ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
- INFO = -9
- ELSE IF( ITYPE.GE.4 ) THEN
- IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
- INFO = -2
- ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
- $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
- $ THEN
- INFO = -3
- ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
- $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
- $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
- INFO = -9
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASCL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 )
- $ RETURN
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
- CFROMC = CFROM
- CTOC = CTO
-*
- 10 CONTINUE
- CFROM1 = CFROMC*SMLNUM
- IF( CFROM1.EQ.CFROMC ) THEN
-! CFROMC is an inf. Multiply by a correctly signed zero for
-! finite CTOC, or a NaN if CTOC is infinite.
- MUL = CTOC / CFROMC
- DONE = .TRUE.
- CTO1 = CTOC
- ELSE
- CTO1 = CTOC / BIGNUM
- IF( CTO1.EQ.CTOC ) THEN
-! CTOC is either 0 or an inf. In both cases, CTOC itself
-! serves as the correct multiplication factor.
- MUL = CTOC
- DONE = .TRUE.
- CFROMC = ONE
- ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
- MUL = SMLNUM
- DONE = .FALSE.
- CFROMC = CFROM1
- ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
- MUL = BIGNUM
- DONE = .FALSE.
- CTOC = CTO1
- ELSE
- MUL = CTOC / CFROMC
- DONE = .TRUE.
- END IF
- END IF
-*
- IF( ITYPE.EQ.0 ) THEN
-*
-* Full matrix
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- A( I, J ) = A( I, J )*MUL
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE IF( ITYPE.EQ.1 ) THEN
-*
-* Lower triangular matrix
-*
- DO 50 J = 1, N
- DO 40 I = J, M
- A( I, J ) = A( I, J )*MUL
- 40 CONTINUE
- 50 CONTINUE
-*
- ELSE IF( ITYPE.EQ.2 ) THEN
-*
-* Upper triangular matrix
-*
- DO 70 J = 1, N
- DO 60 I = 1, MIN( J, M )
- A( I, J ) = A( I, J )*MUL
- 60 CONTINUE
- 70 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* Upper Hessenberg matrix
-*
- DO 90 J = 1, N
- DO 80 I = 1, MIN( J+1, M )
- A( I, J ) = A( I, J )*MUL
- 80 CONTINUE
- 90 CONTINUE
-*
- ELSE IF( ITYPE.EQ.4 ) THEN
-*
-* Lower half of a symmetric band matrix
-*
- K3 = KL + 1
- K4 = N + 1
- DO 110 J = 1, N
- DO 100 I = 1, MIN( K3, K4-J )
- A( I, J ) = A( I, J )*MUL
- 100 CONTINUE
- 110 CONTINUE
-*
- ELSE IF( ITYPE.EQ.5 ) THEN
-*
-* Upper half of a symmetric band matrix
-*
- K1 = KU + 2
- K3 = KU + 1
- DO 130 J = 1, N
- DO 120 I = MAX( K1-J, 1 ), K3
- A( I, J ) = A( I, J )*MUL
- 120 CONTINUE
- 130 CONTINUE
-*
- ELSE IF( ITYPE.EQ.6 ) THEN
-*
-* Band matrix
-*
- K1 = KL + KU + 2
- K2 = KL + 1
- K3 = 2*KL + KU + 1
- K4 = KL + KU + 1 + M
- DO 150 J = 1, N
- DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
- A( I, J ) = A( I, J )*MUL
- 140 CONTINUE
- 150 CONTINUE
-*
- END IF
-*
- IF( .NOT.DONE )
- $ GO TO 10
-*
- RETURN
-*
-* End of DLASCL
-*
- END
diff --git a/netlib/LAPACK/dlascl2.f b/netlib/LAPACK/dlascl2.f
deleted file mode 100644
index 1016881..0000000
--- a/netlib/LAPACK/dlascl2.f
+++ /dev/null
@@ -1,119 +0,0 @@
-*> \brief \b DLASCL2 performs diagonal scaling on a vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASCL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlascl2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlascl2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlascl2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASCL2 ( M, N, D, X, LDX )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASCL2 performs a diagonal scaling on a vector:
-*> x <-- D * x
-*> where the diagonal matrix D is stored as a vector.
-*>
-*> Eventually to be replaced by BLAS_dge_diag_scale in the new BLAS
-*> standard.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of D and X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of D and X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, length M
-*> Diagonal matrix D, stored as a vector of length M.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,N)
-*> On entry, the vector X to be scaled by D.
-*> On exit, the scaled vector.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the vector X. LDX >= 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASCL2 ( M, N, D, X, LDX )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
- DO J = 1, N
- DO I = 1, M
- X( I, J ) = X( I, J ) * D( I )
- END DO
- END DO
-
- RETURN
- END
diff --git a/netlib/LAPACK/dlasd0.f b/netlib/LAPACK/dlasd0.f
deleted file mode 100644
index 735e630..0000000
--- a/netlib/LAPACK/dlasd0.f
+++ /dev/null
@@ -1,315 +0,0 @@
-*> \brief \b DLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Using a divide and conquer approach, DLASD0 computes the singular
-*> value decomposition (SVD) of a real upper bidiagonal N-by-M
-*> matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
-*> The algorithm computes orthogonal matrices U and VT such that
-*> B = U * S * VT. The singular values S are overwritten on D.
-*>
-*> A related subroutine, DLASDA, computes only the singular values,
-*> and optionally, the singular vectors in compact form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, the row dimension of the upper bidiagonal matrix.
-*> This is also the dimension of the main diagonal array D.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> Specifies the column dimension of the bidiagonal matrix.
-*> = 0: The bidiagonal matrix has column dimension M = N;
-*> = 1: The bidiagonal matrix has column dimension M = N+1;
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry D contains the main diagonal of the bidiagonal
-*> matrix.
-*> On exit D, if INFO = 0, contains its singular values.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (M-1)
-*> Contains the subdiagonal entries of the bidiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension at least (LDQ, N)
-*> On exit, U contains the left singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> On entry, leading dimension of U.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension at least (LDVT, M)
-*> On exit, VT**T contains the right singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> On entry, leading dimension of VT.
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> On entry, maximum size of the subproblems at the
-*> bottom of the computation tree.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER work array.
-*> Dimension must be at least (8 * N)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION work array.
-*> Dimension must be at least (3 * M**2 + 2 * M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
- $ WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, IC, IDXQ, IDXQC, IM1, INODE, ITEMP, IWK,
- $ J, LF, LL, LVL, M, NCC, ND, NDB1, NDIML, NDIMR,
- $ NL, NLF, NLP1, NLVL, NR, NRF, NRP1, SQREI
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASD1, DLASDQ, DLASDT, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -2
- END IF
-*
- M = N + SQRE
-*
- IF( LDU.LT.N ) THEN
- INFO = -6
- ELSE IF( LDVT.LT.M ) THEN
- INFO = -8
- ELSE IF( SMLSIZ.LT.3 ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD0', -INFO )
- RETURN
- END IF
-*
-* If the input matrix is too small, call DLASDQ to find the SVD.
-*
- IF( N.LE.SMLSIZ ) THEN
- CALL DLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDVT, U, LDU, U,
- $ LDU, WORK, INFO )
- RETURN
- END IF
-*
-* Set up the computation tree.
-*
- INODE = 1
- NDIML = INODE + N
- NDIMR = NDIML + N
- IDXQ = NDIMR + N
- IWK = IDXQ + N
- CALL DLASDT( N, NLVL, ND, IWORK( INODE ), IWORK( NDIML ),
- $ IWORK( NDIMR ), SMLSIZ )
-*
-* For the nodes on bottom level of the tree, solve
-* their subproblems by DLASDQ.
-*
- NDB1 = ( ND+1 ) / 2
- NCC = 0
- DO 30 I = NDB1, ND
-*
-* IC : center row of each node
-* NL : number of rows of left subproblem
-* NR : number of rows of right subproblem
-* NLF: starting row of the left subproblem
-* NRF: starting row of the right subproblem
-*
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NLP1 = NL + 1
- NR = IWORK( NDIMR+I1 )
- NRP1 = NR + 1
- NLF = IC - NL
- NRF = IC + 1
- SQREI = 1
- CALL DLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), E( NLF ),
- $ VT( NLF, NLF ), LDVT, U( NLF, NLF ), LDU,
- $ U( NLF, NLF ), LDU, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- ITEMP = IDXQ + NLF - 2
- DO 10 J = 1, NL
- IWORK( ITEMP+J ) = J
- 10 CONTINUE
- IF( I.EQ.ND ) THEN
- SQREI = SQRE
- ELSE
- SQREI = 1
- END IF
- NRP1 = NR + SQREI
- CALL DLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), E( NRF ),
- $ VT( NRF, NRF ), LDVT, U( NRF, NRF ), LDU,
- $ U( NRF, NRF ), LDU, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- ITEMP = IDXQ + IC
- DO 20 J = 1, NR
- IWORK( ITEMP+J-1 ) = J
- 20 CONTINUE
- 30 CONTINUE
-*
-* Now conquer each subproblem bottom-up.
-*
- DO 50 LVL = NLVL, 1, -1
-*
-* Find the first node LF and last node LL on the
-* current level LVL.
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 40 I = LF, LL
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- IF( ( SQRE.EQ.0 ) .AND. ( I.EQ.LL ) ) THEN
- SQREI = SQRE
- ELSE
- SQREI = 1
- END IF
- IDXQC = IDXQ + NLF - 1
- ALPHA = D( IC )
- BETA = E( IC )
- CALL DLASD1( NL, NR, SQREI, D( NLF ), ALPHA, BETA,
- $ U( NLF, NLF ), LDU, VT( NLF, NLF ), LDVT,
- $ IWORK( IDXQC ), IWORK( IWK ), WORK, INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of DLASD0
-*
- END
diff --git a/netlib/LAPACK/dlasd1.f b/netlib/LAPACK/dlasd1.f
deleted file mode 100644
index 8b8ae08..0000000
--- a/netlib/LAPACK/dlasd1.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b DLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT,
-* IDXQ, IWORK, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDU, LDVT, NL, NR, SQRE
-* DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* INTEGER IDXQ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), U( LDU, * ), VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
-*> where N = NL + NR + 1 and M = N + SQRE. DLASD1 is called from DLASD0.
-*>
-*> A related subroutine DLASD7 handles the case in which the singular
-*> values (and the singular vectors in factored form) are desired.
-*>
-*> DLASD1 computes the SVD as follows:
-*>
-*> ( D1(in) 0 0 0 )
-*> B = U(in) * ( Z1**T a Z2**T b ) * VT(in)
-*> ( 0 0 D2(in) 0 )
-*>
-*> = U(out) * ( D(out) 0) * VT(out)
-*>
-*> where Z**T = (Z1**T a Z2**T b) = u**T VT**T, and u is a vector of dimension M
-*> with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
-*> elsewhere; and the entry b is empty if SQRE = 0.
-*>
-*> The left singular vectors of the original matrix are stored in U, and
-*> the transpose of the right singular vectors are stored in VT, and the
-*> singular values are in D. The algorithm consists of three stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple singular values or when there are zeros in
-*> the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine DLASD2.
-*>
-*> The second stage consists of calculating the updated
-*> singular values. This is done by finding the square roots of the
-*> roots of the secular equation via the routine DLASD4 (as called
-*> by DLASD3). This routine also calculates the singular vectors of
-*> the current problem.
-*>
-*> The final stage consists of computing the updated singular vectors
-*> directly using the updated singular values. The singular vectors
-*> for the current problem are multiplied with the singular vectors
-*> from the overall problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has row dimension N = NL + NR + 1,
-*> and column dimension M = N + SQRE.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array,
-*> dimension (N = NL+NR+1).
-*> On entry D(1:NL,1:NL) contains the singular values of the
-*> upper block; and D(NL+2:N) contains the singular values of
-*> the lower block. On exit D(1:N) contains the singular values
-*> of the modified matrix.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in,out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension(LDU,N)
-*> On entry U(1:NL, 1:NL) contains the left singular vectors of
-*> the upper block; U(NL+2:N, NL+2:N) contains the left singular
-*> vectors of the lower block. On exit U contains the left
-*> singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension(LDVT,M)
-*> where M = N + SQRE.
-*> On entry VT(1:NL+1, 1:NL+1)**T contains the right singular
-*> vectors of the upper block; VT(NL+2:M, NL+2:M)**T contains
-*> the right singular vectors of the lower block. On exit
-*> VT**T contains the right singular vectors of the
-*> bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= max( 1, M ).
-*> \endverbatim
-*>
-*> \param[out] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension(N)
-*> This contains the permutation which will reintegrate the
-*> subproblem just solved back into sorted order, i.e.
-*> D( IDXQ( I = 1, N ) ) will be in ascending order.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension( 4 * N )
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension( 3*M**2 + 2*M )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT,
- $ IDXQ, IWORK, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDU, LDVT, NL, NR, SQRE
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
- INTEGER IDXQ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), U( LDU, * ), VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER COLTYP, I, IDX, IDXC, IDXP, IQ, ISIGMA, IU2,
- $ IVT2, IZ, K, LDQ, LDU2, LDVT2, M, N, N1, N2
- DOUBLE PRECISION ORGNRM
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAMRG, DLASCL, DLASD2, DLASD3, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( NL.LT.1 ) THEN
- INFO = -1
- ELSE IF( NR.LT.1 ) THEN
- INFO = -2
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD1', -INFO )
- RETURN
- END IF
-*
- N = NL + NR + 1
- M = N + SQRE
-*
-* The following values are for bookkeeping purposes only. They are
-* integer pointers which indicate the portion of the workspace
-* used by a particular array in DLASD2 and DLASD3.
-*
- LDU2 = N
- LDVT2 = M
-*
- IZ = 1
- ISIGMA = IZ + M
- IU2 = ISIGMA + N
- IVT2 = IU2 + LDU2*N
- IQ = IVT2 + LDVT2*M
-*
- IDX = 1
- IDXC = IDX + N
- COLTYP = IDXC + N
- IDXP = COLTYP + N
-*
-* Scale.
-*
- ORGNRM = MAX( ABS( ALPHA ), ABS( BETA ) )
- D( NL+1 ) = ZERO
- DO 10 I = 1, N
- IF( ABS( D( I ) ).GT.ORGNRM ) THEN
- ORGNRM = ABS( D( I ) )
- END IF
- 10 CONTINUE
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, INFO )
- ALPHA = ALPHA / ORGNRM
- BETA = BETA / ORGNRM
-*
-* Deflate singular values.
-*
- CALL DLASD2( NL, NR, SQRE, K, D, WORK( IZ ), ALPHA, BETA, U, LDU,
- $ VT, LDVT, WORK( ISIGMA ), WORK( IU2 ), LDU2,
- $ WORK( IVT2 ), LDVT2, IWORK( IDXP ), IWORK( IDX ),
- $ IWORK( IDXC ), IDXQ, IWORK( COLTYP ), INFO )
-*
-* Solve Secular Equation and update singular vectors.
-*
- LDQ = K
- CALL DLASD3( NL, NR, SQRE, K, D, WORK( IQ ), LDQ, WORK( ISIGMA ),
- $ U, LDU, WORK( IU2 ), LDU2, VT, LDVT, WORK( IVT2 ),
- $ LDVT2, IWORK( IDXC ), IWORK( COLTYP ), WORK( IZ ),
- $ INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
-*
-* Unscale.
-*
- CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
-*
-* Prepare the IDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL DLAMRG( N1, N2, D, 1, -1, IDXQ )
-*
- RETURN
-*
-* End of DLASD1
-*
- END
diff --git a/netlib/LAPACK/dlasd2.f b/netlib/LAPACK/dlasd2.f
deleted file mode 100644
index 074449c..0000000
--- a/netlib/LAPACK/dlasd2.f
+++ /dev/null
@@ -1,634 +0,0 @@
-*> \brief \b DLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
-* LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
-* IDXC, IDXQ, COLTYP, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
-* DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* INTEGER COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ),
-* $ IDXQ( * )
-* DOUBLE PRECISION D( * ), DSIGMA( * ), U( LDU, * ),
-* $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
-* $ Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASD2 merges the two sets of singular values together into a single
-*> sorted set. Then it tries to deflate the size of the problem.
-*> There are two ways in which deflation can occur: when two or more
-*> singular values are close together or if there is a tiny entry in the
-*> Z vector. For each such occurrence the order of the related secular
-*> equation problem is reduced by one.
-*>
-*> DLASD2 is called from DLASD1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix,
-*> This is the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension(N)
-*> On entry D contains the singular values of the two submatrices
-*> to be combined. On exit D contains the trailing (N-K) updated
-*> singular values (those which were deflated) sorted into
-*> increasing order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension(N)
-*> On exit Z contains the updating row vector in the secular
-*> equation.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension(LDU,N)
-*> On entry U contains the left singular vectors of two
-*> submatrices in the two square blocks with corners at (1,1),
-*> (NL, NL), and (NL+2, NL+2), (N,N).
-*> On exit U contains the trailing (N-K) updated left singular
-*> vectors (those which were deflated) in its last N-K columns.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension(LDVT,M)
-*> On entry VT**T contains the right singular vectors of two
-*> submatrices in the two square blocks with corners at (1,1),
-*> (NL+1, NL+1), and (NL+2, NL+2), (M,M).
-*> On exit VT**T contains the trailing (N-K) updated right singular
-*> vectors (those which were deflated) in its last N-K columns.
-*> In case SQRE =1, the last row of VT spans the right null
-*> space.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= M.
-*> \endverbatim
-*>
-*> \param[out] DSIGMA
-*> \verbatim
-*> DSIGMA is DOUBLE PRECISION array, dimension (N)
-*> Contains a copy of the diagonal elements (K-1 singular values
-*> and one zero) in the secular equation.
-*> \endverbatim
-*>
-*> \param[out] U2
-*> \verbatim
-*> U2 is DOUBLE PRECISION array, dimension(LDU2,N)
-*> Contains a copy of the first K-1 left singular vectors which
-*> will be used by DLASD3 in a matrix multiply (DGEMM) to solve
-*> for the new left singular vectors. U2 is arranged into four
-*> blocks. The first block contains a column with 1 at NL+1 and
-*> zero everywhere else; the second block contains non-zero
-*> entries only at and above NL; the third contains non-zero
-*> entries only below NL+1; and the fourth is dense.
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of the array U2. LDU2 >= N.
-*> \endverbatim
-*>
-*> \param[out] VT2
-*> \verbatim
-*> VT2 is DOUBLE PRECISION array, dimension(LDVT2,N)
-*> VT2**T contains a copy of the first K right singular vectors
-*> which will be used by DLASD3 in a matrix multiply (DGEMM) to
-*> solve for the new right singular vectors. VT2 is arranged into
-*> three blocks. The first block contains a row that corresponds
-*> to the special 0 diagonal element in SIGMA; the second block
-*> contains non-zeros only at and before NL +1; the third block
-*> contains non-zeros only at and after NL +2.
-*> \endverbatim
-*>
-*> \param[in] LDVT2
-*> \verbatim
-*> LDVT2 is INTEGER
-*> The leading dimension of the array VT2. LDVT2 >= M.
-*> \endverbatim
-*>
-*> \param[out] IDXP
-*> \verbatim
-*> IDXP is INTEGER array dimension(N)
-*> This will contain the permutation used to place deflated
-*> values of D at the end of the array. On output IDXP(2:K)
-*> points to the nondeflated D-values and IDXP(K+1:N)
-*> points to the deflated singular values.
-*> \endverbatim
-*>
-*> \param[out] IDX
-*> \verbatim
-*> IDX is INTEGER array dimension(N)
-*> This will contain the permutation used to sort the contents of
-*> D into ascending order.
-*> \endverbatim
-*>
-*> \param[out] IDXC
-*> \verbatim
-*> IDXC is INTEGER array dimension(N)
-*> This will contain the permutation used to arrange the columns
-*> of the deflated U matrix into three groups: the first group
-*> contains non-zero entries only at and above NL, the second
-*> contains non-zero entries only below NL+2, and the third is
-*> dense.
-*> \endverbatim
-*>
-*> \param[in,out] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array dimension(N)
-*> This contains the permutation which separately sorts the two
-*> sub-problems in D into ascending order. Note that entries in
-*> the first hlaf of this permutation must first be moved one
-*> position backward; and entries in the second half
-*> must first have NL+1 added to their values.
-*> \endverbatim
-*>
-*> \param[out] COLTYP
-*> \verbatim
-*> COLTYP is INTEGER array dimension(N)
-*> As workspace, this will contain a label which will indicate
-*> which of the following types a column in the U2 matrix or a
-*> row in the VT2 matrix is:
-*> 1 : non-zero in the upper half only
-*> 2 : non-zero in the lower half only
-*> 3 : dense
-*> 4 : deflated
-*>
-*> On exit, it is an array of dimension 4, with COLTYP(I) being
-*> the dimension of the I-th type columns.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
- $ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
- $ IDXC, IDXQ, COLTYP, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
- INTEGER COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ),
- $ IDXQ( * )
- DOUBLE PRECISION D( * ), DSIGMA( * ), U( LDU, * ),
- $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
- $ Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, EIGHT
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
- $ EIGHT = 8.0D+0 )
-* ..
-* .. Local Arrays ..
- INTEGER CTOT( 4 ), PSM( 4 )
-* ..
-* .. Local Scalars ..
- INTEGER CT, I, IDXI, IDXJ, IDXJP, J, JP, JPREV, K2, M,
- $ N, NLP1, NLP2
- DOUBLE PRECISION C, EPS, HLFTOL, S, TAU, TOL, Z1
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL DLAMCH, DLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DLAMRG, DLASET, DROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( NL.LT.1 ) THEN
- INFO = -1
- ELSE IF( NR.LT.1 ) THEN
- INFO = -2
- ELSE IF( ( SQRE.NE.1 ) .AND. ( SQRE.NE.0 ) ) THEN
- INFO = -3
- END IF
-*
- N = NL + NR + 1
- M = N + SQRE
-*
- IF( LDU.LT.N ) THEN
- INFO = -10
- ELSE IF( LDVT.LT.M ) THEN
- INFO = -12
- ELSE IF( LDU2.LT.N ) THEN
- INFO = -15
- ELSE IF( LDVT2.LT.M ) THEN
- INFO = -17
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD2', -INFO )
- RETURN
- END IF
-*
- NLP1 = NL + 1
- NLP2 = NL + 2
-*
-* Generate the first part of the vector Z; and move the singular
-* values in the first part of D one position backward.
-*
- Z1 = ALPHA*VT( NLP1, NLP1 )
- Z( 1 ) = Z1
- DO 10 I = NL, 1, -1
- Z( I+1 ) = ALPHA*VT( I, NLP1 )
- D( I+1 ) = D( I )
- IDXQ( I+1 ) = IDXQ( I ) + 1
- 10 CONTINUE
-*
-* Generate the second part of the vector Z.
-*
- DO 20 I = NLP2, M
- Z( I ) = BETA*VT( I, NLP2 )
- 20 CONTINUE
-*
-* Initialize some reference arrays.
-*
- DO 30 I = 2, NLP1
- COLTYP( I ) = 1
- 30 CONTINUE
- DO 40 I = NLP2, N
- COLTYP( I ) = 2
- 40 CONTINUE
-*
-* Sort the singular values into increasing order
-*
- DO 50 I = NLP2, N
- IDXQ( I ) = IDXQ( I ) + NLP1
- 50 CONTINUE
-*
-* DSIGMA, IDXC, IDXC, and the first column of U2
-* are used as storage space.
-*
- DO 60 I = 2, N
- DSIGMA( I ) = D( IDXQ( I ) )
- U2( I, 1 ) = Z( IDXQ( I ) )
- IDXC( I ) = COLTYP( IDXQ( I ) )
- 60 CONTINUE
-*
- CALL DLAMRG( NL, NR, DSIGMA( 2 ), 1, 1, IDX( 2 ) )
-*
- DO 70 I = 2, N
- IDXI = 1 + IDX( I )
- D( I ) = DSIGMA( IDXI )
- Z( I ) = U2( IDXI, 1 )
- COLTYP( I ) = IDXC( IDXI )
- 70 CONTINUE
-*
-* Calculate the allowable deflation tolerance
-*
- EPS = DLAMCH( 'Epsilon' )
- TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
- TOL = EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
-*
-* There are 2 kinds of deflation -- first a value in the z-vector
-* is small, second two (or more) singular values are very close
-* together (their difference is small).
-*
-* If the value in the z-vector is small, we simply permute the
-* array so that the corresponding singular value is moved to the
-* end.
-*
-* If two values in the D-vector are close, we perform a two-sided
-* rotation designed to make one of the corresponding z-vector
-* entries zero, and then permute the array so that the deflated
-* singular value is moved to the end.
-*
-* If there are multiple singular values then the problem deflates.
-* Here the number of equal singular values are found. As each equal
-* singular value is found, an elementary reflector is computed to
-* rotate the corresponding singular subspace so that the
-* corresponding components of Z are zero in this new basis.
-*
- K = 1
- K2 = N + 1
- DO 80 J = 2, N
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- COLTYP( J ) = 4
- IF( J.EQ.N )
- $ GO TO 120
- ELSE
- JPREV = J
- GO TO 90
- END IF
- 80 CONTINUE
- 90 CONTINUE
- J = JPREV
- 100 CONTINUE
- J = J + 1
- IF( J.GT.N )
- $ GO TO 110
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- COLTYP( J ) = 4
- ELSE
-*
-* Check if singular values are close enough to allow deflation.
-*
- IF( ABS( D( J )-D( JPREV ) ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- S = Z( JPREV )
- C = Z( J )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = DLAPY2( C, S )
- C = C / TAU
- S = -S / TAU
- Z( J ) = TAU
- Z( JPREV ) = ZERO
-*
-* Apply back the Givens rotation to the left and right
-* singular vector matrices.
-*
- IDXJP = IDXQ( IDX( JPREV )+1 )
- IDXJ = IDXQ( IDX( J )+1 )
- IF( IDXJP.LE.NLP1 ) THEN
- IDXJP = IDXJP - 1
- END IF
- IF( IDXJ.LE.NLP1 ) THEN
- IDXJ = IDXJ - 1
- END IF
- CALL DROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S )
- CALL DROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C,
- $ S )
- IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN
- COLTYP( J ) = 3
- END IF
- COLTYP( JPREV ) = 4
- K2 = K2 - 1
- IDXP( K2 ) = JPREV
- JPREV = J
- ELSE
- K = K + 1
- U2( K, 1 ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
- JPREV = J
- END IF
- END IF
- GO TO 100
- 110 CONTINUE
-*
-* Record the last singular value.
-*
- K = K + 1
- U2( K, 1 ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
-*
- 120 CONTINUE
-*
-* Count up the total number of the various types of columns, then
-* form a permutation which positions the four column types into
-* four groups of uniform structure (although one or more of these
-* groups may be empty).
-*
- DO 130 J = 1, 4
- CTOT( J ) = 0
- 130 CONTINUE
- DO 140 J = 2, N
- CT = COLTYP( J )
- CTOT( CT ) = CTOT( CT ) + 1
- 140 CONTINUE
-*
-* PSM(*) = Position in SubMatrix (of types 1 through 4)
-*
- PSM( 1 ) = 2
- PSM( 2 ) = 2 + CTOT( 1 )
- PSM( 3 ) = PSM( 2 ) + CTOT( 2 )
- PSM( 4 ) = PSM( 3 ) + CTOT( 3 )
-*
-* Fill out the IDXC array so that the permutation which it induces
-* will place all type-1 columns first, all type-2 columns next,
-* then all type-3's, and finally all type-4's, starting from the
-* second column. This applies similarly to the rows of VT.
-*
- DO 150 J = 2, N
- JP = IDXP( J )
- CT = COLTYP( JP )
- IDXC( PSM( CT ) ) = J
- PSM( CT ) = PSM( CT ) + 1
- 150 CONTINUE
-*
-* Sort the singular values and corresponding singular vectors into
-* DSIGMA, U2, and VT2 respectively. The singular values/vectors
-* which were not deflated go into the first K slots of DSIGMA, U2,
-* and VT2 respectively, while those which were deflated go into the
-* last N - K slots, except that the first column/row will be treated
-* separately.
-*
- DO 160 J = 2, N
- JP = IDXP( J )
- DSIGMA( J ) = D( JP )
- IDXJ = IDXQ( IDX( IDXP( IDXC( J ) ) )+1 )
- IF( IDXJ.LE.NLP1 ) THEN
- IDXJ = IDXJ - 1
- END IF
- CALL DCOPY( N, U( 1, IDXJ ), 1, U2( 1, J ), 1 )
- CALL DCOPY( M, VT( IDXJ, 1 ), LDVT, VT2( J, 1 ), LDVT2 )
- 160 CONTINUE
-*
-* Determine DSIGMA(1), DSIGMA(2) and Z(1)
-*
- DSIGMA( 1 ) = ZERO
- HLFTOL = TOL / TWO
- IF( ABS( DSIGMA( 2 ) ).LE.HLFTOL )
- $ DSIGMA( 2 ) = HLFTOL
- IF( M.GT.N ) THEN
- Z( 1 ) = DLAPY2( Z1, Z( M ) )
- IF( Z( 1 ).LE.TOL ) THEN
- C = ONE
- S = ZERO
- Z( 1 ) = TOL
- ELSE
- C = Z1 / Z( 1 )
- S = Z( M ) / Z( 1 )
- END IF
- ELSE
- IF( ABS( Z1 ).LE.TOL ) THEN
- Z( 1 ) = TOL
- ELSE
- Z( 1 ) = Z1
- END IF
- END IF
-*
-* Move the rest of the updating row to Z.
-*
- CALL DCOPY( K-1, U2( 2, 1 ), 1, Z( 2 ), 1 )
-*
-* Determine the first column of U2, the first row of VT2 and the
-* last row of VT.
-*
- CALL DLASET( 'A', N, 1, ZERO, ZERO, U2, LDU2 )
- U2( NLP1, 1 ) = ONE
- IF( M.GT.N ) THEN
- DO 170 I = 1, NLP1
- VT( M, I ) = -S*VT( NLP1, I )
- VT2( 1, I ) = C*VT( NLP1, I )
- 170 CONTINUE
- DO 180 I = NLP2, M
- VT2( 1, I ) = S*VT( M, I )
- VT( M, I ) = C*VT( M, I )
- 180 CONTINUE
- ELSE
- CALL DCOPY( M, VT( NLP1, 1 ), LDVT, VT2( 1, 1 ), LDVT2 )
- END IF
- IF( M.GT.N ) THEN
- CALL DCOPY( M, VT( M, 1 ), LDVT, VT2( M, 1 ), LDVT2 )
- END IF
-*
-* The deflated singular values and their corresponding vectors go
-* into the back of D, U, and V respectively.
-*
- IF( N.GT.K ) THEN
- CALL DCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
- CALL DLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ),
- $ LDU )
- CALL DLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ),
- $ LDVT )
- END IF
-*
-* Copy CTOT into COLTYP for referencing in DLASD3.
-*
- DO 190 J = 1, 4
- COLTYP( J ) = CTOT( J )
- 190 CONTINUE
-*
- RETURN
-*
-* End of DLASD2
-*
- END
diff --git a/netlib/LAPACK/dlasd3.f b/netlib/LAPACK/dlasd3.f
deleted file mode 100644
index 8a07389..0000000
--- a/netlib/LAPACK/dlasd3.f
+++ /dev/null
@@ -1,470 +0,0 @@
-*> \brief \b DLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and Z, and then updates the singular vectors by matrix multiplication. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2,
-* LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR,
-* $ SQRE
-* ..
-* .. Array Arguments ..
-* INTEGER CTOT( * ), IDXC( * )
-* DOUBLE PRECISION D( * ), DSIGMA( * ), Q( LDQ, * ), U( LDU, * ),
-* $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
-* $ Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASD3 finds all the square roots of the roots of the secular
-*> equation, as defined by the values in D and Z. It makes the
-*> appropriate calls to DLASD4 and then updates the singular
-*> vectors by matrix multiplication.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*>
-*> DLASD3 is called from DLASD1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The size of the secular equation, 1 =< K = < N.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension(K)
-*> On exit the square roots of the roots of the secular equation,
-*> in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array,
-*> dimension at least (LDQ,K).
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= K.
-*> \endverbatim
-*>
-*> \param[in] DSIGMA
-*> \verbatim
-*> DSIGMA is DOUBLE PRECISION array, dimension(K)
-*> The first K elements of this array contain the old roots
-*> of the deflated updating problem. These are the poles
-*> of the secular equation.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU, N)
-*> The last N - K columns of this matrix contain the deflated
-*> left singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= N.
-*> \endverbatim
-*>
-*> \param[in,out] U2
-*> \verbatim
-*> U2 is DOUBLE PRECISION array, dimension (LDU2, N)
-*> The first K columns of this matrix contain the non-deflated
-*> left singular vectors for the split problem.
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of the array U2. LDU2 >= N.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT, M)
-*> The last M - K columns of VT**T contain the deflated
-*> right singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VT2
-*> \verbatim
-*> VT2 is DOUBLE PRECISION array, dimension (LDVT2, N)
-*> The first K columns of VT2**T contain the non-deflated
-*> right singular vectors for the split problem.
-*> \endverbatim
-*>
-*> \param[in] LDVT2
-*> \verbatim
-*> LDVT2 is INTEGER
-*> The leading dimension of the array VT2. LDVT2 >= N.
-*> \endverbatim
-*>
-*> \param[in] IDXC
-*> \verbatim
-*> IDXC is INTEGER array, dimension ( N )
-*> The permutation used to arrange the columns of U (and rows of
-*> VT) into three groups: the first group contains non-zero
-*> entries only at and above (or before) NL +1; the second
-*> contains non-zero entries only at and below (or after) NL+2;
-*> and the third is dense. The first column of U and the row of
-*> VT are treated separately, however.
-*>
-*> The rows of the singular vectors found by DLASD4
-*> must be likewise permuted before the matrix multiplies can
-*> take place.
-*> \endverbatim
-*>
-*> \param[in] CTOT
-*> \verbatim
-*> CTOT is INTEGER array, dimension ( 4 )
-*> A count of the total number of the various types of columns
-*> in U (or rows in VT), as described in IDXC. The fourth column
-*> type is any column which has been deflated.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (K)
-*> The first K elements of this array contain the components
-*> of the deflation-adjusted updating row vector.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2,
- $ LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR,
- $ SQRE
-* ..
-* .. Array Arguments ..
- INTEGER CTOT( * ), IDXC( * )
- DOUBLE PRECISION D( * ), DSIGMA( * ), Q( LDQ, * ), U( LDU, * ),
- $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
- $ Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO, NEGONE
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0,
- $ NEGONE = -1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER CTEMP, I, J, JC, KTEMP, M, N, NLP1, NLP2, NRP1
- DOUBLE PRECISION RHO, TEMP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3, DNRM2
- EXTERNAL DLAMC3, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DLACPY, DLASCL, DLASD4, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( NL.LT.1 ) THEN
- INFO = -1
- ELSE IF( NR.LT.1 ) THEN
- INFO = -2
- ELSE IF( ( SQRE.NE.1 ) .AND. ( SQRE.NE.0 ) ) THEN
- INFO = -3
- END IF
-*
- N = NL + NR + 1
- M = N + SQRE
- NLP1 = NL + 1
- NLP2 = NL + 2
-*
- IF( ( K.LT.1 ) .OR. ( K.GT.N ) ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.K ) THEN
- INFO = -7
- ELSE IF( LDU.LT.N ) THEN
- INFO = -10
- ELSE IF( LDU2.LT.N ) THEN
- INFO = -12
- ELSE IF( LDVT.LT.M ) THEN
- INFO = -14
- ELSE IF( LDVT2.LT.M ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD3', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.1 ) THEN
- D( 1 ) = ABS( Z( 1 ) )
- CALL DCOPY( M, VT2( 1, 1 ), LDVT2, VT( 1, 1 ), LDVT )
- IF( Z( 1 ).GT.ZERO ) THEN
- CALL DCOPY( N, U2( 1, 1 ), 1, U( 1, 1 ), 1 )
- ELSE
- DO 10 I = 1, N
- U( I, 1 ) = -U2( I, 1 )
- 10 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Modify values DSIGMA(i) to make sure all DSIGMA(i)-DSIGMA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DSIGMA(I) by 2*DSIGMA(I)-DSIGMA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DSIGMA(I) if it is 1; this makes the subsequent
-* subtractions DSIGMA(I)-DSIGMA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DSIGMA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DSIGMA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DSIGMA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 20 I = 1, K
- DSIGMA( I ) = DLAMC3( DSIGMA( I ), DSIGMA( I ) ) - DSIGMA( I )
- 20 CONTINUE
-*
-* Keep a copy of Z.
-*
- CALL DCOPY( K, Z, 1, Q, 1 )
-*
-* Normalize Z.
-*
- RHO = DNRM2( K, Z, 1 )
- CALL DLASCL( 'G', 0, 0, RHO, ONE, K, 1, Z, K, INFO )
- RHO = RHO*RHO
-*
-* Find the new singular values.
-*
- DO 30 J = 1, K
- CALL DLASD4( K, J, DSIGMA, Z, U( 1, J ), RHO, D( J ),
- $ VT( 1, J ), INFO )
-*
-* If the zero finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- 30 CONTINUE
-*
-* Compute updated Z.
-*
- DO 60 I = 1, K
- Z( I ) = U( I, K )*VT( I, K )
- DO 40 J = 1, I - 1
- Z( I ) = Z( I )*( U( I, J )*VT( I, J ) /
- $ ( DSIGMA( I )-DSIGMA( J ) ) /
- $ ( DSIGMA( I )+DSIGMA( J ) ) )
- 40 CONTINUE
- DO 50 J = I, K - 1
- Z( I ) = Z( I )*( U( I, J )*VT( I, J ) /
- $ ( DSIGMA( I )-DSIGMA( J+1 ) ) /
- $ ( DSIGMA( I )+DSIGMA( J+1 ) ) )
- 50 CONTINUE
- Z( I ) = SIGN( SQRT( ABS( Z( I ) ) ), Q( I, 1 ) )
- 60 CONTINUE
-*
-* Compute left singular vectors of the modified diagonal matrix,
-* and store related information for the right singular vectors.
-*
- DO 90 I = 1, K
- VT( 1, I ) = Z( 1 ) / U( 1, I ) / VT( 1, I )
- U( 1, I ) = NEGONE
- DO 70 J = 2, K
- VT( J, I ) = Z( J ) / U( J, I ) / VT( J, I )
- U( J, I ) = DSIGMA( J )*VT( J, I )
- 70 CONTINUE
- TEMP = DNRM2( K, U( 1, I ), 1 )
- Q( 1, I ) = U( 1, I ) / TEMP
- DO 80 J = 2, K
- JC = IDXC( J )
- Q( J, I ) = U( JC, I ) / TEMP
- 80 CONTINUE
- 90 CONTINUE
-*
-* Update the left singular vector matrix.
-*
- IF( K.EQ.2 ) THEN
- CALL DGEMM( 'N', 'N', N, K, K, ONE, U2, LDU2, Q, LDQ, ZERO, U,
- $ LDU )
- GO TO 100
- END IF
- IF( CTOT( 1 ).GT.0 ) THEN
- CALL DGEMM( 'N', 'N', NL, K, CTOT( 1 ), ONE, U2( 1, 2 ), LDU2,
- $ Q( 2, 1 ), LDQ, ZERO, U( 1, 1 ), LDU )
- IF( CTOT( 3 ).GT.0 ) THEN
- KTEMP = 2 + CTOT( 1 ) + CTOT( 2 )
- CALL DGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, KTEMP ),
- $ LDU2, Q( KTEMP, 1 ), LDQ, ONE, U( 1, 1 ), LDU )
- END IF
- ELSE IF( CTOT( 3 ).GT.0 ) THEN
- KTEMP = 2 + CTOT( 1 ) + CTOT( 2 )
- CALL DGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, KTEMP ),
- $ LDU2, Q( KTEMP, 1 ), LDQ, ZERO, U( 1, 1 ), LDU )
- ELSE
- CALL DLACPY( 'F', NL, K, U2, LDU2, U, LDU )
- END IF
- CALL DCOPY( K, Q( 1, 1 ), LDQ, U( NLP1, 1 ), LDU )
- KTEMP = 2 + CTOT( 1 )
- CTEMP = CTOT( 2 ) + CTOT( 3 )
- CALL DGEMM( 'N', 'N', NR, K, CTEMP, ONE, U2( NLP2, KTEMP ), LDU2,
- $ Q( KTEMP, 1 ), LDQ, ZERO, U( NLP2, 1 ), LDU )
-*
-* Generate the right singular vectors.
-*
- 100 CONTINUE
- DO 120 I = 1, K
- TEMP = DNRM2( K, VT( 1, I ), 1 )
- Q( I, 1 ) = VT( 1, I ) / TEMP
- DO 110 J = 2, K
- JC = IDXC( J )
- Q( I, J ) = VT( JC, I ) / TEMP
- 110 CONTINUE
- 120 CONTINUE
-*
-* Update the right singular vector matrix.
-*
- IF( K.EQ.2 ) THEN
- CALL DGEMM( 'N', 'N', K, M, K, ONE, Q, LDQ, VT2, LDVT2, ZERO,
- $ VT, LDVT )
- RETURN
- END IF
- KTEMP = 1 + CTOT( 1 )
- CALL DGEMM( 'N', 'N', K, NLP1, KTEMP, ONE, Q( 1, 1 ), LDQ,
- $ VT2( 1, 1 ), LDVT2, ZERO, VT( 1, 1 ), LDVT )
- KTEMP = 2 + CTOT( 1 ) + CTOT( 2 )
- IF( KTEMP.LE.LDVT2 )
- $ CALL DGEMM( 'N', 'N', K, NLP1, CTOT( 3 ), ONE, Q( 1, KTEMP ),
- $ LDQ, VT2( KTEMP, 1 ), LDVT2, ONE, VT( 1, 1 ),
- $ LDVT )
-*
- KTEMP = CTOT( 1 ) + 1
- NRP1 = NR + SQRE
- IF( KTEMP.GT.1 ) THEN
- DO 130 I = 1, K
- Q( I, KTEMP ) = Q( I, 1 )
- 130 CONTINUE
- DO 140 I = NLP2, M
- VT2( KTEMP, I ) = VT2( 1, I )
- 140 CONTINUE
- END IF
- CTEMP = 1 + CTOT( 2 ) + CTOT( 3 )
- CALL DGEMM( 'N', 'N', K, NRP1, CTEMP, ONE, Q( 1, KTEMP ), LDQ,
- $ VT2( KTEMP, NLP2 ), LDVT2, ZERO, VT( 1, NLP2 ), LDVT )
-*
- RETURN
-*
-* End of DLASD3
-*
- END
diff --git a/netlib/LAPACK/dlasd4.f b/netlib/LAPACK/dlasd4.f
deleted file mode 100644
index 877560c..0000000
--- a/netlib/LAPACK/dlasd4.f
+++ /dev/null
@@ -1,1057 +0,0 @@
-*> \brief \b DLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modification to a positive diagonal matrix. Used by dbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER I, INFO, N
-* DOUBLE PRECISION RHO, SIGMA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DELTA( * ), WORK( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the square root of the I-th updated
-*> eigenvalue of a positive symmetric rank-one modification to
-*> a positive diagonal matrix whose entries are given as the squares
-*> of the corresponding entries in the array d, and that
-*>
-*> 0 <= D(i) < D(j) for i < j
-*>
-*> and that RHO > 0. This is arranged by the calling routine, and is
-*> no loss in generality. The rank-one modified system is thus
-*>
-*> diag( D ) * diag( D ) + RHO * Z * Z_transpose.
-*>
-*> where we assume the Euclidean norm of Z is 1.
-*>
-*> The method consists of approximating the rational functions in the
-*> secular equation by simpler interpolating rational functions.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of all arrays.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. 1 <= I <= N.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( N )
-*> The original eigenvalues. It is assumed that they are in
-*> order, 0 <= D(I) < D(J) for I < J.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( N )
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is DOUBLE PRECISION array, dimension ( N )
-*> If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
-*> component. If N = 1, then DELTA(1) = 1. The vector DELTA
-*> contains the information necessary to construct the
-*> (singular) eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> The computed sigma_I, the I-th updated eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( N )
-*> If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
-*> component. If N = 1, then WORK( 1 ) = 1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = 1, the updating process failed.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> Logical variable ORGATI (origin-at-i?) is used for distinguishing
-*> whether D(i) or D(i+1) is treated as the origin.
-*>
-*> ORGATI = .true. origin at i
-*> ORGATI = .false. origin at i+1
-*>
-*> Logical variable SWTCH3 (switch-for-3-poles?) is for noting
-*> if we are working with THREE poles!
-*>
-*> MAXIT is the maximum number of iterations allowed for each
-*> eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I, INFO, N
- DOUBLE PRECISION RHO, SIGMA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DELTA( * ), WORK( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 400 )
- DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR, EIGHT, TEN
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
- $ THREE = 3.0D+0, FOUR = 4.0D+0, EIGHT = 8.0D+0,
- $ TEN = 10.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ORGATI, SWTCH, SWTCH3, GEOMAVG
- INTEGER II, IIM1, IIP1, IP1, ITER, J, NITER
- DOUBLE PRECISION A, B, C, DELSQ, DELSQ2, SQ2, DPHI, DPSI, DTIIM,
- $ DTIIP, DTIPSQ, DTISQ, DTNSQ, DTNSQ1, DW, EPS,
- $ ERRETM, ETA, PHI, PREW, PSI, RHOINV, SGLB,
- $ SGUB, TAU, TAU2, TEMP, TEMP1, TEMP2, W
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DD( 3 ), ZZ( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAED6, DLASD5
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Since this routine is called in an inner loop, we do no argument
-* checking.
-*
-* Quick return for N=1 and 2.
-*
- INFO = 0
- IF( N.EQ.1 ) THEN
-*
-* Presumably, I=1 upon entry
-*
- SIGMA = SQRT( D( 1 )*D( 1 )+RHO*Z( 1 )*Z( 1 ) )
- DELTA( 1 ) = ONE
- WORK( 1 ) = ONE
- RETURN
- END IF
- IF( N.EQ.2 ) THEN
- CALL DLASD5( I, D, Z, DELTA, RHO, SIGMA, WORK )
- RETURN
- END IF
-*
-* Compute machine epsilon
-*
- EPS = DLAMCH( 'Epsilon' )
- RHOINV = ONE / RHO
-*
-* The case I = N
-*
- IF( I.EQ.N ) THEN
-*
-* Initialize some basic variables
-*
- II = N - 1
- NITER = 1
-*
-* Calculate initial guess
-*
- TEMP = RHO / TWO
-*
-* If ||Z||_2 is not one, then TEMP should be set to
-* RHO * ||Z||_2^2 / TWO
-*
- TEMP1 = TEMP / ( D( N )+SQRT( D( N )*D( N )+TEMP ) )
- DO 10 J = 1, N
- WORK( J ) = D( J ) + D( N ) + TEMP1
- DELTA( J ) = ( D( J )-D( N ) ) - TEMP1
- 10 CONTINUE
-*
- PSI = ZERO
- DO 20 J = 1, N - 2
- PSI = PSI + Z( J )*Z( J ) / ( DELTA( J )*WORK( J ) )
- 20 CONTINUE
-*
- C = RHOINV + PSI
- W = C + Z( II )*Z( II ) / ( DELTA( II )*WORK( II ) ) +
- $ Z( N )*Z( N ) / ( DELTA( N )*WORK( N ) )
-*
- IF( W.LE.ZERO ) THEN
- TEMP1 = SQRT( D( N )*D( N )+RHO )
- TEMP = Z( N-1 )*Z( N-1 ) / ( ( D( N-1 )+TEMP1 )*
- $ ( D( N )-D( N-1 )+RHO / ( D( N )+TEMP1 ) ) ) +
- $ Z( N )*Z( N ) / RHO
-*
-* The following TAU2 is to approximate
-* SIGMA_n^2 - D( N )*D( N )
-*
- IF( C.LE.TEMP ) THEN
- TAU = RHO
- ELSE
- DELSQ = ( D( N )-D( N-1 ) )*( D( N )+D( N-1 ) )
- A = -C*DELSQ + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DELSQ
- IF( A.LT.ZERO ) THEN
- TAU2 = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
- END IF
-*
-* It can be proved that
-* D(N)^2+RHO/2 <= SIGMA_n^2 < D(N)^2+TAU2 <= D(N)^2+RHO
-*
- ELSE
- DELSQ = ( D( N )-D( N-1 ) )*( D( N )+D( N-1 ) )
- A = -C*DELSQ + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DELSQ
-*
-* The following TAU2 is to approximate
-* SIGMA_n^2 - D( N )*D( N )
-*
- IF( A.LT.ZERO ) THEN
- TAU2 = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
-*
-* It can be proved that
-* D(N)^2 < D(N)^2+TAU2 < SIGMA(N)^2 < D(N)^2+RHO/2
-*
- END IF
-*
-* The following TAU is to approximate SIGMA_n - D( N )
-*
- TAU = TAU2 / ( D( N )+SQRT( D( N )*D( N )+TAU2 ) )
-*
- SIGMA = D( N ) + TAU
- DO 30 J = 1, N
- DELTA( J ) = ( D( J )-D( N ) ) - TAU
- WORK( J ) = D( J ) + D( N ) + TAU
- 30 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 40 J = 1, II
- TEMP = Z( J ) / ( DELTA( J )*WORK( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 40 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / ( DELTA( N )*WORK( N ) )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV
-* $ + ABS( TAU2 )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- GO TO 240
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- DTNSQ1 = WORK( N-1 )*DELTA( N-1 )
- DTNSQ = WORK( N )*DELTA( N )
- C = W - DTNSQ1*DPSI - DTNSQ*DPHI
- A = ( DTNSQ+DTNSQ1 )*W - DTNSQ*DTNSQ1*( DPSI+DPHI )
- B = DTNSQ*DTNSQ1*W
- IF( C.LT.ZERO )
- $ C = ABS( C )
- IF( C.EQ.ZERO ) THEN
- ETA = RHO - SIGMA*SIGMA
- ELSE IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = ETA - DTNSQ
- IF( TEMP.GT.RHO )
- $ ETA = RHO + DTNSQ
-*
- ETA = ETA / ( SIGMA+SQRT( ETA+SIGMA*SIGMA ) )
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 50 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- WORK( J ) = WORK( J ) + ETA
- 50 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 60 J = 1, II
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 60 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TAU2 = WORK( N )*DELTA( N )
- TEMP = Z( N ) / TAU2
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV
-* $ + ABS( TAU2 )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Main loop to update the values of the array DELTA
-*
- ITER = NITER + 1
-*
- DO 90 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- GO TO 240
- END IF
-*
-* Calculate the new step
-*
- DTNSQ1 = WORK( N-1 )*DELTA( N-1 )
- DTNSQ = WORK( N )*DELTA( N )
- C = W - DTNSQ1*DPSI - DTNSQ*DPHI
- A = ( DTNSQ+DTNSQ1 )*W - DTNSQ1*DTNSQ*( DPSI+DPHI )
- B = DTNSQ1*DTNSQ*W
- IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = ETA - DTNSQ
- IF( TEMP.LE.ZERO )
- $ ETA = ETA / TWO
-*
- ETA = ETA / ( SIGMA+SQRT( ETA+SIGMA*SIGMA ) )
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 70 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- WORK( J ) = WORK( J ) + ETA
- 70 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 80 J = 1, II
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 80 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TAU2 = WORK( N )*DELTA( N )
- TEMP = Z( N ) / TAU2
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV
-* $ + ABS( TAU2 )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
- 90 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
- GO TO 240
-*
-* End for the case I = N
-*
- ELSE
-*
-* The case for I < N
-*
- NITER = 1
- IP1 = I + 1
-*
-* Calculate initial guess
-*
- DELSQ = ( D( IP1 )-D( I ) )*( D( IP1 )+D( I ) )
- DELSQ2 = DELSQ / TWO
- SQ2=SQRT( ( D( I )*D( I )+D( IP1 )*D( IP1 ) ) / TWO )
- TEMP = DELSQ2 / ( D( I )+SQ2 )
- DO 100 J = 1, N
- WORK( J ) = D( J ) + D( I ) + TEMP
- DELTA( J ) = ( D( J )-D( I ) ) - TEMP
- 100 CONTINUE
-*
- PSI = ZERO
- DO 110 J = 1, I - 1
- PSI = PSI + Z( J )*Z( J ) / ( WORK( J )*DELTA( J ) )
- 110 CONTINUE
-*
- PHI = ZERO
- DO 120 J = N, I + 2, -1
- PHI = PHI + Z( J )*Z( J ) / ( WORK( J )*DELTA( J ) )
- 120 CONTINUE
- C = RHOINV + PSI + PHI
- W = C + Z( I )*Z( I ) / ( WORK( I )*DELTA( I ) ) +
- $ Z( IP1 )*Z( IP1 ) / ( WORK( IP1 )*DELTA( IP1 ) )
-*
- GEOMAVG = .FALSE.
- IF( W.GT.ZERO ) THEN
-*
-* d(i)^2 < the ith sigma^2 < (d(i)^2+d(i+1)^2)/2
-*
-* We choose d(i) as origin.
-*
- ORGATI = .TRUE.
- II = I
- SGLB = ZERO
- SGUB = DELSQ2 / ( D( I )+SQ2 )
- A = C*DELSQ + Z( I )*Z( I ) + Z( IP1 )*Z( IP1 )
- B = Z( I )*Z( I )*DELSQ
- IF( A.GT.ZERO ) THEN
- TAU2 = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- ELSE
- TAU2 = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- END IF
-*
-* TAU2 now is an estimation of SIGMA^2 - D( I )^2. The
-* following, however, is the corresponding estimation of
-* SIGMA - D( I ).
-*
- TAU = TAU2 / ( D( I )+SQRT( D( I )*D( I )+TAU2 ) )
- TEMP = SQRT(EPS)
- IF( (D(I).LE.TEMP*D(IP1)).AND.(ABS(Z(I)).LE.TEMP)
- $ .AND.(D(I).GT.ZERO) ) THEN
- TAU = MIN( TEN*D(I), SGUB )
- GEOMAVG = .TRUE.
- END IF
- ELSE
-*
-* (d(i)^2+d(i+1)^2)/2 <= the ith sigma^2 < d(i+1)^2/2
-*
-* We choose d(i+1) as origin.
-*
- ORGATI = .FALSE.
- II = IP1
- SGLB = -DELSQ2 / ( D( II )+SQ2 )
- SGUB = ZERO
- A = C*DELSQ - Z( I )*Z( I ) - Z( IP1 )*Z( IP1 )
- B = Z( IP1 )*Z( IP1 )*DELSQ
- IF( A.LT.ZERO ) THEN
- TAU2 = TWO*B / ( A-SQRT( ABS( A*A+FOUR*B*C ) ) )
- ELSE
- TAU2 = -( A+SQRT( ABS( A*A+FOUR*B*C ) ) ) / ( TWO*C )
- END IF
-*
-* TAU2 now is an estimation of SIGMA^2 - D( IP1 )^2. The
-* following, however, is the corresponding estimation of
-* SIGMA - D( IP1 ).
-*
- TAU = TAU2 / ( D( IP1 )+SQRT( ABS( D( IP1 )*D( IP1 )+
- $ TAU2 ) ) )
- END IF
-*
- SIGMA = D( II ) + TAU
- DO 130 J = 1, N
- WORK( J ) = D( J ) + D( II ) + TAU
- DELTA( J ) = ( D( J )-D( II ) ) - TAU
- 130 CONTINUE
- IIM1 = II - 1
- IIP1 = II + 1
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 150 J = 1, IIM1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 150 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 160 J = N, IIP1, -1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 160 CONTINUE
-*
- W = RHOINV + PHI + PSI
-*
-* W is the value of the secular function with
-* its ii-th element removed.
-*
- SWTCH3 = .FALSE.
- IF( ORGATI ) THEN
- IF( W.LT.ZERO )
- $ SWTCH3 = .TRUE.
- ELSE
- IF( W.GT.ZERO )
- $ SWTCH3 = .TRUE.
- END IF
- IF( II.EQ.1 .OR. II.EQ.N )
- $ SWTCH3 = .FALSE.
-*
- TEMP = Z( II ) / ( WORK( II )*DELTA( II ) )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = W + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV
- $ + THREE*ABS( TEMP )
-* $ + ABS( TAU2 )*DW
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- GO TO 240
- END IF
-*
- IF( W.LE.ZERO ) THEN
- SGLB = MAX( SGLB, TAU )
- ELSE
- SGUB = MIN( SGUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- IF( .NOT.SWTCH3 ) THEN
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I ) / DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 ) / DTIPSQ )**2
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) + DTISQ*DTISQ*( DPSI+DPHI )
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- DTIIM = WORK( IIM1 )*DELTA( IIM1 )
- DTIIP = WORK( IIP1 )*DELTA( IIP1 )
- TEMP = RHOINV + PSI + PHI
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DTIIM
- TEMP1 = TEMP1*TEMP1
- C = ( TEMP - DTIIP*( DPSI+DPHI ) ) -
- $ ( D( IIM1 )-D( IIP1 ) )*( D( IIM1 )+D( IIP1 ) )*TEMP1
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- IF( DPSI.LT.TEMP1 ) THEN
- ZZ( 3 ) = DTIIP*DTIIP*DPHI
- ELSE
- ZZ( 3 ) = DTIIP*DTIIP*( ( DPSI-TEMP1 )+DPHI )
- END IF
- ELSE
- TEMP1 = Z( IIP1 ) / DTIIP
- TEMP1 = TEMP1*TEMP1
- C = ( TEMP - DTIIM*( DPSI+DPHI ) ) -
- $ ( D( IIP1 )-D( IIM1 ) )*( D( IIM1 )+D( IIP1 ) )*TEMP1
- IF( DPHI.LT.TEMP1 ) THEN
- ZZ( 1 ) = DTIIM*DTIIM*DPSI
- ELSE
- ZZ( 1 ) = DTIIM*DTIIM*( DPSI+( DPHI-TEMP1 ) )
- END IF
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- ZZ( 2 ) = Z( II )*Z( II )
- DD( 1 ) = DTIIM
- DD( 2 ) = DELTA( II )*WORK( II )
- DD( 3 ) = DTIIP
- CALL DLAED6( NITER, ORGATI, C, DD, ZZ, W, ETA, INFO )
-*
- IF( INFO.NE.0 ) THEN
-*
-* If INFO is not 0, i.e., DLAED6 failed, switch back
-* to 2 pole interpolation.
-*
- SWTCH3 = .FALSE.
- INFO = 0
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I ) / DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 ) / DTIPSQ )**2
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) + DTISQ*DTISQ*( DPSI+DPHI)
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- END IF
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
-*
- ETA = ETA / ( SIGMA+SQRT( SIGMA*SIGMA+ETA ) )
- TEMP = TAU + ETA
- IF( TEMP.GT.SGUB .OR. TEMP.LT.SGLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( SGUB-TAU ) / TWO
- ELSE
- ETA = ( SGLB-TAU ) / TWO
- END IF
- IF( GEOMAVG ) THEN
- IF( W .LT. ZERO ) THEN
- IF( TAU .GT. ZERO ) THEN
- ETA = SQRT(SGUB*TAU)-TAU
- END IF
- ELSE
- IF( SGLB .GT. ZERO ) THEN
- ETA = SQRT(SGLB*TAU)-TAU
- END IF
- END IF
- END IF
- END IF
-*
- PREW = W
-*
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 170 J = 1, N
- WORK( J ) = WORK( J ) + ETA
- DELTA( J ) = DELTA( J ) - ETA
- 170 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 180 J = 1, IIM1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 180 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 190 J = N, IIP1, -1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 190 CONTINUE
-*
- TAU2 = WORK( II )*DELTA( II )
- TEMP = Z( II ) / TAU2
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV
- $ + THREE*ABS( TEMP )
-* $ + ABS( TAU2 )*DW
-*
- SWTCH = .FALSE.
- IF( ORGATI ) THEN
- IF( -W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- ELSE
- IF( W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- END IF
-*
-* Main loop to update the values of the array DELTA and WORK
-*
- ITER = NITER + 1
-*
- DO 230 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
-* $ .OR. (SGUB-SGLB).LE.EIGHT*ABS(SGUB+SGLB) ) THEN
- GO TO 240
- END IF
-*
- IF( W.LE.ZERO ) THEN
- SGLB = MAX( SGLB, TAU )
- ELSE
- SGUB = MIN( SGUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- IF( .NOT.SWTCH3 ) THEN
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I ) / DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 ) / DTIPSQ )**2
- END IF
- ELSE
- TEMP = Z( II ) / ( WORK( II )*DELTA( II ) )
- IF( ORGATI ) THEN
- DPSI = DPSI + TEMP*TEMP
- ELSE
- DPHI = DPHI + TEMP*TEMP
- END IF
- C = W - DTISQ*DPSI - DTIPSQ*DPHI
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*
- $ ( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) +
- $ DTISQ*DTISQ*( DPSI+DPHI )
- END IF
- ELSE
- A = DTISQ*DTISQ*DPSI + DTIPSQ*DTIPSQ*DPHI
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- DTIIM = WORK( IIM1 )*DELTA( IIM1 )
- DTIIP = WORK( IIP1 )*DELTA( IIP1 )
- TEMP = RHOINV + PSI + PHI
- IF( SWTCH ) THEN
- C = TEMP - DTIIM*DPSI - DTIIP*DPHI
- ZZ( 1 ) = DTIIM*DTIIM*DPSI
- ZZ( 3 ) = DTIIP*DTIIP*DPHI
- ELSE
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DTIIM
- TEMP1 = TEMP1*TEMP1
- TEMP2 = ( D( IIM1 )-D( IIP1 ) )*
- $ ( D( IIM1 )+D( IIP1 ) )*TEMP1
- C = TEMP - DTIIP*( DPSI+DPHI ) - TEMP2
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- IF( DPSI.LT.TEMP1 ) THEN
- ZZ( 3 ) = DTIIP*DTIIP*DPHI
- ELSE
- ZZ( 3 ) = DTIIP*DTIIP*( ( DPSI-TEMP1 )+DPHI )
- END IF
- ELSE
- TEMP1 = Z( IIP1 ) / DTIIP
- TEMP1 = TEMP1*TEMP1
- TEMP2 = ( D( IIP1 )-D( IIM1 ) )*
- $ ( D( IIM1 )+D( IIP1 ) )*TEMP1
- C = TEMP - DTIIM*( DPSI+DPHI ) - TEMP2
- IF( DPHI.LT.TEMP1 ) THEN
- ZZ( 1 ) = DTIIM*DTIIM*DPSI
- ELSE
- ZZ( 1 ) = DTIIM*DTIIM*( DPSI+( DPHI-TEMP1 ) )
- END IF
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- END IF
- DD( 1 ) = DTIIM
- DD( 2 ) = DELTA( II )*WORK( II )
- DD( 3 ) = DTIIP
- CALL DLAED6( NITER, ORGATI, C, DD, ZZ, W, ETA, INFO )
-*
- IF( INFO.NE.0 ) THEN
-*
-* If INFO is not 0, i.e., DLAED6 failed, switch
-* back to two pole interpolation
-*
- SWTCH3 = .FALSE.
- INFO = 0
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I )/DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 )/DTIPSQ )**2
- END IF
- ELSE
- TEMP = Z( II ) / ( WORK( II )*DELTA( II ) )
- IF( ORGATI ) THEN
- DPSI = DPSI + TEMP*TEMP
- ELSE
- DPHI = DPHI + TEMP*TEMP
- END IF
- C = W - DTISQ*DPSI - DTIPSQ*DPHI
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*
- $ ( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) +
- $ DTISQ*DTISQ*( DPSI+DPHI )
- END IF
- ELSE
- A = DTISQ*DTISQ*DPSI + DTIPSQ*DTIPSQ*DPHI
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- END IF
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
-*
- ETA = ETA / ( SIGMA+SQRT( SIGMA*SIGMA+ETA ) )
- TEMP=TAU+ETA
- IF( TEMP.GT.SGUB .OR. TEMP.LT.SGLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( SGUB-TAU ) / TWO
- ELSE
- ETA = ( SGLB-TAU ) / TWO
- END IF
- IF( GEOMAVG ) THEN
- IF( W .LT. ZERO ) THEN
- IF( TAU .GT. ZERO ) THEN
- ETA = SQRT(SGUB*TAU)-TAU
- END IF
- ELSE
- IF( SGLB .GT. ZERO ) THEN
- ETA = SQRT(SGLB*TAU)-TAU
- END IF
- END IF
- END IF
- END IF
-*
- PREW = W
-*
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 200 J = 1, N
- WORK( J ) = WORK( J ) + ETA
- DELTA( J ) = DELTA( J ) - ETA
- 200 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 210 J = 1, IIM1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 210 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 220 J = N, IIP1, -1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 220 CONTINUE
-*
- TAU2 = WORK( II )*DELTA( II )
- TEMP = Z( II ) / TAU2
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV
- $ + THREE*ABS( TEMP )
-* $ + ABS( TAU2 )*DW
-*
- IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN )
- $ SWTCH = .NOT.SWTCH
-*
- 230 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
-*
- END IF
-*
- 240 CONTINUE
- RETURN
-*
-* End of DLASD4
-*
- END
diff --git a/netlib/LAPACK/dlasd5.f b/netlib/LAPACK/dlasd5.f
deleted file mode 100644
index a1b4cd1..0000000
--- a/netlib/LAPACK/dlasd5.f
+++ /dev/null
@@ -1,231 +0,0 @@
-*> \brief \b DLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK )
-*
-* .. Scalar Arguments ..
-* INTEGER I
-* DOUBLE PRECISION DSIGMA, RHO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the square root of the I-th eigenvalue
-*> of a positive symmetric rank-one modification of a 2-by-2 diagonal
-*> matrix
-*>
-*> diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
-*>
-*> The diagonal entries in the array D are assumed to satisfy
-*>
-*> 0 <= D(i) < D(j) for i < j .
-*>
-*> We also assume RHO > 0 and that the Euclidean norm of the vector
-*> Z is one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. I = 1 or I = 2.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( 2 )
-*> The original eigenvalues. We assume 0 <= D(1) < D(2).
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 2 )
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is DOUBLE PRECISION array, dimension ( 2 )
-*> Contains (D(j) - sigma_I) in its j-th component.
-*> The vector DELTA contains the information necessary
-*> to construct the eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is DOUBLE PRECISION
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] DSIGMA
-*> \verbatim
-*> DSIGMA is DOUBLE PRECISION
-*> The computed sigma_I, the I-th updated eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( 2 )
-*> WORK contains (D(j) + sigma_I) in its j-th component.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I
- DOUBLE PRECISION DSIGMA, RHO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
- $ THREE = 3.0D+0, FOUR = 4.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION B, C, DEL, DELSQ, TAU, W
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- DEL = D( 2 ) - D( 1 )
- DELSQ = DEL*( D( 2 )+D( 1 ) )
- IF( I.EQ.1 ) THEN
- W = ONE + FOUR*RHO*( Z( 2 )*Z( 2 ) / ( D( 1 )+THREE*D( 2 ) )-
- $ Z( 1 )*Z( 1 ) / ( THREE*D( 1 )+D( 2 ) ) ) / DEL
- IF( W.GT.ZERO ) THEN
- B = DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 1 )*Z( 1 )*DELSQ
-*
-* B > ZERO, always
-*
-* The following TAU is DSIGMA * DSIGMA - D( 1 ) * D( 1 )
-*
- TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) )
-*
-* The following TAU is DSIGMA - D( 1 )
-*
- TAU = TAU / ( D( 1 )+SQRT( D( 1 )*D( 1 )+TAU ) )
- DSIGMA = D( 1 ) + TAU
- DELTA( 1 ) = -TAU
- DELTA( 2 ) = DEL - TAU
- WORK( 1 ) = TWO*D( 1 ) + TAU
- WORK( 2 ) = ( D( 1 )+TAU ) + D( 2 )
-* DELTA( 1 ) = -Z( 1 ) / TAU
-* DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
- ELSE
- B = -DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DELSQ
-*
-* The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 )
-*
- IF( B.GT.ZERO ) THEN
- TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) )
- ELSE
- TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO
- END IF
-*
-* The following TAU is DSIGMA - D( 2 )
-*
- TAU = TAU / ( D( 2 )+SQRT( ABS( D( 2 )*D( 2 )+TAU ) ) )
- DSIGMA = D( 2 ) + TAU
- DELTA( 1 ) = -( DEL+TAU )
- DELTA( 2 ) = -TAU
- WORK( 1 ) = D( 1 ) + TAU + D( 2 )
- WORK( 2 ) = TWO*D( 2 ) + TAU
-* DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
-* DELTA( 2 ) = -Z( 2 ) / TAU
- END IF
-* TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
-* DELTA( 1 ) = DELTA( 1 ) / TEMP
-* DELTA( 2 ) = DELTA( 2 ) / TEMP
- ELSE
-*
-* Now I=2
-*
- B = -DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DELSQ
-*
-* The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 )
-*
- IF( B.GT.ZERO ) THEN
- TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO
- ELSE
- TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) )
- END IF
-*
-* The following TAU is DSIGMA - D( 2 )
-*
- TAU = TAU / ( D( 2 )+SQRT( D( 2 )*D( 2 )+TAU ) )
- DSIGMA = D( 2 ) + TAU
- DELTA( 1 ) = -( DEL+TAU )
- DELTA( 2 ) = -TAU
- WORK( 1 ) = D( 1 ) + TAU + D( 2 )
- WORK( 2 ) = TWO*D( 2 ) + TAU
-* DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
-* DELTA( 2 ) = -Z( 2 ) / TAU
-* TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
-* DELTA( 1 ) = DELTA( 1 ) / TEMP
-* DELTA( 2 ) = DELTA( 2 ) / TEMP
- END IF
- RETURN
-*
-* End of DLASD5
-*
- END
diff --git a/netlib/LAPACK/dlasd6.f b/netlib/LAPACK/dlasd6.f
deleted file mode 100644
index 8b0f8d5..0000000
--- a/netlib/LAPACK/dlasd6.f
+++ /dev/null
@@ -1,445 +0,0 @@
-*> \brief \b DLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by appending a row. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA,
-* IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM,
-* LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
-* $ NR, SQRE
-* DOUBLE PRECISION ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), IDXQ( * ), IWORK( * ),
-* $ PERM( * )
-* DOUBLE PRECISION D( * ), DIFL( * ), DIFR( * ),
-* $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ),
-* $ VF( * ), VL( * ), WORK( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASD6 computes the SVD of an updated upper bidiagonal matrix B
-*> obtained by merging two smaller ones by appending a row. This
-*> routine is used only for the problem which requires all singular
-*> values and optionally singular vector matrices in factored form.
-*> B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
-*> A related subroutine, DLASD1, handles the case in which all singular
-*> values and singular vectors of the bidiagonal matrix are desired.
-*>
-*> DLASD6 computes the SVD as follows:
-*>
-*> ( D1(in) 0 0 0 )
-*> B = U(in) * ( Z1**T a Z2**T b ) * VT(in)
-*> ( 0 0 D2(in) 0 )
-*>
-*> = U(out) * ( D(out) 0) * VT(out)
-*>
-*> where Z**T = (Z1**T a Z2**T b) = u**T VT**T, and u is a vector of dimension M
-*> with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
-*> elsewhere; and the entry b is empty if SQRE = 0.
-*>
-*> The singular values of B can be computed using D1, D2, the first
-*> components of all the right singular vectors of the lower block, and
-*> the last components of all the right singular vectors of the upper
-*> block. These components are stored and updated in VF and VL,
-*> respectively, in DLASD6. Hence U and VT are not explicitly
-*> referenced.
-*>
-*> The singular values are stored in D. The algorithm consists of two
-*> stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple singular values or if there is a zero
-*> in the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine DLASD7.
-*>
-*> The second stage consists of calculating the updated
-*> singular values. This is done by finding the roots of the
-*> secular equation via the routine DLASD4 (as called by DLASD8).
-*> This routine also updates VF and VL and computes the distances
-*> between the updated singular values and the old singular
-*> values.
-*>
-*> DLASD6 is called from DLASDA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed in
-*> factored form:
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors in factored form as well.
-*> \endverbatim
-*>
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has row dimension N = NL + NR + 1,
-*> and column dimension M = N + SQRE.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( NL+NR+1 ).
-*> On entry D(1:NL,1:NL) contains the singular values of the
-*> upper block, and D(NL+2:N) contains the singular values
-*> of the lower block. On exit D(1:N) contains the singular
-*> values of the modified matrix.
-*> \endverbatim
-*>
-*> \param[in,out] VF
-*> \verbatim
-*> VF is DOUBLE PRECISION array, dimension ( M )
-*> On entry, VF(1:NL+1) contains the first components of all
-*> right singular vectors of the upper block; and VF(NL+2:M)
-*> contains the first components of all right singular vectors
-*> of the lower block. On exit, VF contains the first components
-*> of all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension ( M )
-*> On entry, VL(1:NL+1) contains the last components of all
-*> right singular vectors of the upper block; and VL(NL+2:M)
-*> contains the last components of all right singular vectors of
-*> the lower block. On exit, VL contains the last components of
-*> all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in,out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[out] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension ( N )
-*> This contains the permutation which will reintegrate the
-*> subproblem just solved back into sorted order, i.e.
-*> D( IDXQ( I = 1, N ) ) will be in ascending order.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( N )
-*> The permutations (from deflation and sorting) to be applied
-*> to each block. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER
-*> leading dimension of GIVCOL, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
-*> Each number indicates the C or S value to be used in the
-*> corresponding Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGNUM
-*> \verbatim
-*> LDGNUM is INTEGER
-*> The leading dimension of GIVNUM and POLES, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] POLES
-*> \verbatim
-*> POLES is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
-*> On exit, POLES(1,*) is an array containing the new singular
-*> values obtained from solving the secular equation, and
-*> POLES(2,*) is an array containing the poles in the secular
-*> equation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] DIFL
-*> \verbatim
-*> DIFL is DOUBLE PRECISION array, dimension ( N )
-*> On exit, DIFL(I) is the distance between I-th updated
-*> (undeflated) singular value and the I-th (undeflated) old
-*> singular value.
-*> \endverbatim
-*>
-*> \param[out] DIFR
-*> \verbatim
-*> DIFR is DOUBLE PRECISION array,
-*> dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
-*> dimension ( N ) if ICOMPQ = 0.
-*> On exit, DIFR(I, 1) is the distance between I-th updated
-*> (undeflated) singular value and the I+1-th (undeflated) old
-*> singular value.
-*>
-*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
-*> normalizing factors for the right singular vector matrix.
-*>
-*> See DLASD8 for details on DIFL and DIFR.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( M )
-*> The first elements of this array contain the components
-*> of the deflation-adjusted updating row vector.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix,
-*> This is the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> C contains garbage if SQRE =0 and the C-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION
-*> S contains garbage if SQRE =0 and the S-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( 4 * M )
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension ( 3 * N )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA,
- $ IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM,
- $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
- $ NR, SQRE
- DOUBLE PRECISION ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), IDXQ( * ), IWORK( * ),
- $ PERM( * )
- DOUBLE PRECISION D( * ), DIFL( * ), DIFR( * ),
- $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ),
- $ VF( * ), VL( * ), WORK( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IDX, IDXC, IDXP, ISIGMA, IVFW, IVLW, IW, M,
- $ N, N1, N2
- DOUBLE PRECISION ORGNRM
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAMRG, DLASCL, DLASD7, DLASD8, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- N = NL + NR + 1
- M = N + SQRE
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( NL.LT.1 ) THEN
- INFO = -2
- ELSE IF( NR.LT.1 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -14
- ELSE IF( LDGNUM.LT.N ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD6', -INFO )
- RETURN
- END IF
-*
-* The following values are for bookkeeping purposes only. They are
-* integer pointers which indicate the portion of the workspace
-* used by a particular array in DLASD7 and DLASD8.
-*
- ISIGMA = 1
- IW = ISIGMA + N
- IVFW = IW + M
- IVLW = IVFW + M
-*
- IDX = 1
- IDXC = IDX + N
- IDXP = IDXC + N
-*
-* Scale.
-*
- ORGNRM = MAX( ABS( ALPHA ), ABS( BETA ) )
- D( NL+1 ) = ZERO
- DO 10 I = 1, N
- IF( ABS( D( I ) ).GT.ORGNRM ) THEN
- ORGNRM = ABS( D( I ) )
- END IF
- 10 CONTINUE
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, INFO )
- ALPHA = ALPHA / ORGNRM
- BETA = BETA / ORGNRM
-*
-* Sort and Deflate singular values.
-*
- CALL DLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, WORK( IW ), VF,
- $ WORK( IVFW ), VL, WORK( IVLW ), ALPHA, BETA,
- $ WORK( ISIGMA ), IWORK( IDX ), IWORK( IDXP ), IDXQ,
- $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, C, S,
- $ INFO )
-*
-* Solve Secular Equation, compute DIFL, DIFR, and update VF, VL.
-*
- CALL DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDGNUM,
- $ WORK( ISIGMA ), WORK( IW ), INFO )
-*
-* Handle error returned
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD8', -INFO )
- RETURN
- END IF
-*
-* Save the poles if ICOMPQ = 1.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- CALL DCOPY( K, D, 1, POLES( 1, 1 ), 1 )
- CALL DCOPY( K, WORK( ISIGMA ), 1, POLES( 1, 2 ), 1 )
- END IF
-*
-* Unscale.
-*
- CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
-*
-* Prepare the IDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL DLAMRG( N1, N2, D, 1, -1, IDXQ )
-*
- RETURN
-*
-* End of DLASD6
-*
- END
diff --git a/netlib/LAPACK/dlasd7.f b/netlib/LAPACK/dlasd7.f
deleted file mode 100644
index bca613d..0000000
--- a/netlib/LAPACK/dlasd7.f
+++ /dev/null
@@ -1,580 +0,0 @@
-*> \brief \b DLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD7 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd7.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd7.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd7.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL,
-* VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ,
-* PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
-* C, S, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
-* $ NR, SQRE
-* DOUBLE PRECISION ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), IDX( * ), IDXP( * ),
-* $ IDXQ( * ), PERM( * )
-* DOUBLE PRECISION D( * ), DSIGMA( * ), GIVNUM( LDGNUM, * ),
-* $ VF( * ), VFW( * ), VL( * ), VLW( * ), Z( * ),
-* $ ZW( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASD7 merges the two sets of singular values together into a single
-*> sorted set. Then it tries to deflate the size of the problem. There
-*> are two ways in which deflation can occur: when two or more singular
-*> values are close together or if there is a tiny entry in the Z
-*> vector. For each such occurrence the order of the related
-*> secular equation problem is reduced by one.
-*>
-*> DLASD7 is called from DLASD6.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed
-*> in compact form, as follows:
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors of upper
-*> bidiagonal matrix in compact form.
-*> \endverbatim
-*>
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has
-*> N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix, this is
-*> the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( N )
-*> On entry D contains the singular values of the two submatrices
-*> to be combined. On exit D contains the trailing (N-K) updated
-*> singular values (those which were deflated) sorted into
-*> increasing order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( M )
-*> On exit Z contains the updating row vector in the secular
-*> equation.
-*> \endverbatim
-*>
-*> \param[out] ZW
-*> \verbatim
-*> ZW is DOUBLE PRECISION array, dimension ( M )
-*> Workspace for Z.
-*> \endverbatim
-*>
-*> \param[in,out] VF
-*> \verbatim
-*> VF is DOUBLE PRECISION array, dimension ( M )
-*> On entry, VF(1:NL+1) contains the first components of all
-*> right singular vectors of the upper block; and VF(NL+2:M)
-*> contains the first components of all right singular vectors
-*> of the lower block. On exit, VF contains the first components
-*> of all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[out] VFW
-*> \verbatim
-*> VFW is DOUBLE PRECISION array, dimension ( M )
-*> Workspace for VF.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension ( M )
-*> On entry, VL(1:NL+1) contains the last components of all
-*> right singular vectors of the upper block; and VL(NL+2:M)
-*> contains the last components of all right singular vectors
-*> of the lower block. On exit, VL contains the last components
-*> of all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[out] VLW
-*> \verbatim
-*> VLW is DOUBLE PRECISION array, dimension ( M )
-*> Workspace for VL.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[out] DSIGMA
-*> \verbatim
-*> DSIGMA is DOUBLE PRECISION array, dimension ( N )
-*> Contains a copy of the diagonal elements (K-1 singular values
-*> and one zero) in the secular equation.
-*> \endverbatim
-*>
-*> \param[out] IDX
-*> \verbatim
-*> IDX is INTEGER array, dimension ( N )
-*> This will contain the permutation used to sort the contents of
-*> D into ascending order.
-*> \endverbatim
-*>
-*> \param[out] IDXP
-*> \verbatim
-*> IDXP is INTEGER array, dimension ( N )
-*> This will contain the permutation used to place deflated
-*> values of D at the end of the array. On output IDXP(2:K)
-*> points to the nondeflated D-values and IDXP(K+1:N)
-*> points to the deflated singular values.
-*> \endverbatim
-*>
-*> \param[in] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension ( N )
-*> This contains the permutation which separately sorts the two
-*> sub-problems in D into ascending order. Note that entries in
-*> the first half of this permutation must first be moved one
-*> position backward; and entries in the second half
-*> must first have NL+1 added to their values.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( N )
-*> The permutations (from deflation and sorting) to be applied
-*> to each singular block. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER
-*> The leading dimension of GIVCOL, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
-*> Each number indicates the C or S value to be used in the
-*> corresponding Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGNUM
-*> \verbatim
-*> LDGNUM is INTEGER
-*> The leading dimension of GIVNUM, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> C contains garbage if SQRE =0 and the C-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION
-*> S contains garbage if SQRE =0 and the S-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL,
- $ VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ,
- $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
- $ C, S, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
- $ NR, SQRE
- DOUBLE PRECISION ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), IDX( * ), IDXP( * ),
- $ IDXQ( * ), PERM( * )
- DOUBLE PRECISION D( * ), DSIGMA( * ), GIVNUM( LDGNUM, * ),
- $ VF( * ), VFW( * ), VL( * ), VLW( * ), Z( * ),
- $ ZW( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, EIGHT
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
- $ EIGHT = 8.0D+0 )
-* ..
-* .. Local Scalars ..
-*
- INTEGER I, IDXI, IDXJ, IDXJP, J, JP, JPREV, K2, M, N,
- $ NLP1, NLP2
- DOUBLE PRECISION EPS, HLFTOL, TAU, TOL, Z1
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAMRG, DROT, XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL DLAMCH, DLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- N = NL + NR + 1
- M = N + SQRE
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( NL.LT.1 ) THEN
- INFO = -2
- ELSE IF( NR.LT.1 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -22
- ELSE IF( LDGNUM.LT.N ) THEN
- INFO = -24
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD7', -INFO )
- RETURN
- END IF
-*
- NLP1 = NL + 1
- NLP2 = NL + 2
- IF( ICOMPQ.EQ.1 ) THEN
- GIVPTR = 0
- END IF
-*
-* Generate the first part of the vector Z and move the singular
-* values in the first part of D one position backward.
-*
- Z1 = ALPHA*VL( NLP1 )
- VL( NLP1 ) = ZERO
- TAU = VF( NLP1 )
- DO 10 I = NL, 1, -1
- Z( I+1 ) = ALPHA*VL( I )
- VL( I ) = ZERO
- VF( I+1 ) = VF( I )
- D( I+1 ) = D( I )
- IDXQ( I+1 ) = IDXQ( I ) + 1
- 10 CONTINUE
- VF( 1 ) = TAU
-*
-* Generate the second part of the vector Z.
-*
- DO 20 I = NLP2, M
- Z( I ) = BETA*VF( I )
- VF( I ) = ZERO
- 20 CONTINUE
-*
-* Sort the singular values into increasing order
-*
- DO 30 I = NLP2, N
- IDXQ( I ) = IDXQ( I ) + NLP1
- 30 CONTINUE
-*
-* DSIGMA, IDXC, IDXC, and ZW are used as storage space.
-*
- DO 40 I = 2, N
- DSIGMA( I ) = D( IDXQ( I ) )
- ZW( I ) = Z( IDXQ( I ) )
- VFW( I ) = VF( IDXQ( I ) )
- VLW( I ) = VL( IDXQ( I ) )
- 40 CONTINUE
-*
- CALL DLAMRG( NL, NR, DSIGMA( 2 ), 1, 1, IDX( 2 ) )
-*
- DO 50 I = 2, N
- IDXI = 1 + IDX( I )
- D( I ) = DSIGMA( IDXI )
- Z( I ) = ZW( IDXI )
- VF( I ) = VFW( IDXI )
- VL( I ) = VLW( IDXI )
- 50 CONTINUE
-*
-* Calculate the allowable deflation tolerence
-*
- EPS = DLAMCH( 'Epsilon' )
- TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
- TOL = EIGHT*EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
-*
-* There are 2 kinds of deflation -- first a value in the z-vector
-* is small, second two (or more) singular values are very close
-* together (their difference is small).
-*
-* If the value in the z-vector is small, we simply permute the
-* array so that the corresponding singular value is moved to the
-* end.
-*
-* If two values in the D-vector are close, we perform a two-sided
-* rotation designed to make one of the corresponding z-vector
-* entries zero, and then permute the array so that the deflated
-* singular value is moved to the end.
-*
-* If there are multiple singular values then the problem deflates.
-* Here the number of equal singular values are found. As each equal
-* singular value is found, an elementary reflector is computed to
-* rotate the corresponding singular subspace so that the
-* corresponding components of Z are zero in this new basis.
-*
- K = 1
- K2 = N + 1
- DO 60 J = 2, N
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- IF( J.EQ.N )
- $ GO TO 100
- ELSE
- JPREV = J
- GO TO 70
- END IF
- 60 CONTINUE
- 70 CONTINUE
- J = JPREV
- 80 CONTINUE
- J = J + 1
- IF( J.GT.N )
- $ GO TO 90
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- ELSE
-*
-* Check if singular values are close enough to allow deflation.
-*
- IF( ABS( D( J )-D( JPREV ) ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- S = Z( JPREV )
- C = Z( J )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = DLAPY2( C, S )
- Z( J ) = TAU
- Z( JPREV ) = ZERO
- C = C / TAU
- S = -S / TAU
-*
-* Record the appropriate Givens rotation
-*
- IF( ICOMPQ.EQ.1 ) THEN
- GIVPTR = GIVPTR + 1
- IDXJP = IDXQ( IDX( JPREV )+1 )
- IDXJ = IDXQ( IDX( J )+1 )
- IF( IDXJP.LE.NLP1 ) THEN
- IDXJP = IDXJP - 1
- END IF
- IF( IDXJ.LE.NLP1 ) THEN
- IDXJ = IDXJ - 1
- END IF
- GIVCOL( GIVPTR, 2 ) = IDXJP
- GIVCOL( GIVPTR, 1 ) = IDXJ
- GIVNUM( GIVPTR, 2 ) = C
- GIVNUM( GIVPTR, 1 ) = S
- END IF
- CALL DROT( 1, VF( JPREV ), 1, VF( J ), 1, C, S )
- CALL DROT( 1, VL( JPREV ), 1, VL( J ), 1, C, S )
- K2 = K2 - 1
- IDXP( K2 ) = JPREV
- JPREV = J
- ELSE
- K = K + 1
- ZW( K ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
- JPREV = J
- END IF
- END IF
- GO TO 80
- 90 CONTINUE
-*
-* Record the last singular value.
-*
- K = K + 1
- ZW( K ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
-*
- 100 CONTINUE
-*
-* Sort the singular values into DSIGMA. The singular values which
-* were not deflated go into the first K slots of DSIGMA, except
-* that DSIGMA(1) is treated separately.
-*
- DO 110 J = 2, N
- JP = IDXP( J )
- DSIGMA( J ) = D( JP )
- VFW( J ) = VF( JP )
- VLW( J ) = VL( JP )
- 110 CONTINUE
- IF( ICOMPQ.EQ.1 ) THEN
- DO 120 J = 2, N
- JP = IDXP( J )
- PERM( J ) = IDXQ( IDX( JP )+1 )
- IF( PERM( J ).LE.NLP1 ) THEN
- PERM( J ) = PERM( J ) - 1
- END IF
- 120 CONTINUE
- END IF
-*
-* The deflated singular values go back into the last N - K slots of
-* D.
-*
- CALL DCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
-*
-* Determine DSIGMA(1), DSIGMA(2), Z(1), VF(1), VL(1), VF(M), and
-* VL(M).
-*
- DSIGMA( 1 ) = ZERO
- HLFTOL = TOL / TWO
- IF( ABS( DSIGMA( 2 ) ).LE.HLFTOL )
- $ DSIGMA( 2 ) = HLFTOL
- IF( M.GT.N ) THEN
- Z( 1 ) = DLAPY2( Z1, Z( M ) )
- IF( Z( 1 ).LE.TOL ) THEN
- C = ONE
- S = ZERO
- Z( 1 ) = TOL
- ELSE
- C = Z1 / Z( 1 )
- S = -Z( M ) / Z( 1 )
- END IF
- CALL DROT( 1, VF( M ), 1, VF( 1 ), 1, C, S )
- CALL DROT( 1, VL( M ), 1, VL( 1 ), 1, C, S )
- ELSE
- IF( ABS( Z1 ).LE.TOL ) THEN
- Z( 1 ) = TOL
- ELSE
- Z( 1 ) = Z1
- END IF
- END IF
-*
-* Restore Z, VF, and VL.
-*
- CALL DCOPY( K-1, ZW( 2 ), 1, Z( 2 ), 1 )
- CALL DCOPY( N-1, VFW( 2 ), 1, VF( 2 ), 1 )
- CALL DCOPY( N-1, VLW( 2 ), 1, VL( 2 ), 1 )
-*
- RETURN
-*
-* End of DLASD7
-*
- END
diff --git a/netlib/LAPACK/dlasd8.f b/netlib/LAPACK/dlasd8.f
deleted file mode 100644
index 60275e7..0000000
--- a/netlib/LAPACK/dlasd8.f
+++ /dev/null
@@ -1,343 +0,0 @@
-*> \brief \b DLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASD8 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd8.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd8.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd8.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
-* DSIGMA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, K, LDDIFR
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DIFL( * ), DIFR( LDDIFR, * ),
-* $ DSIGMA( * ), VF( * ), VL( * ), WORK( * ),
-* $ Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASD8 finds the square roots of the roots of the secular equation,
-*> as defined by the values in DSIGMA and Z. It makes the appropriate
-*> calls to DLASD4, and stores, for each element in D, the distance
-*> to its two nearest poles (elements in DSIGMA). It also updates
-*> the arrays VF and VL, the first and last components of all the
-*> right singular vectors of the original bidiagonal matrix.
-*>
-*> DLASD8 is called from DLASD6.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed in
-*> factored form in the calling routine:
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors in factored form as well.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of terms in the rational function to be solved
-*> by DLASD4. K >= 1.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( K )
-*> On output, D contains the updated singular values.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( K )
-*> On entry, the first K elements of this array contain the
-*> components of the deflation-adjusted updating row vector.
-*> On exit, Z is updated.
-*> \endverbatim
-*>
-*> \param[in,out] VF
-*> \verbatim
-*> VF is DOUBLE PRECISION array, dimension ( K )
-*> On entry, VF contains information passed through DBEDE8.
-*> On exit, VF contains the first K components of the first
-*> components of all right singular vectors of the bidiagonal
-*> matrix.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension ( K )
-*> On entry, VL contains information passed through DBEDE8.
-*> On exit, VL contains the first K components of the last
-*> components of all right singular vectors of the bidiagonal
-*> matrix.
-*> \endverbatim
-*>
-*> \param[out] DIFL
-*> \verbatim
-*> DIFL is DOUBLE PRECISION array, dimension ( K )
-*> On exit, DIFL(I) = D(I) - DSIGMA(I).
-*> \endverbatim
-*>
-*> \param[out] DIFR
-*> \verbatim
-*> DIFR is DOUBLE PRECISION array,
-*> dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
-*> dimension ( K ) if ICOMPQ = 0.
-*> On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
-*> defined and will not be referenced.
-*>
-*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
-*> normalizing factors for the right singular vector matrix.
-*> \endverbatim
-*>
-*> \param[in] LDDIFR
-*> \verbatim
-*> LDDIFR is INTEGER
-*> The leading dimension of DIFR, must be at least K.
-*> \endverbatim
-*>
-*> \param[in,out] DSIGMA
-*> \verbatim
-*> DSIGMA is DOUBLE PRECISION array, dimension ( K )
-*> On entry, the first K elements of this array contain the old
-*> roots of the deflated updating problem. These are the poles
-*> of the secular equation.
-*> On exit, the elements of DSIGMA may be very slightly altered
-*> in value.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension at least 3 * K
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
- $ DSIGMA, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, K, LDDIFR
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DIFL( * ), DIFR( LDDIFR, * ),
- $ DSIGMA( * ), VF( * ), VL( * ), WORK( * ),
- $ Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IWK1, IWK2, IWK2I, IWK3, IWK3I, J
- DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLASCL, DLASD4, DLASET, XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DDOT, DLAMC3, DNRM2
- EXTERNAL DDOT, DLAMC3, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( K.LT.1 ) THEN
- INFO = -2
- ELSE IF( LDDIFR.LT.K ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD8', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.1 ) THEN
- D( 1 ) = ABS( Z( 1 ) )
- DIFL( 1 ) = D( 1 )
- IF( ICOMPQ.EQ.1 ) THEN
- DIFL( 2 ) = ONE
- DIFR( 1, 2 ) = ONE
- END IF
- RETURN
- END IF
-*
-* Modify values DSIGMA(i) to make sure all DSIGMA(i)-DSIGMA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DSIGMA(I) by 2*DSIGMA(I)-DSIGMA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DSIGMA(I) if it is 1; this makes the subsequent
-* subtractions DSIGMA(I)-DSIGMA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DSIGMA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DSIGMA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 10 I = 1, K
- DSIGMA( I ) = DLAMC3( DSIGMA( I ), DSIGMA( I ) ) - DSIGMA( I )
- 10 CONTINUE
-*
-* Book keeping.
-*
- IWK1 = 1
- IWK2 = IWK1 + K
- IWK3 = IWK2 + K
- IWK2I = IWK2 - 1
- IWK3I = IWK3 - 1
-*
-* Normalize Z.
-*
- RHO = DNRM2( K, Z, 1 )
- CALL DLASCL( 'G', 0, 0, RHO, ONE, K, 1, Z, K, INFO )
- RHO = RHO*RHO
-*
-* Initialize WORK(IWK3).
-*
- CALL DLASET( 'A', K, 1, ONE, ONE, WORK( IWK3 ), K )
-*
-* Compute the updated singular values, the arrays DIFL, DIFR,
-* and the updated Z.
-*
- DO 40 J = 1, K
- CALL DLASD4( K, J, DSIGMA, Z, WORK( IWK1 ), RHO, D( J ),
- $ WORK( IWK2 ), INFO )
-*
-* If the root finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASD4', -INFO )
- RETURN
- END IF
- WORK( IWK3I+J ) = WORK( IWK3I+J )*WORK( J )*WORK( IWK2I+J )
- DIFL( J ) = -WORK( J )
- DIFR( J, 1 ) = -WORK( J+1 )
- DO 20 I = 1, J - 1
- WORK( IWK3I+I ) = WORK( IWK3I+I )*WORK( I )*
- $ WORK( IWK2I+I ) / ( DSIGMA( I )-
- $ DSIGMA( J ) ) / ( DSIGMA( I )+
- $ DSIGMA( J ) )
- 20 CONTINUE
- DO 30 I = J + 1, K
- WORK( IWK3I+I ) = WORK( IWK3I+I )*WORK( I )*
- $ WORK( IWK2I+I ) / ( DSIGMA( I )-
- $ DSIGMA( J ) ) / ( DSIGMA( I )+
- $ DSIGMA( J ) )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Compute updated Z.
-*
- DO 50 I = 1, K
- Z( I ) = SIGN( SQRT( ABS( WORK( IWK3I+I ) ) ), Z( I ) )
- 50 CONTINUE
-*
-* Update VF and VL.
-*
- DO 80 J = 1, K
- DIFLJ = DIFL( J )
- DJ = D( J )
- DSIGJ = -DSIGMA( J )
- IF( J.LT.K ) THEN
- DIFRJ = -DIFR( J, 1 )
- DSIGJP = -DSIGMA( J+1 )
- END IF
- WORK( J ) = -Z( J ) / DIFLJ / ( DSIGMA( J )+DJ )
- DO 60 I = 1, J - 1
- WORK( I ) = Z( I ) / ( DLAMC3( DSIGMA( I ), DSIGJ )-DIFLJ )
- $ / ( DSIGMA( I )+DJ )
- 60 CONTINUE
- DO 70 I = J + 1, K
- WORK( I ) = Z( I ) / ( DLAMC3( DSIGMA( I ), DSIGJP )+DIFRJ )
- $ / ( DSIGMA( I )+DJ )
- 70 CONTINUE
- TEMP = DNRM2( K, WORK, 1 )
- WORK( IWK2I+J ) = DDOT( K, WORK, 1, VF, 1 ) / TEMP
- WORK( IWK3I+J ) = DDOT( K, WORK, 1, VL, 1 ) / TEMP
- IF( ICOMPQ.EQ.1 ) THEN
- DIFR( J, 2 ) = TEMP
- END IF
- 80 CONTINUE
-*
- CALL DCOPY( K, WORK( IWK2 ), 1, VF, 1 )
- CALL DCOPY( K, WORK( IWK3 ), 1, VL, 1 )
-*
- RETURN
-*
-* End of DLASD8
-*
- END
-
diff --git a/netlib/LAPACK/dlasda.f b/netlib/LAPACK/dlasda.f
deleted file mode 100644
index bb67904..0000000
--- a/netlib/LAPACK/dlasda.f
+++ /dev/null
@@ -1,515 +0,0 @@
-*> \brief \b DLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASDA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasda.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasda.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasda.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K,
-* DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL,
-* PERM, GIVNUM, C, S, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
-* $ K( * ), PERM( LDGCOL, * )
-* DOUBLE PRECISION C( * ), D( * ), DIFL( LDU, * ), DIFR( LDU, * ),
-* $ E( * ), GIVNUM( LDU, * ), POLES( LDU, * ),
-* $ S( * ), U( LDU, * ), VT( LDU, * ), WORK( * ),
-* $ Z( LDU, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Using a divide and conquer approach, DLASDA computes the singular
-*> value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
-*> B with diagonal D and offdiagonal E, where M = N + SQRE. The
-*> algorithm computes the singular values in the SVD B = U * S * VT.
-*> The orthogonal matrices U and VT are optionally computed in
-*> compact form.
-*>
-*> A related subroutine, DLASD0, computes the singular values and
-*> the singular vectors in explicit form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed
-*> in compact form, as follows
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors of upper bidiagonal
-*> matrix in compact form.
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> The maximum size of the subproblems at the bottom of the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The row dimension of the upper bidiagonal matrix. This is
-*> also the dimension of the main diagonal array D.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> Specifies the column dimension of the bidiagonal matrix.
-*> = 0: The bidiagonal matrix has column dimension M = N;
-*> = 1: The bidiagonal matrix has column dimension M = N + 1.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( N )
-*> On entry D contains the main diagonal of the bidiagonal
-*> matrix. On exit D, if INFO = 0, contains its singular values.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension ( M-1 )
-*> Contains the subdiagonal entries of the bidiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array,
-*> dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
-*> singular vector matrices of all subproblems at the bottom
-*> level.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER, LDU = > N.
-*> The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
-*> GIVNUM, and Z.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array,
-*> dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT**T contains the right
-*> singular vector matrices of all subproblems at the bottom
-*> level.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER array,
-*> dimension ( N ) if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
-*> If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
-*> secular equation on the computation tree.
-*> \endverbatim
-*>
-*> \param[out] DIFL
-*> \verbatim
-*> DIFL is DOUBLE PRECISION array, dimension ( LDU, NLVL ),
-*> where NLVL = floor(log_2 (N/SMLSIZ))).
-*> \endverbatim
-*>
-*> \param[out] DIFR
-*> \verbatim
-*> DIFR is DOUBLE PRECISION array,
-*> dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
-*> dimension ( N ) if ICOMPQ = 0.
-*> If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
-*> record distances between singular values on the I-th
-*> level and singular values on the (I -1)-th level, and
-*> DIFR(1:N, 2 * I ) contains the normalizing factors for
-*> the right singular vector matrix. See DLASD8 for details.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array,
-*> dimension ( LDU, NLVL ) if ICOMPQ = 1 and
-*> dimension ( N ) if ICOMPQ = 0.
-*> The first K elements of Z(1, I) contain the components of
-*> the deflation-adjusted updating row vector for subproblems
-*> on the I-th level.
-*> \endverbatim
-*>
-*> \param[out] POLES
-*> \verbatim
-*> POLES is DOUBLE PRECISION array,
-*> dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
-*> POLES(1, 2*I) contain the new and old singular values
-*> involved in the secular equations on the I-th level.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array,
-*> dimension ( N ) if ICOMPQ = 1, and not referenced if
-*> ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
-*> the number of Givens rotations performed on the I-th
-*> problem on the computation tree.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array,
-*> dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
-*> referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
-*> GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
-*> of Givens rotations performed on the I-th level on the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER, LDGCOL = > N.
-*> The leading dimension of arrays GIVCOL and PERM.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array,
-*> dimension ( LDGCOL, NLVL ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
-*> permutations done on the I-th level of the computation tree.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is DOUBLE PRECISION array,
-*> dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
-*> referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
-*> GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
-*> values of Givens rotations performed on the I-th level on
-*> the computation tree.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array,
-*> dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
-*> If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
-*> C( I ) contains the C-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension ( N ) if
-*> ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
-*> and the I-th subproblem is not square, on exit, S( I )
-*> contains the S-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array.
-*> Dimension must be at least (7 * N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K,
- $ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL,
- $ PERM, GIVNUM, C, S, WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
- $ K( * ), PERM( LDGCOL, * )
- DOUBLE PRECISION C( * ), D( * ), DIFL( LDU, * ), DIFR( LDU, * ),
- $ E( * ), GIVNUM( LDU, * ), POLES( LDU, * ),
- $ S( * ), U( LDU, * ), VT( LDU, * ), WORK( * ),
- $ Z( LDU, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, IC, IDXQ, IDXQI, IM1, INODE, ITEMP, IWK,
- $ J, LF, LL, LVL, LVL2, M, NCC, ND, NDB1, NDIML,
- $ NDIMR, NL, NLF, NLP1, NLVL, NR, NRF, NRP1, NRU,
- $ NWORK1, NWORK2, SMLSZP, SQREI, VF, VFI, VL, VLI
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLASD6, DLASDQ, DLASDT, DLASET, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( SMLSIZ.LT.3 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- ELSE IF( LDU.LT.( N+SQRE ) ) THEN
- INFO = -8
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -17
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASDA', -INFO )
- RETURN
- END IF
-*
- M = N + SQRE
-*
-* If the input matrix is too small, call DLASDQ to find the SVD.
-*
- IF( N.LE.SMLSIZ ) THEN
- IF( ICOMPQ.EQ.0 ) THEN
- CALL DLASDQ( 'U', SQRE, N, 0, 0, 0, D, E, VT, LDU, U, LDU,
- $ U, LDU, WORK, INFO )
- ELSE
- CALL DLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDU, U, LDU,
- $ U, LDU, WORK, INFO )
- END IF
- RETURN
- END IF
-*
-* Book-keeping and set up the computation tree.
-*
- INODE = 1
- NDIML = INODE + N
- NDIMR = NDIML + N
- IDXQ = NDIMR + N
- IWK = IDXQ + N
-*
- NCC = 0
- NRU = 0
-*
- SMLSZP = SMLSIZ + 1
- VF = 1
- VL = VF + M
- NWORK1 = VL + M
- NWORK2 = NWORK1 + SMLSZP*SMLSZP
-*
- CALL DLASDT( N, NLVL, ND, IWORK( INODE ), IWORK( NDIML ),
- $ IWORK( NDIMR ), SMLSIZ )
-*
-* for the nodes on bottom level of the tree, solve
-* their subproblems by DLASDQ.
-*
- NDB1 = ( ND+1 ) / 2
- DO 30 I = NDB1, ND
-*
-* IC : center row of each node
-* NL : number of rows of left subproblem
-* NR : number of rows of right subproblem
-* NLF: starting row of the left subproblem
-* NRF: starting row of the right subproblem
-*
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NLP1 = NL + 1
- NR = IWORK( NDIMR+I1 )
- NLF = IC - NL
- NRF = IC + 1
- IDXQI = IDXQ + NLF - 2
- VFI = VF + NLF - 1
- VLI = VL + NLF - 1
- SQREI = 1
- IF( ICOMPQ.EQ.0 ) THEN
- CALL DLASET( 'A', NLP1, NLP1, ZERO, ONE, WORK( NWORK1 ),
- $ SMLSZP )
- CALL DLASDQ( 'U', SQREI, NL, NLP1, NRU, NCC, D( NLF ),
- $ E( NLF ), WORK( NWORK1 ), SMLSZP,
- $ WORK( NWORK2 ), NL, WORK( NWORK2 ), NL,
- $ WORK( NWORK2 ), INFO )
- ITEMP = NWORK1 + NL*SMLSZP
- CALL DCOPY( NLP1, WORK( NWORK1 ), 1, WORK( VFI ), 1 )
- CALL DCOPY( NLP1, WORK( ITEMP ), 1, WORK( VLI ), 1 )
- ELSE
- CALL DLASET( 'A', NL, NL, ZERO, ONE, U( NLF, 1 ), LDU )
- CALL DLASET( 'A', NLP1, NLP1, ZERO, ONE, VT( NLF, 1 ), LDU )
- CALL DLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ),
- $ E( NLF ), VT( NLF, 1 ), LDU, U( NLF, 1 ), LDU,
- $ U( NLF, 1 ), LDU, WORK( NWORK1 ), INFO )
- CALL DCOPY( NLP1, VT( NLF, 1 ), 1, WORK( VFI ), 1 )
- CALL DCOPY( NLP1, VT( NLF, NLP1 ), 1, WORK( VLI ), 1 )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- DO 10 J = 1, NL
- IWORK( IDXQI+J ) = J
- 10 CONTINUE
- IF( ( I.EQ.ND ) .AND. ( SQRE.EQ.0 ) ) THEN
- SQREI = 0
- ELSE
- SQREI = 1
- END IF
- IDXQI = IDXQI + NLP1
- VFI = VFI + NLP1
- VLI = VLI + NLP1
- NRP1 = NR + SQREI
- IF( ICOMPQ.EQ.0 ) THEN
- CALL DLASET( 'A', NRP1, NRP1, ZERO, ONE, WORK( NWORK1 ),
- $ SMLSZP )
- CALL DLASDQ( 'U', SQREI, NR, NRP1, NRU, NCC, D( NRF ),
- $ E( NRF ), WORK( NWORK1 ), SMLSZP,
- $ WORK( NWORK2 ), NR, WORK( NWORK2 ), NR,
- $ WORK( NWORK2 ), INFO )
- ITEMP = NWORK1 + ( NRP1-1 )*SMLSZP
- CALL DCOPY( NRP1, WORK( NWORK1 ), 1, WORK( VFI ), 1 )
- CALL DCOPY( NRP1, WORK( ITEMP ), 1, WORK( VLI ), 1 )
- ELSE
- CALL DLASET( 'A', NR, NR, ZERO, ONE, U( NRF, 1 ), LDU )
- CALL DLASET( 'A', NRP1, NRP1, ZERO, ONE, VT( NRF, 1 ), LDU )
- CALL DLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ),
- $ E( NRF ), VT( NRF, 1 ), LDU, U( NRF, 1 ), LDU,
- $ U( NRF, 1 ), LDU, WORK( NWORK1 ), INFO )
- CALL DCOPY( NRP1, VT( NRF, 1 ), 1, WORK( VFI ), 1 )
- CALL DCOPY( NRP1, VT( NRF, NRP1 ), 1, WORK( VLI ), 1 )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- DO 20 J = 1, NR
- IWORK( IDXQI+J ) = J
- 20 CONTINUE
- 30 CONTINUE
-*
-* Now conquer each subproblem bottom-up.
-*
- J = 2**NLVL
- DO 50 LVL = NLVL, 1, -1
- LVL2 = LVL*2 - 1
-*
-* Find the first node LF and last node LL on
-* the current level LVL.
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 40 I = LF, LL
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- NRF = IC + 1
- IF( I.EQ.LL ) THEN
- SQREI = SQRE
- ELSE
- SQREI = 1
- END IF
- VFI = VF + NLF - 1
- VLI = VL + NLF - 1
- IDXQI = IDXQ + NLF - 1
- ALPHA = D( IC )
- BETA = E( IC )
- IF( ICOMPQ.EQ.0 ) THEN
- CALL DLASD6( ICOMPQ, NL, NR, SQREI, D( NLF ),
- $ WORK( VFI ), WORK( VLI ), ALPHA, BETA,
- $ IWORK( IDXQI ), PERM, GIVPTR( 1 ), GIVCOL,
- $ LDGCOL, GIVNUM, LDU, POLES, DIFL, DIFR, Z,
- $ K( 1 ), C( 1 ), S( 1 ), WORK( NWORK1 ),
- $ IWORK( IWK ), INFO )
- ELSE
- J = J - 1
- CALL DLASD6( ICOMPQ, NL, NR, SQREI, D( NLF ),
- $ WORK( VFI ), WORK( VLI ), ALPHA, BETA,
- $ IWORK( IDXQI ), PERM( NLF, LVL ),
- $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
- $ GIVNUM( NLF, LVL2 ), LDU,
- $ POLES( NLF, LVL2 ), DIFL( NLF, LVL ),
- $ DIFR( NLF, LVL2 ), Z( NLF, LVL ), K( J ),
- $ C( J ), S( J ), WORK( NWORK1 ),
- $ IWORK( IWK ), INFO )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of DLASDA
-*
- END
diff --git a/netlib/LAPACK/dlasdq.f b/netlib/LAPACK/dlasdq.f
deleted file mode 100644
index 6beef32..0000000
--- a/netlib/LAPACK/dlasdq.f
+++ /dev/null
@@ -1,413 +0,0 @@
-*> \brief \b DLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASDQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasdq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasdq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasdq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
-* U, LDU, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASDQ computes the singular value decomposition (SVD) of a real
-*> (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
-*> E, accumulating the transformations if desired. Letting B denote
-*> the input bidiagonal matrix, the algorithm computes orthogonal
-*> matrices Q and P such that B = Q * S * P**T (P**T denotes the transpose
-*> of P). The singular values S are overwritten on D.
-*>
-*> The input matrix U is changed to U * Q if desired.
-*> The input matrix VT is changed to P**T * VT if desired.
-*> The input matrix C is changed to Q**T * C if desired.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices With
-*> Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
-*> LAPACK Working Note #3, for a detailed description of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the input bidiagonal matrix
-*> is upper or lower bidiagonal, and wether it is square are
-*> not.
-*> UPLO = 'U' or 'u' B is upper bidiagonal.
-*> UPLO = 'L' or 'l' B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: then the input matrix is N-by-N.
-*> = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
-*> (N+1)-by-N if UPLU = 'L'.
-*>
-*> The bidiagonal matrix has
-*> N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of rows and columns
-*> in the matrix. N must be at least 0.
-*> \endverbatim
-*>
-*> \param[in] NCVT
-*> \verbatim
-*> NCVT is INTEGER
-*> On entry, NCVT specifies the number of columns of
-*> the matrix VT. NCVT must be at least 0.
-*> \endverbatim
-*>
-*> \param[in] NRU
-*> \verbatim
-*> NRU is INTEGER
-*> On entry, NRU specifies the number of rows of
-*> the matrix U. NRU must be at least 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> On entry, NCC specifies the number of columns of
-*> the matrix C. NCC must be at least 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D contains the diagonal entries of the
-*> bidiagonal matrix whose SVD is desired. On normal exit,
-*> D contains the singular values in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array.
-*> dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
-*> On entry, the entries of E contain the offdiagonal entries
-*> of the bidiagonal matrix whose SVD is desired. On normal
-*> exit, E will contain 0. If the algorithm does not converge,
-*> D and E will contain the diagonal and superdiagonal entries
-*> of a bidiagonal matrix orthogonally equivalent to the one
-*> given as input.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT, NCVT)
-*> On entry, contains a matrix which on exit has been
-*> premultiplied by P**T, dimension N-by-NCVT if SQRE = 0
-*> and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> On entry, LDVT specifies the leading dimension of VT as
-*> declared in the calling (sub) program. LDVT must be at
-*> least 1. If NCVT is nonzero LDVT must also be at least N.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU, N)
-*> On entry, contains a matrix which on exit has been
-*> postmultiplied by Q, dimension NRU-by-N if SQRE = 0
-*> and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> On entry, LDU specifies the leading dimension of U as
-*> declared in the calling (sub) program. LDU must be at
-*> least max( 1, NRU ) .
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC, NCC)
-*> On entry, contains an N-by-NCC matrix which on exit
-*> has been premultiplied by Q**T dimension N-by-NCC if SQRE = 0
-*> and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> On entry, LDC specifies the leading dimension of C as
-*> declared in the calling (sub) program. LDC must be at
-*> least 1. If NCC is nonzero, LDC must also be at least N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> Workspace. Only referenced if one of NCVT, NRU, or NCC is
-*> nonzero, and if N is at least 2.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, a value of 0 indicates a successful exit.
-*> If INFO < 0, argument number -INFO is illegal.
-*> If INFO > 0, the algorithm did not converge, and INFO
-*> specifies how many superdiagonals did not converge.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
- $ U, LDU, C, LDC, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ROTATE
- INTEGER I, ISUB, IUPLO, J, NP1, SQRE1
- DOUBLE PRECISION CS, R, SMIN, SN
-* ..
-* .. External Subroutines ..
- EXTERNAL DBDSQR, DLARTG, DLASR, DSWAP, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IUPLO = 0
- IF( LSAME( UPLO, 'U' ) )
- $ IUPLO = 1
- IF( LSAME( UPLO, 'L' ) )
- $ IUPLO = 2
- IF( IUPLO.EQ.0 ) THEN
- INFO = -1
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NCVT.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRU.LT.0 ) THEN
- INFO = -5
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -6
- ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
- $ ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
- INFO = -10
- ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
- INFO = -12
- ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
- $ ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASDQ', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
-*
-* ROTATE is true if any singular vectors desired, false otherwise
-*
- ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
- NP1 = N + 1
- SQRE1 = SQRE
-*
-* If matrix non-square upper bidiagonal, rotate to be lower
-* bidiagonal. The rotations are on the right.
-*
- IF( ( IUPLO.EQ.1 ) .AND. ( SQRE1.EQ.1 ) ) THEN
- DO 10 I = 1, N - 1
- CALL DLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( ROTATE ) THEN
- WORK( I ) = CS
- WORK( N+I ) = SN
- END IF
- 10 CONTINUE
- CALL DLARTG( D( N ), E( N ), CS, SN, R )
- D( N ) = R
- E( N ) = ZERO
- IF( ROTATE ) THEN
- WORK( N ) = CS
- WORK( N+N ) = SN
- END IF
- IUPLO = 2
- SQRE1 = 0
-*
-* Update singular vectors if desired.
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', NP1, NCVT, WORK( 1 ),
- $ WORK( NP1 ), VT, LDVT )
- END IF
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left.
-*
- IF( IUPLO.EQ.2 ) THEN
- DO 20 I = 1, N - 1
- CALL DLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( ROTATE ) THEN
- WORK( I ) = CS
- WORK( N+I ) = SN
- END IF
- 20 CONTINUE
-*
-* If matrix (N+1)-by-N lower bidiagonal, one additional
-* rotation is needed.
-*
- IF( SQRE1.EQ.1 ) THEN
- CALL DLARTG( D( N ), E( N ), CS, SN, R )
- D( N ) = R
- IF( ROTATE ) THEN
- WORK( N ) = CS
- WORK( N+N ) = SN
- END IF
- END IF
-*
-* Update singular vectors if desired.
-*
- IF( NRU.GT.0 ) THEN
- IF( SQRE1.EQ.0 ) THEN
- CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ),
- $ WORK( NP1 ), U, LDU )
- ELSE
- CALL DLASR( 'R', 'V', 'F', NRU, NP1, WORK( 1 ),
- $ WORK( NP1 ), U, LDU )
- END IF
- END IF
- IF( NCC.GT.0 ) THEN
- IF( SQRE1.EQ.0 ) THEN
- CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ),
- $ WORK( NP1 ), C, LDC )
- ELSE
- CALL DLASR( 'L', 'V', 'F', NP1, NCC, WORK( 1 ),
- $ WORK( NP1 ), C, LDC )
- END IF
- END IF
- END IF
-*
-* Call DBDSQR to compute the SVD of the reduced real
-* N-by-N upper bidiagonal matrix.
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C,
- $ LDC, WORK, INFO )
-*
-* Sort the singular values into ascending order (insertion sort on
-* singular values, but only one transposition per singular vector)
-*
- DO 40 I = 1, N
-*
-* Scan for smallest D(I).
-*
- ISUB = I
- SMIN = D( I )
- DO 30 J = I + 1, N
- IF( D( J ).LT.SMIN ) THEN
- ISUB = J
- SMIN = D( J )
- END IF
- 30 CONTINUE
- IF( ISUB.NE.I ) THEN
-*
-* Swap singular values and vectors.
-*
- D( ISUB ) = D( I )
- D( I ) = SMIN
- IF( NCVT.GT.0 )
- $ CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, I ), 1 )
- IF( NCC.GT.0 )
- $ CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( I, 1 ), LDC )
- END IF
- 40 CONTINUE
-*
- RETURN
-*
-* End of DLASDQ
-*
- END
diff --git a/netlib/LAPACK/dlasdt.f b/netlib/LAPACK/dlasdt.f
deleted file mode 100644
index 988b3ad..0000000
--- a/netlib/LAPACK/dlasdt.f
+++ /dev/null
@@ -1,172 +0,0 @@
-*> \brief \b DLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASDT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasdt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasdt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasdt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB )
-*
-* .. Scalar Arguments ..
-* INTEGER LVL, MSUB, N, ND
-* ..
-* .. Array Arguments ..
-* INTEGER INODE( * ), NDIML( * ), NDIMR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASDT creates a tree of subproblems for bidiagonal divide and
-*> conquer.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, the number of diagonal elements of the
-*> bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[out] LVL
-*> \verbatim
-*> LVL is INTEGER
-*> On exit, the number of levels on the computation tree.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is INTEGER
-*> On exit, the number of nodes on the tree.
-*> \endverbatim
-*>
-*> \param[out] INODE
-*> \verbatim
-*> INODE is INTEGER array, dimension ( N )
-*> On exit, centers of subproblems.
-*> \endverbatim
-*>
-*> \param[out] NDIML
-*> \verbatim
-*> NDIML is INTEGER array, dimension ( N )
-*> On exit, row dimensions of left children.
-*> \endverbatim
-*>
-*> \param[out] NDIMR
-*> \verbatim
-*> NDIMR is INTEGER array, dimension ( N )
-*> On exit, row dimensions of right children.
-*> \endverbatim
-*>
-*> \param[in] MSUB
-*> \verbatim
-*> MSUB is INTEGER
-*> On entry, the maximum row dimension each subproblem at the
-*> bottom of the tree can be of.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LVL, MSUB, N, ND
-* ..
-* .. Array Arguments ..
- INTEGER INODE( * ), NDIML( * ), NDIMR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IL, IR, LLST, MAXN, NCRNT, NLVL
- DOUBLE PRECISION TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, INT, LOG, MAX
-* ..
-* .. Executable Statements ..
-*
-* Find the number of levels on the tree.
-*
- MAXN = MAX( 1, N )
- TEMP = LOG( DBLE( MAXN ) / DBLE( MSUB+1 ) ) / LOG( TWO )
- LVL = INT( TEMP ) + 1
-*
- I = N / 2
- INODE( 1 ) = I + 1
- NDIML( 1 ) = I
- NDIMR( 1 ) = N - I - 1
- IL = 0
- IR = 1
- LLST = 1
- DO 20 NLVL = 1, LVL - 1
-*
-* Constructing the tree at (NLVL+1)-st level. The number of
-* nodes created on this level is LLST * 2.
-*
- DO 10 I = 0, LLST - 1
- IL = IL + 2
- IR = IR + 2
- NCRNT = LLST + I
- NDIML( IL ) = NDIML( NCRNT ) / 2
- NDIMR( IL ) = NDIML( NCRNT ) - NDIML( IL ) - 1
- INODE( IL ) = INODE( NCRNT ) - NDIMR( IL ) - 1
- NDIML( IR ) = NDIMR( NCRNT ) / 2
- NDIMR( IR ) = NDIMR( NCRNT ) - NDIML( IR ) - 1
- INODE( IR ) = INODE( NCRNT ) + NDIML( IR ) + 1
- 10 CONTINUE
- LLST = LLST*2
- 20 CONTINUE
- ND = LLST*2 - 1
-*
- RETURN
-*
-* End of DLASDT
-*
- END
diff --git a/netlib/LAPACK/dlaset.f b/netlib/LAPACK/dlaset.f
deleted file mode 100644
index 1ce3466..0000000
--- a/netlib/LAPACK/dlaset.f
+++ /dev/null
@@ -1,184 +0,0 @@
-*> \brief \b DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASET + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaset.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaset.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaset.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, M, N
-* DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASET initializes an m-by-n matrix A to BETA on the diagonal and
-*> ALPHA on the offdiagonals.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies the part of the matrix A to be set.
-*> = 'U': Upper triangular part is set; the strictly lower
-*> triangular part of A is not changed.
-*> = 'L': Lower triangular part is set; the strictly upper
-*> triangular part of A is not changed.
-*> Otherwise: All of the matrix A is set.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> The constant to which the offdiagonal elements are to be set.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> The constant to which the diagonal elements are to be set.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On exit, the leading m-by-n submatrix of A is set as follows:
-*>
-*> if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
-*> if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
-*> otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
-*>
-*> and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, M, N
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Set the strictly upper triangular or trapezoidal part of the
-* array to ALPHA.
-*
- DO 20 J = 2, N
- DO 10 I = 1, MIN( J-1, M )
- A( I, J ) = ALPHA
- 10 CONTINUE
- 20 CONTINUE
-*
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-*
-* Set the strictly lower triangular or trapezoidal part of the
-* array to ALPHA.
-*
- DO 40 J = 1, MIN( M, N )
- DO 30 I = J + 1, M
- A( I, J ) = ALPHA
- 30 CONTINUE
- 40 CONTINUE
-*
- ELSE
-*
-* Set the leading m-by-n submatrix to ALPHA.
-*
- DO 60 J = 1, N
- DO 50 I = 1, M
- A( I, J ) = ALPHA
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* Set the first min(M,N) diagonal elements to BETA.
-*
- DO 70 I = 1, MIN( M, N )
- A( I, I ) = BETA
- 70 CONTINUE
-*
- RETURN
-*
-* End of DLASET
-*
- END
diff --git a/netlib/LAPACK/dlasq1.f b/netlib/LAPACK/dlasq1.f
deleted file mode 100644
index d12fb7a..0000000
--- a/netlib/LAPACK/dlasq1.f
+++ /dev/null
@@ -1,224 +0,0 @@
-*> \brief \b DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ1 computes the singular values of a real N-by-N bidiagonal
-*> matrix with diagonal D and off-diagonal E. The singular values
-*> are computed to high relative accuracy, in the absence of
-*> denormalization, underflow and overflow. The algorithm was first
-*> presented in
-*>
-*> "Accurate singular values and differential qd algorithms" by K. V.
-*> Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
-*> 1994,
-*>
-*> and the present implementation is described in "An implementation of
-*> the dqds Algorithm (Positive Case)", LAPACK Working Note.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D contains the diagonal elements of the
-*> bidiagonal matrix whose SVD is desired. On normal exit,
-*> D contains the singular values in decreasing order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, elements E(1:N-1) contain the off-diagonal elements
-*> of the bidiagonal matrix whose SVD is desired.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm failed
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 100*N
-*> iterations (in inner while loop) On exit D and E
-*> represent a matrix with the same singular values
-*> which the calling subroutine could use to finish the
-*> computation, or even feed back into DLASQ1
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO
- DOUBLE PRECISION EPS, SCALE, SAFMIN, SIGMN, SIGMX
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- CALL XERBLA( 'DLASQ1', -INFO )
- RETURN
- ELSE IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- D( 1 ) = ABS( D( 1 ) )
- RETURN
- ELSE IF( N.EQ.2 ) THEN
- CALL DLAS2( D( 1 ), E( 1 ), D( 2 ), SIGMN, SIGMX )
- D( 1 ) = SIGMX
- D( 2 ) = SIGMN
- RETURN
- END IF
-*
-* Estimate the largest singular value.
-*
- SIGMX = ZERO
- DO 10 I = 1, N - 1
- D( I ) = ABS( D( I ) )
- SIGMX = MAX( SIGMX, ABS( E( I ) ) )
- 10 CONTINUE
- D( N ) = ABS( D( N ) )
-*
-* Early return if SIGMX is zero (matrix is already diagonal).
-*
- IF( SIGMX.EQ.ZERO ) THEN
- CALL DLASRT( 'D', N, D, IINFO )
- RETURN
- END IF
-*
- DO 20 I = 1, N
- SIGMX = MAX( SIGMX, D( I ) )
- 20 CONTINUE
-*
-* Copy D and E into WORK (in the Z format) and scale (squaring the
-* input data makes scaling by a power of the radix pointless).
-*
- EPS = DLAMCH( 'Precision' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SCALE = SQRT( EPS / SAFMIN )
- CALL DCOPY( N, D, 1, WORK( 1 ), 2 )
- CALL DCOPY( N-1, E, 1, WORK( 2 ), 2 )
- CALL DLASCL( 'G', 0, 0, SIGMX, SCALE, 2*N-1, 1, WORK, 2*N-1,
- $ IINFO )
-*
-* Compute the q's and e's.
-*
- DO 30 I = 1, 2*N - 1
- WORK( I ) = WORK( I )**2
- 30 CONTINUE
- WORK( 2*N ) = ZERO
-*
- CALL DLASQ2( N, WORK, INFO )
-*
- IF( INFO.EQ.0 ) THEN
- DO 40 I = 1, N
- D( I ) = SQRT( WORK( I ) )
- 40 CONTINUE
- CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
- ELSE IF( INFO.EQ.2 ) THEN
-*
-* Maximum number of iterations exceeded. Move data from WORK
-* into D and E so the calling subroutine can try to finish
-*
- DO I = 1, N
- D( I ) = SQRT( WORK( 2*I-1 ) )
- E( I ) = SQRT( WORK( 2*I ) )
- END DO
- CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
- CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, E, N, IINFO )
- END IF
-*
- RETURN
-*
-* End of DLASQ1
-*
- END
diff --git a/netlib/LAPACK/dlasq2.f b/netlib/LAPACK/dlasq2.f
deleted file mode 100644
index df1690d..0000000
--- a/netlib/LAPACK/dlasq2.f
+++ /dev/null
@@ -1,582 +0,0 @@
-*> \brief \b DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ2( N, Z, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ2 computes all the eigenvalues of the symmetric positive
-*> definite tridiagonal matrix associated with the qd array Z to high
-*> relative accuracy are computed to high relative accuracy, in the
-*> absence of denormalization, underflow and overflow.
-*>
-*> To see the relation of Z to the tridiagonal matrix, let L be a
-*> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
-*> let U be an upper bidiagonal matrix with 1's above and diagonal
-*> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
-*> symmetric tridiagonal to which it is similar.
-*>
-*> Note : DLASQ2 defines a logical variable, IEEE, which is true
-*> on machines which follow ieee-754 floating-point standard in their
-*> handling of infinities and NaNs, and false otherwise. This variable
-*> is passed to DLASQ3.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> On entry Z holds the qd array. On exit, entries 1 to N hold
-*> the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
-*> trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
-*> N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
-*> holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
-*> shifts that failed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if the i-th argument is a scalar and had an illegal
-*> value, then INFO = -i, if the i-th argument is an
-*> array and the j-entry had an illegal value, then
-*> INFO = -(i*100+j)
-*> > 0: the algorithm failed
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 100*N
-*> iterations (in inner while loop). On exit Z holds
-*> a qd array with the same eigenvalues as the given Z.
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Local Variables: I0:N0 defines a current unreduced segment of Z.
-*> The shifts are accumulated in SIGMA. Iteration count is in ITER.
-*> Ping-pong is controlled by PP (alternates between 0 and 1).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASQ2( N, Z, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CBIAS
- PARAMETER ( CBIAS = 1.50D0 )
- DOUBLE PRECISION ZERO, HALF, ONE, TWO, FOUR, HUNDRD
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0,
- $ TWO = 2.0D0, FOUR = 4.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL IEEE
- INTEGER I0, I1, I4, IINFO, IPN4, ITER, IWHILA, IWHILB,
- $ K, KMIN, N0, N1, NBIG, NDIV, NFAIL, PP, SPLT,
- $ TTYPE
- DOUBLE PRECISION D, DEE, DEEMIN, DESIG, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, E, EMAX, EMIN, EPS, G, OLDEMN, QMAX,
- $ QMIN, S, SAFMIN, SIGMA, T, TAU, TEMP, TOL,
- $ TOL2, TRACE, ZMAX, TEMPE, TEMPQ
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASQ3, DLASRT, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH, ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-* (in case DLASQ2 is not called by DLASQ1)
-*
- INFO = 0
- EPS = DLAMCH( 'Precision' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DLASQ2', 1 )
- RETURN
- ELSE IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
-*
-* 1-by-1 case.
-*
- IF( Z( 1 ).LT.ZERO ) THEN
- INFO = -201
- CALL XERBLA( 'DLASQ2', 2 )
- END IF
- RETURN
- ELSE IF( N.EQ.2 ) THEN
-*
-* 2-by-2 case.
-*
- IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN
- INFO = -2
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN
- D = Z( 3 )
- Z( 3 ) = Z( 1 )
- Z( 1 ) = D
- END IF
- Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 )
- IF( Z( 2 ).GT.Z( 3 )*TOL2 ) THEN
- T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) )
- S = Z( 3 )*( Z( 2 ) / T )
- IF( S.LE.T ) THEN
- S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( 1 ) + ( S+Z( 2 ) )
- Z( 3 ) = Z( 3 )*( Z( 1 ) / T )
- Z( 1 ) = T
- END IF
- Z( 2 ) = Z( 3 )
- Z( 6 ) = Z( 2 ) + Z( 1 )
- RETURN
- END IF
-*
-* Check for negative data and compute sums of q's and e's.
-*
- Z( 2*N ) = ZERO
- EMIN = Z( 2 )
- QMAX = ZERO
- ZMAX = ZERO
- D = ZERO
- E = ZERO
-*
- DO 10 K = 1, 2*( N-1 ), 2
- IF( Z( K ).LT.ZERO ) THEN
- INFO = -( 200+K )
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- ELSE IF( Z( K+1 ).LT.ZERO ) THEN
- INFO = -( 200+K+1 )
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- END IF
- D = D + Z( K )
- E = E + Z( K+1 )
- QMAX = MAX( QMAX, Z( K ) )
- EMIN = MIN( EMIN, Z( K+1 ) )
- ZMAX = MAX( QMAX, ZMAX, Z( K+1 ) )
- 10 CONTINUE
- IF( Z( 2*N-1 ).LT.ZERO ) THEN
- INFO = -( 200+2*N-1 )
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- END IF
- D = D + Z( 2*N-1 )
- QMAX = MAX( QMAX, Z( 2*N-1 ) )
- ZMAX = MAX( QMAX, ZMAX )
-*
-* Check for diagonality.
-*
- IF( E.EQ.ZERO ) THEN
- DO 20 K = 2, N
- Z( K ) = Z( 2*K-1 )
- 20 CONTINUE
- CALL DLASRT( 'D', N, Z, IINFO )
- Z( 2*N-1 ) = D
- RETURN
- END IF
-*
- TRACE = D + E
-*
-* Check for zero data.
-*
- IF( TRACE.EQ.ZERO ) THEN
- Z( 2*N-1 ) = ZERO
- RETURN
- END IF
-*
-* Check whether the machine is IEEE conformable.
-*
- IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND.
- $ ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1
-*
-* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...).
-*
- DO 30 K = 2*N, 2, -2
- Z( 2*K ) = ZERO
- Z( 2*K-1 ) = Z( K )
- Z( 2*K-2 ) = ZERO
- Z( 2*K-3 ) = Z( K-1 )
- 30 CONTINUE
-*
- I0 = 1
- N0 = N
-*
-* Reverse the qd-array, if warranted.
-*
- IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( I4-3 )
- Z( I4-3 ) = Z( IPN4-I4-3 )
- Z( IPN4-I4-3 ) = TEMP
- TEMP = Z( I4-1 )
- Z( I4-1 ) = Z( IPN4-I4-5 )
- Z( IPN4-I4-5 ) = TEMP
- 40 CONTINUE
- END IF
-*
-* Initial split checking via dqd and Li's test.
-*
- PP = 0
-*
- DO 80 K = 1, 2
-*
- D = Z( 4*N0+PP-3 )
- DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4
- IF( Z( I4-1 ).LE.TOL2*D ) THEN
- Z( I4-1 ) = -ZERO
- D = Z( I4-3 )
- ELSE
- D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) )
- END IF
- 50 CONTINUE
-*
-* dqd maps Z to ZZ plus Li's test.
-*
- EMIN = Z( 4*I0+PP+1 )
- D = Z( 4*I0+PP-3 )
- DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4
- Z( I4-2*PP-2 ) = D + Z( I4-1 )
- IF( Z( I4-1 ).LE.TOL2*D ) THEN
- Z( I4-1 ) = -ZERO
- Z( I4-2*PP-2 ) = D
- Z( I4-2*PP ) = ZERO
- D = Z( I4+1 )
- ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND.
- $ SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN
- TEMP = Z( I4+1 ) / Z( I4-2*PP-2 )
- Z( I4-2*PP ) = Z( I4-1 )*TEMP
- D = D*TEMP
- ELSE
- Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) )
- D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) )
- END IF
- EMIN = MIN( EMIN, Z( I4-2*PP ) )
- 60 CONTINUE
- Z( 4*N0-PP-2 ) = D
-*
-* Now find qmax.
-*
- QMAX = Z( 4*I0-PP-2 )
- DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4
- QMAX = MAX( QMAX, Z( I4 ) )
- 70 CONTINUE
-*
-* Prepare for the next iteration on K.
-*
- PP = 1 - PP
- 80 CONTINUE
-*
-* Initialise variables to pass to DLASQ3.
-*
- TTYPE = 0
- DMIN1 = ZERO
- DMIN2 = ZERO
- DN = ZERO
- DN1 = ZERO
- DN2 = ZERO
- G = ZERO
- TAU = ZERO
-*
- ITER = 2
- NFAIL = 0
- NDIV = 2*( N0-I0 )
-*
- DO 160 IWHILA = 1, N + 1
- IF( N0.LT.1 )
- $ GO TO 170
-*
-* While array unfinished do
-*
-* E(N0) holds the value of SIGMA when submatrix in I0:N0
-* splits from the rest of the array, but is negated.
-*
- DESIG = ZERO
- IF( N0.EQ.N ) THEN
- SIGMA = ZERO
- ELSE
- SIGMA = -Z( 4*N0-1 )
- END IF
- IF( SIGMA.LT.ZERO ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Find last unreduced submatrix's top index I0, find QMAX and
-* EMIN. Find Gershgorin-type bound if Q's much greater than E's.
-*
- EMAX = ZERO
- IF( N0.GT.I0 ) THEN
- EMIN = ABS( Z( 4*N0-5 ) )
- ELSE
- EMIN = ZERO
- END IF
- QMIN = Z( 4*N0-3 )
- QMAX = QMIN
- DO 90 I4 = 4*N0, 8, -4
- IF( Z( I4-5 ).LE.ZERO )
- $ GO TO 100
- IF( QMIN.GE.FOUR*EMAX ) THEN
- QMIN = MIN( QMIN, Z( I4-3 ) )
- EMAX = MAX( EMAX, Z( I4-5 ) )
- END IF
- QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) )
- EMIN = MIN( EMIN, Z( I4-5 ) )
- 90 CONTINUE
- I4 = 4
-*
- 100 CONTINUE
- I0 = I4 / 4
- PP = 0
-*
- IF( N0-I0.GT.1 ) THEN
- DEE = Z( 4*I0-3 )
- DEEMIN = DEE
- KMIN = I0
- DO 110 I4 = 4*I0+1, 4*N0-3, 4
- DEE = Z( I4 )*( DEE /( DEE+Z( I4-2 ) ) )
- IF( DEE.LE.DEEMIN ) THEN
- DEEMIN = DEE
- KMIN = ( I4+3 )/4
- END IF
- 110 CONTINUE
- IF( (KMIN-I0)*2.LT.N0-KMIN .AND.
- $ DEEMIN.LE.HALF*Z(4*N0-3) ) THEN
- IPN4 = 4*( I0+N0 )
- PP = 2
- DO 120 I4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( I4-3 )
- Z( I4-3 ) = Z( IPN4-I4-3 )
- Z( IPN4-I4-3 ) = TEMP
- TEMP = Z( I4-2 )
- Z( I4-2 ) = Z( IPN4-I4-2 )
- Z( IPN4-I4-2 ) = TEMP
- TEMP = Z( I4-1 )
- Z( I4-1 ) = Z( IPN4-I4-5 )
- Z( IPN4-I4-5 ) = TEMP
- TEMP = Z( I4 )
- Z( I4 ) = Z( IPN4-I4-4 )
- Z( IPN4-I4-4 ) = TEMP
- 120 CONTINUE
- END IF
- END IF
-*
-* Put -(initial shift) into DMIN.
-*
- DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) )
-*
-* Now I0:N0 is unreduced.
-* PP = 0 for ping, PP = 1 for pong.
-* PP = 2 indicates that flipping was applied to the Z array and
-* and that the tests for deflation upon entry in DLASQ3
-* should not be performed.
-*
- NBIG = 100*( N0-I0+1 )
- DO 140 IWHILB = 1, NBIG
- IF( I0.GT.N0 )
- $ GO TO 150
-*
-* While submatrix unfinished take a good dqds step.
-*
- CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, G, TAU )
-*
- PP = 1 - PP
-*
-* When EMIN is very small check for splits.
-*
- IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN
- IF( Z( 4*N0 ).LE.TOL2*QMAX .OR.
- $ Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN
- SPLT = I0 - 1
- QMAX = Z( 4*I0-3 )
- EMIN = Z( 4*I0-1 )
- OLDEMN = Z( 4*I0 )
- DO 130 I4 = 4*I0, 4*( N0-3 ), 4
- IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR.
- $ Z( I4-1 ).LE.TOL2*SIGMA ) THEN
- Z( I4-1 ) = -SIGMA
- SPLT = I4 / 4
- QMAX = ZERO
- EMIN = Z( I4+3 )
- OLDEMN = Z( I4+4 )
- ELSE
- QMAX = MAX( QMAX, Z( I4+1 ) )
- EMIN = MIN( EMIN, Z( I4-1 ) )
- OLDEMN = MIN( OLDEMN, Z( I4 ) )
- END IF
- 130 CONTINUE
- Z( 4*N0-1 ) = EMIN
- Z( 4*N0 ) = OLDEMN
- I0 = SPLT + 1
- END IF
- END IF
-*
- 140 CONTINUE
-*
- INFO = 2
-*
-* Maximum number of iterations exceeded, restore the shift
-* SIGMA and place the new d's and e's in a qd array.
-* This might need to be done for several blocks
-*
- I1 = I0
- N1 = N0
- 145 CONTINUE
- TEMPQ = Z( 4*I0-3 )
- Z( 4*I0-3 ) = Z( 4*I0-3 ) + SIGMA
- DO K = I0+1, N0
- TEMPE = Z( 4*K-5 )
- Z( 4*K-5 ) = Z( 4*K-5 ) * (TEMPQ / Z( 4*K-7 ))
- TEMPQ = Z( 4*K-3 )
- Z( 4*K-3 ) = Z( 4*K-3 ) + SIGMA + TEMPE - Z( 4*K-5 )
- END DO
-*
-* Prepare to do this on the previous block if there is one
-*
- IF( I1.GT.1 ) THEN
- N1 = I1-1
- DO WHILE( ( I1.GE.2 ) .AND. ( Z(4*I1-5).GE.ZERO ) )
- I1 = I1 - 1
- END DO
- SIGMA = -Z(4*N1-1)
- GO TO 145
- END IF
-
- DO K = 1, N
- Z( 2*K-1 ) = Z( 4*K-3 )
-*
-* Only the block 1..N0 is unfinished. The rest of the e's
-* must be essentially zero, although sometimes other data
-* has been stored in them.
-*
- IF( K.LT.N0 ) THEN
- Z( 2*K ) = Z( 4*K-1 )
- ELSE
- Z( 2*K ) = 0
- END IF
- END DO
- RETURN
-*
-* end IWHILB
-*
- 150 CONTINUE
-*
- 160 CONTINUE
-*
- INFO = 3
- RETURN
-*
-* end IWHILA
-*
- 170 CONTINUE
-*
-* Move q's to the front.
-*
- DO 180 K = 2, N
- Z( K ) = Z( 4*K-3 )
- 180 CONTINUE
-*
-* Sort and compute sum of eigenvalues.
-*
- CALL DLASRT( 'D', N, Z, IINFO )
-*
- E = ZERO
- DO 190 K = N, 1, -1
- E = E + Z( K )
- 190 CONTINUE
-*
-* Store trace, sum(eigenvalues) and information on performance.
-*
- Z( 2*N+1 ) = TRACE
- Z( 2*N+2 ) = E
- Z( 2*N+3 ) = DBLE( ITER )
- Z( 2*N+4 ) = DBLE( NDIV ) / DBLE( N**2 )
- Z( 2*N+5 ) = HUNDRD*NFAIL / DBLE( ITER )
- RETURN
-*
-* End of DLASQ2
-*
- END
diff --git a/netlib/LAPACK/dlasq3.f b/netlib/LAPACK/dlasq3.f
deleted file mode 100644
index d49d1c5..0000000
--- a/netlib/LAPACK/dlasq3.f
+++ /dev/null
@@ -1,421 +0,0 @@
-*> \brief \b DLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
-* ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
-* DN2, G, TAU )
-*
-* .. Scalar Arguments ..
-* LOGICAL IEEE
-* INTEGER I0, ITER, N0, NDIV, NFAIL, PP
-* DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
-* $ QMAX, SIGMA, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
-*> In case of failure it changes shifts, and tries again until output
-*> is positive.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in,out] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array.
-*> \endverbatim
-*>
-*> \param[in,out] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> PP=2 indicates that flipping was applied to the Z array
-*> and that the initial tests for deflation should not be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> Sum of shifts used in current segment.
-*> \endverbatim
-*>
-*> \param[in,out] DESIG
-*> \verbatim
-*> DESIG is DOUBLE PRECISION
-*> Lower order part of SIGMA
-*> \endverbatim
-*>
-*> \param[in] QMAX
-*> \verbatim
-*> QMAX is DOUBLE PRECISION
-*> Maximum value of q.
-*> \endverbatim
-*>
-*> \param[out] NFAIL
-*> \verbatim
-*> NFAIL is INTEGER
-*> Number of times shift was too big.
-*> \endverbatim
-*>
-*> \param[out] ITER
-*> \verbatim
-*> ITER is INTEGER
-*> Number of iterations.
-*> \endverbatim
-*>
-*> \param[out] NDIV
-*> \verbatim
-*> NDIV is INTEGER
-*> Number of divisions.
-*> \endverbatim
-*>
-*> \param[in] IEEE
-*> \verbatim
-*> IEEE is LOGICAL
-*> Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
-*> \endverbatim
-*>
-*> \param[in,out] TTYPE
-*> \verbatim
-*> TTYPE is INTEGER
-*> Shift type.
-*> \endverbatim
-*>
-*> \param[in,out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DN1
-*> \verbatim
-*> DN1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DN2
-*> \verbatim
-*> DN2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*>
-*> These are passed as arguments in order to save their values
-*> between calls to DLASQ3.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, G, TAU )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, ITER, N0, NDIV, NFAIL, PP
- DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
- $ QMAX, SIGMA, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CBIAS
- PARAMETER ( CBIAS = 1.50D0 )
- DOUBLE PRECISION ZERO, QURTR, HALF, ONE, TWO, HUNDRD
- PARAMETER ( ZERO = 0.0D0, QURTR = 0.250D0, HALF = 0.5D0,
- $ ONE = 1.0D0, TWO = 2.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER IPN4, J4, N0IN, NN, TTYPE
- DOUBLE PRECISION EPS, S, T, TEMP, TOL, TOL2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASQ4, DLASQ5, DLASQ6
-* ..
-* .. External Function ..
- DOUBLE PRECISION DLAMCH
- LOGICAL DISNAN
- EXTERNAL DISNAN, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- N0IN = N0
- EPS = DLAMCH( 'Precision' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
-*
-* Check for deflation.
-*
- 10 CONTINUE
-*
- IF( N0.LT.I0 )
- $ RETURN
- IF( N0.EQ.I0 )
- $ GO TO 20
- NN = 4*N0 + PP
- IF( N0.EQ.( I0+1 ) )
- $ GO TO 40
-*
-* Check whether E(N0-1) is negligible, 1 eigenvalue.
-*
- IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
- $ Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
- $ GO TO 30
-*
- 20 CONTINUE
-*
- Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
- N0 = N0 - 1
- GO TO 10
-*
-* Check whether E(N0-2) is negligible, 2 eigenvalues.
-*
- 30 CONTINUE
-*
- IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
- $ Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
- $ GO TO 50
-*
- 40 CONTINUE
-*
- IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
- S = Z( NN-3 )
- Z( NN-3 ) = Z( NN-7 )
- Z( NN-7 ) = S
- END IF
- T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
- IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2.AND.T.NE.ZERO ) THEN
- S = Z( NN-3 )*( Z( NN-5 ) / T )
- IF( S.LE.T ) THEN
- S = Z( NN-3 )*( Z( NN-5 ) /
- $ ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( NN-7 ) + ( S+Z( NN-5 ) )
- Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
- Z( NN-7 ) = T
- END IF
- Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
- Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
- N0 = N0 - 2
- GO TO 10
-*
- 50 CONTINUE
- IF( PP.EQ.2 )
- $ PP = 0
-*
-* Reverse the qd-array, if warranted.
-*
- IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
- IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( J4-3 )
- Z( J4-3 ) = Z( IPN4-J4-3 )
- Z( IPN4-J4-3 ) = TEMP
- TEMP = Z( J4-2 )
- Z( J4-2 ) = Z( IPN4-J4-2 )
- Z( IPN4-J4-2 ) = TEMP
- TEMP = Z( J4-1 )
- Z( J4-1 ) = Z( IPN4-J4-5 )
- Z( IPN4-J4-5 ) = TEMP
- TEMP = Z( J4 )
- Z( J4 ) = Z( IPN4-J4-4 )
- Z( IPN4-J4-4 ) = TEMP
- 60 CONTINUE
- IF( N0-I0.LE.4 ) THEN
- Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
- Z( 4*N0-PP ) = Z( 4*I0-PP )
- END IF
- DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
- Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
- $ Z( 4*I0+PP+3 ) )
- Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
- $ Z( 4*I0-PP+4 ) )
- QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
- DMIN = -ZERO
- END IF
- END IF
-*
-* Choose a shift.
-*
- CALL DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
- $ DN2, TAU, TTYPE, G )
-*
-* Call dqds until DMIN > 0.
-*
- 70 CONTINUE
-*
- CALL DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, IEEE, EPS )
-*
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
-*
-* Check status.
-*
- IF( DMIN.GE.ZERO .AND. DMIN1.GE.ZERO ) THEN
-*
-* Success.
-*
- GO TO 90
-*
- ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
- $ Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
- $ ABS( DN ).LT.TOL*SIGMA ) THEN
-*
-* Convergence hidden by negative DN.
-*
- Z( 4*( N0-1 )-PP+2 ) = ZERO
- DMIN = ZERO
- GO TO 90
- ELSE IF( DMIN.LT.ZERO ) THEN
-*
-* TAU too big. Select new TAU and try again.
-*
- NFAIL = NFAIL + 1
- IF( TTYPE.LT.-22 ) THEN
-*
-* Failed twice. Play it safe.
-*
- TAU = ZERO
- ELSE IF( DMIN1.GT.ZERO ) THEN
-*
-* Late failure. Gives excellent shift.
-*
- TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
- TTYPE = TTYPE - 11
- ELSE
-*
-* Early failure. Divide by 4.
-*
- TAU = QURTR*TAU
- TTYPE = TTYPE - 12
- END IF
- GO TO 70
- ELSE IF( DISNAN( DMIN ) ) THEN
-*
-* NaN.
-*
- IF( TAU.EQ.ZERO ) THEN
- GO TO 80
- ELSE
- TAU = ZERO
- GO TO 70
- END IF
- ELSE
-*
-* Possible underflow. Play it safe.
-*
- GO TO 80
- END IF
-*
-* Risk of underflow.
-*
- 80 CONTINUE
- CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
- TAU = ZERO
-*
- 90 CONTINUE
- IF( TAU.LT.SIGMA ) THEN
- DESIG = DESIG + TAU
- T = SIGMA + DESIG
- DESIG = DESIG - ( T-SIGMA )
- ELSE
- T = SIGMA + TAU
- DESIG = SIGMA - ( T-TAU ) + DESIG
- END IF
- SIGMA = T
-*
- RETURN
-*
-* End of DLASQ3
-*
- END
diff --git a/netlib/LAPACK/dlasq4.f b/netlib/LAPACK/dlasq4.f
deleted file mode 100644
index 97d9bde..0000000
--- a/netlib/LAPACK/dlasq4.f
+++ /dev/null
@@ -1,425 +0,0 @@
-*> \brief \b DLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
-* DN1, DN2, TAU, TTYPE, G )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, N0IN, PP, TTYPE
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ4 computes an approximation TAU to the smallest eigenvalue
-*> using values of d from the previous transform.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[in] N0IN
-*> \verbatim
-*> N0IN is INTEGER
-*> The value of N0 at start of EIGTEST.
-*> \endverbatim
-*>
-*> \param[in] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[in] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[in] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[in] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N)
-*> \endverbatim
-*>
-*> \param[in] DN1
-*> \verbatim
-*> DN1 is DOUBLE PRECISION
-*> d(N-1)
-*> \endverbatim
-*>
-*> \param[in] DN2
-*> \verbatim
-*> DN2 is DOUBLE PRECISION
-*> d(N-2)
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> This is the shift.
-*> \endverbatim
-*>
-*> \param[out] TTYPE
-*> \verbatim
-*> TTYPE is INTEGER
-*> Shift type.
-*> \endverbatim
-*>
-*> \param[in,out] G
-*> \verbatim
-*> G is REAL
-*> G is passed as an argument in order to save its value between
-*> calls to DLASQ4.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> CNST1 = 9/16
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, TAU, TTYPE, G )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, N0IN, PP, TTYPE
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CNST1, CNST2, CNST3
- PARAMETER ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
- $ CNST3 = 1.050D0 )
- DOUBLE PRECISION QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
- PARAMETER ( QURTR = 0.250D0, THIRD = 0.3330D0,
- $ HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I4, NN, NP
- DOUBLE PRECISION A2, B1, B2, GAM, GAP1, GAP2, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* A negative DMIN forces the shift to take that absolute value
-* TTYPE records the type of shift.
-*
- IF( DMIN.LE.ZERO ) THEN
- TAU = -DMIN
- TTYPE = -1
- RETURN
- END IF
-*
- NN = 4*N0 + PP
- IF( N0IN.EQ.N0 ) THEN
-*
-* No eigenvalues deflated.
-*
- IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
-*
- B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
- B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
- A2 = Z( NN-7 ) + Z( NN-5 )
-*
-* Cases 2 and 3.
-*
- IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
- GAP2 = DMIN2 - A2 - DMIN2*QURTR
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
- GAP1 = A2 - DN - ( B2 / GAP2 )*B2
- ELSE
- GAP1 = A2 - DN - ( B1+B2 )
- END IF
- IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
- S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
- TTYPE = -2
- ELSE
- S = ZERO
- IF( DN.GT.B1 )
- $ S = DN - B1
- IF( A2.GT.( B1+B2 ) )
- $ S = MIN( S, A2-( B1+B2 ) )
- S = MAX( S, THIRD*DMIN )
- TTYPE = -3
- END IF
- ELSE
-*
-* Case 4.
-*
- TTYPE = -4
- S = QURTR*DMIN
- IF( DMIN.EQ.DN ) THEN
- GAM = DN
- A2 = ZERO
- IF( Z( NN-5 ) .GT. Z( NN-7 ) )
- $ RETURN
- B2 = Z( NN-5 ) / Z( NN-7 )
- NP = NN - 9
- ELSE
- NP = NN - 2*PP
- B2 = Z( NP-2 )
- GAM = DN1
- IF( Z( NP-4 ) .GT. Z( NP-2 ) )
- $ RETURN
- A2 = Z( NP-4 ) / Z( NP-2 )
- IF( Z( NN-9 ) .GT. Z( NN-11 ) )
- $ RETURN
- B2 = Z( NN-9 ) / Z( NN-11 )
- NP = NN - 13
- END IF
-*
-* Approximate contribution to norm squared from I < NN-1.
-*
- A2 = A2 + B2
- DO 10 I4 = NP, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 20
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 20
- 10 CONTINUE
- 20 CONTINUE
- A2 = CNST3*A2
-*
-* Rayleigh quotient residual bound.
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- END IF
- ELSE IF( DMIN.EQ.DN2 ) THEN
-*
-* Case 5.
-*
- TTYPE = -5
- S = QURTR*DMIN
-*
-* Compute contribution to norm squared from I > NN-2.
-*
- NP = NN - 2*PP
- B1 = Z( NP-2 )
- B2 = Z( NP-6 )
- GAM = DN2
- IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
- $ RETURN
- A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
-*
-* Approximate contribution to norm squared from I < NN-2.
-*
- IF( N0-I0.GT.2 ) THEN
- B2 = Z( NN-13 ) / Z( NN-15 )
- A2 = A2 + B2
- DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 40
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 40
- 30 CONTINUE
- 40 CONTINUE
- A2 = CNST3*A2
- END IF
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- ELSE
-*
-* Case 6, no information to guide us.
-*
- IF( TTYPE.EQ.-6 ) THEN
- G = G + THIRD*( ONE-G )
- ELSE IF( TTYPE.EQ.-18 ) THEN
- G = QURTR*THIRD
- ELSE
- G = QURTR
- END IF
- S = G*DMIN
- TTYPE = -6
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
-*
-* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
-*
- IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN
-*
-* Cases 7 and 8.
-*
- TTYPE = -7
- S = THIRD*DMIN1
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 60
- DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- A2 = B1
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*MAX( B1, A2 ).LT.B2 )
- $ GO TO 60
- 50 CONTINUE
- 60 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN1 / ( ONE+B2**2 )
- GAP2 = HALF*DMIN2 - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- TTYPE = -8
- END IF
- ELSE
-*
-* Case 9.
-*
- S = QURTR*DMIN1
- IF( DMIN1.EQ.DN1 )
- $ S = HALF*DMIN1
- TTYPE = -9
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
-*
-* Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
-*
-* Cases 10 and 11.
-*
- IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN
- TTYPE = -10
- S = THIRD*DMIN2
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 80
- DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*B1.LT.B2 )
- $ GO TO 80
- 70 CONTINUE
- 80 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN2 / ( ONE+B2**2 )
- GAP2 = Z( NN-7 ) + Z( NN-9 ) -
- $ SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- END IF
- ELSE
- S = QURTR*DMIN2
- TTYPE = -11
- END IF
- ELSE IF( N0IN.GT.( N0+2 ) ) THEN
-*
-* Case 12, more than two eigenvalues deflated. No information.
-*
- S = ZERO
- TTYPE = -12
- END IF
-*
- TAU = S
- RETURN
-*
-* End of DLASQ4
-*
- END
diff --git a/netlib/LAPACK/dlasq5.f b/netlib/LAPACK/dlasq5.f
deleted file mode 100644
index cdd8cf1..0000000
--- a/netlib/LAPACK/dlasq5.f
+++ /dev/null
@@ -1,410 +0,0 @@
-*> \brief \b DLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2, IEEE, EPS )
-*
-* .. Scalar Arguments ..
-* LOGICAL IEEE
-* INTEGER I0, N0, PP
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU, SIGMA, EPS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ5 computes one dqds transform in ping-pong form, one
-*> version for IEEE machines another for non IEEE machines.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> This is the shift.
-*> \endverbatim
-*>
-*> \param[in] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> This is the accumulated shift up to this step.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is DOUBLE PRECISION
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is DOUBLE PRECISION
-*> d(N0-2).
-*> \endverbatim
-*>
-*> \param[in] IEEE
-*> \verbatim
-*> IEEE is LOGICAL
-*> Flag for IEEE or non IEEE arithmetic.
-*> \endverbatim
-*
-*> \param[in] EPS
-*> \verbatim
-*> EPS is DOUBLE PRECISION
-*> This is the value of epsilon used.
-*> \endverbatim
-*>
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
- $ DN, DNM1, DNM2, IEEE, EPS )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, N0, PP
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU,
- $ SIGMA, EPS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- DOUBLE PRECISION ZERO, HALF
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- DOUBLE PRECISION D, EMIN, TEMP, DTHRESH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
- DTHRESH = EPS*(SIGMA+TAU)
- IF( TAU.LT.DTHRESH*HALF ) TAU = ZERO
- IF( TAU.NE.ZERO ) THEN
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 ) - TAU
- DMIN = D
- DMIN1 = -Z( J4 )
-*
- IF( IEEE ) THEN
-*
-* Code for IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 10 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- TEMP = Z( J4+1 ) / Z( J4-2 )
- D = D*TEMP - TAU
- DMIN = MIN( DMIN, D )
- Z( J4 ) = Z( J4-1 )*TEMP
- EMIN = MIN( Z( J4 ), EMIN )
- 10 CONTINUE
- ELSE
- DO 20 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- TEMP = Z( J4+2 ) / Z( J4-3 )
- D = D*TEMP - TAU
- DMIN = MIN( DMIN, D )
- Z( J4-1 ) = Z( J4 )*TEMP
- EMIN = MIN( Z( J4-1 ), EMIN )
- 20 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DN )
-*
- ELSE
-*
-* Code for non IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 30 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 30 CONTINUE
- ELSE
- DO 40 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 40 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( DNM2.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( DNM1.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DN )
-*
- END IF
- ELSE
-* This is the version that sets d's to zero if they are small enough
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 ) - TAU
- DMIN = D
- DMIN1 = -Z( J4 )
- IF( IEEE ) THEN
-*
-* Code for IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 50 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- TEMP = Z( J4+1 ) / Z( J4-2 )
- D = D*TEMP - TAU
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- Z( J4 ) = Z( J4-1 )*TEMP
- EMIN = MIN( Z( J4 ), EMIN )
- 50 CONTINUE
- ELSE
- DO 60 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- TEMP = Z( J4+2 ) / Z( J4-3 )
- D = D*TEMP - TAU
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- Z( J4-1 ) = Z( J4 )*TEMP
- EMIN = MIN( Z( J4-1 ), EMIN )
- 60 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DN )
-*
- ELSE
-*
-* Code for non IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 70 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
- END IF
- IF( D.LT.DTHRESH) D = ZERO
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 70 CONTINUE
- ELSE
- DO 80 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
- END IF
- IF( D.LT.DTHRESH) D = ZERO
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 80 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( DNM2.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( DNM1.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DN )
-*
- END IF
- END IF
-*
- Z( J4+2 ) = DN
- Z( 4*N0-PP ) = EMIN
- RETURN
-*
-* End of DLASQ5
-*
- END
diff --git a/netlib/LAPACK/dlasq6.f b/netlib/LAPACK/dlasq6.f
deleted file mode 100644
index 3c8661b..0000000
--- a/netlib/LAPACK/dlasq6.f
+++ /dev/null
@@ -1,254 +0,0 @@
-*> \brief \b DLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2 )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, PP
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ6 computes one dqd (shift equal to zero) transform in
-*> ping-pong form, with protection against underflow and overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is DOUBLE PRECISION
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is DOUBLE PRECISION
-*> d(N0-2).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
- $ DNM1, DNM2 )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, PP
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- DOUBLE PRECISION D, EMIN, SAFMIN, TEMP
-* ..
-* .. External Function ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 )
- DMIN = D
-*
- IF( PP.EQ.0 ) THEN
- DO 10 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- D = Z( J4+1 )
- DMIN = D
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4+1 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4+1 ) ) THEN
- TEMP = Z( J4+1 ) / Z( J4-2 )
- Z( J4 ) = Z( J4-1 )*TEMP
- D = D*TEMP
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 10 CONTINUE
- ELSE
- DO 20 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( Z( J4-3 ).EQ.ZERO ) THEN
- Z( J4-1 ) = ZERO
- D = Z( J4+2 )
- DMIN = D
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4+2 ).LT.Z( J4-3 ) .AND.
- $ SAFMIN*Z( J4-3 ).LT.Z( J4+2 ) ) THEN
- TEMP = Z( J4+2 ) / Z( J4-3 )
- Z( J4-1 ) = Z( J4 )*TEMP
- D = D*TEMP
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) )
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 20 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- DNM1 = Z( J4P2+2 )
- DMIN = DNM1
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
- TEMP = Z( J4P2+2 ) / Z( J4-2 )
- Z( J4 ) = Z( J4P2 )*TEMP
- DNM1 = DNM2*TEMP
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- DN = Z( J4P2+2 )
- DMIN = DN
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
- TEMP = Z( J4P2+2 ) / Z( J4-2 )
- Z( J4 ) = Z( J4P2 )*TEMP
- DN = DNM1*TEMP
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, DN )
-*
- Z( J4+2 ) = DN
- Z( 4*N0-PP ) = EMIN
- RETURN
-*
-* End of DLASQ6
-*
- END
diff --git a/netlib/LAPACK/dlasr.f b/netlib/LAPACK/dlasr.f
deleted file mode 100644
index 645d03b..0000000
--- a/netlib/LAPACK/dlasr.f
+++ /dev/null
@@ -1,436 +0,0 @@
-*> \brief \b DLASR applies a sequence of plane rotations to a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, PIVOT, SIDE
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASR applies a sequence of plane rotations to a real matrix A,
-*> from either the left or the right.
-*>
-*> When SIDE = 'L', the transformation takes the form
-*>
-*> A := P*A
-*>
-*> and when SIDE = 'R', the transformation takes the form
-*>
-*> A := A*P**T
-*>
-*> where P is an orthogonal matrix consisting of a sequence of z plane
-*> rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
-*> and P**T is the transpose of P.
-*>
-*> When DIRECT = 'F' (Forward sequence), then
-*>
-*> P = P(z-1) * ... * P(2) * P(1)
-*>
-*> and when DIRECT = 'B' (Backward sequence), then
-*>
-*> P = P(1) * P(2) * ... * P(z-1)
-*>
-*> where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
-*>
-*> R(k) = ( c(k) s(k) )
-*> = ( -s(k) c(k) ).
-*>
-*> When PIVOT = 'V' (Variable pivot), the rotation is performed
-*> for the plane (k,k+1), i.e., P(k) has the form
-*>
-*> P(k) = ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( c(k) s(k) )
-*> ( -s(k) c(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*>
-*> where R(k) appears as a rank-2 modification to the identity matrix in
-*> rows and columns k and k+1.
-*>
-*> When PIVOT = 'T' (Top pivot), the rotation is performed for the
-*> plane (1,k+1), so P(k) has the form
-*>
-*> P(k) = ( c(k) s(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( -s(k) c(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*>
-*> where R(k) appears in rows and columns 1 and k+1.
-*>
-*> Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
-*> performed for the plane (k,z), giving P(k) the form
-*>
-*> P(k) = ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( c(k) s(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( -s(k) c(k) )
-*>
-*> where R(k) appears in rows and columns k and z. The rotations are
-*> performed without ever forming P(k) explicitly.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> Specifies whether the plane rotation matrix P is applied to
-*> A on the left or the right.
-*> = 'L': Left, compute A := P*A
-*> = 'R': Right, compute A:= A*P**T
-*> \endverbatim
-*>
-*> \param[in] PIVOT
-*> \verbatim
-*> PIVOT is CHARACTER*1
-*> Specifies the plane for which P(k) is a plane rotation
-*> matrix.
-*> = 'V': Variable pivot, the plane (k,k+1)
-*> = 'T': Top pivot, the plane (1,k+1)
-*> = 'B': Bottom pivot, the plane (k,z)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Specifies whether P is a forward or backward sequence of
-*> plane rotations.
-*> = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
-*> = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. If m <= 1, an immediate
-*> return is effected.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. If n <= 1, an
-*> immediate return is effected.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> The cosines c(k) of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> The sines s(k) of the plane rotations. The 2-by-2 plane
-*> rotation part of the matrix P(k), R(k), has the form
-*> R(k) = ( c(k) s(k) )
-*> ( -s(k) c(k) ).
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The M-by-N matrix A. On exit, A is overwritten by P*A if
-*> SIDE = 'R' or by A*P**T if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, PIVOT, SIDE
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
- DOUBLE PRECISION CTEMP, STEMP, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
- INFO = 1
- ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
- $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
- INFO = 2
- ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
- $ THEN
- INFO = 3
- ELSE IF( M.LT.0 ) THEN
- INFO = 4
- ELSE IF( N.LT.0 ) THEN
- INFO = 5
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = 9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASR ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
- $ RETURN
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form P * A
-*
- IF( LSAME( PIVOT, 'V' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 20 J = 1, M - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 10 I = 1, N
- TEMP = A( J+1, I )
- A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
- A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 40 J = M - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 30 I = 1, N
- TEMP = A( J+1, I )
- A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
- A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 60 J = 2, M
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 50 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
- A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 80 J = M, 2, -1
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 70 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
- A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 100 J = 1, M - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 90 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
- A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 120 J = M - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 110 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
- A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
- END IF
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form A * P**T
-*
- IF( LSAME( PIVOT, 'V' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 140 J = 1, N - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 130 I = 1, M
- TEMP = A( I, J+1 )
- A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
- A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
- 130 CONTINUE
- END IF
- 140 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 160 J = N - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 150 I = 1, M
- TEMP = A( I, J+1 )
- A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
- A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
- 150 CONTINUE
- END IF
- 160 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 180 J = 2, N
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 170 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
- A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
- 170 CONTINUE
- END IF
- 180 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 200 J = N, 2, -1
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 190 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
- A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
- 190 CONTINUE
- END IF
- 200 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 220 J = 1, N - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 210 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
- A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
- 210 CONTINUE
- END IF
- 220 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 240 J = N - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 230 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
- A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
- 230 CONTINUE
- END IF
- 240 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DLASR
-*
- END
diff --git a/netlib/LAPACK/dlasrt.f b/netlib/LAPACK/dlasrt.f
deleted file mode 100644
index f5d0e6c..0000000
--- a/netlib/LAPACK/dlasrt.f
+++ /dev/null
@@ -1,303 +0,0 @@
-*> \brief \b DLASRT sorts numbers in increasing or decreasing order.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASRT( ID, N, D, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ID
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Sort the numbers in D in increasing order (if ID = 'I') or
-*> in decreasing order (if ID = 'D' ).
-*>
-*> Use Quick Sort, reverting to Insertion sort on arrays of
-*> size <= 20. Dimension of STACK limits N to about 2**32.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ID
-*> \verbatim
-*> ID is CHARACTER*1
-*> = 'I': sort D in increasing order;
-*> = 'D': sort D in decreasing order.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of the array D.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the array to be sorted.
-*> On exit, D has been sorted into increasing order
-*> (D(1) <= ... <= D(N) ) or into decreasing order
-*> (D(1) >= ... >= D(N) ), depending on ID.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASRT( ID, N, D, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER ID
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER SELECT
- PARAMETER ( SELECT = 20 )
-* ..
-* .. Local Scalars ..
- INTEGER DIR, ENDD, I, J, START, STKPNT
- DOUBLE PRECISION D1, D2, D3, DMNMX, TMP
-* ..
-* .. Local Arrays ..
- INTEGER STACK( 2, 32 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input paramters.
-*
- INFO = 0
- DIR = -1
- IF( LSAME( ID, 'D' ) ) THEN
- DIR = 0
- ELSE IF( LSAME( ID, 'I' ) ) THEN
- DIR = 1
- END IF
- IF( DIR.EQ.-1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- STKPNT = 1
- STACK( 1, 1 ) = 1
- STACK( 2, 1 ) = N
- 10 CONTINUE
- START = STACK( 1, STKPNT )
- ENDD = STACK( 2, STKPNT )
- STKPNT = STKPNT - 1
- IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
-*
-* Do Insertion sort on D( START:ENDD )
-*
- IF( DIR.EQ.0 ) THEN
-*
-* Sort into decreasing order
-*
- DO 30 I = START + 1, ENDD
- DO 20 J = I, START + 1, -1
- IF( D( J ).GT.D( J-1 ) ) THEN
- DMNMX = D( J )
- D( J ) = D( J-1 )
- D( J-1 ) = DMNMX
- ELSE
- GO TO 30
- END IF
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE
-*
-* Sort into increasing order
-*
- DO 50 I = START + 1, ENDD
- DO 40 J = I, START + 1, -1
- IF( D( J ).LT.D( J-1 ) ) THEN
- DMNMX = D( J )
- D( J ) = D( J-1 )
- D( J-1 ) = DMNMX
- ELSE
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- END IF
-*
- ELSE IF( ENDD-START.GT.SELECT ) THEN
-*
-* Partition D( START:ENDD ) and stack parts, largest one first
-*
-* Choose partition entry as median of 3
-*
- D1 = D( START )
- D2 = D( ENDD )
- I = ( START+ENDD ) / 2
- D3 = D( I )
- IF( D1.LT.D2 ) THEN
- IF( D3.LT.D1 ) THEN
- DMNMX = D1
- ELSE IF( D3.LT.D2 ) THEN
- DMNMX = D3
- ELSE
- DMNMX = D2
- END IF
- ELSE
- IF( D3.LT.D2 ) THEN
- DMNMX = D2
- ELSE IF( D3.LT.D1 ) THEN
- DMNMX = D3
- ELSE
- DMNMX = D1
- END IF
- END IF
-*
- IF( DIR.EQ.0 ) THEN
-*
-* Sort into decreasing order
-*
- I = START - 1
- J = ENDD + 1
- 60 CONTINUE
- 70 CONTINUE
- J = J - 1
- IF( D( J ).LT.DMNMX )
- $ GO TO 70
- 80 CONTINUE
- I = I + 1
- IF( D( I ).GT.DMNMX )
- $ GO TO 80
- IF( I.LT.J ) THEN
- TMP = D( I )
- D( I ) = D( J )
- D( J ) = TMP
- GO TO 60
- END IF
- IF( J-START.GT.ENDD-J-1 ) THEN
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- ELSE
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- END IF
- ELSE
-*
-* Sort into increasing order
-*
- I = START - 1
- J = ENDD + 1
- 90 CONTINUE
- 100 CONTINUE
- J = J - 1
- IF( D( J ).GT.DMNMX )
- $ GO TO 100
- 110 CONTINUE
- I = I + 1
- IF( D( I ).LT.DMNMX )
- $ GO TO 110
- IF( I.LT.J ) THEN
- TMP = D( I )
- D( I ) = D( J )
- D( J ) = TMP
- GO TO 90
- END IF
- IF( J-START.GT.ENDD-J-1 ) THEN
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- ELSE
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- END IF
- END IF
- END IF
- IF( STKPNT.GT.0 )
- $ GO TO 10
- RETURN
-*
-* End of DLASRT
-*
- END
diff --git a/netlib/LAPACK/dlassq.f b/netlib/LAPACK/dlassq.f
deleted file mode 100644
index c7c4087..0000000
--- a/netlib/LAPACK/dlassq.f
+++ /dev/null
@@ -1,155 +0,0 @@
-*> \brief \b DLASSQ updates a sum of squares represented in scaled form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASSQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION SCALE, SUMSQ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASSQ returns the values scl and smsq such that
-*>
-*> ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
-*>
-*> where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
-*> assumed to be non-negative and scl returns the value
-*>
-*> scl = max( scale, abs( x( i ) ) ).
-*>
-*> scale and sumsq must be supplied in SCALE and SUMSQ and
-*> scl and smsq are overwritten on SCALE and SUMSQ respectively.
-*>
-*> The routine makes only one pass through the vector x.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements to be used from the vector X.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> The vector for which a scaled sum of squares is computed.
-*> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of the vector X.
-*> INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On entry, the value scale in the equation above.
-*> On exit, SCALE is overwritten with scl , the scaling factor
-*> for the sum of squares.
-*> \endverbatim
-*>
-*> \param[in,out] SUMSQ
-*> \verbatim
-*> SUMSQ is DOUBLE PRECISION
-*> On entry, the value sumsq in the equation above.
-*> On exit, SUMSQ is overwritten with smsq , the basic sum of
-*> squares from which scl has been factored out.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION SCALE, SUMSQ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER IX
- DOUBLE PRECISION ABSXI
-* ..
-* .. External Functions ..
- LOGICAL DISNAN
- EXTERNAL DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( N.GT.0 ) THEN
- DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
- ABSXI = ABS( X( IX ) )
- IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN
- IF( SCALE.LT.ABSXI ) THEN
- SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
- SCALE = ABSXI
- ELSE
- SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
- END IF
- END IF
- 10 CONTINUE
- END IF
- RETURN
-*
-* End of DLASSQ
-*
- END
diff --git a/netlib/LAPACK/dlasv2.f b/netlib/LAPACK/dlasv2.f
deleted file mode 100644
index 96aaa1e..0000000
--- a/netlib/LAPACK/dlasv2.f
+++ /dev/null
@@ -1,325 +0,0 @@
-*> \brief \b DLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasv2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasv2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasv2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASV2 computes the singular value decomposition of a 2-by-2
-*> triangular matrix
-*> [ F G ]
-*> [ 0 H ].
-*> On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
-*> smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
-*> right singular vectors for abs(SSMAX), giving the decomposition
-*>
-*> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
-*> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The (1,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is DOUBLE PRECISION
-*> abs(SSMIN) is the smaller singular value.
-*> \endverbatim
-*>
-*> \param[out] SSMAX
-*> \verbatim
-*> SSMAX is DOUBLE PRECISION
-*> abs(SSMAX) is the larger singular value.
-*> \endverbatim
-*>
-*> \param[out] SNL
-*> \verbatim
-*> SNL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] CSL
-*> \verbatim
-*> CSL is DOUBLE PRECISION
-*> The vector (CSL, SNL) is a unit left singular vector for the
-*> singular value abs(SSMAX).
-*> \endverbatim
-*>
-*> \param[out] SNR
-*> \verbatim
-*> SNR is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] CSR
-*> \verbatim
-*> CSR is DOUBLE PRECISION
-*> The vector (CSR, SNR) is a unit right singular vector for the
-*> singular value abs(SSMAX).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Any input parameter may be aliased with any output parameter.
-*>
-*> Barring over/underflow and assuming a guard digit in subtraction, all
-*> output quantities are correct to within a few units in the last
-*> place (ulps).
-*>
-*> In IEEE arithmetic, the code works correctly if one matrix element is
-*> infinite.
-*>
-*> Overflow will not occur unless the largest singular value itself
-*> overflows or is within a few ulps of overflow. (On machines with
-*> partial overflow, like the Cray, overflow may occur if the largest
-*> singular value is within a factor of 2 of overflow.)
-*>
-*> Underflow is harmless if underflow is gradual. Otherwise, results
-*> may correspond to a matrix modified by perturbations of size near
-*> the underflow threshold.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 0.5D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
- DOUBLE PRECISION FOUR
- PARAMETER ( FOUR = 4.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL GASMAL, SWAP
- INTEGER PMAX
- DOUBLE PRECISION A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
- $ MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Executable Statements ..
-*
- FT = F
- FA = ABS( FT )
- HT = H
- HA = ABS( H )
-*
-* PMAX points to the maximum absolute element of matrix
-* PMAX = 1 if F largest in absolute values
-* PMAX = 2 if G largest in absolute values
-* PMAX = 3 if H largest in absolute values
-*
- PMAX = 1
- SWAP = ( HA.GT.FA )
- IF( SWAP ) THEN
- PMAX = 3
- TEMP = FT
- FT = HT
- HT = TEMP
- TEMP = FA
- FA = HA
- HA = TEMP
-*
-* Now FA .ge. HA
-*
- END IF
- GT = G
- GA = ABS( GT )
- IF( GA.EQ.ZERO ) THEN
-*
-* Diagonal matrix
-*
- SSMIN = HA
- SSMAX = FA
- CLT = ONE
- CRT = ONE
- SLT = ZERO
- SRT = ZERO
- ELSE
- GASMAL = .TRUE.
- IF( GA.GT.FA ) THEN
- PMAX = 2
- IF( ( FA / GA ).LT.DLAMCH( 'EPS' ) ) THEN
-*
-* Case of very large GA
-*
- GASMAL = .FALSE.
- SSMAX = GA
- IF( HA.GT.ONE ) THEN
- SSMIN = FA / ( GA / HA )
- ELSE
- SSMIN = ( FA / GA )*HA
- END IF
- CLT = ONE
- SLT = HT / GT
- SRT = ONE
- CRT = FT / GT
- END IF
- END IF
- IF( GASMAL ) THEN
-*
-* Normal case
-*
- D = FA - HA
- IF( D.EQ.FA ) THEN
-*
-* Copes with infinite F or H
-*
- L = ONE
- ELSE
- L = D / FA
- END IF
-*
-* Note that 0 .le. L .le. 1
-*
- M = GT / FT
-*
-* Note that abs(M) .le. 1/macheps
-*
- T = TWO - L
-*
-* Note that T .ge. 1
-*
- MM = M*M
- TT = T*T
- S = SQRT( TT+MM )
-*
-* Note that 1 .le. S .le. 1 + 1/macheps
-*
- IF( L.EQ.ZERO ) THEN
- R = ABS( M )
- ELSE
- R = SQRT( L*L+MM )
- END IF
-*
-* Note that 0 .le. R .le. 1 + 1/macheps
-*
- A = HALF*( S+R )
-*
-* Note that 1 .le. A .le. 1 + abs(M)
-*
- SSMIN = HA / A
- SSMAX = FA*A
- IF( MM.EQ.ZERO ) THEN
-*
-* Note that M is very tiny
-*
- IF( L.EQ.ZERO ) THEN
- T = SIGN( TWO, FT )*SIGN( ONE, GT )
- ELSE
- T = GT / SIGN( D, FT ) + M / T
- END IF
- ELSE
- T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
- END IF
- L = SQRT( T*T+FOUR )
- CRT = TWO / L
- SRT = T / L
- CLT = ( CRT+SRT*M ) / A
- SLT = ( HT / FT )*SRT / A
- END IF
- END IF
- IF( SWAP ) THEN
- CSL = SRT
- SNL = CRT
- CSR = SLT
- SNR = CLT
- ELSE
- CSL = CLT
- SNL = SLT
- CSR = CRT
- SNR = SRT
- END IF
-*
-* Correct signs of SSMAX and SSMIN
-*
- IF( PMAX.EQ.1 )
- $ TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
- IF( PMAX.EQ.2 )
- $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
- IF( PMAX.EQ.3 )
- $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
- SSMAX = SIGN( SSMAX, TSIGN )
- SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
- RETURN
-*
-* End of DLASV2
-*
- END
diff --git a/netlib/LAPACK/dlaswp.f b/netlib/LAPACK/dlaswp.f
deleted file mode 100644
index 937e12b..0000000
--- a/netlib/LAPACK/dlaswp.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b DLASWP performs a series of row interchanges on a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASWP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaswp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaswp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaswp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASWP performs a series of row interchanges on the matrix A.
-*> One row interchange is initiated for each of rows K1 through K2 of A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the matrix of column dimension N to which the row
-*> interchanges will be applied.
-*> On exit, the permuted matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> \endverbatim
-*>
-*> \param[in] K1
-*> \verbatim
-*> K1 is INTEGER
-*> The first element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] K2
-*> \verbatim
-*> K2 is INTEGER
-*> The last element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (K2*abs(INCX))
-*> The vector of pivot indices. Only the elements in positions
-*> K1 through K2 of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
-*> is negative, the pivots are applied in reverse order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by
-*> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
- IF( INCX.GT.0 ) THEN
- IX0 = K1
- I1 = K1
- I2 = K2
- INC = 1
- ELSE IF( INCX.LT.0 ) THEN
- IX0 = 1 + ( 1-K2 )*INCX
- I1 = K2
- I2 = K1
- INC = -1
- ELSE
- RETURN
- END IF
-*
- N32 = ( N / 32 )*32
- IF( N32.NE.0 ) THEN
- DO 30 J = 1, N32, 32
- IX = IX0
- DO 20 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 10 K = J, J + 31
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 10 CONTINUE
- END IF
- IX = IX + INCX
- 20 CONTINUE
- 30 CONTINUE
- END IF
- IF( N32.NE.N ) THEN
- N32 = N32 + 1
- IX = IX0
- DO 50 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 40 K = N32, N
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 40 CONTINUE
- END IF
- IX = IX + INCX
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DLASWP
-*
- END
diff --git a/netlib/LAPACK/dlasy2.f b/netlib/LAPACK/dlasy2.f
deleted file mode 100644
index a4b1030..0000000
--- a/netlib/LAPACK/dlasy2.f
+++ /dev/null
@@ -1,480 +0,0 @@
-*> \brief \b DLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASY2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasy2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasy2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasy2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
-* LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LTRANL, LTRANR
-* INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
-* DOUBLE PRECISION SCALE, XNORM
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
-*>
-*> op(TL)*X + ISGN*X*op(TR) = SCALE*B,
-*>
-*> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
-*> -1. op(T) = T or T**T, where T**T denotes the transpose of T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRANL
-*> \verbatim
-*> LTRANL is LOGICAL
-*> On entry, LTRANL specifies the op(TL):
-*> = .FALSE., op(TL) = TL,
-*> = .TRUE., op(TL) = TL**T.
-*> \endverbatim
-*>
-*> \param[in] LTRANR
-*> \verbatim
-*> LTRANR is LOGICAL
-*> On entry, LTRANR specifies the op(TR):
-*> = .FALSE., op(TR) = TR,
-*> = .TRUE., op(TR) = TR**T.
-*> \endverbatim
-*>
-*> \param[in] ISGN
-*> \verbatim
-*> ISGN is INTEGER
-*> On entry, ISGN specifies the sign of the equation
-*> as described before. ISGN may only be 1 or -1.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> On entry, N1 specifies the order of matrix TL.
-*> N1 may only be 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> On entry, N2 specifies the order of matrix TR.
-*> N2 may only be 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] TL
-*> \verbatim
-*> TL is DOUBLE PRECISION array, dimension (LDTL,2)
-*> On entry, TL contains an N1 by N1 matrix.
-*> \endverbatim
-*>
-*> \param[in] LDTL
-*> \verbatim
-*> LDTL is INTEGER
-*> The leading dimension of the matrix TL. LDTL >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[in] TR
-*> \verbatim
-*> TR is DOUBLE PRECISION array, dimension (LDTR,2)
-*> On entry, TR contains an N2 by N2 matrix.
-*> \endverbatim
-*>
-*> \param[in] LDTR
-*> \verbatim
-*> LDTR is INTEGER
-*> The leading dimension of the matrix TR. LDTR >= max(1,N2).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,2)
-*> On entry, the N1 by N2 matrix B contains the right-hand
-*> side of the equation.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the matrix B. LDB >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On exit, SCALE contains the scale factor. SCALE is chosen
-*> less than or equal to 1 to prevent the solution overflowing.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,2)
-*> On exit, X contains the N1 by N2 solution.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the matrix X. LDX >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[out] XNORM
-*> \verbatim
-*> XNORM is DOUBLE PRECISION
-*> On exit, XNORM is the infinity-norm of the solution.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO is set to
-*> 0: successful exit.
-*> 1: TL and TR have too close eigenvalues, so TL or
-*> TR is perturbed to get a nonsingular equation.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
- $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL LTRANL, LTRANR
- INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
- DOUBLE PRECISION SCALE, XNORM
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TWO, HALF, EIGHT
- PARAMETER ( TWO = 2.0D+0, HALF = 0.5D+0, EIGHT = 8.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BSWAP, XSWAP
- INTEGER I, IP, IPIV, IPSV, J, JP, JPSV, K
- DOUBLE PRECISION BET, EPS, GAM, L21, SGN, SMIN, SMLNUM, TAU1,
- $ TEMP, U11, U12, U22, XMAX
-* ..
-* .. Local Arrays ..
- LOGICAL BSWPIV( 4 ), XSWPIV( 4 )
- INTEGER JPIV( 4 ), LOCL21( 4 ), LOCU12( 4 ),
- $ LOCU22( 4 )
- DOUBLE PRECISION BTMP( 4 ), T16( 4, 4 ), TMP( 4 ), X2( 2 )
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Data statements ..
- DATA LOCU12 / 3, 4, 1, 2 / , LOCL21 / 2, 1, 4, 3 / ,
- $ LOCU22 / 4, 3, 2, 1 /
- DATA XSWPIV / .FALSE., .FALSE., .TRUE., .TRUE. /
- DATA BSWPIV / .FALSE., .TRUE., .FALSE., .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* Do not check the input parameters for errors
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N1.EQ.0 .OR. N2.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- SGN = ISGN
-*
- K = N1 + N1 + N2 - 2
- GO TO ( 10, 20, 30, 50 )K
-*
-* 1 by 1: TL11*X + SGN*X*TR11 = B11
-*
- 10 CONTINUE
- TAU1 = TL( 1, 1 ) + SGN*TR( 1, 1 )
- BET = ABS( TAU1 )
- IF( BET.LE.SMLNUM ) THEN
- TAU1 = SMLNUM
- BET = SMLNUM
- INFO = 1
- END IF
-*
- SCALE = ONE
- GAM = ABS( B( 1, 1 ) )
- IF( SMLNUM*GAM.GT.BET )
- $ SCALE = ONE / GAM
-*
- X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / TAU1
- XNORM = ABS( X( 1, 1 ) )
- RETURN
-*
-* 1 by 2:
-* TL11*[X11 X12] + ISGN*[X11 X12]*op[TR11 TR12] = [B11 B12]
-* [TR21 TR22]
-*
- 20 CONTINUE
-*
- SMIN = MAX( EPS*MAX( ABS( TL( 1, 1 ) ), ABS( TR( 1, 1 ) ),
- $ ABS( TR( 1, 2 ) ), ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) ),
- $ SMLNUM )
- TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- TMP( 4 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
- IF( LTRANR ) THEN
- TMP( 2 ) = SGN*TR( 2, 1 )
- TMP( 3 ) = SGN*TR( 1, 2 )
- ELSE
- TMP( 2 ) = SGN*TR( 1, 2 )
- TMP( 3 ) = SGN*TR( 2, 1 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 1, 2 )
- GO TO 40
-*
-* 2 by 1:
-* op[TL11 TL12]*[X11] + ISGN* [X11]*TR11 = [B11]
-* [TL21 TL22] [X21] [X21] [B21]
-*
- 30 CONTINUE
- SMIN = MAX( EPS*MAX( ABS( TR( 1, 1 ) ), ABS( TL( 1, 1 ) ),
- $ ABS( TL( 1, 2 ) ), ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) ),
- $ SMLNUM )
- TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- TMP( 4 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
- IF( LTRANL ) THEN
- TMP( 2 ) = TL( 1, 2 )
- TMP( 3 ) = TL( 2, 1 )
- ELSE
- TMP( 2 ) = TL( 2, 1 )
- TMP( 3 ) = TL( 1, 2 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 2, 1 )
- 40 CONTINUE
-*
-* Solve 2 by 2 system using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- IPIV = IDAMAX( 4, TMP, 1 )
- U11 = TMP( IPIV )
- IF( ABS( U11 ).LE.SMIN ) THEN
- INFO = 1
- U11 = SMIN
- END IF
- U12 = TMP( LOCU12( IPIV ) )
- L21 = TMP( LOCL21( IPIV ) ) / U11
- U22 = TMP( LOCU22( IPIV ) ) - U12*L21
- XSWAP = XSWPIV( IPIV )
- BSWAP = BSWPIV( IPIV )
- IF( ABS( U22 ).LE.SMIN ) THEN
- INFO = 1
- U22 = SMIN
- END IF
- IF( BSWAP ) THEN
- TEMP = BTMP( 2 )
- BTMP( 2 ) = BTMP( 1 ) - L21*TEMP
- BTMP( 1 ) = TEMP
- ELSE
- BTMP( 2 ) = BTMP( 2 ) - L21*BTMP( 1 )
- END IF
- SCALE = ONE
- IF( ( TWO*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( U22 ) .OR.
- $ ( TWO*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( U11 ) ) THEN
- SCALE = HALF / MAX( ABS( BTMP( 1 ) ), ABS( BTMP( 2 ) ) )
- BTMP( 1 ) = BTMP( 1 )*SCALE
- BTMP( 2 ) = BTMP( 2 )*SCALE
- END IF
- X2( 2 ) = BTMP( 2 ) / U22
- X2( 1 ) = BTMP( 1 ) / U11 - ( U12 / U11 )*X2( 2 )
- IF( XSWAP ) THEN
- TEMP = X2( 2 )
- X2( 2 ) = X2( 1 )
- X2( 1 ) = TEMP
- END IF
- X( 1, 1 ) = X2( 1 )
- IF( N1.EQ.1 ) THEN
- X( 1, 2 ) = X2( 2 )
- XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- ELSE
- X( 2, 1 ) = X2( 2 )
- XNORM = MAX( ABS( X( 1, 1 ) ), ABS( X( 2, 1 ) ) )
- END IF
- RETURN
-*
-* 2 by 2:
-* op[TL11 TL12]*[X11 X12] +ISGN* [X11 X12]*op[TR11 TR12] = [B11 B12]
-* [TL21 TL22] [X21 X22] [X21 X22] [TR21 TR22] [B21 B22]
-*
-* Solve equivalent 4 by 4 system using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- 50 CONTINUE
- SMIN = MAX( ABS( TR( 1, 1 ) ), ABS( TR( 1, 2 ) ),
- $ ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) )
- SMIN = MAX( SMIN, ABS( TL( 1, 1 ) ), ABS( TL( 1, 2 ) ),
- $ ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) )
- SMIN = MAX( EPS*SMIN, SMLNUM )
- BTMP( 1 ) = ZERO
- CALL DCOPY( 16, BTMP, 0, T16, 1 )
- T16( 1, 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- T16( 2, 2 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
- T16( 3, 3 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
- T16( 4, 4 ) = TL( 2, 2 ) + SGN*TR( 2, 2 )
- IF( LTRANL ) THEN
- T16( 1, 2 ) = TL( 2, 1 )
- T16( 2, 1 ) = TL( 1, 2 )
- T16( 3, 4 ) = TL( 2, 1 )
- T16( 4, 3 ) = TL( 1, 2 )
- ELSE
- T16( 1, 2 ) = TL( 1, 2 )
- T16( 2, 1 ) = TL( 2, 1 )
- T16( 3, 4 ) = TL( 1, 2 )
- T16( 4, 3 ) = TL( 2, 1 )
- END IF
- IF( LTRANR ) THEN
- T16( 1, 3 ) = SGN*TR( 1, 2 )
- T16( 2, 4 ) = SGN*TR( 1, 2 )
- T16( 3, 1 ) = SGN*TR( 2, 1 )
- T16( 4, 2 ) = SGN*TR( 2, 1 )
- ELSE
- T16( 1, 3 ) = SGN*TR( 2, 1 )
- T16( 2, 4 ) = SGN*TR( 2, 1 )
- T16( 3, 1 ) = SGN*TR( 1, 2 )
- T16( 4, 2 ) = SGN*TR( 1, 2 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 2, 1 )
- BTMP( 3 ) = B( 1, 2 )
- BTMP( 4 ) = B( 2, 2 )
-*
-* Perform elimination
-*
- DO 100 I = 1, 3
- XMAX = ZERO
- DO 70 IP = I, 4
- DO 60 JP = I, 4
- IF( ABS( T16( IP, JP ) ).GE.XMAX ) THEN
- XMAX = ABS( T16( IP, JP ) )
- IPSV = IP
- JPSV = JP
- END IF
- 60 CONTINUE
- 70 CONTINUE
- IF( IPSV.NE.I ) THEN
- CALL DSWAP( 4, T16( IPSV, 1 ), 4, T16( I, 1 ), 4 )
- TEMP = BTMP( I )
- BTMP( I ) = BTMP( IPSV )
- BTMP( IPSV ) = TEMP
- END IF
- IF( JPSV.NE.I )
- $ CALL DSWAP( 4, T16( 1, JPSV ), 1, T16( 1, I ), 1 )
- JPIV( I ) = JPSV
- IF( ABS( T16( I, I ) ).LT.SMIN ) THEN
- INFO = 1
- T16( I, I ) = SMIN
- END IF
- DO 90 J = I + 1, 4
- T16( J, I ) = T16( J, I ) / T16( I, I )
- BTMP( J ) = BTMP( J ) - T16( J, I )*BTMP( I )
- DO 80 K = I + 1, 4
- T16( J, K ) = T16( J, K ) - T16( J, I )*T16( I, K )
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- IF( ABS( T16( 4, 4 ) ).LT.SMIN )
- $ T16( 4, 4 ) = SMIN
- SCALE = ONE
- IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 3 ) ).GT.ABS( T16( 3, 3 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 4 ) ).GT.ABS( T16( 4, 4 ) ) ) THEN
- SCALE = ( ONE / EIGHT ) / MAX( ABS( BTMP( 1 ) ),
- $ ABS( BTMP( 2 ) ), ABS( BTMP( 3 ) ), ABS( BTMP( 4 ) ) )
- BTMP( 1 ) = BTMP( 1 )*SCALE
- BTMP( 2 ) = BTMP( 2 )*SCALE
- BTMP( 3 ) = BTMP( 3 )*SCALE
- BTMP( 4 ) = BTMP( 4 )*SCALE
- END IF
- DO 120 I = 1, 4
- K = 5 - I
- TEMP = ONE / T16( K, K )
- TMP( K ) = BTMP( K )*TEMP
- DO 110 J = K + 1, 4
- TMP( K ) = TMP( K ) - ( TEMP*T16( K, J ) )*TMP( J )
- 110 CONTINUE
- 120 CONTINUE
- DO 130 I = 1, 3
- IF( JPIV( 4-I ).NE.4-I ) THEN
- TEMP = TMP( 4-I )
- TMP( 4-I ) = TMP( JPIV( 4-I ) )
- TMP( JPIV( 4-I ) ) = TEMP
- END IF
- 130 CONTINUE
- X( 1, 1 ) = TMP( 1 )
- X( 2, 1 ) = TMP( 2 )
- X( 1, 2 ) = TMP( 3 )
- X( 2, 2 ) = TMP( 4 )
- XNORM = MAX( ABS( TMP( 1 ) )+ABS( TMP( 3 ) ),
- $ ABS( TMP( 2 ) )+ABS( TMP( 4 ) ) )
- RETURN
-*
-* End of DLASY2
-*
- END
diff --git a/netlib/LAPACK/dlasyf.f b/netlib/LAPACK/dlasyf.f
deleted file mode 100644
index b16f270..0000000
--- a/netlib/LAPACK/dlasyf.f
+++ /dev/null
@@ -1,666 +0,0 @@
-*> \brief \b DLASYF computes a partial factorization of a real symmetric matrix, using the diagonal pivoting method.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASYF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasyf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasyf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasyf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KB, LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), W( LDW, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASYF computes a partial factorization of a real symmetric matrix A
-*> using the Bunch-Kaufman diagonal pivoting method. The partial
-*> factorization has the form:
-*>
-*> A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
-*> ( 0 U22 ) ( 0 D ) ( U12**T U22**T )
-*>
-*> A = ( L11 0 ) ( D 0 ) ( L11**T L21**T ) if UPLO = 'L'
-*> ( L21 I ) ( 0 A22 ) ( 0 I )
-*>
-*> where the order of D is at most NB. The actual order is returned in
-*> the argument KB, and is either NB or NB-1, or N if N <= NB.
-*>
-*> DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code
-*> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
-*> A22 (if UPLO = 'L').
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The maximum number of columns of the matrix A that should be
-*> factored. NB should be at least 2 to allow for 2-by-2 pivot
-*> blocks.
-*> \endverbatim
-*>
-*> \param[out] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of columns of A that were actually factored.
-*> KB is either NB-1 or NB, or N if N <= NB.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, A contains details of the partial factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If UPLO = 'U', only the last KB elements of IPIV are set;
-*> if UPLO = 'L', only the first KB elements are set.
-*>
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (LDW,NB)
-*> \endverbatim
-*>
-*> \param[in] LDW
-*> \verbatim
-*> LDW is INTEGER
-*> The leading dimension of the array W. LDW >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = k, D(k,k) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KB, LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), W( LDW, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION EIGHT, SEVTEN
- PARAMETER ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP,
- $ KSTEP, KW
- DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D21, D22, R1,
- $ ROWMAX, T
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- EXTERNAL LSAME, IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DGEMV, DSCAL, DSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Initialize ALPHA for use in choosing pivot block size.
-*
- ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Factorize the trailing columns of A using the upper triangle
-* of A and working backwards, and compute the matrix W = U12*D
-* for use in updating A11
-*
-* K is the main loop index, decreasing from N in steps of 1 or 2
-*
-* KW is the column of W which corresponds to column K of A
-*
- K = N
- 10 CONTINUE
- KW = NB + K - N
-*
-* Exit from loop
-*
- IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
- $ GO TO 30
-*
-* Copy column K of A to column KW of W and update it
-*
- CALL DCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
- IF( K.LT.N )
- $ CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), LDA,
- $ W( K, KW+1 ), LDW, ONE, W( 1, KW ), 1 )
-*
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( W( K, KW ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.GT.1 ) THEN
- IMAX = IDAMAX( K-1, W( 1, KW ), 1 )
- COLMAX = ABS( W( IMAX, KW ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* Copy column IMAX to column KW-1 of W and update it
-*
- CALL DCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 )
- CALL DCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
- $ W( IMAX+1, KW-1 ), 1 )
- IF( K.LT.N )
- $ CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ),
- $ LDA, W( IMAX, KW+1 ), LDW, ONE,
- $ W( 1, KW-1 ), 1 )
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = IMAX + IDAMAX( K-IMAX, W( IMAX+1, KW-1 ), 1 )
- ROWMAX = ABS( W( JMAX, KW-1 ) )
- IF( IMAX.GT.1 ) THEN
- JMAX = IDAMAX( IMAX-1, W( 1, KW-1 ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( W( JMAX, KW-1 ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( W( IMAX, KW-1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
-*
-* copy column KW-1 of W to column KW
-*
- CALL DCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
- ELSE
-*
-* interchange rows and columns K-1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K - KSTEP + 1
- KKW = NB + KK - N
-*
-* Updated column KP is already stored in column KKW of W
-*
- IF( KP.NE.KK ) THEN
-*
-* Copy non-updated column KK to column KP
-*
- A( KP, K ) = A( KK, K )
- CALL DCOPY( K-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
- $ LDA )
- CALL DCOPY( KP, A( 1, KK ), 1, A( 1, KP ), 1 )
-*
-* Interchange rows KK and KP in last KK columns of A and W
-*
- CALL DSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA )
- CALL DSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
- $ LDW )
- END IF
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column KW of W now holds
-*
-* W(k) = U(k)*D(k)
-*
-* where U(k) is the k-th column of U
-*
-* Store U(k) in column k of A
-*
- CALL DCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
- R1 = ONE / A( K, K )
- CALL DSCAL( K-1, R1, A( 1, K ), 1 )
- ELSE
-*
-* 2-by-2 pivot block D(k): columns KW and KW-1 of W now
-* hold
-*
-* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
-*
-* where U(k) and U(k-1) are the k-th and (k-1)-th columns
-* of U
-*
- IF( K.GT.2 ) THEN
-*
-* Store U(k) and U(k-1) in columns k and k-1 of A
-*
- D21 = W( K-1, KW )
- D11 = W( K, KW ) / D21
- D22 = W( K-1, KW-1 ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
- DO 20 J = 1, K - 2
- A( J, K-1 ) = D21*( D11*W( J, KW-1 )-W( J, KW ) )
- A( J, K ) = D21*( D22*W( J, KW )-W( J, KW-1 ) )
- 20 CONTINUE
- END IF
-*
-* Copy D(k) to A
-*
- A( K-1, K-1 ) = W( K-1, KW-1 )
- A( K-1, K ) = W( K-1, KW )
- A( K, K ) = W( K, KW )
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K-1 ) = -KP
- END IF
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KSTEP
- GO TO 10
-*
- 30 CONTINUE
-*
-* Update the upper triangle of A11 (= A(1:k,1:k)) as
-*
-* A11 := A11 - U12*D*U12**T = A11 - U12*W**T
-*
-* computing blocks of NB columns at a time
-*
- DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
- JB = MIN( NB, K-J+1 )
-*
-* Update the upper triangle of the diagonal block
-*
- DO 40 JJ = J, J + JB - 1
- CALL DGEMV( 'No transpose', JJ-J+1, N-K, -ONE,
- $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE,
- $ A( J, JJ ), 1 )
- 40 CONTINUE
-*
-* Update the rectangular superdiagonal block
-*
- CALL DGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, -ONE,
- $ A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, ONE,
- $ A( 1, J ), LDA )
- 50 CONTINUE
-*
-* Put U12 in standard form by partially undoing the interchanges
-* in columns k+1:n
-*
- J = K + 1
- 60 CONTINUE
- JJ = J
- JP = IPIV( J )
- IF( JP.LT.0 ) THEN
- JP = -JP
- J = J + 1
- END IF
- J = J + 1
- IF( JP.NE.JJ .AND. J.LE.N )
- $ CALL DSWAP( N-J+1, A( JP, J ), LDA, A( JJ, J ), LDA )
- IF( J.LE.N )
- $ GO TO 60
-*
-* Set KB to the number of columns factorized
-*
- KB = N - K
-*
- ELSE
-*
-* Factorize the leading columns of A using the lower triangle
-* of A and working forwards, and compute the matrix W = L21*D
-* for use in updating A22
-*
-* K is the main loop index, increasing from 1 in steps of 1 or 2
-*
- K = 1
- 70 CONTINUE
-*
-* Exit from loop
-*
- IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
- $ GO TO 90
-*
-* Copy column K of A to column K of W and update it
-*
- CALL DCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
- CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), LDA,
- $ W( K, 1 ), LDW, ONE, W( K, K ), 1 )
-*
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( W( K, K ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.LT.N ) THEN
- IMAX = K + IDAMAX( N-K, W( K+1, K ), 1 )
- COLMAX = ABS( W( IMAX, K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* Copy column IMAX to column K+1 of W and update it
-*
- CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 )
- CALL DCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ),
- $ 1 )
- CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ),
- $ LDA, W( IMAX, 1 ), LDW, ONE, W( K, K+1 ), 1 )
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = K - 1 + IDAMAX( IMAX-K, W( K, K+1 ), 1 )
- ROWMAX = ABS( W( JMAX, K+1 ) )
- IF( IMAX.LT.N ) THEN
- JMAX = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( W( JMAX, K+1 ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( W( IMAX, K+1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
-*
-* copy column K+1 of W to column K
-*
- CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
- ELSE
-*
-* interchange rows and columns K+1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K + KSTEP - 1
-*
-* Updated column KP is already stored in column KK of W
-*
- IF( KP.NE.KK ) THEN
-*
-* Copy non-updated column KK to column KP
-*
- A( KP, K ) = A( KK, K )
- CALL DCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA )
- CALL DCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 )
-*
-* Interchange rows KK and KP in first KK columns of A and W
-*
- CALL DSWAP( KK, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
- CALL DSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
- END IF
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k of W now holds
-*
-* W(k) = L(k)*D(k)
-*
-* where L(k) is the k-th column of L
-*
-* Store L(k) in column k of A
-*
- CALL DCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
- IF( K.LT.N ) THEN
- R1 = ONE / A( K, K )
- CALL DSCAL( N-K, R1, A( K+1, K ), 1 )
- END IF
- ELSE
-*
-* 2-by-2 pivot block D(k): columns k and k+1 of W now hold
-*
-* ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th columns
-* of L
-*
- IF( K.LT.N-1 ) THEN
-*
-* Store L(k) and L(k+1) in columns k and k+1 of A
-*
- D21 = W( K+1, K )
- D11 = W( K+1, K+1 ) / D21
- D22 = W( K, K ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
- DO 80 J = K + 2, N
- A( J, K ) = D21*( D11*W( J, K )-W( J, K+1 ) )
- A( J, K+1 ) = D21*( D22*W( J, K+1 )-W( J, K ) )
- 80 CONTINUE
- END IF
-*
-* Copy D(k) to A
-*
- A( K, K ) = W( K, K )
- A( K+1, K ) = W( K+1, K )
- A( K+1, K+1 ) = W( K+1, K+1 )
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K+1 ) = -KP
- END IF
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KSTEP
- GO TO 70
-*
- 90 CONTINUE
-*
-* Update the lower triangle of A22 (= A(k:n,k:n)) as
-*
-* A22 := A22 - L21*D*L21**T = A22 - L21*W**T
-*
-* computing blocks of NB columns at a time
-*
- DO 110 J = K, N, NB
- JB = MIN( NB, N-J+1 )
-*
-* Update the lower triangle of the diagonal block
-*
- DO 100 JJ = J, J + JB - 1
- CALL DGEMV( 'No transpose', J+JB-JJ, K-1, -ONE,
- $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE,
- $ A( JJ, JJ ), 1 )
- 100 CONTINUE
-*
-* Update the rectangular subdiagonal block
-*
- IF( J+JB.LE.N )
- $ CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
- $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW,
- $ ONE, A( J+JB, J ), LDA )
- 110 CONTINUE
-*
-* Put L21 in standard form by partially undoing the interchanges
-* in columns 1:k-1
-*
- J = K - 1
- 120 CONTINUE
- JJ = J
- JP = IPIV( J )
- IF( JP.LT.0 ) THEN
- JP = -JP
- J = J - 1
- END IF
- J = J - 1
- IF( JP.NE.JJ .AND. J.GE.1 )
- $ CALL DSWAP( J, A( JP, 1 ), LDA, A( JJ, 1 ), LDA )
- IF( J.GE.1 )
- $ GO TO 120
-*
-* Set KB to the number of columns factorized
-*
- KB = K - 1
-*
- END IF
- RETURN
-*
-* End of DLASYF
-*
- END
diff --git a/netlib/LAPACK/dlat2s.f b/netlib/LAPACK/dlat2s.f
deleted file mode 100644
index 63f106a..0000000
--- a/netlib/LAPACK/dlat2s.f
+++ /dev/null
@@ -1,173 +0,0 @@
-*> \brief \b DLAT2S converts a double-precision triangular matrix to a single-precision triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAT2S + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlat2s.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlat2s.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlat2s.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAT2S( UPLO, N, A, LDA, SA, LDSA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDSA, N
-* ..
-* .. Array Arguments ..
-* REAL SA( LDSA, * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE
-*> PRECISION triangular matrix, A.
-*>
-*> RMAX is the overflow for the SINGLE PRECISION arithmetic
-*> DLAS2S checks that all the entries of A are between -RMAX and
-*> RMAX. If not the convertion is aborted and a flag is raised.
-*>
-*> This is an auxiliary routine so there is no argument checking.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N triangular coefficient matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SA
-*> \verbatim
-*> SA is REAL array, dimension (LDSA,N)
-*> Only the UPLO part of SA is referenced. On exit, if INFO=0,
-*> the N-by-N coefficient matrix SA; if INFO>0, the content of
-*> the UPLO part of SA is unspecified.
-*> \endverbatim
-*>
-*> \param[in] LDSA
-*> \verbatim
-*> LDSA is INTEGER
-*> The leading dimension of the array SA. LDSA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> = 1: an entry of the matrix A is greater than the SINGLE
-*> PRECISION overflow threshold, in this case, the content
-*> of the UPLO part of SA in exit is unspecified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAT2S( UPLO, N, A, LDA, SA, LDSA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDSA, N
-* ..
-* .. Array Arguments ..
- REAL SA( LDSA, * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION RMAX
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- REAL SLAMCH
- LOGICAL LSAME
- EXTERNAL SLAMCH, LSAME
-* ..
-* .. Executable Statements ..
-*
- RMAX = SLAMCH( 'O' )
- UPPER = LSAME( UPLO, 'U' )
- IF( UPPER ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, J
- IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
- $ THEN
- INFO = 1
- GO TO 50
- END IF
- SA( I, J ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = J, N
- IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
- $ THEN
- INFO = 1
- GO TO 50
- END IF
- SA( I, J ) = A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- RETURN
-*
-* End of DLAT2S
-*
- END
diff --git a/netlib/LAPACK/dlatbs.f b/netlib/LAPACK/dlatbs.f
deleted file mode 100644
index 8238298..0000000
--- a/netlib/LAPACK/dlatbs.f
+++ /dev/null
@@ -1,812 +0,0 @@
-*> \brief \b DLATBS solves a triangular banded system of equations.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATBS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatbs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatbs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatbs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
-* SCALE, CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATBS solves one of the triangular systems
-*>
-*> A *x = s*b or A**T*x = s*b
-*>
-*> with scaling to prevent overflow, where A is an upper or lower
-*> triangular band matrix. Here A**T denotes the transpose of A, x and b
-*> are n-element vectors, and s is a scaling factor, usually less than
-*> or equal to 1, chosen so that the components of x will be less than
-*> the overflow threshold. If the unscaled problem will not cause
-*> overflow, the Level 2 BLAS routine DTBSV is called. If the matrix A
-*> is singular (A(j,j) = 0 for some j), then s is set to 0 and a
-*> non-trivial solution to A*x = 0 is returned.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of subdiagonals or superdiagonals in the
-*> triangular matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is DOUBLE PRECISION array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, DTBSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTBSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call DTBSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
- $ SCALE, CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, KD, LDAB, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, J, JFIRST, JINC, JLAST, JLEN, MAIND
- DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( KD.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATBS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- DO 10 J = 1, N
- JLEN = MIN( KD, J-1 )
- CNORM( J ) = DASUM( JLEN, AB( KD+1-JLEN, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- DO 20 J = 1, N
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 ) THEN
- CNORM( J ) = DASUM( JLEN, AB( 2, J ), 1 )
- ELSE
- CNORM( J ) = ZERO
- END IF
- 20 CONTINUE
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = IDAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL DSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine DTBSV can be used.
-*
- J = IDAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- MAIND = KD + 1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- MAIND = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( AB( MAIND, J ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- MAIND = KD + 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- MAIND = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( AB( MAIND, J ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL DTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL DSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- DO 110 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 100
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 100 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL DSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(max(1,j-kd):j-1) := x(max(1,j-kd):j-1) -
-* x(j)* A(max(1,j-kd):j-1,j)
-*
- JLEN = MIN( KD, J-1 )
- CALL DAXPY( JLEN, -X( J )*TSCAL,
- $ AB( KD+1-JLEN, J ), 1, X( J-JLEN ), 1 )
- I = IDAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- ELSE IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:min(j+kd,n)) := x(j+1:min(j+kd,n)) -
-* x(j) * A(j+1:min(j+kd,n),j)
-*
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 )
- $ CALL DAXPY( JLEN, -X( J )*TSCAL, AB( 2, J ), 1,
- $ X( J+1 ), 1 )
- I = J + IDAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- 110 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- DO 160 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call DDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- JLEN = MIN( KD, J-1 )
- SUMJ = DDOT( JLEN, AB( KD+1-JLEN, J ), 1,
- $ X( J-JLEN ), 1 )
- ELSE
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 )
- $ SUMJ = DDOT( JLEN, AB( 2, J ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- JLEN = MIN( KD, J-1 )
- DO 120 I = 1, JLEN
- SUMJ = SUMJ + ( AB( KD+I-JLEN, J )*USCAL )*
- $ X( J-JLEN-1+I )
- 120 CONTINUE
- ELSE
- JLEN = MIN( KD, N-J )
- DO 130 I = 1, JLEN
- SUMJ = SUMJ + ( AB( I+1, J )*USCAL )*X( J+I )
- 130 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 150
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 140 I = 1, N
- X( I ) = ZERO
- 140 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 150 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- 160 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of DLATBS
-*
- END
diff --git a/netlib/LAPACK/dlatdf.f b/netlib/LAPACK/dlatdf.f
deleted file mode 100644
index be70313..0000000
--- a/netlib/LAPACK/dlatdf.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b DLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATDF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatdf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatdf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatdf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
-* JPIV )
-*
-* .. Scalar Arguments ..
-* INTEGER IJOB, LDZ, N
-* DOUBLE PRECISION RDSCAL, RDSUM
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), JPIV( * )
-* DOUBLE PRECISION RHS( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATDF uses the LU factorization of the n-by-n matrix Z computed by
-*> DGETC2 and computes a contribution to the reciprocal Dif-estimate
-*> by solving Z * x = b for x, and choosing the r.h.s. b such that
-*> the norm of x is as large as possible. On entry RHS = b holds the
-*> contribution from earlier solved sub-systems, and on return RHS = x.
-*>
-*> The factorization of Z returned by DGETC2 has the form Z = P*L*U*Q,
-*> where P and Q are permutation matrices. L is lower triangular with
-*> unit diagonal elements and U is upper triangular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> IJOB = 2: First compute an approximative null-vector e
-*> of Z using DGECON, e is normalized and solve for
-*> Zx = +-e - f with the sign giving the greater value
-*> of 2-norm(x). About 5 times as expensive as Default.
-*> IJOB .ne. 2: Local look ahead strategy where all entries of
-*> the r.h.s. b is choosen as either +1 or -1 (Default).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Z.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> On entry, the LU part of the factorization of the n-by-n
-*> matrix Z computed by DGETC2: Z = P * L * U * Q
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDA >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] RHS
-*> \verbatim
-*> RHS is DOUBLE PRECISION array, dimension (N)
-*> On entry, RHS contains contributions from other subsystems.
-*> On exit, RHS contains the solution of the subsystem with
-*> entries acoording to the value of IJOB (see above).
-*> \endverbatim
-*>
-*> \param[in,out] RDSUM
-*> \verbatim
-*> RDSUM is DOUBLE PRECISION
-*> On entry, the sum of squares of computed contributions to
-*> the Dif-estimate under computation by DTGSYL, where the
-*> scaling factor RDSCAL (see below) has been factored out.
-*> On exit, the corresponding sum of squares updated with the
-*> contributions from the current sub-system.
-*> If TRANS = 'T' RDSUM is not touched.
-*> NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
-*> \endverbatim
-*>
-*> \param[in,out] RDSCAL
-*> \verbatim
-*> RDSCAL is DOUBLE PRECISION
-*> On entry, scaling factor used to prevent overflow in RDSUM.
-*> On exit, RDSCAL is updated w.r.t. the current contributions
-*> in RDSUM.
-*> If TRANS = 'T', RDSCAL is not touched.
-*> NOTE: RDSCAL only makes sense when DTGSY2 is called by
-*> DTGSYL.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= i <= N, row i of the
-*> matrix has been interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] JPIV
-*> \verbatim
-*> JPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= j <= N, column j of the
-*> matrix has been interchanged with column JPIV(j).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> This routine is a further developed implementation of algorithm
-*> BSOLVE in [1] using complete pivoting in the LU factorization.
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*>
-*> [1] Bo Kagstrom and Lars Westin,
-*> Generalized Schur Methods with Condition Estimators for
-*> Solving the Generalized Sylvester Equation, IEEE Transactions
-*> on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
-*>
-*> [2] Peter Poromaa,
-*> On Efficient and Robust Estimators for the Separation
-*> between two Regular Matrix Pairs with Applications in
-*> Condition Estimation. Report IMINF-95.05, Departement of
-*> Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
- $ JPIV )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IJOB, LDZ, N
- DOUBLE PRECISION RDSCAL, RDSUM
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- DOUBLE PRECISION RHS( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXDIM
- PARAMETER ( MAXDIM = 8 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J, K
- DOUBLE PRECISION BM, BP, PMONE, SMINU, SPLUS, TEMP
-* ..
-* .. Local Arrays ..
- INTEGER IWORK( MAXDIM )
- DOUBLE PRECISION WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGECON, DGESC2, DLASSQ, DLASWP,
- $ DSCAL
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DASUM, DDOT
- EXTERNAL DASUM, DDOT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( IJOB.NE.2 ) THEN
-*
-* Apply permutations IPIV to RHS
-*
- CALL DLASWP( 1, RHS, LDZ, 1, N-1, IPIV, 1 )
-*
-* Solve for L-part choosing RHS either to +1 or -1.
-*
- PMONE = -ONE
-*
- DO 10 J = 1, N - 1
- BP = RHS( J ) + ONE
- BM = RHS( J ) - ONE
- SPLUS = ONE
-*
-* Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and
-* SMIN computed more efficiently than in BSOLVE [1].
-*
- SPLUS = SPLUS + DDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), 1 )
- SMINU = DDOT( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 )
- SPLUS = SPLUS*RHS( J )
- IF( SPLUS.GT.SMINU ) THEN
- RHS( J ) = BP
- ELSE IF( SMINU.GT.SPLUS ) THEN
- RHS( J ) = BM
- ELSE
-*
-* In this case the updating sums are equal and we can
-* choose RHS(J) +1 or -1. The first time this happens
-* we choose -1, thereafter +1. This is a simple way to
-* get good estimates of matrices like Byers well-known
-* example (see [1]). (Not done in BSOLVE.)
-*
- RHS( J ) = RHS( J ) + PMONE
- PMONE = ONE
- END IF
-*
-* Compute the remaining r.h.s.
-*
- TEMP = -RHS( J )
- CALL DAXPY( N-J, TEMP, Z( J+1, J ), 1, RHS( J+1 ), 1 )
-*
- 10 CONTINUE
-*
-* Solve for U-part, look-ahead for RHS(N) = +-1. This is not done
-* in BSOLVE and will hopefully give us a better estimate because
-* any ill-conditioning of the original matrix is transfered to U
-* and not to L. U(N, N) is an approximation to sigma_min(LU).
-*
- CALL DCOPY( N-1, RHS, 1, XP, 1 )
- XP( N ) = RHS( N ) + ONE
- RHS( N ) = RHS( N ) - ONE
- SPLUS = ZERO
- SMINU = ZERO
- DO 30 I = N, 1, -1
- TEMP = ONE / Z( I, I )
- XP( I ) = XP( I )*TEMP
- RHS( I ) = RHS( I )*TEMP
- DO 20 K = I + 1, N
- XP( I ) = XP( I ) - XP( K )*( Z( I, K )*TEMP )
- RHS( I ) = RHS( I ) - RHS( K )*( Z( I, K )*TEMP )
- 20 CONTINUE
- SPLUS = SPLUS + ABS( XP( I ) )
- SMINU = SMINU + ABS( RHS( I ) )
- 30 CONTINUE
- IF( SPLUS.GT.SMINU )
- $ CALL DCOPY( N, XP, 1, RHS, 1 )
-*
-* Apply the permutations JPIV to the computed solution (RHS)
-*
- CALL DLASWP( 1, RHS, LDZ, 1, N-1, JPIV, -1 )
-*
-* Compute the sum of squares
-*
- CALL DLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-*
- ELSE
-*
-* IJOB = 2, Compute approximate nullvector XM of Z
-*
- CALL DGECON( 'I', N, Z, LDZ, ONE, TEMP, WORK, IWORK, INFO )
- CALL DCOPY( N, WORK( N+1 ), 1, XM, 1 )
-*
-* Compute RHS
-*
- CALL DLASWP( 1, XM, LDZ, 1, N-1, IPIV, -1 )
- TEMP = ONE / SQRT( DDOT( N, XM, 1, XM, 1 ) )
- CALL DSCAL( N, TEMP, XM, 1 )
- CALL DCOPY( N, XM, 1, XP, 1 )
- CALL DAXPY( N, ONE, RHS, 1, XP, 1 )
- CALL DAXPY( N, -ONE, XM, 1, RHS, 1 )
- CALL DGESC2( N, Z, LDZ, RHS, IPIV, JPIV, TEMP )
- CALL DGESC2( N, Z, LDZ, XP, IPIV, JPIV, TEMP )
- IF( DASUM( N, XP, 1 ).GT.DASUM( N, RHS, 1 ) )
- $ CALL DCOPY( N, XP, 1, RHS, 1 )
-*
-* Compute the sum of squares
-*
- CALL DLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-*
- END IF
-*
- RETURN
-*
-* End of DLATDF
-*
- END
diff --git a/netlib/LAPACK/dlatm1.f b/netlib/LAPACK/dlatm1.f
deleted file mode 100644
index f93d1fb..0000000
--- a/netlib/LAPACK/dlatm1.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b DLATM1
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IDIST, INFO, IRSIGN, MODE, N
-* DOUBLE PRECISION COND
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATM1 computes the entries of D(1..N) as specified by
-*> MODE, COND and IRSIGN. IDIST and ISEED determine the generation
-*> of random numbers. DLATM1 is called by SLATMR to generate
-*> random test matrices for LAPACK programs.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry describes how D is to be computed:
-*> MODE = 0 means do not change D.
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is DOUBLE PRECISION
-*> On entry, used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IRSIGN
-*> \verbatim
-*> IRSIGN is INTEGER
-*> On entry, if MODE neither -6, 0 nor 6, determines sign of
-*> entries of D
-*> 0 => leave entries of D unchanged
-*> 1 => multiply each entry of D by 1 or -1 with probability .5
-*> \endverbatim
-*>
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is CHARACTER*1
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. The random number generator uses a
-*> linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to DLATM1
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( MIN( M , N ) )
-*> Array to be computed according to MODE, COND and IRSIGN.
-*> May be changed on exit if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of entries of D. Not modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> 0 => normal termination
-*> -1 => if MODE not in range -6 to 6
-*> -2 => if MODE neither -6, 0 nor 6, and
-*> IRSIGN neither 0 nor 1
-*> -3 => if MODE neither -6, 0 nor 6 and COND less than 1
-*> -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3
-*> -7 => if N negative
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IDIST, INFO, IRSIGN, MODE, N
- DOUBLE PRECISION COND
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION ALPHA, TEMP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLARAN
- EXTERNAL DLARAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARNV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, EXP, LOG
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters. Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set INFO if an error
-*
- IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
- INFO = -1
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
- INFO = -2
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ COND.LT.ONE ) THEN
- INFO = -3
- ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
- $ ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATM1', -INFO )
- RETURN
- END IF
-*
-* Compute D according to COND and MODE
-*
- IF( MODE.NE.0 ) THEN
- GO TO ( 10, 30, 50, 70, 90, 110 )ABS( MODE )
-*
-* One large D value:
-*
- 10 CONTINUE
- DO 20 I = 1, N
- D( I ) = ONE / COND
- 20 CONTINUE
- D( 1 ) = ONE
- GO TO 120
-*
-* One small D value:
-*
- 30 CONTINUE
- DO 40 I = 1, N
- D( I ) = ONE
- 40 CONTINUE
- D( N ) = ONE / COND
- GO TO 120
-*
-* Exponentially distributed D values:
-*
- 50 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 ) THEN
- ALPHA = COND**( -ONE / DBLE( N-1 ) )
- DO 60 I = 2, N
- D( I ) = ALPHA**( I-1 )
- 60 CONTINUE
- END IF
- GO TO 120
-*
-* Arithmetically distributed D values:
-*
- 70 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 ) THEN
- TEMP = ONE / COND
- ALPHA = ( ONE-TEMP ) / DBLE( N-1 )
- DO 80 I = 2, N
- D( I ) = DBLE( N-I )*ALPHA + TEMP
- 80 CONTINUE
- END IF
- GO TO 120
-*
-* Randomly distributed D values on ( 1/COND , 1):
-*
- 90 CONTINUE
- ALPHA = LOG( ONE / COND )
- DO 100 I = 1, N
- D( I ) = EXP( ALPHA*DLARAN( ISEED ) )
- 100 CONTINUE
- GO TO 120
-*
-* Randomly distributed D values from IDIST
-*
- 110 CONTINUE
- CALL DLARNV( IDIST, ISEED, N, D )
-*
- 120 CONTINUE
-*
-* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
-* random signs to D
-*
- IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ IRSIGN.EQ.1 ) THEN
- DO 130 I = 1, N
- TEMP = DLARAN( ISEED )
- IF( TEMP.GT.HALF )
- $ D( I ) = -D( I )
- 130 CONTINUE
- END IF
-*
-* Reverse if MODE < 0
-*
- IF( MODE.LT.0 ) THEN
- DO 140 I = 1, N / 2
- TEMP = D( I )
- D( I ) = D( N+1-I )
- D( N+1-I ) = TEMP
- 140 CONTINUE
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DLATM1
-*
- END
diff --git a/netlib/LAPACK/dlatm2.f b/netlib/LAPACK/dlatm2.f
deleted file mode 100644
index 87ef4f4..0000000
--- a/netlib/LAPACK/dlatm2.f
+++ /dev/null
@@ -1,315 +0,0 @@
-*> \brief \b DLATM2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLATM2( M, N, I, J, KL, KU, IDIST,
-* ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
-*
-* .. Scalar Arguments ..
-*
-* INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
-* DOUBLE PRECISION SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
-* INTEGER ISEED( 4 ), IWORK( * )
-* DOUBLE PRECISION D( * ), DL( * ), DR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATM2 returns the (I,J) entry of a random matrix of dimension
-*> (M, N) described by the other paramters. It is called by the
-*> DLATMR routine in order to build random test matrices. No error
-*> checking on parameters is done, because this routine is called in
-*> a tight loop by DLATMR which has already checked the parameters.
-*>
-*> Use of DLATM2 differs from SLATM3 in the order in which the random
-*> number generator is called to fill in random matrix entries.
-*> With DLATM2, the generator is called to fill in the pivoted matrix
-*> columnwise. With DLATM3, the generator is called to fill in the
-*> matrix columnwise, after which it is pivoted. Thus, DLATM3 can
-*> be used to construct random matrices which differ only in their
-*> order of rows and/or columns. DLATM2 is used to construct band
-*> matrices while avoiding calling the random number generator for
-*> entries outside the band (and therefore generating random numbers
-*>
-*> The matrix whose (I,J) entry is returned is constructed as
-*> follows (this routine only computes one entry):
-*>
-*> If I is outside (1..M) or J is outside (1..N), return zero
-*> (this is convenient for generating matrices in band format).
-*>
-*> Generate a matrix A with random entries of distribution IDIST.
-*>
-*> Set the diagonal to D.
-*>
-*> Grade the matrix, if desired, from the left (by DL) and/or
-*> from the right (by DR or DL) as specified by IGRADE.
-*>
-*> Permute, if desired, the rows and/or columns as specified by
-*> IPVTNG and IWORK.
-*>
-*> Band the matrix to have lower bandwidth KL and upper
-*> bandwidth KU.
-*>
-*> Set random entries to zero as specified by SPARSE.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Number of rows of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of columns of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> Row of entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in] J
-*> \verbatim
-*> J is INTEGER
-*> Column of entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> Lower bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> Upper bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array of dimension ( 4 )
-*> Seed for random number generator.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array of dimension ( MIN( I , J ) )
-*> Diagonal entries of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IGRADE
-*> \verbatim
-*> IGRADE is INTEGER
-*> Specifies grading of matrix as follows:
-*> 0 => no grading
-*> 1 => matrix premultiplied by diag( DL )
-*> 2 => matrix postmultiplied by diag( DR )
-*> 3 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DR )
-*> 4 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by inv( diag( DL ) )
-*> 5 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DL )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array ( I or J, as appropriate )
-*> Left scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DR
-*> \verbatim
-*> DR is DOUBLE PRECISION array ( I or J, as appropriate )
-*> Right scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IPVTNG
-*> \verbatim
-*> IPVTNG is INTEGER
-*> On entry specifies pivoting permutations as follows:
-*> 0 => none.
-*> 1 => row pivoting.
-*> 2 => column pivoting.
-*> 3 => full pivoting, i.e., on both sides.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array ( I or J, as appropriate )
-*> This array specifies the permutation used. The
-*> row (or column) in position K was originally in
-*> position IWORK( K ).
-*> This differs from IWORK for DLATM3. Not modified.
-*> \endverbatim
-*>
-*> \param[in] SPARSE
-*> \verbatim
-*> SPARSE is DOUBLE PRECISION between 0. and 1.
-*> On entry specifies the sparsity of the matrix
-*> if sparse matix is to be generated.
-*> SPARSE should lie between 0 and 1.
-*> A uniform ( 0, 1 ) random number x is generated and
-*> compared to SPARSE; if x is larger the matrix entry
-*> is unchanged and if x is smaller the entry is set
-*> to zero. Thus on the average a fraction SPARSE of the
-*> entries will be set to zero.
-*> Not modified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
-*
- INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
- DOUBLE PRECISION SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
- INTEGER ISEED( 4 ), IWORK( * )
- DOUBLE PRECISION D( * ), DL( * ), DR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-*
-* .. Local Scalars ..
-*
- INTEGER ISUB, JSUB
- DOUBLE PRECISION TEMP
-* ..
-*
-* .. External Functions ..
-*
- DOUBLE PRECISION DLARAN, DLARND
- EXTERNAL DLARAN, DLARND
-* ..
-*
-*-----------------------------------------------------------------------
-*
-* .. Executable Statements ..
-*
-*
-* Check for I and J in range
-*
- IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
- DLATM2 = ZERO
- RETURN
- END IF
-*
-* Check for banding
-*
- IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
- DLATM2 = ZERO
- RETURN
- END IF
-*
-* Check for sparsity
-*
- IF( SPARSE.GT.ZERO ) THEN
- IF( DLARAN( ISEED ).LT.SPARSE ) THEN
- DLATM2 = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute subscripts depending on IPVTNG
-*
- IF( IPVTNG.EQ.0 ) THEN
- ISUB = I
- JSUB = J
- ELSE IF( IPVTNG.EQ.1 ) THEN
- ISUB = IWORK( I )
- JSUB = J
- ELSE IF( IPVTNG.EQ.2 ) THEN
- ISUB = I
- JSUB = IWORK( J )
- ELSE IF( IPVTNG.EQ.3 ) THEN
- ISUB = IWORK( I )
- JSUB = IWORK( J )
- END IF
-*
-* Compute entry and grade it according to IGRADE
-*
- IF( ISUB.EQ.JSUB ) THEN
- TEMP = D( ISUB )
- ELSE
- TEMP = DLARND( IDIST, ISEED )
- END IF
- IF( IGRADE.EQ.1 ) THEN
- TEMP = TEMP*DL( ISUB )
- ELSE IF( IGRADE.EQ.2 ) THEN
- TEMP = TEMP*DR( JSUB )
- ELSE IF( IGRADE.EQ.3 ) THEN
- TEMP = TEMP*DL( ISUB )*DR( JSUB )
- ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
- TEMP = TEMP*DL( ISUB ) / DL( JSUB )
- ELSE IF( IGRADE.EQ.5 ) THEN
- TEMP = TEMP*DL( ISUB )*DL( JSUB )
- END IF
- DLATM2 = TEMP
- RETURN
-*
-* End of DLATM2
-*
- END
diff --git a/netlib/LAPACK/dlatm3.f b/netlib/LAPACK/dlatm3.f
deleted file mode 100644
index b2c4982..0000000
--- a/netlib/LAPACK/dlatm3.f
+++ /dev/null
@@ -1,335 +0,0 @@
-*> \brief \b DLATM3
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
-* IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
-* SPARSE )
-*
-* .. Scalar Arguments ..
-*
-* INTEGER I, IDIST, IGRADE, IPVTNG, ISUB, J, JSUB, KL,
-* $ KU, M, N
-* DOUBLE PRECISION SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
-* INTEGER ISEED( 4 ), IWORK( * )
-* DOUBLE PRECISION D( * ), DL( * ), DR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATM3 returns the (ISUB,JSUB) entry of a random matrix of
-*> dimension (M, N) described by the other paramters. (ISUB,JSUB)
-*> is the final position of the (I,J) entry after pivoting
-*> according to IPVTNG and IWORK. DLATM3 is called by the
-*> DLATMR routine in order to build random test matrices. No error
-*> checking on parameters is done, because this routine is called in
-*> a tight loop by DLATMR which has already checked the parameters.
-*>
-*> Use of DLATM3 differs from SLATM2 in the order in which the random
-*> number generator is called to fill in random matrix entries.
-*> With DLATM2, the generator is called to fill in the pivoted matrix
-*> columnwise. With DLATM3, the generator is called to fill in the
-*> matrix columnwise, after which it is pivoted. Thus, DLATM3 can
-*> be used to construct random matrices which differ only in their
-*> order of rows and/or columns. DLATM2 is used to construct band
-*> matrices while avoiding calling the random number generator for
-*> entries outside the band (and therefore generating random numbers
-*> in different orders for different pivot orders).
-*>
-*> The matrix whose (ISUB,JSUB) entry is returned is constructed as
-*> follows (this routine only computes one entry):
-*>
-*> If ISUB is outside (1..M) or JSUB is outside (1..N), return zero
-*> (this is convenient for generating matrices in band format).
-*>
-*> Generate a matrix A with random entries of distribution IDIST.
-*>
-*> Set the diagonal to D.
-*>
-*> Grade the matrix, if desired, from the left (by DL) and/or
-*> from the right (by DR or DL) as specified by IGRADE.
-*>
-*> Permute, if desired, the rows and/or columns as specified by
-*> IPVTNG and IWORK.
-*>
-*> Band the matrix to have lower bandwidth KL and upper
-*> bandwidth KU.
-*>
-*> Set random entries to zero as specified by SPARSE.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Number of rows of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of columns of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> Row of unpivoted entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in] J
-*> \verbatim
-*> J is INTEGER
-*> Column of unpivoted entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISUB
-*> \verbatim
-*> ISUB is INTEGER
-*> Row of pivoted entry to be returned. Changed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] JSUB
-*> \verbatim
-*> JSUB is INTEGER
-*> Column of pivoted entry to be returned. Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> Lower bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> Upper bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array of dimension ( 4 )
-*> Seed for random number generator.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array of dimension ( MIN( I , J ) )
-*> Diagonal entries of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IGRADE
-*> \verbatim
-*> IGRADE is INTEGER
-*> Specifies grading of matrix as follows:
-*> 0 => no grading
-*> 1 => matrix premultiplied by diag( DL )
-*> 2 => matrix postmultiplied by diag( DR )
-*> 3 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DR )
-*> 4 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by inv( diag( DL ) )
-*> 5 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DL )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array ( I or J, as appropriate )
-*> Left scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DR
-*> \verbatim
-*> DR is DOUBLE PRECISION array ( I or J, as appropriate )
-*> Right scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IPVTNG
-*> \verbatim
-*> IPVTNG is INTEGER
-*> On entry specifies pivoting permutations as follows:
-*> 0 => none.
-*> 1 => row pivoting.
-*> 2 => column pivoting.
-*> 3 => full pivoting, i.e., on both sides.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array ( I or J, as appropriate )
-*> This array specifies the permutation used. The
-*> row (or column) originally in position K is in
-*> position IWORK( K ) after pivoting.
-*> This differs from IWORK for DLATM2. Not modified.
-*> \endverbatim
-*>
-*> \param[in] SPARSE
-*> \verbatim
-*> SPARSE is DOUBLE PRECISION between 0. and 1.
-*> On entry specifies the sparsity of the matrix
-*> if sparse matix is to be generated.
-*> SPARSE should lie between 0 and 1.
-*> A uniform ( 0, 1 ) random number x is generated and
-*> compared to SPARSE; if x is larger the matrix entry
-*> is unchanged and if x is smaller the entry is set
-*> to zero. Thus on the average a fraction SPARSE of the
-*> entries will be set to zero.
-*> Not modified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
-*
- INTEGER I, IDIST, IGRADE, IPVTNG, ISUB, J, JSUB, KL,
- $ KU, M, N
- DOUBLE PRECISION SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
- INTEGER ISEED( 4 ), IWORK( * )
- DOUBLE PRECISION D( * ), DL( * ), DR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-*
-* .. Local Scalars ..
-*
- DOUBLE PRECISION TEMP
-* ..
-*
-* .. External Functions ..
-*
- DOUBLE PRECISION DLARAN, DLARND
- EXTERNAL DLARAN, DLARND
-* ..
-*
-*-----------------------------------------------------------------------
-*
-* .. Executable Statements ..
-*
-*
-* Check for I and J in range
-*
- IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
- ISUB = I
- JSUB = J
- DLATM3 = ZERO
- RETURN
- END IF
-*
-* Compute subscripts depending on IPVTNG
-*
- IF( IPVTNG.EQ.0 ) THEN
- ISUB = I
- JSUB = J
- ELSE IF( IPVTNG.EQ.1 ) THEN
- ISUB = IWORK( I )
- JSUB = J
- ELSE IF( IPVTNG.EQ.2 ) THEN
- ISUB = I
- JSUB = IWORK( J )
- ELSE IF( IPVTNG.EQ.3 ) THEN
- ISUB = IWORK( I )
- JSUB = IWORK( J )
- END IF
-*
-* Check for banding
-*
- IF( JSUB.GT.ISUB+KU .OR. JSUB.LT.ISUB-KL ) THEN
- DLATM3 = ZERO
- RETURN
- END IF
-*
-* Check for sparsity
-*
- IF( SPARSE.GT.ZERO ) THEN
- IF( DLARAN( ISEED ).LT.SPARSE ) THEN
- DLATM3 = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute entry and grade it according to IGRADE
-*
- IF( I.EQ.J ) THEN
- TEMP = D( I )
- ELSE
- TEMP = DLARND( IDIST, ISEED )
- END IF
- IF( IGRADE.EQ.1 ) THEN
- TEMP = TEMP*DL( I )
- ELSE IF( IGRADE.EQ.2 ) THEN
- TEMP = TEMP*DR( J )
- ELSE IF( IGRADE.EQ.3 ) THEN
- TEMP = TEMP*DL( I )*DR( J )
- ELSE IF( IGRADE.EQ.4 .AND. I.NE.J ) THEN
- TEMP = TEMP*DL( I ) / DL( J )
- ELSE IF( IGRADE.EQ.5 ) THEN
- TEMP = TEMP*DL( I )*DL( J )
- END IF
- DLATM3 = TEMP
- RETURN
-*
-* End of DLATM3
-*
- END
diff --git a/netlib/LAPACK/dlatm5.f b/netlib/LAPACK/dlatm5.f
deleted file mode 100644
index 9c8ee38..0000000
--- a/netlib/LAPACK/dlatm5.f
+++ /dev/null
@@ -1,501 +0,0 @@
-*> \brief \b DLATM5
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD,
-* E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA,
-* QBLCKB )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N,
-* $ PRTYPE, QBLCKA, QBLCKB
-* DOUBLE PRECISION ALPHA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
-* $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
-* $ L( LDL, * ), R( LDR, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATM5 generates matrices involved in the Generalized Sylvester
-*> equation:
-*>
-*> A * R - L * B = C
-*> D * R - L * E = F
-*>
-*> They also satisfy (the diagonalization condition)
-*>
-*> [ I -L ] ( [ A -C ], [ D -F ] ) [ I R ] = ( [ A ], [ D ] )
-*> [ I ] ( [ B ] [ E ] ) [ I ] ( [ B ] [ E ] )
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] PRTYPE
-*> \verbatim
-*> PRTYPE is INTEGER
-*> "Points" to a certian type of the matrices to generate
-*> (see futher details).
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Specifies the order of A and D and the number of rows in
-*> C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Specifies the order of B and E and the number of columns in
-*> C, F, R and L.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, M).
-*> On exit A M-by-M is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N).
-*> On exit B N-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC, N).
-*> On exit C M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of C.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (LDD, M).
-*> On exit D M-by-M is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDD
-*> \verbatim
-*> LDD is INTEGER
-*> The leading dimension of D.
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (LDE, N).
-*> On exit E N-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDE
-*> \verbatim
-*> LDE is INTEGER
-*> The leading dimension of E.
-*> \endverbatim
-*>
-*> \param[out] F
-*> \verbatim
-*> F is DOUBLE PRECISION array, dimension (LDF, N).
-*> On exit F M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of F.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (LDR, N).
-*> On exit R M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDR
-*> \verbatim
-*> LDR is INTEGER
-*> The leading dimension of R.
-*> \endverbatim
-*>
-*> \param[out] L
-*> \verbatim
-*> L is DOUBLE PRECISION array, dimension (LDL, N).
-*> On exit L M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDL
-*> \verbatim
-*> LDL is INTEGER
-*> The leading dimension of L.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> Parameter used in generating PRTYPE = 1 and 5 matrices.
-*> \endverbatim
-*>
-*> \param[in] QBLCKA
-*> \verbatim
-*> QBLCKA is INTEGER
-*> When PRTYPE = 3, specifies the distance between 2-by-2
-*> blocks on the diagonal in A. Otherwise, QBLCKA is not
-*> referenced. QBLCKA > 1.
-*> \endverbatim
-*>
-*> \param[in] QBLCKB
-*> \verbatim
-*> QBLCKB is INTEGER
-*> When PRTYPE = 3, specifies the distance between 2-by-2
-*> blocks on the diagonal in B. Otherwise, QBLCKB is not
-*> referenced. QBLCKB > 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> PRTYPE = 1: A and B are Jordan blocks, D and E are identity matrices
-*>
-*> A : if (i == j) then A(i, j) = 1.0
-*> if (j == i + 1) then A(i, j) = -1.0
-*> else A(i, j) = 0.0, i, j = 1...M
-*>
-*> B : if (i == j) then B(i, j) = 1.0 - ALPHA
-*> if (j == i + 1) then B(i, j) = 1.0
-*> else B(i, j) = 0.0, i, j = 1...N
-*>
-*> D : if (i == j) then D(i, j) = 1.0
-*> else D(i, j) = 0.0, i, j = 1...M
-*>
-*> E : if (i == j) then E(i, j) = 1.0
-*> else E(i, j) = 0.0, i, j = 1...N
-*>
-*> L = R are chosen from [-10...10],
-*> which specifies the right hand sides (C, F).
-*>
-*> PRTYPE = 2 or 3: Triangular and/or quasi- triangular.
-*>
-*> A : if (i <= j) then A(i, j) = [-1...1]
-*> else A(i, j) = 0.0, i, j = 1...M
-*>
-*> if (PRTYPE = 3) then
-*> A(k + 1, k + 1) = A(k, k)
-*> A(k + 1, k) = [-1...1]
-*> sign(A(k, k + 1) = -(sin(A(k + 1, k))
-*> k = 1, M - 1, QBLCKA
-*>
-*> B : if (i <= j) then B(i, j) = [-1...1]
-*> else B(i, j) = 0.0, i, j = 1...N
-*>
-*> if (PRTYPE = 3) then
-*> B(k + 1, k + 1) = B(k, k)
-*> B(k + 1, k) = [-1...1]
-*> sign(B(k, k + 1) = -(sign(B(k + 1, k))
-*> k = 1, N - 1, QBLCKB
-*>
-*> D : if (i <= j) then D(i, j) = [-1...1].
-*> else D(i, j) = 0.0, i, j = 1...M
-*>
-*>
-*> E : if (i <= j) then D(i, j) = [-1...1]
-*> else E(i, j) = 0.0, i, j = 1...N
-*>
-*> L, R are chosen from [-10...10],
-*> which specifies the right hand sides (C, F).
-*>
-*> PRTYPE = 4 Full
-*> A(i, j) = [-10...10]
-*> D(i, j) = [-1...1] i,j = 1...M
-*> B(i, j) = [-10...10]
-*> E(i, j) = [-1...1] i,j = 1...N
-*> R(i, j) = [-10...10]
-*> L(i, j) = [-1...1] i = 1..M ,j = 1...N
-*>
-*> L, R specifies the right hand sides (C, F).
-*>
-*> PRTYPE = 5 special case common and/or close eigs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD,
- $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA,
- $ QBLCKB )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N,
- $ PRTYPE, QBLCKA, QBLCKB
- DOUBLE PRECISION ALPHA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
- $ L( LDL, * ), R( LDR, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO, TWENTY, HALF, TWO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0, TWENTY = 2.0D+1,
- $ HALF = 0.5D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K
- DOUBLE PRECISION IMEPS, REEPS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MOD, SIN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM
-* ..
-* .. Executable Statements ..
-*
- IF( PRTYPE.EQ.1 ) THEN
- DO 20 I = 1, M
- DO 10 J = 1, M
- IF( I.EQ.J ) THEN
- A( I, J ) = ONE
- D( I, J ) = ONE
- ELSE IF( I.EQ.J-1 ) THEN
- A( I, J ) = -ONE
- D( I, J ) = ZERO
- ELSE
- A( I, J ) = ZERO
- D( I, J ) = ZERO
- END IF
- 10 CONTINUE
- 20 CONTINUE
-*
- DO 40 I = 1, N
- DO 30 J = 1, N
- IF( I.EQ.J ) THEN
- B( I, J ) = ONE - ALPHA
- E( I, J ) = ONE
- ELSE IF( I.EQ.J-1 ) THEN
- B( I, J ) = ONE
- E( I, J ) = ZERO
- ELSE
- B( I, J ) = ZERO
- E( I, J ) = ZERO
- END IF
- 30 CONTINUE
- 40 CONTINUE
-*
- DO 60 I = 1, M
- DO 50 J = 1, N
- R( I, J ) = ( HALF-SIN( DBLE( I / J ) ) )*TWENTY
- L( I, J ) = R( I, J )
- 50 CONTINUE
- 60 CONTINUE
-*
- ELSE IF( PRTYPE.EQ.2 .OR. PRTYPE.EQ.3 ) THEN
- DO 80 I = 1, M
- DO 70 J = 1, M
- IF( I.LE.J ) THEN
- A( I, J ) = ( HALF-SIN( DBLE( I ) ) )*TWO
- D( I, J ) = ( HALF-SIN( DBLE( I*J ) ) )*TWO
- ELSE
- A( I, J ) = ZERO
- D( I, J ) = ZERO
- END IF
- 70 CONTINUE
- 80 CONTINUE
-*
- DO 100 I = 1, N
- DO 90 J = 1, N
- IF( I.LE.J ) THEN
- B( I, J ) = ( HALF-SIN( DBLE( I+J ) ) )*TWO
- E( I, J ) = ( HALF-SIN( DBLE( J ) ) )*TWO
- ELSE
- B( I, J ) = ZERO
- E( I, J ) = ZERO
- END IF
- 90 CONTINUE
- 100 CONTINUE
-*
- DO 120 I = 1, M
- DO 110 J = 1, N
- R( I, J ) = ( HALF-SIN( DBLE( I*J ) ) )*TWENTY
- L( I, J ) = ( HALF-SIN( DBLE( I+J ) ) )*TWENTY
- 110 CONTINUE
- 120 CONTINUE
-*
- IF( PRTYPE.EQ.3 ) THEN
- IF( QBLCKA.LE.1 )
- $ QBLCKA = 2
- DO 130 K = 1, M - 1, QBLCKA
- A( K+1, K+1 ) = A( K, K )
- A( K+1, K ) = -SIN( A( K, K+1 ) )
- 130 CONTINUE
-*
- IF( QBLCKB.LE.1 )
- $ QBLCKB = 2
- DO 140 K = 1, N - 1, QBLCKB
- B( K+1, K+1 ) = B( K, K )
- B( K+1, K ) = -SIN( B( K, K+1 ) )
- 140 CONTINUE
- END IF
-*
- ELSE IF( PRTYPE.EQ.4 ) THEN
- DO 160 I = 1, M
- DO 150 J = 1, M
- A( I, J ) = ( HALF-SIN( DBLE( I*J ) ) )*TWENTY
- D( I, J ) = ( HALF-SIN( DBLE( I+J ) ) )*TWO
- 150 CONTINUE
- 160 CONTINUE
-*
- DO 180 I = 1, N
- DO 170 J = 1, N
- B( I, J ) = ( HALF-SIN( DBLE( I+J ) ) )*TWENTY
- E( I, J ) = ( HALF-SIN( DBLE( I*J ) ) )*TWO
- 170 CONTINUE
- 180 CONTINUE
-*
- DO 200 I = 1, M
- DO 190 J = 1, N
- R( I, J ) = ( HALF-SIN( DBLE( J / I ) ) )*TWENTY
- L( I, J ) = ( HALF-SIN( DBLE( I*J ) ) )*TWO
- 190 CONTINUE
- 200 CONTINUE
-*
- ELSE IF( PRTYPE.GE.5 ) THEN
- REEPS = HALF*TWO*TWENTY / ALPHA
- IMEPS = ( HALF-TWO ) / ALPHA
- DO 220 I = 1, M
- DO 210 J = 1, N
- R( I, J ) = ( HALF-SIN( DBLE( I*J ) ) )*ALPHA / TWENTY
- L( I, J ) = ( HALF-SIN( DBLE( I+J ) ) )*ALPHA / TWENTY
- 210 CONTINUE
- 220 CONTINUE
-*
- DO 230 I = 1, M
- D( I, I ) = ONE
- 230 CONTINUE
-*
- DO 240 I = 1, M
- IF( I.LE.4 ) THEN
- A( I, I ) = ONE
- IF( I.GT.2 )
- $ A( I, I ) = ONE + REEPS
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
- A( I, I+1 ) = IMEPS
- ELSE IF( I.GT.1 ) THEN
- A( I, I-1 ) = -IMEPS
- END IF
- ELSE IF( I.LE.8 ) THEN
- IF( I.LE.6 ) THEN
- A( I, I ) = REEPS
- ELSE
- A( I, I ) = -REEPS
- END IF
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
- A( I, I+1 ) = ONE
- ELSE IF( I.GT.1 ) THEN
- A( I, I-1 ) = -ONE
- END IF
- ELSE
- A( I, I ) = ONE
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
- A( I, I+1 ) = IMEPS*2
- ELSE IF( I.GT.1 ) THEN
- A( I, I-1 ) = -IMEPS*2
- END IF
- END IF
- 240 CONTINUE
-*
- DO 250 I = 1, N
- E( I, I ) = ONE
- IF( I.LE.4 ) THEN
- B( I, I ) = -ONE
- IF( I.GT.2 )
- $ B( I, I ) = ONE - REEPS
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.N ) THEN
- B( I, I+1 ) = IMEPS
- ELSE IF( I.GT.1 ) THEN
- B( I, I-1 ) = -IMEPS
- END IF
- ELSE IF( I.LE.8 ) THEN
- IF( I.LE.6 ) THEN
- B( I, I ) = REEPS
- ELSE
- B( I, I ) = -REEPS
- END IF
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.N ) THEN
- B( I, I+1 ) = ONE + IMEPS
- ELSE IF( I.GT.1 ) THEN
- B( I, I-1 ) = -ONE - IMEPS
- END IF
- ELSE
- B( I, I ) = ONE - REEPS
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.N ) THEN
- B( I, I+1 ) = IMEPS*2
- ELSE IF( I.GT.1 ) THEN
- B( I, I-1 ) = -IMEPS*2
- END IF
- END IF
- 250 CONTINUE
- END IF
-*
-* Compute rhs (C, F)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, A, LDA, R, LDR, ZERO, C, LDC )
- CALL DGEMM( 'N', 'N', M, N, N, -ONE, L, LDL, B, LDB, ONE, C, LDC )
- CALL DGEMM( 'N', 'N', M, N, M, ONE, D, LDD, R, LDR, ZERO, F, LDF )
- CALL DGEMM( 'N', 'N', M, N, N, -ONE, L, LDL, E, LDE, ONE, F, LDF )
-*
-* End of DLATM5
-*
- END
diff --git a/netlib/LAPACK/dlatm6.f b/netlib/LAPACK/dlatm6.f
deleted file mode 100644
index ca64f86..0000000
--- a/netlib/LAPACK/dlatm6.f
+++ /dev/null
@@ -1,333 +0,0 @@
-*> \brief \b DLATM6
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
-* BETA, WX, WY, S, DIF )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDX, LDY, N, TYPE
-* DOUBLE PRECISION ALPHA, BETA, WX, WY
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
-* $ X( LDX, * ), Y( LDY, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATM6 generates test matrices for the generalized eigenvalue
-*> problem, their corresponding right and left eigenvector matrices,
-*> and also reciprocal condition numbers for all eigenvalues and
-*> the reciprocal condition numbers of eigenvectors corresponding to
-*> the 1th and 5th eigenvalues.
-*>
-*> Test Matrices
-*> =============
-*>
-*> Two kinds of test matrix pairs
-*>
-*> (A, B) = inverse(YH) * (Da, Db) * inverse(X)
-*>
-*> are used in the tests:
-*>
-*> Type 1:
-*> Da = 1+a 0 0 0 0 Db = 1 0 0 0 0
-*> 0 2+a 0 0 0 0 1 0 0 0
-*> 0 0 3+a 0 0 0 0 1 0 0
-*> 0 0 0 4+a 0 0 0 0 1 0
-*> 0 0 0 0 5+a , 0 0 0 0 1 , and
-*>
-*> Type 2:
-*> Da = 1 -1 0 0 0 Db = 1 0 0 0 0
-*> 1 1 0 0 0 0 1 0 0 0
-*> 0 0 1 0 0 0 0 1 0 0
-*> 0 0 0 1+a 1+b 0 0 0 1 0
-*> 0 0 0 -1-b 1+a , 0 0 0 0 1 .
-*>
-*> In both cases the same inverse(YH) and inverse(X) are used to compute
-*> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
-*>
-*> YH: = 1 0 -y y -y X = 1 0 -x -x x
-*> 0 1 -y y -y 0 1 x -x -x
-*> 0 0 1 0 0 0 0 1 0 0
-*> 0 0 0 1 0 0 0 0 1 0
-*> 0 0 0 0 1, 0 0 0 0 1 ,
-*>
-*> where a, b, x and y will have all values independently of each other.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TYPE
-*> \verbatim
-*> TYPE is INTEGER
-*> Specifies the problem type (see futher details).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Size of the matrices A and B.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N).
-*> On exit A N-by-N is initialized according to TYPE.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A and of B.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDA, N).
-*> On exit B N-by-N is initialized according to TYPE.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX, N).
-*> On exit X is the N-by-N matrix of right eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of X.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (LDY, N).
-*> On exit Y is the N-by-N matrix of left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of Y.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*>
-*> Weighting constants for matrix A.
-*> \endverbatim
-*>
-*> \param[in] WX
-*> \verbatim
-*> WX is DOUBLE PRECISION
-*> Constant for right eigenvector matrix.
-*> \endverbatim
-*>
-*> \param[in] WY
-*> \verbatim
-*> WY is DOUBLE PRECISION
-*> Constant for left eigenvector matrix.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> S(i) is the reciprocal condition number for eigenvalue i.
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is DOUBLE PRECISION array, dimension (N)
-*> DIF(i) is the reciprocal condition number for eigenvector i.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
- $ BETA, WX, WY, S, DIF )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDX, LDY, N, TYPE
- DOUBLE PRECISION ALPHA, BETA, WX, WY
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
- $ X( LDX, * ), Y( LDY, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, THREE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
- $ THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION WORK( 100 ), Z( 12, 12 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, SQRT
-* ..
-* .. External Subroutines ..
- EXTERNAL DGESVD, DLACPY, DLAKF2
-* ..
-* .. Executable Statements ..
-*
-* Generate test problem ...
-* (Da, Db) ...
-*
- DO 20 I = 1, N
- DO 10 J = 1, N
-*
- IF( I.EQ.J ) THEN
- A( I, I ) = DBLE( I ) + ALPHA
- B( I, I ) = ONE
- ELSE
- A( I, J ) = ZERO
- B( I, J ) = ZERO
- END IF
-*
- 10 CONTINUE
- 20 CONTINUE
-*
-* Form X and Y
-*
- CALL DLACPY( 'F', N, N, B, LDA, Y, LDY )
- Y( 3, 1 ) = -WY
- Y( 4, 1 ) = WY
- Y( 5, 1 ) = -WY
- Y( 3, 2 ) = -WY
- Y( 4, 2 ) = WY
- Y( 5, 2 ) = -WY
-*
- CALL DLACPY( 'F', N, N, B, LDA, X, LDX )
- X( 1, 3 ) = -WX
- X( 1, 4 ) = -WX
- X( 1, 5 ) = WX
- X( 2, 3 ) = WX
- X( 2, 4 ) = -WX
- X( 2, 5 ) = -WX
-*
-* Form (A, B)
-*
- B( 1, 3 ) = WX + WY
- B( 2, 3 ) = -WX + WY
- B( 1, 4 ) = WX - WY
- B( 2, 4 ) = WX - WY
- B( 1, 5 ) = -WX + WY
- B( 2, 5 ) = WX + WY
- IF( TYPE.EQ.1 ) THEN
- A( 1, 3 ) = WX*A( 1, 1 ) + WY*A( 3, 3 )
- A( 2, 3 ) = -WX*A( 2, 2 ) + WY*A( 3, 3 )
- A( 1, 4 ) = WX*A( 1, 1 ) - WY*A( 4, 4 )
- A( 2, 4 ) = WX*A( 2, 2 ) - WY*A( 4, 4 )
- A( 1, 5 ) = -WX*A( 1, 1 ) + WY*A( 5, 5 )
- A( 2, 5 ) = WX*A( 2, 2 ) + WY*A( 5, 5 )
- ELSE IF( TYPE.EQ.2 ) THEN
- A( 1, 3 ) = TWO*WX + WY
- A( 2, 3 ) = WY
- A( 1, 4 ) = -WY*( TWO+ALPHA+BETA )
- A( 2, 4 ) = TWO*WX - WY*( TWO+ALPHA+BETA )
- A( 1, 5 ) = -TWO*WX + WY*( ALPHA-BETA )
- A( 2, 5 ) = WY*( ALPHA-BETA )
- A( 1, 1 ) = ONE
- A( 1, 2 ) = -ONE
- A( 2, 1 ) = ONE
- A( 2, 2 ) = A( 1, 1 )
- A( 3, 3 ) = ONE
- A( 4, 4 ) = ONE + ALPHA
- A( 4, 5 ) = ONE + BETA
- A( 5, 4 ) = -A( 4, 5 )
- A( 5, 5 ) = A( 4, 4 )
- END IF
-*
-* Compute condition numbers
-*
- IF( TYPE.EQ.1 ) THEN
-*
- S( 1 ) = ONE / SQRT( ( ONE+THREE*WY*WY ) /
- $ ( ONE+A( 1, 1 )*A( 1, 1 ) ) )
- S( 2 ) = ONE / SQRT( ( ONE+THREE*WY*WY ) /
- $ ( ONE+A( 2, 2 )*A( 2, 2 ) ) )
- S( 3 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+A( 3, 3 )*A( 3, 3 ) ) )
- S( 4 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+A( 4, 4 )*A( 4, 4 ) ) )
- S( 5 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+A( 5, 5 )*A( 5, 5 ) ) )
-*
- CALL DLAKF2( 1, 4, A, LDA, A( 2, 2 ), B, B( 2, 2 ), Z, 12 )
- CALL DGESVD( 'N', 'N', 8, 8, Z, 12, WORK, WORK( 9 ), 1,
- $ WORK( 10 ), 1, WORK( 11 ), 40, INFO )
- DIF( 1 ) = WORK( 8 )
-*
- CALL DLAKF2( 4, 1, A, LDA, A( 5, 5 ), B, B( 5, 5 ), Z, 12 )
- CALL DGESVD( 'N', 'N', 8, 8, Z, 12, WORK, WORK( 9 ), 1,
- $ WORK( 10 ), 1, WORK( 11 ), 40, INFO )
- DIF( 5 ) = WORK( 8 )
-*
- ELSE IF( TYPE.EQ.2 ) THEN
-*
- S( 1 ) = ONE / SQRT( ONE / THREE+WY*WY )
- S( 2 ) = S( 1 )
- S( 3 ) = ONE / SQRT( ONE / TWO+WX*WX )
- S( 4 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+( ONE+ALPHA )*( ONE+ALPHA )+( ONE+BETA )*( ONE+
- $ BETA ) ) )
- S( 5 ) = S( 4 )
-*
- CALL DLAKF2( 2, 3, A, LDA, A( 3, 3 ), B, B( 3, 3 ), Z, 12 )
- CALL DGESVD( 'N', 'N', 12, 12, Z, 12, WORK, WORK( 13 ), 1,
- $ WORK( 14 ), 1, WORK( 15 ), 60, INFO )
- DIF( 1 ) = WORK( 12 )
-*
- CALL DLAKF2( 3, 2, A, LDA, A( 4, 4 ), B, B( 4, 4 ), Z, 12 )
- CALL DGESVD( 'N', 'N', 12, 12, Z, 12, WORK, WORK( 13 ), 1,
- $ WORK( 14 ), 1, WORK( 15 ), 60, INFO )
- DIF( 5 ) = WORK( 12 )
-*
- END IF
-*
- RETURN
-*
-* End of DLATM6
-*
- END
diff --git a/netlib/LAPACK/dlatm7.f b/netlib/LAPACK/dlatm7.f
deleted file mode 100644
index a8c1a0c..0000000
--- a/netlib/LAPACK/dlatm7.f
+++ /dev/null
@@ -1,297 +0,0 @@
-*> \brief \b DLATM7
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
-* RANK, INFO )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION COND
-* INTEGER IDIST, INFO, IRSIGN, MODE, N, RANK
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * )
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATM7 computes the entries of D as specified by MODE
-*> COND and IRSIGN. IDIST and ISEED determine the generation
-*> of random numbers. DLATM7 is called by DLATMT to generate
-*> random test matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \verbatim
-*> MODE - INTEGER
-*> On entry describes how D is to be computed:
-*> MODE = 0 means do not change D.
-*>
-*> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
-*> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) I=1:RANK
-*>
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> Not modified.
-*>
-*> COND - DOUBLE PRECISION
-*> On entry, used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*>
-*> IRSIGN - INTEGER
-*> On entry, if MODE neither -6, 0 nor 6, determines sign of
-*> entries of D
-*> 0 => leave entries of D unchanged
-*> 1 => multiply each entry of D by 1 or -1 with probability .5
-*>
-*> IDIST - CHARACTER*1
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*>
-*> ISEED - INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. The random number generator uses a
-*> linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to DLATM7
-*> to continue the same random number sequence.
-*> Changed on exit.
-*>
-*> D - DOUBLE PRECISION array, dimension ( MIN( M , N ) )
-*> Array to be computed according to MODE, COND and IRSIGN.
-*> May be changed on exit if MODE is nonzero.
-*>
-*> N - INTEGER
-*> Number of entries of D. Not modified.
-*>
-*> RANK - INTEGER
-*> The rank of matrix to be generated for modes 1,2,3 only.
-*> D( RANK+1:N ) = 0.
-*> Not modified.
-*>
-*> INFO - INTEGER
-*> 0 => normal termination
-*> -1 => if MODE not in range -6 to 6
-*> -2 => if MODE neither -6, 0 nor 6, and
-*> IRSIGN neither 0 nor 1
-*> -3 => if MODE neither -6, 0 nor 6 and COND less than 1
-*> -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3
-*> -7 => if N negative
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
- $ RANK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION COND
- INTEGER IDIST, INFO, IRSIGN, MODE, N, RANK
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * )
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ALPHA, TEMP
- INTEGER I
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLARAN
- EXTERNAL DLARAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARNV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, EXP, LOG
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters. Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set INFO if an error
-*
- IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
- INFO = -1
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
- INFO = -2
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ COND.LT.ONE ) THEN
- INFO = -3
- ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
- $ ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATM7', -INFO )
- RETURN
- END IF
-*
-* Compute D according to COND and MODE
-*
- IF( MODE.NE.0 ) THEN
- GO TO ( 100, 130, 160, 190, 210, 230 )ABS( MODE )
-*
-* One large D value:
-*
- 100 CONTINUE
- DO 110 I = 2, RANK
- D( I ) = ONE / COND
- 110 CONTINUE
- DO 120 I = RANK + 1, N
- D( I ) = ZERO
- 120 CONTINUE
- D( 1 ) = ONE
- GO TO 240
-*
-* One small D value:
-*
- 130 CONTINUE
- DO 140 I = 1, RANK - 1
- D( I ) = ONE
- 140 CONTINUE
- DO 150 I = RANK + 1, N
- D( I ) = ZERO
- 150 CONTINUE
- D( RANK ) = ONE / COND
- GO TO 240
-*
-* Exponentially distributed D values:
-*
- 160 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 .AND. RANK.GT.1 ) THEN
- ALPHA = COND**( -ONE / DBLE( RANK-1 ) )
- DO 170 I = 2, RANK
- D( I ) = ALPHA**( I-1 )
- 170 CONTINUE
- DO 180 I = RANK + 1, N
- D( I ) = ZERO
- 180 CONTINUE
- END IF
- GO TO 240
-*
-* Arithmetically distributed D values:
-*
- 190 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 ) THEN
- TEMP = ONE / COND
- ALPHA = ( ONE-TEMP ) / DBLE( N-1 )
- DO 200 I = 2, N
- D( I ) = DBLE( N-I )*ALPHA + TEMP
- 200 CONTINUE
- END IF
- GO TO 240
-*
-* Randomly distributed D values on ( 1/COND , 1):
-*
- 210 CONTINUE
- ALPHA = LOG( ONE / COND )
- DO 220 I = 1, N
- D( I ) = EXP( ALPHA*DLARAN( ISEED ) )
- 220 CONTINUE
- GO TO 240
-*
-* Randomly distributed D values from IDIST
-*
- 230 CONTINUE
- CALL DLARNV( IDIST, ISEED, N, D )
-*
- 240 CONTINUE
-*
-* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
-* random signs to D
-*
- IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ IRSIGN.EQ.1 ) THEN
- DO 250 I = 1, N
- TEMP = DLARAN( ISEED )
- IF( TEMP.GT.HALF )
- $ D( I ) = -D( I )
- 250 CONTINUE
- END IF
-*
-* Reverse if MODE < 0
-*
- IF( MODE.LT.0 ) THEN
- DO 260 I = 1, N / 2
- TEMP = D( I )
- D( I ) = D( N+1-I )
- D( N+1-I ) = TEMP
- 260 CONTINUE
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DLATM7
-*
- END
diff --git a/netlib/LAPACK/dlatme.f b/netlib/LAPACK/dlatme.f
deleted file mode 100644
index e1dce5f..0000000
--- a/netlib/LAPACK/dlatme.f
+++ /dev/null
@@ -1,710 +0,0 @@
-*> \brief \b DLATME
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATME( N, DIST, ISEED, D, MODE, COND, DMAX, EI,
-* RSIGN,
-* UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM,
-* A,
-* LDA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIST, RSIGN, SIM, UPPER
-* INTEGER INFO, KL, KU, LDA, MODE, MODES, N
-* DOUBLE PRECISION ANORM, COND, CONDS, DMAX
-* ..
-* .. Array Arguments ..
-* CHARACTER EI( * )
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION A( LDA, * ), D( * ), DS( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATME generates random non-symmetric square matrices with
-*> specified eigenvalues for testing LAPACK programs.
-*>
-*> DLATME operates by applying the following sequence of
-*> operations:
-*>
-*> 1. Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX, and RSIGN
-*> as described below.
-*>
-*> 2. If complex conjugate pairs are desired (MODE=0 and EI(1)='R',
-*> or MODE=5), certain pairs of adjacent elements of D are
-*> interpreted as the real and complex parts of a complex
-*> conjugate pair; A thus becomes block diagonal, with 1x1
-*> and 2x2 blocks.
-*>
-*> 3. If UPPER='T', the upper triangle of A is set to random values
-*> out of distribution DIST.
-*>
-*> 4. If SIM='T', A is multiplied on the left by a random matrix
-*> X, whose singular values are specified by DS, MODES, and
-*> CONDS, and on the right by X inverse.
-*>
-*> 5. If KL < N-1, the lower bandwidth is reduced to KL using
-*> Householder transformations. If KU < N-1, the upper
-*> bandwidth is reduced to KU.
-*>
-*> 6. If ANORM is not negative, the matrix is scaled to have
-*> maximum-element-norm ANORM.
-*>
-*> (Note: since the matrix cannot be reduced beyond Hessenberg form,
-*> no packing options are available.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns (or rows) of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate the random eigen-/singular values, and for the
-*> upper triangle (see UPPER).
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to DLATME
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( N )
-*> This array is used to specify the eigenvalues of A. If
-*> MODE=0, then D is assumed to contain the eigenvalues (but
-*> see the description of EI), otherwise they will be
-*> computed according to MODE, COND, DMAX, and RSIGN and
-*> placed in D.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry this describes how the eigenvalues are to
-*> be specified:
-*> MODE = 0 means use D (with EI) as input
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed. Each odd-even pair
-*> of elements will be either used as two real
-*> eigenvalues or as the real and imaginary part
-*> of a complex conjugate pair of eigenvalues;
-*> the choice of which is done is random, with
-*> 50-50 probability, for each pair.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is between 1 and 4, D has entries ranging
-*> from 1 to 1/COND, if between -1 and -4, D has entries
-*> ranging from 1/COND to 1,
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is DOUBLE PRECISION
-*> On entry, this is used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is DOUBLE PRECISION
-*> If MODE is neither -6, 0 nor 6, the contents of D, as
-*> computed according to MODE and COND, will be scaled by
-*> DMAX / max(abs(D(i))). Note that DMAX need not be
-*> positive: if DMAX is negative (or zero), D will be
-*> scaled by a negative number (or zero).
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] EI
-*> \verbatim
-*> EI is CHARACTER*1 array, dimension ( N )
-*> If MODE is 0, and EI(1) is not ' ' (space character),
-*> this array specifies which elements of D (on input) are
-*> real eigenvalues and which are the real and imaginary parts
-*> of a complex conjugate pair of eigenvalues. The elements
-*> of EI may then only have the values 'R' and 'I'. If
-*> EI(j)='R' and EI(j+1)='I', then the j-th eigenvalue is
-*> CMPLX( D(j) , D(j+1) ), and the (j+1)-th is the complex
-*> conjugate thereof. If EI(j)=EI(j+1)='R', then the j-th
-*> eigenvalue is D(j) (i.e., real). EI(1) may not be 'I',
-*> nor may two adjacent elements of EI both have the value 'I'.
-*> If MODE is not 0, then EI is ignored. If MODE is 0 and
-*> EI(1)=' ', then the eigenvalues will all be real.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] RSIGN
-*> \verbatim
-*> RSIGN is CHARACTER*1
-*> If MODE is not 0, 6, or -6, and RSIGN='T', then the
-*> elements of D, as computed according to MODE and COND, will
-*> be multiplied by a random sign (+1 or -1). If RSIGN='F',
-*> they will not be. RSIGN may only have the values 'T' or
-*> 'F'.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] UPPER
-*> \verbatim
-*> UPPER is CHARACTER*1
-*> If UPPER='T', then the elements of A above the diagonal
-*> (and above the 2x2 diagonal blocks, if A has complex
-*> eigenvalues) will be set to random numbers out of DIST.
-*> If UPPER='F', they will not. UPPER may only have the
-*> values 'T' or 'F'.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] SIM
-*> \verbatim
-*> SIM is CHARACTER*1
-*> If SIM='T', then A will be operated on by a "similarity
-*> transform", i.e., multiplied on the left by a matrix X and
-*> on the right by X inverse. X = U S V, where U and V are
-*> random unitary matrices and S is a (diagonal) matrix of
-*> singular values specified by DS, MODES, and CONDS. If
-*> SIM='F', then A will not be transformed.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] DS
-*> \verbatim
-*> DS is DOUBLE PRECISION array, dimension ( N )
-*> This array is used to specify the singular values of X,
-*> in the same way that D specifies the eigenvalues of A.
-*> If MODE=0, the DS contains the singular values, which
-*> may not be zero.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODES
-*> \verbatim
-*> MODES is INTEGER
-*> \endverbatim
-*>
-*> \param[in] CONDS
-*> \verbatim
-*> CONDS is DOUBLE PRECISION
-*> Same as MODE and COND, but for specifying the diagonal
-*> of S. MODES=-6 and +6 are not allowed (since they would
-*> result in randomly ill-conditioned eigenvalues.)
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> This specifies the lower bandwidth of the matrix. KL=1
-*> specifies upper Hessenberg form. If KL is at least N-1,
-*> then A will have full lower bandwidth. KL must be at
-*> least 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> This specifies the upper bandwidth of the matrix. KU=1
-*> specifies lower Hessenberg form. If KU is at least N-1,
-*> then A will have full upper bandwidth; if KU and KL
-*> are both at least N-1, then A will be dense. Only one of
-*> KU and KL may be less than N-1. KU must be at least 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If ANORM is not negative, then A will be scaled by a non-
-*> negative real number to make the maximum-element-norm of A
-*> to be ANORM.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( LDA, N )
-*> On exit A is the desired test matrix.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> LDA specifies the first dimension of A as declared in the
-*> calling program. LDA must be at least N.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( 3*N )
-*> Workspace.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error code. On exit, INFO will be set to one of the
-*> following values:
-*> 0 => normal return
-*> -1 => N negative
-*> -2 => DIST illegal string
-*> -5 => MODE not in range -6 to 6
-*> -6 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -8 => EI(1) is not ' ' or 'R', EI(j) is not 'R' or 'I', or
-*> two adjacent elements of EI are 'I'.
-*> -9 => RSIGN is not 'T' or 'F'
-*> -10 => UPPER is not 'T' or 'F'
-*> -11 => SIM is not 'T' or 'F'
-*> -12 => MODES=0 and DS has a zero singular value.
-*> -13 => MODES is not in the range -5 to 5.
-*> -14 => MODES is nonzero and CONDS is less than 1.
-*> -15 => KL is less than 1.
-*> -16 => KU is less than 1, or KL and KU are both less than
-*> N-1.
-*> -19 => LDA is less than N.
-*> 1 => Error return from DLATM1 (computing D)
-*> 2 => Cannot scale to DMAX (max. eigenvalue is 0)
-*> 3 => Error return from DLATM1 (computing DS)
-*> 4 => Error return from DLARGE
-*> 5 => Zero singular value from DLATM1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATME( N, DIST, ISEED, D, MODE, COND, DMAX, EI,
- $ RSIGN,
- $ UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM,
- $ A,
- $ LDA, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIST, RSIGN, SIM, UPPER
- INTEGER INFO, KL, KU, LDA, MODE, MODES, N
- DOUBLE PRECISION ANORM, COND, CONDS, DMAX
-* ..
-* .. Array Arguments ..
- CHARACTER EI( * )
- INTEGER ISEED( 4 )
- DOUBLE PRECISION A( LDA, * ), D( * ), DS( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 1.0D0 / 2.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BADEI, BADS, USEEI
- INTEGER I, IC, ICOLS, IDIST, IINFO, IR, IROWS, IRSIGN,
- $ ISIM, IUPPER, J, JC, JCR, JR
- DOUBLE PRECISION ALPHA, TAU, TEMP, XNORMS
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION TEMPA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLANGE, DLARAN
- EXTERNAL LSAME, DLANGE, DLARAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMV, DGER, DLARFG, DLARGE, DLARNV,
- $ DLASET, DLATM1, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Check EI
-*
- USEEI = .TRUE.
- BADEI = .FALSE.
- IF( LSAME( EI( 1 ), ' ' ) .OR. MODE.NE.0 ) THEN
- USEEI = .FALSE.
- ELSE
- IF( LSAME( EI( 1 ), 'R' ) ) THEN
- DO 10 J = 2, N
- IF( LSAME( EI( J ), 'I' ) ) THEN
- IF( LSAME( EI( J-1 ), 'I' ) )
- $ BADEI = .TRUE.
- ELSE
- IF( .NOT.LSAME( EI( J ), 'R' ) )
- $ BADEI = .TRUE.
- END IF
- 10 CONTINUE
- ELSE
- BADEI = .TRUE.
- END IF
- END IF
-*
-* Decode RSIGN
-*
- IF( LSAME( RSIGN, 'T' ) ) THEN
- IRSIGN = 1
- ELSE IF( LSAME( RSIGN, 'F' ) ) THEN
- IRSIGN = 0
- ELSE
- IRSIGN = -1
- END IF
-*
-* Decode UPPER
-*
- IF( LSAME( UPPER, 'T' ) ) THEN
- IUPPER = 1
- ELSE IF( LSAME( UPPER, 'F' ) ) THEN
- IUPPER = 0
- ELSE
- IUPPER = -1
- END IF
-*
-* Decode SIM
-*
- IF( LSAME( SIM, 'T' ) ) THEN
- ISIM = 1
- ELSE IF( LSAME( SIM, 'F' ) ) THEN
- ISIM = 0
- ELSE
- ISIM = -1
- END IF
-*
-* Check DS, if MODES=0 and ISIM=1
-*
- BADS = .FALSE.
- IF( MODES.EQ.0 .AND. ISIM.EQ.1 ) THEN
- DO 20 J = 1, N
- IF( DS( J ).EQ.ZERO )
- $ BADS = .TRUE.
- 20 CONTINUE
- END IF
-*
-* Set INFO if an error
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -2
- ELSE IF( ABS( MODE ).GT.6 ) THEN
- INFO = -5
- ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
- $ THEN
- INFO = -6
- ELSE IF( BADEI ) THEN
- INFO = -8
- ELSE IF( IRSIGN.EQ.-1 ) THEN
- INFO = -9
- ELSE IF( IUPPER.EQ.-1 ) THEN
- INFO = -10
- ELSE IF( ISIM.EQ.-1 ) THEN
- INFO = -11
- ELSE IF( BADS ) THEN
- INFO = -12
- ELSE IF( ISIM.EQ.1 .AND. ABS( MODES ).GT.5 ) THEN
- INFO = -13
- ELSE IF( ISIM.EQ.1 .AND. MODES.NE.0 .AND. CONDS.LT.ONE ) THEN
- INFO = -14
- ELSE IF( KL.LT.1 ) THEN
- INFO = -15
- ELSE IF( KU.LT.1 .OR. ( KU.LT.N-1 .AND. KL.LT.N-1 ) ) THEN
- INFO = -16
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -19
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATME', -INFO )
- RETURN
- END IF
-*
-* Initialize random number generator
-*
- DO 30 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 30 CONTINUE
-*
- IF( MOD( ISEED( 4 ), 2 ).NE.1 )
- $ ISEED( 4 ) = ISEED( 4 ) + 1
-*
-* 2) Set up diagonal of A
-*
-* Compute D according to COND and MODE
-*
- CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
- IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 40 I = 2, N
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 40 CONTINUE
-*
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE IF( DMAX.NE.ZERO ) THEN
- INFO = 2
- RETURN
- ELSE
- ALPHA = ZERO
- END IF
-*
- CALL DSCAL( N, ALPHA, D, 1 )
-*
- END IF
-*
- CALL DLASET( 'Full', N, N, ZERO, ZERO, A, LDA )
- CALL DCOPY( N, D, 1, A, LDA+1 )
-*
-* Set up complex conjugate pairs
-*
- IF( MODE.EQ.0 ) THEN
- IF( USEEI ) THEN
- DO 50 J = 2, N
- IF( LSAME( EI( J ), 'I' ) ) THEN
- A( J-1, J ) = A( J, J )
- A( J, J-1 ) = -A( J, J )
- A( J, J ) = A( J-1, J-1 )
- END IF
- 50 CONTINUE
- END IF
-*
- ELSE IF( ABS( MODE ).EQ.5 ) THEN
-*
- DO 60 J = 2, N, 2
- IF( DLARAN( ISEED ).GT.HALF ) THEN
- A( J-1, J ) = A( J, J )
- A( J, J-1 ) = -A( J, J )
- A( J, J ) = A( J-1, J-1 )
- END IF
- 60 CONTINUE
- END IF
-*
-* 3) If UPPER='T', set upper triangle of A to random numbers.
-* (but don't modify the corners of 2x2 blocks.)
-*
- IF( IUPPER.NE.0 ) THEN
- DO 70 JC = 2, N
- IF( A( JC-1, JC ).NE.ZERO ) THEN
- JR = JC - 2
- ELSE
- JR = JC - 1
- END IF
- CALL DLARNV( IDIST, ISEED, JR, A( 1, JC ) )
- 70 CONTINUE
- END IF
-*
-* 4) If SIM='T', apply similarity transformation.
-*
-* -1
-* Transform is X A X , where X = U S V, thus
-*
-* it is U S V A V' (1/S) U'
-*
- IF( ISIM.NE.0 ) THEN
-*
-* Compute S (singular values of the eigenvector matrix)
-* according to CONDS and MODES
-*
- CALL DLATM1( MODES, CONDS, 0, 0, ISEED, DS, N, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
-*
-* Multiply by V and V'
-*
- CALL DLARGE( N, A, LDA, ISEED, WORK, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 4
- RETURN
- END IF
-*
-* Multiply by S and (1/S)
-*
- DO 80 J = 1, N
- CALL DSCAL( N, DS( J ), A( J, 1 ), LDA )
- IF( DS( J ).NE.ZERO ) THEN
- CALL DSCAL( N, ONE / DS( J ), A( 1, J ), 1 )
- ELSE
- INFO = 5
- RETURN
- END IF
- 80 CONTINUE
-*
-* Multiply by U and U'
-*
- CALL DLARGE( N, A, LDA, ISEED, WORK, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 4
- RETURN
- END IF
- END IF
-*
-* 5) Reduce the bandwidth.
-*
- IF( KL.LT.N-1 ) THEN
-*
-* Reduce bandwidth -- kill column
-*
- DO 90 JCR = KL + 1, N - 1
- IC = JCR - KL
- IROWS = N + 1 - JCR
- ICOLS = N + KL - JCR
-*
- CALL DCOPY( IROWS, A( JCR, IC ), 1, WORK, 1 )
- XNORMS = WORK( 1 )
- CALL DLARFG( IROWS, XNORMS, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL DGEMV( 'T', IROWS, ICOLS, ONE, A( JCR, IC+1 ), LDA,
- $ WORK, 1, ZERO, WORK( IROWS+1 ), 1 )
- CALL DGER( IROWS, ICOLS, -TAU, WORK, 1, WORK( IROWS+1 ), 1,
- $ A( JCR, IC+1 ), LDA )
-*
- CALL DGEMV( 'N', N, IROWS, ONE, A( 1, JCR ), LDA, WORK, 1,
- $ ZERO, WORK( IROWS+1 ), 1 )
- CALL DGER( N, IROWS, -TAU, WORK( IROWS+1 ), 1, WORK, 1,
- $ A( 1, JCR ), LDA )
-*
- A( JCR, IC ) = XNORMS
- CALL DLASET( 'Full', IROWS-1, 1, ZERO, ZERO, A( JCR+1, IC ),
- $ LDA )
- 90 CONTINUE
- ELSE IF( KU.LT.N-1 ) THEN
-*
-* Reduce upper bandwidth -- kill a row at a time.
-*
- DO 100 JCR = KU + 1, N - 1
- IR = JCR - KU
- IROWS = N + KU - JCR
- ICOLS = N + 1 - JCR
-*
- CALL DCOPY( ICOLS, A( IR, JCR ), LDA, WORK, 1 )
- XNORMS = WORK( 1 )
- CALL DLARFG( ICOLS, XNORMS, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL DGEMV( 'N', IROWS, ICOLS, ONE, A( IR+1, JCR ), LDA,
- $ WORK, 1, ZERO, WORK( ICOLS+1 ), 1 )
- CALL DGER( IROWS, ICOLS, -TAU, WORK( ICOLS+1 ), 1, WORK, 1,
- $ A( IR+1, JCR ), LDA )
-*
- CALL DGEMV( 'C', ICOLS, N, ONE, A( JCR, 1 ), LDA, WORK, 1,
- $ ZERO, WORK( ICOLS+1 ), 1 )
- CALL DGER( ICOLS, N, -TAU, WORK, 1, WORK( ICOLS+1 ), 1,
- $ A( JCR, 1 ), LDA )
-*
- A( IR, JCR ) = XNORMS
- CALL DLASET( 'Full', 1, ICOLS-1, ZERO, ZERO, A( IR, JCR+1 ),
- $ LDA )
- 100 CONTINUE
- END IF
-*
-* Scale the matrix to have norm ANORM
-*
- IF( ANORM.GE.ZERO ) THEN
- TEMP = DLANGE( 'M', N, N, A, LDA, TEMPA )
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = ANORM / TEMP
- DO 110 J = 1, N
- CALL DSCAL( N, ALPHA, A( 1, J ), 1 )
- 110 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DLATME
-*
- END
diff --git a/netlib/LAPACK/dlatmr.f b/netlib/LAPACK/dlatmr.f
deleted file mode 100644
index d38fddf..0000000
--- a/netlib/LAPACK/dlatmr.f
+++ /dev/null
@@ -1,1227 +0,0 @@
-*> \brief \b DLATMR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
-* RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
-* CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
-* PACK, A, LDA, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
-* INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
-* DOUBLE PRECISION ANORM, COND, CONDL, CONDR, DMAX, SPARSE
-* ..
-* .. Array Arguments ..
-* INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), D( * ), DL( * ), DR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATMR generates random matrices of various types for testing
-*> LAPACK programs.
-*>
-*> DLATMR operates by applying the following sequence of
-*> operations:
-*>
-*> Generate a matrix A with random entries of distribution DIST
-*> which is symmetric if SYM='S', and nonsymmetric
-*> if SYM='N'.
-*>
-*> Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX and RSIGN
-*> as described below.
-*>
-*> Grade the matrix, if desired, from the left and/or right
-*> as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
-*> MODER and CONDR also determine the grading as described
-*> below.
-*>
-*> Permute, if desired, the rows and/or columns as specified by
-*> PIVTNG and IPIVOT.
-*>
-*> Set random entries to zero, if desired, to get a random sparse
-*> matrix as specified by SPARSE.
-*>
-*> Make A a band matrix, if desired, by zeroing out the matrix
-*> outside a band of lower bandwidth KL and upper bandwidth KU.
-*>
-*> Scale A, if desired, to have maximum entry ANORM.
-*>
-*> Pack the matrix if desired. Options specified by PACK are:
-*> no packing
-*> zero out upper half (if symmetric)
-*> zero out lower half (if symmetric)
-*> store the upper half columnwise (if symmetric or
-*> square upper triangular)
-*> store the lower half columnwise (if symmetric or
-*> square lower triangular)
-*> same as upper half rowwise if symmetric
-*> store the lower triangle in banded format (if symmetric)
-*> store the upper triangle in banded format (if symmetric)
-*> store the entire matrix in banded format
-*>
-*> Note: If two calls to DLATMR differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*>
-*> If two calls to DLATMR both have full bandwidth (KL = M-1
-*> and KU = N-1), and differ only in the PIVTNG and PACK
-*> parameters, then the matrices generated will differ only
-*> in the order of the rows and/or columns, and otherwise
-*> contain the same data. This consistency cannot be and
-*> is not maintained with less than full bandwidth.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Number of rows of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of columns of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate a random matrix .
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to DLATMR
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] SYM
-*> \verbatim
-*> SYM is CHARACTER*1
-*> If SYM='S' or 'H', generated matrix is symmetric.
-*> If SYM='N', generated matrix is nonsymmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> On entry this array specifies the diagonal entries
-*> of the diagonal of A. D may either be specified
-*> on entry, or set according to MODE and COND as described
-*> below. May be changed on exit if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry describes how D is to be used:
-*> MODE = 0 means use D as input
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is DOUBLE PRECISION
-*> On entry, used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is DOUBLE PRECISION
-*> If MODE neither -6, 0 nor 6, the diagonal is scaled by
-*> DMAX / max(abs(D(i))), so that maximum absolute entry
-*> of diagonal is abs(DMAX). If DMAX is negative (or zero),
-*> diagonal will be scaled by a negative number (or zero).
-*> \endverbatim
-*>
-*> \param[in] RSIGN
-*> \verbatim
-*> RSIGN is CHARACTER*1
-*> If MODE neither -6, 0 nor 6, specifies sign of diagonal
-*> as follows:
-*> 'T' => diagonal entries are multiplied by 1 or -1
-*> with probability .5
-*> 'F' => diagonal unchanged
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] GRADE
-*> \verbatim
-*> GRADE is CHARACTER*1
-*> Specifies grading of matrix as follows:
-*> 'N' => no grading
-*> 'L' => matrix premultiplied by diag( DL )
-*> (only if matrix nonsymmetric)
-*> 'R' => matrix postmultiplied by diag( DR )
-*> (only if matrix nonsymmetric)
-*> 'B' => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DR )
-*> (only if matrix nonsymmetric)
-*> 'S' or 'H' => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DL )
-*> ('S' for symmetric, or 'H' for Hermitian)
-*> 'E' => matrix premultiplied by diag( DL ) and
-*> postmultiplied by inv( diag( DL ) )
-*> ( 'E' for eigenvalue invariance)
-*> (only if matrix nonsymmetric)
-*> Note: if GRADE='E', then M must equal N.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (M)
-*> If MODEL=0, then on entry this array specifies the diagonal
-*> entries of a diagonal matrix used as described under GRADE
-*> above. If MODEL is not zero, then DL will be set according
-*> to MODEL and CONDL, analogous to the way D is set according
-*> to MODE and COND (except there is no DMAX parameter for DL).
-*> If GRADE='E', then DL cannot have zero entries.
-*> Not referenced if GRADE = 'N' or 'R'. Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] MODEL
-*> \verbatim
-*> MODEL is INTEGER
-*> This specifies how the diagonal array DL is to be computed,
-*> just as MODE specifies how D is to be computed.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] CONDL
-*> \verbatim
-*> CONDL is DOUBLE PRECISION
-*> When MODEL is not zero, this specifies the condition number
-*> of the computed DL. Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] DR
-*> \verbatim
-*> DR is DOUBLE PRECISION array, dimension (N)
-*> If MODER=0, then on entry this array specifies the diagonal
-*> entries of a diagonal matrix used as described under GRADE
-*> above. If MODER is not zero, then DR will be set according
-*> to MODER and CONDR, analogous to the way D is set according
-*> to MODE and COND (except there is no DMAX parameter for DR).
-*> Not referenced if GRADE = 'N', 'L', 'H', 'S' or 'E'.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] MODER
-*> \verbatim
-*> MODER is INTEGER
-*> This specifies how the diagonal array DR is to be computed,
-*> just as MODE specifies how D is to be computed.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] CONDR
-*> \verbatim
-*> CONDR is DOUBLE PRECISION
-*> When MODER is not zero, this specifies the condition number
-*> of the computed DR. Not modified.
-*> \endverbatim
-*>
-*> \param[in] PIVTNG
-*> \verbatim
-*> PIVTNG is CHARACTER*1
-*> On entry specifies pivoting permutations as follows:
-*> 'N' or ' ' => none.
-*> 'L' => left or row pivoting (matrix must be nonsymmetric).
-*> 'R' => right or column pivoting (matrix must be
-*> nonsymmetric).
-*> 'B' or 'F' => both or full pivoting, i.e., on both sides.
-*> In this case, M must equal N
-*>
-*> If two calls to DLATMR both have full bandwidth (KL = M-1
-*> and KU = N-1), and differ only in the PIVTNG and PACK
-*> parameters, then the matrices generated will differ only
-*> in the order of the rows and/or columns, and otherwise
-*> contain the same data. This consistency cannot be
-*> maintained with less than full bandwidth.
-*> \endverbatim
-*>
-*> \param[in] IPIVOT
-*> \verbatim
-*> IPIVOT is INTEGER array, dimension (N or M)
-*> This array specifies the permutation used. After the
-*> basic matrix is generated, the rows, columns, or both
-*> are permuted. If, say, row pivoting is selected, DLATMR
-*> starts with the *last* row and interchanges the M-th and
-*> IPIVOT(M)-th rows, then moves to the next-to-last row,
-*> interchanging the (M-1)-th and the IPIVOT(M-1)-th rows,
-*> and so on. In terms of "2-cycles", the permutation is
-*> (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M))
-*> where the rightmost cycle is applied first. This is the
-*> *inverse* of the effect of pivoting in LINPACK. The idea
-*> is that factoring (with pivoting) an identity matrix
-*> which has been inverse-pivoted in this way should
-*> result in a pivot vector identical to IPIVOT.
-*> Not referenced if PIVTNG = 'N'. Not modified.
-*> \endverbatim
-*>
-*> \param[in] SPARSE
-*> \verbatim
-*> SPARSE is DOUBLE PRECISION
-*> On entry specifies the sparsity of the matrix if a sparse
-*> matrix is to be generated. SPARSE should lie between
-*> 0 and 1. To generate a sparse matrix, for each matrix entry
-*> a uniform ( 0, 1 ) random number x is generated and
-*> compared to SPARSE; if x is larger the matrix entry
-*> is unchanged and if x is smaller the entry is set
-*> to zero. Thus on the average a fraction SPARSE of the
-*> entries will be set to zero.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> On entry specifies the lower bandwidth of the matrix. For
-*> example, KL=0 implies upper triangular, KL=1 implies upper
-*> Hessenberg, and KL at least M-1 implies the matrix is not
-*> banded. Must equal KU if matrix is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> On entry specifies the upper bandwidth of the matrix. For
-*> example, KU=0 implies lower triangular, KU=1 implies lower
-*> Hessenberg, and KU at least N-1 implies the matrix is not
-*> banded. Must equal KL if matrix is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> On entry specifies maximum entry of output matrix
-*> (output matrix will by multiplied by a constant so that
-*> its largest absolute entry equal ANORM)
-*> if ANORM is nonnegative. If ANORM is negative no scaling
-*> is done. Not modified.
-*> \endverbatim
-*>
-*> \param[in] PACK
-*> \verbatim
-*> PACK is CHARACTER*1
-*> On entry specifies packing of matrix as follows:
-*> 'N' => no packing
-*> 'U' => zero out all subdiagonal entries (if symmetric)
-*> 'L' => zero out all superdiagonal entries (if symmetric)
-*> 'C' => store the upper triangle columnwise
-*> (only if matrix symmetric or square upper triangular)
-*> 'R' => store the lower triangle columnwise
-*> (only if matrix symmetric or square lower triangular)
-*> (same as upper half rowwise if symmetric)
-*> 'B' => store the lower triangle in band storage scheme
-*> (only if matrix symmetric)
-*> 'Q' => store the upper triangle in band storage scheme
-*> (only if matrix symmetric)
-*> 'Z' => store the entire matrix in band storage scheme
-*> (pivoting can be provided for by using this
-*> option to store A in the trailing rows of
-*> the allocated storage)
-*>
-*> Using these options, the various LAPACK packed and banded
-*> storage schemes can be obtained:
-*> GB - use 'Z'
-*> PB, SB or TB - use 'B' or 'Q'
-*> PP, SP or TP - use 'C' or 'R'
-*>
-*> If two calls to DLATMR differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On exit A is the desired test matrix. Only those
-*> entries of A which are significant on output
-*> will be referenced (even if A is in packed or band
-*> storage format). The 'unoccupied corners' of A in
-*> band format will be zeroed out.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> on entry LDA specifies the first dimension of A as
-*> declared in the calling program.
-*> If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ).
-*> If PACK='C' or 'R', LDA must be at least 1.
-*> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N )
-*> If PACK='Z', LDA must be at least KUU+KLL+1, where
-*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension ( N or M)
-*> Workspace. Not referenced if PIVTNG = 'N'. Changed on exit.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error parameter on exit:
-*> 0 => normal return
-*> -1 => M negative or unequal to N and SYM='S' or 'H'
-*> -2 => N negative
-*> -3 => DIST illegal string
-*> -5 => SYM illegal string
-*> -7 => MODE not in range -6 to 6
-*> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string
-*> -11 => GRADE illegal string, or GRADE='E' and
-*> M not equal to N, or GRADE='L', 'R', 'B' or 'E' and
-*> SYM = 'S' or 'H'
-*> -12 => GRADE = 'E' and DL contains zero
-*> -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H',
-*> 'S' or 'E'
-*> -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E',
-*> and MODEL neither -6, 0 nor 6
-*> -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B'
-*> -17 => CONDR less than 1.0, GRADE='R' or 'B', and
-*> MODER neither -6, 0 nor 6
-*> -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and
-*> M not equal to N, or PIVTNG='L' or 'R' and SYM='S'
-*> or 'H'
-*> -19 => IPIVOT contains out of range number and
-*> PIVTNG not equal to 'N'
-*> -20 => KL negative
-*> -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL
-*> -22 => SPARSE not in range 0. to 1.
-*> -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q'
-*> and SYM='N', or PACK='C' and SYM='N' and either KL
-*> not equal to 0 or N not equal to M, or PACK='R' and
-*> SYM='N', and either KU not equal to 0 or N not equal
-*> to M
-*> -26 => LDA too small
-*> 1 => Error return from DLATM1 (computing D)
-*> 2 => Cannot scale diagonal to DMAX (max. entry is 0)
-*> 3 => Error return from DLATM1 (computing DL)
-*> 4 => Error return from DLATM1 (computing DR)
-*> 5 => ANORM is positive, but matrix constructed prior to
-*> attempting to scale it to have norm ANORM, is zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
- $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
- $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
- $ PACK, A, LDA, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
- INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
- DOUBLE PRECISION ANORM, COND, CONDL, CONDR, DMAX, SPARSE
-* ..
-* .. Array Arguments ..
- INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), D( * ), DL( * ), DR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BADPVT, DZERO, FULBND
- INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
- $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
- $ MNSUB, MXSUB, NPVTS
- DOUBLE PRECISION ALPHA, ONORM, TEMP
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION TEMPA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLANGB, DLANGE, DLANSB, DLANSP, DLANSY, DLATM2,
- $ DLATM3
- EXTERNAL LSAME, DLANGB, DLANGE, DLANSB, DLANSP, DLANSY,
- $ DLATM2, DLATM3
-* ..
-* .. External Subroutines ..
- EXTERNAL DLATM1, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, MOD
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Decode SYM
-*
- IF( LSAME( SYM, 'S' ) ) THEN
- ISYM = 0
- ELSE IF( LSAME( SYM, 'N' ) ) THEN
- ISYM = 1
- ELSE IF( LSAME( SYM, 'H' ) ) THEN
- ISYM = 0
- ELSE
- ISYM = -1
- END IF
-*
-* Decode RSIGN
-*
- IF( LSAME( RSIGN, 'F' ) ) THEN
- IRSIGN = 0
- ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
- IRSIGN = 1
- ELSE
- IRSIGN = -1
- END IF
-*
-* Decode PIVTNG
-*
- IF( LSAME( PIVTNG, 'N' ) ) THEN
- IPVTNG = 0
- ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
- IPVTNG = 0
- ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
- IPVTNG = 1
- NPVTS = M
- ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
- IPVTNG = 2
- NPVTS = N
- ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
- IPVTNG = 3
- NPVTS = MIN( N, M )
- ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
- IPVTNG = 3
- NPVTS = MIN( N, M )
- ELSE
- IPVTNG = -1
- END IF
-*
-* Decode GRADE
-*
- IF( LSAME( GRADE, 'N' ) ) THEN
- IGRADE = 0
- ELSE IF( LSAME( GRADE, 'L' ) ) THEN
- IGRADE = 1
- ELSE IF( LSAME( GRADE, 'R' ) ) THEN
- IGRADE = 2
- ELSE IF( LSAME( GRADE, 'B' ) ) THEN
- IGRADE = 3
- ELSE IF( LSAME( GRADE, 'E' ) ) THEN
- IGRADE = 4
- ELSE IF( LSAME( GRADE, 'H' ) .OR. LSAME( GRADE, 'S' ) ) THEN
- IGRADE = 5
- ELSE
- IGRADE = -1
- END IF
-*
-* Decode PACK
-*
- IF( LSAME( PACK, 'N' ) ) THEN
- IPACK = 0
- ELSE IF( LSAME( PACK, 'U' ) ) THEN
- IPACK = 1
- ELSE IF( LSAME( PACK, 'L' ) ) THEN
- IPACK = 2
- ELSE IF( LSAME( PACK, 'C' ) ) THEN
- IPACK = 3
- ELSE IF( LSAME( PACK, 'R' ) ) THEN
- IPACK = 4
- ELSE IF( LSAME( PACK, 'B' ) ) THEN
- IPACK = 5
- ELSE IF( LSAME( PACK, 'Q' ) ) THEN
- IPACK = 6
- ELSE IF( LSAME( PACK, 'Z' ) ) THEN
- IPACK = 7
- ELSE
- IPACK = -1
- END IF
-*
-* Set certain internal parameters
-*
- MNMIN = MIN( M, N )
- KLL = MIN( KL, M-1 )
- KUU = MIN( KU, N-1 )
-*
-* If inv(DL) is used, check to see if DL has a zero entry.
-*
- DZERO = .FALSE.
- IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
- DO 10 I = 1, M
- IF( DL( I ).EQ.ZERO )
- $ DZERO = .TRUE.
- 10 CONTINUE
- END IF
-*
-* Check values in IPIVOT
-*
- BADPVT = .FALSE.
- IF( IPVTNG.GT.0 ) THEN
- DO 20 J = 1, NPVTS
- IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
- $ BADPVT = .TRUE.
- 20 CONTINUE
- END IF
-*
-* Set INFO if an error
-*
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.NE.N .AND. ISYM.EQ.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -3
- ELSE IF( ISYM.EQ.-1 ) THEN
- INFO = -5
- ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
- INFO = -7
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ COND.LT.ONE ) THEN
- INFO = -8
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ IRSIGN.EQ.-1 ) THEN
- INFO = -10
- ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
- $ ( ( IGRADE.GE.1 .AND. IGRADE.LE.4 ) .AND. ISYM.EQ.0 ) )
- $ THEN
- INFO = -11
- ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
- INFO = -12
- ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
- $ IGRADE.EQ.5 ) .AND. ( MODEL.LT.-6 .OR. MODEL.GT.6 ) )
- $ THEN
- INFO = -13
- ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
- $ IGRADE.EQ.5 ) .AND. ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND.
- $ MODEL.NE.6 ) .AND. CONDL.LT.ONE ) THEN
- INFO = -14
- ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
- $ ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
- INFO = -16
- ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
- $ ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
- $ CONDR.LT.ONE ) THEN
- INFO = -17
- ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
- $ ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ISYM.EQ.0 ) )
- $ THEN
- INFO = -18
- ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
- INFO = -19
- ELSE IF( KL.LT.0 ) THEN
- INFO = -20
- ELSE IF( KU.LT.0 .OR. ( ISYM.EQ.0 .AND. KL.NE.KU ) ) THEN
- INFO = -21
- ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
- INFO = -22
- ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
- $ IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
- $ ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
- $ N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
- $ 0 .OR. M.NE.N ) ) ) THEN
- INFO = -24
- ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
- $ LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
- $ 4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
- $ 6 ) .AND. LDA.LT.KUU+1 ) .OR.
- $ ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
- INFO = -26
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATMR', -INFO )
- RETURN
- END IF
-*
-* Decide if we can pivot consistently
-*
- FULBND = .FALSE.
- IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
- $ FULBND = .TRUE.
-*
-* Initialize random number generator
-*
- DO 30 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 30 CONTINUE
-*
- ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
-*
-* 2) Set up D, DL, and DR, if indicated.
-*
-* Compute D according to COND and MODE
-*
- CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
- IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 40 I = 2, MNMIN
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 40 CONTINUE
- IF( TEMP.EQ.ZERO .AND. DMAX.NE.ZERO ) THEN
- INFO = 2
- RETURN
- END IF
- IF( TEMP.NE.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE
- ALPHA = ONE
- END IF
- DO 50 I = 1, MNMIN
- D( I ) = ALPHA*D( I )
- 50 CONTINUE
-*
- END IF
-*
-* Compute DL if grading set
-*
- IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
- $ 5 ) THEN
- CALL DLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- END IF
-*
-* Compute DR if grading set
-*
- IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
- CALL DLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = 4
- RETURN
- END IF
- END IF
-*
-* 3) Generate IWORK if pivoting
-*
- IF( IPVTNG.GT.0 ) THEN
- DO 60 I = 1, NPVTS
- IWORK( I ) = I
- 60 CONTINUE
- IF( FULBND ) THEN
- DO 70 I = 1, NPVTS
- K = IPIVOT( I )
- J = IWORK( I )
- IWORK( I ) = IWORK( K )
- IWORK( K ) = J
- 70 CONTINUE
- ELSE
- DO 80 I = NPVTS, 1, -1
- K = IPIVOT( I )
- J = IWORK( I )
- IWORK( I ) = IWORK( K )
- IWORK( K ) = J
- 80 CONTINUE
- END IF
- END IF
-*
-* 4) Generate matrices for each kind of PACKing
-* Always sweep matrix columnwise (if symmetric, upper
-* half only) so that matrix generated does not depend
-* on PACK
-*
- IF( FULBND ) THEN
-*
-* Use DLATM3 so matrices generated with differing PIVOTing only
-* differ only in the order of their rows and/or columns.
-*
- IF( IPACK.EQ.0 ) THEN
- IF( ISYM.EQ.0 ) THEN
- DO 100 J = 1, N
- DO 90 I = 1, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( ISUB, JSUB ) = TEMP
- A( JSUB, ISUB ) = TEMP
- 90 CONTINUE
- 100 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 120 J = 1, N
- DO 110 I = 1, M
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( ISUB, JSUB ) = TEMP
- 110 CONTINUE
- 120 CONTINUE
- END IF
-*
- ELSE IF( IPACK.EQ.1 ) THEN
-*
- DO 140 J = 1, N
- DO 130 I = 1, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MNSUB, MXSUB ) = TEMP
- IF( MNSUB.NE.MXSUB )
- $ A( MXSUB, MNSUB ) = ZERO
- 130 CONTINUE
- 140 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
- DO 160 J = 1, N
- DO 150 I = 1, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MXSUB, MNSUB ) = TEMP
- IF( MNSUB.NE.MXSUB )
- $ A( MNSUB, MXSUB ) = ZERO
- 150 CONTINUE
- 160 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
- DO 180 J = 1, N
- DO 170 I = 1, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
-*
-* Compute K = location of (ISUB,JSUB) entry in packed
-* array
-*
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
-*
-* Convert K to (IISUB,JJSUB) location
-*
- JJSUB = ( K-1 ) / LDA + 1
- IISUB = K - LDA*( JJSUB-1 )
-*
- A( IISUB, JJSUB ) = TEMP
- 170 CONTINUE
- 180 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
- DO 200 J = 1, N
- DO 190 I = 1, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
-*
-* Compute K = location of (I,J) entry in packed array
-*
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- IF( MNSUB.EQ.1 ) THEN
- K = MXSUB
- ELSE
- K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
- $ 2 + MXSUB - MNSUB + 1
- END IF
-*
-* Convert K to (IISUB,JJSUB) location
-*
- JJSUB = ( K-1 ) / LDA + 1
- IISUB = K - LDA*( JJSUB-1 )
-*
- A( IISUB, JJSUB ) = TEMP
- 190 CONTINUE
- 200 CONTINUE
-*
- ELSE IF( IPACK.EQ.5 ) THEN
-*
- DO 220 J = 1, N
- DO 210 I = J - KUU, J
- IF( I.LT.1 ) THEN
- A( J-I+1, I+N ) = ZERO
- ELSE
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MXSUB-MNSUB+1, MNSUB ) = TEMP
- END IF
- 210 CONTINUE
- 220 CONTINUE
-*
- ELSE IF( IPACK.EQ.6 ) THEN
-*
- DO 240 J = 1, N
- DO 230 I = J - KUU, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
- 230 CONTINUE
- 240 CONTINUE
-*
- ELSE IF( IPACK.EQ.7 ) THEN
-*
- IF( ISYM.EQ.0 ) THEN
- DO 260 J = 1, N
- DO 250 I = J - KUU, J
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
- IF( I.LT.1 )
- $ A( J-I+1+KUU, I+N ) = ZERO
- IF( I.GE.1 .AND. MNSUB.NE.MXSUB )
- $ A( MXSUB-MNSUB+1+KUU, MNSUB ) = TEMP
- 250 CONTINUE
- 260 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 280 J = 1, N
- DO 270 I = J - KUU, J + KLL
- TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( ISUB-JSUB+KUU+1, JSUB ) = TEMP
- 270 CONTINUE
- 280 CONTINUE
- END IF
-*
- END IF
-*
- ELSE
-*
-* Use DLATM2
-*
- IF( IPACK.EQ.0 ) THEN
- IF( ISYM.EQ.0 ) THEN
- DO 300 J = 1, N
- DO 290 I = 1, J
- A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( J, I ) = A( I, J )
- 290 CONTINUE
- 300 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 320 J = 1, N
- DO 310 I = 1, M
- A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- 310 CONTINUE
- 320 CONTINUE
- END IF
-*
- ELSE IF( IPACK.EQ.1 ) THEN
-*
- DO 340 J = 1, N
- DO 330 I = 1, J
- A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
- $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
- IF( I.NE.J )
- $ A( J, I ) = ZERO
- 330 CONTINUE
- 340 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
- DO 360 J = 1, N
- DO 350 I = 1, J
- A( J, I ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
- $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
- IF( I.NE.J )
- $ A( I, J ) = ZERO
- 350 CONTINUE
- 360 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
- ISUB = 0
- JSUB = 1
- DO 380 J = 1, N
- DO 370 I = 1, J
- ISUB = ISUB + 1
- IF( ISUB.GT.LDA ) THEN
- ISUB = 1
- JSUB = JSUB + 1
- END IF
- A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- 370 CONTINUE
- 380 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
- IF( ISYM.EQ.0 ) THEN
- DO 400 J = 1, N
- DO 390 I = 1, J
-*
-* Compute K = location of (I,J) entry in packed array
-*
- IF( I.EQ.1 ) THEN
- K = J
- ELSE
- K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
- $ J - I + 1
- END IF
-*
-* Convert K to (ISUB,JSUB) location
-*
- JSUB = ( K-1 ) / LDA + 1
- ISUB = K - LDA*( JSUB-1 )
-*
- A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR,
- $ IPVTNG, IWORK, SPARSE )
- 390 CONTINUE
- 400 CONTINUE
- ELSE
- ISUB = 0
- JSUB = 1
- DO 420 J = 1, N
- DO 410 I = J, M
- ISUB = ISUB + 1
- IF( ISUB.GT.LDA ) THEN
- ISUB = 1
- JSUB = JSUB + 1
- END IF
- A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR,
- $ IPVTNG, IWORK, SPARSE )
- 410 CONTINUE
- 420 CONTINUE
- END IF
-*
- ELSE IF( IPACK.EQ.5 ) THEN
-*
- DO 440 J = 1, N
- DO 430 I = J - KUU, J
- IF( I.LT.1 ) THEN
- A( J-I+1, I+N ) = ZERO
- ELSE
- A( J-I+1, I ) = DLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- END IF
- 430 CONTINUE
- 440 CONTINUE
-*
- ELSE IF( IPACK.EQ.6 ) THEN
-*
- DO 460 J = 1, N
- DO 450 I = J - KUU, J
- A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- 450 CONTINUE
- 460 CONTINUE
-*
- ELSE IF( IPACK.EQ.7 ) THEN
-*
- IF( ISYM.EQ.0 ) THEN
- DO 480 J = 1, N
- DO 470 I = J - KUU, J
- A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL,
- $ DR, IPVTNG, IWORK, SPARSE )
- IF( I.LT.1 )
- $ A( J-I+1+KUU, I+N ) = ZERO
- IF( I.GE.1 .AND. I.NE.J )
- $ A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
- 470 CONTINUE
- 480 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 500 J = 1, N
- DO 490 I = J - KUU, J + KLL
- A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL,
- $ DR, IPVTNG, IWORK, SPARSE )
- 490 CONTINUE
- 500 CONTINUE
- END IF
-*
- END IF
-*
- END IF
-*
-* 5) Scaling the norm
-*
- IF( IPACK.EQ.0 ) THEN
- ONORM = DLANGE( 'M', M, N, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.1 ) THEN
- ONORM = DLANSY( 'M', 'U', N, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.2 ) THEN
- ONORM = DLANSY( 'M', 'L', N, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.3 ) THEN
- ONORM = DLANSP( 'M', 'U', N, A, TEMPA )
- ELSE IF( IPACK.EQ.4 ) THEN
- ONORM = DLANSP( 'M', 'L', N, A, TEMPA )
- ELSE IF( IPACK.EQ.5 ) THEN
- ONORM = DLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.6 ) THEN
- ONORM = DLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.7 ) THEN
- ONORM = DLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
- END IF
-*
- IF( ANORM.GE.ZERO ) THEN
-*
- IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
-*
-* Desired scaling impossible
-*
- INFO = 5
- RETURN
-*
- ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
- $ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
-*
-* Scale carefully to avoid over / underflow
-*
- IF( IPACK.LE.2 ) THEN
- DO 510 J = 1, N
- CALL DSCAL( M, ONE / ONORM, A( 1, J ), 1 )
- CALL DSCAL( M, ANORM, A( 1, J ), 1 )
- 510 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
-*
- CALL DSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
- CALL DSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
- DO 520 J = 1, N
- CALL DSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
- CALL DSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
- 520 CONTINUE
-*
- END IF
-*
- ELSE
-*
-* Scale straightforwardly
-*
- IF( IPACK.LE.2 ) THEN
- DO 530 J = 1, N
- CALL DSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
- 530 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
-*
- CALL DSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
- DO 540 J = 1, N
- CALL DSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
- 540 CONTINUE
- END IF
-*
- END IF
-*
- END IF
-*
-* End of DLATMR
-*
- END
diff --git a/netlib/LAPACK/dlatms.f b/netlib/LAPACK/dlatms.f
deleted file mode 100644
index 38d2b96..0000000
--- a/netlib/LAPACK/dlatms.f
+++ /dev/null
@@ -1,1128 +0,0 @@
-*> \brief \b DLATMS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
-* KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIST, PACK, SYM
-* INTEGER INFO, KL, KU, LDA, M, MODE, N
-* DOUBLE PRECISION COND, DMAX
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATMS generates random matrices with specified singular values
-*> (or symmetric/hermitian with specified eigenvalues)
-*> for testing LAPACK programs.
-*>
-*> DLATMS operates by applying the following sequence of
-*> operations:
-*>
-*> Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX, and SYM
-*> as described below.
-*>
-*> Generate a matrix with the appropriate band structure, by one
-*> of two methods:
-*>
-*> Method A:
-*> Generate a dense M x N matrix by multiplying D on the left
-*> and the right by random unitary matrices, then:
-*>
-*> Reduce the bandwidth according to KL and KU, using
-*> Householder transformations.
-*>
-*> Method B:
-*> Convert the bandwidth-0 (i.e., diagonal) matrix to a
-*> bandwidth-1 matrix using Givens rotations, "chasing"
-*> out-of-band elements back, much as in QR; then
-*> convert the bandwidth-1 to a bandwidth-2 matrix, etc.
-*> Note that for reasonably small bandwidths (relative to
-*> M and N) this requires less storage, as a dense matrix
-*> is not generated. Also, for symmetric matrices, only
-*> one triangle is generated.
-*>
-*> Method A is chosen if the bandwidth is a large fraction of the
-*> order of the matrix, and LDA is at least M (so a dense
-*> matrix can be stored.) Method B is chosen if the bandwidth
-*> is small (< 1/2 N for symmetric, < .3 N+M for
-*> non-symmetric), or LDA is less than M and not less than the
-*> bandwidth.
-*>
-*> Pack the matrix if desired. Options specified by PACK are:
-*> no packing
-*> zero out upper half (if symmetric)
-*> zero out lower half (if symmetric)
-*> store the upper half columnwise (if symmetric or upper
-*> triangular)
-*> store the lower half columnwise (if symmetric or lower
-*> triangular)
-*> store the lower triangle in banded format (if symmetric
-*> or lower triangular)
-*> store the upper triangle in banded format (if symmetric
-*> or upper triangular)
-*> store the entire matrix in banded format
-*> If Method B is chosen, and band format is specified, then the
-*> matrix will be generated in the band format, so no repacking
-*> will be necessary.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate the random eigen-/singular values.
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to DLATMS
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] SYM
-*> \verbatim
-*> SYM is CHARACTER*1
-*> If SYM='S' or 'H', the generated matrix is symmetric, with
-*> eigenvalues specified by D, COND, MODE, and DMAX; they
-*> may be positive, negative, or zero.
-*> If SYM='P', the generated matrix is symmetric, with
-*> eigenvalues (= singular values) specified by D, COND,
-*> MODE, and DMAX; they will not be negative.
-*> If SYM='N', the generated matrix is nonsymmetric, with
-*> singular values specified by D, COND, MODE, and DMAX;
-*> they will not be negative.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( MIN( M , N ) )
-*> This array is used to specify the singular values or
-*> eigenvalues of A (see SYM, above.) If MODE=0, then D is
-*> assumed to contain the singular/eigenvalues, otherwise
-*> they will be computed according to MODE, COND, and DMAX,
-*> and placed in D.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry this describes how the singular/eigenvalues are to
-*> be specified:
-*> MODE = 0 means use D as input
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then
-*> the elements of D will also be multiplied by a random
-*> sign (i.e., +1 or -1.)
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is DOUBLE PRECISION
-*> On entry, this is used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is DOUBLE PRECISION
-*> If MODE is neither -6, 0 nor 6, the contents of D, as
-*> computed according to MODE and COND, will be scaled by
-*> DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
-*> singular value (which is to say the norm) will be abs(DMAX).
-*> Note that DMAX need not be positive: if DMAX is negative
-*> (or zero), D will be scaled by a negative number (or zero).
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> This specifies the lower bandwidth of the matrix. For
-*> example, KL=0 implies upper triangular, KL=1 implies upper
-*> Hessenberg, and KL being at least M-1 means that the matrix
-*> has full lower bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> This specifies the upper bandwidth of the matrix. For
-*> example, KU=0 implies lower triangular, KU=1 implies lower
-*> Hessenberg, and KU being at least N-1 means that the matrix
-*> has full upper bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] PACK
-*> \verbatim
-*> PACK is CHARACTER*1
-*> This specifies packing of matrix as follows:
-*> 'N' => no packing
-*> 'U' => zero out all subdiagonal entries (if symmetric)
-*> 'L' => zero out all superdiagonal entries (if symmetric)
-*> 'C' => store the upper triangle columnwise
-*> (only if the matrix is symmetric or upper triangular)
-*> 'R' => store the lower triangle columnwise
-*> (only if the matrix is symmetric or lower triangular)
-*> 'B' => store the lower triangle in band storage scheme
-*> (only if matrix symmetric or lower triangular)
-*> 'Q' => store the upper triangle in band storage scheme
-*> (only if matrix symmetric or upper triangular)
-*> 'Z' => store the entire matrix in band storage scheme
-*> (pivoting can be provided for by using this
-*> option to store A in the trailing rows of
-*> the allocated storage)
-*>
-*> Using these options, the various LAPACK packed and banded
-*> storage schemes can be obtained:
-*> GB - use 'Z'
-*> PB, SB or TB - use 'B' or 'Q'
-*> PP, SP or TP - use 'C' or 'R'
-*>
-*> If two calls to DLATMS differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( LDA, N )
-*> On exit A is the desired test matrix. A is first generated
-*> in full (unpacked) form, and then packed, if so specified
-*> by PACK. Thus, the first M elements of the first N
-*> columns will always be modified. If PACK specifies a
-*> packed or banded storage scheme, all LDA elements of the
-*> first N columns will be modified; the elements of the
-*> array which do not correspond to elements of the generated
-*> matrix are set to zero.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> LDA specifies the first dimension of A as declared in the
-*> calling program. If PACK='N', 'U', 'L', 'C', or 'R', then
-*> LDA must be at least M. If PACK='B' or 'Q', then LDA must
-*> be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).
-*> If PACK='Z', LDA must be large enough to hold the packed
-*> array: MIN( KU, N-1) + MIN( KL, M-1) + 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( 3*MAX( N , M ) )
-*> Workspace.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error code. On exit, INFO will be set to one of the
-*> following values:
-*> 0 => normal return
-*> -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
-*> -2 => N negative
-*> -3 => DIST illegal string
-*> -5 => SYM illegal string
-*> -7 => MODE not in range -6 to 6
-*> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -10 => KL negative
-*> -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL
-*> -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N';
-*> or PACK='C' or 'Q' and SYM='N' and KL is not zero;
-*> or PACK='R' or 'B' and SYM='N' and KU is not zero;
-*> or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not
-*> N.
-*> -14 => LDA is less than M, or PACK='Z' and LDA is less than
-*> MIN(KU,N-1) + MIN(KL,M-1) + 1.
-*> 1 => Error return from DLATM1
-*> 2 => Cannot scale to DMAX (max. sing. value is 0)
-*> 3 => Error return from DLAGGE or SLAGSY
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
- $ KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIST, PACK, SYM
- INTEGER INFO, KL, KU, LDA, M, MODE, N
- DOUBLE PRECISION COND, DMAX
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN
- INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA,
- $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2,
- $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH,
- $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC,
- $ UUB
- DOUBLE PRECISION ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLARND
- EXTERNAL LSAME, DLARND
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAGGE, DLAGSY, DLAROT, DLARTG, DLASET,
- $ DLATM1, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, DBLE, MAX, MIN, MOD, SIN
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Decode SYM
-*
- IF( LSAME( SYM, 'N' ) ) THEN
- ISYM = 1
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'P' ) ) THEN
- ISYM = 2
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'S' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE IF( LSAME( SYM, 'H' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE
- ISYM = -1
- END IF
-*
-* Decode PACK
-*
- ISYMPK = 0
- IF( LSAME( PACK, 'N' ) ) THEN
- IPACK = 0
- ELSE IF( LSAME( PACK, 'U' ) ) THEN
- IPACK = 1
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'L' ) ) THEN
- IPACK = 2
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'C' ) ) THEN
- IPACK = 3
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'R' ) ) THEN
- IPACK = 4
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'B' ) ) THEN
- IPACK = 5
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'Q' ) ) THEN
- IPACK = 6
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'Z' ) ) THEN
- IPACK = 7
- ELSE
- IPACK = -1
- END IF
-*
-* Set certain internal parameters
-*
- MNMIN = MIN( M, N )
- LLB = MIN( KL, M-1 )
- UUB = MIN( KU, N-1 )
- MR = MIN( M, N+LLB )
- NC = MIN( N, M+UUB )
-*
- IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN
- MINLDA = UUB + 1
- ELSE IF( IPACK.EQ.7 ) THEN
- MINLDA = LLB + UUB + 1
- ELSE
- MINLDA = M
- END IF
-*
-* Use Givens rotation method if bandwidth small enough,
-* or if LDA is too small to store the matrix unpacked.
-*
- GIVENS = .FALSE.
- IF( ISYM.EQ.1 ) THEN
- IF( DBLE( LLB+UUB ).LT.0.3D0*DBLE( MAX( 1, MR+NC ) ) )
- $ GIVENS = .TRUE.
- ELSE
- IF( 2*LLB.LT.M )
- $ GIVENS = .TRUE.
- END IF
- IF( LDA.LT.M .AND. LDA.GE.MINLDA )
- $ GIVENS = .TRUE.
-*
-* Set INFO if an error
-*
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -3
- ELSE IF( ISYM.EQ.-1 ) THEN
- INFO = -5
- ELSE IF( ABS( MODE ).GT.6 ) THEN
- INFO = -7
- ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
- $ THEN
- INFO = -8
- ELSE IF( KL.LT.0 ) THEN
- INFO = -10
- ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN
- INFO = -11
- ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR.
- $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR.
- $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR.
- $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN
- INFO = -12
- ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN
- INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATMS', -INFO )
- RETURN
- END IF
-*
-* Initialize random number generator
-*
- DO 10 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 10 CONTINUE
-*
- IF( MOD( ISEED( 4 ), 2 ).NE.1 )
- $ ISEED( 4 ) = ISEED( 4 ) + 1
-*
-* 2) Set up D if indicated.
-*
-* Compute D according to COND and MODE
-*
- CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Choose Top-Down if D is (apparently) increasing,
-* Bottom-Up if D is (apparently) decreasing.
-*
- IF( ABS( D( 1 ) ).LE.ABS( D( MNMIN ) ) ) THEN
- TOPDWN = .TRUE.
- ELSE
- TOPDWN = .FALSE.
- END IF
-*
- IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 20 I = 2, MNMIN
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 20 CONTINUE
-*
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE
- INFO = 2
- RETURN
- END IF
-*
- CALL DSCAL( MNMIN, ALPHA, D, 1 )
-*
- END IF
-*
-* 3) Generate Banded Matrix using Givens rotations.
-* Also the special case of UUB=LLB=0
-*
-* Compute Addressing constants to cover all
-* storage formats. Whether GE, SY, GB, or SB,
-* upper or lower triangle or both,
-* the (i,j)-th element is in
-* A( i - ISKEW*j + IOFFST, j )
-*
- IF( IPACK.GT.4 ) THEN
- ILDA = LDA - 1
- ISKEW = 1
- IF( IPACK.GT.5 ) THEN
- IOFFST = UUB + 1
- ELSE
- IOFFST = 1
- END IF
- ELSE
- ILDA = LDA
- ISKEW = 0
- IOFFST = 0
- END IF
-*
-* IPACKG is the format that the matrix is generated in. If this is
-* different from IPACK, then the matrix must be repacked at the
-* end. It also signals how to compute the norm, for scaling.
-*
- IPACKG = 0
- CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
-*
-* Diagonal Matrix -- We are done, unless it
-* is to be stored SP/PP/TP (PACK='R' or 'C')
-*
- IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
- IF( IPACK.LE.2 .OR. IPACK.GE.5 )
- $ IPACKG = IPACK
-*
- ELSE IF( GIVENS ) THEN
-*
-* Check whether to use Givens rotations,
-* Householder transformations, or nothing.
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- IF( IPACK.GT.4 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
-*
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
-*
- IF( TOPDWN ) THEN
- JKL = 0
- DO 50 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* Last row actually rotated is M
-* Last column actually rotated is MIN( M+JKU, N )
-*
- DO 40 JR = 1, MIN( M+JKU, N ) + JKL - 1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL )
- IF( JR.LT.M ) THEN
- IL = MIN( N, JR+JKU ) + 1 - ICOL
- CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C,
- $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IR = JR
- IC = ICOL
- DO 30 JCH = JR - JKL, 1, -JKL - JKU
- IF( IR.LT.M ) THEN
- CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- IROW = MAX( 1, JCH-JKU )
- IL = IR + 2 - IROW
- TEMP = ZERO
- ILTEMP = JCH.GT.JKU
- CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IROW-ISKEW*IC+IOFFST, IC ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), TEMP, C, S, DUMMY )
- ICOL = MAX( 1, JCH-JKU-JKL )
- IL = IC + 2 - ICOL
- EXTRA = ZERO
- CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
-*
- JKU = UUB
- DO 80 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
- DO 70 JC = 1, MIN( N+JKL, M ) + JKU - 1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU )
- IF( JC.LT.N ) THEN
- IL = MIN( M, JC+JKL ) + 1 - IROW
- CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C,
- $ S, A( IROW-ISKEW*JC+IOFFST, JC ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IC = JC
- IR = IROW
- DO 60 JCH = JC - JKU, 1, -JKL - JKU
- IF( IC.LT.N ) THEN
- CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- ICOL = MAX( 1, JCH-JKL )
- IL = IC + 2 - ICOL
- TEMP = ZERO
- ILTEMP = JCH.GT.JKL
- CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST,
- $ ICOL+1 ), TEMP, C, S, DUMMY )
- IROW = MAX( 1, JCH-JKL-JKU )
- IL = IR + 2 - IROW
- EXTRA = ZERO
- CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
-*
- ELSE
-*
-* Bottom-Up -- Start at the bottom right.
-*
- JKL = 0
- DO 110 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* First row actually rotated is M
-* First column actually rotated is MIN( M+JKU, N )
-*
- IENDCH = MIN( M, N+JKL ) - 1
- DO 100 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU+1 )
- IF( JC.GT.0 ) THEN
- IL = MIN( M, JC+JKL+1 ) + 1 - IROW
- CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL,
- $ C, S, A( IROW-ISKEW*JC+IOFFST,
- $ JC ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IC = JC
- DO 90 JCH = JC + JKL, IENDCH, JKL + JKU
- ILEXTR = IC.GT.0
- IF( ILEXTR ) THEN
- CALL DLARTG( A( JCH-ISKEW*IC+IOFFST, IC ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IC = MAX( 1, IC )
- ICOL = MIN( N-1, JCH+JKU )
- ILTEMP = JCH + JKU.LT.N
- TEMP = ZERO
- CALL DLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC,
- $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ),
- $ ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL DLAROT( .FALSE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, TEMP, EXTRA )
- IC = ICOL
- END IF
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
-*
- JKU = UUB
- DO 140 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
-* First row actually rotated is MIN( N+JKL, M )
-* First column actually rotated is N
-*
- IENDCH = MIN( N, M+JKU ) - 1
- DO 130 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL+1 )
- IF( JR.GT.0 ) THEN
- IL = MIN( N, JR+JKU+1 ) + 1 - ICOL
- CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL,
- $ C, S, A( JR-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IR = JR
- DO 120 JCH = JR + JKU, IENDCH, JKL + JKU
- ILEXTR = IR.GT.0
- IF( ILEXTR ) THEN
- CALL DLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IR = MAX( 1, IR )
- IROW = MIN( M-1, JCH+JKL )
- ILTEMP = JCH + JKL.LT.M
- TEMP = ZERO
- CALL DLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR,
- $ C, S, A( IR-ISKEW*JCH+IOFFST,
- $ JCH ), ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL DLAROT( .TRUE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ ILDA, TEMP, EXTRA )
- IR = IROW
- END IF
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
- END IF
-*
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- IPACKG = IPACK
- IOFFG = IOFFST
-*
- IF( TOPDWN ) THEN
-*
-* Top-Down -- Generate Upper triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 6
- IOFFG = UUB + 1
- ELSE
- IPACKG = 1
- END IF
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 170 K = 1, UUB
- DO 160 JC = 1, N - 1
- IROW = MAX( 1, JC-K )
- IL = MIN( JC+1, K+2 )
- EXTRA = ZERO
- TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 )
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- CALL DLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S,
- $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA,
- $ EXTRA, TEMP )
- CALL DLAROT( .TRUE., .TRUE., .FALSE.,
- $ MIN( K, N-JC )+1, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, DUMMY )
-*
-* Chase EXTRA back up the matrix
-*
- ICOL = JC
- DO 150 JCH = JC - K, 1, -K
- CALL DLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG,
- $ ICOL+1 ), EXTRA, C, S, DUMMY )
- TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 )
- CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S,
- $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- IROW = MAX( 1, JCH-K )
- IL = MIN( JCH+1, K+2 )
- EXTRA = ZERO
- CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C,
- $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ),
- $ ILDA, EXTRA, TEMP )
- ICOL = JCH
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
-*
-* If we need lower triangle, copy from upper. Note that
-* the order of copying is chosen to work for 'q' -> 'b'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN
- DO 190 JC = 1, N
- IROW = IOFFST - ISKEW*JC
- DO 180 JR = JC, MIN( N, JC+UUB )
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 180 CONTINUE
- 190 CONTINUE
- IF( IPACK.EQ.5 ) THEN
- DO 210 JC = N - UUB + 1, N
- DO 200 JR = N + 2 - JC, UUB + 1
- A( JR, JC ) = ZERO
- 200 CONTINUE
- 210 CONTINUE
- END IF
- IF( IPACKG.EQ.6 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- ELSE
-*
-* Bottom-Up -- Generate Lower triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 5
- IF( IPACK.EQ.6 )
- $ IOFFG = 1
- ELSE
- IPACKG = 2
- END IF
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 240 K = 1, UUB
- DO 230 JC = N - 1, 1, -1
- IL = MIN( N+1-JC, K+2 )
- EXTRA = ZERO
- TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC )
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = -SIN( ANGLE )
- CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, EXTRA )
- ICOL = MAX( 1, JC-K+1 )
- CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C,
- $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, DUMMY, TEMP )
-*
-* Chase EXTRA back down the matrix
-*
- ICOL = JC
- DO 220 JCH = JC + K, N - 1, K
- CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ EXTRA, C, S, DUMMY )
- TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH )
- CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, EXTRA, TEMP )
- IL = MIN( N+1-JCH, K+2 )
- EXTRA = ZERO
- CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C,
- $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- ICOL = JCH
- 220 CONTINUE
- 230 CONTINUE
- 240 CONTINUE
-*
-* If we need upper triangle, copy from lower. Note that
-* the order of copying is chosen to work for 'b' -> 'q'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN
- DO 260 JC = N, 1, -1
- IROW = IOFFST - ISKEW*JC
- DO 250 JR = JC, MAX( 1, JC-UUB ), -1
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 250 CONTINUE
- 260 CONTINUE
- IF( IPACK.EQ.6 ) THEN
- DO 280 JC = 1, UUB
- DO 270 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 270 CONTINUE
- 280 CONTINUE
- END IF
- IF( IPACKG.EQ.5 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-*
-* 4) Generate Banded Matrix by first
-* Rotating by random Unitary matrices,
-* then reducing the bandwidth using Householder
-* transformations.
-*
-* Note: we should get here only if LDA .ge. N
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- CALL DLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK,
- $ IINFO )
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- CALL DLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
-*
- END IF
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- END IF
-*
-* 5) Pack the matrix
-*
- IF( IPACK.NE.IPACKG ) THEN
- IF( IPACK.EQ.1 ) THEN
-*
-* 'U' -- Upper triangular, not packed
-*
- DO 300 J = 1, M
- DO 290 I = J + 1, M
- A( I, J ) = ZERO
- 290 CONTINUE
- 300 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
-* 'L' -- Lower triangular, not packed
-*
- DO 320 J = 2, M
- DO 310 I = 1, J - 1
- A( I, J ) = ZERO
- 310 CONTINUE
- 320 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
-* 'C' -- Upper triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 340 J = 1, M
- DO 330 I = 1, J
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 330 CONTINUE
- 340 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
-* 'R' -- Lower triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 360 J = 1, M
- DO 350 I = J, M
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 350 CONTINUE
- 360 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* 'B' -- The lower triangle is packed as a band matrix.
-* 'Q' -- The upper triangle is packed as a band matrix.
-* 'Z' -- The whole matrix is packed as a band matrix.
-*
- IF( IPACK.EQ.5 )
- $ UUB = 0
- IF( IPACK.EQ.6 )
- $ LLB = 0
-*
- DO 380 J = 1, UUB
- DO 370 I = MIN( J+LLB, M ), 1, -1
- A( I-J+UUB+1, J ) = A( I, J )
- 370 CONTINUE
- 380 CONTINUE
-*
- DO 400 J = UUB + 2, N
- DO 390 I = J - UUB, MIN( J+LLB, M )
- A( I-J+UUB+1, J ) = A( I, J )
- 390 CONTINUE
- 400 CONTINUE
- END IF
-*
-* If packed, zero out extraneous elements.
-*
-* Symmetric/Triangular Packed --
-* zero out everything after A(IROW,ICOL)
-*
- IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
- DO 420 JC = ICOL, M
- DO 410 JR = IROW + 1, LDA
- A( JR, JC ) = ZERO
- 410 CONTINUE
- IROW = 0
- 420 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* Packed Band --
-* 1st row is now in A( UUB+2-j, j), zero above it
-* m-th row is now in A( M+UUB-j,j), zero below it
-* last non-zero diagonal is now in A( UUB+LLB+1,j ),
-* zero below it, too.
-*
- IR1 = UUB + LLB + 2
- IR2 = UUB + M + 2
- DO 450 JC = 1, N
- DO 430 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 430 CONTINUE
- DO 440 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA
- A( JR, JC ) = ZERO
- 440 CONTINUE
- 450 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DLATMS
-*
- END
diff --git a/netlib/LAPACK/dlatmt.f b/netlib/LAPACK/dlatmt.f
deleted file mode 100644
index a2080a8..0000000
--- a/netlib/LAPACK/dlatmt.f
+++ /dev/null
@@ -1,1139 +0,0 @@
-*> \brief \b DLATMT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
-* RANK, KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION COND, DMAX
-* INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK
-* CHARACTER DIST, PACK, SYM
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATMT generates random matrices with specified singular values
-*> (or symmetric/hermitian with specified eigenvalues)
-*> for testing LAPACK programs.
-*>
-*> DLATMT operates by applying the following sequence of
-*> operations:
-*>
-*> Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX, and SYM
-*> as described below.
-*>
-*> Generate a matrix with the appropriate band structure, by one
-*> of two methods:
-*>
-*> Method A:
-*> Generate a dense M x N matrix by multiplying D on the left
-*> and the right by random unitary matrices, then:
-*>
-*> Reduce the bandwidth according to KL and KU, using
-*> Householder transformations.
-*>
-*> Method B:
-*> Convert the bandwidth-0 (i.e., diagonal) matrix to a
-*> bandwidth-1 matrix using Givens rotations, "chasing"
-*> out-of-band elements back, much as in QR; then
-*> convert the bandwidth-1 to a bandwidth-2 matrix, etc.
-*> Note that for reasonably small bandwidths (relative to
-*> M and N) this requires less storage, as a dense matrix
-*> is not generated. Also, for symmetric matrices, only
-*> one triangle is generated.
-*>
-*> Method A is chosen if the bandwidth is a large fraction of the
-*> order of the matrix, and LDA is at least M (so a dense
-*> matrix can be stored.) Method B is chosen if the bandwidth
-*> is small (< 1/2 N for symmetric, < .3 N+M for
-*> non-symmetric), or LDA is less than M and not less than the
-*> bandwidth.
-*>
-*> Pack the matrix if desired. Options specified by PACK are:
-*> no packing
-*> zero out upper half (if symmetric)
-*> zero out lower half (if symmetric)
-*> store the upper half columnwise (if symmetric or upper
-*> triangular)
-*> store the lower half columnwise (if symmetric or lower
-*> triangular)
-*> store the lower triangle in banded format (if symmetric
-*> or lower triangular)
-*> store the upper triangle in banded format (if symmetric
-*> or upper triangular)
-*> store the entire matrix in banded format
-*> If Method B is chosen, and band format is specified, then the
-*> matrix will be generated in the band format, so no repacking
-*> will be necessary.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate the random eigen-/singular values.
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to DLATMT
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] SYM
-*> \verbatim
-*> SYM is CHARACTER*1
-*> If SYM='S' or 'H', the generated matrix is symmetric, with
-*> eigenvalues specified by D, COND, MODE, and DMAX; they
-*> may be positive, negative, or zero.
-*> If SYM='P', the generated matrix is symmetric, with
-*> eigenvalues (= singular values) specified by D, COND,
-*> MODE, and DMAX; they will not be negative.
-*> If SYM='N', the generated matrix is nonsymmetric, with
-*> singular values specified by D, COND, MODE, and DMAX;
-*> they will not be negative.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension ( MIN( M , N ) )
-*> This array is used to specify the singular values or
-*> eigenvalues of A (see SYM, above.) If MODE=0, then D is
-*> assumed to contain the singular/eigenvalues, otherwise
-*> they will be computed according to MODE, COND, and DMAX,
-*> and placed in D.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry this describes how the singular/eigenvalues are to
-*> be specified:
-*> MODE = 0 means use D as input
-*>
-*> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
-*> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1))
-*>
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then
-*> the elements of D will also be multiplied by a random
-*> sign (i.e., +1 or -1.)
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is DOUBLE PRECISION
-*> On entry, this is used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is DOUBLE PRECISION
-*> If MODE is neither -6, 0 nor 6, the contents of D, as
-*> computed according to MODE and COND, will be scaled by
-*> DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
-*> singular value (which is to say the norm) will be abs(DMAX).
-*> Note that DMAX need not be positive: if DMAX is negative
-*> (or zero), D will be scaled by a negative number (or zero).
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The rank of matrix to be generated for modes 1,2,3 only.
-*> D( RANK+1:N ) = 0.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> This specifies the lower bandwidth of the matrix. For
-*> example, KL=0 implies upper triangular, KL=1 implies upper
-*> Hessenberg, and KL being at least M-1 means that the matrix
-*> has full lower bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> This specifies the upper bandwidth of the matrix. For
-*> example, KU=0 implies lower triangular, KU=1 implies lower
-*> Hessenberg, and KU being at least N-1 means that the matrix
-*> has full upper bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] PACK
-*> \verbatim
-*> PACK is CHARACTER*1
-*> This specifies packing of matrix as follows:
-*> 'N' => no packing
-*> 'U' => zero out all subdiagonal entries (if symmetric)
-*> 'L' => zero out all superdiagonal entries (if symmetric)
-*> 'C' => store the upper triangle columnwise
-*> (only if the matrix is symmetric or upper triangular)
-*> 'R' => store the lower triangle columnwise
-*> (only if the matrix is symmetric or lower triangular)
-*> 'B' => store the lower triangle in band storage scheme
-*> (only if matrix symmetric or lower triangular)
-*> 'Q' => store the upper triangle in band storage scheme
-*> (only if matrix symmetric or upper triangular)
-*> 'Z' => store the entire matrix in band storage scheme
-*> (pivoting can be provided for by using this
-*> option to store A in the trailing rows of
-*> the allocated storage)
-*>
-*> Using these options, the various LAPACK packed and banded
-*> storage schemes can be obtained:
-*> GB - use 'Z'
-*> PB, SB or TB - use 'B' or 'Q'
-*> PP, SP or TP - use 'C' or 'R'
-*>
-*> If two calls to DLATMT differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( LDA, N )
-*> On exit A is the desired test matrix. A is first generated
-*> in full (unpacked) form, and then packed, if so specified
-*> by PACK. Thus, the first M elements of the first N
-*> columns will always be modified. If PACK specifies a
-*> packed or banded storage scheme, all LDA elements of the
-*> first N columns will be modified; the elements of the
-*> array which do not correspond to elements of the generated
-*> matrix are set to zero.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> LDA specifies the first dimension of A as declared in the
-*> calling program. If PACK='N', 'U', 'L', 'C', or 'R', then
-*> LDA must be at least M. If PACK='B' or 'Q', then LDA must
-*> be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).
-*> If PACK='Z', LDA must be large enough to hold the packed
-*> array: MIN( KU, N-1) + MIN( KL, M-1) + 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension ( 3*MAX( N , M ) )
-*> Workspace.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error code. On exit, INFO will be set to one of the
-*> following values:
-*> 0 => normal return
-*> -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
-*> -2 => N negative
-*> -3 => DIST illegal string
-*> -5 => SYM illegal string
-*> -7 => MODE not in range -6 to 6
-*> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -10 => KL negative
-*> -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL
-*> -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N';
-*> or PACK='C' or 'Q' and SYM='N' and KL is not zero;
-*> or PACK='R' or 'B' and SYM='N' and KU is not zero;
-*> or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not
-*> N.
-*> -14 => LDA is less than M, or PACK='Z' and LDA is less than
-*> MIN(KU,N-1) + MIN(KL,M-1) + 1.
-*> 1 => Error return from DLATM7
-*> 2 => Cannot scale to DMAX (max. sing. value is 0)
-*> 3 => Error return from DLAGGE or DLAGSY
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_matgen
-*
-* =====================================================================
- SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
- $ RANK, KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION COND, DMAX
- INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK
- CHARACTER DIST, PACK, SYM
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * )
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP
- INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA,
- $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2,
- $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH,
- $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC,
- $ UUB
- LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLARND
- LOGICAL LSAME
- EXTERNAL DLARND, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLATM7, DCOPY, DLAGGE, DLAGSY, DLAROT,
- $ DLARTG, DLASET, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, DBLE, MAX, MIN, MOD, SIN
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Decode SYM
-*
- IF( LSAME( SYM, 'N' ) ) THEN
- ISYM = 1
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'P' ) ) THEN
- ISYM = 2
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'S' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE IF( LSAME( SYM, 'H' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE
- ISYM = -1
- END IF
-*
-* Decode PACK
-*
- ISYMPK = 0
- IF( LSAME( PACK, 'N' ) ) THEN
- IPACK = 0
- ELSE IF( LSAME( PACK, 'U' ) ) THEN
- IPACK = 1
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'L' ) ) THEN
- IPACK = 2
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'C' ) ) THEN
- IPACK = 3
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'R' ) ) THEN
- IPACK = 4
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'B' ) ) THEN
- IPACK = 5
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'Q' ) ) THEN
- IPACK = 6
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'Z' ) ) THEN
- IPACK = 7
- ELSE
- IPACK = -1
- END IF
-*
-* Set certain internal parameters
-*
- MNMIN = MIN( M, N )
- LLB = MIN( KL, M-1 )
- UUB = MIN( KU, N-1 )
- MR = MIN( M, N+LLB )
- NC = MIN( N, M+UUB )
-*
- IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN
- MINLDA = UUB + 1
- ELSE IF( IPACK.EQ.7 ) THEN
- MINLDA = LLB + UUB + 1
- ELSE
- MINLDA = M
- END IF
-*
-* Use Givens rotation method if bandwidth small enough,
-* or if LDA is too small to store the matrix unpacked.
-*
- GIVENS = .FALSE.
- IF( ISYM.EQ.1 ) THEN
- IF( DBLE( LLB+UUB ).LT.0.3D0*DBLE( MAX( 1, MR+NC ) ) )
- $ GIVENS = .TRUE.
- ELSE
- IF( 2*LLB.LT.M )
- $ GIVENS = .TRUE.
- END IF
- IF( LDA.LT.M .AND. LDA.GE.MINLDA )
- $ GIVENS = .TRUE.
-*
-* Set INFO if an error
-*
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -3
- ELSE IF( ISYM.EQ.-1 ) THEN
- INFO = -5
- ELSE IF( ABS( MODE ).GT.6 ) THEN
- INFO = -7
- ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
- $ THEN
- INFO = -8
- ELSE IF( KL.LT.0 ) THEN
- INFO = -10
- ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN
- INFO = -11
- ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR.
- $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR.
- $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR.
- $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN
- INFO = -12
- ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN
- INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATMT', -INFO )
- RETURN
- END IF
-*
-* Initialize random number generator
-*
- DO 100 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 100 CONTINUE
-*
- IF( MOD( ISEED( 4 ), 2 ).NE.1 )
- $ ISEED( 4 ) = ISEED( 4 ) + 1
-*
-* 2) Set up D if indicated.
-*
-* Compute D according to COND and MODE
-*
- CALL DLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, RANK,
- $ IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Choose Top-Down if D is (apparently) increasing,
-* Bottom-Up if D is (apparently) decreasing.
-*
- IF( ABS( D( 1 ) ).LE.ABS( D( RANK ) ) ) THEN
- TOPDWN = .TRUE.
- ELSE
- TOPDWN = .FALSE.
- END IF
-*
- IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 110 I = 2, RANK
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 110 CONTINUE
-*
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE
- INFO = 2
- RETURN
- END IF
-*
- CALL DSCAL( RANK, ALPHA, D, 1 )
-*
- END IF
-*
-* 3) Generate Banded Matrix using Givens rotations.
-* Also the special case of UUB=LLB=0
-*
-* Compute Addressing constants to cover all
-* storage formats. Whether GE, SY, GB, or SB,
-* upper or lower triangle or both,
-* the (i,j)-th element is in
-* A( i - ISKEW*j + IOFFST, j )
-*
- IF( IPACK.GT.4 ) THEN
- ILDA = LDA - 1
- ISKEW = 1
- IF( IPACK.GT.5 ) THEN
- IOFFST = UUB + 1
- ELSE
- IOFFST = 1
- END IF
- ELSE
- ILDA = LDA
- ISKEW = 0
- IOFFST = 0
- END IF
-*
-* IPACKG is the format that the matrix is generated in. If this is
-* different from IPACK, then the matrix must be repacked at the
-* end. It also signals how to compute the norm, for scaling.
-*
- IPACKG = 0
- CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
-*
-* Diagonal Matrix -- We are done, unless it
-* is to be stored SP/PP/TP (PACK='R' or 'C')
-*
- IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
- IF( IPACK.LE.2 .OR. IPACK.GE.5 )
- $ IPACKG = IPACK
-*
- ELSE IF( GIVENS ) THEN
-*
-* Check whether to use Givens rotations,
-* Householder transformations, or nothing.
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- IF( IPACK.GT.4 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
-*
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
-*
- IF( TOPDWN ) THEN
- JKL = 0
- DO 140 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* Last row actually rotated is M
-* Last column actually rotated is MIN( M+JKU, N )
-*
- DO 130 JR = 1, MIN( M+JKU, N ) + JKL - 1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL )
- IF( JR.LT.M ) THEN
- IL = MIN( N, JR+JKU ) + 1 - ICOL
- CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C,
- $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IR = JR
- IC = ICOL
- DO 120 JCH = JR - JKL, 1, -JKL - JKU
- IF( IR.LT.M ) THEN
- CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- IROW = MAX( 1, JCH-JKU )
- IL = IR + 2 - IROW
- TEMP = ZERO
- ILTEMP = JCH.GT.JKU
- CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IROW-ISKEW*IC+IOFFST, IC ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), TEMP, C, S, DUMMY )
- ICOL = MAX( 1, JCH-JKU-JKL )
- IL = IC + 2 - ICOL
- EXTRA = ZERO
- CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
-*
- JKU = UUB
- DO 170 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
- DO 160 JC = 1, MIN( N+JKL, M ) + JKU - 1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU )
- IF( JC.LT.N ) THEN
- IL = MIN( M, JC+JKL ) + 1 - IROW
- CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C,
- $ S, A( IROW-ISKEW*JC+IOFFST, JC ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IC = JC
- IR = IROW
- DO 150 JCH = JC - JKU, 1, -JKL - JKU
- IF( IC.LT.N ) THEN
- CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- ICOL = MAX( 1, JCH-JKL )
- IL = IC + 2 - ICOL
- TEMP = ZERO
- ILTEMP = JCH.GT.JKL
- CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST,
- $ ICOL+1 ), TEMP, C, S, DUMMY )
- IROW = MAX( 1, JCH-JKL-JKU )
- IL = IR + 2 - IROW
- EXTRA = ZERO
- CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
-*
- ELSE
-*
-* Bottom-Up -- Start at the bottom right.
-*
- JKL = 0
- DO 200 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* First row actually rotated is M
-* First column actually rotated is MIN( M+JKU, N )
-*
- IENDCH = MIN( M, N+JKL ) - 1
- DO 190 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU+1 )
- IF( JC.GT.0 ) THEN
- IL = MIN( M, JC+JKL+1 ) + 1 - IROW
- CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL,
- $ C, S, A( IROW-ISKEW*JC+IOFFST,
- $ JC ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IC = JC
- DO 180 JCH = JC + JKL, IENDCH, JKL + JKU
- ILEXTR = IC.GT.0
- IF( ILEXTR ) THEN
- CALL DLARTG( A( JCH-ISKEW*IC+IOFFST, IC ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IC = MAX( 1, IC )
- ICOL = MIN( N-1, JCH+JKU )
- ILTEMP = JCH + JKU.LT.N
- TEMP = ZERO
- CALL DLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC,
- $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ),
- $ ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL DLAROT( .FALSE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, TEMP, EXTRA )
- IC = ICOL
- END IF
- 180 CONTINUE
- 190 CONTINUE
- 200 CONTINUE
-*
- JKU = UUB
- DO 230 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
-* First row actually rotated is MIN( N+JKL, M )
-* First column actually rotated is N
-*
- IENDCH = MIN( N, M+JKU ) - 1
- DO 220 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1
- EXTRA = ZERO
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL+1 )
- IF( JR.GT.0 ) THEN
- IL = MIN( N, JR+JKU+1 ) + 1 - ICOL
- CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL,
- $ C, S, A( JR-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IR = JR
- DO 210 JCH = JR + JKU, IENDCH, JKL + JKU
- ILEXTR = IR.GT.0
- IF( ILEXTR ) THEN
- CALL DLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IR = MAX( 1, IR )
- IROW = MIN( M-1, JCH+JKL )
- ILTEMP = JCH + JKL.LT.M
- TEMP = ZERO
- CALL DLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR,
- $ C, S, A( IR-ISKEW*JCH+IOFFST,
- $ JCH ), ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL DLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL DLAROT( .TRUE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ ILDA, TEMP, EXTRA )
- IR = IROW
- END IF
- 210 CONTINUE
- 220 CONTINUE
- 230 CONTINUE
- END IF
-*
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- IPACKG = IPACK
- IOFFG = IOFFST
-*
- IF( TOPDWN ) THEN
-*
-* Top-Down -- Generate Upper triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 6
- IOFFG = UUB + 1
- ELSE
- IPACKG = 1
- END IF
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 260 K = 1, UUB
- DO 250 JC = 1, N - 1
- IROW = MAX( 1, JC-K )
- IL = MIN( JC+1, K+2 )
- EXTRA = ZERO
- TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 )
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- CALL DLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S,
- $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA,
- $ EXTRA, TEMP )
- CALL DLAROT( .TRUE., .TRUE., .FALSE.,
- $ MIN( K, N-JC )+1, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, DUMMY )
-*
-* Chase EXTRA back up the matrix
-*
- ICOL = JC
- DO 240 JCH = JC - K, 1, -K
- CALL DLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG,
- $ ICOL+1 ), EXTRA, C, S, DUMMY )
- TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 )
- CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S,
- $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- IROW = MAX( 1, JCH-K )
- IL = MIN( JCH+1, K+2 )
- EXTRA = ZERO
- CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C,
- $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ),
- $ ILDA, EXTRA, TEMP )
- ICOL = JCH
- 240 CONTINUE
- 250 CONTINUE
- 260 CONTINUE
-*
-* If we need lower triangle, copy from upper. Note that
-* the order of copying is chosen to work for 'q' -> 'b'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN
- DO 280 JC = 1, N
- IROW = IOFFST - ISKEW*JC
- DO 270 JR = JC, MIN( N, JC+UUB )
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 270 CONTINUE
- 280 CONTINUE
- IF( IPACK.EQ.5 ) THEN
- DO 300 JC = N - UUB + 1, N
- DO 290 JR = N + 2 - JC, UUB + 1
- A( JR, JC ) = ZERO
- 290 CONTINUE
- 300 CONTINUE
- END IF
- IF( IPACKG.EQ.6 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- ELSE
-*
-* Bottom-Up -- Generate Lower triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 5
- IF( IPACK.EQ.6 )
- $ IOFFG = 1
- ELSE
- IPACKG = 2
- END IF
- CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 330 K = 1, UUB
- DO 320 JC = N - 1, 1, -1
- IL = MIN( N+1-JC, K+2 )
- EXTRA = ZERO
- TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC )
- ANGLE = TWOPI*DLARND( 1, ISEED )
- C = COS( ANGLE )
- S = -SIN( ANGLE )
- CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, EXTRA )
- ICOL = MAX( 1, JC-K+1 )
- CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C,
- $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, DUMMY, TEMP )
-*
-* Chase EXTRA back down the matrix
-*
- ICOL = JC
- DO 310 JCH = JC + K, N - 1, K
- CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ EXTRA, C, S, DUMMY )
- TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH )
- CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, EXTRA, TEMP )
- IL = MIN( N+1-JCH, K+2 )
- EXTRA = ZERO
- CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C,
- $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- ICOL = JCH
- 310 CONTINUE
- 320 CONTINUE
- 330 CONTINUE
-*
-* If we need upper triangle, copy from lower. Note that
-* the order of copying is chosen to work for 'b' -> 'q'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN
- DO 350 JC = N, 1, -1
- IROW = IOFFST - ISKEW*JC
- DO 340 JR = JC, MAX( 1, JC-UUB ), -1
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 340 CONTINUE
- 350 CONTINUE
- IF( IPACK.EQ.6 ) THEN
- DO 370 JC = 1, UUB
- DO 360 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 360 CONTINUE
- 370 CONTINUE
- END IF
- IF( IPACKG.EQ.5 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-*
-* 4) Generate Banded Matrix by first
-* Rotating by random Unitary matrices,
-* then reducing the bandwidth using Householder
-* transformations.
-*
-* Note: we should get here only if LDA .ge. N
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- CALL DLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK,
- $ IINFO )
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- CALL DLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
-*
- END IF
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- END IF
-*
-* 5) Pack the matrix
-*
- IF( IPACK.NE.IPACKG ) THEN
- IF( IPACK.EQ.1 ) THEN
-*
-* 'U' -- Upper triangular, not packed
-*
- DO 390 J = 1, M
- DO 380 I = J + 1, M
- A( I, J ) = ZERO
- 380 CONTINUE
- 390 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
-* 'L' -- Lower triangular, not packed
-*
- DO 410 J = 2, M
- DO 400 I = 1, J - 1
- A( I, J ) = ZERO
- 400 CONTINUE
- 410 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
-* 'C' -- Upper triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 430 J = 1, M
- DO 420 I = 1, J
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 420 CONTINUE
- 430 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
-* 'R' -- Lower triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 450 J = 1, M
- DO 440 I = J, M
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 440 CONTINUE
- 450 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* 'B' -- The lower triangle is packed as a band matrix.
-* 'Q' -- The upper triangle is packed as a band matrix.
-* 'Z' -- The whole matrix is packed as a band matrix.
-*
- IF( IPACK.EQ.5 )
- $ UUB = 0
- IF( IPACK.EQ.6 )
- $ LLB = 0
-*
- DO 470 J = 1, UUB
- DO 460 I = MIN( J+LLB, M ), 1, -1
- A( I-J+UUB+1, J ) = A( I, J )
- 460 CONTINUE
- 470 CONTINUE
-*
- DO 490 J = UUB + 2, N
- DO 480 I = J - UUB, MIN( J+LLB, M )
- A( I-J+UUB+1, J ) = A( I, J )
- 480 CONTINUE
- 490 CONTINUE
- END IF
-*
-* If packed, zero out extraneous elements.
-*
-* Symmetric/Triangular Packed --
-* zero out everything after A(IROW,ICOL)
-*
- IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
- DO 510 JC = ICOL, M
- DO 500 JR = IROW + 1, LDA
- A( JR, JC ) = ZERO
- 500 CONTINUE
- IROW = 0
- 510 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* Packed Band --
-* 1st row is now in A( UUB+2-j, j), zero above it
-* m-th row is now in A( M+UUB-j,j), zero below it
-* last non-zero diagonal is now in A( UUB+LLB+1,j ),
-* zero below it, too.
-*
- IR1 = UUB + LLB + 2
- IR2 = UUB + M + 2
- DO 540 JC = 1, N
- DO 520 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 520 CONTINUE
- DO 530 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA
- A( JR, JC ) = ZERO
- 530 CONTINUE
- 540 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DLATMT
-*
- END
diff --git a/netlib/LAPACK/dlatps.f b/netlib/LAPACK/dlatps.f
deleted file mode 100644
index 3898a45..0000000
--- a/netlib/LAPACK/dlatps.f
+++ /dev/null
@@ -1,795 +0,0 @@
-*> \brief \b DLATPS solves a triangular system of equations with the matrix held in packed storage.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATPS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatps.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatps.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatps.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE,
-* CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATPS solves one of the triangular systems
-*>
-*> A *x = s*b or A**T*x = s*b
-*>
-*> with scaling to prevent overflow, where A is an upper or lower
-*> triangular matrix stored in packed form. Here A**T denotes the
-*> transpose of A, x and b are n-element vectors, and s is a scaling
-*> factor, usually less than or equal to 1, chosen so that the
-*> components of x will be less than the overflow threshold. If the
-*> unscaled problem will not cause overflow, the Level 2 BLAS routine
-*> DTPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
-*> then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is DOUBLE PRECISION array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, DTPSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTPSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call DTPSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE,
- $ CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, IP, J, JFIRST, JINC, JLAST, JLEN
- DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATPS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- IP = 1
- DO 10 J = 1, N
- CNORM( J ) = DASUM( J-1, AP( IP ), 1 )
- IP = IP + J
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- IP = 1
- DO 20 J = 1, N - 1
- CNORM( J ) = DASUM( N-J, AP( IP+1 ), 1 )
- IP = IP + N - J + 1
- 20 CONTINUE
- CNORM( N ) = ZERO
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = IDAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL DSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine DTPSV can be used.
-*
- J = IDAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- IP = JFIRST*( JFIRST+1 ) / 2
- JLEN = N
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( AP( IP ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- IP = IP + JINC*JLEN
- JLEN = JLEN - 1
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- IP = JFIRST*( JFIRST+1 ) / 2
- JLEN = 1
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( AP( IP ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- JLEN = JLEN + 1
- IP = IP + JINC*JLEN
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL DTPSV( UPLO, TRANS, DIAG, N, AP, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL DSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- IP = JFIRST*( JFIRST+1 ) / 2
- DO 110 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = AP( IP )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 100
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 100 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL DSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
- CALL DAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X,
- $ 1 )
- I = IDAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- IP = IP - J
- ELSE
- IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
- CALL DAXPY( N-J, -X( J )*TSCAL, AP( IP+1 ), 1,
- $ X( J+1 ), 1 )
- I = J + IDAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- IP = IP + N - J + 1
- END IF
- 110 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- IP = JFIRST*( JFIRST+1 ) / 2
- JLEN = 1
- DO 160 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = AP( IP )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call DDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- SUMJ = DDOT( J-1, AP( IP-J+1 ), 1, X, 1 )
- ELSE IF( J.LT.N ) THEN
- SUMJ = DDOT( N-J, AP( IP+1 ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- DO 120 I = 1, J - 1
- SUMJ = SUMJ + ( AP( IP-J+I )*USCAL )*X( I )
- 120 CONTINUE
- ELSE IF( J.LT.N ) THEN
- DO 130 I = 1, N - J
- SUMJ = SUMJ + ( AP( IP+I )*USCAL )*X( J+I )
- 130 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJS = AP( IP )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 150
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 140 I = 1, N
- X( I ) = ZERO
- 140 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 150 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- JLEN = JLEN + 1
- IP = IP + JINC*JLEN
- 160 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of DLATPS
-*
- END
diff --git a/netlib/LAPACK/dlatrd.f b/netlib/LAPACK/dlatrd.f
deleted file mode 100644
index 69ec001..0000000
--- a/netlib/LAPACK/dlatrd.f
+++ /dev/null
@@ -1,336 +0,0 @@
-*> \brief \b DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATRD reduces NB rows and columns of a real symmetric matrix A to
-*> symmetric tridiagonal form by an orthogonal similarity
-*> transformation Q**T * A * Q, and returns the matrices V and W which are
-*> needed to apply the transformation to the unreduced part of A.
-*>
-*> If UPLO = 'U', DLATRD reduces the last NB rows and columns of a
-*> matrix, of which the upper triangle is supplied;
-*> if UPLO = 'L', DLATRD reduces the first NB rows and columns of a
-*> matrix, of which the lower triangle is supplied.
-*>
-*> This is an auxiliary routine called by DSYTRD.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of rows and columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit:
-*> if UPLO = 'U', the last NB columns have been reduced to
-*> tridiagonal form, with the diagonal elements overwriting
-*> the diagonal elements of A; the elements above the diagonal
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors;
-*> if UPLO = 'L', the first NB columns have been reduced to
-*> tridiagonal form, with the diagonal elements overwriting
-*> the diagonal elements of A; the elements below the diagonal
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= (1,N).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
-*> elements of the last NB columns of the reduced matrix;
-*> if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
-*> the first NB columns of the reduced matrix.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors, stored in
-*> TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (LDW,NB)
-*> The n-by-nb matrix W required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDW
-*> \verbatim
-*> LDW is INTEGER
-*> The leading dimension of the array W. LDW >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n) H(n-1) . . . H(n-nb+1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
-*> and tau in TAU(i-1).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
-*> and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the n-by-nb matrix V
-*> which is needed, with W, to apply the transformation to the unreduced
-*> part of the matrix, using a symmetric rank-2k update of the form:
-*> A := A - V*W**T - W*V**T.
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with n = 5 and nb = 2:
-*>
-*> if UPLO = 'U': if UPLO = 'L':
-*>
-*> ( a a a v4 v5 ) ( d )
-*> ( a a v4 v5 ) ( 1 d )
-*> ( a 1 v5 ) ( v1 1 a )
-*> ( d 1 ) ( v1 v2 a a )
-*> ( d ) ( v1 v2 a a a )
-*>
-*> where d denotes a diagonal element of the reduced matrix, a denotes
-*> an element of the original matrix that is unchanged, and vi denotes
-*> an element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, HALF
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, HALF = 0.5D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IW
- DOUBLE PRECISION ALPHA
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DGEMV, DLARFG, DSCAL, DSYMV
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Reduce last NB columns of upper triangle
-*
- DO 10 I = N, N - NB + 1, -1
- IW = I - N + NB
- IF( I.LT.N ) THEN
-*
-* Update A(1:i,i)
-*
- CALL DGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ),
- $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 )
- CALL DGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ),
- $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 )
- END IF
- IF( I.GT.1 ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(1:i-2,i)
-*
- CALL DLARFG( I-1, A( I-1, I ), A( 1, I ), 1, TAU( I-1 ) )
- E( I-1 ) = A( I-1, I )
- A( I-1, I ) = ONE
-*
-* Compute W(1:i-1,i)
-*
- CALL DSYMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1,
- $ ZERO, W( 1, IW ), 1 )
- IF( I.LT.N ) THEN
- CALL DGEMV( 'Transpose', I-1, N-I, ONE, W( 1, IW+1 ),
- $ LDW, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 )
- CALL DGEMV( 'No transpose', I-1, N-I, -ONE,
- $ A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE,
- $ W( 1, IW ), 1 )
- CALL DGEMV( 'Transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 )
- CALL DGEMV( 'No transpose', I-1, N-I, -ONE,
- $ W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE,
- $ W( 1, IW ), 1 )
- END IF
- CALL DSCAL( I-1, TAU( I-1 ), W( 1, IW ), 1 )
- ALPHA = -HALF*TAU( I-1 )*DDOT( I-1, W( 1, IW ), 1,
- $ A( 1, I ), 1 )
- CALL DAXPY( I-1, ALPHA, A( 1, I ), 1, W( 1, IW ), 1 )
- END IF
-*
- 10 CONTINUE
- ELSE
-*
-* Reduce first NB columns of lower triangle
-*
- DO 20 I = 1, NB
-*
-* Update A(i:n,i)
-*
- CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, A( I, 1 ),
- $ LDA, W( I, 1 ), LDW, ONE, A( I, I ), 1 )
- CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, W( I, 1 ),
- $ LDW, A( I, 1 ), LDA, ONE, A( I, I ), 1 )
- IF( I.LT.N ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(i+2:n,i)
-*
- CALL DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAU( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Compute W(i+1:n,i)
-*
- CALL DSYMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA,
- $ A( I+1, I ), 1, ZERO, W( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), LDW,
- $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 )
- CALL DGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 )
- CALL DGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ),
- $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
- CALL DSCAL( N-I, TAU( I ), W( I+1, I ), 1 )
- ALPHA = -HALF*TAU( I )*DDOT( N-I, W( I+1, I ), 1,
- $ A( I+1, I ), 1 )
- CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 )
- END IF
-*
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DLATRD
-*
- END
diff --git a/netlib/LAPACK/dlatrs.f b/netlib/LAPACK/dlatrs.f
deleted file mode 100644
index b34795e..0000000
--- a/netlib/LAPACK/dlatrs.f
+++ /dev/null
@@ -1,787 +0,0 @@
-*> \brief \b DLATRS solves a triangular system of equations with the scale factor set to prevent overflow.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
-* CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATRS solves one of the triangular systems
-*>
-*> A *x = s*b or A**T *x = s*b
-*>
-*> with scaling to prevent overflow. Here A is an upper or lower
-*> triangular matrix, A**T denotes the transpose of A, x and b are
-*> n-element vectors, and s is a scaling factor, usually less than
-*> or equal to 1, chosen so that the components of x will be less than
-*> the overflow threshold. If the unscaled problem will not cause
-*> overflow, the Level 2 BLAS routine DTRSV is called. If the matrix A
-*> is singular (A(j,j) = 0 for some j), then s is set to 0 and a
-*> non-trivial solution to A*x = 0 is returned.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading n by n
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading n by n lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max (1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is DOUBLE PRECISION array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, DTRSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
- $ CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, LDA, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, J, JFIRST, JINC, JLAST
- DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- DO 10 J = 1, N
- CNORM( J ) = DASUM( J-1, A( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- DO 20 J = 1, N - 1
- CNORM( J ) = DASUM( N-J, A( J+1, J ), 1 )
- 20 CONTINUE
- CNORM( N ) = ZERO
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = IDAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL DSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine DTRSV can be used.
-*
- J = IDAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( A( J, J ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( A( J, J ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL DSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- DO 110 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 100
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 100 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL DSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
- CALL DAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
- $ 1 )
- I = IDAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- ELSE
- IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
- CALL DAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
- $ X( J+1 ), 1 )
- I = J + IDAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- END IF
- 110 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- DO 160 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call DDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- SUMJ = DDOT( J-1, A( 1, J ), 1, X, 1 )
- ELSE IF( J.LT.N ) THEN
- SUMJ = DDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- DO 120 I = 1, J - 1
- SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
- 120 CONTINUE
- ELSE IF( J.LT.N ) THEN
- DO 130 I = J + 1, N
- SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
- 130 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 150
- END IF
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 140 I = 1, N
- X( I ) = ZERO
- 140 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 150 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- 160 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of DLATRS
-*
- END
diff --git a/netlib/LAPACK/dlatrz.f b/netlib/LAPACK/dlatrz.f
deleted file mode 100644
index 6748db2..0000000
--- a/netlib/LAPACK/dlatrz.f
+++ /dev/null
@@ -1,200 +0,0 @@
-*> \brief \b DLATRZ factors an upper trapezoidal matrix by means of orthogonal transformations.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATRZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatrz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatrz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatrz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATRZ( M, N, L, A, LDA, TAU, WORK )
-*
-* .. Scalar Arguments ..
-* INTEGER L, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
-*> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means
-*> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal
-*> matrix and, R and A1 are M-by-M upper triangular matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix A containing the
-*> meaningful part of the Householder vectors. N-M >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the leading M-by-N upper trapezoidal part of the
-*> array A must contain the matrix to be factorized.
-*> On exit, the leading M-by-M upper triangular part of A
-*> contains the upper triangular matrix R, and elements N-L+1 to
-*> N of the first M rows of A, with the array TAU, represent the
-*> orthogonal matrix Z as a product of M elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (M)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The factorization is obtained by Householder's method. The kth
-*> transformation matrix, Z( k ), which is used to introduce zeros into
-*> the ( m - k + 1 )th row of A, is given in the form
-*>
-*> Z( k ) = ( I 0 ),
-*> ( 0 T( k ) )
-*>
-*> where
-*>
-*> T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ),
-*> ( 0 )
-*> ( z( k ) )
-*>
-*> tau is a scalar and z( k ) is an l element vector. tau and z( k )
-*> are chosen to annihilate the elements of the kth row of A2.
-*>
-*> The scalar tau is returned in the kth element of TAU and the vector
-*> u( k ) in the kth row of A2, such that the elements of z( k ) are
-*> in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
-*> the upper triangular part of A1.
-*>
-*> Z is given by
-*>
-*> Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATRZ( M, N, L, A, LDA, TAU, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER L, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFG, DLARZ
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
-* Quick return if possible
-*
- IF( M.EQ.0 ) THEN
- RETURN
- ELSE IF( M.EQ.N ) THEN
- DO 10 I = 1, N
- TAU( I ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- DO 20 I = M, 1, -1
-*
-* Generate elementary reflector H(i) to annihilate
-* [ A(i,i) A(i,n-l+1:n) ]
-*
- CALL DLARFG( L+1, A( I, I ), A( I, N-L+1 ), LDA, TAU( I ) )
-*
-* Apply H(i) to A(1:i-1,i:n) from the right
-*
- CALL DLARZ( 'Right', I-1, N-I+1, L, A( I, N-L+1 ), LDA,
- $ TAU( I ), A( 1, I ), LDA, WORK )
-*
- 20 CONTINUE
-*
- RETURN
-*
-* End of DLATRZ
-*
- END
diff --git a/netlib/LAPACK/dlatzm.f b/netlib/LAPACK/dlatzm.f
deleted file mode 100644
index 107a8bc..0000000
--- a/netlib/LAPACK/dlatzm.f
+++ /dev/null
@@ -1,221 +0,0 @@
-*> \brief \b DLATZM
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatzm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatzm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, LDC, M, N
-* DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine DORMRZ.
-*>
-*> DLATZM applies a Householder matrix generated by DTZRQF to a matrix.
-*>
-*> Let P = I - tau*u*u**T, u = ( 1 ),
-*> ( v )
-*> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
-*> SIDE = 'R'.
-*>
-*> If SIDE equals 'L', let
-*> C = [ C1 ] 1
-*> [ C2 ] m-1
-*> n
-*> Then C is overwritten by P*C.
-*>
-*> If SIDE equals 'R', let
-*> C = [ C1, C2 ] m
-*> 1 n-1
-*> Then C is overwritten by C*P.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form P * C
-*> = 'R': form C * P
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*> (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*> The vector v in the representation of P. V is not used
-*> if TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau in the representation of P.
-*> \endverbatim
-*>
-*> \param[in,out] C1
-*> \verbatim
-*> C1 is DOUBLE PRECISION array, dimension
-*> (LDC,N) if SIDE = 'L'
-*> (M,1) if SIDE = 'R'
-*> On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
-*> if SIDE = 'R'.
-*>
-*> On exit, the first row of P*C if SIDE = 'L', or the first
-*> column of C*P if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in,out] C2
-*> \verbatim
-*> C2 is DOUBLE PRECISION array, dimension
-*> (LDC, N) if SIDE = 'L'
-*> (LDC, N-1) if SIDE = 'R'
-*> On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
-*> m x (n - 1) matrix C2 if SIDE = 'R'.
-*>
-*> On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
-*> if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the arrays C1 and C2. LDC >= (1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, LDC, M, N
- DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
- $ RETURN
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* w := (C1 + v**T * C2)**T
-*
- CALL DCOPY( N, C1, LDC, WORK, 1 )
- CALL DGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
- $ WORK, 1 )
-*
-* [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T
-* [ C2 ] [ C2 ] [ v ]
-*
- CALL DAXPY( N, -TAU, WORK, 1, C1, LDC )
- CALL DGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* 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 )
-*
-* [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
-*
- CALL DAXPY( M, -TAU, WORK, 1, C1, 1 )
- CALL DGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
- END IF
-*
- RETURN
-*
-* End of DLATZM
-*
- END
diff --git a/netlib/LAPACK/dlauu2.f b/netlib/LAPACK/dlauu2.f
deleted file mode 100644
index c77ab60..0000000
--- a/netlib/LAPACK/dlauu2.f
+++ /dev/null
@@ -1,198 +0,0 @@
-*> \brief \b DLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAUU2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlauu2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlauu2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlauu2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAUU2( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAUU2 computes the product U * U**T or L**T * L, where the triangular
-*> factor U or L is stored in the upper or lower triangular part of
-*> the array A.
-*>
-*> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
-*> overwriting the factor U in A.
-*> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
-*> overwriting the factor L in A.
-*>
-*> This is the unblocked form of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the triangular factor stored in the array A
-*> is upper or lower triangular:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the triangular factor U or L. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular factor U or L.
-*> On exit, if UPLO = 'U', the upper triangle of A is
-*> overwritten with the upper triangle of the product U * U**T;
-*> if UPLO = 'L', the lower triangle of A is overwritten with
-*> the lower triangle of the product L**T * L.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAUU2( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAUU2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the product U * U**T.
-*
- DO 10 I = 1, N
- AII = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = DDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA )
- CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 )
- ELSE
- CALL DSCAL( I, AII, A( 1, I ), 1 )
- END IF
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the product L**T * L.
-*
- DO 20 I = 1, N
- AII = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = DDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 )
- CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, AII, A( I, 1 ), LDA )
- ELSE
- CALL DSCAL( I, AII, A( I, 1 ), LDA )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DLAUU2
-*
- END
diff --git a/netlib/LAPACK/dlauum.f b/netlib/LAPACK/dlauum.f
deleted file mode 100644
index 1157057..0000000
--- a/netlib/LAPACK/dlauum.f
+++ /dev/null
@@ -1,218 +0,0 @@
-*> \brief \b DLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAUUM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlauum.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlauum.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlauum.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAUUM( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAUUM computes the product U * U**T or L**T * L, where the triangular
-*> factor U or L is stored in the upper or lower triangular part of
-*> the array A.
-*>
-*> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
-*> overwriting the factor U in A.
-*> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
-*> overwriting the factor L in A.
-*>
-*> This is the blocked form of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the triangular factor stored in the array A
-*> is upper or lower triangular:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the triangular factor U or L. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular factor U or L.
-*> On exit, if UPLO = 'U', the upper triangle of A is
-*> overwritten with the upper triangle of the product U * U**T;
-*> if UPLO = 'L', the lower triangle of A is overwritten with
-*> the lower triangle of the product L**T * L.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAUUM( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLAUU2, DSYRK, DTRMM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLAUUM', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DLAUUM', UPLO, N, -1, -1, -1 )
-*
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL DLAUU2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( UPPER ) THEN
-*
-* Compute the product U * U**T.
-*
- DO 10 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Non-unit',
- $ I-1, IB, ONE, A( I, I ), LDA, A( 1, I ),
- $ LDA )
- CALL DLAUU2( 'Upper', IB, A( I, I ), LDA, INFO )
- IF( I+IB.LE.N ) THEN
- CALL DGEMM( 'No transpose', 'Transpose', I-1, IB,
- $ N-I-IB+1, ONE, A( 1, I+IB ), LDA,
- $ A( I, I+IB ), LDA, ONE, A( 1, I ), LDA )
- CALL DSYRK( 'Upper', 'No transpose', IB, N-I-IB+1,
- $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ),
- $ LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute the product L**T * L.
-*
- DO 20 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
- CALL DTRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB,
- $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA )
- CALL DLAUU2( 'Lower', IB, A( I, I ), LDA, INFO )
- IF( I+IB.LE.N ) THEN
- CALL DGEMM( 'Transpose', 'No transpose', IB, I-1,
- $ N-I-IB+1, ONE, A( I+IB, I ), LDA,
- $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA )
- CALL DSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE,
- $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA )
- END IF
- 20 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DLAUUM
-*
- END
diff --git a/netlib/LAPACK/dopgtr.f b/netlib/LAPACK/dopgtr.f
deleted file mode 100644
index d908de3..0000000
--- a/netlib/LAPACK/dopgtr.f
+++ /dev/null
@@ -1,232 +0,0 @@
-*> \brief \b DOPGTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DOPGTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dopgtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dopgtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dopgtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DOPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDQ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DOPGTR generates a real orthogonal matrix Q which is defined as the
-*> product of n-1 elementary reflectors H(i) of order n, as returned by
-*> DSPTRD using packed storage:
-*>
-*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular packed storage used in previous
-*> call to DSPTRD;
-*> = 'L': Lower triangular packed storage used in previous
-*> call to DSPTRD.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The vectors which define the elementary reflectors, as
-*> returned by DSPTRD.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DSPTRD.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> The N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N-1)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DOPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDQ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IINFO, IJ, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DORG2L, DORG2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DOPGTR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to DSPTRD with UPLO = 'U'
-*
-* Unpack the vectors which define the elementary reflectors and
-* set the last row and column of Q equal to those of the unit
-* matrix
-*
- IJ = 2
- DO 20 J = 1, N - 1
- DO 10 I = 1, J - 1
- Q( I, J ) = AP( IJ )
- IJ = IJ + 1
- 10 CONTINUE
- IJ = IJ + 2
- Q( N, J ) = ZERO
- 20 CONTINUE
- DO 30 I = 1, N - 1
- Q( I, N ) = ZERO
- 30 CONTINUE
- Q( N, N ) = ONE
-*
-* Generate Q(1:n-1,1:n-1)
-*
- CALL DORG2L( N-1, N-1, N-1, Q, LDQ, TAU, WORK, IINFO )
-*
- ELSE
-*
-* Q was determined by a call to DSPTRD with UPLO = 'L'.
-*
-* Unpack the vectors which define the elementary reflectors and
-* set the first row and column of Q equal to those of the unit
-* matrix
-*
- Q( 1, 1 ) = ONE
- DO 40 I = 2, N
- Q( I, 1 ) = ZERO
- 40 CONTINUE
- IJ = 3
- DO 60 J = 2, N
- Q( 1, J ) = ZERO
- DO 50 I = J + 1, N
- Q( I, J ) = AP( IJ )
- IJ = IJ + 1
- 50 CONTINUE
- IJ = IJ + 2
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Generate Q(2:n,2:n)
-*
- CALL DORG2R( N-1, N-1, N-1, Q( 2, 2 ), LDQ, TAU, WORK,
- $ IINFO )
- END IF
- END IF
- RETURN
-*
-* End of DOPGTR
-*
- END
diff --git a/netlib/LAPACK/dopmtr.f b/netlib/LAPACK/dopmtr.f
deleted file mode 100644
index 07486c7..0000000
--- a/netlib/LAPACK/dopmtr.f
+++ /dev/null
@@ -1,339 +0,0 @@
-*> \brief \b DOPMTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DOPMTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dopmtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dopmtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dopmtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, UPLO
-* INTEGER INFO, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DOPMTR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix of order nq, with nq = m if
-*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*> nq-1 elementary reflectors, as returned by DSPTRD using packed
-*> storage:
-*>
-*> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular packed storage used in previous
-*> call to DSPTRD;
-*> = 'L': Lower triangular packed storage used in previous
-*> call to DSPTRD.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension
-*> (M*(M+1)/2) if SIDE = 'L'
-*> (N*(N+1)/2) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by DSPTRD. AP is modified by the routine but
-*> restored on exit.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (M-1) if SIDE = 'L'
-*> or (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DSPTRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, UPLO
- INTEGER INFO, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL FORWRD, LEFT, NOTRAN, UPPER
- INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- UPPER = LSAME( UPLO, 'U' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DOPMTR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to DSPTRD with UPLO = 'U'
-*
- FORWRD = ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN )
-*
- IF( FORWRD ) THEN
- I1 = 1
- I2 = NQ - 1
- I3 = 1
- II = 2
- ELSE
- I1 = NQ - 1
- I2 = 1
- I3 = -1
- II = NQ*( NQ+1 ) / 2 - 1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(1:i,1:n)
-*
- MI = I
- ELSE
-*
-* H(i) is applied to C(1:m,1:i)
-*
- NI = I
- END IF
-*
-* Apply H(i)
-*
- AII = AP( II )
- AP( II ) = ONE
- CALL DLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, LDC,
- $ WORK )
- AP( II ) = AII
-*
- IF( FORWRD ) THEN
- II = II + I + 2
- ELSE
- II = II - I - 1
- END IF
- 10 CONTINUE
- ELSE
-*
-* Q was determined by a call to DSPTRD with UPLO = 'L'.
-*
- FORWRD = ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN )
-*
- IF( FORWRD ) THEN
- I1 = 1
- I2 = NQ - 1
- I3 = 1
- II = 2
- ELSE
- I1 = NQ - 1
- I2 = 1
- I3 = -1
- II = NQ*( NQ+1 ) / 2 - 1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 20 I = I1, I2, I3
- AII = AP( II )
- AP( II ) = ONE
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i+1:m,1:n)
-*
- MI = M - I
- IC = I + 1
- ELSE
-*
-* H(i) is applied to C(1:m,i+1:n)
-*
- NI = N - I
- JC = I + 1
- END IF
-*
-* Apply H(i)
-*
- CALL DLARF( SIDE, MI, NI, AP( II ), 1, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
- AP( II ) = AII
-*
- IF( FORWRD ) THEN
- II = II + NQ - I + 1
- ELSE
- II = II - NQ + I - 2
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DOPMTR
-*
- END
diff --git a/netlib/LAPACK/dorbdb.f b/netlib/LAPACK/dorbdb.f
deleted file mode 100644
index 5580f4e..0000000
--- a/netlib/LAPACK/dorbdb.f
+++ /dev/null
@@ -1,607 +0,0 @@
-*> \brief \b DORBDB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORBDB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorbdb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorbdb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorbdb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
-* X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,
-* TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIGNS, TRANS
-* INTEGER INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P,
-* $ Q
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION PHI( * ), THETA( * )
-* DOUBLE PRECISION TAUP1( * ), TAUP2( * ), TAUQ1( * ), TAUQ2( * ),
-* $ WORK( * ), X11( LDX11, * ), X12( LDX12, * ),
-* $ X21( LDX21, * ), X22( LDX22, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORBDB simultaneously bidiagonalizes the blocks of an M-by-M
-*> partitioned orthogonal matrix X:
-*>
-*> [ B11 | B12 0 0 ]
-*> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T
-*> X = [-----------] = [---------] [----------------] [---------] .
-*> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ]
-*> [ 0 | 0 0 I ]
-*>
-*> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is
-*> not the case, then X must be transposed and/or permuted. This can be
-*> done in constant time using the TRANS and SIGNS options. See DORCSD
-*> for details.)
-*>
-*> The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by-
-*> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are
-*> represented implicitly by Householder vectors.
-*>
-*> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented
-*> implicitly by angles THETA, PHI.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER
-*> = 'T': X, U1, U2, V1T, and V2T are stored in row-major
-*> order;
-*> otherwise: X, U1, U2, V1T, and V2T are stored in column-
-*> major order.
-*> \endverbatim
-*>
-*> \param[in] SIGNS
-*> \verbatim
-*> SIGNS is CHARACTER
-*> = 'O': The lower-left block is made nonpositive (the
-*> "other" convention);
-*> otherwise: The upper-right block is made nonpositive (the
-*> "default" convention).
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows and columns in X.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows in X11 and X12. 0 <= P <= M.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is INTEGER
-*> The number of columns in X11 and X21. 0 <= Q <=
-*> MIN(P,M-P,M-Q).
-*> \endverbatim
-*>
-*> \param[in,out] X11
-*> \verbatim
-*> X11 is DOUBLE PRECISION array, dimension (LDX11,Q)
-*> On entry, the top-left block of the orthogonal matrix to be
-*> reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the columns of tril(X11) specify reflectors for P1,
-*> the rows of triu(X11,1) specify reflectors for Q1;
-*> else TRANS = 'T', and
-*> the rows of triu(X11) specify reflectors for P1,
-*> the columns of tril(X11,-1) specify reflectors for Q1.
-*> \endverbatim
-*>
-*> \param[in] LDX11
-*> \verbatim
-*> LDX11 is INTEGER
-*> The leading dimension of X11. If TRANS = 'N', then LDX11 >=
-*> P; else LDX11 >= Q.
-*> \endverbatim
-*>
-*> \param[in,out] X12
-*> \verbatim
-*> X12 is DOUBLE PRECISION array, dimension (LDX12,M-Q)
-*> On entry, the top-right block of the orthogonal matrix to
-*> be reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the rows of triu(X12) specify the first P reflectors for
-*> Q2;
-*> else TRANS = 'T', and
-*> the columns of tril(X12) specify the first P reflectors
-*> for Q2.
-*> \endverbatim
-*>
-*> \param[in] LDX12
-*> \verbatim
-*> LDX12 is INTEGER
-*> The leading dimension of X12. If TRANS = 'N', then LDX12 >=
-*> P; else LDX11 >= M-Q.
-*> \endverbatim
-*>
-*> \param[in,out] X21
-*> \verbatim
-*> X21 is DOUBLE PRECISION array, dimension (LDX21,Q)
-*> On entry, the bottom-left block of the orthogonal matrix to
-*> be reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the columns of tril(X21) specify reflectors for P2;
-*> else TRANS = 'T', and
-*> the rows of triu(X21) specify reflectors for P2.
-*> \endverbatim
-*>
-*> \param[in] LDX21
-*> \verbatim
-*> LDX21 is INTEGER
-*> The leading dimension of X21. If TRANS = 'N', then LDX21 >=
-*> M-P; else LDX21 >= Q.
-*> \endverbatim
-*>
-*> \param[in,out] X22
-*> \verbatim
-*> X22 is DOUBLE PRECISION array, dimension (LDX22,M-Q)
-*> On entry, the bottom-right block of the orthogonal matrix to
-*> be reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the rows of triu(X22(Q+1:M-P,P+1:M-Q)) specify the last
-*> M-P-Q reflectors for Q2,
-*> else TRANS = 'T', and
-*> the columns of tril(X22(P+1:M-Q,Q+1:M-P)) specify the last
-*> M-P-Q reflectors for P2.
-*> \endverbatim
-*>
-*> \param[in] LDX22
-*> \verbatim
-*> LDX22 is INTEGER
-*> The leading dimension of X22. If TRANS = 'N', then LDX22 >=
-*> M-P; else LDX22 >= M-Q.
-*> \endverbatim
-*>
-*> \param[out] THETA
-*> \verbatim
-*> THETA is DOUBLE PRECISION array, dimension (Q)
-*> The entries of the bidiagonal blocks B11, B12, B21, B22 can
-*> be computed from the angles THETA and PHI. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] PHI
-*> \verbatim
-*> PHI is DOUBLE PRECISION array, dimension (Q-1)
-*> The entries of the bidiagonal blocks B11, B12, B21, B22 can
-*> be computed from the angles THETA and PHI. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP1
-*> \verbatim
-*> TAUP1 is DOUBLE PRECISION array, dimension (P)
-*> The scalar factors of the elementary reflectors that define
-*> P1.
-*> \endverbatim
-*>
-*> \param[out] TAUP2
-*> \verbatim
-*> TAUP2 is DOUBLE PRECISION array, dimension (M-P)
-*> The scalar factors of the elementary reflectors that define
-*> P2.
-*> \endverbatim
-*>
-*> \param[out] TAUQ1
-*> \verbatim
-*> TAUQ1 is DOUBLE PRECISION array, dimension (Q)
-*> The scalar factors of the elementary reflectors that define
-*> Q1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ2
-*> \verbatim
-*> TAUQ2 is DOUBLE PRECISION array, dimension (M-Q)
-*> The scalar factors of the elementary reflectors that define
-*> Q2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= M-Q.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The bidiagonal blocks B11, B12, B21, and B22 are represented
-*> implicitly by angles THETA(1), ..., THETA(Q) and PHI(1), ...,
-*> PHI(Q-1). B11 and B21 are upper bidiagonal, while B21 and B22 are
-*> lower bidiagonal. Every entry in each bidiagonal band is a product
-*> of a sine or cosine of a THETA with a sine or cosine of a PHI. See
-*> [1] or DORCSD for details.
-*>
-*> P1, P2, Q1, and Q2 are represented as products of elementary
-*> reflectors. See DORCSD for details on generating P1, P2, Q1, and Q2
-*> using DORGQR and DORGLQ.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
-*> Algorithms, 50(1):33-65, 2009.
-*>
-* =====================================================================
- SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
- $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,
- $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIGNS, TRANS
- INTEGER INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P,
- $ Q
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION PHI( * ), THETA( * )
- DOUBLE PRECISION TAUP1( * ), TAUP2( * ), TAUQ1( * ), TAUQ2( * ),
- $ WORK( * ), X11( LDX11, * ), X12( LDX12, * ),
- $ X21( LDX21, * ), X22( LDX22, * )
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION REALONE
- PARAMETER ( REALONE = 1.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLMAJOR, LQUERY
- INTEGER I, LWORKMIN, LWORKOPT
- DOUBLE PRECISION Z1, Z2, Z3, Z4
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLARF, DLARFGP, DSCAL, XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DNRM2
- LOGICAL LSAME
- EXTERNAL DNRM2, LSAME
-* ..
-* .. Intrinsic Functions
- INTRINSIC ATAN2, COS, MAX, SIN
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-*
- INFO = 0
- COLMAJOR = .NOT. LSAME( TRANS, 'T' )
- IF( .NOT. LSAME( SIGNS, 'O' ) ) THEN
- Z1 = REALONE
- Z2 = REALONE
- Z3 = REALONE
- Z4 = REALONE
- ELSE
- Z1 = REALONE
- Z2 = -REALONE
- Z3 = REALONE
- Z4 = -REALONE
- END IF
- LQUERY = LWORK .EQ. -1
-*
- IF( M .LT. 0 ) THEN
- INFO = -3
- ELSE IF( P .LT. 0 .OR. P .GT. M ) THEN
- INFO = -4
- ELSE IF( Q .LT. 0 .OR. Q .GT. P .OR. Q .GT. M-P .OR.
- $ Q .GT. M-Q ) THEN
- INFO = -5
- ELSE IF( COLMAJOR .AND. LDX11 .LT. MAX( 1, P ) ) THEN
- INFO = -7
- ELSE IF( .NOT.COLMAJOR .AND. LDX11 .LT. MAX( 1, Q ) ) THEN
- INFO = -7
- ELSE IF( COLMAJOR .AND. LDX12 .LT. MAX( 1, P ) ) THEN
- INFO = -9
- ELSE IF( .NOT.COLMAJOR .AND. LDX12 .LT. MAX( 1, M-Q ) ) THEN
- INFO = -9
- ELSE IF( COLMAJOR .AND. LDX21 .LT. MAX( 1, M-P ) ) THEN
- INFO = -11
- ELSE IF( .NOT.COLMAJOR .AND. LDX21 .LT. MAX( 1, Q ) ) THEN
- INFO = -11
- ELSE IF( COLMAJOR .AND. LDX22 .LT. MAX( 1, M-P ) ) THEN
- INFO = -13
- ELSE IF( .NOT.COLMAJOR .AND. LDX22 .LT. MAX( 1, M-Q ) ) THEN
- INFO = -13
- END IF
-*
-* Compute workspace
-*
- IF( INFO .EQ. 0 ) THEN
- LWORKOPT = M - Q
- LWORKMIN = M - Q
- WORK(1) = LWORKOPT
- IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN
- INFO = -21
- END IF
- END IF
- IF( INFO .NE. 0 ) THEN
- CALL XERBLA( 'xORBDB', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Handle column-major and row-major separately
-*
- IF( COLMAJOR ) THEN
-*
-* Reduce columns 1, ..., Q of X11, X12, X21, and X22
-*
- DO I = 1, Q
-*
- IF( I .EQ. 1 ) THEN
- CALL DSCAL( P-I+1, Z1, X11(I,I), 1 )
- ELSE
- CALL DSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), 1 )
- CALL DAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I,I-1),
- $ 1, X11(I,I), 1 )
- END IF
- IF( I .EQ. 1 ) THEN
- CALL DSCAL( M-P-I+1, Z2, X21(I,I), 1 )
- ELSE
- CALL DSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), 1 )
- CALL DAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I,I-1),
- $ 1, X21(I,I), 1 )
- END IF
-*
- THETA(I) = ATAN2( DNRM2( M-P-I+1, X21(I,I), 1 ),
- $ DNRM2( P-I+1, X11(I,I), 1 ) )
-*
- CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
- X11(I,I) = ONE
- CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
- X21(I,I) = ONE
-*
- CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
- $ X11(I,I+1), LDX11, WORK )
- CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I),
- $ X12(I,I), LDX12, WORK )
- CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
- $ X21(I,I+1), LDX21, WORK )
- CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I),
- $ X22(I,I), LDX22, WORK )
-*
- IF( I .LT. Q ) THEN
- CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1),
- $ LDX11 )
- CALL DAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I,I+1), LDX21,
- $ X11(I,I+1), LDX11 )
- END IF
- CALL DSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), LDX12 )
- CALL DAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), LDX22,
- $ X12(I,I), LDX12 )
-*
- IF( I .LT. Q )
- $ PHI(I) = ATAN2( DNRM2( Q-I, X11(I,I+1), LDX11 ),
- $ DNRM2( M-Q-I+1, X12(I,I), LDX12 ) )
-*
- IF( I .LT. Q ) THEN
- CALL DLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11,
- $ TAUQ1(I) )
- X11(I,I+1) = ONE
- END IF
- CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,
- $ TAUQ2(I) )
- X12(I,I) = ONE
-*
- IF( I .LT. Q ) THEN
- CALL DLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I),
- $ X11(I+1,I+1), LDX11, WORK )
- CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I),
- $ X21(I+1,I+1), LDX21, WORK )
- END IF
- CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
- $ X12(I+1,I), LDX12, WORK )
- CALL DLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
- $ X22(I+1,I), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns Q + 1, ..., P of X12, X22
-*
- DO I = Q + 1, P
-*
- CALL DSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), LDX12 )
- CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,
- $ TAUQ2(I) )
- X12(I,I) = ONE
-*
- CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
- $ X12(I+1,I), LDX12, WORK )
- IF( M-P-Q .GE. 1 )
- $ CALL DLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12,
- $ TAUQ2(I), X22(Q+1,I), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns P + 1, ..., M - Q of X12, X22
-*
- DO I = 1, M - P - Q
-*
- CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(Q+I,P+I), LDX22 )
- CALL DLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1),
- $ LDX22, TAUQ2(P+I) )
- X22(Q+I,P+I) = ONE
- CALL DLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22,
- $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK )
-*
- END DO
-*
- ELSE
-*
-* Reduce columns 1, ..., Q of X11, X12, X21, X22
-*
- DO I = 1, Q
-*
- IF( I .EQ. 1 ) THEN
- CALL DSCAL( P-I+1, Z1, X11(I,I), LDX11 )
- ELSE
- CALL DSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), LDX11 )
- CALL DAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I-1,I),
- $ LDX12, X11(I,I), LDX11 )
- END IF
- IF( I .EQ. 1 ) THEN
- CALL DSCAL( M-P-I+1, Z2, X21(I,I), LDX21 )
- ELSE
- CALL DSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), LDX21 )
- CALL DAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I-1,I),
- $ LDX22, X21(I,I), LDX21 )
- END IF
-*
- THETA(I) = ATAN2( DNRM2( M-P-I+1, X21(I,I), LDX21 ),
- $ DNRM2( P-I+1, X11(I,I), LDX11 ) )
-*
- CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) )
- X11(I,I) = ONE
- CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21,
- $ TAUP2(I) )
- X21(I,I) = ONE
-*
- CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I),
- $ X11(I+1,I), LDX11, WORK )
- CALL DLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, TAUP1(I),
- $ X12(I,I), LDX12, WORK )
- CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I),
- $ X21(I+1,I), LDX21, WORK )
- CALL DLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21,
- $ TAUP2(I), X22(I,I), LDX22, WORK )
-*
- IF( I .LT. Q ) THEN
- CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I+1,I), 1 )
- CALL DAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I+1,I), 1,
- $ X11(I+1,I), 1 )
- END IF
- CALL DSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), 1 )
- CALL DAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), 1,
- $ X12(I,I), 1 )
-*
- IF( I .LT. Q )
- $ PHI(I) = ATAN2( DNRM2( Q-I, X11(I+1,I), 1 ),
- $ DNRM2( M-Q-I+1, X12(I,I), 1 ) )
-*
- IF( I .LT. Q ) THEN
- CALL DLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, TAUQ1(I) )
- X11(I+1,I) = ONE
- END IF
- CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )
- X12(I,I) = ONE
-*
- IF( I .LT. Q ) THEN
- CALL DLARF( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I),
- $ X11(I+1,I+1), LDX11, WORK )
- CALL DLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I),
- $ X21(I+1,I+1), LDX21, WORK )
- END IF
- CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
- $ X12(I,I+1), LDX12, WORK )
- CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I),
- $ X22(I,I+1), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns Q + 1, ..., P of X12, X22
-*
- DO I = Q + 1, P
-*
- CALL DSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), 1 )
- CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )
- X12(I,I) = ONE
-*
- CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
- $ X12(I,I+1), LDX12, WORK )
- IF( M-P-Q .GE. 1 )
- $ CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I),
- $ X22(I,Q+1), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns P + 1, ..., M - Q of X12, X22
-*
- DO I = 1, M - P - Q
-*
- CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(P+I,Q+I), 1 )
- CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1,
- $ TAUQ2(P+I) )
- X22(P+I,Q+I) = ONE
-*
- CALL DLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1,
- $ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK )
-*
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of DORBDB
-*
- END
-
diff --git a/netlib/LAPACK/dorcsd.f b/netlib/LAPACK/dorcsd.f
deleted file mode 100644
index 927bf66..0000000
--- a/netlib/LAPACK/dorcsd.f
+++ /dev/null
@@ -1,598 +0,0 @@
-*> \brief \b DORCSD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORCSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorcsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorcsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorcsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS,
-* SIGNS, M, P, Q, X11, LDX11, X12,
-* LDX12, X21, LDX21, X22, LDX22, THETA,
-* U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
-* LDV2T, WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
-* INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LDX11, LDX12,
-* $ LDX21, LDX22, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION THETA( * )
-* DOUBLE PRECISION U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
-* $ V2T( LDV2T, * ), WORK( * ), X11( LDX11, * ),
-* $ X12( LDX12, * ), X21( LDX21, * ), X22( LDX22,
-* $ * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORCSD computes the CS decomposition of an M-by-M partitioned
-*> orthogonal matrix X:
-*>
-*> [ I 0 0 | 0 0 0 ]
-*> [ 0 C 0 | 0 -S 0 ]
-*> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T
-*> X = [-----------] = [---------] [---------------------] [---------] .
-*> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ]
-*> [ 0 S 0 | 0 C 0 ]
-*> [ 0 0 I | 0 0 0 ]
-*>
-*> X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P,
-*> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are
-*> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in
-*> which R = MIN(P,M-P,Q,M-Q).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU1
-*> \verbatim
-*> JOBU1 is CHARACTER
-*> = 'Y': U1 is computed;
-*> otherwise: U1 is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBU2
-*> \verbatim
-*> JOBU2 is CHARACTER
-*> = 'Y': U2 is computed;
-*> otherwise: U2 is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV1T
-*> \verbatim
-*> JOBV1T is CHARACTER
-*> = 'Y': V1T is computed;
-*> otherwise: V1T is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV2T
-*> \verbatim
-*> JOBV2T is CHARACTER
-*> = 'Y': V2T is computed;
-*> otherwise: V2T is not computed.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER
-*> = 'T': X, U1, U2, V1T, and V2T are stored in row-major
-*> order;
-*> otherwise: X, U1, U2, V1T, and V2T are stored in column-
-*> major order.
-*> \endverbatim
-*>
-*> \param[in] SIGNS
-*> \verbatim
-*> SIGNS is CHARACTER
-*> = 'O': The lower-left block is made nonpositive (the
-*> "other" convention);
-*> otherwise: The upper-right block is made nonpositive (the
-*> "default" convention).
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows and columns in X.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows in X11 and X12. 0 <= P <= M.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is INTEGER
-*> The number of columns in X11 and X21. 0 <= Q <= M.
-*> \endverbatim
-*>
-*> \param[in,out] X11
-*> \verbatim
-*> X11 is DOUBLE PRECISION array, dimension (LDX11,Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX11
-*> \verbatim
-*> LDX11 is INTEGER
-*> The leading dimension of X11. LDX11 >= MAX(1,P).
-*> \endverbatim
-*>
-*> \param[in,out] X12
-*> \verbatim
-*> X12 is DOUBLE PRECISION array, dimension (LDX12,M-Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX12
-*> \verbatim
-*> LDX12 is INTEGER
-*> The leading dimension of X12. LDX12 >= MAX(1,P).
-*> \endverbatim
-*>
-*> \param[in,out] X21
-*> \verbatim
-*> X21 is DOUBLE PRECISION array, dimension (LDX21,Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX21
-*> \verbatim
-*> LDX21 is INTEGER
-*> The leading dimension of X11. LDX21 >= MAX(1,M-P).
-*> \endverbatim
-*>
-*> \param[in,out] X22
-*> \verbatim
-*> X22 is DOUBLE PRECISION array, dimension (LDX22,M-Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX22
-*> \verbatim
-*> LDX22 is INTEGER
-*> The leading dimension of X11. LDX22 >= MAX(1,M-P).
-*> \endverbatim
-*>
-*> \param[out] THETA
-*> \verbatim
-*> THETA is DOUBLE PRECISION array, dimension (R), in which R =
-*> MIN(P,M-P,Q,M-Q).
-*> C = DIAG( COS(THETA(1)), ... , COS(THETA(R)) ) and
-*> S = DIAG( SIN(THETA(1)), ... , SIN(THETA(R)) ).
-*> \endverbatim
-*>
-*> \param[out] U1
-*> \verbatim
-*> U1 is DOUBLE PRECISION array, dimension (P)
-*> If JOBU1 = 'Y', U1 contains the P-by-P orthogonal matrix U1.
-*> \endverbatim
-*>
-*> \param[in] LDU1
-*> \verbatim
-*> LDU1 is INTEGER
-*> The leading dimension of U1. If JOBU1 = 'Y', LDU1 >=
-*> MAX(1,P).
-*> \endverbatim
-*>
-*> \param[out] U2
-*> \verbatim
-*> U2 is DOUBLE PRECISION array, dimension (M-P)
-*> If JOBU2 = 'Y', U2 contains the (M-P)-by-(M-P) orthogonal
-*> matrix U2.
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of U2. If JOBU2 = 'Y', LDU2 >=
-*> MAX(1,M-P).
-*> \endverbatim
-*>
-*> \param[out] V1T
-*> \verbatim
-*> V1T is DOUBLE PRECISION array, dimension (Q)
-*> If JOBV1T = 'Y', V1T contains the Q-by-Q matrix orthogonal
-*> matrix V1**T.
-*> \endverbatim
-*>
-*> \param[in] LDV1T
-*> \verbatim
-*> LDV1T is INTEGER
-*> The leading dimension of V1T. If JOBV1T = 'Y', LDV1T >=
-*> MAX(1,Q).
-*> \endverbatim
-*>
-*> \param[out] V2T
-*> \verbatim
-*> V2T is DOUBLE PRECISION array, dimension (M-Q)
-*> If JOBV2T = 'Y', V2T contains the (M-Q)-by-(M-Q) orthogonal
-*> matrix V2**T.
-*> \endverbatim
-*>
-*> \param[in] LDV2T
-*> \verbatim
-*> LDV2T is INTEGER
-*> The leading dimension of V2T. If JOBV2T = 'Y', LDV2T >=
-*> MAX(1,M-Q).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> If INFO > 0 on exit, WORK(2:R) contains the values PHI(1),
-*> ..., PHI(R-1) that, together with THETA(1), ..., THETA(R),
-*> define the matrix in intermediate bidiagonal-block form
-*> remaining after nonconvergence. INFO specifies the number
-*> of nonzero PHI's.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the work array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (M-MIN(P, M-P, Q, M-Q))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: DBBCSD did not converge. See the description of WORK
-*> above for details.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
-*> Algorithms, 50(1):33-65, 2009.
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS,
- $ SIGNS, M, P, Q, X11, LDX11, X12,
- $ LDX12, X21, LDX21, X22, LDX22, THETA,
- $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
- $ LDV2T, WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
- INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LDX11, LDX12,
- $ LDX21, LDX22, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION THETA( * )
- DOUBLE PRECISION U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
- $ V2T( LDV2T, * ), WORK( * ), X11( LDX11, * ),
- $ X12( LDX12, * ), X21( LDX21, * ), X22( LDX22,
- $ * )
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D0,
- $ ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST, SIGNST
- INTEGER CHILDINFO, I, IB11D, IB11E, IB12D, IB12E,
- $ IB21D, IB21E, IB22D, IB22E, IBBCSD, IORBDB,
- $ IORGLQ, IORGQR, IPHI, ITAUP1, ITAUP2, ITAUQ1,
- $ ITAUQ2, J, LBBCSDWORK, LBBCSDWORKMIN,
- $ LBBCSDWORKOPT, LORBDBWORK, LORBDBWORKMIN,
- $ LORBDBWORKOPT, LORGLQWORK, LORGLQWORKMIN,
- $ LORGLQWORKOPT, LORGQRWORK, LORGQRWORKMIN,
- $ LORGQRWORKOPT, LWORKMIN, LWORKOPT
- LOGICAL COLMAJOR, DEFAULTSIGNS, LQUERY, WANTU1, WANTU2,
- $ WANTV1T, WANTV2T
-* ..
-* .. External Subroutines ..
- EXTERNAL DBBCSD, DLACPY, DLAPMR, DLAPMT, DLASCL, DLASET,
- $ DORBDB, DORGLQ, DORGQR, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-*
- INFO = 0
- WANTU1 = LSAME( JOBU1, 'Y' )
- WANTU2 = LSAME( JOBU2, 'Y' )
- WANTV1T = LSAME( JOBV1T, 'Y' )
- WANTV2T = LSAME( JOBV2T, 'Y' )
- COLMAJOR = .NOT. LSAME( TRANS, 'T' )
- DEFAULTSIGNS = .NOT. LSAME( SIGNS, 'O' )
- LQUERY = LWORK .EQ. -1
- IF( M .LT. 0 ) THEN
- INFO = -7
- ELSE IF( P .LT. 0 .OR. P .GT. M ) THEN
- INFO = -8
- ELSE IF( Q .LT. 0 .OR. Q .GT. M ) THEN
- INFO = -9
- ELSE IF( ( COLMAJOR .AND. LDX11 .LT. MAX(1,P) ) .OR.
- $ ( .NOT.COLMAJOR .AND. LDX11 .LT. MAX(1,Q) ) ) THEN
- INFO = -11
- ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN
- INFO = -20
- ELSE IF( WANTU2 .AND. LDU2 .LT. M-P ) THEN
- INFO = -22
- ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN
- INFO = -24
- ELSE IF( WANTV2T .AND. LDV2T .LT. M-Q ) THEN
- INFO = -26
- END IF
-*
-* Work with transpose if convenient
-*
- IF( INFO .EQ. 0 .AND. MIN( P, M-P ) .LT. MIN( Q, M-Q ) ) THEN
- IF( COLMAJOR ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
- IF( DEFAULTSIGNS ) THEN
- SIGNST = 'O'
- ELSE
- SIGNST = 'D'
- END IF
- CALL DORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M,
- $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22,
- $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1,
- $ U2, LDU2, WORK, LWORK, IWORK, INFO )
- RETURN
- END IF
-*
-* Work with permutation [ 0 I; I 0 ] * X * [ 0 I; I 0 ] if
-* convenient
-*
- IF( INFO .EQ. 0 .AND. M-Q .LT. Q ) THEN
- IF( DEFAULTSIGNS ) THEN
- SIGNST = 'O'
- ELSE
- SIGNST = 'D'
- END IF
- CALL DORCSD( JOBU2, JOBU1, JOBV2T, JOBV1T, TRANS, SIGNST, M,
- $ M-P, M-Q, X22, LDX22, X21, LDX21, X12, LDX12, X11,
- $ LDX11, THETA, U2, LDU2, U1, LDU1, V2T, LDV2T, V1T,
- $ LDV1T, WORK, LWORK, IWORK, INFO )
- RETURN
- END IF
-*
-* Compute workspace
-*
- IF( INFO .EQ. 0 ) THEN
-*
- IPHI = 2
- ITAUP1 = IPHI + MAX( 1, Q - 1 )
- ITAUP2 = ITAUP1 + MAX( 1, P )
- ITAUQ1 = ITAUP2 + MAX( 1, M - P )
- ITAUQ2 = ITAUQ1 + MAX( 1, Q )
- IORGQR = ITAUQ2 + MAX( 1, M - Q )
- CALL DORGQR( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), 0, WORK, -1,
- $ CHILDINFO )
- LORGQRWORKOPT = INT( WORK(1) )
- LORGQRWORKMIN = MAX( 1, M - Q )
- IORGLQ = ITAUQ2 + MAX( 1, M - Q )
- CALL DORGLQ( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), 0, WORK, -1,
- $ CHILDINFO )
- LORGLQWORKOPT = INT( WORK(1) )
- LORGLQWORKMIN = MAX( 1, M - Q )
- IORBDB = ITAUQ2 + MAX( 1, M - Q )
- CALL DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
- $ X21, LDX21, X22, LDX22, 0, 0, 0, 0, 0, 0, WORK,
- $ -1, CHILDINFO )
- LORBDBWORKOPT = INT( WORK(1) )
- LORBDBWORKMIN = LORBDBWORKOPT
- IB11D = ITAUQ2 + MAX( 1, M - Q )
- IB11E = IB11D + MAX( 1, Q )
- IB12D = IB11E + MAX( 1, Q - 1 )
- IB12E = IB12D + MAX( 1, Q )
- IB21D = IB12E + MAX( 1, Q - 1 )
- IB21E = IB21D + MAX( 1, Q )
- IB22D = IB21E + MAX( 1, Q - 1 )
- IB22E = IB22D + MAX( 1, Q )
- IBBCSD = IB22E + MAX( 1, Q - 1 )
- CALL DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, 0,
- $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, LDV2T, 0,
- $ 0, 0, 0, 0, 0, 0, 0, WORK, -1, CHILDINFO )
- LBBCSDWORKOPT = INT( WORK(1) )
- LBBCSDWORKMIN = LBBCSDWORKOPT
- LWORKOPT = MAX( IORGQR + LORGQRWORKOPT, IORGLQ + LORGLQWORKOPT,
- $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKOPT ) - 1
- LWORKMIN = MAX( IORGQR + LORGQRWORKMIN, IORGLQ + LORGLQWORKMIN,
- $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKMIN ) - 1
- WORK(1) = MAX(LWORKOPT,LWORKMIN)
-*
- IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN
- INFO = -22
- ELSE
- LORGQRWORK = LWORK - IORGQR + 1
- LORGLQWORK = LWORK - IORGLQ + 1
- LORBDBWORK = LWORK - IORBDB + 1
- LBBCSDWORK = LWORK - IBBCSD + 1
- END IF
- END IF
-*
-* Abort if any illegal arguments
-*
- IF( INFO .NE. 0 ) THEN
- CALL XERBLA( 'DORCSD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Transform to bidiagonal block form
-*
- CALL DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21,
- $ LDX21, X22, LDX22, THETA, WORK(IPHI), WORK(ITAUP1),
- $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2),
- $ WORK(IORBDB), LORBDBWORK, CHILDINFO )
-*
-* Accumulate Householder reflectors
-*
- IF( COLMAJOR ) THEN
- IF( WANTU1 .AND. P .GT. 0 ) THEN
- CALL DLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 )
- CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR),
- $ LORGQRWORK, INFO)
- END IF
- IF( WANTU2 .AND. M-P .GT. 0 ) THEN
- CALL DLACPY( 'L', M-P, Q, X21, LDX21, U2, LDU2 )
- CALL DORGQR( M-P, M-P, Q, U2, LDU2, WORK(ITAUP2),
- $ WORK(IORGQR), LORGQRWORK, INFO )
- END IF
- IF( WANTV1T .AND. Q .GT. 0 ) THEN
- CALL DLACPY( 'U', Q-1, Q-1, X11(1,2), LDX11, V1T(2,2),
- $ LDV1T )
- V1T(1, 1) = ONE
- DO J = 2, Q
- V1T(1,J) = ZERO
- V1T(J,1) = ZERO
- END DO
- CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1),
- $ WORK(IORGLQ), LORGLQWORK, INFO )
- END IF
- IF( WANTV2T .AND. M-Q .GT. 0 ) THEN
- CALL DLACPY( 'U', P, M-Q, X12, LDX12, V2T, LDV2T )
- CALL DLACPY( 'U', M-P-Q, M-P-Q, X22(Q+1,P+1), LDX22,
- $ V2T(P+1,P+1), LDV2T )
- CALL DORGLQ( M-Q, M-Q, M-Q, V2T, LDV2T, WORK(ITAUQ2),
- $ WORK(IORGLQ), LORGLQWORK, INFO )
- END IF
- ELSE
- IF( WANTU1 .AND. P .GT. 0 ) THEN
- CALL DLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 )
- CALL DORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ),
- $ LORGLQWORK, INFO)
- END IF
- IF( WANTU2 .AND. M-P .GT. 0 ) THEN
- CALL DLACPY( 'U', Q, M-P, X21, LDX21, U2, LDU2 )
- CALL DORGLQ( M-P, M-P, Q, U2, LDU2, WORK(ITAUP2),
- $ WORK(IORGLQ), LORGLQWORK, INFO )
- END IF
- IF( WANTV1T .AND. Q .GT. 0 ) THEN
- CALL DLACPY( 'L', Q-1, Q-1, X11(2,1), LDX11, V1T(2,2),
- $ LDV1T )
- V1T(1, 1) = ONE
- DO J = 2, Q
- V1T(1,J) = ZERO
- V1T(J,1) = ZERO
- END DO
- CALL DORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1),
- $ WORK(IORGQR), LORGQRWORK, INFO )
- END IF
- IF( WANTV2T .AND. M-Q .GT. 0 ) THEN
- CALL DLACPY( 'L', M-Q, P, X12, LDX12, V2T, LDV2T )
- CALL DLACPY( 'L', M-P-Q, M-P-Q, X22(P+1,Q+1), LDX22,
- $ V2T(P+1,P+1), LDV2T )
- CALL DORGQR( M-Q, M-Q, M-Q, V2T, LDV2T, WORK(ITAUQ2),
- $ WORK(IORGQR), LORGQRWORK, INFO )
- END IF
- END IF
-*
-* Compute the CSD of the matrix in bidiagonal-block form
-*
- CALL DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA,
- $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
- $ LDV2T, WORK(IB11D), WORK(IB11E), WORK(IB12D),
- $ WORK(IB12E), WORK(IB21D), WORK(IB21E), WORK(IB22D),
- $ WORK(IB22E), WORK(IBBCSD), LBBCSDWORK, INFO )
-*
-* Permute rows and columns to place identity submatrices in top-
-* left corner of (1,1)-block and/or bottom-right corner of (1,2)-
-* block and/or bottom-right corner of (2,1)-block and/or top-left
-* corner of (2,2)-block
-*
- IF( Q .GT. 0 .AND. WANTU2 ) THEN
- DO I = 1, Q
- IWORK(I) = M - P - Q + I
- END DO
- DO I = Q + 1, M - P
- IWORK(I) = I - Q
- END DO
- IF( COLMAJOR ) THEN
- CALL DLAPMT( .FALSE., M-P, M-P, U2, LDU2, IWORK )
- ELSE
- CALL DLAPMR( .FALSE., M-P, M-P, U2, LDU2, IWORK )
- END IF
- END IF
- IF( M .GT. 0 .AND. WANTV2T ) THEN
- DO I = 1, P
- IWORK(I) = M - P - Q + I
- END DO
- DO I = P + 1, M - Q
- IWORK(I) = I - P
- END DO
- IF( .NOT. COLMAJOR ) THEN
- CALL DLAPMT( .FALSE., M-Q, M-Q, V2T, LDV2T, IWORK )
- ELSE
- CALL DLAPMR( .FALSE., M-Q, M-Q, V2T, LDV2T, IWORK )
- END IF
- END IF
-*
- RETURN
-*
-* End DORCSD
-*
- END
-
diff --git a/netlib/LAPACK/dorg2l.f b/netlib/LAPACK/dorg2l.f
deleted file mode 100644
index b95fa50..0000000
--- a/netlib/LAPACK/dorg2l.f
+++ /dev/null
@@ -1,198 +0,0 @@
-*> \brief \b DORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORG2L + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorg2l.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorg2l.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorg2l.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORG2L generates an m by n real matrix Q with orthonormal columns,
-*> which is defined as the last n columns of a product of k elementary
-*> reflectors of order m
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGEQLF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the (n-k+i)-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGEQLF in the last k columns of its array
-*> argument A.
-*> On exit, the m by n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGEQLF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, II, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORG2L', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Initialise columns 1:n-k to columns of the unit matrix
-*
- DO 20 J = 1, N - K
- DO 10 L = 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- A( M-N+J, J ) = ONE
- 20 CONTINUE
-*
- DO 40 I = 1, K
- II = N - K + I
-*
-* Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
-*
- A( M-N+II, II ) = ONE
- CALL DLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
- $ LDA, WORK )
- CALL DSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
- A( M-N+II, II ) = ONE - TAU( I )
-*
-* Set A(m-k+i+1:m,n-k+i) to zero
-*
- DO 30 L = M - N + II + 1, M
- A( L, II ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of DORG2L
-*
- END
diff --git a/netlib/LAPACK/dorg2r.f b/netlib/LAPACK/dorg2r.f
deleted file mode 100644
index 86df6dd..0000000
--- a/netlib/LAPACK/dorg2r.f
+++ /dev/null
@@ -1,200 +0,0 @@
-*> \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORG2R + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorg2r.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorg2r.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorg2r.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORG2R generates an m by n real matrix Q with orthonormal columns,
-*> which is defined as the first n columns of a product of k elementary
-*> reflectors of order m
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGEQRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGEQRF in the first k columns of its array
-*> argument A.
-*> On exit, the m-by-n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORG2R', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Initialise columns k+1:n to columns of the unit matrix
-*
- DO 20 J = K + 1, N
- DO 10 L = 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- A( J, J ) = ONE
- 20 CONTINUE
-*
- DO 40 I = K, 1, -1
-*
-* Apply H(i) to A(i:m,i:n) from the left
-*
- IF( I.LT.N ) THEN
- A( I, I ) = ONE
- CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- END IF
- IF( I.LT.M )
- $ CALL DSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
- A( I, I ) = ONE - TAU( I )
-*
-* Set A(1:i-1,i) to zero
-*
- DO 30 L = 1, I - 1
- A( L, I ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of DORG2R
-*
- END
diff --git a/netlib/LAPACK/dorgbr.f b/netlib/LAPACK/dorgbr.f
deleted file mode 100644
index ddfa726..0000000
--- a/netlib/LAPACK/dorgbr.f
+++ /dev/null
@@ -1,338 +0,0 @@
-*> \brief \b DORGBR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGBR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgbr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgbr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgbr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER VECT
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGBR generates one of the real orthogonal matrices Q or P**T
-*> determined by DGEBRD when reducing a real matrix A to bidiagonal
-*> form: A = Q * B * P**T. Q and P**T are defined as products of
-*> elementary reflectors H(i) or G(i) respectively.
-*>
-*> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
-*> is of order M:
-*> if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
-*> columns of Q, where m >= n >= k;
-*> if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
-*> M-by-M matrix.
-*>
-*> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
-*> is of order N:
-*> if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
-*> rows of P**T, where n >= m >= k;
-*> if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
-*> an N-by-N matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> Specifies whether the matrix Q or the matrix P**T is
-*> required, as defined in the transformation applied by DGEBRD:
-*> = 'Q': generate Q;
-*> = 'P': generate P**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q or P**T to be returned.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q or P**T to be returned.
-*> N >= 0.
-*> If VECT = 'Q', M >= N >= min(M,K);
-*> if VECT = 'P', N >= M >= min(N,K).
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> If VECT = 'Q', the number of columns in the original M-by-K
-*> matrix reduced by DGEBRD.
-*> If VECT = 'P', the number of rows in the original K-by-N
-*> matrix reduced by DGEBRD.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by DGEBRD.
-*> On exit, the M-by-N matrix Q or P**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension
-*> (min(M,K)) if VECT = 'Q'
-*> (min(N,K)) if VECT = 'P'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i) or G(i), which determines Q or P**T, as
-*> returned by DGEBRD in its array argument TAUQ or TAUP.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,min(M,N)).
-*> For optimum performance LWORK >= min(M,N)*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER VECT
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTQ
- INTEGER I, IINFO, J, LWKOPT, MN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORGLQ, DORGQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- WANTQ = LSAME( VECT, 'Q' )
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
- $ K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
- $ MIN( N, K ) ) ) ) THEN
- INFO = -3
- ELSE IF( K.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = 1
- IF( WANTQ ) THEN
- IF( M.GE.K ) THEN
- CALL DORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
- ELSE
- IF( M.GT.1 ) THEN
- CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
- $ -1, IINFO )
- END IF
- END IF
- ELSE
- IF( K.LT.N ) THEN
- CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
- ELSE
- IF( N.GT.1 ) THEN
- CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ -1, IINFO )
- END IF
- END IF
- END IF
- LWKOPT = WORK( 1 )
- LWKOPT = MAX (LWKOPT, MN)
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGBR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- WORK( 1 ) = LWKOPT
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( WANTQ ) THEN
-*
-* Form Q, determined by a call to DGEBRD to reduce an m-by-k
-* matrix
-*
- IF( M.GE.K ) THEN
-*
-* If m >= k, assume m >= n >= k
-*
- CALL DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* If m < k, assume m = n
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first row and column of Q
-* to those of the unit matrix
-*
- DO 20 J = M, 2, -1
- A( 1, J ) = ZERO
- DO 10 I = J + 1, M
- A( I, J ) = A( I, J-1 )
- 10 CONTINUE
- 20 CONTINUE
- A( 1, 1 ) = ONE
- DO 30 I = 2, M
- A( I, 1 ) = ZERO
- 30 CONTINUE
- IF( M.GT.1 ) THEN
-*
-* Form Q(2:m,2:m)
-*
- CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- ELSE
-*
-* Form P**T, determined by a call to DGEBRD to reduce a k-by-n
-* matrix
-*
- IF( K.LT.N ) THEN
-*
-* If k < n, assume k <= m <= n
-*
- CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* If k >= n, assume m = n
-*
-* Shift the vectors which define the elementary reflectors one
-* row downward, and set the first row and column of P**T to
-* those of the unit matrix
-*
- A( 1, 1 ) = ONE
- DO 40 I = 2, N
- A( I, 1 ) = ZERO
- 40 CONTINUE
- DO 60 J = 2, N
- DO 50 I = J - 1, 2, -1
- A( I, J ) = A( I-1, J )
- 50 CONTINUE
- A( 1, J ) = ZERO
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Form P**T(2:n,2:n)
-*
- CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORGBR
-*
- END
diff --git a/netlib/LAPACK/dorghr.f b/netlib/LAPACK/dorghr.f
deleted file mode 100644
index 48f504e..0000000
--- a/netlib/LAPACK/dorghr.f
+++ /dev/null
@@ -1,240 +0,0 @@
-*> \brief \b DORGHR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGHR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorghr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorghr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorghr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGHR generates a real orthogonal matrix Q which is defined as the
-*> product of IHI-ILO elementary reflectors of order N, as returned by
-*> DGEHRD:
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI must have the same values as in the previous call
-*> of DGEHRD. Q is equal to the unit matrix except in the
-*> submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by DGEHRD.
-*> On exit, the N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEHRD.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= IHI-ILO.
-*> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IINFO, J, LWKOPT, NB, NH
-* ..
-* .. External Subroutines ..
- EXTERNAL DORGQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NH = IHI - ILO
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'DORGQR', ' ', NH, NH, NH, -1 )
- LWKOPT = MAX( 1, NH )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGHR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first ilo and the last n-ihi
-* rows and columns to those of the unit matrix
-*
- DO 40 J = IHI, ILO + 1, -1
- DO 10 I = 1, J - 1
- A( I, J ) = ZERO
- 10 CONTINUE
- DO 20 I = J + 1, IHI
- A( I, J ) = A( I, J-1 )
- 20 CONTINUE
- DO 30 I = IHI + 1, N
- A( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- DO 60 J = 1, ILO
- DO 50 I = 1, N
- A( I, J ) = ZERO
- 50 CONTINUE
- A( J, J ) = ONE
- 60 CONTINUE
- DO 80 J = IHI + 1, N
- DO 70 I = 1, N
- A( I, J ) = ZERO
- 70 CONTINUE
- A( J, J ) = ONE
- 80 CONTINUE
-*
- IF( NH.GT.0 ) THEN
-*
-* Generate Q(ilo+1:ihi,ilo+1:ihi)
-*
- CALL DORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
- $ WORK, LWORK, IINFO )
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORGHR
-*
- END
diff --git a/netlib/LAPACK/dorgl2.f b/netlib/LAPACK/dorgl2.f
deleted file mode 100644
index 3e8398b..0000000
--- a/netlib/LAPACK/dorgl2.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DORGL2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgl2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgl2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgl2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGL2 generates an m by n real matrix Q with orthonormal rows,
-*> which is defined as the first m rows of a product of k elementary
-*> reflectors of order n
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGELQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th row must contain the vector which defines
-*> the elementary reflector H(i), for i = 1,2,...,k, as returned
-*> by DGELQF in the first k rows of its array argument A.
-*> On exit, the m-by-n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGL2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 )
- $ RETURN
-*
- IF( K.LT.M ) THEN
-*
-* Initialise rows k+1:m to rows of the unit matrix
-*
- DO 20 J = 1, N
- DO 10 L = K + 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- IF( J.GT.K .AND. J.LE.M )
- $ A( J, J ) = ONE
- 20 CONTINUE
- END IF
-*
- DO 40 I = K, 1, -1
-*
-* Apply H(i) to A(i:m,i:n) from the right
-*
- IF( I.LT.N ) THEN
- IF( I.LT.M ) THEN
- A( I, I ) = ONE
- CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
- $ TAU( I ), A( I+1, I ), LDA, WORK )
- END IF
- CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
- END IF
- A( I, I ) = ONE - TAU( I )
-*
-* Set A(i,1:i-1) to zero
-*
- DO 30 L = 1, I - 1
- A( I, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of DORGL2
-*
- END
diff --git a/netlib/LAPACK/dorglq.f b/netlib/LAPACK/dorglq.f
deleted file mode 100644
index 88aec15..0000000
--- a/netlib/LAPACK/dorglq.f
+++ /dev/null
@@ -1,289 +0,0 @@
-*> \brief \b DORGLQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGLQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorglq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorglq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorglq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGLQ generates an M-by-N real matrix Q with orthonormal rows,
-*> which is defined as the first M rows of a product of K elementary
-*> reflectors of order N
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGELQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th row must contain the vector which defines
-*> the elementary reflector H(i), for i = 1,2,...,k, as returned
-*> by DGELQF in the first k rows of its array argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORGL2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
- LWKOPT = MAX( 1, M )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGLQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DORGLQ', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORGLQ', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the last block.
-* The first kk rows are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
-* Set A(kk+1:m,1:kk) to zero.
-*
- DO 20 J = 1, KK
- DO 10 I = KK + 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the last or only block.
-*
- IF( KK.LT.M )
- $ CALL DORGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
- $ TAU( KK+1 ), WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = KI + 1, 1, -NB
- IB = MIN( NB, K-I+1 )
- IF( I+IB.LE.M ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i+ib:m,i:n) from the right
-*
- CALL DLARFB( 'Right', 'Transpose', 'Forward', 'Rowwise',
- $ M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK,
- $ LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ),
- $ LDWORK )
- END IF
-*
-* Apply H**T to columns i:n of current block
-*
- CALL DORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
-* Set columns 1:i-1 of current block to zero
-*
- DO 40 J = 1, I - 1
- DO 30 L = I, I + IB - 1
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DORGLQ
-*
- END
diff --git a/netlib/LAPACK/dorgql.f b/netlib/LAPACK/dorgql.f
deleted file mode 100644
index ca4698d..0000000
--- a/netlib/LAPACK/dorgql.f
+++ /dev/null
@@ -1,296 +0,0 @@
-*> \brief \b DORGQL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGQL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgql.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgql.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgql.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGQL generates an M-by-N real matrix Q with orthonormal columns,
-*> which is defined as the last N columns of a product of K elementary
-*> reflectors of order M
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGEQLF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the (n-k+i)-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGEQLF in the last k columns of its array
-*> argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGEQLF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
- $ NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORG2L, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'DORGQL', ' ', M, N, K, -1 )
- LWKOPT = N*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGQL', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DORGQL', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORGQL', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the first block.
-* The last kk columns are handled by the block method.
-*
- KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-* Set A(m-kk+1:m,1:n-kk) to zero.
-*
- DO 20 J = 1, N - KK
- DO 10 I = M - KK + 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the first or only block.
-*
- CALL DORG2L( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = K - KK + 1, K, NB
- IB = MIN( NB, K-I+1 )
- IF( N-K+I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
- $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
- CALL DLARFB( 'Left', 'No transpose', 'Backward',
- $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
- $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H to rows 1:m-k+i+ib-1 of current block
-*
- CALL DORG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
- $ TAU( I ), WORK, IINFO )
-*
-* Set rows m-k+i+ib:m of current block to zero
-*
- DO 40 J = N - K + I, N - K + I + IB - 1
- DO 30 L = M - K + I + IB, M
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DORGQL
-*
- END
diff --git a/netlib/LAPACK/dorgqr.f b/netlib/LAPACK/dorgqr.f
deleted file mode 100644
index 404ab18..0000000
--- a/netlib/LAPACK/dorgqr.f
+++ /dev/null
@@ -1,290 +0,0 @@
-*> \brief \b DORGQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGQR generates an M-by-N real matrix Q with orthonormal columns,
-*> which is defined as the first N columns of a product of K elementary
-*> reflectors of order M
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGEQRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGEQRF in the first k columns of its array
-*> argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORG2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
- LWKOPT = MAX( 1, N )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGQR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DORGQR', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORGQR', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the last block.
-* The first kk columns are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
-* Set A(1:kk,kk+1:n) to zero.
-*
- DO 20 J = KK + 1, N
- DO 10 I = 1, KK
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the last or only block.
-*
- IF( KK.LT.N )
- $ CALL DORG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
- $ TAU( KK+1 ), WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = KI + 1, 1, -NB
- IB = MIN( NB, K-I+1 )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(i:m,i+ib:n) from the left
-*
- CALL DLARFB( 'Left', 'No transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H to rows i:m of current block
-*
- CALL DORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
-* Set rows 1:i-1 of current block to zero
-*
- DO 40 J = I, I + IB - 1
- DO 30 L = 1, I - 1
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DORGQR
-*
- END
diff --git a/netlib/LAPACK/dorgr2.f b/netlib/LAPACK/dorgr2.f
deleted file mode 100644
index 3cd6200..0000000
--- a/netlib/LAPACK/dorgr2.f
+++ /dev/null
@@ -1,202 +0,0 @@
-*> \brief \b DORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGR2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGR2 generates an m by n real matrix Q with orthonormal rows,
-*> which is defined as the last m rows of a product of k elementary
-*> reflectors of order n
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGERQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the (m-k+i)-th row must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGERQF in the last k rows of its array argument
-*> A.
-*> On exit, the m by n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGERQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGR2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, II, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGR2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 )
- $ RETURN
-*
- IF( K.LT.M ) THEN
-*
-* Initialise rows 1:m-k to rows of the unit matrix
-*
- DO 20 J = 1, N
- DO 10 L = 1, M - K
- A( L, J ) = ZERO
- 10 CONTINUE
- IF( J.GT.N-M .AND. J.LE.N-K )
- $ A( M-N+J, J ) = ONE
- 20 CONTINUE
- END IF
-*
- DO 40 I = 1, K
- II = M - K + I
-*
-* Apply H(i) to A(1:m-k+i,1:n-k+i) from the right
-*
- A( II, N-M+II ) = ONE
- CALL DLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, TAU( I ),
- $ A, LDA, WORK )
- CALL DSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA )
- A( II, N-M+II ) = ONE - TAU( I )
-*
-* Set A(m-k+i,n-k+i+1:n) to zero
-*
- DO 30 L = N - M + II + 1, N
- A( II, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of DORGR2
-*
- END
diff --git a/netlib/LAPACK/dorgrq.f b/netlib/LAPACK/dorgrq.f
deleted file mode 100644
index 0263eeb..0000000
--- a/netlib/LAPACK/dorgrq.f
+++ /dev/null
@@ -1,296 +0,0 @@
-*> \brief \b DORGRQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGRQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgrq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgrq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgrq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGRQ generates an M-by-N real matrix Q with orthonormal rows,
-*> which is defined as the last M rows of a product of K elementary
-*> reflectors of order N
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGERQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the (m-k+i)-th row must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGERQF in the last k rows of its array argument
-*> A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \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), as returned by DGERQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORGR2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.LE.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'DORGRQ', ' ', M, N, K, -1 )
- LWKOPT = M*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGRQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DORGRQ', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORGRQ', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the first block.
-* The last kk rows are handled by the block method.
-*
- KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-* Set A(1:m-kk,n-kk+1:n) to zero.
-*
- DO 20 J = N - KK + 1, N
- DO 10 I = 1, M - KK
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the first or only block.
-*
- CALL DORGR2( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = K - KK + 1, K, NB
- IB = MIN( NB, K-I+1 )
- II = M - K + I
- IF( II.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
- $ A( II, 1 ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
-*
- CALL DLARFB( 'Right', 'Transpose', 'Backward', 'Rowwise',
- $ II-1, N-K+I+IB-1, IB, A( II, 1 ), LDA, WORK,
- $ LDWORK, A, LDA, WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H**T to columns 1:n-k+i+ib-1 of current block
-*
- CALL DORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ),
- $ WORK, IINFO )
-*
-* Set columns n-k+i+ib:n of current block to zero
-*
- DO 40 L = N - K + I + IB, N
- DO 30 J = II, II + IB - 1
- A( J, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DORGRQ
-*
- END
diff --git a/netlib/LAPACK/dorgtr.f b/netlib/LAPACK/dorgtr.f
deleted file mode 100644
index 06a7b6c..0000000
--- a/netlib/LAPACK/dorgtr.f
+++ /dev/null
@@ -1,255 +0,0 @@
-*> \brief \b DORGTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORGTR generates a real orthogonal matrix Q which is defined as the
-*> product of n-1 elementary reflectors of order N, as returned by
-*> DSYTRD:
-*>
-*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A contains elementary reflectors
-*> from DSYTRD;
-*> = 'L': Lower triangle of A contains elementary reflectors
-*> from DSYTRD.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by DSYTRD.
-*> On exit, the N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DSYTRD.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N-1).
-*> For optimum performance LWORK >= (N-1)*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER
- INTEGER I, IINFO, J, LWKOPT, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORGQL, DORGQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( UPPER ) THEN
- NB = ILAENV( 1, 'DORGQL', ' ', N-1, N-1, N-1, -1 )
- ELSE
- NB = ILAENV( 1, 'DORGQR', ' ', N-1, N-1, N-1, -1 )
- END IF
- LWKOPT = MAX( 1, N-1 )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGTR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to DSYTRD with UPLO = 'U'
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the left, and set the last row and column of Q to
-* those of the unit matrix
-*
- DO 20 J = 1, N - 1
- DO 10 I = 1, J - 1
- A( I, J ) = A( I, J+1 )
- 10 CONTINUE
- A( N, J ) = ZERO
- 20 CONTINUE
- DO 30 I = 1, N - 1
- A( I, N ) = ZERO
- 30 CONTINUE
- A( N, N ) = ONE
-*
-* Generate Q(1:n-1,1:n-1)
-*
- CALL DORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* Q was determined by a call to DSYTRD with UPLO = 'L'.
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first row and column of Q to
-* those of the unit matrix
-*
- DO 50 J = N, 2, -1
- A( 1, J ) = ZERO
- DO 40 I = J + 1, N
- A( I, J ) = A( I, J-1 )
- 40 CONTINUE
- 50 CONTINUE
- A( 1, 1 ) = ONE
- DO 60 I = 2, N
- A( I, 1 ) = ZERO
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Generate Q(2:n,2:n)
-*
- CALL DORGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORGTR
-*
- END
diff --git a/netlib/LAPACK/dorm2l.f b/netlib/LAPACK/dorm2l.f
deleted file mode 100644
index 3ff2586..0000000
--- a/netlib/LAPACK/dorm2l.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b DORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORM2L + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorm2l.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorm2l.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorm2l.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORM2L overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T * C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGEQLF in the last k columns of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQLF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORM2L', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(1:m-k+i,1:n)
-*
- MI = M - K + I
- ELSE
-*
-* H(i) is applied to C(1:m,1:n-k+i)
-*
- NI = N - K + I
- END IF
-*
-* Apply H(i)
-*
- AII = A( NQ-K+I, I )
- A( NQ-K+I, I ) = ONE
- CALL DLARF( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC,
- $ WORK )
- A( NQ-K+I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DORM2L
-*
- END
diff --git a/netlib/LAPACK/dorm2r.f b/netlib/LAPACK/dorm2r.f
deleted file mode 100644
index b13f12d..0000000
--- a/netlib/LAPACK/dorm2r.f
+++ /dev/null
@@ -1,282 +0,0 @@
-*> \brief \b DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORM2R + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorm2r.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorm2r.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorm2r.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORM2R overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGEQRF in the first k columns of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORM2R', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
- $ LDC, WORK )
- A( I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DORM2R
-*
- END
diff --git a/netlib/LAPACK/dormbr.f b/netlib/LAPACK/dormbr.f
deleted file mode 100644
index 7a0d9b9..0000000
--- a/netlib/LAPACK/dormbr.f
+++ /dev/null
@@ -1,372 +0,0 @@
-*> \brief \b DORMBR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMBR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormbr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormbr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormbr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
-* LDC, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, VECT
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> If VECT = 'Q', DORMBR overwrites the general real M-by-N matrix C
-*> with
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C
-*> with
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': P * C C * P
-*> TRANS = 'T': P**T * C C * P**T
-*>
-*> Here Q and P**T are the orthogonal matrices determined by DGEBRD when
-*> reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
-*> P**T are defined as products of elementary reflectors H(i) and G(i)
-*> respectively.
-*>
-*> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
-*> order of the orthogonal matrix Q or P**T that is applied.
-*>
-*> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
-*> if nq >= k, Q = H(1) H(2) . . . H(k);
-*> if nq < k, Q = H(1) H(2) . . . H(nq-1).
-*>
-*> If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
-*> if k < nq, P = G(1) G(2) . . . G(k);
-*> if k >= nq, P = G(1) G(2) . . . G(nq-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'Q': apply Q or Q**T;
-*> = 'P': apply P or P**T.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q, Q**T, P or P**T from the Left;
-*> = 'R': apply Q, Q**T, P or P**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q or P;
-*> = 'T': Transpose, apply Q**T or P**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> If VECT = 'Q', the number of columns in the original
-*> matrix reduced by DGEBRD.
-*> If VECT = 'P', the number of rows in the original
-*> matrix reduced by DGEBRD.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,min(nq,K)) if VECT = 'Q'
-*> (LDA,nq) if VECT = 'P'
-*> The vectors which define the elementary reflectors H(i) and
-*> G(i), whose products determine the matrices Q and P, as
-*> returned by DGEBRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If VECT = 'Q', LDA >= max(1,nq);
-*> if VECT = 'P', LDA >= max(1,min(nq,K)).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(nq,K))
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i) or G(i) which determines Q or P, as returned
-*> by DGEBRD in the array argument TAUQ or TAUP.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
-*> or P*C or P**T*C or C*P or C*P**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
- $ LDC, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, VECT
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORMLQ, DORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- APPLYQ = LSAME( VECT, 'Q' )
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q or P and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( K.LT.0 ) THEN
- INFO = -6
- ELSE IF( ( APPLYQ .AND. LDA.LT.MAX( 1, NQ ) ) .OR.
- $ ( .NOT.APPLYQ .AND. LDA.LT.MAX( 1, MIN( NQ, K ) ) ) )
- $ THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( APPLYQ ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- ELSE
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMBR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = 1
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- IF( APPLYQ ) THEN
-*
-* Apply Q
-*
- IF( NQ.GE.K ) THEN
-*
-* Q was determined by a call to DGEBRD with nq >= k
-*
- CALL DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, IINFO )
- ELSE IF( NQ.GT.1 ) THEN
-*
-* Q was determined by a call to DGEBRD with nq < k
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- I1 = 2
- I2 = 1
- ELSE
- MI = M
- NI = N - 1
- I1 = 1
- I2 = 2
- END IF
- CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
- $ C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- ELSE
-*
-* Apply P
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
- IF( NQ.GT.K ) THEN
-*
-* P was determined by a call to DGEBRD with nq > k
-*
- CALL DORMLQ( SIDE, TRANST, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, IINFO )
- ELSE IF( NQ.GT.1 ) THEN
-*
-* P was determined by a call to DGEBRD with nq <= k
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- I1 = 2
- I2 = 1
- ELSE
- MI = M
- NI = N - 1
- I1 = 1
- I2 = 2
- END IF
- CALL DORMLQ( SIDE, TRANST, MI, NI, NQ-1, A( 1, 2 ), LDA,
- $ TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMBR
-*
- END
diff --git a/netlib/LAPACK/dormhr.f b/netlib/LAPACK/dormhr.f
deleted file mode 100644
index 85bfc41..0000000
--- a/netlib/LAPACK/dormhr.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b DORMHR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMHR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormhr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormhr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormhr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
-* LDC, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMHR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix of order nq, with nq = m if
-*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*> IHI-ILO elementary reflectors, as returned by DGEHRD:
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI must have the same values as in the previous call
-*> of DGEHRD. Q is equal to the unit matrix except in the
-*> submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*> If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
-*> ILO = 1 and IHI = 0, if M = 0;
-*> if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
-*> ILO = 1 and IHI = 0, if N = 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L'
-*> (LDA,N) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by DGEHRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEHRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
- $ LDC, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NH = IHI - ILO
- LEFT = LSAME( SIDE, 'L' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
- $ THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
- INFO = -5
- ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, NH, N, NH, -1 )
- ELSE
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, NH, NH, -1 )
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMHR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( LEFT ) THEN
- MI = NH
- NI = N
- I1 = ILO + 1
- I2 = 1
- ELSE
- MI = M
- NI = NH
- I1 = 1
- I2 = ILO + 1
- END IF
-*
- CALL DORMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
- $ TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMHR
-*
- END
diff --git a/netlib/LAPACK/dorml2.f b/netlib/LAPACK/dorml2.f
deleted file mode 100644
index 9ae2396..0000000
--- a/netlib/LAPACK/dorml2.f
+++ /dev/null
@@ -1,282 +0,0 @@
-*> \brief \b DORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sgelqf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORML2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorml2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorml2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorml2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORML2 overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGELQF in the first k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORML2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
- A( I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DORML2
-*
- END
diff --git a/netlib/LAPACK/dormlq.f b/netlib/LAPACK/dormlq.f
deleted file mode 100644
index ebbd4d2..0000000
--- a/netlib/LAPACK/dormlq.f
+++ /dev/null
@@ -1,354 +0,0 @@
-*> \brief \b DORMLQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMLQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormlq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormlq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormlq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMLQ overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGELQF in the first k rows of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
- $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORML2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size. NB may be at most NBMAX, where NBMAX
-* is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMLQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
- $ A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMLQ
-*
- END
diff --git a/netlib/LAPACK/dormql.f b/netlib/LAPACK/dormql.f
deleted file mode 100644
index 96c6f19..0000000
--- a/netlib/LAPACK/dormql.f
+++ /dev/null
@@ -1,348 +0,0 @@
-*> \brief \b DORMQL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMQL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormql.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormql.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormql.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMQL overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGEQLF in the last k columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQLF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- INTEGER I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
- $ MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORM2L, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = MAX( 1, N )
- ELSE
- NQ = N
- NW = MAX( 1, M )
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
-*
-* Determine the block size. NB may be at most NBMAX, where
-* NBMAX is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N,
- $ K, -1 ) )
- LWKOPT = NW*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMQL', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB,
- $ A( 1, I ), LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
-*
- MI = M - K + I + IB - 1
- ELSE
-*
-* H or H**T is applied to C(1:m,1:n-k+i+ib-1)
-*
- NI = N - K + I + IB - 1
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI,
- $ IB, A( 1, I ), LDA, T, LDT, C, LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMQL
-*
- END
diff --git a/netlib/LAPACK/dormqr.f b/netlib/LAPACK/dormqr.f
deleted file mode 100644
index c0767ec..0000000
--- a/netlib/LAPACK/dormqr.f
+++ /dev/null
@@ -1,347 +0,0 @@
-*> \brief \b DORMQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMQR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGEQRF in the first k columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
- $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORM2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size. NB may be at most NBMAX, where NBMAX
-* is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
- $ -1 ) )
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMQR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
- $ IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
- $ WORK, LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMQR
-*
- END
diff --git a/netlib/LAPACK/dormr2.f b/netlib/LAPACK/dormr2.f
deleted file mode 100644
index e6bcf04..0000000
--- a/netlib/LAPACK/dormr2.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b DORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMR2 overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q' (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGERQF in the last k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by DGERQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMR2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(1:m-k+i,1:n)
-*
- MI = M - K + I
- ELSE
-*
-* H(i) is applied to C(1:m,1:n-k+i)
-*
- NI = N - K + I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, NQ-K+I )
- A( I, NQ-K+I ) = ONE
- CALL DLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
- $ WORK )
- A( I, NQ-K+I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DORMR2
-*
- END
diff --git a/netlib/LAPACK/dormr3.f b/netlib/LAPACK/dormr3.f
deleted file mode 100644
index c98b16d..0000000
--- a/netlib/LAPACK/dormr3.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b DORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMR3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormr3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormr3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormr3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, L, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMR3 overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'C', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'C',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix A containing
-*> the meaningful part of the Householder reflectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DTZRZF in the last k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by DTZRZF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m-by-n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, L, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JA, JC, MI, NI, NQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARZ, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
- $ ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMR3', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JA = M - L + 1
- JC = 1
- ELSE
- MI = M
- JA = N - L + 1
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) or H(i)**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) or H(i)**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i) or H(i)**T
-*
- CALL DLARZ( SIDE, MI, NI, L, A( I, JA ), LDA, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
-*
- 10 CONTINUE
-*
- RETURN
-*
-* End of DORMR3
-*
- END
diff --git a/netlib/LAPACK/dormrq.f b/netlib/LAPACK/dormrq.f
deleted file mode 100644
index ca0db3b..0000000
--- a/netlib/LAPACK/dormrq.f
+++ /dev/null
@@ -1,355 +0,0 @@
-*> \brief \b DORMRQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMRQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormrq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormrq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormrq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMRQ overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGERQF in the last k rows of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by DGERQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
- $ MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORMR2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = MAX( 1, N )
- ELSE
- NQ = N
- NW = MAX( 1, M )
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
-*
-* Determine the block size. NB may be at most NBMAX, where
-* NBMAX is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N,
- $ K, -1 ) )
- LWKOPT = NW*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMRQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,
- $ A( I, 1 ), LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
-*
- MI = M - K + I + IB - 1
- ELSE
-*
-* H or H**T is applied to C(1:m,1:n-k+i+ib-1)
-*
- NI = N - K + I + IB - 1
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARFB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
- $ IB, A( I, 1 ), LDA, T, LDT, C, LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMRQ
-*
- END
diff --git a/netlib/LAPACK/dormrz.f b/netlib/LAPACK/dormrz.f
deleted file mode 100644
index e971f86..0000000
--- a/netlib/LAPACK/dormrz.f
+++ /dev/null
@@ -1,389 +0,0 @@
-*> \brief \b DORMRZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMRZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormrz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormrz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormrz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, L, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMRZ overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix A containing
-*> the meaningful part of the Householder reflectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DTZRZF in the last k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by DTZRZF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, L, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JA, JC,
- $ LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARZB, DLARZT, DORMR3, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = MAX( 1, N )
- ELSE
- NQ = N
- NW = MAX( 1, M )
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
- $ ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
-*
-* Determine the block size. NB may be at most NBMAX, where
-* NBMAX is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N,
- $ K, -1 ) )
- LWKOPT = NW*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMRZ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
- $ WORK, IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- JA = M - L + 1
- ELSE
- MI = M
- IC = 1
- JA = N - L + 1
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA,
- $ TAU( I ), T, LDT )
-*
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARZB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
- $ IB, L, A( I, JA ), LDA, T, LDT, C( IC, JC ),
- $ LDC, WORK, LDWORK )
- 10 CONTINUE
-*
- END IF
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DORMRZ
-*
- END
diff --git a/netlib/LAPACK/dormtr.f b/netlib/LAPACK/dormtr.f
deleted file mode 100644
index 00fff4d..0000000
--- a/netlib/LAPACK/dormtr.f
+++ /dev/null
@@ -1,310 +0,0 @@
-*> \brief \b DORMTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, UPLO
-* INTEGER INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DORMTR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix of order nq, with nq = m if
-*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*> nq-1 elementary reflectors, as returned by DSYTRD:
-*>
-*> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A contains elementary reflectors
-*> from DSYTRD;
-*> = 'L': Lower triangle of A contains elementary reflectors
-*> from DSYTRD.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L'
-*> (LDA,N) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by DSYTRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DSYTRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, UPLO
- INTEGER INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, UPPER
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORMQL, DORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
- $ THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( UPPER ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMQL', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- ELSE
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMTR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- ELSE
- MI = M
- NI = N - 1
- END IF
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to DSYTRD with UPLO = 'U'
-*
- CALL DORMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C,
- $ LDC, WORK, LWORK, IINFO )
- ELSE
-*
-* Q was determined by a call to DSYTRD with UPLO = 'L'
-*
- IF( LEFT ) THEN
- I1 = 2
- I2 = 1
- ELSE
- I1 = 1
- I2 = 2
- END IF
- CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
- $ C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMTR
-*
- END
diff --git a/netlib/LAPACK/dpbcon.f b/netlib/LAPACK/dpbcon.f
deleted file mode 100644
index 18fdba8..0000000
--- a/netlib/LAPACK/dpbcon.f
+++ /dev/null
@@ -1,271 +0,0 @@
-*> \brief \b DPBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite band matrix using the
-*> Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular factor stored in AB;
-*> = 'L': Lower triangular factor stored in AB.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T of the band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of U or L is
-*> stored in the j-th column of the array AB as follows:
-*> if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> The 1-norm (or infinity-norm) of the symmetric band matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE
- DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATBS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- NORMIN = 'N'
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( UPPER ) THEN
-*
-* Multiply by inv(U**T).
-*
- CALL DLATBS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEL, WORK( 2*N+1 ),
- $ INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(U).
-*
- CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEU, WORK( 2*N+1 ),
- $ INFO )
- ELSE
-*
-* Multiply by inv(L).
-*
- CALL DLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEL, WORK( 2*N+1 ),
- $ INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(L**T).
-*
- CALL DLATBS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEU, WORK( 2*N+1 ),
- $ INFO )
- END IF
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- SCALE = SCALEL*SCALEU
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
-*
- RETURN
-*
-* End of DPBCON
-*
- END
diff --git a/netlib/LAPACK/dpbequ.f b/netlib/LAPACK/dpbequ.f
deleted file mode 100644
index d7fba52..0000000
--- a/netlib/LAPACK/dpbequ.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b DPBEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite band matrix A and reduce its condition
-*> number (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular of A is stored;
-*> = 'L': Lower triangular of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangle of the symmetric band matrix A,
-*> stored in the first KD+1 rows of the array. The j-th column
-*> of A is stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, J
- DOUBLE PRECISION SMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
- IF( UPPER ) THEN
- J = KD + 1
- ELSE
- J = 1
- END IF
-*
-* Initialize SMIN and AMAX.
-*
- S( 1 ) = AB( J, 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
-*
-* Find the minimum and maximum diagonal elements.
-*
- DO 10 I = 2, N
- S( I ) = AB( J, I )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 20 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 20 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 30 I = 1, N
- S( I ) = ONE / SQRT( S( I ) )
- 30 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I))
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
- RETURN
-*
-* End of DPBEQU
-*
- END
diff --git a/netlib/LAPACK/dpbrfs.f b/netlib/LAPACK/dpbrfs.f
deleted file mode 100644
index 2f9ec7a..0000000
--- a/netlib/LAPACK/dpbrfs.f
+++ /dev/null
@@ -1,443 +0,0 @@
-*> \brief \b DPBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B,
-* LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite
-*> and banded, and provides error bounds and backward error estimates
-*> for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangle of the symmetric band matrix A,
-*> stored in the first KD+1 rows of the array. The j-th column
-*> of A is stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T of the band matrix A as computed by
-*> DPBTRF, in the same storage format as A (see AB).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DPBTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B,
- $ LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, J, K, KASE, L, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DPBTRS, DSBMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDAFB.LT.KD+1 ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = MIN( N+1, 2*KD+2 )
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DSBMV( UPLO, N, KD, -ONE, AB, LDAB, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- L = KD + 1 - K
- DO 40 I = MAX( 1, K-KD ), K - 1
- WORK( I ) = WORK( I ) + ABS( AB( L+I, K ) )*XK
- S = S + ABS( AB( L+I, K ) )*ABS( X( I, J ) )
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( AB( KD+1, K ) )*XK + S
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( AB( 1, K ) )*XK
- L = 1 - K
- DO 60 I = K + 1, MIN( N, K+KD )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, K ) )*XK
- S = S + ABS( AB( L+I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N,
- $ INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N,
- $ INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 120 CONTINUE
- CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DPBRFS
-*
- END
diff --git a/netlib/LAPACK/dpbstf.f b/netlib/LAPACK/dpbstf.f
deleted file mode 100644
index 78dd2c1..0000000
--- a/netlib/LAPACK/dpbstf.f
+++ /dev/null
@@ -1,319 +0,0 @@
-*> \brief \b DPBSTF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBSTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbstf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbstf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbstf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBSTF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBSTF computes a split Cholesky factorization of a real
-*> symmetric positive definite band matrix A.
-*>
-*> This routine is designed to be used in conjunction with DSBGST.
-*>
-*> The factorization has the form A = S**T*S where S is a band matrix
-*> of the same bandwidth as A and the following structure:
-*>
-*> S = ( U )
-*> ( M L )
-*>
-*> where U is upper triangular of order m = (n+kd)/2, and L is lower
-*> triangular of order n-m.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first kd+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the factor S from the split Cholesky
-*> factorization A = S**T*S. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the factorization could not be completed,
-*> because the updated element a(i,i) was negative; the
-*> matrix A is not positive definite.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 7, KD = 2:
-*>
-*> S = ( s11 s12 s13 )
-*> ( s22 s23 s24 )
-*> ( s33 s34 )
-*> ( s44 )
-*> ( s53 s54 s55 )
-*> ( s64 s65 s66 )
-*> ( s75 s76 s77 )
-*>
-*> If UPLO = 'U', the array AB holds:
-*>
-*> on entry: on exit:
-*>
-*> * * a13 a24 a35 a46 a57 * * s13 s24 s53 s64 s75
-*> * a12 a23 a34 a45 a56 a67 * s12 s23 s34 s54 s65 s76
-*> a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
-*>
-*> If UPLO = 'L', the array AB holds:
-*>
-*> on entry: on exit:
-*>
-*> a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
-*> a21 a32 a43 a54 a65 a76 * s12 s23 s34 s54 s65 s76 *
-*> a31 a42 a53 a64 a64 * * s13 s24 s53 s64 s75 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPBSTF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, KLD, KM, M
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSYR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBSTF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- KLD = MAX( 1, LDAB-1 )
-*
-* Set the splitting point m.
-*
- M = ( N+KD ) / 2
-*
- IF( UPPER ) THEN
-*
-* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m).
-*
- DO 10 J = N, M + 1, -1
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( KD+1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( KD+1, J ) = AJJ
- KM = MIN( J-1, KD )
-*
-* Compute elements j-km:j-1 of the j-th column and update the
-* the leading submatrix within the band.
-*
- CALL DSCAL( KM, ONE / AJJ, AB( KD+1-KM, J ), 1 )
- CALL DSYR( 'Upper', KM, -ONE, AB( KD+1-KM, J ), 1,
- $ AB( KD+1, J-KM ), KLD )
- 10 CONTINUE
-*
-* Factorize the updated submatrix A(1:m,1:m) as U**T*U.
-*
- DO 20 J = 1, M
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( KD+1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( KD+1, J ) = AJJ
- KM = MIN( KD, M-J )
-*
-* Compute elements j+1:j+km of the j-th row and update the
-* trailing submatrix within the band.
-*
- IF( KM.GT.0 ) THEN
- CALL DSCAL( KM, ONE / AJJ, AB( KD, J+1 ), KLD )
- CALL DSYR( 'Upper', KM, -ONE, AB( KD, J+1 ), KLD,
- $ AB( KD+1, J+1 ), KLD )
- END IF
- 20 CONTINUE
- ELSE
-*
-* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m).
-*
- DO 30 J = N, M + 1, -1
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( 1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( 1, J ) = AJJ
- KM = MIN( J-1, KD )
-*
-* Compute elements j-km:j-1 of the j-th row and update the
-* trailing submatrix within the band.
-*
- CALL DSCAL( KM, ONE / AJJ, AB( KM+1, J-KM ), KLD )
- CALL DSYR( 'Lower', KM, -ONE, AB( KM+1, J-KM ), KLD,
- $ AB( 1, J-KM ), KLD )
- 30 CONTINUE
-*
-* Factorize the updated submatrix A(1:m,1:m) as U**T*U.
-*
- DO 40 J = 1, M
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( 1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( 1, J ) = AJJ
- KM = MIN( KD, M-J )
-*
-* Compute elements j+1:j+km of the j-th column and update the
-* trailing submatrix within the band.
-*
- IF( KM.GT.0 ) THEN
- CALL DSCAL( KM, ONE / AJJ, AB( 2, J ), 1 )
- CALL DSYR( 'Lower', KM, -ONE, AB( 2, J ), 1,
- $ AB( 1, J+1 ), KLD )
- END IF
- 40 CONTINUE
- END IF
- RETURN
-*
- 50 CONTINUE
- INFO = J
- RETURN
-*
-* End of DPBSTF
-*
- END
diff --git a/netlib/LAPACK/dpbsv.f b/netlib/LAPACK/dpbsv.f
deleted file mode 100644
index 837c651..0000000
--- a/netlib/LAPACK/dpbsv.f
+++ /dev/null
@@ -1,229 +0,0 @@
-*> \brief <b> DPBSV computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite band matrix and X
-*> and B are N-by-NRHS matrices.
-*>
-*> The Cholesky decomposition is used to factor A as
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular band matrix, and L is a lower
-*> triangular band matrix, with the same number of superdiagonals or
-*> subdiagonals as A. The factored form of A is then used to solve the
-*> system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
-*> See below for further details.
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of A is not
-*> positive definite, so the factorization could not be
-*> completed, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> On entry: On exit:
-*>
-*> * * a13 a24 a35 a46 * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> On entry: On exit:
-*>
-*> a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
-*> a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
-*> a31 a42 a53 a64 * * l31 l42 l53 l64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPBTRF, DPBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the Cholesky factorization A = U**T*U or A = L*L**T.
-*
- CALL DPBTRF( UPLO, N, KD, AB, LDAB, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of DPBSV
-*
- END
diff --git a/netlib/LAPACK/dpbsvx.f b/netlib/LAPACK/dpbsvx.f
deleted file mode 100644
index 158f283..0000000
--- a/netlib/LAPACK/dpbsvx.f
+++ /dev/null
@@ -1,545 +0,0 @@
-*> \brief <b> DPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
-* EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, UPLO
-* INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), S( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
-*> compute the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite band matrix and X
-*> and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
-*>
-*> 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
-*> factor the matrix A (after equilibration if FACT = 'E') as
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular band matrix, and L is a lower
-*> triangular band matrix.
-*>
-*> 3. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(S) so that it solves the original system before
-*> equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFB contains the factored form of A.
-*> If EQUED = 'Y', the matrix A has been equilibrated
-*> with scaling factors given by S. AB and AFB will not
-*> be modified.
-*> = 'N': The matrix A will be copied to AFB and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFB and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right-hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array, except
-*> if FACT = 'F' and EQUED = 'Y', then A must contain the
-*> equilibrated matrix diag(S)*A*diag(S). The j-th column of A
-*> is stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
-*> See below for further details.
-*>
-*> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
-*> diag(S)*A*diag(S).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> If FACT = 'F', then AFB is an input argument and on entry
-*> contains the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the band matrix
-*> A, in the same storage format as A (see AB). If EQUED = 'Y',
-*> then AFB is the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFB is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*>
-*> If FACT = 'E', then AFB is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the equilibrated
-*> matrix A (see the description of A for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> The scale factors for A; not accessed if EQUED = 'N'. S is
-*> an input argument if FACT = 'F'; otherwise, S is an output
-*> argument. If FACT = 'F' and EQUED = 'Y', each element of S
-*> must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
-*> B is overwritten by diag(S) * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
-*> the original system of equations. Note that if EQUED = 'Y',
-*> A and B are modified on exit, and the solution to the
-*> equilibrated system is inv(diag(S))*X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13
-*> a22 a23 a24
-*> a33 a34 a35
-*> a44 a45 a46
-*> a55 a56
-*> (aij=conjg(aji)) a66
-*>
-*> Band storage of the upper triangle of A:
-*>
-*> * * a13 a24 a35 a46
-*> * a12 a23 a34 a45 a56
-*> a11 a22 a33 a44 a55 a66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> a11 a22 a33 a44 a55 a66
-*> a21 a32 a43 a54 a65 *
-*> a31 a42 a53 a64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
- $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, UPLO
- INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), S( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL EQUIL, NOFACT, RCEQU, UPPER
- INTEGER I, INFEQU, J, J1, J2
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DLAQSB, DPBCON, DPBEQU, DPBRFS,
- $ DPBTRF, DPBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- UPPER = LSAME( UPLO, 'U' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- RCEQU = .FALSE.
- ELSE
- RCEQU = LSAME( EQUED, 'Y' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -7
- ELSE IF( LDAFB.LT.KD+1 ) THEN
- INFO = -9
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -10
- ELSE
- IF( RCEQU ) THEN
- SMIN = BIGNUM
- SMAX = ZERO
- DO 10 J = 1, N
- SMIN = MIN( SMIN, S( J ) )
- SMAX = MAX( SMAX, S( J ) )
- 10 CONTINUE
- IF( SMIN.LE.ZERO ) THEN
- INFO = -11
- ELSE IF( N.GT.0 ) THEN
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
- ELSE
- SCOND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -15
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )
- RCEQU = LSAME( EQUED, 'Y' )
- END IF
- END IF
-*
-* Scale the right-hand side.
-*
- IF( RCEQU ) THEN
- DO 30 J = 1, NRHS
- DO 20 I = 1, N
- B( I, J ) = S( I )*B( I, J )
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the Cholesky factorization A = U**T *U or A = L*L**T.
-*
- IF( UPPER ) THEN
- DO 40 J = 1, N
- J1 = MAX( J-KD, 1 )
- CALL DCOPY( J-J1+1, AB( KD+1-J+J1, J ), 1,
- $ AFB( KD+1-J+J1, J ), 1 )
- 40 CONTINUE
- ELSE
- DO 50 J = 1, N
- J2 = MIN( J+KD, N )
- CALL DCOPY( J2-J+1, AB( 1, J ), 1, AFB( 1, J ), 1 )
- 50 CONTINUE
- END IF
-*
- CALL DPBTRF( UPLO, N, KD, AFB, LDAFB, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = DLANSB( '1', UPLO, N, KD, AB, LDAB, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DPBTRS( UPLO, N, KD, NRHS, AFB, LDAFB, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( RCEQU ) THEN
- DO 70 J = 1, NRHS
- DO 60 I = 1, N
- X( I, J ) = S( I )*X( I, J )
- 60 CONTINUE
- 70 CONTINUE
- DO 80 J = 1, NRHS
- FERR( J ) = FERR( J ) / SCOND
- 80 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DPBSVX
-*
- END
diff --git a/netlib/LAPACK/dpbtf2.f b/netlib/LAPACK/dpbtf2.f
deleted file mode 100644
index 6cc3e42..0000000
--- a/netlib/LAPACK/dpbtf2.f
+++ /dev/null
@@ -1,263 +0,0 @@
-*> \brief \b DPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbtf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbtf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbtf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBTF2( UPLO, N, KD, AB, LDAB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBTF2 computes the Cholesky factorization of a real symmetric
-*> positive definite band matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U , if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix, U**T is the transpose of U, and
-*> L is lower triangular.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, the leading minor of order k is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> On entry: On exit:
-*>
-*> * * a13 a24 a35 a46 * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> On entry: On exit:
-*>
-*> a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
-*> a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
-*> a31 a42 a53 a64 * * l31 l42 l53 l64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPBTF2( UPLO, N, KD, AB, LDAB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, KLD, KN
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSYR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- KLD = MAX( 1, LDAB-1 )
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T*U.
-*
- DO 10 J = 1, N
-*
-* Compute U(J,J) and test for non-positive-definiteness.
-*
- AJJ = AB( KD+1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 30
- AJJ = SQRT( AJJ )
- AB( KD+1, J ) = AJJ
-*
-* Compute elements J+1:J+KN of row J and update the
-* trailing submatrix within the band.
-*
- KN = MIN( KD, N-J )
- IF( KN.GT.0 ) THEN
- CALL DSCAL( KN, ONE / AJJ, AB( KD, J+1 ), KLD )
- CALL DSYR( 'Upper', KN, -ONE, AB( KD, J+1 ), KLD,
- $ AB( KD+1, J+1 ), KLD )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- DO 20 J = 1, N
-*
-* Compute L(J,J) and test for non-positive-definiteness.
-*
- AJJ = AB( 1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 30
- AJJ = SQRT( AJJ )
- AB( 1, J ) = AJJ
-*
-* Compute elements J+1:J+KN of column J and update the
-* trailing submatrix within the band.
-*
- KN = MIN( KD, N-J )
- IF( KN.GT.0 ) THEN
- CALL DSCAL( KN, ONE / AJJ, AB( 2, J ), 1 )
- CALL DSYR( 'Lower', KN, -ONE, AB( 2, J ), 1,
- $ AB( 1, J+1 ), KLD )
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
- 30 CONTINUE
- INFO = J
- RETURN
-*
-* End of DPBTF2
-*
- END
diff --git a/netlib/LAPACK/dpbtrf.f b/netlib/LAPACK/dpbtrf.f
deleted file mode 100644
index d50d033..0000000
--- a/netlib/LAPACK/dpbtrf.f
+++ /dev/null
@@ -1,435 +0,0 @@
-*> \brief \b DPBTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbtrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbtrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbtrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBTRF computes the Cholesky factorization of a real symmetric
-*> positive definite band matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> On entry: On exit:
-*>
-*> * * a13 a24 a35 a46 * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> On entry: On exit:
-*>
-*> a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
-*> a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
-*> a31 a42 a53 a64 * * l31 l42 l53 l64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Peter Mayes and Giuseppe Radicati, IBM ECSEC, Rome, March 23, 1989
-*
-* =====================================================================
- SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
- INTEGER NBMAX, LDWORK
- PARAMETER ( NBMAX = 32, LDWORK = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I2, I3, IB, II, J, JJ, NB
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION WORK( LDWORK, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DPBTF2, DPOTF2, DSYRK, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( ( .NOT.LSAME( UPLO, 'U' ) ) .AND.
- $ ( .NOT.LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment
-*
- NB = ILAENV( 1, 'DPBTRF', UPLO, N, KD, -1, -1 )
-*
-* The block size must not exceed the semi-bandwidth KD, and must not
-* exceed the limit set by the size of the local array WORK.
-*
- NB = MIN( NB, NBMAX )
-*
- IF( NB.LE.1 .OR. NB.GT.KD ) THEN
-*
-* Use unblocked code
-*
- CALL DPBTF2( UPLO, N, KD, AB, LDAB, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Compute the Cholesky factorization of a symmetric band
-* matrix, given the upper triangle of the matrix in band
-* storage.
-*
-* Zero the upper triangle of the work array.
-*
- DO 20 J = 1, NB
- DO 10 I = 1, J - 1
- WORK( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Process the band matrix one diagonal block at a time.
-*
- DO 70 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
-*
-* Factorize the diagonal block
-*
- CALL DPOTF2( UPLO, IB, AB( KD+1, I ), LDAB-1, II )
- IF( II.NE.0 ) THEN
- INFO = I + II - 1
- GO TO 150
- END IF
- IF( I+IB.LE.N ) THEN
-*
-* Update the relevant part of the trailing submatrix.
-* If A11 denotes the diagonal block which has just been
-* factorized, then we need to update the remaining
-* blocks in the diagram:
-*
-* A11 A12 A13
-* A22 A23
-* A33
-*
-* The numbers of rows and columns in the partitioning
-* are IB, I2, I3 respectively. The blocks A12, A22 and
-* A23 are empty if IB = KD. The upper triangle of A13
-* lies outside the band.
-*
- I2 = MIN( KD-IB, N-I-IB+1 )
- I3 = MIN( IB, N-I-KD+1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A12
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose',
- $ 'Non-unit', IB, I2, ONE, AB( KD+1, I ),
- $ LDAB-1, AB( KD+1-IB, I+IB ), LDAB-1 )
-*
-* Update A22
-*
- CALL DSYRK( 'Upper', 'Transpose', I2, IB, -ONE,
- $ AB( KD+1-IB, I+IB ), LDAB-1, ONE,
- $ AB( KD+1, I+IB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Copy the lower triangle of A13 into the work array.
-*
- DO 40 JJ = 1, I3
- DO 30 II = JJ, IB
- WORK( II, JJ ) = AB( II-JJ+1, JJ+I+KD-1 )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Update A13 (in the work array).
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose',
- $ 'Non-unit', IB, I3, ONE, AB( KD+1, I ),
- $ LDAB-1, WORK, LDWORK )
-*
-* Update A23
-*
- IF( I2.GT.0 )
- $ CALL DGEMM( 'Transpose', 'No Transpose', I2, I3,
- $ IB, -ONE, AB( KD+1-IB, I+IB ),
- $ LDAB-1, WORK, LDWORK, ONE,
- $ AB( 1+IB, I+KD ), LDAB-1 )
-*
-* Update A33
-*
- CALL DSYRK( 'Upper', 'Transpose', I3, IB, -ONE,
- $ WORK, LDWORK, ONE, AB( KD+1, I+KD ),
- $ LDAB-1 )
-*
-* Copy the lower triangle of A13 back into place.
-*
- DO 60 JJ = 1, I3
- DO 50 II = JJ, IB
- AB( II-JJ+1, JJ+I+KD-1 ) = WORK( II, JJ )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- END IF
- 70 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization of a symmetric band
-* matrix, given the lower triangle of the matrix in band
-* storage.
-*
-* Zero the lower triangle of the work array.
-*
- DO 90 J = 1, NB
- DO 80 I = J + 1, NB
- WORK( I, J ) = ZERO
- 80 CONTINUE
- 90 CONTINUE
-*
-* Process the band matrix one diagonal block at a time.
-*
- DO 140 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
-*
-* Factorize the diagonal block
-*
- CALL DPOTF2( UPLO, IB, AB( 1, I ), LDAB-1, II )
- IF( II.NE.0 ) THEN
- INFO = I + II - 1
- GO TO 150
- END IF
- IF( I+IB.LE.N ) THEN
-*
-* Update the relevant part of the trailing submatrix.
-* If A11 denotes the diagonal block which has just been
-* factorized, then we need to update the remaining
-* blocks in the diagram:
-*
-* A11
-* A21 A22
-* A31 A32 A33
-*
-* The numbers of rows and columns in the partitioning
-* are IB, I2, I3 respectively. The blocks A21, A22 and
-* A32 are empty if IB = KD. The lower triangle of A31
-* lies outside the band.
-*
- I2 = MIN( KD-IB, N-I-IB+1 )
- I3 = MIN( IB, N-I-KD+1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A21
-*
- CALL DTRSM( 'Right', 'Lower', 'Transpose',
- $ 'Non-unit', I2, IB, ONE, AB( 1, I ),
- $ LDAB-1, AB( 1+IB, I ), LDAB-1 )
-*
-* Update A22
-*
- CALL DSYRK( 'Lower', 'No Transpose', I2, IB, -ONE,
- $ AB( 1+IB, I ), LDAB-1, ONE,
- $ AB( 1, I+IB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Copy the upper triangle of A31 into the work array.
-*
- DO 110 JJ = 1, IB
- DO 100 II = 1, MIN( JJ, I3 )
- WORK( II, JJ ) = AB( KD+1-JJ+II, JJ+I-1 )
- 100 CONTINUE
- 110 CONTINUE
-*
-* Update A31 (in the work array).
-*
- CALL DTRSM( 'Right', 'Lower', 'Transpose',
- $ 'Non-unit', I3, IB, ONE, AB( 1, I ),
- $ LDAB-1, WORK, LDWORK )
-*
-* Update A32
-*
- IF( I2.GT.0 )
- $ CALL DGEMM( 'No transpose', 'Transpose', I3, I2,
- $ IB, -ONE, WORK, LDWORK,
- $ AB( 1+IB, I ), LDAB-1, ONE,
- $ AB( 1+KD-IB, I+IB ), LDAB-1 )
-*
-* Update A33
-*
- CALL DSYRK( 'Lower', 'No Transpose', I3, IB, -ONE,
- $ WORK, LDWORK, ONE, AB( 1, I+KD ),
- $ LDAB-1 )
-*
-* Copy the upper triangle of A31 back into place.
-*
- DO 130 JJ = 1, IB
- DO 120 II = 1, MIN( JJ, I3 )
- AB( KD+1-JJ+II, JJ+I-1 ) = WORK( II, JJ )
- 120 CONTINUE
- 130 CONTINUE
- END IF
- END IF
- 140 CONTINUE
- END IF
- END IF
- RETURN
-*
- 150 CONTINUE
- RETURN
-*
-* End of DPBTRF
-*
- END
diff --git a/netlib/LAPACK/dpbtrs.f b/netlib/LAPACK/dpbtrs.f
deleted file mode 100644
index b8e3791..0000000
--- a/netlib/LAPACK/dpbtrs.f
+++ /dev/null
@@ -1,220 +0,0 @@
-*> \brief \b DPBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPBTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPBTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite band matrix A using the Cholesky factorization
-*> A = U**T*U or A = L*L**T computed by DPBTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular factor stored in AB;
-*> = 'L': Lower triangular factor stored in AB.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T of the band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of U or L is
-*> stored in the j-th column of the array AB as follows:
-*> if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B where A = U**T *U.
-*
- DO 10 J = 1, NRHS
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Solve A*X = B where A = L*L**T.
-*
- DO 20 J = 1, NRHS
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL DTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL DTBSV( 'Lower', 'Transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DPBTRS
-*
- END
diff --git a/netlib/LAPACK/dpftrf.f b/netlib/LAPACK/dpftrf.f
deleted file mode 100644
index 6471367..0000000
--- a/netlib/LAPACK/dpftrf.f
+++ /dev/null
@@ -1,457 +0,0 @@
-*> \brief \b DPFTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPFTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpftrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpftrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpftrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER N, INFO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: * )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPFTRF computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*>
-*> This is the block version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of RFP A is stored;
-*> = 'L': Lower triangle of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( N*(N+1)/2 );
-*> On entry, the symmetric matrix A in RFP format. RFP format is
-*> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N'
-*> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
-*> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is
-*> the transpose of RFP A as defined when
-*> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
-*> follows: If UPLO = 'U' the RFP A contains the NT elements of
-*> upper packed A. If UPLO = 'L' the RFP A contains the elements
-*> of lower packed A. The LDA of RFP A is (N+1)/2 when TRANSR =
-*> 'T'. When TRANSR is 'N' the LDA is N+1 when N is even and N
-*> is odd. See the Note below for more details.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization RFP A = U**T*U or RFP A = L*L**T.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER N, INFO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: * )
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DSYRK, DPOTRF, DTRSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPFTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- ELSE
- NISODD = .TRUE.
- END IF
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(n1)
-*
- CALL DPOTRF( 'L', N1, A( 0 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'R', 'L', 'T', 'N', N2, N1, ONE, A( 0 ), N,
- $ A( N1 ), N )
- CALL DSYRK( 'U', 'N', N2, N1, -ONE, A( N1 ), N, ONE,
- $ A( N ), N )
- CALL DPOTRF( 'U', N2, A( N ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
-* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
-* T1 -> a(n2), T2 -> a(n1), S -> a(0)
-*
- CALL DPOTRF( 'L', N1, A( N2 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'L', 'L', 'N', 'N', N1, N2, ONE, A( N2 ), N,
- $ A( 0 ), N )
- CALL DSYRK( 'U', 'T', N2, N1, -ONE, A( 0 ), N, ONE,
- $ A( N1 ), N )
- CALL DPOTRF( 'U', N2, A( N1 ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is odd
-* T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1)
-* T1 -> a(0+0) , T2 -> a(1+0) , S -> a(0+n1*n1); lda=n1
-*
- CALL DPOTRF( 'U', N1, A( 0 ), N1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'L', 'U', 'T', 'N', N1, N2, ONE, A( 0 ), N1,
- $ A( N1*N1 ), N1 )
- CALL DSYRK( 'L', 'T', N2, N1, -ONE, A( N1*N1 ), N1, ONE,
- $ A( 1 ), N1 )
- CALL DPOTRF( 'L', N2, A( 1 ), N1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is odd
-* T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0)
-* T1 -> a(n2*n2), T2 -> a(n1*n2), S -> a(0); lda = n2
-*
- CALL DPOTRF( 'U', N1, A( N2*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'R', 'U', 'N', 'N', N2, N1, ONE, A( N2*N2 ),
- $ N2, A( 0 ), N2 )
- CALL DSYRK( 'L', 'N', N2, N1, -ONE, A( 0 ), N2, ONE,
- $ A( N1*N2 ), N2 )
- CALL DPOTRF( 'L', N2, A( N1*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- CALL DPOTRF( 'L', K, A( 1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'R', 'L', 'T', 'N', K, K, ONE, A( 1 ), N+1,
- $ A( K+1 ), N+1 )
- CALL DSYRK( 'U', 'N', K, K, -ONE, A( K+1 ), N+1, ONE,
- $ A( 0 ), N+1 )
- CALL DPOTRF( 'U', K, A( 0 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- CALL DPOTRF( 'L', K, A( K+1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'L', 'L', 'N', 'N', K, K, ONE, A( K+1 ),
- $ N+1, A( 0 ), N+1 )
- CALL DSYRK( 'U', 'T', K, K, -ONE, A( 0 ), N+1, ONE,
- $ A( K ), N+1 )
- CALL DPOTRF( 'U', K, A( K ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- CALL DPOTRF( 'U', K, A( 0+K ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'L', 'U', 'T', 'N', K, K, ONE, A( K ), N1,
- $ A( K*( K+1 ) ), K )
- CALL DSYRK( 'L', 'T', K, K, -ONE, A( K*( K+1 ) ), K, ONE,
- $ A( 0 ), K )
- CALL DPOTRF( 'L', K, A( 0 ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- CALL DPOTRF( 'U', K, A( K*( K+1 ) ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRSM( 'R', 'U', 'N', 'N', K, K, ONE,
- $ A( K*( K+1 ) ), K, A( 0 ), K )
- CALL DSYRK( 'L', 'N', K, K, -ONE, A( 0 ), K, ONE,
- $ A( K*K ), K )
- CALL DPOTRF( 'L', K, A( K*K ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DPFTRF
-*
- END
diff --git a/netlib/LAPACK/dpftri.f b/netlib/LAPACK/dpftri.f
deleted file mode 100644
index 04ca4f3..0000000
--- a/netlib/LAPACK/dpftri.f
+++ /dev/null
@@ -1,423 +0,0 @@
-*> \brief \b DPFTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPFTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpftri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpftri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpftri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPFTRI computes the inverse of a (real) symmetric positive definite
-*> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
-*> computed by DPFTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( N*(N+1)/2 )
-*> On entry, the symmetric matrix A in RFP format. RFP format is
-*> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N'
-*> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
-*> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is
-*> the transpose of RFP A as defined when
-*> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
-*> follows: If UPLO = 'U' the RFP A contains the nt elements of
-*> upper packed A. If UPLO = 'L' the RFP A contains the elements
-*> of lower packed A. The LDA of RFP A is (N+1)/2 when TRANSR =
-*> 'T'. When TRANSR is 'N' the LDA is N+1 when N is even and N
-*> is odd. See the Note below for more details.
-*>
-*> On exit, the symmetric inverse of the original matrix, in the
-*> same storage format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the (i,i) element of the factor U or L is
-*> zero, and the inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DTFTRI, DLAUUM, DTRMM, DSYRK
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPFTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Invert the triangular Cholesky factor U or L.
-*
- CALL DTFTRI( TRANSR, UPLO, 'N', N, A, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- ELSE
- NISODD = .TRUE.
- END IF
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* Start execution of triangular matrix multiply: inv(U)*inv(U)^C or
-* inv(L)^C*inv(L). There are eight cases.
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:N1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(N1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(N1)
-*
- CALL DLAUUM( 'L', N1, A( 0 ), N, INFO )
- CALL DSYRK( 'L', 'T', N1, N2, ONE, A( N1 ), N, ONE,
- $ A( 0 ), N )
- CALL DTRMM( 'L', 'U', 'N', 'N', N2, N1, ONE, A( N ), N,
- $ A( N1 ), N )
- CALL DLAUUM( 'U', N2, A( N ), N, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:N2-1)
-* T1 -> a(N1+1,0), T2 -> a(N1,0), S -> a(0,0)
-* T1 -> a(N2), T2 -> a(N1), S -> a(0)
-*
- CALL DLAUUM( 'L', N1, A( N2 ), N, INFO )
- CALL DSYRK( 'L', 'N', N1, N2, ONE, A( 0 ), N, ONE,
- $ A( N2 ), N )
- CALL DTRMM( 'R', 'U', 'T', 'N', N1, N2, ONE, A( N1 ), N,
- $ A( 0 ), N )
- CALL DLAUUM( 'U', N2, A( N1 ), N, INFO )
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE, and N is odd
-* T1 -> a(0), T2 -> a(1), S -> a(0+N1*N1)
-*
- CALL DLAUUM( 'U', N1, A( 0 ), N1, INFO )
- CALL DSYRK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, ONE,
- $ A( 0 ), N1 )
- CALL DTRMM( 'R', 'L', 'N', 'N', N1, N2, ONE, A( 1 ), N1,
- $ A( N1*N1 ), N1 )
- CALL DLAUUM( 'L', N2, A( 1 ), N1, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE, and N is odd
-* T1 -> a(0+N2*N2), T2 -> a(0+N1*N2), S -> a(0)
-*
- CALL DLAUUM( 'U', N1, A( N2*N2 ), N2, INFO )
- CALL DSYRK( 'U', 'T', N1, N2, ONE, A( 0 ), N2, ONE,
- $ A( N2*N2 ), N2 )
- CALL DTRMM( 'L', 'L', 'T', 'N', N2, N1, ONE, A( N1*N2 ),
- $ N2, A( 0 ), N2 )
- CALL DLAUUM( 'L', N2, A( N1*N2 ), N2, INFO )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- CALL DLAUUM( 'L', K, A( 1 ), N+1, INFO )
- CALL DSYRK( 'L', 'T', K, K, ONE, A( K+1 ), N+1, ONE,
- $ A( 1 ), N+1 )
- CALL DTRMM( 'L', 'U', 'N', 'N', K, K, ONE, A( 0 ), N+1,
- $ A( K+1 ), N+1 )
- CALL DLAUUM( 'U', K, A( 0 ), N+1, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- CALL DLAUUM( 'L', K, A( K+1 ), N+1, INFO )
- CALL DSYRK( 'L', 'N', K, K, ONE, A( 0 ), N+1, ONE,
- $ A( K+1 ), N+1 )
- CALL DTRMM( 'R', 'U', 'T', 'N', K, K, ONE, A( K ), N+1,
- $ A( 0 ), N+1 )
- CALL DLAUUM( 'U', K, A( K ), N+1, INFO )
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE, and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1),
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- CALL DLAUUM( 'U', K, A( K ), K, INFO )
- CALL DSYRK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, ONE,
- $ A( K ), K )
- CALL DTRMM( 'R', 'L', 'N', 'N', K, K, ONE, A( 0 ), K,
- $ A( K*( K+1 ) ), K )
- CALL DLAUUM( 'L', K, A( 0 ), K, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE, and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0),
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- CALL DLAUUM( 'U', K, A( K*( K+1 ) ), K, INFO )
- CALL DSYRK( 'U', 'T', K, K, ONE, A( 0 ), K, ONE,
- $ A( K*( K+1 ) ), K )
- CALL DTRMM( 'L', 'L', 'T', 'N', K, K, ONE, A( K*K ), K,
- $ A( 0 ), K )
- CALL DLAUUM( 'L', K, A( K*K ), K, INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DPFTRI
-*
- END
diff --git a/netlib/LAPACK/dpftrs.f b/netlib/LAPACK/dpftrs.f
deleted file mode 100644
index d111dbc..0000000
--- a/netlib/LAPACK/dpftrs.f
+++ /dev/null
@@ -1,280 +0,0 @@
-*> \brief \b DPFTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPFTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpftrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpftrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpftrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPFTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite matrix A using the Cholesky factorization
-*> A = U**T*U or A = L*L**T computed by DPFTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of RFP A is stored;
-*> = 'L': Lower triangle of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ).
-*> The triangular factor U or L from the Cholesky factorization
-*> of RFP A = U**T*U or RFP A = L*L**T, as computed by DPFTRF.
-*> See note below for more details about RFP A.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NORMALTRANSR
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DTFSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPFTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* start execution: there are two triangular solves
-*
- IF( LOWER ) THEN
- CALL DTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- CALL DTFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- ELSE
- CALL DTFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- CALL DTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- END IF
-*
- RETURN
-*
-* End of DPFTRS
-*
- END
diff --git a/netlib/LAPACK/dpocon.f b/netlib/LAPACK/dpocon.f
deleted file mode 100644
index a8b0066..0000000
--- a/netlib/LAPACK/dpocon.f
+++ /dev/null
@@ -1,253 +0,0 @@
-*> \brief \b DPOCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpocon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpocon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpocon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite matrix using the
-*> Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> The 1-norm (or infinity-norm) of the symmetric matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE
- DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATRS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the 1-norm of inv(A).
-*
- KASE = 0
- NORMIN = 'N'
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( UPPER ) THEN
-*
-* Multiply by inv(U**T).
-*
- CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(U).
-*
- CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(L).
-*
- CALL DLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(L**T).
-*
- CALL DLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- SCALE = SCALEL*SCALEU
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of DPOCON
-*
- END
diff --git a/netlib/LAPACK/dpoequ.f b/netlib/LAPACK/dpoequ.f
deleted file mode 100644
index 070c541..0000000
--- a/netlib/LAPACK/dpoequ.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief \b DPOEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpoequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpoequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpoequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOEQU( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite matrix A and reduce its condition number
-*> (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The N-by-N symmetric positive definite matrix whose scaling
-*> factors are to be computed. Only the diagonal elements of A
-*> are referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOEQU( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION SMIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Find the minimum and maximum diagonal elements.
-*
- S( 1 ) = A( 1, 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
- DO 10 I = 2, N
- S( I ) = A( I, I )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 20 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 20 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 30 I = 1, N
- S( I ) = ONE / SQRT( S( I ) )
- 30 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I))
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
- RETURN
-*
-* End of DPOEQU
-*
- END
diff --git a/netlib/LAPACK/dpoequb.f b/netlib/LAPACK/dpoequb.f
deleted file mode 100644
index 09ee542..0000000
--- a/netlib/LAPACK/dpoequb.f
+++ /dev/null
@@ -1,215 +0,0 @@
-*> \brief \b DPOEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpoequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpoequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpoequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite matrix A and reduce its condition number
-*> (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The N-by-N symmetric positive definite matrix whose scaling
-*> factors are to be computed. Only the diagonal elements of A
-*> are referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION SMIN, BASE, TMP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT, LOG, INT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
-* Positive definite only performs 1 pass of equilibration.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOEQUB', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-
- BASE = DLAMCH( 'B' )
- TMP = -0.5D+0 / LOG ( BASE )
-*
-* Find the minimum and maximum diagonal elements.
-*
- S( 1 ) = A( 1, 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
- DO 10 I = 2, N
- S( I ) = A( I, I )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 20 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 20 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 30 I = 1, N
- S( I ) = BASE ** INT( TMP * LOG( S( I ) ) )
- 30 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I)).
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
-*
- RETURN
-*
-* End of DPOEQUB
-*
- END
diff --git a/netlib/LAPACK/dporfs.f b/netlib/LAPACK/dporfs.f
deleted file mode 100644
index 08db3c3..0000000
--- a/netlib/LAPACK/dporfs.f
+++ /dev/null
@@ -1,430 +0,0 @@
-*> \brief \b DPORFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPORFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dporfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dporfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dporfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X,
-* LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPORFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite,
-*> and provides error bounds and backward error estimates for the
-*> solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DPOTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, J, K, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DPOTRS, DSYMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPORFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK + S
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DPORFS
-*
- END
diff --git a/netlib/LAPACK/dposv.f b/netlib/LAPACK/dposv.f
deleted file mode 100644
index 0bcf476..0000000
--- a/netlib/LAPACK/dposv.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief <b> DPOSV computes the solution to system of linear equations A * X = B for PO matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dposv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dposv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dposv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix and X and B
-*> are N-by-NRHS matrices.
-*>
-*> The Cholesky decomposition is used to factor A as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix. The factored form of A is then used to solve the system of
-*> equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of A is not
-*> positive definite, so the factorization could not be
-*> completed, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOsolve
-*
-* =====================================================================
- SUBROUTINE DPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPOTRF, DPOTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the Cholesky factorization A = U**T*U or A = L*L**T.
-*
- CALL DPOTRF( UPLO, N, A, LDA, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of DPOSV
-*
- END
diff --git a/netlib/LAPACK/dposvx.f b/netlib/LAPACK/dposvx.f
deleted file mode 100644
index 4150a5d..0000000
--- a/netlib/LAPACK/dposvx.f
+++ /dev/null
@@ -1,494 +0,0 @@
-*> \brief <b> DPOSVX computes the solution to system of linear equations A * X = B for PO matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dposvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dposvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dposvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
-* S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), S( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
-*> compute the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix and X and B
-*> are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
-*>
-*> 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
-*> factor the matrix A (after equilibration if FACT = 'E') as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix.
-*>
-*> 3. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(S) so that it solves the original system before
-*> equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AF contains the factored form of A.
-*> If EQUED = 'Y', the matrix A has been equilibrated
-*> with scaling factors given by S. A and AF will not
-*> be modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A, except if FACT = 'F' and
-*> EQUED = 'Y', then A must contain the equilibrated matrix
-*> diag(S)*A*diag(S). If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced. A is not modified if
-*> FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
-*> diag(S)*A*diag(S).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, in the same storage
-*> format as A. If EQUED .ne. 'N', then AF is the factored form
-*> of the equilibrated matrix diag(S)*A*diag(S).
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the original
-*> matrix A.
-*>
-*> If FACT = 'E', then AF is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the equilibrated
-*> matrix A (see the description of A for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> The scale factors for A; not accessed if EQUED = 'N'. S is
-*> an input argument if FACT = 'F'; otherwise, S is an output
-*> argument. If FACT = 'F' and EQUED = 'Y', each element of S
-*> must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
-*> B is overwritten by diag(S) * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
-*> the original system of equations. Note that if EQUED = 'Y',
-*> A and B are modified on exit, and the solution to the
-*> equilibrated system is inv(diag(S))*X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doublePOsolve
-*
-* =====================================================================
- SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
- $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), S( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL EQUIL, NOFACT, RCEQU
- INTEGER I, INFEQU, J
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, DLAMCH, DLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAQSY, DPOCON, DPOEQU, DPORFS, DPOTRF,
- $ DPOTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- RCEQU = .FALSE.
- ELSE
- RCEQU = LSAME( EQUED, 'Y' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -9
- ELSE
- IF( RCEQU ) THEN
- SMIN = BIGNUM
- SMAX = ZERO
- DO 10 J = 1, N
- SMIN = MIN( SMIN, S( J ) )
- SMAX = MAX( SMAX, S( J ) )
- 10 CONTINUE
- IF( SMIN.LE.ZERO ) THEN
- INFO = -10
- ELSE IF( N.GT.0 ) THEN
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
- ELSE
- SCOND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
- RCEQU = LSAME( EQUED, 'Y' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( RCEQU ) THEN
- DO 30 J = 1, NRHS
- DO 20 I = 1, N
- B( I, J ) = S( I )*B( I, J )
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the Cholesky factorization A = U**T *U or A = L*L**T.
-*
- CALL DLACPY( UPLO, N, N, A, LDA, AF, LDAF )
- CALL DPOTRF( UPLO, N, AF, LDAF, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = DLANSY( '1', UPLO, N, A, LDA, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX,
- $ FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( RCEQU ) THEN
- DO 50 J = 1, NRHS
- DO 40 I = 1, N
- X( I, J ) = S( I )*X( I, J )
- 40 CONTINUE
- 50 CONTINUE
- DO 60 J = 1, NRHS
- FERR( J ) = FERR( J ) / SCOND
- 60 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DPOSVX
-*
- END
diff --git a/netlib/LAPACK/dpotf2.f b/netlib/LAPACK/dpotf2.f
deleted file mode 100644
index 6003e19..0000000
--- a/netlib/LAPACK/dpotf2.f
+++ /dev/null
@@ -1,230 +0,0 @@
-*> \brief \b DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpotf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpotf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpotf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOTF2 computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U , if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T *U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, the leading minor of order k is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T *U.
-*
- DO 10 J = 1, N
-*
-* Compute U(J,J) and test for non-positive-definiteness.
-*
- AJJ = A( J, J ) - DDOT( J-1, A( 1, J ), 1, A( 1, J ), 1 )
- IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 30
- END IF
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of row J.
-*
- IF( J.LT.N ) THEN
- CALL DGEMV( 'Transpose', J-1, N-J, -ONE, A( 1, J+1 ),
- $ LDA, A( 1, J ), 1, ONE, A( J, J+1 ), LDA )
- CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- DO 20 J = 1, N
-*
-* Compute L(J,J) and test for non-positive-definiteness.
-*
- AJJ = A( J, J ) - DDOT( J-1, A( J, 1 ), LDA, A( J, 1 ),
- $ LDA )
- IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 30
- END IF
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of column J.
-*
- IF( J.LT.N ) THEN
- CALL DGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, 1 ),
- $ LDA, A( J, 1 ), LDA, ONE, A( J+1, J ), 1 )
- CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
- END IF
- 20 CONTINUE
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = J
-*
- 40 CONTINUE
- RETURN
-*
-* End of DPOTF2
-*
- END
diff --git a/netlib/LAPACK/dpotrf.f b/netlib/LAPACK/dpotrf.f
deleted file mode 100644
index 3457230..0000000
--- a/netlib/LAPACK/dpotrf.f
+++ /dev/null
@@ -1,246 +0,0 @@
-*> \brief \b DPOTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpotrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpotrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpotrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOTRF computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*>
-*> This is the block version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DPOTF2, DSYRK, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- CALL DPOTF2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code.
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T*U.
-*
- DO 10 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
- CALL DSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
- $ A( 1, J ), LDA, ONE, A( J, J ), LDA )
- CALL DPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
- IF( J+JB.LE.N ) THEN
-*
-* Compute the current block row.
-*
- CALL DGEMM( 'Transpose', 'No transpose', JB, N-J-JB+1,
- $ J-1, -ONE, A( 1, J ), LDA, A( 1, J+JB ),
- $ LDA, ONE, A( J, J+JB ), LDA )
- CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
- $ JB, N-J-JB+1, ONE, A( J, J ), LDA,
- $ A( J, J+JB ), LDA )
- END IF
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- DO 20 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
- CALL DSYRK( 'Lower', 'No transpose', JB, J-1, -ONE,
- $ A( J, 1 ), LDA, ONE, A( J, J ), LDA )
- CALL DPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
- IF( J+JB.LE.N ) THEN
-*
-* Compute the current block column.
-*
- CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
- $ J-1, -ONE, A( J+JB, 1 ), LDA, A( J, 1 ),
- $ LDA, ONE, A( J+JB, J ), LDA )
- CALL DTRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
- $ N-J-JB+1, JB, ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
- END IF
- 20 CONTINUE
- END IF
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = INFO + J - 1
-*
- 40 CONTINUE
- RETURN
-*
-* End of DPOTRF
-*
- END
diff --git a/netlib/LAPACK/dpotri.f b/netlib/LAPACK/dpotri.f
deleted file mode 100644
index af1572f..0000000
--- a/netlib/LAPACK/dpotri.f
+++ /dev/null
@@ -1,159 +0,0 @@
-*> \brief \b DPOTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpotri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpotri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpotri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOTRI( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOTRI computes the inverse of a real symmetric positive definite
-*> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
-*> computed by DPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, as computed by
-*> DPOTRF.
-*> On exit, the upper or lower triangle of the (symmetric)
-*> inverse of A, overwriting the input factor U or L.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the (i,i) element of the factor U or L is
-*> zero, and the inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOTRI( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAUUM, DTRTRI, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Invert the triangular Cholesky factor U or L.
-*
- CALL DTRTRI( UPLO, 'Non-unit', N, A, LDA, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
-* Form inv(U) * inv(U)**T or inv(L)**T * inv(L).
-*
- CALL DLAUUM( UPLO, N, A, LDA, INFO )
-*
- RETURN
-*
-* End of DPOTRI
-*
- END
diff --git a/netlib/LAPACK/dpotrs.f b/netlib/LAPACK/dpotrs.f
deleted file mode 100644
index 71f19a3..0000000
--- a/netlib/LAPACK/dpotrs.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DPOTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPOTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpotrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpotrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpotrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPOTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite matrix A using the Cholesky factorization
-*> A = U**T*U or A = L*L**T computed by DPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOcomputational
-*
-* =====================================================================
- SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPOTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B where A = U**T *U.
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A*X = B where A = L*L**T.
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
- END IF
-*
- RETURN
-*
-* End of DPOTRS
-*
- END
diff --git a/netlib/LAPACK/dppcon.f b/netlib/LAPACK/dppcon.f
deleted file mode 100644
index 6c55be1..0000000
--- a/netlib/LAPACK/dppcon.f
+++ /dev/null
@@ -1,248 +0,0 @@
-*> \brief \b DPPCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dppcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dppcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dppcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite packed matrix using
-*> the Cholesky factorization A = U**T*U or A = L*L**T computed by
-*> DPPTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, packed columnwise in a linear
-*> array. The j-th column of U or L is stored in the array AP
-*> as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> The 1-norm (or infinity-norm) of the symmetric matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE
- DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATPS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- NORMIN = 'N'
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( UPPER ) THEN
-*
-* Multiply by inv(U**T).
-*
- CALL DLATPS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(U).
-*
- CALL DLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(L).
-*
- CALL DLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(L**T).
-*
- CALL DLATPS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- SCALE = SCALEL*SCALEU
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of DPPCON
-*
- END
diff --git a/netlib/LAPACK/dppequ.f b/netlib/LAPACK/dppequ.f
deleted file mode 100644
index 4af3638..0000000
--- a/netlib/LAPACK/dppequ.f
+++ /dev/null
@@ -1,238 +0,0 @@
-*> \brief \b DPPEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dppequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dppequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dppequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite matrix A in packed storage and reduce
-*> its condition number (with respect to the two-norm). S contains the
-*> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
-*> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
-*> This choice of S puts the condition number of B within a factor N of
-*> the smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
- DOUBLE PRECISION AMAX, SCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, JJ
- DOUBLE PRECISION SMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Initialize SMIN and AMAX.
-*
- S( 1 ) = AP( 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
-*
- IF( UPPER ) THEN
-*
-* UPLO = 'U': Upper triangle of A is stored.
-* Find the minimum and maximum diagonal elements.
-*
- JJ = 1
- DO 10 I = 2, N
- JJ = JJ + I
- S( I ) = AP( JJ )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- ELSE
-*
-* UPLO = 'L': Lower triangle of A is stored.
-* Find the minimum and maximum diagonal elements.
-*
- JJ = 1
- DO 20 I = 2, N
- JJ = JJ + N - I + 2
- S( I ) = AP( JJ )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 20 CONTINUE
- END IF
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 30 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 30 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 40 I = 1, N
- S( I ) = ONE / SQRT( S( I ) )
- 40 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I))
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
- RETURN
-*
-* End of DPPEQU
-*
- END
diff --git a/netlib/LAPACK/dpprfs.f b/netlib/LAPACK/dpprfs.f
deleted file mode 100644
index 45fa1d8..0000000
--- a/netlib/LAPACK/dpprfs.f
+++ /dev/null
@@ -1,421 +0,0 @@
-*> \brief \b DPPRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpprfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpprfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpprfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR,
-* BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite
-*> and packed, and provides error bounds and backward error estimates
-*> for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] AFP
-*> \verbatim
-*> AFP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by DPPTRF/ZPPTRF,
-*> packed columnwise in a linear array in the same format as A
-*> (see AP).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DPPTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR,
- $ BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, IK, J, K, KASE, KK, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DPPTRS, DSPMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ),
- $ 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- KK = 1
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- IK = KK
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( AP( KK+K-1 ) )*XK + S
- KK = KK + K
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( AP( KK ) )*XK
- IK = KK + 1
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- KK = KK + ( N-K+1 )
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DPPTRS( UPLO, N, 1, AFP, WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL DPPTRS( UPLO, N, 1, AFP, WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL DPPTRS( UPLO, N, 1, AFP, WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DPPRFS
-*
- END
diff --git a/netlib/LAPACK/dppsv.f b/netlib/LAPACK/dppsv.f
deleted file mode 100644
index ac7c127..0000000
--- a/netlib/LAPACK/dppsv.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief <b> DPPSV computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dppsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dppsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dppsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPSV( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix stored in
-*> packed format and X and B are N-by-NRHS matrices.
-*>
-*> The Cholesky decomposition is used to factor A as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix. The factored form of A is then used to solve the system of
-*> equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, in the same storage
-*> format as A.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of A is not
-*> positive definite, so the factorization could not be
-*> completed, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = conjg(aji))
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPPSV( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPPTRF, DPPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the Cholesky factorization A = U**T*U or A = L*L**T.
-*
- CALL DPPTRF( UPLO, N, AP, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of DPPSV
-*
- END
diff --git a/netlib/LAPACK/dppsvx.f b/netlib/LAPACK/dppsvx.f
deleted file mode 100644
index 3d61d38..0000000
--- a/netlib/LAPACK/dppsvx.f
+++ /dev/null
@@ -1,494 +0,0 @@
-*> \brief <b> DPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dppsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dppsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dppsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
-* X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), S( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
-*> compute the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix stored in
-*> packed format and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
-*>
-*> 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
-*> factor the matrix A (after equilibration if FACT = 'E') as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix.
-*>
-*> 3. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(S) so that it solves the original system before
-*> equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFP contains the factored form of A.
-*> If EQUED = 'Y', the matrix A has been equilibrated
-*> with scaling factors given by S. AP and AFP will not
-*> be modified.
-*> = 'N': The matrix A will be copied to AFP and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFP and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array, except if FACT = 'F'
-*> and EQUED = 'Y', then A must contain the equilibrated matrix
-*> diag(S)*A*diag(S). The j-th column of A is stored in the
-*> array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details. A is not modified if
-*> FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
-*> diag(S)*A*diag(S).
-*> \endverbatim
-*>
-*> \param[in,out] AFP
-*> \verbatim
-*> AFP is DOUBLE PRECISION array, dimension
-*> (N*(N+1)/2)
-*> If FACT = 'F', then AFP is an input argument and on entry
-*> contains the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, in the same storage
-*> format as A. If EQUED .ne. 'N', then AFP is the factored
-*> form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFP is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T * U or A = L * L**T of the original
-*> matrix A.
-*>
-*> If FACT = 'E', then AFP is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T * U or A = L * L**T of the equilibrated
-*> matrix A (see the description of AP for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> The scale factors for A; not accessed if EQUED = 'N'. S is
-*> an input argument if FACT = 'F'; otherwise, S is an output
-*> argument. If FACT = 'F' and EQUED = 'Y', each element of S
-*> must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
-*> B is overwritten by diag(S) * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
-*> the original system of equations. Note that if EQUED = 'Y',
-*> A and B are modified on exit, and the solution to the
-*> equilibrated system is inv(diag(S))*X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = conjg(aji))
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
- $ X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), S( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL EQUIL, NOFACT, RCEQU
- INTEGER I, INFEQU, J
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSP
- EXTERNAL LSAME, DLAMCH, DLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DLAQSP, DPPCON, DPPEQU, DPPRFS,
- $ DPPTRF, DPPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- RCEQU = .FALSE.
- ELSE
- RCEQU = LSAME( EQUED, 'Y' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -7
- ELSE
- IF( RCEQU ) THEN
- SMIN = BIGNUM
- SMAX = ZERO
- DO 10 J = 1, N
- SMIN = MIN( SMIN, S( J ) )
- SMAX = MAX( SMAX, S( J ) )
- 10 CONTINUE
- IF( SMIN.LE.ZERO ) THEN
- INFO = -8
- ELSE IF( N.GT.0 ) THEN
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
- ELSE
- SCOND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
- RCEQU = LSAME( EQUED, 'Y' )
- END IF
- END IF
-*
-* Scale the right-hand side.
-*
- IF( RCEQU ) THEN
- DO 30 J = 1, NRHS
- DO 20 I = 1, N
- B( I, J ) = S( I )*B( I, J )
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the Cholesky factorization A = U**T * U or A = L * L**T.
-*
- CALL DCOPY( N*( N+1 ) / 2, AP, 1, AFP, 1 )
- CALL DPPTRF( UPLO, N, AFP, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = DLANSP( 'I', UPLO, N, AP, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DPPCON( UPLO, N, AFP, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DPPTRS( UPLO, N, NRHS, AFP, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( RCEQU ) THEN
- DO 50 J = 1, NRHS
- DO 40 I = 1, N
- X( I, J ) = S( I )*X( I, J )
- 40 CONTINUE
- 50 CONTINUE
- DO 60 J = 1, NRHS
- FERR( J ) = FERR( J ) / SCOND
- 60 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DPPSVX
-*
- END
diff --git a/netlib/LAPACK/dpptrf.f b/netlib/LAPACK/dpptrf.f
deleted file mode 100644
index bb06a8d..0000000
--- a/netlib/LAPACK/dpptrf.f
+++ /dev/null
@@ -1,240 +0,0 @@
-*> \brief \b DPPTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpptrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpptrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpptrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPTRF( UPLO, N, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPTRF computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A stored in packed format.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T, in the same
-*> storage format as A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = aji)
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPPTRF( UPLO, N, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JC, JJ
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSPR, DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T*U.
-*
- JJ = 0
- DO 10 J = 1, N
- JC = JJ + 1
- JJ = JJ + J
-*
-* Compute elements 1:J-1 of column J.
-*
- IF( J.GT.1 )
- $ CALL DTPSV( 'Upper', 'Transpose', 'Non-unit', J-1, AP,
- $ AP( JC ), 1 )
-*
-* Compute U(J,J) and test for non-positive-definiteness.
-*
- AJJ = AP( JJ ) - DDOT( J-1, AP( JC ), 1, AP( JC ), 1 )
- IF( AJJ.LE.ZERO ) THEN
- AP( JJ ) = AJJ
- GO TO 30
- END IF
- AP( JJ ) = SQRT( AJJ )
- 10 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- JJ = 1
- DO 20 J = 1, N
-*
-* Compute L(J,J) and test for non-positive-definiteness.
-*
- AJJ = AP( JJ )
- IF( AJJ.LE.ZERO ) THEN
- AP( JJ ) = AJJ
- GO TO 30
- END IF
- AJJ = SQRT( AJJ )
- AP( JJ ) = AJJ
-*
-* Compute elements J+1:N of column J and update the trailing
-* submatrix.
-*
- IF( J.LT.N ) THEN
- CALL DSCAL( N-J, ONE / AJJ, AP( JJ+1 ), 1 )
- CALL DSPR( 'Lower', N-J, -ONE, AP( JJ+1 ), 1,
- $ AP( JJ+N-J+1 ) )
- JJ = JJ + N - J + 1
- END IF
- 20 CONTINUE
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = J
-*
- 40 CONTINUE
- RETURN
-*
-* End of DPPTRF
-*
- END
diff --git a/netlib/LAPACK/dpptri.f b/netlib/LAPACK/dpptri.f
deleted file mode 100644
index 34b12fd..0000000
--- a/netlib/LAPACK/dpptri.f
+++ /dev/null
@@ -1,188 +0,0 @@
-*> \brief \b DPPTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpptri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpptri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpptri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPTRI( UPLO, N, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPTRI computes the inverse of a real symmetric positive definite
-*> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
-*> computed by DPPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular factor is stored in AP;
-*> = 'L': Lower triangular factor is stored in AP.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, packed columnwise as
-*> a linear array. The j-th column of U or L is stored in the
-*> array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
-*>
-*> On exit, the upper or lower triangle of the (symmetric)
-*> inverse of A, overwriting the input factor U or L.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the (i,i) element of the factor U or L is
-*> zero, and the inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPPTRI( UPLO, N, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JC, JJ, JJN
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSPR, DTPMV, DTPTRI, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Invert the triangular Cholesky factor U or L.
-*
- CALL DTPTRI( UPLO, 'Non-unit', N, AP, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the product inv(U) * inv(U)**T.
-*
- JJ = 0
- DO 10 J = 1, N
- JC = JJ + 1
- JJ = JJ + J
- IF( J.GT.1 )
- $ CALL DSPR( 'Upper', J-1, ONE, AP( JC ), 1, AP )
- AJJ = AP( JJ )
- CALL DSCAL( J, AJJ, AP( JC ), 1 )
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the product inv(L)**T * inv(L).
-*
- JJ = 1
- DO 20 J = 1, N
- JJN = JJ + N - J + 1
- AP( JJ ) = DDOT( N-J+1, AP( JJ ), 1, AP( JJ ), 1 )
- IF( J.LT.N )
- $ CALL DTPMV( 'Lower', 'Transpose', 'Non-unit', N-J,
- $ AP( JJN ), AP( JJ+1 ), 1 )
- JJ = JJN
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DPPTRI
-*
- END
diff --git a/netlib/LAPACK/dpptrs.f b/netlib/LAPACK/dpptrs.f
deleted file mode 100644
index 97f2172..0000000
--- a/netlib/LAPACK/dpptrs.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b DPPTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPPTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpptrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpptrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpptrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPPTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite matrix A in packed storage using the Cholesky
-*> factorization A = U**T*U or A = L*L**T computed by DPPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, packed columnwise in a linear
-*> array. The j-th column of U or L is stored in the array AP
-*> as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPPTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B where A = U**T * U.
-*
- DO 10 I = 1, NRHS
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL DTPSV( 'Upper', 'Transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTPSV( 'Upper', 'No transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Solve A*X = B where A = L * L**T.
-*
- DO 20 I = 1, NRHS
-*
-* Solve L*Y = B, overwriting B with X.
-*
- CALL DTPSV( 'Lower', 'No transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
-*
-* Solve L**T *X = Y, overwriting B with X.
-*
- CALL DTPSV( 'Lower', 'Transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DPPTRS
-*
- END
diff --git a/netlib/LAPACK/dpstf2.f b/netlib/LAPACK/dpstf2.f
deleted file mode 100644
index a055853..0000000
--- a/netlib/LAPACK/dpstf2.f
+++ /dev/null
@@ -1,385 +0,0 @@
-*> \brief \b DPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric or complex Hermitian positive semi-definite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPSTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpstf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpstf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpstf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION TOL
-* INTEGER INFO, LDA, N, RANK
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( 2*N )
-* INTEGER PIV( N )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPSTF2 computes the Cholesky factorization with complete
-*> pivoting of a real symmetric positive semidefinite matrix A.
-*>
-*> The factorization has the form
-*> P**T * A * P = U**T * U , if UPLO = 'U',
-*> P**T * A * P = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular, and
-*> P is stored as vector PIV.
-*>
-*> This algorithm does not attempt to check that A is positive
-*> semidefinite. This version of the algorithm calls level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization as above.
-*> \endverbatim
-*>
-*> \param[out] PIV
-*> \verbatim
-*> PIV is INTEGER array, dimension (N)
-*> PIV is such that the nonzero entries are P( PIV(K), K ) = 1.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The rank of A given by the number of steps the algorithm
-*> completed.
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is DOUBLE PRECISION
-*> User defined tolerance. If TOL < 0, then N*U*MAX( A( K,K ) )
-*> will be used. The algorithm terminates at the (K-1)st step
-*> if the pivot <= TOL.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> Work space.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> < 0: If INFO = -K, the K-th argument had an illegal value,
-*> = 0: algorithm completed successfully, and
-*> > 0: the matrix A is either rank deficient with computed rank
-*> as returned in RANK, or is indefinite. See Section 7 of
-*> LAPACK Working Note #161 for further information.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION TOL
- INTEGER INFO, LDA, N, RANK
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( 2*N )
- INTEGER PIV( N )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AJJ, DSTOP, DTEMP
- INTEGER I, ITEMP, J, PVT
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- LOGICAL LSAME, DISNAN
- EXTERNAL DLAMCH, LSAME, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT, MAXLOC
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPSTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize PIV
-*
- DO 100 I = 1, N
- PIV( I ) = I
- 100 CONTINUE
-*
-* Compute stopping value
-*
- PVT = 1
- AJJ = A( PVT, PVT )
- DO I = 2, N
- IF( A( I, I ).GT.AJJ ) THEN
- PVT = I
- AJJ = A( PVT, PVT )
- END IF
- END DO
- IF( AJJ.EQ.ZERO.OR.DISNAN( AJJ ) ) THEN
- RANK = 0
- INFO = 1
- GO TO 170
- END IF
-*
-* Compute stopping value if not supplied
-*
- IF( TOL.LT.ZERO ) THEN
- DSTOP = N * DLAMCH( 'Epsilon' ) * AJJ
- ELSE
- DSTOP = TOL
- END IF
-*
-* Set first half of WORK to zero, holds dot products
-*
- DO 110 I = 1, N
- WORK( I ) = 0
- 110 CONTINUE
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization P**T * A * P = U**T * U
-*
- DO 130 J = 1, N
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 120 I = J, N
-*
- IF( J.GT.1 ) THEN
- WORK( I ) = WORK( I ) + A( J-1, I )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 120 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.DSTOP.OR.DISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 160
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL DSWAP( J-1, A( 1, J ), 1, A( 1, PVT ), 1 )
- IF( PVT.LT.N )
- $ CALL DSWAP( N-PVT, A( J, PVT+1 ), LDA,
- $ A( PVT, PVT+1 ), LDA )
- CALL DSWAP( PVT-J-1, A( J, J+1 ), LDA, A( J+1, PVT ), 1 )
-*
-* Swap dot products and PIV
-*
- DTEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = DTEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of row J
-*
- IF( J.LT.N ) THEN
- CALL DGEMV( 'Trans', J-1, N-J, -ONE, A( 1, J+1 ), LDA,
- $ A( 1, J ), 1, ONE, A( J, J+1 ), LDA )
- CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
- END IF
-*
- 130 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization P**T * A * P = L * L**T
-*
- DO 150 J = 1, N
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 140 I = J, N
-*
- IF( J.GT.1 ) THEN
- WORK( I ) = WORK( I ) + A( I, J-1 )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 140 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.DSTOP.OR.DISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 160
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL DSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA )
- IF( PVT.LT.N )
- $ CALL DSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ),
- $ 1 )
- CALL DSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), LDA )
-*
-* Swap dot products and PIV
-*
- DTEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = DTEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of column J
-*
- IF( J.LT.N ) THEN
- CALL DGEMV( 'No Trans', N-J, J-1, -ONE, A( J+1, 1 ), LDA,
- $ A( J, 1 ), LDA, ONE, A( J+1, J ), 1 )
- CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
- END IF
-*
- 150 CONTINUE
-*
- END IF
-*
-* Ran to completion, A has full rank
-*
- RANK = N
-*
- GO TO 170
- 160 CONTINUE
-*
-* Rank is number of steps completed. Set INFO = 1 to signal
-* that the factorization cannot be used to solve a system.
-*
- RANK = J - 1
- INFO = 1
-*
- 170 CONTINUE
- RETURN
-*
-* End of DPSTF2
-*
- END
diff --git a/netlib/LAPACK/dpstrf.f b/netlib/LAPACK/dpstrf.f
deleted file mode 100644
index 2f64aad..0000000
--- a/netlib/LAPACK/dpstrf.f
+++ /dev/null
@@ -1,443 +0,0 @@
-*> \brief \b DPSTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPSTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpstrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpstrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpstrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION TOL
-* INTEGER INFO, LDA, N, RANK
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( 2*N )
-* INTEGER PIV( N )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPSTRF computes the Cholesky factorization with complete
-*> pivoting of a real symmetric positive semidefinite matrix A.
-*>
-*> The factorization has the form
-*> P**T * A * P = U**T * U , if UPLO = 'U',
-*> P**T * A * P = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular, and
-*> P is stored as vector PIV.
-*>
-*> This algorithm does not attempt to check that A is positive
-*> semidefinite. This version of the algorithm calls level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization as above.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] PIV
-*> \verbatim
-*> PIV is INTEGER array, dimension (N)
-*> PIV is such that the nonzero entries are P( PIV(K), K ) = 1.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The rank of A given by the number of steps the algorithm
-*> completed.
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is DOUBLE PRECISION
-*> User defined tolerance. If TOL < 0, then N*U*MAX( A(K,K) )
-*> will be used. The algorithm terminates at the (K-1)st step
-*> if the pivot <= TOL.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> Work space.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> < 0: If INFO = -K, the K-th argument had an illegal value,
-*> = 0: algorithm completed successfully, and
-*> > 0: the matrix A is either rank deficient with computed rank
-*> as returned in RANK, or is indefinite. See Section 7 of
-*> LAPACK Working Note #161 for further information.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION TOL
- INTEGER INFO, LDA, N, RANK
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( 2*N )
- INTEGER PIV( N )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AJJ, DSTOP, DTEMP
- INTEGER I, ITEMP, J, JB, K, NB, PVT
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER ILAENV
- LOGICAL LSAME, DISNAN
- EXTERNAL DLAMCH, ILAENV, LSAME, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DPSTF2, DSCAL, DSWAP, DSYRK, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT, MAXLOC
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPSTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get block size
-*
- NB = ILAENV( 1, 'DPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL DPSTF2( UPLO, N, A( 1, 1 ), LDA, PIV, RANK, TOL, WORK,
- $ INFO )
- GO TO 200
-*
- ELSE
-*
-* Initialize PIV
-*
- DO 100 I = 1, N
- PIV( I ) = I
- 100 CONTINUE
-*
-* Compute stopping value
-*
- PVT = 1
- AJJ = A( PVT, PVT )
- DO I = 2, N
- IF( A( I, I ).GT.AJJ ) THEN
- PVT = I
- AJJ = A( PVT, PVT )
- END IF
- END DO
- IF( AJJ.EQ.ZERO.OR.DISNAN( AJJ ) ) THEN
- RANK = 0
- INFO = 1
- GO TO 200
- END IF
-*
-* Compute stopping value if not supplied
-*
- IF( TOL.LT.ZERO ) THEN
- DSTOP = N * DLAMCH( 'Epsilon' ) * AJJ
- ELSE
- DSTOP = TOL
- END IF
-*
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization P**T * A * P = U**T * U
-*
- DO 140 K = 1, N, NB
-*
-* Account for last block not being NB wide
-*
- JB = MIN( NB, N-K+1 )
-*
-* Set relevant part of first half of WORK to zero,
-* holds dot products
-*
- DO 110 I = K, N
- WORK( I ) = 0
- 110 CONTINUE
-*
- DO 130 J = K, K + JB - 1
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 120 I = J, N
-*
- IF( J.GT.K ) THEN
- WORK( I ) = WORK( I ) + A( J-1, I )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 120 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.DSTOP.OR.DISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 190
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL DSWAP( J-1, A( 1, J ), 1, A( 1, PVT ), 1 )
- IF( PVT.LT.N )
- $ CALL DSWAP( N-PVT, A( J, PVT+1 ), LDA,
- $ A( PVT, PVT+1 ), LDA )
- CALL DSWAP( PVT-J-1, A( J, J+1 ), LDA,
- $ A( J+1, PVT ), 1 )
-*
-* Swap dot products and PIV
-*
- DTEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = DTEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of row J.
-*
- IF( J.LT.N ) THEN
- CALL DGEMV( 'Trans', J-K, N-J, -ONE, A( K, J+1 ),
- $ LDA, A( K, J ), 1, ONE, A( J, J+1 ),
- $ LDA )
- CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
- END IF
-*
- 130 CONTINUE
-*
-* Update trailing matrix, J already incremented
-*
- IF( K+JB.LE.N ) THEN
- CALL DSYRK( 'Upper', 'Trans', N-J+1, JB, -ONE,
- $ A( K, J ), LDA, ONE, A( J, J ), LDA )
- END IF
-*
- 140 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization P**T * A * P = L * L**T
-*
- DO 180 K = 1, N, NB
-*
-* Account for last block not being NB wide
-*
- JB = MIN( NB, N-K+1 )
-*
-* Set relevant part of first half of WORK to zero,
-* holds dot products
-*
- DO 150 I = K, N
- WORK( I ) = 0
- 150 CONTINUE
-*
- DO 170 J = K, K + JB - 1
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 160 I = J, N
-*
- IF( J.GT.K ) THEN
- WORK( I ) = WORK( I ) + A( I, J-1 )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 160 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.DSTOP.OR.DISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 190
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL DSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA )
- IF( PVT.LT.N )
- $ CALL DSWAP( N-PVT, A( PVT+1, J ), 1,
- $ A( PVT+1, PVT ), 1 )
- CALL DSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ),
- $ LDA )
-*
-* Swap dot products and PIV
-*
- DTEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = DTEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of column J.
-*
- IF( J.LT.N ) THEN
- CALL DGEMV( 'No Trans', N-J, J-K, -ONE,
- $ A( J+1, K ), LDA, A( J, K ), LDA, ONE,
- $ A( J+1, J ), 1 )
- CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
- END IF
-*
- 170 CONTINUE
-*
-* Update trailing matrix, J already incremented
-*
- IF( K+JB.LE.N ) THEN
- CALL DSYRK( 'Lower', 'No Trans', N-J+1, JB, -ONE,
- $ A( J, K ), LDA, ONE, A( J, J ), LDA )
- END IF
-*
- 180 CONTINUE
-*
- END IF
- END IF
-*
-* Ran to completion, A has full rank
-*
- RANK = N
-*
- GO TO 200
- 190 CONTINUE
-*
-* Rank is the number of steps completed. Set INFO = 1 to signal
-* that the factorization cannot be used to solve a system.
-*
- RANK = J - 1
- INFO = 1
-*
- 200 CONTINUE
- RETURN
-*
-* End of DPSTRF
-*
- END
diff --git a/netlib/LAPACK/dptcon.f b/netlib/LAPACK/dptcon.f
deleted file mode 100644
index 78d81dc..0000000
--- a/netlib/LAPACK/dptcon.f
+++ /dev/null
@@ -1,221 +0,0 @@
-*> \brief \b DPTCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTCON( N, D, E, ANORM, RCOND, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTCON computes the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite tridiagonal matrix
-*> using the factorization A = L*D*L**T or A = U**T*D*U computed by
-*> DPTTRF.
-*>
-*> Norm(inv(A)) is computed by a direct method, and the reciprocal of
-*> the condition number is computed as
-*> RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> factorization of A, as computed by DPTTRF.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) off-diagonal elements of the unit bidiagonal factor
-*> U or L from the factorization of A, as computed by DPTTRF.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> The 1-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
-*> 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The method used is described in Nicholas J. Higham, "Efficient
-*> Algorithms for Computing the Condition Number of a Tridiagonal
-*> Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DPTCON( N, D, E, ANORM, RCOND, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IX
- DOUBLE PRECISION AINVNM
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- EXTERNAL IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPTCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that D(1:N) is positive.
-*
- DO 10 I = 1, N
- IF( D( I ).LE.ZERO )
- $ RETURN
- 10 CONTINUE
-*
-* Solve M(A) * x = e, where M(A) = (m(i,j)) is given by
-*
-* m(i,j) = abs(A(i,j)), i = j,
-* m(i,j) = -abs(A(i,j)), i .ne. j,
-*
-* and e = [ 1, 1, ..., 1 ]**T. Note M(A) = M(L)*D*M(L)**T.
-*
-* Solve M(L) * x = e.
-*
- WORK( 1 ) = ONE
- DO 20 I = 2, N
- WORK( I ) = ONE + WORK( I-1 )*ABS( E( I-1 ) )
- 20 CONTINUE
-*
-* Solve D * M(L)**T * x = b.
-*
- WORK( N ) = WORK( N ) / D( N )
- DO 30 I = N - 1, 1, -1
- WORK( I ) = WORK( I ) / D( I ) + WORK( I+1 )*ABS( E( I ) )
- 30 CONTINUE
-*
-* Compute AINVNM = max(x(i)), 1<=i<=n.
-*
- IX = IDAMAX( N, WORK, 1 )
- AINVNM = ABS( WORK( IX ) )
-*
-* Compute the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of DPTCON
-*
- END
diff --git a/netlib/LAPACK/dpteqr.f b/netlib/LAPACK/dpteqr.f
deleted file mode 100644
index 4a98b99..0000000
--- a/netlib/LAPACK/dpteqr.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DPTEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTEQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpteqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpteqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpteqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPZ
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTEQR computes all eigenvalues and, optionally, eigenvectors of a
-*> symmetric positive definite tridiagonal matrix by first factoring the
-*> matrix using DPTTRF, and then calling DBDSQR to compute the singular
-*> values of the bidiagonal factor.
-*>
-*> This routine computes the eigenvalues of the positive definite
-*> tridiagonal matrix to high relative accuracy. This means that if the
-*> eigenvalues range over many orders of magnitude in size, then the
-*> small eigenvalues and corresponding eigenvectors will be computed
-*> more accurately than, for example, with the standard QR method.
-*>
-*> The eigenvectors of a full or band symmetric positive definite matrix
-*> can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to
-*> reduce this matrix to tridiagonal form. (The reduction to tridiagonal
-*> form, however, may preclude the possibility of obtaining high
-*> relative accuracy in the small eigenvalues of the original matrix, if
-*> these eigenvalues range over many orders of magnitude.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only.
-*> = 'V': Compute eigenvectors of original symmetric
-*> matrix also. Array Z contains the orthogonal
-*> matrix used to reduce the original matrix to
-*> tridiagonal form.
-*> = 'I': Compute eigenvectors of tridiagonal matrix also.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal
-*> matrix.
-*> On normal exit, D contains the eigenvalues, in descending
-*> order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix used in the
-*> reduction to tridiagonal form.
-*> On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
-*> original symmetric matrix;
-*> if COMPZ = 'I', the orthonormal eigenvectors of the
-*> tridiagonal matrix.
-*> If INFO > 0 on exit, Z contains the eigenvectors associated
-*> with only the stored eigenvalues.
-*> If COMPZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> COMPZ = 'V' or 'I', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, and i is:
-*> <= N the Cholesky factorization of the matrix could
-*> not be performed because the i-th principal minor
-*> was not positive definite.
-*> > N the SVD algorithm failed to converge;
-*> if INFO = N+i, i off-diagonal elements of the
-*> bidiagonal factor did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTcomputational
-*
-* =====================================================================
- SUBROUTINE DPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER COMPZ
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DBDSQR, DLASET, DPTTRF, XERBLA
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION C( 1, 1 ), VT( 1, 1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ICOMPZ, NRU
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ICOMPZ = 0
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ICOMPZ = 2
- ELSE
- ICOMPZ = -1
- END IF
- IF( ICOMPZ.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
- $ N ) ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPTEQR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ICOMPZ.GT.0 )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
- IF( ICOMPZ.EQ.2 )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-* Call DPTTRF to factor the matrix.
-*
- CALL DPTTRF( N, D, E, INFO )
- IF( INFO.NE.0 )
- $ RETURN
- DO 10 I = 1, N
- D( I ) = SQRT( D( I ) )
- 10 CONTINUE
- DO 20 I = 1, N - 1
- E( I ) = E( I )*D( I )
- 20 CONTINUE
-*
-* Call DBDSQR to compute the singular values/vectors of the
-* bidiagonal factor.
-*
- IF( ICOMPZ.GT.0 ) THEN
- NRU = N
- ELSE
- NRU = 0
- END IF
- CALL DBDSQR( 'Lower', N, 0, NRU, 0, D, E, VT, 1, Z, LDZ, C, 1,
- $ WORK, INFO )
-*
-* Square the singular values.
-*
- IF( INFO.EQ.0 ) THEN
- DO 30 I = 1, N
- D( I ) = D( I )*D( I )
- 30 CONTINUE
- ELSE
- INFO = N + INFO
- END IF
-*
- RETURN
-*
-* End of DPTEQR
-*
- END
diff --git a/netlib/LAPACK/dptrfs.f b/netlib/LAPACK/dptrfs.f
deleted file mode 100644
index 30b6fcc..0000000
--- a/netlib/LAPACK/dptrfs.f
+++ /dev/null
@@ -1,395 +0,0 @@
-*> \brief \b DPTRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR,
-* BERR, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ E( * ), EF( * ), FERR( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite
-*> and tridiagonal, and provides error bounds and backward error
-*> estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in] DF
-*> \verbatim
-*> DF is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> factorization computed by DPTTRF.
-*> \endverbatim
-*>
-*> \param[in] EF
-*> \verbatim
-*> EF is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal factor
-*> L from the factorization computed by DPTTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DPTTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j).
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTcomputational
-*
-* =====================================================================
- SUBROUTINE DPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR,
- $ BERR, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ E( * ), EF( * ), FERR( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER COUNT, I, IX, J, NZ
- DOUBLE PRECISION BI, CX, DX, EPS, EX, LSTRES, S, SAFE1, SAFE2,
- $ SAFMIN
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DPTTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL IDAMAX, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPTRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = 4
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 90 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X. Also compute
-* abs(A)*abs(x) + abs(b) for use in the backward error bound.
-*
- IF( N.EQ.1 ) THEN
- BI = B( 1, J )
- DX = D( 1 )*X( 1, J )
- WORK( N+1 ) = BI - DX
- WORK( 1 ) = ABS( BI ) + ABS( DX )
- ELSE
- BI = B( 1, J )
- DX = D( 1 )*X( 1, J )
- EX = E( 1 )*X( 2, J )
- WORK( N+1 ) = BI - DX - EX
- WORK( 1 ) = ABS( BI ) + ABS( DX ) + ABS( EX )
- DO 30 I = 2, N - 1
- BI = B( I, J )
- CX = E( I-1 )*X( I-1, J )
- DX = D( I )*X( I, J )
- EX = E( I )*X( I+1, J )
- WORK( N+I ) = BI - CX - DX - EX
- WORK( I ) = ABS( BI ) + ABS( CX ) + ABS( DX ) + ABS( EX )
- 30 CONTINUE
- BI = B( N, J )
- CX = E( N-1 )*X( N-1, J )
- DX = D( N )*X( N, J )
- WORK( N+N ) = BI - CX - DX
- WORK( N ) = ABS( BI ) + ABS( CX ) + ABS( DX )
- END IF
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- S = ZERO
- DO 40 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 40 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DPTTRS( N, 1, DF, EF, WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
- DO 50 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 50 CONTINUE
- IX = IDAMAX( N, WORK, 1 )
- FERR( J ) = WORK( IX )
-*
-* Estimate the norm of inv(A).
-*
-* Solve M(A) * x = e, where M(A) = (m(i,j)) is given by
-*
-* m(i,j) = abs(A(i,j)), i = j,
-* m(i,j) = -abs(A(i,j)), i .ne. j,
-*
-* and e = [ 1, 1, ..., 1 ]**T. Note M(A) = M(L)*D*M(L)**T.
-*
-* Solve M(L) * x = e.
-*
- WORK( 1 ) = ONE
- DO 60 I = 2, N
- WORK( I ) = ONE + WORK( I-1 )*ABS( EF( I-1 ) )
- 60 CONTINUE
-*
-* Solve D * M(L)**T * x = b.
-*
- WORK( N ) = WORK( N ) / DF( N )
- DO 70 I = N - 1, 1, -1
- WORK( I ) = WORK( I ) / DF( I ) + WORK( I+1 )*ABS( EF( I ) )
- 70 CONTINUE
-*
-* Compute norm(inv(A)) = max(x(i)), 1<=i<=n.
-*
- IX = IDAMAX( N, WORK, 1 )
- FERR( J ) = FERR( J )*ABS( WORK( IX ) )
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 80 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 80 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 90 CONTINUE
-*
- RETURN
-*
-* End of DPTRFS
-*
- END
diff --git a/netlib/LAPACK/dptsv.f b/netlib/LAPACK/dptsv.f
deleted file mode 100644
index ffc79b3..0000000
--- a/netlib/LAPACK/dptsv.f
+++ /dev/null
@@ -1,167 +0,0 @@
-*> \brief <b> DPTSV computes the solution to system of linear equations A * X = B for PT matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTSV( N, NRHS, D, E, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTSV computes the solution to a real system of linear equations
-*> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
-*> matrix, and X and B are N-by-NRHS matrices.
-*>
-*> A is factored as A = L*D*L**T, and the factored form of A is then
-*> used to solve the system of equations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A. On exit, the n diagonal elements of the diagonal matrix
-*> D from the factorization A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A. On exit, the (n-1) subdiagonal elements of the
-*> unit bidiagonal factor L from the L*D*L**T factorization of
-*> A. (E can also be regarded as the superdiagonal of the unit
-*> bidiagonal factor U from the U**T*D*U factorization of A.)
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the solution has not been
-*> computed. The factorization has not been completed
-*> unless i = N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTsolve
-*
-* =====================================================================
- SUBROUTINE DPTSV( N, NRHS, D, E, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL DPTTRF, DPTTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPTSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the L*D*L**T (or U**T*D*U) factorization of A.
-*
- CALL DPTTRF( N, D, E, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DPTTRS( N, NRHS, D, E, B, LDB, INFO )
- END IF
- RETURN
-*
-* End of DPTSV
-*
- END
diff --git a/netlib/LAPACK/dptsvx.f b/netlib/LAPACK/dptsvx.f
deleted file mode 100644
index 6f2357a..0000000
--- a/netlib/LAPACK/dptsvx.f
+++ /dev/null
@@ -1,336 +0,0 @@
-*> \brief <b> DPTSVX computes the solution to system of linear equations A * X = B for PT matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
-* RCOND, FERR, BERR, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT
-* INTEGER INFO, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ E( * ), EF( * ), FERR( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTSVX uses the factorization A = L*D*L**T to compute the solution
-*> to a real system of linear equations A*X = B, where A is an N-by-N
-*> symmetric positive definite tridiagonal matrix and X and B are
-*> N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
-*> is a unit lower bidiagonal matrix and D is diagonal. The
-*> factorization can also be regarded as having the form
-*> A = U**T*D*U.
-*>
-*> 2. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': On entry, DF and EF contain the factored form of A.
-*> D, E, DF, and EF will not be modified.
-*> = 'N': The matrix A will be copied to DF and EF and
-*> factored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] DF
-*> \verbatim
-*> DF is DOUBLE PRECISION array, dimension (N)
-*> If FACT = 'F', then DF is an input argument and on entry
-*> contains the n diagonal elements of the diagonal matrix D
-*> from the L*D*L**T factorization of A.
-*> If FACT = 'N', then DF is an output argument and on exit
-*> contains the n diagonal elements of the diagonal matrix D
-*> from the L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] EF
-*> \verbatim
-*> EF is DOUBLE PRECISION array, dimension (N-1)
-*> If FACT = 'F', then EF is an input argument and on entry
-*> contains the (n-1) subdiagonal elements of the unit
-*> bidiagonal factor L from the L*D*L**T factorization of A.
-*> If FACT = 'N', then EF is an output argument and on exit
-*> contains the (n-1) subdiagonal elements of the unit
-*> bidiagonal factor L from the L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal condition number of the matrix A. If RCOND
-*> is less than the machine precision (in particular, if
-*> RCOND = 0), the matrix is singular to working precision.
-*> This condition is indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j).
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in any
-*> element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTsolve
-*
-* =====================================================================
- SUBROUTINE DPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
- $ RCOND, FERR, BERR, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT
- INTEGER INFO, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ E( * ), EF( * ), FERR( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT
- DOUBLE PRECISION ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DPTCON, DPTRFS, DPTTRF, DPTTRS,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPTSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the L*D*L**T (or U**T*D*U) factorization of A.
-*
- CALL DCOPY( N, D, 1, DF, 1 )
- IF( N.GT.1 )
- $ CALL DCOPY( N-1, E, 1, EF, 1 )
- CALL DPTTRF( N, DF, EF, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = DLANST( '1', N, D, E )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DPTCON( N, DF, EF, ANORM, RCOND, WORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DPTTRS( N, NRHS, DF, EF, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL DPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR,
- $ WORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DPTSVX
-*
- END
diff --git a/netlib/LAPACK/dpttrf.f b/netlib/LAPACK/dpttrf.f
deleted file mode 100644
index e21327c..0000000
--- a/netlib/LAPACK/dpttrf.f
+++ /dev/null
@@ -1,211 +0,0 @@
-*> \brief \b DPTTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpttrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpttrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpttrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTTRF( N, D, E, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTTRF computes the L*D*L**T factorization of a real symmetric
-*> positive definite tridiagonal matrix A. The factorization may also
-*> be regarded as having the form A = U**T*D*U.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A. On exit, the n diagonal elements of the diagonal matrix
-*> D from the L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A. On exit, the (n-1) subdiagonal elements of the
-*> unit bidiagonal factor L from the L*D*L**T factorization of A.
-*> E can also be regarded as the superdiagonal of the unit
-*> bidiagonal factor U from the U**T*D*U factorization of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, the leading minor of order k is not
-*> positive definite; if k < N, the factorization could not
-*> be completed, while if k = N, the factorization was
-*> completed, but D(N) <= 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTcomputational
-*
-* =====================================================================
- SUBROUTINE DPTTRF( N, D, E, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I4
- DOUBLE PRECISION EI
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DPTTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Compute the L*D*L**T (or U**T*D*U) factorization of A.
-*
- I4 = MOD( N-1, 4 )
- DO 10 I = 1, I4
- IF( D( I ).LE.ZERO ) THEN
- INFO = I
- GO TO 30
- END IF
- EI = E( I )
- E( I ) = EI / D( I )
- D( I+1 ) = D( I+1 ) - E( I )*EI
- 10 CONTINUE
-*
- DO 20 I = I4 + 1, N - 4, 4
-*
-* Drop out of the loop if d(i) <= 0: the matrix is not positive
-* definite.
-*
- IF( D( I ).LE.ZERO ) THEN
- INFO = I
- GO TO 30
- END IF
-*
-* Solve for e(i) and d(i+1).
-*
- EI = E( I )
- E( I ) = EI / D( I )
- D( I+1 ) = D( I+1 ) - E( I )*EI
-*
- IF( D( I+1 ).LE.ZERO ) THEN
- INFO = I + 1
- GO TO 30
- END IF
-*
-* Solve for e(i+1) and d(i+2).
-*
- EI = E( I+1 )
- E( I+1 ) = EI / D( I+1 )
- D( I+2 ) = D( I+2 ) - E( I+1 )*EI
-*
- IF( D( I+2 ).LE.ZERO ) THEN
- INFO = I + 2
- GO TO 30
- END IF
-*
-* Solve for e(i+2) and d(i+3).
-*
- EI = E( I+2 )
- E( I+2 ) = EI / D( I+2 )
- D( I+3 ) = D( I+3 ) - E( I+2 )*EI
-*
- IF( D( I+3 ).LE.ZERO ) THEN
- INFO = I + 3
- GO TO 30
- END IF
-*
-* Solve for e(i+3) and d(i+4).
-*
- EI = E( I+3 )
- E( I+3 ) = EI / D( I+3 )
- D( I+4 ) = D( I+4 ) - E( I+3 )*EI
- 20 CONTINUE
-*
-* Check d(n) for positive definiteness.
-*
- IF( D( N ).LE.ZERO )
- $ INFO = N
-*
- 30 CONTINUE
- RETURN
-*
-* End of DPTTRF
-*
- END
diff --git a/netlib/LAPACK/dpttrs.f b/netlib/LAPACK/dpttrs.f
deleted file mode 100644
index ae34683..0000000
--- a/netlib/LAPACK/dpttrs.f
+++ /dev/null
@@ -1,182 +0,0 @@
-*> \brief \b DPTTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpttrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpttrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpttrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTTRS( N, NRHS, D, E, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTTRS solves a tridiagonal system of the form
-*> A * X = B
-*> using the L*D*L**T factorization of A computed by DPTTRF. D is a
-*> diagonal matrix specified in the vector D, L is a unit bidiagonal
-*> matrix whose subdiagonal is specified in the vector E, and X and B
-*> are N by NRHS matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal factor
-*> L from the L*D*L**T factorization of A. E can also be regarded
-*> as the superdiagonal of the unit bidiagonal factor U from the
-*> factorization A = U**T*D*U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side vectors B for the system of
-*> linear equations.
-*> On exit, the solution vectors, X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTcomputational
-*
-* =====================================================================
- SUBROUTINE DPTTRS( N, NRHS, D, E, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DPTTS2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DPTTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Determine the number of right-hand sides to solve at a time.
-*
- IF( NRHS.EQ.1 ) THEN
- NB = 1
- ELSE
- NB = MAX( 1, ILAENV( 1, 'DPTTRS', ' ', N, NRHS, -1, -1 ) )
- END IF
-*
- IF( NB.GE.NRHS ) THEN
- CALL DPTTS2( N, NRHS, D, E, B, LDB )
- ELSE
- DO 10 J = 1, NRHS, NB
- JB = MIN( NRHS-J+1, NB )
- CALL DPTTS2( N, JB, D, E, B( 1, J ), LDB )
- 10 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DPTTRS
-*
- END
diff --git a/netlib/LAPACK/dptts2.f b/netlib/LAPACK/dptts2.f
deleted file mode 100644
index 59aa6b8..0000000
--- a/netlib/LAPACK/dptts2.f
+++ /dev/null
@@ -1,158 +0,0 @@
-*> \brief \b DPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DPTTS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptts2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptts2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptts2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DPTTS2( N, NRHS, D, E, B, LDB )
-*
-* .. Scalar Arguments ..
-* INTEGER LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DPTTS2 solves a tridiagonal system of the form
-*> A * X = B
-*> using the L*D*L**T factorization of A computed by DPTTRF. D is a
-*> diagonal matrix specified in the vector D, L is a unit bidiagonal
-*> matrix whose subdiagonal is specified in the vector E, and X and B
-*> are N by NRHS matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal factor
-*> L from the L*D*L**T factorization of A. E can also be regarded
-*> as the superdiagonal of the unit bidiagonal factor U from the
-*> factorization A = U**T*D*U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side vectors B for the system of
-*> linear equations.
-*> On exit, the solution vectors, X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doublePTcomputational
-*
-* =====================================================================
- SUBROUTINE DPTTS2( N, NRHS, D, E, B, LDB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- IF( N.EQ.1 )
- $ CALL DSCAL( NRHS, 1.D0 / D( 1 ), B, LDB )
- RETURN
- END IF
-*
-* Solve A * X = B using the factorization A = L*D*L**T,
-* overwriting each right hand side vector with its solution.
-*
- DO 30 J = 1, NRHS
-*
-* Solve L * x = b.
-*
- DO 10 I = 2, N
- B( I, J ) = B( I, J ) - B( I-1, J )*E( I-1 )
- 10 CONTINUE
-*
-* Solve D * L**T * x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- DO 20 I = N - 1, 1, -1
- B( I, J ) = B( I, J ) / D( I ) - B( I+1, J )*E( I )
- 20 CONTINUE
- 30 CONTINUE
-*
- RETURN
-*
-* End of DPTTS2
-*
- END
diff --git a/netlib/LAPACK/drscl.f b/netlib/LAPACK/drscl.f
deleted file mode 100644
index 21ba19c..0000000
--- a/netlib/LAPACK/drscl.f
+++ /dev/null
@@ -1,174 +0,0 @@
-*> \brief \b DRSCL multiplies a vector by the reciprocal of a real scalar.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DRSCL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/drscl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/drscl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/drscl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DRSCL( N, SA, SX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION SA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION SX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DRSCL multiplies an n-element real vector x by the real scalar 1/a.
-*> This is done without overflow or underflow as long as
-*> the final result x/a does not overflow or underflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of components of the vector x.
-*> \endverbatim
-*>
-*> \param[in] SA
-*> \verbatim
-*> SA is DOUBLE PRECISION
-*> The scalar a which is used to divide each component of x.
-*> SA must be >= 0, or the subroutine will divide by zero.
-*> \endverbatim
-*>
-*> \param[in,out] SX
-*> \verbatim
-*> SX is DOUBLE PRECISION array, dimension
-*> (1+(N-1)*abs(INCX))
-*> The n-element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of the vector SX.
-*> > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DRSCL( N, SA, SX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION SA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION SX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DONE
- DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Initialize the denominator to SA and the numerator to 1.
-*
- CDEN = SA
- CNUM = ONE
-*
- 10 CONTINUE
- CDEN1 = CDEN*SMLNUM
- CNUM1 = CNUM / BIGNUM
- IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
-*
-* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
-*
- MUL = SMLNUM
- DONE = .FALSE.
- CDEN = CDEN1
- ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
-*
-* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
-*
- MUL = BIGNUM
- DONE = .FALSE.
- CNUM = CNUM1
- ELSE
-*
-* Multiply X by CNUM / CDEN and return.
-*
- MUL = CNUM / CDEN
- DONE = .TRUE.
- END IF
-*
-* Scale the vector X by MUL
-*
- CALL DSCAL( N, MUL, SX, INCX )
-*
- IF( .NOT.DONE )
- $ GO TO 10
-*
- RETURN
-*
-* End of DRSCL
-*
- END
diff --git a/netlib/LAPACK/dsbev.f b/netlib/LAPACK/dsbev.f
deleted file mode 100644
index fadf43e..0000000
--- a/netlib/LAPACK/dsbev.f
+++ /dev/null
@@ -1,287 +0,0 @@
-*> \brief <b> DSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KD, LDAB, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBEV computes all the eigenvalues and, optionally, eigenvectors of
-*> a real symmetric band matrix A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, AB is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the first
-*> superdiagonal and the diagonal of the tridiagonal matrix T
-*> are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
-*> the diagonal and first subdiagonal of T are returned in the
-*> first two rows of AB.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD + 1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (max(1,3*N-2))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KD, LDAB, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, WANTZ
- INTEGER IINFO, IMAX, INDE, INDWRK, ISCALE
- DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASCL, DSBTRD, DSCAL, DSTEQR, DSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBEV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( LOWER ) THEN
- W( 1 ) = AB( 1, 1 )
- ELSE
- W( 1 ) = AB( KD+1, 1 )
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = DLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- ELSE
- CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- END IF
- END IF
-*
-* Call DSBTRD to reduce symmetric band matrix to tridiagonal form.
-*
- INDE = 1
- INDWRK = INDE + N
- CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
- RETURN
-*
-* End of DSBEV
-*
- END
diff --git a/netlib/LAPACK/dsbevd.f b/netlib/LAPACK/dsbevd.f
deleted file mode 100644
index 0ae815b..0000000
--- a/netlib/LAPACK/dsbevd.f
+++ /dev/null
@@ -1,360 +0,0 @@
-*> \brief <b> DSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
-* LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBEVD computes all the eigenvalues and, optionally, eigenvectors of
-*> a real symmetric band matrix A. If eigenvectors are desired, it uses
-*> a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, AB is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the first
-*> superdiagonal and the diagonal of the tridiagonal matrix T
-*> are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
-*> the diagonal and first subdiagonal of T are returned in the
-*> first two rows of AB.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD + 1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> IF N <= 1, LWORK must be at least 1.
-*> If JOBZ = 'N' and N > 2, LWORK must be at least 2*N.
-*> If JOBZ = 'V' and N > 2, LWORK must be at least
-*> ( 1 + 5*N + 2*N**2 ).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
- $ LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, LQUERY, WANTZ
- INTEGER IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
- $ LLWRK2, LWMIN
- DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLACPY, DLASCL, DSBTRD, DSCAL, DSTEDC,
- $ DSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 5*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
- END IF
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = AB( 1, 1 )
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = DLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- ELSE
- CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- END IF
- END IF
-*
-* Call DSBTRD to reduce symmetric band matrix to tridiagonal form.
-*
- INDE = 1
- INDWRK = INDE + N
- INDWK2 = INDWRK + N*N
- LLWRK2 = LWORK - INDWK2 + 1
- CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, call SSTEDC.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
- $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
- CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N,
- $ ZERO, WORK( INDWK2 ), N )
- CALL DLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL DSCAL( N, ONE / SIGMA, W, 1 )
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of DSBEVD
-*
- END
diff --git a/netlib/LAPACK/dsbevx.f b/netlib/LAPACK/dsbevx.f
deleted file mode 100644
index 39517fb..0000000
--- a/netlib/LAPACK/dsbevx.f
+++ /dev/null
@@ -1,536 +0,0 @@
-*> \brief <b> DSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
-* VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
-* IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric band matrix A. Eigenvalues and eigenvectors can
-*> be selected by specifying either a range of values or a range of
-*> indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found;
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found;
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, AB is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the first
-*> superdiagonal and the diagonal of the tridiagonal matrix T
-*> are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
-*> the diagonal and first subdiagonal of T are returned in the
-*> first two rows of AB.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD + 1.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> If JOBZ = 'V', the N-by-N orthogonal matrix used in the
-*> reduction to tridiagonal form.
-*> If JOBZ = 'N', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. If JOBZ = 'V', then
-*> LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing AB to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (7*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
- $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
- $ IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ
- CHARACTER ORDER
- INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
- $ INDISP, INDIWO, INDWRK, ISCALE, ITMP1, J, JJ,
- $ NSPLIT
- DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DSBTRD, DSCAL,
- $ DSTEBZ, DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
- LOWER = LSAME( UPLO, 'L' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -7
- ELSE IF( WANTZ .AND. LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -11
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -13
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
- $ INFO = -18
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBEVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- M = 1
- IF( LOWER ) THEN
- TMP1 = AB( 1, 1 )
- ELSE
- TMP1 = AB( KD+1, 1 )
- END IF
- IF( VALEIG ) THEN
- IF( .NOT.( VL.LT.TMP1 .AND. VU.GE.TMP1 ) )
- $ M = 0
- END IF
- IF( M.EQ.1 ) THEN
- W( 1 ) = TMP1
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- END IF
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF( VALEIG ) THEN
- VLL = VL
- VUU = VU
- ELSE
- VLL = ZERO
- VUU = ZERO
- END IF
- ANRM = DLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- ELSE
- CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- END IF
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* Call DSBTRD to reduce symmetric band matrix to tridiagonal form.
-*
- INDD = 1
- INDE = INDD + N
- INDWRK = INDE + N
- CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, WORK( INDD ),
- $ WORK( INDE ), Q, LDQ, WORK( INDWRK ), IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal
-* to zero, then call DSTERF or SSTEQR. If this fails for some
-* eigenvalue, then try DSTEBZ.
-*
- TEST = .FALSE.
- IF (INDEIG) THEN
- IF (IL.EQ.1 .AND. IU.EQ.N) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
- CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- IF( .NOT.WANTZ ) THEN
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL DLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 30
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by DSTEIN.
-*
- DO 20 J = 1, M
- CALL DCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
- CALL DGEMV( 'N', N, N, ONE, Q, LDQ, WORK, 1, ZERO,
- $ Z( 1, J ), 1 )
- 20 CONTINUE
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 30 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 50 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 40 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 40 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSBEVX
-*
- END
diff --git a/netlib/LAPACK/dsbgst.f b/netlib/LAPACK/dsbgst.f
deleted file mode 100644
index dce9b48..0000000
--- a/netlib/LAPACK/dsbgst.f
+++ /dev/null
@@ -1,1434 +0,0 @@
-*> \brief \b DSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBGST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbgst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbgst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbgst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X,
-* LDX, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO, VECT
-* INTEGER INFO, KA, KB, LDAB, LDBB, LDX, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBGST reduces a real symmetric-definite banded generalized
-*> eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
-*> such that C has the same bandwidth as A.
-*>
-*> B must have been previously factorized as S**T*S by DPBSTF, using a
-*> split Cholesky factorization. A is overwritten by C = X**T*A*X, where
-*> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the
-*> bandwidth of A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'N': do not form the transformation matrix X;
-*> = 'V': form X.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the transformed matrix X**T*A*X, stored in the same
-*> format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in] BB
-*> \verbatim
-*> BB is DOUBLE PRECISION array, dimension (LDBB,N)
-*> The banded factor S from the split Cholesky factorization of
-*> B, as returned by DPBSTF, stored in the first KB+1 rows of
-*> the array.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,N)
-*> If VECT = 'V', the n-by-n matrix X.
-*> If VECT = 'N', the array X is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X.
-*> LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X,
- $ LDX, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO, VECT
- INTEGER INFO, KA, KB, LDAB, LDBB, LDX, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPDATE, UPPER, WANTX
- INTEGER I, I0, I1, I2, INCA, J, J1, J1T, J2, J2T, K,
- $ KA1, KB1, KBT, L, M, NR, NRT, NX
- DOUBLE PRECISION BII, RA, RA1, T
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGER, DLAR2V, DLARGV, DLARTG, DLARTV, DLASET,
- $ DROT, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTX = LSAME( VECT, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- KA1 = KA + 1
- KB1 = KB + 1
- INFO = 0
- IF( .NOT.WANTX .AND. .NOT.LSAME( VECT, 'N' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KA.LT.0 ) THEN
- INFO = -4
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -7
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -9
- ELSE IF( LDX.LT.1 .OR. WANTX .AND. LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBGST', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- INCA = LDAB*KA1
-*
-* Initialize X to the unit matrix, if needed
-*
- IF( WANTX )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, X, LDX )
-*
-* Set M to the splitting point m. It must be the same value as is
-* used in DPBSTF. The chosen value allows the arrays WORK and RWORK
-* to be of dimension (N).
-*
- M = ( N+KB ) / 2
-*
-* The routine works in two phases, corresponding to the two halves
-* of the split Cholesky factorization of B as S**T*S where
-*
-* S = ( U )
-* ( M L )
-*
-* with U upper triangular of order m, and L lower triangular of
-* order n-m. S has the same bandwidth as B.
-*
-* S is treated as a product of elementary matrices:
-*
-* S = S(m)*S(m-1)*...*S(2)*S(1)*S(m+1)*S(m+2)*...*S(n-1)*S(n)
-*
-* where S(i) is determined by the i-th row of S.
-*
-* In phase 1, the index i takes the values n, n-1, ... , m+1;
-* in phase 2, it takes the values 1, 2, ... , m.
-*
-* For each value of i, the current matrix A is updated by forming
-* inv(S(i))**T*A*inv(S(i)). This creates a triangular bulge outside
-* the band of A. The bulge is then pushed down toward the bottom of
-* A in phase 1, and up toward the top of A in phase 2, by applying
-* plane rotations.
-*
-* There are kb*(kb+1)/2 elements in the bulge, but at most 2*kb-1
-* of them are linearly independent, so annihilating a bulge requires
-* only 2*kb-1 plane rotations. The rotations are divided into a 1st
-* set of kb-1 rotations, and a 2nd set of kb rotations.
-*
-* Wherever possible, rotations are generated and applied in vector
-* operations of length NR between the indices J1 and J2 (sometimes
-* replaced by modified values NRT, J1T or J2T).
-*
-* The cosines and sines of the rotations are stored in the array
-* WORK. The cosines of the 1st set of rotations are stored in
-* elements n+2:n+m-kb-1 and the sines of the 1st set in elements
-* 2:m-kb-1; the cosines of the 2nd set are stored in elements
-* n+m-kb+1:2*n and the sines of the second set in elements m-kb+1:n.
-*
-* The bulges are not formed explicitly; nonzero elements outside the
-* band are created only when they are required for generating new
-* rotations; they are stored in the array WORK, in positions where
-* they are later overwritten by the sines of the rotations which
-* annihilate them.
-*
-* **************************** Phase 1 *****************************
-*
-* The logical structure of this phase is:
-*
-* UPDATE = .TRUE.
-* DO I = N, M + 1, -1
-* use S(i) to update A and create a new bulge
-* apply rotations to push all bulges KA positions downward
-* END DO
-* UPDATE = .FALSE.
-* DO I = M + KA + 1, N - 1
-* apply rotations to push all bulges KA positions downward
-* END DO
-*
-* To avoid duplicating code, the two loops are merged.
-*
- UPDATE = .TRUE.
- I = N + 1
- 10 CONTINUE
- IF( UPDATE ) THEN
- I = I - 1
- KBT = MIN( KB, I-1 )
- I0 = I - 1
- I1 = MIN( N, I+KA )
- I2 = I - KBT + KA1
- IF( I.LT.M+1 ) THEN
- UPDATE = .FALSE.
- I = I + 1
- I0 = M
- IF( KA.EQ.0 )
- $ GO TO 480
- GO TO 10
- END IF
- ELSE
- I = I + KA
- IF( I.GT.N-1 )
- $ GO TO 480
- END IF
-*
- IF( UPPER ) THEN
-*
-* Transform A, working with the upper triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( KB1, I )
- DO 20 J = I, I1
- AB( I-J+KA1, J ) = AB( I-J+KA1, J ) / BII
- 20 CONTINUE
- DO 30 J = MAX( 1, I-KA ), I
- AB( J-I+KA1, I ) = AB( J-I+KA1, I ) / BII
- 30 CONTINUE
- DO 60 K = I - KBT, I - 1
- DO 40 J = I - KBT, K
- AB( J-K+KA1, K ) = AB( J-K+KA1, K ) -
- $ BB( J-I+KB1, I )*AB( K-I+KA1, I ) -
- $ BB( K-I+KB1, I )*AB( J-I+KA1, I ) +
- $ AB( KA1, I )*BB( J-I+KB1, I )*
- $ BB( K-I+KB1, I )
- 40 CONTINUE
- DO 50 J = MAX( 1, I-KA ), I - KBT - 1
- AB( J-K+KA1, K ) = AB( J-K+KA1, K ) -
- $ BB( K-I+KB1, I )*AB( J-I+KA1, I )
- 50 CONTINUE
- 60 CONTINUE
- DO 80 J = I, I1
- DO 70 K = MAX( J-KA, I-KBT ), I - 1
- AB( K-J+KA1, J ) = AB( K-J+KA1, J ) -
- $ BB( K-I+KB1, I )*AB( I-J+KA1, J )
- 70 CONTINUE
- 80 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL DSCAL( N-M, ONE / BII, X( M+1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL DGER( N-M, KBT, -ONE, X( M+1, I ), 1,
- $ BB( KB1-KBT, I ), 1, X( M+1, I-KBT ), LDX )
- END IF
-*
-* store a(i,i1) in RA1 for use in next loop over K
-*
- RA1 = AB( I-I1+KA1, I1 )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions down toward the bottom of the
-* band
-*
- DO 130 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I-K+KA.LT.N .AND. I-K.GT.1 ) THEN
-*
-* generate rotation to annihilate a(i,i-k+ka+1)
-*
- CALL DLARTG( AB( K+1, I-K+KA ), RA1,
- $ WORK( N+I-K+KA-M ), WORK( I-K+KA-M ),
- $ RA )
-*
-* create nonzero element a(i-k,i-k+ka+1) outside the
-* band and store it in WORK(i-k)
-*
- T = -BB( KB1-K, I )*RA1
- WORK( I-K ) = WORK( N+I-K+KA-M )*T -
- $ WORK( I-K+KA-M )*AB( 1, I-K+KA )
- AB( 1, I-K+KA ) = WORK( I-K+KA-M )*T +
- $ WORK( N+I-K+KA-M )*AB( 1, I-K+KA )
- RA1 = RA
- END IF
- END IF
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MAX( J2, I+2*KA-K+1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( N-J2T+KA ) / KA1
- DO 90 J = J2T, J1, KA1
-*
-* create nonzero element a(j-ka,j+1) outside the band
-* and store it in WORK(j-m)
-*
- WORK( J-M ) = WORK( J-M )*AB( 1, J+1 )
- AB( 1, J+1 ) = WORK( N+J-M )*AB( 1, J+1 )
- 90 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL DLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), KA1,
- $ WORK( N+J2T-M ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the right
-*
- DO 100 L = 1, KA - 1
- CALL DLARTV( NR, AB( KA1-L, J2 ), INCA,
- $ AB( KA-L, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 100 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( KA1, J2 ), AB( KA1, J2+1 ),
- $ AB( KA, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the left
-*
- DO 110 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J2+KA1-L ), INCA,
- $ AB( L+1, J2+KA1-L ), INCA,
- $ WORK( N+J2-M ), WORK( J2-M ), KA1 )
- 110 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 120 J = J2, J1, KA1
- CALL DROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J-M ), WORK( J-M ) )
- 120 CONTINUE
- END IF
- 130 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.LE.N .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i-kbt,i-kbt+ka+1) outside the
-* band and store it in WORK(i-kbt)
-*
- WORK( I-KBT ) = -BB( KB1-KBT, I )*RA1
- END IF
- END IF
-*
- DO 170 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I - K - 1 + MAX( 2, K-I0+1 )*KA1
- ELSE
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the left
-*
- DO 140 L = KB - K, 1, -1
- NRT = ( N-J2+KA+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J2-L+1 ), INCA,
- $ AB( L+1, J2-L+1 ), INCA, WORK( N+J2-KA ),
- $ WORK( J2-KA ), KA1 )
- 140 CONTINUE
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- DO 150 J = J1, J2, -KA1
- WORK( J ) = WORK( J-KA )
- WORK( N+J ) = WORK( N+J-KA )
- 150 CONTINUE
- DO 160 J = J2, J1, KA1
-*
-* create nonzero element a(j-ka,j+1) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( 1, J+1 )
- AB( 1, J+1 ) = WORK( N+J )*AB( 1, J+1 )
- 160 CONTINUE
- IF( UPDATE ) THEN
- IF( I-K.LT.N-KA .AND. K.LE.KBT )
- $ WORK( I-K+KA ) = WORK( I-K )
- END IF
- 170 CONTINUE
-*
- DO 210 K = KB, 1, -1
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL DLARGV( NR, AB( 1, J2 ), INCA, WORK( J2 ), KA1,
- $ WORK( N+J2 ), KA1 )
-*
-* apply rotations in 2nd set from the right
-*
- DO 180 L = 1, KA - 1
- CALL DLARTV( NR, AB( KA1-L, J2 ), INCA,
- $ AB( KA-L, J2+1 ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 180 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( KA1, J2 ), AB( KA1, J2+1 ),
- $ AB( KA, J2+1 ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the left
-*
- DO 190 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J2+KA1-L ), INCA,
- $ AB( L+1, J2+KA1-L ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 190 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 200 J = J2, J1, KA1
- CALL DROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 200 CONTINUE
- END IF
- 210 CONTINUE
-*
- DO 230 K = 1, KB - 1
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
-*
-* finish applying rotations in 1st set from the left
-*
- DO 220 L = KB - K, 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J2+KA1-L ), INCA,
- $ AB( L+1, J2+KA1-L ), INCA,
- $ WORK( N+J2-M ), WORK( J2-M ), KA1 )
- 220 CONTINUE
- 230 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 240 J = N - 1, I - KB + 2*KA + 1, -1
- WORK( N+J-M ) = WORK( N+J-KA-M )
- WORK( J-M ) = WORK( J-KA-M )
- 240 CONTINUE
- END IF
-*
- ELSE
-*
-* Transform A, working with the lower triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( 1, I )
- DO 250 J = I, I1
- AB( J-I+1, I ) = AB( J-I+1, I ) / BII
- 250 CONTINUE
- DO 260 J = MAX( 1, I-KA ), I
- AB( I-J+1, J ) = AB( I-J+1, J ) / BII
- 260 CONTINUE
- DO 290 K = I - KBT, I - 1
- DO 270 J = I - KBT, K
- AB( K-J+1, J ) = AB( K-J+1, J ) -
- $ BB( I-J+1, J )*AB( I-K+1, K ) -
- $ BB( I-K+1, K )*AB( I-J+1, J ) +
- $ AB( 1, I )*BB( I-J+1, J )*
- $ BB( I-K+1, K )
- 270 CONTINUE
- DO 280 J = MAX( 1, I-KA ), I - KBT - 1
- AB( K-J+1, J ) = AB( K-J+1, J ) -
- $ BB( I-K+1, K )*AB( I-J+1, J )
- 280 CONTINUE
- 290 CONTINUE
- DO 310 J = I, I1
- DO 300 K = MAX( J-KA, I-KBT ), I - 1
- AB( J-K+1, K ) = AB( J-K+1, K ) -
- $ BB( I-K+1, K )*AB( J-I+1, I )
- 300 CONTINUE
- 310 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL DSCAL( N-M, ONE / BII, X( M+1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL DGER( N-M, KBT, -ONE, X( M+1, I ), 1,
- $ BB( KBT+1, I-KBT ), LDBB-1,
- $ X( M+1, I-KBT ), LDX )
- END IF
-*
-* store a(i1,i) in RA1 for use in next loop over K
-*
- RA1 = AB( I1-I+1, I )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions down toward the bottom of the
-* band
-*
- DO 360 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I-K+KA.LT.N .AND. I-K.GT.1 ) THEN
-*
-* generate rotation to annihilate a(i-k+ka+1,i)
-*
- CALL DLARTG( AB( KA1-K, I ), RA1, WORK( N+I-K+KA-M ),
- $ WORK( I-K+KA-M ), RA )
-*
-* create nonzero element a(i-k+ka+1,i-k) outside the
-* band and store it in WORK(i-k)
-*
- T = -BB( K+1, I-K )*RA1
- WORK( I-K ) = WORK( N+I-K+KA-M )*T -
- $ WORK( I-K+KA-M )*AB( KA1, I-K )
- AB( KA1, I-K ) = WORK( I-K+KA-M )*T +
- $ WORK( N+I-K+KA-M )*AB( KA1, I-K )
- RA1 = RA
- END IF
- END IF
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MAX( J2, I+2*KA-K+1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( N-J2T+KA ) / KA1
- DO 320 J = J2T, J1, KA1
-*
-* create nonzero element a(j+1,j-ka) outside the band
-* and store it in WORK(j-m)
-*
- WORK( J-M ) = WORK( J-M )*AB( KA1, J-KA+1 )
- AB( KA1, J-KA+1 ) = WORK( N+J-M )*AB( KA1, J-KA+1 )
- 320 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL DLARGV( NRT, AB( KA1, J2T-KA ), INCA, WORK( J2T-M ),
- $ KA1, WORK( N+J2T-M ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the left
-*
- DO 330 L = 1, KA - 1
- CALL DLARTV( NR, AB( L+1, J2-L ), INCA,
- $ AB( L+2, J2-L ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 330 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ),
- $ INCA, WORK( N+J2-M ), WORK( J2-M ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the right
-*
- DO 340 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J2 ), INCA,
- $ AB( KA1-L, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 340 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 350 J = J2, J1, KA1
- CALL DROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J-M ), WORK( J-M ) )
- 350 CONTINUE
- END IF
- 360 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.LE.N .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i-kbt+ka+1,i-kbt) outside the
-* band and store it in WORK(i-kbt)
-*
- WORK( I-KBT ) = -BB( KBT+1, I-KBT )*RA1
- END IF
- END IF
-*
- DO 400 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I - K - 1 + MAX( 2, K-I0+1 )*KA1
- ELSE
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the right
-*
- DO 370 L = KB - K, 1, -1
- NRT = ( N-J2+KA+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J2-KA ), INCA,
- $ AB( KA1-L, J2-KA+1 ), INCA,
- $ WORK( N+J2-KA ), WORK( J2-KA ), KA1 )
- 370 CONTINUE
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- DO 380 J = J1, J2, -KA1
- WORK( J ) = WORK( J-KA )
- WORK( N+J ) = WORK( N+J-KA )
- 380 CONTINUE
- DO 390 J = J2, J1, KA1
-*
-* create nonzero element a(j+1,j-ka) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( KA1, J-KA+1 )
- AB( KA1, J-KA+1 ) = WORK( N+J )*AB( KA1, J-KA+1 )
- 390 CONTINUE
- IF( UPDATE ) THEN
- IF( I-K.LT.N-KA .AND. K.LE.KBT )
- $ WORK( I-K+KA ) = WORK( I-K )
- END IF
- 400 CONTINUE
-*
- DO 440 K = KB, 1, -1
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL DLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), KA1,
- $ WORK( N+J2 ), KA1 )
-*
-* apply rotations in 2nd set from the left
-*
- DO 410 L = 1, KA - 1
- CALL DLARTV( NR, AB( L+1, J2-L ), INCA,
- $ AB( L+2, J2-L ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 410 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ),
- $ INCA, WORK( N+J2 ), WORK( J2 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the right
-*
- DO 420 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J2 ), INCA,
- $ AB( KA1-L, J2+1 ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 420 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 430 J = J2, J1, KA1
- CALL DROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 430 CONTINUE
- END IF
- 440 CONTINUE
-*
- DO 460 K = 1, KB - 1
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
-*
-* finish applying rotations in 1st set from the right
-*
- DO 450 L = KB - K, 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J2 ), INCA,
- $ AB( KA1-L, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 450 CONTINUE
- 460 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 470 J = N - 1, I - KB + 2*KA + 1, -1
- WORK( N+J-M ) = WORK( N+J-KA-M )
- WORK( J-M ) = WORK( J-KA-M )
- 470 CONTINUE
- END IF
-*
- END IF
-*
- GO TO 10
-*
- 480 CONTINUE
-*
-* **************************** Phase 2 *****************************
-*
-* The logical structure of this phase is:
-*
-* UPDATE = .TRUE.
-* DO I = 1, M
-* use S(i) to update A and create a new bulge
-* apply rotations to push all bulges KA positions upward
-* END DO
-* UPDATE = .FALSE.
-* DO I = M - KA - 1, 2, -1
-* apply rotations to push all bulges KA positions upward
-* END DO
-*
-* To avoid duplicating code, the two loops are merged.
-*
- UPDATE = .TRUE.
- I = 0
- 490 CONTINUE
- IF( UPDATE ) THEN
- I = I + 1
- KBT = MIN( KB, M-I )
- I0 = I + 1
- I1 = MAX( 1, I-KA )
- I2 = I + KBT - KA1
- IF( I.GT.M ) THEN
- UPDATE = .FALSE.
- I = I - 1
- I0 = M + 1
- IF( KA.EQ.0 )
- $ RETURN
- GO TO 490
- END IF
- ELSE
- I = I - KA
- IF( I.LT.2 )
- $ RETURN
- END IF
-*
- IF( I.LT.M-KBT ) THEN
- NX = M
- ELSE
- NX = N
- END IF
-*
- IF( UPPER ) THEN
-*
-* Transform A, working with the upper triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( KB1, I )
- DO 500 J = I1, I
- AB( J-I+KA1, I ) = AB( J-I+KA1, I ) / BII
- 500 CONTINUE
- DO 510 J = I, MIN( N, I+KA )
- AB( I-J+KA1, J ) = AB( I-J+KA1, J ) / BII
- 510 CONTINUE
- DO 540 K = I + 1, I + KBT
- DO 520 J = K, I + KBT
- AB( K-J+KA1, J ) = AB( K-J+KA1, J ) -
- $ BB( I-J+KB1, J )*AB( I-K+KA1, K ) -
- $ BB( I-K+KB1, K )*AB( I-J+KA1, J ) +
- $ AB( KA1, I )*BB( I-J+KB1, J )*
- $ BB( I-K+KB1, K )
- 520 CONTINUE
- DO 530 J = I + KBT + 1, MIN( N, I+KA )
- AB( K-J+KA1, J ) = AB( K-J+KA1, J ) -
- $ BB( I-K+KB1, K )*AB( I-J+KA1, J )
- 530 CONTINUE
- 540 CONTINUE
- DO 560 J = I1, I
- DO 550 K = I + 1, MIN( J+KA, I+KBT )
- AB( J-K+KA1, K ) = AB( J-K+KA1, K ) -
- $ BB( I-K+KB1, K )*AB( J-I+KA1, I )
- 550 CONTINUE
- 560 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL DSCAL( NX, ONE / BII, X( 1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL DGER( NX, KBT, -ONE, X( 1, I ), 1, BB( KB, I+1 ),
- $ LDBB-1, X( 1, I+1 ), LDX )
- END IF
-*
-* store a(i1,i) in RA1 for use in next loop over K
-*
- RA1 = AB( I1-I+KA1, I )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions up toward the top of the band
-*
- DO 610 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I+K-KA1.GT.0 .AND. I+K.LT.M ) THEN
-*
-* generate rotation to annihilate a(i+k-ka-1,i)
-*
- CALL DLARTG( AB( K+1, I ), RA1, WORK( N+I+K-KA ),
- $ WORK( I+K-KA ), RA )
-*
-* create nonzero element a(i+k-ka-1,i+k) outside the
-* band and store it in WORK(m-kb+i+k)
-*
- T = -BB( KB1-K, I+K )*RA1
- WORK( M-KB+I+K ) = WORK( N+I+K-KA )*T -
- $ WORK( I+K-KA )*AB( 1, I+K )
- AB( 1, I+K ) = WORK( I+K-KA )*T +
- $ WORK( N+I+K-KA )*AB( 1, I+K )
- RA1 = RA
- END IF
- END IF
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MIN( J2, I-2*KA+K-1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( J2T+KA-1 ) / KA1
- DO 570 J = J1, J2T, KA1
-*
-* create nonzero element a(j-1,j+ka) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( 1, J+KA-1 )
- AB( 1, J+KA-1 ) = WORK( N+J )*AB( 1, J+KA-1 )
- 570 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL DLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), KA1,
- $ WORK( N+J1 ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the left
-*
- DO 580 L = 1, KA - 1
- CALL DLARTV( NR, AB( KA1-L, J1+L ), INCA,
- $ AB( KA-L, J1+L ), INCA, WORK( N+J1 ),
- $ WORK( J1 ), KA1 )
- 580 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( KA1, J1 ), AB( KA1, J1-1 ),
- $ AB( KA, J1 ), INCA, WORK( N+J1 ),
- $ WORK( J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the right
-*
- DO 590 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J1T ), INCA,
- $ AB( L+1, J1T-1 ), INCA, WORK( N+J1T ),
- $ WORK( J1T ), KA1 )
- 590 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 600 J = J1, J2, KA1
- CALL DROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 600 CONTINUE
- END IF
- 610 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.GT.0 .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i+kbt-ka-1,i+kbt) outside the
-* band and store it in WORK(m-kb+i+kbt)
-*
- WORK( M-KB+I+KBT ) = -BB( KB1-KBT, I+KBT )*RA1
- END IF
- END IF
-*
- DO 650 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I + K + 1 - MAX( 2, K+I0-M )*KA1
- ELSE
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the right
-*
- DO 620 L = KB - K, 1, -1
- NRT = ( J2+KA+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J1T+KA ), INCA,
- $ AB( L+1, J1T+KA-1 ), INCA,
- $ WORK( N+M-KB+J1T+KA ),
- $ WORK( M-KB+J1T+KA ), KA1 )
- 620 CONTINUE
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- DO 630 J = J1, J2, KA1
- WORK( M-KB+J ) = WORK( M-KB+J+KA )
- WORK( N+M-KB+J ) = WORK( N+M-KB+J+KA )
- 630 CONTINUE
- DO 640 J = J1, J2, KA1
-*
-* create nonzero element a(j-1,j+ka) outside the band
-* and store it in WORK(m-kb+j)
-*
- WORK( M-KB+J ) = WORK( M-KB+J )*AB( 1, J+KA-1 )
- AB( 1, J+KA-1 ) = WORK( N+M-KB+J )*AB( 1, J+KA-1 )
- 640 CONTINUE
- IF( UPDATE ) THEN
- IF( I+K.GT.KA1 .AND. K.LE.KBT )
- $ WORK( M-KB+I+K-KA ) = WORK( M-KB+I+K )
- END IF
- 650 CONTINUE
-*
- DO 690 K = KB, 1, -1
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL DLARGV( NR, AB( 1, J1+KA ), INCA, WORK( M-KB+J1 ),
- $ KA1, WORK( N+M-KB+J1 ), KA1 )
-*
-* apply rotations in 2nd set from the left
-*
- DO 660 L = 1, KA - 1
- CALL DLARTV( NR, AB( KA1-L, J1+L ), INCA,
- $ AB( KA-L, J1+L ), INCA,
- $ WORK( N+M-KB+J1 ), WORK( M-KB+J1 ), KA1 )
- 660 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( KA1, J1 ), AB( KA1, J1-1 ),
- $ AB( KA, J1 ), INCA, WORK( N+M-KB+J1 ),
- $ WORK( M-KB+J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the right
-*
- DO 670 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J1T ), INCA,
- $ AB( L+1, J1T-1 ), INCA,
- $ WORK( N+M-KB+J1T ), WORK( M-KB+J1T ),
- $ KA1 )
- 670 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 680 J = J1, J2, KA1
- CALL DROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+M-KB+J ), WORK( M-KB+J ) )
- 680 CONTINUE
- END IF
- 690 CONTINUE
-*
- DO 710 K = 1, KB - 1
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
-*
-* finish applying rotations in 1st set from the right
-*
- DO 700 L = KB - K, 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L, J1T ), INCA,
- $ AB( L+1, J1T-1 ), INCA, WORK( N+J1T ),
- $ WORK( J1T ), KA1 )
- 700 CONTINUE
- 710 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 720 J = 2, MIN( I+KB, M ) - 2*KA - 1
- WORK( N+J ) = WORK( N+J+KA )
- WORK( J ) = WORK( J+KA )
- 720 CONTINUE
- END IF
-*
- ELSE
-*
-* Transform A, working with the lower triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( 1, I )
- DO 730 J = I1, I
- AB( I-J+1, J ) = AB( I-J+1, J ) / BII
- 730 CONTINUE
- DO 740 J = I, MIN( N, I+KA )
- AB( J-I+1, I ) = AB( J-I+1, I ) / BII
- 740 CONTINUE
- DO 770 K = I + 1, I + KBT
- DO 750 J = K, I + KBT
- AB( J-K+1, K ) = AB( J-K+1, K ) -
- $ BB( J-I+1, I )*AB( K-I+1, I ) -
- $ BB( K-I+1, I )*AB( J-I+1, I ) +
- $ AB( 1, I )*BB( J-I+1, I )*
- $ BB( K-I+1, I )
- 750 CONTINUE
- DO 760 J = I + KBT + 1, MIN( N, I+KA )
- AB( J-K+1, K ) = AB( J-K+1, K ) -
- $ BB( K-I+1, I )*AB( J-I+1, I )
- 760 CONTINUE
- 770 CONTINUE
- DO 790 J = I1, I
- DO 780 K = I + 1, MIN( J+KA, I+KBT )
- AB( K-J+1, J ) = AB( K-J+1, J ) -
- $ BB( K-I+1, I )*AB( I-J+1, J )
- 780 CONTINUE
- 790 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL DSCAL( NX, ONE / BII, X( 1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL DGER( NX, KBT, -ONE, X( 1, I ), 1, BB( 2, I ), 1,
- $ X( 1, I+1 ), LDX )
- END IF
-*
-* store a(i,i1) in RA1 for use in next loop over K
-*
- RA1 = AB( I-I1+1, I1 )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions up toward the top of the band
-*
- DO 840 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I+K-KA1.GT.0 .AND. I+K.LT.M ) THEN
-*
-* generate rotation to annihilate a(i,i+k-ka-1)
-*
- CALL DLARTG( AB( KA1-K, I+K-KA ), RA1,
- $ WORK( N+I+K-KA ), WORK( I+K-KA ), RA )
-*
-* create nonzero element a(i+k,i+k-ka-1) outside the
-* band and store it in WORK(m-kb+i+k)
-*
- T = -BB( K+1, I )*RA1
- WORK( M-KB+I+K ) = WORK( N+I+K-KA )*T -
- $ WORK( I+K-KA )*AB( KA1, I+K-KA )
- AB( KA1, I+K-KA ) = WORK( I+K-KA )*T +
- $ WORK( N+I+K-KA )*AB( KA1, I+K-KA )
- RA1 = RA
- END IF
- END IF
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MIN( J2, I-2*KA+K-1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( J2T+KA-1 ) / KA1
- DO 800 J = J1, J2T, KA1
-*
-* create nonzero element a(j+ka,j-1) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( KA1, J-1 )
- AB( KA1, J-1 ) = WORK( N+J )*AB( KA1, J-1 )
- 800 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL DLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), KA1,
- $ WORK( N+J1 ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the right
-*
- DO 810 L = 1, KA - 1
- CALL DLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ),
- $ INCA, WORK( N+J1 ), WORK( J1 ), KA1 )
- 810 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( 1, J1 ), AB( 1, J1-1 ),
- $ AB( 2, J1-1 ), INCA, WORK( N+J1 ),
- $ WORK( J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the left
-*
- DO 820 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J1T-KA1+L ), INCA,
- $ AB( KA1-L, J1T-KA1+L ), INCA,
- $ WORK( N+J1T ), WORK( J1T ), KA1 )
- 820 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 830 J = J1, J2, KA1
- CALL DROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 830 CONTINUE
- END IF
- 840 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.GT.0 .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i+kbt,i+kbt-ka-1) outside the
-* band and store it in WORK(m-kb+i+kbt)
-*
- WORK( M-KB+I+KBT ) = -BB( KBT+1, I )*RA1
- END IF
- END IF
-*
- DO 880 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I + K + 1 - MAX( 2, K+I0-M )*KA1
- ELSE
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the left
-*
- DO 850 L = KB - K, 1, -1
- NRT = ( J2+KA+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J1T+L-1 ), INCA,
- $ AB( KA1-L, J1T+L-1 ), INCA,
- $ WORK( N+M-KB+J1T+KA ),
- $ WORK( M-KB+J1T+KA ), KA1 )
- 850 CONTINUE
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- DO 860 J = J1, J2, KA1
- WORK( M-KB+J ) = WORK( M-KB+J+KA )
- WORK( N+M-KB+J ) = WORK( N+M-KB+J+KA )
- 860 CONTINUE
- DO 870 J = J1, J2, KA1
-*
-* create nonzero element a(j+ka,j-1) outside the band
-* and store it in WORK(m-kb+j)
-*
- WORK( M-KB+J ) = WORK( M-KB+J )*AB( KA1, J-1 )
- AB( KA1, J-1 ) = WORK( N+M-KB+J )*AB( KA1, J-1 )
- 870 CONTINUE
- IF( UPDATE ) THEN
- IF( I+K.GT.KA1 .AND. K.LE.KBT )
- $ WORK( M-KB+I+K-KA ) = WORK( M-KB+I+K )
- END IF
- 880 CONTINUE
-*
- DO 920 K = KB, 1, -1
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL DLARGV( NR, AB( KA1, J1 ), INCA, WORK( M-KB+J1 ),
- $ KA1, WORK( N+M-KB+J1 ), KA1 )
-*
-* apply rotations in 2nd set from the right
-*
- DO 890 L = 1, KA - 1
- CALL DLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ),
- $ INCA, WORK( N+M-KB+J1 ), WORK( M-KB+J1 ),
- $ KA1 )
- 890 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL DLAR2V( NR, AB( 1, J1 ), AB( 1, J1-1 ),
- $ AB( 2, J1-1 ), INCA, WORK( N+M-KB+J1 ),
- $ WORK( M-KB+J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the left
-*
- DO 900 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J1T-KA1+L ), INCA,
- $ AB( KA1-L, J1T-KA1+L ), INCA,
- $ WORK( N+M-KB+J1T ), WORK( M-KB+J1T ),
- $ KA1 )
- 900 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 910 J = J1, J2, KA1
- CALL DROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+M-KB+J ), WORK( M-KB+J ) )
- 910 CONTINUE
- END IF
- 920 CONTINUE
-*
- DO 940 K = 1, KB - 1
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
-*
-* finish applying rotations in 1st set from the left
-*
- DO 930 L = KB - K, 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KA1-L+1, J1T-KA1+L ), INCA,
- $ AB( KA1-L, J1T-KA1+L ), INCA,
- $ WORK( N+J1T ), WORK( J1T ), KA1 )
- 930 CONTINUE
- 940 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 950 J = 2, MIN( I+KB, M ) - 2*KA - 1
- WORK( N+J ) = WORK( N+J+KA )
- WORK( J ) = WORK( J+KA )
- 950 CONTINUE
- END IF
-*
- END IF
-*
- GO TO 490
-*
-* End of DSBGST
-*
- END
diff --git a/netlib/LAPACK/dsbgv.f b/netlib/LAPACK/dsbgv.f
deleted file mode 100644
index 8e1b5ff..0000000
--- a/netlib/LAPACK/dsbgv.f
+++ /dev/null
@@ -1,280 +0,0 @@
-*> \brief \b DSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbgv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbgv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbgv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z,
-* LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), W( * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBGV computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite banded eigenproblem, of
-*> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
-*> and banded, and B is also positive definite.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the contents of AB are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in,out] BB
-*> \verbatim
-*> BB is DOUBLE PRECISION array, dimension (LDBB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix B, stored in the first kb+1 rows of the array. The
-*> j-th column of B is stored in the j-th column of the array BB
-*> as follows:
-*> if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
-*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
-*>
-*> On exit, the factor S from the split Cholesky factorization
-*> B = S**T*S, as returned by DPBSTF.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors, with the i-th column of Z holding the
-*> eigenvector associated with W(i). The eigenvectors are
-*> normalized so that Z**T*B*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is:
-*> <= N: the algorithm failed to converge:
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
-*> returned INFO = i: B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z,
- $ LDZ, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), W( * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER, WANTZ
- CHARACTER VECT
- INTEGER IINFO, INDE, INDWRK
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPBSTF, DSBGST, DSBTRD, DSTEQR, DSTERF, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KA.LT.0 ) THEN
- INFO = -4
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -7
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBGV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a split Cholesky factorization of B.
-*
- CALL DPBSTF( UPLO, N, KB, BB, LDBB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem.
-*
- INDE = 1
- INDWRK = INDE + N
- CALL DSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* Reduce to tridiagonal form.
-*
- IF( WANTZ ) THEN
- VECT = 'U'
- ELSE
- VECT = 'N'
- END IF
- CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
- $ INFO )
- END IF
- RETURN
-*
-* End of DSBGV
-*
- END
diff --git a/netlib/LAPACK/dsbgvd.f b/netlib/LAPACK/dsbgvd.f
deleted file mode 100644
index 7e8cafe..0000000
--- a/netlib/LAPACK/dsbgvd.f
+++ /dev/null
@@ -1,372 +0,0 @@
-*> \brief \b DSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBGVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbgvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbgvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbgvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W,
-* Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), W( * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBGVD computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite banded eigenproblem, of the
-*> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and
-*> banded, and B is also positive definite. If eigenvectors are
-*> desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the contents of AB are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in,out] BB
-*> \verbatim
-*> BB is DOUBLE PRECISION array, dimension (LDBB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix B, stored in the first kb+1 rows of the array. The
-*> j-th column of B is stored in the j-th column of the array BB
-*> as follows:
-*> if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
-*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
-*>
-*> On exit, the factor S from the split Cholesky factorization
-*> B = S**T*S, as returned by DPBSTF.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors, with the i-th column of Z holding the
-*> eigenvector associated with W(i). The eigenvectors are
-*> normalized so Z**T*B*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LWORK >= 3*N.
-*> If JOBZ = 'V' and N > 1, LWORK >= 1 + 5*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if LIWORK > 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK >= 1.
-*> If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is:
-*> <= N: the algorithm failed to converge:
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
-*> returned INFO = i: B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W,
- $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), W( * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER VECT
- INTEGER IINFO, INDE, INDWK2, INDWRK, LIWMIN, LLWRK2,
- $ LWMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLACPY, DPBSTF, DSBGST, DSBTRD, DSTEDC,
- $ DSTERF, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 5*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
-*
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KA.LT.0 ) THEN
- INFO = -4
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -7
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -14
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -16
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBGVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a split Cholesky factorization of B.
-*
- CALL DPBSTF( UPLO, N, KB, BB, LDBB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem.
-*
- INDE = 1
- INDWRK = INDE + N
- INDWK2 = INDWRK + N*N
- LLWRK2 = LWORK - INDWK2 + 1
- CALL DSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* Reduce to tridiagonal form.
-*
- IF( WANTZ ) THEN
- VECT = 'U'
- ELSE
- VECT = 'N'
- END IF
- CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, call SSTEDC.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
- $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
- CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N,
- $ ZERO, WORK( INDWK2 ), N )
- CALL DLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
- END IF
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DSBGVD
-*
- END
diff --git a/netlib/LAPACK/dsbgvx.f b/netlib/LAPACK/dsbgvx.f
deleted file mode 100644
index f6aae18..0000000
--- a/netlib/LAPACK/dsbgvx.f
+++ /dev/null
@@ -1,513 +0,0 @@
-*> \brief \b DSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBGVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbgvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbgvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbgvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
-* LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
-* LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
-* $ N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), Q( LDQ, * ),
-* $ W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBGVX computes selected eigenvalues, and optionally, eigenvectors
-*> of a real generalized symmetric-definite banded eigenproblem, of
-*> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
-*> and banded, and B is also positive definite. Eigenvalues and
-*> eigenvectors can be selected by specifying either all eigenvalues,
-*> a range of values or a range of indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the contents of AB are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in,out] BB
-*> \verbatim
-*> BB is DOUBLE PRECISION array, dimension (LDBB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix B, stored in the first kb+1 rows of the array. The
-*> j-th column of B is stored in the j-th column of the array BB
-*> as follows:
-*> if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
-*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
-*>
-*> On exit, the factor S from the split Cholesky factorization
-*> B = S**T*S, as returned by DPBSTF.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ, N)
-*> If JOBZ = 'V', the n-by-n matrix used in the reduction of
-*> A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
-*> and consequently C to tridiagonal form.
-*> If JOBZ = 'N', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. If JOBZ = 'N',
-*> LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors, with the i-th column of Z holding the
-*> eigenvector associated with W(i). The eigenvectors are
-*> normalized so Z**T*B*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (7*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (M)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvalues that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit
-*> < 0 : if INFO = -i, the i-th argument had an illegal value
-*> <= N: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in IFAIL.
-*> > N : DPBSTF returned an error code; i.e.,
-*> if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE DSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
- $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
- $ LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
- $ N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), BB( LDBB, * ), Q( LDQ, * ),
- $ W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
- CHARACTER ORDER, VECT
- INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP,
- $ INDIWO, INDWRK, ITMP1, J, JJ, NSPLIT
- DOUBLE PRECISION TMP1
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMV, DLACPY, DPBSTF, DSBGST, DSBTRD,
- $ DSTEBZ, DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KA.LT.0 ) THEN
- INFO = -5
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -8
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -10
- ELSE IF( LDQ.LT.1 .OR. ( WANTZ .AND. LDQ.LT.N ) ) THEN
- INFO = -12
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -14
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -15
- ELSE IF ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -16
- END IF
- END IF
- END IF
- IF( INFO.EQ.0) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -21
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBGVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a split Cholesky factorization of B.
-*
- CALL DPBSTF( UPLO, N, KB, BB, LDBB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem.
-*
- CALL DSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ,
- $ WORK, IINFO )
-*
-* Reduce symmetric band matrix to tridiagonal form.
-*
- INDD = 1
- INDE = INDD + N
- INDWRK = INDE + N
- IF( WANTZ ) THEN
- VECT = 'U'
- ELSE
- VECT = 'N'
- END IF
- CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, WORK( INDD ),
- $ WORK( INDE ), Q, LDQ, WORK( INDWRK ), IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal
-* to zero, then call DSTERF or SSTEQR. If this fails for some
-* eigenvalue, then try DSTEBZ.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
- CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL DLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
- CALL DSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 30
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired,
-* call DSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply transformation matrix used in reduction to tridiagonal
-* form to eigenvectors returned by DSTEIN.
-*
- DO 20 J = 1, M
- CALL DCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
- CALL DGEMV( 'N', N, N, ONE, Q, LDQ, WORK, 1, ZERO,
- $ Z( 1, J ), 1 )
- 20 CONTINUE
- END IF
-*
- 30 CONTINUE
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 50 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 40 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 40 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSBGVX
-*
- END
diff --git a/netlib/LAPACK/dsbtrd.f b/netlib/LAPACK/dsbtrd.f
deleted file mode 100644
index 528a3aa..0000000
--- a/netlib/LAPACK/dsbtrd.f
+++ /dev/null
@@ -1,641 +0,0 @@
-*> \brief \b DSBTRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSBTRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbtrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbtrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbtrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO, VECT
-* INTEGER INFO, KD, LDAB, LDQ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), D( * ), E( * ), Q( LDQ, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSBTRD reduces a real symmetric band matrix A to symmetric
-*> tridiagonal form T by an orthogonal similarity transformation:
-*> Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'N': do not form Q;
-*> = 'V': form Q;
-*> = 'U': update a matrix X, by forming X*Q.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> On exit, the diagonal elements of AB are overwritten by the
-*> diagonal elements of the tridiagonal matrix T; if KD > 0, the
-*> elements on the first superdiagonal (if UPLO = 'U') or the
-*> first subdiagonal (if UPLO = 'L') are overwritten by the
-*> off-diagonal elements of T; the rest of AB is overwritten by
-*> values generated during the reduction.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if VECT = 'U', then Q must contain an N-by-N
-*> matrix X; if VECT = 'N' or 'V', then Q need not be set.
-*>
-*> On exit:
-*> if VECT = 'V', Q contains the N-by-N orthogonal matrix Q;
-*> if VECT = 'U', Q contains the product X*Q;
-*> if VECT = 'N', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by Linda Kaufman, Bell Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO, VECT
- INTEGER INFO, KD, LDAB, LDQ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), D( * ), E( * ), Q( LDQ, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL INITQ, UPPER, WANTQ
- INTEGER I, I2, IBL, INCA, INCX, IQAEND, IQB, IQEND, J,
- $ J1, J1END, J1INC, J2, JEND, JIN, JINC, K, KD1,
- $ KDM1, KDN, L, LAST, LEND, NQ, NR, NRT
- DOUBLE PRECISION TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAR2V, DLARGV, DLARTG, DLARTV, DLASET, DROT,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INITQ = LSAME( VECT, 'V' )
- WANTQ = INITQ .OR. LSAME( VECT, 'U' )
- UPPER = LSAME( UPLO, 'U' )
- KD1 = KD + 1
- KDM1 = KD - 1
- INCX = LDAB - 1
- IQEND = 1
-*
- INFO = 0
- IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'N' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD1 ) THEN
- INFO = -6
- ELSE IF( LDQ.LT.MAX( 1, N ) .AND. WANTQ ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSBTRD', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize Q to the unit matrix, if needed
-*
- IF( INITQ )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
-*
-* Wherever possible, plane rotations are generated and applied in
-* vector operations of length NR over the index set J1:J2:KD1.
-*
-* The cosines and sines of the plane rotations are stored in the
-* arrays D and WORK.
-*
- INCA = KD1*LDAB
- KDN = MIN( N-1, KD )
- IF( UPPER ) THEN
-*
- IF( KD.GT.1 ) THEN
-*
-* Reduce to tridiagonal form, working with upper triangle
-*
- NR = 0
- J1 = KDN + 2
- J2 = 1
-*
- DO 90 I = 1, N - 2
-*
-* Reduce i-th row of matrix to tridiagonal form
-*
- DO 80 K = KDN + 1, 2, -1
- J1 = J1 + KDN
- J2 = J2 + KDN
-*
- IF( NR.GT.0 ) THEN
-*
-* generate plane rotations to annihilate nonzero
-* elements which have been created outside the band
-*
- CALL DLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ),
- $ KD1, D( J1 ), KD1 )
-*
-* apply rotations from the right
-*
-*
-* Dependent on the the number of diagonals either
-* DLARTV or DROT is used
-*
- IF( NR.GE.2*KD-1 ) THEN
- DO 10 L = 1, KD - 1
- CALL DLARTV( NR, AB( L+1, J1-1 ), INCA,
- $ AB( L, J1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
- 10 CONTINUE
-*
- ELSE
- JEND = J1 + ( NR-1 )*KD1
- DO 20 JINC = J1, JEND, KD1
- CALL DROT( KDM1, AB( 2, JINC-1 ), 1,
- $ AB( 1, JINC ), 1, D( JINC ),
- $ WORK( JINC ) )
- 20 CONTINUE
- END IF
- END IF
-*
-*
- IF( K.GT.2 ) THEN
- IF( K.LE.N-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i,i+k-1)
-* within the band
-*
- CALL DLARTG( AB( KD-K+3, I+K-2 ),
- $ AB( KD-K+2, I+K-1 ), D( I+K-1 ),
- $ WORK( I+K-1 ), TEMP )
- AB( KD-K+3, I+K-2 ) = TEMP
-*
-* apply rotation from the right
-*
- CALL DROT( K-3, AB( KD-K+4, I+K-2 ), 1,
- $ AB( KD-K+3, I+K-1 ), 1, D( I+K-1 ),
- $ WORK( I+K-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KDN - 1
- END IF
-*
-* apply plane rotations from both sides to diagonal
-* blocks
-*
- IF( NR.GT.0 )
- $ CALL DLAR2V( NR, AB( KD1, J1-1 ), AB( KD1, J1 ),
- $ AB( KD, J1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
-*
-* apply plane rotations from the left
-*
- IF( NR.GT.0 ) THEN
- IF( 2*KD-1.LT.NR ) THEN
-*
-* Dependent on the the number of diagonals either
-* DLARTV or DROT is used
-*
- DO 30 L = 1, KD - 1
- IF( J2+L.GT.N ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( KD-L, J1+L ), INCA,
- $ AB( KD-L+1, J1+L ), INCA,
- $ D( J1 ), WORK( J1 ), KD1 )
- 30 CONTINUE
- ELSE
- J1END = J1 + KD1*( NR-2 )
- IF( J1END.GE.J1 ) THEN
- DO 40 JIN = J1, J1END, KD1
- CALL DROT( KD-1, AB( KD-1, JIN+1 ), INCX,
- $ AB( KD, JIN+1 ), INCX,
- $ D( JIN ), WORK( JIN ) )
- 40 CONTINUE
- END IF
- LEND = MIN( KDM1, N-J2 )
- LAST = J1END + KD1
- IF( LEND.GT.0 )
- $ CALL DROT( LEND, AB( KD-1, LAST+1 ), INCX,
- $ AB( KD, LAST+1 ), INCX, D( LAST ),
- $ WORK( LAST ) )
- END IF
- END IF
-*
- IF( WANTQ ) THEN
-*
-* accumulate product of plane rotations in Q
-*
- IF( INITQ ) THEN
-*
-* take advantage of the fact that Q was
-* initially the Identity matrix
-*
- IQEND = MAX( IQEND, J2 )
- I2 = MAX( 0, K-3 )
- IQAEND = 1 + I*KD
- IF( K.EQ.2 )
- $ IQAEND = IQAEND + KD
- IQAEND = MIN( IQAEND, IQEND )
- DO 50 J = J1, J2, KD1
- IBL = I - I2 / KDM1
- I2 = I2 + 1
- IQB = MAX( 1, J-IBL )
- NQ = 1 + IQAEND - IQB
- IQAEND = MIN( IQAEND+KD, IQEND )
- CALL DROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ),
- $ 1, D( J ), WORK( J ) )
- 50 CONTINUE
- ELSE
-*
- DO 60 J = J1, J2, KD1
- CALL DROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1,
- $ D( J ), WORK( J ) )
- 60 CONTINUE
- END IF
-*
- END IF
-*
- IF( J2+KDN.GT.N ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KDN - 1
- END IF
-*
- DO 70 J = J1, J2, KD1
-*
-* create nonzero element a(j-1,j+kd) outside the band
-* and store it in WORK
-*
- WORK( J+KD ) = WORK( J )*AB( 1, J+KD )
- AB( 1, J+KD ) = D( J )*AB( 1, J+KD )
- 70 CONTINUE
- 80 CONTINUE
- 90 CONTINUE
- END IF
-*
- IF( KD.GT.0 ) THEN
-*
-* copy off-diagonal elements to E
-*
- DO 100 I = 1, N - 1
- E( I ) = AB( KD, I+1 )
- 100 CONTINUE
- ELSE
-*
-* set E to zero if original matrix was diagonal
-*
- DO 110 I = 1, N - 1
- E( I ) = ZERO
- 110 CONTINUE
- END IF
-*
-* copy diagonal elements to D
-*
- DO 120 I = 1, N
- D( I ) = AB( KD1, I )
- 120 CONTINUE
-*
- ELSE
-*
- IF( KD.GT.1 ) THEN
-*
-* Reduce to tridiagonal form, working with lower triangle
-*
- NR = 0
- J1 = KDN + 2
- J2 = 1
-*
- DO 210 I = 1, N - 2
-*
-* Reduce i-th column of matrix to tridiagonal form
-*
- DO 200 K = KDN + 1, 2, -1
- J1 = J1 + KDN
- J2 = J2 + KDN
-*
- IF( NR.GT.0 ) THEN
-*
-* generate plane rotations to annihilate nonzero
-* elements which have been created outside the band
-*
- CALL DLARGV( NR, AB( KD1, J1-KD1 ), INCA,
- $ WORK( J1 ), KD1, D( J1 ), KD1 )
-*
-* apply plane rotations from one side
-*
-*
-* Dependent on the the number of diagonals either
-* DLARTV or DROT is used
-*
- IF( NR.GT.2*KD-1 ) THEN
- DO 130 L = 1, KD - 1
- CALL DLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA,
- $ AB( KD1-L+1, J1-KD1+L ), INCA,
- $ D( J1 ), WORK( J1 ), KD1 )
- 130 CONTINUE
- ELSE
- JEND = J1 + KD1*( NR-1 )
- DO 140 JINC = J1, JEND, KD1
- CALL DROT( KDM1, AB( KD, JINC-KD ), INCX,
- $ AB( KD1, JINC-KD ), INCX,
- $ D( JINC ), WORK( JINC ) )
- 140 CONTINUE
- END IF
-*
- END IF
-*
- IF( K.GT.2 ) THEN
- IF( K.LE.N-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i+k-1,i)
-* within the band
-*
- CALL DLARTG( AB( K-1, I ), AB( K, I ),
- $ D( I+K-1 ), WORK( I+K-1 ), TEMP )
- AB( K-1, I ) = TEMP
-*
-* apply rotation from the left
-*
- CALL DROT( K-3, AB( K-2, I+1 ), LDAB-1,
- $ AB( K-1, I+1 ), LDAB-1, D( I+K-1 ),
- $ WORK( I+K-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KDN - 1
- END IF
-*
-* apply plane rotations from both sides to diagonal
-* blocks
-*
- IF( NR.GT.0 )
- $ CALL DLAR2V( NR, AB( 1, J1-1 ), AB( 1, J1 ),
- $ AB( 2, J1-1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
-*
-* apply plane rotations from the right
-*
-*
-* Dependent on the the number of diagonals either
-* DLARTV or DROT is used
-*
- IF( NR.GT.0 ) THEN
- IF( NR.GT.2*KD-1 ) THEN
- DO 150 L = 1, KD - 1
- IF( J2+L.GT.N ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL DLARTV( NRT, AB( L+2, J1-1 ), INCA,
- $ AB( L+1, J1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
- 150 CONTINUE
- ELSE
- J1END = J1 + KD1*( NR-2 )
- IF( J1END.GE.J1 ) THEN
- DO 160 J1INC = J1, J1END, KD1
- CALL DROT( KDM1, AB( 3, J1INC-1 ), 1,
- $ AB( 2, J1INC ), 1, D( J1INC ),
- $ WORK( J1INC ) )
- 160 CONTINUE
- END IF
- LEND = MIN( KDM1, N-J2 )
- LAST = J1END + KD1
- IF( LEND.GT.0 )
- $ CALL DROT( LEND, AB( 3, LAST-1 ), 1,
- $ AB( 2, LAST ), 1, D( LAST ),
- $ WORK( LAST ) )
- END IF
- END IF
-*
-*
-*
- IF( WANTQ ) THEN
-*
-* accumulate product of plane rotations in Q
-*
- IF( INITQ ) THEN
-*
-* take advantage of the fact that Q was
-* initially the Identity matrix
-*
- IQEND = MAX( IQEND, J2 )
- I2 = MAX( 0, K-3 )
- IQAEND = 1 + I*KD
- IF( K.EQ.2 )
- $ IQAEND = IQAEND + KD
- IQAEND = MIN( IQAEND, IQEND )
- DO 170 J = J1, J2, KD1
- IBL = I - I2 / KDM1
- I2 = I2 + 1
- IQB = MAX( 1, J-IBL )
- NQ = 1 + IQAEND - IQB
- IQAEND = MIN( IQAEND+KD, IQEND )
- CALL DROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ),
- $ 1, D( J ), WORK( J ) )
- 170 CONTINUE
- ELSE
-*
- DO 180 J = J1, J2, KD1
- CALL DROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1,
- $ D( J ), WORK( J ) )
- 180 CONTINUE
- END IF
- END IF
-*
- IF( J2+KDN.GT.N ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KDN - 1
- END IF
-*
- DO 190 J = J1, J2, KD1
-*
-* create nonzero element a(j+kd,j-1) outside the
-* band and store it in WORK
-*
- WORK( J+KD ) = WORK( J )*AB( KD1, J )
- AB( KD1, J ) = D( J )*AB( KD1, J )
- 190 CONTINUE
- 200 CONTINUE
- 210 CONTINUE
- END IF
-*
- IF( KD.GT.0 ) THEN
-*
-* copy off-diagonal elements to E
-*
- DO 220 I = 1, N - 1
- E( I ) = AB( 2, I )
- 220 CONTINUE
- ELSE
-*
-* set E to zero if original matrix was diagonal
-*
- DO 230 I = 1, N - 1
- E( I ) = ZERO
- 230 CONTINUE
- END IF
-*
-* copy diagonal elements to D
-*
- DO 240 I = 1, N
- D( I ) = AB( 1, I )
- 240 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSBTRD
-*
- END
diff --git a/netlib/LAPACK/dsfrk.f b/netlib/LAPACK/dsfrk.f
deleted file mode 100644
index 960330c..0000000
--- a/netlib/LAPACK/dsfrk.f
+++ /dev/null
@@ -1,544 +0,0 @@
-*> \brief \b DSFRK performs a symmetric rank-k operation for matrix in RFP format.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSFRK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsfrk.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsfrk.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsfrk.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
-* C )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA, BETA
-* INTEGER K, LDA, N
-* CHARACTER TRANS, TRANSR, UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Level 3 BLAS like routine for C in RFP Format.
-*>
-*> DSFRK performs one of the symmetric rank--k operations
-*>
-*> C := alpha*A*A**T + beta*C,
-*>
-*> or
-*>
-*> C := alpha*A**T*A + beta*C,
-*>
-*> where alpha and beta are real scalars, C is an n--by--n symmetric
-*> matrix and A is an n--by--k matrix in the first case and a k--by--n
-*> matrix in the second case.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal Form of RFP A is stored;
-*> = 'T': The Transpose Form of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the upper or lower
-*> triangular part of the array C is to be referenced as
-*> follows:
-*>
-*> UPLO = 'U' or 'u' Only the upper triangular part of C
-*> is to be referenced.
-*>
-*> UPLO = 'L' or 'l' Only the lower triangular part of C
-*> is to be referenced.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' C := alpha*A*A**T + beta*C.
-*>
-*> TRANS = 'T' or 't' C := alpha*A**T*A + beta*C.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix C. N must be
-*> at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> On entry with TRANS = 'N' or 'n', K specifies the number
-*> of columns of the matrix A, and on entry with TRANS = 'T'
-*> or 't', K specifies the number of rows of the matrix A. K
-*> must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,ka)
-*> where KA
-*> is K when TRANS = 'N' or 'n', and is N otherwise. Before
-*> entry with TRANS = 'N' or 'n', the leading N--by--K part of
-*> the array A must contain the matrix A, otherwise the leading
-*> K--by--N part of the array A must contain the matrix A.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. When TRANS = 'N' or 'n'
-*> then LDA must be at least max( 1, n ), otherwise LDA must
-*> be at least max( 1, k ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> On entry, BETA specifies the scalar beta.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (NT)
-*> NT = N*(N+1)/2. On entry, the symmetric matrix C in RFP
-*> Format. RFP Format is described by TRANSR, UPLO and N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
- $ C )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA, BETA
- INTEGER K, LDA, N
- CHARACTER TRANS, TRANSR, UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NORMALTRANSR, NISODD, NOTRANS
- INTEGER INFO, NROWA, J, NK, N1, N2
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DGEMM, DSYRK
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- NOTRANS = LSAME( TRANS, 'N' )
-*
- IF( NOTRANS ) THEN
- NROWA = N
- ELSE
- NROWA = K
- END IF
-*
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSFRK ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
-* The quick return case: ((ALPHA.EQ.0).AND.(BETA.NE.ZERO)) is not
-* done (it is in DSYRK for example) and left in the general case.
-*
- IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
- $ ( BETA.EQ.ONE ) ) )RETURN
-*
- IF( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ZERO ) ) THEN
- DO J = 1, ( ( N*( N+1 ) ) / 2 )
- C( J ) = ZERO
- END DO
- RETURN
- END IF
-*
-* C is N-by-N.
-* If N is odd, set NISODD = .TRUE., and N1 and N2.
-* If N is even, NISODD = .FALSE., and NK.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- NISODD = .FALSE.
- NK = N / 2
- ELSE
- NISODD = .TRUE.
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
- END IF
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
-*
- CALL DSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N )
- CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- $ BETA, C( N+1 ), N )
- CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'T'
-*
- CALL DSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N )
- CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- $ BETA, C( N+1 ), N )
- CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
-*
- END IF
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
-*
- CALL DSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2+1 ), N )
- CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
- $ BETA, C( N1+1 ), N )
- CALL DGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( N2, 1 ), LDA, BETA, C( 1 ), N )
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'T'
-*
- CALL DSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2+1 ), N )
- CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), LDA,
- $ BETA, C( N1+1 ), N )
- CALL DGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, N2 ), LDA, BETA, C( 1 ), N )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is odd, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'T', UPLO = 'L', and TRANS = 'N'
-*
- CALL DSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N1 )
- CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- $ BETA, C( 2 ), N1 )
- CALL DGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( N1+1, 1 ), LDA, BETA,
- $ C( N1*N1+1 ), N1 )
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', UPLO = 'L', and TRANS = 'T'
-*
- CALL DSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N1 )
- CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- $ BETA, C( 2 ), N1 )
- CALL DGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, N1+1 ), LDA, BETA,
- $ C( N1*N1+1 ), N1 )
-*
- END IF
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'T', UPLO = 'U', and TRANS = 'N'
-*
- CALL DSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2*N2+1 ), N2 )
- CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- $ BETA, C( N1*N2+1 ), N2 )
- CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', UPLO = 'U', and TRANS = 'T'
-*
- CALL DSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2*N2+1 ), N2 )
- CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- $ BETA, C( N1*N2+1 ), N2 )
- CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
-*
- CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 2 ), N+1 )
- CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( 1 ), N+1 )
- CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
- $ N+1 )
-*
- ELSE
-*
-* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'T'
-*
- CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 2 ), N+1 )
- CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( 1 ), N+1 )
- CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
- $ N+1 )
-*
- END IF
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
-*
- CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+2 ), N+1 )
- CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( NK+1 ), N+1 )
- CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( NK+1, 1 ), LDA, BETA, C( 1 ),
- $ N+1 )
-*
- ELSE
-*
-* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'T'
-*
- CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+2 ), N+1 )
- CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( NK+1 ), N+1 )
- CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, NK+1 ), LDA, BETA, C( 1 ),
- $ N+1 )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'T', UPLO = 'L', and TRANS = 'N'
-*
- CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+1 ), NK )
- CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( 1 ), NK )
- CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( NK+1, 1 ), LDA, BETA,
- $ C( ( ( NK+1 )*NK )+1 ), NK )
-*
- ELSE
-*
-* N is even, TRANSR = 'T', UPLO = 'L', and TRANS = 'T'
-*
- CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+1 ), NK )
- CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( 1 ), NK )
- CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, NK+1 ), LDA, BETA,
- $ C( ( ( NK+1 )*NK )+1 ), NK )
-*
- END IF
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'T', UPLO = 'U', and TRANS = 'N'
-*
- CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK*( NK+1 )+1 ), NK )
- CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( NK*NK+1 ), NK )
- CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
-*
- ELSE
-*
-* N is even, TRANSR = 'T', UPLO = 'U', and TRANS = 'T'
-*
- CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK*( NK+1 )+1 ), NK )
- CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( NK*NK+1 ), NK )
- CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DSFRK
-*
- END
diff --git a/netlib/LAPACK/dsgesv.f b/netlib/LAPACK/dsgesv.f
deleted file mode 100644
index 64e2c16..0000000
--- a/netlib/LAPACK/dsgesv.f
+++ /dev/null
@@ -1,433 +0,0 @@
-*> \brief <b> DSGESV computes the solution to system of linear equations A * X = B for GE matrices</b> (mixed precision with iterative refinement)
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSGESV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsgesv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsgesv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsgesv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK,
-* SWORK, ITER, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL SWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( N, * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSGESV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*>
-*> DSGESV first attempts to factorize the matrix in SINGLE PRECISION
-*> and use this factorization within an iterative refinement procedure
-*> to produce a solution with DOUBLE PRECISION normwise backward error
-*> quality (see below). If the approach fails the method switches to a
-*> DOUBLE PRECISION factorization and solve.
-*>
-*> The iterative refinement is not going to be a winning strategy if
-*> the ratio SINGLE PRECISION performance over DOUBLE PRECISION
-*> performance is too small. A reasonable strategy should take the
-*> number of right-hand sides and the size of the matrix into account.
-*> This might be done with a call to ILAENV in the future. Up to now, we
-*> always try iterative refinement.
-*>
-*> The iterative refinement process is stopped if
-*> ITER > ITERMAX
-*> or for all the RHS we have:
-*> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX
-*> where
-*> o ITER is the number of the current iteration in the iterative
-*> refinement process
-*> o RNRM is the infinity-norm of the residual
-*> o XNRM is the infinity-norm of the solution
-*> o ANRM is the infinity-operator-norm of the matrix A
-*> o EPS is the machine epsilon returned by DLAMCH('Epsilon')
-*> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00
-*> respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array,
-*> dimension (LDA,N)
-*> On entry, the N-by-N coefficient matrix A.
-*> On exit, if iterative refinement has been successfully used
-*> (INFO.EQ.0 and ITER.GE.0, see description below), then A is
-*> unchanged, if double precision factorization has been used
-*> (INFO.EQ.0 and ITER.LT.0, see description below), then the
-*> array A contains the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> Corresponds either to the single precision factorization
-*> (if INFO.EQ.0 and ITER.GE.0) or the double precision
-*> factorization (if INFO.EQ.0 and ITER.LT.0).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N,NRHS)
-*> This array is used to hold the residual vectors.
-*> \endverbatim
-*>
-*> \param[out] SWORK
-*> \verbatim
-*> SWORK is REAL array, dimension (N*(N+NRHS))
-*> This array is used to use the single precision matrix and the
-*> right-hand sides or solutions in single precision.
-*> \endverbatim
-*>
-*> \param[out] ITER
-*> \verbatim
-*> ITER is INTEGER
-*> < 0: iterative refinement has failed, double precision
-*> factorization has been performed
-*> -1 : the routine fell back to full precision for
-*> implementation- or machine-specific reasons
-*> -2 : narrowing the precision induced an overflow,
-*> the routine fell back to full precision
-*> -3 : failure of SGETRF
-*> -31: stop the iterative refinement after the 30th
-*> iterations
-*> > 0: iterative refinement has been sucessfully used.
-*> Returns the number of iterations
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) computed in DOUBLE PRECISION is
-*> exactly zero. The factorization has been completed,
-*> but the factor U is exactly singular, so the solution
-*> could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK,
- $ SWORK, ITER, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL SWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( N, * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- LOGICAL DOITREF
- PARAMETER ( DOITREF = .TRUE. )
-*
- INTEGER ITERMAX
- PARAMETER ( ITERMAX = 30 )
-*
- DOUBLE PRECISION BWDMAX
- PARAMETER ( BWDMAX = 1.0E+00 )
-*
- DOUBLE PRECISION NEGONE, ONE
- PARAMETER ( NEGONE = -1.0D+0, ONE = 1.0D+0 )
-*
-* .. Local Scalars ..
- INTEGER I, IITER, PTSA, PTSX
- DOUBLE PRECISION ANRM, CTE, EPS, RNRM, XNRM
-*
-* .. External Subroutines ..
- EXTERNAL DAXPY, DGEMM, DLACPY, DLAG2S, SLAG2D, SGETRF,
- $ SGETRS, XERBLA
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL IDAMAX, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- ITER = 0
-*
-* Test the input parameters.
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSGESV', -INFO )
- RETURN
- END IF
-*
-* Quick return if (N.EQ.0).
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Skip single precision iterative refinement if a priori slower
-* than double precision factorization.
-*
- IF( .NOT.DOITREF ) THEN
- ITER = -1
- GO TO 40
- END IF
-*
-* Compute some constants.
-*
- ANRM = DLANGE( 'I', N, N, A, LDA, WORK )
- EPS = DLAMCH( 'Epsilon' )
- CTE = ANRM*EPS*SQRT( DBLE( N ) )*BWDMAX
-*
-* Set the indices PTSA, PTSX for referencing SA and SX in SWORK.
-*
- PTSA = 1
- PTSX = PTSA + N*N
-*
-* Convert B from double precision to single precision and store the
-* result in SX.
-*
- CALL DLAG2S( N, NRHS, B, LDB, SWORK( PTSX ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -2
- GO TO 40
- END IF
-*
-* Convert A from double precision to single precision and store the
-* result in SA.
-*
- CALL DLAG2S( N, N, A, LDA, SWORK( PTSA ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -2
- GO TO 40
- END IF
-*
-* Compute the LU factorization of SA.
-*
- CALL SGETRF( N, N, SWORK( PTSA ), N, IPIV, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -3
- GO TO 40
- END IF
-*
-* Solve the system SA*SX = SB.
-*
- CALL SGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV,
- $ SWORK( PTSX ), N, INFO )
-*
-* Convert SX back to double precision
-*
- CALL SLAG2D( N, NRHS, SWORK( PTSX ), N, X, LDX, INFO )
-*
-* Compute R = B - AX (R is WORK).
-*
- CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N )
-*
- CALL DGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, A,
- $ LDA, X, LDX, ONE, WORK, N )
-*
-* Check whether the NRHS normwise backward errors satisfy the
-* stopping criterion. If yes, set ITER=0 and return.
-*
- DO I = 1, NRHS
- XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) )
- RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) )
- IF( RNRM.GT.XNRM*CTE )
- $ GO TO 10
- END DO
-*
-* If we are here, the NRHS normwise backward errors satisfy the
-* stopping criterion. We are good to exit.
-*
- ITER = 0
- RETURN
-*
- 10 CONTINUE
-*
- DO 30 IITER = 1, ITERMAX
-*
-* Convert R (in WORK) from double precision to single precision
-* and store the result in SX.
-*
- CALL DLAG2S( N, NRHS, WORK, N, SWORK( PTSX ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -2
- GO TO 40
- END IF
-*
-* Solve the system SA*SX = SR.
-*
- CALL SGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV,
- $ SWORK( PTSX ), N, INFO )
-*
-* Convert SX back to double precision and update the current
-* iterate.
-*
- CALL SLAG2D( N, NRHS, SWORK( PTSX ), N, WORK, N, INFO )
-*
- DO I = 1, NRHS
- CALL DAXPY( N, ONE, WORK( 1, I ), 1, X( 1, I ), 1 )
- END DO
-*
-* Compute R = B - AX (R is WORK).
-*
- CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N )
-*
- CALL DGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE,
- $ A, LDA, X, LDX, ONE, WORK, N )
-*
-* Check whether the NRHS normwise backward errors satisfy the
-* stopping criterion. If yes, set ITER=IITER>0 and return.
-*
- DO I = 1, NRHS
- XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) )
- RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) )
- IF( RNRM.GT.XNRM*CTE )
- $ GO TO 20
- END DO
-*
-* If we are here, the NRHS normwise backward errors satisfy the
-* stopping criterion, we are good to exit.
-*
- ITER = IITER
-*
- RETURN
-*
- 20 CONTINUE
-*
- 30 CONTINUE
-*
-* If we are at this place of the code, this is because we have
-* performed ITER=ITERMAX iterations and never satisified the
-* stopping criterion, set up the ITER flag accordingly and follow up
-* on double precision routine.
-*
- ITER = -ITERMAX - 1
-*
- 40 CONTINUE
-*
-* Single-precision iterative refinement failed to converge to a
-* satisfactory solution, so we resort to double precision.
-*
- CALL DGETRF( N, N, A, LDA, IPIV, INFO )
-*
- IF( INFO.NE.0 )
- $ RETURN
-*
- CALL DLACPY( 'All', N, NRHS, B, LDB, X, LDX )
- CALL DGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, X, LDX,
- $ INFO )
-*
- RETURN
-*
-* End of DSGESV.
-*
- END
diff --git a/netlib/LAPACK/dspcon.f b/netlib/LAPACK/dspcon.f
deleted file mode 100644
index e0dac84..0000000
--- a/netlib/LAPACK/dspcon.f
+++ /dev/null
@@ -1,238 +0,0 @@
-*> \brief \b DSPCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric packed matrix A using the factorization
-*> A = U*D*U**T or A = L*D*L**T computed by DSPTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSPTRF, stored as a
-*> packed triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSPTRF.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> The 1-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IP, KASE
- DOUBLE PRECISION AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DSPTRS, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.LE.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- IP = N*( N+1 ) / 2
- DO 10 I = N, 1, -1
- IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
- $ RETURN
- IP = IP - I
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- IP = 1
- DO 20 I = 1, N
- IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
- $ RETURN
- IP = IP + N - I + 1
- 20 CONTINUE
- END IF
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- 30 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
-*
-* Multiply by inv(L*D*L**T) or inv(U*D*U**T).
-*
- CALL DSPTRS( UPLO, N, 1, AP, IPIV, WORK, N, INFO )
- GO TO 30
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of DSPCON
-*
- END
diff --git a/netlib/LAPACK/dspev.f b/netlib/LAPACK/dspev.f
deleted file mode 100644
index 3ddb016..0000000
--- a/netlib/LAPACK/dspev.f
+++ /dev/null
@@ -1,262 +0,0 @@
-*> \brief <b> DSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPEV computes all the eigenvalues and, optionally, eigenvectors of a
-*> real symmetric matrix A in packed storage.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, AP is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
-*> and first superdiagonal of the tridiagonal matrix T overwrite
-*> the corresponding elements of A, and if UPLO = 'L', the
-*> diagonal and first subdiagonal of T overwrite the
-*> corresponding elements of A.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTZ
- INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE
- DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSP
- EXTERNAL LSAME, DLAMCH, DLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL DOPGTR, DSCAL, DSPTRD, DSTEQR, DSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPEV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = AP( 1 )
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = DLANSP( 'M', UPLO, N, AP, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
- END IF
-*
-* Call DSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, first call
-* DOPGTR to generate the orthogonal matrix, then call DSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- INDWRK = INDTAU + N
- CALL DOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDTAU ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
- RETURN
-*
-* End of DSPEV
-*
- END
diff --git a/netlib/LAPACK/dspevd.f b/netlib/LAPACK/dspevd.f
deleted file mode 100644
index 8b6b8da..0000000
--- a/netlib/LAPACK/dspevd.f
+++ /dev/null
@@ -1,338 +0,0 @@
-*> \brief <b> DSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
-* IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPEVD computes all the eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A in packed storage. If eigenvectors are
-*> desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, AP is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
-*> and first superdiagonal of the tridiagonal matrix T overwrite
-*> the corresponding elements of A, and if UPLO = 'L', the
-*> diagonal and first subdiagonal of T overwrite the
-*> corresponding elements of A.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the required LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK must be at least 1.
-*> If JOBZ = 'N' and N > 1, LWORK must be at least 2*N.
-*> If JOBZ = 'V' and N > 1, LWORK must be at least
-*> 1 + 6*N + N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the required sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the required sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTZ
- INTEGER IINFO, INDE, INDTAU, INDWRK, ISCALE, LIWMIN,
- $ LLWORK, LWMIN
- DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSP
- EXTERNAL LSAME, DLAMCH, DLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL DOPMTR, DSCAL, DSPTRD, DSTEDC, DSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
- END IF
- IWORK( 1 ) = LIWMIN
- WORK( 1 ) = LWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -9
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = AP( 1 )
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = DLANSP( 'M', UPLO, N, AP, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
- END IF
-*
-* Call DSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, first call
-* DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
-* tridiagonal matrix, then call DOPMTR to multiply it by the
-* Householder transformations represented in AP.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- INDWRK = INDTAU + N
- LLWORK = LWORK - INDWRK + 1
- CALL DSTEDC( 'I', N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
- $ LLWORK, IWORK, LIWORK, INFO )
- CALL DOPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL DSCAL( N, ONE / SIGMA, W, 1 )
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of DSPEVD
-*
- END
diff --git a/netlib/LAPACK/dspevx.f b/netlib/LAPACK/dspevx.f
deleted file mode 100644
index 35a96b2..0000000
--- a/netlib/LAPACK/dspevx.f
+++ /dev/null
@@ -1,489 +0,0 @@
-*> \brief <b> DSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, LDZ, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A in packed storage. Eigenvalues/vectors
-*> can be selected by specifying either a range of values or a range of
-*> indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found;
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found;
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, AP is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
-*> and first superdiagonal of the tridiagonal matrix T overwrite
-*> the corresponding elements of A, and if UPLO = 'L', the
-*> diagonal and first subdiagonal of T overwrite the
-*> corresponding elements of A.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing AP to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the selected eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, LDZ, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
- CHARACTER ORDER
- INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
- $ INDISP, INDIWO, INDTAU, INDWRK, ISCALE, ITMP1,
- $ J, JJ, NSPLIT
- DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSP
- EXTERNAL LSAME, DLAMCH, DLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DOPGTR, DOPMTR, DSCAL, DSPTRD, DSTEBZ,
- $ DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) )
- $ THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -7
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -9
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
- $ INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPEVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = AP( 1 )
- ELSE
- IF( VL.LT.AP( 1 ) .AND. VU.GE.AP( 1 ) ) THEN
- M = 1
- W( 1 ) = AP( 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF( VALEIG ) THEN
- VLL = VL
- VUU = VU
- ELSE
- VLL = ZERO
- VUU = ZERO
- END IF
- ANRM = DLANSP( 'M', UPLO, N, AP, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* Call DSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
- INDTAU = 1
- INDE = INDTAU + N
- INDD = INDE + N
- INDWRK = INDD + N
- CALL DSPTRD( UPLO, N, AP, WORK( INDD ), WORK( INDE ),
- $ WORK( INDTAU ), IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal
-* to zero, then call DSTERF or DOPGTR and SSTEQR. If this fails
-* for some eigenvalue, then try DSTEBZ.
-*
- TEST = .FALSE.
- IF (INDEIG) THEN
- IF (IL.EQ.1 .AND. IU.EQ.N) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
- CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- IF( .NOT.WANTZ ) THEN
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL DOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 20
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by DSTEIN.
-*
- CALL DOPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 20 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 40 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 30 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 30 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSPEVX
-*
- END
diff --git a/netlib/LAPACK/dspgst.f b/netlib/LAPACK/dspgst.f
deleted file mode 100644
index 4be928d..0000000
--- a/netlib/LAPACK/dspgst.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b DSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPGST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspgst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspgst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspgst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITYPE, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), BP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPGST reduces a real symmetric-definite generalized eigenproblem
-*> to standard form, using packed storage.
-*>
-*> If ITYPE = 1, the problem is A*x = lambda*B*x,
-*> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*>
-*> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*> B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
-*>
-*> B must have been previously factorized as U**T*U or L*L**T by DPPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*> = 2 or 3: compute U*A*U**T or L**T*A*L.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored and B is factored as
-*> U**T*U;
-*> = 'L': Lower triangle of A is stored and B is factored as
-*> L*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, if INFO = 0, the transformed matrix, stored in the
-*> same format as A.
-*> \endverbatim
-*>
-*> \param[in] BP
-*> \verbatim
-*> BP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The triangular factor from the Cholesky factorization of B,
-*> stored in the same format as A, as returned by DPPTRF.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITYPE, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), BP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, HALF
- PARAMETER ( ONE = 1.0D0, HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, J1, J1J1, JJ, K, K1, K1K1, KK
- DOUBLE PRECISION AJJ, AKK, BJJ, BKK, CT
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DSPMV, DSPR2, DTPMV, DTPSV,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPGST', -INFO )
- RETURN
- END IF
-*
- IF( ITYPE.EQ.1 ) THEN
- IF( UPPER ) THEN
-*
-* Compute inv(U**T)*A*inv(U)
-*
-* J1 and JJ are the indices of A(1,j) and A(j,j)
-*
- JJ = 0
- DO 10 J = 1, N
- J1 = JJ + 1
- JJ = JJ + J
-*
-* Compute the j-th column of the upper triangle of A
-*
- BJJ = BP( JJ )
- CALL DTPSV( UPLO, 'Transpose', 'Nonunit', J, BP,
- $ AP( J1 ), 1 )
- CALL DSPMV( UPLO, J-1, -ONE, AP, BP( J1 ), 1, ONE,
- $ AP( J1 ), 1 )
- CALL DSCAL( J-1, ONE / BJJ, AP( J1 ), 1 )
- AP( JJ ) = ( AP( JJ )-DDOT( J-1, AP( J1 ), 1, BP( J1 ),
- $ 1 ) ) / BJJ
- 10 CONTINUE
- ELSE
-*
-* Compute inv(L)*A*inv(L**T)
-*
-* KK and K1K1 are the indices of A(k,k) and A(k+1,k+1)
-*
- KK = 1
- DO 20 K = 1, N
- K1K1 = KK + N - K + 1
-*
-* Update the lower triangle of A(k:n,k:n)
-*
- AKK = AP( KK )
- BKK = BP( KK )
- AKK = AKK / BKK**2
- AP( KK ) = AKK
- IF( K.LT.N ) THEN
- CALL DSCAL( N-K, ONE / BKK, AP( KK+1 ), 1 )
- CT = -HALF*AKK
- CALL DAXPY( N-K, CT, BP( KK+1 ), 1, AP( KK+1 ), 1 )
- CALL DSPR2( UPLO, N-K, -ONE, AP( KK+1 ), 1,
- $ BP( KK+1 ), 1, AP( K1K1 ) )
- CALL DAXPY( N-K, CT, BP( KK+1 ), 1, AP( KK+1 ), 1 )
- CALL DTPSV( UPLO, 'No transpose', 'Non-unit', N-K,
- $ BP( K1K1 ), AP( KK+1 ), 1 )
- END IF
- KK = K1K1
- 20 CONTINUE
- END IF
- ELSE
- IF( UPPER ) THEN
-*
-* Compute U*A*U**T
-*
-* K1 and KK are the indices of A(1,k) and A(k,k)
-*
- KK = 0
- DO 30 K = 1, N
- K1 = KK + 1
- KK = KK + K
-*
-* Update the upper triangle of A(1:k,1:k)
-*
- AKK = AP( KK )
- BKK = BP( KK )
- CALL DTPMV( UPLO, 'No transpose', 'Non-unit', K-1, BP,
- $ AP( K1 ), 1 )
- CT = HALF*AKK
- CALL DAXPY( K-1, CT, BP( K1 ), 1, AP( K1 ), 1 )
- CALL DSPR2( UPLO, K-1, ONE, AP( K1 ), 1, BP( K1 ), 1,
- $ AP )
- CALL DAXPY( K-1, CT, BP( K1 ), 1, AP( K1 ), 1 )
- CALL DSCAL( K-1, BKK, AP( K1 ), 1 )
- AP( KK ) = AKK*BKK**2
- 30 CONTINUE
- ELSE
-*
-* Compute L**T *A*L
-*
-* JJ and J1J1 are the indices of A(j,j) and A(j+1,j+1)
-*
- JJ = 1
- DO 40 J = 1, N
- J1J1 = JJ + N - J + 1
-*
-* Compute the j-th column of the lower triangle of A
-*
- AJJ = AP( JJ )
- BJJ = BP( JJ )
- AP( JJ ) = AJJ*BJJ + DDOT( N-J, AP( JJ+1 ), 1,
- $ BP( JJ+1 ), 1 )
- CALL DSCAL( N-J, BJJ, AP( JJ+1 ), 1 )
- CALL DSPMV( UPLO, N-J, ONE, AP( J1J1 ), BP( JJ+1 ), 1,
- $ ONE, AP( JJ+1 ), 1 )
- CALL DTPMV( UPLO, 'Transpose', 'Non-unit', N-J+1,
- $ BP( JJ ), AP( JJ ), 1 )
- JJ = J1J1
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DSPGST
-*
- END
diff --git a/netlib/LAPACK/dspgv.f b/netlib/LAPACK/dspgv.f
deleted file mode 100644
index 45c7acc..0000000
--- a/netlib/LAPACK/dspgv.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b DSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspgv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspgv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspgv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), BP( * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPGV computes all the eigenvalues and, optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
-*> Here A and B are assumed to be symmetric, stored in packed format,
-*> and B is also positive definite.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension
-*> (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the contents of AP are destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] BP
-*> \verbatim
-*> BP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> B, packed columnwise in a linear array. The j-th column of B
-*> is stored in the array BP as follows:
-*> if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*> if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*>
-*> On exit, the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T, in the same storage
-*> format as B.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors. The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: DPPTRF or DSPEV returned an error code:
-*> <= N: if INFO = i, DSPEV failed to converge;
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero.
-*> > N: if INFO = n + i, for 1 <= i <= n, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), BP( * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER, WANTZ
- CHARACTER TRANS
- INTEGER J, NEIG
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPPTRF, DSPEV, DSPGST, DTPMV, DTPSV, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPGV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL DPPTRF( UPLO, N, BP, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
- CALL DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- NEIG = N
- IF( INFO.GT.0 )
- $ NEIG = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- DO 10 J = 1, NEIG
- CALL DTPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 10 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- DO 20 J = 1, NEIG
- CALL DTPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 20 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DSPGV
-*
- END
diff --git a/netlib/LAPACK/dspgvd.f b/netlib/LAPACK/dspgvd.f
deleted file mode 100644
index 5d57ce4..0000000
--- a/netlib/LAPACK/dspgvd.f
+++ /dev/null
@@ -1,364 +0,0 @@
-*> \brief \b DSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPGVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspgvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspgvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspgvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
-* LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AP( * ), BP( * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPGVD computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
-*> B are assumed to be symmetric, stored in packed format, and B is also
-*> positive definite.
-*> If eigenvectors are desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the contents of AP are destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] BP
-*> \verbatim
-*> BP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> B, packed columnwise in a linear array. The j-th column of B
-*> is stored in the array BP as follows:
-*> if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*> if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*>
-*> On exit, the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T, in the same storage
-*> format as B.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors. The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the required LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LWORK >= 2*N.
-*> If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the required sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK >= 1.
-*> If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the required sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: DPPTRF or DSPEVD returned an error code:
-*> <= N: if INFO = i, DSPEVD failed to converge;
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE DSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
- $ LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AP( * ), BP( * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER TRANS
- INTEGER J, LIWMIN, LWMIN, NEIG
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPPTRF, DSPEVD, DSPGST, DTPMV, DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
- END IF
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPGVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of BP.
-*
- CALL DPPTRF( UPLO, N, BP, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
- CALL DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
- LWMIN = MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) )
- LIWMIN = MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- NEIG = N
- IF( INFO.GT.0 )
- $ NEIG = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T *y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- DO 10 J = 1, NEIG
- CALL DTPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 10 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T *y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- DO 20 J = 1, NEIG
- CALL DTPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 20 CONTINUE
- END IF
- END IF
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DSPGVD
-*
- END
diff --git a/netlib/LAPACK/dspgvx.f b/netlib/LAPACK/dspgvx.f
deleted file mode 100644
index 0bb2469..0000000
--- a/netlib/LAPACK/dspgvx.f
+++ /dev/null
@@ -1,408 +0,0 @@
-*> \brief \b DSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPGVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspgvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspgvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspgvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU,
-* IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
-* IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, ITYPE, IU, LDZ, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION AP( * ), BP( * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPGVX computes selected eigenvalues, and optionally, eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
-*> and B are assumed to be symmetric, stored in packed storage, and B
-*> is also positive definite. Eigenvalues and eigenvectors can be
-*> selected by specifying either a range of values or a range of indices
-*> for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A and B are stored;
-*> = 'L': Lower triangle of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix pencil (A,B). N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the contents of AP are destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] BP
-*> \verbatim
-*> BP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> B, packed columnwise in a linear array. The j-th column of B
-*> is stored in the array BP as follows:
-*> if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*> if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*>
-*> On exit, the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T, in the same storage
-*> format as B.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On normal exit, the first M elements contain the selected
-*> eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'N', then Z is not referenced.
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*>
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: DPPTRF or DSPEVX returned an error code:
-*> <= N: if INFO = i, DSPEVX failed to converge;
-*> i eigenvectors failed to converge. Their indices
-*> are stored in array IFAIL.
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE DSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU,
- $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
- $ IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, ITYPE, IU, LDZ, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION AP( * ), BP( * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, UPPER, VALEIG, WANTZ
- CHARACTER TRANS
- INTEGER J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPPTRF, DSPEVX, DSPGST, DTPMV, DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- UPPER = LSAME( UPLO, 'U' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL ) THEN
- INFO = -9
- END IF
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 ) THEN
- INFO = -10
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -11
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -16
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPGVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL DPPTRF( UPLO, N, BP, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
- CALL DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M,
- $ W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- IF( INFO.GT.0 )
- $ M = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- DO 10 J = 1, M
- CALL DTPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 10 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- DO 20 J = 1, M
- CALL DTPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 20 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DSPGVX
-*
- END
diff --git a/netlib/LAPACK/dsposv.f b/netlib/LAPACK/dsposv.f
deleted file mode 100644
index bb72199..0000000
--- a/netlib/LAPACK/dsposv.f
+++ /dev/null
@@ -1,439 +0,0 @@
-*> \brief <b> DSPOSV computes the solution to system of linear equations A * X = B for PO matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPOSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsposv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsposv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsposv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
-* SWORK, ITER, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL SWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( N, * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPOSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix and X and B
-*> are N-by-NRHS matrices.
-*>
-*> DSPOSV first attempts to factorize the matrix in SINGLE PRECISION
-*> and use this factorization within an iterative refinement procedure
-*> to produce a solution with DOUBLE PRECISION normwise backward error
-*> quality (see below). If the approach fails the method switches to a
-*> DOUBLE PRECISION factorization and solve.
-*>
-*> The iterative refinement is not going to be a winning strategy if
-*> the ratio SINGLE PRECISION performance over DOUBLE PRECISION
-*> performance is too small. A reasonable strategy should take the
-*> number of right-hand sides and the size of the matrix into account.
-*> This might be done with a call to ILAENV in the future. Up to now, we
-*> always try iterative refinement.
-*>
-*> The iterative refinement process is stopped if
-*> ITER > ITERMAX
-*> or for all the RHS we have:
-*> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX
-*> where
-*> o ITER is the number of the current iteration in the iterative
-*> refinement process
-*> o RNRM is the infinity-norm of the residual
-*> o XNRM is the infinity-norm of the solution
-*> o ANRM is the infinity-operator-norm of the matrix A
-*> o EPS is the machine epsilon returned by DLAMCH('Epsilon')
-*> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00
-*> respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array,
-*> dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, if iterative refinement has been successfully used
-*> (INFO.EQ.0 and ITER.GE.0, see description below), then A is
-*> unchanged, if double precision factorization has been used
-*> (INFO.EQ.0 and ITER.LT.0, see description below), then the
-*> array A contains the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N,NRHS)
-*> This array is used to hold the residual vectors.
-*> \endverbatim
-*>
-*> \param[out] SWORK
-*> \verbatim
-*> SWORK is REAL array, dimension (N*(N+NRHS))
-*> This array is used to use the single precision matrix and the
-*> right-hand sides or solutions in single precision.
-*> \endverbatim
-*>
-*> \param[out] ITER
-*> \verbatim
-*> ITER is INTEGER
-*> < 0: iterative refinement has failed, double precision
-*> factorization has been performed
-*> -1 : the routine fell back to full precision for
-*> implementation- or machine-specific reasons
-*> -2 : narrowing the precision induced an overflow,
-*> the routine fell back to full precision
-*> -3 : failure of SPOTRF
-*> -31: stop the iterative refinement after the 30th
-*> iterations
-*> > 0: iterative refinement has been sucessfully used.
-*> Returns the number of iterations
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of (DOUBLE
-*> PRECISION) A is not positive definite, so the
-*> factorization could not be completed, and the solution
-*> has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doublePOsolve
-*
-* =====================================================================
- SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
- $ SWORK, ITER, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL SWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( N, * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- LOGICAL DOITREF
- PARAMETER ( DOITREF = .TRUE. )
-*
- INTEGER ITERMAX
- PARAMETER ( ITERMAX = 30 )
-*
- DOUBLE PRECISION BWDMAX
- PARAMETER ( BWDMAX = 1.0E+00 )
-*
- DOUBLE PRECISION NEGONE, ONE
- PARAMETER ( NEGONE = -1.0D+0, ONE = 1.0D+0 )
-*
-* .. Local Scalars ..
- INTEGER I, IITER, PTSA, PTSX
- DOUBLE PRECISION ANRM, CTE, EPS, RNRM, XNRM
-*
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSYMM, DLACPY, DLAT2S, DLAG2S, SLAG2D,
- $ SPOTRF, SPOTRS, XERBLA
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLANSY
- LOGICAL LSAME
- EXTERNAL IDAMAX, DLAMCH, DLANSY, LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- ITER = 0
-*
-* Test the input parameters.
-*
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPOSV', -INFO )
- RETURN
- END IF
-*
-* Quick return if (N.EQ.0).
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Skip single precision iterative refinement if a priori slower
-* than double precision factorization.
-*
- IF( .NOT.DOITREF ) THEN
- ITER = -1
- GO TO 40
- END IF
-*
-* Compute some constants.
-*
- ANRM = DLANSY( 'I', UPLO, N, A, LDA, WORK )
- EPS = DLAMCH( 'Epsilon' )
- CTE = ANRM*EPS*SQRT( DBLE( N ) )*BWDMAX
-*
-* Set the indices PTSA, PTSX for referencing SA and SX in SWORK.
-*
- PTSA = 1
- PTSX = PTSA + N*N
-*
-* Convert B from double precision to single precision and store the
-* result in SX.
-*
- CALL DLAG2S( N, NRHS, B, LDB, SWORK( PTSX ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -2
- GO TO 40
- END IF
-*
-* Convert A from double precision to single precision and store the
-* result in SA.
-*
- CALL DLAT2S( UPLO, N, A, LDA, SWORK( PTSA ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -2
- GO TO 40
- END IF
-*
-* Compute the Cholesky factorization of SA.
-*
- CALL SPOTRF( UPLO, N, SWORK( PTSA ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -3
- GO TO 40
- END IF
-*
-* Solve the system SA*SX = SB.
-*
- CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N,
- $ INFO )
-*
-* Convert SX back to double precision
-*
- CALL SLAG2D( N, NRHS, SWORK( PTSX ), N, X, LDX, INFO )
-*
-* Compute R = B - AX (R is WORK).
-*
- CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N )
-*
- CALL DSYMM( 'Left', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE,
- $ WORK, N )
-*
-* Check whether the NRHS normwise backward errors satisfy the
-* stopping criterion. If yes, set ITER=0 and return.
-*
- DO I = 1, NRHS
- XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) )
- RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) )
- IF( RNRM.GT.XNRM*CTE )
- $ GO TO 10
- END DO
-*
-* If we are here, the NRHS normwise backward errors satisfy the
-* stopping criterion. We are good to exit.
-*
- ITER = 0
- RETURN
-*
- 10 CONTINUE
-*
- DO 30 IITER = 1, ITERMAX
-*
-* Convert R (in WORK) from double precision to single precision
-* and store the result in SX.
-*
- CALL DLAG2S( N, NRHS, WORK, N, SWORK( PTSX ), N, INFO )
-*
- IF( INFO.NE.0 ) THEN
- ITER = -2
- GO TO 40
- END IF
-*
-* Solve the system SA*SX = SR.
-*
- CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N,
- $ INFO )
-*
-* Convert SX back to double precision and update the current
-* iterate.
-*
- CALL SLAG2D( N, NRHS, SWORK( PTSX ), N, WORK, N, INFO )
-*
- DO I = 1, NRHS
- CALL DAXPY( N, ONE, WORK( 1, I ), 1, X( 1, I ), 1 )
- END DO
-*
-* Compute R = B - AX (R is WORK).
-*
- CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N )
-*
- CALL DSYMM( 'L', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE,
- $ WORK, N )
-*
-* Check whether the NRHS normwise backward errors satisfy the
-* stopping criterion. If yes, set ITER=IITER>0 and return.
-*
- DO I = 1, NRHS
- XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) )
- RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) )
- IF( RNRM.GT.XNRM*CTE )
- $ GO TO 20
- END DO
-*
-* If we are here, the NRHS normwise backward errors satisfy the
-* stopping criterion, we are good to exit.
-*
- ITER = IITER
-*
- RETURN
-*
- 20 CONTINUE
-*
- 30 CONTINUE
-*
-* If we are at this place of the code, this is because we have
-* performed ITER=ITERMAX iterations and never satisified the
-* stopping criterion, set up the ITER flag accordingly and follow
-* up on double precision routine.
-*
- ITER = -ITERMAX - 1
-*
- 40 CONTINUE
-*
-* Single-precision iterative refinement failed to converge to a
-* satisfactory solution, so we resort to double precision.
-*
- CALL DPOTRF( UPLO, N, A, LDA, INFO )
-*
- IF( INFO.NE.0 )
- $ RETURN
-*
- CALL DLACPY( 'All', N, NRHS, B, LDB, X, LDX )
- CALL DPOTRS( UPLO, N, NRHS, A, LDA, X, LDX, INFO )
-*
- RETURN
-*
-* End of DSPOSV.
-*
- END
diff --git a/netlib/LAPACK/dsprfs.f b/netlib/LAPACK/dsprfs.f
deleted file mode 100644
index ea158ee..0000000
--- a/netlib/LAPACK/dsprfs.f
+++ /dev/null
@@ -1,431 +0,0 @@
-*> \brief \b DSPRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsprfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsprfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsprfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX,
-* FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric indefinite
-*> and packed, and provides error bounds and backward error estimates
-*> for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] AFP
-*> \verbatim
-*> AFP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The factored form of the matrix A. AFP contains the block
-*> diagonal matrix D and the multipliers used to obtain the
-*> factor U or L from the factorization A = U*D*U**T or
-*> A = L*D*L**T as computed by DSPTRF, stored as a packed
-*> triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSPTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DSPTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX,
- $ FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, IK, J, K, KASE, KK, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DSPMV, DSPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ),
- $ 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- KK = 1
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- IK = KK
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( AP( KK+K-1 ) )*XK + S
- KK = KK + K
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( AP( KK ) )*XK
- IK = KK + 1
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- KK = KK + ( N-K+1 )
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL DSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N,
- $ INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL DSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DSPRFS
-*
- END
diff --git a/netlib/LAPACK/dspsv.f b/netlib/LAPACK/dspsv.f
deleted file mode 100644
index 79664bb..0000000
--- a/netlib/LAPACK/dspsv.f
+++ /dev/null
@@ -1,224 +0,0 @@
-*> \brief <b> DSPSV computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric matrix stored in packed format and X
-*> and B are N-by-NRHS matrices.
-*>
-*> The diagonal pivoting method is used to factor A as
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, D is symmetric and block diagonal with 1-by-1
-*> and 2-by-2 diagonal blocks. The factored form of A is then used to
-*> solve the system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
-*> a packed triangular matrix in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D, as
-*> determined by DSPTRF. If IPIV(k) > 0, then rows and columns
-*> k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
-*> diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
-*> then rows and columns k-1 and -IPIV(k) were interchanged and
-*> D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
-*> IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
-*> -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
-*> diagonal block.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, so the solution could not be
-*> computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = aji)
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSPTRF, DSPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL DSPTRF( UPLO, N, AP, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of DSPSV
-*
- END
diff --git a/netlib/LAPACK/dspsvx.f b/netlib/LAPACK/dspsvx.f
deleted file mode 100644
index d787cc3..0000000
--- a/netlib/LAPACK/dspsvx.f
+++ /dev/null
@@ -1,386 +0,0 @@
-*> \brief <b> DSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dspsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dspsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dspsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
-* LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPSVX uses the diagonal pivoting factorization A = U*D*U**T or
-*> A = L*D*L**T to compute the solution to a real system of linear
-*> equations A * X = B, where A is an N-by-N symmetric matrix stored
-*> in packed format and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the diagonal pivoting method is used to factor A as
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> 2. If some D(i,i)=0, so that D is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': On entry, AFP and IPIV contain the factored form of
-*> A. AP, AFP and IPIV will not be modified.
-*> = 'N': The matrix A will be copied to AFP and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in,out] AFP
-*> \verbatim
-*> AFP is DOUBLE PRECISION array, dimension
-*> (N*(N+1)/2)
-*> If FACT = 'F', then AFP is an input argument and on entry
-*> contains the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
-*> a packed triangular matrix in the same storage format as A.
-*>
-*> If FACT = 'N', then AFP is an output argument and on exit
-*> contains the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
-*> a packed triangular matrix in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains details of the interchanges and the block structure
-*> of D, as determined by DSPTRF.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains details of the interchanges and the block structure
-*> of D, as determined by DSPTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: D(i,i) is exactly zero. The factorization
-*> has been completed but the factor D is exactly
-*> singular, so the solution and error bounds could
-*> not be computed. RCOND = 0 is returned.
-*> = N+1: D is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = aji)
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
- $ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT
- DOUBLE PRECISION ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANSP
- EXTERNAL LSAME, DLAMCH, DLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DSPCON, DSPRFS, DSPTRF, DSPTRS,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL DCOPY( N*( N+1 ) / 2, AP, 1, AFP, 1 )
- CALL DSPTRF( UPLO, N, AFP, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = DLANSP( 'I', UPLO, N, AP, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DSPCON( UPLO, N, AFP, IPIV, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DSPTRS( UPLO, N, NRHS, AFP, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR,
- $ BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DSPSVX
-*
- END
diff --git a/netlib/LAPACK/dsptrd.f b/netlib/LAPACK/dsptrd.f
deleted file mode 100644
index 5ee076a..0000000
--- a/netlib/LAPACK/dsptrd.f
+++ /dev/null
@@ -1,300 +0,0 @@
-*> \brief \b DSPTRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPTRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsptrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsptrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsptrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), D( * ), E( * ), TAU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPTRD reduces a real symmetric matrix A stored in packed form to
-*> symmetric tridiagonal form T by an orthogonal similarity
-*> transformation: Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
-*> of A are overwritten by the corresponding elements of the
-*> tridiagonal matrix T, and the elements above the first
-*> superdiagonal, with the array TAU, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; if UPLO
-*> = 'L', the diagonal and first subdiagonal of A are over-
-*> written by the corresponding elements of the tridiagonal
-*> matrix T, and the elements below the first subdiagonal, with
-*> the array TAU, represent the orthogonal matrix Q as a product
-*> of elementary reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n-1) . . . H(2) H(1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
-*> overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(n-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
-*> overwriting A(i+2:n,i), and tau is stored in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), D( * ), E( * ), TAU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO, HALF
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0,
- $ HALF = 1.0D0 / 2.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, I1, I1I1, II
- DOUBLE PRECISION ALPHA, TAUI
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLARFG, DSPMV, DSPR2, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPTRD', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Reduce the upper triangle of A.
-* I1 is the index in AP of A(1,I+1).
-*
- I1 = N*( N-1 ) / 2 + 1
- DO 10 I = N - 1, 1, -1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(1:i-1,i+1)
-*
- CALL DLARFG( I, AP( I1+I-1 ), AP( I1 ), 1, TAUI )
- E( I ) = AP( I1+I-1 )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(1:i,1:i)
-*
- AP( I1+I-1 ) = ONE
-*
-* Compute y := tau * A * v storing y in TAU(1:i)
-*
- CALL DSPMV( UPLO, I, TAUI, AP, AP( I1 ), 1, ZERO, TAU,
- $ 1 )
-*
-* Compute w := y - 1/2 * tau * (y**T *v) * v
-*
- ALPHA = -HALF*TAUI*DDOT( I, TAU, 1, AP( I1 ), 1 )
- CALL DAXPY( I, ALPHA, AP( I1 ), 1, TAU, 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL DSPR2( UPLO, I, -ONE, AP( I1 ), 1, TAU, 1, AP )
-*
- AP( I1+I-1 ) = E( I )
- END IF
- D( I+1 ) = AP( I1+I )
- TAU( I ) = TAUI
- I1 = I1 - I
- 10 CONTINUE
- D( 1 ) = AP( 1 )
- ELSE
-*
-* Reduce the lower triangle of A. II is the index in AP of
-* A(i,i) and I1I1 is the index of A(i+1,i+1).
-*
- II = 1
- DO 20 I = 1, N - 1
- I1I1 = II + N - I + 1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(i+2:n,i)
-*
- CALL DLARFG( N-I, AP( II+1 ), AP( II+2 ), 1, TAUI )
- E( I ) = AP( II+1 )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
- AP( II+1 ) = ONE
-*
-* Compute y := tau * A * v storing y in TAU(i:n-1)
-*
- CALL DSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1,
- $ ZERO, TAU( I ), 1 )
-*
-* Compute w := y - 1/2 * tau * (y**T *v) * v
-*
- ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, AP( II+1 ),
- $ 1 )
- CALL DAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL DSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1,
- $ AP( I1I1 ) )
-*
- AP( II+1 ) = E( I )
- END IF
- D( I ) = AP( II )
- TAU( I ) = TAUI
- II = I1I1
- 20 CONTINUE
- D( N ) = AP( II )
- END IF
-*
- RETURN
-*
-* End of DSPTRD
-*
- END
diff --git a/netlib/LAPACK/dsptrf.f b/netlib/LAPACK/dsptrf.f
deleted file mode 100644
index b456493..0000000
--- a/netlib/LAPACK/dsptrf.f
+++ /dev/null
@@ -1,616 +0,0 @@
-*> \brief \b DSPTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsptrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsptrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsptrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPTRF( UPLO, N, AP, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPTRF computes the factorization of a real symmetric matrix A stored
-*> in packed format using the Bunch-Kaufman diagonal pivoting method:
-*>
-*> A = U*D*U**T or A = L*D*L**T
-*>
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L, stored as a packed triangular
-*> matrix overwriting A (see below for further details).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', then A = U*D*U**T, where
-*> U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*> i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I v 0 ) k-s
-*> U(k) = ( 0 I 0 ) s
-*> ( 0 0 I ) n-k
-*> k-s s n-k
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*> If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*> and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*>
-*> If UPLO = 'L', then A = L*D*L**T, where
-*> L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*> i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*> n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I 0 0 ) k-1
-*> L(k) = ( 0 I 0 ) s
-*> ( 0 v I ) n-k-s+1
-*> k-1 s n-k-s+1
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*> If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*> and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> J. Lewis, Boeing Computer Services Company
-*>
-* =====================================================================
- SUBROUTINE DSPTRF( UPLO, N, AP, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION EIGHT, SEVTEN
- PARAMETER ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IMAX, J, JMAX, K, KC, KK, KNC, KP, KPC,
- $ KSTEP, KX, NPP
- DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
- $ ROWMAX, T, WK, WKM1, WKP1
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- EXTERNAL LSAME, IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSPR, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPTRF', -INFO )
- RETURN
- END IF
-*
-* Initialize ALPHA for use in choosing pivot block size.
-*
- ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
- IF( UPPER ) THEN
-*
-* Factorize A as U*D*U**T using the upper triangle of A
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2
-*
- K = N
- KC = ( N-1 )*N / 2 + 1
- 10 CONTINUE
- KNC = KC
-*
-* If K < 1, exit from loop
-*
- IF( K.LT.1 )
- $ GO TO 110
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( AP( KC+K-1 ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.GT.1 ) THEN
- IMAX = IDAMAX( K-1, AP( KC ), 1 )
- COLMAX = ABS( AP( KC+IMAX-1 ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
- ROWMAX = ZERO
- JMAX = IMAX
- KX = IMAX*( IMAX+1 ) / 2 + IMAX
- DO 20 J = IMAX + 1, K
- IF( ABS( AP( KX ) ).GT.ROWMAX ) THEN
- ROWMAX = ABS( AP( KX ) )
- JMAX = J
- END IF
- KX = KX + J
- 20 CONTINUE
- KPC = ( IMAX-1 )*IMAX / 2 + 1
- IF( IMAX.GT.1 ) THEN
- JMAX = IDAMAX( IMAX-1, AP( KPC ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( AP( KPC+JMAX-1 ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( AP( KPC+IMAX-1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K-1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K - KSTEP + 1
- IF( KSTEP.EQ.2 )
- $ KNC = KNC - K + 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the leading
-* submatrix A(1:k,1:k)
-*
- CALL DSWAP( KP-1, AP( KNC ), 1, AP( KPC ), 1 )
- KX = KPC + KP - 1
- DO 30 J = KP + 1, KK - 1
- KX = KX + J - 1
- T = AP( KNC+J-1 )
- AP( KNC+J-1 ) = AP( KX )
- AP( KX ) = T
- 30 CONTINUE
- T = AP( KNC+KK-1 )
- AP( KNC+KK-1 ) = AP( KPC+KP-1 )
- AP( KPC+KP-1 ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = AP( KC+K-2 )
- AP( KC+K-2 ) = AP( KC+KP-1 )
- AP( KC+KP-1 ) = T
- END IF
- END IF
-*
-* Update the leading submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = U(k)*D(k)
-*
-* where U(k) is the k-th column of U
-*
-* Perform a rank-1 update of A(1:k-1,1:k-1) as
-*
-* A := A - U(k)*D(k)*U(k)**T = A - W(k)*1/D(k)*W(k)**T
-*
- R1 = ONE / AP( KC+K-1 )
- CALL DSPR( UPLO, K-1, -R1, AP( KC ), 1, AP )
-*
-* Store U(k) in column k
-*
- CALL DSCAL( K-1, R1, AP( KC ), 1 )
- ELSE
-*
-* 2-by-2 pivot block D(k): columns k and k-1 now hold
-*
-* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
-*
-* where U(k) and U(k-1) are the k-th and (k-1)-th columns
-* of U
-*
-* Perform a rank-2 update of A(1:k-2,1:k-2) as
-*
-* A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
-* = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )**T
-*
- IF( K.GT.2 ) THEN
-*
- D12 = AP( K-1+( K-1 )*K / 2 )
- D22 = AP( K-1+( K-2 )*( K-1 ) / 2 ) / D12
- D11 = AP( K+( K-1 )*K / 2 ) / D12
- T = ONE / ( D11*D22-ONE )
- D12 = T / D12
-*
- DO 50 J = K - 2, 1, -1
- WKM1 = D12*( D11*AP( J+( K-2 )*( K-1 ) / 2 )-
- $ AP( J+( K-1 )*K / 2 ) )
- WK = D12*( D22*AP( J+( K-1 )*K / 2 )-
- $ AP( J+( K-2 )*( K-1 ) / 2 ) )
- DO 40 I = J, 1, -1
- AP( I+( J-1 )*J / 2 ) = AP( I+( J-1 )*J / 2 ) -
- $ AP( I+( K-1 )*K / 2 )*WK -
- $ AP( I+( K-2 )*( K-1 ) / 2 )*WKM1
- 40 CONTINUE
- AP( J+( K-1 )*K / 2 ) = WK
- AP( J+( K-2 )*( K-1 ) / 2 ) = WKM1
- 50 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K-1 ) = -KP
- END IF
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KSTEP
- KC = KNC - K
- GO TO 10
-*
- ELSE
-*
-* Factorize A as L*D*L**T using the lower triangle of A
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2
-*
- K = 1
- KC = 1
- NPP = N*( N+1 ) / 2
- 60 CONTINUE
- KNC = KC
-*
-* If K > N, exit from loop
-*
- IF( K.GT.N )
- $ GO TO 110
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( AP( KC ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.LT.N ) THEN
- IMAX = K + IDAMAX( N-K, AP( KC+1 ), 1 )
- COLMAX = ABS( AP( KC+IMAX-K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- ROWMAX = ZERO
- KX = KC + IMAX - K
- DO 70 J = K, IMAX - 1
- IF( ABS( AP( KX ) ).GT.ROWMAX ) THEN
- ROWMAX = ABS( AP( KX ) )
- JMAX = J
- END IF
- KX = KX + N - J
- 70 CONTINUE
- KPC = NPP - ( N-IMAX+1 )*( N-IMAX+2 ) / 2 + 1
- IF( IMAX.LT.N ) THEN
- JMAX = IMAX + IDAMAX( N-IMAX, AP( KPC+1 ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( AP( KPC+JMAX-IMAX ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( AP( KPC ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K+1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K + KSTEP - 1
- IF( KSTEP.EQ.2 )
- $ KNC = KNC + N - K + 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the trailing
-* submatrix A(k:n,k:n)
-*
- IF( KP.LT.N )
- $ CALL DSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ),
- $ 1 )
- KX = KNC + KP - KK
- DO 80 J = KK + 1, KP - 1
- KX = KX + N - J + 1
- T = AP( KNC+J-KK )
- AP( KNC+J-KK ) = AP( KX )
- AP( KX ) = T
- 80 CONTINUE
- T = AP( KNC )
- AP( KNC ) = AP( KPC )
- AP( KPC ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = AP( KC+1 )
- AP( KC+1 ) = AP( KC+KP-K )
- AP( KC+KP-K ) = T
- END IF
- END IF
-*
-* Update the trailing submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = L(k)*D(k)
-*
-* where L(k) is the k-th column of L
-*
- IF( K.LT.N ) THEN
-*
-* Perform a rank-1 update of A(k+1:n,k+1:n) as
-*
-* A := A - L(k)*D(k)*L(k)**T = A - W(k)*(1/D(k))*W(k)**T
-*
- R1 = ONE / AP( KC )
- CALL DSPR( UPLO, N-K, -R1, AP( KC+1 ), 1,
- $ AP( KC+N-K+1 ) )
-*
-* Store L(k) in column K
-*
- CALL DSCAL( N-K, R1, AP( KC+1 ), 1 )
- END IF
- ELSE
-*
-* 2-by-2 pivot block D(k): columns K and K+1 now hold
-*
-* ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th columns
-* of L
-*
- IF( K.LT.N-1 ) THEN
-*
-* Perform a rank-2 update of A(k+2:n,k+2:n) as
-*
-* A := A - ( L(k) L(k+1) )*D(k)*( L(k) L(k+1) )**T
-* = A - ( W(k) W(k+1) )*inv(D(k))*( W(k) W(k+1) )**T
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th
-* columns of L
-*
- D21 = AP( K+1+( K-1 )*( 2*N-K ) / 2 )
- D11 = AP( K+1+K*( 2*N-K-1 ) / 2 ) / D21
- D22 = AP( K+( K-1 )*( 2*N-K ) / 2 ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
-*
- DO 100 J = K + 2, N
- WK = D21*( D11*AP( J+( K-1 )*( 2*N-K ) / 2 )-
- $ AP( J+K*( 2*N-K-1 ) / 2 ) )
- WKP1 = D21*( D22*AP( J+K*( 2*N-K-1 ) / 2 )-
- $ AP( J+( K-1 )*( 2*N-K ) / 2 ) )
-*
- DO 90 I = J, N
- AP( I+( J-1 )*( 2*N-J ) / 2 ) = AP( I+( J-1 )*
- $ ( 2*N-J ) / 2 ) - AP( I+( K-1 )*( 2*N-K ) /
- $ 2 )*WK - AP( I+K*( 2*N-K-1 ) / 2 )*WKP1
- 90 CONTINUE
-*
- AP( J+( K-1 )*( 2*N-K ) / 2 ) = WK
- AP( J+K*( 2*N-K-1 ) / 2 ) = WKP1
-*
- 100 CONTINUE
- END IF
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K+1 ) = -KP
- END IF
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KSTEP
- KC = KNC + N - K + 2
- GO TO 60
-*
- END IF
-*
- 110 CONTINUE
- RETURN
-*
-* End of DSPTRF
-*
- END
diff --git a/netlib/LAPACK/dsptri.f b/netlib/LAPACK/dsptri.f
deleted file mode 100644
index e914fff..0000000
--- a/netlib/LAPACK/dsptri.f
+++ /dev/null
@@ -1,401 +0,0 @@
-*> \brief \b DSPTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsptri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsptri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsptri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPTRI( UPLO, N, AP, IPIV, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPTRI computes the inverse of a real symmetric indefinite matrix
-*> A in packed storage using the factorization A = U*D*U**T or
-*> A = L*D*L**T computed by DSPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the block diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by DSPTRF,
-*> stored as a packed triangular matrix.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix, stored as a packed triangular matrix. The j-th column
-*> of inv(A) is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = inv(A)(i,j) for 1<=i<=j;
-*> if UPLO = 'L',
-*> AP(i + (j-1)*(2n-j)/2) = inv(A)(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSPTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSPTRI( UPLO, N, AP, IPIV, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, K, KC, KCNEXT, KP, KPC, KSTEP, KX, NPP
- DOUBLE PRECISION AK, AKKP1, AKP1, D, T, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DSPMV, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- KP = N*( N+1 ) / 2
- DO 10 INFO = N, 1, -1
- IF( IPIV( INFO ).GT.0 .AND. AP( KP ).EQ.ZERO )
- $ RETURN
- KP = KP - INFO
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- KP = 1
- DO 20 INFO = 1, N
- IF( IPIV( INFO ).GT.0 .AND. AP( KP ).EQ.ZERO )
- $ RETURN
- KP = KP + N - INFO + 1
- 20 CONTINUE
- END IF
- INFO = 0
-*
- IF( UPPER ) THEN
-*
-* Compute inv(A) from the factorization A = U*D*U**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- KC = 1
- 30 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 50
-*
- KCNEXT = KC + K
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- AP( KC+K-1 ) = ONE / AP( KC+K-1 )
-*
-* Compute column K of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL DCOPY( K-1, AP( KC ), 1, WORK, 1 )
- CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ),
- $ 1 )
- AP( KC+K-1 ) = AP( KC+K-1 ) -
- $ DDOT( K-1, WORK, 1, AP( KC ), 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( AP( KCNEXT+K-1 ) )
- AK = AP( KC+K-1 ) / T
- AKP1 = AP( KCNEXT+K ) / T
- AKKP1 = AP( KCNEXT+K-1 ) / T
- D = T*( AK*AKP1-ONE )
- AP( KC+K-1 ) = AKP1 / D
- AP( KCNEXT+K ) = AK / D
- AP( KCNEXT+K-1 ) = -AKKP1 / D
-*
-* Compute columns K and K+1 of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL DCOPY( K-1, AP( KC ), 1, WORK, 1 )
- CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ),
- $ 1 )
- AP( KC+K-1 ) = AP( KC+K-1 ) -
- $ DDOT( K-1, WORK, 1, AP( KC ), 1 )
- AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) -
- $ DDOT( K-1, AP( KC ), 1, AP( KCNEXT ),
- $ 1 )
- CALL DCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 )
- CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO,
- $ AP( KCNEXT ), 1 )
- AP( KCNEXT+K ) = AP( KCNEXT+K ) -
- $ DDOT( K-1, WORK, 1, AP( KCNEXT ), 1 )
- END IF
- KSTEP = 2
- KCNEXT = KCNEXT + K + 1
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the leading
-* submatrix A(1:k+1,1:k+1)
-*
- KPC = ( KP-1 )*KP / 2 + 1
- CALL DSWAP( KP-1, AP( KC ), 1, AP( KPC ), 1 )
- KX = KPC + KP - 1
- DO 40 J = KP + 1, K - 1
- KX = KX + J - 1
- TEMP = AP( KC+J-1 )
- AP( KC+J-1 ) = AP( KX )
- AP( KX ) = TEMP
- 40 CONTINUE
- TEMP = AP( KC+K-1 )
- AP( KC+K-1 ) = AP( KPC+KP-1 )
- AP( KPC+KP-1 ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = AP( KC+K+K-1 )
- AP( KC+K+K-1 ) = AP( KC+K+KP-1 )
- AP( KC+K+KP-1 ) = TEMP
- END IF
- END IF
-*
- K = K + KSTEP
- KC = KCNEXT
- GO TO 30
- 50 CONTINUE
-*
- ELSE
-*
-* Compute inv(A) from the factorization A = L*D*L**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- NPP = N*( N+1 ) / 2
- K = N
- KC = NPP
- 60 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 80
-*
- KCNEXT = KC - ( N-K+2 )
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- AP( KC ) = ONE / AP( KC )
-*
-* Compute column K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL DCOPY( N-K, AP( KC+1 ), 1, WORK, 1 )
- CALL DSPMV( UPLO, N-K, -ONE, AP( KC+N-K+1 ), WORK, 1,
- $ ZERO, AP( KC+1 ), 1 )
- AP( KC ) = AP( KC ) - DDOT( N-K, WORK, 1, AP( KC+1 ), 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( AP( KCNEXT+1 ) )
- AK = AP( KCNEXT ) / T
- AKP1 = AP( KC ) / T
- AKKP1 = AP( KCNEXT+1 ) / T
- D = T*( AK*AKP1-ONE )
- AP( KCNEXT ) = AKP1 / D
- AP( KC ) = AK / D
- AP( KCNEXT+1 ) = -AKKP1 / D
-*
-* Compute columns K-1 and K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL DCOPY( N-K, AP( KC+1 ), 1, WORK, 1 )
- CALL DSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1,
- $ ZERO, AP( KC+1 ), 1 )
- AP( KC ) = AP( KC ) - DDOT( N-K, WORK, 1, AP( KC+1 ), 1 )
- AP( KCNEXT+1 ) = AP( KCNEXT+1 ) -
- $ DDOT( N-K, AP( KC+1 ), 1,
- $ AP( KCNEXT+2 ), 1 )
- CALL DCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 )
- CALL DSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1,
- $ ZERO, AP( KCNEXT+2 ), 1 )
- AP( KCNEXT ) = AP( KCNEXT ) -
- $ DDOT( N-K, WORK, 1, AP( KCNEXT+2 ), 1 )
- END IF
- KSTEP = 2
- KCNEXT = KCNEXT - ( N-K+3 )
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the trailing
-* submatrix A(k-1:n,k-1:n)
-*
- KPC = NPP - ( N-KP+1 )*( N-KP+2 ) / 2 + 1
- IF( KP.LT.N )
- $ CALL DSWAP( N-KP, AP( KC+KP-K+1 ), 1, AP( KPC+1 ), 1 )
- KX = KC + KP - K
- DO 70 J = K + 1, KP - 1
- KX = KX + N - J + 1
- TEMP = AP( KC+J-K )
- AP( KC+J-K ) = AP( KX )
- AP( KX ) = TEMP
- 70 CONTINUE
- TEMP = AP( KC )
- AP( KC ) = AP( KPC )
- AP( KPC ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = AP( KC-N+K-1 )
- AP( KC-N+K-1 ) = AP( KC-N+KP-1 )
- AP( KC-N+KP-1 ) = TEMP
- END IF
- END IF
-*
- K = K - KSTEP
- KC = KCNEXT
- GO TO 60
- 80 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSPTRI
-*
- END
diff --git a/netlib/LAPACK/dsptrs.f b/netlib/LAPACK/dsptrs.f
deleted file mode 100644
index 48c82ac..0000000
--- a/netlib/LAPACK/dsptrs.f
+++ /dev/null
@@ -1,450 +0,0 @@
-*> \brief \b DSPTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSPTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsptrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsptrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsptrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSPTRS solves a system of linear equations A*X = B with a real
-*> symmetric matrix A stored in packed format using the factorization
-*> A = U*D*U**T or A = L*D*L**T computed by DSPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSPTRF, stored as a
-*> packed triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSPTRF.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, K, KC, KP
- DOUBLE PRECISION AK, AKM1, AKM1K, BK, BKM1, DENOM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSPTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B, where A = U*D*U**T.
-*
-* First solve U*D*X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- KC = N*( N+1 ) / 2 + 1
- 10 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 30
-*
- KC = KC - K
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL DGER( K-1, NRHS, -ONE, AP( KC ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL DSCAL( NRHS, ONE / AP( KC+K-1 ), B( K, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K-1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K-1 )
- $ CALL DSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in columns K-1 and K of A.
-*
- CALL DGER( K-2, NRHS, -ONE, AP( KC ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
- CALL DGER( K-2, NRHS, -ONE, AP( KC-( K-1 ) ), 1,
- $ B( K-1, 1 ), LDB, B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = AP( KC+K-2 )
- AKM1 = AP( KC-1 ) / AKM1K
- AK = AP( KC+K-1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 20 J = 1, NRHS
- BKM1 = B( K-1, J ) / AKM1K
- BK = B( K, J ) / AKM1K
- B( K-1, J ) = ( AK*BKM1-BK ) / DENOM
- B( K, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 20 CONTINUE
- KC = KC - K + 1
- K = K - 2
- END IF
-*
- GO TO 10
- 30 CONTINUE
-*
-* Next solve U**T*X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- KC = 1
- 40 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 50
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(U**T(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ),
- $ 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- KC = KC + K
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
-* stored in columns K and K+1 of A.
-*
- CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ),
- $ 1, ONE, B( K, 1 ), LDB )
- CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
- $ AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB )
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- KC = KC + 2*K + 1
- K = K + 2
- END IF
-*
- GO TO 40
- 50 CONTINUE
-*
- ELSE
-*
-* Solve A*X = B, where A = L*D*L**T.
-*
-* First solve L*D*X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- KC = 1
- 60 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 80
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL DGER( N-K, NRHS, -ONE, AP( KC+1 ), 1, B( K, 1 ),
- $ LDB, B( K+1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL DSCAL( NRHS, ONE / AP( KC ), B( K, 1 ), LDB )
- KC = KC + N - K + 1
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K+1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K+1 )
- $ CALL DSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in columns K and K+1 of A.
-*
- IF( K.LT.N-1 ) THEN
- CALL DGER( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ),
- $ LDB, B( K+2, 1 ), LDB )
- CALL DGER( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1,
- $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
- END IF
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = AP( KC+1 )
- AKM1 = AP( KC ) / AKM1K
- AK = AP( KC+N-K+1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 70 J = 1, NRHS
- BKM1 = B( K, J ) / AKM1K
- BK = B( K+1, J ) / AKM1K
- B( K, J ) = ( AK*BKM1-BK ) / DENOM
- B( K+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 70 CONTINUE
- KC = KC + 2*( N-K ) + 1
- K = K + 2
- END IF
-*
- GO TO 60
- 80 CONTINUE
-*
-* Next solve L**T*X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- KC = N*( N+1 ) / 2 + 1
- 90 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 100
-*
- KC = KC - ( N-K+1 )
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(L**T(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, AP( KC+1 ), 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(L**T(K-1)), where L(K-1) is the transformation
-* stored in columns K-1 and K of A.
-*
- IF( K.LT.N ) THEN
- CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, AP( KC+1 ), 1, ONE, B( K, 1 ), LDB )
- CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, AP( KC-( N-K ) ), 1, ONE, B( K-1, 1 ),
- $ LDB )
- END IF
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- KC = KC - ( N-K+2 )
- K = K - 2
- END IF
-*
- GO TO 90
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSPTRS
-*
- END
diff --git a/netlib/LAPACK/dstebz.f b/netlib/LAPACK/dstebz.f
deleted file mode 100644
index 01bea27..0000000
--- a/netlib/LAPACK/dstebz.f
+++ /dev/null
@@ -1,761 +0,0 @@
-*> \brief \b DSTEBZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEBZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstebz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstebz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstebz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
-* M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ORDER, RANGE
-* INTEGER IL, INFO, IU, M, N, NSPLIT
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEBZ computes the eigenvalues of a symmetric tridiagonal
-*> matrix T. The user may ask for all eigenvalues, all eigenvalues
-*> in the half-open interval (VL, VU], or the IL-th through IU-th
-*> eigenvalues.
-*>
-*> To avoid overflow, the matrix must be scaled so that its
-*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
-*> accuracy, it should not be much smaller than that.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': ("All") all eigenvalues will be found.
-*> = 'V': ("Value") all eigenvalues in the half-open interval
-*> (VL, VU] will be found.
-*> = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
-*> entire matrix) will be found.
-*> \endverbatim
-*>
-*> \param[in] ORDER
-*> \verbatim
-*> ORDER is CHARACTER*1
-*> = 'B': ("By Block") the eigenvalues will be grouped by
-*> split-off block (see IBLOCK, ISPLIT) and
-*> ordered from smallest to largest within
-*> the block.
-*> = 'E': ("Entire matrix")
-*> the eigenvalues for the entire matrix
-*> will be ordered from smallest to
-*> largest.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. Eigenvalues less than or equal
-*> to VL, or greater than VU, will not be returned. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute tolerance for the eigenvalues. An eigenvalue
-*> (or cluster) is considered to be located if it has been
-*> determined to lie in an interval whose width is ABSTOL or
-*> less. If ABSTOL is less than or equal to zero, then ULP*|T|
-*> will be used, where |T| means the 1-norm of T.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The actual number of eigenvalues found. 0 <= M <= N.
-*> (See also the description of INFO=2,3.)
-*> \endverbatim
-*>
-*> \param[out] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of diagonal blocks in the matrix T.
-*> 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On exit, the first M elements of W will contain the
-*> eigenvalues. (DSTEBZ may use the remaining N-M elements as
-*> workspace.)
-*> \endverbatim
-*>
-*> \param[out] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> At each row/column j where E(j) is zero or small, the
-*> matrix T is considered to split into a block diagonal
-*> matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
-*> block (from 1 to the number of blocks) the eigenvalue W(i)
-*> belongs. (DSTEBZ may use the remaining N-M elements as
-*> workspace.)
-*> \endverbatim
-*>
-*> \param[out] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into submatrices.
-*> The first submatrix consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> (Only the first NSPLIT elements will actually be used, but
-*> since the user cannot know a priori what value NSPLIT will
-*> have, N words must be reserved for ISPLIT.)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: some or all of the eigenvalues failed to converge or
-*> were not computed:
-*> =1 or 3: Bisection failed to converge for some
-*> eigenvalues; these eigenvalues are flagged by a
-*> negative block number. The effect is that the
-*> eigenvalues may not be as accurate as the
-*> absolute and relative tolerances. This is
-*> generally caused by unexpectedly inaccurate
-*> arithmetic.
-*> =2 or 3: RANGE='I' only: Not all of the eigenvalues
-*> IL:IU were found.
-*> Effect: M < IU+1-IL
-*> Cause: non-monotonic arithmetic, causing the
-*> Sturm sequence to be non-monotonic.
-*> Cure: recalculate, using RANGE='A', and pick
-*> out eigenvalues IL:IU. In some cases,
-*> increasing the PARAMETER "FUDGE" may
-*> make things work.
-*> = 4: RANGE='I', and the Gershgorin interval
-*> initially used was too small. No eigenvalues
-*> were computed.
-*> Probable cause: your machine has sloppy
-*> floating-point arithmetic.
-*> Cure: Increase the PARAMETER "FUDGE",
-*> recompile, and try again.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> RELFAC DOUBLE PRECISION, default = 2.0e0
-*> The relative tolerance. An interval (a,b] lies within
-*> "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|),
-*> where "ulp" is the machine precision (distance from 1 to
-*> the next larger floating point number.)
-*>
-*> FUDGE DOUBLE PRECISION, default = 2
-*> A "fudge factor" to widen the Gershgorin intervals. Ideally,
-*> a value of 1 should work, but on machines with sloppy
-*> arithmetic, this needs to be larger. The default for
-*> publicly released versions should be large enough to handle
-*> the worst machine around. Note that this has no effect
-*> on accuracy of the solution.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
- $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER ORDER, RANGE
- INTEGER IL, INFO, IU, M, N, NSPLIT
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, HALF
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ HALF = 1.0D0 / TWO )
- DOUBLE PRECISION FUDGE, RELFAC
- PARAMETER ( FUDGE = 2.1D0, RELFAC = 2.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NCNVRG, TOOFEW
- INTEGER IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
- $ IM, IN, IOFF, IORDER, IOUT, IRANGE, ITMAX,
- $ ITMP1, IW, IWOFF, J, JB, JDISC, JE, NB, NWL,
- $ NWU
- DOUBLE PRECISION ATOLI, BNORM, GL, GU, PIVMIN, RTOLI, SAFEMN,
- $ TMP1, TMP2, TNORM, ULP, WKILL, WL, WLU, WU, WUL
-* ..
-* .. Local Arrays ..
- INTEGER IDUMMA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, ILAENV, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAEBZ, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Decode RANGE
-*
- IF( LSAME( RANGE, 'A' ) ) THEN
- IRANGE = 1
- ELSE IF( LSAME( RANGE, 'V' ) ) THEN
- IRANGE = 2
- ELSE IF( LSAME( RANGE, 'I' ) ) THEN
- IRANGE = 3
- ELSE
- IRANGE = 0
- END IF
-*
-* Decode ORDER
-*
- IF( LSAME( ORDER, 'B' ) ) THEN
- IORDER = 2
- ELSE IF( LSAME( ORDER, 'E' ) ) THEN
- IORDER = 1
- ELSE
- IORDER = 0
- END IF
-*
-* Check for Errors
-*
- IF( IRANGE.LE.0 ) THEN
- INFO = -1
- ELSE IF( IORDER.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( IRANGE.EQ.2 ) THEN
- IF( VL.GE.VU )
- $ INFO = -5
- ELSE IF( IRANGE.EQ.3 .AND. ( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) )
- $ THEN
- INFO = -6
- ELSE IF( IRANGE.EQ.3 .AND. ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) )
- $ THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEBZ', -INFO )
- RETURN
- END IF
-*
-* Initialize error flags
-*
- INFO = 0
- NCNVRG = .FALSE.
- TOOFEW = .FALSE.
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
-* Simplifications:
-*
- IF( IRANGE.EQ.3 .AND. IL.EQ.1 .AND. IU.EQ.N )
- $ IRANGE = 1
-*
-* Get machine constants
-* NB is the minimum vector length for vector bisection, or 0
-* if only scalar is to be done.
-*
- SAFEMN = DLAMCH( 'S' )
- ULP = DLAMCH( 'P' )
- RTOLI = ULP*RELFAC
- NB = ILAENV( 1, 'DSTEBZ', ' ', N, -1, -1, -1 )
- IF( NB.LE.1 )
- $ NB = 0
-*
-* Special Case when N=1
-*
- IF( N.EQ.1 ) THEN
- NSPLIT = 1
- ISPLIT( 1 ) = 1
- IF( IRANGE.EQ.2 .AND. ( VL.GE.D( 1 ) .OR. VU.LT.D( 1 ) ) ) THEN
- M = 0
- ELSE
- W( 1 ) = D( 1 )
- IBLOCK( 1 ) = 1
- M = 1
- END IF
- RETURN
- END IF
-*
-* Compute Splitting Points
-*
- NSPLIT = 1
- WORK( N ) = ZERO
- PIVMIN = ONE
-*
- DO 10 J = 2, N
- TMP1 = E( J-1 )**2
- IF( ABS( D( J )*D( J-1 ) )*ULP**2+SAFEMN.GT.TMP1 ) THEN
- ISPLIT( NSPLIT ) = J - 1
- NSPLIT = NSPLIT + 1
- WORK( J-1 ) = ZERO
- ELSE
- WORK( J-1 ) = TMP1
- PIVMIN = MAX( PIVMIN, TMP1 )
- END IF
- 10 CONTINUE
- ISPLIT( NSPLIT ) = N
- PIVMIN = PIVMIN*SAFEMN
-*
-* Compute Interval and ATOLI
-*
- IF( IRANGE.EQ.3 ) THEN
-*
-* RANGE='I': Compute the interval containing eigenvalues
-* IL through IU.
-*
-* Compute Gershgorin interval for entire (split) matrix
-* and use it as the initial interval
-*
- GU = D( 1 )
- GL = D( 1 )
- TMP1 = ZERO
-*
- DO 20 J = 1, N - 1
- TMP2 = SQRT( WORK( J ) )
- GU = MAX( GU, D( J )+TMP1+TMP2 )
- GL = MIN( GL, D( J )-TMP1-TMP2 )
- TMP1 = TMP2
- 20 CONTINUE
-*
- GU = MAX( GU, D( N )+TMP1 )
- GL = MIN( GL, D( N )-TMP1 )
- TNORM = MAX( ABS( GL ), ABS( GU ) )
- GL = GL - FUDGE*TNORM*ULP*N - FUDGE*TWO*PIVMIN
- GU = GU + FUDGE*TNORM*ULP*N + FUDGE*PIVMIN
-*
-* Compute Iteration parameters
-*
- ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- IF( ABSTOL.LE.ZERO ) THEN
- ATOLI = ULP*TNORM
- ELSE
- ATOLI = ABSTOL
- END IF
-*
- WORK( N+1 ) = GL
- WORK( N+2 ) = GL
- WORK( N+3 ) = GU
- WORK( N+4 ) = GU
- WORK( N+5 ) = GL
- WORK( N+6 ) = GU
- IWORK( 1 ) = -1
- IWORK( 2 ) = -1
- IWORK( 3 ) = N + 1
- IWORK( 4 ) = N + 1
- IWORK( 5 ) = IL - 1
- IWORK( 6 ) = IU
-*
- CALL DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E,
- $ WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
- $ IWORK, W, IBLOCK, IINFO )
-*
- IF( IWORK( 6 ).EQ.IU ) THEN
- WL = WORK( N+1 )
- WLU = WORK( N+3 )
- NWL = IWORK( 1 )
- WU = WORK( N+4 )
- WUL = WORK( N+2 )
- NWU = IWORK( 4 )
- ELSE
- WL = WORK( N+2 )
- WLU = WORK( N+4 )
- NWL = IWORK( 2 )
- WU = WORK( N+3 )
- WUL = WORK( N+1 )
- NWU = IWORK( 3 )
- END IF
-*
- IF( NWL.LT.0 .OR. NWL.GE.N .OR. NWU.LT.1 .OR. NWU.GT.N ) THEN
- INFO = 4
- RETURN
- END IF
- ELSE
-*
-* RANGE='A' or 'V' -- Set ATOLI
-*
- TNORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ),
- $ ABS( D( N ) )+ABS( E( N-1 ) ) )
-*
- DO 30 J = 2, N - 1
- TNORM = MAX( TNORM, ABS( D( J ) )+ABS( E( J-1 ) )+
- $ ABS( E( J ) ) )
- 30 CONTINUE
-*
- IF( ABSTOL.LE.ZERO ) THEN
- ATOLI = ULP*TNORM
- ELSE
- ATOLI = ABSTOL
- END IF
-*
- IF( IRANGE.EQ.2 ) THEN
- WL = VL
- WU = VU
- ELSE
- WL = ZERO
- WU = ZERO
- END IF
- END IF
-*
-* Find Eigenvalues -- Loop Over Blocks and recompute NWL and NWU.
-* NWL accumulates the number of eigenvalues .le. WL,
-* NWU accumulates the number of eigenvalues .le. WU
-*
- M = 0
- IEND = 0
- INFO = 0
- NWL = 0
- NWU = 0
-*
- DO 70 JB = 1, NSPLIT
- IOFF = IEND
- IBEGIN = IOFF + 1
- IEND = ISPLIT( JB )
- IN = IEND - IOFF
-*
- IF( IN.EQ.1 ) THEN
-*
-* Special Case -- IN=1
-*
- IF( IRANGE.EQ.1 .OR. WL.GE.D( IBEGIN )-PIVMIN )
- $ NWL = NWL + 1
- IF( IRANGE.EQ.1 .OR. WU.GE.D( IBEGIN )-PIVMIN )
- $ NWU = NWU + 1
- IF( IRANGE.EQ.1 .OR. ( WL.LT.D( IBEGIN )-PIVMIN .AND. WU.GE.
- $ D( IBEGIN )-PIVMIN ) ) THEN
- M = M + 1
- W( M ) = D( IBEGIN )
- IBLOCK( M ) = JB
- END IF
- ELSE
-*
-* General Case -- IN > 1
-*
-* Compute Gershgorin Interval
-* and use it as the initial interval
-*
- GU = D( IBEGIN )
- GL = D( IBEGIN )
- TMP1 = ZERO
-*
- DO 40 J = IBEGIN, IEND - 1
- TMP2 = ABS( E( J ) )
- GU = MAX( GU, D( J )+TMP1+TMP2 )
- GL = MIN( GL, D( J )-TMP1-TMP2 )
- TMP1 = TMP2
- 40 CONTINUE
-*
- GU = MAX( GU, D( IEND )+TMP1 )
- GL = MIN( GL, D( IEND )-TMP1 )
- BNORM = MAX( ABS( GL ), ABS( GU ) )
- GL = GL - FUDGE*BNORM*ULP*IN - FUDGE*PIVMIN
- GU = GU + FUDGE*BNORM*ULP*IN + FUDGE*PIVMIN
-*
-* Compute ATOLI for the current submatrix
-*
- IF( ABSTOL.LE.ZERO ) THEN
- ATOLI = ULP*MAX( ABS( GL ), ABS( GU ) )
- ELSE
- ATOLI = ABSTOL
- END IF
-*
- IF( IRANGE.GT.1 ) THEN
- IF( GU.LT.WL ) THEN
- NWL = NWL + IN
- NWU = NWU + IN
- GO TO 70
- END IF
- GL = MAX( GL, WL )
- GU = MIN( GU, WU )
- IF( GL.GE.GU )
- $ GO TO 70
- END IF
-*
-* Set Up Initial Interval
-*
- WORK( N+1 ) = GL
- WORK( N+IN+1 ) = GU
- CALL DLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
-*
- NWL = NWL + IWORK( 1 )
- NWU = NWU + IWORK( IN+1 )
- IWOFF = M - IWORK( 1 )
-*
-* Compute Eigenvalues
-*
- ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
-*
-* Copy Eigenvalues Into W and IBLOCK
-* Use -JB for block number for unconverged eigenvalues.
-*
- DO 60 J = 1, IOUT
- TMP1 = HALF*( WORK( J+N )+WORK( J+IN+N ) )
-*
-* Flag non-convergence.
-*
- IF( J.GT.IOUT-IINFO ) THEN
- NCNVRG = .TRUE.
- IB = -JB
- ELSE
- IB = JB
- END IF
- DO 50 JE = IWORK( J ) + 1 + IWOFF,
- $ IWORK( J+IN ) + IWOFF
- W( JE ) = TMP1
- IBLOCK( JE ) = IB
- 50 CONTINUE
- 60 CONTINUE
-*
- M = M + IM
- END IF
- 70 CONTINUE
-*
-* If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
-* If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
-*
- IF( IRANGE.EQ.3 ) THEN
- IM = 0
- IDISCL = IL - 1 - NWL
- IDISCU = NWU - IU
-*
- IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
- DO 80 JE = 1, M
- IF( W( JE ).LE.WLU .AND. IDISCL.GT.0 ) THEN
- IDISCL = IDISCL - 1
- ELSE IF( W( JE ).GE.WUL .AND. IDISCU.GT.0 ) THEN
- IDISCU = IDISCU - 1
- ELSE
- IM = IM + 1
- W( IM ) = W( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 80 CONTINUE
- M = IM
- END IF
- IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
-*
-* Code to deal with effects of bad arithmetic:
-* Some low eigenvalues to be discarded are not in (WL,WLU],
-* or high eigenvalues to be discarded are not in (WUL,WU]
-* so just kill off the smallest IDISCL/largest IDISCU
-* eigenvalues, by simply finding the smallest/largest
-* eigenvalue(s).
-*
-* (If N(w) is monotone non-decreasing, this should never
-* happen.)
-*
- IF( IDISCL.GT.0 ) THEN
- WKILL = WU
- DO 100 JDISC = 1, IDISCL
- IW = 0
- DO 90 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).LT.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 90 CONTINUE
- IBLOCK( IW ) = 0
- 100 CONTINUE
- END IF
- IF( IDISCU.GT.0 ) THEN
-*
- WKILL = WL
- DO 120 JDISC = 1, IDISCU
- IW = 0
- DO 110 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).GT.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 110 CONTINUE
- IBLOCK( IW ) = 0
- 120 CONTINUE
- END IF
- IM = 0
- DO 130 JE = 1, M
- IF( IBLOCK( JE ).NE.0 ) THEN
- IM = IM + 1
- W( IM ) = W( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 130 CONTINUE
- M = IM
- END IF
- IF( IDISCL.LT.0 .OR. IDISCU.LT.0 ) THEN
- TOOFEW = .TRUE.
- END IF
- END IF
-*
-* If ORDER='B', do nothing -- the eigenvalues are already sorted
-* by block.
-* If ORDER='E', sort the eigenvalues from smallest to largest
-*
- IF( IORDER.EQ.1 .AND. NSPLIT.GT.1 ) THEN
- DO 150 JE = 1, M - 1
- IE = 0
- TMP1 = W( JE )
- DO 140 J = JE + 1, M
- IF( W( J ).LT.TMP1 ) THEN
- IE = J
- TMP1 = W( J )
- END IF
- 140 CONTINUE
-*
- IF( IE.NE.0 ) THEN
- ITMP1 = IBLOCK( IE )
- W( IE ) = W( JE )
- IBLOCK( IE ) = IBLOCK( JE )
- W( JE ) = TMP1
- IBLOCK( JE ) = ITMP1
- END IF
- 150 CONTINUE
- END IF
-*
- INFO = 0
- IF( NCNVRG )
- $ INFO = INFO + 1
- IF( TOOFEW )
- $ INFO = INFO + 2
- RETURN
-*
-* End of DSTEBZ
-*
- END
diff --git a/netlib/LAPACK/dstedc.f b/netlib/LAPACK/dstedc.f
deleted file mode 100644
index b59e1c3..0000000
--- a/netlib/LAPACK/dstedc.f
+++ /dev/null
@@ -1,489 +0,0 @@
-*> \brief \b DSTEBZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEDC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstedc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstedc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstedc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPZ
-* INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEDC computes all eigenvalues and, optionally, eigenvectors of a
-*> symmetric tridiagonal matrix using the divide and conquer method.
-*> The eigenvectors of a full or band real symmetric matrix can also be
-*> found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this
-*> matrix to tridiagonal form.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none. See DLAED3 for details.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only.
-*> = 'I': Compute eigenvectors of tridiagonal matrix also.
-*> = 'V': Compute eigenvectors of original dense symmetric
-*> matrix also. On entry, Z contains the orthogonal
-*> matrix used to reduce the original matrix to
-*> tridiagonal form.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the diagonal elements of the tridiagonal matrix.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the subdiagonal elements of the tridiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> On entry, if COMPZ = 'V', then Z contains the orthogonal
-*> matrix used in the reduction to tridiagonal form.
-*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
-*> orthonormal eigenvectors of the original symmetric matrix,
-*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors
-*> of the symmetric tridiagonal matrix.
-*> If COMPZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If eigenvectors are desired, then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
-*> If COMPZ = 'V' and N > 1 then LWORK must be at least
-*> ( 1 + 3*N + 2*N*lg N + 4*N**2 ),
-*> where lg( N ) = smallest integer k such
-*> that 2**k >= N.
-*> If COMPZ = 'I' and N > 1 then LWORK must be at least
-*> ( 1 + 4*N + N**2 ).
-*> Note that for COMPZ = 'I' or 'V', then if N is less than or
-*> equal to the minimum divide size, usually 25, then LWORK need
-*> only be max(1,2*(N-1)).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
-*> If COMPZ = 'V' and N > 1 then LIWORK must be at least
-*> ( 6 + 6*N + 5*N*lg N ).
-*> If COMPZ = 'I' and N > 1 then LIWORK must be at least
-*> ( 3 + 5*N ).
-*> Note that for COMPZ = 'I' or 'V', then if N is less than or
-*> equal to the minimum divide size, usually 25, then LIWORK
-*> need only be 1.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute an eigenvalue while
-*> working on the submatrix lying in rows and columns
-*> INFO/(N+1) through mod(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPZ
- INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER FINISH, I, ICOMPZ, II, J, K, LGN, LIWMIN,
- $ LWMIN, M, SMLSIZ, START, STOREZ, STRTRW
- DOUBLE PRECISION EPS, ORGNRM, P, TINY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET, DLASRT,
- $ DSTEQR, DSTERF, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, LOG, MAX, MOD, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ICOMPZ = 0
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ICOMPZ = 2
- ELSE
- ICOMPZ = -1
- END IF
- IF( ICOMPZ.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( LDZ.LT.1 ) .OR.
- $ ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -6
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Compute the workspace requirements
-*
- SMLSIZ = ILAENV( 9, 'DSTEDC', ' ', 0, 0, 0, 0 )
- IF( N.LE.1 .OR. ICOMPZ.EQ.0 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE IF( N.LE.SMLSIZ ) THEN
- LIWMIN = 1
- LWMIN = 2*( N - 1 )
- ELSE
- LGN = INT( LOG( DBLE( N ) )/LOG( TWO ) )
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IF( ICOMPZ.EQ.1 ) THEN
- LWMIN = 1 + 3*N + 2*N*LGN + 4*N**2
- LIWMIN = 6 + 6*N + 5*N*LGN
- ELSE IF( ICOMPZ.EQ.2 ) THEN
- LWMIN = 1 + 4*N + N**2
- LIWMIN = 3 + 5*N
- END IF
- END IF
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT. LQUERY ) THEN
- INFO = -8
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT. LQUERY ) THEN
- INFO = -10
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEDC', -INFO )
- RETURN
- ELSE IF (LQUERY) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( N.EQ.1 ) THEN
- IF( ICOMPZ.NE.0 )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* If the following conditional clause is removed, then the routine
-* will use the Divide and Conquer routine to compute only the
-* eigenvalues, which requires (3N + 3N**2) real workspace and
-* (2 + 5N + 2N lg(N)) integer workspace.
-* Since on many architectures DSTERF is much faster than any other
-* algorithm for finding eigenvalues only, it is used here
-* as the default. If the conditional clause is removed, then
-* information on the size of workspace needs to be changed.
-*
-* If COMPZ = 'N', use DSTERF to compute the eigenvalues.
-*
- IF( ICOMPZ.EQ.0 ) THEN
- CALL DSTERF( N, D, E, INFO )
- GO TO 50
- END IF
-*
-* If N is smaller than the minimum divide size (SMLSIZ+1), then
-* solve the problem with another solver.
-*
- IF( N.LE.SMLSIZ ) THEN
-*
- CALL DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
- ELSE
-*
-* If COMPZ = 'V', the Z matrix must be stored elsewhere for later
-* use.
-*
- IF( ICOMPZ.EQ.1 ) THEN
- STOREZ = 1 + N*N
- ELSE
- STOREZ = 1
- END IF
-*
- IF( ICOMPZ.EQ.2 ) THEN
- CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
- END IF
-*
-* Scale.
-*
- ORGNRM = DLANST( 'M', N, D, E )
- IF( ORGNRM.EQ.ZERO )
- $ GO TO 50
-*
- EPS = DLAMCH( 'Epsilon' )
-*
- START = 1
-*
-* while ( START <= N )
-*
- 10 CONTINUE
- IF( START.LE.N ) THEN
-*
-* Let FINISH be the position of the next subdiagonal entry
-* such that E( FINISH ) <= TINY or FINISH = N if no such
-* subdiagonal exists. The matrix identified by the elements
-* between START and FINISH constitutes an independent
-* sub-problem.
-*
- FINISH = START
- 20 CONTINUE
- IF( FINISH.LT.N ) THEN
- TINY = EPS*SQRT( ABS( D( FINISH ) ) )*
- $ SQRT( ABS( D( FINISH+1 ) ) )
- IF( ABS( E( FINISH ) ).GT.TINY ) THEN
- FINISH = FINISH + 1
- GO TO 20
- END IF
- END IF
-*
-* (Sub) Problem determined. Compute its size and solve it.
-*
- M = FINISH - START + 1
- IF( M.EQ.1 ) THEN
- START = FINISH + 1
- GO TO 10
- END IF
- IF( M.GT.SMLSIZ ) THEN
-*
-* Scale.
-*
- ORGNRM = DLANST( 'M', M, D( START ), E( START ) )
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M,
- $ INFO )
- CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ),
- $ M-1, INFO )
-*
- IF( ICOMPZ.EQ.1 ) THEN
- STRTRW = 1
- ELSE
- STRTRW = START
- END IF
- CALL DLAED0( ICOMPZ, N, M, D( START ), E( START ),
- $ Z( STRTRW, START ), LDZ, WORK( 1 ), N,
- $ WORK( STOREZ ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) +
- $ MOD( INFO, ( M+1 ) ) + START - 1
- GO TO 50
- END IF
-*
-* Scale back.
-*
- CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M,
- $ INFO )
-*
- ELSE
- IF( ICOMPZ.EQ.1 ) THEN
-*
-* Since QR won't update a Z matrix which is larger than
-* the length of D, we must solve the sub-problem in a
-* workspace and then multiply back into Z.
-*
- CALL DSTEQR( 'I', M, D( START ), E( START ), WORK, M,
- $ WORK( M*M+1 ), INFO )
- CALL DLACPY( 'A', N, M, Z( 1, START ), LDZ,
- $ WORK( STOREZ ), N )
- CALL DGEMM( 'N', 'N', N, M, M, ONE,
- $ WORK( STOREZ ), N, WORK, M, ZERO,
- $ Z( 1, START ), LDZ )
- ELSE IF( ICOMPZ.EQ.2 ) THEN
- CALL DSTEQR( 'I', M, D( START ), E( START ),
- $ Z( START, START ), LDZ, WORK, INFO )
- ELSE
- CALL DSTERF( M, D( START ), E( START ), INFO )
- END IF
- IF( INFO.NE.0 ) THEN
- INFO = START*( N+1 ) + FINISH
- GO TO 50
- END IF
- END IF
-*
- START = FINISH + 1
- GO TO 10
- END IF
-*
-* endwhile
-*
-* If the problem split any number of times, then the eigenvalues
-* will not be properly ordered. Here we permute the eigenvalues
-* (and the associated eigenvectors) into ascending order.
-*
- IF( M.NE.N ) THEN
- IF( ICOMPZ.EQ.0 ) THEN
-*
-* Use Quick Sort
-*
- CALL DLASRT( 'I', N, D, INFO )
-*
- ELSE
-*
-* Use Selection Sort to minimize swaps of eigenvectors
-*
- DO 40 II = 2, N
- I = II - 1
- K = I
- P = D( I )
- DO 30 J = II, N
- IF( D( J ).LT.P ) THEN
- K = J
- P = D( J )
- END IF
- 30 CONTINUE
- IF( K.NE.I ) THEN
- D( K ) = D( I )
- D( I ) = P
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
- END IF
- 40 CONTINUE
- END IF
- END IF
- END IF
-*
- 50 CONTINUE
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DSTEDC
-*
- END
diff --git a/netlib/LAPACK/dstegr.f b/netlib/LAPACK/dstegr.f
deleted file mode 100644
index 298e1c7..0000000
--- a/netlib/LAPACK/dstegr.f
+++ /dev/null
@@ -1,293 +0,0 @@
-*> \brief \b DSTEGR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEGR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstegr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstegr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstegr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEGR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
-* DOUBLE PRECISION Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEGR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has
-*> a well defined set of pairwise different real eigenvalues, the corresponding
-*> real eigenvectors are pairwise orthogonal.
-*>
-*> The spectrum may be computed either completely or partially by specifying
-*> either an interval (VL,VU] or a range of indices IL:IU for the desired
-*> eigenvalues.
-*>
-*> DSTEGR is a compatability wrapper around the improved DSTEMR routine.
-*> See DSTEMR for further details.
-*>
-*> One important change is that the ABSTOL parameter no longer provides any
-*> benefit and hence is no longer used.
-*>
-*> Note : DSTEGR and DSTEMR work only on machines which follow
-*> IEEE-754 floating-point standard in their handling of infinities and
-*> NaNs. Normal execution may create these exceptiona values and hence
-*> may abort due to a floating point exception in environments which
-*> do not conform to the IEEE-754 standard.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal matrix
-*> T. On exit, D is overwritten.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, the (N-1) subdiagonal elements of the tridiagonal
-*> matrix T in elements 1 to N-1 of E. E(N) need not be set on
-*> input, but is used internally as workspace.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> Unused. Was the absolute error tolerance for the
-*> eigenvalues/eigenvectors in previous versions.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix T
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> Supplying N columns is always safe.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th computed eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ). This is relevant in the case when the matrix
-*> is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal
-*> (and minimal) LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,18*N)
-*> if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (LIWORK)
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N)
-*> if the eigenvectors are desired, and LIWORK >= max(1,8*N)
-*> if only the eigenvalues are to be computed.
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = 1X, internal error in DLARRE,
-*> if INFO = 2X, internal error in DLARRV.
-*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
-*> the nonzero error code returned by DLARRE or
-*> DLARRV, respectively.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Inderjit Dhillon, IBM Almaden, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE DSTEGR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
- DOUBLE PRECISION Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL TRYRAC
-* ..
-* .. External Subroutines ..
- EXTERNAL DSTEMR
-* ..
-* .. Executable Statements ..
- INFO = 0
- TRYRAC = .FALSE.
-
- CALL DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
- $ M, W, Z, LDZ, N, ISUPPZ, TRYRAC, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* End of DSTEGR
-*
- END
diff --git a/netlib/LAPACK/dstein.f b/netlib/LAPACK/dstein.f
deleted file mode 100644
index 7cc372b..0000000
--- a/netlib/LAPACK/dstein.f
+++ /dev/null
@@ -1,452 +0,0 @@
-*> \brief \b DSTEIN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEIN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstein.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstein.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstein.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK,
-* IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDZ, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), IFAIL( * ), ISPLIT( * ),
-* $ IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEIN computes the eigenvectors of a real symmetric tridiagonal
-*> matrix T corresponding to specified eigenvalues, using inverse
-*> iteration.
-*>
-*> The maximum number of iterations allowed for each eigenvector is
-*> specified by an internal parameter MAXITS (currently set to 5).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the tridiagonal matrix
-*> T, in elements 1 to N-1.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of eigenvectors to be found. 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements of W contain the eigenvalues for
-*> which eigenvectors are to be computed. The eigenvalues
-*> should be grouped by split-off block and ordered from
-*> smallest to largest within the block. ( The output array
-*> W from DSTEBZ with ORDER = 'B' is expected here. )
-*> \endverbatim
-*>
-*> \param[in] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> The submatrix indices associated with the corresponding
-*> eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to
-*> the first submatrix from the top, =2 if W(i) belongs to
-*> the second submatrix, etc. ( The output array IBLOCK
-*> from DSTEBZ is expected here. )
-*> \endverbatim
-*>
-*> \param[in] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into submatrices.
-*> The first submatrix consists of rows/columns 1 to
-*> ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
-*> through ISPLIT( 2 ), etc.
-*> ( The output array ISPLIT from DSTEBZ is expected here. )
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, M)
-*> The computed eigenvectors. The eigenvector associated
-*> with the eigenvalue W(i) is stored in the i-th column of
-*> Z. Any vector which fails to converge is set to its current
-*> iterate after MAXITS iterations.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (M)
-*> On normal exit, all elements of IFAIL are zero.
-*> If one or more eigenvectors fail to converge after
-*> MAXITS iterations, then their indices are stored in
-*> array IFAIL.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge
-*> in MAXITS iterations. Their indices are stored in
-*> array IFAIL.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> MAXITS INTEGER, default = 5
-*> The maximum number of iterations performed.
-*>
-*> EXTRA INTEGER, default = 2
-*> The number of iterations performed after norm growth
-*> criterion is satisfied, should be at least 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK,
- $ IWORK, IFAIL, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDZ, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), IFAIL( * ), ISPLIT( * ),
- $ IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TEN, ODM3, ODM1
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 1.0D+1,
- $ ODM3 = 1.0D-3, ODM1 = 1.0D-1 )
- INTEGER MAXITS, EXTRA
- PARAMETER ( MAXITS = 5, EXTRA = 2 )
-* ..
-* .. Local Scalars ..
- INTEGER B1, BLKSIZ, BN, GPIND, I, IINFO, INDRV1,
- $ INDRV2, INDRV3, INDRV4, INDRV5, ITS, J, J1,
- $ JBLK, JMAX, NBLK, NRMCHK
- DOUBLE PRECISION DTPCRT, EPS, EPS1, NRM, ONENRM, ORTOL, PERTOL,
- $ SCL, SEP, TOL, XJ, XJM, ZTR
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 )
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH, DNRM2
- EXTERNAL IDAMAX, DASUM, DDOT, DLAMCH, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLAGTF, DLAGTS, DLARNV, DSCAL,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- DO 10 I = 1, M
- IFAIL( I ) = 0
- 10 CONTINUE
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 .OR. M.GT.N ) THEN
- INFO = -4
- ELSE IF( LDZ.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE
- DO 20 J = 2, M
- IF( IBLOCK( J ).LT.IBLOCK( J-1 ) ) THEN
- INFO = -6
- GO TO 30
- END IF
- IF( IBLOCK( J ).EQ.IBLOCK( J-1 ) .AND. W( J ).LT.W( J-1 ) )
- $ THEN
- INFO = -5
- GO TO 30
- END IF
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEIN', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- EPS = DLAMCH( 'Precision' )
-*
-* Initialize seed for random number generator DLARNV.
-*
- DO 40 I = 1, 4
- ISEED( I ) = 1
- 40 CONTINUE
-*
-* Initialize pointers.
-*
- INDRV1 = 0
- INDRV2 = INDRV1 + N
- INDRV3 = INDRV2 + N
- INDRV4 = INDRV3 + N
- INDRV5 = INDRV4 + N
-*
-* Compute eigenvectors of matrix blocks.
-*
- J1 = 1
- DO 160 NBLK = 1, IBLOCK( M )
-*
-* Find starting and ending indices of block nblk.
-*
- IF( NBLK.EQ.1 ) THEN
- B1 = 1
- ELSE
- B1 = ISPLIT( NBLK-1 ) + 1
- END IF
- BN = ISPLIT( NBLK )
- BLKSIZ = BN - B1 + 1
- IF( BLKSIZ.EQ.1 )
- $ GO TO 60
- GPIND = B1
-*
-* Compute reorthogonalization criterion and stopping criterion.
-*
- ONENRM = ABS( D( B1 ) ) + ABS( E( B1 ) )
- ONENRM = MAX( ONENRM, ABS( D( BN ) )+ABS( E( BN-1 ) ) )
- DO 50 I = B1 + 1, BN - 1
- ONENRM = MAX( ONENRM, ABS( D( I ) )+ABS( E( I-1 ) )+
- $ ABS( E( I ) ) )
- 50 CONTINUE
- ORTOL = ODM3*ONENRM
-*
- DTPCRT = SQRT( ODM1 / BLKSIZ )
-*
-* Loop through eigenvalues of block nblk.
-*
- 60 CONTINUE
- JBLK = 0
- DO 150 J = J1, M
- IF( IBLOCK( J ).NE.NBLK ) THEN
- J1 = J
- GO TO 160
- END IF
- JBLK = JBLK + 1
- XJ = W( J )
-*
-* Skip all the work if the block size is one.
-*
- IF( BLKSIZ.EQ.1 ) THEN
- WORK( INDRV1+1 ) = ONE
- GO TO 120
- END IF
-*
-* If eigenvalues j and j-1 are too close, add a relatively
-* small perturbation.
-*
- IF( JBLK.GT.1 ) THEN
- EPS1 = ABS( EPS*XJ )
- PERTOL = TEN*EPS1
- SEP = XJ - XJM
- IF( SEP.LT.PERTOL )
- $ XJ = XJM + PERTOL
- END IF
-*
- ITS = 0
- NRMCHK = 0
-*
-* Get random starting vector.
-*
- CALL DLARNV( 2, ISEED, BLKSIZ, WORK( INDRV1+1 ) )
-*
-* Copy the matrix T so it won't be destroyed in factorization.
-*
- CALL DCOPY( BLKSIZ, D( B1 ), 1, WORK( INDRV4+1 ), 1 )
- CALL DCOPY( BLKSIZ-1, E( B1 ), 1, WORK( INDRV2+2 ), 1 )
- CALL DCOPY( BLKSIZ-1, E( B1 ), 1, WORK( INDRV3+1 ), 1 )
-*
-* Compute LU factors with partial pivoting ( PT = LU )
-*
- TOL = ZERO
- CALL DLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, WORK( INDRV2+2 ),
- $ WORK( INDRV3+1 ), TOL, WORK( INDRV5+1 ), IWORK,
- $ IINFO )
-*
-* Update iteration count.
-*
- 70 CONTINUE
- ITS = ITS + 1
- IF( ITS.GT.MAXITS )
- $ GO TO 100
-*
-* Normalize and scale the righthand side vector Pb.
-*
- SCL = BLKSIZ*ONENRM*MAX( EPS,
- $ ABS( WORK( INDRV4+BLKSIZ ) ) ) /
- $ DASUM( BLKSIZ, WORK( INDRV1+1 ), 1 )
- CALL DSCAL( BLKSIZ, SCL, WORK( INDRV1+1 ), 1 )
-*
-* Solve the system LU = Pb.
-*
- CALL DLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), WORK( INDRV2+2 ),
- $ WORK( INDRV3+1 ), WORK( INDRV5+1 ), IWORK,
- $ WORK( INDRV1+1 ), TOL, IINFO )
-*
-* Reorthogonalize by modified Gram-Schmidt if eigenvalues are
-* close enough.
-*
- IF( JBLK.EQ.1 )
- $ GO TO 90
- IF( ABS( XJ-XJM ).GT.ORTOL )
- $ GPIND = J
- IF( GPIND.NE.J ) THEN
- DO 80 I = GPIND, J - 1
- ZTR = -DDOT( BLKSIZ, WORK( INDRV1+1 ), 1, Z( B1, I ),
- $ 1 )
- CALL DAXPY( BLKSIZ, ZTR, Z( B1, I ), 1,
- $ WORK( INDRV1+1 ), 1 )
- 80 CONTINUE
- END IF
-*
-* Check the infinity norm of the iterate.
-*
- 90 CONTINUE
- JMAX = IDAMAX( BLKSIZ, WORK( INDRV1+1 ), 1 )
- NRM = ABS( WORK( INDRV1+JMAX ) )
-*
-* Continue for additional iterations after norm reaches
-* stopping criterion.
-*
- IF( NRM.LT.DTPCRT )
- $ GO TO 70
- NRMCHK = NRMCHK + 1
- IF( NRMCHK.LT.EXTRA+1 )
- $ GO TO 70
-*
- GO TO 110
-*
-* If stopping criterion was not satisfied, update info and
-* store eigenvector number in array ifail.
-*
- 100 CONTINUE
- INFO = INFO + 1
- IFAIL( INFO ) = J
-*
-* Accept iterate as jth eigenvector.
-*
- 110 CONTINUE
- SCL = ONE / DNRM2( BLKSIZ, WORK( INDRV1+1 ), 1 )
- JMAX = IDAMAX( BLKSIZ, WORK( INDRV1+1 ), 1 )
- IF( WORK( INDRV1+JMAX ).LT.ZERO )
- $ SCL = -SCL
- CALL DSCAL( BLKSIZ, SCL, WORK( INDRV1+1 ), 1 )
- 120 CONTINUE
- DO 130 I = 1, N
- Z( I, J ) = ZERO
- 130 CONTINUE
- DO 140 I = 1, BLKSIZ
- Z( B1+I-1, J ) = WORK( INDRV1+I )
- 140 CONTINUE
-*
-* Save the shift to check eigenvalue spacing at next
-* iteration.
-*
- XJM = XJ
-*
- 150 CONTINUE
- 160 CONTINUE
-*
- RETURN
-*
-* End of DSTEIN
-*
- END
diff --git a/netlib/LAPACK/dstemr.f b/netlib/LAPACK/dstemr.f
deleted file mode 100644
index 5930465..0000000
--- a/netlib/LAPACK/dstemr.f
+++ /dev/null
@@ -1,767 +0,0 @@
-*> \brief \b DSTEMR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEMR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstemr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstemr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstemr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
-* M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
-* IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* LOGICAL TRYRAC
-* INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
-* DOUBLE PRECISION VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
-* DOUBLE PRECISION Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEMR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has
-*> a well defined set of pairwise different real eigenvalues, the corresponding
-*> real eigenvectors are pairwise orthogonal.
-*>
-*> The spectrum may be computed either completely or partially by specifying
-*> either an interval (VL,VU] or a range of indices IL:IU for the desired
-*> eigenvalues.
-*>
-*> Depending on the number of desired eigenvalues, these are computed either
-*> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are
-*> computed by the use of various suitable L D L^T factorizations near clusters
-*> of close eigenvalues (referred to as RRRs, Relatively Robust
-*> Representations). An informal sketch of the algorithm follows.
-*>
-*> For each unreduced block (submatrix) of T,
-*> (a) Compute T - sigma I = L D L^T, so that L and D
-*> define all the wanted eigenvalues to high relative accuracy.
-*> This means that small relative changes in the entries of D and L
-*> cause only small relative changes in the eigenvalues and
-*> eigenvectors. The standard (unfactored) representation of the
-*> tridiagonal matrix T does not have this property in general.
-*> (b) Compute the eigenvalues to suitable accuracy.
-*> If the eigenvectors are desired, the algorithm attains full
-*> accuracy of the computed eigenvalues only right before
-*> the corresponding vectors have to be computed, see steps c) and d).
-*> (c) For each cluster of close eigenvalues, select a new
-*> shift close to the cluster, find a new factorization, and refine
-*> the shifted eigenvalues to suitable accuracy.
-*> (d) For each eigenvalue with a large enough relative separation compute
-*> the corresponding eigenvector by forming a rank revealing twisted
-*> factorization. Go back to (c) for any clusters that remain.
-*>
-*> For more details, see:
-*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
-*> to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
-*> Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
-*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
-*> Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
-*> 2004. Also LAPACK Working Note 154.
-*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
-*> tridiagonal eigenvalue/eigenvector problem",
-*> Computer Science Division Technical Report No. UCB/CSD-97-971,
-*> UC Berkeley, May 1997.
-*>
-*> Further Details
-*> 1.DSTEMR works only on machines which follow IEEE-754
-*> floating-point standard in their handling of infinities and NaNs.
-*> This permits the use of efficient inner loops avoiding a check for
-*> zero divisors.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal matrix
-*> T. On exit, D is overwritten.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, the (N-1) subdiagonal elements of the tridiagonal
-*> matrix T in elements 1 to N-1 of E. E(N) need not be set on
-*> input, but is used internally as workspace.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix T
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and can be computed with a workspace
-*> query by setting NZC = -1, see below.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] NZC
-*> \verbatim
-*> NZC is INTEGER
-*> The number of eigenvectors to be held in the array Z.
-*> If RANGE = 'A', then NZC >= max(1,N).
-*> If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,VU].
-*> If RANGE = 'I', then NZC >= IU-IL+1.
-*> If NZC = -1, then a workspace query is assumed; the
-*> routine calculates the number of columns of the array Z that
-*> are needed to hold the eigenvectors.
-*> This value is returned as the first entry of the Z array, and
-*> no error message related to NZC is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th computed eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ). This is relevant in the case when the matrix
-*> is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
-*> \endverbatim
-*>
-*> \param[in,out] TRYRAC
-*> \verbatim
-*> TRYRAC is LOGICAL
-*> If TRYRAC.EQ..TRUE., indicates that the code should check whether
-*> the tridiagonal matrix defines its eigenvalues to high relative
-*> accuracy. If so, the code uses relative-accuracy preserving
-*> algorithms that might be (a bit) slower depending on the matrix.
-*> If the matrix does not define its eigenvalues to high relative
-*> accuracy, the code can uses possibly faster algorithms.
-*> If TRYRAC.EQ..FALSE., the code is not required to guarantee
-*> relatively accurate eigenvalues and can use the fastest possible
-*> techniques.
-*> On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix
-*> does not define its eigenvalues to high relative accuracy.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal
-*> (and minimal) LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,18*N)
-*> if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (LIWORK)
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N)
-*> if the eigenvectors are desired, and LIWORK >= max(1,8*N)
-*> if only the eigenvalues are to be computed.
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = 1X, internal error in DLARRE,
-*> if INFO = 2X, internal error in DLARRV.
-*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
-*> the nonzero error code returned by DLARRE or
-*> DLARRV, respectively.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
- $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- LOGICAL TRYRAC
- INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
- DOUBLE PRECISION VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
- DOUBLE PRECISION Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, FOUR, MINRGP
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0,
- $ FOUR = 4.0D0,
- $ MINRGP = 1.0D-3 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
- INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
- $ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
- $ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
- $ ITMP2, J, JBLK, JJ, LIWMIN, LWMIN, NSPLIT,
- $ NZCMIN, OFFSET, WBEGIN, WEND
- DOUBLE PRECISION BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
- $ RTOL1, RTOL2, SAFMIN, SCALE, SMLNUM, SN,
- $ THRESH, TMP, TNRM, WL, WU
-* ..
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAE2, DLAEV2, DLARRC, DLARRE, DLARRJ,
- $ DLARRR, DLARRV, DLASRT, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-
-
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
- ZQUERY = ( NZC.EQ.-1 )
-
-* DSTEMR needs WORK of size 6*N, IWORK of size 3*N.
-* In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N.
-* Furthermore, DLARRV needs WORK of size 12*N, IWORK of size 7*N.
- IF( WANTZ ) THEN
- LWMIN = 18*N
- LIWMIN = 10*N
- ELSE
-* need less workspace if only the eigenvalues are wanted
- LWMIN = 12*N
- LIWMIN = 8*N
- ENDIF
-
- WL = ZERO
- WU = ZERO
- IIL = 0
- IIU = 0
-
- IF( VALEIG ) THEN
-* We do not reference VL, VU in the cases RANGE = 'I','A'
-* The interval (WL, WU] contains all the wanted eigenvalues.
-* It is either given by the user or computed in DLARRE.
- WL = VL
- WU = VU
- ELSEIF( INDEIG ) THEN
-* We do not reference IL, IU in the cases RANGE = 'V','A'
- IIL = IL
- IIU = IU
- ENDIF
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( VALEIG .AND. N.GT.0 .AND. WU.LE.WL ) THEN
- INFO = -7
- ELSE IF( INDEIG .AND. ( IIL.LT.1 .OR. IIL.GT.N ) ) THEN
- INFO = -8
- ELSE IF( INDEIG .AND. ( IIU.LT.IIL .OR. IIU.GT.N ) ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -13
- ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -17
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -19
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( WANTZ .AND. ALLEIG ) THEN
- NZCMIN = N
- ELSE IF( WANTZ .AND. VALEIG ) THEN
- CALL DLARRC( 'T', N, VL, VU, D, E, SAFMIN,
- $ NZCMIN, ITMP, ITMP2, INFO )
- ELSE IF( WANTZ .AND. INDEIG ) THEN
- NZCMIN = IIU-IIL+1
- ELSE
-* WANTZ .EQ. FALSE.
- NZCMIN = 0
- ENDIF
- IF( ZQUERY .AND. INFO.EQ.0 ) THEN
- Z( 1,1 ) = NZCMIN
- ELSE IF( NZC.LT.NZCMIN .AND. .NOT.ZQUERY ) THEN
- INFO = -14
- END IF
- END IF
-
- IF( INFO.NE.0 ) THEN
-*
- CALL XERBLA( 'DSTEMR', -INFO )
-*
- RETURN
- ELSE IF( LQUERY .OR. ZQUERY ) THEN
- RETURN
- END IF
-*
-* Handle N = 0, 1, and 2 cases immediately
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = D( 1 )
- ELSE
- IF( WL.LT.D( 1 ) .AND. WU.GE.D( 1 ) ) THEN
- M = 1
- W( 1 ) = D( 1 )
- END IF
- END IF
- IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- Z( 1, 1 ) = ONE
- ISUPPZ(1) = 1
- ISUPPZ(2) = 1
- END IF
- RETURN
- END IF
-*
- IF( N.EQ.2 ) THEN
- IF( .NOT.WANTZ ) THEN
- CALL DLAE2( D(1), E(1), D(2), R1, R2 )
- ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- CALL DLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
- END IF
- IF( ALLEIG.OR.
- $ (VALEIG.AND.(R2.GT.WL).AND.
- $ (R2.LE.WU)).OR.
- $ (INDEIG.AND.(IIL.EQ.1)) ) THEN
- M = M+1
- W( M ) = R2
- IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- Z( 1, M ) = -SN
- Z( 2, M ) = CS
-* Note: At most one of SN and CS can be zero.
- IF (SN.NE.ZERO) THEN
- IF (CS.NE.ZERO) THEN
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 2
- ELSE
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 1
- END IF
- ELSE
- ISUPPZ(2*M-1) = 2
- ISUPPZ(2*M) = 2
- END IF
- ENDIF
- ENDIF
- IF( ALLEIG.OR.
- $ (VALEIG.AND.(R1.GT.WL).AND.
- $ (R1.LE.WU)).OR.
- $ (INDEIG.AND.(IIU.EQ.2)) ) THEN
- M = M+1
- W( M ) = R1
- IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- Z( 1, M ) = CS
- Z( 2, M ) = SN
-* Note: At most one of SN and CS can be zero.
- IF (SN.NE.ZERO) THEN
- IF (CS.NE.ZERO) THEN
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 2
- ELSE
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 1
- END IF
- ELSE
- ISUPPZ(2*M-1) = 2
- ISUPPZ(2*M) = 2
- END IF
- ENDIF
- ENDIF
-
- ELSE
-
-* Continue with general N
-
- INDGRS = 1
- INDERR = 2*N + 1
- INDGP = 3*N + 1
- INDD = 4*N + 1
- INDE2 = 5*N + 1
- INDWRK = 6*N + 1
-*
- IINSPL = 1
- IINDBL = N + 1
- IINDW = 2*N + 1
- IINDWK = 3*N + 1
-*
-* Scale matrix to allowable range, if necessary.
-* The allowable range is related to the PIVMIN parameter; see the
-* comments in DLARRD. The preference for scaling small values
-* up is heuristic; we expect users' matrices not to be close to the
-* RMAX threshold.
-*
- SCALE = ONE
- TNRM = DLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- SCALE = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- SCALE = RMAX / TNRM
- END IF
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( N, SCALE, D, 1 )
- CALL DSCAL( N-1, SCALE, E, 1 )
- TNRM = TNRM*SCALE
- IF( VALEIG ) THEN
-* If eigenvalues in interval have to be found,
-* scale (WL, WU] accordingly
- WL = WL*SCALE
- WU = WU*SCALE
- ENDIF
- END IF
-*
-* Compute the desired eigenvalues of the tridiagonal after splitting
-* into smaller subblocks if the corresponding off-diagonal elements
-* are small
-* THRESH is the splitting parameter for DLARRE
-* A negative THRESH forces the old splitting criterion based on the
-* size of the off-diagonal. A positive THRESH switches to splitting
-* which preserves relative accuracy.
-*
- IF( TRYRAC ) THEN
-* Test whether the matrix warrants the more expensive relative approach.
- CALL DLARRR( N, D, E, IINFO )
- ELSE
-* The user does not care about relative accurately eigenvalues
- IINFO = -1
- ENDIF
-* Set the splitting criterion
- IF (IINFO.EQ.0) THEN
- THRESH = EPS
- ELSE
- THRESH = -EPS
-* relative accuracy is desired but T does not guarantee it
- TRYRAC = .FALSE.
- ENDIF
-*
- IF( TRYRAC ) THEN
-* Copy original diagonal, needed to guarantee relative accuracy
- CALL DCOPY(N,D,1,WORK(INDD),1)
- ENDIF
-* Store the squares of the offdiagonal values of T
- DO 5 J = 1, N-1
- WORK( INDE2+J-1 ) = E(J)**2
- 5 CONTINUE
-
-* Set the tolerance parameters for bisection
- IF( .NOT.WANTZ ) THEN
-* DLARRE computes the eigenvalues to full precision.
- RTOL1 = FOUR * EPS
- RTOL2 = FOUR * EPS
- ELSE
-* DLARRE computes the eigenvalues to less than full precision.
-* DLARRV will refine the eigenvalue approximations, and we can
-* need less accurate initial bisection in DLARRE.
-* Note: these settings do only affect the subset case and DLARRE
- RTOL1 = SQRT(EPS)
- RTOL2 = MAX( SQRT(EPS)*5.0D-3, FOUR * EPS )
- ENDIF
- CALL DLARRE( RANGE, N, WL, WU, IIL, IIU, D, E,
- $ WORK(INDE2), RTOL1, RTOL2, THRESH, NSPLIT,
- $ IWORK( IINSPL ), M, W, WORK( INDERR ),
- $ WORK( INDGP ), IWORK( IINDBL ),
- $ IWORK( IINDW ), WORK( INDGRS ), PIVMIN,
- $ WORK( INDWRK ), IWORK( IINDWK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 10 + ABS( IINFO )
- RETURN
- END IF
-* Note that if RANGE .NE. 'V', DLARRE computes bounds on the desired
-* part of the spectrum. All desired eigenvalues are contained in
-* (WL,WU]
-
-
- IF( WANTZ ) THEN
-*
-* Compute the desired eigenvectors corresponding to the computed
-* eigenvalues
-*
- CALL DLARRV( N, WL, WU, D, E,
- $ PIVMIN, IWORK( IINSPL ), M,
- $ 1, M, MINRGP, RTOL1, RTOL2,
- $ W, WORK( INDERR ), WORK( INDGP ), IWORK( IINDBL ),
- $ IWORK( IINDW ), WORK( INDGRS ), Z, LDZ,
- $ ISUPPZ, WORK( INDWRK ), IWORK( IINDWK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 20 + ABS( IINFO )
- RETURN
- END IF
- ELSE
-* DLARRE computes eigenvalues of the (shifted) root representation
-* DLARRV returns the eigenvalues of the unshifted matrix.
-* However, if the eigenvectors are not desired by the user, we need
-* to apply the corresponding shifts from DLARRE to obtain the
-* eigenvalues of the original matrix.
- DO 20 J = 1, M
- ITMP = IWORK( IINDBL+J-1 )
- W( J ) = W( J ) + E( IWORK( IINSPL+ITMP-1 ) )
- 20 CONTINUE
- END IF
-*
-
- IF ( TRYRAC ) THEN
-* Refine computed eigenvalues so that they are relatively accurate
-* with respect to the original matrix T.
- IBEGIN = 1
- WBEGIN = 1
- DO 39 JBLK = 1, IWORK( IINDBL+M-1 )
- IEND = IWORK( IINSPL+JBLK-1 )
- IN = IEND - IBEGIN + 1
- WEND = WBEGIN - 1
-* check if any eigenvalues have to be refined in this block
- 36 CONTINUE
- IF( WEND.LT.M ) THEN
- IF( IWORK( IINDBL+WEND ).EQ.JBLK ) THEN
- WEND = WEND + 1
- GO TO 36
- END IF
- END IF
- IF( WEND.LT.WBEGIN ) THEN
- IBEGIN = IEND + 1
- GO TO 39
- END IF
-
- OFFSET = IWORK(IINDW+WBEGIN-1)-1
- IFIRST = IWORK(IINDW+WBEGIN-1)
- ILAST = IWORK(IINDW+WEND-1)
- RTOL2 = FOUR * EPS
- CALL DLARRJ( IN,
- $ WORK(INDD+IBEGIN-1), WORK(INDE2+IBEGIN-1),
- $ IFIRST, ILAST, RTOL2, OFFSET, W(WBEGIN),
- $ WORK( INDERR+WBEGIN-1 ),
- $ WORK( INDWRK ), IWORK( IINDWK ), PIVMIN,
- $ TNRM, IINFO )
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- 39 CONTINUE
- ENDIF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( M, ONE / SCALE, W, 1 )
- END IF
-
- END IF
-
-*
-* If eigenvalues are not in increasing order, then sort them,
-* possibly along with eigenvectors.
-*
- IF( NSPLIT.GT.1 .OR. N.EQ.2 ) THEN
- IF( .NOT. WANTZ ) THEN
- CALL DLASRT( 'I', M, W, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- ELSE
- DO 60 J = 1, M - 1
- I = 0
- TMP = W( J )
- DO 50 JJ = J + 1, M
- IF( W( JJ ).LT.TMP ) THEN
- I = JJ
- TMP = W( JJ )
- END IF
- 50 CONTINUE
- IF( I.NE.0 ) THEN
- W( I ) = W( J )
- W( J ) = TMP
- IF( WANTZ ) THEN
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- ITMP = ISUPPZ( 2*I-1 )
- ISUPPZ( 2*I-1 ) = ISUPPZ( 2*J-1 )
- ISUPPZ( 2*J-1 ) = ITMP
- ITMP = ISUPPZ( 2*I )
- ISUPPZ( 2*I ) = ISUPPZ( 2*J )
- ISUPPZ( 2*J ) = ITMP
- END IF
- END IF
- 60 CONTINUE
- END IF
- ENDIF
-*
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of DSTEMR
-*
- END
diff --git a/netlib/LAPACK/dsteqr.f b/netlib/LAPACK/dsteqr.f
deleted file mode 100644
index 9e165bb..0000000
--- a/netlib/LAPACK/dsteqr.f
+++ /dev/null
@@ -1,572 +0,0 @@
-*> \brief \b DSTEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsteqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsteqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsteqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPZ
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEQR computes all eigenvalues and, optionally, eigenvectors of a
-*> symmetric tridiagonal matrix using the implicit QL or QR method.
-*> The eigenvectors of a full or band symmetric matrix can also be found
-*> if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to
-*> tridiagonal form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only.
-*> = 'V': Compute eigenvalues and eigenvectors of the original
-*> symmetric matrix. On entry, Z must contain the
-*> orthogonal matrix used to reduce the original matrix
-*> to tridiagonal form.
-*> = 'I': Compute eigenvalues and eigenvectors of the
-*> tridiagonal matrix. Z is initialized to the identity
-*> matrix.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the diagonal elements of the tridiagonal matrix.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', then Z contains the orthogonal
-*> matrix used in the reduction to tridiagonal form.
-*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
-*> orthonormal eigenvectors of the original symmetric matrix,
-*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors
-*> of the symmetric tridiagonal matrix.
-*> If COMPZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> eigenvectors are desired, then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
-*> If COMPZ = 'N', then WORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm has failed to find all the eigenvalues in
-*> a total of 30*N iterations; if INFO = i, then i
-*> elements of E have not converged to zero; on exit, D
-*> and E contain the elements of a symmetric tridiagonal
-*> matrix which is orthogonally similar to the original
-*> matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPZ
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, THREE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ THREE = 3.0D0 )
- INTEGER MAXIT
- PARAMETER ( MAXIT = 30 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
- $ LENDM1, LENDP1, LENDSV, LM1, LSV, M, MM, MM1,
- $ NM1, NMAXIT
- DOUBLE PRECISION ANORM, B, C, EPS, EPS2, F, G, P, R, RT1, RT2,
- $ S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANST, DLAPY2
- EXTERNAL LSAME, DLAMCH, DLANST, DLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASET, DLASR,
- $ DLASRT, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ICOMPZ = 0
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ICOMPZ = 2
- ELSE
- ICOMPZ = -1
- END IF
- IF( ICOMPZ.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
- $ N ) ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEQR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ICOMPZ.EQ.2 )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Determine the unit roundoff and over/underflow thresholds.
-*
- EPS = DLAMCH( 'E' )
- EPS2 = EPS**2
- SAFMIN = DLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- SSFMAX = SQRT( SAFMAX ) / THREE
- SSFMIN = SQRT( SAFMIN ) / EPS2
-*
-* Compute the eigenvalues and eigenvectors of the tridiagonal
-* matrix.
-*
- IF( ICOMPZ.EQ.2 )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
- NMAXIT = N*MAXIT
- JTOT = 0
-*
-* Determine where the matrix splits and choose QL or QR iteration
-* for each block, according to whether top or bottom diagonal
-* element is smaller.
-*
- L1 = 1
- NM1 = N - 1
-*
- 10 CONTINUE
- IF( L1.GT.N )
- $ GO TO 160
- IF( L1.GT.1 )
- $ E( L1-1 ) = ZERO
- IF( L1.LE.NM1 ) THEN
- DO 20 M = L1, NM1
- TST = ABS( E( M ) )
- IF( TST.EQ.ZERO )
- $ GO TO 30
- IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
- $ 1 ) ) ) )*EPS ) THEN
- E( M ) = ZERO
- GO TO 30
- END IF
- 20 CONTINUE
- END IF
- M = N
-*
- 30 CONTINUE
- L = L1
- LSV = L
- LEND = M
- LENDSV = LEND
- L1 = M + 1
- IF( LEND.EQ.L )
- $ GO TO 10
-*
-* Scale submatrix in rows and columns L to LEND
-*
- ANORM = DLANST( 'M', LEND-L+1, D( L ), E( L ) )
- ISCALE = 0
- IF( ANORM.EQ.ZERO )
- $ GO TO 10
- IF( ANORM.GT.SSFMAX ) THEN
- ISCALE = 1
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
- $ INFO )
- ELSE IF( ANORM.LT.SSFMIN ) THEN
- ISCALE = 2
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
- $ INFO )
- END IF
-*
-* Choose between QL and QR iteration
-*
- IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
- LEND = LSV
- L = LENDSV
- END IF
-*
- IF( LEND.GT.L ) THEN
-*
-* QL Iteration
-*
-* Look for small subdiagonal element.
-*
- 40 CONTINUE
- IF( L.NE.LEND ) THEN
- LENDM1 = LEND - 1
- DO 50 M = L, LENDM1
- TST = ABS( E( M ) )**2
- IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M+1 ) )+
- $ SAFMIN )GO TO 60
- 50 CONTINUE
- END IF
-*
- M = LEND
-*
- 60 CONTINUE
- IF( M.LT.LEND )
- $ E( M ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 80
-*
-* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
-* to compute its eigensystem.
-*
- IF( M.EQ.L+1 ) THEN
- IF( ICOMPZ.GT.0 ) THEN
- CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S )
- WORK( L ) = C
- WORK( N-1+L ) = S
- CALL DLASR( 'R', 'V', 'B', N, 2, WORK( L ),
- $ WORK( N-1+L ), Z( 1, L ), LDZ )
- ELSE
- CALL DLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
- END IF
- D( L ) = RT1
- D( L+1 ) = RT2
- E( L ) = ZERO
- L = L + 2
- IF( L.LE.LEND )
- $ GO TO 40
- GO TO 140
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 140
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- G = ( D( L+1 )-P ) / ( TWO*E( L ) )
- R = DLAPY2( G, ONE )
- G = D( M ) - P + ( E( L ) / ( G+SIGN( R, G ) ) )
-*
- S = ONE
- C = ONE
- P = ZERO
-*
-* Inner loop
-*
- MM1 = M - 1
- DO 70 I = MM1, L, -1
- F = S*E( I )
- B = C*E( I )
- CALL DLARTG( G, F, C, S, R )
- IF( I.NE.M-1 )
- $ E( I+1 ) = R
- G = D( I+1 ) - P
- R = ( D( I )-G )*S + TWO*C*B
- P = S*R
- D( I+1 ) = G + P
- G = C*R - B
-*
-* If eigenvectors are desired, then save rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- WORK( I ) = C
- WORK( N-1+I ) = -S
- END IF
-*
- 70 CONTINUE
-*
-* If eigenvectors are desired, then apply saved rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- MM = M - L + 1
- CALL DLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ),
- $ Z( 1, L ), LDZ )
- END IF
-*
- D( L ) = D( L ) - P
- E( L ) = G
- GO TO 40
-*
-* Eigenvalue found.
-*
- 80 CONTINUE
- D( L ) = P
-*
- L = L + 1
- IF( L.LE.LEND )
- $ GO TO 40
- GO TO 140
-*
- ELSE
-*
-* QR Iteration
-*
-* Look for small superdiagonal element.
-*
- 90 CONTINUE
- IF( L.NE.LEND ) THEN
- LENDP1 = LEND + 1
- DO 100 M = L, LENDP1, -1
- TST = ABS( E( M-1 ) )**2
- IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M-1 ) )+
- $ SAFMIN )GO TO 110
- 100 CONTINUE
- END IF
-*
- M = LEND
-*
- 110 CONTINUE
- IF( M.GT.LEND )
- $ E( M-1 ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 130
-*
-* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
-* to compute its eigensystem.
-*
- IF( M.EQ.L-1 ) THEN
- IF( ICOMPZ.GT.0 ) THEN
- CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S )
- WORK( M ) = C
- WORK( N-1+M ) = S
- CALL DLASR( 'R', 'V', 'F', N, 2, WORK( M ),
- $ WORK( N-1+M ), Z( 1, L-1 ), LDZ )
- ELSE
- CALL DLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
- END IF
- D( L-1 ) = RT1
- D( L ) = RT2
- E( L-1 ) = ZERO
- L = L - 2
- IF( L.GE.LEND )
- $ GO TO 90
- GO TO 140
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 140
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- G = ( D( L-1 )-P ) / ( TWO*E( L-1 ) )
- R = DLAPY2( G, ONE )
- G = D( M ) - P + ( E( L-1 ) / ( G+SIGN( R, G ) ) )
-*
- S = ONE
- C = ONE
- P = ZERO
-*
-* Inner loop
-*
- LM1 = L - 1
- DO 120 I = M, LM1
- F = S*E( I )
- B = C*E( I )
- CALL DLARTG( G, F, C, S, R )
- IF( I.NE.M )
- $ E( I-1 ) = R
- G = D( I ) - P
- R = ( D( I+1 )-G )*S + TWO*C*B
- P = S*R
- D( I ) = G + P
- G = C*R - B
-*
-* If eigenvectors are desired, then save rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- WORK( I ) = C
- WORK( N-1+I ) = S
- END IF
-*
- 120 CONTINUE
-*
-* If eigenvectors are desired, then apply saved rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- MM = L - M + 1
- CALL DLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ),
- $ Z( 1, M ), LDZ )
- END IF
-*
- D( L ) = D( L ) - P
- E( LM1 ) = G
- GO TO 90
-*
-* Eigenvalue found.
-*
- 130 CONTINUE
- D( L ) = P
-*
- L = L - 1
- IF( L.GE.LEND )
- $ GO TO 90
- GO TO 140
-*
- END IF
-*
-* Undo scaling if necessary
-*
- 140 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
- CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ),
- $ N, INFO )
- ELSE IF( ISCALE.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
- CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ),
- $ N, INFO )
- END IF
-*
-* Check for no convergence to an eigenvalue after a total
-* of N*MAXIT iterations.
-*
- IF( JTOT.LT.NMAXIT )
- $ GO TO 10
- DO 150 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 150 CONTINUE
- GO TO 190
-*
-* Order eigenvalues and eigenvectors.
-*
- 160 CONTINUE
- IF( ICOMPZ.EQ.0 ) THEN
-*
-* Use Quick Sort
-*
- CALL DLASRT( 'I', N, D, INFO )
-*
- ELSE
-*
-* Use Selection Sort to minimize swaps of eigenvectors
-*
- DO 180 II = 2, N
- I = II - 1
- K = I
- P = D( I )
- DO 170 J = II, N
- IF( D( J ).LT.P ) THEN
- K = J
- P = D( J )
- END IF
- 170 CONTINUE
- IF( K.NE.I ) THEN
- D( K ) = D( I )
- D( I ) = P
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
- END IF
- 180 CONTINUE
- END IF
-*
- 190 CONTINUE
- RETURN
-*
-* End of DSTEQR
-*
- END
diff --git a/netlib/LAPACK/dsterf.f b/netlib/LAPACK/dsterf.f
deleted file mode 100644
index b93cc13..0000000
--- a/netlib/LAPACK/dsterf.f
+++ /dev/null
@@ -1,426 +0,0 @@
-*> \brief \b DSTERF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTERF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsterf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsterf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsterf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTERF( N, D, E, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
-*> using the Pal-Walker-Kahan variant of the QL or QR algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm failed to find all of the eigenvalues in
-*> a total of 30*N iterations; if INFO = i, then i
-*> elements of E have not converged to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DSTERF( N, D, E, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO, THREE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
- $ THREE = 3.0D0 )
- INTEGER MAXIT
- PARAMETER ( MAXIT = 30 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ISCALE, JTOT, L, L1, LEND, LENDSV, LSV, M,
- $ NMAXIT
- DOUBLE PRECISION ALPHA, ANORM, BB, C, EPS, EPS2, GAMMA, OLDC,
- $ OLDGAM, P, R, RT1, RT2, RTE, S, SAFMAX, SAFMIN,
- $ SIGMA, SSFMAX, SSFMIN, RMAX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLANST, DLAPY2
- EXTERNAL DLAMCH, DLANST, DLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAE2, DLASCL, DLASRT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DSTERF', -INFO )
- RETURN
- END IF
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the unit roundoff for this environment.
-*
- EPS = DLAMCH( 'E' )
- EPS2 = EPS**2
- SAFMIN = DLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- SSFMAX = SQRT( SAFMAX ) / THREE
- SSFMIN = SQRT( SAFMIN ) / EPS2
- RMAX = DLAMCH( 'O' )
-*
-* Compute the eigenvalues of the tridiagonal matrix.
-*
- NMAXIT = N*MAXIT
- SIGMA = ZERO
- JTOT = 0
-*
-* Determine where the matrix splits and choose QL or QR iteration
-* for each block, according to whether top or bottom diagonal
-* element is smaller.
-*
- L1 = 1
-*
- 10 CONTINUE
- IF( L1.GT.N )
- $ GO TO 170
- IF( L1.GT.1 )
- $ E( L1-1 ) = ZERO
- DO 20 M = L1, N - 1
- IF( ABS( E( M ) ).LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
- $ 1 ) ) ) )*EPS ) THEN
- E( M ) = ZERO
- GO TO 30
- END IF
- 20 CONTINUE
- M = N
-*
- 30 CONTINUE
- L = L1
- LSV = L
- LEND = M
- LENDSV = LEND
- L1 = M + 1
- IF( LEND.EQ.L )
- $ GO TO 10
-*
-* Scale submatrix in rows and columns L to LEND
-*
- ANORM = DLANST( 'M', LEND-L+1, D( L ), E( L ) )
- ISCALE = 0
- IF( ANORM.EQ.ZERO )
- $ GO TO 10
- IF( (ANORM.GT.SSFMAX) ) THEN
- ISCALE = 1
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
- $ INFO )
- ELSE IF( ANORM.LT.SSFMIN ) THEN
- ISCALE = 2
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
- $ INFO )
- END IF
-*
- DO 40 I = L, LEND - 1
- E( I ) = E( I )**2
- 40 CONTINUE
-*
-* Choose between QL and QR iteration
-*
- IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
- LEND = LSV
- L = LENDSV
- END IF
-*
- IF( LEND.GE.L ) THEN
-*
-* QL Iteration
-*
-* Look for small subdiagonal element.
-*
- 50 CONTINUE
- IF( L.NE.LEND ) THEN
- DO 60 M = L, LEND - 1
- IF( ABS( E( M ) ).LE.EPS2*ABS( D( M )*D( M+1 ) ) )
- $ GO TO 70
- 60 CONTINUE
- END IF
- M = LEND
-*
- 70 CONTINUE
- IF( M.LT.LEND )
- $ E( M ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 90
-*
-* If remaining matrix is 2 by 2, use DLAE2 to compute its
-* eigenvalues.
-*
- IF( M.EQ.L+1 ) THEN
- RTE = SQRT( E( L ) )
- CALL DLAE2( D( L ), RTE, D( L+1 ), RT1, RT2 )
- D( L ) = RT1
- D( L+1 ) = RT2
- E( L ) = ZERO
- L = L + 2
- IF( L.LE.LEND )
- $ GO TO 50
- GO TO 150
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 150
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- RTE = SQRT( E( L ) )
- SIGMA = ( D( L+1 )-P ) / ( TWO*RTE )
- R = DLAPY2( SIGMA, ONE )
- SIGMA = P - ( RTE / ( SIGMA+SIGN( R, SIGMA ) ) )
-*
- C = ONE
- S = ZERO
- GAMMA = D( M ) - SIGMA
- P = GAMMA*GAMMA
-*
-* Inner loop
-*
- DO 80 I = M - 1, L, -1
- BB = E( I )
- R = P + BB
- IF( I.NE.M-1 )
- $ E( I+1 ) = S*R
- OLDC = C
- C = P / R
- S = BB / R
- OLDGAM = GAMMA
- ALPHA = D( I )
- GAMMA = C*( ALPHA-SIGMA ) - S*OLDGAM
- D( I+1 ) = OLDGAM + ( ALPHA-GAMMA )
- IF( C.NE.ZERO ) THEN
- P = ( GAMMA*GAMMA ) / C
- ELSE
- P = OLDC*BB
- END IF
- 80 CONTINUE
-*
- E( L ) = S*P
- D( L ) = SIGMA + GAMMA
- GO TO 50
-*
-* Eigenvalue found.
-*
- 90 CONTINUE
- D( L ) = P
-*
- L = L + 1
- IF( L.LE.LEND )
- $ GO TO 50
- GO TO 150
-*
- ELSE
-*
-* QR Iteration
-*
-* Look for small superdiagonal element.
-*
- 100 CONTINUE
- DO 110 M = L, LEND + 1, -1
- IF( ABS( E( M-1 ) ).LE.EPS2*ABS( D( M )*D( M-1 ) ) )
- $ GO TO 120
- 110 CONTINUE
- M = LEND
-*
- 120 CONTINUE
- IF( M.GT.LEND )
- $ E( M-1 ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 140
-*
-* If remaining matrix is 2 by 2, use DLAE2 to compute its
-* eigenvalues.
-*
- IF( M.EQ.L-1 ) THEN
- RTE = SQRT( E( L-1 ) )
- CALL DLAE2( D( L ), RTE, D( L-1 ), RT1, RT2 )
- D( L ) = RT1
- D( L-1 ) = RT2
- E( L-1 ) = ZERO
- L = L - 2
- IF( L.GE.LEND )
- $ GO TO 100
- GO TO 150
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 150
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- RTE = SQRT( E( L-1 ) )
- SIGMA = ( D( L-1 )-P ) / ( TWO*RTE )
- R = DLAPY2( SIGMA, ONE )
- SIGMA = P - ( RTE / ( SIGMA+SIGN( R, SIGMA ) ) )
-*
- C = ONE
- S = ZERO
- GAMMA = D( M ) - SIGMA
- P = GAMMA*GAMMA
-*
-* Inner loop
-*
- DO 130 I = M, L - 1
- BB = E( I )
- R = P + BB
- IF( I.NE.M )
- $ E( I-1 ) = S*R
- OLDC = C
- C = P / R
- S = BB / R
- OLDGAM = GAMMA
- ALPHA = D( I+1 )
- GAMMA = C*( ALPHA-SIGMA ) - S*OLDGAM
- D( I ) = OLDGAM + ( ALPHA-GAMMA )
- IF( C.NE.ZERO ) THEN
- P = ( GAMMA*GAMMA ) / C
- ELSE
- P = OLDC*BB
- END IF
- 130 CONTINUE
-*
- E( L-1 ) = S*P
- D( L ) = SIGMA + GAMMA
- GO TO 100
-*
-* Eigenvalue found.
-*
- 140 CONTINUE
- D( L ) = P
-*
- L = L - 1
- IF( L.GE.LEND )
- $ GO TO 100
- GO TO 150
-*
- END IF
-*
-* Undo scaling if necessary
-*
- 150 CONTINUE
- IF( ISCALE.EQ.1 )
- $ CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
- IF( ISCALE.EQ.2 )
- $ CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
-*
-* Check for no convergence to an eigenvalue after a total
-* of N*MAXIT iterations.
-*
- IF( JTOT.LT.NMAXIT )
- $ GO TO 10
- DO 160 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 160 CONTINUE
- GO TO 180
-*
-* Sort eigenvalues in increasing order.
-*
- 170 CONTINUE
- CALL DLASRT( 'I', N, D, INFO )
-*
- 180 CONTINUE
- RETURN
-*
-* End of DSTERF
-*
- END
diff --git a/netlib/LAPACK/dstev.f b/netlib/LAPACK/dstev.f
deleted file mode 100644
index aeca438..0000000
--- a/netlib/LAPACK/dstev.f
+++ /dev/null
@@ -1,235 +0,0 @@
-*> \brief <b> DSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEV computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric tridiagonal matrix A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A, stored in elements 1 to N-1 of E.
-*> On exit, the contents of E are destroyed.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with D(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
-*> If JOBZ = 'N', WORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of E did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTZ
- INTEGER IMAX, ISCALE
- DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TNRM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSTEQR, DSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -6
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- TNRM = DLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( N, SIGMA, D, 1 )
- CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
- END IF
-*
-* For eigenvalues only, call DSTERF. For eigenvalues and
-* eigenvectors, call DSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, D, E, INFO )
- ELSE
- CALL DSTEQR( 'I', N, D, E, Z, LDZ, WORK, INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, D, 1 )
- END IF
-*
- RETURN
-*
-* End of DSTEV
-*
- END
diff --git a/netlib/LAPACK/dstevd.f b/netlib/LAPACK/dstevd.f
deleted file mode 100644
index 42648a0..0000000
--- a/netlib/LAPACK/dstevd.f
+++ /dev/null
@@ -1,302 +0,0 @@
-*> \brief <b> DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ
-* INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEVD computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric tridiagonal matrix. If eigenvectors are desired, it
-*> uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A, stored in elements 1 to N-1 of E.
-*> On exit, the contents of E are destroyed.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with D(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1 then LWORK must be at least
-*> ( 1 + 4*N + N**2 ).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of E did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ
- INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTZ
- INTEGER ISCALE, LIWMIN, LWMIN
- DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TNRM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSTEDC, DSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- LIWMIN = 1
- LWMIN = 1
- IF( N.GT.1 .AND. WANTZ ) THEN
- LWMIN = 1 + 4*N + N**2
- LIWMIN = 3 + 5*N
- END IF
-*
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -6
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -8
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- TNRM = DLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( N, SIGMA, D, 1 )
- CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
- END IF
-*
-* For eigenvalues only, call DSTERF. For eigenvalues and
-* eigenvectors, call DSTEDC.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, D, E, INFO )
- ELSE
- CALL DSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK,
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL DSCAL( N, ONE / SIGMA, D, 1 )
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DSTEVD
-*
- END
diff --git a/netlib/LAPACK/dstevr.f b/netlib/LAPACK/dstevr.f
deleted file mode 100644
index 076ab92..0000000
--- a/netlib/LAPACK/dstevr.f
+++ /dev/null
@@ -1,575 +0,0 @@
-*> \brief <b> DSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEVR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstevr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstevr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstevr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
-* M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEVR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix T. Eigenvalues and
-*> eigenvectors can be selected by specifying either a range of values
-*> or a range of indices for the desired eigenvalues.
-*>
-*> Whenever possible, DSTEVR calls DSTEMR to compute the
-*> eigenspectrum using Relatively Robust Representations. DSTEMR
-*> computes eigenvalues by the dqds algorithm, while orthogonal
-*> eigenvectors are computed from various "good" L D L^T representations
-*> (also known as Relatively Robust Representations). Gram-Schmidt
-*> orthogonalization is avoided as far as possible. More specifically,
-*> the various steps of the algorithm are as follows. For the i-th
-*> unreduced block of T,
-*> (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T
-*> is a relatively robust representation,
-*> (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high
-*> relative accuracy by the dqds algorithm,
-*> (c) If there is a cluster of close eigenvalues, "choose" sigma_i
-*> close to the cluster, and go to step (a),
-*> (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T,
-*> compute the corresponding eigenvector by forming a
-*> rank-revealing twisted factorization.
-*> The desired accuracy of the output can be specified by the input
-*> parameter ABSTOL.
-*>
-*> For more details, see "A new O(n^2) algorithm for the symmetric
-*> tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon,
-*> Computer Science Division Technical Report No. UCB//CSD-97-971,
-*> UC Berkeley, May 1997.
-*>
-*>
-*> Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested
-*> on machines which conform to the ieee-754 floating point standard.
-*> DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and
-*> when partial spectrum requests are made.
-*>
-*> Normal execution of DSTEMR may create NaNs and infinities and
-*> hence may abort due to a floating point exception in environments
-*> which do not handle NaNs and infinities in the ieee standard default
-*> manner.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
-*> DSTEIN are called
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, D may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (max(1,N-1))
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A in elements 1 to N-1 of E.
-*> On exit, E may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*>
-*> If high relative accuracy is important, set ABSTOL to
-*> DLAMCH( 'Safe minimum' ). Doing so will guarantee that
-*> eigenvalues are computed to high relative accuracy when
-*> possible in future releases. The current code does not
-*> make any guarantees about high relative accuracy, but
-*> future releases will. See J. Barlow and J. Demmel,
-*> "Computing Accurate Eigensystems of Scaled Diagonally
-*> Dominant Matrices", LAPACK Working Note #7, for a discussion
-*> of which matrices define their eigenvalues to high relative
-*> accuracy.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ).
-*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal (and
-*> minimal) LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,20*N).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal (and
-*> minimal) LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: Internal error
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Inderjit Dhillon, IBM Almaden, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Ken Stanley, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*>
-* =====================================================================
- SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
- $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, LQUERY, VALEIG, WANTZ,
- $ TRYRAC
- CHARACTER ORDER
- INTEGER I, IEEEOK, IMAX, INDIBL, INDIFL, INDISP,
- $ INDIWO, ISCALE, ITMP1, J, JJ, LIWMIN, LWMIN,
- $ NSPLIT
- DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TMP1, TNRM, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTEMR, DSTEIN, DSTERF,
- $ DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-*
-* Test the input parameters.
-*
- IEEEOK = ILAENV( 10, 'DSTEVR', 'N', 1, 2, 3, 4 )
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
- LWMIN = MAX( 1, 20*N )
- LIWMIN = MAX( 1, 10*N )
-*
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -7
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -9
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -14
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -17
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -19
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEVR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = D( 1 )
- ELSE
- IF( VL.LT.D( 1 ) .AND. VU.GE.D( 1 ) ) THEN
- M = 1
- W( 1 ) = D( 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- VLL = VL
- VUU = VU
-*
- TNRM = DLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( N, SIGMA, D, 1 )
- CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-
-* Initialize indices into workspaces. Note: These indices are used only
-* if DSTERF or DSTEMR fail.
-
-* IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in DSTEBZ and
-* stores the block indices of each of the M<=N eigenvalues.
- INDIBL = 1
-* IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in DSTEBZ and
-* stores the starting and finishing indices of each block.
- INDISP = INDIBL + N
-* IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
-* that corresponding to eigenvectors that fail to converge in
-* DSTEIN. This information is discarded; if any fail, the driver
-* returns INFO > 0.
- INDIFL = INDISP + N
-* INDIWO is the offset of the remaining integer workspace.
- INDIWO = INDISP + N
-*
-* If all eigenvalues are desired, then
-* call DSTERF or DSTEMR. If this fails for some eigenvalue, then
-* try DSTEBZ.
-*
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. IEEEOK.EQ.1 ) THEN
- CALL DCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 )
- IF( .NOT.WANTZ ) THEN
- CALL DCOPY( N, D, 1, W, 1 )
- CALL DSTERF( N, W, WORK, INFO )
- ELSE
- CALL DCOPY( N, D, 1, WORK( N+1 ), 1 )
- IF (ABSTOL .LE. TWO*N*EPS) THEN
- TRYRAC = .TRUE.
- ELSE
- TRYRAC = .FALSE.
- END IF
- CALL DSTEMR( JOBZ, 'A', N, WORK( N+1 ), WORK, VL, VU, IL,
- $ IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC,
- $ WORK( 2*N+1 ), LWORK-2*N, IWORK, LIWORK, INFO )
-*
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 10
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
-
- CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
- $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), WORK,
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ),
- $ Z, LDZ, WORK, IWORK( INDIWO ), IWORK( INDIFL ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 10 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 30 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 20 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 20 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( I )
- W( I ) = W( J )
- IWORK( I ) = IWORK( J )
- W( J ) = TMP1
- IWORK( J ) = ITMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- END IF
- 30 CONTINUE
- END IF
-*
-* Causes problems with tests 19 & 20:
-* IF (wantz .and. INDEIG ) Z( 1,1) = Z(1,1) / 1.002 + .002
-*
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of DSTEVR
-*
- END
diff --git a/netlib/LAPACK/dstevx.f b/netlib/LAPACK/dstevx.f
deleted file mode 100644
index cda9de1..0000000
--- a/netlib/LAPACK/dstevx.f
+++ /dev/null
@@ -1,457 +0,0 @@
-*> \brief <b> DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSTEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
-* M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* INTEGER IL, INFO, IU, LDZ, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSTEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix A. Eigenvalues and
-*> eigenvectors can be selected by specifying either a range of values
-*> or a range of indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, D may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (max(1,N-1))
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A in elements 1 to N-1 of E.
-*> On exit, E may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less
-*> than or equal to zero, then EPS*|T| will be used in
-*> its place, where |T| is the 1-norm of the tridiagonal
-*> matrix.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge (INFO > 0), then that
-*> column of Z contains the latest approximation to the
-*> eigenvector, and the index of the eigenvector is returned
-*> in IFAIL. If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHEReigen
-*
-* =====================================================================
- SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
- $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- INTEGER IL, INFO, IU, LDZ, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
- CHARACTER ORDER
- INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK,
- $ ISCALE, ITMP1, J, JJ, NSPLIT
- DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TMP1, TNRM, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANST
- EXTERNAL LSAME, DLAMCH, DLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTEIN, DSTEQR, DSTERF,
- $ DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -7
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -9
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
- $ INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSTEVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = D( 1 )
- ELSE
- IF( VL.LT.D( 1 ) .AND. VU.GE.D( 1 ) ) THEN
- M = 1
- W( 1 ) = D( 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- IF( VALEIG ) THEN
- VLL = VL
- VUU = VU
- ELSE
- VLL = ZERO
- VUU = ZERO
- END IF
- TNRM = DLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL DSCAL( N, SIGMA, D, 1 )
- CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* If all eigenvalues are desired and ABSTOL is less than zero, then
-* call DSTERF or SSTEQR. If this fails for some eigenvalue, then
-* try DSTEBZ.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
- CALL DCOPY( N, D, 1, W, 1 )
- CALL DCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 )
- INDWRK = N + 1
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK, INFO )
- ELSE
- CALL DSTEQR( 'I', N, W, WORK, Z, LDZ, WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 20
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDWRK = 1
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
- $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ),
- $ WORK( INDWRK ), IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ),
- $ Z, LDZ, WORK( INDWRK ), IWORK( INDIWO ), IFAIL,
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 20 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 40 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 30 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 30 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSTEVX
-*
- END
diff --git a/netlib/LAPACK/dsycon.f b/netlib/LAPACK/dsycon.f
deleted file mode 100644
index 6e39484..0000000
--- a/netlib/LAPACK/dsycon.f
+++ /dev/null
@@ -1,244 +0,0 @@
-*> \brief \b DSYCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsycon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsycon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsycon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYCON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric matrix A using the factorization
-*> A = U*D*U**T or A = L*D*L**T computed by DSYTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> The 1-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYCON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, KASE
- DOUBLE PRECISION AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DSYTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.LE.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- DO 10 I = N, 1, -1
- IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- DO 20 I = 1, N
- IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
- $ RETURN
- 20 CONTINUE
- END IF
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- 30 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
-*
-* Multiply by inv(L*D*L**T) or inv(U*D*U**T).
-*
- CALL DSYTRS( UPLO, N, 1, A, LDA, IPIV, WORK, N, INFO )
- GO TO 30
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of DSYCON
-*
- END
diff --git a/netlib/LAPACK/dsyconv.f b/netlib/LAPACK/dsyconv.f
deleted file mode 100644
index cc45a35..0000000
--- a/netlib/LAPACK/dsyconv.f
+++ /dev/null
@@ -1,362 +0,0 @@
-*> \brief \b DSYCONV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYCONV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO, WAY
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYCONV convert A given by TRF into L and D and vice-versa.
-*> Get Non-diag elements of D (returned in workspace) and
-*> apply or reverse permutation done in TRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] WAY
-*> \verbatim
-*> WAY is CHARACTER*1
-*> = 'C': Convert
-*> = 'R': Revert
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO, WAY
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-*
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* .. Local Scalars ..
- LOGICAL UPPER, CONVERT
- INTEGER I, IP, J
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- CONVERT = LSAME( WAY, 'C' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
-
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYCONV', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* A is UPPER
-*
-* Convert A (A is upper)
-*
-* Convert VALUE
-*
- IF ( CONVERT ) THEN
- I=N
- WORK(1)=ZERO
- DO WHILE ( I .GT. 1 )
- IF( IPIV(I) .LT. 0 ) THEN
- WORK(I)=A(I-1,I)
- A(I-1,I)=ZERO
- I=I-1
- ELSE
- WORK(I)=ZERO
- ENDIF
- I=I-1
- END DO
-*
-* Convert PERMUTATIONS
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0) THEN
- IP=IPIV(I)
- IF( I .LT. N) THEN
- DO 12 J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I,J)
- A(I,J)=TEMP
- 12 CONTINUE
- ENDIF
- ELSE
- IP=-IPIV(I)
- IF( I .LT. N) THEN
- DO 13 J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I-1,J)
- A(I-1,J)=TEMP
- 13 CONTINUE
- ENDIF
- I=I-1
- ENDIF
- I=I-1
- END DO
-
- ELSE
-*
-* Revert A (A is upper)
-*
-*
-* Revert PERMUTATIONS
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF( I .LT. N) THEN
- DO J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I,J)
- A(I,J)=TEMP
- END DO
- ENDIF
- ELSE
- IP=-IPIV(I)
- I=I+1
- IF( I .LT. N) THEN
- DO J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I-1,J)
- A(I-1,J)=TEMP
- END DO
- ENDIF
- ENDIF
- I=I+1
- END DO
-*
-* Revert VALUE
-*
- I=N
- DO WHILE ( I .GT. 1 )
- IF( IPIV(I) .LT. 0 ) THEN
- A(I-1,I)=WORK(I)
- I=I-1
- ENDIF
- I=I-1
- END DO
- END IF
- ELSE
-*
-* A is LOWER
-*
- IF ( CONVERT ) THEN
-*
-* Convert A (A is lower)
-*
-*
-* Convert VALUE
-*
- I=1
- WORK(N)=ZERO
- DO WHILE ( I .LE. N )
- IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
- WORK(I)=A(I+1,I)
- A(I+1,I)=ZERO
- I=I+1
- ELSE
- WORK(I)=ZERO
- ENDIF
- I=I+1
- END DO
-*
-* Convert PERMUTATIONS
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .GT. 1) THEN
- DO 22 J= 1,I-1
- TEMP=A(IP,J)
- A(IP,J)=A(I,J)
- A(I,J)=TEMP
- 22 CONTINUE
- ENDIF
- ELSE
- IP=-IPIV(I)
- IF (I .GT. 1) THEN
- DO 23 J= 1,I-1
- TEMP=A(IP,J)
- A(IP,J)=A(I+1,J)
- A(I+1,J)=TEMP
- 23 CONTINUE
- ENDIF
- I=I+1
- ENDIF
- I=I+1
- END DO
- ELSE
-*
-* Revert A (A is lower)
-*
-*
-* Revert PERMUTATIONS
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .GT. 1) THEN
- DO J= 1,I-1
- TEMP=A(I,J)
- A(I,J)=A(IP,J)
- A(IP,J)=TEMP
- END DO
- ENDIF
- ELSE
- IP=-IPIV(I)
- I=I-1
- IF (I .GT. 1) THEN
- DO J= 1,I-1
- TEMP=A(I+1,J)
- A(I+1,J)=A(IP,J)
- A(IP,J)=TEMP
- END DO
- ENDIF
- ENDIF
- I=I-1
- END DO
-*
-* Revert VALUE
-*
- I=1
- DO WHILE ( I .LE. N-1 )
- IF( IPIV(I) .LT. ZERO ) THEN
- A(I+1,I)=WORK(I)
- I=I+1
- ENDIF
- I=I+1
- END DO
- END IF
- END IF
-
- RETURN
-*
-* End of DSYCONV
-*
- END
diff --git a/netlib/LAPACK/dsyequb.f b/netlib/LAPACK/dsyequb.f
deleted file mode 100644
index 865acef..0000000
--- a/netlib/LAPACK/dsyequb.f
+++ /dev/null
@@ -1,342 +0,0 @@
-*> \brief \b DSYEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION AMAX, SCOND
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), S( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYEQUB computes row and column scalings intended to equilibrate a
-*> symmetric matrix A and reduce its condition number
-*> (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The N-by-N symmetric matrix whose scaling
-*> factors are to be computed. Only the diagonal elements of A
-*> are referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is DOUBLE PRECISION
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par References:
-* ================
-*>
-*> Livne, O.E. and Golub, G.H., "Scaling by Binormalization", \n
-*> Numerical Algorithms, vol. 35, no. 1, pp. 97-120, January 2004. \n
-*> DOI 10.1023/B:NUMA.0000016606.32820.69 \n
-*> Tech report version: http://ruready.utah.edu/archive/papers/bin.pdf
-*>
-* =====================================================================
- SUBROUTINE DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
- DOUBLE PRECISION AMAX, SCOND
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), S( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
- INTEGER MAX_ITER
- PARAMETER ( MAX_ITER = 100 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, ITER
- DOUBLE PRECISION AVG, STD, TOL, C0, C1, C2, T, U, SI, D, BASE,
- $ SMIN, SMAX, SMLNUM, BIGNUM, SCALE, SUMSQ
- LOGICAL UP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- LOGICAL LSAME
- EXTERNAL DLAMCH, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test input parameters.
-*
- INFO = 0
- IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -1
- ELSE IF ( N .LT. 0 ) THEN
- INFO = -2
- ELSE IF ( LDA .LT. MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF ( INFO .NE. 0 ) THEN
- CALL XERBLA( 'DSYEQUB', -INFO )
- RETURN
- END IF
-
- UP = LSAME( UPLO, 'U' )
- AMAX = ZERO
-*
-* Quick return if possible.
-*
- IF ( N .EQ. 0 ) THEN
- SCOND = ONE
- RETURN
- END IF
-
- DO I = 1, N
- S( I ) = ZERO
- END DO
-
- AMAX = ZERO
- IF ( UP ) THEN
- DO J = 1, N
- DO I = 1, J-1
- S( I ) = MAX( S( I ), ABS( A( I, J ) ) )
- S( J ) = MAX( S( J ), ABS( A( I, J ) ) )
- AMAX = MAX( AMAX, ABS( A(I, J) ) )
- END DO
- S( J ) = MAX( S( J ), ABS( A( J, J ) ) )
- AMAX = MAX( AMAX, ABS( A( J, J ) ) )
- END DO
- ELSE
- DO J = 1, N
- S( J ) = MAX( S( J ), ABS( A( J, J ) ) )
- AMAX = MAX( AMAX, ABS( A( J, J ) ) )
- DO I = J+1, N
- S( I ) = MAX( S( I ), ABS( A( I, J ) ) )
- S( J ) = MAX( S( J ), ABS( A( I, J ) ) )
- AMAX = MAX( AMAX, ABS( A( I, J ) ) )
- END DO
- END DO
- END IF
- DO J = 1, N
- S( J ) = 1.0D+0 / S( J )
- END DO
-
- TOL = ONE / SQRT(2.0D0 * N)
-
- DO ITER = 1, MAX_ITER
- SCALE = 0.0D+0
- SUMSQ = 0.0D+0
-* BETA = |A|S
- DO I = 1, N
- WORK(I) = ZERO
- END DO
- IF ( UP ) THEN
- DO J = 1, N
- DO I = 1, J-1
- T = ABS( A( I, J ) )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) ) * S( J )
- WORK( J ) = WORK( J ) + ABS( A( I, J ) ) * S( I )
- END DO
- WORK( J ) = WORK( J ) + ABS( A( J, J ) ) * S( J )
- END DO
- ELSE
- DO J = 1, N
- WORK( J ) = WORK( J ) + ABS( A( J, J ) ) * S( J )
- DO I = J+1, N
- T = ABS( A( I, J ) )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) ) * S( J )
- WORK( J ) = WORK( J ) + ABS( A( I, J ) ) * S( I )
- END DO
- END DO
- END IF
-
-* avg = s^T beta / n
- AVG = 0.0D+0
- DO I = 1, N
- AVG = AVG + S( I )*WORK( I )
- END DO
- AVG = AVG / N
-
- STD = 0.0D+0
- DO I = 2*N+1, 3*N
- WORK( I ) = S( I-2*N ) * WORK( I-2*N ) - AVG
- END DO
- CALL DLASSQ( N, WORK( 2*N+1 ), 1, SCALE, SUMSQ )
- STD = SCALE * SQRT( SUMSQ / N )
-
- IF ( STD .LT. TOL * AVG ) GOTO 999
-
- DO I = 1, N
- T = ABS( A( I, I ) )
- SI = S( I )
- C2 = ( N-1 ) * T
- C1 = ( N-2 ) * ( WORK( I ) - T*SI )
- C0 = -(T*SI)*SI + 2*WORK( I )*SI - N*AVG
- D = C1*C1 - 4*C0*C2
-
- IF ( D .LE. 0 ) THEN
- INFO = -1
- RETURN
- END IF
- SI = -2*C0 / ( C1 + SQRT( D ) )
-
- D = SI - S( I )
- U = ZERO
- IF ( UP ) THEN
- DO J = 1, I
- T = ABS( A( J, I ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- DO J = I+1,N
- T = ABS( A( I, J ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- ELSE
- DO J = 1, I
- T = ABS( A( I, J ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- DO J = I+1,N
- T = ABS( A( J, I ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- END IF
-
- AVG = AVG + ( U + WORK( I ) ) * D / N
- S( I ) = SI
-
- END DO
-
- END DO
-
- 999 CONTINUE
-
- SMLNUM = DLAMCH( 'SAFEMIN' )
- BIGNUM = ONE / SMLNUM
- SMIN = BIGNUM
- SMAX = ZERO
- T = ONE / SQRT(AVG)
- BASE = DLAMCH( 'B' )
- U = ONE / LOG( BASE )
- DO I = 1, N
- S( I ) = BASE ** INT( U * LOG( S( I ) * T ) )
- SMIN = MIN( SMIN, S( I ) )
- SMAX = MAX( SMAX, S( I ) )
- END DO
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
-*
- END
diff --git a/netlib/LAPACK/dsyev.f b/netlib/LAPACK/dsyev.f
deleted file mode 100644
index 64b39ed..0000000
--- a/netlib/LAPACK/dsyev.f
+++ /dev/null
@@ -1,286 +0,0 @@
-*> \brief <b> DSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYEV computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric matrix A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> orthonormal eigenvectors of the matrix A.
-*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
-*> or the upper triangle (if UPLO='U') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,3*N-1).
-*> For optimal efficiency, LWORK >= (NB+2)*N,
-*> where NB is the blocksize for DSYTRD returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYeigen
-*
-* =====================================================================
- SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, LQUERY, WANTZ
- INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
- $ LLWORK, LWKOPT, NB
- DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF, DSYTRD,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( 1, ( NB+2 )*N )
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY )
- $ INFO = -8
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = A( 1, 1 )
- WORK( 1 ) = 2
- IF( WANTZ )
- $ A( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 )
- $ CALL DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
-*
-* Call DSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- INDWRK = INDTAU + N
- LLWORK = LWORK - INDWRK + 1
- CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
- $ WORK( INDWRK ), LLWORK, IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, first call
-* DORGTR to generate the orthogonal matrix, then call DSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
- $ LLWORK, IINFO )
- CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DSYEV
-*
- END
diff --git a/netlib/LAPACK/dsyevd.f b/netlib/LAPACK/dsyevd.f
deleted file mode 100644
index 3c9545a..0000000
--- a/netlib/LAPACK/dsyevd.f
+++ /dev/null
@@ -1,357 +0,0 @@
-*> \brief <b> DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDA, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYEVD computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric matrix A. If eigenvectors are desired, it uses a
-*> divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*>
-*> Because of large use of BLAS of level 3, DSYEVD needs N**2 more
-*> workspace than DSYEVX.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> orthonormal eigenvectors of the matrix A.
-*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
-*> or the upper triangle (if UPLO='U') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK must be at least 1.
-*> If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
-*> If JOBZ = 'V' and N > 1, LWORK must be at least
-*> 1 + 6*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If N <= 1, LIWORK must be at least 1.
-*> If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i and JOBZ = 'N', then the algorithm failed
-*> to converge; i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> if INFO = i and JOBZ = 'V', then the algorithm failed
-*> to compute an eigenvalue while working on the submatrix
-*> lying in rows and columns INFO/(N+1) through
-*> mod(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYeigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee \n
-*> Modified description of INFO. Sven, 16 Feb 05. \n
-
-
-*>
-* =====================================================================
- SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDA, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
-*
- LOGICAL LOWER, LQUERY, WANTZ
- INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
- $ LIOPT, LIWMIN, LLWORK, LLWRK2, LOPT, LWMIN
- DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF,
- $ DSYTRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- LOPT = LWMIN
- LIOPT = LIWMIN
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N + 1
- END IF
- LOPT = MAX( LWMIN, 2*N +
- $ ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
- LIOPT = LIWMIN
- END IF
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -8
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = A( 1, 1 )
- IF( WANTZ )
- $ A( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 )
- $ CALL DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
-*
-* Call DSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- INDWRK = INDTAU + N
- LLWORK = LWORK - INDWRK + 1
- INDWK2 = INDWRK + N*N
- LLWRK2 = LWORK - INDWK2 + 1
-*
- CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
- $ WORK( INDWRK ), LLWORK, IINFO )
-*
-* For eigenvalues only, call DSTERF. For eigenvectors, first call
-* DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
-* tridiagonal matrix, then call DORMTR to multiply it by the
-* Householder transformations stored in A.
-*
- IF( .NOT.WANTZ ) THEN
- CALL DSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
- $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
- CALL DORMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
- $ WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
- CALL DLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL DSCAL( N, ONE / SIGMA, W, 1 )
-*
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- RETURN
-*
-* End of DSYEVD
-*
- END
diff --git a/netlib/LAPACK/dsyevr.f b/netlib/LAPACK/dsyevr.f
deleted file mode 100644
index 08f3636..0000000
--- a/netlib/LAPACK/dsyevr.f
+++ /dev/null
@@ -1,672 +0,0 @@
-*> \brief <b> DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYEVR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
-* IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYEVR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be
-*> selected by specifying either a range of values or a range of
-*> indices for the desired eigenvalues.
-*>
-*> DSYEVR first reduces the matrix A to tridiagonal form T with a call
-*> to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute
-*> the eigenspectrum using Relatively Robust Representations. DSTEMR
-*> computes eigenvalues by the dqds algorithm, while orthogonal
-*> eigenvectors are computed from various "good" L D L^T representations
-*> (also known as Relatively Robust Representations). Gram-Schmidt
-*> orthogonalization is avoided as far as possible. More specifically,
-*> the various steps of the algorithm are as follows.
-*>
-*> For each unreduced block (submatrix) of T,
-*> (a) Compute T - sigma I = L D L^T, so that L and D
-*> define all the wanted eigenvalues to high relative accuracy.
-*> This means that small relative changes in the entries of D and L
-*> cause only small relative changes in the eigenvalues and
-*> eigenvectors. The standard (unfactored) representation of the
-*> tridiagonal matrix T does not have this property in general.
-*> (b) Compute the eigenvalues to suitable accuracy.
-*> If the eigenvectors are desired, the algorithm attains full
-*> accuracy of the computed eigenvalues only right before
-*> the corresponding vectors have to be computed, see steps c) and d).
-*> (c) For each cluster of close eigenvalues, select a new
-*> shift close to the cluster, find a new factorization, and refine
-*> the shifted eigenvalues to suitable accuracy.
-*> (d) For each eigenvalue with a large enough relative separation compute
-*> the corresponding eigenvector by forming a rank revealing twisted
-*> factorization. Go back to (c) for any clusters that remain.
-*>
-*> The desired accuracy of the output can be specified by the input
-*> parameter ABSTOL.
-*>
-*> For more details, see DSTEMR's documentation and:
-*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
-*> to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
-*> Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
-*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
-*> Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
-*> 2004. Also LAPACK Working Note 154.
-*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
-*> tridiagonal eigenvalue/eigenvector problem",
-*> Computer Science Division Technical Report No. UCB/CSD-97-971,
-*> UC Berkeley, May 1997.
-*>
-*>
-*> Note 1 : DSYEVR calls DSTEMR when the full spectrum is requested
-*> on machines which conform to the ieee-754 floating point standard.
-*> DSYEVR calls DSTEBZ and SSTEIN on non-ieee machines and
-*> when partial spectrum requests are made.
-*>
-*> Normal execution of DSTEMR may create NaNs and infinities and
-*> hence may abort due to a floating point exception in environments
-*> which do not handle NaNs and infinities in the ieee standard default
-*> manner.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
-*> DSTEIN are called
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, the lower triangle (if UPLO='L') or the upper
-*> triangle (if UPLO='U') of A, including the diagonal, is
-*> destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*>
-*> If high relative accuracy is important, set ABSTOL to
-*> DLAMCH( 'Safe minimum' ). Doing so will guarantee that
-*> eigenvalues are computed to high relative accuracy when
-*> possible in future releases. The current code does not
-*> make any guarantees about high relative accuracy, but
-*> future releases will. See J. Barlow and J. Demmel,
-*> "Computing Accurate Eigensystems of Scaled Diagonally
-*> Dominant Matrices", LAPACK Working Note #7, for a discussion
-*> of which matrices define their eigenvalues to high relative
-*> accuracy.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> Supplying N columns is always safe.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ).
-*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,26*N).
-*> For optimal efficiency, LWORK >= (NB+6)*N,
-*> where NB is the max of the blocksize for DSYTRD and DORMTR
-*> returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: Internal error
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYeigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Inderjit Dhillon, IBM Almaden, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Ken Stanley, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Jason Riedy, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*>
-* =====================================================================
- SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
- $ TRYRAC
- CHARACTER ORDER
- INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
- $ INDEE, INDIBL, INDIFL, INDISP, INDIWO, INDTAU,
- $ INDWK, INDWKN, ISCALE, J, JJ, LIWMIN,
- $ LLWORK, LLWRKN, LWKOPT, LWMIN, NB, NSPLIT
- DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, DSTEIN,
- $ DSTERF, DSWAP, DSYTRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- IEEEOK = ILAENV( 10, 'DSYEVR', 'N', 1, 2, 3, 4 )
-*
- LOWER = LSAME( UPLO, 'L' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
-*
- LWMIN = MAX( 1, 26*N )
- LIWMIN = MAX( 1, 10*N )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -8
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -10
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -15
- ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -18
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
- NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
- LWKOPT = MAX( ( NB+1 )*N, LWMIN )
- WORK( 1 ) = LWKOPT
- IWORK( 1 ) = LIWMIN
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYEVR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = 7
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- ELSE
- IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- END IF
- END IF
- IF( WANTZ ) THEN
- Z( 1, 1 ) = ONE
- ISUPPZ( 1 ) = 1
- ISUPPZ( 2 ) = 1
- END IF
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF (VALEIG) THEN
- VLL = VL
- VUU = VU
- END IF
- ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- DO 10 J = 1, N
- CALL DSCAL( N-J+1, SIGMA, A( J, J ), 1 )
- 10 CONTINUE
- ELSE
- DO 20 J = 1, N
- CALL DSCAL( J, SIGMA, A( 1, J ), 1 )
- 20 CONTINUE
- END IF
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-
-* Initialize indices into workspaces. Note: The IWORK indices are
-* used only if DSTERF or DSTEMR fail.
-
-* WORK(INDTAU:INDTAU+N-1) stores the scalar factors of the
-* elementary reflectors used in DSYTRD.
- INDTAU = 1
-* WORK(INDD:INDD+N-1) stores the tridiagonal's diagonal entries.
- INDD = INDTAU + N
-* WORK(INDE:INDE+N-1) stores the off-diagonal entries of the
-* tridiagonal matrix from DSYTRD.
- INDE = INDD + N
-* WORK(INDDD:INDDD+N-1) is a copy of the diagonal entries over
-* -written by DSTEMR (the DSTERF path copies the diagonal to W).
- INDDD = INDE + N
-* WORK(INDEE:INDEE+N-1) is a copy of the off-diagonal entries over
-* -written while computing the eigenvalues in DSTERF and DSTEMR.
- INDEE = INDDD + N
-* INDWK is the starting offset of the left-over workspace, and
-* LLWORK is the remaining workspace size.
- INDWK = INDEE + N
- LLWORK = LWORK - INDWK + 1
-
-* IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in DSTEBZ and
-* stores the block indices of each of the M<=N eigenvalues.
- INDIBL = 1
-* IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in DSTEBZ and
-* stores the starting and finishing indices of each block.
- INDISP = INDIBL + N
-* IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
-* that corresponding to eigenvectors that fail to converge in
-* DSTEIN. This information is discarded; if any fail, the driver
-* returns INFO > 0.
- INDIFL = INDISP + N
-* INDIWO is the offset of the remaining integer workspace.
- INDIWO = INDIFL + N
-
-*
-* Call DSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- CALL DSYTRD( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ),
- $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO )
-*
-* If all eigenvalues are desired
-* then call DSTERF or DSTEMR and DORMTR.
-*
- IF( ( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) .AND.
- $ IEEEOK.EQ.1 ) THEN
- IF( .NOT.WANTZ ) THEN
- CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 )
-*
- IF (ABSTOL .LE. TWO*N*EPS) THEN
- TRYRAC = .TRUE.
- ELSE
- TRYRAC = .FALSE.
- END IF
- CALL DSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ),
- $ VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ,
- $ TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK,
- $ INFO )
-*
-*
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by DSTEIN.
-*
- IF( WANTZ .AND. INFO.EQ.0 ) THEN
- INDWKN = INDE
- LLWRKN = LWORK - INDWKN + 1
- CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA,
- $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
- $ LLWRKN, IINFO )
- END IF
- END IF
-*
-*
- IF( INFO.EQ.0 ) THEN
-* Everything worked. Skip DSTEBZ/DSTEIN. IWORK(:) are
-* undefined.
- M = N
- GO TO 30
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN.
-* Also call DSTEBZ and DSTEIN if DSTEMR fails.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
-
- CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWK ), IWORK( INDIWO ), IWORK( INDIFL ),
- $ INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by DSTEIN.
-*
- INDWKN = INDE
- LLWRKN = LWORK - INDWKN + 1
- CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
- $ LDZ, WORK( INDWKN ), LLWRKN, IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
-* Jump here if DSTEMR/DSTEIN succeeded.
- 30 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors. Note: We do not sort the IFAIL portion of IWORK.
-* It may not be initialized (if DSTEMR/DSTEIN succeeded), and we do
-* not return this detailed information to the user.
-*
- IF( WANTZ ) THEN
- DO 50 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 40 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 40 CONTINUE
-*
- IF( I.NE.0 ) THEN
- W( I ) = W( J )
- W( J ) = TMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- END IF
- 50 CONTINUE
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DSYEVR
-*
- END
diff --git a/netlib/LAPACK/dsyevx.f b/netlib/LAPACK/dsyevx.f
deleted file mode 100644
index cb990e5..0000000
--- a/netlib/LAPACK/dsyevx.f
+++ /dev/null
@@ -1,547 +0,0 @@
-*> \brief <b> DSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK,
-* IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be
-*> selected by specifying either a range of values or a range of indices
-*> for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, the lower triangle (if UPLO='L') or the upper
-*> triangle (if UPLO='U') of A, including the diagonal, is
-*> destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On normal exit, the first M elements contain the selected
-*> eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= 1, when N <= 1;
-*> otherwise 8*N.
-*> For optimal efficiency, LWORK >= (NB+3)*N,
-*> where NB is the max of the blocksize for DSYTRD and DORMTR
-*> returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYeigen
-*
-* =====================================================================
- SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK,
- $ IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
- $ WANTZ
- CHARACTER ORDER
- INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
- $ INDISP, INDIWO, INDTAU, INDWKN, INDWRK, ISCALE,
- $ ITMP1, J, JJ, LLWORK, LLWRKN, LWKMIN,
- $ LWKOPT, NB, NSPLIT
- DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, DSTEBZ,
- $ DSTEIN, DSTEQR, DSTERF, DSWAP, DSYTRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- LOWER = LSAME( UPLO, 'L' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -8
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -10
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -15
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LWKMIN = 1
- WORK( 1 ) = LWKMIN
- ELSE
- LWKMIN = 8*N
- NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
- NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
- LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
- $ INFO = -17
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYEVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 ) THEN
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- ELSE
- IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- EPS = DLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF( VALEIG ) THEN
- VLL = VL
- VUU = VU
- END IF
- ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- DO 10 J = 1, N
- CALL DSCAL( N-J+1, SIGMA, A( J, J ), 1 )
- 10 CONTINUE
- ELSE
- DO 20 J = 1, N
- CALL DSCAL( J, SIGMA, A( 1, J ), 1 )
- 20 CONTINUE
- END IF
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* Call DSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- INDTAU = 1
- INDE = INDTAU + N
- INDD = INDE + N
- INDWRK = INDD + N
- LLWORK = LWORK - INDWRK + 1
- CALL DSYTRD( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ),
- $ WORK( INDTAU ), WORK( INDWRK ), LLWORK, IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal to
-* zero, then call DSTERF or DORGTR and SSTEQR. If this fails for
-* some eigenvalue, then try DSTEBZ.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
- CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- IF( .NOT.WANTZ ) THEN
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL DLACPY( 'A', N, N, A, LDA, Z, LDZ )
- CALL DORGTR( UPLO, N, Z, LDZ, WORK( INDTAU ),
- $ WORK( INDWRK ), LLWORK, IINFO )
- CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL DSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 30 I = 1, N
- IFAIL( I ) = 0
- 30 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 40
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call DSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by DSTEIN.
-*
- INDWKN = INDE
- LLWRKN = LWORK - INDWKN + 1
- CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
- $ LDZ, WORK( INDWKN ), LLWRKN, IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 40 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 60 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 50 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 50 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 60 CONTINUE
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DSYEVX
-*
- END
diff --git a/netlib/LAPACK/dsygs2.f b/netlib/LAPACK/dsygs2.f
deleted file mode 100644
index 644dcff..0000000
--- a/netlib/LAPACK/dsygs2.f
+++ /dev/null
@@ -1,283 +0,0 @@
-*> \brief \b DSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorization results obtained from spotrf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYGS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygs2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygs2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygs2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYGS2 reduces a real symmetric-definite generalized eigenproblem
-*> to standard form.
-*>
-*> If ITYPE = 1, the problem is A*x = lambda*B*x,
-*> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*>
-*> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*> B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T *A*L.
-*>
-*> B must have been previously factorized as U**T *U or L*L**T by DPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*> = 2 or 3: compute U*A*U**T or L**T *A*L.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored, and how B has been factorized.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the transformed matrix, stored in the
-*> same format as A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> The triangular factor from the Cholesky factorization of B,
-*> as returned by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, HALF
- PARAMETER ( ONE = 1.0D0, HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER K
- DOUBLE PRECISION AKK, BKK, CT
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DSYR2, DTRMV, DTRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYGS2', -INFO )
- RETURN
- END IF
-*
- IF( ITYPE.EQ.1 ) THEN
- IF( UPPER ) THEN
-*
-* Compute inv(U**T)*A*inv(U)
-*
- DO 10 K = 1, N
-*
-* Update the upper triangle of A(k:n,k:n)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- AKK = AKK / BKK**2
- A( K, K ) = AKK
- IF( K.LT.N ) THEN
- CALL DSCAL( N-K, ONE / BKK, A( K, K+1 ), LDA )
- CT = -HALF*AKK
- CALL DAXPY( N-K, CT, B( K, K+1 ), LDB, A( K, K+1 ),
- $ LDA )
- CALL DSYR2( UPLO, N-K, -ONE, A( K, K+1 ), LDA,
- $ B( K, K+1 ), LDB, A( K+1, K+1 ), LDA )
- CALL DAXPY( N-K, CT, B( K, K+1 ), LDB, A( K, K+1 ),
- $ LDA )
- CALL DTRSV( UPLO, 'Transpose', 'Non-unit', N-K,
- $ B( K+1, K+1 ), LDB, A( K, K+1 ), LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute inv(L)*A*inv(L**T)
-*
- DO 20 K = 1, N
-*
-* Update the lower triangle of A(k:n,k:n)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- AKK = AKK / BKK**2
- A( K, K ) = AKK
- IF( K.LT.N ) THEN
- CALL DSCAL( N-K, ONE / BKK, A( K+1, K ), 1 )
- CT = -HALF*AKK
- CALL DAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 )
- CALL DSYR2( UPLO, N-K, -ONE, A( K+1, K ), 1,
- $ B( K+1, K ), 1, A( K+1, K+1 ), LDA )
- CALL DAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 )
- CALL DTRSV( UPLO, 'No transpose', 'Non-unit', N-K,
- $ B( K+1, K+1 ), LDB, A( K+1, K ), 1 )
- END IF
- 20 CONTINUE
- END IF
- ELSE
- IF( UPPER ) THEN
-*
-* Compute U*A*U**T
-*
- DO 30 K = 1, N
-*
-* Update the upper triangle of A(1:k,1:k)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- CALL DTRMV( UPLO, 'No transpose', 'Non-unit', K-1, B,
- $ LDB, A( 1, K ), 1 )
- CT = HALF*AKK
- CALL DAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 )
- CALL DSYR2( UPLO, K-1, ONE, A( 1, K ), 1, B( 1, K ), 1,
- $ A, LDA )
- CALL DAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 )
- CALL DSCAL( K-1, BKK, A( 1, K ), 1 )
- A( K, K ) = AKK*BKK**2
- 30 CONTINUE
- ELSE
-*
-* Compute L**T *A*L
-*
- DO 40 K = 1, N
-*
-* Update the lower triangle of A(1:k,1:k)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- CALL DTRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, LDB,
- $ A( K, 1 ), LDA )
- CT = HALF*AKK
- CALL DAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA )
- CALL DSYR2( UPLO, K-1, ONE, A( K, 1 ), LDA, B( K, 1 ),
- $ LDB, A, LDA )
- CALL DAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA )
- CALL DSCAL( K-1, BKK, A( K, 1 ), LDA )
- A( K, K ) = AKK*BKK**2
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DSYGS2
-*
- END
diff --git a/netlib/LAPACK/dsygst.f b/netlib/LAPACK/dsygst.f
deleted file mode 100644
index f1d5311..0000000
--- a/netlib/LAPACK/dsygst.f
+++ /dev/null
@@ -1,321 +0,0 @@
-*> \brief \b DSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYGST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYGST reduces a real symmetric-definite generalized eigenproblem
-*> to standard form.
-*>
-*> If ITYPE = 1, the problem is A*x = lambda*B*x,
-*> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*>
-*> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*> B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
-*>
-*> B must have been previously factorized as U**T*U or L*L**T by DPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*> = 2 or 3: compute U*A*U**T or L**T*A*L.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored and B is factored as
-*> U**T*U;
-*> = 'L': Lower triangle of A is stored and B is factored as
-*> L*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the transformed matrix, stored in the
-*> same format as A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> The triangular factor from the Cholesky factorization of B,
-*> as returned by DPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, HALF
- PARAMETER ( ONE = 1.0D0, HALF = 0.5D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER K, KB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL DSYGS2, DSYMM, DSYR2K, DTRMM, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYGST', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DSYGST', UPLO, N, -1, -1, -1 )
-*
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ITYPE.EQ.1 ) THEN
- IF( UPPER ) THEN
-*
-* Compute inv(U**T)*A*inv(U)
-*
- DO 10 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the upper triangle of A(k:n,k:n)
-*
- CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- IF( K+KB.LE.N ) THEN
- CALL DTRSM( 'Left', UPLO, 'Transpose', 'Non-unit',
- $ KB, N-K-KB+1, ONE, B( K, K ), LDB,
- $ A( K, K+KB ), LDA )
- CALL DSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
- $ A( K, K ), LDA, B( K, K+KB ), LDB, ONE,
- $ A( K, K+KB ), LDA )
- CALL DSYR2K( UPLO, 'Transpose', N-K-KB+1, KB, -ONE,
- $ A( K, K+KB ), LDA, B( K, K+KB ), LDB,
- $ ONE, A( K+KB, K+KB ), LDA )
- CALL DSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
- $ A( K, K ), LDA, B( K, K+KB ), LDB, ONE,
- $ A( K, K+KB ), LDA )
- CALL DTRSM( 'Right', UPLO, 'No transpose',
- $ 'Non-unit', KB, N-K-KB+1, ONE,
- $ B( K+KB, K+KB ), LDB, A( K, K+KB ),
- $ LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute inv(L)*A*inv(L**T)
-*
- DO 20 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the lower triangle of A(k:n,k:n)
-*
- CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- IF( K+KB.LE.N ) THEN
- CALL DTRSM( 'Right', UPLO, 'Transpose', 'Non-unit',
- $ N-K-KB+1, KB, ONE, B( K, K ), LDB,
- $ A( K+KB, K ), LDA )
- CALL DSYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
- $ A( K, K ), LDA, B( K+KB, K ), LDB, ONE,
- $ A( K+KB, K ), LDA )
- CALL DSYR2K( UPLO, 'No transpose', N-K-KB+1, KB,
- $ -ONE, A( K+KB, K ), LDA, B( K+KB, K ),
- $ LDB, ONE, A( K+KB, K+KB ), LDA )
- CALL DSYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
- $ A( K, K ), LDA, B( K+KB, K ), LDB, ONE,
- $ A( K+KB, K ), LDA )
- CALL DTRSM( 'Left', UPLO, 'No transpose',
- $ 'Non-unit', N-K-KB+1, KB, ONE,
- $ B( K+KB, K+KB ), LDB, A( K+KB, K ),
- $ LDA )
- END IF
- 20 CONTINUE
- END IF
- ELSE
- IF( UPPER ) THEN
-*
-* Compute U*A*U**T
-*
- DO 30 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the upper triangle of A(1:k+kb-1,1:k+kb-1)
-*
- CALL DTRMM( 'Left', UPLO, 'No transpose', 'Non-unit',
- $ K-1, KB, ONE, B, LDB, A( 1, K ), LDA )
- CALL DSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
- $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA )
- CALL DSYR2K( UPLO, 'No transpose', K-1, KB, ONE,
- $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A,
- $ LDA )
- CALL DSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
- $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA )
- CALL DTRMM( 'Right', UPLO, 'Transpose', 'Non-unit',
- $ K-1, KB, ONE, B( K, K ), LDB, A( 1, K ),
- $ LDA )
- CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- 30 CONTINUE
- ELSE
-*
-* Compute L**T*A*L
-*
- DO 40 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the lower triangle of A(1:k+kb-1,1:k+kb-1)
-*
- CALL DTRMM( 'Right', UPLO, 'No transpose', 'Non-unit',
- $ KB, K-1, ONE, B, LDB, A( K, 1 ), LDA )
- CALL DSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
- $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA )
- CALL DSYR2K( UPLO, 'Transpose', K-1, KB, ONE,
- $ A( K, 1 ), LDA, B( K, 1 ), LDB, ONE, A,
- $ LDA )
- CALL DSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
- $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA )
- CALL DTRMM( 'Left', UPLO, 'Transpose', 'Non-unit', KB,
- $ K-1, ONE, B( K, K ), LDB, A( K, 1 ), LDA )
- CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- 40 CONTINUE
- END IF
- END IF
- END IF
- RETURN
-*
-* End of DSYGST
-*
- END
diff --git a/netlib/LAPACK/dsygv.f b/netlib/LAPACK/dsygv.f
deleted file mode 100644
index e556318..0000000
--- a/netlib/LAPACK/dsygv.f
+++ /dev/null
@@ -1,314 +0,0 @@
-*> \brief \b DSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYGV computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
-*> Here A and B are assumed to be symmetric and B is also
-*> positive definite.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*>
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> matrix Z of eigenvectors. The eigenvectors are normalized
-*> as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
-*> or the lower triangle (if UPLO='L') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the symmetric positive definite matrix B.
-*> If UPLO = 'U', the leading N-by-N upper triangular part of B
-*> contains the upper triangular part of the matrix B.
-*> If UPLO = 'L', the leading N-by-N lower triangular part of B
-*> contains the lower triangular part of the matrix B.
-*>
-*> On exit, if INFO <= N, the part of B containing the matrix is
-*> overwritten by the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,3*N-1).
-*> For optimal efficiency, LWORK >= (NB+2)*N,
-*> where NB is the blocksize for DSYTRD returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: DPOTRF or DSYEV returned an error code:
-*> <= N: if INFO = i, DSYEV failed to converge;
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYeigen
-*
-* =====================================================================
- SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER TRANS
- INTEGER LWKMIN, LWKOPT, NB, NEIG
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DPOTRF, DSYEV, DSYGST, DTRMM, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- LWKMIN = MAX( 1, 3*N - 1 )
- NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( LWKMIN, ( NB + 2 )*N )
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYGV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL DPOTRF( UPLO, N, B, LDB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- CALL DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- NEIG = N
- IF( INFO.GT.0 )
- $ NEIG = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
- $ B, LDB, A, LDA )
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
- $ B, LDB, A, LDA )
- END IF
- END IF
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DSYGV
-*
- END
diff --git a/netlib/LAPACK/dsygvd.f b/netlib/LAPACK/dsygvd.f
deleted file mode 100644
index 171aa17..0000000
--- a/netlib/LAPACK/dsygvd.f
+++ /dev/null
@@ -1,380 +0,0 @@
-*> \brief \b DSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYGVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
-* LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYGVD computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
-*> B are assumed to be symmetric and B is also positive definite.
-*> If eigenvectors are desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*>
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> matrix Z of eigenvectors. The eigenvectors are normalized
-*> as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
-*> or the lower triangle (if UPLO='L') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the symmetric matrix B. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of B contains the
-*> upper triangular part of the matrix B. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of B contains
-*> the lower triangular part of the matrix B.
-*>
-*> On exit, if INFO <= N, the part of B containing the matrix is
-*> overwritten by the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LWORK >= 2*N+1.
-*> If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If N <= 1, LIWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LIWORK >= 1.
-*> If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: DPOTRF or DSYEVD returned an error code:
-*> <= N: if INFO = i and JOBZ = 'N', then the algorithm
-*> failed to converge; i off-diagonal elements of an
-*> intermediate tridiagonal form did not converge to
-*> zero;
-*> if INFO = i and JOBZ = 'V', then the algorithm
-*> failed to compute an eigenvalue while working on
-*> the submatrix lying in rows and columns INFO/(N+1)
-*> through mod(INFO,N+1);
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified so that no backsubstitution is performed if DSYEVD fails to
-*> converge (NEIG in old code could be greater than N causing out of
-*> bounds reference to A - reported by Ralf Meyer). Also corrected the
-*> description of INFO and the test on ITYPE. Sven, 16 Feb 05.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*>
-* =====================================================================
- SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
- $ LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER TRANS
- INTEGER LIOPT, LIWMIN, LOPT, LWMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DPOTRF, DSYEVD, DSYGST, DTRMM, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N + 1
- END IF
- LOPT = LWMIN
- LIOPT = LIWMIN
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYGVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL DPOTRF( UPLO, N, B, LDB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- CALL DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK,
- $ INFO )
- LOPT = MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) )
- LIOPT = MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) )
-*
- IF( WANTZ .AND. INFO.EQ.0 ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, N, ONE,
- $ B, LDB, A, LDA )
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, N, ONE,
- $ B, LDB, A, LDA )
- END IF
- END IF
-*
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- RETURN
-*
-* End of DSYGVD
-*
- END
diff --git a/netlib/LAPACK/dsygvx.f b/netlib/LAPACK/dsygvx.f
deleted file mode 100644
index b18c5e1..0000000
--- a/netlib/LAPACK/dsygvx.f
+++ /dev/null
@@ -1,458 +0,0 @@
-*> \brief \b DSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYGVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB,
-* VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
-* LWORK, IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, ITYPE, IU, LDA, LDB, LDZ, LWORK, M, N
-* DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYGVX computes selected eigenvalues, and optionally, eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
-*> and B are assumed to be symmetric and B is also positive definite.
-*> Eigenvalues and eigenvectors can be selected by specifying either a
-*> range of values or a range of indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A and B are stored;
-*> = 'L': Lower triangle of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix pencil (A,B). N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*>
-*> On exit, the lower triangle (if UPLO='L') or the upper
-*> triangle (if UPLO='U') of A, including the diagonal, is
-*> destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, the symmetric matrix B. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of B contains the
-*> upper triangular part of the matrix B. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of B contains
-*> the lower triangular part of the matrix B.
-*>
-*> On exit, if INFO <= N, the part of B containing the matrix is
-*> overwritten by the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is DOUBLE PRECISION
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing C to tridiagonal form, where C is the symmetric
-*> matrix of the standard symmetric problem to which the
-*> generalized problem is transformed.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*DLAMCH('S').
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is DOUBLE PRECISION array, dimension (N)
-*> On normal exit, the first M elements contain the selected
-*> eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'N', then Z is not referenced.
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*>
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,8*N).
-*> For optimal efficiency, LWORK >= (NB+3)*N,
-*> where NB is the blocksize for DSYTRD returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: DPOTRF or DSYEVX returned an error code:
-*> <= N: if INFO = i, DSYEVX failed to converge;
-*> i eigenvectors failed to converge. Their indices
-*> are stored in array IFAIL.
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYeigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE DSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB,
- $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
- $ LWORK, IWORK, IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, ITYPE, IU, LDA, LDB, LDZ, LWORK, M, N
- DOUBLE PRECISION ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LQUERY, UPPER, VALEIG, WANTZ
- CHARACTER TRANS
- INTEGER LWKMIN, LWKOPT, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DPOTRF, DSYEVX, DSYGST, DTRMM, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- UPPER = LSAME( UPLO, 'U' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -11
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -13
- END IF
- END IF
- END IF
- IF (INFO.EQ.0) THEN
- IF (LDZ.LT.1 .OR. (WANTZ .AND. LDZ.LT.N)) THEN
- INFO = -18
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- LWKMIN = MAX( 1, 8*N )
- NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYGVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Form a Cholesky factorization of B.
-*
- CALL DPOTRF( UPLO, N, B, LDB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- CALL DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL,
- $ M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- IF( INFO.GT.0 )
- $ M = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B,
- $ LDB, Z, LDZ )
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B,
- $ LDB, Z, LDZ )
- END IF
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DSYGVX
-*
- END
diff --git a/netlib/LAPACK/dsyrfs.f b/netlib/LAPACK/dsyrfs.f
deleted file mode 100644
index fb807c8..0000000
--- a/netlib/LAPACK/dsyrfs.f
+++ /dev/null
@@ -1,441 +0,0 @@
-*> \brief \b DSYRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
-* X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric indefinite, and
-*> provides error bounds and backward error estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The factored form of the matrix A. AF contains the block
-*> diagonal matrix D and the multipliers used to obtain the
-*> factor U or L from the factorization A = U*D*U**T or
-*> A = L*D*L**T as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DSYTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
- $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, J, K, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DSYMV, DSYTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK + S
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DSYRFS
-*
- END
diff --git a/netlib/LAPACK/dsysv.f b/netlib/LAPACK/dsysv.f
deleted file mode 100644
index cd61e0a..0000000
--- a/netlib/LAPACK/dsysv.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief <b> DSYSV computes the solution to system of linear equations A * X = B for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, LWORK, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
-*> matrices.
-*>
-*> The diagonal pivoting method is used to factor A as
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
-*> used to solve the system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the block diagonal matrix D and the
-*> multipliers used to obtain the factor U or L from the
-*> factorization A = U*D*U**T or A = L*D*L**T as computed by
-*> DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D, as
-*> determined by DSYTRF. If IPIV(k) > 0, then rows and columns
-*> k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
-*> diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
-*> then rows and columns k-1 and -IPIV(k) were interchanged and
-*> D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
-*> IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
-*> -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
-*> diagonal block.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of WORK. LWORK >= 1, and for best performance
-*> LWORK >= max(1,N*NB), where NB is the optimal blocksize for
-*> DSYTRF.
-*> for LWORK < N, TRS will be done with Level BLAS 2
-*> for LWORK >= N, TRS will be done with Level BLAS 3
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, so the solution could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYsolve
-*
-* =====================================================================
- SUBROUTINE DSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, LWORK, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LWKOPT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DSYTRF, DSYTRS, DSYTRS2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
- LWKOPT = WORK(1)
- END IF
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYSV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- IF ( LWORK.LT.N ) THEN
-*
-* Solve with TRS ( Use Level BLAS 2)
-*
- CALL DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
- ELSE
-*
-* Solve with TRS2 ( Use Level BLAS 3)
-*
- CALL DSYTRS2( UPLO,N,NRHS,A,LDA,IPIV,B,LDB,WORK,INFO )
-*
- END IF
-*
- END IF
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DSYSV
-*
- END
diff --git a/netlib/LAPACK/dsysvx.f b/netlib/LAPACK/dsysvx.f
deleted file mode 100644
index c43e9a1..0000000
--- a/netlib/LAPACK/dsysvx.f
+++ /dev/null
@@ -1,416 +0,0 @@
-*> \brief <b> DSYSVX computes the solution to system of linear equations A * X = B for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
-* LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, LWORK, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYSVX uses the diagonal pivoting factorization to compute the
-*> solution to a real system of linear equations A * X = B,
-*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
-*> matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the diagonal pivoting method is used to factor A.
-*> The form of the factorization is
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> 2. If some D(i,i)=0, so that D is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': On entry, AF and IPIV contain the factored form of
-*> A. AF and IPIV will not be modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by DSYTRF.
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains details of the interchanges and the block structure
-*> of D, as determined by DSYTRF.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains details of the interchanges and the block structure
-*> of D, as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of WORK. LWORK >= max(1,3*N), and for best
-*> performance, when FACT = 'N', LWORK >= max(1,3*N,N*NB), where
-*> NB is the optimal blocksize for DSYTRF.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: D(i,i) is exactly zero. The factorization
-*> has been completed but the factor D is exactly
-*> singular, so the solution and error bounds could
-*> not be computed. RCOND = 0 is returned.
-*> = N+1: D is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleSYsolve
-*
-* =====================================================================
- SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
- $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK,
- $ IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, LWORK, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, NOFACT
- INTEGER LWKOPT, NB
- DOUBLE PRECISION ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DSYCON, DSYRFS, DSYTRF, DSYTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -11
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN
- INFO = -18
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- LWKOPT = MAX( 1, 3*N )
- IF( NOFACT ) THEN
- NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( LWKOPT, N*NB )
- END IF
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYSVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL DLACPY( UPLO, N, N, A, LDA, AF, LDAF )
- CALL DSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, LWORK, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = DLANSY( 'I', UPLO, N, A, LDA, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* Compute the solution vectors X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DSYTRS( UPLO, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DSYSVX
-*
- END
diff --git a/netlib/LAPACK/dsyswapr.f b/netlib/LAPACK/dsyswapr.f
deleted file mode 100644
index 6952889..0000000
--- a/netlib/LAPACK/dsyswapr.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief \b DSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYSWAPR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyswapr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyswapr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyswapr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER I1, I2, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, N )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYSWAPR applies an elementary permutation on the rows and the columns of
-*> a symmetric matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the NB diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by DSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] I1
-*> \verbatim
-*> I1 is INTEGER
-*> Index of the first row to swap
-*> \endverbatim
-*>
-*> \param[in] I2
-*> \verbatim
-*> I2 is INTEGER
-*> Index of the second row to swap
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYauxiliary
-*
-* =====================================================================
- SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER I1, I2, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, N )
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
- DOUBLE PRECISION TMP
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSWAP
-* ..
-* .. Executable Statements ..
-*
- UPPER = LSAME( UPLO, 'U' )
- IF (UPPER) THEN
-*
-* UPPER
-* first swap
-* - swap column I1 and I2 from I1 to I1-1
- CALL DSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
-*
-* second swap :
-* - swap A(I1,I1) and A(I2,I2)
-* - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
- TMP=A(I1,I1)
- A(I1,I1)=A(I2,I2)
- A(I2,I2)=TMP
-*
- DO I=1,I2-I1-1
- TMP=A(I1,I1+I)
- A(I1,I1+I)=A(I1+I,I2)
- A(I1+I,I2)=TMP
- END DO
-*
-* third swap
-* - swap row I1 and I2 from I2+1 to N
- DO I=I2+1,N
- TMP=A(I1,I)
- A(I1,I)=A(I2,I)
- A(I2,I)=TMP
- END DO
-*
- ELSE
-*
-* LOWER
-* first swap
-* - swap row I1 and I2 from I1 to I1-1
- CALL DSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
-*
-* second swap :
-* - swap A(I1,I1) and A(I2,I2)
-* - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
- TMP=A(I1,I1)
- A(I1,I1)=A(I2,I2)
- A(I2,I2)=TMP
-*
- DO I=1,I2-I1-1
- TMP=A(I1+I,I1)
- A(I1+I,I1)=A(I2,I1+I)
- A(I2,I1+I)=TMP
- END DO
-*
-* third swap
-* - swap col I1 and I2 from I2+1 to N
- DO I=I2+1,N
- TMP=A(I,I1)
- A(I,I1)=A(I,I2)
- A(I,I2)=TMP
- END DO
-*
- ENDIF
- END SUBROUTINE DSYSWAPR
-
diff --git a/netlib/LAPACK/dsytd2.f b/netlib/LAPACK/dsytd2.f
deleted file mode 100644
index a238f9a..0000000
--- a/netlib/LAPACK/dsytd2.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b DSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity transformation (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
-*> form T by an orthogonal similarity transformation: Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
-*> of A are overwritten by the corresponding elements of the
-*> tridiagonal matrix T, and the elements above the first
-*> superdiagonal, with the array TAU, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; if UPLO
-*> = 'L', the diagonal and first subdiagonal of A are over-
-*> written by the corresponding elements of the tridiagonal
-*> matrix T, and the elements below the first subdiagonal, with
-*> the array TAU, represent the orthogonal matrix Q as a product
-*> of elementary reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n-1) . . . H(2) H(1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*> A(1:i-1,i+1), and tau in TAU(i).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(n-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
-*> and tau in TAU(i).
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with n = 5:
-*>
-*> if UPLO = 'U': if UPLO = 'L':
-*>
-*> ( d e v2 v3 v4 ) ( d )
-*> ( d e v3 v4 ) ( e d )
-*> ( d e v4 ) ( v1 e d )
-*> ( d e ) ( v1 v2 e d )
-*> ( d ) ( v1 v2 v3 e d )
-*>
-*> where d and e denote diagonal and off-diagonal elements of T, and vi
-*> denotes an element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO, HALF
- PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0,
- $ HALF = 1.0D0 / 2.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
- DOUBLE PRECISION ALPHA, TAUI
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLARFG, DSYMV, DSYR2, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTD2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Reduce the upper triangle of A
-*
- DO 10 I = N - 1, 1, -1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(1:i-1,i+1)
-*
- CALL DLARFG( I, A( I, I+1 ), A( 1, I+1 ), 1, TAUI )
- E( I ) = A( I, I+1 )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(1:i,1:i)
-*
- A( I, I+1 ) = ONE
-*
-* Compute x := tau * A * v storing x in TAU(1:i)
-*
- CALL DSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO,
- $ TAU, 1 )
-*
-* Compute w := x - 1/2 * tau * (x**T * v) * v
-*
- ALPHA = -HALF*TAUI*DDOT( I, TAU, 1, A( 1, I+1 ), 1 )
- CALL DAXPY( I, ALPHA, A( 1, I+1 ), 1, TAU, 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL DSYR2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A,
- $ LDA )
-*
- A( I, I+1 ) = E( I )
- END IF
- D( I+1 ) = A( I+1, I+1 )
- TAU( I ) = TAUI
- 10 CONTINUE
- D( 1 ) = A( 1, 1 )
- ELSE
-*
-* Reduce the lower triangle of A
-*
- DO 20 I = 1, N - 1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(i+2:n,i)
-*
- CALL DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAUI )
- E( I ) = A( I+1, I )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
- A( I+1, I ) = ONE
-*
-* Compute x := tau * A * v storing y in TAU(i:n-1)
-*
- CALL DSYMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA,
- $ A( I+1, I ), 1, ZERO, TAU( I ), 1 )
-*
-* Compute w := x - 1/2 * tau * (x**T * v) * v
-*
- ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, A( I+1, I ),
- $ 1 )
- CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL DSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1,
- $ A( I+1, I+1 ), LDA )
-*
- A( I+1, I ) = E( I )
- END IF
- D( I ) = A( I, I )
- TAU( I ) = TAUI
- 20 CONTINUE
- D( N ) = A( N, N )
- END IF
-*
- RETURN
-*
-* End of DSYTD2
-*
- END
diff --git a/netlib/LAPACK/dsytf2.f b/netlib/LAPACK/dsytf2.f
deleted file mode 100644
index 23d8889..0000000
--- a/netlib/LAPACK/dsytf2.f
+++ /dev/null
@@ -1,597 +0,0 @@
-*> \brief \b DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTF2 computes the factorization of a real symmetric matrix A using
-*> the Bunch-Kaufman diagonal pivoting method:
-*>
-*> A = U*D*U**T or A = L*D*L**T
-*>
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, U**T is the transpose of U, and D is symmetric and
-*> block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L (see below for further details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, D(k,k) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', then A = U*D*U**T, where
-*> U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*> i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I v 0 ) k-s
-*> U(k) = ( 0 I 0 ) s
-*> ( 0 0 I ) n-k
-*> k-s s n-k
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*> If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*> and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*>
-*> If UPLO = 'L', then A = L*D*L**T, where
-*> L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*> i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*> n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I 0 0 ) k-1
-*> L(k) = ( 0 I 0 ) s
-*> ( 0 v I ) n-k-s+1
-*> k-1 s n-k-s+1
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*> If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*> and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> \verbatim
-*>
-*> 09-29-06 - patch from
-*> Bobby Cheng, MathWorks
-*>
-*> Replace l.204 and l.372
-*> IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*> by
-*> IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
-*>
-*> 01-01-96 - Based on modifications by
-*> J. Lewis, Boeing Computer Services Company
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> 1-96 - Based on modifications by J. Lewis, Boeing Computer Services
-*> Company
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION EIGHT, SEVTEN
- PARAMETER ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IMAX, J, JMAX, K, KK, KP, KSTEP
- DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
- $ ROWMAX, T, WK, WKM1, WKP1
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- INTEGER IDAMAX
- EXTERNAL LSAME, IDAMAX, DISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSWAP, DSYR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTF2', -INFO )
- RETURN
- END IF
-*
-* Initialize ALPHA for use in choosing pivot block size.
-*
- ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
- IF( UPPER ) THEN
-*
-* Factorize A as U*D*U**T using the upper triangle of A
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2
-*
- K = N
- 10 CONTINUE
-*
-* If K < 1, exit from loop
-*
- IF( K.LT.1 )
- $ GO TO 70
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( A( K, K ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.GT.1 ) THEN
- IMAX = IDAMAX( K-1, A( 1, K ), 1 )
- COLMAX = ABS( A( IMAX, K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
-*
-* Column K is zero or contains a NaN: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = IMAX + IDAMAX( K-IMAX, A( IMAX, IMAX+1 ), LDA )
- ROWMAX = ABS( A( IMAX, JMAX ) )
- IF( IMAX.GT.1 ) THEN
- JMAX = IDAMAX( IMAX-1, A( 1, IMAX ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K-1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K - KSTEP + 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the leading
-* submatrix A(1:k,1:k)
-*
- CALL DSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
- CALL DSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ),
- $ LDA )
- T = A( KK, KK )
- A( KK, KK ) = A( KP, KP )
- A( KP, KP ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = A( K-1, K )
- A( K-1, K ) = A( KP, K )
- A( KP, K ) = T
- END IF
- END IF
-*
-* Update the leading submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = U(k)*D(k)
-*
-* where U(k) is the k-th column of U
-*
-* Perform a rank-1 update of A(1:k-1,1:k-1) as
-*
-* A := A - U(k)*D(k)*U(k)**T = A - W(k)*1/D(k)*W(k)**T
-*
- R1 = ONE / A( K, K )
- CALL DSYR( UPLO, K-1, -R1, A( 1, K ), 1, A, LDA )
-*
-* Store U(k) in column k
-*
- CALL DSCAL( K-1, R1, A( 1, K ), 1 )
- ELSE
-*
-* 2-by-2 pivot block D(k): columns k and k-1 now hold
-*
-* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
-*
-* where U(k) and U(k-1) are the k-th and (k-1)-th columns
-* of U
-*
-* Perform a rank-2 update of A(1:k-2,1:k-2) as
-*
-* A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
-* = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )**T
-*
- IF( K.GT.2 ) THEN
-*
- D12 = A( K-1, K )
- D22 = A( K-1, K-1 ) / D12
- D11 = A( K, K ) / D12
- T = ONE / ( D11*D22-ONE )
- D12 = T / D12
-*
- DO 30 J = K - 2, 1, -1
- WKM1 = D12*( D11*A( J, K-1 )-A( J, K ) )
- WK = D12*( D22*A( J, K )-A( J, K-1 ) )
- DO 20 I = J, 1, -1
- A( I, J ) = A( I, J ) - A( I, K )*WK -
- $ A( I, K-1 )*WKM1
- 20 CONTINUE
- A( J, K ) = WK
- A( J, K-1 ) = WKM1
- 30 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K-1 ) = -KP
- END IF
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KSTEP
- GO TO 10
-*
- ELSE
-*
-* Factorize A as L*D*L**T using the lower triangle of A
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2
-*
- K = 1
- 40 CONTINUE
-*
-* If K > N, exit from loop
-*
- IF( K.GT.N )
- $ GO TO 70
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( A( K, K ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.LT.N ) THEN
- IMAX = K + IDAMAX( N-K, A( K+1, K ), 1 )
- COLMAX = ABS( A( IMAX, K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
-*
-* Column K is zero or contains a NaN: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), LDA )
- ROWMAX = ABS( A( IMAX, JMAX ) )
- IF( IMAX.LT.N ) THEN
- JMAX = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K+1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K + KSTEP - 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the trailing
-* submatrix A(k:n,k:n)
-*
- IF( KP.LT.N )
- $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
- CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
- $ LDA )
- T = A( KK, KK )
- A( KK, KK ) = A( KP, KP )
- A( KP, KP ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = A( K+1, K )
- A( K+1, K ) = A( KP, K )
- A( KP, K ) = T
- END IF
- END IF
-*
-* Update the trailing submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = L(k)*D(k)
-*
-* where L(k) is the k-th column of L
-*
- IF( K.LT.N ) THEN
-*
-* Perform a rank-1 update of A(k+1:n,k+1:n) as
-*
-* A := A - L(k)*D(k)*L(k)**T = A - W(k)*(1/D(k))*W(k)**T
-*
- D11 = ONE / A( K, K )
- CALL DSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
- $ A( K+1, K+1 ), LDA )
-*
-* Store L(k) in column K
-*
- CALL DSCAL( N-K, D11, A( K+1, K ), 1 )
- END IF
- ELSE
-*
-* 2-by-2 pivot block D(k)
-*
- IF( K.LT.N-1 ) THEN
-*
-* Perform a rank-2 update of A(k+2:n,k+2:n) as
-*
-* A := A - ( (A(k) A(k+1))*D(k)**(-1) ) * (A(k) A(k+1))**T
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th
-* columns of L
-*
- D21 = A( K+1, K )
- D11 = A( K+1, K+1 ) / D21
- D22 = A( K, K ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
-*
- DO 60 J = K + 2, N
-*
- WK = D21*( D11*A( J, K )-A( J, K+1 ) )
- WKP1 = D21*( D22*A( J, K+1 )-A( J, K ) )
-*
- DO 50 I = J, N
- A( I, J ) = A( I, J ) - A( I, K )*WK -
- $ A( I, K+1 )*WKP1
- 50 CONTINUE
-*
- A( J, K ) = WK
- A( J, K+1 ) = WKP1
-*
- 60 CONTINUE
- END IF
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K+1 ) = -KP
- END IF
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KSTEP
- GO TO 40
-*
- END IF
-*
- 70 CONTINUE
-*
- RETURN
-*
-* End of DSYTF2
-*
- END
diff --git a/netlib/LAPACK/dsytrd.f b/netlib/LAPACK/dsytrd.f
deleted file mode 100644
index b268f4c..0000000
--- a/netlib/LAPACK/dsytrd.f
+++ /dev/null
@@ -1,376 +0,0 @@
-*> \brief \b DSYTRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRD reduces a real symmetric matrix A to real symmetric
-*> tridiagonal form T by an orthogonal similarity transformation:
-*> Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
-*> of A are overwritten by the corresponding elements of the
-*> tridiagonal matrix T, and the elements above the first
-*> superdiagonal, with the array TAU, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; if UPLO
-*> = 'L', the diagonal and first subdiagonal of A are over-
-*> written by the corresponding elements of the tridiagonal
-*> matrix T, and the elements below the first subdiagonal, with
-*> the array TAU, represent the orthogonal matrix Q as a product
-*> of elementary reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 1.
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n-1) . . . H(2) H(1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*> A(1:i-1,i+1), and tau in TAU(i).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(n-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
-*> and tau in TAU(i).
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with n = 5:
-*>
-*> if UPLO = 'U': if UPLO = 'L':
-*>
-*> ( d e v2 v3 v4 ) ( d )
-*> ( d e v3 v4 ) ( e d )
-*> ( d e v4 ) ( v1 e d )
-*> ( d e ) ( v1 v2 e d )
-*> ( d ) ( v1 v2 v3 e d )
-*>
-*> where d and e denote diagonal and off-diagonal elements of T, and vi
-*> denotes an element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER
- INTEGER I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLATRD, DSYR2K, DSYTD2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size.
-*
- NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NX = N
- IWS = 1
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
-*
-* Determine when to cross over from blocked to unblocked code
-* (last block is always handled by unblocked code).
-*
- NX = MAX( NB, ILAENV( 3, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
- IF( NX.LT.N ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: determine the
-* minimum value of NB, and reduce NB or force use of
-* unblocked code by setting NX = N.
-*
- NB = MAX( LWORK / LDWORK, 1 )
- NBMIN = ILAENV( 2, 'DSYTRD', UPLO, N, -1, -1, -1 )
- IF( NB.LT.NBMIN )
- $ NX = N
- END IF
- ELSE
- NX = N
- END IF
- ELSE
- NB = 1
- END IF
-*
- IF( UPPER ) THEN
-*
-* Reduce the upper triangle of A.
-* Columns 1:kk are handled by the unblocked method.
-*
- KK = N - ( ( N-NX+NB-1 ) / NB )*NB
- DO 20 I = N - NB + 1, KK + 1, -NB
-*
-* Reduce columns i:i+nb-1 to tridiagonal form and form the
-* matrix W which is needed to update the unreduced part of
-* the matrix
-*
- CALL DLATRD( UPLO, I+NB-1, NB, A, LDA, E, TAU, WORK,
- $ LDWORK )
-*
-* Update the unreduced submatrix A(1:i-1,1:i-1), using an
-* update of the form: A := A - V*W**T - W*V**T
-*
- CALL DSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, I ),
- $ LDA, WORK, LDWORK, ONE, A, LDA )
-*
-* Copy superdiagonal elements back into A, and diagonal
-* elements into D
-*
- DO 10 J = I, I + NB - 1
- A( J-1, J ) = E( J-1 )
- D( J ) = A( J, J )
- 10 CONTINUE
- 20 CONTINUE
-*
-* Use unblocked code to reduce the last or only block
-*
- CALL DSYTD2( UPLO, KK, A, LDA, D, E, TAU, IINFO )
- ELSE
-*
-* Reduce the lower triangle of A
-*
- DO 40 I = 1, N - NX, NB
-*
-* Reduce columns i:i+nb-1 to tridiagonal form and form the
-* matrix W which is needed to update the unreduced part of
-* the matrix
-*
- CALL DLATRD( UPLO, N-I+1, NB, A( I, I ), LDA, E( I ),
- $ TAU( I ), WORK, LDWORK )
-*
-* Update the unreduced submatrix A(i+ib:n,i+ib:n), using
-* an update of the form: A := A - V*W**T - W*V**T
-*
- CALL DSYR2K( UPLO, 'No transpose', N-I-NB+1, NB, -ONE,
- $ A( I+NB, I ), LDA, WORK( NB+1 ), LDWORK, ONE,
- $ A( I+NB, I+NB ), LDA )
-*
-* Copy subdiagonal elements back into A, and diagonal
-* elements into D
-*
- DO 30 J = I, I + NB - 1
- A( J+1, J ) = E( J )
- D( J ) = A( J, J )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Use unblocked code to reduce the last or only block
-*
- CALL DSYTD2( UPLO, N-I+1, A( I, I ), LDA, D( I ), E( I ),
- $ TAU( I ), IINFO )
- END IF
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DSYTRD
-*
- END
diff --git a/netlib/LAPACK/dsytrf.f b/netlib/LAPACK/dsytrf.f
deleted file mode 100644
index a0b83c7..0000000
--- a/netlib/LAPACK/dsytrf.f
+++ /dev/null
@@ -1,363 +0,0 @@
-*> \brief \b DSYTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRF computes the factorization of a real symmetric matrix A using
-*> the Bunch-Kaufman diagonal pivoting method. The form of the
-*> factorization is
-*>
-*> A = U*D*U**T or A = L*D*L**T
-*>
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> This is the blocked version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L (see below for further details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of WORK. LWORK >=1. For best performance
-*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', then A = U*D*U**T, where
-*> U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*> i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I v 0 ) k-s
-*> U(k) = ( 0 I 0 ) s
-*> ( 0 0 I ) n-k
-*> k-s s n-k
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*> If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*> and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*>
-*> If UPLO = 'L', then A = L*D*L**T, where
-*> L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*> i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*> n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I 0 0 ) k-1
-*> L(k) = ( 0 I 0 ) s
-*> ( 0 v I ) n-k-s+1
-*> k-1 s n-k-s+1
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*> If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*> and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER
- INTEGER IINFO, IWS, J, K, KB, LDWORK, LWKOPT, NB, NBMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASYF, DSYTF2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size
-*
- NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = N
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
- NB = MAX( LWORK / LDWORK, 1 )
- NBMIN = MAX( 2, ILAENV( 2, 'DSYTRF', UPLO, N, -1, -1, -1 ) )
- END IF
- ELSE
- IWS = 1
- END IF
- IF( NB.LT.NBMIN )
- $ NB = N
-*
- IF( UPPER ) THEN
-*
-* Factorize A as U*D*U**T using the upper triangle of A
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* KB, where KB is the number of columns factorized by DLASYF;
-* KB is either NB or NB-1, or K for the last block
-*
- K = N
- 10 CONTINUE
-*
-* If K < 1, exit from loop
-*
- IF( K.LT.1 )
- $ GO TO 40
-*
- IF( K.GT.NB ) THEN
-*
-* Factorize columns k-kb+1:k of A and use blocked code to
-* update columns 1:k-kb
-*
- CALL DLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, LDWORK,
- $ IINFO )
- ELSE
-*
-* Use unblocked code to factorize columns 1:k of A
-*
- CALL DSYTF2( UPLO, K, A, LDA, IPIV, IINFO )
- KB = K
- END IF
-*
-* Set INFO on the first occurrence of a zero pivot
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KB
- GO TO 10
-*
- ELSE
-*
-* Factorize A as L*D*L**T using the lower triangle of A
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* KB, where KB is the number of columns factorized by DLASYF;
-* KB is either NB or NB-1, or N-K+1 for the last block
-*
- K = 1
- 20 CONTINUE
-*
-* If K > N, exit from loop
-*
- IF( K.GT.N )
- $ GO TO 40
-*
- IF( K.LE.N-NB ) THEN
-*
-* Factorize columns k:k+kb-1 of A and use blocked code to
-* update columns k+kb:n
-*
- CALL DLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ),
- $ WORK, LDWORK, IINFO )
- ELSE
-*
-* Use unblocked code to factorize columns k:n of A
-*
- CALL DSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO )
- KB = N - K + 1
- END IF
-*
-* Set INFO on the first occurrence of a zero pivot
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + K - 1
-*
-* Adjust IPIV
-*
- DO 30 J = K, K + KB - 1
- IF( IPIV( J ).GT.0 ) THEN
- IPIV( J ) = IPIV( J ) + K - 1
- ELSE
- IPIV( J ) = IPIV( J ) - K + 1
- END IF
- 30 CONTINUE
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KB
- GO TO 20
-*
- END IF
-*
- 40 CONTINUE
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DSYTRF
-*
- END
diff --git a/netlib/LAPACK/dsytri.f b/netlib/LAPACK/dsytri.f
deleted file mode 100644
index bbafae4..0000000
--- a/netlib/LAPACK/dsytri.f
+++ /dev/null
@@ -1,382 +0,0 @@
-*> \brief \b DSYTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRI computes the inverse of a real symmetric indefinite matrix
-*> A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*> DSYTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the block diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by DSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER K, KP, KSTEP
- DOUBLE PRECISION AK, AKKP1, AKP1, D, T, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT
- EXTERNAL LSAME, DDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DSWAP, DSYMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- DO 10 INFO = N, 1, -1
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- DO 20 INFO = 1, N
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 20 CONTINUE
- END IF
- INFO = 0
-*
- IF( UPPER ) THEN
-*
-* Compute inv(A) from the factorization A = U*D*U**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- 30 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 40
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- A( K, K ) = ONE / A( K, K )
-*
-* Compute column K of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL DCOPY( K-1, A( 1, K ), 1, WORK, 1 )
- CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
- $ A( 1, K ), 1 )
- A( K, K ) = A( K, K ) - DDOT( K-1, WORK, 1, A( 1, K ),
- $ 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( A( K, K+1 ) )
- AK = A( K, K ) / T
- AKP1 = A( K+1, K+1 ) / T
- AKKP1 = A( K, K+1 ) / T
- D = T*( AK*AKP1-ONE )
- A( K, K ) = AKP1 / D
- A( K+1, K+1 ) = AK / D
- A( K, K+1 ) = -AKKP1 / D
-*
-* Compute columns K and K+1 of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL DCOPY( K-1, A( 1, K ), 1, WORK, 1 )
- CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
- $ A( 1, K ), 1 )
- A( K, K ) = A( K, K ) - DDOT( K-1, WORK, 1, A( 1, K ),
- $ 1 )
- A( K, K+1 ) = A( K, K+1 ) -
- $ DDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 )
- CALL DCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 )
- CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
- $ A( 1, K+1 ), 1 )
- A( K+1, K+1 ) = A( K+1, K+1 ) -
- $ DDOT( K-1, WORK, 1, A( 1, K+1 ), 1 )
- END IF
- KSTEP = 2
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the leading
-* submatrix A(1:k+1,1:k+1)
-*
- CALL DSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 )
- CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA )
- TEMP = A( K, K )
- A( K, K ) = A( KP, KP )
- A( KP, KP ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = A( K, K+1 )
- A( K, K+1 ) = A( KP, K+1 )
- A( KP, K+1 ) = TEMP
- END IF
- END IF
-*
- K = K + KSTEP
- GO TO 30
- 40 CONTINUE
-*
- ELSE
-*
-* Compute inv(A) from the factorization A = L*D*L**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- 50 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 60
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- A( K, K ) = ONE / A( K, K )
-*
-* Compute column K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
- CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
- $ ZERO, A( K+1, K ), 1 )
- A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ),
- $ 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( A( K, K-1 ) )
- AK = A( K-1, K-1 ) / T
- AKP1 = A( K, K ) / T
- AKKP1 = A( K, K-1 ) / T
- D = T*( AK*AKP1-ONE )
- A( K-1, K-1 ) = AKP1 / D
- A( K, K ) = AK / D
- A( K, K-1 ) = -AKKP1 / D
-*
-* Compute columns K-1 and K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
- CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
- $ ZERO, A( K+1, K ), 1 )
- A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ),
- $ 1 )
- A( K, K-1 ) = A( K, K-1 ) -
- $ DDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ),
- $ 1 )
- CALL DCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 )
- CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
- $ ZERO, A( K+1, K-1 ), 1 )
- A( K-1, K-1 ) = A( K-1, K-1 ) -
- $ DDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 )
- END IF
- KSTEP = 2
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the trailing
-* submatrix A(k-1:n,k-1:n)
-*
- IF( KP.LT.N )
- $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 )
- CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA )
- TEMP = A( K, K )
- A( K, K ) = A( KP, KP )
- A( KP, KP ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = A( K, K-1 )
- A( K, K-1 ) = A( KP, K-1 )
- A( KP, K-1 ) = TEMP
- END IF
- END IF
-*
- K = K - KSTEP
- GO TO 50
- 60 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSYTRI
-*
- END
diff --git a/netlib/LAPACK/dsytri2.f b/netlib/LAPACK/dsytri2.f
deleted file mode 100644
index 285ef04..0000000
--- a/netlib/LAPACK/dsytri2.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief \b DSYTRI2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRI2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRI2 computes the inverse of a DOUBLE PRECISION symmetric indefinite matrix
-*> A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*> DSYTRF. DSYTRI2 sets the LEADING DIMENSION of the workspace
-*> before calling DSYTRI2X that actually computes the inverse.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the NB diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by DSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the NB structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3)
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> WORK is size >= (N+NB+1)*(NB+3)
-*> If LDWORK = -1, then a workspace query is assumed; the routine
-*> calculates:
-*> - the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array,
-*> - and no error message related to LDWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER, LQUERY
- INTEGER MINSIZE, NBMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DSYTRI2X
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
-* Get blocksize
- NBMAX = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
- IF ( NBMAX .GE. N ) THEN
- MINSIZE = N
- ELSE
- MINSIZE = (N+NBMAX+1)*(NBMAX+3)
- END IF
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
-* Quick return if possible
-*
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRI2', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- WORK(1)=MINSIZE
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
-
- IF( NBMAX .GE. N ) THEN
- CALL DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
- ELSE
- CALL DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
- END IF
- RETURN
-*
-* End of DSYTRI2
-*
- END
diff --git a/netlib/LAPACK/dsytri2x.f b/netlib/LAPACK/dsytri2x.f
deleted file mode 100644
index a2474d8..0000000
--- a/netlib/LAPACK/dsytri2x.f
+++ /dev/null
@@ -1,591 +0,0 @@
-*> \brief \b DSYTRI2X
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRI2X + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri2x.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri2x.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri2x.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N, NB
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( N+NB+1,* )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRI2X computes the inverse of a real symmetric indefinite matrix
-*> A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*> DSYTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the NNB diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by DSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the NNB structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N+NNB+1,NNB+3)
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> Block size
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N, NB
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( N+NB+1,* )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IINFO, IP, K, CUT, NNB
- INTEGER COUNT
- INTEGER J, U11, INVD
-
- DOUBLE PRECISION AK, AKKP1, AKP1, D, T
- DOUBLE PRECISION U01_I_J, U01_IP1_J
- DOUBLE PRECISION U11_I_J, U11_IP1_J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSYCONV, XERBLA, DTRTRI
- EXTERNAL DGEMM, DTRMM, DSYSWAPR
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
-*
-* Quick return if possible
-*
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRI2X', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
-*
-* Convert A
-* Workspace got Non-diag elements of D
-*
- CALL DSYCONV( UPLO, 'C', N, A, LDA, IPIV, WORK, IINFO )
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- DO INFO = N, 1, -1
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- END DO
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- DO INFO = 1, N
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- END DO
- END IF
- INFO = 0
-*
-* Splitting Workspace
-* U01 is a block (N,NB+1)
-* The first element of U01 is in WORK(1,1)
-* U11 is a block (NB+1,NB+1)
-* The first element of U11 is in WORK(N+1,1)
- U11 = N
-* INVD is a block (N,2)
-* The first element of INVD is in WORK(1,INVD)
- INVD = NB+2
-
- IF( UPPER ) THEN
-*
-* invA = P * inv(U**T)*inv(D)*inv(U)*P**T.
-*
- CALL DTRTRI( UPLO, 'U', N, A, LDA, INFO )
-*
-* inv(D) and inv(D)*inv(U)
-*
- K=1
- DO WHILE ( K .LE. N )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal NNB
- WORK(K,INVD) = ONE / A( K, K )
- WORK(K,INVD+1) = 0
- K=K+1
- ELSE
-* 2 x 2 diagonal NNB
- T = WORK(K+1,1)
- AK = A( K, K ) / T
- AKP1 = A( K+1, K+1 ) / T
- AKKP1 = WORK(K+1,1) / T
- D = T*( AK*AKP1-ONE )
- WORK(K,INVD) = AKP1 / D
- WORK(K+1,INVD+1) = AK / D
- WORK(K,INVD+1) = -AKKP1 / D
- WORK(K+1,INVD) = -AKKP1 / D
- K=K+2
- END IF
- END DO
-*
-* inv(U**T) = (inv(U))**T
-*
-* inv(U**T)*inv(D)*inv(U)
-*
- CUT=N
- DO WHILE (CUT .GT. 0)
- NNB=NB
- IF (CUT .LE. NNB) THEN
- NNB=CUT
- ELSE
- COUNT = 0
-* count negative elements,
- DO I=CUT+1-NNB,CUT
- IF (IPIV(I) .LT. 0) COUNT=COUNT+1
- END DO
-* need a even number for a clear cut
- IF (MOD(COUNT,2) .EQ. 1) NNB=NNB+1
- END IF
-
- CUT=CUT-NNB
-*
-* U01 Block
-*
- DO I=1,CUT
- DO J=1,NNB
- WORK(I,J)=A(I,CUT+J)
- END DO
- END DO
-*
-* U11 Block
-*
- DO I=1,NNB
- WORK(U11+I,I)=ONE
- DO J=1,I-1
- WORK(U11+I,J)=ZERO
- END DO
- DO J=I+1,NNB
- WORK(U11+I,J)=A(CUT+I,CUT+J)
- END DO
- END DO
-*
-* invD*U01
-*
- I=1
- DO WHILE (I .LE. CUT)
- IF (IPIV(I) > 0) THEN
- DO J=1,NNB
- WORK(I,J)=WORK(I,INVD)*WORK(I,J)
- END DO
- I=I+1
- ELSE
- DO J=1,NNB
- U01_I_J = WORK(I,J)
- U01_IP1_J = WORK(I+1,J)
- WORK(I,J)=WORK(I,INVD)*U01_I_J+
- $ WORK(I,INVD+1)*U01_IP1_J
- WORK(I+1,J)=WORK(I+1,INVD)*U01_I_J+
- $ WORK(I+1,INVD+1)*U01_IP1_J
- END DO
- I=I+2
- END IF
- END DO
-*
-* invD1*U11
-*
- I=1
- DO WHILE (I .LE. NNB)
- IF (IPIV(CUT+I) > 0) THEN
- DO J=I,NNB
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J)
- END DO
- I=I+1
- ELSE
- DO J=I,NNB
- U11_I_J = WORK(U11+I,J)
- U11_IP1_J = WORK(U11+I+1,J)
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J) +
- $ WORK(CUT+I,INVD+1)*WORK(U11+I+1,J)
- WORK(U11+I+1,J)=WORK(CUT+I+1,INVD)*U11_I_J+
- $ WORK(CUT+I+1,INVD+1)*U11_IP1_J
- END DO
- I=I+2
- END IF
- END DO
-*
-* U11**T*invD1*U11->U11
-*
- CALL DTRMM('L','U','T','U',NNB, NNB,
- $ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
-*
- DO I=1,NNB
- DO J=I,NNB
- A(CUT+I,CUT+J)=WORK(U11+I,J)
- END DO
- END DO
-*
-* U01**T*invD*U01->A(CUT+I,CUT+J)
-*
- CALL DGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
- $ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
-
-*
-* U11 = U11**T*invD1*U11 + U01**T*invD*U01
-*
- DO I=1,NNB
- DO J=I,NNB
- A(CUT+I,CUT+J)=A(CUT+I,CUT+J)+WORK(U11+I,J)
- END DO
- END DO
-*
-* U01 = U00**T*invD0*U01
-*
- CALL DTRMM('L',UPLO,'T','U',CUT, NNB,
- $ ONE,A,LDA,WORK,N+NB+1)
-
-*
-* Update U01
-*
- DO I=1,CUT
- DO J=1,NNB
- A(I,CUT+J)=WORK(I,J)
- END DO
- END DO
-*
-* Next Block
-*
- END DO
-*
-* Apply PERMUTATIONS P and P**T: P * inv(U**T)*inv(D)*inv(U) *P**T
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP )
- IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I )
- ELSE
- IP=-IPIV(I)
- I=I+1
- IF ( (I-1) .LT. IP)
- $ CALL DSYSWAPR( UPLO, N, A, LDA, I-1 ,IP )
- IF ( (I-1) .GT. IP)
- $ CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I-1 )
- ENDIF
- I=I+1
- END DO
- ELSE
-*
-* LOWER...
-*
-* invA = P * inv(U**T)*inv(D)*inv(U)*P**T.
-*
- CALL DTRTRI( UPLO, 'U', N, A, LDA, INFO )
-*
-* inv(D) and inv(D)*inv(U)
-*
- K=N
- DO WHILE ( K .GE. 1 )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal NNB
- WORK(K,INVD) = ONE / A( K, K )
- WORK(K,INVD+1) = 0
- K=K-1
- ELSE
-* 2 x 2 diagonal NNB
- T = WORK(K-1,1)
- AK = A( K-1, K-1 ) / T
- AKP1 = A( K, K ) / T
- AKKP1 = WORK(K-1,1) / T
- D = T*( AK*AKP1-ONE )
- WORK(K-1,INVD) = AKP1 / D
- WORK(K,INVD) = AK / D
- WORK(K,INVD+1) = -AKKP1 / D
- WORK(K-1,INVD+1) = -AKKP1 / D
- K=K-2
- END IF
- END DO
-*
-* inv(U**T) = (inv(U))**T
-*
-* inv(U**T)*inv(D)*inv(U)
-*
- CUT=0
- DO WHILE (CUT .LT. N)
- NNB=NB
- IF (CUT + NNB .GT. N) THEN
- NNB=N-CUT
- ELSE
- COUNT = 0
-* count negative elements,
- DO I=CUT+1,CUT+NNB
- IF (IPIV(I) .LT. 0) COUNT=COUNT+1
- END DO
-* need a even number for a clear cut
- IF (MOD(COUNT,2) .EQ. 1) NNB=NNB+1
- END IF
-* L21 Block
- DO I=1,N-CUT-NNB
- DO J=1,NNB
- WORK(I,J)=A(CUT+NNB+I,CUT+J)
- END DO
- END DO
-* L11 Block
- DO I=1,NNB
- WORK(U11+I,I)=ONE
- DO J=I+1,NNB
- WORK(U11+I,J)=ZERO
- END DO
- DO J=1,I-1
- WORK(U11+I,J)=A(CUT+I,CUT+J)
- END DO
- END DO
-*
-* invD*L21
-*
- I=N-CUT-NNB
- DO WHILE (I .GE. 1)
- IF (IPIV(CUT+NNB+I) > 0) THEN
- DO J=1,NNB
- WORK(I,J)=WORK(CUT+NNB+I,INVD)*WORK(I,J)
- END DO
- I=I-1
- ELSE
- DO J=1,NNB
- U01_I_J = WORK(I,J)
- U01_IP1_J = WORK(I-1,J)
- WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
- $ WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
- WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
- $ WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
- END DO
- I=I-2
- END IF
- END DO
-*
-* invD1*L11
-*
- I=NNB
- DO WHILE (I .GE. 1)
- IF (IPIV(CUT+I) > 0) THEN
- DO J=1,NNB
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J)
- END DO
- I=I-1
- ELSE
- DO J=1,NNB
- U11_I_J = WORK(U11+I,J)
- U11_IP1_J = WORK(U11+I-1,J)
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J) +
- $ WORK(CUT+I,INVD+1)*U11_IP1_J
- WORK(U11+I-1,J)=WORK(CUT+I-1,INVD+1)*U11_I_J+
- $ WORK(CUT+I-1,INVD)*U11_IP1_J
- END DO
- I=I-2
- END IF
- END DO
-*
-* L11**T*invD1*L11->L11
-*
- CALL DTRMM('L',UPLO,'T','U',NNB, NNB,
- $ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
-
-*
- DO I=1,NNB
- DO J=1,I
- A(CUT+I,CUT+J)=WORK(U11+I,J)
- END DO
- END DO
-*
- IF ( (CUT+NNB) .LT. N ) THEN
-*
-* L21**T*invD2*L21->A(CUT+I,CUT+J)
-*
- CALL DGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1)
- $ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
-
-*
-* L11 = L11**T*invD1*L11 + U01**T*invD*U01
-*
- DO I=1,NNB
- DO J=1,I
- A(CUT+I,CUT+J)=A(CUT+I,CUT+J)+WORK(U11+I,J)
- END DO
- END DO
-*
-* L01 = L22**T*invD2*L21
-*
- CALL DTRMM('L',UPLO,'T','U', N-NNB-CUT, NNB,
- $ ONE,A(CUT+NNB+1,CUT+NNB+1),LDA,WORK,N+NB+1)
-*
-* Update L21
-*
- DO I=1,N-CUT-NNB
- DO J=1,NNB
- A(CUT+NNB+I,CUT+J)=WORK(I,J)
- END DO
- END DO
-
- ELSE
-*
-* L11 = L11**T*invD1*L11
-*
- DO I=1,NNB
- DO J=1,I
- A(CUT+I,CUT+J)=WORK(U11+I,J)
- END DO
- END DO
- END IF
-*
-* Next Block
-*
- CUT=CUT+NNB
- END DO
-*
-* Apply PERMUTATIONS P and P**T: P * inv(U**T)*inv(D)*inv(U) *P**T
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP )
- IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I )
- ELSE
- IP=-IPIV(I)
- IF ( I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP )
- IF ( I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP, I )
- I=I-1
- ENDIF
- I=I-1
- END DO
- END IF
-*
- RETURN
-*
-* End of DSYTRI2X
-*
- END
-
diff --git a/netlib/LAPACK/dsytrs.f b/netlib/LAPACK/dsytrs.f
deleted file mode 100644
index 9aae7b1..0000000
--- a/netlib/LAPACK/dsytrs.f
+++ /dev/null
@@ -1,445 +0,0 @@
-*> \brief \b DSYTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRS solves a system of linear equations A*X = B with a real
-*> symmetric matrix A using the factorization A = U*D*U**T or
-*> A = L*D*L**T computed by DSYTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, K, KP
- DOUBLE PRECISION AK, AKM1, AKM1K, BK, BKM1, DENOM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B, where A = U*D*U**T.
-*
-* First solve U*D*X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- 10 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 30
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL DGER( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL DSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K-1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K-1 )
- $ CALL DSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in columns K-1 and K of A.
-*
- CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
- CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
- $ LDB, B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = A( K-1, K )
- AKM1 = A( K-1, K-1 ) / AKM1K
- AK = A( K, K ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 20 J = 1, NRHS
- BKM1 = B( K-1, J ) / AKM1K
- BK = B( K, J ) / AKM1K
- B( K-1, J ) = ( AK*BKM1-BK ) / DENOM
- B( K, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 20 CONTINUE
- K = K - 2
- END IF
-*
- GO TO 10
- 30 CONTINUE
-*
-* Next solve U**T *X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- 40 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 50
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(U**T(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
- $ 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
-* stored in columns K and K+1 of A.
-*
- CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
- $ 1, ONE, B( K, 1 ), LDB )
- CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
- $ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB )
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K + 2
- END IF
-*
- GO TO 40
- 50 CONTINUE
-*
- ELSE
-*
-* Solve A*X = B, where A = L*D*L**T.
-*
-* First solve L*D*X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- 60 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 80
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL DGER( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ),
- $ LDB, B( K+1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL DSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K+1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K+1 )
- $ CALL DSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in columns K and K+1 of A.
-*
- IF( K.LT.N-1 ) THEN
- CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ),
- $ LDB, B( K+2, 1 ), LDB )
- CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1,
- $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
- END IF
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = A( K+1, K )
- AKM1 = A( K, K ) / AKM1K
- AK = A( K+1, K+1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 70 J = 1, NRHS
- BKM1 = B( K, J ) / AKM1K
- BK = B( K+1, J ) / AKM1K
- B( K, J ) = ( AK*BKM1-BK ) / DENOM
- B( K+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 70 CONTINUE
- K = K + 2
- END IF
-*
- GO TO 60
- 80 CONTINUE
-*
-* Next solve L**T *X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- 90 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 100
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(L**T(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(L**T(K-1)), where L(K-1) is the transformation
-* stored in columns K-1 and K of A.
-*
- IF( K.LT.N ) THEN
- CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
- CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
- $ LDB )
- END IF
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K - 2
- END IF
-*
- GO TO 90
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DSYTRS
-*
- END
diff --git a/netlib/LAPACK/dsytrs2.f b/netlib/LAPACK/dsytrs2.f
deleted file mode 100644
index af1e0b1..0000000
--- a/netlib/LAPACK/dsytrs2.f
+++ /dev/null
@@ -1,356 +0,0 @@
-*> \brief \b DSYTRS2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DSYTRS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrs2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrs2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrs2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSYTRS2 solves a system of linear equations A*X = B with a real
-*> symmetric matrix A using the factorization A = U*D*U**T or
-*> A = L*D*L**T computed by DSYTRF and converted by DSYCONV.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by DSYTRF.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IINFO, J, K, KP
- DOUBLE PRECISION AK, AKM1, AKM1K, BK, BKM1, DENOM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSYCONV, DSWAP, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DSYTRS2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Convert A
-*
- CALL DSYCONV( UPLO, 'C', N, A, LDA, IPIV, WORK, IINFO )
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B, where A = U*D*U**T.
-*
-* P**T * B
- K=N
- DO WHILE ( K .GE. 1 )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K-1 and -IPIV(K).
- KP = -IPIV( K )
- IF( KP.EQ.-IPIV( K-1 ) )
- $ CALL DSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-2
- END IF
- END DO
-*
-* Compute (U \P**T * B) -> B [ (U \P**T * B) ]
-*
- CALL DTRSM('L','U','N','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* Compute D \ B -> B [ D \ (U \P**T * B) ]
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0 ) THEN
- CALL DSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
- ELSEIF ( I .GT. 1) THEN
- IF ( IPIV(I-1) .EQ. IPIV(I) ) THEN
- AKM1K = WORK(I)
- AKM1 = A( I-1, I-1 ) / AKM1K
- AK = A( I, I ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 15 J = 1, NRHS
- BKM1 = B( I-1, J ) / AKM1K
- BK = B( I, J ) / AKM1K
- B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
- B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 15 CONTINUE
- I = I - 1
- ENDIF
- ENDIF
- I = I - 1
- END DO
-*
-* Compute (U**T \ B) -> B [ U**T \ (D \ (U \P**T * B) ) ]
-*
- CALL DTRSM('L','U','T','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* P * B [ P * (U**T \ (D \ (U \P**T * B) )) ]
-*
- K=1
- DO WHILE ( K .LE. N )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K-1 and -IPIV(K).
- KP = -IPIV( K )
- IF( K .LT. N .AND. KP.EQ.-IPIV( K+1 ) )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+2
- ENDIF
- END DO
-*
- ELSE
-*
-* Solve A*X = B, where A = L*D*L**T.
-*
-* P**T * B
- K=1
- DO WHILE ( K .LE. N )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K and -IPIV(K+1).
- KP = -IPIV( K+1 )
- IF( KP.EQ.-IPIV( K ) )
- $ CALL DSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+2
- ENDIF
- END DO
-*
-* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
-*
- CALL DTRSM('L','L','N','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* Compute D \ B -> B [ D \ (L \P**T * B) ]
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- CALL DSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
- ELSE
- AKM1K = WORK(I)
- AKM1 = A( I, I ) / AKM1K
- AK = A( I+1, I+1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 25 J = 1, NRHS
- BKM1 = B( I, J ) / AKM1K
- BK = B( I+1, J ) / AKM1K
- B( I, J ) = ( AK*BKM1-BK ) / DENOM
- B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 25 CONTINUE
- I = I + 1
- ENDIF
- I = I + 1
- END DO
-*
-* Compute (L**T \ B) -> B [ L**T \ (D \ (L \P**T * B) ) ]
-*
- CALL DTRSM('L','L','T','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* P * B [ P * (L**T \ (D \ (L \P**T * B) )) ]
-*
- K=N
- DO WHILE ( K .GE. 1 )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K-1 and -IPIV(K).
- KP = -IPIV( K )
- IF( K.GT.1 .AND. KP.EQ.-IPIV( K-1 ) )
- $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-2
- ENDIF
- END DO
-*
- END IF
-*
-* Revert A
-*
- CALL DSYCONV( UPLO, 'R', N, A, LDA, IPIV, WORK, IINFO )
-*
- RETURN
-*
-* End of DSYTRS2
-*
- END
diff --git a/netlib/LAPACK/dtbcon.f b/netlib/LAPACK/dtbcon.f
deleted file mode 100644
index 6962ad5..0000000
--- a/netlib/LAPACK/dtbcon.f
+++ /dev/null
@@ -1,284 +0,0 @@
-*> \brief \b DTBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTBCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtbcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtbcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtbcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER INFO, KD, LDAB, N
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTBCON estimates the reciprocal of the condition number of a
-*> triangular band matrix A, in either the 1-norm or the infinity-norm.
-*>
-*> The norm of A is computed and an estimate is obtained for
-*> norm(inv(A)), then the reciprocal of the condition number is
-*> computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals or subdiagonals of the
-*> triangular band matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first kd+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER INFO, KD, LDAB, N
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, ONENRM, UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLANTB
- EXTERNAL LSAME, IDAMAX, DLAMCH, DLANTB
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATBS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- END IF
-*
- RCOND = ZERO
- SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) )
-*
-* Compute the norm of the triangular matrix A.
-*
- ANORM = DLANTB( NORM, UPLO, DIAG, N, KD, AB, LDAB, WORK )
-*
-* Continue only if ANORM > 0.
-*
- IF( ANORM.GT.ZERO ) THEN
-*
-* Estimate the norm of the inverse of A.
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(A).
-*
- CALL DLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD,
- $ AB, LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(A**T).
-*
- CALL DLATBS( UPLO, 'Transpose', DIAG, NORMIN, N, KD, AB,
- $ LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO )
- END IF
- NORMIN = 'Y'
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- XNORM = ABS( WORK( IX ) )
- IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / ANORM ) / AINVNM
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of DTBCON
-*
- END
diff --git a/netlib/LAPACK/dtbrfs.f b/netlib/LAPACK/dtbrfs.f
deleted file mode 100644
index e2d5a3e..0000000
--- a/netlib/LAPACK/dtbrfs.f
+++ /dev/null
@@ -1,485 +0,0 @@
-*> \brief \b DTBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTBRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtbrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtbrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtbrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
-* LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTBRFS provides error bounds and backward error estimates for the
-*> solution to a system of linear equations with a triangular band
-*> coefficient matrix.
-*>
-*> The solution matrix X must be computed by DTBTRS or some other
-*> means before entering this routine. DTBRFS does not do iterative
-*> refinement because doing so cannot improve the backward error.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals or subdiagonals of the
-*> triangular band matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first kd+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> The solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
- $ LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, KD, LDAB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- CHARACTER TRANST
- INTEGER I, J, K, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DTBMV, DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = KD + 2
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 250 J = 1, NRHS
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A or A**T, depending on TRANS.
-*
- CALL DCOPY( N, X( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DTBMV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, WORK( N+1 ),
- $ 1 )
- CALL DAXPY( N, -ONE, B( 1, J ), 1, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 20 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 20 CONTINUE
-*
- IF( NOTRAN ) THEN
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 40 K = 1, N
- XK = ABS( X( K, J ) )
- DO 30 I = MAX( 1, K-KD ), K
- WORK( I ) = WORK( I ) +
- $ ABS( AB( KD+1+I-K, K ) )*XK
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 K = 1, N
- XK = ABS( X( K, J ) )
- DO 50 I = MAX( 1, K-KD ), K - 1
- WORK( I ) = WORK( I ) +
- $ ABS( AB( KD+1+I-K, K ) )*XK
- 50 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 60 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 80 K = 1, N
- XK = ABS( X( K, J ) )
- DO 70 I = K, MIN( N, K+KD )
- WORK( I ) = WORK( I ) + ABS( AB( 1+I-K, K ) )*XK
- 70 CONTINUE
- 80 CONTINUE
- ELSE
- DO 100 K = 1, N
- XK = ABS( X( K, J ) )
- DO 90 I = K + 1, MIN( N, K+KD )
- WORK( I ) = WORK( I ) + ABS( AB( 1+I-K, K ) )*XK
- 90 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 100 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Compute abs(A**T)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 120 K = 1, N
- S = ZERO
- DO 110 I = MAX( 1, K-KD ), K
- S = S + ABS( AB( KD+1+I-K, K ) )*
- $ ABS( X( I, J ) )
- 110 CONTINUE
- WORK( K ) = WORK( K ) + S
- 120 CONTINUE
- ELSE
- DO 140 K = 1, N
- S = ABS( X( K, J ) )
- DO 130 I = MAX( 1, K-KD ), K - 1
- S = S + ABS( AB( KD+1+I-K, K ) )*
- $ ABS( X( I, J ) )
- 130 CONTINUE
- WORK( K ) = WORK( K ) + S
- 140 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 160 K = 1, N
- S = ZERO
- DO 150 I = K, MIN( N, K+KD )
- S = S + ABS( AB( 1+I-K, K ) )*ABS( X( I, J ) )
- 150 CONTINUE
- WORK( K ) = WORK( K ) + S
- 160 CONTINUE
- ELSE
- DO 180 K = 1, N
- S = ABS( X( K, J ) )
- DO 170 I = K + 1, MIN( N, K+KD )
- S = S + ABS( AB( 1+I-K, K ) )*ABS( X( I, J ) )
- 170 CONTINUE
- WORK( K ) = WORK( K ) + S
- 180 CONTINUE
- END IF
- END IF
- END IF
- S = ZERO
- DO 190 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 190 CONTINUE
- BERR( J ) = S
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 200 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 200 CONTINUE
-*
- KASE = 0
- 210 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DTBSV( UPLO, TRANST, DIAG, N, KD, AB, LDAB,
- $ WORK( N+1 ), 1 )
- DO 220 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 220 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 230 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 230 CONTINUE
- CALL DTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB,
- $ WORK( N+1 ), 1 )
- END IF
- GO TO 210
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 240 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 240 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of DTBRFS
-*
- END
diff --git a/netlib/LAPACK/dtbtrs.f b/netlib/LAPACK/dtbtrs.f
deleted file mode 100644
index 15c75d2..0000000
--- a/netlib/LAPACK/dtbtrs.f
+++ /dev/null
@@ -1,244 +0,0 @@
-*> \brief \b DTBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTBTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtbtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtbtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtbtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
-* LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTBTRS solves a triangular system of the form
-*>
-*> A * X = B or A**T * X = B,
-*>
-*> where A is a triangular band matrix of order N, and B is an
-*> N-by NRHS matrix. A check is made to verify that A is nonsingular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals or subdiagonals of the
-*> triangular band matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first kd+1 rows of AB. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the
-*> solutions X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
- $ LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOUNIT = LSAME( DIAG, 'N' )
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- IF( UPPER ) THEN
- DO 10 INFO = 1, N
- IF( AB( KD+1, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
- DO 20 INFO = 1, N
- IF( AB( 1, INFO ).EQ.ZERO )
- $ RETURN
- 20 CONTINUE
- END IF
- END IF
- INFO = 0
-*
-* Solve A * X = B or A**T * X = B.
-*
- DO 30 J = 1, NRHS
- CALL DTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 )
- 30 CONTINUE
-*
- RETURN
-*
-* End of DTBTRS
-*
- END
diff --git a/netlib/LAPACK/dtfsm.f b/netlib/LAPACK/dtfsm.f
deleted file mode 100644
index 3b5720f..0000000
--- a/netlib/LAPACK/dtfsm.f
+++ /dev/null
@@ -1,1006 +0,0 @@
-*> \brief \b DTFSM solves a matrix equation (one operand is a triangular matrix in RFP format).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTFSM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtfsm.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtfsm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtfsm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
-* B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO
-* INTEGER LDB, M, N
-* DOUBLE PRECISION ALPHA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: * ), B( 0: LDB-1, 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Level 3 BLAS like routine for A in RFP Format.
-*>
-*> DTFSM solves the matrix equation
-*>
-*> op( A )*X = alpha*B or X*op( A ) = alpha*B
-*>
-*> where alpha is a scalar, X and B are m by n matrices, A is a unit, or
-*> non-unit, upper or lower triangular matrix and op( A ) is one of
-*>
-*> op( A ) = A or op( A ) = A**T.
-*>
-*> A is in Rectangular Full Packed (RFP) Format.
-*>
-*> The matrix X is overwritten on B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal Form of RFP A is stored;
-*> = 'T': The Transpose Form of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> On entry, SIDE specifies whether op( A ) appears on the left
-*> or right of X as follows:
-*>
-*> SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*>
-*> SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the RFP matrix A came from
-*> an upper or lower triangular matrix as follows:
-*> UPLO = 'U' or 'u' RFP A came from an upper triangular matrix
-*> UPLO = 'L' or 'l' RFP A came from a lower triangular matrix
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the form of op( A ) to be used
-*> in the matrix multiplication as follows:
-*>
-*> TRANS = 'N' or 'n' op( A ) = A.
-*>
-*> TRANS = 'T' or 't' op( A ) = A'.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not RFP A is unit
-*> triangular as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of B. M must be at
-*> least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of B. N must be
-*> at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, ALPHA specifies the scalar alpha. When alpha is
-*> zero then A is not referenced and B need not be set before
-*> entry.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (NT)
-*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
-*> RFP Format is described by TRANSR, UPLO and N as follows:
-*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
-*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
-*> TRANSR = 'T' then RFP is the transpose of RFP A as
-*> defined when TRANSR = 'N'. The contents of RFP A are defined
-*> by UPLO as follows: If UPLO = 'U' the RFP A contains the NT
-*> elements of upper packed A either in normal or
-*> transpose Format. If UPLO = 'L' the RFP A contains
-*> the NT elements of lower packed A either in normal or
-*> transpose Format. The LDA of RFP A is (N+1)/2 when
-*> TRANSR = 'T'. When TRANSR is 'N' the LDA is N+1 when N is
-*> even and is N when is odd.
-*> See the Note below for more details. Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> Before entry, the leading m by n part of the array B must
-*> contain the right-hand side matrix B, and on exit is
-*> overwritten by the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> On entry, LDB specifies the first dimension of B as declared
-*> in the calling (sub) program. LDB must be at least
-*> max( 1, m ).
-*> Unchanged on exit.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
- $ B, LDB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO
- INTEGER LDB, M, N
- DOUBLE PRECISION ALPHA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: * ), B( 0: LDB-1, 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, LSIDE, MISODD, NISODD, NORMALTRANSR,
- $ NOTRANS
- INTEGER M1, M2, N1, N2, K, INFO, I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DGEMM, DTRSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LSIDE = LSAME( SIDE, 'L' )
- LOWER = LSAME( UPLO, 'L' )
- NOTRANS = LSAME( TRANS, 'N' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSIDE .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -4
- ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
- $ THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -6
- ELSE IF( N.LT.0 ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTFSM ', -INFO )
- RETURN
- END IF
-*
-* Quick return when ( (N.EQ.0).OR.(M.EQ.0) )
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
- $ RETURN
-*
-* Quick return when ALPHA.EQ.(0D+0)
-*
- IF( ALPHA.EQ.ZERO ) THEN
- DO 20 J = 0, N - 1
- DO 10 I = 0, M - 1
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
- IF( LSIDE ) THEN
-*
-* SIDE = 'L'
-*
-* A is M-by-M.
-* If M is odd, set NISODD = .TRUE., and M1 and M2.
-* If M is even, NISODD = .FALSE., and M.
-*
- IF( MOD( M, 2 ).EQ.0 ) THEN
- MISODD = .FALSE.
- K = M / 2
- ELSE
- MISODD = .TRUE.
- IF( LOWER ) THEN
- M2 = M / 2
- M1 = M - M2
- ELSE
- M1 = M / 2
- M2 = M - M1
- END IF
- END IF
-*
-*
- IF( MISODD ) THEN
-*
-* SIDE = 'L' and N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'L', N is odd, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'N'
-*
- IF( M.EQ.1 ) THEN
- CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
- $ A, M, B, LDB )
- ELSE
- CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
- $ A( 0 ), M, B, LDB )
- CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ),
- $ M, B, LDB, ALPHA, B( M1, 0 ), LDB )
- CALL DTRSM( 'L', 'U', 'T', DIAG, M2, N, ONE,
- $ A( M ), M, B( M1, 0 ), LDB )
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'T'
-*
- IF( M.EQ.1 ) THEN
- CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ALPHA,
- $ A( 0 ), M, B, LDB )
- ELSE
- CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
- $ A( M ), M, B( M1, 0 ), LDB )
- CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ),
- $ M, B( M1, 0 ), LDB, ALPHA, B, LDB )
- CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ONE,
- $ A( 0 ), M, B, LDB )
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
- $ A( M2 ), M, B, LDB )
- CALL DGEMM( 'T', 'N', M2, N, M1, -ONE, A( 0 ), M,
- $ B, LDB, ALPHA, B( M1, 0 ), LDB )
- CALL DTRSM( 'L', 'U', 'T', DIAG, M2, N, ONE,
- $ A( M1 ), M, B( M1, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
- $ A( M1 ), M, B( M1, 0 ), LDB )
- CALL DGEMM( 'N', 'N', M1, N, M2, -ONE, A( 0 ), M,
- $ B( M1, 0 ), LDB, ALPHA, B, LDB )
- CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ONE,
- $ A( M2 ), M, B, LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'L', N is odd, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'N'
-*
- IF( M.EQ.1 ) THEN
- CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA,
- $ A( 0 ), M1, B, LDB )
- ELSE
- CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA,
- $ A( 0 ), M1, B, LDB )
- CALL DGEMM( 'T', 'N', M2, N, M1, -ONE,
- $ A( M1*M1 ), M1, B, LDB, ALPHA,
- $ B( M1, 0 ), LDB )
- CALL DTRSM( 'L', 'L', 'N', DIAG, M2, N, ONE,
- $ A( 1 ), M1, B( M1, 0 ), LDB )
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'T'
-*
- IF( M.EQ.1 ) THEN
- CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA,
- $ A( 0 ), M1, B, LDB )
- ELSE
- CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA,
- $ A( 1 ), M1, B( M1, 0 ), LDB )
- CALL DGEMM( 'N', 'N', M1, N, M2, -ONE,
- $ A( M1*M1 ), M1, B( M1, 0 ), LDB,
- $ ALPHA, B, LDB )
- CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ONE,
- $ A( 0 ), M1, B, LDB )
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA,
- $ A( M2*M2 ), M2, B, LDB )
- CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( 0 ), M2,
- $ B, LDB, ALPHA, B( M1, 0 ), LDB )
- CALL DTRSM( 'L', 'L', 'N', DIAG, M2, N, ONE,
- $ A( M1*M2 ), M2, B( M1, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA,
- $ A( M1*M2 ), M2, B( M1, 0 ), LDB )
- CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( 0 ), M2,
- $ B( M1, 0 ), LDB, ALPHA, B, LDB )
- CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ONE,
- $ A( M2*M2 ), M2, B, LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'L' and N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'L', N is even, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
- $ A( 1 ), M+1, B, LDB )
- CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( K+1 ),
- $ M+1, B, LDB, ALPHA, B( K, 0 ), LDB )
- CALL DTRSM( 'L', 'U', 'T', DIAG, K, N, ONE,
- $ A( 0 ), M+1, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
- $ A( 0 ), M+1, B( K, 0 ), LDB )
- CALL DGEMM( 'T', 'N', K, N, K, -ONE, A( K+1 ),
- $ M+1, B( K, 0 ), LDB, ALPHA, B, LDB )
- CALL DTRSM( 'L', 'L', 'T', DIAG, K, N, ONE,
- $ A( 1 ), M+1, B, LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
- $ A( K+1 ), M+1, B, LDB )
- CALL DGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), M+1,
- $ B, LDB, ALPHA, B( K, 0 ), LDB )
- CALL DTRSM( 'L', 'U', 'T', DIAG, K, N, ONE,
- $ A( K ), M+1, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'T'
- CALL DTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
- $ A( K ), M+1, B( K, 0 ), LDB )
- CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), M+1,
- $ B( K, 0 ), LDB, ALPHA, B, LDB )
- CALL DTRSM( 'L', 'L', 'T', DIAG, K, N, ONE,
- $ A( K+1 ), M+1, B, LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'L', N is even, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'L', 'U', 'T', DIAG, K, N, ALPHA,
- $ A( K ), K, B, LDB )
- CALL DGEMM( 'T', 'N', K, N, K, -ONE,
- $ A( K*( K+1 ) ), K, B, LDB, ALPHA,
- $ B( K, 0 ), LDB )
- CALL DTRSM( 'L', 'L', 'N', DIAG, K, N, ONE,
- $ A( 0 ), K, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'L', 'L', 'T', DIAG, K, N, ALPHA,
- $ A( 0 ), K, B( K, 0 ), LDB )
- CALL DGEMM( 'N', 'N', K, N, K, -ONE,
- $ A( K*( K+1 ) ), K, B( K, 0 ), LDB,
- $ ALPHA, B, LDB )
- CALL DTRSM( 'L', 'U', 'N', DIAG, K, N, ONE,
- $ A( K ), K, B, LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'L', 'U', 'T', DIAG, K, N, ALPHA,
- $ A( K*( K+1 ) ), K, B, LDB )
- CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), K, B,
- $ LDB, ALPHA, B( K, 0 ), LDB )
- CALL DTRSM( 'L', 'L', 'N', DIAG, K, N, ONE,
- $ A( K*K ), K, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'L', 'L', 'T', DIAG, K, N, ALPHA,
- $ A( K*K ), K, B( K, 0 ), LDB )
- CALL DGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), K,
- $ B( K, 0 ), LDB, ALPHA, B, LDB )
- CALL DTRSM( 'L', 'U', 'N', DIAG, K, N, ONE,
- $ A( K*( K+1 ) ), K, B, LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R'
-*
-* A is N-by-N.
-* If N is odd, set NISODD = .TRUE., and N1 and N2.
-* If N is even, NISODD = .FALSE., and K.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- NISODD = .FALSE.
- K = N / 2
- ELSE
- NISODD = .TRUE.
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
- END IF
-*
- IF( NISODD ) THEN
-*
-* SIDE = 'R' and N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'R', N is odd, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'N'
-*
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA,
- $ A( N ), N, B( 0, N1 ), LDB )
- CALL DGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, N1, ONE,
- $ A( 0 ), N, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'T'
-*
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA,
- $ A( 0 ), N, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, N2, ONE,
- $ A( N ), N, B( 0, N1 ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA,
- $ A( N2 ), N, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, N2, ONE,
- $ A( N1 ), N, B( 0, N1 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA,
- $ A( N1 ), N, B( 0, N1 ), LDB )
- CALL DGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB )
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, N1, ONE,
- $ A( N2 ), N, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R', N is odd, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'N'
-*
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
- $ A( 1 ), N1, B( 0, N1 ), LDB )
- CALL DGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, N1, ONE,
- $ A( 0 ), N1, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'T'
-*
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
- $ A( 0 ), N1, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, N2, ONE,
- $ A( 1 ), N1, B( 0, N1 ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
- $ A( N2*N2 ), N2, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, N2, ONE,
- $ A( N1*N2 ), N2, B( 0, N1 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
- $ A( N1*N2 ), N2, B( 0, N1 ), LDB )
- CALL DGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, N1, ONE,
- $ A( N2*N2 ), N2, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R' and N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'R', N is even, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, K, ALPHA,
- $ A( 0 ), N+1, B( 0, K ), LDB )
- CALL DGEMM( 'N', 'N', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( K+1 ), N+1, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, K, ONE,
- $ A( 1 ), N+1, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, K, ALPHA,
- $ A( 1 ), N+1, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'T', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( K+1 ), N+1, ALPHA, B( 0, K ),
- $ LDB )
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, K, ONE,
- $ A( 0 ), N+1, B( 0, K ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, K, ALPHA,
- $ A( K+1 ), N+1, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'N', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), N+1, ALPHA, B( 0, K ),
- $ LDB )
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, K, ONE,
- $ A( K ), N+1, B( 0, K ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, K, ALPHA,
- $ A( K ), N+1, B( 0, K ), LDB )
- CALL DGEMM( 'N', 'T', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( 0 ), N+1, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, K, ONE,
- $ A( K+1 ), N+1, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R', N is even, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
- $ A( 0 ), K, B( 0, K ), LDB )
- CALL DGEMM( 'N', 'T', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( ( K+1 )*K ), K, ALPHA,
- $ B( 0, 0 ), LDB )
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, K, ONE,
- $ A( K ), K, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
- $ A( K ), K, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'N', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( ( K+1 )*K ), K, ALPHA,
- $ B( 0, K ), LDB )
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, K, ONE,
- $ A( 0 ), K, B( 0, K ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL DTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
- $ A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
- CALL DGEMM( 'N', 'T', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), K, ALPHA, B( 0, K ), LDB )
- CALL DTRSM( 'R', 'L', 'T', DIAG, M, K, ONE,
- $ A( K*K ), K, B( 0, K ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'T'
-*
- CALL DTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
- $ A( K*K ), K, B( 0, K ), LDB )
- CALL DGEMM( 'N', 'N', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( 0 ), K, ALPHA, B( 0, 0 ), LDB )
- CALL DTRSM( 'R', 'U', 'T', DIAG, M, K, ONE,
- $ A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- END IF
- END IF
-*
- RETURN
-*
-* End of DTFSM
-*
- END
diff --git a/netlib/LAPACK/dtftri.f b/netlib/LAPACK/dtftri.f
deleted file mode 100644
index a8a6a0b..0000000
--- a/netlib/LAPACK/dtftri.f
+++ /dev/null
@@ -1,472 +0,0 @@
-*> \brief \b DTFTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTFTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtftri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtftri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtftri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO, DIAG
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTFTRI computes the inverse of a triangular matrix A stored in RFP
-*> format.
-*>
-*> This is a Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (0:nt-1);
-*> nt=N*(N+1)/2. On entry, the triangular factor of a Hermitian
-*> Positive Definite matrix A in RFP format. RFP format is
-*> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N'
-*> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
-*> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is
-*> the transpose of RFP A as defined when
-*> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
-*> follows: If UPLO = 'U' the RFP A contains the nt elements of
-*> upper packed A; If UPLO = 'L' the RFP A contains the nt
-*> elements of lower packed A. The LDA of RFP A is (N+1)/2 when
-*> TRANSR = 'T'. When TRANSR is 'N' the LDA is N+1 when N is
-*> even and N is odd. See the Note below for more details.
-*>
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO, DIAG
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DTRMM, DTRTRI
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
- $ THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTFTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- ELSE
- NISODD = .TRUE.
- END IF
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(n1)
-*
- CALL DTRTRI( 'L', DIAG, N1, A( 0 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'L', 'N', DIAG, N2, N1, -ONE, A( 0 ),
- $ N, A( N1 ), N )
- CALL DTRTRI( 'U', DIAG, N2, A( N ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'U', 'T', DIAG, N2, N1, ONE, A( N ), N,
- $ A( N1 ), N )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
-* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
-* T1 -> a(n2), T2 -> a(n1), S -> a(0)
-*
- CALL DTRTRI( 'L', DIAG, N1, A( N2 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'L', 'T', DIAG, N1, N2, -ONE, A( N2 ),
- $ N, A( 0 ), N )
- CALL DTRTRI( 'U', DIAG, N2, A( N1 ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'U', 'N', DIAG, N1, N2, ONE, A( N1 ),
- $ N, A( 0 ), N )
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is odd
-* T1 -> a(0), T2 -> a(1), S -> a(0+n1*n1)
-*
- CALL DTRTRI( 'U', DIAG, N1, A( 0 ), N1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'U', 'N', DIAG, N1, N2, -ONE, A( 0 ),
- $ N1, A( N1*N1 ), N1 )
- CALL DTRTRI( 'L', DIAG, N2, A( 1 ), N1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'L', 'T', DIAG, N1, N2, ONE, A( 1 ),
- $ N1, A( N1*N1 ), N1 )
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is odd
-* T1 -> a(0+n2*n2), T2 -> a(0+n1*n2), S -> a(0)
-*
- CALL DTRTRI( 'U', DIAG, N1, A( N2*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'U', 'T', DIAG, N2, N1, -ONE,
- $ A( N2*N2 ), N2, A( 0 ), N2 )
- CALL DTRTRI( 'L', DIAG, N2, A( N1*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'L', 'N', DIAG, N2, N1, ONE,
- $ A( N1*N2 ), N2, A( 0 ), N2 )
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- CALL DTRTRI( 'L', DIAG, K, A( 1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'L', 'N', DIAG, K, K, -ONE, A( 1 ),
- $ N+1, A( K+1 ), N+1 )
- CALL DTRTRI( 'U', DIAG, K, A( 0 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'U', 'T', DIAG, K, K, ONE, A( 0 ), N+1,
- $ A( K+1 ), N+1 )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- CALL DTRTRI( 'L', DIAG, K, A( K+1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'L', 'T', DIAG, K, K, -ONE, A( K+1 ),
- $ N+1, A( 0 ), N+1 )
- CALL DTRTRI( 'U', DIAG, K, A( K ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'U', 'N', DIAG, K, K, ONE, A( K ), N+1,
- $ A( 0 ), N+1 )
- END IF
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- CALL DTRTRI( 'U', DIAG, K, A( K ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'U', 'N', DIAG, K, K, -ONE, A( K ), K,
- $ A( K*( K+1 ) ), K )
- CALL DTRTRI( 'L', DIAG, K, A( 0 ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'L', 'T', DIAG, K, K, ONE, A( 0 ), K,
- $ A( K*( K+1 ) ), K )
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- CALL DTRTRI( 'U', DIAG, K, A( K*( K+1 ) ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'R', 'U', 'T', DIAG, K, K, -ONE,
- $ A( K*( K+1 ) ), K, A( 0 ), K )
- CALL DTRTRI( 'L', DIAG, K, A( K*K ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL DTRMM( 'L', 'L', 'N', DIAG, K, K, ONE, A( K*K ), K,
- $ A( 0 ), K )
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTFTRI
-*
- END
diff --git a/netlib/LAPACK/dtfttp.f b/netlib/LAPACK/dtfttp.f
deleted file mode 100644
index 36ec09b..0000000
--- a/netlib/LAPACK/dtfttp.f
+++ /dev/null
@@ -1,517 +0,0 @@
-*> \brief \b DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTFTTP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtfttp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtfttp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtfttp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTFTTP( TRANSR, UPLO, N, ARF, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( 0: * ), ARF( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTFTTP copies a triangular matrix A from rectangular full packed
-*> format (TF) to standard packed format (TP).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF is in Normal format;
-*> = 'T': ARF is in Transpose format;
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ARF
-*> \verbatim
-*> ARF is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
-*> On entry, the upper or lower triangular matrix A stored in
-*> RFP format. For a further discussion see Notes below.
-*> \endverbatim
-*>
-*> \param[out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
-*> On exit, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTFTTP( TRANSR, UPLO, N, ARF, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( 0: * ), ARF( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K, NT
- INTEGER I, J, IJ
- INTEGER IJP, JP, LDA, JS
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTFTTP', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( NORMALTRANSR ) THEN
- AP( 0 ) = ARF( 0 )
- ELSE
- AP( 0 ) = ARF( 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:NT-1)
-*
- NT = N*( N+1 ) / 2
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
-* set lda of ARF^C; ARF^C is (0:(N+1)/2-1,0:N-noe)
-* where noe = 0 if n is even, noe = 1 if n is odd
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- LDA = N + 1
- ELSE
- NISODD = .TRUE.
- LDA = N
- END IF
-*
-* ARF^C has lda rows and n+1-noe cols
-*
- IF( .NOT.NORMALTRANSR )
- $ LDA = ( N+1 ) / 2
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(n1); lda = n
-*
- IJP = 0
- JP = 0
- DO J = 0, N2
- DO I = J, N - 1
- IJ = I + JP
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, N2 - 1
- DO J = 1 + I, N2
- IJ = I + J*LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
-* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
-* T1 -> a(n2), T2 -> a(n1), S -> a(0)
-*
- IJP = 0
- DO J = 0, N1 - 1
- IJ = N2 + J
- DO I = 0, J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = N1, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is odd
-* T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1)
-* T1 -> a(0+0) , T2 -> a(1+0) , S -> a(0+n1*n1); lda=n1
-*
- IJP = 0
- DO I = 0, N2
- DO IJ = I*( LDA+1 ), N*LDA - 1, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
- JS = 1
- DO J = 0, N2 - 1
- DO IJ = JS, JS + N2 - J - 1
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is odd
-* T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0)
-* T1 -> a(n2*n2), T2 -> a(n1*n2), S -> a(0); lda = n2
-*
- IJP = 0
- JS = N2*LDA
- DO J = 0, N1 - 1
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, N1
- DO IJ = I, I + ( N1+I )*LDA, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- IJP = 0
- JP = 0
- DO J = 0, K - 1
- DO I = J, N - 1
- IJ = 1 + I + JP
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, K - 1
- DO J = I, K - 1
- IJ = I + J*LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- IJP = 0
- DO J = 0, K - 1
- IJ = K + 1 + J
- DO I = 0, J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = K, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- IJP = 0
- DO I = 0, K - 1
- DO IJ = I + ( I+1 )*LDA, ( N+1 )*LDA - 1, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
- JS = 0
- DO J = 0, K - 1
- DO IJ = JS, JS + K - J - 1
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- IJP = 0
- JS = ( K+1 )*LDA
- DO J = 0, K - 1
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, K - 1
- DO IJ = I, I + ( K+I )*LDA, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DTFTTP
-*
- END
diff --git a/netlib/LAPACK/dtfttr.f b/netlib/LAPACK/dtfttr.f
deleted file mode 100644
index 384f680..0000000
--- a/netlib/LAPACK/dtfttr.f
+++ /dev/null
@@ -1,495 +0,0 @@
-*> \brief \b DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTFTTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtfttr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtfttr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtfttr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTFTTR copies a triangular matrix A from rectangular full packed
-*> format (TF) to standard full format (TR).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF is in Normal format;
-*> = 'T': ARF is in Transpose format.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices ARF and A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ARF
-*> \verbatim
-*> ARF is DOUBLE PRECISION array, dimension (N*(N+1)/2).
-*> On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
-*> matrix A in RFP format. See the "Notes" below for more
-*> details.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On exit, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE DTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K, NT, NX2, NP1X2
- INTEGER I, J, L, IJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTFTTR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- IF( N.EQ.1 ) THEN
- A( 0, 0 ) = ARF( 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:nt-1)
-*
- NT = N*( N+1 ) / 2
-*
-* set N1 and N2 depending on LOWER: for N even N1=N2=K
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
-* If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
-* N--by--(N+1)/2.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- IF( .NOT.LOWER )
- $ NP1X2 = N + N + 2
- ELSE
- NISODD = .TRUE.
- IF( .NOT.LOWER )
- $ NX2 = N + N
- END IF
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2
- DO I = N1, N2 + J
- A( N2+J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N
- DO J = N - 1, N1, -1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = J - N1, N1 - 1
- A( J-N1, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- IJ = IJ - NX2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2 - 1
- DO I = 0, J
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = N1 + J, N - 1
- A( I, N1+J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = N2, N - 1
- DO I = 0, N1 - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, N1
- DO I = N1, N - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, N1 - 1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = N2 + J, N - 1
- A( N2+J, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, K - 1
- DO I = K, K + J
- A( K+J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N - 1
- DO J = N - 1, K, -1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = J - K, K - 1
- A( J-K, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- IJ = IJ - NP1X2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- J = K
- DO I = K, N - 1
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = K + 1 + J, N - 1
- A( I, K+1+J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = K - 1, N - 1
- DO I = 0, K - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, K
- DO I = K, N - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = K + 1 + J, N - 1
- A( K+1+J, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-* Note that here, on exit of the loop, J = K-1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DTFTTR
-*
- END
diff --git a/netlib/LAPACK/dtgevc.f b/netlib/LAPACK/dtgevc.f
deleted file mode 100644
index a988f52..0000000
--- a/netlib/LAPACK/dtgevc.f
+++ /dev/null
@@ -1,1211 +0,0 @@
-*> \brief \b DTGEVC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGEVC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgevc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgevc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgevc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
-* LDVL, VR, LDVR, MM, M, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, SIDE
-* INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* DOUBLE PRECISION P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGEVC computes some or all of the right and/or left eigenvectors of
-*> a pair of real matrices (S,P), where S is a quasi-triangular matrix
-*> and P is upper triangular. Matrix pairs of this type are produced by
-*> the generalized Schur factorization of a matrix pair (A,B):
-*>
-*> A = Q*S*Z**T, B = Q*P*Z**T
-*>
-*> as computed by DGGHRD + DHGEQZ.
-*>
-*> The right eigenvector x and the left eigenvector y of (S,P)
-*> corresponding to an eigenvalue w are defined by:
-*>
-*> S*x = w*P*x, (y**H)*S = w*(y**H)*P,
-*>
-*> where y**H denotes the conjugate tranpose of y.
-*> The eigenvalues are not input to this routine, but are computed
-*> directly from the diagonal blocks of S and P.
-*>
-*> This routine returns the matrices X and/or Y of right and left
-*> eigenvectors of (S,P), or the products Z*X and/or Q*Y,
-*> where Z and Q are input matrices.
-*> If Q and Z are the orthogonal factors from the generalized Schur
-*> factorization of a matrix pair (A,B), then Z*X and Q*Y
-*> are the matrices of right and left eigenvectors of (A,B).
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute all right and/or left eigenvectors;
-*> = 'B': compute all right and/or left eigenvectors,
-*> backtransformed by the matrices in VR and/or VL;
-*> = 'S': compute selected right and/or left eigenvectors,
-*> specified by the logical array SELECT.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY='S', SELECT specifies the eigenvectors to be
-*> computed. If w(j) is a real eigenvalue, the corresponding
-*> real eigenvector is computed if SELECT(j) is .TRUE..
-*> If w(j) and w(j+1) are the real and imaginary parts of a
-*> complex eigenvalue, the corresponding complex eigenvector
-*> is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
-*> and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
-*> set to .FALSE..
-*> Not referenced if HOWMNY = 'A' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices S and P. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (LDS,N)
-*> The upper quasi-triangular matrix S from a generalized Schur
-*> factorization, as computed by DHGEQZ.
-*> \endverbatim
-*>
-*> \param[in] LDS
-*> \verbatim
-*> LDS is INTEGER
-*> The leading dimension of array S. LDS >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is DOUBLE PRECISION array, dimension (LDP,N)
-*> The upper triangular matrix P from a generalized Schur
-*> factorization, as computed by DHGEQZ.
-*> 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
-*> of S must be in positive diagonal form.
-*> \endverbatim
-*>
-*> \param[in] LDP
-*> \verbatim
-*> LDP is INTEGER
-*> The leading dimension of array P. LDP >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,MM)
-*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of left Schur vectors returned by DHGEQZ).
-*> On exit, if SIDE = 'L' or 'B', VL contains:
-*> if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
-*> if HOWMNY = 'B', the matrix Q*Y;
-*> if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
-*> SELECT, stored consecutively in the columns of
-*> VL, in the same order as their eigenvalues.
-*>
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part, and the second the imaginary part.
-*>
-*> Not referenced if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of array VL. LDVL >= 1, and if
-*> SIDE = 'L' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,MM)
-*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*> contain an N-by-N matrix Z (usually the orthogonal matrix Z
-*> of right Schur vectors returned by DHGEQZ).
-*>
-*> On exit, if SIDE = 'R' or 'B', VR contains:
-*> if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
-*> if HOWMNY = 'B' or 'b', the matrix Z*X;
-*> if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
-*> specified by SELECT, stored consecutively in the
-*> columns of VR, in the same order as their
-*> eigenvalues.
-*>
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part and the second the imaginary part.
-*>
-*> Not referenced if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> SIDE = 'R' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR actually
-*> used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
-*> is set to N. Each selected real eigenvector occupies one
-*> column and each selected complex eigenvector occupies two
-*> columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (6*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: the 2-by-2 block (INFO:INFO+1) does not have a complex
-*> eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Allocation of workspace:
-*> ---------- -- ---------
-*>
-*> WORK( j ) = 1-norm of j-th column of A, above the diagonal
-*> WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
-*> WORK( 2*N+1:3*N ) = real part of eigenvector
-*> WORK( 3*N+1:4*N ) = imaginary part of eigenvector
-*> WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
-*> WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
-*>
-*> Rowwise vs. columnwise solution methods:
-*> ------- -- ---------- -------- -------
-*>
-*> Finding a generalized eigenvector consists basically of solving the
-*> singular triangular system
-*>
-*> (A - w B) x = 0 (for right) or: (A - w B)**H y = 0 (for left)
-*>
-*> Consider finding the i-th right eigenvector (assume all eigenvalues
-*> are real). The equation to be solved is:
-*> n i
-*> 0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. . .,1
-*> k=j k=j
-*>
-*> where C = (A - w B) (The components v(i+1:n) are 0.)
-*>
-*> The "rowwise" method is:
-*>
-*> (1) v(i) := 1
-*> for j = i-1,. . .,1:
-*> i
-*> (2) compute s = - sum C(j,k) v(k) and
-*> k=j+1
-*>
-*> (3) v(j) := s / C(j,j)
-*>
-*> Step 2 is sometimes called the "dot product" step, since it is an
-*> inner product between the j-th row and the portion of the eigenvector
-*> that has been computed so far.
-*>
-*> The "columnwise" method consists basically in doing the sums
-*> for all the rows in parallel. As each v(j) is computed, the
-*> contribution of v(j) times the j-th column of C is added to the
-*> partial sums. Since FORTRAN arrays are stored columnwise, this has
-*> the advantage that at each step, the elements of C that are accessed
-*> are adjacent to one another, whereas with the rowwise method, the
-*> elements accessed at a step are spaced LDS (and LDP) words apart.
-*>
-*> When finding left eigenvectors, the matrix in question is the
-*> transpose of the one in storage, so the rowwise method then
-*> actually accesses columns of A and B at each step, and so is the
-*> preferred method.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
- $ LDVL, VR, LDVR, MM, M, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- DOUBLE PRECISION P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, SAFETY
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0,
- $ SAFETY = 1.0D+2 )
-* ..
-* .. Local Scalars ..
- LOGICAL COMPL, COMPR, IL2BY2, ILABAD, ILALL, ILBACK,
- $ ILBBAD, ILCOMP, ILCPLX, LSA, LSB
- INTEGER I, IBEG, IEIG, IEND, IHWMNY, IINFO, IM, ISIDE,
- $ J, JA, JC, JE, JR, JW, NA, NW
- DOUBLE PRECISION ACOEF, ACOEFA, ANORM, ASCALE, BCOEFA, BCOEFI,
- $ BCOEFR, BIG, BIGNUM, BNORM, BSCALE, CIM2A,
- $ CIM2B, CIMAGA, CIMAGB, CRE2A, CRE2B, CREALA,
- $ CREALB, DMIN, SAFMIN, SALFAR, SBETA, SCALE,
- $ SMALL, TEMP, TEMP2, TEMP2I, TEMP2R, ULP, XMAX,
- $ XSCALE
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
- $ SUMP( 2, 2 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DLABAD, DLACPY, DLAG2, DLALN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters
-*
- IF( LSAME( HOWMNY, 'A' ) ) THEN
- IHWMNY = 1
- ILALL = .TRUE.
- ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'S' ) ) THEN
- IHWMNY = 2
- ILALL = .FALSE.
- ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
- IHWMNY = 3
- ILALL = .TRUE.
- ILBACK = .TRUE.
- ELSE
- IHWMNY = -1
- ILALL = .TRUE.
- END IF
-*
- IF( LSAME( SIDE, 'R' ) ) THEN
- ISIDE = 1
- COMPL = .FALSE.
- COMPR = .TRUE.
- ELSE IF( LSAME( SIDE, 'L' ) ) THEN
- ISIDE = 2
- COMPL = .TRUE.
- COMPR = .FALSE.
- ELSE IF( LSAME( SIDE, 'B' ) ) THEN
- ISIDE = 3
- COMPL = .TRUE.
- COMPR = .TRUE.
- ELSE
- ISIDE = -1
- END IF
-*
- INFO = 0
- IF( ISIDE.LT.0 ) THEN
- INFO = -1
- ELSE IF( IHWMNY.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGEVC', -INFO )
- RETURN
- END IF
-*
-* Count the number of eigenvectors to be computed
-*
- IF( .NOT.ILALL ) THEN
- IM = 0
- ILCPLX = .FALSE.
- DO 10 J = 1, N
- IF( ILCPLX ) THEN
- ILCPLX = .FALSE.
- GO TO 10
- END IF
- IF( J.LT.N ) THEN
- IF( S( J+1, J ).NE.ZERO )
- $ ILCPLX = .TRUE.
- END IF
- IF( ILCPLX ) THEN
- IF( SELECT( J ) .OR. SELECT( J+1 ) )
- $ IM = IM + 2
- ELSE
- IF( SELECT( J ) )
- $ IM = IM + 1
- END IF
- 10 CONTINUE
- ELSE
- IM = N
- END IF
-*
-* Check 2-by-2 diagonal blocks of A, B
-*
- ILABAD = .FALSE.
- ILBBAD = .FALSE.
- DO 20 J = 1, N - 1
- IF( S( J+1, J ).NE.ZERO ) THEN
- IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
- $ P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
- IF( J.LT.N-1 ) THEN
- IF( S( J+2, J+1 ).NE.ZERO )
- $ ILABAD = .TRUE.
- END IF
- END IF
- 20 CONTINUE
-*
- IF( ILABAD ) THEN
- INFO = -5
- ELSE IF( ILBBAD ) THEN
- INFO = -7
- ELSE IF( COMPL .AND. LDVL.LT.N .OR. LDVL.LT.1 ) THEN
- INFO = -10
- ELSE IF( COMPR .AND. LDVR.LT.N .OR. LDVR.LT.1 ) THEN
- INFO = -12
- ELSE IF( MM.LT.IM ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGEVC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = IM
- IF( N.EQ.0 )
- $ RETURN
-*
-* Machine Constants
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- BIG = ONE / SAFMIN
- CALL DLABAD( SAFMIN, BIG )
- ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
- SMALL = SAFMIN*N / ULP
- BIG = ONE / SMALL
- BIGNUM = ONE / ( SAFMIN*N )
-*
-* Compute the 1-norm of each column of the strictly upper triangular
-* part (i.e., excluding all elements belonging to the diagonal
-* blocks) of A and B to check for possible overflow in the
-* triangular solver.
-*
- ANORM = ABS( S( 1, 1 ) )
- IF( N.GT.1 )
- $ ANORM = ANORM + ABS( S( 2, 1 ) )
- BNORM = ABS( P( 1, 1 ) )
- WORK( 1 ) = ZERO
- WORK( N+1 ) = ZERO
-*
- DO 50 J = 2, N
- TEMP = ZERO
- TEMP2 = ZERO
- IF( S( J, J-1 ).EQ.ZERO ) THEN
- IEND = J - 1
- ELSE
- IEND = J - 2
- END IF
- DO 30 I = 1, IEND
- TEMP = TEMP + ABS( S( I, J ) )
- TEMP2 = TEMP2 + ABS( P( I, J ) )
- 30 CONTINUE
- WORK( J ) = TEMP
- WORK( N+J ) = TEMP2
- DO 40 I = IEND + 1, MIN( J+1, N )
- TEMP = TEMP + ABS( S( I, J ) )
- TEMP2 = TEMP2 + ABS( P( I, J ) )
- 40 CONTINUE
- ANORM = MAX( ANORM, TEMP )
- BNORM = MAX( BNORM, TEMP2 )
- 50 CONTINUE
-*
- ASCALE = ONE / MAX( ANORM, SAFMIN )
- BSCALE = ONE / MAX( BNORM, SAFMIN )
-*
-* Left eigenvectors
-*
- IF( COMPL ) THEN
- IEIG = 0
-*
-* Main loop over eigenvalues
-*
- ILCPLX = .FALSE.
- DO 220 JE = 1, N
-*
-* Skip this iteration if (a) HOWMNY='S' and SELECT=.FALSE., or
-* (b) this would be the second of a complex pair.
-* Check for complex eigenvalue, so as to be sure of which
-* entry(-ies) of SELECT to look at.
-*
- IF( ILCPLX ) THEN
- ILCPLX = .FALSE.
- GO TO 220
- END IF
- NW = 1
- IF( JE.LT.N ) THEN
- IF( S( JE+1, JE ).NE.ZERO ) THEN
- ILCPLX = .TRUE.
- NW = 2
- END IF
- END IF
- IF( ILALL ) THEN
- ILCOMP = .TRUE.
- ELSE IF( ILCPLX ) THEN
- ILCOMP = SELECT( JE ) .OR. SELECT( JE+1 )
- ELSE
- ILCOMP = SELECT( JE )
- END IF
- IF( .NOT.ILCOMP )
- $ GO TO 220
-*
-* Decide if (a) singular pencil, (b) real eigenvalue, or
-* (c) complex eigenvalue.
-*
- IF( .NOT.ILCPLX ) THEN
- IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
-*
-* Singular matrix pencil -- return unit eigenvector
-*
- IEIG = IEIG + 1
- DO 60 JR = 1, N
- VL( JR, IEIG ) = ZERO
- 60 CONTINUE
- VL( IEIG, IEIG ) = ONE
- GO TO 220
- END IF
- END IF
-*
-* Clear vector
-*
- DO 70 JR = 1, NW*N
- WORK( 2*N+JR ) = ZERO
- 70 CONTINUE
-* T
-* Compute coefficients in ( a A - b B ) y = 0
-* a is ACOEF
-* b is BCOEFR + i*BCOEFI
-*
- IF( .NOT.ILCPLX ) THEN
-*
-* Real eigenvalue
-*
- TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
- $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
- SBETA = ( TEMP*P( JE, JE ) )*BSCALE
- ACOEF = SBETA*ASCALE
- BCOEFR = SALFAR*BSCALE
- BCOEFI = ZERO
-*
-* Scale to avoid underflow
-*
- SCALE = ONE
- LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEF ).LT.SMALL
- LSB = ABS( SALFAR ).GE.SAFMIN .AND. ABS( BCOEFR ).LT.
- $ SMALL
- IF( LSA )
- $ SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
- IF( LSB )
- $ SCALE = MAX( SCALE, ( SMALL / ABS( SALFAR ) )*
- $ MIN( BNORM, BIG ) )
- IF( LSA .OR. LSB ) THEN
- SCALE = MIN( SCALE, ONE /
- $ ( SAFMIN*MAX( ONE, ABS( ACOEF ),
- $ ABS( BCOEFR ) ) ) )
- IF( LSA ) THEN
- ACOEF = ASCALE*( SCALE*SBETA )
- ELSE
- ACOEF = SCALE*ACOEF
- END IF
- IF( LSB ) THEN
- BCOEFR = BSCALE*( SCALE*SALFAR )
- ELSE
- BCOEFR = SCALE*BCOEFR
- END IF
- END IF
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR )
-*
-* First component is 1
-*
- WORK( 2*N+JE ) = ONE
- XMAX = ONE
- ELSE
-*
-* Complex eigenvalue
-*
- CALL DLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
- $ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
- $ BCOEFI )
- BCOEFI = -BCOEFI
- IF( BCOEFI.EQ.ZERO ) THEN
- INFO = JE
- RETURN
- END IF
-*
-* Scale to avoid over/underflow
-*
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- SCALE = ONE
- IF( ACOEFA*ULP.LT.SAFMIN .AND. ACOEFA.GE.SAFMIN )
- $ SCALE = ( SAFMIN / ULP ) / ACOEFA
- IF( BCOEFA*ULP.LT.SAFMIN .AND. BCOEFA.GE.SAFMIN )
- $ SCALE = MAX( SCALE, ( SAFMIN / ULP ) / BCOEFA )
- IF( SAFMIN*ACOEFA.GT.ASCALE )
- $ SCALE = ASCALE / ( SAFMIN*ACOEFA )
- IF( SAFMIN*BCOEFA.GT.BSCALE )
- $ SCALE = MIN( SCALE, BSCALE / ( SAFMIN*BCOEFA ) )
- IF( SCALE.NE.ONE ) THEN
- ACOEF = SCALE*ACOEF
- ACOEFA = ABS( ACOEF )
- BCOEFR = SCALE*BCOEFR
- BCOEFI = SCALE*BCOEFI
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- END IF
-*
-* Compute first two components of eigenvector
-*
- TEMP = ACOEF*S( JE+1, JE )
- TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
- TEMP2I = -BCOEFI*P( JE, JE )
- IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
- WORK( 2*N+JE ) = ONE
- WORK( 3*N+JE ) = ZERO
- WORK( 2*N+JE+1 ) = -TEMP2R / TEMP
- WORK( 3*N+JE+1 ) = -TEMP2I / TEMP
- ELSE
- WORK( 2*N+JE+1 ) = ONE
- WORK( 3*N+JE+1 ) = ZERO
- TEMP = ACOEF*S( JE, JE+1 )
- WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
- $ S( JE+1, JE+1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
- END IF
- XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
- $ ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
- END IF
-*
- DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-* T
-* Triangular solve of (a A - b B) y = 0
-*
-* T
-* (rowwise in (a A - b B) , or columnwise in (a A - b B) )
-*
- IL2BY2 = .FALSE.
-*
- DO 160 J = JE + NW, N
- IF( IL2BY2 ) THEN
- IL2BY2 = .FALSE.
- GO TO 160
- END IF
-*
- NA = 1
- BDIAG( 1 ) = P( J, J )
- IF( J.LT.N ) THEN
- IF( S( J+1, J ).NE.ZERO ) THEN
- IL2BY2 = .TRUE.
- BDIAG( 2 ) = P( J+1, J+1 )
- NA = 2
- END IF
- END IF
-*
-* Check whether scaling is necessary for dot products
-*
- XSCALE = ONE / MAX( ONE, XMAX )
- TEMP = MAX( WORK( J ), WORK( N+J ),
- $ ACOEFA*WORK( J )+BCOEFA*WORK( N+J ) )
- IF( IL2BY2 )
- $ TEMP = MAX( TEMP, WORK( J+1 ), WORK( N+J+1 ),
- $ ACOEFA*WORK( J+1 )+BCOEFA*WORK( N+J+1 ) )
- IF( TEMP.GT.BIGNUM*XSCALE ) THEN
- DO 90 JW = 0, NW - 1
- DO 80 JR = JE, J - 1
- WORK( ( JW+2 )*N+JR ) = XSCALE*
- $ WORK( ( JW+2 )*N+JR )
- 80 CONTINUE
- 90 CONTINUE
- XMAX = XMAX*XSCALE
- END IF
-*
-* Compute dot products
-*
-* j-1
-* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
-* k=je
-*
-* To reduce the op count, this is done as
-*
-* _ j-1 _ j-1
-* a*conjg( sum S(k,j)*x(k) ) - b*conjg( sum P(k,j)*x(k) )
-* k=je k=je
-*
-* which may cause underflow problems if A or B are close
-* to underflow. (E.g., less than SMALL.)
-*
-*
- DO 120 JW = 1, NW
- DO 110 JA = 1, NA
- SUMS( JA, JW ) = ZERO
- SUMP( JA, JW ) = ZERO
-*
- DO 100 JR = JE, J - 1
- SUMS( JA, JW ) = SUMS( JA, JW ) +
- $ S( JR, J+JA-1 )*
- $ WORK( ( JW+1 )*N+JR )
- SUMP( JA, JW ) = SUMP( JA, JW ) +
- $ P( JR, J+JA-1 )*
- $ WORK( ( JW+1 )*N+JR )
- 100 CONTINUE
- 110 CONTINUE
- 120 CONTINUE
-*
- DO 130 JA = 1, NA
- IF( ILCPLX ) THEN
- SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
- $ BCOEFR*SUMP( JA, 1 ) -
- $ BCOEFI*SUMP( JA, 2 )
- SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
- $ BCOEFR*SUMP( JA, 2 ) +
- $ BCOEFI*SUMP( JA, 1 )
- ELSE
- SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
- $ BCOEFR*SUMP( JA, 1 )
- END IF
- 130 CONTINUE
-*
-* T
-* Solve ( a A - b B ) y = SUM(,)
-* with scaling and perturbation of the denominator
-*
- CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
- $ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
- $ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
- $ IINFO )
- IF( SCALE.LT.ONE ) THEN
- DO 150 JW = 0, NW - 1
- DO 140 JR = JE, J - 1
- WORK( ( JW+2 )*N+JR ) = SCALE*
- $ WORK( ( JW+2 )*N+JR )
- 140 CONTINUE
- 150 CONTINUE
- XMAX = SCALE*XMAX
- END IF
- XMAX = MAX( XMAX, TEMP )
- 160 CONTINUE
-*
-* Copy eigenvector to VL, back transforming if
-* HOWMNY='B'.
-*
- IEIG = IEIG + 1
- IF( ILBACK ) THEN
- DO 170 JW = 0, NW - 1
- CALL DGEMV( 'N', N, N+1-JE, ONE, VL( 1, JE ), LDVL,
- $ WORK( ( JW+2 )*N+JE ), 1, ZERO,
- $ WORK( ( JW+4 )*N+1 ), 1 )
- 170 CONTINUE
- CALL DLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, JE ),
- $ LDVL )
- IBEG = 1
- ELSE
- CALL DLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, IEIG ),
- $ LDVL )
- IBEG = JE
- END IF
-*
-* Scale eigenvector
-*
- XMAX = ZERO
- IF( ILCPLX ) THEN
- DO 180 J = IBEG, N
- XMAX = MAX( XMAX, ABS( VL( J, IEIG ) )+
- $ ABS( VL( J, IEIG+1 ) ) )
- 180 CONTINUE
- ELSE
- DO 190 J = IBEG, N
- XMAX = MAX( XMAX, ABS( VL( J, IEIG ) ) )
- 190 CONTINUE
- END IF
-*
- IF( XMAX.GT.SAFMIN ) THEN
- XSCALE = ONE / XMAX
-*
- DO 210 JW = 0, NW - 1
- DO 200 JR = IBEG, N
- VL( JR, IEIG+JW ) = XSCALE*VL( JR, IEIG+JW )
- 200 CONTINUE
- 210 CONTINUE
- END IF
- IEIG = IEIG + NW - 1
-*
- 220 CONTINUE
- END IF
-*
-* Right eigenvectors
-*
- IF( COMPR ) THEN
- IEIG = IM + 1
-*
-* Main loop over eigenvalues
-*
- ILCPLX = .FALSE.
- DO 500 JE = N, 1, -1
-*
-* Skip this iteration if (a) HOWMNY='S' and SELECT=.FALSE., or
-* (b) this would be the second of a complex pair.
-* Check for complex eigenvalue, so as to be sure of which
-* entry(-ies) of SELECT to look at -- if complex, SELECT(JE)
-* or SELECT(JE-1).
-* If this is a complex pair, the 2-by-2 diagonal block
-* corresponding to the eigenvalue is in rows/columns JE-1:JE
-*
- IF( ILCPLX ) THEN
- ILCPLX = .FALSE.
- GO TO 500
- END IF
- NW = 1
- IF( JE.GT.1 ) THEN
- IF( S( JE, JE-1 ).NE.ZERO ) THEN
- ILCPLX = .TRUE.
- NW = 2
- END IF
- END IF
- IF( ILALL ) THEN
- ILCOMP = .TRUE.
- ELSE IF( ILCPLX ) THEN
- ILCOMP = SELECT( JE ) .OR. SELECT( JE-1 )
- ELSE
- ILCOMP = SELECT( JE )
- END IF
- IF( .NOT.ILCOMP )
- $ GO TO 500
-*
-* Decide if (a) singular pencil, (b) real eigenvalue, or
-* (c) complex eigenvalue.
-*
- IF( .NOT.ILCPLX ) THEN
- IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
-*
-* Singular matrix pencil -- unit eigenvector
-*
- IEIG = IEIG - 1
- DO 230 JR = 1, N
- VR( JR, IEIG ) = ZERO
- 230 CONTINUE
- VR( IEIG, IEIG ) = ONE
- GO TO 500
- END IF
- END IF
-*
-* Clear vector
-*
- DO 250 JW = 0, NW - 1
- DO 240 JR = 1, N
- WORK( ( JW+2 )*N+JR ) = ZERO
- 240 CONTINUE
- 250 CONTINUE
-*
-* Compute coefficients in ( a A - b B ) x = 0
-* a is ACOEF
-* b is BCOEFR + i*BCOEFI
-*
- IF( .NOT.ILCPLX ) THEN
-*
-* Real eigenvalue
-*
- TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
- $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
- SBETA = ( TEMP*P( JE, JE ) )*BSCALE
- ACOEF = SBETA*ASCALE
- BCOEFR = SALFAR*BSCALE
- BCOEFI = ZERO
-*
-* Scale to avoid underflow
-*
- SCALE = ONE
- LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEF ).LT.SMALL
- LSB = ABS( SALFAR ).GE.SAFMIN .AND. ABS( BCOEFR ).LT.
- $ SMALL
- IF( LSA )
- $ SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
- IF( LSB )
- $ SCALE = MAX( SCALE, ( SMALL / ABS( SALFAR ) )*
- $ MIN( BNORM, BIG ) )
- IF( LSA .OR. LSB ) THEN
- SCALE = MIN( SCALE, ONE /
- $ ( SAFMIN*MAX( ONE, ABS( ACOEF ),
- $ ABS( BCOEFR ) ) ) )
- IF( LSA ) THEN
- ACOEF = ASCALE*( SCALE*SBETA )
- ELSE
- ACOEF = SCALE*ACOEF
- END IF
- IF( LSB ) THEN
- BCOEFR = BSCALE*( SCALE*SALFAR )
- ELSE
- BCOEFR = SCALE*BCOEFR
- END IF
- END IF
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR )
-*
-* First component is 1
-*
- WORK( 2*N+JE ) = ONE
- XMAX = ONE
-*
-* Compute contribution from column JE of A and B to sum
-* (See "Further Details", above.)
-*
- DO 260 JR = 1, JE - 1
- WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
- $ ACOEF*S( JR, JE )
- 260 CONTINUE
- ELSE
-*
-* Complex eigenvalue
-*
- CALL DLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
- $ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
- $ BCOEFI )
- IF( BCOEFI.EQ.ZERO ) THEN
- INFO = JE - 1
- RETURN
- END IF
-*
-* Scale to avoid over/underflow
-*
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- SCALE = ONE
- IF( ACOEFA*ULP.LT.SAFMIN .AND. ACOEFA.GE.SAFMIN )
- $ SCALE = ( SAFMIN / ULP ) / ACOEFA
- IF( BCOEFA*ULP.LT.SAFMIN .AND. BCOEFA.GE.SAFMIN )
- $ SCALE = MAX( SCALE, ( SAFMIN / ULP ) / BCOEFA )
- IF( SAFMIN*ACOEFA.GT.ASCALE )
- $ SCALE = ASCALE / ( SAFMIN*ACOEFA )
- IF( SAFMIN*BCOEFA.GT.BSCALE )
- $ SCALE = MIN( SCALE, BSCALE / ( SAFMIN*BCOEFA ) )
- IF( SCALE.NE.ONE ) THEN
- ACOEF = SCALE*ACOEF
- ACOEFA = ABS( ACOEF )
- BCOEFR = SCALE*BCOEFR
- BCOEFI = SCALE*BCOEFI
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- END IF
-*
-* Compute first two components of eigenvector
-* and contribution to sums
-*
- TEMP = ACOEF*S( JE, JE-1 )
- TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
- TEMP2I = -BCOEFI*P( JE, JE )
- IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
- WORK( 2*N+JE ) = ONE
- WORK( 3*N+JE ) = ZERO
- WORK( 2*N+JE-1 ) = -TEMP2R / TEMP
- WORK( 3*N+JE-1 ) = -TEMP2I / TEMP
- ELSE
- WORK( 2*N+JE-1 ) = ONE
- WORK( 3*N+JE-1 ) = ZERO
- TEMP = ACOEF*S( JE-1, JE )
- WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
- $ S( JE-1, JE-1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
- END IF
-*
- XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
- $ ABS( WORK( 2*N+JE-1 ) )+ABS( WORK( 3*N+JE-1 ) ) )
-*
-* Compute contribution from columns JE and JE-1
-* of A and B to the sums.
-*
- CREALA = ACOEF*WORK( 2*N+JE-1 )
- CIMAGA = ACOEF*WORK( 3*N+JE-1 )
- CREALB = BCOEFR*WORK( 2*N+JE-1 ) -
- $ BCOEFI*WORK( 3*N+JE-1 )
- CIMAGB = BCOEFI*WORK( 2*N+JE-1 ) +
- $ BCOEFR*WORK( 3*N+JE-1 )
- CRE2A = ACOEF*WORK( 2*N+JE )
- CIM2A = ACOEF*WORK( 3*N+JE )
- CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
- CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
- DO 270 JR = 1, JE - 2
- WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
- $ CREALB*P( JR, JE-1 ) -
- $ CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
- WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
- $ CIMAGB*P( JR, JE-1 ) -
- $ CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
- 270 CONTINUE
- END IF
-*
- DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-* Columnwise triangular solve of (a A - b B) x = 0
-*
- IL2BY2 = .FALSE.
- DO 370 J = JE - NW, 1, -1
-*
-* If a 2-by-2 block, is in position j-1:j, wait until
-* next iteration to process it (when it will be j:j+1)
-*
- IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
- IF( S( J, J-1 ).NE.ZERO ) THEN
- IL2BY2 = .TRUE.
- GO TO 370
- END IF
- END IF
- BDIAG( 1 ) = P( J, J )
- IF( IL2BY2 ) THEN
- NA = 2
- BDIAG( 2 ) = P( J+1, J+1 )
- ELSE
- NA = 1
- END IF
-*
-* Compute x(j) (and x(j+1), if 2-by-2 block)
-*
- CALL DLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
- $ LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
- $ N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
- $ IINFO )
- IF( SCALE.LT.ONE ) THEN
-*
- DO 290 JW = 0, NW - 1
- DO 280 JR = 1, JE
- WORK( ( JW+2 )*N+JR ) = SCALE*
- $ WORK( ( JW+2 )*N+JR )
- 280 CONTINUE
- 290 CONTINUE
- END IF
- XMAX = MAX( SCALE*XMAX, TEMP )
-*
- DO 310 JW = 1, NW
- DO 300 JA = 1, NA
- WORK( ( JW+1 )*N+J+JA-1 ) = SUM( JA, JW )
- 300 CONTINUE
- 310 CONTINUE
-*
-* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
-*
- IF( J.GT.1 ) THEN
-*
-* Check whether scaling is necessary for sum.
-*
- XSCALE = ONE / MAX( ONE, XMAX )
- TEMP = ACOEFA*WORK( J ) + BCOEFA*WORK( N+J )
- IF( IL2BY2 )
- $ TEMP = MAX( TEMP, ACOEFA*WORK( J+1 )+BCOEFA*
- $ WORK( N+J+1 ) )
- TEMP = MAX( TEMP, ACOEFA, BCOEFA )
- IF( TEMP.GT.BIGNUM*XSCALE ) THEN
-*
- DO 330 JW = 0, NW - 1
- DO 320 JR = 1, JE
- WORK( ( JW+2 )*N+JR ) = XSCALE*
- $ WORK( ( JW+2 )*N+JR )
- 320 CONTINUE
- 330 CONTINUE
- XMAX = XMAX*XSCALE
- END IF
-*
-* Compute the contributions of the off-diagonals of
-* column j (and j+1, if 2-by-2 block) of A and B to the
-* sums.
-*
-*
- DO 360 JA = 1, NA
- IF( ILCPLX ) THEN
- CREALA = ACOEF*WORK( 2*N+J+JA-1 )
- CIMAGA = ACOEF*WORK( 3*N+J+JA-1 )
- CREALB = BCOEFR*WORK( 2*N+J+JA-1 ) -
- $ BCOEFI*WORK( 3*N+J+JA-1 )
- CIMAGB = BCOEFI*WORK( 2*N+J+JA-1 ) +
- $ BCOEFR*WORK( 3*N+J+JA-1 )
- DO 340 JR = 1, J - 1
- WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*S( JR, J+JA-1 ) +
- $ CREALB*P( JR, J+JA-1 )
- WORK( 3*N+JR ) = WORK( 3*N+JR ) -
- $ CIMAGA*S( JR, J+JA-1 ) +
- $ CIMAGB*P( JR, J+JA-1 )
- 340 CONTINUE
- ELSE
- CREALA = ACOEF*WORK( 2*N+J+JA-1 )
- CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
- DO 350 JR = 1, J - 1
- WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*S( JR, J+JA-1 ) +
- $ CREALB*P( JR, J+JA-1 )
- 350 CONTINUE
- END IF
- 360 CONTINUE
- END IF
-*
- IL2BY2 = .FALSE.
- 370 CONTINUE
-*
-* Copy eigenvector to VR, back transforming if
-* HOWMNY='B'.
-*
- IEIG = IEIG - NW
- IF( ILBACK ) THEN
-*
- DO 410 JW = 0, NW - 1
- DO 380 JR = 1, N
- WORK( ( JW+4 )*N+JR ) = WORK( ( JW+2 )*N+1 )*
- $ VR( JR, 1 )
- 380 CONTINUE
-*
-* A series of compiler directives to defeat
-* vectorization for the next loop
-*
-*
- DO 400 JC = 2, JE
- DO 390 JR = 1, N
- WORK( ( JW+4 )*N+JR ) = WORK( ( JW+4 )*N+JR ) +
- $ WORK( ( JW+2 )*N+JC )*VR( JR, JC )
- 390 CONTINUE
- 400 CONTINUE
- 410 CONTINUE
-*
- DO 430 JW = 0, NW - 1
- DO 420 JR = 1, N
- VR( JR, IEIG+JW ) = WORK( ( JW+4 )*N+JR )
- 420 CONTINUE
- 430 CONTINUE
-*
- IEND = N
- ELSE
- DO 450 JW = 0, NW - 1
- DO 440 JR = 1, N
- VR( JR, IEIG+JW ) = WORK( ( JW+2 )*N+JR )
- 440 CONTINUE
- 450 CONTINUE
-*
- IEND = JE
- END IF
-*
-* Scale eigenvector
-*
- XMAX = ZERO
- IF( ILCPLX ) THEN
- DO 460 J = 1, IEND
- XMAX = MAX( XMAX, ABS( VR( J, IEIG ) )+
- $ ABS( VR( J, IEIG+1 ) ) )
- 460 CONTINUE
- ELSE
- DO 470 J = 1, IEND
- XMAX = MAX( XMAX, ABS( VR( J, IEIG ) ) )
- 470 CONTINUE
- END IF
-*
- IF( XMAX.GT.SAFMIN ) THEN
- XSCALE = ONE / XMAX
- DO 490 JW = 0, NW - 1
- DO 480 JR = 1, IEND
- VR( JR, IEIG+JW ) = XSCALE*VR( JR, IEIG+JW )
- 480 CONTINUE
- 490 CONTINUE
- END IF
- 500 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DTGEVC
-*
- END
diff --git a/netlib/LAPACK/dtgex2.f b/netlib/LAPACK/dtgex2.f
deleted file mode 100644
index a581339..0000000
--- a/netlib/LAPACK/dtgex2.f
+++ /dev/null
@@ -1,699 +0,0 @@
-*> \brief \b DTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGEX2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgex2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgex2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgex2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-* LDZ, J1, N1, N2, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ, WANTZ
-* INTEGER INFO, J1, LDA, LDB, LDQ, LDZ, LWORK, N, N1, N2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
-*> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
-*> (A, B) by an orthogonal equivalence transformation.
-*>
-*> (A, B) must be in generalized real Schur canonical form (as returned
-*> by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
-*> diagonal blocks. B is upper triangular.
-*>
-*> Optionally, the matrices Q and Z of generalized Schur vectors are
-*> updated.
-*>
-*> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T
-*> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> .TRUE. : update the left transformation matrix Q;
-*> .FALSE.: do not update Q.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> .TRUE. : update the right transformation matrix Z;
-*> .FALSE.: do not update Z.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimensions (LDA,N)
-*> On entry, the matrix A in the pair (A, B).
-*> On exit, the updated matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimensions (LDB,N)
-*> On entry, the matrix B in the pair (A, B).
-*> On exit, the updated matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
-*> On exit, the updated matrix Q.
-*> Not referenced if WANTQ = .FALSE..
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1.
-*> If WANTQ = .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
-*> On exit, the updated matrix Z.
-*> Not referenced if WANTZ = .FALSE..
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If WANTZ = .TRUE., LDZ >= N.
-*> \endverbatim
-*>
-*> \param[in] J1
-*> \verbatim
-*> J1 is INTEGER
-*> The index to the first block (A11, B11). 1 <= J1 <= N.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The order of the first block (A11, B11). N1 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> The order of the second block (A22, B22). N2 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= MAX( 1, N*(N2+N1), (N2+N1)*(N2+N1)*2 )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: Successful exit
-*> >0: If INFO = 1, the transformed matrix (A, B) would be
-*> too far from generalized Schur form; the blocks are
-*> not swapped and (A, B) and (Q, Z) are unchanged.
-*> The problem of swapping is too ill-conditioned.
-*> <0: If INFO = -16: LWORK is too small. Appropriate value
-*> for LWORK is returned in WORK(1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleGEauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> In the current code both weak and strong stability tests are
-*> performed. The user can omit the strong stability test by changing
-*> the internal logical parameter WANDS to .FALSE.. See ref. [2] for
-*> details.
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*>
-*> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*> Estimation: Theory, Algorithms and Software,
-*> Report UMINF - 94.04, Department of Computing Science, Umea
-*> University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*> Note 87. To appear in Numerical Algorithms, 1996.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, J1, N1, N2, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ, WANTZ
- INTEGER INFO, J1, LDA, LDB, LDQ, LDZ, LWORK, N, N1, N2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-* Replaced various illegal calls to DCOPY by calls to DLASET, or by DO
-* loops. Sven Hammarling, 1/5/02.
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TWENTY
- PARAMETER ( TWENTY = 2.0D+01 )
- INTEGER LDST
- PARAMETER ( LDST = 4 )
- LOGICAL WANDS
- PARAMETER ( WANDS = .TRUE. )
-* ..
-* .. Local Scalars ..
- LOGICAL DTRONG, WEAK
- INTEGER I, IDUM, LINFO, M
- DOUBLE PRECISION BQRA21, BRQA21, DDUM, DNORM, DSCALE, DSUM, EPS,
- $ F, G, SA, SB, SCALE, SMLNUM, SS, THRESH, WS
-* ..
-* .. Local Arrays ..
- INTEGER IWORK( LDST )
- DOUBLE PRECISION AI( 2 ), AR( 2 ), BE( 2 ), IR( LDST, LDST ),
- $ IRCOP( LDST, LDST ), LI( LDST, LDST ),
- $ LICOP( LDST, LDST ), S( LDST, LDST ),
- $ SCPY( LDST, LDST ), T( LDST, LDST ),
- $ TAUL( LDST ), TAUR( LDST ), TCPY( LDST, LDST )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGEQR2, DGERQ2, DLACPY, DLAGV2, DLARTG,
- $ DLASET, DLASSQ, DORG2R, DORGR2, DORM2R, DORMR2,
- $ DROT, DSCAL, DTGSY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.LE.1 .OR. N1.LE.0 .OR. N2.LE.0 )
- $ RETURN
- IF( N1.GT.N .OR. ( J1+N1 ).GT.N )
- $ RETURN
- M = N1 + N2
- IF( LWORK.LT.MAX( 1, N*M, M*M*2 ) ) THEN
- INFO = -16
- WORK( 1 ) = MAX( 1, N*M, M*M*2 )
- RETURN
- END IF
-*
- WEAK = .FALSE.
- DTRONG = .FALSE.
-*
-* Make a local copy of selected block
-*
- CALL DLASET( 'Full', LDST, LDST, ZERO, ZERO, LI, LDST )
- CALL DLASET( 'Full', LDST, LDST, ZERO, ZERO, IR, LDST )
- CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, S, LDST )
- CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, T, LDST )
-*
-* Compute threshold for testing acceptance of swapping.
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- DSCALE = ZERO
- DSUM = ONE
- CALL DLACPY( 'Full', M, M, S, LDST, WORK, M )
- CALL DLASSQ( M*M, WORK, 1, DSCALE, DSUM )
- CALL DLACPY( 'Full', M, M, T, LDST, WORK, M )
- CALL DLASSQ( M*M, WORK, 1, DSCALE, DSUM )
- DNORM = DSCALE*SQRT( DSUM )
-*
-* THRES has been changed from
-* THRESH = MAX( TEN*EPS*SA, SMLNUM )
-* to
-* THRESH = MAX( TWENTY*EPS*SA, SMLNUM )
-* on 04/01/10.
-* "Bug" reported by Ondra Kamenik, confirmed by Julie Langou, fixed by
-* Jim Demmel and Guillaume Revy. See forum post 1783.
-*
- THRESH = MAX( TWENTY*EPS*DNORM, SMLNUM )
-*
- IF( M.EQ.2 ) THEN
-*
-* CASE 1: Swap 1-by-1 and 1-by-1 blocks.
-*
-* Compute orthogonal QL and RQ that swap 1-by-1 and 1-by-1 blocks
-* using Givens rotations and perform the swap tentatively.
-*
- F = S( 2, 2 )*T( 1, 1 ) - T( 2, 2 )*S( 1, 1 )
- G = S( 2, 2 )*T( 1, 2 ) - T( 2, 2 )*S( 1, 2 )
- SB = ABS( T( 2, 2 ) )
- SA = ABS( S( 2, 2 ) )
- CALL DLARTG( F, G, IR( 1, 2 ), IR( 1, 1 ), DDUM )
- IR( 2, 1 ) = -IR( 1, 2 )
- IR( 2, 2 ) = IR( 1, 1 )
- CALL DROT( 2, S( 1, 1 ), 1, S( 1, 2 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- CALL DROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- IF( SA.GE.SB ) THEN
- CALL DLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
- $ DDUM )
- ELSE
- CALL DLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
- $ DDUM )
- END IF
- CALL DROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, LI( 1, 1 ),
- $ LI( 2, 1 ) )
- CALL DROT( 2, T( 1, 1 ), LDST, T( 2, 1 ), LDST, LI( 1, 1 ),
- $ LI( 2, 1 ) )
- LI( 2, 2 ) = LI( 1, 1 )
- LI( 1, 2 ) = -LI( 2, 1 )
-*
-* Weak stability test:
-* |S21| + |T21| <= O(EPS * F-norm((S, T)))
-*
- WS = ABS( S( 2, 1 ) ) + ABS( T( 2, 1 ) )
- WEAK = WS.LE.THRESH
- IF( .NOT.WEAK )
- $ GO TO 70
-*
- IF( WANDS ) THEN
-*
-* Strong stability test:
-* F-norm((A-QL**T*S*QR, B-QL**T*T*QR)) <= O(EPS*F-norm((A,B)))
-*
- CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
- $ M )
- CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
- $ WORK, M )
- CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- DSCALE = ZERO
- DSUM = ONE
- CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-*
- CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
- $ M )
- CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
- SS = DSCALE*SQRT( DSUM )
- DTRONG = SS.LE.THRESH
- IF( .NOT.DTRONG )
- $ GO TO 70
- END IF
-*
-* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
-* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
-*
- CALL DROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- CALL DROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- CALL DROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA,
- $ LI( 1, 1 ), LI( 2, 1 ) )
- CALL DROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB,
- $ LI( 1, 1 ), LI( 2, 1 ) )
-*
-* Set N1-by-N2 (2,1) - blocks to ZERO.
-*
- A( J1+1, J1 ) = ZERO
- B( J1+1, J1 ) = ZERO
-*
-* Accumulate transformations into Q and Z if requested.
-*
- IF( WANTZ )
- $ CALL DROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- IF( WANTQ )
- $ CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, LI( 1, 1 ),
- $ LI( 2, 1 ) )
-*
-* Exit with INFO = 0 if swap was successfully performed.
-*
- RETURN
-*
- ELSE
-*
-* CASE 2: Swap 1-by-1 and 2-by-2 blocks, or 2-by-2
-* and 2-by-2 blocks.
-*
-* Solve the generalized Sylvester equation
-* S11 * R - L * S22 = SCALE * S12
-* T11 * R - L * T22 = SCALE * T12
-* for R and L. Solutions in LI and IR.
-*
- CALL DLACPY( 'Full', N1, N2, T( 1, N1+1 ), LDST, LI, LDST )
- CALL DLACPY( 'Full', N1, N2, S( 1, N1+1 ), LDST,
- $ IR( N2+1, N1+1 ), LDST )
- CALL DTGSY2( 'N', 0, N1, N2, S, LDST, S( N1+1, N1+1 ), LDST,
- $ IR( N2+1, N1+1 ), LDST, T, LDST, T( N1+1, N1+1 ),
- $ LDST, LI, LDST, SCALE, DSUM, DSCALE, IWORK, IDUM,
- $ LINFO )
-*
-* Compute orthogonal matrix QL:
-*
-* QL**T * LI = [ TL ]
-* [ 0 ]
-* where
-* LI = [ -L ]
-* [ SCALE * identity(N2) ]
-*
- DO 10 I = 1, N2
- CALL DSCAL( N1, -ONE, LI( 1, I ), 1 )
- LI( N1+I, I ) = SCALE
- 10 CONTINUE
- CALL DGEQR2( M, N2, LI, LDST, TAUL, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL DORG2R( M, M, N2, LI, LDST, TAUL, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Compute orthogonal matrix RQ:
-*
-* IR * RQ**T = [ 0 TR],
-*
-* where IR = [ SCALE * identity(N1), R ]
-*
- DO 20 I = 1, N1
- IR( N2+I, I ) = SCALE
- 20 CONTINUE
- CALL DGERQ2( N1, M, IR( N2+1, 1 ), LDST, TAUR, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL DORGR2( M, M, N1, IR, LDST, TAUR, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Perform the swapping tentatively:
-*
- CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
- $ WORK, M )
- CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, S,
- $ LDST )
- CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, T,
- $ LDST )
- CALL DLACPY( 'F', M, M, S, LDST, SCPY, LDST )
- CALL DLACPY( 'F', M, M, T, LDST, TCPY, LDST )
- CALL DLACPY( 'F', M, M, IR, LDST, IRCOP, LDST )
- CALL DLACPY( 'F', M, M, LI, LDST, LICOP, LDST )
-*
-* Triangularize the B-part by an RQ factorization.
-* Apply transformation (from left) to A-part, giving S.
-*
- CALL DGERQ2( M, M, T, LDST, TAUR, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL DORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, WORK,
- $ LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL DORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, WORK,
- $ LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Compute F-norm(S21) in BRQA21. (T21 is 0.)
-*
- DSCALE = ZERO
- DSUM = ONE
- DO 30 I = 1, N2
- CALL DLASSQ( N1, S( N2+1, I ), 1, DSCALE, DSUM )
- 30 CONTINUE
- BRQA21 = DSCALE*SQRT( DSUM )
-*
-* Triangularize the B-part by a QR factorization.
-* Apply transformation (from right) to A-part, giving S.
-*
- CALL DGEQR2( M, M, TCPY, LDST, TAUL, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL DORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, LDST,
- $ WORK, INFO )
- CALL DORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, LDST,
- $ WORK, INFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Compute F-norm(S21) in BQRA21. (T21 is 0.)
-*
- DSCALE = ZERO
- DSUM = ONE
- DO 40 I = 1, N2
- CALL DLASSQ( N1, SCPY( N2+1, I ), 1, DSCALE, DSUM )
- 40 CONTINUE
- BQRA21 = DSCALE*SQRT( DSUM )
-*
-* Decide which method to use.
-* Weak stability test:
-* F-norm(S21) <= O(EPS * F-norm((S, T)))
-*
- IF( BQRA21.LE.BRQA21 .AND. BQRA21.LE.THRESH ) THEN
- CALL DLACPY( 'F', M, M, SCPY, LDST, S, LDST )
- CALL DLACPY( 'F', M, M, TCPY, LDST, T, LDST )
- CALL DLACPY( 'F', M, M, IRCOP, LDST, IR, LDST )
- CALL DLACPY( 'F', M, M, LICOP, LDST, LI, LDST )
- ELSE IF( BRQA21.GE.THRESH ) THEN
- GO TO 70
- END IF
-*
-* Set lower triangle of B-part to zero
-*
- CALL DLASET( 'Lower', M-1, M-1, ZERO, ZERO, T(2,1), LDST )
-*
- IF( WANDS ) THEN
-*
-* Strong stability test:
-* F-norm((A-QL*S*QR**T, B-QL*T*QR**T)) <= O(EPS*F-norm((A,B)))
-*
- CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
- $ M )
- CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
- $ WORK, M )
- CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- DSCALE = ZERO
- DSUM = ONE
- CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-*
- CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
- $ M )
- CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
- SS = DSCALE*SQRT( DSUM )
- DTRONG = ( SS.LE.THRESH )
- IF( .NOT.DTRONG )
- $ GO TO 70
-*
- END IF
-*
-* If the swap is accepted ("weakly" and "strongly"), apply the
-* transformations and set N1-by-N2 (2,1)-block to zero.
-*
- CALL DLASET( 'Full', N1, N2, ZERO, ZERO, S(N2+1,1), LDST )
-*
-* copy back M-by-M diagonal block starting at index J1 of (A, B)
-*
- CALL DLACPY( 'F', M, M, S, LDST, A( J1, J1 ), LDA )
- CALL DLACPY( 'F', M, M, T, LDST, B( J1, J1 ), LDB )
- CALL DLASET( 'Full', LDST, LDST, ZERO, ZERO, T, LDST )
-*
-* Standardize existing 2-by-2 blocks.
-*
- DO 50 I = 1, M*M
- WORK(I) = ZERO
- 50 CONTINUE
- WORK( 1 ) = ONE
- T( 1, 1 ) = ONE
- IDUM = LWORK - M*M - 2
- IF( N2.GT.1 ) THEN
- CALL DLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, BE,
- $ WORK( 1 ), WORK( 2 ), T( 1, 1 ), T( 2, 1 ) )
- WORK( M+1 ) = -WORK( 2 )
- WORK( M+2 ) = WORK( 1 )
- T( N2, N2 ) = T( 1, 1 )
- T( 1, 2 ) = -T( 2, 1 )
- END IF
- WORK( M*M ) = ONE
- T( M, M ) = ONE
-*
- IF( N1.GT.1 ) THEN
- CALL DLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), LDB,
- $ TAUR, TAUL, WORK( M*M+1 ), WORK( N2*M+N2+1 ),
- $ WORK( N2*M+N2+2 ), T( N2+1, N2+1 ),
- $ T( M, M-1 ) )
- WORK( M*M ) = WORK( N2*M+N2+1 )
- WORK( M*M-1 ) = -WORK( N2*M+N2+2 )
- T( M, M ) = T( N2+1, N2+1 )
- T( M-1, M ) = -T( M, M-1 )
- END IF
- CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, J1+N2 ),
- $ LDA, ZERO, WORK( M*M+1 ), N2 )
- CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, J1+N2 ),
- $ LDA )
- CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, J1+N2 ),
- $ LDB, ZERO, WORK( M*M+1 ), N2 )
- CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, J1+N2 ),
- $ LDB )
- CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, WORK, M, ZERO,
- $ WORK( M*M+1 ), M )
- CALL DLACPY( 'Full', M, M, WORK( M*M+1 ), M, LI, LDST )
- CALL DGEMM( 'N', 'N', N2, N1, N1, ONE, A( J1, J1+N2 ), LDA,
- $ T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
- CALL DLACPY( 'Full', N2, N1, WORK, N2, A( J1, J1+N2 ), LDA )
- CALL DGEMM( 'N', 'N', N2, N1, N1, ONE, B( J1, J1+N2 ), LDB,
- $ T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
- CALL DLACPY( 'Full', N2, N1, WORK, N2, B( J1, J1+N2 ), LDB )
- CALL DGEMM( 'T', 'N', M, M, M, ONE, IR, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL DLACPY( 'Full', M, M, WORK, M, IR, LDST )
-*
-* Accumulate transformations into Q and Z if requested.
-*
- IF( WANTQ ) THEN
- CALL DGEMM( 'N', 'N', N, M, M, ONE, Q( 1, J1 ), LDQ, LI,
- $ LDST, ZERO, WORK, N )
- CALL DLACPY( 'Full', N, M, WORK, N, Q( 1, J1 ), LDQ )
-*
- END IF
-*
- IF( WANTZ ) THEN
- CALL DGEMM( 'N', 'N', N, M, M, ONE, Z( 1, J1 ), LDZ, IR,
- $ LDST, ZERO, WORK, N )
- CALL DLACPY( 'Full', N, M, WORK, N, Z( 1, J1 ), LDZ )
-*
- END IF
-*
-* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
-* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
-*
- I = J1 + M
- IF( I.LE.N ) THEN
- CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
- $ A( J1, I ), LDA, ZERO, WORK, M )
- CALL DLACPY( 'Full', M, N-I+1, WORK, M, A( J1, I ), LDA )
- CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
- $ B( J1, I ), LDA, ZERO, WORK, M )
- CALL DLACPY( 'Full', M, N-I+1, WORK, M, B( J1, I ), LDB )
- END IF
- I = J1 - 1
- IF( I.GT.0 ) THEN
- CALL DGEMM( 'N', 'N', I, M, M, ONE, A( 1, J1 ), LDA, IR,
- $ LDST, ZERO, WORK, I )
- CALL DLACPY( 'Full', I, M, WORK, I, A( 1, J1 ), LDA )
- CALL DGEMM( 'N', 'N', I, M, M, ONE, B( 1, J1 ), LDB, IR,
- $ LDST, ZERO, WORK, I )
- CALL DLACPY( 'Full', I, M, WORK, I, B( 1, J1 ), LDB )
- END IF
-*
-* Exit with INFO = 0 if swap was successfully performed.
-*
- RETURN
-*
- END IF
-*
-* Exit with INFO = 1 if swap was rejected.
-*
- 70 CONTINUE
-*
- INFO = 1
- RETURN
-*
-* End of DTGEX2
-*
- END
diff --git a/netlib/LAPACK/dtgexc.f b/netlib/LAPACK/dtgexc.f
deleted file mode 100644
index 4a55bf0..0000000
--- a/netlib/LAPACK/dtgexc.f
+++ /dev/null
@@ -1,544 +0,0 @@
-*> \brief \b DTGEXC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGEXC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgexc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgexc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgexc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-* LDZ, IFST, ILST, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ, WANTZ
-* INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGEXC reorders the generalized real Schur decomposition of a real
-*> matrix pair (A,B) using an orthogonal equivalence transformation
-*>
-*> (A, B) = Q * (A, B) * Z**T,
-*>
-*> so that the diagonal block of (A, B) with row index IFST is moved
-*> to row ILST.
-*>
-*> (A, B) must be in generalized real Schur canonical form (as returned
-*> by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
-*> diagonal blocks. B is upper triangular.
-*>
-*> Optionally, the matrices Q and Z of generalized Schur vectors are
-*> updated.
-*>
-*> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T
-*> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> .TRUE. : update the left transformation matrix Q;
-*> .FALSE.: do not update Q.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> .TRUE. : update the right transformation matrix Z;
-*> .FALSE.: do not update Z.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the matrix A in generalized real Schur canonical
-*> form.
-*> On exit, the updated matrix A, again in generalized
-*> real Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the matrix B in generalized real Schur canonical
-*> form (A,B).
-*> On exit, the updated matrix B, again in generalized
-*> real Schur canonical form (A,B).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
-*> On exit, the updated matrix Q.
-*> If WANTQ = .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1.
-*> If WANTQ = .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
-*> On exit, the updated matrix Z.
-*> If WANTZ = .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If WANTZ = .TRUE., LDZ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] IFST
-*> \verbatim
-*> IFST is INTEGER
-*> \endverbatim
-*>
-*> \param[in,out] ILST
-*> \verbatim
-*> ILST is INTEGER
-*> Specify the reordering of the diagonal blocks of (A, B).
-*> The block with row index IFST is moved to row ILST, by a
-*> sequence of swapping between adjacent blocks.
-*> On exit, if IFST pointed on entry to the second row of
-*> a 2-by-2 block, it is changed to point to the first row;
-*> ILST always points to the first row of the block in its
-*> final position (which may differ from its input value by
-*> +1 or -1). 1 <= IFST, ILST <= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: successful exit.
-*> <0: if INFO = -i, the i-th argument had an illegal value.
-*> =1: The transformed matrix pair (A, B) would be too far
-*> from generalized Schur form; the problem is ill-
-*> conditioned. (A, B) may have been partially reordered,
-*> and ILST points to the first row of the current
-*> position of the block being moved.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, IFST, ILST, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ, WANTZ
- INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER HERE, LWMIN, NBF, NBL, NBNEXT
-* ..
-* .. External Subroutines ..
- EXTERNAL DTGEX2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test input arguments.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -11
- ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
- INFO = -12
- ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LWMIN = 1
- ELSE
- LWMIN = 4*N + 16
- END IF
- WORK(1) = LWMIN
-*
- IF (LWORK.LT.LWMIN .AND. .NOT.LQUERY) THEN
- INFO = -15
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGEXC', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the first row of the specified block and find out
-* if it is 1-by-1 or 2-by-2.
-*
- IF( IFST.GT.1 ) THEN
- IF( A( IFST, IFST-1 ).NE.ZERO )
- $ IFST = IFST - 1
- END IF
- NBF = 1
- IF( IFST.LT.N ) THEN
- IF( A( IFST+1, IFST ).NE.ZERO )
- $ NBF = 2
- END IF
-*
-* Determine the first row of the final block
-* and find out if it is 1-by-1 or 2-by-2.
-*
- IF( ILST.GT.1 ) THEN
- IF( A( ILST, ILST-1 ).NE.ZERO )
- $ ILST = ILST - 1
- END IF
- NBL = 1
- IF( ILST.LT.N ) THEN
- IF( A( ILST+1, ILST ).NE.ZERO )
- $ NBL = 2
- END IF
- IF( IFST.EQ.ILST )
- $ RETURN
-*
- IF( IFST.LT.ILST ) THEN
-*
-* Update ILST.
-*
- IF( NBF.EQ.2 .AND. NBL.EQ.1 )
- $ ILST = ILST - 1
- IF( NBF.EQ.1 .AND. NBL.EQ.2 )
- $ ILST = ILST + 1
-*
- HERE = IFST
-*
- 10 CONTINUE
-*
-* Swap with next one below.
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1-by-1 or 2-by-2.
-*
- NBNEXT = 1
- IF( HERE+NBF+1.LE.N ) THEN
- IF( A( HERE+NBF+1, HERE+NBF ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE, NBF, NBNEXT, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + NBNEXT
-*
-* Test if 2-by-2 block breaks into two 1-by-1 blocks.
-*
- IF( NBF.EQ.2 ) THEN
- IF( A( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1-by-1 blocks, each of which
-* must be swapped individually.
-*
- NBNEXT = 1
- IF( HERE+3.LE.N ) THEN
- IF( A( HERE+3, HERE+2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE+1, 1, NBNEXT, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 1
-*
- ELSE
-*
-* Recompute NBNEXT in case of 2-by-2 split.
-*
- IF( A( HERE+2, HERE+1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2-by-2 block did not split.
-*
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK,
- $ INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 2
- ELSE
-*
-* 2-by-2 block did split.
-*
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 1
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 1
- END IF
-*
- END IF
- END IF
- IF( HERE.LT.ILST )
- $ GO TO 10
- ELSE
- HERE = IFST
-*
- 20 CONTINUE
-*
-* Swap with next one below.
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1-by-1 or 2-by-2.
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( A( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE-NBNEXT, NBNEXT, NBF, WORK, LWORK,
- $ INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - NBNEXT
-*
-* Test if 2-by-2 block breaks into two 1-by-1 blocks.
-*
- IF( NBF.EQ.2 ) THEN
- IF( A( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1-by-1 blocks, each of which
-* must be swapped individually.
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( A( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE-NBNEXT, NBNEXT, 1, WORK, LWORK,
- $ INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 1
- ELSE
-*
-* Recompute NBNEXT in case of 2-by-2 split.
-*
- IF( A( HERE, HERE-1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2-by-2 block did not split.
-*
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE-1, 2, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 2
- ELSE
-*
-* 2-by-2 block did split.
-*
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 1
- CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 1
- END IF
- END IF
- END IF
- IF( HERE.GT.ILST )
- $ GO TO 20
- END IF
- ILST = HERE
- WORK( 1 ) = LWMIN
- RETURN
-*
-* End of DTGEXC
-*
- END
diff --git a/netlib/LAPACK/dtgsen.f b/netlib/LAPACK/dtgsen.f
deleted file mode 100644
index 82b1762..0000000
--- a/netlib/LAPACK/dtgsen.f
+++ /dev/null
@@ -1,864 +0,0 @@
-*> \brief \b DTGSEN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGSEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsen.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsen.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsen.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
-* ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
-* PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ, WANTZ
-* INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
-* $ M, N
-* DOUBLE PRECISION PL, PR
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGSEN reorders the generalized real Schur decomposition of a real
-*> matrix pair (A, B) (in terms of an orthonormal equivalence trans-
-*> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues
-*> appears in the leading diagonal blocks of the upper quasi-triangular
-*> matrix A and the upper triangular B. The leading columns of Q and
-*> Z form orthonormal bases of the corresponding left and right eigen-
-*> spaces (deflating subspaces). (A, B) must be in generalized real
-*> Schur canonical form (as returned by DGGES), i.e. A is block upper
-*> triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
-*> triangular.
-*>
-*> DTGSEN also computes the generalized eigenvalues
-*>
-*> w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
-*>
-*> of the reordered matrix pair (A, B).
-*>
-*> Optionally, DTGSEN computes the estimates of reciprocal condition
-*> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
-*> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
-*> between the matrix pairs (A11, B11) and (A22,B22) that correspond to
-*> the selected cluster and the eigenvalues outside the cluster, resp.,
-*> and norms of "projections" onto left and right eigenspaces w.r.t.
-*> the selected cluster in the (1,1)-block.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies whether condition numbers are required for the
-*> cluster of eigenvalues (PL and PR) or the deflating subspaces
-*> (Difu and Difl):
-*> =0: Only reorder w.r.t. SELECT. No extras.
-*> =1: Reciprocal of norms of "projections" onto left and right
-*> eigenspaces w.r.t. the selected cluster (PL and PR).
-*> =2: Upper bounds on Difu and Difl. F-norm-based estimate
-*> (DIF(1:2)).
-*> =3: Estimate of Difu and Difl. 1-norm-based estimate
-*> (DIF(1:2)).
-*> About 5 times as expensive as IJOB = 2.
-*> =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
-*> version to get it all.
-*> =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
-*> \endverbatim
-*>
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> .TRUE. : update the left transformation matrix Q;
-*> .FALSE.: do not update Q.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> .TRUE. : update the right transformation matrix Z;
-*> .FALSE.: do not update Z.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> SELECT specifies the eigenvalues in the selected cluster.
-*> To select a real eigenvalue w(j), SELECT(j) must be set to
-*> .TRUE.. To select a complex conjugate pair of eigenvalues
-*> w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
-*> either SELECT(j) or SELECT(j+1) or both must be set to
-*> .TRUE.; a complex conjugate pair of eigenvalues must be
-*> either both included in the cluster or both excluded.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension(LDA,N)
-*> On entry, the upper quasi-triangular matrix A, with (A, B) in
-*> generalized real Schur canonical form.
-*> On exit, A is overwritten by the reordered matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension(LDB,N)
-*> On entry, the upper triangular matrix B, with (A, B) in
-*> generalized real Schur canonical form.
-*> On exit, B is overwritten by the reordered matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*>
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
-*> and BETA(j),j=1,...,N are the diagonals of the complex Schur
-*> form (S,T) that would result if the 2-by-2 diagonal blocks of
-*> the real generalized Schur form of (A,B) were further reduced
-*> to triangular form using complex unitary transformations.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) negative.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
-*> On exit, Q has been postmultiplied by the left orthogonal
-*> transformation matrix which reorder (A, B); The leading M
-*> columns of Q form orthonormal bases for the specified pair of
-*> left eigenspaces (deflating subspaces).
-*> If WANTQ = .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1;
-*> and if WANTQ = .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
-*> On exit, Z has been postmultiplied by the left orthogonal
-*> transformation matrix which reorder (A, B); The leading M
-*> columns of Z form orthonormal bases for the specified pair of
-*> left eigenspaces (deflating subspaces).
-*> If WANTZ = .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1;
-*> If WANTZ = .TRUE., LDZ >= N.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The dimension of the specified pair of left and right eigen-
-*> spaces (deflating subspaces). 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[out] PL
-*> \verbatim
-*> PL is DOUBLE PRECISION
-*> \endverbatim
-
-*> \param[out] PR
-*> \verbatim
-*> PR is DOUBLE PRECISION
-*>
-*> If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
-*> reciprocal of the norm of "projections" onto left and right
-*> eigenspaces with respect to the selected cluster.
-*> 0 < PL, PR <= 1.
-*> If M = 0 or M = N, PL = PR = 1.
-*> If IJOB = 0, 2 or 3, PL and PR are not referenced.
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is DOUBLE PRECISION array, dimension (2).
-*> If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
-*> If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
-*> Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
-*> estimates of Difu and Difl.
-*> If M = 0 or N, DIF(1:2) = F-norm([A, B]).
-*> If IJOB = 0 or 1, DIF is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 4*N+16.
-*> If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
-*> If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= 1.
-*> If IJOB = 1, 2 or 4, LIWORK >= N+6.
-*> If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: Successful exit.
-*> <0: If INFO = -i, the i-th argument had an illegal value.
-*> =1: Reordering of (A, B) failed because the transformed
-*> matrix pair (A, B) would be too far from generalized
-*> Schur form; the problem is very ill-conditioned.
-*> (A, B) may have been partially reordered.
-*> If requested, 0 is returned in DIF(*), PL and PR.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> DTGSEN first collects the selected eigenvalues by computing
-*> orthogonal U and W that move them to the top left corner of (A, B).
-*> In other words, the selected eigenvalues are the eigenvalues of
-*> (A11, B11) in:
-*>
-*> U**T*(A, B)*W = (A11 A12) (B11 B12) n1
-*> ( 0 A22),( 0 B22) n2
-*> n1 n2 n1 n2
-*>
-*> where N = n1+n2 and U**T means the transpose of U. The first n1 columns
-*> of U and W span the specified pair of left and right eigenspaces
-*> (deflating subspaces) of (A, B).
-*>
-*> If (A, B) has been obtained from the generalized real Schur
-*> decomposition of a matrix pair (C, D) = Q*(A, B)*Z**T, then the
-*> reordered generalized real Schur form of (C, D) is given by
-*>
-*> (C, D) = (Q*U)*(U**T*(A, B)*W)*(Z*W)**T,
-*>
-*> and the first n1 columns of Q*U and Z*W span the corresponding
-*> deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
-*>
-*> Note that if the selected eigenvalue is sufficiently ill-conditioned,
-*> then its value may differ significantly from its value before
-*> reordering.
-*>
-*> The reciprocal condition numbers of the left and right eigenspaces
-*> spanned by the first n1 columns of U and W (or Q*U and Z*W) may
-*> be returned in DIF(1:2), corresponding to Difu and Difl, resp.
-*>
-*> The Difu and Difl are defined as:
-*>
-*> Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
-*> and
-*> Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
-*>
-*> where sigma-min(Zu) is the smallest singular value of the
-*> (2*n1*n2)-by-(2*n1*n2) matrix
-*>
-*> Zu = [ kron(In2, A11) -kron(A22**T, In1) ]
-*> [ kron(In2, B11) -kron(B22**T, In1) ].
-*>
-*> Here, Inx is the identity matrix of size nx and A22**T is the
-*> transpose of A22. kron(X, Y) is the Kronecker product between
-*> the matrices X and Y.
-*>
-*> When DIF(2) is small, small changes in (A, B) can cause large changes
-*> in the deflating subspace. An approximate (asymptotic) bound on the
-*> maximum angular error in the computed deflating subspaces is
-*>
-*> EPS * norm((A, B)) / DIF(2),
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal norm of the projectors on the left and right
-*> eigenspaces associated with (A11, B11) may be returned in PL and PR.
-*> They are computed as follows. First we compute L and R so that
-*> P*(A, B)*Q is block diagonal, where
-*>
-*> P = ( I -L ) n1 Q = ( I R ) n1
-*> ( 0 I ) n2 and ( 0 I ) n2
-*> n1 n2 n1 n2
-*>
-*> and (L, R) is the solution to the generalized Sylvester equation
-*>
-*> A11*R - L*A22 = -A12
-*> B11*R - L*B22 = -B12
-*>
-*> Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
-*> An approximate (asymptotic) bound on the average absolute error of
-*> the selected eigenvalues is
-*>
-*> EPS * norm((A, B)) / PL.
-*>
-*> There are also global error bounds which valid for perturbations up
-*> to a certain restriction: A lower bound (x) on the smallest
-*> F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
-*> coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
-*> (i.e. (A + E, B + F), is
-*>
-*> x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
-*>
-*> An approximate bound on x can be computed from DIF(1:2), PL and PR.
-*>
-*> If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
-*> (L', R') and unperturbed (L, R) left and right deflating subspaces
-*> associated with the selected cluster in the (1,1)-blocks can be
-*> bounded as
-*>
-*> max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
-*> max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
-*>
-*> See LAPACK User's Guide section 4.11 or the following references
-*> for more information.
-*>
-*> Note that if the default method for computing the Frobenius-norm-
-*> based estimate DIF is not wanted (see DLATDF), then the parameter
-*> IDIFJB (see below) should be changed from 3 to 4 (routine DLATDF
-*> (IJOB = 2 will be used)). See DTGSYL for more details.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*>
-*> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*> Estimation: Theory, Algorithms and Software,
-*> Report UMINF - 94.04, Department of Computing Science, Umea
-*> University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*> Note 87. To appear in Numerical Algorithms, 1996.
-*>
-*> [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*> for Solving the Generalized Sylvester Equation and Estimating the
-*> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*> Department of Computing Science, Umea University, S-901 87 Umea,
-*> Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*> Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
-*> 1996.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
- $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ, WANTZ
- INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
- $ M, N
- DOUBLE PRECISION PL, PR
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER IDIFJB
- PARAMETER ( IDIFJB = 3 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, PAIR, SWAP, WANTD, WANTD1, WANTD2,
- $ WANTP
- INTEGER I, IERR, IJB, K, KASE, KK, KS, LIWMIN, LWMIN,
- $ MN2, N1, N2
- DOUBLE PRECISION DSCALE, DSUM, EPS, RDSCAL, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLACPY, DLAG2, DLASSQ, DTGEXC, DTGSYL,
- $ XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- IF( IJOB.LT.0 .OR. IJOB.GT.5 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -16
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGSEN', -INFO )
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- IERR = 0
-*
- WANTP = IJOB.EQ.1 .OR. IJOB.GE.4
- WANTD1 = IJOB.EQ.2 .OR. IJOB.EQ.4
- WANTD2 = IJOB.EQ.3 .OR. IJOB.EQ.5
- WANTD = WANTD1 .OR. WANTD2
-*
-* Set M to the dimension of the specified pair of deflating
-* subspaces.
-*
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
-*
- IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
- LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) )
- LIWMIN = MAX( 1, N+6 )
- ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN
- LWMIN = MAX( 1, 4*N+16, 4*M*( N-M ) )
- LIWMIN = MAX( 1, 2*M*( N-M ), N+6 )
- ELSE
- LWMIN = MAX( 1, 4*N+16 )
- LIWMIN = 1
- END IF
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -22
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -24
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGSEN', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.N .OR. M.EQ.0 ) THEN
- IF( WANTP ) THEN
- PL = ONE
- PR = ONE
- END IF
- IF( WANTD ) THEN
- DSCALE = ZERO
- DSUM = ONE
- DO 20 I = 1, N
- CALL DLASSQ( N, A( 1, I ), 1, DSCALE, DSUM )
- CALL DLASSQ( N, B( 1, I ), 1, DSCALE, DSUM )
- 20 CONTINUE
- DIF( 1 ) = DSCALE*SQRT( DSUM )
- DIF( 2 ) = DIF( 1 )
- END IF
- GO TO 60
- END IF
-*
-* Collect the selected blocks at the top-left corner of (A, B).
-*
- KS = 0
- PAIR = .FALSE.
- DO 30 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
-*
- SWAP = SELECT( K )
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).NE.ZERO ) THEN
- PAIR = .TRUE.
- SWAP = SWAP .OR. SELECT( K+1 )
- END IF
- END IF
-*
- IF( SWAP ) THEN
- KS = KS + 1
-*
-* Swap the K-th block to position KS.
-* Perform the reordering of diagonal blocks in (A, B)
-* by orthogonal transformation matrices and update
-* Q and Z accordingly (if requested):
-*
- KK = K
- IF( K.NE.KS )
- $ CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, KK, KS, WORK, LWORK, IERR )
-*
- IF( IERR.GT.0 ) THEN
-*
-* Swap is rejected: exit.
-*
- INFO = 1
- IF( WANTP ) THEN
- PL = ZERO
- PR = ZERO
- END IF
- IF( WANTD ) THEN
- DIF( 1 ) = ZERO
- DIF( 2 ) = ZERO
- END IF
- GO TO 60
- END IF
-*
- IF( PAIR )
- $ KS = KS + 1
- END IF
- END IF
- 30 CONTINUE
- IF( WANTP ) THEN
-*
-* Solve generalized Sylvester equation for R and L
-* and compute PL and PR.
-*
- N1 = M
- N2 = N - M
- I = N1 + 1
- IJB = 0
- CALL DLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 )
- CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
- $ N1 )
- CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
- $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
- $ DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
- $ LWORK-2*N1*N2, IWORK, IERR )
-*
-* Estimate the reciprocal of norms of "projections" onto left
-* and right eigenspaces.
-*
- RDSCAL = ZERO
- DSUM = ONE
- CALL DLASSQ( N1*N2, WORK, 1, RDSCAL, DSUM )
- PL = RDSCAL*SQRT( DSUM )
- IF( PL.EQ.ZERO ) THEN
- PL = ONE
- ELSE
- PL = DSCALE / ( SQRT( DSCALE*DSCALE / PL+PL )*SQRT( PL ) )
- END IF
- RDSCAL = ZERO
- DSUM = ONE
- CALL DLASSQ( N1*N2, WORK( N1*N2+1 ), 1, RDSCAL, DSUM )
- PR = RDSCAL*SQRT( DSUM )
- IF( PR.EQ.ZERO ) THEN
- PR = ONE
- ELSE
- PR = DSCALE / ( SQRT( DSCALE*DSCALE / PR+PR )*SQRT( PR ) )
- END IF
- END IF
-*
- IF( WANTD ) THEN
-*
-* Compute estimates of Difu and Difl.
-*
- IF( WANTD1 ) THEN
- N1 = M
- N2 = N - M
- I = N1 + 1
- IJB = IDIFJB
-*
-* Frobenius norm-based Difu-estimate.
-*
- CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
- $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
- $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ),
- $ LWORK-2*N1*N2, IWORK, IERR )
-*
-* Frobenius norm-based Difl-estimate.
-*
- CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
- $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
- $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ),
- $ LWORK-2*N1*N2, IWORK, IERR )
- ELSE
-*
-*
-* Compute 1-norm-based estimates of Difu and Difl using
-* reversed communication with DLACN2. In each step a
-* generalized Sylvester equation or a transposed variant
-* is solved.
-*
- KASE = 0
- N1 = M
- N2 = N - M
- I = N1 + 1
- IJB = 0
- MN2 = 2*N1*N2
-*
-* 1-norm-based estimate of Difu.
-*
- 40 CONTINUE
- CALL DLACN2( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 1 ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Solve generalized Sylvester equation.
-*
- CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
- $ WORK, N1, B, LDB, B( I, I ), LDB,
- $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- ELSE
-*
-* Solve the transposed variant.
-*
- CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA,
- $ WORK, N1, B, LDB, B( I, I ), LDB,
- $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- END IF
- GO TO 40
- END IF
- DIF( 1 ) = DSCALE / DIF( 1 )
-*
-* 1-norm-based estimate of Difl.
-*
- 50 CONTINUE
- CALL DLACN2( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 2 ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Solve generalized Sylvester equation.
-*
- CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
- $ WORK, N2, B( I, I ), LDB, B, LDB,
- $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- ELSE
-*
-* Solve the transposed variant.
-*
- CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA,
- $ WORK, N2, B( I, I ), LDB, B, LDB,
- $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- END IF
- GO TO 50
- END IF
- DIF( 2 ) = DSCALE / DIF( 2 )
-*
- END IF
- END IF
-*
- 60 CONTINUE
-*
-* Compute generalized eigenvalues of reordered pair (A, B) and
-* normalize the generalized Schur form.
-*
- PAIR = .FALSE.
- DO 80 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
-*
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).NE.ZERO ) THEN
- PAIR = .TRUE.
- END IF
- END IF
-*
- IF( PAIR ) THEN
-*
-* Compute the eigenvalue(s) at position K.
-*
- WORK( 1 ) = A( K, K )
- WORK( 2 ) = A( K+1, K )
- WORK( 3 ) = A( K, K+1 )
- WORK( 4 ) = A( K+1, K+1 )
- WORK( 5 ) = B( K, K )
- WORK( 6 ) = B( K+1, K )
- WORK( 7 ) = B( K, K+1 )
- WORK( 8 ) = B( K+1, K+1 )
- CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ),
- $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ),
- $ ALPHAI( K ) )
- ALPHAI( K+1 ) = -ALPHAI( K )
-*
- ELSE
-*
- IF( SIGN( ONE, B( K, K ) ).LT.ZERO ) THEN
-*
-* If B(K,K) is negative, make it positive
-*
- DO 70 I = 1, N
- A( K, I ) = -A( K, I )
- B( K, I ) = -B( K, I )
- IF( WANTQ ) Q( I, K ) = -Q( I, K )
- 70 CONTINUE
- END IF
-*
- ALPHAR( K ) = A( K, K )
- ALPHAI( K ) = ZERO
- BETA( K ) = B( K, K )
-*
- END IF
- END IF
- 80 CONTINUE
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DTGSEN
-*
- END
diff --git a/netlib/LAPACK/dtgsja.f b/netlib/LAPACK/dtgsja.f
deleted file mode 100644
index ceae929..0000000
--- a/netlib/LAPACK/dtgsja.f
+++ /dev/null
@@ -1,655 +0,0 @@
-*> \brief \b DTGSJA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGSJA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsja.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsja.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsja.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
-* LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV,
-* Q, LDQ, WORK, NCYCLE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBQ, JOBU, JOBV
-* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N,
-* $ NCYCLE, P
-* DOUBLE PRECISION TOLA, TOLB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), ALPHA( * ), B( LDB, * ),
-* $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
-* $ V( LDV, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGSJA computes the generalized singular value decomposition (GSVD)
-*> of two real upper triangular (or trapezoidal) matrices A and B.
-*>
-*> On entry, it is assumed that matrices A and B have the following
-*> forms, which may be obtained by the preprocessing subroutine DGGSVP
-*> from a general M-by-N matrix A and P-by-N matrix B:
-*>
-*> N-K-L K L
-*> A = K ( 0 A12 A13 ) if M-K-L >= 0;
-*> L ( 0 0 A23 )
-*> M-K-L ( 0 0 0 )
-*>
-*> N-K-L K L
-*> A = K ( 0 A12 A13 ) if M-K-L < 0;
-*> M-K ( 0 0 A23 )
-*>
-*> N-K-L K L
-*> B = L ( 0 0 B13 )
-*> P-L ( 0 0 0 )
-*>
-*> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
-*> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
-*> otherwise A23 is (M-K)-by-L upper trapezoidal.
-*>
-*> On exit,
-*>
-*> U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ),
-*>
-*> where U, V and Q are orthogonal matrices.
-*> R is a nonsingular upper triangular matrix, and D1 and D2 are
-*> ``diagonal'' matrices, which are of the following structures:
-*>
-*> If M-K-L >= 0,
-*>
-*> K L
-*> D1 = K ( I 0 )
-*> L ( 0 C )
-*> M-K-L ( 0 0 )
-*>
-*> K L
-*> D2 = L ( 0 S )
-*> P-L ( 0 0 )
-*>
-*> N-K-L K L
-*> ( 0 R ) = K ( 0 R11 R12 ) K
-*> L ( 0 0 R22 ) L
-*>
-*> where
-*>
-*> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
-*> S = diag( BETA(K+1), ... , BETA(K+L) ),
-*> C**2 + S**2 = I.
-*>
-*> R is stored in A(1:K+L,N-K-L+1:N) on exit.
-*>
-*> If M-K-L < 0,
-*>
-*> K M-K K+L-M
-*> D1 = K ( I 0 0 )
-*> M-K ( 0 C 0 )
-*>
-*> K M-K K+L-M
-*> D2 = M-K ( 0 S 0 )
-*> K+L-M ( 0 0 I )
-*> P-L ( 0 0 0 )
-*>
-*> N-K-L K M-K K+L-M
-*> ( 0 R ) = K ( 0 R11 R12 R13 )
-*> M-K ( 0 0 R22 R23 )
-*> K+L-M ( 0 0 0 R33 )
-*>
-*> where
-*> C = diag( ALPHA(K+1), ... , ALPHA(M) ),
-*> S = diag( BETA(K+1), ... , BETA(M) ),
-*> C**2 + S**2 = I.
-*>
-*> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
-*> ( 0 R22 R23 )
-*> in B(M-K+1:L,N+M-K-L+1:N) on exit.
-*>
-*> The computation of the orthogonal transformation matrices U, V or Q
-*> is optional. These matrices may either be formed explicitly, or they
-*> may be postmultiplied into input matrices U1, V1, or Q1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> = 'U': U must contain an orthogonal matrix U1 on entry, and
-*> the product U1*U is returned;
-*> = 'I': U is initialized to the unit matrix, and the
-*> orthogonal matrix U is returned;
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> = 'V': V must contain an orthogonal matrix V1 on entry, and
-*> the product V1*V is returned;
-*> = 'I': V is initialized to the unit matrix, and the
-*> orthogonal matrix V is returned;
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBQ
-*> \verbatim
-*> JOBQ is CHARACTER*1
-*> = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
-*> the product Q1*Q is returned;
-*> = 'I': Q is initialized to the unit matrix, and the
-*> orthogonal matrix Q is returned;
-*> = 'N': Q is not computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*>
-*> K and L specify the subblocks in the input matrices A and B:
-*> A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
-*> of A and B, whose GSVD is going to be computed by DTGSJA.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
-*> matrix R or part of R. See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
-*> a part of R. See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[in] TOLA
-*> \verbatim
-*> TOLA is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] TOLB
-*> \verbatim
-*> TOLB is DOUBLE PRECISION
-*>
-*> TOLA and TOLB are the convergence criteria for the Jacobi-
-*> Kogbetliantz iteration procedure. Generally, they are the
-*> same as used in the preprocessing step, say
-*> TOLA = max(M,N)*norm(A)*MAZHEPS,
-*> TOLB = max(P,N)*norm(B)*MAZHEPS.
-*> \endverbatim
-*>
-*> \param[out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION array, dimension (N)
-*>
-*> On exit, ALPHA and BETA contain the generalized singular
-*> value pairs of A and B;
-*> ALPHA(1:K) = 1,
-*> BETA(1:K) = 0,
-*> and if M-K-L >= 0,
-*> ALPHA(K+1:K+L) = diag(C),
-*> BETA(K+1:K+L) = diag(S),
-*> or if M-K-L < 0,
-*> ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
-*> BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
-*> Furthermore, if K+L < N,
-*> ALPHA(K+L+1:N) = 0 and
-*> BETA(K+L+1:N) = 0.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,M)
-*> On entry, if JOBU = 'U', U must contain a matrix U1 (usually
-*> the orthogonal matrix returned by DGGSVP).
-*> On exit,
-*> if JOBU = 'I', U contains the orthogonal matrix U;
-*> if JOBU = 'U', U contains the product U1*U.
-*> If JOBU = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,M) if
-*> JOBU = 'U'; LDU >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,P)
-*> On entry, if JOBV = 'V', V must contain a matrix V1 (usually
-*> the orthogonal matrix returned by DGGSVP).
-*> On exit,
-*> if JOBV = 'I', V contains the orthogonal matrix V;
-*> if JOBV = 'V', V contains the product V1*V.
-*> If JOBV = 'N', V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,P) if
-*> JOBV = 'V'; LDV >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
-*> the orthogonal matrix returned by DGGSVP).
-*> On exit,
-*> if JOBQ = 'I', Q contains the orthogonal matrix Q;
-*> if JOBQ = 'Q', Q contains the product Q1*Q.
-*> If JOBQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N) if
-*> JOBQ = 'Q'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] NCYCLE
-*> \verbatim
-*> NCYCLE is INTEGER
-*> The number of cycles required for convergence.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1: the procedure does not converge after MAXIT cycles.
-*> \endverbatim
-*>
-*> \verbatim
-*> Internal Parameters
-*> ===================
-*>
-*> MAXIT INTEGER
-*> MAXIT specifies the total loops that the iterative procedure
-*> may take. If after MAXIT cycles, the routine fails to
-*> converge, we return INFO = 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> DTGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
-*> min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
-*> matrix B13 to the form:
-*>
-*> U1**T *A13*Q1 = C1*R1; V1**T *B13*Q1 = S1*R1,
-*>
-*> where U1, V1 and Q1 are orthogonal matrix, and Z**T is the transpose
-*> of Z. C1 and S1 are diagonal matrices satisfying
-*>
-*> C1**2 + S1**2 = I,
-*>
-*> and R1 is an L-by-L nonsingular upper triangular matrix.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
- $ LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV,
- $ Q, LDQ, WORK, NCYCLE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBQ, JOBU, JOBV
- INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N,
- $ NCYCLE, P
- DOUBLE PRECISION TOLA, TOLB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
- $ V( LDV, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 40 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
-*
- LOGICAL INITQ, INITU, INITV, UPPER, WANTQ, WANTU, WANTV
- INTEGER I, J, KCYCLE
- DOUBLE PRECISION A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, ERROR,
- $ GAMMA, RWK, SNQ, SNU, SNV, SSMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAGS2, DLAPLL, DLARTG, DLASET, DROT,
- $ DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- INITU = LSAME( JOBU, 'I' )
- WANTU = INITU .OR. LSAME( JOBU, 'U' )
-*
- INITV = LSAME( JOBV, 'I' )
- WANTV = INITV .OR. LSAME( JOBV, 'V' )
-*
- INITQ = LSAME( JOBQ, 'I' )
- WANTQ = INITQ .OR. LSAME( JOBQ, 'Q' )
-*
- INFO = 0
- IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( P.LT.0 ) THEN
- INFO = -5
- ELSE IF( N.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -12
- ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
- INFO = -18
- ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
- INFO = -20
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -22
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGSJA', -INFO )
- RETURN
- END IF
-*
-* Initialize U, V and Q, if necessary
-*
- IF( INITU )
- $ CALL DLASET( 'Full', M, M, ZERO, ONE, U, LDU )
- IF( INITV )
- $ CALL DLASET( 'Full', P, P, ZERO, ONE, V, LDV )
- IF( INITQ )
- $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
-*
-* Loop until convergence
-*
- UPPER = .FALSE.
- DO 40 KCYCLE = 1, MAXIT
-*
- UPPER = .NOT.UPPER
-*
- DO 20 I = 1, L - 1
- DO 10 J = I + 1, L
-*
- A1 = ZERO
- A2 = ZERO
- A3 = ZERO
- IF( K+I.LE.M )
- $ A1 = A( K+I, N-L+I )
- IF( K+J.LE.M )
- $ A3 = A( K+J, N-L+J )
-*
- B1 = B( I, N-L+I )
- B3 = B( J, N-L+J )
-*
- IF( UPPER ) THEN
- IF( K+I.LE.M )
- $ A2 = A( K+I, N-L+J )
- B2 = B( I, N-L+J )
- ELSE
- IF( K+J.LE.M )
- $ A2 = A( K+J, N-L+I )
- B2 = B( J, N-L+I )
- END IF
-*
- CALL DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU,
- $ CSV, SNV, CSQ, SNQ )
-*
-* Update (K+I)-th and (K+J)-th rows of matrix A: U**T *A
-*
- IF( K+J.LE.M )
- $ CALL DROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ),
- $ LDA, CSU, SNU )
-*
-* Update I-th and J-th rows of matrix B: V**T *B
-*
- CALL DROT( L, B( J, N-L+1 ), LDB, B( I, N-L+1 ), LDB,
- $ CSV, SNV )
-*
-* Update (N-L+I)-th and (N-L+J)-th columns of matrices
-* A and B: A*Q and B*Q
-*
- CALL DROT( MIN( K+L, M ), A( 1, N-L+J ), 1,
- $ A( 1, N-L+I ), 1, CSQ, SNQ )
-*
- CALL DROT( L, B( 1, N-L+J ), 1, B( 1, N-L+I ), 1, CSQ,
- $ SNQ )
-*
- IF( UPPER ) THEN
- IF( K+I.LE.M )
- $ A( K+I, N-L+J ) = ZERO
- B( I, N-L+J ) = ZERO
- ELSE
- IF( K+J.LE.M )
- $ A( K+J, N-L+I ) = ZERO
- B( J, N-L+I ) = ZERO
- END IF
-*
-* Update orthogonal matrices U, V, Q, if desired.
-*
- IF( WANTU .AND. K+J.LE.M )
- $ CALL DROT( M, U( 1, K+J ), 1, U( 1, K+I ), 1, CSU,
- $ SNU )
-*
- IF( WANTV )
- $ CALL DROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV )
-*
- IF( WANTQ )
- $ CALL DROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ,
- $ SNQ )
-*
- 10 CONTINUE
- 20 CONTINUE
-*
- IF( .NOT.UPPER ) THEN
-*
-* The matrices A13 and B13 were lower triangular at the start
-* of the cycle, and are now upper triangular.
-*
-* Convergence test: test the parallelism of the corresponding
-* rows of A and B.
-*
- ERROR = ZERO
- DO 30 I = 1, MIN( L, M-K )
- CALL DCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 )
- CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 )
- CALL DLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN )
- ERROR = MAX( ERROR, SSMIN )
- 30 CONTINUE
-*
- IF( ABS( ERROR ).LE.MIN( TOLA, TOLB ) )
- $ GO TO 50
- END IF
-*
-* End of cycle loop
-*
- 40 CONTINUE
-*
-* The algorithm has not converged after MAXIT cycles.
-*
- INFO = 1
- GO TO 100
-*
- 50 CONTINUE
-*
-* If ERROR <= MIN(TOLA,TOLB), then the algorithm has converged.
-* Compute the generalized singular value pairs (ALPHA, BETA), and
-* set the triangular matrix R to array A.
-*
- DO 60 I = 1, K
- ALPHA( I ) = ONE
- BETA( I ) = ZERO
- 60 CONTINUE
-*
- DO 70 I = 1, MIN( L, M-K )
-*
- A1 = A( K+I, N-L+I )
- B1 = B( I, N-L+I )
-*
- IF( A1.NE.ZERO ) THEN
- GAMMA = B1 / A1
-*
-* change sign if necessary
-*
- IF( GAMMA.LT.ZERO ) THEN
- CALL DSCAL( L-I+1, -ONE, B( I, N-L+I ), LDB )
- IF( WANTV )
- $ CALL DSCAL( P, -ONE, V( 1, I ), 1 )
- END IF
-*
- CALL DLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ),
- $ RWK )
-*
- IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN
- CALL DSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ),
- $ LDA )
- ELSE
- CALL DSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ),
- $ LDB )
- CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
- $ LDA )
- END IF
-*
- ELSE
-*
- ALPHA( K+I ) = ZERO
- BETA( K+I ) = ONE
- CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
- $ LDA )
-*
- END IF
-*
- 70 CONTINUE
-*
-* Post-assignment
-*
- DO 80 I = M + 1, K + L
- ALPHA( I ) = ZERO
- BETA( I ) = ONE
- 80 CONTINUE
-*
- IF( K+L.LT.N ) THEN
- DO 90 I = K + L + 1, N
- ALPHA( I ) = ZERO
- BETA( I ) = ZERO
- 90 CONTINUE
- END IF
-*
- 100 CONTINUE
- NCYCLE = KCYCLE
- RETURN
-*
-* End of DTGSJA
-*
- END
diff --git a/netlib/LAPACK/dtgsna.f b/netlib/LAPACK/dtgsna.f
deleted file mode 100644
index 80394fa..0000000
--- a/netlib/LAPACK/dtgsna.f
+++ /dev/null
@@ -1,700 +0,0 @@
-*> \brief \b DTGSNA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGSNA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsna.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsna.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsna.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
-* LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, JOB
-* INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), DIF( * ), S( * ),
-* $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGSNA estimates reciprocal condition numbers for specified
-*> eigenvalues and/or eigenvectors of a matrix pair (A, B) in
-*> generalized real Schur canonical form (or of any matrix pair
-*> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where
-*> Z**T denotes the transpose of Z.
-*>
-*> (A, B) must be in generalized real Schur form (as returned by DGGES),
-*> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal
-*> blocks. B is upper triangular.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies whether condition numbers are required for
-*> eigenvalues (S) or eigenvectors (DIF):
-*> = 'E': for eigenvalues only (S);
-*> = 'V': for eigenvectors only (DIF);
-*> = 'B': for both eigenvalues and eigenvectors (S and DIF).
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute condition numbers for all eigenpairs;
-*> = 'S': compute condition numbers for selected eigenpairs
-*> specified by the array SELECT.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenpairs for which
-*> condition numbers are required. To select condition numbers
-*> for the eigenpair corresponding to a real eigenvalue w(j),
-*> SELECT(j) must be set to .TRUE.. To select condition numbers
-*> corresponding to a complex conjugate pair of eigenvalues w(j)
-*> and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
-*> set to .TRUE..
-*> If HOWMNY = 'A', SELECT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the square matrix pair (A, B). N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The upper quasi-triangular matrix A in the pair (A,B).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> The upper triangular matrix B in the pair (A,B).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,M)
-*> If JOB = 'E' or 'B', VL must contain left eigenvectors of
-*> (A, B), corresponding to the eigenpairs specified by HOWMNY
-*> and SELECT. The eigenvectors must be stored in consecutive
-*> columns of VL, as returned by DTGEVC.
-*> If JOB = 'V', VL is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1.
-*> If JOB = 'E' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,M)
-*> If JOB = 'E' or 'B', VR must contain right eigenvectors of
-*> (A, B), corresponding to the eigenpairs specified by HOWMNY
-*> and SELECT. The eigenvectors must be stored in consecutive
-*> columns ov VR, as returned by DTGEVC.
-*> If JOB = 'V', VR is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1.
-*> If JOB = 'E' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (MM)
-*> If JOB = 'E' or 'B', the reciprocal condition numbers of the
-*> selected eigenvalues, stored in consecutive elements of the
-*> array. For a complex conjugate pair of eigenvalues two
-*> consecutive elements of S are set to the same value. Thus
-*> S(j), DIF(j), and the j-th columns of VL and VR all
-*> correspond to the same eigenpair (but not in general the
-*> j-th eigenpair, unless all eigenpairs are selected).
-*> If JOB = 'V', S is not referenced.
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is DOUBLE PRECISION array, dimension (MM)
-*> If JOB = 'V' or 'B', the estimated reciprocal condition
-*> numbers of the selected eigenvectors, stored in consecutive
-*> elements of the array. For a complex eigenvector two
-*> consecutive elements of DIF are set to the same value. If
-*> the eigenvalues cannot be reordered to compute DIF(j), DIF(j)
-*> is set to 0; this can only occur when the true value would be
-*> very small anyway.
-*> If JOB = 'E', DIF is not referenced.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of elements in the arrays S and DIF. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of elements of the arrays S and DIF used to store
-*> the specified condition numbers; for each selected real
-*> eigenvalue one element is used, and for each selected complex
-*> conjugate pair of eigenvalues, two elements are used.
-*> If HOWMNY = 'A', M is set to N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N + 6)
-*> If JOB = 'E', IWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: Successful exit
-*> <0: If INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The reciprocal of the condition number of a generalized eigenvalue
-*> w = (a, b) is defined as
-*>
-*> S(w) = (|u**TAv|**2 + |u**TBv|**2)**(1/2) / (norm(u)*norm(v))
-*>
-*> where u and v are the left and right eigenvectors of (A, B)
-*> corresponding to w; |z| denotes the absolute value of the complex
-*> number, and norm(u) denotes the 2-norm of the vector u.
-*> The pair (a, b) corresponds to an eigenvalue w = a/b (= u**TAv/u**TBv)
-*> of the matrix pair (A, B). If both a and b equal zero, then (A B) is
-*> singular and S(I) = -1 is returned.
-*>
-*> An approximate error bound on the chordal distance between the i-th
-*> computed generalized eigenvalue w and the corresponding exact
-*> eigenvalue lambda is
-*>
-*> chord(w, lambda) <= EPS * norm(A, B) / S(I)
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal of the condition number DIF(i) of right eigenvector u
-*> and left eigenvector v corresponding to the generalized eigenvalue w
-*> is defined as follows:
-*>
-*> a) If the i-th eigenvalue w = (a,b) is real
-*>
-*> Suppose U and V are orthogonal transformations such that
-*>
-*> U**T*(A, B)*V = (S, T) = ( a * ) ( b * ) 1
-*> ( 0 S22 ),( 0 T22 ) n-1
-*> 1 n-1 1 n-1
-*>
-*> Then the reciprocal condition number DIF(i) is
-*>
-*> Difl((a, b), (S22, T22)) = sigma-min( Zl ),
-*>
-*> where sigma-min(Zl) denotes the smallest singular value of the
-*> 2(n-1)-by-2(n-1) matrix
-*>
-*> Zl = [ kron(a, In-1) -kron(1, S22) ]
-*> [ kron(b, In-1) -kron(1, T22) ] .
-*>
-*> Here In-1 is the identity matrix of size n-1. kron(X, Y) is the
-*> Kronecker product between the matrices X and Y.
-*>
-*> Note that if the default method for computing DIF(i) is wanted
-*> (see DLATDF), then the parameter DIFDRI (see below) should be
-*> changed from 3 to 4 (routine DLATDF(IJOB = 2 will be used)).
-*> See DTGSYL for more details.
-*>
-*> b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair,
-*>
-*> Suppose U and V are orthogonal transformations such that
-*>
-*> U**T*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2
-*> ( 0 S22 ),( 0 T22) n-2
-*> 2 n-2 2 n-2
-*>
-*> and (S11, T11) corresponds to the complex conjugate eigenvalue
-*> pair (w, conjg(w)). There exist unitary matrices U1 and V1 such
-*> that
-*>
-*> U1**T*S11*V1 = ( s11 s12 ) and U1**T*T11*V1 = ( t11 t12 )
-*> ( 0 s22 ) ( 0 t22 )
-*>
-*> where the generalized eigenvalues w = s11/t11 and
-*> conjg(w) = s22/t22.
-*>
-*> Then the reciprocal condition number DIF(i) is bounded by
-*>
-*> min( d1, max( 1, |real(s11)/real(s22)| )*d2 )
-*>
-*> where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where
-*> Z1 is the complex 2-by-2 matrix
-*>
-*> Z1 = [ s11 -s22 ]
-*> [ t11 -t22 ],
-*>
-*> This is done by computing (using real arithmetic) the
-*> roots of the characteristical polynomial det(Z1**T * Z1 - lambda I),
-*> where Z1**T denotes the transpose of Z1 and det(X) denotes
-*> the determinant of X.
-*>
-*> and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an
-*> upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2)
-*>
-*> Z2 = [ kron(S11**T, In-2) -kron(I2, S22) ]
-*> [ kron(T11**T, In-2) -kron(I2, T22) ]
-*>
-*> Note that if the default method for computing DIF is wanted (see
-*> DLATDF), then the parameter DIFDRI (see below) should be changed
-*> from 3 to 4 (routine DLATDF(IJOB = 2 will be used)). See DTGSYL
-*> for more details.
-*>
-*> For each eigenvalue/vector specified by SELECT, DIF stores a
-*> Frobenius norm-based estimate of Difl.
-*>
-*> An approximate error bound for the i-th computed eigenvector VL(i) or
-*> VR(i) is given by
-*>
-*> EPS * norm(A, B) / DIF(i).
-*>
-*> See ref. [2-3] for more details and further references.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*>
-*> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*> Estimation: Theory, Algorithms and Software,
-*> Report UMINF - 94.04, Department of Computing Science, Umea
-*> University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*> Note 87. To appear in Numerical Algorithms, 1996.
-*>
-*> [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*> for Solving the Generalized Sylvester Equation and Estimating the
-*> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*> Department of Computing Science, Umea University, S-901 87 Umea,
-*> Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*> Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
-*> No 1, 1996.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, JOB
- INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), DIF( * ), S( * ),
- $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER DIFDRI
- PARAMETER ( DIFDRI = 3 )
- DOUBLE PRECISION ZERO, ONE, TWO, FOUR
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
- $ FOUR = 4.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, PAIR, SOMCON, WANTBH, WANTDF, WANTS
- INTEGER I, IERR, IFST, ILST, IZ, K, KS, LWMIN, N1, N2
- DOUBLE PRECISION ALPHAI, ALPHAR, ALPRQT, BETA, C1, C2, COND,
- $ EPS, LNRM, RNRM, ROOT1, ROOT2, SCALE, SMLNUM,
- $ TMPII, TMPIR, TMPRI, TMPRR, UHAV, UHAVI, UHBV,
- $ UHBVI
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DUMMY( 1 ), DUMMY1( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT, DLAMCH, DLAPY2, DNRM2
- EXTERNAL LSAME, DDOT, DLAMCH, DLAPY2, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DLACPY, DLAG2, DTGEXC, DTGSYL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- WANTBH = LSAME( JOB, 'B' )
- WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
- WANTDF = LSAME( JOB, 'V' ) .OR. WANTBH
-*
- SOMCON = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.WANTS .AND. .NOT.WANTDF ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( HOWMNY, 'A' ) .AND. .NOT.SOMCON ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( WANTS .AND. LDVL.LT.N ) THEN
- INFO = -10
- ELSE IF( WANTS .AND. LDVR.LT.N ) THEN
- INFO = -12
- ELSE
-*
-* Set M to the number of eigenpairs for which condition numbers
-* are required, and test MM.
-*
- IF( SOMCON ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( N.EQ.0 ) THEN
- LWMIN = 1
- ELSE IF( LSAME( JOB, 'V' ) .OR. LSAME( JOB, 'B' ) ) THEN
- LWMIN = 2*N*( N + 2 ) + 16
- ELSE
- LWMIN = N
- END IF
- WORK( 1 ) = LWMIN
-*
- IF( MM.LT.M ) THEN
- INFO = -15
- ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -18
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGSNA', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- KS = 0
- PAIR = .FALSE.
-*
- DO 20 K = 1, N
-*
-* Determine whether A(k,k) begins a 1-by-1 or 2-by-2 block.
-*
- IF( PAIR ) THEN
- PAIR = .FALSE.
- GO TO 20
- ELSE
- IF( K.LT.N )
- $ PAIR = A( K+1, K ).NE.ZERO
- END IF
-*
-* Determine whether condition numbers are required for the k-th
-* eigenpair.
-*
- IF( SOMCON ) THEN
- IF( PAIR ) THEN
- IF( .NOT.SELECT( K ) .AND. .NOT.SELECT( K+1 ) )
- $ GO TO 20
- ELSE
- IF( .NOT.SELECT( K ) )
- $ GO TO 20
- END IF
- END IF
-*
- KS = KS + 1
-*
- IF( WANTS ) THEN
-*
-* Compute the reciprocal condition number of the k-th
-* eigenvalue.
-*
- IF( PAIR ) THEN
-*
-* Complex eigenvalue pair.
-*
- RNRM = DLAPY2( DNRM2( N, VR( 1, KS ), 1 ),
- $ DNRM2( N, VR( 1, KS+1 ), 1 ) )
- LNRM = DLAPY2( DNRM2( N, VL( 1, KS ), 1 ),
- $ DNRM2( N, VL( 1, KS+1 ), 1 ) )
- CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- TMPRR = DDOT( N, WORK, 1, VL( 1, KS ), 1 )
- TMPRI = DDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS+1 ), 1,
- $ ZERO, WORK, 1 )
- TMPII = DDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- TMPIR = DDOT( N, WORK, 1, VL( 1, KS ), 1 )
- UHAV = TMPRR + TMPII
- UHAVI = TMPIR - TMPRI
- CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- TMPRR = DDOT( N, WORK, 1, VL( 1, KS ), 1 )
- TMPRI = DDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS+1 ), 1,
- $ ZERO, WORK, 1 )
- TMPII = DDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- TMPIR = DDOT( N, WORK, 1, VL( 1, KS ), 1 )
- UHBV = TMPRR + TMPII
- UHBVI = TMPIR - TMPRI
- UHAV = DLAPY2( UHAV, UHAVI )
- UHBV = DLAPY2( UHBV, UHBVI )
- COND = DLAPY2( UHAV, UHBV )
- S( KS ) = COND / ( RNRM*LNRM )
- S( KS+1 ) = S( KS )
-*
- ELSE
-*
-* Real eigenvalue.
-*
- RNRM = DNRM2( N, VR( 1, KS ), 1 )
- LNRM = DNRM2( N, VL( 1, KS ), 1 )
- CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- UHAV = DDOT( N, WORK, 1, VL( 1, KS ), 1 )
- CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- UHBV = DDOT( N, WORK, 1, VL( 1, KS ), 1 )
- COND = DLAPY2( UHAV, UHBV )
- IF( COND.EQ.ZERO ) THEN
- S( KS ) = -ONE
- ELSE
- S( KS ) = COND / ( RNRM*LNRM )
- END IF
- END IF
- END IF
-*
- IF( WANTDF ) THEN
- IF( N.EQ.1 ) THEN
- DIF( KS ) = DLAPY2( A( 1, 1 ), B( 1, 1 ) )
- GO TO 20
- END IF
-*
-* Estimate the reciprocal condition number of the k-th
-* eigenvectors.
- IF( PAIR ) THEN
-*
-* Copy the 2-by 2 pencil beginning at (A(k,k), B(k, k)).
-* Compute the eigenvalue(s) at position K.
-*
- WORK( 1 ) = A( K, K )
- WORK( 2 ) = A( K+1, K )
- WORK( 3 ) = A( K, K+1 )
- WORK( 4 ) = A( K+1, K+1 )
- WORK( 5 ) = B( K, K )
- WORK( 6 ) = B( K+1, K )
- WORK( 7 ) = B( K, K+1 )
- WORK( 8 ) = B( K+1, K+1 )
- CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA,
- $ DUMMY1( 1 ), ALPHAR, DUMMY( 1 ), ALPHAI )
- ALPRQT = ONE
- C1 = TWO*( ALPHAR*ALPHAR+ALPHAI*ALPHAI+BETA*BETA )
- C2 = FOUR*BETA*BETA*ALPHAI*ALPHAI
- ROOT1 = C1 + SQRT( C1*C1-4.0D0*C2 )
- ROOT2 = C2 / ROOT1
- ROOT1 = ROOT1 / TWO
- COND = MIN( SQRT( ROOT1 ), SQRT( ROOT2 ) )
- END IF
-*
-* Copy the matrix (A, B) to the array WORK and swap the
-* diagonal block beginning at A(k,k) to the (1,1) position.
-*
- CALL DLACPY( 'Full', N, N, A, LDA, WORK, N )
- CALL DLACPY( 'Full', N, N, B, LDB, WORK( N*N+1 ), N )
- IFST = K
- ILST = 1
-*
- CALL DTGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), N,
- $ DUMMY, 1, DUMMY1, 1, IFST, ILST,
- $ WORK( N*N*2+1 ), LWORK-2*N*N, IERR )
-*
- IF( IERR.GT.0 ) THEN
-*
-* Ill-conditioned problem - swap rejected.
-*
- DIF( KS ) = ZERO
- ELSE
-*
-* Reordering successful, solve generalized Sylvester
-* equation for R and L,
-* A22 * R - L * A11 = A12
-* B22 * R - L * B11 = B12,
-* and compute estimate of Difl((A11,B11), (A22, B22)).
-*
- N1 = 1
- IF( WORK( 2 ).NE.ZERO )
- $ N1 = 2
- N2 = N - N1
- IF( N2.EQ.0 ) THEN
- DIF( KS ) = COND
- ELSE
- I = N*N + 1
- IZ = 2*N*N + 1
- CALL DTGSYL( 'N', DIFDRI, N2, N1, WORK( N*N1+N1+1 ),
- $ N, WORK, N, WORK( N1+1 ), N,
- $ WORK( N*N1+N1+I ), N, WORK( I ), N,
- $ WORK( N1+I ), N, SCALE, DIF( KS ),
- $ WORK( IZ+1 ), LWORK-2*N*N, IWORK, IERR )
-*
- IF( PAIR )
- $ DIF( KS ) = MIN( MAX( ONE, ALPRQT )*DIF( KS ),
- $ COND )
- END IF
- END IF
- IF( PAIR )
- $ DIF( KS+1 ) = DIF( KS )
- END IF
- IF( PAIR )
- $ KS = KS + 1
-*
- 20 CONTINUE
- WORK( 1 ) = LWMIN
- RETURN
-*
-* End of DTGSNA
-*
- END
diff --git a/netlib/LAPACK/dtgsy2.f b/netlib/LAPACK/dtgsy2.f
deleted file mode 100644
index 44fc84f..0000000
--- a/netlib/LAPACK/dtgsy2.f
+++ /dev/null
@@ -1,1075 +0,0 @@
-*> \brief \b DTGSY2 solves the generalized Sylvester equation (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGSY2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsy2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsy2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsy2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-* LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
-* IWORK, PQ, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N,
-* $ PQ
-* DOUBLE PRECISION RDSCAL, RDSUM, SCALE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
-* $ D( LDD, * ), E( LDE, * ), F( LDF, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGSY2 solves the generalized Sylvester equation:
-*>
-*> A * R - L * B = scale * C (1)
-*> D * R - L * E = scale * F,
-*>
-*> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
-*> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
-*> N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
-*> must be in generalized Schur canonical form, i.e. A, B are upper
-*> quasi triangular and D, E are upper triangular. The solution (R, L)
-*> overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
-*> chosen to avoid overflow.
-*>
-*> In matrix notation solving equation (1) corresponds to solve
-*> Z*x = scale*b, where Z is defined as
-*>
-*> Z = [ kron(In, A) -kron(B**T, Im) ] (2)
-*> [ kron(In, D) -kron(E**T, Im) ],
-*>
-*> Ik is the identity matrix of size k and X**T is the transpose of X.
-*> kron(X, Y) is the Kronecker product between the matrices X and Y.
-*> In the process of solving (1), we solve a number of such systems
-*> where Dim(In), Dim(In) = 1 or 2.
-*>
-*> If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y,
-*> which is equivalent to solve for R and L in
-*>
-*> A**T * R + D**T * L = scale * C (3)
-*> R * B**T + L * E**T = scale * -F
-*>
-*> This case is used to compute an estimate of Dif[(A, D), (B, E)] =
-*> sigma_min(Z) using reverse communicaton with DLACON.
-*>
-*> DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL
-*> of an upper bound on the separation between to matrix pairs. Then
-*> the input (A, D), (B, E) are sub-pencils of the matrix pair in
-*> DTGSYL. See DTGSYL for details.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N', solve the generalized Sylvester equation (1).
-*> = 'T': solve the 'transposed' system (3).
-*> \endverbatim
-*>
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies what kind of functionality to be performed.
-*> = 0: solve (1) only.
-*> = 1: A contribution from this subsystem to a Frobenius
-*> norm-based estimate of the separation between two matrix
-*> pairs is computed. (look ahead strategy is used).
-*> = 2: A contribution from this subsystem to a Frobenius
-*> norm-based estimate of the separation between two matrix
-*> pairs is computed. (DGECON on sub-systems is used.)
-*> Not referenced if TRANS = 'T'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the order of A and D, and the row
-*> dimension of C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of B and E, and the column
-*> dimension of C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, M)
-*> On entry, A contains an upper quasi triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the matrix A. LDA >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> On entry, B contains an upper quasi triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the matrix B. LDB >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC, N)
-*> On entry, C contains the right-hand-side of the first matrix
-*> equation in (1).
-*> On exit, if IJOB = 0, C has been overwritten by the
-*> solution R.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the matrix C. LDC >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (LDD, M)
-*> On entry, D contains an upper triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDD
-*> \verbatim
-*> LDD is INTEGER
-*> The leading dimension of the matrix D. LDD >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (LDE, N)
-*> On entry, E contains an upper triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDE
-*> \verbatim
-*> LDE is INTEGER
-*> The leading dimension of the matrix E. LDE >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] F
-*> \verbatim
-*> F is DOUBLE PRECISION array, dimension (LDF, N)
-*> On entry, F contains the right-hand-side of the second matrix
-*> equation in (1).
-*> On exit, if IJOB = 0, F has been overwritten by the
-*> solution L.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of the matrix F. LDF >= max(1, M).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
-*> R and L (C and F on entry) will hold the solutions to a
-*> slightly perturbed system but the input matrices A, B, D and
-*> E have not been changed. If SCALE = 0, R and L will hold the
-*> solutions to the homogeneous system with C = F = 0. Normally,
-*> SCALE = 1.
-*> \endverbatim
-*>
-*> \param[in,out] RDSUM
-*> \verbatim
-*> RDSUM is DOUBLE PRECISION
-*> On entry, the sum of squares of computed contributions to
-*> the Dif-estimate under computation by DTGSYL, where the
-*> scaling factor RDSCAL (see below) has been factored out.
-*> On exit, the corresponding sum of squares updated with the
-*> contributions from the current sub-system.
-*> If TRANS = 'T' RDSUM is not touched.
-*> NOTE: RDSUM only makes sense when DTGSY2 is called by DTGSYL.
-*> \endverbatim
-*>
-*> \param[in,out] RDSCAL
-*> \verbatim
-*> RDSCAL is DOUBLE PRECISION
-*> On entry, scaling factor used to prevent overflow in RDSUM.
-*> On exit, RDSCAL is updated w.r.t. the current contributions
-*> in RDSUM.
-*> If TRANS = 'T', RDSCAL is not touched.
-*> NOTE: RDSCAL only makes sense when DTGSY2 is called by
-*> DTGSYL.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (M+N+2)
-*> \endverbatim
-*>
-*> \param[out] PQ
-*> \verbatim
-*> PQ is INTEGER
-*> On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
-*> 8-by-8) solved by this routine.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, if INFO is set to
-*> =0: Successful exit
-*> <0: If INFO = -i, the i-th argument had an illegal value.
-*> >0: The matrix pairs (A, D) and (B, E) have common or very
-*> close eigenvalues.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleSYauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
- SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
- $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
- $ IWORK, PQ, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N,
- $ PQ
- DOUBLE PRECISION RDSCAL, RDSUM, SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ D( LDD, * ), E( LDE, * ), F( LDF, * )
-* ..
-*
-* =====================================================================
-* Replaced various illegal calls to DCOPY by calls to DLASET.
-* Sven Hammarling, 27/5/02.
-*
-* .. Parameters ..
- INTEGER LDZ
- PARAMETER ( LDZ = 8 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER I, IE, IERR, II, IS, ISP1, J, JE, JJ, JS, JSP1,
- $ K, MB, NB, P, Q, ZDIM
- DOUBLE PRECISION ALPHA, SCALOC
-* ..
-* .. Local Arrays ..
- INTEGER IPIV( LDZ ), JPIV( LDZ )
- DOUBLE PRECISION RHS( LDZ ), Z( LDZ, LDZ )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMM, DGEMV, DGER, DGESC2,
- $ DGETC2, DLASET, DLATDF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test input parameters
-*
- INFO = 0
- IERR = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -1
- ELSE IF( NOTRAN ) THEN
- IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.2 ) ) THEN
- INFO = -2
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( M.LE.0 ) THEN
- INFO = -3
- ELSE IF( N.LE.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
- INFO = -12
- ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
- INFO = -16
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGSY2', -INFO )
- RETURN
- END IF
-*
-* Determine block structure of A
-*
- PQ = 0
- P = 0
- I = 1
- 10 CONTINUE
- IF( I.GT.M )
- $ GO TO 20
- P = P + 1
- IWORK( P ) = I
- IF( I.EQ.M )
- $ GO TO 20
- IF( A( I+1, I ).NE.ZERO ) THEN
- I = I + 2
- ELSE
- I = I + 1
- END IF
- GO TO 10
- 20 CONTINUE
- IWORK( P+1 ) = M + 1
-*
-* Determine block structure of B
-*
- Q = P + 1
- J = 1
- 30 CONTINUE
- IF( J.GT.N )
- $ GO TO 40
- Q = Q + 1
- IWORK( Q ) = J
- IF( J.EQ.N )
- $ GO TO 40
- IF( B( J+1, J ).NE.ZERO ) THEN
- J = J + 2
- ELSE
- J = J + 1
- END IF
- GO TO 30
- 40 CONTINUE
- IWORK( Q+1 ) = N + 1
- PQ = P*( Q-P-1 )
-*
- IF( NOTRAN ) THEN
-*
-* Solve (I, J) - subsystem
-* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-* for I = P, P - 1, ..., 1; J = 1, 2, ..., Q
-*
- SCALE = ONE
- SCALOC = ONE
- DO 120 J = P + 2, Q
- JS = IWORK( J )
- JSP1 = JS + 1
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- DO 110 I = P, 1, -1
-*
- IS = IWORK( I )
- ISP1 = IS + 1
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- ZDIM = MB*NB*2
-*
- IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 2-by-2 system Z * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = D( IS, IS )
- Z( 1, 2 ) = -B( JS, JS )
- Z( 2, 2 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = F( IS, JS )
-*
-* Solve Z * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- IF( IJOB.EQ.0 ) THEN
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 50 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 50 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- F( IS, JS ) = RHS( 2 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- ALPHA = -RHS( 1 )
- CALL DAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, JS ),
- $ 1 )
- CALL DAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, JS ),
- $ 1 )
- END IF
- IF( J.LT.Q ) THEN
- CALL DAXPY( N-JE, RHS( 2 ), B( JS, JE+1 ), LDB,
- $ C( IS, JE+1 ), LDC )
- CALL DAXPY( N-JE, RHS( 2 ), E( JS, JE+1 ), LDE,
- $ F( IS, JE+1 ), LDF )
- END IF
-*
- ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build a 4-by-4 system Z * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = ZERO
- Z( 3, 1 ) = D( IS, IS )
- Z( 4, 1 ) = ZERO
-*
- Z( 1, 2 ) = ZERO
- Z( 2, 2 ) = A( IS, IS )
- Z( 3, 2 ) = ZERO
- Z( 4, 2 ) = D( IS, IS )
-*
- Z( 1, 3 ) = -B( JS, JS )
- Z( 2, 3 ) = -B( JS, JSP1 )
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = -E( JS, JSP1 )
-*
- Z( 1, 4 ) = -B( JSP1, JS )
- Z( 2, 4 ) = -B( JSP1, JSP1 )
- Z( 3, 4 ) = ZERO
- Z( 4, 4 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( IS, JSP1 )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( IS, JSP1 )
-*
-* Solve Z * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- IF( IJOB.EQ.0 ) THEN
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 60 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 60 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( IS, JSP1 ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( IS, JSP1 ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL DGER( IS-1, NB, -ONE, A( 1, IS ), 1, RHS( 1 ),
- $ 1, C( 1, JS ), LDC )
- CALL DGER( IS-1, NB, -ONE, D( 1, IS ), 1, RHS( 1 ),
- $ 1, F( 1, JS ), LDF )
- END IF
- IF( J.LT.Q ) THEN
- CALL DAXPY( N-JE, RHS( 3 ), B( JS, JE+1 ), LDB,
- $ C( IS, JE+1 ), LDC )
- CALL DAXPY( N-JE, RHS( 3 ), E( JS, JE+1 ), LDE,
- $ F( IS, JE+1 ), LDF )
- CALL DAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), LDB,
- $ C( IS, JE+1 ), LDC )
- CALL DAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), LDE,
- $ F( IS, JE+1 ), LDF )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 4-by-4 system Z * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( ISP1, IS )
- Z( 3, 1 ) = D( IS, IS )
- Z( 4, 1 ) = ZERO
-*
- Z( 1, 2 ) = A( IS, ISP1 )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 3, 2 ) = D( IS, ISP1 )
- Z( 4, 2 ) = D( ISP1, ISP1 )
-*
- Z( 1, 3 ) = -B( JS, JS )
- Z( 2, 3 ) = ZERO
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = ZERO
-*
- Z( 1, 4 ) = ZERO
- Z( 2, 4 ) = -B( JS, JS )
- Z( 3, 4 ) = ZERO
- Z( 4, 4 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( ISP1, JS )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( ISP1, JS )
-*
-* Solve Z * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
- IF( IJOB.EQ.0 ) THEN
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 70 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 70 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( ISP1, JS ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( ISP1, JS ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL DGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), LDA,
- $ RHS( 1 ), 1, ONE, C( 1, JS ), 1 )
- CALL DGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), LDD,
- $ RHS( 1 ), 1, ONE, F( 1, JS ), 1 )
- END IF
- IF( J.LT.Q ) THEN
- CALL DGER( MB, N-JE, ONE, RHS( 3 ), 1,
- $ B( JS, JE+1 ), LDB, C( IS, JE+1 ), LDC )
- CALL DGER( MB, N-JE, ONE, RHS( 3 ), 1,
- $ E( JS, JE+1 ), LDE, F( IS, JE+1 ), LDF )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build an 8-by-8 system Z * x = RHS
-*
- CALL DLASET( 'F', LDZ, LDZ, ZERO, ZERO, Z, LDZ )
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( ISP1, IS )
- Z( 5, 1 ) = D( IS, IS )
-*
- Z( 1, 2 ) = A( IS, ISP1 )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 5, 2 ) = D( IS, ISP1 )
- Z( 6, 2 ) = D( ISP1, ISP1 )
-*
- Z( 3, 3 ) = A( IS, IS )
- Z( 4, 3 ) = A( ISP1, IS )
- Z( 7, 3 ) = D( IS, IS )
-*
- Z( 3, 4 ) = A( IS, ISP1 )
- Z( 4, 4 ) = A( ISP1, ISP1 )
- Z( 7, 4 ) = D( IS, ISP1 )
- Z( 8, 4 ) = D( ISP1, ISP1 )
-*
- Z( 1, 5 ) = -B( JS, JS )
- Z( 3, 5 ) = -B( JS, JSP1 )
- Z( 5, 5 ) = -E( JS, JS )
- Z( 7, 5 ) = -E( JS, JSP1 )
-*
- Z( 2, 6 ) = -B( JS, JS )
- Z( 4, 6 ) = -B( JS, JSP1 )
- Z( 6, 6 ) = -E( JS, JS )
- Z( 8, 6 ) = -E( JS, JSP1 )
-*
- Z( 1, 7 ) = -B( JSP1, JS )
- Z( 3, 7 ) = -B( JSP1, JSP1 )
- Z( 7, 7 ) = -E( JSP1, JSP1 )
-*
- Z( 2, 8 ) = -B( JSP1, JS )
- Z( 4, 8 ) = -B( JSP1, JSP1 )
- Z( 8, 8 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- K = 1
- II = MB*NB + 1
- DO 80 JJ = 0, NB - 1
- CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
- CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
- K = K + MB
- II = II + MB
- 80 CONTINUE
-*
-* Solve Z * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
- IF( IJOB.EQ.0 ) THEN
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 90 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 90 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- K = 1
- II = MB*NB + 1
- DO 100 JJ = 0, NB - 1
- CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
- CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
- K = K + MB
- II = II + MB
- 100 CONTINUE
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ A( 1, IS ), LDA, RHS( 1 ), MB, ONE,
- $ C( 1, JS ), LDC )
- CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ D( 1, IS ), LDD, RHS( 1 ), MB, ONE,
- $ F( 1, JS ), LDF )
- END IF
- IF( J.LT.Q ) THEN
- K = MB*NB + 1
- CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
- $ MB, B( JS, JE+1 ), LDB, ONE,
- $ C( IS, JE+1 ), LDC )
- CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
- $ MB, E( JS, JE+1 ), LDE, ONE,
- $ F( IS, JE+1 ), LDF )
- END IF
-*
- END IF
-*
- 110 CONTINUE
- 120 CONTINUE
- ELSE
-*
-* Solve (I, J) - subsystem
-* A(I, I)**T * R(I, J) + D(I, I)**T * L(J, J) = C(I, J)
-* R(I, I) * B(J, J) + L(I, J) * E(J, J) = -F(I, J)
-* for I = 1, 2, ..., P, J = Q, Q - 1, ..., 1
-*
- SCALE = ONE
- SCALOC = ONE
- DO 200 I = 1, P
-*
- IS = IWORK( I )
- ISP1 = IS + 1
- IE = IWORK ( I+1 ) - 1
- MB = IE - IS + 1
- DO 190 J = Q, P + 2, -1
-*
- JS = IWORK( J )
- JSP1 = JS + 1
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- ZDIM = MB*NB*2
- IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 2-by-2 system Z**T * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = -B( JS, JS )
- Z( 1, 2 ) = D( IS, IS )
- Z( 2, 2 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = F( IS, JS )
-*
-* Solve Z**T * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 130 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 130 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- F( IS, JS ) = RHS( 2 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- ALPHA = RHS( 1 )
- CALL DAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, 1 ),
- $ LDF )
- ALPHA = RHS( 2 )
- CALL DAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, 1 ),
- $ LDF )
- END IF
- IF( I.LT.P ) THEN
- ALPHA = -RHS( 1 )
- CALL DAXPY( M-IE, ALPHA, A( IS, IE+1 ), LDA,
- $ C( IE+1, JS ), 1 )
- ALPHA = -RHS( 2 )
- CALL DAXPY( M-IE, ALPHA, D( IS, IE+1 ), LDD,
- $ C( IE+1, JS ), 1 )
- END IF
-*
- ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build a 4-by-4 system Z**T * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = ZERO
- Z( 3, 1 ) = -B( JS, JS )
- Z( 4, 1 ) = -B( JSP1, JS )
-*
- Z( 1, 2 ) = ZERO
- Z( 2, 2 ) = A( IS, IS )
- Z( 3, 2 ) = -B( JS, JSP1 )
- Z( 4, 2 ) = -B( JSP1, JSP1 )
-*
- Z( 1, 3 ) = D( IS, IS )
- Z( 2, 3 ) = ZERO
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = ZERO
-*
- Z( 1, 4 ) = ZERO
- Z( 2, 4 ) = D( IS, IS )
- Z( 3, 4 ) = -E( JS, JSP1 )
- Z( 4, 4 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( IS, JSP1 )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( IS, JSP1 )
-*
-* Solve Z**T * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 140 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 140 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( IS, JSP1 ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( IS, JSP1 ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL DAXPY( JS-1, RHS( 1 ), B( 1, JS ), 1,
- $ F( IS, 1 ), LDF )
- CALL DAXPY( JS-1, RHS( 2 ), B( 1, JSP1 ), 1,
- $ F( IS, 1 ), LDF )
- CALL DAXPY( JS-1, RHS( 3 ), E( 1, JS ), 1,
- $ F( IS, 1 ), LDF )
- CALL DAXPY( JS-1, RHS( 4 ), E( 1, JSP1 ), 1,
- $ F( IS, 1 ), LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL DGER( M-IE, NB, -ONE, A( IS, IE+1 ), LDA,
- $ RHS( 1 ), 1, C( IE+1, JS ), LDC )
- CALL DGER( M-IE, NB, -ONE, D( IS, IE+1 ), LDD,
- $ RHS( 3 ), 1, C( IE+1, JS ), LDC )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 4-by-4 system Z**T * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( IS, ISP1 )
- Z( 3, 1 ) = -B( JS, JS )
- Z( 4, 1 ) = ZERO
-*
- Z( 1, 2 ) = A( ISP1, IS )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 3, 2 ) = ZERO
- Z( 4, 2 ) = -B( JS, JS )
-*
- Z( 1, 3 ) = D( IS, IS )
- Z( 2, 3 ) = D( IS, ISP1 )
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = ZERO
-*
- Z( 1, 4 ) = ZERO
- Z( 2, 4 ) = D( ISP1, ISP1 )
- Z( 3, 4 ) = ZERO
- Z( 4, 4 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( ISP1, JS )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( ISP1, JS )
-*
-* Solve Z**T * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 150 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 150 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( ISP1, JS ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( ISP1, JS ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL DGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, JS ),
- $ 1, F( IS, 1 ), LDF )
- CALL DGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, JS ),
- $ 1, F( IS, 1 ), LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL DGEMV( 'T', MB, M-IE, -ONE, A( IS, IE+1 ),
- $ LDA, RHS( 1 ), 1, ONE, C( IE+1, JS ),
- $ 1 )
- CALL DGEMV( 'T', MB, M-IE, -ONE, D( IS, IE+1 ),
- $ LDD, RHS( 3 ), 1, ONE, C( IE+1, JS ),
- $ 1 )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build an 8-by-8 system Z**T * x = RHS
-*
- CALL DLASET( 'F', LDZ, LDZ, ZERO, ZERO, Z, LDZ )
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( IS, ISP1 )
- Z( 5, 1 ) = -B( JS, JS )
- Z( 7, 1 ) = -B( JSP1, JS )
-*
- Z( 1, 2 ) = A( ISP1, IS )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 6, 2 ) = -B( JS, JS )
- Z( 8, 2 ) = -B( JSP1, JS )
-*
- Z( 3, 3 ) = A( IS, IS )
- Z( 4, 3 ) = A( IS, ISP1 )
- Z( 5, 3 ) = -B( JS, JSP1 )
- Z( 7, 3 ) = -B( JSP1, JSP1 )
-*
- Z( 3, 4 ) = A( ISP1, IS )
- Z( 4, 4 ) = A( ISP1, ISP1 )
- Z( 6, 4 ) = -B( JS, JSP1 )
- Z( 8, 4 ) = -B( JSP1, JSP1 )
-*
- Z( 1, 5 ) = D( IS, IS )
- Z( 2, 5 ) = D( IS, ISP1 )
- Z( 5, 5 ) = -E( JS, JS )
-*
- Z( 2, 6 ) = D( ISP1, ISP1 )
- Z( 6, 6 ) = -E( JS, JS )
-*
- Z( 3, 7 ) = D( IS, IS )
- Z( 4, 7 ) = D( IS, ISP1 )
- Z( 5, 7 ) = -E( JS, JSP1 )
- Z( 7, 7 ) = -E( JSP1, JSP1 )
-*
- Z( 4, 8 ) = D( ISP1, ISP1 )
- Z( 6, 8 ) = -E( JS, JSP1 )
- Z( 8, 8 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- K = 1
- II = MB*NB + 1
- DO 160 JJ = 0, NB - 1
- CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
- CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
- K = K + MB
- II = II + MB
- 160 CONTINUE
-*
-*
-* Solve Z**T * x = RHS
-*
- CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 170 K = 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 170 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- K = 1
- II = MB*NB + 1
- DO 180 JJ = 0, NB - 1
- CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
- CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
- K = K + MB
- II = II + MB
- 180 CONTINUE
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE,
- $ C( IS, JS ), LDC, B( 1, JS ), LDB, ONE,
- $ F( IS, 1 ), LDF )
- CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE,
- $ F( IS, JS ), LDF, E( 1, JS ), LDE, ONE,
- $ F( IS, 1 ), LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ A( IS, IE+1 ), LDA, C( IS, JS ), LDC,
- $ ONE, C( IE+1, JS ), LDC )
- CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ D( IS, IE+1 ), LDD, F( IS, JS ), LDF,
- $ ONE, C( IE+1, JS ), LDC )
- END IF
-*
- END IF
-*
- 190 CONTINUE
- 200 CONTINUE
-*
- END IF
- RETURN
-*
-* End of DTGSY2
-*
- END
diff --git a/netlib/LAPACK/dtgsyl.f b/netlib/LAPACK/dtgsyl.f
deleted file mode 100644
index d589016..0000000
--- a/netlib/LAPACK/dtgsyl.f
+++ /dev/null
@@ -1,682 +0,0 @@
-*> \brief \b DTGSYL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTGSYL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsyl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsyl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsyl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-* LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
-* $ LWORK, M, N
-* DOUBLE PRECISION DIF, SCALE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
-* $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTGSYL solves the generalized Sylvester equation:
-*>
-*> A * R - L * B = scale * C (1)
-*> D * R - L * E = scale * F
-*>
-*> where R and L are unknown m-by-n matrices, (A, D), (B, E) and
-*> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
-*> respectively, with real entries. (A, D) and (B, E) must be in
-*> generalized (real) Schur canonical form, i.e. A, B are upper quasi
-*> triangular and D, E are upper triangular.
-*>
-*> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
-*> scaling factor chosen to avoid overflow.
-*>
-*> In matrix notation (1) is equivalent to solve Zx = scale b, where
-*> Z is defined as
-*>
-*> Z = [ kron(In, A) -kron(B**T, Im) ] (2)
-*> [ kron(In, D) -kron(E**T, Im) ].
-*>
-*> Here Ik is the identity matrix of size k and X**T is the transpose of
-*> X. kron(X, Y) is the Kronecker product between the matrices X and Y.
-*>
-*> If TRANS = 'T', DTGSYL solves the transposed system Z**T*y = scale*b,
-*> which is equivalent to solve for R and L in
-*>
-*> A**T * R + D**T * L = scale * C (3)
-*> R * B**T + L * E**T = scale * -F
-*>
-*> This case (TRANS = 'T') is used to compute an one-norm-based estimate
-*> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
-*> and (B,E), using DLACON.
-*>
-*> If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate
-*> of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
-*> reciprocal of the smallest singular value of Z. See [1-2] for more
-*> information.
-*>
-*> This is a level 3 BLAS algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N', solve the generalized Sylvester equation (1).
-*> = 'T', solve the 'transposed' system (3).
-*> \endverbatim
-*>
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies what kind of functionality to be performed.
-*> =0: solve (1) only.
-*> =1: The functionality of 0 and 3.
-*> =2: The functionality of 0 and 4.
-*> =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*> (look ahead strategy IJOB = 1 is used).
-*> =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*> ( DGECON on sub-systems is used ).
-*> Not referenced if TRANS = 'T'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The order of the matrices A and D, and the row dimension of
-*> the matrices C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices B and E, and the column dimension
-*> of the matrices C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA, M)
-*> The upper quasi triangular matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB, N)
-*> The upper quasi triangular matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC, N)
-*> On entry, C contains the right-hand-side of the first matrix
-*> equation in (1) or (3).
-*> On exit, if IJOB = 0, 1 or 2, C has been overwritten by
-*> the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
-*> the solution achieved during the computation of the
-*> Dif-estimate.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (LDD, M)
-*> The upper triangular matrix D.
-*> \endverbatim
-*>
-*> \param[in] LDD
-*> \verbatim
-*> LDD is INTEGER
-*> The leading dimension of the array D. LDD >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (LDE, N)
-*> The upper triangular matrix E.
-*> \endverbatim
-*>
-*> \param[in] LDE
-*> \verbatim
-*> LDE is INTEGER
-*> The leading dimension of the array E. LDE >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] F
-*> \verbatim
-*> F is DOUBLE PRECISION array, dimension (LDF, N)
-*> On entry, F contains the right-hand-side of the second matrix
-*> equation in (1) or (3).
-*> On exit, if IJOB = 0, 1 or 2, F has been overwritten by
-*> the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
-*> the solution achieved during the computation of the
-*> Dif-estimate.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of the array F. LDF >= max(1, M).
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is DOUBLE PRECISION
-*> On exit DIF is the reciprocal of a lower bound of the
-*> reciprocal of the Dif-function, i.e. DIF is an upper bound of
-*> Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
-*> IF IJOB = 0 or TRANS = 'T', DIF is not touched.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On exit SCALE is the scaling factor in (1) or (3).
-*> If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
-*> to a slightly perturbed system but the input matrices A, B, D
-*> and E have not been changed. If SCALE = 0, C and F hold the
-*> solutions R and L, respectively, to the homogeneous system
-*> with C = F = 0. Normally, SCALE = 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK > = 1.
-*> If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (M+N+6)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: successful exit
-*> <0: If INFO = -i, the i-th argument had an illegal value.
-*> >0: (A, D) and (B, E) have common or close eigenvalues.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*> for Solving the Generalized Sylvester Equation and Estimating the
-*> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*> Department of Computing Science, Umea University, S-901 87 Umea,
-*> Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*> Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
-*> No 1, 1996.
-*>
-*> [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
-*> Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
-*> Appl., 15(4):1045-1060, 1994
-*>
-*> [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
-*> Condition Estimators for Solving the Generalized Sylvester
-*> Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
-*> July 1989, pp 745-751.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
- $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
- $ LWORK, M, N
- DOUBLE PRECISION DIF, SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-* Replaced various illegal calls to DCOPY by calls to DLASET.
-* Sven Hammarling, 1/5/02.
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, NOTRAN
- INTEGER I, IE, IFUNC, IROUND, IS, ISOLVE, J, JE, JS, K,
- $ LINFO, LWMIN, MB, NB, P, PPQQ, PQ, Q
- DOUBLE PRECISION DSCALE, DSUM, SCALE2, SCALOC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLACPY, DLASET, DSCAL, DTGSY2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test input parameters
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -1
- ELSE IF( NOTRAN ) THEN
- IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.4 ) ) THEN
- INFO = -2
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( M.LE.0 ) THEN
- INFO = -3
- ELSE IF( N.LE.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
- INFO = -12
- ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
- INFO = -16
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( NOTRAN ) THEN
- IF( IJOB.EQ.1 .OR. IJOB.EQ.2 ) THEN
- LWMIN = MAX( 1, 2*M*N )
- ELSE
- LWMIN = 1
- END IF
- ELSE
- LWMIN = 1
- END IF
- WORK( 1 ) = LWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTGSYL', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- SCALE = 1
- IF( NOTRAN ) THEN
- IF( IJOB.NE.0 ) THEN
- DIF = 0
- END IF
- END IF
- RETURN
- END IF
-*
-* Determine optimal block sizes MB and NB
-*
- MB = ILAENV( 2, 'DTGSYL', TRANS, M, N, -1, -1 )
- NB = ILAENV( 5, 'DTGSYL', TRANS, M, N, -1, -1 )
-*
- ISOLVE = 1
- IFUNC = 0
- IF( NOTRAN ) THEN
- IF( IJOB.GE.3 ) THEN
- IFUNC = IJOB - 2
- CALL DLASET( 'F', M, N, ZERO, ZERO, C, LDC )
- CALL DLASET( 'F', M, N, ZERO, ZERO, F, LDF )
- ELSE IF( IJOB.GE.1 ) THEN
- ISOLVE = 2
- END IF
- END IF
-*
- IF( ( MB.LE.1 .AND. NB.LE.1 ) .OR. ( MB.GE.M .AND. NB.GE.N ) )
- $ THEN
-*
- DO 30 IROUND = 1, ISOLVE
-*
-* Use unblocked Level 2 solver
-*
- DSCALE = ZERO
- DSUM = ONE
- PQ = 0
- CALL DTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D,
- $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE,
- $ IWORK, PQ, INFO )
- IF( DSCALE.NE.ZERO ) THEN
- IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
- DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
- ELSE
- DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
- END IF
- END IF
-*
- IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
- IF( NOTRAN ) THEN
- IFUNC = IJOB
- END IF
- SCALE2 = SCALE
- CALL DLACPY( 'F', M, N, C, LDC, WORK, M )
- CALL DLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
- CALL DLASET( 'F', M, N, ZERO, ZERO, C, LDC )
- CALL DLASET( 'F', M, N, ZERO, ZERO, F, LDF )
- ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
- CALL DLACPY( 'F', M, N, WORK, M, C, LDC )
- CALL DLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
- SCALE = SCALE2
- END IF
- 30 CONTINUE
-*
- RETURN
- END IF
-*
-* Determine block structure of A
-*
- P = 0
- I = 1
- 40 CONTINUE
- IF( I.GT.M )
- $ GO TO 50
- P = P + 1
- IWORK( P ) = I
- I = I + MB
- IF( I.GE.M )
- $ GO TO 50
- IF( A( I, I-1 ).NE.ZERO )
- $ I = I + 1
- GO TO 40
- 50 CONTINUE
-*
- IWORK( P+1 ) = M + 1
- IF( IWORK( P ).EQ.IWORK( P+1 ) )
- $ P = P - 1
-*
-* Determine block structure of B
-*
- Q = P + 1
- J = 1
- 60 CONTINUE
- IF( J.GT.N )
- $ GO TO 70
- Q = Q + 1
- IWORK( Q ) = J
- J = J + NB
- IF( J.GE.N )
- $ GO TO 70
- IF( B( J, J-1 ).NE.ZERO )
- $ J = J + 1
- GO TO 60
- 70 CONTINUE
-*
- IWORK( Q+1 ) = N + 1
- IF( IWORK( Q ).EQ.IWORK( Q+1 ) )
- $ Q = Q - 1
-*
- IF( NOTRAN ) THEN
-*
- DO 150 IROUND = 1, ISOLVE
-*
-* Solve (I, J)-subsystem
-* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-* for I = P, P - 1,..., 1; J = 1, 2,..., Q
-*
- DSCALE = ZERO
- DSUM = ONE
- PQ = 0
- SCALE = ONE
- DO 130 J = P + 2, Q
- JS = IWORK( J )
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- DO 120 I = P, 1, -1
- IS = IWORK( I )
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- PPQQ = 0
- CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
- $ B( JS, JS ), LDB, C( IS, JS ), LDC,
- $ D( IS, IS ), LDD, E( JS, JS ), LDE,
- $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
- $ IWORK( Q+2 ), PPQQ, LINFO )
- IF( LINFO.GT.0 )
- $ INFO = LINFO
-*
- PQ = PQ + PPQQ
- IF( SCALOC.NE.ONE ) THEN
- DO 80 K = 1, JS - 1
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 80 CONTINUE
- DO 90 K = JS, JE
- CALL DSCAL( IS-1, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( IS-1, SCALOC, F( 1, K ), 1 )
- 90 CONTINUE
- DO 100 K = JS, JE
- CALL DSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
- CALL DSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
- 100 CONTINUE
- DO 110 K = JE + 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 110 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ A( 1, IS ), LDA, C( IS, JS ), LDC, ONE,
- $ C( 1, JS ), LDC )
- CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ D( 1, IS ), LDD, C( IS, JS ), LDC, ONE,
- $ F( 1, JS ), LDF )
- END IF
- IF( J.LT.Q ) THEN
- CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE,
- $ F( IS, JS ), LDF, B( JS, JE+1 ), LDB,
- $ ONE, C( IS, JE+1 ), LDC )
- CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE,
- $ F( IS, JS ), LDF, E( JS, JE+1 ), LDE,
- $ ONE, F( IS, JE+1 ), LDF )
- END IF
- 120 CONTINUE
- 130 CONTINUE
- IF( DSCALE.NE.ZERO ) THEN
- IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
- DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
- ELSE
- DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
- END IF
- END IF
- IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
- IF( NOTRAN ) THEN
- IFUNC = IJOB
- END IF
- SCALE2 = SCALE
- CALL DLACPY( 'F', M, N, C, LDC, WORK, M )
- CALL DLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
- CALL DLASET( 'F', M, N, ZERO, ZERO, C, LDC )
- CALL DLASET( 'F', M, N, ZERO, ZERO, F, LDF )
- ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
- CALL DLACPY( 'F', M, N, WORK, M, C, LDC )
- CALL DLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
- SCALE = SCALE2
- END IF
- 150 CONTINUE
-*
- ELSE
-*
-* Solve transposed (I, J)-subsystem
-* A(I, I)**T * R(I, J) + D(I, I)**T * L(I, J) = C(I, J)
-* R(I, J) * B(J, J)**T + L(I, J) * E(J, J)**T = -F(I, J)
-* for I = 1,2,..., P; J = Q, Q-1,..., 1
-*
- SCALE = ONE
- DO 210 I = 1, P
- IS = IWORK( I )
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- DO 200 J = Q, P + 2, -1
- JS = IWORK( J )
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
- $ B( JS, JS ), LDB, C( IS, JS ), LDC,
- $ D( IS, IS ), LDD, E( JS, JS ), LDE,
- $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
- $ IWORK( Q+2 ), PPQQ, LINFO )
- IF( LINFO.GT.0 )
- $ INFO = LINFO
- IF( SCALOC.NE.ONE ) THEN
- DO 160 K = 1, JS - 1
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 160 CONTINUE
- DO 170 K = JS, JE
- CALL DSCAL( IS-1, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( IS-1, SCALOC, F( 1, K ), 1 )
- 170 CONTINUE
- DO 180 K = JS, JE
- CALL DSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
- CALL DSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
- 180 CONTINUE
- DO 190 K = JE + 1, N
- CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
- 190 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Substitute R(I, J) and L(I, J) into remaining equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, JS ),
- $ LDC, B( 1, JS ), LDB, ONE, F( IS, 1 ),
- $ LDF )
- CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, JS ),
- $ LDF, E( 1, JS ), LDE, ONE, F( IS, 1 ),
- $ LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ A( IS, IE+1 ), LDA, C( IS, JS ), LDC, ONE,
- $ C( IE+1, JS ), LDC )
- CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ D( IS, IE+1 ), LDD, F( IS, JS ), LDF, ONE,
- $ C( IE+1, JS ), LDC )
- END IF
- 200 CONTINUE
- 210 CONTINUE
-*
- END IF
-*
- WORK( 1 ) = LWMIN
-*
- RETURN
-*
-* End of DTGSYL
-*
- END
diff --git a/netlib/LAPACK/dtpcon.f b/netlib/LAPACK/dtpcon.f
deleted file mode 100644
index 2619891..0000000
--- a/netlib/LAPACK/dtpcon.f
+++ /dev/null
@@ -1,267 +0,0 @@
-*> \brief \b DTPCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER INFO, N
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPCON estimates the reciprocal of the condition number of a packed
-*> triangular matrix A, in either the 1-norm or the infinity-norm.
-*>
-*> The norm of A is computed and an estimate is obtained for
-*> norm(inv(A)), then the reciprocal of the condition number is
-*> computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER INFO, N
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, ONENRM, UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLANTP
- EXTERNAL LSAME, IDAMAX, DLAMCH, DLANTP
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATPS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- END IF
-*
- RCOND = ZERO
- SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) )
-*
-* Compute the norm of the triangular matrix A.
-*
- ANORM = DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
-*
-* Continue only if ANORM > 0.
-*
- IF( ANORM.GT.ZERO ) THEN
-*
-* Estimate the norm of the inverse of A.
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(A).
-*
- CALL DLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP,
- $ WORK, SCALE, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(A**T).
-*
- CALL DLATPS( UPLO, 'Transpose', DIAG, NORMIN, N, AP,
- $ WORK, SCALE, WORK( 2*N+1 ), INFO )
- END IF
- NORMIN = 'Y'
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- XNORM = ABS( WORK( IX ) )
- IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / ANORM ) / AINVNM
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of DTPCON
-*
- END
diff --git a/netlib/LAPACK/dtpmqrt.f b/netlib/LAPACK/dtpmqrt.f
deleted file mode 100644
index baeffa0..0000000
--- a/netlib/LAPACK/dtpmqrt.f
+++ /dev/null
@@ -1,366 +0,0 @@
-*> \brief \b DTPMQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPMQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpmqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpmqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpmqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
-* A, LDA, B, LDB, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION V( LDV, * ), A( LDA, * ), B( LDB, * ),
-* $ T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPMQRT applies a real orthogonal matrix Q obtained from a
-*> "triangular-pentagonal" real block reflector H to a general
-*> real matrix C, which consists of two blocks A and B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix B. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The order of the trapezoidal part of V.
-*> K >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size used for the storage of T. K >= NB >= 1.
-*> This must be the same value of NB used to generate T
-*> in CTPQRT.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> CTPQRT in B. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDV >= max(1,M);
-*> if SIDE = 'R', LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The upper triangular factors of the block reflectors
-*> as returned by CTPQRT, stored as a NB-by-K matrix.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,N) if SIDE = 'L' or
-*> (LDA,K) if SIDE = 'R'
-*> On entry, the K-by-N or M-by-K matrix A.
-*> On exit, A is overwritten by the corresponding block of
-*> Q*C or Q**T*C or C*Q or C*Q**T. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDC >= max(1,K);
-*> If SIDE = 'R', LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the M-by-N matrix B.
-*> On exit, B is overwritten by the corresponding block of
-*> Q*C or Q**T*C or C*Q or C*Q**T. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B.
-*> LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array. The dimension of WORK is
-*> N*NB if SIDE = 'L', or M*NB if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The columns of the pentagonal matrix V contain the elementary reflectors
-*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a
-*> trapezoidal block V2:
-*>
-*> V = [V1]
-*> [V2].
-*>
-*> The size of the trapezoidal block V2 is determined by the parameter L,
-*> where 0 <= L <= K; V2 is upper trapezoidal, consisting of the first L
-*> rows of a K-by-K upper triangular matrix. If L=K, V2 is upper triangular;
-*> if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
-*>
-*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is M-by-K.
-*> [B]
-*>
-*> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is N-by-K.
-*>
-*> The real orthogonal matrix Q is formed from V and T.
-*>
-*> If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
-*>
-*> If TRANS='T' and SIDE='L', C is on exit replaced with Q**T * C.
-*>
-*> If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
-*>
-*> If TRANS='T' and SIDE='R', C is on exit replaced with C * Q**T.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
- $ A, LDA, B, LDB, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION V( LDV, * ), A( LDA, * ), B( LDB, * ),
- $ T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, MB, LB, KF, Q
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DLARFB
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* .. Test the input arguments ..
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- RIGHT = LSAME( SIDE, 'R' )
- TRAN = LSAME( TRANS, 'T' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
- IF( LEFT ) THEN
- Q = M
- ELSE IF ( RIGHT ) THEN
- Q = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
- INFO = -1
- ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 ) THEN
- INFO = -5
- ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
- INFO = -6
- ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN
- INFO = -7
- ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
- INFO = -9
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -11
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -13
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -15
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPMQRT', -INFO )
- RETURN
- END IF
-*
-* .. Quick return if possible ..
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
-*
- IF( LEFT .AND. TRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( M-L+I+IB-1, M )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-M+L-I+1
- END IF
- CALL DTPRFB( 'L', 'T', 'F', 'C', MB, N, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( I, 1 ), LDA, B, LDB, WORK, IB )
- END DO
-*
- ELSE IF( RIGHT .AND. NOTRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( N-L+I+IB-1, N )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-N+L-I+1
- END IF
- CALL DTPRFB( 'R', 'N', 'F', 'C', M, MB, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( 1, I ), LDA, B, LDB, WORK, M )
- END DO
-*
- ELSE IF( LEFT .AND. NOTRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( M-L+I+IB-1, M )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-M+L-I+1
- END IF
- CALL DTPRFB( 'L', 'N', 'F', 'C', MB, N, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( I, 1 ), LDA, B, LDB, WORK, IB )
- END DO
-*
- ELSE IF( RIGHT .AND. TRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( N-L+I+IB-1, N )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-N+L-I+1
- END IF
- CALL DTPRFB( 'R', 'T', 'F', 'C', M, MB, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( 1, I ), LDA, B, LDB, WORK, M )
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of DTPMQRT
-*
- END
diff --git a/netlib/LAPACK/dtpqrt.f b/netlib/LAPACK/dtpqrt.f
deleted file mode 100644
index 95f6fde..0000000
--- a/netlib/LAPACK/dtpqrt.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b DTPQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPQRT computes a blocked QR factorization of a real
-*> "triangular-pentagonal" matrix C, which is composed of a
-*> triangular block A and pentagonal block B, using the compact
-*> WY representation for Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix B.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B, and the order of the
-*> triangular matrix A.
-*> N >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of rows of the upper trapezoidal part of B.
-*> MIN(M,N) >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size to be used in the blocked QR. N >= NB >= 1.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the upper triangular N-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the pentagonal M-by-N matrix B. The first M-L rows
-*> are rectangular, and the last L rows are upper trapezoidal.
-*> On exit, B contains the pentagonal matrix V. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The upper triangular block reflectors stored in compact form
-*> as a sequence of upper triangular blocks. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (NB*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The input matrix C is a (N+M)-by-N matrix
-*>
-*> C = [ A ]
-*> [ B ]
-*>
-*> where A is an upper triangular N-by-N matrix, and B is M-by-N pentagonal
-*> matrix consisting of a (M-L)-by-N rectangular matrix B1 on top of a L-by-N
-*> upper trapezoidal matrix B2:
-*>
-*> B = [ B1 ] <- (M-L)-by-N rectangular
-*> [ B2 ] <- L-by-N upper trapezoidal.
-*>
-*> The upper trapezoidal matrix B2 consists of the first L rows of a
-*> N-by-N upper triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
-*> B is rectangular M-by-N; if M=L=N, B is upper triangular.
-*>
-*> The matrix W stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal (of A) in the (N+M)-by-N input matrix C
-*>
-*> C = [ A ] <- upper triangular N-by-N
-*> [ B ] <- M-by-N pentagonal
-*>
-*> so that W can be represented as
-*>
-*> W = [ I ] <- identity, N-by-N
-*> [ V ] <- M-by-N, same form as B.
-*>
-*> Thus, all of information needed for W is contained on exit in B, which
-*> we call V above. Note that V has the same form as B; that is,
-*>
-*> V = [ V1 ] <- (M-L)-by-N rectangular
-*> [ V2 ] <- L-by-N upper trapezoidal.
-*>
-*> The columns of V represent the vectors which define the H(i)'s.
-*>
-*> The number of blocks is B = ceiling(N/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = N - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
-*>
-*> T = [T1 T2 ... TB].
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- INTEGER I, IB, LB, MB, IINFO
-* ..
-* .. External Subroutines ..
- EXTERNAL DTPQRT2, DTPRFB, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
- INFO = -3
- ELSE IF( NB.LT.1 .OR. NB.GT.N ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -8
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPQRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) RETURN
-*
- DO I = 1, N, NB
-*
-* Compute the QR factorization of the current block
-*
- IB = MIN( N-I+1, NB )
- MB = MIN( M-L+I+IB-1, M )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-M+L-I+1
- END IF
-*
- CALL DTPQRT2( MB, IB, LB, A(I,I), LDA, B( 1, I ), LDB,
- $ T(1, I ), LDT, IINFO )
-*
-* Update by applying H**T to B(:,I+IB:N) from the left
-*
- IF( I+IB.LE.N ) THEN
- CALL DTPRFB( 'L', 'T', 'F', 'C', MB, N-I-IB+1, IB, LB,
- $ B( 1, I ), LDB, T( 1, I ), LDT,
- $ A( I, I+IB ), LDA, B( 1, I+IB ), LDB,
- $ WORK, IB )
- END IF
- END DO
- RETURN
-*
-* End of DTPQRT
-*
- END
diff --git a/netlib/LAPACK/dtpqrt2.f b/netlib/LAPACK/dtpqrt2.f
deleted file mode 100644
index ca2da23..0000000
--- a/netlib/LAPACK/dtpqrt2.f
+++ /dev/null
@@ -1,302 +0,0 @@
-*> \brief \b DTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPQRT2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpqrt2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpqrt2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpqrt2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LDT, N, M, L
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPQRT2 computes a QR factorization of a real "triangular-pentagonal"
-*> matrix C, which is composed of a triangular block A and pentagonal block B,
-*> using the compact WY representation for Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of rows of the matrix B.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B, and the order of
-*> the triangular matrix A.
-*> N >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of rows of the upper trapezoidal part of B.
-*> MIN(M,N) >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the upper triangular N-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the pentagonal M-by-N matrix B. The first M-L rows
-*> are rectangular, and the last L rows are upper trapezoidal.
-*> On exit, B contains the pentagonal matrix V. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The N-by-N upper triangular factor T of the block reflector.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The input matrix C is a (N+M)-by-N matrix
-*>
-*> C = [ A ]
-*> [ B ]
-*>
-*> where A is an upper triangular N-by-N matrix, and B is M-by-N pentagonal
-*> matrix consisting of a (M-L)-by-N rectangular matrix B1 on top of a L-by-N
-*> upper trapezoidal matrix B2:
-*>
-*> B = [ B1 ] <- (M-L)-by-N rectangular
-*> [ B2 ] <- L-by-N upper trapezoidal.
-*>
-*> The upper trapezoidal matrix B2 consists of the first L rows of a
-*> N-by-N upper triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
-*> B is rectangular M-by-N; if M=L=N, B is upper triangular.
-*>
-*> The matrix W stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal (of A) in the (N+M)-by-N input matrix C
-*>
-*> C = [ A ] <- upper triangular N-by-N
-*> [ B ] <- M-by-N pentagonal
-*>
-*> so that W can be represented as
-*>
-*> W = [ I ] <- identity, N-by-N
-*> [ V ] <- M-by-N, same form as B.
-*>
-*> Thus, all of information needed for W is contained on exit in B, which
-*> we call V above. Note that V has the same form as B; that is,
-*>
-*> V = [ V1 ] <- (M-L)-by-N rectangular
-*> [ V2 ] <- L-by-N upper trapezoidal.
-*>
-*> The columns of V represent the vectors which define the H(i)'s.
-*> The (M+N)-by-(M+N) block reflector H is then given by
-*>
-*> H = I - W * T * W**T
-*>
-*> where W^H is the conjugate transpose of W and T is the upper triangular
-*> factor of the block reflector.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LDT, N, M, L
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER( ONE = 1.0, ZERO = 0.0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, P, MP, NP
- DOUBLE PRECISION ALPHA
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFG, DGEMV, DGER, DTRMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -7
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPQRT2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 ) RETURN
-*
- DO I = 1, N
-*
-* Generate elementary reflector H(I) to annihilate B(:,I)
-*
- P = M-L+MIN( L, I )
- CALL DLARFG( P+1, A( I, I ), B( 1, I ), 1, T( I, 1 ) )
- IF( I.LT.N ) THEN
-*
-* W(1:N-I) := C(I:M,I+1:N)^H * C(I:M,I) [use W = T(:,N)]
-*
- DO J = 1, N-I
- T( J, N ) = (A( I, I+J ))
- END DO
- CALL DGEMV( 'T', P, N-I, ONE, B( 1, I+1 ), LDB,
- $ B( 1, I ), 1, ONE, T( 1, N ), 1 )
-*
-* C(I:M,I+1:N) = C(I:m,I+1:N) + alpha*C(I:M,I)*W(1:N-1)^H
-*
- ALPHA = -(T( I, 1 ))
- DO J = 1, N-I
- A( I, I+J ) = A( I, I+J ) + ALPHA*(T( J, N ))
- END DO
- CALL DGER( P, N-I, ALPHA, B( 1, I ), 1,
- $ T( 1, N ), 1, B( 1, I+1 ), LDB )
- END IF
- END DO
-*
- DO I = 2, N
-*
-* T(1:I-1,I) := C(I:M,1:I-1)^H * (alpha * C(I:M,I))
-*
- ALPHA = -T( I, 1 )
-
- DO J = 1, I-1
- T( J, I ) = ZERO
- END DO
- P = MIN( I-1, L )
- MP = MIN( M-L+1, M )
- NP = MIN( P+1, N )
-*
-* Triangular part of B2
-*
- DO J = 1, P
- T( J, I ) = ALPHA*B( M-L+J, I )
- END DO
- CALL DTRMV( 'U', 'T', 'N', P, B( MP, 1 ), LDB,
- $ T( 1, I ), 1 )
-*
-* Rectangular part of B2
-*
- CALL DGEMV( 'T', L, I-1-P, ALPHA, B( MP, NP ), LDB,
- $ B( MP, I ), 1, ZERO, T( NP, I ), 1 )
-*
-* B1
-*
- CALL DGEMV( 'T', M-L, I-1, ALPHA, B, LDB, B( 1, I ), 1,
- $ ONE, T( 1, I ), 1 )
-*
-* T(1:I-1,I) := T(1:I-1,1:I-1) * T(1:I-1,I)
-*
- CALL DTRMV( 'U', 'N', 'N', I-1, T, LDT, T( 1, I ), 1 )
-*
-* T(I,I) = tau(I)
-*
- T( I, I ) = T( I, 1 )
- T( I, 1 ) = ZERO
- END DO
-
-*
-* End of DTPQRT2
-*
- END
diff --git a/netlib/LAPACK/dtprfb.f b/netlib/LAPACK/dtprfb.f
deleted file mode 100644
index 08976d0..0000000
--- a/netlib/LAPACK/dtprfb.f
+++ /dev/null
@@ -1,811 +0,0 @@
-*> \brief \b DTPRFB applies a real or complex "triangular-pentagonal" blocked reflector to a real or complex matrix, which is composed of two blocks.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPRFB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtprfb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtprfb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtprfb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L,
-* V, LDV, T, LDT, A, LDA, B, LDB, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, L, LDA, LDB, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPRFB applies a real "triangular-pentagonal" block reflector H or its
-*> transpose H**T to a real matrix C, which is composed of two
-*> blocks A and B, either from the left or right.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H**T from the Left
-*> = 'R': apply H or H**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'T': apply H**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = '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
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columns
-*> = 'R': Rows
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix B.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B.
-*> N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T, i.e. the number of elementary
-*> reflectors whose product defines the block reflector.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The order of the trapezoidal part of V.
-*> K >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
-*> The pentagonal matrix V, which contains the elementary reflectors
-*> H(1), H(2), ..., H(K). See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
-*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*> if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The triangular K-by-K matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T.
-*> LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,N) if SIDE = 'L' or (LDA,K) if SIDE = 'R'
-*> On entry, the K-by-N or M-by-K matrix A.
-*> On exit, A is overwritten by the corresponding block of
-*> H*C or H**T*C or C*H or C*H**T. See Futher Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDC >= max(1,K);
-*> If SIDE = 'R', LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On entry, the M-by-N matrix B.
-*> On exit, B is overwritten by the corresponding block of
-*> H*C or H**T*C or C*H or C*H**T. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B.
-*> LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (LDWORK,N) if SIDE = 'L',
-*> (LDWORK,K) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= K;
-*> if SIDE = 'R', LDWORK >= M.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix C is a composite matrix formed from blocks A and B.
-*> The block B is of size M-by-N; if SIDE = 'R', A is of size M-by-K,
-*> and if SIDE = 'L', A is of size K-by-N.
-*>
-*> If SIDE = 'R' and DIRECT = 'F', C = [A B].
-*>
-*> If SIDE = 'L' and DIRECT = 'F', C = [A]
-*> [B].
-*>
-*> If SIDE = 'R' and DIRECT = 'B', C = [B A].
-*>
-*> If SIDE = 'L' and DIRECT = 'B', C = [B]
-*> [A].
-*>
-*> The pentagonal matrix V is composed of a rectangular block V1 and a
-*> trapezoidal block V2. The size of the trapezoidal block is determined by
-*> the parameter L, where 0<=L<=K. If L=K, the V2 block of V is triangular;
-*> if L=0, there is no trapezoidal block, thus V = V1 is rectangular.
-*>
-*> If DIRECT = 'F' and STOREV = 'C': V = [V1]
-*> [V2]
-*> - V2 is upper trapezoidal (first L rows of K-by-K upper triangular)
-*>
-*> If DIRECT = 'F' and STOREV = 'R': V = [V1 V2]
-*>
-*> - V2 is lower trapezoidal (first L columns of K-by-K lower triangular)
-*>
-*> If DIRECT = 'B' and STOREV = 'C': V = [V2]
-*> [V1]
-*> - V2 is lower trapezoidal (last L rows of K-by-K lower triangular)
-*>
-*> If DIRECT = 'B' and STOREV = 'R': V = [V2 V1]
-*>
-*> - V2 is upper trapezoidal (last L columns of K-by-K upper triangular)
-*>
-*> If STOREV = 'C' and SIDE = 'L', V is M-by-K with V2 L-by-K.
-*>
-*> If STOREV = 'C' and SIDE = 'R', V is N-by-K with V2 L-by-K.
-*>
-*> If STOREV = 'R' and SIDE = 'L', V is K-by-M with V2 K-by-L.
-*>
-*> If STOREV = 'R' and SIDE = 'R', V is K-by-N with V2 K-by-L.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L,
- $ V, LDV, T, LDT, A, LDA, B, LDB, WORK, LDWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, L, LDA, LDB, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ),
- $ V( LDV, * ), WORK( LDWORK, * )
-* ..
-*
-* ==========================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0, ZERO = 0.0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, MP, NP, KP
- LOGICAL LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DTRMM
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 .OR. L.LT.0 ) RETURN
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
- COLUMN = .TRUE.
- ROW = .FALSE.
- ELSE IF ( LSAME( STOREV, 'R' ) ) THEN
- COLUMN = .FALSE.
- ROW = .TRUE.
- ELSE
- COLUMN = .FALSE.
- ROW = .FALSE.
- END IF
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
- LEFT = .TRUE.
- RIGHT = .FALSE.
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
- LEFT = .FALSE.
- RIGHT = .TRUE.
- ELSE
- LEFT = .FALSE.
- RIGHT = .FALSE.
- END IF
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
- FORWARD = .TRUE.
- BACKWARD = .FALSE.
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- FORWARD = .FALSE.
- BACKWARD = .TRUE.
- ELSE
- FORWARD = .FALSE.
- BACKWARD = .FALSE.
- END IF
-*
-* ---------------------------------------------------------------------------
-*
- IF( COLUMN .AND. FORWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I ] (K-by-K)
-* [ V ] (M-by-K)
-*
-* Form H C or H**T C where C = [ A ] (K-by-N)
-* [ B ] (M-by-N)
-*
-* H = I - W T W**T or H**T = I - W T**T W**T
-*
-* A = A - T (A + V**T B) or A = A - T**T (A + V**T B)
-* B = B - V T (A + V**T B) or B = B - V T**T (A + V**T B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( M-L+1, M )
- KP = MIN( L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( I, J ) = B( M-L+I, J )
- END DO
- END DO
- CALL DTRMM( 'L', 'U', 'T', 'N', L, N, ONE, V( MP, 1 ), LDV,
- $ WORK, LDWORK )
- CALL DGEMM( 'T', 'N', L, N, M-L, ONE, V, LDV, B, LDB,
- $ ONE, WORK, LDWORK )
- CALL DGEMM( 'T', 'N', K-L, N, M, ONE, V( 1, KP ), LDV,
- $ B, LDB, ZERO, WORK( KP, 1 ), LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'N', 'N', M-L, N, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, B, LDB )
- CALL DGEMM( 'N', 'N', L, N, K-L, -ONE, V( MP, KP ), LDV,
- $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB )
- CALL DTRMM( 'L', 'U', 'N', 'N', L, N, ONE, V( MP, 1 ), LDV,
- $ WORK, LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( M-L+I, J ) = B( M-L+I, J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( COLUMN .AND. FORWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I ] (K-by-K)
-* [ V ] (N-by-K)
-*
-* Form C H or C H**T where C = [ A B ] (A is M-by-K, B is M-by-N)
-*
-* H = I - W T W**T or H**T = I - W T**T W**T
-*
-* A = A - (A + B V) T or A = A - (A + B V) T**T
-* B = B - (A + B V) T V**T or B = B - (A + B V) T**T V**T
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( N-L+1, N )
- KP = MIN( L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, J ) = B( I, N-L+J )
- END DO
- END DO
- CALL DTRMM( 'R', 'U', 'N', 'N', M, L, ONE, V( NP, 1 ), LDV,
- $ WORK, LDWORK )
- CALL DGEMM( 'N', 'N', M, L, N-L, ONE, B, LDB,
- $ V, LDV, ONE, WORK, LDWORK )
- CALL DGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB,
- $ V( 1, KP ), LDV, ZERO, WORK( 1, KP ), LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'N', 'T', M, N-L, K, -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL DGEMM( 'N', 'T', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK,
- $ V( NP, KP ), LDV, ONE, B( 1, NP ), LDB )
- CALL DTRMM( 'R', 'U', 'T', 'N', M, L, ONE, V( NP, 1 ), LDV,
- $ WORK, LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, N-L+J ) = B( I, N-L+J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( COLUMN .AND. BACKWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V ] (M-by-K)
-* [ I ] (K-by-K)
-*
-* Form H C or H**T C where C = [ B ] (M-by-N)
-* [ A ] (K-by-N)
-*
-* H = I - W T W**T or H**T = I - W T**T W**T
-*
-* A = A - T (A + V**T B) or A = A - T**T (A + V**T B)
-* B = B - V T (A + V**T B) or B = B - V T**T (A + V**T B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( L+1, M )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( K-L+I, J ) = B( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'L', 'L', 'T', 'N', L, N, ONE, V( 1, KP ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- CALL DGEMM( 'T', 'N', L, N, M-L, ONE, V( MP, KP ), LDV,
- $ B( MP, 1 ), LDB, ONE, WORK( KP, 1 ), LDWORK )
- CALL DGEMM( 'T', 'N', K-L, N, M, ONE, V, LDV,
- $ B, LDB, ZERO, WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'L', 'L', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'N', 'N', M-L, N, K, -ONE, V( MP, 1 ), LDV,
- $ WORK, LDWORK, ONE, B( MP, 1 ), LDB )
- CALL DGEMM( 'N', 'N', L, N, K-L, -ONE, V, LDV,
- $ WORK, LDWORK, ONE, B, LDB )
- CALL DTRMM( 'L', 'L', 'N', 'N', L, N, ONE, V( 1, KP ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( I, J ) = B( I, J ) - WORK( K-L+I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( COLUMN .AND. BACKWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V ] (N-by-K)
-* [ I ] (K-by-K)
-*
-* Form C H or C H**T where C = [ B A ] (B is M-by-N, A is M-by-K)
-*
-* H = I - W T W**T or H**T = I - W T**T W**T
-*
-* A = A - (A + B V) T or A = A - (A + B V) T**T
-* B = B - (A + B V) T V**T or B = B - (A + B V) T**T V**T
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( L+1, N )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, K-L+J ) = B( I, J )
- END DO
- END DO
- CALL DTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, KP ), LDV,
- $ WORK( 1, KP ), LDWORK )
- CALL DGEMM( 'N', 'N', M, L, N-L, ONE, B( 1, NP ), LDB,
- $ V( NP, KP ), LDV, ONE, WORK( 1, KP ), LDWORK )
- CALL DGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB,
- $ V, LDV, ZERO, WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'N', 'T', M, N-L, K, -ONE, WORK, LDWORK,
- $ V( NP, 1 ), LDV, ONE, B( 1, NP ), LDB )
- CALL DGEMM( 'N', 'T', M, L, K-L, -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL DTRMM( 'R', 'L', 'T', 'N', M, L, ONE, V( 1, KP ), LDV,
- $ WORK( 1, KP ), LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, J ) = B( I, J ) - WORK( I, K-L+J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. FORWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I V ] ( I is K-by-K, V is K-by-M )
-*
-* Form H C or H**T C where C = [ A ] (K-by-N)
-* [ B ] (M-by-N)
-*
-* H = I - W**T T W or H**T = I - W**T T**T W
-*
-* A = A - T (A + V B) or A = A - T**T (A + V B)
-* B = B - V**T T (A + V B) or B = B - V**T T**T (A + V B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( M-L+1, M )
- KP = MIN( L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( I, J ) = B( M-L+I, J )
- END DO
- END DO
- CALL DTRMM( 'L', 'L', 'N', 'N', L, N, ONE, V( 1, MP ), LDV,
- $ WORK, LDB )
- CALL DGEMM( 'N', 'N', L, N, M-L, ONE, V, LDV,B, LDB,
- $ ONE, WORK, LDWORK )
- CALL DGEMM( 'N', 'N', K-L, N, M, ONE, V( KP, 1 ), LDV,
- $ B, LDB, ZERO, WORK( KP, 1 ), LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'T', 'N', M-L, N, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, B, LDB )
- CALL DGEMM( 'T', 'N', L, N, K-L, -ONE, V( KP, MP ), LDV,
- $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB )
- CALL DTRMM( 'L', 'L', 'T', 'N', L, N, ONE, V( 1, MP ), LDV,
- $ WORK, LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( M-L+I, J ) = B( M-L+I, J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. FORWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I V ] ( I is K-by-K, V is K-by-N )
-*
-* Form C H or C H**T where C = [ A B ] (A is M-by-K, B is M-by-N)
-*
-* H = I - W**T T W or H**T = I - W**T T**T W
-*
-* A = A - (A + B V**T) T or A = A - (A + B V**T) T**T
-* B = B - (A + B V**T) T V or B = B - (A + B V**T) T**T V
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( N-L+1, N )
- KP = MIN( L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, J ) = B( I, N-L+J )
- END DO
- END DO
- CALL DTRMM( 'R', 'L', 'T', 'N', M, L, ONE, V( 1, NP ), LDV,
- $ WORK, LDWORK )
- CALL DGEMM( 'N', 'T', M, L, N-L, ONE, B, LDB, V, LDV,
- $ ONE, WORK, LDWORK )
- CALL DGEMM( 'N', 'T', M, K-L, N, ONE, B, LDB,
- $ V( KP, 1 ), LDV, ZERO, WORK( 1, KP ), LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL DGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK,
- $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB )
- CALL DTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV,
- $ WORK, LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, N-L+J ) = B( I, N-L+J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. BACKWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V I ] ( I is K-by-K, V is K-by-M )
-*
-* Form H C or H**T C where C = [ B ] (M-by-N)
-* [ A ] (K-by-N)
-*
-* H = I - W**T T W or H**T = I - W**T T**T W
-*
-* A = A - T (A + V B) or A = A - T**T (A + V B)
-* B = B - V**T T (A + V B) or B = B - V**T T**T (A + V B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( L+1, M )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( K-L+I, J ) = B( I, J )
- END DO
- END DO
- CALL DTRMM( 'L', 'U', 'N', 'N', L, N, ONE, V( KP, 1 ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- CALL DGEMM( 'N', 'N', L, N, M-L, ONE, V( KP, MP ), LDV,
- $ B( MP, 1 ), LDB, ONE, WORK( KP, 1 ), LDWORK )
- CALL DGEMM( 'N', 'N', K-L, N, M, ONE, V, LDV, B, LDB,
- $ ZERO, WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'L', 'L ', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'T', 'N', M-L, N, K, -ONE, V( 1, MP ), LDV,
- $ WORK, LDWORK, ONE, B( MP, 1 ), LDB )
- CALL DGEMM( 'T', 'N', L, N, K-L, -ONE, V, LDV,
- $ WORK, LDWORK, ONE, B, LDB )
- CALL DTRMM( 'L', 'U', 'T', 'N', L, N, ONE, V( KP, 1 ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( I, J ) = B( I, J ) - WORK( K-L+I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. BACKWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V I ] ( I is K-by-K, V is K-by-N )
-*
-* Form C H or C H**T where C = [ B A ] (A is M-by-K, B is M-by-N)
-*
-* H = I - W**T T W or H**T = I - W**T T**T W
-*
-* A = A - (A + B V**T) T or A = A - (A + B V**T) T**T
-* B = B - (A + B V**T) T V or B = B - (A + B V**T) T**T V
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( L+1, N )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, K-L+J ) = B( I, J )
- END DO
- END DO
- CALL DTRMM( 'R', 'U', 'T', 'N', M, L, ONE, V( KP, 1 ), LDV,
- $ WORK( 1, KP ), LDWORK )
- CALL DGEMM( 'N', 'T', M, L, N-L, ONE, B( 1, NP ), LDB,
- $ V( KP, NP ), LDV, ONE, WORK( 1, KP ), LDWORK )
- CALL DGEMM( 'N', 'T', M, K-L, N, ONE, B, LDB, V, LDV,
- $ ZERO, WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL DTRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL DGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK,
- $ V( 1, NP ), LDV, ONE, B( 1, NP ), LDB )
- CALL DGEMM( 'N', 'N', M, L, K-L , -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL DTRMM( 'R', 'U', 'N', 'N', M, L, ONE, V( KP, 1 ), LDV,
- $ WORK( 1, KP ), LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, J ) = B( I, J ) - WORK( I, K-L+J )
- END DO
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of DTPRFB
-*
- END
diff --git a/netlib/LAPACK/dtprfs.f b/netlib/LAPACK/dtprfs.f
deleted file mode 100644
index b5a5809..0000000
--- a/netlib/LAPACK/dtprfs.f
+++ /dev/null
@@ -1,473 +0,0 @@
-*> \brief \b DTPRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtprfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtprfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtprfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX,
-* FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION AP( * ), B( LDB, * ), BERR( * ), FERR( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPRFS provides error bounds and backward error estimates for the
-*> solution to a system of linear equations with a triangular packed
-*> coefficient matrix.
-*>
-*> The solution matrix X must be computed by DTPTRS or some other
-*> means before entering this routine. DTPRFS does not do iterative
-*> refinement because doing so cannot improve the backward error.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> The solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX,
- $ FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION AP( * ), B( LDB, * ), BERR( * ), FERR( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- CHARACTER TRANST
- INTEGER I, J, K, KASE, KC, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DTPMV, DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 250 J = 1, NRHS
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A or A**T, depending on TRANS.
-*
- CALL DCOPY( N, X( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DTPMV( UPLO, TRANS, DIAG, N, AP, WORK( N+1 ), 1 )
- CALL DAXPY( N, -ONE, B( 1, J ), 1, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 20 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 20 CONTINUE
-*
- IF( NOTRAN ) THEN
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- KC = 1
- IF( NOUNIT ) THEN
- DO 40 K = 1, N
- XK = ABS( X( K, J ) )
- DO 30 I = 1, K
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-1 ) )*XK
- 30 CONTINUE
- KC = KC + K
- 40 CONTINUE
- ELSE
- DO 60 K = 1, N
- XK = ABS( X( K, J ) )
- DO 50 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-1 ) )*XK
- 50 CONTINUE
- WORK( K ) = WORK( K ) + XK
- KC = KC + K
- 60 CONTINUE
- END IF
- ELSE
- KC = 1
- IF( NOUNIT ) THEN
- DO 80 K = 1, N
- XK = ABS( X( K, J ) )
- DO 70 I = K, N
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-K ) )*XK
- 70 CONTINUE
- KC = KC + N - K + 1
- 80 CONTINUE
- ELSE
- DO 100 K = 1, N
- XK = ABS( X( K, J ) )
- DO 90 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-K ) )*XK
- 90 CONTINUE
- WORK( K ) = WORK( K ) + XK
- KC = KC + N - K + 1
- 100 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Compute abs(A**T)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- KC = 1
- IF( NOUNIT ) THEN
- DO 120 K = 1, N
- S = ZERO
- DO 110 I = 1, K
- S = S + ABS( AP( KC+I-1 ) )*ABS( X( I, J ) )
- 110 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + K
- 120 CONTINUE
- ELSE
- DO 140 K = 1, N
- S = ABS( X( K, J ) )
- DO 130 I = 1, K - 1
- S = S + ABS( AP( KC+I-1 ) )*ABS( X( I, J ) )
- 130 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + K
- 140 CONTINUE
- END IF
- ELSE
- KC = 1
- IF( NOUNIT ) THEN
- DO 160 K = 1, N
- S = ZERO
- DO 150 I = K, N
- S = S + ABS( AP( KC+I-K ) )*ABS( X( I, J ) )
- 150 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + N - K + 1
- 160 CONTINUE
- ELSE
- DO 180 K = 1, N
- S = ABS( X( K, J ) )
- DO 170 I = K + 1, N
- S = S + ABS( AP( KC+I-K ) )*ABS( X( I, J ) )
- 170 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + N - K + 1
- 180 CONTINUE
- END IF
- END IF
- END IF
- S = ZERO
- DO 190 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 190 CONTINUE
- BERR( J ) = S
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 200 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 200 CONTINUE
-*
- KASE = 0
- 210 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DTPSV( UPLO, TRANST, DIAG, N, AP, WORK( N+1 ), 1 )
- DO 220 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 220 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 230 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 230 CONTINUE
- CALL DTPSV( UPLO, TRANS, DIAG, N, AP, WORK( N+1 ), 1 )
- END IF
- GO TO 210
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 240 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 240 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of DTPRFS
-*
- END
diff --git a/netlib/LAPACK/dtptri.f b/netlib/LAPACK/dtptri.f
deleted file mode 100644
index 9e8aa1c..0000000
--- a/netlib/LAPACK/dtptri.f
+++ /dev/null
@@ -1,241 +0,0 @@
-*> \brief \b DTPTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtptri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtptri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtptri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPTRI( UPLO, DIAG, N, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPTRI computes the inverse of a real upper or lower triangular
-*> matrix A stored in packed format.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangular matrix A, stored
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*((2*n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same packed storage format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A triangular matrix A can be transferred to packed storage using one
-*> of the following program segments:
-*>
-*> UPLO = 'U': UPLO = 'L':
-*>
-*> JC = 1 JC = 1
-*> DO 2 J = 1, N DO 2 J = 1, N
-*> DO 1 I = 1, J DO 1 I = J, N
-*> AP(JC+I-1) = A(I,J) AP(JC+I-J) = A(I,J)
-*> 1 CONTINUE 1 CONTINUE
-*> JC = JC + J JC = JC + N - J + 1
-*> 2 CONTINUE 2 CONTINUE
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTPTRI( UPLO, DIAG, N, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JC, JCLAST, JJ
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DTPMV, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPTRI', -INFO )
- RETURN
- END IF
-*
-* Check for singularity if non-unit.
-*
- IF( NOUNIT ) THEN
- IF( UPPER ) THEN
- JJ = 0
- DO 10 INFO = 1, N
- JJ = JJ + INFO
- IF( AP( JJ ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
- JJ = 1
- DO 20 INFO = 1, N
- IF( AP( JJ ).EQ.ZERO )
- $ RETURN
- JJ = JJ + N - INFO + 1
- 20 CONTINUE
- END IF
- INFO = 0
- END IF
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix.
-*
- JC = 1
- DO 30 J = 1, N
- IF( NOUNIT ) THEN
- AP( JC+J-1 ) = ONE / AP( JC+J-1 )
- AJJ = -AP( JC+J-1 )
- ELSE
- AJJ = -ONE
- END IF
-*
-* Compute elements 1:j-1 of j-th column.
-*
- CALL DTPMV( 'Upper', 'No transpose', DIAG, J-1, AP,
- $ AP( JC ), 1 )
- CALL DSCAL( J-1, AJJ, AP( JC ), 1 )
- JC = JC + J
- 30 CONTINUE
-*
- ELSE
-*
-* Compute inverse of lower triangular matrix.
-*
- JC = N*( N+1 ) / 2
- DO 40 J = N, 1, -1
- IF( NOUNIT ) THEN
- AP( JC ) = ONE / AP( JC )
- AJJ = -AP( JC )
- ELSE
- AJJ = -ONE
- END IF
- IF( J.LT.N ) THEN
-*
-* Compute elements j+1:n of j-th column.
-*
- CALL DTPMV( 'Lower', 'No transpose', DIAG, N-J,
- $ AP( JCLAST ), AP( JC+1 ), 1 )
- CALL DSCAL( N-J, AJJ, AP( JC+1 ), 1 )
- END IF
- JCLAST = JC
- JC = JC - N + J - 2
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DTPTRI
-*
- END
diff --git a/netlib/LAPACK/dtptrs.f b/netlib/LAPACK/dtptrs.f
deleted file mode 100644
index abce458..0000000
--- a/netlib/LAPACK/dtptrs.f
+++ /dev/null
@@ -1,228 +0,0 @@
-*> \brief \b DTPTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtptrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtptrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtptrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPTRS solves a triangular system of the form
-*>
-*> A * X = B or A**T * X = B,
-*>
-*> where A is a triangular matrix of order N stored in packed format,
-*> and B is an N-by-NRHS matrix. A check is made to verify that A is
-*> nonsingular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the
-*> solutions X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- IF( UPPER ) THEN
- JC = 1
- DO 10 INFO = 1, N
- IF( AP( JC+INFO-1 ).EQ.ZERO )
- $ RETURN
- JC = JC + INFO
- 10 CONTINUE
- ELSE
- JC = 1
- DO 20 INFO = 1, N
- IF( AP( JC ).EQ.ZERO )
- $ RETURN
- JC = JC + N - INFO + 1
- 20 CONTINUE
- END IF
- END IF
- INFO = 0
-*
-* Solve A * x = b or A**T * x = b.
-*
- DO 30 J = 1, NRHS
- CALL DTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 )
- 30 CONTINUE
-*
- RETURN
-*
-* End of DTPTRS
-*
- END
diff --git a/netlib/LAPACK/dtpttf.f b/netlib/LAPACK/dtpttf.f
deleted file mode 100644
index f79babc..0000000
--- a/netlib/LAPACK/dtpttf.f
+++ /dev/null
@@ -1,502 +0,0 @@
-*> \brief \b DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPTTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpttf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpttf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpttf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPTTF( TRANSR, UPLO, N, AP, ARF, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AP( 0: * ), ARF( 0: * )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPTTF copies a triangular matrix A from standard packed format (TP)
-*> to rectangular full packed format (TF).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF in Normal format is wanted;
-*> = 'T': ARF in Conjugate-transpose format is wanted.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
-*> On entry, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] ARF
-*> \verbatim
-*> ARF is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
-*> On exit, the upper or lower triangular matrix A stored in
-*> RFP format. For a further discussion see Notes below.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTPTTF( TRANSR, UPLO, N, AP, ARF, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AP( 0: * ), ARF( 0: * )
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K, NT
- INTEGER I, J, IJ
- INTEGER IJP, JP, LDA, JS
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPTTF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( NORMALTRANSR ) THEN
- ARF( 0 ) = AP( 0 )
- ELSE
- ARF( 0 ) = AP( 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:NT-1)
-*
- NT = N*( N+1 ) / 2
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
-* set lda of ARF^C; ARF^C is (0:(N+1)/2-1,0:N-noe)
-* where noe = 0 if n is even, noe = 1 if n is odd
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- LDA = N + 1
- ELSE
- NISODD = .TRUE.
- LDA = N
- END IF
-*
-* ARF^C has lda rows and n+1-noe cols
-*
- IF( .NOT.NORMALTRANSR )
- $ LDA = ( N+1 ) / 2
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IJP = 0
- JP = 0
- DO J = 0, N2
- DO I = J, N - 1
- IJ = I + JP
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, N2 - 1
- DO J = 1 + I, N2
- IJ = I + J*LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IJP = 0
- DO J = 0, N1 - 1
- IJ = N2 + J
- DO I = 0, J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = N1, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IJP = 0
- DO I = 0, N2
- DO IJ = I*( LDA+1 ), N*LDA - 1, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
- JS = 1
- DO J = 0, N2 - 1
- DO IJ = JS, JS + N2 - J - 1
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IJP = 0
- JS = N2*LDA
- DO J = 0, N1 - 1
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, N1
- DO IJ = I, I + ( N1+I )*LDA, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IJP = 0
- JP = 0
- DO J = 0, K - 1
- DO I = J, N - 1
- IJ = 1 + I + JP
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, K - 1
- DO J = I, K - 1
- IJ = I + J*LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IJP = 0
- DO J = 0, K - 1
- IJ = K + 1 + J
- DO I = 0, J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = K, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IJP = 0
- DO I = 0, K - 1
- DO IJ = I + ( I+1 )*LDA, ( N+1 )*LDA - 1, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
- JS = 0
- DO J = 0, K - 1
- DO IJ = JS, JS + K - J - 1
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IJP = 0
- JS = ( K+1 )*LDA
- DO J = 0, K - 1
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, K - 1
- DO IJ = I, I + ( K+I )*LDA, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DTPTTF
-*
- END
diff --git a/netlib/LAPACK/dtpttr.f b/netlib/LAPACK/dtpttr.f
deleted file mode 100644
index 1c11deb..0000000
--- a/netlib/LAPACK/dtpttr.f
+++ /dev/null
@@ -1,176 +0,0 @@
-*> \brief \b DTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTPTTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpttr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpttr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpttr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTPTTR( UPLO, N, AP, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTPTTR copies a triangular matrix A from standard packed format (TP)
-*> to standard full format (TR).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular.
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension ( N*(N+1)/2 ),
-*> On entry, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension ( LDA, N )
-*> On exit, the triangular matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTPTTR( UPLO, N, AP, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER
- INTEGER I, J, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTPTTR', -INFO )
- RETURN
- END IF
-*
- IF( LOWER ) THEN
- K = 0
- DO J = 1, N
- DO I = J, N
- K = K + 1
- A( I, J ) = AP( K )
- END DO
- END DO
- ELSE
- K = 0
- DO J = 1, N
- DO I = 1, J
- K = K + 1
- A( I, J ) = AP( K )
- END DO
- END DO
- END IF
-*
-*
- RETURN
-*
-* End of DTPTTR
-*
- END
diff --git a/netlib/LAPACK/dtrcon.f b/netlib/LAPACK/dtrcon.f
deleted file mode 100644
index 80578d6..0000000
--- a/netlib/LAPACK/dtrcon.f
+++ /dev/null
@@ -1,276 +0,0 @@
-*> \brief \b DTRCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRCON estimates the reciprocal of the condition number of a
-*> triangular matrix A, in either the 1-norm or the infinity-norm.
-*>
-*> The norm of A is computed and an estimate is obtained for
-*> norm(inv(A)), then the reciprocal of the condition number is
-*> computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER INFO, LDA, N
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, ONENRM, UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH, DLANTR
- EXTERNAL LSAME, IDAMAX, DLAMCH, DLANTR
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATRS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- END IF
-*
- RCOND = ZERO
- SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) )
-*
-* Compute the norm of the triangular matrix A.
-*
- ANORM = DLANTR( NORM, UPLO, DIAG, N, N, A, LDA, WORK )
-*
-* Continue only if ANORM > 0.
-*
- IF( ANORM.GT.ZERO ) THEN
-*
-* Estimate the norm of the inverse of A.
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(A).
-*
- CALL DLATRS( UPLO, 'No transpose', DIAG, NORMIN, N, A,
- $ LDA, WORK, SCALE, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(A**T).
-*
- CALL DLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, LDA,
- $ WORK, SCALE, WORK( 2*N+1 ), INFO )
- END IF
- NORMIN = 'Y'
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- XNORM = ABS( WORK( IX ) )
- IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / ANORM ) / AINVNM
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of DTRCON
-*
- END
diff --git a/netlib/LAPACK/dtrevc.f b/netlib/LAPACK/dtrevc.f
deleted file mode 100644
index 62e5029..0000000
--- a/netlib/LAPACK/dtrevc.f
+++ /dev/null
@@ -1,1076 +0,0 @@
-*> \brief \b DTREVC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTREVC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrevc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrevc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrevc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-* LDVR, MM, M, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, SIDE
-* INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTREVC computes some or all of the right and/or left eigenvectors of
-*> a real upper quasi-triangular matrix T.
-*> Matrices of this type are produced by the Schur factorization of
-*> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR.
-*>
-*> The right eigenvector x and the left eigenvector y of T corresponding
-*> to an eigenvalue w are defined by:
-*>
-*> T*x = w*x, (y**T)*T = w*(y**T)
-*>
-*> where y**T denotes the transpose of y.
-*> The eigenvalues are not input to this routine, but are read directly
-*> from the diagonal blocks of T.
-*>
-*> This routine returns the matrices X and/or Y of right and left
-*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
-*> input matrix. If Q is the orthogonal factor that reduces a matrix
-*> A to Schur form T, then Q*X and Q*Y are the matrices of right and
-*> left eigenvectors of A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute all right and/or left eigenvectors;
-*> = 'B': compute all right and/or left eigenvectors,
-*> backtransformed by the matrices in VR and/or VL;
-*> = 'S': compute selected right and/or left eigenvectors,
-*> as indicated by the logical array SELECT.
-*> \endverbatim
-*>
-*> \param[in,out] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be
-*> computed.
-*> If w(j) is a real eigenvalue, the corresponding real
-*> eigenvector is computed if SELECT(j) is .TRUE..
-*> If w(j) and w(j+1) are the real and imaginary parts of a
-*> complex eigenvalue, the corresponding complex eigenvector is
-*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
-*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
-*> .FALSE..
-*> Not referenced if HOWMNY = 'A' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The upper quasi-triangular matrix T in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,MM)
-*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of Schur vectors returned by DHSEQR).
-*> On exit, if SIDE = 'L' or 'B', VL contains:
-*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-*> if HOWMNY = 'B', the matrix Q*Y;
-*> if HOWMNY = 'S', the left eigenvectors of T specified by
-*> SELECT, stored consecutively in the columns
-*> of VL, in the same order as their
-*> eigenvalues.
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part, and the second the imaginary part.
-*> Not referenced if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1, and if
-*> SIDE = 'L' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,MM)
-*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of Schur vectors returned by DHSEQR).
-*> On exit, if SIDE = 'R' or 'B', VR contains:
-*> if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-*> if HOWMNY = 'B', the matrix Q*X;
-*> if HOWMNY = 'S', the right eigenvectors of T specified by
-*> SELECT, stored consecutively in the columns
-*> of VR, in the same order as their
-*> eigenvalues.
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part and the second the imaginary part.
-*> Not referenced if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> SIDE = 'R' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR actually
-*> used to store the eigenvectors.
-*> If HOWMNY = 'A' or 'B', M is set to N.
-*> Each selected real eigenvector occupies one column and each
-*> selected complex eigenvector occupies two columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The algorithm used in this program is basically backward (forward)
-*> substitution, with scaling to make the the code robust against
-*> possible overflow.
-*>
-*> Each eigenvector is normalized so that the element of largest
-*> magnitude has magnitude 1; here the magnitude of a complex number
-*> (x,y) is taken to be |x| + |y|.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
- $ LDVR, MM, M, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLV, BOTHV, LEFTV, OVER, PAIR, RIGHTV, SOMEV
- INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, N2
- DOUBLE PRECISION BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE,
- $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR,
- $ XNORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION X( 2, 2 )
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- BOTHV = LSAME( SIDE, 'B' )
- RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
- LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
- ALLV = LSAME( HOWMNY, 'A' )
- OVER = LSAME( HOWMNY, 'B' )
- SOMEV = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -1
- ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
- INFO = -8
- ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
- INFO = -10
- ELSE
-*
-* Set M to the number of columns required to store the selected
-* eigenvectors, standardize the array SELECT if necessary, and
-* test MM.
-*
- IF( SOMEV ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 J = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- SELECT( J ) = .FALSE.
- ELSE
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).EQ.ZERO ) THEN
- IF( SELECT( J ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN
- SELECT( J ) = .TRUE.
- M = M + 2
- END IF
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( MM.LT.M ) THEN
- INFO = -11
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTREVC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set the constants to control overflow.
-*
- UNFL = DLAMCH( 'Safe minimum' )
- OVFL = ONE / UNFL
- CALL DLABAD( UNFL, OVFL )
- ULP = DLAMCH( 'Precision' )
- SMLNUM = UNFL*( N / ULP )
- BIGNUM = ( ONE-ULP ) / SMLNUM
-*
-* Compute 1-norm of each column of strictly upper triangular
-* part of T to control overflow in triangular solver.
-*
- WORK( 1 ) = ZERO
- DO 30 J = 2, N
- WORK( J ) = ZERO
- DO 20 I = 1, J - 1
- WORK( J ) = WORK( J ) + ABS( T( I, J ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Index IP is used to specify the real or complex eigenvalue:
-* IP = 0, real eigenvalue,
-* 1, first of conjugate complex pair: (wr,wi)
-* -1, second of conjugate complex pair: (wr,wi)
-*
- N2 = 2*N
-*
- IF( RIGHTV ) THEN
-*
-* Compute right eigenvectors.
-*
- IP = 0
- IS = M
- DO 140 KI = N, 1, -1
-*
- IF( IP.EQ.1 )
- $ GO TO 130
- IF( KI.EQ.1 )
- $ GO TO 40
- IF( T( KI, KI-1 ).EQ.ZERO )
- $ GO TO 40
- IP = -1
-*
- 40 CONTINUE
- IF( SOMEV ) THEN
- IF( IP.EQ.0 ) THEN
- IF( .NOT.SELECT( KI ) )
- $ GO TO 130
- ELSE
- IF( .NOT.SELECT( KI-1 ) )
- $ GO TO 130
- END IF
- END IF
-*
-* Compute the KI-th eigenvalue (WR,WI).
-*
- WR = T( KI, KI )
- WI = ZERO
- IF( IP.NE.0 )
- $ WI = SQRT( ABS( T( KI, KI-1 ) ) )*
- $ SQRT( ABS( T( KI-1, KI ) ) )
- SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
- IF( IP.EQ.0 ) THEN
-*
-* Real right eigenvector
-*
- WORK( KI+N ) = ONE
-*
-* Form right-hand side
-*
- DO 50 K = 1, KI - 1
- WORK( K+N ) = -T( K, KI )
- 50 CONTINUE
-*
-* Solve the upper quasi-triangular system:
-* (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
-*
- JNXT = KI - 1
- DO 60 J = KI - 1, 1, -1
- IF( J.GT.JNXT )
- $ GO TO 60
- J1 = J
- J2 = J
- JNXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
- CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale X(1,1) to avoid overflow when updating
-* the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
-*
-* Update right-hand side
-*
- CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ WORK( J-1+N ), N, WR, ZERO, X, 2,
- $ SCALE, XNORM, IERR )
-*
-* Scale X(1,1) and X(2,1) to avoid overflow when
-* updating the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- BETA = MAX( WORK( J-1 ), WORK( J ) )
- IF( BETA.GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- X( 2, 1 ) = X( 2, 1 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- WORK( J-1+N ) = X( 1, 1 )
- WORK( J+N ) = X( 2, 1 )
-*
-* Update right-hand side
-*
- CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- END IF
- 60 CONTINUE
-*
-* Copy the vector x or Q*x to VR and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( KI, WORK( 1+N ), 1, VR( 1, IS ), 1 )
-*
- II = IDAMAX( KI, VR( 1, IS ), 1 )
- REMAX = ONE / ABS( VR( II, IS ) )
- CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
- DO 70 K = KI + 1, N
- VR( K, IS ) = ZERO
- 70 CONTINUE
- ELSE
- IF( KI.GT.1 )
- $ CALL DGEMV( 'N', N, KI-1, ONE, VR, LDVR,
- $ WORK( 1+N ), 1, WORK( KI+N ),
- $ VR( 1, KI ), 1 )
-*
- II = IDAMAX( N, VR( 1, KI ), 1 )
- REMAX = ONE / ABS( VR( II, KI ) )
- CALL DSCAL( N, REMAX, VR( 1, KI ), 1 )
- END IF
-*
- ELSE
-*
-* Complex right eigenvector.
-*
-* Initial solve
-* [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
-* [ (T(KI,KI-1) T(KI,KI) ) ]
-*
- IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN
- WORK( KI-1+N ) = ONE
- WORK( KI+N2 ) = WI / T( KI-1, KI )
- ELSE
- WORK( KI-1+N ) = -WI / T( KI, KI-1 )
- WORK( KI+N2 ) = ONE
- END IF
- WORK( KI+N ) = ZERO
- WORK( KI-1+N2 ) = ZERO
-*
-* Form right-hand side
-*
- DO 80 K = 1, KI - 2
- WORK( K+N ) = -WORK( KI-1+N )*T( K, KI-1 )
- WORK( K+N2 ) = -WORK( KI+N2 )*T( K, KI )
- 80 CONTINUE
-*
-* Solve upper quasi-triangular system:
-* (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
-*
- JNXT = KI - 2
- DO 90 J = KI - 2, 1, -1
- IF( J.GT.JNXT )
- $ GO TO 90
- J1 = J
- J2 = J
- JNXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
- CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR, WI,
- $ X, 2, SCALE, XNORM, IERR )
-*
-* Scale X(1,1) and X(1,2) to avoid overflow when
-* updating the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- X( 1, 2 ) = X( 1, 2 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- CALL DSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
-*
-* Update the right-hand side
-*
- CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1,
- $ WORK( 1+N2 ), 1 )
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
- CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ WORK( J-1+N ), N, WR, WI, X, 2, SCALE,
- $ XNORM, IERR )
-*
-* Scale X to avoid overflow when updating
-* the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- BETA = MAX( WORK( J-1 ), WORK( J ) )
- IF( BETA.GT.BIGNUM / XNORM ) THEN
- REC = ONE / XNORM
- X( 1, 1 ) = X( 1, 1 )*REC
- X( 1, 2 ) = X( 1, 2 )*REC
- X( 2, 1 ) = X( 2, 1 )*REC
- X( 2, 2 ) = X( 2, 2 )*REC
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- CALL DSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
- END IF
- WORK( J-1+N ) = X( 1, 1 )
- WORK( J+N ) = X( 2, 1 )
- WORK( J-1+N2 ) = X( 1, 2 )
- WORK( J+N2 ) = X( 2, 2 )
-*
-* Update the right-hand side
-*
- CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1,
- $ WORK( 1+N2 ), 1 )
- CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
- $ WORK( 1+N2 ), 1 )
- END IF
- 90 CONTINUE
-*
-* Copy the vector x or Q*x to VR and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( KI, WORK( 1+N ), 1, VR( 1, IS-1 ), 1 )
- CALL DCOPY( KI, WORK( 1+N2 ), 1, VR( 1, IS ), 1 )
-*
- EMAX = ZERO
- DO 100 K = 1, KI
- EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+
- $ ABS( VR( K, IS ) ) )
- 100 CONTINUE
-*
- REMAX = ONE / EMAX
- CALL DSCAL( KI, REMAX, VR( 1, IS-1 ), 1 )
- CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
- DO 110 K = KI + 1, N
- VR( K, IS-1 ) = ZERO
- VR( K, IS ) = ZERO
- 110 CONTINUE
-*
- ELSE
-*
- IF( KI.GT.2 ) THEN
- CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR,
- $ WORK( 1+N ), 1, WORK( KI-1+N ),
- $ VR( 1, KI-1 ), 1 )
- CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR,
- $ WORK( 1+N2 ), 1, WORK( KI+N2 ),
- $ VR( 1, KI ), 1 )
- ELSE
- CALL DSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 )
- CALL DSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 )
- END IF
-*
- EMAX = ZERO
- DO 120 K = 1, N
- EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+
- $ ABS( VR( K, KI ) ) )
- 120 CONTINUE
- REMAX = ONE / EMAX
- CALL DSCAL( N, REMAX, VR( 1, KI-1 ), 1 )
- CALL DSCAL( N, REMAX, VR( 1, KI ), 1 )
- END IF
- END IF
-*
- IS = IS - 1
- IF( IP.NE.0 )
- $ IS = IS - 1
- 130 CONTINUE
- IF( IP.EQ.1 )
- $ IP = 0
- IF( IP.EQ.-1 )
- $ IP = 1
- 140 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
-*
-* Compute left eigenvectors.
-*
- IP = 0
- IS = 1
- DO 260 KI = 1, N
-*
- IF( IP.EQ.-1 )
- $ GO TO 250
- IF( KI.EQ.N )
- $ GO TO 150
- IF( T( KI+1, KI ).EQ.ZERO )
- $ GO TO 150
- IP = 1
-*
- 150 CONTINUE
- IF( SOMEV ) THEN
- IF( .NOT.SELECT( KI ) )
- $ GO TO 250
- END IF
-*
-* Compute the KI-th eigenvalue (WR,WI).
-*
- WR = T( KI, KI )
- WI = ZERO
- IF( IP.NE.0 )
- $ WI = SQRT( ABS( T( KI, KI+1 ) ) )*
- $ SQRT( ABS( T( KI+1, KI ) ) )
- SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
- IF( IP.EQ.0 ) THEN
-*
-* Real left eigenvector.
-*
- WORK( KI+N ) = ONE
-*
-* Form right-hand side
-*
- DO 160 K = KI + 1, N
- WORK( K+N ) = -T( KI, K )
- 160 CONTINUE
-*
-* Solve the quasi-triangular system:
-* (T(KI+1:N,KI+1:N) - WR)**T*X = SCALE*WORK
-*
- VMAX = ONE
- VCRIT = BIGNUM
-*
- JNXT = KI + 1
- DO 170 J = KI + 1, N
- IF( J.LT.JNXT )
- $ GO TO 170
- J1 = J
- J2 = J
- JNXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side.
-*
- IF( WORK( J ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-1, T( KI+1, J ), 1,
- $ WORK( KI+1+N ), 1 )
-*
-* Solve (T(J,J)-WR)**T*X = WORK
-*
- CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
- VMAX = MAX( ABS( WORK( J+N ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side.
-*
- BETA = MAX( WORK( J ), WORK( J+1 ) )
- IF( BETA.GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-1, T( KI+1, J ), 1,
- $ WORK( KI+1+N ), 1 )
-*
- WORK( J+1+N ) = WORK( J+1+N ) -
- $ DDOT( J-KI-1, T( KI+1, J+1 ), 1,
- $ WORK( KI+1+N ), 1 )
-*
-* Solve
-* [T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 )
-* [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
- WORK( J+1+N ) = X( 2, 1 )
-*
- VMAX = MAX( ABS( WORK( J+N ) ),
- $ ABS( WORK( J+1+N ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- END IF
- 170 CONTINUE
-*
-* Copy the vector x or Q*x to VL and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
-*
- II = IDAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
- REMAX = ONE / ABS( VL( II, IS ) )
- CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
-*
- DO 180 K = 1, KI - 1
- VL( K, IS ) = ZERO
- 180 CONTINUE
-*
- ELSE
-*
- IF( KI.LT.N )
- $ CALL DGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL,
- $ WORK( KI+1+N ), 1, WORK( KI+N ),
- $ VL( 1, KI ), 1 )
-*
- II = IDAMAX( N, VL( 1, KI ), 1 )
- REMAX = ONE / ABS( VL( II, KI ) )
- CALL DSCAL( N, REMAX, VL( 1, KI ), 1 )
-*
- END IF
-*
- ELSE
-*
-* Complex left eigenvector.
-*
-* Initial solve:
-* ((T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI))*X = 0.
-* ((T(KI+1,KI) T(KI+1,KI+1)) )
-*
- IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN
- WORK( KI+N ) = WI / T( KI, KI+1 )
- WORK( KI+1+N2 ) = ONE
- ELSE
- WORK( KI+N ) = ONE
- WORK( KI+1+N2 ) = -WI / T( KI+1, KI )
- END IF
- WORK( KI+1+N ) = ZERO
- WORK( KI+N2 ) = ZERO
-*
-* Form right-hand side
-*
- DO 190 K = KI + 2, N
- WORK( K+N ) = -WORK( KI+N )*T( KI, K )
- WORK( K+N2 ) = -WORK( KI+1+N2 )*T( KI+1, K )
- 190 CONTINUE
-*
-* Solve complex quasi-triangular system:
-* ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
-*
- VMAX = ONE
- VCRIT = BIGNUM
-*
- JNXT = KI + 2
- DO 200 J = KI + 2, N
- IF( J.LT.JNXT )
- $ GO TO 200
- J1 = J
- J2 = J
- JNXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
-* Scale if necessary to avoid overflow when
-* forming the right-hand side elements.
-*
- IF( WORK( J ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N ), 1 )
- WORK( J+N2 ) = WORK( J+N2 ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
-* Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2
-*
- CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ -WI, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
- VMAX = MAX( ABS( WORK( J+N ) ),
- $ ABS( WORK( J+N2 ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side elements.
-*
- BETA = MAX( WORK( J ), WORK( J+1 ) )
- IF( BETA.GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N ), 1 )
-*
- WORK( J+N2 ) = WORK( J+N2 ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
- WORK( J+1+N ) = WORK( J+1+N ) -
- $ DDOT( J-KI-2, T( KI+2, J+1 ), 1,
- $ WORK( KI+2+N ), 1 )
-*
- WORK( J+1+N2 ) = WORK( J+1+N2 ) -
- $ DDOT( J-KI-2, T( KI+2, J+1 ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
-* Solve 2-by-2 complex linear equation
-* ([T(j,j) T(j,j+1) ]**T-(wr-i*wi)*I)*X = SCALE*B
-* ([T(j+1,j) T(j+1,j+1)] )
-*
- CALL DLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ -WI, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
- WORK( J+1+N ) = X( 2, 1 )
- WORK( J+1+N2 ) = X( 2, 2 )
- VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ),
- $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- END IF
- 200 CONTINUE
-*
-* Copy the vector x or Q*x to VL and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
- CALL DCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ),
- $ 1 )
-*
- EMAX = ZERO
- DO 220 K = KI, N
- EMAX = MAX( EMAX, ABS( VL( K, IS ) )+
- $ ABS( VL( K, IS+1 ) ) )
- 220 CONTINUE
- REMAX = ONE / EMAX
- CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
- CALL DSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 )
-*
- DO 230 K = 1, KI - 1
- VL( K, IS ) = ZERO
- VL( K, IS+1 ) = ZERO
- 230 CONTINUE
- ELSE
- IF( KI.LT.N-1 ) THEN
- CALL DGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
- $ LDVL, WORK( KI+2+N ), 1, WORK( KI+N ),
- $ VL( 1, KI ), 1 )
- CALL DGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
- $ LDVL, WORK( KI+2+N2 ), 1,
- $ WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
- ELSE
- CALL DSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 )
- CALL DSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
- END IF
-*
- EMAX = ZERO
- DO 240 K = 1, N
- EMAX = MAX( EMAX, ABS( VL( K, KI ) )+
- $ ABS( VL( K, KI+1 ) ) )
- 240 CONTINUE
- REMAX = ONE / EMAX
- CALL DSCAL( N, REMAX, VL( 1, KI ), 1 )
- CALL DSCAL( N, REMAX, VL( 1, KI+1 ), 1 )
-*
- END IF
-*
- END IF
-*
- IS = IS + 1
- IF( IP.NE.0 )
- $ IS = IS + 1
- 250 CONTINUE
- IF( IP.EQ.-1 )
- $ IP = 0
- IF( IP.EQ.1 )
- $ IP = -1
-*
- 260 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of DTREVC
-*
- END
diff --git a/netlib/LAPACK/dtrexc.f b/netlib/LAPACK/dtrexc.f
deleted file mode 100644
index 4ac8d9d..0000000
--- a/netlib/LAPACK/dtrexc.f
+++ /dev/null
@@ -1,426 +0,0 @@
-*> \brief \b DTREXC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTREXC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrexc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrexc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrexc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ
-* INTEGER IFST, ILST, INFO, LDQ, LDT, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTREXC reorders the real Schur factorization of a real matrix
-*> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
-*> moved to row ILST.
-*>
-*> The real Schur form T is reordered by an orthogonal similarity
-*> transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
-*> is updated by postmultiplying it with Z.
-*>
-*> T must be in Schur canonical form (as returned by DHSEQR), that is,
-*> block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*> 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'V': update the matrix Q of Schur vectors;
-*> = 'N': do not update Q.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> Schur canonical form.
-*> On exit, the reordered upper quasi-triangular matrix, again
-*> in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*> On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*> orthogonal transformation matrix Z which reorders T.
-*> If COMPQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IFST
-*> \verbatim
-*> IFST is INTEGER
-*> \endverbatim
-*>
-*> \param[in,out] ILST
-*> \verbatim
-*> ILST is INTEGER
-*>
-*> Specify the reordering of the diagonal blocks of T.
-*> The block with row index IFST is moved to row ILST, by a
-*> sequence of transpositions between adjacent blocks.
-*> On exit, if IFST pointed on entry to the second row of a
-*> 2-by-2 block, it is changed to point to the first row; ILST
-*> always points to the first row of the block in its final
-*> position (which may differ from its input value by +1 or -1).
-*> 1 <= IFST <= N; 1 <= ILST <= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: two adjacent blocks were too close to swap (the problem
-*> is very ill-conditioned); T may have been partially
-*> reordered, and ILST points to the first row of the
-*> current position of the block being moved.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ
- INTEGER IFST, ILST, INFO, LDQ, LDT, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTQ
- INTEGER HERE, NBF, NBL, NBNEXT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAEXC, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input arguments.
-*
- INFO = 0
- WANTQ = LSAME( COMPQ, 'V' )
- IF( .NOT.WANTQ .AND. .NOT.LSAME( COMPQ, 'N' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
- INFO = -6
- ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
- INFO = -7
- ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTREXC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the first row of specified block
-* and find out it is 1 by 1 or 2 by 2.
-*
- IF( IFST.GT.1 ) THEN
- IF( T( IFST, IFST-1 ).NE.ZERO )
- $ IFST = IFST - 1
- END IF
- NBF = 1
- IF( IFST.LT.N ) THEN
- IF( T( IFST+1, IFST ).NE.ZERO )
- $ NBF = 2
- END IF
-*
-* Determine the first row of the final block
-* and find out it is 1 by 1 or 2 by 2.
-*
- IF( ILST.GT.1 ) THEN
- IF( T( ILST, ILST-1 ).NE.ZERO )
- $ ILST = ILST - 1
- END IF
- NBL = 1
- IF( ILST.LT.N ) THEN
- IF( T( ILST+1, ILST ).NE.ZERO )
- $ NBL = 2
- END IF
-*
- IF( IFST.EQ.ILST )
- $ RETURN
-*
- IF( IFST.LT.ILST ) THEN
-*
-* Update ILST
-*
- IF( NBF.EQ.2 .AND. NBL.EQ.1 )
- $ ILST = ILST - 1
- IF( NBF.EQ.1 .AND. NBL.EQ.2 )
- $ ILST = ILST + 1
-*
- HERE = IFST
-*
- 10 CONTINUE
-*
-* Swap block with next one below
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1 by 1 or 2 by 2
-*
- NBNEXT = 1
- IF( HERE+NBF+1.LE.N ) THEN
- IF( T( HERE+NBF+1, HERE+NBF ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBF, NBNEXT,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + NBNEXT
-*
-* Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
- IF( NBF.EQ.2 ) THEN
- IF( T( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1 by 1 blocks each of which
-* must be swapped individually
-*
- NBNEXT = 1
- IF( HERE+3.LE.N ) THEN
- IF( T( HERE+3, HERE+2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, NBNEXT,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1 by 1 blocks, no problems possible
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT,
- $ WORK, INFO )
- HERE = HERE + 1
- ELSE
-*
-* Recompute NBNEXT in case 2 by 2 split
-*
- IF( T( HERE+2, HERE+1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2 by 2 Block did not split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1,
- $ NBNEXT, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 2
- ELSE
-*
-* 2 by 2 Block did split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
- $ WORK, INFO )
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1,
- $ WORK, INFO )
- HERE = HERE + 2
- END IF
- END IF
- END IF
- IF( HERE.LT.ILST )
- $ GO TO 10
-*
- ELSE
-*
- HERE = IFST
- 20 CONTINUE
-*
-* Swap block with next one above
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1 by 1 or 2 by 2
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( T( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
- $ NBF, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - NBNEXT
-*
-* Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
- IF( NBF.EQ.2 ) THEN
- IF( T( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1 by 1 blocks each of which
-* must be swapped individually
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( T( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
- $ 1, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1 by 1 blocks, no problems possible
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1,
- $ WORK, INFO )
- HERE = HERE - 1
- ELSE
-*
-* Recompute NBNEXT in case 2 by 2 split
-*
- IF( T( HERE, HERE-1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2 by 2 Block did not split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 2
- ELSE
-*
-* 2 by 2 Block did split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
- $ WORK, INFO )
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1,
- $ WORK, INFO )
- HERE = HERE - 2
- END IF
- END IF
- END IF
- IF( HERE.GT.ILST )
- $ GO TO 20
- END IF
- ILST = HERE
-*
- RETURN
-*
-* End of DTREXC
-*
- END
diff --git a/netlib/LAPACK/dtrrfs.f b/netlib/LAPACK/dtrrfs.f
deleted file mode 100644
index 7668d60..0000000
--- a/netlib/LAPACK/dtrrfs.f
+++ /dev/null
@@ -1,472 +0,0 @@
-*> \brief \b DTRRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
-* LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRRFS provides error bounds and backward error estimates for the
-*> solution to a system of linear equations with a triangular
-*> coefficient matrix.
-*>
-*> The solution matrix X must be computed by DTRTRS or some other
-*> means before entering this routine. DTRRFS does not do iterative
-*> refinement because doing so cannot improve the backward error.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> The solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- CHARACTER TRANST
- INTEGER I, J, K, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLACN2, DTRMV, DTRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 250 J = 1, NRHS
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A or A**T, depending on TRANS.
-*
- CALL DCOPY( N, X( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DTRMV( UPLO, TRANS, DIAG, N, A, LDA, WORK( N+1 ), 1 )
- CALL DAXPY( N, -ONE, B( 1, J ), 1, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 20 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 20 CONTINUE
-*
- IF( NOTRAN ) THEN
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 40 K = 1, N
- XK = ABS( X( K, J ) )
- DO 30 I = 1, K
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 K = 1, N
- XK = ABS( X( K, J ) )
- DO 50 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 50 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 60 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 80 K = 1, N
- XK = ABS( X( K, J ) )
- DO 70 I = K, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 70 CONTINUE
- 80 CONTINUE
- ELSE
- DO 100 K = 1, N
- XK = ABS( X( K, J ) )
- DO 90 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 90 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 100 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Compute abs(A**T)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 120 K = 1, N
- S = ZERO
- DO 110 I = 1, K
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 110 CONTINUE
- WORK( K ) = WORK( K ) + S
- 120 CONTINUE
- ELSE
- DO 140 K = 1, N
- S = ABS( X( K, J ) )
- DO 130 I = 1, K - 1
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 130 CONTINUE
- WORK( K ) = WORK( K ) + S
- 140 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 160 K = 1, N
- S = ZERO
- DO 150 I = K, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 150 CONTINUE
- WORK( K ) = WORK( K ) + S
- 160 CONTINUE
- ELSE
- DO 180 K = 1, N
- S = ABS( X( K, J ) )
- DO 170 I = K + 1, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 170 CONTINUE
- WORK( K ) = WORK( K ) + S
- 180 CONTINUE
- END IF
- END IF
- END IF
- S = ZERO
- DO 190 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 190 CONTINUE
- BERR( J ) = S
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 200 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 200 CONTINUE
-*
- KASE = 0
- 210 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DTRSV( UPLO, TRANST, DIAG, N, A, LDA, WORK( N+1 ),
- $ 1 )
- DO 220 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 220 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 230 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 230 CONTINUE
- CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, WORK( N+1 ),
- $ 1 )
- END IF
- GO TO 210
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 240 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 240 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of DTRRFS
-*
- END
diff --git a/netlib/LAPACK/dtrsen.f b/netlib/LAPACK/dtrsen.f
deleted file mode 100644
index 0141732..0000000
--- a/netlib/LAPACK/dtrsen.f
+++ /dev/null
@@ -1,570 +0,0 @@
-*> \brief \b DTRSEN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRSEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrsen.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrsen.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrsen.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI,
-* M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, JOB
-* INTEGER INFO, LDQ, LDT, LIWORK, LWORK, M, N
-* DOUBLE PRECISION S, SEP
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ),
-* $ WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRSEN reorders the real Schur factorization of a real matrix
-*> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
-*> the leading diagonal blocks of the upper quasi-triangular matrix T,
-*> and the leading columns of Q form an orthonormal basis of the
-*> corresponding right invariant subspace.
-*>
-*> Optionally the routine computes the reciprocal condition numbers of
-*> the cluster of eigenvalues and/or the invariant subspace.
-*>
-*> T must be in Schur canonical form (as returned by DHSEQR), that is,
-*> block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*> 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies whether condition numbers are required for the
-*> cluster of eigenvalues (S) or the invariant subspace (SEP):
-*> = 'N': none;
-*> = 'E': for eigenvalues only (S);
-*> = 'V': for invariant subspace only (SEP);
-*> = 'B': for both eigenvalues and invariant subspace (S and
-*> SEP).
-*> \endverbatim
-*>
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'V': update the matrix Q of Schur vectors;
-*> = 'N': do not update Q.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> SELECT specifies the eigenvalues in the selected cluster. To
-*> select a real eigenvalue w(j), SELECT(j) must be set to
-*> .TRUE.. To select a complex conjugate pair of eigenvalues
-*> w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
-*> either SELECT(j) or SELECT(j+1) or both must be set to
-*> .TRUE.; a complex conjugate pair of eigenvalues must be
-*> either both included in the cluster or both excluded.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> canonical form.
-*> On exit, T is overwritten by the reordered matrix T, again in
-*> Schur canonical form, with the selected eigenvalues in the
-*> leading diagonal blocks.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*> On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*> orthogonal transformation matrix which reorders T; the
-*> leading M columns of Q form an orthonormal basis for the
-*> specified invariant subspace.
-*> If COMPQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*>
-*> The real and imaginary parts, respectively, of the reordered
-*> eigenvalues of T. The eigenvalues are stored in the same
-*> order as on the diagonal of T, with WR(i) = T(i,i) and, if
-*> T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
-*> WI(i+1) = -WI(i). Note that if a complex eigenvalue is
-*> sufficiently ill-conditioned, then its value may differ
-*> significantly from its value before reordering.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The dimension of the specified invariant subspace.
-*> 0 < = M <= N.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION
-*> If JOB = 'E' or 'B', S is a lower bound on the reciprocal
-*> condition number for the selected cluster of eigenvalues.
-*> S cannot underestimate the true reciprocal condition number
-*> by more than a factor of sqrt(N). If M = 0 or N, S = 1.
-*> If JOB = 'N' or 'V', S is not referenced.
-*> \endverbatim
-*>
-*> \param[out] SEP
-*> \verbatim
-*> SEP is DOUBLE PRECISION
-*> If JOB = 'V' or 'B', SEP is the estimated reciprocal
-*> condition number of the specified invariant subspace. If
-*> M = 0 or N, SEP = norm(T).
-*> If JOB = 'N' or 'E', SEP is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If JOB = 'N', LWORK >= max(1,N);
-*> if JOB = 'E', LWORK >= max(1,M*(N-M));
-*> if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOB = 'N' or 'E', LIWORK >= 1;
-*> if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: reordering of T failed because some eigenvalues are too
-*> close to separate (the problem is very ill-conditioned);
-*> T may have been partially reordered, and WR and WI
-*> contain the eigenvalues in the same order as in T; S and
-*> SEP (if requested) are set to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> DTRSEN first collects the selected eigenvalues by computing an
-*> orthogonal transformation Z to move them to the top left corner of T.
-*> In other words, the selected eigenvalues are the eigenvalues of T11
-*> in:
-*>
-*> Z**T * T * Z = ( T11 T12 ) n1
-*> ( 0 T22 ) n2
-*> n1 n2
-*>
-*> where N = n1+n2 and Z**T means the transpose of Z. The first n1 columns
-*> of Z span the specified invariant subspace of T.
-*>
-*> If T has been obtained from the real Schur factorization of a matrix
-*> A = Q*T*Q**T, then the reordered real Schur factorization of A is given
-*> by A = (Q*Z)*(Z**T*T*Z)*(Q*Z)**T, and the first n1 columns of Q*Z span
-*> the corresponding invariant subspace of A.
-*>
-*> The reciprocal condition number of the average of the eigenvalues of
-*> T11 may be returned in S. S lies between 0 (very badly conditioned)
-*> and 1 (very well conditioned). It is computed as follows. First we
-*> compute R so that
-*>
-*> P = ( I R ) n1
-*> ( 0 0 ) n2
-*> n1 n2
-*>
-*> is the projector on the invariant subspace associated with T11.
-*> R is the solution of the Sylvester equation:
-*>
-*> T11*R - R*T22 = T12.
-*>
-*> Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
-*> the two-norm of M. Then S is computed as the lower bound
-*>
-*> (1 + F-norm(R)**2)**(-1/2)
-*>
-*> on the reciprocal of 2-norm(P), the true reciprocal condition number.
-*> S cannot underestimate 1 / 2-norm(P) by more than a factor of
-*> sqrt(N).
-*>
-*> An approximate error bound for the computed average of the
-*> eigenvalues of T11 is
-*>
-*> EPS * norm(T) / S
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal condition number of the right invariant subspace
-*> spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
-*> SEP is defined as the separation of T11 and T22:
-*>
-*> sep( T11, T22 ) = sigma-min( C )
-*>
-*> where sigma-min(C) is the smallest singular value of the
-*> n1*n2-by-n1*n2 matrix
-*>
-*> C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
-*>
-*> I(m) is an m by m identity matrix, and kprod denotes the Kronecker
-*> product. We estimate sigma-min(C) by the reciprocal of an estimate of
-*> the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
-*> cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
-*>
-*> When SEP is small, small changes in T can cause large changes in
-*> the invariant subspace. An approximate bound on the maximum angular
-*> error in the computed right invariant subspace is
-*>
-*> EPS * norm(T) / SEP
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI,
- $ M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, JOB
- INTEGER INFO, LDQ, LDT, LIWORK, LWORK, M, N
- DOUBLE PRECISION S, SEP
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ),
- $ WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, PAIR, SWAP, WANTBH, WANTQ, WANTS,
- $ WANTSP
- INTEGER IERR, K, KASE, KK, KS, LIWMIN, LWMIN, N1, N2,
- $ NN
- DOUBLE PRECISION EST, RNORM, SCALE
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLANGE
- EXTERNAL LSAME, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLACPY, DTREXC, DTRSYL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- WANTBH = LSAME( JOB, 'B' )
- WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
- WANTSP = LSAME( JOB, 'V' ) .OR. WANTBH
- WANTQ = LSAME( COMPQ, 'V' )
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.WANTS .AND. .NOT.WANTSP )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -8
- ELSE
-*
-* Set M to the dimension of the specified invariant subspace,
-* and test LWORK and LIWORK.
-*
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( T( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
-*
- N1 = M
- N2 = N - M
- NN = N1*N2
-*
- IF( WANTSP ) THEN
- LWMIN = MAX( 1, 2*NN )
- LIWMIN = MAX( 1, NN )
- ELSE IF( LSAME( JOB, 'N' ) ) THEN
- LWMIN = MAX( 1, N )
- LIWMIN = 1
- ELSE IF( LSAME( JOB, 'E' ) ) THEN
- LWMIN = MAX( 1, NN )
- LIWMIN = 1
- END IF
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -15
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -17
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRSEN', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.N .OR. M.EQ.0 ) THEN
- IF( WANTS )
- $ S = ONE
- IF( WANTSP )
- $ SEP = DLANGE( '1', N, N, T, LDT, WORK )
- GO TO 40
- END IF
-*
-* Collect the selected blocks at the top-left corner of T.
-*
- KS = 0
- PAIR = .FALSE.
- DO 20 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- SWAP = SELECT( K )
- IF( K.LT.N ) THEN
- IF( T( K+1, K ).NE.ZERO ) THEN
- PAIR = .TRUE.
- SWAP = SWAP .OR. SELECT( K+1 )
- END IF
- END IF
- IF( SWAP ) THEN
- KS = KS + 1
-*
-* Swap the K-th block to position KS.
-*
- IERR = 0
- KK = K
- IF( K.NE.KS )
- $ CALL DTREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, WORK,
- $ IERR )
- IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN
-*
-* Blocks too close to swap: exit.
-*
- INFO = 1
- IF( WANTS )
- $ S = ZERO
- IF( WANTSP )
- $ SEP = ZERO
- GO TO 40
- END IF
- IF( PAIR )
- $ KS = KS + 1
- END IF
- END IF
- 20 CONTINUE
-*
- IF( WANTS ) THEN
-*
-* Solve Sylvester equation for R:
-*
-* T11*R - R*T22 = scale*T12
-*
- CALL DLACPY( 'F', N1, N2, T( 1, N1+1 ), LDT, WORK, N1 )
- CALL DTRSYL( 'N', 'N', -1, N1, N2, T, LDT, T( N1+1, N1+1 ),
- $ LDT, WORK, N1, SCALE, IERR )
-*
-* Estimate the reciprocal of the condition number of the cluster
-* of eigenvalues.
-*
- RNORM = DLANGE( 'F', N1, N2, WORK, N1, WORK )
- IF( RNORM.EQ.ZERO ) THEN
- S = ONE
- ELSE
- S = SCALE / ( SQRT( SCALE*SCALE / RNORM+RNORM )*
- $ SQRT( RNORM ) )
- END IF
- END IF
-*
- IF( WANTSP ) THEN
-*
-* Estimate sep(T11,T22).
-*
- EST = ZERO
- KASE = 0
- 30 CONTINUE
- CALL DLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Solve T11*R - R*T22 = scale*X.
-*
- CALL DTRSYL( 'N', 'N', -1, N1, N2, T, LDT,
- $ T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
- $ IERR )
- ELSE
-*
-* Solve T11**T*R - R*T22**T = scale*X.
-*
- CALL DTRSYL( 'T', 'T', -1, N1, N2, T, LDT,
- $ T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
- $ IERR )
- END IF
- GO TO 30
- END IF
-*
- SEP = SCALE / EST
- END IF
-*
- 40 CONTINUE
-*
-* Store the output eigenvalues in WR and WI.
-*
- DO 50 K = 1, N
- WR( K ) = T( K, K )
- WI( K ) = ZERO
- 50 CONTINUE
- DO 60 K = 1, N - 1
- IF( T( K+1, K ).NE.ZERO ) THEN
- WI( K ) = SQRT( ABS( T( K, K+1 ) ) )*
- $ SQRT( ABS( T( K+1, K ) ) )
- WI( K+1 ) = -WI( K )
- END IF
- 60 CONTINUE
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of DTRSEN
-*
- END
diff --git a/netlib/LAPACK/dtrsna.f b/netlib/LAPACK/dtrsna.f
deleted file mode 100644
index 6dcd20a..0000000
--- a/netlib/LAPACK/dtrsna.f
+++ /dev/null
@@ -1,603 +0,0 @@
-*> \brief \b DTRSNA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRSNA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrsna.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrsna.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrsna.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-* LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, JOB
-* INTEGER INFO, LDT, LDVL, LDVR, LDWORK, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* DOUBLE PRECISION S( * ), SEP( * ), T( LDT, * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRSNA estimates reciprocal condition numbers for specified
-*> eigenvalues and/or right eigenvectors of a real upper
-*> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
-*> orthogonal).
-*>
-*> T must be in Schur canonical form (as returned by DHSEQR), that is,
-*> block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*> 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies whether condition numbers are required for
-*> eigenvalues (S) or eigenvectors (SEP):
-*> = 'E': for eigenvalues only (S);
-*> = 'V': for eigenvectors only (SEP);
-*> = 'B': for both eigenvalues and eigenvectors (S and SEP).
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute condition numbers for all eigenpairs;
-*> = 'S': compute condition numbers for selected eigenpairs
-*> specified by the array SELECT.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenpairs for which
-*> condition numbers are required. To select condition numbers
-*> for the eigenpair corresponding to a real eigenvalue w(j),
-*> SELECT(j) must be set to .TRUE.. To select condition numbers
-*> corresponding to a complex conjugate pair of eigenvalues w(j)
-*> and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
-*> set to .TRUE..
-*> If HOWMNY = 'A', SELECT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The upper quasi-triangular matrix T, in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,M)
-*> If JOB = 'E' or 'B', VL must contain left eigenvectors of T
-*> (or of any Q*T*Q**T with Q orthogonal), corresponding to the
-*> eigenpairs specified by HOWMNY and SELECT. The eigenvectors
-*> must be stored in consecutive columns of VL, as returned by
-*> DHSEIN or DTREVC.
-*> If JOB = 'V', VL is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL.
-*> LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,M)
-*> If JOB = 'E' or 'B', VR must contain right eigenvectors of T
-*> (or of any Q*T*Q**T with Q orthogonal), corresponding to the
-*> eigenpairs specified by HOWMNY and SELECT. The eigenvectors
-*> must be stored in consecutive columns of VR, as returned by
-*> DHSEIN or DTREVC.
-*> If JOB = 'V', VR is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR.
-*> LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (MM)
-*> If JOB = 'E' or 'B', the reciprocal condition numbers of the
-*> selected eigenvalues, stored in consecutive elements of the
-*> array. For a complex conjugate pair of eigenvalues two
-*> consecutive elements of S are set to the same value. Thus
-*> S(j), SEP(j), and the j-th columns of VL and VR all
-*> correspond to the same eigenpair (but not in general the
-*> j-th eigenpair, unless all eigenpairs are selected).
-*> If JOB = 'V', S is not referenced.
-*> \endverbatim
-*>
-*> \param[out] SEP
-*> \verbatim
-*> SEP is DOUBLE PRECISION array, dimension (MM)
-*> If JOB = 'V' or 'B', the estimated reciprocal condition
-*> numbers of the selected eigenvectors, stored in consecutive
-*> elements of the array. For a complex eigenvector two
-*> consecutive elements of SEP are set to the same value. If
-*> the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
-*> is set to 0; this can only occur when the true value would be
-*> very small anyway.
-*> If JOB = 'E', SEP is not referenced.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of elements in the arrays S (if JOB = 'E' or 'B')
-*> and/or SEP (if JOB = 'V' or 'B'). MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of elements of the arrays S and/or SEP actually
-*> used to store the estimated condition numbers.
-*> If HOWMNY = 'A', M is set to N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LDWORK,N+6)
-*> If JOB = 'E', WORK is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*(N-1))
-*> If JOB = 'E', IWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The reciprocal of the condition number of an eigenvalue lambda is
-*> defined as
-*>
-*> S(lambda) = |v**T*u| / (norm(u)*norm(v))
-*>
-*> where u and v are the right and left eigenvectors of T corresponding
-*> to lambda; v**T denotes the transpose of v, and norm(u)
-*> denotes the Euclidean norm. These reciprocal condition numbers always
-*> lie between zero (very badly conditioned) and one (very well
-*> conditioned). If n = 1, S(lambda) is defined to be 1.
-*>
-*> An approximate error bound for a computed eigenvalue W(i) is given by
-*>
-*> EPS * norm(T) / S(i)
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal of the condition number of the right eigenvector u
-*> corresponding to lambda is defined as follows. Suppose
-*>
-*> T = ( lambda c )
-*> ( 0 T22 )
-*>
-*> Then the reciprocal condition number is
-*>
-*> SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
-*>
-*> where sigma-min denotes the smallest singular value. We approximate
-*> the smallest singular value by the reciprocal of an estimate of the
-*> one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
-*> defined to be abs(T(1,1)).
-*>
-*> An approximate error bound for a computed right eigenvector VR(i)
-*> is given by
-*>
-*> EPS * norm(T) / SEP(i)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
- $ LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, JOB
- INTEGER INFO, LDT, LDVL, LDVR, LDWORK, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- DOUBLE PRECISION S( * ), SEP( * ), T( LDT, * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL PAIR, SOMCON, WANTBH, WANTS, WANTSP
- INTEGER I, IERR, IFST, ILST, J, K, KASE, KS, N2, NN
- DOUBLE PRECISION BIGNUM, COND, CS, DELTA, DUMM, EPS, EST, LNRM,
- $ MU, PROD, PROD1, PROD2, RNRM, SCALE, SMLNUM, SN
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
- DOUBLE PRECISION DUMMY( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT, DLAMCH, DLAPY2, DNRM2
- EXTERNAL LSAME, DDOT, DLAMCH, DLAPY2, DNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLACPY, DLAQTR, DTREXC, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- WANTBH = LSAME( JOB, 'B' )
- WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
- WANTSP = LSAME( JOB, 'V' ) .OR. WANTBH
-*
- SOMCON = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- IF( .NOT.WANTS .AND. .NOT.WANTSP ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( HOWMNY, 'A' ) .AND. .NOT.SOMCON ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVL.LT.1 .OR. ( WANTS .AND. LDVL.LT.N ) ) THEN
- INFO = -8
- ELSE IF( LDVR.LT.1 .OR. ( WANTS .AND. LDVR.LT.N ) ) THEN
- INFO = -10
- ELSE
-*
-* Set M to the number of eigenpairs for which condition numbers
-* are required, and test MM.
-*
- IF( SOMCON ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( T( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( MM.LT.M ) THEN
- INFO = -13
- ELSE IF( LDWORK.LT.1 .OR. ( WANTSP .AND. LDWORK.LT.N ) ) THEN
- INFO = -16
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRSNA', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( SOMCON ) THEN
- IF( .NOT.SELECT( 1 ) )
- $ RETURN
- END IF
- IF( WANTS )
- $ S( 1 ) = ONE
- IF( WANTSP )
- $ SEP( 1 ) = ABS( T( 1, 1 ) )
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
- KS = 0
- PAIR = .FALSE.
- DO 60 K = 1, N
-*
-* Determine whether T(k,k) begins a 1-by-1 or 2-by-2 block.
-*
- IF( PAIR ) THEN
- PAIR = .FALSE.
- GO TO 60
- ELSE
- IF( K.LT.N )
- $ PAIR = T( K+1, K ).NE.ZERO
- END IF
-*
-* Determine whether condition numbers are required for the k-th
-* eigenpair.
-*
- IF( SOMCON ) THEN
- IF( PAIR ) THEN
- IF( .NOT.SELECT( K ) .AND. .NOT.SELECT( K+1 ) )
- $ GO TO 60
- ELSE
- IF( .NOT.SELECT( K ) )
- $ GO TO 60
- END IF
- END IF
-*
- KS = KS + 1
-*
- IF( WANTS ) THEN
-*
-* Compute the reciprocal condition number of the k-th
-* eigenvalue.
-*
- IF( .NOT.PAIR ) THEN
-*
-* Real eigenvalue.
-*
- PROD = DDOT( N, VR( 1, KS ), 1, VL( 1, KS ), 1 )
- RNRM = DNRM2( N, VR( 1, KS ), 1 )
- LNRM = DNRM2( N, VL( 1, KS ), 1 )
- S( KS ) = ABS( PROD ) / ( RNRM*LNRM )
- ELSE
-*
-* Complex eigenvalue.
-*
- PROD1 = DDOT( N, VR( 1, KS ), 1, VL( 1, KS ), 1 )
- PROD1 = PROD1 + DDOT( N, VR( 1, KS+1 ), 1, VL( 1, KS+1 ),
- $ 1 )
- PROD2 = DDOT( N, VL( 1, KS ), 1, VR( 1, KS+1 ), 1 )
- PROD2 = PROD2 - DDOT( N, VL( 1, KS+1 ), 1, VR( 1, KS ),
- $ 1 )
- RNRM = DLAPY2( DNRM2( N, VR( 1, KS ), 1 ),
- $ DNRM2( N, VR( 1, KS+1 ), 1 ) )
- LNRM = DLAPY2( DNRM2( N, VL( 1, KS ), 1 ),
- $ DNRM2( N, VL( 1, KS+1 ), 1 ) )
- COND = DLAPY2( PROD1, PROD2 ) / ( RNRM*LNRM )
- S( KS ) = COND
- S( KS+1 ) = COND
- END IF
- END IF
-*
- IF( WANTSP ) THEN
-*
-* Estimate the reciprocal condition number of the k-th
-* eigenvector.
-*
-* Copy the matrix T to the array WORK and swap the diagonal
-* block beginning at T(k,k) to the (1,1) position.
-*
- CALL DLACPY( 'Full', N, N, T, LDT, WORK, LDWORK )
- IFST = K
- ILST = 1
- CALL DTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, IFST, ILST,
- $ WORK( 1, N+1 ), IERR )
-*
- IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN
-*
-* Could not swap because blocks not well separated
-*
- SCALE = ONE
- EST = BIGNUM
- ELSE
-*
-* Reordering successful
-*
- IF( WORK( 2, 1 ).EQ.ZERO ) THEN
-*
-* Form C = T22 - lambda*I in WORK(2:N,2:N).
-*
- DO 20 I = 2, N
- WORK( I, I ) = WORK( I, I ) - WORK( 1, 1 )
- 20 CONTINUE
- N2 = 1
- NN = N - 1
- ELSE
-*
-* Triangularize the 2 by 2 block by unitary
-* transformation U = [ cs i*ss ]
-* [ i*ss cs ].
-* such that the (1,1) position of WORK is complex
-* eigenvalue lambda with positive imaginary part. (2,2)
-* position of WORK is the complex eigenvalue lambda
-* with negative imaginary part.
-*
- MU = SQRT( ABS( WORK( 1, 2 ) ) )*
- $ SQRT( ABS( WORK( 2, 1 ) ) )
- DELTA = DLAPY2( MU, WORK( 2, 1 ) )
- CS = MU / DELTA
- SN = -WORK( 2, 1 ) / DELTA
-*
-* Form
-*
-* C**T = WORK(2:N,2:N) + i*[rwork(1) ..... rwork(n-1) ]
-* [ mu ]
-* [ .. ]
-* [ .. ]
-* [ mu ]
-* where C**T is transpose of matrix C,
-* and RWORK is stored starting in the N+1-st column of
-* WORK.
-*
- DO 30 J = 3, N
- WORK( 2, J ) = CS*WORK( 2, J )
- WORK( J, J ) = WORK( J, J ) - WORK( 1, 1 )
- 30 CONTINUE
- WORK( 2, 2 ) = ZERO
-*
- WORK( 1, N+1 ) = TWO*MU
- DO 40 I = 2, N - 1
- WORK( I, N+1 ) = SN*WORK( 1, I+1 )
- 40 CONTINUE
- N2 = 2
- NN = 2*( N-1 )
- END IF
-*
-* Estimate norm(inv(C**T))
-*
- EST = ZERO
- KASE = 0
- 50 CONTINUE
- CALL DLACN2( NN, WORK( 1, N+2 ), WORK( 1, N+4 ), IWORK,
- $ EST, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
- IF( N2.EQ.1 ) THEN
-*
-* Real eigenvalue: solve C**T*x = scale*c.
-*
- CALL DLAQTR( .TRUE., .TRUE., N-1, WORK( 2, 2 ),
- $ LDWORK, DUMMY, DUMM, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
- ELSE
-*
-* Complex eigenvalue: solve
-* C**T*(p+iq) = scale*(c+id) in real arithmetic.
-*
- CALL DLAQTR( .TRUE., .FALSE., N-1, WORK( 2, 2 ),
- $ LDWORK, WORK( 1, N+1 ), MU, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
- END IF
- ELSE
- IF( N2.EQ.1 ) THEN
-*
-* Real eigenvalue: solve C*x = scale*c.
-*
- CALL DLAQTR( .FALSE., .TRUE., N-1, WORK( 2, 2 ),
- $ LDWORK, DUMMY, DUMM, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
- ELSE
-*
-* Complex eigenvalue: solve
-* C*(p+iq) = scale*(c+id) in real arithmetic.
-*
- CALL DLAQTR( .FALSE., .FALSE., N-1,
- $ WORK( 2, 2 ), LDWORK,
- $ WORK( 1, N+1 ), MU, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
-*
- END IF
- END IF
-*
- GO TO 50
- END IF
- END IF
-*
- SEP( KS ) = SCALE / MAX( EST, SMLNUM )
- IF( PAIR )
- $ SEP( KS+1 ) = SEP( KS )
- END IF
-*
- IF( PAIR )
- $ KS = KS + 1
-*
- 60 CONTINUE
- RETURN
-*
-* End of DTRSNA
-*
- END
diff --git a/netlib/LAPACK/dtrsyl.f b/netlib/LAPACK/dtrsyl.f
deleted file mode 100644
index 0d16d9c..0000000
--- a/netlib/LAPACK/dtrsyl.f
+++ /dev/null
@@ -1,1002 +0,0 @@
-*> \brief \b DTRSYL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRSYL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrsyl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrsyl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrsyl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
-* LDC, SCALE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANA, TRANB
-* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRSYL solves the real Sylvester matrix equation:
-*>
-*> op(A)*X + X*op(B) = scale*C or
-*> op(A)*X - X*op(B) = scale*C,
-*>
-*> where op(A) = A or A**T, and A and B are both upper quasi-
-*> triangular. A is M-by-M and B is N-by-N; the right hand side C and
-*> the solution X are M-by-N; and scale is an output scale factor, set
-*> <= 1 to avoid overflow in X.
-*>
-*> A and B must be in Schur canonical form (as returned by DHSEQR), that
-*> is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
-*> each 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANA
-*> \verbatim
-*> TRANA is CHARACTER*1
-*> Specifies the option op(A):
-*> = 'N': op(A) = A (No transpose)
-*> = 'T': op(A) = A**T (Transpose)
-*> = 'C': op(A) = A**H (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] TRANB
-*> \verbatim
-*> TRANB is CHARACTER*1
-*> Specifies the option op(B):
-*> = 'N': op(B) = B (No transpose)
-*> = 'T': op(B) = B**T (Transpose)
-*> = 'C': op(B) = B**H (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] ISGN
-*> \verbatim
-*> ISGN is INTEGER
-*> Specifies the sign in the equation:
-*> = +1: solve op(A)*X + X*op(B) = scale*C
-*> = -1: solve op(A)*X - X*op(B) = scale*C
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The order of the matrix A, and the number of rows in the
-*> matrices X and C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B, and the number of columns in the
-*> matrices X and C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,M)
-*> The upper quasi-triangular matrix A, in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> The upper quasi-triangular matrix B, in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N right hand side matrix C.
-*> On exit, C is overwritten by the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M)
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scale factor, scale, set <= 1 to avoid overflow in X.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: A and B have common or very close eigenvalues; perturbed
-*> values were used to solve the equation (but the matrices
-*> A and B are unchanged).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYcomputational
-*
-* =====================================================================
- SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
- $ LDC, SCALE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANA, TRANB
- INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRNA, NOTRNB
- INTEGER IERR, J, K, K1, K2, KNEXT, L, L1, L2, LNEXT
- DOUBLE PRECISION A11, BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
- $ SMLNUM, SUML, SUMR, XNORM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DUM( 1 ), VEC( 2, 2 ), X( 2, 2 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DDOT, DLAMCH, DLANGE
- EXTERNAL LSAME, DDOT, DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLABAD, DLALN2, DLASY2, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test input parameters
-*
- NOTRNA = LSAME( TRANA, 'N' )
- NOTRNB = LSAME( TRANB, 'N' )
-*
- INFO = 0
- IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
- $ LSAME( TRANA, 'C' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
- $ LSAME( TRANB, 'C' ) ) THEN
- INFO = -2
- ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRSYL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- SCALE = ONE
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SMLNUM*DBLE( M*N ) / EPS
- BIGNUM = ONE / SMLNUM
-*
- SMIN = MAX( SMLNUM, EPS*DLANGE( 'M', M, M, A, LDA, DUM ),
- $ EPS*DLANGE( 'M', N, N, B, LDB, DUM ) )
-*
- SGN = ISGN
-*
- IF( NOTRNA .AND. NOTRNB ) THEN
-*
-* Solve A*X + ISGN*X*B = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* bottom-left corner column by column by
-*
-* A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-* Where
-* M L-1
-* R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)].
-* I=K+1 J=1
-*
-* Start column loop (index = L)
-* L1 (L2) : column index of the first (first) row of X(K,L).
-*
- LNEXT = 1
- DO 60 L = 1, N
- IF( L.LT.LNEXT )
- $ GO TO 60
- IF( L.EQ.N ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L+1, L ).NE.ZERO ) THEN
- L1 = L
- L2 = L + 1
- LNEXT = L + 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L + 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L).
-*
- KNEXT = M
- DO 50 K = M, 1, -1
- IF( K.GT.KNEXT )
- $ GO TO 50
- IF( K.EQ.1 ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K, K-1 ).NE.ZERO ) THEN
- K1 = K - 1
- K2 = K
- KNEXT = K - 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K - 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 10 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 10 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 20 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 20 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L2 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 30 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 30 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL DLASY2( .FALSE., .FALSE., ISGN, 2, 2,
- $ A( K1, K1 ), LDA, B( L1, L1 ), LDB, VEC,
- $ 2, SCALOC, X, 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 40 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 40 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 50 CONTINUE
-*
- 60 CONTINUE
-*
- ELSE IF( .NOT.NOTRNA .AND. NOTRNB ) THEN
-*
-* Solve A**T *X + ISGN*X*B = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* upper-left corner column by column by
-*
-* A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-* Where
-* K-1 T L-1
-* R(K,L) = SUM [A(I,K)**T*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)]
-* I=1 J=1
-*
-* Start column loop (index = L)
-* L1 (L2): column index of the first (last) row of X(K,L)
-*
- LNEXT = 1
- DO 120 L = 1, N
- IF( L.LT.LNEXT )
- $ GO TO 120
- IF( L.EQ.N ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L+1, L ).NE.ZERO ) THEN
- L1 = L
- L2 = L + 1
- LNEXT = L + 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L + 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L)
-*
- KNEXT = 1
- DO 110 K = 1, M
- IF( K.LT.KNEXT )
- $ GO TO 110
- IF( K.EQ.M ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K+1, K ).NE.ZERO ) THEN
- K1 = K
- K2 = K + 1
- KNEXT = K + 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K + 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 70 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 70 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 80 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 80 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 90 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 90 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
- SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL DLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ),
- $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
- $ 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 100 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 100 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 110 CONTINUE
- 120 CONTINUE
-*
- ELSE IF( .NOT.NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-* Solve A**T*X + ISGN*X*B**T = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* top-right corner column by column by
-*
-* A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
-*
-* Where
-* K-1 N
-* R(K,L) = SUM [A(I,K)**T*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
-* I=1 J=L+1
-*
-* Start column loop (index = L)
-* L1 (L2): column index of the first (last) row of X(K,L)
-*
- LNEXT = N
- DO 180 L = N, 1, -1
- IF( L.GT.LNEXT )
- $ GO TO 180
- IF( L.EQ.1 ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L, L-1 ).NE.ZERO ) THEN
- L1 = L - 1
- L2 = L
- LNEXT = L - 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L - 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L)
-*
- KNEXT = 1
- DO 170 K = 1, M
- IF( K.LT.KNEXT )
- $ GO TO 170
- IF( K.EQ.M ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K+1, K ).NE.ZERO ) THEN
- K1 = K
- K2 = K + 1
- KNEXT = K + 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K + 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
- $ B( L1, MIN( L1+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 130 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 130 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 140 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 140 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 150 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 150 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
- SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL DLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
- $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
- $ 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 160 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 160 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 170 CONTINUE
- 180 CONTINUE
-*
- ELSE IF( NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-* Solve A*X + ISGN*X*B**T = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* bottom-right corner column by column by
-*
-* A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
-*
-* Where
-* M N
-* R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
-* I=K+1 J=L+1
-*
-* Start column loop (index = L)
-* L1 (L2): column index of the first (last) row of X(K,L)
-*
- LNEXT = N
- DO 240 L = N, 1, -1
- IF( L.GT.LNEXT )
- $ GO TO 240
- IF( L.EQ.1 ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L, L-1 ).NE.ZERO ) THEN
- L1 = L - 1
- L2 = L
- LNEXT = L - 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L - 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L)
-*
- KNEXT = M
- DO 230 K = M, 1, -1
- IF( K.GT.KNEXT )
- $ GO TO 230
- IF( K.EQ.1 ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K, K-1 ).NE.ZERO ) THEN
- K1 = K - 1
- K2 = K
- KNEXT = K - 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K - 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = DDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
- $ B( L1, MIN( L1+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 190 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 190 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 200 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 200 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L2 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 210 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 210 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL DLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
- $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
- $ 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 220 J = 1, N
- CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
- 220 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 230 CONTINUE
- 240 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of DTRSYL
-*
- END
diff --git a/netlib/LAPACK/dtrti2.f b/netlib/LAPACK/dtrti2.f
deleted file mode 100644
index edf1b5b..0000000
--- a/netlib/LAPACK/dtrti2.f
+++ /dev/null
@@ -1,212 +0,0 @@
-*> \brief \b DTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTI2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrti2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrti2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrti2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTI2 computes the inverse of a real upper or lower triangular
-*> matrix.
-*>
-*> This is the Level 2 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading n by n upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced. If DIAG = 'U', the
-*> diagonal elements of A are also not referenced and are
-*> assumed to be 1.
-*>
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DTRMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTI2', -INFO )
- RETURN
- END IF
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix.
-*
- DO 10 J = 1, N
- IF( NOUNIT ) THEN
- A( J, J ) = ONE / A( J, J )
- AJJ = -A( J, J )
- ELSE
- AJJ = -ONE
- END IF
-*
-* Compute elements 1:j-1 of j-th column.
-*
- CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
- $ A( 1, J ), 1 )
- CALL DSCAL( J-1, AJJ, A( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Compute inverse of lower triangular matrix.
-*
- DO 20 J = N, 1, -1
- IF( NOUNIT ) THEN
- A( J, J ) = ONE / A( J, J )
- AJJ = -A( J, J )
- ELSE
- AJJ = -ONE
- END IF
- IF( J.LT.N ) THEN
-*
-* Compute elements j+1:n of j-th column.
-*
- CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J,
- $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
- CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DTRTI2
-*
- END
diff --git a/netlib/LAPACK/dtrtri.f b/netlib/LAPACK/dtrtri.f
deleted file mode 100644
index 5d27ca5..0000000
--- a/netlib/LAPACK/dtrtri.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b DTRTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrtri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrtri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrtri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTRI computes the inverse of a real upper or lower triangular
-*> matrix A.
-*>
-*> This is the Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced. If DIAG = 'U', the
-*> diagonal elements of A are also not referenced and are
-*> assumed to be 1.
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JB, NB, NN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DTRMM, DTRSM, DTRTI2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity if non-unit.
-*
- IF( NOUNIT ) THEN
- DO 10 INFO = 1, N
- IF( A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- INFO = 0
- END IF
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DTRTRI', UPLO // DIAG, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix
-*
- DO 20 J = 1, N, NB
- JB = MIN( NB, N-J+1 )
-*
-* Compute rows 1:j-1 of current block column
-*
- CALL DTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
- $ JB, ONE, A, LDA, A( 1, J ), LDA )
- CALL DTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
- $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
-*
-* Compute inverse of current diagonal block
-*
- CALL DTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
- 20 CONTINUE
- ELSE
-*
-* Compute inverse of lower triangular matrix
-*
- NN = ( ( N-1 ) / NB )*NB + 1
- DO 30 J = NN, 1, -NB
- JB = MIN( NB, N-J+1 )
- IF( J+JB.LE.N ) THEN
-*
-* Compute rows j+jb:n of current block column
-*
- CALL DTRMM( 'Left', 'Lower', 'No transpose', DIAG,
- $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
- $ A( J+JB, J ), LDA )
- CALL DTRSM( 'Right', 'Lower', 'No transpose', DIAG,
- $ N-J-JB+1, JB, -ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
- END IF
-*
-* Compute inverse of current diagonal block
-*
- CALL DTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
- 30 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRTRI
-*
- END
diff --git a/netlib/LAPACK/dtrtrs.f b/netlib/LAPACK/dtrtrs.f
deleted file mode 100644
index 416a66e..0000000
--- a/netlib/LAPACK/dtrtrs.f
+++ /dev/null
@@ -1,226 +0,0 @@
-*> \brief \b DTRTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTRS solves a triangular system of the form
-*>
-*> A * X = B or A**T * X = B,
-*>
-*> where A is a triangular matrix of order N, and B is an N-by-NRHS
-*> matrix. A check is made to verify that A is nonsingular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the solutions
-*> X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- DO 10 INFO = 1, N
- IF( A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- END IF
- INFO = 0
-*
-* Solve A * x = b or A**T * x = b.
-*
- CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
- $ LDB )
-*
- RETURN
-*
-* End of DTRTRS
-*
- END
diff --git a/netlib/LAPACK/dtrttf.f b/netlib/LAPACK/dtrttf.f
deleted file mode 100644
index 69b502a..0000000
--- a/netlib/LAPACK/dtrttf.f
+++ /dev/null
@@ -1,492 +0,0 @@
-*> \brief \b DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrttf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrttf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrttf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTTF copies a triangular matrix A from standard full format (TR)
-*> to rectangular full packed format (TF) .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF in Normal form is wanted;
-*> = 'T': ARF in Transpose form is wanted.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N).
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the matrix A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ARF
-*> \verbatim
-*> ARF is DOUBLE PRECISION array, dimension (NT).
-*> NT=N*(N+1)/2. On exit, the triangular matrix A in RFP format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE DTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER I, IJ, J, K, L, N1, N2, NT, NX2, NP1X2
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTTF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- IF( N.EQ.1 ) THEN
- ARF( 0 ) = A( 0, 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:nt-1)
-*
- NT = N*( N+1 ) / 2
-*
-* Set N1 and N2 depending on LOWER: for N even N1=N2=K
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
-* If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
-* N--by--(N+1)/2.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- IF( .NOT.LOWER )
- $ NP1X2 = N + N + 2
- ELSE
- NISODD = .TRUE.
- IF( .NOT.LOWER )
- $ NX2 = N + N
- END IF
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2
- DO I = N1, N2 + J
- ARF( IJ ) = A( N2+J, I )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N
- DO J = N - 1, N1, -1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = J - N1, N1 - 1
- ARF( IJ ) = A( J-N1, L )
- IJ = IJ + 1
- END DO
- IJ = IJ - NX2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2 - 1
- DO I = 0, J
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- DO I = N1 + J, N - 1
- ARF( IJ ) = A( I, N1+J )
- IJ = IJ + 1
- END DO
- END DO
- DO J = N2, N - 1
- DO I = 0, N1 - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, N1
- DO I = N1, N - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, N1 - 1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = N2 + J, N - 1
- ARF( IJ ) = A( N2+J, L )
- IJ = IJ + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, K - 1
- DO I = K, K + J
- ARF( IJ ) = A( K+J, I )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N - 1
- DO J = N - 1, K, -1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = J - K, K - 1
- ARF( IJ ) = A( J-K, L )
- IJ = IJ + 1
- END DO
- IJ = IJ - NP1X2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- J = K
- DO I = K, N - 1
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- DO I = K + 1 + J, N - 1
- ARF( IJ ) = A( I, K+1+J )
- IJ = IJ + 1
- END DO
- END DO
- DO J = K - 1, N - 1
- DO I = 0, K - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, K
- DO I = K, N - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = K + 1 + J, N - 1
- ARF( IJ ) = A( K+1+J, L )
- IJ = IJ + 1
- END DO
- END DO
-* Note that here, on exit of the loop, J = K-1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of DTRTTF
-*
- END
diff --git a/netlib/LAPACK/dtrttp.f b/netlib/LAPACK/dtrttp.f
deleted file mode 100644
index 58c4083..0000000
--- a/netlib/LAPACK/dtrttp.f
+++ /dev/null
@@ -1,176 +0,0 @@
-*> \brief \b DTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTTP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrttp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrttp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrttp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTTP( UPLO, N, A, LDA, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTTP copies a triangular matrix A from full format (TR) to standard
-*> packed format (TP).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular.
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices AP and A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On exit, the triangular matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] AP
-*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2
-*> On exit, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTTP( UPLO, N, A, LDA, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER
- INTEGER I, J, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTTP', -INFO )
- RETURN
- END IF
-*
- IF( LOWER ) THEN
- K = 0
- DO J = 1, N
- DO I = J, N
- K = K + 1
- AP( K ) = A( I, J )
- END DO
- END DO
- ELSE
- K = 0
- DO J = 1, N
- DO I = 1, J
- K = K + 1
- AP( K ) = A( I, J )
- END DO
- END DO
- END IF
-*
-*
- RETURN
-*
-* End of DTRTTP
-*
- END
diff --git a/netlib/LAPACK/dtzrqf.f b/netlib/LAPACK/dtzrqf.f
deleted file mode 100644
index 10aec72..0000000
--- a/netlib/LAPACK/dtzrqf.f
+++ /dev/null
@@ -1,232 +0,0 @@
-*> \brief \b DTZRQF
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtzrqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtzrqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine DTZRZF.
-*>
-*> DTZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
-*> to upper triangular form by means of orthogonal transformations.
-*>
-*> The upper trapezoidal matrix A is factored as
-*>
-*> A = ( R 0 ) * Z,
-*>
-*> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
-*> triangular matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= M.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the leading M-by-N upper trapezoidal part of the
-*> array A must contain the matrix to be factorized.
-*> On exit, the leading M-by-M upper triangular part of A
-*> contains the upper triangular matrix R, and elements M+1 to
-*> N of the first M rows of A, with the array TAU, represent the
-*> orthogonal matrix Z as a product of M elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (M)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The factorization is obtained by Householder's method. The kth
-*> transformation matrix, Z( k ), which is used to introduce zeros into
-*> the ( m - k + 1 )th row of A, is given in the form
-*>
-*> Z( k ) = ( I 0 ),
-*> ( 0 T( k ) )
-*>
-*> where
-*>
-*> T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ),
-*> ( 0 )
-*> ( z( k ) )
-*>
-*> tau is a scalar and z( k ) is an ( n - m ) element vector.
-*> tau and z( k ) are chosen to annihilate the elements of the kth row
-*> of X.
-*>
-*> The scalar tau is returned in the kth element of TAU and the vector
-*> u( k ) in the kth row of A, such that the elements of z( k ) are
-*> in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
-*> the upper triangular part of A.
-*>
-*> Z is given by
-*>
-*> Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K, M1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DGER, DLARFG, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTZRQF', -INFO )
- RETURN
- END IF
-*
-* Perform the factorization.
-*
- IF( M.EQ.0 )
- $ RETURN
- IF( M.EQ.N ) THEN
- DO 10 I = 1, N
- TAU( I ) = ZERO
- 10 CONTINUE
- ELSE
- M1 = MIN( M+1, N )
- DO 20 K = M, 1, -1
-*
-* 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 ) )
-*
- IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN
-*
-* We now perform the operation A := A*P( k ).
-*
-* Use the first ( k - 1 ) elements of TAU to store a( k ),
-* where a( k ) consists of the first ( k - 1 ) elements of
-* the kth column of A. Also let B denote the first
-* ( k - 1 ) rows of the last ( n - m ) columns of A.
-*
- CALL DCOPY( K-1, A( 1, K ), 1, TAU, 1 )
-*
-* Form w = a( k ) + B*z( k ) in TAU.
-*
- CALL DGEMV( 'No transpose', K-1, N-M, ONE, A( 1, M1 ),
- $ LDA, A( K, M1 ), LDA, ONE, TAU, 1 )
-*
-* Now form a( k ) := a( k ) - tau*w
-* 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 )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DTZRQF
-*
- END
diff --git a/netlib/LAPACK/dtzrzf.f b/netlib/LAPACK/dtzrzf.f
deleted file mode 100644
index 00f70fc..0000000
--- a/netlib/LAPACK/dtzrzf.f
+++ /dev/null
@@ -1,313 +0,0 @@
-*> \brief \b DTZRZF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTZRZF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtzrzf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtzrzf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtzrzf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
-*> to upper triangular form by means of orthogonal transformations.
-*>
-*> The upper trapezoidal matrix A is factored as
-*>
-*> A = ( R 0 ) * Z,
-*>
-*> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
-*> triangular matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= M.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the leading M-by-N upper trapezoidal part of the
-*> array A must contain the matrix to be factorized.
-*> On exit, the leading M-by-M upper triangular part of A
-*> contains the upper triangular matrix R, and elements M+1 to
-*> N of the first M rows of A, with the array TAU, represent the
-*> orthogonal matrix Z as a product of M elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (M)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The N-by-N matrix Z can be computed by
-*>
-*> Z = Z(1)*Z(2)* ... *Z(M)
-*>
-*> where each N-by-N Z(k) is given by
-*>
-*> Z(k) = I - tau(k)*v(k)*v(k)**T
-*>
-*> with v(k) is the kth row vector of the M-by-N matrix
-*>
-*> V = ( I A(:,M+1:N) )
-*>
-*> I is the M-by-M identity matrix, A(:,M+1:N)
-*> is the output stored in A on exit from DTZRZF,
-*> and tau(k) is the kth element of the array TAU.
-*>
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IWS, KI, KK, LDWORK, LWKMIN, LWKOPT,
- $ M1, MU, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, DLARZB, DLARZT, DLATRZ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. M.EQ.N ) THEN
- LWKOPT = 1
- LWKMIN = 1
- ELSE
-*
-* Determine the block size.
-*
- NB = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- LWKMIN = MAX( 1, M )
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTZRZF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 ) THEN
- RETURN
- ELSE IF( M.EQ.N ) THEN
- DO 10 I = 1, N
- TAU( I ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 1
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.M ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGERQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.M ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGERQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.M .AND. NX.LT.M ) THEN
-*
-* Use blocked code initially.
-* The last kk rows are handled by the block method.
-*
- M1 = MIN( M+1, N )
- KI = ( ( M-NX-1 ) / NB )*NB
- KK = MIN( M, KI+NB )
-*
- DO 20 I = M - KK + KI + 1, M - KK + 1, -NB
- IB = MIN( M-I+1, NB )
-*
-* Compute the TZ factorization of the current block
-* A(i:i+ib-1,i:n)
-*
- CALL DLATRZ( IB, N-I+1, N-M, A( I, I ), LDA, TAU( I ),
- $ WORK )
- IF( I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL DLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(1:i-1,i:n) from the right
-*
- CALL DLARZB( 'Right', 'No transpose', 'Backward',
- $ 'Rowwise', I-1, N-I+1, IB, N-M, A( I, M1 ),
- $ LDA, WORK, LDWORK, A( 1, I ), LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 20 CONTINUE
- MU = I + NB - 1
- ELSE
- MU = M
- END IF
-*
-* Use unblocked code to factor the last or only block
-*
- IF( MU.GT.0 )
- $ CALL DLATRZ( MU, N, N-M, A, LDA, TAU, WORK )
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of DTZRZF
-*
- END
diff --git a/netlib/LAPACK/dzsum1.f b/netlib/LAPACK/dzsum1.f
deleted file mode 100644
index bfa032c..0000000
--- a/netlib/LAPACK/dzsum1.f
+++ /dev/null
@@ -1,140 +0,0 @@
-*> \brief \b DZSUM1 forms the 1-norm of the complex vector using the true absolute value.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DZSUM1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dzsum1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dzsum1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dzsum1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 CX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DZSUM1 takes the sum of the absolute values of a complex
-*> vector and returns a double precision result.
-*>
-*> Based on DZASUM from the Level 1 BLAS.
-*> The change is to use the 'genuine' absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements in the vector CX.
-*> \endverbatim
-*>
-*> \param[in] CX
-*> \verbatim
-*> CX is COMPLEX*16 array, dimension (N)
-*> The vector whose elements will be summed.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive values of CX. INCX > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complex16OTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham for use with ZLACON.
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 CX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, NINCX
- DOUBLE PRECISION STEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- DZSUM1 = 0.0D0
- STEMP = 0.0D0
- IF( N.LE.0 )
- $ RETURN
- IF( INCX.EQ.1 )
- $ GO TO 20
-*
-* CODE FOR INCREMENT NOT EQUAL TO 1
-*
- NINCX = N*INCX
- DO 10 I = 1, NINCX, INCX
-*
-* NEXT LINE MODIFIED.
-*
- STEMP = STEMP + ABS( CX( I ) )
- 10 CONTINUE
- DZSUM1 = STEMP
- RETURN
-*
-* CODE FOR INCREMENT EQUAL TO 1
-*
- 20 CONTINUE
- DO 30 I = 1, N
-*
-* NEXT LINE MODIFIED.
-*
- STEMP = STEMP + ABS( CX( I ) )
- 30 CONTINUE
- DZSUM1 = STEMP
- RETURN
-*
-* End of DZSUM1
-*
- END
diff --git a/netlib/LAPACK/icmax1.f b/netlib/LAPACK/icmax1.f
deleted file mode 100644
index f312a2d..0000000
--- a/netlib/LAPACK/icmax1.f
+++ /dev/null
@@ -1,154 +0,0 @@
-*> \brief \b ICMAX1 finds the index of the vector element whose real part has maximum absolute value.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ICMAX1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/icmax1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/icmax1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/icmax1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ICMAX1( N, CX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX CX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ICMAX1 finds the index of the element whose real part has maximum
-*> absolute value.
-*>
-*> Based on ICAMAX from Level 1 BLAS.
-*> The change is to use the 'genuine' absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements in the vector CX.
-*> \endverbatim
-*>
-*> \param[in] CX
-*> \verbatim
-*> CX is COMPLEX array, dimension (N)
-*> The vector whose elements will be summed.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive values of CX. INCX >= 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complexOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham for use with CLACON.
-*
-* =====================================================================
- INTEGER FUNCTION ICMAX1( N, CX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX CX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IX
- REAL SMAX
- COMPLEX ZDUM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Statement Functions ..
- REAL CABS1
-* ..
-* .. Statement Function definitions ..
-*
-* NEXT LINE IS THE ONLY MODIFICATION.
- CABS1( ZDUM ) = ABS( ZDUM )
-* ..
-* .. Executable Statements ..
-*
- ICMAX1 = 0
- IF( N.LT.1 )
- $ RETURN
- ICMAX1 = 1
- IF( N.EQ.1 )
- $ RETURN
- IF( INCX.EQ.1 )
- $ GO TO 30
-*
-* CODE FOR INCREMENT NOT EQUAL TO 1
-*
- IX = 1
- SMAX = CABS1( CX( 1 ) )
- IX = IX + INCX
- DO 20 I = 2, N
- IF( CABS1( CX( IX ) ).LE.SMAX )
- $ GO TO 10
- ICMAX1 = I
- SMAX = CABS1( CX( IX ) )
- 10 CONTINUE
- IX = IX + INCX
- 20 CONTINUE
- RETURN
-*
-* CODE FOR INCREMENT EQUAL TO 1
-*
- 30 CONTINUE
- SMAX = CABS1( CX( 1 ) )
- DO 40 I = 2, N
- IF( CABS1( CX( I ) ).LE.SMAX )
- $ GO TO 40
- ICMAX1 = I
- SMAX = CABS1( CX( I ) )
- 40 CONTINUE
- RETURN
-*
-* End of ICMAX1
-*
- END
diff --git a/netlib/LAPACK/ieeeck.f b/netlib/LAPACK/ieeeck.f
deleted file mode 100644
index 132e436..0000000
--- a/netlib/LAPACK/ieeeck.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b IEEECK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download IEEECK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ieeeck.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ieeeck.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ieeeck.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
-*
-* .. Scalar Arguments ..
-* INTEGER ISPEC
-* REAL ONE, ZERO
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> IEEECK is called from the ILAENV to verify that Infinity and
-*> possibly NaN arithmetic is safe (i.e. will not trap).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ISPEC
-*> \verbatim
-*> ISPEC is INTEGER
-*> Specifies whether to test just for inifinity arithmetic
-*> or whether to test for infinity and NaN arithmetic.
-*> = 0: Verify infinity arithmetic only.
-*> = 1: Verify infinity and NaN arithmetic.
-*> \endverbatim
-*>
-*> \param[in] ZERO
-*> \verbatim
-*> ZERO is REAL
-*> Must contain the value 0.0
-*> This is passed to prevent the compiler from optimizing
-*> away this code.
-*> \endverbatim
-*>
-*> \param[in] ONE
-*> \verbatim
-*> ONE is REAL
-*> Must contain the value 1.0
-*> This is passed to prevent the compiler from optimizing
-*> away this code.
-*>
-*> RETURN VALUE: INTEGER
-*> = 0: Arithmetic failed to produce the correct answers
-*> = 1: Arithmetic produced the correct answers
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER ISPEC
- REAL ONE, ZERO
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
- $ NEGZRO, NEWZRO, POSINF
-* ..
-* .. Executable Statements ..
- IEEECK = 1
-*
- POSINF = ONE / ZERO
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = -ONE / ZERO
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGZRO = ONE / ( NEGINF+ONE )
- IF( NEGZRO.NE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = ONE / NEGZRO
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEWZRO = NEGZRO + ZERO
- IF( NEWZRO.NE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- POSINF = ONE / NEWZRO
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = NEGINF*POSINF
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- POSINF = POSINF*POSINF
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
-*
-*
-*
-* Return if we were only asked to check infinity arithmetic
-*
- IF( ISPEC.EQ.0 )
- $ RETURN
-*
- NAN1 = POSINF + NEGINF
-*
- NAN2 = POSINF / NEGINF
-*
- NAN3 = POSINF / POSINF
-*
- NAN4 = POSINF*ZERO
-*
- NAN5 = NEGINF*NEGZRO
-*
- NAN6 = NAN5*ZERO
-*
- IF( NAN1.EQ.NAN1 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN2.EQ.NAN2 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN3.EQ.NAN3 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN4.EQ.NAN4 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN5.EQ.NAN5 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN6.EQ.NAN6 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- RETURN
- END
diff --git a/netlib/LAPACK/ilaclc.f b/netlib/LAPACK/ilaclc.f
deleted file mode 100644
index 4bd639d..0000000
--- a/netlib/LAPACK/ilaclc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILACLC scans a matrix for its last non-zero column.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILACLC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaclc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaclc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaclc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILACLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILACLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complexOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILACLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX ZERO
- PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILACLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILACLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILACLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILACLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/ilaclr.f b/netlib/LAPACK/ilaclr.f
deleted file mode 100644
index 617d670..0000000
--- a/netlib/LAPACK/ilaclr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILACLR scans a matrix for its last non-zero row.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILACLR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaclr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaclr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaclr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILACLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILACLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complexOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILACLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX ZERO
- PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILACLR = M
- ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILACLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILACLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILACLR = MAX( ILACLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/iladiag.f b/netlib/LAPACK/iladiag.f
deleted file mode 100644
index 1d5c5bf..0000000
--- a/netlib/LAPACK/iladiag.f
+++ /dev/null
@@ -1,92 +0,0 @@
-*> \brief \b ILADIAG
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILADIAG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladiag.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladiag.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladiag.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILADIAG( DIAG )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine translated from a character string specifying if a
-*> matrix has unit diagonal or not to the relevant BLAST-specified
-*> integer constant.
-*>
-*> ILADIAG returns an INTEGER. If ILADIAG < 0, then the input is not a
-*> character indicating a unit or non-unit diagonal. Otherwise ILADIAG
-*> returns the constant value corresponding to DIAG.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILADIAG( DIAG )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_NON_UNIT_DIAG, BLAS_UNIT_DIAG
- PARAMETER ( BLAS_NON_UNIT_DIAG = 131, BLAS_UNIT_DIAG = 132 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( DIAG, 'N' ) ) THEN
- ILADIAG = BLAS_NON_UNIT_DIAG
- ELSE IF( LSAME( DIAG, 'U' ) ) THEN
- ILADIAG = BLAS_UNIT_DIAG
- ELSE
- ILADIAG = -1
- END IF
- RETURN
-*
-* End of ILADIAG
-*
- END
diff --git a/netlib/LAPACK/iladlc.f b/netlib/LAPACK/iladlc.f
deleted file mode 100644
index b56387d..0000000
--- a/netlib/LAPACK/iladlc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILADLC scans a matrix for its last non-zero column.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILADLC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILADLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILADLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILADLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILADLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILADLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILADLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILADLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/iladlr.f b/netlib/LAPACK/iladlr.f
deleted file mode 100644
index fe155af..0000000
--- a/netlib/LAPACK/iladlr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILADLR scans a matrix for its last non-zero row.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILADLR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILADLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILADLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILADLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILADLR = M
- ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILADLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILADLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILADLR = MAX( ILADLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/ilaenv.f b/netlib/LAPACK/ilaenv.f
deleted file mode 100644
index 867464d..0000000
--- a/netlib/LAPACK/ilaenv.f
+++ /dev/null
@@ -1,624 +0,0 @@
-*> \brief \b ILAENV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAENV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaenv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaenv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaenv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-*
-* .. Scalar Arguments ..
-* CHARACTER*( * ) NAME, OPTS
-* INTEGER ISPEC, N1, N2, N3, N4
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILAENV is called from the LAPACK routines to choose problem-dependent
-*> parameters for the local environment. See ISPEC for a description of
-*> the parameters.
-*>
-*> ILAENV returns an INTEGER
-*> if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC
-*> if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value.
-*>
-*> This version provides a set of parameters which should give good,
-*> but not optimal, performance on many of the currently available
-*> computers. Users are encouraged to modify this subroutine to set
-*> the tuning parameters for their particular machine using the option
-*> and problem size information in the arguments.
-*>
-*> This routine will not function correctly if it is converted to all
-*> lower case. Converting it to all upper case is allowed.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ISPEC
-*> \verbatim
-*> ISPEC is INTEGER
-*> Specifies the parameter to be returned as the value of
-*> ILAENV.
-*> = 1: the optimal blocksize; if this value is 1, an unblocked
-*> algorithm will give the best performance.
-*> = 2: the minimum block size for which the block routine
-*> should be used; if the usable block size is less than
-*> this value, an unblocked routine should be used.
-*> = 3: the crossover point (in a block routine, for N less
-*> than this value, an unblocked routine should be used)
-*> = 4: the number of shifts, used in the nonsymmetric
-*> eigenvalue routines (DEPRECATED)
-*> = 5: the minimum column dimension for blocking to be used;
-*> rectangular blocks must have dimension at least k by m,
-*> where k is given by ILAENV(2,...) and m by ILAENV(5,...)
-*> = 6: the crossover point for the SVD (when reducing an m by n
-*> matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
-*> this value, a QR factorization is used first to reduce
-*> the matrix to a triangular form.)
-*> = 7: the number of processors
-*> = 8: the crossover point for the multishift QR method
-*> for nonsymmetric eigenvalue problems (DEPRECATED)
-*> = 9: maximum size of the subproblems at the bottom of the
-*> computation tree in the divide-and-conquer algorithm
-*> (used by xGELSD and xGESDD)
-*> =10: ieee NaN arithmetic can be trusted not to trap
-*> =11: infinity arithmetic can be trusted not to trap
-*> 12 <= ISPEC <= 16:
-*> xHSEQR or one of its subroutines,
-*> see IPARMQ for detailed explanation
-*> \endverbatim
-*>
-*> \param[in] NAME
-*> \verbatim
-*> NAME is CHARACTER*(*)
-*> The name of the calling subroutine, in either upper case or
-*> lower case.
-*> \endverbatim
-*>
-*> \param[in] OPTS
-*> \verbatim
-*> OPTS is CHARACTER*(*)
-*> The character options to the subroutine NAME, concatenated
-*> into a single character string. For example, UPLO = 'U',
-*> TRANS = 'T', and DIAG = 'N' for a triangular routine would
-*> be specified as OPTS = 'UTN'.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N3
-*> \verbatim
-*> N3 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N4
-*> \verbatim
-*> N4 is INTEGER
-*> Problem dimensions for the subroutine NAME; these may not all
-*> be required.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The following conventions have been used when calling ILAENV from the
-*> LAPACK routines:
-*> 1) OPTS is a concatenation of all of the character options to
-*> subroutine NAME, in the same order that they appear in the
-*> argument list for NAME, even if they are not used in determining
-*> the value of the parameter specified by ISPEC.
-*> 2) The problem dimensions N1, N2, N3, N4 are specified in the order
-*> that they appear in the argument list for NAME. N1 is used
-*> first, N2 second, and so on, and unused problem dimensions are
-*> passed a value of -1.
-*> 3) The parameter value returned by ILAENV is checked for validity in
-*> the calling subroutine. For example, ILAENV is used to retrieve
-*> the optimal blocksize for STRTRI as follows:
-*>
-*> NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
-*> IF( NB.LE.1 ) NB = MAX( 1, N )
-*> \endverbatim
-*>
-* =====================================================================
- INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER*( * ) NAME, OPTS
- INTEGER ISPEC, N1, N2, N3, N4
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IC, IZ, NB, NBMIN, NX
- LOGICAL CNAME, SNAME
- CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*6
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC CHAR, ICHAR, INT, MIN, REAL
-* ..
-* .. External Functions ..
- INTEGER IEEECK, IPARMQ
- EXTERNAL IEEECK, IPARMQ
-* ..
-* .. Executable Statements ..
-*
- GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
- $ 130, 140, 150, 160, 160, 160, 160, 160 )ISPEC
-*
-* Invalid value for ISPEC
-*
- ILAENV = -1
- RETURN
-*
- 10 CONTINUE
-*
-* Convert NAME to upper case if the first character is lower case.
-*
- ILAENV = 1
- SUBNAM = NAME
- IC = ICHAR( SUBNAM( 1: 1 ) )
- IZ = ICHAR( 'Z' )
- IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
-*
-* ASCII character set
-*
- IF( IC.GE.97 .AND. IC.LE.122 ) THEN
- SUBNAM( 1: 1 ) = CHAR( IC-32 )
- DO 20 I = 2, 6
- IC = ICHAR( SUBNAM( I: I ) )
- IF( IC.GE.97 .AND. IC.LE.122 )
- $ SUBNAM( I: I ) = CHAR( IC-32 )
- 20 CONTINUE
- END IF
-*
- ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
-*
-* EBCDIC character set
-*
- IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
- $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
- $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
- SUBNAM( 1: 1 ) = CHAR( IC+64 )
- DO 30 I = 2, 6
- IC = ICHAR( SUBNAM( I: I ) )
- IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
- $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
- $ ( IC.GE.162 .AND. IC.LE.169 ) )SUBNAM( I:
- $ I ) = CHAR( IC+64 )
- 30 CONTINUE
- END IF
-*
- ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
-*
-* Prime machines: ASCII+128
-*
- IF( IC.GE.225 .AND. IC.LE.250 ) THEN
- SUBNAM( 1: 1 ) = CHAR( IC-32 )
- DO 40 I = 2, 6
- IC = ICHAR( SUBNAM( I: I ) )
- IF( IC.GE.225 .AND. IC.LE.250 )
- $ SUBNAM( I: I ) = CHAR( IC-32 )
- 40 CONTINUE
- END IF
- END IF
-*
- C1 = SUBNAM( 1: 1 )
- SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
- CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
- IF( .NOT.( CNAME .OR. SNAME ) )
- $ RETURN
- C2 = SUBNAM( 2: 3 )
- C3 = SUBNAM( 4: 6 )
- C4 = C3( 2: 3 )
-*
- GO TO ( 50, 60, 70 )ISPEC
-*
- 50 CONTINUE
-*
-* ISPEC = 1: block size
-*
-* In these examples, separate code is provided for setting NB for
-* real and complex. We assume that NB will take the same value in
-* single or double precision.
-*
- NB = 1
-*
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
- $ C3.EQ.'QLF' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'PO' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NB = 32
- ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
- NB = 64
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- NB = 64
- ELSE IF( C3.EQ.'TRD' ) THEN
- NB = 32
- ELSE IF( C3.EQ.'GST' ) THEN
- NB = 64
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- END IF
- ELSE IF( C2.EQ.'GB' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- IF( N4.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- ELSE
- IF( N4.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- END IF
- END IF
- ELSE IF( C2.EQ.'PB' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- IF( N2.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- ELSE
- IF( N2.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- END IF
- END IF
- ELSE IF( C2.EQ.'TR' ) THEN
- IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'LA' ) THEN
- IF( C3.EQ.'UUM' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
- IF( C3.EQ.'EBZ' ) THEN
- NB = 1
- END IF
- END IF
- ILAENV = NB
- RETURN
-*
- 60 CONTINUE
-*
-* ISPEC = 2: minimum block size
-*
- NBMIN = 2
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. C3.EQ.
- $ 'QLF' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NBMIN = 8
- ELSE
- NBMIN = 8
- END IF
- ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRD' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- END IF
- END IF
- ILAENV = NBMIN
- RETURN
-*
- 70 CONTINUE
-*
-* ISPEC = 3: crossover point
-*
- NX = 0
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. C3.EQ.
- $ 'QLF' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NX = 32
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRD' ) THEN
- NX = 32
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NX = 128
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NX = 128
- END IF
- END IF
- END IF
- ILAENV = NX
- RETURN
-*
- 80 CONTINUE
-*
-* ISPEC = 4: number of shifts (used by xHSEQR)
-*
- ILAENV = 6
- RETURN
-*
- 90 CONTINUE
-*
-* ISPEC = 5: minimum column dimension (not used)
-*
- ILAENV = 2
- RETURN
-*
- 100 CONTINUE
-*
-* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
-*
- ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
- RETURN
-*
- 110 CONTINUE
-*
-* ISPEC = 7: number of processors (not used)
-*
- ILAENV = 1
- RETURN
-*
- 120 CONTINUE
-*
-* ISPEC = 8: crossover point for multishift (used by xHSEQR)
-*
- ILAENV = 50
- RETURN
-*
- 130 CONTINUE
-*
-* ISPEC = 9: maximum size of the subproblems at the bottom of the
-* computation tree in the divide-and-conquer algorithm
-* (used by xGELSD and xGESDD)
-*
- ILAENV = 25
- RETURN
-*
- 140 CONTINUE
-*
-* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
-*
-* ILAENV = 0
- ILAENV = 1
- IF( ILAENV.EQ.1 ) THEN
- ILAENV = IEEECK( 1, 0.0, 1.0 )
- END IF
- RETURN
-*
- 150 CONTINUE
-*
-* ISPEC = 11: infinity arithmetic can be trusted not to trap
-*
-* ILAENV = 0
- ILAENV = 1
- IF( ILAENV.EQ.1 ) THEN
- ILAENV = IEEECK( 0, 0.0, 1.0 )
- END IF
- RETURN
-*
- 160 CONTINUE
-*
-* 12 <= ISPEC <= 16: xHSEQR or one of its subroutines.
-*
- ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
- RETURN
-*
-* End of ILAENV
-*
- END
diff --git a/netlib/LAPACK/ilaprec.f b/netlib/LAPACK/ilaprec.f
deleted file mode 100644
index 88ae77e..0000000
--- a/netlib/LAPACK/ilaprec.f
+++ /dev/null
@@ -1,98 +0,0 @@
-*> \brief \b ILAPREC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAPREC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaprec.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaprec.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaprec.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAPREC( PREC )
-*
-* .. Scalar Arguments ..
-* CHARACTER PREC
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine translated from a character string specifying an
-*> intermediate precision to the relevant BLAST-specified integer
-*> constant.
-*>
-*> ILAPREC returns an INTEGER. If ILAPREC < 0, then the input is not a
-*> character indicating a supported intermediate precision. Otherwise
-*> ILAPREC returns the constant value corresponding to PREC.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILAPREC( PREC )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER PREC
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_PREC_SINGLE, BLAS_PREC_DOUBLE, BLAS_PREC_INDIGENOUS,
- $ BLAS_PREC_EXTRA
- PARAMETER ( BLAS_PREC_SINGLE = 211, BLAS_PREC_DOUBLE = 212,
- $ BLAS_PREC_INDIGENOUS = 213, BLAS_PREC_EXTRA = 214 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( PREC, 'S' ) ) THEN
- ILAPREC = BLAS_PREC_SINGLE
- ELSE IF( LSAME( PREC, 'D' ) ) THEN
- ILAPREC = BLAS_PREC_DOUBLE
- ELSE IF( LSAME( PREC, 'I' ) ) THEN
- ILAPREC = BLAS_PREC_INDIGENOUS
- ELSE IF( LSAME( PREC, 'X' ) .OR. LSAME( PREC, 'E' ) ) THEN
- ILAPREC = BLAS_PREC_EXTRA
- ELSE
- ILAPREC = -1
- END IF
- RETURN
-*
-* End of ILAPREC
-*
- END
diff --git a/netlib/LAPACK/ilaslc.f b/netlib/LAPACK/ilaslc.f
deleted file mode 100644
index e1dc426..0000000
--- a/netlib/LAPACK/ilaslc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILASLC scans a matrix for its last non-zero column.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILASLC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILASLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILASLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILASLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILASLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILASLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILASLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILASLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/ilaslr.f b/netlib/LAPACK/ilaslr.f
deleted file mode 100644
index 9436dc4..0000000
--- a/netlib/LAPACK/ilaslr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILASLR scans a matrix for its last non-zero row.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILASLR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILASLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILASLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILASLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILASLR = M
- ELSEIF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILASLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILASLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILASLR = MAX( ILASLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/ilatrans.f b/netlib/LAPACK/ilatrans.f
deleted file mode 100644
index d8fc9bc..0000000
--- a/netlib/LAPACK/ilatrans.f
+++ /dev/null
@@ -1,95 +0,0 @@
-*> \brief \b ILATRANS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILATRANS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilatrans.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilatrans.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilatrans.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILATRANS( TRANS )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine translates from a character string specifying a
-*> transposition operation to the relevant BLAST-specified integer
-*> constant.
-*>
-*> ILATRANS returns an INTEGER. If ILATRANS < 0, then the input is not
-*> a character indicating a transposition operator. Otherwise ILATRANS
-*> returns the constant value corresponding to TRANS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILATRANS( TRANS )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_NO_TRANS, BLAS_TRANS, BLAS_CONJ_TRANS
- PARAMETER ( BLAS_NO_TRANS = 111, BLAS_TRANS = 112,
- $ BLAS_CONJ_TRANS = 113 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( TRANS, 'N' ) ) THEN
- ILATRANS = BLAS_NO_TRANS
- ELSE IF( LSAME( TRANS, 'T' ) ) THEN
- ILATRANS = BLAS_TRANS
- ELSE IF( LSAME( TRANS, 'C' ) ) THEN
- ILATRANS = BLAS_CONJ_TRANS
- ELSE
- ILATRANS = -1
- END IF
- RETURN
-*
-* End of ILATRANS
-*
- END
diff --git a/netlib/LAPACK/ilauplo.f b/netlib/LAPACK/ilauplo.f
deleted file mode 100644
index e65c103..0000000
--- a/netlib/LAPACK/ilauplo.f
+++ /dev/null
@@ -1,92 +0,0 @@
-*> \brief \b ILAUPLO
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAUPLO + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilauplo.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilauplo.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilauplo.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAUPLO( UPLO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine translated from a character string specifying a
-*> upper- or lower-triangular matrix to the relevant BLAST-specified
-*> integer constant.
-*>
-*> ILAUPLO returns an INTEGER. If ILAUPLO < 0, then the input is not
-*> a character indicating an upper- or lower-triangular matrix.
-*> Otherwise ILAUPLO returns the constant value corresponding to UPLO.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILAUPLO( UPLO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_UPPER, BLAS_LOWER
- PARAMETER ( BLAS_UPPER = 121, BLAS_LOWER = 122 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( UPLO, 'U' ) ) THEN
- ILAUPLO = BLAS_UPPER
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
- ILAUPLO = BLAS_LOWER
- ELSE
- ILAUPLO = -1
- END IF
- RETURN
-*
-* End of ILAUPLO
-*
- END
diff --git a/netlib/LAPACK/ilaver.f b/netlib/LAPACK/ilaver.f
deleted file mode 100644
index a00cbbc..0000000
--- a/netlib/LAPACK/ilaver.f
+++ /dev/null
@@ -1,66 +0,0 @@
-*> \brief \b ILAVER returns the LAPACK version.
-**
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
-*
-* INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine returns the LAPACK version.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[out] VERS_MAJOR
-*> return the lapack major version
-*>
-*> \param[out] VERS_MINOR
-*> return the lapack minor version from the major version
-*>
-*> \param[out] VERS_PATCH
-*> return the lapack patch version from the minor version
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* =====================================================================
-*
- INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
-* =====================================================================
- VERS_MAJOR = 3
- VERS_MINOR = 4
- VERS_PATCH = 2
-* =====================================================================
-*
- RETURN
- END
diff --git a/netlib/LAPACK/ilazlc.f b/netlib/LAPACK/ilazlc.f
deleted file mode 100644
index 718b277..0000000
--- a/netlib/LAPACK/ilazlc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILAZLC scans a matrix for its last non-zero column.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAZLC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAZLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILAZLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complex16OTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILAZLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILAZLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILAZLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILAZLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILAZLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/ilazlr.f b/netlib/LAPACK/ilazlr.f
deleted file mode 100644
index 4469721..0000000
--- a/netlib/LAPACK/ilazlr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILAZLR scans a matrix for its last non-zero row.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAZLR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAZLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILAZLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complex16OTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILAZLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILAZLR = M
- ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILAZLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILAZLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILAZLR = MAX( ILAZLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/netlib/LAPACK/iparmq.f b/netlib/LAPACK/iparmq.f
deleted file mode 100644
index bd5bd7a..0000000
--- a/netlib/LAPACK/iparmq.f
+++ /dev/null
@@ -1,322 +0,0 @@
-*> \brief \b IPARMQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download IPARMQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iparmq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iparmq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iparmq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, ISPEC, LWORK, N
-* CHARACTER NAME*( * ), OPTS*( * )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This program sets problem and machine dependent parameters
-*> useful for xHSEQR and its subroutines. It is called whenever
-*> ILAENV is called with 12 <= ISPEC <= 16
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ISPEC
-*> \verbatim
-*> ISPEC is integer scalar
-*> ISPEC specifies which tunable parameter IPARMQ should
-*> return.
-*>
-*> ISPEC=12: (INMIN) Matrices of order nmin or less
-*> are sent directly to xLAHQR, the implicit
-*> double shift QR algorithm. NMIN must be
-*> at least 11.
-*>
-*> ISPEC=13: (INWIN) Size of the deflation window.
-*> This is best set greater than or equal to
-*> the number of simultaneous shifts NS.
-*> Larger matrices benefit from larger deflation
-*> windows.
-*>
-*> ISPEC=14: (INIBL) Determines when to stop nibbling and
-*> invest in an (expensive) multi-shift QR sweep.
-*> If the aggressive early deflation subroutine
-*> finds LD converged eigenvalues from an order
-*> NW deflation window and LD.GT.(NW*NIBBLE)/100,
-*> then the next QR sweep is skipped and early
-*> deflation is applied immediately to the
-*> remaining active diagonal block. Setting
-*> IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
-*> multi-shift QR sweep whenever early deflation
-*> finds a converged eigenvalue. Setting
-*> IPARMQ(ISPEC=14) greater than or equal to 100
-*> prevents TTQRE from skipping a multi-shift
-*> QR sweep.
-*>
-*> ISPEC=15: (NSHFTS) The number of simultaneous shifts in
-*> a multi-shift QR iteration.
-*>
-*> ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
-*> following meanings.
-*> 0: During the multi-shift QR sweep,
-*> xLAQR5 does not accumulate reflections and
-*> does not use matrix-matrix multiply to
-*> update the far-from-diagonal matrix
-*> entries.
-*> 1: During the multi-shift QR sweep,
-*> xLAQR5 and/or xLAQRaccumulates reflections and uses
-*> matrix-matrix multiply to update the
-*> far-from-diagonal matrix entries.
-*> 2: During the multi-shift QR sweep.
-*> xLAQR5 accumulates reflections and takes
-*> advantage of 2-by-2 block structure during
-*> matrix-matrix multiplies.
-*> (If xTRMM is slower than xGEMM, then
-*> IPARMQ(ISPEC=16)=1 may be more efficient than
-*> IPARMQ(ISPEC=16)=2 despite the greater level of
-*> arithmetic work implied by the latter choice.)
-*> \endverbatim
-*>
-*> \param[in] NAME
-*> \verbatim
-*> NAME is character string
-*> Name of the calling subroutine
-*> \endverbatim
-*>
-*> \param[in] OPTS
-*> \verbatim
-*> OPTS is character string
-*> This is a concatenation of the string arguments to
-*> TTQRE.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is integer scalar
-*> N is the order of the Hessenberg matrix H.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular
-*> in rows and columns 1:ILO-1 and IHI+1:N.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer scalar
-*> The amount of workspace available.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Little is known about how best to choose these parameters.
-*> It is possible to use different values of the parameters
-*> for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
-*>
-*> It is probably best to choose different parameters for
-*> different matrices and different parameters at different
-*> times during the iteration, but this has not been
-*> implemented --- yet.
-*>
-*>
-*> The best choices of most of the parameters depend
-*> in an ill-understood way on the relative execution
-*> rate of xLAQR3 and xLAQR5 and on the nature of each
-*> particular eigenvalue problem. Experiment may be the
-*> only practical way to determine which choices are most
-*> effective.
-*>
-*> Following is a list of default values supplied by IPARMQ.
-*> These defaults may be adjusted in order to attain better
-*> performance in any particular computational environment.
-*>
-*> IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
-*> Default: 75. (Must be at least 11.)
-*>
-*> IPARMQ(ISPEC=13) Recommended deflation window size.
-*> This depends on ILO, IHI and NS, the
-*> number of simultaneous shifts returned
-*> by IPARMQ(ISPEC=15). The default for
-*> (IHI-ILO+1).LE.500 is NS. The default
-*> for (IHI-ILO+1).GT.500 is 3*NS/2.
-*>
-*> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14.
-*>
-*> IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
-*> a multi-shift QR iteration.
-*>
-*> If IHI-ILO+1 is ...
-*>
-*> greater than ...but less ... the
-*> or equal to ... than default is
-*>
-*> 0 30 NS = 2+
-*> 30 60 NS = 4+
-*> 60 150 NS = 10
-*> 150 590 NS = **
-*> 590 3000 NS = 64
-*> 3000 6000 NS = 128
-*> 6000 infinity NS = 256
-*>
-*> (+) By default matrices of this order are
-*> passed to the implicit double shift routine
-*> xLAHQR. See IPARMQ(ISPEC=12) above. These
-*> values of NS are used only in case of a rare
-*> xLAHQR failure.
-*>
-*> (**) The asterisks (**) indicate an ad-hoc
-*> function increasing from 10 to 64.
-*>
-*> IPARMQ(ISPEC=16) Select structured matrix multiply.
-*> (See ISPEC=16 above for details.)
-*> Default: 3.
-*> \endverbatim
-*>
-* =====================================================================
- INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, ISPEC, LWORK, N
- CHARACTER NAME*( * ), OPTS*( * )
-*
-* ================================================================
-* .. Parameters ..
- INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22
- PARAMETER ( INMIN = 12, INWIN = 13, INIBL = 14,
- $ ISHFTS = 15, IACC22 = 16 )
- INTEGER NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP
- PARAMETER ( NMIN = 75, K22MIN = 14, KACMIN = 14,
- $ NIBBLE = 14, KNWSWP = 500 )
- REAL TWO
- PARAMETER ( TWO = 2.0 )
-* ..
-* .. Local Scalars ..
- INTEGER NH, NS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC LOG, MAX, MOD, NINT, REAL
-* ..
-* .. Executable Statements ..
- IF( ( ISPEC.EQ.ISHFTS ) .OR. ( ISPEC.EQ.INWIN ) .OR.
- $ ( ISPEC.EQ.IACC22 ) ) THEN
-*
-* ==== Set the number simultaneous shifts ====
-*
- NH = IHI - ILO + 1
- NS = 2
- IF( NH.GE.30 )
- $ NS = 4
- IF( NH.GE.60 )
- $ NS = 10
- IF( NH.GE.150 )
- $ NS = MAX( 10, NH / NINT( LOG( REAL( NH ) ) / LOG( TWO ) ) )
- IF( NH.GE.590 )
- $ NS = 64
- IF( NH.GE.3000 )
- $ NS = 128
- IF( NH.GE.6000 )
- $ NS = 256
- NS = MAX( 2, NS-MOD( NS, 2 ) )
- END IF
-*
- IF( ISPEC.EQ.INMIN ) THEN
-*
-*
-* ===== Matrices of order smaller than NMIN get sent
-* . to xLAHQR, the classic double shift algorithm.
-* . This must be at least 11. ====
-*
- IPARMQ = NMIN
-*
- ELSE IF( ISPEC.EQ.INIBL ) THEN
-*
-* ==== INIBL: skip a multi-shift qr iteration and
-* . whenever aggressive early deflation finds
-* . at least (NIBBLE*(window size)/100) deflations. ====
-*
- IPARMQ = NIBBLE
-*
- ELSE IF( ISPEC.EQ.ISHFTS ) THEN
-*
-* ==== NSHFTS: The number of simultaneous shifts =====
-*
- IPARMQ = NS
-*
- ELSE IF( ISPEC.EQ.INWIN ) THEN
-*
-* ==== NW: deflation window size. ====
-*
- IF( NH.LE.KNWSWP ) THEN
- IPARMQ = NS
- ELSE
- IPARMQ = 3*NS / 2
- END IF
-*
- ELSE IF( ISPEC.EQ.IACC22 ) THEN
-*
-* ==== IACC22: Whether to accumulate reflections
-* . before updating the far-from-diagonal elements
-* . and whether to use 2-by-2 block structure while
-* . doing it. A small amount of work could be saved
-* . by making this choice dependent also upon the
-* . NH=IHI-ILO+1.
-*
- IPARMQ = 0
- IF( NS.GE.KACMIN )
- $ IPARMQ = 1
- IF( NS.GE.K22MIN )
- $ IPARMQ = 2
-*
- ELSE
-* ===== invalid value of ispec =====
- IPARMQ = -1
-*
- END IF
-*
-* ==== End of IPARMQ ====
-*
- END
diff --git a/netlib/LAPACK/izmax1.f b/netlib/LAPACK/izmax1.f
deleted file mode 100644
index 3f48c34..0000000
--- a/netlib/LAPACK/izmax1.f
+++ /dev/null
@@ -1,154 +0,0 @@
-*> \brief \b IZMAX1 finds the index of the vector element whose real part has maximum absolute value.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download IZMAX1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/izmax1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/izmax1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/izmax1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IZMAX1( N, CX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 CX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> IZMAX1 finds the index of the element whose real part has maximum
-*> absolute value.
-*>
-*> Based on IZAMAX from Level 1 BLAS.
-*> The change is to use the 'genuine' absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements in the vector CX.
-*> \endverbatim
-*>
-*> \param[in] CX
-*> \verbatim
-*> CX is COMPLEX*16 array, dimension (N)
-*> The vector whose elements will be summed.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive values of CX. INCX >= 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complex16OTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham for use with ZLACON.
-*
-* =====================================================================
- INTEGER FUNCTION IZMAX1( N, CX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 CX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IX
- DOUBLE PRECISION SMAX
- COMPLEX*16 ZDUM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Statement Functions ..
- DOUBLE PRECISION CABS1
-* ..
-* .. Statement Function definitions ..
-*
-* NEXT LINE IS THE ONLY MODIFICATION.
- CABS1( ZDUM ) = ABS( ZDUM )
-* ..
-* .. Executable Statements ..
-*
- IZMAX1 = 0
- IF( N.LT.1 )
- $ RETURN
- IZMAX1 = 1
- IF( N.EQ.1 )
- $ RETURN
- IF( INCX.EQ.1 )
- $ GO TO 30
-*
-* CODE FOR INCREMENT NOT EQUAL TO 1
-*
- IX = 1
- SMAX = CABS1( CX( 1 ) )
- IX = IX + INCX
- DO 20 I = 2, N
- IF( CABS1( CX( IX ) ).LE.SMAX )
- $ GO TO 10
- IZMAX1 = I
- SMAX = CABS1( CX( IX ) )
- 10 CONTINUE
- IX = IX + INCX
- 20 CONTINUE
- RETURN
-*
-* CODE FOR INCREMENT EQUAL TO 1
-*
- 30 CONTINUE
- SMAX = CABS1( CX( 1 ) )
- DO 40 I = 2, N
- IF( CABS1( CX( I ) ).LE.SMAX )
- $ GO TO 40
- IZMAX1 = I
- SMAX = CABS1( CX( I ) )
- 40 CONTINUE
- RETURN
-*
-* End of IZMAX1
-*
- END
diff --git a/netlib/LAPACK/lsamen.f b/netlib/LAPACK/lsamen.f
deleted file mode 100644
index e14d96b..0000000
--- a/netlib/LAPACK/lsamen.f
+++ /dev/null
@@ -1,122 +0,0 @@
-*> \brief \b LSAMEN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download LSAMEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/lsamen.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/lsamen.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/lsamen.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION LSAMEN( N, CA, CB )
-*
-* .. Scalar Arguments ..
-* CHARACTER*( * ) CA, CB
-* INTEGER N
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> LSAMEN tests if the first N letters of CA are the same as the
-*> first N letters of CB, regardless of case.
-*> LSAMEN returns .TRUE. if CA and CB are equivalent except for case
-*> and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA )
-*> or LEN( CB ) is less than N.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of characters in CA and CB to be compared.
-*> \endverbatim
-*>
-*> \param[in] CA
-*> \verbatim
-*> CA is CHARACTER*(*)
-*> \endverbatim
-*>
-*> \param[in] CB
-*> \verbatim
-*> CB is CHARACTER*(*)
-*> CA and CB specify two character strings of length at least N.
-*> Only the first N characters of each string will be accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION LSAMEN( N, CA, CB )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER*( * ) CA, CB
- INTEGER N
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC LEN
-* ..
-* .. Executable Statements ..
-*
- LSAMEN = .FALSE.
- IF( LEN( CA ).LT.N .OR. LEN( CB ).LT.N )
- $ GO TO 20
-*
-* Do for each character in the two strings.
-*
- DO 10 I = 1, N
-*
-* Test if the characters are equal using LSAME.
-*
- IF( .NOT.LSAME( CA( I: I ), CB( I: I ) ) )
- $ GO TO 20
-*
- 10 CONTINUE
- LSAMEN = .TRUE.
-*
- 20 CONTINUE
- RETURN
-*
-* End of LSAMEN
-*
- END
diff --git a/netlib/LAPACK/sbbcsd.f b/netlib/LAPACK/sbbcsd.f
deleted file mode 100644
index 162d533..0000000
--- a/netlib/LAPACK/sbbcsd.f
+++ /dev/null
@@ -1,1077 +0,0 @@
-*> \brief \b SBBCSD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SBBCSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sbbcsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sbbcsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sbbcsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q,
-* THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T,
-* V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
-* B22D, B22E, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS
-* INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
-* REAL B11D( * ), B11E( * ), B12D( * ), B12E( * ),
-* $ B21D( * ), B21E( * ), B22D( * ), B22E( * ),
-* $ PHI( * ), THETA( * ), WORK( * )
-* REAL U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
-* $ V2T( LDV2T, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SBBCSD computes the CS decomposition of an orthogonal matrix in
-*> bidiagonal-block form,
-*>
-*>
-*> [ B11 | B12 0 0 ]
-*> [ 0 | 0 -I 0 ]
-*> X = [----------------]
-*> [ B21 | B22 0 0 ]
-*> [ 0 | 0 0 I ]
-*>
-*> [ C | -S 0 0 ]
-*> [ U1 | ] [ 0 | 0 -I 0 ] [ V1 | ]**T
-*> = [---------] [---------------] [---------] .
-*> [ | U2 ] [ S | C 0 0 ] [ | V2 ]
-*> [ 0 | 0 0 I ]
-*>
-*> X is M-by-M, its top-left block is P-by-Q, and Q must be no larger
-*> than P, M-P, or M-Q. (If Q is not the smallest index, then X must be
-*> transposed and/or permuted. This can be done in constant time using
-*> the TRANS and SIGNS options. See SORCSD for details.)
-*>
-*> The bidiagonal matrices B11, B12, B21, and B22 are represented
-*> implicitly by angles THETA(1:Q) and PHI(1:Q-1).
-*>
-*> The orthogonal matrices U1, U2, V1T, and V2T are input/output.
-*> The input matrices are pre- or post-multiplied by the appropriate
-*> singular vector matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU1
-*> \verbatim
-*> JOBU1 is CHARACTER
-*> = 'Y': U1 is updated;
-*> otherwise: U1 is not updated.
-*> \endverbatim
-*>
-*> \param[in] JOBU2
-*> \verbatim
-*> JOBU2 is CHARACTER
-*> = 'Y': U2 is updated;
-*> otherwise: U2 is not updated.
-*> \endverbatim
-*>
-*> \param[in] JOBV1T
-*> \verbatim
-*> JOBV1T is CHARACTER
-*> = 'Y': V1T is updated;
-*> otherwise: V1T is not updated.
-*> \endverbatim
-*>
-*> \param[in] JOBV2T
-*> \verbatim
-*> JOBV2T is CHARACTER
-*> = 'Y': V2T is updated;
-*> otherwise: V2T is not updated.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER
-*> = 'T': X, U1, U2, V1T, and V2T are stored in row-major
-*> order;
-*> otherwise: X, U1, U2, V1T, and V2T are stored in column-
-*> major order.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows and columns in X, the orthogonal matrix in
-*> bidiagonal-block form.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows in the top-left block of X. 0 <= P <= M.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is INTEGER
-*> The number of columns in the top-left block of X.
-*> 0 <= Q <= MIN(P,M-P,M-Q).
-*> \endverbatim
-*>
-*> \param[in,out] THETA
-*> \verbatim
-*> THETA is REAL array, dimension (Q)
-*> On entry, the angles THETA(1),...,THETA(Q) that, along with
-*> PHI(1), ...,PHI(Q-1), define the matrix in bidiagonal-block
-*> form. On exit, the angles whose cosines and sines define the
-*> diagonal blocks in the CS decomposition.
-*> \endverbatim
-*>
-*> \param[in,out] PHI
-*> \verbatim
-*> PHI is REAL array, dimension (Q-1)
-*> The angles PHI(1),...,PHI(Q-1) that, along with THETA(1),...,
-*> THETA(Q), define the matrix in bidiagonal-block form.
-*> \endverbatim
-*>
-*> \param[in,out] U1
-*> \verbatim
-*> U1 is REAL array, dimension (LDU1,P)
-*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied
-*> by the left singular vector matrix common to [ B11 ; 0 ] and
-*> [ B12 0 0 ; 0 -I 0 0 ].
-*> \endverbatim
-*>
-*> \param[in] LDU1
-*> \verbatim
-*> LDU1 is INTEGER
-*> The leading dimension of the array U1.
-*> \endverbatim
-*>
-*> \param[in,out] U2
-*> \verbatim
-*> U2 is REAL array, dimension (LDU2,M-P)
-*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is
-*> postmultiplied by the left singular vector matrix common to
-*> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ].
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of the array U2.
-*> \endverbatim
-*>
-*> \param[in,out] V1T
-*> \verbatim
-*> V1T is REAL array, dimension (LDV1T,Q)
-*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied
-*> by the transpose of the right singular vector
-*> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ].
-*> \endverbatim
-*>
-*> \param[in] LDV1T
-*> \verbatim
-*> LDV1T is INTEGER
-*> The leading dimension of the array V1T.
-*> \endverbatim
-*>
-*> \param[in,out] V2T
-*> \verbatim
-*> V2T is REAL array, dimenison (LDV2T,M-Q)
-*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is
-*> premultiplied by the transpose of the right
-*> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and
-*> [ B22 0 0 ; 0 0 I ].
-*> \endverbatim
-*>
-*> \param[in] LDV2T
-*> \verbatim
-*> LDV2T is INTEGER
-*> The leading dimension of the array V2T.
-*> \endverbatim
-*>
-*> \param[out] B11D
-*> \verbatim
-*> B11D is REAL array, dimension (Q)
-*> When SBBCSD converges, B11D contains the cosines of THETA(1),
-*> ..., THETA(Q). If SBBCSD fails to converge, then B11D
-*> contains the diagonal of the partially reduced top-left
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B11E
-*> \verbatim
-*> B11E is REAL array, dimension (Q-1)
-*> When SBBCSD converges, B11E contains zeros. If SBBCSD fails
-*> to converge, then B11E contains the superdiagonal of the
-*> partially reduced top-left block.
-*> \endverbatim
-*>
-*> \param[out] B12D
-*> \verbatim
-*> B12D is REAL array, dimension (Q)
-*> When SBBCSD converges, B12D contains the negative sines of
-*> THETA(1), ..., THETA(Q). If SBBCSD fails to converge, then
-*> B12D contains the diagonal of the partially reduced top-right
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B12E
-*> \verbatim
-*> B12E is REAL array, dimension (Q-1)
-*> When SBBCSD converges, B12E contains zeros. If SBBCSD fails
-*> to converge, then B12E contains the subdiagonal of the
-*> partially reduced top-right block.
-*> \endverbatim
-*>
-*> \param[out] B21D
-*> \verbatim
-*> B21D is REAL array, dimension (Q)
-*> When CBBCSD converges, B21D contains the negative sines of
-*> THETA(1), ..., THETA(Q). If CBBCSD fails to converge, then
-*> B21D contains the diagonal of the partially reduced bottom-left
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B21E
-*> \verbatim
-*> B21E is REAL array, dimension (Q-1)
-*> When CBBCSD converges, B21E contains zeros. If CBBCSD fails
-*> to converge, then B21E contains the subdiagonal of the
-*> partially reduced bottom-left block.
-*> \endverbatim
-*>
-*> \param[out] B22D
-*> \verbatim
-*> B22D is REAL array, dimension (Q)
-*> When CBBCSD converges, B22D contains the negative sines of
-*> THETA(1), ..., THETA(Q). If CBBCSD fails to converge, then
-*> B22D contains the diagonal of the partially reduced bottom-right
-*> block.
-*> \endverbatim
-*>
-*> \param[out] B22E
-*> \verbatim
-*> B22E is REAL array, dimension (Q-1)
-*> When CBBCSD converges, B22E contains zeros. If CBBCSD fails
-*> to converge, then B22E contains the subdiagonal of the
-*> partially reduced bottom-right block.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= MAX(1,8*Q).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the WORK array,
-*> returns this value as the first entry of the work array, and
-*> no error message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if SBBCSD did not converge, INFO specifies the number
-*> of nonzero entries in PHI, and B11D, B11E, etc.,
-*> contain the partially reduced matrix.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLMUL REAL, default = MAX(10,MIN(100,EPS**(-1/8)))
-*> TOLMUL controls the convergence criterion of the QR loop.
-*> Angles THETA(i), PHI(i) are rounded to 0 or PI/2 when they
-*> are within TOLMUL*EPS of either bound.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
-*> Algorithms, 50(1):33-65, 2009.
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q,
- $ THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T,
- $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
- $ B22D, B22E, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS
- INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
- REAL B11D( * ), B11E( * ), B12D( * ), B12E( * ),
- $ B21D( * ), B21E( * ), B22D( * ), B22E( * ),
- $ PHI( * ), THETA( * ), WORK( * )
- REAL U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
- $ V2T( LDV2T, * )
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- INTEGER MAXITR
- PARAMETER ( MAXITR = 6 )
- REAL HUNDRED, MEIGHTH, ONE, PIOVER2, TEN, ZERO
- PARAMETER ( HUNDRED = 100.0E0, MEIGHTH = -0.125E0,
- $ ONE = 1.0E0, PIOVER2 = 1.57079632679489662E0,
- $ TEN = 10.0E0, ZERO = 0.0E0 )
- REAL NEGONECOMPLEX
- PARAMETER ( NEGONECOMPLEX = -1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLMAJOR, LQUERY, RESTART11, RESTART12,
- $ RESTART21, RESTART22, WANTU1, WANTU2, WANTV1T,
- $ WANTV2T
- INTEGER I, IMIN, IMAX, ITER, IU1CS, IU1SN, IU2CS,
- $ IU2SN, IV1TCS, IV1TSN, IV2TCS, IV2TSN, J,
- $ LWORKMIN, LWORKOPT, MAXIT, MINI
- REAL B11BULGE, B12BULGE, B21BULGE, B22BULGE, DUMMY,
- $ EPS, MU, NU, R, SIGMA11, SIGMA21,
- $ TEMP, THETAMAX, THETAMIN, THRESH, TOL, TOLMUL,
- $ UNFL, X1, X2, Y1, Y2
-*
-* .. External Subroutines ..
- EXTERNAL SLASR, SSCAL, SSWAP, SLARTGP, SLARTGS, SLAS2,
- $ XERBLA
-* ..
-* .. External Functions ..
- REAL SLAMCH
- LOGICAL LSAME
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, ATAN2, COS, MAX, MIN, SIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-*
- INFO = 0
- LQUERY = LWORK .EQ. -1
- WANTU1 = LSAME( JOBU1, 'Y' )
- WANTU2 = LSAME( JOBU2, 'Y' )
- WANTV1T = LSAME( JOBV1T, 'Y' )
- WANTV2T = LSAME( JOBV2T, 'Y' )
- COLMAJOR = .NOT. LSAME( TRANS, 'T' )
-*
- IF( M .LT. 0 ) THEN
- INFO = -6
- ELSE IF( P .LT. 0 .OR. P .GT. M ) THEN
- INFO = -7
- ELSE IF( Q .LT. 0 .OR. Q .GT. M ) THEN
- INFO = -8
- ELSE IF( Q .GT. P .OR. Q .GT. M-P .OR. Q .GT. M-Q ) THEN
- INFO = -8
- ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN
- INFO = -12
- ELSE IF( WANTU2 .AND. LDU2 .LT. M-P ) THEN
- INFO = -14
- ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN
- INFO = -16
- ELSE IF( WANTV2T .AND. LDV2T .LT. M-Q ) THEN
- INFO = -18
- END IF
-*
-* Quick return if Q = 0
-*
- IF( INFO .EQ. 0 .AND. Q .EQ. 0 ) THEN
- LWORKMIN = 1
- WORK(1) = LWORKMIN
- RETURN
- END IF
-*
-* Compute workspace
-*
- IF( INFO .EQ. 0 ) THEN
- IU1CS = 1
- IU1SN = IU1CS + Q
- IU2CS = IU1SN + Q
- IU2SN = IU2CS + Q
- IV1TCS = IU2SN + Q
- IV1TSN = IV1TCS + Q
- IV2TCS = IV1TSN + Q
- IV2TSN = IV2TCS + Q
- LWORKOPT = IV2TSN + Q - 1
- LWORKMIN = LWORKOPT
- WORK(1) = LWORKOPT
- IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN
- INFO = -28
- END IF
- END IF
-*
- IF( INFO .NE. 0 ) THEN
- CALL XERBLA( 'SBBCSD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'Epsilon' )
- UNFL = SLAMCH( 'Safe minimum' )
- TOLMUL = MAX( TEN, MIN( HUNDRED, EPS**MEIGHTH ) )
- TOL = TOLMUL*EPS
- THRESH = MAX( TOL, MAXITR*Q*Q*UNFL )
-*
-* Test for negligible sines or cosines
-*
- DO I = 1, Q
- IF( THETA(I) .LT. THRESH ) THEN
- THETA(I) = ZERO
- ELSE IF( THETA(I) .GT. PIOVER2-THRESH ) THEN
- THETA(I) = PIOVER2
- END IF
- END DO
- DO I = 1, Q-1
- IF( PHI(I) .LT. THRESH ) THEN
- PHI(I) = ZERO
- ELSE IF( PHI(I) .GT. PIOVER2-THRESH ) THEN
- PHI(I) = PIOVER2
- END IF
- END DO
-*
-* Initial deflation
-*
- IMAX = Q
- DO WHILE( ( IMAX .GT. 1 ) .AND. ( PHI(IMAX-1) .EQ. ZERO ) )
- IMAX = IMAX - 1
- END DO
- IMIN = IMAX - 1
- IF ( IMIN .GT. 1 ) THEN
- DO WHILE( PHI(IMIN-1) .NE. ZERO )
- IMIN = IMIN - 1
- IF ( IMIN .LE. 1 ) EXIT
- END DO
- END IF
-*
-* Initialize iteration counter
-*
- MAXIT = MAXITR*Q*Q
- ITER = 0
-*
-* Begin main iteration loop
-*
- DO WHILE( IMAX .GT. 1 )
-*
-* Compute the matrix entries
-*
- B11D(IMIN) = COS( THETA(IMIN) )
- B21D(IMIN) = -SIN( THETA(IMIN) )
- DO I = IMIN, IMAX - 1
- B11E(I) = -SIN( THETA(I) ) * SIN( PHI(I) )
- B11D(I+1) = COS( THETA(I+1) ) * COS( PHI(I) )
- B12D(I) = SIN( THETA(I) ) * COS( PHI(I) )
- B12E(I) = COS( THETA(I+1) ) * SIN( PHI(I) )
- B21E(I) = -COS( THETA(I) ) * SIN( PHI(I) )
- B21D(I+1) = -SIN( THETA(I+1) ) * COS( PHI(I) )
- B22D(I) = COS( THETA(I) ) * COS( PHI(I) )
- B22E(I) = -SIN( THETA(I+1) ) * SIN( PHI(I) )
- END DO
- B12D(IMAX) = SIN( THETA(IMAX) )
- B22D(IMAX) = COS( THETA(IMAX) )
-*
-* Abort if not converging; otherwise, increment ITER
-*
- IF( ITER .GT. MAXIT ) THEN
- INFO = 0
- DO I = 1, Q
- IF( PHI(I) .NE. ZERO )
- $ INFO = INFO + 1
- END DO
- RETURN
- END IF
-*
- ITER = ITER + IMAX - IMIN
-*
-* Compute shifts
-*
- THETAMAX = THETA(IMIN)
- THETAMIN = THETA(IMIN)
- DO I = IMIN+1, IMAX
- IF( THETA(I) > THETAMAX )
- $ THETAMAX = THETA(I)
- IF( THETA(I) < THETAMIN )
- $ THETAMIN = THETA(I)
- END DO
-*
- IF( THETAMAX .GT. PIOVER2 - THRESH ) THEN
-*
-* Zero on diagonals of B11 and B22; induce deflation with a
-* zero shift
-*
- MU = ZERO
- NU = ONE
-*
- ELSE IF( THETAMIN .LT. THRESH ) THEN
-*
-* Zero on diagonals of B12 and B22; induce deflation with a
-* zero shift
-*
- MU = ONE
- NU = ZERO
-*
- ELSE
-*
-* Compute shifts for B11 and B21 and use the lesser
-*
- CALL SLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), SIGMA11,
- $ DUMMY )
- CALL SLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), SIGMA21,
- $ DUMMY )
-*
- IF( SIGMA11 .LE. SIGMA21 ) THEN
- MU = SIGMA11
- NU = SQRT( ONE - MU**2 )
- IF( MU .LT. THRESH ) THEN
- MU = ZERO
- NU = ONE
- END IF
- ELSE
- NU = SIGMA21
- MU = SQRT( 1.0 - NU**2 )
- IF( NU .LT. THRESH ) THEN
- MU = ONE
- NU = ZERO
- END IF
- END IF
- END IF
-*
-* Rotate to produce bulges in B11 and B21
-*
- IF( MU .LE. NU ) THEN
- CALL SLARTGS( B11D(IMIN), B11E(IMIN), MU,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1) )
- ELSE
- CALL SLARTGS( B21D(IMIN), B21E(IMIN), NU,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1) )
- END IF
-*
- TEMP = WORK(IV1TCS+IMIN-1)*B11D(IMIN) +
- $ WORK(IV1TSN+IMIN-1)*B11E(IMIN)
- B11E(IMIN) = WORK(IV1TCS+IMIN-1)*B11E(IMIN) -
- $ WORK(IV1TSN+IMIN-1)*B11D(IMIN)
- B11D(IMIN) = TEMP
- B11BULGE = WORK(IV1TSN+IMIN-1)*B11D(IMIN+1)
- B11D(IMIN+1) = WORK(IV1TCS+IMIN-1)*B11D(IMIN+1)
- TEMP = WORK(IV1TCS+IMIN-1)*B21D(IMIN) +
- $ WORK(IV1TSN+IMIN-1)*B21E(IMIN)
- B21E(IMIN) = WORK(IV1TCS+IMIN-1)*B21E(IMIN) -
- $ WORK(IV1TSN+IMIN-1)*B21D(IMIN)
- B21D(IMIN) = TEMP
- B21BULGE = WORK(IV1TSN+IMIN-1)*B21D(IMIN+1)
- B21D(IMIN+1) = WORK(IV1TCS+IMIN-1)*B21D(IMIN+1)
-*
-* Compute THETA(IMIN)
-*
- THETA( IMIN ) = ATAN2( SQRT( B21D(IMIN)**2+B21BULGE**2 ),
- $ SQRT( B11D(IMIN)**2+B11BULGE**2 ) )
-*
-* Chase the bulges in B11(IMIN+1,IMIN) and B21(IMIN+1,IMIN)
-*
- IF( B11D(IMIN)**2+B11BULGE**2 .GT. THRESH**2 ) THEN
- CALL SLARTGP( B11BULGE, B11D(IMIN), WORK(IU1SN+IMIN-1),
- $ WORK(IU1CS+IMIN-1), R )
- ELSE IF( MU .LE. NU ) THEN
- CALL SLARTGS( B11E( IMIN ), B11D( IMIN + 1 ), MU,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1) )
- ELSE
- CALL SLARTGS( B12D( IMIN ), B12E( IMIN ), NU,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1) )
- END IF
- IF( B21D(IMIN)**2+B21BULGE**2 .GT. THRESH**2 ) THEN
- CALL SLARTGP( B21BULGE, B21D(IMIN), WORK(IU2SN+IMIN-1),
- $ WORK(IU2CS+IMIN-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL SLARTGS( B21E( IMIN ), B21D( IMIN + 1 ), NU,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1) )
- ELSE
- CALL SLARTGS( B22D(IMIN), B22E(IMIN), MU,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1) )
- END IF
- WORK(IU2CS+IMIN-1) = -WORK(IU2CS+IMIN-1)
- WORK(IU2SN+IMIN-1) = -WORK(IU2SN+IMIN-1)
-*
- TEMP = WORK(IU1CS+IMIN-1)*B11E(IMIN) +
- $ WORK(IU1SN+IMIN-1)*B11D(IMIN+1)
- B11D(IMIN+1) = WORK(IU1CS+IMIN-1)*B11D(IMIN+1) -
- $ WORK(IU1SN+IMIN-1)*B11E(IMIN)
- B11E(IMIN) = TEMP
- IF( IMAX .GT. IMIN+1 ) THEN
- B11BULGE = WORK(IU1SN+IMIN-1)*B11E(IMIN+1)
- B11E(IMIN+1) = WORK(IU1CS+IMIN-1)*B11E(IMIN+1)
- END IF
- TEMP = WORK(IU1CS+IMIN-1)*B12D(IMIN) +
- $ WORK(IU1SN+IMIN-1)*B12E(IMIN)
- B12E(IMIN) = WORK(IU1CS+IMIN-1)*B12E(IMIN) -
- $ WORK(IU1SN+IMIN-1)*B12D(IMIN)
- B12D(IMIN) = TEMP
- B12BULGE = WORK(IU1SN+IMIN-1)*B12D(IMIN+1)
- B12D(IMIN+1) = WORK(IU1CS+IMIN-1)*B12D(IMIN+1)
- TEMP = WORK(IU2CS+IMIN-1)*B21E(IMIN) +
- $ WORK(IU2SN+IMIN-1)*B21D(IMIN+1)
- B21D(IMIN+1) = WORK(IU2CS+IMIN-1)*B21D(IMIN+1) -
- $ WORK(IU2SN+IMIN-1)*B21E(IMIN)
- B21E(IMIN) = TEMP
- IF( IMAX .GT. IMIN+1 ) THEN
- B21BULGE = WORK(IU2SN+IMIN-1)*B21E(IMIN+1)
- B21E(IMIN+1) = WORK(IU2CS+IMIN-1)*B21E(IMIN+1)
- END IF
- TEMP = WORK(IU2CS+IMIN-1)*B22D(IMIN) +
- $ WORK(IU2SN+IMIN-1)*B22E(IMIN)
- B22E(IMIN) = WORK(IU2CS+IMIN-1)*B22E(IMIN) -
- $ WORK(IU2SN+IMIN-1)*B22D(IMIN)
- B22D(IMIN) = TEMP
- B22BULGE = WORK(IU2SN+IMIN-1)*B22D(IMIN+1)
- B22D(IMIN+1) = WORK(IU2CS+IMIN-1)*B22D(IMIN+1)
-*
-* Inner loop: chase bulges from B11(IMIN,IMIN+2),
-* B12(IMIN,IMIN+1), B21(IMIN,IMIN+2), and B22(IMIN,IMIN+1) to
-* bottom-right
-*
- DO I = IMIN+1, IMAX-1
-*
-* Compute PHI(I-1)
-*
- X1 = SIN(THETA(I-1))*B11E(I-1) + COS(THETA(I-1))*B21E(I-1)
- X2 = SIN(THETA(I-1))*B11BULGE + COS(THETA(I-1))*B21BULGE
- Y1 = SIN(THETA(I-1))*B12D(I-1) + COS(THETA(I-1))*B22D(I-1)
- Y2 = SIN(THETA(I-1))*B12BULGE + COS(THETA(I-1))*B22BULGE
-*
- PHI(I-1) = ATAN2( SQRT(X1**2+X2**2), SQRT(Y1**2+Y2**2) )
-*
-* Determine if there are bulges to chase or if a new direct
-* summand has been reached
-*
- RESTART11 = B11E(I-1)**2 + B11BULGE**2 .LE. THRESH**2
- RESTART21 = B21E(I-1)**2 + B21BULGE**2 .LE. THRESH**2
- RESTART12 = B12D(I-1)**2 + B12BULGE**2 .LE. THRESH**2
- RESTART22 = B22D(I-1)**2 + B22BULGE**2 .LE. THRESH**2
-*
-* If possible, chase bulges from B11(I-1,I+1), B12(I-1,I),
-* B21(I-1,I+1), and B22(I-1,I). If necessary, restart bulge-
-* chasing by applying the original shift again.
-*
- IF( .NOT. RESTART11 .AND. .NOT. RESTART21 ) THEN
- CALL SLARTGP( X2, X1, WORK(IV1TSN+I-1), WORK(IV1TCS+I-1),
- $ R )
- ELSE IF( .NOT. RESTART11 .AND. RESTART21 ) THEN
- CALL SLARTGP( B11BULGE, B11E(I-1), WORK(IV1TSN+I-1),
- $ WORK(IV1TCS+I-1), R )
- ELSE IF( RESTART11 .AND. .NOT. RESTART21 ) THEN
- CALL SLARTGP( B21BULGE, B21E(I-1), WORK(IV1TSN+I-1),
- $ WORK(IV1TCS+I-1), R )
- ELSE IF( MU .LE. NU ) THEN
- CALL SLARTGS( B11D(I), B11E(I), MU, WORK(IV1TCS+I-1),
- $ WORK(IV1TSN+I-1) )
- ELSE
- CALL SLARTGS( B21D(I), B21E(I), NU, WORK(IV1TCS+I-1),
- $ WORK(IV1TSN+I-1) )
- END IF
- WORK(IV1TCS+I-1) = -WORK(IV1TCS+I-1)
- WORK(IV1TSN+I-1) = -WORK(IV1TSN+I-1)
- IF( .NOT. RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL SLARTGP( Y2, Y1, WORK(IV2TSN+I-1-1),
- $ WORK(IV2TCS+I-1-1), R )
- ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN
- CALL SLARTGP( B12BULGE, B12D(I-1), WORK(IV2TSN+I-1-1),
- $ WORK(IV2TCS+I-1-1), R )
- ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL SLARTGP( B22BULGE, B22D(I-1), WORK(IV2TSN+I-1-1),
- $ WORK(IV2TCS+I-1-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL SLARTGS( B12E(I-1), B12D(I), NU, WORK(IV2TCS+I-1-1),
- $ WORK(IV2TSN+I-1-1) )
- ELSE
- CALL SLARTGS( B22E(I-1), B22D(I), MU, WORK(IV2TCS+I-1-1),
- $ WORK(IV2TSN+I-1-1) )
- END IF
-*
- TEMP = WORK(IV1TCS+I-1)*B11D(I) + WORK(IV1TSN+I-1)*B11E(I)
- B11E(I) = WORK(IV1TCS+I-1)*B11E(I) -
- $ WORK(IV1TSN+I-1)*B11D(I)
- B11D(I) = TEMP
- B11BULGE = WORK(IV1TSN+I-1)*B11D(I+1)
- B11D(I+1) = WORK(IV1TCS+I-1)*B11D(I+1)
- TEMP = WORK(IV1TCS+I-1)*B21D(I) + WORK(IV1TSN+I-1)*B21E(I)
- B21E(I) = WORK(IV1TCS+I-1)*B21E(I) -
- $ WORK(IV1TSN+I-1)*B21D(I)
- B21D(I) = TEMP
- B21BULGE = WORK(IV1TSN+I-1)*B21D(I+1)
- B21D(I+1) = WORK(IV1TCS+I-1)*B21D(I+1)
- TEMP = WORK(IV2TCS+I-1-1)*B12E(I-1) +
- $ WORK(IV2TSN+I-1-1)*B12D(I)
- B12D(I) = WORK(IV2TCS+I-1-1)*B12D(I) -
- $ WORK(IV2TSN+I-1-1)*B12E(I-1)
- B12E(I-1) = TEMP
- B12BULGE = WORK(IV2TSN+I-1-1)*B12E(I)
- B12E(I) = WORK(IV2TCS+I-1-1)*B12E(I)
- TEMP = WORK(IV2TCS+I-1-1)*B22E(I-1) +
- $ WORK(IV2TSN+I-1-1)*B22D(I)
- B22D(I) = WORK(IV2TCS+I-1-1)*B22D(I) -
- $ WORK(IV2TSN+I-1-1)*B22E(I-1)
- B22E(I-1) = TEMP
- B22BULGE = WORK(IV2TSN+I-1-1)*B22E(I)
- B22E(I) = WORK(IV2TCS+I-1-1)*B22E(I)
-*
-* Compute THETA(I)
-*
- X1 = COS(PHI(I-1))*B11D(I) + SIN(PHI(I-1))*B12E(I-1)
- X2 = COS(PHI(I-1))*B11BULGE + SIN(PHI(I-1))*B12BULGE
- Y1 = COS(PHI(I-1))*B21D(I) + SIN(PHI(I-1))*B22E(I-1)
- Y2 = COS(PHI(I-1))*B21BULGE + SIN(PHI(I-1))*B22BULGE
-*
- THETA(I) = ATAN2( SQRT(Y1**2+Y2**2), SQRT(X1**2+X2**2) )
-*
-* Determine if there are bulges to chase or if a new direct
-* summand has been reached
-*
- RESTART11 = B11D(I)**2 + B11BULGE**2 .LE. THRESH**2
- RESTART12 = B12E(I-1)**2 + B12BULGE**2 .LE. THRESH**2
- RESTART21 = B21D(I)**2 + B21BULGE**2 .LE. THRESH**2
- RESTART22 = B22E(I-1)**2 + B22BULGE**2 .LE. THRESH**2
-*
-* If possible, chase bulges from B11(I+1,I), B12(I+1,I-1),
-* B21(I+1,I), and B22(I+1,I-1). If necessary, restart bulge-
-* chasing by applying the original shift again.
-*
- IF( .NOT. RESTART11 .AND. .NOT. RESTART12 ) THEN
- CALL SLARTGP( X2, X1, WORK(IU1SN+I-1), WORK(IU1CS+I-1),
- $ R )
- ELSE IF( .NOT. RESTART11 .AND. RESTART12 ) THEN
- CALL SLARTGP( B11BULGE, B11D(I), WORK(IU1SN+I-1),
- $ WORK(IU1CS+I-1), R )
- ELSE IF( RESTART11 .AND. .NOT. RESTART12 ) THEN
- CALL SLARTGP( B12BULGE, B12E(I-1), WORK(IU1SN+I-1),
- $ WORK(IU1CS+I-1), R )
- ELSE IF( MU .LE. NU ) THEN
- CALL SLARTGS( B11E(I), B11D(I+1), MU, WORK(IU1CS+I-1),
- $ WORK(IU1SN+I-1) )
- ELSE
- CALL SLARTGS( B12D(I), B12E(I), NU, WORK(IU1CS+I-1),
- $ WORK(IU1SN+I-1) )
- END IF
- IF( .NOT. RESTART21 .AND. .NOT. RESTART22 ) THEN
- CALL SLARTGP( Y2, Y1, WORK(IU2SN+I-1), WORK(IU2CS+I-1),
- $ R )
- ELSE IF( .NOT. RESTART21 .AND. RESTART22 ) THEN
- CALL SLARTGP( B21BULGE, B21D(I), WORK(IU2SN+I-1),
- $ WORK(IU2CS+I-1), R )
- ELSE IF( RESTART21 .AND. .NOT. RESTART22 ) THEN
- CALL SLARTGP( B22BULGE, B22E(I-1), WORK(IU2SN+I-1),
- $ WORK(IU2CS+I-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL SLARTGS( B21E(I), B21E(I+1), NU, WORK(IU2CS+I-1),
- $ WORK(IU2SN+I-1) )
- ELSE
- CALL SLARTGS( B22D(I), B22E(I), MU, WORK(IU2CS+I-1),
- $ WORK(IU2SN+I-1) )
- END IF
- WORK(IU2CS+I-1) = -WORK(IU2CS+I-1)
- WORK(IU2SN+I-1) = -WORK(IU2SN+I-1)
-*
- TEMP = WORK(IU1CS+I-1)*B11E(I) + WORK(IU1SN+I-1)*B11D(I+1)
- B11D(I+1) = WORK(IU1CS+I-1)*B11D(I+1) -
- $ WORK(IU1SN+I-1)*B11E(I)
- B11E(I) = TEMP
- IF( I .LT. IMAX - 1 ) THEN
- B11BULGE = WORK(IU1SN+I-1)*B11E(I+1)
- B11E(I+1) = WORK(IU1CS+I-1)*B11E(I+1)
- END IF
- TEMP = WORK(IU2CS+I-1)*B21E(I) + WORK(IU2SN+I-1)*B21D(I+1)
- B21D(I+1) = WORK(IU2CS+I-1)*B21D(I+1) -
- $ WORK(IU2SN+I-1)*B21E(I)
- B21E(I) = TEMP
- IF( I .LT. IMAX - 1 ) THEN
- B21BULGE = WORK(IU2SN+I-1)*B21E(I+1)
- B21E(I+1) = WORK(IU2CS+I-1)*B21E(I+1)
- END IF
- TEMP = WORK(IU1CS+I-1)*B12D(I) + WORK(IU1SN+I-1)*B12E(I)
- B12E(I) = WORK(IU1CS+I-1)*B12E(I) - WORK(IU1SN+I-1)*B12D(I)
- B12D(I) = TEMP
- B12BULGE = WORK(IU1SN+I-1)*B12D(I+1)
- B12D(I+1) = WORK(IU1CS+I-1)*B12D(I+1)
- TEMP = WORK(IU2CS+I-1)*B22D(I) + WORK(IU2SN+I-1)*B22E(I)
- B22E(I) = WORK(IU2CS+I-1)*B22E(I) - WORK(IU2SN+I-1)*B22D(I)
- B22D(I) = TEMP
- B22BULGE = WORK(IU2SN+I-1)*B22D(I+1)
- B22D(I+1) = WORK(IU2CS+I-1)*B22D(I+1)
-*
- END DO
-*
-* Compute PHI(IMAX-1)
-*
- X1 = SIN(THETA(IMAX-1))*B11E(IMAX-1) +
- $ COS(THETA(IMAX-1))*B21E(IMAX-1)
- Y1 = SIN(THETA(IMAX-1))*B12D(IMAX-1) +
- $ COS(THETA(IMAX-1))*B22D(IMAX-1)
- Y2 = SIN(THETA(IMAX-1))*B12BULGE + COS(THETA(IMAX-1))*B22BULGE
-*
- PHI(IMAX-1) = ATAN2( ABS(X1), SQRT(Y1**2+Y2**2) )
-*
-* Chase bulges from B12(IMAX-1,IMAX) and B22(IMAX-1,IMAX)
-*
- RESTART12 = B12D(IMAX-1)**2 + B12BULGE**2 .LE. THRESH**2
- RESTART22 = B22D(IMAX-1)**2 + B22BULGE**2 .LE. THRESH**2
-*
- IF( .NOT. RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL SLARTGP( Y2, Y1, WORK(IV2TSN+IMAX-1-1),
- $ WORK(IV2TCS+IMAX-1-1), R )
- ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN
- CALL SLARTGP( B12BULGE, B12D(IMAX-1), WORK(IV2TSN+IMAX-1-1),
- $ WORK(IV2TCS+IMAX-1-1), R )
- ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN
- CALL SLARTGP( B22BULGE, B22D(IMAX-1), WORK(IV2TSN+IMAX-1-1),
- $ WORK(IV2TCS+IMAX-1-1), R )
- ELSE IF( NU .LT. MU ) THEN
- CALL SLARTGS( B12E(IMAX-1), B12D(IMAX), NU,
- $ WORK(IV2TCS+IMAX-1-1), WORK(IV2TSN+IMAX-1-1) )
- ELSE
- CALL SLARTGS( B22E(IMAX-1), B22D(IMAX), MU,
- $ WORK(IV2TCS+IMAX-1-1), WORK(IV2TSN+IMAX-1-1) )
- END IF
-*
- TEMP = WORK(IV2TCS+IMAX-1-1)*B12E(IMAX-1) +
- $ WORK(IV2TSN+IMAX-1-1)*B12D(IMAX)
- B12D(IMAX) = WORK(IV2TCS+IMAX-1-1)*B12D(IMAX) -
- $ WORK(IV2TSN+IMAX-1-1)*B12E(IMAX-1)
- B12E(IMAX-1) = TEMP
- TEMP = WORK(IV2TCS+IMAX-1-1)*B22E(IMAX-1) +
- $ WORK(IV2TSN+IMAX-1-1)*B22D(IMAX)
- B22D(IMAX) = WORK(IV2TCS+IMAX-1-1)*B22D(IMAX) -
- $ WORK(IV2TSN+IMAX-1-1)*B22E(IMAX-1)
- B22E(IMAX-1) = TEMP
-*
-* Update singular vectors
-*
- IF( WANTU1 ) THEN
- IF( COLMAJOR ) THEN
- CALL SLASR( 'R', 'V', 'F', P, IMAX-IMIN+1,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1),
- $ U1(1,IMIN), LDU1 )
- ELSE
- CALL SLASR( 'L', 'V', 'F', IMAX-IMIN+1, P,
- $ WORK(IU1CS+IMIN-1), WORK(IU1SN+IMIN-1),
- $ U1(IMIN,1), LDU1 )
- END IF
- END IF
- IF( WANTU2 ) THEN
- IF( COLMAJOR ) THEN
- CALL SLASR( 'R', 'V', 'F', M-P, IMAX-IMIN+1,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1),
- $ U2(1,IMIN), LDU2 )
- ELSE
- CALL SLASR( 'L', 'V', 'F', IMAX-IMIN+1, M-P,
- $ WORK(IU2CS+IMIN-1), WORK(IU2SN+IMIN-1),
- $ U2(IMIN,1), LDU2 )
- END IF
- END IF
- IF( WANTV1T ) THEN
- IF( COLMAJOR ) THEN
- CALL SLASR( 'L', 'V', 'F', IMAX-IMIN+1, Q,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1),
- $ V1T(IMIN,1), LDV1T )
- ELSE
- CALL SLASR( 'R', 'V', 'F', Q, IMAX-IMIN+1,
- $ WORK(IV1TCS+IMIN-1), WORK(IV1TSN+IMIN-1),
- $ V1T(1,IMIN), LDV1T )
- END IF
- END IF
- IF( WANTV2T ) THEN
- IF( COLMAJOR ) THEN
- CALL SLASR( 'L', 'V', 'F', IMAX-IMIN+1, M-Q,
- $ WORK(IV2TCS+IMIN-1), WORK(IV2TSN+IMIN-1),
- $ V2T(IMIN,1), LDV2T )
- ELSE
- CALL SLASR( 'R', 'V', 'F', M-Q, IMAX-IMIN+1,
- $ WORK(IV2TCS+IMIN-1), WORK(IV2TSN+IMIN-1),
- $ V2T(1,IMIN), LDV2T )
- END IF
- END IF
-*
-* Fix signs on B11(IMAX-1,IMAX) and B21(IMAX-1,IMAX)
-*
- IF( B11E(IMAX-1)+B21E(IMAX-1) .GT. 0 ) THEN
- B11D(IMAX) = -B11D(IMAX)
- B21D(IMAX) = -B21D(IMAX)
- IF( WANTV1T ) THEN
- IF( COLMAJOR ) THEN
- CALL SSCAL( Q, NEGONECOMPLEX, V1T(IMAX,1), LDV1T )
- ELSE
- CALL SSCAL( Q, NEGONECOMPLEX, V1T(1,IMAX), 1 )
- END IF
- END IF
- END IF
-*
-* Compute THETA(IMAX)
-*
- X1 = COS(PHI(IMAX-1))*B11D(IMAX) +
- $ SIN(PHI(IMAX-1))*B12E(IMAX-1)
- Y1 = COS(PHI(IMAX-1))*B21D(IMAX) +
- $ SIN(PHI(IMAX-1))*B22E(IMAX-1)
-*
- THETA(IMAX) = ATAN2( ABS(Y1), ABS(X1) )
-*
-* Fix signs on B11(IMAX,IMAX), B12(IMAX,IMAX-1), B21(IMAX,IMAX),
-* and B22(IMAX,IMAX-1)
-*
- IF( B11D(IMAX)+B12E(IMAX-1) .LT. 0 ) THEN
- B12D(IMAX) = -B12D(IMAX)
- IF( WANTU1 ) THEN
- IF( COLMAJOR ) THEN
- CALL SSCAL( P, NEGONECOMPLEX, U1(1,IMAX), 1 )
- ELSE
- CALL SSCAL( P, NEGONECOMPLEX, U1(IMAX,1), LDU1 )
- END IF
- END IF
- END IF
- IF( B21D(IMAX)+B22E(IMAX-1) .GT. 0 ) THEN
- B22D(IMAX) = -B22D(IMAX)
- IF( WANTU2 ) THEN
- IF( COLMAJOR ) THEN
- CALL SSCAL( M-P, NEGONECOMPLEX, U2(1,IMAX), 1 )
- ELSE
- CALL SSCAL( M-P, NEGONECOMPLEX, U2(IMAX,1), LDU2 )
- END IF
- END IF
- END IF
-*
-* Fix signs on B12(IMAX,IMAX) and B22(IMAX,IMAX)
-*
- IF( B12D(IMAX)+B22D(IMAX) .LT. 0 ) THEN
- IF( WANTV2T ) THEN
- IF( COLMAJOR ) THEN
- CALL SSCAL( M-Q, NEGONECOMPLEX, V2T(IMAX,1), LDV2T )
- ELSE
- CALL SSCAL( M-Q, NEGONECOMPLEX, V2T(1,IMAX), 1 )
- END IF
- END IF
- END IF
-*
-* Test for negligible sines or cosines
-*
- DO I = IMIN, IMAX
- IF( THETA(I) .LT. THRESH ) THEN
- THETA(I) = ZERO
- ELSE IF( THETA(I) .GT. PIOVER2-THRESH ) THEN
- THETA(I) = PIOVER2
- END IF
- END DO
- DO I = IMIN, IMAX-1
- IF( PHI(I) .LT. THRESH ) THEN
- PHI(I) = ZERO
- ELSE IF( PHI(I) .GT. PIOVER2-THRESH ) THEN
- PHI(I) = PIOVER2
- END IF
- END DO
-*
-* Deflate
-*
- IF (IMAX .GT. 1) THEN
- DO WHILE( PHI(IMAX-1) .EQ. ZERO )
- IMAX = IMAX - 1
- IF (IMAX .LE. 1) EXIT
- END DO
- END IF
- IF( IMIN .GT. IMAX - 1 )
- $ IMIN = IMAX - 1
- IF (IMIN .GT. 1) THEN
- DO WHILE (PHI(IMIN-1) .NE. ZERO)
- IMIN = IMIN - 1
- IF (IMIN .LE. 1) EXIT
- END DO
- END IF
-*
-* Repeat main iteration loop
-*
- END DO
-*
-* Postprocessing: order THETA from least to greatest
-*
- DO I = 1, Q
-*
- MINI = I
- THETAMIN = THETA(I)
- DO J = I+1, Q
- IF( THETA(J) .LT. THETAMIN ) THEN
- MINI = J
- THETAMIN = THETA(J)
- END IF
- END DO
-*
- IF( MINI .NE. I ) THEN
- THETA(MINI) = THETA(I)
- THETA(I) = THETAMIN
- IF( COLMAJOR ) THEN
- IF( WANTU1 )
- $ CALL SSWAP( P, U1(1,I), 1, U1(1,MINI), 1 )
- IF( WANTU2 )
- $ CALL SSWAP( M-P, U2(1,I), 1, U2(1,MINI), 1 )
- IF( WANTV1T )
- $ CALL SSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), LDV1T )
- IF( WANTV2T )
- $ CALL SSWAP( M-Q, V2T(I,1), LDV2T, V2T(MINI,1),
- $ LDV2T )
- ELSE
- IF( WANTU1 )
- $ CALL SSWAP( P, U1(I,1), LDU1, U1(MINI,1), LDU1 )
- IF( WANTU2 )
- $ CALL SSWAP( M-P, U2(I,1), LDU2, U2(MINI,1), LDU2 )
- IF( WANTV1T )
- $ CALL SSWAP( Q, V1T(1,I), 1, V1T(1,MINI), 1 )
- IF( WANTV2T )
- $ CALL SSWAP( M-Q, V2T(1,I), 1, V2T(1,MINI), 1 )
- END IF
- END IF
-*
- END DO
-*
- RETURN
-*
-* End of SBBCSD
-*
- END
-
diff --git a/netlib/LAPACK/sbdsdc.f b/netlib/LAPACK/sbdsdc.f
deleted file mode 100644
index 261aa1c..0000000
--- a/netlib/LAPACK/sbdsdc.f
+++ /dev/null
@@ -1,521 +0,0 @@
-*> \brief \b SBDSDC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SBDSDC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sbdsdc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sbdsdc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sbdsdc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, UPLO
-* INTEGER INFO, LDU, LDVT, N
-* ..
-* .. Array Arguments ..
-* INTEGER IQ( * ), IWORK( * )
-* REAL D( * ), E( * ), Q( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SBDSDC computes the singular value decomposition (SVD) of a real
-*> N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
-*> using a divide and conquer method, where S is a diagonal matrix
-*> with non-negative diagonal elements (the singular values of B), and
-*> U and VT are orthogonal matrices of left and right singular vectors,
-*> respectively. SBDSDC can be used to compute all singular values,
-*> and optionally, singular vectors or singular vectors in compact form.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none. See SLASD3 for details.
-*>
-*> The code currently calls SLASDQ if singular values only are desired.
-*> However, it can be slightly modified to compute singular values
-*> using the divide and conquer method.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': B is upper bidiagonal.
-*> = 'L': B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> Specifies whether singular vectors are to be computed
-*> as follows:
-*> = 'N': Compute singular values only;
-*> = 'P': Compute singular values and compute singular
-*> vectors in compact form;
-*> = 'I': Compute singular values and singular vectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the bidiagonal matrix B.
-*> On exit, if INFO=0, the singular values of B.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the elements of E contain the offdiagonal
-*> elements of the bidiagonal matrix whose SVD is desired.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,N)
-*> If COMPQ = 'I', then:
-*> On exit, if INFO = 0, U contains the left singular vectors
-*> of the bidiagonal matrix.
-*> For other values of COMPQ, U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1.
-*> If singular vectors are desired, then LDU >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT,N)
-*> If COMPQ = 'I', then:
-*> On exit, if INFO = 0, VT**T contains the right singular
-*> vectors of the bidiagonal matrix.
-*> For other values of COMPQ, VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1.
-*> If singular vectors are desired, then LDVT >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ)
-*> If COMPQ = 'P', then:
-*> On exit, if INFO = 0, Q and IQ contain the left
-*> and right singular vectors in a compact form,
-*> requiring O(N log N) space instead of 2*N**2.
-*> In particular, Q contains all the REAL data in
-*> LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
-*> words of memory, where SMLSIZ is returned by ILAENV and
-*> is equal to the maximum size of the subproblems at the
-*> bottom of the computation tree (usually about 25).
-*> For other values of COMPQ, Q is not referenced.
-*> \endverbatim
-*>
-*> \param[out] IQ
-*> \verbatim
-*> IQ is INTEGER array, dimension (LDIQ)
-*> If COMPQ = 'P', then:
-*> On exit, if INFO = 0, Q and IQ contain the left
-*> and right singular vectors in a compact form,
-*> requiring O(N log N) space instead of 2*N**2.
-*> In particular, IQ contains all INTEGER data in
-*> LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
-*> words of memory, where SMLSIZ is returned by ILAENV and
-*> is equal to the maximum size of the subproblems at the
-*> bottom of the computation tree (usually about 25).
-*> For other values of COMPQ, IQ is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> If COMPQ = 'N' then LWORK >= (4 * N).
-*> If COMPQ = 'P' then LWORK >= (6 * N).
-*> If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute a singular value.
-*> The update process of divide and conquer failed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, UPLO
- INTEGER INFO, LDU, LDVT, N
-* ..
-* .. Array Arguments ..
- INTEGER IQ( * ), IWORK( * )
- REAL D( * ), E( * ), Q( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-* Changed dimension statement in comment describing E from (N) to
-* (N-1). Sven, 17 Feb 05.
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER DIFL, DIFR, GIVCOL, GIVNUM, GIVPTR, I, IC,
- $ ICOMPQ, IERR, II, IS, IU, IUPLO, IVT, J, K, KK,
- $ MLVL, NM1, NSIZE, PERM, POLES, QSTART, SMLSIZ,
- $ SMLSZP, SQRE, START, WSTART, Z
- REAL CS, EPS, ORGNRM, P, R, SN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANST
- EXTERNAL SLAMCH, SLANST, ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA, SLASDQ,
- $ SLASET, SLASR, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC REAL, ABS, INT, LOG, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IUPLO = 0
- IF( LSAME( UPLO, 'U' ) )
- $ IUPLO = 1
- IF( LSAME( UPLO, 'L' ) )
- $ IUPLO = 2
- IF( LSAME( COMPQ, 'N' ) ) THEN
- ICOMPQ = 0
- ELSE IF( LSAME( COMPQ, 'P' ) ) THEN
- ICOMPQ = 1
- ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
- ICOMPQ = 2
- ELSE
- ICOMPQ = -1
- END IF
- IF( IUPLO.EQ.0 ) THEN
- INFO = -1
- ELSE IF( ICOMPQ.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ( LDU.LT.1 ) .OR. ( ( ICOMPQ.EQ.2 ) .AND. ( LDU.LT.
- $ N ) ) ) THEN
- INFO = -7
- ELSE IF( ( LDVT.LT.1 ) .OR. ( ( ICOMPQ.EQ.2 ) .AND. ( LDVT.LT.
- $ N ) ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SBDSDC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- SMLSIZ = ILAENV( 9, 'SBDSDC', ' ', 0, 0, 0, 0 )
- IF( N.EQ.1 ) THEN
- IF( ICOMPQ.EQ.1 ) THEN
- Q( 1 ) = SIGN( ONE, D( 1 ) )
- Q( 1+SMLSIZ*N ) = ONE
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- U( 1, 1 ) = SIGN( ONE, D( 1 ) )
- VT( 1, 1 ) = ONE
- END IF
- D( 1 ) = ABS( D( 1 ) )
- RETURN
- END IF
- NM1 = N - 1
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left
-*
- WSTART = 1
- QSTART = 3
- IF( ICOMPQ.EQ.1 ) THEN
- CALL SCOPY( N, D, 1, Q( 1 ), 1 )
- CALL SCOPY( N-1, E, 1, Q( N+1 ), 1 )
- END IF
- IF( IUPLO.EQ.2 ) THEN
- QSTART = 5
- WSTART = 2*N - 1
- DO 10 I = 1, N - 1
- CALL SLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( ICOMPQ.EQ.1 ) THEN
- Q( I+2*N ) = CS
- Q( I+3*N ) = SN
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- WORK( I ) = CS
- WORK( NM1+I ) = -SN
- END IF
- 10 CONTINUE
- END IF
-*
-* If ICOMPQ = 0, use SLASDQ to compute the singular values.
-*
- IF( ICOMPQ.EQ.0 ) THEN
- CALL SLASDQ( 'U', 0, N, 0, 0, 0, D, E, VT, LDVT, U, LDU, U,
- $ LDU, WORK( WSTART ), INFO )
- GO TO 40
- END IF
-*
-* If N is smaller than the minimum divide size SMLSIZ, then solve
-* the problem with another solver.
-*
- IF( N.LE.SMLSIZ ) THEN
- IF( ICOMPQ.EQ.2 ) THEN
- CALL SLASET( 'A', N, N, ZERO, ONE, U, LDU )
- CALL SLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
- CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
- $ LDU, WORK( WSTART ), INFO )
- ELSE IF( ICOMPQ.EQ.1 ) THEN
- IU = 1
- IVT = IU + N
- CALL SLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
- $ N )
- CALL SLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
- $ N )
- CALL SLASDQ( 'U', 0, N, N, N, 0, D, E,
- $ Q( IVT+( QSTART-1 )*N ), N,
- $ Q( IU+( QSTART-1 )*N ), N,
- $ Q( IU+( QSTART-1 )*N ), N, WORK( WSTART ),
- $ INFO )
- END IF
- GO TO 40
- END IF
-*
- IF( ICOMPQ.EQ.2 ) THEN
- CALL SLASET( 'A', N, N, ZERO, ONE, U, LDU )
- CALL SLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
- END IF
-*
-* Scale.
-*
- ORGNRM = SLANST( 'M', N, D, E )
- IF( ORGNRM.EQ.ZERO )
- $ RETURN
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, IERR )
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, NM1, 1, E, NM1, IERR )
-*
- EPS = SLAMCH( 'Epsilon' )
-*
- MLVL = INT( LOG( REAL( N ) / REAL( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1
- SMLSZP = SMLSIZ + 1
-*
- IF( ICOMPQ.EQ.1 ) THEN
- IU = 1
- IVT = 1 + SMLSIZ
- DIFL = IVT + SMLSZP
- DIFR = DIFL + MLVL
- Z = DIFR + MLVL*2
- IC = Z + MLVL
- IS = IC + 1
- POLES = IS + 1
- GIVNUM = POLES + 2*MLVL
-*
- K = 1
- GIVPTR = 2
- PERM = 3
- GIVCOL = PERM + MLVL
- END IF
-*
- DO 20 I = 1, N
- IF( ABS( D( I ) ).LT.EPS ) THEN
- D( I ) = SIGN( EPS, D( I ) )
- END IF
- 20 CONTINUE
-*
- START = 1
- SQRE = 0
-*
- DO 30 I = 1, NM1
- IF( ( ABS( E( I ) ).LT.EPS ) .OR. ( I.EQ.NM1 ) ) THEN
-*
-* Subproblem found. First determine its size and then
-* apply divide and conquer on it.
-*
- IF( I.LT.NM1 ) THEN
-*
-* A subproblem with E(I) small for I < NM1.
-*
- NSIZE = I - START + 1
- ELSE IF( ABS( E( I ) ).GE.EPS ) THEN
-*
-* A subproblem with E(NM1) not too small but I = NM1.
-*
- NSIZE = N - START + 1
- ELSE
-*
-* A subproblem with E(NM1) small. This implies an
-* 1-by-1 subproblem at D(N). Solve this 1-by-1 problem
-* first.
-*
- NSIZE = I - START + 1
- IF( ICOMPQ.EQ.2 ) THEN
- U( N, N ) = SIGN( ONE, D( N ) )
- VT( N, N ) = ONE
- ELSE IF( ICOMPQ.EQ.1 ) THEN
- Q( N+( QSTART-1 )*N ) = SIGN( ONE, D( N ) )
- Q( N+( SMLSIZ+QSTART-1 )*N ) = ONE
- END IF
- D( N ) = ABS( D( N ) )
- END IF
- IF( ICOMPQ.EQ.2 ) THEN
- CALL SLASD0( NSIZE, SQRE, D( START ), E( START ),
- $ U( START, START ), LDU, VT( START, START ),
- $ LDVT, SMLSIZ, IWORK, WORK( WSTART ), INFO )
- ELSE
- CALL SLASDA( ICOMPQ, SMLSIZ, NSIZE, SQRE, D( START ),
- $ E( START ), Q( START+( IU+QSTART-2 )*N ), N,
- $ Q( START+( IVT+QSTART-2 )*N ),
- $ IQ( START+K*N ), Q( START+( DIFL+QSTART-2 )*
- $ N ), Q( START+( DIFR+QSTART-2 )*N ),
- $ Q( START+( Z+QSTART-2 )*N ),
- $ Q( START+( POLES+QSTART-2 )*N ),
- $ IQ( START+GIVPTR*N ), IQ( START+GIVCOL*N ),
- $ N, IQ( START+PERM*N ),
- $ Q( START+( GIVNUM+QSTART-2 )*N ),
- $ Q( START+( IC+QSTART-2 )*N ),
- $ Q( START+( IS+QSTART-2 )*N ),
- $ WORK( WSTART ), IWORK, INFO )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- START = I + 1
- END IF
- 30 CONTINUE
-*
-* Unscale
-*
- CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, IERR )
- 40 CONTINUE
-*
-* Use Selection Sort to minimize swaps of singular vectors
-*
- DO 60 II = 2, N
- I = II - 1
- KK = I
- P = D( I )
- DO 50 J = II, N
- IF( D( J ).GT.P ) THEN
- KK = J
- P = D( J )
- END IF
- 50 CONTINUE
- IF( KK.NE.I ) THEN
- D( KK ) = D( I )
- D( I ) = P
- IF( ICOMPQ.EQ.1 ) THEN
- IQ( I ) = KK
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- CALL SSWAP( N, U( 1, I ), 1, U( 1, KK ), 1 )
- CALL SSWAP( N, VT( I, 1 ), LDVT, VT( KK, 1 ), LDVT )
- END IF
- ELSE IF( ICOMPQ.EQ.1 ) THEN
- IQ( I ) = I
- END IF
- 60 CONTINUE
-*
-* If ICOMPQ = 1, use IQ(N,1) as the indicator for UPLO
-*
- IF( ICOMPQ.EQ.1 ) THEN
- IF( IUPLO.EQ.1 ) THEN
- IQ( N ) = 1
- ELSE
- IQ( N ) = 0
- END IF
- END IF
-*
-* If B is lower bidiagonal, update U by those Givens rotations
-* which rotated B to be upper bidiagonal
-*
- IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
- $ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
-*
- RETURN
-*
-* End of SBDSDC
-*
- END
diff --git a/netlib/LAPACK/sbdsqr.f b/netlib/LAPACK/sbdsqr.f
deleted file mode 100644
index 6b906bb..0000000
--- a/netlib/LAPACK/sbdsqr.f
+++ /dev/null
@@ -1,850 +0,0 @@
-*> \brief \b SBDSQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SBDSQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sbdsqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sbdsqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sbdsqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
-* LDU, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), D( * ), E( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SBDSQR computes the singular values and, optionally, the right and/or
-*> left singular vectors from the singular value decomposition (SVD) of
-*> a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
-*> zero-shift QR algorithm. The SVD of B has the form
-*>
-*> B = Q * S * P**T
-*>
-*> where S is the diagonal matrix of singular values, Q is an orthogonal
-*> matrix of left singular vectors, and P is an orthogonal matrix of
-*> right singular vectors. If left singular vectors are requested, this
-*> subroutine actually returns U*Q instead of Q, and, if right singular
-*> vectors are requested, this subroutine returns P**T*VT instead of
-*> P**T, for given real input matrices U and VT. When U and VT are the
-*> orthogonal matrices that reduce a general matrix A to bidiagonal
-*> form: A = U*B*VT, as computed by SGEBRD, then
-*>
-*> A = (U*Q) * S * (P**T*VT)
-*>
-*> is the SVD of A. Optionally, the subroutine may also compute Q**T*C
-*> for a given real input matrix C.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices With
-*> Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
-*> LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
-*> no. 5, pp. 873-912, Sept 1990) and
-*> "Accurate singular values and differential qd algorithms," by
-*> B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
-*> Department, University of California at Berkeley, July 1992
-*> for a detailed description of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': B is upper bidiagonal;
-*> = 'L': B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCVT
-*> \verbatim
-*> NCVT is INTEGER
-*> The number of columns of the matrix VT. NCVT >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRU
-*> \verbatim
-*> NRU is INTEGER
-*> The number of rows of the matrix U. NRU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> The number of columns of the matrix C. NCC >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the bidiagonal matrix B.
-*> On exit, if INFO=0, the singular values of B in decreasing
-*> order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the N-1 offdiagonal elements of the bidiagonal
-*> matrix B.
-*> On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
-*> will contain the diagonal and superdiagonal elements of a
-*> bidiagonal matrix orthogonally equivalent to the one given
-*> as input.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT, NCVT)
-*> On entry, an N-by-NCVT matrix VT.
-*> On exit, VT is overwritten by P**T * VT.
-*> Not referenced if NCVT = 0.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT.
-*> LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU, N)
-*> On entry, an NRU-by-N matrix U.
-*> On exit, U is overwritten by U * Q.
-*> Not referenced if NRU = 0.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,NRU).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC, NCC)
-*> On entry, an N-by-NCC matrix C.
-*> On exit, C is overwritten by Q**T * C.
-*> Not referenced if NCC = 0.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C.
-*> LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: If INFO = -i, the i-th argument had an illegal value
-*> > 0:
-*> if NCVT = NRU = NCC = 0,
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 30*N
-*> iterations (in inner while loop)
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> else NCVT = NRU = NCC = 0,
-*> the algorithm did not converge; D and E contain the
-*> elements of a bidiagonal matrix which is orthogonally
-*> similar to the input matrix B; if INFO = i, i
-*> elements of E have not converged to zero.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLMUL REAL, default = max(10,min(100,EPS**(-1/8)))
-*> TOLMUL controls the convergence criterion of the QR loop.
-*> If it is positive, TOLMUL*EPS is the desired relative
-*> precision in the computed singular values.
-*> If it is negative, abs(TOLMUL*EPS*sigma_max) is the
-*> desired absolute accuracy in the computed singular
-*> values (corresponds to relative accuracy
-*> abs(TOLMUL*EPS) in the largest singular value.
-*> abs(TOLMUL) should be between 1 and 1/EPS, and preferably
-*> between 10 (for fast convergence) and .1/EPS
-*> (for there to be some accuracy in the results).
-*> Default is to lose at either one eighth or 2 of the
-*> available decimal digits in each computed singular value
-*> (whichever is smaller).
-*>
-*> MAXITR INTEGER, default = 6
-*> MAXITR controls the maximum number of passes of the
-*> algorithm through its inner loop. The algorithms stops
-*> (and so fails to converge) if the number of passes
-*> through the inner loop exceeds MAXITR*N**2.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
- $ LDU, C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), D( * ), E( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL NEGONE
- PARAMETER ( NEGONE = -1.0E0 )
- REAL HNDRTH
- PARAMETER ( HNDRTH = 0.01E0 )
- REAL TEN
- PARAMETER ( TEN = 10.0E0 )
- REAL HNDRD
- PARAMETER ( HNDRD = 100.0E0 )
- REAL MEIGTH
- PARAMETER ( MEIGTH = -0.125E0 )
- INTEGER MAXITR
- PARAMETER ( MAXITR = 6 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, ROTATE
- INTEGER I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
- $ NM12, NM13, OLDLL, OLDM
- REAL ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
- $ OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
- $ SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
- $ SN, THRESH, TOL, TOLMUL, UNFL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARTG, SLAS2, SLASQ1, SLASR, SLASV2, SROT,
- $ SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, REAL, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NCVT.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -5
- ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
- $ ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
- INFO = -9
- ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
- INFO = -11
- ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
- $ ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SBDSQR', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
- IF( N.EQ.1 )
- $ GO TO 160
-*
-* ROTATE is true if any singular vectors desired, false otherwise
-*
- ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
-*
-* If no singular vectors desired, use qd algorithm
-*
- IF( .NOT.ROTATE ) THEN
- CALL SLASQ1( N, D, E, WORK, INFO )
-*
-* If INFO equals 2, dqds didn't finish, try to finish
-*
- IF( INFO .NE. 2 ) RETURN
- INFO = 0
- END IF
-*
- NM1 = N - 1
- NM12 = NM1 + NM1
- NM13 = NM12 + NM1
- IDIR = 0
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'Epsilon' )
- UNFL = SLAMCH( 'Safe minimum' )
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left
-*
- IF( LOWER ) THEN
- DO 10 I = 1, N - 1
- CALL SLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- WORK( I ) = CS
- WORK( NM1+I ) = SN
- 10 CONTINUE
-*
-* Update singular vectors if desired
-*
- IF( NRU.GT.0 )
- $ CALL SLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U,
- $ LDU )
- IF( NCC.GT.0 )
- $ CALL SLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C,
- $ LDC )
- END IF
-*
-* Compute singular values to relative accuracy TOL
-* (By setting TOL to be negative, algorithm will compute
-* singular values to absolute accuracy ABS(TOL)*norm(input matrix))
-*
- TOLMUL = MAX( TEN, MIN( HNDRD, EPS**MEIGTH ) )
- TOL = TOLMUL*EPS
-*
-* Compute approximate maximum, minimum singular values
-*
- SMAX = ZERO
- DO 20 I = 1, N
- SMAX = MAX( SMAX, ABS( D( I ) ) )
- 20 CONTINUE
- DO 30 I = 1, N - 1
- SMAX = MAX( SMAX, ABS( E( I ) ) )
- 30 CONTINUE
- SMINL = ZERO
- IF( TOL.GE.ZERO ) THEN
-*
-* Relative accuracy desired
-*
- SMINOA = ABS( D( 1 ) )
- IF( SMINOA.EQ.ZERO )
- $ GO TO 50
- MU = SMINOA
- DO 40 I = 2, N
- MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
- SMINOA = MIN( SMINOA, MU )
- IF( SMINOA.EQ.ZERO )
- $ GO TO 50
- 40 CONTINUE
- 50 CONTINUE
- SMINOA = SMINOA / SQRT( REAL( N ) )
- THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
- ELSE
-*
-* Absolute accuracy desired
-*
- THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
- END IF
-*
-* Prepare for main iteration loop for the singular values
-* (MAXIT is the maximum number of passes through the inner
-* loop permitted before nonconvergence signalled.)
-*
- MAXIT = MAXITR*N*N
- ITER = 0
- OLDLL = -1
- OLDM = -1
-*
-* M points to last element of unconverged part of matrix
-*
- M = N
-*
-* Begin main iteration loop
-*
- 60 CONTINUE
-*
-* Check for convergence or exceeding iteration count
-*
- IF( M.LE.1 )
- $ GO TO 160
- IF( ITER.GT.MAXIT )
- $ GO TO 200
-*
-* Find diagonal block of matrix to work on
-*
- IF( TOL.LT.ZERO .AND. ABS( D( M ) ).LE.THRESH )
- $ D( M ) = ZERO
- SMAX = ABS( D( M ) )
- SMIN = SMAX
- DO 70 LLL = 1, M - 1
- LL = M - LLL
- ABSS = ABS( D( LL ) )
- ABSE = ABS( E( LL ) )
- IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
- $ D( LL ) = ZERO
- IF( ABSE.LE.THRESH )
- $ GO TO 80
- SMIN = MIN( SMIN, ABSS )
- SMAX = MAX( SMAX, ABSS, ABSE )
- 70 CONTINUE
- LL = 0
- GO TO 90
- 80 CONTINUE
- E( LL ) = ZERO
-*
-* Matrix splits since E(LL) = 0
-*
- IF( LL.EQ.M-1 ) THEN
-*
-* Convergence of bottom singular value, return to top of loop
-*
- M = M - 1
- GO TO 60
- END IF
- 90 CONTINUE
- LL = LL + 1
-*
-* E(LL) through E(M-1) are nonzero, E(LL-1) is zero
-*
- IF( LL.EQ.M-1 ) THEN
-*
-* 2 by 2 block, handle separately
-*
- CALL SLASV2( D( M-1 ), E( M-1 ), D( M ), SIGMN, SIGMX, SINR,
- $ COSR, SINL, COSL )
- D( M-1 ) = SIGMX
- E( M-1 ) = ZERO
- D( M ) = SIGMN
-*
-* Compute singular vectors, if desired
-*
- IF( NCVT.GT.0 )
- $ CALL SROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR,
- $ SINR )
- IF( NRU.GT.0 )
- $ CALL SROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
- IF( NCC.GT.0 )
- $ CALL SROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
- $ SINL )
- M = M - 2
- GO TO 60
- END IF
-*
-* If working on new submatrix, choose shift direction
-* (from larger end diagonal element towards smaller)
-*
- IF( LL.GT.OLDM .OR. M.LT.OLDLL ) THEN
- IF( ABS( D( LL ) ).GE.ABS( D( M ) ) ) THEN
-*
-* Chase bulge from top (big end) to bottom (small end)
-*
- IDIR = 1
- ELSE
-*
-* Chase bulge from bottom (big end) to top (small end)
-*
- IDIR = 2
- END IF
- END IF
-*
-* Apply convergence tests
-*
- IF( IDIR.EQ.1 ) THEN
-*
-* Run convergence test in forward direction
-* First apply standard test to bottom of matrix
-*
- IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
- $ ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
- E( M-1 ) = ZERO
- GO TO 60
- END IF
-*
- IF( TOL.GE.ZERO ) THEN
-*
-* If relative accuracy desired,
-* apply convergence criterion forward
-*
- MU = ABS( D( LL ) )
- SMINL = MU
- DO 100 LLL = LL, M - 1
- IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
- E( LLL ) = ZERO
- GO TO 60
- END IF
- MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
- SMINL = MIN( SMINL, MU )
- 100 CONTINUE
- END IF
-*
- ELSE
-*
-* Run convergence test in backward direction
-* First apply standard test to top of matrix
-*
- IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
- $ ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
- E( LL ) = ZERO
- GO TO 60
- END IF
-*
- IF( TOL.GE.ZERO ) THEN
-*
-* If relative accuracy desired,
-* apply convergence criterion backward
-*
- MU = ABS( D( M ) )
- SMINL = MU
- DO 110 LLL = M - 1, LL, -1
- IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
- E( LLL ) = ZERO
- GO TO 60
- END IF
- MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
- SMINL = MIN( SMINL, MU )
- 110 CONTINUE
- END IF
- END IF
- OLDLL = LL
- OLDM = M
-*
-* Compute shift. First, test if shifting would ruin relative
-* accuracy, and if so set the shift to zero.
-*
- IF( TOL.GE.ZERO .AND. N*TOL*( SMINL / SMAX ).LE.
- $ MAX( EPS, HNDRTH*TOL ) ) THEN
-*
-* Use a zero shift to avoid loss of relative accuracy
-*
- SHIFT = ZERO
- ELSE
-*
-* Compute the shift from 2-by-2 block at end of matrix
-*
- IF( IDIR.EQ.1 ) THEN
- SLL = ABS( D( LL ) )
- CALL SLAS2( D( M-1 ), E( M-1 ), D( M ), SHIFT, R )
- ELSE
- SLL = ABS( D( M ) )
- CALL SLAS2( D( LL ), E( LL ), D( LL+1 ), SHIFT, R )
- END IF
-*
-* Test if shift negligible, and if so set to zero
-*
- IF( SLL.GT.ZERO ) THEN
- IF( ( SHIFT / SLL )**2.LT.EPS )
- $ SHIFT = ZERO
- END IF
- END IF
-*
-* Increment iteration count
-*
- ITER = ITER + M - LL
-*
-* If SHIFT = 0, do simplified QR iteration
-*
- IF( SHIFT.EQ.ZERO ) THEN
- IF( IDIR.EQ.1 ) THEN
-*
-* Chase bulge from top to bottom
-* Save cosines and sines for later singular vector updates
-*
- CS = ONE
- OLDCS = ONE
- DO 120 I = LL, M - 1
- CALL SLARTG( D( I )*CS, E( I ), CS, SN, R )
- IF( I.GT.LL )
- $ E( I-1 ) = OLDSN*R
- CALL SLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
- WORK( I-LL+1 ) = CS
- WORK( I-LL+1+NM1 ) = SN
- WORK( I-LL+1+NM12 ) = OLDCS
- WORK( I-LL+1+NM13 ) = OLDSN
- 120 CONTINUE
- H = D( M )*CS
- D( M ) = H*OLDCS
- E( M-1 ) = H*OLDSN
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
- $ WORK( N ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL SLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
- $ WORK( NM13+1 ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
- $ WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( M-1 ) ).LE.THRESH )
- $ E( M-1 ) = ZERO
-*
- ELSE
-*
-* Chase bulge from bottom to top
-* Save cosines and sines for later singular vector updates
-*
- CS = ONE
- OLDCS = ONE
- DO 130 I = M, LL + 1, -1
- CALL SLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
- IF( I.LT.M )
- $ E( I ) = OLDSN*R
- CALL SLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
- WORK( I-LL ) = CS
- WORK( I-LL+NM1 ) = -SN
- WORK( I-LL+NM12 ) = OLDCS
- WORK( I-LL+NM13 ) = -OLDSN
- 130 CONTINUE
- H = D( LL )*CS
- D( LL ) = H*OLDCS
- E( LL ) = H*OLDSN
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
- $ WORK( NM13+1 ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL SLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
- $ WORK( N ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
- $ WORK( N ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( LL ) ).LE.THRESH )
- $ E( LL ) = ZERO
- END IF
- ELSE
-*
-* Use nonzero shift
-*
- IF( IDIR.EQ.1 ) THEN
-*
-* Chase bulge from top to bottom
-* Save cosines and sines for later singular vector updates
-*
- F = ( ABS( D( LL ) )-SHIFT )*
- $ ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
- G = E( LL )
- DO 140 I = LL, M - 1
- CALL SLARTG( F, G, COSR, SINR, R )
- IF( I.GT.LL )
- $ E( I-1 ) = R
- F = COSR*D( I ) + SINR*E( I )
- E( I ) = COSR*E( I ) - SINR*D( I )
- G = SINR*D( I+1 )
- D( I+1 ) = COSR*D( I+1 )
- CALL SLARTG( F, G, COSL, SINL, R )
- D( I ) = R
- F = COSL*E( I ) + SINL*D( I+1 )
- D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
- IF( I.LT.M-1 ) THEN
- G = SINL*E( I+1 )
- E( I+1 ) = COSL*E( I+1 )
- END IF
- WORK( I-LL+1 ) = COSR
- WORK( I-LL+1+NM1 ) = SINR
- WORK( I-LL+1+NM12 ) = COSL
- WORK( I-LL+1+NM13 ) = SINL
- 140 CONTINUE
- E( M-1 ) = F
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
- $ WORK( N ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL SLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
- $ WORK( NM13+1 ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
- $ WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( M-1 ) ).LE.THRESH )
- $ E( M-1 ) = ZERO
-*
- ELSE
-*
-* Chase bulge from bottom to top
-* Save cosines and sines for later singular vector updates
-*
- F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
- $ D( M ) )
- G = E( M-1 )
- DO 150 I = M, LL + 1, -1
- CALL SLARTG( F, G, COSR, SINR, R )
- IF( I.LT.M )
- $ E( I ) = R
- F = COSR*D( I ) + SINR*E( I-1 )
- E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
- G = SINR*D( I-1 )
- D( I-1 ) = COSR*D( I-1 )
- CALL SLARTG( F, G, COSL, SINL, R )
- D( I ) = R
- F = COSL*E( I-1 ) + SINL*D( I-1 )
- D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
- IF( I.GT.LL+1 ) THEN
- G = SINL*E( I-2 )
- E( I-2 ) = COSL*E( I-2 )
- END IF
- WORK( I-LL ) = COSR
- WORK( I-LL+NM1 ) = -SINR
- WORK( I-LL+NM12 ) = COSL
- WORK( I-LL+NM13 ) = -SINL
- 150 CONTINUE
- E( LL ) = F
-*
-* Test convergence
-*
- IF( ABS( E( LL ) ).LE.THRESH )
- $ E( LL ) = ZERO
-*
-* Update singular vectors if desired
-*
- IF( NCVT.GT.0 )
- $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
- $ WORK( NM13+1 ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL SLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
- $ WORK( N ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
- $ WORK( N ), C( LL, 1 ), LDC )
- END IF
- END IF
-*
-* QR iteration finished, go back and check convergence
-*
- GO TO 60
-*
-* All singular values converged, so make them positive
-*
- 160 CONTINUE
- DO 170 I = 1, N
- IF( D( I ).LT.ZERO ) THEN
- D( I ) = -D( I )
-*
-* Change sign of singular vectors, if desired
-*
- IF( NCVT.GT.0 )
- $ CALL SSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
- END IF
- 170 CONTINUE
-*
-* Sort the singular values into decreasing order (insertion sort on
-* singular values, but only one transposition per singular vector)
-*
- DO 190 I = 1, N - 1
-*
-* Scan for smallest D(I)
-*
- ISUB = 1
- SMIN = D( 1 )
- DO 180 J = 2, N + 1 - I
- IF( D( J ).LE.SMIN ) THEN
- ISUB = J
- SMIN = D( J )
- END IF
- 180 CONTINUE
- IF( ISUB.NE.N+1-I ) THEN
-*
-* Swap singular values and vectors
-*
- D( ISUB ) = D( N+1-I )
- D( N+1-I ) = SMIN
- IF( NCVT.GT.0 )
- $ CALL SSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
- $ LDVT )
- IF( NRU.GT.0 )
- $ CALL SSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
- IF( NCC.GT.0 )
- $ CALL SSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
- END IF
- 190 CONTINUE
- GO TO 220
-*
-* Maximum number of iterations exceeded, failure to converge
-*
- 200 CONTINUE
- INFO = 0
- DO 210 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 210 CONTINUE
- 220 CONTINUE
- RETURN
-*
-* End of SBDSQR
-*
- END
diff --git a/netlib/LAPACK/scsum1.f b/netlib/LAPACK/scsum1.f
deleted file mode 100644
index 2fbb911..0000000
--- a/netlib/LAPACK/scsum1.f
+++ /dev/null
@@ -1,140 +0,0 @@
-*> \brief \b SCSUM1 forms the 1-norm of the complex vector using the true absolute value.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SCSUM1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/scsum1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/scsum1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/scsum1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SCSUM1( N, CX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX CX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SCSUM1 takes the sum of the absolute values of a complex
-*> vector and returns a single precision result.
-*>
-*> Based on SCASUM from the Level 1 BLAS.
-*> The change is to use the 'genuine' absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements in the vector CX.
-*> \endverbatim
-*>
-*> \param[in] CX
-*> \verbatim
-*> CX is COMPLEX array, dimension (N)
-*> The vector whose elements will be summed.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive values of CX. INCX > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup complexOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham for use with CLACON.
-*
-* =====================================================================
- REAL FUNCTION SCSUM1( N, CX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX CX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, NINCX
- REAL STEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- SCSUM1 = 0.0E0
- STEMP = 0.0E0
- IF( N.LE.0 )
- $ RETURN
- IF( INCX.EQ.1 )
- $ GO TO 20
-*
-* CODE FOR INCREMENT NOT EQUAL TO 1
-*
- NINCX = N*INCX
- DO 10 I = 1, NINCX, INCX
-*
-* NEXT LINE MODIFIED.
-*
- STEMP = STEMP + ABS( CX( I ) )
- 10 CONTINUE
- SCSUM1 = STEMP
- RETURN
-*
-* CODE FOR INCREMENT EQUAL TO 1
-*
- 20 CONTINUE
- DO 30 I = 1, N
-*
-* NEXT LINE MODIFIED.
-*
- STEMP = STEMP + ABS( CX( I ) )
- 30 CONTINUE
- SCSUM1 = STEMP
- RETURN
-*
-* End of SCSUM1
-*
- END
diff --git a/netlib/LAPACK/sdisna.f b/netlib/LAPACK/sdisna.f
deleted file mode 100644
index d6d2d16..0000000
--- a/netlib/LAPACK/sdisna.f
+++ /dev/null
@@ -1,245 +0,0 @@
-*> \brief \b SDISNA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SDISNA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sdisna.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sdisna.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sdisna.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SDISNA( JOB, M, N, D, SEP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER INFO, M, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), SEP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SDISNA computes the reciprocal condition numbers for the eigenvectors
-*> of a real symmetric or complex Hermitian matrix or for the left or
-*> right singular vectors of a general m-by-n matrix. The reciprocal
-*> condition number is the 'gap' between the corresponding eigenvalue or
-*> singular value and the nearest other one.
-*>
-*> The bound on the error, measured by angle in radians, in the I-th
-*> computed vector is given by
-*>
-*> SLAMCH( 'E' ) * ( ANORM / SEP( I ) )
-*>
-*> where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
-*> to be smaller than SLAMCH( 'E' )*ANORM in order to limit the size of
-*> the error bound.
-*>
-*> SDISNA may also be used to compute error bounds for eigenvectors of
-*> the generalized symmetric definite eigenproblem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies for which problem the reciprocal condition numbers
-*> should be computed:
-*> = 'E': the eigenvectors of a symmetric/Hermitian matrix;
-*> = 'L': the left singular vectors of a general matrix;
-*> = 'R': the right singular vectors of a general matrix.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> If JOB = 'L' or 'R', the number of columns of the matrix,
-*> in which case N >= 0. Ignored if JOB = 'E'.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (M) if JOB = 'E'
-*> dimension (min(M,N)) if JOB = 'L' or 'R'
-*> The eigenvalues (if JOB = 'E') or singular values (if JOB =
-*> 'L' or 'R') of the matrix, in either increasing or decreasing
-*> order. If singular values, they must be non-negative.
-*> \endverbatim
-*>
-*> \param[out] SEP
-*> \verbatim
-*> SEP is REAL array, dimension (M) if JOB = 'E'
-*> dimension (min(M,N)) if JOB = 'L' or 'R'
-*> The reciprocal condition numbers of the vectors.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SDISNA( JOB, M, N, D, SEP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER INFO, M, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), SEP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DECR, EIGEN, INCR, LEFT, RIGHT, SING
- INTEGER I, K
- REAL ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- EIGEN = LSAME( JOB, 'E' )
- LEFT = LSAME( JOB, 'L' )
- RIGHT = LSAME( JOB, 'R' )
- SING = LEFT .OR. RIGHT
- IF( EIGEN ) THEN
- K = M
- ELSE IF( SING ) THEN
- K = MIN( M, N )
- END IF
- IF( .NOT.EIGEN .AND. .NOT.SING ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( K.LT.0 ) THEN
- INFO = -3
- ELSE
- INCR = .TRUE.
- DECR = .TRUE.
- DO 10 I = 1, K - 1
- IF( INCR )
- $ INCR = INCR .AND. D( I ).LE.D( I+1 )
- IF( DECR )
- $ DECR = DECR .AND. D( I ).GE.D( I+1 )
- 10 CONTINUE
- IF( SING .AND. K.GT.0 ) THEN
- IF( INCR )
- $ INCR = INCR .AND. ZERO.LE.D( 1 )
- IF( DECR )
- $ DECR = DECR .AND. D( K ).GE.ZERO
- END IF
- IF( .NOT.( INCR .OR. DECR ) )
- $ INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SDISNA', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 )
- $ RETURN
-*
-* Compute reciprocal condition numbers
-*
- IF( K.EQ.1 ) THEN
- SEP( 1 ) = SLAMCH( 'O' )
- ELSE
- OLDGAP = ABS( D( 2 )-D( 1 ) )
- SEP( 1 ) = OLDGAP
- DO 20 I = 2, K - 1
- NEWGAP = ABS( D( I+1 )-D( I ) )
- SEP( I ) = MIN( OLDGAP, NEWGAP )
- OLDGAP = NEWGAP
- 20 CONTINUE
- SEP( K ) = OLDGAP
- END IF
- IF( SING ) THEN
- IF( ( LEFT .AND. M.GT.N ) .OR. ( RIGHT .AND. M.LT.N ) ) THEN
- IF( INCR )
- $ SEP( 1 ) = MIN( SEP( 1 ), D( 1 ) )
- IF( DECR )
- $ SEP( K ) = MIN( SEP( K ), D( K ) )
- END IF
- END IF
-*
-* Ensure that reciprocal condition numbers are not less than
-* threshold, in order to limit the size of the error bound
-*
- EPS = SLAMCH( 'E' )
- SAFMIN = SLAMCH( 'S' )
- ANORM = MAX( ABS( D( 1 ) ), ABS( D( K ) ) )
- IF( ANORM.EQ.ZERO ) THEN
- THRESH = EPS
- ELSE
- THRESH = MAX( EPS*ANORM, SAFMIN )
- END IF
- DO 30 I = 1, K
- SEP( I ) = MAX( SEP( I ), THRESH )
- 30 CONTINUE
-*
- RETURN
-*
-* End of SDISNA
-*
- END
diff --git a/netlib/LAPACK/sgbbrd.f b/netlib/LAPACK/sgbbrd.f
deleted file mode 100644
index f5d3fd2..0000000
--- a/netlib/LAPACK/sgbbrd.f
+++ /dev/null
@@ -1,547 +0,0 @@
-*> \brief \b SGBBRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBBRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbbrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbbrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbbrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q,
-* LDQ, PT, LDPT, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER VECT
-* INTEGER INFO, KL, KU, LDAB, LDC, LDPT, LDQ, M, N, NCC
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), C( LDC, * ), D( * ), E( * ),
-* $ PT( LDPT, * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBBRD reduces a real general m-by-n band matrix A to upper
-*> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*>
-*> The routine computes B, and optionally forms Q or P**T, or computes
-*> Q**T*C for a given matrix C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> Specifies whether or not the matrices Q and P**T are to be
-*> formed.
-*> = 'N': do not form Q or P**T;
-*> = 'Q': form Q only;
-*> = 'P': form P**T only;
-*> = 'B': form both.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> The number of columns of the matrix C. NCC >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals of the matrix A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals of the matrix A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the m-by-n band matrix A, stored in rows 1 to
-*> KL+KU+1. The j-th column of A is stored in the j-th column of
-*> the array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
-*> On exit, A is overwritten by values generated during the
-*> reduction.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B.
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (min(M,N)-1)
-*> The superdiagonal elements of the bidiagonal matrix B.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,M)
-*> If VECT = 'Q' or 'B', the m-by-m orthogonal matrix Q.
-*> If VECT = 'N' or 'P', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] PT
-*> \verbatim
-*> PT is REAL array, dimension (LDPT,N)
-*> If VECT = 'P' or 'B', the n-by-n orthogonal matrix P'.
-*> If VECT = 'N' or 'Q', the array PT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDPT
-*> \verbatim
-*> LDPT is INTEGER
-*> The leading dimension of the array PT.
-*> LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,NCC)
-*> On entry, an m-by-ncc matrix C.
-*> On exit, C is overwritten by Q**T*C.
-*> C is not referenced if NCC = 0.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C.
-*> LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*max(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q,
- $ LDQ, PT, LDPT, C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER VECT
- INTEGER INFO, KL, KU, LDAB, LDC, LDPT, LDQ, M, N, NCC
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), C( LDC, * ), D( * ), E( * ),
- $ PT( LDPT, * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTB, WANTC, WANTPT, WANTQ
- INTEGER I, INCA, J, J1, J2, KB, KB1, KK, KLM, KLU1,
- $ KUN, L, MINMN, ML, ML0, MN, MU, MU0, NR, NRT
- REAL RA, RB, RC, RS
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARGV, SLARTG, SLARTV, SLASET, SROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTB = LSAME( VECT, 'B' )
- WANTQ = LSAME( VECT, 'Q' ) .OR. WANTB
- WANTPT = LSAME( VECT, 'P' ) .OR. WANTB
- WANTC = NCC.GT.0
- KLU1 = KL + KU + 1
- INFO = 0
- IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. .NOT.LSAME( VECT, 'N' ) )
- $ THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -4
- ELSE IF( KL.LT.0 ) THEN
- INFO = -5
- ELSE IF( KU.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KLU1 ) THEN
- INFO = -8
- ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. LDQ.LT.MAX( 1, M ) ) THEN
- INFO = -12
- ELSE IF( LDPT.LT.1 .OR. WANTPT .AND. LDPT.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDC.LT.1 .OR. WANTC .AND. LDC.LT.MAX( 1, M ) ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBBRD', -INFO )
- RETURN
- END IF
-*
-* Initialize Q and P**T to the unit matrix, if needed
-*
- IF( WANTQ )
- $ CALL SLASET( 'Full', M, M, ZERO, ONE, Q, LDQ )
- IF( WANTPT )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, PT, LDPT )
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- MINMN = MIN( M, N )
-*
- IF( KL+KU.GT.1 ) THEN
-*
-* Reduce to upper bidiagonal form if KU > 0; if KU = 0, reduce
-* first to lower bidiagonal form and then transform to upper
-* bidiagonal
-*
- IF( KU.GT.0 ) THEN
- ML0 = 1
- MU0 = 2
- ELSE
- ML0 = 2
- MU0 = 1
- END IF
-*
-* Wherever possible, plane rotations are generated and applied in
-* vector operations of length NR over the index set J1:J2:KLU1.
-*
-* The sines of the plane rotations are stored in WORK(1:max(m,n))
-* and the cosines in WORK(max(m,n)+1:2*max(m,n)).
-*
- MN = MAX( M, N )
- KLM = MIN( M-1, KL )
- KUN = MIN( N-1, KU )
- KB = KLM + KUN
- KB1 = KB + 1
- INCA = KB1*LDAB
- NR = 0
- J1 = KLM + 2
- J2 = 1 - KUN
-*
- DO 90 I = 1, MINMN
-*
-* Reduce i-th column and i-th row of matrix to bidiagonal form
-*
- ML = KLM + 1
- MU = KUN + 1
- DO 80 KK = 1, KB
- J1 = J1 + KB
- J2 = J2 + KB
-*
-* generate plane rotations to annihilate nonzero elements
-* which have been created below the band
-*
- IF( NR.GT.0 )
- $ CALL SLARGV( NR, AB( KLU1, J1-KLM-1 ), INCA,
- $ WORK( J1 ), KB1, WORK( MN+J1 ), KB1 )
-*
-* apply plane rotations from the left
-*
- DO 10 L = 1, KB
- IF( J2-KLM+L-1.GT.N ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), INCA,
- $ AB( KLU1-L+1, J1-KLM+L-1 ), INCA,
- $ WORK( MN+J1 ), WORK( J1 ), KB1 )
- 10 CONTINUE
-*
- IF( ML.GT.ML0 ) THEN
- IF( ML.LE.M-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i+ml-1,i)
-* within the band, and apply rotation from the left
-*
- CALL SLARTG( AB( KU+ML-1, I ), AB( KU+ML, I ),
- $ WORK( MN+I+ML-1 ), WORK( I+ML-1 ),
- $ RA )
- AB( KU+ML-1, I ) = RA
- IF( I.LT.N )
- $ CALL SROT( MIN( KU+ML-2, N-I ),
- $ AB( KU+ML-2, I+1 ), LDAB-1,
- $ AB( KU+ML-1, I+1 ), LDAB-1,
- $ WORK( MN+I+ML-1 ), WORK( I+ML-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KB1
- END IF
-*
- IF( WANTQ ) THEN
-*
-* accumulate product of plane rotations in Q
-*
- DO 20 J = J1, J2, KB1
- CALL SROT( M, Q( 1, J-1 ), 1, Q( 1, J ), 1,
- $ WORK( MN+J ), WORK( J ) )
- 20 CONTINUE
- END IF
-*
- IF( WANTC ) THEN
-*
-* apply plane rotations to C
-*
- DO 30 J = J1, J2, KB1
- CALL SROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), LDC,
- $ WORK( MN+J ), WORK( J ) )
- 30 CONTINUE
- END IF
-*
- IF( J2+KUN.GT.N ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KB1
- END IF
-*
- DO 40 J = J1, J2, KB1
-*
-* create nonzero element a(j-1,j+ku) above the band
-* and store it in WORK(n+1:2*n)
-*
- WORK( J+KUN ) = WORK( J )*AB( 1, J+KUN )
- AB( 1, J+KUN ) = WORK( MN+J )*AB( 1, J+KUN )
- 40 CONTINUE
-*
-* generate plane rotations to annihilate nonzero elements
-* which have been generated above the band
-*
- IF( NR.GT.0 )
- $ CALL SLARGV( NR, AB( 1, J1+KUN-1 ), INCA,
- $ WORK( J1+KUN ), KB1, WORK( MN+J1+KUN ),
- $ KB1 )
-*
-* apply plane rotations from the right
-*
- DO 50 L = 1, KB
- IF( J2+L-1.GT.M ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L+1, J1+KUN-1 ), INCA,
- $ AB( L, J1+KUN ), INCA,
- $ WORK( MN+J1+KUN ), WORK( J1+KUN ),
- $ KB1 )
- 50 CONTINUE
-*
- IF( ML.EQ.ML0 .AND. MU.GT.MU0 ) THEN
- IF( MU.LE.N-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i,i+mu-1)
-* within the band, and apply rotation from the right
-*
- CALL SLARTG( AB( KU-MU+3, I+MU-2 ),
- $ AB( KU-MU+2, I+MU-1 ),
- $ WORK( MN+I+MU-1 ), WORK( I+MU-1 ),
- $ RA )
- AB( KU-MU+3, I+MU-2 ) = RA
- CALL SROT( MIN( KL+MU-2, M-I ),
- $ AB( KU-MU+4, I+MU-2 ), 1,
- $ AB( KU-MU+3, I+MU-1 ), 1,
- $ WORK( MN+I+MU-1 ), WORK( I+MU-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KB1
- END IF
-*
- IF( WANTPT ) THEN
-*
-* accumulate product of plane rotations in P**T
-*
- DO 60 J = J1, J2, KB1
- CALL SROT( N, PT( J+KUN-1, 1 ), LDPT,
- $ PT( J+KUN, 1 ), LDPT, WORK( MN+J+KUN ),
- $ WORK( J+KUN ) )
- 60 CONTINUE
- END IF
-*
- IF( J2+KB.GT.M ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KB1
- END IF
-*
- DO 70 J = J1, J2, KB1
-*
-* create nonzero element a(j+kl+ku,j+ku-1) below the
-* band and store it in WORK(1:n)
-*
- WORK( J+KB ) = WORK( J+KUN )*AB( KLU1, J+KUN )
- AB( KLU1, J+KUN ) = WORK( MN+J+KUN )*AB( KLU1, J+KUN )
- 70 CONTINUE
-*
- IF( ML.GT.ML0 ) THEN
- ML = ML - 1
- ELSE
- MU = MU - 1
- END IF
- 80 CONTINUE
- 90 CONTINUE
- END IF
-*
- IF( KU.EQ.0 .AND. KL.GT.0 ) THEN
-*
-* A has been reduced to lower bidiagonal form
-*
-* Transform lower bidiagonal form to upper bidiagonal by applying
-* plane rotations from the left, storing diagonal elements in D
-* and off-diagonal elements in E
-*
- DO 100 I = 1, MIN( M-1, N )
- CALL SLARTG( AB( 1, I ), AB( 2, I ), RC, RS, RA )
- D( I ) = RA
- IF( I.LT.N ) THEN
- E( I ) = RS*AB( 1, I+1 )
- AB( 1, I+1 ) = RC*AB( 1, I+1 )
- END IF
- IF( WANTQ )
- $ CALL SROT( M, Q( 1, I ), 1, Q( 1, I+1 ), 1, RC, RS )
- IF( WANTC )
- $ CALL SROT( NCC, C( I, 1 ), LDC, C( I+1, 1 ), LDC, RC,
- $ RS )
- 100 CONTINUE
- IF( M.LE.N )
- $ D( M ) = AB( 1, M )
- ELSE IF( KU.GT.0 ) THEN
-*
-* A has been reduced to upper bidiagonal form
-*
- IF( M.LT.N ) THEN
-*
-* Annihilate a(m,m+1) by applying plane rotations from the
-* right, storing diagonal elements in D and off-diagonal
-* elements in E
-*
- RB = AB( KU, M+1 )
- DO 110 I = M, 1, -1
- CALL SLARTG( AB( KU+1, I ), RB, RC, RS, RA )
- D( I ) = RA
- IF( I.GT.1 ) THEN
- RB = -RS*AB( KU, I )
- E( I-1 ) = RC*AB( KU, I )
- END IF
- IF( WANTPT )
- $ CALL SROT( N, PT( I, 1 ), LDPT, PT( M+1, 1 ), LDPT,
- $ RC, RS )
- 110 CONTINUE
- ELSE
-*
-* Copy off-diagonal elements to E and diagonal elements to D
-*
- DO 120 I = 1, MINMN - 1
- E( I ) = AB( KU, I+1 )
- 120 CONTINUE
- DO 130 I = 1, MINMN
- D( I ) = AB( KU+1, I )
- 130 CONTINUE
- END IF
- ELSE
-*
-* A is diagonal. Set elements of E to zero and copy diagonal
-* elements to D.
-*
- DO 140 I = 1, MINMN - 1
- E( I ) = ZERO
- 140 CONTINUE
- DO 150 I = 1, MINMN
- D( I ) = AB( 1, I )
- 150 CONTINUE
- END IF
- RETURN
-*
-* End of SGBBRD
-*
- END
diff --git a/netlib/LAPACK/sgbcon.f b/netlib/LAPACK/sgbcon.f
deleted file mode 100644
index 4301feb..0000000
--- a/netlib/LAPACK/sgbcon.f
+++ /dev/null
@@ -1,311 +0,0 @@
-*> \brief \b SGBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, KL, KU, LDAB, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBCON estimates the reciprocal of the condition number of a real
-*> general band matrix A, in either the 1-norm or the infinity-norm,
-*> using the LU factorization computed by SGBTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by SGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, KL, KU, LDAB, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, ONENRM
- CHARACTER NORMIN
- INTEGER IX, J, JP, KASE, KASE1, KD, LM
- REAL AINVNM, SCALE, SMLNUM, T
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SDOT, SLAMCH
- EXTERNAL LSAME, ISAMAX, SDOT, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SLACN2, SLATBS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = SLAMCH( 'Safe minimum' )
-*
-* Estimate the norm of inv(A).
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KD = KL + KU + 1
- LNOTI = KL.GT.0
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(L).
-*
- IF( LNOTI ) THEN
- DO 20 J = 1, N - 1
- LM = MIN( KL, N-J )
- JP = IPIV( J )
- T = WORK( JP )
- IF( JP.NE.J ) THEN
- WORK( JP ) = WORK( J )
- WORK( J ) = T
- END IF
- CALL SAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 )
- 20 CONTINUE
- END IF
-*
-* Multiply by inv(U).
-*
- CALL SLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),
- $ INFO )
- ELSE
-*
-* Multiply by inv(U**T).
-*
- CALL SLATBS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),
- $ INFO )
-*
-* Multiply by inv(L**T).
-*
- IF( LNOTI ) THEN
- DO 30 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- WORK( J ) = WORK( J ) - SDOT( LM, AB( KD+1, J ), 1,
- $ WORK( J+1 ), 1 )
- JP = IPIV( J )
- IF( JP.NE.J ) THEN
- T = WORK( JP )
- WORK( JP ) = WORK( J )
- WORK( J ) = T
- END IF
- 30 CONTINUE
- END IF
- END IF
-*
-* Divide X by 1/SCALE if doing so will not cause overflow.
-*
- NORMIN = 'Y'
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 40
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 40 CONTINUE
- RETURN
-*
-* End of SGBCON
-*
- END
diff --git a/netlib/LAPACK/sgbequ.f b/netlib/LAPACK/sgbequ.f
deleted file mode 100644
index 3d7a36c..0000000
--- a/netlib/LAPACK/sgbequ.f
+++ /dev/null
@@ -1,324 +0,0 @@
-*> \brief \b SGBEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBEQU computes row and column scalings intended to equilibrate an
-*> M-by-N band matrix A and reduce its condition number. R returns the
-*> row scale factors and C the column scale factors, chosen to try to
-*> make the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
-*>
-*> R(i) and C(j) are restricted to be between SMLNUM = smallest safe
-*> number and BIGNUM = largest safe number. Use of these scaling
-*> factors is not guaranteed to reduce the condition number of A but
-*> works well in practice.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th
-*> column of A is stored in the j-th column of the array AB as
-*> follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL array, dimension (M)
-*> If INFO = 0, or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is REAL
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is REAL
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
- REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, KD
- REAL BIGNUM, RCMAX, RCMIN, SMLNUM
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- KD = KU + 1
- DO 30 J = 1, N
- DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- R( I ) = MAX( R( I ), ABS( AB( KD+I-J, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I))
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- KD = KU + 1
- DO 90 J = 1, N
- DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- C( J ) = MAX( C( J ), ABS( AB( KD+I-J, J ) )*R( I ) )
- 80 CONTINUE
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J))
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of SGBEQU
-*
- END
diff --git a/netlib/LAPACK/sgbequb.f b/netlib/LAPACK/sgbequb.f
deleted file mode 100644
index d1effd9..0000000
--- a/netlib/LAPACK/sgbequb.f
+++ /dev/null
@@ -1,340 +0,0 @@
-*> \brief \b SGBEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBEQUB computes row and column scalings intended to equilibrate an
-*> M-by-N matrix A and reduce its condition number. R returns the row
-*> scale factors and C the column scale factors, chosen to try to make
-*> the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
-*> the radix.
-*>
-*> R(i) and C(j) are restricted to be a power of the radix between
-*> SMLNUM = smallest safe number and BIGNUM = largest safe number. Use
-*> of these scaling factors is not guaranteed to reduce the condition
-*> number of A but works well in practice.
-*>
-*> This routine differs from SGEEQU by restricting the scaling factors
-*> to a power of the radix. Baring over- and underflow, scaling by
-*> these factors introduces no additional rounding errors. However, the
-*> scaled entries' magnitured are no longer approximately 1 but lie
-*> between sqrt(radix) and 1/sqrt(radix).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is REAL
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is REAL
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
- REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, KD
- REAL BIGNUM, RCMAX, RCMIN, SMLNUM, RADIX, LOGRDX
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, LOG
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBEQUB', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants. Assume SMLNUM is a power of the radix.
-*
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- RADIX = SLAMCH( 'B' )
- LOGRDX = LOG(RADIX)
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- KD = KU + 1
- DO 30 J = 1, N
- DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- R( I ) = MAX( R( I ), ABS( AB( KD+I-J, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
- DO I = 1, M
- IF( R( I ).GT.ZERO ) THEN
- R( I ) = RADIX**INT( LOG( R( I ) ) / LOGRDX )
- END IF
- END DO
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I)).
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors.
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- C( J ) = MAX( C( J ), ABS( AB( KD+I-J, J ) )*R( I ) )
- 80 CONTINUE
- IF( C( J ).GT.ZERO ) THEN
- C( J ) = RADIX**INT( LOG( C( J ) ) / LOGRDX )
- END IF
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J)).
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of SGBEQUB
-*
- END
diff --git a/netlib/LAPACK/sgbrfs.f b/netlib/LAPACK/sgbrfs.f
deleted file mode 100644
index 514aeb0..0000000
--- a/netlib/LAPACK/sgbrfs.f
+++ /dev/null
@@ -1,464 +0,0 @@
-*> \brief \b SGBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
-* IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is banded, and provides
-*> error bounds and backward error estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The original band matrix A, stored in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is REAL array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by SGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from SGBTRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SGBTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
- $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANST
- INTEGER COUNT, I, J, K, KASE, KK, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGBMV, SGBTRS, SLACN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -7
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -9
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = MIN( KL+KU+2, N+1 )
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), 1,
- $ ONE, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(op(A))*abs(X) + abs(B).
-*
- IF( NOTRAN ) THEN
- DO 50 K = 1, N
- KK = KU + 1 - K
- XK = ABS( X( K, J ) )
- DO 40 I = MAX( 1, K-KU ), MIN( N, K+KL )
- WORK( I ) = WORK( I ) + ABS( AB( KK+I, K ) )*XK
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- KK = KU + 1 - K
- DO 60 I = MAX( 1, K-KU ), MIN( N, K+KL )
- S = S + ABS( AB( KK+I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL SGBTRS( TRANST, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 110 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 120 CONTINUE
- CALL SGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SGBRFS
-*
- END
diff --git a/netlib/LAPACK/sgbsv.f b/netlib/LAPACK/sgbsv.f
deleted file mode 100644
index 308e38d..0000000
--- a/netlib/LAPACK/sgbsv.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief <b> SGBSV computes the solution to system of linear equations A * X = B for GB matrices</b> (simple driver)
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBSV computes the solution to a real system of linear equations
-*> A * X = B, where A is a band matrix of order N with KL subdiagonals
-*> and KU superdiagonals, and X and B are N-by-NRHS matrices.
-*>
-*> The LU decomposition with partial pivoting and row interchanges is
-*> used to factor A as A = L * U, where L is a product of permutation
-*> and unit lower triangular matrices with KL subdiagonals, and U is
-*> upper triangular with KL+KU superdiagonals. The factored form of A
-*> is then used to solve the system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL SGBTRF, SGBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( KL.LT.0 ) THEN
- INFO = -2
- ELSE IF( KU.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of the band matrix A.
-*
- CALL SGBTRF( N, N, KL, KU, AB, LDAB, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV,
- $ B, LDB, INFO )
- END IF
- RETURN
-*
-* End of SGBSV
-*
- END
diff --git a/netlib/LAPACK/sgbsvx.f b/netlib/LAPACK/sgbsvx.f
deleted file mode 100644
index 10cb454..0000000
--- a/netlib/LAPACK/sgbsvx.f
+++ /dev/null
@@ -1,644 +0,0 @@
-*> \brief <b> SGBSVX computes the solution to system of linear equations A * X = B for GB matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
-* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
-* RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, TRANS
-* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), C( * ), FERR( * ), R( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBSVX uses the LU factorization to compute the solution to a real
-*> system of linear equations A * X = B, A**T * X = B, or A**H * X = B,
-*> where A is a band matrix of order N with KL subdiagonals and KU
-*> superdiagonals, and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed by this subroutine:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
-*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*> or diag(C)*B (if TRANS = 'T' or 'C').
-*>
-*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*> matrix A (after equilibration if FACT = 'E') as
-*> A = L * U,
-*> where L is a product of permutation and unit lower triangular
-*> matrices with KL subdiagonals, and U is upper triangular with
-*> KL+KU superdiagonals.
-*>
-*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*> that it solves the original system before equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFB and IPIV contain the factored form of
-*> A. If EQUED is not 'N', the matrix A has been
-*> equilibrated with scaling factors given by R and C.
-*> AB, AFB, and IPIV are not modified.
-*> = 'N': The matrix A will be copied to AFB and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFB and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*>
-*> If FACT = 'F' and EQUED is not 'N', then A must have been
-*> equilibrated by the scaling factors in R and/or C. AB is not
-*> modified if FACT = 'F' or 'N', or if FACT = 'E' and
-*> EQUED = 'N' on exit.
-*>
-*> On exit, if EQUED .ne. 'N', A is scaled as follows:
-*> EQUED = 'R': A := diag(R) * A
-*> EQUED = 'C': A := A * diag(C)
-*> EQUED = 'B': A := diag(R) * A * diag(C).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in,out] AFB
-*> \verbatim
-*> AFB is REAL array, dimension (LDAFB,N)
-*> If FACT = 'F', then AFB is an input argument and on entry
-*> contains details of the LU factorization of the band matrix
-*> A, as computed by SGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
-*> the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFB is an output argument and on exit
-*> returns details of the LU factorization of A.
-*>
-*> If FACT = 'E', then AFB is an output argument and on exit
-*> returns details of the LU factorization of the equilibrated
-*> matrix A (see the description of AB for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the factorization A = L*U
-*> as computed by SGBTRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = L*U
-*> of the equilibrated matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is REAL array, dimension (N)
-*> The row scale factors for A. If EQUED = 'R' or 'B', A is
-*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*> is not accessed. R is an input argument if FACT = 'F';
-*> otherwise, R is an output argument. If FACT = 'F' and
-*> EQUED = 'R' or 'B', each element of R must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The column scale factors for A. If EQUED = 'C' or 'B', A is
-*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*> is not accessed. C is an input argument if FACT = 'F';
-*> otherwise, C is an output argument. If FACT = 'F' and
-*> EQUED = 'C' or 'B', each element of C must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit,
-*> if EQUED = 'N', B is not modified;
-*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*> diag(R)*B;
-*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*> overwritten by diag(C)*B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*> to the original system of equations. Note that A and B are
-*> modified on exit if EQUED .ne. 'N', and the solution to the
-*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*> and EQUED = 'R' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> On exit, WORK(1) contains the reciprocal pivot growth
-*> factor norm(A)/norm(U). The "max absolute element" norm is
-*> used. If WORK(1) is much less than 1, then the stability
-*> of the LU factorization of the (equilibrated) matrix A
-*> could be poor. This also means that the solution X, condition
-*> estimator RCOND, and forward error bound FERR could be
-*> unreliable. If factorization fails with 0<INFO<=N, then
-*> WORK(1) contains the reciprocal pivot growth factor for the
-*> leading INFO columns of A.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution and error bounds
-*> could not be computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGBsolve
-*
-* =====================================================================
- SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
- $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
- $ RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, TRANS
- INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), C( * ), FERR( * ), R( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-* Moved setting of INFO = N+1 so INFO does not subsequently get
-* overwritten. Sven, 17 Mar 05.
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
- CHARACTER NORM
- INTEGER I, INFEQU, J, J1, J2
- REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
- $ ROWCND, RPVGRW, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANGB, SLANTB
- EXTERNAL LSAME, SLAMCH, SLANGB, SLANTB
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGBCON, SGBEQU, SGBRFS, SGBTRF, SGBTRS,
- $ SLACPY, SLAQGB, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- ROWEQU = .FALSE.
- COLEQU = .FALSE.
- ELSE
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- SMLNUM = SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KL.LT.0 ) THEN
- INFO = -4
- ELSE IF( KU.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -8
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -10
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -12
- ELSE
- IF( ROWEQU ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 10 J = 1, N
- RCMIN = MIN( RCMIN, R( J ) )
- RCMAX = MAX( RCMAX, R( J ) )
- 10 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -13
- ELSE IF( N.GT.0 ) THEN
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- ROWCND = ONE
- END IF
- END IF
- IF( COLEQU .AND. INFO.EQ.0 ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 20 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 20 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -14
- ELSE IF( N.GT.0 ) THEN
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- COLCND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -16
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -18
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL SGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL SLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, EQUED )
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( NOTRAN ) THEN
- IF( ROWEQU ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = R( I )*B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( COLEQU ) THEN
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- B( I, J ) = C( I )*B( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the LU factorization of the band matrix A.
-*
- DO 70 J = 1, N
- J1 = MAX( J-KU, 1 )
- J2 = MIN( J+KL, N )
- CALL SCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1,
- $ AFB( KL+KU+1-J+J1, J ), 1 )
- 70 CONTINUE
-*
- CALL SGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 ) THEN
-*
-* Compute the reciprocal pivot growth factor of the
-* leading rank-deficient INFO columns of A.
-*
- ANORM = ZERO
- DO 90 J = 1, INFO
- DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- ANORM = MAX( ANORM, ABS( AB( I, J ) ) )
- 80 CONTINUE
- 90 CONTINUE
- RPVGRW = SLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ),
- $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB,
- $ WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = ANORM / RPVGRW
- END IF
- WORK( 1 ) = RPVGRW
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A and the
-* reciprocal pivot growth factor RPVGRW.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = SLANGB( NORM, N, KL, KU, AB, LDAB, WORK )
- RPVGRW = SLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = SLANGB( 'M', N, KL, KU, AB, LDAB, WORK ) / RPVGRW
- END IF
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX,
- $ INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV,
- $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( NOTRAN ) THEN
- IF( COLEQU ) THEN
- DO 110 J = 1, NRHS
- DO 100 I = 1, N
- X( I, J ) = C( I )*X( I, J )
- 100 CONTINUE
- 110 CONTINUE
- DO 120 J = 1, NRHS
- FERR( J ) = FERR( J ) / COLCND
- 120 CONTINUE
- END IF
- ELSE IF( ROWEQU ) THEN
- DO 140 J = 1, NRHS
- DO 130 I = 1, N
- X( I, J ) = R( I )*X( I, J )
- 130 CONTINUE
- 140 CONTINUE
- DO 150 J = 1, NRHS
- FERR( J ) = FERR( J ) / ROWCND
- 150 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- WORK( 1 ) = RPVGRW
- RETURN
-*
-* End of SGBSVX
-*
- END
diff --git a/netlib/LAPACK/sgbtf2.f b/netlib/LAPACK/sgbtf2.f
deleted file mode 100644
index 11c5ee3..0000000
--- a/netlib/LAPACK/sgbtf2.f
+++ /dev/null
@@ -1,277 +0,0 @@
-*> \brief \b SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbtf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbtf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbtf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBTF2 computes an LU factorization of a real m-by-n band matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U, because of fill-in resulting from the row
-*> interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, JP, JU, KM, KV
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- EXTERNAL ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGER, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in.
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero.
-*
- DO 20 J = KU + 2, MIN( KV, N )
- DO 10 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* JU is the index of the last column affected by the current stage
-* of the factorization.
-*
- JU = 1
-*
- DO 40 J = 1, MIN( M, N )
-*
-* Set fill-in elements in column J+KV to zero.
-*
- IF( J+KV.LE.N ) THEN
- DO 30 I = 1, KL
- AB( I, J+KV ) = ZERO
- 30 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-J )
- JP = ISAMAX( KM+1, AB( KV+1, J ), 1 )
- IPIV( J ) = JP + J - 1
- IF( AB( KV+JP, J ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( J+KU+JP-1, N ) )
-*
-* Apply interchange to columns J to JU.
-*
- IF( JP.NE.1 )
- $ CALL SSWAP( JU-J+1, AB( KV+JP, J ), LDAB-1,
- $ AB( KV+1, J ), LDAB-1 )
-*
- IF( KM.GT.0 ) THEN
-*
-* Compute multipliers.
-*
- CALL SSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 )
-*
-* Update trailing submatrix within the band.
-*
- IF( JU.GT.J )
- $ CALL SGER( KM, JU-J, -ONE, AB( KV+2, J ), 1,
- $ AB( KV, J+1 ), LDAB-1, AB( KV+1, J+1 ),
- $ LDAB-1 )
- END IF
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = J
- END IF
- 40 CONTINUE
- RETURN
-*
-* End of SGBTF2
-*
- END
diff --git a/netlib/LAPACK/sgbtrf.f b/netlib/LAPACK/sgbtrf.f
deleted file mode 100644
index 3df8d69..0000000
--- a/netlib/LAPACK/sgbtrf.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief \b SGBTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbtrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbtrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbtrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBTRF computes an LU factorization of a real m-by-n band matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> This is the blocked version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
- INTEGER NBMAX, LDWORK
- PARAMETER ( NBMAX = 64, LDWORK = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I2, I3, II, IP, J, J2, J3, JB, JJ, JM, JP,
- $ JU, K2, KM, KV, NB, NW
- REAL TEMP
-* ..
-* .. Local Arrays ..
- REAL WORK13( LDWORK, NBMAX ),
- $ WORK31( LDWORK, NBMAX )
-* ..
-* .. External Functions ..
- INTEGER ILAENV, ISAMAX
- EXTERNAL ILAENV, ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGBTF2, SGEMM, SGER, SLASWP, SSCAL,
- $ SSWAP, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment
-*
- NB = ILAENV( 1, 'SGBTRF', ' ', M, N, KL, KU )
-*
-* The block size must not exceed the limit set by the size of the
-* local arrays WORK13 and WORK31.
-*
- NB = MIN( NB, NBMAX )
-*
- IF( NB.LE.1 .OR. NB.GT.KL ) THEN
-*
-* Use unblocked code
-*
- CALL SGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
- ELSE
-*
-* Use blocked code
-*
-* Zero the superdiagonal elements of the work array WORK13
-*
- DO 20 J = 1, NB
- DO 10 I = 1, J - 1
- WORK13( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Zero the subdiagonal elements of the work array WORK31
-*
- DO 40 J = 1, NB
- DO 30 I = J + 1, NB
- WORK31( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero
-*
- DO 60 J = KU + 2, MIN( KV, N )
- DO 50 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
-* JU is the index of the last column affected by the current
-* stage of the factorization
-*
- JU = 1
-*
- DO 180 J = 1, MIN( M, N ), NB
- JB = MIN( NB, MIN( M, N )-J+1 )
-*
-* The active part of the matrix is partitioned
-*
-* A11 A12 A13
-* A21 A22 A23
-* A31 A32 A33
-*
-* Here A11, A21 and A31 denote the current block of JB columns
-* which is about to be factorized. The number of rows in the
-* partitioning are JB, I2, I3 respectively, and the numbers
-* of columns are JB, J2, J3. The superdiagonal elements of A13
-* and the subdiagonal elements of A31 lie outside the band.
-*
- I2 = MIN( KL-JB, M-J-JB+1 )
- I3 = MIN( JB, M-J-KL+1 )
-*
-* J2 and J3 are computed after JU has been updated.
-*
-* Factorize the current block of JB columns
-*
- DO 80 JJ = J, J + JB - 1
-*
-* Set fill-in elements in column JJ+KV to zero
-*
- IF( JJ+KV.LE.N ) THEN
- DO 70 I = 1, KL
- AB( I, JJ+KV ) = ZERO
- 70 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-JJ )
- JP = ISAMAX( KM+1, AB( KV+1, JJ ), 1 )
- IPIV( JJ ) = JP + JJ - J
- IF( AB( KV+JP, JJ ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( JJ+KU+JP-1, N ) )
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to J+JB-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
- CALL SSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange affects columns J to JJ-1 of A31
-* which are stored in the work array WORK31
-*
- CALL SSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- CALL SSWAP( J+JB-JJ, AB( KV+1, JJ ), LDAB-1,
- $ AB( KV+JP, JJ ), LDAB-1 )
- END IF
- END IF
-*
-* Compute multipliers
-*
- CALL SSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ),
- $ 1 )
-*
-* Update trailing submatrix within the band and within
-* the current block. JM is the index of the last column
-* which needs to be updated.
-*
- JM = MIN( JU, J+JB-1 )
- IF( JM.GT.JJ )
- $ CALL SGER( KM, JM-JJ, -ONE, AB( KV+2, JJ ), 1,
- $ AB( KV, JJ+1 ), LDAB-1,
- $ AB( KV+1, JJ+1 ), LDAB-1 )
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = JJ
- END IF
-*
-* Copy current column of A31 into the work array WORK31
-*
- NW = MIN( JJ-J+1, I3 )
- IF( NW.GT.0 )
- $ CALL SCOPY( NW, AB( KV+KL+1-JJ+J, JJ ), 1,
- $ WORK31( 1, JJ-J+1 ), 1 )
- 80 CONTINUE
- IF( J+JB.LE.N ) THEN
-*
-* Apply the row interchanges to the other blocks.
-*
- J2 = MIN( JU-J+1, KV ) - JB
- J3 = MAX( 0, JU-J-KV+1 )
-*
-* Use SLASWP to apply the row interchanges to A12, A22, and
-* A32.
-*
- CALL SLASWP( J2, AB( KV+1-JB, J+JB ), LDAB-1, 1, JB,
- $ IPIV( J ), 1 )
-*
-* Adjust the pivot indices.
-*
- DO 90 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 90 CONTINUE
-*
-* Apply the row interchanges to A13, A23, and A33
-* columnwise.
-*
- K2 = J - 1 + JB + J2
- DO 110 I = 1, J3
- JJ = K2 + I
- DO 100 II = J + I - 1, J + JB - 1
- IP = IPIV( II )
- IF( IP.NE.II ) THEN
- TEMP = AB( KV+1+II-JJ, JJ )
- AB( KV+1+II-JJ, JJ ) = AB( KV+1+IP-JJ, JJ )
- AB( KV+1+IP-JJ, JJ ) = TEMP
- END IF
- 100 CONTINUE
- 110 CONTINUE
-*
-* Update the relevant part of the trailing submatrix
-*
- IF( J2.GT.0 ) THEN
-*
-* Update A12
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J2, ONE, AB( KV+1, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A22
-*
- CALL SGEMM( 'No transpose', 'No transpose', I2, J2,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+1, J+JB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A32
-*
- CALL SGEMM( 'No transpose', 'No transpose', I3, J2,
- $ JB, -ONE, WORK31, LDWORK,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+KL+1-JB, J+JB ), LDAB-1 )
- END IF
- END IF
-*
- IF( J3.GT.0 ) THEN
-*
-* Copy the lower triangle of A13 into the work array
-* WORK13
-*
- DO 130 JJ = 1, J3
- DO 120 II = JJ, JB
- WORK13( II, JJ ) = AB( II-JJ+1, JJ+J+KV-1 )
- 120 CONTINUE
- 130 CONTINUE
-*
-* Update A13 in the work array
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J3, ONE, AB( KV+1, J ), LDAB-1,
- $ WORK13, LDWORK )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A23
-*
- CALL SGEMM( 'No transpose', 'No transpose', I2, J3,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ),
- $ LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A33
-*
- CALL SGEMM( 'No transpose', 'No transpose', I3, J3,
- $ JB, -ONE, WORK31, LDWORK, WORK13,
- $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 )
- END IF
-*
-* Copy the lower triangle of A13 back into place
-*
- DO 150 JJ = 1, J3
- DO 140 II = JJ, JB
- AB( II-JJ+1, JJ+J+KV-1 ) = WORK13( II, JJ )
- 140 CONTINUE
- 150 CONTINUE
- END IF
- ELSE
-*
-* Adjust the pivot indices.
-*
- DO 160 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 160 CONTINUE
- END IF
-*
-* Partially undo the interchanges in the current block to
-* restore the upper triangular form of A31 and copy the upper
-* triangle of A31 back into place
-*
- DO 170 JJ = J + JB - 1, J, -1
- JP = IPIV( JJ ) - JJ + 1
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to JJ-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
-* The interchange does not affect A31
-*
- CALL SSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange does affect A31
-*
- CALL SSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- END IF
- END IF
-*
-* Copy the current column of A31 back into place
-*
- NW = MIN( I3, JJ-J+1 )
- IF( NW.GT.0 )
- $ CALL SCOPY( NW, WORK31( 1, JJ-J+1 ), 1,
- $ AB( KV+KL+1-JJ+J, JJ ), 1 )
- 170 CONTINUE
- 180 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SGBTRF
-*
- END
diff --git a/netlib/LAPACK/sgbtrs.f b/netlib/LAPACK/sgbtrs.f
deleted file mode 100644
index d47d41c..0000000
--- a/netlib/LAPACK/sgbtrs.f
+++ /dev/null
@@ -1,269 +0,0 @@
-*> \brief \b SGBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGBTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGBTRS solves a system of linear equations
-*> A * X = B or A**T * X = B
-*> with a general band matrix A using the LU factorization computed
-*> by SGBTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by SGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, NOTRAN
- INTEGER I, J, KD, L, LM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER, SSWAP, STBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.( 2*KL+KU+1 ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- KD = KU + KL + 1
- LNOTI = KL.GT.0
-*
- IF( NOTRAN ) THEN
-*
-* Solve A*X = B.
-*
-* Solve L*X = B, overwriting B with X.
-*
-* L is represented as a product of permutations and unit lower
-* triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
-* where each transformation L(i) is a rank-one modification of
-* the identity matrix.
-*
- IF( LNOTI ) THEN
- DO 10 J = 1, N - 1
- LM = MIN( KL, N-J )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL SSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- CALL SGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ),
- $ LDB, B( J+1, 1 ), LDB )
- 10 CONTINUE
- END IF
-*
- DO 20 I = 1, NRHS
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU,
- $ AB, LDAB, B( 1, I ), 1 )
- 20 CONTINUE
-*
- ELSE
-*
-* Solve A**T*X = B.
-*
- DO 30 I = 1, NRHS
-*
-* Solve U**T*X = B, overwriting B with X.
-*
- CALL STBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB,
- $ LDAB, B( 1, I ), 1 )
- 30 CONTINUE
-*
-* Solve L**T*X = B, overwriting B with X.
-*
- IF( LNOTI ) THEN
- DO 40 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- CALL SGEMV( 'Transpose', LM, NRHS, -ONE, B( J+1, 1 ),
- $ LDB, AB( KD+1, J ), 1, ONE, B( J, 1 ), LDB )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL SSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of SGBTRS
-*
- END
diff --git a/netlib/LAPACK/sgebak.f b/netlib/LAPACK/sgebak.f
deleted file mode 100644
index acb80d2..0000000
--- a/netlib/LAPACK/sgebak.f
+++ /dev/null
@@ -1,268 +0,0 @@
-*> \brief \b SGEBAK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEBAK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebak.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebak.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebak.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB, SIDE
-* INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
-* REAL V( LDV, * ), SCALE( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEBAK forms the right or left eigenvectors of a real general matrix
-*> by backward transformation on the computed eigenvectors of the
-*> balanced matrix output by SGEBAL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the type of backward transformation required:
-*> = 'N', do nothing, return immediately;
-*> = 'P', do backward transformation for permutation only;
-*> = 'S', do backward transformation for scaling only;
-*> = 'B', do backward transformations for both permutation and
-*> scaling.
-*> JOB must be the same as the argument JOB supplied to SGEBAL.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': V contains right eigenvectors;
-*> = 'L': V contains left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrix V. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> The integers ILO and IHI determined by SGEBAL.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in] SCALE
-*> \verbatim
-*> SCALE is REAL array, dimension (N)
-*> Details of the permutation and scaling factors, as returned
-*> by SGEBAL.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix V. M >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,M)
-*> On entry, the matrix of right or left eigenvectors to be
-*> transformed, as returned by SHSEIN or STREVC.
-*> On exit, V is overwritten by the transformed eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB, SIDE
- INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
- REAL V( LDV, * ), SCALE( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFTV, RIGHTV
- INTEGER I, II, K
- REAL S
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters
-*
- RIGHTV = LSAME( SIDE, 'R' )
- LEFTV = LSAME( SIDE, 'L' )
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -7
- ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEBAK', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( M.EQ.0 )
- $ RETURN
- IF( LSAME( JOB, 'N' ) )
- $ RETURN
-*
- IF( ILO.EQ.IHI )
- $ GO TO 30
-*
-* Backward balance
-*
- IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
- IF( RIGHTV ) THEN
- DO 10 I = ILO, IHI
- S = SCALE( I )
- CALL SSCAL( M, S, V( I, 1 ), LDV )
- 10 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
- DO 20 I = ILO, IHI
- S = ONE / SCALE( I )
- CALL SSCAL( M, S, V( I, 1 ), LDV )
- 20 CONTINUE
- END IF
-*
- END IF
-*
-* Backward permutation
-*
-* For I = ILO-1 step -1 until 1,
-* IHI+1 step 1 until N do --
-*
- 30 CONTINUE
- IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
- IF( RIGHTV ) THEN
- DO 40 II = 1, N
- I = II
- IF( I.GE.ILO .AND. I.LE.IHI )
- $ GO TO 40
- IF( I.LT.ILO )
- $ I = ILO - II
- K = SCALE( I )
- IF( K.EQ.I )
- $ GO TO 40
- CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 40 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
- DO 50 II = 1, N
- I = II
- IF( I.GE.ILO .AND. I.LE.IHI )
- $ GO TO 50
- IF( I.LT.ILO )
- $ I = ILO - II
- K = SCALE( I )
- IF( K.EQ.I )
- $ GO TO 50
- CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 50 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SGEBAK
-*
- END
diff --git a/netlib/LAPACK/sgebal.f b/netlib/LAPACK/sgebal.f
deleted file mode 100644
index 853ff20..0000000
--- a/netlib/LAPACK/sgebal.f
+++ /dev/null
@@ -1,405 +0,0 @@
-*> \brief \b SGEBAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEBAL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebal.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebal.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebal.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), SCALE( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEBAL balances a general real matrix A. This involves, first,
-*> permuting A by a similarity transformation to isolate eigenvalues
-*> in the first 1 to ILO-1 and last IHI+1 to N elements on the
-*> diagonal; and second, applying a diagonal similarity transformation
-*> to rows and columns ILO to IHI to make the rows and columns as
-*> close in norm as possible. Both steps are optional.
-*>
-*> Balancing may reduce the 1-norm of the matrix, and improve the
-*> accuracy of the computed eigenvalues and/or eigenvectors.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the operations to be performed on A:
-*> = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
-*> for i = 1,...,N;
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the input matrix A.
-*> On exit, A is overwritten by the balanced matrix.
-*> If JOB = 'N', A is not referenced.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are set to integers such that on exit
-*> A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
-*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL array, dimension (N)
-*> Details of the permutations and scaling factors applied to
-*> A. If P(j) is the index of the row and column interchanged
-*> with row and column j and D(j) is the scaling factor
-*> applied to row and column j, then
-*> SCALE(j) = P(j) for j = 1,...,ILO-1
-*> = D(j) for j = ILO,...,IHI
-*> = P(j) for j = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The permutations consist of row and column interchanges which put
-*> the matrix in the form
-*>
-*> ( T1 X Y )
-*> P A P = ( 0 B Z )
-*> ( 0 0 T2 )
-*>
-*> where T1 and T2 are upper triangular matrices whose eigenvalues lie
-*> along the diagonal. The column indices ILO and IHI mark the starting
-*> and ending columns of the submatrix B. Balancing consists of applying
-*> a diagonal similarity transformation inv(D) * B * D to make the
-*> 1-norms of each row of B and its corresponding column nearly equal.
-*> The output matrix is
-*>
-*> ( T1 X*D Y )
-*> ( 0 inv(D)*B*D inv(D)*Z ).
-*> ( 0 0 T2 )
-*>
-*> Information about the permutations P and the diagonal matrix D is
-*> returned in the vector SCALE.
-*>
-*> This subroutine is based on the EISPACK routine BALANC.
-*>
-*> Modified by Tzu-Yi Chen, Computer Science Division, University of
-*> California at Berkeley, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), SCALE( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL SCLFAC
- PARAMETER ( SCLFAC = 2.0E+0 )
- REAL FACTOR
- PARAMETER ( FACTOR = 0.95E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOCONV
- INTEGER I, ICA, IEXC, IRA, J, K, L, M
- REAL C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
- $ SFMIN2
-* ..
-* .. External Functions ..
- LOGICAL SISNAN, LSAME
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL SISNAN, LSAME, ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEBAL', -INFO )
- RETURN
- END IF
-*
- K = 1
- L = N
-*
- IF( N.EQ.0 )
- $ GO TO 210
-*
- IF( LSAME( JOB, 'N' ) ) THEN
- DO 10 I = 1, N
- SCALE( I ) = ONE
- 10 CONTINUE
- GO TO 210
- END IF
-*
- IF( LSAME( JOB, 'S' ) )
- $ GO TO 120
-*
-* Permutation to isolate eigenvalues if possible
-*
- GO TO 50
-*
-* Row and column exchange.
-*
- 20 CONTINUE
- SCALE( M ) = J
- IF( J.EQ.M )
- $ GO TO 30
-*
- CALL SSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
- CALL SSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
-*
- 30 CONTINUE
- GO TO ( 40, 80 )IEXC
-*
-* Search for rows isolating an eigenvalue and push them down.
-*
- 40 CONTINUE
- IF( L.EQ.1 )
- $ GO TO 210
- L = L - 1
-*
- 50 CONTINUE
- DO 70 J = L, 1, -1
-*
- DO 60 I = 1, L
- IF( I.EQ.J )
- $ GO TO 60
- IF( A( J, I ).NE.ZERO )
- $ GO TO 70
- 60 CONTINUE
-*
- M = L
- IEXC = 1
- GO TO 20
- 70 CONTINUE
-*
- GO TO 90
-*
-* Search for columns isolating an eigenvalue and push them left.
-*
- 80 CONTINUE
- K = K + 1
-*
- 90 CONTINUE
- DO 110 J = K, L
-*
- DO 100 I = K, L
- IF( I.EQ.J )
- $ GO TO 100
- IF( A( I, J ).NE.ZERO )
- $ GO TO 110
- 100 CONTINUE
-*
- M = K
- IEXC = 2
- GO TO 20
- 110 CONTINUE
-*
- 120 CONTINUE
- DO 130 I = K, L
- SCALE( I ) = ONE
- 130 CONTINUE
-*
- IF( LSAME( JOB, 'P' ) )
- $ GO TO 210
-*
-* Balance the submatrix in rows K to L.
-*
-* Iterative loop for norm reduction
-*
- SFMIN1 = SLAMCH( 'S' ) / SLAMCH( 'P' )
- SFMAX1 = ONE / SFMIN1
- SFMIN2 = SFMIN1*SCLFAC
- SFMAX2 = ONE / SFMIN2
- 140 CONTINUE
- NOCONV = .FALSE.
-*
- DO 200 I = K, L
- C = ZERO
- R = ZERO
-*
- DO 150 J = K, L
- IF( J.EQ.I )
- $ GO TO 150
- C = C + ABS( A( J, I ) )
- R = R + ABS( A( I, J ) )
- 150 CONTINUE
- ICA = ISAMAX( L, A( 1, I ), 1 )
- CA = ABS( A( ICA, I ) )
- IRA = ISAMAX( N-K+1, A( I, K ), LDA )
- RA = ABS( A( I, IRA+K-1 ) )
-*
-* Guard against zero C or R due to underflow.
-*
- IF( C.EQ.ZERO .OR. R.EQ.ZERO )
- $ GO TO 200
- G = R / SCLFAC
- F = ONE
- S = C + R
- 160 CONTINUE
- IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
- $ MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
- F = F*SCLFAC
- C = C*SCLFAC
- CA = CA*SCLFAC
- R = R / SCLFAC
- G = G / SCLFAC
- RA = RA / SCLFAC
- GO TO 160
-*
- 170 CONTINUE
- G = C / SCLFAC
- 180 CONTINUE
- IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
- $ MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
- IF( SISNAN( C+F+CA+R+G+RA ) ) THEN
-*
-* Exit if NaN to avoid infinite loop
-*
- INFO = -3
- CALL XERBLA( 'SGEBAL', -INFO )
- RETURN
- END IF
- F = F / SCLFAC
- C = C / SCLFAC
- G = G / SCLFAC
- CA = CA / SCLFAC
- R = R*SCLFAC
- RA = RA*SCLFAC
- GO TO 180
-*
-* Now balance.
-*
- 190 CONTINUE
- IF( ( C+R ).GE.FACTOR*S )
- $ GO TO 200
- IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
- IF( F*SCALE( I ).LE.SFMIN1 )
- $ GO TO 200
- END IF
- IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
- IF( SCALE( I ).GE.SFMAX1 / F )
- $ GO TO 200
- END IF
- G = ONE / F
- SCALE( I ) = SCALE( I )*F
- NOCONV = .TRUE.
-*
- CALL SSCAL( N-K+1, G, A( I, K ), LDA )
- CALL SSCAL( L, F, A( 1, I ), 1 )
-*
- 200 CONTINUE
-*
- IF( NOCONV )
- $ GO TO 140
-*
- 210 CONTINUE
- ILO = K
- IHI = L
-*
- RETURN
-*
-* End of SGEBAL
-*
- END
diff --git a/netlib/LAPACK/sgebd2.f b/netlib/LAPACK/sgebd2.f
deleted file mode 100644
index 26d16f0..0000000
--- a/netlib/LAPACK/sgebd2.f
+++ /dev/null
@@ -1,320 +0,0 @@
-*> \brief \b SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEBD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEBD2 reduces a real general m by n matrix A to upper or lower
-*> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*>
-*> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n general matrix to be reduced.
-*> On exit,
-*> if m >= n, the diagonal and the first superdiagonal are
-*> overwritten with the upper bidiagonal matrix B; the
-*> elements below the diagonal, with the array TAUQ, represent
-*> the orthogonal matrix Q as a product of elementary
-*> reflectors, and the elements above the first superdiagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors;
-*> if m < n, the diagonal and the first subdiagonal are
-*> overwritten with the lower bidiagonal matrix B; the
-*> elements below the first subdiagonal, with the array TAUQ,
-*> represent the orthogonal matrix Q as a product of
-*> elementary reflectors, and the elements above the diagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (min(M,N)-1)
-*> The off-diagonal elements of the bidiagonal matrix B:
-*> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is REAL array dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (max(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> If m >= n,
-*>
-*> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n,
-*>
-*> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The contents of A on exit are illustrated by the following examples:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
-*> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
-*> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
-*> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
-*> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
-*> ( v1 v2 v3 v4 v5 )
-*>
-*> where d and e denote diagonal and off-diagonal elements of B, vi
-*> denotes an element of the vector defining H(i), and ui an element of
-*> the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'SGEBD2', -INFO )
- RETURN
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* Reduce to upper bidiagonal form
-*
- DO 10 I = 1, N
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAUQ( I ) )
- D( I ) = A( I, I )
- A( I, I ) = ONE
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- IF( I.LT.N )
- $ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = D( I )
-*
- IF( I.LT.N ) THEN
-*
-* Generate elementary reflector G(i) to annihilate
-* A(i,i+2:n)
-*
- CALL SLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
- $ LDA, TAUP( I ) )
- E( I ) = A( I, I+1 )
- A( I, I+1 ) = ONE
-*
-* Apply G(i) to A(i+1:m,i+1:n) from the right
-*
- CALL SLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
- $ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
- A( I, I+1 ) = E( I )
- ELSE
- TAUP( I ) = ZERO
- END IF
- 10 CONTINUE
- ELSE
-*
-* Reduce to lower bidiagonal form
-*
- DO 20 I = 1, M
-*
-* Generate elementary reflector G(i) to annihilate A(i,i+1:n)
-*
- CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAUP( I ) )
- D( I ) = A( I, I )
- A( I, I ) = ONE
-*
-* Apply G(i) to A(i+1:m,i:n) from the right
-*
- IF( I.LT.M )
- $ CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
- $ TAUP( I ), A( I+1, I ), LDA, WORK )
- A( I, I ) = D( I )
-*
- IF( I.LT.M ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(i+2:m,i)
-*
- CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
- $ TAUQ( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Apply H(i) to A(i+1:m,i+1:n) from the left
-*
- CALL SLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
- $ A( I+1, I+1 ), LDA, WORK )
- A( I+1, I ) = E( I )
- ELSE
- TAUQ( I ) = ZERO
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of SGEBD2
-*
- END
diff --git a/netlib/LAPACK/sgebrd.f b/netlib/LAPACK/sgebrd.f
deleted file mode 100644
index f4dfd2b..0000000
--- a/netlib/LAPACK/sgebrd.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b SGEBRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEBRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEBRD reduces a general real M-by-N matrix A to upper or lower
-*> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*>
-*> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N general matrix to be reduced.
-*> On exit,
-*> if m >= n, the diagonal and the first superdiagonal are
-*> overwritten with the upper bidiagonal matrix B; the
-*> elements below the diagonal, with the array TAUQ, represent
-*> the orthogonal matrix Q as a product of elementary
-*> reflectors, and the elements above the first superdiagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors;
-*> if m < n, the diagonal and the first subdiagonal are
-*> overwritten with the lower bidiagonal matrix B; the
-*> elements below the first subdiagonal, with the array TAUQ,
-*> represent the orthogonal matrix Q as a product of
-*> elementary reflectors, and the elements above the diagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (min(M,N)-1)
-*> The off-diagonal elements of the bidiagonal matrix B:
-*> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is REAL array dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,M,N).
-*> For optimum performance LWORK >= (M+N)*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> If m >= n,
-*>
-*> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n,
-*>
-*> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The contents of A on exit are illustrated by the following examples:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
-*> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
-*> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
-*> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
-*> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
-*> ( v1 v2 v3 v4 v5 )
-*>
-*> where d and e denote diagonal and off-diagonal elements of B, vi
-*> denotes an element of the vector defining H(i), and ui an element of
-*> the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- REAL WS
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEBD2, SGEMM, SLABRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, REAL
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB = MAX( 1, ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) )
- LWKOPT = ( M+N )*NB
- WORK( 1 ) = REAL( LWKOPT )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'SGEBRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- MINMN = MIN( M, N )
- IF( MINMN.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- WS = MAX( M, N )
- LDWRKX = M
- LDWRKY = N
-*
- IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
-*
-* Set the crossover point NX.
-*
- NX = MAX( NB, ILAENV( 3, 'SGEBRD', ' ', M, N, -1, -1 ) )
-*
-* Determine when to switch from blocked to unblocked code.
-*
- IF( NX.LT.MINMN ) THEN
- WS = ( M+N )*NB
- IF( LWORK.LT.WS ) THEN
-*
-* Not enough work space for the optimal NB, consider using
-* a smaller block size.
-*
- NBMIN = ILAENV( 2, 'SGEBRD', ' ', M, N, -1, -1 )
- IF( LWORK.GE.( M+N )*NBMIN ) THEN
- NB = LWORK / ( M+N )
- ELSE
- NB = 1
- NX = MINMN
- END IF
- END IF
- END IF
- ELSE
- NX = MINMN
- END IF
-*
- DO 30 I = 1, MINMN - NX, NB
-*
-* Reduce rows and columns i:i+nb-1 to bidiagonal form and return
-* the matrices X and Y which are needed to update the unreduced
-* part of the matrix
-*
- CALL SLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
- $ TAUQ( I ), TAUP( I ), WORK, LDWRKX,
- $ WORK( LDWRKX*NB+1 ), LDWRKY )
-*
-* Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
-* of the form A := A - V*Y**T - X*U**T
-*
- CALL SGEMM( 'No transpose', 'Transpose', M-I-NB+1, N-I-NB+1,
- $ NB, -ONE, A( I+NB, I ), LDA,
- $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
- $ A( I+NB, I+NB ), LDA )
- CALL SGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1,
- $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
- $ ONE, A( I+NB, I+NB ), LDA )
-*
-* Copy diagonal and off-diagonal elements of B back into A
-*
- IF( M.GE.N ) THEN
- DO 10 J = I, I + NB - 1
- A( J, J ) = D( J )
- A( J, J+1 ) = E( J )
- 10 CONTINUE
- ELSE
- DO 20 J = I, I + NB - 1
- A( J, J ) = D( J )
- A( J+1, J ) = E( J )
- 20 CONTINUE
- END IF
- 30 CONTINUE
-*
-* Use unblocked code to reduce the remainder of the matrix
-*
- CALL SGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
- $ TAUQ( I ), TAUP( I ), WORK, IINFO )
- WORK( 1 ) = WS
- RETURN
-*
-* End of SGEBRD
-*
- END
diff --git a/netlib/LAPACK/sgecon.f b/netlib/LAPACK/sgecon.f
deleted file mode 100644
index 60c6b1e..0000000
--- a/netlib/LAPACK/sgecon.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b SGECON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGECON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgecon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgecon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgecon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, LDA, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGECON estimates the reciprocal of the condition number of a general
-*> real matrix A, in either the 1-norm or the infinity-norm, using
-*> the LU factorization computed by SGETRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by SGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, LDA, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ONENRM
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- REAL AINVNM, SCALE, SL, SMLNUM, SU
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL LSAME, ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATRS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGECON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = SLAMCH( 'Safe minimum' )
-*
-* Estimate the norm of inv(A).
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(L).
-*
- CALL SLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
- $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
-*
-* Multiply by inv(U).
-*
- CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(U**T).
-*
- CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SU, WORK( 3*N+1 ), INFO )
-*
-* Multiply by inv(L**T).
-*
- CALL SLATRS( 'Lower', 'Transpose', 'Unit', NORMIN, N, A,
- $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Divide X by 1/(SL*SU) if doing so will not cause overflow.
-*
- SCALE = SL*SU
- NORMIN = 'Y'
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of SGECON
-*
- END
diff --git a/netlib/LAPACK/sgeequ.f b/netlib/LAPACK/sgeequ.f
deleted file mode 100644
index e64acbd..0000000
--- a/netlib/LAPACK/sgeequ.f
+++ /dev/null
@@ -1,304 +0,0 @@
-*> \brief \b SGEEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEEQU computes row and column scalings intended to equilibrate an
-*> M-by-N matrix A and reduce its condition number. R returns the row
-*> scale factors and C the column scale factors, chosen to try to make
-*> the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
-*>
-*> R(i) and C(j) are restricted to be between SMLNUM = smallest safe
-*> number and BIGNUM = largest safe number. Use of these scaling
-*> factors is not guaranteed to reduce the condition number of A but
-*> works well in practice.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The M-by-N matrix whose equilibration factors are
-*> to be computed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is REAL
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is REAL
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
- REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL BIGNUM, RCMAX, RCMIN, SMLNUM
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I))
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = 1, M
- C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
- 80 CONTINUE
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J))
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of SGEEQU
-*
- END
diff --git a/netlib/LAPACK/sgeequb.f b/netlib/LAPACK/sgeequb.f
deleted file mode 100644
index 018c7ce..0000000
--- a/netlib/LAPACK/sgeequb.f
+++ /dev/null
@@ -1,321 +0,0 @@
-*> \brief \b SGEEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEEQUB( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEEQUB computes row and column scalings intended to equilibrate an
-*> M-by-N matrix A and reduce its condition number. R returns the row
-*> scale factors and C the column scale factors, chosen to try to make
-*> the largest element in each row and column of the matrix B with
-*> elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
-*> the radix.
-*>
-*> R(i) and C(j) are restricted to be a power of the radix between
-*> SMLNUM = smallest safe number and BIGNUM = largest safe number. Use
-*> of these scaling factors is not guaranteed to reduce the condition
-*> number of A but works well in practice.
-*>
-*> This routine differs from SGEEQU by restricting the scaling factors
-*> to a power of the radix. Baring over- and underflow, scaling by
-*> these factors introduces no additional rounding errors. However, the
-*> scaled entries' magnitured are no longer approximately 1 but lie
-*> between sqrt(radix) and 1/sqrt(radix).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The M-by-N matrix whose equilibration factors are
-*> to be computed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is REAL
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is REAL
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGEEQUB( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
- REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL BIGNUM, RCMAX, RCMIN, SMLNUM, RADIX, LOGRDX
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, LOG
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEEQUB', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants. Assume SMLNUM is a power of the radix.
-*
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- RADIX = SLAMCH( 'B' )
- LOGRDX = LOG( RADIX )
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
- DO I = 1, M
- IF( R( I ).GT.ZERO ) THEN
- R( I ) = RADIX**INT( LOG( R( I ) ) / LOGRDX )
- END IF
- END DO
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I)).
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = 1, M
- C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
- 80 CONTINUE
- IF( C( J ).GT.ZERO ) THEN
- C( J ) = RADIX**INT( LOG( C( J ) ) / LOGRDX )
- END IF
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J)).
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of SGEEQUB
-*
- END
diff --git a/netlib/LAPACK/sgees.f b/netlib/LAPACK/sgees.f
deleted file mode 100644
index 691749c..0000000
--- a/netlib/LAPACK/sgees.f
+++ /dev/null
@@ -1,535 +0,0 @@
-*> \brief <b> SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEES + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgees.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgees.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgees.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
-* VS, LDVS, WORK, LWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVS, SORT
-* INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* REAL A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
-* $ WR( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELECT
-* EXTERNAL SELECT
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEES computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues, the real Schur form T, and, optionally, the matrix of
-*> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
-*>
-*> Optionally, it also orders the eigenvalues on the diagonal of the
-*> real Schur form so that selected eigenvalues are at the top left.
-*> The leading columns of Z then form an orthonormal basis for the
-*> invariant subspace corresponding to the selected eigenvalues.
-*>
-*> A matrix is in real Schur form if it is upper quasi-triangular with
-*> 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
-*> form
-*> [ a b ]
-*> [ c a ]
-*>
-*> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVS
-*> \verbatim
-*> JOBVS is CHARACTER*1
-*> = 'N': Schur vectors are not computed;
-*> = 'V': Schur vectors are computed.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELECT).
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL FUNCTION of two REAL arguments
-*> SELECT must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'S', SELECT is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> If SORT = 'N', SELECT is not referenced.
-*> An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
-*> SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
-*> conjugate pair of eigenvalues is selected, then both complex
-*> eigenvalues are selected.
-*> Note that a selected complex eigenvalue may no longer
-*> satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
-*> ordering may change the value of complex eigenvalues
-*> (especially if the eigenvalue is ill-conditioned); in this
-*> case INFO is set to N+2 (see INFO below).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten by its real Schur form T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELECT is true. (Complex conjugate
-*> pairs for which SELECT is true for either
-*> eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues in the same order
-*> that they appear on the diagonal of the output Schur form T.
-*> Complex conjugate pairs of eigenvalues will appear
-*> consecutively with the eigenvalue having the positive
-*> imaginary part first.
-*> \endverbatim
-*>
-*> \param[out] VS
-*> \verbatim
-*> VS is REAL array, dimension (LDVS,N)
-*> If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
-*> vectors.
-*> If JOBVS = 'N', VS is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVS
-*> \verbatim
-*> LDVS is INTEGER
-*> The leading dimension of the array VS. LDVS >= 1; if
-*> JOBVS = 'V', LDVS >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N).
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, and i is
-*> <= N: the QR algorithm failed to compute all the
-*> eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
-*> contain those eigenvalues which have converged; if
-*> JOBVS = 'V', VS contains the matrix which reduces A
-*> to its partially converged Schur form.
-*> = N+1: the eigenvalues could not be reordered because some
-*> eigenvalues were too close to separate (the problem
-*> is very ill-conditioned);
-*> = N+2: after reordering, roundoff changed values of some
-*> complex eigenvalues so that leading eigenvalues in
-*> the Schur form no longer satisfy SELECT=.TRUE. This
-*> could also be caused by underflow due to scaling.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
- $ VS, LDVS, WORK, LWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVS, SORT
- INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- REAL A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
- $ WR( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELECT
- EXTERNAL SELECT
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
- $ WANTVS
- INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
- $ IHI, ILO, INXT, IP, ITAU, IWRK, MAXWRK, MINWRK
- REAL ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER IDUM( 1 )
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD,
- $ SLACPY, SLASCL, SORGHR, SSWAP, STRSEN, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVS = LSAME( JOBVS, 'V' )
- WANTST = LSAME( SORT, 'S' )
- IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by SHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
- MINWRK = 3*N
-*
- CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
- $ WORK, -1, IEVAL )
- HSWORK = WORK( 1 )
-*
- IF( .NOT.WANTVS ) THEN
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- ELSE
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'SORGHR', ' ', N, 1, N, -1 ) )
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- END IF
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEES ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL SLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (Workspace: need N)
-*
- IBAL = 1
- CALL SGEBAL( 'P', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = N + IBAL
- IWRK = N + ITAU
- CALL SGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVS ) THEN
-*
-* Copy Householder vectors to VS
-*
- CALL SLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-* Generate orthogonal matrix in VS
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
- END IF
-*
- SDIM = 0
-*
-* Perform QR iteration, accumulating Schur vectors in VS if desired
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
- $ WORK( IWRK ), LWORK-IWRK+1, IEVAL )
- IF( IEVAL.GT.0 )
- $ INFO = IEVAL
-*
-* Sort eigenvalues if desired
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
- IF( SCALEA ) THEN
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
- END IF
- DO 10 I = 1, N
- BWORK( I ) = SELECT( WR( I ), WI( I ) )
- 10 CONTINUE
-*
-* Reorder eigenvalues and transform Schur vectors
-* (Workspace: none needed)
-*
- CALL STRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
- $ SDIM, S, SEP, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
- $ ICOND )
- IF( ICOND.GT.0 )
- $ INFO = N + ICOND
- END IF
-*
- IF( WANTVS ) THEN
-*
-* Undo balancing
-* (Workspace: need N)
-*
- CALL SGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
- $ IERR )
- END IF
-*
- IF( SCALEA ) THEN
-*
-* Undo scaling for the Schur form of A
-*
- CALL SLASCL( 'H', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
- CALL SCOPY( N, A, LDA+1, WR, 1 )
- IF( CSCALE.EQ.SMLNUM ) THEN
-*
-* If scaling back towards underflow, adjust WI if an
-* offdiagonal element of a 2-by-2 block in the Schur form
-* underflows.
-*
- IF( IEVAL.GT.0 ) THEN
- I1 = IEVAL + 1
- I2 = IHI - 1
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI,
- $ MAX( ILO-1, 1 ), IERR )
- ELSE IF( WANTST ) THEN
- I1 = 1
- I2 = N - 1
- ELSE
- I1 = ILO
- I2 = IHI - 1
- END IF
- INXT = I1 - 1
- DO 20 I = I1, I2
- IF( I.LT.INXT )
- $ GO TO 20
- IF( WI( I ).EQ.ZERO ) THEN
- INXT = I + 1
- ELSE
- IF( A( I+1, I ).EQ.ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- ELSE IF( A( I+1, I ).NE.ZERO .AND. A( I, I+1 ).EQ.
- $ ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- IF( I.GT.1 )
- $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
- IF( N.GT.I+1 )
- $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA,
- $ A( I+1, I+2 ), LDA )
- IF( WANTVS ) THEN
- CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
- END IF
- A( I, I+1 ) = A( I+1, I )
- A( I+1, I ) = ZERO
- END IF
- INXT = I + 2
- END IF
- 20 CONTINUE
- END IF
-*
-* Undo scaling for the imaginary part of the eigenvalues
-*
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
- $ WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
- END IF
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
-*
-* Check if reordering successful
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 30 I = 1, N
- CURSL = SELECT( WR( I ), WI( I ) )
- IF( WI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 30 CONTINUE
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of SGEES
-*
- END
diff --git a/netlib/LAPACK/sgeesx.f b/netlib/LAPACK/sgeesx.f
deleted file mode 100644
index fe98b45..0000000
--- a/netlib/LAPACK/sgeesx.f
+++ /dev/null
@@ -1,649 +0,0 @@
-*> \brief <b> SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEESX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeesx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeesx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeesx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
-* WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
-* IWORK, LIWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVS, SENSE, SORT
-* INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
-* REAL RCONDE, RCONDV
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
-* $ WR( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELECT
-* EXTERNAL SELECT
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEESX computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues, the real Schur form T, and, optionally, the matrix of
-*> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
-*>
-*> Optionally, it also orders the eigenvalues on the diagonal of the
-*> real Schur form so that selected eigenvalues are at the top left;
-*> computes a reciprocal condition number for the average of the
-*> selected eigenvalues (RCONDE); and computes a reciprocal condition
-*> number for the right invariant subspace corresponding to the
-*> selected eigenvalues (RCONDV). The leading columns of Z form an
-*> orthonormal basis for this invariant subspace.
-*>
-*> For further explanation of the reciprocal condition numbers RCONDE
-*> and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
-*> these quantities are called s and sep respectively).
-*>
-*> A real matrix is in real Schur form if it is upper quasi-triangular
-*> with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
-*> the form
-*> [ a b ]
-*> [ c a ]
-*>
-*> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVS
-*> \verbatim
-*> JOBVS is CHARACTER*1
-*> = 'N': Schur vectors are not computed;
-*> = 'V': Schur vectors are computed.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELECT).
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is procedure) LOGICAL FUNCTION of two REAL arguments
-*> SELECT must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'S', SELECT is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> If SORT = 'N', SELECT is not referenced.
-*> An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
-*> SELECT(WR(j),WI(j)) is true; i.e., if either one of a
-*> complex conjugate pair of eigenvalues is selected, then both
-*> are. Note that a selected complex eigenvalue may no longer
-*> satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
-*> ordering may change the value of complex eigenvalues
-*> (especially if the eigenvalue is ill-conditioned); in this
-*> case INFO may be set to N+3 (see INFO below).
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N': None are computed;
-*> = 'E': Computed for average of selected eigenvalues only;
-*> = 'V': Computed for selected right invariant subspace only;
-*> = 'B': Computed for both.
-*> If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A is overwritten by its real Schur form T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELECT is true. (Complex conjugate
-*> pairs for which SELECT is true for either
-*> eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*> WR and WI contain the real and imaginary parts, respectively,
-*> of the computed eigenvalues, in the same order that they
-*> appear on the diagonal of the output Schur form T. Complex
-*> conjugate pairs of eigenvalues appear consecutively with the
-*> eigenvalue having the positive imaginary part first.
-*> \endverbatim
-*>
-*> \param[out] VS
-*> \verbatim
-*> VS is REAL array, dimension (LDVS,N)
-*> If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
-*> vectors.
-*> If JOBVS = 'N', VS is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVS
-*> \verbatim
-*> LDVS is INTEGER
-*> The leading dimension of the array VS. LDVS >= 1, and if
-*> JOBVS = 'V', LDVS >= N.
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is REAL
-*> If SENSE = 'E' or 'B', RCONDE contains the reciprocal
-*> condition number for the average of the selected eigenvalues.
-*> Not referenced if SENSE = 'N' or 'V'.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is REAL
-*> If SENSE = 'V' or 'B', RCONDV contains the reciprocal
-*> condition number for the selected right invariant subspace.
-*> Not referenced if SENSE = 'N' or 'E'.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N).
-*> Also, if SENSE = 'E' or 'V' or 'B',
-*> LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
-*> selected eigenvalues computed by this routine. Note that
-*> N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
-*> returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
-*> 'B' this may not be large enough.
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates upper bounds on the optimal sizes of the
-*> arrays WORK and IWORK, returns these values as the first
-*> entries of the WORK and IWORK arrays, and no error messages
-*> related to LWORK or LIWORK are issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
-*> Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
-*> only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
-*> may not be large enough.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates upper bounds on the optimal sizes of
-*> the arrays WORK and IWORK, returns these values as the first
-*> entries of the WORK and IWORK arrays, and no error messages
-*> related to LWORK or LIWORK are issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, and i is
-*> <= N: the QR algorithm failed to compute all the
-*> eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
-*> contain those eigenvalues which have converged; if
-*> JOBVS = 'V', VS contains the transformation which
-*> reduces A to its partially converged Schur form.
-*> = N+1: the eigenvalues could not be reordered because some
-*> eigenvalues were too close to separate (the problem
-*> is very ill-conditioned);
-*> = N+2: after reordering, roundoff changed values of some
-*> complex eigenvalues so that leading eigenvalues in
-*> the Schur form no longer satisfy SELECT=.TRUE. This
-*> could also be caused by underflow due to scaling.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
- $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
- $ IWORK, LIWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVS, SENSE, SORT
- INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
- REAL RCONDE, RCONDV
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- REAL A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
- $ WR( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELECT
- EXTERNAL SELECT
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
- $ WANTSE, WANTSN, WANTST, WANTSV, WANTVS
- INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
- $ IHI, ILO, INXT, IP, ITAU, IWRK, LWRK, LIWRK,
- $ MAXWRK, MINWRK
- REAL ANRM, BIGNUM, CSCALE, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD,
- $ SLACPY, SLASCL, SORGHR, SSWAP, STRSEN, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- WANTVS = LSAME( JOBVS, 'V' )
- WANTST = LSAME( SORT, 'S' )
- WANTSN = LSAME( SENSE, 'N' )
- WANTSE = LSAME( SENSE, 'E' )
- WANTSV = LSAME( SENSE, 'V' )
- WANTSB = LSAME( SENSE, 'B' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
- $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
- INFO = -12
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "RWorkspace:" describe the
-* minimal amount of real workspace needed at that point in the
-* code, as well as the preferred amount for good performance.
-* IWorkspace refers to integer workspace.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by SHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.
-* If SENSE = 'E', 'V' or 'B', then the amount of workspace needed
-* depends on SDIM, which is computed by the routine STRSEN later
-* in the code.)
-*
- IF( INFO.EQ.0 ) THEN
- LIWRK = 1
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- LWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
- MINWRK = 3*N
-*
- CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
- $ WORK, -1, IEVAL )
- HSWORK = WORK( 1 )
-*
- IF( .NOT.WANTVS ) THEN
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- ELSE
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'SORGHR', ' ', N, 1, N, -1 ) )
- MAXWRK = MAX( MAXWRK, N + HSWORK )
- END IF
- LWRK = MAXWRK
- IF( .NOT.WANTSN )
- $ LWRK = MAX( LWRK, N + ( N*N )/2 )
- IF( WANTSV .OR. WANTSB )
- $ LIWRK = ( N*N )/4
- END IF
- IWORK( 1 ) = LIWRK
- WORK( 1 ) = LWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -16
- ELSE IF( LIWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -18
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEESX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL SLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (RWorkspace: need N)
-*
- IBAL = 1
- CALL SGEBAL( 'P', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (RWorkspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = N + IBAL
- IWRK = N + ITAU
- CALL SGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVS ) THEN
-*
-* Copy Householder vectors to VS
-*
- CALL SLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-* Generate orthogonal matrix in VS
-* (RWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
- END IF
-*
- SDIM = 0
-*
-* Perform QR iteration, accumulating Schur vectors in VS if desired
-* (RWorkspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
- $ WORK( IWRK ), LWORK-IWRK+1, IEVAL )
- IF( IEVAL.GT.0 )
- $ INFO = IEVAL
-*
-* Sort eigenvalues if desired
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
- IF( SCALEA ) THEN
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
- END IF
- DO 10 I = 1, N
- BWORK( I ) = SELECT( WR( I ), WI( I ) )
- 10 CONTINUE
-*
-* Reorder eigenvalues, transform Schur vectors, and compute
-* reciprocal condition numbers
-* (RWorkspace: if SENSE is not 'N', need N+2*SDIM*(N-SDIM)
-* otherwise, need N )
-* (IWorkspace: if SENSE is 'V' or 'B', need SDIM*(N-SDIM)
-* otherwise, need 0 )
-*
- CALL STRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
- $ SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1,
- $ IWORK, LIWORK, ICOND )
- IF( .NOT.WANTSN )
- $ MAXWRK = MAX( MAXWRK, N+2*SDIM*( N-SDIM ) )
- IF( ICOND.EQ.-15 ) THEN
-*
-* Not enough real workspace
-*
- INFO = -16
- ELSE IF( ICOND.EQ.-17 ) THEN
-*
-* Not enough integer workspace
-*
- INFO = -18
- ELSE IF( ICOND.GT.0 ) THEN
-*
-* STRSEN failed to reorder or to restore standard Schur form
-*
- INFO = ICOND + N
- END IF
- END IF
-*
- IF( WANTVS ) THEN
-*
-* Undo balancing
-* (RWorkspace: need N)
-*
- CALL SGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
- $ IERR )
- END IF
-*
- IF( SCALEA ) THEN
-*
-* Undo scaling for the Schur form of A
-*
- CALL SLASCL( 'H', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
- CALL SCOPY( N, A, LDA+1, WR, 1 )
- IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN
- DUM( 1 ) = RCONDV
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
- RCONDV = DUM( 1 )
- END IF
- IF( CSCALE.EQ.SMLNUM ) THEN
-*
-* If scaling back towards underflow, adjust WI if an
-* offdiagonal element of a 2-by-2 block in the Schur form
-* underflows.
-*
- IF( IEVAL.GT.0 ) THEN
- I1 = IEVAL + 1
- I2 = IHI - 1
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- ELSE IF( WANTST ) THEN
- I1 = 1
- I2 = N - 1
- ELSE
- I1 = ILO
- I2 = IHI - 1
- END IF
- INXT = I1 - 1
- DO 20 I = I1, I2
- IF( I.LT.INXT )
- $ GO TO 20
- IF( WI( I ).EQ.ZERO ) THEN
- INXT = I + 1
- ELSE
- IF( A( I+1, I ).EQ.ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- ELSE IF( A( I+1, I ).NE.ZERO .AND. A( I, I+1 ).EQ.
- $ ZERO ) THEN
- WI( I ) = ZERO
- WI( I+1 ) = ZERO
- IF( I.GT.1 )
- $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
- IF( N.GT.I+1 )
- $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA,
- $ A( I+1, I+2 ), LDA )
- CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
- A( I, I+1 ) = A( I+1, I )
- A( I+1, I ) = ZERO
- END IF
- INXT = I + 2
- END IF
- 20 CONTINUE
- END IF
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
- $ WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
- END IF
-*
- IF( WANTST .AND. INFO.EQ.0 ) THEN
-*
-* Check if reordering successful
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 30 I = 1, N
- CURSL = SELECT( WR( I ), WI( I ) )
- IF( WI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 30 CONTINUE
- END IF
-*
- WORK( 1 ) = MAXWRK
- IF( WANTSV .OR. WANTSB ) THEN
- IWORK( 1 ) = SDIM*(N-SDIM)
- ELSE
- IWORK( 1 ) = 1
- END IF
-*
- RETURN
-*
-* End of SGEESX
-*
- END
diff --git a/netlib/LAPACK/sgeev.f b/netlib/LAPACK/sgeev.f
deleted file mode 100644
index 89dbe08..0000000
--- a/netlib/LAPACK/sgeev.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief <b> SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
-* LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEEV computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues and, optionally, the left and/or right eigenvectors.
-*>
-*> The right eigenvector v(j) of A satisfies
-*> A * v(j) = lambda(j) * v(j)
-*> where lambda(j) is its eigenvalue.
-*> The left eigenvector u(j) of A satisfies
-*> u(j)**H * A = lambda(j) * u(j)**H
-*> where u(j)**H denotes the conjugate-transpose of u(j).
-*>
-*> The computed eigenvectors are normalized to have Euclidean norm
-*> equal to 1 and largest component real.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': left eigenvectors of A are not computed;
-*> = 'V': left eigenvectors of A are computed.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': right eigenvectors of A are not computed;
-*> = 'V': right eigenvectors of A are computed.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues. Complex
-*> conjugate pairs of eigenvalues appear consecutively
-*> with the eigenvalue having the positive imaginary part
-*> first.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order
-*> as their eigenvalues.
-*> If JOBVL = 'N', VL is not referenced.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j),
-*> the j-th column of VL.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1; if
-*> JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order
-*> as their eigenvalues.
-*> If JOBVR = 'N', VR is not referenced.
-*> If the j-th eigenvalue is real, then v(j) = VR(:,j),
-*> the j-th column of VR.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
-*> v(j+1) = VR(:,j) - i*VR(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1; if
-*> JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N), and
-*> if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
-*> performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the QR algorithm failed to compute all the
-*> eigenvalues, and no eigenvectors have been computed;
-*> elements i+1:N of WR and WI contain eigenvalues which
-*> have converged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
- $ LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
- CHARACTER SIDE
- INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
- $ MAXWRK, MINWRK, NOUT
- REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
- $ SN
-* ..
-* .. Local Arrays ..
- LOGICAL SELECT( 1 )
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY,
- $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV, ISAMAX
- REAL SLAMCH, SLANGE, SLAPY2, SNRM2
- EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2,
- $ SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVL = LSAME( JOBVL, 'V' )
- WANTVR = LSAME( JOBVR, 'V' )
- IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
- INFO = -9
- ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by SHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
- IF( WANTVL ) THEN
- MINWRK = 4*N
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'SORGHR', ' ', N, 1, N, -1 ) )
- CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- MAXWRK = MAX( MAXWRK, 4*N )
- ELSE IF( WANTVR ) THEN
- MINWRK = 4*N
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'SORGHR', ' ', N, 1, N, -1 ) )
- CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- MAXWRK = MAX( MAXWRK, 4*N )
- ELSE
- MINWRK = 3*N
- CALL SHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL SLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Balance the matrix
-* (Workspace: need N)
-*
- IBAL = 1
- CALL SGEBAL( 'B', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = IBAL + N
- IWRK = ITAU + N
- CALL SGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVL ) THEN
-*
-* Want left eigenvectors
-* Copy Householder vectors to VL
-*
- SIDE = 'L'
- CALL SLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-* Generate orthogonal matrix in VL
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VL
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- IF( WANTVR ) THEN
-*
-* Want left and right eigenvectors
-* Copy Schur vectors to VR
-*
- SIDE = 'B'
- CALL SLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
- END IF
-*
- ELSE IF( WANTVR ) THEN
-*
-* Want right eigenvectors
-* Copy Householder vectors to VR
-*
- SIDE = 'R'
- CALL SLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-* Generate orthogonal matrix in VR
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VR
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- ELSE
-*
-* Compute eigenvalues only
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
- END IF
-*
-* If INFO > 0 from SHSEQR, then quit
-*
- IF( INFO.GT.0 )
- $ GO TO 50
-*
- IF( WANTVL .OR. WANTVR ) THEN
-*
-* Compute left and/or right eigenvectors
-* (Workspace: need 4*N)
-*
- CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ N, NOUT, WORK( IWRK ), IERR )
- END IF
-*
- IF( WANTVL ) THEN
-*
-* Undo balancing of left eigenvectors
-* (Workspace: need N)
-*
- CALL SGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL,
- $ IERR )
-*
-* Normalize left eigenvectors and make largest component real
-*
- DO 20 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / SNRM2( N, VL( 1, I ), 1 )
- CALL SSCAL( N, SCL, VL( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / SLAPY2( SNRM2( N, VL( 1, I ), 1 ),
- $ SNRM2( N, VL( 1, I+1 ), 1 ) )
- CALL SSCAL( N, SCL, VL( 1, I ), 1 )
- CALL SSCAL( N, SCL, VL( 1, I+1 ), 1 )
- DO 10 K = 1, N
- WORK( IWRK+K-1 ) = VL( K, I )**2 + VL( K, I+1 )**2
- 10 CONTINUE
- K = ISAMAX( N, WORK( IWRK ), 1 )
- CALL SLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R )
- CALL SROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN )
- VL( K, I+1 ) = ZERO
- END IF
- 20 CONTINUE
- END IF
-*
- IF( WANTVR ) THEN
-*
-* Undo balancing of right eigenvectors
-* (Workspace: need N)
-*
- CALL SGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR,
- $ IERR )
-*
-* Normalize right eigenvectors and make largest component real
-*
- DO 40 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / SNRM2( N, VR( 1, I ), 1 )
- CALL SSCAL( N, SCL, VR( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / SLAPY2( SNRM2( N, VR( 1, I ), 1 ),
- $ SNRM2( N, VR( 1, I+1 ), 1 ) )
- CALL SSCAL( N, SCL, VR( 1, I ), 1 )
- CALL SSCAL( N, SCL, VR( 1, I+1 ), 1 )
- DO 30 K = 1, N
- WORK( IWRK+K-1 ) = VR( K, I )**2 + VR( K, I+1 )**2
- 30 CONTINUE
- K = ISAMAX( N, WORK( IWRK ), 1 )
- CALL SLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R )
- CALL SROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN )
- VR( K, I+1 ) = ZERO
- END IF
- 40 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 50 CONTINUE
- IF( SCALEA ) THEN
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- IF( INFO.GT.0 ) THEN
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- END IF
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of SGEEV
-*
- END
diff --git a/netlib/LAPACK/sgeevx.f b/netlib/LAPACK/sgeevx.f
deleted file mode 100644
index 821c080..0000000
--- a/netlib/LAPACK/sgeevx.f
+++ /dev/null
@@ -1,680 +0,0 @@
-*> \brief <b> SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
-* VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
-* RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER BALANC, JOBVL, JOBVR, SENSE
-* INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
-* REAL ABNRM
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ),
-* $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEEVX computes for an N-by-N real nonsymmetric matrix A, the
-*> eigenvalues and, optionally, the left and/or right eigenvectors.
-*>
-*> Optionally also, it computes a balancing transformation to improve
-*> the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
-*> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
-*> (RCONDE), and reciprocal condition numbers for the right
-*> eigenvectors (RCONDV).
-*>
-*> The right eigenvector v(j) of A satisfies
-*> A * v(j) = lambda(j) * v(j)
-*> where lambda(j) is its eigenvalue.
-*> The left eigenvector u(j) of A satisfies
-*> u(j)**H * A = lambda(j) * u(j)**H
-*> where u(j)**H denotes the conjugate-transpose of u(j).
-*>
-*> The computed eigenvectors are normalized to have Euclidean norm
-*> equal to 1 and largest component real.
-*>
-*> Balancing a matrix means permuting the rows and columns to make it
-*> more nearly upper triangular, and applying a diagonal similarity
-*> transformation D * A * D**(-1), where D is a diagonal matrix, to
-*> make its rows and columns closer in norm and the condition numbers
-*> of its eigenvalues and eigenvectors smaller. The computed
-*> reciprocal condition numbers correspond to the balanced matrix.
-*> Permuting rows and columns will not change the condition numbers
-*> (in exact arithmetic) but diagonal scaling will. For further
-*> explanation of balancing, see section 4.10.2 of the LAPACK
-*> Users' Guide.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] BALANC
-*> \verbatim
-*> BALANC is CHARACTER*1
-*> Indicates how the input matrix should be diagonally scaled
-*> and/or permuted to improve the conditioning of its
-*> eigenvalues.
-*> = 'N': Do not diagonally scale or permute;
-*> = 'P': Perform permutations to make the matrix more nearly
-*> upper triangular. Do not diagonally scale;
-*> = 'S': Diagonally scale the matrix, i.e. replace A by
-*> D*A*D**(-1), where D is a diagonal matrix chosen
-*> to make the rows and columns of A more equal in
-*> norm. Do not permute;
-*> = 'B': Both diagonally scale and permute A.
-*>
-*> Computed reciprocal condition numbers will be for the matrix
-*> after balancing and/or permuting. Permuting does not change
-*> condition numbers (in exact arithmetic), but balancing does.
-*> \endverbatim
-*>
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': left eigenvectors of A are not computed;
-*> = 'V': left eigenvectors of A are computed.
-*> If SENSE = 'E' or 'B', JOBVL must = 'V'.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': right eigenvectors of A are not computed;
-*> = 'V': right eigenvectors of A are computed.
-*> If SENSE = 'E' or 'B', JOBVR must = 'V'.
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N': None are computed;
-*> = 'E': Computed for eigenvalues only;
-*> = 'V': Computed for right eigenvectors only;
-*> = 'B': Computed for eigenvalues and right eigenvectors.
-*>
-*> If SENSE = 'E' or 'B', both left and right eigenvectors
-*> must also be computed (JOBVL = 'V' and JOBVR = 'V').
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten. If JOBVL = 'V' or
-*> JOBVR = 'V', A contains the real Schur form of the balanced
-*> version of the input matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues. Complex
-*> conjugate pairs of eigenvalues will appear consecutively
-*> with the eigenvalue having the positive imaginary part
-*> first.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order
-*> as their eigenvalues.
-*> If JOBVL = 'N', VL is not referenced.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j),
-*> the j-th column of VL.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1; if
-*> JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order
-*> as their eigenvalues.
-*> If JOBVR = 'N', VR is not referenced.
-*> If the j-th eigenvalue is real, then v(j) = VR(:,j),
-*> the j-th column of VR.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
-*> v(j+1) = VR(:,j) - i*VR(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are integer values determined when A was
-*> balanced. The balanced A(i,j) = 0 if I > J and
-*> J = 1,...,ILO-1 or I = IHI+1,...,N.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> when balancing A. If P(j) is the index of the row and column
-*> interchanged with row and column j, and D(j) is the scaling
-*> factor applied to row and column j, then
-*> SCALE(J) = P(J), for J = 1,...,ILO-1
-*> = D(J), for J = ILO,...,IHI
-*> = P(J) for J = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] ABNRM
-*> \verbatim
-*> ABNRM is REAL
-*> The one-norm of the balanced matrix (the maximum
-*> of the sum of absolute values of elements of any column).
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is REAL array, dimension (N)
-*> RCONDE(j) is the reciprocal condition number of the j-th
-*> eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is REAL array, dimension (N)
-*> RCONDV(j) is the reciprocal condition number of the j-th
-*> right eigenvector.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. If SENSE = 'N' or 'E',
-*> LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
-*> LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*N-2)
-*> If SENSE = 'N' or 'E', not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the QR algorithm failed to compute all the
-*> eigenvalues, and no eigenvectors or condition numbers
-*> have been computed; elements 1:ILO-1 and i+1:N of WR
-*> and WI contain eigenvalues which have converged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
- $ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
- $ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER BALANC, JOBVL, JOBVR, SENSE
- INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
- REAL ABNRM
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), RCONDE( * ), RCONDV( * ),
- $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
- $ WNTSNN, WNTSNV
- CHARACTER JOB, SIDE
- INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK,
- $ MINWRK, NOUT
- REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
- $ SN
-* ..
-* .. Local Arrays ..
- LOGICAL SELECT( 1 )
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY,
- $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC,
- $ STRSNA, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV, ISAMAX
- REAL SLAMCH, SLANGE, SLAPY2, SNRM2
- EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2,
- $ SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVL = LSAME( JOBVL, 'V' )
- WANTVR = LSAME( JOBVR, 'V' )
- WNTSNN = LSAME( SENSE, 'N' )
- WNTSNE = LSAME( SENSE, 'E' )
- WNTSNV = LSAME( SENSE, 'V' )
- WNTSNB = LSAME( SENSE, 'B' )
- IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR.
- $ LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR.
- $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND.
- $ WANTVR ) ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
- INFO = -11
- ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
- INFO = -13
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by SHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
-*
- IF( WANTVL ) THEN
- CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
- $ WORK, -1, INFO )
- ELSE IF( WANTVR ) THEN
- CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- ELSE
- IF( WNTSNN ) THEN
- CALL SHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR,
- $ LDVR, WORK, -1, INFO )
- ELSE
- CALL SHSEQR( 'S', 'N', N, 1, N, A, LDA, WR, WI, VR,
- $ LDVR, WORK, -1, INFO )
- END IF
- END IF
- HSWORK = WORK( 1 )
-*
- IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
- MINWRK = 2*N
- IF( .NOT.WNTSNN )
- $ MINWRK = MAX( MINWRK, N*N+6*N )
- MAXWRK = MAX( MAXWRK, HSWORK )
- IF( .NOT.WNTSNN )
- $ MAXWRK = MAX( MAXWRK, N*N + 6*N )
- ELSE
- MINWRK = 3*N
- IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) )
- $ MINWRK = MAX( MINWRK, N*N + 6*N )
- MAXWRK = MAX( MAXWRK, HSWORK )
- MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'SORGHR',
- $ ' ', N, 1, N, -1 ) )
- IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) )
- $ MAXWRK = MAX( MAXWRK, N*N + 6*N )
- MAXWRK = MAX( MAXWRK, 3*N )
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -21
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEEVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ICOND = 0
- ANRM = SLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL SLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Balance the matrix and compute ABNRM
-*
- CALL SGEBAL( BALANC, N, A, LDA, ILO, IHI, SCALE, IERR )
- ABNRM = SLANGE( '1', N, N, A, LDA, DUM )
- IF( SCALEA ) THEN
- DUM( 1 ) = ABNRM
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
- ABNRM = DUM( 1 )
- END IF
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- ITAU = 1
- IWRK = ITAU + N
- CALL SGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVL ) THEN
-*
-* Want left eigenvectors
-* Copy Householder vectors to VL
-*
- SIDE = 'L'
- CALL SLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-* Generate orthogonal matrix in VL
-* (Workspace: need 2*N-1, prefer N+(N-1)*NB)
-*
- CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VL
-* (Workspace: need 1, prefer HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- IF( WANTVR ) THEN
-*
-* Want left and right eigenvectors
-* Copy Schur vectors to VR
-*
- SIDE = 'B'
- CALL SLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
- END IF
-*
- ELSE IF( WANTVR ) THEN
-*
-* Want right eigenvectors
-* Copy Householder vectors to VR
-*
- SIDE = 'R'
- CALL SLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-* Generate orthogonal matrix in VR
-* (Workspace: need 2*N-1, prefer N+(N-1)*NB)
-*
- CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VR
-* (Workspace: need 1, prefer HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- ELSE
-*
-* Compute eigenvalues only
-* If condition numbers desired, compute Schur form
-*
- IF( WNTSNN ) THEN
- JOB = 'E'
- ELSE
- JOB = 'S'
- END IF
-*
-* (Workspace: need 1, prefer HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL SHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
- END IF
-*
-* If INFO > 0 from SHSEQR, then quit
-*
- IF( INFO.GT.0 )
- $ GO TO 50
-*
- IF( WANTVL .OR. WANTVR ) THEN
-*
-* Compute left and/or right eigenvectors
-* (Workspace: need 3*N)
-*
- CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ N, NOUT, WORK( IWRK ), IERR )
- END IF
-*
-* Compute condition numbers if desired
-* (Workspace: need N*N+6*N unless SENSE = 'E')
-*
- IF( .NOT.WNTSNN ) THEN
- CALL STRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, IWORK,
- $ ICOND )
- END IF
-*
- IF( WANTVL ) THEN
-*
-* Undo balancing of left eigenvectors
-*
- CALL SGEBAK( BALANC, 'L', N, ILO, IHI, SCALE, N, VL, LDVL,
- $ IERR )
-*
-* Normalize left eigenvectors and make largest component real
-*
- DO 20 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / SNRM2( N, VL( 1, I ), 1 )
- CALL SSCAL( N, SCL, VL( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / SLAPY2( SNRM2( N, VL( 1, I ), 1 ),
- $ SNRM2( N, VL( 1, I+1 ), 1 ) )
- CALL SSCAL( N, SCL, VL( 1, I ), 1 )
- CALL SSCAL( N, SCL, VL( 1, I+1 ), 1 )
- DO 10 K = 1, N
- WORK( K ) = VL( K, I )**2 + VL( K, I+1 )**2
- 10 CONTINUE
- K = ISAMAX( N, WORK, 1 )
- CALL SLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R )
- CALL SROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN )
- VL( K, I+1 ) = ZERO
- END IF
- 20 CONTINUE
- END IF
-*
- IF( WANTVR ) THEN
-*
-* Undo balancing of right eigenvectors
-*
- CALL SGEBAK( BALANC, 'R', N, ILO, IHI, SCALE, N, VR, LDVR,
- $ IERR )
-*
-* Normalize right eigenvectors and make largest component real
-*
- DO 40 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / SNRM2( N, VR( 1, I ), 1 )
- CALL SSCAL( N, SCL, VR( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / SLAPY2( SNRM2( N, VR( 1, I ), 1 ),
- $ SNRM2( N, VR( 1, I+1 ), 1 ) )
- CALL SSCAL( N, SCL, VR( 1, I ), 1 )
- CALL SSCAL( N, SCL, VR( 1, I+1 ), 1 )
- DO 30 K = 1, N
- WORK( K ) = VR( K, I )**2 + VR( K, I+1 )**2
- 30 CONTINUE
- K = ISAMAX( N, WORK, 1 )
- CALL SLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R )
- CALL SROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN )
- VR( K, I+1 ) = ZERO
- END IF
- 40 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 50 CONTINUE
- IF( SCALEA ) THEN
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- IF( INFO.EQ.0 ) THEN
- IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 )
- $ CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N,
- $ IERR )
- ELSE
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- END IF
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of SGEEVX
-*
- END
diff --git a/netlib/LAPACK/sgegs.f b/netlib/LAPACK/sgegs.f
deleted file mode 100644
index 7eac0f4..0000000
--- a/netlib/LAPACK/sgegs.f
+++ /dev/null
@@ -1,541 +0,0 @@
-*> \brief <b> SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgegs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgegs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR,
-* ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVSL, JOBVSR
-* INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
-* $ VSR( LDVSR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine SGGES.
-*>
-*> SGEGS computes the eigenvalues, real Schur form, and, optionally,
-*> left and or/right Schur vectors of a real matrix pair (A,B).
-*> Given two square matrices A and B, the generalized real Schur
-*> factorization has the form
-*>
-*> A = Q*S*Z**T, B = Q*T*Z**T
-*>
-*> where Q and Z are orthogonal matrices, T is upper triangular, and S
-*> is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
-*> blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
-*> of eigenvalues of (A,B). The columns of Q are the left Schur vectors
-*> and the columns of Z are the right Schur vectors.
-*>
-*> If only the eigenvalues of (A,B) are needed, the driver routine
-*> SGEGV should be used instead. See SGEGV for a description of the
-*> eigenvalues of the generalized nonsymmetric eigenvalue problem
-*> (GNEP).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVSL
-*> \verbatim
-*> JOBVSL is CHARACTER*1
-*> = 'N': do not compute the left Schur vectors;
-*> = 'V': compute the left Schur vectors (returned in VSL).
-*> \endverbatim
-*>
-*> \param[in] JOBVSR
-*> \verbatim
-*> JOBVSR is CHARACTER*1
-*> = 'N': do not compute the right Schur vectors;
-*> = 'V': compute the right Schur vectors (returned in VSR).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VSL, and VSR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the matrix A.
-*> On exit, the upper quasi-triangular matrix S from the
-*> generalized real Schur factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the matrix B.
-*> On exit, the upper triangular matrix T from the generalized
-*> real Schur factorization.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> The real parts of each scalar alpha defining an eigenvalue
-*> of GNEP.
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> The imaginary parts of each scalar alpha defining an
-*> eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
-*> eigenvalue is real; if positive, then the j-th and (j+1)-st
-*> eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) = -ALPHAI(j).
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> The scalars beta that define the eigenvalues of GNEP.
-*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*> beta = BETA(j) represent the j-th eigenvalue of the matrix
-*> pair (A,B), in one of the forms lambda = alpha/beta or
-*> mu = beta/alpha. Since either lambda or mu may overflow,
-*> they should not, in general, be computed.
-*> \endverbatim
-*>
-*> \param[out] VSL
-*> \verbatim
-*> VSL is REAL array, dimension (LDVSL,N)
-*> If JOBVSL = 'V', the matrix of left Schur vectors Q.
-*> Not referenced if JOBVSL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSL
-*> \verbatim
-*> LDVSL is INTEGER
-*> The leading dimension of the matrix VSL. LDVSL >=1, and
-*> if JOBVSL = 'V', LDVSL >= N.
-*> \endverbatim
-*>
-*> \param[out] VSR
-*> \verbatim
-*> VSR is REAL array, dimension (LDVSR,N)
-*> If JOBVSR = 'V', the matrix of right Schur vectors Z.
-*> Not referenced if JOBVSR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSR
-*> \verbatim
-*> LDVSR is INTEGER
-*> The leading dimension of the matrix VSR. LDVSR >= 1, and
-*> if JOBVSR = 'V', LDVSR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,4*N).
-*> For good performance, LWORK must generally be larger.
-*> To compute the optimal value of LWORK, call ILAENV to get
-*> blocksizes (for SGEQRF, SORMQR, and SORGQR.) Then compute:
-*> NB -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR
-*> The optimal LWORK is 2*N + N*(NB+1).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. (A,B) are not in Schur
-*> form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*> be correct for j=INFO+1,...,N.
-*> > N: errors that usually indicate LAPACK problems:
-*> =N+1: error return from SGGBAL
-*> =N+2: error return from SGEQRF
-*> =N+3: error return from SORMQR
-*> =N+4: error return from SORGQR
-*> =N+5: error return from SGGHRD
-*> =N+6: error return from SHGEQZ (other than failed
-*> iteration)
-*> =N+7: error return from SGGBAK (computing VSL)
-*> =N+8: error return from SGGBAK (computing VSR)
-*> =N+9: error return from SLASCL (various places)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR,
- $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVSL, JOBVSR
- INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
- $ VSR( LDVSR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILVSL, ILVSR, LQUERY
- INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT,
- $ ILO, IRIGHT, IROWS, ITAU, IWORK, LOPT, LWKMIN,
- $ LWKOPT, NB, NB1, NB2, NB3
- REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
- $ SAFMIN, SMLNUM
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY,
- $ SLASCL, SLASET, SORGQR, SORMQR, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVSL, 'N' ) ) THEN
- IJOBVL = 1
- ILVSL = .FALSE.
- ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
- IJOBVL = 2
- ILVSL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVSL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVSR, 'N' ) ) THEN
- IJOBVR = 1
- ILVSR = .FALSE.
- ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
- IJOBVR = 2
- ILVSR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVSR = .FALSE.
- END IF
-*
-* Test the input arguments
-*
- LWKMIN = MAX( 4*N, 1 )
- LWKOPT = LWKMIN
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- INFO = 0
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
- INFO = -12
- ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -16
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB1 = ILAENV( 1, 'SGEQRF', ' ', N, N, -1, -1 )
- NB2 = ILAENV( 1, 'SORMQR', ' ', N, N, N, -1 )
- NB3 = ILAENV( 1, 'SORGQR', ' ', N, N, N, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LOPT = 2*N+N*(NB+1)
- WORK( 1 ) = LOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEGS ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'E' )*SLAMCH( 'B' )
- SAFMIN = SLAMCH( 'S' )
- SMLNUM = N*SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = SLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
-*
- IF( ILBSCL ) THEN
- CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
-* Permute the matrix to make it more nearly triangular
-* Workspace layout: (2*N words -- "work..." not actually used)
-* left_permutation, right_permutation, work...
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWORK = IRIGHT + N
- CALL SGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWORK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 1
- GO TO 10
- END IF
-*
-* Reduce B to triangular form, and initialize VSL and/or VSR
-* Workspace layout: ("work..." must have at least N words)
-* left_permutation, right_permutation, tau, work...
-*
- IROWS = IHI + 1 - ILO
- ICOLS = N + 1 - ILO
- ITAU = IWORK
- IWORK = ITAU + IROWS
- CALL SGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 2
- GO TO 10
- END IF
-*
- CALL SORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWORK ),
- $ LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 3
- GO TO 10
- END IF
-*
- IF( ILVSL ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
- CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VSL( ILO+1, ILO ), LDVSL )
- CALL SORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
- $ WORK( ITAU ), WORK( IWORK ), LWORK+1-IWORK,
- $ IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 4
- GO TO 10
- END IF
- END IF
-*
- IF( ILVSR )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-* Reduce to generalized Hessenberg form
-*
- CALL SGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
- $ LDVSL, VSR, LDVSR, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 5
- GO TO 10
- END IF
-*
-* Perform QZ algorithm, computing Schur vectors if desired
-* Workspace layout: ("work..." must have at least 1 word)
-* left_permutation, right_permutation, work...
-*
- IWORK = ITAU
- CALL SHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- IF( IINFO.GT.0 .AND. IINFO.LE.N ) THEN
- INFO = IINFO
- ELSE IF( IINFO.GT.N .AND. IINFO.LE.2*N ) THEN
- INFO = IINFO - N
- ELSE
- INFO = N + 6
- END IF
- GO TO 10
- END IF
-*
-* Apply permutation to VSL and VSR
-*
- IF( ILVSL ) THEN
- CALL SGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSL, LDVSL, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 7
- GO TO 10
- END IF
- END IF
- IF( ILVSR ) THEN
- CALL SGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSR, LDVSR, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 8
- GO TO 10
- END IF
- END IF
-*
-* Undo scaling
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- CALL SLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHAR, N,
- $ IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- CALL SLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHAI, N,
- $ IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
- IF( ILBSCL ) THEN
- 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 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- RETURN
- END IF
- END IF
-*
- 10 CONTINUE
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SGEGS
-*
- END
diff --git a/netlib/LAPACK/sgegv.f b/netlib/LAPACK/sgegv.f
deleted file mode 100644
index 0491ca1..0000000
--- a/netlib/LAPACK/sgegv.f
+++ /dev/null
@@ -1,769 +0,0 @@
-*> \brief <b> SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgegv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgegv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-* BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine SGGEV.
-*>
-*> SGEGV computes the eigenvalues and, optionally, the left and/or right
-*> eigenvectors of a real matrix pair (A,B).
-*> Given two square matrices A and B,
-*> the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
-*> eigenvalues lambda and corresponding (non-zero) eigenvectors x such
-*> that
-*>
-*> A*x = lambda*B*x.
-*>
-*> An alternate form is to find the eigenvalues mu and corresponding
-*> eigenvectors y such that
-*>
-*> mu*A*y = B*y.
-*>
-*> These two forms are equivalent with mu = 1/lambda and x = y if
-*> neither lambda nor mu is zero. In order to deal with the case that
-*> lambda or mu is zero or small, two values alpha and beta are returned
-*> for each eigenvalue, such that lambda = alpha/beta and
-*> mu = beta/alpha.
-*>
-*> The vectors x and y in the above equations are right eigenvectors of
-*> the matrix pair (A,B). Vectors u and v satisfying
-*>
-*> u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
-*>
-*> are left eigenvectors of (A,B).
-*>
-*> Note: this routine performs "full balancing" on A and B
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': do not compute the left generalized eigenvectors;
-*> = 'V': compute the left generalized eigenvectors (returned
-*> in VL).
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': do not compute the right generalized eigenvectors;
-*> = 'V': compute the right generalized eigenvectors (returned
-*> in VR).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VL, and VR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the matrix A.
-*> If JOBVL = 'V' or JOBVR = 'V', then on exit A
-*> contains the real Schur form of A from the generalized Schur
-*> factorization of the pair (A,B) after balancing.
-*> If no eigenvectors were computed, then only the diagonal
-*> blocks from the Schur form will be correct. See SGGHRD and
-*> SHGEQZ for details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the matrix B.
-*> If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
-*> upper triangular matrix obtained from B in the generalized
-*> Schur factorization of the pair (A,B) after balancing.
-*> If no eigenvectors were computed, then only those elements of
-*> B corresponding to the diagonal blocks from the Schur form of
-*> A will be correct. See SGGHRD and SHGEQZ for details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> The real parts of each scalar alpha defining an eigenvalue of
-*> GNEP.
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> The imaginary parts of each scalar alpha defining an
-*> eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
-*> eigenvalue is real; if positive, then the j-th and
-*> (j+1)-st eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) = -ALPHAI(j).
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> The scalars beta that define the eigenvalues of GNEP.
-*>
-*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*> beta = BETA(j) represent the j-th eigenvalue of the matrix
-*> pair (A,B), in one of the forms lambda = alpha/beta or
-*> mu = beta/alpha. Since either lambda or mu may overflow,
-*> they should not, in general, be computed.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored
-*> in the columns of VL, in the same order as their eigenvalues.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j).
-*> If the j-th and (j+1)-st eigenvalues form a complex conjugate
-*> pair, then
-*> u(j) = VL(:,j) + i*VL(:,j+1)
-*> and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*>
-*> Each eigenvector is scaled so that its largest component has
-*> abs(real part) + abs(imag. part) = 1, except for eigenvectors
-*> corresponding to an eigenvalue with alpha = beta = 0, which
-*> are set to zero.
-*> Not referenced if JOBVL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the matrix VL. LDVL >= 1, and
-*> if JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors x(j) are stored
-*> in the columns of VR, in the same order as their eigenvalues.
-*> If the j-th eigenvalue is real, then x(j) = VR(:,j).
-*> If the j-th and (j+1)-st eigenvalues form a complex conjugate
-*> pair, then
-*> x(j) = VR(:,j) + i*VR(:,j+1)
-*> and
-*> x(j+1) = VR(:,j) - i*VR(:,j+1).
-*>
-*> Each eigenvector is scaled so that its largest component has
-*> abs(real part) + abs(imag. part) = 1, except for eigenvalues
-*> corresponding to an eigenvalue with alpha = beta = 0, which
-*> are set to zero.
-*> Not referenced if JOBVR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the matrix VR. LDVR >= 1, and
-*> if JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,8*N).
-*> For good performance, LWORK must generally be larger.
-*> To compute the optimal value of LWORK, call ILAENV to get
-*> blocksizes (for SGEQRF, SORMQR, and SORGQR.) Then compute:
-*> NB -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR;
-*> The optimal LWORK is:
-*> 2*N + MAX( 6*N, N*(NB+1) ).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. No eigenvectors have been
-*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*> should be correct for j=INFO+1,...,N.
-*> > N: errors that usually indicate LAPACK problems:
-*> =N+1: error return from SGGBAL
-*> =N+2: error return from SGEQRF
-*> =N+3: error return from SORMQR
-*> =N+4: error return from SORGQR
-*> =N+5: error return from SGGHRD
-*> =N+6: error return from SHGEQZ (other than failed
-*> iteration)
-*> =N+7: error return from STGEVC
-*> =N+8: error return from SGGBAK (computing VL)
-*> =N+9: error return from SGGBAK (computing VR)
-*> =N+10: error return from SLASCL (various calls)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Balancing
-*> ---------
-*>
-*> This driver calls SGGBAL to both permute and scale rows and columns
-*> of A and B. The permutations PL and PR are chosen so that PL*A*PR
-*> and PL*B*R will be upper triangular except for the diagonal blocks
-*> A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
-*> possible. The diagonal scaling matrices DL and DR are chosen so
-*> that the pair DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
-*> one (except for the elements that start out zero.)
-*>
-*> After the eigenvalues and eigenvectors of the balanced matrices
-*> have been computed, SGGBAK transforms the eigenvectors back to what
-*> they would have been (in perfect arithmetic) if they had not been
-*> balanced.
-*>
-*> Contents of A and B on Exit
-*> -------- -- - --- - -- ----
-*>
-*> If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
-*> both), then on exit the arrays A and B will contain the real Schur
-*> form[*] of the "balanced" versions of A and B. If no eigenvectors
-*> are computed, then only the diagonal blocks will be correct.
-*>
-*> [*] See SHGEQZ, SGEGS, or read the book "Matrix Computations",
-*> by Golub & van Loan, pub. by Johns Hopkins U. Press.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
- $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILIMIT, ILV, ILVL, ILVR, LQUERY
- CHARACTER CHTEMP
- INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT, ILO,
- $ IN, IRIGHT, IROWS, ITAU, IWORK, JC, JR, LOPT,
- $ LWKMIN, LWKOPT, NB, NB1, NB2, NB3
- REAL ABSAI, ABSAR, ABSB, ANRM, ANRM1, ANRM2, BNRM,
- $ BNRM1, BNRM2, EPS, ONEPLS, SAFMAX, SAFMIN,
- $ SALFAI, SALFAR, SBETA, SCALE, TEMP
-* ..
-* .. Local Arrays ..
- LOGICAL LDUMMA( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY,
- $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVL, 'N' ) ) THEN
- IJOBVL = 1
- ILVL = .FALSE.
- ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
- IJOBVL = 2
- ILVL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVR, 'N' ) ) THEN
- IJOBVR = 1
- ILVR = .FALSE.
- ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
- IJOBVR = 2
- ILVR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVR = .FALSE.
- END IF
- ILV = ILVL .OR. ILVR
-*
-* Test the input arguments
-*
- LWKMIN = MAX( 8*N, 1 )
- LWKOPT = LWKMIN
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- INFO = 0
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
- INFO = -12
- ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -16
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB1 = ILAENV( 1, 'SGEQRF', ' ', N, N, -1, -1 )
- NB2 = ILAENV( 1, 'SORMQR', ' ', N, N, N, -1 )
- NB3 = ILAENV( 1, 'SORGQR', ' ', N, N, N, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LOPT = 2*N + MAX( 6*N, N*(NB+1) )
- WORK( 1 ) = LOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEGV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'E' )*SLAMCH( 'B' )
- SAFMIN = SLAMCH( 'S' )
- SAFMIN = SAFMIN + SAFMIN
- SAFMAX = ONE / SAFMIN
- ONEPLS = ONE + ( 4*EPS )
-*
-* Scale A
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, WORK )
- ANRM1 = ANRM
- ANRM2 = ONE
- IF( ANRM.LT.ONE ) THEN
- IF( SAFMAX*ANRM.LT.ONE ) THEN
- ANRM1 = SAFMIN
- ANRM2 = SAFMAX*ANRM
- END IF
- END IF
-*
- IF( ANRM.GT.ZERO ) THEN
- CALL SLASCL( 'G', -1, -1, ANRM, ONE, N, N, A, LDA, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 10
- RETURN
- END IF
- END IF
-*
-* Scale B
-*
- BNRM = SLANGE( 'M', N, N, B, LDB, WORK )
- BNRM1 = BNRM
- BNRM2 = ONE
- IF( BNRM.LT.ONE ) THEN
- IF( SAFMAX*BNRM.LT.ONE ) THEN
- BNRM1 = SAFMIN
- BNRM2 = SAFMAX*BNRM
- END IF
- END IF
-*
- IF( BNRM.GT.ZERO ) THEN
- CALL SLASCL( 'G', -1, -1, BNRM, ONE, N, N, B, LDB, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 10
- RETURN
- END IF
- END IF
-*
-* Permute the matrix to make it more nearly triangular
-* Workspace layout: (8*N words -- "work" requires 6*N words)
-* left_permutation, right_permutation, work...
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWORK = IRIGHT + N
- CALL SGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWORK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 1
- GO TO 120
- END IF
-*
-* Reduce B to triangular form, and initialize VL and/or VR
-* Workspace layout: ("work..." must have at least N words)
-* left_permutation, right_permutation, tau, work...
-*
- IROWS = IHI + 1 - ILO
- IF( ILV ) THEN
- ICOLS = N + 1 - ILO
- ELSE
- ICOLS = IROWS
- END IF
- ITAU = IWORK
- IWORK = ITAU + IROWS
- CALL SGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 2
- GO TO 120
- END IF
-*
- CALL SORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWORK ),
- $ LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 3
- GO TO 120
- END IF
-*
- IF( ILVL ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
- CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VL( ILO+1, ILO ), LDVL )
- CALL SORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
- $ WORK( ITAU ), WORK( IWORK ), LWORK+1-IWORK,
- $ IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 4
- GO TO 120
- END IF
- END IF
-*
- IF( ILVR )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-* Reduce to generalized Hessenberg form
-*
- IF( ILV ) THEN
-*
-* Eigenvectors requested -- work on whole matrix.
-*
- CALL SGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, IINFO )
- ELSE
- CALL SGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
- $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IINFO )
- END IF
- IF( IINFO.NE.0 ) THEN
- INFO = N + 5
- GO TO 120
- END IF
-*
-* Perform QZ algorithm
-* Workspace layout: ("work..." must have at least 1 word)
-* left_permutation, right_permutation, work...
-*
- IWORK = ITAU
- IF( ILV ) THEN
- CHTEMP = 'S'
- ELSE
- CHTEMP = 'E'
- END IF
- CALL SHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
- $ WORK( IWORK ), LWORK+1-IWORK, IINFO )
- IF( IINFO.GE.0 )
- $ LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
- IF( IINFO.NE.0 ) THEN
- IF( IINFO.GT.0 .AND. IINFO.LE.N ) THEN
- INFO = IINFO
- ELSE IF( IINFO.GT.N .AND. IINFO.LE.2*N ) THEN
- INFO = IINFO - N
- ELSE
- INFO = N + 6
- END IF
- GO TO 120
- END IF
-*
- IF( ILV ) THEN
-*
-* Compute Eigenvectors (STGEVC requires 6*N words of workspace)
-*
- IF( ILVL ) THEN
- IF( ILVR ) THEN
- CHTEMP = 'B'
- ELSE
- CHTEMP = 'L'
- END IF
- ELSE
- CHTEMP = 'R'
- END IF
-*
- CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
- $ VR, LDVR, N, IN, WORK( IWORK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 7
- GO TO 120
- END IF
-*
-* Undo balancing on VL and VR, rescale
-*
- IF( ILVL ) THEN
- CALL SGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VL, LDVL, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 8
- GO TO 120
- END IF
- DO 50 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 50
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 10 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
- 10 CONTINUE
- ELSE
- DO 20 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
- $ ABS( VL( JR, JC+1 ) ) )
- 20 CONTINUE
- END IF
- IF( TEMP.LT.SAFMIN )
- $ GO TO 50
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 30 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- 30 CONTINUE
- ELSE
- DO 40 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
- 40 CONTINUE
- END IF
- 50 CONTINUE
- END IF
- IF( ILVR ) THEN
- CALL SGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VR, LDVR, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = N + 9
- GO TO 120
- END IF
- DO 100 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 100
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 60 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
- 60 CONTINUE
- ELSE
- DO 70 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
- $ ABS( VR( JR, JC+1 ) ) )
- 70 CONTINUE
- END IF
- IF( TEMP.LT.SAFMIN )
- $ GO TO 100
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 80 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- 80 CONTINUE
- ELSE
- DO 90 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- END IF
-*
-* End of eigenvector calculation
-*
- END IF
-*
-* Undo scaling in alpha, beta
-*
-* Note: this does not give the alpha and beta for the unscaled
-* problem.
-*
-* Un-scaling is limited to avoid underflow in alpha and beta
-* if they are significant.
-*
- DO 110 JC = 1, N
- ABSAR = ABS( ALPHAR( JC ) )
- ABSAI = ABS( ALPHAI( JC ) )
- ABSB = ABS( BETA( JC ) )
- SALFAR = ANRM*ALPHAR( JC )
- SALFAI = ANRM*ALPHAI( JC )
- SBETA = BNRM*BETA( JC )
- ILIMIT = .FALSE.
- SCALE = ONE
-*
-* Check for significant underflow in ALPHAI
-*
- IF( ABS( SALFAI ).LT.SAFMIN .AND. ABSAI.GE.
- $ MAX( SAFMIN, EPS*ABSAR, EPS*ABSB ) ) THEN
- ILIMIT = .TRUE.
- SCALE = ( ONEPLS*SAFMIN / ANRM1 ) /
- $ MAX( ONEPLS*SAFMIN, ANRM2*ABSAI )
-*
- ELSE IF( SALFAI.EQ.ZERO ) THEN
-*
-* If insignificant underflow in ALPHAI, then make the
-* conjugate eigenvalue real.
-*
- IF( ALPHAI( JC ).LT.ZERO .AND. JC.GT.1 ) THEN
- ALPHAI( JC-1 ) = ZERO
- ELSE IF( ALPHAI( JC ).GT.ZERO .AND. JC.LT.N ) THEN
- ALPHAI( JC+1 ) = ZERO
- END IF
- END IF
-*
-* Check for significant underflow in ALPHAR
-*
- IF( ABS( SALFAR ).LT.SAFMIN .AND. ABSAR.GE.
- $ MAX( SAFMIN, EPS*ABSAI, EPS*ABSB ) ) THEN
- ILIMIT = .TRUE.
- SCALE = MAX( SCALE, ( ONEPLS*SAFMIN / ANRM1 ) /
- $ MAX( ONEPLS*SAFMIN, ANRM2*ABSAR ) )
- END IF
-*
-* Check for significant underflow in BETA
-*
- IF( ABS( SBETA ).LT.SAFMIN .AND. ABSB.GE.
- $ MAX( SAFMIN, EPS*ABSAR, EPS*ABSAI ) ) THEN
- ILIMIT = .TRUE.
- SCALE = MAX( SCALE, ( ONEPLS*SAFMIN / BNRM1 ) /
- $ MAX( ONEPLS*SAFMIN, BNRM2*ABSB ) )
- END IF
-*
-* Check for possible overflow when limiting scaling
-*
- IF( ILIMIT ) THEN
- TEMP = ( SCALE*SAFMIN )*MAX( ABS( SALFAR ), ABS( SALFAI ),
- $ ABS( SBETA ) )
- IF( TEMP.GT.ONE )
- $ SCALE = SCALE / TEMP
- IF( SCALE.LT.ONE )
- $ ILIMIT = .FALSE.
- END IF
-*
-* Recompute un-scaled ALPHAR, ALPHAI, BETA if necessary.
-*
- IF( ILIMIT ) THEN
- SALFAR = ( SCALE*ALPHAR( JC ) )*ANRM
- SALFAI = ( SCALE*ALPHAI( JC ) )*ANRM
- SBETA = ( SCALE*BETA( JC ) )*BNRM
- END IF
- ALPHAR( JC ) = SALFAR
- ALPHAI( JC ) = SALFAI
- BETA( JC ) = SBETA
- 110 CONTINUE
-*
- 120 CONTINUE
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SGEGV
-*
- END
diff --git a/netlib/LAPACK/sgehd2.f b/netlib/LAPACK/sgehd2.f
deleted file mode 100644
index 6c8fc13..0000000
--- a/netlib/LAPACK/sgehd2.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b SGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEHD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgehd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgehd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgehd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEHD2 reduces a real general matrix A to upper Hessenberg form H by
-*> an orthogonal similarity transformation: Q**T * A * Q = H .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that A is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to SGEBAL; otherwise they should be
-*> set to 1 and N respectively. See Further Details.
-*> 1 <= ILO <= IHI <= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the n by n general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> elements below the first subdiagonal, with the array TAU,
-*> represent the orthogonal matrix Q as a product of elementary
-*> reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of (ihi-ilo) elementary
-*> reflectors
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*> exit in A(i+2:ihi,i), and tau in TAU(i).
-*>
-*> The contents of A are illustrated by the following example, with
-*> n = 7, ilo = 2 and ihi = 6:
-*>
-*> on entry, on exit,
-*>
-*> ( a a a a a a a ) ( a a h h h h a )
-*> ( a a a a a a ) ( a h h h h a )
-*> ( a a a a a a ) ( h h h h h h )
-*> ( a a a a a a ) ( v2 h h h h h )
-*> ( a a a a a a ) ( v2 v3 h h h h )
-*> ( a a a a a a ) ( v2 v3 v4 h h h )
-*> ( a ) ( a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL AII
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEHD2', -INFO )
- RETURN
- END IF
-*
- DO 10 I = ILO, IHI - 1
-*
-* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
-*
- CALL SLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAU( I ) )
- AII = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Apply H(i) to A(1:ihi,i+1:ihi) from the right
-*
- CALL SLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
- $ A( 1, I+1 ), LDA, WORK )
-*
-* Apply H(i) to A(i+1:ihi,i+1:n) from the left
-*
- CALL SLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
- $ A( I+1, I+1 ), LDA, WORK )
-*
- A( I+1, I ) = AII
- 10 CONTINUE
-*
- RETURN
-*
-* End of SGEHD2
-*
- END
diff --git a/netlib/LAPACK/sgehrd.f b/netlib/LAPACK/sgehrd.f
deleted file mode 100644
index b88ea03..0000000
--- a/netlib/LAPACK/sgehrd.f
+++ /dev/null
@@ -1,352 +0,0 @@
-*> \brief \b SGEHRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEHRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgehrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgehrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgehrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEHRD reduces a real general matrix A to upper Hessenberg form H by
-*> an orthogonal similarity transformation: Q**T * A * Q = H .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that A is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to SGEBAL; otherwise they should be
-*> set to 1 and N respectively. See Further Details.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> elements below the first subdiagonal, with the array TAU,
-*> represent the orthogonal matrix Q as a product of elementary
-*> reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
-*> zero.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of (ihi-ilo) elementary
-*> reflectors
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*> exit in A(i+2:ihi,i), and tau in TAU(i).
-*>
-*> The contents of A are illustrated by the following example, with
-*> n = 7, ilo = 2 and ihi = 6:
-*>
-*> on entry, on exit,
-*>
-*> ( a a a a a a a ) ( a a h h h h a )
-*> ( a a a a a a ) ( a h h h h a )
-*> ( a a a a a a ) ( h h h h h h )
-*> ( a a a a a a ) ( v2 h h h h h )
-*> ( a a a a a a ) ( v2 v3 h h h h )
-*> ( a a a a a a ) ( v2 v3 v4 h h h )
-*> ( a ) ( a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*>
-*> This file is a slight modification of LAPACK-3.0's DGEHRD
-*> subroutine incorporating improvements proposed by Quintana-Orti and
-*> Van de Geijn (2006). (See DLAHR2.)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0,
- $ ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, LDWORK, LWKOPT, NB,
- $ NBMIN, NH, NX
- REAL EI
-* ..
-* .. Local Arrays ..
- REAL T( LDT, NBMAX )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SGEHD2, SGEMM, SLAHR2, SLARFB, STRMM,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, -1 ) )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEHRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
-*
- DO 10 I = 1, ILO - 1
- TAU( I ) = ZERO
- 10 CONTINUE
- DO 20 I = MAX( 1, IHI ), N - 1
- TAU( I ) = ZERO
- 20 CONTINUE
-*
-* Quick return if possible
-*
- NH = IHI - ILO + 1
- IF( NH.LE.1 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
-* Determine the block size
-*
- NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, -1 ) )
- NBMIN = 2
- IWS = 1
- IF( NB.GT.1 .AND. NB.LT.NH ) THEN
-*
-* Determine when to cross over from blocked to unblocked code
-* (last block is always handled by unblocked code)
-*
- NX = MAX( NB, ILAENV( 3, 'SGEHRD', ' ', N, ILO, IHI, -1 ) )
- IF( NX.LT.NH ) THEN
-*
-* Determine if workspace is large enough for blocked code
-*
- IWS = N*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: determine the
-* minimum value of NB, and reduce NB or force use of
-* unblocked code
-*
- NBMIN = MAX( 2, ILAENV( 2, 'SGEHRD', ' ', N, ILO, IHI,
- $ -1 ) )
- IF( LWORK.GE.N*NBMIN ) THEN
- NB = LWORK / N
- ELSE
- NB = 1
- END IF
- END IF
- END IF
- END IF
- LDWORK = N
-*
- IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN
-*
-* Use unblocked code below
-*
- I = ILO
-*
- ELSE
-*
-* Use blocked code
-*
- DO 40 I = ILO, IHI - 1 - NX, NB
- IB = MIN( NB, IHI-I )
-*
-* Reduce columns i:i+ib-1 to Hessenberg form, returning the
-* matrices V and T of the block reflector H = I - V*T*V**T
-* which performs the reduction, and also the matrix Y = A*V*T
-*
- CALL SLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,
- $ WORK, LDWORK )
-*
-* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
-* right, computing A := A - Y * V**T. V(i+ib,ib-1) must be set
-* to 1
-*
- EI = A( I+IB, I+IB-1 )
- A( I+IB, I+IB-1 ) = ONE
- CALL SGEMM( 'No transpose', 'Transpose',
- $ IHI, IHI-I-IB+1,
- $ IB, -ONE, WORK, LDWORK, A( I+IB, I ), LDA, ONE,
- $ A( 1, I+IB ), LDA )
- A( I+IB, I+IB-1 ) = EI
-*
-* Apply the block reflector H to A(1:i,i+1:i+ib-1) from the
-* right
-*
- CALL STRMM( 'Right', 'Lower', 'Transpose',
- $ 'Unit', I, IB-1,
- $ ONE, A( I+1, I ), LDA, WORK, LDWORK )
- DO 30 J = 0, IB-2
- CALL SAXPY( I, -ONE, WORK( LDWORK*J+1 ), 1,
- $ A( 1, I+J+1 ), 1 )
- 30 CONTINUE
-*
-* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
-* left
-*
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise',
- $ IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT,
- $ A( I+1, I+IB ), LDA, WORK, LDWORK )
- 40 CONTINUE
- END IF
-*
-* Use unblocked code to reduce the rest of the matrix
-*
- CALL SGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
- WORK( 1 ) = IWS
-*
- RETURN
-*
-* End of SGEHRD
-*
- END
diff --git a/netlib/LAPACK/sgejsv.f b/netlib/LAPACK/sgejsv.f
deleted file mode 100644
index d15bd4b..0000000
--- a/netlib/LAPACK/sgejsv.f
+++ /dev/null
@@ -1,1777 +0,0 @@
-*> \brief \b SGEJSV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEJSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgejsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgejsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgejsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
-* M, N, A, LDA, SVA, U, LDU, V, LDV,
-* WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* IMPLICIT NONE
-* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), SVA( N ), U( LDU, * ), V( LDV, * ),
-* $ WORK( LWORK )
-* INTEGER IWORK( * )
-* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEJSV computes the singular value decomposition (SVD) of a real M-by-N
-*> matrix [A], where M >= N. The SVD of [A] is written as
-*>
-*> [A] = [U] * [SIGMA] * [V]^t,
-*>
-*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N
-*> diagonal elements, [U] is an M-by-N (or M-by-M) orthonormal matrix, and
-*> [V] is an N-by-N orthogonal matrix. The diagonal elements of [SIGMA] are
-*> the singular values of [A]. The columns of [U] and [V] are the left and
-*> the right singular vectors of [A], respectively. The matrices [U] and [V]
-*> are computed and stored in the arrays U and V, respectively. The diagonal
-*> of [SIGMA] is computed and stored in the array SVA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBA
-*> \verbatim
-*> JOBA is CHARACTER*1
-*> Specifies the level of accuracy:
-*> = 'C': This option works well (high relative accuracy) if A = B * D,
-*> with well-conditioned B and arbitrary diagonal matrix D.
-*> The accuracy cannot be spoiled by COLUMN scaling. The
-*> accuracy of the computed output depends on the condition of
-*> B, and the procedure aims at the best theoretical accuracy.
-*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is
-*> bounded by f(M,N)*epsilon* cond(B), independent of D.
-*> The input matrix is preprocessed with the QRF with column
-*> pivoting. This initial preprocessing and preconditioning by
-*> a rank revealing QR factorization is common for all values of
-*> JOBA. Additional actions are specified as follows:
-*> = 'E': Computation as with 'C' with an additional estimate of the
-*> condition number of B. It provides a realistic error bound.
-*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings
-*> D1, D2, and well-conditioned matrix C, this option gives
-*> higher accuracy than the 'C' option. If the structure of the
-*> input matrix is not known, and relative accuracy is
-*> desirable, then this option is advisable. The input matrix A
-*> is preprocessed with QR factorization with FULL (row and
-*> column) pivoting.
-*> = 'G' Computation as with 'F' with an additional estimate of the
-*> condition number of B, where A=D*B. If A has heavily weighted
-*> rows, then using this condition number gives too pessimistic
-*> error bound.
-*> = 'A': Small singular values are the noise and the matrix is treated
-*> as numerically rank defficient. The error in the computed
-*> singular values is bounded by f(m,n)*epsilon*||A||.
-*> The computed SVD A = U * S * V^t restores A up to
-*> f(m,n)*epsilon*||A||.
-*> This gives the procedure the licence to discard (set to zero)
-*> all singular values below N*epsilon*||A||.
-*> = 'R': Similar as in 'A'. Rank revealing property of the initial
-*> QR factorization is used do reveal (using triangular factor)
-*> a gap sigma_{r+1} < epsilon * sigma_r in which case the
-*> numerical RANK is declared to be r. The SVD is computed with
-*> absolute error bounds, but more accurately than with 'A'.
-*> \endverbatim
-*>
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies whether to compute the columns of U:
-*> = 'U': N columns of U are returned in the array U.
-*> = 'F': full set of M left sing. vectors is returned in the array U.
-*> = 'W': U may be used as workspace of length M*N. See the description
-*> of U.
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether to compute the matrix V:
-*> = 'V': N columns of V are returned in the array V; Jacobi rotations
-*> are not explicitly accumulated.
-*> = 'J': N columns of V are returned in the array V, but they are
-*> computed as the product of Jacobi rotations. This option is
-*> allowed only if JOBU .NE. 'N', i.e. in computing the full SVD.
-*> = 'W': V may be used as workspace of length N*N. See the description
-*> of V.
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBR
-*> \verbatim
-*> JOBR is CHARACTER*1
-*> Specifies the RANGE for the singular values. Issues the licence to
-*> set to zero small positive singular values if they are outside
-*> specified range. If A .NE. 0 is scaled so that the largest singular
-*> value of c*A is around SQRT(BIG), BIG=SLAMCH('O'), then JOBR issues
-*> the licence to kill columns of A whose norm in c*A is less than
-*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN,
-*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E').
-*> = 'N': Do not kill small columns of c*A. This option assumes that
-*> BLAS and QR factorizations and triangular solvers are
-*> implemented to work in that range. If the condition of A
-*> is greater than BIG, use SGESVJ.
-*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)]
-*> (roughly, as described above). This option is recommended.
-*> ===========================
-*> For computing the singular values in the FULL range [SFMIN,BIG]
-*> use SGESVJ.
-*> \endverbatim
-*>
-*> \param[in] JOBT
-*> \verbatim
-*> JOBT is CHARACTER*1
-*> If the matrix is square then the procedure may determine to use
-*> transposed A if A^t seems to be better with respect to convergence.
-*> If the matrix is not square, JOBT is ignored. This is subject to
-*> changes in the future.
-*> The decision is based on two values of entropy over the adjoint
-*> orbit of A^t * A. See the descriptions of WORK(6) and WORK(7).
-*> = 'T': transpose if entropy test indicates possibly faster
-*> convergence of Jacobi process if A^t is taken as input. If A is
-*> replaced with A^t, then the row pivoting is included automatically.
-*> = 'N': do not speculate.
-*> This option can be used to compute only the singular values, or the
-*> full SVD (U, SIGMA and V). For only one set of singular vectors
-*> (U or V), the caller should provide both U and V, as one of the
-*> matrices is used as workspace if the matrix A is transposed.
-*> The implementer can easily remove this constraint and make the
-*> code more complicated. See the descriptions of U and V.
-*> \endverbatim
-*>
-*> \param[in] JOBP
-*> \verbatim
-*> JOBP is CHARACTER*1
-*> Issues the licence to introduce structured perturbations to drown
-*> denormalized numbers. This licence should be active if the
-*> denormals are poorly implemented, causing slow computation,
-*> especially in cases of fast convergence (!). For details see [1,2].
-*> For the sake of simplicity, this perturbations are included only
-*> when the full SVD or only the singular values are requested. The
-*> implementer/user can easily add the perturbation for the cases of
-*> computing one set of singular vectors.
-*> = 'P': introduce perturbation
-*> = 'N': do not perturb
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] SVA
-*> \verbatim
-*> SVA is REAL array, dimension (N)
-*> On exit,
-*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the
-*> computation SVA contains Euclidean column norms of the
-*> iterated matrices in the array A.
-*> - For WORK(1) .NE. WORK(2): The singular values of A are
-*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if
-*> sigma_max(A) overflows or if small singular values have been
-*> saved from underflow by scaling the input matrix A.
-*> - If JOBR='R' then some of the singular values may be returned
-*> as exact zeros obtained by "set to zero" because they are
-*> below the numerical rank threshold or are denormalized numbers.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension ( LDU, N )
-*> If JOBU = 'U', then U contains on exit the M-by-N matrix of
-*> the left singular vectors.
-*> If JOBU = 'F', then U contains on exit the M-by-M matrix of
-*> the left singular vectors, including an ONB
-*> of the orthogonal complement of the Range(A).
-*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N),
-*> then U is used as workspace if the procedure
-*> replaces A with A^t. In that case, [V] is computed
-*> in U as left singular vectors of A^t and then
-*> copied back to the V array. This 'W' option is just
-*> a reminder to the caller that in this case U is
-*> reserved as workspace of length N*N.
-*> If JOBU = 'N' U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U, LDU >= 1.
-*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension ( LDV, N )
-*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of
-*> the right singular vectors;
-*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N),
-*> then V is used as workspace if the pprocedure
-*> replaces A with A^t. In that case, [U] is computed
-*> in V as right singular vectors of A^t and then
-*> copied back to the U array. This 'W' option is just
-*> a reminder to the caller that in this case V is
-*> reserved as workspace of length N*N.
-*> If JOBV = 'N' V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV >= 1.
-*> If JOBV = 'V' or 'J' or 'W', then LDV >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension at least LWORK.
-*> On exit,
-*> WORK(1) = SCALE = WORK(2) / WORK(1) is the scaling factor such
-*> that SCALE*SVA(1:N) are the computed singular values
-*> of A. (See the description of SVA().)
-*> WORK(2) = See the description of WORK(1).
-*> WORK(3) = SCONDA is an estimate for the condition number of
-*> column equilibrated A. (If JOBA .EQ. 'E' or 'G')
-*> SCONDA is an estimate of SQRT(||(R^t * R)^(-1)||_1).
-*> It is computed using SPOCON. It holds
-*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
-*> where R is the triangular factor from the QRF of A.
-*> However, if R is truncated and the numerical rank is
-*> determined to be strictly smaller than N, SCONDA is
-*> returned as -1, thus indicating that the smallest
-*> singular values might be lost.
-*>
-*> If full SVD is needed, the following two condition numbers are
-*> useful for the analysis of the algorithm. They are provied for
-*> a developer/implementer who is familiar with the details of
-*> the method.
-*>
-*> WORK(4) = an estimate of the scaled condition number of the
-*> triangular factor in the first QR factorization.
-*> WORK(5) = an estimate of the scaled condition number of the
-*> triangular factor in the second QR factorization.
-*> The following two parameters are computed if JOBT .EQ. 'T'.
-*> They are provided for a developer/implementer who is familiar
-*> with the details of the method.
-*>
-*> WORK(6) = the entropy of A^t*A :: this is the Shannon entropy
-*> of diag(A^t*A) / Trace(A^t*A) taken as point in the
-*> probability simplex.
-*> WORK(7) = the entropy of A*A^t.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> Length of WORK to confirm proper allocation of work space.
-*> LWORK depends on the job:
-*>
-*> If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and
-*> -> .. no scaled condition estimate required (JOBE.EQ.'N'):
-*> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement.
-*> ->> For optimal performance (blocked code) the optimal value
-*> is LWORK >= max(2*M+N,3*N+(N+1)*NB,7). Here NB is the optimal
-*> block size for DGEQP3 and DGEQRF.
-*> In general, optimal LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), 7).
-*> -> .. an estimate of the scaled condition number of A is
-*> required (JOBA='E', 'G'). In this case, LWORK is the maximum
-*> of the above and N*N+4*N, i.e. LWORK >= max(2*M+N,N*N+4*N,7).
-*> ->> For optimal performance (blocked code) the optimal value
-*> is LWORK >= max(2*M+N,3*N+(N+1)*NB, N*N+4*N, 7).
-*> In general, the optimal length LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF),
-*> N+N*N+LWORK(DPOCON),7).
-*>
-*> If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'),
-*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7).
-*> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7),
-*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQ,
-*> DORMLQ. In general, the optimal length LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3), N+LWORK(DPOCON),
-*> N+LWORK(DGELQ), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)).
-*>
-*> If SIGMA and the left singular vectors are needed
-*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7).
-*> -> For optimal performance:
-*> if JOBU.EQ.'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7),
-*> if JOBU.EQ.'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7),
-*> where NB is the optimal block size for DGEQP3, DGEQRF, DORMQR.
-*> In general, the optimal length LWORK is computed as
-*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON),
-*> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)).
-*> Here LWORK(DORMQR) equals N*NB (for JOBU.EQ.'U') or
-*> M*NB (for JOBU.EQ.'F').
-*>
-*> If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and
-*> -> if JOBV.EQ.'V'
-*> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N).
-*> -> if JOBV.EQ.'J' the minimal requirement is
-*> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6).
-*> -> For optimal performance, LWORK should be additionally
-*> larger than N+M*NB, where NB is the optimal block size
-*> for DORMQR.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension M+3*N.
-*> On exit,
-*> IWORK(1) = the numerical rank determined after the initial
-*> QR factorization with pivoting. See the descriptions
-*> of JOBA and JOBR.
-*> IWORK(2) = the number of the computed nonzero singular values
-*> IWORK(3) = if nonzero, a warning message:
-*> If IWORK(3).EQ.1 then some of the column norms of A
-*> were denormalized floats. The requested high accuracy
-*> is not warranted by the data.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value.
-*> = 0 : successfull exit;
-*> > 0 : SGEJSV did not converge in the maximal allowed number
-*> of sweeps. The computed values may be inaccurate.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEsing
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> SGEJSV implements a preconditioned Jacobi SVD algorithm. It uses SGEQP3,
-*> SGEQRF, and SGELQF as preprocessors and preconditioners. Optionally, an
-*> additional row pivoting can be used as a preprocessor, which in some
-*> cases results in much higher accuracy. An example is matrix A with the
-*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned
-*> diagonal matrices and C is well-conditioned matrix. In that case, complete
-*> pivoting in the first QR factorizations provides accuracy dependent on the
-*> condition number of C, and independent of D1, D2. Such higher accuracy is
-*> not completely understood theoretically, but it works well in practice.
-*> Further, if A can be written as A = B*D, with well-conditioned B and some
-*> diagonal D, then the high accuracy is guaranteed, both theoretically and
-*> in software, independent of D. For more details see [1], [2].
-*> The computational range for the singular values can be the full range
-*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS
-*> & LAPACK routines called by SGEJSV are implemented to work in that range.
-*> If that is not the case, then the restriction for safe computation with
-*> the singular values in the range of normalized IEEE numbers is that the
-*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not
-*> overflow. This code (SGEJSV) is best used in this restricted range,
-*> meaning that singular values of magnitude below ||A||_2 / SLAMCH('O') are
-*> returned as zeros. See JOBR for details on this.
-*> Further, this implementation is somewhat slower than the one described
-*> in [1,2] due to replacement of some non-LAPACK components, and because
-*> the choice of some tuning parameters in the iterative part (SGESVJ) is
-*> left to the implementer on a particular machine.
-*> The rank revealing QR factorization (in this code: SGEQP3) should be
-*> implemented as in [3]. We have a new version of SGEQP3 under development
-*> that is more robust than the current one in LAPACK, with a cleaner cut in
-*> rank defficient cases. It will be available in the SIGMA library [4].
-*> If M is much larger than N, it is obvious that the inital QRF with
-*> column pivoting can be preprocessed by the QRF without pivoting. That
-*> well known trick is not used in SGEJSV because in some cases heavy row
-*> weighting can be treated with complete pivoting. The overhead in cases
-*> M much larger than N is then only due to pivoting, but the benefits in
-*> terms of accuracy have prevailed. The implementer/user can incorporate
-*> this extra QRF step easily. The implementer can also improve data movement
-*> (matrix transpose, matrix copy, matrix transposed copy) - this
-*> implementation of SGEJSV uses only the simplest, naive data movement.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.
-*> LAPACK Working note 169.
-*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.
-*> LAPACK Working note 170.
-*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR
-*> factorization software - a case study.
-*> ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28.
-*> LAPACK Working note 176.
-*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,
-*> QSVD, (H,K)-SVD computations.
-*> Department of Mathematics, University of Zagreb, 2008.
-*> \endverbatim
-*
-*> \par Bugs, examples and comments:
-* =================================
-*>
-*> Please report all bugs and send interesting examples and/or comments to
-*> drmac at math.hr. Thank you.
-*>
-* =====================================================================
- SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
- $ M, N, A, LDA, SVA, U, LDU, V, LDV,
- $ WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- IMPLICIT NONE
- INTEGER INFO, LDA, LDU, LDV, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), SVA( N ), U( LDU, * ), V( LDV, * ),
- $ WORK( LWORK )
- INTEGER IWORK( * )
- CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
-* ..
-*
-* ===========================================================================
-*
-* .. Local Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- REAL AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, COND_OK,
- $ CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, MAXPRJ, SCALEM,
- $ SCONDA, SFMIN, SMALL, TEMP1, USCAL1, USCAL2, XSC
- INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING
- LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LSVEC,
- $ L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN,
- $ NOSCAL, ROWPIV, RSVEC, TRANSP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, ALOG, AMAX1, AMIN1, FLOAT,
- $ MAX0, MIN0, NINT, SIGN, SQRT
-* ..
-* .. External Functions ..
- REAL SLAMCH, SNRM2
- INTEGER ISAMAX
- LOGICAL LSAME
- EXTERNAL ISAMAX, LSAME, SLAMCH, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGELQF, SGEQP3, SGEQRF, SLACPY, SLASCL,
- $ SLASET, SLASSQ, SLASWP, SORGQR, SORMLQ,
- $ SORMQR, SPOCON, SSCAL, SSWAP, STRSM, XERBLA
-*
- EXTERNAL SGESVJ
-* ..
-*
-* Test the input arguments
-*
- LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' )
- JRACC = LSAME( JOBV, 'J' )
- RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC
- ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' )
- L2RANK = LSAME( JOBA, 'R' )
- L2ABER = LSAME( JOBA, 'A' )
- ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' )
- L2TRAN = LSAME( JOBT, 'T' )
- L2KILL = LSAME( JOBR, 'R' )
- DEFR = LSAME( JOBR, 'N' )
- L2PERT = LSAME( JOBP, 'P' )
-*
- IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR.
- $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN
- INFO = - 1
- ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR.
- $ LSAME( JOBU, 'W' )) ) THEN
- INFO = - 2
- ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR.
- $ LSAME( JOBV, 'W' )) .OR. ( JRACC .AND. (.NOT.LSVEC) ) ) THEN
- INFO = - 3
- ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN
- INFO = - 4
- ELSE IF ( .NOT. ( L2TRAN .OR. LSAME( JOBT, 'N' ) ) ) THEN
- INFO = - 5
- ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN
- INFO = - 6
- ELSE IF ( M .LT. 0 ) THEN
- INFO = - 7
- ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN
- INFO = - 8
- ELSE IF ( LDA .LT. M ) THEN
- INFO = - 10
- ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN
- INFO = - 13
- ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN
- INFO = - 14
- ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND.
- $ (LWORK .LT. MAX0(7,4*N+1,2*M+N))) .OR.
- $ (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND.
- $ (LWORK .LT. MAX0(7,4*N+N*N,2*M+N))) .OR.
- $ (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1)))
- $ .OR.
- $ (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1)))
- $ .OR.
- $ (LSVEC .AND. RSVEC .AND. (.NOT.JRACC) .AND.
- $ (LWORK.LT.MAX0(2*M+N,6*N+2*N*N)))
- $ .OR. (LSVEC .AND. RSVEC .AND. JRACC .AND.
- $ LWORK.LT.MAX0(2*M+N,4*N+N*N,2*N+N*N+6)))
- $ THEN
- INFO = - 17
- ELSE
-* #:)
- INFO = 0
- END IF
-*
- IF ( INFO .NE. 0 ) THEN
-* #:(
- CALL XERBLA( 'SGEJSV', - INFO )
- RETURN
- END IF
-*
-* Quick return for void matrix (Y3K safe)
-* #:)
- IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN
-*
-* Determine whether the matrix U should be M x N or M x M
-*
- IF ( LSVEC ) THEN
- N1 = N
- IF ( LSAME( JOBU, 'F' ) ) N1 = M
- END IF
-*
-* Set numerical parameters
-*
-*! NOTE: Make sure SLAMCH() does not fail on the target architecture.
-*
- EPSLN = SLAMCH('Epsilon')
- SFMIN = SLAMCH('SafeMinimum')
- SMALL = SFMIN / EPSLN
- BIG = SLAMCH('O')
-* BIG = ONE / SFMIN
-*
-* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N
-*
-*(!) If necessary, scale SVA() to protect the largest norm from
-* overflow. It is possible that this scaling pushes the smallest
-* column norm left from the underflow threshold (extreme case).
-*
- SCALEM = ONE / SQRT(FLOAT(M)*FLOAT(N))
- NOSCAL = .TRUE.
- GOSCAL = .TRUE.
- DO 1874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A(1,p), 1, AAPP, AAQQ )
- IF ( AAPP .GT. BIG ) THEN
- INFO = - 9
- CALL XERBLA( 'SGEJSV', -INFO )
- RETURN
- END IF
- AAQQ = SQRT(AAQQ)
- IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN
- SVA(p) = AAPP * AAQQ
- ELSE
- NOSCAL = .FALSE.
- SVA(p) = AAPP * ( AAQQ * SCALEM )
- IF ( GOSCAL ) THEN
- GOSCAL = .FALSE.
- CALL SSCAL( p-1, SCALEM, SVA, 1 )
- END IF
- END IF
- 1874 CONTINUE
-*
- IF ( NOSCAL ) SCALEM = ONE
-*
- AAPP = ZERO
- AAQQ = BIG
- DO 4781 p = 1, N
- AAPP = AMAX1( AAPP, SVA(p) )
- IF ( SVA(p) .NE. ZERO ) AAQQ = AMIN1( AAQQ, SVA(p) )
- 4781 CONTINUE
-*
-* Quick return for zero M x N matrix
-* #:)
- IF ( AAPP .EQ. ZERO ) THEN
- IF ( LSVEC ) CALL SLASET( 'G', M, N1, ZERO, ONE, U, LDU )
- IF ( RSVEC ) CALL SLASET( 'G', N, N, ZERO, ONE, V, LDV )
- WORK(1) = ONE
- WORK(2) = ONE
- IF ( ERREST ) WORK(3) = ONE
- IF ( LSVEC .AND. RSVEC ) THEN
- WORK(4) = ONE
- WORK(5) = ONE
- END IF
- IF ( L2TRAN ) THEN
- WORK(6) = ZERO
- WORK(7) = ZERO
- END IF
- IWORK(1) = 0
- IWORK(2) = 0
- IWORK(3) = 0
- RETURN
- END IF
-*
-* Issue warning if denormalized column norms detected. Override the
-* high relative accuracy request. Issue licence to kill columns
-* (set them to zero) whose norm is less than sigma_max / BIG (roughly).
-* #:(
- WARNING = 0
- IF ( AAQQ .LE. SFMIN ) THEN
- L2RANK = .TRUE.
- L2KILL = .TRUE.
- WARNING = 1
- END IF
-*
-* Quick return for one-column matrix
-* #:)
- IF ( N .EQ. 1 ) THEN
-*
- IF ( LSVEC ) THEN
- CALL SLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR )
- CALL SLACPY( 'A', M, 1, A, LDA, U, LDU )
-* computing all M left singular vectors of the M x 1 matrix
- IF ( N1 .NE. N ) THEN
- CALL SGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N,IERR )
- CALL SORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N,IERR )
- CALL SCOPY( M, A(1,1), 1, U(1,1), 1 )
- END IF
- END IF
- IF ( RSVEC ) THEN
- V(1,1) = ONE
- END IF
- IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN
- SVA(1) = SVA(1) / SCALEM
- SCALEM = ONE
- END IF
- WORK(1) = ONE / SCALEM
- WORK(2) = ONE
- IF ( SVA(1) .NE. ZERO ) THEN
- IWORK(1) = 1
- IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN
- IWORK(2) = 1
- ELSE
- IWORK(2) = 0
- END IF
- ELSE
- IWORK(1) = 0
- IWORK(2) = 0
- END IF
- IF ( ERREST ) WORK(3) = ONE
- IF ( LSVEC .AND. RSVEC ) THEN
- WORK(4) = ONE
- WORK(5) = ONE
- END IF
- IF ( L2TRAN ) THEN
- WORK(6) = ZERO
- WORK(7) = ZERO
- END IF
- RETURN
-*
- END IF
-*
- TRANSP = .FALSE.
- L2TRAN = L2TRAN .AND. ( M .EQ. N )
-*
- AATMAX = -ONE
- AATMIN = BIG
- IF ( ROWPIV .OR. L2TRAN ) THEN
-*
-* Compute the row norms, needed to determine row pivoting sequence
-* (in the case of heavily row weighted A, row pivoting is strongly
-* advised) and to collect information needed to compare the
-* structures of A * A^t and A^t * A (in the case L2TRAN.EQ..TRUE.).
-*
- IF ( L2TRAN ) THEN
- DO 1950 p = 1, M
- XSC = ZERO
- TEMP1 = ONE
- CALL SLASSQ( N, A(p,1), LDA, XSC, TEMP1 )
-* SLASSQ gets both the ell_2 and the ell_infinity norm
-* in one pass through the vector
- WORK(M+N+p) = XSC * SCALEM
- WORK(N+p) = XSC * (SCALEM*SQRT(TEMP1))
- AATMAX = AMAX1( AATMAX, WORK(N+p) )
- IF (WORK(N+p) .NE. ZERO) AATMIN = AMIN1(AATMIN,WORK(N+p))
- 1950 CONTINUE
- ELSE
- DO 1904 p = 1, M
- WORK(M+N+p) = SCALEM*ABS( A(p,ISAMAX(N,A(p,1),LDA)) )
- AATMAX = AMAX1( AATMAX, WORK(M+N+p) )
- AATMIN = AMIN1( AATMIN, WORK(M+N+p) )
- 1904 CONTINUE
- END IF
-*
- END IF
-*
-* For square matrix A try to determine whether A^t would be better
-* input for the preconditioned Jacobi SVD, with faster convergence.
-* The decision is based on an O(N) function of the vector of column
-* and row norms of A, based on the Shannon entropy. This should give
-* the right choice in most cases when the difference actually matters.
-* It may fail and pick the slower converging side.
-*
- ENTRA = ZERO
- ENTRAT = ZERO
- IF ( L2TRAN ) THEN
-*
- XSC = ZERO
- TEMP1 = ONE
- CALL SLASSQ( N, SVA, 1, XSC, TEMP1 )
- TEMP1 = ONE / TEMP1
-*
- ENTRA = ZERO
- DO 1113 p = 1, N
- BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1
- IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * ALOG(BIG1)
- 1113 CONTINUE
- ENTRA = - ENTRA / ALOG(FLOAT(N))
-*
-* Now, SVA().^2/Trace(A^t * A) is a point in the probability simplex.
-* It is derived from the diagonal of A^t * A. Do the same with the
-* diagonal of A * A^t, compute the entropy of the corresponding
-* probability distribution. Note that A * A^t and A^t * A have the
-* same trace.
-*
- ENTRAT = ZERO
- DO 1114 p = N+1, N+M
- BIG1 = ( ( WORK(p) / XSC )**2 ) * TEMP1
- IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * ALOG(BIG1)
- 1114 CONTINUE
- ENTRAT = - ENTRAT / ALOG(FLOAT(M))
-*
-* Analyze the entropies and decide A or A^t. Smaller entropy
-* usually means better input for the algorithm.
-*
- TRANSP = ( ENTRAT .LT. ENTRA )
-*
-* If A^t is better than A, transpose A.
-*
- IF ( TRANSP ) THEN
-* In an optimal implementation, this trivial transpose
-* should be replaced with faster transpose.
- DO 1115 p = 1, N - 1
- DO 1116 q = p + 1, N
- TEMP1 = A(q,p)
- A(q,p) = A(p,q)
- A(p,q) = TEMP1
- 1116 CONTINUE
- 1115 CONTINUE
- DO 1117 p = 1, N
- WORK(M+N+p) = SVA(p)
- SVA(p) = WORK(N+p)
- 1117 CONTINUE
- TEMP1 = AAPP
- AAPP = AATMAX
- AATMAX = TEMP1
- TEMP1 = AAQQ
- AAQQ = AATMIN
- AATMIN = TEMP1
- KILL = LSVEC
- LSVEC = RSVEC
- RSVEC = KILL
- IF ( LSVEC ) N1 = N
-*
- ROWPIV = .TRUE.
- END IF
-*
- END IF
-* END IF L2TRAN
-*
-* Scale the matrix so that its maximal singular value remains less
-* than SQRT(BIG) -- the matrix is scaled so that its maximal column
-* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep
-* SQRT(BIG) instead of BIG is the fact that SGEJSV uses LAPACK and
-* BLAS routines that, in some implementations, are not capable of
-* working in the full interval [SFMIN,BIG] and that they may provoke
-* overflows in the intermediate results. If the singular values spread
-* from SFMIN to BIG, then SGESVJ will compute them. So, in that case,
-* one should use SGESVJ instead of SGEJSV.
-*
- BIG1 = SQRT( BIG )
- TEMP1 = SQRT( BIG / FLOAT(N) )
-*
- CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR )
- IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN
- AAQQ = ( AAQQ / AAPP ) * TEMP1
- ELSE
- AAQQ = ( AAQQ * TEMP1 ) / AAPP
- END IF
- TEMP1 = TEMP1 * SCALEM
- CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR )
-*
-* To undo scaling at the end of this procedure, multiply the
-* computed singular values with USCAL2 / USCAL1.
-*
- USCAL1 = TEMP1
- USCAL2 = AAPP
-*
- IF ( L2KILL ) THEN
-* L2KILL enforces computation of nonzero singular values in
-* the restricted range of condition number of the initial A,
-* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN).
- XSC = SQRT( SFMIN )
- ELSE
- XSC = SMALL
-*
-* Now, if the condition number of A is too big,
-* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN,
-* as a precaution measure, the full SVD is computed using SGESVJ
-* with accumulated Jacobi rotations. This provides numerically
-* more robust computation, at the cost of slightly increased run
-* time. Depending on the concrete implementation of BLAS and LAPACK
-* (i.e. how they behave in presence of extreme ill-conditioning) the
-* implementor may decide to remove this switch.
- IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN
- JRACC = .TRUE.
- END IF
-*
- END IF
- IF ( AAQQ .LT. XSC ) THEN
- DO 700 p = 1, N
- IF ( SVA(p) .LT. XSC ) THEN
- CALL SLASET( 'A', M, 1, ZERO, ZERO, A(1,p), LDA )
- SVA(p) = ZERO
- END IF
- 700 CONTINUE
- END IF
-*
-* Preconditioning using QR factorization with pivoting
-*
- IF ( ROWPIV ) THEN
-* Optional row permutation (Bjoerck row pivoting):
-* A result by Cox and Higham shows that the Bjoerck's
-* row pivoting combined with standard column pivoting
-* has similar effect as Powell-Reid complete pivoting.
-* The ell-infinity norms of A are made nonincreasing.
- DO 1952 p = 1, M - 1
- q = ISAMAX( M-p+1, WORK(M+N+p), 1 ) + p - 1
- IWORK(2*N+p) = q
- IF ( p .NE. q ) THEN
- TEMP1 = WORK(M+N+p)
- WORK(M+N+p) = WORK(M+N+q)
- WORK(M+N+q) = TEMP1
- END IF
- 1952 CONTINUE
- CALL SLASWP( N, A, LDA, 1, M-1, IWORK(2*N+1), 1 )
- END IF
-*
-* End of the preparation phase (scaling, optional sorting and
-* transposing, optional flushing of small columns).
-*
-* Preconditioning
-*
-* If the full SVD is needed, the right singular vectors are computed
-* from a matrix equation, and for that we need theoretical analysis
-* of the Businger-Golub pivoting. So we use SGEQP3 as the first RR QRF.
-* In all other cases the first RR QRF can be chosen by other criteria
-* (eg speed by replacing global with restricted window pivoting, such
-* as in SGEQPX from TOMS # 782). Good results will be obtained using
-* SGEQPX with properly (!) chosen numerical parameters.
-* Any improvement of SGEQP3 improves overal performance of SGEJSV.
-*
-* A * P1 = Q1 * [ R1^t 0]^t:
- DO 1963 p = 1, N
-* .. all columns are free columns
- IWORK(p) = 0
- 1963 CONTINUE
- CALL SGEQP3( M,N,A,LDA, IWORK,WORK, WORK(N+1),LWORK-N, IERR )
-*
-* The upper triangular matrix R1 from the first QRF is inspected for
-* rank deficiency and possibilities for deflation, or possible
-* ill-conditioning. Depending on the user specified flag L2RANK,
-* the procedure explores possibilities to reduce the numerical
-* rank by inspecting the computed upper triangular factor. If
-* L2RANK or L2ABER are up, then SGEJSV will compute the SVD of
-* A + dA, where ||dA|| <= f(M,N)*EPSLN.
-*
- NR = 1
- IF ( L2ABER ) THEN
-* Standard absolute error bound suffices. All sigma_i with
-* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an
-* agressive enforcement of lower numerical rank by introducing a
-* backward error of the order of N*EPSLN*||A||.
- TEMP1 = SQRT(FLOAT(N))*EPSLN
- DO 3001 p = 2, N
- IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN
- NR = NR + 1
- ELSE
- GO TO 3002
- END IF
- 3001 CONTINUE
- 3002 CONTINUE
- ELSE IF ( L2RANK ) THEN
-* .. similarly as above, only slightly more gentle (less agressive).
-* Sudden drop on the diagonal of R1 is used as the criterion for
-* close-to-rank-defficient.
- TEMP1 = SQRT(SFMIN)
- DO 3401 p = 2, N
- IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.
- $ ( ABS(A(p,p)) .LT. SMALL ) .OR.
- $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402
- NR = NR + 1
- 3401 CONTINUE
- 3402 CONTINUE
-*
- ELSE
-* The goal is high relative accuracy. However, if the matrix
-* has high scaled condition number the relative accuracy is in
-* general not feasible. Later on, a condition number estimator
-* will be deployed to estimate the scaled condition number.
-* Here we just remove the underflowed part of the triangular
-* factor. This prevents the situation in which the code is
-* working hard to get the accuracy not warranted by the data.
- TEMP1 = SQRT(SFMIN)
- DO 3301 p = 2, N
- IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR.
- $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302
- NR = NR + 1
- 3301 CONTINUE
- 3302 CONTINUE
-*
- END IF
-*
- ALMORT = .FALSE.
- IF ( NR .EQ. N ) THEN
- MAXPRJ = ONE
- DO 3051 p = 2, N
- TEMP1 = ABS(A(p,p)) / SVA(IWORK(p))
- MAXPRJ = AMIN1( MAXPRJ, TEMP1 )
- 3051 CONTINUE
- IF ( MAXPRJ**2 .GE. ONE - FLOAT(N)*EPSLN ) ALMORT = .TRUE.
- END IF
-*
-*
- SCONDA = - ONE
- CONDR1 = - ONE
- CONDR2 = - ONE
-*
- IF ( ERREST ) THEN
- IF ( N .EQ. NR ) THEN
- IF ( RSVEC ) THEN
-* .. V is available as workspace
- CALL SLACPY( 'U', N, N, A, LDA, V, LDV )
- DO 3053 p = 1, N
- TEMP1 = SVA(IWORK(p))
- CALL SSCAL( p, ONE/TEMP1, V(1,p), 1 )
- 3053 CONTINUE
- CALL SPOCON( 'U', N, V, LDV, ONE, TEMP1,
- $ WORK(N+1), IWORK(2*N+M+1), IERR )
- ELSE IF ( LSVEC ) THEN
-* .. U is available as workspace
- CALL SLACPY( 'U', N, N, A, LDA, U, LDU )
- DO 3054 p = 1, N
- TEMP1 = SVA(IWORK(p))
- CALL SSCAL( p, ONE/TEMP1, U(1,p), 1 )
- 3054 CONTINUE
- CALL SPOCON( 'U', N, U, LDU, ONE, TEMP1,
- $ WORK(N+1), IWORK(2*N+M+1), IERR )
- ELSE
- CALL SLACPY( 'U', N, N, A, LDA, WORK(N+1), N )
- DO 3052 p = 1, N
- TEMP1 = SVA(IWORK(p))
- CALL SSCAL( p, ONE/TEMP1, WORK(N+(p-1)*N+1), 1 )
- 3052 CONTINUE
-* .. the columns of R are scaled to have unit Euclidean lengths.
- CALL SPOCON( 'U', N, WORK(N+1), N, ONE, TEMP1,
- $ WORK(N+N*N+1), IWORK(2*N+M+1), IERR )
- END IF
- SCONDA = ONE / SQRT(TEMP1)
-* SCONDA is an estimate of SQRT(||(R^t * R)^(-1)||_1).
-* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
- ELSE
- SCONDA = - ONE
- END IF
- END IF
-*
- L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) )
-* If there is no violent scaling, artificial perturbation is not needed.
-*
-* Phase 3:
-*
- IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN
-*
-* Singular Values only
-*
-* .. transpose A(1:NR,1:N)
- DO 1946 p = 1, MIN0( N-1, NR )
- CALL SCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 )
- 1946 CONTINUE
-*
-* The following two DO-loops introduce small relative perturbation
-* into the strict upper triangle of the lower triangular matrix.
-* Small entries below the main diagonal are also changed.
-* This modification is useful if the computing environment does not
-* provide/allow FLUSH TO ZERO underflow, for it prevents many
-* annoying denormalized numbers in case of strongly scaled matrices.
-* The perturbation is structured so that it does not introduce any
-* new perturbation of the singular values, and it does not destroy
-* the job done by the preconditioner.
-* The licence for this perturbation is in the variable L2PERT, which
-* should be .FALSE. if FLUSH TO ZERO underflow is active.
-*
- IF ( .NOT. ALMORT ) THEN
-*
- IF ( L2PERT ) THEN
-* XSC = SQRT(SMALL)
- XSC = EPSLN / FLOAT(N)
- DO 4947 q = 1, NR
- TEMP1 = XSC*ABS(A(q,q))
- DO 4949 p = 1, N
- IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )
- $ .OR. ( p .LT. q ) )
- $ A(p,q) = SIGN( TEMP1, A(p,q) )
- 4949 CONTINUE
- 4947 CONTINUE
- ELSE
- CALL SLASET( 'U', NR-1,NR-1, ZERO,ZERO, A(1,2),LDA )
- END IF
-*
-* .. second preconditioning using the QR factorization
-*
- CALL SGEQRF( N,NR, A,LDA, WORK, WORK(N+1),LWORK-N, IERR )
-*
-* .. and transpose upper to lower triangular
- DO 1948 p = 1, NR - 1
- CALL SCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 )
- 1948 CONTINUE
-*
- END IF
-*
-* Row-cyclic Jacobi SVD algorithm with column pivoting
-*
-* .. again some perturbation (a "background noise") is added
-* to drown denormals
- IF ( L2PERT ) THEN
-* XSC = SQRT(SMALL)
- XSC = EPSLN / FLOAT(N)
- DO 1947 q = 1, NR
- TEMP1 = XSC*ABS(A(q,q))
- DO 1949 p = 1, NR
- IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )
- $ .OR. ( p .LT. q ) )
- $ A(p,q) = SIGN( TEMP1, A(p,q) )
- 1949 CONTINUE
- 1947 CONTINUE
- ELSE
- CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), LDA )
- END IF
-*
-* .. and one-sided Jacobi rotations are started on a lower
-* triangular matrix (plus perturbation which is ignored in
-* the part which destroys triangular form (confusing?!))
-*
- CALL SGESVJ( 'L', 'NoU', 'NoV', NR, NR, A, LDA, SVA,
- $ N, V, LDV, WORK, LWORK, INFO )
-*
- SCALEM = WORK(1)
- NUMRANK = NINT(WORK(2))
-*
-*
- ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN
-*
-* -> Singular Values and Right Singular Vectors <-
-*
- IF ( ALMORT ) THEN
-*
-* .. in this case NR equals N
- DO 1998 p = 1, NR
- CALL SCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
- 1998 CONTINUE
- CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
-*
- CALL SGESVJ( 'L','U','N', N, NR, V,LDV, SVA, NR, A,LDA,
- $ WORK, LWORK, INFO )
- SCALEM = WORK(1)
- NUMRANK = NINT(WORK(2))
-
- ELSE
-*
-* .. two more QR factorizations ( one QRF is not enough, two require
-* accumulated product of Jacobi rotations, three are perfect )
-*
- CALL SLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), LDA )
- CALL SGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, IERR)
- CALL SLACPY( 'Lower', NR, NR, A, LDA, V, LDV )
- CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
- CALL SGEQRF( NR, NR, V, LDV, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
- DO 8998 p = 1, NR
- CALL SCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 )
- 8998 CONTINUE
- CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
-*
- CALL SGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U,
- $ LDU, WORK(N+1), LWORK-N, INFO )
- SCALEM = WORK(N+1)
- NUMRANK = NINT(WORK(N+2))
- IF ( NR .LT. N ) THEN
- CALL SLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), LDV )
- CALL SLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), LDV )
- CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), LDV )
- END IF
-*
- CALL SORMLQ( 'Left', 'Transpose', N, N, NR, A, LDA, WORK,
- $ V, LDV, WORK(N+1), LWORK-N, IERR )
-*
- END IF
-*
- DO 8991 p = 1, N
- CALL SCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA )
- 8991 CONTINUE
- CALL SLACPY( 'All', N, N, A, LDA, V, LDV )
-*
- IF ( TRANSP ) THEN
- CALL SLACPY( 'All', N, N, V, LDV, U, LDU )
- END IF
-*
- ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN
-*
-* .. Singular Values and Left Singular Vectors ..
-*
-* .. second preconditioning step to avoid need to accumulate
-* Jacobi rotations in the Jacobi iterations.
- DO 1965 p = 1, NR
- CALL SCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 )
- 1965 CONTINUE
- CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU )
-*
- CALL SGEQRF( N, NR, U, LDU, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
-*
- DO 1967 p = 1, NR - 1
- CALL SCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 )
- 1967 CONTINUE
- CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU )
-*
- CALL SGESVJ( 'Lower', 'U', 'N', NR,NR, U, LDU, SVA, NR, A,
- $ LDA, WORK(N+1), LWORK-N, INFO )
- SCALEM = WORK(N+1)
- NUMRANK = NINT(WORK(N+2))
-*
- IF ( NR .LT. M ) THEN
- CALL SLASET( 'A', M-NR, NR,ZERO, ZERO, U(NR+1,1), LDU )
- IF ( NR .LT. N1 ) THEN
- CALL SLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), LDU )
- CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), LDU )
- END IF
- END IF
-*
- CALL SORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
-*
- IF ( ROWPIV )
- $ CALL SLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
- DO 1974 p = 1, N1
- XSC = ONE / SNRM2( M, U(1,p), 1 )
- CALL SSCAL( M, XSC, U(1,p), 1 )
- 1974 CONTINUE
-*
- IF ( TRANSP ) THEN
- CALL SLACPY( 'All', N, N, U, LDU, V, LDV )
- END IF
-*
- ELSE
-*
-* .. Full SVD ..
-*
- IF ( .NOT. JRACC ) THEN
-*
- IF ( .NOT. ALMORT ) THEN
-*
-* Second Preconditioning Step (QRF [with pivoting])
-* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is
-* equivalent to an LQF CALL. Since in many libraries the QRF
-* seems to be better optimized than the LQF, we do explicit
-* transpose and use the QRF. This is subject to changes in an
-* optimized implementation of SGEJSV.
-*
- DO 1968 p = 1, NR
- CALL SCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
- 1968 CONTINUE
-*
-* .. the following two loops perturb small entries to avoid
-* denormals in the second QR factorization, where they are
-* as good as zeros. This is done to avoid painfully slow
-* computation with denormals. The relative size of the perturbation
-* is a parameter that can be changed by the implementer.
-* This perturbation device will be obsolete on machines with
-* properly implemented arithmetic.
-* To switch it off, set L2PERT=.FALSE. To remove it from the
-* code, remove the action under L2PERT=.TRUE., leave the ELSE part.
-* The following two loops should be blocked and fused with the
-* transposed copy above.
-*
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL)
- DO 2969 q = 1, NR
- TEMP1 = XSC*ABS( V(q,q) )
- DO 2968 p = 1, N
- IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )
- $ .OR. ( p .LT. q ) )
- $ V(p,q) = SIGN( TEMP1, V(p,q) )
- IF ( p .LT. q ) V(p,q) = - V(p,q)
- 2968 CONTINUE
- 2969 CONTINUE
- ELSE
- CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
- END IF
-*
-* Estimate the row scaled condition number of R1
-* (If R1 is rectangular, N > NR, then the condition number
-* of the leading NR x NR submatrix is estimated.)
-*
- CALL SLACPY( 'L', NR, NR, V, LDV, WORK(2*N+1), NR )
- DO 3950 p = 1, NR
- TEMP1 = SNRM2(NR-p+1,WORK(2*N+(p-1)*NR+p),1)
- CALL SSCAL(NR-p+1,ONE/TEMP1,WORK(2*N+(p-1)*NR+p),1)
- 3950 CONTINUE
- CALL SPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1,
- $ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR)
- CONDR1 = ONE / SQRT(TEMP1)
-* .. here need a second oppinion on the condition number
-* .. then assume worst case scenario
-* R1 is OK for inverse <=> CONDR1 .LT. FLOAT(N)
-* more conservative <=> CONDR1 .LT. SQRT(FLOAT(N))
-*
- COND_OK = SQRT(FLOAT(NR))
-*[TP] COND_OK is a tuning parameter.
-
- IF ( CONDR1 .LT. COND_OK ) THEN
-* .. the second QRF without pivoting. Note: in an optimized
-* implementation, this QRF should be implemented as the QRF
-* of a lower triangular matrix.
-* R1^t = Q2 * R2
- CALL SGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
-*
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL)/EPSLN
- DO 3959 p = 2, NR
- DO 3958 q = 1, p - 1
- TEMP1 = XSC * AMIN1(ABS(V(p,p)),ABS(V(q,q)))
- IF ( ABS(V(q,p)) .LE. TEMP1 )
- $ V(q,p) = SIGN( TEMP1, V(q,p) )
- 3958 CONTINUE
- 3959 CONTINUE
- END IF
-*
- IF ( NR .NE. N )
- $ CALL SLACPY( 'A', N, NR, V, LDV, WORK(2*N+1), N )
-* .. save ...
-*
-* .. this transposed copy should be better than naive
- DO 1969 p = 1, NR - 1
- CALL SCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 )
- 1969 CONTINUE
-*
- CONDR2 = CONDR1
-*
- ELSE
-*
-* .. ill-conditioned case: second QRF with pivoting
-* Note that windowed pivoting would be equaly good
-* numerically, and more run-time efficient. So, in
-* an optimal implementation, the next call to SGEQP3
-* should be replaced with eg. CALL SGEQPX (ACM TOMS #782)
-* with properly (carefully) chosen parameters.
-*
-* R1^t * P2 = Q2 * R2
- DO 3003 p = 1, NR
- IWORK(N+p) = 0
- 3003 CONTINUE
- CALL SGEQP3( N, NR, V, LDV, IWORK(N+1), WORK(N+1),
- $ WORK(2*N+1), LWORK-2*N, IERR )
-** CALL SGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1),
-** $ LWORK-2*N, IERR )
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL)
- DO 3969 p = 2, NR
- DO 3968 q = 1, p - 1
- TEMP1 = XSC * AMIN1(ABS(V(p,p)),ABS(V(q,q)))
- IF ( ABS(V(q,p)) .LE. TEMP1 )
- $ V(q,p) = SIGN( TEMP1, V(q,p) )
- 3968 CONTINUE
- 3969 CONTINUE
- END IF
-*
- CALL SLACPY( 'A', N, NR, V, LDV, WORK(2*N+1), N )
-*
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL)
- DO 8970 p = 2, NR
- DO 8971 q = 1, p - 1
- TEMP1 = XSC * AMIN1(ABS(V(p,p)),ABS(V(q,q)))
- V(p,q) = - SIGN( TEMP1, V(q,p) )
- 8971 CONTINUE
- 8970 CONTINUE
- ELSE
- CALL SLASET( 'L',NR-1,NR-1,ZERO,ZERO,V(2,1),LDV )
- END IF
-* Now, compute R2 = L3 * Q3, the LQ factorization.
- CALL SGELQF( NR, NR, V, LDV, WORK(2*N+N*NR+1),
- $ WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR )
-* .. and estimate the condition number
- CALL SLACPY( 'L',NR,NR,V,LDV,WORK(2*N+N*NR+NR+1),NR )
- DO 4950 p = 1, NR
- TEMP1 = SNRM2( p, WORK(2*N+N*NR+NR+p), NR )
- CALL SSCAL( p, ONE/TEMP1, WORK(2*N+N*NR+NR+p), NR )
- 4950 CONTINUE
- CALL SPOCON( 'L',NR,WORK(2*N+N*NR+NR+1),NR,ONE,TEMP1,
- $ WORK(2*N+N*NR+NR+NR*NR+1),IWORK(M+2*N+1),IERR )
- CONDR2 = ONE / SQRT(TEMP1)
-*
- IF ( CONDR2 .GE. COND_OK ) THEN
-* .. save the Householder vectors used for Q3
-* (this overwrittes the copy of R2, as it will not be
-* needed in this branch, but it does not overwritte the
-* Huseholder vectors of Q2.).
- CALL SLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N )
-* .. and the rest of the information on Q3 is in
-* WORK(2*N+N*NR+1:2*N+N*NR+N)
- END IF
-*
- END IF
-*
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL)
- DO 4968 q = 2, NR
- TEMP1 = XSC * V(q,q)
- DO 4969 p = 1, q - 1
-* V(p,q) = - SIGN( TEMP1, V(q,p) )
- V(p,q) = - SIGN( TEMP1, V(p,q) )
- 4969 CONTINUE
- 4968 CONTINUE
- ELSE
- CALL SLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV )
- END IF
-*
-* Second preconditioning finished; continue with Jacobi SVD
-* The input matrix is lower trinagular.
-*
-* Recover the right singular vectors as solution of a well
-* conditioned triangular matrix equation.
-*
- IF ( CONDR1 .LT. COND_OK ) THEN
-*
- CALL SGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U,
- $ LDU,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,INFO )
- SCALEM = WORK(2*N+N*NR+NR+1)
- NUMRANK = NINT(WORK(2*N+N*NR+NR+2))
- DO 3970 p = 1, NR
- CALL SCOPY( NR, V(1,p), 1, U(1,p), 1 )
- CALL SSCAL( NR, SVA(p), V(1,p), 1 )
- 3970 CONTINUE
-
-* .. pick the right matrix equation and solve it
-*
- IF ( NR .EQ. N ) THEN
-* :)) .. best case, R1 is inverted. The solution of this matrix
-* equation is Q2*V2 = the product of the Jacobi rotations
-* used in SGESVJ, premultiplied with the orthogonal matrix
-* from the second QR factorization.
- CALL STRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V,LDV )
- ELSE
-* .. R1 is well conditioned, but non-square. Transpose(R2)
-* is inverted to get the product of the Jacobi rotations
-* used in SGESVJ. The Q-factor from the second QR
-* factorization is then built in explicitly.
- CALL STRSM('L','U','T','N',NR,NR,ONE,WORK(2*N+1),
- $ N,V,LDV)
- IF ( NR .LT. N ) THEN
- CALL SLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV)
- CALL SLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV)
- CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV)
- END IF
- CALL SORMQR('L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR)
- END IF
-*
- ELSE IF ( CONDR2 .LT. COND_OK ) THEN
-*
-* :) .. the input matrix A is very likely a relative of
-* the Kahan matrix :)
-* The matrix R2 is inverted. The solution of the matrix equation
-* is Q3^T*V3 = the product of the Jacobi rotations (appplied to
-* the lower triangular L3 from the LQ factorization of
-* R2=L3*Q3), pre-multiplied with the transposed Q3.
- CALL SGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U,
- $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO )
- SCALEM = WORK(2*N+N*NR+NR+1)
- NUMRANK = NINT(WORK(2*N+N*NR+NR+2))
- DO 3870 p = 1, NR
- CALL SCOPY( NR, V(1,p), 1, U(1,p), 1 )
- CALL SSCAL( NR, SVA(p), U(1,p), 1 )
- 3870 CONTINUE
- CALL STRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U,LDU)
-* .. apply the permutation from the second QR factorization
- DO 873 q = 1, NR
- DO 872 p = 1, NR
- WORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
- 872 CONTINUE
- DO 874 p = 1, NR
- U(p,q) = WORK(2*N+N*NR+NR+p)
- 874 CONTINUE
- 873 CONTINUE
- IF ( NR .LT. N ) THEN
- CALL SLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV )
- CALL SLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV )
- CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV )
- END IF
- CALL SORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
- ELSE
-* Last line of defense.
-* #:( This is a rather pathological case: no scaled condition
-* improvement after two pivoted QR factorizations. Other
-* possibility is that the rank revealing QR factorization
-* or the condition estimator has failed, or the COND_OK
-* is set very close to ONE (which is unnecessary). Normally,
-* this branch should never be executed, but in rare cases of
-* failure of the RRQR or condition estimator, the last line of
-* defense ensures that SGEJSV completes the task.
-* Compute the full SVD of L3 using SGESVJ with explicit
-* accumulation of Jacobi rotations.
- CALL SGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U,
- $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO )
- SCALEM = WORK(2*N+N*NR+NR+1)
- NUMRANK = NINT(WORK(2*N+N*NR+NR+2))
- IF ( NR .LT. N ) THEN
- CALL SLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV )
- CALL SLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV )
- CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV )
- END IF
- CALL SORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
-*
- CALL SORMLQ( 'L', 'T', NR, NR, NR, WORK(2*N+1), N,
- $ WORK(2*N+N*NR+1), U, LDU, WORK(2*N+N*NR+NR+1),
- $ LWORK-2*N-N*NR-NR, IERR )
- DO 773 q = 1, NR
- DO 772 p = 1, NR
- WORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
- 772 CONTINUE
- DO 774 p = 1, NR
- U(p,q) = WORK(2*N+N*NR+NR+p)
- 774 CONTINUE
- 773 CONTINUE
-*
- END IF
-*
-* Permute the rows of V using the (column) permutation from the
-* first QRF. Also, scale the columns to make them unit in
-* Euclidean norm. This applies to all cases.
-*
- TEMP1 = SQRT(FLOAT(N)) * EPSLN
- DO 1972 q = 1, N
- DO 972 p = 1, N
- WORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
- 972 CONTINUE
- DO 973 p = 1, N
- V(p,q) = WORK(2*N+N*NR+NR+p)
- 973 CONTINUE
- XSC = ONE / SNRM2( N, V(1,q), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL SSCAL( N, XSC, V(1,q), 1 )
- 1972 CONTINUE
-* At this moment, V contains the right singular vectors of A.
-* Next, assemble the left singular vector matrix U (M x N).
- IF ( NR .LT. M ) THEN
- CALL SLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU )
- IF ( NR .LT. N1 ) THEN
- CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU)
- CALL SLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1),LDU)
- END IF
- END IF
-*
-* The Q matrix from the first QRF is built into the left singular
-* matrix U. This applies to all cases.
-*
- CALL SORMQR( 'Left', 'No_Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
-
-* The columns of U are normalized. The cost is O(M*N) flops.
- TEMP1 = SQRT(FLOAT(M)) * EPSLN
- DO 1973 p = 1, NR
- XSC = ONE / SNRM2( M, U(1,p), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL SSCAL( M, XSC, U(1,p), 1 )
- 1973 CONTINUE
-*
-* If the initial QRF is computed with row pivoting, the left
-* singular vectors must be adjusted.
-*
- IF ( ROWPIV )
- $ CALL SLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
- ELSE
-*
-* .. the initial matrix A has almost orthogonal columns and
-* the second QRF is not needed
-*
- CALL SLACPY( 'Upper', N, N, A, LDA, WORK(N+1), N )
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL)
- DO 5970 p = 2, N
- TEMP1 = XSC * WORK( N + (p-1)*N + p )
- DO 5971 q = 1, p - 1
- WORK(N+(q-1)*N+p)=-SIGN(TEMP1,WORK(N+(p-1)*N+q))
- 5971 CONTINUE
- 5970 CONTINUE
- ELSE
- CALL SLASET( 'Lower',N-1,N-1,ZERO,ZERO,WORK(N+2),N )
- END IF
-*
- CALL SGESVJ( 'Upper', 'U', 'N', N, N, WORK(N+1), N, SVA,
- $ N, U, LDU, WORK(N+N*N+1), LWORK-N-N*N, INFO )
-*
- SCALEM = WORK(N+N*N+1)
- NUMRANK = NINT(WORK(N+N*N+2))
- DO 6970 p = 1, N
- CALL SCOPY( N, WORK(N+(p-1)*N+1), 1, U(1,p), 1 )
- CALL SSCAL( N, SVA(p), WORK(N+(p-1)*N+1), 1 )
- 6970 CONTINUE
-*
- CALL STRSM( 'Left', 'Upper', 'NoTrans', 'No UD', N, N,
- $ ONE, A, LDA, WORK(N+1), N )
- DO 6972 p = 1, N
- CALL SCOPY( N, WORK(N+p), N, V(IWORK(p),1), LDV )
- 6972 CONTINUE
- TEMP1 = SQRT(FLOAT(N))*EPSLN
- DO 6971 p = 1, N
- XSC = ONE / SNRM2( N, V(1,p), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL SSCAL( N, XSC, V(1,p), 1 )
- 6971 CONTINUE
-*
-* Assemble the left singular vector matrix U (M x N).
-*
- IF ( N .LT. M ) THEN
- CALL SLASET( 'A', M-N, N, ZERO, ZERO, U(N+1,1), LDU )
- IF ( N .LT. N1 ) THEN
- CALL SLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU )
- CALL SLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU )
- END IF
- END IF
- CALL SORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
- TEMP1 = SQRT(FLOAT(M))*EPSLN
- DO 6973 p = 1, N1
- XSC = ONE / SNRM2( M, U(1,p), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL SSCAL( M, XSC, U(1,p), 1 )
- 6973 CONTINUE
-*
- IF ( ROWPIV )
- $ CALL SLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
- END IF
-*
-* end of the >> almost orthogonal case << in the full SVD
-*
- ELSE
-*
-* This branch deploys a preconditioned Jacobi SVD with explicitly
-* accumulated rotations. It is included as optional, mainly for
-* experimental purposes. It does perfom well, and can also be used.
-* In this implementation, this branch will be automatically activated
-* if the condition number sigma_max(A) / sigma_min(A) is predicted
-* to be greater than the overflow threshold. This is because the
-* a posteriori computation of the singular vectors assumes robust
-* implementation of BLAS and some LAPACK procedures, capable of working
-* in presence of extreme values. Since that is not always the case, ...
-*
- DO 7968 p = 1, NR
- CALL SCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
- 7968 CONTINUE
-*
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL/EPSLN)
- DO 5969 q = 1, NR
- TEMP1 = XSC*ABS( V(q,q) )
- DO 5968 p = 1, N
- IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )
- $ .OR. ( p .LT. q ) )
- $ V(p,q) = SIGN( TEMP1, V(p,q) )
- IF ( p .LT. q ) V(p,q) = - V(p,q)
- 5968 CONTINUE
- 5969 CONTINUE
- ELSE
- CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV )
- END IF
-
- CALL SGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1),
- $ LWORK-2*N, IERR )
- CALL SLACPY( 'L', N, NR, V, LDV, WORK(2*N+1), N )
-*
- DO 7969 p = 1, NR
- CALL SCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 )
- 7969 CONTINUE
-
- IF ( L2PERT ) THEN
- XSC = SQRT(SMALL/EPSLN)
- DO 9970 q = 2, NR
- DO 9971 p = 1, q - 1
- TEMP1 = XSC * AMIN1(ABS(U(p,p)),ABS(U(q,q)))
- U(p,q) = - SIGN( TEMP1, U(q,p) )
- 9971 CONTINUE
- 9970 CONTINUE
- ELSE
- CALL SLASET('U', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU )
- END IF
-
- CALL SGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA,
- $ N, V, LDV, WORK(2*N+N*NR+1), LWORK-2*N-N*NR, INFO )
- SCALEM = WORK(2*N+N*NR+1)
- NUMRANK = NINT(WORK(2*N+N*NR+2))
-
- IF ( NR .LT. N ) THEN
- CALL SLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV )
- CALL SLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV )
- CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV )
- END IF
-
- CALL SORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1),
- $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
-*
-* Permute the rows of V using the (column) permutation from the
-* first QRF. Also, scale the columns to make them unit in
-* Euclidean norm. This applies to all cases.
-*
- TEMP1 = SQRT(FLOAT(N)) * EPSLN
- DO 7972 q = 1, N
- DO 8972 p = 1, N
- WORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
- 8972 CONTINUE
- DO 8973 p = 1, N
- V(p,q) = WORK(2*N+N*NR+NR+p)
- 8973 CONTINUE
- XSC = ONE / SNRM2( N, V(1,q), 1 )
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
- $ CALL SSCAL( N, XSC, V(1,q), 1 )
- 7972 CONTINUE
-*
-* At this moment, V contains the right singular vectors of A.
-* Next, assemble the left singular vector matrix U (M x N).
-*
- IF ( NR .LT. M ) THEN
- CALL SLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU )
- IF ( NR .LT. N1 ) THEN
- CALL SLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1),LDU )
- CALL SLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU )
- END IF
- END IF
-*
- CALL SORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
- $ LDU, WORK(N+1), LWORK-N, IERR )
-*
- IF ( ROWPIV )
- $ CALL SLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 )
-*
-*
- END IF
- IF ( TRANSP ) THEN
-* .. swap U and V because the procedure worked on A^t
- DO 6974 p = 1, N
- CALL SSWAP( N, U(1,p), 1, V(1,p), 1 )
- 6974 CONTINUE
- END IF
-*
- END IF
-* end of the full SVD
-*
-* Undo scaling, if necessary (and possible)
-*
- IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN
- CALL SLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR )
- USCAL1 = ONE
- USCAL2 = ONE
- END IF
-*
- IF ( NR .LT. N ) THEN
- DO 3004 p = NR+1, N
- SVA(p) = ZERO
- 3004 CONTINUE
- END IF
-*
- WORK(1) = USCAL2 * SCALEM
- WORK(2) = USCAL1
- IF ( ERREST ) WORK(3) = SCONDA
- IF ( LSVEC .AND. RSVEC ) THEN
- WORK(4) = CONDR1
- WORK(5) = CONDR2
- END IF
- IF ( L2TRAN ) THEN
- WORK(6) = ENTRA
- WORK(7) = ENTRAT
- END IF
-*
- IWORK(1) = NR
- IWORK(2) = NUMRANK
- IWORK(3) = WARNING
-*
- RETURN
-* ..
-* .. END OF SGEJSV
-* ..
- END
-*
diff --git a/netlib/LAPACK/sgelq2.f b/netlib/LAPACK/sgelq2.f
deleted file mode 100644
index 955331d..0000000
--- a/netlib/LAPACK/sgelq2.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b SGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGELQ2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelq2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelq2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelq2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGELQ2 computes an LQ factorization of a real m by n matrix A:
-*> A = L * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and below the diagonal of the array
-*> contain the m by min(m,n) lower trapezoidal matrix L (L is
-*> lower triangular if m <= n); the elements above the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- REAL AII
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELQ2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i,i+1:n)
-*
- CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAU( I ) )
- IF( I.LT.M ) THEN
-*
-* Apply H(i) to A(i+1:m,i:n) from the right
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
- $ A( I+1, I ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of SGELQ2
-*
- END
diff --git a/netlib/LAPACK/sgelqf.f b/netlib/LAPACK/sgelqf.f
deleted file mode 100644
index 9008210..0000000
--- a/netlib/LAPACK/sgelqf.f
+++ /dev/null
@@ -1,269 +0,0 @@
-*> \brief \b SGELQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGELQF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelqf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGELQF computes an LQ factorization of a real M-by-N matrix A:
-*> A = L * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and below the diagonal of the array
-*> contain the m-by-min(m,n) lower trapezoidal matrix L (L is
-*> lower triangular if m <= n); the elements above the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGELQ2, SLARFB, SLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGELQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGELQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the LQ factorization of the current block
-* A(i:i+ib-1,i:n)
-*
- CALL SGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.M ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(i+ib:m,i:n) from the right
-*
- CALL SLARFB( 'Right', 'No transpose', 'Forward',
- $ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
- $ LDA, WORK, LDWORK, A( I+IB, I ), LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL SGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGELQF
-*
- END
diff --git a/netlib/LAPACK/sgels.f b/netlib/LAPACK/sgels.f
deleted file mode 100644
index 003c85d..0000000
--- a/netlib/LAPACK/sgels.f
+++ /dev/null
@@ -1,504 +0,0 @@
-*> \brief <b> SGELS solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGELS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgels.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgels.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgels.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGELS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, or its transpose, using a QR or LQ
-*> factorization of A. It is assumed that A has full rank.
-*>
-*> The following options are provided:
-*>
-*> 1. If TRANS = 'N' and m >= n: find the least squares solution of
-*> an overdetermined system, i.e., solve the least squares problem
-*> minimize || B - A*X ||.
-*>
-*> 2. If TRANS = 'N' and m < n: find the minimum norm solution of
-*> an underdetermined system A * X = B.
-*>
-*> 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
-*> an undetermined system A**T * X = B.
-*>
-*> 4. If TRANS = 'T' and m < n: find the least squares solution of
-*> an overdetermined system, i.e., solve the least squares problem
-*> minimize || B - A**T * X ||.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': the linear system involves A;
-*> = 'T': the linear system involves A**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of
-*> columns of the matrices B and X. NRHS >=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if M >= N, A is overwritten by details of its QR
-*> factorization as returned by SGEQRF;
-*> if M < N, A is overwritten by details of its LQ
-*> factorization as returned by SGELQF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the matrix B of right hand side vectors, stored
-*> columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
-*> if TRANS = 'T'.
-*> On exit, if INFO = 0, B is overwritten by the solution
-*> vectors, stored columnwise:
-*> if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
-*> squares solution vectors; the residual sum of squares for the
-*> solution in each column is given by the sum of squares of
-*> elements N+1 to M in that column;
-*> if TRANS = 'N' and m < n, rows 1 to N of B contain the
-*> minimum norm solution vectors;
-*> if TRANS = 'T' and m >= n, rows 1 to M of B contain the
-*> minimum norm solution vectors;
-*> if TRANS = 'T' and m < n, rows 1 to M of B contain the
-*> least squares solution vectors; the residual sum of squares
-*> for the solution in each column is given by the sum of
-*> squares of elements M+1 to N in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= MAX(1,M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= max( 1, MN + max( MN, NRHS ) ).
-*> For optimal performance,
-*> LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
-*> where MN = min(M,N) and NB is the optimum block size.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of the
-*> triangular factor of A is zero, so that A does not have
-*> full rank; the least squares solution could not be
-*> computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-* =====================================================================
- SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, TPSD
- INTEGER BROW, I, IASCL, IBSCL, J, MN, NB, SCLLEN, WSIZE
- REAL ANRM, BIGNUM, BNRM, SMLNUM
-* ..
-* .. Local Arrays ..
- REAL RWORK( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SGELQF, SGEQRF, SLABAD, SLASCL, SLASET, SORMLQ,
- $ SORMQR, STRTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.MAX( 1, MN + MAX( MN, NRHS ) ) .AND.
- $ .NOT.LQUERY ) THEN
- INFO = -10
- END IF
-*
-* Figure out optimal block size
-*
- IF( INFO.EQ.0 .OR. INFO.EQ.-10 ) THEN
-*
- TPSD = .TRUE.
- IF( LSAME( TRANS, 'N' ) )
- $ TPSD = .FALSE.
-*
- IF( M.GE.N ) THEN
- NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- IF( TPSD ) THEN
- NB = MAX( NB, ILAENV( 1, 'SORMQR', 'LN', M, NRHS, N,
- $ -1 ) )
- ELSE
- NB = MAX( NB, ILAENV( 1, 'SORMQR', 'LT', M, NRHS, N,
- $ -1 ) )
- END IF
- ELSE
- NB = ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
- IF( TPSD ) THEN
- NB = MAX( NB, ILAENV( 1, 'SORMLQ', 'LT', N, NRHS, M,
- $ -1 ) )
- ELSE
- NB = MAX( NB, ILAENV( 1, 'SORMLQ', 'LN', N, NRHS, M,
- $ -1 ) )
- END IF
- END IF
-*
- WSIZE = MAX( 1, MN + MAX( MN, NRHS )*NB )
- WORK( 1 ) = REAL( WSIZE )
-*
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELS ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- CALL SLASET( 'Full', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- RETURN
- END IF
-*
-* Get machine parameters
-*
- SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Scale A, B if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, RWORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- GO TO 50
- END IF
-*
- BROW = M
- IF( TPSD )
- $ BROW = N
- BNRM = SLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, 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, BROW, NRHS, B, LDB,
- $ INFO )
- IBSCL = 2
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* compute QR factorization of A
-*
- CALL SGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least N, optimally N*NB
-*
- IF( .NOT.TPSD ) THEN
-*
-* Least-Squares Problem min || A * X - B ||
-*
-* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
-*
- CALL SORMQR( 'Left', 'Transpose', M, NRHS, N, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
-* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
-*
- CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
- SCLLEN = N
-*
- ELSE
-*
-* Overdetermined system of equations A**T * X = B
-*
-* B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
-*
- CALL STRTRS( 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
-* B(N+1:M,1:NRHS) = ZERO
-*
- DO 20 J = 1, NRHS
- DO 10 I = N + 1, M
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
-*
- CALL SORMQR( 'Left', 'No transpose', M, NRHS, N, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
- SCLLEN = M
-*
- END IF
-*
- ELSE
-*
-* Compute LQ factorization of A
-*
- CALL SGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least M, optimally M*NB.
-*
- IF( .NOT.TPSD ) THEN
-*
-* underdetermined system of equations A * X = B
-*
-* B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
-*
- CALL STRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
-* B(M+1:N,1:NRHS) = 0
-*
- DO 40 J = 1, NRHS
- DO 30 I = M + 1, N
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
-*
- CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
- SCLLEN = N
-*
- ELSE
-*
-* overdetermined system min || A**T * X - B ||
-*
-* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
-*
- CALL SORMLQ( 'Left', 'No transpose', N, NRHS, M, A, LDA,
- $ WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
- $ INFO )
-*
-* workspace at least NRHS, optimally NRHS*NB
-*
-* B(1:M,1:NRHS) := inv(L**T) * B(1:M,1:NRHS)
-*
- CALL STRTRS( 'Lower', 'Transpose', 'Non-unit', M, NRHS,
- $ A, LDA, B, LDB, INFO )
-*
- IF( INFO.GT.0 ) THEN
- RETURN
- END IF
-*
- SCLLEN = M
-*
- END IF
-*
- END IF
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- ELSE IF( IASCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- END IF
- IF( IBSCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
- END IF
-*
- 50 CONTINUE
- WORK( 1 ) = REAL( WSIZE )
-*
- RETURN
-*
-* End of SGELS
-*
- END
diff --git a/netlib/LAPACK/sgelsd.f b/netlib/LAPACK/sgelsd.f
deleted file mode 100644
index d03f37b..0000000
--- a/netlib/LAPACK/sgelsd.f
+++ /dev/null
@@ -1,633 +0,0 @@
-*> \brief <b> SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGELSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND,
-* RANK, WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGELSD computes the minimum-norm solution to a real linear least
-*> squares problem:
-*> minimize 2-norm(| b - A*x |)
-*> using the singular value decomposition (SVD) of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*>
-*> The problem is solved in three steps:
-*> (1) Reduce the coefficient matrix A to bidiagonal form with
-*> Householder transformations, reducing the original problem
-*> into a "bidiagonal least squares problem" (BLS)
-*> (2) Solve the BLS using a divide and conquer approach.
-*> (3) Apply back all the Householder tranformations to solve
-*> the original least squares problem.
-*>
-*> The effective rank of A is determined by treating as zero those
-*> singular values which are less than RCOND times the largest singular
-*> value.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A has been destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, B is overwritten by the N-by-NRHS solution
-*> matrix X. If m >= n and RANK = n, the residual
-*> sum-of-squares for the solution in the i-th column is given
-*> by the sum of squares of elements n+1:m in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,max(M,N)).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (min(M,N))
-*> The singular values of A in decreasing order.
-*> The condition number of A in the 2-norm = S(1)/S(min(m,n)).
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> RCOND is used to determine the effective rank of A.
-*> Singular values S(i) <= RCOND*S(1) are treated as zero.
-*> If RCOND < 0, machine precision is used instead.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the number of singular values
-*> which are greater than RCOND*S(1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK must be at least 1.
-*> The exact minimum amount of workspace needed depends on M,
-*> N and NRHS. As long as LWORK is at least
-*> 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
-*> if M is greater than or equal to N or
-*> 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
-*> if M is less than N, the code will execute correctly.
-*> SMLSIZ is returned by ILAENV and is equal to the maximum
-*> size of the subproblems at the bottom of the computation
-*> tree (usually about 25), and
-*> NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the array WORK and the
-*> minimum size of the array IWORK, and returns these values as
-*> the first entries of the WORK and IWORK arrays, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> LIWORK >= max(1, 3*MINMN*NLVL + 11*MINMN),
-*> where MINMN = MIN( M,N ).
-*> On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: the algorithm for computing the SVD failed to converge;
-*> if INFO = i, i off-diagonal elements of an intermediate
-*> bidiagonal form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND,
- $ RANK, WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
- $ LDWORK, LIWORK, MAXMN, MAXWRK, MINMN, MINWRK,
- $ MM, MNTHR, NLVL, NWORK, SMLSIZ, WLALSD
- REAL ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEBRD, SGELQF, SGEQRF, SLABAD, SLACPY, SLALSD,
- $ SLASCL, SLASET, SORMBR, SORMLQ, SORMQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL SLAMCH, SLANGE, ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, LOG, MAX, MIN, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- MINMN = MIN( M, N )
- MAXMN = MAX( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, MAXMN ) ) THEN
- INFO = -7
- END IF
-*
-* Compute workspace.
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- LIWORK = 1
- IF( MINMN.GT.0 ) THEN
- SMLSIZ = ILAENV( 9, 'SGELSD', ' ', 0, 0, 0, 0 )
- MNTHR = ILAENV( 6, 'SGELSD', ' ', M, N, NRHS, -1 )
- NLVL = MAX( INT( LOG( REAL( MINMN ) / REAL( SMLSIZ + 1 ) ) /
- $ LOG( TWO ) ) + 1, 0 )
- LIWORK = 3*MINMN*NLVL + 11*MINMN
- MM = M
- IF( M.GE.N .AND. M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than
-* columns.
-*
- MM = N
- MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'SGEQRF', ' ', M,
- $ N, -1, -1 ) )
- MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'SORMQR', 'LT',
- $ M, NRHS, N, -1 ) )
- END IF
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined.
-*
- MAXWRK = MAX( MAXWRK, 3*N + ( MM + N )*ILAENV( 1,
- $ 'SGEBRD', ' ', MM, N, -1, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*N + NRHS*ILAENV( 1, 'SORMBR',
- $ 'QLT', MM, NRHS, N, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*N + ( N - 1 )*ILAENV( 1,
- $ 'SORMBR', 'PLN', N, NRHS, N, -1 ) )
- WLALSD = 9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS +
- $ ( SMLSIZ + 1 )**2
- MAXWRK = MAX( MAXWRK, 3*N + WLALSD )
- MINWRK = MAX( 3*N + MM, 3*N + NRHS, 3*N + WLALSD )
- END IF
- IF( N.GT.M ) THEN
- WLALSD = 9*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS +
- $ ( SMLSIZ + 1 )**2
- IF( N.GE.MNTHR ) THEN
-*
-* Path 2a - underdetermined, with many more columns
-* than rows.
-*
- MAXWRK = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1,
- $ -1 )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + 2*M*ILAENV( 1,
- $ 'SGEBRD', ' ', M, M, -1, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + NRHS*ILAENV( 1,
- $ 'SORMBR', 'QLT', M, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + ( M - 1 )*ILAENV( 1,
- $ 'SORMBR', 'PLN', M, NRHS, M, -1 ) )
- IF( NRHS.GT.1 ) THEN
- MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS )
- ELSE
- MAXWRK = MAX( MAXWRK, M*M + 2*M )
- END IF
- MAXWRK = MAX( MAXWRK, M + NRHS*ILAENV( 1, 'SORMLQ',
- $ 'LT', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + WLALSD )
-! XXX: Ensure the Path 2a case below is triggered. The workspace
-! calculation should use queries for all routines eventually.
- MAXWRK = MAX( MAXWRK,
- $ 4*M+M*M+MAX( M, 2*M-4, NRHS, N-3*M ) )
- ELSE
-*
-* Path 2 - remaining underdetermined cases.
-*
- MAXWRK = 3*M + ( N + M )*ILAENV( 1, 'SGEBRD', ' ', M,
- $ N, -1, -1 )
- MAXWRK = MAX( MAXWRK, 3*M + NRHS*ILAENV( 1, 'SORMBR',
- $ 'QLT', M, NRHS, N, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*M + M*ILAENV( 1, 'SORMBR',
- $ 'PLN', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*M + WLALSD )
- END IF
- MINWRK = MAX( 3*M + NRHS, 3*M + M, 3*M + WLALSD )
- END IF
- END IF
- MINWRK = MIN( MINWRK, MAXWRK )
- WORK( 1 ) = MAXWRK
- IWORK( 1 ) = LIWORK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELSD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters.
-*
- EPS = SLAMCH( 'P' )
- SFMIN = SLAMCH( 'S' )
- SMLNUM = SFMIN / EPS
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Scale A if max entry outside range [SMLNUM,BIGNUM].
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM.
-*
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM.
-*
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- CALL SLASET( 'F', MINMN, 1, ZERO, ZERO, S, 1 )
- RANK = 0
- GO TO 10
- END IF
-*
-* Scale B if max entry outside range [SMLNUM,BIGNUM].
-*
- BNRM = SLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM.
-*
- 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 )
- IBSCL = 2
- END IF
-*
-* If M < N make sure certain entries of B are zero.
-*
- IF( M.LT.N )
- $ CALL SLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
-*
-* Overdetermined case.
-*
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined.
-*
- MM = M
- IF( M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than columns.
-*
- MM = N
- ITAU = 1
- NWORK = ITAU + N
-*
-* Compute A=Q*R.
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Multiply B by transpose(Q).
-* (Workspace: need N+NRHS, prefer N+NRHS*NB)
-*
- CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
-* Zero out below R.
-*
- IF( N.GT.1 ) THEN
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- END IF
- END IF
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in A.
-* (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
-*
- CALL SGEBRD( MM, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of R.
-* (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
-*
- CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
-* Solve the bidiagonal least squares problem.
-*
- CALL SLALSD( 'U', SMLSIZ, N, NRHS, S, WORK( IE ), B, LDB,
- $ RCOND, RANK, WORK( NWORK ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- GO TO 10
- END IF
-*
-* Multiply B by right bidiagonalizing vectors of R.
-*
- CALL SORMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
- ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+
- $ MAX( M, 2*M-4, NRHS, N-3*M, WLALSD ) ) THEN
-*
-* Path 2a - underdetermined, with many more columns than rows
-* and sufficient workspace for an efficient algorithm.
-*
- LDWORK = M
- IF( LWORK.GE.MAX( 4*M+M*LDA+MAX( M, 2*M-4, NRHS, N-3*M ),
- $ M*LDA+M+M*NRHS, 4*M+M*LDA+WLALSD ) )LDWORK = LDA
- ITAU = 1
- NWORK = M + 1
-*
-* Compute A=L*Q.
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
- IL = NWORK
-*
-* Copy L to WORK(IL), zeroing out above its diagonal.
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWORK )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( IL+LDWORK ),
- $ LDWORK )
- IE = IL + LDWORK*M
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IL).
-* (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IL ), LDWORK, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of L.
-* (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
-*
- CALL SORMBR( 'Q', 'L', 'T', M, NRHS, M, WORK( IL ), LDWORK,
- $ WORK( ITAUQ ), B, LDB, WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Solve the bidiagonal least squares problem.
-*
- CALL SLALSD( 'U', SMLSIZ, M, NRHS, S, WORK( IE ), B, LDB,
- $ RCOND, RANK, WORK( NWORK ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- GO TO 10
- END IF
-*
-* Multiply B by right bidiagonalizing vectors of L.
-*
- CALL SORMBR( 'P', 'L', 'N', M, NRHS, M, WORK( IL ), LDWORK,
- $ WORK( ITAUP ), B, LDB, WORK( NWORK ),
- $ LWORK-NWORK+1, INFO )
-*
-* Zero out below first M rows of B.
-*
- CALL SLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
- NWORK = ITAU + M
-*
-* Multiply transpose(Q) by B.
-* (Workspace: need M+NRHS, prefer M+NRHS*NB)
-*
- CALL SORMLQ( 'L', 'T', N, NRHS, M, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
- ELSE
-*
-* Path 2 - remaining underdetermined cases.
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize A.
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors.
-* (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
-*
- CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
-* Solve the bidiagonal least squares problem.
-*
- CALL SLALSD( 'L', SMLSIZ, M, NRHS, S, WORK( IE ), B, LDB,
- $ RCOND, RANK, WORK( NWORK ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- GO TO 10
- END IF
-*
-* Multiply B by right bidiagonalizing vectors of A.
-*
- CALL SORMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ),
- $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
-*
- END IF
-*
-* Undo scaling.
-*
- IF( IASCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
- CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- ELSE IF( IASCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
- CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- END IF
- IF( IBSCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 10 CONTINUE
- WORK( 1 ) = MAXWRK
- IWORK( 1 ) = LIWORK
- RETURN
-*
-* End of SGELSD
-*
- END
diff --git a/netlib/LAPACK/sgelss.f b/netlib/LAPACK/sgelss.f
deleted file mode 100644
index bb46130..0000000
--- a/netlib/LAPACK/sgelss.f
+++ /dev/null
@@ -1,743 +0,0 @@
-*> \brief <b> SGELSS solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGELSS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelss.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelss.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelss.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGELSS computes the minimum norm solution to a real linear least
-*> squares problem:
-*>
-*> Minimize 2-norm(| b - A*x |).
-*>
-*> using the singular value decomposition (SVD) of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
-*> X.
-*>
-*> The effective rank of A is determined by treating as zero those
-*> singular values which are less than RCOND times the largest singular
-*> value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the first min(m,n) rows of A are overwritten with
-*> its right singular vectors, stored rowwise.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, B is overwritten by the N-by-NRHS solution
-*> matrix X. If m >= n and RANK = n, the residual
-*> sum-of-squares for the solution in the i-th column is given
-*> by the sum of squares of elements n+1:m in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,max(M,N)).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (min(M,N))
-*> The singular values of A in decreasing order.
-*> The condition number of A in the 2-norm = S(1)/S(min(m,n)).
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> RCOND is used to determine the effective rank of A.
-*> Singular values S(i) <= RCOND*S(1) are treated as zero.
-*> If RCOND < 0, machine precision is used instead.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the number of singular values
-*> which are greater than RCOND*S(1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 1, and also:
-*> LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: the algorithm for computing the SVD failed to converge;
-*> if INFO = i, i off-diagonal elements of an intermediate
-*> bidiagonal form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-* =====================================================================
- SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
- REAL RCOND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER BDSPAC, BL, CHUNK, I, IASCL, IBSCL, IE, IL,
- $ ITAU, ITAUP, ITAUQ, IWORK, LDWORK, MAXMN,
- $ MAXWRK, MINMN, MINWRK, MM, MNTHR
- INTEGER LWORK_SGEQRF, LWORK_SORMQR, LWORK_SGEBRD,
- $ LWORK_SORMBR, LWORK_SORGBR, LWORK_SORMLQ
- REAL ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM, THR
-* ..
-* .. Local Arrays ..
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SBDSQR, SCOPY, SGEBRD, SGELQF, SGEMM, SGEMV,
- $ SGEQRF, SLABAD, SLACPY, SLASCL, SLASET, SORGBR,
- $ SORMBR, SORMLQ, SORMQR, SRSCL, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- MAXMN = MAX( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, MAXMN ) ) THEN
- INFO = -7
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( MINMN.GT.0 ) THEN
- MM = M
- MNTHR = ILAENV( 6, 'SGELSS', ' ', M, N, NRHS, -1 )
- IF( M.GE.N .AND. M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than
-* columns
-*
-* Compute space needed for SGEQRF
- CALL SGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
- LWORK_SGEQRF=DUM(1)
-* Compute space needed for SORMQR
- CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, DUM(1), B,
- $ LDB, DUM(1), -1, INFO )
- LWORK_SORMQR=DUM(1)
- MM = N
- MAXWRK = MAX( MAXWRK, N + LWORK_SGEQRF )
- MAXWRK = MAX( MAXWRK, N + LWORK_SORMQR )
- END IF
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined
-*
-* Compute workspace needed for SBDSQR
-*
- BDSPAC = MAX( 1, 5*N )
-* Compute space needed for SGEBRD
- CALL SGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, INFO )
- LWORK_SGEBRD=DUM(1)
-* Compute space needed for SORMBR
- CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1),
- $ B, LDB, DUM(1), -1, INFO )
- LWORK_SORMBR=DUM(1)
-* Compute space needed for SORGBR
- CALL SORGBR( 'P', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, INFO )
- LWORK_SORGBR=DUM(1)
-* Compute total workspace needed
- MAXWRK = MAX( MAXWRK, 3*N + LWORK_SGEBRD )
- MAXWRK = MAX( MAXWRK, 3*N + LWORK_SORMBR )
- MAXWRK = MAX( MAXWRK, 3*N + LWORK_SORGBR )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MAXWRK = MAX( MAXWRK, N*NRHS )
- MINWRK = MAX( 3*N + MM, 3*N + NRHS, BDSPAC )
- MAXWRK = MAX( MINWRK, MAXWRK )
- END IF
- IF( N.GT.M ) THEN
-*
-* Compute workspace needed for SBDSQR
-*
- BDSPAC = MAX( 1, 5*M )
- MINWRK = MAX( 3*M+NRHS, 3*M+N, BDSPAC )
- IF( N.GE.MNTHR ) THEN
-*
-* Path 2a - underdetermined, with many more columns
-* than rows
-*
-* Compute space needed for SGEBRD
- CALL SGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, INFO )
- LWORK_SGEBRD=DUM(1)
-* Compute space needed for SORMBR
- CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA,
- $ DUM(1), B, LDB, DUM(1), -1, INFO )
- LWORK_SORMBR=DUM(1)
-* Compute space needed for SORGBR
- CALL SORGBR( 'P', M, M, M, A, LDA, DUM(1),
- $ DUM(1), -1, INFO )
- LWORK_SORGBR=DUM(1)
-* Compute space needed for SORMLQ
- CALL SORMLQ( 'L', 'T', N, NRHS, M, A, LDA, DUM(1),
- $ B, LDB, DUM(1), -1, INFO )
- LWORK_SORMLQ=DUM(1)
-* Compute total workspace needed
- MAXWRK = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1,
- $ -1 )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_SGEBRD )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_SORMBR )
- MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_SORGBR )
- MAXWRK = MAX( MAXWRK, M*M + M + BDSPAC )
- IF( NRHS.GT.1 ) THEN
- MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS )
- ELSE
- MAXWRK = MAX( MAXWRK, M*M + 2*M )
- END IF
- MAXWRK = MAX( MAXWRK, M + LWORK_SORMLQ )
- ELSE
-*
-* Path 2 - underdetermined
-*
-* Compute space needed for SGEBRD
- CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, INFO )
- LWORK_SGEBRD=DUM(1)
-* Compute space needed for SORMBR
- CALL SORMBR( 'Q', 'L', 'T', M, NRHS, M, A, LDA,
- $ DUM(1), B, LDB, DUM(1), -1, INFO )
- LWORK_SORMBR=DUM(1)
-* Compute space needed for SORGBR
- CALL SORGBR( 'P', M, N, M, A, LDA, DUM(1),
- $ DUM(1), -1, INFO )
- LWORK_SORGBR=DUM(1)
- MAXWRK = 3*M + LWORK_SGEBRD
- MAXWRK = MAX( MAXWRK, 3*M + LWORK_SORMBR )
- MAXWRK = MAX( MAXWRK, 3*M + LWORK_SORGBR )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MAXWRK = MAX( MAXWRK, N*NRHS )
- END IF
- END IF
- MAXWRK = MAX( MINWRK, MAXWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELSS', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters
-*
- EPS = SLAMCH( 'P' )
- SFMIN = SLAMCH( 'S' )
- SMLNUM = SFMIN / EPS
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- CALL SLASET( 'F', MINMN, 1, ZERO, ZERO, S, 1 )
- RANK = 0
- GO TO 70
- END IF
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = SLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- 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 )
- IBSCL = 2
- END IF
-*
-* Overdetermined case
-*
- IF( M.GE.N ) THEN
-*
-* Path 1 - overdetermined or exactly determined
-*
- MM = M
- IF( M.GE.MNTHR ) THEN
-*
-* Path 1a - overdetermined, with many more rows than columns
-*
- MM = N
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
-*
-* Multiply B by transpose(Q)
-* (Workspace: need N+NRHS, prefer N+NRHS*NB)
-*
- CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-* Zero out below R
-*
- IF( N.GT.1 )
- $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- END IF
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
-*
- CALL SGEBRD( MM, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of R
-* (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
-*
- CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-* Generate right bidiagonalizing vectors of R in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, INFO )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration
-* multiply B by transpose of left singular vectors
-* compute right singular vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, 0, NRHS, S, WORK( IE ), A, LDA, DUM,
- $ 1, B, LDB, WORK( IWORK ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 70
-*
-* Multiply B by reciprocals of singular values
-*
- THR = MAX( RCOND*S( 1 ), SFMIN )
- IF( RCOND.LT.ZERO )
- $ THR = MAX( EPS*S( 1 ), SFMIN )
- RANK = 0
- DO 10 I = 1, N
- IF( S( I ).GT.THR ) THEN
- CALL SRSCL( NRHS, S( I ), B( I, 1 ), LDB )
- RANK = RANK + 1
- ELSE
- CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- END IF
- 10 CONTINUE
-*
-* Multiply B by right singular vectors
-* (Workspace: need N, prefer N*NRHS)
-*
- IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN
- CALL SGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, ZERO,
- $ WORK, LDB )
- CALL SLACPY( 'G', N, NRHS, WORK, LDB, B, LDB )
- ELSE IF( NRHS.GT.1 ) THEN
- CHUNK = LWORK / N
- DO 20 I = 1, NRHS, CHUNK
- BL = MIN( NRHS-I+1, CHUNK )
- CALL SGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, I ),
- $ LDB, ZERO, WORK, N )
- CALL SLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
- 20 CONTINUE
- ELSE
- CALL SGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
- CALL SCOPY( N, WORK, 1, B, 1 )
- END IF
-*
- ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+
- $ MAX( M, 2*M-4, NRHS, N-3*M ) ) THEN
-*
-* Path 2a - underdetermined, with many more columns than rows
-* and sufficient workspace for an efficient algorithm
-*
- LDWORK = M
- IF( LWORK.GE.MAX( 4*M+M*LDA+MAX( M, 2*M-4, NRHS, N-3*M ),
- $ M*LDA+M+M*NRHS ) )LDWORK = LDA
- ITAU = 1
- IWORK = M + 1
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
- IL = IWORK
-*
-* Copy L to WORK(IL), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWORK )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( IL+LDWORK ),
- $ LDWORK )
- IE = IL + LDWORK*M
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IL)
-* (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IL ), LDWORK, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors of L
-* (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
-*
- CALL SORMBR( 'Q', 'L', 'T', M, NRHS, M, WORK( IL ), LDWORK,
- $ WORK( ITAUQ ), B, LDB, WORK( IWORK ),
- $ LWORK-IWORK+1, INFO )
-*
-* Generate right bidiagonalizing vectors of R in WORK(IL)
-* (Workspace: need M*M+5*M-1, prefer M*M+4*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, INFO )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration,
-* computing right singular vectors of L in WORK(IL) and
-* multiplying B by transpose of left singular vectors
-* (Workspace: need M*M+M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, 0, NRHS, S, WORK( IE ), WORK( IL ),
- $ LDWORK, A, LDA, B, LDB, WORK( IWORK ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 70
-*
-* Multiply B by reciprocals of singular values
-*
- THR = MAX( RCOND*S( 1 ), SFMIN )
- IF( RCOND.LT.ZERO )
- $ THR = MAX( EPS*S( 1 ), SFMIN )
- RANK = 0
- DO 30 I = 1, M
- IF( S( I ).GT.THR ) THEN
- CALL SRSCL( NRHS, S( I ), B( I, 1 ), LDB )
- RANK = RANK + 1
- ELSE
- CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- END IF
- 30 CONTINUE
- IWORK = IE
-*
-* Multiply B by right singular vectors of L in WORK(IL)
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NRHS)
-*
- IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN
- CALL SGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), LDWORK,
- $ B, LDB, ZERO, WORK( IWORK ), LDB )
- CALL SLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB )
- ELSE IF( NRHS.GT.1 ) THEN
- CHUNK = ( LWORK-IWORK+1 ) / M
- DO 40 I = 1, NRHS, CHUNK
- BL = MIN( NRHS-I+1, CHUNK )
- CALL SGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
- CALL SLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
- $ LDB )
- 40 CONTINUE
- ELSE
- CALL SGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
- $ 1, ZERO, WORK( IWORK ), 1 )
- CALL SCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
- END IF
-*
-* Zero out below first M rows of B
-*
- CALL SLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
- IWORK = ITAU + M
-*
-* Multiply transpose(Q) by B
-* (Workspace: need M+NRHS, prefer M+NRHS*NB)
-*
- CALL SORMLQ( 'L', 'T', N, NRHS, M, A, LDA, WORK( ITAU ), B,
- $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
- ELSE
-*
-* Path 2 - remaining underdetermined cases
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ INFO )
-*
-* Multiply B by transpose of left bidiagonalizing vectors
-* (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
-*
- CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ),
- $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-* Generate right bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, INFO )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration,
-* computing right singular vectors of A in A and
-* multiplying B by transpose of left singular vectors
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'L', M, N, 0, NRHS, S, WORK( IE ), A, LDA, DUM,
- $ 1, B, LDB, WORK( IWORK ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 70
-*
-* Multiply B by reciprocals of singular values
-*
- THR = MAX( RCOND*S( 1 ), SFMIN )
- IF( RCOND.LT.ZERO )
- $ THR = MAX( EPS*S( 1 ), SFMIN )
- RANK = 0
- DO 50 I = 1, M
- IF( S( I ).GT.THR ) THEN
- CALL SRSCL( NRHS, S( I ), B( I, 1 ), LDB )
- RANK = RANK + 1
- ELSE
- CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- END IF
- 50 CONTINUE
-*
-* Multiply B by right singular vectors of A
-* (Workspace: need N, prefer N*NRHS)
-*
- IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN
- CALL SGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, ZERO,
- $ WORK, LDB )
- CALL SLACPY( 'F', N, NRHS, WORK, LDB, B, LDB )
- ELSE IF( NRHS.GT.1 ) THEN
- CHUNK = LWORK / N
- DO 60 I = 1, NRHS, CHUNK
- BL = MIN( NRHS-I+1, CHUNK )
- CALL SGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, I ),
- $ LDB, ZERO, WORK, N )
- CALL SLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
- 60 CONTINUE
- ELSE
- CALL SGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
- CALL SCOPY( N, WORK, 1, B, 1 )
- END IF
- END IF
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
- CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- ELSE IF( IASCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
- CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ INFO )
- END IF
- IF( IBSCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 70 CONTINUE
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of SGELSS
-*
- END
diff --git a/netlib/LAPACK/sgelsx.f b/netlib/LAPACK/sgelsx.f
deleted file mode 100644
index cbc19a8..0000000
--- a/netlib/LAPACK/sgelsx.f
+++ /dev/null
@@ -1,435 +0,0 @@
-*> \brief <b> SGELSX solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelsx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, M, N, NRHS, RANK
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine SGELSY.
-*>
-*> SGELSX computes the minimum-norm solution to a real linear least
-*> squares problem:
-*> minimize || A * X - B ||
-*> using a complete orthogonal factorization of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*>
-*> The routine first computes a QR factorization with column pivoting:
-*> A * P = Q * [ R11 R12 ]
-*> [ 0 R22 ]
-*> with R11 defined as the largest leading submatrix whose estimated
-*> condition number is less than 1/RCOND. The order of R11, RANK,
-*> is the effective rank of A.
-*>
-*> Then, R22 is considered to be negligible, and R12 is annihilated
-*> by orthogonal transformations from the right, arriving at the
-*> complete orthogonal factorization:
-*> A * P = Q * [ T11 0 ] * Z
-*> [ 0 0 ]
-*> The minimum-norm solution is then
-*> X = P * Z**T [ inv(T11)*Q1**T*B ]
-*> [ 0 ]
-*> where Q1 consists of the first RANK columns of Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of
-*> columns of matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A has been overwritten by details of its
-*> complete orthogonal factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, the N-by-NRHS solution matrix X.
-*> If m >= n and RANK = n, the residual sum-of-squares for
-*> the solution in the i-th column is given by the sum of
-*> squares of elements N+1:M in that column.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M,N).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is an
-*> initial column, otherwise it is a free column. Before
-*> the QR factorization of A, all initial columns are
-*> permuted to the leading positions; only the remaining
-*> free columns are moved as a result of column pivoting
-*> during the factorization.
-*> On exit, if JPVT(i) = k, then the i-th column of A*P
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> RCOND is used to determine the effective rank of A, which
-*> is defined as the order of the largest leading triangular
-*> submatrix R11 in the QR factorization with pivoting of A,
-*> whose estimated condition number < 1/RCOND.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the order of the submatrix
-*> R11. This is the same as the order of the submatrix T11
-*> in the complete orthogonal factorization of A.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-* =====================================================================
- SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
- $ WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, M, N, NRHS, RANK
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER IMAX, IMIN
- PARAMETER ( IMAX = 1, IMIN = 2 )
- REAL ZERO, ONE, DONE, NTDONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, DONE = ZERO,
- $ NTDONE = ONE )
-* ..
-* .. Local Scalars ..
- INTEGER I, IASCL, IBSCL, ISMAX, ISMIN, J, K, MN
- REAL ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
- $ SMAXPR, SMIN, SMINPR, SMLNUM, T1, T2
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLANGE
- EXTERNAL SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQPF, SLABAD, SLAIC1, SLASCL, SLASET, SLATZM,
- $ SORM2R, STRSM, STZRQF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- MN = MIN( M, N )
- ISMIN = MN + 1
- ISMAX = 2*MN + 1
-*
-* Test the input arguments.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELSX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters
-*
- SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Scale A, B if max elements outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- RANK = 0
- GO TO 100
- END IF
-*
- BNRM = SLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- 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 )
- 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 )
-*
-* workspace 3*N. Details of Householder rotations stored
-* in WORK(1:MN).
-*
-* Determine RANK using incremental condition estimation
-*
- WORK( ISMIN ) = ONE
- WORK( ISMAX ) = ONE
- SMAX = ABS( A( 1, 1 ) )
- SMIN = SMAX
- IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
- RANK = 0
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- GO TO 100
- ELSE
- RANK = 1
- END IF
-*
- 10 CONTINUE
- IF( RANK.LT.MN ) THEN
- I = RANK + 1
- CALL SLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
- $ A( I, I ), SMINPR, S1, C1 )
- CALL SLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
- $ A( I, I ), SMAXPR, S2, C2 )
-*
- IF( SMAXPR*RCOND.LE.SMINPR ) THEN
- DO 20 I = 1, RANK
- WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
- WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
- 20 CONTINUE
- WORK( ISMIN+RANK ) = C1
- WORK( ISMAX+RANK ) = C2
- SMIN = SMINPR
- SMAX = SMAXPR
- RANK = RANK + 1
- GO TO 10
- END IF
- END IF
-*
-* Logically partition R = [ R11 R12 ]
-* [ 0 R22 ]
-* where R11 = R(1:RANK,1:RANK)
-*
-* [R11,R12] = [ T11, 0 ] * Y
-*
- IF( RANK.LT.N )
- $ CALL STZRQF( RANK, N, A, LDA, WORK( MN+1 ), INFO )
-*
-* Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-* 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 )
-*
-* 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 )
-*
- DO 40 I = RANK + 1, N
- DO 30 J = 1, NRHS
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* B(1:N,1:NRHS) := Y**T * B(1:N,1:NRHS)
-*
- IF( RANK.LT.N ) THEN
- DO 50 I = 1, RANK
- CALL SLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), LDA,
- $ WORK( MN+I ), B( I, 1 ), B( RANK+1, 1 ), LDB,
- $ WORK( 2*MN+1 ) )
- 50 CONTINUE
- END IF
-*
-* workspace NRHS
-*
-* B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
- DO 90 J = 1, NRHS
- DO 60 I = 1, N
- WORK( 2*MN+I ) = NTDONE
- 60 CONTINUE
- DO 80 I = 1, N
- IF( WORK( 2*MN+I ).EQ.NTDONE ) THEN
- IF( JPVT( I ).NE.I ) THEN
- K = I
- T1 = B( K, J )
- T2 = B( JPVT( K ), J )
- 70 CONTINUE
- B( JPVT( K ), J ) = T1
- WORK( 2*MN+K ) = DONE
- T1 = T2
- K = JPVT( K )
- T2 = B( JPVT( K ), J )
- IF( JPVT( K ).NE.I )
- $ GO TO 70
- B( I, J ) = T1
- WORK( 2*MN+K ) = DONE
- END IF
- END IF
- 80 CONTINUE
- 90 CONTINUE
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- 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( '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 )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 100 CONTINUE
-*
- RETURN
-*
-* End of SGELSX
-*
- END
diff --git a/netlib/LAPACK/sgelsy.f b/netlib/LAPACK/sgelsy.f
deleted file mode 100644
index 2ad42b7..0000000
--- a/netlib/LAPACK/sgelsy.f
+++ /dev/null
@@ -1,479 +0,0 @@
-*> \brief <b> SGELSY solves overdetermined or underdetermined systems for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGELSY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelsy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelsy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGELSY computes the minimum-norm solution to a real linear least
-*> squares problem:
-*> minimize || A * X - B ||
-*> using a complete orthogonal factorization of A. A is an M-by-N
-*> matrix which may be rank-deficient.
-*>
-*> Several right hand side vectors b and solution vectors x can be
-*> handled in a single call; they are stored as the columns of the
-*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*> matrix X.
-*>
-*> The routine first computes a QR factorization with column pivoting:
-*> A * P = Q * [ R11 R12 ]
-*> [ 0 R22 ]
-*> with R11 defined as the largest leading submatrix whose estimated
-*> condition number is less than 1/RCOND. The order of R11, RANK,
-*> is the effective rank of A.
-*>
-*> Then, R22 is considered to be negligible, and R12 is annihilated
-*> by orthogonal transformations from the right, arriving at the
-*> complete orthogonal factorization:
-*> A * P = Q * [ T11 0 ] * Z
-*> [ 0 0 ]
-*> The minimum-norm solution is then
-*> X = P * Z**T [ inv(T11)*Q1**T*B ]
-*> [ 0 ]
-*> where Q1 consists of the first RANK columns of Q.
-*>
-*> This routine is basically identical to the original xGELSX except
-*> three differences:
-*> o The call to the subroutine xGEQPF has been substituted by the
-*> the call to the subroutine xGEQP3. This subroutine is a Blas-3
-*> version of the QR factorization with column pivoting.
-*> o Matrix B (the right hand side) is updated with Blas-3.
-*> o The permutation of matrix B (the right hand side) is faster and
-*> more simple.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of
-*> columns of matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A has been overwritten by details of its
-*> complete orthogonal factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the M-by-NRHS right hand side matrix B.
-*> On exit, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M,N).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*> to the front of AP, otherwise column i is a free column.
-*> On exit, if JPVT(i) = k, then the i-th column of AP
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> RCOND is used to determine the effective rank of A, which
-*> is defined as the order of the largest leading triangular
-*> submatrix R11 in the QR factorization with pivoting of A,
-*> whose estimated condition number < 1/RCOND.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The effective rank of A, i.e., the order of the submatrix
-*> R11. This is the same as the order of the submatrix T11
-*> in the complete orthogonal factorization of A.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> The unblocked strategy requires that:
-*> LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
-*> where MN = min( M, N ).
-*> The block algorithm requires that:
-*> LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
-*> where NB is an upper bound on the blocksize returned
-*> by ILAENV for the routines SGEQP3, STZRZF, STZRQF, SORMQR,
-*> and SORMRZ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: If INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA \n
-*> E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
-*>
-* =====================================================================
- SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER IMAX, IMIN
- PARAMETER ( IMAX = 1, IMIN = 2 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IASCL, IBSCL, ISMAX, ISMIN, J, LWKMIN,
- $ LWKOPT, MN, NB, NB1, NB2, NB3, NB4
- REAL ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
- $ SMAXPR, SMIN, SMINPR, SMLNUM, WSIZE
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL ILAENV, SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEQP3, SLABAD, SLAIC1, SLASCL, SLASET,
- $ SORMQR, SORMRZ, STRSM, STZRZF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- MN = MIN( M, N )
- ISMIN = MN + 1
- ISMAX = 2*MN + 1
-*
-* Test the input arguments.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
- INFO = -7
- END IF
-*
-* Figure out optimal block size
-*
- IF( INFO.EQ.0 ) THEN
- IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
- LWKMIN = 1
- LWKOPT = 1
- ELSE
- NB1 = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- NB2 = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
- NB3 = ILAENV( 1, 'SORMQR', ' ', M, N, NRHS, -1 )
- NB4 = ILAENV( 1, 'SORMRQ', ' ', M, N, NRHS, -1 )
- NB = MAX( NB1, NB2, NB3, NB4 )
- LWKMIN = MN + MAX( 2*MN, N + 1, MN + NRHS )
- LWKOPT = MAX( LWKMIN,
- $ MN + 2*N + NB*( N + 1 ), 2*MN + NB*NRHS )
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGELSY', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
- RANK = 0
- RETURN
- END IF
-*
-* Get machine parameters
-*
- SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Scale A, B if max entries outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, WORK )
- IASCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
- IASCL = 1
- ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-* Scale matrix norm down to BIGNUM
-*
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
- IASCL = 2
- ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-* Matrix all zero. Return zero solution.
-*
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- RANK = 0
- GO TO 70
- END IF
-*
- BNRM = SLANGE( 'M', M, NRHS, B, LDB, WORK )
- IBSCL = 0
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-* Scale matrix norm up to SMLNUM
-*
- 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 )
- IBSCL = 2
- END IF
-*
-* Compute QR factorization with column pivoting of A:
-* A * P = Q * R
-*
- CALL SGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
- $ LWORK-MN, INFO )
- WSIZE = MN + WORK( MN+1 )
-*
-* workspace: MN+2*N+NB*(N+1).
-* Details of Householder rotations stored in WORK(1:MN).
-*
-* Determine RANK using incremental condition estimation
-*
- WORK( ISMIN ) = ONE
- WORK( ISMAX ) = ONE
- SMAX = ABS( A( 1, 1 ) )
- SMIN = SMAX
- IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
- RANK = 0
- CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
- GO TO 70
- ELSE
- RANK = 1
- END IF
-*
- 10 CONTINUE
- IF( RANK.LT.MN ) THEN
- I = RANK + 1
- CALL SLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
- $ A( I, I ), SMINPR, S1, C1 )
- CALL SLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
- $ A( I, I ), SMAXPR, S2, C2 )
-*
- IF( SMAXPR*RCOND.LE.SMINPR ) THEN
- DO 20 I = 1, RANK
- WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
- WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
- 20 CONTINUE
- WORK( ISMIN+RANK ) = C1
- WORK( ISMAX+RANK ) = C2
- SMIN = SMINPR
- SMAX = SMAXPR
- RANK = RANK + 1
- GO TO 10
- END IF
- END IF
-*
-* workspace: 3*MN.
-*
-* Logically partition R = [ R11 R12 ]
-* [ 0 R22 ]
-* where R11 = R(1:RANK,1:RANK)
-*
-* [R11,R12] = [ T11, 0 ] * Y
-*
- IF( RANK.LT.N )
- $ CALL STZRZF( RANK, N, A, LDA, WORK( MN+1 ), WORK( 2*MN+1 ),
- $ LWORK-2*MN, INFO )
-*
-* workspace: 2*MN.
-* Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
-*
- CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
- $ B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
- WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) )
-*
-* workspace: 2*MN+NB*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 )
-*
- DO 40 J = 1, NRHS
- DO 30 I = RANK + 1, N
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* B(1:N,1:NRHS) := Y**T * B(1:N,1:NRHS)
-*
- IF( RANK.LT.N ) THEN
- CALL SORMRZ( 'Left', 'Transpose', N, NRHS, RANK, N-RANK, A,
- $ LDA, WORK( MN+1 ), B, LDB, WORK( 2*MN+1 ),
- $ LWORK-2*MN, INFO )
- END IF
-*
-* workspace: 2*MN+NRHS.
-*
-* B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- WORK( JPVT( I ) ) = B( I, J )
- 50 CONTINUE
- CALL SCOPY( N, WORK( 1 ), 1, B( 1, J ), 1 )
- 60 CONTINUE
-*
-* workspace: N.
-*
-* Undo scaling
-*
- IF( IASCL.EQ.1 ) THEN
- 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( '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 )
- ELSE IF( IBSCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
- END IF
-*
- 70 CONTINUE
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SGELSY
-*
- END
diff --git a/netlib/LAPACK/sgemqrt.f b/netlib/LAPACK/sgemqrt.f
deleted file mode 100644
index 443c9d1..0000000
--- a/netlib/LAPACK/sgemqrt.f
+++ /dev/null
@@ -1,291 +0,0 @@
-*> \brief \b SGEMQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEMQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgemqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgemqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgemqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
-* C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDV, LDC, M, N, NB, LDT
-* ..
-* .. Array Arguments ..
-* REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEMQRT overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q C C Q
-*> TRANS = 'T': Q**T C C Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of K
-*> elementary reflectors:
-*>
-*> Q = H(1) H(2) . . . H(K) = I - V T V**T
-*>
-*> generated using the compact WY representation as returned by SGEQRT.
-*>
-*> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size used for the storage of T. K >= NB >= 1.
-*> This must be the same value of NB used to generate T
-*> in CGEQRT.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> CGEQRT in the first K columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,K)
-*> The upper triangular factors of the block reflectors
-*> as returned by CGEQRT, stored as a NB-by-N matrix.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q C, Q**T C, C Q**T or C Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array. The dimension of WORK is
-*> N*NB if SIDE = 'L', or M*NB if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
- $ C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDV, LDC, M, N, NB, LDT
-* ..
-* .. Array Arguments ..
- REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, LDWORK, KF, Q
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SLARFB
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* .. Test the input arguments ..
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- RIGHT = LSAME( SIDE, 'R' )
- TRAN = LSAME( TRANS, 'T' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
- IF( LEFT ) THEN
- LDWORK = MAX( 1, N )
- Q = M
- ELSE IF ( RIGHT ) THEN
- LDWORK = MAX( 1, M )
- Q = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
- INFO = -1
- ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN
- INFO = -5
- ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN
- INFO = -6
- ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
- INFO = -8
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -10
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEMQRT', -INFO )
- RETURN
- END IF
-*
-* .. Quick return if possible ..
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
-*
- IF( LEFT .AND. TRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- CALL SLARFB( 'L', 'T', 'F', 'C', M-I+1, N, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( I, 1 ), LDC, WORK, LDWORK )
- END DO
-*
- ELSE IF( RIGHT .AND. NOTRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- CALL SLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( 1, I ), LDC, WORK, LDWORK )
- END DO
-*
- ELSE IF( LEFT .AND. NOTRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- CALL SLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( I, 1 ), LDC, WORK, LDWORK )
- END DO
-*
- ELSE IF( RIGHT .AND. TRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- CALL SLARFB( 'R', 'T', 'F', 'C', M, N-I+1, IB,
- $ V( I, I ), LDV, T( 1, I ), LDT,
- $ C( 1, I ), LDC, WORK, LDWORK )
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of SGEMQRT
-*
- END
diff --git a/netlib/LAPACK/sgeql2.f b/netlib/LAPACK/sgeql2.f
deleted file mode 100644
index 4d44618..0000000
--- a/netlib/LAPACK/sgeql2.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief \b SGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeql2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeql2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeql2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQL2 computes a QL factorization of a real m by n matrix A:
-*> A = Q * L.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, if m >= n, the lower triangle of the subarray
-*> A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
-*> if m <= n, the elements on and below the (n-m)-th
-*> superdiagonal contain the m by n lower trapezoidal matrix L;
-*> the remaining elements, with the array TAU, represent the
-*> orthogonal matrix Q as a product of elementary reflectors
-*> (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
-*> A(1:m-k+i-1,n-k+i), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- REAL AII
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQL2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = K, 1, -1
-*
-* Generate elementary reflector H(i) to annihilate
-* A(1:m-k+i-1,n-k+i)
-*
- CALL SLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
- $ TAU( I ) )
-*
-* Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left
-*
- AII = A( M-K+I, N-K+I )
- A( M-K+I, N-K+I ) = ONE
- CALL SLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ),
- $ A, LDA, WORK )
- A( M-K+I, N-K+I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of SGEQL2
-*
- END
diff --git a/netlib/LAPACK/sgeqlf.f b/netlib/LAPACK/sgeqlf.f
deleted file mode 100644
index 7d2949a..0000000
--- a/netlib/LAPACK/sgeqlf.f
+++ /dev/null
@@ -1,287 +0,0 @@
-*> \brief \b SGEQLF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQLF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqlf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqlf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqlf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQLF computes a QL factorization of a real M-by-N matrix A:
-*> A = Q * L.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if m >= n, the lower triangle of the subarray
-*> A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
-*> if m <= n, the elements on and below the (n-m)-th
-*> superdiagonal contain the M-by-N lower trapezoidal matrix L;
-*> the remaining elements, with the array TAU, represent the
-*> orthogonal matrix Q as a product of elementary reflectors
-*> (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
-*> A(1:m-k+i-1,n-k+i), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
- $ MU, NB, NBMIN, NU, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQL2, SLARFB, SLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'SGEQLF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQLF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 1
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGEQLF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGEQLF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially.
-* The last kk columns are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
- DO 10 I = K - KK + KI + 1, K - KK + 1, -NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QL factorization of the current block
-* A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1)
-*
- CALL SGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ),
- $ WORK, IINFO )
- IF( N-K+I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
- $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
- CALL SLARFB( 'Left', 'Transpose', 'Backward',
- $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
- $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- MU = M - K + I + NB - 1
- NU = N - K + I + NB - 1
- ELSE
- MU = M
- NU = N
- END IF
-*
-* Use unblocked code to factor the last or only block
-*
- IF( MU.GT.0 .AND. NU.GT.0 )
- $ CALL SGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGEQLF
-*
- END
diff --git a/netlib/LAPACK/sgeqp3.f b/netlib/LAPACK/sgeqp3.f
deleted file mode 100644
index 23f3af2..0000000
--- a/netlib/LAPACK/sgeqp3.f
+++ /dev/null
@@ -1,364 +0,0 @@
-*> \brief \b SGEQP3
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQP3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqp3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqp3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqp3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQP3 computes a QR factorization with column pivoting of a
-*> matrix A: A*P = Q*R using Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the upper triangle of the array contains the
-*> min(M,N)-by-N upper trapezoidal matrix R; the elements below
-*> the diagonal, together with the array TAU, represent the
-*> orthogonal matrix Q as a product of min(M,N) elementary
-*> reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(J).ne.0, the J-th column of A is permuted
-*> to the front of A*P (a leading column); if JPVT(J)=0,
-*> the J-th column of A is a free column.
-*> On exit, if JPVT(J)=K, then the J-th column of A*P was the
-*> the K-th column of A.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO=0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 3*N+1.
-*> For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real/complex vector
-*> with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
-*> A(i+1:m,i), and tau in TAU(i).
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*> X. Sun, Computer Science Dept., Duke University, USA
-*>
-* =====================================================================
- SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER INB, INBMIN, IXOVER
- PARAMETER ( INB = 1, INBMIN = 2, IXOVER = 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
- $ NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SLAQP2, SLAQPS, SORMQR, SSWAP, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SNRM2
- EXTERNAL ILAENV, SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- MINMN = MIN( M, N )
- IF( MINMN.EQ.0 ) THEN
- IWS = 1
- LWKOPT = 1
- ELSE
- IWS = 3*N + 1
- NB = ILAENV( INB, 'SGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = 2*N + ( N + 1 )*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQP3', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( MINMN.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Move initial columns up front.
-*
- NFXD = 1
- DO 10 J = 1, N
- IF( JPVT( J ).NE.0 ) THEN
- IF( J.NE.NFXD ) THEN
- CALL SSWAP( M, A( 1, J ), 1, A( 1, NFXD ), 1 )
- JPVT( J ) = JPVT( NFXD )
- JPVT( NFXD ) = J
- ELSE
- JPVT( J ) = J
- END IF
- NFXD = NFXD + 1
- ELSE
- JPVT( J ) = J
- END IF
- 10 CONTINUE
- NFXD = NFXD - 1
-*
-* Factorize fixed columns
-* =======================
-*
-* Compute the QR factorization of fixed columns and update
-* remaining columns.
-*
- IF( NFXD.GT.0 ) THEN
- NA = MIN( M, NFXD )
-*CC CALL SGEQR2( M, NA, A, LDA, TAU, WORK, INFO )
- CALL SGEQRF( M, NA, A, LDA, TAU, WORK, LWORK, INFO )
- IWS = MAX( IWS, INT( WORK( 1 ) ) )
- IF( NA.LT.N ) THEN
-*CC CALL SORM2R( 'Left', 'Transpose', M, N-NA, NA, A, LDA,
-*CC $ TAU, A( 1, NA+1 ), LDA, WORK, INFO )
- CALL SORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, TAU,
- $ A( 1, NA+1 ), LDA, WORK, LWORK, INFO )
- IWS = MAX( IWS, INT( WORK( 1 ) ) )
- END IF
- END IF
-*
-* Factorize free columns
-* ======================
-*
- IF( NFXD.LT.MINMN ) THEN
-*
- SM = M - NFXD
- SN = N - NFXD
- SMINMN = MINMN - NFXD
-*
-* Determine the block size.
-*
- NB = ILAENV( INB, 'SGEQRF', ' ', SM, SN, -1, -1 )
- NBMIN = 2
- NX = 0
-*
- IF( ( NB.GT.1 ) .AND. ( NB.LT.SMINMN ) ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( IXOVER, 'SGEQRF', ' ', SM, SN, -1,
- $ -1 ) )
-*
-*
- IF( NX.LT.SMINMN ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- MINWS = 2*SN + ( SN+1 )*NB
- IWS = MAX( IWS, MINWS )
- IF( LWORK.LT.MINWS ) THEN
-*
-* Not enough workspace to use optimal NB: Reduce NB and
-* determine the minimum value of NB.
-*
- NB = ( LWORK-2*SN ) / ( SN+1 )
- NBMIN = MAX( 2, ILAENV( INBMIN, 'SGEQRF', ' ', SM, SN,
- $ -1, -1 ) )
-*
-*
- END IF
- END IF
- END IF
-*
-* Initialize partial column norms. The first N elements of work
-* store the exact column norms.
-*
- DO 20 J = NFXD + 1, N
- WORK( J ) = SNRM2( SM, A( NFXD+1, J ), 1 )
- WORK( N+J ) = WORK( J )
- 20 CONTINUE
-*
- IF( ( NB.GE.NBMIN ) .AND. ( NB.LT.SMINMN ) .AND.
- $ ( NX.LT.SMINMN ) ) THEN
-*
-* Use blocked code initially.
-*
- J = NFXD + 1
-*
-* Compute factorization: while loop.
-*
-*
- TOPBMN = MINMN - NX
- 30 CONTINUE
- IF( J.LE.TOPBMN ) THEN
- JB = MIN( NB, TOPBMN-J+1 )
-*
-* Factorize JB columns among columns J:N.
-*
- CALL SLAQPS( M, N-J+1, J-1, JB, FJB, A( 1, J ), LDA,
- $ JPVT( J ), TAU( J ), WORK( J ), WORK( N+J ),
- $ WORK( 2*N+1 ), WORK( 2*N+JB+1 ), N-J+1 )
-*
- J = J + FJB
- GO TO 30
- END IF
- ELSE
- J = NFXD + 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
-*
- IF( J.LE.MINMN )
- $ CALL SLAQP2( M, N-J+1, J-1, A( 1, J ), LDA, JPVT( J ),
- $ TAU( J ), WORK( J ), WORK( N+J ),
- $ WORK( 2*N+1 ) )
-*
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGEQP3
-*
- END
diff --git a/netlib/LAPACK/sgeqpf.f b/netlib/LAPACK/sgeqpf.f
deleted file mode 100644
index 02950e0..0000000
--- a/netlib/LAPACK/sgeqpf.f
+++ /dev/null
@@ -1,306 +0,0 @@
-*> \brief \b SGEQPF
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqpf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqpf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine SGEQP3.
-*>
-*> SGEQPF computes a QR factorization with column pivoting of a
-*> real M-by-N matrix A: A*P = Q*R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the upper triangle of the array contains the
-*> min(M,N)-by-N upper triangular matrix R; the elements
-*> below the diagonal, together with the array TAU,
-*> represent the orthogonal matrix Q as a product of
-*> min(m,n) elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*> to the front of A*P (a leading column); if JPVT(i) = 0,
-*> the i-th column of A is a free column.
-*> On exit, if JPVT(i) = k, then the i-th column of A*P
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(n)
-*>
-*> Each H(i) has the form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
-*>
-*> The matrix P is represented in jpvt as follows: If
-*> jpvt(j) = i
-*> then the jth column of P is the ith canonical unit vector.
-*>
-*> Partial column norm updating strategy modified by
-*> Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*> University of Zagreb, Croatia.
-*> -- April 2011 --
-*> For more details see LAPACK Working Note 176.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ITEMP, J, MA, MN, PVT
- REAL AII, TEMP, TEMP2, TOL3Z
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQR2, SLARF, SLARFG, SORM2R, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH, SNRM2
- EXTERNAL ISAMAX, SLAMCH, SNRM2
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQPF', -INFO )
- RETURN
- END IF
-*
- MN = MIN( M, N )
- TOL3Z = SQRT(SLAMCH('Epsilon'))
-*
-* Move initial columns up front
-*
- ITEMP = 1
- DO 10 I = 1, N
- IF( JPVT( I ).NE.0 ) THEN
- IF( I.NE.ITEMP ) THEN
- CALL SSWAP( M, A( 1, I ), 1, A( 1, ITEMP ), 1 )
- JPVT( I ) = JPVT( ITEMP )
- JPVT( ITEMP ) = I
- ELSE
- JPVT( I ) = I
- END IF
- ITEMP = ITEMP + 1
- ELSE
- JPVT( I ) = I
- END IF
- 10 CONTINUE
- ITEMP = ITEMP - 1
-*
-* Compute the QR factorization and update remaining columns
-*
- IF( ITEMP.GT.0 ) THEN
- 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 )
- END IF
- END IF
-*
- IF( ITEMP.LT.MN ) THEN
-*
-* Initialize partial column norms. The first n elements of
-* work store the exact column norms.
-*
- DO 20 I = ITEMP + 1, N
- WORK( I ) = SNRM2( M-ITEMP, A( ITEMP+1, I ), 1 )
- WORK( N+I ) = WORK( I )
- 20 CONTINUE
-*
-* Compute factorization
-*
- DO 40 I = ITEMP + 1, MN
-*
-* Determine ith pivot column and swap if necessary
-*
- PVT = ( I-1 ) + ISAMAX( N-I+1, WORK( I ), 1 )
-*
- IF( PVT.NE.I ) THEN
- CALL SSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
- ITEMP = JPVT( PVT )
- JPVT( PVT ) = JPVT( I )
- JPVT( I ) = ITEMP
- WORK( PVT ) = WORK( I )
- WORK( N+PVT ) = WORK( N+I )
- END IF
-*
-* 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 ) )
- ELSE
- CALL SLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) )
- END IF
-*
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL SLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK( 2*N+1 ) )
- A( I, I ) = AII
- END IF
-*
-* Update partial column norms
-*
- DO 30 J = I + 1, N
- IF( WORK( J ).NE.ZERO ) THEN
-*
-* NOTE: The following 4 lines follow from the analysis in
-* Lapack Working Note 176.
-*
- TEMP = ABS( A( I, J ) ) / WORK( J )
- TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
- TEMP2 = TEMP*( WORK( J ) / WORK( N+J ) )**2
- IF( TEMP2 .LE. TOL3Z ) THEN
- IF( M-I.GT.0 ) THEN
- WORK( J ) = SNRM2( M-I, A( I+1, J ), 1 )
- WORK( N+J ) = WORK( J )
- ELSE
- WORK( J ) = ZERO
- WORK( N+J ) = ZERO
- END IF
- ELSE
- WORK( J ) = WORK( J )*SQRT( TEMP )
- END IF
- END IF
- 30 CONTINUE
-*
- 40 CONTINUE
- END IF
- RETURN
-*
-* End of SGEQPF
-*
- END
diff --git a/netlib/LAPACK/sgeqr2.f b/netlib/LAPACK/sgeqr2.f
deleted file mode 100644
index 1f027f6..0000000
--- a/netlib/LAPACK/sgeqr2.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQR2 computes a QR factorization of a real m by n matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(m,n) by n upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- REAL AII
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQR2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAU( I ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of SGEQR2
-*
- END
diff --git a/netlib/LAPACK/sgeqr2p.f b/netlib/LAPACK/sgeqr2p.f
deleted file mode 100644
index 021d64e..0000000
--- a/netlib/LAPACK/sgeqr2p.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b SGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQR2P + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqr2p.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqr2p.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqr2p.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQR2P computes a QR factorization of a real m by n matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(m,n) by n upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- REAL AII
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFGP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQR2P', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL SLARFGP( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAU( I ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of SGEQR2P
-*
- END
diff --git a/netlib/LAPACK/sgeqrf.f b/netlib/LAPACK/sgeqrf.f
deleted file mode 100644
index 8474bf4..0000000
--- a/netlib/LAPACK/sgeqrf.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b SGEQRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQRF computes a QR factorization of a real M-by-N matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of min(m,n) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQR2, SLARFB, SLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGEQRF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block
-* A(i:m,i:i+ib-1)
-*
- CALL SGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i:m,i+ib:n) from the left
-*
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL SGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGEQRF
-*
- END
diff --git a/netlib/LAPACK/sgeqrfp.f b/netlib/LAPACK/sgeqrfp.f
deleted file mode 100644
index 9e676c0..0000000
--- a/netlib/LAPACK/sgeqrfp.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b SGEQRFP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQRFP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqrfp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqrfp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqrfp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQRFP computes a QR factorization of a real M-by-N matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of min(m,n) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQR2P, SLARFB, SLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQRFP', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGEQRF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block
-* A(i:m,i:i+ib-1)
-*
- CALL SGEQR2P( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i:m,i+ib:n) from the left
-*
- CALL SLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL SGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGEQRFP
-*
- END
diff --git a/netlib/LAPACK/sgeqrt.f b/netlib/LAPACK/sgeqrt.f
deleted file mode 100644
index 0efc07b..0000000
--- a/netlib/LAPACK/sgeqrt.f
+++ /dev/null
@@ -1,218 +0,0 @@
-*> \brief \b SGEQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDT, M, N, NB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQRT computes a blocked QR factorization of a real M-by-N matrix A
-*> using the compact WY representation of Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size to be used in the blocked QR. MIN(M,N) >= NB >= 1.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if M >= N); the elements below the diagonal
-*> are the columns of V.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,MIN(M,N))
-*> The upper triangular block reflectors stored in compact form
-*> as a sequence of upper triangular blocks. See below
-*> for further details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (NB*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
-*>
-*> V = ( 1 )
-*> ( v1 1 )
-*> ( v1 v2 1 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> where the vi's represent the vectors which define H(i), which are returned
-*> in the matrix A. The 1's along the diagonal of V are not stored in A.
-*>
-*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
-*>
-*> T = (T1 T2 ... TB).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDT, M, N, NB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- INTEGER I, IB, IINFO, K
- LOGICAL USE_RECURSIVE_QR
- PARAMETER( USE_RECURSIVE_QR=.TRUE. )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRT2, SGEQRT3, SLARFB, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NB.LT.1 .OR. NB.GT.MIN(M,N) ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) RETURN
-*
-* Blocked loop of length K
-*
- DO I = 1, K, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block A(I:M,I:I+IB-1)
-*
- IF( USE_RECURSIVE_QR ) THEN
- CALL SGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO )
- ELSE
- CALL SGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO )
- END IF
- IF( I+IB.LE.N ) THEN
-*
-* Update by applying H**T to A(I:M,I+IB:N) from the left
-*
- CALL SLARFB( 'L', 'T', 'F', 'C', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, T( 1, I ), LDT,
- $ A( I, I+IB ), LDA, WORK , N-I-IB+1 )
- END IF
- END DO
- RETURN
-*
-* End of SGEQRT
-*
- END
diff --git a/netlib/LAPACK/sgeqrt2.f b/netlib/LAPACK/sgeqrt2.f
deleted file mode 100644
index 08e9cf1..0000000
--- a/netlib/LAPACK/sgeqrt2.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b SGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQRT2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqrt2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqrt2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqrt2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEQRT2( M, N, A, LDA, T, LDT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDT, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), T( LDT, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQRT2 computes a QR factorization of a real M-by-N matrix A,
-*> using the compact WY representation of Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= N.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the real M-by-N matrix A. On exit, the elements on and
-*> above the diagonal contain the N-by-N upper triangular matrix R; the
-*> elements below the diagonal are the columns of V. See below for
-*> further details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> The N-by-N upper triangular factor of the block reflector.
-*> The elements on and above the diagonal contain the block
-*> reflector T; the elements below the diagonal are not used.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
-*>
-*> V = ( 1 )
-*> ( v1 1 )
-*> ( v1 v2 1 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> where the vi's represent the vectors which define H(i), which are returned
-*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
-*> block reflector H is then given by
-*>
-*> H = I - V * T * V**T
-*>
-*> where V**T is the transpose of V.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEQRT2( M, N, A, LDA, T, LDT, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDT, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), T( LDT, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER( ONE = 1.0, ZERO = 0.0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- REAL AII, ALPHA
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFG, SGEMV, SGER, STRMV, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQRT2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO I = 1, K
-*
-* Generate elem. refl. H(i) to annihilate A(i+1:m,i), tau(I) -> T(I,1)
-*
- CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ T( I, 1 ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(I:M,I+1:N) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
-*
-* W(1:N-I) := A(I:M,I+1:N)^H * A(I:M,I) [W = T(:,N)]
-*
- CALL SGEMV( 'T',M-I+1, N-I, ONE, A( I, I+1 ), LDA,
- $ A( I, I ), 1, ZERO, T( 1, N ), 1 )
-*
-* A(I:M,I+1:N) = A(I:m,I+1:N) + alpha*A(I:M,I)*W(1:N-1)^H
-*
- ALPHA = -(T( I, 1 ))
- CALL SGER( M-I+1, N-I, ALPHA, A( I, I ), 1,
- $ T( 1, N ), 1, A( I, I+1 ), LDA )
- A( I, I ) = AII
- END IF
- END DO
-*
- DO I = 2, N
- AII = A( I, I )
- A( I, I ) = ONE
-*
-* T(1:I-1,I) := alpha * A(I:M,1:I-1)**T * A(I:M,I)
-*
- ALPHA = -T( I, 1 )
- CALL SGEMV( 'T', M-I+1, I-1, ALPHA, A( I, 1 ), LDA,
- $ A( I, I ), 1, ZERO, T( 1, I ), 1 )
- A( I, I ) = AII
-*
-* T(1:I-1,I) := T(1:I-1,1:I-1) * T(1:I-1,I)
-*
- CALL STRMV( 'U', 'N', 'N', I-1, T, LDT, T( 1, I ), 1 )
-*
-* T(I,I) = tau(I)
-*
- T( I, I ) = T( I, 1 )
- T( I, 1) = ZERO
- END DO
-
-*
-* End of SGEQRT2
-*
- END
diff --git a/netlib/LAPACK/sgeqrt3.f b/netlib/LAPACK/sgeqrt3.f
deleted file mode 100644
index 86a43f6..0000000
--- a/netlib/LAPACK/sgeqrt3.f
+++ /dev/null
@@ -1,257 +0,0 @@
-*> \brief \b SGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGEQRT3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqrt3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqrt3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqrt3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* RECURSIVE SUBROUTINE SGEQRT3( M, N, A, LDA, T, LDT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LDT
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), T( LDT, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGEQRT3 recursively computes a QR factorization of a real M-by-N
-*> matrix A, using the compact WY representation of Q.
-*>
-*> Based on the algorithm of Elmroth and Gustavson,
-*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= N.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the real M-by-N matrix A. On exit, the elements on and
-*> above the diagonal contain the N-by-N upper triangular matrix R; the
-*> elements below the diagonal are the columns of V. See below for
-*> further details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> The N-by-N upper triangular factor of the block reflector.
-*> The elements on and above the diagonal contain the block
-*> reflector T; the elements below the diagonal are not used.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
-*>
-*> V = ( 1 )
-*> ( v1 1 )
-*> ( v1 v2 1 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> where the vi's represent the vectors which define H(i), which are returned
-*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
-*> block reflector H is then given by
-*>
-*> H = I - V * T * V**T
-*>
-*> where V**T is the transpose of V.
-*>
-*> For details of the algorithm, see Elmroth and Gustavson (cited above).
-*> \endverbatim
-*>
-* =====================================================================
- RECURSIVE SUBROUTINE SGEQRT3( M, N, A, LDA, T, LDT, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N, LDT
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), T( LDT, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, J, J1, N1, N2, IINFO
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFG, STRMM, SGEMM, XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N .LT. 0 ) THEN
- INFO = -2
- ELSE IF( M .LT. N ) THEN
- INFO = -1
- ELSE IF( LDA .LT. MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LDT .LT. MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGEQRT3', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
-*
-* Compute Householder transform when N=1
-*
- CALL SLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T )
-*
- ELSE
-*
-* Otherwise, split A into blocks...
-*
- N1 = N/2
- N2 = N-N1
- J1 = MIN( N1+1, N )
- I1 = MIN( N+1, M )
-*
-* Compute A(1:M,1:N1) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
-*
- CALL SGEQRT3( M, N1, A, LDA, T, LDT, IINFO )
-*
-* Compute A(1:M,J1:N) = Q1^H A(1:M,J1:N) [workspace: T(1:N1,J1:N)]
-*
- DO J=1,N2
- DO I=1,N1
- T( I, J+N1 ) = A( I, J+N1 )
- END DO
- END DO
- CALL STRMM( 'L', 'L', 'T', 'U', N1, N2, ONE,
- & A, LDA, T( 1, J1 ), LDT )
-*
- CALL SGEMM( 'T', 'N', N1, N2, M-N1, ONE, A( J1, 1 ), LDA,
- & A( J1, J1 ), LDA, ONE, T( 1, J1 ), LDT)
-*
- CALL STRMM( 'L', 'U', 'T', 'N', N1, N2, ONE,
- & T, LDT, T( 1, J1 ), LDT )
-*
- CALL SGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( J1, 1 ), LDA,
- & T( 1, J1 ), LDT, ONE, A( J1, J1 ), LDA )
-*
- CALL STRMM( 'L', 'L', 'N', 'U', N1, N2, ONE,
- & A, LDA, T( 1, J1 ), LDT )
-*
- DO J=1,N2
- DO I=1,N1
- A( I, J+N1 ) = A( I, J+N1 ) - T( I, J+N1 )
- END DO
- END DO
-*
-* Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
-*
- CALL SGEQRT3( M-N1, N2, A( J1, J1 ), LDA,
- & T( J1, J1 ), LDT, IINFO )
-*
-* Compute T3 = T(1:N1,J1:N) = -T1 Y1^H Y2 T2
-*
- DO I=1,N1
- DO J=1,N2
- T( I, J+N1 ) = (A( J+N1, I ))
- END DO
- END DO
-*
- CALL STRMM( 'R', 'L', 'N', 'U', N1, N2, ONE,
- & A( J1, J1 ), LDA, T( 1, J1 ), LDT )
-*
- CALL SGEMM( 'T', 'N', N1, N2, M-N, ONE, A( I1, 1 ), LDA,
- & A( I1, J1 ), LDA, ONE, T( 1, J1 ), LDT )
-*
- CALL STRMM( 'L', 'U', 'N', 'N', N1, N2, -ONE, T, LDT,
- & T( 1, J1 ), LDT )
-*
- CALL STRMM( 'R', 'U', 'N', 'N', N1, N2, ONE,
- & T( J1, J1 ), LDT, T( 1, J1 ), LDT )
-*
-* Y = (Y1,Y2); R = [ R1 A(1:N1,J1:N) ]; T = [T1 T3]
-* [ 0 R2 ] [ 0 T2]
-*
- END IF
-*
- RETURN
-*
-* End of SGEQRT3
-*
- END
diff --git a/netlib/LAPACK/sgerfs.f b/netlib/LAPACK/sgerfs.f
deleted file mode 100644
index c7ec925..0000000
--- a/netlib/LAPACK/sgerfs.f
+++ /dev/null
@@ -1,438 +0,0 @@
-*> \brief \b SGERFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGERFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgerfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgerfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgerfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
-* X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGERFS improves the computed solution to a system of linear
-*> equations and provides error bounds and backward error estimates for
-*> the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The original N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by SGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from SGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SGETRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
- $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANST
- INTEGER COUNT, I, J, K, KASE, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SGETRS, SLACN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGERFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(op(A))*abs(X) + abs(B).
-*
- IF( NOTRAN ) THEN
- DO 50 K = 1, N
- XK = ABS( X( K, J ) )
- DO 40 I = 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- DO 60 I = 1, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL SGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK( N+1 ),
- $ N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL SGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SGERFS
-*
- END
diff --git a/netlib/LAPACK/sgerq2.f b/netlib/LAPACK/sgerq2.f
deleted file mode 100644
index 6bbfbb8..0000000
--- a/netlib/LAPACK/sgerq2.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief \b SGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGERQ2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgerq2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgerq2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgerq2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGERQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGERQ2 computes an RQ factorization of a real m by n matrix A:
-*> A = R * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, if m <= n, the upper triangle of the subarray
-*> A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
-*> if m >= n, the elements on and above the (m-n)-th subdiagonal
-*> contain the m by n upper trapezoidal matrix R; the remaining
-*> elements, with the array TAU, represent the orthogonal matrix
-*> Q as a product of elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*> A(m-k+i,1:n-k+i-1), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGERQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- REAL AII
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGERQ2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = K, 1, -1
-*
-* Generate elementary reflector H(i) to annihilate
-* A(m-k+i,1:n-k+i-1)
-*
- CALL SLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
- $ TAU( I ) )
-*
-* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
-*
- AII = A( M-K+I, N-K+I )
- A( M-K+I, N-K+I ) = ONE
- CALL SLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
- $ TAU( I ), A, LDA, WORK )
- A( M-K+I, N-K+I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of SGERQ2
-*
- END
diff --git a/netlib/LAPACK/sgerqf.f b/netlib/LAPACK/sgerqf.f
deleted file mode 100644
index 5714730..0000000
--- a/netlib/LAPACK/sgerqf.f
+++ /dev/null
@@ -1,290 +0,0 @@
-*> \brief \b SGERQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGERQF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgerqf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgerqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgerqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGERQF computes an RQ factorization of a real M-by-N matrix A:
-*> A = R * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if m <= n, the upper triangle of the subarray
-*> A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
-*> if m >= n, the elements on and above the (m-n)-th subdiagonal
-*> contain the M-by-N upper trapezoidal matrix R;
-*> the remaining elements, with the array TAU, represent the
-*> orthogonal matrix Q as a product of min(m,n) elementary
-*> reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*> A(m-k+i,1:n-k+i-1), and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
- $ MU, NB, NBMIN, NU, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGERQ2, SLARFB, SLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- WORK( 1 ) = LWKOPT
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGERQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 1
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGERQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGERQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially.
-* The last kk rows are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
- DO 10 I = K - KK + KI + 1, K - KK + 1, -NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the RQ factorization of the current block
-* A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1)
-*
- CALL SGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ),
- $ WORK, IINFO )
- IF( M-K+I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
- $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
-*
- CALL SLARFB( 'Right', 'No transpose', 'Backward',
- $ 'Rowwise', M-K+I-1, N-K+I+IB-1, IB,
- $ A( M-K+I, 1 ), LDA, WORK, LDWORK, A, LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- MU = M - K + I + NB - 1
- NU = N - K + I + NB - 1
- ELSE
- MU = M
- NU = N
- END IF
-*
-* Use unblocked code to factor the last or only block
-*
- IF( MU.GT.0 .AND. NU.GT.0 )
- $ CALL SGERQ2( MU, NU, A, LDA, TAU, WORK, IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGERQF
-*
- END
diff --git a/netlib/LAPACK/sgesc2.f b/netlib/LAPACK/sgesc2.f
deleted file mode 100644
index bba4c63..0000000
--- a/netlib/LAPACK/sgesc2.f
+++ /dev/null
@@ -1,201 +0,0 @@
-*> \brief \b SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESC2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesc2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesc2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesc2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, N
-* REAL SCALE
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), JPIV( * )
-* REAL A( LDA, * ), RHS( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGESC2 solves a system of linear equations
-*>
-*> A * X = scale* RHS
-*>
-*> with a general N-by-N matrix A using the LU factorization with
-*> complete pivoting computed by SGETC2.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the LU part of the factorization of the n-by-n
-*> matrix A computed by SGETC2: A = P * L * U * Q
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] RHS
-*> \verbatim
-*> RHS is REAL array, dimension (N).
-*> On entry, the right hand side vector b.
-*> On exit, the solution vector X.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= i <= N, row i of the
-*> matrix has been interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] JPIV
-*> \verbatim
-*> JPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= j <= N, column j of the
-*> matrix has been interchanged with column JPIV(j).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> On exit, SCALE contains the scale factor. SCALE is chosen
-*> 0 <= SCALE <= 1 to prevent owerflow in the solution.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
- SUBROUTINE SGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, N
- REAL SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- REAL A( LDA, * ), RHS( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, TWO
- PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL BIGNUM, EPS, SMLNUM, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SLABAD, SLASWP, SSCAL
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL ISAMAX, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Set constant to control owerflow
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Apply permutations IPIV to RHS
-*
- CALL SLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
-*
-* Solve for L part
-*
- DO 20 I = 1, N - 1
- DO 10 J = I + 1, N
- RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
- 10 CONTINUE
- 20 CONTINUE
-*
-* Solve for U part
-*
- SCALE = ONE
-*
-* Check for scaling
-*
- I = ISAMAX( N, RHS, 1 )
- IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
- TEMP = ( ONE / TWO ) / ABS( RHS( I ) )
- CALL SSCAL( N, TEMP, RHS( 1 ), 1 )
- SCALE = SCALE*TEMP
- END IF
-*
- DO 40 I = N, 1, -1
- TEMP = ONE / A( I, I )
- RHS( I ) = RHS( I )*TEMP
- DO 30 J = I + 1, N
- RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Apply permutations JPIV to the solution (RHS)
-*
- CALL SLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
- RETURN
-*
-* End of SGESC2
-*
- END
diff --git a/netlib/LAPACK/sgesdd.f b/netlib/LAPACK/sgesdd.f
deleted file mode 100644
index 821767a..0000000
--- a/netlib/LAPACK/sgesdd.f
+++ /dev/null
@@ -1,1431 +0,0 @@
-*> \brief \b SGESDD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESDD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesdd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesdd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesdd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
-* LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ
-* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), S( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGESDD computes the singular value decomposition (SVD) of a real
-*> M-by-N matrix A, optionally computing the left and right singular
-*> vectors. If singular vectors are desired, it uses a
-*> divide-and-conquer algorithm.
-*>
-*> The SVD is written
-*>
-*> A = U * SIGMA * transpose(V)
-*>
-*> where SIGMA is an M-by-N matrix which is zero except for its
-*> min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
-*> V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
-*> are the singular values of A; they are real and non-negative, and
-*> are returned in descending order. The first min(m,n) columns of
-*> U and V are the left and right singular vectors of A.
-*>
-*> Note that the routine returns VT = V**T, not V.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> Specifies options for computing all or part of the matrix U:
-*> = 'A': all M columns of U and all N rows of V**T are
-*> returned in the arrays U and VT;
-*> = 'S': the first min(M,N) columns of U and the first
-*> min(M,N) rows of V**T are returned in the arrays U
-*> and VT;
-*> = 'O': If M >= N, the first N columns of U are overwritten
-*> on the array A and all rows of V**T are returned in
-*> the array VT;
-*> otherwise, all columns of U are returned in the
-*> array U and the first M rows of V**T are overwritten
-*> in the array A;
-*> = 'N': no columns of U or rows of V**T are computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if JOBZ = 'O', A is overwritten with the first N columns
-*> of U (the left singular vectors, stored
-*> columnwise) if M >= N;
-*> A is overwritten with the first M rows
-*> of V**T (the right singular vectors, stored
-*> rowwise) otherwise.
-*> if JOBZ .ne. 'O', the contents of A are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (min(M,N))
-*> The singular values of A, sorted so that S(i) >= S(i+1).
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,UCOL)
-*> UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
-*> UCOL = min(M,N) if JOBZ = 'S'.
-*> If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
-*> orthogonal matrix U;
-*> if JOBZ = 'S', U contains the first min(M,N) columns of U
-*> (the left singular vectors, stored columnwise);
-*> if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1; if
-*> JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT,N)
-*> If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
-*> N-by-N orthogonal matrix V**T;
-*> if JOBZ = 'S', VT contains the first min(M,N) rows of
-*> V**T (the right singular vectors, stored rowwise);
-*> if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1; if
-*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
-*> if JOBZ = 'S', LDVT >= min(M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 1.
-*> If JOBZ = 'N',
-*> LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)).
-*> If JOBZ = 'O',
-*> LWORK >= 3*min(M,N) +
-*> max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
-*> If JOBZ = 'S' or 'A'
-*> LWORK >= 3*min(M,N) +
-*> max(max(M,N),4*min(M,N)*min(M,N)+3*min(M,N)+max(M,N)).
-*> For good performance, LWORK should generally be larger.
-*> If LWORK = -1 but other input arguments are legal, WORK(1)
-*> returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (8*min(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: SBDSDC did not converge, updating process failed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEsing
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
- $ LWORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ
- INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), S( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IL,
- $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT,
- $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK,
- $ MNTHR, NWORK, WRKBL
- REAL ANRM, BIGNUM, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER IDUM( 1 )
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SBDSDC, SGEBRD, SGELQF, SGEMM, SGEQRF, SLACPY,
- $ SLASCL, SLASET, SORGBR, SORGLQ, SORGQR, SORMBR,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- WNTQA = LSAME( JOBZ, 'A' )
- WNTQS = LSAME( JOBZ, 'S' )
- WNTQAS = WNTQA .OR. WNTQS
- WNTQO = LSAME( JOBZ, 'O' )
- WNTQN = LSAME( JOBZ, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDU.LT.1 .OR. ( WNTQAS .AND. LDU.LT.M ) .OR.
- $ ( WNTQO .AND. M.LT.N .AND. LDU.LT.M ) ) THEN
- INFO = -8
- ELSE IF( LDVT.LT.1 .OR. ( WNTQA .AND. LDVT.LT.N ) .OR.
- $ ( WNTQS .AND. LDVT.LT.MINMN ) .OR.
- $ ( WNTQO .AND. M.GE.N .AND. LDVT.LT.N ) ) THEN
- INFO = -10
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-* Compute space needed for SBDSDC
-*
- MNTHR = INT( MINMN*11.0E0 / 6.0E0 )
- IF( WNTQN ) THEN
- BDSPAC = 7*N
- ELSE
- BDSPAC = 3*N*N + 4*N
- END IF
- IF( M.GE.MNTHR ) THEN
- IF( WNTQN ) THEN
-*
-* Path 1 (M much larger than N, JOBZ='N')
-*
- WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+N )
- MINWRK = BDSPAC + N
- ELSE IF( WNTQO ) THEN
-*
-* Path 2 (M much larger than N, JOBZ='O')
-*
- WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'SORGQR', ' ', M,
- $ N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + 2*N*N
- MINWRK = BDSPAC + 2*N*N + 3*N
- ELSE IF( WNTQS ) THEN
-*
-* Path 3 (M much larger than N, JOBZ='S')
-*
- WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'SORGQR', ' ', M,
- $ N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 3*N
- ELSE IF( WNTQA ) THEN
-*
-* Path 4 (M much larger than N, JOBZ='A')
-*
- WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'SORGQR', ' ', M,
- $ M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 2*N + M
- END IF
- ELSE
-*
-* Path 5 (M at least N, but not much larger)
-*
- WRKBL = 3*N + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1,
- $ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- ELSE IF( WNTQO ) THEN
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + M*N
- MINWRK = 3*N + MAX( M, N*N+BDSPAC )
- ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*N+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( MAXWRK, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- END IF
- END IF
- ELSE IF ( MINMN.GT.0 ) THEN
-*
-* Compute space needed for SBDSDC
-*
- MNTHR = INT( MINMN*11.0E0 / 6.0E0 )
- IF( WNTQN ) THEN
- BDSPAC = 7*M
- ELSE
- BDSPAC = 3*M*M + 4*M
- END IF
- IF( N.GE.MNTHR ) THEN
- IF( WNTQN ) THEN
-*
-* Path 1t (N much larger than M, JOBZ='N')
-*
- WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+M )
- MINWRK = BDSPAC + M
- ELSE IF( WNTQO ) THEN
-*
-* Path 2t (N much larger than M, JOBZ='O')
-*
- WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'SORGLQ', ' ', M,
- $ N, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + 2*M*M
- MINWRK = BDSPAC + 2*M*M + 3*M
- ELSE IF( WNTQS ) THEN
-*
-* Path 3t (N much larger than M, JOBZ='S')
-*
- WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'SORGLQ', ' ', M,
- $ N, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
- ELSE IF( WNTQA ) THEN
-*
-* Path 4t (N much larger than M, JOBZ='A')
-*
- WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
- WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'SORGLQ', ' ', N,
- $ N, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
- END IF
- ELSE
-*
-* Path 5t (N greater than M, but not much larger)
-*
- WRKBL = 3*M + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1,
- $ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- ELSE IF( WNTQO ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
- MAXWRK = WRKBL + M*N
- MINWRK = 3*M + MAX( N, M*M+BDSPAC )
- ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- END IF
- END IF
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGESDD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SQRT( SLAMCH( 'S' ) ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, DUM )
- ISCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ISCL = 1
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ISCL = 1
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* A has at least as many rows as columns. If A has sufficiently
-* more rows than columns, first reduce using the QR
-* decomposition (if sufficient workspace available)
-*
- IF( M.GE.MNTHR ) THEN
-*
- IF( WNTQN ) THEN
-*
-* Path 1 (M much larger than N, JOBZ='N')
-* No singular vectors to be computed
-*
- ITAU = 1
- NWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Zero out below R
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- NWORK = IE + N
-*
-* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need N+BDSPAC)
-*
- CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
-*
- ELSE IF( WNTQO ) THEN
-*
-* Path 2 (M much larger than N, JOBZ = 'O')
-* N left singular vectors to be overwritten on A and
-* N right singular vectors to be computed in VT
-*
- IR = 1
-*
-* WORK(IR) is LDWRKR by N
-*
- IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN
- LDWRKR = LDA
- ELSE
- LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N
- END IF
- ITAU = IR + LDWRKR*N
- NWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in VT, copying result to WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* WORK(IU) is N by N
-*
- IU = NWORK
- NWORK = IU + N*N
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in WORK(IU) and computing right
-* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
- $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite WORK(IU) by left singular vectors of R
-* and VT by right singular vectors of R
-* (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in WORK(IR) and copying to A
-* (Workspace: need 2*N*N, prefer N*N+M*N)
-*
- DO 10 I = 1, M, LDWRKR
- CHUNK = MIN( M-I+1, LDWRKR )
- CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IU ), N, ZERO, WORK( IR ),
- $ LDWRKR )
- CALL SLACPY( 'F', CHUNK, N, WORK( IR ), LDWRKR,
- $ A( I, 1 ), LDA )
- 10 CONTINUE
-*
- ELSE IF( WNTQS ) THEN
-*
-* Path 3 (M much larger than N, JOBZ='S')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IR = 1
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- ITAU = IR + LDWRKR*N
- NWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagoal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of R and VT
-* by right singular vectors of R
-* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
- CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in U
-* (Workspace: need N*N)
-*
- CALL SLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR )
- CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA, WORK( IR ),
- $ LDWRKR, ZERO, U, LDU )
-*
- ELSE IF( WNTQA ) THEN
-*
-* Path 4 (M much larger than N, JOBZ='A')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IU = 1
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- ITAU = IU + LDWRKU*N
- NWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Produce R in A, zeroing out other entries
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in WORK(IU) and computing right
-* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
- $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite WORK(IU) by left singular vectors of R and VT
-* by right singular vectors of R
-* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', N, N, N, A, LDA,
- $ WORK( ITAUQ ), WORK( IU ), LDWRKU,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ),
- $ LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL SLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- END IF
-*
- ELSE
-*
-* M .LT. MNTHR
-*
-* Path 5 (M at least N, but not much larger)
-* Reduce to bidiagonal form without QR decomposition
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- NWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- IF( WNTQN ) THEN
-*
-* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need N+BDSPAC)
-*
- CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
- ELSE IF( WNTQO ) THEN
- IU = NWORK
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
-*
-* WORK( IU ) is M by N
-*
- LDWRKU = M
- NWORK = IU + LDWRKU*N
- CALL SLASET( 'F', M, N, ZERO, ZERO, WORK( IU ),
- $ LDWRKU )
- ELSE
-*
-* WORK( IU ) is N by N
-*
- LDWRKU = N
- NWORK = IU + LDWRKU*N
-*
-* WORK(IR) is LDWRKR by N
-*
- IR = NWORK
- LDWRKR = ( LWORK-N*N-3*N ) / N
- END IF
- NWORK = IU + LDWRKU*N
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in WORK(IU) and computing right
-* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ),
- $ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ),
- $ IWORK, INFO )
-*
-* Overwrite VT by right singular vectors of A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
-*
-* Overwrite WORK(IU) by left singular vectors of A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), WORK( IU ), LDWRKU,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Copy left singular vectors of A from WORK(IU) to A
-*
- CALL SLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA )
- ELSE
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by left singular vectors of
-* bidiagonal matrix in WORK(IU), storing result in
-* WORK(IR) and copying to A
-* (Workspace: need 2*N*N, prefer N*N+M*N)
-*
- DO 20 I = 1, M, LDWRKR
- CHUNK = MIN( M-I+1, LDWRKR )
- CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IU ), LDWRKU, ZERO,
- $ WORK( IR ), LDWRKR )
- CALL SLACPY( 'F', CHUNK, N, WORK( IR ), LDWRKR,
- $ A( I, 1 ), LDA )
- 20 CONTINUE
- END IF
-*
- ELSE IF( WNTQS ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
-*
- CALL SLASET( 'F', M, N, ZERO, ZERO, U, LDU )
- CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
-*
- CALL SLASET( 'F', M, M, ZERO, ZERO, U, LDU )
- CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Set the right corner of U to identity matrix
-*
- IF( M.GT.N ) THEN
- CALL SLASET( 'F', M-N, M-N, ZERO, ONE, U( N+1, N+1 ),
- $ LDU )
- END IF
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', N, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- END IF
-*
- END IF
-*
- ELSE
-*
-* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition (if
-* sufficient workspace available)
-*
- IF( N.GE.MNTHR ) THEN
-*
- IF( WNTQN ) THEN
-*
-* Path 1t (N much larger than M, JOBZ='N')
-* No singular vectors to be computed
-*
- ITAU = 1
- NWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Zero out above L
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- NWORK = IE + M
-*
-* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need M+BDSPAC)
-*
- CALL SBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
-*
- ELSE IF( WNTQO ) THEN
-*
-* Path 2t (N much larger than M, JOBZ='O')
-* M right singular vectors to be overwritten on A and
-* M left singular vectors to be computed in U
-*
- IVT = 1
-*
-* IVT is M by M
-*
- IL = IVT + M*M
- IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN
-*
-* WORK(IL) is M by N
-*
- LDWRKL = M
- CHUNK = N
- ELSE
- LDWRKL = M
- CHUNK = ( LWORK-M*M ) / M
- END IF
- ITAU = IL + LDWRKL*M
- NWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy L to WORK(IL), zeroing about above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IL+LDWRKL ), LDWRKL )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IL)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U, and computing right singular
-* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
- $ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ),
- $ IWORK, INFO )
-*
-* Overwrite U by left singular vectors of L and WORK(IVT)
-* by right singular vectors of L
-* (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUP ), WORK( IVT ), M,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply right singular vectors of L in WORK(IVT) by Q
-* in A, storing result in WORK(IL) and copying to A
-* (Workspace: need 2*M*M, prefer M*M+M*N)
-*
- DO 30 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M,
- $ A( 1, I ), LDA, ZERO, WORK( IL ), LDWRKL )
- CALL SLACPY( 'F', M, BLK, WORK( IL ), LDWRKL,
- $ A( 1, I ), LDA )
- 30 CONTINUE
-*
- ELSE IF( WNTQS ) THEN
-*
-* Path 3t (N much larger than M, JOBZ='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IL = 1
-*
-* WORK(IL) is M by M
-*
- LDWRKL = M
- ITAU = IL + LDWRKL*M
- NWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Copy L to WORK(IL), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IL+LDWRKL ), LDWRKL )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of L and VT
-* by right singular vectors of L
-* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
-* Multiply right singular vectors of L in WORK(IL) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL SLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL )
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), LDWRKL,
- $ A, LDA, ZERO, VT, LDVT )
-*
- ELSE IF( WNTQA ) THEN
-*
-* Path 4t (N much larger than M, JOBZ='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IVT = 1
-*
-* WORK(IVT) is M by M
-*
- LDWKVT = M
- ITAU = IVT + LDWKVT*M
- NWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Produce L in A, zeroing out other entries
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
-*
- CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
- $ WORK( IVT ), LDWKVT, DUM, IDUM,
- $ WORK( NWORK ), IWORK, INFO )
-*
-* Overwrite U by left singular vectors of L and WORK(IVT)
-* by right singular vectors of L
-* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, M, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', M, M, M, A, LDA,
- $ WORK( ITAUP ), WORK( IVT ), LDWKVT,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply right singular vectors of L in WORK(IVT) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT,
- $ VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL SLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- END IF
-*
- ELSE
-*
-* N .LT. MNTHR
-*
-* Path 5t (N greater than M, but not much larger)
-* Reduce to bidiagonal form without LQ decomposition
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- NWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
- $ IERR )
- IF( WNTQN ) THEN
-*
-* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need M+BDSPAC)
-*
- CALL SBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
- $ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
- ELSE IF( WNTQO ) THEN
- LDWKVT = M
- IVT = NWORK
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
-*
-* WORK( IVT ) is M by N
-*
- CALL SLASET( 'F', M, N, ZERO, ZERO, WORK( IVT ),
- $ LDWKVT )
- NWORK = IVT + LDWKVT*N
- ELSE
-*
-* WORK( IVT ) is M by M
-*
- NWORK = IVT + LDWKVT*M
- IL = NWORK
-*
-* WORK(IL) is M by CHUNK
-*
- CHUNK = ( LWORK-M*M-3*M ) / M
- END IF
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU,
- $ WORK( IVT ), LDWKVT, DUM, IDUM,
- $ WORK( NWORK ), IWORK, INFO )
-*
-* Overwrite U by left singular vectors of A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
-*
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
-*
-* Overwrite WORK(IVT) by left singular vectors of A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), WORK( IVT ), LDWKVT,
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Copy right singular vectors of A from WORK(IVT) to A
-*
- CALL SLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA )
- ELSE
-*
-* Generate P**T in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( NWORK ), LWORK-NWORK+1, IERR )
-*
-* Multiply Q in A by right singular vectors of
-* bidiagonal matrix in WORK(IVT), storing result in
-* WORK(IL) and copying to A
-* (Workspace: need 2*M*M, prefer M*M+M*N)
-*
- DO 40 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ),
- $ LDWKVT, A( 1, I ), LDA, ZERO,
- $ WORK( IL ), M )
- CALL SLACPY( 'F', M, BLK, WORK( IL ), M, A( 1, I ),
- $ LDA )
- 40 CONTINUE
- END IF
- ELSE IF( WNTQS ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
-*
- CALL SLASET( 'F', M, N, ZERO, ZERO, VT, LDVT )
- CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need 3*M, prefer 2*M+M*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
-*
-* Perform bidiagonal SVD, computing left singular vectors
-* of bidiagonal matrix in U and computing right singular
-* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
-*
- CALL SLASET( 'F', N, N, ZERO, ZERO, VT, LDVT )
- CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
- $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
- $ INFO )
-*
-* Set the right corner of VT to identity matrix
-*
- IF( N.GT.M ) THEN
- CALL SLASET( 'F', N-M, N-M, ZERO, ONE, VT( M+1, M+1 ),
- $ LDVT )
- END IF
-*
-* Overwrite U by left singular vectors of A and VT
-* by right singular vectors of A
-* (Workspace: need 2*M+N, prefer 2*M+N*NB)
-*
- CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- CALL SORMBR( 'P', 'R', 'T', N, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
- $ LWORK-NWORK+1, IERR )
- END IF
-*
- END IF
-*
- END IF
-*
-* Undo scaling if necessary
-*
- IF( ISCL.EQ.1 ) THEN
- IF( ANRM.GT.BIGNUM )
- $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( ANRM.LT.SMLNUM )
- $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- END IF
-*
-* Return optimal workspace in WORK(1)
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of SGESDD
-*
- END
diff --git a/netlib/LAPACK/sgesv.f b/netlib/LAPACK/sgesv.f
deleted file mode 100644
index 40509d3..0000000
--- a/netlib/LAPACK/sgesv.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief <b> SGESV computes the solution to system of linear equations A * X = B for GE matrices</b> (simple driver)
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGESV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*>
-*> The LU decomposition with partial pivoting and row interchanges is
-*> used to factor A as
-*> A = P * L * U,
-*> where P is a permutation matrix, L is unit lower triangular, and U is
-*> upper triangular. The factored form of A is then used to solve the
-*> system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N coefficient matrix A.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-* =====================================================================
- SUBROUTINE SGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL SGETRF, SGETRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGESV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of A.
-*
- CALL SGETRF( N, N, A, LDA, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
- $ INFO )
- END IF
- RETURN
-*
-* End of SGESV
-*
- END
diff --git a/netlib/LAPACK/sgesvd.f b/netlib/LAPACK/sgesvd.f
deleted file mode 100644
index 263548b..0000000
--- a/netlib/LAPACK/sgesvd.f
+++ /dev/null
@@ -1,3494 +0,0 @@
-*> \brief <b> SGESVD computes the singular value decomposition (SVD) for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU, JOBVT
-* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), S( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGESVD computes the singular value decomposition (SVD) of a real
-*> M-by-N matrix A, optionally computing the left and/or right singular
-*> vectors. The SVD is written
-*>
-*> A = U * SIGMA * transpose(V)
-*>
-*> where SIGMA is an M-by-N matrix which is zero except for its
-*> min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
-*> V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
-*> are the singular values of A; they are real and non-negative, and
-*> are returned in descending order. The first min(m,n) columns of
-*> U and V are the left and right singular vectors of A.
-*>
-*> Note that the routine returns V**T, not V.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies options for computing all or part of the matrix U:
-*> = 'A': all M columns of U are returned in array U:
-*> = 'S': the first min(m,n) columns of U (the left singular
-*> vectors) are returned in the array U;
-*> = 'O': the first min(m,n) columns of U (the left singular
-*> vectors) are overwritten on the array A;
-*> = 'N': no columns of U (no left singular vectors) are
-*> computed.
-*> \endverbatim
-*>
-*> \param[in] JOBVT
-*> \verbatim
-*> JOBVT is CHARACTER*1
-*> Specifies options for computing all or part of the matrix
-*> V**T:
-*> = 'A': all N rows of V**T are returned in the array VT;
-*> = 'S': the first min(m,n) rows of V**T (the right singular
-*> vectors) are returned in the array VT;
-*> = 'O': the first min(m,n) rows of V**T (the right singular
-*> vectors) are overwritten on the array A;
-*> = 'N': no rows of V**T (no right singular vectors) are
-*> computed.
-*>
-*> JOBVT and JOBU cannot both be 'O'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if JOBU = 'O', A is overwritten with the first min(m,n)
-*> columns of U (the left singular vectors,
-*> stored columnwise);
-*> if JOBVT = 'O', A is overwritten with the first min(m,n)
-*> rows of V**T (the right singular vectors,
-*> stored rowwise);
-*> if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
-*> are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (min(M,N))
-*> The singular values of A, sorted so that S(i) >= S(i+1).
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,UCOL)
-*> (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
-*> If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
-*> if JOBU = 'S', U contains the first min(m,n) columns of U
-*> (the left singular vectors, stored columnwise);
-*> if JOBU = 'N' or 'O', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1; if
-*> JOBU = 'S' or 'A', LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT,N)
-*> If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
-*> V**T;
-*> if JOBVT = 'S', VT contains the first min(m,n) rows of
-*> V**T (the right singular vectors, stored rowwise);
-*> if JOBVT = 'N' or 'O', VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1; if
-*> JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
-*> if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
-*> superdiagonal elements of an upper bidiagonal matrix B
-*> whose diagonal is in S (not necessarily sorted). B
-*> satisfies A = U * B * VT, so it has the same singular values
-*> as A, and singular vectors related by U and VT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code):
-*> - PATH 1 (M much larger than N, JOBU='N')
-*> - PATH 1t (N much larger than M, JOBVT='N')
-*> LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) for the other paths
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if SBDSQR did not converge, INFO specifies how many
-*> superdiagonals of an intermediate bidiagonal form B
-*> did not converge to zero. See the description of WORK
-*> above for details.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGEsing
-*
-* =====================================================================
- SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU, JOBVT
- INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), S( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
- $ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
- $ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
- $ NRVT, WRKBL
- INTEGER LWORK_SGEQRF, LWORK_SORGQR_N, LWORK_SORGQR_M,
- $ LWORK_SGEBRD, LWORK_SORGBR_P, LWORK_SORGBR_Q,
- $ LWORK_SGELQF, LWORK_SORGLQ_N, LWORK_SORGLQ_M
- REAL ANRM, BIGNUM, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- REAL DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SBDSQR, SGEBRD, SGELQF, SGEMM, SGEQRF, SLACPY,
- $ SLASCL, SLASET, SORGBR, SORGLQ, SORGQR, SORMBR,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- WNTUA = LSAME( JOBU, 'A' )
- WNTUS = LSAME( JOBU, 'S' )
- WNTUAS = WNTUA .OR. WNTUS
- WNTUO = LSAME( JOBU, 'O' )
- WNTUN = LSAME( JOBU, 'N' )
- WNTVA = LSAME( JOBVT, 'A' )
- WNTVS = LSAME( JOBVT, 'S' )
- WNTVAS = WNTVA .OR. WNTVS
- WNTVO = LSAME( JOBVT, 'O' )
- WNTVN = LSAME( JOBVT, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
- $ ( WNTVO .AND. WNTUO ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
- INFO = -9
- ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
- $ ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-* Compute space needed for SBDSQR
-*
- MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 )
- BDSPAC = 5*N
-* Compute space needed for SGEQRF
- CALL SGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_SGEQRF=DUM(1)
-* Compute space needed for SORGQR
- CALL SORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_SORGQR_N=DUM(1)
- CALL SORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_SORGQR_M=DUM(1)
-* Compute space needed for SGEBRD
- CALL SGEBRD( N, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_SGEBRD=DUM(1)
-* Compute space needed for SORGBR P
- CALL SORGBR( 'P', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_P=DUM(1)
-* Compute space needed for SORGBR Q
- CALL SORGBR( 'Q', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_Q=DUM(1)
-*
- IF( M.GE.MNTHR ) THEN
- IF( WNTUN ) THEN
-*
-* Path 1 (M much larger than N, JOBU='N')
-*
- MAXWRK = N + LWORK_SGEQRF
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_SGEBRD )
- IF( WNTVO .OR. WNTVAS )
- $ MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_P )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 4*N, BDSPAC )
- ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-* Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVN ) THEN
-*
-* Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVO ) THEN
-*
-* Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVAS ) THEN
-*
-* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVN ) THEN
-*
-* Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVO ) THEN
-*
-* Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVAS ) THEN
-*
-* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_SGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_SORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- END IF
- ELSE
-*
-* Path 10 (M at least N, but not much larger)
-*
- CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_SGEBRD=DUM(1)
- MAXWRK = 3*N + LWORK_SGEBRD
- IF( WNTUS .OR. WNTUO ) THEN
- CALL SORGBR( 'Q', M, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_Q=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_Q )
- END IF
- IF( WNTUA ) THEN
- CALL SORGBR( 'Q', M, M, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_Q=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_Q )
- END IF
- IF( .NOT.WNTVN ) THEN
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_P )
- END IF
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 3*N+M, BDSPAC )
- END IF
- ELSE IF( MINMN.GT.0 ) THEN
-*
-* Compute space needed for SBDSQR
-*
- MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 )
- BDSPAC = 5*M
-* Compute space needed for SGELQF
- CALL SGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_SGELQF=DUM(1)
-* Compute space needed for SORGLQ
- CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR )
- LWORK_SORGLQ_N=DUM(1)
- CALL SORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_SORGLQ_M=DUM(1)
-* Compute space needed for SGEBRD
- CALL SGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_SGEBRD=DUM(1)
-* Compute space needed for SORGBR P
- CALL SORGBR( 'P', M, M, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_P=DUM(1)
-* Compute space needed for SORGBR Q
- CALL SORGBR( 'Q', M, M, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_Q=DUM(1)
- IF( N.GE.MNTHR ) THEN
- IF( WNTVN ) THEN
-*
-* Path 1t(N much larger than M, JOBVT='N')
-*
- MAXWRK = M + LWORK_SGELQF
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_SGEBRD )
- IF( WNTUO .OR. WNTUAS )
- $ MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_Q )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 4*M, BDSPAC )
- ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-* Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-* Path 3t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='O')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUN ) THEN
-*
-* Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUO ) THEN
-*
-* Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- MAXWRK = MAX( MAXWRK, MINWRK )
- ELSE IF( WNTVS .AND. WNTUAS ) THEN
-*
-* Path 6t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='S')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUN ) THEN
-*
-* Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUO ) THEN
-*
-* Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUAS ) THEN
-*
-* Path 9t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='A')
-*
- WRKBL = M + LWORK_SGELQF
- WRKBL = MAX( WRKBL, M+LWORK_SORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_SORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- END IF
- ELSE
-*
-* Path 10t(N greater than M, but not much larger)
-*
- CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_SGEBRD=DUM(1)
- MAXWRK = 3*M + LWORK_SGEBRD
- IF( WNTVS .OR. WNTVO ) THEN
-* Compute space needed for SORGBR P
- CALL SORGBR( 'P', M, N, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_P=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_P )
- END IF
- IF( WNTVA ) THEN
- CALL SORGBR( 'P', N, N, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_SORGBR_P=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_P )
- END IF
- IF( .NOT.WNTUN ) THEN
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_Q )
- END IF
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 3*M+N, BDSPAC )
- END IF
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGESVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SQRT( SLAMCH( 'S' ) ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', M, N, A, LDA, DUM )
- ISCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ISCL = 1
- CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ISCL = 1
- CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* A has at least as many rows as columns. If A has sufficiently
-* more rows than columns, first reduce using the QR
-* decomposition (if sufficient workspace available)
-*
- IF( M.GE.MNTHR ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 1 (M much larger than N, JOBU='N')
-* No left singular vectors to be computed
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Zero out below R
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- NCVT = 0
- IF( WNTVO .OR. WNTVAS ) THEN
-*
-* If right singular vectors desired, generate P'.
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- NCVT = N
- END IF
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in A if desired
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA,
- $ DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
-* If right singular vectors desired in VT, copy them there
-*
- IF( WNTVAS )
- $ CALL SLACPY( 'F', N, N, A, LDA, VT, LDVT )
-*
- ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-* Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-* N left singular vectors to be overwritten on A and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N, WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-* WORK(IU) is LDA by N, WORK(IR) is N by N
-*
- LDWRKU = LDA
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is LDWRKU by N, WORK(IR) is N by N
-*
- LDWRKU = ( LWORK-N*N-N ) / N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IR) and zero out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing R
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1,
- $ WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + N
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in WORK(IU) and copying to A
-* (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
- DO 10 I = 1, M, LDWRKU
- CHUNK = MIN( M-I+1, LDWRKU )
- CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IR ), LDWRKR, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL SLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
- $ A( I, 1 ), LDA )
- 10 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing A
-* (Workspace: need 4*N, prefer 3*N+N*NB)
-*
- CALL SORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1,
- $ A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
-* N left singular vectors to be overwritten on A and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is LDWRKU by N and WORK(IR) is N by N
-*
- LDWRKU = ( LWORK-N*N-N ) / N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT, copying result to WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
-*
-* Generate left vectors bidiagonalizing R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in VT
-* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR) and computing right
-* singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT,
- $ WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + N
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in WORK(IU) and copying to A
-* (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
- DO 20 I = 1, M, LDWRKU
- CHUNK = MIN( M-I+1, LDWRKU )
- CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IR ), LDWRKR, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL SLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
- $ A( I, 1 ), LDA )
- 20 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
-*
-* Generate Q in A
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in A by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), A, LDA, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT,
- $ A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTUS ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-* N left singular vectors to be computed in U and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IR) is LDA by N
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IR+1 ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
- $ 1, WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in U
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IR ), LDWRKR, ZERO, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
- $ 1, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVO ) THEN
-*
-* Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is N by N and WORK(IR) is N by N
-*
- LDWRKU = N
- IR = IU + LDWRKU*N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*N*N+4*N,
-* prefer 2*N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', N, N, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*N*N+4*N-1,
-* prefer 2*N*N+3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in WORK(IR)
-* (Workspace: need 2*N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, WORK( IU ),
- $ LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in U
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
-* Copy right singular vectors of R to A
-* (Workspace: need N*N)
-*
- CALL SLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
- $ LDA, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVAS ) THEN
-*
-* Path 6 (M much larger than N, JOBU='S', JOBVT='S'
-* or 'A')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- END IF
- ITAU = IU + LDWRKU*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to VT
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
- $ LDVT )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need N*N+4*N-1,
-* prefer N*N+3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
- $ LDVT, WORK( IU ), LDWRKU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in U
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in VT
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- ELSE IF( WNTUA ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-* M left singular vectors to be computed in U and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IR) is LDA by N
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IR+1 ), LDWRKR )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
- $ 1, WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IR), storing result in A
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IR ), LDWRKR, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL SLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in A
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
- $ 1, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVO ) THEN
-*
-* Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is N by N and WORK(IR) is N by N
-*
- LDWRKU = N
- IR = IU + LDWRKU*N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
-*
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*N*N+4*N,
-* prefer 2*N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', N, N, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*N*N+4*N-1,
-* prefer 2*N*N+3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in WORK(IR)
-* (Workspace: need 2*N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, WORK( IU ),
- $ LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL SLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-* Copy right singular vectors of R from WORK(IR) to A
-*
- CALL SLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in A
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
- $ LDA, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVAS ) THEN
-*
-* Path 9 (M much larger than N, JOBU='A', JOBVT='S'
-* or 'A')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- END IF
- ITAU = IU + LDWRKU*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to VT
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
- $ LDVT )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL SORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need N*N+4*N-1,
-* prefer N*N+3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
- $ LDVT, WORK( IU ), LDWRKU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL SLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL SGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R from A to VT, zeroing out below it
-*
- CALL SLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL SGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in VT
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL SORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* M .LT. MNTHR
-*
-* Path 10 (M at least N, but not much larger)
-* Reduce to bidiagonal form without QR decomposition
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUAS ) THEN
-*
-* If left singular vectors desired in U, copy result to U
-* and generate left bidiagonalizing vectors in U
-* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB)
-*
- CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
- IF( WNTUS )
- $ NCU = N
- IF( WNTUA )
- $ NCU = M
- CALL SORGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVAS ) THEN
-*
-* If right singular vectors desired in VT, copy result to
-* VT and generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SLACPY( 'U', N, N, A, LDA, VT, LDVT )
- CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTUO ) THEN
-*
-* If left singular vectors desired in A, generate left
-* bidiagonalizing vectors in A
-* (Workspace: need 4*N, prefer 3*N+N*NB)
-*
- CALL SORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVO ) THEN
-*
-* If right singular vectors desired in A, generate right
-* bidiagonalizing vectors in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + N
- IF( WNTUAS .OR. WNTUO )
- $ NRU = M
- IF( WNTUN )
- $ NRU = 0
- IF( WNTVAS .OR. WNTVO )
- $ NCVT = N
- IF( WNTVN )
- $ NCVT = 0
- IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in A and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
- END IF
-*
- END IF
-*
- ELSE
-*
-* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition (if
-* sufficient workspace available)
-*
- IF( N.GE.MNTHR ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 1t(N much larger than M, JOBVT='N')
-* No right singular vectors to be computed
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Zero out above L
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUO .OR. WNTUAS ) THEN
-*
-* If left singular vectors desired, generate Q
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + M
- NRU = 0
- IF( WNTUO .OR. WNTUAS )
- $ NRU = M
-*
-* Perform bidiagonal QR iteration, computing left singular
-* vectors of A in A if desired
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A,
- $ LDA, DUM, 1, WORK( IWORK ), INFO )
-*
-* If left singular vectors desired in U, copy them there
-*
- IF( WNTUAS )
- $ CALL SLACPY( 'F', M, M, A, LDA, U, LDU )
-*
- ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-* Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-* M right singular vectors to be overwritten on A and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is M by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
- LDWRKU = M
- CHUNK = ( LWORK-M*M-M ) / M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IR) and zero out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing L
-* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + M
-*
-* Multiply right singular vectors of L in WORK(IR) by Q
-* in A, storing result in WORK(IU) and copying to A
-* (Workspace: need M*M+2*M, prefer M*M+M*N+M)
-*
- DO 30 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
- $ LDWRKR, A( 1, I ), LDA, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL SLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
- $ A( 1, I ), LDA )
- 30 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA,
- $ DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
-* M right singular vectors to be overwritten on A and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is M by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
- LDWRKU = M
- CHUNK = ( LWORK-M*M-M ) / M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing about above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U, copying result to WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
-*
-* Generate right vectors bidiagonalizing L in WORK(IR)
-* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing L in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U, and computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + M
-*
-* Multiply right singular vectors of L in WORK(IR) by Q
-* in A, storing result in WORK(IU) and copying to A
-* (Workspace: need M*M+2*M, prefer M*M+M*N+M))
-*
- DO 40 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
- $ LDWRKR, A( 1, I ), LDA, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL SLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
- $ A( 1, I ), LDA )
- 40 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
-*
-* Generate Q in A
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in A
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), A, LDA, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing L in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTVS ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-* M right singular vectors to be computed in VT and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IR) is LDA by M
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is M by M
-*
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IR), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing L in
-* WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IR) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
- $ LDWRKR, A, LDA, ZERO, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy result to VT
-*
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
- $ LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUO ) THEN
-*
-* Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is M by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by M and WORK(IR) is M by M
-*
- LDWRKU = M
- IR = IU + LDWRKU*M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out below it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*M*M+4*M,
-* prefer 2*M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, M, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*M*M+4*M-1,
-* prefer 2*M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in WORK(IR) and computing
-* right singular vectors of L in WORK(IU)
-* (Workspace: need 2*M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, WORK( IR ),
- $ LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
-* Copy left singular vectors of L to A
-* (Workspace: need M*M)
-*
- CALL SLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors of L in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, compute left
-* singular vectors of A in A and compute right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUAS ) THEN
-*
-* Path 6t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is LDA by M
-*
- LDWRKU = M
- END IF
- ITAU = IU + LDWRKU*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
- $ LDU )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need M*M+4*M-1,
-* prefer M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U and computing right
-* singular vectors of L in WORK(IU)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in U by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- ELSE IF( WNTVA ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-* N right singular vectors to be computed in VT and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IR) is LDA by M
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is M by M
-*
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Copy L to WORK(IR), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in VT
-* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need M*M+4*M-1,
-* prefer M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IR) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
- $ LDWRKR, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL SLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in A by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
- $ LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUO ) THEN
-*
-* Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is M by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by M and WORK(IR) is M by M
-*
- LDWRKU = M
- IR = IU + LDWRKU*M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*M*M+4*M,
-* prefer 2*M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, M, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*M*M+4*M-1,
-* prefer 2*M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in WORK(IR) and computing
-* right singular vectors of L in WORK(IU)
-* (Workspace: need 2*M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, WORK( IR ),
- $ LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL SLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-* Copy left singular vectors of A from WORK(IR) to A
-*
- CALL SLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in A by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUAS ) THEN
-*
-* Path 9t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IU) is LDA by M
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is M by M
-*
- LDWRKU = M
- END IF
- ITAU = IU + LDWRKU*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL SLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
- $ LDU )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
- CALL SORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U and computing right
-* singular vectors of L in WORK(IU)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL SBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL SLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL SGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL SLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL SGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in U by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL SORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N .LT. MNTHR
-*
-* Path 10t(N greater than M, but not much larger)
-* Reduce to bidiagonal form without LQ decomposition
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUAS ) THEN
-*
-* If left singular vectors desired in U, copy result to U
-* and generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
- CALL SLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL SORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVAS ) THEN
-*
-* If right singular vectors desired in VT, copy result to
-* VT and generate right bidiagonalizing vectors in VT
-* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB)
-*
- CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
- IF( WNTVA )
- $ NRVT = N
- IF( WNTVS )
- $ NRVT = M
- CALL SORGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTUO ) THEN
-*
-* If left singular vectors desired in A, generate left
-* bidiagonalizing vectors in A
-* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
- CALL SORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVO ) THEN
-*
-* If right singular vectors desired in A, generate right
-* bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL SORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + M
- IF( WNTUAS .OR. WNTUO )
- $ NRU = M
- IF( WNTUN )
- $ NRU = 0
- IF( WNTVAS .OR. WNTVO )
- $ NCVT = N
- IF( WNTVN )
- $ NCVT = 0
- IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in A and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL SBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
- END IF
-*
- END IF
-*
- END IF
-*
-* If SBDSQR failed to converge, copy unconverged superdiagonals
-* to WORK( 2:MINMN )
-*
- IF( INFO.NE.0 ) THEN
- IF( IE.GT.2 ) THEN
- DO 50 I = 1, MINMN - 1
- WORK( I+1 ) = WORK( I+IE-1 )
- 50 CONTINUE
- END IF
- IF( IE.LT.2 ) THEN
- DO 60 I = MINMN - 1, 1, -1
- WORK( I+1 ) = WORK( I+IE-1 )
- 60 CONTINUE
- END IF
- END IF
-*
-* Undo scaling if necessary
-*
- IF( ISCL.EQ.1 ) THEN
- IF( ANRM.GT.BIGNUM )
- $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
- $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
- $ MINMN, IERR )
- IF( ANRM.LT.SMLNUM )
- $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
- $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
- $ MINMN, IERR )
- END IF
-*
-* Return optimal workspace in WORK(1)
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of SGESVD
-*
- END
diff --git a/netlib/LAPACK/sgesvj.f b/netlib/LAPACK/sgesvj.f
deleted file mode 100644
index 1786975..0000000
--- a/netlib/LAPACK/sgesvj.f
+++ /dev/null
@@ -1,1599 +0,0 @@
-*> \brief \b SGESVJ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESVJ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesvj.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesvj.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesvj.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
-* LDV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDV, LWORK, M, MV, N
-* CHARACTER*1 JOBA, JOBU, JOBV
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), SVA( N ), V( LDV, * ),
-* $ WORK( LWORK )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGESVJ computes the singular value decomposition (SVD) of a real
-*> M-by-N matrix A, where M >= N. The SVD of A is written as
-*> [++] [xx] [x0] [xx]
-*> A = U * SIGMA * V^t, [++] = [xx] * [ox] * [xx]
-*> [++] [xx]
-*> where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal
-*> matrix, and V is an N-by-N orthogonal matrix. The diagonal elements
-*> of SIGMA are the singular values of A. The columns of U and V are the
-*> left and the right singular vectors of A, respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBA
-*> \verbatim
-*> JOBA is CHARACTER* 1
-*> Specifies the structure of A.
-*> = 'L': The input matrix A is lower triangular;
-*> = 'U': The input matrix A is upper triangular;
-*> = 'G': The input matrix A is general M-by-N matrix, M >= N.
-*> \endverbatim
-*>
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies whether to compute the left singular vectors
-*> (columns of U):
-*> = 'U': The left singular vectors corresponding to the nonzero
-*> singular values are computed and returned in the leading
-*> columns of A. See more details in the description of A.
-*> The default numerical orthogonality threshold is set to
-*> approximately TOL=CTOL*EPS, CTOL=SQRT(M), EPS=SLAMCH('E').
-*> = 'C': Analogous to JOBU='U', except that user can control the
-*> level of numerical orthogonality of the computed left
-*> singular vectors. TOL can be set to TOL = CTOL*EPS, where
-*> CTOL is given on input in the array WORK.
-*> No CTOL smaller than ONE is allowed. CTOL greater
-*> than 1 / EPS is meaningless. The option 'C'
-*> can be used if M*EPS is satisfactory orthogonality
-*> of the computed left singular vectors, so CTOL=M could
-*> save few sweeps of Jacobi rotations.
-*> See the descriptions of A and WORK(1).
-*> = 'N': The matrix U is not computed. However, see the
-*> description of A.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether to compute the right singular vectors, that
-*> is, the matrix V:
-*> = 'V' : the matrix V is computed and returned in the array V
-*> = 'A' : the Jacobi rotations are applied to the MV-by-N
-*> array V. In other words, the right singular vector
-*> matrix V is not computed explicitly; instead it is
-*> applied to an MV-by-N matrix initially stored in the
-*> first MV rows of V.
-*> = 'N' : the matrix V is not computed and the array V is not
-*> referenced
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. 1/SLAMCH('E') > M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A.
-*> M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C':
-*> If INFO .EQ. 0 :
-*> RANKA orthonormal columns of U are returned in the
-*> leading RANKA columns of the array A. Here RANKA <= N
-*> is the number of computed singular values of A that are
-*> above the underflow threshold SLAMCH('S'). The singular
-*> vectors corresponding to underflowed or zero singular
-*> values are not computed. The value of RANKA is returned
-*> in the array WORK as RANKA=NINT(WORK(2)). Also see the
-*> descriptions of SVA and WORK. The computed columns of U
-*> are mutually numerically orthogonal up to approximately
-*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'),
-*> see the description of JOBU.
-*> If INFO .GT. 0,
-*> the procedure SGESVJ did not converge in the given number
-*> of iterations (sweeps). In that case, the computed
-*> columns of U may not be orthogonal up to TOL. The output
-*> U (stored in A), SIGMA (given by the computed singular
-*> values in SVA(1:N)) and V is still a decomposition of the
-*> input matrix A in the sense that the residual
-*> ||A-SCALE*U*SIGMA*V^T||_2 / ||A||_2 is small.
-*> If JOBU .EQ. 'N':
-*> If INFO .EQ. 0 :
-*> Note that the left singular vectors are 'for free' in the
-*> one-sided Jacobi SVD algorithm. However, if only the
-*> singular values are needed, the level of numerical
-*> orthogonality of U is not an issue and iterations are
-*> stopped when the columns of the iterated matrix are
-*> numerically orthogonal up to approximately M*EPS. Thus,
-*> on exit, A contains the columns of U scaled with the
-*> corresponding singular values.
-*> If INFO .GT. 0 :
-*> the procedure SGESVJ did not converge in the given number
-*> of iterations (sweeps).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] SVA
-*> \verbatim
-*> SVA is REAL array, dimension (N)
-*> On exit,
-*> If INFO .EQ. 0 :
-*> depending on the value SCALE = WORK(1), we have:
-*> If SCALE .EQ. ONE:
-*> SVA(1:N) contains the computed singular values of A.
-*> During the computation SVA contains the Euclidean column
-*> norms of the iterated matrices in the array A.
-*> If SCALE .NE. ONE:
-*> The singular values of A are SCALE*SVA(1:N), and this
-*> factored representation is due to the fact that some of the
-*> singular values of A might underflow or overflow.
-*>
-*> If INFO .GT. 0 :
-*> the procedure SGESVJ did not converge in the given number of
-*> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate.
-*> \endverbatim
-*>
-*> \param[in] MV
-*> \verbatim
-*> MV is INTEGER
-*> If JOBV .EQ. 'A', then the product of Jacobi rotations in SGESVJ
-*> is applied to the first MV rows of V. See the description of JOBV.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,N)
-*> If JOBV = 'V', then V contains on exit the N-by-N matrix of
-*> the right singular vectors;
-*> If JOBV = 'A', then V contains the product of the computed right
-*> singular vector matrix and the initial matrix in
-*> the array V.
-*> If JOBV = 'N', then V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV .GE. 1.
-*> If JOBV .EQ. 'V', then LDV .GE. max(1,N).
-*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) .
-*> \endverbatim
-*>
-*> \param[in,out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension max(4,M+N).
-*> On entry,
-*> If JOBU .EQ. 'C' :
-*> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
-*> The process stops if all columns of A are mutually
-*> orthogonal up to CTOL*EPS, EPS=SLAMCH('E').
-*> It is required that CTOL >= ONE, i.e. it is not
-*> allowed to force the routine to obtain orthogonality
-*> below EPSILON.
-*> On exit,
-*> WORK(1) = SCALE is the scaling factor such that SCALE*SVA(1:N)
-*> are the computed singular vcalues of A.
-*> (See description of SVA().)
-*> WORK(2) = NINT(WORK(2)) is the number of the computed nonzero
-*> singular values.
-*> WORK(3) = NINT(WORK(3)) is the number of the computed singular
-*> values that are larger than the underflow threshold.
-*> WORK(4) = NINT(WORK(4)) is the number of sweeps of Jacobi
-*> rotations needed for numerical convergence.
-*> WORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep.
-*> This is useful information in cases when SGESVJ did
-*> not converge, as it can be used to estimate whether
-*> the output is stil useful and for post festum analysis.
-*> WORK(6) = the largest absolute value over all sines of the
-*> Jacobi rotation angles in the last sweep. It can be
-*> useful for a post festum analysis.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> length of WORK, WORK >= MAX(6,M+N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit.
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value
-*> > 0 : SGESVJ did not converge in the maximal allowed number (30)
-*> of sweeps. The output may still be useful. See the
-*> description of WORK.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> The orthogonal N-by-N matrix V is obtained as a product of Jacobi plane
-*> rotations. The rotations are implemented as fast scaled rotations of
-*> Anda and Park [1]. In the case of underflow of the Jacobi angle, a
-*> modified Jacobi transformation of Drmac [4] is used. Pivot strategy uses
-*> column interchanges of de Rijk [2]. The relative accuracy of the computed
-*> singular values and the accuracy of the computed singular vectors (in
-*> angle metric) is as guaranteed by the theory of Demmel and Veselic [3].
-*> The condition number that determines the accuracy in the full rank case
-*> is essentially min_{D=diag} kappa(A*D), where kappa(.) is the
-*> spectral condition number. The best performance of this Jacobi SVD
-*> procedure is achieved if used in an accelerated version of Drmac and
-*> Veselic [5,6], and it is the kernel routine in the SIGMA library [7].
-*> Some tunning parameters (marked with [TP]) are available for the
-*> implementer. \n
-*> The computational range for the nonzero singular values is the machine
-*> number interval ( UNDERFLOW , OVERFLOW ). In extreme cases, even
-*> denormalized singular values can be computed with the corresponding
-*> gradual loss of accurate digits.
-*>
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*>
-*> \par References:
-* ================
-*>
-*> [1] A. A. Anda and H. Park: Fast plane rotations with dynamic scaling. \n
-*> SIAM J. matrix Anal. Appl., Vol. 15 (1994), pp. 162-174. \n\n
-*> [2] P. P. M. De Rijk: A one-sided Jacobi algorithm for computing the
-*> singular value decomposition on a vector computer. \n
-*> SIAM J. Sci. Stat. Comp., Vol. 10 (1998), pp. 359-371. \n\n
-*> [3] J. Demmel and K. Veselic: Jacobi method is more accurate than QR. \n
-*> [4] Z. Drmac: Implementation of Jacobi rotations for accurate singular
-*> value computation in floating point arithmetic. \n
-*> SIAM J. Sci. Comp., Vol. 18 (1997), pp. 1200-1222. \n\n
-*> [5] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. \n
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. \n
-*> LAPACK Working note 169. \n\n
-*> [6] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. \n
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. \n
-*> LAPACK Working note 170. \n\n
-*> [7] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,
-*> QSVD, (H,K)-SVD computations.\n
-*> Department of Mathematics, University of Zagreb, 2008.
-*>
-*> \par Bugs, Examples and Comments:
-* =================================
-*>
-*> Please report all bugs and send interesting test examples and comments to
-*> drmac at math.hr. Thank you.
-*
-* =====================================================================
- SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
- $ LDV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDV, LWORK, M, MV, N
- CHARACTER*1 JOBA, JOBU, JOBV
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), SVA( N ), V( LDV, * ),
- $ WORK( LWORK )
-* ..
-*
-* =====================================================================
-*
-* .. Local Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0)
- INTEGER NSWEEP
- PARAMETER ( NSWEEP = 30 )
-* ..
-* .. Local Scalars ..
- REAL AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
- $ BIGTHETA, CS, CTOL, EPSLN, LARGE, MXAAPQ,
- $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
- $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA,
- $ THSIGN, TOL
- INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
- $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
- $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
- $ SWBAND
- LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK,
- $ RSVEC, UCTOL, UPPER
-* ..
-* .. Local Arrays ..
- REAL FASTR( 5 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, AMAX1, AMIN1, FLOAT, MIN0, SIGN, SQRT
-* ..
-* .. External Functions ..
-* ..
-* from BLAS
- REAL SDOT, SNRM2
- EXTERNAL SDOT, SNRM2
- INTEGER ISAMAX
- EXTERNAL ISAMAX
-* from LAPACK
- REAL SLAMCH
- EXTERNAL SLAMCH
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
-* ..
-* from BLAS
- EXTERNAL SAXPY, SCOPY, SROTM, SSCAL, SSWAP
-* from LAPACK
- EXTERNAL SLASCL, SLASET, SLASSQ, XERBLA
-*
- EXTERNAL SGSVJ0, SGSVJ1
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- LSVEC = LSAME( JOBU, 'U' )
- UCTOL = LSAME( JOBU, 'C' )
- RSVEC = LSAME( JOBV, 'V' )
- APPLV = LSAME( JOBV, 'A' )
- UPPER = LSAME( JOBA, 'U' )
- LOWER = LSAME( JOBA, 'L' )
-*
- IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN
- INFO = -5
- ELSE IF( LDA.LT.M ) THEN
- INFO = -7
- ELSE IF( MV.LT.0 ) THEN
- INFO = -9
- ELSE IF( ( RSVEC .AND. ( LDV.LT.N ) ) .OR.
- $ ( APPLV .AND. ( LDV.LT.MV ) ) ) THEN
- INFO = -11
- ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN
- INFO = -12
- ELSE IF( LWORK.LT.MAX0( M+N, 6 ) ) THEN
- INFO = -13
- ELSE
- INFO = 0
- END IF
-*
-* #:(
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGESVJ', -INFO )
- RETURN
- END IF
-*
-* #:) Quick return for void matrix
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN
-*
-* Set numerical parameters
-* The stopping criterion for Jacobi rotations is
-*
-* max_{i<>j}|A(:,i)^T * A(:,j)|/(||A(:,i)||*||A(:,j)||) < CTOL*EPS
-*
-* where EPS is the round-off and CTOL is defined as follows:
-*
- IF( UCTOL ) THEN
-* ... user controlled
- CTOL = WORK( 1 )
- ELSE
-* ... default
- IF( LSVEC .OR. RSVEC .OR. APPLV ) THEN
- CTOL = SQRT( FLOAT( M ) )
- ELSE
- CTOL = FLOAT( M )
- END IF
- END IF
-* ... and the machine dependent parameters are
-*[!] (Make sure that SLAMCH() works properly on the target machine.)
-*
- EPSLN = SLAMCH( 'Epsilon' )
- ROOTEPS = SQRT( EPSLN )
- SFMIN = SLAMCH( 'SafeMinimum' )
- ROOTSFMIN = SQRT( SFMIN )
- SMALL = SFMIN / EPSLN
- BIG = SLAMCH( 'Overflow' )
-* BIG = ONE / SFMIN
- ROOTBIG = ONE / ROOTSFMIN
- LARGE = BIG / SQRT( FLOAT( M*N ) )
- BIGTHETA = ONE / ROOTEPS
-*
- TOL = CTOL*EPSLN
- ROOTTOL = SQRT( TOL )
-*
- IF( FLOAT( M )*EPSLN.GE.ONE ) THEN
- INFO = -4
- CALL XERBLA( 'SGESVJ', -INFO )
- RETURN
- END IF
-*
-* Initialize the right singular vector matrix.
-*
- IF( RSVEC ) THEN
- MVL = N
- CALL SLASET( 'A', MVL, N, ZERO, ONE, V, LDV )
- ELSE IF( APPLV ) THEN
- MVL = MV
- END IF
- RSVEC = RSVEC .OR. APPLV
-*
-* Initialize SVA( 1:N ) = ( ||A e_i||_2, i = 1:N )
-*(!) If necessary, scale A to protect the largest singular value
-* from overflow. It is possible that saving the largest singular
-* value destroys the information about the small ones.
-* This initial scaling is almost minimal in the sense that the
-* goal is to make sure that no column norm overflows, and that
-* SQRT(N)*max_i SVA(i) does not overflow. If INFinite entries
-* in A are detected, the procedure returns with INFO=-6.
-*
- SKL = ONE / SQRT( FLOAT( M )*FLOAT( N ) )
- NOSCALE = .TRUE.
- GOSCALE = .TRUE.
-*
- IF( LOWER ) THEN
-* the input matrix is M-by-N lower triangular (trapezoidal)
- DO 1874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL SLASSQ( M-p+1, A( p, p ), 1, AAPP, AAQQ )
- IF( AAPP.GT.BIG ) THEN
- INFO = -6
- CALL XERBLA( 'SGESVJ', -INFO )
- RETURN
- END IF
- AAQQ = SQRT( AAQQ )
- IF( ( AAPP.LT.( BIG / AAQQ ) ) .AND. NOSCALE ) THEN
- SVA( p ) = AAPP*AAQQ
- ELSE
- NOSCALE = .FALSE.
- SVA( p ) = AAPP*( AAQQ*SKL )
- IF( GOSCALE ) THEN
- GOSCALE = .FALSE.
- DO 1873 q = 1, p - 1
- SVA( q ) = SVA( q )*SKL
- 1873 CONTINUE
- END IF
- END IF
- 1874 CONTINUE
- ELSE IF( UPPER ) THEN
-* the input matrix is M-by-N upper triangular (trapezoidal)
- DO 2874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL SLASSQ( p, A( 1, p ), 1, AAPP, AAQQ )
- IF( AAPP.GT.BIG ) THEN
- INFO = -6
- CALL XERBLA( 'SGESVJ', -INFO )
- RETURN
- END IF
- AAQQ = SQRT( AAQQ )
- IF( ( AAPP.LT.( BIG / AAQQ ) ) .AND. NOSCALE ) THEN
- SVA( p ) = AAPP*AAQQ
- ELSE
- NOSCALE = .FALSE.
- SVA( p ) = AAPP*( AAQQ*SKL )
- IF( GOSCALE ) THEN
- GOSCALE = .FALSE.
- DO 2873 q = 1, p - 1
- SVA( q ) = SVA( q )*SKL
- 2873 CONTINUE
- END IF
- END IF
- 2874 CONTINUE
- ELSE
-* the input matrix is M-by-N general dense
- DO 3874 p = 1, N
- AAPP = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A( 1, p ), 1, AAPP, AAQQ )
- IF( AAPP.GT.BIG ) THEN
- INFO = -6
- CALL XERBLA( 'SGESVJ', -INFO )
- RETURN
- END IF
- AAQQ = SQRT( AAQQ )
- IF( ( AAPP.LT.( BIG / AAQQ ) ) .AND. NOSCALE ) THEN
- SVA( p ) = AAPP*AAQQ
- ELSE
- NOSCALE = .FALSE.
- SVA( p ) = AAPP*( AAQQ*SKL )
- IF( GOSCALE ) THEN
- GOSCALE = .FALSE.
- DO 3873 q = 1, p - 1
- SVA( q ) = SVA( q )*SKL
- 3873 CONTINUE
- END IF
- END IF
- 3874 CONTINUE
- END IF
-*
- IF( NOSCALE )SKL = ONE
-*
-* Move the smaller part of the spectrum from the underflow threshold
-*(!) Start by determining the position of the nonzero entries of the
-* array SVA() relative to ( SFMIN, BIG ).
-*
- AAPP = ZERO
- AAQQ = BIG
- DO 4781 p = 1, N
- IF( SVA( p ).NE.ZERO )AAQQ = AMIN1( AAQQ, SVA( p ) )
- AAPP = AMAX1( AAPP, SVA( p ) )
- 4781 CONTINUE
-*
-* #:) Quick return for zero matrix
-*
- IF( AAPP.EQ.ZERO ) THEN
- IF( LSVEC )CALL SLASET( 'G', M, N, ZERO, ONE, A, LDA )
- WORK( 1 ) = ONE
- WORK( 2 ) = ZERO
- WORK( 3 ) = ZERO
- WORK( 4 ) = ZERO
- WORK( 5 ) = ZERO
- WORK( 6 ) = ZERO
- RETURN
- END IF
-*
-* #:) Quick return for one-column matrix
-*
- IF( N.EQ.1 ) THEN
- IF( LSVEC )CALL SLASCL( 'G', 0, 0, SVA( 1 ), SKL, M, 1,
- $ A( 1, 1 ), LDA, IERR )
- WORK( 1 ) = ONE / SKL
- IF( SVA( 1 ).GE.SFMIN ) THEN
- WORK( 2 ) = ONE
- ELSE
- WORK( 2 ) = ZERO
- END IF
- WORK( 3 ) = ZERO
- WORK( 4 ) = ZERO
- WORK( 5 ) = ZERO
- WORK( 6 ) = ZERO
- RETURN
- END IF
-*
-* Protect small singular values from underflow, and try to
-* avoid underflows/overflows in computing Jacobi rotations.
-*
- SN = SQRT( SFMIN / EPSLN )
- TEMP1 = SQRT( BIG / FLOAT( N ) )
- IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR.
- $ ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN
- TEMP1 = AMIN1( BIG, TEMP1 / AAPP )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN
- TEMP1 = AMIN1( SN / AAQQ, BIG / ( AAPP*SQRT( FLOAT( N ) ) ) )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN
- TEMP1 = AMAX1( SN / AAQQ, TEMP1 / AAPP )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN
- TEMP1 = AMIN1( SN / AAQQ, BIG / ( SQRT( FLOAT( N ) )*AAPP ) )
-* AAQQ = AAQQ*TEMP1
-* AAPP = AAPP*TEMP1
- ELSE
- TEMP1 = ONE
- END IF
-*
-* Scale, if necessary
-*
- IF( TEMP1.NE.ONE ) THEN
- CALL SLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR )
- END IF
- SKL = TEMP1*SKL
- IF( SKL.NE.ONE ) THEN
- CALL SLASCL( JOBA, 0, 0, ONE, SKL, M, N, A, LDA, IERR )
- SKL = ONE / SKL
- END IF
-*
-* Row-cyclic Jacobi SVD algorithm with column pivoting
-*
- EMPTSW = ( N*( N-1 ) ) / 2
- NOTROT = 0
- FASTR( 1 ) = ZERO
-*
-* A is represented in factored form A = A * diag(WORK), where diag(WORK)
-* is initialized to identity. WORK is updated during fast scaled
-* rotations.
-*
- DO 1868 q = 1, N
- WORK( q ) = ONE
- 1868 CONTINUE
-*
-*
- SWBAND = 3
-*[TP] SWBAND is a tuning parameter [TP]. It is meaningful and effective
-* if SGESVJ is used as a computational routine in the preconditioned
-* Jacobi SVD algorithm SGESVJ. For sweeps i=1:SWBAND the procedure
-* works on pivots inside a band-like region around the diagonal.
-* The boundaries are determined dynamically, based on the number of
-* pivots above a threshold.
-*
- KBL = MIN0( 8, N )
-*[TP] KBL is a tuning parameter that defines the tile size in the
-* tiling of the p-q loops of pivot pairs. In general, an optimal
-* value of KBL depends on the matrix dimensions and on the
-* parameters of the computer's memory.
-*
- NBL = N / KBL
- IF( ( NBL*KBL ).NE.N )NBL = NBL + 1
-*
- BLSKIP = KBL**2
-*[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
-*
- ROWSKIP = MIN0( 5, KBL )
-*[TP] ROWSKIP is a tuning parameter.
-*
- LKAHEAD = 1
-*[TP] LKAHEAD is a tuning parameter.
-*
-* Quasi block transformations, using the lower (upper) triangular
-* structure of the input matrix. The quasi-block-cycling usually
-* invokes cubic convergence. Big part of this cycle is done inside
-* canonical subspaces of dimensions less than M.
-*
- IF( ( LOWER .OR. UPPER ) .AND. ( N.GT.MAX0( 64, 4*KBL ) ) ) THEN
-*[TP] The number of partition levels and the actual partition are
-* tuning parameters.
- N4 = N / 4
- N2 = N / 2
- N34 = 3*N4
- IF( APPLV ) THEN
- q = 0
- ELSE
- q = 1
- END IF
-*
- IF( LOWER ) THEN
-*
-* This works very well on lower triangular matrices, in particular
-* in the framework of the preconditioned Jacobi SVD (xGEJSV).
-* The idea is simple:
-* [+ 0 0 0] Note that Jacobi transformations of [0 0]
-* [+ + 0 0] [0 0]
-* [+ + x 0] actually work on [x 0] [x 0]
-* [+ + x x] [x x]. [x x]
-*
- CALL SGSVJ0( JOBV, M-N34, N-N34, A( N34+1, N34+1 ), LDA,
- $ WORK( N34+1 ), SVA( N34+1 ), MVL,
- $ V( N34*q+1, N34+1 ), LDV, EPSLN, SFMIN, TOL,
- $ 2, WORK( N+1 ), LWORK-N, IERR )
-*
- CALL SGSVJ0( JOBV, M-N2, N34-N2, A( N2+1, N2+1 ), LDA,
- $ WORK( N2+1 ), SVA( N2+1 ), MVL,
- $ V( N2*q+1, N2+1 ), LDV, EPSLN, SFMIN, TOL, 2,
- $ WORK( N+1 ), LWORK-N, IERR )
-*
- CALL SGSVJ1( JOBV, M-N2, N-N2, N4, A( N2+1, N2+1 ), LDA,
- $ WORK( N2+1 ), SVA( N2+1 ), MVL,
- $ V( N2*q+1, N2+1 ), LDV, EPSLN, SFMIN, TOL, 1,
- $ WORK( N+1 ), LWORK-N, IERR )
-*
- CALL SGSVJ0( JOBV, M-N4, N2-N4, A( N4+1, N4+1 ), LDA,
- $ WORK( N4+1 ), SVA( N4+1 ), MVL,
- $ V( N4*q+1, N4+1 ), LDV, EPSLN, SFMIN, TOL, 1,
- $ WORK( N+1 ), LWORK-N, IERR )
-*
- CALL SGSVJ0( JOBV, M, N4, A, LDA, WORK, SVA, MVL, V, LDV,
- $ EPSLN, SFMIN, TOL, 1, WORK( N+1 ), LWORK-N,
- $ IERR )
-*
- CALL SGSVJ1( JOBV, M, N2, N4, A, LDA, WORK, SVA, MVL, V,
- $ LDV, EPSLN, SFMIN, TOL, 1, WORK( N+1 ),
- $ LWORK-N, IERR )
-*
-*
- ELSE IF( UPPER ) THEN
-*
-*
- CALL SGSVJ0( JOBV, N4, N4, A, LDA, WORK, SVA, MVL, V, LDV,
- $ EPSLN, SFMIN, TOL, 2, WORK( N+1 ), LWORK-N,
- $ IERR )
-*
- CALL SGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, WORK( N4+1 ),
- $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV,
- $ EPSLN, SFMIN, TOL, 1, WORK( N+1 ), LWORK-N,
- $ IERR )
-*
- CALL SGSVJ1( JOBV, N2, N2, N4, A, LDA, WORK, SVA, MVL, V,
- $ LDV, EPSLN, SFMIN, TOL, 1, WORK( N+1 ),
- $ LWORK-N, IERR )
-*
- CALL SGSVJ0( JOBV, N2+N4, N4, A( 1, N2+1 ), LDA,
- $ WORK( N2+1 ), SVA( N2+1 ), MVL,
- $ V( N2*q+1, N2+1 ), LDV, EPSLN, SFMIN, TOL, 1,
- $ WORK( N+1 ), LWORK-N, IERR )
-
- END IF
-*
- END IF
-*
-* .. Row-cyclic pivot strategy with de Rijk's pivoting ..
-*
- DO 1993 i = 1, NSWEEP
-*
-* .. go go go ...
-*
- MXAAPQ = ZERO
- MXSINJ = ZERO
- ISWROT = 0
-*
- NOTROT = 0
- PSKIPPED = 0
-*
-* Each sweep is unrolled using KBL-by-KBL tiles over the pivot pairs
-* 1 <= p < q <= N. This is the first step toward a blocked implementation
-* of the rotations. New implementation, based on block transformations,
-* is under development.
-*
- DO 2000 ibr = 1, NBL
-*
- igl = ( ibr-1 )*KBL + 1
-*
- DO 1002 ir1 = 0, MIN0( LKAHEAD, NBL-ibr )
-*
- igl = igl + ir1*KBL
-*
- DO 2001 p = igl, MIN0( igl+KBL-1, N-1 )
-*
-* .. de Rijk's pivoting
-*
- q = ISAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- CALL SSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL SSWAP( MVL, V( 1, p ), 1,
- $ V( 1, q ), 1 )
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = WORK( p )
- WORK( p ) = WORK( q )
- WORK( q ) = TEMP1
- END IF
-*
- IF( ir1.EQ.0 ) THEN
-*
-* Column norms are periodically updated by explicit
-* norm computation.
-* Caveat:
-* Unfortunately, some BLAS implementations compute SNRM2(M,A(1,p),1)
-* as SQRT(SDOT(M,A(1,p),1,A(1,p),1)), which may cause the result to
-* overflow for ||A(:,p)||_2 > SQRT(overflow_threshold), and to
-* underflow for ||A(:,p)||_2 < SQRT(underflow_threshold).
-* Hence, SNRM2 cannot be trusted, not even in the case when
-* the true norm is far from the under(over)flow boundaries.
-* If properly implemented SNRM2 is available, the IF-THEN-ELSE
-* below should read "AAPP = SNRM2( M, A(1,p), 1 ) * WORK(p)".
-*
- IF( ( SVA( p ).LT.ROOTBIG ) .AND.
- $ ( SVA( p ).GT.ROOTSFMIN ) ) THEN
- SVA( p ) = SNRM2( M, A( 1, p ), 1 )*WORK( p )
- ELSE
- TEMP1 = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, TEMP1, AAPP )
- SVA( p ) = TEMP1*SQRT( AAPP )*WORK( p )
- END IF
- AAPP = SVA( p )
- ELSE
- AAPP = SVA( p )
- END IF
-*
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2002 q = p + 1, MIN0( igl+KBL-1, N )
-*
- AAQQ = SVA( q )
-*
- IF( AAQQ.GT.ZERO ) THEN
-*
- AAPP0 = AAPP
- IF( AAQQ.GE.ONE ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL SCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAPP,
- $ WORK( p ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = SDOT( M, WORK( N+1 ), 1,
- $ A( 1, q ), 1 )*WORK( q ) / AAQQ
- END IF
- ELSE
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL SCOPY( M, A( 1, q ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ,
- $ WORK( q ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = SDOT( M, WORK( N+1 ), 1,
- $ A( 1, p ), 1 )*WORK( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( ABS( AAPQ ).GT.TOL ) THEN
-*
-* .. rotate
-*[RTD] ROTATED = ROTATED + ONE
-*
- IF( ir1.EQ.0 ) THEN
- NOTROT = 0
- PSKIPPED = 0
- ISWROT = ISWROT + 1
- END IF
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*ABS( AQOAP-APOAQ ) / AAPQ
-*
- IF( ABS( THETA ).GT.BIGTHETA ) THEN
-*
- T = HALF / THETA
- FASTR( 3 ) = T*WORK( p ) / WORK( q )
- FASTR( 4 ) = -T*WORK( q ) /
- $ WORK( p )
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, ABS( T ) )
-*
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -SIGN( ONE, AAPQ )
- T = ONE / ( THETA+THSIGN*
- $ SQRT( ONE+THETA*THETA ) )
- CS = SQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
-*
- MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = WORK( p ) / WORK( q )
- AQOAP = WORK( q ) / WORK( p )
- IF( WORK( p ).GE.ONE ) THEN
- IF( WORK( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q )*CS
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- END IF
- ELSE
- IF( WORK( q ).GE.ONE ) THEN
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- ELSE
- IF( WORK( p ).GE.WORK( q ) )
- $ THEN
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-* .. have to use modified Gram-Schmidt like transformation
- CALL SCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE, M,
- $ 1, WORK( N+1 ), LDA,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE, M,
- $ 1, A( 1, q ), LDA, IERR )
- TEMP1 = -AAPQ*WORK( p ) / WORK( q )
- CALL SAXPY( M, TEMP1, WORK( N+1 ), 1,
- $ A( 1, q ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAQQ, M,
- $ 1, A( 1, q ), LDA, IERR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q), SVA(p)
-* recompute SVA(q), SVA(p).
-*
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = SNRM2( M, A( 1, q ), 1 )*
- $ WORK( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*SQRT( AAQQ )*WORK( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 ).LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = SNRM2( M, A( 1, p ), 1 )*
- $ WORK( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*SQRT( AAPP )*WORK( p )
- END IF
- SVA( p ) = AAPP
- END IF
-*
- ELSE
-* A(:,p) and A(:,q) already numerically orthogonal
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
-*[RTD] SKIPPED = SKIPPED + 1
- PSKIPPED = PSKIPPED + 1
- END IF
- ELSE
-* A(:,q) is zero column
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- IF( ir1.EQ.0 )AAPP = -AAPP
- NOTROT = 0
- GO TO 2103
- END IF
-*
- 2002 CONTINUE
-* END q-LOOP
-*
- 2103 CONTINUE
-* bailed out of q-loop
-*
- SVA( p ) = AAPP
-*
- ELSE
- SVA( p ) = AAPP
- IF( ( ir1.EQ.0 ) .AND. ( AAPP.EQ.ZERO ) )
- $ NOTROT = NOTROT + MIN0( igl+KBL-1, N ) - p
- END IF
-*
- 2001 CONTINUE
-* end of the p-loop
-* end of doing the block ( ibr, ibr )
- 1002 CONTINUE
-* end of ir1-loop
-*
-* ... go to the off diagonal blocks
-*
- igl = ( ibr-1 )*KBL + 1
-*
- DO 2010 jbc = ibr + 1, NBL
-*
- jgl = ( jbc-1 )*KBL + 1
-*
-* doing the block at ( ibr, jbc )
-*
- IJBLSK = 0
- DO 2100 p = igl, MIN0( igl+KBL-1, N )
-*
- AAPP = SVA( p )
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2200 q = jgl, MIN0( jgl+KBL-1, N )
-*
- AAQQ = SVA( q )
- IF( AAQQ.GT.ZERO ) THEN
- AAPP0 = AAPP
-*
-* .. M x 2 Jacobi SVD ..
-*
-* Safe Gram matrix computation
-*
- IF( AAQQ.GE.ONE ) THEN
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- ELSE
- ROTOK = ( SMALL*AAQQ ).LE.AAPP
- END IF
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL SCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAPP,
- $ WORK( p ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = SDOT( M, WORK( N+1 ), 1,
- $ A( 1, q ), 1 )*WORK( q ) / AAQQ
- END IF
- ELSE
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- ELSE
- ROTOK = AAQQ.LE.( AAPP / SMALL )
- END IF
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*WORK( p )*WORK( q ) /
- $ AAQQ ) / AAPP
- ELSE
- CALL SCOPY( M, A( 1, q ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ,
- $ WORK( q ), M, 1,
- $ WORK( N+1 ), LDA, IERR )
- AAPQ = SDOT( M, WORK( N+1 ), 1,
- $ A( 1, p ), 1 )*WORK( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( ABS( AAPQ ).GT.TOL ) THEN
- NOTROT = 0
-*[RTD] ROTATED = ROTATED + 1
- PSKIPPED = 0
- ISWROT = ISWROT + 1
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*ABS( AQOAP-APOAQ ) / AAPQ
- IF( AAQQ.GT.AAPP0 )THETA = -THETA
-*
- IF( ABS( THETA ).GT.BIGTHETA ) THEN
- T = HALF / THETA
- FASTR( 3 ) = T*WORK( p ) / WORK( q )
- FASTR( 4 ) = -T*WORK( q ) /
- $ WORK( p )
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, ABS( T ) )
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -SIGN( ONE, AAPQ )
- IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
- T = ONE / ( THETA+THSIGN*
- $ SQRT( ONE+THETA*THETA ) )
- CS = SQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
- MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = WORK( p ) / WORK( q )
- AQOAP = WORK( q ) / WORK( p )
- IF( WORK( p ).GE.ONE ) THEN
-*
- IF( WORK( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q )*CS
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- END IF
- ELSE
- IF( WORK( q ).GE.ONE ) THEN
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- ELSE
- IF( WORK( p ).GE.WORK( q ) )
- $ THEN
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- WORK( p ) = WORK( p )*CS
- WORK( q ) = WORK( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- WORK( p ) = WORK( p ) / CS
- WORK( q ) = WORK( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
- IF( AAPP.GT.AAQQ ) THEN
- CALL SCOPY( M, A( 1, p ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, WORK( N+1 ), LDA,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*WORK( p ) / WORK( q )
- CALL SAXPY( M, TEMP1, WORK( N+1 ),
- $ 1, A( 1, q ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAQQ,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- ELSE
- CALL SCOPY( M, A( 1, q ), 1,
- $ WORK( N+1 ), 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, WORK( N+1 ), LDA,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*WORK( q ) / WORK( p )
- CALL SAXPY( M, TEMP1, WORK( N+1 ),
- $ 1, A( 1, p ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAPP,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- SVA( p ) = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- END IF
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q)
-* .. recompute SVA(q)
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = SNRM2( M, A( 1, q ), 1 )*
- $ WORK( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*SQRT( AAQQ )*WORK( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = SNRM2( M, A( 1, p ), 1 )*
- $ WORK( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*SQRT( AAPP )*WORK( p )
- END IF
- SVA( p ) = AAPP
- END IF
-* end of OK rotation
- ELSE
- NOTROT = NOTROT + 1
-*[RTD] SKIPPED = SKIPPED + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND. ( IJBLSK.GE.BLSKIP ) )
- $ THEN
- SVA( p ) = AAPP
- NOTROT = 0
- GO TO 2011
- END IF
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- AAPP = -AAPP
- NOTROT = 0
- GO TO 2203
- END IF
-*
- 2200 CONTINUE
-* end of the q-loop
- 2203 CONTINUE
-*
- SVA( p ) = AAPP
-*
- ELSE
-*
- IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
- $ MIN0( jgl+KBL-1, N ) - jgl + 1
- IF( AAPP.LT.ZERO )NOTROT = 0
-*
- END IF
-*
- 2100 CONTINUE
-* end of the p-loop
- 2010 CONTINUE
-* end of the jbc-loop
- 2011 CONTINUE
-*2011 bailed out of the jbc-loop
- DO 2012 p = igl, MIN0( igl+KBL-1, N )
- SVA( p ) = ABS( SVA( p ) )
- 2012 CONTINUE
-***
- 2000 CONTINUE
-*2000 :: end of the ibr-loop
-*
-* .. update SVA(N)
- IF( ( SVA( N ).LT.ROOTBIG ) .AND. ( SVA( N ).GT.ROOTSFMIN ) )
- $ THEN
- SVA( N ) = SNRM2( M, A( 1, N ), 1 )*WORK( N )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, N ), 1, T, AAPP )
- SVA( N ) = T*SQRT( AAPP )*WORK( N )
- END IF
-*
-* Additional steering devices
-*
- IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
- $ ( ISWROT.LE.N ) ) )SWBAND = i
-*
- IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.SQRT( FLOAT( N ) )*
- $ TOL ) .AND. ( FLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
- GO TO 1994
- END IF
-*
- IF( NOTROT.GE.EMPTSW )GO TO 1994
-*
- 1993 CONTINUE
-* end i=1:NSWEEP loop
-*
-* #:( Reaching this point means that the procedure has not converged.
- INFO = NSWEEP - 1
- GO TO 1995
-*
- 1994 CONTINUE
-* #:) Reaching this point means numerical convergence after the i-th
-* sweep.
-*
- INFO = 0
-* #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
-*
-* Sort the singular values and find how many are above
-* the underflow threshold.
-*
- N2 = 0
- N4 = 0
- DO 5991 p = 1, N - 1
- q = ISAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = WORK( p )
- WORK( p ) = WORK( q )
- WORK( q ) = TEMP1
- CALL SSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL SSWAP( MVL, V( 1, p ), 1, V( 1, q ), 1 )
- END IF
- IF( SVA( p ).NE.ZERO ) THEN
- N4 = N4 + 1
- IF( SVA( p )*SKL.GT.SFMIN )N2 = N2 + 1
- END IF
- 5991 CONTINUE
- IF( SVA( N ).NE.ZERO ) THEN
- N4 = N4 + 1
- IF( SVA( N )*SKL.GT.SFMIN )N2 = N2 + 1
- END IF
-*
-* Normalize the left singular vectors.
-*
- IF( LSVEC .OR. UCTOL ) THEN
- DO 1998 p = 1, N2
- CALL SSCAL( M, WORK( p ) / SVA( p ), A( 1, p ), 1 )
- 1998 CONTINUE
- END IF
-*
-* Scale the product of Jacobi rotations (assemble the fast rotations).
-*
- IF( RSVEC ) THEN
- IF( APPLV ) THEN
- DO 2398 p = 1, N
- CALL SSCAL( MVL, WORK( p ), V( 1, p ), 1 )
- 2398 CONTINUE
- ELSE
- DO 2399 p = 1, N
- TEMP1 = ONE / SNRM2( MVL, V( 1, p ), 1 )
- CALL SSCAL( MVL, TEMP1, V( 1, p ), 1 )
- 2399 CONTINUE
- END IF
- END IF
-*
-* Undo scaling, if necessary (and possible).
- IF( ( ( SKL.GT.ONE ) .AND. ( SVA( 1 ).LT.( BIG / SKL ) ) )
- $ .OR. ( ( SKL.LT.ONE ) .AND. ( SVA( MAX( N2, 1 ) ) .GT.
- $ ( SFMIN / SKL ) ) ) ) THEN
- DO 2400 p = 1, N
- SVA( P ) = SKL*SVA( P )
- 2400 CONTINUE
- SKL = ONE
- END IF
-*
- WORK( 1 ) = SKL
-* The singular values of A are SKL*SVA(1:N). If SKL.NE.ONE
-* then some of the singular values may overflow or underflow and
-* the spectrum is given in this factored representation.
-*
- WORK( 2 ) = FLOAT( N4 )
-* N4 is the number of computed nonzero singular values of A.
-*
- WORK( 3 ) = FLOAT( N2 )
-* N2 is the number of singular values of A greater than SFMIN.
-* If N2<N, SVA(N2:N) contains ZEROS and/or denormalized numbers
-* that may carry some information.
-*
- WORK( 4 ) = FLOAT( i )
-* i is the index of the last sweep before declaring convergence.
-*
- WORK( 5 ) = MXAAPQ
-* MXAAPQ is the largest absolute value of scaled pivots in the
-* last sweep
-*
- WORK( 6 ) = MXSINJ
-* MXSINJ is the largest absolute value of the sines of Jacobi angles
-* in the last sweep
-*
- RETURN
-* ..
-* .. END OF SGESVJ
-* ..
- END
diff --git a/netlib/LAPACK/sgesvx.f b/netlib/LAPACK/sgesvx.f
deleted file mode 100644
index 67938a9..0000000
--- a/netlib/LAPACK/sgesvx.f
+++ /dev/null
@@ -1,602 +0,0 @@
-*> \brief <b> SGESVX computes the solution to system of linear equations A * X = B for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
-* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, TRANS
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), C( * ), FERR( * ), R( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGESVX uses the LU factorization to compute the solution to a real
-*> system of linear equations
-*> A * X = B,
-*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
-*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*> or diag(C)*B (if TRANS = 'T' or 'C').
-*>
-*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*> matrix A (after equilibration if FACT = 'E') as
-*> A = P * L * U,
-*> where P is a permutation matrix, L is a unit lower triangular
-*> matrix, and U is upper triangular.
-*>
-*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*> that it solves the original system before equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AF and IPIV contain the factored form of A.
-*> If EQUED is not 'N', the matrix A has been
-*> equilibrated with scaling factors given by R and C.
-*> A, AF, and IPIV are not modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
-*> not 'N', then A must have been equilibrated by the scaling
-*> factors in R and/or C. A is not modified if FACT = 'F' or
-*> 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if EQUED .ne. 'N', A is scaled as follows:
-*> EQUED = 'R': A := diag(R) * A
-*> EQUED = 'C': A := A * diag(C)
-*> EQUED = 'B': A := diag(R) * A * diag(C).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the factors L and U from the factorization
-*> A = P*L*U as computed by SGETRF. If EQUED .ne. 'N', then
-*> AF is the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the factors L and U from the factorization A = P*L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then AF is an output argument and on exit
-*> returns the factors L and U from the factorization A = P*L*U
-*> of the equilibrated matrix A (see the description of A for
-*> the form of the equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the factorization A = P*L*U
-*> as computed by SGETRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = P*L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = P*L*U
-*> of the equilibrated matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is REAL array, dimension (N)
-*> The row scale factors for A. If EQUED = 'R' or 'B', A is
-*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*> is not accessed. R is an input argument if FACT = 'F';
-*> otherwise, R is an output argument. If FACT = 'F' and
-*> EQUED = 'R' or 'B', each element of R must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The column scale factors for A. If EQUED = 'C' or 'B', A is
-*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*> is not accessed. C is an input argument if FACT = 'F';
-*> otherwise, C is an output argument. If FACT = 'F' and
-*> EQUED = 'C' or 'B', each element of C must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit,
-*> if EQUED = 'N', B is not modified;
-*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*> diag(R)*B;
-*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*> overwritten by diag(C)*B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*> to the original system of equations. Note that A and B are
-*> modified on exit if EQUED .ne. 'N', and the solution to the
-*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*> and EQUED = 'R' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> On exit, WORK(1) contains the reciprocal pivot growth
-*> factor norm(A)/norm(U). The "max absolute element" norm is
-*> used. If WORK(1) is much less than 1, then the stability
-*> of the LU factorization of the (equilibrated) matrix A
-*> could be poor. This also means that the solution X, condition
-*> estimator RCOND, and forward error bound FERR could be
-*> unreliable. If factorization fails with 0<INFO<=N, then
-*> WORK(1) contains the reciprocal pivot growth factor for the
-*> leading INFO columns of A.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization has
-*> been completed, but the factor U is exactly
-*> singular, so the solution and error bounds
-*> could not be computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGEsolve
-*
-* =====================================================================
- SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
- $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, TRANS
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), C( * ), FERR( * ), R( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
- CHARACTER NORM
- INTEGER I, INFEQU, J
- REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
- $ ROWCND, RPVGRW, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANGE, SLANTR
- EXTERNAL LSAME, SLAMCH, SLANGE, SLANTR
-* ..
-* .. External Subroutines ..
- EXTERNAL SGECON, SGEEQU, SGERFS, SGETRF, SGETRS, SLACPY,
- $ SLAQGE, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- ROWEQU = .FALSE.
- COLEQU = .FALSE.
- ELSE
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- SMLNUM = SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -10
- ELSE
- IF( ROWEQU ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 10 J = 1, N
- RCMIN = MIN( RCMIN, R( J ) )
- RCMAX = MAX( RCMAX, R( J ) )
- 10 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -11
- ELSE IF( N.GT.0 ) THEN
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- ROWCND = ONE
- END IF
- END IF
- IF( COLEQU .AND. INFO.EQ.0 ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 20 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 20 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -12
- ELSE IF( N.GT.0 ) THEN
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- COLCND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -16
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGESVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL SGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL SLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ EQUED )
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( NOTRAN ) THEN
- IF( ROWEQU ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = R( I )*B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( COLEQU ) THEN
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- B( I, J ) = C( I )*B( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the LU factorization of A.
-*
- CALL SLACPY( 'Full', N, N, A, LDA, AF, LDAF )
- CALL SGETRF( N, N, AF, LDAF, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 ) THEN
-*
-* Compute the reciprocal pivot growth factor of the
-* leading rank-deficient INFO columns of A.
-*
- RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF,
- $ WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = SLANGE( 'M', N, INFO, A, LDA, WORK ) / RPVGRW
- END IF
- WORK( 1 ) = RPVGRW
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A and the
-* reciprocal pivot growth factor RPVGRW.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = SLANGE( NORM, N, N, A, LDA, WORK )
- RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AF, LDAF, WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) / RPVGRW
- END IF
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( NOTRAN ) THEN
- IF( COLEQU ) THEN
- DO 80 J = 1, NRHS
- DO 70 I = 1, N
- X( I, J ) = C( I )*X( I, J )
- 70 CONTINUE
- 80 CONTINUE
- DO 90 J = 1, NRHS
- FERR( J ) = FERR( J ) / COLCND
- 90 CONTINUE
- END IF
- ELSE IF( ROWEQU ) THEN
- DO 110 J = 1, NRHS
- DO 100 I = 1, N
- X( I, J ) = R( I )*X( I, J )
- 100 CONTINUE
- 110 CONTINUE
- DO 120 J = 1, NRHS
- FERR( J ) = FERR( J ) / ROWCND
- 120 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- WORK( 1 ) = RPVGRW
- RETURN
-*
-* End of SGESVX
-*
- END
diff --git a/netlib/LAPACK/sgetc2.f b/netlib/LAPACK/sgetc2.f
deleted file mode 100644
index 7e9d485..0000000
--- a/netlib/LAPACK/sgetc2.f
+++ /dev/null
@@ -1,211 +0,0 @@
-*> \brief \b SGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETC2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgetc2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgetc2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgetc2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), JPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGETC2 computes an LU factorization with complete pivoting of the
-*> n-by-n matrix A. The factorization has the form A = P * L * U * Q,
-*> where P and Q are permutation matrices, L is lower triangular with
-*> unit diagonal elements and U is upper triangular.
-*>
-*> This is the Level 2 BLAS algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the n-by-n matrix A to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U*Q; the unit diagonal elements of L are not stored.
-*> If U(k, k) appears to be less than SMIN, U(k, k) is given the
-*> value of SMIN, i.e., giving a nonsingular perturbed system.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension(N).
-*> The pivot indices; for 1 <= i <= N, row i of the
-*> matrix has been interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] JPIV
-*> \verbatim
-*> JPIV is INTEGER array, dimension(N).
-*> The pivot indices; for 1 <= j <= N, column j of the
-*> matrix has been interchanged with column JPIV(j).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = k, U(k, k) is likely to produce owerflow if
-*> we try to solve for x in Ax = b. So U is perturbed to
-*> avoid the overflow.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
- SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IP, IPV, J, JP, JPV
- REAL BIGNUM, EPS, SMIN, SMLNUM, XMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGER, SLABAD, SSWAP
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Set constants to control overflow
-*
- INFO = 0
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Factorize A using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- DO 40 I = 1, N - 1
-*
-* Find max element in matrix A
-*
- XMAX = ZERO
- DO 20 IP = I, N
- DO 10 JP = I, N
- IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
- XMAX = ABS( A( IP, JP ) )
- IPV = IP
- JPV = JP
- END IF
- 10 CONTINUE
- 20 CONTINUE
- IF( I.EQ.1 )
- $ SMIN = MAX( EPS*XMAX, SMLNUM )
-*
-* Swap rows
-*
- IF( IPV.NE.I )
- $ CALL SSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA )
- IPIV( I ) = IPV
-*
-* Swap columns
-*
- IF( JPV.NE.I )
- $ CALL SSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 )
- JPIV( I ) = JPV
-*
-* Check for singularity
-*
- IF( ABS( A( I, I ) ).LT.SMIN ) THEN
- INFO = I
- A( I, I ) = SMIN
- END IF
- DO 30 J = I + 1, N
- A( J, I ) = A( J, I ) / A( I, I )
- 30 CONTINUE
- CALL SGER( N-I, N-I, -ONE, A( I+1, I ), 1, A( I, I+1 ), LDA,
- $ A( I+1, I+1 ), LDA )
- 40 CONTINUE
-*
- IF( ABS( A( N, N ) ).LT.SMIN ) THEN
- INFO = N
- A( N, N ) = SMIN
- END IF
-*
- RETURN
-*
-* End of SGETC2
-*
- END
diff --git a/netlib/LAPACK/sgetf2.f b/netlib/LAPACK/sgetf2.f
deleted file mode 100644
index 4b31027..0000000
--- a/netlib/LAPACK/sgetf2.f
+++ /dev/null
@@ -1,213 +0,0 @@
-*> \brief \b SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgetf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgetf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgetf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGETF2 computes an LU factorization of a general m-by-n matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> The factorization has the form
-*> A = P * L * U
-*> where P is a permutation matrix, L is lower triangular with unit
-*> diagonal elements (lower trapezoidal if m > n), and U is upper
-*> triangular (upper trapezoidal if m < n).
-*>
-*> This is the right-looking Level 2 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL SFMIN
- INTEGER I, J, JP
-* ..
-* .. External Functions ..
- REAL SLAMCH
- INTEGER ISAMAX
- EXTERNAL SLAMCH, ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGER, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = SLAMCH('S')
-*
- DO 10 J = 1, MIN( M, N )
-*
-* Find pivot and test for singularity.
-*
- JP = J - 1 + ISAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
- IF( A( JP, J ).NE.ZERO ) THEN
-*
-* Apply the interchange to columns 1:N.
-*
- IF( JP.NE.J )
- $ CALL SSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-* Compute elements J+1:M of J-th column.
-*
- IF( J.LT.M ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL SSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO 20 I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- 20 CONTINUE
- END IF
- END IF
-*
- ELSE IF( INFO.EQ.0 ) THEN
-*
- INFO = J
- END IF
-*
- IF( J.LT.MIN( M, N ) ) THEN
-*
-* Update trailing submatrix.
-*
- CALL SGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,
- $ A( J+1, J+1 ), LDA )
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of SGETF2
-*
- END
diff --git a/netlib/LAPACK/sgetrf.f b/netlib/LAPACK/sgetrf.f
deleted file mode 100644
index b7ac344..0000000
--- a/netlib/LAPACK/sgetrf.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b SGETRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgetrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgetrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgetrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGETRF computes an LU factorization of a general M-by-N matrix A
-*> using partial pivoting with row interchanges.
-*>
-*> The factorization has the form
-*> A = P * L * U
-*> where P is a permutation matrix, L is lower triangular with unit
-*> diagonal elements (lower trapezoidal if m > n), and U is upper
-*> triangular (upper trapezoidal if m < n).
-*>
-*> This is the right-looking Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGETF2, SLASWP, STRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL SGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL SGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to columns 1:J-1.
-*
- CALL SLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF( J+JB.LE.N ) THEN
-*
-* Apply interchanges to columns J+JB:N.
-*
- CALL SLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
- $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
- $ LDA )
- IF( J+JB.LE.M ) THEN
-*
-* Update trailing submatrix.
-*
- CALL SGEMM( 'No transpose', 'No transpose', M-J-JB+1,
- $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
- $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
- $ LDA )
- END IF
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of SGETRF
-*
- END
diff --git a/netlib/LAPACK/sgetri.f b/netlib/LAPACK/sgetri.f
deleted file mode 100644
index 15a8374..0000000
--- a/netlib/LAPACK/sgetri.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b SGETRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgetri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgetri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgetri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGETRI computes the inverse of a matrix using the LU factorization
-*> computed by SGETRF.
-*>
-*> This method inverts U and then computes inv(A) by solving the system
-*> inv(A)*L = inv(U) for inv(A).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the factors L and U from the factorization
-*> A = P*L*U as computed by SGETRF.
-*> On exit, if INFO = 0, the inverse of the original matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from SGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimal performance LWORK >= N*NB, where NB is
-*> the optimal blocksize returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
-*> singular and its inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
- $ NBMIN, NN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NB = ILAENV( 1, 'SGETRI', ' ', N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRI', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form inv(U). If INFO > 0 from STRTRI, then U is singular,
-* and the inverse is not computed.
-*
- CALL STRTRI( 'Upper', 'Non-unit', N, A, LDA, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
- NBMIN = 2
- LDWORK = N
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
- IWS = MAX( LDWORK*NB, 1 )
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGETRI', ' ', N, -1, -1, -1 ) )
- END IF
- ELSE
- IWS = N
- END IF
-*
-* Solve the equation inv(A)*L = inv(U) for inv(A).
-*
- IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- DO 20 J = N, 1, -1
-*
-* Copy current column of L to WORK and replace with zeros.
-*
- DO 10 I = J + 1, N
- WORK( I ) = A( I, J )
- A( I, J ) = ZERO
- 10 CONTINUE
-*
-* Compute current column of inv(A).
-*
- IF( J.LT.N )
- $ CALL SGEMV( 'No transpose', N, N-J, -ONE, A( 1, J+1 ),
- $ LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 )
- 20 CONTINUE
- ELSE
-*
-* Use blocked code.
-*
- NN = ( ( N-1 ) / NB )*NB + 1
- DO 50 J = NN, 1, -NB
- JB = MIN( NB, N-J+1 )
-*
-* Copy current block column of L to WORK and replace with
-* zeros.
-*
- DO 40 JJ = J, J + JB - 1
- DO 30 I = JJ + 1, N
- WORK( I+( JJ-J )*LDWORK ) = A( I, JJ )
- A( I, JJ ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Compute current block column of inv(A).
-*
- IF( J+JB.LE.N )
- $ CALL SGEMM( 'No transpose', 'No transpose', N, JB,
- $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA,
- $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA )
- CALL STRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB,
- $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA )
- 50 CONTINUE
- END IF
-*
-* Apply column interchanges.
-*
- DO 60 J = N - 1, 1, -1
- JP = IPIV( J )
- IF( JP.NE.J )
- $ CALL SSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
- 60 CONTINUE
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SGETRI
-*
- END
diff --git a/netlib/LAPACK/sgetrs.f b/netlib/LAPACK/sgetrs.f
deleted file mode 100644
index caa4567..0000000
--- a/netlib/LAPACK/sgetrs.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b SGETRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgetrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgetrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgetrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGETRS solves a system of linear equations
-*> A * X = B or A**T * X = B
-*> with a general N-by-N matrix A using the LU factorization computed
-*> by SGETRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by SGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from SGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASWP, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * X = B.
-*
-* Apply row interchanges to the right hand sides.
-*
- CALL SLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A**T * X = B.
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
- $ A, LDA, B, LDB )
-*
-* Apply row interchanges to the solution vectors.
-*
- CALL SLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
- END IF
-*
- RETURN
-*
-* End of SGETRS
-*
- END
diff --git a/netlib/LAPACK/sggbak.f b/netlib/LAPACK/sggbak.f
deleted file mode 100644
index f10895c..0000000
--- a/netlib/LAPACK/sggbak.f
+++ /dev/null
@@ -1,306 +0,0 @@
-*> \brief \b SGGBAK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGBAK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggbak.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggbak.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggbak.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
-* LDV, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB, SIDE
-* INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
-* REAL LSCALE( * ), RSCALE( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGBAK forms the right or left eigenvectors of a real generalized
-*> eigenvalue problem A*x = lambda*B*x, by backward transformation on
-*> the computed eigenvectors of the balanced pair of matrices output by
-*> SGGBAL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the type of backward transformation required:
-*> = 'N': do nothing, return immediately;
-*> = 'P': do backward transformation for permutation only;
-*> = 'S': do backward transformation for scaling only;
-*> = 'B': do backward transformations for both permutation and
-*> scaling.
-*> JOB must be the same as the argument JOB supplied to SGGBAL.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': V contains right eigenvectors;
-*> = 'L': V contains left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrix V. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> The integers ILO and IHI determined by SGGBAL.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in] LSCALE
-*> \verbatim
-*> LSCALE is REAL array, dimension (N)
-*> Details of the permutations and/or scaling factors applied
-*> to the left side of A and B, as returned by SGGBAL.
-*> \endverbatim
-*>
-*> \param[in] RSCALE
-*> \verbatim
-*> RSCALE is REAL array, dimension (N)
-*> Details of the permutations and/or scaling factors applied
-*> to the right side of A and B, as returned by SGGBAL.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix V. M >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,M)
-*> On entry, the matrix of right or left eigenvectors to be
-*> transformed, as returned by STGEVC.
-*> On exit, V is overwritten by the transformed eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the matrix V. LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> See R.C. Ward, Balancing the generalized eigenvalue problem,
-*> SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
- $ LDV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB, SIDE
- INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
- REAL LSCALE( * ), RSCALE( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFTV, RIGHTV
- INTEGER I, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- RIGHTV = LSAME( SIDE, 'R' )
- LEFTV = LSAME( SIDE, 'L' )
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 ) THEN
- INFO = -4
- ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
- INFO = -4
- ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
- $ THEN
- INFO = -5
- ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -8
- ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGBAK', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( M.EQ.0 )
- $ RETURN
- IF( LSAME( JOB, 'N' ) )
- $ RETURN
-*
- IF( ILO.EQ.IHI )
- $ GO TO 30
-*
-* Backward balance
-*
- IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-* Backward transformation on right eigenvectors
-*
- IF( RIGHTV ) THEN
- DO 10 I = ILO, IHI
- CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
- 10 CONTINUE
- END IF
-*
-* Backward transformation on left eigenvectors
-*
- IF( LEFTV ) THEN
- DO 20 I = ILO, IHI
- CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
- 20 CONTINUE
- END IF
- END IF
-*
-* Backward permutation
-*
- 30 CONTINUE
- IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-* Backward permutation on right eigenvectors
-*
- IF( RIGHTV ) THEN
- IF( ILO.EQ.1 )
- $ GO TO 50
-*
- DO 40 I = ILO - 1, 1, -1
- K = RSCALE( I )
- IF( K.EQ.I )
- $ GO TO 40
- CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 40 CONTINUE
-*
- 50 CONTINUE
- IF( IHI.EQ.N )
- $ GO TO 70
- DO 60 I = IHI + 1, N
- K = RSCALE( I )
- IF( K.EQ.I )
- $ GO TO 60
- CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 60 CONTINUE
- END IF
-*
-* Backward permutation on left eigenvectors
-*
- 70 CONTINUE
- IF( LEFTV ) THEN
- IF( ILO.EQ.1 )
- $ GO TO 90
- DO 80 I = ILO - 1, 1, -1
- K = LSCALE( I )
- IF( K.EQ.I )
- $ GO TO 80
- CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 80 CONTINUE
-*
- 90 CONTINUE
- IF( IHI.EQ.N )
- $ GO TO 110
- DO 100 I = IHI + 1, N
- K = LSCALE( I )
- IF( K.EQ.I )
- $ GO TO 100
- CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 100 CONTINUE
- END IF
- END IF
-*
- 110 CONTINUE
-*
- RETURN
-*
-* End of SGGBAK
-*
- END
diff --git a/netlib/LAPACK/sggbal.f b/netlib/LAPACK/sggbal.f
deleted file mode 100644
index 31b18e9..0000000
--- a/netlib/LAPACK/sggbal.f
+++ /dev/null
@@ -1,559 +0,0 @@
-*> \brief \b SGGBAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGBAL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggbal.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggbal.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggbal.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
-* RSCALE, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER IHI, ILO, INFO, LDA, LDB, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), LSCALE( * ),
-* $ RSCALE( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGBAL balances a pair of general real matrices (A,B). This
-*> involves, first, permuting A and B by similarity transformations to
-*> isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
-*> elements on the diagonal; and second, applying a diagonal similarity
-*> transformation to rows and columns ILO to IHI to make the rows
-*> and columns as close in norm as possible. Both steps are optional.
-*>
-*> Balancing may reduce the 1-norm of the matrices, and improve the
-*> accuracy of the computed eigenvalues and/or eigenvectors in the
-*> generalized eigenvalue problem A*x = lambda*B*x.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the operations to be performed on A and B:
-*> = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
-*> and RSCALE(I) = 1.0 for i = 1,...,N.
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the input matrix A.
-*> On exit, A is overwritten by the balanced matrix.
-*> If JOB = 'N', A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the input matrix B.
-*> On exit, B is overwritten by the balanced matrix.
-*> If JOB = 'N', B is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are set to integers such that on exit
-*> A(i,j) = 0 and B(i,j) = 0 if i > j and
-*> j = 1,...,ILO-1 or i = IHI+1,...,N.
-*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] LSCALE
-*> \verbatim
-*> LSCALE is REAL array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the left side of A and B. If P(j) is the index of the
-*> row interchanged with row j, and D(j)
-*> is the scaling factor applied to row j, then
-*> LSCALE(j) = P(j) for J = 1,...,ILO-1
-*> = D(j) for J = ILO,...,IHI
-*> = P(j) for J = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] RSCALE
-*> \verbatim
-*> RSCALE is REAL array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the right side of A and B. If P(j) is the index of the
-*> column interchanged with column j, and D(j)
-*> is the scaling factor applied to column j, then
-*> LSCALE(j) = P(j) for J = 1,...,ILO-1
-*> = D(j) for J = ILO,...,IHI
-*> = P(j) for J = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (lwork)
-*> lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
-*> at least 1 when JOB = 'N' or 'P'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> See R.C. WARD, Balancing the generalized eigenvalue problem,
-*> SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
- $ RSCALE, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), LSCALE( * ),
- $ RSCALE( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 )
- REAL THREE, SCLFAC
- PARAMETER ( THREE = 3.0E+0, SCLFAC = 1.0E+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ICAB, IFLOW, IP1, IR, IRAB, IT, J, JC, JP1,
- $ K, KOUNT, L, LCAB, LM1, LRAB, LSFMAX, LSFMIN,
- $ M, NR, NRP2
- REAL ALPHA, BASL, BETA, CAB, CMAX, COEF, COEF2,
- $ COEF5, COR, EW, EWC, GAMMA, PGAMMA, RAB, SFMAX,
- $ SFMIN, SUM, T, TA, TB, TC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SDOT, SLAMCH
- EXTERNAL LSAME, ISAMAX, SDOT, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG10, MAX, MIN, REAL, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGBAL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- ILO = 1
- IHI = N
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- ILO = 1
- IHI = N
- LSCALE( 1 ) = ONE
- RSCALE( 1 ) = ONE
- RETURN
- END IF
-*
- IF( LSAME( JOB, 'N' ) ) THEN
- ILO = 1
- IHI = N
- DO 10 I = 1, N
- LSCALE( I ) = ONE
- RSCALE( I ) = ONE
- 10 CONTINUE
- RETURN
- END IF
-*
- K = 1
- L = N
- IF( LSAME( JOB, 'S' ) )
- $ GO TO 190
-*
- GO TO 30
-*
-* Permute the matrices A and B to isolate the eigenvalues.
-*
-* Find row with one nonzero in columns 1 through L
-*
- 20 CONTINUE
- L = LM1
- IF( L.NE.1 )
- $ GO TO 30
-*
- RSCALE( 1 ) = ONE
- LSCALE( 1 ) = ONE
- GO TO 190
-*
- 30 CONTINUE
- LM1 = L - 1
- DO 80 I = L, 1, -1
- DO 40 J = 1, LM1
- JP1 = J + 1
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 50
- 40 CONTINUE
- J = L
- GO TO 70
-*
- 50 CONTINUE
- DO 60 J = JP1, L
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 80
- 60 CONTINUE
- J = JP1 - 1
-*
- 70 CONTINUE
- M = L
- IFLOW = 1
- GO TO 160
- 80 CONTINUE
- GO TO 100
-*
-* Find column with one nonzero in rows K through N
-*
- 90 CONTINUE
- K = K + 1
-*
- 100 CONTINUE
- DO 150 J = K, L
- DO 110 I = K, LM1
- IP1 = I + 1
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 120
- 110 CONTINUE
- I = L
- GO TO 140
- 120 CONTINUE
- DO 130 I = IP1, L
- IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
- $ GO TO 150
- 130 CONTINUE
- I = IP1 - 1
- 140 CONTINUE
- M = K
- IFLOW = 2
- GO TO 160
- 150 CONTINUE
- GO TO 190
-*
-* Permute rows M and I
-*
- 160 CONTINUE
- LSCALE( M ) = I
- IF( I.EQ.M )
- $ GO TO 170
- CALL SSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
- CALL SSWAP( N-K+1, B( I, K ), LDB, B( M, K ), LDB )
-*
-* Permute columns M and J
-*
- 170 CONTINUE
- RSCALE( M ) = J
- IF( J.EQ.M )
- $ GO TO 180
- CALL SSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
- CALL SSWAP( L, B( 1, J ), 1, B( 1, M ), 1 )
-*
- 180 CONTINUE
- GO TO ( 20, 90 )IFLOW
-*
- 190 CONTINUE
- ILO = K
- IHI = L
-*
- IF( LSAME( JOB, 'P' ) ) THEN
- DO 195 I = ILO, IHI
- LSCALE( I ) = ONE
- RSCALE( I ) = ONE
- 195 CONTINUE
- RETURN
- END IF
-*
- IF( ILO.EQ.IHI )
- $ RETURN
-*
-* Balance the submatrix in rows ILO to IHI.
-*
- NR = IHI - ILO + 1
- DO 200 I = ILO, IHI
- RSCALE( I ) = ZERO
- LSCALE( I ) = ZERO
-*
- WORK( I ) = ZERO
- WORK( I+N ) = ZERO
- WORK( I+2*N ) = ZERO
- WORK( I+3*N ) = ZERO
- WORK( I+4*N ) = ZERO
- WORK( I+5*N ) = ZERO
- 200 CONTINUE
-*
-* Compute right side vector in resulting linear equations
-*
- BASL = LOG10( SCLFAC )
- DO 240 I = ILO, IHI
- DO 230 J = ILO, IHI
- TB = B( I, J )
- TA = A( I, J )
- IF( TA.EQ.ZERO )
- $ GO TO 210
- TA = LOG10( ABS( TA ) ) / BASL
- 210 CONTINUE
- IF( TB.EQ.ZERO )
- $ GO TO 220
- TB = LOG10( ABS( TB ) ) / BASL
- 220 CONTINUE
- WORK( I+4*N ) = WORK( I+4*N ) - TA - TB
- WORK( J+5*N ) = WORK( J+5*N ) - TA - TB
- 230 CONTINUE
- 240 CONTINUE
-*
- COEF = ONE / REAL( 2*NR )
- COEF2 = COEF*COEF
- COEF5 = HALF*COEF2
- NRP2 = NR + 2
- BETA = ZERO
- IT = 1
-*
-* Start generalized conjugate gradient iteration
-*
- 250 CONTINUE
-*
- GAMMA = SDOT( NR, WORK( ILO+4*N ), 1, WORK( ILO+4*N ), 1 ) +
- $ SDOT( NR, WORK( ILO+5*N ), 1, WORK( ILO+5*N ), 1 )
-*
- EW = ZERO
- EWC = ZERO
- DO 260 I = ILO, IHI
- EW = EW + WORK( I+4*N )
- EWC = EWC + WORK( I+5*N )
- 260 CONTINUE
-*
- GAMMA = COEF*GAMMA - COEF2*( EW**2+EWC**2 ) - COEF5*( EW-EWC )**2
- IF( GAMMA.EQ.ZERO )
- $ GO TO 350
- IF( IT.NE.1 )
- $ BETA = GAMMA / PGAMMA
- T = COEF5*( EWC-THREE*EW )
- TC = COEF5*( EW-THREE*EWC )
-*
- CALL SSCAL( NR, BETA, WORK( ILO ), 1 )
- CALL SSCAL( NR, BETA, WORK( ILO+N ), 1 )
-*
- CALL SAXPY( NR, COEF, WORK( ILO+4*N ), 1, WORK( ILO+N ), 1 )
- CALL SAXPY( NR, COEF, WORK( ILO+5*N ), 1, WORK( ILO ), 1 )
-*
- DO 270 I = ILO, IHI
- WORK( I ) = WORK( I ) + TC
- WORK( I+N ) = WORK( I+N ) + T
- 270 CONTINUE
-*
-* Apply matrix to vector
-*
- DO 300 I = ILO, IHI
- KOUNT = 0
- SUM = ZERO
- DO 290 J = ILO, IHI
- IF( A( I, J ).EQ.ZERO )
- $ GO TO 280
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( J )
- 280 CONTINUE
- IF( B( I, J ).EQ.ZERO )
- $ GO TO 290
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( J )
- 290 CONTINUE
- WORK( I+2*N ) = REAL( KOUNT )*WORK( I+N ) + SUM
- 300 CONTINUE
-*
- DO 330 J = ILO, IHI
- KOUNT = 0
- SUM = ZERO
- DO 320 I = ILO, IHI
- IF( A( I, J ).EQ.ZERO )
- $ GO TO 310
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( I+N )
- 310 CONTINUE
- IF( B( I, J ).EQ.ZERO )
- $ GO TO 320
- KOUNT = KOUNT + 1
- SUM = SUM + WORK( I+N )
- 320 CONTINUE
- WORK( J+3*N ) = REAL( KOUNT )*WORK( J ) + SUM
- 330 CONTINUE
-*
- SUM = SDOT( NR, WORK( ILO+N ), 1, WORK( ILO+2*N ), 1 ) +
- $ SDOT( NR, WORK( ILO ), 1, WORK( ILO+3*N ), 1 )
- ALPHA = GAMMA / SUM
-*
-* Determine correction to current iteration
-*
- CMAX = ZERO
- DO 340 I = ILO, IHI
- COR = ALPHA*WORK( I+N )
- IF( ABS( COR ).GT.CMAX )
- $ CMAX = ABS( COR )
- LSCALE( I ) = LSCALE( I ) + COR
- COR = ALPHA*WORK( I )
- IF( ABS( COR ).GT.CMAX )
- $ CMAX = ABS( COR )
- RSCALE( I ) = RSCALE( I ) + COR
- 340 CONTINUE
- IF( CMAX.LT.HALF )
- $ GO TO 350
-*
- CALL SAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 )
- CALL SAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 )
-*
- PGAMMA = GAMMA
- IT = IT + 1
- IF( IT.LE.NRP2 )
- $ GO TO 250
-*
-* End generalized conjugate gradient iteration
-*
- 350 CONTINUE
- SFMIN = SLAMCH( 'S' )
- SFMAX = ONE / SFMIN
- LSFMIN = INT( LOG10( SFMIN ) / BASL+ONE )
- LSFMAX = INT( LOG10( SFMAX ) / BASL )
- DO 360 I = ILO, IHI
- IRAB = ISAMAX( N-ILO+1, A( I, ILO ), LDA )
- RAB = ABS( A( I, IRAB+ILO-1 ) )
- IRAB = ISAMAX( N-ILO+1, B( I, ILO ), LDB )
- RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
- LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
- IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
- IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB )
- LSCALE( I ) = SCLFAC**IR
- ICAB = ISAMAX( IHI, A( 1, I ), 1 )
- CAB = ABS( A( ICAB, I ) )
- ICAB = ISAMAX( IHI, B( 1, I ), 1 )
- CAB = MAX( CAB, ABS( B( ICAB, I ) ) )
- LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE )
- JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) )
- JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB )
- RSCALE( I ) = SCLFAC**JC
- 360 CONTINUE
-*
-* Row scaling of matrices A and B
-*
- DO 370 I = ILO, IHI
- CALL SSCAL( N-ILO+1, LSCALE( I ), A( I, ILO ), LDA )
- CALL SSCAL( N-ILO+1, LSCALE( I ), B( I, ILO ), LDB )
- 370 CONTINUE
-*
-* Column scaling of matrices A and B
-*
- DO 380 J = ILO, IHI
- CALL SSCAL( IHI, RSCALE( J ), A( 1, J ), 1 )
- CALL SSCAL( IHI, RSCALE( J ), B( 1, J ), 1 )
- 380 CONTINUE
-*
- RETURN
-*
-* End of SGGBAL
-*
- END
diff --git a/netlib/LAPACK/sgges.f b/netlib/LAPACK/sgges.f
deleted file mode 100644
index 2f686a2..0000000
--- a/netlib/LAPACK/sgges.f
+++ /dev/null
@@ -1,680 +0,0 @@
-*> \brief <b> SGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGES + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgges.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgges.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgges.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
-* SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
-* LDVSR, WORK, LWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVSL, JOBVSR, SORT
-* INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
-* $ VSR( LDVSR, * ), WORK( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELCTG
-* EXTERNAL SELCTG
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
-*> the generalized eigenvalues, the generalized real Schur form (S,T),
-*> optionally, the left and/or right matrices of Schur vectors (VSL and
-*> VSR). This gives the generalized Schur factorization
-*>
-*> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
-*>
-*> Optionally, it also orders the eigenvalues so that a selected cluster
-*> of eigenvalues appears in the leading diagonal blocks of the upper
-*> quasi-triangular matrix S and the upper triangular matrix T.The
-*> leading columns of VSL and VSR then form an orthonormal basis for the
-*> corresponding left and right eigenspaces (deflating subspaces).
-*>
-*> (If only the generalized eigenvalues are needed, use the driver
-*> SGGEV instead, which is faster.)
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
-*> or a ratio alpha/beta = w, such that A - w*B is singular. It is
-*> usually represented as the pair (alpha,beta), as there is a
-*> reasonable interpretation for beta=0 or both being zero.
-*>
-*> A pair of matrices (S,T) is in generalized real Schur form if T is
-*> upper triangular with non-negative diagonal and S is block upper
-*> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
-*> to real generalized eigenvalues, while 2-by-2 blocks of S will be
-*> "standardized" by making the corresponding elements of T have the
-*> form:
-*> [ a 0 ]
-*> [ 0 b ]
-*>
-*> and the pair of corresponding 2-by-2 blocks in S and T will have a
-*> complex conjugate pair of generalized eigenvalues.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVSL
-*> \verbatim
-*> JOBVSL is CHARACTER*1
-*> = 'N': do not compute the left Schur vectors;
-*> = 'V': compute the left Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVSR
-*> \verbatim
-*> JOBVSR is CHARACTER*1
-*> = 'N': do not compute the right Schur vectors;
-*> = 'V': compute the right Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the generalized Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELCTG);
-*> \endverbatim
-*>
-*> \param[in] SELCTG
-*> \verbatim
-*> SELCTG is a LOGICAL FUNCTION of three REAL arguments
-*> SELCTG must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'N', SELCTG is not referenced.
-*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
-*> SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
-*> one of a complex conjugate pair of eigenvalues is selected,
-*> then both complex eigenvalues are selected.
-*>
-*> Note that in the ill-conditioned case, a selected complex
-*> eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
-*> BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
-*> in this case.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VSL, and VSR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the first of the pair of matrices.
-*> On exit, A has been overwritten by its generalized Schur
-*> form S.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the second of the pair of matrices.
-*> On exit, B has been overwritten by its generalized Schur
-*> form T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELCTG is true. (Complex conjugate pairs for which
-*> SELCTG is true for either eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
-*> and BETA(j),j=1,...,N are the diagonals of the complex Schur
-*> form (S,T) that would result if the 2-by-2 diagonal blocks of
-*> the real Schur form of (A,B) were further reduced to
-*> triangular form using 2-by-2 complex unitary transformations.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio.
-*> However, ALPHAR and ALPHAI will be always less than and
-*> usually comparable with norm(A) in magnitude, and BETA always
-*> less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VSL
-*> \verbatim
-*> VSL is REAL array, dimension (LDVSL,N)
-*> If JOBVSL = 'V', VSL will contain the left Schur vectors.
-*> Not referenced if JOBVSL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSL
-*> \verbatim
-*> LDVSL is INTEGER
-*> The leading dimension of the matrix VSL. LDVSL >=1, and
-*> if JOBVSL = 'V', LDVSL >= N.
-*> \endverbatim
-*>
-*> \param[out] VSR
-*> \verbatim
-*> VSR is REAL array, dimension (LDVSR,N)
-*> If JOBVSR = 'V', VSR will contain the right Schur vectors.
-*> Not referenced if JOBVSR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSR
-*> \verbatim
-*> LDVSR is INTEGER
-*> The leading dimension of the matrix VSR. LDVSR >= 1, and
-*> if JOBVSR = 'V', LDVSR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N = 0, LWORK >= 1, else LWORK >= max(8*N,6*N+16).
-*> For good performance , LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. (A,B) are not in Schur
-*> form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*> be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in SHGEQZ.
-*> =N+2: after reordering, roundoff changed values of
-*> some complex eigenvalues so that leading
-*> eigenvalues in the Generalized Schur form no
-*> longer satisfy SELCTG=.TRUE. This could also
-*> be caused due to scaling.
-*> =N+3: reordering failed in STGSEN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
- $ SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
- $ LDVSR, WORK, LWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVSL, JOBVSR, SORT
- INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
- $ VSR( LDVSR, * ), WORK( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELCTG
- EXTERNAL SELCTG
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, LST2SL, WANTST
- INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
- $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, MAXWRK,
- $ MINWRK
- REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
- $ PVSR, SAFMAX, SAFMIN, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER IDUM( 1 )
- REAL DIF( 2 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD,
- $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGSEN,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVSL, 'N' ) ) THEN
- IJOBVL = 1
- ILVSL = .FALSE.
- ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
- IJOBVL = 2
- ILVSL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVSL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVSR, 'N' ) ) THEN
- IJOBVR = 1
- ILVSR = .FALSE.
- ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
- IJOBVR = 2
- ILVSR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVSR = .FALSE.
- END IF
-*
- WANTST = LSAME( SORT, 'S' )
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
- INFO = -15
- ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
- INFO = -17
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.GT.0 )THEN
- MINWRK = MAX( 8*N, 6*N + 16 )
- MAXWRK = MINWRK - N +
- $ N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 )
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, -1 ) )
- IF( ILVSL ) THEN
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) )
- END IF
- ELSE
- MINWRK = 1
- MAXWRK = 1
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -19
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGES ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SAFMIN = SLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- CALL SLABAD( SAFMIN, SAFMAX )
- SMLNUM = SQRT( SAFMIN ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL SLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = SLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL SLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (Workspace: need 6*N + 2*N space for storing balancing factors)
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWRK = IRIGHT + N
- CALL SGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB)
-*
- IROWS = IHI + 1 - ILO
- ICOLS = N + 1 - ILO
- ITAU = IWRK
- IWRK = ITAU + IROWS
- CALL SGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to matrix A
-* (Workspace: need N, prefer N*NB)
-*
- CALL SORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VSL
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVSL ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
- IF( IROWS.GT.1 ) THEN
- CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VSL( ILO+1, ILO ), LDVSL )
- END IF
- CALL SORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
-* Initialize VSR
-*
- IF( ILVSR )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- CALL SGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
- $ LDVSL, VSR, LDVSR, IERR )
-*
-* Perform QZ algorithm, computing Schur vectors if desired
-* (Workspace: need N)
-*
- IWRK = ITAU
- CALL SHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 40
- END IF
-*
-* Sort eigenvalues ALPHA/BETA if desired
-* (Workspace: need 4*N+16 )
-*
- SDIM = 0
- IF( WANTST ) THEN
-*
-* Undo scaling on eigenvalues before SELCTGing
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
- $ IERR )
- END IF
- IF( ILBSCL )
- $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-*
-* Select eigenvalues
-*
- DO 10 I = 1, N
- BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- 10 CONTINUE
-*
- CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR,
- $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL,
- $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
- $ IERR )
- IF( IERR.EQ.1 )
- $ INFO = N + 3
-*
- END IF
-*
-* Apply back-permutation to VSL and VSR
-* (Workspace: none needed)
-*
- IF( ILVSL )
- $ CALL SGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSL, LDVSL, IERR )
-*
- IF( ILVSR )
- $ CALL SGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSR, LDVSR, IERR )
-*
-* Check if unscaling would cause over/underflow, if so, rescale
-* (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
-* B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
-*
- IF( ILASCL )THEN
- DO 50 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( ALPHAR( I )/SAFMAX ).GT.( ANRMTO/ANRM ) .OR.
- $ ( SAFMIN/ALPHAR( I ) ).GT.( ANRM/ANRMTO ) ) THEN
- WORK( 1 ) = ABS( A( I, I )/ALPHAR( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- ELSE IF( ( ALPHAI( I )/SAFMAX ).GT.( ANRMTO/ANRM ) .OR.
- $ ( SAFMIN/ALPHAI( I ) ).GT.( ANRM/ANRMTO ) ) THEN
- WORK( 1 ) = ABS( A( I, I+1 )/ALPHAI( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 50 CONTINUE
- END IF
-*
- IF( ILBSCL )THEN
- DO 60 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( BETA( I )/SAFMAX ).GT.( BNRMTO/BNRM ) .OR.
- $ ( SAFMIN/BETA( I ) ).GT.( BNRM/BNRMTO ) ) THEN
- WORK( 1 ) = ABS(B( I, I )/BETA( I ))
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 60 CONTINUE
- END IF
-*
-* Undo scaling
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL SLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
- CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- IF( WANTST ) THEN
-*
-* Check if reordering is correct
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 30 I = 1, N
- CURSL = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- IF( ALPHAI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 30 CONTINUE
-*
- END IF
-*
- 40 CONTINUE
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of SGGES
-*
- END
diff --git a/netlib/LAPACK/sggesx.f b/netlib/LAPACK/sggesx.f
deleted file mode 100644
index 7a2b34d..0000000
--- a/netlib/LAPACK/sggesx.f
+++ /dev/null
@@ -1,820 +0,0 @@
-*> \brief <b> SGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGESX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggesx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggesx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggesx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA,
-* B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL,
-* VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK,
-* LIWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVSL, JOBVSR, SENSE, SORT
-* INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LIWORK, LWORK, N,
-* $ SDIM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), RCONDE( 2 ),
-* $ RCONDV( 2 ), VSL( LDVSL, * ), VSR( LDVSR, * ),
-* $ WORK( * )
-* ..
-* .. Function Arguments ..
-* LOGICAL SELCTG
-* EXTERNAL SELCTG
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGESX computes for a pair of N-by-N real nonsymmetric matrices
-*> (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
-*> optionally, the left and/or right matrices of Schur vectors (VSL and
-*> VSR). This gives the generalized Schur factorization
-*>
-*> (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )
-*>
-*> Optionally, it also orders the eigenvalues so that a selected cluster
-*> of eigenvalues appears in the leading diagonal blocks of the upper
-*> quasi-triangular matrix S and the upper triangular matrix T; computes
-*> a reciprocal condition number for the average of the selected
-*> eigenvalues (RCONDE); and computes a reciprocal condition number for
-*> the right and left deflating subspaces corresponding to the selected
-*> eigenvalues (RCONDV). The leading columns of VSL and VSR then form
-*> an orthonormal basis for the corresponding left and right eigenspaces
-*> (deflating subspaces).
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
-*> or a ratio alpha/beta = w, such that A - w*B is singular. It is
-*> usually represented as the pair (alpha,beta), as there is a
-*> reasonable interpretation for beta=0 or for both being zero.
-*>
-*> A pair of matrices (S,T) is in generalized real Schur form if T is
-*> upper triangular with non-negative diagonal and S is block upper
-*> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
-*> to real generalized eigenvalues, while 2-by-2 blocks of S will be
-*> "standardized" by making the corresponding elements of T have the
-*> form:
-*> [ a 0 ]
-*> [ 0 b ]
-*>
-*> and the pair of corresponding 2-by-2 blocks in S and T will have a
-*> complex conjugate pair of generalized eigenvalues.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVSL
-*> \verbatim
-*> JOBVSL is CHARACTER*1
-*> = 'N': do not compute the left Schur vectors;
-*> = 'V': compute the left Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVSR
-*> \verbatim
-*> JOBVSR is CHARACTER*1
-*> = 'N': do not compute the right Schur vectors;
-*> = 'V': compute the right Schur vectors.
-*> \endverbatim
-*>
-*> \param[in] SORT
-*> \verbatim
-*> SORT is CHARACTER*1
-*> Specifies whether or not to order the eigenvalues on the
-*> diagonal of the generalized Schur form.
-*> = 'N': Eigenvalues are not ordered;
-*> = 'S': Eigenvalues are ordered (see SELCTG).
-*> \endverbatim
-*>
-*> \param[in] SELCTG
-*> \verbatim
-*> SELCTG is procedure) LOGICAL FUNCTION of three REAL arguments
-*> SELCTG must be declared EXTERNAL in the calling subroutine.
-*> If SORT = 'N', SELCTG is not referenced.
-*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
-*> to the top left of the Schur form.
-*> An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
-*> SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
-*> one of a complex conjugate pair of eigenvalues is selected,
-*> then both complex eigenvalues are selected.
-*> Note that a selected complex eigenvalue may no longer satisfy
-*> SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
-*> since ordering may change the value of complex eigenvalues
-*> (especially if the eigenvalue is ill-conditioned), in this
-*> case INFO is set to N+3.
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N' : None are computed;
-*> = 'E' : Computed for average of selected eigenvalues only;
-*> = 'V' : Computed for selected deflating subspaces only;
-*> = 'B' : Computed for both.
-*> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VSL, and VSR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the first of the pair of matrices.
-*> On exit, A has been overwritten by its generalized Schur
-*> form S.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the second of the pair of matrices.
-*> On exit, B has been overwritten by its generalized Schur
-*> form T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] SDIM
-*> \verbatim
-*> SDIM is INTEGER
-*> If SORT = 'N', SDIM = 0.
-*> If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*> for which SELCTG is true. (Complex conjugate pairs for which
-*> SELCTG is true for either eigenvalue count as 2.)
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
-*> and BETA(j),j=1,...,N are the diagonals of the complex Schur
-*> form (S,T) that would result if the 2-by-2 diagonal blocks of
-*> the real Schur form of (A,B) were further reduced to
-*> triangular form using 2-by-2 complex unitary transformations.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio.
-*> However, ALPHAR and ALPHAI will be always less than and
-*> usually comparable with norm(A) in magnitude, and BETA always
-*> less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VSL
-*> \verbatim
-*> VSL is REAL array, dimension (LDVSL,N)
-*> If JOBVSL = 'V', VSL will contain the left Schur vectors.
-*> Not referenced if JOBVSL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSL
-*> \verbatim
-*> LDVSL is INTEGER
-*> The leading dimension of the matrix VSL. LDVSL >=1, and
-*> if JOBVSL = 'V', LDVSL >= N.
-*> \endverbatim
-*>
-*> \param[out] VSR
-*> \verbatim
-*> VSR is REAL array, dimension (LDVSR,N)
-*> If JOBVSR = 'V', VSR will contain the right Schur vectors.
-*> Not referenced if JOBVSR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVSR
-*> \verbatim
-*> LDVSR is INTEGER
-*> The leading dimension of the matrix VSR. LDVSR >= 1, and
-*> if JOBVSR = 'V', LDVSR >= N.
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is REAL array, dimension ( 2 )
-*> If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
-*> reciprocal condition numbers for the average of the selected
-*> eigenvalues.
-*> Not referenced if SENSE = 'N' or 'V'.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is REAL array, dimension ( 2 )
-*> If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
-*> reciprocal condition numbers for the selected deflating
-*> subspaces.
-*> Not referenced if SENSE = 'N' or 'E'.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
-*> LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
-*> LWORK >= max( 8*N, 6*N+16 ).
-*> Note that 2*SDIM*(N-SDIM) <= N*N/2.
-*> Note also that an error is only returned if
-*> LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
-*> this may not be large enough.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the bound on the optimal size of the WORK
-*> array and the minimum size of the IWORK array, returns these
-*> values as the first entries of the WORK and IWORK arrays, and
-*> no error message related to LWORK or LIWORK is issued by
-*> XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
-*> LIWORK >= N+6.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the bound on the optimal size of the
-*> WORK array and the minimum size of the IWORK array, returns
-*> these values as the first entries of the WORK and IWORK
-*> arrays, and no error message related to LWORK or LIWORK is
-*> issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> Not referenced if SORT = 'N'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. (A,B) are not in Schur
-*> form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*> be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in SHGEQZ
-*> =N+2: after reordering, roundoff changed values of
-*> some complex eigenvalues so that leading
-*> eigenvalues in the Generalized Schur form no
-*> longer satisfy SELCTG=.TRUE. This could also
-*> be caused due to scaling.
-*> =N+3: reordering failed in STGSEN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> An approximate (asymptotic) bound on the average absolute error of
-*> the selected eigenvalues is
-*>
-*> EPS * norm((A, B)) / RCONDE( 1 ).
-*>
-*> An approximate (asymptotic) bound on the maximum angular error in
-*> the computed deflating subspaces is
-*>
-*> EPS * norm((A, B)) / RCONDV( 2 ).
-*>
-*> See LAPACK User's Guide, section 4.11 for more information.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA,
- $ B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL,
- $ VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK,
- $ LIWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVSL, JOBVSR, SENSE, SORT
- INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LIWORK, LWORK, N,
- $ SDIM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), RCONDE( 2 ),
- $ RCONDV( 2 ), VSL( LDVSL, * ), VSR( LDVSR, * ),
- $ WORK( * )
-* ..
-* .. Function Arguments ..
- LOGICAL SELCTG
- EXTERNAL SELCTG
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, LST2SL, WANTSB, WANTSE, WANTSN, WANTST,
- $ WANTSV
- INTEGER I, ICOLS, IERR, IHI, IJOB, IJOBVL, IJOBVR,
- $ ILEFT, ILO, IP, IRIGHT, IROWS, ITAU, IWRK,
- $ LIWMIN, LWRK, MAXWRK, MINWRK
- REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PL,
- $ PR, SAFMAX, SAFMIN, SMLNUM
-* ..
-* .. Local Arrays ..
- REAL DIF( 2 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD,
- $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGSEN,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVSL, 'N' ) ) THEN
- IJOBVL = 1
- ILVSL = .FALSE.
- ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
- IJOBVL = 2
- ILVSL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVSL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVSR, 'N' ) ) THEN
- IJOBVR = 1
- ILVSR = .FALSE.
- ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
- IJOBVR = 2
- ILVSR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVSR = .FALSE.
- END IF
-*
- WANTST = LSAME( SORT, 'S' )
- WANTSN = LSAME( SENSE, 'N' )
- WANTSE = LSAME( SENSE, 'E' )
- WANTSV = LSAME( SENSE, 'V' )
- WANTSB = LSAME( SENSE, 'B' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
- IF( WANTSN ) THEN
- IJOB = 0
- ELSE IF( WANTSE ) THEN
- IJOB = 1
- ELSE IF( WANTSV ) THEN
- IJOB = 2
- ELSE IF( WANTSB ) THEN
- IJOB = 4
- END IF
-*
-* Test the input arguments
-*
- INFO = 0
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
- $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN
- INFO = -5
- ELSE IF( N.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
- INFO = -16
- ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
- INFO = -18
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.GT.0) THEN
- MINWRK = MAX( 8*N, 6*N + 16 )
- MAXWRK = MINWRK - N +
- $ N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 )
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, -1 ) )
- IF( ILVSL ) THEN
- MAXWRK = MAX( MAXWRK, MINWRK - N +
- $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) )
- END IF
- LWRK = MAXWRK
- IF( IJOB.GE.1 )
- $ LWRK = MAX( LWRK, N*N/2 )
- ELSE
- MINWRK = 1
- MAXWRK = 1
- LWRK = 1
- END IF
- WORK( 1 ) = LWRK
- IF( WANTSN .OR. N.EQ.0 ) THEN
- LIWMIN = 1
- ELSE
- LIWMIN = N + 6
- END IF
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -22
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -24
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGESX', -INFO )
- RETURN
- ELSE IF (LQUERY) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SDIM = 0
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SAFMIN = SLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- CALL SLABAD( SAFMIN, SAFMAX )
- SMLNUM = SQRT( SAFMIN ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL SLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = SLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL SLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute the matrix to make it more nearly triangular
-* (Workspace: need 6*N + 2*N for permutation parameters)
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWRK = IRIGHT + N
- CALL SGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB)
-*
- IROWS = IHI + 1 - ILO
- ICOLS = N + 1 - ILO
- ITAU = IWRK
- IWRK = ITAU + IROWS
- CALL SGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to matrix A
-* (Workspace: need N, prefer N*NB)
-*
- CALL SORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VSL
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVSL ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
- IF( IROWS.GT.1 ) THEN
- CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VSL( ILO+1, ILO ), LDVSL )
- END IF
- CALL SORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
-* Initialize VSR
-*
- IF( ILVSR )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- CALL SGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
- $ LDVSL, VSR, LDVSR, IERR )
-*
- SDIM = 0
-*
-* Perform QZ algorithm, computing Schur vectors if desired
-* (Workspace: need N)
-*
- IWRK = ITAU
- CALL SHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 50
- END IF
-*
-* Sort eigenvalues ALPHA/BETA and compute the reciprocal of
-* condition number(s)
-* (Workspace: If IJOB >= 1, need MAX( 8*(N+1), 2*SDIM*(N-SDIM) )
-* otherwise, need 8*(N+1) )
-*
- IF( WANTST ) THEN
-*
-* Undo scaling on eigenvalues before SELCTGing
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
- $ IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
- $ IERR )
- END IF
- IF( ILBSCL )
- $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-*
-* Select eigenvalues
-*
- DO 10 I = 1, N
- BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- 10 CONTINUE
-*
-* Reorder eigenvalues, transform Generalized Schur vectors, and
-* compute reciprocal condition numbers
-*
- CALL STGSEN( IJOB, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
- $ SDIM, PL, PR, DIF, WORK( IWRK ), LWORK-IWRK+1,
- $ IWORK, LIWORK, IERR )
-*
- IF( IJOB.GE.1 )
- $ MAXWRK = MAX( MAXWRK, 2*SDIM*( N-SDIM ) )
- IF( IERR.EQ.-22 ) THEN
-*
-* not enough real workspace
-*
- INFO = -22
- ELSE
- IF( IJOB.EQ.1 .OR. IJOB.EQ.4 ) THEN
- RCONDE( 1 ) = PL
- RCONDE( 2 ) = PR
- END IF
- IF( IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
- RCONDV( 1 ) = DIF( 1 )
- RCONDV( 2 ) = DIF( 2 )
- END IF
- IF( IERR.EQ.1 )
- $ INFO = N + 3
- END IF
-*
- END IF
-*
-* Apply permutation to VSL and VSR
-* (Workspace: none needed)
-*
- IF( ILVSL )
- $ CALL SGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSL, LDVSL, IERR )
-*
- IF( ILVSR )
- $ CALL SGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VSR, LDVSR, IERR )
-*
-* Check if unscaling would cause over/underflow, if so, rescale
-* (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
-* B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
-*
- IF( ILASCL ) THEN
- DO 20 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( ALPHAR( I ) / SAFMAX ).GT.( ANRMTO / ANRM ) .OR.
- $ ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) )
- $ THEN
- WORK( 1 ) = ABS( A( I, I ) / ALPHAR( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- ELSE IF( ( ALPHAI( I ) / SAFMAX ).GT.( ANRMTO / ANRM )
- $ .OR. ( SAFMIN / ALPHAI( I ) ).GT.( ANRM / ANRMTO ) )
- $ THEN
- WORK( 1 ) = ABS( A( I, I+1 ) / ALPHAI( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 20 CONTINUE
- END IF
-*
- IF( ILBSCL ) THEN
- DO 25 I = 1, N
- IF( ALPHAI( I ).NE.ZERO ) THEN
- IF( ( BETA( I ) / SAFMAX ).GT.( BNRMTO / BNRM ) .OR.
- $ ( SAFMIN / BETA( I ) ).GT.( BNRM / BNRMTO ) ) THEN
- WORK( 1 ) = ABS( B( I, I ) / BETA( I ) )
- BETA( I ) = BETA( I )*WORK( 1 )
- ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
- ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
- END IF
- END IF
- 25 CONTINUE
- END IF
-*
-* Undo scaling
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL SLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
- CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- IF( WANTST ) THEN
-*
-* Check if reordering is correct
-*
- LASTSL = .TRUE.
- LST2SL = .TRUE.
- SDIM = 0
- IP = 0
- DO 40 I = 1, N
- CURSL = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
- IF( ALPHAI( I ).EQ.ZERO ) THEN
- IF( CURSL )
- $ SDIM = SDIM + 1
- IP = 0
- IF( CURSL .AND. .NOT.LASTSL )
- $ INFO = N + 2
- ELSE
- IF( IP.EQ.1 ) THEN
-*
-* Last eigenvalue of conjugate pair
-*
- CURSL = CURSL .OR. LASTSL
- LASTSL = CURSL
- IF( CURSL )
- $ SDIM = SDIM + 2
- IP = -1
- IF( CURSL .AND. .NOT.LST2SL )
- $ INFO = N + 2
- ELSE
-*
-* First eigenvalue of conjugate pair
-*
- IP = 1
- END IF
- END IF
- LST2SL = LASTSL
- LASTSL = CURSL
- 40 CONTINUE
-*
- END IF
-*
- 50 CONTINUE
-*
- WORK( 1 ) = MAXWRK
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of SGGESX
-*
- END
diff --git a/netlib/LAPACK/sggev.f b/netlib/LAPACK/sggev.f
deleted file mode 100644
index 51321a2..0000000
--- a/netlib/LAPACK/sggev.f
+++ /dev/null
@@ -1,592 +0,0 @@
-*> \brief <b> SGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-* BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
-*> the generalized eigenvalues, and optionally, the left and/or right
-*> generalized eigenvectors.
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar
-*> lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
-*> singular. It is usually represented as the pair (alpha,beta), as
-*> there is a reasonable interpretation for beta=0, and even for both
-*> being zero.
-*>
-*> The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> A * v(j) = lambda(j) * B * v(j).
-*>
-*> The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> u(j)**H * A = lambda(j) * u(j)**H * B .
-*>
-*> where u(j)**H is the conjugate-transpose of u(j).
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': do not compute the left generalized eigenvectors;
-*> = 'V': compute the left generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': do not compute the right generalized eigenvectors;
-*> = 'V': compute the right generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VL, and VR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the matrix A in the pair (A,B).
-*> On exit, A has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the matrix B in the pair (A,B).
-*> On exit, B has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. If ALPHAI(j) is zero, then
-*> the j-th eigenvalue is real; if positive, then the j-th and
-*> (j+1)-st eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio
-*> alpha/beta. However, ALPHAR and ALPHAI will be always less
-*> than and usually comparable with norm(A) in magnitude, and
-*> BETA always less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> u(j) = VL(:,j), the j-th column of VL. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
-*> Each eigenvector is scaled so the largest component has
-*> abs(real part)+abs(imag. part)=1.
-*> Not referenced if JOBVL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the matrix VL. LDVL >= 1, and
-*> if JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> v(j) = VR(:,j), the j-th column of VR. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
-*> Each eigenvector is scaled so the largest component has
-*> abs(real part)+abs(imag. part)=1.
-*> Not referenced if JOBVR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the matrix VR. LDVR >= 1, and
-*> if JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,8*N).
-*> For good performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. No eigenvectors have been
-*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*> should be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in SHGEQZ.
-*> =N+2: error return from STGEVC.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGEeigen
-*
-* =====================================================================
- SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
- $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
- CHARACTER CHTEMP
- INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
- $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, MAXWRK,
- $ MINWRK
- REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
- $ SMLNUM, TEMP
-* ..
-* .. Local Arrays ..
- LOGICAL LDUMMA( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD,
- $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVL, 'N' ) ) THEN
- IJOBVL = 1
- ILVL = .FALSE.
- ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
- IJOBVL = 2
- ILVL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVR, 'N' ) ) THEN
- IJOBVR = 1
- ILVR = .FALSE.
- ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
- IJOBVR = 2
- ILVR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVR = .FALSE.
- END IF
- ILV = ILVL .OR. ILVR
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( IJOBVL.LE.0 ) THEN
- INFO = -1
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
- INFO = -12
- ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
- INFO = -14
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV. The workspace is
-* computed assuming ILO = 1 and IHI = N, the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = MAX( 1, 8*N )
- MAXWRK = MAX( 1, N*( 7 +
- $ ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) ) )
- MAXWRK = MAX( MAXWRK, N*( 7 +
- $ ILAENV( 1, 'SORMQR', ' ', N, 1, N, 0 ) ) )
- IF( ILVL ) THEN
- MAXWRK = MAX( MAXWRK, N*( 7 +
- $ ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) ) )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -16
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL SLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = SLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL SLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute the matrices A, B to isolate eigenvalues if possible
-* (Workspace: need 6*N)
-*
- ILEFT = 1
- IRIGHT = N + 1
- IWRK = IRIGHT + N
- CALL SGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB)
-*
- IROWS = IHI + 1 - ILO
- IF( ILV ) THEN
- ICOLS = N + 1 - ILO
- ELSE
- ICOLS = IROWS
- END IF
- ITAU = IWRK
- IWRK = ITAU + IROWS
- CALL SGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to matrix A
-* (Workspace: need N, prefer N*NB)
-*
- CALL SORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VL
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVL ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
- IF( IROWS.GT.1 ) THEN
- CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VL( ILO+1, ILO ), LDVL )
- END IF
- CALL SORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
-* Initialize VR
-*
- IF( ILVR )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- IF( ILV ) THEN
-*
-* Eigenvectors requested -- work on whole matrix.
-*
- CALL SGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, IERR )
- ELSE
- CALL SGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
- $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
- END IF
-*
-* Perform QZ algorithm (Compute eigenvalues, and optionally, the
-* Schur forms and Schur vectors)
-* (Workspace: need N)
-*
- IWRK = ITAU
- IF( ILV ) THEN
- CHTEMP = 'S'
- ELSE
- CHTEMP = 'E'
- END IF
- CALL SHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 110
- END IF
-*
-* Compute Eigenvectors
-* (Workspace: need 6*N)
-*
- IF( ILV ) THEN
- IF( ILVL ) THEN
- IF( ILVR ) THEN
- CHTEMP = 'B'
- ELSE
- CHTEMP = 'L'
- END IF
- ELSE
- CHTEMP = 'R'
- END IF
- CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
- $ VR, LDVR, N, IN, WORK( IWRK ), IERR )
- IF( IERR.NE.0 ) THEN
- INFO = N + 2
- GO TO 110
- END IF
-*
-* Undo balancing on VL and VR and normalization
-* (Workspace: none needed)
-*
- IF( ILVL ) THEN
- CALL SGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VL, LDVL, IERR )
- DO 50 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 50
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 10 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
- 10 CONTINUE
- ELSE
- DO 20 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
- $ ABS( VL( JR, JC+1 ) ) )
- 20 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 50
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 30 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- 30 CONTINUE
- ELSE
- DO 40 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
- 40 CONTINUE
- END IF
- 50 CONTINUE
- END IF
- IF( ILVR ) THEN
- CALL SGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
- $ WORK( IRIGHT ), N, VR, LDVR, IERR )
- DO 100 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 100
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 60 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
- 60 CONTINUE
- ELSE
- DO 70 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
- $ ABS( VR( JR, JC+1 ) ) )
- 70 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 100
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 80 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- 80 CONTINUE
- ELSE
- DO 90 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- END IF
-*
-* End of eigenvector calculation
-*
- END IF
-*
-* Undo scaling if necessary
-*
- 110 CONTINUE
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of SGGEV
-*
- END
diff --git a/netlib/LAPACK/sggevx.f b/netlib/LAPACK/sggevx.f
deleted file mode 100644
index ad5b356..0000000
--- a/netlib/LAPACK/sggevx.f
+++ /dev/null
@@ -1,866 +0,0 @@
-*> \brief <b> SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB,
-* ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO,
-* IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE,
-* RCONDV, WORK, LWORK, IWORK, BWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER BALANC, JOBVL, JOBVR, SENSE
-* INTEGER IHI, ILO, INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-* REAL ABNRM, BBNRM
-* ..
-* .. Array Arguments ..
-* LOGICAL BWORK( * )
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), LSCALE( * ),
-* $ RCONDE( * ), RCONDV( * ), RSCALE( * ),
-* $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
-*> the generalized eigenvalues, and optionally, the left and/or right
-*> generalized eigenvectors.
-*>
-*> Optionally also, it computes a balancing transformation to improve
-*> the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
-*> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
-*> the eigenvalues (RCONDE), and reciprocal condition numbers for the
-*> right eigenvectors (RCONDV).
-*>
-*> A generalized eigenvalue for a pair of matrices (A,B) is a scalar
-*> lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
-*> singular. It is usually represented as the pair (alpha,beta), as
-*> there is a reasonable interpretation for beta=0, and even for both
-*> being zero.
-*>
-*> The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> A * v(j) = lambda(j) * B * v(j) .
-*>
-*> The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
-*> of (A,B) satisfies
-*>
-*> u(j)**H * A = lambda(j) * u(j)**H * B.
-*>
-*> where u(j)**H is the conjugate-transpose of u(j).
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] BALANC
-*> \verbatim
-*> BALANC is CHARACTER*1
-*> Specifies the balance option to be performed.
-*> = 'N': do not diagonally scale or permute;
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> Computed reciprocal condition numbers will be for the
-*> matrices after permuting and/or balancing. Permuting does
-*> not change condition numbers (in exact arithmetic), but
-*> balancing does.
-*> \endverbatim
-*>
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': do not compute the left generalized eigenvectors;
-*> = 'V': compute the left generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': do not compute the right generalized eigenvectors;
-*> = 'V': compute the right generalized eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] SENSE
-*> \verbatim
-*> SENSE is CHARACTER*1
-*> Determines which reciprocal condition numbers are computed.
-*> = 'N': none are computed;
-*> = 'E': computed for eigenvalues only;
-*> = 'V': computed for eigenvectors only;
-*> = 'B': computed for eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A, B, VL, and VR. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the matrix A in the pair (A,B).
-*> On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
-*> or both, then A contains the first part of the real Schur
-*> form of the "balanced" versions of the input A and B.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the matrix B in the pair (A,B).
-*> On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
-*> or both, then B contains the second part of the real Schur
-*> form of the "balanced" versions of the input A and B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. If ALPHAI(j) is zero, then
-*> the j-th eigenvalue is real; if positive, then the j-th and
-*> (j+1)-st eigenvalues are a complex conjugate pair, with
-*> ALPHAI(j+1) negative.
-*>
-*> Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*> may easily over- or underflow, and BETA(j) may even be zero.
-*> Thus, the user should avoid naively computing the ratio
-*> ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
-*> than and usually comparable with norm(A) in magnitude, and
-*> BETA always less than and usually comparable with norm(B).
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> u(j) = VL(:,j), the j-th column of VL. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
-*> Each eigenvector will be scaled so the largest component have
-*> abs(real part) + abs(imag. part) = 1.
-*> Not referenced if JOBVL = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the matrix VL. LDVL >= 1, and
-*> if JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order as
-*> their eigenvalues. If the j-th eigenvalue is real, then
-*> v(j) = VR(:,j), the j-th column of VR. If the j-th and
-*> (j+1)-th eigenvalues form a complex conjugate pair, then
-*> v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
-*> Each eigenvector will be scaled so the largest component have
-*> abs(real part) + abs(imag. part) = 1.
-*> Not referenced if JOBVR = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the matrix VR. LDVR >= 1, and
-*> if JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are integer values such that on exit
-*> A(i,j) = 0 and B(i,j) = 0 if i > j and
-*> j = 1,...,ILO-1 or i = IHI+1,...,N.
-*> If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] LSCALE
-*> \verbatim
-*> LSCALE is REAL array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the left side of A and B. If PL(j) is the index of the
-*> row interchanged with row j, and DL(j) is the scaling
-*> factor applied to row j, then
-*> LSCALE(j) = PL(j) for j = 1,...,ILO-1
-*> = DL(j) for j = ILO,...,IHI
-*> = PL(j) for j = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] RSCALE
-*> \verbatim
-*> RSCALE is REAL array, dimension (N)
-*> Details of the permutations and scaling factors applied
-*> to the right side of A and B. If PR(j) is the index of the
-*> column interchanged with column j, and DR(j) is the scaling
-*> factor applied to column j, then
-*> RSCALE(j) = PR(j) for j = 1,...,ILO-1
-*> = DR(j) for j = ILO,...,IHI
-*> = PR(j) for j = IHI+1,...,N
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] ABNRM
-*> \verbatim
-*> ABNRM is REAL
-*> The one-norm of the balanced matrix A.
-*> \endverbatim
-*>
-*> \param[out] BBNRM
-*> \verbatim
-*> BBNRM is REAL
-*> The one-norm of the balanced matrix B.
-*> \endverbatim
-*>
-*> \param[out] RCONDE
-*> \verbatim
-*> RCONDE is REAL array, dimension (N)
-*> If SENSE = 'E' or 'B', the reciprocal condition numbers of
-*> the eigenvalues, stored in consecutive elements of the array.
-*> For a complex conjugate pair of eigenvalues two consecutive
-*> elements of RCONDE are set to the same value. Thus RCONDE(j),
-*> RCONDV(j), and the j-th columns of VL and VR all correspond
-*> to the j-th eigenpair.
-*> If SENSE = 'N' or 'V', RCONDE is not referenced.
-*> \endverbatim
-*>
-*> \param[out] RCONDV
-*> \verbatim
-*> RCONDV is REAL array, dimension (N)
-*> If SENSE = 'V' or 'B', the estimated reciprocal condition
-*> numbers of the eigenvectors, stored in consecutive elements
-*> of the array. For a complex eigenvector two consecutive
-*> elements of RCONDV are set to the same value. If the
-*> eigenvalues cannot be reordered to compute RCONDV(j),
-*> RCONDV(j) is set to 0; this can only occur when the true
-*> value would be very small anyway.
-*> If SENSE = 'N' or 'E', RCONDV is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,2*N).
-*> If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
-*> LWORK >= max(1,6*N).
-*> If SENSE = 'E', LWORK >= max(1,10*N).
-*> If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N+6)
-*> If SENSE = 'E', IWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] BWORK
-*> \verbatim
-*> BWORK is LOGICAL array, dimension (N)
-*> If SENSE = 'N', BWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1,...,N:
-*> The QZ iteration failed. No eigenvectors have been
-*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*> should be correct for j=INFO+1,...,N.
-*> > N: =N+1: other than QZ iteration failed in SHGEQZ.
-*> =N+2: error return from STGEVC.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGEeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Balancing a matrix pair (A,B) includes, first, permuting rows and
-*> columns to isolate eigenvalues, second, applying diagonal similarity
-*> transformation to the rows and columns to make the rows and columns
-*> as close in norm as possible. The computed reciprocal condition
-*> numbers correspond to the balanced matrix. Permuting rows and columns
-*> will not change the condition numbers (in exact arithmetic) but
-*> diagonal scaling will. For further explanation of balancing, see
-*> section 4.11.1.2 of LAPACK Users' Guide.
-*>
-*> An approximate error bound on the chordal distance between the i-th
-*> computed generalized eigenvalue w and the corresponding exact
-*> eigenvalue lambda is
-*>
-*> chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)
-*>
-*> An approximate error bound for the angle between the i-th computed
-*> eigenvector VL(i) or VR(i) is given by
-*>
-*> EPS * norm(ABNRM, BBNRM) / DIF(i).
-*>
-*> For further explanation of the reciprocal condition numbers RCONDE
-*> and RCONDV, see section 4.11 of LAPACK User's Guide.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO,
- $ IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE,
- $ RCONDV, WORK, LWORK, IWORK, BWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER BALANC, JOBVL, JOBVR, SENSE
- INTEGER IHI, ILO, INFO, LDA, LDB, LDVL, LDVR, LWORK, N
- REAL ABNRM, BBNRM
-* ..
-* .. Array Arguments ..
- LOGICAL BWORK( * )
- INTEGER IWORK( * )
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), LSCALE( * ),
- $ RCONDE( * ), RCONDV( * ), RSCALE( * ),
- $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY, NOSCL,
- $ PAIR, WANTSB, WANTSE, WANTSN, WANTSV
- CHARACTER CHTEMP
- INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
- $ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK,
- $ MINWRK, MM
- REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
- $ SMLNUM, TEMP
-* ..
-* .. Local Arrays ..
- LOGICAL LDUMMA( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD,
- $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC,
- $ STGSNA, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode the input arguments
-*
- IF( LSAME( JOBVL, 'N' ) ) THEN
- IJOBVL = 1
- ILVL = .FALSE.
- ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
- IJOBVL = 2
- ILVL = .TRUE.
- ELSE
- IJOBVL = -1
- ILVL = .FALSE.
- END IF
-*
- IF( LSAME( JOBVR, 'N' ) ) THEN
- IJOBVR = 1
- ILVR = .FALSE.
- ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
- IJOBVR = 2
- ILVR = .TRUE.
- ELSE
- IJOBVR = -1
- ILVR = .FALSE.
- END IF
- ILV = ILVL .OR. ILVR
-*
- NOSCL = LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'P' )
- WANTSN = LSAME( SENSE, 'N' )
- WANTSE = LSAME( SENSE, 'E' )
- WANTSV = LSAME( SENSE, 'V' )
- WANTSB = LSAME( SENSE, 'B' )
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( NOSCL .OR. LSAME( BALANC, 'S' ) .OR.
- $ LSAME( BALANC, 'B' ) ) ) THEN
- INFO = -1
- ELSE IF( IJOBVL.LE.0 ) THEN
- INFO = -2
- ELSE IF( IJOBVR.LE.0 ) THEN
- INFO = -3
- ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSB .OR. WANTSV ) )
- $ THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
- INFO = -16
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV. The workspace is
-* computed assuming ILO = 1 and IHI = N, the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- IF( NOSCL .AND. .NOT.ILV ) THEN
- MINWRK = 2*N
- ELSE
- MINWRK = 6*N
- END IF
- IF( WANTSE ) THEN
- MINWRK = 10*N
- ELSE IF( WANTSV .OR. WANTSB ) THEN
- MINWRK = 2*N*( N + 4 ) + 16
- END IF
- MAXWRK = MINWRK
- MAXWRK = MAX( MAXWRK,
- $ N + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) )
- MAXWRK = MAX( MAXWRK,
- $ N + N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, 0 ) )
- IF( ILVL ) THEN
- MAXWRK = MAX( MAXWRK, N +
- $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, 0 ) )
- END IF
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -26
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGEVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = SLANGE( 'M', N, N, A, LDA, WORK )
- ILASCL = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ANRMTO = SMLNUM
- ILASCL = .TRUE.
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ANRMTO = BIGNUM
- ILASCL = .TRUE.
- END IF
- IF( ILASCL )
- $ CALL SLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-* Scale B if max element outside range [SMLNUM,BIGNUM]
-*
- BNRM = SLANGE( 'M', N, N, B, LDB, WORK )
- ILBSCL = .FALSE.
- IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
- BNRMTO = SMLNUM
- ILBSCL = .TRUE.
- ELSE IF( BNRM.GT.BIGNUM ) THEN
- BNRMTO = BIGNUM
- ILBSCL = .TRUE.
- END IF
- IF( ILBSCL )
- $ CALL SLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-* Permute and/or balance the matrix pair (A,B)
-* (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise)
-*
- CALL SGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
- $ WORK, IERR )
-*
-* Compute ABNRM and BBNRM
-*
- ABNRM = SLANGE( '1', N, N, A, LDA, WORK( 1 ) )
- IF( ILASCL ) THEN
- WORK( 1 ) = ABNRM
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, 1, 1, WORK( 1 ), 1,
- $ IERR )
- ABNRM = WORK( 1 )
- END IF
-*
- BBNRM = SLANGE( '1', N, N, B, LDB, WORK( 1 ) )
- IF( ILBSCL ) THEN
- WORK( 1 ) = BBNRM
- CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, 1, 1, WORK( 1 ), 1,
- $ IERR )
- BBNRM = WORK( 1 )
- END IF
-*
-* Reduce B to triangular form (QR decomposition of B)
-* (Workspace: need N, prefer N*NB )
-*
- IROWS = IHI + 1 - ILO
- IF( ILV .OR. .NOT.WANTSN ) THEN
- ICOLS = N + 1 - ILO
- ELSE
- ICOLS = IROWS
- END IF
- ITAU = 1
- IWRK = ITAU + IROWS
- CALL SGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
- $ WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-* Apply the orthogonal transformation to A
-* (Workspace: need N, prefer N*NB)
-*
- CALL SORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
- $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
- $ LWORK+1-IWRK, IERR )
-*
-* Initialize VL and/or VR
-* (Workspace: need N, prefer N*NB)
-*
- IF( ILVL ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
- IF( IROWS.GT.1 ) THEN
- CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
- $ VL( ILO+1, ILO ), LDVL )
- END IF
- CALL SORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
- $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
- END IF
-*
- IF( ILVR )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-* Reduce to generalized Hessenberg form
-* (Workspace: none needed)
-*
- IF( ILV .OR. .NOT.WANTSN ) THEN
-*
-* Eigenvectors requested -- work on whole matrix.
-*
- CALL SGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, IERR )
- ELSE
- CALL SGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
- $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
- END IF
-*
-* Perform QZ algorithm (Compute eigenvalues, and optionally, the
-* Schur forms and Schur vectors)
-* (Workspace: need N)
-*
- IF( ILV .OR. .NOT.WANTSN ) THEN
- CHTEMP = 'S'
- ELSE
- CHTEMP = 'E'
- END IF
-*
- CALL SHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK,
- $ LWORK, IERR )
- IF( IERR.NE.0 ) THEN
- IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
- INFO = IERR
- ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
- INFO = IERR - N
- ELSE
- INFO = N + 1
- END IF
- GO TO 130
- END IF
-*
-* Compute Eigenvectors and estimate condition numbers if desired
-* (Workspace: STGEVC: need 6*N
-* STGSNA: need 2*N*(N+2)+16 if SENSE = 'V' or 'B',
-* need N otherwise )
-*
- IF( ILV .OR. .NOT.WANTSN ) THEN
- IF( ILV ) THEN
- IF( ILVL ) THEN
- IF( ILVR ) THEN
- CHTEMP = 'B'
- ELSE
- CHTEMP = 'L'
- END IF
- ELSE
- CHTEMP = 'R'
- END IF
-*
- CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, N, IN, WORK, IERR )
- IF( IERR.NE.0 ) THEN
- INFO = N + 2
- GO TO 130
- END IF
- END IF
-*
- IF( .NOT.WANTSN ) THEN
-*
-* compute eigenvectors (STGEVC) and estimate condition
-* numbers (STGSNA). Note that the definition of the condition
-* number is not invariant under transformation (u,v) to
-* (Q*u, Z*v), where (u,v) are eigenvectors of the generalized
-* Schur form (S,T), Q and Z are orthogonal matrices. In order
-* to avoid using extra 2*N*N workspace, we have to recalculate
-* eigenvectors and estimate one condition numbers at a time.
-*
- PAIR = .FALSE.
- DO 20 I = 1, N
-*
- IF( PAIR ) THEN
- PAIR = .FALSE.
- GO TO 20
- END IF
- MM = 1
- IF( I.LT.N ) THEN
- IF( A( I+1, I ).NE.ZERO ) THEN
- PAIR = .TRUE.
- MM = 2
- END IF
- END IF
-*
- DO 10 J = 1, N
- BWORK( J ) = .FALSE.
- 10 CONTINUE
- IF( MM.EQ.1 ) THEN
- BWORK( I ) = .TRUE.
- ELSE IF( MM.EQ.2 ) THEN
- BWORK( I ) = .TRUE.
- BWORK( I+1 ) = .TRUE.
- END IF
-*
- IWRK = MM*N + 1
- IWRK1 = IWRK + MM*N
-*
-* Compute a pair of left and right eigenvectors.
-* (compute workspace: need up to 4*N + 6*N)
-*
- IF( WANTSE .OR. WANTSB ) THEN
- CALL STGEVC( 'B', 'S', BWORK, N, A, LDA, B, LDB,
- $ WORK( 1 ), N, WORK( IWRK ), N, MM, M,
- $ WORK( IWRK1 ), IERR )
- IF( IERR.NE.0 ) THEN
- INFO = N + 2
- GO TO 130
- END IF
- END IF
-*
- CALL STGSNA( SENSE, 'S', BWORK, N, A, LDA, B, LDB,
- $ WORK( 1 ), N, WORK( IWRK ), N, RCONDE( I ),
- $ RCONDV( I ), MM, M, WORK( IWRK1 ),
- $ LWORK-IWRK1+1, IWORK, IERR )
-*
- 20 CONTINUE
- END IF
- END IF
-*
-* Undo balancing on VL and VR and normalization
-* (Workspace: none needed)
-*
- IF( ILVL ) THEN
- CALL SGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, VL,
- $ LDVL, IERR )
-*
- DO 70 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 70
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 30 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
- 30 CONTINUE
- ELSE
- DO 40 JR = 1, N
- TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
- $ ABS( VL( JR, JC+1 ) ) )
- 40 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 70
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 50 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- 50 CONTINUE
- ELSE
- DO 60 JR = 1, N
- VL( JR, JC ) = VL( JR, JC )*TEMP
- VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
- 60 CONTINUE
- END IF
- 70 CONTINUE
- END IF
- IF( ILVR ) THEN
- CALL SGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, VR,
- $ LDVR, IERR )
- DO 120 JC = 1, N
- IF( ALPHAI( JC ).LT.ZERO )
- $ GO TO 120
- TEMP = ZERO
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 80 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
- 80 CONTINUE
- ELSE
- DO 90 JR = 1, N
- TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
- $ ABS( VR( JR, JC+1 ) ) )
- 90 CONTINUE
- END IF
- IF( TEMP.LT.SMLNUM )
- $ GO TO 120
- TEMP = ONE / TEMP
- IF( ALPHAI( JC ).EQ.ZERO ) THEN
- DO 100 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- 100 CONTINUE
- ELSE
- DO 110 JR = 1, N
- VR( JR, JC ) = VR( JR, JC )*TEMP
- VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 130 CONTINUE
-*
- IF( ILASCL ) THEN
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
- CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
- END IF
-*
- IF( ILBSCL ) THEN
- CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of SGGEVX
-*
- END
diff --git a/netlib/LAPACK/sggglm.f b/netlib/LAPACK/sggglm.f
deleted file mode 100644
index 4418299..0000000
--- a/netlib/LAPACK/sggglm.f
+++ /dev/null
@@ -1,348 +0,0 @@
-*> \brief <b> SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGGLM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggglm.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggglm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggglm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
-* $ X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGGLM solves a general Gauss-Markov linear model (GLM) problem:
-*>
-*> minimize || y ||_2 subject to d = A*x + B*y
-*> x
-*>
-*> where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
-*> given N-vector. It is assumed that M <= N <= M+P, and
-*>
-*> rank(A) = M and rank( A B ) = N.
-*>
-*> Under these assumptions, the constrained equation is always
-*> consistent, and there is a unique solution x and a minimal 2-norm
-*> solution y, which is obtained using a generalized QR factorization
-*> of the matrices (A, B) given by
-*>
-*> A = Q*(R), B = Q*T*Z.
-*> (0)
-*>
-*> In particular, if matrix B is square nonsingular, then the problem
-*> GLM is equivalent to the following weighted linear least squares
-*> problem
-*>
-*> minimize || inv(B)*(d-A*x) ||_2
-*> x
-*>
-*> where inv(B) denotes the inverse of B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix A. 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of columns of the matrix B. P >= N-M.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,M)
-*> On entry, the N-by-M matrix A.
-*> On exit, the upper triangular part of the array A contains
-*> the M-by-M upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,P)
-*> On entry, the N-by-P matrix B.
-*> On exit, if N <= P, the upper triangle of the subarray
-*> B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
-*> if N > P, the elements on and above the (N-P)th subdiagonal
-*> contain the N-by-P upper trapezoidal matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, D is the left hand side of the GLM equation.
-*> On exit, D is destroyed.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is REAL array, dimension (P)
-*>
-*> On exit, X and Y are the solutions of the GLM problem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N+M+P).
-*> For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
-*> where NB is an upper bound for the optimal blocksizes for
-*> SGEQRF, SGERQF, SORMQR and SORMRQ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1: the upper triangular factor R associated with A in the
-*> generalized QR factorization of the pair (A, B) is
-*> singular, so that rank(A) < M; the least squares
-*> solution could not be computed.
-*> = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal
-*> factor T associated with B in the generalized QR
-*> factorization of the pair (A, B) is singular, so that
-*> rank( A B ) < N; the least squares solution could not
-*> be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
- $ X( * ), Y( * )
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, LOPT, LWKMIN, LWKOPT, NB, NB1, NB2, NB3,
- $ NB4, NP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMV, SGGQRF, SORMQR, SORMRQ, STRTRS,
- $ XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NP = MIN( N, P )
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 .OR. M.GT.N ) THEN
- INFO = -2
- ELSE IF( P.LT.0 .OR. P.LT.N-M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
-*
-* Calculate workspace
-*
- IF( INFO.EQ.0) THEN
- IF( N.EQ.0 ) THEN
- LWKMIN = 1
- LWKOPT = 1
- ELSE
- NB1 = ILAENV( 1, 'SGEQRF', ' ', N, M, -1, -1 )
- NB2 = ILAENV( 1, 'SGERQF', ' ', N, M, -1, -1 )
- NB3 = ILAENV( 1, 'SORMQR', ' ', N, M, P, -1 )
- NB4 = ILAENV( 1, 'SORMRQ', ' ', N, M, P, -1 )
- NB = MAX( NB1, NB2, NB3, NB4 )
- LWKMIN = M + N + P
- LWKOPT = M + NP + MAX( N, P )*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGGLM', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Compute the GQR factorization of matrices A and B:
-*
-* Q**T*A = ( R11 ) M, Q**T*B*Z**T = ( T11 T12 ) M
-* ( 0 ) N-M ( 0 T22 ) N-M
-* M M+P-N N-M
-*
-* where R11 and T22 are upper triangular, and Q and Z are
-* orthogonal.
-*
- CALL SGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ),
- $ WORK( M+NP+1 ), LWORK-M-NP, INFO )
- LOPT = WORK( M+NP+1 )
-*
-* Update left-hand-side vector d = Q**T*d = ( d1 ) M
-* ( d2 ) N-M
-*
- CALL SORMQR( 'Left', 'Transpose', N, 1, M, A, LDA, WORK, D,
- $ MAX( 1, N ), WORK( M+NP+1 ), LWORK-M-NP, INFO )
- LOPT = MAX( LOPT, INT( WORK( M+NP+1 ) ) )
-*
-* Solve T22*y2 = d2 for y2
-*
- IF( N.GT.M ) THEN
- CALL STRTRS( 'Upper', 'No transpose', 'Non unit', N-M, 1,
- $ B( M+1, M+P-N+1 ), LDB, D( M+1 ), N-M, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
- CALL SCOPY( N-M, D( M+1 ), 1, Y( M+P-N+1 ), 1 )
- END IF
-*
-* Set y1 = 0
-*
- DO 10 I = 1, M + P - N
- Y( I ) = ZERO
- 10 CONTINUE
-*
-* Update d1 = d1 - T12*y2
-*
- CALL SGEMV( 'No transpose', M, N-M, -ONE, B( 1, M+P-N+1 ), LDB,
- $ Y( M+P-N+1 ), 1, ONE, D, 1 )
-*
-* Solve triangular system: R11*x = d1
-*
- IF( M.GT.0 ) THEN
- CALL STRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, LDA,
- $ D, M, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 2
- RETURN
- END IF
-*
-* Copy D to X
-*
- CALL SCOPY( M, D, 1, X, 1 )
- END IF
-*
-* Backward transformation y = Z**T *y
-*
- CALL SORMRQ( 'Left', 'Transpose', P, 1, NP,
- $ B( MAX( 1, N-P+1 ), 1 ), LDB, WORK( M+1 ), Y,
- $ MAX( 1, P ), WORK( M+NP+1 ), LWORK-M-NP, INFO )
- WORK( 1 ) = M + NP + MAX( LOPT, INT( WORK( M+NP+1 ) ) )
-*
- RETURN
-*
-* End of SGGGLM
-*
- END
diff --git a/netlib/LAPACK/sgghrd.f b/netlib/LAPACK/sgghrd.f
deleted file mode 100644
index 9ff6e8f..0000000
--- a/netlib/LAPACK/sgghrd.f
+++ /dev/null
@@ -1,361 +0,0 @@
-*> \brief \b SGGHRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGHRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgghrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgghrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgghrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
-* LDQ, Z, LDZ, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, COMPZ
-* INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGHRD reduces a pair of real matrices (A,B) to generalized upper
-*> Hessenberg form using orthogonal transformations, where A is a
-*> general matrix and B is upper triangular. The form of the
-*> generalized eigenvalue problem is
-*> A*x = lambda*B*x,
-*> and B is typically made upper triangular by computing its QR
-*> factorization and moving the orthogonal matrix Q to the left side
-*> of the equation.
-*>
-*> This subroutine simultaneously reduces A to a Hessenberg matrix H:
-*> Q**T*A*Z = H
-*> and transforms B to another upper triangular matrix T:
-*> Q**T*B*Z = T
-*> in order to reduce the problem to its standard form
-*> H*y = lambda*T*y
-*> where y = Z**T*x.
-*>
-*> The orthogonal matrices Q and Z are determined as products of Givens
-*> rotations. They may either be formed explicitly, or they may be
-*> postmultiplied into input matrices Q1 and Z1, so that
-*>
-*> Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
-*>
-*> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
-*>
-*> If Q1 is the orthogonal matrix from the QR factorization of B in the
-*> original equation A*x = lambda*B*x, then SGGHRD reduces the original
-*> problem to generalized Hessenberg form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'N': do not compute Q;
-*> = 'I': Q is initialized to the unit matrix, and the
-*> orthogonal matrix Q is returned;
-*> = 'V': Q must contain an orthogonal matrix Q1 on entry,
-*> and the product Q1*Q is returned.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': do not compute Z;
-*> = 'I': Z is initialized to the unit matrix, and the
-*> orthogonal matrix Z is returned;
-*> = 'V': Z must contain an orthogonal matrix Z1 on entry,
-*> and the product Z1*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI mark the rows and columns of A which are to be
-*> reduced. It is assumed that A is already upper triangular
-*> in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
-*> normally set by a previous call to SGGBAL; otherwise they
-*> should be set to 1 and N respectively.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the N-by-N general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> rest is set to zero.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the N-by-N upper triangular matrix B.
-*> On exit, the upper triangular matrix T = Q**T B Z. The
-*> elements below the diagonal are set to zero.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> On entry, if COMPQ = 'V', the orthogonal matrix Q1,
-*> typically from the QR factorization of B.
-*> On exit, if COMPQ='I', the orthogonal matrix Q, and if
-*> COMPQ = 'V', the product Q1*Q.
-*> Not referenced if COMPQ='N'.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix Z1.
-*> On exit, if COMPZ='I', the orthogonal matrix Z, and if
-*> COMPZ = 'V', the product Z1*Z.
-*> Not referenced if COMPZ='N'.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z.
-*> LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine reduces A to Hessenberg and B to triangular form by
-*> an unblocked reduction, as described in _Matrix_Computations_,
-*> by Golub and Van Loan (Johns Hopkins Press.)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
- $ LDQ, Z, LDZ, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, COMPZ
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILQ, ILZ
- INTEGER ICOMPQ, ICOMPZ, JCOL, JROW
- REAL C, S, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARTG, SLASET, SROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode COMPQ
-*
- IF( LSAME( COMPQ, 'N' ) ) THEN
- ILQ = .FALSE.
- ICOMPQ = 1
- ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 2
- ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 3
- ELSE
- ICOMPQ = 0
- END IF
-*
-* Decode COMPZ
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ILZ = .FALSE.
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 2
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 3
- ELSE
- ICOMPZ = 0
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( ICOMPQ.LE.0 ) THEN
- INFO = -1
- ELSE IF( ICOMPZ.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 ) THEN
- INFO = -4
- ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( ( ILQ .AND. LDQ.LT.N ) .OR. LDQ.LT.1 ) THEN
- INFO = -11
- ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGHRD', -INFO )
- RETURN
- END IF
-*
-* Initialize Q and Z if desired.
-*
- IF( ICOMPQ.EQ.3 )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
- IF( ICOMPZ.EQ.3 )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Zero out lower triangle of B
-*
- DO 20 JCOL = 1, N - 1
- DO 10 JROW = JCOL + 1, N
- B( JROW, JCOL ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Reduce A and B
-*
- DO 40 JCOL = ILO, IHI - 2
-*
- DO 30 JROW = IHI, JCOL + 2, -1
-*
-* Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL)
-*
- TEMP = A( JROW-1, JCOL )
- CALL SLARTG( TEMP, A( JROW, JCOL ), C, S,
- $ A( JROW-1, JCOL ) )
- A( JROW, JCOL ) = ZERO
- CALL SROT( N-JCOL, A( JROW-1, JCOL+1 ), LDA,
- $ A( JROW, JCOL+1 ), LDA, C, S )
- CALL SROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB,
- $ B( JROW, JROW-1 ), LDB, C, S )
- IF( ILQ )
- $ CALL SROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, S )
-*
-* Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1)
-*
- TEMP = B( JROW, JROW )
- CALL SLARTG( TEMP, B( JROW, JROW-1 ), C, S,
- $ B( JROW, JROW ) )
- B( JROW, JROW-1 ) = ZERO
- CALL SROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S )
- CALL SROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C,
- $ S )
- IF( ILZ )
- $ CALL SROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S )
- 30 CONTINUE
- 40 CONTINUE
-*
- RETURN
-*
-* End of SGGHRD
-*
- END
diff --git a/netlib/LAPACK/sgglse.f b/netlib/LAPACK/sgglse.f
deleted file mode 100644
index ce0bcfe..0000000
--- a/netlib/LAPACK/sgglse.f
+++ /dev/null
@@ -1,354 +0,0 @@
-*> \brief <b> SGGLSE solves overdetermined or underdetermined systems for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGLSE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgglse.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgglse.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgglse.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), C( * ), D( * ),
-* $ WORK( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGLSE solves the linear equality-constrained least squares (LSE)
-*> problem:
-*>
-*> minimize || c - A*x ||_2 subject to B*x = d
-*>
-*> where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
-*> M-vector, and d is a given P-vector. It is assumed that
-*> P <= N <= M+P, and
-*>
-*> rank(B) = P and rank( (A) ) = N.
-*> ( (B) )
-*>
-*> These conditions ensure that the LSE problem has a unique solution,
-*> which is obtained using a generalized RQ factorization of the
-*> matrices (B, A) given by
-*>
-*> B = (0 R)*Q, A = Z*T*Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. 0 <= P <= N <= M+P.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, the upper triangle of the subarray B(1:P,N-P+1:N)
-*> contains the P-by-P upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (M)
-*> On entry, C contains the right hand side vector for the
-*> least squares part of the LSE problem.
-*> On exit, the residual sum of squares for the solution
-*> is given by the sum of squares of elements N-P+1 to M of
-*> vector C.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (P)
-*> On entry, D contains the right hand side vector for the
-*> constrained equation.
-*> On exit, D is destroyed.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> On exit, X is the solution of the LSE problem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M+N+P).
-*> For optimum performance LWORK >= P+min(M,N)+max(M,N)*NB,
-*> where NB is an upper bound for the optimal blocksizes for
-*> SGEQRF, SGERQF, SORMQR and SORMRQ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1: the upper triangular factor R associated with B in the
-*> generalized RQ factorization of the pair (B, A) is
-*> singular, so that rank(B) < P; the least squares
-*> solution could not be computed.
-*> = 2: the (N-P) by (N-P) part of the upper trapezoidal factor
-*> T associated with A in the generalized RQ factorization
-*> of the pair (B, A) is singular, so that
-*> rank( (A) ) < N; the least squares solution could not
-*> ( (B) )
-*> be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERsolve
-*
-* =====================================================================
- SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), C( * ), D( * ),
- $ WORK( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LOPT, LWKMIN, LWKOPT, MN, NB, NB1, NB2, NB3,
- $ NB4, NR
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SGGRQF, SORMQR, SORMRQ,
- $ STRMV, STRTRS, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( P.LT.0 .OR. P.GT.N .OR. P.LT.N-M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -7
- END IF
-*
-* Calculate workspace
-*
- IF( INFO.EQ.0) THEN
- IF( N.EQ.0 ) THEN
- LWKMIN = 1
- LWKOPT = 1
- ELSE
- NB1 = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
- NB2 = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
- NB3 = ILAENV( 1, 'SORMQR', ' ', M, N, P, -1 )
- NB4 = ILAENV( 1, 'SORMRQ', ' ', M, N, P, -1 )
- NB = MAX( NB1, NB2, NB3, NB4 )
- LWKMIN = M + N + P
- LWKOPT = P + MN + MAX( M, N )*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGLSE', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Compute the GRQ factorization of matrices B and A:
-*
-* B*Q**T = ( 0 T12 ) P Z**T*A*Q**T = ( R11 R12 ) N-P
-* N-P P ( 0 R22 ) M+P-N
-* N-P P
-*
-* where T12 and R11 are upper triangular, and Q and Z are
-* orthogonal.
-*
- CALL SGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ),
- $ WORK( P+MN+1 ), LWORK-P-MN, INFO )
- LOPT = WORK( P+MN+1 )
-*
-* Update c = Z**T *c = ( c1 ) N-P
-* ( c2 ) M+P-N
-*
- CALL SORMQR( 'Left', 'Transpose', M, 1, MN, A, LDA, WORK( P+1 ),
- $ C, MAX( 1, M ), WORK( P+MN+1 ), LWORK-P-MN, INFO )
- LOPT = MAX( LOPT, INT( WORK( P+MN+1 ) ) )
-*
-* Solve T12*x2 = d for x2
-*
- IF( P.GT.0 ) THEN
- CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', P, 1,
- $ B( 1, N-P+1 ), LDB, D, P, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Put the solution in X
-*
- CALL SCOPY( P, D, 1, X( N-P+1 ), 1 )
-*
-* Update c1
-*
- CALL SGEMV( 'No transpose', N-P, P, -ONE, A( 1, N-P+1 ), LDA,
- $ D, 1, ONE, C, 1 )
- END IF
-*
-* Solve R11*x1 = c1 for x1
-*
- IF( N.GT.P ) THEN
- CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', N-P, 1,
- $ A, LDA, C, N-P, INFO )
-*
- IF( INFO.GT.0 ) THEN
- INFO = 2
- RETURN
- END IF
-*
-* Put the solutions in X
-*
- CALL SCOPY( N-P, C, 1, X, 1 )
- END IF
-*
-* Compute the residual vector:
-*
- IF( M.LT.N ) THEN
- NR = M + P - N
- IF( NR.GT.0 )
- $ CALL SGEMV( 'No transpose', NR, N-M, -ONE, A( N-P+1, M+1 ),
- $ LDA, D( NR+1 ), 1, ONE, C( N-P+1 ), 1 )
- ELSE
- NR = P
- END IF
- IF( NR.GT.0 ) THEN
- CALL STRMV( 'Upper', 'No transpose', 'Non unit', NR,
- $ A( N-P+1, N-P+1 ), LDA, D, 1 )
- CALL SAXPY( NR, -ONE, D, 1, C( N-P+1 ), 1 )
- END IF
-*
-* Backward transformation x = Q**T*x
-*
- CALL SORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), X,
- $ N, WORK( P+MN+1 ), LWORK-P-MN, INFO )
- WORK( 1 ) = P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) )
-*
- RETURN
-*
-* End of SGGLSE
-*
- END
diff --git a/netlib/LAPACK/sggqrf.f b/netlib/LAPACK/sggqrf.f
deleted file mode 100644
index 31f99bd..0000000
--- a/netlib/LAPACK/sggqrf.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b SGGQRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGQRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggqrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggqrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggqrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGQRF computes a generalized QR factorization of an N-by-M matrix A
-*> and an N-by-P matrix B:
-*>
-*> A = Q*R, B = Q*T*Z,
-*>
-*> where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
-*> matrix, and R and T assume one of the forms:
-*>
-*> if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
-*> ( 0 ) N-M N M-N
-*> M
-*>
-*> where R11 is upper triangular, and
-*>
-*> if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
-*> P-N N ( T21 ) P
-*> P
-*>
-*> where T12 or T21 is upper triangular.
-*>
-*> In particular, if B is square and nonsingular, the GQR factorization
-*> of A and B implicitly gives the QR factorization of inv(B)*A:
-*>
-*> inv(B)*A = Z**T*(inv(T)*R)
-*>
-*> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the
-*> transpose of the matrix Z.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of columns of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,M)
-*> On entry, the N-by-M matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(N,M)-by-M upper trapezoidal matrix R (R is
-*> upper triangular if N >= M); the elements below the diagonal,
-*> with the array TAUA, represent the orthogonal matrix Q as a
-*> product of min(N,M) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAUA
-*> \verbatim
-*> TAUA is REAL array, dimension (min(N,M))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q (see Further Details).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,P)
-*> On entry, the N-by-P matrix B.
-*> On exit, if N <= P, the upper triangle of the subarray
-*> B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
-*> if N > P, the elements on and above the (N-P)-th subdiagonal
-*> contain the N-by-P upper trapezoidal matrix T; the remaining
-*> elements, with the array TAUB, represent the orthogonal
-*> matrix Z as a product of elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAUB
-*> \verbatim
-*> TAUB is REAL array, dimension (min(N,P))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Z (see Further Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N,M,P).
-*> For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
-*> where NB1 is the optimal blocksize for the QR factorization
-*> of an N-by-M matrix, NB2 is the optimal blocksize for the
-*> RQ factorization of an N-by-P matrix, and NB3 is the optimal
-*> blocksize for a call of SORMQR.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(n,m).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taua * v * v**T
-*>
-*> where taua is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
-*> and taua in TAUA(i).
-*> To form Q explicitly, use LAPACK subroutine SORGQR.
-*> To use Q to update another matrix, use LAPACK subroutine SORMQR.
-*>
-*> The matrix Z is represented as a product of elementary reflectors
-*>
-*> Z = H(1) H(2) . . . H(k), where k = min(n,p).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taub * v * v**T
-*>
-*> where taub is a real scalar, and v is a real vector with
-*> v(p-k+i+1:p) = 0 and v(p-k+i) = 1; v(1:p-k+i-1) is stored on exit in
-*> B(n-k+i,1:p-k+i-1), and taub in TAUB(i).
-*> To form Z explicitly, use LAPACK subroutine SORGRQ.
-*> To use Z to update another matrix, use LAPACK subroutine SORMRQ.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LOPT, LWKOPT, NB, NB1, NB2, NB3
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGERQF, SORMQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB1 = ILAENV( 1, 'SGEQRF', ' ', N, M, -1, -1 )
- NB2 = ILAENV( 1, 'SGERQF', ' ', N, P, -1, -1 )
- NB3 = ILAENV( 1, 'SORMQR', ' ', N, M, P, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LWKOPT = MAX( N, M, P )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( P.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.MAX( 1, N, M, P ) .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* QR factorization of N-by-M matrix A: A = Q*R
-*
- CALL SGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
- LOPT = WORK( 1 )
-*
-* Update B := Q**T*B.
-*
- CALL SORMQR( 'Left', 'Transpose', N, P, MIN( N, M ), A, LDA, TAUA,
- $ B, LDB, WORK, LWORK, INFO )
- LOPT = MAX( LOPT, INT( WORK( 1 ) ) )
-*
-* RQ factorization of N-by-P matrix B: B = T*Z.
-*
- CALL SGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
- WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) )
-*
- RETURN
-*
-* End of SGGQRF
-*
- END
diff --git a/netlib/LAPACK/sggrqf.f b/netlib/LAPACK/sggrqf.f
deleted file mode 100644
index da26635..0000000
--- a/netlib/LAPACK/sggrqf.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b SGGRQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGGRQF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggrqf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggrqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggrqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGRQF computes a generalized RQ factorization of an M-by-N matrix A
-*> and a P-by-N matrix B:
-*>
-*> A = R*Q, B = Z*T*Q,
-*>
-*> where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
-*> matrix, and R and T assume one of the forms:
-*>
-*> if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
-*> N-M M ( R21 ) N
-*> N
-*>
-*> where R12 or R21 is upper triangular, and
-*>
-*> if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
-*> ( 0 ) P-N P N-P
-*> N
-*>
-*> where T11 is upper triangular.
-*>
-*> In particular, if B is square and nonsingular, the GRQ factorization
-*> of A and B implicitly gives the RQ factorization of A*inv(B):
-*>
-*> A*inv(B) = (R*inv(T))*Z**T
-*>
-*> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the
-*> transpose of the matrix Z.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, if M <= N, the upper triangle of the subarray
-*> A(1:M,N-M+1:N) contains the M-by-M upper triangular matrix R;
-*> if M > N, the elements on and above the (M-N)-th subdiagonal
-*> contain the M-by-N upper trapezoidal matrix R; the remaining
-*> elements, with the array TAUA, represent the orthogonal
-*> matrix Q as a product of elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAUA
-*> \verbatim
-*> TAUA is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q (see Further Details).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(P,N)-by-N upper trapezoidal matrix T (T is
-*> upper triangular if P >= N); the elements below the diagonal,
-*> with the array TAUB, represent the orthogonal matrix Z as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[out] TAUB
-*> \verbatim
-*> TAUB is REAL array, dimension (min(P,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Z (see Further Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N,M,P).
-*> For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
-*> where NB1 is the optimal blocksize for the RQ factorization
-*> of an M-by-N matrix, NB2 is the optimal blocksize for the
-*> QR factorization of a P-by-N matrix, and NB3 is the optimal
-*> blocksize for a call of SORMRQ.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INF0= -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taua * v * v**T
-*>
-*> where taua is a real scalar, and v is a real vector with
-*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*> A(m-k+i,1:n-k+i-1), and taua in TAUA(i).
-*> To form Q explicitly, use LAPACK subroutine SORGRQ.
-*> To use Q to update another matrix, use LAPACK subroutine SORMRQ.
-*>
-*> The matrix Z is represented as a product of elementary reflectors
-*>
-*> Z = H(1) H(2) . . . H(k), where k = min(p,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - taub * v * v**T
-*>
-*> where taub is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i),
-*> and taub in TAUB(i).
-*> To form Z explicitly, use LAPACK subroutine SORGQR.
-*> To use Z to update another matrix, use LAPACK subroutine SORMQR.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LWORK, M, N, P
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), TAUA( * ), TAUB( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LOPT, LWKOPT, NB, NB1, NB2, NB3
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQRF, SGERQF, SORMRQ, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB1 = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
- NB2 = ILAENV( 1, 'SGEQRF', ' ', P, N, -1, -1 )
- NB3 = ILAENV( 1, 'SORMRQ', ' ', M, N, P, -1 )
- NB = MAX( NB1, NB2, NB3 )
- LWKOPT = MAX( N, M, P)*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( P.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.MAX( 1, M, P, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGRQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* RQ factorization of M-by-N matrix A: A = R*Q
-*
- CALL SGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
- LOPT = WORK( 1 )
-*
-* Update B := B*Q**T
-*
- CALL SORMRQ( 'Right', 'Transpose', P, N, MIN( M, N ),
- $ A( MAX( 1, M-N+1 ), 1 ), LDA, TAUA, B, LDB, WORK,
- $ LWORK, INFO )
- LOPT = MAX( LOPT, INT( WORK( 1 ) ) )
-*
-* QR factorization of P-by-N matrix B: B = Z*T
-*
- CALL SGEQRF( P, N, B, LDB, TAUB, WORK, LWORK, INFO )
- WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) )
-*
- RETURN
-*
-* End of SGGRQF
-*
- END
diff --git a/netlib/LAPACK/sggsvd.f b/netlib/LAPACK/sggsvd.f
deleted file mode 100644
index 6320197..0000000
--- a/netlib/LAPACK/sggsvd.f
+++ /dev/null
@@ -1,462 +0,0 @@
-*> \brief <b> SGGSVD computes the singular value decomposition (SVD) for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggsvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggsvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
-* LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBQ, JOBU, JOBV
-* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), ALPHA( * ), B( LDB, * ),
-* $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
-* $ V( LDV, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGSVD computes the generalized singular value decomposition (GSVD)
-*> of an M-by-N real matrix A and P-by-N real matrix B:
-*>
-*> U**T*A*Q = D1*( 0 R ), V**T*B*Q = D2*( 0 R )
-*>
-*> where U, V and Q are orthogonal matrices.
-*> Let K+L = the effective numerical rank of the matrix (A**T,B**T)**T,
-*> then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
-*> D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
-*> following structures, respectively:
-*>
-*> If M-K-L >= 0,
-*>
-*> K L
-*> D1 = K ( I 0 )
-*> L ( 0 C )
-*> M-K-L ( 0 0 )
-*>
-*> K L
-*> D2 = L ( 0 S )
-*> P-L ( 0 0 )
-*>
-*> N-K-L K L
-*> ( 0 R ) = K ( 0 R11 R12 )
-*> L ( 0 0 R22 )
-*>
-*> where
-*>
-*> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
-*> S = diag( BETA(K+1), ... , BETA(K+L) ),
-*> C**2 + S**2 = I.
-*>
-*> R is stored in A(1:K+L,N-K-L+1:N) on exit.
-*>
-*> If M-K-L < 0,
-*>
-*> K M-K K+L-M
-*> D1 = K ( I 0 0 )
-*> M-K ( 0 C 0 )
-*>
-*> K M-K K+L-M
-*> D2 = M-K ( 0 S 0 )
-*> K+L-M ( 0 0 I )
-*> P-L ( 0 0 0 )
-*>
-*> N-K-L K M-K K+L-M
-*> ( 0 R ) = K ( 0 R11 R12 R13 )
-*> M-K ( 0 0 R22 R23 )
-*> K+L-M ( 0 0 0 R33 )
-*>
-*> where
-*>
-*> C = diag( ALPHA(K+1), ... , ALPHA(M) ),
-*> S = diag( BETA(K+1), ... , BETA(M) ),
-*> C**2 + S**2 = I.
-*>
-*> (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
-*> ( 0 R22 R23 )
-*> in B(M-K+1:L,N+M-K-L+1:N) on exit.
-*>
-*> The routine computes C, S, R, and optionally the orthogonal
-*> transformation matrices U, V and Q.
-*>
-*> In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
-*> A and B implicitly gives the SVD of A*inv(B):
-*> A*inv(B) = U*(D1*inv(D2))*V**T.
-*> If ( A**T,B**T)**T has orthonormal columns, then the GSVD of A and B is
-*> also equal to the CS decomposition of A and B. Furthermore, the GSVD
-*> can be used to derive the solution of the eigenvalue problem:
-*> A**T*A x = lambda* B**T*B x.
-*> In some literature, the GSVD of A and B is presented in the form
-*> U**T*A*X = ( 0 D1 ), V**T*B*X = ( 0 D2 )
-*> where U and V are orthogonal and X is nonsingular, D1 and D2 are
-*> ``diagonal''. The former GSVD form can be converted to the latter
-*> form by taking the nonsingular matrix X as
-*>
-*> X = Q*( I 0 )
-*> ( 0 inv(R) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> = 'U': Orthogonal matrix U is computed;
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> = 'V': Orthogonal matrix V is computed;
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBQ
-*> \verbatim
-*> JOBQ is CHARACTER*1
-*> = 'Q': Orthogonal matrix Q is computed;
-*> = 'N': Q is not computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> \endverbatim
-*>
-*> \param[out] L
-*> \verbatim
-*> L is INTEGER
-*>
-*> On exit, K and L specify the dimension of the subblocks
-*> described in Purpose.
-*> K + L = effective numerical rank of (A**T,B**T)**T.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A contains the triangular matrix R, or part of R.
-*> See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, B contains the triangular matrix R if M-K-L < 0.
-*> See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[out] ALPHA
-*> \verbatim
-*> ALPHA is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*>
-*> On exit, ALPHA and BETA contain the generalized singular
-*> value pairs of A and B;
-*> ALPHA(1:K) = 1,
-*> BETA(1:K) = 0,
-*> and if M-K-L >= 0,
-*> ALPHA(K+1:K+L) = C,
-*> BETA(K+1:K+L) = S,
-*> or if M-K-L < 0,
-*> ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
-*> BETA(K+1:M) =S, BETA(M+1:K+L) =1
-*> and
-*> ALPHA(K+L+1:N) = 0
-*> BETA(K+L+1:N) = 0
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,M)
-*> If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
-*> If JOBU = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,M) if
-*> JOBU = 'U'; LDU >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,P)
-*> If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
-*> If JOBV = 'N', V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,P) if
-*> JOBV = 'V'; LDV >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
-*> If JOBQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N) if
-*> JOBQ = 'Q'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array,
-*> dimension (max(3*N,M,P)+N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> On exit, IWORK stores the sorting information. More
-*> precisely, the following loop will sort ALPHA
-*> for I = K+1, min(M,K+L)
-*> swap ALPHA(I) and ALPHA(IWORK(I))
-*> endfor
-*> such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, the Jacobi-type procedure failed to
-*> converge. For further details, see subroutine STGSJA.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLA REAL
-*> TOLB REAL
-*> TOLA and TOLB are the thresholds to determine the effective
-*> rank of (A**T,B**T)**T. Generally, they are set to
-*> TOLA = MAX(M,N)*norm(A)*MACHEPS,
-*> TOLB = MAX(P,N)*norm(B)*MACHEPS.
-*> The size of TOLA and TOLB may affect the size of backward
-*> errors of the decomposition.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERsing
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
- $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBQ, JOBU, JOBV
- INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
- $ V( LDV, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL WANTQ, WANTU, WANTV
- INTEGER I, IBND, ISUB, J, NCYCLE
- REAL ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANGE
- EXTERNAL LSAME, SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGGSVP, STGSJA, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTU = LSAME( JOBU, 'U' )
- WANTV = LSAME( JOBV, 'V' )
- WANTQ = LSAME( JOBQ, 'Q' )
-*
- INFO = 0
- IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( P.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -12
- ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
- INFO = -16
- ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
- INFO = -18
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -20
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGSVD', -INFO )
- RETURN
- END IF
-*
-* Compute the Frobenius norm of matrices A and B
-*
- ANORM = SLANGE( '1', M, N, A, LDA, WORK )
- BNORM = SLANGE( '1', P, N, B, LDB, WORK )
-*
-* Get machine precision and set up threshold for determining
-* the effective numerical rank of the matrices A and B.
-*
- ULP = SLAMCH( 'Precision' )
- UNFL = SLAMCH( 'Safe Minimum' )
- TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP
- TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP
-*
-* Preprocessing
-*
- CALL SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA,
- $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK,
- $ WORK( N+1 ), INFO )
-*
-* Compute the GSVD of two upper "triangular" matrices
-*
- CALL STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, LDB,
- $ TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
- $ WORK, NCYCLE, INFO )
-*
-* Sort the singular values and store the pivot indices in IWORK
-* Copy ALPHA to WORK, then sort ALPHA in WORK
-*
- CALL SCOPY( N, ALPHA, 1, WORK, 1 )
- IBND = MIN( L, M-K )
- DO 20 I = 1, IBND
-*
-* Scan for largest ALPHA(K+I)
-*
- ISUB = I
- SMAX = WORK( K+I )
- DO 10 J = I + 1, IBND
- TEMP = WORK( K+J )
- IF( TEMP.GT.SMAX ) THEN
- ISUB = J
- SMAX = TEMP
- END IF
- 10 CONTINUE
- IF( ISUB.NE.I ) THEN
- WORK( K+ISUB ) = WORK( K+I )
- WORK( K+I ) = SMAX
- IWORK( K+I ) = K + ISUB
- ELSE
- IWORK( K+I ) = K + I
- END IF
- 20 CONTINUE
-*
- RETURN
-*
-* End of SGGSVD
-*
- END
diff --git a/netlib/LAPACK/sggsvp.f b/netlib/LAPACK/sggsvp.f
deleted file mode 100644
index f89c352..0000000
--- a/netlib/LAPACK/sggsvp.f
+++ /dev/null
@@ -1,520 +0,0 @@
-*> \brief \b SGGSVP
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggsvp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggsvp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
-* TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
-* IWORK, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBQ, JOBU, JOBV
-* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
-* REAL TOLA, TOLB
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGGSVP computes orthogonal matrices U, V and Q such that
-*>
-*> N-K-L K L
-*> U**T*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
-*> L ( 0 0 A23 )
-*> M-K-L ( 0 0 0 )
-*>
-*> N-K-L K L
-*> = K ( 0 A12 A13 ) if M-K-L < 0;
-*> M-K ( 0 0 A23 )
-*>
-*> N-K-L K L
-*> V**T*B*Q = L ( 0 0 B13 )
-*> P-L ( 0 0 0 )
-*>
-*> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
-*> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
-*> otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
-*> numerical rank of the (M+P)-by-N matrix (A**T,B**T)**T.
-*>
-*> This decomposition is the preprocessing step for computing the
-*> Generalized Singular Value Decomposition (GSVD), see subroutine
-*> SGGSVD.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> = 'U': Orthogonal matrix U is computed;
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> = 'V': Orthogonal matrix V is computed;
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBQ
-*> \verbatim
-*> JOBQ is CHARACTER*1
-*> = 'Q': Orthogonal matrix Q is computed;
-*> = 'N': Q is not computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A contains the triangular (or trapezoidal) matrix
-*> described in the Purpose section.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, B contains the triangular matrix described in
-*> the Purpose section.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[in] TOLA
-*> \verbatim
-*> TOLA is REAL
-*> \endverbatim
-*>
-*> \param[in] TOLB
-*> \verbatim
-*> TOLB is REAL
-*>
-*> TOLA and TOLB are the thresholds to determine the effective
-*> numerical rank of matrix B and a subblock of A. Generally,
-*> they are set to
-*> TOLA = MAX(M,N)*norm(A)*MACHEPS,
-*> TOLB = MAX(P,N)*norm(B)*MACHEPS.
-*> The size of TOLA and TOLB may affect the size of backward
-*> errors of the decomposition.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> \endverbatim
-*>
-*> \param[out] L
-*> \verbatim
-*> L is INTEGER
-*>
-*> On exit, K and L specify the dimension of the subblocks
-*> described in Purpose section.
-*> K + L = effective numerical rank of (A**T,B**T)**T.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,M)
-*> If JOBU = 'U', U contains the orthogonal matrix U.
-*> If JOBU = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,M) if
-*> JOBU = 'U'; LDU >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,P)
-*> If JOBV = 'V', V contains the orthogonal matrix V.
-*> If JOBV = 'N', V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,P) if
-*> JOBV = 'V'; LDV >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> If JOBQ = 'Q', Q contains the orthogonal matrix Q.
-*> If JOBQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N) if
-*> JOBQ = 'Q'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (max(3*N,M,P))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> The subroutine uses LAPACK subroutine SGEQPF for the QR factorization
-*> with column pivoting to detect the effective numerical rank of the
-*> a matrix. It may be replaced by a better rank determination strategy.
-*>
-* =====================================================================
- SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
- $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
- $ IWORK, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBQ, JOBU, JOBV
- INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
- REAL TOLA, TOLB
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL FORWRD, WANTQ, WANTU, WANTV
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEQPF, SGEQR2, SGERQ2, SLACPY, SLAPMT, SLASET,
- $ SORG2R, SORM2R, SORMR2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTU = LSAME( JOBU, 'U' )
- WANTV = LSAME( JOBV, 'V' )
- WANTQ = LSAME( JOBQ, 'Q' )
- FORWRD = .TRUE.
-*
- INFO = 0
- IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( P.LT.0 ) THEN
- INFO = -5
- ELSE IF( N.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -10
- ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
- INFO = -16
- ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
- INFO = -18
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -20
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGGSVP', -INFO )
- RETURN
- END IF
-*
-* QR with column pivoting of B: B*P = V*( S11 S12 )
-* ( 0 0 )
-*
- DO 10 I = 1, N
- IWORK( I ) = 0
- 10 CONTINUE
- CALL SGEQPF( P, N, B, LDB, IWORK, TAU, WORK, INFO )
-*
-* Update A := A*P
-*
- CALL SLAPMT( FORWRD, M, N, A, LDA, IWORK )
-*
-* Determine the effective rank of matrix B.
-*
- L = 0
- DO 20 I = 1, MIN( P, N )
- IF( ABS( B( I, I ) ).GT.TOLB )
- $ L = L + 1
- 20 CONTINUE
-*
- IF( WANTV ) THEN
-*
-* Copy the details of V, and form V.
-*
- CALL SLASET( 'Full', P, P, ZERO, ZERO, V, LDV )
- IF( P.GT.1 )
- $ CALL SLACPY( 'Lower', P-1, N, B( 2, 1 ), LDB, V( 2, 1 ),
- $ LDV )
- CALL SORG2R( P, P, MIN( P, N ), V, LDV, TAU, WORK, INFO )
- END IF
-*
-* Clean up B
-*
- DO 40 J = 1, L - 1
- DO 30 I = J + 1, L
- B( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- IF( P.GT.L )
- $ CALL SLASET( 'Full', P-L, N, ZERO, ZERO, B( L+1, 1 ), LDB )
-*
- IF( WANTQ ) THEN
-*
-* Set Q = I and Update Q := Q*P
-*
- CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
- CALL SLAPMT( FORWRD, N, N, Q, LDQ, IWORK )
- END IF
-*
- IF( P.GE.L .AND. N.NE.L ) THEN
-*
-* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z
-*
- CALL SGERQ2( L, N, B, LDB, TAU, WORK, INFO )
-*
-* Update A := A*Z**T
-*
- CALL SORMR2( 'Right', 'Transpose', M, N, L, B, LDB, TAU, A,
- $ LDA, WORK, INFO )
-*
- IF( WANTQ ) THEN
-*
-* Update Q := Q*Z**T
-*
- CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q,
- $ LDQ, WORK, INFO )
- END IF
-*
-* Clean up B
-*
- CALL SLASET( 'Full', L, N-L, ZERO, ZERO, B, LDB )
- DO 60 J = N - L + 1, N
- DO 50 I = J - N + L + 1, L
- B( I, J ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
- END IF
-*
-* Let N-L L
-* A = ( A11 A12 ) M,
-*
-* then the following does the complete QR decomposition of A11:
-*
-* A11 = U*( 0 T12 )*P1**T
-* ( 0 0 )
-*
- DO 70 I = 1, N - L
- IWORK( I ) = 0
- 70 CONTINUE
- CALL SGEQPF( M, N-L, A, LDA, IWORK, TAU, WORK, INFO )
-*
-* Determine the effective rank of A11
-*
- K = 0
- DO 80 I = 1, MIN( M, N-L )
- IF( ABS( A( I, I ) ).GT.TOLA )
- $ K = K + 1
- 80 CONTINUE
-*
-* Update A12 := U**T*A12, where A12 = A( 1:M, N-L+1:N )
-*
- CALL SORM2R( 'Left', 'Transpose', M, L, MIN( M, N-L ), A, LDA,
- $ TAU, A( 1, N-L+1 ), LDA, WORK, INFO )
-*
- IF( WANTU ) THEN
-*
-* Copy the details of U, and form U
-*
- 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 SORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO )
- END IF
-*
- IF( WANTQ ) THEN
-*
-* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1
-*
- CALL SLAPMT( FORWRD, N, N-L, Q, LDQ, IWORK )
- END IF
-*
-* Clean up A: set the strictly lower triangular part of
-* A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0.
-*
- DO 100 J = 1, K - 1
- DO 90 I = J + 1, K
- A( I, J ) = ZERO
- 90 CONTINUE
- 100 CONTINUE
- IF( M.GT.K )
- $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA )
-*
- IF( N-L.GT.K ) THEN
-*
-* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1
-*
- CALL SGERQ2( K, N-L, A, LDA, TAU, WORK, INFO )
-*
- IF( WANTQ ) THEN
-*
-* 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 )
- END IF
-*
-* Clean up A
-*
- CALL SLASET( 'Full', K, N-L-K, ZERO, ZERO, A, LDA )
- DO 120 J = N - L - K + 1, N - L
- DO 110 I = J - N + L + K + 1, K
- A( I, J ) = ZERO
- 110 CONTINUE
- 120 CONTINUE
-*
- END IF
-*
- IF( M.GT.K ) THEN
-*
-* QR factorization of A( K+1:M,N-L+1:N )
-*
- CALL SGEQR2( M-K, L, A( K+1, N-L+1 ), LDA, TAU, WORK, INFO )
-*
- IF( WANTU ) THEN
-*
-* 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 )
- END IF
-*
-* Clean up
-*
- DO 140 J = N - L + 1, N
- DO 130 I = J - N + K + L + 1, M
- A( I, J ) = ZERO
- 130 CONTINUE
- 140 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of SGGSVP
-*
- END
diff --git a/netlib/LAPACK/sgsvj0.f b/netlib/LAPACK/sgsvj0.f
deleted file mode 100644
index 48defb8..0000000
--- a/netlib/LAPACK/sgsvj0.f
+++ /dev/null
@@ -1,1078 +0,0 @@
-*> \brief \b SGSVJ0 pre-processor for the routine sgesvj.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGSVJ0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgsvj0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgsvj0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgsvj0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
-* SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDV, LWORK, M, MV, N, NSWEEP
-* REAL EPS, SFMIN, TOL
-* CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), SVA( N ), D( N ), V( LDV, * ),
-* $ WORK( LWORK )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGSVJ0 is called from SGESVJ as a pre-processor and that is its main
-*> purpose. It applies Jacobi rotations in the same way as SGESVJ does, but
-*> it does not check convergence (stopping criterion). Few tuning
-*> parameters (marked by [TP]) are available for the implementer.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether the output from this procedure is used
-*> to compute the matrix V:
-*> = 'V': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the N-by-N array V.
-*> (See the description of V.)
-*> = 'A': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the MV-by-N array V.
-*> (See the descriptions of MV and V.)
-*> = 'N': the Jacobi rotations are not accumulated.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A.
-*> M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, M-by-N matrix A, such that A*diag(D) represents
-*> the input matrix.
-*> On exit,
-*> A_onexit * D_onexit represents the input matrix A*diag(D)
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of D, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The array D accumulates the scaling factors from the fast scaled
-*> Jacobi rotations.
-*> On entry, A*diag(D) represents the input matrix.
-*> On exit, A_onexit*diag(D_onexit) represents the input matrix
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of A, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in,out] SVA
-*> \verbatim
-*> SVA is REAL array, dimension (N)
-*> On entry, SVA contains the Euclidean norms of the columns of
-*> the matrix A*diag(D).
-*> On exit, SVA contains the Euclidean norms of the columns of
-*> the matrix onexit*diag(D_onexit).
-*> \endverbatim
-*>
-*> \param[in] MV
-*> \verbatim
-*> MV is INTEGER
-*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then MV is not referenced.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,N)
-*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV >= 1.
-*> If JOBV = 'V', LDV .GE. N.
-*> If JOBV = 'A', LDV .GE. MV.
-*> \endverbatim
-*>
-*> \param[in] EPS
-*> \verbatim
-*> EPS is REAL
-*> EPS = SLAMCH('Epsilon')
-*> \endverbatim
-*>
-*> \param[in] SFMIN
-*> \verbatim
-*> SFMIN is REAL
-*> SFMIN = SLAMCH('Safe Minimum')
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is REAL
-*> TOL is the threshold for Jacobi rotations. For a pair
-*> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is
-*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL.
-*> \endverbatim
-*>
-*> \param[in] NSWEEP
-*> \verbatim
-*> NSWEEP is INTEGER
-*> NSWEEP is the number of sweeps of Jacobi rotations to be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> LWORK is the dimension of WORK. LWORK .GE. M.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit.
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> SGSVJ0 is used just to enable SGESVJ to call a simplified version of
-*> itself to work on a submatrix of the original matrix.
-*>
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*>
-*> \par Bugs, Examples and Comments:
-* =================================
-*>
-*> Please report all bugs and send interesting test examples and comments to
-*> drmac at math.hr. Thank you.
-*
-* =====================================================================
- SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
- $ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDV, LWORK, M, MV, N, NSWEEP
- REAL EPS, SFMIN, TOL
- CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), SVA( N ), D( N ), V( LDV, * ),
- $ WORK( LWORK )
-* ..
-*
-* =====================================================================
-*
-* .. Local Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0)
-* ..
-* .. Local Scalars ..
- REAL AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
- $ BIGTHETA, CS, MXAAPQ, MXSINJ, ROOTBIG, ROOTEPS,
- $ ROOTSFMIN, ROOTTOL, SMALL, SN, T, TEMP1, THETA,
- $ THSIGN
- INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
- $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, NBL,
- $ NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND
- LOGICAL APPLV, ROTOK, RSVEC
-* ..
-* .. Local Arrays ..
- REAL FASTR( 5 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, AMAX1, FLOAT, MIN0, SIGN, SQRT
-* ..
-* .. External Functions ..
- REAL SDOT, SNRM2
- INTEGER ISAMAX
- LOGICAL LSAME
- EXTERNAL ISAMAX, LSAME, SDOT, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- APPLV = LSAME( JOBV, 'A' )
- RSVEC = LSAME( JOBV, 'V' )
- IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN
- INFO = -3
- ELSE IF( LDA.LT.M ) THEN
- INFO = -5
- ELSE IF( ( RSVEC.OR.APPLV ) .AND. ( MV.LT.0 ) ) THEN
- INFO = -8
- ELSE IF( ( RSVEC.AND.( LDV.LT.N ) ).OR.
- $ ( APPLV.AND.( LDV.LT.MV ) ) ) THEN
- INFO = -10
- ELSE IF( TOL.LE.EPS ) THEN
- INFO = -13
- ELSE IF( NSWEEP.LT.0 ) THEN
- INFO = -14
- ELSE IF( LWORK.LT.M ) THEN
- INFO = -16
- ELSE
- INFO = 0
- END IF
-*
-* #:(
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGSVJ0', -INFO )
- RETURN
- END IF
-*
- IF( RSVEC ) THEN
- MVL = N
- ELSE IF( APPLV ) THEN
- MVL = MV
- END IF
- RSVEC = RSVEC .OR. APPLV
-
- ROOTEPS = SQRT( EPS )
- ROOTSFMIN = SQRT( SFMIN )
- SMALL = SFMIN / EPS
- BIG = ONE / SFMIN
- ROOTBIG = ONE / ROOTSFMIN
- BIGTHETA = ONE / ROOTEPS
- ROOTTOL = SQRT( TOL )
-*
-* .. Row-cyclic Jacobi SVD algorithm with column pivoting ..
-*
- EMPTSW = ( N*( N-1 ) ) / 2
- NOTROT = 0
- FASTR( 1 ) = ZERO
-*
-* .. Row-cyclic pivot strategy with de Rijk's pivoting ..
-*
-
- SWBAND = 0
-*[TP] SWBAND is a tuning parameter. It is meaningful and effective
-* if SGESVJ is used as a computational routine in the preconditioned
-* Jacobi SVD algorithm SGESVJ. For sweeps i=1:SWBAND the procedure
-* ......
-
- KBL = MIN0( 8, N )
-*[TP] KBL is a tuning parameter that defines the tile size in the
-* tiling of the p-q loops of pivot pairs. In general, an optimal
-* value of KBL depends on the matrix dimensions and on the
-* parameters of the computer's memory.
-*
- NBL = N / KBL
- IF( ( NBL*KBL ).NE.N )NBL = NBL + 1
-
- BLSKIP = ( KBL**2 ) + 1
-*[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
-
- ROWSKIP = MIN0( 5, KBL )
-*[TP] ROWSKIP is a tuning parameter.
-
- LKAHEAD = 1
-*[TP] LKAHEAD is a tuning parameter.
- SWBAND = 0
- PSKIPPED = 0
-*
- DO 1993 i = 1, NSWEEP
-* .. go go go ...
-*
- MXAAPQ = ZERO
- MXSINJ = ZERO
- ISWROT = 0
-*
- NOTROT = 0
- PSKIPPED = 0
-*
- DO 2000 ibr = 1, NBL
-
- igl = ( ibr-1 )*KBL + 1
-*
- DO 1002 ir1 = 0, MIN0( LKAHEAD, NBL-ibr )
-*
- igl = igl + ir1*KBL
-*
- DO 2001 p = igl, MIN0( igl+KBL-1, N-1 )
-
-* .. de Rijk's pivoting
- q = ISAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- CALL SSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL SSWAP( MVL, V( 1, p ), 1,
- $ V( 1, q ), 1 )
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = D( p )
- D( p ) = D( q )
- D( q ) = TEMP1
- END IF
-*
- IF( ir1.EQ.0 ) THEN
-*
-* Column norms are periodically updated by explicit
-* norm computation.
-* Caveat:
-* Some BLAS implementations compute SNRM2(M,A(1,p),1)
-* as SQRT(SDOT(M,A(1,p),1,A(1,p),1)), which may result in
-* overflow for ||A(:,p)||_2 > SQRT(overflow_threshold), and
-* undeflow for ||A(:,p)||_2 < SQRT(underflow_threshold).
-* Hence, SNRM2 cannot be trusted, not even in the case when
-* the true norm is far from the under(over)flow boundaries.
-* If properly implemented SNRM2 is available, the IF-THEN-ELSE
-* below should read "AAPP = SNRM2( M, A(1,p), 1 ) * D(p)".
-*
- IF( ( SVA( p ).LT.ROOTBIG ) .AND.
- $ ( SVA( p ).GT.ROOTSFMIN ) ) THEN
- SVA( p ) = SNRM2( M, A( 1, p ), 1 )*D( p )
- ELSE
- TEMP1 = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, TEMP1, AAPP )
- SVA( p ) = TEMP1*SQRT( AAPP )*D( p )
- END IF
- AAPP = SVA( p )
- ELSE
- AAPP = SVA( p )
- END IF
-
-*
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2002 q = p + 1, MIN0( igl+KBL-1, N )
-*
- AAQQ = SVA( q )
-
- IF( AAQQ.GT.ZERO ) THEN
-*
- AAPP0 = AAPP
- IF( AAQQ.GE.ONE ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL SCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, D( p ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = SDOT( M, WORK, 1, A( 1, q ),
- $ 1 )*D( q ) / AAQQ
- END IF
- ELSE
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL SCOPY( M, A( 1, q ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ, D( q ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = SDOT( M, WORK, 1, A( 1, p ),
- $ 1 )*D( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( ABS( AAPQ ).GT.TOL ) THEN
-*
-* .. rotate
-* ROTATED = ROTATED + ONE
-*
- IF( ir1.EQ.0 ) THEN
- NOTROT = 0
- PSKIPPED = 0
- ISWROT = ISWROT + 1
- END IF
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*ABS( AQOAP-APOAQ ) / AAPQ
-*
- IF( ABS( THETA ).GT.BIGTHETA ) THEN
-*
- T = HALF / THETA
- FASTR( 3 ) = T*D( p ) / D( q )
- FASTR( 4 ) = -T*D( q ) / D( p )
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, ABS( T ) )
-*
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -SIGN( ONE, AAPQ )
- T = ONE / ( THETA+THSIGN*
- $ SQRT( ONE+THETA*THETA ) )
- CS = SQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
-*
- MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = D( p ) / D( q )
- AQOAP = D( q ) / D( p )
- IF( D( p ).GE.ONE ) THEN
- IF( D( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- D( p ) = D( p )*CS
- D( q ) = D( q )*CS
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- END IF
- ELSE
- IF( D( q ).GE.ONE ) THEN
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- ELSE
- IF( D( p ).GE.D( q ) ) THEN
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-* .. have to use modified Gram-Schmidt like transformation
- CALL SCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE, M,
- $ 1, WORK, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE, M,
- $ 1, A( 1, q ), LDA, IERR )
- TEMP1 = -AAPQ*D( p ) / D( q )
- CALL SAXPY( M, TEMP1, WORK, 1,
- $ A( 1, q ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAQQ, M,
- $ 1, A( 1, q ), LDA, IERR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q), SVA(p)
-* recompute SVA(q), SVA(p).
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = SNRM2( M, A( 1, q ), 1 )*
- $ D( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*SQRT( AAQQ )*D( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 ).LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = SNRM2( M, A( 1, p ), 1 )*
- $ D( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*SQRT( AAPP )*D( p )
- END IF
- SVA( p ) = AAPP
- END IF
-*
- ELSE
-* A(:,p) and A(:,q) already numerically orthogonal
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- END IF
- ELSE
-* A(:,q) is zero column
- IF( ir1.EQ.0 )NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- IF( ir1.EQ.0 )AAPP = -AAPP
- NOTROT = 0
- GO TO 2103
- END IF
-*
- 2002 CONTINUE
-* END q-LOOP
-*
- 2103 CONTINUE
-* bailed out of q-loop
-
- SVA( p ) = AAPP
-
- ELSE
- SVA( p ) = AAPP
- IF( ( ir1.EQ.0 ) .AND. ( AAPP.EQ.ZERO ) )
- $ NOTROT = NOTROT + MIN0( igl+KBL-1, N ) - p
- END IF
-*
- 2001 CONTINUE
-* end of the p-loop
-* end of doing the block ( ibr, ibr )
- 1002 CONTINUE
-* end of ir1-loop
-*
-*........................................................
-* ... go to the off diagonal blocks
-*
- igl = ( ibr-1 )*KBL + 1
-*
- DO 2010 jbc = ibr + 1, NBL
-*
- jgl = ( jbc-1 )*KBL + 1
-*
-* doing the block at ( ibr, jbc )
-*
- IJBLSK = 0
- DO 2100 p = igl, MIN0( igl+KBL-1, N )
-*
- AAPP = SVA( p )
-*
- IF( AAPP.GT.ZERO ) THEN
-*
- PSKIPPED = 0
-*
- DO 2200 q = jgl, MIN0( jgl+KBL-1, N )
-*
- AAQQ = SVA( q )
-*
- IF( AAQQ.GT.ZERO ) THEN
- AAPP0 = AAPP
-*
-* .. M x 2 Jacobi SVD ..
-*
-* .. Safe Gram matrix computation ..
-*
- IF( AAQQ.GE.ONE ) THEN
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- ELSE
- ROTOK = ( SMALL*AAQQ ).LE.AAPP
- END IF
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL SCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, D( p ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = SDOT( M, WORK, 1, A( 1, q ),
- $ 1 )*D( q ) / AAQQ
- END IF
- ELSE
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- ELSE
- ROTOK = AAQQ.LE.( AAPP / SMALL )
- END IF
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL SCOPY( M, A( 1, q ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ, D( q ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = SDOT( M, WORK, 1, A( 1, p ),
- $ 1 )*D( p ) / AAPP
- END IF
- END IF
-*
- MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) )
-*
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( ABS( AAPQ ).GT.TOL ) THEN
- NOTROT = 0
-* ROTATED = ROTATED + 1
- PSKIPPED = 0
- ISWROT = ISWROT + 1
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*ABS( AQOAP-APOAQ ) / AAPQ
- IF( AAQQ.GT.AAPP0 )THETA = -THETA
-*
- IF( ABS( THETA ).GT.BIGTHETA ) THEN
- T = HALF / THETA
- FASTR( 3 ) = T*D( p ) / D( q )
- FASTR( 4 ) = -T*D( q ) / D( p )
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, ABS( T ) )
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -SIGN( ONE, AAPQ )
- IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
- T = ONE / ( THETA+THSIGN*
- $ SQRT( ONE+THETA*THETA ) )
- CS = SQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
- MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-*
- APOAQ = D( p ) / D( q )
- AQOAP = D( q ) / D( p )
- IF( D( p ).GE.ONE ) THEN
-*
- IF( D( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- D( p ) = D( p )*CS
- D( q ) = D( q )*CS
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- END IF
- ELSE
- IF( D( q ).GE.ONE ) THEN
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- ELSE
- IF( D( p ).GE.D( q ) ) THEN
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
- IF( AAPP.GT.AAQQ ) THEN
- CALL SCOPY( M, A( 1, p ), 1, WORK,
- $ 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( p ) / D( q )
- CALL SAXPY( M, TEMP1, WORK, 1,
- $ A( 1, q ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAQQ,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- ELSE
- CALL SCOPY( M, A( 1, q ), 1, WORK,
- $ 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( q ) / D( p )
- CALL SAXPY( M, TEMP1, WORK, 1,
- $ A( 1, p ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAPP,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- SVA( p ) = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- END IF
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q)
-* .. recompute SVA(q)
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = SNRM2( M, A( 1, q ), 1 )*
- $ D( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*SQRT( AAQQ )*D( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = SNRM2( M, A( 1, p ), 1 )*
- $ D( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*SQRT( AAPP )*D( p )
- END IF
- SVA( p ) = AAPP
- END IF
-* end of OK rotation
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
-*
- IF( ( i.LE.SWBAND ) .AND. ( IJBLSK.GE.BLSKIP ) )
- $ THEN
- SVA( p ) = AAPP
- NOTROT = 0
- GO TO 2011
- END IF
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- AAPP = -AAPP
- NOTROT = 0
- GO TO 2203
- END IF
-*
- 2200 CONTINUE
-* end of the q-loop
- 2203 CONTINUE
-*
- SVA( p ) = AAPP
-*
- ELSE
- IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
- $ MIN0( jgl+KBL-1, N ) - jgl + 1
- IF( AAPP.LT.ZERO )NOTROT = 0
- END IF
-
- 2100 CONTINUE
-* end of the p-loop
- 2010 CONTINUE
-* end of the jbc-loop
- 2011 CONTINUE
-*2011 bailed out of the jbc-loop
- DO 2012 p = igl, MIN0( igl+KBL-1, N )
- SVA( p ) = ABS( SVA( p ) )
- 2012 CONTINUE
-*
- 2000 CONTINUE
-*2000 :: end of the ibr-loop
-*
-* .. update SVA(N)
- IF( ( SVA( N ).LT.ROOTBIG ) .AND. ( SVA( N ).GT.ROOTSFMIN ) )
- $ THEN
- SVA( N ) = SNRM2( M, A( 1, N ), 1 )*D( N )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, N ), 1, T, AAPP )
- SVA( N ) = T*SQRT( AAPP )*D( N )
- END IF
-*
-* Additional steering devices
-*
- IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
- $ ( ISWROT.LE.N ) ) )SWBAND = i
-*
- IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.FLOAT( N )*TOL ) .AND.
- $ ( FLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
- GO TO 1994
- END IF
-*
- IF( NOTROT.GE.EMPTSW )GO TO 1994
-
- 1993 CONTINUE
-* end i=1:NSWEEP loop
-* #:) Reaching this point means that the procedure has comleted the given
-* number of iterations.
- INFO = NSWEEP - 1
- GO TO 1995
- 1994 CONTINUE
-* #:) Reaching this point means that during the i-th sweep all pivots were
-* below the given tolerance, causing early exit.
-*
- INFO = 0
-* #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
-*
-* Sort the vector D.
- DO 5991 p = 1, N - 1
- q = ISAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = D( p )
- D( p ) = D( q )
- D( q ) = TEMP1
- CALL SSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL SSWAP( MVL, V( 1, p ), 1, V( 1, q ), 1 )
- END IF
- 5991 CONTINUE
-*
- RETURN
-* ..
-* .. END OF SGSVJ0
-* ..
- END
diff --git a/netlib/LAPACK/sgsvj1.f b/netlib/LAPACK/sgsvj1.f
deleted file mode 100644
index dca8f38..0000000
--- a/netlib/LAPACK/sgsvj1.f
+++ /dev/null
@@ -1,783 +0,0 @@
-*> \brief \b SGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGSVJ1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgsvj1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgsvj1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgsvj1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
-* EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* REAL EPS, SFMIN, TOL
-* INTEGER INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP
-* CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( N ), SVA( N ), V( LDV, * ),
-* $ WORK( LWORK )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGSVJ1 is called from SGESVJ as a pre-processor and that is its main
-*> purpose. It applies Jacobi rotations in the same way as SGESVJ does, but
-*> it targets only particular pivots and it does not check convergence
-*> (stopping criterion). Few tunning parameters (marked by [TP]) are
-*> available for the implementer.
-*>
-*> Further Details
-*> ~~~~~~~~~~~~~~~
-*> SGSVJ1 applies few sweeps of Jacobi rotations in the column space of
-*> the input M-by-N matrix A. The pivot pairs are taken from the (1,2)
-*> off-diagonal block in the corresponding N-by-N Gram matrix A^T * A. The
-*> block-entries (tiles) of the (1,2) off-diagonal block are marked by the
-*> [x]'s in the following scheme:
-*>
-*> | * * * [x] [x] [x]|
-*> | * * * [x] [x] [x]| Row-cycling in the nblr-by-nblc [x] blocks.
-*> | * * * [x] [x] [x]| Row-cyclic pivoting inside each [x] block.
-*> |[x] [x] [x] * * * |
-*> |[x] [x] [x] * * * |
-*> |[x] [x] [x] * * * |
-*>
-*> In terms of the columns of A, the first N1 columns are rotated 'against'
-*> the remaining N-N1 columns, trying to increase the angle between the
-*> corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is
-*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parmeter.
-*> The number of sweeps is given in NSWEEP and the orthogonality threshold
-*> is given in TOL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> Specifies whether the output from this procedure is used
-*> to compute the matrix V:
-*> = 'V': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the N-by-N array V.
-*> (See the description of V.)
-*> = 'A': the product of the Jacobi rotations is accumulated
-*> by postmulyiplying the MV-by-N array V.
-*> (See the descriptions of MV and V.)
-*> = 'N': the Jacobi rotations are not accumulated.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A.
-*> M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> N1 specifies the 2 x 2 block partition, the first N1 columns are
-*> rotated 'against' the remaining N-N1 columns of A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, M-by-N matrix A, such that A*diag(D) represents
-*> the input matrix.
-*> On exit,
-*> A_onexit * D_onexit represents the input matrix A*diag(D)
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of N1, D, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The array D accumulates the scaling factors from the fast scaled
-*> Jacobi rotations.
-*> On entry, A*diag(D) represents the input matrix.
-*> On exit, A_onexit*diag(D_onexit) represents the input matrix
-*> post-multiplied by a sequence of Jacobi rotations, where the
-*> rotation threshold and the total number of sweeps are given in
-*> TOL and NSWEEP, respectively.
-*> (See the descriptions of N1, A, TOL and NSWEEP.)
-*> \endverbatim
-*>
-*> \param[in,out] SVA
-*> \verbatim
-*> SVA is REAL array, dimension (N)
-*> On entry, SVA contains the Euclidean norms of the columns of
-*> the matrix A*diag(D).
-*> On exit, SVA contains the Euclidean norms of the columns of
-*> the matrix onexit*diag(D_onexit).
-*> \endverbatim
-*>
-*> \param[in] MV
-*> \verbatim
-*> MV is INTEGER
-*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then MV is not referenced.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,N)
-*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a
-*> sequence of Jacobi rotations.
-*> If JOBV = 'N', then V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V, LDV >= 1.
-*> If JOBV = 'V', LDV .GE. N.
-*> If JOBV = 'A', LDV .GE. MV.
-*> \endverbatim
-*>
-*> \param[in] EPS
-*> \verbatim
-*> EPS is REAL
-*> EPS = SLAMCH('Epsilon')
-*> \endverbatim
-*>
-*> \param[in] SFMIN
-*> \verbatim
-*> SFMIN is REAL
-*> SFMIN = SLAMCH('Safe Minimum')
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is REAL
-*> TOL is the threshold for Jacobi rotations. For a pair
-*> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is
-*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL.
-*> \endverbatim
-*>
-*> \param[in] NSWEEP
-*> \verbatim
-*> NSWEEP is INTEGER
-*> NSWEEP is the number of sweeps of Jacobi rotations to be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> LWORK is the dimension of WORK. LWORK .GE. M.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit.
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)
-*
-* =====================================================================
- SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
- $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL EPS, SFMIN, TOL
- INTEGER INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP
- CHARACTER*1 JOBV
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( N ), SVA( N ), V( LDV, * ),
- $ WORK( LWORK )
-* ..
-*
-* =====================================================================
-*
-* .. Local Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0)
-* ..
-* .. Local Scalars ..
- REAL AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
- $ BIGTHETA, CS, LARGE, MXAAPQ, MXSINJ, ROOTBIG,
- $ ROOTEPS, ROOTSFMIN, ROOTTOL, SMALL, SN, T,
- $ TEMP1, THETA, THSIGN
- INTEGER BLSKIP, EMPTSW, i, ibr, igl, IERR, IJBLSK,
- $ ISWROT, jbc, jgl, KBL, MVL, NOTROT, nblc, nblr,
- $ p, PSKIPPED, q, ROWSKIP, SWBAND
- LOGICAL APPLV, ROTOK, RSVEC
-* ..
-* .. Local Arrays ..
- REAL FASTR( 5 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, AMAX1, FLOAT, MIN0, SIGN, SQRT
-* ..
-* .. External Functions ..
- REAL SDOT, SNRM2
- INTEGER ISAMAX
- LOGICAL LSAME
- EXTERNAL ISAMAX, LSAME, SDOT, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- APPLV = LSAME( JOBV, 'A' )
- RSVEC = LSAME( JOBV, 'V' )
- IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN
- INFO = -3
- ELSE IF( N1.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.M ) THEN
- INFO = -6
- ELSE IF( ( RSVEC.OR.APPLV ) .AND. ( MV.LT.0 ) ) THEN
- INFO = -9
- ELSE IF( ( RSVEC.AND.( LDV.LT.N ) ).OR.
- $ ( APPLV.AND.( LDV.LT.MV ) ) ) THEN
- INFO = -11
- ELSE IF( TOL.LE.EPS ) THEN
- INFO = -14
- ELSE IF( NSWEEP.LT.0 ) THEN
- INFO = -15
- ELSE IF( LWORK.LT.M ) THEN
- INFO = -17
- ELSE
- INFO = 0
- END IF
-*
-* #:(
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGSVJ1', -INFO )
- RETURN
- END IF
-*
- IF( RSVEC ) THEN
- MVL = N
- ELSE IF( APPLV ) THEN
- MVL = MV
- END IF
- RSVEC = RSVEC .OR. APPLV
-
- ROOTEPS = SQRT( EPS )
- ROOTSFMIN = SQRT( SFMIN )
- SMALL = SFMIN / EPS
- BIG = ONE / SFMIN
- ROOTBIG = ONE / ROOTSFMIN
- LARGE = BIG / SQRT( FLOAT( M*N ) )
- BIGTHETA = ONE / ROOTEPS
- ROOTTOL = SQRT( TOL )
-*
-* .. Initialize the right singular vector matrix ..
-*
-* RSVEC = LSAME( JOBV, 'Y' )
-*
- EMPTSW = N1*( N-N1 )
- NOTROT = 0
- FASTR( 1 ) = ZERO
-*
-* .. Row-cyclic pivot strategy with de Rijk's pivoting ..
-*
- KBL = MIN0( 8, N )
- NBLR = N1 / KBL
- IF( ( NBLR*KBL ).NE.N1 )NBLR = NBLR + 1
-
-* .. the tiling is nblr-by-nblc [tiles]
-
- NBLC = ( N-N1 ) / KBL
- IF( ( NBLC*KBL ).NE.( N-N1 ) )NBLC = NBLC + 1
- BLSKIP = ( KBL**2 ) + 1
-*[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
-
- ROWSKIP = MIN0( 5, KBL )
-*[TP] ROWSKIP is a tuning parameter.
- SWBAND = 0
-*[TP] SWBAND is a tuning parameter. It is meaningful and effective
-* if SGESVJ is used as a computational routine in the preconditioned
-* Jacobi SVD algorithm SGESVJ.
-*
-*
-* | * * * [x] [x] [x]|
-* | * * * [x] [x] [x]| Row-cycling in the nblr-by-nblc [x] blocks.
-* | * * * [x] [x] [x]| Row-cyclic pivoting inside each [x] block.
-* |[x] [x] [x] * * * |
-* |[x] [x] [x] * * * |
-* |[x] [x] [x] * * * |
-*
-*
- DO 1993 i = 1, NSWEEP
-* .. go go go ...
-*
- MXAAPQ = ZERO
- MXSINJ = ZERO
- ISWROT = 0
-*
- NOTROT = 0
- PSKIPPED = 0
-*
- DO 2000 ibr = 1, NBLR
-
- igl = ( ibr-1 )*KBL + 1
-*
-*
-*........................................................
-* ... go to the off diagonal blocks
-
- igl = ( ibr-1 )*KBL + 1
-
- DO 2010 jbc = 1, NBLC
-
- jgl = N1 + ( jbc-1 )*KBL + 1
-
-* doing the block at ( ibr, jbc )
-
- IJBLSK = 0
- DO 2100 p = igl, MIN0( igl+KBL-1, N1 )
-
- AAPP = SVA( p )
-
- IF( AAPP.GT.ZERO ) THEN
-
- PSKIPPED = 0
-
- DO 2200 q = jgl, MIN0( jgl+KBL-1, N )
-*
- AAQQ = SVA( q )
-
- IF( AAQQ.GT.ZERO ) THEN
- AAPP0 = AAPP
-*
-* .. M x 2 Jacobi SVD ..
-*
-* .. Safe Gram matrix computation ..
-*
- IF( AAQQ.GE.ONE ) THEN
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = ( SMALL*AAPP ).LE.AAQQ
- ELSE
- ROTOK = ( SMALL*AAQQ ).LE.AAPP
- END IF
- IF( AAPP.LT.( BIG / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL SCOPY( M, A( 1, p ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, D( p ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = SDOT( M, WORK, 1, A( 1, q ),
- $ 1 )*D( q ) / AAQQ
- END IF
- ELSE
- IF( AAPP.GE.AAQQ ) THEN
- ROTOK = AAPP.LE.( AAQQ / SMALL )
- ELSE
- ROTOK = AAQQ.LE.( AAPP / SMALL )
- END IF
- IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
- AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1,
- $ q ), 1 )*D( p )*D( q ) / AAQQ )
- $ / AAPP
- ELSE
- CALL SCOPY( M, A( 1, q ), 1, WORK, 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ, D( q ),
- $ M, 1, WORK, LDA, IERR )
- AAPQ = SDOT( M, WORK, 1, A( 1, p ),
- $ 1 )*D( p ) / AAPP
- END IF
- END IF
-
- MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) )
-
-* TO rotate or NOT to rotate, THAT is the question ...
-*
- IF( ABS( AAPQ ).GT.TOL ) THEN
- NOTROT = 0
-* ROTATED = ROTATED + 1
- PSKIPPED = 0
- ISWROT = ISWROT + 1
-*
- IF( ROTOK ) THEN
-*
- AQOAP = AAQQ / AAPP
- APOAQ = AAPP / AAQQ
- THETA = -HALF*ABS( AQOAP-APOAQ ) / AAPQ
- IF( AAQQ.GT.AAPP0 )THETA = -THETA
-
- IF( ABS( THETA ).GT.BIGTHETA ) THEN
- T = HALF / THETA
- FASTR( 3 ) = T*D( p ) / D( q )
- FASTR( 4 ) = -T*D( q ) / D( p )
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1, FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1,
- $ FASTR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, ABS( T ) )
- ELSE
-*
-* .. choose correct signum for THETA and rotate
-*
- THSIGN = -SIGN( ONE, AAPQ )
- IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
- T = ONE / ( THETA+THSIGN*
- $ SQRT( ONE+THETA*THETA ) )
- CS = SQRT( ONE / ( ONE+T*T ) )
- SN = T*CS
- MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE+T*APOAQ*AAPQ ) )
- AAPP = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-T*AQOAP*AAPQ ) )
-
- APOAQ = D( p ) / D( q )
- AQOAP = D( q ) / D( p )
- IF( D( p ).GE.ONE ) THEN
-*
- IF( D( q ).GE.ONE ) THEN
- FASTR( 3 ) = T*APOAQ
- FASTR( 4 ) = -T*AQOAP
- D( p ) = D( p )*CS
- D( q ) = D( q )*CS
- CALL SROTM( M, A( 1, p ), 1,
- $ A( 1, q ), 1,
- $ FASTR )
- IF( RSVEC )CALL SROTM( MVL,
- $ V( 1, p ), 1, V( 1, q ),
- $ 1, FASTR )
- ELSE
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- END IF
- ELSE
- IF( D( q ).GE.ONE ) THEN
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M, -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- IF( RSVEC ) THEN
- CALL SAXPY( MVL, T*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- ELSE
- IF( D( p ).GE.D( q ) ) THEN
- CALL SAXPY( M, -T*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- CALL SAXPY( M, CS*SN*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- D( p ) = D( p )*CS
- D( q ) = D( q ) / CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ -T*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- CALL SAXPY( MVL,
- $ CS*SN*APOAQ,
- $ V( 1, p ), 1,
- $ V( 1, q ), 1 )
- END IF
- ELSE
- CALL SAXPY( M, T*APOAQ,
- $ A( 1, p ), 1,
- $ A( 1, q ), 1 )
- CALL SAXPY( M,
- $ -CS*SN*AQOAP,
- $ A( 1, q ), 1,
- $ A( 1, p ), 1 )
- D( p ) = D( p ) / CS
- D( q ) = D( q )*CS
- IF( RSVEC ) THEN
- CALL SAXPY( MVL,
- $ T*APOAQ, V( 1, p ),
- $ 1, V( 1, q ), 1 )
- CALL SAXPY( MVL,
- $ -CS*SN*AQOAP,
- $ V( 1, q ), 1,
- $ V( 1, p ), 1 )
- END IF
- END IF
- END IF
- END IF
- END IF
-
- ELSE
- IF( AAPP.GT.AAQQ ) THEN
- CALL SCOPY( M, A( 1, p ), 1, WORK,
- $ 1 )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( p ) / D( q )
- CALL SAXPY( M, TEMP1, WORK, 1,
- $ A( 1, q ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAQQ,
- $ M, 1, A( 1, q ), LDA,
- $ IERR )
- SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- ELSE
- CALL SCOPY( M, A( 1, q ), 1, WORK,
- $ 1 )
- CALL SLASCL( 'G', 0, 0, AAQQ, ONE,
- $ M, 1, WORK, LDA, IERR )
- CALL SLASCL( 'G', 0, 0, AAPP, ONE,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- TEMP1 = -AAPQ*D( q ) / D( p )
- CALL SAXPY( M, TEMP1, WORK, 1,
- $ A( 1, p ), 1 )
- CALL SLASCL( 'G', 0, 0, ONE, AAPP,
- $ M, 1, A( 1, p ), LDA,
- $ IERR )
- SVA( p ) = AAPP*SQRT( AMAX1( ZERO,
- $ ONE-AAPQ*AAPQ ) )
- MXSINJ = AMAX1( MXSINJ, SFMIN )
- END IF
- END IF
-* END IF ROTOK THEN ... ELSE
-*
-* In the case of cancellation in updating SVA(q)
-* .. recompute SVA(q)
- IF( ( SVA( q ) / AAQQ )**2.LE.ROOTEPS )
- $ THEN
- IF( ( AAQQ.LT.ROOTBIG ) .AND.
- $ ( AAQQ.GT.ROOTSFMIN ) ) THEN
- SVA( q ) = SNRM2( M, A( 1, q ), 1 )*
- $ D( q )
- ELSE
- T = ZERO
- AAQQ = ONE
- CALL SLASSQ( M, A( 1, q ), 1, T,
- $ AAQQ )
- SVA( q ) = T*SQRT( AAQQ )*D( q )
- END IF
- END IF
- IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
- IF( ( AAPP.LT.ROOTBIG ) .AND.
- $ ( AAPP.GT.ROOTSFMIN ) ) THEN
- AAPP = SNRM2( M, A( 1, p ), 1 )*
- $ D( p )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, p ), 1, T,
- $ AAPP )
- AAPP = T*SQRT( AAPP )*D( p )
- END IF
- SVA( p ) = AAPP
- END IF
-* end of OK rotation
- ELSE
- NOTROT = NOTROT + 1
-* SKIPPED = SKIPPED + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
- ELSE
- NOTROT = NOTROT + 1
- PSKIPPED = PSKIPPED + 1
- IJBLSK = IJBLSK + 1
- END IF
-
-* IF ( NOTROT .GE. EMPTSW ) GO TO 2011
- IF( ( i.LE.SWBAND ) .AND. ( IJBLSK.GE.BLSKIP ) )
- $ THEN
- SVA( p ) = AAPP
- NOTROT = 0
- GO TO 2011
- END IF
- IF( ( i.LE.SWBAND ) .AND.
- $ ( PSKIPPED.GT.ROWSKIP ) ) THEN
- AAPP = -AAPP
- NOTROT = 0
- GO TO 2203
- END IF
-
-*
- 2200 CONTINUE
-* end of the q-loop
- 2203 CONTINUE
-
- SVA( p ) = AAPP
-*
- ELSE
- IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
- $ MIN0( jgl+KBL-1, N ) - jgl + 1
- IF( AAPP.LT.ZERO )NOTROT = 0
-*** IF ( NOTROT .GE. EMPTSW ) GO TO 2011
- END IF
-
- 2100 CONTINUE
-* end of the p-loop
- 2010 CONTINUE
-* end of the jbc-loop
- 2011 CONTINUE
-*2011 bailed out of the jbc-loop
- DO 2012 p = igl, MIN0( igl+KBL-1, N )
- SVA( p ) = ABS( SVA( p ) )
- 2012 CONTINUE
-*** IF ( NOTROT .GE. EMPTSW ) GO TO 1994
- 2000 CONTINUE
-*2000 :: end of the ibr-loop
-*
-* .. update SVA(N)
- IF( ( SVA( N ).LT.ROOTBIG ) .AND. ( SVA( N ).GT.ROOTSFMIN ) )
- $ THEN
- SVA( N ) = SNRM2( M, A( 1, N ), 1 )*D( N )
- ELSE
- T = ZERO
- AAPP = ONE
- CALL SLASSQ( M, A( 1, N ), 1, T, AAPP )
- SVA( N ) = T*SQRT( AAPP )*D( N )
- END IF
-*
-* Additional steering devices
-*
- IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
- $ ( ISWROT.LE.N ) ) )SWBAND = i
-
- IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.FLOAT( N )*TOL ) .AND.
- $ ( FLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
- GO TO 1994
- END IF
-
-*
- IF( NOTROT.GE.EMPTSW )GO TO 1994
-
- 1993 CONTINUE
-* end i=1:NSWEEP loop
-* #:) Reaching this point means that the procedure has completed the given
-* number of sweeps.
- INFO = NSWEEP - 1
- GO TO 1995
- 1994 CONTINUE
-* #:) Reaching this point means that during the i-th sweep all pivots were
-* below the given threshold, causing early exit.
-
- INFO = 0
-* #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
-*
-* Sort the vector D
-*
- DO 5991 p = 1, N - 1
- q = ISAMAX( N-p+1, SVA( p ), 1 ) + p - 1
- IF( p.NE.q ) THEN
- TEMP1 = SVA( p )
- SVA( p ) = SVA( q )
- SVA( q ) = TEMP1
- TEMP1 = D( p )
- D( p ) = D( q )
- D( q ) = TEMP1
- CALL SSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
- IF( RSVEC )CALL SSWAP( MVL, V( 1, p ), 1, V( 1, q ), 1 )
- END IF
- 5991 CONTINUE
-*
- RETURN
-* ..
-* .. END OF SGSVJ1
-* ..
- END
diff --git a/netlib/LAPACK/sgtcon.f b/netlib/LAPACK/sgtcon.f
deleted file mode 100644
index b6b33b1..0000000
--- a/netlib/LAPACK/sgtcon.f
+++ /dev/null
@@ -1,255 +0,0 @@
-*> \brief \b SGTCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTCON estimates the reciprocal of the condition number of a real
-*> tridiagonal matrix A using the LU factorization as computed by
-*> SGTTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A as computed by SGTTRF.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is REAL array, dimension (N-2)
-*> The (n-2) elements of the second superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTcomputational
-*
-* =====================================================================
- SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ONENRM
- INTEGER I, KASE, KASE1
- REAL AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGTTRS, SLACN2, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGTCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that D(1:N) is non-zero.
-*
- DO 10 I = 1, N
- IF( D( I ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
-*
- AINVNM = ZERO
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 20 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(U)*inv(L).
-*
- CALL SGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
- $ WORK, N, INFO )
- ELSE
-*
-* Multiply by inv(L**T)*inv(U**T).
-*
- CALL SGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK,
- $ N, INFO )
- END IF
- GO TO 20
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of SGTCON
-*
- END
diff --git a/netlib/LAPACK/sgtrfs.f b/netlib/LAPACK/sgtrfs.f
deleted file mode 100644
index 4cc05be..0000000
--- a/netlib/LAPACK/sgtrfs.f
+++ /dev/null
@@ -1,474 +0,0 @@
-*> \brief \b SGTRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
-* IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is tridiagonal, and provides
-*> error bounds and backward error estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) superdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DLF
-*> \verbatim
-*> DLF is REAL array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A as computed by SGTTRF.
-*> \endverbatim
-*>
-*> \param[in] DF
-*> \verbatim
-*> DF is REAL array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DUF
-*> \verbatim
-*> DUF is REAL array, dimension (N-1)
-*> The (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is REAL array, dimension (N-2)
-*> The (n-2) elements of the second superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SGTTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTcomputational
-*
-* =====================================================================
- SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
- $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANSN, TRANST
- INTEGER COUNT, I, J, KASE, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGTTRS, SLACN2, SLAGTM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -15
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGTRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANSN = 'N'
- TRANST = 'T'
- ELSE
- TRANSN = 'T'
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = 4
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 110 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE,
- $ WORK( N+1 ), N )
-*
-* Compute abs(op(A))*abs(x) + abs(b) for use in the backward
-* error bound.
-*
- IF( NOTRAN ) THEN
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) )
- ELSE
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) ) +
- $ ABS( DU( 1 )*X( 2, J ) )
- DO 30 I = 2, N - 1
- WORK( I ) = ABS( B( I, J ) ) +
- $ ABS( DL( I-1 )*X( I-1, J ) ) +
- $ ABS( D( I )*X( I, J ) ) +
- $ ABS( DU( I )*X( I+1, J ) )
- 30 CONTINUE
- WORK( N ) = ABS( B( N, J ) ) +
- $ ABS( DL( N-1 )*X( N-1, J ) ) +
- $ ABS( D( N )*X( N, J ) )
- END IF
- ELSE
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) )
- ELSE
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) ) +
- $ ABS( DL( 1 )*X( 2, J ) )
- DO 40 I = 2, N - 1
- WORK( I ) = ABS( B( I, J ) ) +
- $ ABS( DU( I-1 )*X( I-1, J ) ) +
- $ ABS( D( I )*X( I, J ) ) +
- $ ABS( DL( I )*X( I+1, J ) )
- 40 CONTINUE
- WORK( N ) = ABS( B( N, J ) ) +
- $ ABS( DU( N-1 )*X( N-1, J ) ) +
- $ ABS( D( N )*X( N, J ) )
- END IF
- END IF
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- S = ZERO
- DO 50 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 50 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 60 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 60 CONTINUE
-*
- KASE = 0
- 70 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL SGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- DO 80 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 80 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 90 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 90 CONTINUE
- CALL SGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- END IF
- GO TO 70
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 100 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 100 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 110 CONTINUE
-*
- RETURN
-*
-* End of SGTRFS
-*
- END
diff --git a/netlib/LAPACK/sgtsv.f b/netlib/LAPACK/sgtsv.f
deleted file mode 100644
index 3cd6c9b..0000000
--- a/netlib/LAPACK/sgtsv.f
+++ /dev/null
@@ -1,333 +0,0 @@
-*> \brief <b> SGTSV computes the solution to system of linear equations A * X = B for GT matrices <b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), D( * ), DL( * ), DU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTSV solves the equation
-*>
-*> A*X = B,
-*>
-*> where A is an n by n tridiagonal matrix, by Gaussian elimination with
-*> partial pivoting.
-*>
-*> Note that the equation A**T*X = B may be solved by interchanging the
-*> order of the arguments DU and DL.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-2) elements of the
-*> second super-diagonal of the upper triangular matrix U from
-*> the LU factorization of A, in DL(1), ..., DL(n-2).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of U.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N by NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N by NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero, and the solution
-*> has not been computed. The factorization has not been
-*> completed unless i = N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTsolve
-*
-* =====================================================================
- SUBROUTINE SGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), D( * ), DL( * ), DU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL FACT, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGTSV ', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( NRHS.EQ.1 ) THEN
- DO 10 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
- ELSE
- INFO = I
- RETURN
- END IF
- DL( I ) = ZERO
- ELSE
-*
-* Interchange rows I and I+1
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DL( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DL( I )
- DU( I ) = TEMP
- TEMP = B( I, 1 )
- B( I, 1 ) = B( I+1, 1 )
- B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
- END IF
- 10 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
- ELSE
- INFO = I
- RETURN
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DU( I ) = TEMP
- TEMP = B( I, 1 )
- B( I, 1 ) = B( I+1, 1 )
- B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
- END IF
- END IF
- IF( D( N ).EQ.ZERO ) THEN
- INFO = N
- RETURN
- END IF
- ELSE
- DO 40 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- DO 20 J = 1, NRHS
- B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
- 20 CONTINUE
- ELSE
- INFO = I
- RETURN
- END IF
- DL( I ) = ZERO
- ELSE
-*
-* Interchange rows I and I+1
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DL( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DL( I )
- DU( I ) = TEMP
- DO 30 J = 1, NRHS
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - FACT*B( I+1, J )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- DO 50 J = 1, NRHS
- B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
- 50 CONTINUE
- ELSE
- INFO = I
- RETURN
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DU( I ) = TEMP
- DO 60 J = 1, NRHS
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - FACT*B( I+1, J )
- 60 CONTINUE
- END IF
- END IF
- IF( D( N ).EQ.ZERO ) THEN
- INFO = N
- RETURN
- END IF
- END IF
-*
-* Back solve with the matrix U from the factorization.
-*
- IF( NRHS.LE.2 ) THEN
- J = 1
- 70 CONTINUE
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
- DO 80 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
- $ B( I+2, J ) ) / D( I )
- 80 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
- ELSE
- DO 100 J = 1, NRHS
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 90 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
- $ B( I+2, J ) ) / D( I )
- 90 CONTINUE
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SGTSV
-*
- END
diff --git a/netlib/LAPACK/sgtsvx.f b/netlib/LAPACK/sgtsvx.f
deleted file mode 100644
index 64d5459..0000000
--- a/netlib/LAPACK/sgtsvx.f
+++ /dev/null
@@ -1,414 +0,0 @@
-*> \brief <b> SGTSVX computes the solution to system of linear equations A * X = B for GT matrices <b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
-* DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, TRANS
-* INTEGER INFO, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTSVX uses the LU factorization to compute the solution to a real
-*> system of linear equations A * X = B or A**T * X = B,
-*> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
-*> matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
-*> as A = L * U, where L is a product of permutation and unit lower
-*> bidiagonal matrices and U is upper triangular with nonzeros in
-*> only the main diagonal and first two superdiagonals.
-*>
-*> 2. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
-*> form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
-*> will not be modified.
-*> = 'N': The matrix will be copied to DLF, DF, and DUF
-*> and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) superdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in,out] DLF
-*> \verbatim
-*> DLF is REAL array, dimension (N-1)
-*> If FACT = 'F', then DLF is an input argument and on entry
-*> contains the (n-1) multipliers that define the matrix L from
-*> the LU factorization of A as computed by SGTTRF.
-*>
-*> If FACT = 'N', then DLF is an output argument and on exit
-*> contains the (n-1) multipliers that define the matrix L from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DF
-*> \verbatim
-*> DF is REAL array, dimension (N)
-*> If FACT = 'F', then DF is an input argument and on entry
-*> contains the n diagonal elements of the upper triangular
-*> matrix U from the LU factorization of A.
-*>
-*> If FACT = 'N', then DF is an output argument and on exit
-*> contains the n diagonal elements of the upper triangular
-*> matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DUF
-*> \verbatim
-*> DUF is REAL array, dimension (N-1)
-*> If FACT = 'F', then DUF is an input argument and on entry
-*> contains the (n-1) elements of the first superdiagonal of U.
-*>
-*> If FACT = 'N', then DUF is an output argument and on exit
-*> contains the (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in,out] DU2
-*> \verbatim
-*> DU2 is REAL array, dimension (N-2)
-*> If FACT = 'F', then DU2 is an input argument and on entry
-*> contains the (n-2) elements of the second superdiagonal of
-*> U.
-*>
-*> If FACT = 'N', then DU2 is an output argument and on exit
-*> contains the (n-2) elements of the second superdiagonal of
-*> U.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the LU factorization of A as
-*> computed by SGTTRF.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the LU factorization of A;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
-*> a row interchange was not required.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization
-*> has not been completed unless i = N, but the
-*> factor U is exactly singular, so the solution
-*> and error bounds could not be computed.
-*> RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTsolve
-*
-* =====================================================================
- SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
- $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, TRANS
- INTEGER INFO, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT, NOTRAN
- CHARACTER NORM
- REAL ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANGT
- EXTERNAL LSAME, SLAMCH, SLANGT
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGTCON, SGTRFS, SGTTRF, SGTTRS, SLACPY,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGTSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the LU factorization of A.
-*
- CALL SCOPY( N, D, 1, DF, 1 )
- IF( N.GT.1 ) THEN
- CALL SCOPY( N-1, DL, 1, DLF, 1 )
- CALL SCOPY( N-1, DU, 1, DUF, 1 )
- END IF
- CALL SGTTRF( N, DLF, DF, DUF, DU2, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = SLANGT( NORM, N, DL, D, DU )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SGTTRS( TRANS, N, NRHS, DLF, DF, DUF, DU2, IPIV, X, LDX,
- $ INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV,
- $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of SGTSVX
-*
- END
diff --git a/netlib/LAPACK/sgttrf.f b/netlib/LAPACK/sgttrf.f
deleted file mode 100644
index 19bc9b2..0000000
--- a/netlib/LAPACK/sgttrf.f
+++ /dev/null
@@ -1,237 +0,0 @@
-*> \brief \b SGTTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgttrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgttrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgttrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTTRF computes an LU factorization of a real tridiagonal matrix A
-*> using elimination with partial pivoting and row interchanges.
-*>
-*> The factorization has the form
-*> A = L * U
-*> where L is a product of permutation and unit lower bidiagonal
-*> matrices and U is upper triangular with nonzeros in only the main
-*> diagonal and first two superdiagonals.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-1) multipliers that
-*> define the matrix L from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of the
-*> upper triangular matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] DU2
-*> \verbatim
-*> DU2 is REAL array, dimension (N-2)
-*> On exit, DU2 is overwritten by the (n-2) elements of the
-*> second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTcomputational
-*
-* =====================================================================
- SUBROUTINE SGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL FACT, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'SGTTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize IPIV(i) = i and DU2(I) = 0
-*
- DO 10 I = 1, N
- IPIV( I ) = I
- 10 CONTINUE
- DO 20 I = 1, N - 2
- DU2( I ) = ZERO
- 20 CONTINUE
-*
- DO 30 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required, eliminate DL(I)
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
-*
-* Interchange rows I and I+1, eliminate DL(I)
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- DU2( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DU( I+1 )
- IPIV( I ) = I + 1
- END IF
- 30 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- IPIV( I ) = I + 1
- END IF
- END IF
-*
-* Check for a zero on the diagonal of U.
-*
- DO 40 I = 1, N
- IF( D( I ).EQ.ZERO ) THEN
- INFO = I
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of SGTTRF
-*
- END
diff --git a/netlib/LAPACK/sgttrs.f b/netlib/LAPACK/sgttrs.f
deleted file mode 100644
index 117839b..0000000
--- a/netlib/LAPACK/sgttrs.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief \b SGTTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgttrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgttrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgttrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTTRS solves one of the systems of equations
-*> A*X = B or A**T*X = B,
-*> with a tridiagonal matrix A using the LU factorization computed
-*> by SGTTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is REAL array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTcomputational
-*
-* =====================================================================
- SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER ITRANS, J, JB, NB
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGTTS2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
- IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
- $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGTTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Decode TRANS
-*
- IF( NOTRAN ) THEN
- ITRANS = 0
- ELSE
- ITRANS = 1
- END IF
-*
-* Determine the number of right-hand sides to solve at a time.
-*
- IF( NRHS.EQ.1 ) THEN
- NB = 1
- ELSE
- NB = MAX( 1, ILAENV( 1, 'SGTTRS', TRANS, N, NRHS, -1, -1 ) )
- END IF
-*
- IF( NB.GE.NRHS ) THEN
- CALL SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
- ELSE
- DO 10 J = 1, NRHS, NB
- JB = MIN( NRHS-J+1, NB )
- CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
- $ LDB )
- 10 CONTINUE
- END IF
-*
-* End of SGTTRS
-*
- END
diff --git a/netlib/LAPACK/sgtts2.f b/netlib/LAPACK/sgtts2.f
deleted file mode 100644
index 31f12f9..0000000
--- a/netlib/LAPACK/sgtts2.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b SGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGTTS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtts2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtts2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtts2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* .. Scalar Arguments ..
-* INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SGTTS2 solves one of the systems of equations
-*> A*X = B or A**T*X = B,
-*> with a tridiagonal matrix A using the LU factorization computed
-*> by SGTTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITRANS
-*> \verbatim
-*> ITRANS is INTEGER
-*> Specifies the form of the system of equations.
-*> = 0: A * X = B (No transpose)
-*> = 1: A**T* X = B (Transpose)
-*> = 2: A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is REAL array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGTcomputational
-*
-* =====================================================================
- SUBROUTINE SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IP, J
- REAL TEMP
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( ITRANS.EQ.0 ) THEN
-*
-* Solve A*X = B using the LU factorization of A,
-* overwriting each right hand side vector with its solution.
-*
- IF( NRHS.LE.1 ) THEN
- J = 1
- 10 CONTINUE
-*
-* Solve L*x = b.
-*
- DO 20 I = 1, N - 1
- IP = IPIV( I )
- TEMP = B( I+1-IP+I, J ) - DL( I )*B( IP, J )
- B( I, J ) = B( IP, J )
- B( I+1, J ) = TEMP
- 20 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 30 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 30 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 10
- END IF
- ELSE
- DO 60 J = 1, NRHS
-*
-* Solve L*x = b.
-*
- DO 40 I = 1, N - 1
- IF( IPIV( I ).EQ.I ) THEN
- B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
- ELSE
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - DL( I )*B( I, J )
- END IF
- 40 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 50 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- ELSE
-*
-* Solve A**T * X = B.
-*
- IF( NRHS.LE.1 ) THEN
-*
-* Solve U**T*x = b.
-*
- J = 1
- 70 CONTINUE
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 80 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
- $ B( I-2, J ) ) / D( I )
- 80 CONTINUE
-*
-* Solve L**T*x = b.
-*
- DO 90 I = N - 1, 1, -1
- IP = IPIV( I )
- TEMP = B( I, J ) - DL( I )*B( I+1, J )
- B( I, J ) = B( IP, J )
- B( IP, J ) = TEMP
- 90 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
-*
- ELSE
- DO 120 J = 1, NRHS
-*
-* Solve U**T*x = b.
-*
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 100 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
- $ DU2( I-2 )*B( I-2, J ) ) / D( I )
- 100 CONTINUE
- DO 110 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DL( I )*TEMP
- B( I, J ) = TEMP
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- END IF
-*
-* End of SGTTS2
-*
- END
diff --git a/netlib/LAPACK/shgeqz.f b/netlib/LAPACK/shgeqz.f
deleted file mode 100644
index 4bd1a1d..0000000
--- a/netlib/LAPACK/shgeqz.f
+++ /dev/null
@@ -1,1357 +0,0 @@
-*> \brief \b SHGEQZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SHGEQZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/shgeqz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/shgeqz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/shgeqz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
-* ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, COMPZ, JOB
-* INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL ALPHAI( * ), ALPHAR( * ), BETA( * ),
-* $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SHGEQZ computes the eigenvalues of a real matrix pair (H,T),
-*> where H is an upper Hessenberg matrix and T is upper triangular,
-*> using the double-shift QZ method.
-*> Matrix pairs of this type are produced by the reduction to
-*> generalized upper Hessenberg form of a real matrix pair (A,B):
-*>
-*> A = Q1*H*Z1**T, B = Q1*T*Z1**T,
-*>
-*> as computed by SGGHRD.
-*>
-*> If JOB='S', then the Hessenberg-triangular pair (H,T) is
-*> also reduced to generalized Schur form,
-*>
-*> H = Q*S*Z**T, T = Q*P*Z**T,
-*>
-*> where Q and Z are orthogonal matrices, P is an upper triangular
-*> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
-*> diagonal blocks.
-*>
-*> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
-*> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
-*> eigenvalues.
-*>
-*> Additionally, the 2-by-2 upper triangular diagonal blocks of P
-*> corresponding to 2-by-2 blocks of S are reduced to positive diagonal
-*> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
-*> P(j,j) > 0, and P(j+1,j+1) > 0.
-*>
-*> Optionally, the orthogonal matrix Q from the generalized Schur
-*> factorization may be postmultiplied into an input matrix Q1, and the
-*> orthogonal matrix Z may be postmultiplied into an input matrix Z1.
-*> If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced
-*> the matrix pair (A,B) to generalized upper Hessenberg form, then the
-*> output matrices Q1*Q and Z1*Z are the orthogonal factors from the
-*> generalized Schur factorization of (A,B):
-*>
-*> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
-*>
-*> To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
-*> of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
-*> complex and beta real.
-*> If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
-*> generalized nonsymmetric eigenvalue problem (GNEP)
-*> A*x = lambda*B*x
-*> and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
-*> alternate form of the GNEP
-*> mu*A*y = B*y.
-*> Real eigenvalues can be read directly from the generalized Schur
-*> form:
-*> alpha = S(i,i), beta = P(i,i).
-*>
-*> Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
-*> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
-*> pp. 241--256.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> = 'E': Compute eigenvalues only;
-*> = 'S': Compute eigenvalues and the Schur form.
-*> \endverbatim
-*>
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'N': Left Schur vectors (Q) are not computed;
-*> = 'I': Q is initialized to the unit matrix and the matrix Q
-*> of left Schur vectors of (H,T) is returned;
-*> = 'V': Q must contain an orthogonal matrix Q1 on entry and
-*> the product Q1*Q is returned.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Right Schur vectors (Z) are not computed;
-*> = 'I': Z is initialized to the unit matrix and the matrix Z
-*> of right Schur vectors of (H,T) is returned;
-*> = 'V': Z must contain an orthogonal matrix Z1 on entry and
-*> the product Z1*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices H, T, Q, and Z. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI mark the rows and columns of H which are in
-*> Hessenberg form. It is assumed that A is already upper
-*> triangular in rows and columns 1:ILO-1 and IHI+1:N.
-*> If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH, N)
-*> On entry, the N-by-N upper Hessenberg matrix H.
-*> On exit, if JOB = 'S', H contains the upper quasi-triangular
-*> matrix S from the generalized Schur factorization.
-*> If JOB = 'E', the diagonal blocks of H match those of S, but
-*> the rest of H is unspecified.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT, N)
-*> On entry, the N-by-N upper triangular matrix T.
-*> On exit, if JOB = 'S', T contains the upper triangular
-*> matrix P from the generalized Schur factorization;
-*> 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
-*> are reduced to positive diagonal form, i.e., if H(j+1,j) is
-*> non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
-*> T(j+1,j+1) > 0.
-*> If JOB = 'E', the diagonal blocks of T match those of P, but
-*> the rest of T is unspecified.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> The real parts of each scalar alpha defining an eigenvalue
-*> of GNEP.
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> The imaginary parts of each scalar alpha defining an
-*> eigenvalue of GNEP.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*> The scalars beta that define the eigenvalues of GNEP.
-*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*> beta = BETA(j) represent the j-th eigenvalue of the matrix
-*> pair (A,B), in one of the forms lambda = alpha/beta or
-*> mu = beta/alpha. Since either lambda or mu may overflow,
-*> they should not, in general, be computed.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
-*> the reduction of (A,B) to generalized Hessenberg form.
-*> On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
-*> vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
-*> of left Schur vectors of (A,B).
-*> Not referenced if COMPZ = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1.
-*> If COMPQ='V' or 'I', then LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
-*> the reduction of (A,B) to generalized Hessenberg form.
-*> On exit, if COMPZ = 'I', the orthogonal matrix of
-*> right Schur vectors of (H,T), and if COMPZ = 'V', the
-*> orthogonal matrix of right Schur vectors of (A,B).
-*> Not referenced if COMPZ = 'N'.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If COMPZ='V' or 'I', then LDZ >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1,...,N: the QZ iteration did not converge. (H,T) is not
-*> in Schur form, but ALPHAR(i), ALPHAI(i), and
-*> BETA(i), i=INFO+1,...,N should be correct.
-*> = N+1,...,2*N: the shift calculation failed. (H,T) is not
-*> in Schur form, but ALPHAR(i), ALPHAI(i), and
-*> BETA(i), i=INFO-N+1,...,N should be correct.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Iteration counters:
-*>
-*> JITER -- counts iterations.
-*> IITER -- counts iterations run since ILAST was last
-*> changed. This is therefore reset only when a 1-by-1 or
-*> 2-by-2 block deflates off the bottom.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
- $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL ALPHAI( * ), ALPHAR( * ), BETA( * ),
- $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* $ SAFETY = 1.0E+0 )
- REAL HALF, ZERO, ONE, SAFETY
- PARAMETER ( HALF = 0.5E+0, ZERO = 0.0E+0, ONE = 1.0E+0,
- $ SAFETY = 1.0E+2 )
-* ..
-* .. Local Scalars ..
- LOGICAL ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ,
- $ LQUERY
- INTEGER ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
- $ ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
- $ JR, MAXIT
- REAL A11, A12, A1I, A1R, A21, A22, A2I, A2R, AD11,
- $ AD11L, AD12, AD12L, AD21, AD21L, AD22, AD22L,
- $ AD32L, AN, ANORM, ASCALE, ATOL, B11, B1A, B1I,
- $ B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
- $ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
- $ CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
- $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T1,
- $ TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
- $ U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
- $ WR2
-* ..
-* .. Local Arrays ..
- REAL V( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANHS, SLAPY2, SLAPY3
- EXTERNAL LSAME, SLAMCH, SLANHS, SLAPY2, SLAPY3
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAG2, SLARFG, SLARTG, SLASET, SLASV2, SROT,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode JOB, COMPQ, COMPZ
-*
- IF( LSAME( JOB, 'E' ) ) THEN
- ILSCHR = .FALSE.
- ISCHUR = 1
- ELSE IF( LSAME( JOB, 'S' ) ) THEN
- ILSCHR = .TRUE.
- ISCHUR = 2
- ELSE
- ISCHUR = 0
- END IF
-*
- IF( LSAME( COMPQ, 'N' ) ) THEN
- ILQ = .FALSE.
- ICOMPQ = 1
- ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 2
- ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
- ILQ = .TRUE.
- ICOMPQ = 3
- ELSE
- ICOMPQ = 0
- END IF
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ILZ = .FALSE.
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 2
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ILZ = .TRUE.
- ICOMPZ = 3
- ELSE
- ICOMPZ = 0
- END IF
-*
-* Check Argument Values
-*
- INFO = 0
- WORK( 1 ) = MAX( 1, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( ISCHUR.EQ.0 ) THEN
- INFO = -1
- ELSE IF( ICOMPQ.EQ.0 ) THEN
- INFO = -2
- ELSE IF( ICOMPZ.EQ.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( ILO.LT.1 ) THEN
- INFO = -5
- ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
- INFO = -6
- ELSE IF( LDH.LT.N ) THEN
- INFO = -8
- ELSE IF( LDT.LT.N ) THEN
- INFO = -10
- ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
- INFO = -15
- ELSE IF( LDZ.LT.1 .OR. ( ILZ .AND. LDZ.LT.N ) ) THEN
- INFO = -17
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -19
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SHGEQZ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- WORK( 1 ) = REAL( 1 )
- RETURN
- END IF
-*
-* Initialize Q and Z
-*
- IF( ICOMPQ.EQ.3 )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
- IF( ICOMPZ.EQ.3 )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-* Machine Constants
-*
- IN = IHI + 1 - ILO
- SAFMIN = SLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- ULP = SLAMCH( 'E' )*SLAMCH( 'B' )
- ANORM = SLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
- BNORM = SLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
- ATOL = MAX( SAFMIN, ULP*ANORM )
- BTOL = MAX( SAFMIN, ULP*BNORM )
- ASCALE = ONE / MAX( SAFMIN, ANORM )
- BSCALE = ONE / MAX( SAFMIN, BNORM )
-*
-* Set Eigenvalues IHI+1:N
-*
- DO 30 J = IHI + 1, N
- IF( T( J, J ).LT.ZERO ) THEN
- IF( ILSCHR ) THEN
- DO 10 JR = 1, J
- H( JR, J ) = -H( JR, J )
- T( JR, J ) = -T( JR, J )
- 10 CONTINUE
- ELSE
- H( J, J ) = -H( J, J )
- T( J, J ) = -T( J, J )
- END IF
- IF( ILZ ) THEN
- DO 20 JR = 1, N
- Z( JR, J ) = -Z( JR, J )
- 20 CONTINUE
- END IF
- END IF
- ALPHAR( J ) = H( J, J )
- ALPHAI( J ) = ZERO
- BETA( J ) = T( J, J )
- 30 CONTINUE
-*
-* If IHI < ILO, skip QZ steps
-*
- IF( IHI.LT.ILO )
- $ GO TO 380
-*
-* MAIN QZ ITERATION LOOP
-*
-* Initialize dynamic indices
-*
-* Eigenvalues ILAST+1:N have been found.
-* Column operations modify rows IFRSTM:whatever.
-* Row operations modify columns whatever:ILASTM.
-*
-* If only eigenvalues are being computed, then
-* IFRSTM is the row of the last splitting row above row ILAST;
-* this is always at least ILO.
-* IITER counts iterations since the last eigenvalue was found,
-* to tell when to use an extraordinary shift.
-* MAXIT is the maximum number of QZ sweeps allowed.
-*
- ILAST = IHI
- IF( ILSCHR ) THEN
- IFRSTM = 1
- ILASTM = N
- ELSE
- IFRSTM = ILO
- ILASTM = IHI
- END IF
- IITER = 0
- ESHIFT = ZERO
- MAXIT = 30*( IHI-ILO+1 )
-*
- DO 360 JITER = 1, MAXIT
-*
-* Split the matrix if possible.
-*
-* Two tests:
-* 1: H(j,j-1)=0 or j=ILO
-* 2: T(j,j)=0
-*
- IF( ILAST.EQ.ILO ) THEN
-*
-* Special case: j=ILAST
-*
- GO TO 80
- ELSE
- IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- H( ILAST, ILAST-1 ) = ZERO
- GO TO 80
- END IF
- END IF
-*
- IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
- T( ILAST, ILAST ) = ZERO
- GO TO 70
- END IF
-*
-* General case: j<ILAST
-*
- DO 60 J = ILAST - 1, ILO, -1
-*
-* Test 1: for H(j,j-1)=0 or j=ILO
-*
- IF( J.EQ.ILO ) THEN
- ILAZRO = .TRUE.
- ELSE
- IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
- H( J, J-1 ) = ZERO
- ILAZRO = .TRUE.
- ELSE
- ILAZRO = .FALSE.
- END IF
- END IF
-*
-* Test 2: for T(j,j)=0
-*
- IF( ABS( T( J, J ) ).LT.BTOL ) THEN
- T( J, J ) = ZERO
-*
-* Test 1a: Check for 2 consecutive small subdiagonals in A
-*
- ILAZR2 = .FALSE.
- IF( .NOT.ILAZRO ) THEN
- TEMP = ABS( H( J, J-1 ) )
- TEMP2 = ABS( H( J, J ) )
- TEMPR = MAX( TEMP, TEMP2 )
- IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
- TEMP = TEMP / TEMPR
- TEMP2 = TEMP2 / TEMPR
- END IF
- IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
- $ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
- END IF
-*
-* If both tests pass (1 & 2), i.e., the leading diagonal
-* element of B in the block is zero, split a 1x1 block off
-* at the top. (I.e., at the J-th row/column) The leading
-* diagonal element of the remainder can also be zero, so
-* this may have to be done repeatedly.
-*
- IF( ILAZRO .OR. ILAZR2 ) THEN
- DO 40 JCH = J, ILAST - 1
- TEMP = H( JCH, JCH )
- CALL SLARTG( TEMP, H( JCH+1, JCH ), C, S,
- $ H( JCH, JCH ) )
- H( JCH+1, JCH ) = ZERO
- CALL SROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
- $ H( JCH+1, JCH+1 ), LDH, C, S )
- CALL SROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
- $ T( JCH+1, JCH+1 ), LDT, C, S )
- IF( ILQ )
- $ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
- $ C, S )
- IF( ILAZR2 )
- $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
- ILAZR2 = .FALSE.
- IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
- IF( JCH+1.GE.ILAST ) THEN
- GO TO 80
- ELSE
- IFIRST = JCH + 1
- GO TO 110
- END IF
- END IF
- T( JCH+1, JCH+1 ) = ZERO
- 40 CONTINUE
- GO TO 70
- ELSE
-*
-* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
-* Then process as in the case T(ILAST,ILAST)=0
-*
- DO 50 JCH = J, ILAST - 1
- TEMP = T( JCH, JCH+1 )
- CALL SLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
- $ T( JCH, JCH+1 ) )
- T( JCH+1, JCH+1 ) = ZERO
- IF( JCH.LT.ILASTM-1 )
- $ CALL SROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
- $ T( JCH+1, JCH+2 ), LDT, C, S )
- CALL SROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
- $ H( JCH+1, JCH-1 ), LDH, C, S )
- IF( ILQ )
- $ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
- $ C, S )
- TEMP = H( JCH+1, JCH )
- CALL SLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
- $ H( JCH+1, JCH ) )
- H( JCH+1, JCH-1 ) = ZERO
- CALL SROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
- $ H( IFRSTM, JCH-1 ), 1, C, S )
- CALL SROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
- $ T( IFRSTM, JCH-1 ), 1, C, S )
- IF( ILZ )
- $ CALL SROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
- $ C, S )
- 50 CONTINUE
- GO TO 70
- END IF
- ELSE IF( ILAZRO ) THEN
-*
-* Only test 1 passed -- work on J:ILAST
-*
- IFIRST = J
- GO TO 110
- END IF
-*
-* Neither test passed -- try next J
-*
- 60 CONTINUE
-*
-* (Drop-through is "impossible")
-*
- INFO = N + 1
- GO TO 420
-*
-* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
-* 1x1 block.
-*
- 70 CONTINUE
- TEMP = H( ILAST, ILAST )
- CALL SLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
- $ H( ILAST, ILAST ) )
- H( ILAST, ILAST-1 ) = ZERO
- CALL SROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
- $ H( IFRSTM, ILAST-1 ), 1, C, S )
- CALL SROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
- $ T( IFRSTM, ILAST-1 ), 1, C, S )
- IF( ILZ )
- $ CALL SROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
-*
-* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
-* and BETA
-*
- 80 CONTINUE
- IF( T( ILAST, ILAST ).LT.ZERO ) THEN
- IF( ILSCHR ) THEN
- DO 90 J = IFRSTM, ILAST
- H( J, ILAST ) = -H( J, ILAST )
- T( J, ILAST ) = -T( J, ILAST )
- 90 CONTINUE
- ELSE
- H( ILAST, ILAST ) = -H( ILAST, ILAST )
- T( ILAST, ILAST ) = -T( ILAST, ILAST )
- END IF
- IF( ILZ ) THEN
- DO 100 J = 1, N
- Z( J, ILAST ) = -Z( J, ILAST )
- 100 CONTINUE
- END IF
- END IF
- ALPHAR( ILAST ) = H( ILAST, ILAST )
- ALPHAI( ILAST ) = ZERO
- BETA( ILAST ) = T( ILAST, ILAST )
-*
-* Go to next block -- exit if finished.
-*
- ILAST = ILAST - 1
- IF( ILAST.LT.ILO )
- $ GO TO 380
-*
-* Reset counters
-*
- IITER = 0
- ESHIFT = ZERO
- IF( .NOT.ILSCHR ) THEN
- ILASTM = ILAST
- IF( IFRSTM.GT.ILAST )
- $ IFRSTM = ILO
- END IF
- GO TO 350
-*
-* QZ step
-*
-* This iteration only involves rows/columns IFIRST:ILAST. We
-* assume IFIRST < ILAST, and that the diagonal of B is non-zero.
-*
- 110 CONTINUE
- IITER = IITER + 1
- IF( .NOT.ILSCHR ) THEN
- IFRSTM = IFIRST
- END IF
-*
-* Compute single shifts.
-*
-* At this point, IFIRST < ILAST, and the diagonal elements of
-* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
-* magnitude)
-*
- IF( ( IITER / 10 )*10.EQ.IITER ) THEN
-*
-* Exceptional shift. Chosen for no particularly good reason.
-* (Single shift only.)
-*
- IF( ( REAL( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
- $ ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
- ESHIFT = ESHIFT + H( ILAST, ILAST-1 ) /
- $ T( ILAST-1, ILAST-1 )
- ELSE
- ESHIFT = ESHIFT + ONE / ( SAFMIN*REAL( MAXIT ) )
- END IF
- S1 = ONE
- WR = ESHIFT
-*
- ELSE
-*
-* Shifts based on the generalized eigenvalues of the
-* bottom-right 2x2 block of A and B. The first eigenvalue
-* returned by SLAG2 is the Wilkinson shift (AEP p.512),
-*
- CALL SLAG2( H( ILAST-1, ILAST-1 ), LDH,
- $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
- $ S2, WR, WR2, WI )
-*
- TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
- IF( WI.NE.ZERO )
- $ GO TO 200
- END IF
-*
-* Fiddle with shift to avoid overflow
-*
- TEMP = MIN( ASCALE, ONE )*( HALF*SAFMAX )
- IF( S1.GT.TEMP ) THEN
- SCALE = TEMP / S1
- ELSE
- SCALE = ONE
- END IF
-*
- TEMP = MIN( BSCALE, ONE )*( HALF*SAFMAX )
- IF( ABS( WR ).GT.TEMP )
- $ SCALE = MIN( SCALE, TEMP / ABS( WR ) )
- S1 = SCALE*S1
- WR = SCALE*WR
-*
-* Now check for two consecutive small subdiagonals.
-*
- DO 120 J = ILAST - 1, IFIRST + 1, -1
- ISTART = J
- TEMP = ABS( S1*H( J, J-1 ) )
- TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
- TEMPR = MAX( TEMP, TEMP2 )
- IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
- TEMP = TEMP / TEMPR
- TEMP2 = TEMP2 / TEMPR
- END IF
- IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
- $ TEMP2 )GO TO 130
- 120 CONTINUE
-*
- ISTART = IFIRST
- 130 CONTINUE
-*
-* Do an implicit single-shift QZ sweep.
-*
-* Initial Q
-*
- TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
- TEMP2 = S1*H( ISTART+1, ISTART )
- CALL SLARTG( TEMP, TEMP2, C, S, TEMPR )
-*
-* Sweep
-*
- DO 190 J = ISTART, ILAST - 1
- IF( J.GT.ISTART ) THEN
- TEMP = H( J, J-1 )
- CALL SLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
- H( J+1, J-1 ) = ZERO
- END IF
-*
- DO 140 JC = J, ILASTM
- TEMP = C*H( J, JC ) + S*H( J+1, JC )
- H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
- H( J, JC ) = TEMP
- TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
- T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
- T( J, JC ) = TEMP2
- 140 CONTINUE
- IF( ILQ ) THEN
- DO 150 JR = 1, N
- TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
- Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
- Q( JR, J ) = TEMP
- 150 CONTINUE
- END IF
-*
- TEMP = T( J+1, J+1 )
- CALL SLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
- T( J+1, J ) = ZERO
-*
- DO 160 JR = IFRSTM, MIN( J+2, ILAST )
- TEMP = C*H( JR, J+1 ) + S*H( JR, J )
- H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
- H( JR, J+1 ) = TEMP
- 160 CONTINUE
- DO 170 JR = IFRSTM, J
- TEMP = C*T( JR, J+1 ) + S*T( JR, J )
- T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
- T( JR, J+1 ) = TEMP
- 170 CONTINUE
- IF( ILZ ) THEN
- DO 180 JR = 1, N
- TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
- Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
- Z( JR, J+1 ) = TEMP
- 180 CONTINUE
- END IF
- 190 CONTINUE
-*
- GO TO 350
-*
-* Use Francis double-shift
-*
-* Note: the Francis double-shift should work with real shifts,
-* but only if the block is at least 3x3.
-* This code may break if this point is reached with
-* a 2x2 block with real eigenvalues.
-*
- 200 CONTINUE
- IF( IFIRST+1.EQ.ILAST ) THEN
-*
-* Special case -- 2x2 block with complex eigenvectors
-*
-* Step 1: Standardize, that is, rotate so that
-*
-* ( B11 0 )
-* B = ( ) with B11 non-negative.
-* ( 0 B22 )
-*
- CALL SLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
- $ T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
-*
- IF( B11.LT.ZERO ) THEN
- CR = -CR
- SR = -SR
- B11 = -B11
- B22 = -B22
- END IF
-*
- CALL SROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
- $ H( ILAST, ILAST-1 ), LDH, CL, SL )
- CALL SROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
- $ H( IFRSTM, ILAST ), 1, CR, SR )
-*
- IF( ILAST.LT.ILASTM )
- $ CALL SROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
- $ T( ILAST, ILAST+1 ), LDT, CL, SL )
- IF( IFRSTM.LT.ILAST-1 )
- $ CALL SROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
- $ T( IFRSTM, ILAST ), 1, CR, SR )
-*
- IF( ILQ )
- $ CALL SROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
- $ SL )
- IF( ILZ )
- $ CALL SROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
- $ SR )
-*
- T( ILAST-1, ILAST-1 ) = B11
- T( ILAST-1, ILAST ) = ZERO
- T( ILAST, ILAST-1 ) = ZERO
- T( ILAST, ILAST ) = B22
-*
-* If B22 is negative, negate column ILAST
-*
- IF( B22.LT.ZERO ) THEN
- DO 210 J = IFRSTM, ILAST
- H( J, ILAST ) = -H( J, ILAST )
- T( J, ILAST ) = -T( J, ILAST )
- 210 CONTINUE
-*
- IF( ILZ ) THEN
- DO 220 J = 1, N
- Z( J, ILAST ) = -Z( J, ILAST )
- 220 CONTINUE
- END IF
- B22 = -B22
- END IF
-*
-* Step 2: Compute ALPHAR, ALPHAI, and BETA (see refs.)
-*
-* Recompute shift
-*
- CALL SLAG2( H( ILAST-1, ILAST-1 ), LDH,
- $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
- $ TEMP, WR, TEMP2, WI )
-*
-* If standardization has perturbed the shift onto real line,
-* do another (real single-shift) QR step.
-*
- IF( WI.EQ.ZERO )
- $ GO TO 350
- S1INV = ONE / S1
-*
-* Do EISPACK (QZVAL) computation of alpha and beta
-*
- A11 = H( ILAST-1, ILAST-1 )
- A21 = H( ILAST, ILAST-1 )
- A12 = H( ILAST-1, ILAST )
- A22 = H( ILAST, ILAST )
-*
-* Compute complex Givens rotation on right
-* (Assume some element of C = (sA - wB) > unfl )
-* __
-* (sA - wB) ( CZ -SZ )
-* ( SZ CZ )
-*
- C11R = S1*A11 - WR*B11
- C11I = -WI*B11
- C12 = S1*A12
- C21 = S1*A21
- C22R = S1*A22 - WR*B22
- C22I = -WI*B22
-*
- IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
- $ ABS( C22R )+ABS( C22I ) ) THEN
- T1 = SLAPY3( C12, C11R, C11I )
- CZ = C12 / T1
- SZR = -C11R / T1
- SZI = -C11I / T1
- ELSE
- CZ = SLAPY2( C22R, C22I )
- IF( CZ.LE.SAFMIN ) THEN
- CZ = ZERO
- SZR = ONE
- SZI = ZERO
- ELSE
- TEMPR = C22R / CZ
- TEMPI = C22I / CZ
- T1 = SLAPY2( CZ, C21 )
- CZ = CZ / T1
- SZR = -C21*TEMPR / T1
- SZI = C21*TEMPI / T1
- END IF
- END IF
-*
-* Compute Givens rotation on left
-*
-* ( CQ SQ )
-* ( __ ) A or B
-* ( -SQ CQ )
-*
- AN = ABS( A11 ) + ABS( A12 ) + ABS( A21 ) + ABS( A22 )
- BN = ABS( B11 ) + ABS( B22 )
- WABS = ABS( WR ) + ABS( WI )
- IF( S1*AN.GT.WABS*BN ) THEN
- CQ = CZ*B11
- SQR = SZR*B22
- SQI = -SZI*B22
- ELSE
- A1R = CZ*A11 + SZR*A12
- A1I = SZI*A12
- A2R = CZ*A21 + SZR*A22
- A2I = SZI*A22
- CQ = SLAPY2( A1R, A1I )
- IF( CQ.LE.SAFMIN ) THEN
- CQ = ZERO
- SQR = ONE
- SQI = ZERO
- ELSE
- TEMPR = A1R / CQ
- TEMPI = A1I / CQ
- SQR = TEMPR*A2R + TEMPI*A2I
- SQI = TEMPI*A2R - TEMPR*A2I
- END IF
- END IF
- T1 = SLAPY3( CQ, SQR, SQI )
- CQ = CQ / T1
- SQR = SQR / T1
- SQI = SQI / T1
-*
-* Compute diagonal elements of QBZ
-*
- TEMPR = SQR*SZR - SQI*SZI
- TEMPI = SQR*SZI + SQI*SZR
- B1R = CQ*CZ*B11 + TEMPR*B22
- B1I = TEMPI*B22
- B1A = SLAPY2( B1R, B1I )
- B2R = CQ*CZ*B22 + TEMPR*B11
- B2I = -TEMPI*B11
- B2A = SLAPY2( B2R, B2I )
-*
-* Normalize so beta > 0, and Im( alpha1 ) > 0
-*
- BETA( ILAST-1 ) = B1A
- BETA( ILAST ) = B2A
- ALPHAR( ILAST-1 ) = ( WR*B1A )*S1INV
- ALPHAI( ILAST-1 ) = ( WI*B1A )*S1INV
- ALPHAR( ILAST ) = ( WR*B2A )*S1INV
- ALPHAI( ILAST ) = -( WI*B2A )*S1INV
-*
-* Step 3: Go to next block -- exit if finished.
-*
- ILAST = IFIRST - 1
- IF( ILAST.LT.ILO )
- $ GO TO 380
-*
-* Reset counters
-*
- IITER = 0
- ESHIFT = ZERO
- IF( .NOT.ILSCHR ) THEN
- ILASTM = ILAST
- IF( IFRSTM.GT.ILAST )
- $ IFRSTM = ILO
- END IF
- GO TO 350
- ELSE
-*
-* Usual case: 3x3 or larger block, using Francis implicit
-* double-shift
-*
-* 2
-* Eigenvalue equation is w - c w + d = 0,
-*
-* -1 2 -1
-* so compute 1st column of (A B ) - c A B + d
-* using the formula in QZIT (from EISPACK)
-*
-* We assume that the block is at least 3x3
-*
- AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
- $ ( BSCALE*T( ILAST, ILAST ) )
- AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
- $ ( BSCALE*T( ILAST, ILAST ) )
- U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
- AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
- $ ( BSCALE*T( IFIRST, IFIRST ) )
- AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
- $ ( BSCALE*T( IFIRST, IFIRST ) )
- AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
- $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
- AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
- $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
- AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
- $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
- U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
-*
- V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
- $ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
- V( 2 ) = ( ( AD22L-AD11L )-AD21L*U12L-( AD11-AD11L )-
- $ ( AD22-AD11L )+AD21*U12 )*AD21L
- V( 3 ) = AD32L*AD21L
-*
- ISTART = IFIRST
-*
- CALL SLARFG( 3, V( 1 ), V( 2 ), 1, TAU )
- V( 1 ) = ONE
-*
-* Sweep
-*
- DO 290 J = ISTART, ILAST - 2
-*
-* All but last elements: use 3x3 Householder transforms.
-*
-* Zero (j-1)st column of A
-*
- IF( J.GT.ISTART ) THEN
- V( 1 ) = H( J, J-1 )
- V( 2 ) = H( J+1, J-1 )
- V( 3 ) = H( J+2, J-1 )
-*
- CALL SLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
- V( 1 ) = ONE
- H( J+1, J-1 ) = ZERO
- H( J+2, J-1 ) = ZERO
- END IF
-*
- DO 230 JC = J, ILASTM
- TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
- $ H( J+2, JC ) )
- H( J, JC ) = H( J, JC ) - TEMP
- H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
- H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
- TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
- $ T( J+2, JC ) )
- T( J, JC ) = T( J, JC ) - TEMP2
- T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
- T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
- 230 CONTINUE
- IF( ILQ ) THEN
- DO 240 JR = 1, N
- TEMP = TAU*( Q( JR, J )+V( 2 )*Q( JR, J+1 )+V( 3 )*
- $ Q( JR, J+2 ) )
- Q( JR, J ) = Q( JR, J ) - TEMP
- Q( JR, J+1 ) = Q( JR, J+1 ) - TEMP*V( 2 )
- Q( JR, J+2 ) = Q( JR, J+2 ) - TEMP*V( 3 )
- 240 CONTINUE
- END IF
-*
-* Zero j-th column of B (see SLAGBC for details)
-*
-* Swap rows to pivot
-*
- ILPIVT = .FALSE.
- TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
- TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
- IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
- SCALE = ZERO
- U1 = ONE
- U2 = ZERO
- GO TO 250
- ELSE IF( TEMP.GE.TEMP2 ) THEN
- W11 = T( J+1, J+1 )
- W21 = T( J+2, J+1 )
- W12 = T( J+1, J+2 )
- W22 = T( J+2, J+2 )
- U1 = T( J+1, J )
- U2 = T( J+2, J )
- ELSE
- W21 = T( J+1, J+1 )
- W11 = T( J+2, J+1 )
- W22 = T( J+1, J+2 )
- W12 = T( J+2, J+2 )
- U2 = T( J+1, J )
- U1 = T( J+2, J )
- END IF
-*
-* Swap columns if nec.
-*
- IF( ABS( W12 ).GT.ABS( W11 ) ) THEN
- ILPIVT = .TRUE.
- TEMP = W12
- TEMP2 = W22
- W12 = W11
- W22 = W21
- W11 = TEMP
- W21 = TEMP2
- END IF
-*
-* LU-factor
-*
- TEMP = W21 / W11
- U2 = U2 - TEMP*U1
- W22 = W22 - TEMP*W12
- W21 = ZERO
-*
-* Compute SCALE
-*
- SCALE = ONE
- IF( ABS( W22 ).LT.SAFMIN ) THEN
- SCALE = ZERO
- U2 = ONE
- U1 = -W12 / W11
- GO TO 250
- END IF
- IF( ABS( W22 ).LT.ABS( U2 ) )
- $ SCALE = ABS( W22 / U2 )
- IF( ABS( W11 ).LT.ABS( U1 ) )
- $ SCALE = MIN( SCALE, ABS( W11 / U1 ) )
-*
-* Solve
-*
- U2 = ( SCALE*U2 ) / W22
- U1 = ( SCALE*U1-W12*U2 ) / W11
-*
- 250 CONTINUE
- IF( ILPIVT ) THEN
- TEMP = U2
- U2 = U1
- U1 = TEMP
- END IF
-*
-* Compute Householder Vector
-*
- T1 = SQRT( SCALE**2+U1**2+U2**2 )
- TAU = ONE + SCALE / T1
- VS = -ONE / ( SCALE+T1 )
- V( 1 ) = ONE
- V( 2 ) = VS*U1
- V( 3 ) = VS*U2
-*
-* Apply transformations from the right.
-*
- DO 260 JR = IFRSTM, MIN( J+3, ILAST )
- TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
- $ H( JR, J+2 ) )
- H( JR, J ) = H( JR, J ) - TEMP
- H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
- H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
- 260 CONTINUE
- DO 270 JR = IFRSTM, J + 2
- TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
- $ T( JR, J+2 ) )
- T( JR, J ) = T( JR, J ) - TEMP
- T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
- T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
- 270 CONTINUE
- IF( ILZ ) THEN
- DO 280 JR = 1, N
- TEMP = TAU*( Z( JR, J )+V( 2 )*Z( JR, J+1 )+V( 3 )*
- $ Z( JR, J+2 ) )
- Z( JR, J ) = Z( JR, J ) - TEMP
- Z( JR, J+1 ) = Z( JR, J+1 ) - TEMP*V( 2 )
- Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
- 280 CONTINUE
- END IF
- T( J+1, J ) = ZERO
- T( J+2, J ) = ZERO
- 290 CONTINUE
-*
-* Last elements: Use Givens rotations
-*
-* Rotations from the left
-*
- J = ILAST - 1
- TEMP = H( J, J-1 )
- CALL SLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
- H( J+1, J-1 ) = ZERO
-*
- DO 300 JC = J, ILASTM
- TEMP = C*H( J, JC ) + S*H( J+1, JC )
- H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
- H( J, JC ) = TEMP
- TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
- T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
- T( J, JC ) = TEMP2
- 300 CONTINUE
- IF( ILQ ) THEN
- DO 310 JR = 1, N
- TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
- Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
- Q( JR, J ) = TEMP
- 310 CONTINUE
- END IF
-*
-* Rotations from the right.
-*
- TEMP = T( J+1, J+1 )
- CALL SLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
- T( J+1, J ) = ZERO
-*
- DO 320 JR = IFRSTM, ILAST
- TEMP = C*H( JR, J+1 ) + S*H( JR, J )
- H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
- H( JR, J+1 ) = TEMP
- 320 CONTINUE
- DO 330 JR = IFRSTM, ILAST - 1
- TEMP = C*T( JR, J+1 ) + S*T( JR, J )
- T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
- T( JR, J+1 ) = TEMP
- 330 CONTINUE
- IF( ILZ ) THEN
- DO 340 JR = 1, N
- TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
- Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
- Z( JR, J+1 ) = TEMP
- 340 CONTINUE
- END IF
-*
-* End of Double-Shift code
-*
- END IF
-*
- GO TO 350
-*
-* End of iteration loop
-*
- 350 CONTINUE
- 360 CONTINUE
-*
-* Drop-through = non-convergence
-*
- INFO = ILAST
- GO TO 420
-*
-* Successful completion of all QZ steps
-*
- 380 CONTINUE
-*
-* Set Eigenvalues 1:ILO-1
-*
- DO 410 J = 1, ILO - 1
- IF( T( J, J ).LT.ZERO ) THEN
- IF( ILSCHR ) THEN
- DO 390 JR = 1, J
- H( JR, J ) = -H( JR, J )
- T( JR, J ) = -T( JR, J )
- 390 CONTINUE
- ELSE
- H( J, J ) = -H( J, J )
- T( J, J ) = -T( J, J )
- END IF
- IF( ILZ ) THEN
- DO 400 JR = 1, N
- Z( JR, J ) = -Z( JR, J )
- 400 CONTINUE
- END IF
- END IF
- ALPHAR( J ) = H( J, J )
- ALPHAI( J ) = ZERO
- BETA( J ) = T( J, J )
- 410 CONTINUE
-*
-* Normal Termination
-*
- INFO = 0
-*
-* Exit (other than argument error) -- return optimal workspace size
-*
- 420 CONTINUE
- WORK( 1 ) = REAL( N )
- RETURN
-*
-* End of SHGEQZ
-*
- END
diff --git a/netlib/LAPACK/shsein.f b/netlib/LAPACK/shsein.f
deleted file mode 100644
index 0c69e2c..0000000
--- a/netlib/LAPACK/shsein.f
+++ /dev/null
@@ -1,526 +0,0 @@
-*> \brief \b SHSEIN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SHSEIN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/shsein.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/shsein.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/shsein.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI,
-* VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL,
-* IFAILR, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EIGSRC, INITV, SIDE
-* INTEGER INFO, LDH, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IFAILL( * ), IFAILR( * )
-* REAL H( LDH, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SHSEIN uses inverse iteration to find specified right and/or left
-*> eigenvectors of a real upper Hessenberg matrix H.
-*>
-*> The right eigenvector x and the left eigenvector y of the matrix H
-*> corresponding to an eigenvalue w are defined by:
-*>
-*> H * x = w * x, y**h * H = w * y**h
-*>
-*> where y**h denotes the conjugate transpose of the vector y.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] EIGSRC
-*> \verbatim
-*> EIGSRC is CHARACTER*1
-*> Specifies the source of eigenvalues supplied in (WR,WI):
-*> = 'Q': the eigenvalues were found using SHSEQR; thus, if
-*> H has zero subdiagonal elements, and so is
-*> block-triangular, then the j-th eigenvalue can be
-*> assumed to be an eigenvalue of the block containing
-*> the j-th row/column. This property allows SHSEIN to
-*> perform inverse iteration on just one diagonal block.
-*> = 'N': no assumptions are made on the correspondence
-*> between eigenvalues and diagonal blocks. In this
-*> case, SHSEIN must always perform inverse iteration
-*> using the whole matrix H.
-*> \endverbatim
-*>
-*> \param[in] INITV
-*> \verbatim
-*> INITV is CHARACTER*1
-*> = 'N': no initial vectors are supplied;
-*> = 'U': user-supplied initial vectors are stored in the arrays
-*> VL and/or VR.
-*> \endverbatim
-*>
-*> \param[in,out] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> Specifies the eigenvectors to be computed. To select the
-*> real eigenvector corresponding to a real eigenvalue WR(j),
-*> SELECT(j) must be set to .TRUE.. To select the complex
-*> eigenvector corresponding to a complex eigenvalue
-*> (WR(j),WI(j)), with complex conjugate (WR(j+1),WI(j+1)),
-*> either SELECT(j) or SELECT(j+1) or both must be set to
-*> .TRUE.; then on exit SELECT(j) is .TRUE. and SELECT(j+1) is
-*> .FALSE..
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> The upper Hessenberg matrix H.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*>
-*> On entry, the real and imaginary parts of the eigenvalues of
-*> H; a complex conjugate pair of eigenvalues must be stored in
-*> consecutive elements of WR and WI.
-*> On exit, WR may have been altered since close eigenvalues
-*> are perturbed slightly in searching for independent
-*> eigenvectors.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,MM)
-*> On entry, if INITV = 'U' and SIDE = 'L' or 'B', VL must
-*> contain starting vectors for the inverse iteration for the
-*> left eigenvectors; the starting vector for each eigenvector
-*> must be in the same column(s) in which the eigenvector will
-*> be stored.
-*> On exit, if SIDE = 'L' or 'B', the left eigenvectors
-*> specified by SELECT will be stored consecutively in the
-*> columns of VL, in the same order as their eigenvalues. A
-*> complex eigenvector corresponding to a complex eigenvalue is
-*> stored in two consecutive columns, the first holding the real
-*> part and the second the imaginary part.
-*> If SIDE = 'R', VL is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL.
-*> LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,MM)
-*> On entry, if INITV = 'U' and SIDE = 'R' or 'B', VR must
-*> contain starting vectors for the inverse iteration for the
-*> right eigenvectors; the starting vector for each eigenvector
-*> must be in the same column(s) in which the eigenvector will
-*> be stored.
-*> On exit, if SIDE = 'R' or 'B', the right eigenvectors
-*> specified by SELECT will be stored consecutively in the
-*> columns of VR, in the same order as their eigenvalues. A
-*> complex eigenvector corresponding to a complex eigenvalue is
-*> stored in two consecutive columns, the first holding the real
-*> part and the second the imaginary part.
-*> If SIDE = 'L', VR is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR.
-*> LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR required to
-*> store the eigenvectors; each selected real eigenvector
-*> occupies one column and each selected complex eigenvector
-*> occupies two columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ((N+2)*N)
-*> \endverbatim
-*>
-*> \param[out] IFAILL
-*> \verbatim
-*> IFAILL is INTEGER array, dimension (MM)
-*> If SIDE = 'L' or 'B', IFAILL(i) = j > 0 if the left
-*> eigenvector in the i-th column of VL (corresponding to the
-*> eigenvalue w(j)) failed to converge; IFAILL(i) = 0 if the
-*> eigenvector converged satisfactorily. If the i-th and (i+1)th
-*> columns of VL hold a complex eigenvector, then IFAILL(i) and
-*> IFAILL(i+1) are set to the same value.
-*> If SIDE = 'R', IFAILL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] IFAILR
-*> \verbatim
-*> IFAILR is INTEGER array, dimension (MM)
-*> If SIDE = 'R' or 'B', IFAILR(i) = j > 0 if the right
-*> eigenvector in the i-th column of VR (corresponding to the
-*> eigenvalue w(j)) failed to converge; IFAILR(i) = 0 if the
-*> eigenvector converged satisfactorily. If the i-th and (i+1)th
-*> columns of VR hold a complex eigenvector, then IFAILR(i) and
-*> IFAILR(i+1) are set to the same value.
-*> If SIDE = 'L', IFAILR is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, i is the number of eigenvectors which
-*> failed to converge; see IFAILL and IFAILR for further
-*> details.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Each eigenvector is normalized so that the element of largest
-*> magnitude has magnitude 1; here the magnitude of a complex number
-*> (x,y) is taken to be |x|+|y|.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI,
- $ VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL,
- $ IFAILR, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER EIGSRC, INITV, SIDE
- INTEGER INFO, LDH, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IFAILL( * ), IFAILR( * )
- REAL H( LDH, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BOTHV, FROMQR, LEFTV, NOINIT, PAIR, RIGHTV
- INTEGER I, IINFO, K, KL, KLN, KR, KSI, KSR, LDWORK
- REAL BIGNUM, EPS3, HNORM, SMLNUM, ULP, UNFL, WKI,
- $ WKR
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANHS
- EXTERNAL LSAME, SLAMCH, SLANHS
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAEIN, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters.
-*
- BOTHV = LSAME( SIDE, 'B' )
- RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
- LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
- FROMQR = LSAME( EIGSRC, 'Q' )
-*
- NOINIT = LSAME( INITV, 'N' )
-*
-* Set M to the number of columns required to store the selected
-* eigenvectors, and standardize the array SELECT.
-*
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- SELECT( K ) = .FALSE.
- ELSE
- IF( WI( K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) ) THEN
- SELECT( K ) = .TRUE.
- M = M + 2
- END IF
- END IF
- END IF
- 10 CONTINUE
-*
- INFO = 0
- IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -1
- ELSE IF( .NOT.FROMQR .AND. .NOT.LSAME( EIGSRC, 'N' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOINIT .AND. .NOT.LSAME( INITV, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
- INFO = -11
- ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
- INFO = -13
- ELSE IF( MM.LT.M ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SHSEIN', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set machine-dependent constants.
-*
- UNFL = SLAMCH( 'Safe minimum' )
- ULP = SLAMCH( 'Precision' )
- SMLNUM = UNFL*( N / ULP )
- BIGNUM = ( ONE-ULP ) / SMLNUM
-*
- LDWORK = N + 1
-*
- KL = 1
- KLN = 0
- IF( FROMQR ) THEN
- KR = 0
- ELSE
- KR = N
- END IF
- KSR = 1
-*
- DO 120 K = 1, N
- IF( SELECT( K ) ) THEN
-*
-* Compute eigenvector(s) corresponding to W(K).
-*
- IF( FROMQR ) THEN
-*
-* If affiliation of eigenvalues is known, check whether
-* the matrix splits.
-*
-* Determine KL and KR such that 1 <= KL <= K <= KR <= N
-* and H(KL,KL-1) and H(KR+1,KR) are zero (or KL = 1 or
-* KR = N).
-*
-* Then inverse iteration can be performed with the
-* submatrix H(KL:N,KL:N) for a left eigenvector, and with
-* the submatrix H(1:KR,1:KR) for a right eigenvector.
-*
- DO 20 I = K, KL + 1, -1
- IF( H( I, I-1 ).EQ.ZERO )
- $ GO TO 30
- 20 CONTINUE
- 30 CONTINUE
- KL = I
- IF( K.GT.KR ) THEN
- DO 40 I = K, N - 1
- IF( H( I+1, I ).EQ.ZERO )
- $ GO TO 50
- 40 CONTINUE
- 50 CONTINUE
- KR = I
- END IF
- END IF
-*
- IF( KL.NE.KLN ) THEN
- KLN = KL
-*
-* Compute infinity-norm of submatrix H(KL:KR,KL:KR) if it
-* has not ben computed before.
-*
- HNORM = SLANHS( 'I', KR-KL+1, H( KL, KL ), LDH, WORK )
- IF( HNORM.GT.ZERO ) THEN
- EPS3 = HNORM*ULP
- ELSE
- EPS3 = SMLNUM
- END IF
- END IF
-*
-* Perturb eigenvalue if it is close to any previous
-* selected eigenvalues affiliated to the submatrix
-* H(KL:KR,KL:KR). Close roots are modified by EPS3.
-*
- WKR = WR( K )
- WKI = WI( K )
- 60 CONTINUE
- DO 70 I = K - 1, KL, -1
- IF( SELECT( I ) .AND. ABS( WR( I )-WKR )+
- $ ABS( WI( I )-WKI ).LT.EPS3 ) THEN
- WKR = WKR + EPS3
- GO TO 60
- END IF
- 70 CONTINUE
- WR( K ) = WKR
-*
- PAIR = WKI.NE.ZERO
- IF( PAIR ) THEN
- KSI = KSR + 1
- ELSE
- KSI = KSR
- END IF
- IF( LEFTV ) THEN
-*
-* Compute left eigenvector.
-*
- CALL SLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), LDH,
- $ WKR, WKI, VL( KL, KSR ), VL( KL, KSI ),
- $ WORK, LDWORK, WORK( N*N+N+1 ), EPS3, SMLNUM,
- $ BIGNUM, IINFO )
- IF( IINFO.GT.0 ) THEN
- IF( PAIR ) THEN
- INFO = INFO + 2
- ELSE
- INFO = INFO + 1
- END IF
- IFAILL( KSR ) = K
- IFAILL( KSI ) = K
- ELSE
- IFAILL( KSR ) = 0
- IFAILL( KSI ) = 0
- END IF
- DO 80 I = 1, KL - 1
- VL( I, KSR ) = ZERO
- 80 CONTINUE
- IF( PAIR ) THEN
- DO 90 I = 1, KL - 1
- VL( I, KSI ) = ZERO
- 90 CONTINUE
- END IF
- END IF
- IF( RIGHTV ) THEN
-*
-* Compute right eigenvector.
-*
- CALL SLAEIN( .TRUE., NOINIT, KR, H, LDH, WKR, WKI,
- $ VR( 1, KSR ), VR( 1, KSI ), WORK, LDWORK,
- $ WORK( N*N+N+1 ), EPS3, SMLNUM, BIGNUM,
- $ IINFO )
- IF( IINFO.GT.0 ) THEN
- IF( PAIR ) THEN
- INFO = INFO + 2
- ELSE
- INFO = INFO + 1
- END IF
- IFAILR( KSR ) = K
- IFAILR( KSI ) = K
- ELSE
- IFAILR( KSR ) = 0
- IFAILR( KSI ) = 0
- END IF
- DO 100 I = KR + 1, N
- VR( I, KSR ) = ZERO
- 100 CONTINUE
- IF( PAIR ) THEN
- DO 110 I = KR + 1, N
- VR( I, KSI ) = ZERO
- 110 CONTINUE
- END IF
- END IF
-*
- IF( PAIR ) THEN
- KSR = KSR + 2
- ELSE
- KSR = KSR + 1
- END IF
- END IF
- 120 CONTINUE
-*
- RETURN
-*
-* End of SHSEIN
-*
- END
diff --git a/netlib/LAPACK/shseqr.f b/netlib/LAPACK/shseqr.f
deleted file mode 100644
index 1c1f8ec..0000000
--- a/netlib/LAPACK/shseqr.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief \b SHSEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SHSEQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/shseqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/shseqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/shseqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
-* LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
-* CHARACTER COMPZ, JOB
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SHSEQR computes the eigenvalues of a Hessenberg matrix H
-*> and, optionally, the matrices T and Z from the Schur decomposition
-*> H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*> Schur form), and Z is the orthogonal matrix of Schur vectors.
-*>
-*> Optionally Z may be postmultiplied into an input orthogonal
-*> matrix Q so that this routine can give the Schur factorization
-*> of a matrix A which has been reduced to the Hessenberg form H
-*> by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> = 'E': compute eigenvalues only;
-*> = 'S': compute eigenvalues and the Schur form T.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': no Schur vectors are computed;
-*> = 'I': Z is initialized to the unit matrix and the matrix Z
-*> of Schur vectors of H is returned;
-*> = 'V': Z must contain an orthogonal matrix Q on entry, and
-*> the product Q*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to SGEBAL, and then passed to ZGEHRD
-*> when the matrix output by SGEBAL is reduced to Hessenberg
-*> form. Otherwise ILO and IHI should be set to 1 and N
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and JOB = 'S', then H contains the
-*> upper quasi-triangular matrix T from the Schur decomposition
-*> (the Schur form); 2-by-2 diagonal blocks (corresponding to
-*> complex conjugate pairs of eigenvalues) are returned in
-*> standard form, with H(i,i) = H(i+1,i+1) and
-*> H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
-*> contents of H are unspecified on exit. (The output value of
-*> H when INFO.GT.0 is given under the description of INFO
-*> below.)
-*>
-*> Unlike earlier versions of SHSEQR, this subroutine may
-*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
-*> or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*>
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues. If two eigenvalues are computed as a complex
-*> conjugate pair, they are stored in consecutive elements of
-*> WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
-*> WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
-*> the same order as on the diagonal of the Schur form returned
-*> in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
-*> diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> If COMPZ = 'N', Z is not referenced.
-*> If COMPZ = 'I', on entry Z need not be set and on exit,
-*> if INFO = 0, Z contains the orthogonal matrix Z of the Schur
-*> vectors of H. If COMPZ = 'V', on entry Z must contain an
-*> N-by-N matrix Q, which is assumed to be equal to the unit
-*> matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
-*> if INFO = 0, Z contains Q*Z.
-*> Normally Q is the orthogonal matrix generated by SORGHR
-*> after the call to SGEHRD which formed the Hessenberg matrix
-*> H. (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if COMPZ = 'I' or
-*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient and delivers very good and sometimes
-*> optimal performance. However, LWORK as large as 11*N
-*> may be required for optimal performance. A workspace
-*> query is recommended to determine the optimal workspace
-*> size.
-*>
-*> If LWORK = -1, then SHSEQR does a workspace query.
-*> In this case, SHSEQR checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .LT. 0: if INFO = -i, the i-th argument had an illegal
-*> value
-*> .GT. 0: if INFO = i, SHSEQR failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and JOB = 'E', then on exit, the
-*> remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and JOB = 'S', then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is an orthogonal matrix. The final
-*> value of H is upper Hessenberg and quasi-triangular
-*> in rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and COMPZ = 'V', then on exit
-*>
-*> (final value of Z) = (initial value of Z)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of JOB.)
-*>
-*> If INFO .GT. 0 and COMPZ = 'I', then on exit
-*> (final value of Z) = U
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of JOB.)
-*>
-*> If INFO .GT. 0 and COMPZ = 'N', then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Default values supplied by
-*> ILAENV(ISPEC,'SHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
-*> It is suggested that these defaults be adjusted in order
-*> to attain best performance in each particular
-*> computational environment.
-*>
-*> ISPEC=12: The SLAHQR vs SLAQR0 crossover point.
-*> Default: 75. (Must be at least 11.)
-*>
-*> ISPEC=13: Recommended deflation window size.
-*> This depends on ILO, IHI and NS. NS is the
-*> number of simultaneous shifts returned
-*> by ILAENV(ISPEC=15). (See ISPEC=15 below.)
-*> The default for (IHI-ILO+1).LE.500 is NS.
-*> The default for (IHI-ILO+1).GT.500 is 3*NS/2.
-*>
-*> ISPEC=14: Nibble crossover point. (See IPARMQ for
-*> details.) Default: 14% of deflation window
-*> size.
-*>
-*> ISPEC=15: Number of simultaneous shifts in a multishift
-*> QR iteration.
-*>
-*> If IHI-ILO+1 is ...
-*>
-*> greater than ...but less ... the
-*> or equal to ... than default is
-*>
-*> 1 30 NS = 2(+)
-*> 30 60 NS = 4(+)
-*> 60 150 NS = 10(+)
-*> 150 590 NS = **
-*> 590 3000 NS = 64
-*> 3000 6000 NS = 128
-*> 6000 infinity NS = 256
-*>
-*> (+) By default some or all matrices of this order
-*> are passed to the implicit double shift routine
-*> SLAHQR and this parameter is ignored. See
-*> ISPEC=12 above and comments in IPARMQ for
-*> details.
-*>
-*> (**) The asterisks (**) indicate an ad-hoc
-*> function of N increasing from 10 to 64.
-*>
-*> ISPEC=16: Select structured matrix multiply.
-*> If the number of simultaneous shifts (specified
-*> by ISPEC=15) is less than 14, then the default
-*> for ISPEC=16 is 0. Otherwise the default for
-*> ISPEC=16 is 2.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-* =====================================================================
- SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
- $ LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
- CHARACTER COMPZ, JOB
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . SLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== NL allocates some local workspace to help small matrices
-* . through a rare SLAHQR failure. NL .GT. NTINY = 11 is
-* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom-
-* . mended. (The default value of NMIN is 75.) Using NL = 49
-* . allows up to six simultaneous shifts and a 16-by-16
-* . deflation window. ====
- INTEGER NL
- PARAMETER ( NL = 49 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 )
-* ..
-* .. Local Arrays ..
- REAL HL( NL, NL ), WORKL( NL )
-* ..
-* .. Local Scalars ..
- INTEGER I, KBOT, NMIN
- LOGICAL INITZ, LQUERY, WANTT, WANTZ
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- LOGICAL LSAME
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SLAHQR, SLAQR0, SLASET, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, REAL
-* ..
-* .. Executable Statements ..
-*
-* ==== Decode and check the input parameters. ====
-*
- WANTT = LSAME( JOB, 'S' )
- INITZ = LSAME( COMPZ, 'I' )
- WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
- WORK( 1 ) = REAL( MAX( 1, N ) )
- LQUERY = LWORK.EQ.-1
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -5
- ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.NE.0 ) THEN
-*
-* ==== Quick return in case of invalid argument. ====
-*
- CALL XERBLA( 'SHSEQR', -INFO )
- RETURN
-*
- ELSE IF( N.EQ.0 ) THEN
-*
-* ==== Quick return in case N = 0; nothing to do. ====
-*
- RETURN
-*
- ELSE IF( LQUERY ) THEN
-*
-* ==== Quick return in case of a workspace query ====
-*
- CALL SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, WORK, LWORK, INFO )
-* ==== Ensure reported workspace size is backward-compatible with
-* . previous LAPACK versions. ====
- WORK( 1 ) = MAX( REAL( MAX( 1, N ) ), WORK( 1 ) )
- RETURN
-*
- ELSE
-*
-* ==== copy eigenvalues isolated by SGEBAL ====
-*
- DO 10 I = 1, ILO - 1
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- 10 CONTINUE
- DO 20 I = IHI + 1, N
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- 20 CONTINUE
-*
-* ==== Initialize Z, if requested ====
-*
- IF( INITZ )
- $ CALL SLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
-*
-* ==== Quick return if possible ====
-*
- IF( ILO.EQ.IHI ) THEN
- WR( ILO ) = H( ILO, ILO )
- WI( ILO ) = ZERO
- RETURN
- END IF
-*
-* ==== SLAHQR/SLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'SHSEQR', JOB( : 1 ) // COMPZ( : 1 ), N,
- $ ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== SLAQR0 for big matrices; SLAHQR for small ones ====
-*
- IF( N.GT.NMIN ) THEN
- CALL SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, WORK, LWORK, INFO )
- ELSE
-*
-* ==== Small matrix ====
-*
- CALL SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, INFO )
-*
- IF( INFO.GT.0 ) THEN
-*
-* ==== A rare SLAHQR failure! SLAQR0 sometimes succeeds
-* . when SLAHQR fails. ====
-*
- KBOT = INFO
-*
- IF( N.GE.NL ) THEN
-*
-* ==== Larger matrices have enough subdiagonal scratch
-* . space to call SLAQR0 directly. ====
-*
- CALL SLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, WR,
- $ WI, ILO, IHI, Z, LDZ, WORK, LWORK, INFO )
-*
- ELSE
-*
-* ==== Tiny matrices don't have enough subdiagonal
-* . scratch space to benefit from SLAQR0. Hence,
-* . tiny matrices must be copied into a larger
-* . array before calling SLAQR0. ====
-*
- CALL SLACPY( 'A', N, N, H, LDH, HL, NL )
- HL( N+1, N ) = ZERO
- CALL SLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
- $ NL )
- CALL SLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, WR,
- $ WI, ILO, IHI, Z, LDZ, WORKL, NL, INFO )
- IF( WANTT .OR. INFO.NE.0 )
- $ CALL SLACPY( 'A', N, N, HL, NL, H, LDH )
- END IF
- END IF
- END IF
-*
-* ==== Clear out the trash, if necessary. ====
-*
- IF( ( WANTT .OR. INFO.NE.0 ) .AND. N.GT.2 )
- $ CALL SLASET( 'L', N-2, N-2, ZERO, ZERO, H( 3, 1 ), LDH )
-*
-* ==== Ensure reported workspace size is backward-compatible with
-* . previous LAPACK versions. ====
-*
- WORK( 1 ) = MAX( REAL( MAX( 1, N ) ), WORK( 1 ) )
- END IF
-*
-* ==== End of SHSEQR ====
-*
- END
diff --git a/netlib/LAPACK/sisnan.f b/netlib/LAPACK/sisnan.f
deleted file mode 100644
index a746da5..0000000
--- a/netlib/LAPACK/sisnan.f
+++ /dev/null
@@ -1,80 +0,0 @@
-*> \brief \b SISNAN tests input for NaN.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SISNAN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sisnan.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sisnan.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sisnan.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION SISNAN( SIN )
-*
-* .. Scalar Arguments ..
-* REAL SIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SISNAN returns .TRUE. if its argument is NaN, and .FALSE.
-*> otherwise. To be replaced by the Fortran 2003 intrinsic in the
-*> future.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIN
-*> \verbatim
-*> SIN is REAL
-*> Input to test for NaN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION SISNAN( SIN )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL SIN
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL SLAISNAN
- EXTERNAL SLAISNAN
-* ..
-* .. Executable Statements ..
- SISNAN = SLAISNAN(SIN,SIN)
- RETURN
- END
diff --git a/netlib/LAPACK/sla_gbamv.f b/netlib/LAPACK/sla_gbamv.f
deleted file mode 100644
index 91de2d6..0000000
--- a/netlib/LAPACK/sla_gbamv.f
+++ /dev/null
@@ -1,410 +0,0 @@
-*> \brief \b SLA_GBAMV performs a matrix-vector operation to calculate error bounds.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_GBAMV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gbamv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gbamv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gbamv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
-* INCX, BETA, Y, INCY )
-*
-* .. Scalar Arguments ..
-* REAL ALPHA, BETA
-* INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_GBAMV performs one of the matrix-vector operations
-*>
-*> y := alpha*abs(A)*abs(x) + beta*abs(y),
-*> or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
-*>
-*> where alpha and beta are scalars, x and y are vectors and A is an
-*> m by n matrix.
-*>
-*> This function is primarily used in calculating error bounds.
-*> To protect against underflow during evaluation, components in
-*> the resulting vector are perturbed away from zero by (N+1)
-*> times the underflow threshold. To prevent unnecessarily large
-*> errors for block-structure embedded in general matrices,
-*> "symbolically" zero components are not perturbed. A zero
-*> entry is considered "symbolic" if all multiplications involved
-*> in computing that entry have at least one zero multiplicand.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is INTEGER
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
-*> BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*> BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array of DIMENSION ( LDAB, n )
-*> Before entry, the leading m by n part of the array AB must
-*> contain the matrix of coefficients.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> On entry, LDA specifies the first dimension of AB as declared
-*> in the calling (sub) program. LDAB must be at least
-*> max( 1, m ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension
-*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array, dimension
-*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> Unchanged on exit.
-*>
-*> Level 2 Blas routine.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
- $ INCX, BETA, Y, INCY )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL ALPHA, BETA
- INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL SYMB_ZERO
- REAL TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SLAMCH
- REAL SLAMCH
-* ..
-* .. External Functions ..
- EXTERNAL ILATRANS
- INTEGER ILATRANS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'C' ) ) ) ) THEN
- INFO = 1
- ELSE IF( M.LT.0 )THEN
- INFO = 2
- ELSE IF( N.LT.0 )THEN
- INFO = 3
- ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
- INFO = 4
- ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
- INFO = 5
- ELSE IF( LDAB.LT.KL+KU+1 )THEN
- INFO = 6
- ELSE IF( INCX.EQ.0 )THEN
- INFO = 8
- ELSE IF( INCY.EQ.0 )THEN
- INFO = 11
- END IF
- IF( INFO.NE.0 )THEN
- CALL XERBLA( 'SLA_GBAMV ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
- $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
- $ RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF( INCX.GT.0 )THEN
- KX = 1
- ELSE
- KX = 1 - ( LENX - 1 )*INCX
- END IF
- IF( INCY.GT.0 )THEN
- KY = 1
- ELSE
- KY = 1 - ( LENY - 1 )*INCY
- END IF
-*
-* Set SAFE1 essentially to be the underflow threshold times the
-* number of additions in each row.
-*
- SAFE1 = SLAMCH( 'Safe minimum' )
- SAFE1 = (N+1)*SAFE1
-*
-* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
-*
-* The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
-* the inexact flag. Still doesn't help change the iteration order
-* to per-column.
-*
- KD = KU + 1
- KE = KL + 1
- IY = KY
- IF ( INCX.EQ.1 ) THEN
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KD+I-J, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KE-I+J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
- IY = IY + INCY
- END DO
- END IF
- ELSE
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KD+I-J, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
- TEMP = ABS( AB( KE-I+J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
-
- END IF
-*
- RETURN
-*
-* End of SLA_GBAMV
-*
- END
diff --git a/netlib/LAPACK/sla_gbrcond.f b/netlib/LAPACK/sla_gbrcond.f
deleted file mode 100644
index 11700ac..0000000
--- a/netlib/LAPACK/sla_gbrcond.f
+++ /dev/null
@@ -1,351 +0,0 @@
-*> \brief \b SLA_GBRCOND estimates the Skeel condition number for a general banded matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_GBRCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gbrcond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gbrcond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gbrcond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB,
-* IPIV, CMODE, C, INFO, WORK, IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER N, LDAB, LDAFB, INFO, KL, KU, CMODE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * ), IPIV( * )
-* REAL AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ),
-* $ C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_GBRCOND Estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate Transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is REAL array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by SGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from the factorization A = P*L*U
-*> as computed by SGBTRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (5*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB,
- $ IPIV, CMODE, C, INFO, WORK, IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER N, LDAB, LDAFB, INFO, KL, KU, CMODE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * ), IPIV( * )
- REAL AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ),
- $ C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRANS
- INTEGER KASE, I, J, KD, KE
- REAL AINVNM, TMP
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SGBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- SLA_GBRCOND = 0.0
-*
- INFO = 0
- NOTRANS = LSAME( TRANS, 'N' )
- IF ( .NOT. NOTRANS .AND. .NOT. LSAME(TRANS, 'T')
- $ .AND. .NOT. LSAME(TRANS, 'C') ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLA_GBRCOND', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 ) THEN
- SLA_GBRCOND = 1.0
- RETURN
- END IF
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- KD = KU + 1
- KE = KL + 1
- IF ( NOTRANS ) THEN
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KD+I-J, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KD+I-J, J ) )
- END DO
- ELSE
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KD+I-J, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KE-I+J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KE-I+J, I ) )
- END DO
- ELSE
- DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
- TMP = TMP + ABS( AB( KE-I+J, I ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- END IF
-*
-* Estimate the norm of inv(op(A)).
-*
- AINVNM = 0.0
-
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
-
- IF ( NOTRANS ) THEN
- CALL SGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB,
- $ IPIV, WORK, N, INFO )
- ELSE
- CALL SGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK, N, INFO )
- END IF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF ( NOTRANS ) THEN
- CALL SGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK, N, INFO )
- ELSE
- CALL SGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB,
- $ IPIV, WORK, N, INFO )
- END IF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0 )
- $ SLA_GBRCOND = ( 1.0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/sla_gbrpvgrw.f b/netlib/LAPACK/sla_gbrpvgrw.f
deleted file mode 100644
index b1177ba..0000000
--- a/netlib/LAPACK/sla_gbrpvgrw.f
+++ /dev/null
@@ -1,160 +0,0 @@
-*> \brief \b SLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_GBRPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gbrpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gbrpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gbrpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_GBRPVGRW( N, KL, KU, NCOLS, AB, LDAB, AFB,
-* LDAFB )
-*
-* .. Scalar Arguments ..
-* INTEGER N, KL, KU, NCOLS, LDAB, LDAFB
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), AFB( LDAFB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_GBRPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCOLS
-*> \verbatim
-*> NCOLS is INTEGER
-*> The number of columns of the matrix A. NCOLS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is REAL array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by SGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_GBRPVGRW( N, KL, KU, NCOLS, AB, LDAB, AFB,
- $ LDAFB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, KL, KU, NCOLS, LDAB, LDAFB
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), AFB( LDAFB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J, KD
- REAL AMAX, UMAX, RPVGRW
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- RPVGRW = 1.0
-
- KD = KU + 1
- DO J = 1, NCOLS
- AMAX = 0.0
- UMAX = 0.0
- DO I = MAX( J-KU, 1 ), MIN( J+KL, N )
- AMAX = MAX( ABS( AB( KD+I-J, J)), AMAX )
- END DO
- DO I = MAX( J-KU, 1 ), J
- UMAX = MAX( ABS( AFB( KD+I-J, J ) ), UMAX )
- END DO
- IF ( UMAX /= 0.0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- SLA_GBRPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/sla_geamv.f b/netlib/LAPACK/sla_geamv.f
deleted file mode 100644
index e6f68cf..0000000
--- a/netlib/LAPACK/sla_geamv.f
+++ /dev/null
@@ -1,396 +0,0 @@
-*> \brief \b SLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_GEAMV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_geamv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_geamv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_geamv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
-* Y, INCY )
-*
-* .. Scalar Arguments ..
-* REAL ALPHA, BETA
-* INTEGER INCX, INCY, LDA, M, N, TRANS
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_GEAMV performs one of the matrix-vector operations
-*>
-*> y := alpha*abs(A)*abs(x) + beta*abs(y),
-*> or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
-*>
-*> where alpha and beta are scalars, x and y are vectors and A is an
-*> m by n matrix.
-*>
-*> This function is primarily used in calculating error bounds.
-*> To protect against underflow during evaluation, components in
-*> the resulting vector are perturbed away from zero by (N+1)
-*> times the underflow threshold. To prevent unnecessarily large
-*> errors for block-structure embedded in general matrices,
-*> "symbolically" zero components are not perturbed. A zero
-*> entry is considered "symbolic" if all multiplications involved
-*> in computing that entry have at least one zero multiplicand.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is INTEGER
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
-*> BLAS_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*> BLAS_CONJ_TRANS y := alpha*abs(A**T)*abs(x) + beta*abs(y)
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n )
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, m ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension
-*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL
-*> Array of DIMENSION at least
-*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> Unchanged on exit.
-*>
-*> Level 2 Blas routine.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
- $ Y, INCY )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL ALPHA, BETA
- INTEGER INCX, INCY, LDA, M, N, TRANS
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL SYMB_ZERO
- REAL TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SLAMCH
- REAL SLAMCH
-* ..
-* .. External Functions ..
- EXTERNAL ILATRANS
- INTEGER ILATRANS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
- $ .OR. ( TRANS.EQ.ILATRANS( 'C' )) ) ) THEN
- INFO = 1
- ELSE IF( M.LT.0 )THEN
- INFO = 2
- ELSE IF( N.LT.0 )THEN
- INFO = 3
- ELSE IF( LDA.LT.MAX( 1, M ) )THEN
- INFO = 6
- ELSE IF( INCX.EQ.0 )THEN
- INFO = 8
- ELSE IF( INCY.EQ.0 )THEN
- INFO = 11
- END IF
- IF( INFO.NE.0 )THEN
- CALL XERBLA( 'SLA_GEAMV ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
- $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
- $ RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF( INCX.GT.0 )THEN
- KX = 1
- ELSE
- KX = 1 - ( LENX - 1 )*INCX
- END IF
- IF( INCY.GT.0 )THEN
- KY = 1
- ELSE
- KY = 1 - ( LENY - 1 )*INCY
- END IF
-*
-* Set SAFE1 essentially to be the underflow threshold times the
-* number of additions in each row.
-*
- SAFE1 = SLAMCH( 'Safe minimum' )
- SAFE1 = (N+1)*SAFE1
-*
-* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
-*
-* The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
-* the inexact flag. Still doesn't help change the iteration order
-* to per-column.
-*
- IY = KY
- IF ( INCX.EQ.1 ) THEN
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, LENX
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, LENX
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
- ELSE
- IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = 1, LENX
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF (.NOT.SYMB_ZERO)
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, LENY
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- JX = KX
- DO J = 1, LENX
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF (.NOT.SYMB_ZERO)
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
-
- END IF
-*
- RETURN
-*
-* End of SLA_GEAMV
-*
- END
diff --git a/netlib/LAPACK/sla_gercond.f b/netlib/LAPACK/sla_gercond.f
deleted file mode 100644
index e241cbd..0000000
--- a/netlib/LAPACK/sla_gercond.f
+++ /dev/null
@@ -1,327 +0,0 @@
-*> \brief \b SLA_GERCOND estimates the Skeel condition number for a general matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_GERCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gercond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gercond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gercond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_GERCOND ( TRANS, N, A, LDA, AF, LDAF, IPIV,
-* CMODE, C, INFO, WORK, IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), WORK( * ),
-* $ C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_GERCOND estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate Transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The factors L and U from the factorization
-*> A = P*L*U as computed by SGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from the factorization A = P*L*U
-*> as computed by SGETRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.2
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_GERCOND ( TRANS, N, A, LDA, AF, LDAF, IPIV,
- $ CMODE, C, INFO, WORK, IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), WORK( * ),
- $ C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRANS
- INTEGER KASE, I, J
- REAL AINVNM, TMP
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SGETRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- SLA_GERCOND = 0.0
-*
- INFO = 0
- NOTRANS = LSAME( TRANS, 'N' )
- IF ( .NOT. NOTRANS .AND. .NOT. LSAME(TRANS, 'T')
- $ .AND. .NOT. LSAME(TRANS, 'C') ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLA_GERCOND', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 ) THEN
- SLA_GERCOND = 1.0
- RETURN
- END IF
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- IF (NOTRANS) THEN
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( I, J ) )
- END DO
- ELSE
- DO J = 1, N
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- TMP = TMP + ABS( A( J, I ) )
- END DO
- ELSE
- DO J = 1, N
- TMP = TMP + ABS( A( J, I ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- END IF
-*
-* Estimate the norm of inv(op(A)).
-*
- AINVNM = 0.0
-
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK(I) = WORK(I) * WORK(2*N+I)
- END DO
-
- IF (NOTRANS) THEN
- CALL SGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- ELSE
- CALL SGETRS( 'Transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- END IF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF (NOTRANS) THEN
- CALL SGETRS( 'Transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- ELSE
- CALL SGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
- $ WORK, N, INFO )
- END IF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0 )
- $ SLA_GERCOND = ( 1.0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/sla_gerpvgrw.f b/netlib/LAPACK/sla_gerpvgrw.f
deleted file mode 100644
index 042cff2..0000000
--- a/netlib/LAPACK/sla_gerpvgrw.f
+++ /dev/null
@@ -1,139 +0,0 @@
-*> \brief \b SLA_GERPVGRW
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_GERPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gerpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gerpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gerpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_GERPVGRW( N, NCOLS, A, LDA, AF, LDAF )
-*
-* .. Scalar Arguments ..
-* INTEGER N, NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), AF( LDAF, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_GERPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCOLS
-*> \verbatim
-*> NCOLS is INTEGER
-*> The number of columns of the matrix A. NCOLS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The factors L and U from the factorization
-*> A = P*L*U as computed by SGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_GERPVGRW( N, NCOLS, A, LDA, AF, LDAF )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER N, NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), AF( LDAF, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- REAL AMAX, UMAX, RPVGRW
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- RPVGRW = 1.0
-
- DO J = 1, NCOLS
- AMAX = 0.0
- UMAX = 0.0
- DO I = 1, N
- AMAX = MAX( ABS( A( I, J ) ), AMAX )
- END DO
- DO I = 1, J
- UMAX = MAX( ABS( AF( I, J ) ), UMAX )
- END DO
- IF ( UMAX /= 0.0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- SLA_GERPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/sla_lin_berr.f b/netlib/LAPACK/sla_lin_berr.f
deleted file mode 100644
index 7f7a355..0000000
--- a/netlib/LAPACK/sla_lin_berr.f
+++ /dev/null
@@ -1,153 +0,0 @@
-*> \brief \b SLA_LIN_BERR computes a component-wise relative backward error.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_LIN_BERR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_lin_berr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_lin_berr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_lin_berr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR )
-*
-* .. Scalar Arguments ..
-* INTEGER N, NZ, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AYB( N, NRHS ), BERR( NRHS )
-* REAL RES( N, NRHS )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_LIN_BERR computes componentwise relative backward error from
-*> the formula
-*> max(i) ( abs(R(i)) / ( abs(op(A_s))*abs(Y) + abs(B_s) )(i) )
-*> where abs(Z) is the componentwise absolute value of the matrix
-*> or vector Z.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NZ
-*> \verbatim
-*> NZ is INTEGER
-*> We add (NZ+1)*SLAMCH( 'Safe minimum' ) to R(i) in the numerator to
-*> guard against spuriously zero residuals. Default value is N.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices AYB, RES, and BERR. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] RES
-*> \verbatim
-*> RES is REAL array, dimension (N,NRHS)
-*> The residual matrix, i.e., the matrix R in the relative backward
-*> error formula above.
-*> \endverbatim
-*>
-*> \param[in] AYB
-*> \verbatim
-*> AYB is REAL array, dimension (N, NRHS)
-*> The denominator in the relative backward error formula above, i.e.,
-*> the matrix abs(op(A_s))*abs(Y) + abs(B_s). The matrices A, Y, and B
-*> are from iterative refinement (see sla_gerfsx_extended.f).
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error from the formula above.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, NZ, NRHS
-* ..
-* .. Array Arguments ..
- REAL AYB( N, NRHS ), BERR( NRHS )
- REAL RES( N, NRHS )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL TMP
- INTEGER I, J
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- EXTERNAL SLAMCH
- REAL SLAMCH
- REAL SAFE1
-* ..
-* .. Executable Statements ..
-*
-* Adding SAFE1 to the numerator guards against spuriously zero
-* residuals. A similar safeguard is in the SLA_yyAMV routine used
-* to compute AYB.
-*
- SAFE1 = SLAMCH( 'Safe minimum' )
- SAFE1 = (NZ+1)*SAFE1
-
- DO J = 1, NRHS
- BERR(J) = 0.0
- DO I = 1, N
- IF (AYB(I,J) .NE. 0.0) THEN
- TMP = (SAFE1+ABS(RES(I,J)))/AYB(I,J)
- BERR(J) = MAX( BERR(J), TMP )
- END IF
-*
-* If AYB is exactly 0.0 (and if computed by SLA_yyAMV), then we know
-* the true residual also must be exactly 0.0.
-*
- END DO
- END DO
- END
diff --git a/netlib/LAPACK/sla_porcond.f b/netlib/LAPACK/sla_porcond.f
deleted file mode 100644
index f590086..0000000
--- a/netlib/LAPACK/sla_porcond.f
+++ /dev/null
@@ -1,327 +0,0 @@
-*> \brief \b SLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_PORCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_porcond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_porcond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_porcond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_PORCOND( UPLO, N, A, LDA, AF, LDAF, CMODE, C,
-* INFO, WORK, IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER N, LDA, LDAF, INFO, CMODE
-* REAL A( LDA, * ), AF( LDAF, * ), WORK( * ),
-* $ C( * )
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_PORCOND Estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_PORCOND( UPLO, N, A, LDA, AF, LDAF, CMODE, C,
- $ INFO, WORK, IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER N, LDA, LDAF, INFO, CMODE
- REAL A( LDA, * ), AF( LDAF, * ), WORK( * ),
- $ C( * )
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER KASE, I, J
- REAL AINVNM, TMP
- LOGICAL UP
-* ..
-* .. Array Arguments ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- EXTERNAL LSAME, ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SPOTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- SLA_PORCOND = 0.0
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLA_PORCOND', -INFO )
- RETURN
- END IF
-
- IF( N.EQ.0 ) THEN
- SLA_PORCOND = 1.0
- RETURN
- END IF
- UP = .FALSE.
- IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- IF ( UP ) THEN
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( J ,I ) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ENDIF
-*
-* Estimate the norm of inv(op(A)).
-*
- AINVNM = 0.0
-
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
-
- IF (UP) THEN
- CALL SPOTRS( 'Upper', N, 1, AF, LDAF, WORK, N, INFO )
- ELSE
- CALL SPOTRS( 'Lower', N, 1, AF, LDAF, WORK, N, INFO )
- ENDIF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF ( UP ) THEN
- CALL SPOTRS( 'Upper', N, 1, AF, LDAF, WORK, N, INFO )
- ELSE
- CALL SPOTRS( 'Lower', N, 1, AF, LDAF, WORK, N, INFO )
- ENDIF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0 )
- $ SLA_PORCOND = ( 1.0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/sla_porpvgrw.f b/netlib/LAPACK/sla_porpvgrw.f
deleted file mode 100644
index a6623c3..0000000
--- a/netlib/LAPACK/sla_porpvgrw.f
+++ /dev/null
@@ -1,208 +0,0 @@
-*> \brief \b SLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_PORPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_porpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_porpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_porpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER*1 UPLO
-* INTEGER NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*>
-*> SLA_PORPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] NCOLS
-*> \verbatim
-*> NCOLS is INTEGER
-*> The number of columns of the matrix A. NCOLS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER*1 UPLO
- INTEGER NCOLS, LDA, LDAF
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- REAL AMAX, UMAX, RPVGRW
- LOGICAL UPPER
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- EXTERNAL LSAME, SLASET
- LOGICAL LSAME
-* ..
-* .. Executable Statements ..
-*
- UPPER = LSAME( 'Upper', UPLO )
-*
-* SPOTRF will have factored only the NCOLSxNCOLS leading minor, so
-* we restrict the growth search to that minor and use only the first
-* 2*NCOLS workspace entries.
-*
- RPVGRW = 1.0
- DO I = 1, 2*NCOLS
- WORK( I ) = 0.0
- END DO
-*
-* Find the max magnitude entry of each column.
-*
- IF ( UPPER ) THEN
- DO J = 1, NCOLS
- DO I = 1, J
- WORK( NCOLS+J ) =
- $ MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
- END DO
- END DO
- ELSE
- DO J = 1, NCOLS
- DO I = J, NCOLS
- WORK( NCOLS+J ) =
- $ MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
- END DO
- END DO
- END IF
-*
-* Now find the max magnitude entry of each column of the factor in
-* AF. No pivoting, so no permutations.
-*
- IF ( LSAME( 'Upper', UPLO ) ) THEN
- DO J = 1, NCOLS
- DO I = 1, J
- WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
- END DO
- END DO
- ELSE
- DO J = 1, NCOLS
- DO I = J, NCOLS
- WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
- END DO
- END DO
- END IF
-*
-* Compute the *inverse* of the max element growth factor. Dividing
-* by zero would imply the largest entry of the factor's column is
-* zero. Than can happen when either the column of A is zero or
-* massive pivots made the factor underflow to zero. Neither counts
-* as growth in itself, so simply ignore terms with zero
-* denominators.
-*
- IF ( LSAME( 'Upper', UPLO ) ) THEN
- DO I = 1, NCOLS
- UMAX = WORK( I )
- AMAX = WORK( NCOLS+I )
- IF ( UMAX /= 0.0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- ELSE
- DO I = 1, NCOLS
- UMAX = WORK( I )
- AMAX = WORK( NCOLS+I )
- IF ( UMAX /= 0.0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- END IF
-
- SLA_PORPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/sla_syamv.f b/netlib/LAPACK/sla_syamv.f
deleted file mode 100644
index 5d44221..0000000
--- a/netlib/LAPACK/sla_syamv.f
+++ /dev/null
@@ -1,417 +0,0 @@
-*> \brief \b SLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_SYAMV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_syamv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_syamv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_syamv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
-* INCY )
-*
-* .. Scalar Arguments ..
-* REAL ALPHA, BETA
-* INTEGER INCX, INCY, LDA, N, UPLO
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_SYAMV performs the matrix-vector operation
-*>
-*> y := alpha*abs(A)*abs(x) + beta*abs(y),
-*>
-*> where alpha and beta are scalars, x and y are vectors and A is an
-*> n by n symmetric matrix.
-*>
-*> This function is primarily used in calculating error bounds.
-*> To protect against underflow during evaluation, components in
-*> the resulting vector are perturbed away from zero by (N+1)
-*> times the underflow threshold. To prevent unnecessarily large
-*> errors for block-structure embedded in general matrices,
-*> "symbolically" zero components are not perturbed. A zero
-*> entry is considered "symbolic" if all multiplications involved
-*> in computing that entry have at least one zero multiplicand.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is INTEGER
-*> On entry, UPLO specifies whether the upper or lower
-*> triangular part of the array A is to be referenced as
-*> follows:
-*>
-*> UPLO = BLAS_UPPER Only the upper triangular part of A
-*> is to be referenced.
-*>
-*> UPLO = BLAS_LOWER Only the lower triangular part of A
-*> is to be referenced.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL .
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, n ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension
-*> ( 1 + ( n - 1 )*abs( INCX ) )
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL .
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array, dimension
-*> ( 1 + ( n - 1 )*abs( INCY ) )
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> Unchanged on exit.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> -- Modified for the absolute-value product, April 2006
-*> Jason Riedy, UC Berkeley
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
- $ INCY )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL ALPHA, BETA
- INTEGER INCX, INCY, LDA, N, UPLO
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL SYMB_ZERO
- REAL TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SLAMCH
- REAL SLAMCH
-* ..
-* .. External Functions ..
- EXTERNAL ILAUPLO
- INTEGER ILAUPLO
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ( UPLO.NE.ILAUPLO( 'U' ) .AND.
- $ UPLO.NE.ILAUPLO( 'L' ) ) THEN
- INFO = 1
- ELSE IF( N.LT.0 )THEN
- INFO = 2
- ELSE IF( LDA.LT.MAX( 1, N ) )THEN
- INFO = 5
- ELSE IF( INCX.EQ.0 )THEN
- INFO = 7
- ELSE IF( INCY.EQ.0 )THEN
- INFO = 10
- END IF
- IF( INFO.NE.0 )THEN
- CALL XERBLA( 'SSYMV ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
- $ RETURN
-*
-* Set up the start points in X and Y.
-*
- IF( INCX.GT.0 )THEN
- KX = 1
- ELSE
- KX = 1 - ( N - 1 )*INCX
- END IF
- IF( INCY.GT.0 )THEN
- KY = 1
- ELSE
- KY = 1 - ( N - 1 )*INCY
- END IF
-*
-* Set SAFE1 essentially to be the underflow threshold times the
-* number of additions in each row.
-*
- SAFE1 = SLAMCH( 'Safe minimum' )
- SAFE1 = (N+1)*SAFE1
-*
-* Form y := alpha*abs(A)*abs(x) + beta*abs(y).
-*
-* The O(N^2) SYMB_ZERO tests could be replaced by O(N) queries to
-* the inexact flag. Still doesn't help change the iteration order
-* to per-column.
-*
- IY = KY
- IF ( INCX.EQ.1 ) THEN
- IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- DO J = I+1, N
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- DO J = I+1, N
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
- ELSE
- IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- JX = KX
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- DO J = I+1, N
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- ELSE
- DO I = 1, N
- IF ( BETA .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- Y( IY ) = 0.0
- ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
- SYMB_ZERO = .TRUE.
- ELSE
- SYMB_ZERO = .FALSE.
- Y( IY ) = BETA * ABS( Y( IY ) )
- END IF
- JX = KX
- IF ( ALPHA .NE. ZERO ) THEN
- DO J = 1, I
- TEMP = ABS( A( I, J ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- DO J = I+1, N
- TEMP = ABS( A( J, I ) )
- SYMB_ZERO = SYMB_ZERO .AND.
- $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
-
- Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP
- JX = JX + INCX
- END DO
- END IF
-
- IF ( .NOT.SYMB_ZERO )
- $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
-
- IY = IY + INCY
- END DO
- END IF
-
- END IF
-*
- RETURN
-*
-* End of SLA_SYAMV
-*
- END
diff --git a/netlib/LAPACK/sla_syrcond.f b/netlib/LAPACK/sla_syrcond.f
deleted file mode 100644
index a815ad9..0000000
--- a/netlib/LAPACK/sla_syrcond.f
+++ /dev/null
@@ -1,340 +0,0 @@
-*> \brief \b SLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_SYRCOND + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_syrcond.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_syrcond.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_syrcond.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE,
-* C, INFO, WORK, IWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments
-* INTEGER IWORK( * ), IPIV( * )
-* REAL A( LDA, * ), AF( LDAF, * ), WORK( * ), C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_SYRCOND estimates the Skeel condition number of op(A) * op2(C)
-*> where op2 is determined by CMODE as follows
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> The Skeel condition number cond(A) = norminf( |inv(A)||A| )
-*> is computed by computing scaling factors R such that
-*> diag(R)*A*op2(C) is row equilibrated and computing the standard
-*> infinity-norm condition number.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] CMODE
-*> \verbatim
-*> CMODE is INTEGER
-*> Determines op2(C) in the formula op(A) * op2(C) as follows:
-*> CMODE = 1 op2(C) = C
-*> CMODE = 0 op2(C) = I
-*> CMODE = -1 op2(C) = inv(C)
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The vector C in the formula op(A) * op2(C).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Successful exit.
-*> i > 0: The ith argument is invalid.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N).
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N).
-*> Workspace.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE,
- $ C, INFO, WORK, IWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER N, LDA, LDAF, INFO, CMODE
-* ..
-* .. Array Arguments
- INTEGER IWORK( * ), IPIV( * )
- REAL A( LDA, * ), AF( LDAF, * ), WORK( * ), C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- CHARACTER NORMIN
- INTEGER KASE, I, J
- REAL AINVNM, SMLNUM, TMP
- LOGICAL UP
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL LSAME, ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATRS, SRSCL, XERBLA, SSYTRS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- SLA_SYRCOND = 0.0
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLA_SYRCOND', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 ) THEN
- SLA_SYRCOND = 1.0
- RETURN
- END IF
- UP = .FALSE.
- IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
-*
-* Compute the equilibration matrix R such that
-* inv(R)*A*C has unit 1-norm.
-*
- IF ( UP ) THEN
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( J, I ) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( I, J ) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ELSE
- DO I = 1, N
- TMP = 0.0
- IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) * C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) * C( J ) )
- END DO
- ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, I
- TMP = TMP + ABS( A( I, J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I ) )
- END DO
- ELSE
- DO J = 1, I
- TMP = TMP + ABS( A( I, J) / C( J ) )
- END DO
- DO J = I+1, N
- TMP = TMP + ABS( A( J, I) / C( J ) )
- END DO
- END IF
- WORK( 2*N+I ) = TMP
- END DO
- ENDIF
-*
-* Estimate the norm of inv(op(A)).
-*
- SMLNUM = SLAMCH( 'Safe minimum' )
- AINVNM = 0.0
- NORMIN = 'N'
-
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.2 ) THEN
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
-
- IF ( UP ) THEN
- CALL SSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ELSE
- CALL SSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ENDIF
-*
-* Multiply by inv(C).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
- ELSE
-*
-* Multiply by inv(C**T).
-*
- IF ( CMODE .EQ. 1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) / C( I )
- END DO
- ELSE IF ( CMODE .EQ. -1 ) THEN
- DO I = 1, N
- WORK( I ) = WORK( I ) * C( I )
- END DO
- END IF
-
- IF ( UP ) THEN
- CALL SSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ELSE
- CALL SSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO )
- ENDIF
-*
-* Multiply by R.
-*
- DO I = 1, N
- WORK( I ) = WORK( I ) * WORK( 2*N+I )
- END DO
- END IF
-*
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM .NE. 0.0 )
- $ SLA_SYRCOND = ( 1.0 / AINVNM )
-*
- RETURN
-*
- END
diff --git a/netlib/LAPACK/sla_syrpvgrw.f b/netlib/LAPACK/sla_syrpvgrw.f
deleted file mode 100644
index 21da411..0000000
--- a/netlib/LAPACK/sla_syrpvgrw.f
+++ /dev/null
@@ -1,320 +0,0 @@
-*> \brief \b SLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_SYRPVGRW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_syrpvgrw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_syrpvgrw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_syrpvgrw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER*1 UPLO
-* INTEGER N, INFO, LDA, LDAF
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*>
-*> SLA_SYRPVGRW computes the reciprocal pivot growth factor
-*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
-*> much less than 1, the stability of the LU factorization of the
-*> (equilibrated) matrix A could be poor. This also means that the
-*> solution X, estimated condition numbers, and error bounds could be
-*> unreliable.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> The value of INFO returned from SSYTRF, .i.e., the pivot in
-*> column INFO is exactly 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- REAL FUNCTION SLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV,
- $ WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER*1 UPLO
- INTEGER N, INFO, LDA, LDAF
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), AF( LDAF, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER NCOLS, I, J, K, KP
- REAL AMAX, UMAX, RPVGRW, TMP
- LOGICAL UPPER
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- EXTERNAL LSAME, SLASET
- LOGICAL LSAME
-* ..
-* .. Executable Statements ..
-*
- UPPER = LSAME( 'Upper', UPLO )
- IF ( INFO.EQ.0 ) THEN
- IF ( UPPER ) THEN
- NCOLS = 1
- ELSE
- NCOLS = N
- END IF
- ELSE
- NCOLS = INFO
- END IF
-
- RPVGRW = 1.0
- DO I = 1, 2*N
- WORK( I ) = 0.0
- END DO
-*
-* Find the max magnitude entry of each column of A. Compute the max
-* for all N columns so we can apply the pivot permutation while
-* looping below. Assume a full factorization is the common case.
-*
- IF ( UPPER ) THEN
- DO J = 1, N
- DO I = 1, J
- WORK( N+I ) = MAX( ABS( A( I, J ) ), WORK( N+I ) )
- WORK( N+J ) = MAX( ABS( A( I, J ) ), WORK( N+J ) )
- END DO
- END DO
- ELSE
- DO J = 1, N
- DO I = J, N
- WORK( N+I ) = MAX( ABS( A( I, J ) ), WORK( N+I ) )
- WORK( N+J ) = MAX( ABS( A( I, J ) ), WORK( N+J ) )
- END DO
- END DO
- END IF
-*
-* Now find the max magnitude entry of each column of U or L. Also
-* permute the magnitudes of A above so they're in the same order as
-* the factor.
-*
-* The iteration orders and permutations were copied from ssytrs.
-* Calls to SSWAP would be severe overkill.
-*
- IF ( UPPER ) THEN
- K = N
- DO WHILE ( K .LT. NCOLS .AND. K.GT.0 )
- IF ( IPIV( K ).GT.0 ) THEN
-! 1x1 pivot
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- DO I = 1, K
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- END DO
- K = K - 1
- ELSE
-! 2x2 pivot
- KP = -IPIV( K )
- TMP = WORK( N+K-1 )
- WORK( N+K-1 ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- DO I = 1, K-1
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- WORK( K-1 ) = MAX( ABS( AF( I, K-1 ) ), WORK( K-1 ) )
- END DO
- WORK( K ) = MAX( ABS( AF( K, K ) ), WORK( K ) )
- K = K - 2
- END IF
- END DO
- K = NCOLS
- DO WHILE ( K .LE. N )
- IF ( IPIV( K ).GT.0 ) THEN
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- K = K + 1
- ELSE
- KP = -IPIV( K )
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- K = K + 2
- END IF
- END DO
- ELSE
- K = 1
- DO WHILE ( K .LE. NCOLS )
- IF ( IPIV( K ).GT.0 ) THEN
-! 1x1 pivot
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- DO I = K, N
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- END DO
- K = K + 1
- ELSE
-! 2x2 pivot
- KP = -IPIV( K )
- TMP = WORK( N+K+1 )
- WORK( N+K+1 ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- DO I = K+1, N
- WORK( K ) = MAX( ABS( AF( I, K ) ), WORK( K ) )
- WORK( K+1 ) = MAX( ABS( AF(I, K+1 ) ), WORK( K+1 ) )
- END DO
- WORK( K ) = MAX( ABS( AF( K, K ) ), WORK( K ) )
- K = K + 2
- END IF
- END DO
- K = NCOLS
- DO WHILE ( K .GE. 1 )
- IF ( IPIV( K ).GT.0 ) THEN
- KP = IPIV( K )
- IF ( KP .NE. K ) THEN
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- END IF
- K = K - 1
- ELSE
- KP = -IPIV( K )
- TMP = WORK( N+K )
- WORK( N+K ) = WORK( N+KP )
- WORK( N+KP ) = TMP
- K = K - 2
- ENDIF
- END DO
- END IF
-*
-* Compute the *inverse* of the max element growth factor. Dividing
-* by zero would imply the largest entry of the factor's column is
-* zero. Than can happen when either the column of A is zero or
-* massive pivots made the factor underflow to zero. Neither counts
-* as growth in itself, so simply ignore terms with zero
-* denominators.
-*
- IF ( UPPER ) THEN
- DO I = NCOLS, N
- UMAX = WORK( I )
- AMAX = WORK( N+I )
- IF ( UMAX /= 0.0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- ELSE
- DO I = 1, NCOLS
- UMAX = WORK( I )
- AMAX = WORK( N+I )
- IF ( UMAX /= 0.0 ) THEN
- RPVGRW = MIN( AMAX / UMAX, RPVGRW )
- END IF
- END DO
- END IF
-
- SLA_SYRPVGRW = RPVGRW
- END
diff --git a/netlib/LAPACK/sla_wwaddw.f b/netlib/LAPACK/sla_wwaddw.f
deleted file mode 100644
index 081beb4..0000000
--- a/netlib/LAPACK/sla_wwaddw.f
+++ /dev/null
@@ -1,111 +0,0 @@
-*> \brief \b SLA_WWADDW adds a vector into a doubled-single vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLA_WWADDW + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_wwaddw.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_wwaddw.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_wwaddw.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLA_WWADDW( N, X, Y, W )
-*
-* .. Scalar Arguments ..
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* REAL X( * ), Y( * ), W( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLA_WWADDW adds a vector W into a doubled-single vector (X, Y).
-*>
-*> This works for all extant IBM's hex and binary floating point
-*> arithmetics, but not for decimal.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of vectors X, Y, and W.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> The first part of the doubled-single accumulation vector.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array, dimension (N)
-*> The second part of the doubled-single accumulation vector.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The vector to be added.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLA_WWADDW( N, X, Y, W )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N
-* ..
-* .. Array Arguments ..
- REAL X( * ), Y( * ), W( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL S
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
- DO 10 I = 1, N
- S = X(I) + W(I)
- S = (S + S) - S
- Y(I) = ((X(I) - S) + W(I)) + Y(I)
- X(I) = S
- 10 CONTINUE
- RETURN
- END
diff --git a/netlib/LAPACK/slabad.f b/netlib/LAPACK/slabad.f
deleted file mode 100644
index 5bf6530..0000000
--- a/netlib/LAPACK/slabad.f
+++ /dev/null
@@ -1,105 +0,0 @@
-*> \brief \b SLABAD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLABAD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slabad.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slabad.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slabad.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLABAD( SMALL, LARGE )
-*
-* .. Scalar Arguments ..
-* REAL LARGE, SMALL
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLABAD takes as input the values computed by SLAMCH for underflow and
-*> overflow, and returns the square root of each of these values if the
-*> log of LARGE is sufficiently large. This subroutine is intended to
-*> identify machines with a large exponent range, such as the Crays, and
-*> redefine the underflow and overflow limits to be the square roots of
-*> the values computed by SLAMCH. This subroutine is needed because
-*> SLAMCH does not compensate for poor arithmetic in the upper half of
-*> the exponent range, as is found on a Cray.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] SMALL
-*> \verbatim
-*> SMALL is REAL
-*> On entry, the underflow threshold as computed by SLAMCH.
-*> On exit, if LOG10(LARGE) is sufficiently large, the square
-*> root of SMALL, otherwise unchanged.
-*> \endverbatim
-*>
-*> \param[in,out] LARGE
-*> \verbatim
-*> LARGE is REAL
-*> On entry, the overflow threshold as computed by SLAMCH.
-*> On exit, if LOG10(LARGE) is sufficiently large, the square
-*> root of LARGE, otherwise unchanged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLABAD( SMALL, LARGE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL LARGE, SMALL
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC LOG10, SQRT
-* ..
-* .. Executable Statements ..
-*
-* If it looks like we're on a Cray, take the square root of
-* SMALL and LARGE to avoid overflow and underflow problems.
-*
- IF( LOG10( LARGE ).GT.2000. ) THEN
- SMALL = SQRT( SMALL )
- LARGE = SQRT( LARGE )
- END IF
-*
- RETURN
-*
-* End of SLABAD
-*
- END
diff --git a/netlib/LAPACK/slabrd.f b/netlib/LAPACK/slabrd.f
deleted file mode 100644
index 5006eac..0000000
--- a/netlib/LAPACK/slabrd.f
+++ /dev/null
@@ -1,381 +0,0 @@
-*> \brief \b SLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLABRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slabrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slabrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slabrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
-* LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDX, LDY, M, N, NB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLABRD reduces the first NB rows and columns of a real general
-*> m by n matrix A to upper or lower bidiagonal form by an orthogonal
-*> transformation Q**T * A * P, and returns the matrices X and Y which
-*> are needed to apply the transformation to the unreduced part of A.
-*>
-*> If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
-*> bidiagonal form.
-*>
-*> This is an auxiliary routine called by SGEBRD
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of leading rows and columns of A to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n general matrix to be reduced.
-*> On exit, the first NB rows and columns of the matrix are
-*> overwritten; the rest of the array is unchanged.
-*> If m >= n, elements on and below the diagonal in the first NB
-*> columns, with the array TAUQ, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; and
-*> elements above the diagonal in the first NB rows, with the
-*> array TAUP, represent the orthogonal matrix P as a product
-*> of elementary reflectors.
-*> If m < n, elements below the diagonal in the first NB
-*> columns, with the array TAUQ, represent the orthogonal
-*> matrix Q as a product of elementary reflectors, and
-*> elements on and above the diagonal in the first NB rows,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (NB)
-*> The diagonal elements of the first NB rows and columns of
-*> the reduced matrix. D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (NB)
-*> The off-diagonal elements of the first NB rows and columns of
-*> the reduced matrix.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is REAL array dimension (NB)
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is REAL array, dimension (NB)
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NB)
-*> The m-by-nb matrix X required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is REAL array, dimension (LDY,NB)
-*> The n-by-nb matrix Y required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors.
-*>
-*> If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
-*> A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
-*> A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
-*> A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
-*> A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The elements of the vectors v and u together form the m-by-nb matrix
-*> V and the nb-by-n matrix U**T which are needed, with X and Y, to apply
-*> the transformation to the unreduced part of the matrix, using a block
-*> update of the form: A := A - V*Y**T - X*U**T.
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with nb = 2:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
-*> ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
-*> ( v1 v2 a a a ) ( v1 1 a a a a )
-*> ( v1 v2 a a a ) ( v1 v2 a a a a )
-*> ( v1 v2 a a a ) ( v1 v2 a a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix which is unchanged,
-*> vi denotes an element of the vector defining H(i), and ui an element
-*> of the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
- $ LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDX, LDY, M, N, NB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SLARFG, SSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
- IF( M.GE.N ) THEN
-*
-* Reduce to upper bidiagonal form
-*
- DO 10 I = 1, NB
-*
-* Update A(i:m,i)
-*
- CALL SGEMV( 'No transpose', M-I+1, I-1, -ONE, A( I, 1 ),
- $ LDA, Y( I, 1 ), LDY, ONE, A( I, I ), 1 )
- CALL SGEMV( 'No transpose', M-I+1, I-1, -ONE, X( I, 1 ),
- $ LDX, A( 1, I ), 1, ONE, A( I, I ), 1 )
-*
-* Generate reflection Q(i) to annihilate A(i+1:m,i)
-*
- CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAUQ( I ) )
- D( I ) = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = ONE
-*
-* Compute Y(i+1:n,i)
-*
- CALL SGEMV( 'Transpose', M-I+1, N-I, ONE, A( I, I+1 ),
- $ LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), LDA,
- $ A( I, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL SGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
- $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), LDX,
- $ A( I, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL SGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
- $ LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL SSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-*
-* Update A(i,i+1:n)
-*
- CALL SGEMV( 'No transpose', N-I, I, -ONE, Y( I+1, 1 ),
- $ LDY, A( I, 1 ), LDA, ONE, A( I, I+1 ), LDA )
- CALL SGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
- $ LDA, X( I, 1 ), LDX, ONE, A( I, I+1 ), LDA )
-*
-* Generate reflection P(i) to annihilate A(i,i+2:n)
-*
- CALL SLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
- $ LDA, TAUP( I ) )
- E( I ) = A( I, I+1 )
- A( I, I+1 ) = ONE
-*
-* Compute X(i+1:m,i)
-*
- CALL SGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), LDY,
- $ A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
- CALL SGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ),
- $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
- CALL SGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
- $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL SSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Reduce to lower bidiagonal form
-*
- DO 20 I = 1, NB
-*
-* Update A(i,i:n)
-*
- CALL SGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ),
- $ LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA )
- CALL SGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), LDA,
- $ X( I, 1 ), LDX, ONE, A( I, I ), LDA )
-*
-* Generate reflection P(i) to annihilate A(i,i+1:n)
-*
- CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAUP( I ) )
- D( I ) = A( I, I )
- IF( I.LT.M ) THEN
- A( I, I ) = ONE
-*
-* Compute X(i+1:m,i)
-*
- CALL SGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ),
- $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), LDY,
- $ A( I, I ), LDA, ZERO, X( 1, I ), 1 )
- CALL SGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL SGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ),
- $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
- CALL SGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
- $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL SSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-*
-* Update A(i+1:m,i)
-*
- CALL SGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
- CALL SGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ),
- $ LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
-*
-* Generate reflection Q(i) to annihilate A(i+2:m,i)
-*
- CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
- $ TAUQ( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Compute Y(i+1:n,i)
-*
- CALL SGEMV( 'Transpose', M-I, N-I, ONE, A( I+1, I+1 ),
- $ LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL SGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
- $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), LDX,
- $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL SGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), LDA,
- $ Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL SSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of SLABRD
-*
- END
diff --git a/netlib/LAPACK/slacn2.f b/netlib/LAPACK/slacn2.f
deleted file mode 100644
index 73c993e..0000000
--- a/netlib/LAPACK/slacn2.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLACN2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slacn2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slacn2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slacn2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-* .. Scalar Arguments ..
-* INTEGER KASE, N
-* REAL EST
-* ..
-* .. Array Arguments ..
-* INTEGER ISGN( * ), ISAVE( 3 )
-* REAL V( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLACN2 estimates the 1-norm of a square, real matrix A.
-*> Reverse communication is used for evaluating matrix-vector products.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 1.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension (N)
-*> On the final return, V = A*W, where EST = norm(V)/norm(W)
-*> (W is not returned).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> On an intermediate return, X should be overwritten by
-*> A * X, if KASE=1,
-*> A**T * X, if KASE=2,
-*> and SLACN2 must be re-called with all the other parameters
-*> unchanged.
-*> \endverbatim
-*>
-*> \param[out] ISGN
-*> \verbatim
-*> ISGN is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] EST
-*> \verbatim
-*> EST is REAL
-*> On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
-*> unchanged from the previous call to SLACN2.
-*> On exit, EST is an estimate (a lower bound) for norm(A).
-*> \endverbatim
-*>
-*> \param[in,out] KASE
-*> \verbatim
-*> KASE is INTEGER
-*> On the initial call to SLACN2, KASE should be 0.
-*> On an intermediate return, KASE will be 1 or 2, indicating
-*> whether X should be overwritten by A * X or A**T * X.
-*> On the final return from SLACN2, KASE will again be 0.
-*> \endverbatim
-*>
-*> \param[in,out] ISAVE
-*> \verbatim
-*> ISAVE is INTEGER array, dimension (3)
-*> ISAVE is used to save variables between calls to SLACN2
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Originally named SONEST, dated March 16, 1988.
-*>
-*> This is a thread safe version of SLACON, which uses the array ISAVE
-*> in place of a SAVE statement, as follows:
-*>
-*> SLACON SLACN2
-*> JUMP ISAVE(1)
-*> J ISAVE(2)
-*> ITER ISAVE(3)
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham, University of Manchester
-*
-*> \par References:
-* ================
-*>
-*> N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*> a real or complex matrix, with applications to condition estimation",
-*> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*>
-* =====================================================================
- SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER KASE, N
- REAL EST
-* ..
-* .. Array Arguments ..
- INTEGER ISGN( * ), ISAVE( 3 )
- REAL V( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, JLAST
- REAL ALTSGN, ESTOLD, TEMP
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SASUM
- EXTERNAL ISAMAX, SASUM
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, NINT, REAL, SIGN
-* ..
-* .. Executable Statements ..
-*
- IF( KASE.EQ.0 ) THEN
- DO 10 I = 1, N
- X( I ) = ONE / REAL( N )
- 10 CONTINUE
- KASE = 1
- ISAVE( 1 ) = 1
- RETURN
- END IF
-*
- GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 )
-*
-* ................ ENTRY (ISAVE( 1 ) = 1)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
-*
- 20 CONTINUE
- IF( N.EQ.1 ) THEN
- V( 1 ) = X( 1 )
- EST = ABS( V( 1 ) )
-* ... QUIT
- GO TO 150
- END IF
- EST = SASUM( N, X, 1 )
-*
- DO 30 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 30 CONTINUE
- KASE = 2
- ISAVE( 1 ) = 2
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 2)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 40 CONTINUE
- ISAVE( 2 ) = ISAMAX( N, X, 1 )
- ISAVE( 3 ) = 2
-*
-* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
- 50 CONTINUE
- DO 60 I = 1, N
- X( I ) = ZERO
- 60 CONTINUE
- X( ISAVE( 2 ) ) = ONE
- KASE = 1
- ISAVE( 1 ) = 3
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 3)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 70 CONTINUE
- CALL SCOPY( N, X, 1, V, 1 )
- ESTOLD = EST
- EST = SASUM( N, V, 1 )
- DO 80 I = 1, N
- IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
- $ GO TO 90
- 80 CONTINUE
-* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- GO TO 120
-*
- 90 CONTINUE
-* TEST FOR CYCLING.
- IF( EST.LE.ESTOLD )
- $ GO TO 120
-*
- DO 100 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 100 CONTINUE
- KASE = 2
- ISAVE( 1 ) = 4
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 4)
-* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 110 CONTINUE
- JLAST = ISAVE( 2 )
- ISAVE( 2 ) = ISAMAX( N, X, 1 )
- IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
- $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN
- ISAVE( 3 ) = ISAVE( 3 ) + 1
- GO TO 50
- END IF
-*
-* ITERATION COMPLETE. FINAL STAGE.
-*
- 120 CONTINUE
- ALTSGN = ONE
- DO 130 I = 1, N
- X( I ) = ALTSGN*( ONE+REAL( I-1 ) / REAL( N-1 ) )
- ALTSGN = -ALTSGN
- 130 CONTINUE
- KASE = 1
- ISAVE( 1 ) = 5
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 5)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 140 CONTINUE
- TEMP = TWO*( SASUM( N, X, 1 ) / REAL( 3*N ) )
- IF( TEMP.GT.EST ) THEN
- CALL SCOPY( N, X, 1, V, 1 )
- EST = TEMP
- END IF
-*
- 150 CONTINUE
- KASE = 0
- RETURN
-*
-* End of SLACN2
-*
- END
diff --git a/netlib/LAPACK/slacon.f b/netlib/LAPACK/slacon.f
deleted file mode 100644
index 0493e06..0000000
--- a/netlib/LAPACK/slacon.f
+++ /dev/null
@@ -1,275 +0,0 @@
-*> \brief \b SLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLACON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slacon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slacon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slacon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLACON( N, V, X, ISGN, EST, KASE )
-*
-* .. Scalar Arguments ..
-* INTEGER KASE, N
-* REAL EST
-* ..
-* .. Array Arguments ..
-* INTEGER ISGN( * )
-* REAL V( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLACON estimates the 1-norm of a square, real matrix A.
-*> Reverse communication is used for evaluating matrix-vector products.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 1.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension (N)
-*> On the final return, V = A*W, where EST = norm(V)/norm(W)
-*> (W is not returned).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> On an intermediate return, X should be overwritten by
-*> A * X, if KASE=1,
-*> A**T * X, if KASE=2,
-*> and SLACON must be re-called with all the other parameters
-*> unchanged.
-*> \endverbatim
-*>
-*> \param[out] ISGN
-*> \verbatim
-*> ISGN is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] EST
-*> \verbatim
-*> EST is REAL
-*> On entry with KASE = 1 or 2 and JUMP = 3, EST should be
-*> unchanged from the previous call to SLACON.
-*> On exit, EST is an estimate (a lower bound) for norm(A).
-*> \endverbatim
-*>
-*> \param[in,out] KASE
-*> \verbatim
-*> KASE is INTEGER
-*> On the initial call to SLACON, KASE should be 0.
-*> On an intermediate return, KASE will be 1 or 2, indicating
-*> whether X should be overwritten by A * X or A**T * X.
-*> On the final return from SLACON, KASE will again be 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham, University of Manchester. \n
-*> Originally named SONEST, dated March 16, 1988.
-*
-*> \par References:
-* ================
-*>
-*> N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*> a real or complex matrix, with applications to condition estimation",
-*> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*>
-* =====================================================================
- SUBROUTINE SLACON( N, V, X, ISGN, EST, KASE )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER KASE, N
- REAL EST
-* ..
-* .. Array Arguments ..
- INTEGER ISGN( * )
- REAL V( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ITER, J, JLAST, JUMP
- REAL ALTSGN, ESTOLD, TEMP
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SASUM
- EXTERNAL ISAMAX, SASUM
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, NINT, REAL, SIGN
-* ..
-* .. Save statement ..
- SAVE
-* ..
-* .. Executable Statements ..
-*
- IF( KASE.EQ.0 ) THEN
- DO 10 I = 1, N
- X( I ) = ONE / REAL( N )
- 10 CONTINUE
- KASE = 1
- JUMP = 1
- RETURN
- END IF
-*
- GO TO ( 20, 40, 70, 110, 140 )JUMP
-*
-* ................ ENTRY (JUMP = 1)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
-*
- 20 CONTINUE
- IF( N.EQ.1 ) THEN
- V( 1 ) = X( 1 )
- EST = ABS( V( 1 ) )
-* ... QUIT
- GO TO 150
- END IF
- EST = SASUM( N, X, 1 )
-*
- DO 30 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 30 CONTINUE
- KASE = 2
- JUMP = 2
- RETURN
-*
-* ................ ENTRY (JUMP = 2)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 40 CONTINUE
- J = ISAMAX( N, X, 1 )
- ITER = 2
-*
-* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
- 50 CONTINUE
- DO 60 I = 1, N
- X( I ) = ZERO
- 60 CONTINUE
- X( J ) = ONE
- KASE = 1
- JUMP = 3
- RETURN
-*
-* ................ ENTRY (JUMP = 3)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 70 CONTINUE
- CALL SCOPY( N, X, 1, V, 1 )
- ESTOLD = EST
- EST = SASUM( N, V, 1 )
- DO 80 I = 1, N
- IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
- $ GO TO 90
- 80 CONTINUE
-* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- GO TO 120
-*
- 90 CONTINUE
-* TEST FOR CYCLING.
- IF( EST.LE.ESTOLD )
- $ GO TO 120
-*
- DO 100 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 100 CONTINUE
- KASE = 2
- JUMP = 4
- RETURN
-*
-* ................ ENTRY (JUMP = 4)
-* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 110 CONTINUE
- JLAST = J
- J = ISAMAX( N, X, 1 )
- IF( ( X( JLAST ).NE.ABS( X( J ) ) ) .AND. ( ITER.LT.ITMAX ) ) THEN
- ITER = ITER + 1
- GO TO 50
- END IF
-*
-* ITERATION COMPLETE. FINAL STAGE.
-*
- 120 CONTINUE
- ALTSGN = ONE
- DO 130 I = 1, N
- X( I ) = ALTSGN*( ONE+REAL( I-1 ) / REAL( N-1 ) )
- ALTSGN = -ALTSGN
- 130 CONTINUE
- KASE = 1
- JUMP = 5
- RETURN
-*
-* ................ ENTRY (JUMP = 5)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 140 CONTINUE
- TEMP = TWO*( SASUM( N, X, 1 ) / REAL( 3*N ) )
- IF( TEMP.GT.EST ) THEN
- CALL SCOPY( N, X, 1, V, 1 )
- EST = TEMP
- END IF
-*
- 150 CONTINUE
- KASE = 0
- RETURN
-*
-* End of SLACON
-*
- END
diff --git a/netlib/LAPACK/slacpy.f b/netlib/LAPACK/slacpy.f
deleted file mode 100644
index fa19989..0000000
--- a/netlib/LAPACK/slacpy.f
+++ /dev/null
@@ -1,156 +0,0 @@
-*> \brief \b SLACPY copies all or part of one two-dimensional array to another.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLACPY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slacpy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slacpy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slacpy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, LDB, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLACPY copies all or part of a two-dimensional matrix A to another
-*> matrix B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies the part of the matrix A to be copied to B.
-*> = 'U': Upper triangular part
-*> = 'L': Lower triangular part
-*> Otherwise: All of the matrix A
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The m by n matrix A. If UPLO = 'U', only the upper triangle
-*> or trapezoid is accessed; if UPLO = 'L', only the lower
-*> triangle or trapezoid is accessed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On exit, B = A in the locations specified by UPLO.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, LDB, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, MIN( J, M )
- B( I, J ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
- DO 40 J = 1, N
- DO 30 I = J, M
- B( I, J ) = A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 J = 1, N
- DO 50 I = 1, M
- B( I, J ) = A( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- RETURN
-*
-* End of SLACPY
-*
- END
diff --git a/netlib/LAPACK/sladiv.f b/netlib/LAPACK/sladiv.f
deleted file mode 100644
index eace5c7..0000000
--- a/netlib/LAPACK/sladiv.f
+++ /dev/null
@@ -1,128 +0,0 @@
-*> \brief \b SLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLADIV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sladiv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sladiv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sladiv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLADIV( A, B, C, D, P, Q )
-*
-* .. Scalar Arguments ..
-* REAL A, B, C, D, P, Q
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLADIV performs complex division in real arithmetic
-*>
-*> a + i*b
-*> p + i*q = ---------
-*> c + i*d
-*>
-*> The algorithm is due to Robert L. Smith and can be found
-*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is REAL
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL
-*> The scalars a, b, c, and d in the above expression.
-*> \endverbatim
-*>
-*> \param[out] P
-*> \verbatim
-*> P is REAL
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL
-*> The scalars p and q in the above expression.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLADIV( A, B, C, D, P, Q )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL A, B, C, D, P, Q
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL E, F
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( ABS( D ).LT.ABS( C ) ) THEN
- E = D / C
- F = C + D*E
- P = ( A+B*E ) / F
- Q = ( B-A*E ) / F
- ELSE
- E = C / D
- F = D + C*E
- P = ( B+A*E ) / F
- Q = ( -A+B*E ) / F
- END IF
-*
- RETURN
-*
-* End of SLADIV
-*
- END
diff --git a/netlib/LAPACK/slae2.f b/netlib/LAPACK/slae2.f
deleted file mode 100644
index 313436c..0000000
--- a/netlib/LAPACK/slae2.f
+++ /dev/null
@@ -1,185 +0,0 @@
-*> \brief \b SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAE2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slae2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slae2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slae2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAE2( A, B, C, RT1, RT2 )
-*
-* .. Scalar Arguments ..
-* REAL A, B, C, RT1, RT2
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
-*> [ A B ]
-*> [ B C ].
-*> On return, RT1 is the eigenvalue of larger absolute value, and RT2
-*> is the eigenvalue of smaller absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is REAL
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL
-*> The (1,2) and (2,1) elements of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] RT1
-*> \verbatim
-*> RT1 is REAL
-*> The eigenvalue of larger absolute value.
-*> \endverbatim
-*>
-*> \param[out] RT2
-*> \verbatim
-*> RT2 is REAL
-*> The eigenvalue of smaller absolute value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> RT1 is accurate to a few ulps barring over/underflow.
-*>
-*> RT2 may be inaccurate if there is massive cancellation in the
-*> determinant A*C-B*B; higher precision or correctly rounded or
-*> correctly truncated arithmetic would be needed to compute RT2
-*> accurately in all cases.
-*>
-*> Overflow is possible only if RT1 is within a factor of 5 of overflow.
-*> Underflow is harmless if the input data is 0 or exceeds
-*> underflow_threshold / macheps.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLAE2( A, B, C, RT1, RT2 )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL A, B, C, RT1, RT2
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL HALF
- PARAMETER ( HALF = 0.5E0 )
-* ..
-* .. Local Scalars ..
- REAL AB, ACMN, ACMX, ADF, DF, RT, SM, TB
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Compute the eigenvalues
-*
- SM = A + C
- DF = A - C
- ADF = ABS( DF )
- TB = B + B
- AB = ABS( TB )
- IF( ABS( A ).GT.ABS( C ) ) THEN
- ACMX = A
- ACMN = C
- ELSE
- ACMX = C
- ACMN = A
- END IF
- IF( ADF.GT.AB ) THEN
- RT = ADF*SQRT( ONE+( AB / ADF )**2 )
- ELSE IF( ADF.LT.AB ) THEN
- RT = AB*SQRT( ONE+( ADF / AB )**2 )
- ELSE
-*
-* Includes case AB=ADF=0
-*
- RT = AB*SQRT( TWO )
- END IF
- IF( SM.LT.ZERO ) THEN
- RT1 = HALF*( SM-RT )
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE IF( SM.GT.ZERO ) THEN
- RT1 = HALF*( SM+RT )
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE
-*
-* Includes case RT1 = RT2 = 0
-*
- RT1 = HALF*RT
- RT2 = -HALF*RT
- END IF
- RETURN
-*
-* End of SLAE2
-*
- END
diff --git a/netlib/LAPACK/slaebz.f b/netlib/LAPACK/slaebz.f
deleted file mode 100644
index 5706487..0000000
--- a/netlib/LAPACK/slaebz.f
+++ /dev/null
@@ -1,649 +0,0 @@
-*> \brief \b SLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAEBZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaebz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaebz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaebz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAEBZ( IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL,
-* RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT,
-* NAB, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IJOB, INFO, MINP, MMAX, MOUT, N, NBMIN, NITMAX
-* REAL ABSTOL, PIVMIN, RELTOL
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * ), NAB( MMAX, * ), NVAL( * )
-* REAL AB( MMAX, * ), C( * ), D( * ), E( * ), E2( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAEBZ contains the iteration loops which compute and use the
-*> function N(w), which is the count of eigenvalues of a symmetric
-*> tridiagonal matrix T less than or equal to its argument w. It
-*> performs a choice of two types of loops:
-*>
-*> IJOB=1, followed by
-*> IJOB=2: It takes as input a list of intervals and returns a list of
-*> sufficiently small intervals whose union contains the same
-*> eigenvalues as the union of the original intervals.
-*> The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
-*> The output interval (AB(j,1),AB(j,2)] will contain
-*> eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
-*>
-*> IJOB=3: It performs a binary search in each input interval
-*> (AB(j,1),AB(j,2)] for a point w(j) such that
-*> N(w(j))=NVAL(j), and uses C(j) as the starting point of
-*> the search. If such a w(j) is found, then on output
-*> AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
-*> (AB(j,1),AB(j,2)] will be a small interval containing the
-*> point where N(w) jumps through NVAL(j), unless that point
-*> lies outside the initial interval.
-*>
-*> Note that the intervals are in all cases half-open intervals,
-*> i.e., of the form (a,b] , which includes b but not a .
-*>
-*> To avoid underflow, the matrix should be scaled so that its largest
-*> element is no greater than overflow**(1/2) * underflow**(1/4)
-*> in absolute value. To assure the most accurate computation
-*> of small eigenvalues, the matrix should be scaled to be
-*> not much smaller than that, either.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966
-*>
-*> Note: the arguments are, in general, *not* checked for unreasonable
-*> values.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies what is to be done:
-*> = 1: Compute NAB for the initial intervals.
-*> = 2: Perform bisection iteration to find eigenvalues of T.
-*> = 3: Perform bisection iteration to invert N(w), i.e.,
-*> to find a point which has a specified number of
-*> eigenvalues of T to its left.
-*> Other values will cause SLAEBZ to return with INFO=-1.
-*> \endverbatim
-*>
-*> \param[in] NITMAX
-*> \verbatim
-*> NITMAX is INTEGER
-*> The maximum number of "levels" of bisection to be
-*> performed, i.e., an interval of width W will not be made
-*> smaller than 2^(-NITMAX) * W. If not all intervals
-*> have converged after NITMAX iterations, then INFO is set
-*> to the number of non-converged intervals.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension n of the tridiagonal matrix T. It must be at
-*> least 1.
-*> \endverbatim
-*>
-*> \param[in] MMAX
-*> \verbatim
-*> MMAX is INTEGER
-*> The maximum number of intervals. If more than MMAX intervals
-*> are generated, then SLAEBZ will quit with INFO=MMAX+1.
-*> \endverbatim
-*>
-*> \param[in] MINP
-*> \verbatim
-*> MINP is INTEGER
-*> The initial number of intervals. It may not be greater than
-*> MMAX.
-*> \endverbatim
-*>
-*> \param[in] NBMIN
-*> \verbatim
-*> NBMIN is INTEGER
-*> The smallest number of intervals that should be processed
-*> using a vector loop. If zero, then only the scalar loop
-*> will be used.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The minimum (absolute) width of an interval. When an
-*> interval is narrower than ABSTOL, or than RELTOL times the
-*> larger (in magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. This must be at least
-*> zero.
-*> \endverbatim
-*>
-*> \param[in] RELTOL
-*> \verbatim
-*> RELTOL is REAL
-*> The minimum relative width of an interval. When an interval
-*> is narrower than ABSTOL, or than RELTOL times the larger (in
-*> magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. Note: this should
-*> always be at least radix*machine epsilon.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum absolute value of a "pivot" in the Sturm
-*> sequence loop.
-*> This must be at least max |e(j)**2|*safe_min and at
-*> least safe_min, where safe_min is at least
-*> the smallest number that can divide one without overflow.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> The offdiagonal elements of the tridiagonal matrix T in
-*> positions 1 through N-1. E(N) is arbitrary.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is REAL array, dimension (N)
-*> The squares of the offdiagonal elements of the tridiagonal
-*> matrix T. E2(N) is ignored.
-*> \endverbatim
-*>
-*> \param[in,out] NVAL
-*> \verbatim
-*> NVAL is INTEGER array, dimension (MINP)
-*> If IJOB=1 or 2, not referenced.
-*> If IJOB=3, the desired values of N(w). The elements of NVAL
-*> will be reordered to correspond with the intervals in AB.
-*> Thus, NVAL(j) on output will not, in general be the same as
-*> NVAL(j) on input, but it will correspond with the interval
-*> (AB(j,1),AB(j,2)] on output.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (MMAX,2)
-*> The endpoints of the intervals. AB(j,1) is a(j), the left
-*> endpoint of the j-th interval, and AB(j,2) is b(j), the
-*> right endpoint of the j-th interval. The input intervals
-*> will, in general, be modified, split, and reordered by the
-*> calculation.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (MMAX)
-*> If IJOB=1, ignored.
-*> If IJOB=2, workspace.
-*> If IJOB=3, then on input C(j) should be initialized to the
-*> first search point in the binary search.
-*> \endverbatim
-*>
-*> \param[out] MOUT
-*> \verbatim
-*> MOUT is INTEGER
-*> If IJOB=1, the number of eigenvalues in the intervals.
-*> If IJOB=2 or 3, the number of intervals output.
-*> If IJOB=3, MOUT will equal MINP.
-*> \endverbatim
-*>
-*> \param[in,out] NAB
-*> \verbatim
-*> NAB is INTEGER array, dimension (MMAX,2)
-*> If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)).
-*> If IJOB=2, then on input, NAB(i,j) should be set. It must
-*> satisfy the condition:
-*> N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)),
-*> which means that in interval i only eigenvalues
-*> NAB(i,1)+1,...,NAB(i,2) will be considered. Usually,
-*> NAB(i,j)=N(AB(i,j)), from a previous call to SLAEBZ with
-*> IJOB=1.
-*> On output, NAB(i,j) will contain
-*> max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of
-*> the input interval that the output interval
-*> (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the
-*> the input values of NAB(k,1) and NAB(k,2).
-*> If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)),
-*> unless N(w) > NVAL(i) for all search points w , in which
-*> case NAB(i,1) will not be modified, i.e., the output
-*> value will be the same as the input value (modulo
-*> reorderings -- see NVAL and AB), or unless N(w) < NVAL(i)
-*> for all search points w , in which case NAB(i,2) will
-*> not be modified. Normally, NAB should be set to some
-*> distinctive value(s) before SLAEBZ is called.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MMAX)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MMAX)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: All intervals converged.
-*> = 1--MMAX: The last INFO intervals did not converge.
-*> = MMAX+1: More than MMAX intervals were generated.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine is intended to be called only by other LAPACK
-*> routines, thus the interface is less user-friendly. It is intended
-*> for two purposes:
-*>
-*> (a) finding eigenvalues. In this case, SLAEBZ should have one or
-*> more initial intervals set up in AB, and SLAEBZ should be called
-*> with IJOB=1. This sets up NAB, and also counts the eigenvalues.
-*> Intervals with no eigenvalues would usually be thrown out at
-*> this point. Also, if not all the eigenvalues in an interval i
-*> are desired, NAB(i,1) can be increased or NAB(i,2) decreased.
-*> For example, set NAB(i,1)=NAB(i,2)-1 to get the largest
-*> eigenvalue. SLAEBZ is then called with IJOB=2 and MMAX
-*> no smaller than the value of MOUT returned by the call with
-*> IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1
-*> through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the
-*> tolerance specified by ABSTOL and RELTOL.
-*>
-*> (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l).
-*> In this case, start with a Gershgorin interval (a,b). Set up
-*> AB to contain 2 search intervals, both initially (a,b). One
-*> NVAL element should contain f-1 and the other should contain l
-*> , while C should contain a and b, resp. NAB(i,1) should be -1
-*> and NAB(i,2) should be N+1, to flag an error if the desired
-*> interval does not lie in (a,b). SLAEBZ is then called with
-*> IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals --
-*> j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while
-*> if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r
-*> >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and
-*> N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and
-*> w(l-r)=...=w(l+k) are handled similarly.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLAEBZ( IJOB, NITMAX, N, MMAX, MINP, NBMIN, ABSTOL,
- $ RELTOL, PIVMIN, D, E, E2, NVAL, AB, C, MOUT,
- $ NAB, WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IJOB, INFO, MINP, MMAX, MOUT, N, NBMIN, NITMAX
- REAL ABSTOL, PIVMIN, RELTOL
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * ), NAB( MMAX, * ), NVAL( * )
- REAL AB( MMAX, * ), C( * ), D( * ), E( * ), E2( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, TWO, HALF
- PARAMETER ( ZERO = 0.0E0, TWO = 2.0E0,
- $ HALF = 1.0E0 / TWO )
-* ..
-* .. Local Scalars ..
- INTEGER ITMP1, ITMP2, J, JI, JIT, JP, KF, KFNEW, KL,
- $ KLNEW
- REAL TMP1, TMP2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Check for Errors
-*
- INFO = 0
- IF( IJOB.LT.1 .OR. IJOB.GT.3 ) THEN
- INFO = -1
- RETURN
- END IF
-*
-* Initialize NAB
-*
- IF( IJOB.EQ.1 ) THEN
-*
-* Compute the number of eigenvalues in the initial intervals.
-*
- MOUT = 0
- DO 30 JI = 1, MINP
- DO 20 JP = 1, 2
- TMP1 = D( 1 ) - AB( JI, JP )
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- NAB( JI, JP ) = 0
- IF( TMP1.LE.ZERO )
- $ NAB( JI, JP ) = 1
-*
- DO 10 J = 2, N
- TMP1 = D( J ) - E2( J-1 ) / TMP1 - AB( JI, JP )
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- IF( TMP1.LE.ZERO )
- $ NAB( JI, JP ) = NAB( JI, JP ) + 1
- 10 CONTINUE
- 20 CONTINUE
- MOUT = MOUT + NAB( JI, 2 ) - NAB( JI, 1 )
- 30 CONTINUE
- RETURN
- END IF
-*
-* Initialize for loop
-*
-* KF and KL have the following meaning:
-* Intervals 1,...,KF-1 have converged.
-* Intervals KF,...,KL still need to be refined.
-*
- KF = 1
- KL = MINP
-*
-* If IJOB=2, initialize C.
-* If IJOB=3, use the user-supplied starting point.
-*
- IF( IJOB.EQ.2 ) THEN
- DO 40 JI = 1, MINP
- C( JI ) = HALF*( AB( JI, 1 )+AB( JI, 2 ) )
- 40 CONTINUE
- END IF
-*
-* Iteration loop
-*
- DO 130 JIT = 1, NITMAX
-*
-* Loop over intervals
-*
- IF( KL-KF+1.GE.NBMIN .AND. NBMIN.GT.0 ) THEN
-*
-* Begin of Parallel Version of the loop
-*
- DO 60 JI = KF, KL
-*
-* Compute N(c), the number of eigenvalues less than c
-*
- WORK( JI ) = D( 1 ) - C( JI )
- IWORK( JI ) = 0
- IF( WORK( JI ).LE.PIVMIN ) THEN
- IWORK( JI ) = 1
- WORK( JI ) = MIN( WORK( JI ), -PIVMIN )
- END IF
-*
- DO 50 J = 2, N
- WORK( JI ) = D( J ) - E2( J-1 ) / WORK( JI ) - C( JI )
- IF( WORK( JI ).LE.PIVMIN ) THEN
- IWORK( JI ) = IWORK( JI ) + 1
- WORK( JI ) = MIN( WORK( JI ), -PIVMIN )
- END IF
- 50 CONTINUE
- 60 CONTINUE
-*
- IF( IJOB.LE.2 ) THEN
-*
-* IJOB=2: Choose all intervals containing eigenvalues.
-*
- KLNEW = KL
- DO 70 JI = KF, KL
-*
-* Insure that N(w) is monotone
-*
- IWORK( JI ) = MIN( NAB( JI, 2 ),
- $ MAX( NAB( JI, 1 ), IWORK( JI ) ) )
-*
-* Update the Queue -- add intervals if both halves
-* contain eigenvalues.
-*
- IF( IWORK( JI ).EQ.NAB( JI, 2 ) ) THEN
-*
-* No eigenvalue in the upper interval:
-* just use the lower interval.
-*
- AB( JI, 2 ) = C( JI )
-*
- ELSE IF( IWORK( JI ).EQ.NAB( JI, 1 ) ) THEN
-*
-* No eigenvalue in the lower interval:
-* just use the upper interval.
-*
- AB( JI, 1 ) = C( JI )
- ELSE
- KLNEW = KLNEW + 1
- IF( KLNEW.LE.MMAX ) THEN
-*
-* Eigenvalue in both intervals -- add upper to
-* queue.
-*
- AB( KLNEW, 2 ) = AB( JI, 2 )
- NAB( KLNEW, 2 ) = NAB( JI, 2 )
- AB( KLNEW, 1 ) = C( JI )
- NAB( KLNEW, 1 ) = IWORK( JI )
- AB( JI, 2 ) = C( JI )
- NAB( JI, 2 ) = IWORK( JI )
- ELSE
- INFO = MMAX + 1
- END IF
- END IF
- 70 CONTINUE
- IF( INFO.NE.0 )
- $ RETURN
- KL = KLNEW
- ELSE
-*
-* IJOB=3: Binary search. Keep only the interval containing
-* w s.t. N(w) = NVAL
-*
- DO 80 JI = KF, KL
- IF( IWORK( JI ).LE.NVAL( JI ) ) THEN
- AB( JI, 1 ) = C( JI )
- NAB( JI, 1 ) = IWORK( JI )
- END IF
- IF( IWORK( JI ).GE.NVAL( JI ) ) THEN
- AB( JI, 2 ) = C( JI )
- NAB( JI, 2 ) = IWORK( JI )
- END IF
- 80 CONTINUE
- END IF
-*
- ELSE
-*
-* End of Parallel Version of the loop
-*
-* Begin of Serial Version of the loop
-*
- KLNEW = KL
- DO 100 JI = KF, KL
-*
-* Compute N(w), the number of eigenvalues less than w
-*
- TMP1 = C( JI )
- TMP2 = D( 1 ) - TMP1
- ITMP1 = 0
- IF( TMP2.LE.PIVMIN ) THEN
- ITMP1 = 1
- TMP2 = MIN( TMP2, -PIVMIN )
- END IF
-*
- DO 90 J = 2, N
- TMP2 = D( J ) - E2( J-1 ) / TMP2 - TMP1
- IF( TMP2.LE.PIVMIN ) THEN
- ITMP1 = ITMP1 + 1
- TMP2 = MIN( TMP2, -PIVMIN )
- END IF
- 90 CONTINUE
-*
- IF( IJOB.LE.2 ) THEN
-*
-* IJOB=2: Choose all intervals containing eigenvalues.
-*
-* Insure that N(w) is monotone
-*
- ITMP1 = MIN( NAB( JI, 2 ),
- $ MAX( NAB( JI, 1 ), ITMP1 ) )
-*
-* Update the Queue -- add intervals if both halves
-* contain eigenvalues.
-*
- IF( ITMP1.EQ.NAB( JI, 2 ) ) THEN
-*
-* No eigenvalue in the upper interval:
-* just use the lower interval.
-*
- AB( JI, 2 ) = TMP1
-*
- ELSE IF( ITMP1.EQ.NAB( JI, 1 ) ) THEN
-*
-* No eigenvalue in the lower interval:
-* just use the upper interval.
-*
- AB( JI, 1 ) = TMP1
- ELSE IF( KLNEW.LT.MMAX ) THEN
-*
-* Eigenvalue in both intervals -- add upper to queue.
-*
- KLNEW = KLNEW + 1
- AB( KLNEW, 2 ) = AB( JI, 2 )
- NAB( KLNEW, 2 ) = NAB( JI, 2 )
- AB( KLNEW, 1 ) = TMP1
- NAB( KLNEW, 1 ) = ITMP1
- AB( JI, 2 ) = TMP1
- NAB( JI, 2 ) = ITMP1
- ELSE
- INFO = MMAX + 1
- RETURN
- END IF
- ELSE
-*
-* IJOB=3: Binary search. Keep only the interval
-* containing w s.t. N(w) = NVAL
-*
- IF( ITMP1.LE.NVAL( JI ) ) THEN
- AB( JI, 1 ) = TMP1
- NAB( JI, 1 ) = ITMP1
- END IF
- IF( ITMP1.GE.NVAL( JI ) ) THEN
- AB( JI, 2 ) = TMP1
- NAB( JI, 2 ) = ITMP1
- END IF
- END IF
- 100 CONTINUE
- KL = KLNEW
-*
- END IF
-*
-* Check for convergence
-*
- KFNEW = KF
- DO 110 JI = KF, KL
- TMP1 = ABS( AB( JI, 2 )-AB( JI, 1 ) )
- TMP2 = MAX( ABS( AB( JI, 2 ) ), ABS( AB( JI, 1 ) ) )
- IF( TMP1.LT.MAX( ABSTOL, PIVMIN, RELTOL*TMP2 ) .OR.
- $ NAB( JI, 1 ).GE.NAB( JI, 2 ) ) THEN
-*
-* Converged -- Swap with position KFNEW,
-* then increment KFNEW
-*
- IF( JI.GT.KFNEW ) THEN
- TMP1 = AB( JI, 1 )
- TMP2 = AB( JI, 2 )
- ITMP1 = NAB( JI, 1 )
- ITMP2 = NAB( JI, 2 )
- AB( JI, 1 ) = AB( KFNEW, 1 )
- AB( JI, 2 ) = AB( KFNEW, 2 )
- NAB( JI, 1 ) = NAB( KFNEW, 1 )
- NAB( JI, 2 ) = NAB( KFNEW, 2 )
- AB( KFNEW, 1 ) = TMP1
- AB( KFNEW, 2 ) = TMP2
- NAB( KFNEW, 1 ) = ITMP1
- NAB( KFNEW, 2 ) = ITMP2
- IF( IJOB.EQ.3 ) THEN
- ITMP1 = NVAL( JI )
- NVAL( JI ) = NVAL( KFNEW )
- NVAL( KFNEW ) = ITMP1
- END IF
- END IF
- KFNEW = KFNEW + 1
- END IF
- 110 CONTINUE
- KF = KFNEW
-*
-* Choose Midpoints
-*
- DO 120 JI = KF, KL
- C( JI ) = HALF*( AB( JI, 1 )+AB( JI, 2 ) )
- 120 CONTINUE
-*
-* If no more intervals to refine, quit.
-*
- IF( KF.GT.KL )
- $ GO TO 140
- 130 CONTINUE
-*
-* Converged
-*
- 140 CONTINUE
- INFO = MAX( KL+1-KF, 0 )
- MOUT = KL
-*
- RETURN
-*
-* End of SLAEBZ
-*
- END
diff --git a/netlib/LAPACK/slaed0.f b/netlib/LAPACK/slaed0.f
deleted file mode 100644
index b05f18e..0000000
--- a/netlib/LAPACK/slaed0.f
+++ /dev/null
@@ -1,434 +0,0 @@
-*> \brief \b SLAED0 used by sstedc. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL D( * ), E( * ), Q( LDQ, * ), QSTORE( LDQS, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED0 computes all eigenvalues and corresponding eigenvectors of a
-*> symmetric tridiagonal matrix using the divide and conquer method.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> = 0: Compute eigenvalues only.
-*> = 1: Compute eigenvectors of original dense symmetric matrix
-*> also. On entry, Q contains the orthogonal matrix used
-*> to reduce the original matrix to tridiagonal form.
-*> = 2: Compute eigenvalues and eigenvectors of tridiagonal
-*> matrix.
-*> \endverbatim
-*>
-*> \param[in] QSIZ
-*> \verbatim
-*> QSIZ is INTEGER
-*> The dimension of the orthogonal matrix used to reduce
-*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the main diagonal of the tridiagonal matrix.
-*> On exit, its eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> On entry, Q must contain an N-by-N orthogonal matrix.
-*> If ICOMPQ = 0 Q is not referenced.
-*> If ICOMPQ = 1 On entry, Q is a subset of the columns of the
-*> orthogonal matrix used to reduce the full
-*> matrix to tridiagonal form corresponding to
-*> the subset of the full matrix which is being
-*> decomposed at this time.
-*> If ICOMPQ = 2 On entry, Q will be the identity matrix.
-*> On exit, Q contains the eigenvectors of the
-*> tridiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. If eigenvectors are
-*> desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
-*> \endverbatim
-*>
-*> \param[out] QSTORE
-*> \verbatim
-*> QSTORE is REAL array, dimension (LDQS, N)
-*> Referenced only when ICOMPQ = 1. Used to store parts of
-*> the eigenvector matrix when the updating matrix multiplies
-*> take place.
-*> \endverbatim
-*>
-*> \param[in] LDQS
-*> \verbatim
-*> LDQS is INTEGER
-*> The leading dimension of the array QSTORE. If ICOMPQ = 1,
-*> then LDQS >= max(1,N). In any case, LDQS >= 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array,
-*> If ICOMPQ = 0 or 1, the dimension of WORK must be at least
-*> 1 + 3*N + 2*N*lg N + 3*N**2
-*> ( lg( N ) = smallest integer k
-*> such that 2^k >= N )
-*> If ICOMPQ = 2, the dimension of WORK must be at least
-*> 4*N + N**2.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array,
-*> If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
-*> 6 + 6*N + 5*N*lg N.
-*> ( lg( N ) = smallest integer k
-*> such that 2^k >= N )
-*> If ICOMPQ = 2, the dimension of IWORK must be at least
-*> 3 + 5*N.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute an eigenvalue while
-*> working on the submatrix lying in rows and columns
-*> INFO/(N+1) through mod(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL D( * ), E( * ), Q( LDQ, * ), QSTORE( LDQS, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.E0, ONE = 1.E0, TWO = 2.E0 )
-* ..
-* .. Local Scalars ..
- INTEGER CURLVL, CURPRB, CURR, I, IGIVCL, IGIVNM,
- $ IGIVPT, INDXQ, IPERM, IPRMPT, IQ, IQPTR, IWREM,
- $ J, K, LGN, MATSIZ, MSD2, SMLSIZ, SMM1, SPM1,
- $ SPM2, SUBMAT, SUBPBS, TLVLS
- REAL TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, SLACPY, SLAED1, SLAED7, SSTEQR,
- $ XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.2 ) THEN
- INFO = -1
- ELSE IF( ( ICOMPQ.EQ.1 ) .AND. ( QSIZ.LT.MAX( 0, N ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDQS.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED0', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- SMLSIZ = ILAENV( 9, 'SLAED0', ' ', 0, 0, 0, 0 )
-*
-* Determine the size and placement of the submatrices, and save in
-* the leading elements of IWORK.
-*
- IWORK( 1 ) = N
- SUBPBS = 1
- TLVLS = 0
- 10 CONTINUE
- IF( IWORK( SUBPBS ).GT.SMLSIZ ) THEN
- DO 20 J = SUBPBS, 1, -1
- IWORK( 2*J ) = ( IWORK( J )+1 ) / 2
- IWORK( 2*J-1 ) = IWORK( J ) / 2
- 20 CONTINUE
- TLVLS = TLVLS + 1
- SUBPBS = 2*SUBPBS
- GO TO 10
- END IF
- DO 30 J = 2, SUBPBS
- IWORK( J ) = IWORK( J ) + IWORK( J-1 )
- 30 CONTINUE
-*
-* Divide the matrix into SUBPBS submatrices of size at most SMLSIZ+1
-* using rank-1 modifications (cuts).
-*
- SPM1 = SUBPBS - 1
- DO 40 I = 1, SPM1
- SUBMAT = IWORK( I ) + 1
- SMM1 = SUBMAT - 1
- D( SMM1 ) = D( SMM1 ) - ABS( E( SMM1 ) )
- D( SUBMAT ) = D( SUBMAT ) - ABS( E( SMM1 ) )
- 40 CONTINUE
-*
- INDXQ = 4*N + 3
- IF( ICOMPQ.NE.2 ) THEN
-*
-* Set up workspaces for eigenvalues only/accumulate new vectors
-* routine
-*
- TEMP = LOG( REAL( N ) ) / LOG( TWO )
- LGN = INT( TEMP )
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IPRMPT = INDXQ + N + 1
- IPERM = IPRMPT + N*LGN
- IQPTR = IPERM + N*LGN
- IGIVPT = IQPTR + N + 2
- IGIVCL = IGIVPT + N*LGN
-*
- IGIVNM = 1
- IQ = IGIVNM + 2*N*LGN
- IWREM = IQ + N**2 + 1
-*
-* Initialize pointers
-*
- DO 50 I = 0, SUBPBS
- IWORK( IPRMPT+I ) = 1
- IWORK( IGIVPT+I ) = 1
- 50 CONTINUE
- IWORK( IQPTR ) = 1
- END IF
-*
-* Solve each submatrix eigenproblem at the bottom of the divide and
-* conquer tree.
-*
- CURR = 0
- DO 70 I = 0, SPM1
- IF( I.EQ.0 ) THEN
- SUBMAT = 1
- MATSIZ = IWORK( 1 )
- ELSE
- SUBMAT = IWORK( I ) + 1
- MATSIZ = IWORK( I+1 ) - IWORK( I )
- END IF
- IF( ICOMPQ.EQ.2 ) THEN
- CALL SSTEQR( 'I', MATSIZ, D( SUBMAT ), E( SUBMAT ),
- $ Q( SUBMAT, SUBMAT ), LDQ, WORK, INFO )
- IF( INFO.NE.0 )
- $ GO TO 130
- ELSE
- CALL SSTEQR( 'I', MATSIZ, D( SUBMAT ), E( SUBMAT ),
- $ WORK( IQ-1+IWORK( IQPTR+CURR ) ), MATSIZ, WORK,
- $ INFO )
- IF( INFO.NE.0 )
- $ GO TO 130
- IF( ICOMPQ.EQ.1 ) THEN
- CALL SGEMM( 'N', 'N', QSIZ, MATSIZ, MATSIZ, ONE,
- $ Q( 1, SUBMAT ), LDQ, WORK( IQ-1+IWORK( IQPTR+
- $ CURR ) ), MATSIZ, ZERO, QSTORE( 1, SUBMAT ),
- $ LDQS )
- END IF
- IWORK( IQPTR+CURR+1 ) = IWORK( IQPTR+CURR ) + MATSIZ**2
- CURR = CURR + 1
- END IF
- K = 1
- DO 60 J = SUBMAT, IWORK( I+1 )
- IWORK( INDXQ+J ) = K
- K = K + 1
- 60 CONTINUE
- 70 CONTINUE
-*
-* Successively merge eigensystems of adjacent submatrices
-* into eigensystem for the corresponding larger matrix.
-*
-* while ( SUBPBS > 1 )
-*
- CURLVL = 1
- 80 CONTINUE
- IF( SUBPBS.GT.1 ) THEN
- SPM2 = SUBPBS - 2
- DO 90 I = 0, SPM2, 2
- IF( I.EQ.0 ) THEN
- SUBMAT = 1
- MATSIZ = IWORK( 2 )
- MSD2 = IWORK( 1 )
- CURPRB = 0
- ELSE
- SUBMAT = IWORK( I ) + 1
- MATSIZ = IWORK( I+2 ) - IWORK( I )
- MSD2 = MATSIZ / 2
- CURPRB = CURPRB + 1
- END IF
-*
-* Merge lower order eigensystems (of size MSD2 and MATSIZ - MSD2)
-* into an eigensystem of size MATSIZ.
-* SLAED1 is used only for the full eigensystem of a tridiagonal
-* matrix.
-* SLAED7 handles the cases in which eigenvalues only or eigenvalues
-* and eigenvectors of a full symmetric matrix (which was reduced to
-* tridiagonal form) are desired.
-*
- IF( ICOMPQ.EQ.2 ) THEN
- CALL SLAED1( MATSIZ, D( SUBMAT ), Q( SUBMAT, SUBMAT ),
- $ LDQ, IWORK( INDXQ+SUBMAT ),
- $ E( SUBMAT+MSD2-1 ), MSD2, WORK,
- $ IWORK( SUBPBS+1 ), INFO )
- ELSE
- CALL SLAED7( ICOMPQ, MATSIZ, QSIZ, TLVLS, CURLVL, CURPRB,
- $ D( SUBMAT ), QSTORE( 1, SUBMAT ), LDQS,
- $ IWORK( INDXQ+SUBMAT ), E( SUBMAT+MSD2-1 ),
- $ MSD2, WORK( IQ ), IWORK( IQPTR ),
- $ IWORK( IPRMPT ), IWORK( IPERM ),
- $ IWORK( IGIVPT ), IWORK( IGIVCL ),
- $ WORK( IGIVNM ), WORK( IWREM ),
- $ IWORK( SUBPBS+1 ), INFO )
- END IF
- IF( INFO.NE.0 )
- $ GO TO 130
- IWORK( I / 2+1 ) = IWORK( I+2 )
- 90 CONTINUE
- SUBPBS = SUBPBS / 2
- CURLVL = CURLVL + 1
- GO TO 80
- END IF
-*
-* end while
-*
-* Re-merge the eigenvalues/vectors which were deflated at the final
-* merge step.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- DO 100 I = 1, N
- J = IWORK( INDXQ+I )
- WORK( I ) = D( J )
- CALL SCOPY( QSIZ, QSTORE( 1, J ), 1, Q( 1, I ), 1 )
- 100 CONTINUE
- CALL SCOPY( N, WORK, 1, D, 1 )
- ELSE IF( ICOMPQ.EQ.2 ) THEN
- DO 110 I = 1, N
- J = IWORK( INDXQ+I )
- WORK( I ) = D( J )
- CALL SCOPY( N, Q( 1, J ), 1, WORK( N*I+1 ), 1 )
- 110 CONTINUE
- CALL SCOPY( N, WORK, 1, D, 1 )
- CALL SLACPY( 'A', N, N, WORK( N+1 ), N, Q, LDQ )
- ELSE
- DO 120 I = 1, N
- J = IWORK( INDXQ+I )
- WORK( I ) = D( J )
- 120 CONTINUE
- CALL SCOPY( N, WORK, 1, D, 1 )
- END IF
- GO TO 140
-*
- 130 CONTINUE
- INFO = SUBMAT*( N+1 ) + SUBMAT + MATSIZ - 1
-*
- 140 CONTINUE
- RETURN
-*
-* End of SLAED0
-*
- END
diff --git a/netlib/LAPACK/slaed1.f b/netlib/LAPACK/slaed1.f
deleted file mode 100644
index 74eeb63..0000000
--- a/netlib/LAPACK/slaed1.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b SLAED1 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CUTPNT, INFO, LDQ, N
-* REAL RHO
-* ..
-* .. Array Arguments ..
-* INTEGER INDXQ( * ), IWORK( * )
-* REAL D( * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED1 computes the updated eigensystem of a diagonal
-*> matrix after modification by a rank-one symmetric matrix. This
-*> routine is used only for the eigenproblem which requires all
-*> eigenvalues and eigenvectors of a tridiagonal matrix. SLAED7 handles
-*> the case in which eigenvalues only or eigenvalues and eigenvectors
-*> of a full symmetric matrix (which was reduced to tridiagonal form)
-*> are desired.
-*>
-*> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out)
-*>
-*> where Z = Q**T*u, u is a vector of length N with ones in the
-*> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
-*>
-*> The eigenvectors of the original matrix are stored in Q, and the
-*> eigenvalues are in D. The algorithm consists of three stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple eigenvalues or if there is a zero in
-*> the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine SLAED2.
-*>
-*> The second stage consists of calculating the updated
-*> eigenvalues. This is done by finding the roots of the secular
-*> equation via the routine SLAED4 (as called by SLAED3).
-*> This routine also calculates the eigenvectors of the current
-*> problem.
-*>
-*> The final stage consists of computing the updated eigenvectors
-*> directly using the updated eigenvalues. The eigenvectors for
-*> the current problem are multiplied with the eigenvectors from
-*> the overall problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the eigenvalues of the rank-1-perturbed matrix.
-*> On exit, the eigenvalues of the repaired matrix.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, the eigenvectors of the rank-1-perturbed matrix.
-*> On exit, the eigenvectors of the repaired tridiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> On entry, the permutation which separately sorts the two
-*> subproblems in D into ascending order.
-*> On exit, the permutation which will reintegrate the
-*> subproblems back into sorted order,
-*> i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The subdiagonal entry used to create the rank-1 modification.
-*> \endverbatim
-*>
-*> \param[in] CUTPNT
-*> \verbatim
-*> CUTPNT is INTEGER
-*> The location of the last eigenvalue in the leading sub-matrix.
-*> min(1,N) <= CUTPNT <= N/2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N + N**2)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CUTPNT, INFO, LDQ, N
- REAL RHO
-* ..
-* .. Array Arguments ..
- INTEGER INDXQ( * ), IWORK( * )
- REAL D( * ), Q( LDQ, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER COLTYP, CPP1, I, IDLMDA, INDX, INDXC, INDXP,
- $ IQ2, IS, IW, IZ, K, N1, N2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAED2, SLAED3, SLAMRG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( MIN( 1, N / 2 ).GT.CUTPNT .OR. ( N / 2 ).LT.CUTPNT ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED1', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* The following values are integer pointers which indicate
-* the portion of the workspace
-* used by a particular array in SLAED2 and SLAED3.
-*
- IZ = 1
- IDLMDA = IZ + N
- IW = IDLMDA + N
- IQ2 = IW + N
-*
- INDX = 1
- INDXC = INDX + N
- COLTYP = INDXC + N
- INDXP = COLTYP + N
-*
-*
-* Form the z-vector which consists of the last row of Q_1 and the
-* first row of Q_2.
-*
- CALL SCOPY( CUTPNT, Q( CUTPNT, 1 ), LDQ, WORK( IZ ), 1 )
- CPP1 = CUTPNT + 1
- CALL SCOPY( N-CUTPNT, Q( CPP1, CPP1 ), LDQ, WORK( IZ+CUTPNT ), 1 )
-*
-* Deflate eigenvalues.
-*
- CALL SLAED2( K, N, CUTPNT, D, Q, LDQ, INDXQ, RHO, WORK( IZ ),
- $ WORK( IDLMDA ), WORK( IW ), WORK( IQ2 ),
- $ IWORK( INDX ), IWORK( INDXC ), IWORK( INDXP ),
- $ IWORK( COLTYP ), INFO )
-*
- IF( INFO.NE.0 )
- $ GO TO 20
-*
-* Solve Secular Equation.
-*
- IF( K.NE.0 ) THEN
- IS = ( IWORK( COLTYP )+IWORK( COLTYP+1 ) )*CUTPNT +
- $ ( IWORK( COLTYP+1 )+IWORK( COLTYP+2 ) )*( N-CUTPNT ) + IQ2
- CALL SLAED3( K, N, CUTPNT, D, Q, LDQ, RHO, WORK( IDLMDA ),
- $ WORK( IQ2 ), IWORK( INDXC ), IWORK( COLTYP ),
- $ WORK( IW ), WORK( IS ), INFO )
- IF( INFO.NE.0 )
- $ GO TO 20
-*
-* Prepare the INDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL SLAMRG( N1, N2, D, 1, -1, INDXQ )
- ELSE
- DO 10 I = 1, N
- INDXQ( I ) = I
- 10 CONTINUE
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of SLAED1
-*
- END
diff --git a/netlib/LAPACK/slaed2.f b/netlib/LAPACK/slaed2.f
deleted file mode 100644
index 897eb4c..0000000
--- a/netlib/LAPACK/slaed2.f
+++ /dev/null
@@ -1,539 +0,0 @@
-*> \brief \b SLAED2 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W,
-* Q2, INDX, INDXC, INDXP, COLTYP, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDQ, N, N1
-* REAL RHO
-* ..
-* .. Array Arguments ..
-* INTEGER COLTYP( * ), INDX( * ), INDXC( * ), INDXP( * ),
-* $ INDXQ( * )
-* REAL D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
-* $ W( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED2 merges the two sets of eigenvalues together into a single
-*> sorted set. Then it tries to deflate the size of the problem.
-*> There are two ways in which deflation can occur: when two or more
-*> eigenvalues are close together or if there is a tiny entry in the
-*> Z vector. For each such occurrence the order of the related secular
-*> equation problem is reduced by one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> The number of non-deflated eigenvalues, and the order of the
-*> related secular equation. 0 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The location of the last eigenvalue in the leading sub-matrix.
-*> min(1,N) <= N1 <= N/2.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, D contains the eigenvalues of the two submatrices to
-*> be combined.
-*> On exit, D contains the trailing (N-K) updated eigenvalues
-*> (those which were deflated) sorted into increasing order.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> On entry, Q contains the eigenvectors of two submatrices in
-*> the two square blocks with corners at (1,1), (N1,N1)
-*> and (N1+1, N1+1), (N,N).
-*> On exit, Q contains the trailing (N-K) updated eigenvectors
-*> (those which were deflated) in its last N-K columns.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> The permutation which separately sorts the two sub-problems
-*> in D into ascending order. Note that elements in the second
-*> half of this permutation must first have N1 added to their
-*> values. Destroyed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] RHO
-*> \verbatim
-*> RHO is REAL
-*> On entry, the off-diagonal element associated with the rank-1
-*> cut which originally split the two submatrices which are now
-*> being recombined.
-*> On exit, RHO has been modified to the value required by
-*> SLAED3.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (N)
-*> On entry, Z contains the updating vector (the last
-*> row of the first sub-eigenvector matrix and the first row of
-*> the second sub-eigenvector matrix).
-*> On exit, the contents of Z have been destroyed by the updating
-*> process.
-*> \endverbatim
-*>
-*> \param[out] DLAMDA
-*> \verbatim
-*> DLAMDA is REAL array, dimension (N)
-*> A copy of the first K eigenvalues which will be used by
-*> SLAED3 to form the secular equation.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first k values of the final deflation-altered z-vector
-*> which will be passed to SLAED3.
-*> \endverbatim
-*>
-*> \param[out] Q2
-*> \verbatim
-*> Q2 is REAL array, dimension (N1**2+(N-N1)**2)
-*> A copy of the first K eigenvectors which will be used by
-*> SLAED3 in a matrix multiply (SGEMM) to solve for the new
-*> eigenvectors.
-*> \endverbatim
-*>
-*> \param[out] INDX
-*> \verbatim
-*> INDX is INTEGER array, dimension (N)
-*> The permutation used to sort the contents of DLAMDA into
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] INDXC
-*> \verbatim
-*> INDXC is INTEGER array, dimension (N)
-*> The permutation used to arrange the columns of the deflated
-*> Q matrix into three groups: the first group contains non-zero
-*> elements only at and above N1, the second contains
-*> non-zero elements only below N1, and the third is dense.
-*> \endverbatim
-*>
-*> \param[out] INDXP
-*> \verbatim
-*> INDXP is INTEGER array, dimension (N)
-*> The permutation used to place deflated values of D at the end
-*> of the array. INDXP(1:K) points to the nondeflated D-values
-*> and INDXP(K+1:N) points to the deflated eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] COLTYP
-*> \verbatim
-*> COLTYP is INTEGER array, dimension (N)
-*> During execution, a label which will indicate which of the
-*> following types a column in the Q2 matrix is:
-*> 1 : non-zero in the upper half only;
-*> 2 : dense;
-*> 3 : non-zero in the lower half only;
-*> 4 : deflated.
-*> On exit, COLTYP(i) is the number of columns of type i,
-*> for i=1 to 4 only.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE SLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W,
- $ Q2, INDX, INDXC, INDXP, COLTYP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDQ, N, N1
- REAL RHO
-* ..
-* .. Array Arguments ..
- INTEGER COLTYP( * ), INDX( * ), INDXC( * ), INDXP( * ),
- $ INDXQ( * )
- REAL D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
- $ W( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL MONE, ZERO, ONE, TWO, EIGHT
- PARAMETER ( MONE = -1.0E0, ZERO = 0.0E0, ONE = 1.0E0,
- $ TWO = 2.0E0, EIGHT = 8.0E0 )
-* ..
-* .. Local Arrays ..
- INTEGER CTOT( 4 ), PSM( 4 )
-* ..
-* .. Local Scalars ..
- INTEGER CT, I, IMAX, IQ1, IQ2, J, JMAX, JS, K2, N1P1,
- $ N2, NJ, PJ
- REAL C, EPS, S, T, TAU, TOL
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH, SLAPY2
- EXTERNAL ISAMAX, SLAMCH, SLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SLAMRG, SROT, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( MIN( 1, ( N / 2 ) ).GT.N1 .OR. ( N / 2 ).LT.N1 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- N2 = N - N1
- N1P1 = N1 + 1
-*
- IF( RHO.LT.ZERO ) THEN
- CALL SSCAL( N2, MONE, Z( N1P1 ), 1 )
- END IF
-*
-* Normalize z so that norm(z) = 1. Since z is the concatenation of
-* two normalized vectors, norm2(z) = sqrt(2).
-*
- T = ONE / SQRT( TWO )
- CALL SSCAL( N, T, Z, 1 )
-*
-* RHO = ABS( norm(z)**2 * RHO )
-*
- RHO = ABS( TWO*RHO )
-*
-* Sort the eigenvalues into increasing order
-*
- DO 10 I = N1P1, N
- INDXQ( I ) = INDXQ( I ) + N1
- 10 CONTINUE
-*
-* re-integrate the deflated parts from the last pass
-*
- DO 20 I = 1, N
- DLAMDA( I ) = D( INDXQ( I ) )
- 20 CONTINUE
- CALL SLAMRG( N1, N2, DLAMDA, 1, 1, INDXC )
- DO 30 I = 1, N
- INDX( I ) = INDXQ( INDXC( I ) )
- 30 CONTINUE
-*
-* Calculate the allowable deflation tolerance
-*
- IMAX = ISAMAX( N, Z, 1 )
- JMAX = ISAMAX( N, D, 1 )
- EPS = SLAMCH( 'Epsilon' )
- TOL = EIGHT*EPS*MAX( ABS( D( JMAX ) ), ABS( Z( IMAX ) ) )
-*
-* If the rank-1 modifier is small enough, no more needs to be done
-* except to reorganize Q so that its columns correspond with the
-* elements in D.
-*
- IF( RHO*ABS( Z( IMAX ) ).LE.TOL ) THEN
- K = 0
- IQ2 = 1
- DO 40 J = 1, N
- I = INDX( J )
- CALL SCOPY( N, Q( 1, I ), 1, Q2( IQ2 ), 1 )
- DLAMDA( J ) = D( I )
- IQ2 = IQ2 + N
- 40 CONTINUE
- CALL SLACPY( 'A', N, N, Q2, N, Q, LDQ )
- CALL SCOPY( N, DLAMDA, 1, D, 1 )
- GO TO 190
- END IF
-*
-* If there are multiple eigenvalues then the problem deflates. Here
-* the number of equal eigenvalues are found. As each equal
-* eigenvalue is found, an elementary reflector is computed to rotate
-* the corresponding eigensubspace so that the corresponding
-* components of Z are zero in this new basis.
-*
- DO 50 I = 1, N1
- COLTYP( I ) = 1
- 50 CONTINUE
- DO 60 I = N1P1, N
- COLTYP( I ) = 3
- 60 CONTINUE
-*
-*
- K = 0
- K2 = N + 1
- DO 70 J = 1, N
- NJ = INDX( J )
- IF( RHO*ABS( Z( NJ ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- COLTYP( NJ ) = 4
- INDXP( K2 ) = NJ
- IF( J.EQ.N )
- $ GO TO 100
- ELSE
- PJ = NJ
- GO TO 80
- END IF
- 70 CONTINUE
- 80 CONTINUE
- J = J + 1
- NJ = INDX( J )
- IF( J.GT.N )
- $ GO TO 100
- IF( RHO*ABS( Z( NJ ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- COLTYP( NJ ) = 4
- INDXP( K2 ) = NJ
- ELSE
-*
-* Check if eigenvalues are close enough to allow deflation.
-*
- S = Z( PJ )
- C = Z( NJ )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = SLAPY2( C, S )
- T = D( NJ ) - D( PJ )
- C = C / TAU
- S = -S / TAU
- IF( ABS( T*C*S ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- Z( NJ ) = TAU
- Z( PJ ) = ZERO
- IF( COLTYP( NJ ).NE.COLTYP( PJ ) )
- $ COLTYP( NJ ) = 2
- COLTYP( PJ ) = 4
- CALL SROT( N, Q( 1, PJ ), 1, Q( 1, NJ ), 1, C, S )
- T = D( PJ )*C**2 + D( NJ )*S**2
- D( NJ ) = D( PJ )*S**2 + D( NJ )*C**2
- D( PJ ) = T
- K2 = K2 - 1
- I = 1
- 90 CONTINUE
- IF( K2+I.LE.N ) THEN
- IF( D( PJ ).LT.D( INDXP( K2+I ) ) ) THEN
- INDXP( K2+I-1 ) = INDXP( K2+I )
- INDXP( K2+I ) = PJ
- I = I + 1
- GO TO 90
- ELSE
- INDXP( K2+I-1 ) = PJ
- END IF
- ELSE
- INDXP( K2+I-1 ) = PJ
- END IF
- PJ = NJ
- ELSE
- K = K + 1
- DLAMDA( K ) = D( PJ )
- W( K ) = Z( PJ )
- INDXP( K ) = PJ
- PJ = NJ
- END IF
- END IF
- GO TO 80
- 100 CONTINUE
-*
-* Record the last eigenvalue.
-*
- K = K + 1
- DLAMDA( K ) = D( PJ )
- W( K ) = Z( PJ )
- INDXP( K ) = PJ
-*
-* Count up the total number of the various types of columns, then
-* form a permutation which positions the four column types into
-* four uniform groups (although one or more of these groups may be
-* empty).
-*
- DO 110 J = 1, 4
- CTOT( J ) = 0
- 110 CONTINUE
- DO 120 J = 1, N
- CT = COLTYP( J )
- CTOT( CT ) = CTOT( CT ) + 1
- 120 CONTINUE
-*
-* PSM(*) = Position in SubMatrix (of types 1 through 4)
-*
- PSM( 1 ) = 1
- PSM( 2 ) = 1 + CTOT( 1 )
- PSM( 3 ) = PSM( 2 ) + CTOT( 2 )
- PSM( 4 ) = PSM( 3 ) + CTOT( 3 )
- K = N - CTOT( 4 )
-*
-* Fill out the INDXC array so that the permutation which it induces
-* will place all type-1 columns first, all type-2 columns next,
-* then all type-3's, and finally all type-4's.
-*
- DO 130 J = 1, N
- JS = INDXP( J )
- CT = COLTYP( JS )
- INDX( PSM( CT ) ) = JS
- INDXC( PSM( CT ) ) = J
- PSM( CT ) = PSM( CT ) + 1
- 130 CONTINUE
-*
-* Sort the eigenvalues and corresponding eigenvectors into DLAMDA
-* and Q2 respectively. The eigenvalues/vectors which were not
-* deflated go into the first K slots of DLAMDA and Q2 respectively,
-* while those which were deflated go into the last N - K slots.
-*
- I = 1
- IQ1 = 1
- IQ2 = 1 + ( CTOT( 1 )+CTOT( 2 ) )*N1
- DO 140 J = 1, CTOT( 1 )
- JS = INDX( I )
- CALL SCOPY( N1, Q( 1, JS ), 1, Q2( IQ1 ), 1 )
- Z( I ) = D( JS )
- I = I + 1
- IQ1 = IQ1 + N1
- 140 CONTINUE
-*
- DO 150 J = 1, CTOT( 2 )
- JS = INDX( I )
- CALL SCOPY( N1, Q( 1, JS ), 1, Q2( IQ1 ), 1 )
- CALL SCOPY( N2, Q( N1+1, JS ), 1, Q2( IQ2 ), 1 )
- Z( I ) = D( JS )
- I = I + 1
- IQ1 = IQ1 + N1
- IQ2 = IQ2 + N2
- 150 CONTINUE
-*
- DO 160 J = 1, CTOT( 3 )
- JS = INDX( I )
- CALL SCOPY( N2, Q( N1+1, JS ), 1, Q2( IQ2 ), 1 )
- Z( I ) = D( JS )
- I = I + 1
- IQ2 = IQ2 + N2
- 160 CONTINUE
-*
- IQ1 = IQ2
- DO 170 J = 1, CTOT( 4 )
- JS = INDX( I )
- CALL SCOPY( N, Q( 1, JS ), 1, Q2( IQ2 ), 1 )
- IQ2 = IQ2 + N
- Z( I ) = D( JS )
- I = I + 1
- 170 CONTINUE
-*
-* The deflated eigenvalues and their corresponding vectors go back
-* into the last N - K slots of D and Q respectively.
-*
- IF( K.LT.N ) THEN
- CALL SLACPY( 'A', N, CTOT( 4 ), Q2( IQ1 ), N,
- $ Q( 1, K+1 ), LDQ )
- CALL SCOPY( N-K, Z( K+1 ), 1, D( K+1 ), 1 )
- END IF
-*
-* Copy CTOT into COLTYP for referencing in SLAED3.
-*
- DO 180 J = 1, 4
- COLTYP( J ) = CTOT( J )
- 180 CONTINUE
-*
- 190 CONTINUE
- RETURN
-*
-* End of SLAED2
-*
- END
diff --git a/netlib/LAPACK/slaed3.f b/netlib/LAPACK/slaed3.f
deleted file mode 100644
index 334fcb2..0000000
--- a/netlib/LAPACK/slaed3.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b SLAED3 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
-* CTOT, W, S, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDQ, N, N1
-* REAL RHO
-* ..
-* .. Array Arguments ..
-* INTEGER CTOT( * ), INDX( * )
-* REAL D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
-* $ S( * ), W( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED3 finds the roots of the secular equation, as defined by the
-*> values in D, W, and RHO, between 1 and K. It makes the
-*> appropriate calls to SLAED4 and then updates the eigenvectors by
-*> multiplying the matrix of eigenvectors of the pair of eigensystems
-*> being combined by the matrix of eigenvectors of the K-by-K system
-*> which is solved here.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of terms in the rational function to be solved by
-*> SLAED4. K >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the Q matrix.
-*> N >= K (deflation may result in N>K).
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The location of the last eigenvalue in the leading submatrix.
-*> min(1,N) <= N1 <= N/2.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> D(I) contains the updated eigenvalues for
-*> 1 <= I <= K.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> Initially the first K columns are used as workspace.
-*> On output the columns 1 to K contain
-*> the updated eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The value of the parameter in the rank one update equation.
-*> RHO >= 0 required.
-*> \endverbatim
-*>
-*> \param[in,out] DLAMDA
-*> \verbatim
-*> DLAMDA is REAL array, dimension (K)
-*> The first K elements of this array contain the old roots
-*> of the deflated updating problem. These are the poles
-*> of the secular equation. May be changed on output by
-*> having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
-*> Cray-2, or Cray C-90, as described above.
-*> \endverbatim
-*>
-*> \param[in] Q2
-*> \verbatim
-*> Q2 is REAL array, dimension (LDQ2, N)
-*> The first K columns of this matrix contain the non-deflated
-*> eigenvectors for the split problem.
-*> \endverbatim
-*>
-*> \param[in] INDX
-*> \verbatim
-*> INDX is INTEGER array, dimension (N)
-*> The permutation used to arrange the columns of the deflated
-*> Q matrix into three groups (see SLAED2).
-*> The rows of the eigenvectors found by SLAED4 must be likewise
-*> permuted before the matrix multiply can take place.
-*> \endverbatim
-*>
-*> \param[in] CTOT
-*> \verbatim
-*> CTOT is INTEGER array, dimension (4)
-*> A count of the total number of the various types of columns
-*> in Q, as described in INDX. The fourth column type is any
-*> column which has been deflated.
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is REAL array, dimension (K)
-*> The first K elements of this array contain the components
-*> of the deflation-adjusted updating vector. Destroyed on
-*> output.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N1 + 1)*K
-*> Will contain the eigenvectors of the repaired matrix which
-*> will be multiplied by the previously accumulated eigenvectors
-*> to update the system.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
- $ CTOT, W, S, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDQ, N, N1
- REAL RHO
-* ..
-* .. Array Arguments ..
- INTEGER CTOT( * ), INDX( * )
- REAL D( * ), DLAMDA( * ), Q( LDQ, * ), Q2( * ),
- $ S( * ), W( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, II, IQ2, J, N12, N2, N23
- REAL TEMP
-* ..
-* .. External Functions ..
- REAL SLAMC3, SNRM2
- EXTERNAL SLAMC3, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, SLACPY, SLAED4, SLASET, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( K.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.K ) THEN
- INFO = -2
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED3', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 )
- $ RETURN
-*
-* Modify values DLAMDA(i) to make sure all DLAMDA(i)-DLAMDA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DLAMDA(I) by 2*DLAMDA(I)-DLAMDA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DLAMDA(I) if it is 1; this makes the subsequent
-* subtractions DLAMDA(I)-DLAMDA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DLAMDA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DLAMDA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 10 I = 1, K
- DLAMDA( I ) = SLAMC3( DLAMDA( I ), DLAMDA( I ) ) - DLAMDA( I )
- 10 CONTINUE
-*
- DO 20 J = 1, K
- CALL SLAED4( K, J, DLAMDA, W, Q( 1, J ), RHO, D( J ), INFO )
-*
-* If the zero finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 )
- $ GO TO 120
- 20 CONTINUE
-*
- IF( K.EQ.1 )
- $ GO TO 110
- IF( K.EQ.2 ) THEN
- DO 30 J = 1, K
- W( 1 ) = Q( 1, J )
- W( 2 ) = Q( 2, J )
- II = INDX( 1 )
- Q( 1, J ) = W( II )
- II = INDX( 2 )
- Q( 2, J ) = W( II )
- 30 CONTINUE
- GO TO 110
- END IF
-*
-* Compute updated W.
-*
- CALL SCOPY( K, W, 1, S, 1 )
-*
-* Initialize W(I) = Q(I,I)
-*
- CALL SCOPY( K, Q, LDQ+1, W, 1 )
- DO 60 J = 1, K
- DO 40 I = 1, J - 1
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 40 CONTINUE
- DO 50 I = J + 1, K
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 50 CONTINUE
- 60 CONTINUE
- DO 70 I = 1, K
- W( I ) = SIGN( SQRT( -W( I ) ), S( I ) )
- 70 CONTINUE
-*
-* Compute eigenvectors of the modified rank-1 modification.
-*
- DO 100 J = 1, K
- DO 80 I = 1, K
- S( I ) = W( I ) / Q( I, J )
- 80 CONTINUE
- TEMP = SNRM2( K, S, 1 )
- DO 90 I = 1, K
- II = INDX( I )
- Q( I, J ) = S( II ) / TEMP
- 90 CONTINUE
- 100 CONTINUE
-*
-* Compute the updated eigenvectors.
-*
- 110 CONTINUE
-*
- N2 = N - N1
- N12 = CTOT( 1 ) + CTOT( 2 )
- N23 = CTOT( 2 ) + CTOT( 3 )
-*
- CALL SLACPY( 'A', N23, K, Q( CTOT( 1 )+1, 1 ), LDQ, S, N23 )
- IQ2 = N1*N12 + 1
- IF( N23.NE.0 ) THEN
- CALL SGEMM( 'N', 'N', N2, K, N23, ONE, Q2( IQ2 ), N2, S, N23,
- $ ZERO, Q( N1+1, 1 ), LDQ )
- ELSE
- CALL SLASET( 'A', N2, K, ZERO, ZERO, Q( N1+1, 1 ), LDQ )
- END IF
-*
- CALL SLACPY( 'A', N12, K, Q, LDQ, S, N12 )
- IF( N12.NE.0 ) THEN
- CALL SGEMM( 'N', 'N', N1, K, N12, ONE, Q2, N1, S, N12, ZERO, Q,
- $ LDQ )
- ELSE
- CALL SLASET( 'A', N1, K, ZERO, ZERO, Q( 1, 1 ), LDQ )
- END IF
-*
-*
- 120 CONTINUE
- RETURN
-*
-* End of SLAED3
-*
- END
diff --git a/netlib/LAPACK/slaed4.f b/netlib/LAPACK/slaed4.f
deleted file mode 100644
index 6330c85..0000000
--- a/netlib/LAPACK/slaed4.f
+++ /dev/null
@@ -1,917 +0,0 @@
-*> \brief \b SLAED4 used by sstedc. Finds a single root of the secular equation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER I, INFO, N
-* REAL DLAM, RHO
-* ..
-* .. Array Arguments ..
-* REAL D( * ), DELTA( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the I-th updated eigenvalue of a symmetric
-*> rank-one modification to a diagonal matrix whose elements are
-*> given in the array d, and that
-*>
-*> D(i) < D(j) for i < j
-*>
-*> and that RHO > 0. This is arranged by the calling routine, and is
-*> no loss in generality. The rank-one modified system is thus
-*>
-*> diag( D ) + RHO * Z * Z_transpose.
-*>
-*> where we assume the Euclidean norm of Z is 1.
-*>
-*> The method consists of approximating the rational functions in the
-*> secular equation by simpler interpolating rational functions.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of all arrays.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. 1 <= I <= N.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The original eigenvalues. It is assumed that they are in
-*> order, D(I) < D(J) for I < J.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (N)
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is REAL array, dimension (N)
-*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th
-*> component. If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5
-*> for detail. The vector DELTA contains the information necessary
-*> to construct the eigenvectors by SLAED3 and SLAED9.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] DLAM
-*> \verbatim
-*> DLAM is REAL
-*> The computed lambda_I, the I-th updated eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = 1, the updating process failed.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> Logical variable ORGATI (origin-at-i?) is used for distinguishing
-*> whether D(i) or D(i+1) is treated as the origin.
-*>
-*> ORGATI = .true. origin at i
-*> ORGATI = .false. origin at i+1
-*>
-*> Logical variable SWTCH3 (switch-for-3-poles?) is for noting
-*> if we are working with THREE poles!
-*>
-*> MAXIT is the maximum number of iterations allowed for each
-*> eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I, INFO, N
- REAL DLAM, RHO
-* ..
-* .. Array Arguments ..
- REAL D( * ), DELTA( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 30 )
- REAL ZERO, ONE, TWO, THREE, FOUR, EIGHT, TEN
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ THREE = 3.0E0, FOUR = 4.0E0, EIGHT = 8.0E0,
- $ TEN = 10.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ORGATI, SWTCH, SWTCH3
- INTEGER II, IIM1, IIP1, IP1, ITER, J, NITER
- REAL A, B, C, DEL, DLTLB, DLTUB, DPHI, DPSI, DW,
- $ EPS, ERRETM, ETA, MIDPT, PHI, PREW, PSI,
- $ RHOINV, TAU, TEMP, TEMP1, W
-* ..
-* .. Local Arrays ..
- REAL ZZ( 3 )
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAED5, SLAED6
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Since this routine is called in an inner loop, we do no argument
-* checking.
-*
-* Quick return for N=1 and 2.
-*
- INFO = 0
- IF( N.EQ.1 ) THEN
-*
-* Presumably, I=1 upon entry
-*
- DLAM = D( 1 ) + RHO*Z( 1 )*Z( 1 )
- DELTA( 1 ) = ONE
- RETURN
- END IF
- IF( N.EQ.2 ) THEN
- CALL SLAED5( I, D, Z, DELTA, RHO, DLAM )
- RETURN
- END IF
-*
-* Compute machine epsilon
-*
- EPS = SLAMCH( 'Epsilon' )
- RHOINV = ONE / RHO
-*
-* The case I = N
-*
- IF( I.EQ.N ) THEN
-*
-* Initialize some basic variables
-*
- II = N - 1
- NITER = 1
-*
-* Calculate initial guess
-*
- MIDPT = RHO / TWO
-*
-* If ||Z||_2 is not one, then TEMP should be set to
-* RHO * ||Z||_2^2 / TWO
-*
- DO 10 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - MIDPT
- 10 CONTINUE
-*
- PSI = ZERO
- DO 20 J = 1, N - 2
- PSI = PSI + Z( J )*Z( J ) / DELTA( J )
- 20 CONTINUE
-*
- C = RHOINV + PSI
- W = C + Z( II )*Z( II ) / DELTA( II ) +
- $ Z( N )*Z( N ) / DELTA( N )
-*
- IF( W.LE.ZERO ) THEN
- TEMP = Z( N-1 )*Z( N-1 ) / ( D( N )-D( N-1 )+RHO ) +
- $ Z( N )*Z( N ) / RHO
- IF( C.LE.TEMP ) THEN
- TAU = RHO
- ELSE
- DEL = D( N ) - D( N-1 )
- A = -C*DEL + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DEL
- IF( A.LT.ZERO ) THEN
- TAU = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
- END IF
-*
-* It can be proved that
-* D(N)+RHO/2 <= LAMBDA(N) < D(N)+TAU <= D(N)+RHO
-*
- DLTLB = MIDPT
- DLTUB = RHO
- ELSE
- DEL = D( N ) - D( N-1 )
- A = -C*DEL + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DEL
- IF( A.LT.ZERO ) THEN
- TAU = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
-*
-* It can be proved that
-* D(N) < D(N)+TAU < LAMBDA(N) < D(N)+RHO/2
-*
- DLTLB = ZERO
- DLTUB = MIDPT
- END IF
-*
- DO 30 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - TAU
- 30 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 40 J = 1, II
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 40 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / DELTA( N )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +
- $ ABS( TAU )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- DLAM = D( I ) + TAU
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- C = W - DELTA( N-1 )*DPSI - DELTA( N )*DPHI
- A = ( DELTA( N-1 )+DELTA( N ) )*W -
- $ DELTA( N-1 )*DELTA( N )*( DPSI+DPHI )
- B = DELTA( N-1 )*DELTA( N )*W
- IF( C.LT.ZERO )
- $ C = ABS( C )
- IF( C.EQ.ZERO ) THEN
-* ETA = B/A
-* ETA = RHO - TAU
- ETA = DLTUB - TAU
- ELSE IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
- DO 50 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 50 CONTINUE
-*
- TAU = TAU + ETA
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 60 J = 1, II
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 60 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / DELTA( N )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +
- $ ABS( TAU )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Main loop to update the values of the array DELTA
-*
- ITER = NITER + 1
-*
- DO 90 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- DLAM = D( I ) + TAU
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- C = W - DELTA( N-1 )*DPSI - DELTA( N )*DPHI
- A = ( DELTA( N-1 )+DELTA( N ) )*W -
- $ DELTA( N-1 )*DELTA( N )*( DPSI+DPHI )
- B = DELTA( N-1 )*DELTA( N )*W
- IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
- DO 70 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 70 CONTINUE
-*
- TAU = TAU + ETA
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 80 J = 1, II
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 80 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / DELTA( N )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +
- $ ABS( TAU )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
- 90 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
- DLAM = D( I ) + TAU
- GO TO 250
-*
-* End for the case I = N
-*
- ELSE
-*
-* The case for I < N
-*
- NITER = 1
- IP1 = I + 1
-*
-* Calculate initial guess
-*
- DEL = D( IP1 ) - D( I )
- MIDPT = DEL / TWO
- DO 100 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - MIDPT
- 100 CONTINUE
-*
- PSI = ZERO
- DO 110 J = 1, I - 1
- PSI = PSI + Z( J )*Z( J ) / DELTA( J )
- 110 CONTINUE
-*
- PHI = ZERO
- DO 120 J = N, I + 2, -1
- PHI = PHI + Z( J )*Z( J ) / DELTA( J )
- 120 CONTINUE
- C = RHOINV + PSI + PHI
- W = C + Z( I )*Z( I ) / DELTA( I ) +
- $ Z( IP1 )*Z( IP1 ) / DELTA( IP1 )
-*
- IF( W.GT.ZERO ) THEN
-*
-* d(i)< the ith eigenvalue < (d(i)+d(i+1))/2
-*
-* We choose d(i) as origin.
-*
- ORGATI = .TRUE.
- A = C*DEL + Z( I )*Z( I ) + Z( IP1 )*Z( IP1 )
- B = Z( I )*Z( I )*DEL
- IF( A.GT.ZERO ) THEN
- TAU = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- ELSE
- TAU = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- END IF
- DLTLB = ZERO
- DLTUB = MIDPT
- ELSE
-*
-* (d(i)+d(i+1))/2 <= the ith eigenvalue < d(i+1)
-*
-* We choose d(i+1) as origin.
-*
- ORGATI = .FALSE.
- A = C*DEL - Z( I )*Z( I ) - Z( IP1 )*Z( IP1 )
- B = Z( IP1 )*Z( IP1 )*DEL
- IF( A.LT.ZERO ) THEN
- TAU = TWO*B / ( A-SQRT( ABS( A*A+FOUR*B*C ) ) )
- ELSE
- TAU = -( A+SQRT( ABS( A*A+FOUR*B*C ) ) ) / ( TWO*C )
- END IF
- DLTLB = -MIDPT
- DLTUB = ZERO
- END IF
-*
- IF( ORGATI ) THEN
- DO 130 J = 1, N
- DELTA( J ) = ( D( J )-D( I ) ) - TAU
- 130 CONTINUE
- ELSE
- DO 140 J = 1, N
- DELTA( J ) = ( D( J )-D( IP1 ) ) - TAU
- 140 CONTINUE
- END IF
- IF( ORGATI ) THEN
- II = I
- ELSE
- II = I + 1
- END IF
- IIM1 = II - 1
- IIP1 = II + 1
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 150 J = 1, IIM1
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 150 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 160 J = N, IIP1, -1
- TEMP = Z( J ) / DELTA( J )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 160 CONTINUE
-*
- W = RHOINV + PHI + PSI
-*
-* W is the value of the secular function with
-* its ii-th element removed.
-*
- SWTCH3 = .FALSE.
- IF( ORGATI ) THEN
- IF( W.LT.ZERO )
- $ SWTCH3 = .TRUE.
- ELSE
- IF( W.GT.ZERO )
- $ SWTCH3 = .TRUE.
- END IF
- IF( II.EQ.1 .OR. II.EQ.N )
- $ SWTCH3 = .FALSE.
-*
- TEMP = Z( II ) / DELTA( II )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = W + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV +
- $ THREE*ABS( TEMP ) + ABS( TAU )*DW
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- IF( ORGATI ) THEN
- DLAM = D( I ) + TAU
- ELSE
- DLAM = D( IP1 ) + TAU
- END IF
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- IF( .NOT.SWTCH3 ) THEN
- IF( ORGATI ) THEN
- C = W - DELTA( IP1 )*DW - ( D( I )-D( IP1 ) )*
- $ ( Z( I ) / DELTA( I ) )**2
- ELSE
- C = W - DELTA( I )*DW - ( D( IP1 )-D( I ) )*
- $ ( Z( IP1 ) / DELTA( IP1 ) )**2
- END IF
- A = ( DELTA( I )+DELTA( IP1 ) )*W -
- $ DELTA( I )*DELTA( IP1 )*DW
- B = DELTA( I )*DELTA( IP1 )*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DELTA( IP1 )*DELTA( IP1 )*
- $ ( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) + DELTA( I )*DELTA( I )*
- $ ( DPSI+DPHI )
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- TEMP = RHOINV + PSI + PHI
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DELTA( IIM1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIP1 )*( DPSI+DPHI ) -
- $ ( D( IIM1 )-D( IIP1 ) )*TEMP1
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- ZZ( 3 ) = DELTA( IIP1 )*DELTA( IIP1 )*
- $ ( ( DPSI-TEMP1 )+DPHI )
- ELSE
- TEMP1 = Z( IIP1 ) / DELTA( IIP1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIM1 )*( DPSI+DPHI ) -
- $ ( D( IIP1 )-D( IIM1 ) )*TEMP1
- ZZ( 1 ) = DELTA( IIM1 )*DELTA( IIM1 )*
- $ ( DPSI+( DPHI-TEMP1 ) )
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- ZZ( 2 ) = Z( II )*Z( II )
- CALL SLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, ETA,
- $ INFO )
- IF( INFO.NE.0 )
- $ GO TO 250
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
-*
- PREW = W
-*
- DO 180 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 180 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 190 J = 1, IIM1
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 190 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 200 J = N, IIP1, -1
- TEMP = Z( J ) / DELTA( J )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 200 CONTINUE
-*
- TEMP = Z( II ) / DELTA( II )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV +
- $ THREE*ABS( TEMP ) + ABS( TAU+ETA )*DW
-*
- SWTCH = .FALSE.
- IF( ORGATI ) THEN
- IF( -W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- ELSE
- IF( W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- END IF
-*
- TAU = TAU + ETA
-*
-* Main loop to update the values of the array DELTA
-*
- ITER = NITER + 1
-*
- DO 240 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- IF( ORGATI ) THEN
- DLAM = D( I ) + TAU
- ELSE
- DLAM = D( IP1 ) + TAU
- END IF
- GO TO 250
- END IF
-*
- IF( W.LE.ZERO ) THEN
- DLTLB = MAX( DLTLB, TAU )
- ELSE
- DLTUB = MIN( DLTUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- IF( .NOT.SWTCH3 ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- C = W - DELTA( IP1 )*DW -
- $ ( D( I )-D( IP1 ) )*( Z( I ) / DELTA( I ) )**2
- ELSE
- C = W - DELTA( I )*DW - ( D( IP1 )-D( I ) )*
- $ ( Z( IP1 ) / DELTA( IP1 ) )**2
- END IF
- ELSE
- TEMP = Z( II ) / DELTA( II )
- IF( ORGATI ) THEN
- DPSI = DPSI + TEMP*TEMP
- ELSE
- DPHI = DPHI + TEMP*TEMP
- END IF
- C = W - DELTA( I )*DPSI - DELTA( IP1 )*DPHI
- END IF
- A = ( DELTA( I )+DELTA( IP1 ) )*W -
- $ DELTA( I )*DELTA( IP1 )*DW
- B = DELTA( I )*DELTA( IP1 )*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DELTA( IP1 )*
- $ DELTA( IP1 )*( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) +
- $ DELTA( I )*DELTA( I )*( DPSI+DPHI )
- END IF
- ELSE
- A = DELTA( I )*DELTA( I )*DPSI +
- $ DELTA( IP1 )*DELTA( IP1 )*DPHI
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- TEMP = RHOINV + PSI + PHI
- IF( SWTCH ) THEN
- C = TEMP - DELTA( IIM1 )*DPSI - DELTA( IIP1 )*DPHI
- ZZ( 1 ) = DELTA( IIM1 )*DELTA( IIM1 )*DPSI
- ZZ( 3 ) = DELTA( IIP1 )*DELTA( IIP1 )*DPHI
- ELSE
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DELTA( IIM1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIP1 )*( DPSI+DPHI ) -
- $ ( D( IIM1 )-D( IIP1 ) )*TEMP1
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- ZZ( 3 ) = DELTA( IIP1 )*DELTA( IIP1 )*
- $ ( ( DPSI-TEMP1 )+DPHI )
- ELSE
- TEMP1 = Z( IIP1 ) / DELTA( IIP1 )
- TEMP1 = TEMP1*TEMP1
- C = TEMP - DELTA( IIM1 )*( DPSI+DPHI ) -
- $ ( D( IIP1 )-D( IIM1 ) )*TEMP1
- ZZ( 1 ) = DELTA( IIM1 )*DELTA( IIM1 )*
- $ ( DPSI+( DPHI-TEMP1 ) )
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- END IF
- CALL SLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, ETA,
- $ INFO )
- IF( INFO.NE.0 )
- $ GO TO 250
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
- TEMP = TAU + ETA
- IF( TEMP.GT.DLTUB .OR. TEMP.LT.DLTLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( DLTUB-TAU ) / TWO
- ELSE
- ETA = ( DLTLB-TAU ) / TWO
- END IF
- END IF
-*
- DO 210 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- 210 CONTINUE
-*
- TAU = TAU + ETA
- PREW = W
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 220 J = 1, IIM1
- TEMP = Z( J ) / DELTA( J )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 220 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 230 J = N, IIP1, -1
- TEMP = Z( J ) / DELTA( J )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 230 CONTINUE
-*
- TEMP = Z( II ) / DELTA( II )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV +
- $ THREE*ABS( TEMP ) + ABS( TAU )*DW
- IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN )
- $ SWTCH = .NOT.SWTCH
-*
- 240 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
- IF( ORGATI ) THEN
- DLAM = D( I ) + TAU
- ELSE
- DLAM = D( IP1 ) + TAU
- END IF
-*
- END IF
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of SLAED4
-*
- END
diff --git a/netlib/LAPACK/slaed5.f b/netlib/LAPACK/slaed5.f
deleted file mode 100644
index d5573b4..0000000
--- a/netlib/LAPACK/slaed5.f
+++ /dev/null
@@ -1,189 +0,0 @@
-*> \brief \b SLAED5 used by sstedc. Solves the 2-by-2 secular equation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED5( I, D, Z, DELTA, RHO, DLAM )
-*
-* .. Scalar Arguments ..
-* INTEGER I
-* REAL DLAM, RHO
-* ..
-* .. Array Arguments ..
-* REAL D( 2 ), DELTA( 2 ), Z( 2 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the I-th eigenvalue of a symmetric rank-one
-*> modification of a 2-by-2 diagonal matrix
-*>
-*> diag( D ) + RHO * Z * transpose(Z) .
-*>
-*> The diagonal elements in the array D are assumed to satisfy
-*>
-*> D(i) < D(j) for i < j .
-*>
-*> We also assume RHO > 0 and that the Euclidean norm of the vector
-*> Z is one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. I = 1 or I = 2.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (2)
-*> The original eigenvalues. We assume D(1) < D(2).
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (2)
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is REAL array, dimension (2)
-*> The vector DELTA contains the information necessary
-*> to construct the eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] DLAM
-*> \verbatim
-*> DLAM is REAL
-*> The computed lambda_I, the I-th updated eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLAED5( I, D, Z, DELTA, RHO, DLAM )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I
- REAL DLAM, RHO
-* ..
-* .. Array Arguments ..
- REAL D( 2 ), DELTA( 2 ), Z( 2 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, FOUR
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ FOUR = 4.0E0 )
-* ..
-* .. Local Scalars ..
- REAL B, C, DEL, TAU, TEMP, W
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- DEL = D( 2 ) - D( 1 )
- IF( I.EQ.1 ) THEN
- W = ONE + TWO*RHO*( Z( 2 )*Z( 2 )-Z( 1 )*Z( 1 ) ) / DEL
- IF( W.GT.ZERO ) THEN
- B = DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 1 )*Z( 1 )*DEL
-*
-* B > ZERO, always
-*
- TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) )
- DLAM = D( 1 ) + TAU
- DELTA( 1 ) = -Z( 1 ) / TAU
- DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
- ELSE
- B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DEL
- IF( B.GT.ZERO ) THEN
- TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) )
- ELSE
- TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO
- END IF
- DLAM = D( 2 ) + TAU
- DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
- DELTA( 2 ) = -Z( 2 ) / TAU
- END IF
- TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
- DELTA( 1 ) = DELTA( 1 ) / TEMP
- DELTA( 2 ) = DELTA( 2 ) / TEMP
- ELSE
-*
-* Now I=2
-*
- B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DEL
- IF( B.GT.ZERO ) THEN
- TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO
- ELSE
- TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) )
- END IF
- DLAM = D( 2 ) + TAU
- DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
- DELTA( 2 ) = -Z( 2 ) / TAU
- TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
- DELTA( 1 ) = DELTA( 1 ) / TEMP
- DELTA( 2 ) = DELTA( 2 ) / TEMP
- END IF
- RETURN
-*
-* End OF SLAED5
-*
- END
diff --git a/netlib/LAPACK/slaed6.f b/netlib/LAPACK/slaed6.f
deleted file mode 100644
index 10e3641..0000000
--- a/netlib/LAPACK/slaed6.f
+++ /dev/null
@@ -1,409 +0,0 @@
-*> \brief \b SLAED6 used by sstedc. Computes one Newton step in solution of the secular equation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL ORGATI
-* INTEGER INFO, KNITER
-* REAL FINIT, RHO, TAU
-* ..
-* .. Array Arguments ..
-* REAL D( 3 ), Z( 3 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED6 computes the positive or negative root (closest to the origin)
-*> of
-*> z(1) z(2) z(3)
-*> f(x) = rho + --------- + ---------- + ---------
-*> d(1)-x d(2)-x d(3)-x
-*>
-*> It is assumed that
-*>
-*> if ORGATI = .true. the root is between d(2) and d(3);
-*> otherwise it is between d(1) and d(2)
-*>
-*> This routine will be called by SLAED4 when necessary. In most cases,
-*> the root sought is the smallest in magnitude, though it might not be
-*> in some extremely rare situations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] KNITER
-*> \verbatim
-*> KNITER is INTEGER
-*> Refer to SLAED4 for its significance.
-*> \endverbatim
-*>
-*> \param[in] ORGATI
-*> \verbatim
-*> ORGATI is LOGICAL
-*> If ORGATI is true, the needed root is between d(2) and
-*> d(3); otherwise it is between d(1) and d(2). See
-*> SLAED4 for further details.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> Refer to the equation f(x) above.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (3)
-*> D satisfies d(1) < d(2) < d(3).
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (3)
-*> Each of the elements in z must be positive.
-*> \endverbatim
-*>
-*> \param[in] FINIT
-*> \verbatim
-*> FINIT is REAL
-*> The value of f at 0. It is more accurate than the one
-*> evaluated inside this routine (if someone wants to do
-*> so).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL
-*> The root of the equation f(x).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = 1, failure to converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> 10/02/03: This version has a few statements commented out for thread
-*> safety (machine parameters are computed on each entry). SJH.
-*>
-*> 05/10/06: Modified from a new version of Ren-Cang Li, use
-*> Gragg-Thornton-Warner cubic convergent scheme for better stability.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL ORGATI
- INTEGER INFO, KNITER
- REAL FINIT, RHO, TAU
-* ..
-* .. Array Arguments ..
- REAL D( 3 ), Z( 3 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 40 )
- REAL ZERO, ONE, TWO, THREE, FOUR, EIGHT
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ THREE = 3.0E0, FOUR = 4.0E0, EIGHT = 8.0E0 )
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Local Arrays ..
- REAL DSCALE( 3 ), ZSCALE( 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL SCALE
- INTEGER I, ITER, NITER
- REAL A, B, BASE, C, DDF, DF, EPS, ERRETM, ETA, F,
- $ FC, SCLFAC, SCLINV, SMALL1, SMALL2, SMINV1,
- $ SMINV2, TEMP, TEMP1, TEMP2, TEMP3, TEMP4,
- $ LBD, UBD
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
- IF( ORGATI ) THEN
- LBD = D(2)
- UBD = D(3)
- ELSE
- LBD = D(1)
- UBD = D(2)
- END IF
- IF( FINIT .LT. ZERO )THEN
- LBD = ZERO
- ELSE
- UBD = ZERO
- END IF
-*
- NITER = 1
- TAU = ZERO
- IF( KNITER.EQ.2 ) THEN
- IF( ORGATI ) THEN
- TEMP = ( D( 3 )-D( 2 ) ) / TWO
- C = RHO + Z( 1 ) / ( ( D( 1 )-D( 2 ) )-TEMP )
- A = C*( D( 2 )+D( 3 ) ) + Z( 2 ) + Z( 3 )
- B = C*D( 2 )*D( 3 ) + Z( 2 )*D( 3 ) + Z( 3 )*D( 2 )
- ELSE
- TEMP = ( D( 1 )-D( 2 ) ) / TWO
- C = RHO + Z( 3 ) / ( ( D( 3 )-D( 2 ) )-TEMP )
- A = C*( D( 1 )+D( 2 ) ) + Z( 1 ) + Z( 2 )
- B = C*D( 1 )*D( 2 ) + Z( 1 )*D( 2 ) + Z( 2 )*D( 1 )
- END IF
- TEMP = MAX( ABS( A ), ABS( B ), ABS( C ) )
- A = A / TEMP
- B = B / TEMP
- C = C / TEMP
- IF( C.EQ.ZERO ) THEN
- TAU = B / A
- ELSE IF( A.LE.ZERO ) THEN
- TAU = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- TAU = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- IF( TAU .LT. LBD .OR. TAU .GT. UBD )
- $ TAU = ( LBD+UBD )/TWO
- IF( D(1).EQ.TAU .OR. D(2).EQ.TAU .OR. D(3).EQ.TAU ) THEN
- TAU = ZERO
- ELSE
- TEMP = FINIT + TAU*Z(1)/( D(1)*( D( 1 )-TAU ) ) +
- $ TAU*Z(2)/( D(2)*( D( 2 )-TAU ) ) +
- $ TAU*Z(3)/( D(3)*( D( 3 )-TAU ) )
- IF( TEMP .LE. ZERO )THEN
- LBD = TAU
- ELSE
- UBD = TAU
- END IF
- IF( ABS( FINIT ).LE.ABS( TEMP ) )
- $ TAU = ZERO
- END IF
- END IF
-*
-* get machine parameters for possible scaling to avoid overflow
-*
-* modified by Sven: parameters SMALL1, SMINV1, SMALL2,
-* SMINV2, EPS are not SAVEd anymore between one call to the
-* others but recomputed at each call
-*
- EPS = SLAMCH( 'Epsilon' )
- BASE = SLAMCH( 'Base' )
- SMALL1 = BASE**( INT( LOG( SLAMCH( 'SafMin' ) ) / LOG( BASE ) /
- $ THREE ) )
- SMINV1 = ONE / SMALL1
- SMALL2 = SMALL1*SMALL1
- SMINV2 = SMINV1*SMINV1
-*
-* Determine if scaling of inputs necessary to avoid overflow
-* when computing 1/TEMP**3
-*
- IF( ORGATI ) THEN
- TEMP = MIN( ABS( D( 2 )-TAU ), ABS( D( 3 )-TAU ) )
- ELSE
- TEMP = MIN( ABS( D( 1 )-TAU ), ABS( D( 2 )-TAU ) )
- END IF
- SCALE = .FALSE.
- IF( TEMP.LE.SMALL1 ) THEN
- SCALE = .TRUE.
- IF( TEMP.LE.SMALL2 ) THEN
-*
-* Scale up by power of radix nearest 1/SAFMIN**(2/3)
-*
- SCLFAC = SMINV2
- SCLINV = SMALL2
- ELSE
-*
-* Scale up by power of radix nearest 1/SAFMIN**(1/3)
-*
- SCLFAC = SMINV1
- SCLINV = SMALL1
- END IF
-*
-* Scaling up safe because D, Z, TAU scaled elsewhere to be O(1)
-*
- DO 10 I = 1, 3
- DSCALE( I ) = D( I )*SCLFAC
- ZSCALE( I ) = Z( I )*SCLFAC
- 10 CONTINUE
- TAU = TAU*SCLFAC
- LBD = LBD*SCLFAC
- UBD = UBD*SCLFAC
- ELSE
-*
-* Copy D and Z to DSCALE and ZSCALE
-*
- DO 20 I = 1, 3
- DSCALE( I ) = D( I )
- ZSCALE( I ) = Z( I )
- 20 CONTINUE
- END IF
-*
- FC = ZERO
- DF = ZERO
- DDF = ZERO
- DO 30 I = 1, 3
- TEMP = ONE / ( DSCALE( I )-TAU )
- TEMP1 = ZSCALE( I )*TEMP
- TEMP2 = TEMP1*TEMP
- TEMP3 = TEMP2*TEMP
- FC = FC + TEMP1 / DSCALE( I )
- DF = DF + TEMP2
- DDF = DDF + TEMP3
- 30 CONTINUE
- F = FINIT + TAU*FC
-*
- IF( ABS( F ).LE.ZERO )
- $ GO TO 60
- IF( F .LE. ZERO )THEN
- LBD = TAU
- ELSE
- UBD = TAU
- END IF
-*
-* Iteration begins -- Use Gragg-Thornton-Warner cubic convergent
-* scheme
-*
-* It is not hard to see that
-*
-* 1) Iterations will go up monotonically
-* if FINIT < 0;
-*
-* 2) Iterations will go down monotonically
-* if FINIT > 0.
-*
- ITER = NITER + 1
-*
- DO 50 NITER = ITER, MAXIT
-*
- IF( ORGATI ) THEN
- TEMP1 = DSCALE( 2 ) - TAU
- TEMP2 = DSCALE( 3 ) - TAU
- ELSE
- TEMP1 = DSCALE( 1 ) - TAU
- TEMP2 = DSCALE( 2 ) - TAU
- END IF
- A = ( TEMP1+TEMP2 )*F - TEMP1*TEMP2*DF
- B = TEMP1*TEMP2*F
- C = F - ( TEMP1+TEMP2 )*DF + TEMP1*TEMP2*DDF
- TEMP = MAX( ABS( A ), ABS( B ), ABS( C ) )
- A = A / TEMP
- B = B / TEMP
- C = C / TEMP
- IF( C.EQ.ZERO ) THEN
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- IF( F*ETA.GE.ZERO ) THEN
- ETA = -F / DF
- END IF
-*
- TAU = TAU + ETA
- IF( TAU .LT. LBD .OR. TAU .GT. UBD )
- $ TAU = ( LBD + UBD )/TWO
-*
- FC = ZERO
- ERRETM = ZERO
- DF = ZERO
- DDF = ZERO
- DO 40 I = 1, 3
- IF ( ( DSCALE( I )-TAU ).NE.ZERO ) THEN
- TEMP = ONE / ( DSCALE( I )-TAU )
- TEMP1 = ZSCALE( I )*TEMP
- TEMP2 = TEMP1*TEMP
- TEMP3 = TEMP2*TEMP
- TEMP4 = TEMP1 / DSCALE( I )
- FC = FC + TEMP4
- ERRETM = ERRETM + ABS( TEMP4 )
- DF = DF + TEMP2
- DDF = DDF + TEMP3
- ELSE
- GO TO 60
- END IF
- 40 CONTINUE
- F = FINIT + TAU*FC
- ERRETM = EIGHT*( ABS( FINIT )+ABS( TAU )*ERRETM ) +
- $ ABS( TAU )*DF
- IF( ABS( F ).LE.EPS*ERRETM )
- $ GO TO 60
- IF( F .LE. ZERO )THEN
- LBD = TAU
- ELSE
- UBD = TAU
- END IF
- 50 CONTINUE
- INFO = 1
- 60 CONTINUE
-*
-* Undo scaling
-*
- IF( SCALE )
- $ TAU = TAU*SCLINV
- RETURN
-*
-* End of SLAED6
-*
- END
diff --git a/netlib/LAPACK/slaed7.f b/netlib/LAPACK/slaed7.f
deleted file mode 100644
index 766e1c7..0000000
--- a/netlib/LAPACK/slaed7.f
+++ /dev/null
@@ -1,407 +0,0 @@
-*> \brief \b SLAED7 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED7 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed7.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed7.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed7.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
-* LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR,
-* PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N,
-* $ QSIZ, TLVLS
-* REAL RHO
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ),
-* $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * )
-* REAL D( * ), GIVNUM( 2, * ), Q( LDQ, * ),
-* $ QSTORE( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED7 computes the updated eigensystem of a diagonal
-*> matrix after modification by a rank-one symmetric matrix. This
-*> routine is used only for the eigenproblem which requires all
-*> eigenvalues and optionally eigenvectors of a dense symmetric matrix
-*> that has been reduced to tridiagonal form. SLAED1 handles
-*> the case in which all eigenvalues and eigenvectors of a symmetric
-*> tridiagonal matrix are desired.
-*>
-*> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out)
-*>
-*> where Z = Q**Tu, u is a vector of length N with ones in the
-*> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
-*>
-*> The eigenvectors of the original matrix are stored in Q, and the
-*> eigenvalues are in D. The algorithm consists of three stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple eigenvalues or if there is a zero in
-*> the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine SLAED8.
-*>
-*> The second stage consists of calculating the updated
-*> eigenvalues. This is done by finding the roots of the secular
-*> equation via the routine SLAED4 (as called by SLAED9).
-*> This routine also calculates the eigenvectors of the current
-*> problem.
-*>
-*> The final stage consists of computing the updated eigenvectors
-*> directly using the updated eigenvalues. The eigenvectors for
-*> the current problem are multiplied with the eigenvectors from
-*> the overall problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> = 0: Compute eigenvalues only.
-*> = 1: Compute eigenvectors of original dense symmetric matrix
-*> also. On entry, Q contains the orthogonal matrix used
-*> to reduce the original matrix to tridiagonal form.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] QSIZ
-*> \verbatim
-*> QSIZ is INTEGER
-*> The dimension of the orthogonal matrix used to reduce
-*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
-*> \endverbatim
-*>
-*> \param[in] TLVLS
-*> \verbatim
-*> TLVLS is INTEGER
-*> The total number of merging levels in the overall divide and
-*> conquer tree.
-*> \endverbatim
-*>
-*> \param[in] CURLVL
-*> \verbatim
-*> CURLVL is INTEGER
-*> The current level in the overall merge routine,
-*> 0 <= CURLVL <= TLVLS.
-*> \endverbatim
-*>
-*> \param[in] CURPBM
-*> \verbatim
-*> CURPBM is INTEGER
-*> The current problem in the current level in the overall
-*> merge routine (counting from upper left to lower right).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the eigenvalues of the rank-1-perturbed matrix.
-*> On exit, the eigenvalues of the repaired matrix.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> On entry, the eigenvectors of the rank-1-perturbed matrix.
-*> On exit, the eigenvectors of the repaired tridiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> The permutation which will reintegrate the subproblem just
-*> solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
-*> will be in ascending order.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The subdiagonal element used to create the rank-1
-*> modification.
-*> \endverbatim
-*>
-*> \param[in] CUTPNT
-*> \verbatim
-*> CUTPNT is INTEGER
-*> Contains the location of the last eigenvalue in the leading
-*> sub-matrix. min(1,N) <= CUTPNT <= N.
-*> \endverbatim
-*>
-*> \param[in,out] QSTORE
-*> \verbatim
-*> QSTORE is REAL array, dimension (N**2+1)
-*> Stores eigenvectors of submatrices encountered during
-*> divide and conquer, packed together. QPTR points to
-*> beginning of the submatrices.
-*> \endverbatim
-*>
-*> \param[in,out] QPTR
-*> \verbatim
-*> QPTR is INTEGER array, dimension (N+2)
-*> List of indices pointing to beginning of submatrices stored
-*> in QSTORE. The submatrices are numbered starting at the
-*> bottom left of the divide and conquer tree, from left to
-*> right and bottom to top.
-*> \endverbatim
-*>
-*> \param[in] PRMPTR
-*> \verbatim
-*> PRMPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in PERM a
-*> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
-*> indicates the size of the permutation and also the size of
-*> the full, non-deflated problem.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension (N lg N)
-*> Contains the permutations (from deflation and sorting) to be
-*> applied to each eigenblock.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in GIVCOL a
-*> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
-*> indicates the number of Givens rotations.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension (2, N lg N)
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension (2, N lg N)
-*> Each number indicates the S value to be used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N+2*QSIZ*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
- $ LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR,
- $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N,
- $ QSIZ, TLVLS
- REAL RHO
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ),
- $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * )
- REAL D( * ), GIVNUM( 2, * ), Q( LDQ, * ),
- $ QSTORE( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER COLTYP, CURR, I, IDLMDA, INDX, INDXC, INDXP,
- $ IQ2, IS, IW, IZ, K, LDQ2, N1, N2, PTR
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLAED8, SLAED9, SLAEDA, SLAMRG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ICOMPQ.EQ.1 .AND. QSIZ.LT.N ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( MIN( 1, N ).GT.CUTPNT .OR. N.LT.CUTPNT ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED7', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* The following values are for bookkeeping purposes only. They are
-* integer pointers which indicate the portion of the workspace
-* used by a particular array in SLAED8 and SLAED9.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- LDQ2 = QSIZ
- ELSE
- LDQ2 = N
- END IF
-*
- IZ = 1
- IDLMDA = IZ + N
- IW = IDLMDA + N
- IQ2 = IW + N
- IS = IQ2 + N*LDQ2
-*
- INDX = 1
- INDXC = INDX + N
- COLTYP = INDXC + N
- INDXP = COLTYP + N
-*
-* Form the z-vector which consists of the last row of Q_1 and the
-* first row of Q_2.
-*
- PTR = 1 + 2**TLVLS
- DO 10 I = 1, CURLVL - 1
- PTR = PTR + 2**( TLVLS-I )
- 10 CONTINUE
- CURR = PTR + CURPBM
- CALL SLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
- $ GIVCOL, GIVNUM, QSTORE, QPTR, WORK( IZ ),
- $ WORK( IZ+N ), INFO )
-*
-* When solving the final problem, we no longer need the stored data,
-* so we will overwrite the data from this level onto the previously
-* used storage space.
-*
- IF( CURLVL.EQ.TLVLS ) THEN
- QPTR( CURR ) = 1
- PRMPTR( CURR ) = 1
- GIVPTR( CURR ) = 1
- END IF
-*
-* Sort and Deflate eigenvalues.
-*
- CALL SLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, CUTPNT,
- $ WORK( IZ ), WORK( IDLMDA ), WORK( IQ2 ), LDQ2,
- $ WORK( IW ), PERM( PRMPTR( CURR ) ), GIVPTR( CURR+1 ),
- $ GIVCOL( 1, GIVPTR( CURR ) ),
- $ GIVNUM( 1, GIVPTR( CURR ) ), IWORK( INDXP ),
- $ IWORK( INDX ), INFO )
- PRMPTR( CURR+1 ) = PRMPTR( CURR ) + N
- GIVPTR( CURR+1 ) = GIVPTR( CURR+1 ) + GIVPTR( CURR )
-*
-* Solve Secular Equation.
-*
- IF( K.NE.0 ) THEN
- CALL SLAED9( K, 1, K, N, D, WORK( IS ), K, RHO, WORK( IDLMDA ),
- $ WORK( IW ), QSTORE( QPTR( CURR ) ), K, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
- IF( ICOMPQ.EQ.1 ) THEN
- CALL SGEMM( 'N', 'N', QSIZ, K, K, ONE, WORK( IQ2 ), LDQ2,
- $ QSTORE( QPTR( CURR ) ), K, ZERO, Q, LDQ )
- END IF
- QPTR( CURR+1 ) = QPTR( CURR ) + K**2
-*
-* Prepare the INDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL SLAMRG( N1, N2, D, 1, -1, INDXQ )
- ELSE
- QPTR( CURR+1 ) = QPTR( CURR )
- DO 20 I = 1, N
- INDXQ( I ) = I
- 20 CONTINUE
- END IF
-*
- 30 CONTINUE
- RETURN
-*
-* End of SLAED7
-*
- END
diff --git a/netlib/LAPACK/slaed8.f b/netlib/LAPACK/slaed8.f
deleted file mode 100644
index c9446d2..0000000
--- a/netlib/LAPACK/slaed8.f
+++ /dev/null
@@ -1,524 +0,0 @@
-*> \brief \b SLAED8 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED8 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed8.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed8.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed8.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO,
-* CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR,
-* GIVCOL, GIVNUM, INDXP, INDX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N,
-* $ QSIZ
-* REAL RHO
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ),
-* $ INDXQ( * ), PERM( * )
-* REAL D( * ), DLAMDA( * ), GIVNUM( 2, * ),
-* $ Q( LDQ, * ), Q2( LDQ2, * ), W( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED8 merges the two sets of eigenvalues together into a single
-*> sorted set. Then it tries to deflate the size of the problem.
-*> There are two ways in which deflation can occur: when two or more
-*> eigenvalues are close together or if there is a tiny element in the
-*> Z vector. For each such occurrence the order of the related secular
-*> equation problem is reduced by one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> = 0: Compute eigenvalues only.
-*> = 1: Compute eigenvectors of original dense symmetric matrix
-*> also. On entry, Q contains the orthogonal matrix used
-*> to reduce the original matrix to tridiagonal form.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> The number of non-deflated eigenvalues, and the order of the
-*> related secular equation.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] QSIZ
-*> \verbatim
-*> QSIZ is INTEGER
-*> The dimension of the orthogonal matrix used to reduce
-*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the eigenvalues of the two submatrices to be
-*> combined. On exit, the trailing (N-K) updated eigenvalues
-*> (those which were deflated) sorted into increasing order.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> If ICOMPQ = 0, Q is not referenced. Otherwise,
-*> on entry, Q contains the eigenvectors of the partially solved
-*> system which has been previously updated in matrix
-*> multiplies with other partially solved eigensystems.
-*> On exit, Q contains the trailing (N-K) updated eigenvectors
-*> (those which were deflated) in its last N-K columns.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] INDXQ
-*> \verbatim
-*> INDXQ is INTEGER array, dimension (N)
-*> The permutation which separately sorts the two sub-problems
-*> in D into ascending order. Note that elements in the second
-*> half of this permutation must first have CUTPNT added to
-*> their values in order to be accurate.
-*> \endverbatim
-*>
-*> \param[in,out] RHO
-*> \verbatim
-*> RHO is REAL
-*> On entry, the off-diagonal element associated with the rank-1
-*> cut which originally split the two submatrices which are now
-*> being recombined.
-*> On exit, RHO has been modified to the value required by
-*> SLAED3.
-*> \endverbatim
-*>
-*> \param[in] CUTPNT
-*> \verbatim
-*> CUTPNT is INTEGER
-*> The location of the last eigenvalue in the leading
-*> sub-matrix. min(1,N) <= CUTPNT <= N.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (N)
-*> On entry, Z contains the updating vector (the last row of
-*> the first sub-eigenvector matrix and the first row of the
-*> second sub-eigenvector matrix).
-*> On exit, the contents of Z are destroyed by the updating
-*> process.
-*> \endverbatim
-*>
-*> \param[out] DLAMDA
-*> \verbatim
-*> DLAMDA is REAL array, dimension (N)
-*> A copy of the first K eigenvalues which will be used by
-*> SLAED3 to form the secular equation.
-*> \endverbatim
-*>
-*> \param[out] Q2
-*> \verbatim
-*> Q2 is REAL array, dimension (LDQ2,N)
-*> If ICOMPQ = 0, Q2 is not referenced. Otherwise,
-*> a copy of the first K eigenvectors which will be used by
-*> SLAED7 in a matrix multiply (SGEMM) to update the new
-*> eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDQ2
-*> \verbatim
-*> LDQ2 is INTEGER
-*> The leading dimension of the array Q2. LDQ2 >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first k values of the final deflation-altered z-vector and
-*> will be passed to SLAED3.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension (N)
-*> The permutations (from deflation and sorting) to be applied
-*> to each eigenblock.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension (2, N)
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension (2, N)
-*> Each number indicates the S value to be used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[out] INDXP
-*> \verbatim
-*> INDXP is INTEGER array, dimension (N)
-*> The permutation used to place deflated values of D at the end
-*> of the array. INDXP(1:K) points to the nondeflated D-values
-*> and INDXP(K+1:N) points to the deflated eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] INDX
-*> \verbatim
-*> INDX is INTEGER array, dimension (N)
-*> The permutation used to sort the contents of D into ascending
-*> order.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO,
- $ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR,
- $ GIVCOL, GIVNUM, INDXP, INDX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N,
- $ QSIZ
- REAL RHO
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ),
- $ INDXQ( * ), PERM( * )
- REAL D( * ), DLAMDA( * ), GIVNUM( 2, * ),
- $ Q( LDQ, * ), Q2( LDQ2, * ), W( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL MONE, ZERO, ONE, TWO, EIGHT
- PARAMETER ( MONE = -1.0E0, ZERO = 0.0E0, ONE = 1.0E0,
- $ TWO = 2.0E0, EIGHT = 8.0E0 )
-* ..
-* .. Local Scalars ..
-*
- INTEGER I, IMAX, J, JLAM, JMAX, JP, K2, N1, N1P1, N2
- REAL C, EPS, S, T, TAU, TOL
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH, SLAPY2
- EXTERNAL ISAMAX, SLAMCH, SLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SLAMRG, SROT, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ICOMPQ.EQ.1 .AND. QSIZ.LT.N ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( CUTPNT.LT.MIN( 1, N ) .OR. CUTPNT.GT.N ) THEN
- INFO = -10
- ELSE IF( LDQ2.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED8', -INFO )
- RETURN
- END IF
-*
-* Need to initialize GIVPTR to O here in case of quick exit
-* to prevent an unspecified code behavior (usually sigfault)
-* when IWORK array on entry to *stedc is not zeroed
-* (or at least some IWORK entries which used in *laed7 for GIVPTR).
-*
- GIVPTR = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- N1 = CUTPNT
- N2 = N - N1
- N1P1 = N1 + 1
-*
- IF( RHO.LT.ZERO ) THEN
- CALL SSCAL( N2, MONE, Z( N1P1 ), 1 )
- END IF
-*
-* Normalize z so that norm(z) = 1
-*
- T = ONE / SQRT( TWO )
- DO 10 J = 1, N
- INDX( J ) = J
- 10 CONTINUE
- CALL SSCAL( N, T, Z, 1 )
- RHO = ABS( TWO*RHO )
-*
-* Sort the eigenvalues into increasing order
-*
- DO 20 I = CUTPNT + 1, N
- INDXQ( I ) = INDXQ( I ) + CUTPNT
- 20 CONTINUE
- DO 30 I = 1, N
- DLAMDA( I ) = D( INDXQ( I ) )
- W( I ) = Z( INDXQ( I ) )
- 30 CONTINUE
- I = 1
- J = CUTPNT + 1
- CALL SLAMRG( N1, N2, DLAMDA, 1, 1, INDX )
- DO 40 I = 1, N
- D( I ) = DLAMDA( INDX( I ) )
- Z( I ) = W( INDX( I ) )
- 40 CONTINUE
-*
-* Calculate the allowable deflation tolerence
-*
- IMAX = ISAMAX( N, Z, 1 )
- JMAX = ISAMAX( N, D, 1 )
- EPS = SLAMCH( 'Epsilon' )
- TOL = EIGHT*EPS*ABS( D( JMAX ) )
-*
-* If the rank-1 modifier is small enough, no more needs to be done
-* except to reorganize Q so that its columns correspond with the
-* elements in D.
-*
- IF( RHO*ABS( Z( IMAX ) ).LE.TOL ) THEN
- K = 0
- IF( ICOMPQ.EQ.0 ) THEN
- DO 50 J = 1, N
- PERM( J ) = INDXQ( INDX( J ) )
- 50 CONTINUE
- ELSE
- DO 60 J = 1, N
- PERM( J ) = INDXQ( INDX( J ) )
- CALL SCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 )
- 60 CONTINUE
- CALL SLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ),
- $ LDQ )
- END IF
- RETURN
- END IF
-*
-* If there are multiple eigenvalues then the problem deflates. Here
-* the number of equal eigenvalues are found. As each equal
-* eigenvalue is found, an elementary reflector is computed to rotate
-* the corresponding eigensubspace so that the corresponding
-* components of Z are zero in this new basis.
-*
- K = 0
- K2 = N + 1
- DO 70 J = 1, N
- IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- INDXP( K2 ) = J
- IF( J.EQ.N )
- $ GO TO 110
- ELSE
- JLAM = J
- GO TO 80
- END IF
- 70 CONTINUE
- 80 CONTINUE
- J = J + 1
- IF( J.GT.N )
- $ GO TO 100
- IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- INDXP( K2 ) = J
- ELSE
-*
-* Check if eigenvalues are close enough to allow deflation.
-*
- S = Z( JLAM )
- C = Z( J )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = SLAPY2( C, S )
- T = D( J ) - D( JLAM )
- C = C / TAU
- S = -S / TAU
- IF( ABS( T*C*S ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- Z( J ) = TAU
- Z( JLAM ) = ZERO
-*
-* Record the appropriate Givens rotation
-*
- GIVPTR = GIVPTR + 1
- GIVCOL( 1, GIVPTR ) = INDXQ( INDX( JLAM ) )
- GIVCOL( 2, GIVPTR ) = INDXQ( INDX( J ) )
- GIVNUM( 1, GIVPTR ) = C
- GIVNUM( 2, GIVPTR ) = S
- IF( ICOMPQ.EQ.1 ) THEN
- CALL SROT( QSIZ, Q( 1, INDXQ( INDX( JLAM ) ) ), 1,
- $ Q( 1, INDXQ( INDX( J ) ) ), 1, C, S )
- END IF
- T = D( JLAM )*C*C + D( J )*S*S
- D( J ) = D( JLAM )*S*S + D( J )*C*C
- D( JLAM ) = T
- K2 = K2 - 1
- I = 1
- 90 CONTINUE
- IF( K2+I.LE.N ) THEN
- IF( D( JLAM ).LT.D( INDXP( K2+I ) ) ) THEN
- INDXP( K2+I-1 ) = INDXP( K2+I )
- INDXP( K2+I ) = JLAM
- I = I + 1
- GO TO 90
- ELSE
- INDXP( K2+I-1 ) = JLAM
- END IF
- ELSE
- INDXP( K2+I-1 ) = JLAM
- END IF
- JLAM = J
- ELSE
- K = K + 1
- W( K ) = Z( JLAM )
- DLAMDA( K ) = D( JLAM )
- INDXP( K ) = JLAM
- JLAM = J
- END IF
- END IF
- GO TO 80
- 100 CONTINUE
-*
-* Record the last eigenvalue.
-*
- K = K + 1
- W( K ) = Z( JLAM )
- DLAMDA( K ) = D( JLAM )
- INDXP( K ) = JLAM
-*
- 110 CONTINUE
-*
-* Sort the eigenvalues and corresponding eigenvectors into DLAMDA
-* and Q2 respectively. The eigenvalues/vectors which were not
-* deflated go into the first K slots of DLAMDA and Q2 respectively,
-* while those which were deflated go into the last N - K slots.
-*
- IF( ICOMPQ.EQ.0 ) THEN
- DO 120 J = 1, N
- JP = INDXP( J )
- DLAMDA( J ) = D( JP )
- PERM( J ) = INDXQ( INDX( JP ) )
- 120 CONTINUE
- ELSE
- DO 130 J = 1, N
- JP = INDXP( J )
- DLAMDA( J ) = D( JP )
- PERM( J ) = INDXQ( INDX( JP ) )
- CALL SCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 )
- 130 CONTINUE
- END IF
-*
-* The deflated eigenvalues and their corresponding vectors go back
-* into the last N - K slots of D and Q respectively.
-*
- IF( K.LT.N ) THEN
- IF( ICOMPQ.EQ.0 ) THEN
- CALL SCOPY( N-K, DLAMDA( K+1 ), 1, D( K+1 ), 1 )
- ELSE
- CALL SCOPY( N-K, DLAMDA( K+1 ), 1, D( K+1 ), 1 )
- CALL SLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2,
- $ Q( 1, K+1 ), LDQ )
- END IF
- END IF
-*
- RETURN
-*
-* End of SLAED8
-*
- END
diff --git a/netlib/LAPACK/slaed9.f b/netlib/LAPACK/slaed9.f
deleted file mode 100644
index 7828434..0000000
--- a/netlib/LAPACK/slaed9.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b SLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAED9 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed9.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed9.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed9.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
-* S, LDS, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N
-* REAL RHO
-* ..
-* .. Array Arguments ..
-* REAL D( * ), DLAMDA( * ), Q( LDQ, * ), S( LDS, * ),
-* $ W( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAED9 finds the roots of the secular equation, as defined by the
-*> values in D, Z, and RHO, between KSTART and KSTOP. It makes the
-*> appropriate calls to SLAED4 and then stores the new matrix of
-*> eigenvectors for use in calculating the next level of Z vectors.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of terms in the rational function to be solved by
-*> SLAED4. K >= 0.
-*> \endverbatim
-*>
-*> \param[in] KSTART
-*> \verbatim
-*> KSTART is INTEGER
-*> \endverbatim
-*>
-*> \param[in] KSTOP
-*> \verbatim
-*> KSTOP is INTEGER
-*> The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
-*> are to be computed. 1 <= KSTART <= KSTOP <= K.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the Q matrix.
-*> N >= K (delation may result in N > K).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> D(I) contains the updated eigenvalues
-*> for KSTART <= I <= KSTOP.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The value of the parameter in the rank one update equation.
-*> RHO >= 0 required.
-*> \endverbatim
-*>
-*> \param[in] DLAMDA
-*> \verbatim
-*> DLAMDA is REAL array, dimension (K)
-*> The first K elements of this array contain the old roots
-*> of the deflated updating problem. These are the poles
-*> of the secular equation.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is REAL array, dimension (K)
-*> The first K elements of this array contain the components
-*> of the deflation-adjusted updating vector.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (LDS, K)
-*> Will contain the eigenvectors of the repaired matrix which
-*> will be stored for subsequent Z vector calculation and
-*> multiplied by the previously accumulated eigenvectors
-*> to update the system.
-*> \endverbatim
-*>
-*> \param[in] LDS
-*> \verbatim
-*> LDS is INTEGER
-*> The leading dimension of S. LDS >= max( 1, K ).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, an eigenvalue did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
- $ S, LDS, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N
- REAL RHO
-* ..
-* .. Array Arguments ..
- REAL D( * ), DLAMDA( * ), Q( LDQ, * ), S( LDS, * ),
- $ W( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- REAL TEMP
-* ..
-* .. External Functions ..
- REAL SLAMC3, SNRM2
- EXTERNAL SLAMC3, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAED4, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( K.LT.0 ) THEN
- INFO = -1
- ELSE IF( KSTART.LT.1 .OR. KSTART.GT.MAX( 1, K ) ) THEN
- INFO = -2
- ELSE IF( MAX( 1, KSTOP ).LT.KSTART .OR. KSTOP.GT.MAX( 1, K ) )
- $ THEN
- INFO = -3
- ELSE IF( N.LT.K ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDS.LT.MAX( 1, K ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAED9', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.0 )
- $ RETURN
-*
-* Modify values DLAMDA(i) to make sure all DLAMDA(i)-DLAMDA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DLAMDA(I) by 2*DLAMDA(I)-DLAMDA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DLAMDA(I) if it is 1; this makes the subsequent
-* subtractions DLAMDA(I)-DLAMDA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DLAMDA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DLAMDA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 10 I = 1, N
- DLAMDA( I ) = SLAMC3( DLAMDA( I ), DLAMDA( I ) ) - DLAMDA( I )
- 10 CONTINUE
-*
- DO 20 J = KSTART, KSTOP
- CALL SLAED4( K, J, DLAMDA, W, Q( 1, J ), RHO, D( J ), INFO )
-*
-* If the zero finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 )
- $ GO TO 120
- 20 CONTINUE
-*
- IF( K.EQ.1 .OR. K.EQ.2 ) THEN
- DO 40 I = 1, K
- DO 30 J = 1, K
- S( J, I ) = Q( J, I )
- 30 CONTINUE
- 40 CONTINUE
- GO TO 120
- END IF
-*
-* Compute updated W.
-*
- CALL SCOPY( K, W, 1, S, 1 )
-*
-* Initialize W(I) = Q(I,I)
-*
- CALL SCOPY( K, Q, LDQ+1, W, 1 )
- DO 70 J = 1, K
- DO 50 I = 1, J - 1
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 50 CONTINUE
- DO 60 I = J + 1, K
- W( I ) = W( I )*( Q( I, J ) / ( DLAMDA( I )-DLAMDA( J ) ) )
- 60 CONTINUE
- 70 CONTINUE
- DO 80 I = 1, K
- W( I ) = SIGN( SQRT( -W( I ) ), S( I, 1 ) )
- 80 CONTINUE
-*
-* Compute eigenvectors of the modified rank-1 modification.
-*
- DO 110 J = 1, K
- DO 90 I = 1, K
- Q( I, J ) = W( I ) / Q( I, J )
- 90 CONTINUE
- TEMP = SNRM2( K, Q( 1, J ), 1 )
- DO 100 I = 1, K
- S( I, J ) = Q( I, J ) / TEMP
- 100 CONTINUE
- 110 CONTINUE
-*
- 120 CONTINUE
- RETURN
-*
-* End of SLAED9
-*
- END
diff --git a/netlib/LAPACK/slaeda.f b/netlib/LAPACK/slaeda.f
deleted file mode 100644
index 70d1aa2..0000000
--- a/netlib/LAPACK/slaeda.f
+++ /dev/null
@@ -1,308 +0,0 @@
-*> \brief \b SLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAEDA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaeda.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaeda.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaeda.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
-* GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CURLVL, CURPBM, INFO, N, TLVLS
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( 2, * ), GIVPTR( * ), PERM( * ),
-* $ PRMPTR( * ), QPTR( * )
-* REAL GIVNUM( 2, * ), Q( * ), Z( * ), ZTEMP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAEDA computes the Z vector corresponding to the merge step in the
-*> CURLVLth step of the merge process with TLVLS steps for the CURPBMth
-*> problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] TLVLS
-*> \verbatim
-*> TLVLS is INTEGER
-*> The total number of merging levels in the overall divide and
-*> conquer tree.
-*> \endverbatim
-*>
-*> \param[in] CURLVL
-*> \verbatim
-*> CURLVL is INTEGER
-*> The current level in the overall merge routine,
-*> 0 <= curlvl <= tlvls.
-*> \endverbatim
-*>
-*> \param[in] CURPBM
-*> \verbatim
-*> CURPBM is INTEGER
-*> The current problem in the current level in the overall
-*> merge routine (counting from upper left to lower right).
-*> \endverbatim
-*>
-*> \param[in] PRMPTR
-*> \verbatim
-*> PRMPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in PERM a
-*> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
-*> indicates the size of the permutation and incidentally the
-*> size of the full, non-deflated problem.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension (N lg N)
-*> Contains the permutations (from deflation and sorting) to be
-*> applied to each eigenblock.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array, dimension (N lg N)
-*> Contains a list of pointers which indicate where in GIVCOL a
-*> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
-*> indicates the number of Givens rotations.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension (2, N lg N)
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension (2, N lg N)
-*> Each number indicates the S value to be used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is REAL array, dimension (N**2)
-*> Contains the square eigenblocks from previous levels, the
-*> starting positions for blocks are given by QPTR.
-*> \endverbatim
-*>
-*> \param[in] QPTR
-*> \verbatim
-*> QPTR is INTEGER array, dimension (N+2)
-*> Contains a list of pointers which indicate where in Q an
-*> eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
-*> the size of the block.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (N)
-*> On output this vector contains the updating vector (the last
-*> row of the first sub-eigenvector matrix and the first row of
-*> the second sub-eigenvector matrix).
-*> \endverbatim
-*>
-*> \param[out] ZTEMP
-*> \verbatim
-*> ZTEMP is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
- $ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CURLVL, CURPBM, INFO, N, TLVLS
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( 2, * ), GIVPTR( * ), PERM( * ),
- $ PRMPTR( * ), QPTR( * )
- REAL GIVNUM( 2, * ), Q( * ), Z( * ), ZTEMP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER BSIZ1, BSIZ2, CURR, I, K, MID, PSIZ1, PSIZ2,
- $ PTR, ZPTR1
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMV, SROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAEDA', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine location of first number in second half.
-*
- MID = N / 2 + 1
-*
-* Gather last/first rows of appropriate eigenblocks into center of Z
-*
- PTR = 1
-*
-* Determine location of lowest level subproblem in the full storage
-* scheme
-*
- CURR = PTR + CURPBM*2**CURLVL + 2**( CURLVL-1 ) - 1
-*
-* Determine size of these matrices. We add HALF to the value of
-* the SQRT in case the machine underestimates one of these square
-* roots.
-*
- BSIZ1 = INT( HALF+SQRT( REAL( QPTR( CURR+1 )-QPTR( CURR ) ) ) )
- BSIZ2 = INT( HALF+SQRT( REAL( QPTR( CURR+2 )-QPTR( CURR+1 ) ) ) )
- DO 10 K = 1, MID - BSIZ1 - 1
- Z( K ) = ZERO
- 10 CONTINUE
- CALL SCOPY( BSIZ1, Q( QPTR( CURR )+BSIZ1-1 ), BSIZ1,
- $ Z( MID-BSIZ1 ), 1 )
- CALL SCOPY( BSIZ2, Q( QPTR( CURR+1 ) ), BSIZ2, Z( MID ), 1 )
- DO 20 K = MID + BSIZ2, N
- Z( K ) = ZERO
- 20 CONTINUE
-*
-* Loop through remaining levels 1 -> CURLVL applying the Givens
-* rotations and permutation and then multiplying the center matrices
-* against the current Z.
-*
- PTR = 2**TLVLS + 1
- DO 70 K = 1, CURLVL - 1
- CURR = PTR + CURPBM*2**( CURLVL-K ) + 2**( CURLVL-K-1 ) - 1
- PSIZ1 = PRMPTR( CURR+1 ) - PRMPTR( CURR )
- PSIZ2 = PRMPTR( CURR+2 ) - PRMPTR( CURR+1 )
- ZPTR1 = MID - PSIZ1
-*
-* Apply Givens at CURR and CURR+1
-*
- DO 30 I = GIVPTR( CURR ), GIVPTR( CURR+1 ) - 1
- CALL SROT( 1, Z( ZPTR1+GIVCOL( 1, I )-1 ), 1,
- $ Z( ZPTR1+GIVCOL( 2, I )-1 ), 1, GIVNUM( 1, I ),
- $ GIVNUM( 2, I ) )
- 30 CONTINUE
- DO 40 I = GIVPTR( CURR+1 ), GIVPTR( CURR+2 ) - 1
- CALL SROT( 1, Z( MID-1+GIVCOL( 1, I ) ), 1,
- $ Z( MID-1+GIVCOL( 2, I ) ), 1, GIVNUM( 1, I ),
- $ GIVNUM( 2, I ) )
- 40 CONTINUE
- PSIZ1 = PRMPTR( CURR+1 ) - PRMPTR( CURR )
- PSIZ2 = PRMPTR( CURR+2 ) - PRMPTR( CURR+1 )
- DO 50 I = 0, PSIZ1 - 1
- ZTEMP( I+1 ) = Z( ZPTR1+PERM( PRMPTR( CURR )+I )-1 )
- 50 CONTINUE
- DO 60 I = 0, PSIZ2 - 1
- ZTEMP( PSIZ1+I+1 ) = Z( MID+PERM( PRMPTR( CURR+1 )+I )-1 )
- 60 CONTINUE
-*
-* Multiply Blocks at CURR and CURR+1
-*
-* Determine size of these matrices. We add HALF to the value of
-* the SQRT in case the machine underestimates one of these
-* square roots.
-*
- BSIZ1 = INT( HALF+SQRT( REAL( QPTR( CURR+1 )-QPTR( CURR ) ) ) )
- BSIZ2 = INT( HALF+SQRT( REAL( QPTR( CURR+2 )-QPTR( CURR+
- $ 1 ) ) ) )
- IF( BSIZ1.GT.0 ) THEN
- CALL SGEMV( 'T', BSIZ1, BSIZ1, ONE, Q( QPTR( CURR ) ),
- $ BSIZ1, ZTEMP( 1 ), 1, ZERO, Z( ZPTR1 ), 1 )
- END IF
- CALL SCOPY( PSIZ1-BSIZ1, ZTEMP( BSIZ1+1 ), 1, Z( ZPTR1+BSIZ1 ),
- $ 1 )
- IF( BSIZ2.GT.0 ) THEN
- CALL SGEMV( 'T', BSIZ2, BSIZ2, ONE, Q( QPTR( CURR+1 ) ),
- $ BSIZ2, ZTEMP( PSIZ1+1 ), 1, ZERO, Z( MID ), 1 )
- END IF
- CALL SCOPY( PSIZ2-BSIZ2, ZTEMP( PSIZ1+BSIZ2+1 ), 1,
- $ Z( MID+BSIZ2 ), 1 )
-*
- PTR = PTR + 2**( TLVLS-K )
- 70 CONTINUE
-*
- RETURN
-*
-* End of SLAEDA
-*
- END
diff --git a/netlib/LAPACK/slaein.f b/netlib/LAPACK/slaein.f
deleted file mode 100644
index 8c8ed6f..0000000
--- a/netlib/LAPACK/slaein.f
+++ /dev/null
@@ -1,632 +0,0 @@
-*> \brief \b SLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAEIN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaein.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaein.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaein.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B,
-* LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL NOINIT, RIGHTV
-* INTEGER INFO, LDB, LDH, N
-* REAL BIGNUM, EPS3, SMLNUM, WI, WR
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), H( LDH, * ), VI( * ), VR( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAEIN uses inverse iteration to find a right or left eigenvector
-*> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg
-*> matrix H.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RIGHTV
-*> \verbatim
-*> RIGHTV is LOGICAL
-*> = .TRUE. : compute right eigenvector;
-*> = .FALSE.: compute left eigenvector.
-*> \endverbatim
-*>
-*> \param[in] NOINIT
-*> \verbatim
-*> NOINIT is LOGICAL
-*> = .TRUE. : no initial vector supplied in (VR,VI).
-*> = .FALSE.: initial vector supplied in (VR,VI).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> The upper Hessenberg matrix H.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] WR
-*> \verbatim
-*> WR is REAL
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is REAL
-*> The real and imaginary parts of the eigenvalue of H whose
-*> corresponding right or left eigenvector is to be computed.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] VI
-*> \verbatim
-*> VI is REAL array, dimension (N)
-*> On entry, if NOINIT = .FALSE. and WI = 0.0, VR must contain
-*> a real starting vector for inverse iteration using the real
-*> eigenvalue WR; if NOINIT = .FALSE. and WI.ne.0.0, VR and VI
-*> must contain the real and imaginary parts of a complex
-*> starting vector for inverse iteration using the complex
-*> eigenvalue (WR,WI); otherwise VR and VI need not be set.
-*> On exit, if WI = 0.0 (real eigenvalue), VR contains the
-*> computed real eigenvector; if WI.ne.0.0 (complex eigenvalue),
-*> VR and VI contain the real and imaginary parts of the
-*> computed complex eigenvector. The eigenvector is normalized
-*> so that the component of largest magnitude has magnitude 1;
-*> here the magnitude of a complex number (x,y) is taken to be
-*> |x| + |y|.
-*> VI is not referenced if WI = 0.0.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= N+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in] EPS3
-*> \verbatim
-*> EPS3 is REAL
-*> A small machine-dependent value which is used to perturb
-*> close eigenvalues, and to replace zero pivots.
-*> \endverbatim
-*>
-*> \param[in] SMLNUM
-*> \verbatim
-*> SMLNUM is REAL
-*> A machine-dependent value close to the underflow threshold.
-*> \endverbatim
-*>
-*> \param[in] BIGNUM
-*> \verbatim
-*> BIGNUM is REAL
-*> A machine-dependent value close to the overflow threshold.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: inverse iteration did not converge; VR is set to the
-*> last iterate, and so is VI if WI.ne.0.0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B,
- $ LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL NOINIT, RIGHTV
- INTEGER INFO, LDB, LDH, N
- REAL BIGNUM, EPS3, SMLNUM, WI, WR
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), H( LDH, * ), VI( * ), VR( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TENTH
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TENTH = 1.0E-1 )
-* ..
-* .. Local Scalars ..
- CHARACTER NORMIN, TRANS
- INTEGER I, I1, I2, I3, IERR, ITS, J
- REAL ABSBII, ABSBJJ, EI, EJ, GROWTO, NORM, NRMSML,
- $ REC, ROOTN, SCALE, TEMP, VCRIT, VMAX, VNORM, W,
- $ W1, X, XI, XR, Y
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SASUM, SLAPY2, SNRM2
- EXTERNAL ISAMAX, SASUM, SLAPY2, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLADIV, SLATRS, SSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* GROWTO is the threshold used in the acceptance test for an
-* eigenvector.
-*
- ROOTN = SQRT( REAL( N ) )
- GROWTO = TENTH / ROOTN
- NRMSML = MAX( ONE, EPS3*ROOTN )*SMLNUM
-*
-* Form B = H - (WR,WI)*I (except that the subdiagonal elements and
-* the imaginary parts of the diagonal elements are not stored).
-*
- DO 20 J = 1, N
- DO 10 I = 1, J - 1
- B( I, J ) = H( I, J )
- 10 CONTINUE
- B( J, J ) = H( J, J ) - WR
- 20 CONTINUE
-*
- IF( WI.EQ.ZERO ) THEN
-*
-* Real eigenvalue.
-*
- IF( NOINIT ) THEN
-*
-* Set initial vector.
-*
- DO 30 I = 1, N
- VR( I ) = EPS3
- 30 CONTINUE
- ELSE
-*
-* Scale supplied initial vector.
-*
- VNORM = SNRM2( N, VR, 1 )
- CALL SSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), VR,
- $ 1 )
- END IF
-*
- IF( RIGHTV ) THEN
-*
-* LU decomposition with partial pivoting of B, replacing zero
-* pivots by EPS3.
-*
- DO 60 I = 1, N - 1
- EI = H( I+1, I )
- IF( ABS( B( I, I ) ).LT.ABS( EI ) ) THEN
-*
-* Interchange rows and eliminate.
-*
- X = B( I, I ) / EI
- B( I, I ) = EI
- DO 40 J = I + 1, N
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - X*TEMP
- B( I, J ) = TEMP
- 40 CONTINUE
- ELSE
-*
-* Eliminate without interchange.
-*
- IF( B( I, I ).EQ.ZERO )
- $ B( I, I ) = EPS3
- X = EI / B( I, I )
- IF( X.NE.ZERO ) THEN
- DO 50 J = I + 1, N
- B( I+1, J ) = B( I+1, J ) - X*B( I, J )
- 50 CONTINUE
- END IF
- END IF
- 60 CONTINUE
- IF( B( N, N ).EQ.ZERO )
- $ B( N, N ) = EPS3
-*
- TRANS = 'N'
-*
- ELSE
-*
-* UL decomposition with partial pivoting of B, replacing zero
-* pivots by EPS3.
-*
- DO 90 J = N, 2, -1
- EJ = H( J, J-1 )
- IF( ABS( B( J, J ) ).LT.ABS( EJ ) ) THEN
-*
-* Interchange columns and eliminate.
-*
- X = B( J, J ) / EJ
- B( J, J ) = EJ
- DO 70 I = 1, J - 1
- TEMP = B( I, J-1 )
- B( I, J-1 ) = B( I, J ) - X*TEMP
- B( I, J ) = TEMP
- 70 CONTINUE
- ELSE
-*
-* Eliminate without interchange.
-*
- IF( B( J, J ).EQ.ZERO )
- $ B( J, J ) = EPS3
- X = EJ / B( J, J )
- IF( X.NE.ZERO ) THEN
- DO 80 I = 1, J - 1
- B( I, J-1 ) = B( I, J-1 ) - X*B( I, J )
- 80 CONTINUE
- END IF
- END IF
- 90 CONTINUE
- IF( B( 1, 1 ).EQ.ZERO )
- $ B( 1, 1 ) = EPS3
-*
- TRANS = 'T'
-*
- END IF
-*
- NORMIN = 'N'
- DO 110 ITS = 1, N
-*
-* Solve U*x = scale*v for a right eigenvector
-* or U**T*x = scale*v for a left eigenvector,
-* overwriting x on v.
-*
- CALL SLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB,
- $ VR, SCALE, WORK, IERR )
- NORMIN = 'Y'
-*
-* Test for sufficient growth in the norm of v.
-*
- VNORM = SASUM( N, VR, 1 )
- IF( VNORM.GE.GROWTO*SCALE )
- $ GO TO 120
-*
-* Choose new orthogonal starting vector and try again.
-*
- TEMP = EPS3 / ( ROOTN+ONE )
- VR( 1 ) = EPS3
- DO 100 I = 2, N
- VR( I ) = TEMP
- 100 CONTINUE
- VR( N-ITS+1 ) = VR( N-ITS+1 ) - EPS3*ROOTN
- 110 CONTINUE
-*
-* Failure to find eigenvector in N iterations.
-*
- INFO = 1
-*
- 120 CONTINUE
-*
-* Normalize eigenvector.
-*
- I = ISAMAX( N, VR, 1 )
- CALL SSCAL( N, ONE / ABS( VR( I ) ), VR, 1 )
- ELSE
-*
-* Complex eigenvalue.
-*
- IF( NOINIT ) THEN
-*
-* Set initial vector.
-*
- DO 130 I = 1, N
- VR( I ) = EPS3
- VI( I ) = ZERO
- 130 CONTINUE
- ELSE
-*
-* Scale supplied initial vector.
-*
- NORM = SLAPY2( SNRM2( N, VR, 1 ), SNRM2( N, VI, 1 ) )
- REC = ( EPS3*ROOTN ) / MAX( NORM, NRMSML )
- CALL SSCAL( N, REC, VR, 1 )
- CALL SSCAL( N, REC, VI, 1 )
- END IF
-*
- IF( RIGHTV ) THEN
-*
-* LU decomposition with partial pivoting of B, replacing zero
-* pivots by EPS3.
-*
-* The imaginary part of the (i,j)-th element of U is stored in
-* B(j+1,i).
-*
- B( 2, 1 ) = -WI
- DO 140 I = 2, N
- B( I+1, 1 ) = ZERO
- 140 CONTINUE
-*
- DO 170 I = 1, N - 1
- ABSBII = SLAPY2( B( I, I ), B( I+1, I ) )
- EI = H( I+1, I )
- IF( ABSBII.LT.ABS( EI ) ) THEN
-*
-* Interchange rows and eliminate.
-*
- XR = B( I, I ) / EI
- XI = B( I+1, I ) / EI
- B( I, I ) = EI
- B( I+1, I ) = ZERO
- DO 150 J = I + 1, N
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - XR*TEMP
- B( J+1, I+1 ) = B( J+1, I ) - XI*TEMP
- B( I, J ) = TEMP
- B( J+1, I ) = ZERO
- 150 CONTINUE
- B( I+2, I ) = -WI
- B( I+1, I+1 ) = B( I+1, I+1 ) - XI*WI
- B( I+2, I+1 ) = B( I+2, I+1 ) + XR*WI
- ELSE
-*
-* Eliminate without interchanging rows.
-*
- IF( ABSBII.EQ.ZERO ) THEN
- B( I, I ) = EPS3
- B( I+1, I ) = ZERO
- ABSBII = EPS3
- END IF
- EI = ( EI / ABSBII ) / ABSBII
- XR = B( I, I )*EI
- XI = -B( I+1, I )*EI
- DO 160 J = I + 1, N
- B( I+1, J ) = B( I+1, J ) - XR*B( I, J ) +
- $ XI*B( J+1, I )
- B( J+1, I+1 ) = -XR*B( J+1, I ) - XI*B( I, J )
- 160 CONTINUE
- B( I+2, I+1 ) = B( I+2, I+1 ) - WI
- END IF
-*
-* Compute 1-norm of offdiagonal elements of i-th row.
-*
- WORK( I ) = SASUM( N-I, B( I, I+1 ), LDB ) +
- $ SASUM( N-I, B( I+2, I ), 1 )
- 170 CONTINUE
- IF( B( N, N ).EQ.ZERO .AND. B( N+1, N ).EQ.ZERO )
- $ B( N, N ) = EPS3
- WORK( N ) = ZERO
-*
- I1 = N
- I2 = 1
- I3 = -1
- ELSE
-*
-* UL decomposition with partial pivoting of conjg(B),
-* replacing zero pivots by EPS3.
-*
-* The imaginary part of the (i,j)-th element of U is stored in
-* B(j+1,i).
-*
- B( N+1, N ) = WI
- DO 180 J = 1, N - 1
- B( N+1, J ) = ZERO
- 180 CONTINUE
-*
- DO 210 J = N, 2, -1
- EJ = H( J, J-1 )
- ABSBJJ = SLAPY2( B( J, J ), B( J+1, J ) )
- IF( ABSBJJ.LT.ABS( EJ ) ) THEN
-*
-* Interchange columns and eliminate
-*
- XR = B( J, J ) / EJ
- XI = B( J+1, J ) / EJ
- B( J, J ) = EJ
- B( J+1, J ) = ZERO
- DO 190 I = 1, J - 1
- TEMP = B( I, J-1 )
- B( I, J-1 ) = B( I, J ) - XR*TEMP
- B( J, I ) = B( J+1, I ) - XI*TEMP
- B( I, J ) = TEMP
- B( J+1, I ) = ZERO
- 190 CONTINUE
- B( J+1, J-1 ) = WI
- B( J-1, J-1 ) = B( J-1, J-1 ) + XI*WI
- B( J, J-1 ) = B( J, J-1 ) - XR*WI
- ELSE
-*
-* Eliminate without interchange.
-*
- IF( ABSBJJ.EQ.ZERO ) THEN
- B( J, J ) = EPS3
- B( J+1, J ) = ZERO
- ABSBJJ = EPS3
- END IF
- EJ = ( EJ / ABSBJJ ) / ABSBJJ
- XR = B( J, J )*EJ
- XI = -B( J+1, J )*EJ
- DO 200 I = 1, J - 1
- B( I, J-1 ) = B( I, J-1 ) - XR*B( I, J ) +
- $ XI*B( J+1, I )
- B( J, I ) = -XR*B( J+1, I ) - XI*B( I, J )
- 200 CONTINUE
- B( J, J-1 ) = B( J, J-1 ) + WI
- END IF
-*
-* Compute 1-norm of offdiagonal elements of j-th column.
-*
- WORK( J ) = SASUM( J-1, B( 1, J ), 1 ) +
- $ SASUM( J-1, B( J+1, 1 ), LDB )
- 210 CONTINUE
- IF( B( 1, 1 ).EQ.ZERO .AND. B( 2, 1 ).EQ.ZERO )
- $ B( 1, 1 ) = EPS3
- WORK( 1 ) = ZERO
-*
- I1 = 1
- I2 = N
- I3 = 1
- END IF
-*
- DO 270 ITS = 1, N
- SCALE = ONE
- VMAX = ONE
- VCRIT = BIGNUM
-*
-* Solve U*(xr,xi) = scale*(vr,vi) for a right eigenvector,
-* or U**T*(xr,xi) = scale*(vr,vi) for a left eigenvector,
-* overwriting (xr,xi) on (vr,vi).
-*
- DO 250 I = I1, I2, I3
-*
- IF( WORK( I ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL SSCAL( N, REC, VR, 1 )
- CALL SSCAL( N, REC, VI, 1 )
- SCALE = SCALE*REC
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- XR = VR( I )
- XI = VI( I )
- IF( RIGHTV ) THEN
- DO 220 J = I + 1, N
- XR = XR - B( I, J )*VR( J ) + B( J+1, I )*VI( J )
- XI = XI - B( I, J )*VI( J ) - B( J+1, I )*VR( J )
- 220 CONTINUE
- ELSE
- DO 230 J = 1, I - 1
- XR = XR - B( J, I )*VR( J ) + B( I+1, J )*VI( J )
- XI = XI - B( J, I )*VI( J ) - B( I+1, J )*VR( J )
- 230 CONTINUE
- END IF
-*
- W = ABS( B( I, I ) ) + ABS( B( I+1, I ) )
- IF( W.GT.SMLNUM ) THEN
- IF( W.LT.ONE ) THEN
- W1 = ABS( XR ) + ABS( XI )
- IF( W1.GT.W*BIGNUM ) THEN
- REC = ONE / W1
- CALL SSCAL( N, REC, VR, 1 )
- CALL SSCAL( N, REC, VI, 1 )
- XR = VR( I )
- XI = VI( I )
- SCALE = SCALE*REC
- VMAX = VMAX*REC
- END IF
- END IF
-*
-* Divide by diagonal element of B.
-*
- CALL SLADIV( XR, XI, B( I, I ), B( I+1, I ), VR( I ),
- $ VI( I ) )
- VMAX = MAX( ABS( VR( I ) )+ABS( VI( I ) ), VMAX )
- VCRIT = BIGNUM / VMAX
- ELSE
- DO 240 J = 1, N
- VR( J ) = ZERO
- VI( J ) = ZERO
- 240 CONTINUE
- VR( I ) = ONE
- VI( I ) = ONE
- SCALE = ZERO
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
- 250 CONTINUE
-*
-* Test for sufficient growth in the norm of (VR,VI).
-*
- VNORM = SASUM( N, VR, 1 ) + SASUM( N, VI, 1 )
- IF( VNORM.GE.GROWTO*SCALE )
- $ GO TO 280
-*
-* Choose a new orthogonal starting vector and try again.
-*
- Y = EPS3 / ( ROOTN+ONE )
- VR( 1 ) = EPS3
- VI( 1 ) = ZERO
-*
- DO 260 I = 2, N
- VR( I ) = Y
- VI( I ) = ZERO
- 260 CONTINUE
- VR( N-ITS+1 ) = VR( N-ITS+1 ) - EPS3*ROOTN
- 270 CONTINUE
-*
-* Failure to find eigenvector in N iterations
-*
- INFO = 1
-*
- 280 CONTINUE
-*
-* Normalize eigenvector.
-*
- VNORM = ZERO
- DO 290 I = 1, N
- VNORM = MAX( VNORM, ABS( VR( I ) )+ABS( VI( I ) ) )
- 290 CONTINUE
- CALL SSCAL( N, ONE / VNORM, VR, 1 )
- CALL SSCAL( N, ONE / VNORM, VI, 1 )
-*
- END IF
-*
- RETURN
-*
-* End of SLAEIN
-*
- END
diff --git a/netlib/LAPACK/slaev2.f b/netlib/LAPACK/slaev2.f
deleted file mode 100644
index f6b81ca..0000000
--- a/netlib/LAPACK/slaev2.f
+++ /dev/null
@@ -1,238 +0,0 @@
-*> \brief \b SLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAEV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaev2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaev2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaev2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
-*
-* .. Scalar Arguments ..
-* REAL A, B, C, CS1, RT1, RT2, SN1
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
-*> [ A B ]
-*> [ B C ].
-*> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
-*> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
-*> eigenvector for RT1, giving the decomposition
-*>
-*> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
-*> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is REAL
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL
-*> The (1,2) element and the conjugate of the (2,1) element of
-*> the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] RT1
-*> \verbatim
-*> RT1 is REAL
-*> The eigenvalue of larger absolute value.
-*> \endverbatim
-*>
-*> \param[out] RT2
-*> \verbatim
-*> RT2 is REAL
-*> The eigenvalue of smaller absolute value.
-*> \endverbatim
-*>
-*> \param[out] CS1
-*> \verbatim
-*> CS1 is REAL
-*> \endverbatim
-*>
-*> \param[out] SN1
-*> \verbatim
-*> SN1 is REAL
-*> The vector (CS1, SN1) is a unit right eigenvector for RT1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> RT1 is accurate to a few ulps barring over/underflow.
-*>
-*> RT2 may be inaccurate if there is massive cancellation in the
-*> determinant A*C-B*B; higher precision or correctly rounded or
-*> correctly truncated arithmetic would be needed to compute RT2
-*> accurately in all cases.
-*>
-*> CS1 and SN1 are accurate to a few ulps barring over/underflow.
-*>
-*> Overflow is possible only if RT1 is within a factor of 5 of overflow.
-*> Underflow is harmless if the input data is 0 or exceeds
-*> underflow_threshold / macheps.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL A, B, C, CS1, RT1, RT2, SN1
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL HALF
- PARAMETER ( HALF = 0.5E0 )
-* ..
-* .. Local Scalars ..
- INTEGER SGN1, SGN2
- REAL AB, ACMN, ACMX, ACS, ADF, CS, CT, DF, RT, SM,
- $ TB, TN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Compute the eigenvalues
-*
- SM = A + C
- DF = A - C
- ADF = ABS( DF )
- TB = B + B
- AB = ABS( TB )
- IF( ABS( A ).GT.ABS( C ) ) THEN
- ACMX = A
- ACMN = C
- ELSE
- ACMX = C
- ACMN = A
- END IF
- IF( ADF.GT.AB ) THEN
- RT = ADF*SQRT( ONE+( AB / ADF )**2 )
- ELSE IF( ADF.LT.AB ) THEN
- RT = AB*SQRT( ONE+( ADF / AB )**2 )
- ELSE
-*
-* Includes case AB=ADF=0
-*
- RT = AB*SQRT( TWO )
- END IF
- IF( SM.LT.ZERO ) THEN
- RT1 = HALF*( SM-RT )
- SGN1 = -1
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE IF( SM.GT.ZERO ) THEN
- RT1 = HALF*( SM+RT )
- SGN1 = 1
-*
-* Order of execution important.
-* To get fully accurate smaller eigenvalue,
-* next line needs to be executed in higher precision.
-*
- RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
- ELSE
-*
-* Includes case RT1 = RT2 = 0
-*
- RT1 = HALF*RT
- RT2 = -HALF*RT
- SGN1 = 1
- END IF
-*
-* Compute the eigenvector
-*
- IF( DF.GE.ZERO ) THEN
- CS = DF + RT
- SGN2 = 1
- ELSE
- CS = DF - RT
- SGN2 = -1
- END IF
- ACS = ABS( CS )
- IF( ACS.GT.AB ) THEN
- CT = -TB / CS
- SN1 = ONE / SQRT( ONE+CT*CT )
- CS1 = CT*SN1
- ELSE
- IF( AB.EQ.ZERO ) THEN
- CS1 = ONE
- SN1 = ZERO
- ELSE
- TN = -CS / TB
- CS1 = ONE / SQRT( ONE+TN*TN )
- SN1 = TN*CS1
- END IF
- END IF
- IF( SGN1.EQ.SGN2 ) THEN
- TN = CS1
- CS1 = -SN1
- SN1 = TN
- END IF
- RETURN
-*
-* End of SLAEV2
-*
- END
diff --git a/netlib/LAPACK/slaexc.f b/netlib/LAPACK/slaexc.f
deleted file mode 100644
index db479cd..0000000
--- a/netlib/LAPACK/slaexc.f
+++ /dev/null
@@ -1,435 +0,0 @@
-*> \brief \b SLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form, by an orthogonal similarity transformation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAEXC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaexc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaexc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaexc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ
-* INTEGER INFO, J1, LDQ, LDT, N, N1, N2
-* ..
-* .. Array Arguments ..
-* REAL Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
-*> an upper quasi-triangular matrix T by an orthogonal similarity
-*> transformation.
-*>
-*> T must be in Schur canonical form, that is, block upper triangular
-*> with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
-*> has its diagonal elemnts equal and its off-diagonal elements of
-*> opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> = .TRUE. : accumulate the transformation in the matrix Q;
-*> = .FALSE.: do not accumulate the transformation.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> canonical form.
-*> On exit, the updated matrix T, again in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
-*> On exit, if WANTQ is .TRUE., the updated matrix Q.
-*> If WANTQ is .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in] J1
-*> \verbatim
-*> J1 is INTEGER
-*> The index of the first row of the first block T11.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The order of the first block T11. N1 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> The order of the second block T22. N2 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: the transformed matrix T would be too far from Schur
-*> form; the blocks are not swapped and T and Q are
-*> unchanged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ
- INTEGER INFO, J1, LDQ, LDT, N, N1, N2
-* ..
-* .. Array Arguments ..
- REAL Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL TEN
- PARAMETER ( TEN = 1.0E+1 )
- INTEGER LDD, LDX
- PARAMETER ( LDD = 4, LDX = 2 )
-* ..
-* .. Local Scalars ..
- INTEGER IERR, J2, J3, J4, K, ND
- REAL CS, DNORM, EPS, SCALE, SMLNUM, SN, T11, T22,
- $ T33, TAU, TAU1, TAU2, TEMP, THRESH, WI1, WI2,
- $ WR1, WR2, XNORM
-* ..
-* .. Local Arrays ..
- REAL D( LDD, 4 ), U( 3 ), U1( 3 ), U2( 3 ),
- $ X( LDX, 2 )
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLANGE
- EXTERNAL SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SLANV2, SLARFG, SLARFX, SLARTG, SLASY2,
- $ SROT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. N1.EQ.0 .OR. N2.EQ.0 )
- $ RETURN
- IF( J1+N1.GT.N )
- $ RETURN
-*
- J2 = J1 + 1
- J3 = J1 + 2
- J4 = J1 + 3
-*
- IF( N1.EQ.1 .AND. N2.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- T11 = T( J1, J1 )
- T22 = T( J2, J2 )
-*
-* Determine the transformation to perform the interchange.
-*
- CALL SLARTG( T( J1, J2 ), T22-T11, CS, SN, TEMP )
-*
-* Apply transformation to the matrix T.
-*
- IF( J3.LE.N )
- $ CALL SROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, CS,
- $ SN )
- CALL SROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
-*
- T( J1, J1 ) = T22
- T( J2, J2 ) = T11
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL SROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
- END IF
-*
- ELSE
-*
-* Swapping involves at least one 2-by-2 block.
-*
-* Copy the diagonal block of order N1+N2 to the local array D
-* and compute its norm.
-*
- ND = N1 + N2
- CALL SLACPY( 'Full', ND, ND, T( J1, J1 ), LDT, D, LDD )
- DNORM = SLANGE( 'Max', ND, ND, D, LDD, WORK )
-*
-* Compute machine-dependent threshold for test for accepting
-* swap.
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- THRESH = MAX( TEN*EPS*DNORM, SMLNUM )
-*
-* Solve T11*X - X*T22 = scale*T12 for X.
-*
- CALL SLASY2( .FALSE., .FALSE., -1, N1, N2, D, LDD,
- $ D( N1+1, N1+1 ), LDD, D( 1, N1+1 ), LDD, SCALE, X,
- $ LDX, XNORM, IERR )
-*
-* Swap the adjacent diagonal blocks.
-*
- K = N1 + N1 + N2 - 3
- GO TO ( 10, 20, 30 )K
-*
- 10 CONTINUE
-*
-* N1 = 1, N2 = 2: generate elementary reflector H so that:
-*
-* ( scale, X11, X12 ) H = ( 0, 0, * )
-*
- U( 1 ) = SCALE
- U( 2 ) = X( 1, 1 )
- U( 3 ) = X( 1, 2 )
- CALL SLARFG( 3, U( 3 ), U, 1, TAU )
- U( 3 ) = ONE
- T11 = T( J1, J1 )
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL SLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
- CALL SLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 3,
- $ 3 )-T11 ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL SLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, WORK )
- CALL SLARFX( 'R', J2, 3, U, TAU, T( 1, J1 ), LDT, WORK )
-*
- T( J3, J1 ) = ZERO
- T( J3, J2 ) = ZERO
- T( J3, J3 ) = T11
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL SLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
- END IF
- GO TO 40
-*
- 20 CONTINUE
-*
-* N1 = 2, N2 = 1: generate elementary reflector H so that:
-*
-* H ( -X11 ) = ( * )
-* ( -X21 ) = ( 0 )
-* ( scale ) = ( 0 )
-*
- U( 1 ) = -X( 1, 1 )
- U( 2 ) = -X( 2, 1 )
- U( 3 ) = SCALE
- CALL SLARFG( 3, U( 1 ), U( 2 ), 1, TAU )
- U( 1 ) = ONE
- T33 = T( J3, J3 )
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL SLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
- CALL SLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 2, 1 ) ), ABS( D( 3, 1 ) ), ABS( D( 1,
- $ 1 )-T33 ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL SLARFX( 'R', J3, 3, U, TAU, T( 1, J1 ), LDT, WORK )
- CALL SLARFX( 'L', 3, N-J1, U, TAU, T( J1, J2 ), LDT, WORK )
-*
- T( J1, J1 ) = T33
- T( J2, J1 ) = ZERO
- T( J3, J1 ) = ZERO
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL SLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
- END IF
- GO TO 40
-*
- 30 CONTINUE
-*
-* N1 = 2, N2 = 2: generate elementary reflectors H(1) and H(2) so
-* that:
-*
-* H(2) H(1) ( -X11 -X12 ) = ( * * )
-* ( -X21 -X22 ) ( 0 * )
-* ( scale 0 ) ( 0 0 )
-* ( 0 scale ) ( 0 0 )
-*
- U1( 1 ) = -X( 1, 1 )
- U1( 2 ) = -X( 2, 1 )
- U1( 3 ) = SCALE
- CALL SLARFG( 3, U1( 1 ), U1( 2 ), 1, TAU1 )
- U1( 1 ) = ONE
-*
- TEMP = -TAU1*( X( 1, 2 )+U1( 2 )*X( 2, 2 ) )
- U2( 1 ) = -TEMP*U1( 2 ) - X( 2, 2 )
- U2( 2 ) = -TEMP*U1( 3 )
- U2( 3 ) = SCALE
- CALL SLARFG( 3, U2( 1 ), U2( 2 ), 1, TAU2 )
- U2( 1 ) = ONE
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL SLARFX( 'L', 3, 4, U1, TAU1, D, LDD, WORK )
- CALL SLARFX( 'R', 4, 3, U1, TAU1, D, LDD, WORK )
- CALL SLARFX( 'L', 3, 4, U2, TAU2, D( 2, 1 ), LDD, WORK )
- CALL SLARFX( 'R', 4, 3, U2, TAU2, D( 1, 2 ), LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 4, 1 ) ),
- $ ABS( D( 4, 2 ) ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL SLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, WORK )
- CALL SLARFX( 'R', J4, 3, U1, TAU1, T( 1, J1 ), LDT, WORK )
- CALL SLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, WORK )
- CALL SLARFX( 'R', J4, 3, U2, TAU2, T( 1, J2 ), LDT, WORK )
-*
- T( J3, J1 ) = ZERO
- T( J3, J2 ) = ZERO
- T( J4, J1 ) = ZERO
- T( J4, J2 ) = ZERO
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL SLARFX( 'R', N, 3, U1, TAU1, Q( 1, J1 ), LDQ, WORK )
- CALL SLARFX( 'R', N, 3, U2, TAU2, Q( 1, J2 ), LDQ, WORK )
- END IF
-*
- 40 CONTINUE
-*
- IF( N2.EQ.2 ) THEN
-*
-* Standardize new 2-by-2 block T11
-*
- CALL SLANV2( T( J1, J1 ), T( J1, J2 ), T( J2, J1 ),
- $ T( J2, J2 ), WR1, WI1, WR2, WI2, CS, SN )
- CALL SROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), LDT,
- $ CS, SN )
- CALL SROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
- IF( WANTQ )
- $ CALL SROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
- END IF
-*
- IF( N1.EQ.2 ) THEN
-*
-* Standardize new 2-by-2 block T22
-*
- J3 = J1 + N2
- J4 = J3 + 1
- CALL SLANV2( T( J3, J3 ), T( J3, J4 ), T( J4, J3 ),
- $ T( J4, J4 ), WR1, WI1, WR2, WI2, CS, SN )
- IF( J3+2.LE.N )
- $ CALL SROT( N-J3-1, T( J3, J3+2 ), LDT, T( J4, J3+2 ),
- $ LDT, CS, SN )
- CALL SROT( J3-1, T( 1, J3 ), 1, T( 1, J4 ), 1, CS, SN )
- IF( WANTQ )
- $ CALL SROT( N, Q( 1, J3 ), 1, Q( 1, J4 ), 1, CS, SN )
- END IF
-*
- END IF
- RETURN
-*
-* Exit with INFO = 1 if swap was rejected.
-*
- 50 INFO = 1
- RETURN
-*
-* End of SLAEXC
-*
- END
diff --git a/netlib/LAPACK/slag2.f b/netlib/LAPACK/slag2.f
deleted file mode 100644
index ad04333..0000000
--- a/netlib/LAPACK/slag2.f
+++ /dev/null
@@ -1,379 +0,0 @@
-*> \brief \b SLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary to avoid over-/underflow.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAG2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slag2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slag2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slag2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
-* WR2, WI )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDB
-* REAL SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
-*> problem A - w B, with scaling as necessary to avoid over-/underflow.
-*>
-*> The scaling factor "s" results in a modified eigenvalue equation
-*>
-*> s A - w B
-*>
-*> where s is a non-negative scaling factor chosen so that w, w B,
-*> and s A do not overflow and, if possible, do not underflow, either.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, 2)
-*> On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
-*> is less than 1/SAFMIN. Entries less than
-*> sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= 2.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, 2)
-*> On entry, the 2 x 2 upper triangular matrix B. It is
-*> assumed that the one-norm of B is less than 1/SAFMIN. The
-*> diagonals should be at least sqrt(SAFMIN) times the largest
-*> element of B (in absolute value); if a diagonal is smaller
-*> than that, then +/- sqrt(SAFMIN) will be used instead of
-*> that diagonal.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= 2.
-*> \endverbatim
-*>
-*> \param[in] SAFMIN
-*> \verbatim
-*> SAFMIN is REAL
-*> The smallest positive number s.t. 1/SAFMIN does not
-*> overflow. (This should always be SLAMCH('S') -- it is an
-*> argument in order to avoid having to call SLAMCH frequently.)
-*> \endverbatim
-*>
-*> \param[out] SCALE1
-*> \verbatim
-*> SCALE1 is REAL
-*> A scaling factor used to avoid over-/underflow in the
-*> eigenvalue equation which defines the first eigenvalue. If
-*> the eigenvalues are complex, then the eigenvalues are
-*> ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
-*> exponent range of the machine), SCALE1=SCALE2, and SCALE1
-*> will always be positive. If the eigenvalues are real, then
-*> the first (real) eigenvalue is WR1 / SCALE1 , but this may
-*> overflow or underflow, and in fact, SCALE1 may be zero or
-*> less than the underflow threshhold if the exact eigenvalue
-*> is sufficiently large.
-*> \endverbatim
-*>
-*> \param[out] SCALE2
-*> \verbatim
-*> SCALE2 is REAL
-*> A scaling factor used to avoid over-/underflow in the
-*> eigenvalue equation which defines the second eigenvalue. If
-*> the eigenvalues are complex, then SCALE2=SCALE1. If the
-*> eigenvalues are real, then the second (real) eigenvalue is
-*> WR2 / SCALE2 , but this may overflow or underflow, and in
-*> fact, SCALE2 may be zero or less than the underflow
-*> threshhold if the exact eigenvalue is sufficiently large.
-*> \endverbatim
-*>
-*> \param[out] WR1
-*> \verbatim
-*> WR1 is REAL
-*> If the eigenvalue is real, then WR1 is SCALE1 times the
-*> eigenvalue closest to the (2,2) element of A B**(-1). If the
-*> eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
-*> part of the eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] WR2
-*> \verbatim
-*> WR2 is REAL
-*> If the eigenvalue is real, then WR2 is SCALE2 times the
-*> other eigenvalue. If the eigenvalue is complex, then
-*> WR1=WR2 is SCALE1 times the real part of the eigenvalues.
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL
-*> If the eigenvalue is real, then WI is zero. If the
-*> eigenvalue is complex, then WI is SCALE1 times the imaginary
-*> part of the eigenvalues. WI will always be non-negative.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
- $ WR2, WI )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDB
- REAL SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
- REAL HALF
- PARAMETER ( HALF = ONE / TWO )
- REAL FUZZY1
- PARAMETER ( FUZZY1 = ONE+1.0E-5 )
-* ..
-* .. Local Scalars ..
- REAL A11, A12, A21, A22, ABI22, ANORM, AS11, AS12,
- $ AS22, ASCALE, B11, B12, B22, BINV11, BINV22,
- $ BMIN, BNORM, BSCALE, BSIZE, C1, C2, C3, C4, C5,
- $ DIFF, DISCR, PP, QQ, R, RTMAX, RTMIN, S1, S2,
- $ SAFMAX, SHIFT, SS, SUM, WABS, WBIG, WDET,
- $ WSCALE, WSIZE, WSMALL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
- RTMIN = SQRT( SAFMIN )
- RTMAX = ONE / RTMIN
- SAFMAX = ONE / SAFMIN
-*
-* Scale A
-*
- ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
- $ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
- ASCALE = ONE / ANORM
- A11 = ASCALE*A( 1, 1 )
- A21 = ASCALE*A( 2, 1 )
- A12 = ASCALE*A( 1, 2 )
- A22 = ASCALE*A( 2, 2 )
-*
-* Perturb B if necessary to insure non-singularity
-*
- B11 = B( 1, 1 )
- B12 = B( 1, 2 )
- B22 = B( 2, 2 )
- BMIN = RTMIN*MAX( ABS( B11 ), ABS( B12 ), ABS( B22 ), RTMIN )
- IF( ABS( B11 ).LT.BMIN )
- $ B11 = SIGN( BMIN, B11 )
- IF( ABS( B22 ).LT.BMIN )
- $ B22 = SIGN( BMIN, B22 )
-*
-* Scale B
-*
- BNORM = MAX( ABS( B11 ), ABS( B12 )+ABS( B22 ), SAFMIN )
- BSIZE = MAX( ABS( B11 ), ABS( B22 ) )
- BSCALE = ONE / BSIZE
- B11 = B11*BSCALE
- B12 = B12*BSCALE
- B22 = B22*BSCALE
-*
-* Compute larger eigenvalue by method described by C. van Loan
-*
-* ( AS is A shifted by -SHIFT*B )
-*
- BINV11 = ONE / B11
- BINV22 = ONE / B22
- S1 = A11*BINV11
- S2 = A22*BINV22
- IF( ABS( S1 ).LE.ABS( S2 ) ) THEN
- AS12 = A12 - S1*B12
- AS22 = A22 - S1*B22
- SS = A21*( BINV11*BINV22 )
- ABI22 = AS22*BINV22 - SS*B12
- PP = HALF*ABI22
- SHIFT = S1
- ELSE
- AS12 = A12 - S2*B12
- AS11 = A11 - S2*B11
- SS = A21*( BINV11*BINV22 )
- ABI22 = -SS*B12
- PP = HALF*( AS11*BINV11+ABI22 )
- SHIFT = S2
- END IF
- QQ = SS*AS12
- IF( ABS( PP*RTMIN ).GE.ONE ) THEN
- DISCR = ( RTMIN*PP )**2 + QQ*SAFMIN
- R = SQRT( ABS( DISCR ) )*RTMAX
- ELSE
- IF( PP**2+ABS( QQ ).LE.SAFMIN ) THEN
- DISCR = ( RTMAX*PP )**2 + QQ*SAFMAX
- R = SQRT( ABS( DISCR ) )*RTMIN
- ELSE
- DISCR = PP**2 + QQ
- R = SQRT( ABS( DISCR ) )
- END IF
- END IF
-*
-* Note: the test of R in the following IF is to cover the case when
-* DISCR is small and negative and is flushed to zero during
-* the calculation of R. On machines which have a consistent
-* flush-to-zero threshhold and handle numbers above that
-* threshhold correctly, it would not be necessary.
-*
- IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN
- SUM = PP + SIGN( R, PP )
- DIFF = PP - SIGN( R, PP )
- WBIG = SHIFT + SUM
-*
-* Compute smaller eigenvalue
-*
- WSMALL = SHIFT + DIFF
- IF( HALF*ABS( WBIG ).GT.MAX( ABS( WSMALL ), SAFMIN ) ) THEN
- WDET = ( A11*A22-A12*A21 )*( BINV11*BINV22 )
- WSMALL = WDET / WBIG
- END IF
-*
-* Choose (real) eigenvalue closest to 2,2 element of A*B**(-1)
-* for WR1.
-*
- IF( PP.GT.ABI22 ) THEN
- WR1 = MIN( WBIG, WSMALL )
- WR2 = MAX( WBIG, WSMALL )
- ELSE
- WR1 = MAX( WBIG, WSMALL )
- WR2 = MIN( WBIG, WSMALL )
- END IF
- WI = ZERO
- ELSE
-*
-* Complex eigenvalues
-*
- WR1 = SHIFT + PP
- WR2 = WR1
- WI = R
- END IF
-*
-* Further scaling to avoid underflow and overflow in computing
-* SCALE1 and overflow in computing w*B.
-*
-* This scale factor (WSCALE) is bounded from above using C1 and C2,
-* and from below using C3 and C4.
-* C1 implements the condition s A must never overflow.
-* C2 implements the condition w B must never overflow.
-* C3, with C2,
-* implement the condition that s A - w B must never overflow.
-* C4 implements the condition s should not underflow.
-* C5 implements the condition max(s,|w|) should be at least 2.
-*
- C1 = BSIZE*( SAFMIN*MAX( ONE, ASCALE ) )
- C2 = SAFMIN*MAX( ONE, BNORM )
- C3 = BSIZE*SAFMIN
- IF( ASCALE.LE.ONE .AND. BSIZE.LE.ONE ) THEN
- C4 = MIN( ONE, ( ASCALE / SAFMIN )*BSIZE )
- ELSE
- C4 = ONE
- END IF
- IF( ASCALE.LE.ONE .OR. BSIZE.LE.ONE ) THEN
- C5 = MIN( ONE, ASCALE*BSIZE )
- ELSE
- C5 = ONE
- END IF
-*
-* Scale first eigenvalue
-*
- WABS = ABS( WR1 ) + ABS( WI )
- WSIZE = MAX( SAFMIN, C1, FUZZY1*( WABS*C2+C3 ),
- $ MIN( C4, HALF*MAX( WABS, C5 ) ) )
- IF( WSIZE.NE.ONE ) THEN
- WSCALE = ONE / WSIZE
- IF( WSIZE.GT.ONE ) THEN
- SCALE1 = ( MAX( ASCALE, BSIZE )*WSCALE )*
- $ MIN( ASCALE, BSIZE )
- ELSE
- SCALE1 = ( MIN( ASCALE, BSIZE )*WSCALE )*
- $ MAX( ASCALE, BSIZE )
- END IF
- WR1 = WR1*WSCALE
- IF( WI.NE.ZERO ) THEN
- WI = WI*WSCALE
- WR2 = WR1
- SCALE2 = SCALE1
- END IF
- ELSE
- SCALE1 = ASCALE*BSIZE
- SCALE2 = SCALE1
- END IF
-*
-* Scale second eigenvalue (if real)
-*
- IF( WI.EQ.ZERO ) THEN
- WSIZE = MAX( SAFMIN, C1, FUZZY1*( ABS( WR2 )*C2+C3 ),
- $ MIN( C4, HALF*MAX( ABS( WR2 ), C5 ) ) )
- IF( WSIZE.NE.ONE ) THEN
- WSCALE = ONE / WSIZE
- IF( WSIZE.GT.ONE ) THEN
- SCALE2 = ( MAX( ASCALE, BSIZE )*WSCALE )*
- $ MIN( ASCALE, BSIZE )
- ELSE
- SCALE2 = ( MIN( ASCALE, BSIZE )*WSCALE )*
- $ MAX( ASCALE, BSIZE )
- END IF
- WR2 = WR2*WSCALE
- ELSE
- SCALE2 = ASCALE*BSIZE
- END IF
- END IF
-*
-* End of SLAG2
-*
- RETURN
- END
diff --git a/netlib/LAPACK/slag2d.f b/netlib/LAPACK/slag2d.f
deleted file mode 100644
index e515fa6..0000000
--- a/netlib/LAPACK/slag2d.f
+++ /dev/null
@@ -1,137 +0,0 @@
-*> \brief \b SLAG2D converts a single precision matrix to a double precision matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAG2D + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slag2d.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slag2d.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slag2d.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAG2D( M, N, SA, LDSA, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDSA, M, N
-* ..
-* .. Array Arguments ..
-* REAL SA( LDSA, * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAG2D converts a SINGLE PRECISION matrix, SA, to a DOUBLE
-*> PRECISION matrix, A.
-*>
-*> Note that while it is possible to overflow while converting
-*> from double to single, it is not possible to overflow when
-*> converting from single to double.
-*>
-*> This is an auxiliary routine so there is no argument checking.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of lines of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] SA
-*> \verbatim
-*> SA is REAL array, dimension (LDSA,N)
-*> On entry, the M-by-N coefficient matrix SA.
-*> \endverbatim
-*>
-*> \param[in] LDSA
-*> \verbatim
-*> LDSA is INTEGER
-*> The leading dimension of the array SA. LDSA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On exit, the M-by-N coefficient matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAG2D( M, N, SA, LDSA, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDSA, M, N
-* ..
-* .. Array Arguments ..
- REAL SA( LDSA, * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- DO 20 J = 1, N
- DO 10 I = 1, M
- A( I, J ) = SA( I, J )
- 10 CONTINUE
- 20 CONTINUE
- RETURN
-*
-* End of SLAG2D
-*
- END
diff --git a/netlib/LAPACK/slagge.f b/netlib/LAPACK/slagge.f
deleted file mode 100644
index 295311c..0000000
--- a/netlib/LAPACK/slagge.f
+++ /dev/null
@@ -1,357 +0,0 @@
-*> \brief \b SLAGGE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGGE generates a real general m by n matrix A, by pre- and post-
-*> multiplying a real diagonal matrix D with random orthogonal matrices:
-*> A = U*D*V. The lower and upper bandwidths may then be reduced to
-*> kl and ku by additional orthogonal transformations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of nonzero subdiagonals within the band of A.
-*> 0 <= KL <= M-1.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of nonzero superdiagonals within the band of A.
-*> 0 <= KU <= N-1.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (min(M,N))
-*> The diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The generated m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= M.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (M+N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL TAU, WA, WB, WN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER, SLARNV, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SIGN
-* ..
-* .. External Functions ..
- REAL SNRM2
- EXTERNAL SNRM2
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -7
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'SLAGGE', -INFO )
- RETURN
- END IF
-*
-* initialize A to diagonal matrix
-*
- DO 20 J = 1, N
- DO 10 I = 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- DO 30 I = 1, MIN( M, N )
- A( I, I ) = D( I )
- 30 CONTINUE
-*
-* pre- and post-multiply A by random orthogonal matrices
-*
- DO 40 I = MIN( M, N ), 1, -1
- IF( I.LT.M ) THEN
-*
-* generate random reflection
-*
- CALL SLARNV( 3, ISEED, M-I+1, WORK )
- WN = SNRM2( M-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL SSCAL( M-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* multiply A(i:m,i:n) by random reflection from the left
-*
- CALL SGEMV( 'Transpose', M-I+1, N-I+1, ONE, A( I, I ), LDA,
- $ WORK, 1, ZERO, WORK( M+1 ), 1 )
- CALL SGER( M-I+1, N-I+1, -TAU, WORK, 1, WORK( M+1 ), 1,
- $ A( I, I ), LDA )
- END IF
- IF( I.LT.N ) THEN
-*
-* generate random reflection
-*
- CALL SLARNV( 3, ISEED, N-I+1, WORK )
- WN = SNRM2( N-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* multiply A(i:m,i:n) by random reflection from the right
-*
- CALL SGEMV( 'No transpose', M-I+1, N-I+1, ONE, A( I, I ),
- $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 )
- CALL SGER( M-I+1, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1,
- $ A( I, I ), LDA )
- END IF
- 40 CONTINUE
-*
-* Reduce number of subdiagonals to KL and number of superdiagonals
-* to KU
-*
- DO 70 I = 1, MAX( M-1-KL, N-1-KU )
- IF( KL.LE.KU ) THEN
-*
-* annihilate subdiagonal elements first (necessary if KL = 0)
-*
- IF( I.LE.MIN( M-1-KL, N ) ) THEN
-*
-* generate reflection to annihilate A(kl+i+1:m,i)
-*
- WN = SNRM2( M-KL-I+1, A( KL+I, I ), 1 )
- WA = SIGN( WN, A( KL+I, I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( KL+I, I ) + WA
- CALL SSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 )
- A( KL+I, I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(kl+i:m,i+1:n) from the left
-*
- CALL SGEMV( 'Transpose', M-KL-I+1, N-I, ONE,
- $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO,
- $ WORK, 1 )
- CALL SGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1,
- $ A( KL+I, I+1 ), LDA )
- A( KL+I, I ) = -WA
- END IF
-*
- IF( I.LE.MIN( N-1-KU, M ) ) THEN
-*
-* generate reflection to annihilate A(i,ku+i+1:n)
-*
- WN = SNRM2( N-KU-I+1, A( I, KU+I ), LDA )
- WA = SIGN( WN, A( I, KU+I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( I, KU+I ) + WA
- CALL SSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA )
- A( I, KU+I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(i+1:m,ku+i:n) from the right
-*
- CALL SGEMV( 'No transpose', M-I, N-KU-I+1, ONE,
- $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO,
- $ WORK, 1 )
- CALL SGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ),
- $ LDA, A( I+1, KU+I ), LDA )
- A( I, KU+I ) = -WA
- END IF
- ELSE
-*
-* annihilate superdiagonal elements first (necessary if
-* KU = 0)
-*
- IF( I.LE.MIN( N-1-KU, M ) ) THEN
-*
-* generate reflection to annihilate A(i,ku+i+1:n)
-*
- WN = SNRM2( N-KU-I+1, A( I, KU+I ), LDA )
- WA = SIGN( WN, A( I, KU+I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( I, KU+I ) + WA
- CALL SSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA )
- A( I, KU+I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(i+1:m,ku+i:n) from the right
-*
- CALL SGEMV( 'No transpose', M-I, N-KU-I+1, ONE,
- $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO,
- $ WORK, 1 )
- CALL SGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ),
- $ LDA, A( I+1, KU+I ), LDA )
- A( I, KU+I ) = -WA
- END IF
-*
- IF( I.LE.MIN( M-1-KL, N ) ) THEN
-*
-* generate reflection to annihilate A(kl+i+1:m,i)
-*
- WN = SNRM2( M-KL-I+1, A( KL+I, I ), 1 )
- WA = SIGN( WN, A( KL+I, I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( KL+I, I ) + WA
- CALL SSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 )
- A( KL+I, I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(kl+i:m,i+1:n) from the left
-*
- CALL SGEMV( 'Transpose', M-KL-I+1, N-I, ONE,
- $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO,
- $ WORK, 1 )
- CALL SGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1,
- $ A( KL+I, I+1 ), LDA )
- A( KL+I, I ) = -WA
- END IF
- END IF
-*
- DO 50 J = KL + I + 1, M
- A( J, I ) = ZERO
- 50 CONTINUE
-*
- DO 60 J = KU + I + 1, N
- A( I, J ) = ZERO
- 60 CONTINUE
- 70 CONTINUE
- RETURN
-*
-* End of SLAGGE
-*
- END
diff --git a/netlib/LAPACK/slags2.f b/netlib/LAPACK/slags2.f
deleted file mode 100644
index a78c00d..0000000
--- a/netlib/LAPACK/slags2.f
+++ /dev/null
@@ -1,362 +0,0 @@
-*> \brief \b SLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAGS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slags2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slags2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slags2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
-* SNV, CSQ, SNQ )
-*
-* .. Scalar Arguments ..
-* LOGICAL UPPER
-* REAL A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
-* $ SNU, SNV
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
-*> that if ( UPPER ) then
-*>
-*> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 )
-*> ( 0 A3 ) ( x x )
-*> and
-*> V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 )
-*> ( 0 B3 ) ( x x )
-*>
-*> or if ( .NOT.UPPER ) then
-*>
-*> U**T *A*Q = U**T *( A1 0 )*Q = ( x x )
-*> ( A2 A3 ) ( 0 x )
-*> and
-*> V**T*B*Q = V**T*( B1 0 )*Q = ( x x )
-*> ( B2 B3 ) ( 0 x )
-*>
-*> The rows of the transformed A and B are parallel, where
-*>
-*> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
-*> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
-*>
-*> Z**T denotes the transpose of Z.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPPER
-*> \verbatim
-*> UPPER is LOGICAL
-*> = .TRUE.: the input matrices A and B are upper triangular.
-*> = .FALSE.: the input matrices A and B are lower triangular.
-*> \endverbatim
-*>
-*> \param[in] A1
-*> \verbatim
-*> A1 is REAL
-*> \endverbatim
-*>
-*> \param[in] A2
-*> \verbatim
-*> A2 is REAL
-*> \endverbatim
-*>
-*> \param[in] A3
-*> \verbatim
-*> A3 is REAL
-*> On entry, A1, A2 and A3 are elements of the input 2-by-2
-*> upper (lower) triangular matrix A.
-*> \endverbatim
-*>
-*> \param[in] B1
-*> \verbatim
-*> B1 is REAL
-*> \endverbatim
-*>
-*> \param[in] B2
-*> \verbatim
-*> B2 is REAL
-*> \endverbatim
-*>
-*> \param[in] B3
-*> \verbatim
-*> B3 is REAL
-*> On entry, B1, B2 and B3 are elements of the input 2-by-2
-*> upper (lower) triangular matrix B.
-*> \endverbatim
-*>
-*> \param[out] CSU
-*> \verbatim
-*> CSU is REAL
-*> \endverbatim
-*>
-*> \param[out] SNU
-*> \verbatim
-*> SNU is REAL
-*> The desired orthogonal matrix U.
-*> \endverbatim
-*>
-*> \param[out] CSV
-*> \verbatim
-*> CSV is REAL
-*> \endverbatim
-*>
-*> \param[out] SNV
-*> \verbatim
-*> SNV is REAL
-*> The desired orthogonal matrix V.
-*> \endverbatim
-*>
-*> \param[out] CSQ
-*> \verbatim
-*> CSQ is REAL
-*> \endverbatim
-*>
-*> \param[out] SNQ
-*> \verbatim
-*> SNQ is REAL
-*> The desired orthogonal matrix Q.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
- $ SNV, CSQ, SNQ )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL UPPER
- REAL A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
- $ SNU, SNV
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL A, AUA11, AUA12, AUA21, AUA22, AVB11, AVB12,
- $ AVB21, AVB22, CSL, CSR, D, S1, S2, SNL,
- $ SNR, UA11R, UA22R, VB11R, VB22R, B, C, R, UA11,
- $ UA12, UA21, UA22, VB11, VB12, VB21, VB22
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARTG, SLASV2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( UPPER ) THEN
-*
-* Input matrices A and B are upper triangular matrices
-*
-* Form matrix C = A*adj(B) = ( a b )
-* ( 0 d )
-*
- A = A1*B3
- D = A3*B1
- B = A2*B1 - A1*B2
-*
-* The SVD of real 2-by-2 triangular C
-*
-* ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 )
-* ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T )
-*
- CALL SLASV2( A, B, D, S1, S2, SNR, CSR, SNL, CSL )
-*
- IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) )
- $ THEN
-*
-* Compute the (1,1) and (1,2) elements of U**T *A and V**T *B,
-* and (1,2) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA11R = CSL*A1
- UA12 = CSL*A2 + SNL*A3
-*
- VB11R = CSR*B1
- VB12 = CSR*B2 + SNR*B3
-*
- AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 )
- AVB12 = ABS( CSR )*ABS( B2 ) + ABS( SNR )*ABS( B3 )
-*
-* zero (1,2) elements of U**T *A and V**T *B
-*
- IF( ( ABS( UA11R )+ABS( UA12 ) ).NE.ZERO ) THEN
- IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 /
- $ ( ABS( VB11R )+ABS( VB12 ) ) ) THEN
- CALL SLARTG( -UA11R, UA12, CSQ, SNQ, R )
- ELSE
- CALL SLARTG( -VB11R, VB12, CSQ, SNQ, R )
- END IF
- ELSE
- CALL SLARTG( -VB11R, VB12, CSQ, SNQ, R )
- END IF
-*
- CSU = CSL
- SNU = -SNL
- CSV = CSR
- SNV = -SNR
-*
- ELSE
-*
-* Compute the (2,1) and (2,2) elements of U**T *A and V**T *B,
-* and (2,2) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA21 = -SNL*A1
- UA22 = -SNL*A2 + CSL*A3
-*
- VB21 = -SNR*B1
- VB22 = -SNR*B2 + CSR*B3
-*
- AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 )
- AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 )
-*
-* zero (2,2) elements of U**T*A and V**T*B, and then swap.
-*
- IF( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN
- IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 /
- $ ( ABS( VB21 )+ABS( VB22 ) ) ) THEN
- CALL SLARTG( -UA21, UA22, CSQ, SNQ, R )
- ELSE
- CALL SLARTG( -VB21, VB22, CSQ, SNQ, R )
- END IF
- ELSE
- CALL SLARTG( -VB21, VB22, CSQ, SNQ, R )
- END IF
-*
- CSU = SNL
- SNU = CSL
- CSV = SNR
- SNV = CSR
-*
- END IF
-*
- ELSE
-*
-* Input matrices A and B are lower triangular matrices
-*
-* Form matrix C = A*adj(B) = ( a 0 )
-* ( c d )
-*
- A = A1*B3
- D = A3*B1
- C = A2*B3 - A3*B2
-*
-* The SVD of real 2-by-2 triangular C
-*
-* ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 )
-* ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T )
-*
- CALL SLASV2( A, C, D, S1, S2, SNR, CSR, SNL, CSL )
-*
- IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) )
- $ THEN
-*
-* Compute the (2,1) and (2,2) elements of U**T *A and V**T *B,
-* and (2,1) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA21 = -SNR*A1 + CSR*A2
- UA22R = CSR*A3
-*
- VB21 = -SNL*B1 + CSL*B2
- VB22R = CSL*B3
-*
- AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 )
- AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 )
-*
-* zero (2,1) elements of U**T *A and V**T *B.
-*
- IF( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN
- IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 /
- $ ( ABS( VB21 )+ABS( VB22R ) ) ) THEN
- CALL SLARTG( UA22R, UA21, CSQ, SNQ, R )
- ELSE
- CALL SLARTG( VB22R, VB21, CSQ, SNQ, R )
- END IF
- ELSE
- CALL SLARTG( VB22R, VB21, CSQ, SNQ, R )
- END IF
-*
- CSU = CSR
- SNU = -SNR
- CSV = CSL
- SNV = -SNL
-*
- ELSE
-*
-* Compute the (1,1) and (1,2) elements of U**T *A and V**T *B,
-* and (1,1) element of |U|**T *|A| and |V|**T *|B|.
-*
- UA11 = CSR*A1 + SNR*A2
- UA12 = SNR*A3
-*
- VB11 = CSL*B1 + SNL*B2
- VB12 = SNL*B3
-*
- AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 )
- AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 )
-*
-* zero (1,1) elements of U**T*A and V**T*B, and then swap.
-*
- IF( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN
- IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 /
- $ ( ABS( VB11 )+ABS( VB12 ) ) ) THEN
- CALL SLARTG( UA12, UA11, CSQ, SNQ, R )
- ELSE
- CALL SLARTG( VB12, VB11, CSQ, SNQ, R )
- END IF
- ELSE
- CALL SLARTG( VB12, VB11, CSQ, SNQ, R )
- END IF
-*
- CSU = SNR
- SNU = CSR
- CSV = SNL
- SNV = CSL
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SLAGS2
-*
- END
diff --git a/netlib/LAPACK/slagsy.f b/netlib/LAPACK/slagsy.f
deleted file mode 100644
index 6d80a9a..0000000
--- a/netlib/LAPACK/slagsy.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b SLAGSY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGSY generates a real symmetric matrix A, by pre- and post-
-*> multiplying a real diagonal matrix D with a random orthogonal matrix:
-*> A = U*D*U'. The semi-bandwidth may then be reduced to k by additional
-*> orthogonal transformations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of nonzero subdiagonals within the band of A.
-*> 0 <= K <= N-1.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The generated n by n symmetric matrix A (the full matrix is
-*> stored).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= N.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, HALF
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, HALF = 0.5E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL ALPHA, TAU, WA, WB, WN
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SGEMV, SGER, SLARNV, SSCAL, SSYMV,
- $ SSYR2, XERBLA
-* ..
-* .. External Functions ..
- REAL SDOT, SNRM2
- EXTERNAL SDOT, SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( K.LT.0 .OR. K.GT.N-1 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'SLAGSY', -INFO )
- RETURN
- END IF
-*
-* initialize lower triangle of A to diagonal matrix
-*
- DO 20 J = 1, N
- DO 10 I = J + 1, N
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- DO 30 I = 1, N
- A( I, I ) = D( I )
- 30 CONTINUE
-*
-* Generate lower triangle of symmetric matrix
-*
- DO 40 I = N - 1, 1, -1
-*
-* generate random reflection
-*
- CALL SLARNV( 3, ISEED, N-I+1, WORK )
- WN = SNRM2( N-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply random reflection to A(i:n,i:n) from the left
-* and the right
-*
-* compute y := tau * A * u
-*
- CALL SSYMV( 'Lower', N-I+1, TAU, A( I, I ), LDA, WORK, 1, ZERO,
- $ WORK( N+1 ), 1 )
-*
-* compute v := y - 1/2 * tau * ( y, u ) * u
-*
- ALPHA = -HALF*TAU*SDOT( N-I+1, WORK( N+1 ), 1, WORK, 1 )
- CALL SAXPY( N-I+1, ALPHA, WORK, 1, WORK( N+1 ), 1 )
-*
-* apply the transformation as a rank-2 update to A(i:n,i:n)
-*
- CALL SSYR2( 'Lower', N-I+1, -ONE, WORK, 1, WORK( N+1 ), 1,
- $ A( I, I ), LDA )
- 40 CONTINUE
-*
-* Reduce number of subdiagonals to K
-*
- DO 60 I = 1, N - 1 - K
-*
-* generate reflection to annihilate A(k+i+1:n,i)
-*
- WN = SNRM2( N-K-I+1, A( K+I, I ), 1 )
- WA = SIGN( WN, A( K+I, I ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = A( K+I, I ) + WA
- CALL SSCAL( N-K-I, ONE / WB, A( K+I+1, I ), 1 )
- A( K+I, I ) = ONE
- TAU = WB / WA
- END IF
-*
-* apply reflection to A(k+i:n,i+1:k+i-1) from the left
-*
- CALL SGEMV( 'Transpose', N-K-I+1, K-1, ONE, A( K+I, I+1 ), LDA,
- $ A( K+I, I ), 1, ZERO, WORK, 1 )
- CALL SGER( N-K-I+1, K-1, -TAU, A( K+I, I ), 1, WORK, 1,
- $ A( K+I, I+1 ), LDA )
-*
-* apply reflection to A(k+i:n,k+i:n) from the left and the right
-*
-* compute y := tau * A * u
-*
- CALL SSYMV( 'Lower', N-K-I+1, TAU, A( K+I, K+I ), LDA,
- $ A( K+I, I ), 1, ZERO, WORK, 1 )
-*
-* compute v := y - 1/2 * tau * ( y, u ) * u
-*
- ALPHA = -HALF*TAU*SDOT( N-K-I+1, WORK, 1, A( K+I, I ), 1 )
- CALL SAXPY( N-K-I+1, ALPHA, A( K+I, I ), 1, WORK, 1 )
-*
-* apply symmetric rank-2 update to A(k+i:n,k+i:n)
-*
- CALL SSYR2( 'Lower', N-K-I+1, -ONE, A( K+I, I ), 1, WORK, 1,
- $ A( K+I, K+I ), LDA )
-*
- A( K+I, I ) = -WA
- DO 50 J = K + I + 1, N
- A( J, I ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
-* Store full symmetric matrix
-*
- DO 80 J = 1, N
- DO 70 I = J + 1, N
- A( J, I ) = A( I, J )
- 70 CONTINUE
- 80 CONTINUE
- RETURN
-*
-* End of SLAGSY
-*
- END
diff --git a/netlib/LAPACK/slagtf.f b/netlib/LAPACK/slagtf.f
deleted file mode 100644
index a2f2e6d..0000000
--- a/netlib/LAPACK/slagtf.f
+++ /dev/null
@@ -1,266 +0,0 @@
-*> \brief \b SLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAGTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slagtf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slagtf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slagtf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* REAL LAMBDA, TOL
-* ..
-* .. Array Arguments ..
-* INTEGER IN( * )
-* REAL A( * ), B( * ), C( * ), D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
-*> tridiagonal matrix and lambda is a scalar, as
-*>
-*> T - lambda*I = PLU,
-*>
-*> where P is a permutation matrix, L is a unit lower tridiagonal matrix
-*> with at most one non-zero sub-diagonal elements per column and U is
-*> an upper triangular matrix with at most two non-zero super-diagonal
-*> elements per column.
-*>
-*> The factorization is obtained by Gaussian elimination with partial
-*> pivoting and implicit row scaling.
-*>
-*> The parameter LAMBDA is included in the routine so that SLAGTF may
-*> be used, in conjunction with SLAGTS, to obtain eigenvectors of T by
-*> inverse iteration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (N)
-*> On entry, A must contain the diagonal elements of T.
-*>
-*> On exit, A is overwritten by the n diagonal elements of the
-*> upper triangular matrix U of the factorization of T.
-*> \endverbatim
-*>
-*> \param[in] LAMBDA
-*> \verbatim
-*> LAMBDA is REAL
-*> On entry, the scalar lambda.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (N-1)
-*> On entry, B must contain the (n-1) super-diagonal elements of
-*> T.
-*>
-*> On exit, B is overwritten by the (n-1) super-diagonal
-*> elements of the matrix U of the factorization of T.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (N-1)
-*> On entry, C must contain the (n-1) sub-diagonal elements of
-*> T.
-*>
-*> On exit, C is overwritten by the (n-1) sub-diagonal elements
-*> of the matrix L of the factorization of T.
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is REAL
-*> On entry, a relative tolerance used to indicate whether or
-*> not the matrix (T - lambda*I) is nearly singular. TOL should
-*> normally be chose as approximately the largest relative error
-*> in the elements of T. For example, if the elements of T are
-*> correct to about 4 significant figures, then TOL should be
-*> set to about 5*10**(-4). If TOL is supplied as less than eps,
-*> where eps is the relative machine precision, then the value
-*> eps is used in place of TOL.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N-2)
-*> On exit, D is overwritten by the (n-2) second super-diagonal
-*> elements of the matrix U of the factorization of T.
-*> \endverbatim
-*>
-*> \param[out] IN
-*> \verbatim
-*> IN is INTEGER array, dimension (N)
-*> On exit, IN contains details of the permutation matrix P. If
-*> an interchange occurred at the kth step of the elimination,
-*> then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
-*> returns the smallest positive integer j such that
-*>
-*> abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
-*>
-*> where norm( A(j) ) denotes the sum of the absolute values of
-*> the jth row of the matrix A. If no such j exists then IN(n)
-*> is returned as zero. If IN(n) is returned as positive, then a
-*> diagonal element of U is small, indicating that
-*> (T - lambda*I) is singular or nearly singular,
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit
-*> .lt. 0: if INFO = -k, the kth argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
- REAL LAMBDA, TOL
-* ..
-* .. Array Arguments ..
- INTEGER IN( * )
- REAL A( * ), B( * ), C( * ), D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER K
- REAL EPS, MULT, PIV1, PIV2, SCALE1, SCALE2, TEMP, TL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'SLAGTF', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- A( 1 ) = A( 1 ) - LAMBDA
- IN( N ) = 0
- IF( N.EQ.1 ) THEN
- IF( A( 1 ).EQ.ZERO )
- $ IN( 1 ) = 1
- RETURN
- END IF
-*
- EPS = SLAMCH( 'Epsilon' )
-*
- TL = MAX( TOL, EPS )
- SCALE1 = ABS( A( 1 ) ) + ABS( B( 1 ) )
- DO 10 K = 1, N - 1
- A( K+1 ) = A( K+1 ) - LAMBDA
- SCALE2 = ABS( C( K ) ) + ABS( A( K+1 ) )
- IF( K.LT.( N-1 ) )
- $ SCALE2 = SCALE2 + ABS( B( K+1 ) )
- IF( A( K ).EQ.ZERO ) THEN
- PIV1 = ZERO
- ELSE
- PIV1 = ABS( A( K ) ) / SCALE1
- END IF
- IF( C( K ).EQ.ZERO ) THEN
- IN( K ) = 0
- PIV2 = ZERO
- SCALE1 = SCALE2
- IF( K.LT.( N-1 ) )
- $ D( K ) = ZERO
- ELSE
- PIV2 = ABS( C( K ) ) / SCALE2
- IF( PIV2.LE.PIV1 ) THEN
- IN( K ) = 0
- SCALE1 = SCALE2
- C( K ) = C( K ) / A( K )
- A( K+1 ) = A( K+1 ) - C( K )*B( K )
- IF( K.LT.( N-1 ) )
- $ D( K ) = ZERO
- ELSE
- IN( K ) = 1
- MULT = A( K ) / C( K )
- A( K ) = C( K )
- TEMP = A( K+1 )
- A( K+1 ) = B( K ) - MULT*TEMP
- IF( K.LT.( N-1 ) ) THEN
- D( K ) = B( K+1 )
- B( K+1 ) = -MULT*D( K )
- END IF
- B( K ) = TEMP
- C( K ) = MULT
- END IF
- END IF
- IF( ( MAX( PIV1, PIV2 ).LE.TL ) .AND. ( IN( N ).EQ.0 ) )
- $ IN( N ) = K
- 10 CONTINUE
- IF( ( ABS( A( N ) ).LE.SCALE1*TL ) .AND. ( IN( N ).EQ.0 ) )
- $ IN( N ) = N
-*
- RETURN
-*
-* End of SLAGTF
-*
- END
diff --git a/netlib/LAPACK/slagtm.f b/netlib/LAPACK/slagtm.f
deleted file mode 100644
index 41f4ace..0000000
--- a/netlib/LAPACK/slagtm.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b SLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAGTM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slagtm.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slagtm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slagtm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
-* B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER LDB, LDX, N, NRHS
-* REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), D( * ), DL( * ), DU( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGTM performs a matrix-vector product of the form
-*>
-*> B := alpha * A * X + beta * B
-*>
-*> where A is a tridiagonal matrix of order N, B and X are N by NRHS
-*> matrices, and alpha and beta are real scalars, each of which may be
-*> 0., 1., or -1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': No transpose, B := alpha * A * X + beta * B
-*> = 'T': Transpose, B := alpha * A'* X + beta * B
-*> = 'C': Conjugate transpose = Transpose
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices X and B.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
-*> it is assumed to be 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) sub-diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) super-diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> The N by NRHS matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(N,1).
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
-*> it is assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N by NRHS matrix B.
-*> On exit, B is overwritten by the matrix expression
-*> B := alpha * A * X + beta * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(N,1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
- $ B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER LDB, LDX, N, NRHS
- REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), D( * ), DL( * ), DU( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Multiply B by BETA if BETA.NE.1.
-*
- IF( BETA.EQ.ZERO ) THEN
- DO 20 J = 1, NRHS
- DO 10 I = 1, N
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( BETA.EQ.-ONE ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = -B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
-*
- IF( ALPHA.EQ.ONE ) THEN
- IF( LSAME( TRANS, 'N' ) ) THEN
-*
-* Compute B := B + A*X
-*
- DO 60 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
- $ DU( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
- $ D( N )*X( N, J )
- DO 50 I = 2, N - 1
- B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
- $ D( I )*X( I, J ) + DU( I )*X( I+1, J )
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
-*
-* Compute B := B + A**T*X
-*
- DO 80 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
- $ DL( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
- $ D( N )*X( N, J )
- DO 70 I = 2, N - 1
- B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
- $ D( I )*X( I, J ) + DL( I )*X( I+1, J )
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
- ELSE IF( ALPHA.EQ.-ONE ) THEN
- IF( LSAME( TRANS, 'N' ) ) THEN
-*
-* Compute B := B - A*X
-*
- DO 100 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
- $ DU( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
- $ D( N )*X( N, J )
- DO 90 I = 2, N - 1
- B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
- $ D( I )*X( I, J ) - DU( I )*X( I+1, J )
- 90 CONTINUE
- END IF
- 100 CONTINUE
- ELSE
-*
-* Compute B := B - A**T*X
-*
- DO 120 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
- $ DL( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
- $ D( N )*X( N, J )
- DO 110 I = 2, N - 1
- B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
- $ D( I )*X( I, J ) - DL( I )*X( I+1, J )
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of SLAGTM
-*
- END
diff --git a/netlib/LAPACK/slagts.f b/netlib/LAPACK/slagts.f
deleted file mode 100644
index 7d579b8..0000000
--- a/netlib/LAPACK/slagts.f
+++ /dev/null
@@ -1,383 +0,0 @@
-*> \brief \b SLAGTS solves the system of equations (T-λI)x = y or (T-λI)Tx = y,where T is a general tridiagonal matrix and λ a scalar, using the LU factorization computed by slagtf.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAGTS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slagts.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slagts.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slagts.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGTS( JOB, N, A, B, C, D, IN, Y, TOL, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, JOB, N
-* REAL TOL
-* ..
-* .. Array Arguments ..
-* INTEGER IN( * )
-* REAL A( * ), B( * ), C( * ), D( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGTS may be used to solve one of the systems of equations
-*>
-*> (T - lambda*I)*x = y or (T - lambda*I)**T*x = y,
-*>
-*> where T is an n by n tridiagonal matrix, for x, following the
-*> factorization of (T - lambda*I) as
-*>
-*> (T - lambda*I) = P*L*U ,
-*>
-*> by routine SLAGTF. The choice of equation to be solved is
-*> controlled by the argument JOB, and in each case there is an option
-*> to perturb zero or very small diagonal elements of U, this option
-*> being intended for use in applications such as inverse iteration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is INTEGER
-*> Specifies the job to be performed by SLAGTS as follows:
-*> = 1: The equations (T - lambda*I)x = y are to be solved,
-*> but diagonal elements of U are not to be perturbed.
-*> = -1: The equations (T - lambda*I)x = y are to be solved
-*> and, if overflow would otherwise occur, the diagonal
-*> elements of U are to be perturbed. See argument TOL
-*> below.
-*> = 2: The equations (T - lambda*I)**Tx = y are to be solved,
-*> but diagonal elements of U are not to be perturbed.
-*> = -2: The equations (T - lambda*I)**Tx = y are to be solved
-*> and, if overflow would otherwise occur, the diagonal
-*> elements of U are to be perturbed. See argument TOL
-*> below.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (N)
-*> On entry, A must contain the diagonal elements of U as
-*> returned from SLAGTF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (N-1)
-*> On entry, B must contain the first super-diagonal elements of
-*> U as returned from SLAGTF.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N-1)
-*> On entry, C must contain the sub-diagonal elements of L as
-*> returned from SLAGTF.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N-2)
-*> On entry, D must contain the second super-diagonal elements
-*> of U as returned from SLAGTF.
-*> \endverbatim
-*>
-*> \param[in] IN
-*> \verbatim
-*> IN is INTEGER array, dimension (N)
-*> On entry, IN must contain details of the matrix P as returned
-*> from SLAGTF.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array, dimension (N)
-*> On entry, the right hand side vector y.
-*> On exit, Y is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[in,out] TOL
-*> \verbatim
-*> TOL is REAL
-*> On entry, with JOB .lt. 0, TOL should be the minimum
-*> perturbation to be made to very small diagonal elements of U.
-*> TOL should normally be chosen as about eps*norm(U), where eps
-*> is the relative machine precision, but if TOL is supplied as
-*> non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
-*> If JOB .gt. 0 then TOL is not referenced.
-*>
-*> On exit, TOL is changed as described above, only if TOL is
-*> non-positive on entry. Otherwise TOL is unchanged.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit
-*> .lt. 0: if INFO = -i, the i-th argument had an illegal value
-*> .gt. 0: overflow would occur when computing the INFO(th)
-*> element of the solution vector x. This can only occur
-*> when JOB is supplied as positive and either means
-*> that a diagonal element of U is very small, or that
-*> the elements of the right-hand side vector y are very
-*> large.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAGTS( JOB, N, A, B, C, D, IN, Y, TOL, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, JOB, N
- REAL TOL
-* ..
-* .. Array Arguments ..
- INTEGER IN( * )
- REAL A( * ), B( * ), C( * ), D( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER K
- REAL ABSAK, AK, BIGNUM, EPS, PERT, SFMIN, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SIGN
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( ( ABS( JOB ).GT.2 ) .OR. ( JOB.EQ.0 ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAGTS', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- EPS = SLAMCH( 'Epsilon' )
- SFMIN = SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SFMIN
-*
- IF( JOB.LT.0 ) THEN
- IF( TOL.LE.ZERO ) THEN
- TOL = ABS( A( 1 ) )
- IF( N.GT.1 )
- $ TOL = MAX( TOL, ABS( A( 2 ) ), ABS( B( 1 ) ) )
- DO 10 K = 3, N
- TOL = MAX( TOL, ABS( A( K ) ), ABS( B( K-1 ) ),
- $ ABS( D( K-2 ) ) )
- 10 CONTINUE
- TOL = TOL*EPS
- IF( TOL.EQ.ZERO )
- $ TOL = EPS
- END IF
- END IF
-*
- IF( ABS( JOB ).EQ.1 ) THEN
- DO 20 K = 2, N
- IF( IN( K-1 ).EQ.0 ) THEN
- Y( K ) = Y( K ) - C( K-1 )*Y( K-1 )
- ELSE
- TEMP = Y( K-1 )
- Y( K-1 ) = Y( K )
- Y( K ) = TEMP - C( K-1 )*Y( K )
- END IF
- 20 CONTINUE
- IF( JOB.EQ.1 ) THEN
- DO 30 K = N, 1, -1
- IF( K.LE.N-2 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 ) - D( K )*Y( K+2 )
- ELSE IF( K.EQ.N-1 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- INFO = K
- RETURN
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- INFO = K
- RETURN
- END IF
- END IF
- Y( K ) = TEMP / AK
- 30 CONTINUE
- ELSE
- DO 50 K = N, 1, -1
- IF( K.LE.N-2 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 ) - D( K )*Y( K+2 )
- ELSE IF( K.EQ.N-1 ) THEN
- TEMP = Y( K ) - B( K )*Y( K+1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- PERT = SIGN( TOL, AK )
- 40 CONTINUE
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 40
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 40
- END IF
- END IF
- Y( K ) = TEMP / AK
- 50 CONTINUE
- END IF
- ELSE
-*
-* Come to here if JOB = 2 or -2
-*
- IF( JOB.EQ.2 ) THEN
- DO 60 K = 1, N
- IF( K.GE.3 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 ) - D( K-2 )*Y( K-2 )
- ELSE IF( K.EQ.2 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- INFO = K
- RETURN
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- INFO = K
- RETURN
- END IF
- END IF
- Y( K ) = TEMP / AK
- 60 CONTINUE
- ELSE
- DO 80 K = 1, N
- IF( K.GE.3 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 ) - D( K-2 )*Y( K-2 )
- ELSE IF( K.EQ.2 ) THEN
- TEMP = Y( K ) - B( K-1 )*Y( K-1 )
- ELSE
- TEMP = Y( K )
- END IF
- AK = A( K )
- PERT = SIGN( TOL, AK )
- 70 CONTINUE
- ABSAK = ABS( AK )
- IF( ABSAK.LT.ONE ) THEN
- IF( ABSAK.LT.SFMIN ) THEN
- IF( ABSAK.EQ.ZERO .OR. ABS( TEMP )*SFMIN.GT.ABSAK )
- $ THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 70
- ELSE
- TEMP = TEMP*BIGNUM
- AK = AK*BIGNUM
- END IF
- ELSE IF( ABS( TEMP ).GT.ABSAK*BIGNUM ) THEN
- AK = AK + PERT
- PERT = 2*PERT
- GO TO 70
- END IF
- END IF
- Y( K ) = TEMP / AK
- 80 CONTINUE
- END IF
-*
- DO 90 K = N, 2, -1
- IF( IN( K-1 ).EQ.0 ) THEN
- Y( K-1 ) = Y( K-1 ) - C( K-1 )*Y( K )
- ELSE
- TEMP = Y( K-1 )
- Y( K-1 ) = Y( K )
- Y( K ) = TEMP - C( K-1 )*Y( K )
- END IF
- 90 CONTINUE
- END IF
-*
-* End of SLAGTS
-*
- END
diff --git a/netlib/LAPACK/slagv2.f b/netlib/LAPACK/slagv2.f
deleted file mode 100644
index cbdf00c..0000000
--- a/netlib/LAPACK/slagv2.f
+++ /dev/null
@@ -1,374 +0,0 @@
-*> \brief \b SLAGV2 computes the Generalized Schur factorization of a real 2-by-2 matrix pencil (A,B) where B is upper triangular.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAGV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slagv2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slagv2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slagv2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
-* CSR, SNR )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDB
-* REAL CSL, CSR, SNL, SNR
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
-* $ B( LDB, * ), BETA( 2 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAGV2 computes the Generalized Schur factorization of a real 2-by-2
-*> matrix pencil (A,B) where B is upper triangular. This routine
-*> computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
-*> SNR such that
-*>
-*> 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
-*> types), then
-*>
-*> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
-*> [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
-*>
-*> [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
-*> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
-*>
-*> 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
-*> then
-*>
-*> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
-*> [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
-*>
-*> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
-*> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
-*>
-*> where b11 >= b22 > 0.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, 2)
-*> On entry, the 2 x 2 matrix A.
-*> On exit, A is overwritten by the ``A-part'' of the
-*> generalized Schur form.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> THe leading dimension of the array A. LDA >= 2.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, 2)
-*> On entry, the upper triangular 2 x 2 matrix B.
-*> On exit, B is overwritten by the ``B-part'' of the
-*> generalized Schur form.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> THe leading dimension of the array B. LDB >= 2.
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (2)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (2)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (2)
-*> (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
-*> pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
-*> be zero.
-*> \endverbatim
-*>
-*> \param[out] CSL
-*> \verbatim
-*> CSL is REAL
-*> The cosine of the left rotation matrix.
-*> \endverbatim
-*>
-*> \param[out] SNL
-*> \verbatim
-*> SNL is REAL
-*> The sine of the left rotation matrix.
-*> \endverbatim
-*>
-*> \param[out] CSR
-*> \verbatim
-*> CSR is REAL
-*> The cosine of the right rotation matrix.
-*> \endverbatim
-*>
-*> \param[out] SNR
-*> \verbatim
-*> SNR is REAL
-*> The sine of the right rotation matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE SLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
- $ CSR, SNR )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDB
- REAL CSL, CSR, SNL, SNR
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
- $ B( LDB, * ), BETA( 2 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL ANORM, ASCALE, BNORM, BSCALE, H1, H2, H3, QQ,
- $ R, RR, SAFMIN, SCALE1, SCALE2, T, ULP, WI, WR1,
- $ WR2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAG2, SLARTG, SLASV2, SROT
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLAPY2
- EXTERNAL SLAMCH, SLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- SAFMIN = SLAMCH( 'S' )
- ULP = SLAMCH( 'P' )
-*
-* Scale A
-*
- ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
- $ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
- ASCALE = ONE / ANORM
- A( 1, 1 ) = ASCALE*A( 1, 1 )
- A( 1, 2 ) = ASCALE*A( 1, 2 )
- A( 2, 1 ) = ASCALE*A( 2, 1 )
- A( 2, 2 ) = ASCALE*A( 2, 2 )
-*
-* Scale B
-*
- BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 1, 2 ) )+ABS( B( 2, 2 ) ),
- $ SAFMIN )
- BSCALE = ONE / BNORM
- B( 1, 1 ) = BSCALE*B( 1, 1 )
- B( 1, 2 ) = BSCALE*B( 1, 2 )
- B( 2, 2 ) = BSCALE*B( 2, 2 )
-*
-* Check if A can be deflated
-*
- IF( ABS( A( 2, 1 ) ).LE.ULP ) THEN
- CSL = ONE
- SNL = ZERO
- CSR = ONE
- SNR = ZERO
- A( 2, 1 ) = ZERO
- B( 2, 1 ) = ZERO
- WI = ZERO
-*
-* Check if B is singular
-*
- ELSE IF( ABS( B( 1, 1 ) ).LE.ULP ) THEN
- CALL SLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
- CSR = ONE
- SNR = ZERO
- CALL SROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
- CALL SROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
- A( 2, 1 ) = ZERO
- B( 1, 1 ) = ZERO
- B( 2, 1 ) = ZERO
- WI = ZERO
-*
- ELSE IF( ABS( B( 2, 2 ) ).LE.ULP ) THEN
- CALL SLARTG( A( 2, 2 ), A( 2, 1 ), CSR, SNR, T )
- SNR = -SNR
- CALL SROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
- CALL SROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
- CSL = ONE
- SNL = ZERO
- A( 2, 1 ) = ZERO
- B( 2, 1 ) = ZERO
- B( 2, 2 ) = ZERO
- WI = ZERO
-*
- ELSE
-*
-* B is nonsingular, first compute the eigenvalues of (A,B)
-*
- CALL SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2,
- $ WI )
-*
- IF( WI.EQ.ZERO ) THEN
-*
-* two real eigenvalues, compute s*A-w*B
-*
- H1 = SCALE1*A( 1, 1 ) - WR1*B( 1, 1 )
- H2 = SCALE1*A( 1, 2 ) - WR1*B( 1, 2 )
- H3 = SCALE1*A( 2, 2 ) - WR1*B( 2, 2 )
-*
- RR = SLAPY2( H1, H2 )
- QQ = SLAPY2( SCALE1*A( 2, 1 ), H3 )
-*
- IF( RR.GT.QQ ) THEN
-*
-* find right rotation matrix to zero 1,1 element of
-* (sA - wB)
-*
- CALL SLARTG( H2, H1, CSR, SNR, T )
-*
- ELSE
-*
-* find right rotation matrix to zero 2,1 element of
-* (sA - wB)
-*
- CALL SLARTG( H3, SCALE1*A( 2, 1 ), CSR, SNR, T )
-*
- END IF
-*
- SNR = -SNR
- CALL SROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
- CALL SROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-*
-* compute inf norms of A and B
-*
- H1 = MAX( ABS( A( 1, 1 ) )+ABS( A( 1, 2 ) ),
- $ ABS( A( 2, 1 ) )+ABS( A( 2, 2 ) ) )
- H2 = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
- $ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
-*
- IF( ( SCALE1*H1 ).GE.ABS( WR1 )*H2 ) THEN
-*
-* find left rotation matrix Q to zero out B(2,1)
-*
- CALL SLARTG( B( 1, 1 ), B( 2, 1 ), CSL, SNL, R )
-*
- ELSE
-*
-* find left rotation matrix Q to zero out A(2,1)
-*
- CALL SLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
-*
- END IF
-*
- CALL SROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
- CALL SROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
-*
- A( 2, 1 ) = ZERO
- B( 2, 1 ) = ZERO
-*
- ELSE
-*
-* a pair of complex conjugate eigenvalues
-* first compute the SVD of the matrix B
-*
- CALL SLASV2( B( 1, 1 ), B( 1, 2 ), B( 2, 2 ), R, T, SNR,
- $ CSR, SNL, CSL )
-*
-* Form (A,B) := Q(A,B)Z**T where Q is left rotation matrix and
-* Z is right rotation matrix computed from SLASV2
-*
- CALL SROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
- CALL SROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
- CALL SROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
- CALL SROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-*
- B( 2, 1 ) = ZERO
- B( 1, 2 ) = ZERO
-*
- END IF
-*
- END IF
-*
-* Unscaling
-*
- A( 1, 1 ) = ANORM*A( 1, 1 )
- A( 2, 1 ) = ANORM*A( 2, 1 )
- A( 1, 2 ) = ANORM*A( 1, 2 )
- A( 2, 2 ) = ANORM*A( 2, 2 )
- B( 1, 1 ) = BNORM*B( 1, 1 )
- B( 2, 1 ) = BNORM*B( 2, 1 )
- B( 1, 2 ) = BNORM*B( 1, 2 )
- B( 2, 2 ) = BNORM*B( 2, 2 )
-*
- IF( WI.EQ.ZERO ) THEN
- ALPHAR( 1 ) = A( 1, 1 )
- ALPHAR( 2 ) = A( 2, 2 )
- ALPHAI( 1 ) = ZERO
- ALPHAI( 2 ) = ZERO
- BETA( 1 ) = B( 1, 1 )
- BETA( 2 ) = B( 2, 2 )
- ELSE
- ALPHAR( 1 ) = ANORM*WR1 / SCALE1 / BNORM
- ALPHAI( 1 ) = ANORM*WI / SCALE1 / BNORM
- ALPHAR( 2 ) = ALPHAR( 1 )
- ALPHAI( 2 ) = -ALPHAI( 1 )
- BETA( 1 ) = ONE
- BETA( 2 ) = ONE
- END IF
-*
- RETURN
-*
-* End of SLAGV2
-*
- END
diff --git a/netlib/LAPACK/slahilb.f b/netlib/LAPACK/slahilb.f
deleted file mode 100644
index 6a18529..0000000
--- a/netlib/LAPACK/slahilb.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief \b SLAHILB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER N, NRHS, LDA, LDX, LDB, INFO
-* .. Array Arguments ..
-* REAL A(LDA, N), X(LDX, NRHS), B(LDB, NRHS), WORK(N)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAHILB generates an N by N scaled Hilbert matrix in A along with
-*> NRHS right-hand sides in B and solutions in X such that A*X=B.
-*>
-*> The Hilbert matrix is scaled by M = LCM(1, 2, ..., 2*N-1) so that all
-*> entries are integers. The right-hand sides are the first NRHS
-*> columns of M * the identity matrix, and the solutions are the
-*> first NRHS columns of the inverse Hilbert matrix.
-*>
-*> The condition number of the Hilbert matrix grows exponentially with
-*> its size, roughly as O(e ** (3.5*N)). Additionally, the inverse
-*> Hilbert matrices beyond a relatively small dimension cannot be
-*> generated exactly without extra precision. Precision is exhausted
-*> when the largest entry in the inverse Hilbert matrix is greater than
-*> 2 to the power of the number of bits in the fraction of the data type
-*> used plus one, which is 24 for single precision.
-*>
-*> In single, the generated solution is exact for N <= 6 and has
-*> small componentwise error for 7 <= N <= 11.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The requested number of right-hand sides.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> The generated scaled Hilbert matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= N.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX, NRHS)
-*> The generated exact solutions. Currently, the first NRHS
-*> columns of the inverse Hilbert matrix.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= N.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, NRHS)
-*> The generated right-hand sides. Currently, the first NRHS
-*> columns of LCM(1, 2, ..., 2*N-1) * the identity matrix.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: N is too large; the data is still generated but may not
-*> be not exact.
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER N, NRHS, LDA, LDX, LDB, INFO
-* .. Array Arguments ..
- REAL A(LDA, N), X(LDX, NRHS), B(LDB, NRHS), WORK(N)
-* ..
-*
-* =====================================================================
-* .. Local Scalars ..
- INTEGER TM, TI, R
- INTEGER M
- INTEGER I, J
-
-* .. Parameters ..
-* NMAX_EXACT the largest dimension where the generated data is
-* exact.
-* NMAX_APPROX the largest dimension where the generated data has
-* a small componentwise relative error.
- INTEGER NMAX_EXACT, NMAX_APPROX
- PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11)
-
-* ..
-* .. External Functions
- EXTERNAL SLASET
- INTRINSIC REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF (N .LT. 0 .OR. N .GT. NMAX_APPROX) THEN
- INFO = -1
- ELSE IF (NRHS .LT. 0) THEN
- INFO = -2
- ELSE IF (LDA .LT. N) THEN
- INFO = -4
- ELSE IF (LDX .LT. N) THEN
- INFO = -6
- ELSE IF (LDB .LT. N) THEN
- INFO = -8
- END IF
- IF (INFO .LT. 0) THEN
- CALL XERBLA('SLAHILB', -INFO)
- RETURN
- END IF
- IF (N .GT. NMAX_EXACT) THEN
- INFO = 1
- END IF
-
-* Compute M = the LCM of the integers [1, 2*N-1]. The largest
-* reasonable N is small enough that integers suffice (up to N = 11).
- M = 1
- DO I = 2, (2*N-1)
- TM = M
- TI = I
- R = MOD(TM, TI)
- DO WHILE (R .NE. 0)
- TM = TI
- TI = R
- R = MOD(TM, TI)
- END DO
- M = (M / TI) * I
- END DO
-
-* Generate the scaled Hilbert matrix in A
- DO J = 1, N
- DO I = 1, N
- A(I, J) = REAL(M) / (I + J - 1)
- END DO
- END DO
-
-* Generate matrix B as simply the first NRHS columns of M * the
-* identity.
- CALL SLASET('Full', N, NRHS, 0.0, REAL(M), B, LDB)
-
-* Generate the true solutions in X. Because B = the first NRHS
-* columns of M*I, the true solutions are just the first NRHS columns
-* of the inverse Hilbert matrix.
- WORK(1) = N
- DO J = 2, N
- WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) )
- $ * (N +J -1)
- END DO
-
- DO J = 1, NRHS
- DO I = 1, N
- X(I, J) = (WORK(I)*WORK(J)) / (I + J - 1)
- END DO
- END DO
-
- END
-
diff --git a/netlib/LAPACK/slahqr.f b/netlib/LAPACK/slahqr.f
deleted file mode 100644
index b3caf68..0000000
--- a/netlib/LAPACK/slahqr.f
+++ /dev/null
@@ -1,611 +0,0 @@
-*> \brief \b SLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAHQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slahqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slahqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slahqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAHQR is an auxiliary routine called by SHSEQR to update the
-*> eigenvalues and Schur decomposition already computed by SHSEQR, by
-*> dealing with the Hessenberg submatrix in rows and columns ILO to
-*> IHI.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper quasi-triangular in
-*> rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-*> ILO = 1). SLAHQR works primarily with the Hessenberg
-*> submatrix in rows and columns ILO to IHI, but applies
-*> transformations to all of H if WANTT is .TRUE..
-*> 1 <= ILO <= max(1,IHI); IHI <= N.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO is zero and if WANTT is .TRUE., H is upper
-*> quasi-triangular in rows and columns ILO:IHI, with any
-*> 2-by-2 diagonal blocks in standard form. If INFO is zero
-*> and WANTT is .FALSE., the contents of H are unspecified on
-*> exit. The output state of H if INFO is nonzero is given
-*> below under the description of INFO.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues ILO to IHI are stored in the corresponding
-*> elements of WR and WI. If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-*> eigenvalues are stored in the same order as on the diagonal
-*> of the Schur form returned in H, with WR(i) = H(i,i), and, if
-*> H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-*> WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> If WANTZ is .TRUE., on entry Z must contain the current
-*> matrix Z of transformations accumulated by SHSEQR, and on
-*> exit Z has been updated; transformations are applied only to
-*> the submatrix Z(ILOZ:IHIZ,ILO:IHI).
-*> If WANTZ is .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: If INFO = i, SLAHQR failed to compute all the
-*> eigenvalues ILO to IHI in a total of 30 iterations
-*> per eigenvalue; elements i+1:ihi of WR and WI
-*> contain those eigenvalues which have been
-*> successfully computed.
-*>
-*> If INFO .GT. 0 and WANTT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the
-*> eigenvalues of the upper Hessenberg matrix rows
-*> and columns ILO thorugh INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*> (*) (initial value of H)*U = U*(final value of H)
-*> where U is an orthognal matrix. The final
-*> value of H is upper Hessenberg and triangular in
-*> rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*> (final value of Z) = (initial value of Z)*U
-*> where U is the orthogonal matrix in (*)
-*> (regardless of the value of WANTT.)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> 02-96 Based on modifications by
-*> David Day, Sandia National Laboratory, USA
-*>
-*> 12-04 Further modifications by
-*> Ralph Byers, University of Kansas, USA
-*> This is a modified version of SLAHQR from LAPACK version 3.0.
-*> It is (1) more robust against overflow and underflow and
-*> (2) adopts the more conservative Ahues & Tisseur stopping
-*> criterion (LAWN 122, 1997).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-* ..
-*
-* =========================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 30 )
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0, TWO = 2.0e0 )
- REAL DAT1, DAT2
- PARAMETER ( DAT1 = 3.0e0 / 4.0e0, DAT2 = -0.4375e0 )
-* ..
-* .. Local Scalars ..
- REAL AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S,
- $ H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX,
- $ SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST,
- $ ULP, V2, V3
- INTEGER I, I1, I2, ITS, J, K, L, M, NH, NR, NZ
-* ..
-* .. Local Arrays ..
- REAL V( 3 )
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLABAD, SLANV2, SLARFG, SROT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( ILO.EQ.IHI ) THEN
- WR( ILO ) = H( ILO, ILO )
- WI( ILO ) = ZERO
- RETURN
- END IF
-*
-* ==== clear out the trash ====
- DO 10 J = ILO, IHI - 3
- H( J+2, J ) = ZERO
- H( J+3, J ) = ZERO
- 10 CONTINUE
- IF( ILO.LE.IHI-2 )
- $ H( IHI, IHI-2 ) = ZERO
-*
- NH = IHI - ILO + 1
- NZ = IHIZ - ILOZ + 1
-*
-* Set machine-dependent constants for the stopping criterion.
-*
- SAFMIN = SLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL SLABAD( SAFMIN, SAFMAX )
- ULP = SLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( REAL( NH ) / ULP )
-*
-* I1 and I2 are the indices of the first row and last column of H
-* to which transformations must be applied. If eigenvalues only are
-* being computed, I1 and I2 are set inside the main loop.
-*
- IF( WANTT ) THEN
- I1 = 1
- I2 = N
- END IF
-*
-* The main loop begins here. I is the loop index and decreases from
-* IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-* with the active submatrix in rows and columns L to I.
-* Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-* H(L,L-1) is negligible so that the matrix splits.
-*
- I = IHI
- 20 CONTINUE
- L = ILO
- IF( I.LT.ILO )
- $ GO TO 160
-*
-* Perform QR iterations on rows and columns ILO to I until a
-* submatrix of order 1 or 2 splits off at the bottom because a
-* subdiagonal element has become negligible.
-*
- DO 140 ITS = 0, ITMAX
-*
-* Look for a single small subdiagonal element.
-*
- DO 30 K = I, L + 1, -1
- IF( ABS( H( K, K-1 ) ).LE.SMLNUM )
- $ GO TO 40
- TST = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) )
- IF( TST.EQ.ZERO ) THEN
- IF( K-2.GE.ILO )
- $ TST = TST + ABS( H( K-1, K-2 ) )
- IF( K+1.LE.IHI )
- $ TST = TST + ABS( H( K+1, K ) )
- END IF
-* ==== The following is a conservative small subdiagonal
-* . deflation criterion due to Ahues & Tisseur (LAWN 122,
-* . 1997). It has better mathematical foundation and
-* . improves accuracy in some cases. ====
- IF( ABS( H( K, K-1 ) ).LE.ULP*TST ) THEN
- AB = MAX( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
- BA = MIN( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
- AA = MAX( ABS( H( K, K ) ),
- $ ABS( H( K-1, K-1 )-H( K, K ) ) )
- BB = MIN( ABS( H( K, K ) ),
- $ ABS( H( K-1, K-1 )-H( K, K ) ) )
- S = AA + AB
- IF( BA*( AB / S ).LE.MAX( SMLNUM,
- $ ULP*( BB*( AA / S ) ) ) )GO TO 40
- END IF
- 30 CONTINUE
- 40 CONTINUE
- L = K
- IF( L.GT.ILO ) THEN
-*
-* H(L,L-1) is negligible
-*
- H( L, L-1 ) = ZERO
- END IF
-*
-* Exit from loop if a submatrix of order 1 or 2 has split off.
-*
- IF( L.GE.I-1 )
- $ GO TO 150
-*
-* Now the active submatrix is in rows and columns L to I. If
-* eigenvalues only are being computed, only the active submatrix
-* need be transformed.
-*
- IF( .NOT.WANTT ) THEN
- I1 = L
- I2 = I
- END IF
-*
- IF( ITS.EQ.10 ) THEN
-*
-* Exceptional shift.
-*
- S = ABS( H( L+1, L ) ) + ABS( H( L+2, L+1 ) )
- H11 = DAT1*S + H( L, L )
- H12 = DAT2*S
- H21 = S
- H22 = H11
- ELSE IF( ITS.EQ.20 ) THEN
-*
-* Exceptional shift.
-*
- S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- H11 = DAT1*S + H( I, I )
- H12 = DAT2*S
- H21 = S
- H22 = H11
- ELSE
-*
-* Prepare to use Francis' double shift
-* (i.e. 2nd degree generalized Rayleigh quotient)
-*
- H11 = H( I-1, I-1 )
- H21 = H( I, I-1 )
- H12 = H( I-1, I )
- H22 = H( I, I )
- END IF
- S = ABS( H11 ) + ABS( H12 ) + ABS( H21 ) + ABS( H22 )
- IF( S.EQ.ZERO ) THEN
- RT1R = ZERO
- RT1I = ZERO
- RT2R = ZERO
- RT2I = ZERO
- ELSE
- H11 = H11 / S
- H21 = H21 / S
- H12 = H12 / S
- H22 = H22 / S
- TR = ( H11+H22 ) / TWO
- DET = ( H11-TR )*( H22-TR ) - H12*H21
- RTDISC = SQRT( ABS( DET ) )
- IF( DET.GE.ZERO ) THEN
-*
-* ==== complex conjugate shifts ====
-*
- RT1R = TR*S
- RT2R = RT1R
- RT1I = RTDISC*S
- RT2I = -RT1I
- ELSE
-*
-* ==== real shifts (use only one of them) ====
-*
- RT1R = TR + RTDISC
- RT2R = TR - RTDISC
- IF( ABS( RT1R-H22 ).LE.ABS( RT2R-H22 ) ) THEN
- RT1R = RT1R*S
- RT2R = RT1R
- ELSE
- RT2R = RT2R*S
- RT1R = RT2R
- END IF
- RT1I = ZERO
- RT2I = ZERO
- END IF
- END IF
-*
-* Look for two consecutive small subdiagonal elements.
-*
- DO 50 M = I - 2, L, -1
-* Determine the effect of starting the double-shift QR
-* iteration at row M, and see if this would make H(M,M-1)
-* negligible. (The following uses scaling to avoid
-* overflows and most underflows.)
-*
- H21S = H( M+1, M )
- S = ABS( H( M, M )-RT2R ) + ABS( RT2I ) + ABS( H21S )
- H21S = H( M+1, M ) / S
- V( 1 ) = H21S*H( M, M+1 ) + ( H( M, M )-RT1R )*
- $ ( ( H( M, M )-RT2R ) / S ) - RT1I*( RT2I / S )
- V( 2 ) = H21S*( H( M, M )+H( M+1, M+1 )-RT1R-RT2R )
- V( 3 ) = H21S*H( M+2, M+1 )
- S = ABS( V( 1 ) ) + ABS( V( 2 ) ) + ABS( V( 3 ) )
- V( 1 ) = V( 1 ) / S
- V( 2 ) = V( 2 ) / S
- V( 3 ) = V( 3 ) / S
- IF( M.EQ.L )
- $ GO TO 60
- IF( ABS( H( M, M-1 ) )*( ABS( V( 2 ) )+ABS( V( 3 ) ) ).LE.
- $ ULP*ABS( V( 1 ) )*( ABS( H( M-1, M-1 ) )+ABS( H( M,
- $ M ) )+ABS( H( M+1, M+1 ) ) ) )GO TO 60
- 50 CONTINUE
- 60 CONTINUE
-*
-* Double-shift QR step
-*
- DO 130 K = M, I - 1
-*
-* The first iteration of this loop determines a reflection G
-* from the vector V and applies it from left and right to H,
-* thus creating a nonzero bulge below the subdiagonal.
-*
-* Each subsequent iteration determines a reflection G to
-* restore the Hessenberg form in the (K-1)th column, and thus
-* chases the bulge one step toward the bottom of the active
-* submatrix. NR is the order of G.
-*
- NR = MIN( 3, I-K+1 )
- IF( K.GT.M )
- $ CALL SCOPY( NR, H( K, K-1 ), 1, V, 1 )
- CALL SLARFG( NR, V( 1 ), V( 2 ), 1, T1 )
- IF( K.GT.M ) THEN
- H( K, K-1 ) = V( 1 )
- H( K+1, K-1 ) = ZERO
- IF( K.LT.I-1 )
- $ H( K+2, K-1 ) = ZERO
- ELSE IF( M.GT.L ) THEN
-* ==== Use the following instead of
-* . H( K, K-1 ) = -H( K, K-1 ) to
-* . avoid a bug when v(2) and v(3)
-* . underflow. ====
- H( K, K-1 ) = H( K, K-1 )*( ONE-T1 )
- END IF
- V2 = V( 2 )
- T2 = T1*V2
- IF( NR.EQ.3 ) THEN
- V3 = V( 3 )
- T3 = T1*V3
-*
-* Apply G from the left to transform the rows of the matrix
-* in columns K to I2.
-*
- DO 70 J = K, I2
- SUM = H( K, J ) + V2*H( K+1, J ) + V3*H( K+2, J )
- H( K, J ) = H( K, J ) - SUM*T1
- H( K+1, J ) = H( K+1, J ) - SUM*T2
- H( K+2, J ) = H( K+2, J ) - SUM*T3
- 70 CONTINUE
-*
-* Apply G from the right to transform the columns of the
-* matrix in rows I1 to min(K+3,I).
-*
- DO 80 J = I1, MIN( K+3, I )
- SUM = H( J, K ) + V2*H( J, K+1 ) + V3*H( J, K+2 )
- H( J, K ) = H( J, K ) - SUM*T1
- H( J, K+1 ) = H( J, K+1 ) - SUM*T2
- H( J, K+2 ) = H( J, K+2 ) - SUM*T3
- 80 CONTINUE
-*
- IF( WANTZ ) THEN
-*
-* Accumulate transformations in the matrix Z
-*
- DO 90 J = ILOZ, IHIZ
- SUM = Z( J, K ) + V2*Z( J, K+1 ) + V3*Z( J, K+2 )
- Z( J, K ) = Z( J, K ) - SUM*T1
- Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
- Z( J, K+2 ) = Z( J, K+2 ) - SUM*T3
- 90 CONTINUE
- END IF
- ELSE IF( NR.EQ.2 ) THEN
-*
-* Apply G from the left to transform the rows of the matrix
-* in columns K to I2.
-*
- DO 100 J = K, I2
- SUM = H( K, J ) + V2*H( K+1, J )
- H( K, J ) = H( K, J ) - SUM*T1
- H( K+1, J ) = H( K+1, J ) - SUM*T2
- 100 CONTINUE
-*
-* Apply G from the right to transform the columns of the
-* matrix in rows I1 to min(K+3,I).
-*
- DO 110 J = I1, I
- SUM = H( J, K ) + V2*H( J, K+1 )
- H( J, K ) = H( J, K ) - SUM*T1
- H( J, K+1 ) = H( J, K+1 ) - SUM*T2
- 110 CONTINUE
-*
- IF( WANTZ ) THEN
-*
-* Accumulate transformations in the matrix Z
-*
- DO 120 J = ILOZ, IHIZ
- SUM = Z( J, K ) + V2*Z( J, K+1 )
- Z( J, K ) = Z( J, K ) - SUM*T1
- Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
- 120 CONTINUE
- END IF
- END IF
- 130 CONTINUE
-*
- 140 CONTINUE
-*
-* Failure to converge in remaining number of iterations
-*
- INFO = I
- RETURN
-*
- 150 CONTINUE
-*
- IF( L.EQ.I ) THEN
-*
-* H(I,I-1) is negligible: one eigenvalue has converged.
-*
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- ELSE IF( L.EQ.I-1 ) THEN
-*
-* H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
-*
-* Transform the 2-by-2 submatrix to standard Schur form,
-* and compute and store the eigenvalues.
-*
- CALL SLANV2( H( I-1, I-1 ), H( I-1, I ), H( I, I-1 ),
- $ H( I, I ), WR( I-1 ), WI( I-1 ), WR( I ), WI( I ),
- $ CS, SN )
-*
- IF( WANTT ) THEN
-*
-* Apply the transformation to the rest of H.
-*
- IF( I2.GT.I )
- $ CALL SROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH,
- $ CS, SN )
- CALL SROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN )
- END IF
- IF( WANTZ ) THEN
-*
-* Apply the transformation to Z.
-*
- CALL SROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN )
- END IF
- END IF
-*
-* return to start of the main loop with new value of I.
-*
- I = L - 1
- GO TO 20
-*
- 160 CONTINUE
- RETURN
-*
-* End of SLAHQR
-*
- END
diff --git a/netlib/LAPACK/slahr2.f b/netlib/LAPACK/slahr2.f
deleted file mode 100644
index c0b72dd..0000000
--- a/netlib/LAPACK/slahr2.f
+++ /dev/null
@@ -1,326 +0,0 @@
-*> \brief \b SLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAHR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slahr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slahr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slahr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), T( LDT, NB ), TAU( NB ),
-* $ Y( LDY, NB )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
-*> matrix A so that elements below the k-th subdiagonal are zero. The
-*> reduction is performed by an orthogonal similarity transformation
-*> Q**T * A * Q. The routine returns the matrices V and T which determine
-*> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T.
-*>
-*> This is an auxiliary routine called by SGEHRD.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The offset for the reduction. Elements below the k-th
-*> subdiagonal in the first NB columns are reduced to zero.
-*> K < N.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N-K+1)
-*> On entry, the n-by-(n-k+1) general matrix A.
-*> On exit, the elements on and above the k-th subdiagonal in
-*> the first NB columns are overwritten with the corresponding
-*> elements of the reduced matrix; the elements below the k-th
-*> subdiagonal, with the array TAU, represent the matrix Q as a
-*> product of elementary reflectors. The other columns of A are
-*> unchanged. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (NB)
-*> The scalar factors of the elementary reflectors. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,NB)
-*> The upper triangular matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is REAL array, dimension (LDY,NB)
-*> The n-by-nb matrix Y.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of nb elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*> A(i+k+1:n,i), and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*> V which is needed, with T and Y, to apply the transformation to the
-*> unreduced part of the matrix, using an update of the form:
-*> A := (I - V*T*V**T) * (A - Y*V**T).
-*>
-*> The contents of A on exit are illustrated by the following example
-*> with n = 7, k = 3 and nb = 2:
-*>
-*> ( a a a a a )
-*> ( a a a a a )
-*> ( a a a a a )
-*> ( h h a a a )
-*> ( v1 h a a a )
-*> ( v1 v2 a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*>
-*> This subroutine is a slight modification of LAPACK-3.0's DLAHRD
-*> incorporating improvements proposed by Quintana-Orti and Van de
-*> Gejin. Note that the entries of A(1:K,2:NB) differ from those
-*> returned by the original LAPACK-3.0's DLAHRD routine. (This
-*> subroutine is not backward compatible with LAPACK-3.0's DLAHRD.)
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> Gregorio Quintana-Orti and Robert van de Geijn, "Improving the
-*> performance of reduction to Hessenberg form," ACM Transactions on
-*> Mathematical Software, 32(2):180-194, June 2006.
-*>
-* =====================================================================
- SUBROUTINE SLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), T( LDT, NB ), TAU( NB ),
- $ Y( LDY, NB )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0,
- $ ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL EI
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMM, SGEMV, SLACPY,
- $ SLARFG, SSCAL, STRMM, STRMV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, NB
- IF( I.GT.1 ) THEN
-*
-* Update A(K+1:N,I)
-*
-* Update I-th column of A - Y * V**T
-*
- CALL SGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY,
- $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 )
-*
-* Apply I - V * T**T * V**T to this column (call it b) from the
-* left, using the last column of T as workspace
-*
-* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
-* ( V2 ) ( b2 )
-*
-* where V1 is unit lower triangular
-*
-* 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 )
-*
-* w := w + V2**T * b2
-*
- CALL SGEMV( 'Transpose', N-K-I+1, I-1,
- $ ONE, A( K+I, 1 ),
- $ LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-* w := T**T * w
-*
- 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 )
-*
-* b1 := b1 - V1*w
-*
- CALL STRMV( 'Lower', 'NO TRANSPOSE',
- $ 'UNIT', I-1,
- $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
- CALL SAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
- A( K+I-1, I-1 ) = EI
- END IF
-*
-* 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 ) )
- EI = A( K+I, I )
- A( K+I, I ) = ONE
-*
-* Compute Y(K+1:N,I)
-*
- CALL SGEMV( 'NO TRANSPOSE', N-K, N-K-I+1,
- $ ONE, A( K+1, I+1 ),
- $ LDA, A( K+I, I ), 1, ZERO, Y( K+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-K, I-1, -ONE,
- $ Y( K+1, 1 ), LDY,
- $ T( 1, I ), 1, ONE, Y( K+1, I ), 1 )
- CALL SSCAL( N-K, TAU( I ), Y( K+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 )
- T( I, I ) = TAU( I )
-*
- 10 CONTINUE
- A( K+NB, NB ) = EI
-*
-* Compute Y(1:K,1:NB)
-*
- CALL SLACPY( 'ALL', K, NB, A( 1, 2 ), LDA, Y, LDY )
- CALL STRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE',
- $ 'UNIT', K, NB,
- $ ONE, A( K+1, 1 ), LDA, Y, LDY )
- IF( N.GT.K+NB )
- $ CALL SGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K,
- $ NB, N-K-NB, ONE,
- $ A( 1, 2+NB ), LDA, A( K+1+NB, 1 ), LDA, ONE, Y,
- $ LDY )
- CALL STRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE',
- $ 'NON-UNIT', K, NB,
- $ ONE, T, LDT, Y, LDY )
-*
- RETURN
-*
-* End of SLAHR2
-*
- END
diff --git a/netlib/LAPACK/slahrd.f b/netlib/LAPACK/slahrd.f
deleted file mode 100644
index 34376f3..0000000
--- a/netlib/LAPACK/slahrd.f
+++ /dev/null
@@ -1,288 +0,0 @@
-*> \brief \b SLAHRD reduces the first nb columns of a general rectangular matrix A so that elements below the k-th subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A.
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slahrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slahrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), T( LDT, NB ), TAU( NB ),
-* $ Y( LDY, NB )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
-*> matrix A so that elements below the k-th subdiagonal are zero. The
-*> reduction is performed by an orthogonal similarity transformation
-*> Q**T * A * Q. The routine returns the matrices V and T which determine
-*> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T.
-*>
-*> This is an OBSOLETE auxiliary routine.
-*> This routine will be 'deprecated' in a future release.
-*> Please use the new routine SLAHR2 instead.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The offset for the reduction. Elements below the k-th
-*> subdiagonal in the first NB columns are reduced to zero.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N-K+1)
-*> On entry, the n-by-(n-k+1) general matrix A.
-*> On exit, the elements on and above the k-th subdiagonal in
-*> the first NB columns are overwritten with the corresponding
-*> elements of the reduced matrix; the elements below the k-th
-*> subdiagonal, with the array TAU, represent the matrix Q as a
-*> product of elementary reflectors. The other columns of A are
-*> unchanged. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (NB)
-*> The scalar factors of the elementary reflectors. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,NB)
-*> The upper triangular matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is REAL array, dimension (LDY,NB)
-*> The n-by-nb matrix Y.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of nb elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*> A(i+k+1:n,i), and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*> V which is needed, with T and Y, to apply the transformation to the
-*> unreduced part of the matrix, using an update of the form:
-*> A := (I - V*T*V**T) * (A - Y*V**T).
-*>
-*> The contents of A on exit are illustrated by the following example
-*> with n = 7, k = 3 and nb = 2:
-*>
-*> ( a h a a a )
-*> ( a h a a a )
-*> ( a h a a a )
-*> ( h h a a a )
-*> ( v1 h a a a )
-*> ( v1 v2 a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), T( LDT, NB ), TAU( NB ),
- $ Y( LDY, NB )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL EI
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SLARFG, SSCAL, STRMV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, NB
- IF( I.GT.1 ) THEN
-*
-* Update A(1:n,i)
-*
-* Compute i-th column of A - Y * V**T
-*
- CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY,
- $ A( K+I-1, 1 ), LDA, ONE, A( 1, I ), 1 )
-*
-* Apply I - V * T**T * V**T to this column (call it b) from the
-* left, using the last column of T as workspace
-*
-* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
-* ( V2 ) ( b2 )
-*
-* where V1 is unit lower triangular
-*
-* 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 )
-*
-* w := w + V2**T *b2
-*
- CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ),
- $ LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-* w := T**T *w
-*
- 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 )
-*
-* b1 := b1 - V1*w
-*
- CALL STRMV( 'Lower', 'No transpose', 'Unit', I-1,
- $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
- CALL SAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
- A( K+I-1, I-1 ) = EI
- END IF
-*
-* 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 ) )
- 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 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 )
- T( I, I ) = TAU( I )
-*
- 10 CONTINUE
- A( K+NB, NB ) = EI
-*
- RETURN
-*
-* End of SLAHRD
-*
- END
diff --git a/netlib/LAPACK/slaic1.f b/netlib/LAPACK/slaic1.f
deleted file mode 100644
index edbfcdf..0000000
--- a/netlib/LAPACK/slaic1.f
+++ /dev/null
@@ -1,367 +0,0 @@
-*> \brief \b SLAIC1 applies one step of incremental condition estimation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAIC1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaic1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaic1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaic1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
-*
-* .. Scalar Arguments ..
-* INTEGER J, JOB
-* REAL C, GAMMA, S, SEST, SESTPR
-* ..
-* .. Array Arguments ..
-* REAL W( J ), X( J )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAIC1 applies one step of incremental condition estimation in
-*> its simplest version:
-*>
-*> Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
-*> lower triangular matrix L, such that
-*> twonorm(L*x) = sest
-*> Then SLAIC1 computes sestpr, s, c such that
-*> the vector
-*> [ s*x ]
-*> xhat = [ c ]
-*> is an approximate singular vector of
-*> [ L 0 ]
-*> Lhat = [ w**T gamma ]
-*> in the sense that
-*> twonorm(Lhat*xhat) = sestpr.
-*>
-*> Depending on JOB, an estimate for the largest or smallest singular
-*> value is computed.
-*>
-*> Note that [s c]**T and sestpr**2 is an eigenpair of the system
-*>
-*> diag(sest*sest, 0) + [alpha gamma] * [ alpha ]
-*> [ gamma ]
-*>
-*> where alpha = x**T*w.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is INTEGER
-*> = 1: an estimate for the largest singular value is computed.
-*> = 2: an estimate for the smallest singular value is computed.
-*> \endverbatim
-*>
-*> \param[in] J
-*> \verbatim
-*> J is INTEGER
-*> Length of X and W
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension (J)
-*> The j-vector x.
-*> \endverbatim
-*>
-*> \param[in] SEST
-*> \verbatim
-*> SEST is REAL
-*> Estimated singular value of j by j matrix L
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is REAL array, dimension (J)
-*> The j-vector w.
-*> \endverbatim
-*>
-*> \param[in] GAMMA
-*> \verbatim
-*> GAMMA is REAL
-*> The diagonal element gamma.
-*> \endverbatim
-*>
-*> \param[out] SESTPR
-*> \verbatim
-*> SESTPR is REAL
-*> Estimated singular value of (j+1) by (j+1) matrix Lhat.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL
-*> Sine needed in forming xhat.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL
-*> Cosine needed in forming xhat.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER J, JOB
- REAL C, GAMMA, S, SEST, SESTPR
-* ..
-* .. Array Arguments ..
- REAL W( J ), X( J )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
- REAL HALF, FOUR
- PARAMETER ( HALF = 0.5E0, FOUR = 4.0E0 )
-* ..
-* .. Local Scalars ..
- REAL ABSALP, ABSEST, ABSGAM, ALPHA, B, COSINE, EPS,
- $ NORMA, S1, S2, SINE, T, TEST, TMP, ZETA1, ZETA2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SIGN, SQRT
-* ..
-* .. External Functions ..
- REAL SDOT, SLAMCH
- EXTERNAL SDOT, SLAMCH
-* ..
-* .. Executable Statements ..
-*
- EPS = SLAMCH( 'Epsilon' )
- ALPHA = SDOT( J, X, 1, W, 1 )
-*
- ABSALP = ABS( ALPHA )
- ABSGAM = ABS( GAMMA )
- ABSEST = ABS( SEST )
-*
- IF( JOB.EQ.1 ) THEN
-*
-* Estimating largest singular value
-*
-* special cases
-*
- IF( SEST.EQ.ZERO ) THEN
- S1 = MAX( ABSGAM, ABSALP )
- IF( S1.EQ.ZERO ) THEN
- S = ZERO
- C = ONE
- SESTPR = ZERO
- ELSE
- S = ALPHA / S1
- C = GAMMA / S1
- TMP = SQRT( S*S+C*C )
- S = S / TMP
- C = C / TMP
- SESTPR = S1*TMP
- END IF
- RETURN
- ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
- S = ONE
- C = ZERO
- TMP = MAX( ABSEST, ABSALP )
- S1 = ABSEST / TMP
- S2 = ABSALP / TMP
- SESTPR = TMP*SQRT( S1*S1+S2*S2 )
- RETURN
- ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
- S1 = ABSGAM
- S2 = ABSEST
- IF( S1.LE.S2 ) THEN
- S = ONE
- C = ZERO
- SESTPR = S2
- ELSE
- S = ZERO
- C = ONE
- SESTPR = S1
- END IF
- RETURN
- ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
- S1 = ABSGAM
- S2 = ABSALP
- IF( S1.LE.S2 ) THEN
- TMP = S1 / S2
- S = SQRT( ONE+TMP*TMP )
- SESTPR = S2*S
- C = ( GAMMA / S2 ) / S
- S = SIGN( ONE, ALPHA ) / S
- ELSE
- TMP = S2 / S1
- C = SQRT( ONE+TMP*TMP )
- SESTPR = S1*C
- S = ( ALPHA / S1 ) / C
- C = SIGN( ONE, GAMMA ) / C
- END IF
- RETURN
- ELSE
-*
-* normal case
-*
- ZETA1 = ALPHA / ABSEST
- ZETA2 = GAMMA / ABSEST
-*
- B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
- C = ZETA1*ZETA1
- IF( B.GT.ZERO ) THEN
- T = C / ( B+SQRT( B*B+C ) )
- ELSE
- T = SQRT( B*B+C ) - B
- END IF
-*
- SINE = -ZETA1 / T
- COSINE = -ZETA2 / ( ONE+T )
- TMP = SQRT( SINE*SINE+COSINE*COSINE )
- S = SINE / TMP
- C = COSINE / TMP
- SESTPR = SQRT( T+ONE )*ABSEST
- RETURN
- END IF
-*
- ELSE IF( JOB.EQ.2 ) THEN
-*
-* Estimating smallest singular value
-*
-* special cases
-*
- IF( SEST.EQ.ZERO ) THEN
- SESTPR = ZERO
- IF( MAX( ABSGAM, ABSALP ).EQ.ZERO ) THEN
- SINE = ONE
- COSINE = ZERO
- ELSE
- SINE = -GAMMA
- COSINE = ALPHA
- END IF
- S1 = MAX( ABS( SINE ), ABS( COSINE ) )
- S = SINE / S1
- C = COSINE / S1
- TMP = SQRT( S*S+C*C )
- S = S / TMP
- C = C / TMP
- RETURN
- ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
- S = ZERO
- C = ONE
- SESTPR = ABSGAM
- RETURN
- ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
- S1 = ABSGAM
- S2 = ABSEST
- IF( S1.LE.S2 ) THEN
- S = ZERO
- C = ONE
- SESTPR = S1
- ELSE
- S = ONE
- C = ZERO
- SESTPR = S2
- END IF
- RETURN
- ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
- S1 = ABSGAM
- S2 = ABSALP
- IF( S1.LE.S2 ) THEN
- TMP = S1 / S2
- C = SQRT( ONE+TMP*TMP )
- SESTPR = ABSEST*( TMP / C )
- S = -( GAMMA / S2 ) / C
- C = SIGN( ONE, ALPHA ) / C
- ELSE
- TMP = S2 / S1
- S = SQRT( ONE+TMP*TMP )
- SESTPR = ABSEST / S
- C = ( ALPHA / S1 ) / S
- S = -SIGN( ONE, GAMMA ) / S
- END IF
- RETURN
- ELSE
-*
-* normal case
-*
- ZETA1 = ALPHA / ABSEST
- ZETA2 = GAMMA / ABSEST
-*
- NORMA = MAX( ONE+ZETA1*ZETA1+ABS( ZETA1*ZETA2 ),
- $ ABS( ZETA1*ZETA2 )+ZETA2*ZETA2 )
-*
-* See if root is closer to zero or to ONE
-*
- TEST = ONE + TWO*( ZETA1-ZETA2 )*( ZETA1+ZETA2 )
- IF( TEST.GE.ZERO ) THEN
-*
-* root is close to zero, compute directly
-*
- B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
- C = ZETA2*ZETA2
- T = C / ( B+SQRT( ABS( B*B-C ) ) )
- SINE = ZETA1 / ( ONE-T )
- COSINE = -ZETA2 / T
- SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
- ELSE
-*
-* root is closer to ONE, shift by that amount
-*
- B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
- C = ZETA1*ZETA1
- IF( B.GE.ZERO ) THEN
- T = -C / ( B+SQRT( B*B+C ) )
- ELSE
- T = B - SQRT( B*B+C )
- END IF
- SINE = -ZETA1 / T
- COSINE = -ZETA2 / ( ONE+T )
- SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
- END IF
- TMP = SQRT( SINE*SINE+COSINE*COSINE )
- S = SINE / TMP
- C = COSINE / TMP
- RETURN
-*
- END IF
- END IF
- RETURN
-*
-* End of SLAIC1
-*
- END
diff --git a/netlib/LAPACK/slaisnan.f b/netlib/LAPACK/slaisnan.f
deleted file mode 100644
index 0cf4117..0000000
--- a/netlib/LAPACK/slaisnan.f
+++ /dev/null
@@ -1,91 +0,0 @@
-*> \brief \b SLAISNAN tests input for NaN by comparing two arguments for inequality.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAISNAN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaisnan.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaisnan.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaisnan.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION SLAISNAN( SIN1, SIN2 )
-*
-* .. Scalar Arguments ..
-* REAL SIN1, SIN2
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is not for general use. It exists solely to avoid
-*> over-optimization in SISNAN.
-*>
-*> SLAISNAN checks for NaNs by comparing its two arguments for
-*> inequality. NaN is the only floating-point value where NaN != NaN
-*> returns .TRUE. To check for NaNs, pass the same variable as both
-*> arguments.
-*>
-*> A compiler must assume that the two arguments are
-*> not the same variable, and the test will not be optimized away.
-*> Interprocedural or whole-program optimization may delete this
-*> test. The ISNAN functions will be replaced by the correct
-*> Fortran 03 intrinsic once the intrinsic is widely available.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIN1
-*> \verbatim
-*> SIN1 is REAL
-*> \endverbatim
-*>
-*> \param[in] SIN2
-*> \verbatim
-*> SIN2 is REAL
-*> Two numbers to compare for inequality.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION SLAISNAN( SIN1, SIN2 )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL SIN1, SIN2
-* ..
-*
-* =====================================================================
-*
-* .. Executable Statements ..
- SLAISNAN = (SIN1.NE.SIN2)
- RETURN
- END
diff --git a/netlib/LAPACK/slakf2.f b/netlib/LAPACK/slakf2.f
deleted file mode 100644
index 6de7103..0000000
--- a/netlib/LAPACK/slakf2.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b SLAKF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDZ, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDA, * ), D( LDA, * ),
-* $ E( LDA, * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Form the 2*M*N by 2*M*N matrix
-*>
-*> Z = [ kron(In, A) -kron(B', Im) ]
-*> [ kron(In, D) -kron(E', Im) ],
-*>
-*> where In is the identity matrix of size n and X' is the transpose
-*> of X. kron(X, Y) is the Kronecker product between the matrices X
-*> and Y.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Size of matrix, must be >= 1.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Size of matrix, must be >= 1.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL, dimension ( LDA, M )
-*> The matrix A in the output matrix Z.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A, B, D, and E. ( LDA >= M+N )
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL, dimension ( LDA, N )
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL, dimension ( LDA, M )
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL, dimension ( LDA, N )
-*>
-*> The matrices used in forming the output matrix Z.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL, dimension ( LDZ, 2*M*N )
-*> The resultant Kronecker M*N*2 by M*N*2 matrix (see above.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of Z. ( LDZ >= 2*M*N )
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDZ, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDA, * ), D( LDA, * ),
- $ E( LDA, * ), Z( LDZ, * )
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IK, J, JK, L, MN, MN2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASET
-* ..
-* .. Executable Statements ..
-*
-* Initialize Z
-*
- MN = M*N
- MN2 = 2*MN
- CALL SLASET( 'Full', MN2, MN2, ZERO, ZERO, Z, LDZ )
-*
- IK = 1
- DO 50 L = 1, N
-*
-* form kron(In, A)
-*
- DO 20 I = 1, M
- DO 10 J = 1, M
- Z( IK+I-1, IK+J-1 ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
-*
-* form kron(In, D)
-*
- DO 40 I = 1, M
- DO 30 J = 1, M
- Z( IK+MN+I-1, IK+J-1 ) = D( I, J )
- 30 CONTINUE
- 40 CONTINUE
-*
- IK = IK + M
- 50 CONTINUE
-*
- IK = 1
- DO 90 L = 1, N
- JK = MN + 1
-*
- DO 80 J = 1, N
-*
-* form -kron(B', Im)
-*
- DO 60 I = 1, M
- Z( IK+I-1, JK+I-1 ) = -B( J, L )
- 60 CONTINUE
-*
-* form -kron(E', Im)
-*
- DO 70 I = 1, M
- Z( IK+MN+I-1, JK+I-1 ) = -E( J, L )
- 70 CONTINUE
-*
- JK = JK + M
- 80 CONTINUE
-*
- IK = IK + M
- 90 CONTINUE
-*
- RETURN
-*
-* End of SLAKF2
-*
- END
diff --git a/netlib/LAPACK/slaln2.f b/netlib/LAPACK/slaln2.f
deleted file mode 100644
index 14468c0..0000000
--- a/netlib/LAPACK/slaln2.f
+++ /dev/null
@@ -1,611 +0,0 @@
-*> \brief \b SLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLALN2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaln2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaln2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaln2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
-* LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LTRANS
-* INTEGER INFO, LDA, LDB, LDX, NA, NW
-* REAL CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLALN2 solves a system of the form (ca A - w D ) X = s B
-*> or (ca A**T - w D) X = s B with possible scaling ("s") and
-*> perturbation of A. (A**T means A-transpose.)
-*>
-*> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
-*> real diagonal matrix, w is a real or complex value, and X and B are
-*> NA x 1 matrices -- real if w is real, complex if w is complex. NA
-*> may be 1 or 2.
-*>
-*> If w is complex, X and B are represented as NA x 2 matrices,
-*> the first column of each being the real part and the second
-*> being the imaginary part.
-*>
-*> "s" is a scaling factor (.LE. 1), computed by SLALN2, which is
-*> so chosen that X can be computed without overflow. X is further
-*> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
-*> than overflow.
-*>
-*> If both singular values of (ca A - w D) are less than SMIN,
-*> SMIN*identity will be used instead of (ca A - w D). If only one
-*> singular value is less than SMIN, one element of (ca A - w D) will be
-*> perturbed enough to make the smallest singular value roughly SMIN.
-*> If both singular values are at least SMIN, (ca A - w D) will not be
-*> perturbed. In any case, the perturbation will be at most some small
-*> multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
-*> are computed by infinity-norm approximations, and thus will only be
-*> correct to a factor of 2 or so.
-*>
-*> Note: all input quantities are assumed to be smaller than overflow
-*> by a reasonable factor. (See BIGNUM.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRANS
-*> \verbatim
-*> LTRANS is LOGICAL
-*> =.TRUE.: A-transpose will be used.
-*> =.FALSE.: A will be used (not transposed.)
-*> \endverbatim
-*>
-*> \param[in] NA
-*> \verbatim
-*> NA is INTEGER
-*> The size of the matrix A. It may (only) be 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> 1 if "w" is real, 2 if "w" is complex. It may only be 1
-*> or 2.
-*> \endverbatim
-*>
-*> \param[in] SMIN
-*> \verbatim
-*> SMIN is REAL
-*> The desired lower bound on the singular values of A. This
-*> should be a safe distance away from underflow or overflow,
-*> say, between (underflow/machine precision) and (machine
-*> precision * overflow ). (See BIGNUM and ULP.)
-*> \endverbatim
-*>
-*> \param[in] CA
-*> \verbatim
-*> CA is REAL
-*> The coefficient c, which A is multiplied by.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,NA)
-*> The NA x NA matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[in] D1
-*> \verbatim
-*> D1 is REAL
-*> The 1,1 element in the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] D2
-*> \verbatim
-*> D2 is REAL
-*> The 2,2 element in the diagonal matrix D. Not used if NW=1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NW)
-*> The NA x NW matrix B (right-hand side). If NW=2 ("w" is
-*> complex), column 1 contains the real part of B and column 2
-*> contains the imaginary part.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[in] WR
-*> \verbatim
-*> WR is REAL
-*> The real part of the scalar "w".
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is REAL
-*> The imaginary part of the scalar "w". Not used if NW=1.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NW)
-*> The NA x NW matrix X (unknowns), as computed by SLALN2.
-*> If NW=2 ("w" is complex), on exit, column 1 will contain
-*> the real part of X and column 2 will contain the imaginary
-*> part.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of X. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> The scale factor that B must be multiplied by to insure
-*> that overflow does not occur when computing X. Thus,
-*> (ca A - w D) X will be SCALE*B, not B (ignoring
-*> perturbations of A.) It will be at most 1.
-*> \endverbatim
-*>
-*> \param[out] XNORM
-*> \verbatim
-*> XNORM is REAL
-*> The infinity-norm of X, when X is regarded as an NA x NW
-*> real matrix.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> An error flag. It will be set to zero if no error occurs,
-*> a negative number if an argument is in error, or a positive
-*> number if ca A - w D had to be perturbed.
-*> The possible values are:
-*> = 0: No error occurred, and (ca A - w D) did not have to be
-*> perturbed.
-*> = 1: (ca A - w D) had to be perturbed to make its smallest
-*> (or only) singular value greater than SMIN.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
- $ LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL LTRANS
- INTEGER INFO, LDA, LDB, LDX, NA, NW
- REAL CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER ICMAX, J
- REAL BBND, BI1, BI2, BIGNUM, BNORM, BR1, BR2, CI21,
- $ CI22, CMAX, CNORM, CR21, CR22, CSI, CSR, LI21,
- $ LR21, SMINI, SMLNUM, TEMP, U22ABS, UI11, UI11R,
- $ UI12, UI12S, UI22, UR11, UR11R, UR12, UR12S,
- $ UR22, XI1, XI2, XR1, XR2
-* ..
-* .. Local Arrays ..
- LOGICAL CSWAP( 4 ), RSWAP( 4 )
- INTEGER IPIVOT( 4, 4 )
- REAL CI( 2, 2 ), CIV( 4 ), CR( 2, 2 ), CRV( 4 )
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLADIV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Equivalences ..
- EQUIVALENCE ( CI( 1, 1 ), CIV( 1 ) ),
- $ ( CR( 1, 1 ), CRV( 1 ) )
-* ..
-* .. Data statements ..
- DATA CSWAP / .FALSE., .FALSE., .TRUE., .TRUE. /
- DATA RSWAP / .FALSE., .TRUE., .FALSE., .TRUE. /
- DATA IPIVOT / 1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2, 4,
- $ 3, 2, 1 /
-* ..
-* .. Executable Statements ..
-*
-* Compute BIGNUM
-*
- SMLNUM = TWO*SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- SMINI = MAX( SMIN, SMLNUM )
-*
-* Don't check for input errors
-*
- INFO = 0
-*
-* Standard Initializations
-*
- SCALE = ONE
-*
- IF( NA.EQ.1 ) THEN
-*
-* 1 x 1 (i.e., scalar) system C X = B
-*
- IF( NW.EQ.1 ) THEN
-*
-* Real 1x1 system.
-*
-* C = ca A - w D
-*
- CSR = CA*A( 1, 1 ) - WR*D1
- CNORM = ABS( CSR )
-*
-* If | C | < SMINI, use C = SMINI
-*
- IF( CNORM.LT.SMINI ) THEN
- CSR = SMINI
- CNORM = SMINI
- INFO = 1
- END IF
-*
-* Check scaling for X = B / C
-*
- BNORM = ABS( B( 1, 1 ) )
- IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*CNORM )
- $ SCALE = ONE / BNORM
- END IF
-*
-* Compute X
-*
- X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / CSR
- XNORM = ABS( X( 1, 1 ) )
- ELSE
-*
-* Complex 1x1 system (w is complex)
-*
-* C = ca A - w D
-*
- CSR = CA*A( 1, 1 ) - WR*D1
- CSI = -WI*D1
- CNORM = ABS( CSR ) + ABS( CSI )
-*
-* If | C | < SMINI, use C = SMINI
-*
- IF( CNORM.LT.SMINI ) THEN
- CSR = SMINI
- CSI = ZERO
- CNORM = SMINI
- INFO = 1
- END IF
-*
-* Check scaling for X = B / C
-*
- BNORM = ABS( B( 1, 1 ) ) + ABS( B( 1, 2 ) )
- IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*CNORM )
- $ SCALE = ONE / BNORM
- END IF
-*
-* Compute X
-*
- CALL SLADIV( SCALE*B( 1, 1 ), SCALE*B( 1, 2 ), CSR, CSI,
- $ X( 1, 1 ), X( 1, 2 ) )
- XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- END IF
-*
- ELSE
-*
-* 2x2 System
-*
-* Compute the real part of C = ca A - w D (or ca A**T - w D )
-*
- CR( 1, 1 ) = CA*A( 1, 1 ) - WR*D1
- CR( 2, 2 ) = CA*A( 2, 2 ) - WR*D2
- IF( LTRANS ) THEN
- CR( 1, 2 ) = CA*A( 2, 1 )
- CR( 2, 1 ) = CA*A( 1, 2 )
- ELSE
- CR( 2, 1 ) = CA*A( 2, 1 )
- CR( 1, 2 ) = CA*A( 1, 2 )
- END IF
-*
- IF( NW.EQ.1 ) THEN
-*
-* Real 2x2 system (w is real)
-*
-* Find the largest element in C
-*
- CMAX = ZERO
- ICMAX = 0
-*
- DO 10 J = 1, 4
- IF( ABS( CRV( J ) ).GT.CMAX ) THEN
- CMAX = ABS( CRV( J ) )
- ICMAX = J
- END IF
- 10 CONTINUE
-*
-* If norm(C) < SMINI, use SMINI*identity.
-*
- IF( CMAX.LT.SMINI ) THEN
- BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 2, 1 ) ) )
- IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*SMINI )
- $ SCALE = ONE / BNORM
- END IF
- TEMP = SCALE / SMINI
- X( 1, 1 ) = TEMP*B( 1, 1 )
- X( 2, 1 ) = TEMP*B( 2, 1 )
- XNORM = TEMP*BNORM
- INFO = 1
- RETURN
- END IF
-*
-* Gaussian elimination with complete pivoting.
-*
- UR11 = CRV( ICMAX )
- CR21 = CRV( IPIVOT( 2, ICMAX ) )
- UR12 = CRV( IPIVOT( 3, ICMAX ) )
- CR22 = CRV( IPIVOT( 4, ICMAX ) )
- UR11R = ONE / UR11
- LR21 = UR11R*CR21
- UR22 = CR22 - UR12*LR21
-*
-* If smaller pivot < SMINI, use SMINI
-*
- IF( ABS( UR22 ).LT.SMINI ) THEN
- UR22 = SMINI
- INFO = 1
- END IF
- IF( RSWAP( ICMAX ) ) THEN
- BR1 = B( 2, 1 )
- BR2 = B( 1, 1 )
- ELSE
- BR1 = B( 1, 1 )
- BR2 = B( 2, 1 )
- END IF
- BR2 = BR2 - LR21*BR1
- BBND = MAX( ABS( BR1*( UR22*UR11R ) ), ABS( BR2 ) )
- IF( BBND.GT.ONE .AND. ABS( UR22 ).LT.ONE ) THEN
- IF( BBND.GE.BIGNUM*ABS( UR22 ) )
- $ SCALE = ONE / BBND
- END IF
-*
- XR2 = ( BR2*SCALE ) / UR22
- XR1 = ( SCALE*BR1 )*UR11R - XR2*( UR11R*UR12 )
- IF( CSWAP( ICMAX ) ) THEN
- X( 1, 1 ) = XR2
- X( 2, 1 ) = XR1
- ELSE
- X( 1, 1 ) = XR1
- X( 2, 1 ) = XR2
- END IF
- XNORM = MAX( ABS( XR1 ), ABS( XR2 ) )
-*
-* Further scaling if norm(A) norm(X) > overflow
-*
- IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
- IF( XNORM.GT.BIGNUM / CMAX ) THEN
- TEMP = CMAX / BIGNUM
- X( 1, 1 ) = TEMP*X( 1, 1 )
- X( 2, 1 ) = TEMP*X( 2, 1 )
- XNORM = TEMP*XNORM
- SCALE = TEMP*SCALE
- END IF
- END IF
- ELSE
-*
-* Complex 2x2 system (w is complex)
-*
-* Find the largest element in C
-*
- CI( 1, 1 ) = -WI*D1
- CI( 2, 1 ) = ZERO
- CI( 1, 2 ) = ZERO
- CI( 2, 2 ) = -WI*D2
- CMAX = ZERO
- ICMAX = 0
-*
- DO 20 J = 1, 4
- IF( ABS( CRV( J ) )+ABS( CIV( J ) ).GT.CMAX ) THEN
- CMAX = ABS( CRV( J ) ) + ABS( CIV( J ) )
- ICMAX = J
- END IF
- 20 CONTINUE
-*
-* If norm(C) < SMINI, use SMINI*identity.
-*
- IF( CMAX.LT.SMINI ) THEN
- BNORM = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
- $ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
- IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*SMINI )
- $ SCALE = ONE / BNORM
- END IF
- TEMP = SCALE / SMINI
- X( 1, 1 ) = TEMP*B( 1, 1 )
- X( 2, 1 ) = TEMP*B( 2, 1 )
- X( 1, 2 ) = TEMP*B( 1, 2 )
- X( 2, 2 ) = TEMP*B( 2, 2 )
- XNORM = TEMP*BNORM
- INFO = 1
- RETURN
- END IF
-*
-* Gaussian elimination with complete pivoting.
-*
- UR11 = CRV( ICMAX )
- UI11 = CIV( ICMAX )
- CR21 = CRV( IPIVOT( 2, ICMAX ) )
- CI21 = CIV( IPIVOT( 2, ICMAX ) )
- UR12 = CRV( IPIVOT( 3, ICMAX ) )
- UI12 = CIV( IPIVOT( 3, ICMAX ) )
- CR22 = CRV( IPIVOT( 4, ICMAX ) )
- CI22 = CIV( IPIVOT( 4, ICMAX ) )
- IF( ICMAX.EQ.1 .OR. ICMAX.EQ.4 ) THEN
-*
-* Code when off-diagonals of pivoted C are real
-*
- IF( ABS( UR11 ).GT.ABS( UI11 ) ) THEN
- TEMP = UI11 / UR11
- UR11R = ONE / ( UR11*( ONE+TEMP**2 ) )
- UI11R = -TEMP*UR11R
- ELSE
- TEMP = UR11 / UI11
- UI11R = -ONE / ( UI11*( ONE+TEMP**2 ) )
- UR11R = -TEMP*UI11R
- END IF
- LR21 = CR21*UR11R
- LI21 = CR21*UI11R
- UR12S = UR12*UR11R
- UI12S = UR12*UI11R
- UR22 = CR22 - UR12*LR21
- UI22 = CI22 - UR12*LI21
- ELSE
-*
-* Code when diagonals of pivoted C are real
-*
- UR11R = ONE / UR11
- UI11R = ZERO
- LR21 = CR21*UR11R
- LI21 = CI21*UR11R
- UR12S = UR12*UR11R
- UI12S = UI12*UR11R
- UR22 = CR22 - UR12*LR21 + UI12*LI21
- UI22 = -UR12*LI21 - UI12*LR21
- END IF
- U22ABS = ABS( UR22 ) + ABS( UI22 )
-*
-* If smaller pivot < SMINI, use SMINI
-*
- IF( U22ABS.LT.SMINI ) THEN
- UR22 = SMINI
- UI22 = ZERO
- INFO = 1
- END IF
- IF( RSWAP( ICMAX ) ) THEN
- BR2 = B( 1, 1 )
- BR1 = B( 2, 1 )
- BI2 = B( 1, 2 )
- BI1 = B( 2, 2 )
- ELSE
- BR1 = B( 1, 1 )
- BR2 = B( 2, 1 )
- BI1 = B( 1, 2 )
- BI2 = B( 2, 2 )
- END IF
- BR2 = BR2 - LR21*BR1 + LI21*BI1
- BI2 = BI2 - LI21*BR1 - LR21*BI1
- BBND = MAX( ( ABS( BR1 )+ABS( BI1 ) )*
- $ ( U22ABS*( ABS( UR11R )+ABS( UI11R ) ) ),
- $ ABS( BR2 )+ABS( BI2 ) )
- IF( BBND.GT.ONE .AND. U22ABS.LT.ONE ) THEN
- IF( BBND.GE.BIGNUM*U22ABS ) THEN
- SCALE = ONE / BBND
- BR1 = SCALE*BR1
- BI1 = SCALE*BI1
- BR2 = SCALE*BR2
- BI2 = SCALE*BI2
- END IF
- END IF
-*
- CALL SLADIV( BR2, BI2, UR22, UI22, XR2, XI2 )
- XR1 = UR11R*BR1 - UI11R*BI1 - UR12S*XR2 + UI12S*XI2
- XI1 = UI11R*BR1 + UR11R*BI1 - UI12S*XR2 - UR12S*XI2
- IF( CSWAP( ICMAX ) ) THEN
- X( 1, 1 ) = XR2
- X( 2, 1 ) = XR1
- X( 1, 2 ) = XI2
- X( 2, 2 ) = XI1
- ELSE
- X( 1, 1 ) = XR1
- X( 2, 1 ) = XR2
- X( 1, 2 ) = XI1
- X( 2, 2 ) = XI2
- END IF
- XNORM = MAX( ABS( XR1 )+ABS( XI1 ), ABS( XR2 )+ABS( XI2 ) )
-*
-* Further scaling if norm(A) norm(X) > overflow
-*
- IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
- IF( XNORM.GT.BIGNUM / CMAX ) THEN
- TEMP = CMAX / BIGNUM
- X( 1, 1 ) = TEMP*X( 1, 1 )
- X( 2, 1 ) = TEMP*X( 2, 1 )
- X( 1, 2 ) = TEMP*X( 1, 2 )
- X( 2, 2 ) = TEMP*X( 2, 2 )
- XNORM = TEMP*XNORM
- SCALE = TEMP*SCALE
- END IF
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of SLALN2
-*
- END
diff --git a/netlib/LAPACK/slals0.f b/netlib/LAPACK/slals0.f
deleted file mode 100644
index e20dbf9..0000000
--- a/netlib/LAPACK/slals0.f
+++ /dev/null
@@ -1,502 +0,0 @@
-*> \brief \b SLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLALS0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slals0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slals0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slals0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
-* PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
-* POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL,
-* $ LDGNUM, NL, NR, NRHS, SQRE
-* REAL C, S
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), PERM( * )
-* REAL B( LDB, * ), BX( LDBX, * ), DIFL( * ),
-* $ DIFR( LDGNUM, * ), GIVNUM( LDGNUM, * ),
-* $ POLES( LDGNUM, * ), WORK( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLALS0 applies back the multiplying factors of either the left or the
-*> right singular vector matrix of a diagonal matrix appended by a row
-*> to the right hand side matrix B in solving the least squares problem
-*> using the divide-and-conquer SVD approach.
-*>
-*> For the left singular vector matrix, three types of orthogonal
-*> matrices are involved:
-*>
-*> (1L) Givens rotations: the number of such rotations is GIVPTR; the
-*> pairs of columns/rows they were applied to are stored in GIVCOL;
-*> and the C- and S-values of these rotations are stored in GIVNUM.
-*>
-*> (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
-*> row, and for J=2:N, PERM(J)-th row of B is to be moved to the
-*> J-th row.
-*>
-*> (3L) The left singular vector matrix of the remaining matrix.
-*>
-*> For the right singular vector matrix, four types of orthogonal
-*> matrices are involved:
-*>
-*> (1R) The right singular vector matrix of the remaining matrix.
-*>
-*> (2R) If SQRE = 1, one extra Givens rotation to generate the right
-*> null space.
-*>
-*> (3R) The inverse transformation of (2L).
-*>
-*> (4R) The inverse transformation of (1L).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed in
-*> factored form:
-*> = 0: Left singular vector matrix.
-*> = 1: Right singular vector matrix.
-*> \endverbatim
-*>
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has row dimension N = NL + NR + 1,
-*> and column dimension M = N + SQRE.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of columns of B and BX. NRHS must be at least 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension ( LDB, NRHS )
-*> On input, B contains the right hand sides of the least
-*> squares problem in rows 1 through M. On output, B contains
-*> the solution X in rows 1 through N.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. LDB must be at least
-*> max(1,MAX( M, N ) ).
-*> \endverbatim
-*>
-*> \param[out] BX
-*> \verbatim
-*> BX is REAL array, dimension ( LDBX, NRHS )
-*> \endverbatim
-*>
-*> \param[in] LDBX
-*> \verbatim
-*> LDBX is INTEGER
-*> The leading dimension of BX.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( N )
-*> The permutations (from deflation and sorting) applied
-*> to the two blocks.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
-*> Each pair of numbers indicates a pair of rows/columns
-*> involved in a Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER
-*> The leading dimension of GIVCOL, must be at least N.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension ( LDGNUM, 2 )
-*> Each number indicates the C or S value used in the
-*> corresponding Givens rotation.
-*> \endverbatim
-*>
-*> \param[in] LDGNUM
-*> \verbatim
-*> LDGNUM is INTEGER
-*> The leading dimension of arrays DIFR, POLES and
-*> GIVNUM, must be at least K.
-*> \endverbatim
-*>
-*> \param[in] POLES
-*> \verbatim
-*> POLES is REAL array, dimension ( LDGNUM, 2 )
-*> On entry, POLES(1:K, 1) contains the new singular
-*> values obtained from solving the secular equation, and
-*> POLES(1:K, 2) is an array containing the poles in the secular
-*> equation.
-*> \endverbatim
-*>
-*> \param[in] DIFL
-*> \verbatim
-*> DIFL is REAL array, dimension ( K ).
-*> On entry, DIFL(I) is the distance between I-th updated
-*> (undeflated) singular value and the I-th (undeflated) old
-*> singular value.
-*> \endverbatim
-*>
-*> \param[in] DIFR
-*> \verbatim
-*> DIFR is REAL array, dimension ( LDGNUM, 2 ).
-*> On entry, DIFR(I, 1) contains the distances between I-th
-*> updated (undeflated) singular value and the I+1-th
-*> (undeflated) old singular value. And DIFR(I, 2) is the
-*> normalizing factor for the I-th right singular vector.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( K )
-*> Contain the components of the deflation-adjusted updating row
-*> vector.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix,
-*> This is the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL
-*> C contains garbage if SQRE =0 and the C-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL
-*> S contains garbage if SQRE =0 and the S-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ( K )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
- $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
- $ POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL,
- $ LDGNUM, NL, NR, NRHS, SQRE
- REAL C, S
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), PERM( * )
- REAL B( LDB, * ), BX( LDBX, * ), DIFL( * ),
- $ DIFR( LDGNUM, * ), GIVNUM( LDGNUM, * ),
- $ POLES( LDGNUM, * ), WORK( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO, NEGONE
- PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0, NEGONE = -1.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, M, N, NLP1
- REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SROT, SSCAL,
- $ XERBLA
-* ..
-* .. External Functions ..
- REAL SLAMC3, SNRM2
- EXTERNAL SLAMC3, SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( NL.LT.1 ) THEN
- INFO = -2
- ELSE IF( NR.LT.1 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- END IF
-*
- N = NL + NR + 1
-*
- IF( NRHS.LT.1 ) THEN
- INFO = -5
- ELSE IF( LDB.LT.N ) THEN
- INFO = -7
- ELSE IF( LDBX.LT.N ) THEN
- INFO = -9
- ELSE IF( GIVPTR.LT.0 ) THEN
- INFO = -11
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -13
- ELSE IF( LDGNUM.LT.N ) THEN
- INFO = -15
- ELSE IF( K.LT.1 ) THEN
- INFO = -20
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLALS0', -INFO )
- RETURN
- END IF
-*
- M = N + SQRE
- NLP1 = NL + 1
-*
- IF( ICOMPQ.EQ.0 ) THEN
-*
-* Apply back orthogonal transformations from the left.
-*
-* Step (1L): apply back the Givens rotations performed.
-*
- DO 10 I = 1, GIVPTR
- CALL SROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB,
- $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ),
- $ GIVNUM( I, 1 ) )
- 10 CONTINUE
-*
-* Step (2L): permute rows of B.
-*
- CALL SCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX )
- DO 20 I = 2, N
- CALL SCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX )
- 20 CONTINUE
-*
-* Step (3L): apply the inverse of the left singular vector
-* matrix to BX.
-*
- IF( K.EQ.1 ) THEN
- CALL SCOPY( NRHS, BX, LDBX, B, LDB )
- IF( Z( 1 ).LT.ZERO ) THEN
- CALL SSCAL( NRHS, NEGONE, B, LDB )
- END IF
- ELSE
- DO 50 J = 1, K
- DIFLJ = DIFL( J )
- DJ = POLES( J, 1 )
- DSIGJ = -POLES( J, 2 )
- IF( J.LT.K ) THEN
- DIFRJ = -DIFR( J, 1 )
- DSIGJP = -POLES( J+1, 2 )
- END IF
- IF( ( Z( J ).EQ.ZERO ) .OR. ( POLES( J, 2 ).EQ.ZERO ) )
- $ THEN
- WORK( J ) = ZERO
- ELSE
- WORK( J ) = -POLES( J, 2 )*Z( J ) / DIFLJ /
- $ ( POLES( J, 2 )+DJ )
- END IF
- DO 30 I = 1, J - 1
- IF( ( Z( I ).EQ.ZERO ) .OR.
- $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = POLES( I, 2 )*Z( I ) /
- $ ( SLAMC3( POLES( I, 2 ), DSIGJ )-
- $ DIFLJ ) / ( POLES( I, 2 )+DJ )
- END IF
- 30 CONTINUE
- DO 40 I = J + 1, K
- IF( ( Z( I ).EQ.ZERO ) .OR.
- $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = POLES( I, 2 )*Z( I ) /
- $ ( SLAMC3( POLES( I, 2 ), DSIGJP )+
- $ DIFRJ ) / ( POLES( I, 2 )+DJ )
- END IF
- 40 CONTINUE
- WORK( 1 ) = NEGONE
- TEMP = SNRM2( K, WORK, 1 )
- CALL SGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO,
- $ B( J, 1 ), LDB )
- CALL SLASCL( 'G', 0, 0, TEMP, ONE, 1, NRHS, B( J, 1 ),
- $ LDB, INFO )
- 50 CONTINUE
- END IF
-*
-* Move the deflated rows of BX to B also.
-*
- IF( K.LT.MAX( M, N ) )
- $ CALL SLACPY( 'A', N-K, NRHS, BX( K+1, 1 ), LDBX,
- $ B( K+1, 1 ), LDB )
- ELSE
-*
-* Apply back the right orthogonal transformations.
-*
-* Step (1R): apply back the new right singular vector matrix
-* to B.
-*
- IF( K.EQ.1 ) THEN
- CALL SCOPY( NRHS, B, LDB, BX, LDBX )
- ELSE
- DO 80 J = 1, K
- DSIGJ = POLES( J, 2 )
- IF( Z( J ).EQ.ZERO ) THEN
- WORK( J ) = ZERO
- ELSE
- WORK( J ) = -Z( J ) / DIFL( J ) /
- $ ( DSIGJ+POLES( J, 1 ) ) / DIFR( J, 2 )
- END IF
- DO 60 I = 1, J - 1
- IF( Z( J ).EQ.ZERO ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I+1,
- $ 2 ) )-DIFR( I, 1 ) ) /
- $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
- END IF
- 60 CONTINUE
- DO 70 I = J + 1, K
- IF( Z( J ).EQ.ZERO ) THEN
- WORK( I ) = ZERO
- ELSE
- WORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I,
- $ 2 ) )-DIFL( I ) ) /
- $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
- END IF
- 70 CONTINUE
- CALL SGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO,
- $ BX( J, 1 ), LDBX )
- 80 CONTINUE
- END IF
-*
-* Step (2R): if SQRE = 1, apply back the rotation that is
-* related to the right null space of the subproblem.
-*
- IF( SQRE.EQ.1 ) THEN
- CALL SCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX )
- CALL SROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S )
- END IF
- IF( K.LT.MAX( M, N ) )
- $ CALL SLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ),
- $ LDBX )
-*
-* Step (3R): permute rows of B.
-*
- CALL SCOPY( NRHS, BX( 1, 1 ), LDBX, B( NLP1, 1 ), LDB )
- IF( SQRE.EQ.1 ) THEN
- CALL SCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB )
- END IF
- DO 90 I = 2, N
- CALL SCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB )
- 90 CONTINUE
-*
-* Step (4R): apply back the Givens rotations performed.
-*
- DO 100 I = GIVPTR, 1, -1
- CALL SROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB,
- $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ),
- $ -GIVNUM( I, 1 ) )
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SLALS0
-*
- END
diff --git a/netlib/LAPACK/slalsa.f b/netlib/LAPACK/slalsa.f
deleted file mode 100644
index ad225d0..0000000
--- a/netlib/LAPACK/slalsa.f
+++ /dev/null
@@ -1,495 +0,0 @@
-*> \brief \b SLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLALSA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slalsa.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slalsa.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slalsa.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
-* LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
-* GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
-* $ SMLSIZ
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
-* $ K( * ), PERM( LDGCOL, * )
-* REAL B( LDB, * ), BX( LDBX, * ), C( * ),
-* $ DIFL( LDU, * ), DIFR( LDU, * ),
-* $ GIVNUM( LDU, * ), POLES( LDU, * ), S( * ),
-* $ U( LDU, * ), VT( LDU, * ), WORK( * ),
-* $ Z( LDU, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLALSA is an itermediate step in solving the least squares problem
-*> by computing the SVD of the coefficient matrix in compact form (The
-*> singular vectors are computed as products of simple orthorgonal
-*> matrices.).
-*>
-*> If ICOMPQ = 0, SLALSA applies the inverse of the left singular vector
-*> matrix of an upper bidiagonal matrix to the right hand side; and if
-*> ICOMPQ = 1, SLALSA applies the right singular vector matrix to the
-*> right hand side. The singular vector matrices were generated in
-*> compact form by SLALSA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether the left or the right singular vector
-*> matrix is involved.
-*> = 0: Left singular vector matrix
-*> = 1: Right singular vector matrix
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> The maximum size of the subproblems at the bottom of the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The row and column dimensions of the upper bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of columns of B and BX. NRHS must be at least 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension ( LDB, NRHS )
-*> On input, B contains the right hand sides of the least
-*> squares problem in rows 1 through M.
-*> On output, B contains the solution X in rows 1 through N.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B in the calling subprogram.
-*> LDB must be at least max(1,MAX( M, N ) ).
-*> \endverbatim
-*>
-*> \param[out] BX
-*> \verbatim
-*> BX is REAL array, dimension ( LDBX, NRHS )
-*> On exit, the result of applying the left or right singular
-*> vector matrix to B.
-*> \endverbatim
-*>
-*> \param[in] LDBX
-*> \verbatim
-*> LDBX is INTEGER
-*> The leading dimension of BX.
-*> \endverbatim
-*>
-*> \param[in] U
-*> \verbatim
-*> U is REAL array, dimension ( LDU, SMLSIZ ).
-*> On entry, U contains the left singular vector matrices of all
-*> subproblems at the bottom level.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER, LDU = > N.
-*> The leading dimension of arrays U, VT, DIFL, DIFR,
-*> POLES, GIVNUM, and Z.
-*> \endverbatim
-*>
-*> \param[in] VT
-*> \verbatim
-*> VT is REAL array, dimension ( LDU, SMLSIZ+1 ).
-*> On entry, VT**T contains the right singular vector matrices of
-*> all subproblems at the bottom level.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER array, dimension ( N ).
-*> \endverbatim
-*>
-*> \param[in] DIFL
-*> \verbatim
-*> DIFL is REAL array, dimension ( LDU, NLVL ).
-*> where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
-*> \endverbatim
-*>
-*> \param[in] DIFR
-*> \verbatim
-*> DIFR is REAL array, dimension ( LDU, 2 * NLVL ).
-*> On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
-*> distances between singular values on the I-th level and
-*> singular values on the (I -1)-th level, and DIFR(*, 2 * I)
-*> record the normalizing factors of the right singular vectors
-*> matrices of subproblems on I-th level.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( LDU, NLVL ).
-*> On entry, Z(1, I) contains the components of the deflation-
-*> adjusted updating row vector for subproblems on the I-th
-*> level.
-*> \endverbatim
-*>
-*> \param[in] POLES
-*> \verbatim
-*> POLES is REAL array, dimension ( LDU, 2 * NLVL ).
-*> On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
-*> singular values involved in the secular equations on the I-th
-*> level.
-*> \endverbatim
-*>
-*> \param[in] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array, dimension ( N ).
-*> On entry, GIVPTR( I ) records the number of Givens
-*> rotations performed on the I-th problem on the computation
-*> tree.
-*> \endverbatim
-*>
-*> \param[in] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
-*> On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
-*> locations of Givens rotations performed on the I-th level on
-*> the computation tree.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER, LDGCOL = > N.
-*> The leading dimension of arrays GIVCOL and PERM.
-*> \endverbatim
-*>
-*> \param[in] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( LDGCOL, NLVL ).
-*> On entry, PERM(*, I) records permutations done on the I-th
-*> level of the computation tree.
-*> \endverbatim
-*>
-*> \param[in] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension ( LDU, 2 * NLVL ).
-*> On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
-*> values of Givens rotations performed on the I-th level on the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension ( N ).
-*> On entry, if the I-th subproblem is not square,
-*> C( I ) contains the C-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension ( N ).
-*> On entry, if the I-th subproblem is not square,
-*> S( I ) contains the S-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array.
-*> The dimension must be at least N.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array.
-*> The dimension must be at least 3 * N
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
- $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
- $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
- $ SMLSIZ
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
- $ K( * ), PERM( LDGCOL, * )
- REAL B( LDB, * ), BX( LDBX, * ), C( * ),
- $ DIFL( LDU, * ), DIFR( LDU, * ),
- $ GIVNUM( LDU, * ), POLES( LDU, * ), S( * ),
- $ U( LDU, * ), VT( LDU, * ), WORK( * ),
- $ Z( LDU, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, IC, IM1, INODE, J, LF, LL, LVL, LVL2,
- $ ND, NDB1, NDIML, NDIMR, NL, NLF, NLP1, NLVL,
- $ NR, NRF, NRP1, SQRE
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, SLALS0, SLASDT, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( SMLSIZ.LT.3 ) THEN
- INFO = -2
- ELSE IF( N.LT.SMLSIZ ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.1 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.N ) THEN
- INFO = -6
- ELSE IF( LDBX.LT.N ) THEN
- INFO = -8
- ELSE IF( LDU.LT.N ) THEN
- INFO = -10
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -19
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLALSA', -INFO )
- RETURN
- END IF
-*
-* Book-keeping and setting up the computation tree.
-*
- INODE = 1
- NDIML = INODE + N
- NDIMR = NDIML + N
-*
- CALL SLASDT( N, NLVL, ND, IWORK( INODE ), IWORK( NDIML ),
- $ IWORK( NDIMR ), SMLSIZ )
-*
-* The following code applies back the left singular vector factors.
-* For applying back the right singular vector factors, go to 50.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- GO TO 50
- END IF
-*
-* The nodes on the bottom level of the tree were solved
-* by SLASDQ. The corresponding left and right singular vector
-* matrices are in explicit form. First apply back the left
-* singular vector matrices.
-*
- NDB1 = ( ND+1 ) / 2
- DO 10 I = NDB1, ND
-*
-* IC : center row of each node
-* NL : number of rows of left subproblem
-* NR : number of rows of right subproblem
-* NLF: starting row of the left subproblem
-* NRF: starting row of the right subproblem
-*
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NR = IWORK( NDIMR+I1 )
- NLF = IC - NL
- NRF = IC + 1
- CALL SGEMM( 'T', 'N', NL, NRHS, NL, ONE, U( NLF, 1 ), LDU,
- $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
- CALL SGEMM( 'T', 'N', NR, NRHS, NR, ONE, U( NRF, 1 ), LDU,
- $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
- 10 CONTINUE
-*
-* Next copy the rows of B that correspond to unchanged rows
-* in the bidiagonal matrix to BX.
-*
- DO 20 I = 1, ND
- IC = IWORK( INODE+I-1 )
- CALL SCOPY( NRHS, B( IC, 1 ), LDB, BX( IC, 1 ), LDBX )
- 20 CONTINUE
-*
-* Finally go through the left singular vector matrices of all
-* the other subproblems bottom-up on the tree.
-*
- J = 2**NLVL
- SQRE = 0
-*
- DO 40 LVL = NLVL, 1, -1
- LVL2 = 2*LVL - 1
-*
-* find the first node LF and last node LL on
-* the current level LVL
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 30 I = LF, LL
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- NRF = IC + 1
- J = J - 1
- CALL SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX,
- $ B( NLF, 1 ), LDB, PERM( NLF, LVL ),
- $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
- $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ),
- $ DIFL( NLF, LVL ), DIFR( NLF, LVL2 ),
- $ Z( NLF, LVL ), K( J ), C( J ), S( J ), WORK,
- $ INFO )
- 30 CONTINUE
- 40 CONTINUE
- GO TO 90
-*
-* ICOMPQ = 1: applying back the right singular vector factors.
-*
- 50 CONTINUE
-*
-* First now go through the right singular vector matrices of all
-* the tree nodes top-down.
-*
- J = 0
- DO 70 LVL = 1, NLVL
- LVL2 = 2*LVL - 1
-*
-* Find the first node LF and last node LL on
-* the current level LVL.
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 60 I = LL, LF, -1
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- NRF = IC + 1
- IF( I.EQ.LL ) THEN
- SQRE = 0
- ELSE
- SQRE = 1
- END IF
- J = J + 1
- CALL SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB,
- $ BX( NLF, 1 ), LDBX, PERM( NLF, LVL ),
- $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
- $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ),
- $ DIFL( NLF, LVL ), DIFR( NLF, LVL2 ),
- $ Z( NLF, LVL ), K( J ), C( J ), S( J ), WORK,
- $ INFO )
- 60 CONTINUE
- 70 CONTINUE
-*
-* The nodes on the bottom level of the tree were solved
-* by SLASDQ. The corresponding right singular vector
-* matrices are in explicit form. Apply them back.
-*
- NDB1 = ( ND+1 ) / 2
- DO 80 I = NDB1, ND
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NR = IWORK( NDIMR+I1 )
- NLP1 = NL + 1
- IF( I.EQ.ND ) THEN
- NRP1 = NR
- ELSE
- NRP1 = NR + 1
- END IF
- NLF = IC - NL
- NRF = IC + 1
- CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU,
- $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
- CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU,
- $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
- 80 CONTINUE
-*
- 90 CONTINUE
-*
- RETURN
-*
-* End of SLALSA
-*
- END
diff --git a/netlib/LAPACK/slalsd.f b/netlib/LAPACK/slalsd.f
deleted file mode 100644
index fe1f0c5..0000000
--- a/netlib/LAPACK/slalsd.f
+++ /dev/null
@@ -1,523 +0,0 @@
-*> \brief \b SLALSD uses the singular value decomposition of A to solve the least squares problem.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLALSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slalsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slalsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slalsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND,
-* RANK, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS, RANK, SMLSIZ
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL B( LDB, * ), D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLALSD uses the singular value decomposition of A to solve the least
-*> squares problem of finding X to minimize the Euclidean norm of each
-*> column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
-*> are N-by-NRHS. The solution X overwrites B.
-*>
-*> The singular values of A smaller than RCOND times the largest
-*> singular value are treated as zero in solving the least squares
-*> problem; in this case a minimum norm solution is returned.
-*> The actual singular values are returned in D in ascending order.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': D and E define an upper bidiagonal matrix.
-*> = 'L': D and E define a lower bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> The maximum size of the subproblems at the bottom of the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the bidiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of columns of B. NRHS must be at least 1.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry D contains the main diagonal of the bidiagonal
-*> matrix. On exit, if INFO = 0, D contains its singular values.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> Contains the super-diagonal entries of the bidiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On input, B contains the right hand sides of the least
-*> squares problem. On output, B contains the solution X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B in the calling subprogram.
-*> LDB must be at least max(1,N).
-*> \endverbatim
-*>
-*> \param[in] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The singular values of A less than or equal to RCOND times
-*> the largest singular value are treated as zero in solving
-*> the least squares problem. If RCOND is negative,
-*> machine precision is used instead.
-*> For example, if diag(S)*X=B were the least squares problem,
-*> where diag(S) is a diagonal matrix of singular values, the
-*> solution would be X(i) = B(i) / S(i) if S(i) is greater than
-*> RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
-*> RCOND*max(S).
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The number of singular values of A greater than RCOND times
-*> the largest singular value.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension at least
-*> (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
-*> where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension at least
-*> (3*N*NLVL + 11*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute a singular value while
-*> working on the submatrix lying in rows and columns
-*> INFO/(N+1) through MOD(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND,
- $ RANK, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS, RANK, SMLSIZ
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL B( LDB, * ), D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER BX, BXST, C, DIFL, DIFR, GIVCOL, GIVNUM,
- $ GIVPTR, I, ICMPQ1, ICMPQ2, IWK, J, K, NLVL,
- $ NM1, NSIZE, NSUB, NWORK, PERM, POLES, S, SIZEI,
- $ SMLSZP, SQRE, ST, ST1, U, VT, Z
- REAL CS, EPS, ORGNRM, R, RCND, SN, TOL
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH, SLANST
- EXTERNAL ISAMAX, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, SLACPY, SLALSA, SLARTG, SLASCL,
- $ SLASDA, SLASDQ, SLASET, SLASRT, SROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, REAL, SIGN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.1 ) THEN
- INFO = -4
- ELSE IF( ( LDB.LT.1 ) .OR. ( LDB.LT.N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLALSD', -INFO )
- RETURN
- END IF
-*
- EPS = SLAMCH( 'Epsilon' )
-*
-* Set up the tolerance.
-*
- IF( ( RCOND.LE.ZERO ) .OR. ( RCOND.GE.ONE ) ) THEN
- RCND = EPS
- ELSE
- RCND = RCOND
- END IF
-*
- RANK = 0
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- IF( D( 1 ).EQ.ZERO ) THEN
- CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, B, LDB )
- ELSE
- RANK = 1
- CALL SLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO )
- D( 1 ) = ABS( D( 1 ) )
- END IF
- RETURN
- END IF
-*
-* Rotate the matrix if it is lower bidiagonal.
-*
- IF( UPLO.EQ.'L' ) THEN
- DO 10 I = 1, N - 1
- CALL SLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( NRHS.EQ.1 ) THEN
- CALL SROT( 1, B( I, 1 ), 1, B( I+1, 1 ), 1, CS, SN )
- ELSE
- WORK( I*2-1 ) = CS
- WORK( I*2 ) = SN
- END IF
- 10 CONTINUE
- IF( NRHS.GT.1 ) THEN
- DO 30 I = 1, NRHS
- DO 20 J = 1, N - 1
- CS = WORK( J*2-1 )
- SN = WORK( J*2 )
- CALL SROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN )
- 20 CONTINUE
- 30 CONTINUE
- END IF
- END IF
-*
-* Scale.
-*
- NM1 = N - 1
- ORGNRM = SLANST( 'M', N, D, E )
- IF( ORGNRM.EQ.ZERO ) THEN
- CALL SLASET( 'A', N, NRHS, ZERO, ZERO, B, LDB )
- RETURN
- END IF
-*
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, INFO )
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, NM1, 1, E, NM1, INFO )
-*
-* If N is smaller than the minimum divide size SMLSIZ, then solve
-* the problem with another solver.
-*
- IF( N.LE.SMLSIZ ) THEN
- NWORK = 1 + N*N
- CALL SLASET( 'A', N, N, ZERO, ONE, WORK, N )
- CALL SLASDQ( 'U', 0, N, N, 0, NRHS, D, E, WORK, N, WORK, N, B,
- $ LDB, WORK( NWORK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- TOL = RCND*ABS( D( ISAMAX( N, D, 1 ) ) )
- DO 40 I = 1, N
- IF( D( I ).LE.TOL ) THEN
- CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
- ELSE
- CALL SLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ),
- $ LDB, INFO )
- RANK = RANK + 1
- END IF
- 40 CONTINUE
- CALL SGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, ZERO,
- $ WORK( NWORK ), N )
- CALL SLACPY( 'A', N, NRHS, WORK( NWORK ), N, B, LDB )
-*
-* Unscale.
-*
- CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
- CALL SLASRT( 'D', N, D, INFO )
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, N, NRHS, B, LDB, INFO )
-*
- RETURN
- END IF
-*
-* Book-keeping and setting up some constants.
-*
- NLVL = INT( LOG( REAL( N ) / REAL( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1
-*
- SMLSZP = SMLSIZ + 1
-*
- U = 1
- VT = 1 + SMLSIZ*N
- DIFL = VT + SMLSZP*N
- DIFR = DIFL + NLVL*N
- Z = DIFR + NLVL*N*2
- C = Z + NLVL*N
- S = C + N
- POLES = S + N
- GIVNUM = POLES + 2*NLVL*N
- BX = GIVNUM + 2*NLVL*N
- NWORK = BX + N*NRHS
-*
- SIZEI = 1 + N
- K = SIZEI + N
- GIVPTR = K + N
- PERM = GIVPTR + N
- GIVCOL = PERM + NLVL*N
- IWK = GIVCOL + NLVL*N*2
-*
- ST = 1
- SQRE = 0
- ICMPQ1 = 1
- ICMPQ2 = 0
- NSUB = 0
-*
- DO 50 I = 1, N
- IF( ABS( D( I ) ).LT.EPS ) THEN
- D( I ) = SIGN( EPS, D( I ) )
- END IF
- 50 CONTINUE
-*
- DO 60 I = 1, NM1
- IF( ( ABS( E( I ) ).LT.EPS ) .OR. ( I.EQ.NM1 ) ) THEN
- NSUB = NSUB + 1
- IWORK( NSUB ) = ST
-*
-* Subproblem found. First determine its size and then
-* apply divide and conquer on it.
-*
- IF( I.LT.NM1 ) THEN
-*
-* A subproblem with E(I) small for I < NM1.
-*
- NSIZE = I - ST + 1
- IWORK( SIZEI+NSUB-1 ) = NSIZE
- ELSE IF( ABS( E( I ) ).GE.EPS ) THEN
-*
-* A subproblem with E(NM1) not too small but I = NM1.
-*
- NSIZE = N - ST + 1
- IWORK( SIZEI+NSUB-1 ) = NSIZE
- ELSE
-*
-* A subproblem with E(NM1) small. This implies an
-* 1-by-1 subproblem at D(N), which is not solved
-* explicitly.
-*
- NSIZE = I - ST + 1
- IWORK( SIZEI+NSUB-1 ) = NSIZE
- NSUB = NSUB + 1
- IWORK( NSUB ) = N
- IWORK( SIZEI+NSUB-1 ) = 1
- CALL SCOPY( NRHS, B( N, 1 ), LDB, WORK( BX+NM1 ), N )
- END IF
- ST1 = ST - 1
- IF( NSIZE.EQ.1 ) THEN
-*
-* This is a 1-by-1 subproblem and is not solved
-* explicitly.
-*
- CALL SCOPY( NRHS, B( ST, 1 ), LDB, WORK( BX+ST1 ), N )
- ELSE IF( NSIZE.LE.SMLSIZ ) THEN
-*
-* This is a small subproblem and is solved by SLASDQ.
-*
- CALL SLASET( 'A', NSIZE, NSIZE, ZERO, ONE,
- $ WORK( VT+ST1 ), N )
- CALL SLASDQ( 'U', 0, NSIZE, NSIZE, 0, NRHS, D( ST ),
- $ E( ST ), WORK( VT+ST1 ), N, WORK( NWORK ),
- $ N, B( ST, 1 ), LDB, WORK( NWORK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- CALL SLACPY( 'A', NSIZE, NRHS, B( ST, 1 ), LDB,
- $ WORK( BX+ST1 ), N )
- ELSE
-*
-* A large problem. Solve it using divide and conquer.
-*
- CALL SLASDA( ICMPQ1, SMLSIZ, NSIZE, SQRE, D( ST ),
- $ E( ST ), WORK( U+ST1 ), N, WORK( VT+ST1 ),
- $ IWORK( K+ST1 ), WORK( DIFL+ST1 ),
- $ WORK( DIFR+ST1 ), WORK( Z+ST1 ),
- $ WORK( POLES+ST1 ), IWORK( GIVPTR+ST1 ),
- $ IWORK( GIVCOL+ST1 ), N, IWORK( PERM+ST1 ),
- $ WORK( GIVNUM+ST1 ), WORK( C+ST1 ),
- $ WORK( S+ST1 ), WORK( NWORK ), IWORK( IWK ),
- $ INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- BXST = BX + ST1
- CALL SLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, B( ST, 1 ),
- $ LDB, WORK( BXST ), N, WORK( U+ST1 ), N,
- $ WORK( VT+ST1 ), IWORK( K+ST1 ),
- $ WORK( DIFL+ST1 ), WORK( DIFR+ST1 ),
- $ WORK( Z+ST1 ), WORK( POLES+ST1 ),
- $ IWORK( GIVPTR+ST1 ), IWORK( GIVCOL+ST1 ), N,
- $ IWORK( PERM+ST1 ), WORK( GIVNUM+ST1 ),
- $ WORK( C+ST1 ), WORK( S+ST1 ), WORK( NWORK ),
- $ IWORK( IWK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- END IF
- ST = I + 1
- END IF
- 60 CONTINUE
-*
-* Apply the singular values and treat the tiny ones as zero.
-*
- TOL = RCND*ABS( D( ISAMAX( N, D, 1 ) ) )
-*
- DO 70 I = 1, N
-*
-* Some of the elements in D can be negative because 1-by-1
-* subproblems were not solved explicitly.
-*
- IF( ABS( D( I ) ).LE.TOL ) THEN
- CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, WORK( BX+I-1 ), N )
- ELSE
- RANK = RANK + 1
- CALL SLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS,
- $ WORK( BX+I-1 ), N, INFO )
- END IF
- D( I ) = ABS( D( I ) )
- 70 CONTINUE
-*
-* Now apply back the right singular vectors.
-*
- ICMPQ2 = 1
- DO 80 I = 1, NSUB
- ST = IWORK( I )
- ST1 = ST - 1
- NSIZE = IWORK( SIZEI+I-1 )
- BXST = BX + ST1
- IF( NSIZE.EQ.1 ) THEN
- CALL SCOPY( NRHS, WORK( BXST ), N, B( ST, 1 ), LDB )
- ELSE IF( NSIZE.LE.SMLSIZ ) THEN
- CALL SGEMM( 'T', 'N', NSIZE, NRHS, NSIZE, ONE,
- $ WORK( VT+ST1 ), N, WORK( BXST ), N, ZERO,
- $ B( ST, 1 ), LDB )
- ELSE
- CALL SLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N,
- $ B( ST, 1 ), LDB, WORK( U+ST1 ), N,
- $ WORK( VT+ST1 ), IWORK( K+ST1 ),
- $ WORK( DIFL+ST1 ), WORK( DIFR+ST1 ),
- $ WORK( Z+ST1 ), WORK( POLES+ST1 ),
- $ IWORK( GIVPTR+ST1 ), IWORK( GIVCOL+ST1 ), N,
- $ IWORK( PERM+ST1 ), WORK( GIVNUM+ST1 ),
- $ WORK( C+ST1 ), WORK( S+ST1 ), WORK( NWORK ),
- $ IWORK( IWK ), INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- END IF
- 80 CONTINUE
-*
-* Unscale and sort the singular values.
-*
- CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
- CALL SLASRT( 'D', N, D, INFO )
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, N, NRHS, B, LDB, INFO )
-*
- RETURN
-*
-* End of SLALSD
-*
- END
diff --git a/netlib/LAPACK/slamch.f b/netlib/LAPACK/slamch.f
deleted file mode 100644
index 4bffad0..0000000
--- a/netlib/LAPACK/slamch.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b SLAMCH
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLAMCH( CMACH )
-*
-* .. Scalar Arguments ..
-* CHARACTER CMACH
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAMCH determines single precision machine parameters.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] CMACH
-*> \verbatim
-*> Specifies the value to be returned by SLAMCH:
-*> = 'E' or 'e', SLAMCH := eps
-*> = 'S' or 's , SLAMCH := sfmin
-*> = 'B' or 'b', SLAMCH := base
-*> = 'P' or 'p', SLAMCH := eps*base
-*> = 'N' or 'n', SLAMCH := t
-*> = 'R' or 'r', SLAMCH := rnd
-*> = 'M' or 'm', SLAMCH := emin
-*> = 'U' or 'u', SLAMCH := rmin
-*> = 'L' or 'l', SLAMCH := emax
-*> = 'O' or 'o', SLAMCH := rmax
-*> where
-*> eps = relative machine precision
-*> sfmin = safe minimum, such that 1/sfmin does not overflow
-*> base = base of the machine
-*> prec = eps*base
-*> t = number of (base) digits in the mantissa
-*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
-*> emin = minimum exponent before (gradual) underflow
-*> rmin = underflow threshold - base**(emin-1)
-*> emax = largest exponent before overflow
-*> rmax = overflow threshold - (base**emax)*(1-eps)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLAMCH( CMACH )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER CMACH
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL RND, EPS, SFMIN, SMALL, RMACH
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
- $ MINEXPONENT, RADIX, TINY
-* ..
-* .. Executable Statements ..
-*
-*
-* Assume rounding, not chopping. Always.
-*
- RND = ONE
-*
- IF( ONE.EQ.RND ) THEN
- EPS = EPSILON(ZERO) * 0.5
- ELSE
- EPS = EPSILON(ZERO)
- END IF
-*
- IF( LSAME( CMACH, 'E' ) ) THEN
- RMACH = EPS
- ELSE IF( LSAME( CMACH, 'S' ) ) THEN
- SFMIN = TINY(ZERO)
- SMALL = ONE / HUGE(ZERO)
- IF( SMALL.GE.SFMIN ) THEN
-*
-* Use SMALL plus a bit, to avoid the possibility of rounding
-* causing overflow when computing 1/sfmin.
-*
- SFMIN = SMALL*( ONE+EPS )
- END IF
- RMACH = SFMIN
- ELSE IF( LSAME( CMACH, 'B' ) ) THEN
- RMACH = RADIX(ZERO)
- ELSE IF( LSAME( CMACH, 'P' ) ) THEN
- RMACH = EPS * RADIX(ZERO)
- ELSE IF( LSAME( CMACH, 'N' ) ) THEN
- RMACH = DIGITS(ZERO)
- ELSE IF( LSAME( CMACH, 'R' ) ) THEN
- RMACH = RND
- ELSE IF( LSAME( CMACH, 'M' ) ) THEN
- RMACH = MINEXPONENT(ZERO)
- ELSE IF( LSAME( CMACH, 'U' ) ) THEN
- RMACH = tiny(zero)
- ELSE IF( LSAME( CMACH, 'L' ) ) THEN
- RMACH = MAXEXPONENT(ZERO)
- ELSE IF( LSAME( CMACH, 'O' ) ) THEN
- RMACH = HUGE(ZERO)
- ELSE
- RMACH = ZERO
- END IF
-*
- SLAMCH = RMACH
- RETURN
-*
-* End of SLAMCH
-*
- END
-************************************************************************
-*> \brief \b SLAMC3
-*> \details
-*> \b Purpose:
-*> \verbatim
-*> SLAMC3 is intended to force A and B to be stored prior to doing
-*> the addition of A and B , for use in situations where optimizers
-*> might hold one of these in a register.
-*> \endverbatim
-*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
-*> \date November 2011
-*> \ingroup auxOTHERauxiliary
-*>
-*> \param[in] A
-*> \verbatim
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> The values A and B.
-*> \endverbatim
-*>
-*
- REAL FUNCTION SLAMC3( A, B )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2010
-*
-* .. Scalar Arguments ..
- REAL A, B
-* ..
-* =====================================================================
-*
-* .. Executable Statements ..
-*
- SLAMC3 = A + B
-*
- RETURN
-*
-* End of SLAMC3
-*
- END
-*
-************************************************************************
diff --git a/netlib/LAPACK/slamrg.f b/netlib/LAPACK/slamrg.f
deleted file mode 100644
index 6229abd..0000000
--- a/netlib/LAPACK/slamrg.f
+++ /dev/null
@@ -1,171 +0,0 @@
-*> \brief \b SLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAMRG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slamrg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slamrg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slamrg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX )
-*
-* .. Scalar Arguments ..
-* INTEGER N1, N2, STRD1, STRD2
-* ..
-* .. Array Arguments ..
-* INTEGER INDEX( * )
-* REAL A( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAMRG will create a permutation list which will merge the elements
-*> of A (which is composed of two independently sorted sets) into a
-*> single set which is sorted in ascending order.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> These arguements contain the respective lengths of the two
-*> sorted lists to be merged.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (N1+N2)
-*> The first N1 elements of A contain a list of numbers which
-*> are sorted in either ascending or descending order. Likewise
-*> for the final N2 elements.
-*> \endverbatim
-*>
-*> \param[in] STRD1
-*> \verbatim
-*> STRD1 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] STRD2
-*> \verbatim
-*> STRD2 is INTEGER
-*> These are the strides to be taken through the array A.
-*> Allowable strides are 1 and -1. They indicate whether a
-*> subset of A is sorted in ascending (STRDx = 1) or descending
-*> (STRDx = -1) order.
-*> \endverbatim
-*>
-*> \param[out] INDEX
-*> \verbatim
-*> INDEX is INTEGER array, dimension (N1+N2)
-*> On exit this array will contain a permutation such that
-*> if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
-*> sorted in ascending order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N1, N2, STRD1, STRD2
-* ..
-* .. Array Arguments ..
- INTEGER INDEX( * )
- REAL A( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IND1, IND2, N1SV, N2SV
-* ..
-* .. Executable Statements ..
-*
- N1SV = N1
- N2SV = N2
- IF( STRD1.GT.0 ) THEN
- IND1 = 1
- ELSE
- IND1 = N1
- END IF
- IF( STRD2.GT.0 ) THEN
- IND2 = 1 + N1
- ELSE
- IND2 = N1 + N2
- END IF
- I = 1
-* while ( (N1SV > 0) & (N2SV > 0) )
- 10 CONTINUE
- IF( N1SV.GT.0 .AND. N2SV.GT.0 ) THEN
- IF( A( IND1 ).LE.A( IND2 ) ) THEN
- INDEX( I ) = IND1
- I = I + 1
- IND1 = IND1 + STRD1
- N1SV = N1SV - 1
- ELSE
- INDEX( I ) = IND2
- I = I + 1
- IND2 = IND2 + STRD2
- N2SV = N2SV - 1
- END IF
- GO TO 10
- END IF
-* end while
- IF( N1SV.EQ.0 ) THEN
- DO 20 N1SV = 1, N2SV
- INDEX( I ) = IND2
- I = I + 1
- IND2 = IND2 + STRD2
- 20 CONTINUE
- ELSE
-* N2SV .EQ. 0
- DO 30 N2SV = 1, N1SV
- INDEX( I ) = IND1
- I = I + 1
- IND1 = IND1 + STRD1
- 30 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SLAMRG
-*
- END
diff --git a/netlib/LAPACK/slaneg.f b/netlib/LAPACK/slaneg.f
deleted file mode 100644
index f17068c..0000000
--- a/netlib/LAPACK/slaneg.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b SLANEG computes the Sturm count.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANEG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaneg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaneg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaneg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION SLANEG( N, D, LLD, SIGMA, PIVMIN, R )
-*
-* .. Scalar Arguments ..
-* INTEGER N, R
-* REAL PIVMIN, SIGMA
-* ..
-* .. Array Arguments ..
-* REAL D( * ), LLD( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANEG computes the Sturm count, the number of negative pivots
-*> encountered while factoring tridiagonal T - sigma I = L D L^T.
-*> This implementation works directly on the factors without forming
-*> the tridiagonal matrix T. The Sturm count is also the number of
-*> eigenvalues of T less than sigma.
-*>
-*> This routine is called from SLARRB.
-*>
-*> The current routine does not use the PIVMIN parameter but rather
-*> requires IEEE-754 propagation of Infinities and NaNs. This
-*> routine also has no input range restrictions but does require
-*> default exception handling such that x/0 produces Inf when x is
-*> non-zero, and Inf/Inf produces NaN. For more information, see:
-*>
-*> Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
-*> Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
-*> Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
-*> (Tech report version in LAWN 172 with the same title.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] LLD
-*> \verbatim
-*> LLD is REAL array, dimension (N-1)
-*> The (N-1) elements L(i)*L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] SIGMA
-*> \verbatim
-*> SIGMA is REAL
-*> Shift amount in T - sigma I = L D L^T.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot in the Sturm sequence. May be used
-*> when zero pivots are encountered on non-IEEE-754
-*> architectures.
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is INTEGER
-*> The twist index for the twisted factorization that is used
-*> for the negcount.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA \n
-*> Jason Riedy, University of California, Berkeley, USA \n
-*>
-* =====================================================================
- INTEGER FUNCTION SLANEG( N, D, LLD, SIGMA, PIVMIN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, R
- REAL PIVMIN, SIGMA
-* ..
-* .. Array Arguments ..
- REAL D( * ), LLD( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* Some architectures propagate Infinities and NaNs very slowly, so
-* the code computes counts in BLKLEN chunks. Then a NaN can
-* propagate at most BLKLEN columns before being detected. This is
-* not a general tuning parameter; it needs only to be just large
-* enough that the overhead is tiny in common cases.
- INTEGER BLKLEN
- PARAMETER ( BLKLEN = 128 )
-* ..
-* .. Local Scalars ..
- INTEGER BJ, J, NEG1, NEG2, NEGCNT
- REAL BSAV, DMINUS, DPLUS, GAMMA, P, T, TMP
- LOGICAL SAWNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN, MAX
-* ..
-* .. External Functions ..
- LOGICAL SISNAN
- EXTERNAL SISNAN
-* ..
-* .. Executable Statements ..
-
- NEGCNT = 0
-
-* I) upper part: L D L^T - SIGMA I = L+ D+ L+^T
- T = -SIGMA
- DO 210 BJ = 1, R-1, BLKLEN
- NEG1 = 0
- BSAV = T
- DO 21 J = BJ, MIN(BJ+BLKLEN-1, R-1)
- DPLUS = D( J ) + T
- IF( DPLUS.LT.ZERO ) NEG1 = NEG1 + 1
- TMP = T / DPLUS
- T = TMP * LLD( J ) - SIGMA
- 21 CONTINUE
- SAWNAN = SISNAN( T )
-* Run a slower version of the above loop if a NaN is detected.
-* A NaN should occur only with a zero pivot after an infinite
-* pivot. In that case, substituting 1 for T/DPLUS is the
-* correct limit.
- IF( SAWNAN ) THEN
- NEG1 = 0
- T = BSAV
- DO 22 J = BJ, MIN(BJ+BLKLEN-1, R-1)
- DPLUS = D( J ) + T
- IF( DPLUS.LT.ZERO ) NEG1 = NEG1 + 1
- TMP = T / DPLUS
- IF (SISNAN(TMP)) TMP = ONE
- T = TMP * LLD(J) - SIGMA
- 22 CONTINUE
- END IF
- NEGCNT = NEGCNT + NEG1
- 210 CONTINUE
-*
-* II) lower part: L D L^T - SIGMA I = U- D- U-^T
- P = D( N ) - SIGMA
- DO 230 BJ = N-1, R, -BLKLEN
- NEG2 = 0
- BSAV = P
- DO 23 J = BJ, MAX(BJ-BLKLEN+1, R), -1
- DMINUS = LLD( J ) + P
- IF( DMINUS.LT.ZERO ) NEG2 = NEG2 + 1
- TMP = P / DMINUS
- P = TMP * D( J ) - SIGMA
- 23 CONTINUE
- SAWNAN = SISNAN( P )
-* As above, run a slower version that substitutes 1 for Inf/Inf.
-*
- IF( SAWNAN ) THEN
- NEG2 = 0
- P = BSAV
- DO 24 J = BJ, MAX(BJ-BLKLEN+1, R), -1
- DMINUS = LLD( J ) + P
- IF( DMINUS.LT.ZERO ) NEG2 = NEG2 + 1
- TMP = P / DMINUS
- IF (SISNAN(TMP)) TMP = ONE
- P = TMP * D(J) - SIGMA
- 24 CONTINUE
- END IF
- NEGCNT = NEGCNT + NEG2
- 230 CONTINUE
-*
-* III) Twist index
-* T was shifted by SIGMA initially.
- GAMMA = (T + SIGMA) + P
- IF( GAMMA.LT.ZERO ) NEGCNT = NEGCNT+1
-
- SLANEG = NEGCNT
- END
diff --git a/netlib/LAPACK/slangb.f b/netlib/LAPACK/slangb.f
deleted file mode 100644
index 27c6fe6..0000000
--- a/netlib/LAPACK/slangb.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b SLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANGB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slangb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slangb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slangb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANGB( NORM, N, KL, KU, AB, LDAB,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER KL, KU, LDAB, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANGB returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of an
-*> n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
-*> \endverbatim
-*>
-*> \return SLANGB
-*> \verbatim
-*>
-*> SLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANGB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANGB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of sub-diagonals of the matrix A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of super-diagonals of the matrix A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th
-*> column of A is stored in the j-th column of the array AB as
-*> follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGBauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANGB( NORM, N, KL, KU, AB, LDAB,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER KL, KU, LDAB, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K, L
- REAL SCALE, SUM, VALUE, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- TEMP = ABS( AB( I, J ) )
- IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 30 CONTINUE
- IF( VALUE.LT.SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, N
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- K = KU + 1 - J
- DO 60 I = MAX( 1, J-KU ), MIN( N, J+KL )
- WORK( I ) = WORK( I ) + ABS( AB( K+I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, N
- TEMP = WORK( I )
- IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- L = MAX( 1, J-KU )
- K = KU + 1 - J + L
- CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANGB = VALUE
- RETURN
-*
-* End of SLANGB
-*
- END
diff --git a/netlib/LAPACK/slange.f b/netlib/LAPACK/slange.f
deleted file mode 100644
index f2fe0e4..0000000
--- a/netlib/LAPACK/slange.f
+++ /dev/null
@@ -1,211 +0,0 @@
-*> \brief \b SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANGE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slange.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slange.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slange.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANGE( NORM, M, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANGE returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real matrix A.
-*> \endverbatim
-*>
-*> \return SLANGE
-*> \verbatim
-*>
-*> SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANGE as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0. When M = 0,
-*> SLANGE is set to zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0. When N = 0,
-*> SLANGE is set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANGE( NORM, M, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL SCALE, SUM, VALUE, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( MIN( M, N ).EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = 1, M
- TEMP = ABS( A( I, J ) )
- IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = 1, M
- SUM = SUM + ABS( A( I, J ) )
- 30 CONTINUE
- IF( VALUE.LT.SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, M
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- DO 60 I = 1, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, M
- TEMP = WORK( I )
- IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANGE = VALUE
- RETURN
-*
-* End of SLANGE
-*
- END
diff --git a/netlib/LAPACK/slangt.f b/netlib/LAPACK/slangt.f
deleted file mode 100644
index 150eb97..0000000
--- a/netlib/LAPACK/slangt.f
+++ /dev/null
@@ -1,208 +0,0 @@
-*> \brief \b SLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANGT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slangt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slangt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slangt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANGT( NORM, N, DL, D, DU )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), DL( * ), DU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANGT returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \return SLANGT
-*> \verbatim
-*>
-*> SLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANGT as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANGT is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array, dimension (N-1)
-*> The (n-1) sub-diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is REAL array, dimension (N-1)
-*> The (n-1) super-diagonal elements of A.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANGT( NORM, N, DL, D, DU )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER N
-* ..
-* .. Array Arguments ..
- REAL D( * ), DL( * ), DU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL ANORM, SCALE, SUM, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- ANORM = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- ANORM = ABS( D( N ) )
- DO 10 I = 1, N - 1
- IF( ANORM.LT.ABS( DL( I ) ) .OR. SISNAN( ABS( DL( I ) ) ) )
- $ ANORM = ABS(DL(I))
- IF( ANORM.LT.ABS( D( I ) ) .OR. SISNAN( ABS( D( I ) ) ) )
- $ ANORM = ABS(D(I))
- IF( ANORM.LT.ABS( DU( I ) ) .OR. SISNAN (ABS( DU( I ) ) ) )
- $ ANORM = ABS(DU(I))
- 10 CONTINUE
- ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN
-*
-* Find norm1(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) )
- TEMP = ABS( D( N ) )+ABS( DU( N-1 ) )
- IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
- DO 20 I = 2, N - 1
- TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) )
- IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
- 20 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) )
- TEMP = ABS( D( N ) )+ABS( DL( N-1 ) )
- IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
- DO 30 I = 2, N - 1
- TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) )
- IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
- 30 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- CALL SLASSQ( N, D, 1, SCALE, SUM )
- IF( N.GT.1 ) THEN
- CALL SLASSQ( N-1, DL, 1, SCALE, SUM )
- CALL SLASSQ( N-1, DU, 1, SCALE, SUM )
- END IF
- ANORM = SCALE*SQRT( SUM )
- END IF
-*
- SLANGT = ANORM
- RETURN
-*
-* End of SLANGT
-*
- END
diff --git a/netlib/LAPACK/slanhs.f b/netlib/LAPACK/slanhs.f
deleted file mode 100644
index fe166cf..0000000
--- a/netlib/LAPACK/slanhs.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief \b SLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANHS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slanhs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slanhs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slanhs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANHS( NORM, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANHS returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> Hessenberg matrix A.
-*> \endverbatim
-*>
-*> \return SLANHS
-*> \verbatim
-*>
-*> SLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANHS as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANHS is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The n by n upper Hessenberg matrix A; the part of A below the
-*> first sub-diagonal is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(N,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANHS( NORM, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = 1, MIN( N, J+1 )
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = 1, MIN( N, J+1 )
- SUM = SUM + ABS( A( I, J ) )
- 30 CONTINUE
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, N
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- DO 60 I = 1, MIN( N, J+1 )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANHS = VALUE
- RETURN
-*
-* End of SLANHS
-*
- END
diff --git a/netlib/LAPACK/slansb.f b/netlib/LAPACK/slansb.f
deleted file mode 100644
index e361824..0000000
--- a/netlib/LAPACK/slansb.f
+++ /dev/null
@@ -1,258 +0,0 @@
-*> \brief \b SLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANSB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slansb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slansb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slansb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANSB( NORM, UPLO, N, K, AB, LDAB,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, UPLO
-* INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANSB returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of an
-*> n by n symmetric band matrix A, with k super-diagonals.
-*> \endverbatim
-*>
-*> \return SLANSB
-*> \verbatim
-*>
-*> SLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANSB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> band matrix A is supplied.
-*> = 'U': Upper triangular part is supplied
-*> = 'L': Lower triangular part is supplied
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANSB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of super-diagonals or sub-diagonals of the
-*> band matrix A. K >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangle of the symmetric band matrix A,
-*> stored in the first K+1 rows of AB. The j-th column of A is
-*> stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= K+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANSB( NORM, UPLO, N, K, AB, LDAB,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, UPLO
- INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
- REAL ABSA, SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = MAX( K+2-J, 1 ), K + 1
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = 1, MIN( N+1-J, K+1 )
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- SUM = ZERO
- L = K + 1 - J
- DO 50 I = MAX( 1, J-K ), J - 1
- ABSA = ABS( AB( L+I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 50 CONTINUE
- WORK( J ) = SUM + ABS( AB( K+1, J ) )
- 60 CONTINUE
- DO 70 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- ELSE
- DO 80 I = 1, N
- WORK( I ) = ZERO
- 80 CONTINUE
- DO 100 J = 1, N
- SUM = WORK( J ) + ABS( AB( 1, J ) )
- L = 1 - J
- DO 90 I = J + 1, MIN( N, J+K )
- ABSA = ABS( AB( L+I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 90 CONTINUE
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 100 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- IF( K.GT.0 ) THEN
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 2, N
- CALL SLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
- $ 1, SCALE, SUM )
- 110 CONTINUE
- L = K + 1
- ELSE
- DO 120 J = 1, N - 1
- CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
- $ SUM )
- 120 CONTINUE
- L = 1
- END IF
- SUM = 2*SUM
- ELSE
- L = 1
- END IF
- CALL SLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM )
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANSB = VALUE
- RETURN
-*
-* End of SLANSB
-*
- END
diff --git a/netlib/LAPACK/slansf.f b/netlib/LAPACK/slansf.f
deleted file mode 100644
index 5c3cdac..0000000
--- a/netlib/LAPACK/slansf.f
+++ /dev/null
@@ -1,964 +0,0 @@
-*> \brief \b SLANSF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANSF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slansf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slansf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slansf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, TRANSR, UPLO
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* REAL A( 0: * ), WORK( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANSF returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric matrix A in RFP format.
-*> \endverbatim
-*>
-*> \return SLANSF
-*> \verbatim
-*>
-*> SLANSF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANSF as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> Specifies whether the RFP format of A is normal or
-*> transposed format.
-*> = 'N': RFP format is Normal;
-*> = 'T': RFP format is Transpose.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the RFP matrix A came from
-*> an upper or lower triangular matrix as follows:
-*> = 'U': RFP A came from an upper triangular matrix;
-*> = 'L': RFP A came from a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANSF is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension ( N*(N+1)/2 );
-*> On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
-*> part of the symmetric matrix A stored in RFP format. See the
-*> "Notes" below for more details.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, TRANSR, UPLO
- INTEGER N
-* ..
-* .. Array Arguments ..
- REAL A( 0: * ), WORK( 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA
- REAL SCALE, S, VALUE, AA, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- SLANSF = ZERO
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- SLANSF = ABS( A(0) )
- RETURN
- END IF
-*
-* set noe = 1 if n is odd. if n is even set noe=0
-*
- NOE = 1
- IF( MOD( N, 2 ).EQ.0 )
- $ NOE = 0
-*
-* set ifm = 0 when form='T or 't' and 1 otherwise
-*
- IFM = 1
- IF( LSAME( TRANSR, 'T' ) )
- $ IFM = 0
-*
-* set ilu = 0 when uplo='U or 'u' and 1 otherwise
-*
- ILU = 1
- IF( LSAME( UPLO, 'U' ) )
- $ ILU = 0
-*
-* set lda = (n+1)/2 when ifm = 0
-* set lda = n when ifm = 1 and noe = 1
-* set lda = n+1 when ifm = 1 and noe = 0
-*
- IF( IFM.EQ.1 ) THEN
- IF( NOE.EQ.1 ) THEN
- LDA = N
- ELSE
-* noe=0
- LDA = N + 1
- END IF
- ELSE
-* ifm=0
- LDA = ( N+1 ) / 2
- END IF
-*
- IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- K = ( N+1 ) / 2
- VALUE = ZERO
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( IFM.EQ.1 ) THEN
-* A is n by k
- DO J = 0, K - 1
- DO I = 0, N - 1
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- ELSE
-* xpose case; A is k by n
- DO J = 0, N - 1
- DO I = 0, K - 1
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- END IF
- ELSE
-* n is even
- IF( IFM.EQ.1 ) THEN
-* A is n+1 by k
- DO J = 0, K - 1
- DO I = 0, N
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- ELSE
-* xpose case; A is k by n+1
- DO J = 0, N
- DO I = 0, K - 1
- TEMP = ABS( A( I+J*LDA ) )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END DO
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- IF( IFM.EQ.1 ) THEN
- K = N / 2
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( ILU.EQ.0 ) THEN
- DO I = 0, K - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K
- S = ZERO
- DO I = 0, K + J - 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(i,j+k)
- S = S + AA
- WORK( I ) = WORK( I ) + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- WORK( J+K ) = S + AA
- IF( I.EQ.K+K )
- $ GO TO 10
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = WORK( J ) + AA
- S = ZERO
- DO L = J + 1, K - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- 10 CONTINUE
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu = 1
- K = K + 1
-* k=(n+1)/2 for n odd and ilu=1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = K - 1, 0, -1
- S = ZERO
- DO I = 0, J - 2
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,i+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + AA
- END DO
- IF( J.GT.0 ) THEN
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + S
-* i=j
- I = I + 1
- END IF
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = AA
- S = ZERO
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- ELSE
-* n is even
- IF( ILU.EQ.0 ) THEN
- DO I = 0, K - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K - 1
- S = ZERO
- DO I = 0, K + J - 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(i,j+k)
- S = S + AA
- WORK( I ) = WORK( I ) + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- WORK( J+K ) = S + AA
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = WORK( J ) + AA
- S = ZERO
- DO L = J + 1, K - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu = 1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = K - 1, 0, -1
- S = ZERO
- DO I = 0, J - 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,i+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* -> A(j+k,j+k)
- S = S + AA
- WORK( I+K ) = WORK( I+K ) + S
-* i=j
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(j,j)
- WORK( J ) = AA
- S = ZERO
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* -> A(l,j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- END IF
- ELSE
-* ifm=0
- K = N / 2
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( ILU.EQ.0 ) THEN
- N1 = K
-* n/2
- K = K + 1
-* k is the row size and lda
- DO I = N1, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, N1 - 1
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,n1+i)
- WORK( I+N1 ) = WORK( I+N1 ) + AA
- S = S + AA
- END DO
- WORK( J ) = S
- END DO
-* j=n1=k-1 is special
- S = ABS( A( 0+J*LDA ) )
-* A(k-1,k-1)
- DO I = 1, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,i+n1)
- WORK( I+N1 ) = WORK( I+N1 ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- DO J = K, N - 1
- S = ZERO
- DO I = 0, J - K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(i,j-k)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=j-k
- AA = ABS( A( I+J*LDA ) )
-* A(j-k,j-k)
- S = S + AA
- WORK( J-K ) = WORK( J-K ) + S
- I = I + 1
- S = ABS( A( I+J*LDA ) )
-* A(j,j)
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,l)
- WORK( L ) = WORK( L ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu=1
- K = K + 1
-* k=(n+1)/2 for n odd and ilu=1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K - 2
-* process
- S = ZERO
- DO I = 0, J - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* i=j so process of A(j,j)
- S = S + AA
- WORK( J ) = S
-* is initialised here
- I = I + 1
-* i=j process A(j+k,j+k)
- AA = ABS( A( I+J*LDA ) )
- S = AA
- DO L = K + J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(l,k+j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( K+J ) = WORK( K+J ) + S
- END DO
-* j=k-1 is special :process col A(k-1,0:k-1)
- S = ZERO
- DO I = 0, K - 2
- AA = ABS( A( I+J*LDA ) )
-* A(k,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=k-1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,k-1)
- S = S + AA
- WORK( I ) = S
-* done with col j=k+1
- DO J = K, N - 1
-* process col j of A = A(j,0:k-1)
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- ELSE
-* n is even
- IF( ILU.EQ.0 ) THEN
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
- DO J = 0, K - 1
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,i+k)
- WORK( I+K ) = WORK( I+K ) + AA
- S = S + AA
- END DO
- WORK( J ) = S
- END DO
-* j=k
- AA = ABS( A( 0+J*LDA ) )
-* A(k,k)
- S = AA
- DO I = 1, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(k,k+i)
- WORK( I+K ) = WORK( I+K ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- DO J = K + 1, N - 1
- S = ZERO
- DO I = 0, J - 2 - K
- AA = ABS( A( I+J*LDA ) )
-* A(i,j-k-1)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=j-1-k
- AA = ABS( A( I+J*LDA ) )
-* A(j-k-1,j-k-1)
- S = S + AA
- WORK( J-K-1 ) = WORK( J-K-1 ) + S
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,j)
- S = AA
- DO L = J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(j,l)
- WORK( L ) = WORK( L ) + AA
- S = S + AA
- END DO
- WORK( J ) = WORK( J ) + S
- END DO
-* j=n
- S = ZERO
- DO I = 0, K - 2
- AA = ABS( A( I+J*LDA ) )
-* A(i,k-1)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=k-1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,k-1)
- S = S + AA
- WORK( I ) = WORK( I ) + S
- VALUE = WORK ( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- ELSE
-* ilu=1
- DO I = K, N - 1
- WORK( I ) = ZERO
- END DO
-* j=0 is special :process col A(k:n-1,k)
- S = ABS( A( 0 ) )
-* A(k,k)
- DO I = 1, K - 1
- AA = ABS( A( I ) )
-* A(k+i,k)
- WORK( I+K ) = WORK( I+K ) + AA
- S = S + AA
- END DO
- WORK( K ) = WORK( K ) + S
- DO J = 1, K - 1
-* process
- S = ZERO
- DO I = 0, J - 2
- AA = ABS( A( I+J*LDA ) )
-* A(j-1,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- AA = ABS( A( I+J*LDA ) )
-* i=j-1 so process of A(j-1,j-1)
- S = S + AA
- WORK( J-1 ) = S
-* is initialised here
- I = I + 1
-* i=j process A(j+k,j+k)
- AA = ABS( A( I+J*LDA ) )
- S = AA
- DO L = K + J + 1, N - 1
- I = I + 1
- AA = ABS( A( I+J*LDA ) )
-* A(l,k+j)
- S = S + AA
- WORK( L ) = WORK( L ) + AA
- END DO
- WORK( K+J ) = WORK( K+J ) + S
- END DO
-* j=k is special :process col A(k,0:k-1)
- S = ZERO
- DO I = 0, K - 2
- AA = ABS( A( I+J*LDA ) )
-* A(k,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
-* i=k-1
- AA = ABS( A( I+J*LDA ) )
-* A(k-1,k-1)
- S = S + AA
- WORK( I ) = S
-* done with col j=k+1
- DO J = K + 1, N
-* process col j-1 of A = A(j-1,0:k-1)
- S = ZERO
- DO I = 0, K - 1
- AA = ABS( A( I+J*LDA ) )
-* A(j-1,i)
- WORK( I ) = WORK( I ) + AA
- S = S + AA
- END DO
- WORK( J-1 ) = WORK( J-1 ) + S
- END DO
- VALUE = WORK( 0 )
- DO I = 1, N-1
- TEMP = WORK( I )
- IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
- $ VALUE = TEMP
- END DO
- END IF
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- K = ( N+1 ) / 2
- SCALE = ZERO
- S = ONE
- IF( NOE.EQ.1 ) THEN
-* n is odd
- IF( IFM.EQ.1 ) THEN
-* A is normal
- IF( ILU.EQ.0 ) THEN
-* A is upper
- DO J = 0, K - 3
- CALL SLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S )
-* L at A(k,0)
- END DO
- DO J = 0, K - 1
- CALL SLASSQ( K+J-1, A( 0+J*LDA ), 1, SCALE, S )
-* trap U at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K-1, A( K ), LDA+1, SCALE, S )
-* tri L at A(k,0)
- CALL SLASSQ( K, A( K-1 ), LDA+1, SCALE, S )
-* tri U at A(k-1,0)
- ELSE
-* ilu=1 & A is lower
- DO J = 0, K - 1
- CALL SLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S )
-* trap L at A(0,0)
- END DO
- DO J = 0, K - 2
- CALL SLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S )
-* U at A(0,1)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri L at A(0,0)
- CALL SLASSQ( K-1, A( 0+LDA ), LDA+1, SCALE, S )
-* tri U at A(0,1)
- END IF
- ELSE
-* A is xpose
- IF( ILU.EQ.0 ) THEN
-* A**T is upper
- DO J = 1, K - 2
- CALL SLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S )
-* U at A(0,k)
- END DO
- DO J = 0, K - 2
- CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k-1 rect. at A(0,0)
- END DO
- DO J = 0, K - 2
- CALL SLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1,
- $ SCALE, S )
-* L at A(0,k-1)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S )
-* tri U at A(0,k)
- CALL SLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S )
-* tri L at A(0,k-1)
- ELSE
-* A**T is lower
- DO J = 1, K - 1
- CALL SLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
-* U at A(0,0)
- END DO
- DO J = K, N - 1
- CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k-1 rect. at A(0,k)
- END DO
- DO J = 0, K - 3
- CALL SLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S )
-* L at A(1,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri U at A(0,0)
- CALL SLASSQ( K-1, A( 1 ), LDA+1, SCALE, S )
-* tri L at A(1,0)
- END IF
- END IF
- ELSE
-* n is even
- IF( IFM.EQ.1 ) THEN
-* A is normal
- IF( ILU.EQ.0 ) THEN
-* A is upper
- DO J = 0, K - 2
- CALL SLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S )
-* L at A(k+1,0)
- END DO
- DO J = 0, K - 1
- CALL SLASSQ( K+J, A( 0+J*LDA ), 1, SCALE, S )
-* trap U at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K, A( K+1 ), LDA+1, SCALE, S )
-* tri L at A(k+1,0)
- CALL SLASSQ( K, A( K ), LDA+1, SCALE, S )
-* tri U at A(k,0)
- ELSE
-* ilu=1 & A is lower
- DO J = 0, K - 1
- CALL SLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S )
-* trap L at A(1,0)
- END DO
- DO J = 1, K - 1
- CALL SLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
-* U at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K, A( 1 ), LDA+1, SCALE, S )
-* tri L at A(1,0)
- CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri U at A(0,0)
- END IF
- ELSE
-* A is xpose
- IF( ILU.EQ.0 ) THEN
-* A**T is upper
- DO J = 1, K - 1
- CALL SLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S )
-* U at A(0,k+1)
- END DO
- DO J = 0, K - 1
- CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k rect. at A(0,0)
- END DO
- DO J = 0, K - 2
- CALL SLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE,
- $ S )
-* L at A(0,k)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S )
-* tri U at A(0,k+1)
- CALL SLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S )
-* tri L at A(0,k)
- ELSE
-* A**T is lower
- DO J = 1, K - 1
- CALL SLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S )
-* U at A(0,1)
- END DO
- DO J = K + 1, N
- CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
-* k by k rect. at A(0,k+1)
- END DO
- DO J = 0, K - 2
- CALL SLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S )
-* L at A(0,0)
- END DO
- S = S + S
-* double s for the off diagonal elements
- CALL SLASSQ( K, A( LDA ), LDA+1, SCALE, S )
-* tri L at A(0,1)
- CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
-* tri U at A(0,0)
- END IF
- END IF
- END IF
- VALUE = SCALE*SQRT( S )
- END IF
-*
- SLANSF = VALUE
- RETURN
-*
-* End of SLANSF
-*
- END
diff --git a/netlib/LAPACK/slansp.f b/netlib/LAPACK/slansp.f
deleted file mode 100644
index 67c7fd7..0000000
--- a/netlib/LAPACK/slansp.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANSP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slansp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slansp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slansp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANSP( NORM, UPLO, N, AP, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, UPLO
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANSP returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric matrix A, supplied in packed form.
-*> \endverbatim
-*>
-*> \return SLANSP
-*> \verbatim
-*>
-*> SLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANSP as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is supplied.
-*> = 'U': Upper triangular part of A is supplied
-*> = 'L': Lower triangular part of A is supplied
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANSP is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANSP( NORM, UPLO, N, AP, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, UPLO
- INTEGER N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K
- REAL ABSA, SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- K = 1
- DO 20 J = 1, N
- DO 10 I = K, K + J - 1
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- K = K + J
- 20 CONTINUE
- ELSE
- K = 1
- DO 40 J = 1, N
- DO 30 I = K, K + N - J
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- K = K + N - J + 1
- 40 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- VALUE = ZERO
- K = 1
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- SUM = ZERO
- DO 50 I = 1, J - 1
- ABSA = ABS( AP( K ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- K = K + 1
- 50 CONTINUE
- WORK( J ) = SUM + ABS( AP( K ) )
- K = K + 1
- 60 CONTINUE
- DO 70 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- ELSE
- DO 80 I = 1, N
- WORK( I ) = ZERO
- 80 CONTINUE
- DO 100 J = 1, N
- SUM = WORK( J ) + ABS( AP( K ) )
- K = K + 1
- DO 90 I = J + 1, N
- ABSA = ABS( AP( K ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- K = K + 1
- 90 CONTINUE
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 100 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- K = 2
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 2, N
- CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM )
- K = K + J
- 110 CONTINUE
- ELSE
- DO 120 J = 1, N - 1
- CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM )
- K = K + N - J + 1
- 120 CONTINUE
- END IF
- SUM = 2*SUM
- K = 1
- DO 130 I = 1, N
- IF( AP( K ).NE.ZERO ) THEN
- ABSA = ABS( AP( K ) )
- IF( SCALE.LT.ABSA ) THEN
- SUM = ONE + SUM*( SCALE / ABSA )**2
- SCALE = ABSA
- ELSE
- SUM = SUM + ( ABSA / SCALE )**2
- END IF
- END IF
- IF( LSAME( UPLO, 'U' ) ) THEN
- K = K + I + 1
- ELSE
- K = K + N - I + 1
- END IF
- 130 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANSP = VALUE
- RETURN
-*
-* End of SLANSP
-*
- END
diff --git a/netlib/LAPACK/slanst.f b/netlib/LAPACK/slanst.f
deleted file mode 100644
index 56db996..0000000
--- a/netlib/LAPACK/slanst.f
+++ /dev/null
@@ -1,186 +0,0 @@
-*> \brief \b SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slanst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slanst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slanst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANST( NORM, N, D, E )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANST returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \return SLANST
-*> \verbatim
-*>
-*> SLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANST as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANST is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) sub-diagonal or super-diagonal elements of A.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANST( NORM, N, D, E )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL ANORM, SCALE, SUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- ANORM = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- ANORM = ABS( D( N ) )
- DO 10 I = 1, N - 1
- SUM = ABS( D( I ) )
- IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
- SUM = ABS( E( I ) )
- IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
- 10 CONTINUE
- ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR.
- $ LSAME( NORM, 'I' ) ) THEN
-*
-* Find norm1(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = ABS( D( 1 ) )+ABS( E( 1 ) )
- SUM = ABS( E( N-1 ) )+ABS( D( N ) )
- IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
- DO 20 I = 2, N - 1
- SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) )
- IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
- 20 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- IF( N.GT.1 ) THEN
- CALL SLASSQ( N-1, E, 1, SCALE, SUM )
- SUM = 2*SUM
- END IF
- CALL SLASSQ( N, D, 1, SCALE, SUM )
- ANORM = SCALE*SQRT( SUM )
- END IF
-*
- SLANST = ANORM
- RETURN
-*
-* End of SLANST
-*
- END
diff --git a/netlib/LAPACK/slansy.f b/netlib/LAPACK/slansy.f
deleted file mode 100644
index 1640358..0000000
--- a/netlib/LAPACK/slansy.f
+++ /dev/null
@@ -1,241 +0,0 @@
-*> \brief \b SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANSY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slansy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slansy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slansy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANSY( NORM, UPLO, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM, UPLO
-* INTEGER LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANSY returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> real symmetric matrix A.
-*> \endverbatim
-*>
-*> \return SLANSY
-*> \verbatim
-*>
-*> SLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANSY as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is to be referenced.
-*> = 'U': Upper triangular part of A is referenced
-*> = 'L': Lower triangular part of A is referenced
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANSY is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading n by n
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading n by n lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(N,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*> WORK is not referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANSY( NORM, UPLO, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER NORM, UPLO
- INTEGER LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL ABSA, SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, J
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = J, N
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
- $ ( NORM.EQ.'1' ) ) THEN
-*
-* Find normI(A) ( = norm1(A), since A is symmetric).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- SUM = ZERO
- DO 50 I = 1, J - 1
- ABSA = ABS( A( I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 50 CONTINUE
- WORK( J ) = SUM + ABS( A( J, J ) )
- 60 CONTINUE
- DO 70 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- ELSE
- DO 80 I = 1, N
- WORK( I ) = ZERO
- 80 CONTINUE
- DO 100 J = 1, N
- SUM = WORK( J ) + ABS( A( J, J ) )
- DO 90 I = J + 1, N
- ABSA = ABS( A( I, J ) )
- SUM = SUM + ABSA
- WORK( I ) = WORK( I ) + ABSA
- 90 CONTINUE
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 100 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 2, N
- CALL SLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
- 110 CONTINUE
- ELSE
- DO 120 J = 1, N - 1
- CALL SLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
- 120 CONTINUE
- END IF
- SUM = 2*SUM
- CALL SLASSQ( N, A, LDA+1, SCALE, SUM )
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANSY = VALUE
- RETURN
-*
-* End of SLANSY
-*
- END
diff --git a/netlib/LAPACK/slantb.f b/netlib/LAPACK/slantb.f
deleted file mode 100644
index 9d87539..0000000
--- a/netlib/LAPACK/slantb.f
+++ /dev/null
@@ -1,361 +0,0 @@
-*> \brief \b SLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANTB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slantb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slantb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slantb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB,
-* LDAB, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANTB returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of an
-*> n by n triangular band matrix A, with ( k + 1 ) diagonals.
-*> \endverbatim
-*>
-*> \return SLANTB
-*> \verbatim
-*>
-*> SLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANTB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANTB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals of the matrix A if UPLO = 'L'.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first k+1 rows of AB. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
-*> Note that when DIAG = 'U', the elements of the array AB
-*> corresponding to the diagonal elements of the matrix A are
-*> not referenced, but are assumed to be one.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= K+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB,
- $ LDAB, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J, L
- REAL SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = MAX( K+2-J, 1 ), K
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = 2, MIN( N+1-J, K+1 )
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = MAX( K+2-J, 1 ), K + 1
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = 1, MIN( N+1-J, K+1 )
- SUM = ABS( AB( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 90 I = MAX( K+2-J, 1 ), K
- SUM = SUM + ABS( AB( I, J ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = MAX( K+2-J, 1 ), K + 1
- SUM = SUM + ABS( AB( I, J ) )
- 100 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = 2, MIN( N+1-J, K+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = 1, MIN( N+1-J, K+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 130 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, N
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- L = K + 1 - J
- DO 160 I = MAX( 1, J-K ), J - 1
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO 180 I = 1, N
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- L = K + 1 - J
- DO 190 I = MAX( 1, J-K ), J
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 230 J = 1, N
- L = 1 - J
- DO 220 I = J + 1, MIN( N, J+K )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 220 CONTINUE
- 230 CONTINUE
- ELSE
- DO 240 I = 1, N
- WORK( I ) = ZERO
- 240 CONTINUE
- DO 260 J = 1, N
- L = 1 - J
- DO 250 I = J, MIN( N, J+K )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 250 CONTINUE
- 260 CONTINUE
- END IF
- END IF
- DO 270 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 270 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- IF( K.GT.0 ) THEN
- DO 280 J = 2, N
- CALL SLASSQ( MIN( J-1, K ),
- $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE,
- $ SUM )
- 280 CONTINUE
- END IF
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 290 J = 1, N
- CALL SLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
- $ 1, SCALE, SUM )
- 290 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- IF( K.GT.0 ) THEN
- DO 300 J = 1, N - 1
- CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
- $ SUM )
- 300 CONTINUE
- END IF
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 310 J = 1, N
- CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
- $ SUM )
- 310 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANTB = VALUE
- RETURN
-*
-* End of SLANTB
-*
- END
diff --git a/netlib/LAPACK/slantp.f b/netlib/LAPACK/slantp.f
deleted file mode 100644
index 129d7a6..0000000
--- a/netlib/LAPACK/slantp.f
+++ /dev/null
@@ -1,355 +0,0 @@
-*> \brief \b SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANTP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slantp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slantp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slantp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANTP returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> triangular matrix A, supplied in packed form.
-*> \endverbatim
-*>
-*> \return SLANTP
-*> \verbatim
-*>
-*> SLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANTP as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, SLANTP is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> Note that when DIAG = 'U', the elements of the array AP
-*> corresponding to the diagonal elements of the matrix A are
-*> not referenced, but are assumed to be one.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J, K
- REAL SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- K = 1
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = K, K + J - 2
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- K = K + J
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = K + 1, K + N - J
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- K = K + N - J + 1
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = K, K + J - 1
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 50 CONTINUE
- K = K + J
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = K, K + N - J
- SUM = ABS( AP( I ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- K = K + N - J + 1
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- K = 1
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 90 I = K, K + J - 2
- SUM = SUM + ABS( AP( I ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = K, K + J - 1
- SUM = SUM + ABS( AP( I ) )
- 100 CONTINUE
- END IF
- K = K + J
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = K + 1, K + N - J
- SUM = SUM + ABS( AP( I ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = K, K + N - J
- SUM = SUM + ABS( AP( I ) )
- 130 CONTINUE
- END IF
- K = K + N - J + 1
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- K = 1
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, N
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- DO 160 I = 1, J - 1
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 160 CONTINUE
- K = K + 1
- 170 CONTINUE
- ELSE
- DO 180 I = 1, N
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- DO 190 I = 1, J
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 230 J = 1, N
- K = K + 1
- DO 220 I = J + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 220 CONTINUE
- 230 CONTINUE
- ELSE
- DO 240 I = 1, N
- WORK( I ) = ZERO
- 240 CONTINUE
- DO 260 J = 1, N
- DO 250 I = J, N
- WORK( I ) = WORK( I ) + ABS( AP( K ) )
- K = K + 1
- 250 CONTINUE
- 260 CONTINUE
- END IF
- END IF
- VALUE = ZERO
- DO 270 I = 1, N
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 270 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- K = 2
- DO 280 J = 2, N
- CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM )
- K = K + J
- 280 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- K = 1
- DO 290 J = 1, N
- CALL SLASSQ( J, AP( K ), 1, SCALE, SUM )
- K = K + J
- 290 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- K = 2
- DO 300 J = 1, N - 1
- CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM )
- K = K + N - J + 1
- 300 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- K = 1
- DO 310 J = 1, N
- CALL SLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )
- K = K + N - J + 1
- 310 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANTP = VALUE
- RETURN
-*
-* End of SLANTP
-*
- END
diff --git a/netlib/LAPACK/slantr.f b/netlib/LAPACK/slantr.f
deleted file mode 100644
index 50c896d..0000000
--- a/netlib/LAPACK/slantr.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b SLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slantr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slantr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slantr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANTR returns the value of the one norm, or the Frobenius norm, or
-*> the infinity norm, or the element of largest absolute value of a
-*> trapezoidal or triangular matrix A.
-*> \endverbatim
-*>
-*> \return SLANTR
-*> \verbatim
-*>
-*> SLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in SLANTR as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower trapezoidal.
-*> = 'U': Upper trapezoidal
-*> = 'L': Lower trapezoidal
-*> Note that A is triangular instead of trapezoidal if M = N.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A has unit diagonal.
-*> = 'N': Non-unit diagonal
-*> = 'U': Unit diagonal
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0, and if
-*> UPLO = 'U', M <= N. When M = 0, SLANTR is set to zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0, and if
-*> UPLO = 'L', N <= M. When N = 0, SLANTR is set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The trapezoidal matrix A (A is triangular if M = N).
-*> If UPLO = 'U', the leading m by n upper trapezoidal part of
-*> the array A contains the upper trapezoidal matrix, and the
-*> strictly lower triangular part of A is not referenced.
-*> If UPLO = 'L', the leading m by n lower trapezoidal part of
-*> the array A contains the lower trapezoidal matrix, and the
-*> strictly upper triangular part of A is not referenced. Note
-*> that when DIAG = 'U', the diagonal elements of A are not
-*> referenced and are assumed to be one.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)),
-*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J
- REAL SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- EXTERNAL LSAME, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( MIN( M, N ).EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, MIN( M, J-1 )
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = J + 1, M
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = 1, MIN( M, J )
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = J, M
- SUM = ABS( A( I, J ) )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
- SUM = ONE
- DO 90 I = 1, J - 1
- SUM = SUM + ABS( A( I, J ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = 1, MIN( M, J )
- SUM = SUM + ABS( A( I, J ) )
- 100 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = J + 1, M
- SUM = SUM + ABS( A( I, J ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = J, M
- SUM = SUM + ABS( A( I, J ) )
- 130 CONTINUE
- END IF
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, M
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- DO 160 I = 1, MIN( M, J-1 )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO 180 I = 1, M
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- DO 190 I = 1, MIN( M, J )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 220 I = N + 1, M
- WORK( I ) = ZERO
- 220 CONTINUE
- DO 240 J = 1, N
- DO 230 I = J + 1, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 230 CONTINUE
- 240 CONTINUE
- ELSE
- DO 250 I = 1, M
- WORK( I ) = ZERO
- 250 CONTINUE
- DO 270 J = 1, N
- DO 260 I = J, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 260 CONTINUE
- 270 CONTINUE
- END IF
- END IF
- VALUE = ZERO
- DO 280 I = 1, M
- SUM = WORK( I )
- IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
- 280 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = MIN( M, N )
- DO 290 J = 2, N
- CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
- 290 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 300 J = 1, N
- CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
- 300 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = MIN( M, N )
- DO 310 J = 1, N
- CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
- $ SUM )
- 310 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 320 J = 1, N
- CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
- 320 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- SLANTR = VALUE
- RETURN
-*
-* End of SLANTR
-*
- END
diff --git a/netlib/LAPACK/slanv2.f b/netlib/LAPACK/slanv2.f
deleted file mode 100644
index e535e20..0000000
--- a/netlib/LAPACK/slanv2.f
+++ /dev/null
@@ -1,289 +0,0 @@
-*> \brief \b SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLANV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slanv2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slanv2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slanv2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-* .. Scalar Arguments ..
-* REAL A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
-*> matrix in standard form:
-*>
-*> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
-*> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
-*>
-*> where either
-*> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
-*> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
-*> conjugate eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL
-*> On entry, the elements of the input matrix.
-*> On exit, they are overwritten by the elements of the
-*> standardised Schur form.
-*> \endverbatim
-*>
-*> \param[out] RT1R
-*> \verbatim
-*> RT1R is REAL
-*> \endverbatim
-*>
-*> \param[out] RT1I
-*> \verbatim
-*> RT1I is REAL
-*> \endverbatim
-*>
-*> \param[out] RT2R
-*> \verbatim
-*> RT2R is REAL
-*> \endverbatim
-*>
-*> \param[out] RT2I
-*> \verbatim
-*> RT2I is REAL
-*> The real and imaginary parts of the eigenvalues. If the
-*> eigenvalues are a complex conjugate pair, RT1I > 0.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is REAL
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is REAL
-*> Parameters of the rotation matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by V. Sima, Research Institute for Informatics, Bucharest,
-*> Romania, to reduce the risk of cancellation errors,
-*> when computing real eigenvalues, and to ensure, if possible, that
-*> abs(RT1R) >= abs(RT2R).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 )
- REAL MULTPL
- PARAMETER ( MULTPL = 4.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
- $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLAPY2
- EXTERNAL SLAMCH, SLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
- EPS = SLAMCH( 'P' )
- IF( C.EQ.ZERO ) THEN
- CS = ONE
- SN = ZERO
- GO TO 10
-*
- ELSE IF( B.EQ.ZERO ) THEN
-*
-* Swap rows and columns
-*
- CS = ZERO
- SN = ONE
- TEMP = D
- D = A
- A = TEMP
- B = -C
- C = ZERO
- GO TO 10
- ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE.
- $ SIGN( ONE, C ) ) THEN
- CS = ONE
- SN = ZERO
- GO TO 10
- ELSE
-*
- TEMP = A - D
- P = HALF*TEMP
- BCMAX = MAX( ABS( B ), ABS( C ) )
- BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
- SCALE = MAX( ABS( P ), BCMAX )
- Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
-*
-* If Z is of the order of the machine accuracy, postpone the
-* decision on the nature of eigenvalues
-*
- IF( Z.GE.MULTPL*EPS ) THEN
-*
-* Real eigenvalues. Compute A and D.
-*
- Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
- A = D + Z
- D = D - ( BCMAX / Z )*BCMIS
-*
-* Compute B and the rotation matrix
-*
- TAU = SLAPY2( C, Z )
- CS = Z / TAU
- SN = C / TAU
- B = B - C
- C = ZERO
- ELSE
-*
-* Complex eigenvalues, or real (almost) equal eigenvalues.
-* Make diagonal elements equal.
-*
- SIGMA = B + C
- TAU = SLAPY2( SIGMA, TEMP )
- CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
- SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
-*
-* Compute [ AA BB ] = [ A B ] [ CS -SN ]
-* [ CC DD ] [ C D ] [ SN CS ]
-*
- AA = A*CS + B*SN
- BB = -A*SN + B*CS
- CC = C*CS + D*SN
- DD = -C*SN + D*CS
-*
-* Compute [ A B ] = [ CS SN ] [ AA BB ]
-* [ C D ] [-SN CS ] [ CC DD ]
-*
- A = AA*CS + CC*SN
- B = BB*CS + DD*SN
- C = -AA*SN + CC*CS
- D = -BB*SN + DD*CS
-*
- TEMP = HALF*( A+D )
- A = TEMP
- D = TEMP
-*
- IF( C.NE.ZERO ) THEN
- IF( B.NE.ZERO ) THEN
- IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
-*
-* Real eigenvalues: reduce to upper triangular form
-*
- SAB = SQRT( ABS( B ) )
- SAC = SQRT( ABS( C ) )
- P = SIGN( SAB*SAC, C )
- TAU = ONE / SQRT( ABS( B+C ) )
- A = TEMP + P
- D = TEMP - P
- B = B - C
- C = ZERO
- CS1 = SAB*TAU
- SN1 = SAC*TAU
- TEMP = CS*CS1 - SN*SN1
- SN = CS*SN1 + SN*CS1
- CS = TEMP
- END IF
- ELSE
- B = -C
- C = ZERO
- TEMP = CS
- CS = -SN
- SN = TEMP
- END IF
- END IF
- END IF
-*
- END IF
-*
- 10 CONTINUE
-*
-* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
-*
- RT1R = A
- RT2R = D
- IF( C.EQ.ZERO ) THEN
- RT1I = ZERO
- RT2I = ZERO
- ELSE
- RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) )
- RT2I = -RT1I
- END IF
- RETURN
-*
-* End of SLANV2
-*
- END
diff --git a/netlib/LAPACK/slapll.f b/netlib/LAPACK/slapll.f
deleted file mode 100644
index 05a4607..0000000
--- a/netlib/LAPACK/slapll.f
+++ /dev/null
@@ -1,165 +0,0 @@
-*> \brief \b SLAPLL measures the linear dependence of two vectors.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAPLL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapll.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapll.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapll.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAPLL( N, X, INCX, Y, INCY, SSMIN )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, INCY, N
-* REAL SSMIN
-* ..
-* .. Array Arguments ..
-* REAL X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given two column vectors X and Y, let
-*>
-*> A = ( X Y ).
-*>
-*> The subroutine first computes the QR factorization of A = Q*R,
-*> and then computes the SVD of the 2-by-2 upper triangular matrix R.
-*> The smaller singular value of R is returned in SSMIN, which is used
-*> as the measurement of the linear dependency of the vectors X and Y.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of the vectors X and Y.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array,
-*> dimension (1+(N-1)*INCX)
-*> On entry, X contains the N-vector X.
-*> On exit, X is overwritten.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array,
-*> dimension (1+(N-1)*INCY)
-*> On entry, Y contains the N-vector Y.
-*> On exit, Y is overwritten.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> The increment between successive elements of Y. INCY > 0.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is REAL
-*> The smallest singular value of the N-by-2 matrix A = ( X Y ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAPLL( N, X, INCX, Y, INCY, SSMIN )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, INCY, N
- REAL SSMIN
-* ..
-* .. Array Arguments ..
- REAL X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL A11, A12, A22, C, SSMAX, TAU
-* ..
-* .. External Functions ..
- REAL SDOT
- EXTERNAL SDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SLARFG, SLAS2
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- SSMIN = ZERO
- RETURN
- END IF
-*
-* Compute the QR factorization of the N-by-2 matrix ( X Y )
-*
- CALL SLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
- A11 = X( 1 )
- X( 1 ) = ONE
-*
- C = -TAU*SDOT( N, X, INCX, Y, INCY )
- CALL SAXPY( N, C, X, INCX, Y, INCY )
-*
- CALL SLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
-*
- A12 = Y( 1 )
- A22 = Y( 1+INCY )
-*
-* Compute the SVD of 2-by-2 Upper triangular matrix.
-*
- CALL SLAS2( A11, A12, A22, SSMIN, SSMAX )
-*
- RETURN
-*
-* End of SLAPLL
-*
- END
diff --git a/netlib/LAPACK/slapmr.f b/netlib/LAPACK/slapmr.f
deleted file mode 100644
index e496f63..0000000
--- a/netlib/LAPACK/slapmr.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b SLAPMR rearranges rows of a matrix as specified by a permutation vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAPMR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapmr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapmr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapmr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAPMR( FORWRD, M, N, X, LDX, K )
-*
-* .. Scalar Arguments ..
-* LOGICAL FORWRD
-* INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER K( * )
-* REAL X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAPMR rearranges the rows of the M by N matrix X as specified
-*> by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
-*> If FORWRD = .TRUE., forward permutation:
-*>
-*> X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
-*>
-*> If FORWRD = .FALSE., backward permutation:
-*>
-*> X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FORWRD
-*> \verbatim
-*> FORWRD is LOGICAL
-*> = .TRUE., forward permutation
-*> = .FALSE., backward permutation
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,N)
-*> On entry, the M by N matrix X.
-*> On exit, X contains the permuted matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X, LDX >= MAX(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] K
-*> \verbatim
-*> K is INTEGER array, dimension (M)
-*> On entry, K contains the permutation vector. K is used as
-*> internal workspace, but reset to its original value on
-*> output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAPMR( FORWRD, M, N, X, LDX, K )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL FORWRD
- INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
- INTEGER K( * )
- REAL X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IN, J, JJ
- REAL TEMP
-* ..
-* .. Executable Statements ..
-*
- IF( M.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, M
- K( I ) = -K( I )
- 10 CONTINUE
-*
- IF( FORWRD ) THEN
-*
-* Forward permutation
-*
- DO 50 I = 1, M
-*
- IF( K( I ).GT.0 )
- $ GO TO 40
-*
- J = I
- K( J ) = -K( J )
- IN = K( J )
-*
- 20 CONTINUE
- IF( K( IN ).GT.0 )
- $ GO TO 40
-*
- DO 30 JJ = 1, N
- TEMP = X( J, JJ )
- X( J, JJ ) = X( IN, JJ )
- X( IN, JJ ) = TEMP
- 30 CONTINUE
-*
- K( IN ) = -K( IN )
- J = IN
- IN = K( IN )
- GO TO 20
-*
- 40 CONTINUE
-*
- 50 CONTINUE
-*
- ELSE
-*
-* Backward permutation
-*
- DO 90 I = 1, M
-*
- IF( K( I ).GT.0 )
- $ GO TO 80
-*
- K( I ) = -K( I )
- J = K( I )
- 60 CONTINUE
- IF( J.EQ.I )
- $ GO TO 80
-*
- DO 70 JJ = 1, N
- TEMP = X( I, JJ )
- X( I, JJ ) = X( J, JJ )
- X( J, JJ ) = TEMP
- 70 CONTINUE
-*
- K( J ) = -K( J )
- J = K( J )
- GO TO 60
-*
- 80 CONTINUE
-*
- 90 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of ZLAPMT
-*
- END
-
diff --git a/netlib/LAPACK/slapmt.f b/netlib/LAPACK/slapmt.f
deleted file mode 100644
index c55c1bc..0000000
--- a/netlib/LAPACK/slapmt.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b SLAPMT performs a forward or backward permutation of the columns of a matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAPMT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapmt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapmt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapmt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAPMT( FORWRD, M, N, X, LDX, K )
-*
-* .. Scalar Arguments ..
-* LOGICAL FORWRD
-* INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER K( * )
-* REAL X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAPMT rearranges the columns of the M by N matrix X as specified
-*> by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
-*> If FORWRD = .TRUE., forward permutation:
-*>
-*> X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
-*>
-*> If FORWRD = .FALSE., backward permutation:
-*>
-*> X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FORWRD
-*> \verbatim
-*> FORWRD is LOGICAL
-*> = .TRUE., forward permutation
-*> = .FALSE., backward permutation
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,N)
-*> On entry, the M by N matrix X.
-*> On exit, X contains the permuted matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X, LDX >= MAX(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] K
-*> \verbatim
-*> K is INTEGER array, dimension (N)
-*> On entry, K contains the permutation vector. K is used as
-*> internal workspace, but reset to its original value on
-*> output.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAPMT( FORWRD, M, N, X, LDX, K )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL FORWRD
- INTEGER LDX, M, N
-* ..
-* .. Array Arguments ..
- INTEGER K( * )
- REAL X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, II, J, IN
- REAL TEMP
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, N
- K( I ) = -K( I )
- 10 CONTINUE
-*
- IF( FORWRD ) THEN
-*
-* Forward permutation
-*
- DO 60 I = 1, N
-*
- IF( K( I ).GT.0 )
- $ GO TO 40
-*
- J = I
- K( J ) = -K( J )
- IN = K( J )
-*
- 20 CONTINUE
- IF( K( IN ).GT.0 )
- $ GO TO 40
-*
- DO 30 II = 1, M
- TEMP = X( II, J )
- X( II, J ) = X( II, IN )
- X( II, IN ) = TEMP
- 30 CONTINUE
-*
- K( IN ) = -K( IN )
- J = IN
- IN = K( IN )
- GO TO 20
-*
- 40 CONTINUE
-*
- 60 CONTINUE
-*
- ELSE
-*
-* Backward permutation
-*
- DO 110 I = 1, N
-*
- IF( K( I ).GT.0 )
- $ GO TO 100
-*
- K( I ) = -K( I )
- J = K( I )
- 80 CONTINUE
- IF( J.EQ.I )
- $ GO TO 100
-*
- DO 90 II = 1, M
- TEMP = X( II, I )
- X( II, I ) = X( II, J )
- X( II, J ) = TEMP
- 90 CONTINUE
-*
- K( J ) = -K( J )
- J = K( J )
- GO TO 80
-*
- 100 CONTINUE
-
- 110 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of SLAPMT
-*
- END
diff --git a/netlib/LAPACK/slapy2.f b/netlib/LAPACK/slapy2.f
deleted file mode 100644
index 85f502b..0000000
--- a/netlib/LAPACK/slapy2.f
+++ /dev/null
@@ -1,104 +0,0 @@
-*> \brief \b SLAPY2 returns sqrt(x2+y2).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAPY2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLAPY2( X, Y )
-*
-* .. Scalar Arguments ..
-* REAL X, Y
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
-*> overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is REAL
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is REAL
-*> X and Y specify the values x and y.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLAPY2( X, Y )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL X, Y
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- REAL W, XABS, YABS, Z
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- XABS = ABS( X )
- YABS = ABS( Y )
- W = MAX( XABS, YABS )
- Z = MIN( XABS, YABS )
- IF( Z.EQ.ZERO ) THEN
- SLAPY2 = W
- ELSE
- SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
- END IF
- RETURN
-*
-* End of SLAPY2
-*
- END
diff --git a/netlib/LAPACK/slapy3.f b/netlib/LAPACK/slapy3.f
deleted file mode 100644
index 34bf5e1..0000000
--- a/netlib/LAPACK/slapy3.f
+++ /dev/null
@@ -1,111 +0,0 @@
-*> \brief \b SLAPY3 returns sqrt(x2+y2+z2).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAPY3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLAPY3( X, Y, Z )
-*
-* .. Scalar Arguments ..
-* REAL X, Y, Z
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
-*> unnecessary overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is REAL
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is REAL
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL
-*> X, Y and Z specify the values x, y and z.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- REAL FUNCTION SLAPY3( X, Y, Z )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL X, Y, Z
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- REAL W, XABS, YABS, ZABS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- XABS = ABS( X )
- YABS = ABS( Y )
- ZABS = ABS( Z )
- W = MAX( XABS, YABS, ZABS )
- IF( W.EQ.ZERO ) THEN
-* W can be zero for max(0,nan,0)
-* adding all three entries together will make sure
-* NaN will not disappear.
- SLAPY3 = XABS + YABS + ZABS
- ELSE
- SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
- $ ( ZABS / W )**2 )
- END IF
- RETURN
-*
-* End of SLAPY3
-*
- END
diff --git a/netlib/LAPACK/slaqgb.f b/netlib/LAPACK/slaqgb.f
deleted file mode 100644
index 5346166..0000000
--- a/netlib/LAPACK/slaqgb.f
+++ /dev/null
@@ -1,256 +0,0 @@
-*> \brief \b SLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQGB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqgb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqgb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqgb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED
-* INTEGER KL, KU, LDAB, M, N
-* REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQGB equilibrates a general M by N band matrix A with KL
-*> subdiagonals and KU superdiagonals using the row and scaling factors
-*> in the vectors R and C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, the equilibrated matrix, in the same storage format
-*> as A. See EQUED for the form of the equilibrated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDA >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is REAL array, dimension (M)
-*> The row scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The column scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] ROWCND
-*> \verbatim
-*> ROWCND is REAL
-*> Ratio of the smallest R(i) to the largest R(i).
-*> \endverbatim
-*>
-*> \param[in] COLCND
-*> \verbatim
-*> COLCND is REAL
-*> Ratio of the smallest C(i) to the largest C(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if row or column scaling
-*> should be done based on the ratio of the row or column scaling
-*> factors. If ROWCND < THRESH, row scaling is done, and if
-*> COLCND < THRESH, column scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if row scaling
-*> should be done based on the absolute size of the largest matrix
-*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGBauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED
- INTEGER KL, KU, LDAB, M, N
- REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, THRESH
- PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
- $ THEN
-*
-* No row scaling
-*
- IF( COLCND.GE.THRESH ) THEN
-*
-* No column scaling
-*
- EQUED = 'N'
- ELSE
-*
-* Column scaling
-*
- DO 20 J = 1, N
- CJ = C( J )
- DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
- 10 CONTINUE
- 20 CONTINUE
- EQUED = 'C'
- END IF
- ELSE IF( COLCND.GE.THRESH ) THEN
-*
-* Row scaling, no column scaling
-*
- DO 40 J = 1, N
- DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
- 30 CONTINUE
- 40 CONTINUE
- EQUED = 'R'
- ELSE
-*
-* Row and column scaling
-*
- DO 60 J = 1, N
- CJ = C( J )
- DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
- 50 CONTINUE
- 60 CONTINUE
- EQUED = 'B'
- END IF
-*
- RETURN
-*
-* End of SLAQGB
-*
- END
diff --git a/netlib/LAPACK/slaqge.f b/netlib/LAPACK/slaqge.f
deleted file mode 100644
index d3fd5c6..0000000
--- a/netlib/LAPACK/slaqge.f
+++ /dev/null
@@ -1,236 +0,0 @@
-*> \brief \b SLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQGE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqge.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqge.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqge.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED
-* INTEGER LDA, M, N
-* REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQGE equilibrates a general M by N matrix A using the row and
-*> column scaling factors in the vectors R and C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M by N matrix A.
-*> On exit, the equilibrated matrix. See EQUED for the form of
-*> the equilibrated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is REAL array, dimension (M)
-*> The row scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (N)
-*> The column scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] ROWCND
-*> \verbatim
-*> ROWCND is REAL
-*> Ratio of the smallest R(i) to the largest R(i).
-*> \endverbatim
-*>
-*> \param[in] COLCND
-*> \verbatim
-*> COLCND is REAL
-*> Ratio of the smallest C(i) to the largest C(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if row or column scaling
-*> should be done based on the ratio of the row or column scaling
-*> factors. If ROWCND < THRESH, row scaling is done, and if
-*> COLCND < THRESH, column scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if row scaling
-*> should be done based on the absolute size of the largest matrix
-*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED
- INTEGER LDA, M, N
- REAL AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, THRESH
- PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
- $ THEN
-*
-* No row scaling
-*
- IF( COLCND.GE.THRESH ) THEN
-*
-* No column scaling
-*
- EQUED = 'N'
- ELSE
-*
-* Column scaling
-*
- DO 20 J = 1, N
- CJ = C( J )
- DO 10 I = 1, M
- A( I, J ) = CJ*A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- EQUED = 'C'
- END IF
- ELSE IF( COLCND.GE.THRESH ) THEN
-*
-* Row scaling, no column scaling
-*
- DO 40 J = 1, N
- DO 30 I = 1, M
- A( I, J ) = R( I )*A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- EQUED = 'R'
- ELSE
-*
-* Row and column scaling
-*
- DO 60 J = 1, N
- CJ = C( J )
- DO 50 I = 1, M
- A( I, J ) = CJ*R( I )*A( I, J )
- 50 CONTINUE
- 60 CONTINUE
- EQUED = 'B'
- END IF
-*
- RETURN
-*
-* End of SLAQGE
-*
- END
diff --git a/netlib/LAPACK/slaqp2.f b/netlib/LAPACK/slaqp2.f
deleted file mode 100644
index 2aa54b2..0000000
--- a/netlib/LAPACK/slaqp2.f
+++ /dev/null
@@ -1,262 +0,0 @@
-*> \brief \b SLAQP2 computes a QR factorization with column pivoting of the matrix block.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQP2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqp2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqp2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqp2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
-* WORK )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, M, N, OFFSET
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* REAL A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQP2 computes a QR factorization with column pivoting of
-*> the block A(OFFSET+1:M,1:N).
-*> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> The number of rows of the matrix A that must be pivoted
-*> but no factorized. OFFSET >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
-*> the triangular factor obtained; the elements in block
-*> A(OFFSET+1:M,1:N) below the diagonal, together with the
-*> array TAU, represent the orthogonal matrix Q as a product of
-*> elementary reflectors. Block A(1:OFFSET,1:N) has been
-*> accordingly pivoted, but no factorized.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*> to the front of A*P (a leading column); if JPVT(i) = 0,
-*> the i-th column of A is a free column.
-*> On exit, if JPVT(i) = k, then the i-th column of A*P
-*> was the k-th column of A.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in,out] VN1
-*> \verbatim
-*> VN1 is REAL array, dimension (N)
-*> The vector with the partial column norms.
-*> \endverbatim
-*>
-*> \param[in,out] VN2
-*> \verbatim
-*> VN2 is REAL array, dimension (N)
-*> The vector with the exact column norms.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*> X. Sun, Computer Science Dept., Duke University, USA
-*> \n
-*> Partial column norm updating strategy modified on April 2011
-*> Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*> University of Zagreb, Croatia.
-*
-*> \par References:
-* ================
-*>
-*> LAPACK Working Note 176
-*
-*> \htmlonly
-*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a>
-*> \endhtmlonly
-*
-* =====================================================================
- SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDA, M, N, OFFSET
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- REAL A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ITEMP, J, MN, OFFPI, PVT
- REAL AII, TEMP, TEMP2, TOL3Z
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SLARFG, SSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH, SNRM2
- EXTERNAL ISAMAX, SLAMCH, SNRM2
-* ..
-* .. Executable Statements ..
-*
- MN = MIN( M-OFFSET, N )
- TOL3Z = SQRT(SLAMCH('Epsilon'))
-*
-* Compute factorization.
-*
- DO 20 I = 1, MN
-*
- OFFPI = OFFSET + I
-*
-* Determine ith pivot column and swap if necessary.
-*
- PVT = ( I-1 ) + ISAMAX( N-I+1, VN1( I ), 1 )
-*
- IF( PVT.NE.I ) THEN
- CALL SSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
- ITEMP = JPVT( PVT )
- JPVT( PVT ) = JPVT( I )
- JPVT( I ) = ITEMP
- VN1( PVT ) = VN1( I )
- VN2( PVT ) = VN2( I )
- END IF
-*
-* Generate elementary reflector H(i).
-*
- IF( OFFPI.LT.M ) THEN
- CALL SLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1,
- $ TAU( I ) )
- ELSE
- CALL SLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) )
- END IF
-*
- IF( I.LT.N ) THEN
-*
-* Apply H(i)**T to A(offset+i:m,i+1:n) from the left.
-*
- AII = A( OFFPI, I )
- A( OFFPI, I ) = ONE
- CALL SLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
- $ TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) )
- A( OFFPI, I ) = AII
- END IF
-*
-* Update partial column norms.
-*
- DO 10 J = I + 1, N
- IF( VN1( J ).NE.ZERO ) THEN
-*
-* NOTE: The following 4 lines follow from the analysis in
-* Lapack Working Note 176.
-*
- TEMP = ONE - ( ABS( A( OFFPI, J ) ) / VN1( J ) )**2
- TEMP = MAX( TEMP, ZERO )
- TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
- IF( TEMP2 .LE. TOL3Z ) THEN
- IF( OFFPI.LT.M ) THEN
- VN1( J ) = SNRM2( M-OFFPI, A( OFFPI+1, J ), 1 )
- VN2( J ) = VN1( J )
- ELSE
- VN1( J ) = ZERO
- VN2( J ) = ZERO
- END IF
- ELSE
- VN1( J ) = VN1( J )*SQRT( TEMP )
- END IF
- END IF
- 10 CONTINUE
-*
- 20 CONTINUE
-*
- RETURN
-*
-* End of SLAQP2
-*
- END
diff --git a/netlib/LAPACK/slaqps.f b/netlib/LAPACK/slaqps.f
deleted file mode 100644
index 7983147..0000000
--- a/netlib/LAPACK/slaqps.f
+++ /dev/null
@@ -1,359 +0,0 @@
-*> \brief \b SLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQPS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqps.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqps.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqps.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
-* VN2, AUXV, F, LDF )
-*
-* .. Scalar Arguments ..
-* INTEGER KB, LDA, LDF, M, N, NB, OFFSET
-* ..
-* .. Array Arguments ..
-* INTEGER JPVT( * )
-* REAL A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
-* $ VN1( * ), VN2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQPS computes a step of QR factorization with column pivoting
-*> of a real M-by-N matrix A by using Blas-3. It tries to factorize
-*> NB columns from A starting from the row OFFSET+1, and updates all
-*> of the matrix with Blas-3 xGEMM.
-*>
-*> In some cases, due to catastrophic cancellations, it cannot
-*> factorize NB columns. Hence, the actual number of factorized
-*> columns is returned in KB.
-*>
-*> Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> The number of rows of A that have been factorized in
-*> previous steps.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to factorize.
-*> \endverbatim
-*>
-*> \param[out] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of columns actually factorized.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, block A(OFFSET+1:M,1:KB) is the triangular
-*> factor obtained and block A(1:OFFSET,1:N) has been
-*> accordingly pivoted, but no factorized.
-*> The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
-*> been updated.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] JPVT
-*> \verbatim
-*> JPVT is INTEGER array, dimension (N)
-*> JPVT(I) = K <==> Column K of the full matrix A has been
-*> permuted into position I in AP.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (KB)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in,out] VN1
-*> \verbatim
-*> VN1 is REAL array, dimension (N)
-*> The vector with the partial column norms.
-*> \endverbatim
-*>
-*> \param[in,out] VN2
-*> \verbatim
-*> VN2 is REAL array, dimension (N)
-*> The vector with the exact column norms.
-*> \endverbatim
-*>
-*> \param[in,out] AUXV
-*> \verbatim
-*> AUXV is REAL array, dimension (NB)
-*> Auxiliar vector.
-*> \endverbatim
-*>
-*> \param[in,out] F
-*> \verbatim
-*> F is REAL array, dimension (LDF,NB)
-*> Matrix F**T = L*Y**T*A.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of the array F. LDF >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*> X. Sun, Computer Science Dept., Duke University, USA
-*>
-*> \n
-*> Partial column norm updating strategy modified on April 2011
-*> Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*> University of Zagreb, Croatia.
-*
-*> \par References:
-* ================
-*>
-*> LAPACK Working Note 176
-*
-*> \htmlonly
-*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a>
-*> \endhtmlonly
-*
-* =====================================================================
- SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
- $ VN2, AUXV, F, LDF )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER KB, LDA, LDF, M, N, NB, OFFSET
-* ..
-* .. Array Arguments ..
- INTEGER JPVT( * )
- REAL A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
- $ VN1( * ), VN2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER ITEMP, J, K, LASTRK, LSTICC, PVT, RK
- REAL AKK, TEMP, TEMP2, TOL3Z
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGEMV, SLARFG, SSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, NINT, REAL, SQRT
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH, SNRM2
- EXTERNAL ISAMAX, SLAMCH, SNRM2
-* ..
-* .. Executable Statements ..
-*
- LASTRK = MIN( M, N+OFFSET )
- LSTICC = 0
- K = 0
- TOL3Z = SQRT(SLAMCH('Epsilon'))
-*
-* Beginning of while loop.
-*
- 10 CONTINUE
- IF( ( K.LT.NB ) .AND. ( LSTICC.EQ.0 ) ) THEN
- K = K + 1
- RK = OFFSET + K
-*
-* Determine ith pivot column and swap if necessary
-*
- PVT = ( K-1 ) + ISAMAX( N-K+1, VN1( K ), 1 )
- IF( PVT.NE.K ) THEN
- CALL SSWAP( M, A( 1, PVT ), 1, A( 1, K ), 1 )
- CALL SSWAP( K-1, F( PVT, 1 ), LDF, F( K, 1 ), LDF )
- ITEMP = JPVT( PVT )
- JPVT( PVT ) = JPVT( K )
- JPVT( K ) = ITEMP
- VN1( PVT ) = VN1( K )
- VN2( PVT ) = VN2( K )
- END IF
-*
-* Apply previous Householder reflectors to column K:
-* A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)**T.
-*
- IF( K.GT.1 ) THEN
- CALL SGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, 1 ),
- $ LDA, F( K, 1 ), LDF, ONE, A( RK, K ), 1 )
- END IF
-*
-* Generate elementary reflector H(k).
-*
- IF( RK.LT.M ) THEN
- CALL SLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) )
- ELSE
- CALL SLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) )
- END IF
-*
- AKK = A( RK, K )
- A( RK, K ) = ONE
-*
-* Compute Kth column of F:
-*
-* Compute F(K+1:N,K) := tau(K)*A(RK:M,K+1:N)**T*A(RK:M,K).
-*
- IF( K.LT.N ) THEN
- CALL SGEMV( 'Transpose', M-RK+1, N-K, TAU( K ),
- $ A( RK, K+1 ), LDA, A( RK, K ), 1, ZERO,
- $ F( K+1, K ), 1 )
- END IF
-*
-* Padding F(1:K,K) with zeros.
-*
- DO 20 J = 1, K
- F( J, K ) = ZERO
- 20 CONTINUE
-*
-* Incremental updating of F:
-* F(1:N,K) := F(1:N,K) - tau(K)*F(1:N,1:K-1)*A(RK:M,1:K-1)**T
-* *A(RK:M,K).
-*
- IF( K.GT.1 ) THEN
- CALL SGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, 1 ),
- $ LDA, A( RK, K ), 1, ZERO, AUXV( 1 ), 1 )
-*
- CALL SGEMV( 'No transpose', N, K-1, ONE, F( 1, 1 ), LDF,
- $ AUXV( 1 ), 1, ONE, F( 1, K ), 1 )
- END IF
-*
-* Update the current row of A:
-* A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**T.
-*
- IF( K.LT.N ) THEN
- CALL SGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), LDF,
- $ A( RK, 1 ), LDA, ONE, A( RK, K+1 ), LDA )
- END IF
-*
-* Update partial column norms.
-*
- IF( RK.LT.LASTRK ) THEN
- DO 30 J = K + 1, N
- IF( VN1( J ).NE.ZERO ) THEN
-*
-* NOTE: The following 4 lines follow from the analysis in
-* Lapack Working Note 176.
-*
- TEMP = ABS( A( RK, J ) ) / VN1( J )
- TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
- TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
- IF( TEMP2 .LE. TOL3Z ) THEN
- VN2( J ) = REAL( LSTICC )
- LSTICC = J
- ELSE
- VN1( J ) = VN1( J )*SQRT( TEMP )
- END IF
- END IF
- 30 CONTINUE
- END IF
-*
- A( RK, K ) = AKK
-*
-* End of while loop.
-*
- GO TO 10
- END IF
- KB = K
- RK = OFFSET + KB
-*
-* Apply the block reflector to the rest of the matrix:
-* A(OFFSET+KB+1:M,KB+1:N) := A(OFFSET+KB+1:M,KB+1:N) -
-* A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**T.
-*
- IF( KB.LT.MIN( N, M-OFFSET ) ) THEN
- CALL SGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, -ONE,
- $ A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, ONE,
- $ A( RK+1, KB+1 ), LDA )
- END IF
-*
-* Recomputation of difficult columns.
-*
- 40 CONTINUE
- IF( LSTICC.GT.0 ) THEN
- ITEMP = NINT( VN2( LSTICC ) )
- VN1( LSTICC ) = SNRM2( M-RK, A( RK+1, LSTICC ), 1 )
-*
-* NOTE: The computation of VN1( LSTICC ) relies on the fact that
-* SNRM2 does not fail on vectors with norm below the value of
-* SQRT(DLAMCH('S'))
-*
- VN2( LSTICC ) = VN1( LSTICC )
- LSTICC = ITEMP
- GO TO 40
- END IF
-*
- RETURN
-*
-* End of SLAQPS
-*
- END
diff --git a/netlib/LAPACK/slaqr0.f b/netlib/LAPACK/slaqr0.f
deleted file mode 100644
index 80dfb60..0000000
--- a/netlib/LAPACK/slaqr0.f
+++ /dev/null
@@ -1,739 +0,0 @@
-*> \brief \b SLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQR0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQR0 computes the eigenvalues of a Hessenberg matrix H
-*> and, optionally, the matrices T and Z from the Schur decomposition
-*> H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*> Schur form), and Z is the orthogonal matrix of Schur vectors.
-*>
-*> Optionally Z may be postmultiplied into an input orthogonal
-*> matrix Q so that this routine can give the Schur factorization
-*> of a matrix A which has been reduced to the Hessenberg form H
-*> by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*> previous call to SGEBAL, and then passed to SGEHRD when the
-*> matrix output by SGEBAL is reduced to Hessenberg form.
-*> Otherwise, ILO and IHI should be set to 1 and N,
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*> the upper quasi-triangular matrix T from the Schur
-*> decomposition (the Schur form); 2-by-2 diagonal blocks
-*> (corresponding to complex conjugate pairs of eigenvalues)
-*> are returned in standard form, with H(i,i) = H(i+1,i+1)
-*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*> .FALSE., then the contents of H are unspecified on exit.
-*> (The output value of H when INFO.GT.0 is given under the
-*> description of INFO below.)
-*>
-*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (IHI)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (IHI)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI)
-*> and WI(ILO:IHI). If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*> the eigenvalues are stored in the same order as on the
-*> diagonal of the Schur form returned in H, with
-*> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*> block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,IHI)
-*> If WANTZ is .FALSE., then Z is not referenced.
-*> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*> orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*> (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if WANTZ is .TRUE.
-*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension LWORK
-*> On exit, if LWORK = -1, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient, but LWORK typically as large as 6*N may
-*> be required for optimal performance. A workspace query
-*> to determine the optimal workspace size is recommended.
-*>
-*> If LWORK = -1, then SLAQR0 does a workspace query.
-*> In this case, SLAQR0 checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: if INFO = i, SLAQR0 failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is an orthogonal matrix. The final
-*> value of H is upper Hessenberg and quasi-triangular
-*> in rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*>
-*> (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of WANTT.)
-*>
-*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*>
-* =====================================================================
- SUBROUTINE SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . SLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== Exceptional deflation windows: try to cure rare
-* . slow convergence by varying the size of the
-* . deflation window after KEXNW iterations. ====
- INTEGER KEXNW
- PARAMETER ( KEXNW = 5 )
-*
-* ==== Exceptional shifts: try to cure rare slow convergence
-* . with ad-hoc exceptional shifts every KEXSH iterations.
-* . ====
- INTEGER KEXSH
- PARAMETER ( KEXSH = 6 )
-*
-* ==== The constants WILK1 and WILK2 are used to form the
-* . exceptional shifts. ====
- REAL WILK1, WILK2
- PARAMETER ( WILK1 = 0.75e0, WILK2 = -0.4375e0 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 )
-* ..
-* .. Local Scalars ..
- REAL AA, BB, CC, CS, DD, SN, SS, SWAP
- INTEGER I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
- $ KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
- $ LWKOPT, NDEC, NDFL, NH, NHO, NIBBLE, NMIN, NS,
- $ NSMAX, NSR, NVE, NW, NWMAX, NWR, NWUPBD
- LOGICAL SORTED
- CHARACTER JBCMPZ*2
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Local Arrays ..
- REAL ZDUM( 1, 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SLAHQR, SLANV2, SLAQR3, SLAQR4, SLAQR5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, MAX, MIN, MOD, REAL
-* ..
-* .. Executable Statements ..
- INFO = 0
-*
-* ==== Quick return for N = 0: nothing to do. ====
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
- IF( N.LE.NTINY ) THEN
-*
-* ==== Tiny matrices must use SLAHQR. ====
-*
- LWKOPT = 1
- IF( LWORK.NE.-1 )
- $ CALL SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
- ELSE
-*
-* ==== Use small bulge multi-shift QR with aggressive early
-* . deflation on larger-than-tiny matrices. ====
-*
-* ==== Hope for the best. ====
-*
- INFO = 0
-*
-* ==== Set up job flags for ILAENV. ====
-*
- IF( WANTT ) THEN
- JBCMPZ( 1: 1 ) = 'S'
- ELSE
- JBCMPZ( 1: 1 ) = 'E'
- END IF
- IF( WANTZ ) THEN
- JBCMPZ( 2: 2 ) = 'V'
- ELSE
- JBCMPZ( 2: 2 ) = 'N'
- END IF
-*
-* ==== NWR = recommended deflation window size. At this
-* . point, N .GT. NTINY = 11, so there is enough
-* . subdiagonal workspace for NWR.GE.2 as required.
-* . (In fact, there is enough subdiagonal space for
-* . NWR.GE.3.) ====
-*
- NWR = ILAENV( 13, 'SLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NWR = MAX( 2, NWR )
- NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-*
-* ==== NSR = recommended number of simultaneous shifts.
-* . At this point N .GT. NTINY = 11, so there is at
-* . enough subdiagonal workspace for NSR to be even
-* . and greater than or equal to two as required. ====
-*
- NSR = ILAENV( 15, 'SLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
- NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-* ==== Estimate optimal workspace ====
-*
-* ==== Workspace query call to SLAQR3 ====
-*
- CALL SLAQR3( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
- $ N, H, LDH, WORK, -1 )
-*
-* ==== Optimal workspace = MAX(SLAQR5, SLAQR3) ====
-*
- LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = REAL( LWKOPT )
- RETURN
- END IF
-*
-* ==== SLAHQR/SLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'SLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== Nibble crossover point ====
-*
- NIBBLE = ILAENV( 14, 'SLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NIBBLE = MAX( 0, NIBBLE )
-*
-* ==== Accumulate reflections during ttswp? Use block
-* . 2-by-2 structure during matrix-matrix multiply? ====
-*
- KACC22 = ILAENV( 16, 'SLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- KACC22 = MAX( 0, KACC22 )
- KACC22 = MIN( 2, KACC22 )
-*
-* ==== NWMAX = the largest possible deflation window for
-* . which there is sufficient workspace. ====
-*
- NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
- NW = NWMAX
-*
-* ==== NSMAX = the Largest number of simultaneous shifts
-* . for which there is sufficient workspace. ====
-*
- NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
- NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-* ==== NDFL: an iteration count restarted at deflation. ====
-*
- NDFL = 1
-*
-* ==== ITMAX = iteration limit ====
-*
- ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-* ==== Last row and column in the active block ====
-*
- KBOT = IHI
-*
-* ==== Main Loop ====
-*
- DO 80 IT = 1, ITMAX
-*
-* ==== Done when KBOT falls below ILO ====
-*
- IF( KBOT.LT.ILO )
- $ GO TO 90
-*
-* ==== Locate active block ====
-*
- DO 10 K = KBOT, ILO + 1, -1
- IF( H( K, K-1 ).EQ.ZERO )
- $ GO TO 20
- 10 CONTINUE
- K = ILO
- 20 CONTINUE
- KTOP = K
-*
-* ==== Select deflation window size:
-* . Typical Case:
-* . If possible and advisable, nibble the entire
-* . active block. If not, use size MIN(NWR,NWMAX)
-* . or MIN(NWR+1,NWMAX) depending upon which has
-* . the smaller corresponding subdiagonal entry
-* . (a heuristic).
-* .
-* . Exceptional Case:
-* . If there have been no deflations in KEXNW or
-* . more iterations, then vary the deflation window
-* . size. At first, because, larger windows are,
-* . in general, more powerful than smaller ones,
-* . rapidly increase the window to the maximum possible.
-* . Then, gradually reduce the window size. ====
-*
- NH = KBOT - KTOP + 1
- NWUPBD = MIN( NH, NWMAX )
- IF( NDFL.LT.KEXNW ) THEN
- NW = MIN( NWUPBD, NWR )
- ELSE
- NW = MIN( NWUPBD, 2*NW )
- END IF
- IF( NW.LT.NWMAX ) THEN
- IF( NW.GE.NH-1 ) THEN
- NW = NH
- ELSE
- KWTOP = KBOT - NW + 1
- IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
- $ ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
- END IF
- END IF
- IF( NDFL.LT.KEXNW ) THEN
- NDEC = -1
- ELSE IF( NDEC.GE.0 .OR. NW.GE.NWUPBD ) THEN
- NDEC = NDEC + 1
- IF( NW-NDEC.LT.2 )
- $ NDEC = 0
- NW = NW - NDEC
- END IF
-*
-* ==== Aggressive early deflation:
-* . split workspace under the subdiagonal into
-* . - an nw-by-nw work array V in the lower
-* . left-hand-corner,
-* . - an NW-by-at-least-NW-but-more-is-better
-* . (NW-by-NHO) horizontal work array along
-* . the bottom edge,
-* . - an at-least-NW-but-more-is-better (NHV-by-NW)
-* . vertical work array along the left-hand-edge.
-* . ====
-*
- KV = N - NW + 1
- KT = NW + 1
- NHO = ( N-NW-1 ) - KT + 1
- KWV = NW + 2
- NVE = ( N-NW ) - KWV + 1
-*
-* ==== Aggressive early deflation ====
-*
- CALL SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
- $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
- $ WORK, LWORK )
-*
-* ==== Adjust KBOT accounting for new deflations. ====
-*
- KBOT = KBOT - LD
-*
-* ==== KS points to the shifts. ====
-*
- KS = KBOT - LS + 1
-*
-* ==== Skip an expensive QR sweep if there is a (partly
-* . heuristic) reason to expect that many eigenvalues
-* . will deflate without it. Here, the QR sweep is
-* . skipped if many eigenvalues have just been deflated
-* . or if the remaining active block is small.
-*
- IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
- $ KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-* ==== NS = nominal number of simultaneous shifts.
-* . This may be lowered (slightly) if SLAQR3
-* . did not provide that many shifts. ====
-*
- NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
- NS = NS - MOD( NS, 2 )
-*
-* ==== If there have been no deflations
-* . in a multiple of KEXSH iterations,
-* . then try exceptional shifts.
-* . Otherwise use shifts provided by
-* . SLAQR3 above or from the eigenvalues
-* . of a trailing principal submatrix. ====
-*
- IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
- KS = KBOT - NS + 1
- DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
- SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- AA = WILK1*SS + H( I, I )
- BB = SS
- CC = WILK2*SS
- DD = AA
- CALL SLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
- $ WR( I ), WI( I ), CS, SN )
- 30 CONTINUE
- IF( KS.EQ.KTOP ) THEN
- WR( KS+1 ) = H( KS+1, KS+1 )
- WI( KS+1 ) = ZERO
- WR( KS ) = WR( KS+1 )
- WI( KS ) = WI( KS+1 )
- END IF
- ELSE
-*
-* ==== Got NS/2 or fewer shifts? Use SLAQR4 or
-* . SLAHQR on a trailing principal submatrix to
-* . get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-* . there is enough space below the subdiagonal
-* . to fit an NS-by-NS scratch array.) ====
-*
- IF( KBOT-KS+1.LE.NS / 2 ) THEN
- KS = KBOT - NS + 1
- KT = N - NS + 1
- CALL SLACPY( 'A', NS, NS, H( KS, KS ), LDH,
- $ H( KT, 1 ), LDH )
- IF( NS.GT.NMIN ) THEN
- CALL SLAQR4( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ),
- $ WI( KS ), 1, 1, ZDUM, 1, WORK,
- $ LWORK, INF )
- ELSE
- CALL SLAHQR( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ),
- $ WI( KS ), 1, 1, ZDUM, 1, INF )
- END IF
- KS = KS + INF
-*
-* ==== In case of a rare QR failure use
-* . eigenvalues of the trailing 2-by-2
-* . principal submatrix. ====
-*
- IF( KS.GE.KBOT ) THEN
- AA = H( KBOT-1, KBOT-1 )
- CC = H( KBOT, KBOT-1 )
- BB = H( KBOT-1, KBOT )
- DD = H( KBOT, KBOT )
- CALL SLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
- $ WI( KBOT-1 ), WR( KBOT ),
- $ WI( KBOT ), CS, SN )
- KS = KBOT - 1
- END IF
- END IF
-*
- IF( KBOT-KS+1.GT.NS ) THEN
-*
-* ==== Sort the shifts (Helps a little)
-* . Bubble sort keeps complex conjugate
-* . pairs together. ====
-*
- SORTED = .false.
- DO 50 K = KBOT, KS + 1, -1
- IF( SORTED )
- $ GO TO 60
- SORTED = .true.
- DO 40 I = KS, K - 1
- IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
- $ ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
- SORTED = .false.
-*
- SWAP = WR( I )
- WR( I ) = WR( I+1 )
- WR( I+1 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I+1 )
- WI( I+1 ) = SWAP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* ==== Shuffle shifts into pairs of real shifts
-* . and pairs of complex conjugate shifts
-* . assuming complex conjugate shifts are
-* . already adjacent to one another. (Yes,
-* . they are.) ====
-*
- DO 70 I = KBOT, KS + 2, -2
- IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
- SWAP = WR( I )
- WR( I ) = WR( I-1 )
- WR( I-1 ) = WR( I-2 )
- WR( I-2 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I-1 )
- WI( I-1 ) = WI( I-2 )
- WI( I-2 ) = SWAP
- END IF
- 70 CONTINUE
- END IF
-*
-* ==== If there are only two shifts and both are
-* . real, then use only one. ====
-*
- IF( KBOT-KS+1.EQ.2 ) THEN
- IF( WI( KBOT ).EQ.ZERO ) THEN
- IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
- $ ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
- WR( KBOT-1 ) = WR( KBOT )
- ELSE
- WR( KBOT ) = WR( KBOT-1 )
- END IF
- END IF
- END IF
-*
-* ==== Use up to NS of the the smallest magnatiude
-* . shifts. If there aren't NS shifts available,
-* . then use them all, possibly dropping one to
-* . make the number of shifts even. ====
-*
- NS = MIN( NS, KBOT-KS+1 )
- NS = NS - MOD( NS, 2 )
- KS = KBOT - NS + 1
-*
-* ==== Small-bulge multi-shift QR sweep:
-* . split workspace under the subdiagonal into
-* . - a KDU-by-KDU work array U in the lower
-* . left-hand-corner,
-* . - a KDU-by-at-least-KDU-but-more-is-better
-* . (KDU-by-NHo) horizontal work array WH along
-* . the bottom edge,
-* . - and an at-least-KDU-but-more-is-better-by-KDU
-* . (NVE-by-KDU) vertical work WV arrow along
-* . the left-hand-edge. ====
-*
- KDU = 3*NS - 3
- KU = N - KDU + 1
- KWH = KDU + 1
- NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
- KWV = KDU + 4
- NVE = N - KDU - KWV + 1
-*
-* ==== Small-bulge multi-shift QR sweep ====
-*
- CALL SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
- $ WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
- $ LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
- $ H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
- END IF
-*
-* ==== Note progress (or the lack of it). ====
-*
- IF( LD.GT.0 ) THEN
- NDFL = 1
- ELSE
- NDFL = NDFL + 1
- END IF
-*
-* ==== End of main loop ====
- 80 CONTINUE
-*
-* ==== Iteration limit exceeded. Set INFO to show where
-* . the problem occurred and exit. ====
-*
- INFO = KBOT
- 90 CONTINUE
- END IF
-*
-* ==== Return the optimal value of LWORK. ====
-*
- WORK( 1 ) = REAL( LWKOPT )
-*
-* ==== End of SLAQR0 ====
-*
- END
diff --git a/netlib/LAPACK/slaqr1.f b/netlib/LAPACK/slaqr1.f
deleted file mode 100644
index 336d545..0000000
--- a/netlib/LAPACK/slaqr1.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief \b SLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQR1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-* .. Scalar Arguments ..
-* REAL SI1, SI2, SR1, SR2
-* INTEGER LDH, N
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), V( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given a 2-by-2 or 3-by-3 matrix H, SLAQR1 sets v to a
-*> scalar multiple of the first column of the product
-*>
-*> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
-*>
-*> scaling to avoid overflows and most underflows. It
-*> is assumed that either
-*>
-*> 1) sr1 = sr2 and si1 = -si2
-*> or
-*> 2) si1 = si2 = 0.
-*>
-*> This is useful for starting double implicit shift bulges
-*> in the QR algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is integer
-*> Order of the matrix H. N must be either 2 or 3.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is REAL array of dimension (LDH,N)
-*> The 2-by-2 or 3-by-3 matrix H in (*).
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> The leading dimension of H as declared in
-*> the calling procedure. LDH.GE.N
-*> \endverbatim
-*>
-*> \param[in] SR1
-*> \verbatim
-*> SR1 is REAL
-*> \endverbatim
-*>
-*> \param[in] SI1
-*> \verbatim
-*> SI1 is REAL
-*> \endverbatim
-*>
-*> \param[in] SR2
-*> \verbatim
-*> SR2 is REAL
-*> \endverbatim
-*>
-*> \param[in] SI2
-*> \verbatim
-*> SI2 is REAL
-*> The shifts in (*).
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array of dimension N
-*> A scalar multiple of the first column of the
-*> matrix K in (*).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE SLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL SI1, SI2, SR1, SR2
- INTEGER LDH, N
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), V( * )
-* ..
-*
-* ================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0e0 )
-* ..
-* .. Local Scalars ..
- REAL H21S, H31S, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
- IF( N.EQ.2 ) THEN
- S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) )
- IF( S.EQ.ZERO ) THEN
- V( 1 ) = ZERO
- V( 2 ) = ZERO
- ELSE
- H21S = H( 2, 1 ) / S
- V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )*
- $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S )
- V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 )
- END IF
- ELSE
- S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) +
- $ ABS( H( 3, 1 ) )
- IF( S.EQ.ZERO ) THEN
- V( 1 ) = ZERO
- V( 2 ) = ZERO
- V( 3 ) = ZERO
- ELSE
- H21S = H( 2, 1 ) / S
- H31S = H( 3, 1 ) / S
- V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) -
- $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S
- V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) +
- $ H( 2, 3 )*H31S
- V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) +
- $ H21S*H( 3, 2 )
- END IF
- END IF
- END
diff --git a/netlib/LAPACK/slaqr2.f b/netlib/LAPACK/slaqr2.f
deleted file mode 100644
index 6b9775b..0000000
--- a/netlib/LAPACK/slaqr2.f
+++ /dev/null
@@ -1,684 +0,0 @@
-*> \brief \b SLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-* LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQR2 is identical to SLAQR3 except that it avoids
-*> recursion by calling SLAHQR instead of SLAQR4.
-*>
-*> Aggressive early deflation:
-*>
-*> This subroutine accepts as input an upper Hessenberg matrix
-*> H and performs an orthogonal similarity transformation
-*> designed to detect and deflate fully converged eigenvalues from
-*> a trailing principal submatrix. On output H has been over-
-*> written by a new Hessenberg matrix that is a perturbation of
-*> an orthogonal similarity transformation of H. It is to be
-*> hoped that the final version of H has many zero subdiagonal
-*> entries.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> If .TRUE., then the Hessenberg matrix H is fully updated
-*> so that the quasi-triangular Schur factor may be
-*> computed (in cooperation with the calling subroutine).
-*> If .FALSE., then only enough of H is updated to preserve
-*> the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> If .TRUE., then the orthogonal matrix Z is updated so
-*> so that the orthogonal Schur factor may be computed
-*> (in cooperation with the calling subroutine).
-*> If .FALSE., then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H and (if WANTZ is .TRUE.) the
-*> order of the orthogonal matrix Z.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is INTEGER
-*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*> KBOT and KTOP together determine an isolated block
-*> along the diagonal of the Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is INTEGER
-*> It is assumed without a check that either
-*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
-*> determine an isolated block along the diagonal of the
-*> Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> On input the initial N-by-N section of H stores the
-*> Hessenberg matrix undergoing aggressive early deflation.
-*> On output H has been transformed by an orthogonal
-*> similarity transformation, perturbed, and the returned
-*> to Hessenberg form that (it is to be hoped) has some
-*> zero subdiagonal entries.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> Leading dimension of H just as declared in the calling
-*> subroutine. N .LE. LDH
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> IF WANTZ is .TRUE., then on output, the orthogonal
-*> similarity transformation mentioned above has been
-*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ is .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer
-*> The leading dimension of Z just as declared in the
-*> calling subroutine. 1 .LE. LDZ.
-*> \endverbatim
-*>
-*> \param[out] NS
-*> \verbatim
-*> NS is integer
-*> The number of unconverged (ie approximate) eigenvalues
-*> returned in SR and SI that may be used as shifts by the
-*> calling subroutine.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is integer
-*> The number of converged eigenvalues uncovered by this
-*> subroutine.
-*> \endverbatim
-*>
-*> \param[out] SR
-*> \verbatim
-*> SR is REAL array, dimension KBOT
-*> \endverbatim
-*>
-*> \param[out] SI
-*> \verbatim
-*> SI is REAL array, dimension KBOT
-*> On output, the real and imaginary parts of approximate
-*> eigenvalues that may be used for shifts are stored in
-*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*> The real and imaginary parts of converged eigenvalues
-*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*> SI(KBOT-ND+1) through SI(KBOT), respectively.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,NW)
-*> An NW-by-NW work array.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> The leading dimension of V just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> The number of columns of T. NH.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,NW)
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is integer
-*> The leading dimension of T just as declared in the
-*> calling subroutine. NW .LE. LDT
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer
-*> The number of rows of work array WV available for
-*> workspace. NV.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is REAL array, dimension (LDWV,NW)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer
-*> The leading dimension of W just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension LWORK.
-*> On exit, WORK(1) is set to an estimate of the optimal value
-*> of LWORK for the given values of N, NW, KTOP and KBOT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer
-*> The dimension of the work array WORK. LWORK = 2*NW
-*> suffices, but greater efficiency may result from larger
-*> values of LWORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; SLAQR2
-*> only estimates the optimal workspace size for the given
-*> values of N, NW, KTOP and KBOT. The estimate is returned
-*> in WORK(1). No error message related to LWORK is issued
-*> by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
- $ LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
- $ LDZ, LWORK, N, ND, NH, NS, NV, NW
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
- $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 )
-* ..
-* .. Local Scalars ..
- REAL AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
- $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
- INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
- $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2,
- $ LWKOPT
- LOGICAL BULGE, SORTED
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEHRD, SGEMM, SLABAD, SLACPY, SLAHQR,
- $ SLANV2, SLARF, SLARFG, SLASET, SORMHR, STREXC
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, MAX, MIN, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* ==== Estimate optimal workspace. ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- IF( JW.LE.2 ) THEN
- LWKOPT = 1
- ELSE
-*
-* ==== Workspace query call to SGEHRD ====
-*
- CALL SGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
- LWK1 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to SORMHR ====
-*
- CALL SORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
- $ WORK, -1, INFO )
- LWK2 = INT( WORK( 1 ) )
-*
-* ==== Optimal workspace ====
-*
- LWKOPT = JW + MAX( LWK1, LWK2 )
- END IF
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = REAL( LWKOPT )
- RETURN
- END IF
-*
-* ==== Nothing to do ...
-* ... for an empty active block ... ====
- NS = 0
- ND = 0
- WORK( 1 ) = ONE
- IF( KTOP.GT.KBOT )
- $ RETURN
-* ... nor for an empty deflation window. ====
- IF( NW.LT.1 )
- $ RETURN
-*
-* ==== Machine constants ====
-*
- SAFMIN = SLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL SLABAD( SAFMIN, SAFMAX )
- ULP = SLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( REAL( N ) / ULP )
-*
-* ==== Setup deflation window ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- KWTOP = KBOT - JW + 1
- IF( KWTOP.EQ.KTOP ) THEN
- S = ZERO
- ELSE
- S = H( KWTOP, KWTOP-1 )
- END IF
-*
- IF( KBOT.EQ.KWTOP ) THEN
-*
-* ==== 1-by-1 deflation window: not much to do ====
-*
- SR( KWTOP ) = H( KWTOP, KWTOP )
- SI( KWTOP ) = ZERO
- NS = 1
- ND = 0
- IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
- $ THEN
- NS = 0
- ND = 1
- IF( KWTOP.GT.KTOP )
- $ H( KWTOP, KWTOP-1 ) = ZERO
- END IF
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
-* ==== Convert to spike-triangular form. (In case of a
-* . rare QR failure, this routine continues to do
-* . aggressive early deflation using that part of
-* . the deflation window that converged using INFQR
-* . here and there to keep track.) ====
-*
- CALL SLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
- CALL SCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
- CALL SLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
- CALL SLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, INFQR )
-*
-* ==== STREXC needs a clean margin near the diagonal ====
-*
- DO 10 J = 1, JW - 3
- T( J+2, J ) = ZERO
- T( J+3, J ) = ZERO
- 10 CONTINUE
- IF( JW.GT.2 )
- $ T( JW, JW-2 ) = ZERO
-*
-* ==== Deflation detection loop ====
-*
- NS = JW
- ILST = INFQR + 1
- 20 CONTINUE
- IF( ILST.LE.NS ) THEN
- IF( NS.EQ.1 ) THEN
- BULGE = .FALSE.
- ELSE
- BULGE = T( NS, NS-1 ).NE.ZERO
- END IF
-*
-* ==== Small spike tip test for deflation ====
-*
- IF( .NOT.BULGE ) THEN
-*
-* ==== Real eigenvalue ====
-*
- FOO = ABS( T( NS, NS ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 1
- ELSE
-*
-* ==== Undeflatable. Move it up out of the way.
-* . (STREXC can not fail in this case.) ====
-*
- IFST = NS
- CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 1
- END IF
- ELSE
-*
-* ==== Complex conjugate pair ====
-*
- FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
- $ SQRT( ABS( T( NS-1, NS ) ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
- $ MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 2
- ELSE
-*
-* ==== Undeflatable. Move them up out of the way.
-* . Fortunately, STREXC does the right thing with
-* . ILST in case of a rare exchange failure. ====
-*
- IFST = NS
- CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 2
- END IF
- END IF
-*
-* ==== End deflation detection loop ====
-*
- GO TO 20
- END IF
-*
-* ==== Return to Hessenberg form ====
-*
- IF( NS.EQ.0 )
- $ S = ZERO
-*
- IF( NS.LT.JW ) THEN
-*
-* ==== sorting diagonal blocks of T improves accuracy for
-* . graded matrices. Bubble sort deals well with
-* . exchange failures. ====
-*
- SORTED = .false.
- I = NS + 1
- 30 CONTINUE
- IF( SORTED )
- $ GO TO 50
- SORTED = .true.
-*
- KEND = I - 1
- I = INFQR + 1
- IF( I.EQ.NS ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- 40 CONTINUE
- IF( K.LE.KEND ) THEN
- IF( K.EQ.I+1 ) THEN
- EVI = ABS( T( I, I ) )
- ELSE
- EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
- $ SQRT( ABS( T( I, I+1 ) ) )
- END IF
-*
- IF( K.EQ.KEND ) THEN
- EVK = ABS( T( K, K ) )
- ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
- EVK = ABS( T( K, K ) )
- ELSE
- EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
- $ SQRT( ABS( T( K, K+1 ) ) )
- END IF
-*
- IF( EVI.GE.EVK ) THEN
- I = K
- ELSE
- SORTED = .false.
- IFST = I
- ILST = K
- CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- IF( INFO.EQ.0 ) THEN
- I = ILST
- ELSE
- I = K
- END IF
- END IF
- IF( I.EQ.KEND ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- GO TO 40
- END IF
- GO TO 30
- 50 CONTINUE
- END IF
-*
-* ==== Restore shift/eigenvalue array from T ====
-*
- I = JW
- 60 CONTINUE
- IF( I.GE.INFQR+1 ) THEN
- IF( I.EQ.INFQR+1 ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE
- AA = T( I-1, I-1 )
- CC = T( I, I-1 )
- BB = T( I-1, I )
- DD = T( I, I )
- CALL SLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
- $ SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
- $ SI( KWTOP+I-1 ), CS, SN )
- I = I - 2
- END IF
- GO TO 60
- END IF
-*
- IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
- IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-* ==== Reflect spike back into lower triangle ====
-*
- CALL SCOPY( NS, V, LDV, WORK, 1 )
- BETA = WORK( 1 )
- CALL SLARFG( NS, BETA, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
- CALL SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL SLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL SLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
- $ WORK( JW+1 ) )
-*
- CALL SGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
- $ LWORK-JW, INFO )
- END IF
-*
-* ==== Copy updated reduced window into place ====
-*
- IF( KWTOP.GT.1 )
- $ H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
- CALL SLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
- CALL SCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
- $ LDH+1 )
-*
-* ==== Accumulate orthogonal matrix in order update
-* . H and Z, if requested. ====
-*
- IF( NS.GT.1 .AND. S.NE.ZERO )
- $ CALL SORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
- $ WORK( JW+1 ), LWORK-JW, INFO )
-*
-* ==== Update vertical slab in H ====
-*
- IF( WANTT ) THEN
- LTOP = 1
- ELSE
- LTOP = KTOP
- END IF
- DO 70 KROW = LTOP, KWTOP - 1, NV
- KLN = MIN( NV, KWTOP-KROW )
- CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
- $ LDH, V, LDV, ZERO, WV, LDWV )
- CALL SLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
- 70 CONTINUE
-*
-* ==== Update horizontal slab in H ====
-*
- IF( WANTT ) THEN
- DO 80 KCOL = KBOT + 1, N, NH
- KLN = MIN( NH, N-KCOL+1 )
- CALL SGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
- $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
- CALL SLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
- $ LDH )
- 80 CONTINUE
- END IF
-*
-* ==== Update vertical slab in Z ====
-*
- IF( WANTZ ) THEN
- DO 90 KROW = ILOZ, IHIZ, NV
- KLN = MIN( NV, IHIZ-KROW+1 )
- CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
- $ LDZ, V, LDV, ZERO, WV, LDWV )
- CALL SLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
- $ LDZ )
- 90 CONTINUE
- END IF
- END IF
-*
-* ==== Return the number of deflations ... ====
-*
- ND = JW - NS
-*
-* ==== ... and the number of shifts. (Subtracting
-* . INFQR from the spike length takes care
-* . of the case of a rare QR failure while
-* . calculating eigenvalues of the deflation
-* . window.) ====
-*
- NS = NS - INFQR
-*
-* ==== Return optimal workspace. ====
-*
- WORK( 1 ) = REAL( LWKOPT )
-*
-* ==== End of SLAQR2 ====
-*
- END
diff --git a/netlib/LAPACK/slaqr3.f b/netlib/LAPACK/slaqr3.f
deleted file mode 100644
index 150febd..0000000
--- a/netlib/LAPACK/slaqr3.f
+++ /dev/null
@@ -1,695 +0,0 @@
-*> \brief \b SLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQR3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-* LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Aggressive early deflation:
-*>
-*> SLAQR3 accepts as input an upper Hessenberg matrix
-*> H and performs an orthogonal similarity transformation
-*> designed to detect and deflate fully converged eigenvalues from
-*> a trailing principal submatrix. On output H has been over-
-*> written by a new Hessenberg matrix that is a perturbation of
-*> an orthogonal similarity transformation of H. It is to be
-*> hoped that the final version of H has many zero subdiagonal
-*> entries.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> If .TRUE., then the Hessenberg matrix H is fully updated
-*> so that the quasi-triangular Schur factor may be
-*> computed (in cooperation with the calling subroutine).
-*> If .FALSE., then only enough of H is updated to preserve
-*> the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> If .TRUE., then the orthogonal matrix Z is updated so
-*> so that the orthogonal Schur factor may be computed
-*> (in cooperation with the calling subroutine).
-*> If .FALSE., then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H and (if WANTZ is .TRUE.) the
-*> order of the orthogonal matrix Z.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is INTEGER
-*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*> KBOT and KTOP together determine an isolated block
-*> along the diagonal of the Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is INTEGER
-*> It is assumed without a check that either
-*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
-*> determine an isolated block along the diagonal of the
-*> Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> On input the initial N-by-N section of H stores the
-*> Hessenberg matrix undergoing aggressive early deflation.
-*> On output H has been transformed by an orthogonal
-*> similarity transformation, perturbed, and the returned
-*> to Hessenberg form that (it is to be hoped) has some
-*> zero subdiagonal entries.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> Leading dimension of H just as declared in the calling
-*> subroutine. N .LE. LDH
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> IF WANTZ is .TRUE., then on output, the orthogonal
-*> similarity transformation mentioned above has been
-*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ is .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer
-*> The leading dimension of Z just as declared in the
-*> calling subroutine. 1 .LE. LDZ.
-*> \endverbatim
-*>
-*> \param[out] NS
-*> \verbatim
-*> NS is integer
-*> The number of unconverged (ie approximate) eigenvalues
-*> returned in SR and SI that may be used as shifts by the
-*> calling subroutine.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is integer
-*> The number of converged eigenvalues uncovered by this
-*> subroutine.
-*> \endverbatim
-*>
-*> \param[out] SR
-*> \verbatim
-*> SR is REAL array, dimension KBOT
-*> \endverbatim
-*>
-*> \param[out] SI
-*> \verbatim
-*> SI is REAL array, dimension KBOT
-*> On output, the real and imaginary parts of approximate
-*> eigenvalues that may be used for shifts are stored in
-*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*> The real and imaginary parts of converged eigenvalues
-*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*> SI(KBOT-ND+1) through SI(KBOT), respectively.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,NW)
-*> An NW-by-NW work array.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> The leading dimension of V just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> The number of columns of T. NH.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,NW)
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is integer
-*> The leading dimension of T just as declared in the
-*> calling subroutine. NW .LE. LDT
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer
-*> The number of rows of work array WV available for
-*> workspace. NV.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is REAL array, dimension (LDWV,NW)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer
-*> The leading dimension of W just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension LWORK.
-*> On exit, WORK(1) is set to an estimate of the optimal value
-*> of LWORK for the given values of N, NW, KTOP and KBOT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer
-*> The dimension of the work array WORK. LWORK = 2*NW
-*> suffices, but greater efficiency may result from larger
-*> values of LWORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; SLAQR3
-*> only estimates the optimal workspace size for the given
-*> values of N, NW, KTOP and KBOT. The estimate is returned
-*> in WORK(1). No error message related to LWORK is issued
-*> by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
- $ LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
- $ LDZ, LWORK, N, ND, NH, NS, NV, NW
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
- $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 )
-* ..
-* .. Local Scalars ..
- REAL AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
- $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
- INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
- $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
- $ LWKOPT, NMIN
- LOGICAL BULGE, SORTED
-* ..
-* .. External Functions ..
- REAL SLAMCH
- INTEGER ILAENV
- EXTERNAL SLAMCH, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEHRD, SGEMM, SLABAD, SLACPY, SLAHQR,
- $ SLANV2, SLAQR4, SLARF, SLARFG, SLASET, SORMHR,
- $ STREXC
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, MAX, MIN, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* ==== Estimate optimal workspace. ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- IF( JW.LE.2 ) THEN
- LWKOPT = 1
- ELSE
-*
-* ==== Workspace query call to SGEHRD ====
-*
- CALL SGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
- LWK1 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to SORMHR ====
-*
- CALL SORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
- $ WORK, -1, INFO )
- LWK2 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to SLAQR4 ====
-*
- CALL SLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, JW,
- $ V, LDV, WORK, -1, INFQR )
- LWK3 = INT( WORK( 1 ) )
-*
-* ==== Optimal workspace ====
-*
- LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
- END IF
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = REAL( LWKOPT )
- RETURN
- END IF
-*
-* ==== Nothing to do ...
-* ... for an empty active block ... ====
- NS = 0
- ND = 0
- WORK( 1 ) = ONE
- IF( KTOP.GT.KBOT )
- $ RETURN
-* ... nor for an empty deflation window. ====
- IF( NW.LT.1 )
- $ RETURN
-*
-* ==== Machine constants ====
-*
- SAFMIN = SLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL SLABAD( SAFMIN, SAFMAX )
- ULP = SLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( REAL( N ) / ULP )
-*
-* ==== Setup deflation window ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- KWTOP = KBOT - JW + 1
- IF( KWTOP.EQ.KTOP ) THEN
- S = ZERO
- ELSE
- S = H( KWTOP, KWTOP-1 )
- END IF
-*
- IF( KBOT.EQ.KWTOP ) THEN
-*
-* ==== 1-by-1 deflation window: not much to do ====
-*
- SR( KWTOP ) = H( KWTOP, KWTOP )
- SI( KWTOP ) = ZERO
- NS = 1
- ND = 0
- IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
- $ THEN
- NS = 0
- ND = 1
- IF( KWTOP.GT.KTOP )
- $ H( KWTOP, KWTOP-1 ) = ZERO
- END IF
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
-* ==== Convert to spike-triangular form. (In case of a
-* . rare QR failure, this routine continues to do
-* . aggressive early deflation using that part of
-* . the deflation window that converged using INFQR
-* . here and there to keep track.) ====
-*
- CALL SLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
- CALL SCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
- CALL SLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
- NMIN = ILAENV( 12, 'SLAQR3', 'SV', JW, 1, JW, LWORK )
- IF( JW.GT.NMIN ) THEN
- CALL SLAQR4( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, WORK, LWORK, INFQR )
- ELSE
- CALL SLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, INFQR )
- END IF
-*
-* ==== STREXC needs a clean margin near the diagonal ====
-*
- DO 10 J = 1, JW - 3
- T( J+2, J ) = ZERO
- T( J+3, J ) = ZERO
- 10 CONTINUE
- IF( JW.GT.2 )
- $ T( JW, JW-2 ) = ZERO
-*
-* ==== Deflation detection loop ====
-*
- NS = JW
- ILST = INFQR + 1
- 20 CONTINUE
- IF( ILST.LE.NS ) THEN
- IF( NS.EQ.1 ) THEN
- BULGE = .FALSE.
- ELSE
- BULGE = T( NS, NS-1 ).NE.ZERO
- END IF
-*
-* ==== Small spike tip test for deflation ====
-*
- IF( .NOT. BULGE ) THEN
-*
-* ==== Real eigenvalue ====
-*
- FOO = ABS( T( NS, NS ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 1
- ELSE
-*
-* ==== Undeflatable. Move it up out of the way.
-* . (STREXC can not fail in this case.) ====
-*
- IFST = NS
- CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 1
- END IF
- ELSE
-*
-* ==== Complex conjugate pair ====
-*
- FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
- $ SQRT( ABS( T( NS-1, NS ) ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
- $ MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 2
- ELSE
-*
-* ==== Undeflatable. Move them up out of the way.
-* . Fortunately, STREXC does the right thing with
-* . ILST in case of a rare exchange failure. ====
-*
- IFST = NS
- CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 2
- END IF
- END IF
-*
-* ==== End deflation detection loop ====
-*
- GO TO 20
- END IF
-*
-* ==== Return to Hessenberg form ====
-*
- IF( NS.EQ.0 )
- $ S = ZERO
-*
- IF( NS.LT.JW ) THEN
-*
-* ==== sorting diagonal blocks of T improves accuracy for
-* . graded matrices. Bubble sort deals well with
-* . exchange failures. ====
-*
- SORTED = .false.
- I = NS + 1
- 30 CONTINUE
- IF( SORTED )
- $ GO TO 50
- SORTED = .true.
-*
- KEND = I - 1
- I = INFQR + 1
- IF( I.EQ.NS ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- 40 CONTINUE
- IF( K.LE.KEND ) THEN
- IF( K.EQ.I+1 ) THEN
- EVI = ABS( T( I, I ) )
- ELSE
- EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
- $ SQRT( ABS( T( I, I+1 ) ) )
- END IF
-*
- IF( K.EQ.KEND ) THEN
- EVK = ABS( T( K, K ) )
- ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
- EVK = ABS( T( K, K ) )
- ELSE
- EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
- $ SQRT( ABS( T( K, K+1 ) ) )
- END IF
-*
- IF( EVI.GE.EVK ) THEN
- I = K
- ELSE
- SORTED = .false.
- IFST = I
- ILST = K
- CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- IF( INFO.EQ.0 ) THEN
- I = ILST
- ELSE
- I = K
- END IF
- END IF
- IF( I.EQ.KEND ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- GO TO 40
- END IF
- GO TO 30
- 50 CONTINUE
- END IF
-*
-* ==== Restore shift/eigenvalue array from T ====
-*
- I = JW
- 60 CONTINUE
- IF( I.GE.INFQR+1 ) THEN
- IF( I.EQ.INFQR+1 ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE
- AA = T( I-1, I-1 )
- CC = T( I, I-1 )
- BB = T( I-1, I )
- DD = T( I, I )
- CALL SLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
- $ SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
- $ SI( KWTOP+I-1 ), CS, SN )
- I = I - 2
- END IF
- GO TO 60
- END IF
-*
- IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
- IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-* ==== Reflect spike back into lower triangle ====
-*
- CALL SCOPY( NS, V, LDV, WORK, 1 )
- BETA = WORK( 1 )
- CALL SLARFG( NS, BETA, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
- CALL SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL SLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL SLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
- $ WORK( JW+1 ) )
-*
- CALL SGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
- $ LWORK-JW, INFO )
- END IF
-*
-* ==== Copy updated reduced window into place ====
-*
- IF( KWTOP.GT.1 )
- $ H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
- CALL SLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
- CALL SCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
- $ LDH+1 )
-*
-* ==== Accumulate orthogonal matrix in order update
-* . H and Z, if requested. ====
-*
- IF( NS.GT.1 .AND. S.NE.ZERO )
- $ CALL SORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
- $ WORK( JW+1 ), LWORK-JW, INFO )
-*
-* ==== Update vertical slab in H ====
-*
- IF( WANTT ) THEN
- LTOP = 1
- ELSE
- LTOP = KTOP
- END IF
- DO 70 KROW = LTOP, KWTOP - 1, NV
- KLN = MIN( NV, KWTOP-KROW )
- CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
- $ LDH, V, LDV, ZERO, WV, LDWV )
- CALL SLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
- 70 CONTINUE
-*
-* ==== Update horizontal slab in H ====
-*
- IF( WANTT ) THEN
- DO 80 KCOL = KBOT + 1, N, NH
- KLN = MIN( NH, N-KCOL+1 )
- CALL SGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
- $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
- CALL SLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
- $ LDH )
- 80 CONTINUE
- END IF
-*
-* ==== Update vertical slab in Z ====
-*
- IF( WANTZ ) THEN
- DO 90 KROW = ILOZ, IHIZ, NV
- KLN = MIN( NV, IHIZ-KROW+1 )
- CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
- $ LDZ, V, LDV, ZERO, WV, LDWV )
- CALL SLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
- $ LDZ )
- 90 CONTINUE
- END IF
- END IF
-*
-* ==== Return the number of deflations ... ====
-*
- ND = JW - NS
-*
-* ==== ... and the number of shifts. (Subtracting
-* . INFQR from the spike length takes care
-* . of the case of a rare QR failure while
-* . calculating eigenvalues of the deflation
-* . window.) ====
-*
- NS = NS - INFQR
-*
-* ==== Return optimal workspace. ====
-*
- WORK( 1 ) = REAL( LWKOPT )
-*
-* ==== End of SLAQR3 ====
-*
- END
diff --git a/netlib/LAPACK/slaqr4.f b/netlib/LAPACK/slaqr4.f
deleted file mode 100644
index f918a9c..0000000
--- a/netlib/LAPACK/slaqr4.f
+++ /dev/null
@@ -1,742 +0,0 @@
-*> \brief \b SLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQR4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQR4 implements one level of recursion for SLAQR0.
-*> It is a complete implementation of the small bulge multi-shift
-*> QR algorithm. It may be called by SLAQR0 and, for large enough
-*> deflation window size, it may be called by SLAQR3. This
-*> subroutine is identical to SLAQR0 except that it calls SLAQR2
-*> instead of SLAQR3.
-*>
-*> SLAQR4 computes the eigenvalues of a Hessenberg matrix H
-*> and, optionally, the matrices T and Z from the Schur decomposition
-*> H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*> Schur form), and Z is the orthogonal matrix of Schur vectors.
-*>
-*> Optionally Z may be postmultiplied into an input orthogonal
-*> matrix Q so that this routine can give the Schur factorization
-*> of a matrix A which has been reduced to the Hessenberg form H
-*> by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*> previous call to SGEBAL, and then passed to SGEHRD when the
-*> matrix output by SGEBAL is reduced to Hessenberg form.
-*> Otherwise, ILO and IHI should be set to 1 and N,
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*> the upper quasi-triangular matrix T from the Schur
-*> decomposition (the Schur form); 2-by-2 diagonal blocks
-*> (corresponding to complex conjugate pairs of eigenvalues)
-*> are returned in standard form, with H(i,i) = H(i+1,i+1)
-*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*> .FALSE., then the contents of H are unspecified on exit.
-*> (The output value of H when INFO.GT.0 is given under the
-*> description of INFO below.)
-*>
-*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (IHI)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (IHI)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI)
-*> and WI(ILO:IHI). If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*> the eigenvalues are stored in the same order as on the
-*> diagonal of the Schur form returned in H, with
-*> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*> block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,IHI)
-*> If WANTZ is .FALSE., then Z is not referenced.
-*> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*> orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*> (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if WANTZ is .TRUE.
-*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension LWORK
-*> On exit, if LWORK = -1, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient, but LWORK typically as large as 6*N may
-*> be required for optimal performance. A workspace query
-*> to determine the optimal workspace size is recommended.
-*>
-*> If LWORK = -1, then SLAQR4 does a workspace query.
-*> In this case, SLAQR4 checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: if INFO = i, SLAQR4 failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is a orthogonal matrix. The final
-*> value of H is upper Hessenberg and triangular in
-*> rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*>
-*> (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of WANTT.)
-*>
-*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*>
-* =====================================================================
- SUBROUTINE SLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-*
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . SLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== Exceptional deflation windows: try to cure rare
-* . slow convergence by varying the size of the
-* . deflation window after KEXNW iterations. ====
- INTEGER KEXNW
- PARAMETER ( KEXNW = 5 )
-*
-* ==== Exceptional shifts: try to cure rare slow convergence
-* . with ad-hoc exceptional shifts every KEXSH iterations.
-* . ====
- INTEGER KEXSH
- PARAMETER ( KEXSH = 6 )
-*
-* ==== The constants WILK1 and WILK2 are used to form the
-* . exceptional shifts. ====
- REAL WILK1, WILK2
- PARAMETER ( WILK1 = 0.75e0, WILK2 = -0.4375e0 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 )
-* ..
-* .. Local Scalars ..
- REAL AA, BB, CC, CS, DD, SN, SS, SWAP
- INTEGER I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
- $ KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
- $ LWKOPT, NDEC, NDFL, NH, NHO, NIBBLE, NMIN, NS,
- $ NSMAX, NSR, NVE, NW, NWMAX, NWR, NWUPBD
- LOGICAL SORTED
- CHARACTER JBCMPZ*2
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Local Arrays ..
- REAL ZDUM( 1, 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SLAHQR, SLANV2, SLAQR2, SLAQR5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, MAX, MIN, MOD, REAL
-* ..
-* .. Executable Statements ..
- INFO = 0
-*
-* ==== Quick return for N = 0: nothing to do. ====
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
- IF( N.LE.NTINY ) THEN
-*
-* ==== Tiny matrices must use SLAHQR. ====
-*
- LWKOPT = 1
- IF( LWORK.NE.-1 )
- $ CALL SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
- ELSE
-*
-* ==== Use small bulge multi-shift QR with aggressive early
-* . deflation on larger-than-tiny matrices. ====
-*
-* ==== Hope for the best. ====
-*
- INFO = 0
-*
-* ==== Set up job flags for ILAENV. ====
-*
- IF( WANTT ) THEN
- JBCMPZ( 1: 1 ) = 'S'
- ELSE
- JBCMPZ( 1: 1 ) = 'E'
- END IF
- IF( WANTZ ) THEN
- JBCMPZ( 2: 2 ) = 'V'
- ELSE
- JBCMPZ( 2: 2 ) = 'N'
- END IF
-*
-* ==== NWR = recommended deflation window size. At this
-* . point, N .GT. NTINY = 11, so there is enough
-* . subdiagonal workspace for NWR.GE.2 as required.
-* . (In fact, there is enough subdiagonal space for
-* . NWR.GE.3.) ====
-*
- NWR = ILAENV( 13, 'SLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NWR = MAX( 2, NWR )
- NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-*
-* ==== NSR = recommended number of simultaneous shifts.
-* . At this point N .GT. NTINY = 11, so there is at
-* . enough subdiagonal workspace for NSR to be even
-* . and greater than or equal to two as required. ====
-*
- NSR = ILAENV( 15, 'SLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
- NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-* ==== Estimate optimal workspace ====
-*
-* ==== Workspace query call to SLAQR2 ====
-*
- CALL SLAQR2( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
- $ N, H, LDH, WORK, -1 )
-*
-* ==== Optimal workspace = MAX(SLAQR5, SLAQR2) ====
-*
- LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = REAL( LWKOPT )
- RETURN
- END IF
-*
-* ==== SLAHQR/SLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'SLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== Nibble crossover point ====
-*
- NIBBLE = ILAENV( 14, 'SLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NIBBLE = MAX( 0, NIBBLE )
-*
-* ==== Accumulate reflections during ttswp? Use block
-* . 2-by-2 structure during matrix-matrix multiply? ====
-*
- KACC22 = ILAENV( 16, 'SLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- KACC22 = MAX( 0, KACC22 )
- KACC22 = MIN( 2, KACC22 )
-*
-* ==== NWMAX = the largest possible deflation window for
-* . which there is sufficient workspace. ====
-*
- NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
- NW = NWMAX
-*
-* ==== NSMAX = the Largest number of simultaneous shifts
-* . for which there is sufficient workspace. ====
-*
- NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
- NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-* ==== NDFL: an iteration count restarted at deflation. ====
-*
- NDFL = 1
-*
-* ==== ITMAX = iteration limit ====
-*
- ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-* ==== Last row and column in the active block ====
-*
- KBOT = IHI
-*
-* ==== Main Loop ====
-*
- DO 80 IT = 1, ITMAX
-*
-* ==== Done when KBOT falls below ILO ====
-*
- IF( KBOT.LT.ILO )
- $ GO TO 90
-*
-* ==== Locate active block ====
-*
- DO 10 K = KBOT, ILO + 1, -1
- IF( H( K, K-1 ).EQ.ZERO )
- $ GO TO 20
- 10 CONTINUE
- K = ILO
- 20 CONTINUE
- KTOP = K
-*
-* ==== Select deflation window size:
-* . Typical Case:
-* . If possible and advisable, nibble the entire
-* . active block. If not, use size MIN(NWR,NWMAX)
-* . or MIN(NWR+1,NWMAX) depending upon which has
-* . the smaller corresponding subdiagonal entry
-* . (a heuristic).
-* .
-* . Exceptional Case:
-* . If there have been no deflations in KEXNW or
-* . more iterations, then vary the deflation window
-* . size. At first, because, larger windows are,
-* . in general, more powerful than smaller ones,
-* . rapidly increase the window to the maximum possible.
-* . Then, gradually reduce the window size. ====
-*
- NH = KBOT - KTOP + 1
- NWUPBD = MIN( NH, NWMAX )
- IF( NDFL.LT.KEXNW ) THEN
- NW = MIN( NWUPBD, NWR )
- ELSE
- NW = MIN( NWUPBD, 2*NW )
- END IF
- IF( NW.LT.NWMAX ) THEN
- IF( NW.GE.NH-1 ) THEN
- NW = NH
- ELSE
- KWTOP = KBOT - NW + 1
- IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
- $ ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
- END IF
- END IF
- IF( NDFL.LT.KEXNW ) THEN
- NDEC = -1
- ELSE IF( NDEC.GE.0 .OR. NW.GE.NWUPBD ) THEN
- NDEC = NDEC + 1
- IF( NW-NDEC.LT.2 )
- $ NDEC = 0
- NW = NW - NDEC
- END IF
-*
-* ==== Aggressive early deflation:
-* . split workspace under the subdiagonal into
-* . - an nw-by-nw work array V in the lower
-* . left-hand-corner,
-* . - an NW-by-at-least-NW-but-more-is-better
-* . (NW-by-NHO) horizontal work array along
-* . the bottom edge,
-* . - an at-least-NW-but-more-is-better (NHV-by-NW)
-* . vertical work array along the left-hand-edge.
-* . ====
-*
- KV = N - NW + 1
- KT = NW + 1
- NHO = ( N-NW-1 ) - KT + 1
- KWV = NW + 2
- NVE = ( N-NW ) - KWV + 1
-*
-* ==== Aggressive early deflation ====
-*
- CALL SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
- $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
- $ WORK, LWORK )
-*
-* ==== Adjust KBOT accounting for new deflations. ====
-*
- KBOT = KBOT - LD
-*
-* ==== KS points to the shifts. ====
-*
- KS = KBOT - LS + 1
-*
-* ==== Skip an expensive QR sweep if there is a (partly
-* . heuristic) reason to expect that many eigenvalues
-* . will deflate without it. Here, the QR sweep is
-* . skipped if many eigenvalues have just been deflated
-* . or if the remaining active block is small.
-*
- IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
- $ KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-* ==== NS = nominal number of simultaneous shifts.
-* . This may be lowered (slightly) if SLAQR2
-* . did not provide that many shifts. ====
-*
- NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
- NS = NS - MOD( NS, 2 )
-*
-* ==== If there have been no deflations
-* . in a multiple of KEXSH iterations,
-* . then try exceptional shifts.
-* . Otherwise use shifts provided by
-* . SLAQR2 above or from the eigenvalues
-* . of a trailing principal submatrix. ====
-*
- IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
- KS = KBOT - NS + 1
- DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
- SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- AA = WILK1*SS + H( I, I )
- BB = SS
- CC = WILK2*SS
- DD = AA
- CALL SLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
- $ WR( I ), WI( I ), CS, SN )
- 30 CONTINUE
- IF( KS.EQ.KTOP ) THEN
- WR( KS+1 ) = H( KS+1, KS+1 )
- WI( KS+1 ) = ZERO
- WR( KS ) = WR( KS+1 )
- WI( KS ) = WI( KS+1 )
- END IF
- ELSE
-*
-* ==== Got NS/2 or fewer shifts? Use SLAHQR
-* . on a trailing principal submatrix to
-* . get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-* . there is enough space below the subdiagonal
-* . to fit an NS-by-NS scratch array.) ====
-*
- IF( KBOT-KS+1.LE.NS / 2 ) THEN
- KS = KBOT - NS + 1
- KT = N - NS + 1
- CALL SLACPY( 'A', NS, NS, H( KS, KS ), LDH,
- $ H( KT, 1 ), LDH )
- CALL SLAHQR( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ), WI( KS ),
- $ 1, 1, ZDUM, 1, INF )
- KS = KS + INF
-*
-* ==== In case of a rare QR failure use
-* . eigenvalues of the trailing 2-by-2
-* . principal submatrix. ====
-*
- IF( KS.GE.KBOT ) THEN
- AA = H( KBOT-1, KBOT-1 )
- CC = H( KBOT, KBOT-1 )
- BB = H( KBOT-1, KBOT )
- DD = H( KBOT, KBOT )
- CALL SLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
- $ WI( KBOT-1 ), WR( KBOT ),
- $ WI( KBOT ), CS, SN )
- KS = KBOT - 1
- END IF
- END IF
-*
- IF( KBOT-KS+1.GT.NS ) THEN
-*
-* ==== Sort the shifts (Helps a little)
-* . Bubble sort keeps complex conjugate
-* . pairs together. ====
-*
- SORTED = .false.
- DO 50 K = KBOT, KS + 1, -1
- IF( SORTED )
- $ GO TO 60
- SORTED = .true.
- DO 40 I = KS, K - 1
- IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
- $ ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
- SORTED = .false.
-*
- SWAP = WR( I )
- WR( I ) = WR( I+1 )
- WR( I+1 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I+1 )
- WI( I+1 ) = SWAP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* ==== Shuffle shifts into pairs of real shifts
-* . and pairs of complex conjugate shifts
-* . assuming complex conjugate shifts are
-* . already adjacent to one another. (Yes,
-* . they are.) ====
-*
- DO 70 I = KBOT, KS + 2, -2
- IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
- SWAP = WR( I )
- WR( I ) = WR( I-1 )
- WR( I-1 ) = WR( I-2 )
- WR( I-2 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I-1 )
- WI( I-1 ) = WI( I-2 )
- WI( I-2 ) = SWAP
- END IF
- 70 CONTINUE
- END IF
-*
-* ==== If there are only two shifts and both are
-* . real, then use only one. ====
-*
- IF( KBOT-KS+1.EQ.2 ) THEN
- IF( WI( KBOT ).EQ.ZERO ) THEN
- IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
- $ ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
- WR( KBOT-1 ) = WR( KBOT )
- ELSE
- WR( KBOT ) = WR( KBOT-1 )
- END IF
- END IF
- END IF
-*
-* ==== Use up to NS of the the smallest magnatiude
-* . shifts. If there aren't NS shifts available,
-* . then use them all, possibly dropping one to
-* . make the number of shifts even. ====
-*
- NS = MIN( NS, KBOT-KS+1 )
- NS = NS - MOD( NS, 2 )
- KS = KBOT - NS + 1
-*
-* ==== Small-bulge multi-shift QR sweep:
-* . split workspace under the subdiagonal into
-* . - a KDU-by-KDU work array U in the lower
-* . left-hand-corner,
-* . - a KDU-by-at-least-KDU-but-more-is-better
-* . (KDU-by-NHo) horizontal work array WH along
-* . the bottom edge,
-* . - and an at-least-KDU-but-more-is-better-by-KDU
-* . (NVE-by-KDU) vertical work WV arrow along
-* . the left-hand-edge. ====
-*
- KDU = 3*NS - 3
- KU = N - KDU + 1
- KWH = KDU + 1
- NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
- KWV = KDU + 4
- NVE = N - KDU - KWV + 1
-*
-* ==== Small-bulge multi-shift QR sweep ====
-*
- CALL SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
- $ WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
- $ LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
- $ H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
- END IF
-*
-* ==== Note progress (or the lack of it). ====
-*
- IF( LD.GT.0 ) THEN
- NDFL = 1
- ELSE
- NDFL = NDFL + 1
- END IF
-*
-* ==== End of main loop ====
- 80 CONTINUE
-*
-* ==== Iteration limit exceeded. Set INFO to show where
-* . the problem occurred and exit. ====
-*
- INFO = KBOT
- 90 CONTINUE
- END IF
-*
-* ==== Return the optimal value of LWORK. ====
-*
- WORK( 1 ) = REAL( LWKOPT )
-*
-* ==== End of SLAQR4 ====
-*
- END
diff --git a/netlib/LAPACK/slaqr5.f b/netlib/LAPACK/slaqr5.f
deleted file mode 100644
index 6a29974..0000000
--- a/netlib/LAPACK/slaqr5.f
+++ /dev/null
@@ -1,921 +0,0 @@
-*> \brief \b SLAQR5 performs a single small-bulge multi-shift QR sweep.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQR5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
-* SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
-* LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
-* $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* REAL H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
-* $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQR5, called by SLAQR0, performs a
-*> single small-bulge multi-shift QR sweep.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is logical scalar
-*> WANTT = .true. if the quasi-triangular Schur factor
-*> is being computed. WANTT is set to .false. otherwise.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is logical scalar
-*> WANTZ = .true. if the orthogonal Schur factor is being
-*> computed. WANTZ is set to .false. otherwise.
-*> \endverbatim
-*>
-*> \param[in] KACC22
-*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
-*> Specifies the computation mode of far-from-diagonal
-*> orthogonal updates.
-*> = 0: SLAQR5 does not accumulate reflections and does not
-*> use matrix-matrix multiply to update far-from-diagonal
-*> matrix entries.
-*> = 1: SLAQR5 accumulates reflections and uses matrix-matrix
-*> multiply to update the far-from-diagonal matrix entries.
-*> = 2: SLAQR5 accumulates reflections, uses matrix-matrix
-*> multiply to update the far-from-diagonal matrix entries,
-*> and takes advantage of 2-by-2 block structure during
-*> matrix multiplies.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is integer scalar
-*> N is the order of the Hessenberg matrix H upon which this
-*> subroutine operates.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is integer scalar
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is integer scalar
-*> These are the first and last rows and columns of an
-*> isolated diagonal block upon which the QR sweep is to be
-*> applied. It is assumed without a check that
-*> either KTOP = 1 or H(KTOP,KTOP-1) = 0
-*> and
-*> either KBOT = N or H(KBOT+1,KBOT) = 0.
-*> \endverbatim
-*>
-*> \param[in] NSHFTS
-*> \verbatim
-*> NSHFTS is integer scalar
-*> NSHFTS gives the number of simultaneous shifts. NSHFTS
-*> must be positive and even.
-*> \endverbatim
-*>
-*> \param[in,out] SR
-*> \verbatim
-*> SR is REAL array of size (NSHFTS)
-*> \endverbatim
-*>
-*> \param[in,out] SI
-*> \verbatim
-*> SI is REAL array of size (NSHFTS)
-*> SR contains the real parts and SI contains the imaginary
-*> parts of the NSHFTS shifts of origin that define the
-*> multi-shift QR sweep. On output SR and SI may be
-*> reordered.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is REAL array of size (LDH,N)
-*> On input H contains a Hessenberg matrix. On output a
-*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
-*> to the isolated diagonal block in rows and columns KTOP
-*> through KBOT.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer scalar
-*> LDH is the leading dimension of H just as declared in the
-*> calling procedure. LDH.GE.MAX(1,N).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array of size (LDZ,IHI)
-*> If WANTZ = .TRUE., then the QR Sweep orthogonal
-*> similarity transformation is accumulated into
-*> Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ = .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer scalar
-*> LDA is the leading dimension of Z just as declared in
-*> the calling procedure. LDZ.GE.N.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is REAL array of size (LDV,NSHFTS/2)
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> LDV is the leading dimension of V as declared in the
-*> calling procedure. LDV.GE.3.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array of size
-*> (LDU,3*NSHFTS-3)
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is integer scalar
-*> LDU is the leading dimension of U just as declared in the
-*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> NH is the number of columns in array WH available for
-*> workspace. NH.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WH
-*> \verbatim
-*> WH is REAL array of size (LDWH,NH)
-*> \endverbatim
-*>
-*> \param[in] LDWH
-*> \verbatim
-*> LDWH is integer scalar
-*> Leading dimension of WH just as declared in the
-*> calling procedure. LDWH.GE.3*NSHFTS-3.
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer scalar
-*> NV is the number of rows in WV agailable for workspace.
-*> NV.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is REAL array of size
-*> (LDWV,3*NSHFTS-3)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer scalar
-*> LDWV is the leading dimension of WV as declared in the
-*> in the calling subroutine. LDWV.GE.NV.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*>
-* =====================================================================
- SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
- $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
- $ LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
- $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- REAL H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
- $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 )
-* ..
-* .. Local Scalars ..
- REAL ALPHA, BETA, H11, H12, H21, H22, REFSUM,
- $ SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2,
- $ ULP
- INTEGER I, I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN,
- $ JROW, JTOP, K, K1, KDU, KMS, KNZ, KRCOL, KZS,
- $ M, M22, MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL,
- $ NS, NU
- LOGICAL ACCUM, BLK22, BMP22
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
-*
- INTRINSIC ABS, MAX, MIN, MOD, REAL
-* ..
-* .. Local Arrays ..
- REAL VT( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLABAD, SLACPY, SLAQR1, SLARFG, SLASET,
- $ STRMM
-* ..
-* .. Executable Statements ..
-*
-* ==== If there are no shifts, then there is nothing to do. ====
-*
- IF( NSHFTS.LT.2 )
- $ RETURN
-*
-* ==== If the active block is empty or 1-by-1, then there
-* . is nothing to do. ====
-*
- IF( KTOP.GE.KBOT )
- $ RETURN
-*
-* ==== Shuffle shifts into pairs of real shifts and pairs
-* . of complex conjugate shifts assuming complex
-* . conjugate shifts are already adjacent to one
-* . another. ====
-*
- DO 10 I = 1, NSHFTS - 2, 2
- IF( SI( I ).NE.-SI( I+1 ) ) THEN
-*
- SWAP = SR( I )
- SR( I ) = SR( I+1 )
- SR( I+1 ) = SR( I+2 )
- SR( I+2 ) = SWAP
-*
- SWAP = SI( I )
- SI( I ) = SI( I+1 )
- SI( I+1 ) = SI( I+2 )
- SI( I+2 ) = SWAP
- END IF
- 10 CONTINUE
-*
-* ==== NSHFTS is supposed to be even, but if it is odd,
-* . then simply reduce it by one. The shuffle above
-* . ensures that the dropped shift is real and that
-* . the remaining shifts are paired. ====
-*
- NS = NSHFTS - MOD( NSHFTS, 2 )
-*
-* ==== Machine constants for deflation ====
-*
- SAFMIN = SLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL SLABAD( SAFMIN, SAFMAX )
- ULP = SLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( REAL( N ) / ULP )
-*
-* ==== Use accumulated reflections to update far-from-diagonal
-* . entries ? ====
-*
- ACCUM = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )
-*
-* ==== If so, exploit the 2-by-2 block structure? ====
-*
- BLK22 = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )
-*
-* ==== clear trash ====
-*
- IF( KTOP+2.LE.KBOT )
- $ H( KTOP+2, KTOP ) = ZERO
-*
-* ==== NBMPS = number of 2-shift bulges in the chain ====
-*
- NBMPS = NS / 2
-*
-* ==== KDU = width of slab ====
-*
- KDU = 6*NBMPS - 3
-*
-* ==== Create and chase chains of NBMPS bulges ====
-*
- DO 220 INCOL = 3*( 1-NBMPS ) + KTOP - 1, KBOT - 2, 3*NBMPS - 2
- NDCOL = INCOL + KDU
- IF( ACCUM )
- $ CALL SLASET( 'ALL', KDU, KDU, ZERO, ONE, U, LDU )
-*
-* ==== Near-the-diagonal bulge chase. The following loop
-* . performs the near-the-diagonal part of a small bulge
-* . multi-shift QR sweep. Each 6*NBMPS-2 column diagonal
-* . chunk extends from column INCOL to column NDCOL
-* . (including both column INCOL and column NDCOL). The
-* . following loop chases a 3*NBMPS column long chain of
-* . NBMPS bulges 3*NBMPS-2 columns to the right. (INCOL
-* . may be less than KTOP and and NDCOL may be greater than
-* . KBOT indicating phantom columns from which to chase
-* . bulges before they are actually introduced or to which
-* . to chase bulges beyond column KBOT.) ====
-*
- DO 150 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )
-*
-* ==== Bulges number MTOP to MBOT are active double implicit
-* . shift bulges. There may or may not also be small
-* . 2-by-2 bulge, if there is room. The inactive bulges
-* . (if any) must wait until the active bulges have moved
-* . down the diagonal to make room. The phantom matrix
-* . paradigm described above helps keep track. ====
-*
- MTOP = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )
- MBOT = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )
- M22 = MBOT + 1
- BMP22 = ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ.
- $ ( KBOT-2 )
-*
-* ==== Generate reflections to chase the chain right
-* . one column. (The minimum value of K is KTOP-1.) ====
-*
- DO 20 M = MTOP, MBOT
- K = KRCOL + 3*( M-1 )
- IF( K.EQ.KTOP-1 ) THEN
- CALL SLAQR1( 3, H( KTOP, KTOP ), LDH, SR( 2*M-1 ),
- $ SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
- $ V( 1, M ) )
- ALPHA = V( 1, M )
- CALL SLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )
- ELSE
- BETA = H( K+1, K )
- V( 2, M ) = H( K+2, K )
- V( 3, M ) = H( K+3, K )
- CALL SLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )
-*
-* ==== A Bulge may collapse because of vigilant
-* . deflation or destructive underflow. In the
-* . underflow case, try the two-small-subdiagonals
-* . trick to try to reinflate the bulge. ====
-*
- IF( H( K+3, K ).NE.ZERO .OR. H( K+3, K+1 ).NE.
- $ ZERO .OR. H( K+3, K+2 ).EQ.ZERO ) THEN
-*
-* ==== Typical case: not collapsed (yet). ====
-*
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- ELSE
-*
-* ==== Atypical case: collapsed. Attempt to
-* . reintroduce ignoring H(K+1,K) and H(K+2,K).
-* . If the fill resulting from the new
-* . reflector is too large, then abandon it.
-* . Otherwise, use the new one. ====
-*
- CALL SLAQR1( 3, H( K+1, K+1 ), LDH, SR( 2*M-1 ),
- $ SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
- $ VT )
- ALPHA = VT( 1 )
- CALL SLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
- REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
- $ H( K+2, K ) )
-*
- IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
- $ ABS( REFSUM*VT( 3 ) ).GT.ULP*
- $ ( ABS( H( K, K ) )+ABS( H( K+1,
- $ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
-*
-* ==== Starting a new bulge here would
-* . create non-negligible fill. Use
-* . the old one with trepidation. ====
-*
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- ELSE
-*
-* ==== Stating a new bulge here would
-* . create only negligible fill.
-* . Replace the old reflector with
-* . the new one. ====
-*
- H( K+1, K ) = H( K+1, K ) - REFSUM
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- V( 1, M ) = VT( 1 )
- V( 2, M ) = VT( 2 )
- V( 3, M ) = VT( 3 )
- END IF
- END IF
- END IF
- 20 CONTINUE
-*
-* ==== Generate a 2-by-2 reflection, if needed. ====
-*
- K = KRCOL + 3*( M22-1 )
- IF( BMP22 ) THEN
- IF( K.EQ.KTOP-1 ) THEN
- CALL SLAQR1( 2, H( K+1, K+1 ), LDH, SR( 2*M22-1 ),
- $ SI( 2*M22-1 ), SR( 2*M22 ), SI( 2*M22 ),
- $ V( 1, M22 ) )
- BETA = V( 1, M22 )
- CALL SLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
- ELSE
- BETA = H( K+1, K )
- V( 2, M22 ) = H( K+2, K )
- CALL SLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- END IF
- END IF
-*
-* ==== Multiply H by reflections from the left ====
-*
- IF( ACCUM ) THEN
- JBOT = MIN( NDCOL, KBOT )
- ELSE IF( WANTT ) THEN
- JBOT = N
- ELSE
- JBOT = KBOT
- END IF
- DO 40 J = MAX( KTOP, KRCOL ), JBOT
- MEND = MIN( MBOT, ( J-KRCOL+2 ) / 3 )
- DO 30 M = MTOP, MEND
- K = KRCOL + 3*( M-1 )
- REFSUM = V( 1, M )*( H( K+1, J )+V( 2, M )*
- $ H( K+2, J )+V( 3, M )*H( K+3, J ) )
- H( K+1, J ) = H( K+1, J ) - REFSUM
- H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
- H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
- 30 CONTINUE
- 40 CONTINUE
- IF( BMP22 ) THEN
- K = KRCOL + 3*( M22-1 )
- DO 50 J = MAX( K+1, KTOP ), JBOT
- REFSUM = V( 1, M22 )*( H( K+1, J )+V( 2, M22 )*
- $ H( K+2, J ) )
- H( K+1, J ) = H( K+1, J ) - REFSUM
- H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
- 50 CONTINUE
- END IF
-*
-* ==== Multiply H by reflections from the right.
-* . Delay filling in the last row until the
-* . vigilant deflation check is complete. ====
-*
- IF( ACCUM ) THEN
- JTOP = MAX( KTOP, INCOL )
- ELSE IF( WANTT ) THEN
- JTOP = 1
- ELSE
- JTOP = KTOP
- END IF
- DO 90 M = MTOP, MBOT
- IF( V( 1, M ).NE.ZERO ) THEN
- K = KRCOL + 3*( M-1 )
- DO 60 J = JTOP, MIN( KBOT, K+3 )
- REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )*
- $ H( J, K+2 )+V( 3, M )*H( J, K+3 ) )
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
- H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M )
- H( J, K+3 ) = H( J, K+3 ) - REFSUM*V( 3, M )
- 60 CONTINUE
-*
- IF( ACCUM ) THEN
-*
-* ==== Accumulate U. (If necessary, update Z later
-* . with with an efficient matrix-matrix
-* . multiply.) ====
-*
- KMS = K - INCOL
- DO 70 J = MAX( 1, KTOP-INCOL ), KDU
- REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )*
- $ U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M )
- U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*V( 3, M )
- 70 CONTINUE
- ELSE IF( WANTZ ) THEN
-*
-* ==== U is not accumulated, so update Z
-* . now by multiplying by reflections
-* . from the right. ====
-*
- DO 80 J = ILOZ, IHIZ
- REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )*
- $ Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M )
- Z( J, K+3 ) = Z( J, K+3 ) - REFSUM*V( 3, M )
- 80 CONTINUE
- END IF
- END IF
- 90 CONTINUE
-*
-* ==== Special case: 2-by-2 reflection (if needed) ====
-*
- K = KRCOL + 3*( M22-1 )
- IF( BMP22 ) THEN
- IF ( V( 1, M22 ).NE.ZERO ) THEN
- DO 100 J = JTOP, MIN( KBOT, K+3 )
- REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
- $ H( J, K+2 ) )
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
- H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )
- 100 CONTINUE
-*
- IF( ACCUM ) THEN
- KMS = K - INCOL
- DO 110 J = MAX( 1, KTOP-INCOL ), KDU
- REFSUM = V( 1, M22 )*( U( J, KMS+1 )+
- $ V( 2, M22 )*U( J, KMS+2 ) )
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*
- $ V( 2, M22 )
- 110 CONTINUE
- ELSE IF( WANTZ ) THEN
- DO 120 J = ILOZ, IHIZ
- REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*
- $ Z( J, K+2 ) )
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )
- 120 CONTINUE
- END IF
- END IF
- END IF
-*
-* ==== Vigilant deflation check ====
-*
- MSTART = MTOP
- IF( KRCOL+3*( MSTART-1 ).LT.KTOP )
- $ MSTART = MSTART + 1
- MEND = MBOT
- IF( BMP22 )
- $ MEND = MEND + 1
- IF( KRCOL.EQ.KBOT-2 )
- $ MEND = MEND + 1
- DO 130 M = MSTART, MEND
- K = MIN( KBOT-1, KRCOL+3*( M-1 ) )
-*
-* ==== The following convergence test requires that
-* . the tradition small-compared-to-nearby-diagonals
-* . criterion and the Ahues & Tisseur (LAWN 122, 1997)
-* . criteria both be satisfied. The latter improves
-* . accuracy in some examples. Falling back on an
-* . alternate convergence criterion when TST1 or TST2
-* . is zero (as done here) is traditional but probably
-* . unnecessary. ====
-*
- IF( H( K+1, K ).NE.ZERO ) THEN
- TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
- IF( TST1.EQ.ZERO ) THEN
- IF( K.GE.KTOP+1 )
- $ TST1 = TST1 + ABS( H( K, K-1 ) )
- IF( K.GE.KTOP+2 )
- $ TST1 = TST1 + ABS( H( K, K-2 ) )
- IF( K.GE.KTOP+3 )
- $ TST1 = TST1 + ABS( H( K, K-3 ) )
- IF( K.LE.KBOT-2 )
- $ TST1 = TST1 + ABS( H( K+2, K+1 ) )
- IF( K.LE.KBOT-3 )
- $ TST1 = TST1 + ABS( H( K+3, K+1 ) )
- IF( K.LE.KBOT-4 )
- $ TST1 = TST1 + ABS( H( K+4, K+1 ) )
- END IF
- IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
- $ THEN
- H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
- H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
- H11 = MAX( ABS( H( K+1, K+1 ) ),
- $ ABS( H( K, K )-H( K+1, K+1 ) ) )
- H22 = MIN( ABS( H( K+1, K+1 ) ),
- $ ABS( H( K, K )-H( K+1, K+1 ) ) )
- SCL = H11 + H12
- TST2 = H22*( H11 / SCL )
-*
- IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
- $ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
- END IF
- END IF
- 130 CONTINUE
-*
-* ==== Fill in the last row of each bulge. ====
-*
- MEND = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
- DO 140 M = MTOP, MEND
- K = KRCOL + 3*( M-1 )
- REFSUM = V( 1, M )*V( 3, M )*H( K+4, K+3 )
- H( K+4, K+1 ) = -REFSUM
- H( K+4, K+2 ) = -REFSUM*V( 2, M )
- H( K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*V( 3, M )
- 140 CONTINUE
-*
-* ==== End of near-the-diagonal bulge chase. ====
-*
- 150 CONTINUE
-*
-* ==== Use U (if accumulated) to update far-from-diagonal
-* . entries in H. If required, use U to update Z as
-* . well. ====
-*
- IF( ACCUM ) THEN
- IF( WANTT ) THEN
- JTOP = 1
- JBOT = N
- ELSE
- JTOP = KTOP
- JBOT = KBOT
- END IF
- IF( ( .NOT.BLK22 ) .OR. ( INCOL.LT.KTOP ) .OR.
- $ ( NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN
-*
-* ==== Updates not exploiting the 2-by-2 block
-* . structure of U. K1 and NU keep track of
-* . the location and size of U in the special
-* . cases of introducing bulges and chasing
-* . bulges off the bottom. In these special
-* . cases and in case the number of shifts
-* . is NS = 2, there is no 2-by-2 block
-* . structure to exploit. ====
-*
- K1 = MAX( 1, KTOP-INCOL )
- NU = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1
-*
-* ==== Horizontal Multiply ====
-*
- DO 160 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
- JLEN = MIN( NH, JBOT-JCOL+1 )
- CALL SGEMM( 'C', 'N', NU, JLEN, NU, ONE, U( K1, K1 ),
- $ LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH,
- $ LDWH )
- CALL SLACPY( 'ALL', NU, JLEN, WH, LDWH,
- $ H( INCOL+K1, JCOL ), LDH )
- 160 CONTINUE
-*
-* ==== Vertical multiply ====
-*
- DO 170 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV
- JLEN = MIN( NV, MAX( KTOP, INCOL )-JROW )
- CALL SGEMM( 'N', 'N', JLEN, NU, NU, ONE,
- $ H( JROW, INCOL+K1 ), LDH, U( K1, K1 ),
- $ LDU, ZERO, WV, LDWV )
- CALL SLACPY( 'ALL', JLEN, NU, WV, LDWV,
- $ H( JROW, INCOL+K1 ), LDH )
- 170 CONTINUE
-*
-* ==== Z multiply (also vertical) ====
-*
- IF( WANTZ ) THEN
- DO 180 JROW = ILOZ, IHIZ, NV
- JLEN = MIN( NV, IHIZ-JROW+1 )
- CALL SGEMM( 'N', 'N', JLEN, NU, NU, ONE,
- $ Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ),
- $ LDU, ZERO, WV, LDWV )
- CALL SLACPY( 'ALL', JLEN, NU, WV, LDWV,
- $ Z( JROW, INCOL+K1 ), LDZ )
- 180 CONTINUE
- END IF
- ELSE
-*
-* ==== Updates exploiting U's 2-by-2 block structure.
-* . (I2, I4, J2, J4 are the last rows and columns
-* . of the blocks.) ====
-*
- I2 = ( KDU+1 ) / 2
- I4 = KDU
- J2 = I4 - I2
- J4 = KDU
-*
-* ==== KZS and KNZ deal with the band of zeros
-* . along the diagonal of one of the triangular
-* . blocks. ====
-*
- KZS = ( J4-J2 ) - ( NS+1 )
- KNZ = NS + 1
-*
-* ==== Horizontal multiply ====
-*
- DO 190 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
- JLEN = MIN( NH, JBOT-JCOL+1 )
-*
-* ==== Copy bottom of H to top+KZS of scratch ====
-* (The first KZS rows get multiplied by zero.) ====
-*
- CALL SLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),
- $ LDH, WH( KZS+1, 1 ), LDWH )
-*
-* ==== Multiply by U21**T ====
-*
- CALL SLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
- CALL STRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,
- $ U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
- $ LDWH )
-*
-* ==== Multiply top of H by U11**T ====
-*
- CALL SGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,
- $ H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
-*
-* ==== Copy top of H to bottom of WH ====
-*
- CALL SLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,
- $ WH( I2+1, 1 ), LDWH )
-*
-* ==== Multiply by U21**T ====
-*
- CALL STRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,
- $ U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
-*
-* ==== Multiply by U22 ====
-*
- CALL SGEMM( 'C', 'N', I4-I2, JLEN, J4-J2, ONE,
- $ U( J2+1, I2+1 ), LDU,
- $ H( INCOL+1+J2, JCOL ), LDH, ONE,
- $ WH( I2+1, 1 ), LDWH )
-*
-* ==== Copy it back ====
-*
- CALL SLACPY( 'ALL', KDU, JLEN, WH, LDWH,
- $ H( INCOL+1, JCOL ), LDH )
- 190 CONTINUE
-*
-* ==== Vertical multiply ====
-*
- DO 200 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
- JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )
-*
-* ==== Copy right of H to scratch (the first KZS
-* . columns get multiplied by zero) ====
-*
- CALL SLACPY( 'ALL', JLEN, KNZ, H( JROW, INCOL+1+J2 ),
- $ LDH, WV( 1, 1+KZS ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL SLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
- CALL STRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
- $ U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
- $ LDWV )
-*
-* ==== Multiply by U11 ====
-*
- CALL SGEMM( 'N', 'N', JLEN, I2, J2, ONE,
- $ H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV,
- $ LDWV )
-*
-* ==== Copy left of H to right of scratch ====
-*
- CALL SLACPY( 'ALL', JLEN, J2, H( JROW, INCOL+1 ), LDH,
- $ WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL STRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
- $ U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U22 ====
-*
- CALL SGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
- $ H( JROW, INCOL+1+J2 ), LDH,
- $ U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ),
- $ LDWV )
-*
-* ==== Copy it back ====
-*
- CALL SLACPY( 'ALL', JLEN, KDU, WV, LDWV,
- $ H( JROW, INCOL+1 ), LDH )
- 200 CONTINUE
-*
-* ==== Multiply Z (also vertical) ====
-*
- IF( WANTZ ) THEN
- DO 210 JROW = ILOZ, IHIZ, NV
- JLEN = MIN( NV, IHIZ-JROW+1 )
-*
-* ==== Copy right of Z to left of scratch (first
-* . KZS columns get multiplied by zero) ====
-*
- CALL SLACPY( 'ALL', JLEN, KNZ,
- $ Z( JROW, INCOL+1+J2 ), LDZ,
- $ WV( 1, 1+KZS ), LDWV )
-*
-* ==== Multiply by U12 ====
-*
- CALL SLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV,
- $ LDWV )
- CALL STRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
- $ U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
- $ LDWV )
-*
-* ==== Multiply by U11 ====
-*
- CALL SGEMM( 'N', 'N', JLEN, I2, J2, ONE,
- $ Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE,
- $ WV, LDWV )
-*
-* ==== Copy left of Z to right of scratch ====
-*
- CALL SLACPY( 'ALL', JLEN, J2, Z( JROW, INCOL+1 ),
- $ LDZ, WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL STRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
- $ U( 1, I2+1 ), LDU, WV( 1, 1+I2 ),
- $ LDWV )
-*
-* ==== Multiply by U22 ====
-*
- CALL SGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
- $ Z( JROW, INCOL+1+J2 ), LDZ,
- $ U( J2+1, I2+1 ), LDU, ONE,
- $ WV( 1, 1+I2 ), LDWV )
-*
-* ==== Copy the result back to Z ====
-*
- CALL SLACPY( 'ALL', JLEN, KDU, WV, LDWV,
- $ Z( JROW, INCOL+1 ), LDZ )
- 210 CONTINUE
- END IF
- END IF
- END IF
- 220 CONTINUE
-*
-* ==== End of SLAQR5 ====
-*
- END
diff --git a/netlib/LAPACK/slaqsb.f b/netlib/LAPACK/slaqsb.f
deleted file mode 100644
index 42a117f..0000000
--- a/netlib/LAPACK/slaqsb.f
+++ /dev/null
@@ -1,226 +0,0 @@
-*> \brief \b SLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQSB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqsb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqsb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqsb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, UPLO
-* INTEGER KD, LDAB, N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQSB equilibrates a symmetric band matrix A using the scaling
-*> factors in the vector S.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> The scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> Ratio of the smallest S(i) to the largest S(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies whether or not equilibration was done.
-*> = 'N': No equilibration.
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if scaling should be done
-*> based on the ratio of the scaling factors. If SCOND < THRESH,
-*> scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if scaling should
-*> be done based on the absolute size of the largest matrix element.
-*> If AMAX > LARGE or AMAX < SMALL, scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, UPLO
- INTEGER KD, LDAB, N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, THRESH
- PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
-*
-* No equilibration
-*
- EQUED = 'N'
- ELSE
-*
-* Replace A by diag(S) * A * diag(S).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Upper triangle of A is stored in band format.
-*
- DO 20 J = 1, N
- CJ = S( J )
- DO 10 I = MAX( 1, J-KD ), J
- AB( KD+1+I-J, J ) = CJ*S( I )*AB( KD+1+I-J, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
-*
-* Lower triangle of A is stored.
-*
- DO 40 J = 1, N
- CJ = S( J )
- DO 30 I = J, MIN( N, J+KD )
- AB( 1+I-J, J ) = CJ*S( I )*AB( 1+I-J, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- EQUED = 'Y'
- END IF
-*
- RETURN
-*
-* End of SLAQSB
-*
- END
diff --git a/netlib/LAPACK/slaqsp.f b/netlib/LAPACK/slaqsp.f
deleted file mode 100644
index ac5842e..0000000
--- a/netlib/LAPACK/slaqsp.f
+++ /dev/null
@@ -1,212 +0,0 @@
-*> \brief \b SLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQSP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqsp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqsp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqsp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, UPLO
-* INTEGER N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQSP equilibrates a symmetric matrix A using the scaling factors
-*> in the vector S.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the equilibrated matrix: diag(S) * A * diag(S), in
-*> the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> The scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> Ratio of the smallest S(i) to the largest S(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies whether or not equilibration was done.
-*> = 'N': No equilibration.
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if scaling should be done
-*> based on the ratio of the scaling factors. If SCOND < THRESH,
-*> scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if scaling should
-*> be done based on the absolute size of the largest matrix element.
-*> If AMAX > LARGE or AMAX < SMALL, scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, UPLO
- INTEGER N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL AP( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, THRESH
- PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, JC
- REAL CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
-*
-* No equilibration
-*
- EQUED = 'N'
- ELSE
-*
-* Replace A by diag(S) * A * diag(S).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Upper triangle of A is stored.
-*
- JC = 1
- DO 20 J = 1, N
- CJ = S( J )
- DO 10 I = 1, J
- AP( JC+I-1 ) = CJ*S( I )*AP( JC+I-1 )
- 10 CONTINUE
- JC = JC + J
- 20 CONTINUE
- ELSE
-*
-* Lower triangle of A is stored.
-*
- JC = 1
- DO 40 J = 1, N
- CJ = S( J )
- DO 30 I = J, N
- AP( JC+I-J ) = CJ*S( I )*AP( JC+I-J )
- 30 CONTINUE
- JC = JC + N - J + 1
- 40 CONTINUE
- END IF
- EQUED = 'Y'
- END IF
-*
- RETURN
-*
-* End of SLAQSP
-*
- END
diff --git a/netlib/LAPACK/slaqsy.f b/netlib/LAPACK/slaqsy.f
deleted file mode 100644
index 86d21d7..0000000
--- a/netlib/LAPACK/slaqsy.f
+++ /dev/null
@@ -1,216 +0,0 @@
-*> \brief \b SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQSY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqsy.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqsy.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqsy.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, UPLO
-* INTEGER LDA, N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQSY equilibrates a symmetric matrix A using the scaling factors
-*> in the vector S.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if EQUED = 'Y', the equilibrated matrix:
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(N,1).
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> The scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> Ratio of the smallest S(i) to the largest S(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies whether or not equilibration was done.
-*> = 'N': No equilibration.
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if scaling should be done
-*> based on the ratio of the scaling factors. If SCOND < THRESH,
-*> scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if scaling should
-*> be done based on the absolute size of the largest matrix element.
-*> If AMAX > LARGE or AMAX < SMALL, scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, UPLO
- INTEGER LDA, N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, THRESH
- PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- REAL CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
-*
-* No equilibration
-*
- EQUED = 'N'
- ELSE
-*
-* Replace A by diag(S) * A * diag(S).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Upper triangle of A is stored.
-*
- DO 20 J = 1, N
- CJ = S( J )
- DO 10 I = 1, J
- A( I, J ) = CJ*S( I )*A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
-*
-* Lower triangle of A is stored.
-*
- DO 40 J = 1, N
- CJ = S( J )
- DO 30 I = J, N
- A( I, J ) = CJ*S( I )*A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- EQUED = 'Y'
- END IF
-*
- RETURN
-*
-* End of SLAQSY
-*
- END
diff --git a/netlib/LAPACK/slaqtr.f b/netlib/LAPACK/slaqtr.f
deleted file mode 100644
index e2dc607..0000000
--- a/netlib/LAPACK/slaqtr.f
+++ /dev/null
@@ -1,748 +0,0 @@
-*> \brief \b SLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAQTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LREAL, LTRAN
-* INTEGER INFO, LDT, N
-* REAL SCALE, W
-* ..
-* .. Array Arguments ..
-* REAL B( * ), T( LDT, * ), WORK( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAQTR solves the real quasi-triangular system
-*>
-*> op(T)*p = scale*c, if LREAL = .TRUE.
-*>
-*> or the complex quasi-triangular systems
-*>
-*> op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
-*>
-*> in real arithmetic, where T is upper quasi-triangular.
-*> If LREAL = .FALSE., then the first diagonal block of T must be
-*> 1 by 1, B is the specially structured matrix
-*>
-*> B = [ b(1) b(2) ... b(n) ]
-*> [ w ]
-*> [ w ]
-*> [ . ]
-*> [ w ]
-*>
-*> op(A) = A or A**T, A**T denotes the transpose of
-*> matrix A.
-*>
-*> On input, X = [ c ]. On output, X = [ p ].
-*> [ d ] [ q ]
-*>
-*> This subroutine is designed for the condition number estimation
-*> in routine STRSNA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRAN
-*> \verbatim
-*> LTRAN is LOGICAL
-*> On entry, LTRAN specifies the option of conjugate transpose:
-*> = .FALSE., op(T+i*B) = T+i*B,
-*> = .TRUE., op(T+i*B) = (T+i*B)**T.
-*> \endverbatim
-*>
-*> \param[in] LREAL
-*> \verbatim
-*> LREAL is LOGICAL
-*> On entry, LREAL specifies the input matrix structure:
-*> = .FALSE., the input is complex
-*> = .TRUE., the input is real
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of T+i*B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> On entry, T contains a matrix in Schur canonical form.
-*> If LREAL = .FALSE., then the first diagonal block of T must
-*> be 1 by 1.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the matrix T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (N)
-*> On entry, B contains the elements to form the matrix
-*> B as described above.
-*> If LREAL = .TRUE., B is not referenced.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is REAL
-*> On entry, W is the diagonal element of the matrix B.
-*> If LREAL = .TRUE., W is not referenced.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> On exit, SCALE is the scale factor.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (2*N)
-*> On entry, X contains the right hand side of the system.
-*> On exit, X is overwritten by the solution.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO is set to
-*> 0: successful exit.
-*> 1: the some diagonal 1 by 1 block has been perturbed by
-*> a small number SMIN to keep nonsingularity.
-*> 2: the some diagonal 2 by 2 block has been perturbed by
-*> a small number in SLALN2 to keep nonsingularity.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL LREAL, LTRAN
- INTEGER INFO, LDT, N
- REAL SCALE, W
-* ..
-* .. Array Arguments ..
- REAL B( * ), T( LDT, * ), WORK( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER I, IERR, J, J1, J2, JNEXT, K, N1, N2
- REAL BIGNUM, EPS, REC, SCALOC, SI, SMIN, SMINW,
- $ SMLNUM, SR, TJJ, TMP, XJ, XMAX, XNORM, Z
-* ..
-* .. Local Arrays ..
- REAL D( 2, 2 ), V( 2, 2 )
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SASUM, SDOT, SLAMCH, SLANGE
- EXTERNAL ISAMAX, SASUM, SDOT, SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SLADIV, SLALN2, SSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Do not test the input parameters for errors
-*
- NOTRAN = .NOT.LTRAN
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
-*
- XNORM = SLANGE( 'M', N, N, T, LDT, D )
- IF( .NOT.LREAL )
- $ XNORM = MAX( XNORM, ABS( W ), SLANGE( 'M', N, 1, B, N, D ) )
- SMIN = MAX( SMLNUM, EPS*XNORM )
-*
-* Compute 1-norm of each column of strictly upper triangular
-* part of T to control overflow in triangular solver.
-*
- WORK( 1 ) = ZERO
- DO 10 J = 2, N
- WORK( J ) = SASUM( J-1, T( 1, J ), 1 )
- 10 CONTINUE
-*
- IF( .NOT.LREAL ) THEN
- DO 20 I = 2, N
- WORK( I ) = WORK( I ) + ABS( B( I ) )
- 20 CONTINUE
- END IF
-*
- N2 = 2*N
- N1 = N
- IF( .NOT.LREAL )
- $ N1 = N2
- K = ISAMAX( N1, X, 1 )
- XMAX = ABS( X( K ) )
- SCALE = ONE
-*
- IF( XMAX.GT.BIGNUM ) THEN
- SCALE = BIGNUM / XMAX
- CALL SSCAL( N1, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( LREAL ) THEN
-*
- IF( NOTRAN ) THEN
-*
-* Solve T*p = scale*c
-*
- JNEXT = N
- DO 30 J = N, 1, -1
- IF( J.GT.JNEXT )
- $ GO TO 30
- J1 = J
- J2 = J
- JNEXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNEXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* Meet 1 by 1 diagonal block
-*
-* Scale to avoid overflow when computing
-* x(j) = b(j)/T(j,j)
-*
- XJ = ABS( X( J1 ) )
- TJJ = ABS( T( J1, J1 ) )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMIN ) THEN
- TMP = SMIN
- TJJ = SMIN
- INFO = 1
- END IF
-*
- IF( XJ.EQ.ZERO )
- $ GO TO 30
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J1 ) = X( J1 ) / TMP
- XJ = ABS( X( J1 ) )
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j1 of T.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( WORK( J1 ).GT.( BIGNUM-XMAX )*REC ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
- IF( J1.GT.1 ) THEN
- CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- K = ISAMAX( J1-1, X, 1 )
- XMAX = ABS( X( K ) )
- END IF
-*
- ELSE
-*
-* Meet 2 by 2 diagonal block
-*
-* Call 2 by 2 linear system solve, to take
-* care of possible overflow by scaling factor.
-*
- D( 1, 1 ) = X( J1 )
- D( 2, 1 ) = X( J2 )
- CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, ZERO, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL SSCAL( N, SCALOC, X, 1 )
- SCALE = SCALE*SCALOC
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
-*
-* Scale V(1,1) (= X(J1)) and/or V(2,1) (=X(J2))
-* to avoid overflow in updating right-hand side.
-*
- XJ = MAX( ABS( V( 1, 1 ) ), ABS( V( 2, 1 ) ) )
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( MAX( WORK( J1 ), WORK( J2 ) ).GT.
- $ ( BIGNUM-XMAX )*REC ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Update right-hand side
-*
- IF( J1.GT.1 ) THEN
- CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- CALL SAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 )
- K = ISAMAX( J1-1, X, 1 )
- XMAX = ABS( X( K ) )
- END IF
-*
- END IF
-*
- 30 CONTINUE
-*
- ELSE
-*
-* Solve T**T*p = scale*c
-*
- JNEXT = 1
- DO 40 J = 1, N
- IF( J.LT.JNEXT )
- $ GO TO 40
- J1 = J
- J2 = J
- JNEXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNEXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1 by 1 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side element by inner product.
-*
- XJ = ABS( X( J1 ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( WORK( J1 ).GT.( BIGNUM-XJ )*REC ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- X( J1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X, 1 )
-*
- XJ = ABS( X( J1 ) )
- TJJ = ABS( T( J1, J1 ) )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMIN ) THEN
- TMP = SMIN
- TJJ = SMIN
- INFO = 1
- END IF
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J1 ) = X( J1 ) / TMP
- XMAX = MAX( XMAX, ABS( X( J1 ) ) )
-*
- ELSE
-*
-* 2 by 2 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side elements by inner product.
-*
- XJ = MAX( ABS( X( J1 ) ), ABS( X( J2 ) ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( MAX( WORK( J2 ), WORK( J1 ) ).GT.( BIGNUM-XJ )*
- $ REC ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- D( 1, 1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X,
- $ 1 )
- D( 2, 1 ) = X( J2 ) - SDOT( J1-1, T( 1, J2 ), 1, X,
- $ 1 )
-*
- CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, ZERO, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL SSCAL( N, SCALOC, X, 1 )
- SCALE = SCALE*SCALOC
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
- XMAX = MAX( ABS( X( J1 ) ), ABS( X( J2 ) ), XMAX )
-*
- END IF
- 40 CONTINUE
- END IF
-*
- ELSE
-*
- SMINW = MAX( EPS*ABS( W ), SMIN )
- IF( NOTRAN ) THEN
-*
-* Solve (T + iB)*(p+iq) = c+id
-*
- JNEXT = N
- DO 70 J = N, 1, -1
- IF( J.GT.JNEXT )
- $ GO TO 70
- J1 = J
- J2 = J
- JNEXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNEXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1 by 1 diagonal block
-*
-* Scale if necessary to avoid overflow in division
-*
- Z = W
- IF( J1.EQ.1 )
- $ Z = B( 1 )
- XJ = ABS( X( J1 ) ) + ABS( X( N+J1 ) )
- TJJ = ABS( T( J1, J1 ) ) + ABS( Z )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMINW ) THEN
- TMP = SMINW
- TJJ = SMINW
- INFO = 1
- END IF
-*
- IF( XJ.EQ.ZERO )
- $ GO TO 70
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL SSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- CALL SLADIV( X( J1 ), X( N+J1 ), TMP, Z, SR, SI )
- X( J1 ) = SR
- X( N+J1 ) = SI
- XJ = ABS( X( J1 ) ) + ABS( X( N+J1 ) )
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j1 of T.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( WORK( J1 ).GT.( BIGNUM-XMAX )*REC ) THEN
- CALL SSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
-*
- IF( J1.GT.1 ) THEN
- CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- CALL SAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
-*
- X( 1 ) = X( 1 ) + B( J1 )*X( N+J1 )
- X( N+1 ) = X( N+1 ) - B( J1 )*X( J1 )
-*
- XMAX = ZERO
- DO 50 K = 1, J1 - 1
- XMAX = MAX( XMAX, ABS( X( K ) )+
- $ ABS( X( K+N ) ) )
- 50 CONTINUE
- END IF
-*
- ELSE
-*
-* Meet 2 by 2 diagonal block
-*
- D( 1, 1 ) = X( J1 )
- D( 2, 1 ) = X( J2 )
- D( 1, 2 ) = X( N+J1 )
- D( 2, 2 ) = X( N+J2 )
- CALL SLALN2( .FALSE., 2, 2, SMINW, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, -W, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL SSCAL( 2*N, SCALOC, X, 1 )
- SCALE = SCALOC*SCALE
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
- X( N+J1 ) = V( 1, 2 )
- X( N+J2 ) = V( 2, 2 )
-*
-* Scale X(J1), .... to avoid overflow in
-* updating right hand side.
-*
- XJ = MAX( ABS( V( 1, 1 ) )+ABS( V( 1, 2 ) ),
- $ ABS( V( 2, 1 ) )+ABS( V( 2, 2 ) ) )
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( MAX( WORK( J1 ), WORK( J2 ) ).GT.
- $ ( BIGNUM-XMAX )*REC ) THEN
- CALL SSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Update the right-hand side.
-*
- IF( J1.GT.1 ) THEN
- CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 )
- CALL SAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 )
-*
- CALL SAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
- CALL SAXPY( J1-1, -X( N+J2 ), T( 1, J2 ), 1,
- $ X( N+1 ), 1 )
-*
- X( 1 ) = X( 1 ) + B( J1 )*X( N+J1 ) +
- $ B( J2 )*X( N+J2 )
- X( N+1 ) = X( N+1 ) - B( J1 )*X( J1 ) -
- $ B( J2 )*X( J2 )
-*
- XMAX = ZERO
- DO 60 K = 1, J1 - 1
- XMAX = MAX( ABS( X( K ) )+ABS( X( K+N ) ),
- $ XMAX )
- 60 CONTINUE
- END IF
-*
- END IF
- 70 CONTINUE
-*
- ELSE
-*
-* Solve (T + iB)**T*(p+iq) = c+id
-*
- JNEXT = 1
- DO 80 J = 1, N
- IF( J.LT.JNEXT )
- $ GO TO 80
- J1 = J
- J2 = J
- JNEXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNEXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1 by 1 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side element by inner product.
-*
- XJ = ABS( X( J1 ) ) + ABS( X( J1+N ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( WORK( J1 ).GT.( BIGNUM-XJ )*REC ) THEN
- CALL SSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- X( J1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X, 1 )
- X( N+J1 ) = X( N+J1 ) - SDOT( J1-1, T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
- IF( J1.GT.1 ) THEN
- X( J1 ) = X( J1 ) - B( J1 )*X( N+1 )
- X( N+J1 ) = X( N+J1 ) + B( J1 )*X( 1 )
- END IF
- XJ = ABS( X( J1 ) ) + ABS( X( J1+N ) )
-*
- Z = W
- IF( J1.EQ.1 )
- $ Z = B( 1 )
-*
-* Scale if necessary to avoid overflow in
-* complex division
-*
- TJJ = ABS( T( J1, J1 ) ) + ABS( Z )
- TMP = T( J1, J1 )
- IF( TJJ.LT.SMINW ) THEN
- TMP = SMINW
- TJJ = SMINW
- INFO = 1
- END IF
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.BIGNUM*TJJ ) THEN
- REC = ONE / XJ
- CALL SSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- CALL SLADIV( X( J1 ), X( N+J1 ), TMP, -Z, SR, SI )
- X( J1 ) = SR
- X( J1+N ) = SI
- XMAX = MAX( ABS( X( J1 ) )+ABS( X( J1+N ) ), XMAX )
-*
- ELSE
-*
-* 2 by 2 diagonal block
-*
-* Scale if necessary to avoid overflow in forming the
-* right-hand side element by inner product.
-*
- XJ = MAX( ABS( X( J1 ) )+ABS( X( N+J1 ) ),
- $ ABS( X( J2 ) )+ABS( X( N+J2 ) ) )
- IF( XMAX.GT.ONE ) THEN
- REC = ONE / XMAX
- IF( MAX( WORK( J1 ), WORK( J2 ) ).GT.
- $ ( BIGNUM-XJ ) / XMAX ) THEN
- CALL SSCAL( N2, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- D( 1, 1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X,
- $ 1 )
- D( 2, 1 ) = X( J2 ) - SDOT( J1-1, T( 1, J2 ), 1, X,
- $ 1 )
- D( 1, 2 ) = X( N+J1 ) - SDOT( J1-1, T( 1, J1 ), 1,
- $ X( N+1 ), 1 )
- D( 2, 2 ) = X( N+J2 ) - SDOT( J1-1, T( 1, J2 ), 1,
- $ X( N+1 ), 1 )
- D( 1, 1 ) = D( 1, 1 ) - B( J1 )*X( N+1 )
- D( 2, 1 ) = D( 2, 1 ) - B( J2 )*X( N+1 )
- D( 1, 2 ) = D( 1, 2 ) + B( J1 )*X( 1 )
- D( 2, 2 ) = D( 2, 2 ) + B( J2 )*X( 1 )
-*
- CALL SLALN2( .TRUE., 2, 2, SMINW, ONE, T( J1, J1 ),
- $ LDT, ONE, ONE, D, 2, ZERO, W, V, 2,
- $ SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 2
-*
- IF( SCALOC.NE.ONE ) THEN
- CALL SSCAL( N2, SCALOC, X, 1 )
- SCALE = SCALOC*SCALE
- END IF
- X( J1 ) = V( 1, 1 )
- X( J2 ) = V( 2, 1 )
- X( N+J1 ) = V( 1, 2 )
- X( N+J2 ) = V( 2, 2 )
- XMAX = MAX( ABS( X( J1 ) )+ABS( X( N+J1 ) ),
- $ ABS( X( J2 ) )+ABS( X( N+J2 ) ), XMAX )
-*
- END IF
-*
- 80 CONTINUE
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SLAQTR
-*
- END
diff --git a/netlib/LAPACK/slar1v.f b/netlib/LAPACK/slar1v.f
deleted file mode 100644
index d813f68..0000000
--- a/netlib/LAPACK/slar1v.f
+++ /dev/null
@@ -1,486 +0,0 @@
-*> \brief \b SLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAR1V + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slar1v.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slar1v.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slar1v.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD,
-* PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA,
-* R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTNC
-* INTEGER B1, BN, N, NEGCNT, R
-* REAL GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID,
-* $ RQCORR, ZTZ
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * )
-* REAL D( * ), L( * ), LD( * ), LLD( * ),
-* $ WORK( * )
-* REAL Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAR1V computes the (scaled) r-th column of the inverse of
-*> the sumbmatrix in rows B1 through BN of the tridiagonal matrix
-*> L D L**T - sigma I. When sigma is close to an eigenvalue, the
-*> computed vector is an accurate eigenvector. Usually, r corresponds
-*> to the index where the eigenvector is largest in magnitude.
-*> The following steps accomplish this computation :
-*> (a) Stationary qd transform, L D L**T - sigma I = L(+) D(+) L(+)**T,
-*> (b) Progressive qd transform, L D L**T - sigma I = U(-) D(-) U(-)**T,
-*> (c) Computation of the diagonal elements of the inverse of
-*> L D L**T - sigma I by combining the above transforms, and choosing
-*> r as the index where the diagonal of the inverse is (one of the)
-*> largest in magnitude.
-*> (d) Computation of the (scaled) r-th column of the inverse using the
-*> twisted factorization obtained by combining the top part of the
-*> the stationary and the bottom part of the progressive transform.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix L D L**T.
-*> \endverbatim
-*>
-*> \param[in] B1
-*> \verbatim
-*> B1 is INTEGER
-*> First index of the submatrix of L D L**T.
-*> \endverbatim
-*>
-*> \param[in] BN
-*> \verbatim
-*> BN is INTEGER
-*> Last index of the submatrix of L D L**T.
-*> \endverbatim
-*>
-*> \param[in] LAMBDA
-*> \verbatim
-*> LAMBDA is REAL
-*> The shift. In order to compute an accurate eigenvector,
-*> LAMBDA should be a good approximation to an eigenvalue
-*> of L D L**T.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal matrix
-*> L, in elements 1 to N-1.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] LD
-*> \verbatim
-*> LD is REAL array, dimension (N-1)
-*> The n-1 elements L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] LLD
-*> \verbatim
-*> LLD is REAL array, dimension (N-1)
-*> The n-1 elements L(i)*L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[in] GAPTOL
-*> \verbatim
-*> GAPTOL is REAL
-*> Tolerance that indicates when eigenvector entries are negligible
-*> w.r.t. their contribution to the residual.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (N)
-*> On input, all entries of Z must be set to 0.
-*> On output, Z contains the (scaled) r-th column of the
-*> inverse. The scaling is such that Z(R) equals 1.
-*> \endverbatim
-*>
-*> \param[in] WANTNC
-*> \verbatim
-*> WANTNC is LOGICAL
-*> Specifies whether NEGCNT has to be computed.
-*> \endverbatim
-*>
-*> \param[out] NEGCNT
-*> \verbatim
-*> NEGCNT is INTEGER
-*> If WANTNC is .TRUE. then NEGCNT = the number of pivots < pivmin
-*> in the matrix factorization L D L**T, and NEGCNT = -1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] ZTZ
-*> \verbatim
-*> ZTZ is REAL
-*> The square of the 2-norm of Z.
-*> \endverbatim
-*>
-*> \param[out] MINGMA
-*> \verbatim
-*> MINGMA is REAL
-*> The reciprocal of the largest (in magnitude) diagonal
-*> element of the inverse of L D L**T - sigma I.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is INTEGER
-*> The twist index for the twisted factorization used to
-*> compute Z.
-*> On input, 0 <= R <= N. If R is input as 0, R is set to
-*> the index where (L D L**T - sigma I)^{-1} is largest
-*> in magnitude. If 1 <= R <= N, R is unchanged.
-*> On output, R contains the twist index used to compute Z.
-*> Ideally, R designates the position of the maximum entry in the
-*> eigenvector.
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension (2)
-*> The support of the vector in Z, i.e., the vector Z is
-*> nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
-*> \endverbatim
-*>
-*> \param[out] NRMINV
-*> \verbatim
-*> NRMINV is REAL
-*> NRMINV = 1/SQRT( ZTZ )
-*> \endverbatim
-*>
-*> \param[out] RESID
-*> \verbatim
-*> RESID is REAL
-*> The residual of the FP vector.
-*> RESID = ABS( MINGMA )/SQRT( ZTZ )
-*> \endverbatim
-*>
-*> \param[out] RQCORR
-*> \verbatim
-*> RQCORR is REAL
-*> The Rayleigh Quotient correction to LAMBDA.
-*> RQCORR = MINGMA*TMP
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD,
- $ PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA,
- $ R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL WANTNC
- INTEGER B1, BN, N, NEGCNT, R
- REAL GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID,
- $ RQCORR, ZTZ
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * )
- REAL D( * ), L( * ), LD( * ), LLD( * ),
- $ WORK( * )
- REAL Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-
-* ..
-* .. Local Scalars ..
- LOGICAL SAWNAN1, SAWNAN2
- INTEGER I, INDLPL, INDP, INDS, INDUMN, NEG1, NEG2, R1,
- $ R2
- REAL DMINUS, DPLUS, EPS, S, TMP
-* ..
-* .. External Functions ..
- LOGICAL SISNAN
- REAL SLAMCH
- EXTERNAL SISNAN, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- EPS = SLAMCH( 'Precision' )
-
-
- IF( R.EQ.0 ) THEN
- R1 = B1
- R2 = BN
- ELSE
- R1 = R
- R2 = R
- END IF
-
-* Storage for LPLUS
- INDLPL = 0
-* Storage for UMINUS
- INDUMN = N
- INDS = 2*N + 1
- INDP = 3*N + 1
-
- IF( B1.EQ.1 ) THEN
- WORK( INDS ) = ZERO
- ELSE
- WORK( INDS+B1-1 ) = LLD( B1-1 )
- END IF
-
-*
-* Compute the stationary transform (using the differential form)
-* until the index R2.
-*
- SAWNAN1 = .FALSE.
- NEG1 = 0
- S = WORK( INDS+B1-1 ) - LAMBDA
- DO 50 I = B1, R1 - 1
- DPLUS = D( I ) + S
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- IF(DPLUS.LT.ZERO) NEG1 = NEG1 + 1
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- S = WORK( INDS+I ) - LAMBDA
- 50 CONTINUE
- SAWNAN1 = SISNAN( S )
- IF( SAWNAN1 ) GOTO 60
- DO 51 I = R1, R2 - 1
- DPLUS = D( I ) + S
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- S = WORK( INDS+I ) - LAMBDA
- 51 CONTINUE
- SAWNAN1 = SISNAN( S )
-*
- 60 CONTINUE
- IF( SAWNAN1 ) THEN
-* Runs a slower version of the above loop if a NaN is detected
- NEG1 = 0
- S = WORK( INDS+B1-1 ) - LAMBDA
- DO 70 I = B1, R1 - 1
- DPLUS = D( I ) + S
- IF(ABS(DPLUS).LT.PIVMIN) DPLUS = -PIVMIN
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- IF(DPLUS.LT.ZERO) NEG1 = NEG1 + 1
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- IF( WORK( INDLPL+I ).EQ.ZERO )
- $ WORK( INDS+I ) = LLD( I )
- S = WORK( INDS+I ) - LAMBDA
- 70 CONTINUE
- DO 71 I = R1, R2 - 1
- DPLUS = D( I ) + S
- IF(ABS(DPLUS).LT.PIVMIN) DPLUS = -PIVMIN
- WORK( INDLPL+I ) = LD( I ) / DPLUS
- WORK( INDS+I ) = S*WORK( INDLPL+I )*L( I )
- IF( WORK( INDLPL+I ).EQ.ZERO )
- $ WORK( INDS+I ) = LLD( I )
- S = WORK( INDS+I ) - LAMBDA
- 71 CONTINUE
- END IF
-*
-* Compute the progressive transform (using the differential form)
-* until the index R1
-*
- SAWNAN2 = .FALSE.
- NEG2 = 0
- WORK( INDP+BN-1 ) = D( BN ) - LAMBDA
- DO 80 I = BN - 1, R1, -1
- DMINUS = LLD( I ) + WORK( INDP+I )
- TMP = D( I ) / DMINUS
- IF(DMINUS.LT.ZERO) NEG2 = NEG2 + 1
- WORK( INDUMN+I ) = L( I )*TMP
- WORK( INDP+I-1 ) = WORK( INDP+I )*TMP - LAMBDA
- 80 CONTINUE
- TMP = WORK( INDP+R1-1 )
- SAWNAN2 = SISNAN( TMP )
-
- IF( SAWNAN2 ) THEN
-* Runs a slower version of the above loop if a NaN is detected
- NEG2 = 0
- DO 100 I = BN-1, R1, -1
- DMINUS = LLD( I ) + WORK( INDP+I )
- IF(ABS(DMINUS).LT.PIVMIN) DMINUS = -PIVMIN
- TMP = D( I ) / DMINUS
- IF(DMINUS.LT.ZERO) NEG2 = NEG2 + 1
- WORK( INDUMN+I ) = L( I )*TMP
- WORK( INDP+I-1 ) = WORK( INDP+I )*TMP - LAMBDA
- IF( TMP.EQ.ZERO )
- $ WORK( INDP+I-1 ) = D( I ) - LAMBDA
- 100 CONTINUE
- END IF
-*
-* Find the index (from R1 to R2) of the largest (in magnitude)
-* diagonal element of the inverse
-*
- MINGMA = WORK( INDS+R1-1 ) + WORK( INDP+R1-1 )
- IF( MINGMA.LT.ZERO ) NEG1 = NEG1 + 1
- IF( WANTNC ) THEN
- NEGCNT = NEG1 + NEG2
- ELSE
- NEGCNT = -1
- ENDIF
- IF( ABS(MINGMA).EQ.ZERO )
- $ MINGMA = EPS*WORK( INDS+R1-1 )
- R = R1
- DO 110 I = R1, R2 - 1
- TMP = WORK( INDS+I ) + WORK( INDP+I )
- IF( TMP.EQ.ZERO )
- $ TMP = EPS*WORK( INDS+I )
- IF( ABS( TMP ).LE.ABS( MINGMA ) ) THEN
- MINGMA = TMP
- R = I + 1
- END IF
- 110 CONTINUE
-*
-* Compute the FP vector: solve N^T v = e_r
-*
- ISUPPZ( 1 ) = B1
- ISUPPZ( 2 ) = BN
- Z( R ) = ONE
- ZTZ = ONE
-*
-* Compute the FP vector upwards from R
-*
- IF( .NOT.SAWNAN1 .AND. .NOT.SAWNAN2 ) THEN
- DO 210 I = R-1, B1, -1
- Z( I ) = -( WORK( INDLPL+I )*Z( I+1 ) )
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I ) = ZERO
- ISUPPZ( 1 ) = I + 1
- GOTO 220
- ENDIF
- ZTZ = ZTZ + Z( I )*Z( I )
- 210 CONTINUE
- 220 CONTINUE
- ELSE
-* Run slower loop if NaN occurred.
- DO 230 I = R - 1, B1, -1
- IF( Z( I+1 ).EQ.ZERO ) THEN
- Z( I ) = -( LD( I+1 ) / LD( I ) )*Z( I+2 )
- ELSE
- Z( I ) = -( WORK( INDLPL+I )*Z( I+1 ) )
- END IF
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I ) = ZERO
- ISUPPZ( 1 ) = I + 1
- GO TO 240
- END IF
- ZTZ = ZTZ + Z( I )*Z( I )
- 230 CONTINUE
- 240 CONTINUE
- ENDIF
-
-* Compute the FP vector downwards from R in blocks of size BLKSIZ
- IF( .NOT.SAWNAN1 .AND. .NOT.SAWNAN2 ) THEN
- DO 250 I = R, BN-1
- Z( I+1 ) = -( WORK( INDUMN+I )*Z( I ) )
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I+1 ) = ZERO
- ISUPPZ( 2 ) = I
- GO TO 260
- END IF
- ZTZ = ZTZ + Z( I+1 )*Z( I+1 )
- 250 CONTINUE
- 260 CONTINUE
- ELSE
-* Run slower loop if NaN occurred.
- DO 270 I = R, BN - 1
- IF( Z( I ).EQ.ZERO ) THEN
- Z( I+1 ) = -( LD( I-1 ) / LD( I ) )*Z( I-1 )
- ELSE
- Z( I+1 ) = -( WORK( INDUMN+I )*Z( I ) )
- END IF
- IF( (ABS(Z(I))+ABS(Z(I+1)))* ABS(LD(I)).LT.GAPTOL )
- $ THEN
- Z( I+1 ) = ZERO
- ISUPPZ( 2 ) = I
- GO TO 280
- END IF
- ZTZ = ZTZ + Z( I+1 )*Z( I+1 )
- 270 CONTINUE
- 280 CONTINUE
- END IF
-*
-* Compute quantities for convergence test
-*
- TMP = ONE / ZTZ
- NRMINV = SQRT( TMP )
- RESID = ABS( MINGMA )*NRMINV
- RQCORR = MINGMA*TMP
-*
-*
- RETURN
-*
-* End of SLAR1V
-*
- END
diff --git a/netlib/LAPACK/slar2v.f b/netlib/LAPACK/slar2v.f
deleted file mode 100644
index 20c119b..0000000
--- a/netlib/LAPACK/slar2v.f
+++ /dev/null
@@ -1,157 +0,0 @@
-*> \brief \b SLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAR2V + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slar2v.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slar2v.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slar2v.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAR2V( N, X, Y, Z, INCX, C, S, INCC )
-*
-* .. Scalar Arguments ..
-* INTEGER INCC, INCX, N
-* ..
-* .. Array Arguments ..
-* REAL C( * ), S( * ), X( * ), Y( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAR2V applies a vector of real plane rotations from both sides to
-*> a sequence of 2-by-2 real symmetric matrices, defined by the elements
-*> of the vectors x, y and z. For i = 1,2,...,n
-*>
-*> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) )
-*> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of plane rotations to be applied.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array,
-*> dimension (1+(N-1)*INCX)
-*> The vector x.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array,
-*> dimension (1+(N-1)*INCX)
-*> The vector y.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array,
-*> dimension (1+(N-1)*INCX)
-*> The vector z.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X, Y and Z. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (1+(N-1)*INCC)
-*> The cosines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension (1+(N-1)*INCC)
-*> The sines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCC
-*> \verbatim
-*> INCC is INTEGER
-*> The increment between elements of C and S. INCC > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAR2V( N, X, Y, Z, INCX, C, S, INCC )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCC, INCX, N
-* ..
-* .. Array Arguments ..
- REAL C( * ), S( * ), X( * ), Y( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IC, IX
- REAL CI, SI, T1, T2, T3, T4, T5, T6, XI, YI, ZI
-* ..
-* .. Executable Statements ..
-*
- IX = 1
- IC = 1
- DO 10 I = 1, N
- XI = X( IX )
- YI = Y( IX )
- ZI = Z( IX )
- CI = C( IC )
- SI = S( IC )
- T1 = SI*ZI
- T2 = CI*ZI
- T3 = T2 - SI*XI
- T4 = T2 + SI*YI
- T5 = CI*XI + T1
- T6 = CI*YI - T1
- X( IX ) = CI*T5 + SI*T4
- Y( IX ) = CI*T6 - SI*T3
- Z( IX ) = CI*T4 - SI*T5
- IX = IX + INCX
- IC = IC + INCC
- 10 CONTINUE
-*
-* End of SLAR2V
-*
- RETURN
- END
diff --git a/netlib/LAPACK/slaran.f b/netlib/LAPACK/slaran.f
deleted file mode 100644
index 9738d28..0000000
--- a/netlib/LAPACK/slaran.f
+++ /dev/null
@@ -1,147 +0,0 @@
-*> \brief \b SLARAN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLARAN( ISEED )
-*
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARAN returns a random real number from a uniform (0,1)
-*> distribution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine uses a multiplicative congruential method with modulus
-*> 2**48 and multiplier 33952834046453 (see G.S.Fishman,
-*> 'Multiplicative congruential random number generators with modulus
-*> 2**b: an exhaustive analysis for b = 32 and a partial analysis for
-*> b = 48', Math. Comp. 189, pp 331-344, 1990).
-*>
-*> 48-bit integers are stored in 4 integer array elements with 12 bits
-*> per element. Hence the routine is portable across machines with
-*> integers of 32 bits or more.
-*> \endverbatim
-*>
-* =====================================================================
- REAL FUNCTION SLARAN( ISEED )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER M1, M2, M3, M4
- PARAMETER ( M1 = 494, M2 = 322, M3 = 2508, M4 = 2549 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- INTEGER IPW2
- REAL R
- PARAMETER ( IPW2 = 4096, R = ONE / IPW2 )
-* ..
-* .. Local Scalars ..
- INTEGER IT1, IT2, IT3, IT4
- REAL RNDOUT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD, REAL
-* ..
-* .. Executable Statements ..
- 10 CONTINUE
-*
-* multiply the seed by the multiplier modulo 2**48
-*
- IT4 = ISEED( 4 )*M4
- IT3 = IT4 / IPW2
- IT4 = IT4 - IPW2*IT3
- IT3 = IT3 + ISEED( 3 )*M4 + ISEED( 4 )*M3
- IT2 = IT3 / IPW2
- IT3 = IT3 - IPW2*IT2
- IT2 = IT2 + ISEED( 2 )*M4 + ISEED( 3 )*M3 + ISEED( 4 )*M2
- IT1 = IT2 / IPW2
- IT2 = IT2 - IPW2*IT1
- IT1 = IT1 + ISEED( 1 )*M4 + ISEED( 2 )*M3 + ISEED( 3 )*M2 +
- $ ISEED( 4 )*M1
- IT1 = MOD( IT1, IPW2 )
-*
-* return updated seed
-*
- ISEED( 1 ) = IT1
- ISEED( 2 ) = IT2
- ISEED( 3 ) = IT3
- ISEED( 4 ) = IT4
-*
-* convert 48-bit integer to a real number in the interval (0,1)
-*
- RNDOUT = R*( REAL( IT1 )+R*( REAL( IT2 )+R*( REAL( IT3 )+R*
- $ ( REAL( IT4 ) ) ) ) )
-*
- IF (RNDOUT.EQ.1.0) THEN
-* If a real number has n bits of precision, and the first
-* n bits of the 48-bit integer above happen to be all 1 (which
-* will occur about once every 2**n calls), then SLARAN will
-* be rounded to exactly 1.0. In IEEE single precision arithmetic,
-* this will happen relatively often since n = 24.
-* Since SLARAN is not supposed to return exactly 0.0 or 1.0
-* (and some callers of SLARAN, such as CLARND, depend on that),
-* the statistically correct thing to do in this situation is
-* simply to iterate again.
-* N.B. the case SLARAN = 0.0 should not be possible.
-*
- GOTO 10
- END IF
-*
- SLARAN = RNDOUT
- RETURN
-*
-* End of SLARAN
-*
- END
diff --git a/netlib/LAPACK/slarf.f b/netlib/LAPACK/slarf.f
deleted file mode 100644
index 2747561..0000000
--- a/netlib/LAPACK/slarf.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b SLARF applies an elementary reflector to a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, LDC, M, N
-* REAL TAU
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARF applies a real elementary reflector H to a real m by n matrix
-*> C, from either the left or the right. H is represented in the form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar and v is a real vector.
-*>
-*> If tau = 0, then H is taken to be the unit matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension
-*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*> The vector v in the representation of H. V is not used if
-*> TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, LDC, M, N
- REAL TAU
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL APPLYLEFT
- INTEGER I, LASTV, LASTC
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILASLR, ILASLC
- EXTERNAL LSAME, ILASLR, ILASLC
-* ..
-* .. Executable Statements ..
-*
- APPLYLEFT = LSAME( SIDE, 'L' )
- LASTV = 0
- LASTC = 0
- IF( TAU.NE.ZERO ) THEN
-! Set up variables for scanning V. LASTV begins pointing to the end
-! of V.
- IF( APPLYLEFT ) THEN
- LASTV = M
- ELSE
- LASTV = N
- END IF
- IF( INCV.GT.0 ) THEN
- I = 1 + (LASTV-1) * INCV
- ELSE
- I = 1
- END IF
-! Look for the last non-zero row in V.
- DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
- LASTV = LASTV - 1
- I = I - INCV
- END DO
- IF( APPLYLEFT ) THEN
-! Scan for the last non-zero column in C(1:lastv,:).
- LASTC = ILASLC(LASTV, N, C, LDC)
- ELSE
-! Scan for the last non-zero row in C(:,1:lastv).
- LASTC = ILASLR(M, LASTV, C, LDC)
- END IF
- END IF
-! Note that lastc.eq.0 renders the BLAS operations null; no special
-! case is needed at this level.
- IF( APPLYLEFT ) THEN
-*
-* Form H * C
-*
- IF( LASTV.GT.0 ) THEN
-*
-* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
-*
- CALL SGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
- $ ZERO, WORK, 1 )
-*
-* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
-*
- CALL SGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
- END IF
- ELSE
-*
-* Form C * H
-*
- IF( LASTV.GT.0 ) THEN
-*
-* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
-*
- CALL SGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
- $ V, INCV, ZERO, WORK, 1 )
-*
-* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
-*
- CALL SGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
- END IF
- END IF
- RETURN
-*
-* End of SLARF
-*
- END
diff --git a/netlib/LAPACK/slarfb.f b/netlib/LAPACK/slarfb.f
deleted file mode 100644
index 7694801..0000000
--- a/netlib/LAPACK/slarfb.f
+++ /dev/null
@@ -1,758 +0,0 @@
-*> \brief \b SLARFB applies a block reflector or its transpose to a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARFB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
-* T, LDT, C, LDC, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), T( LDT, * ), V( LDV, * ),
-* $ WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARFB applies a real block reflector H or its transpose H**T to a
-*> real m by n matrix C, from either the left or the right.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H**T from the Left
-*> = 'R': apply H or H**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'T': apply H**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = '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
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columnwise
-*> = 'R': Rowwise
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T (= the number of elementary
-*> reflectors whose product defines the block reflector).
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*> (LDV,N) if STOREV = 'R' and SIDE = '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' and SIDE = 'L', LDV >= max(1,M);
-*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*> if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,K)
-*> The triangular k by k matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LDWORK,K)
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= max(1,N);
-*> if SIDE = 'R', LDWORK >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \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; the corresponding
-*> array elements are modified but restored on exit. The rest of the
-*> array is not used.
-*>
-*> 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 SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
- $ T, LDT, C, LDC, WORK, LDWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), T( LDT, * ), V( LDV, * ),
- $ WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST
- INTEGER I, J, LASTV, LASTC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILASLR, ILASLC
- EXTERNAL LSAME, ILASLR, ILASLC
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, STRMM
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
- IF( LSAME( TRANS, 'N' ) ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-* Let V = ( V1 ) (first K rows)
-* ( V2 )
-* where V1 is unit lower triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILASLR( M, K, V, LDV ) )
- LASTC = ILASLC( LASTV, N, C, LDC )
-*
-* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
-*
-* W := C1**T
-*
- DO 10 J = 1, K
- CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 10 CONTINUE
-*
-* W := W * V1
-*
- CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2**T *V2
-*
- CALL SGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - V2 * W**T
-*
- CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTV-K, LASTC, K,
- $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
- $ C( K+1, 1 ), LDC )
- END IF
-*
-* W := W * V1**T
-*
- CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W**T
-*
- DO 30 J = 1, K
- DO 20 I = 1, LASTC
- C( J, I ) = C( J, I ) - WORK( I, J )
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILASLR( N, K, V, LDV ) )
- LASTC = ILASLR( M, LASTV, C, LDC )
-*
-* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
-*
-* W := C1
-*
- DO 40 J = 1, K
- CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
- 40 CONTINUE
-*
-* W := W * V1
-*
- CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2 * V2
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - W * V2**T
-*
- CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTC, LASTV-K, K,
- $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
- $ C( 1, K+1 ), LDC )
- END IF
-*
-* W := W * V1**T
-*
- CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 60 J = 1, K
- DO 50 I = 1, LASTC
- C( I, J ) = C( I, J ) - WORK( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- ELSE
-*
-* Let V = ( V1 )
-* ( V2 ) (last K rows)
-* where V2 is unit upper triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTC = ILASLC( M, N, C, LDC )
-*
-* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
-*
-* W := C2**T
-*
- DO 70 J = 1, K
- CALL SCOPY( LASTC, C( M-K+J, 1 ), LDC,
- $ WORK( 1, J ), 1 )
- 70 CONTINUE
-*
-* W := W * V2
-*
- CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
- $ WORK, LDWORK )
- IF( M.GT.K ) THEN
-*
-* W := W + C1**T*V1
-*
- CALL SGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V * W**T
-*
- IF( M.GT.K ) THEN
-*
-* C1 := C1 - V1 * W**T
-*
- CALL SGEMM( 'No transpose', 'Transpose',
- $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2**T
-*
- CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W**T
-*
- DO 90 J = 1, K
- DO 80 I = 1, LASTC
- C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
- 80 CONTINUE
- 90 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTC = ILASLR( M, N, C, LDC )
-*
-* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
-*
-* W := C2
-*
- DO 100 J = 1, K
- CALL SCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
- 100 CONTINUE
-*
-* W := W * V2
-*
- CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
- $ WORK, LDWORK )
- IF( N.GT.K ) THEN
-*
-* W := W + C1 * V1
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V**T
-*
- IF( N.GT.K ) THEN
-*
-* C1 := C1 - W * V1**T
-*
- CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2**T
-*
- CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W
-*
- DO 120 J = 1, K
- DO 110 I = 1, LASTC
- C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J)
- 110 CONTINUE
- 120 CONTINUE
- END IF
- END IF
-*
- ELSE IF( LSAME( STOREV, 'R' ) ) THEN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-* Let V = ( V1 V2 ) (V1: first K columns)
-* where V1 is unit upper triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILASLC( K, M, V, LDV ) )
- LASTC = ILASLC( LASTV, N, C, LDC )
-*
-* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
-*
-* W := C1**T
-*
- DO 130 J = 1, K
- CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 130 CONTINUE
-*
-* W := W * V1**T
-*
- CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2**T*V2**T
-*
- CALL SGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V**T * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - V2**T * W**T
-*
- CALL SGEMM( 'Transpose', 'Transpose',
- $ LASTV-K, LASTC, K,
- $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
- $ ONE, C( K+1, 1 ), LDC )
- END IF
-*
-* W := W * V1
-*
- CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W**T
-*
- DO 150 J = 1, K
- DO 140 I = 1, LASTC
- C( J, I ) = C( J, I ) - WORK( I, J )
- 140 CONTINUE
- 150 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILASLC( K, N, V, LDV ) )
- LASTC = ILASLR( M, LASTV, C, LDC )
-*
-* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
-*
-* W := C1
-*
- DO 160 J = 1, K
- CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
- 160 CONTINUE
-*
-* W := W * V1**T
-*
- CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2 * V2**T
-*
- CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - W * V2
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K,
- $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
- $ ONE, C( 1, K+1 ), LDC )
- END IF
-*
-* W := W * V1
-*
- CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 180 J = 1, K
- DO 170 I = 1, LASTC
- C( I, J ) = C( I, J ) - WORK( I, J )
- 170 CONTINUE
- 180 CONTINUE
-*
- END IF
-*
- ELSE
-*
-* Let V = ( V1 V2 ) (V2: last K columns)
-* where V2 is unit lower triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTC = ILASLC( M, N, C, LDC )
-*
-* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
-*
-* W := C2**T
-*
- DO 190 J = 1, K
- CALL SCOPY( LASTC, C( M-K+J, 1 ), LDC,
- $ WORK( 1, J ), 1 )
- 190 CONTINUE
-*
-* W := W * V2**T
-*
- CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
- $ WORK, LDWORK )
- IF( M.GT.K ) THEN
-*
-* W := W + C1**T * V1**T
-*
- CALL SGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V**T * W**T
-*
- IF( M.GT.K ) THEN
-*
-* C1 := C1 - V1**T * W**T
-*
- CALL SGEMM( 'Transpose', 'Transpose',
- $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2
-*
- CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W**T
-*
- DO 210 J = 1, K
- DO 200 I = 1, LASTC
- C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
- 200 CONTINUE
- 210 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTC = ILASLR( M, N, C, LDC )
-*
-* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
-*
-* W := C2
-*
- DO 220 J = 1, K
- CALL SCOPY( LASTC, C( 1, N-K+J ), 1,
- $ WORK( 1, J ), 1 )
- 220 CONTINUE
-*
-* W := W * V2**T
-*
- CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
- $ WORK, LDWORK )
- IF( N.GT.K ) THEN
-*
-* W := W + C1 * V1**T
-*
- CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V
-*
- IF( N.GT.K ) THEN
-*
-* C1 := C1 - W * V1
-*
- CALL SGEMM( 'No transpose', 'No transpose',
- $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2
-*
- CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
- $ WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 240 J = 1, K
- DO 230 I = 1, LASTC
- C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
- 230 CONTINUE
- 240 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
- RETURN
-*
-* End of SLARFB
-*
- END
diff --git a/netlib/LAPACK/slarfg.f b/netlib/LAPACK/slarfg.f
deleted file mode 100644
index d44f8b1..0000000
--- a/netlib/LAPACK/slarfg.f
+++ /dev/null
@@ -1,196 +0,0 @@
-*> \brief \b SLARFG generates an elementary reflector (Householder matrix).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARFG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* REAL ALPHA, TAU
-* ..
-* .. Array Arguments ..
-* REAL X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARFG generates a real elementary reflector H of order n, such
-*> that
-*>
-*> H * ( alpha ) = ( beta ), H**T * H = I.
-*> ( x ) ( 0 )
-*>
-*> where alpha and beta are scalars, and x is an (n-1)-element real
-*> vector. H is represented in the form
-*>
-*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
-*> ( v )
-*>
-*> where tau is a real scalar and v is a real (n-1)-element
-*> vector.
-*>
-*> If the elements of x are all zero, then tau = 0 and H is taken to be
-*> the unit matrix.
-*>
-*> Otherwise 1 <= tau <= 2.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the elementary reflector.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, the value alpha.
-*> On exit, it is overwritten with the value beta.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension
-*> (1+(N-2)*abs(INCX))
-*> On entry, the vector x.
-*> On exit, it is overwritten with the vector v.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL
-*> The value tau.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- REAL ALPHA, TAU
-* ..
-* .. Array Arguments ..
- REAL X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J, KNT
- REAL BETA, RSAFMN, SAFMIN, XNORM
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLAPY2, SNRM2
- EXTERNAL SLAMCH, SLAPY2, SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.1 ) THEN
- TAU = ZERO
- RETURN
- END IF
-*
- XNORM = SNRM2( N-1, X, INCX )
-*
- IF( XNORM.EQ.ZERO ) THEN
-*
-* H = I
-*
- TAU = ZERO
- ELSE
-*
-* general case
-*
- BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
- SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
- KNT = 0
- IF( ABS( BETA ).LT.SAFMIN ) THEN
-*
-* XNORM, BETA may be inaccurate; scale X and recompute them
-*
- RSAFMN = ONE / SAFMIN
- 10 CONTINUE
- KNT = KNT + 1
- CALL SSCAL( N-1, RSAFMN, X, INCX )
- BETA = BETA*RSAFMN
- ALPHA = ALPHA*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN )
- $ GO TO 10
-*
-* New BETA is at most 1, at least SAFMIN
-*
- XNORM = SNRM2( N-1, X, INCX )
- BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
- END IF
- TAU = ( BETA-ALPHA ) / BETA
- CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
-*
-* If ALPHA is subnormal, it may lose relative accuracy
-*
- DO 20 J = 1, KNT
- BETA = BETA*SAFMIN
- 20 CONTINUE
- ALPHA = BETA
- END IF
-*
- RETURN
-*
-* End of SLARFG
-*
- END
diff --git a/netlib/LAPACK/slarfgp.f b/netlib/LAPACK/slarfgp.f
deleted file mode 100644
index 706966d..0000000
--- a/netlib/LAPACK/slarfgp.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b SLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARFGP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfgp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfgp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfgp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARFGP( N, ALPHA, X, INCX, TAU )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* REAL ALPHA, TAU
-* ..
-* .. Array Arguments ..
-* REAL X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARFGP generates a real elementary reflector H of order n, such
-*> that
-*>
-*> H * ( alpha ) = ( beta ), H**T * H = I.
-*> ( x ) ( 0 )
-*>
-*> where alpha and beta are scalars, beta is non-negative, and x is
-*> an (n-1)-element real vector. H is represented in the form
-*>
-*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
-*> ( v )
-*>
-*> where tau is a real scalar and v is a real (n-1)-element
-*> vector.
-*>
-*> If the elements of x are all zero, then tau = 0 and H is taken to be
-*> the unit matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the elementary reflector.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, the value alpha.
-*> On exit, it is overwritten with the value beta.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension
-*> (1+(N-2)*abs(INCX))
-*> On entry, the vector x.
-*> On exit, it is overwritten with the vector v.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL
-*> The value tau.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARFGP( N, ALPHA, X, INCX, TAU )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- REAL ALPHA, TAU
-* ..
-* .. Array Arguments ..
- REAL X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL TWO, ONE, ZERO
- PARAMETER ( TWO = 2.0E+0, ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J, KNT
- REAL BETA, BIGNUM, SAVEALPHA, SMLNUM, XNORM
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLAPY2, SNRM2
- EXTERNAL SLAMCH, SLAPY2, SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- TAU = ZERO
- RETURN
- END IF
-*
- XNORM = SNRM2( N-1, X, INCX )
-*
- IF( XNORM.EQ.ZERO ) THEN
-*
-* H = [+/-1, 0; I], sign chosen so ALPHA >= 0.
-*
- IF( ALPHA.GE.ZERO ) THEN
-* When TAU.eq.ZERO, the vector is special-cased to be
-* all zeros in the application routines. We do not need
-* to clear it.
- TAU = ZERO
- ELSE
-* However, the application routines rely on explicit
-* zero checks when TAU.ne.ZERO, and we must clear X.
- TAU = TWO
- DO J = 1, N-1
- X( 1 + (J-1)*INCX ) = 0
- END DO
- ALPHA = -ALPHA
- END IF
- ELSE
-*
-* general case
-*
- BETA = SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
- SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'E' )
- KNT = 0
- IF( ABS( BETA ).LT.SMLNUM ) THEN
-*
-* XNORM, BETA may be inaccurate; scale X and recompute them
-*
- BIGNUM = ONE / SMLNUM
- 10 CONTINUE
- KNT = KNT + 1
- CALL SSCAL( N-1, BIGNUM, X, INCX )
- BETA = BETA*BIGNUM
- ALPHA = ALPHA*BIGNUM
- IF( ABS( BETA ).LT.SMLNUM )
- $ GO TO 10
-*
-* New BETA is at most 1, at least SMLNUM
-*
- XNORM = SNRM2( N-1, X, INCX )
- BETA = SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
- END IF
- SAVEALPHA = ALPHA
- ALPHA = ALPHA + BETA
- IF( BETA.LT.ZERO ) THEN
- BETA = -BETA
- TAU = -ALPHA / BETA
- ELSE
- ALPHA = XNORM * (XNORM/ALPHA)
- TAU = ALPHA / BETA
- ALPHA = -ALPHA
- END IF
-*
- IF ( ABS(TAU).LE.SMLNUM ) THEN
-*
-* In the case where the computed TAU ends up being a denormalized number,
-* it loses relative accuracy. This is a BIG problem. Solution: flush TAU
-* to ZERO. This explains the next IF statement.
-*
-* (Bug report provided by Pat Quillen from MathWorks on Jul 29, 2009.)
-* (Thanks Pat. Thanks MathWorks.)
-*
- IF( SAVEALPHA.GE.ZERO ) THEN
- TAU = ZERO
- ELSE
- TAU = TWO
- DO J = 1, N-1
- X( 1 + (J-1)*INCX ) = 0
- END DO
- BETA = -SAVEALPHA
- END IF
-*
- ELSE
-*
-* This is the general case.
-*
- CALL SSCAL( N-1, ONE / ALPHA, X, INCX )
-*
- END IF
-*
-* If BETA is subnormal, it may lose relative accuracy
-*
- DO 20 J = 1, KNT
- BETA = BETA*SMLNUM
- 20 CONTINUE
- ALPHA = BETA
- END IF
-*
- RETURN
-*
-* End of SLARFGP
-*
- END
diff --git a/netlib/LAPACK/slarft.f b/netlib/LAPACK/slarft.f
deleted file mode 100644
index bc3521d..0000000
--- a/netlib/LAPACK/slarft.f
+++ /dev/null
@@ -1,326 +0,0 @@
-*> \brief \b SLARFT forms the triangular factor T of a block reflector H = I - vtvH
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARFT + dependencies
-*> <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>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, STOREV
-* INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
-* REAL T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARFT forms the triangular factor T of a real block reflector H
-*> of order n, which is defined as a product of k elementary reflectors.
-*>
-*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
-*>
-*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
-*>
-*> If STOREV = 'C', the vector which defines the elementary reflector
-*> H(i) is stored in the i-th column of the array V, and
-*>
-*> H = I - V * T * V**T
-*>
-*> If STOREV = 'R', the vector which defines the elementary reflector
-*> H(i) is stored in the i-th row of the array V, and
-*>
-*> H = I - V**T * T * V
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Specifies the order in which the elementary reflectors are
-*> multiplied to form the block reflector:
-*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*> \endverbatim
-*>
-*> \param[in] STOREV
-*> \verbatim
-*> STOREV is CHARACTER*1
-*> Specifies how the vectors which define the elementary
-*> reflectors are stored (see also Further Details):
-*> = 'C': columnwise
-*> = 'R': rowwise
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the block reflector H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the triangular factor T (= the number of
-*> elementary reflectors). K >= 1.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,N) if STOREV = 'R'
-*> The matrix V. See further details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,K)
-*> The k by k triangular factor T of the block reflector.
-*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*> lower triangular. The rest of the array is not used.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \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 (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, STOREV
- INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
- REAL T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, PREVLASTV, LASTV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, STRMV
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
- PREVLASTV = N
- DO I = 1, K
- PREVLASTV = MAX( I, PREVLASTV )
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO J = 1, I
- T( J, I ) = ZERO
- END DO
- ELSE
-*
-* general case
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
-* Skip any trailing zeros.
- DO LASTV = N, I+1, -1
- IF( V( LASTV, I ).NE.ZERO ) EXIT
- END DO
- DO J = 1, I-1
- T( J, I ) = -TAU( I ) * V( I , J )
- END DO
- J = MIN( LASTV, PREVLASTV )
-*
-* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i)
-*
- CALL SGEMV( 'Transpose', J-I, I-1, -TAU( I ),
- $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE,
- $ T( 1, I ), 1 )
- ELSE
-* Skip any trailing zeros.
- DO LASTV = N, I+1, -1
- IF( V( I, LASTV ).NE.ZERO ) EXIT
- END DO
- DO J = 1, I-1
- T( J, I ) = -TAU( I ) * V( J , I )
- END DO
- J = MIN( LASTV, PREVLASTV )
-*
-* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T
-*
- CALL SGEMV( 'No transpose', I-1, J-I, -TAU( I ),
- $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
- $ ONE, T( 1, I ), 1 )
- END IF
-*
-* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
-*
- CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
- $ LDT, T( 1, I ), 1 )
- T( I, I ) = TAU( I )
- IF( I.GT.1 ) THEN
- PREVLASTV = MAX( PREVLASTV, LASTV )
- ELSE
- PREVLASTV = LASTV
- END IF
- END IF
- END DO
- ELSE
- PREVLASTV = 1
- DO I = K, 1, -1
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO J = I, K
- T( J, I ) = ZERO
- END DO
- ELSE
-*
-* general case
-*
- IF( I.LT.K ) THEN
- IF( LSAME( STOREV, 'C' ) ) THEN
-* Skip any leading zeros.
- DO LASTV = 1, I-1
- IF( V( LASTV, I ).NE.ZERO ) EXIT
- END DO
- DO J = I+1, K
- T( J, I ) = -TAU( I ) * V( N-K+I , J )
- END DO
- J = MAX( LASTV, PREVLASTV )
-*
-* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i)
-*
- CALL SGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ),
- $ V( J, I+1 ), LDV, V( J, I ), 1, ONE,
- $ T( I+1, I ), 1 )
- ELSE
-* Skip any leading zeros.
- DO LASTV = 1, I-1
- IF( V( I, LASTV ).NE.ZERO ) EXIT
- END DO
- DO J = I+1, K
- T( J, I ) = -TAU( I ) * V( J, N-K+I )
- END DO
- J = MAX( LASTV, PREVLASTV )
-*
-* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T
-*
- CALL SGEMV( 'No transpose', K-I, N-K+I-J,
- $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV,
- $ ONE, T( I+1, I ), 1 )
- END IF
-*
-* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
-*
- CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
- $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
- IF( I.GT.1 ) THEN
- PREVLASTV = MIN( PREVLASTV, LASTV )
- ELSE
- PREVLASTV = LASTV
- END IF
- END IF
- T( I, I ) = TAU( I )
- END IF
- END DO
- END IF
- RETURN
-*
-* End of SLARFT
-*
- END
diff --git a/netlib/LAPACK/slarfx.f b/netlib/LAPACK/slarfx.f
deleted file mode 100644
index c4bb71b..0000000
--- a/netlib/LAPACK/slarfx.f
+++ /dev/null
@@ -1,696 +0,0 @@
-*> \brief \b SLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARFX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER LDC, M, N
-* REAL TAU
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARFX applies a real elementary reflector H to a real m by n
-*> matrix C, from either the left or the right. H is represented in the
-*> form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar and v is a real vector.
-*>
-*> If tau = 0, then H is taken to be the unit matrix
-*>
-*> This version uses inline code if H has order < 11.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension (M) if SIDE = 'L'
-*> or (N) if SIDE = 'R'
-*> The vector v in the representation of H.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDA >= (1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> WORK is not referenced if H has order < 11.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER LDC, M, N
- REAL TAU
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J
- REAL SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
- $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF
-* ..
-* .. Executable Statements ..
-*
- IF( TAU.EQ.ZERO )
- $ RETURN
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C, where H has order m.
-*
- GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
- $ 170, 190 )M
-*
-* Code for general M
-*
- CALL SLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
- GO TO 410
- 10 CONTINUE
-*
-* Special code for 1 x 1 Householder
-*
- T1 = ONE - TAU*V( 1 )*V( 1 )
- DO 20 J = 1, N
- C( 1, J ) = T1*C( 1, J )
- 20 CONTINUE
- GO TO 410
- 30 CONTINUE
-*
-* Special code for 2 x 2 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- DO 40 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- 40 CONTINUE
- GO TO 410
- 50 CONTINUE
-*
-* Special code for 3 x 3 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- DO 60 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- 60 CONTINUE
- GO TO 410
- 70 CONTINUE
-*
-* Special code for 4 x 4 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- DO 80 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- 80 CONTINUE
- GO TO 410
- 90 CONTINUE
-*
-* Special code for 5 x 5 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- DO 100 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- 100 CONTINUE
- GO TO 410
- 110 CONTINUE
-*
-* Special code for 6 x 6 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- DO 120 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- 120 CONTINUE
- GO TO 410
- 130 CONTINUE
-*
-* Special code for 7 x 7 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- DO 140 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- 140 CONTINUE
- GO TO 410
- 150 CONTINUE
-*
-* Special code for 8 x 8 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- DO 160 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- 160 CONTINUE
- GO TO 410
- 170 CONTINUE
-*
-* Special code for 9 x 9 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- DO 180 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- C( 9, J ) = C( 9, J ) - SUM*T9
- 180 CONTINUE
- GO TO 410
- 190 CONTINUE
-*
-* Special code for 10 x 10 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- V10 = V( 10 )
- T10 = TAU*V10
- DO 200 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
- $ V10*C( 10, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- C( 9, J ) = C( 9, J ) - SUM*T9
- C( 10, J ) = C( 10, J ) - SUM*T10
- 200 CONTINUE
- GO TO 410
- ELSE
-*
-* Form C * H, where H has order n.
-*
- GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
- $ 370, 390 )N
-*
-* Code for general N
-*
- CALL SLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
- GO TO 410
- 210 CONTINUE
-*
-* Special code for 1 x 1 Householder
-*
- T1 = ONE - TAU*V( 1 )*V( 1 )
- DO 220 J = 1, M
- C( J, 1 ) = T1*C( J, 1 )
- 220 CONTINUE
- GO TO 410
- 230 CONTINUE
-*
-* Special code for 2 x 2 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- DO 240 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- 240 CONTINUE
- GO TO 410
- 250 CONTINUE
-*
-* Special code for 3 x 3 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- DO 260 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- 260 CONTINUE
- GO TO 410
- 270 CONTINUE
-*
-* Special code for 4 x 4 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- DO 280 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- 280 CONTINUE
- GO TO 410
- 290 CONTINUE
-*
-* Special code for 5 x 5 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- DO 300 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- 300 CONTINUE
- GO TO 410
- 310 CONTINUE
-*
-* Special code for 6 x 6 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- DO 320 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- 320 CONTINUE
- GO TO 410
- 330 CONTINUE
-*
-* Special code for 7 x 7 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- DO 340 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- 340 CONTINUE
- GO TO 410
- 350 CONTINUE
-*
-* Special code for 8 x 8 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- DO 360 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- 360 CONTINUE
- GO TO 410
- 370 CONTINUE
-*
-* Special code for 9 x 9 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- DO 380 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- C( J, 9 ) = C( J, 9 ) - SUM*T9
- 380 CONTINUE
- GO TO 410
- 390 CONTINUE
-*
-* Special code for 10 x 10 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- V10 = V( 10 )
- T10 = TAU*V10
- DO 400 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
- $ V10*C( J, 10 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- C( J, 9 ) = C( J, 9 ) - SUM*T9
- C( J, 10 ) = C( J, 10 ) - SUM*T10
- 400 CONTINUE
- GO TO 410
- END IF
- 410 RETURN
-*
-* End of SLARFX
-*
- END
diff --git a/netlib/LAPACK/slarge.f b/netlib/LAPACK/slarge.f
deleted file mode 100644
index 5184bb5..0000000
--- a/netlib/LAPACK/slarge.f
+++ /dev/null
@@ -1,174 +0,0 @@
-*> \brief \b SLARGE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARGE( N, A, LDA, ISEED, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARGE pre- and post-multiplies a real general n by n matrix A
-*> with a random orthogonal matrix: A = U*D*U'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the original n by n matrix A.
-*> On exit, A is overwritten by U*A*U' for some random
-*> orthogonal matrix U.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= N.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLARGE( N, A, LDA, ISEED, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL TAU, WA, WB, WN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER, SLARNV, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN
-* ..
-* .. External Functions ..
- REAL SNRM2
- EXTERNAL SNRM2
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'SLARGE', -INFO )
- RETURN
- END IF
-*
-* pre- and post-multiply A by random orthogonal matrix
-*
- DO 10 I = N, 1, -1
-*
-* generate random reflection
-*
- CALL SLARNV( 3, ISEED, N-I+1, WORK )
- WN = SNRM2( N-I+1, WORK, 1 )
- WA = SIGN( WN, WORK( 1 ) )
- IF( WN.EQ.ZERO ) THEN
- TAU = ZERO
- ELSE
- WB = WORK( 1 ) + WA
- CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
- WORK( 1 ) = ONE
- TAU = WB / WA
- END IF
-*
-* multiply A(i:n,1:n) by random reflection from the left
-*
- CALL SGEMV( 'Transpose', N-I+1, N, ONE, A( I, 1 ), LDA, WORK,
- $ 1, ZERO, WORK( N+1 ), 1 )
- CALL SGER( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
- $ LDA )
-*
-* multiply A(1:n,i:n) by random reflection from the right
-*
- CALL SGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
- $ WORK, 1, ZERO, WORK( N+1 ), 1 )
- CALL SGER( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
- $ LDA )
- 10 CONTINUE
- RETURN
-*
-* End of SLARGE
-*
- END
diff --git a/netlib/LAPACK/slargv.f b/netlib/LAPACK/slargv.f
deleted file mode 100644
index a587e08..0000000
--- a/netlib/LAPACK/slargv.f
+++ /dev/null
@@ -1,167 +0,0 @@
-*> \brief \b SLARGV generates a vector of plane rotations with real cosines and real sines.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slargv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slargv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slargv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARGV( N, X, INCX, Y, INCY, C, INCC )
-*
-* .. Scalar Arguments ..
-* INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
-* REAL C( * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARGV generates a vector of real plane rotations, determined by
-*> elements of the real vectors x and y. For i = 1,2,...,n
-*>
-*> ( c(i) s(i) ) ( x(i) ) = ( a(i) )
-*> ( -s(i) c(i) ) ( y(i) ) = ( 0 )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of plane rotations to be generated.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array,
-*> dimension (1+(N-1)*INCX)
-*> On entry, the vector x.
-*> On exit, x(i) is overwritten by a(i), for i = 1,...,n.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array,
-*> dimension (1+(N-1)*INCY)
-*> On entry, the vector y.
-*> On exit, the sines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> The increment between elements of Y. INCY > 0.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array, dimension (1+(N-1)*INCC)
-*> The cosines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCC
-*> \verbatim
-*> INCC is INTEGER
-*> The increment between elements of C. INCC > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARGV( N, X, INCX, Y, INCY, C, INCC )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
- REAL C( * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IC, IX, IY
- REAL F, G, T, TT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IX = 1
- IY = 1
- IC = 1
- DO 10 I = 1, N
- F = X( IX )
- G = Y( IY )
- IF( G.EQ.ZERO ) THEN
- C( IC ) = ONE
- ELSE IF( F.EQ.ZERO ) THEN
- C( IC ) = ZERO
- Y( IY ) = ONE
- X( IX ) = G
- ELSE IF( ABS( F ).GT.ABS( G ) ) THEN
- T = G / F
- TT = SQRT( ONE+T*T )
- C( IC ) = ONE / TT
- Y( IY ) = T*C( IC )
- X( IX ) = F*TT
- ELSE
- T = F / G
- TT = SQRT( ONE+T*T )
- Y( IY ) = ONE / TT
- C( IC ) = T*Y( IY )
- X( IX ) = G*TT
- END IF
- IC = IC + INCC
- IY = IY + INCY
- IX = IX + INCX
- 10 CONTINUE
- RETURN
-*
-* End of SLARGV
-*
- END
diff --git a/netlib/LAPACK/slarnd.f b/netlib/LAPACK/slarnd.f
deleted file mode 100644
index 126aa4f..0000000
--- a/netlib/LAPACK/slarnd.f
+++ /dev/null
@@ -1,133 +0,0 @@
-*> \brief \b SLARND
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLARND( IDIST, ISEED )
-*
-* .. Scalar Arguments ..
-* INTEGER IDIST
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARND returns a random real number from a uniform or normal
-*> distribution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> Specifies the distribution of the random numbers:
-*> = 1: uniform (0,1)
-*> = 2: uniform (-1,1)
-*> = 3: normal (0,1)
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine calls the auxiliary routine SLARAN to generate a random
-*> real number from a uniform (0,1) distribution. The Box-Muller method
-*> is used to transform numbers from a uniform to a normal distribution.
-*> \endverbatim
-*>
-* =====================================================================
- REAL FUNCTION SLARND( IDIST, ISEED )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IDIST
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, TWO
- PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 )
- REAL TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 )
-* ..
-* .. Local Scalars ..
- REAL T1, T2
-* ..
-* .. External Functions ..
- REAL SLARAN
- EXTERNAL SLARAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC COS, LOG, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Generate a real random number from a uniform (0,1) distribution
-*
- T1 = SLARAN( ISEED )
-*
- IF( IDIST.EQ.1 ) THEN
-*
-* uniform (0,1)
-*
- SLARND = T1
- ELSE IF( IDIST.EQ.2 ) THEN
-*
-* uniform (-1,1)
-*
- SLARND = TWO*T1 - ONE
- ELSE IF( IDIST.EQ.3 ) THEN
-*
-* normal (0,1)
-*
- T2 = SLARAN( ISEED )
- SLARND = SQRT( -TWO*LOG( T1 ) )*COS( TWOPI*T2 )
- END IF
- RETURN
-*
-* End of SLARND
-*
- END
diff --git a/netlib/LAPACK/slarnv.f b/netlib/LAPACK/slarnv.f
deleted file mode 100644
index eede7fc..0000000
--- a/netlib/LAPACK/slarnv.f
+++ /dev/null
@@ -1,178 +0,0 @@
-*> \brief \b SLARNV returns a vector of random numbers from a uniform or normal distribution.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARNV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarnv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarnv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarnv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARNV( IDIST, ISEED, N, X )
-*
-* .. Scalar Arguments ..
-* INTEGER IDIST, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARNV returns a vector of n random real numbers from a uniform or
-*> normal distribution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> Specifies the distribution of the random numbers:
-*> = 1: uniform (0,1)
-*> = 2: uniform (-1,1)
-*> = 3: normal (0,1)
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of random numbers to be generated.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> The generated random numbers.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine calls the auxiliary routine SLARUV to generate random
-*> real numbers from a uniform (0,1) distribution, in batches of up to
-*> 128 using vectorisable code. The Box-Muller method is used to
-*> transform numbers from a uniform to a normal distribution.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLARNV( IDIST, ISEED, N, X )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IDIST, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, TWO
- PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 )
- INTEGER LV
- PARAMETER ( LV = 128 )
- REAL TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IL, IL2, IV
-* ..
-* .. Local Arrays ..
- REAL U( LV )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC COS, LOG, MIN, SQRT
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARUV
-* ..
-* .. Executable Statements ..
-*
- DO 40 IV = 1, N, LV / 2
- IL = MIN( LV / 2, N-IV+1 )
- IF( IDIST.EQ.3 ) THEN
- IL2 = 2*IL
- ELSE
- IL2 = IL
- END IF
-*
-* Call SLARUV to generate IL2 numbers from a uniform (0,1)
-* distribution (IL2 <= LV)
-*
- CALL SLARUV( ISEED, IL2, U )
-*
- IF( IDIST.EQ.1 ) THEN
-*
-* Copy generated numbers
-*
- DO 10 I = 1, IL
- X( IV+I-1 ) = U( I )
- 10 CONTINUE
- ELSE IF( IDIST.EQ.2 ) THEN
-*
-* Convert generated numbers to uniform (-1,1) distribution
-*
- DO 20 I = 1, IL
- X( IV+I-1 ) = TWO*U( I ) - ONE
- 20 CONTINUE
- ELSE IF( IDIST.EQ.3 ) THEN
-*
-* Convert generated numbers to normal (0,1) distribution
-*
- DO 30 I = 1, IL
- X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
- $ COS( TWOPI*U( 2*I ) )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- RETURN
-*
-* End of SLARNV
-*
- END
diff --git a/netlib/LAPACK/slaror.f b/netlib/LAPACK/slaror.f
deleted file mode 100644
index 2c9657e..0000000
--- a/netlib/LAPACK/slaror.f
+++ /dev/null
@@ -1,304 +0,0 @@
-*> \brief \b SLAROR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER INIT, SIDE
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL A( LDA, * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAROR pre- or post-multiplies an M by N matrix A by a random
-*> orthogonal matrix U, overwriting A. A may optionally be initialized
-*> to the identity matrix before multiplying by U. U is generated using
-*> the method of G.W. Stewart (SIAM J. Numer. Anal. 17, 1980, 403-409).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> Specifies whether A is multiplied on the left or right by U.
-*> = 'L': Multiply A on the left (premultiply) by U
-*> = 'R': Multiply A on the right (postmultiply) by U'
-*> = 'C' or 'T': Multiply A on the left by U and the right
-*> by U' (Here, U' means U-transpose.)
-*> \endverbatim
-*>
-*> \param[in] INIT
-*> \verbatim
-*> INIT is CHARACTER*1
-*> Specifies whether or not A should be initialized to the
-*> identity matrix.
-*> = 'I': Initialize A to (a section of) the identity matrix
-*> before applying U.
-*> = 'N': No initialization. Apply U to the input matrix A.
-*>
-*> INIT = 'I' may be used to generate square or rectangular
-*> orthogonal matrices:
-*>
-*> For M = N and SIDE = 'L' or 'R', the rows will be orthogonal
-*> to each other, as will the columns.
-*>
-*> If M < N, SIDE = 'R' produces a dense matrix whose rows are
-*> orthogonal and whose columns are not, while SIDE = 'L'
-*> produces a matrix whose rows are orthogonal, and whose first
-*> M columns are orthogonal, and whose remaining columns are
-*> zero.
-*>
-*> If M > N, SIDE = 'L' produces a dense matrix whose columns
-*> are orthogonal and whose rows are not, while SIDE = 'R'
-*> produces a matrix whose columns are orthogonal, and whose
-*> first M rows are orthogonal, and whose remaining rows are
-*> zero.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the array A.
-*> On exit, overwritten by U A ( if SIDE = 'L' ),
-*> or by A U ( if SIDE = 'R' ),
-*> or by U A U' ( if SIDE = 'C' or 'T').
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry ISEED specifies the seed of the random number
-*> generator. The array elements should be between 0 and 4095;
-*> if not they will be reduced mod 4096. Also, ISEED(4) must
-*> be odd. The random number generator uses a linear
-*> congruential sequence limited to small integers, and so
-*> should produce machine independent random numbers. The
-*> values of ISEED are changed on exit, and can be used in the
-*> next call to SLAROR to continue the same random number
-*> sequence.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (3*MAX( M, N ))
-*> Workspace of length
-*> 2*M + N if SIDE = 'L',
-*> 2*N + M if SIDE = 'R',
-*> 3*N if SIDE = 'C' or 'T'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> An error flag. It is set to:
-*> = 0: normal return
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> = 1: if the random numbers generated by SLARND are bad.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER INIT, SIDE
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL A( LDA, * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TOOSML
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0,
- $ TOOSML = 1.0E-20 )
-* ..
-* .. Local Scalars ..
- INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
- REAL FACTOR, XNORM, XNORMS
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLARND, SNRM2
- EXTERNAL LSAME, SLARND, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER, SLASET, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.EQ.0 .OR. M.EQ.0 )
- $ RETURN
-*
- ITYPE = 0
- IF( LSAME( SIDE, 'L' ) ) THEN
- ITYPE = 1
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
- ITYPE = 2
- ELSE IF( LSAME( SIDE, 'C' ) .OR. LSAME( SIDE, 'T' ) ) THEN
- ITYPE = 3
- END IF
-*
-* Check for argument errors.
-*
- IF( ITYPE.EQ.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN
- INFO = -4
- ELSE IF( LDA.LT.M ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAROR', -INFO )
- RETURN
- END IF
-*
- IF( ITYPE.EQ.1 ) THEN
- NXFRM = M
- ELSE
- NXFRM = N
- END IF
-*
-* Initialize A to the identity matrix if desired
-*
- IF( LSAME( INIT, 'I' ) )
- $ CALL SLASET( 'Full', M, N, ZERO, ONE, A, LDA )
-*
-* If no rotation possible, multiply by random +/-1
-*
-* Compute rotation by computing Householder transformations
-* H(2), H(3), ..., H(nhouse)
-*
- DO 10 J = 1, NXFRM
- X( J ) = ZERO
- 10 CONTINUE
-*
- DO 30 IXFRM = 2, NXFRM
- KBEG = NXFRM - IXFRM + 1
-*
-* Generate independent normal( 0, 1 ) random numbers
-*
- DO 20 J = KBEG, NXFRM
- X( J ) = SLARND( 3, ISEED )
- 20 CONTINUE
-*
-* Generate a Householder transformation from the random vector X
-*
- XNORM = SNRM2( IXFRM, X( KBEG ), 1 )
- XNORMS = SIGN( XNORM, X( KBEG ) )
- X( KBEG+NXFRM ) = SIGN( ONE, -X( KBEG ) )
- FACTOR = XNORMS*( XNORMS+X( KBEG ) )
- IF( ABS( FACTOR ).LT.TOOSML ) THEN
- INFO = 1
- CALL XERBLA( 'SLAROR', INFO )
- RETURN
- ELSE
- FACTOR = ONE / FACTOR
- END IF
- X( KBEG ) = X( KBEG ) + XNORMS
-*
-* Apply Householder transformation to A
-*
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN
-*
-* Apply H(k) from the left.
-*
- CALL SGEMV( 'T', IXFRM, N, ONE, A( KBEG, 1 ), LDA,
- $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 )
- CALL SGER( IXFRM, N, -FACTOR, X( KBEG ), 1, X( 2*NXFRM+1 ),
- $ 1, A( KBEG, 1 ), LDA )
-*
- END IF
-*
- IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN
-*
-* Apply H(k) from the right.
-*
- CALL SGEMV( 'N', M, IXFRM, ONE, A( 1, KBEG ), LDA,
- $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 )
- CALL SGER( M, IXFRM, -FACTOR, X( 2*NXFRM+1 ), 1, X( KBEG ),
- $ 1, A( 1, KBEG ), LDA )
-*
- END IF
- 30 CONTINUE
-*
- X( 2*NXFRM ) = SIGN( ONE, SLARND( 3, ISEED ) )
-*
-* Scale the matrix A by D.
-*
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN
- DO 40 IROW = 1, M
- CALL SSCAL( N, X( NXFRM+IROW ), A( IROW, 1 ), LDA )
- 40 CONTINUE
- END IF
-*
- IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN
- DO 50 JCOL = 1, N
- CALL SSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 )
- 50 CONTINUE
- END IF
- RETURN
-*
-* End of SLAROR
-*
- END
diff --git a/netlib/LAPACK/slarot.f b/netlib/LAPACK/slarot.f
deleted file mode 100644
index f243baf..0000000
--- a/netlib/LAPACK/slarot.f
+++ /dev/null
@@ -1,317 +0,0 @@
-*> \brief \b SLAROT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
-* XRIGHT )
-*
-* .. Scalar Arguments ..
-* LOGICAL LLEFT, LRIGHT, LROWS
-* INTEGER LDA, NL
-* REAL C, S, XLEFT, XRIGHT
-* ..
-* .. Array Arguments ..
-* REAL A( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAROT applies a (Givens) rotation to two adjacent rows or
-*> columns, where one element of the first and/or last column/row
-*> for use on matrices stored in some format other than GE, so
-*> that elements of the matrix may be used or modified for which
-*> no array element is provided.
-*>
-*> One example is a symmetric matrix in SB format (bandwidth=4), for
-*> which UPLO='L': Two adjacent rows will have the format:
-*>
-*> row j: C> C> C> C> C> . . . .
-*> row j+1: C> C> C> C> C> . . . .
-*>
-*> '*' indicates elements for which storage is provided,
-*> '.' indicates elements for which no storage is provided, but
-*> are not necessarily zero; their values are determined by
-*> symmetry. ' ' indicates elements which are necessarily zero,
-*> and have no storage provided.
-*>
-*> Those columns which have two '*'s can be handled by SROT.
-*> Those columns which have no '*'s can be ignored, since as long
-*> as the Givens rotations are carefully applied to preserve
-*> symmetry, their values are determined.
-*> Those columns which have one '*' have to be handled separately,
-*> by using separate variables "p" and "q":
-*>
-*> row j: C> C> C> C> C> p . . .
-*> row j+1: q C> C> C> C> C> . . . .
-*>
-*> The element p would have to be set correctly, then that column
-*> is rotated, setting p to its new value. The next call to
-*> SLAROT would rotate columns j and j+1, using p, and restore
-*> symmetry. The element q would start out being zero, and be
-*> made non-zero by the rotation. Later, rotations would presumably
-*> be chosen to zero q out.
-*>
-*> Typical Calling Sequences: rotating the i-th and (i+1)-st rows.
-*> ------- ------- ---------
-*>
-*> General dense matrix:
-*>
-*> CALL SLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S,
-*> A(i,1),LDA, DUMMY, DUMMY)
-*>
-*> General banded matrix in GB format:
-*>
-*> j = MAX(1, i-KL )
-*> NL = MIN( N, i+KU+1 ) + 1-j
-*> CALL SLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S,
-*> A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT )
-*>
-*> [ note that i+1-j is just MIN(i,KL+1) ]
-*>
-*> Symmetric banded matrix in SY format, bandwidth K,
-*> lower triangle only:
-*>
-*> j = MAX(1, i-K )
-*> NL = MIN( K+1, i ) + 1
-*> CALL SLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S,
-*> A(i,j), LDA, XLEFT, XRIGHT )
-*>
-*> Same, but upper triangle only:
-*>
-*> NL = MIN( K+1, N-i ) + 1
-*> CALL SLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S,
-*> A(i,i), LDA, XLEFT, XRIGHT )
-*>
-*> Symmetric banded matrix in SB format, bandwidth K,
-*> lower triangle only:
-*>
-*> [ same as for SY, except:]
-*> . . . .
-*> A(i+1-j,j), LDA-1, XLEFT, XRIGHT )
-*>
-*> [ note that i+1-j is just MIN(i,K+1) ]
-*>
-*> Same, but upper triangle only:
-*> . . .
-*> A(K+1,i), LDA-1, XLEFT, XRIGHT )
-*>
-*> Rotating columns is just the transpose of rotating rows, except
-*> for GB and SB: (rotating columns i and i+1)
-*>
-*> GB:
-*> j = MAX(1, i-KU )
-*> NL = MIN( N, i+KL+1 ) + 1-j
-*> CALL SLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S,
-*> A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM )
-*>
-*> [note that KU+j+1-i is just MAX(1,KU+2-i)]
-*>
-*> SB: (upper triangle)
-*>
-*> . . . . . .
-*> A(K+j+1-i,i),LDA-1, XTOP, XBOTTM )
-*>
-*> SB: (lower triangle)
-*>
-*> . . . . . .
-*> A(1,i),LDA-1, XTOP, XBOTTM )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \verbatim
-*> LROWS - LOGICAL
-*> If .TRUE., then SLAROT will rotate two rows. If .FALSE.,
-*> then it will rotate two columns.
-*> Not modified.
-*>
-*> LLEFT - LOGICAL
-*> If .TRUE., then XLEFT will be used instead of the
-*> corresponding element of A for the first element in the
-*> second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.)
-*> If .FALSE., then the corresponding element of A will be
-*> used.
-*> Not modified.
-*>
-*> LRIGHT - LOGICAL
-*> If .TRUE., then XRIGHT will be used instead of the
-*> corresponding element of A for the last element in the
-*> first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If
-*> .FALSE., then the corresponding element of A will be used.
-*> Not modified.
-*>
-*> NL - INTEGER
-*> The length of the rows (if LROWS=.TRUE.) or columns (if
-*> LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are
-*> used, the columns/rows they are in should be included in
-*> NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at
-*> least 2. The number of rows/columns to be rotated
-*> exclusive of those involving XLEFT and/or XRIGHT may
-*> not be negative, i.e., NL minus how many of LLEFT and
-*> LRIGHT are .TRUE. must be at least zero; if not, XERBLA
-*> will be called.
-*> Not modified.
-*>
-*> C, S - REAL
-*> Specify the Givens rotation to be applied. If LROWS is
-*> true, then the matrix ( c s )
-*> (-s c ) is applied from the left;
-*> if false, then the transpose thereof is applied from the
-*> right. For a Givens rotation, C**2 + S**2 should be 1,
-*> but this is not checked.
-*> Not modified.
-*>
-*> A - REAL array.
-*> The array containing the rows/columns to be rotated. The
-*> first element of A should be the upper left element to
-*> be rotated.
-*> Read and modified.
-*>
-*> LDA - INTEGER
-*> The "effective" leading dimension of A. If A contains
-*> a matrix stored in GE or SY format, then this is just
-*> the leading dimension of A as dimensioned in the calling
-*> routine. If A contains a matrix stored in band (GB or SB)
-*> format, then this should be *one less* than the leading
-*> dimension used in the calling routine. Thus, if
-*> A were dimensioned A(LDA,*) in SLAROT, then A(1,j) would
-*> be the j-th element in the first of the two rows
-*> to be rotated, and A(2,j) would be the j-th in the second,
-*> regardless of how the array may be stored in the calling
-*> routine. [A cannot, however, actually be dimensioned thus,
-*> since for band format, the row number may exceed LDA, which
-*> is not legal FORTRAN.]
-*> If LROWS=.TRUE., then LDA must be at least 1, otherwise
-*> it must be at least NL minus the number of .TRUE. values
-*> in XLEFT and XRIGHT.
-*> Not modified.
-*>
-*> XLEFT - REAL
-*> If LLEFT is .TRUE., then XLEFT will be used and modified
-*> instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
-*> (if LROWS=.FALSE.).
-*> Read and modified.
-*>
-*> XRIGHT - REAL
-*> If LRIGHT is .TRUE., then XRIGHT will be used and modified
-*> instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
-*> (if LROWS=.FALSE.).
-*> Read and modified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
- $ XRIGHT )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL LLEFT, LRIGHT, LROWS
- INTEGER LDA, NL
- REAL C, S, XLEFT, XRIGHT
-* ..
-* .. Array Arguments ..
- REAL A( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER IINC, INEXT, IX, IY, IYT, NT
-* ..
-* .. Local Arrays ..
- REAL XT( 2 ), YT( 2 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SROT, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Set up indices, arrays for ends
-*
- IF( LROWS ) THEN
- IINC = LDA
- INEXT = 1
- ELSE
- IINC = 1
- INEXT = LDA
- END IF
-*
- IF( LLEFT ) THEN
- NT = 1
- IX = 1 + IINC
- IY = 2 + LDA
- XT( 1 ) = A( 1 )
- YT( 1 ) = XLEFT
- ELSE
- NT = 0
- IX = 1
- IY = 1 + INEXT
- END IF
-*
- IF( LRIGHT ) THEN
- IYT = 1 + INEXT + ( NL-1 )*IINC
- NT = NT + 1
- XT( NT ) = XRIGHT
- YT( NT ) = A( IYT )
- END IF
-*
-* Check for errors
-*
- IF( NL.LT.NT ) THEN
- CALL XERBLA( 'SLAROT', 4 )
- RETURN
- END IF
- IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN
- CALL XERBLA( 'SLAROT', 8 )
- RETURN
- END IF
-*
-* Rotate
-*
- CALL SROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S )
- CALL SROT( NT, XT, 1, YT, 1, C, S )
-*
-* Stuff values back into XLEFT, XRIGHT, etc.
-*
- IF( LLEFT ) THEN
- A( 1 ) = XT( 1 )
- XLEFT = YT( 1 )
- END IF
-*
- IF( LRIGHT ) THEN
- XRIGHT = XT( NT )
- A( IYT ) = YT( NT )
- END IF
-*
- RETURN
-*
-* End of SLAROT
-*
- END
diff --git a/netlib/LAPACK/slarra.f b/netlib/LAPACK/slarra.f
deleted file mode 100644
index ffc7c40..0000000
--- a/netlib/LAPACK/slarra.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b SLARRA computes the splitting points with the specified threshold.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarra.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarra.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarra.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM,
-* NSPLIT, ISPLIT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N, NSPLIT
-* REAL SPLTOL, TNRM
-* ..
-* .. Array Arguments ..
-* INTEGER ISPLIT( * )
-* REAL D( * ), E( * ), E2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Compute the splitting points with threshold SPLTOL.
-*> SLARRA sets any "small" off-diagonal elements to zero.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal
-*> matrix T.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> On entry, the first (N-1) entries contain the subdiagonal
-*> elements of the tridiagonal matrix T; E(N) need not be set.
-*> On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
-*> are set to zero, the other entries of E are untouched.
-*> \endverbatim
-*>
-*> \param[in,out] E2
-*> \verbatim
-*> E2 is REAL array, dimension (N)
-*> On entry, the first (N-1) entries contain the SQUARES of the
-*> subdiagonal elements of the tridiagonal matrix T;
-*> E2(N) need not be set.
-*> On exit, the entries E2( ISPLIT( I ) ),
-*> 1 <= I <= NSPLIT, have been set to zero
-*> \endverbatim
-*>
-*> \param[in] SPLTOL
-*> \verbatim
-*> SPLTOL is REAL
-*> The threshold for splitting. Two criteria can be used:
-*> SPLTOL<0 : criterion based on absolute off-diagonal value
-*> SPLTOL>0 : criterion that preserves relative accuracy
-*> \endverbatim
-*>
-*> \param[in] TNRM
-*> \verbatim
-*> TNRM is REAL
-*> The norm of the matrix.
-*> \endverbatim
-*>
-*> \param[out] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of blocks T splits into. 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[out] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into blocks.
-*> The first block consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM,
- $ NSPLIT, ISPLIT, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N, NSPLIT
- REAL SPLTOL, TNRM
-* ..
-* .. Array Arguments ..
- INTEGER ISPLIT( * )
- REAL D( * ), E( * ), E2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL EABS, TMP1
-
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-
-* Compute splitting points
- NSPLIT = 1
- IF(SPLTOL.LT.ZERO) THEN
-* Criterion based on absolute off-diagonal value
- TMP1 = ABS(SPLTOL)* TNRM
- DO 9 I = 1, N-1
- EABS = ABS( E(I) )
- IF( EABS .LE. TMP1) THEN
- E(I) = ZERO
- E2(I) = ZERO
- ISPLIT( NSPLIT ) = I
- NSPLIT = NSPLIT + 1
- END IF
- 9 CONTINUE
- ELSE
-* Criterion that guarantees relative accuracy
- DO 10 I = 1, N-1
- EABS = ABS( E(I) )
- IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) )
- $ THEN
- E(I) = ZERO
- E2(I) = ZERO
- ISPLIT( NSPLIT ) = I
- NSPLIT = NSPLIT + 1
- END IF
- 10 CONTINUE
- ENDIF
- ISPLIT( NSPLIT ) = N
-
- RETURN
-*
-* End of SLARRA
-*
- END
diff --git a/netlib/LAPACK/slarrb.f b/netlib/LAPACK/slarrb.f
deleted file mode 100644
index d39c32d..0000000
--- a/netlib/LAPACK/slarrb.f
+++ /dev/null
@@ -1,401 +0,0 @@
-*> \brief \b SLARRB provides limited bisection to locate eigenvalues for more accuracy.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
-* RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
-* PIVMIN, SPDIAM, TWIST, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
-* REAL PIVMIN, RTOL1, RTOL2, SPDIAM
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL D( * ), LLD( * ), W( * ),
-* $ WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given the relatively robust representation(RRR) L D L^T, SLARRB
-*> does "limited" bisection to refine the eigenvalues of L D L^T,
-*> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
-*> guesses for these eigenvalues are input in W, the corresponding estimate
-*> of the error in these guesses and their gaps are input in WERR
-*> and WGAP, respectively. During bisection, intervals
-*> [left, right] are maintained by storing their mid-points and
-*> semi-widths in the arrays W and WERR respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] LLD
-*> \verbatim
-*> LLD is REAL array, dimension (N-1)
-*> The (N-1) elements L(i)*L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] IFIRST
-*> \verbatim
-*> IFIRST is INTEGER
-*> The index of the first eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] ILAST
-*> \verbatim
-*> ILAST is INTEGER
-*> The index of the last eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] RTOL1
-*> \verbatim
-*> RTOL1 is REAL
-*> \endverbatim
-*>
-*> \param[in] RTOL2
-*> \verbatim
-*> RTOL2 is REAL
-*> Tolerance for the convergence of the bisection intervals.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
-*> where GAP is the (estimated) distance to the nearest
-*> eigenvalue.
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFSET
-*> through ILAST-OFFSET elements of these arrays are to be used.
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
-*> estimates of the eigenvalues of L D L^T indexed IFIRST throug
-*> ILAST.
-*> On output, these estimates are refined.
-*> \endverbatim
-*>
-*> \param[in,out] WGAP
-*> \verbatim
-*> WGAP is REAL array, dimension (N-1)
-*> On input, the (estimated) gaps between consecutive
-*> eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap between
-*> eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST
-*> then WGAP(IFIRST-OFFSET) must be set to ZERO.
-*> On output, these gaps are refined.
-*> \endverbatim
-*>
-*> \param[in,out] WERR
-*> \verbatim
-*> WERR is REAL array, dimension (N)
-*> On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are
-*> the errors in the estimates of the corresponding elements in W.
-*> On output, these errors are refined.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[in] SPDIAM
-*> \verbatim
-*> SPDIAM is REAL
-*> The spectral diameter of the matrix.
-*> \endverbatim
-*>
-*> \param[in] TWIST
-*> \verbatim
-*> TWIST is INTEGER
-*> The twist index for the twisted factorization that is used
-*> for the negcount.
-*> TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L+^T
-*> TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U-^T
-*> TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(r) N(r)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error flag.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
- $ RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
- $ PIVMIN, SPDIAM, TWIST, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
- REAL PIVMIN, RTOL1, RTOL2, SPDIAM
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL D( * ), LLD( * ), W( * ),
- $ WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, TWO, HALF
- PARAMETER ( ZERO = 0.0E0, TWO = 2.0E0,
- $ HALF = 0.5E0 )
- INTEGER MAXITR
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, II, IP, ITER, K, NEGCNT, NEXT, NINT,
- $ OLNINT, PREV, R
- REAL BACK, CVRGD, GAP, LEFT, LGAP, MID, MNWDTH,
- $ RGAP, RIGHT, TMP, WIDTH
-* ..
-* .. External Functions ..
- INTEGER SLANEG
- EXTERNAL SLANEG
-*
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
- MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- MNWDTH = TWO * PIVMIN
-*
- R = TWIST
- IF((R.LT.1).OR.(R.GT.N)) R = N
-*
-* Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ].
-* The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while
-* Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 )
-* for an unconverged interval is set to the index of the next unconverged
-* interval, and is -1 or 0 for a converged interval. Thus a linked
-* list of unconverged intervals is set up.
-*
- I1 = IFIRST
-* The number of unconverged intervals
- NINT = 0
-* The last unconverged interval found
- PREV = 0
-
- RGAP = WGAP( I1-OFFSET )
- DO 75 I = I1, ILAST
- K = 2*I
- II = I - OFFSET
- LEFT = W( II ) - WERR( II )
- RIGHT = W( II ) + WERR( II )
- LGAP = RGAP
- RGAP = WGAP( II )
- GAP = MIN( LGAP, RGAP )
-
-* Make sure that [LEFT,RIGHT] contains the desired eigenvalue
-* Compute negcount from dstqds facto L+D+L+^T = L D L^T - LEFT
-*
-* Do while( NEGCNT(LEFT).GT.I-1 )
-*
- BACK = WERR( II )
- 20 CONTINUE
- NEGCNT = SLANEG( N, D, LLD, LEFT, PIVMIN, R )
- IF( NEGCNT.GT.I-1 ) THEN
- LEFT = LEFT - BACK
- BACK = TWO*BACK
- GO TO 20
- END IF
-*
-* Do while( NEGCNT(RIGHT).LT.I )
-* Compute negcount from dstqds facto L+D+L+^T = L D L^T - RIGHT
-*
- BACK = WERR( II )
- 50 CONTINUE
-
- NEGCNT = SLANEG( N, D, LLD, RIGHT, PIVMIN, R )
- IF( NEGCNT.LT.I ) THEN
- RIGHT = RIGHT + BACK
- BACK = TWO*BACK
- GO TO 50
- END IF
- WIDTH = HALF*ABS( LEFT - RIGHT )
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
- CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
- IF( WIDTH.LE.CVRGD .OR. WIDTH.LE.MNWDTH ) THEN
-* This interval has already converged and does not need refinement.
-* (Note that the gaps might change through refining the
-* eigenvalues, however, they can only get bigger.)
-* Remove it from the list.
- IWORK( K-1 ) = -1
-* Make sure that I1 always points to the first unconverged interval
- IF((I.EQ.I1).AND.(I.LT.ILAST)) I1 = I + 1
- IF((PREV.GE.I1).AND.(I.LE.ILAST)) IWORK( 2*PREV-1 ) = I + 1
- ELSE
-* unconverged interval found
- PREV = I
- NINT = NINT + 1
- IWORK( K-1 ) = I + 1
- IWORK( K ) = NEGCNT
- END IF
- WORK( K-1 ) = LEFT
- WORK( K ) = RIGHT
- 75 CONTINUE
-
-*
-* Do while( NINT.GT.0 ), i.e. there are still unconverged intervals
-* and while (ITER.LT.MAXITR)
-*
- ITER = 0
- 80 CONTINUE
- PREV = I1 - 1
- I = I1
- OLNINT = NINT
-
- DO 100 IP = 1, OLNINT
- K = 2*I
- II = I - OFFSET
- RGAP = WGAP( II )
- LGAP = RGAP
- IF(II.GT.1) LGAP = WGAP( II-1 )
- GAP = MIN( LGAP, RGAP )
- NEXT = IWORK( K-1 )
- LEFT = WORK( K-1 )
- RIGHT = WORK( K )
- MID = HALF*( LEFT + RIGHT )
-
-* semiwidth of interval
- WIDTH = RIGHT - MID
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
- CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
- IF( ( WIDTH.LE.CVRGD ) .OR. ( WIDTH.LE.MNWDTH ).OR.
- $ ( ITER.EQ.MAXITR ) )THEN
-* reduce number of unconverged intervals
- NINT = NINT - 1
-* Mark interval as converged.
- IWORK( K-1 ) = 0
- IF( I1.EQ.I ) THEN
- I1 = NEXT
- ELSE
-* Prev holds the last unconverged interval previously examined
- IF(PREV.GE.I1) IWORK( 2*PREV-1 ) = NEXT
- END IF
- I = NEXT
- GO TO 100
- END IF
- PREV = I
-*
-* Perform one bisection step
-*
- NEGCNT = SLANEG( N, D, LLD, MID, PIVMIN, R )
- IF( NEGCNT.LE.I-1 ) THEN
- WORK( K-1 ) = MID
- ELSE
- WORK( K ) = MID
- END IF
- I = NEXT
- 100 CONTINUE
- ITER = ITER + 1
-* do another loop if there are still unconverged intervals
-* However, in the last iteration, all intervals are accepted
-* since this is the best we can do.
- IF( ( NINT.GT.0 ).AND.(ITER.LE.MAXITR) ) GO TO 80
-*
-*
-* At this point, all the intervals have converged
- DO 110 I = IFIRST, ILAST
- K = 2*I
- II = I - OFFSET
-* All intervals marked by '0' have been refined.
- IF( IWORK( K-1 ).EQ.0 ) THEN
- W( II ) = HALF*( WORK( K-1 )+WORK( K ) )
- WERR( II ) = WORK( K ) - W( II )
- END IF
- 110 CONTINUE
-*
- DO 111 I = IFIRST+1, ILAST
- K = 2*I
- II = I - OFFSET
- WGAP( II-1 ) = MAX( ZERO,
- $ W(II) - WERR (II) - W( II-1 ) - WERR( II-1 ))
- 111 CONTINUE
-
- RETURN
-*
-* End of SLARRB
-*
- END
diff --git a/netlib/LAPACK/slarrc.f b/netlib/LAPACK/slarrc.f
deleted file mode 100644
index 7812ca5..0000000
--- a/netlib/LAPACK/slarrc.f
+++ /dev/null
@@ -1,243 +0,0 @@
-*> \brief \b SLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
-* EIGCNT, LCNT, RCNT, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBT
-* INTEGER EIGCNT, INFO, LCNT, N, RCNT
-* REAL PIVMIN, VL, VU
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Find the number of eigenvalues of the symmetric tridiagonal matrix T
-*> that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
-*> if JOBT = 'L'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBT
-*> \verbatim
-*> JOBT is CHARACTER*1
-*> = 'T': Compute Sturm count for matrix T.
-*> = 'L': Compute Sturm count for matrix L D L^T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is DOUBLE PRECISION
-*> The lower and upper bounds for the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
-*> JOBT = 'L': The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
-*> JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[out] EIGCNT
-*> \verbatim
-*> EIGCNT is INTEGER
-*> The number of eigenvalues of the symmetric tridiagonal matrix T
-*> that are in the interval (VL,VU]
-*> \endverbatim
-*>
-*> \param[out] LCNT
-*> \verbatim
-*> LCNT is INTEGER
-*> \endverbatim
-*>
-*> \param[out] RCNT
-*> \verbatim
-*> RCNT is INTEGER
-*> The left and right negcounts of the interval.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
- $ EIGCNT, LCNT, RCNT, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBT
- INTEGER EIGCNT, INFO, LCNT, N, RCNT
- REAL PIVMIN, VL, VU
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- LOGICAL MATT
- REAL LPIVOT, RPIVOT, SL, SU, TMP, TMP2
-
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- LCNT = 0
- RCNT = 0
- EIGCNT = 0
- MATT = LSAME( JOBT, 'T' )
-
-
- IF (MATT) THEN
-* Sturm sequence count on T
- LPIVOT = D( 1 ) - VL
- RPIVOT = D( 1 ) - VU
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- DO 10 I = 1, N-1
- TMP = E(I)**2
- LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
- RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- 10 CONTINUE
- ELSE
-* Sturm sequence count on L D L^T
- SL = -VL
- SU = -VU
- DO 20 I = 1, N - 1
- LPIVOT = D( I ) + SL
- RPIVOT = D( I ) + SU
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- TMP = E(I) * D(I) * E(I)
-*
- TMP2 = TMP / LPIVOT
- IF( TMP2.EQ.ZERO ) THEN
- SL = TMP - VL
- ELSE
- SL = SL*TMP2 - VL
- END IF
-*
- TMP2 = TMP / RPIVOT
- IF( TMP2.EQ.ZERO ) THEN
- SU = TMP - VU
- ELSE
- SU = SU*TMP2 - VU
- END IF
- 20 CONTINUE
- LPIVOT = D( N ) + SL
- RPIVOT = D( N ) + SU
- IF( LPIVOT.LE.ZERO ) THEN
- LCNT = LCNT + 1
- ENDIF
- IF( RPIVOT.LE.ZERO ) THEN
- RCNT = RCNT + 1
- ENDIF
- ENDIF
- EIGCNT = RCNT - LCNT
-
- RETURN
-*
-* end of SLARRC
-*
- END
diff --git a/netlib/LAPACK/slarrd.f b/netlib/LAPACK/slarrd.f
deleted file mode 100644
index 7d17210..0000000
--- a/netlib/LAPACK/slarrd.f
+++ /dev/null
@@ -1,855 +0,0 @@
-*> \brief \b SLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS,
-* RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
-* M, W, WERR, WL, WU, IBLOCK, INDEXW,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ORDER, RANGE
-* INTEGER IL, INFO, IU, M, N, NSPLIT
-* REAL PIVMIN, RELTOL, VL, VU, WL, WU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), INDEXW( * ),
-* $ ISPLIT( * ), IWORK( * )
-* REAL D( * ), E( * ), E2( * ),
-* $ GERS( * ), W( * ), WERR( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARRD computes the eigenvalues of a symmetric tridiagonal
-*> matrix T to suitable accuracy. This is an auxiliary code to be
-*> called from SSTEMR.
-*> The user may ask for all eigenvalues, all eigenvalues
-*> in the half-open interval (VL, VU], or the IL-th through IU-th
-*> eigenvalues.
-*>
-*> To avoid overflow, the matrix must be scaled so that its
-*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
-*> accuracy, it should not be much smaller than that.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': ("All") all eigenvalues will be found.
-*> = 'V': ("Value") all eigenvalues in the half-open interval
-*> (VL, VU] will be found.
-*> = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
-*> entire matrix) will be found.
-*> \endverbatim
-*>
-*> \param[in] ORDER
-*> \verbatim
-*> ORDER is CHARACTER*1
-*> = 'B': ("By Block") the eigenvalues will be grouped by
-*> split-off block (see IBLOCK, ISPLIT) and
-*> ordered from smallest to largest within
-*> the block.
-*> = 'E': ("Entire matrix")
-*> the eigenvalues for the entire matrix
-*> will be ordered from smallest to
-*> largest.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. Eigenvalues less than or equal
-*> to VL, or greater than VU, will not be returned. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] GERS
-*> \verbatim
-*> GERS is REAL array, dimension (2*N)
-*> The N Gerschgorin intervals (the i-th Gerschgorin interval
-*> is (GERS(2*i-1), GERS(2*i)).
-*> \endverbatim
-*>
-*> \param[in] RELTOL
-*> \verbatim
-*> RELTOL is REAL
-*> The minimum relative width of an interval. When an interval
-*> is narrower than RELTOL times the larger (in
-*> magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. Note: this should
-*> always be at least radix*machine epsilon.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is REAL array, dimension (N-1)
-*> The (n-1) squared off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot allowed in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[in] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of diagonal blocks in the matrix T.
-*> 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[in] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into submatrices.
-*> The first submatrix consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> (Only the first NSPLIT elements will actually be used, but
-*> since the user cannot know a priori what value NSPLIT will
-*> have, N words must be reserved for ISPLIT.)
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The actual number of eigenvalues found. 0 <= M <= N.
-*> (See also the description of INFO=2,3.)
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On exit, the first M elements of W will contain the
-*> eigenvalue approximations. SLARRD computes an interval
-*> I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
-*> approximation is given as the interval midpoint
-*> W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
-*> WERR(j) = abs( a_j - b_j)/2
-*> \endverbatim
-*>
-*> \param[out] WERR
-*> \verbatim
-*> WERR is REAL array, dimension (N)
-*> The error bound on the corresponding eigenvalue approximation
-*> in W.
-*> \endverbatim
-*>
-*> \param[out] WL
-*> \verbatim
-*> WL is REAL
-*> \endverbatim
-*>
-*> \param[out] WU
-*> \verbatim
-*> WU is REAL
-*> The interval (WL, WU] contains all the wanted eigenvalues.
-*> If RANGE='V', then WL=VL and WU=VU.
-*> If RANGE='A', then WL and WU are the global Gerschgorin bounds
-*> on the spectrum.
-*> If RANGE='I', then WL and WU are computed by SLAEBZ from the
-*> index range specified.
-*> \endverbatim
-*>
-*> \param[out] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> At each row/column j where E(j) is zero or small, the
-*> matrix T is considered to split into a block diagonal
-*> matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
-*> block (from 1 to the number of blocks) the eigenvalue W(i)
-*> belongs. (SLARRD may use the remaining N-M elements as
-*> workspace.)
-*> \endverbatim
-*>
-*> \param[out] INDEXW
-*> \verbatim
-*> INDEXW is INTEGER array, dimension (N)
-*> The indices of the eigenvalues within each block (submatrix);
-*> for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
-*> i-th eigenvalue W(i) is the j-th eigenvalue in block k.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: some or all of the eigenvalues failed to converge or
-*> were not computed:
-*> =1 or 3: Bisection failed to converge for some
-*> eigenvalues; these eigenvalues are flagged by a
-*> negative block number. The effect is that the
-*> eigenvalues may not be as accurate as the
-*> absolute and relative tolerances. This is
-*> generally caused by unexpectedly inaccurate
-*> arithmetic.
-*> =2 or 3: RANGE='I' only: Not all of the eigenvalues
-*> IL:IU were found.
-*> Effect: M < IU+1-IL
-*> Cause: non-monotonic arithmetic, causing the
-*> Sturm sequence to be non-monotonic.
-*> Cure: recalculate, using RANGE='A', and pick
-*> out eigenvalues IL:IU. In some cases,
-*> increasing the PARAMETER "FUDGE" may
-*> make things work.
-*> = 4: RANGE='I', and the Gershgorin interval
-*> initially used was too small. No eigenvalues
-*> were computed.
-*> Probable cause: your machine has sloppy
-*> floating-point arithmetic.
-*> Cure: Increase the PARAMETER "FUDGE",
-*> recompile, and try again.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> FUDGE REAL, default = 2
-*> A "fudge factor" to widen the Gershgorin intervals. Ideally,
-*> a value of 1 should work, but on machines with sloppy
-*> arithmetic, this needs to be larger. The default for
-*> publicly released versions should be large enough to handle
-*> the worst machine around. Note that this has no effect
-*> on accuracy of the solution.
-*> \endverbatim
-*>
-*> \par Contributors:
-* ==================
-*>
-*> W. Kahan, University of California, Berkeley, USA \n
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA \n
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS,
- $ RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
- $ M, W, WERR, WL, WU, IBLOCK, INDEXW,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER ORDER, RANGE
- INTEGER IL, INFO, IU, M, N, NSPLIT
- REAL PIVMIN, RELTOL, VL, VU, WL, WU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), INDEXW( * ),
- $ ISPLIT( * ), IWORK( * )
- REAL D( * ), E( * ), E2( * ),
- $ GERS( * ), W( * ), WERR( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, HALF, FUDGE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0,
- $ TWO = 2.0E0, HALF = ONE/TWO,
- $ FUDGE = TWO )
- INTEGER ALLRNG, VALRNG, INDRNG
- PARAMETER ( ALLRNG = 1, VALRNG = 2, INDRNG = 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL NCNVRG, TOOFEW
- INTEGER I, IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
- $ IM, IN, IOFF, IOUT, IRANGE, ITMAX, ITMP1,
- $ ITMP2, IW, IWOFF, J, JBLK, JDISC, JE, JEE, NB,
- $ NWL, NWU
- REAL ATOLI, EPS, GL, GU, RTOLI, TMP1, TMP2,
- $ TNORM, UFLOW, WKILL, WLU, WUL
-
-* ..
-* .. Local Arrays ..
- INTEGER IDUMMA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH
- EXTERNAL LSAME, ILAENV, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAEBZ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Decode RANGE
-*
- IF( LSAME( RANGE, 'A' ) ) THEN
- IRANGE = ALLRNG
- ELSE IF( LSAME( RANGE, 'V' ) ) THEN
- IRANGE = VALRNG
- ELSE IF( LSAME( RANGE, 'I' ) ) THEN
- IRANGE = INDRNG
- ELSE
- IRANGE = 0
- END IF
-*
-* Check for Errors
-*
- IF( IRANGE.LE.0 ) THEN
- INFO = -1
- ELSE IF( .NOT.(LSAME(ORDER,'B').OR.LSAME(ORDER,'E')) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( IRANGE.EQ.VALRNG ) THEN
- IF( VL.GE.VU )
- $ INFO = -5
- ELSE IF( IRANGE.EQ.INDRNG .AND.
- $ ( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) ) THEN
- INFO = -6
- ELSE IF( IRANGE.EQ.INDRNG .AND.
- $ ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
-
-* Initialize error flags
- INFO = 0
- NCNVRG = .FALSE.
- TOOFEW = .FALSE.
-
-* Quick return if possible
- M = 0
- IF( N.EQ.0 ) RETURN
-
-* Simplification:
- IF( IRANGE.EQ.INDRNG .AND. IL.EQ.1 .AND. IU.EQ.N ) IRANGE = 1
-
-* Get machine constants
- EPS = SLAMCH( 'P' )
- UFLOW = SLAMCH( 'U' )
-
-
-* Special Case when N=1
-* Treat case of 1x1 matrix for quick return
- IF( N.EQ.1 ) THEN
- IF( (IRANGE.EQ.ALLRNG).OR.
- $ ((IRANGE.EQ.VALRNG).AND.(D(1).GT.VL).AND.(D(1).LE.VU)).OR.
- $ ((IRANGE.EQ.INDRNG).AND.(IL.EQ.1).AND.(IU.EQ.1)) ) THEN
- M = 1
- W(1) = D(1)
-* The computation error of the eigenvalue is zero
- WERR(1) = ZERO
- IBLOCK( 1 ) = 1
- INDEXW( 1 ) = 1
- ENDIF
- RETURN
- END IF
-
-* NB is the minimum vector length for vector bisection, or 0
-* if only scalar is to be done.
- NB = ILAENV( 1, 'SSTEBZ', ' ', N, -1, -1, -1 )
- IF( NB.LE.1 ) NB = 0
-
-* Find global spectral radius
- GL = D(1)
- GU = D(1)
- DO 5 I = 1,N
- GL = MIN( GL, GERS( 2*I - 1))
- GU = MAX( GU, GERS(2*I) )
- 5 CONTINUE
-* Compute global Gerschgorin bounds and spectral diameter
- TNORM = MAX( ABS( GL ), ABS( GU ) )
- GL = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN
- GU = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN
-* [JAN/28/2009] remove the line below since SPDIAM variable not use
-* SPDIAM = GU - GL
-* Input arguments for SLAEBZ:
-* The relative tolerance. An interval (a,b] lies within
-* "relative tolerance" if b-a < RELTOL*max(|a|,|b|),
- RTOLI = RELTOL
-* Set the absolute tolerance for interval convergence to zero to force
-* interval convergence based on relative size of the interval.
-* This is dangerous because intervals might not converge when RELTOL is
-* small. But at least a very small number should be selected so that for
-* strongly graded matrices, the code can get relatively accurate
-* eigenvalues.
- ATOLI = FUDGE*TWO*UFLOW + FUDGE*TWO*PIVMIN
-
- IF( IRANGE.EQ.INDRNG ) THEN
-
-* RANGE='I': Compute an interval containing eigenvalues
-* IL through IU. The initial interval [GL,GU] from the global
-* Gerschgorin bounds GL and GU is refined by SLAEBZ.
- ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- WORK( N+1 ) = GL
- WORK( N+2 ) = GL
- WORK( N+3 ) = GU
- WORK( N+4 ) = GU
- WORK( N+5 ) = GL
- WORK( N+6 ) = GU
- IWORK( 1 ) = -1
- IWORK( 2 ) = -1
- IWORK( 3 ) = N + 1
- IWORK( 4 ) = N + 1
- IWORK( 5 ) = IL - 1
- IWORK( 6 ) = IU
-*
- CALL SLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN,
- $ D, E, E2, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
- $ IWORK, W, IBLOCK, IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = IINFO
- RETURN
- END IF
-* On exit, output intervals may not be ordered by ascending negcount
- IF( IWORK( 6 ).EQ.IU ) THEN
- WL = WORK( N+1 )
- WLU = WORK( N+3 )
- NWL = IWORK( 1 )
- WU = WORK( N+4 )
- WUL = WORK( N+2 )
- NWU = IWORK( 4 )
- ELSE
- WL = WORK( N+2 )
- WLU = WORK( N+4 )
- NWL = IWORK( 2 )
- WU = WORK( N+3 )
- WUL = WORK( N+1 )
- NWU = IWORK( 3 )
- END IF
-* On exit, the interval [WL, WLU] contains a value with negcount NWL,
-* and [WUL, WU] contains a value with negcount NWU.
- IF( NWL.LT.0 .OR. NWL.GE.N .OR. NWU.LT.1 .OR. NWU.GT.N ) THEN
- INFO = 4
- RETURN
- END IF
-
- ELSEIF( IRANGE.EQ.VALRNG ) THEN
- WL = VL
- WU = VU
-
- ELSEIF( IRANGE.EQ.ALLRNG ) THEN
- WL = GL
- WU = GU
- ENDIF
-
-
-
-* Find Eigenvalues -- Loop Over blocks and recompute NWL and NWU.
-* NWL accumulates the number of eigenvalues .le. WL,
-* NWU accumulates the number of eigenvalues .le. WU
- M = 0
- IEND = 0
- INFO = 0
- NWL = 0
- NWU = 0
-*
- DO 70 JBLK = 1, NSPLIT
- IOFF = IEND
- IBEGIN = IOFF + 1
- IEND = ISPLIT( JBLK )
- IN = IEND - IOFF
-*
- IF( IN.EQ.1 ) THEN
-* 1x1 block
- IF( WL.GE.D( IBEGIN )-PIVMIN )
- $ NWL = NWL + 1
- IF( WU.GE.D( IBEGIN )-PIVMIN )
- $ NWU = NWU + 1
- IF( IRANGE.EQ.ALLRNG .OR.
- $ ( WL.LT.D( IBEGIN )-PIVMIN
- $ .AND. WU.GE. D( IBEGIN )-PIVMIN ) ) THEN
- M = M + 1
- W( M ) = D( IBEGIN )
- WERR(M) = ZERO
-* The gap for a single block doesn't matter for the later
-* algorithm and is assigned an arbitrary large value
- IBLOCK( M ) = JBLK
- INDEXW( M ) = 1
- END IF
-
-* Disabled 2x2 case because of a failure on the following matrix
-* RANGE = 'I', IL = IU = 4
-* Original Tridiagonal, d = [
-* -0.150102010615740E+00
-* -0.849897989384260E+00
-* -0.128208148052635E-15
-* 0.128257718286320E-15
-* ];
-* e = [
-* -0.357171383266986E+00
-* -0.180411241501588E-15
-* -0.175152352710251E-15
-* ];
-*
-* ELSE IF( IN.EQ.2 ) THEN
-** 2x2 block
-* DISC = SQRT( (HALF*(D(IBEGIN)-D(IEND)))**2 + E(IBEGIN)**2 )
-* TMP1 = HALF*(D(IBEGIN)+D(IEND))
-* L1 = TMP1 - DISC
-* IF( WL.GE. L1-PIVMIN )
-* $ NWL = NWL + 1
-* IF( WU.GE. L1-PIVMIN )
-* $ NWU = NWU + 1
-* IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L1-PIVMIN .AND. WU.GE.
-* $ L1-PIVMIN ) ) THEN
-* M = M + 1
-* W( M ) = L1
-** The uncertainty of eigenvalues of a 2x2 matrix is very small
-* WERR( M ) = EPS * ABS( W( M ) ) * TWO
-* IBLOCK( M ) = JBLK
-* INDEXW( M ) = 1
-* ENDIF
-* L2 = TMP1 + DISC
-* IF( WL.GE. L2-PIVMIN )
-* $ NWL = NWL + 1
-* IF( WU.GE. L2-PIVMIN )
-* $ NWU = NWU + 1
-* IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L2-PIVMIN .AND. WU.GE.
-* $ L2-PIVMIN ) ) THEN
-* M = M + 1
-* W( M ) = L2
-** The uncertainty of eigenvalues of a 2x2 matrix is very small
-* WERR( M ) = EPS * ABS( W( M ) ) * TWO
-* IBLOCK( M ) = JBLK
-* INDEXW( M ) = 2
-* ENDIF
- ELSE
-* General Case - block of size IN >= 2
-* Compute local Gerschgorin interval and use it as the initial
-* interval for SLAEBZ
- GU = D( IBEGIN )
- GL = D( IBEGIN )
- TMP1 = ZERO
-
- DO 40 J = IBEGIN, IEND
- GL = MIN( GL, GERS( 2*J - 1))
- GU = MAX( GU, GERS(2*J) )
- 40 CONTINUE
-* [JAN/28/2009]
-* change SPDIAM by TNORM in lines 2 and 3 thereafter
-* line 1: remove computation of SPDIAM (not useful anymore)
-* SPDIAM = GU - GL
-* GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN
-* GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN
- GL = GL - FUDGE*TNORM*EPS*IN - FUDGE*PIVMIN
- GU = GU + FUDGE*TNORM*EPS*IN + FUDGE*PIVMIN
-*
- IF( IRANGE.GT.1 ) THEN
- IF( GU.LT.WL ) THEN
-* the local block contains none of the wanted eigenvalues
- NWL = NWL + IN
- NWU = NWU + IN
- GO TO 70
- END IF
-* refine search interval if possible, only range (WL,WU] matters
- GL = MAX( GL, WL )
- GU = MIN( GU, WU )
- IF( GL.GE.GU )
- $ GO TO 70
- END IF
-
-* Find negcount of initial interval boundaries GL and GU
- WORK( N+1 ) = GL
- WORK( N+IN+1 ) = GU
- CALL SLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = IINFO
- RETURN
- END IF
-*
- NWL = NWL + IWORK( 1 )
- NWU = NWU + IWORK( IN+1 )
- IWOFF = M - IWORK( 1 )
-
-* Compute Eigenvalues
- ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- CALL SLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = IINFO
- RETURN
- END IF
-*
-* Copy eigenvalues into W and IBLOCK
-* Use -JBLK for block number for unconverged eigenvalues.
-* Loop over the number of output intervals from SLAEBZ
- DO 60 J = 1, IOUT
-* eigenvalue approximation is middle point of interval
- TMP1 = HALF*( WORK( J+N )+WORK( J+IN+N ) )
-* semi length of error interval
- TMP2 = HALF*ABS( WORK( J+N )-WORK( J+IN+N ) )
- IF( J.GT.IOUT-IINFO ) THEN
-* Flag non-convergence.
- NCNVRG = .TRUE.
- IB = -JBLK
- ELSE
- IB = JBLK
- END IF
- DO 50 JE = IWORK( J ) + 1 + IWOFF,
- $ IWORK( J+IN ) + IWOFF
- W( JE ) = TMP1
- WERR( JE ) = TMP2
- INDEXW( JE ) = JE - IWOFF
- IBLOCK( JE ) = IB
- 50 CONTINUE
- 60 CONTINUE
-*
- M = M + IM
- END IF
- 70 CONTINUE
-
-* If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
-* If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
- IF( IRANGE.EQ.INDRNG ) THEN
- IDISCL = IL - 1 - NWL
- IDISCU = NWU - IU
-*
- IF( IDISCL.GT.0 ) THEN
- IM = 0
- DO 80 JE = 1, M
-* Remove some of the smallest eigenvalues from the left so that
-* at the end IDISCL =0. Move all eigenvalues up to the left.
- IF( W( JE ).LE.WLU .AND. IDISCL.GT.0 ) THEN
- IDISCL = IDISCL - 1
- ELSE
- IM = IM + 1
- W( IM ) = W( JE )
- WERR( IM ) = WERR( JE )
- INDEXW( IM ) = INDEXW( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 80 CONTINUE
- M = IM
- END IF
- IF( IDISCU.GT.0 ) THEN
-* Remove some of the largest eigenvalues from the right so that
-* at the end IDISCU =0. Move all eigenvalues up to the left.
- IM=M+1
- DO 81 JE = M, 1, -1
- IF( W( JE ).GE.WUL .AND. IDISCU.GT.0 ) THEN
- IDISCU = IDISCU - 1
- ELSE
- IM = IM - 1
- W( IM ) = W( JE )
- WERR( IM ) = WERR( JE )
- INDEXW( IM ) = INDEXW( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 81 CONTINUE
- JEE = 0
- DO 82 JE = IM, M
- JEE = JEE + 1
- W( JEE ) = W( JE )
- WERR( JEE ) = WERR( JE )
- INDEXW( JEE ) = INDEXW( JE )
- IBLOCK( JEE ) = IBLOCK( JE )
- 82 CONTINUE
- M = M-IM+1
- END IF
-
- IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
-* Code to deal with effects of bad arithmetic. (If N(w) is
-* monotone non-decreasing, this should never happen.)
-* Some low eigenvalues to be discarded are not in (WL,WLU],
-* or high eigenvalues to be discarded are not in (WUL,WU]
-* so just kill off the smallest IDISCL/largest IDISCU
-* eigenvalues, by marking the corresponding IBLOCK = 0
- IF( IDISCL.GT.0 ) THEN
- WKILL = WU
- DO 100 JDISC = 1, IDISCL
- IW = 0
- DO 90 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).LT.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 90 CONTINUE
- IBLOCK( IW ) = 0
- 100 CONTINUE
- END IF
- IF( IDISCU.GT.0 ) THEN
- WKILL = WL
- DO 120 JDISC = 1, IDISCU
- IW = 0
- DO 110 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).GE.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 110 CONTINUE
- IBLOCK( IW ) = 0
- 120 CONTINUE
- END IF
-* Now erase all eigenvalues with IBLOCK set to zero
- IM = 0
- DO 130 JE = 1, M
- IF( IBLOCK( JE ).NE.0 ) THEN
- IM = IM + 1
- W( IM ) = W( JE )
- WERR( IM ) = WERR( JE )
- INDEXW( IM ) = INDEXW( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 130 CONTINUE
- M = IM
- END IF
- IF( IDISCL.LT.0 .OR. IDISCU.LT.0 ) THEN
- TOOFEW = .TRUE.
- END IF
- END IF
-*
- IF(( IRANGE.EQ.ALLRNG .AND. M.NE.N ).OR.
- $ ( IRANGE.EQ.INDRNG .AND. M.NE.IU-IL+1 ) ) THEN
- TOOFEW = .TRUE.
- END IF
-
-* If ORDER='B', do nothing the eigenvalues are already sorted by
-* block.
-* If ORDER='E', sort the eigenvalues from smallest to largest
-
- IF( LSAME(ORDER,'E') .AND. NSPLIT.GT.1 ) THEN
- DO 150 JE = 1, M - 1
- IE = 0
- TMP1 = W( JE )
- DO 140 J = JE + 1, M
- IF( W( J ).LT.TMP1 ) THEN
- IE = J
- TMP1 = W( J )
- END IF
- 140 CONTINUE
- IF( IE.NE.0 ) THEN
- TMP2 = WERR( IE )
- ITMP1 = IBLOCK( IE )
- ITMP2 = INDEXW( IE )
- W( IE ) = W( JE )
- WERR( IE ) = WERR( JE )
- IBLOCK( IE ) = IBLOCK( JE )
- INDEXW( IE ) = INDEXW( JE )
- W( JE ) = TMP1
- WERR( JE ) = TMP2
- IBLOCK( JE ) = ITMP1
- INDEXW( JE ) = ITMP2
- END IF
- 150 CONTINUE
- END IF
-*
- INFO = 0
- IF( NCNVRG )
- $ INFO = INFO + 1
- IF( TOOFEW )
- $ INFO = INFO + 2
- RETURN
-*
-* End of SLARRD
-*
- END
diff --git a/netlib/LAPACK/slarre.f b/netlib/LAPACK/slarre.f
deleted file mode 100644
index a5b9f2f..0000000
--- a/netlib/LAPACK/slarre.f
+++ /dev/null
@@ -1,895 +0,0 @@
-*> \brief \b SLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduced block Ti, finds base representations and eigenvalues.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRE + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarre.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarre.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarre.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2,
-* RTOL1, RTOL2, SPLTOL, NSPLIT, ISPLIT, M,
-* W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER RANGE
-* INTEGER IL, INFO, IU, M, N, NSPLIT
-* REAL PIVMIN, RTOL1, RTOL2, SPLTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * ),
-* $ INDEXW( * )
-* REAL D( * ), E( * ), E2( * ), GERS( * ),
-* $ W( * ),WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> To find the desired eigenvalues of a given real symmetric
-*> tridiagonal matrix T, SLARRE sets any "small" off-diagonal
-*> elements to zero, and for each unreduced block T_i, it finds
-*> (a) a suitable shift at one end of the block's spectrum,
-*> (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
-*> (c) eigenvalues of each L_i D_i L_i^T.
-*> The representations and eigenvalues found are then used by
-*> SSTEMR to compute the eigenvectors of T.
-*> The accuracy varies depending on whether bisection is used to
-*> find a few eigenvalues or the dqds algorithm (subroutine SLASQ2) to
-*> conpute all and then discard any unwanted one.
-*> As an added benefit, SLARRE also outputs the n
-*> Gerschgorin intervals for the matrices L_i D_i L_i^T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': ("All") all eigenvalues will be found.
-*> = 'V': ("Value") all eigenvalues in the half-open interval
-*> (VL, VU] will be found.
-*> = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
-*> entire matrix) will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in,out] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds for the eigenvalues.
-*> Eigenvalues less than or equal to VL, or greater than VU,
-*> will not be returned. VL < VU.
-*> If RANGE='I' or ='A', SLARRE computes bounds on the desired
-*> part of the spectrum.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal
-*> matrix T.
-*> On exit, the N diagonal elements of the diagonal
-*> matrices D_i.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> On entry, the first (N-1) entries contain the subdiagonal
-*> elements of the tridiagonal matrix T; E(N) need not be set.
-*> On exit, E contains the subdiagonal elements of the unit
-*> bidiagonal matrices L_i. The entries E( ISPLIT( I ) ),
-*> 1 <= I <= NSPLIT, contain the base points sigma_i on output.
-*> \endverbatim
-*>
-*> \param[in,out] E2
-*> \verbatim
-*> E2 is REAL array, dimension (N)
-*> On entry, the first (N-1) entries contain the SQUARES of the
-*> subdiagonal elements of the tridiagonal matrix T;
-*> E2(N) need not be set.
-*> On exit, the entries E2( ISPLIT( I ) ),
-*> 1 <= I <= NSPLIT, have been set to zero
-*> \endverbatim
-*>
-*> \param[in] RTOL1
-*> \verbatim
-*> RTOL1 is REAL
-*> \endverbatim
-*>
-*> \param[in] RTOL2
-*> \verbatim
-*> RTOL2 is REAL
-*> Parameters for bisection.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
-*> \endverbatim
-*>
-*> \param[in] SPLTOL
-*> \verbatim
-*> SPLTOL is REAL
-*> The threshold for splitting.
-*> \endverbatim
-*>
-*> \param[out] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of blocks T splits into. 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[out] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into blocks.
-*> The first block consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues (of all L_i D_i L_i^T)
-*> found.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the eigenvalues. The
-*> eigenvalues of each of the blocks, L_i D_i L_i^T, are
-*> sorted in ascending order ( SLARRE may use the
-*> remaining N-M elements as workspace).
-*> \endverbatim
-*>
-*> \param[out] WERR
-*> \verbatim
-*> WERR is REAL array, dimension (N)
-*> The error bound on the corresponding eigenvalue in W.
-*> \endverbatim
-*>
-*> \param[out] WGAP
-*> \verbatim
-*> WGAP is REAL array, dimension (N)
-*> The separation from the right neighbor eigenvalue in W.
-*> The gap is only with respect to the eigenvalues of the same block
-*> as each block has its own representation tree.
-*> Exception: at the right end of a block we store the left gap
-*> \endverbatim
-*>
-*> \param[out] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> The indices of the blocks (submatrices) associated with the
-*> corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
-*> W(i) belongs to the first block from the top, =2 if W(i)
-*> belongs to the second block, etc.
-*> \endverbatim
-*>
-*> \param[out] INDEXW
-*> \verbatim
-*> INDEXW is INTEGER array, dimension (N)
-*> The indices of the eigenvalues within each block (submatrix);
-*> for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
-*> i-th eigenvalue W(i) is the 10-th eigenvalue in block 2
-*> \endverbatim
-*>
-*> \param[out] GERS
-*> \verbatim
-*> GERS is REAL array, dimension (2*N)
-*> The N Gerschgorin intervals (the i-th Gerschgorin interval
-*> is (GERS(2*i-1), GERS(2*i)).
-*> \endverbatim
-*>
-*> \param[out] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (6*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: A problem occured in SLARRE.
-*> < 0: One of the called subroutines signaled an internal problem.
-*> Needs inspection of the corresponding parameter IINFO
-*> for further information.
-*>
-*> =-1: Problem in SLARRD.
-*> = 2: No base representation could be found in MAXTRY iterations.
-*> Increasing MAXTRY and recompilation might be a remedy.
-*> =-3: Problem in SLARRB when computing the refined root
-*> representation for SLASQ2.
-*> =-4: Problem in SLARRB when preforming bisection on the
-*> desired part of the spectrum.
-*> =-5: Problem in SLASQ2.
-*> =-6: Problem in SLASQ2.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The base representations are required to suffer very little
-*> element growth and consequently define all their eigenvalues to
-*> high relative accuracy.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA \n
-*>
-* =====================================================================
- SUBROUTINE SLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2,
- $ RTOL1, RTOL2, SPLTOL, NSPLIT, ISPLIT, M,
- $ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER RANGE
- INTEGER IL, INFO, IU, M, N, NSPLIT
- REAL PIVMIN, RTOL1, RTOL2, SPLTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * ),
- $ INDEXW( * )
- REAL D( * ), E( * ), E2( * ), GERS( * ),
- $ W( * ),WERR( * ), WGAP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL FAC, FOUR, FOURTH, FUDGE, HALF, HNDRD,
- $ MAXGROWTH, ONE, PERT, TWO, ZERO
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0,
- $ TWO = 2.0E0, FOUR=4.0E0,
- $ HNDRD = 100.0E0,
- $ PERT = 4.0E0,
- $ HALF = ONE/TWO, FOURTH = ONE/FOUR, FAC= HALF,
- $ MAXGROWTH = 64.0E0, FUDGE = 2.0E0 )
- INTEGER MAXTRY, ALLRNG, INDRNG, VALRNG
- PARAMETER ( MAXTRY = 6, ALLRNG = 1, INDRNG = 2,
- $ VALRNG = 3 )
-* ..
-* .. Local Scalars ..
- LOGICAL FORCEB, NOREP, USEDQD
- INTEGER CNT, CNT1, CNT2, I, IBEGIN, IDUM, IEND, IINFO,
- $ IN, INDL, INDU, IRANGE, J, JBLK, MB, MM,
- $ WBEGIN, WEND
- REAL AVGAP, BSRTOL, CLWDTH, DMAX, DPIVOT, EABS,
- $ EMAX, EOLD, EPS, GL, GU, ISLEFT, ISRGHT, RTL,
- $ RTOL, S1, S2, SAFMIN, SGNDEF, SIGMA, SPDIAM,
- $ TAU, TMP, TMP1
-
-
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL SLAMCH, LSAME
-
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLARNV, SLARRA, SLARRB, SLARRC, SLARRD,
- $ SLASQ2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-
-* ..
-* .. Executable Statements ..
-*
-
- INFO = 0
-
-*
-* Decode RANGE
-*
- IF( LSAME( RANGE, 'A' ) ) THEN
- IRANGE = ALLRNG
- ELSE IF( LSAME( RANGE, 'V' ) ) THEN
- IRANGE = VALRNG
- ELSE IF( LSAME( RANGE, 'I' ) ) THEN
- IRANGE = INDRNG
- END IF
-
- M = 0
-
-* Get machine constants
- SAFMIN = SLAMCH( 'S' )
- EPS = SLAMCH( 'P' )
-
-* Set parameters
- RTL = HNDRD*EPS
-* If one were ever to ask for less initial precision in BSRTOL,
-* one should keep in mind that for the subset case, the extremal
-* eigenvalues must be at least as accurate as the current setting
-* (eigenvalues in the middle need not as much accuracy)
- BSRTOL = SQRT(EPS)*(0.5E-3)
-
-* Treat case of 1x1 matrix for quick return
- IF( N.EQ.1 ) THEN
- IF( (IRANGE.EQ.ALLRNG).OR.
- $ ((IRANGE.EQ.VALRNG).AND.(D(1).GT.VL).AND.(D(1).LE.VU)).OR.
- $ ((IRANGE.EQ.INDRNG).AND.(IL.EQ.1).AND.(IU.EQ.1)) ) THEN
- M = 1
- W(1) = D(1)
-* The computation error of the eigenvalue is zero
- WERR(1) = ZERO
- WGAP(1) = ZERO
- IBLOCK( 1 ) = 1
- INDEXW( 1 ) = 1
- GERS(1) = D( 1 )
- GERS(2) = D( 1 )
- ENDIF
-* store the shift for the initial RRR, which is zero in this case
- E(1) = ZERO
- RETURN
- END IF
-
-* General case: tridiagonal matrix of order > 1
-*
-* Init WERR, WGAP. Compute Gerschgorin intervals and spectral diameter.
-* Compute maximum off-diagonal entry and pivmin.
- GL = D(1)
- GU = D(1)
- EOLD = ZERO
- EMAX = ZERO
- E(N) = ZERO
- DO 5 I = 1,N
- WERR(I) = ZERO
- WGAP(I) = ZERO
- EABS = ABS( E(I) )
- IF( EABS .GE. EMAX ) THEN
- EMAX = EABS
- END IF
- TMP1 = EABS + EOLD
- GERS( 2*I-1) = D(I) - TMP1
- GL = MIN( GL, GERS( 2*I - 1))
- GERS( 2*I ) = D(I) + TMP1
- GU = MAX( GU, GERS(2*I) )
- EOLD = EABS
- 5 CONTINUE
-* The minimum pivot allowed in the Sturm sequence for T
- PIVMIN = SAFMIN * MAX( ONE, EMAX**2 )
-* Compute spectral diameter. The Gerschgorin bounds give an
-* estimate that is wrong by at most a factor of SQRT(2)
- SPDIAM = GU - GL
-
-* Compute splitting points
- CALL SLARRA( N, D, E, E2, SPLTOL, SPDIAM,
- $ NSPLIT, ISPLIT, IINFO )
-
-* Can force use of bisection instead of faster DQDS.
-* Option left in the code for future multisection work.
- FORCEB = .FALSE.
-
-* Initialize USEDQD, DQDS should be used for ALLRNG unless someone
-* explicitly wants bisection.
- USEDQD = (( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB))
-
- IF( (IRANGE.EQ.ALLRNG) .AND. (.NOT. FORCEB) ) THEN
-* Set interval [VL,VU] that contains all eigenvalues
- VL = GL
- VU = GU
- ELSE
-* We call SLARRD to find crude approximations to the eigenvalues
-* in the desired range. In case IRANGE = INDRNG, we also obtain the
-* interval (VL,VU] that contains all the wanted eigenvalues.
-* An interval [LEFT,RIGHT] has converged if
-* RIGHT-LEFT.LT.RTOL*MAX(ABS(LEFT),ABS(RIGHT))
-* SLARRD needs a WORK of size 4*N, IWORK of size 3*N
- CALL SLARRD( RANGE, 'B', N, VL, VU, IL, IU, GERS,
- $ BSRTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
- $ MM, W, WERR, VL, VU, IBLOCK, INDEXW,
- $ WORK, IWORK, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
-* Make sure that the entries M+1 to N in W, WERR, IBLOCK, INDEXW are 0
- DO 14 I = MM+1,N
- W( I ) = ZERO
- WERR( I ) = ZERO
- IBLOCK( I ) = 0
- INDEXW( I ) = 0
- 14 CONTINUE
- END IF
-
-
-***
-* Loop over unreduced blocks
- IBEGIN = 1
- WBEGIN = 1
- DO 170 JBLK = 1, NSPLIT
- IEND = ISPLIT( JBLK )
- IN = IEND - IBEGIN + 1
-
-* 1 X 1 block
- IF( IN.EQ.1 ) THEN
- IF( (IRANGE.EQ.ALLRNG).OR.( (IRANGE.EQ.VALRNG).AND.
- $ ( D( IBEGIN ).GT.VL ).AND.( D( IBEGIN ).LE.VU ) )
- $ .OR. ( (IRANGE.EQ.INDRNG).AND.(IBLOCK(WBEGIN).EQ.JBLK))
- $ ) THEN
- M = M + 1
- W( M ) = D( IBEGIN )
- WERR(M) = ZERO
-* The gap for a single block doesn't matter for the later
-* algorithm and is assigned an arbitrary large value
- WGAP(M) = ZERO
- IBLOCK( M ) = JBLK
- INDEXW( M ) = 1
- WBEGIN = WBEGIN + 1
- ENDIF
-* E( IEND ) holds the shift for the initial RRR
- E( IEND ) = ZERO
- IBEGIN = IEND + 1
- GO TO 170
- END IF
-*
-* Blocks of size larger than 1x1
-*
-* E( IEND ) will hold the shift for the initial RRR, for now set it =0
- E( IEND ) = ZERO
-*
-* Find local outer bounds GL,GU for the block
- GL = D(IBEGIN)
- GU = D(IBEGIN)
- DO 15 I = IBEGIN , IEND
- GL = MIN( GERS( 2*I-1 ), GL )
- GU = MAX( GERS( 2*I ), GU )
- 15 CONTINUE
- SPDIAM = GU - GL
-
- IF(.NOT. ((IRANGE.EQ.ALLRNG).AND.(.NOT.FORCEB)) ) THEN
-* Count the number of eigenvalues in the current block.
- MB = 0
- DO 20 I = WBEGIN,MM
- IF( IBLOCK(I).EQ.JBLK ) THEN
- MB = MB+1
- ELSE
- GOTO 21
- ENDIF
- 20 CONTINUE
- 21 CONTINUE
-
- IF( MB.EQ.0) THEN
-* No eigenvalue in the current block lies in the desired range
-* E( IEND ) holds the shift for the initial RRR
- E( IEND ) = ZERO
- IBEGIN = IEND + 1
- GO TO 170
- ELSE
-
-* Decide whether dqds or bisection is more efficient
- USEDQD = ( (MB .GT. FAC*IN) .AND. (.NOT.FORCEB) )
- WEND = WBEGIN + MB - 1
-* Calculate gaps for the current block
-* In later stages, when representations for individual
-* eigenvalues are different, we use SIGMA = E( IEND ).
- SIGMA = ZERO
- DO 30 I = WBEGIN, WEND - 1
- WGAP( I ) = MAX( ZERO,
- $ W(I+1)-WERR(I+1) - (W(I)+WERR(I)) )
- 30 CONTINUE
- WGAP( WEND ) = MAX( ZERO,
- $ VU - SIGMA - (W( WEND )+WERR( WEND )))
-* Find local index of the first and last desired evalue.
- INDL = INDEXW(WBEGIN)
- INDU = INDEXW( WEND )
- ENDIF
- ENDIF
- IF(( (IRANGE.EQ.ALLRNG) .AND. (.NOT. FORCEB) ).OR.USEDQD) THEN
-* Case of DQDS
-* Find approximations to the extremal eigenvalues of the block
- CALL SLARRK( IN, 1, GL, GU, D(IBEGIN),
- $ E2(IBEGIN), PIVMIN, RTL, TMP, TMP1, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
- ISLEFT = MAX(GL, TMP - TMP1
- $ - HNDRD * EPS* ABS(TMP - TMP1))
-
- CALL SLARRK( IN, IN, GL, GU, D(IBEGIN),
- $ E2(IBEGIN), PIVMIN, RTL, TMP, TMP1, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
- ISRGHT = MIN(GU, TMP + TMP1
- $ + HNDRD * EPS * ABS(TMP + TMP1))
-* Improve the estimate of the spectral diameter
- SPDIAM = ISRGHT - ISLEFT
- ELSE
-* Case of bisection
-* Find approximations to the wanted extremal eigenvalues
- ISLEFT = MAX(GL, W(WBEGIN) - WERR(WBEGIN)
- $ - HNDRD * EPS*ABS(W(WBEGIN)- WERR(WBEGIN) ))
- ISRGHT = MIN(GU,W(WEND) + WERR(WEND)
- $ + HNDRD * EPS * ABS(W(WEND)+ WERR(WEND)))
- ENDIF
-
-
-* Decide whether the base representation for the current block
-* L_JBLK D_JBLK L_JBLK^T = T_JBLK - sigma_JBLK I
-* should be on the left or the right end of the current block.
-* The strategy is to shift to the end which is "more populated"
-* Furthermore, decide whether to use DQDS for the computation of
-* the eigenvalue approximations at the end of SLARRE or bisection.
-* dqds is chosen if all eigenvalues are desired or the number of
-* eigenvalues to be computed is large compared to the blocksize.
- IF( ( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB) ) THEN
-* If all the eigenvalues have to be computed, we use dqd
- USEDQD = .TRUE.
-* INDL is the local index of the first eigenvalue to compute
- INDL = 1
- INDU = IN
-* MB = number of eigenvalues to compute
- MB = IN
- WEND = WBEGIN + MB - 1
-* Define 1/4 and 3/4 points of the spectrum
- S1 = ISLEFT + FOURTH * SPDIAM
- S2 = ISRGHT - FOURTH * SPDIAM
- ELSE
-* SLARRD has computed IBLOCK and INDEXW for each eigenvalue
-* approximation.
-* choose sigma
- IF( USEDQD ) THEN
- S1 = ISLEFT + FOURTH * SPDIAM
- S2 = ISRGHT - FOURTH * SPDIAM
- ELSE
- TMP = MIN(ISRGHT,VU) - MAX(ISLEFT,VL)
- S1 = MAX(ISLEFT,VL) + FOURTH * TMP
- S2 = MIN(ISRGHT,VU) - FOURTH * TMP
- ENDIF
- ENDIF
-
-* Compute the negcount at the 1/4 and 3/4 points
- IF(MB.GT.1) THEN
- CALL SLARRC( 'T', IN, S1, S2, D(IBEGIN),
- $ E(IBEGIN), PIVMIN, CNT, CNT1, CNT2, IINFO)
- ENDIF
-
- IF(MB.EQ.1) THEN
- SIGMA = GL
- SGNDEF = ONE
- ELSEIF( CNT1 - INDL .GE. INDU - CNT2 ) THEN
- IF( ( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB) ) THEN
- SIGMA = MAX(ISLEFT,GL)
- ELSEIF( USEDQD ) THEN
-* use Gerschgorin bound as shift to get pos def matrix
-* for dqds
- SIGMA = ISLEFT
- ELSE
-* use approximation of the first desired eigenvalue of the
-* block as shift
- SIGMA = MAX(ISLEFT,VL)
- ENDIF
- SGNDEF = ONE
- ELSE
- IF( ( IRANGE.EQ.ALLRNG ) .AND. (.NOT.FORCEB) ) THEN
- SIGMA = MIN(ISRGHT,GU)
- ELSEIF( USEDQD ) THEN
-* use Gerschgorin bound as shift to get neg def matrix
-* for dqds
- SIGMA = ISRGHT
- ELSE
-* use approximation of the first desired eigenvalue of the
-* block as shift
- SIGMA = MIN(ISRGHT,VU)
- ENDIF
- SGNDEF = -ONE
- ENDIF
-
-
-* An initial SIGMA has been chosen that will be used for computing
-* T - SIGMA I = L D L^T
-* Define the increment TAU of the shift in case the initial shift
-* needs to be refined to obtain a factorization with not too much
-* element growth.
- IF( USEDQD ) THEN
-* The initial SIGMA was to the outer end of the spectrum
-* the matrix is definite and we need not retreat.
- TAU = SPDIAM*EPS*N + TWO*PIVMIN
- TAU = MAX( TAU,TWO*EPS*ABS(SIGMA) )
- ELSE
- IF(MB.GT.1) THEN
- CLWDTH = W(WEND) + WERR(WEND) - W(WBEGIN) - WERR(WBEGIN)
- AVGAP = ABS(CLWDTH / REAL(WEND-WBEGIN))
- IF( SGNDEF.EQ.ONE ) THEN
- TAU = HALF*MAX(WGAP(WBEGIN),AVGAP)
- TAU = MAX(TAU,WERR(WBEGIN))
- ELSE
- TAU = HALF*MAX(WGAP(WEND-1),AVGAP)
- TAU = MAX(TAU,WERR(WEND))
- ENDIF
- ELSE
- TAU = WERR(WBEGIN)
- ENDIF
- ENDIF
-*
- DO 80 IDUM = 1, MAXTRY
-* Compute L D L^T factorization of tridiagonal matrix T - sigma I.
-* Store D in WORK(1:IN), L in WORK(IN+1:2*IN), and reciprocals of
-* pivots in WORK(2*IN+1:3*IN)
- DPIVOT = D( IBEGIN ) - SIGMA
- WORK( 1 ) = DPIVOT
- DMAX = ABS( WORK(1) )
- J = IBEGIN
- DO 70 I = 1, IN - 1
- WORK( 2*IN+I ) = ONE / WORK( I )
- TMP = E( J )*WORK( 2*IN+I )
- WORK( IN+I ) = TMP
- DPIVOT = ( D( J+1 )-SIGMA ) - TMP*E( J )
- WORK( I+1 ) = DPIVOT
- DMAX = MAX( DMAX, ABS(DPIVOT) )
- J = J + 1
- 70 CONTINUE
-* check for element growth
- IF( DMAX .GT. MAXGROWTH*SPDIAM ) THEN
- NOREP = .TRUE.
- ELSE
- NOREP = .FALSE.
- ENDIF
- IF( USEDQD .AND. .NOT.NOREP ) THEN
-* Ensure the definiteness of the representation
-* All entries of D (of L D L^T) must have the same sign
- DO 71 I = 1, IN
- TMP = SGNDEF*WORK( I )
- IF( TMP.LT.ZERO ) NOREP = .TRUE.
- 71 CONTINUE
- ENDIF
- IF(NOREP) THEN
-* Note that in the case of IRANGE=ALLRNG, we use the Gerschgorin
-* shift which makes the matrix definite. So we should end up
-* here really only in the case of IRANGE = VALRNG or INDRNG.
- IF( IDUM.EQ.MAXTRY-1 ) THEN
- IF( SGNDEF.EQ.ONE ) THEN
-* The fudged Gerschgorin shift should succeed
- SIGMA =
- $ GL - FUDGE*SPDIAM*EPS*N - FUDGE*TWO*PIVMIN
- ELSE
- SIGMA =
- $ GU + FUDGE*SPDIAM*EPS*N + FUDGE*TWO*PIVMIN
- END IF
- ELSE
- SIGMA = SIGMA - SGNDEF * TAU
- TAU = TWO * TAU
- END IF
- ELSE
-* an initial RRR is found
- GO TO 83
- END IF
- 80 CONTINUE
-* if the program reaches this point, no base representation could be
-* found in MAXTRY iterations.
- INFO = 2
- RETURN
-
- 83 CONTINUE
-* At this point, we have found an initial base representation
-* T - SIGMA I = L D L^T with not too much element growth.
-* Store the shift.
- E( IEND ) = SIGMA
-* Store D and L.
- CALL SCOPY( IN, WORK, 1, D( IBEGIN ), 1 )
- CALL SCOPY( IN-1, WORK( IN+1 ), 1, E( IBEGIN ), 1 )
-
-
- IF(MB.GT.1 ) THEN
-*
-* Perturb each entry of the base representation by a small
-* (but random) relative amount to overcome difficulties with
-* glued matrices.
-*
- DO 122 I = 1, 4
- ISEED( I ) = 1
- 122 CONTINUE
-
- CALL SLARNV(2, ISEED, 2*IN-1, WORK(1))
- DO 125 I = 1,IN-1
- D(IBEGIN+I-1) = D(IBEGIN+I-1)*(ONE+EPS*PERT*WORK(I))
- E(IBEGIN+I-1) = E(IBEGIN+I-1)*(ONE+EPS*PERT*WORK(IN+I))
- 125 CONTINUE
- D(IEND) = D(IEND)*(ONE+EPS*FOUR*WORK(IN))
-*
- ENDIF
-*
-* Don't update the Gerschgorin intervals because keeping track
-* of the updates would be too much work in SLARRV.
-* We update W instead and use it to locate the proper Gerschgorin
-* intervals.
-
-* Compute the required eigenvalues of L D L' by bisection or dqds
- IF ( .NOT.USEDQD ) THEN
-* If SLARRD has been used, shift the eigenvalue approximations
-* according to their representation. This is necessary for
-* a uniform SLARRV since dqds computes eigenvalues of the
-* shifted representation. In SLARRV, W will always hold the
-* UNshifted eigenvalue approximation.
- DO 134 J=WBEGIN,WEND
- W(J) = W(J) - SIGMA
- WERR(J) = WERR(J) + ABS(W(J)) * EPS
- 134 CONTINUE
-* call SLARRB to reduce eigenvalue error of the approximations
-* from SLARRD
- DO 135 I = IBEGIN, IEND-1
- WORK( I ) = D( I ) * E( I )**2
- 135 CONTINUE
-* use bisection to find EV from INDL to INDU
- CALL SLARRB(IN, D(IBEGIN), WORK(IBEGIN),
- $ INDL, INDU, RTOL1, RTOL2, INDL-1,
- $ W(WBEGIN), WGAP(WBEGIN), WERR(WBEGIN),
- $ WORK( 2*N+1 ), IWORK, PIVMIN, SPDIAM,
- $ IN, IINFO )
- IF( IINFO .NE. 0 ) THEN
- INFO = -4
- RETURN
- END IF
-* SLARRB computes all gaps correctly except for the last one
-* Record distance to VU/GU
- WGAP( WEND ) = MAX( ZERO,
- $ ( VU-SIGMA ) - ( W( WEND ) + WERR( WEND ) ) )
- DO 138 I = INDL, INDU
- M = M + 1
- IBLOCK(M) = JBLK
- INDEXW(M) = I
- 138 CONTINUE
- ELSE
-* Call dqds to get all eigs (and then possibly delete unwanted
-* eigenvalues).
-* Note that dqds finds the eigenvalues of the L D L^T representation
-* of T to high relative accuracy. High relative accuracy
-* might be lost when the shift of the RRR is subtracted to obtain
-* the eigenvalues of T. However, T is not guaranteed to define its
-* eigenvalues to high relative accuracy anyway.
-* Set RTOL to the order of the tolerance used in SLASQ2
-* This is an ESTIMATED error, the worst case bound is 4*N*EPS
-* which is usually too large and requires unnecessary work to be
-* done by bisection when computing the eigenvectors
- RTOL = LOG(REAL(IN)) * FOUR * EPS
- J = IBEGIN
- DO 140 I = 1, IN - 1
- WORK( 2*I-1 ) = ABS( D( J ) )
- WORK( 2*I ) = E( J )*E( J )*WORK( 2*I-1 )
- J = J + 1
- 140 CONTINUE
- WORK( 2*IN-1 ) = ABS( D( IEND ) )
- WORK( 2*IN ) = ZERO
- CALL SLASQ2( IN, WORK, IINFO )
- IF( IINFO .NE. 0 ) THEN
-* If IINFO = -5 then an index is part of a tight cluster
-* and should be changed. The index is in IWORK(1) and the
-* gap is in WORK(N+1)
- INFO = -5
- RETURN
- ELSE
-* Test that all eigenvalues are positive as expected
- DO 149 I = 1, IN
- IF( WORK( I ).LT.ZERO ) THEN
- INFO = -6
- RETURN
- ENDIF
- 149 CONTINUE
- END IF
- IF( SGNDEF.GT.ZERO ) THEN
- DO 150 I = INDL, INDU
- M = M + 1
- W( M ) = WORK( IN-I+1 )
- IBLOCK( M ) = JBLK
- INDEXW( M ) = I
- 150 CONTINUE
- ELSE
- DO 160 I = INDL, INDU
- M = M + 1
- W( M ) = -WORK( I )
- IBLOCK( M ) = JBLK
- INDEXW( M ) = I
- 160 CONTINUE
- END IF
-
- DO 165 I = M - MB + 1, M
-* the value of RTOL below should be the tolerance in SLASQ2
- WERR( I ) = RTOL * ABS( W(I) )
- 165 CONTINUE
- DO 166 I = M - MB + 1, M - 1
-* compute the right gap between the intervals
- WGAP( I ) = MAX( ZERO,
- $ W(I+1)-WERR(I+1) - (W(I)+WERR(I)) )
- 166 CONTINUE
- WGAP( M ) = MAX( ZERO,
- $ ( VU-SIGMA ) - ( W( M ) + WERR( M ) ) )
- END IF
-* proceed with next block
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- 170 CONTINUE
-*
-
- RETURN
-*
-* end of SLARRE
-*
- END
diff --git a/netlib/LAPACK/slarrf.f b/netlib/LAPACK/slarrf.f
deleted file mode 100644
index 076fa48..0000000
--- a/netlib/LAPACK/slarrf.f
+++ /dev/null
@@ -1,487 +0,0 @@
-*> \brief \b SLARRF finds a new relatively robust representation such that at least one of the eigenvalues is relatively isolated.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRF( N, D, L, LD, CLSTRT, CLEND,
-* W, WGAP, WERR,
-* SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA,
-* DPLUS, LPLUS, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER CLSTRT, CLEND, INFO, N
-* REAL CLGAPL, CLGAPR, PIVMIN, SIGMA, SPDIAM
-* ..
-* .. Array Arguments ..
-* REAL D( * ), DPLUS( * ), L( * ), LD( * ),
-* $ LPLUS( * ), W( * ), WGAP( * ), WERR( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given the initial representation L D L^T and its cluster of close
-*> eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
-*> W( CLEND ), SLARRF finds a new relatively robust representation
-*> L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
-*> eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix (subblock, if the matrix splitted).
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is REAL array, dimension (N-1)
-*> The (N-1) subdiagonal elements of the unit bidiagonal
-*> matrix L.
-*> \endverbatim
-*>
-*> \param[in] LD
-*> \verbatim
-*> LD is REAL array, dimension (N-1)
-*> The (N-1) elements L(i)*D(i).
-*> \endverbatim
-*>
-*> \param[in] CLSTRT
-*> \verbatim
-*> CLSTRT is INTEGER
-*> The index of the first eigenvalue in the cluster.
-*> \endverbatim
-*>
-*> \param[in] CLEND
-*> \verbatim
-*> CLEND is INTEGER
-*> The index of the last eigenvalue in the cluster.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is REAL array, dimension
-*> dimension is >= (CLEND-CLSTRT+1)
-*> The eigenvalue APPROXIMATIONS of L D L^T in ascending order.
-*> W( CLSTRT ) through W( CLEND ) form the cluster of relatively
-*> close eigenalues.
-*> \endverbatim
-*>
-*> \param[in,out] WGAP
-*> \verbatim
-*> WGAP is REAL array, dimension
-*> dimension is >= (CLEND-CLSTRT+1)
-*> The separation from the right neighbor eigenvalue in W.
-*> \endverbatim
-*>
-*> \param[in] WERR
-*> \verbatim
-*> WERR is REAL array, dimension
-*> dimension is >= (CLEND-CLSTRT+1)
-*> WERR contain the semiwidth of the uncertainty
-*> interval of the corresponding eigenvalue APPROXIMATION in W
-*> \endverbatim
-*>
-*> \param[in] SPDIAM
-*> \verbatim
-*> SPDIAM is REAL
-*> estimate of the spectral diameter obtained from the
-*> Gerschgorin intervals
-*> \endverbatim
-*>
-*> \param[in] CLGAPL
-*> \verbatim
-*> CLGAPL is REAL
-*> \endverbatim
-*>
-*> \param[in] CLGAPR
-*> \verbatim
-*> CLGAPR is REAL
-*> absolute gap on each end of the cluster.
-*> Set by the calling routine to protect against shifts too close
-*> to eigenvalues outside the cluster.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot allowed in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is REAL
-*> The shift used to form L(+) D(+) L(+)^T.
-*> \endverbatim
-*>
-*> \param[out] DPLUS
-*> \verbatim
-*> DPLUS is REAL array, dimension (N)
-*> The N diagonal elements of the diagonal matrix D(+).
-*> \endverbatim
-*>
-*> \param[out] LPLUS
-*> \verbatim
-*> LPLUS is REAL array, dimension (N-1)
-*> The first (N-1) elements of LPLUS contain the subdiagonal
-*> elements of the unit bidiagonal matrix L(+).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Signals processing OK (=0) or failure (=1)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRF( N, D, L, LD, CLSTRT, CLEND,
- $ W, WGAP, WERR,
- $ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA,
- $ DPLUS, LPLUS, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER CLSTRT, CLEND, INFO, N
- REAL CLGAPL, CLGAPR, PIVMIN, SIGMA, SPDIAM
-* ..
-* .. Array Arguments ..
- REAL D( * ), DPLUS( * ), L( * ), LD( * ),
- $ LPLUS( * ), W( * ), WGAP( * ), WERR( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL MAXGROWTH1, MAXGROWTH2, ONE, QUART, TWO
- PARAMETER ( ONE = 1.0E0, TWO = 2.0E0,
- $ QUART = 0.25E0,
- $ MAXGROWTH1 = 8.E0,
- $ MAXGROWTH2 = 8.E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DORRR1, FORCER, NOFAIL, SAWNAN1, SAWNAN2, TRYRRR1
- INTEGER I, INDX, KTRY, KTRYMAX, SLEFT, SRIGHT, SHIFT
- PARAMETER ( KTRYMAX = 1, SLEFT = 1, SRIGHT = 2 )
- REAL AVGAP, BESTSHIFT, CLWDTH, EPS, FACT, FAIL,
- $ FAIL2, GROWTHBOUND, LDELTA, LDMAX, LSIGMA,
- $ MAX1, MAX2, MINGAP, OLDP, PROD, RDELTA, RDMAX,
- $ RRR1, RRR2, RSIGMA, S, SMLGROWTH, TMP, ZNM2
-* ..
-* .. External Functions ..
- LOGICAL SISNAN
- REAL SLAMCH
- EXTERNAL SISNAN, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- FACT = REAL(2**KTRYMAX)
- EPS = SLAMCH( 'Precision' )
- SHIFT = 0
- FORCER = .FALSE.
-
-
-* Note that we cannot guarantee that for any of the shifts tried,
-* the factorization has a small or even moderate element growth.
-* There could be Ritz values at both ends of the cluster and despite
-* backing off, there are examples where all factorizations tried
-* (in IEEE mode, allowing zero pivots & infinities) have INFINITE
-* element growth.
-* For this reason, we should use PIVMIN in this subroutine so that at
-* least the L D L^T factorization exists. It can be checked afterwards
-* whether the element growth caused bad residuals/orthogonality.
-
-* Decide whether the code should accept the best among all
-* representations despite large element growth or signal INFO=1
- NOFAIL = .TRUE.
-*
-
-* Compute the average gap length of the cluster
- CLWDTH = ABS(W(CLEND)-W(CLSTRT)) + WERR(CLEND) + WERR(CLSTRT)
- AVGAP = CLWDTH / REAL(CLEND-CLSTRT)
- MINGAP = MIN(CLGAPL, CLGAPR)
-* Initial values for shifts to both ends of cluster
- LSIGMA = MIN(W( CLSTRT ),W( CLEND )) - WERR( CLSTRT )
- RSIGMA = MAX(W( CLSTRT ),W( CLEND )) + WERR( CLEND )
-
-* Use a small fudge to make sure that we really shift to the outside
- LSIGMA = LSIGMA - ABS(LSIGMA)* TWO * EPS
- RSIGMA = RSIGMA + ABS(RSIGMA)* TWO * EPS
-
-* Compute upper bounds for how much to back off the initial shifts
- LDMAX = QUART * MINGAP + TWO * PIVMIN
- RDMAX = QUART * MINGAP + TWO * PIVMIN
-
- LDELTA = MAX(AVGAP,WGAP( CLSTRT ))/FACT
- RDELTA = MAX(AVGAP,WGAP( CLEND-1 ))/FACT
-*
-* Initialize the record of the best representation found
-*
- S = SLAMCH( 'S' )
- SMLGROWTH = ONE / S
- FAIL = REAL(N-1)*MINGAP/(SPDIAM*EPS)
- FAIL2 = REAL(N-1)*MINGAP/(SPDIAM*SQRT(EPS))
- BESTSHIFT = LSIGMA
-*
-* while (KTRY <= KTRYMAX)
- KTRY = 0
- GROWTHBOUND = MAXGROWTH1*SPDIAM
-
- 5 CONTINUE
- SAWNAN1 = .FALSE.
- SAWNAN2 = .FALSE.
-* Ensure that we do not back off too much of the initial shifts
- LDELTA = MIN(LDMAX,LDELTA)
- RDELTA = MIN(RDMAX,RDELTA)
-
-* Compute the element growth when shifting to both ends of the cluster
-* accept the shift if there is no element growth at one of the two ends
-
-* Left end
- S = -LSIGMA
- DPLUS( 1 ) = D( 1 ) + S
- IF(ABS(DPLUS(1)).LT.PIVMIN) THEN
- DPLUS(1) = -PIVMIN
-* Need to set SAWNAN1 because refined RRR test should not be used
-* in this case
- SAWNAN1 = .TRUE.
- ENDIF
- MAX1 = ABS( DPLUS( 1 ) )
- DO 6 I = 1, N - 1
- LPLUS( I ) = LD( I ) / DPLUS( I )
- S = S*LPLUS( I )*L( I ) - LSIGMA
- DPLUS( I+1 ) = D( I+1 ) + S
- IF(ABS(DPLUS(I+1)).LT.PIVMIN) THEN
- DPLUS(I+1) = -PIVMIN
-* Need to set SAWNAN1 because refined RRR test should not be used
-* in this case
- SAWNAN1 = .TRUE.
- ENDIF
- MAX1 = MAX( MAX1,ABS(DPLUS(I+1)) )
- 6 CONTINUE
- SAWNAN1 = SAWNAN1 .OR. SISNAN( MAX1 )
-
- IF( FORCER .OR.
- $ (MAX1.LE.GROWTHBOUND .AND. .NOT.SAWNAN1 ) ) THEN
- SIGMA = LSIGMA
- SHIFT = SLEFT
- GOTO 100
- ENDIF
-
-* Right end
- S = -RSIGMA
- WORK( 1 ) = D( 1 ) + S
- IF(ABS(WORK(1)).LT.PIVMIN) THEN
- WORK(1) = -PIVMIN
-* Need to set SAWNAN2 because refined RRR test should not be used
-* in this case
- SAWNAN2 = .TRUE.
- ENDIF
- MAX2 = ABS( WORK( 1 ) )
- DO 7 I = 1, N - 1
- WORK( N+I ) = LD( I ) / WORK( I )
- S = S*WORK( N+I )*L( I ) - RSIGMA
- WORK( I+1 ) = D( I+1 ) + S
- IF(ABS(WORK(I+1)).LT.PIVMIN) THEN
- WORK(I+1) = -PIVMIN
-* Need to set SAWNAN2 because refined RRR test should not be used
-* in this case
- SAWNAN2 = .TRUE.
- ENDIF
- MAX2 = MAX( MAX2,ABS(WORK(I+1)) )
- 7 CONTINUE
- SAWNAN2 = SAWNAN2 .OR. SISNAN( MAX2 )
-
- IF( FORCER .OR.
- $ (MAX2.LE.GROWTHBOUND .AND. .NOT.SAWNAN2 ) ) THEN
- SIGMA = RSIGMA
- SHIFT = SRIGHT
- GOTO 100
- ENDIF
-* If we are at this point, both shifts led to too much element growth
-
-* Record the better of the two shifts (provided it didn't lead to NaN)
- IF(SAWNAN1.AND.SAWNAN2) THEN
-* both MAX1 and MAX2 are NaN
- GOTO 50
- ELSE
- IF( .NOT.SAWNAN1 ) THEN
- INDX = 1
- IF(MAX1.LE.SMLGROWTH) THEN
- SMLGROWTH = MAX1
- BESTSHIFT = LSIGMA
- ENDIF
- ENDIF
- IF( .NOT.SAWNAN2 ) THEN
- IF(SAWNAN1 .OR. MAX2.LE.MAX1) INDX = 2
- IF(MAX2.LE.SMLGROWTH) THEN
- SMLGROWTH = MAX2
- BESTSHIFT = RSIGMA
- ENDIF
- ENDIF
- ENDIF
-
-* If we are here, both the left and the right shift led to
-* element growth. If the element growth is moderate, then
-* we may still accept the representation, if it passes a
-* refined test for RRR. This test supposes that no NaN occurred.
-* Moreover, we use the refined RRR test only for isolated clusters.
- IF((CLWDTH.LT.MINGAP/REAL(128)) .AND.
- $ (MIN(MAX1,MAX2).LT.FAIL2)
- $ .AND.(.NOT.SAWNAN1).AND.(.NOT.SAWNAN2)) THEN
- DORRR1 = .TRUE.
- ELSE
- DORRR1 = .FALSE.
- ENDIF
- TRYRRR1 = .TRUE.
- IF( TRYRRR1 .AND. DORRR1 ) THEN
- IF(INDX.EQ.1) THEN
- TMP = ABS( DPLUS( N ) )
- ZNM2 = ONE
- PROD = ONE
- OLDP = ONE
- DO 15 I = N-1, 1, -1
- IF( PROD .LE. EPS ) THEN
- PROD =
- $ ((DPLUS(I+1)*WORK(N+I+1))/(DPLUS(I)*WORK(N+I)))*OLDP
- ELSE
- PROD = PROD*ABS(WORK(N+I))
- END IF
- OLDP = PROD
- ZNM2 = ZNM2 + PROD**2
- TMP = MAX( TMP, ABS( DPLUS( I ) * PROD ))
- 15 CONTINUE
- RRR1 = TMP/( SPDIAM * SQRT( ZNM2 ) )
- IF (RRR1.LE.MAXGROWTH2) THEN
- SIGMA = LSIGMA
- SHIFT = SLEFT
- GOTO 100
- ENDIF
- ELSE IF(INDX.EQ.2) THEN
- TMP = ABS( WORK( N ) )
- ZNM2 = ONE
- PROD = ONE
- OLDP = ONE
- DO 16 I = N-1, 1, -1
- IF( PROD .LE. EPS ) THEN
- PROD = ((WORK(I+1)*LPLUS(I+1))/(WORK(I)*LPLUS(I)))*OLDP
- ELSE
- PROD = PROD*ABS(LPLUS(I))
- END IF
- OLDP = PROD
- ZNM2 = ZNM2 + PROD**2
- TMP = MAX( TMP, ABS( WORK( I ) * PROD ))
- 16 CONTINUE
- RRR2 = TMP/( SPDIAM * SQRT( ZNM2 ) )
- IF (RRR2.LE.MAXGROWTH2) THEN
- SIGMA = RSIGMA
- SHIFT = SRIGHT
- GOTO 100
- ENDIF
- END IF
- ENDIF
-
- 50 CONTINUE
-
- IF (KTRY.LT.KTRYMAX) THEN
-* If we are here, both shifts failed also the RRR test.
-* Back off to the outside
- LSIGMA = MAX( LSIGMA - LDELTA,
- $ LSIGMA - LDMAX)
- RSIGMA = MIN( RSIGMA + RDELTA,
- $ RSIGMA + RDMAX )
- LDELTA = TWO * LDELTA
- RDELTA = TWO * RDELTA
- KTRY = KTRY + 1
- GOTO 5
- ELSE
-* None of the representations investigated satisfied our
-* criteria. Take the best one we found.
- IF((SMLGROWTH.LT.FAIL).OR.NOFAIL) THEN
- LSIGMA = BESTSHIFT
- RSIGMA = BESTSHIFT
- FORCER = .TRUE.
- GOTO 5
- ELSE
- INFO = 1
- RETURN
- ENDIF
- END IF
-
- 100 CONTINUE
- IF (SHIFT.EQ.SLEFT) THEN
- ELSEIF (SHIFT.EQ.SRIGHT) THEN
-* store new L and D back into DPLUS, LPLUS
- CALL SCOPY( N, WORK, 1, DPLUS, 1 )
- CALL SCOPY( N-1, WORK(N+1), 1, LPLUS, 1 )
- ENDIF
-
- RETURN
-*
-* End of SLARRF
-*
- END
diff --git a/netlib/LAPACK/slarrj.f b/netlib/LAPACK/slarrj.f
deleted file mode 100644
index 5b7abcf..0000000
--- a/netlib/LAPACK/slarrj.f
+++ /dev/null
@@ -1,373 +0,0 @@
-*> \brief \b SLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRJ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrj.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrj.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrj.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRJ( N, D, E2, IFIRST, ILAST,
-* RTOL, OFFSET, W, WERR, WORK, IWORK,
-* PIVMIN, SPDIAM, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IFIRST, ILAST, INFO, N, OFFSET
-* REAL PIVMIN, RTOL, SPDIAM
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL D( * ), E2( * ), W( * ),
-* $ WERR( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Given the initial eigenvalue approximations of T, SLARRJ
-*> does bisection to refine the eigenvalues of T,
-*> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
-*> guesses for these eigenvalues are input in W, the corresponding estimate
-*> of the error in these guesses in WERR. During bisection, intervals
-*> [left, right] are maintained by storing their mid-points and
-*> semi-widths in the arrays W and WERR respectively.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The N diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is REAL array, dimension (N-1)
-*> The Squares of the (N-1) subdiagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] IFIRST
-*> \verbatim
-*> IFIRST is INTEGER
-*> The index of the first eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] ILAST
-*> \verbatim
-*> ILAST is INTEGER
-*> The index of the last eigenvalue to be computed.
-*> \endverbatim
-*>
-*> \param[in] RTOL
-*> \verbatim
-*> RTOL is REAL
-*> Tolerance for the convergence of the bisection intervals.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).
-*> \endverbatim
-*>
-*> \param[in] OFFSET
-*> \verbatim
-*> OFFSET is INTEGER
-*> Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
-*> through ILAST-OFFSET elements of these arrays are to be used.
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
-*> estimates of the eigenvalues of L D L^T indexed IFIRST through
-*> ILAST.
-*> On output, these estimates are refined.
-*> \endverbatim
-*>
-*> \param[in,out] WERR
-*> \verbatim
-*> WERR is REAL array, dimension (N)
-*> On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are
-*> the errors in the estimates of the corresponding elements in W.
-*> On output, these errors are refined.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*N)
-*> Workspace.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[in] SPDIAM
-*> \verbatim
-*> SPDIAM is REAL
-*> The spectral diameter of T.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error flag.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRJ( N, D, E2, IFIRST, ILAST,
- $ RTOL, OFFSET, W, WERR, WORK, IWORK,
- $ PIVMIN, SPDIAM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IFIRST, ILAST, INFO, N, OFFSET
- REAL PIVMIN, RTOL, SPDIAM
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL D( * ), E2( * ), W( * ),
- $ WERR( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, HALF
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ HALF = 0.5E0 )
- INTEGER MAXITR
-* ..
-* .. Local Scalars ..
- INTEGER CNT, I, I1, I2, II, ITER, J, K, NEXT, NINT,
- $ OLNINT, P, PREV, SAVI1
- REAL DPLUS, FAC, LEFT, MID, RIGHT, S, TMP, WIDTH
-*
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
- MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
-*
-* Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ].
-* The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while
-* Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 )
-* for an unconverged interval is set to the index of the next unconverged
-* interval, and is -1 or 0 for a converged interval. Thus a linked
-* list of unconverged intervals is set up.
-*
-
- I1 = IFIRST
- I2 = ILAST
-* The number of unconverged intervals
- NINT = 0
-* The last unconverged interval found
- PREV = 0
- DO 75 I = I1, I2
- K = 2*I
- II = I - OFFSET
- LEFT = W( II ) - WERR( II )
- MID = W(II)
- RIGHT = W( II ) + WERR( II )
- WIDTH = RIGHT - MID
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
-
-* The following test prevents the test of converged intervals
- IF( WIDTH.LT.RTOL*TMP ) THEN
-* This interval has already converged and does not need refinement.
-* (Note that the gaps might change through refining the
-* eigenvalues, however, they can only get bigger.)
-* Remove it from the list.
- IWORK( K-1 ) = -1
-* Make sure that I1 always points to the first unconverged interval
- IF((I.EQ.I1).AND.(I.LT.I2)) I1 = I + 1
- IF((PREV.GE.I1).AND.(I.LE.I2)) IWORK( 2*PREV-1 ) = I + 1
- ELSE
-* unconverged interval found
- PREV = I
-* Make sure that [LEFT,RIGHT] contains the desired eigenvalue
-*
-* Do while( CNT(LEFT).GT.I-1 )
-*
- FAC = ONE
- 20 CONTINUE
- CNT = 0
- S = LEFT
- DPLUS = D( 1 ) - S
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- DO 30 J = 2, N
- DPLUS = D( J ) - S - E2( J-1 )/DPLUS
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- 30 CONTINUE
- IF( CNT.GT.I-1 ) THEN
- LEFT = LEFT - WERR( II )*FAC
- FAC = TWO*FAC
- GO TO 20
- END IF
-*
-* Do while( CNT(RIGHT).LT.I )
-*
- FAC = ONE
- 50 CONTINUE
- CNT = 0
- S = RIGHT
- DPLUS = D( 1 ) - S
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- DO 60 J = 2, N
- DPLUS = D( J ) - S - E2( J-1 )/DPLUS
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- 60 CONTINUE
- IF( CNT.LT.I ) THEN
- RIGHT = RIGHT + WERR( II )*FAC
- FAC = TWO*FAC
- GO TO 50
- END IF
- NINT = NINT + 1
- IWORK( K-1 ) = I + 1
- IWORK( K ) = CNT
- END IF
- WORK( K-1 ) = LEFT
- WORK( K ) = RIGHT
- 75 CONTINUE
-
-
- SAVI1 = I1
-*
-* Do while( NINT.GT.0 ), i.e. there are still unconverged intervals
-* and while (ITER.LT.MAXITR)
-*
- ITER = 0
- 80 CONTINUE
- PREV = I1 - 1
- I = I1
- OLNINT = NINT
-
- DO 100 P = 1, OLNINT
- K = 2*I
- II = I - OFFSET
- NEXT = IWORK( K-1 )
- LEFT = WORK( K-1 )
- RIGHT = WORK( K )
- MID = HALF*( LEFT + RIGHT )
-
-* semiwidth of interval
- WIDTH = RIGHT - MID
- TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
-
- IF( ( WIDTH.LT.RTOL*TMP ) .OR.
- $ (ITER.EQ.MAXITR) )THEN
-* reduce number of unconverged intervals
- NINT = NINT - 1
-* Mark interval as converged.
- IWORK( K-1 ) = 0
- IF( I1.EQ.I ) THEN
- I1 = NEXT
- ELSE
-* Prev holds the last unconverged interval previously examined
- IF(PREV.GE.I1) IWORK( 2*PREV-1 ) = NEXT
- END IF
- I = NEXT
- GO TO 100
- END IF
- PREV = I
-*
-* Perform one bisection step
-*
- CNT = 0
- S = MID
- DPLUS = D( 1 ) - S
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- DO 90 J = 2, N
- DPLUS = D( J ) - S - E2( J-1 )/DPLUS
- IF( DPLUS.LT.ZERO ) CNT = CNT + 1
- 90 CONTINUE
- IF( CNT.LE.I-1 ) THEN
- WORK( K-1 ) = MID
- ELSE
- WORK( K ) = MID
- END IF
- I = NEXT
-
- 100 CONTINUE
- ITER = ITER + 1
-* do another loop if there are still unconverged intervals
-* However, in the last iteration, all intervals are accepted
-* since this is the best we can do.
- IF( ( NINT.GT.0 ).AND.(ITER.LE.MAXITR) ) GO TO 80
-*
-*
-* At this point, all the intervals have converged
- DO 110 I = SAVI1, ILAST
- K = 2*I
- II = I - OFFSET
-* All intervals marked by '0' have been refined.
- IF( IWORK( K-1 ).EQ.0 ) THEN
- W( II ) = HALF*( WORK( K-1 )+WORK( K ) )
- WERR( II ) = WORK( K ) - W( II )
- END IF
- 110 CONTINUE
-*
-
- RETURN
-*
-* End of SLARRJ
-*
- END
diff --git a/netlib/LAPACK/slarrk.f b/netlib/LAPACK/slarrk.f
deleted file mode 100644
index 66dd091..0000000
--- a/netlib/LAPACK/slarrk.f
+++ /dev/null
@@ -1,249 +0,0 @@
-*> \brief \b SLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrk.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrk.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrk.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRK( N, IW, GL, GU,
-* D, E2, PIVMIN, RELTOL, W, WERR, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, IW, N
-* REAL PIVMIN, RELTOL, GL, GU, W, WERR
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARRK computes one eigenvalue of a symmetric tridiagonal
-*> matrix T to suitable accuracy. This is an auxiliary code to be
-*> called from SSTEMR.
-*>
-*> To avoid overflow, the matrix must be scaled so that its
-*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
-*> accuracy, it should not be much smaller than that.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] IW
-*> \verbatim
-*> IW is INTEGER
-*> The index of the eigenvalues to be returned.
-*> \endverbatim
-*>
-*> \param[in] GL
-*> \verbatim
-*> GL is REAL
-*> \endverbatim
-*>
-*> \param[in] GU
-*> \verbatim
-*> GU is REAL
-*> An upper and a lower bound on the eigenvalue.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E2
-*> \verbatim
-*> E2 is REAL array, dimension (N-1)
-*> The (n-1) squared off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot allowed in the Sturm sequence for T.
-*> \endverbatim
-*>
-*> \param[in] RELTOL
-*> \verbatim
-*> RELTOL is REAL
-*> The minimum relative width of an interval. When an interval
-*> is narrower than RELTOL times the larger (in
-*> magnitude) endpoint, then it is considered to be
-*> sufficiently small, i.e., converged. Note: this should
-*> always be at least radix*machine epsilon.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL
-*> \endverbatim
-*>
-*> \param[out] WERR
-*> \verbatim
-*> WERR is REAL
-*> The error bound on the corresponding eigenvalue approximation
-*> in W.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: Eigenvalue converged
-*> = -1: Eigenvalue did NOT converge
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> FUDGE REAL , default = 2
-*> A "fudge factor" to widen the Gershgorin intervals.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARRK( N, IW, GL, GU,
- $ D, E2, PIVMIN, RELTOL, W, WERR, INFO)
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, IW, N
- REAL PIVMIN, RELTOL, GL, GU, W, WERR
-* ..
-* .. Array Arguments ..
- REAL D( * ), E2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL FUDGE, HALF, TWO, ZERO
- PARAMETER ( HALF = 0.5E0, TWO = 2.0E0,
- $ FUDGE = TWO, ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IT, ITMAX, NEGCNT
- REAL ATOLI, EPS, LEFT, MID, RIGHT, RTOLI, TMP1,
- $ TMP2, TNORM
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX
-* ..
-* .. Executable Statements ..
-*
-* Get machine constants
- EPS = SLAMCH( 'P' )
-
- TNORM = MAX( ABS( GL ), ABS( GU ) )
- RTOLI = RELTOL
- ATOLI = FUDGE*TWO*PIVMIN
-
- ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
-
- INFO = -1
-
- LEFT = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN
- RIGHT = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN
- IT = 0
-
- 10 CONTINUE
-*
-* Check if interval converged or maximum number of iterations reached
-*
- TMP1 = ABS( RIGHT - LEFT )
- TMP2 = MAX( ABS(RIGHT), ABS(LEFT) )
- IF( TMP1.LT.MAX( ATOLI, PIVMIN, RTOLI*TMP2 ) ) THEN
- INFO = 0
- GOTO 30
- ENDIF
- IF(IT.GT.ITMAX)
- $ GOTO 30
-
-*
-* Count number of negative pivots for mid-point
-*
- IT = IT + 1
- MID = HALF * (LEFT + RIGHT)
- NEGCNT = 0
- TMP1 = D( 1 ) - MID
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- IF( TMP1.LE.ZERO )
- $ NEGCNT = NEGCNT + 1
-*
- DO 20 I = 2, N
- TMP1 = D( I ) - E2( I-1 ) / TMP1 - MID
- IF( ABS( TMP1 ).LT.PIVMIN )
- $ TMP1 = -PIVMIN
- IF( TMP1.LE.ZERO )
- $ NEGCNT = NEGCNT + 1
- 20 CONTINUE
-
- IF(NEGCNT.GE.IW) THEN
- RIGHT = MID
- ELSE
- LEFT = MID
- ENDIF
- GOTO 10
-
- 30 CONTINUE
-*
-* Converged or maximum number of iterations reached
-*
- W = HALF * (LEFT + RIGHT)
- WERR = HALF * ABS( RIGHT - LEFT )
-
- RETURN
-*
-* End of SLARRK
-*
- END
diff --git a/netlib/LAPACK/slarrr.f b/netlib/LAPACK/slarrr.f
deleted file mode 100644
index 5e2230d..0000000
--- a/netlib/LAPACK/slarrr.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRR( N, D, E, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER N, INFO
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * )
-* ..
-*
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Perform tests to decide whether the symmetric tridiagonal matrix T
-*> warrants expensive computations which guarantee high relative accuracy
-*> in the eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N > 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The N diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> On entry, the first (N-1) entries contain the subdiagonal
-*> elements of the tridiagonal matrix T; E(N) is set to ZERO.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> INFO = 0(default) : the matrix warrants computations preserving
-*> relative accuracy.
-*> INFO = 1 : the matrix warrants computations guaranteeing
-*> only absolute accuracy.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRR( N, D, E, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N, INFO
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * )
-* ..
-*
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, RELCOND
- PARAMETER ( ZERO = 0.0E0,
- $ RELCOND = 0.999E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- LOGICAL YESREL
- REAL EPS, SAFMIN, SMLNUM, RMIN, TMP, TMP2,
- $ OFFDIG, OFFDIG2
-
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* As a default, do NOT go for relative-accuracy preserving computations.
- INFO = 1
-
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- RMIN = SQRT( SMLNUM )
-
-* Tests for relative accuracy
-*
-* Test for scaled diagonal dominance
-* Scale the diagonal entries to one and check whether the sum of the
-* off-diagonals is less than one
-*
-* The sdd relative error bounds have a 1/(1- 2*x) factor in them,
-* x = max(OFFDIG + OFFDIG2), so when x is close to 1/2, no relative
-* accuracy is promised. In the notation of the code fragment below,
-* 1/(1 - (OFFDIG + OFFDIG2)) is the condition number.
-* We don't think it is worth going into "sdd mode" unless the relative
-* condition number is reasonable, not 1/macheps.
-* The threshold should be compatible with other thresholds used in the
-* code. We set OFFDIG + OFFDIG2 <= .999 =: RELCOND, it corresponds
-* to losing at most 3 decimal digits: 1 / (1 - (OFFDIG + OFFDIG2)) <= 1000
-* instead of the current OFFDIG + OFFDIG2 < 1
-*
- YESREL = .TRUE.
- OFFDIG = ZERO
- TMP = SQRT(ABS(D(1)))
- IF (TMP.LT.RMIN) YESREL = .FALSE.
- IF(.NOT.YESREL) GOTO 11
- DO 10 I = 2, N
- TMP2 = SQRT(ABS(D(I)))
- IF (TMP2.LT.RMIN) YESREL = .FALSE.
- IF(.NOT.YESREL) GOTO 11
- OFFDIG2 = ABS(E(I-1))/(TMP*TMP2)
- IF(OFFDIG+OFFDIG2.GE.RELCOND) YESREL = .FALSE.
- IF(.NOT.YESREL) GOTO 11
- TMP = TMP2
- OFFDIG = OFFDIG2
- 10 CONTINUE
- 11 CONTINUE
-
- IF( YESREL ) THEN
- INFO = 0
- RETURN
- ELSE
- ENDIF
-*
-
-*
-* *** MORE TO BE IMPLEMENTED ***
-*
-
-*
-* Test if the lower bidiagonal matrix L from T = L D L^T
-* (zero shift facto) is well conditioned
-*
-
-*
-* Test if the upper bidiagonal matrix U from T = U D U^T
-* (zero shift facto) is well conditioned.
-* In this case, the matrix needs to be flipped and, at the end
-* of the eigenvector computation, the flip needs to be applied
-* to the computed eigenvectors (and the support)
-*
-
-*
- RETURN
-*
-* END OF SLARRR
-*
- END
diff --git a/netlib/LAPACK/slarrv.f b/netlib/LAPACK/slarrv.f
deleted file mode 100644
index f93eeb4..0000000
--- a/netlib/LAPACK/slarrv.f
+++ /dev/null
@@ -1,1028 +0,0 @@
-*> \brief \b SLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARRV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARRV( N, VL, VU, D, L, PIVMIN,
-* ISPLIT, M, DOL, DOU, MINRGP,
-* RTOL1, RTOL2, W, WERR, WGAP,
-* IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER DOL, DOU, INFO, LDZ, M, N
-* REAL MINRGP, PIVMIN, RTOL1, RTOL2, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), INDEXW( * ), ISPLIT( * ),
-* $ ISUPPZ( * ), IWORK( * )
-* REAL D( * ), GERS( * ), L( * ), W( * ), WERR( * ),
-* $ WGAP( * ), WORK( * )
-* REAL Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARRV computes the eigenvectors of the tridiagonal matrix
-*> T = L D L**T given L, D and APPROXIMATIONS to the eigenvalues of L D L**T.
-*> The input eigenvalues should have been computed by SLARRE.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> Lower and upper bounds of the interval that contains the desired
-*> eigenvalues. VL < VU. Needed to compute gaps on the left or right
-*> end of the extremal eigenvalues in the desired RANGE.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the N diagonal elements of the diagonal matrix D.
-*> On exit, D may be overwritten.
-*> \endverbatim
-*>
-*> \param[in,out] L
-*> \verbatim
-*> L is REAL array, dimension (N)
-*> On entry, the (N-1) subdiagonal elements of the unit
-*> bidiagonal matrix L are in elements 1 to N-1 of L
-*> (if the matrix is not splitted.) At the end of each block
-*> is stored the corresponding shift as given by SLARRE.
-*> On exit, L is overwritten.
-*> \endverbatim
-*>
-*> \param[in] PIVMIN
-*> \verbatim
-*> PIVMIN is REAL
-*> The minimum pivot allowed in the Sturm sequence.
-*> \endverbatim
-*>
-*> \param[in] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into blocks.
-*> The first block consists of rows/columns 1 to
-*> ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
-*> through ISPLIT( 2 ), etc.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of input eigenvalues. 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[in] DOL
-*> \verbatim
-*> DOL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] DOU
-*> \verbatim
-*> DOU is INTEGER
-*> If the user wants to compute only selected eigenvectors from all
-*> the eigenvalues supplied, he can specify an index range DOL:DOU.
-*> Or else the setting DOL=1, DOU=M should be applied.
-*> Note that DOL and DOU refer to the order in which the eigenvalues
-*> are stored in W.
-*> If the user wants to compute only selected eigenpairs, then
-*> the columns DOL-1 to DOU+1 of the eigenvector space Z contain the
-*> computed eigenvectors. All other columns of Z are set to zero.
-*> \endverbatim
-*>
-*> \param[in] MINRGP
-*> \verbatim
-*> MINRGP is REAL
-*> \endverbatim
-*>
-*> \param[in] RTOL1
-*> \verbatim
-*> RTOL1 is REAL
-*> \endverbatim
-*>
-*> \param[in] RTOL2
-*> \verbatim
-*> RTOL2 is REAL
-*> Parameters for bisection.
-*> An interval [LEFT,RIGHT] has converged if
-*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
-*> \endverbatim
-*>
-*> \param[in,out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements of W contain the APPROXIMATE eigenvalues for
-*> which eigenvectors are to be computed. The eigenvalues
-*> should be grouped by split-off block and ordered from
-*> smallest to largest within the block ( The output array
-*> W from SLARRE is expected here ). Furthermore, they are with
-*> respect to the shift of the corresponding root representation
-*> for their block. On exit, W holds the eigenvalues of the
-*> UNshifted matrix.
-*> \endverbatim
-*>
-*> \param[in,out] WERR
-*> \verbatim
-*> WERR is REAL array, dimension (N)
-*> The first M elements contain the semiwidth of the uncertainty
-*> interval of the corresponding eigenvalue in W
-*> \endverbatim
-*>
-*> \param[in,out] WGAP
-*> \verbatim
-*> WGAP is REAL array, dimension (N)
-*> The separation from the right neighbor eigenvalue in W.
-*> \endverbatim
-*>
-*> \param[in] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> The indices of the blocks (submatrices) associated with the
-*> corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
-*> W(i) belongs to the first block from the top, =2 if W(i)
-*> belongs to the second block, etc.
-*> \endverbatim
-*>
-*> \param[in] INDEXW
-*> \verbatim
-*> INDEXW is INTEGER array, dimension (N)
-*> The indices of the eigenvalues within each block (submatrix);
-*> for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
-*> i-th eigenvalue W(i) is the 10-th eigenvalue in the second block.
-*> \endverbatim
-*>
-*> \param[in] GERS
-*> \verbatim
-*> GERS is REAL array, dimension (2*N)
-*> The N Gerschgorin intervals (the i-th Gerschgorin interval
-*> is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should
-*> be computed from the original UNshifted matrix.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M) )
-*> If INFO = 0, the first M columns of Z contain the
-*> orthonormal eigenvectors of the matrix T
-*> corresponding to the input eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The I-th eigenvector
-*> is nonzero only in elements ISUPPZ( 2*I-1 ) through
-*> ISUPPZ( 2*I ).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (12*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (7*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*>
-*> > 0: A problem occured in SLARRV.
-*> < 0: One of the called subroutines signaled an internal problem.
-*> Needs inspection of the corresponding parameter IINFO
-*> for further information.
-*>
-*> =-1: Problem in SLARRB when refining a child's eigenvalues.
-*> =-2: Problem in SLARRF when computing the RRR of a child.
-*> When a child is inside a tight cluster, it can be difficult
-*> to find an RRR. A partial remedy from the user's point of
-*> view is to make the parameter MINRGP smaller and recompile.
-*> However, as the orthogonality of the computed vectors is
-*> proportional to 1/MINRGP, the user should be aware that
-*> he might be trading in precision when he decreases MINRGP.
-*> =-3: Problem in SLARRB when refining a single eigenvalue
-*> after the Rayleigh correction was rejected.
-*> = 5: The Rayleigh Quotient Iteration failed to converge to
-*> full accuracy in MAXITR steps.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SLARRV( N, VL, VU, D, L, PIVMIN,
- $ ISPLIT, M, DOL, DOU, MINRGP,
- $ RTOL1, RTOL2, W, WERR, WGAP,
- $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER DOL, DOU, INFO, LDZ, M, N
- REAL MINRGP, PIVMIN, RTOL1, RTOL2, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), INDEXW( * ), ISPLIT( * ),
- $ ISUPPZ( * ), IWORK( * )
- REAL D( * ), GERS( * ), L( * ), W( * ), WERR( * ),
- $ WGAP( * ), WORK( * )
- REAL Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXITR
- PARAMETER ( MAXITR = 10 )
- REAL ZERO, ONE, TWO, THREE, FOUR, HALF
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0,
- $ TWO = 2.0E0, THREE = 3.0E0,
- $ FOUR = 4.0E0, HALF = 0.5E0)
-* ..
-* .. Local Scalars ..
- LOGICAL ESKIP, NEEDBS, STP2II, TRYRQC, USEDBS, USEDRQ
- INTEGER DONE, I, IBEGIN, IDONE, IEND, II, IINDC1,
- $ IINDC2, IINDR, IINDWK, IINFO, IM, IN, INDEIG,
- $ INDLD, INDLLD, INDWRK, ISUPMN, ISUPMX, ITER,
- $ ITMP1, J, JBLK, K, MINIWSIZE, MINWSIZE, NCLUS,
- $ NDEPTH, NEGCNT, NEWCLS, NEWFST, NEWFTT, NEWLST,
- $ NEWSIZ, OFFSET, OLDCLS, OLDFST, OLDIEN, OLDLST,
- $ OLDNCL, P, PARITY, Q, WBEGIN, WEND, WINDEX,
- $ WINDMN, WINDPL, ZFROM, ZTO, ZUSEDL, ZUSEDU,
- $ ZUSEDW
- REAL BSTRES, BSTW, EPS, FUDGE, GAP, GAPTOL, GL, GU,
- $ LAMBDA, LEFT, LGAP, MINGMA, NRMINV, RESID,
- $ RGAP, RIGHT, RQCORR, RQTOL, SAVGAP, SGNDEF,
- $ SIGMA, SPDIAM, SSIGMA, TAU, TMP, TOL, ZTZ
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAR1V, SLARRB, SLARRF, SLASET,
- $ SSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, REAL, MAX, MIN
-* ..
-* .. Executable Statements ..
-* ..
-
-* The first N entries of WORK are reserved for the eigenvalues
- INDLD = N+1
- INDLLD= 2*N+1
- INDWRK= 3*N+1
- MINWSIZE = 12 * N
-
- DO 5 I= 1,MINWSIZE
- WORK( I ) = ZERO
- 5 CONTINUE
-
-* IWORK(IINDR+1:IINDR+N) hold the twist indices R for the
-* factorization used to compute the FP vector
- IINDR = 0
-* IWORK(IINDC1+1:IINC2+N) are used to store the clusters of the current
-* layer and the one above.
- IINDC1 = N
- IINDC2 = 2*N
- IINDWK = 3*N + 1
-
- MINIWSIZE = 7 * N
- DO 10 I= 1,MINIWSIZE
- IWORK( I ) = 0
- 10 CONTINUE
-
- ZUSEDL = 1
- IF(DOL.GT.1) THEN
-* Set lower bound for use of Z
- ZUSEDL = DOL-1
- ENDIF
- ZUSEDU = M
- IF(DOU.LT.M) THEN
-* Set lower bound for use of Z
- ZUSEDU = DOU+1
- ENDIF
-* The width of the part of Z that is used
- ZUSEDW = ZUSEDU - ZUSEDL + 1
-
-
- CALL SLASET( 'Full', N, ZUSEDW, ZERO, ZERO,
- $ Z(1,ZUSEDL), LDZ )
-
- EPS = SLAMCH( 'Precision' )
- RQTOL = TWO * EPS
-*
-* Set expert flags for standard code.
- TRYRQC = .TRUE.
-
- IF((DOL.EQ.1).AND.(DOU.EQ.M)) THEN
- ELSE
-* Only selected eigenpairs are computed. Since the other evalues
-* are not refined by RQ iteration, bisection has to compute to full
-* accuracy.
- RTOL1 = FOUR * EPS
- RTOL2 = FOUR * EPS
- ENDIF
-
-* The entries WBEGIN:WEND in W, WERR, WGAP correspond to the
-* desired eigenvalues. The support of the nonzero eigenvector
-* entries is contained in the interval IBEGIN:IEND.
-* Remark that if k eigenpairs are desired, then the eigenvectors
-* are stored in k contiguous columns of Z.
-
-* DONE is the number of eigenvectors already computed
- DONE = 0
- IBEGIN = 1
- WBEGIN = 1
- DO 170 JBLK = 1, IBLOCK( M )
- IEND = ISPLIT( JBLK )
- SIGMA = L( IEND )
-* Find the eigenvectors of the submatrix indexed IBEGIN
-* through IEND.
- WEND = WBEGIN - 1
- 15 CONTINUE
- IF( WEND.LT.M ) THEN
- IF( IBLOCK( WEND+1 ).EQ.JBLK ) THEN
- WEND = WEND + 1
- GO TO 15
- END IF
- END IF
- IF( WEND.LT.WBEGIN ) THEN
- IBEGIN = IEND + 1
- GO TO 170
- ELSEIF( (WEND.LT.DOL).OR.(WBEGIN.GT.DOU) ) THEN
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- GO TO 170
- END IF
-
-* Find local spectral diameter of the block
- GL = GERS( 2*IBEGIN-1 )
- GU = GERS( 2*IBEGIN )
- DO 20 I = IBEGIN+1 , IEND
- GL = MIN( GERS( 2*I-1 ), GL )
- GU = MAX( GERS( 2*I ), GU )
- 20 CONTINUE
- SPDIAM = GU - GL
-
-* OLDIEN is the last index of the previous block
- OLDIEN = IBEGIN - 1
-* Calculate the size of the current block
- IN = IEND - IBEGIN + 1
-* The number of eigenvalues in the current block
- IM = WEND - WBEGIN + 1
-
-* This is for a 1x1 block
- IF( IBEGIN.EQ.IEND ) THEN
- DONE = DONE+1
- Z( IBEGIN, WBEGIN ) = ONE
- ISUPPZ( 2*WBEGIN-1 ) = IBEGIN
- ISUPPZ( 2*WBEGIN ) = IBEGIN
- W( WBEGIN ) = W( WBEGIN ) + SIGMA
- WORK( WBEGIN ) = W( WBEGIN )
- IBEGIN = IEND + 1
- WBEGIN = WBEGIN + 1
- GO TO 170
- END IF
-
-* The desired (shifted) eigenvalues are stored in W(WBEGIN:WEND)
-* Note that these can be approximations, in this case, the corresp.
-* entries of WERR give the size of the uncertainty interval.
-* The eigenvalue approximations will be refined when necessary as
-* high relative accuracy is required for the computation of the
-* corresponding eigenvectors.
- CALL SCOPY( IM, W( WBEGIN ), 1,
- $ WORK( WBEGIN ), 1 )
-
-* We store in W the eigenvalue approximations w.r.t. the original
-* matrix T.
- DO 30 I=1,IM
- W(WBEGIN+I-1) = W(WBEGIN+I-1)+SIGMA
- 30 CONTINUE
-
-
-* NDEPTH is the current depth of the representation tree
- NDEPTH = 0
-* PARITY is either 1 or 0
- PARITY = 1
-* NCLUS is the number of clusters for the next level of the
-* representation tree, we start with NCLUS = 1 for the root
- NCLUS = 1
- IWORK( IINDC1+1 ) = 1
- IWORK( IINDC1+2 ) = IM
-
-* IDONE is the number of eigenvectors already computed in the current
-* block
- IDONE = 0
-* loop while( IDONE.LT.IM )
-* generate the representation tree for the current block and
-* compute the eigenvectors
- 40 CONTINUE
- IF( IDONE.LT.IM ) THEN
-* This is a crude protection against infinitely deep trees
- IF( NDEPTH.GT.M ) THEN
- INFO = -2
- RETURN
- ENDIF
-* breadth first processing of the current level of the representation
-* tree: OLDNCL = number of clusters on current level
- OLDNCL = NCLUS
-* reset NCLUS to count the number of child clusters
- NCLUS = 0
-*
- PARITY = 1 - PARITY
- IF( PARITY.EQ.0 ) THEN
- OLDCLS = IINDC1
- NEWCLS = IINDC2
- ELSE
- OLDCLS = IINDC2
- NEWCLS = IINDC1
- END IF
-* Process the clusters on the current level
- DO 150 I = 1, OLDNCL
- J = OLDCLS + 2*I
-* OLDFST, OLDLST = first, last index of current cluster.
-* cluster indices start with 1 and are relative
-* to WBEGIN when accessing W, WGAP, WERR, Z
- OLDFST = IWORK( J-1 )
- OLDLST = IWORK( J )
- IF( NDEPTH.GT.0 ) THEN
-* Retrieve relatively robust representation (RRR) of cluster
-* that has been computed at the previous level
-* The RRR is stored in Z and overwritten once the eigenvectors
-* have been computed or when the cluster is refined
-
- IF((DOL.EQ.1).AND.(DOU.EQ.M)) THEN
-* Get representation from location of the leftmost evalue
-* of the cluster
- J = WBEGIN + OLDFST - 1
- ELSE
- IF(WBEGIN+OLDFST-1.LT.DOL) THEN
-* Get representation from the left end of Z array
- J = DOL - 1
- ELSEIF(WBEGIN+OLDFST-1.GT.DOU) THEN
-* Get representation from the right end of Z array
- J = DOU
- ELSE
- J = WBEGIN + OLDFST - 1
- ENDIF
- ENDIF
- CALL SCOPY( IN, Z( IBEGIN, J ), 1, D( IBEGIN ), 1 )
- CALL SCOPY( IN-1, Z( IBEGIN, J+1 ), 1, L( IBEGIN ),
- $ 1 )
- SIGMA = Z( IEND, J+1 )
-
-* Set the corresponding entries in Z to zero
- CALL SLASET( 'Full', IN, 2, ZERO, ZERO,
- $ Z( IBEGIN, J), LDZ )
- END IF
-
-* Compute DL and DLL of current RRR
- DO 50 J = IBEGIN, IEND-1
- TMP = D( J )*L( J )
- WORK( INDLD-1+J ) = TMP
- WORK( INDLLD-1+J ) = TMP*L( J )
- 50 CONTINUE
-
- IF( NDEPTH.GT.0 ) THEN
-* P and Q are index of the first and last eigenvalue to compute
-* within the current block
- P = INDEXW( WBEGIN-1+OLDFST )
- Q = INDEXW( WBEGIN-1+OLDLST )
-* Offset for the arrays WORK, WGAP and WERR, i.e., the P-OFFSET
-* through the Q-OFFSET elements of these arrays are to be used.
-* OFFSET = P-OLDFST
- OFFSET = INDEXW( WBEGIN ) - 1
-* perform limited bisection (if necessary) to get approximate
-* eigenvalues to the precision needed.
- CALL SLARRB( IN, D( IBEGIN ),
- $ WORK(INDLLD+IBEGIN-1),
- $ P, Q, RTOL1, RTOL2, OFFSET,
- $ WORK(WBEGIN),WGAP(WBEGIN),WERR(WBEGIN),
- $ WORK( INDWRK ), IWORK( IINDWK ),
- $ PIVMIN, SPDIAM, IN, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -1
- RETURN
- ENDIF
-* We also recompute the extremal gaps. W holds all eigenvalues
-* of the unshifted matrix and must be used for computation
-* of WGAP, the entries of WORK might stem from RRRs with
-* different shifts. The gaps from WBEGIN-1+OLDFST to
-* WBEGIN-1+OLDLST are correctly computed in SLARRB.
-* However, we only allow the gaps to become greater since
-* this is what should happen when we decrease WERR
- IF( OLDFST.GT.1) THEN
- WGAP( WBEGIN+OLDFST-2 ) =
- $ MAX(WGAP(WBEGIN+OLDFST-2),
- $ W(WBEGIN+OLDFST-1)-WERR(WBEGIN+OLDFST-1)
- $ - W(WBEGIN+OLDFST-2)-WERR(WBEGIN+OLDFST-2) )
- ENDIF
- IF( WBEGIN + OLDLST -1 .LT. WEND ) THEN
- WGAP( WBEGIN+OLDLST-1 ) =
- $ MAX(WGAP(WBEGIN+OLDLST-1),
- $ W(WBEGIN+OLDLST)-WERR(WBEGIN+OLDLST)
- $ - W(WBEGIN+OLDLST-1)-WERR(WBEGIN+OLDLST-1) )
- ENDIF
-* Each time the eigenvalues in WORK get refined, we store
-* the newly found approximation with all shifts applied in W
- DO 53 J=OLDFST,OLDLST
- W(WBEGIN+J-1) = WORK(WBEGIN+J-1)+SIGMA
- 53 CONTINUE
- END IF
-
-* Process the current node.
- NEWFST = OLDFST
- DO 140 J = OLDFST, OLDLST
- IF( J.EQ.OLDLST ) THEN
-* we are at the right end of the cluster, this is also the
-* boundary of the child cluster
- NEWLST = J
- ELSE IF ( WGAP( WBEGIN + J -1).GE.
- $ MINRGP* ABS( WORK(WBEGIN + J -1) ) ) THEN
-* the right relative gap is big enough, the child cluster
-* (NEWFST,..,NEWLST) is well separated from the following
- NEWLST = J
- ELSE
-* inside a child cluster, the relative gap is not
-* big enough.
- GOTO 140
- END IF
-
-* Compute size of child cluster found
- NEWSIZ = NEWLST - NEWFST + 1
-
-* NEWFTT is the place in Z where the new RRR or the computed
-* eigenvector is to be stored
- IF((DOL.EQ.1).AND.(DOU.EQ.M)) THEN
-* Store representation at location of the leftmost evalue
-* of the cluster
- NEWFTT = WBEGIN + NEWFST - 1
- ELSE
- IF(WBEGIN+NEWFST-1.LT.DOL) THEN
-* Store representation at the left end of Z array
- NEWFTT = DOL - 1
- ELSEIF(WBEGIN+NEWFST-1.GT.DOU) THEN
-* Store representation at the right end of Z array
- NEWFTT = DOU
- ELSE
- NEWFTT = WBEGIN + NEWFST - 1
- ENDIF
- ENDIF
-
- IF( NEWSIZ.GT.1) THEN
-*
-* Current child is not a singleton but a cluster.
-* Compute and store new representation of child.
-*
-*
-* Compute left and right cluster gap.
-*
-* LGAP and RGAP are not computed from WORK because
-* the eigenvalue approximations may stem from RRRs
-* different shifts. However, W hold all eigenvalues
-* of the unshifted matrix. Still, the entries in WGAP
-* have to be computed from WORK since the entries
-* in W might be of the same order so that gaps are not
-* exhibited correctly for very close eigenvalues.
- IF( NEWFST.EQ.1 ) THEN
- LGAP = MAX( ZERO,
- $ W(WBEGIN)-WERR(WBEGIN) - VL )
- ELSE
- LGAP = WGAP( WBEGIN+NEWFST-2 )
- ENDIF
- RGAP = WGAP( WBEGIN+NEWLST-1 )
-*
-* Compute left- and rightmost eigenvalue of child
-* to high precision in order to shift as close
-* as possible and obtain as large relative gaps
-* as possible
-*
- DO 55 K =1,2
- IF(K.EQ.1) THEN
- P = INDEXW( WBEGIN-1+NEWFST )
- ELSE
- P = INDEXW( WBEGIN-1+NEWLST )
- ENDIF
- OFFSET = INDEXW( WBEGIN ) - 1
- CALL SLARRB( IN, D(IBEGIN),
- $ WORK( INDLLD+IBEGIN-1 ),P,P,
- $ RQTOL, RQTOL, OFFSET,
- $ WORK(WBEGIN),WGAP(WBEGIN),
- $ WERR(WBEGIN),WORK( INDWRK ),
- $ IWORK( IINDWK ), PIVMIN, SPDIAM,
- $ IN, IINFO )
- 55 CONTINUE
-*
- IF((WBEGIN+NEWLST-1.LT.DOL).OR.
- $ (WBEGIN+NEWFST-1.GT.DOU)) THEN
-* if the cluster contains no desired eigenvalues
-* skip the computation of that branch of the rep. tree
-*
-* We could skip before the refinement of the extremal
-* eigenvalues of the child, but then the representation
-* tree could be different from the one when nothing is
-* skipped. For this reason we skip at this place.
- IDONE = IDONE + NEWLST - NEWFST + 1
- GOTO 139
- ENDIF
-*
-* Compute RRR of child cluster.
-* Note that the new RRR is stored in Z
-*
-* SLARRF needs LWORK = 2*N
- CALL SLARRF( IN, D( IBEGIN ), L( IBEGIN ),
- $ WORK(INDLD+IBEGIN-1),
- $ NEWFST, NEWLST, WORK(WBEGIN),
- $ WGAP(WBEGIN), WERR(WBEGIN),
- $ SPDIAM, LGAP, RGAP, PIVMIN, TAU,
- $ Z(IBEGIN, NEWFTT),Z(IBEGIN, NEWFTT+1),
- $ WORK( INDWRK ), IINFO )
- IF( IINFO.EQ.0 ) THEN
-* a new RRR for the cluster was found by SLARRF
-* update shift and store it
- SSIGMA = SIGMA + TAU
- Z( IEND, NEWFTT+1 ) = SSIGMA
-* WORK() are the midpoints and WERR() the semi-width
-* Note that the entries in W are unchanged.
- DO 116 K = NEWFST, NEWLST
- FUDGE =
- $ THREE*EPS*ABS(WORK(WBEGIN+K-1))
- WORK( WBEGIN + K - 1 ) =
- $ WORK( WBEGIN + K - 1) - TAU
- FUDGE = FUDGE +
- $ FOUR*EPS*ABS(WORK(WBEGIN+K-1))
-* Fudge errors
- WERR( WBEGIN + K - 1 ) =
- $ WERR( WBEGIN + K - 1 ) + FUDGE
-* Gaps are not fudged. Provided that WERR is small
-* when eigenvalues are close, a zero gap indicates
-* that a new representation is needed for resolving
-* the cluster. A fudge could lead to a wrong decision
-* of judging eigenvalues 'separated' which in
-* reality are not. This could have a negative impact
-* on the orthogonality of the computed eigenvectors.
- 116 CONTINUE
-
- NCLUS = NCLUS + 1
- K = NEWCLS + 2*NCLUS
- IWORK( K-1 ) = NEWFST
- IWORK( K ) = NEWLST
- ELSE
- INFO = -2
- RETURN
- ENDIF
- ELSE
-*
-* Compute eigenvector of singleton
-*
- ITER = 0
-*
- TOL = FOUR * LOG(REAL(IN)) * EPS
-*
- K = NEWFST
- WINDEX = WBEGIN + K - 1
- WINDMN = MAX(WINDEX - 1,1)
- WINDPL = MIN(WINDEX + 1,M)
- LAMBDA = WORK( WINDEX )
- DONE = DONE + 1
-* Check if eigenvector computation is to be skipped
- IF((WINDEX.LT.DOL).OR.
- $ (WINDEX.GT.DOU)) THEN
- ESKIP = .TRUE.
- GOTO 125
- ELSE
- ESKIP = .FALSE.
- ENDIF
- LEFT = WORK( WINDEX ) - WERR( WINDEX )
- RIGHT = WORK( WINDEX ) + WERR( WINDEX )
- INDEIG = INDEXW( WINDEX )
-* Note that since we compute the eigenpairs for a child,
-* all eigenvalue approximations are w.r.t the same shift.
-* In this case, the entries in WORK should be used for
-* computing the gaps since they exhibit even very small
-* differences in the eigenvalues, as opposed to the
-* entries in W which might "look" the same.
-
- IF( K .EQ. 1) THEN
-* In the case RANGE='I' and with not much initial
-* accuracy in LAMBDA and VL, the formula
-* LGAP = MAX( ZERO, (SIGMA - VL) + LAMBDA )
-* can lead to an overestimation of the left gap and
-* thus to inadequately early RQI 'convergence'.
-* Prevent this by forcing a small left gap.
- LGAP = EPS*MAX(ABS(LEFT),ABS(RIGHT))
- ELSE
- LGAP = WGAP(WINDMN)
- ENDIF
- IF( K .EQ. IM) THEN
-* In the case RANGE='I' and with not much initial
-* accuracy in LAMBDA and VU, the formula
-* can lead to an overestimation of the right gap and
-* thus to inadequately early RQI 'convergence'.
-* Prevent this by forcing a small right gap.
- RGAP = EPS*MAX(ABS(LEFT),ABS(RIGHT))
- ELSE
- RGAP = WGAP(WINDEX)
- ENDIF
- GAP = MIN( LGAP, RGAP )
- IF(( K .EQ. 1).OR.(K .EQ. IM)) THEN
-* The eigenvector support can become wrong
-* because significant entries could be cut off due to a
-* large GAPTOL parameter in LAR1V. Prevent this.
- GAPTOL = ZERO
- ELSE
- GAPTOL = GAP * EPS
- ENDIF
- ISUPMN = IN
- ISUPMX = 1
-* Update WGAP so that it holds the minimum gap
-* to the left or the right. This is crucial in the
-* case where bisection is used to ensure that the
-* eigenvalue is refined up to the required precision.
-* The correct value is restored afterwards.
- SAVGAP = WGAP(WINDEX)
- WGAP(WINDEX) = GAP
-* We want to use the Rayleigh Quotient Correction
-* as often as possible since it converges quadratically
-* when we are close enough to the desired eigenvalue.
-* However, the Rayleigh Quotient can have the wrong sign
-* and lead us away from the desired eigenvalue. In this
-* case, the best we can do is to use bisection.
- USEDBS = .FALSE.
- USEDRQ = .FALSE.
-* Bisection is initially turned off unless it is forced
- NEEDBS = .NOT.TRYRQC
- 120 CONTINUE
-* Check if bisection should be used to refine eigenvalue
- IF(NEEDBS) THEN
-* Take the bisection as new iterate
- USEDBS = .TRUE.
- ITMP1 = IWORK( IINDR+WINDEX )
- OFFSET = INDEXW( WBEGIN ) - 1
- CALL SLARRB( IN, D(IBEGIN),
- $ WORK(INDLLD+IBEGIN-1),INDEIG,INDEIG,
- $ ZERO, TWO*EPS, OFFSET,
- $ WORK(WBEGIN),WGAP(WBEGIN),
- $ WERR(WBEGIN),WORK( INDWRK ),
- $ IWORK( IINDWK ), PIVMIN, SPDIAM,
- $ ITMP1, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = -3
- RETURN
- ENDIF
- LAMBDA = WORK( WINDEX )
-* Reset twist index from inaccurate LAMBDA to
-* force computation of true MINGMA
- IWORK( IINDR+WINDEX ) = 0
- ENDIF
-* Given LAMBDA, compute the eigenvector.
- CALL SLAR1V( IN, 1, IN, LAMBDA, D( IBEGIN ),
- $ L( IBEGIN ), WORK(INDLD+IBEGIN-1),
- $ WORK(INDLLD+IBEGIN-1),
- $ PIVMIN, GAPTOL, Z( IBEGIN, WINDEX ),
- $ .NOT.USEDBS, NEGCNT, ZTZ, MINGMA,
- $ IWORK( IINDR+WINDEX ), ISUPPZ( 2*WINDEX-1 ),
- $ NRMINV, RESID, RQCORR, WORK( INDWRK ) )
- IF(ITER .EQ. 0) THEN
- BSTRES = RESID
- BSTW = LAMBDA
- ELSEIF(RESID.LT.BSTRES) THEN
- BSTRES = RESID
- BSTW = LAMBDA
- ENDIF
- ISUPMN = MIN(ISUPMN,ISUPPZ( 2*WINDEX-1 ))
- ISUPMX = MAX(ISUPMX,ISUPPZ( 2*WINDEX ))
- ITER = ITER + 1
-
-* sin alpha <= |resid|/gap
-* Note that both the residual and the gap are
-* proportional to the matrix, so ||T|| doesn't play
-* a role in the quotient
-
-*
-* Convergence test for Rayleigh-Quotient iteration
-* (omitted when Bisection has been used)
-*
- IF( RESID.GT.TOL*GAP .AND. ABS( RQCORR ).GT.
- $ RQTOL*ABS( LAMBDA ) .AND. .NOT. USEDBS)
- $ THEN
-* We need to check that the RQCORR update doesn't
-* move the eigenvalue away from the desired one and
-* towards a neighbor. -> protection with bisection
- IF(INDEIG.LE.NEGCNT) THEN
-* The wanted eigenvalue lies to the left
- SGNDEF = -ONE
- ELSE
-* The wanted eigenvalue lies to the right
- SGNDEF = ONE
- ENDIF
-* We only use the RQCORR if it improves the
-* the iterate reasonably.
- IF( ( RQCORR*SGNDEF.GE.ZERO )
- $ .AND.( LAMBDA + RQCORR.LE. RIGHT)
- $ .AND.( LAMBDA + RQCORR.GE. LEFT)
- $ ) THEN
- USEDRQ = .TRUE.
-* Store new midpoint of bisection interval in WORK
- IF(SGNDEF.EQ.ONE) THEN
-* The current LAMBDA is on the left of the true
-* eigenvalue
- LEFT = LAMBDA
-* We prefer to assume that the error estimate
-* is correct. We could make the interval not
-* as a bracket but to be modified if the RQCORR
-* chooses to. In this case, the RIGHT side should
-* be modified as follows:
-* RIGHT = MAX(RIGHT, LAMBDA + RQCORR)
- ELSE
-* The current LAMBDA is on the right of the true
-* eigenvalue
- RIGHT = LAMBDA
-* See comment about assuming the error estimate is
-* correct above.
-* LEFT = MIN(LEFT, LAMBDA + RQCORR)
- ENDIF
- WORK( WINDEX ) =
- $ HALF * (RIGHT + LEFT)
-* Take RQCORR since it has the correct sign and
-* improves the iterate reasonably
- LAMBDA = LAMBDA + RQCORR
-* Update width of error interval
- WERR( WINDEX ) =
- $ HALF * (RIGHT-LEFT)
- ELSE
- NEEDBS = .TRUE.
- ENDIF
- IF(RIGHT-LEFT.LT.RQTOL*ABS(LAMBDA)) THEN
-* The eigenvalue is computed to bisection accuracy
-* compute eigenvector and stop
- USEDBS = .TRUE.
- GOTO 120
- ELSEIF( ITER.LT.MAXITR ) THEN
- GOTO 120
- ELSEIF( ITER.EQ.MAXITR ) THEN
- NEEDBS = .TRUE.
- GOTO 120
- ELSE
- INFO = 5
- RETURN
- END IF
- ELSE
- STP2II = .FALSE.
- IF(USEDRQ .AND. USEDBS .AND.
- $ BSTRES.LE.RESID) THEN
- LAMBDA = BSTW
- STP2II = .TRUE.
- ENDIF
- IF (STP2II) THEN
-* improve error angle by second step
- CALL SLAR1V( IN, 1, IN, LAMBDA,
- $ D( IBEGIN ), L( IBEGIN ),
- $ WORK(INDLD+IBEGIN-1),
- $ WORK(INDLLD+IBEGIN-1),
- $ PIVMIN, GAPTOL, Z( IBEGIN, WINDEX ),
- $ .NOT.USEDBS, NEGCNT, ZTZ, MINGMA,
- $ IWORK( IINDR+WINDEX ),
- $ ISUPPZ( 2*WINDEX-1 ),
- $ NRMINV, RESID, RQCORR, WORK( INDWRK ) )
- ENDIF
- WORK( WINDEX ) = LAMBDA
- END IF
-*
-* Compute FP-vector support w.r.t. whole matrix
-*
- ISUPPZ( 2*WINDEX-1 ) = ISUPPZ( 2*WINDEX-1 )+OLDIEN
- ISUPPZ( 2*WINDEX ) = ISUPPZ( 2*WINDEX )+OLDIEN
- ZFROM = ISUPPZ( 2*WINDEX-1 )
- ZTO = ISUPPZ( 2*WINDEX )
- ISUPMN = ISUPMN + OLDIEN
- ISUPMX = ISUPMX + OLDIEN
-* Ensure vector is ok if support in the RQI has changed
- IF(ISUPMN.LT.ZFROM) THEN
- DO 122 II = ISUPMN,ZFROM-1
- Z( II, WINDEX ) = ZERO
- 122 CONTINUE
- ENDIF
- IF(ISUPMX.GT.ZTO) THEN
- DO 123 II = ZTO+1,ISUPMX
- Z( II, WINDEX ) = ZERO
- 123 CONTINUE
- ENDIF
- CALL SSCAL( ZTO-ZFROM+1, NRMINV,
- $ Z( ZFROM, WINDEX ), 1 )
- 125 CONTINUE
-* Update W
- W( WINDEX ) = LAMBDA+SIGMA
-* Recompute the gaps on the left and right
-* But only allow them to become larger and not
-* smaller (which can only happen through "bad"
-* cancellation and doesn't reflect the theory
-* where the initial gaps are underestimated due
-* to WERR being too crude.)
- IF(.NOT.ESKIP) THEN
- IF( K.GT.1) THEN
- WGAP( WINDMN ) = MAX( WGAP(WINDMN),
- $ W(WINDEX)-WERR(WINDEX)
- $ - W(WINDMN)-WERR(WINDMN) )
- ENDIF
- IF( WINDEX.LT.WEND ) THEN
- WGAP( WINDEX ) = MAX( SAVGAP,
- $ W( WINDPL )-WERR( WINDPL )
- $ - W( WINDEX )-WERR( WINDEX) )
- ENDIF
- ENDIF
- IDONE = IDONE + 1
- ENDIF
-* here ends the code for the current child
-*
- 139 CONTINUE
-* Proceed to any remaining child nodes
- NEWFST = J + 1
- 140 CONTINUE
- 150 CONTINUE
- NDEPTH = NDEPTH + 1
- GO TO 40
- END IF
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- 170 CONTINUE
-*
-
- RETURN
-*
-* End of SLARRV
-*
- END
diff --git a/netlib/LAPACK/slarscl2.f b/netlib/LAPACK/slarscl2.f
deleted file mode 100644
index 83a32fe..0000000
--- a/netlib/LAPACK/slarscl2.f
+++ /dev/null
@@ -1,119 +0,0 @@
-*> \brief \b SLARSCL2 performs reciprocal diagonal scaling on a vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARSCL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarscl2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarscl2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarscl2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARSCL2 ( M, N, D, X, LDX )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
-* REAL D( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARSCL2 performs a reciprocal diagonal scaling on an vector:
-*> x <-- inv(D) * x
-*> where the diagonal matrix D is stored as a vector.
-*>
-*> Eventually to be replaced by BLAS_sge_diag_scale in the new BLAS
-*> standard.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of D and X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of D and X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, length M
-*> Diagonal matrix D, stored as a vector of length M.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,N)
-*> On entry, the vector X to be scaled by D.
-*> On exit, the scaled vector.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the vector X. LDX >= 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLARSCL2 ( M, N, D, X, LDX )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
- REAL D( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
- DO J = 1, N
- DO I = 1, M
- X( I, J ) = X( I, J ) / D( I )
- END DO
- END DO
-
- RETURN
- END
diff --git a/netlib/LAPACK/slartg.f b/netlib/LAPACK/slartg.f
deleted file mode 100644
index fd7d9dd..0000000
--- a/netlib/LAPACK/slartg.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b SLARTG generates a plane rotation with real cosine and real sine.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARTG + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slartg.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slartg.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slartg.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARTG( F, G, CS, SN, R )
-*
-* .. Scalar Arguments ..
-* REAL CS, F, G, R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARTG generate a plane rotation so that
-*>
-*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
-*> [ -SN CS ] [ G ] [ 0 ]
-*>
-*> This is a slower, more accurate version of the BLAS1 routine SROTG,
-*> with the following other differences:
-*> F and G are unchanged on return.
-*> If G=0, then CS=1 and SN=0.
-*> If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
-*> floating point operations (saves work in SBDSQR when
-*> there are zeros on the diagonal).
-*>
-*> If F exceeds G in magnitude, CS will be positive.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is REAL
-*> The first component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is REAL
-*> The second component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is REAL
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is REAL
-*> The sine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL
-*> The nonzero component of the rotated vector.
-*>
-*> This version has a few statements commented out for thread safety
-*> (machine parameters are computed on each entry). 10 feb 03, SJH.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARTG( F, G, CS, SN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL CS, F, G, R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
-* LOGICAL FIRST
- INTEGER COUNT, I
- REAL EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, SQRT
-* ..
-* .. Save statement ..
-* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
-* ..
-* .. Data statements ..
-* DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* IF( FIRST ) THEN
- SAFMIN = SLAMCH( 'S' )
- EPS = SLAMCH( 'E' )
- SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
- $ LOG( SLAMCH( 'B' ) ) / TWO )
- SAFMX2 = ONE / SAFMN2
-* FIRST = .FALSE.
-* END IF
- IF( G.EQ.ZERO ) THEN
- CS = ONE
- SN = ZERO
- R = F
- ELSE IF( F.EQ.ZERO ) THEN
- CS = ZERO
- SN = ONE
- R = G
- ELSE
- F1 = F
- G1 = G
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 ) THEN
- COUNT = 0
- 10 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMN2
- G1 = G1*SAFMN2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 )
- $ GO TO 10
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 20 I = 1, COUNT
- R = R*SAFMX2
- 20 CONTINUE
- ELSE IF( SCALE.LE.SAFMN2 ) THEN
- COUNT = 0
- 30 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMX2
- G1 = G1*SAFMX2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.LE.SAFMN2 )
- $ GO TO 30
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 40 I = 1, COUNT
- R = R*SAFMN2
- 40 CONTINUE
- ELSE
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- END IF
- IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
- CS = -CS
- SN = -SN
- R = -R
- END IF
- END IF
- RETURN
-*
-* End of SLARTG
-*
- END
diff --git a/netlib/LAPACK/slartgp.f b/netlib/LAPACK/slartgp.f
deleted file mode 100644
index bd518bc..0000000
--- a/netlib/LAPACK/slartgp.f
+++ /dev/null
@@ -1,202 +0,0 @@
-*> \brief \b SLARTGP generates a plane rotation so that the diagonal is nonnegative.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARTGP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slartgp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slartgp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slartgp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARTGP( F, G, CS, SN, R )
-*
-* .. Scalar Arguments ..
-* REAL CS, F, G, R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARTGP generates a plane rotation so that
-*>
-*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
-*> [ -SN CS ] [ G ] [ 0 ]
-*>
-*> This is a slower, more accurate version of the Level 1 BLAS routine SROTG,
-*> with the following other differences:
-*> F and G are unchanged on return.
-*> If G=0, then CS=(+/-)1 and SN=0.
-*> If F=0 and (G .ne. 0), then CS=0 and SN=(+/-)1.
-*>
-*> The sign is chosen so that R >= 0.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is REAL
-*> The first component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is REAL
-*> The second component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is REAL
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is REAL
-*> The sine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL
-*> The nonzero component of the rotated vector.
-*>
-*> This version has a few statements commented out for thread safety
-*> (machine parameters are computed on each entry). 10 feb 03, SJH.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARTGP( F, G, CS, SN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL CS, F, G, R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
-* LOGICAL FIRST
- INTEGER COUNT, I
- REAL EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, SIGN, SQRT
-* ..
-* .. Save statement ..
-* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
-* ..
-* .. Data statements ..
-* DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* IF( FIRST ) THEN
- SAFMIN = SLAMCH( 'S' )
- EPS = SLAMCH( 'E' )
- SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
- $ LOG( SLAMCH( 'B' ) ) / TWO )
- SAFMX2 = ONE / SAFMN2
-* FIRST = .FALSE.
-* END IF
- IF( G.EQ.ZERO ) THEN
- CS = SIGN( ONE, F )
- SN = ZERO
- R = ABS( F )
- ELSE IF( F.EQ.ZERO ) THEN
- CS = ZERO
- SN = SIGN( ONE, G )
- R = ABS( G )
- ELSE
- F1 = F
- G1 = G
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 ) THEN
- COUNT = 0
- 10 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMN2
- G1 = G1*SAFMN2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 )
- $ GO TO 10
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 20 I = 1, COUNT
- R = R*SAFMX2
- 20 CONTINUE
- ELSE IF( SCALE.LE.SAFMN2 ) THEN
- COUNT = 0
- 30 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMX2
- G1 = G1*SAFMX2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.LE.SAFMN2 )
- $ GO TO 30
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 40 I = 1, COUNT
- R = R*SAFMN2
- 40 CONTINUE
- ELSE
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- END IF
- IF( R.LT.ZERO ) THEN
- CS = -CS
- SN = -SN
- R = -R
- END IF
- END IF
- RETURN
-*
-* End of SLARTG
-*
- END
diff --git a/netlib/LAPACK/slartgs.f b/netlib/LAPACK/slartgs.f
deleted file mode 100644
index 2d39413..0000000
--- a/netlib/LAPACK/slartgs.f
+++ /dev/null
@@ -1,158 +0,0 @@
-*> \brief \b SLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARTGS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slartgs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slartgs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slartgs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN )
-*
-* .. Scalar Arguments ..
-* REAL CS, SIGMA, SN, X, Y
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARTGS generates a plane rotation designed to introduce a bulge in
-*> Golub-Reinsch-style implicit QR iteration for the bidiagonal SVD
-*> problem. X and Y are the top-row entries, and SIGMA is the shift.
-*> The computed CS and SN define a plane rotation satisfying
-*>
-*> [ CS SN ] . [ X^2 - SIGMA ] = [ R ],
-*> [ -SN CS ] [ X * Y ] [ 0 ]
-*>
-*> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the
-*> rotation is by PI/2.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is REAL
-*> The (1,1) entry of an upper bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is REAL
-*> The (1,2) entry of an upper bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] SIGMA
-*> \verbatim
-*> SIGMA is REAL
-*> The shift.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is REAL
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is REAL
-*> The sine of the rotation.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL CS, SIGMA, SN, X, Y
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- REAL NEGONE, ONE, ZERO
- PARAMETER ( NEGONE = -1.0E0, ONE = 1.0E0, ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- REAL R, S, THRESH, W, Z
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* .. Executable Statements ..
-*
- THRESH = SLAMCH('E')
-*
-* Compute the first column of B**T*B - SIGMA^2*I, up to a scale
-* factor.
-*
- IF( (SIGMA .EQ. ZERO .AND. ABS(X) .LT. THRESH) .OR.
- $ (ABS(X) .EQ. SIGMA .AND. Y .EQ. ZERO) ) THEN
- Z = ZERO
- W = ZERO
- ELSE IF( SIGMA .EQ. ZERO ) THEN
- IF( X .GE. ZERO ) THEN
- Z = X
- W = Y
- ELSE
- Z = -X
- W = -Y
- END IF
- ELSE IF( ABS(X) .LT. THRESH ) THEN
- Z = -SIGMA*SIGMA
- W = ZERO
- ELSE
- IF( X .GE. ZERO ) THEN
- S = ONE
- ELSE
- S = NEGONE
- END IF
- Z = S * (ABS(X)-SIGMA) * (S+SIGMA/X)
- W = S * Y
- END IF
-*
-* Generate the rotation.
-* CALL SLARTGP( Z, W, CS, SN, R ) might seem more natural;
-* reordering the arguments ensures that if Z = 0 then the rotation
-* is by PI/2.
-*
- CALL SLARTGP( W, Z, SN, CS, R )
-*
- RETURN
-*
-* End SLARTGS
-*
- END
-
diff --git a/netlib/LAPACK/slartv.f b/netlib/LAPACK/slartv.f
deleted file mode 100644
index 5d3187e..0000000
--- a/netlib/LAPACK/slartv.f
+++ /dev/null
@@ -1,147 +0,0 @@
-*> \brief \b SLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair of vectors.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARTV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slartv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slartv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slartv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARTV( N, X, INCX, Y, INCY, C, S, INCC )
-*
-* .. Scalar Arguments ..
-* INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
-* REAL C( * ), S( * ), X( * ), Y( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARTV applies a vector of real plane rotations to elements of the
-*> real vectors x and y. For i = 1,2,...,n
-*>
-*> ( x(i) ) := ( c(i) s(i) ) ( x(i) )
-*> ( y(i) ) ( -s(i) c(i) ) ( y(i) )
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of plane rotations to be applied.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array,
-*> dimension (1+(N-1)*INCX)
-*> The vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is REAL array,
-*> dimension (1+(N-1)*INCY)
-*> The vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> The increment between elements of Y. INCY > 0.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension (1+(N-1)*INCC)
-*> The cosines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension (1+(N-1)*INCC)
-*> The sines of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] INCC
-*> \verbatim
-*> INCC is INTEGER
-*> The increment between elements of C and S. INCC > 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLARTV( N, X, INCX, Y, INCY, C, S, INCC )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCC, INCX, INCY, N
-* ..
-* .. Array Arguments ..
- REAL C( * ), S( * ), X( * ), Y( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IC, IX, IY
- REAL XI, YI
-* ..
-* .. Executable Statements ..
-*
- IX = 1
- IY = 1
- IC = 1
- DO 10 I = 1, N
- XI = X( IX )
- YI = Y( IY )
- X( IX ) = C( IC )*XI + S( IC )*YI
- Y( IY ) = C( IC )*YI - S( IC )*XI
- IX = IX + INCX
- IY = IY + INCY
- IC = IC + INCC
- 10 CONTINUE
- RETURN
-*
-* End of SLARTV
-*
- END
diff --git a/netlib/LAPACK/slaruv.f b/netlib/LAPACK/slaruv.f
deleted file mode 100644
index 97cae10..0000000
--- a/netlib/LAPACK/slaruv.f
+++ /dev/null
@@ -1,447 +0,0 @@
-*> \brief \b SLARUV returns a vector of n random real numbers from a uniform distribution.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARUV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaruv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaruv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaruv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARUV( ISEED, N, X )
-*
-* .. Scalar Arguments ..
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL X( N )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARUV returns a vector of n random real numbers from a uniform (0,1)
-*> distribution (n <= 128).
-*>
-*> This is an auxiliary routine called by SLARNV and CLARNV.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry, the seed of the random number generator; the array
-*> elements must be between 0 and 4095, and ISEED(4) must be
-*> odd.
-*> On exit, the seed is updated.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of random numbers to be generated. N <= 128.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> The generated random numbers.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> This routine uses a multiplicative congruential method with modulus
-*> 2**48 and multiplier 33952834046453 (see G.S.Fishman,
-*> 'Multiplicative congruential random number generators with modulus
-*> 2**b: an exhaustive analysis for b = 32 and a partial analysis for
-*> b = 48', Math. Comp. 189, pp 331-344, 1990).
-*>
-*> 48-bit integers are stored in 4 integer array elements with 12 bits
-*> per element. Hence the routine is portable across machines with
-*> integers of 32 bits or more.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLARUV( ISEED, N, X )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER N
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL X( N )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- INTEGER LV, IPW2
- REAL R
- PARAMETER ( LV = 128, IPW2 = 4096, R = ONE / IPW2 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, I2, I3, I4, IT1, IT2, IT3, IT4, J
-* ..
-* .. Local Arrays ..
- INTEGER MM( LV, 4 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN, MOD, REAL
-* ..
-* .. Data statements ..
- DATA ( MM( 1, J ), J = 1, 4 ) / 494, 322, 2508,
- $ 2549 /
- DATA ( MM( 2, J ), J = 1, 4 ) / 2637, 789, 3754,
- $ 1145 /
- DATA ( MM( 3, J ), J = 1, 4 ) / 255, 1440, 1766,
- $ 2253 /
- DATA ( MM( 4, J ), J = 1, 4 ) / 2008, 752, 3572,
- $ 305 /
- DATA ( MM( 5, J ), J = 1, 4 ) / 1253, 2859, 2893,
- $ 3301 /
- DATA ( MM( 6, J ), J = 1, 4 ) / 3344, 123, 307,
- $ 1065 /
- DATA ( MM( 7, J ), J = 1, 4 ) / 4084, 1848, 1297,
- $ 3133 /
- DATA ( MM( 8, J ), J = 1, 4 ) / 1739, 643, 3966,
- $ 2913 /
- DATA ( MM( 9, J ), J = 1, 4 ) / 3143, 2405, 758,
- $ 3285 /
- DATA ( MM( 10, J ), J = 1, 4 ) / 3468, 2638, 2598,
- $ 1241 /
- DATA ( MM( 11, J ), J = 1, 4 ) / 688, 2344, 3406,
- $ 1197 /
- DATA ( MM( 12, J ), J = 1, 4 ) / 1657, 46, 2922,
- $ 3729 /
- DATA ( MM( 13, J ), J = 1, 4 ) / 1238, 3814, 1038,
- $ 2501 /
- DATA ( MM( 14, J ), J = 1, 4 ) / 3166, 913, 2934,
- $ 1673 /
- DATA ( MM( 15, J ), J = 1, 4 ) / 1292, 3649, 2091,
- $ 541 /
- DATA ( MM( 16, J ), J = 1, 4 ) / 3422, 339, 2451,
- $ 2753 /
- DATA ( MM( 17, J ), J = 1, 4 ) / 1270, 3808, 1580,
- $ 949 /
- DATA ( MM( 18, J ), J = 1, 4 ) / 2016, 822, 1958,
- $ 2361 /
- DATA ( MM( 19, J ), J = 1, 4 ) / 154, 2832, 2055,
- $ 1165 /
- DATA ( MM( 20, J ), J = 1, 4 ) / 2862, 3078, 1507,
- $ 4081 /
- DATA ( MM( 21, J ), J = 1, 4 ) / 697, 3633, 1078,
- $ 2725 /
- DATA ( MM( 22, J ), J = 1, 4 ) / 1706, 2970, 3273,
- $ 3305 /
- DATA ( MM( 23, J ), J = 1, 4 ) / 491, 637, 17,
- $ 3069 /
- DATA ( MM( 24, J ), J = 1, 4 ) / 931, 2249, 854,
- $ 3617 /
- DATA ( MM( 25, J ), J = 1, 4 ) / 1444, 2081, 2916,
- $ 3733 /
- DATA ( MM( 26, J ), J = 1, 4 ) / 444, 4019, 3971,
- $ 409 /
- DATA ( MM( 27, J ), J = 1, 4 ) / 3577, 1478, 2889,
- $ 2157 /
- DATA ( MM( 28, J ), J = 1, 4 ) / 3944, 242, 3831,
- $ 1361 /
- DATA ( MM( 29, J ), J = 1, 4 ) / 2184, 481, 2621,
- $ 3973 /
- DATA ( MM( 30, J ), J = 1, 4 ) / 1661, 2075, 1541,
- $ 1865 /
- DATA ( MM( 31, J ), J = 1, 4 ) / 3482, 4058, 893,
- $ 2525 /
- DATA ( MM( 32, J ), J = 1, 4 ) / 657, 622, 736,
- $ 1409 /
- DATA ( MM( 33, J ), J = 1, 4 ) / 3023, 3376, 3992,
- $ 3445 /
- DATA ( MM( 34, J ), J = 1, 4 ) / 3618, 812, 787,
- $ 3577 /
- DATA ( MM( 35, J ), J = 1, 4 ) / 1267, 234, 2125,
- $ 77 /
- DATA ( MM( 36, J ), J = 1, 4 ) / 1828, 641, 2364,
- $ 3761 /
- DATA ( MM( 37, J ), J = 1, 4 ) / 164, 4005, 2460,
- $ 2149 /
- DATA ( MM( 38, J ), J = 1, 4 ) / 3798, 1122, 257,
- $ 1449 /
- DATA ( MM( 39, J ), J = 1, 4 ) / 3087, 3135, 1574,
- $ 3005 /
- DATA ( MM( 40, J ), J = 1, 4 ) / 2400, 2640, 3912,
- $ 225 /
- DATA ( MM( 41, J ), J = 1, 4 ) / 2870, 2302, 1216,
- $ 85 /
- DATA ( MM( 42, J ), J = 1, 4 ) / 3876, 40, 3248,
- $ 3673 /
- DATA ( MM( 43, J ), J = 1, 4 ) / 1905, 1832, 3401,
- $ 3117 /
- DATA ( MM( 44, J ), J = 1, 4 ) / 1593, 2247, 2124,
- $ 3089 /
- DATA ( MM( 45, J ), J = 1, 4 ) / 1797, 2034, 2762,
- $ 1349 /
- DATA ( MM( 46, J ), J = 1, 4 ) / 1234, 2637, 149,
- $ 2057 /
- DATA ( MM( 47, J ), J = 1, 4 ) / 3460, 1287, 2245,
- $ 413 /
- DATA ( MM( 48, J ), J = 1, 4 ) / 328, 1691, 166,
- $ 65 /
- DATA ( MM( 49, J ), J = 1, 4 ) / 2861, 496, 466,
- $ 1845 /
- DATA ( MM( 50, J ), J = 1, 4 ) / 1950, 1597, 4018,
- $ 697 /
- DATA ( MM( 51, J ), J = 1, 4 ) / 617, 2394, 1399,
- $ 3085 /
- DATA ( MM( 52, J ), J = 1, 4 ) / 2070, 2584, 190,
- $ 3441 /
- DATA ( MM( 53, J ), J = 1, 4 ) / 3331, 1843, 2879,
- $ 1573 /
- DATA ( MM( 54, J ), J = 1, 4 ) / 769, 336, 153,
- $ 3689 /
- DATA ( MM( 55, J ), J = 1, 4 ) / 1558, 1472, 2320,
- $ 2941 /
- DATA ( MM( 56, J ), J = 1, 4 ) / 2412, 2407, 18,
- $ 929 /
- DATA ( MM( 57, J ), J = 1, 4 ) / 2800, 433, 712,
- $ 533 /
- DATA ( MM( 58, J ), J = 1, 4 ) / 189, 2096, 2159,
- $ 2841 /
- DATA ( MM( 59, J ), J = 1, 4 ) / 287, 1761, 2318,
- $ 4077 /
- DATA ( MM( 60, J ), J = 1, 4 ) / 2045, 2810, 2091,
- $ 721 /
- DATA ( MM( 61, J ), J = 1, 4 ) / 1227, 566, 3443,
- $ 2821 /
- DATA ( MM( 62, J ), J = 1, 4 ) / 2838, 442, 1510,
- $ 2249 /
- DATA ( MM( 63, J ), J = 1, 4 ) / 209, 41, 449,
- $ 2397 /
- DATA ( MM( 64, J ), J = 1, 4 ) / 2770, 1238, 1956,
- $ 2817 /
- DATA ( MM( 65, J ), J = 1, 4 ) / 3654, 1086, 2201,
- $ 245 /
- DATA ( MM( 66, J ), J = 1, 4 ) / 3993, 603, 3137,
- $ 1913 /
- DATA ( MM( 67, J ), J = 1, 4 ) / 192, 840, 3399,
- $ 1997 /
- DATA ( MM( 68, J ), J = 1, 4 ) / 2253, 3168, 1321,
- $ 3121 /
- DATA ( MM( 69, J ), J = 1, 4 ) / 3491, 1499, 2271,
- $ 997 /
- DATA ( MM( 70, J ), J = 1, 4 ) / 2889, 1084, 3667,
- $ 1833 /
- DATA ( MM( 71, J ), J = 1, 4 ) / 2857, 3438, 2703,
- $ 2877 /
- DATA ( MM( 72, J ), J = 1, 4 ) / 2094, 2408, 629,
- $ 1633 /
- DATA ( MM( 73, J ), J = 1, 4 ) / 1818, 1589, 2365,
- $ 981 /
- DATA ( MM( 74, J ), J = 1, 4 ) / 688, 2391, 2431,
- $ 2009 /
- DATA ( MM( 75, J ), J = 1, 4 ) / 1407, 288, 1113,
- $ 941 /
- DATA ( MM( 76, J ), J = 1, 4 ) / 634, 26, 3922,
- $ 2449 /
- DATA ( MM( 77, J ), J = 1, 4 ) / 3231, 512, 2554,
- $ 197 /
- DATA ( MM( 78, J ), J = 1, 4 ) / 815, 1456, 184,
- $ 2441 /
- DATA ( MM( 79, J ), J = 1, 4 ) / 3524, 171, 2099,
- $ 285 /
- DATA ( MM( 80, J ), J = 1, 4 ) / 1914, 1677, 3228,
- $ 1473 /
- DATA ( MM( 81, J ), J = 1, 4 ) / 516, 2657, 4012,
- $ 2741 /
- DATA ( MM( 82, J ), J = 1, 4 ) / 164, 2270, 1921,
- $ 3129 /
- DATA ( MM( 83, J ), J = 1, 4 ) / 303, 2587, 3452,
- $ 909 /
- DATA ( MM( 84, J ), J = 1, 4 ) / 2144, 2961, 3901,
- $ 2801 /
- DATA ( MM( 85, J ), J = 1, 4 ) / 3480, 1970, 572,
- $ 421 /
- DATA ( MM( 86, J ), J = 1, 4 ) / 119, 1817, 3309,
- $ 4073 /
- DATA ( MM( 87, J ), J = 1, 4 ) / 3357, 676, 3171,
- $ 2813 /
- DATA ( MM( 88, J ), J = 1, 4 ) / 837, 1410, 817,
- $ 2337 /
- DATA ( MM( 89, J ), J = 1, 4 ) / 2826, 3723, 3039,
- $ 1429 /
- DATA ( MM( 90, J ), J = 1, 4 ) / 2332, 2803, 1696,
- $ 1177 /
- DATA ( MM( 91, J ), J = 1, 4 ) / 2089, 3185, 1256,
- $ 1901 /
- DATA ( MM( 92, J ), J = 1, 4 ) / 3780, 184, 3715,
- $ 81 /
- DATA ( MM( 93, J ), J = 1, 4 ) / 1700, 663, 2077,
- $ 1669 /
- DATA ( MM( 94, J ), J = 1, 4 ) / 3712, 499, 3019,
- $ 2633 /
- DATA ( MM( 95, J ), J = 1, 4 ) / 150, 3784, 1497,
- $ 2269 /
- DATA ( MM( 96, J ), J = 1, 4 ) / 2000, 1631, 1101,
- $ 129 /
- DATA ( MM( 97, J ), J = 1, 4 ) / 3375, 1925, 717,
- $ 1141 /
- DATA ( MM( 98, J ), J = 1, 4 ) / 1621, 3912, 51,
- $ 249 /
- DATA ( MM( 99, J ), J = 1, 4 ) / 3090, 1398, 981,
- $ 3917 /
- DATA ( MM( 100, J ), J = 1, 4 ) / 3765, 1349, 1978,
- $ 2481 /
- DATA ( MM( 101, J ), J = 1, 4 ) / 1149, 1441, 1813,
- $ 3941 /
- DATA ( MM( 102, J ), J = 1, 4 ) / 3146, 2224, 3881,
- $ 2217 /
- DATA ( MM( 103, J ), J = 1, 4 ) / 33, 2411, 76,
- $ 2749 /
- DATA ( MM( 104, J ), J = 1, 4 ) / 3082, 1907, 3846,
- $ 3041 /
- DATA ( MM( 105, J ), J = 1, 4 ) / 2741, 3192, 3694,
- $ 1877 /
- DATA ( MM( 106, J ), J = 1, 4 ) / 359, 2786, 1682,
- $ 345 /
- DATA ( MM( 107, J ), J = 1, 4 ) / 3316, 382, 124,
- $ 2861 /
- DATA ( MM( 108, J ), J = 1, 4 ) / 1749, 37, 1660,
- $ 1809 /
- DATA ( MM( 109, J ), J = 1, 4 ) / 185, 759, 3997,
- $ 3141 /
- DATA ( MM( 110, J ), J = 1, 4 ) / 2784, 2948, 479,
- $ 2825 /
- DATA ( MM( 111, J ), J = 1, 4 ) / 2202, 1862, 1141,
- $ 157 /
- DATA ( MM( 112, J ), J = 1, 4 ) / 2199, 3802, 886,
- $ 2881 /
- DATA ( MM( 113, J ), J = 1, 4 ) / 1364, 2423, 3514,
- $ 3637 /
- DATA ( MM( 114, J ), J = 1, 4 ) / 1244, 2051, 1301,
- $ 1465 /
- DATA ( MM( 115, J ), J = 1, 4 ) / 2020, 2295, 3604,
- $ 2829 /
- DATA ( MM( 116, J ), J = 1, 4 ) / 3160, 1332, 1888,
- $ 2161 /
- DATA ( MM( 117, J ), J = 1, 4 ) / 2785, 1832, 1836,
- $ 3365 /
- DATA ( MM( 118, J ), J = 1, 4 ) / 2772, 2405, 1990,
- $ 361 /
- DATA ( MM( 119, J ), J = 1, 4 ) / 1217, 3638, 2058,
- $ 2685 /
- DATA ( MM( 120, J ), J = 1, 4 ) / 1822, 3661, 692,
- $ 3745 /
- DATA ( MM( 121, J ), J = 1, 4 ) / 1245, 327, 1194,
- $ 2325 /
- DATA ( MM( 122, J ), J = 1, 4 ) / 2252, 3660, 20,
- $ 3609 /
- DATA ( MM( 123, J ), J = 1, 4 ) / 3904, 716, 3285,
- $ 3821 /
- DATA ( MM( 124, J ), J = 1, 4 ) / 2774, 1842, 2046,
- $ 3537 /
- DATA ( MM( 125, J ), J = 1, 4 ) / 997, 3987, 2107,
- $ 517 /
- DATA ( MM( 126, J ), J = 1, 4 ) / 2573, 1368, 3508,
- $ 3017 /
- DATA ( MM( 127, J ), J = 1, 4 ) / 1148, 1848, 3525,
- $ 2141 /
- DATA ( MM( 128, J ), J = 1, 4 ) / 545, 2366, 3801,
- $ 1537 /
-* ..
-* .. Executable Statements ..
-*
- I1 = ISEED( 1 )
- I2 = ISEED( 2 )
- I3 = ISEED( 3 )
- I4 = ISEED( 4 )
-*
- DO 10 I = 1, MIN( N, LV )
-*
- 20 CONTINUE
-*
-* Multiply the seed by i-th power of the multiplier modulo 2**48
-*
- IT4 = I4*MM( I, 4 )
- IT3 = IT4 / IPW2
- IT4 = IT4 - IPW2*IT3
- IT3 = IT3 + I3*MM( I, 4 ) + I4*MM( I, 3 )
- IT2 = IT3 / IPW2
- IT3 = IT3 - IPW2*IT2
- IT2 = IT2 + I2*MM( I, 4 ) + I3*MM( I, 3 ) + I4*MM( I, 2 )
- IT1 = IT2 / IPW2
- IT2 = IT2 - IPW2*IT1
- IT1 = IT1 + I1*MM( I, 4 ) + I2*MM( I, 3 ) + I3*MM( I, 2 ) +
- $ I4*MM( I, 1 )
- IT1 = MOD( IT1, IPW2 )
-*
-* Convert 48-bit integer to a real number in the interval (0,1)
-*
- X( I ) = R*( REAL( IT1 )+R*( REAL( IT2 )+R*( REAL( IT3 )+R*
- $ REAL( IT4 ) ) ) )
-*
- IF (X( I ).EQ.1.0) THEN
-* If a real number has n bits of precision, and the first
-* n bits of the 48-bit integer above happen to be all 1 (which
-* will occur about once every 2**n calls), then X( I ) will
-* be rounded to exactly 1.0. In IEEE single precision arithmetic,
-* this will happen relatively often since n = 24.
-* Since X( I ) is not supposed to return exactly 0.0 or 1.0,
-* the statistically correct thing to do in this situation is
-* simply to iterate again.
-* N.B. the case X( I ) = 0.0 should not be possible.
- I1 = I1 + 2
- I2 = I2 + 2
- I3 = I3 + 2
- I4 = I4 + 2
- GOTO 20
- END IF
-*
- 10 CONTINUE
-*
-* Return final value of seed
-*
- ISEED( 1 ) = IT1
- ISEED( 2 ) = IT2
- ISEED( 3 ) = IT3
- ISEED( 4 ) = IT4
- RETURN
-*
-* End of SLARUV
-*
- END
diff --git a/netlib/LAPACK/slarz.f b/netlib/LAPACK/slarz.f
deleted file mode 100644
index 3158a4c..0000000
--- a/netlib/LAPACK/slarz.f
+++ /dev/null
@@ -1,236 +0,0 @@
-*> \brief \b SLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, L, LDC, M, N
-* REAL TAU
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARZ applies a real elementary reflector H to a real M-by-N
-*> matrix C, from either the left or the right. H is represented in the
-*> form
-*>
-*> H = I - tau * v * v**T
-*>
-*> where tau is a real scalar and v is a real vector.
-*>
-*> If tau = 0, then H is taken to be the unit matrix.
-*>
-*>
-*> H is a product of k elementary reflectors as returned by STZRZF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of entries of the vector V containing
-*> the meaningful part of the Householder vectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension (1+(L-1)*abs(INCV))
-*> The vector v in the representation of H as returned by
-*> STZRZF. V is not used if TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, L, LDC, M, N
- REAL TAU
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C
-*
- IF( TAU.NE.ZERO ) THEN
-*
-* w( 1:n ) = C( 1, 1:n )
-*
- CALL SCOPY( N, C, LDC, WORK, 1 )
-*
-* w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )**T * v( 1:l )
-*
- CALL SGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V,
- $ INCV, ONE, WORK, 1 )
-*
-* C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
-*
- CALL SAXPY( N, -TAU, WORK, 1, C, LDC )
-*
-* C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-* tau * v( 1:l ) * w( 1:n )**T
-*
- CALL SGER( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
- $ LDC )
- END IF
-*
- ELSE
-*
-* Form C * H
-*
- IF( TAU.NE.ZERO ) THEN
-*
-* w( 1:m ) = C( 1:m, 1 )
-*
- CALL SCOPY( M, C, 1, WORK, 1 )
-*
-* w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
-*
- CALL SGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
- $ V, INCV, ONE, WORK, 1 )
-*
-* C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
-*
- CALL SAXPY( M, -TAU, WORK, 1, C, 1 )
-*
-* C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-* tau * w( 1:m ) * v( 1:l )**T
-*
- CALL SGER( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
- $ LDC )
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SLARZ
-*
- END
diff --git a/netlib/LAPACK/slarzb.f b/netlib/LAPACK/slarzb.f
deleted file mode 100644
index 9252f31..0000000
--- a/netlib/LAPACK/slarzb.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b SLARZB applies a block reflector or its transpose to a general matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARZB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarzb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarzb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarzb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
-* LDV, T, LDT, C, LDC, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, L, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), T( LDT, * ), V( LDV, * ),
-* $ WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLARZB applies a real block reflector H or its transpose H**T to
-*> a real distributed M-by-N C from the left or the right.
-*>
-*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H**T from the Left
-*> = 'R': apply H or H**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'C': apply H**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
-*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*> \endverbatim
-*>
-*> \param[in] STOREV
-*> \verbatim
-*> STOREV is CHARACTER*1
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columnwise (not supported yet)
-*> = 'R': Rowwise
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T (= the number of elementary
-*> reflectors whose product defines the block reflector).
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix V containing the
-*> meaningful part of the Householder reflectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,NV).
-*> If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,K)
-*> The triangular K-by-K matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LDWORK,K)
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= max(1,N);
-*> if SIDE = 'R', LDWORK >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
- $ LDV, T, LDT, C, LDC, WORK, LDWORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, L, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), T( LDT, * ), V( LDV, * ),
- $ WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST
- INTEGER I, INFO, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, STRMM, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
-* Check for currently supported options
-*
- INFO = 0
- IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLARZB', -INFO )
- RETURN
- END IF
-*
- IF( LSAME( TRANS, 'N' ) ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C
-*
-* W( 1:n, 1:k ) = C( 1:k, 1:n )**T
-*
- DO 10 J = 1, K
- CALL SCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 10 CONTINUE
-*
-* W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
-* C( m-l+1:m, 1:n )**T * V( 1:k, 1:l )**T
-*
- IF( L.GT.0 )
- $ CALL SGEMM( 'Transpose', 'Transpose', N, K, L, ONE,
- $ C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-* W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T or W( 1:m, 1:k ) * T
-*
- CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
- $ LDT, WORK, LDWORK )
-*
-* C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**T
-*
- DO 30 J = 1, N
- DO 20 I = 1, K
- C( I, J ) = C( I, J ) - WORK( J, I )
- 20 CONTINUE
- 30 CONTINUE
-*
-* C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-* V( 1:k, 1:l )**T * W( 1:n, 1:k )**T
-*
- IF( L.GT.0 )
- $ CALL SGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
- $ WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T
-*
-* W( 1:m, 1:k ) = C( 1:m, 1:k )
-*
- DO 40 J = 1, K
- CALL SCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
- 40 CONTINUE
-*
-* W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
-* C( 1:m, n-l+1:n ) * V( 1:k, 1:l )**T
-*
- IF( L.GT.0 )
- $ CALL SGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
- $ C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-* W( 1:m, 1:k ) = W( 1:m, 1:k ) * T or W( 1:m, 1:k ) * T**T
-*
- CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
- $ LDT, WORK, LDWORK )
-*
-* C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
-*
- DO 60 J = 1, K
- DO 50 I = 1, M
- C( I, J ) = C( I, J ) - WORK( I, J )
- 50 CONTINUE
- 60 CONTINUE
-*
-* C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-* W( 1:m, 1:k ) * V( 1:k, 1:l )
-*
- IF( L.GT.0 )
- $ CALL SGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
- $ WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
-*
- END IF
-*
- RETURN
-*
-* End of SLARZB
-*
- END
diff --git a/netlib/LAPACK/slarzt.f b/netlib/LAPACK/slarzt.f
deleted file mode 100644
index a8a1901..0000000
--- a/netlib/LAPACK/slarzt.f
+++ /dev/null
@@ -1,264 +0,0 @@
-*> \brief \b SLARZT forms the triangular factor T of a block reflector H = I - vtvH.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLARZT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarzt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarzt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarzt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLARZT( 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
-*>
-*> SLARZT 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
-*>
-*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*> \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, not supported yet)
-*> = '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 (not supported yet)
-*> = '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,out] 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.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \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; the corresponding
-*> array elements are modified but restored on exit. The rest of the
-*> array is not used.
-*>
-*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
-*>
-*> ______V_____
-*> ( v1 v2 v3 ) / \
-*> ( v1 v2 v3 ) ( v1 v1 v1 v1 v1 . . . . 1 )
-*> V = ( v1 v2 v3 ) ( v2 v2 v2 v2 v2 . . . 1 )
-*> ( v1 v2 v3 ) ( v3 v3 v3 v3 v3 . . 1 )
-*> ( v1 v2 v3 )
-*> . . .
-*> . . .
-*> 1 . .
-*> 1 .
-*> 1
-*>
-*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
-*>
-*> ______V_____
-*> 1 / \
-*> . 1 ( 1 . . . . v1 v1 v1 v1 v1 )
-*> . . 1 ( . 1 . . . v2 v2 v2 v2 v2 )
-*> . . . ( . . 1 . . v3 v3 v3 v3 v3 )
-*> . . .
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*> V = ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, STOREV
- INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
- REAL T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, STRMV, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Check for currently supported options
-*
- INFO = 0
- IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLARZT', -INFO )
- RETURN
- END IF
-*
- DO 20 I = K, 1, -1
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO 10 J = I, K
- T( J, I ) = ZERO
- 10 CONTINUE
- ELSE
-*
-* general case
-*
- IF( I.LT.K ) THEN
-*
-* T(i+1:k,i) = - tau(i) * V(i+1:k,1:n) * V(i,1:n)**T
-*
- CALL SGEMV( 'No transpose', K-I, N, -TAU( I ),
- $ V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
- $ T( I+1, I ), 1 )
-*
-* 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 )
- END IF
- T( I, I ) = TAU( I )
- END IF
- 20 CONTINUE
- RETURN
-*
-* End of SLARZT
-*
- END
diff --git a/netlib/LAPACK/slas2.f b/netlib/LAPACK/slas2.f
deleted file mode 100644
index 36431d5..0000000
--- a/netlib/LAPACK/slas2.f
+++ /dev/null
@@ -1,183 +0,0 @@
-*> \brief \b SLAS2 computes singular values of a 2-by-2 triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slas2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slas2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slas2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAS2( F, G, H, SSMIN, SSMAX )
-*
-* .. Scalar Arguments ..
-* REAL F, G, H, SSMAX, SSMIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAS2 computes the singular values of the 2-by-2 matrix
-*> [ F G ]
-*> [ 0 H ].
-*> On return, SSMIN is the smaller singular value and SSMAX is the
-*> larger singular value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is REAL
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is REAL
-*> The (1,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is REAL
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is REAL
-*> The smaller singular value.
-*> \endverbatim
-*>
-*> \param[out] SSMAX
-*> \verbatim
-*> SSMAX is REAL
-*> The larger singular value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Barring over/underflow, all output quantities are correct to within
-*> a few units in the last place (ulps), even in the absence of a guard
-*> digit in addition/subtraction.
-*>
-*> In IEEE arithmetic, the code works correctly if one matrix element is
-*> infinite.
-*>
-*> Overflow will not occur unless the largest singular value itself
-*> overflows, or is within a few ulps of overflow. (On machines with
-*> partial overflow, like the Cray, overflow may occur if the largest
-*> singular value is within a factor of 2 of overflow.)
-*>
-*> Underflow is harmless if underflow is gradual. Otherwise, results
-*> may correspond to a matrix modified by perturbations of size near
-*> the underflow threshold.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLAS2( F, G, H, SSMIN, SSMAX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL F, G, H, SSMAX, SSMIN
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
- REAL AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- FA = ABS( F )
- GA = ABS( G )
- HA = ABS( H )
- FHMN = MIN( FA, HA )
- FHMX = MAX( FA, HA )
- IF( FHMN.EQ.ZERO ) THEN
- SSMIN = ZERO
- IF( FHMX.EQ.ZERO ) THEN
- SSMAX = GA
- ELSE
- SSMAX = MAX( FHMX, GA )*SQRT( ONE+
- $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
- END IF
- ELSE
- IF( GA.LT.FHMX ) THEN
- AS = ONE + FHMN / FHMX
- AT = ( FHMX-FHMN ) / FHMX
- AU = ( GA / FHMX )**2
- C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
- SSMIN = FHMN*C
- SSMAX = FHMX / C
- ELSE
- AU = FHMX / GA
- IF( AU.EQ.ZERO ) THEN
-*
-* Avoid possible harmful underflow if exponent range
-* asymmetric (true SSMIN may not underflow even if
-* AU underflows)
-*
- SSMIN = ( FHMN*FHMX ) / GA
- SSMAX = GA
- ELSE
- AS = ONE + FHMN / FHMX
- AT = ( FHMX-FHMN ) / FHMX
- C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
- $ SQRT( ONE+( AT*AU )**2 ) )
- SSMIN = ( FHMN*C )*AU
- SSMIN = SSMIN + SSMIN
- SSMAX = GA / ( C+C )
- END IF
- END IF
- END IF
- RETURN
-*
-* End of SLAS2
-*
- END
diff --git a/netlib/LAPACK/slascl.f b/netlib/LAPACK/slascl.f
deleted file mode 100644
index bacf86e..0000000
--- a/netlib/LAPACK/slascl.f
+++ /dev/null
@@ -1,364 +0,0 @@
-*> \brief \b SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASCL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slascl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slascl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slascl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TYPE
-* INTEGER INFO, KL, KU, LDA, M, N
-* REAL CFROM, CTO
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASCL multiplies the M by N real matrix A by the real scalar
-*> CTO/CFROM. This is done without over/underflow as long as the final
-*> result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
-*> A may be full, upper triangular, lower triangular, upper Hessenberg,
-*> or banded.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TYPE
-*> \verbatim
-*> TYPE is CHARACTER*1
-*> TYPE indices the storage type of the input matrix.
-*> = 'G': A is a full matrix.
-*> = 'L': A is a lower triangular matrix.
-*> = 'U': A is an upper triangular matrix.
-*> = 'H': A is an upper Hessenberg matrix.
-*> = 'B': A is a symmetric band matrix with lower bandwidth KL
-*> and upper bandwidth KU and with the only the lower
-*> half stored.
-*> = 'Q': A is a symmetric band matrix with lower bandwidth KL
-*> and upper bandwidth KU and with the only the upper
-*> half stored.
-*> = 'Z': A is a band matrix with lower bandwidth KL and upper
-*> bandwidth KU. See SGBTRF for storage details.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The lower bandwidth of A. Referenced only if TYPE = 'B',
-*> 'Q' or 'Z'.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The upper bandwidth of A. Referenced only if TYPE = 'B',
-*> 'Q' or 'Z'.
-*> \endverbatim
-*>
-*> \param[in] CFROM
-*> \verbatim
-*> CFROM is REAL
-*> \endverbatim
-*>
-*> \param[in] CTO
-*> \verbatim
-*> CTO is REAL
-*>
-*> The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
-*> without over/underflow if the final result CTO*A(I,J)/CFROM
-*> can be represented without over/underflow. CFROM must be
-*> nonzero.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The matrix to be multiplied by CTO/CFROM. See TYPE for the
-*> storage type.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> 0 - successful exit
-*> <0 - if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TYPE
- INTEGER INFO, KL, KU, LDA, M, N
- REAL CFROM, CTO
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DONE
- INTEGER I, ITYPE, J, K1, K2, K3, K4
- REAL BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH, SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
-*
- IF( LSAME( TYPE, 'G' ) ) THEN
- ITYPE = 0
- ELSE IF( LSAME( TYPE, 'L' ) ) THEN
- ITYPE = 1
- ELSE IF( LSAME( TYPE, 'U' ) ) THEN
- ITYPE = 2
- ELSE IF( LSAME( TYPE, 'H' ) ) THEN
- ITYPE = 3
- ELSE IF( LSAME( TYPE, 'B' ) ) THEN
- ITYPE = 4
- ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
- ITYPE = 5
- ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
- ITYPE = 6
- ELSE
- ITYPE = -1
- END IF
-*
- IF( ITYPE.EQ.-1 ) THEN
- INFO = -1
- ELSE IF( CFROM.EQ.ZERO .OR. SISNAN(CFROM) ) THEN
- INFO = -4
- ELSE IF( SISNAN(CTO) ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -6
- ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
- $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
- INFO = -7
- ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
- INFO = -9
- ELSE IF( ITYPE.GE.4 ) THEN
- IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
- INFO = -2
- ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
- $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
- $ THEN
- INFO = -3
- ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
- $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
- $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
- INFO = -9
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASCL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 )
- $ RETURN
-*
-* Get machine parameters
-*
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
- CFROMC = CFROM
- CTOC = CTO
-*
- 10 CONTINUE
- CFROM1 = CFROMC*SMLNUM
- IF( CFROM1.EQ.CFROMC ) THEN
-! CFROMC is an inf. Multiply by a correctly signed zero for
-! finite CTOC, or a NaN if CTOC is infinite.
- MUL = CTOC / CFROMC
- DONE = .TRUE.
- CTO1 = CTOC
- ELSE
- CTO1 = CTOC / BIGNUM
- IF( CTO1.EQ.CTOC ) THEN
-! CTOC is either 0 or an inf. In both cases, CTOC itself
-! serves as the correct multiplication factor.
- MUL = CTOC
- DONE = .TRUE.
- CFROMC = ONE
- ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
- MUL = SMLNUM
- DONE = .FALSE.
- CFROMC = CFROM1
- ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
- MUL = BIGNUM
- DONE = .FALSE.
- CTOC = CTO1
- ELSE
- MUL = CTOC / CFROMC
- DONE = .TRUE.
- END IF
- END IF
-*
- IF( ITYPE.EQ.0 ) THEN
-*
-* Full matrix
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- A( I, J ) = A( I, J )*MUL
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE IF( ITYPE.EQ.1 ) THEN
-*
-* Lower triangular matrix
-*
- DO 50 J = 1, N
- DO 40 I = J, M
- A( I, J ) = A( I, J )*MUL
- 40 CONTINUE
- 50 CONTINUE
-*
- ELSE IF( ITYPE.EQ.2 ) THEN
-*
-* Upper triangular matrix
-*
- DO 70 J = 1, N
- DO 60 I = 1, MIN( J, M )
- A( I, J ) = A( I, J )*MUL
- 60 CONTINUE
- 70 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* Upper Hessenberg matrix
-*
- DO 90 J = 1, N
- DO 80 I = 1, MIN( J+1, M )
- A( I, J ) = A( I, J )*MUL
- 80 CONTINUE
- 90 CONTINUE
-*
- ELSE IF( ITYPE.EQ.4 ) THEN
-*
-* Lower half of a symmetric band matrix
-*
- K3 = KL + 1
- K4 = N + 1
- DO 110 J = 1, N
- DO 100 I = 1, MIN( K3, K4-J )
- A( I, J ) = A( I, J )*MUL
- 100 CONTINUE
- 110 CONTINUE
-*
- ELSE IF( ITYPE.EQ.5 ) THEN
-*
-* Upper half of a symmetric band matrix
-*
- K1 = KU + 2
- K3 = KU + 1
- DO 130 J = 1, N
- DO 120 I = MAX( K1-J, 1 ), K3
- A( I, J ) = A( I, J )*MUL
- 120 CONTINUE
- 130 CONTINUE
-*
- ELSE IF( ITYPE.EQ.6 ) THEN
-*
-* Band matrix
-*
- K1 = KL + KU + 2
- K2 = KL + 1
- K3 = 2*KL + KU + 1
- K4 = KL + KU + 1 + M
- DO 150 J = 1, N
- DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
- A( I, J ) = A( I, J )*MUL
- 140 CONTINUE
- 150 CONTINUE
-*
- END IF
-*
- IF( .NOT.DONE )
- $ GO TO 10
-*
- RETURN
-*
-* End of SLASCL
-*
- END
diff --git a/netlib/LAPACK/slascl2.f b/netlib/LAPACK/slascl2.f
deleted file mode 100644
index 5888247..0000000
--- a/netlib/LAPACK/slascl2.f
+++ /dev/null
@@ -1,119 +0,0 @@
-*> \brief \b SLASCL2 performs diagonal scaling on a vector.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASCL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slascl2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slascl2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slascl2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASCL2 ( M, N, D, X, LDX )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
-* REAL D( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASCL2 performs a diagonal scaling on a vector:
-*> x <-- D * x
-*> where the diagonal matrix D is stored as a vector.
-*>
-*> Eventually to be replaced by BLAS_sge_diag_scale in the new BLAS
-*> standard.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of D and X. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of D and X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, length M
-*> Diagonal matrix D, stored as a vector of length M.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,N)
-*> On entry, the vector X to be scaled by D.
-*> On exit, the scaled vector.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the vector X. LDX >= 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLASCL2 ( M, N, D, X, LDX )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDX
-* ..
-* .. Array Arguments ..
- REAL D( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
- DO J = 1, N
- DO I = 1, M
- X( I, J ) = X( I, J ) * D( I )
- END DO
- END DO
-
- RETURN
- END
diff --git a/netlib/LAPACK/slasd0.f b/netlib/LAPACK/slasd0.f
deleted file mode 100644
index b04a32d..0000000
--- a/netlib/LAPACK/slasd0.f
+++ /dev/null
@@ -1,313 +0,0 @@
-*> \brief \b SLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD0 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd0.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd0.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd0.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Using a divide and conquer approach, SLASD0 computes the singular
-*> value decomposition (SVD) of a real upper bidiagonal N-by-M
-*> matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
-*> The algorithm computes orthogonal matrices U and VT such that
-*> B = U * S * VT. The singular values S are overwritten on D.
-*>
-*> A related subroutine, SLASDA, computes only the singular values,
-*> and optionally, the singular vectors in compact form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, the row dimension of the upper bidiagonal matrix.
-*> This is also the dimension of the main diagonal array D.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> Specifies the column dimension of the bidiagonal matrix.
-*> = 0: The bidiagonal matrix has column dimension M = N;
-*> = 1: The bidiagonal matrix has column dimension M = N+1;
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry D contains the main diagonal of the bidiagonal
-*> matrix.
-*> On exit D, if INFO = 0, contains its singular values.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (M-1)
-*> Contains the subdiagonal entries of the bidiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension at least (LDQ, N)
-*> On exit, U contains the left singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> On entry, leading dimension of U.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is REAL array, dimension at least (LDVT, M)
-*> On exit, VT**T contains the right singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> On entry, leading dimension of VT.
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> On entry, maximum size of the subproblems at the
-*> bottom of the computation tree.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*M**2+2*M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
- $ WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, IC, IDXQ, IDXQC, IM1, INODE, ITEMP, IWK,
- $ J, LF, LL, LVL, M, NCC, ND, NDB1, NDIML, NDIMR,
- $ NL, NLF, NLP1, NLVL, NR, NRF, NRP1, SQREI
- REAL ALPHA, BETA
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASD1, SLASDQ, SLASDT, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -2
- END IF
-*
- M = N + SQRE
-*
- IF( LDU.LT.N ) THEN
- INFO = -6
- ELSE IF( LDVT.LT.M ) THEN
- INFO = -8
- ELSE IF( SMLSIZ.LT.3 ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD0', -INFO )
- RETURN
- END IF
-*
-* If the input matrix is too small, call SLASDQ to find the SVD.
-*
- IF( N.LE.SMLSIZ ) THEN
- CALL SLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDVT, U, LDU, U,
- $ LDU, WORK, INFO )
- RETURN
- END IF
-*
-* Set up the computation tree.
-*
- INODE = 1
- NDIML = INODE + N
- NDIMR = NDIML + N
- IDXQ = NDIMR + N
- IWK = IDXQ + N
- CALL SLASDT( N, NLVL, ND, IWORK( INODE ), IWORK( NDIML ),
- $ IWORK( NDIMR ), SMLSIZ )
-*
-* For the nodes on bottom level of the tree, solve
-* their subproblems by SLASDQ.
-*
- NDB1 = ( ND+1 ) / 2
- NCC = 0
- DO 30 I = NDB1, ND
-*
-* IC : center row of each node
-* NL : number of rows of left subproblem
-* NR : number of rows of right subproblem
-* NLF: starting row of the left subproblem
-* NRF: starting row of the right subproblem
-*
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NLP1 = NL + 1
- NR = IWORK( NDIMR+I1 )
- NRP1 = NR + 1
- NLF = IC - NL
- NRF = IC + 1
- SQREI = 1
- CALL SLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), E( NLF ),
- $ VT( NLF, NLF ), LDVT, U( NLF, NLF ), LDU,
- $ U( NLF, NLF ), LDU, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- ITEMP = IDXQ + NLF - 2
- DO 10 J = 1, NL
- IWORK( ITEMP+J ) = J
- 10 CONTINUE
- IF( I.EQ.ND ) THEN
- SQREI = SQRE
- ELSE
- SQREI = 1
- END IF
- NRP1 = NR + SQREI
- CALL SLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), E( NRF ),
- $ VT( NRF, NRF ), LDVT, U( NRF, NRF ), LDU,
- $ U( NRF, NRF ), LDU, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- ITEMP = IDXQ + IC
- DO 20 J = 1, NR
- IWORK( ITEMP+J-1 ) = J
- 20 CONTINUE
- 30 CONTINUE
-*
-* Now conquer each subproblem bottom-up.
-*
- DO 50 LVL = NLVL, 1, -1
-*
-* Find the first node LF and last node LL on the
-* current level LVL.
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 40 I = LF, LL
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- IF( ( SQRE.EQ.0 ) .AND. ( I.EQ.LL ) ) THEN
- SQREI = SQRE
- ELSE
- SQREI = 1
- END IF
- IDXQC = IDXQ + NLF - 1
- ALPHA = D( IC )
- BETA = E( IC )
- CALL SLASD1( NL, NR, SQREI, D( NLF ), ALPHA, BETA,
- $ U( NLF, NLF ), LDU, VT( NLF, NLF ), LDVT,
- $ IWORK( IDXQC ), IWORK( IWK ), WORK, INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of SLASD0
-*
- END
diff --git a/netlib/LAPACK/slasd1.f b/netlib/LAPACK/slasd1.f
deleted file mode 100644
index b076fca..0000000
--- a/netlib/LAPACK/slasd1.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b SLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT,
-* IDXQ, IWORK, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDU, LDVT, NL, NR, SQRE
-* REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* INTEGER IDXQ( * ), IWORK( * )
-* REAL D( * ), U( LDU, * ), VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
-*> where N = NL + NR + 1 and M = N + SQRE. SLASD1 is called from SLASD0.
-*>
-*> A related subroutine SLASD7 handles the case in which the singular
-*> values (and the singular vectors in factored form) are desired.
-*>
-*> SLASD1 computes the SVD as follows:
-*>
-*> ( D1(in) 0 0 0 )
-*> B = U(in) * ( Z1**T a Z2**T b ) * VT(in)
-*> ( 0 0 D2(in) 0 )
-*>
-*> = U(out) * ( D(out) 0) * VT(out)
-*>
-*> where Z**T = (Z1**T a Z2**T b) = u**T VT**T, and u is a vector of dimension M
-*> with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
-*> elsewhere; and the entry b is empty if SQRE = 0.
-*>
-*> The left singular vectors of the original matrix are stored in U, and
-*> the transpose of the right singular vectors are stored in VT, and the
-*> singular values are in D. The algorithm consists of three stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple singular values or when there are zeros in
-*> the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine SLASD2.
-*>
-*> The second stage consists of calculating the updated
-*> singular values. This is done by finding the square roots of the
-*> roots of the secular equation via the routine SLASD4 (as called
-*> by SLASD3). This routine also calculates the singular vectors of
-*> the current problem.
-*>
-*> The final stage consists of computing the updated singular vectors
-*> directly using the updated singular values. The singular vectors
-*> for the current problem are multiplied with the singular vectors
-*> from the overall problem.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has row dimension N = NL + NR + 1,
-*> and column dimension M = N + SQRE.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (NL+NR+1).
-*> N = NL+NR+1
-*> On entry D(1:NL,1:NL) contains the singular values of the
-*> upper block; and D(NL+2:N) contains the singular values of
-*> the lower block. On exit D(1:N) contains the singular values
-*> of the modified matrix.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in,out] BETA
-*> \verbatim
-*> BETA is REAL
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,N)
-*> On entry U(1:NL, 1:NL) contains the left singular vectors of
-*> the upper block; U(NL+2:N, NL+2:N) contains the left singular
-*> vectors of the lower block. On exit U contains the left
-*> singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max( 1, N ).
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT,M)
-*> where M = N + SQRE.
-*> On entry VT(1:NL+1, 1:NL+1)**T contains the right singular
-*> vectors of the upper block; VT(NL+2:M, NL+2:M)**T contains
-*> the right singular vectors of the lower block. On exit
-*> VT**T contains the right singular vectors of the
-*> bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= max( 1, M ).
-*> \endverbatim
-*>
-*> \param[out] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension (N)
-*> This contains the permutation which will reintegrate the
-*> subproblem just solved back into sorted order, i.e.
-*> D( IDXQ( I = 1, N ) ) will be in ascending order.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*M**2+2*M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT,
- $ IDXQ, IWORK, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDU, LDVT, NL, NR, SQRE
- REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
- INTEGER IDXQ( * ), IWORK( * )
- REAL D( * ), U( LDU, * ), VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER COLTYP, I, IDX, IDXC, IDXP, IQ, ISIGMA, IU2,
- $ IVT2, IZ, K, LDQ, LDU2, LDVT2, M, N, N1, N2
- REAL ORGNRM
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAMRG, SLASCL, SLASD2, SLASD3, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( NL.LT.1 ) THEN
- INFO = -1
- ELSE IF( NR.LT.1 ) THEN
- INFO = -2
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD1', -INFO )
- RETURN
- END IF
-*
- N = NL + NR + 1
- M = N + SQRE
-*
-* The following values are for bookkeeping purposes only. They are
-* integer pointers which indicate the portion of the workspace
-* used by a particular array in SLASD2 and SLASD3.
-*
- LDU2 = N
- LDVT2 = M
-*
- IZ = 1
- ISIGMA = IZ + M
- IU2 = ISIGMA + N
- IVT2 = IU2 + LDU2*N
- IQ = IVT2 + LDVT2*M
-*
- IDX = 1
- IDXC = IDX + N
- COLTYP = IDXC + N
- IDXP = COLTYP + N
-*
-* Scale.
-*
- ORGNRM = MAX( ABS( ALPHA ), ABS( BETA ) )
- D( NL+1 ) = ZERO
- DO 10 I = 1, N
- IF( ABS( D( I ) ).GT.ORGNRM ) THEN
- ORGNRM = ABS( D( I ) )
- END IF
- 10 CONTINUE
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, INFO )
- ALPHA = ALPHA / ORGNRM
- BETA = BETA / ORGNRM
-*
-* Deflate singular values.
-*
- CALL SLASD2( NL, NR, SQRE, K, D, WORK( IZ ), ALPHA, BETA, U, LDU,
- $ VT, LDVT, WORK( ISIGMA ), WORK( IU2 ), LDU2,
- $ WORK( IVT2 ), LDVT2, IWORK( IDXP ), IWORK( IDX ),
- $ IWORK( IDXC ), IDXQ, IWORK( COLTYP ), INFO )
-*
-* Solve Secular Equation and update singular vectors.
-*
- LDQ = K
- CALL SLASD3( NL, NR, SQRE, K, D, WORK( IQ ), LDQ, WORK( ISIGMA ),
- $ U, LDU, WORK( IU2 ), LDU2, VT, LDVT, WORK( IVT2 ),
- $ LDVT2, IWORK( IDXC ), IWORK( COLTYP ), WORK( IZ ),
- $ INFO )
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
-*
-* Unscale.
-*
- CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
-*
-* Prepare the IDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL SLAMRG( N1, N2, D, 1, -1, IDXQ )
-*
- RETURN
-*
-* End of SLASD1
-*
- END
diff --git a/netlib/LAPACK/slasd2.f b/netlib/LAPACK/slasd2.f
deleted file mode 100644
index 500eedb..0000000
--- a/netlib/LAPACK/slasd2.f
+++ /dev/null
@@ -1,634 +0,0 @@
-*> \brief \b SLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
-* LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
-* IDXC, IDXQ, COLTYP, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
-* REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* INTEGER COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ),
-* $ IDXQ( * )
-* REAL D( * ), DSIGMA( * ), U( LDU, * ),
-* $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
-* $ Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASD2 merges the two sets of singular values together into a single
-*> sorted set. Then it tries to deflate the size of the problem.
-*> There are two ways in which deflation can occur: when two or more
-*> singular values are close together or if there is a tiny entry in the
-*> Z vector. For each such occurrence the order of the related secular
-*> equation problem is reduced by one.
-*>
-*> SLASD2 is called from SLASD1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix,
-*> This is the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry D contains the singular values of the two submatrices
-*> to be combined. On exit D contains the trailing (N-K) updated
-*> singular values (those which were deflated) sorted into
-*> increasing order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (N)
-*> On exit Z contains the updating row vector in the secular
-*> equation.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,N)
-*> On entry U contains the left singular vectors of two
-*> submatrices in the two square blocks with corners at (1,1),
-*> (NL, NL), and (NL+2, NL+2), (N,N).
-*> On exit U contains the trailing (N-K) updated left singular
-*> vectors (those which were deflated) in its last N-K columns.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT,M)
-*> On entry VT**T contains the right singular vectors of two
-*> submatrices in the two square blocks with corners at (1,1),
-*> (NL+1, NL+1), and (NL+2, NL+2), (M,M).
-*> On exit VT**T contains the trailing (N-K) updated right singular
-*> vectors (those which were deflated) in its last N-K columns.
-*> In case SQRE =1, the last row of VT spans the right null
-*> space.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= M.
-*> \endverbatim
-*>
-*> \param[out] DSIGMA
-*> \verbatim
-*> DSIGMA is REAL array, dimension (N)
-*> Contains a copy of the diagonal elements (K-1 singular values
-*> and one zero) in the secular equation.
-*> \endverbatim
-*>
-*> \param[out] U2
-*> \verbatim
-*> U2 is REAL array, dimension (LDU2,N)
-*> Contains a copy of the first K-1 left singular vectors which
-*> will be used by SLASD3 in a matrix multiply (SGEMM) to solve
-*> for the new left singular vectors. U2 is arranged into four
-*> blocks. The first block contains a column with 1 at NL+1 and
-*> zero everywhere else; the second block contains non-zero
-*> entries only at and above NL; the third contains non-zero
-*> entries only below NL+1; and the fourth is dense.
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of the array U2. LDU2 >= N.
-*> \endverbatim
-*>
-*> \param[out] VT2
-*> \verbatim
-*> VT2 is REAL array, dimension (LDVT2,N)
-*> VT2**T contains a copy of the first K right singular vectors
-*> which will be used by SLASD3 in a matrix multiply (SGEMM) to
-*> solve for the new right singular vectors. VT2 is arranged into
-*> three blocks. The first block contains a row that corresponds
-*> to the special 0 diagonal element in SIGMA; the second block
-*> contains non-zeros only at and before NL +1; the third block
-*> contains non-zeros only at and after NL +2.
-*> \endverbatim
-*>
-*> \param[in] LDVT2
-*> \verbatim
-*> LDVT2 is INTEGER
-*> The leading dimension of the array VT2. LDVT2 >= M.
-*> \endverbatim
-*>
-*> \param[out] IDXP
-*> \verbatim
-*> IDXP is INTEGER array, dimension (N)
-*> This will contain the permutation used to place deflated
-*> values of D at the end of the array. On output IDXP(2:K)
-*> points to the nondeflated D-values and IDXP(K+1:N)
-*> points to the deflated singular values.
-*> \endverbatim
-*>
-*> \param[out] IDX
-*> \verbatim
-*> IDX is INTEGER array, dimension (N)
-*> This will contain the permutation used to sort the contents of
-*> D into ascending order.
-*> \endverbatim
-*>
-*> \param[out] IDXC
-*> \verbatim
-*> IDXC is INTEGER array, dimension (N)
-*> This will contain the permutation used to arrange the columns
-*> of the deflated U matrix into three groups: the first group
-*> contains non-zero entries only at and above NL, the second
-*> contains non-zero entries only below NL+2, and the third is
-*> dense.
-*> \endverbatim
-*>
-*> \param[in,out] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension (N)
-*> This contains the permutation which separately sorts the two
-*> sub-problems in D into ascending order. Note that entries in
-*> the first hlaf of this permutation must first be moved one
-*> position backward; and entries in the second half
-*> must first have NL+1 added to their values.
-*> \endverbatim
-*>
-*> \param[out] COLTYP
-*> \verbatim
-*> COLTYP is INTEGER array, dimension (N)
-*> As workspace, this will contain a label which will indicate
-*> which of the following types a column in the U2 matrix or a
-*> row in the VT2 matrix is:
-*> 1 : non-zero in the upper half only
-*> 2 : non-zero in the lower half only
-*> 3 : dense
-*> 4 : deflated
-*>
-*> On exit, it is an array of dimension 4, with COLTYP(I) being
-*> the dimension of the I-th type columns.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
- $ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
- $ IDXC, IDXQ, COLTYP, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
- REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
- INTEGER COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ),
- $ IDXQ( * )
- REAL D( * ), DSIGMA( * ), U( LDU, * ),
- $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
- $ Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, EIGHT
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
- $ EIGHT = 8.0E+0 )
-* ..
-* .. Local Arrays ..
- INTEGER CTOT( 4 ), PSM( 4 )
-* ..
-* .. Local Scalars ..
- INTEGER CT, I, IDXI, IDXJ, IDXJP, J, JP, JPREV, K2, M,
- $ N, NLP1, NLP2
- REAL C, EPS, HLFTOL, S, TAU, TOL, Z1
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLAPY2
- EXTERNAL SLAMCH, SLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SLAMRG, SLASET, SROT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( NL.LT.1 ) THEN
- INFO = -1
- ELSE IF( NR.LT.1 ) THEN
- INFO = -2
- ELSE IF( ( SQRE.NE.1 ) .AND. ( SQRE.NE.0 ) ) THEN
- INFO = -3
- END IF
-*
- N = NL + NR + 1
- M = N + SQRE
-*
- IF( LDU.LT.N ) THEN
- INFO = -10
- ELSE IF( LDVT.LT.M ) THEN
- INFO = -12
- ELSE IF( LDU2.LT.N ) THEN
- INFO = -15
- ELSE IF( LDVT2.LT.M ) THEN
- INFO = -17
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD2', -INFO )
- RETURN
- END IF
-*
- NLP1 = NL + 1
- NLP2 = NL + 2
-*
-* Generate the first part of the vector Z; and move the singular
-* values in the first part of D one position backward.
-*
- Z1 = ALPHA*VT( NLP1, NLP1 )
- Z( 1 ) = Z1
- DO 10 I = NL, 1, -1
- Z( I+1 ) = ALPHA*VT( I, NLP1 )
- D( I+1 ) = D( I )
- IDXQ( I+1 ) = IDXQ( I ) + 1
- 10 CONTINUE
-*
-* Generate the second part of the vector Z.
-*
- DO 20 I = NLP2, M
- Z( I ) = BETA*VT( I, NLP2 )
- 20 CONTINUE
-*
-* Initialize some reference arrays.
-*
- DO 30 I = 2, NLP1
- COLTYP( I ) = 1
- 30 CONTINUE
- DO 40 I = NLP2, N
- COLTYP( I ) = 2
- 40 CONTINUE
-*
-* Sort the singular values into increasing order
-*
- DO 50 I = NLP2, N
- IDXQ( I ) = IDXQ( I ) + NLP1
- 50 CONTINUE
-*
-* DSIGMA, IDXC, IDXC, and the first column of U2
-* are used as storage space.
-*
- DO 60 I = 2, N
- DSIGMA( I ) = D( IDXQ( I ) )
- U2( I, 1 ) = Z( IDXQ( I ) )
- IDXC( I ) = COLTYP( IDXQ( I ) )
- 60 CONTINUE
-*
- CALL SLAMRG( NL, NR, DSIGMA( 2 ), 1, 1, IDX( 2 ) )
-*
- DO 70 I = 2, N
- IDXI = 1 + IDX( I )
- D( I ) = DSIGMA( IDXI )
- Z( I ) = U2( IDXI, 1 )
- COLTYP( I ) = IDXC( IDXI )
- 70 CONTINUE
-*
-* Calculate the allowable deflation tolerance
-*
- EPS = SLAMCH( 'Epsilon' )
- TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
- TOL = EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
-*
-* There are 2 kinds of deflation -- first a value in the z-vector
-* is small, second two (or more) singular values are very close
-* together (their difference is small).
-*
-* If the value in the z-vector is small, we simply permute the
-* array so that the corresponding singular value is moved to the
-* end.
-*
-* If two values in the D-vector are close, we perform a two-sided
-* rotation designed to make one of the corresponding z-vector
-* entries zero, and then permute the array so that the deflated
-* singular value is moved to the end.
-*
-* If there are multiple singular values then the problem deflates.
-* Here the number of equal singular values are found. As each equal
-* singular value is found, an elementary reflector is computed to
-* rotate the corresponding singular subspace so that the
-* corresponding components of Z are zero in this new basis.
-*
- K = 1
- K2 = N + 1
- DO 80 J = 2, N
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- COLTYP( J ) = 4
- IF( J.EQ.N )
- $ GO TO 120
- ELSE
- JPREV = J
- GO TO 90
- END IF
- 80 CONTINUE
- 90 CONTINUE
- J = JPREV
- 100 CONTINUE
- J = J + 1
- IF( J.GT.N )
- $ GO TO 110
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- COLTYP( J ) = 4
- ELSE
-*
-* Check if singular values are close enough to allow deflation.
-*
- IF( ABS( D( J )-D( JPREV ) ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- S = Z( JPREV )
- C = Z( J )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = SLAPY2( C, S )
- C = C / TAU
- S = -S / TAU
- Z( J ) = TAU
- Z( JPREV ) = ZERO
-*
-* Apply back the Givens rotation to the left and right
-* singular vector matrices.
-*
- IDXJP = IDXQ( IDX( JPREV )+1 )
- IDXJ = IDXQ( IDX( J )+1 )
- IF( IDXJP.LE.NLP1 ) THEN
- IDXJP = IDXJP - 1
- END IF
- IF( IDXJ.LE.NLP1 ) THEN
- IDXJ = IDXJ - 1
- END IF
- CALL SROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S )
- CALL SROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C,
- $ S )
- IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN
- COLTYP( J ) = 3
- END IF
- COLTYP( JPREV ) = 4
- K2 = K2 - 1
- IDXP( K2 ) = JPREV
- JPREV = J
- ELSE
- K = K + 1
- U2( K, 1 ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
- JPREV = J
- END IF
- END IF
- GO TO 100
- 110 CONTINUE
-*
-* Record the last singular value.
-*
- K = K + 1
- U2( K, 1 ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
-*
- 120 CONTINUE
-*
-* Count up the total number of the various types of columns, then
-* form a permutation which positions the four column types into
-* four groups of uniform structure (although one or more of these
-* groups may be empty).
-*
- DO 130 J = 1, 4
- CTOT( J ) = 0
- 130 CONTINUE
- DO 140 J = 2, N
- CT = COLTYP( J )
- CTOT( CT ) = CTOT( CT ) + 1
- 140 CONTINUE
-*
-* PSM(*) = Position in SubMatrix (of types 1 through 4)
-*
- PSM( 1 ) = 2
- PSM( 2 ) = 2 + CTOT( 1 )
- PSM( 3 ) = PSM( 2 ) + CTOT( 2 )
- PSM( 4 ) = PSM( 3 ) + CTOT( 3 )
-*
-* Fill out the IDXC array so that the permutation which it induces
-* will place all type-1 columns first, all type-2 columns next,
-* then all type-3's, and finally all type-4's, starting from the
-* second column. This applies similarly to the rows of VT.
-*
- DO 150 J = 2, N
- JP = IDXP( J )
- CT = COLTYP( JP )
- IDXC( PSM( CT ) ) = J
- PSM( CT ) = PSM( CT ) + 1
- 150 CONTINUE
-*
-* Sort the singular values and corresponding singular vectors into
-* DSIGMA, U2, and VT2 respectively. The singular values/vectors
-* which were not deflated go into the first K slots of DSIGMA, U2,
-* and VT2 respectively, while those which were deflated go into the
-* last N - K slots, except that the first column/row will be treated
-* separately.
-*
- DO 160 J = 2, N
- JP = IDXP( J )
- DSIGMA( J ) = D( JP )
- IDXJ = IDXQ( IDX( IDXP( IDXC( J ) ) )+1 )
- IF( IDXJ.LE.NLP1 ) THEN
- IDXJ = IDXJ - 1
- END IF
- CALL SCOPY( N, U( 1, IDXJ ), 1, U2( 1, J ), 1 )
- CALL SCOPY( M, VT( IDXJ, 1 ), LDVT, VT2( J, 1 ), LDVT2 )
- 160 CONTINUE
-*
-* Determine DSIGMA(1), DSIGMA(2) and Z(1)
-*
- DSIGMA( 1 ) = ZERO
- HLFTOL = TOL / TWO
- IF( ABS( DSIGMA( 2 ) ).LE.HLFTOL )
- $ DSIGMA( 2 ) = HLFTOL
- IF( M.GT.N ) THEN
- Z( 1 ) = SLAPY2( Z1, Z( M ) )
- IF( Z( 1 ).LE.TOL ) THEN
- C = ONE
- S = ZERO
- Z( 1 ) = TOL
- ELSE
- C = Z1 / Z( 1 )
- S = Z( M ) / Z( 1 )
- END IF
- ELSE
- IF( ABS( Z1 ).LE.TOL ) THEN
- Z( 1 ) = TOL
- ELSE
- Z( 1 ) = Z1
- END IF
- END IF
-*
-* Move the rest of the updating row to Z.
-*
- CALL SCOPY( K-1, U2( 2, 1 ), 1, Z( 2 ), 1 )
-*
-* Determine the first column of U2, the first row of VT2 and the
-* last row of VT.
-*
- CALL SLASET( 'A', N, 1, ZERO, ZERO, U2, LDU2 )
- U2( NLP1, 1 ) = ONE
- IF( M.GT.N ) THEN
- DO 170 I = 1, NLP1
- VT( M, I ) = -S*VT( NLP1, I )
- VT2( 1, I ) = C*VT( NLP1, I )
- 170 CONTINUE
- DO 180 I = NLP2, M
- VT2( 1, I ) = S*VT( M, I )
- VT( M, I ) = C*VT( M, I )
- 180 CONTINUE
- ELSE
- CALL SCOPY( M, VT( NLP1, 1 ), LDVT, VT2( 1, 1 ), LDVT2 )
- END IF
- IF( M.GT.N ) THEN
- CALL SCOPY( M, VT( M, 1 ), LDVT, VT2( M, 1 ), LDVT2 )
- END IF
-*
-* The deflated singular values and their corresponding vectors go
-* into the back of D, U, and V respectively.
-*
- IF( N.GT.K ) THEN
- CALL SCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
- CALL SLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ),
- $ LDU )
- CALL SLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ),
- $ LDVT )
- END IF
-*
-* Copy CTOT into COLTYP for referencing in SLASD3.
-*
- DO 190 J = 1, 4
- COLTYP( J ) = CTOT( J )
- 190 CONTINUE
-*
- RETURN
-*
-* End of SLASD2
-*
- END
diff --git a/netlib/LAPACK/slasd3.f b/netlib/LAPACK/slasd3.f
deleted file mode 100644
index 1ad481c..0000000
--- a/netlib/LAPACK/slasd3.f
+++ /dev/null
@@ -1,470 +0,0 @@
-*> \brief \b SLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and Z, and then updates the singular vectors by matrix multiplication. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2,
-* LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR,
-* $ SQRE
-* ..
-* .. Array Arguments ..
-* INTEGER CTOT( * ), IDXC( * )
-* REAL D( * ), DSIGMA( * ), Q( LDQ, * ), U( LDU, * ),
-* $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
-* $ Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASD3 finds all the square roots of the roots of the secular
-*> equation, as defined by the values in D and Z. It makes the
-*> appropriate calls to SLASD4 and then updates the singular
-*> vectors by matrix multiplication.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*>
-*> SLASD3 is called from SLASD1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The size of the secular equation, 1 =< K = < N.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension(K)
-*> On exit the square roots of the roots of the secular equation,
-*> in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array,
-*> dimension at least (LDQ,K).
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= K.
-*> \endverbatim
-*>
-*> \param[in,out] DSIGMA
-*> \verbatim
-*> DSIGMA is REAL array, dimension(K)
-*> The first K elements of this array contain the old roots
-*> of the deflated updating problem. These are the poles
-*> of the secular equation.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU, N)
-*> The last N - K columns of this matrix contain the deflated
-*> left singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= N.
-*> \endverbatim
-*>
-*> \param[in] U2
-*> \verbatim
-*> U2 is REAL array, dimension (LDU2, N)
-*> The first K columns of this matrix contain the non-deflated
-*> left singular vectors for the split problem.
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of the array U2. LDU2 >= N.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT, M)
-*> The last M - K columns of VT**T contain the deflated
-*> right singular vectors.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VT2
-*> \verbatim
-*> VT2 is REAL array, dimension (LDVT2, N)
-*> The first K columns of VT2**T contain the non-deflated
-*> right singular vectors for the split problem.
-*> \endverbatim
-*>
-*> \param[in] LDVT2
-*> \verbatim
-*> LDVT2 is INTEGER
-*> The leading dimension of the array VT2. LDVT2 >= N.
-*> \endverbatim
-*>
-*> \param[in] IDXC
-*> \verbatim
-*> IDXC is INTEGER array, dimension (N)
-*> The permutation used to arrange the columns of U (and rows of
-*> VT) into three groups: the first group contains non-zero
-*> entries only at and above (or before) NL +1; the second
-*> contains non-zero entries only at and below (or after) NL+2;
-*> and the third is dense. The first column of U and the row of
-*> VT are treated separately, however.
-*>
-*> The rows of the singular vectors found by SLASD4
-*> must be likewise permuted before the matrix multiplies can
-*> take place.
-*> \endverbatim
-*>
-*> \param[in] CTOT
-*> \verbatim
-*> CTOT is INTEGER array, dimension (4)
-*> A count of the total number of the various types of columns
-*> in U (or rows in VT), as described in IDXC. The fourth column
-*> type is any column which has been deflated.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (K)
-*> The first K elements of this array contain the components
-*> of the deflation-adjusted updating row vector.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2,
- $ LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR,
- $ SQRE
-* ..
-* .. Array Arguments ..
- INTEGER CTOT( * ), IDXC( * )
- REAL D( * ), DSIGMA( * ), Q( LDQ, * ), U( LDU, * ),
- $ U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
- $ Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO, NEGONE
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0,
- $ NEGONE = -1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER CTEMP, I, J, JC, KTEMP, M, N, NLP1, NLP2, NRP1
- REAL RHO, TEMP
-* ..
-* .. External Functions ..
- REAL SLAMC3, SNRM2
- EXTERNAL SLAMC3, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, SLACPY, SLASCL, SLASD4, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( NL.LT.1 ) THEN
- INFO = -1
- ELSE IF( NR.LT.1 ) THEN
- INFO = -2
- ELSE IF( ( SQRE.NE.1 ) .AND. ( SQRE.NE.0 ) ) THEN
- INFO = -3
- END IF
-*
- N = NL + NR + 1
- M = N + SQRE
- NLP1 = NL + 1
- NLP2 = NL + 2
-*
- IF( ( K.LT.1 ) .OR. ( K.GT.N ) ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.K ) THEN
- INFO = -7
- ELSE IF( LDU.LT.N ) THEN
- INFO = -10
- ELSE IF( LDU2.LT.N ) THEN
- INFO = -12
- ELSE IF( LDVT.LT.M ) THEN
- INFO = -14
- ELSE IF( LDVT2.LT.M ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD3', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.1 ) THEN
- D( 1 ) = ABS( Z( 1 ) )
- CALL SCOPY( M, VT2( 1, 1 ), LDVT2, VT( 1, 1 ), LDVT )
- IF( Z( 1 ).GT.ZERO ) THEN
- CALL SCOPY( N, U2( 1, 1 ), 1, U( 1, 1 ), 1 )
- ELSE
- DO 10 I = 1, N
- U( I, 1 ) = -U2( I, 1 )
- 10 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Modify values DSIGMA(i) to make sure all DSIGMA(i)-DSIGMA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DSIGMA(I) by 2*DSIGMA(I)-DSIGMA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DSIGMA(I) if it is 1; this makes the subsequent
-* subtractions DSIGMA(I)-DSIGMA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DSIGMA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DSIGMA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DSIGMA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 20 I = 1, K
- DSIGMA( I ) = SLAMC3( DSIGMA( I ), DSIGMA( I ) ) - DSIGMA( I )
- 20 CONTINUE
-*
-* Keep a copy of Z.
-*
- CALL SCOPY( K, Z, 1, Q, 1 )
-*
-* Normalize Z.
-*
- RHO = SNRM2( K, Z, 1 )
- CALL SLASCL( 'G', 0, 0, RHO, ONE, K, 1, Z, K, INFO )
- RHO = RHO*RHO
-*
-* Find the new singular values.
-*
- DO 30 J = 1, K
- CALL SLASD4( K, J, DSIGMA, Z, U( 1, J ), RHO, D( J ),
- $ VT( 1, J ), INFO )
-*
-* If the zero finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- 30 CONTINUE
-*
-* Compute updated Z.
-*
- DO 60 I = 1, K
- Z( I ) = U( I, K )*VT( I, K )
- DO 40 J = 1, I - 1
- Z( I ) = Z( I )*( U( I, J )*VT( I, J ) /
- $ ( DSIGMA( I )-DSIGMA( J ) ) /
- $ ( DSIGMA( I )+DSIGMA( J ) ) )
- 40 CONTINUE
- DO 50 J = I, K - 1
- Z( I ) = Z( I )*( U( I, J )*VT( I, J ) /
- $ ( DSIGMA( I )-DSIGMA( J+1 ) ) /
- $ ( DSIGMA( I )+DSIGMA( J+1 ) ) )
- 50 CONTINUE
- Z( I ) = SIGN( SQRT( ABS( Z( I ) ) ), Q( I, 1 ) )
- 60 CONTINUE
-*
-* Compute left singular vectors of the modified diagonal matrix,
-* and store related information for the right singular vectors.
-*
- DO 90 I = 1, K
- VT( 1, I ) = Z( 1 ) / U( 1, I ) / VT( 1, I )
- U( 1, I ) = NEGONE
- DO 70 J = 2, K
- VT( J, I ) = Z( J ) / U( J, I ) / VT( J, I )
- U( J, I ) = DSIGMA( J )*VT( J, I )
- 70 CONTINUE
- TEMP = SNRM2( K, U( 1, I ), 1 )
- Q( 1, I ) = U( 1, I ) / TEMP
- DO 80 J = 2, K
- JC = IDXC( J )
- Q( J, I ) = U( JC, I ) / TEMP
- 80 CONTINUE
- 90 CONTINUE
-*
-* Update the left singular vector matrix.
-*
- IF( K.EQ.2 ) THEN
- CALL SGEMM( 'N', 'N', N, K, K, ONE, U2, LDU2, Q, LDQ, ZERO, U,
- $ LDU )
- GO TO 100
- END IF
- IF( CTOT( 1 ).GT.0 ) THEN
- CALL SGEMM( 'N', 'N', NL, K, CTOT( 1 ), ONE, U2( 1, 2 ), LDU2,
- $ Q( 2, 1 ), LDQ, ZERO, U( 1, 1 ), LDU )
- IF( CTOT( 3 ).GT.0 ) THEN
- KTEMP = 2 + CTOT( 1 ) + CTOT( 2 )
- CALL SGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, KTEMP ),
- $ LDU2, Q( KTEMP, 1 ), LDQ, ONE, U( 1, 1 ), LDU )
- END IF
- ELSE IF( CTOT( 3 ).GT.0 ) THEN
- KTEMP = 2 + CTOT( 1 ) + CTOT( 2 )
- CALL SGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, KTEMP ),
- $ LDU2, Q( KTEMP, 1 ), LDQ, ZERO, U( 1, 1 ), LDU )
- ELSE
- CALL SLACPY( 'F', NL, K, U2, LDU2, U, LDU )
- END IF
- CALL SCOPY( K, Q( 1, 1 ), LDQ, U( NLP1, 1 ), LDU )
- KTEMP = 2 + CTOT( 1 )
- CTEMP = CTOT( 2 ) + CTOT( 3 )
- CALL SGEMM( 'N', 'N', NR, K, CTEMP, ONE, U2( NLP2, KTEMP ), LDU2,
- $ Q( KTEMP, 1 ), LDQ, ZERO, U( NLP2, 1 ), LDU )
-*
-* Generate the right singular vectors.
-*
- 100 CONTINUE
- DO 120 I = 1, K
- TEMP = SNRM2( K, VT( 1, I ), 1 )
- Q( I, 1 ) = VT( 1, I ) / TEMP
- DO 110 J = 2, K
- JC = IDXC( J )
- Q( I, J ) = VT( JC, I ) / TEMP
- 110 CONTINUE
- 120 CONTINUE
-*
-* Update the right singular vector matrix.
-*
- IF( K.EQ.2 ) THEN
- CALL SGEMM( 'N', 'N', K, M, K, ONE, Q, LDQ, VT2, LDVT2, ZERO,
- $ VT, LDVT )
- RETURN
- END IF
- KTEMP = 1 + CTOT( 1 )
- CALL SGEMM( 'N', 'N', K, NLP1, KTEMP, ONE, Q( 1, 1 ), LDQ,
- $ VT2( 1, 1 ), LDVT2, ZERO, VT( 1, 1 ), LDVT )
- KTEMP = 2 + CTOT( 1 ) + CTOT( 2 )
- IF( KTEMP.LE.LDVT2 )
- $ CALL SGEMM( 'N', 'N', K, NLP1, CTOT( 3 ), ONE, Q( 1, KTEMP ),
- $ LDQ, VT2( KTEMP, 1 ), LDVT2, ONE, VT( 1, 1 ),
- $ LDVT )
-*
- KTEMP = CTOT( 1 ) + 1
- NRP1 = NR + SQRE
- IF( KTEMP.GT.1 ) THEN
- DO 130 I = 1, K
- Q( I, KTEMP ) = Q( I, 1 )
- 130 CONTINUE
- DO 140 I = NLP2, M
- VT2( KTEMP, I ) = VT2( 1, I )
- 140 CONTINUE
- END IF
- CTEMP = 1 + CTOT( 2 ) + CTOT( 3 )
- CALL SGEMM( 'N', 'N', K, NRP1, CTEMP, ONE, Q( 1, KTEMP ), LDQ,
- $ VT2( KTEMP, NLP2 ), LDVT2, ZERO, VT( 1, NLP2 ), LDVT )
-*
- RETURN
-*
-* End of SLASD3
-*
- END
diff --git a/netlib/LAPACK/slasd4.f b/netlib/LAPACK/slasd4.f
deleted file mode 100644
index 6bed144..0000000
--- a/netlib/LAPACK/slasd4.f
+++ /dev/null
@@ -1,1057 +0,0 @@
-*> \brief \b SLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modification to a positive diagonal matrix. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER I, INFO, N
-* REAL RHO, SIGMA
-* ..
-* .. Array Arguments ..
-* REAL D( * ), DELTA( * ), WORK( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the square root of the I-th updated
-*> eigenvalue of a positive symmetric rank-one modification to
-*> a positive diagonal matrix whose entries are given as the squares
-*> of the corresponding entries in the array d, and that
-*>
-*> 0 <= D(i) < D(j) for i < j
-*>
-*> and that RHO > 0. This is arranged by the calling routine, and is
-*> no loss in generality. The rank-one modified system is thus
-*>
-*> diag( D ) * diag( D ) + RHO * Z * Z_transpose.
-*>
-*> where we assume the Euclidean norm of Z is 1.
-*>
-*> The method consists of approximating the rational functions in the
-*> secular equation by simpler interpolating rational functions.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of all arrays.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. 1 <= I <= N.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension ( N )
-*> The original eigenvalues. It is assumed that they are in
-*> order, 0 <= D(I) < D(J) for I < J.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( N )
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is REAL array, dimension ( N )
-*> If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
-*> component. If N = 1, then DELTA(1) = 1. The vector DELTA
-*> contains the information necessary to construct the
-*> (singular) eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is REAL
-*> The computed sigma_I, the I-th updated eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ( N )
-*> If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
-*> component. If N = 1, then WORK( 1 ) = 1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = 1, the updating process failed.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> Logical variable ORGATI (origin-at-i?) is used for distinguishing
-*> whether D(i) or D(i+1) is treated as the origin.
-*>
-*> ORGATI = .true. origin at i
-*> ORGATI = .false. origin at i+1
-*>
-*> Logical variable SWTCH3 (switch-for-3-poles?) is for noting
-*> if we are working with THREE poles!
-*>
-*> MAXIT is the maximum number of iterations allowed for each
-*> eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I, INFO, N
- REAL RHO, SIGMA
-* ..
-* .. Array Arguments ..
- REAL D( * ), DELTA( * ), WORK( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 400 )
- REAL ZERO, ONE, TWO, THREE, FOUR, EIGHT, TEN
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
- $ THREE = 3.0E+0, FOUR = 4.0E+0, EIGHT = 8.0E+0,
- $ TEN = 10.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ORGATI, SWTCH, SWTCH3, GEOMAVG
- INTEGER II, IIM1, IIP1, IP1, ITER, J, NITER
- REAL A, B, C, DELSQ, DELSQ2, SQ2, DPHI, DPSI, DTIIM,
- $ DTIIP, DTIPSQ, DTISQ, DTNSQ, DTNSQ1, DW, EPS,
- $ ERRETM, ETA, PHI, PREW, PSI, RHOINV, SGLB,
- $ SGUB, TAU, TAU2, TEMP, TEMP1, TEMP2, W
-* ..
-* .. Local Arrays ..
- REAL DD( 3 ), ZZ( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAED6, SLASD5
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Since this routine is called in an inner loop, we do no argument
-* checking.
-*
-* Quick return for N=1 and 2.
-*
- INFO = 0
- IF( N.EQ.1 ) THEN
-*
-* Presumably, I=1 upon entry
-*
- SIGMA = SQRT( D( 1 )*D( 1 )+RHO*Z( 1 )*Z( 1 ) )
- DELTA( 1 ) = ONE
- WORK( 1 ) = ONE
- RETURN
- END IF
- IF( N.EQ.2 ) THEN
- CALL SLASD5( I, D, Z, DELTA, RHO, SIGMA, WORK )
- RETURN
- END IF
-*
-* Compute machine epsilon
-*
- EPS = SLAMCH( 'Epsilon' )
- RHOINV = ONE / RHO
-*
-* The case I = N
-*
- IF( I.EQ.N ) THEN
-*
-* Initialize some basic variables
-*
- II = N - 1
- NITER = 1
-*
-* Calculate initial guess
-*
- TEMP = RHO / TWO
-*
-* If ||Z||_2 is not one, then TEMP should be set to
-* RHO * ||Z||_2^2 / TWO
-*
- TEMP1 = TEMP / ( D( N )+SQRT( D( N )*D( N )+TEMP ) )
- DO 10 J = 1, N
- WORK( J ) = D( J ) + D( N ) + TEMP1
- DELTA( J ) = ( D( J )-D( N ) ) - TEMP1
- 10 CONTINUE
-*
- PSI = ZERO
- DO 20 J = 1, N - 2
- PSI = PSI + Z( J )*Z( J ) / ( DELTA( J )*WORK( J ) )
- 20 CONTINUE
-*
- C = RHOINV + PSI
- W = C + Z( II )*Z( II ) / ( DELTA( II )*WORK( II ) ) +
- $ Z( N )*Z( N ) / ( DELTA( N )*WORK( N ) )
-*
- IF( W.LE.ZERO ) THEN
- TEMP1 = SQRT( D( N )*D( N )+RHO )
- TEMP = Z( N-1 )*Z( N-1 ) / ( ( D( N-1 )+TEMP1 )*
- $ ( D( N )-D( N-1 )+RHO / ( D( N )+TEMP1 ) ) ) +
- $ Z( N )*Z( N ) / RHO
-*
-* The following TAU2 is to approximate
-* SIGMA_n^2 - D( N )*D( N )
-*
- IF( C.LE.TEMP ) THEN
- TAU = RHO
- ELSE
- DELSQ = ( D( N )-D( N-1 ) )*( D( N )+D( N-1 ) )
- A = -C*DELSQ + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DELSQ
- IF( A.LT.ZERO ) THEN
- TAU2 = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
- END IF
-*
-* It can be proved that
-* D(N)^2+RHO/2 <= SIGMA_n^2 < D(N)^2+TAU2 <= D(N)^2+RHO
-*
- ELSE
- DELSQ = ( D( N )-D( N-1 ) )*( D( N )+D( N-1 ) )
- A = -C*DELSQ + Z( N-1 )*Z( N-1 ) + Z( N )*Z( N )
- B = Z( N )*Z( N )*DELSQ
-*
-* The following TAU2 is to approximate
-* SIGMA_n^2 - D( N )*D( N )
-*
- IF( A.LT.ZERO ) THEN
- TAU2 = TWO*B / ( SQRT( A*A+FOUR*B*C )-A )
- ELSE
- TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C )
- END IF
-*
-* It can be proved that
-* D(N)^2 < D(N)^2+TAU2 < SIGMA(N)^2 < D(N)^2+RHO/2
-*
- END IF
-*
-* The following TAU is to approximate SIGMA_n - D( N )
-*
- TAU = TAU2 / ( D( N )+SQRT( D( N )*D( N )+TAU2 ) )
-*
- SIGMA = D( N ) + TAU
- DO 30 J = 1, N
- DELTA( J ) = ( D( J )-D( N ) ) - TAU
- WORK( J ) = D( J ) + D( N ) + TAU
- 30 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 40 J = 1, II
- TEMP = Z( J ) / ( DELTA( J )*WORK( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 40 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TEMP = Z( N ) / ( DELTA( N )*WORK( N ) )
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV
-* $ + ABS( TAU2 )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- GO TO 240
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- DTNSQ1 = WORK( N-1 )*DELTA( N-1 )
- DTNSQ = WORK( N )*DELTA( N )
- C = W - DTNSQ1*DPSI - DTNSQ*DPHI
- A = ( DTNSQ+DTNSQ1 )*W - DTNSQ*DTNSQ1*( DPSI+DPHI )
- B = DTNSQ*DTNSQ1*W
- IF( C.LT.ZERO )
- $ C = ABS( C )
- IF( C.EQ.ZERO ) THEN
- ETA = RHO - SIGMA*SIGMA
- ELSE IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = ETA - DTNSQ
- IF( TEMP.GT.RHO )
- $ ETA = RHO + DTNSQ
-*
- ETA = ETA / ( SIGMA+SQRT( ETA+SIGMA*SIGMA ) )
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 50 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- WORK( J ) = WORK( J ) + ETA
- 50 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 60 J = 1, II
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 60 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TAU2 = WORK( N )*DELTA( N )
- TEMP = Z( N ) / TAU2
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV
-* $ + ABS( TAU2 )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
-*
-* Main loop to update the values of the array DELTA
-*
- ITER = NITER + 1
-*
- DO 90 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- GO TO 240
- END IF
-*
-* Calculate the new step
-*
- DTNSQ1 = WORK( N-1 )*DELTA( N-1 )
- DTNSQ = WORK( N )*DELTA( N )
- C = W - DTNSQ1*DPSI - DTNSQ*DPHI
- A = ( DTNSQ+DTNSQ1 )*W - DTNSQ1*DTNSQ*( DPSI+DPHI )
- B = DTNSQ1*DTNSQ*W
- IF( A.GE.ZERO ) THEN
- ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A-SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GT.ZERO )
- $ ETA = -W / ( DPSI+DPHI )
- TEMP = ETA - DTNSQ
- IF( TEMP.LE.ZERO )
- $ ETA = ETA / TWO
-*
- ETA = ETA / ( SIGMA+SQRT( ETA+SIGMA*SIGMA ) )
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 70 J = 1, N
- DELTA( J ) = DELTA( J ) - ETA
- WORK( J ) = WORK( J ) + ETA
- 70 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 80 J = 1, II
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 80 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- TAU2 = WORK( N )*DELTA( N )
- TEMP = Z( N ) / TAU2
- PHI = Z( N )*TEMP
- DPHI = TEMP*TEMP
- ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV
-* $ + ABS( TAU2 )*( DPSI+DPHI )
-*
- W = RHOINV + PHI + PSI
- 90 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
- GO TO 240
-*
-* End for the case I = N
-*
- ELSE
-*
-* The case for I < N
-*
- NITER = 1
- IP1 = I + 1
-*
-* Calculate initial guess
-*
- DELSQ = ( D( IP1 )-D( I ) )*( D( IP1 )+D( I ) )
- DELSQ2 = DELSQ / TWO
- SQ2=SQRT( ( D( I )*D( I )+D( IP1 )*D( IP1 ) ) / TWO )
- TEMP = DELSQ2 / ( D( I )+SQ2 )
- DO 100 J = 1, N
- WORK( J ) = D( J ) + D( I ) + TEMP
- DELTA( J ) = ( D( J )-D( I ) ) - TEMP
- 100 CONTINUE
-*
- PSI = ZERO
- DO 110 J = 1, I - 1
- PSI = PSI + Z( J )*Z( J ) / ( WORK( J )*DELTA( J ) )
- 110 CONTINUE
-*
- PHI = ZERO
- DO 120 J = N, I + 2, -1
- PHI = PHI + Z( J )*Z( J ) / ( WORK( J )*DELTA( J ) )
- 120 CONTINUE
- C = RHOINV + PSI + PHI
- W = C + Z( I )*Z( I ) / ( WORK( I )*DELTA( I ) ) +
- $ Z( IP1 )*Z( IP1 ) / ( WORK( IP1 )*DELTA( IP1 ) )
-*
- GEOMAVG = .FALSE.
- IF( W.GT.ZERO ) THEN
-*
-* d(i)^2 < the ith sigma^2 < (d(i)^2+d(i+1)^2)/2
-*
-* We choose d(i) as origin.
-*
- ORGATI = .TRUE.
- II = I
- SGLB = ZERO
- SGUB = DELSQ2 / ( D( I )+SQ2 )
- A = C*DELSQ + Z( I )*Z( I ) + Z( IP1 )*Z( IP1 )
- B = Z( I )*Z( I )*DELSQ
- IF( A.GT.ZERO ) THEN
- TAU2 = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- ELSE
- TAU2 = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- END IF
-*
-* TAU2 now is an estimation of SIGMA^2 - D( I )^2. The
-* following, however, is the corresponding estimation of
-* SIGMA - D( I ).
-*
- TAU = TAU2 / ( D( I )+SQRT( D( I )*D( I )+TAU2 ) )
- TEMP = SQRT(EPS)
- IF( (D(I).LE.TEMP*D(IP1)).AND.(ABS(Z(I)).LE.TEMP)
- $ .AND.(D(I).GT.ZERO) ) THEN
- TAU = MIN( TEN*D(I), SGUB )
- GEOMAVG = .TRUE.
- END IF
- ELSE
-*
-* (d(i)^2+d(i+1)^2)/2 <= the ith sigma^2 < d(i+1)^2/2
-*
-* We choose d(i+1) as origin.
-*
- ORGATI = .FALSE.
- II = IP1
- SGLB = -DELSQ2 / ( D( II )+SQ2 )
- SGUB = ZERO
- A = C*DELSQ - Z( I )*Z( I ) - Z( IP1 )*Z( IP1 )
- B = Z( IP1 )*Z( IP1 )*DELSQ
- IF( A.LT.ZERO ) THEN
- TAU2 = TWO*B / ( A-SQRT( ABS( A*A+FOUR*B*C ) ) )
- ELSE
- TAU2 = -( A+SQRT( ABS( A*A+FOUR*B*C ) ) ) / ( TWO*C )
- END IF
-*
-* TAU2 now is an estimation of SIGMA^2 - D( IP1 )^2. The
-* following, however, is the corresponding estimation of
-* SIGMA - D( IP1 ).
-*
- TAU = TAU2 / ( D( IP1 )+SQRT( ABS( D( IP1 )*D( IP1 )+
- $ TAU2 ) ) )
- END IF
-*
- SIGMA = D( II ) + TAU
- DO 130 J = 1, N
- WORK( J ) = D( J ) + D( II ) + TAU
- DELTA( J ) = ( D( J )-D( II ) ) - TAU
- 130 CONTINUE
- IIM1 = II - 1
- IIP1 = II + 1
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 150 J = 1, IIM1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 150 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 160 J = N, IIP1, -1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 160 CONTINUE
-*
- W = RHOINV + PHI + PSI
-*
-* W is the value of the secular function with
-* its ii-th element removed.
-*
- SWTCH3 = .FALSE.
- IF( ORGATI ) THEN
- IF( W.LT.ZERO )
- $ SWTCH3 = .TRUE.
- ELSE
- IF( W.GT.ZERO )
- $ SWTCH3 = .TRUE.
- END IF
- IF( II.EQ.1 .OR. II.EQ.N )
- $ SWTCH3 = .FALSE.
-*
- TEMP = Z( II ) / ( WORK( II )*DELTA( II ) )
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = W + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV
- $ + THREE*ABS( TEMP )
-* $ + ABS( TAU2 )*DW
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
- GO TO 240
- END IF
-*
- IF( W.LE.ZERO ) THEN
- SGLB = MAX( SGLB, TAU )
- ELSE
- SGUB = MIN( SGUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- NITER = NITER + 1
- IF( .NOT.SWTCH3 ) THEN
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I ) / DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 ) / DTIPSQ )**2
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) + DTISQ*DTISQ*( DPSI+DPHI )
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- DTIIM = WORK( IIM1 )*DELTA( IIM1 )
- DTIIP = WORK( IIP1 )*DELTA( IIP1 )
- TEMP = RHOINV + PSI + PHI
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DTIIM
- TEMP1 = TEMP1*TEMP1
- C = ( TEMP - DTIIP*( DPSI+DPHI ) ) -
- $ ( D( IIM1 )-D( IIP1 ) )*( D( IIM1 )+D( IIP1 ) )*TEMP1
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- IF( DPSI.LT.TEMP1 ) THEN
- ZZ( 3 ) = DTIIP*DTIIP*DPHI
- ELSE
- ZZ( 3 ) = DTIIP*DTIIP*( ( DPSI-TEMP1 )+DPHI )
- END IF
- ELSE
- TEMP1 = Z( IIP1 ) / DTIIP
- TEMP1 = TEMP1*TEMP1
- C = ( TEMP - DTIIM*( DPSI+DPHI ) ) -
- $ ( D( IIP1 )-D( IIM1 ) )*( D( IIM1 )+D( IIP1 ) )*TEMP1
- IF( DPHI.LT.TEMP1 ) THEN
- ZZ( 1 ) = DTIIM*DTIIM*DPSI
- ELSE
- ZZ( 1 ) = DTIIM*DTIIM*( DPSI+( DPHI-TEMP1 ) )
- END IF
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- ZZ( 2 ) = Z( II )*Z( II )
- DD( 1 ) = DTIIM
- DD( 2 ) = DELTA( II )*WORK( II )
- DD( 3 ) = DTIIP
- CALL SLAED6( NITER, ORGATI, C, DD, ZZ, W, ETA, INFO )
-*
- IF( INFO.NE.0 ) THEN
-*
-* If INFO is not 0, i.e., SLAED6 failed, switch back
-* to 2 pole interpolation.
-*
- SWTCH3 = .FALSE.
- INFO = 0
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I ) / DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 ) / DTIPSQ )**2
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) + DTISQ*DTISQ*( DPSI+DPHI)
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- END IF
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
-*
- ETA = ETA / ( SIGMA+SQRT( SIGMA*SIGMA+ETA ) )
- TEMP = TAU + ETA
- IF( TEMP.GT.SGUB .OR. TEMP.LT.SGLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( SGUB-TAU ) / TWO
- ELSE
- ETA = ( SGLB-TAU ) / TWO
- END IF
- IF( GEOMAVG ) THEN
- IF( W .LT. ZERO ) THEN
- IF( TAU .GT. ZERO ) THEN
- ETA = SQRT(SGUB*TAU)-TAU
- END IF
- ELSE
- IF( SGLB .GT. ZERO ) THEN
- ETA = SQRT(SGLB*TAU)-TAU
- END IF
- END IF
- END IF
- END IF
-*
- PREW = W
-*
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 170 J = 1, N
- WORK( J ) = WORK( J ) + ETA
- DELTA( J ) = DELTA( J ) - ETA
- 170 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 180 J = 1, IIM1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 180 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 190 J = N, IIP1, -1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 190 CONTINUE
-*
- TAU2 = WORK( II )*DELTA( II )
- TEMP = Z( II ) / TAU2
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV
- $ + THREE*ABS( TEMP )
-* $ + ABS( TAU2 )*DW
-*
- SWTCH = .FALSE.
- IF( ORGATI ) THEN
- IF( -W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- ELSE
- IF( W.GT.ABS( PREW ) / TEN )
- $ SWTCH = .TRUE.
- END IF
-*
-* Main loop to update the values of the array DELTA and WORK
-*
- ITER = NITER + 1
-*
- DO 230 NITER = ITER, MAXIT
-*
-* Test for convergence
-*
- IF( ABS( W ).LE.EPS*ERRETM ) THEN
-* $ .OR. (SGUB-SGLB).LE.EIGHT*ABS(SGUB+SGLB) ) THEN
- GO TO 240
- END IF
-*
- IF( W.LE.ZERO ) THEN
- SGLB = MAX( SGLB, TAU )
- ELSE
- SGUB = MIN( SGUB, TAU )
- END IF
-*
-* Calculate the new step
-*
- IF( .NOT.SWTCH3 ) THEN
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I ) / DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 ) / DTIPSQ )**2
- END IF
- ELSE
- TEMP = Z( II ) / ( WORK( II )*DELTA( II ) )
- IF( ORGATI ) THEN
- DPSI = DPSI + TEMP*TEMP
- ELSE
- DPHI = DPHI + TEMP*TEMP
- END IF
- C = W - DTISQ*DPSI - DTIPSQ*DPHI
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*
- $ ( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) +
- $ DTISQ*DTISQ*( DPSI+DPHI )
- END IF
- ELSE
- A = DTISQ*DTISQ*DPSI + DTIPSQ*DTIPSQ*DPHI
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- ELSE
-*
-* Interpolation using THREE most relevant poles
-*
- DTIIM = WORK( IIM1 )*DELTA( IIM1 )
- DTIIP = WORK( IIP1 )*DELTA( IIP1 )
- TEMP = RHOINV + PSI + PHI
- IF( SWTCH ) THEN
- C = TEMP - DTIIM*DPSI - DTIIP*DPHI
- ZZ( 1 ) = DTIIM*DTIIM*DPSI
- ZZ( 3 ) = DTIIP*DTIIP*DPHI
- ELSE
- IF( ORGATI ) THEN
- TEMP1 = Z( IIM1 ) / DTIIM
- TEMP1 = TEMP1*TEMP1
- TEMP2 = ( D( IIM1 )-D( IIP1 ) )*
- $ ( D( IIM1 )+D( IIP1 ) )*TEMP1
- C = TEMP - DTIIP*( DPSI+DPHI ) - TEMP2
- ZZ( 1 ) = Z( IIM1 )*Z( IIM1 )
- IF( DPSI.LT.TEMP1 ) THEN
- ZZ( 3 ) = DTIIP*DTIIP*DPHI
- ELSE
- ZZ( 3 ) = DTIIP*DTIIP*( ( DPSI-TEMP1 )+DPHI )
- END IF
- ELSE
- TEMP1 = Z( IIP1 ) / DTIIP
- TEMP1 = TEMP1*TEMP1
- TEMP2 = ( D( IIP1 )-D( IIM1 ) )*
- $ ( D( IIM1 )+D( IIP1 ) )*TEMP1
- C = TEMP - DTIIM*( DPSI+DPHI ) - TEMP2
- IF( DPHI.LT.TEMP1 ) THEN
- ZZ( 1 ) = DTIIM*DTIIM*DPSI
- ELSE
- ZZ( 1 ) = DTIIM*DTIIM*( DPSI+( DPHI-TEMP1 ) )
- END IF
- ZZ( 3 ) = Z( IIP1 )*Z( IIP1 )
- END IF
- END IF
- DD( 1 ) = DTIIM
- DD( 2 ) = DELTA( II )*WORK( II )
- DD( 3 ) = DTIIP
- CALL SLAED6( NITER, ORGATI, C, DD, ZZ, W, ETA, INFO )
-*
- IF( INFO.NE.0 ) THEN
-*
-* If INFO is not 0, i.e., SLAED6 failed, switch
-* back to two pole interpolation
-*
- SWTCH3 = .FALSE.
- INFO = 0
- DTIPSQ = WORK( IP1 )*DELTA( IP1 )
- DTISQ = WORK( I )*DELTA( I )
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- C = W - DTIPSQ*DW + DELSQ*( Z( I )/DTISQ )**2
- ELSE
- C = W - DTISQ*DW - DELSQ*( Z( IP1 )/DTIPSQ )**2
- END IF
- ELSE
- TEMP = Z( II ) / ( WORK( II )*DELTA( II ) )
- IF( ORGATI ) THEN
- DPSI = DPSI + TEMP*TEMP
- ELSE
- DPHI = DPHI + TEMP*TEMP
- END IF
- C = W - DTISQ*DPSI - DTIPSQ*DPHI
- END IF
- A = ( DTIPSQ+DTISQ )*W - DTIPSQ*DTISQ*DW
- B = DTIPSQ*DTISQ*W
- IF( C.EQ.ZERO ) THEN
- IF( A.EQ.ZERO ) THEN
- IF( .NOT.SWTCH ) THEN
- IF( ORGATI ) THEN
- A = Z( I )*Z( I ) + DTIPSQ*DTIPSQ*
- $ ( DPSI+DPHI )
- ELSE
- A = Z( IP1 )*Z( IP1 ) +
- $ DTISQ*DTISQ*( DPSI+DPHI )
- END IF
- ELSE
- A = DTISQ*DTISQ*DPSI + DTIPSQ*DTIPSQ*DPHI
- END IF
- END IF
- ETA = B / A
- ELSE IF( A.LE.ZERO ) THEN
- ETA = ( A-SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
- ELSE
- ETA = TWO*B / ( A+SQRT( ABS( A*A-FOUR*B*C ) ) )
- END IF
- END IF
- END IF
-*
-* Note, eta should be positive if w is negative, and
-* eta should be negative otherwise. However,
-* if for some reason caused by roundoff, eta*w > 0,
-* we simply use one Newton step instead. This way
-* will guarantee eta*w < 0.
-*
- IF( W*ETA.GE.ZERO )
- $ ETA = -W / DW
-*
- ETA = ETA / ( SIGMA+SQRT( SIGMA*SIGMA+ETA ) )
- TEMP=TAU+ETA
- IF( TEMP.GT.SGUB .OR. TEMP.LT.SGLB ) THEN
- IF( W.LT.ZERO ) THEN
- ETA = ( SGUB-TAU ) / TWO
- ELSE
- ETA = ( SGLB-TAU ) / TWO
- END IF
- IF( GEOMAVG ) THEN
- IF( W .LT. ZERO ) THEN
- IF( TAU .GT. ZERO ) THEN
- ETA = SQRT(SGUB*TAU)-TAU
- END IF
- ELSE
- IF( SGLB .GT. ZERO ) THEN
- ETA = SQRT(SGLB*TAU)-TAU
- END IF
- END IF
- END IF
- END IF
-*
- PREW = W
-*
- TAU = TAU + ETA
- SIGMA = SIGMA + ETA
-*
- DO 200 J = 1, N
- WORK( J ) = WORK( J ) + ETA
- DELTA( J ) = DELTA( J ) - ETA
- 200 CONTINUE
-*
-* Evaluate PSI and the derivative DPSI
-*
- DPSI = ZERO
- PSI = ZERO
- ERRETM = ZERO
- DO 210 J = 1, IIM1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PSI = PSI + Z( J )*TEMP
- DPSI = DPSI + TEMP*TEMP
- ERRETM = ERRETM + PSI
- 210 CONTINUE
- ERRETM = ABS( ERRETM )
-*
-* Evaluate PHI and the derivative DPHI
-*
- DPHI = ZERO
- PHI = ZERO
- DO 220 J = N, IIP1, -1
- TEMP = Z( J ) / ( WORK( J )*DELTA( J ) )
- PHI = PHI + Z( J )*TEMP
- DPHI = DPHI + TEMP*TEMP
- ERRETM = ERRETM + PHI
- 220 CONTINUE
-*
- TAU2 = WORK( II )*DELTA( II )
- TEMP = Z( II ) / TAU2
- DW = DPSI + DPHI + TEMP*TEMP
- TEMP = Z( II )*TEMP
- W = RHOINV + PHI + PSI + TEMP
- ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV
- $ + THREE*ABS( TEMP )
-* $ + ABS( TAU2 )*DW
-*
- IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN )
- $ SWTCH = .NOT.SWTCH
-*
- 230 CONTINUE
-*
-* Return with INFO = 1, NITER = MAXIT and not converged
-*
- INFO = 1
-*
- END IF
-*
- 240 CONTINUE
- RETURN
-*
-* End of SLASD4
-*
- END
diff --git a/netlib/LAPACK/slasd5.f b/netlib/LAPACK/slasd5.f
deleted file mode 100644
index 6c2535b..0000000
--- a/netlib/LAPACK/slasd5.f
+++ /dev/null
@@ -1,231 +0,0 @@
-*> \brief \b SLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK )
-*
-* .. Scalar Arguments ..
-* INTEGER I
-* REAL DSIGMA, RHO
-* ..
-* .. Array Arguments ..
-* REAL D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine computes the square root of the I-th eigenvalue
-*> of a positive symmetric rank-one modification of a 2-by-2 diagonal
-*> matrix
-*>
-*> diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
-*>
-*> The diagonal entries in the array D are assumed to satisfy
-*>
-*> 0 <= D(i) < D(j) for i < j .
-*>
-*> We also assume RHO > 0 and that the Euclidean norm of the vector
-*> Z is one.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> The index of the eigenvalue to be computed. I = 1 or I = 2.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (2)
-*> The original eigenvalues. We assume 0 <= D(1) < D(2).
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (2)
-*> The components of the updating vector.
-*> \endverbatim
-*>
-*> \param[out] DELTA
-*> \verbatim
-*> DELTA is REAL array, dimension (2)
-*> Contains (D(j) - sigma_I) in its j-th component.
-*> The vector DELTA contains the information necessary
-*> to construct the eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RHO
-*> \verbatim
-*> RHO is REAL
-*> The scalar in the symmetric updating formula.
-*> \endverbatim
-*>
-*> \param[out] DSIGMA
-*> \verbatim
-*> DSIGMA is REAL
-*> The computed sigma_I, the I-th updated eigenvalue.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2)
-*> WORK contains (D(j) + sigma_I) in its j-th component.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ren-Cang Li, Computer Science Division, University of California
-*> at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I
- REAL DSIGMA, RHO
-* ..
-* .. Array Arguments ..
- REAL D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, THREE, FOUR
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
- $ THREE = 3.0E+0, FOUR = 4.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL B, C, DEL, DELSQ, TAU, W
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- DEL = D( 2 ) - D( 1 )
- DELSQ = DEL*( D( 2 )+D( 1 ) )
- IF( I.EQ.1 ) THEN
- W = ONE + FOUR*RHO*( Z( 2 )*Z( 2 ) / ( D( 1 )+THREE*D( 2 ) )-
- $ Z( 1 )*Z( 1 ) / ( THREE*D( 1 )+D( 2 ) ) ) / DEL
- IF( W.GT.ZERO ) THEN
- B = DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 1 )*Z( 1 )*DELSQ
-*
-* B > ZERO, always
-*
-* The following TAU is DSIGMA * DSIGMA - D( 1 ) * D( 1 )
-*
- TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) )
-*
-* The following TAU is DSIGMA - D( 1 )
-*
- TAU = TAU / ( D( 1 )+SQRT( D( 1 )*D( 1 )+TAU ) )
- DSIGMA = D( 1 ) + TAU
- DELTA( 1 ) = -TAU
- DELTA( 2 ) = DEL - TAU
- WORK( 1 ) = TWO*D( 1 ) + TAU
- WORK( 2 ) = ( D( 1 )+TAU ) + D( 2 )
-* DELTA( 1 ) = -Z( 1 ) / TAU
-* DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
- ELSE
- B = -DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DELSQ
-*
-* The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 )
-*
- IF( B.GT.ZERO ) THEN
- TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) )
- ELSE
- TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO
- END IF
-*
-* The following TAU is DSIGMA - D( 2 )
-*
- TAU = TAU / ( D( 2 )+SQRT( ABS( D( 2 )*D( 2 )+TAU ) ) )
- DSIGMA = D( 2 ) + TAU
- DELTA( 1 ) = -( DEL+TAU )
- DELTA( 2 ) = -TAU
- WORK( 1 ) = D( 1 ) + TAU + D( 2 )
- WORK( 2 ) = TWO*D( 2 ) + TAU
-* DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
-* DELTA( 2 ) = -Z( 2 ) / TAU
- END IF
-* TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
-* DELTA( 1 ) = DELTA( 1 ) / TEMP
-* DELTA( 2 ) = DELTA( 2 ) / TEMP
- ELSE
-*
-* Now I=2
-*
- B = -DELSQ + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) )
- C = RHO*Z( 2 )*Z( 2 )*DELSQ
-*
-* The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 )
-*
- IF( B.GT.ZERO ) THEN
- TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO
- ELSE
- TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) )
- END IF
-*
-* The following TAU is DSIGMA - D( 2 )
-*
- TAU = TAU / ( D( 2 )+SQRT( D( 2 )*D( 2 )+TAU ) )
- DSIGMA = D( 2 ) + TAU
- DELTA( 1 ) = -( DEL+TAU )
- DELTA( 2 ) = -TAU
- WORK( 1 ) = D( 1 ) + TAU + D( 2 )
- WORK( 2 ) = TWO*D( 2 ) + TAU
-* DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
-* DELTA( 2 ) = -Z( 2 ) / TAU
-* TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
-* DELTA( 1 ) = DELTA( 1 ) / TEMP
-* DELTA( 2 ) = DELTA( 2 ) / TEMP
- END IF
- RETURN
-*
-* End of SLASD5
-*
- END
diff --git a/netlib/LAPACK/slasd6.f b/netlib/LAPACK/slasd6.f
deleted file mode 100644
index 45b3ab1..0000000
--- a/netlib/LAPACK/slasd6.f
+++ /dev/null
@@ -1,445 +0,0 @@
-*> \brief \b SLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by appending a row. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA,
-* IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM,
-* LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
-* $ NR, SQRE
-* REAL ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), IDXQ( * ), IWORK( * ),
-* $ PERM( * )
-* REAL D( * ), DIFL( * ), DIFR( * ),
-* $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ),
-* $ VF( * ), VL( * ), WORK( * ), Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASD6 computes the SVD of an updated upper bidiagonal matrix B
-*> obtained by merging two smaller ones by appending a row. This
-*> routine is used only for the problem which requires all singular
-*> values and optionally singular vector matrices in factored form.
-*> B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
-*> A related subroutine, SLASD1, handles the case in which all singular
-*> values and singular vectors of the bidiagonal matrix are desired.
-*>
-*> SLASD6 computes the SVD as follows:
-*>
-*> ( D1(in) 0 0 0 )
-*> B = U(in) * ( Z1**T a Z2**T b ) * VT(in)
-*> ( 0 0 D2(in) 0 )
-*>
-*> = U(out) * ( D(out) 0) * VT(out)
-*>
-*> where Z**T = (Z1**T a Z2**T b) = u**T VT**T, and u is a vector of dimension M
-*> with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
-*> elsewhere; and the entry b is empty if SQRE = 0.
-*>
-*> The singular values of B can be computed using D1, D2, the first
-*> components of all the right singular vectors of the lower block, and
-*> the last components of all the right singular vectors of the upper
-*> block. These components are stored and updated in VF and VL,
-*> respectively, in SLASD6. Hence U and VT are not explicitly
-*> referenced.
-*>
-*> The singular values are stored in D. The algorithm consists of two
-*> stages:
-*>
-*> The first stage consists of deflating the size of the problem
-*> when there are multiple singular values or if there is a zero
-*> in the Z vector. For each such occurence the dimension of the
-*> secular equation problem is reduced by one. This stage is
-*> performed by the routine SLASD7.
-*>
-*> The second stage consists of calculating the updated
-*> singular values. This is done by finding the roots of the
-*> secular equation via the routine SLASD4 (as called by SLASD8).
-*> This routine also updates VF and VL and computes the distances
-*> between the updated singular values and the old singular
-*> values.
-*>
-*> SLASD6 is called from SLASDA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed in
-*> factored form:
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors in factored form as well.
-*> \endverbatim
-*>
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has row dimension N = NL + NR + 1,
-*> and column dimension M = N + SQRE.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (NL+NR+1).
-*> On entry D(1:NL,1:NL) contains the singular values of the
-*> upper block, and D(NL+2:N) contains the singular values
-*> of the lower block. On exit D(1:N) contains the singular
-*> values of the modified matrix.
-*> \endverbatim
-*>
-*> \param[in,out] VF
-*> \verbatim
-*> VF is REAL array, dimension (M)
-*> On entry, VF(1:NL+1) contains the first components of all
-*> right singular vectors of the upper block; and VF(NL+2:M)
-*> contains the first components of all right singular vectors
-*> of the lower block. On exit, VF contains the first components
-*> of all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL array, dimension (M)
-*> On entry, VL(1:NL+1) contains the last components of all
-*> right singular vectors of the upper block; and VL(NL+2:M)
-*> contains the last components of all right singular vectors of
-*> the lower block. On exit, VL contains the last components of
-*> all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in,out] BETA
-*> \verbatim
-*> BETA is REAL
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[out] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension (N)
-*> This contains the permutation which will reintegrate the
-*> subproblem just solved back into sorted order, i.e.
-*> D( IDXQ( I = 1, N ) ) will be in ascending order.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( N )
-*> The permutations (from deflation and sorting) to be applied
-*> to each block. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER
-*> leading dimension of GIVCOL, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension ( LDGNUM, 2 )
-*> Each number indicates the C or S value to be used in the
-*> corresponding Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGNUM
-*> \verbatim
-*> LDGNUM is INTEGER
-*> The leading dimension of GIVNUM and POLES, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] POLES
-*> \verbatim
-*> POLES is REAL array, dimension ( LDGNUM, 2 )
-*> On exit, POLES(1,*) is an array containing the new singular
-*> values obtained from solving the secular equation, and
-*> POLES(2,*) is an array containing the poles in the secular
-*> equation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] DIFL
-*> \verbatim
-*> DIFL is REAL array, dimension ( N )
-*> On exit, DIFL(I) is the distance between I-th updated
-*> (undeflated) singular value and the I-th (undeflated) old
-*> singular value.
-*> \endverbatim
-*>
-*> \param[out] DIFR
-*> \verbatim
-*> DIFR is REAL array,
-*> dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
-*> dimension ( N ) if ICOMPQ = 0.
-*> On exit, DIFR(I, 1) is the distance between I-th updated
-*> (undeflated) singular value and the I+1-th (undeflated) old
-*> singular value.
-*>
-*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
-*> normalizing factors for the right singular vector matrix.
-*>
-*> See SLASD8 for details on DIFL and DIFR.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension ( M )
-*> The first elements of this array contain the components
-*> of the deflation-adjusted updating row vector.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix,
-*> This is the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL
-*> C contains garbage if SQRE =0 and the C-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL
-*> S contains garbage if SQRE =0 and the S-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ( 4 * M )
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension ( 3 * N )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA,
- $ IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM,
- $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
- $ NR, SQRE
- REAL ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), IDXQ( * ), IWORK( * ),
- $ PERM( * )
- REAL D( * ), DIFL( * ), DIFR( * ),
- $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ),
- $ VF( * ), VL( * ), WORK( * ), Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IDX, IDXC, IDXP, ISIGMA, IVFW, IVLW, IW, M,
- $ N, N1, N2
- REAL ORGNRM
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAMRG, SLASCL, SLASD7, SLASD8, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- N = NL + NR + 1
- M = N + SQRE
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( NL.LT.1 ) THEN
- INFO = -2
- ELSE IF( NR.LT.1 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -14
- ELSE IF( LDGNUM.LT.N ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD6', -INFO )
- RETURN
- END IF
-*
-* The following values are for bookkeeping purposes only. They are
-* integer pointers which indicate the portion of the workspace
-* used by a particular array in SLASD7 and SLASD8.
-*
- ISIGMA = 1
- IW = ISIGMA + N
- IVFW = IW + M
- IVLW = IVFW + M
-*
- IDX = 1
- IDXC = IDX + N
- IDXP = IDXC + N
-*
-* Scale.
-*
- ORGNRM = MAX( ABS( ALPHA ), ABS( BETA ) )
- D( NL+1 ) = ZERO
- DO 10 I = 1, N
- IF( ABS( D( I ) ).GT.ORGNRM ) THEN
- ORGNRM = ABS( D( I ) )
- END IF
- 10 CONTINUE
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, N, 1, D, N, INFO )
- ALPHA = ALPHA / ORGNRM
- BETA = BETA / ORGNRM
-*
-* Sort and Deflate singular values.
-*
- CALL SLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, WORK( IW ), VF,
- $ WORK( IVFW ), VL, WORK( IVLW ), ALPHA, BETA,
- $ WORK( ISIGMA ), IWORK( IDX ), IWORK( IDXP ), IDXQ,
- $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, C, S,
- $ INFO )
-*
-* Solve Secular Equation, compute DIFL, DIFR, and update VF, VL.
-*
- CALL SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDGNUM,
- $ WORK( ISIGMA ), WORK( IW ), INFO )
-*
-* Handle error returned
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD8', -INFO )
- RETURN
- END IF
-*
-* Save the poles if ICOMPQ = 1.
-*
- IF( ICOMPQ.EQ.1 ) THEN
- CALL SCOPY( K, D, 1, POLES( 1, 1 ), 1 )
- CALL SCOPY( K, WORK( ISIGMA ), 1, POLES( 1, 2 ), 1 )
- END IF
-*
-* Unscale.
-*
- CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, N, 1, D, N, INFO )
-*
-* Prepare the IDXQ sorting permutation.
-*
- N1 = K
- N2 = N - K
- CALL SLAMRG( N1, N2, D, 1, -1, IDXQ )
-*
- RETURN
-*
-* End of SLASD6
-*
- END
diff --git a/netlib/LAPACK/slasd7.f b/netlib/LAPACK/slasd7.f
deleted file mode 100644
index f32bd47..0000000
--- a/netlib/LAPACK/slasd7.f
+++ /dev/null
@@ -1,580 +0,0 @@
-*> \brief \b SLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD7 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd7.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd7.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd7.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL,
-* VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ,
-* PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
-* C, S, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
-* $ NR, SQRE
-* REAL ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), IDX( * ), IDXP( * ),
-* $ IDXQ( * ), PERM( * )
-* REAL D( * ), DSIGMA( * ), GIVNUM( LDGNUM, * ),
-* $ VF( * ), VFW( * ), VL( * ), VLW( * ), Z( * ),
-* $ ZW( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASD7 merges the two sets of singular values together into a single
-*> sorted set. Then it tries to deflate the size of the problem. There
-*> are two ways in which deflation can occur: when two or more singular
-*> values are close together or if there is a tiny entry in the Z
-*> vector. For each such occurrence the order of the related
-*> secular equation problem is reduced by one.
-*>
-*> SLASD7 is called from SLASD6.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed
-*> in compact form, as follows:
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors of upper
-*> bidiagonal matrix in compact form.
-*> \endverbatim
-*>
-*> \param[in] NL
-*> \verbatim
-*> NL is INTEGER
-*> The row dimension of the upper block. NL >= 1.
-*> \endverbatim
-*>
-*> \param[in] NR
-*> \verbatim
-*> NR is INTEGER
-*> The row dimension of the lower block. NR >= 1.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: the lower block is an NR-by-NR square matrix.
-*> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
-*>
-*> The bidiagonal matrix has
-*> N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER
-*> Contains the dimension of the non-deflated matrix, this is
-*> the order of the related secular equation. 1 <= K <=N.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension ( N )
-*> On entry D contains the singular values of the two submatrices
-*> to be combined. On exit D contains the trailing (N-K) updated
-*> singular values (those which were deflated) sorted into
-*> increasing order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension ( M )
-*> On exit Z contains the updating row vector in the secular
-*> equation.
-*> \endverbatim
-*>
-*> \param[out] ZW
-*> \verbatim
-*> ZW is REAL array, dimension ( M )
-*> Workspace for Z.
-*> \endverbatim
-*>
-*> \param[in,out] VF
-*> \verbatim
-*> VF is REAL array, dimension ( M )
-*> On entry, VF(1:NL+1) contains the first components of all
-*> right singular vectors of the upper block; and VF(NL+2:M)
-*> contains the first components of all right singular vectors
-*> of the lower block. On exit, VF contains the first components
-*> of all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[out] VFW
-*> \verbatim
-*> VFW is REAL array, dimension ( M )
-*> Workspace for VF.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL array, dimension ( M )
-*> On entry, VL(1:NL+1) contains the last components of all
-*> right singular vectors of the upper block; and VL(NL+2:M)
-*> contains the last components of all right singular vectors
-*> of the lower block. On exit, VL contains the last components
-*> of all right singular vectors of the bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[out] VLW
-*> \verbatim
-*> VLW is REAL array, dimension ( M )
-*> Workspace for VL.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> Contains the diagonal element associated with the added row.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> Contains the off-diagonal element associated with the added
-*> row.
-*> \endverbatim
-*>
-*> \param[out] DSIGMA
-*> \verbatim
-*> DSIGMA is REAL array, dimension ( N )
-*> Contains a copy of the diagonal elements (K-1 singular values
-*> and one zero) in the secular equation.
-*> \endverbatim
-*>
-*> \param[out] IDX
-*> \verbatim
-*> IDX is INTEGER array, dimension ( N )
-*> This will contain the permutation used to sort the contents of
-*> D into ascending order.
-*> \endverbatim
-*>
-*> \param[out] IDXP
-*> \verbatim
-*> IDXP is INTEGER array, dimension ( N )
-*> This will contain the permutation used to place deflated
-*> values of D at the end of the array. On output IDXP(2:K)
-*> points to the nondeflated D-values and IDXP(K+1:N)
-*> points to the deflated singular values.
-*> \endverbatim
-*>
-*> \param[in] IDXQ
-*> \verbatim
-*> IDXQ is INTEGER array, dimension ( N )
-*> This contains the permutation which separately sorts the two
-*> sub-problems in D into ascending order. Note that entries in
-*> the first half of this permutation must first be moved one
-*> position backward; and entries in the second half
-*> must first have NL+1 added to their values.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( N )
-*> The permutations (from deflation and sorting) to be applied
-*> to each singular block. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER
-*> The number of Givens rotations which took place in this
-*> subproblem. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
-*> Each pair of numbers indicates a pair of columns to take place
-*> in a Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER
-*> The leading dimension of GIVCOL, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array, dimension ( LDGNUM, 2 )
-*> Each number indicates the C or S value to be used in the
-*> corresponding Givens rotation. Not referenced if ICOMPQ = 0.
-*> \endverbatim
-*>
-*> \param[in] LDGNUM
-*> \verbatim
-*> LDGNUM is INTEGER
-*> The leading dimension of GIVNUM, must be at least N.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL
-*> C contains garbage if SQRE =0 and the C-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL
-*> S contains garbage if SQRE =0 and the S-value of a Givens
-*> rotation related to the right null space if SQRE = 1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL,
- $ VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ,
- $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
- $ C, S, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
- $ NR, SQRE
- REAL ALPHA, BETA, C, S
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), IDX( * ), IDXP( * ),
- $ IDXQ( * ), PERM( * )
- REAL D( * ), DSIGMA( * ), GIVNUM( LDGNUM, * ),
- $ VF( * ), VFW( * ), VL( * ), VLW( * ), Z( * ),
- $ ZW( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, EIGHT
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
- $ EIGHT = 8.0E+0 )
-* ..
-* .. Local Scalars ..
-*
- INTEGER I, IDXI, IDXJ, IDXJP, J, JP, JPREV, K2, M, N,
- $ NLP1, NLP2
- REAL EPS, HLFTOL, TAU, TOL, Z1
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAMRG, SROT, XERBLA
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLAPY2
- EXTERNAL SLAMCH, SLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- N = NL + NR + 1
- M = N + SQRE
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( NL.LT.1 ) THEN
- INFO = -2
- ELSE IF( NR.LT.1 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -22
- ELSE IF( LDGNUM.LT.N ) THEN
- INFO = -24
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD7', -INFO )
- RETURN
- END IF
-*
- NLP1 = NL + 1
- NLP2 = NL + 2
- IF( ICOMPQ.EQ.1 ) THEN
- GIVPTR = 0
- END IF
-*
-* Generate the first part of the vector Z and move the singular
-* values in the first part of D one position backward.
-*
- Z1 = ALPHA*VL( NLP1 )
- VL( NLP1 ) = ZERO
- TAU = VF( NLP1 )
- DO 10 I = NL, 1, -1
- Z( I+1 ) = ALPHA*VL( I )
- VL( I ) = ZERO
- VF( I+1 ) = VF( I )
- D( I+1 ) = D( I )
- IDXQ( I+1 ) = IDXQ( I ) + 1
- 10 CONTINUE
- VF( 1 ) = TAU
-*
-* Generate the second part of the vector Z.
-*
- DO 20 I = NLP2, M
- Z( I ) = BETA*VF( I )
- VF( I ) = ZERO
- 20 CONTINUE
-*
-* Sort the singular values into increasing order
-*
- DO 30 I = NLP2, N
- IDXQ( I ) = IDXQ( I ) + NLP1
- 30 CONTINUE
-*
-* DSIGMA, IDXC, IDXC, and ZW are used as storage space.
-*
- DO 40 I = 2, N
- DSIGMA( I ) = D( IDXQ( I ) )
- ZW( I ) = Z( IDXQ( I ) )
- VFW( I ) = VF( IDXQ( I ) )
- VLW( I ) = VL( IDXQ( I ) )
- 40 CONTINUE
-*
- CALL SLAMRG( NL, NR, DSIGMA( 2 ), 1, 1, IDX( 2 ) )
-*
- DO 50 I = 2, N
- IDXI = 1 + IDX( I )
- D( I ) = DSIGMA( IDXI )
- Z( I ) = ZW( IDXI )
- VF( I ) = VFW( IDXI )
- VL( I ) = VLW( IDXI )
- 50 CONTINUE
-*
-* Calculate the allowable deflation tolerence
-*
- EPS = SLAMCH( 'Epsilon' )
- TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
- TOL = EIGHT*EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
-*
-* There are 2 kinds of deflation -- first a value in the z-vector
-* is small, second two (or more) singular values are very close
-* together (their difference is small).
-*
-* If the value in the z-vector is small, we simply permute the
-* array so that the corresponding singular value is moved to the
-* end.
-*
-* If two values in the D-vector are close, we perform a two-sided
-* rotation designed to make one of the corresponding z-vector
-* entries zero, and then permute the array so that the deflated
-* singular value is moved to the end.
-*
-* If there are multiple singular values then the problem deflates.
-* Here the number of equal singular values are found. As each equal
-* singular value is found, an elementary reflector is computed to
-* rotate the corresponding singular subspace so that the
-* corresponding components of Z are zero in this new basis.
-*
- K = 1
- K2 = N + 1
- DO 60 J = 2, N
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- IF( J.EQ.N )
- $ GO TO 100
- ELSE
- JPREV = J
- GO TO 70
- END IF
- 60 CONTINUE
- 70 CONTINUE
- J = JPREV
- 80 CONTINUE
- J = J + 1
- IF( J.GT.N )
- $ GO TO 90
- IF( ABS( Z( J ) ).LE.TOL ) THEN
-*
-* Deflate due to small z component.
-*
- K2 = K2 - 1
- IDXP( K2 ) = J
- ELSE
-*
-* Check if singular values are close enough to allow deflation.
-*
- IF( ABS( D( J )-D( JPREV ) ).LE.TOL ) THEN
-*
-* Deflation is possible.
-*
- S = Z( JPREV )
- C = Z( J )
-*
-* Find sqrt(a**2+b**2) without overflow or
-* destructive underflow.
-*
- TAU = SLAPY2( C, S )
- Z( J ) = TAU
- Z( JPREV ) = ZERO
- C = C / TAU
- S = -S / TAU
-*
-* Record the appropriate Givens rotation
-*
- IF( ICOMPQ.EQ.1 ) THEN
- GIVPTR = GIVPTR + 1
- IDXJP = IDXQ( IDX( JPREV )+1 )
- IDXJ = IDXQ( IDX( J )+1 )
- IF( IDXJP.LE.NLP1 ) THEN
- IDXJP = IDXJP - 1
- END IF
- IF( IDXJ.LE.NLP1 ) THEN
- IDXJ = IDXJ - 1
- END IF
- GIVCOL( GIVPTR, 2 ) = IDXJP
- GIVCOL( GIVPTR, 1 ) = IDXJ
- GIVNUM( GIVPTR, 2 ) = C
- GIVNUM( GIVPTR, 1 ) = S
- END IF
- CALL SROT( 1, VF( JPREV ), 1, VF( J ), 1, C, S )
- CALL SROT( 1, VL( JPREV ), 1, VL( J ), 1, C, S )
- K2 = K2 - 1
- IDXP( K2 ) = JPREV
- JPREV = J
- ELSE
- K = K + 1
- ZW( K ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
- JPREV = J
- END IF
- END IF
- GO TO 80
- 90 CONTINUE
-*
-* Record the last singular value.
-*
- K = K + 1
- ZW( K ) = Z( JPREV )
- DSIGMA( K ) = D( JPREV )
- IDXP( K ) = JPREV
-*
- 100 CONTINUE
-*
-* Sort the singular values into DSIGMA. The singular values which
-* were not deflated go into the first K slots of DSIGMA, except
-* that DSIGMA(1) is treated separately.
-*
- DO 110 J = 2, N
- JP = IDXP( J )
- DSIGMA( J ) = D( JP )
- VFW( J ) = VF( JP )
- VLW( J ) = VL( JP )
- 110 CONTINUE
- IF( ICOMPQ.EQ.1 ) THEN
- DO 120 J = 2, N
- JP = IDXP( J )
- PERM( J ) = IDXQ( IDX( JP )+1 )
- IF( PERM( J ).LE.NLP1 ) THEN
- PERM( J ) = PERM( J ) - 1
- END IF
- 120 CONTINUE
- END IF
-*
-* The deflated singular values go back into the last N - K slots of
-* D.
-*
- CALL SCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
-*
-* Determine DSIGMA(1), DSIGMA(2), Z(1), VF(1), VL(1), VF(M), and
-* VL(M).
-*
- DSIGMA( 1 ) = ZERO
- HLFTOL = TOL / TWO
- IF( ABS( DSIGMA( 2 ) ).LE.HLFTOL )
- $ DSIGMA( 2 ) = HLFTOL
- IF( M.GT.N ) THEN
- Z( 1 ) = SLAPY2( Z1, Z( M ) )
- IF( Z( 1 ).LE.TOL ) THEN
- C = ONE
- S = ZERO
- Z( 1 ) = TOL
- ELSE
- C = Z1 / Z( 1 )
- S = -Z( M ) / Z( 1 )
- END IF
- CALL SROT( 1, VF( M ), 1, VF( 1 ), 1, C, S )
- CALL SROT( 1, VL( M ), 1, VL( 1 ), 1, C, S )
- ELSE
- IF( ABS( Z1 ).LE.TOL ) THEN
- Z( 1 ) = TOL
- ELSE
- Z( 1 ) = Z1
- END IF
- END IF
-*
-* Restore Z, VF, and VL.
-*
- CALL SCOPY( K-1, ZW( 2 ), 1, Z( 2 ), 1 )
- CALL SCOPY( N-1, VFW( 2 ), 1, VF( 2 ), 1 )
- CALL SCOPY( N-1, VLW( 2 ), 1, VL( 2 ), 1 )
-*
- RETURN
-*
-* End of SLASD7
-*
- END
diff --git a/netlib/LAPACK/slasd8.f b/netlib/LAPACK/slasd8.f
deleted file mode 100644
index c80d7cd..0000000
--- a/netlib/LAPACK/slasd8.f
+++ /dev/null
@@ -1,343 +0,0 @@
-*> \brief \b SLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASD8 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd8.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd8.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd8.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
-* DSIGMA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, K, LDDIFR
-* ..
-* .. Array Arguments ..
-* REAL D( * ), DIFL( * ), DIFR( LDDIFR, * ),
-* $ DSIGMA( * ), VF( * ), VL( * ), WORK( * ),
-* $ Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASD8 finds the square roots of the roots of the secular equation,
-*> as defined by the values in DSIGMA and Z. It makes the appropriate
-*> calls to SLASD4, and stores, for each element in D, the distance
-*> to its two nearest poles (elements in DSIGMA). It also updates
-*> the arrays VF and VL, the first and last components of all the
-*> right singular vectors of the original bidiagonal matrix.
-*>
-*> SLASD8 is called from SLASD6.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed in
-*> factored form in the calling routine:
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors in factored form as well.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of terms in the rational function to be solved
-*> by SLASD4. K >= 1.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension ( K )
-*> On output, D contains the updated singular values.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension ( K )
-*> On entry, the first K elements of this array contain the
-*> components of the deflation-adjusted updating row vector.
-*> On exit, Z is updated.
-*> \endverbatim
-*>
-*> \param[in,out] VF
-*> \verbatim
-*> VF is REAL array, dimension ( K )
-*> On entry, VF contains information passed through DBEDE8.
-*> On exit, VF contains the first K components of the first
-*> components of all right singular vectors of the bidiagonal
-*> matrix.
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL array, dimension ( K )
-*> On entry, VL contains information passed through DBEDE8.
-*> On exit, VL contains the first K components of the last
-*> components of all right singular vectors of the bidiagonal
-*> matrix.
-*> \endverbatim
-*>
-*> \param[out] DIFL
-*> \verbatim
-*> DIFL is REAL array, dimension ( K )
-*> On exit, DIFL(I) = D(I) - DSIGMA(I).
-*> \endverbatim
-*>
-*> \param[out] DIFR
-*> \verbatim
-*> DIFR is REAL array,
-*> dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
-*> dimension ( K ) if ICOMPQ = 0.
-*> On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
-*> defined and will not be referenced.
-*>
-*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
-*> normalizing factors for the right singular vector matrix.
-*> \endverbatim
-*>
-*> \param[in] LDDIFR
-*> \verbatim
-*> LDDIFR is INTEGER
-*> The leading dimension of DIFR, must be at least K.
-*> \endverbatim
-*>
-*> \param[in,out] DSIGMA
-*> \verbatim
-*> DSIGMA is REAL array, dimension ( K )
-*> On entry, the first K elements of this array contain the old
-*> roots of the deflated updating problem. These are the poles
-*> of the secular equation.
-*> On exit, the elements of DSIGMA may be very slightly altered
-*> in value.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension at least 3 * K
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
- $ DSIGMA, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, K, LDDIFR
-* ..
-* .. Array Arguments ..
- REAL D( * ), DIFL( * ), DIFR( LDDIFR, * ),
- $ DSIGMA( * ), VF( * ), VL( * ), WORK( * ),
- $ Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IWK1, IWK2, IWK2I, IWK3, IWK3I, J
- REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLASCL, SLASD4, SLASET, XERBLA
-* ..
-* .. External Functions ..
- REAL SDOT, SLAMC3, SNRM2
- EXTERNAL SDOT, SLAMC3, SNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( K.LT.1 ) THEN
- INFO = -2
- ELSE IF( LDDIFR.LT.K ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD8', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( K.EQ.1 ) THEN
- D( 1 ) = ABS( Z( 1 ) )
- DIFL( 1 ) = D( 1 )
- IF( ICOMPQ.EQ.1 ) THEN
- DIFL( 2 ) = ONE
- DIFR( 1, 2 ) = ONE
- END IF
- RETURN
- END IF
-*
-* Modify values DSIGMA(i) to make sure all DSIGMA(i)-DSIGMA(j) can
-* be computed with high relative accuracy (barring over/underflow).
-* This is a problem on machines without a guard digit in
-* add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
-* The following code replaces DSIGMA(I) by 2*DSIGMA(I)-DSIGMA(I),
-* which on any of these machines zeros out the bottommost
-* bit of DSIGMA(I) if it is 1; this makes the subsequent
-* subtractions DSIGMA(I)-DSIGMA(J) unproblematic when cancellation
-* occurs. On binary machines with a guard digit (almost all
-* machines) it does not change DSIGMA(I) at all. On hexadecimal
-* and decimal machines with a guard digit, it slightly
-* changes the bottommost bits of DSIGMA(I). It does not account
-* for hexadecimal or decimal machines without guard digits
-* (we know of none). We use a subroutine call to compute
-* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
-* this code.
-*
- DO 10 I = 1, K
- DSIGMA( I ) = SLAMC3( DSIGMA( I ), DSIGMA( I ) ) - DSIGMA( I )
- 10 CONTINUE
-*
-* Book keeping.
-*
- IWK1 = 1
- IWK2 = IWK1 + K
- IWK3 = IWK2 + K
- IWK2I = IWK2 - 1
- IWK3I = IWK3 - 1
-*
-* Normalize Z.
-*
- RHO = SNRM2( K, Z, 1 )
- CALL SLASCL( 'G', 0, 0, RHO, ONE, K, 1, Z, K, INFO )
- RHO = RHO*RHO
-*
-* Initialize WORK(IWK3).
-*
- CALL SLASET( 'A', K, 1, ONE, ONE, WORK( IWK3 ), K )
-*
-* Compute the updated singular values, the arrays DIFL, DIFR,
-* and the updated Z.
-*
- DO 40 J = 1, K
- CALL SLASD4( K, J, DSIGMA, Z, WORK( IWK1 ), RHO, D( J ),
- $ WORK( IWK2 ), INFO )
-*
-* If the root finder fails, the computation is terminated.
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASD4', -INFO )
- RETURN
- END IF
- WORK( IWK3I+J ) = WORK( IWK3I+J )*WORK( J )*WORK( IWK2I+J )
- DIFL( J ) = -WORK( J )
- DIFR( J, 1 ) = -WORK( J+1 )
- DO 20 I = 1, J - 1
- WORK( IWK3I+I ) = WORK( IWK3I+I )*WORK( I )*
- $ WORK( IWK2I+I ) / ( DSIGMA( I )-
- $ DSIGMA( J ) ) / ( DSIGMA( I )+
- $ DSIGMA( J ) )
- 20 CONTINUE
- DO 30 I = J + 1, K
- WORK( IWK3I+I ) = WORK( IWK3I+I )*WORK( I )*
- $ WORK( IWK2I+I ) / ( DSIGMA( I )-
- $ DSIGMA( J ) ) / ( DSIGMA( I )+
- $ DSIGMA( J ) )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Compute updated Z.
-*
- DO 50 I = 1, K
- Z( I ) = SIGN( SQRT( ABS( WORK( IWK3I+I ) ) ), Z( I ) )
- 50 CONTINUE
-*
-* Update VF and VL.
-*
- DO 80 J = 1, K
- DIFLJ = DIFL( J )
- DJ = D( J )
- DSIGJ = -DSIGMA( J )
- IF( J.LT.K ) THEN
- DIFRJ = -DIFR( J, 1 )
- DSIGJP = -DSIGMA( J+1 )
- END IF
- WORK( J ) = -Z( J ) / DIFLJ / ( DSIGMA( J )+DJ )
- DO 60 I = 1, J - 1
- WORK( I ) = Z( I ) / ( SLAMC3( DSIGMA( I ), DSIGJ )-DIFLJ )
- $ / ( DSIGMA( I )+DJ )
- 60 CONTINUE
- DO 70 I = J + 1, K
- WORK( I ) = Z( I ) / ( SLAMC3( DSIGMA( I ), DSIGJP )+DIFRJ )
- $ / ( DSIGMA( I )+DJ )
- 70 CONTINUE
- TEMP = SNRM2( K, WORK, 1 )
- WORK( IWK2I+J ) = SDOT( K, WORK, 1, VF, 1 ) / TEMP
- WORK( IWK3I+J ) = SDOT( K, WORK, 1, VL, 1 ) / TEMP
- IF( ICOMPQ.EQ.1 ) THEN
- DIFR( J, 2 ) = TEMP
- END IF
- 80 CONTINUE
-*
- CALL SCOPY( K, WORK( IWK2 ), 1, VF, 1 )
- CALL SCOPY( K, WORK( IWK3 ), 1, VL, 1 )
-*
- RETURN
-*
-* End of SLASD8
-*
- END
-
diff --git a/netlib/LAPACK/slasda.f b/netlib/LAPACK/slasda.f
deleted file mode 100644
index c6d69cb..0000000
--- a/netlib/LAPACK/slasda.f
+++ /dev/null
@@ -1,514 +0,0 @@
-*> \brief \b SLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASDA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasda.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasda.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasda.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K,
-* DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL,
-* PERM, GIVNUM, C, S, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
-* INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
-* $ K( * ), PERM( LDGCOL, * )
-* REAL C( * ), D( * ), DIFL( LDU, * ), DIFR( LDU, * ),
-* $ E( * ), GIVNUM( LDU, * ), POLES( LDU, * ),
-* $ S( * ), U( LDU, * ), VT( LDU, * ), WORK( * ),
-* $ Z( LDU, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Using a divide and conquer approach, SLASDA computes the singular
-*> value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
-*> B with diagonal D and offdiagonal E, where M = N + SQRE. The
-*> algorithm computes the singular values in the SVD B = U * S * VT.
-*> The orthogonal matrices U and VT are optionally computed in
-*> compact form.
-*>
-*> A related subroutine, SLASD0, computes the singular values and
-*> the singular vectors in explicit form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ICOMPQ
-*> \verbatim
-*> ICOMPQ is INTEGER
-*> Specifies whether singular vectors are to be computed
-*> in compact form, as follows
-*> = 0: Compute singular values only.
-*> = 1: Compute singular vectors of upper bidiagonal
-*> matrix in compact form.
-*> \endverbatim
-*>
-*> \param[in] SMLSIZ
-*> \verbatim
-*> SMLSIZ is INTEGER
-*> The maximum size of the subproblems at the bottom of the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The row dimension of the upper bidiagonal matrix. This is
-*> also the dimension of the main diagonal array D.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> Specifies the column dimension of the bidiagonal matrix.
-*> = 0: The bidiagonal matrix has column dimension M = N;
-*> = 1: The bidiagonal matrix has column dimension M = N + 1.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension ( N )
-*> On entry D contains the main diagonal of the bidiagonal
-*> matrix. On exit D, if INFO = 0, contains its singular values.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension ( M-1 )
-*> Contains the subdiagonal entries of the bidiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is REAL array,
-*> dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
-*> singular vector matrices of all subproblems at the bottom
-*> level.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER, LDU = > N.
-*> The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
-*> GIVNUM, and Z.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is REAL array,
-*> dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT**T contains the right
-*> singular vector matrices of all subproblems at the bottom
-*> level.
-*> \endverbatim
-*>
-*> \param[out] K
-*> \verbatim
-*> K is INTEGER array, dimension ( N )
-*> if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
-*> If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
-*> secular equation on the computation tree.
-*> \endverbatim
-*>
-*> \param[out] DIFL
-*> \verbatim
-*> DIFL is REAL array, dimension ( LDU, NLVL ),
-*> where NLVL = floor(log_2 (N/SMLSIZ))).
-*> \endverbatim
-*>
-*> \param[out] DIFR
-*> \verbatim
-*> DIFR is REAL array,
-*> dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
-*> dimension ( N ) if ICOMPQ = 0.
-*> If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
-*> record distances between singular values on the I-th
-*> level and singular values on the (I -1)-th level, and
-*> DIFR(1:N, 2 * I ) contains the normalizing factors for
-*> the right singular vector matrix. See SLASD8 for details.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array,
-*> dimension ( LDU, NLVL ) if ICOMPQ = 1 and
-*> dimension ( N ) if ICOMPQ = 0.
-*> The first K elements of Z(1, I) contain the components of
-*> the deflation-adjusted updating row vector for subproblems
-*> on the I-th level.
-*> \endverbatim
-*>
-*> \param[out] POLES
-*> \verbatim
-*> POLES is REAL array,
-*> dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
-*> POLES(1, 2*I) contain the new and old singular values
-*> involved in the secular equations on the I-th level.
-*> \endverbatim
-*>
-*> \param[out] GIVPTR
-*> \verbatim
-*> GIVPTR is INTEGER array,
-*> dimension ( N ) if ICOMPQ = 1, and not referenced if
-*> ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
-*> the number of Givens rotations performed on the I-th
-*> problem on the computation tree.
-*> \endverbatim
-*>
-*> \param[out] GIVCOL
-*> \verbatim
-*> GIVCOL is INTEGER array,
-*> dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
-*> referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
-*> GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
-*> of Givens rotations performed on the I-th level on the
-*> computation tree.
-*> \endverbatim
-*>
-*> \param[in] LDGCOL
-*> \verbatim
-*> LDGCOL is INTEGER, LDGCOL = > N.
-*> The leading dimension of arrays GIVCOL and PERM.
-*> \endverbatim
-*>
-*> \param[out] PERM
-*> \verbatim
-*> PERM is INTEGER array, dimension ( LDGCOL, NLVL )
-*> if ICOMPQ = 1, and not referenced
-*> if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
-*> permutations done on the I-th level of the computation tree.
-*> \endverbatim
-*>
-*> \param[out] GIVNUM
-*> \verbatim
-*> GIVNUM is REAL array,
-*> dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
-*> referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
-*> GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
-*> values of Givens rotations performed on the I-th level on
-*> the computation tree.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array,
-*> dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
-*> If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
-*> C( I ) contains the C-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension ( N ) if
-*> ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
-*> and the I-th subproblem is not square, on exit, S( I )
-*> contains the S-value of a Givens rotation related to
-*> the right null space of the I-th subproblem.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (7*N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = 1, a singular value did not converge
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K,
- $ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL,
- $ PERM, GIVNUM, C, S, WORK, IWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
-* ..
-* .. Array Arguments ..
- INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
- $ K( * ), PERM( LDGCOL, * )
- REAL C( * ), D( * ), DIFL( LDU, * ), DIFR( LDU, * ),
- $ E( * ), GIVNUM( LDU, * ), POLES( LDU, * ),
- $ S( * ), U( LDU, * ), VT( LDU, * ), WORK( * ),
- $ Z( LDU, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I1, IC, IDXQ, IDXQI, IM1, INODE, ITEMP, IWK,
- $ J, LF, LL, LVL, LVL2, M, NCC, ND, NDB1, NDIML,
- $ NDIMR, NL, NLF, NLP1, NLVL, NR, NRF, NRP1, NRU,
- $ NWORK1, NWORK2, SMLSZP, SQREI, VF, VFI, VL, VLI
- REAL ALPHA, BETA
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLASD6, SLASDQ, SLASDT, SLASET, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
- INFO = -1
- ELSE IF( SMLSIZ.LT.3 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -4
- ELSE IF( LDU.LT.( N+SQRE ) ) THEN
- INFO = -8
- ELSE IF( LDGCOL.LT.N ) THEN
- INFO = -17
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASDA', -INFO )
- RETURN
- END IF
-*
- M = N + SQRE
-*
-* If the input matrix is too small, call SLASDQ to find the SVD.
-*
- IF( N.LE.SMLSIZ ) THEN
- IF( ICOMPQ.EQ.0 ) THEN
- CALL SLASDQ( 'U', SQRE, N, 0, 0, 0, D, E, VT, LDU, U, LDU,
- $ U, LDU, WORK, INFO )
- ELSE
- CALL SLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDU, U, LDU,
- $ U, LDU, WORK, INFO )
- END IF
- RETURN
- END IF
-*
-* Book-keeping and set up the computation tree.
-*
- INODE = 1
- NDIML = INODE + N
- NDIMR = NDIML + N
- IDXQ = NDIMR + N
- IWK = IDXQ + N
-*
- NCC = 0
- NRU = 0
-*
- SMLSZP = SMLSIZ + 1
- VF = 1
- VL = VF + M
- NWORK1 = VL + M
- NWORK2 = NWORK1 + SMLSZP*SMLSZP
-*
- CALL SLASDT( N, NLVL, ND, IWORK( INODE ), IWORK( NDIML ),
- $ IWORK( NDIMR ), SMLSIZ )
-*
-* for the nodes on bottom level of the tree, solve
-* their subproblems by SLASDQ.
-*
- NDB1 = ( ND+1 ) / 2
- DO 30 I = NDB1, ND
-*
-* IC : center row of each node
-* NL : number of rows of left subproblem
-* NR : number of rows of right subproblem
-* NLF: starting row of the left subproblem
-* NRF: starting row of the right subproblem
-*
- I1 = I - 1
- IC = IWORK( INODE+I1 )
- NL = IWORK( NDIML+I1 )
- NLP1 = NL + 1
- NR = IWORK( NDIMR+I1 )
- NLF = IC - NL
- NRF = IC + 1
- IDXQI = IDXQ + NLF - 2
- VFI = VF + NLF - 1
- VLI = VL + NLF - 1
- SQREI = 1
- IF( ICOMPQ.EQ.0 ) THEN
- CALL SLASET( 'A', NLP1, NLP1, ZERO, ONE, WORK( NWORK1 ),
- $ SMLSZP )
- CALL SLASDQ( 'U', SQREI, NL, NLP1, NRU, NCC, D( NLF ),
- $ E( NLF ), WORK( NWORK1 ), SMLSZP,
- $ WORK( NWORK2 ), NL, WORK( NWORK2 ), NL,
- $ WORK( NWORK2 ), INFO )
- ITEMP = NWORK1 + NL*SMLSZP
- CALL SCOPY( NLP1, WORK( NWORK1 ), 1, WORK( VFI ), 1 )
- CALL SCOPY( NLP1, WORK( ITEMP ), 1, WORK( VLI ), 1 )
- ELSE
- CALL SLASET( 'A', NL, NL, ZERO, ONE, U( NLF, 1 ), LDU )
- CALL SLASET( 'A', NLP1, NLP1, ZERO, ONE, VT( NLF, 1 ), LDU )
- CALL SLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ),
- $ E( NLF ), VT( NLF, 1 ), LDU, U( NLF, 1 ), LDU,
- $ U( NLF, 1 ), LDU, WORK( NWORK1 ), INFO )
- CALL SCOPY( NLP1, VT( NLF, 1 ), 1, WORK( VFI ), 1 )
- CALL SCOPY( NLP1, VT( NLF, NLP1 ), 1, WORK( VLI ), 1 )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- DO 10 J = 1, NL
- IWORK( IDXQI+J ) = J
- 10 CONTINUE
- IF( ( I.EQ.ND ) .AND. ( SQRE.EQ.0 ) ) THEN
- SQREI = 0
- ELSE
- SQREI = 1
- END IF
- IDXQI = IDXQI + NLP1
- VFI = VFI + NLP1
- VLI = VLI + NLP1
- NRP1 = NR + SQREI
- IF( ICOMPQ.EQ.0 ) THEN
- CALL SLASET( 'A', NRP1, NRP1, ZERO, ONE, WORK( NWORK1 ),
- $ SMLSZP )
- CALL SLASDQ( 'U', SQREI, NR, NRP1, NRU, NCC, D( NRF ),
- $ E( NRF ), WORK( NWORK1 ), SMLSZP,
- $ WORK( NWORK2 ), NR, WORK( NWORK2 ), NR,
- $ WORK( NWORK2 ), INFO )
- ITEMP = NWORK1 + ( NRP1-1 )*SMLSZP
- CALL SCOPY( NRP1, WORK( NWORK1 ), 1, WORK( VFI ), 1 )
- CALL SCOPY( NRP1, WORK( ITEMP ), 1, WORK( VLI ), 1 )
- ELSE
- CALL SLASET( 'A', NR, NR, ZERO, ONE, U( NRF, 1 ), LDU )
- CALL SLASET( 'A', NRP1, NRP1, ZERO, ONE, VT( NRF, 1 ), LDU )
- CALL SLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ),
- $ E( NRF ), VT( NRF, 1 ), LDU, U( NRF, 1 ), LDU,
- $ U( NRF, 1 ), LDU, WORK( NWORK1 ), INFO )
- CALL SCOPY( NRP1, VT( NRF, 1 ), 1, WORK( VFI ), 1 )
- CALL SCOPY( NRP1, VT( NRF, NRP1 ), 1, WORK( VLI ), 1 )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- DO 20 J = 1, NR
- IWORK( IDXQI+J ) = J
- 20 CONTINUE
- 30 CONTINUE
-*
-* Now conquer each subproblem bottom-up.
-*
- J = 2**NLVL
- DO 50 LVL = NLVL, 1, -1
- LVL2 = LVL*2 - 1
-*
-* Find the first node LF and last node LL on
-* the current level LVL.
-*
- IF( LVL.EQ.1 ) THEN
- LF = 1
- LL = 1
- ELSE
- LF = 2**( LVL-1 )
- LL = 2*LF - 1
- END IF
- DO 40 I = LF, LL
- IM1 = I - 1
- IC = IWORK( INODE+IM1 )
- NL = IWORK( NDIML+IM1 )
- NR = IWORK( NDIMR+IM1 )
- NLF = IC - NL
- NRF = IC + 1
- IF( I.EQ.LL ) THEN
- SQREI = SQRE
- ELSE
- SQREI = 1
- END IF
- VFI = VF + NLF - 1
- VLI = VL + NLF - 1
- IDXQI = IDXQ + NLF - 1
- ALPHA = D( IC )
- BETA = E( IC )
- IF( ICOMPQ.EQ.0 ) THEN
- CALL SLASD6( ICOMPQ, NL, NR, SQREI, D( NLF ),
- $ WORK( VFI ), WORK( VLI ), ALPHA, BETA,
- $ IWORK( IDXQI ), PERM, GIVPTR( 1 ), GIVCOL,
- $ LDGCOL, GIVNUM, LDU, POLES, DIFL, DIFR, Z,
- $ K( 1 ), C( 1 ), S( 1 ), WORK( NWORK1 ),
- $ IWORK( IWK ), INFO )
- ELSE
- J = J - 1
- CALL SLASD6( ICOMPQ, NL, NR, SQREI, D( NLF ),
- $ WORK( VFI ), WORK( VLI ), ALPHA, BETA,
- $ IWORK( IDXQI ), PERM( NLF, LVL ),
- $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
- $ GIVNUM( NLF, LVL2 ), LDU,
- $ POLES( NLF, LVL2 ), DIFL( NLF, LVL ),
- $ DIFR( NLF, LVL2 ), Z( NLF, LVL ), K( J ),
- $ C( J ), S( J ), WORK( NWORK1 ),
- $ IWORK( IWK ), INFO )
- END IF
- IF( INFO.NE.0 ) THEN
- RETURN
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of SLASDA
-*
- END
diff --git a/netlib/LAPACK/slasdq.f b/netlib/LAPACK/slasdq.f
deleted file mode 100644
index 289ed85..0000000
--- a/netlib/LAPACK/slasdq.f
+++ /dev/null
@@ -1,413 +0,0 @@
-*> \brief \b SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASDQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasdq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasdq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasdq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
-* U, LDU, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
-* ..
-* .. Array Arguments ..
-* REAL C( LDC, * ), D( * ), E( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASDQ computes the singular value decomposition (SVD) of a real
-*> (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
-*> E, accumulating the transformations if desired. Letting B denote
-*> the input bidiagonal matrix, the algorithm computes orthogonal
-*> matrices Q and P such that B = Q * S * P**T (P**T denotes the transpose
-*> of P). The singular values S are overwritten on D.
-*>
-*> The input matrix U is changed to U * Q if desired.
-*> The input matrix VT is changed to P**T * VT if desired.
-*> The input matrix C is changed to Q**T * C if desired.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices With
-*> Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
-*> LAPACK Working Note #3, for a detailed description of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the input bidiagonal matrix
-*> is upper or lower bidiagonal, and wether it is square are
-*> not.
-*> UPLO = 'U' or 'u' B is upper bidiagonal.
-*> UPLO = 'L' or 'l' B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] SQRE
-*> \verbatim
-*> SQRE is INTEGER
-*> = 0: then the input matrix is N-by-N.
-*> = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
-*> (N+1)-by-N if UPLU = 'L'.
-*>
-*> The bidiagonal matrix has
-*> N = NL + NR + 1 rows and
-*> M = N + SQRE >= N columns.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of rows and columns
-*> in the matrix. N must be at least 0.
-*> \endverbatim
-*>
-*> \param[in] NCVT
-*> \verbatim
-*> NCVT is INTEGER
-*> On entry, NCVT specifies the number of columns of
-*> the matrix VT. NCVT must be at least 0.
-*> \endverbatim
-*>
-*> \param[in] NRU
-*> \verbatim
-*> NRU is INTEGER
-*> On entry, NRU specifies the number of rows of
-*> the matrix U. NRU must be at least 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> On entry, NCC specifies the number of columns of
-*> the matrix C. NCC must be at least 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, D contains the diagonal entries of the
-*> bidiagonal matrix whose SVD is desired. On normal exit,
-*> D contains the singular values in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array.
-*> dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
-*> On entry, the entries of E contain the offdiagonal entries
-*> of the bidiagonal matrix whose SVD is desired. On normal
-*> exit, E will contain 0. If the algorithm does not converge,
-*> D and E will contain the diagonal and superdiagonal entries
-*> of a bidiagonal matrix orthogonally equivalent to the one
-*> given as input.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is REAL array, dimension (LDVT, NCVT)
-*> On entry, contains a matrix which on exit has been
-*> premultiplied by P**T, dimension N-by-NCVT if SQRE = 0
-*> and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> On entry, LDVT specifies the leading dimension of VT as
-*> declared in the calling (sub) program. LDVT must be at
-*> least 1. If NCVT is nonzero LDVT must also be at least N.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU, N)
-*> On entry, contains a matrix which on exit has been
-*> postmultiplied by Q, dimension NRU-by-N if SQRE = 0
-*> and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> On entry, LDU specifies the leading dimension of U as
-*> declared in the calling (sub) program. LDU must be at
-*> least max( 1, NRU ) .
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC, NCC)
-*> On entry, contains an N-by-NCC matrix which on exit
-*> has been premultiplied by Q**T dimension N-by-NCC if SQRE = 0
-*> and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> On entry, LDC specifies the leading dimension of C as
-*> declared in the calling (sub) program. LDC must be at
-*> least 1. If NCC is nonzero, LDC must also be at least N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> Workspace. Only referenced if one of NCVT, NRU, or NCC is
-*> nonzero, and if N is at least 2.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, a value of 0 indicates a successful exit.
-*> If INFO < 0, argument number -INFO is illegal.
-*> If INFO > 0, the algorithm did not converge, and INFO
-*> specifies how many superdiagonals did not converge.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
- $ U, LDU, C, LDC, WORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
-* ..
-* .. Array Arguments ..
- REAL C( LDC, * ), D( * ), E( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ROTATE
- INTEGER I, ISUB, IUPLO, J, NP1, SQRE1
- REAL CS, R, SMIN, SN
-* ..
-* .. External Subroutines ..
- EXTERNAL SBDSQR, SLARTG, SLASR, SSWAP, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IUPLO = 0
- IF( LSAME( UPLO, 'U' ) )
- $ IUPLO = 1
- IF( LSAME( UPLO, 'L' ) )
- $ IUPLO = 2
- IF( IUPLO.EQ.0 ) THEN
- INFO = -1
- ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NCVT.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRU.LT.0 ) THEN
- INFO = -5
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -6
- ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
- $ ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
- INFO = -10
- ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
- INFO = -12
- ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
- $ ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASDQ', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
-*
-* ROTATE is true if any singular vectors desired, false otherwise
-*
- ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
- NP1 = N + 1
- SQRE1 = SQRE
-*
-* If matrix non-square upper bidiagonal, rotate to be lower
-* bidiagonal. The rotations are on the right.
-*
- IF( ( IUPLO.EQ.1 ) .AND. ( SQRE1.EQ.1 ) ) THEN
- DO 10 I = 1, N - 1
- CALL SLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( ROTATE ) THEN
- WORK( I ) = CS
- WORK( N+I ) = SN
- END IF
- 10 CONTINUE
- CALL SLARTG( D( N ), E( N ), CS, SN, R )
- D( N ) = R
- E( N ) = ZERO
- IF( ROTATE ) THEN
- WORK( N ) = CS
- WORK( N+N ) = SN
- END IF
- IUPLO = 2
- SQRE1 = 0
-*
-* Update singular vectors if desired.
-*
- IF( NCVT.GT.0 )
- $ CALL SLASR( 'L', 'V', 'F', NP1, NCVT, WORK( 1 ),
- $ WORK( NP1 ), VT, LDVT )
- END IF
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left.
-*
- IF( IUPLO.EQ.2 ) THEN
- DO 20 I = 1, N - 1
- CALL SLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- IF( ROTATE ) THEN
- WORK( I ) = CS
- WORK( N+I ) = SN
- END IF
- 20 CONTINUE
-*
-* If matrix (N+1)-by-N lower bidiagonal, one additional
-* rotation is needed.
-*
- IF( SQRE1.EQ.1 ) THEN
- CALL SLARTG( D( N ), E( N ), CS, SN, R )
- D( N ) = R
- IF( ROTATE ) THEN
- WORK( N ) = CS
- WORK( N+N ) = SN
- END IF
- END IF
-*
-* Update singular vectors if desired.
-*
- IF( NRU.GT.0 ) THEN
- IF( SQRE1.EQ.0 ) THEN
- CALL SLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ),
- $ WORK( NP1 ), U, LDU )
- ELSE
- CALL SLASR( 'R', 'V', 'F', NRU, NP1, WORK( 1 ),
- $ WORK( NP1 ), U, LDU )
- END IF
- END IF
- IF( NCC.GT.0 ) THEN
- IF( SQRE1.EQ.0 ) THEN
- CALL SLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ),
- $ WORK( NP1 ), C, LDC )
- ELSE
- CALL SLASR( 'L', 'V', 'F', NP1, NCC, WORK( 1 ),
- $ WORK( NP1 ), C, LDC )
- END IF
- END IF
- END IF
-*
-* Call SBDSQR to compute the SVD of the reduced real
-* N-by-N upper bidiagonal matrix.
-*
- CALL SBDSQR( 'U', N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C,
- $ LDC, WORK, INFO )
-*
-* Sort the singular values into ascending order (insertion sort on
-* singular values, but only one transposition per singular vector)
-*
- DO 40 I = 1, N
-*
-* Scan for smallest D(I).
-*
- ISUB = I
- SMIN = D( I )
- DO 30 J = I + 1, N
- IF( D( J ).LT.SMIN ) THEN
- ISUB = J
- SMIN = D( J )
- END IF
- 30 CONTINUE
- IF( ISUB.NE.I ) THEN
-*
-* Swap singular values and vectors.
-*
- D( ISUB ) = D( I )
- D( I ) = SMIN
- IF( NCVT.GT.0 )
- $ CALL SSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL SSWAP( NRU, U( 1, ISUB ), 1, U( 1, I ), 1 )
- IF( NCC.GT.0 )
- $ CALL SSWAP( NCC, C( ISUB, 1 ), LDC, C( I, 1 ), LDC )
- END IF
- 40 CONTINUE
-*
- RETURN
-*
-* End of SLASDQ
-*
- END
diff --git a/netlib/LAPACK/slasdt.f b/netlib/LAPACK/slasdt.f
deleted file mode 100644
index f67475e..0000000
--- a/netlib/LAPACK/slasdt.f
+++ /dev/null
@@ -1,172 +0,0 @@
-*> \brief \b SLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASDT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasdt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasdt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasdt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB )
-*
-* .. Scalar Arguments ..
-* INTEGER LVL, MSUB, N, ND
-* ..
-* .. Array Arguments ..
-* INTEGER INODE( * ), NDIML( * ), NDIMR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASDT creates a tree of subproblems for bidiagonal divide and
-*> conquer.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, the number of diagonal elements of the
-*> bidiagonal matrix.
-*> \endverbatim
-*>
-*> \param[out] LVL
-*> \verbatim
-*> LVL is INTEGER
-*> On exit, the number of levels on the computation tree.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is INTEGER
-*> On exit, the number of nodes on the tree.
-*> \endverbatim
-*>
-*> \param[out] INODE
-*> \verbatim
-*> INODE is INTEGER array, dimension ( N )
-*> On exit, centers of subproblems.
-*> \endverbatim
-*>
-*> \param[out] NDIML
-*> \verbatim
-*> NDIML is INTEGER array, dimension ( N )
-*> On exit, row dimensions of left children.
-*> \endverbatim
-*>
-*> \param[out] NDIMR
-*> \verbatim
-*> NDIMR is INTEGER array, dimension ( N )
-*> On exit, row dimensions of right children.
-*> \endverbatim
-*>
-*> \param[in] MSUB
-*> \verbatim
-*> MSUB is INTEGER
-*> On entry, the maximum row dimension each subproblem at the
-*> bottom of the tree can be of.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Ming Gu and Huan Ren, Computer Science Division, University of
-*> California at Berkeley, USA
-*>
-* =====================================================================
- SUBROUTINE SLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LVL, MSUB, N, ND
-* ..
-* .. Array Arguments ..
- INTEGER INODE( * ), NDIML( * ), NDIMR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IL, IR, LLST, MAXN, NCRNT, NLVL
- REAL TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC INT, LOG, MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Find the number of levels on the tree.
-*
- MAXN = MAX( 1, N )
- TEMP = LOG( REAL( MAXN ) / REAL( MSUB+1 ) ) / LOG( TWO )
- LVL = INT( TEMP ) + 1
-*
- I = N / 2
- INODE( 1 ) = I + 1
- NDIML( 1 ) = I
- NDIMR( 1 ) = N - I - 1
- IL = 0
- IR = 1
- LLST = 1
- DO 20 NLVL = 1, LVL - 1
-*
-* Constructing the tree at (NLVL+1)-st level. The number of
-* nodes created on this level is LLST * 2.
-*
- DO 10 I = 0, LLST - 1
- IL = IL + 2
- IR = IR + 2
- NCRNT = LLST + I
- NDIML( IL ) = NDIML( NCRNT ) / 2
- NDIMR( IL ) = NDIML( NCRNT ) - NDIML( IL ) - 1
- INODE( IL ) = INODE( NCRNT ) - NDIMR( IL ) - 1
- NDIML( IR ) = NDIMR( NCRNT ) / 2
- NDIMR( IR ) = NDIMR( NCRNT ) - NDIML( IR ) - 1
- INODE( IR ) = INODE( NCRNT ) + NDIML( IR ) + 1
- 10 CONTINUE
- LLST = LLST*2
- 20 CONTINUE
- ND = LLST*2 - 1
-*
- RETURN
-*
-* End of SLASDT
-*
- END
diff --git a/netlib/LAPACK/slaset.f b/netlib/LAPACK/slaset.f
deleted file mode 100644
index 034a3b9..0000000
--- a/netlib/LAPACK/slaset.f
+++ /dev/null
@@ -1,184 +0,0 @@
-*> \brief \b SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASET + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaset.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaset.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaset.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, M, N
-* REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASET initializes an m-by-n matrix A to BETA on the diagonal and
-*> ALPHA on the offdiagonals.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies the part of the matrix A to be set.
-*> = 'U': Upper triangular part is set; the strictly lower
-*> triangular part of A is not changed.
-*> = 'L': Lower triangular part is set; the strictly upper
-*> triangular part of A is not changed.
-*> Otherwise: All of the matrix A is set.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> The constant to which the offdiagonal elements are to be set.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> The constant to which the diagonal elements are to be set.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On exit, the leading m-by-n submatrix of A is set as follows:
-*>
-*> if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
-*> if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
-*> otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
-*>
-*> and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, M, N
- REAL ALPHA, BETA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Set the strictly upper triangular or trapezoidal part of the
-* array to ALPHA.
-*
- DO 20 J = 2, N
- DO 10 I = 1, MIN( J-1, M )
- A( I, J ) = ALPHA
- 10 CONTINUE
- 20 CONTINUE
-*
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-*
-* Set the strictly lower triangular or trapezoidal part of the
-* array to ALPHA.
-*
- DO 40 J = 1, MIN( M, N )
- DO 30 I = J + 1, M
- A( I, J ) = ALPHA
- 30 CONTINUE
- 40 CONTINUE
-*
- ELSE
-*
-* Set the leading m-by-n submatrix to ALPHA.
-*
- DO 60 J = 1, N
- DO 50 I = 1, M
- A( I, J ) = ALPHA
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* Set the first min(M,N) diagonal elements to BETA.
-*
- DO 70 I = 1, MIN( M, N )
- A( I, I ) = BETA
- 70 CONTINUE
-*
- RETURN
-*
-* End of SLASET
-*
- END
diff --git a/netlib/LAPACK/slasq1.f b/netlib/LAPACK/slasq1.f
deleted file mode 100644
index 21a1c57..0000000
--- a/netlib/LAPACK/slasq1.f
+++ /dev/null
@@ -1,224 +0,0 @@
-*> \brief \b SLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASQ1 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq1.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq1.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq1.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASQ1( N, D, E, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASQ1 computes the singular values of a real N-by-N bidiagonal
-*> matrix with diagonal D and off-diagonal E. The singular values
-*> are computed to high relative accuracy, in the absence of
-*> denormalization, underflow and overflow. The algorithm was first
-*> presented in
-*>
-*> "Accurate singular values and differential qd algorithms" by K. V.
-*> Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
-*> 1994,
-*>
-*> and the present implementation is described in "An implementation of
-*> the dqds Algorithm (Positive Case)", LAPACK Working Note.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, D contains the diagonal elements of the
-*> bidiagonal matrix whose SVD is desired. On normal exit,
-*> D contains the singular values in decreasing order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> On entry, elements E(1:N-1) contain the off-diagonal elements
-*> of the bidiagonal matrix whose SVD is desired.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm failed
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 100*N
-*> iterations (in inner while loop) On exit D and E
-*> represent a matrix with the same singular values
-*> which the calling subroutine could use to finish the
-*> computation, or even feed back into SLASQ1
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLASQ1( N, D, E, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO
- REAL EPS, SCALE, SAFMIN, SIGMN, SIGMX
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAS2, SLASCL, SLASQ2, SLASRT, XERBLA
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- CALL XERBLA( 'SLASQ1', -INFO )
- RETURN
- ELSE IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- D( 1 ) = ABS( D( 1 ) )
- RETURN
- ELSE IF( N.EQ.2 ) THEN
- CALL SLAS2( D( 1 ), E( 1 ), D( 2 ), SIGMN, SIGMX )
- D( 1 ) = SIGMX
- D( 2 ) = SIGMN
- RETURN
- END IF
-*
-* Estimate the largest singular value.
-*
- SIGMX = ZERO
- DO 10 I = 1, N - 1
- D( I ) = ABS( D( I ) )
- SIGMX = MAX( SIGMX, ABS( E( I ) ) )
- 10 CONTINUE
- D( N ) = ABS( D( N ) )
-*
-* Early return if SIGMX is zero (matrix is already diagonal).
-*
- IF( SIGMX.EQ.ZERO ) THEN
- CALL SLASRT( 'D', N, D, IINFO )
- RETURN
- END IF
-*
- DO 20 I = 1, N
- SIGMX = MAX( SIGMX, D( I ) )
- 20 CONTINUE
-*
-* Copy D and E into WORK (in the Z format) and scale (squaring the
-* input data makes scaling by a power of the radix pointless).
-*
- EPS = SLAMCH( 'Precision' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SCALE = SQRT( EPS / SAFMIN )
- CALL SCOPY( N, D, 1, WORK( 1 ), 2 )
- CALL SCOPY( N-1, E, 1, WORK( 2 ), 2 )
- CALL SLASCL( 'G', 0, 0, SIGMX, SCALE, 2*N-1, 1, WORK, 2*N-1,
- $ IINFO )
-*
-* Compute the q's and e's.
-*
- DO 30 I = 1, 2*N - 1
- WORK( I ) = WORK( I )**2
- 30 CONTINUE
- WORK( 2*N ) = ZERO
-*
- CALL SLASQ2( N, WORK, INFO )
-*
- IF( INFO.EQ.0 ) THEN
- DO 40 I = 1, N
- D( I ) = SQRT( WORK( I ) )
- 40 CONTINUE
- CALL SLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
- ELSE IF( INFO.EQ.2 ) THEN
-*
-* Maximum number of iterations exceeded. Move data from WORK
-* into D and E so the calling subroutine can try to finish
-*
- DO I = 1, N
- D( I ) = SQRT( WORK( 2*I-1 ) )
- E( I ) = SQRT( WORK( 2*I ) )
- END DO
- CALL SLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
- CALL SLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, E, N, IINFO )
- END IF
-*
- RETURN
-*
-* End of SLASQ1
-*
- END
diff --git a/netlib/LAPACK/slasq2.f b/netlib/LAPACK/slasq2.f
deleted file mode 100644
index b97451f..0000000
--- a/netlib/LAPACK/slasq2.f
+++ /dev/null
@@ -1,589 +0,0 @@
-*> \brief \b SLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASQ2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASQ2( N, Z, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASQ2 computes all the eigenvalues of the symmetric positive
-*> definite tridiagonal matrix associated with the qd array Z to high
-*> relative accuracy are computed to high relative accuracy, in the
-*> absence of denormalization, underflow and overflow.
-*>
-*> To see the relation of Z to the tridiagonal matrix, let L be a
-*> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
-*> let U be an upper bidiagonal matrix with 1's above and diagonal
-*> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
-*> symmetric tridiagonal to which it is similar.
-*>
-*> Note : SLASQ2 defines a logical variable, IEEE, which is true
-*> on machines which follow ieee-754 floating-point standard in their
-*> handling of infinities and NaNs, and false otherwise. This variable
-*> is passed to SLASQ3.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension ( 4*N )
-*> On entry Z holds the qd array. On exit, entries 1 to N hold
-*> the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
-*> trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
-*> N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
-*> holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
-*> shifts that failed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if the i-th argument is a scalar and had an illegal
-*> value, then INFO = -i, if the i-th argument is an
-*> array and the j-entry had an illegal value, then
-*> INFO = -(i*100+j)
-*> > 0: the algorithm failed
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 100*N
-*> iterations (in inner while loop). On exit Z holds
-*> a qd array with the same eigenvalues as the given Z.
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Local Variables: I0:N0 defines a current unreduced segment of Z.
-*> The shifts are accumulated in SIGMA. Iteration count is in ITER.
-*> Ping-pong is controlled by PP (alternates between 0 and 1).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLASQ2( N, Z, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL CBIAS
- PARAMETER ( CBIAS = 1.50E0 )
- REAL ZERO, HALF, ONE, TWO, FOUR, HUNDRD
- PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0,
- $ TWO = 2.0E0, FOUR = 4.0E0, HUNDRD = 100.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL IEEE
- INTEGER I0, I4, IINFO, IPN4, ITER, IWHILA, IWHILB, K,
- $ KMIN, N0, NBIG, NDIV, NFAIL, PP, SPLT, TTYPE,
- $ I1, N1
- REAL D, DEE, DEEMIN, DESIG, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, E, EMAX, EMIN, EPS, G, OLDEMN, QMAX,
- $ QMIN, S, SAFMIN, SIGMA, T, TAU, TEMP, TOL,
- $ TOL2, TRACE, ZMAX, TEMPE, TEMPQ
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASQ3, SLASRT, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- REAL SLAMCH
- EXTERNAL ILAENV, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-* (in case SLASQ2 is not called by SLASQ1)
-*
- INFO = 0
- EPS = SLAMCH( 'Precision' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'SLASQ2', 1 )
- RETURN
- ELSE IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
-*
-* 1-by-1 case.
-*
- IF( Z( 1 ).LT.ZERO ) THEN
- INFO = -201
- CALL XERBLA( 'SLASQ2', 2 )
- END IF
- RETURN
- ELSE IF( N.EQ.2 ) THEN
-*
-* 2-by-2 case.
-*
- IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN
- INFO = -2
- CALL XERBLA( 'SLASQ2', 2 )
- RETURN
- ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN
- D = Z( 3 )
- Z( 3 ) = Z( 1 )
- Z( 1 ) = D
- END IF
- Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 )
- IF( Z( 2 ).GT.Z( 3 )*TOL2 ) THEN
- T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) )
- S = Z( 3 )*( Z( 2 ) / T )
- IF( S.LE.T ) THEN
- S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( 1 ) + ( S+Z( 2 ) )
- Z( 3 ) = Z( 3 )*( Z( 1 ) / T )
- Z( 1 ) = T
- END IF
- Z( 2 ) = Z( 3 )
- Z( 6 ) = Z( 2 ) + Z( 1 )
- RETURN
- END IF
-*
-* Check for negative data and compute sums of q's and e's.
-*
- Z( 2*N ) = ZERO
- EMIN = Z( 2 )
- QMAX = ZERO
- ZMAX = ZERO
- D = ZERO
- E = ZERO
-*
- DO 10 K = 1, 2*( N-1 ), 2
- IF( Z( K ).LT.ZERO ) THEN
- INFO = -( 200+K )
- CALL XERBLA( 'SLASQ2', 2 )
- RETURN
- ELSE IF( Z( K+1 ).LT.ZERO ) THEN
- INFO = -( 200+K+1 )
- CALL XERBLA( 'SLASQ2', 2 )
- RETURN
- END IF
- D = D + Z( K )
- E = E + Z( K+1 )
- QMAX = MAX( QMAX, Z( K ) )
- EMIN = MIN( EMIN, Z( K+1 ) )
- ZMAX = MAX( QMAX, ZMAX, Z( K+1 ) )
- 10 CONTINUE
- IF( Z( 2*N-1 ).LT.ZERO ) THEN
- INFO = -( 200+2*N-1 )
- CALL XERBLA( 'SLASQ2', 2 )
- RETURN
- END IF
- D = D + Z( 2*N-1 )
- QMAX = MAX( QMAX, Z( 2*N-1 ) )
- ZMAX = MAX( QMAX, ZMAX )
-*
-* Check for diagonality.
-*
- IF( E.EQ.ZERO ) THEN
- DO 20 K = 2, N
- Z( K ) = Z( 2*K-1 )
- 20 CONTINUE
- CALL SLASRT( 'D', N, Z, IINFO )
- Z( 2*N-1 ) = D
- RETURN
- END IF
-*
- TRACE = D + E
-*
-* Check for zero data.
-*
- IF( TRACE.EQ.ZERO ) THEN
- Z( 2*N-1 ) = ZERO
- RETURN
- END IF
-*
-* Check whether the machine is IEEE conformable.
-*
-* IEEE = ILAENV( 10, 'SLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND.
-* $ ILAENV( 11, 'SLASQ2', 'N', 1, 2, 3, 4 ).EQ.1
-*
-* [11/15/2008] The case IEEE=.TRUE. has a problem in single precision with
-* some the test matrices of type 16. The double precision code is fine.
-*
- IEEE = .FALSE.
-*
-* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...).
-*
- DO 30 K = 2*N, 2, -2
- Z( 2*K ) = ZERO
- Z( 2*K-1 ) = Z( K )
- Z( 2*K-2 ) = ZERO
- Z( 2*K-3 ) = Z( K-1 )
- 30 CONTINUE
-*
- I0 = 1
- N0 = N
-*
-* Reverse the qd-array, if warranted.
-*
- IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( I4-3 )
- Z( I4-3 ) = Z( IPN4-I4-3 )
- Z( IPN4-I4-3 ) = TEMP
- TEMP = Z( I4-1 )
- Z( I4-1 ) = Z( IPN4-I4-5 )
- Z( IPN4-I4-5 ) = TEMP
- 40 CONTINUE
- END IF
-*
-* Initial split checking via dqd and Li's test.
-*
- PP = 0
-*
- DO 80 K = 1, 2
-*
- D = Z( 4*N0+PP-3 )
- DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4
- IF( Z( I4-1 ).LE.TOL2*D ) THEN
- Z( I4-1 ) = -ZERO
- D = Z( I4-3 )
- ELSE
- D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) )
- END IF
- 50 CONTINUE
-*
-* dqd maps Z to ZZ plus Li's test.
-*
- EMIN = Z( 4*I0+PP+1 )
- D = Z( 4*I0+PP-3 )
- DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4
- Z( I4-2*PP-2 ) = D + Z( I4-1 )
- IF( Z( I4-1 ).LE.TOL2*D ) THEN
- Z( I4-1 ) = -ZERO
- Z( I4-2*PP-2 ) = D
- Z( I4-2*PP ) = ZERO
- D = Z( I4+1 )
- ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND.
- $ SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN
- TEMP = Z( I4+1 ) / Z( I4-2*PP-2 )
- Z( I4-2*PP ) = Z( I4-1 )*TEMP
- D = D*TEMP
- ELSE
- Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) )
- D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) )
- END IF
- EMIN = MIN( EMIN, Z( I4-2*PP ) )
- 60 CONTINUE
- Z( 4*N0-PP-2 ) = D
-*
-* Now find qmax.
-*
- QMAX = Z( 4*I0-PP-2 )
- DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4
- QMAX = MAX( QMAX, Z( I4 ) )
- 70 CONTINUE
-*
-* Prepare for the next iteration on K.
-*
- PP = 1 - PP
- 80 CONTINUE
-*
-* Initialise variables to pass to SLASQ3.
-*
- TTYPE = 0
- DMIN1 = ZERO
- DMIN2 = ZERO
- DN = ZERO
- DN1 = ZERO
- DN2 = ZERO
- G = ZERO
- TAU = ZERO
-*
- ITER = 2
- NFAIL = 0
- NDIV = 2*( N0-I0 )
-*
- DO 160 IWHILA = 1, N + 1
- IF( N0.LT.1 )
- $ GO TO 170
-*
-* While array unfinished do
-*
-* E(N0) holds the value of SIGMA when submatrix in I0:N0
-* splits from the rest of the array, but is negated.
-*
- DESIG = ZERO
- IF( N0.EQ.N ) THEN
- SIGMA = ZERO
- ELSE
- SIGMA = -Z( 4*N0-1 )
- END IF
- IF( SIGMA.LT.ZERO ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Find last unreduced submatrix's top index I0, find QMAX and
-* EMIN. Find Gershgorin-type bound if Q's much greater than E's.
-*
- EMAX = ZERO
- IF( N0.GT.I0 ) THEN
- EMIN = ABS( Z( 4*N0-5 ) )
- ELSE
- EMIN = ZERO
- END IF
- QMIN = Z( 4*N0-3 )
- QMAX = QMIN
- DO 90 I4 = 4*N0, 8, -4
- IF( Z( I4-5 ).LE.ZERO )
- $ GO TO 100
- IF( QMIN.GE.FOUR*EMAX ) THEN
- QMIN = MIN( QMIN, Z( I4-3 ) )
- EMAX = MAX( EMAX, Z( I4-5 ) )
- END IF
- QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) )
- EMIN = MIN( EMIN, Z( I4-5 ) )
- 90 CONTINUE
- I4 = 4
-*
- 100 CONTINUE
- I0 = I4 / 4
- PP = 0
-*
- IF( N0-I0.GT.1 ) THEN
- DEE = Z( 4*I0-3 )
- DEEMIN = DEE
- KMIN = I0
- DO 110 I4 = 4*I0+1, 4*N0-3, 4
- DEE = Z( I4 )*( DEE /( DEE+Z( I4-2 ) ) )
- IF( DEE.LE.DEEMIN ) THEN
- DEEMIN = DEE
- KMIN = ( I4+3 )/4
- END IF
- 110 CONTINUE
- IF( (KMIN-I0)*2.LT.N0-KMIN .AND.
- $ DEEMIN.LE.HALF*Z(4*N0-3) ) THEN
- IPN4 = 4*( I0+N0 )
- PP = 2
- DO 120 I4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( I4-3 )
- Z( I4-3 ) = Z( IPN4-I4-3 )
- Z( IPN4-I4-3 ) = TEMP
- TEMP = Z( I4-2 )
- Z( I4-2 ) = Z( IPN4-I4-2 )
- Z( IPN4-I4-2 ) = TEMP
- TEMP = Z( I4-1 )
- Z( I4-1 ) = Z( IPN4-I4-5 )
- Z( IPN4-I4-5 ) = TEMP
- TEMP = Z( I4 )
- Z( I4 ) = Z( IPN4-I4-4 )
- Z( IPN4-I4-4 ) = TEMP
- 120 CONTINUE
- END IF
- END IF
-*
-* Put -(initial shift) into DMIN.
-*
- DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) )
-*
-* Now I0:N0 is unreduced.
-* PP = 0 for ping, PP = 1 for pong.
-* PP = 2 indicates that flipping was applied to the Z array and
-* and that the tests for deflation upon entry in SLASQ3
-* should not be performed.
-*
- NBIG = 100*( N0-I0+1 )
- DO 140 IWHILB = 1, NBIG
- IF( I0.GT.N0 )
- $ GO TO 150
-*
-* While submatrix unfinished take a good dqds step.
-*
- CALL SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, G, TAU )
-*
- PP = 1 - PP
-*
-* When EMIN is very small check for splits.
-*
- IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN
- IF( Z( 4*N0 ).LE.TOL2*QMAX .OR.
- $ Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN
- SPLT = I0 - 1
- QMAX = Z( 4*I0-3 )
- EMIN = Z( 4*I0-1 )
- OLDEMN = Z( 4*I0 )
- DO 130 I4 = 4*I0, 4*( N0-3 ), 4
- IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR.
- $ Z( I4-1 ).LE.TOL2*SIGMA ) THEN
- Z( I4-1 ) = -SIGMA
- SPLT = I4 / 4
- QMAX = ZERO
- EMIN = Z( I4+3 )
- OLDEMN = Z( I4+4 )
- ELSE
- QMAX = MAX( QMAX, Z( I4+1 ) )
- EMIN = MIN( EMIN, Z( I4-1 ) )
- OLDEMN = MIN( OLDEMN, Z( I4 ) )
- END IF
- 130 CONTINUE
- Z( 4*N0-1 ) = EMIN
- Z( 4*N0 ) = OLDEMN
- I0 = SPLT + 1
- END IF
- END IF
-*
- 140 CONTINUE
-*
- INFO = 2
-*
-* Maximum number of iterations exceeded, restore the shift
-* SIGMA and place the new d's and e's in a qd array.
-* This might need to be done for several blocks
-*
- I1 = I0
- N1 = N0
- 145 CONTINUE
- TEMPQ = Z( 4*I0-3 )
- Z( 4*I0-3 ) = Z( 4*I0-3 ) + SIGMA
- DO K = I0+1, N0
- TEMPE = Z( 4*K-5 )
- Z( 4*K-5 ) = Z( 4*K-5 ) * (TEMPQ / Z( 4*K-7 ))
- TEMPQ = Z( 4*K-3 )
- Z( 4*K-3 ) = Z( 4*K-3 ) + SIGMA + TEMPE - Z( 4*K-5 )
- END DO
-*
-* Prepare to do this on the previous block if there is one
-*
- IF( I1.GT.1 ) THEN
- N1 = I1-1
- DO WHILE( ( I1.GE.2 ) .AND. ( Z(4*I1-5).GE.ZERO ) )
- I1 = I1 - 1
- END DO
- IF( I1.GE.1 ) THEN
- SIGMA = -Z(4*N1-1)
- GO TO 145
- END IF
- END IF
-
- DO K = 1, N
- Z( 2*K-1 ) = Z( 4*K-3 )
-*
-* Only the block 1..N0 is unfinished. The rest of the e's
-* must be essentially zero, although sometimes other data
-* has been stored in them.
-*
- IF( K.LT.N0 ) THEN
- Z( 2*K ) = Z( 4*K-1 )
- ELSE
- Z( 2*K ) = 0
- END IF
- END DO
- RETURN
-*
-* end IWHILB
-*
- 150 CONTINUE
-*
- 160 CONTINUE
-*
- INFO = 3
- RETURN
-*
-* end IWHILA
-*
- 170 CONTINUE
-*
-* Move q's to the front.
-*
- DO 180 K = 2, N
- Z( K ) = Z( 4*K-3 )
- 180 CONTINUE
-*
-* Sort and compute sum of eigenvalues.
-*
- CALL SLASRT( 'D', N, Z, IINFO )
-*
- E = ZERO
- DO 190 K = N, 1, -1
- E = E + Z( K )
- 190 CONTINUE
-*
-* Store trace, sum(eigenvalues) and information on performance.
-*
- Z( 2*N+1 ) = TRACE
- Z( 2*N+2 ) = E
- Z( 2*N+3 ) = REAL( ITER )
- Z( 2*N+4 ) = REAL( NDIV ) / REAL( N**2 )
- Z( 2*N+5 ) = HUNDRD*NFAIL / REAL( ITER )
- RETURN
-*
-* End of SLASQ2
-*
- END
diff --git a/netlib/LAPACK/slasq3.f b/netlib/LAPACK/slasq3.f
deleted file mode 100644
index 64badbb..0000000
--- a/netlib/LAPACK/slasq3.f
+++ /dev/null
@@ -1,421 +0,0 @@
-*> \brief \b SLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASQ3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
-* ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
-* DN2, G, TAU )
-*
-* .. Scalar Arguments ..
-* LOGICAL IEEE
-* INTEGER I0, ITER, N0, NDIV, NFAIL, PP
-* REAL DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
-* $ QMAX, SIGMA, TAU
-* ..
-* .. Array Arguments ..
-* REAL Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
-*> In case of failure it changes shifts, and tries again until output
-*> is positive.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in,out] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( 4*N )
-*> Z holds the qd array.
-*> \endverbatim
-*>
-*> \param[in,out] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> PP=2 indicates that flipping was applied to the Z array
-*> and that the initial tests for deflation should not be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is REAL
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is REAL
-*> Sum of shifts used in current segment.
-*> \endverbatim
-*>
-*> \param[in,out] DESIG
-*> \verbatim
-*> DESIG is REAL
-*> Lower order part of SIGMA
-*> \endverbatim
-*>
-*> \param[in] QMAX
-*> \verbatim
-*> QMAX is REAL
-*> Maximum value of q.
-*> \endverbatim
-*>
-*> \param[out] NFAIL
-*> \verbatim
-*> NFAIL is INTEGER
-*> Number of times shift was too big.
-*> \endverbatim
-*>
-*> \param[out] ITER
-*> \verbatim
-*> ITER is INTEGER
-*> Number of iterations.
-*> \endverbatim
-*>
-*> \param[out] NDIV
-*> \verbatim
-*> NDIV is INTEGER
-*> Number of divisions.
-*> \endverbatim
-*>
-*> \param[in] IEEE
-*> \verbatim
-*> IEEE is LOGICAL
-*> Flag for IEEE or non IEEE arithmetic (passed to SLASQ5).
-*> \endverbatim
-*>
-*> \param[in,out] TTYPE
-*> \verbatim
-*> TTYPE is INTEGER
-*> Shift type.
-*> \endverbatim
-*>
-*> \param[in,out] DMIN1
-*> \verbatim
-*> DMIN1 is REAL
-*> \endverbatim
-*>
-*> \param[in,out] DMIN2
-*> \verbatim
-*> DMIN2 is REAL
-*> \endverbatim
-*>
-*> \param[in,out] DN
-*> \verbatim
-*> DN is REAL
-*> \endverbatim
-*>
-*> \param[in,out] DN1
-*> \verbatim
-*> DN1 is REAL
-*> \endverbatim
-*>
-*> \param[in,out] DN2
-*> \verbatim
-*> DN2 is REAL
-*> \endverbatim
-*>
-*> \param[in,out] G
-*> \verbatim
-*> G is REAL
-*> \endverbatim
-*>
-*> \param[in,out] TAU
-*> \verbatim
-*> TAU is REAL
-*>
-*> These are passed as arguments in order to save their values
-*> between calls to SLASQ3.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, G, TAU )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, ITER, N0, NDIV, NFAIL, PP
- REAL DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
- $ QMAX, SIGMA, TAU
-* ..
-* .. Array Arguments ..
- REAL Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL CBIAS
- PARAMETER ( CBIAS = 1.50E0 )
- REAL ZERO, QURTR, HALF, ONE, TWO, HUNDRD
- PARAMETER ( ZERO = 0.0E0, QURTR = 0.250E0, HALF = 0.5E0,
- $ ONE = 1.0E0, TWO = 2.0E0, HUNDRD = 100.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER IPN4, J4, N0IN, NN, TTYPE
- REAL EPS, S, T, TEMP, TOL, TOL2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASQ4, SLASQ5, SLASQ6
-* ..
-* .. External Function ..
- REAL SLAMCH
- LOGICAL SISNAN
- EXTERNAL SISNAN, SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- N0IN = N0
- EPS = SLAMCH( 'Precision' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
-*
-* Check for deflation.
-*
- 10 CONTINUE
-*
- IF( N0.LT.I0 )
- $ RETURN
- IF( N0.EQ.I0 )
- $ GO TO 20
- NN = 4*N0 + PP
- IF( N0.EQ.( I0+1 ) )
- $ GO TO 40
-*
-* Check whether E(N0-1) is negligible, 1 eigenvalue.
-*
- IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
- $ Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
- $ GO TO 30
-*
- 20 CONTINUE
-*
- Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
- N0 = N0 - 1
- GO TO 10
-*
-* Check whether E(N0-2) is negligible, 2 eigenvalues.
-*
- 30 CONTINUE
-*
- IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
- $ Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
- $ GO TO 50
-*
- 40 CONTINUE
-*
- IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
- S = Z( NN-3 )
- Z( NN-3 ) = Z( NN-7 )
- Z( NN-7 ) = S
- END IF
- T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
- IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2.AND.T.NE.ZERO ) THEN
- S = Z( NN-3 )*( Z( NN-5 ) / T )
- IF( S.LE.T ) THEN
- S = Z( NN-3 )*( Z( NN-5 ) /
- $ ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( NN-7 ) + ( S+Z( NN-5 ) )
- Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
- Z( NN-7 ) = T
- END IF
- Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
- Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
- N0 = N0 - 2
- GO TO 10
-*
- 50 CONTINUE
- IF( PP.EQ.2 )
- $ PP = 0
-*
-* Reverse the qd-array, if warranted.
-*
- IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
- IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( J4-3 )
- Z( J4-3 ) = Z( IPN4-J4-3 )
- Z( IPN4-J4-3 ) = TEMP
- TEMP = Z( J4-2 )
- Z( J4-2 ) = Z( IPN4-J4-2 )
- Z( IPN4-J4-2 ) = TEMP
- TEMP = Z( J4-1 )
- Z( J4-1 ) = Z( IPN4-J4-5 )
- Z( IPN4-J4-5 ) = TEMP
- TEMP = Z( J4 )
- Z( J4 ) = Z( IPN4-J4-4 )
- Z( IPN4-J4-4 ) = TEMP
- 60 CONTINUE
- IF( N0-I0.LE.4 ) THEN
- Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
- Z( 4*N0-PP ) = Z( 4*I0-PP )
- END IF
- DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
- Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
- $ Z( 4*I0+PP+3 ) )
- Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
- $ Z( 4*I0-PP+4 ) )
- QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
- DMIN = -ZERO
- END IF
- END IF
-*
-* Choose a shift.
-*
- CALL SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
- $ DN2, TAU, TTYPE, G )
-*
-* Call dqds until DMIN > 0.
-*
- 70 CONTINUE
-*
- CALL SLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, IEEE, EPS )
-*
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
-*
-* Check status.
-*
- IF( DMIN.GE.ZERO .AND. DMIN1.GE.ZERO ) THEN
-*
-* Success.
-*
- GO TO 90
-*
- ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
- $ Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
- $ ABS( DN ).LT.TOL*SIGMA ) THEN
-*
-* Convergence hidden by negative DN.
-*
- Z( 4*( N0-1 )-PP+2 ) = ZERO
- DMIN = ZERO
- GO TO 90
- ELSE IF( DMIN.LT.ZERO ) THEN
-*
-* TAU too big. Select new TAU and try again.
-*
- NFAIL = NFAIL + 1
- IF( TTYPE.LT.-22 ) THEN
-*
-* Failed twice. Play it safe.
-*
- TAU = ZERO
- ELSE IF( DMIN1.GT.ZERO ) THEN
-*
-* Late failure. Gives excellent shift.
-*
- TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
- TTYPE = TTYPE - 11
- ELSE
-*
-* Early failure. Divide by 4.
-*
- TAU = QURTR*TAU
- TTYPE = TTYPE - 12
- END IF
- GO TO 70
- ELSE IF( SISNAN( DMIN ) ) THEN
-*
-* NaN.
-*
- IF( TAU.EQ.ZERO ) THEN
- GO TO 80
- ELSE
- TAU = ZERO
- GO TO 70
- END IF
- ELSE
-*
-* Possible underflow. Play it safe.
-*
- GO TO 80
- END IF
-*
-* Risk of underflow.
-*
- 80 CONTINUE
- CALL SLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
- TAU = ZERO
-*
- 90 CONTINUE
- IF( TAU.LT.SIGMA ) THEN
- DESIG = DESIG + TAU
- T = SIGMA + DESIG
- DESIG = DESIG - ( T-SIGMA )
- ELSE
- T = SIGMA + TAU
- DESIG = SIGMA - ( T-TAU ) + DESIG
- END IF
- SIGMA = T
-*
- RETURN
-*
-* End of SLASQ3
-*
- END
diff --git a/netlib/LAPACK/slasq4.f b/netlib/LAPACK/slasq4.f
deleted file mode 100644
index bdd24f3..0000000
--- a/netlib/LAPACK/slasq4.f
+++ /dev/null
@@ -1,425 +0,0 @@
-*> \brief \b SLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASQ4 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq4.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq4.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq4.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
-* DN1, DN2, TAU, TTYPE, G )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, N0IN, PP, TTYPE
-* REAL DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
-* REAL Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASQ4 computes an approximation TAU to the smallest eigenvalue
-*> using values of d from the previous transform.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( 4*N )
-*> Z holds the qd array.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[in] N0IN
-*> \verbatim
-*> N0IN is INTEGER
-*> The value of N0 at start of EIGTEST.
-*> \endverbatim
-*>
-*> \param[in] DMIN
-*> \verbatim
-*> DMIN is REAL
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[in] DMIN1
-*> \verbatim
-*> DMIN1 is REAL
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[in] DMIN2
-*> \verbatim
-*> DMIN2 is REAL
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[in] DN
-*> \verbatim
-*> DN is REAL
-*> d(N)
-*> \endverbatim
-*>
-*> \param[in] DN1
-*> \verbatim
-*> DN1 is REAL
-*> d(N-1)
-*> \endverbatim
-*>
-*> \param[in] DN2
-*> \verbatim
-*> DN2 is REAL
-*> d(N-2)
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL
-*> This is the shift.
-*> \endverbatim
-*>
-*> \param[out] TTYPE
-*> \verbatim
-*> TTYPE is INTEGER
-*> Shift type.
-*> \endverbatim
-*>
-*> \param[in,out] G
-*> \verbatim
-*> G is REAL
-*> G is passed as an argument in order to save its value between
-*> calls to SLASQ4.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> CNST1 = 9/16
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, TAU, TTYPE, G )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, N0IN, PP, TTYPE
- REAL DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
- REAL Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL CNST1, CNST2, CNST3
- PARAMETER ( CNST1 = 0.5630E0, CNST2 = 1.010E0,
- $ CNST3 = 1.050E0 )
- REAL QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
- PARAMETER ( QURTR = 0.250E0, THIRD = 0.3330E0,
- $ HALF = 0.50E0, ZERO = 0.0E0, ONE = 1.0E0,
- $ TWO = 2.0E0, HUNDRD = 100.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I4, NN, NP
- REAL A2, B1, B2, GAM, GAP1, GAP2, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* A negative DMIN forces the shift to take that absolute value
-* TTYPE records the type of shift.
-*
- IF( DMIN.LE.ZERO ) THEN
- TAU = -DMIN
- TTYPE = -1
- RETURN
- END IF
-*
- NN = 4*N0 + PP
- IF( N0IN.EQ.N0 ) THEN
-*
-* No eigenvalues deflated.
-*
- IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
-*
- B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
- B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
- A2 = Z( NN-7 ) + Z( NN-5 )
-*
-* Cases 2 and 3.
-*
- IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
- GAP2 = DMIN2 - A2 - DMIN2*QURTR
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
- GAP1 = A2 - DN - ( B2 / GAP2 )*B2
- ELSE
- GAP1 = A2 - DN - ( B1+B2 )
- END IF
- IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
- S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
- TTYPE = -2
- ELSE
- S = ZERO
- IF( DN.GT.B1 )
- $ S = DN - B1
- IF( A2.GT.( B1+B2 ) )
- $ S = MIN( S, A2-( B1+B2 ) )
- S = MAX( S, THIRD*DMIN )
- TTYPE = -3
- END IF
- ELSE
-*
-* Case 4.
-*
- TTYPE = -4
- S = QURTR*DMIN
- IF( DMIN.EQ.DN ) THEN
- GAM = DN
- A2 = ZERO
- IF( Z( NN-5 ) .GT. Z( NN-7 ) )
- $ RETURN
- B2 = Z( NN-5 ) / Z( NN-7 )
- NP = NN - 9
- ELSE
- NP = NN - 2*PP
- B2 = Z( NP-2 )
- GAM = DN1
- IF( Z( NP-4 ) .GT. Z( NP-2 ) )
- $ RETURN
- A2 = Z( NP-4 ) / Z( NP-2 )
- IF( Z( NN-9 ) .GT. Z( NN-11 ) )
- $ RETURN
- B2 = Z( NN-9 ) / Z( NN-11 )
- NP = NN - 13
- END IF
-*
-* Approximate contribution to norm squared from I < NN-1.
-*
- A2 = A2 + B2
- DO 10 I4 = NP, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 20
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 20
- 10 CONTINUE
- 20 CONTINUE
- A2 = CNST3*A2
-*
-* Rayleigh quotient residual bound.
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- END IF
- ELSE IF( DMIN.EQ.DN2 ) THEN
-*
-* Case 5.
-*
- TTYPE = -5
- S = QURTR*DMIN
-*
-* Compute contribution to norm squared from I > NN-2.
-*
- NP = NN - 2*PP
- B1 = Z( NP-2 )
- B2 = Z( NP-6 )
- GAM = DN2
- IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
- $ RETURN
- A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
-*
-* Approximate contribution to norm squared from I < NN-2.
-*
- IF( N0-I0.GT.2 ) THEN
- B2 = Z( NN-13 ) / Z( NN-15 )
- A2 = A2 + B2
- DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 40
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 40
- 30 CONTINUE
- 40 CONTINUE
- A2 = CNST3*A2
- END IF
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- ELSE
-*
-* Case 6, no information to guide us.
-*
- IF( TTYPE.EQ.-6 ) THEN
- G = G + THIRD*( ONE-G )
- ELSE IF( TTYPE.EQ.-18 ) THEN
- G = QURTR*THIRD
- ELSE
- G = QURTR
- END IF
- S = G*DMIN
- TTYPE = -6
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
-*
-* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
-*
- IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN
-*
-* Cases 7 and 8.
-*
- TTYPE = -7
- S = THIRD*DMIN1
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 60
- DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- A2 = B1
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*MAX( B1, A2 ).LT.B2 )
- $ GO TO 60
- 50 CONTINUE
- 60 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN1 / ( ONE+B2**2 )
- GAP2 = HALF*DMIN2 - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- TTYPE = -8
- END IF
- ELSE
-*
-* Case 9.
-*
- S = QURTR*DMIN1
- IF( DMIN1.EQ.DN1 )
- $ S = HALF*DMIN1
- TTYPE = -9
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
-*
-* Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
-*
-* Cases 10 and 11.
-*
- IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN
- TTYPE = -10
- S = THIRD*DMIN2
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 80
- DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*B1.LT.B2 )
- $ GO TO 80
- 70 CONTINUE
- 80 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN2 / ( ONE+B2**2 )
- GAP2 = Z( NN-7 ) + Z( NN-9 ) -
- $ SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- END IF
- ELSE
- S = QURTR*DMIN2
- TTYPE = -11
- END IF
- ELSE IF( N0IN.GT.( N0+2 ) ) THEN
-*
-* Case 12, more than two eigenvalues deflated. No information.
-*
- S = ZERO
- TTYPE = -12
- END IF
-*
- TAU = S
- RETURN
-*
-* End of SLASQ4
-*
- END
diff --git a/netlib/LAPACK/slasq5.f b/netlib/LAPACK/slasq5.f
deleted file mode 100644
index d1d68e3..0000000
--- a/netlib/LAPACK/slasq5.f
+++ /dev/null
@@ -1,399 +0,0 @@
-*> \brief \b SLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASQ5 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq5.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq5.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq5.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2, IEEE )
-*
-* .. Scalar Arguments ..
-* LOGICAL IEEE
-* INTEGER I0, N0, PP
-* REAL DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
-* ..
-* .. Array Arguments ..
-* REAL Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASQ5 computes one dqds transform in ping-pong form, one
-*> version for IEEE machines another for non IEEE machines.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL
-*> This is the shift.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is REAL
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is REAL
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is REAL
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is REAL
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is REAL
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is REAL
-*> d(N0-2).
-*> \endverbatim
-*>
-*> \param[in] IEEE
-*> \verbatim
-*> IEEE is LOGICAL
-*> Flag for IEEE or non IEEE arithmetic.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
- $ DN, DNM1, DNM2, IEEE, EPS )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, N0, PP
- REAL DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU,
- $ SIGMA, EPS
-* ..
-* .. Array Arguments ..
- REAL Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- REAL ZERO, HALF
- PARAMETER ( ZERO = 0.0E0, HALF = 0.5 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- REAL D, EMIN, TEMP, DTHRESH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
- DTHRESH = EPS*(SIGMA+TAU)
- IF( TAU.LT.DTHRESH*HALF ) TAU = ZERO
- IF( TAU.NE.ZERO ) THEN
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 ) - TAU
- DMIN = D
- DMIN1 = -Z( J4 )
-*
- IF( IEEE ) THEN
-*
-* Code for IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 10 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- TEMP = Z( J4+1 ) / Z( J4-2 )
- D = D*TEMP - TAU
- DMIN = MIN( DMIN, D )
- Z( J4 ) = Z( J4-1 )*TEMP
- EMIN = MIN( Z( J4 ), EMIN )
- 10 CONTINUE
- ELSE
- DO 20 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- TEMP = Z( J4+2 ) / Z( J4-3 )
- D = D*TEMP - TAU
- DMIN = MIN( DMIN, D )
- Z( J4-1 ) = Z( J4 )*TEMP
- EMIN = MIN( Z( J4-1 ), EMIN )
- 20 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DN )
-*
- ELSE
-*
-* Code for non IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 30 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 30 CONTINUE
- ELSE
- DO 40 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 40 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( DNM2.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( DNM1.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DN )
-*
- END IF
-*
- ELSE
-* This is the version that sets d's to zero if they are small enough
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 ) - TAU
- DMIN = D
- DMIN1 = -Z( J4 )
- IF( IEEE ) THEN
-*
-* Code for IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 50 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- TEMP = Z( J4+1 ) / Z( J4-2 )
- D = D*TEMP - TAU
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- Z( J4 ) = Z( J4-1 )*TEMP
- EMIN = MIN( Z( J4 ), EMIN )
- 50 CONTINUE
- ELSE
- DO 60 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- TEMP = Z( J4+2 ) / Z( J4-3 )
- D = D*TEMP - TAU
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- Z( J4-1 ) = Z( J4 )*TEMP
- EMIN = MIN( Z( J4-1 ), EMIN )
- 60 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DN )
-*
- ELSE
-*
-* Code for non IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 70 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
- END IF
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 70 CONTINUE
- ELSE
- DO 80 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
- END IF
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 80 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( DNM2.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( DNM1.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DN )
-*
- END IF
-*
- END IF
- Z( J4+2 ) = DN
- Z( 4*N0-PP ) = EMIN
- RETURN
-*
-* End of SLASQ5
-*
- END
diff --git a/netlib/LAPACK/slasq6.f b/netlib/LAPACK/slasq6.f
deleted file mode 100644
index e56813b..0000000
--- a/netlib/LAPACK/slasq6.f
+++ /dev/null
@@ -1,254 +0,0 @@
-*> \brief \b SLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASQ6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2 )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, PP
-* REAL DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
-* REAL Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASQ6 computes one dqd (shift equal to zero) transform in
-*> ping-pong form, with protection against underflow and overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is REAL
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is REAL
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is REAL
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is REAL
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is REAL
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is REAL
-*> d(N0-2).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
- $ DNM1, DNM2 )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, PP
- REAL DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
- REAL Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- REAL D, EMIN, SAFMIN, TEMP
-* ..
-* .. External Function ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 )
- DMIN = D
-*
- IF( PP.EQ.0 ) THEN
- DO 10 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- D = Z( J4+1 )
- DMIN = D
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4+1 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4+1 ) ) THEN
- TEMP = Z( J4+1 ) / Z( J4-2 )
- Z( J4 ) = Z( J4-1 )*TEMP
- D = D*TEMP
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 10 CONTINUE
- ELSE
- DO 20 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( Z( J4-3 ).EQ.ZERO ) THEN
- Z( J4-1 ) = ZERO
- D = Z( J4+2 )
- DMIN = D
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4+2 ).LT.Z( J4-3 ) .AND.
- $ SAFMIN*Z( J4-3 ).LT.Z( J4+2 ) ) THEN
- TEMP = Z( J4+2 ) / Z( J4-3 )
- Z( J4-1 ) = Z( J4 )*TEMP
- D = D*TEMP
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) )
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 20 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- DNM1 = Z( J4P2+2 )
- DMIN = DNM1
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
- TEMP = Z( J4P2+2 ) / Z( J4-2 )
- Z( J4 ) = Z( J4P2 )*TEMP
- DNM1 = DNM2*TEMP
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- DN = Z( J4P2+2 )
- DMIN = DN
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
- TEMP = Z( J4P2+2 ) / Z( J4-2 )
- Z( J4 ) = Z( J4P2 )*TEMP
- DN = DNM1*TEMP
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, DN )
-*
- Z( J4+2 ) = DN
- Z( 4*N0-PP ) = EMIN
- RETURN
-*
-* End of SLASQ6
-*
- END
diff --git a/netlib/LAPACK/slasr.f b/netlib/LAPACK/slasr.f
deleted file mode 100644
index 5f8cbaa..0000000
--- a/netlib/LAPACK/slasr.f
+++ /dev/null
@@ -1,436 +0,0 @@
-*> \brief \b SLASR applies a sequence of plane rotations to a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, PIVOT, SIDE
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASR applies a sequence of plane rotations to a real matrix A,
-*> from either the left or the right.
-*>
-*> When SIDE = 'L', the transformation takes the form
-*>
-*> A := P*A
-*>
-*> and when SIDE = 'R', the transformation takes the form
-*>
-*> A := A*P**T
-*>
-*> where P is an orthogonal matrix consisting of a sequence of z plane
-*> rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
-*> and P**T is the transpose of P.
-*>
-*> When DIRECT = 'F' (Forward sequence), then
-*>
-*> P = P(z-1) * ... * P(2) * P(1)
-*>
-*> and when DIRECT = 'B' (Backward sequence), then
-*>
-*> P = P(1) * P(2) * ... * P(z-1)
-*>
-*> where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
-*>
-*> R(k) = ( c(k) s(k) )
-*> = ( -s(k) c(k) ).
-*>
-*> When PIVOT = 'V' (Variable pivot), the rotation is performed
-*> for the plane (k,k+1), i.e., P(k) has the form
-*>
-*> P(k) = ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( c(k) s(k) )
-*> ( -s(k) c(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*>
-*> where R(k) appears as a rank-2 modification to the identity matrix in
-*> rows and columns k and k+1.
-*>
-*> When PIVOT = 'T' (Top pivot), the rotation is performed for the
-*> plane (1,k+1), so P(k) has the form
-*>
-*> P(k) = ( c(k) s(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( -s(k) c(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*>
-*> where R(k) appears in rows and columns 1 and k+1.
-*>
-*> Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
-*> performed for the plane (k,z), giving P(k) the form
-*>
-*> P(k) = ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( c(k) s(k) )
-*> ( 1 )
-*> ( ... )
-*> ( 1 )
-*> ( -s(k) c(k) )
-*>
-*> where R(k) appears in rows and columns k and z. The rotations are
-*> performed without ever forming P(k) explicitly.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> Specifies whether the plane rotation matrix P is applied to
-*> A on the left or the right.
-*> = 'L': Left, compute A := P*A
-*> = 'R': Right, compute A:= A*P**T
-*> \endverbatim
-*>
-*> \param[in] PIVOT
-*> \verbatim
-*> PIVOT is CHARACTER*1
-*> Specifies the plane for which P(k) is a plane rotation
-*> matrix.
-*> = 'V': Variable pivot, the plane (k,k+1)
-*> = 'T': Top pivot, the plane (1,k+1)
-*> = 'B': Bottom pivot, the plane (k,z)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Specifies whether P is a forward or backward sequence of
-*> plane rotations.
-*> = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
-*> = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. If m <= 1, an immediate
-*> return is effected.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. If n <= 1, an
-*> immediate return is effected.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is REAL array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> The cosines c(k) of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> The sines s(k) of the plane rotations. The 2-by-2 plane
-*> rotation part of the matrix P(k), R(k), has the form
-*> R(k) = ( c(k) s(k) )
-*> ( -s(k) c(k) ).
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The M-by-N matrix A. On exit, A is overwritten by P*A if
-*> SIDE = 'R' or by A*P**T if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, PIVOT, SIDE
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
- REAL CTEMP, STEMP, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
- INFO = 1
- ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
- $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
- INFO = 2
- ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
- $ THEN
- INFO = 3
- ELSE IF( M.LT.0 ) THEN
- INFO = 4
- ELSE IF( N.LT.0 ) THEN
- INFO = 5
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = 9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASR ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
- $ RETURN
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form P * A
-*
- IF( LSAME( PIVOT, 'V' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 20 J = 1, M - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 10 I = 1, N
- TEMP = A( J+1, I )
- A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
- A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 40 J = M - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 30 I = 1, N
- TEMP = A( J+1, I )
- A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
- A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 60 J = 2, M
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 50 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
- A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 80 J = M, 2, -1
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 70 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
- A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 100 J = 1, M - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 90 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
- A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 120 J = M - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 110 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
- A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
- END IF
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form A * P**T
-*
- IF( LSAME( PIVOT, 'V' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 140 J = 1, N - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 130 I = 1, M
- TEMP = A( I, J+1 )
- A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
- A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
- 130 CONTINUE
- END IF
- 140 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 160 J = N - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 150 I = 1, M
- TEMP = A( I, J+1 )
- A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
- A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
- 150 CONTINUE
- END IF
- 160 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 180 J = 2, N
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 170 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
- A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
- 170 CONTINUE
- END IF
- 180 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 200 J = N, 2, -1
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 190 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
- A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
- 190 CONTINUE
- END IF
- 200 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 220 J = 1, N - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 210 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
- A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
- 210 CONTINUE
- END IF
- 220 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 240 J = N - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 230 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
- A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
- 230 CONTINUE
- END IF
- 240 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of SLASR
-*
- END
diff --git a/netlib/LAPACK/slasrt.f b/netlib/LAPACK/slasrt.f
deleted file mode 100644
index e93c0d6..0000000
--- a/netlib/LAPACK/slasrt.f
+++ /dev/null
@@ -1,303 +0,0 @@
-*> \brief \b SLASRT sorts numbers in increasing or decreasing order.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASRT( ID, N, D, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ID
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Sort the numbers in D in increasing order (if ID = 'I') or
-*> in decreasing order (if ID = 'D' ).
-*>
-*> Use Quick Sort, reverting to Insertion sort on arrays of
-*> size <= 20. Dimension of STACK limits N to about 2**32.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ID
-*> \verbatim
-*> ID is CHARACTER*1
-*> = 'I': sort D in increasing order;
-*> = 'D': sort D in decreasing order.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of the array D.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the array to be sorted.
-*> On exit, D has been sorted into increasing order
-*> (D(1) <= ... <= D(N) ) or into decreasing order
-*> (D(1) >= ... >= D(N) ), depending on ID.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLASRT( ID, N, D, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER ID
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER SELECT
- PARAMETER ( SELECT = 20 )
-* ..
-* .. Local Scalars ..
- INTEGER DIR, ENDD, I, J, START, STKPNT
- REAL D1, D2, D3, DMNMX, TMP
-* ..
-* .. Local Arrays ..
- INTEGER STACK( 2, 32 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input paramters.
-*
- INFO = 0
- DIR = -1
- IF( LSAME( ID, 'D' ) ) THEN
- DIR = 0
- ELSE IF( LSAME( ID, 'I' ) ) THEN
- DIR = 1
- END IF
- IF( DIR.EQ.-1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLASRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- STKPNT = 1
- STACK( 1, 1 ) = 1
- STACK( 2, 1 ) = N
- 10 CONTINUE
- START = STACK( 1, STKPNT )
- ENDD = STACK( 2, STKPNT )
- STKPNT = STKPNT - 1
- IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
-*
-* Do Insertion sort on D( START:ENDD )
-*
- IF( DIR.EQ.0 ) THEN
-*
-* Sort into decreasing order
-*
- DO 30 I = START + 1, ENDD
- DO 20 J = I, START + 1, -1
- IF( D( J ).GT.D( J-1 ) ) THEN
- DMNMX = D( J )
- D( J ) = D( J-1 )
- D( J-1 ) = DMNMX
- ELSE
- GO TO 30
- END IF
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE
-*
-* Sort into increasing order
-*
- DO 50 I = START + 1, ENDD
- DO 40 J = I, START + 1, -1
- IF( D( J ).LT.D( J-1 ) ) THEN
- DMNMX = D( J )
- D( J ) = D( J-1 )
- D( J-1 ) = DMNMX
- ELSE
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- END IF
-*
- ELSE IF( ENDD-START.GT.SELECT ) THEN
-*
-* Partition D( START:ENDD ) and stack parts, largest one first
-*
-* Choose partition entry as median of 3
-*
- D1 = D( START )
- D2 = D( ENDD )
- I = ( START+ENDD ) / 2
- D3 = D( I )
- IF( D1.LT.D2 ) THEN
- IF( D3.LT.D1 ) THEN
- DMNMX = D1
- ELSE IF( D3.LT.D2 ) THEN
- DMNMX = D3
- ELSE
- DMNMX = D2
- END IF
- ELSE
- IF( D3.LT.D2 ) THEN
- DMNMX = D2
- ELSE IF( D3.LT.D1 ) THEN
- DMNMX = D3
- ELSE
- DMNMX = D1
- END IF
- END IF
-*
- IF( DIR.EQ.0 ) THEN
-*
-* Sort into decreasing order
-*
- I = START - 1
- J = ENDD + 1
- 60 CONTINUE
- 70 CONTINUE
- J = J - 1
- IF( D( J ).LT.DMNMX )
- $ GO TO 70
- 80 CONTINUE
- I = I + 1
- IF( D( I ).GT.DMNMX )
- $ GO TO 80
- IF( I.LT.J ) THEN
- TMP = D( I )
- D( I ) = D( J )
- D( J ) = TMP
- GO TO 60
- END IF
- IF( J-START.GT.ENDD-J-1 ) THEN
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- ELSE
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- END IF
- ELSE
-*
-* Sort into increasing order
-*
- I = START - 1
- J = ENDD + 1
- 90 CONTINUE
- 100 CONTINUE
- J = J - 1
- IF( D( J ).GT.DMNMX )
- $ GO TO 100
- 110 CONTINUE
- I = I + 1
- IF( D( I ).LT.DMNMX )
- $ GO TO 110
- IF( I.LT.J ) THEN
- TMP = D( I )
- D( I ) = D( J )
- D( J ) = TMP
- GO TO 90
- END IF
- IF( J-START.GT.ENDD-J-1 ) THEN
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- ELSE
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- END IF
- END IF
- END IF
- IF( STKPNT.GT.0 )
- $ GO TO 10
- RETURN
-*
-* End of SLASRT
-*
- END
diff --git a/netlib/LAPACK/slassq.f b/netlib/LAPACK/slassq.f
deleted file mode 100644
index 0776bb3..0000000
--- a/netlib/LAPACK/slassq.f
+++ /dev/null
@@ -1,155 +0,0 @@
-*> \brief \b SLASSQ updates a sum of squares represented in scaled form.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASSQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slassq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slassq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slassq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* REAL SCALE, SUMSQ
-* ..
-* .. Array Arguments ..
-* REAL X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASSQ returns the values scl and smsq such that
-*>
-*> ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
-*>
-*> where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
-*> assumed to be non-negative and scl returns the value
-*>
-*> scl = max( scale, abs( x( i ) ) ).
-*>
-*> scale and sumsq must be supplied in SCALE and SUMSQ and
-*> scl and smsq are overwritten on SCALE and SUMSQ respectively.
-*>
-*> The routine makes only one pass through the vector x.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements to be used from the vector X.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> The vector for which a scaled sum of squares is computed.
-*> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of the vector X.
-*> INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> On entry, the value scale in the equation above.
-*> On exit, SCALE is overwritten with scl , the scaling factor
-*> for the sum of squares.
-*> \endverbatim
-*>
-*> \param[in,out] SUMSQ
-*> \verbatim
-*> SUMSQ is REAL
-*> On entry, the value sumsq in the equation above.
-*> On exit, SUMSQ is overwritten with smsq , the basic sum of
-*> squares from which scl has been factored out.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- REAL SCALE, SUMSQ
-* ..
-* .. Array Arguments ..
- REAL X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER IX
- REAL ABSXI
-* ..
-* .. External Functions ..
- LOGICAL SISNAN
- EXTERNAL SISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( N.GT.0 ) THEN
- DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
- ABSXI = ABS( X( IX ) )
- IF( ABSXI.GT.ZERO.OR.SISNAN( ABSXI ) ) THEN
- IF( SCALE.LT.ABSXI ) THEN
- SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
- SCALE = ABSXI
- ELSE
- SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
- END IF
- END IF
- 10 CONTINUE
- END IF
- RETURN
-*
-* End of SLASSQ
-*
- END
diff --git a/netlib/LAPACK/slasv2.f b/netlib/LAPACK/slasv2.f
deleted file mode 100644
index 24ae12c..0000000
--- a/netlib/LAPACK/slasv2.f
+++ /dev/null
@@ -1,325 +0,0 @@
-*> \brief \b SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASV2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasv2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasv2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasv2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-* .. Scalar Arguments ..
-* REAL CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASV2 computes the singular value decomposition of a 2-by-2
-*> triangular matrix
-*> [ F G ]
-*> [ 0 H ].
-*> On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
-*> smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
-*> right singular vectors for abs(SSMAX), giving the decomposition
-*>
-*> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
-*> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is REAL
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is REAL
-*> The (1,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is REAL
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is REAL
-*> abs(SSMIN) is the smaller singular value.
-*> \endverbatim
-*>
-*> \param[out] SSMAX
-*> \verbatim
-*> SSMAX is REAL
-*> abs(SSMAX) is the larger singular value.
-*> \endverbatim
-*>
-*> \param[out] SNL
-*> \verbatim
-*> SNL is REAL
-*> \endverbatim
-*>
-*> \param[out] CSL
-*> \verbatim
-*> CSL is REAL
-*> The vector (CSL, SNL) is a unit left singular vector for the
-*> singular value abs(SSMAX).
-*> \endverbatim
-*>
-*> \param[out] SNR
-*> \verbatim
-*> SNR is REAL
-*> \endverbatim
-*>
-*> \param[out] CSR
-*> \verbatim
-*> CSR is REAL
-*> The vector (CSR, SNR) is a unit right singular vector for the
-*> singular value abs(SSMAX).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Any input parameter may be aliased with any output parameter.
-*>
-*> Barring over/underflow and assuming a guard digit in subtraction, all
-*> output quantities are correct to within a few units in the last
-*> place (ulps).
-*>
-*> In IEEE arithmetic, the code works correctly if one matrix element is
-*> infinite.
-*>
-*> Overflow will not occur unless the largest singular value itself
-*> overflows or is within a few ulps of overflow. (On machines with
-*> partial overflow, like the Cray, overflow may occur if the largest
-*> singular value is within a factor of 2 of overflow.)
-*>
-*> Underflow is harmless if underflow is gradual. Otherwise, results
-*> may correspond to a matrix modified by perturbations of size near
-*> the underflow threshold.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL HALF
- PARAMETER ( HALF = 0.5E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E0 )
- REAL FOUR
- PARAMETER ( FOUR = 4.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL GASMAL, SWAP
- INTEGER PMAX
- REAL A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
- $ MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Executable Statements ..
-*
- FT = F
- FA = ABS( FT )
- HT = H
- HA = ABS( H )
-*
-* PMAX points to the maximum absolute element of matrix
-* PMAX = 1 if F largest in absolute values
-* PMAX = 2 if G largest in absolute values
-* PMAX = 3 if H largest in absolute values
-*
- PMAX = 1
- SWAP = ( HA.GT.FA )
- IF( SWAP ) THEN
- PMAX = 3
- TEMP = FT
- FT = HT
- HT = TEMP
- TEMP = FA
- FA = HA
- HA = TEMP
-*
-* Now FA .ge. HA
-*
- END IF
- GT = G
- GA = ABS( GT )
- IF( GA.EQ.ZERO ) THEN
-*
-* Diagonal matrix
-*
- SSMIN = HA
- SSMAX = FA
- CLT = ONE
- CRT = ONE
- SLT = ZERO
- SRT = ZERO
- ELSE
- GASMAL = .TRUE.
- IF( GA.GT.FA ) THEN
- PMAX = 2
- IF( ( FA / GA ).LT.SLAMCH( 'EPS' ) ) THEN
-*
-* Case of very large GA
-*
- GASMAL = .FALSE.
- SSMAX = GA
- IF( HA.GT.ONE ) THEN
- SSMIN = FA / ( GA / HA )
- ELSE
- SSMIN = ( FA / GA )*HA
- END IF
- CLT = ONE
- SLT = HT / GT
- SRT = ONE
- CRT = FT / GT
- END IF
- END IF
- IF( GASMAL ) THEN
-*
-* Normal case
-*
- D = FA - HA
- IF( D.EQ.FA ) THEN
-*
-* Copes with infinite F or H
-*
- L = ONE
- ELSE
- L = D / FA
- END IF
-*
-* Note that 0 .le. L .le. 1
-*
- M = GT / FT
-*
-* Note that abs(M) .le. 1/macheps
-*
- T = TWO - L
-*
-* Note that T .ge. 1
-*
- MM = M*M
- TT = T*T
- S = SQRT( TT+MM )
-*
-* Note that 1 .le. S .le. 1 + 1/macheps
-*
- IF( L.EQ.ZERO ) THEN
- R = ABS( M )
- ELSE
- R = SQRT( L*L+MM )
- END IF
-*
-* Note that 0 .le. R .le. 1 + 1/macheps
-*
- A = HALF*( S+R )
-*
-* Note that 1 .le. A .le. 1 + abs(M)
-*
- SSMIN = HA / A
- SSMAX = FA*A
- IF( MM.EQ.ZERO ) THEN
-*
-* Note that M is very tiny
-*
- IF( L.EQ.ZERO ) THEN
- T = SIGN( TWO, FT )*SIGN( ONE, GT )
- ELSE
- T = GT / SIGN( D, FT ) + M / T
- END IF
- ELSE
- T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
- END IF
- L = SQRT( T*T+FOUR )
- CRT = TWO / L
- SRT = T / L
- CLT = ( CRT+SRT*M ) / A
- SLT = ( HT / FT )*SRT / A
- END IF
- END IF
- IF( SWAP ) THEN
- CSL = SRT
- SNL = CRT
- CSR = SLT
- SNR = CLT
- ELSE
- CSL = CLT
- SNL = SLT
- CSR = CRT
- SNR = SRT
- END IF
-*
-* Correct signs of SSMAX and SSMIN
-*
- IF( PMAX.EQ.1 )
- $ TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
- IF( PMAX.EQ.2 )
- $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
- IF( PMAX.EQ.3 )
- $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
- SSMAX = SIGN( SSMAX, TSIGN )
- SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
- RETURN
-*
-* End of SLASV2
-*
- END
diff --git a/netlib/LAPACK/slaswp.f b/netlib/LAPACK/slaswp.f
deleted file mode 100644
index fb6f27d..0000000
--- a/netlib/LAPACK/slaswp.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b SLASWP performs a series of row interchanges on a general rectangular matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASWP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaswp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaswp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaswp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASWP performs a series of row interchanges on the matrix A.
-*> One row interchange is initiated for each of rows K1 through K2 of A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the matrix of column dimension N to which the row
-*> interchanges will be applied.
-*> On exit, the permuted matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> \endverbatim
-*>
-*> \param[in] K1
-*> \verbatim
-*> K1 is INTEGER
-*> The first element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] K2
-*> \verbatim
-*> K2 is INTEGER
-*> The last element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (K2*abs(INCX))
-*> The vector of pivot indices. Only the elements in positions
-*> K1 through K2 of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
-*> is negative, the pivots are applied in reverse order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by
-*> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
- REAL TEMP
-* ..
-* .. Executable Statements ..
-*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
- IF( INCX.GT.0 ) THEN
- IX0 = K1
- I1 = K1
- I2 = K2
- INC = 1
- ELSE IF( INCX.LT.0 ) THEN
- IX0 = 1 + ( 1-K2 )*INCX
- I1 = K2
- I2 = K1
- INC = -1
- ELSE
- RETURN
- END IF
-*
- N32 = ( N / 32 )*32
- IF( N32.NE.0 ) THEN
- DO 30 J = 1, N32, 32
- IX = IX0
- DO 20 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 10 K = J, J + 31
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 10 CONTINUE
- END IF
- IX = IX + INCX
- 20 CONTINUE
- 30 CONTINUE
- END IF
- IF( N32.NE.N ) THEN
- N32 = N32 + 1
- IX = IX0
- DO 50 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 40 K = N32, N
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 40 CONTINUE
- END IF
- IX = IX + INCX
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SLASWP
-*
- END
diff --git a/netlib/LAPACK/slasy2.f b/netlib/LAPACK/slasy2.f
deleted file mode 100644
index 5684a11..0000000
--- a/netlib/LAPACK/slasy2.f
+++ /dev/null
@@ -1,480 +0,0 @@
-*> \brief \b SLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASY2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasy2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasy2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasy2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
-* LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LTRANL, LTRANR
-* INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
-* REAL SCALE, XNORM
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
-*>
-*> op(TL)*X + ISGN*X*op(TR) = SCALE*B,
-*>
-*> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
-*> -1. op(T) = T or T**T, where T**T denotes the transpose of T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRANL
-*> \verbatim
-*> LTRANL is LOGICAL
-*> On entry, LTRANL specifies the op(TL):
-*> = .FALSE., op(TL) = TL,
-*> = .TRUE., op(TL) = TL**T.
-*> \endverbatim
-*>
-*> \param[in] LTRANR
-*> \verbatim
-*> LTRANR is LOGICAL
-*> On entry, LTRANR specifies the op(TR):
-*> = .FALSE., op(TR) = TR,
-*> = .TRUE., op(TR) = TR**T.
-*> \endverbatim
-*>
-*> \param[in] ISGN
-*> \verbatim
-*> ISGN is INTEGER
-*> On entry, ISGN specifies the sign of the equation
-*> as described before. ISGN may only be 1 or -1.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> On entry, N1 specifies the order of matrix TL.
-*> N1 may only be 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> On entry, N2 specifies the order of matrix TR.
-*> N2 may only be 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] TL
-*> \verbatim
-*> TL is REAL array, dimension (LDTL,2)
-*> On entry, TL contains an N1 by N1 matrix.
-*> \endverbatim
-*>
-*> \param[in] LDTL
-*> \verbatim
-*> LDTL is INTEGER
-*> The leading dimension of the matrix TL. LDTL >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[in] TR
-*> \verbatim
-*> TR is REAL array, dimension (LDTR,2)
-*> On entry, TR contains an N2 by N2 matrix.
-*> \endverbatim
-*>
-*> \param[in] LDTR
-*> \verbatim
-*> LDTR is INTEGER
-*> The leading dimension of the matrix TR. LDTR >= max(1,N2).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,2)
-*> On entry, the N1 by N2 matrix B contains the right-hand
-*> side of the equation.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the matrix B. LDB >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> On exit, SCALE contains the scale factor. SCALE is chosen
-*> less than or equal to 1 to prevent the solution overflowing.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,2)
-*> On exit, X contains the N1 by N2 solution.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the matrix X. LDX >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[out] XNORM
-*> \verbatim
-*> XNORM is REAL
-*> On exit, XNORM is the infinity-norm of the solution.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO is set to
-*> 0: successful exit.
-*> 1: TL and TR have too close eigenvalues, so TL or
-*> TR is perturbed to get a nonsingular equation.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYauxiliary
-*
-* =====================================================================
- SUBROUTINE SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
- $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL LTRANL, LTRANR
- INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
- REAL SCALE, XNORM
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL TWO, HALF, EIGHT
- PARAMETER ( TWO = 2.0E+0, HALF = 0.5E+0, EIGHT = 8.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BSWAP, XSWAP
- INTEGER I, IP, IPIV, IPSV, J, JP, JPSV, K
- REAL BET, EPS, GAM, L21, SGN, SMIN, SMLNUM, TAU1,
- $ TEMP, U11, U12, U22, XMAX
-* ..
-* .. Local Arrays ..
- LOGICAL BSWPIV( 4 ), XSWPIV( 4 )
- INTEGER JPIV( 4 ), LOCL21( 4 ), LOCU12( 4 ),
- $ LOCU22( 4 )
- REAL BTMP( 4 ), T16( 4, 4 ), TMP( 4 ), X2( 2 )
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Data statements ..
- DATA LOCU12 / 3, 4, 1, 2 / , LOCL21 / 2, 1, 4, 3 / ,
- $ LOCU22 / 4, 3, 2, 1 /
- DATA XSWPIV / .FALSE., .FALSE., .TRUE., .TRUE. /
- DATA BSWPIV / .FALSE., .TRUE., .FALSE., .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* Do not check the input parameters for errors
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N1.EQ.0 .OR. N2.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- SGN = ISGN
-*
- K = N1 + N1 + N2 - 2
- GO TO ( 10, 20, 30, 50 )K
-*
-* 1 by 1: TL11*X + SGN*X*TR11 = B11
-*
- 10 CONTINUE
- TAU1 = TL( 1, 1 ) + SGN*TR( 1, 1 )
- BET = ABS( TAU1 )
- IF( BET.LE.SMLNUM ) THEN
- TAU1 = SMLNUM
- BET = SMLNUM
- INFO = 1
- END IF
-*
- SCALE = ONE
- GAM = ABS( B( 1, 1 ) )
- IF( SMLNUM*GAM.GT.BET )
- $ SCALE = ONE / GAM
-*
- X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / TAU1
- XNORM = ABS( X( 1, 1 ) )
- RETURN
-*
-* 1 by 2:
-* TL11*[X11 X12] + ISGN*[X11 X12]*op[TR11 TR12] = [B11 B12]
-* [TR21 TR22]
-*
- 20 CONTINUE
-*
- SMIN = MAX( EPS*MAX( ABS( TL( 1, 1 ) ), ABS( TR( 1, 1 ) ),
- $ ABS( TR( 1, 2 ) ), ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) ),
- $ SMLNUM )
- TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- TMP( 4 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
- IF( LTRANR ) THEN
- TMP( 2 ) = SGN*TR( 2, 1 )
- TMP( 3 ) = SGN*TR( 1, 2 )
- ELSE
- TMP( 2 ) = SGN*TR( 1, 2 )
- TMP( 3 ) = SGN*TR( 2, 1 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 1, 2 )
- GO TO 40
-*
-* 2 by 1:
-* op[TL11 TL12]*[X11] + ISGN* [X11]*TR11 = [B11]
-* [TL21 TL22] [X21] [X21] [B21]
-*
- 30 CONTINUE
- SMIN = MAX( EPS*MAX( ABS( TR( 1, 1 ) ), ABS( TL( 1, 1 ) ),
- $ ABS( TL( 1, 2 ) ), ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) ),
- $ SMLNUM )
- TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- TMP( 4 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
- IF( LTRANL ) THEN
- TMP( 2 ) = TL( 1, 2 )
- TMP( 3 ) = TL( 2, 1 )
- ELSE
- TMP( 2 ) = TL( 2, 1 )
- TMP( 3 ) = TL( 1, 2 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 2, 1 )
- 40 CONTINUE
-*
-* Solve 2 by 2 system using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- IPIV = ISAMAX( 4, TMP, 1 )
- U11 = TMP( IPIV )
- IF( ABS( U11 ).LE.SMIN ) THEN
- INFO = 1
- U11 = SMIN
- END IF
- U12 = TMP( LOCU12( IPIV ) )
- L21 = TMP( LOCL21( IPIV ) ) / U11
- U22 = TMP( LOCU22( IPIV ) ) - U12*L21
- XSWAP = XSWPIV( IPIV )
- BSWAP = BSWPIV( IPIV )
- IF( ABS( U22 ).LE.SMIN ) THEN
- INFO = 1
- U22 = SMIN
- END IF
- IF( BSWAP ) THEN
- TEMP = BTMP( 2 )
- BTMP( 2 ) = BTMP( 1 ) - L21*TEMP
- BTMP( 1 ) = TEMP
- ELSE
- BTMP( 2 ) = BTMP( 2 ) - L21*BTMP( 1 )
- END IF
- SCALE = ONE
- IF( ( TWO*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( U22 ) .OR.
- $ ( TWO*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( U11 ) ) THEN
- SCALE = HALF / MAX( ABS( BTMP( 1 ) ), ABS( BTMP( 2 ) ) )
- BTMP( 1 ) = BTMP( 1 )*SCALE
- BTMP( 2 ) = BTMP( 2 )*SCALE
- END IF
- X2( 2 ) = BTMP( 2 ) / U22
- X2( 1 ) = BTMP( 1 ) / U11 - ( U12 / U11 )*X2( 2 )
- IF( XSWAP ) THEN
- TEMP = X2( 2 )
- X2( 2 ) = X2( 1 )
- X2( 1 ) = TEMP
- END IF
- X( 1, 1 ) = X2( 1 )
- IF( N1.EQ.1 ) THEN
- X( 1, 2 ) = X2( 2 )
- XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- ELSE
- X( 2, 1 ) = X2( 2 )
- XNORM = MAX( ABS( X( 1, 1 ) ), ABS( X( 2, 1 ) ) )
- END IF
- RETURN
-*
-* 2 by 2:
-* op[TL11 TL12]*[X11 X12] +ISGN* [X11 X12]*op[TR11 TR12] = [B11 B12]
-* [TL21 TL22] [X21 X22] [X21 X22] [TR21 TR22] [B21 B22]
-*
-* Solve equivalent 4 by 4 system using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- 50 CONTINUE
- SMIN = MAX( ABS( TR( 1, 1 ) ), ABS( TR( 1, 2 ) ),
- $ ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) )
- SMIN = MAX( SMIN, ABS( TL( 1, 1 ) ), ABS( TL( 1, 2 ) ),
- $ ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) )
- SMIN = MAX( EPS*SMIN, SMLNUM )
- BTMP( 1 ) = ZERO
- CALL SCOPY( 16, BTMP, 0, T16, 1 )
- T16( 1, 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- T16( 2, 2 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
- T16( 3, 3 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
- T16( 4, 4 ) = TL( 2, 2 ) + SGN*TR( 2, 2 )
- IF( LTRANL ) THEN
- T16( 1, 2 ) = TL( 2, 1 )
- T16( 2, 1 ) = TL( 1, 2 )
- T16( 3, 4 ) = TL( 2, 1 )
- T16( 4, 3 ) = TL( 1, 2 )
- ELSE
- T16( 1, 2 ) = TL( 1, 2 )
- T16( 2, 1 ) = TL( 2, 1 )
- T16( 3, 4 ) = TL( 1, 2 )
- T16( 4, 3 ) = TL( 2, 1 )
- END IF
- IF( LTRANR ) THEN
- T16( 1, 3 ) = SGN*TR( 1, 2 )
- T16( 2, 4 ) = SGN*TR( 1, 2 )
- T16( 3, 1 ) = SGN*TR( 2, 1 )
- T16( 4, 2 ) = SGN*TR( 2, 1 )
- ELSE
- T16( 1, 3 ) = SGN*TR( 2, 1 )
- T16( 2, 4 ) = SGN*TR( 2, 1 )
- T16( 3, 1 ) = SGN*TR( 1, 2 )
- T16( 4, 2 ) = SGN*TR( 1, 2 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 2, 1 )
- BTMP( 3 ) = B( 1, 2 )
- BTMP( 4 ) = B( 2, 2 )
-*
-* Perform elimination
-*
- DO 100 I = 1, 3
- XMAX = ZERO
- DO 70 IP = I, 4
- DO 60 JP = I, 4
- IF( ABS( T16( IP, JP ) ).GE.XMAX ) THEN
- XMAX = ABS( T16( IP, JP ) )
- IPSV = IP
- JPSV = JP
- END IF
- 60 CONTINUE
- 70 CONTINUE
- IF( IPSV.NE.I ) THEN
- CALL SSWAP( 4, T16( IPSV, 1 ), 4, T16( I, 1 ), 4 )
- TEMP = BTMP( I )
- BTMP( I ) = BTMP( IPSV )
- BTMP( IPSV ) = TEMP
- END IF
- IF( JPSV.NE.I )
- $ CALL SSWAP( 4, T16( 1, JPSV ), 1, T16( 1, I ), 1 )
- JPIV( I ) = JPSV
- IF( ABS( T16( I, I ) ).LT.SMIN ) THEN
- INFO = 1
- T16( I, I ) = SMIN
- END IF
- DO 90 J = I + 1, 4
- T16( J, I ) = T16( J, I ) / T16( I, I )
- BTMP( J ) = BTMP( J ) - T16( J, I )*BTMP( I )
- DO 80 K = I + 1, 4
- T16( J, K ) = T16( J, K ) - T16( J, I )*T16( I, K )
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- IF( ABS( T16( 4, 4 ) ).LT.SMIN )
- $ T16( 4, 4 ) = SMIN
- SCALE = ONE
- IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 3 ) ).GT.ABS( T16( 3, 3 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 4 ) ).GT.ABS( T16( 4, 4 ) ) ) THEN
- SCALE = ( ONE / EIGHT ) / MAX( ABS( BTMP( 1 ) ),
- $ ABS( BTMP( 2 ) ), ABS( BTMP( 3 ) ), ABS( BTMP( 4 ) ) )
- BTMP( 1 ) = BTMP( 1 )*SCALE
- BTMP( 2 ) = BTMP( 2 )*SCALE
- BTMP( 3 ) = BTMP( 3 )*SCALE
- BTMP( 4 ) = BTMP( 4 )*SCALE
- END IF
- DO 120 I = 1, 4
- K = 5 - I
- TEMP = ONE / T16( K, K )
- TMP( K ) = BTMP( K )*TEMP
- DO 110 J = K + 1, 4
- TMP( K ) = TMP( K ) - ( TEMP*T16( K, J ) )*TMP( J )
- 110 CONTINUE
- 120 CONTINUE
- DO 130 I = 1, 3
- IF( JPIV( 4-I ).NE.4-I ) THEN
- TEMP = TMP( 4-I )
- TMP( 4-I ) = TMP( JPIV( 4-I ) )
- TMP( JPIV( 4-I ) ) = TEMP
- END IF
- 130 CONTINUE
- X( 1, 1 ) = TMP( 1 )
- X( 2, 1 ) = TMP( 2 )
- X( 1, 2 ) = TMP( 3 )
- X( 2, 2 ) = TMP( 4 )
- XNORM = MAX( ABS( TMP( 1 ) )+ABS( TMP( 3 ) ),
- $ ABS( TMP( 2 ) )+ABS( TMP( 4 ) ) )
- RETURN
-*
-* End of SLASY2
-*
- END
diff --git a/netlib/LAPACK/slasyf.f b/netlib/LAPACK/slasyf.f
deleted file mode 100644
index 20c8ffa..0000000
--- a/netlib/LAPACK/slasyf.f
+++ /dev/null
@@ -1,666 +0,0 @@
-*> \brief \b SLASYF computes a partial factorization of a real symmetric matrix, using the diagonal pivoting method.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASYF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasyf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasyf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasyf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KB, LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), W( LDW, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLASYF computes a partial factorization of a real symmetric matrix A
-*> using the Bunch-Kaufman diagonal pivoting method. The partial
-*> factorization has the form:
-*>
-*> A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
-*> ( 0 U22 ) ( 0 D ) ( U12**T U22**T )
-*>
-*> A = ( L11 0 ) ( D 0 ) ( L11**T L21**T ) if UPLO = 'L'
-*> ( L21 I ) ( 0 A22 ) ( 0 I )
-*>
-*> where the order of D is at most NB. The actual order is returned in
-*> the argument KB, and is either NB or NB-1, or N if N <= NB.
-*>
-*> SLASYF is an auxiliary routine called by SSYTRF. It uses blocked code
-*> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
-*> A22 (if UPLO = 'L').
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The maximum number of columns of the matrix A that should be
-*> factored. NB should be at least 2 to allow for 2-by-2 pivot
-*> blocks.
-*> \endverbatim
-*>
-*> \param[out] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of columns of A that were actually factored.
-*> KB is either NB-1 or NB, or N if N <= NB.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, A contains details of the partial factorization.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If UPLO = 'U', only the last KB elements of IPIV are set;
-*> if UPLO = 'L', only the first KB elements are set.
-*>
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (LDW,NB)
-*> \endverbatim
-*>
-*> \param[in] LDW
-*> \verbatim
-*> LDW is INTEGER
-*> The leading dimension of the array W. LDW >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> > 0: if INFO = k, D(k,k) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KB, LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), W( LDW, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL EIGHT, SEVTEN
- PARAMETER ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP,
- $ KSTEP, KW
- REAL ABSAKK, ALPHA, COLMAX, D11, D21, D22, R1,
- $ ROWMAX, T
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- EXTERNAL LSAME, ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMM, SGEMV, SSCAL, SSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Initialize ALPHA for use in choosing pivot block size.
-*
- ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Factorize the trailing columns of A using the upper triangle
-* of A and working backwards, and compute the matrix W = U12*D
-* for use in updating A11
-*
-* K is the main loop index, decreasing from N in steps of 1 or 2
-*
-* KW is the column of W which corresponds to column K of A
-*
- K = N
- 10 CONTINUE
- KW = NB + K - N
-*
-* Exit from loop
-*
- IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
- $ GO TO 30
-*
-* Copy column K of A to column KW of W and update it
-*
- CALL SCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
- IF( K.LT.N )
- $ CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), LDA,
- $ W( K, KW+1 ), LDW, ONE, W( 1, KW ), 1 )
-*
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( W( K, KW ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.GT.1 ) THEN
- IMAX = ISAMAX( K-1, W( 1, KW ), 1 )
- COLMAX = ABS( W( IMAX, KW ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* Copy column IMAX to column KW-1 of W and update it
-*
- CALL SCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 )
- CALL SCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
- $ W( IMAX+1, KW-1 ), 1 )
- IF( K.LT.N )
- $ CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ),
- $ LDA, W( IMAX, KW+1 ), LDW, ONE,
- $ W( 1, KW-1 ), 1 )
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = IMAX + ISAMAX( K-IMAX, W( IMAX+1, KW-1 ), 1 )
- ROWMAX = ABS( W( JMAX, KW-1 ) )
- IF( IMAX.GT.1 ) THEN
- JMAX = ISAMAX( IMAX-1, W( 1, KW-1 ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( W( JMAX, KW-1 ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( W( IMAX, KW-1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
-*
-* copy column KW-1 of W to column KW
-*
- CALL SCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
- ELSE
-*
-* interchange rows and columns K-1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K - KSTEP + 1
- KKW = NB + KK - N
-*
-* Updated column KP is already stored in column KKW of W
-*
- IF( KP.NE.KK ) THEN
-*
-* Copy non-updated column KK to column KP
-*
- A( KP, K ) = A( KK, K )
- CALL SCOPY( K-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
- $ LDA )
- CALL SCOPY( KP, A( 1, KK ), 1, A( 1, KP ), 1 )
-*
-* Interchange rows KK and KP in last KK columns of A and W
-*
- CALL SSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA )
- CALL SSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
- $ LDW )
- END IF
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column KW of W now holds
-*
-* W(k) = U(k)*D(k)
-*
-* where U(k) is the k-th column of U
-*
-* Store U(k) in column k of A
-*
- CALL SCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
- R1 = ONE / A( K, K )
- CALL SSCAL( K-1, R1, A( 1, K ), 1 )
- ELSE
-*
-* 2-by-2 pivot block D(k): columns KW and KW-1 of W now
-* hold
-*
-* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
-*
-* where U(k) and U(k-1) are the k-th and (k-1)-th columns
-* of U
-*
- IF( K.GT.2 ) THEN
-*
-* Store U(k) and U(k-1) in columns k and k-1 of A
-*
- D21 = W( K-1, KW )
- D11 = W( K, KW ) / D21
- D22 = W( K-1, KW-1 ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
- DO 20 J = 1, K - 2
- A( J, K-1 ) = D21*( D11*W( J, KW-1 )-W( J, KW ) )
- A( J, K ) = D21*( D22*W( J, KW )-W( J, KW-1 ) )
- 20 CONTINUE
- END IF
-*
-* Copy D(k) to A
-*
- A( K-1, K-1 ) = W( K-1, KW-1 )
- A( K-1, K ) = W( K-1, KW )
- A( K, K ) = W( K, KW )
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K-1 ) = -KP
- END IF
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KSTEP
- GO TO 10
-*
- 30 CONTINUE
-*
-* Update the upper triangle of A11 (= A(1:k,1:k)) as
-*
-* A11 := A11 - U12*D*U12**T = A11 - U12*W**T
-*
-* computing blocks of NB columns at a time
-*
- DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
- JB = MIN( NB, K-J+1 )
-*
-* Update the upper triangle of the diagonal block
-*
- DO 40 JJ = J, J + JB - 1
- CALL SGEMV( 'No transpose', JJ-J+1, N-K, -ONE,
- $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE,
- $ A( J, JJ ), 1 )
- 40 CONTINUE
-*
-* Update the rectangular superdiagonal block
-*
- CALL SGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, -ONE,
- $ A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, ONE,
- $ A( 1, J ), LDA )
- 50 CONTINUE
-*
-* Put U12 in standard form by partially undoing the interchanges
-* in columns k+1:n
-*
- J = K + 1
- 60 CONTINUE
- JJ = J
- JP = IPIV( J )
- IF( JP.LT.0 ) THEN
- JP = -JP
- J = J + 1
- END IF
- J = J + 1
- IF( JP.NE.JJ .AND. J.LE.N )
- $ CALL SSWAP( N-J+1, A( JP, J ), LDA, A( JJ, J ), LDA )
- IF( J.LE.N )
- $ GO TO 60
-*
-* Set KB to the number of columns factorized
-*
- KB = N - K
-*
- ELSE
-*
-* Factorize the leading columns of A using the lower triangle
-* of A and working forwards, and compute the matrix W = L21*D
-* for use in updating A22
-*
-* K is the main loop index, increasing from 1 in steps of 1 or 2
-*
- K = 1
- 70 CONTINUE
-*
-* Exit from loop
-*
- IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
- $ GO TO 90
-*
-* Copy column K of A to column K of W and update it
-*
- CALL SCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
- CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), LDA,
- $ W( K, 1 ), LDW, ONE, W( K, K ), 1 )
-*
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( W( K, K ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.LT.N ) THEN
- IMAX = K + ISAMAX( N-K, W( K+1, K ), 1 )
- COLMAX = ABS( W( IMAX, K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* Copy column IMAX to column K+1 of W and update it
-*
- CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 )
- CALL SCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ),
- $ 1 )
- CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ),
- $ LDA, W( IMAX, 1 ), LDW, ONE, W( K, K+1 ), 1 )
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = K - 1 + ISAMAX( IMAX-K, W( K, K+1 ), 1 )
- ROWMAX = ABS( W( JMAX, K+1 ) )
- IF( IMAX.LT.N ) THEN
- JMAX = IMAX + ISAMAX( N-IMAX, W( IMAX+1, K+1 ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( W( JMAX, K+1 ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( W( IMAX, K+1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
-*
-* copy column K+1 of W to column K
-*
- CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
- ELSE
-*
-* interchange rows and columns K+1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K + KSTEP - 1
-*
-* Updated column KP is already stored in column KK of W
-*
- IF( KP.NE.KK ) THEN
-*
-* Copy non-updated column KK to column KP
-*
- A( KP, K ) = A( KK, K )
- CALL SCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA )
- CALL SCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 )
-*
-* Interchange rows KK and KP in first KK columns of A and W
-*
- CALL SSWAP( KK, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
- CALL SSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
- END IF
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k of W now holds
-*
-* W(k) = L(k)*D(k)
-*
-* where L(k) is the k-th column of L
-*
-* Store L(k) in column k of A
-*
- CALL SCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
- IF( K.LT.N ) THEN
- R1 = ONE / A( K, K )
- CALL SSCAL( N-K, R1, A( K+1, K ), 1 )
- END IF
- ELSE
-*
-* 2-by-2 pivot block D(k): columns k and k+1 of W now hold
-*
-* ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th columns
-* of L
-*
- IF( K.LT.N-1 ) THEN
-*
-* Store L(k) and L(k+1) in columns k and k+1 of A
-*
- D21 = W( K+1, K )
- D11 = W( K+1, K+1 ) / D21
- D22 = W( K, K ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
- DO 80 J = K + 2, N
- A( J, K ) = D21*( D11*W( J, K )-W( J, K+1 ) )
- A( J, K+1 ) = D21*( D22*W( J, K+1 )-W( J, K ) )
- 80 CONTINUE
- END IF
-*
-* Copy D(k) to A
-*
- A( K, K ) = W( K, K )
- A( K+1, K ) = W( K+1, K )
- A( K+1, K+1 ) = W( K+1, K+1 )
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K+1 ) = -KP
- END IF
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KSTEP
- GO TO 70
-*
- 90 CONTINUE
-*
-* Update the lower triangle of A22 (= A(k:n,k:n)) as
-*
-* A22 := A22 - L21*D*L21**T = A22 - L21*W**T
-*
-* computing blocks of NB columns at a time
-*
- DO 110 J = K, N, NB
- JB = MIN( NB, N-J+1 )
-*
-* Update the lower triangle of the diagonal block
-*
- DO 100 JJ = J, J + JB - 1
- CALL SGEMV( 'No transpose', J+JB-JJ, K-1, -ONE,
- $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE,
- $ A( JJ, JJ ), 1 )
- 100 CONTINUE
-*
-* Update the rectangular subdiagonal block
-*
- IF( J+JB.LE.N )
- $ CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
- $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW,
- $ ONE, A( J+JB, J ), LDA )
- 110 CONTINUE
-*
-* Put L21 in standard form by partially undoing the interchanges
-* in columns 1:k-1
-*
- J = K - 1
- 120 CONTINUE
- JJ = J
- JP = IPIV( J )
- IF( JP.LT.0 ) THEN
- JP = -JP
- J = J - 1
- END IF
- J = J - 1
- IF( JP.NE.JJ .AND. J.GE.1 )
- $ CALL SSWAP( J, A( JP, 1 ), LDA, A( JJ, 1 ), LDA )
- IF( J.GE.1 )
- $ GO TO 120
-*
-* Set KB to the number of columns factorized
-*
- KB = K - 1
-*
- END IF
- RETURN
-*
-* End of SLASYF
-*
- END
diff --git a/netlib/LAPACK/slatbs.f b/netlib/LAPACK/slatbs.f
deleted file mode 100644
index 1cd7cb7..0000000
--- a/netlib/LAPACK/slatbs.f
+++ /dev/null
@@ -1,812 +0,0 @@
-*> \brief \b SLATBS solves a triangular banded system of equations.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLATBS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatbs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatbs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatbs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
-* SCALE, CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, N
-* REAL SCALE
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATBS solves one of the triangular systems
-*>
-*> A *x = s*b or A**T*x = s*b
-*>
-*> with scaling to prevent overflow, where A is an upper or lower
-*> triangular band matrix. Here A**T denotes the transpose of A, x and b
-*> are n-element vectors, and s is a scaling factor, usually less than
-*> or equal to 1, chosen so that the components of x will be less than
-*> the overflow threshold. If the unscaled problem will not cause
-*> overflow, the Level 2 BLAS routine STBSV is called. If the matrix A
-*> is singular (A(j,j) = 0 for some j), then s is set to 0 and a
-*> non-trivial solution to A*x = 0 is returned.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of subdiagonals or superdiagonals in the
-*> triangular matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is REAL array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, STBSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine STBSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call STBSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
- $ SCALE, CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, KD, LDAB, N
- REAL SCALE
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, J, JFIRST, JINC, JLAST, JLEN, MAIND
- REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SASUM, SDOT, SLAMCH
- EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SSCAL, STBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( KD.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATBS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- DO 10 J = 1, N
- JLEN = MIN( KD, J-1 )
- CNORM( J ) = SASUM( JLEN, AB( KD+1-JLEN, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- DO 20 J = 1, N
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 ) THEN
- CNORM( J ) = SASUM( JLEN, AB( 2, J ), 1 )
- ELSE
- CNORM( J ) = ZERO
- END IF
- 20 CONTINUE
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = ISAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL SSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine STBSV can be used.
-*
- J = ISAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- MAIND = KD + 1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- MAIND = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( AB( MAIND, J ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- MAIND = KD + 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- MAIND = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( AB( MAIND, J ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL SSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- DO 100 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 95
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 95 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL SSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(max(1,j-kd):j-1) := x(max(1,j-kd):j-1) -
-* x(j)* A(max(1,j-kd):j-1,j)
-*
- JLEN = MIN( KD, J-1 )
- CALL SAXPY( JLEN, -X( J )*TSCAL,
- $ AB( KD+1-JLEN, J ), 1, X( J-JLEN ), 1 )
- I = ISAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- ELSE IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:min(j+kd,n)) := x(j+1:min(j+kd,n)) -
-* x(j) * A(j+1:min(j+kd,n),j)
-*
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 )
- $ CALL SAXPY( JLEN, -X( J )*TSCAL, AB( 2, J ), 1,
- $ X( J+1 ), 1 )
- I = J + ISAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- 100 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- DO 140 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call SDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- JLEN = MIN( KD, J-1 )
- SUMJ = SDOT( JLEN, AB( KD+1-JLEN, J ), 1,
- $ X( J-JLEN ), 1 )
- ELSE
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 )
- $ SUMJ = SDOT( JLEN, AB( 2, J ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- JLEN = MIN( KD, J-1 )
- DO 110 I = 1, JLEN
- SUMJ = SUMJ + ( AB( KD+I-JLEN, J )*USCAL )*
- $ X( J-JLEN-1+I )
- 110 CONTINUE
- ELSE
- JLEN = MIN( KD, N-J )
- DO 120 I = 1, JLEN
- SUMJ = SUMJ + ( AB( I+1, J )*USCAL )*X( J+I )
- 120 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 135
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 130 I = 1, N
- X( I ) = ZERO
- 130 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 135 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- 140 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL SSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of SLATBS
-*
- END
diff --git a/netlib/LAPACK/slatdf.f b/netlib/LAPACK/slatdf.f
deleted file mode 100644
index 51773d4..0000000
--- a/netlib/LAPACK/slatdf.f
+++ /dev/null
@@ -1,323 +0,0 @@
-*> \brief \b SLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLATDF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatdf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatdf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatdf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
-* JPIV )
-*
-* .. Scalar Arguments ..
-* INTEGER IJOB, LDZ, N
-* REAL RDSCAL, RDSUM
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), JPIV( * )
-* REAL RHS( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATDF uses the LU factorization of the n-by-n matrix Z computed by
-*> SGETC2 and computes a contribution to the reciprocal Dif-estimate
-*> by solving Z * x = b for x, and choosing the r.h.s. b such that
-*> the norm of x is as large as possible. On entry RHS = b holds the
-*> contribution from earlier solved sub-systems, and on return RHS = x.
-*>
-*> The factorization of Z returned by SGETC2 has the form Z = P*L*U*Q,
-*> where P and Q are permutation matrices. L is lower triangular with
-*> unit diagonal elements and U is upper triangular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> IJOB = 2: First compute an approximative null-vector e
-*> of Z using SGECON, e is normalized and solve for
-*> Zx = +-e - f with the sign giving the greater value
-*> of 2-norm(x). About 5 times as expensive as Default.
-*> IJOB .ne. 2: Local look ahead strategy where all entries of
-*> the r.h.s. b is choosen as either +1 or -1 (Default).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Z.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> On entry, the LU part of the factorization of the n-by-n
-*> matrix Z computed by SGETC2: Z = P * L * U * Q
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDA >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] RHS
-*> \verbatim
-*> RHS is REAL array, dimension N.
-*> On entry, RHS contains contributions from other subsystems.
-*> On exit, RHS contains the solution of the subsystem with
-*> entries acoording to the value of IJOB (see above).
-*> \endverbatim
-*>
-*> \param[in,out] RDSUM
-*> \verbatim
-*> RDSUM is REAL
-*> On entry, the sum of squares of computed contributions to
-*> the Dif-estimate under computation by STGSYL, where the
-*> scaling factor RDSCAL (see below) has been factored out.
-*> On exit, the corresponding sum of squares updated with the
-*> contributions from the current sub-system.
-*> If TRANS = 'T' RDSUM is not touched.
-*> NOTE: RDSUM only makes sense when STGSY2 is called by STGSYL.
-*> \endverbatim
-*>
-*> \param[in,out] RDSCAL
-*> \verbatim
-*> RDSCAL is REAL
-*> On entry, scaling factor used to prevent overflow in RDSUM.
-*> On exit, RDSCAL is updated w.r.t. the current contributions
-*> in RDSUM.
-*> If TRANS = 'T', RDSCAL is not touched.
-*> NOTE: RDSCAL only makes sense when STGSY2 is called by
-*> STGSYL.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= i <= N, row i of the
-*> matrix has been interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] JPIV
-*> \verbatim
-*> JPIV is INTEGER array, dimension (N).
-*> The pivot indices; for 1 <= j <= N, column j of the
-*> matrix has been interchanged with column JPIV(j).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> This routine is a further developed implementation of algorithm
-*> BSOLVE in [1] using complete pivoting in the LU factorization.
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*>
-*> [1] Bo Kagstrom and Lars Westin,
-*> Generalized Schur Methods with Condition Estimators for
-*> Solving the Generalized Sylvester Equation, IEEE Transactions
-*> on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
-*>
-*> [2] Peter Poromaa,
-*> On Efficient and Robust Estimators for the Separation
-*> between two Regular Matrix Pairs with Applications in
-*> Condition Estimation. Report IMINF-95.05, Departement of
-*> Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
- $ JPIV )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER IJOB, LDZ, N
- REAL RDSCAL, RDSUM
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- REAL RHS( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXDIM
- PARAMETER ( MAXDIM = 8 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J, K
- REAL BM, BP, PMONE, SMINU, SPLUS, TEMP
-* ..
-* .. Local Arrays ..
- INTEGER IWORK( MAXDIM )
- REAL WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGECON, SGESC2, SLASSQ, SLASWP,
- $ SSCAL
-* ..
-* .. External Functions ..
- REAL SASUM, SDOT
- EXTERNAL SASUM, SDOT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( IJOB.NE.2 ) THEN
-*
-* Apply permutations IPIV to RHS
-*
- CALL SLASWP( 1, RHS, LDZ, 1, N-1, IPIV, 1 )
-*
-* Solve for L-part choosing RHS either to +1 or -1.
-*
- PMONE = -ONE
-*
- DO 10 J = 1, N - 1
- BP = RHS( J ) + ONE
- BM = RHS( J ) - ONE
- SPLUS = ONE
-*
-* Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and
-* SMIN computed more efficiently than in BSOLVE [1].
-*
- SPLUS = SPLUS + SDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), 1 )
- SMINU = SDOT( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 )
- SPLUS = SPLUS*RHS( J )
- IF( SPLUS.GT.SMINU ) THEN
- RHS( J ) = BP
- ELSE IF( SMINU.GT.SPLUS ) THEN
- RHS( J ) = BM
- ELSE
-*
-* In this case the updating sums are equal and we can
-* choose RHS(J) +1 or -1. The first time this happens
-* we choose -1, thereafter +1. This is a simple way to
-* get good estimates of matrices like Byers well-known
-* example (see [1]). (Not done in BSOLVE.)
-*
- RHS( J ) = RHS( J ) + PMONE
- PMONE = ONE
- END IF
-*
-* Compute the remaining r.h.s.
-*
- TEMP = -RHS( J )
- CALL SAXPY( N-J, TEMP, Z( J+1, J ), 1, RHS( J+1 ), 1 )
-*
- 10 CONTINUE
-*
-* Solve for U-part, look-ahead for RHS(N) = +-1. This is not done
-* in BSOLVE and will hopefully give us a better estimate because
-* any ill-conditioning of the original matrix is transfered to U
-* and not to L. U(N, N) is an approximation to sigma_min(LU).
-*
- CALL SCOPY( N-1, RHS, 1, XP, 1 )
- XP( N ) = RHS( N ) + ONE
- RHS( N ) = RHS( N ) - ONE
- SPLUS = ZERO
- SMINU = ZERO
- DO 30 I = N, 1, -1
- TEMP = ONE / Z( I, I )
- XP( I ) = XP( I )*TEMP
- RHS( I ) = RHS( I )*TEMP
- DO 20 K = I + 1, N
- XP( I ) = XP( I ) - XP( K )*( Z( I, K )*TEMP )
- RHS( I ) = RHS( I ) - RHS( K )*( Z( I, K )*TEMP )
- 20 CONTINUE
- SPLUS = SPLUS + ABS( XP( I ) )
- SMINU = SMINU + ABS( RHS( I ) )
- 30 CONTINUE
- IF( SPLUS.GT.SMINU )
- $ CALL SCOPY( N, XP, 1, RHS, 1 )
-*
-* Apply the permutations JPIV to the computed solution (RHS)
-*
- CALL SLASWP( 1, RHS, LDZ, 1, N-1, JPIV, -1 )
-*
-* Compute the sum of squares
-*
- CALL SLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-*
- ELSE
-*
-* IJOB = 2, Compute approximate nullvector XM of Z
-*
- CALL SGECON( 'I', N, Z, LDZ, ONE, TEMP, WORK, IWORK, INFO )
- CALL SCOPY( N, WORK( N+1 ), 1, XM, 1 )
-*
-* Compute RHS
-*
- CALL SLASWP( 1, XM, LDZ, 1, N-1, IPIV, -1 )
- TEMP = ONE / SQRT( SDOT( N, XM, 1, XM, 1 ) )
- CALL SSCAL( N, TEMP, XM, 1 )
- CALL SCOPY( N, XM, 1, XP, 1 )
- CALL SAXPY( N, ONE, RHS, 1, XP, 1 )
- CALL SAXPY( N, -ONE, XM, 1, RHS, 1 )
- CALL SGESC2( N, Z, LDZ, RHS, IPIV, JPIV, TEMP )
- CALL SGESC2( N, Z, LDZ, XP, IPIV, JPIV, TEMP )
- IF( SASUM( N, XP, 1 ).GT.SASUM( N, RHS, 1 ) )
- $ CALL SCOPY( N, XP, 1, RHS, 1 )
-*
-* Compute the sum of squares
-*
- CALL SLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-*
- END IF
-*
- RETURN
-*
-* End of SLATDF
-*
- END
diff --git a/netlib/LAPACK/slatm1.f b/netlib/LAPACK/slatm1.f
deleted file mode 100644
index 26c457e..0000000
--- a/netlib/LAPACK/slatm1.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b SLATM1
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IDIST, INFO, IRSIGN, MODE, N
-* REAL COND
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATM1 computes the entries of D(1..N) as specified by
-*> MODE, COND and IRSIGN. IDIST and ISEED determine the generation
-*> of random numbers. SLATM1 is called by SLATMR to generate
-*> random test matrices for LAPACK programs.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry describes how D is to be computed:
-*> MODE = 0 means do not change D.
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is REAL
-*> On entry, used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IRSIGN
-*> \verbatim
-*> IRSIGN is INTEGER
-*> On entry, if MODE neither -6, 0 nor 6, determines sign of
-*> entries of D
-*> 0 => leave entries of D unchanged
-*> 1 => multiply each entry of D by 1 or -1 with probability .5
-*> \endverbatim
-*>
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is CHARACTER*1
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. The random number generator uses a
-*> linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to SLATM1
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension ( MIN( M , N ) )
-*> Array to be computed according to MODE, COND and IRSIGN.
-*> May be changed on exit if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of entries of D. Not modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> 0 => normal termination
-*> -1 => if MODE not in range -6 to 6
-*> -2 => if MODE neither -6, 0 nor 6, and
-*> IRSIGN neither 0 nor 1
-*> -3 => if MODE neither -6, 0 nor 6 and COND less than 1
-*> -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3
-*> -7 => if N negative
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IDIST, INFO, IRSIGN, MODE, N
- REAL COND
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL HALF
- PARAMETER ( HALF = 0.5E0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL ALPHA, TEMP
-* ..
-* .. External Functions ..
- REAL SLARAN
- EXTERNAL SLARAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARNV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, EXP, LOG, REAL
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters. Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set INFO if an error
-*
- IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
- INFO = -1
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
- INFO = -2
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ COND.LT.ONE ) THEN
- INFO = -3
- ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
- $ ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATM1', -INFO )
- RETURN
- END IF
-*
-* Compute D according to COND and MODE
-*
- IF( MODE.NE.0 ) THEN
- GO TO ( 10, 30, 50, 70, 90, 110 )ABS( MODE )
-*
-* One large D value:
-*
- 10 CONTINUE
- DO 20 I = 1, N
- D( I ) = ONE / COND
- 20 CONTINUE
- D( 1 ) = ONE
- GO TO 120
-*
-* One small D value:
-*
- 30 CONTINUE
- DO 40 I = 1, N
- D( I ) = ONE
- 40 CONTINUE
- D( N ) = ONE / COND
- GO TO 120
-*
-* Exponentially distributed D values:
-*
- 50 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 ) THEN
- ALPHA = COND**( -ONE / REAL( N-1 ) )
- DO 60 I = 2, N
- D( I ) = ALPHA**( I-1 )
- 60 CONTINUE
- END IF
- GO TO 120
-*
-* Arithmetically distributed D values:
-*
- 70 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 ) THEN
- TEMP = ONE / COND
- ALPHA = ( ONE-TEMP ) / REAL( N-1 )
- DO 80 I = 2, N
- D( I ) = REAL( N-I )*ALPHA + TEMP
- 80 CONTINUE
- END IF
- GO TO 120
-*
-* Randomly distributed D values on ( 1/COND , 1):
-*
- 90 CONTINUE
- ALPHA = LOG( ONE / COND )
- DO 100 I = 1, N
- D( I ) = EXP( ALPHA*SLARAN( ISEED ) )
- 100 CONTINUE
- GO TO 120
-*
-* Randomly distributed D values from IDIST
-*
- 110 CONTINUE
- CALL SLARNV( IDIST, ISEED, N, D )
-*
- 120 CONTINUE
-*
-* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
-* random signs to D
-*
- IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ IRSIGN.EQ.1 ) THEN
- DO 130 I = 1, N
- TEMP = SLARAN( ISEED )
- IF( TEMP.GT.HALF )
- $ D( I ) = -D( I )
- 130 CONTINUE
- END IF
-*
-* Reverse if MODE < 0
-*
- IF( MODE.LT.0 ) THEN
- DO 140 I = 1, N / 2
- TEMP = D( I )
- D( I ) = D( N+1-I )
- D( N+1-I ) = TEMP
- 140 CONTINUE
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SLATM1
-*
- END
diff --git a/netlib/LAPACK/slatm2.f b/netlib/LAPACK/slatm2.f
deleted file mode 100644
index 88dcd64..0000000
--- a/netlib/LAPACK/slatm2.f
+++ /dev/null
@@ -1,315 +0,0 @@
-*> \brief \b SLATM2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLATM2( M, N, I, J, KL, KU, IDIST,
-* ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
-*
-* .. Scalar Arguments ..
-*
-* INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
-* REAL SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
-* INTEGER ISEED( 4 ), IWORK( * )
-* REAL D( * ), DL( * ), DR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATM2 returns the (I,J) entry of a random matrix of dimension
-*> (M, N) described by the other paramters. It is called by the
-*> SLATMR routine in order to build random test matrices. No error
-*> checking on parameters is done, because this routine is called in
-*> a tight loop by SLATMR which has already checked the parameters.
-*>
-*> Use of SLATM2 differs from SLATM3 in the order in which the random
-*> number generator is called to fill in random matrix entries.
-*> With SLATM2, the generator is called to fill in the pivoted matrix
-*> columnwise. With SLATM3, the generator is called to fill in the
-*> matrix columnwise, after which it is pivoted. Thus, SLATM3 can
-*> be used to construct random matrices which differ only in their
-*> order of rows and/or columns. SLATM2 is used to construct band
-*> matrices while avoiding calling the random number generator for
-*> entries outside the band (and therefore generating random numbers
-*>
-*> The matrix whose (I,J) entry is returned is constructed as
-*> follows (this routine only computes one entry):
-*>
-*> If I is outside (1..M) or J is outside (1..N), return zero
-*> (this is convenient for generating matrices in band format).
-*>
-*> Generate a matrix A with random entries of distribution IDIST.
-*>
-*> Set the diagonal to D.
-*>
-*> Grade the matrix, if desired, from the left (by DL) and/or
-*> from the right (by DR or DL) as specified by IGRADE.
-*>
-*> Permute, if desired, the rows and/or columns as specified by
-*> IPVTNG and IWORK.
-*>
-*> Band the matrix to have lower bandwidth KL and upper
-*> bandwidth KU.
-*>
-*> Set random entries to zero as specified by SPARSE.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Number of rows of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of columns of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> Row of entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in] J
-*> \verbatim
-*> J is INTEGER
-*> Column of entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> Lower bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> Upper bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array of dimension ( 4 )
-*> Seed for random number generator.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array of dimension ( MIN( I , J ) )
-*> Diagonal entries of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IGRADE
-*> \verbatim
-*> IGRADE is INTEGER
-*> Specifies grading of matrix as follows:
-*> 0 => no grading
-*> 1 => matrix premultiplied by diag( DL )
-*> 2 => matrix postmultiplied by diag( DR )
-*> 3 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DR )
-*> 4 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by inv( diag( DL ) )
-*> 5 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DL )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array ( I or J, as appropriate )
-*> Left scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DR
-*> \verbatim
-*> DR is REAL array ( I or J, as appropriate )
-*> Right scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IPVTNG
-*> \verbatim
-*> IPVTNG is INTEGER
-*> On entry specifies pivoting permutations as follows:
-*> 0 => none.
-*> 1 => row pivoting.
-*> 2 => column pivoting.
-*> 3 => full pivoting, i.e., on both sides.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array ( I or J, as appropriate )
-*> This array specifies the permutation used. The
-*> row (or column) in position K was originally in
-*> position IWORK( K ).
-*> This differs from IWORK for SLATM3. Not modified.
-*> \endverbatim
-*>
-*> \param[in] SPARSE
-*> \verbatim
-*> SPARSE is REAL between 0. and 1.
-*> On entry specifies the sparsity of the matrix
-*> if sparse matix is to be generated.
-*> SPARSE should lie between 0 and 1.
-*> A uniform ( 0, 1 ) random number x is generated and
-*> compared to SPARSE; if x is larger the matrix entry
-*> is unchanged and if x is smaller the entry is set
-*> to zero. Thus on the average a fraction SPARSE of the
-*> entries will be set to zero.
-*> Not modified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- REAL FUNCTION SLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
-*
- INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
- REAL SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
- INTEGER ISEED( 4 ), IWORK( * )
- REAL D( * ), DL( * ), DR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-*
-* .. Local Scalars ..
-*
- INTEGER ISUB, JSUB
- REAL TEMP
-* ..
-*
-* .. External Functions ..
-*
- REAL SLARAN, SLARND
- EXTERNAL SLARAN, SLARND
-* ..
-*
-*-----------------------------------------------------------------------
-*
-* .. Executable Statements ..
-*
-*
-* Check for I and J in range
-*
- IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
- SLATM2 = ZERO
- RETURN
- END IF
-*
-* Check for banding
-*
- IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
- SLATM2 = ZERO
- RETURN
- END IF
-*
-* Check for sparsity
-*
- IF( SPARSE.GT.ZERO ) THEN
- IF( SLARAN( ISEED ).LT.SPARSE ) THEN
- SLATM2 = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute subscripts depending on IPVTNG
-*
- IF( IPVTNG.EQ.0 ) THEN
- ISUB = I
- JSUB = J
- ELSE IF( IPVTNG.EQ.1 ) THEN
- ISUB = IWORK( I )
- JSUB = J
- ELSE IF( IPVTNG.EQ.2 ) THEN
- ISUB = I
- JSUB = IWORK( J )
- ELSE IF( IPVTNG.EQ.3 ) THEN
- ISUB = IWORK( I )
- JSUB = IWORK( J )
- END IF
-*
-* Compute entry and grade it according to IGRADE
-*
- IF( ISUB.EQ.JSUB ) THEN
- TEMP = D( ISUB )
- ELSE
- TEMP = SLARND( IDIST, ISEED )
- END IF
- IF( IGRADE.EQ.1 ) THEN
- TEMP = TEMP*DL( ISUB )
- ELSE IF( IGRADE.EQ.2 ) THEN
- TEMP = TEMP*DR( JSUB )
- ELSE IF( IGRADE.EQ.3 ) THEN
- TEMP = TEMP*DL( ISUB )*DR( JSUB )
- ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
- TEMP = TEMP*DL( ISUB ) / DL( JSUB )
- ELSE IF( IGRADE.EQ.5 ) THEN
- TEMP = TEMP*DL( ISUB )*DL( JSUB )
- END IF
- SLATM2 = TEMP
- RETURN
-*
-* End of SLATM2
-*
- END
diff --git a/netlib/LAPACK/slatm3.f b/netlib/LAPACK/slatm3.f
deleted file mode 100644
index f90790c..0000000
--- a/netlib/LAPACK/slatm3.f
+++ /dev/null
@@ -1,335 +0,0 @@
-*> \brief \b SLATM3
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* REAL FUNCTION SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
-* IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
-* SPARSE )
-*
-* .. Scalar Arguments ..
-*
-* INTEGER I, IDIST, IGRADE, IPVTNG, ISUB, J, JSUB, KL,
-* $ KU, M, N
-* REAL SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
-* INTEGER ISEED( 4 ), IWORK( * )
-* REAL D( * ), DL( * ), DR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATM3 returns the (ISUB,JSUB) entry of a random matrix of
-*> dimension (M, N) described by the other paramters. (ISUB,JSUB)
-*> is the final position of the (I,J) entry after pivoting
-*> according to IPVTNG and IWORK. SLATM3 is called by the
-*> SLATMR routine in order to build random test matrices. No error
-*> checking on parameters is done, because this routine is called in
-*> a tight loop by SLATMR which has already checked the parameters.
-*>
-*> Use of SLATM3 differs from SLATM2 in the order in which the random
-*> number generator is called to fill in random matrix entries.
-*> With SLATM2, the generator is called to fill in the pivoted matrix
-*> columnwise. With SLATM3, the generator is called to fill in the
-*> matrix columnwise, after which it is pivoted. Thus, SLATM3 can
-*> be used to construct random matrices which differ only in their
-*> order of rows and/or columns. SLATM2 is used to construct band
-*> matrices while avoiding calling the random number generator for
-*> entries outside the band (and therefore generating random numbers
-*> in different orders for different pivot orders).
-*>
-*> The matrix whose (ISUB,JSUB) entry is returned is constructed as
-*> follows (this routine only computes one entry):
-*>
-*> If ISUB is outside (1..M) or JSUB is outside (1..N), return zero
-*> (this is convenient for generating matrices in band format).
-*>
-*> Generate a matrix A with random entries of distribution IDIST.
-*>
-*> Set the diagonal to D.
-*>
-*> Grade the matrix, if desired, from the left (by DL) and/or
-*> from the right (by DR or DL) as specified by IGRADE.
-*>
-*> Permute, if desired, the rows and/or columns as specified by
-*> IPVTNG and IWORK.
-*>
-*> Band the matrix to have lower bandwidth KL and upper
-*> bandwidth KU.
-*>
-*> Set random entries to zero as specified by SPARSE.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Number of rows of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of columns of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] I
-*> \verbatim
-*> I is INTEGER
-*> Row of unpivoted entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in] J
-*> \verbatim
-*> J is INTEGER
-*> Column of unpivoted entry to be returned. Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISUB
-*> \verbatim
-*> ISUB is INTEGER
-*> Row of pivoted entry to be returned. Changed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] JSUB
-*> \verbatim
-*> JSUB is INTEGER
-*> Column of pivoted entry to be returned. Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> Lower bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> Upper bandwidth. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IDIST
-*> \verbatim
-*> IDIST is INTEGER
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array of dimension ( 4 )
-*> Seed for random number generator.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array of dimension ( MIN( I , J ) )
-*> Diagonal entries of matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IGRADE
-*> \verbatim
-*> IGRADE is INTEGER
-*> Specifies grading of matrix as follows:
-*> 0 => no grading
-*> 1 => matrix premultiplied by diag( DL )
-*> 2 => matrix postmultiplied by diag( DR )
-*> 3 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DR )
-*> 4 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by inv( diag( DL ) )
-*> 5 => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DL )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is REAL array ( I or J, as appropriate )
-*> Left scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DR
-*> \verbatim
-*> DR is REAL array ( I or J, as appropriate )
-*> Right scale factors for grading matrix. Not modified.
-*> \endverbatim
-*>
-*> \param[in] IPVTNG
-*> \verbatim
-*> IPVTNG is INTEGER
-*> On entry specifies pivoting permutations as follows:
-*> 0 => none.
-*> 1 => row pivoting.
-*> 2 => column pivoting.
-*> 3 => full pivoting, i.e., on both sides.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] IWORK
-*> \verbatim
-*> IWORK is INTEGER array ( I or J, as appropriate )
-*> This array specifies the permutation used. The
-*> row (or column) originally in position K is in
-*> position IWORK( K ) after pivoting.
-*> This differs from IWORK for SLATM2. Not modified.
-*> \endverbatim
-*>
-*> \param[in] SPARSE
-*> \verbatim
-*> SPARSE is REAL between 0. and 1.
-*> On entry specifies the sparsity of the matrix
-*> if sparse matix is to be generated.
-*> SPARSE should lie between 0 and 1.
-*> A uniform ( 0, 1 ) random number x is generated and
-*> compared to SPARSE; if x is larger the matrix entry
-*> is unchanged and if x is smaller the entry is set
-*> to zero. Thus on the average a fraction SPARSE of the
-*> entries will be set to zero.
-*> Not modified.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- REAL FUNCTION SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
-*
- INTEGER I, IDIST, IGRADE, IPVTNG, ISUB, J, JSUB, KL,
- $ KU, M, N
- REAL SPARSE
-* ..
-*
-* .. Array Arguments ..
-*
- INTEGER ISEED( 4 ), IWORK( * )
- REAL D( * ), DL( * ), DR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
-* ..
-*
-* .. Local Scalars ..
-*
- REAL TEMP
-* ..
-*
-* .. External Functions ..
-*
- REAL SLARAN, SLARND
- EXTERNAL SLARAN, SLARND
-* ..
-*
-*-----------------------------------------------------------------------
-*
-* .. Executable Statements ..
-*
-*
-* Check for I and J in range
-*
- IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
- ISUB = I
- JSUB = J
- SLATM3 = ZERO
- RETURN
- END IF
-*
-* Compute subscripts depending on IPVTNG
-*
- IF( IPVTNG.EQ.0 ) THEN
- ISUB = I
- JSUB = J
- ELSE IF( IPVTNG.EQ.1 ) THEN
- ISUB = IWORK( I )
- JSUB = J
- ELSE IF( IPVTNG.EQ.2 ) THEN
- ISUB = I
- JSUB = IWORK( J )
- ELSE IF( IPVTNG.EQ.3 ) THEN
- ISUB = IWORK( I )
- JSUB = IWORK( J )
- END IF
-*
-* Check for banding
-*
- IF( JSUB.GT.ISUB+KU .OR. JSUB.LT.ISUB-KL ) THEN
- SLATM3 = ZERO
- RETURN
- END IF
-*
-* Check for sparsity
-*
- IF( SPARSE.GT.ZERO ) THEN
- IF( SLARAN( ISEED ).LT.SPARSE ) THEN
- SLATM3 = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute entry and grade it according to IGRADE
-*
- IF( I.EQ.J ) THEN
- TEMP = D( I )
- ELSE
- TEMP = SLARND( IDIST, ISEED )
- END IF
- IF( IGRADE.EQ.1 ) THEN
- TEMP = TEMP*DL( I )
- ELSE IF( IGRADE.EQ.2 ) THEN
- TEMP = TEMP*DR( J )
- ELSE IF( IGRADE.EQ.3 ) THEN
- TEMP = TEMP*DL( I )*DR( J )
- ELSE IF( IGRADE.EQ.4 .AND. I.NE.J ) THEN
- TEMP = TEMP*DL( I ) / DL( J )
- ELSE IF( IGRADE.EQ.5 ) THEN
- TEMP = TEMP*DL( I )*DL( J )
- END IF
- SLATM3 = TEMP
- RETURN
-*
-* End of SLATM3
-*
- END
diff --git a/netlib/LAPACK/slatm5.f b/netlib/LAPACK/slatm5.f
deleted file mode 100644
index ce0540c..0000000
--- a/netlib/LAPACK/slatm5.f
+++ /dev/null
@@ -1,501 +0,0 @@
-*> \brief \b SLATM5
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD,
-* E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA,
-* QBLCKB )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N,
-* $ PRTYPE, QBLCKA, QBLCKB
-* REAL ALPHA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
-* $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
-* $ L( LDL, * ), R( LDR, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATM5 generates matrices involved in the Generalized Sylvester
-*> equation:
-*>
-*> A * R - L * B = C
-*> D * R - L * E = F
-*>
-*> They also satisfy (the diagonalization condition)
-*>
-*> [ I -L ] ( [ A -C ], [ D -F ] ) [ I R ] = ( [ A ], [ D ] )
-*> [ I ] ( [ B ] [ E ] ) [ I ] ( [ B ] [ E ] )
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] PRTYPE
-*> \verbatim
-*> PRTYPE is INTEGER
-*> "Points" to a certian type of the matrices to generate
-*> (see futher details).
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Specifies the order of A and D and the number of rows in
-*> C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Specifies the order of B and E and the number of columns in
-*> C, F, R and L.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, M).
-*> On exit A M-by-M is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N).
-*> On exit B N-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC, N).
-*> On exit C M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of C.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (LDD, M).
-*> On exit D M-by-M is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDD
-*> \verbatim
-*> LDD is INTEGER
-*> The leading dimension of D.
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (LDE, N).
-*> On exit E N-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDE
-*> \verbatim
-*> LDE is INTEGER
-*> The leading dimension of E.
-*> \endverbatim
-*>
-*> \param[out] F
-*> \verbatim
-*> F is REAL array, dimension (LDF, N).
-*> On exit F M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of F.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is REAL array, dimension (LDR, N).
-*> On exit R M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDR
-*> \verbatim
-*> LDR is INTEGER
-*> The leading dimension of R.
-*> \endverbatim
-*>
-*> \param[out] L
-*> \verbatim
-*> L is REAL array, dimension (LDL, N).
-*> On exit L M-by-N is initialized according to PRTYPE.
-*> \endverbatim
-*>
-*> \param[in] LDL
-*> \verbatim
-*> LDL is INTEGER
-*> The leading dimension of L.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> Parameter used in generating PRTYPE = 1 and 5 matrices.
-*> \endverbatim
-*>
-*> \param[in] QBLCKA
-*> \verbatim
-*> QBLCKA is INTEGER
-*> When PRTYPE = 3, specifies the distance between 2-by-2
-*> blocks on the diagonal in A. Otherwise, QBLCKA is not
-*> referenced. QBLCKA > 1.
-*> \endverbatim
-*>
-*> \param[in] QBLCKB
-*> \verbatim
-*> QBLCKB is INTEGER
-*> When PRTYPE = 3, specifies the distance between 2-by-2
-*> blocks on the diagonal in B. Otherwise, QBLCKB is not
-*> referenced. QBLCKB > 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> PRTYPE = 1: A and B are Jordan blocks, D and E are identity matrices
-*>
-*> A : if (i == j) then A(i, j) = 1.0
-*> if (j == i + 1) then A(i, j) = -1.0
-*> else A(i, j) = 0.0, i, j = 1...M
-*>
-*> B : if (i == j) then B(i, j) = 1.0 - ALPHA
-*> if (j == i + 1) then B(i, j) = 1.0
-*> else B(i, j) = 0.0, i, j = 1...N
-*>
-*> D : if (i == j) then D(i, j) = 1.0
-*> else D(i, j) = 0.0, i, j = 1...M
-*>
-*> E : if (i == j) then E(i, j) = 1.0
-*> else E(i, j) = 0.0, i, j = 1...N
-*>
-*> L = R are chosen from [-10...10],
-*> which specifies the right hand sides (C, F).
-*>
-*> PRTYPE = 2 or 3: Triangular and/or quasi- triangular.
-*>
-*> A : if (i <= j) then A(i, j) = [-1...1]
-*> else A(i, j) = 0.0, i, j = 1...M
-*>
-*> if (PRTYPE = 3) then
-*> A(k + 1, k + 1) = A(k, k)
-*> A(k + 1, k) = [-1...1]
-*> sign(A(k, k + 1) = -(sin(A(k + 1, k))
-*> k = 1, M - 1, QBLCKA
-*>
-*> B : if (i <= j) then B(i, j) = [-1...1]
-*> else B(i, j) = 0.0, i, j = 1...N
-*>
-*> if (PRTYPE = 3) then
-*> B(k + 1, k + 1) = B(k, k)
-*> B(k + 1, k) = [-1...1]
-*> sign(B(k, k + 1) = -(sign(B(k + 1, k))
-*> k = 1, N - 1, QBLCKB
-*>
-*> D : if (i <= j) then D(i, j) = [-1...1].
-*> else D(i, j) = 0.0, i, j = 1...M
-*>
-*>
-*> E : if (i <= j) then D(i, j) = [-1...1]
-*> else E(i, j) = 0.0, i, j = 1...N
-*>
-*> L, R are chosen from [-10...10],
-*> which specifies the right hand sides (C, F).
-*>
-*> PRTYPE = 4 Full
-*> A(i, j) = [-10...10]
-*> D(i, j) = [-1...1] i,j = 1...M
-*> B(i, j) = [-10...10]
-*> E(i, j) = [-1...1] i,j = 1...N
-*> R(i, j) = [-10...10]
-*> L(i, j) = [-1...1] i = 1..M ,j = 1...N
-*>
-*> L, R specifies the right hand sides (C, F).
-*>
-*> PRTYPE = 5 special case common and/or close eigs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD,
- $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA,
- $ QBLCKB )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N,
- $ PRTYPE, QBLCKA, QBLCKB
- REAL ALPHA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
- $ L( LDL, * ), R( LDR, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO, TWENTY, HALF, TWO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0, TWENTY = 2.0E+1,
- $ HALF = 0.5E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K
- REAL IMEPS, REEPS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD, REAL, SIN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM
-* ..
-* .. Executable Statements ..
-*
- IF( PRTYPE.EQ.1 ) THEN
- DO 20 I = 1, M
- DO 10 J = 1, M
- IF( I.EQ.J ) THEN
- A( I, J ) = ONE
- D( I, J ) = ONE
- ELSE IF( I.EQ.J-1 ) THEN
- A( I, J ) = -ONE
- D( I, J ) = ZERO
- ELSE
- A( I, J ) = ZERO
- D( I, J ) = ZERO
- END IF
- 10 CONTINUE
- 20 CONTINUE
-*
- DO 40 I = 1, N
- DO 30 J = 1, N
- IF( I.EQ.J ) THEN
- B( I, J ) = ONE - ALPHA
- E( I, J ) = ONE
- ELSE IF( I.EQ.J-1 ) THEN
- B( I, J ) = ONE
- E( I, J ) = ZERO
- ELSE
- B( I, J ) = ZERO
- E( I, J ) = ZERO
- END IF
- 30 CONTINUE
- 40 CONTINUE
-*
- DO 60 I = 1, M
- DO 50 J = 1, N
- R( I, J ) = ( HALF-SIN( REAL( I / J ) ) )*TWENTY
- L( I, J ) = R( I, J )
- 50 CONTINUE
- 60 CONTINUE
-*
- ELSE IF( PRTYPE.EQ.2 .OR. PRTYPE.EQ.3 ) THEN
- DO 80 I = 1, M
- DO 70 J = 1, M
- IF( I.LE.J ) THEN
- A( I, J ) = ( HALF-SIN( REAL( I ) ) )*TWO
- D( I, J ) = ( HALF-SIN( REAL( I*J ) ) )*TWO
- ELSE
- A( I, J ) = ZERO
- D( I, J ) = ZERO
- END IF
- 70 CONTINUE
- 80 CONTINUE
-*
- DO 100 I = 1, N
- DO 90 J = 1, N
- IF( I.LE.J ) THEN
- B( I, J ) = ( HALF-SIN( REAL( I+J ) ) )*TWO
- E( I, J ) = ( HALF-SIN( REAL( J ) ) )*TWO
- ELSE
- B( I, J ) = ZERO
- E( I, J ) = ZERO
- END IF
- 90 CONTINUE
- 100 CONTINUE
-*
- DO 120 I = 1, M
- DO 110 J = 1, N
- R( I, J ) = ( HALF-SIN( REAL( I*J ) ) )*TWENTY
- L( I, J ) = ( HALF-SIN( REAL( I+J ) ) )*TWENTY
- 110 CONTINUE
- 120 CONTINUE
-*
- IF( PRTYPE.EQ.3 ) THEN
- IF( QBLCKA.LE.1 )
- $ QBLCKA = 2
- DO 130 K = 1, M - 1, QBLCKA
- A( K+1, K+1 ) = A( K, K )
- A( K+1, K ) = -SIN( A( K, K+1 ) )
- 130 CONTINUE
-*
- IF( QBLCKB.LE.1 )
- $ QBLCKB = 2
- DO 140 K = 1, N - 1, QBLCKB
- B( K+1, K+1 ) = B( K, K )
- B( K+1, K ) = -SIN( B( K, K+1 ) )
- 140 CONTINUE
- END IF
-*
- ELSE IF( PRTYPE.EQ.4 ) THEN
- DO 160 I = 1, M
- DO 150 J = 1, M
- A( I, J ) = ( HALF-SIN( REAL( I*J ) ) )*TWENTY
- D( I, J ) = ( HALF-SIN( REAL( I+J ) ) )*TWO
- 150 CONTINUE
- 160 CONTINUE
-*
- DO 180 I = 1, N
- DO 170 J = 1, N
- B( I, J ) = ( HALF-SIN( REAL( I+J ) ) )*TWENTY
- E( I, J ) = ( HALF-SIN( REAL( I*J ) ) )*TWO
- 170 CONTINUE
- 180 CONTINUE
-*
- DO 200 I = 1, M
- DO 190 J = 1, N
- R( I, J ) = ( HALF-SIN( REAL( J / I ) ) )*TWENTY
- L( I, J ) = ( HALF-SIN( REAL( I*J ) ) )*TWO
- 190 CONTINUE
- 200 CONTINUE
-*
- ELSE IF( PRTYPE.GE.5 ) THEN
- REEPS = HALF*TWO*TWENTY / ALPHA
- IMEPS = ( HALF-TWO ) / ALPHA
- DO 220 I = 1, M
- DO 210 J = 1, N
- R( I, J ) = ( HALF-SIN( REAL( I*J ) ) )*ALPHA / TWENTY
- L( I, J ) = ( HALF-SIN( REAL( I+J ) ) )*ALPHA / TWENTY
- 210 CONTINUE
- 220 CONTINUE
-*
- DO 230 I = 1, M
- D( I, I ) = ONE
- 230 CONTINUE
-*
- DO 240 I = 1, M
- IF( I.LE.4 ) THEN
- A( I, I ) = ONE
- IF( I.GT.2 )
- $ A( I, I ) = ONE + REEPS
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
- A( I, I+1 ) = IMEPS
- ELSE IF( I.GT.1 ) THEN
- A( I, I-1 ) = -IMEPS
- END IF
- ELSE IF( I.LE.8 ) THEN
- IF( I.LE.6 ) THEN
- A( I, I ) = REEPS
- ELSE
- A( I, I ) = -REEPS
- END IF
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
- A( I, I+1 ) = ONE
- ELSE IF( I.GT.1 ) THEN
- A( I, I-1 ) = -ONE
- END IF
- ELSE
- A( I, I ) = ONE
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
- A( I, I+1 ) = IMEPS*2
- ELSE IF( I.GT.1 ) THEN
- A( I, I-1 ) = -IMEPS*2
- END IF
- END IF
- 240 CONTINUE
-*
- DO 250 I = 1, N
- E( I, I ) = ONE
- IF( I.LE.4 ) THEN
- B( I, I ) = -ONE
- IF( I.GT.2 )
- $ B( I, I ) = ONE - REEPS
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.N ) THEN
- B( I, I+1 ) = IMEPS
- ELSE IF( I.GT.1 ) THEN
- B( I, I-1 ) = -IMEPS
- END IF
- ELSE IF( I.LE.8 ) THEN
- IF( I.LE.6 ) THEN
- B( I, I ) = REEPS
- ELSE
- B( I, I ) = -REEPS
- END IF
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.N ) THEN
- B( I, I+1 ) = ONE + IMEPS
- ELSE IF( I.GT.1 ) THEN
- B( I, I-1 ) = -ONE - IMEPS
- END IF
- ELSE
- B( I, I ) = ONE - REEPS
- IF( MOD( I, 2 ).NE.0 .AND. I.LT.N ) THEN
- B( I, I+1 ) = IMEPS*2
- ELSE IF( I.GT.1 ) THEN
- B( I, I-1 ) = -IMEPS*2
- END IF
- END IF
- 250 CONTINUE
- END IF
-*
-* Compute rhs (C, F)
-*
- CALL SGEMM( 'N', 'N', M, N, M, ONE, A, LDA, R, LDR, ZERO, C, LDC )
- CALL SGEMM( 'N', 'N', M, N, N, -ONE, L, LDL, B, LDB, ONE, C, LDC )
- CALL SGEMM( 'N', 'N', M, N, M, ONE, D, LDD, R, LDR, ZERO, F, LDF )
- CALL SGEMM( 'N', 'N', M, N, N, -ONE, L, LDL, E, LDE, ONE, F, LDF )
-*
-* End of SLATM5
-*
- END
diff --git a/netlib/LAPACK/slatm6.f b/netlib/LAPACK/slatm6.f
deleted file mode 100644
index e606bec..0000000
--- a/netlib/LAPACK/slatm6.f
+++ /dev/null
@@ -1,333 +0,0 @@
-*> \brief \b SLATM6
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
-* BETA, WX, WY, S, DIF )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDX, LDY, N, TYPE
-* REAL ALPHA, BETA, WX, WY
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
-* $ X( LDX, * ), Y( LDY, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATM6 generates test matrices for the generalized eigenvalue
-*> problem, their corresponding right and left eigenvector matrices,
-*> and also reciprocal condition numbers for all eigenvalues and
-*> the reciprocal condition numbers of eigenvectors corresponding to
-*> the 1th and 5th eigenvalues.
-*>
-*> Test Matrices
-*> =============
-*>
-*> Two kinds of test matrix pairs
-*>
-*> (A, B) = inverse(YH) * (Da, Db) * inverse(X)
-*>
-*> are used in the tests:
-*>
-*> Type 1:
-*> Da = 1+a 0 0 0 0 Db = 1 0 0 0 0
-*> 0 2+a 0 0 0 0 1 0 0 0
-*> 0 0 3+a 0 0 0 0 1 0 0
-*> 0 0 0 4+a 0 0 0 0 1 0
-*> 0 0 0 0 5+a , 0 0 0 0 1 , and
-*>
-*> Type 2:
-*> Da = 1 -1 0 0 0 Db = 1 0 0 0 0
-*> 1 1 0 0 0 0 1 0 0 0
-*> 0 0 1 0 0 0 0 1 0 0
-*> 0 0 0 1+a 1+b 0 0 0 1 0
-*> 0 0 0 -1-b 1+a , 0 0 0 0 1 .
-*>
-*> In both cases the same inverse(YH) and inverse(X) are used to compute
-*> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
-*>
-*> YH: = 1 0 -y y -y X = 1 0 -x -x x
-*> 0 1 -y y -y 0 1 x -x -x
-*> 0 0 1 0 0 0 0 1 0 0
-*> 0 0 0 1 0 0 0 0 1 0
-*> 0 0 0 0 1, 0 0 0 0 1 ,
-*>
-*> where a, b, x and y will have all values independently of each other.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TYPE
-*> \verbatim
-*> TYPE is INTEGER
-*> Specifies the problem type (see futher details).
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Size of the matrices A and B.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N).
-*> On exit A N-by-N is initialized according to TYPE.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A and of B.
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is REAL array, dimension (LDA, N).
-*> On exit B N-by-N is initialized according to TYPE.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX, N).
-*> On exit X is the N-by-N matrix of right eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of X.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is REAL array, dimension (LDY, N).
-*> On exit Y is the N-by-N matrix of left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of Y.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*>
-*> Weighting constants for matrix A.
-*> \endverbatim
-*>
-*> \param[in] WX
-*> \verbatim
-*> WX is REAL
-*> Constant for right eigenvector matrix.
-*> \endverbatim
-*>
-*> \param[in] WY
-*> \verbatim
-*> WY is REAL
-*> Constant for left eigenvector matrix.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> S(i) is the reciprocal condition number for eigenvalue i.
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is REAL array, dimension (N)
-*> DIF(i) is the reciprocal condition number for eigenvector i.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
- $ BETA, WX, WY, S, DIF )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDX, LDY, N, TYPE
- REAL ALPHA, BETA, WX, WY
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
- $ X( LDX, * ), Y( LDY, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, THREE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
- $ THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
-* ..
-* .. Local Arrays ..
- REAL WORK( 100 ), Z( 12, 12 )
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC REAL, SQRT
-* ..
-* .. External Subroutines ..
- EXTERNAL SGESVD, SLACPY, SLAKF2
-* ..
-* .. Executable Statements ..
-*
-* Generate test problem ...
-* (Da, Db) ...
-*
- DO 20 I = 1, N
- DO 10 J = 1, N
-*
- IF( I.EQ.J ) THEN
- A( I, I ) = REAL( I ) + ALPHA
- B( I, I ) = ONE
- ELSE
- A( I, J ) = ZERO
- B( I, J ) = ZERO
- END IF
-*
- 10 CONTINUE
- 20 CONTINUE
-*
-* Form X and Y
-*
- CALL SLACPY( 'F', N, N, B, LDA, Y, LDY )
- Y( 3, 1 ) = -WY
- Y( 4, 1 ) = WY
- Y( 5, 1 ) = -WY
- Y( 3, 2 ) = -WY
- Y( 4, 2 ) = WY
- Y( 5, 2 ) = -WY
-*
- CALL SLACPY( 'F', N, N, B, LDA, X, LDX )
- X( 1, 3 ) = -WX
- X( 1, 4 ) = -WX
- X( 1, 5 ) = WX
- X( 2, 3 ) = WX
- X( 2, 4 ) = -WX
- X( 2, 5 ) = -WX
-*
-* Form (A, B)
-*
- B( 1, 3 ) = WX + WY
- B( 2, 3 ) = -WX + WY
- B( 1, 4 ) = WX - WY
- B( 2, 4 ) = WX - WY
- B( 1, 5 ) = -WX + WY
- B( 2, 5 ) = WX + WY
- IF( TYPE.EQ.1 ) THEN
- A( 1, 3 ) = WX*A( 1, 1 ) + WY*A( 3, 3 )
- A( 2, 3 ) = -WX*A( 2, 2 ) + WY*A( 3, 3 )
- A( 1, 4 ) = WX*A( 1, 1 ) - WY*A( 4, 4 )
- A( 2, 4 ) = WX*A( 2, 2 ) - WY*A( 4, 4 )
- A( 1, 5 ) = -WX*A( 1, 1 ) + WY*A( 5, 5 )
- A( 2, 5 ) = WX*A( 2, 2 ) + WY*A( 5, 5 )
- ELSE IF( TYPE.EQ.2 ) THEN
- A( 1, 3 ) = TWO*WX + WY
- A( 2, 3 ) = WY
- A( 1, 4 ) = -WY*( TWO+ALPHA+BETA )
- A( 2, 4 ) = TWO*WX - WY*( TWO+ALPHA+BETA )
- A( 1, 5 ) = -TWO*WX + WY*( ALPHA-BETA )
- A( 2, 5 ) = WY*( ALPHA-BETA )
- A( 1, 1 ) = ONE
- A( 1, 2 ) = -ONE
- A( 2, 1 ) = ONE
- A( 2, 2 ) = A( 1, 1 )
- A( 3, 3 ) = ONE
- A( 4, 4 ) = ONE + ALPHA
- A( 4, 5 ) = ONE + BETA
- A( 5, 4 ) = -A( 4, 5 )
- A( 5, 5 ) = A( 4, 4 )
- END IF
-*
-* Compute condition numbers
-*
- IF( TYPE.EQ.1 ) THEN
-*
- S( 1 ) = ONE / SQRT( ( ONE+THREE*WY*WY ) /
- $ ( ONE+A( 1, 1 )*A( 1, 1 ) ) )
- S( 2 ) = ONE / SQRT( ( ONE+THREE*WY*WY ) /
- $ ( ONE+A( 2, 2 )*A( 2, 2 ) ) )
- S( 3 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+A( 3, 3 )*A( 3, 3 ) ) )
- S( 4 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+A( 4, 4 )*A( 4, 4 ) ) )
- S( 5 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+A( 5, 5 )*A( 5, 5 ) ) )
-*
- CALL SLAKF2( 1, 4, A, LDA, A( 2, 2 ), B, B( 2, 2 ), Z, 12 )
- CALL SGESVD( 'N', 'N', 8, 8, Z, 12, WORK, WORK( 9 ), 1,
- $ WORK( 10 ), 1, WORK( 11 ), 40, INFO )
- DIF( 1 ) = WORK( 8 )
-*
- CALL SLAKF2( 4, 1, A, LDA, A( 5, 5 ), B, B( 5, 5 ), Z, 12 )
- CALL SGESVD( 'N', 'N', 8, 8, Z, 12, WORK, WORK( 9 ), 1,
- $ WORK( 10 ), 1, WORK( 11 ), 40, INFO )
- DIF( 5 ) = WORK( 8 )
-*
- ELSE IF( TYPE.EQ.2 ) THEN
-*
- S( 1 ) = ONE / SQRT( ONE / THREE+WY*WY )
- S( 2 ) = S( 1 )
- S( 3 ) = ONE / SQRT( ONE / TWO+WX*WX )
- S( 4 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
- $ ( ONE+( ONE+ALPHA )*( ONE+ALPHA )+( ONE+BETA )*( ONE+
- $ BETA ) ) )
- S( 5 ) = S( 4 )
-*
- CALL SLAKF2( 2, 3, A, LDA, A( 3, 3 ), B, B( 3, 3 ), Z, 12 )
- CALL SGESVD( 'N', 'N', 12, 12, Z, 12, WORK, WORK( 13 ), 1,
- $ WORK( 14 ), 1, WORK( 15 ), 60, INFO )
- DIF( 1 ) = WORK( 12 )
-*
- CALL SLAKF2( 3, 2, A, LDA, A( 4, 4 ), B, B( 4, 4 ), Z, 12 )
- CALL SGESVD( 'N', 'N', 12, 12, Z, 12, WORK, WORK( 13 ), 1,
- $ WORK( 14 ), 1, WORK( 15 ), 60, INFO )
- DIF( 5 ) = WORK( 12 )
-*
- END IF
-*
- RETURN
-*
-* End of SLATM6
-*
- END
diff --git a/netlib/LAPACK/slatm7.f b/netlib/LAPACK/slatm7.f
deleted file mode 100644
index 7e19541..0000000
--- a/netlib/LAPACK/slatm7.f
+++ /dev/null
@@ -1,297 +0,0 @@
-*> \brief \b SLATM7
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
-* RANK, INFO )
-*
-* .. Scalar Arguments ..
-* REAL COND
-* INTEGER IDIST, INFO, IRSIGN, MODE, N, RANK
-* ..
-* .. Array Arguments ..
-* REAL D( * )
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATM7 computes the entries of D as specified by MODE
-*> COND and IRSIGN. IDIST and ISEED determine the generation
-*> of random numbers. SLATM7 is called by SLATMT to generate
-*> random test matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \verbatim
-*> MODE - INTEGER
-*> On entry describes how D is to be computed:
-*> MODE = 0 means do not change D.
-*>
-*> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
-*> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) I=1:RANK
-*>
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> Not modified.
-*>
-*> COND - REAL
-*> On entry, used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*>
-*> IRSIGN - INTEGER
-*> On entry, if MODE neither -6, 0 nor 6, determines sign of
-*> entries of D
-*> 0 => leave entries of D unchanged
-*> 1 => multiply each entry of D by 1 or -1 with probability .5
-*>
-*> IDIST - CHARACTER*1
-*> On entry, IDIST specifies the type of distribution to be
-*> used to generate a random matrix .
-*> 1 => UNIFORM( 0, 1 )
-*> 2 => UNIFORM( -1, 1 )
-*> 3 => NORMAL( 0, 1 )
-*> Not modified.
-*>
-*> ISEED - INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. The random number generator uses a
-*> linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to SLATM7
-*> to continue the same random number sequence.
-*> Changed on exit.
-*>
-*> D - REAL array, dimension ( MIN( M , N ) )
-*> Array to be computed according to MODE, COND and IRSIGN.
-*> May be changed on exit if MODE is nonzero.
-*>
-*> N - INTEGER
-*> Number of entries of D. Not modified.
-*>
-*> RANK - INTEGER
-*> The rank of matrix to be generated for modes 1,2,3 only.
-*> D( RANK+1:N ) = 0.
-*> Not modified.
-*>
-*> INFO - INTEGER
-*> 0 => normal termination
-*> -1 => if MODE not in range -6 to 6
-*> -2 => if MODE neither -6, 0 nor 6, and
-*> IRSIGN neither 0 nor 1
-*> -3 => if MODE neither -6, 0 nor 6 and COND less than 1
-*> -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3
-*> -7 => if N negative
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
- $ RANK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL COND
- INTEGER IDIST, INFO, IRSIGN, MODE, N, RANK
-* ..
-* .. Array Arguments ..
- REAL D( * )
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL HALF
- PARAMETER ( HALF = 0.5E0 )
-* ..
-* .. Local Scalars ..
- REAL ALPHA, TEMP
- INTEGER I
-* ..
-* .. External Functions ..
- REAL SLARAN
- EXTERNAL SLARAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARNV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, EXP, LOG, REAL
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters. Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set INFO if an error
-*
- IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
- INFO = -1
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
- INFO = -2
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ COND.LT.ONE ) THEN
- INFO = -3
- ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
- $ ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATM7', -INFO )
- RETURN
- END IF
-*
-* Compute D according to COND and MODE
-*
- IF( MODE.NE.0 ) THEN
- GO TO ( 100, 130, 160, 190, 210, 230 )ABS( MODE )
-*
-* One large D value:
-*
- 100 CONTINUE
- DO 110 I = 2, RANK
- D( I ) = ONE / COND
- 110 CONTINUE
- DO 120 I = RANK + 1, N
- D( I ) = ZERO
- 120 CONTINUE
- D( 1 ) = ONE
- GO TO 240
-*
-* One small D value:
-*
- 130 CONTINUE
- DO 140 I = 1, RANK - 1
- D( I ) = ONE
- 140 CONTINUE
- DO 150 I = RANK + 1, N
- D( I ) = ZERO
- 150 CONTINUE
- D( RANK ) = ONE / COND
- GO TO 240
-*
-* Exponentially distributed D values:
-*
- 160 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 .AND. RANK.GT.1 ) THEN
- ALPHA = COND**( -ONE / REAL( RANK-1 ) )
- DO 170 I = 2, RANK
- D( I ) = ALPHA**( I-1 )
- 170 CONTINUE
- DO 180 I = RANK + 1, N
- D( I ) = ZERO
- 180 CONTINUE
- END IF
- GO TO 240
-*
-* Arithmetically distributed D values:
-*
- 190 CONTINUE
- D( 1 ) = ONE
- IF( N.GT.1 ) THEN
- TEMP = ONE / COND
- ALPHA = ( ONE-TEMP ) / REAL( N-1 )
- DO 200 I = 2, N
- D( I ) = REAL( N-I )*ALPHA + TEMP
- 200 CONTINUE
- END IF
- GO TO 240
-*
-* Randomly distributed D values on ( 1/COND , 1):
-*
- 210 CONTINUE
- ALPHA = LOG( ONE / COND )
- DO 220 I = 1, N
- D( I ) = EXP( ALPHA*SLARAN( ISEED ) )
- 220 CONTINUE
- GO TO 240
-*
-* Randomly distributed D values from IDIST
-*
- 230 CONTINUE
- CALL SLARNV( IDIST, ISEED, N, D )
-*
- 240 CONTINUE
-*
-* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
-* random signs to D
-*
- IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ IRSIGN.EQ.1 ) THEN
- DO 250 I = 1, N
- TEMP = SLARAN( ISEED )
- IF( TEMP.GT.HALF )
- $ D( I ) = -D( I )
- 250 CONTINUE
- END IF
-*
-* Reverse if MODE < 0
-*
- IF( MODE.LT.0 ) THEN
- DO 260 I = 1, N / 2
- TEMP = D( I )
- D( I ) = D( N+1-I )
- D( N+1-I ) = TEMP
- 260 CONTINUE
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SLATM7
-*
- END
diff --git a/netlib/LAPACK/slatme.f b/netlib/LAPACK/slatme.f
deleted file mode 100644
index 88bfaae..0000000
--- a/netlib/LAPACK/slatme.f
+++ /dev/null
@@ -1,710 +0,0 @@
-*> \brief \b SLATME
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATME( N, DIST, ISEED, D, MODE, COND, DMAX, EI,
-* RSIGN,
-* UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM,
-* A,
-* LDA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIST, RSIGN, SIM, UPPER
-* INTEGER INFO, KL, KU, LDA, MODE, MODES, N
-* REAL ANORM, COND, CONDS, DMAX
-* ..
-* .. Array Arguments ..
-* CHARACTER EI( * )
-* INTEGER ISEED( 4 )
-* REAL A( LDA, * ), D( * ), DS( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATME generates random non-symmetric square matrices with
-*> specified eigenvalues for testing LAPACK programs.
-*>
-*> SLATME operates by applying the following sequence of
-*> operations:
-*>
-*> 1. Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX, and RSIGN
-*> as described below.
-*>
-*> 2. If complex conjugate pairs are desired (MODE=0 and EI(1)='R',
-*> or MODE=5), certain pairs of adjacent elements of D are
-*> interpreted as the real and complex parts of a complex
-*> conjugate pair; A thus becomes block diagonal, with 1x1
-*> and 2x2 blocks.
-*>
-*> 3. If UPPER='T', the upper triangle of A is set to random values
-*> out of distribution DIST.
-*>
-*> 4. If SIM='T', A is multiplied on the left by a random matrix
-*> X, whose singular values are specified by DS, MODES, and
-*> CONDS, and on the right by X inverse.
-*>
-*> 5. If KL < N-1, the lower bandwidth is reduced to KL using
-*> Householder transformations. If KU < N-1, the upper
-*> bandwidth is reduced to KU.
-*>
-*> 6. If ANORM is not negative, the matrix is scaled to have
-*> maximum-element-norm ANORM.
-*>
-*> (Note: since the matrix cannot be reduced beyond Hessenberg form,
-*> no packing options are available.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns (or rows) of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate the random eigen-/singular values, and for the
-*> upper triangle (see UPPER).
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to SLATME
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension ( N )
-*> This array is used to specify the eigenvalues of A. If
-*> MODE=0, then D is assumed to contain the eigenvalues (but
-*> see the description of EI), otherwise they will be
-*> computed according to MODE, COND, DMAX, and RSIGN and
-*> placed in D.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry this describes how the eigenvalues are to
-*> be specified:
-*> MODE = 0 means use D (with EI) as input
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed. Each odd-even pair
-*> of elements will be either used as two real
-*> eigenvalues or as the real and imaginary part
-*> of a complex conjugate pair of eigenvalues;
-*> the choice of which is done is random, with
-*> 50-50 probability, for each pair.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is between 1 and 4, D has entries ranging
-*> from 1 to 1/COND, if between -1 and -4, D has entries
-*> ranging from 1/COND to 1,
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is REAL
-*> On entry, this is used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is REAL
-*> If MODE is neither -6, 0 nor 6, the contents of D, as
-*> computed according to MODE and COND, will be scaled by
-*> DMAX / max(abs(D(i))). Note that DMAX need not be
-*> positive: if DMAX is negative (or zero), D will be
-*> scaled by a negative number (or zero).
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] EI
-*> \verbatim
-*> EI is CHARACTER*1 array, dimension ( N )
-*> If MODE is 0, and EI(1) is not ' ' (space character),
-*> this array specifies which elements of D (on input) are
-*> real eigenvalues and which are the real and imaginary parts
-*> of a complex conjugate pair of eigenvalues. The elements
-*> of EI may then only have the values 'R' and 'I'. If
-*> EI(j)='R' and EI(j+1)='I', then the j-th eigenvalue is
-*> CMPLX( D(j) , D(j+1) ), and the (j+1)-th is the complex
-*> conjugate thereof. If EI(j)=EI(j+1)='R', then the j-th
-*> eigenvalue is D(j) (i.e., real). EI(1) may not be 'I',
-*> nor may two adjacent elements of EI both have the value 'I'.
-*> If MODE is not 0, then EI is ignored. If MODE is 0 and
-*> EI(1)=' ', then the eigenvalues will all be real.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] RSIGN
-*> \verbatim
-*> RSIGN is CHARACTER*1
-*> If MODE is not 0, 6, or -6, and RSIGN='T', then the
-*> elements of D, as computed according to MODE and COND, will
-*> be multiplied by a random sign (+1 or -1). If RSIGN='F',
-*> they will not be. RSIGN may only have the values 'T' or
-*> 'F'.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] UPPER
-*> \verbatim
-*> UPPER is CHARACTER*1
-*> If UPPER='T', then the elements of A above the diagonal
-*> (and above the 2x2 diagonal blocks, if A has complex
-*> eigenvalues) will be set to random numbers out of DIST.
-*> If UPPER='F', they will not. UPPER may only have the
-*> values 'T' or 'F'.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] SIM
-*> \verbatim
-*> SIM is CHARACTER*1
-*> If SIM='T', then A will be operated on by a "similarity
-*> transform", i.e., multiplied on the left by a matrix X and
-*> on the right by X inverse. X = U S V, where U and V are
-*> random unitary matrices and S is a (diagonal) matrix of
-*> singular values specified by DS, MODES, and CONDS. If
-*> SIM='F', then A will not be transformed.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] DS
-*> \verbatim
-*> DS is REAL array, dimension ( N )
-*> This array is used to specify the singular values of X,
-*> in the same way that D specifies the eigenvalues of A.
-*> If MODE=0, the DS contains the singular values, which
-*> may not be zero.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODES
-*> \verbatim
-*> MODES is INTEGER
-*> \endverbatim
-*>
-*> \param[in] CONDS
-*> \verbatim
-*> CONDS is REAL
-*> Same as MODE and COND, but for specifying the diagonal
-*> of S. MODES=-6 and +6 are not allowed (since they would
-*> result in randomly ill-conditioned eigenvalues.)
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> This specifies the lower bandwidth of the matrix. KL=1
-*> specifies upper Hessenberg form. If KL is at least N-1,
-*> then A will have full lower bandwidth. KL must be at
-*> least 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> This specifies the upper bandwidth of the matrix. KU=1
-*> specifies lower Hessenberg form. If KU is at least N-1,
-*> then A will have full upper bandwidth; if KU and KL
-*> are both at least N-1, then A will be dense. Only one of
-*> KU and KL may be less than N-1. KU must be at least 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> If ANORM is not negative, then A will be scaled by a non-
-*> negative real number to make the maximum-element-norm of A
-*> to be ANORM.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension ( LDA, N )
-*> On exit A is the desired test matrix.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> LDA specifies the first dimension of A as declared in the
-*> calling program. LDA must be at least N.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ( 3*N )
-*> Workspace.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error code. On exit, INFO will be set to one of the
-*> following values:
-*> 0 => normal return
-*> -1 => N negative
-*> -2 => DIST illegal string
-*> -5 => MODE not in range -6 to 6
-*> -6 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -8 => EI(1) is not ' ' or 'R', EI(j) is not 'R' or 'I', or
-*> two adjacent elements of EI are 'I'.
-*> -9 => RSIGN is not 'T' or 'F'
-*> -10 => UPPER is not 'T' or 'F'
-*> -11 => SIM is not 'T' or 'F'
-*> -12 => MODES=0 and DS has a zero singular value.
-*> -13 => MODES is not in the range -5 to 5.
-*> -14 => MODES is nonzero and CONDS is less than 1.
-*> -15 => KL is less than 1.
-*> -16 => KU is less than 1, or KL and KU are both less than
-*> N-1.
-*> -19 => LDA is less than N.
-*> 1 => Error return from SLATM1 (computing D)
-*> 2 => Cannot scale to DMAX (max. eigenvalue is 0)
-*> 3 => Error return from SLATM1 (computing DS)
-*> 4 => Error return from SLARGE
-*> 5 => Zero singular value from SLATM1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATME( N, DIST, ISEED, D, MODE, COND, DMAX, EI,
- $ RSIGN,
- $ UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM,
- $ A,
- $ LDA, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIST, RSIGN, SIM, UPPER
- INTEGER INFO, KL, KU, LDA, MODE, MODES, N
- REAL ANORM, COND, CONDS, DMAX
-* ..
-* .. Array Arguments ..
- CHARACTER EI( * )
- INTEGER ISEED( 4 )
- REAL A( LDA, * ), D( * ), DS( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL HALF
- PARAMETER ( HALF = 1.0E0 / 2.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BADEI, BADS, USEEI
- INTEGER I, IC, ICOLS, IDIST, IINFO, IR, IROWS, IRSIGN,
- $ ISIM, IUPPER, J, JC, JCR, JR
- REAL ALPHA, TAU, TEMP, XNORMS
-* ..
-* .. Local Arrays ..
- REAL TEMPA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLANGE, SLARAN
- EXTERNAL LSAME, SLANGE, SLARAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMV, SGER, SLARFG, SLARGE, SLARNV,
- $ SLATM1, SLASET, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Check EI
-*
- USEEI = .TRUE.
- BADEI = .FALSE.
- IF( LSAME( EI( 1 ), ' ' ) .OR. MODE.NE.0 ) THEN
- USEEI = .FALSE.
- ELSE
- IF( LSAME( EI( 1 ), 'R' ) ) THEN
- DO 10 J = 2, N
- IF( LSAME( EI( J ), 'I' ) ) THEN
- IF( LSAME( EI( J-1 ), 'I' ) )
- $ BADEI = .TRUE.
- ELSE
- IF( .NOT.LSAME( EI( J ), 'R' ) )
- $ BADEI = .TRUE.
- END IF
- 10 CONTINUE
- ELSE
- BADEI = .TRUE.
- END IF
- END IF
-*
-* Decode RSIGN
-*
- IF( LSAME( RSIGN, 'T' ) ) THEN
- IRSIGN = 1
- ELSE IF( LSAME( RSIGN, 'F' ) ) THEN
- IRSIGN = 0
- ELSE
- IRSIGN = -1
- END IF
-*
-* Decode UPPER
-*
- IF( LSAME( UPPER, 'T' ) ) THEN
- IUPPER = 1
- ELSE IF( LSAME( UPPER, 'F' ) ) THEN
- IUPPER = 0
- ELSE
- IUPPER = -1
- END IF
-*
-* Decode SIM
-*
- IF( LSAME( SIM, 'T' ) ) THEN
- ISIM = 1
- ELSE IF( LSAME( SIM, 'F' ) ) THEN
- ISIM = 0
- ELSE
- ISIM = -1
- END IF
-*
-* Check DS, if MODES=0 and ISIM=1
-*
- BADS = .FALSE.
- IF( MODES.EQ.0 .AND. ISIM.EQ.1 ) THEN
- DO 20 J = 1, N
- IF( DS( J ).EQ.ZERO )
- $ BADS = .TRUE.
- 20 CONTINUE
- END IF
-*
-* Set INFO if an error
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -2
- ELSE IF( ABS( MODE ).GT.6 ) THEN
- INFO = -5
- ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
- $ THEN
- INFO = -6
- ELSE IF( BADEI ) THEN
- INFO = -8
- ELSE IF( IRSIGN.EQ.-1 ) THEN
- INFO = -9
- ELSE IF( IUPPER.EQ.-1 ) THEN
- INFO = -10
- ELSE IF( ISIM.EQ.-1 ) THEN
- INFO = -11
- ELSE IF( BADS ) THEN
- INFO = -12
- ELSE IF( ISIM.EQ.1 .AND. ABS( MODES ).GT.5 ) THEN
- INFO = -13
- ELSE IF( ISIM.EQ.1 .AND. MODES.NE.0 .AND. CONDS.LT.ONE ) THEN
- INFO = -14
- ELSE IF( KL.LT.1 ) THEN
- INFO = -15
- ELSE IF( KU.LT.1 .OR. ( KU.LT.N-1 .AND. KL.LT.N-1 ) ) THEN
- INFO = -16
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -19
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATME', -INFO )
- RETURN
- END IF
-*
-* Initialize random number generator
-*
- DO 30 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 30 CONTINUE
-*
- IF( MOD( ISEED( 4 ), 2 ).NE.1 )
- $ ISEED( 4 ) = ISEED( 4 ) + 1
-*
-* 2) Set up diagonal of A
-*
-* Compute D according to COND and MODE
-*
- CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
- IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 40 I = 2, N
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 40 CONTINUE
-*
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE IF( DMAX.NE.ZERO ) THEN
- INFO = 2
- RETURN
- ELSE
- ALPHA = ZERO
- END IF
-*
- CALL SSCAL( N, ALPHA, D, 1 )
-*
- END IF
-*
- CALL SLASET( 'Full', N, N, ZERO, ZERO, A, LDA )
- CALL SCOPY( N, D, 1, A, LDA+1 )
-*
-* Set up complex conjugate pairs
-*
- IF( MODE.EQ.0 ) THEN
- IF( USEEI ) THEN
- DO 50 J = 2, N
- IF( LSAME( EI( J ), 'I' ) ) THEN
- A( J-1, J ) = A( J, J )
- A( J, J-1 ) = -A( J, J )
- A( J, J ) = A( J-1, J-1 )
- END IF
- 50 CONTINUE
- END IF
-*
- ELSE IF( ABS( MODE ).EQ.5 ) THEN
-*
- DO 60 J = 2, N, 2
- IF( SLARAN( ISEED ).GT.HALF ) THEN
- A( J-1, J ) = A( J, J )
- A( J, J-1 ) = -A( J, J )
- A( J, J ) = A( J-1, J-1 )
- END IF
- 60 CONTINUE
- END IF
-*
-* 3) If UPPER='T', set upper triangle of A to random numbers.
-* (but don't modify the corners of 2x2 blocks.)
-*
- IF( IUPPER.NE.0 ) THEN
- DO 70 JC = 2, N
- IF( A( JC-1, JC ).NE.ZERO ) THEN
- JR = JC - 2
- ELSE
- JR = JC - 1
- END IF
- CALL SLARNV( IDIST, ISEED, JR, A( 1, JC ) )
- 70 CONTINUE
- END IF
-*
-* 4) If SIM='T', apply similarity transformation.
-*
-* -1
-* Transform is X A X , where X = U S V, thus
-*
-* it is U S V A V' (1/S) U'
-*
- IF( ISIM.NE.0 ) THEN
-*
-* Compute S (singular values of the eigenvector matrix)
-* according to CONDS and MODES
-*
- CALL SLATM1( MODES, CONDS, 0, 0, ISEED, DS, N, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
-*
-* Multiply by V and V'
-*
- CALL SLARGE( N, A, LDA, ISEED, WORK, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 4
- RETURN
- END IF
-*
-* Multiply by S and (1/S)
-*
- DO 80 J = 1, N
- CALL SSCAL( N, DS( J ), A( J, 1 ), LDA )
- IF( DS( J ).NE.ZERO ) THEN
- CALL SSCAL( N, ONE / DS( J ), A( 1, J ), 1 )
- ELSE
- INFO = 5
- RETURN
- END IF
- 80 CONTINUE
-*
-* Multiply by U and U'
-*
- CALL SLARGE( N, A, LDA, ISEED, WORK, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 4
- RETURN
- END IF
- END IF
-*
-* 5) Reduce the bandwidth.
-*
- IF( KL.LT.N-1 ) THEN
-*
-* Reduce bandwidth -- kill column
-*
- DO 90 JCR = KL + 1, N - 1
- IC = JCR - KL
- IROWS = N + 1 - JCR
- ICOLS = N + KL - JCR
-*
- CALL SCOPY( IROWS, A( JCR, IC ), 1, WORK, 1 )
- XNORMS = WORK( 1 )
- CALL SLARFG( IROWS, XNORMS, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL SGEMV( 'T', IROWS, ICOLS, ONE, A( JCR, IC+1 ), LDA,
- $ WORK, 1, ZERO, WORK( IROWS+1 ), 1 )
- CALL SGER( IROWS, ICOLS, -TAU, WORK, 1, WORK( IROWS+1 ), 1,
- $ A( JCR, IC+1 ), LDA )
-*
- CALL SGEMV( 'N', N, IROWS, ONE, A( 1, JCR ), LDA, WORK, 1,
- $ ZERO, WORK( IROWS+1 ), 1 )
- CALL SGER( N, IROWS, -TAU, WORK( IROWS+1 ), 1, WORK, 1,
- $ A( 1, JCR ), LDA )
-*
- A( JCR, IC ) = XNORMS
- CALL SLASET( 'Full', IROWS-1, 1, ZERO, ZERO, A( JCR+1, IC ),
- $ LDA )
- 90 CONTINUE
- ELSE IF( KU.LT.N-1 ) THEN
-*
-* Reduce upper bandwidth -- kill a row at a time.
-*
- DO 100 JCR = KU + 1, N - 1
- IR = JCR - KU
- IROWS = N + KU - JCR
- ICOLS = N + 1 - JCR
-*
- CALL SCOPY( ICOLS, A( IR, JCR ), LDA, WORK, 1 )
- XNORMS = WORK( 1 )
- CALL SLARFG( ICOLS, XNORMS, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL SGEMV( 'N', IROWS, ICOLS, ONE, A( IR+1, JCR ), LDA,
- $ WORK, 1, ZERO, WORK( ICOLS+1 ), 1 )
- CALL SGER( IROWS, ICOLS, -TAU, WORK( ICOLS+1 ), 1, WORK, 1,
- $ A( IR+1, JCR ), LDA )
-*
- CALL SGEMV( 'C', ICOLS, N, ONE, A( JCR, 1 ), LDA, WORK, 1,
- $ ZERO, WORK( ICOLS+1 ), 1 )
- CALL SGER( ICOLS, N, -TAU, WORK, 1, WORK( ICOLS+1 ), 1,
- $ A( JCR, 1 ), LDA )
-*
- A( IR, JCR ) = XNORMS
- CALL SLASET( 'Full', 1, ICOLS-1, ZERO, ZERO, A( IR, JCR+1 ),
- $ LDA )
- 100 CONTINUE
- END IF
-*
-* Scale the matrix to have norm ANORM
-*
- IF( ANORM.GE.ZERO ) THEN
- TEMP = SLANGE( 'M', N, N, A, LDA, TEMPA )
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = ANORM / TEMP
- DO 110 J = 1, N
- CALL SSCAL( N, ALPHA, A( 1, J ), 1 )
- 110 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SLATME
-*
- END
diff --git a/netlib/LAPACK/slatmr.f b/netlib/LAPACK/slatmr.f
deleted file mode 100644
index d53ddf8..0000000
--- a/netlib/LAPACK/slatmr.f
+++ /dev/null
@@ -1,1227 +0,0 @@
-*> \brief \b SLATMR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
-* RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
-* CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
-* PACK, A, LDA, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
-* INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
-* REAL ANORM, COND, CONDL, CONDR, DMAX, SPARSE
-* ..
-* .. Array Arguments ..
-* INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
-* REAL A( LDA, * ), D( * ), DL( * ), DR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATMR generates random matrices of various types for testing
-*> LAPACK programs.
-*>
-*> SLATMR operates by applying the following sequence of
-*> operations:
-*>
-*> Generate a matrix A with random entries of distribution DIST
-*> which is symmetric if SYM='S', and nonsymmetric
-*> if SYM='N'.
-*>
-*> Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX and RSIGN
-*> as described below.
-*>
-*> Grade the matrix, if desired, from the left and/or right
-*> as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
-*> MODER and CONDR also determine the grading as described
-*> below.
-*>
-*> Permute, if desired, the rows and/or columns as specified by
-*> PIVTNG and IPIVOT.
-*>
-*> Set random entries to zero, if desired, to get a random sparse
-*> matrix as specified by SPARSE.
-*>
-*> Make A a band matrix, if desired, by zeroing out the matrix
-*> outside a band of lower bandwidth KL and upper bandwidth KU.
-*>
-*> Scale A, if desired, to have maximum entry ANORM.
-*>
-*> Pack the matrix if desired. Options specified by PACK are:
-*> no packing
-*> zero out upper half (if symmetric)
-*> zero out lower half (if symmetric)
-*> store the upper half columnwise (if symmetric or
-*> square upper triangular)
-*> store the lower half columnwise (if symmetric or
-*> square lower triangular)
-*> same as upper half rowwise if symmetric
-*> store the lower triangle in banded format (if symmetric)
-*> store the upper triangle in banded format (if symmetric)
-*> store the entire matrix in banded format
-*>
-*> Note: If two calls to SLATMR differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*>
-*> If two calls to SLATMR both have full bandwidth (KL = M-1
-*> and KU = N-1), and differ only in the PIVTNG and PACK
-*> parameters, then the matrices generated will differ only
-*> in the order of the rows and/or columns, and otherwise
-*> contain the same data. This consistency cannot be and
-*> is not maintained with less than full bandwidth.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> Number of rows of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> Number of columns of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate a random matrix .
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension (4)
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to SLATMR
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] SYM
-*> \verbatim
-*> SYM is CHARACTER*1
-*> If SYM='S' or 'H', generated matrix is symmetric.
-*> If SYM='N', generated matrix is nonsymmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (min(M,N))
-*> On entry this array specifies the diagonal entries
-*> of the diagonal of A. D may either be specified
-*> on entry, or set according to MODE and COND as described
-*> below. May be changed on exit if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry describes how D is to be used:
-*> MODE = 0 means use D as input
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is REAL
-*> On entry, used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is REAL
-*> If MODE neither -6, 0 nor 6, the diagonal is scaled by
-*> DMAX / max(abs(D(i))), so that maximum absolute entry
-*> of diagonal is abs(DMAX). If DMAX is negative (or zero),
-*> diagonal will be scaled by a negative number (or zero).
-*> \endverbatim
-*>
-*> \param[in] RSIGN
-*> \verbatim
-*> RSIGN is CHARACTER*1
-*> If MODE neither -6, 0 nor 6, specifies sign of diagonal
-*> as follows:
-*> 'T' => diagonal entries are multiplied by 1 or -1
-*> with probability .5
-*> 'F' => diagonal unchanged
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] GRADE
-*> \verbatim
-*> GRADE is CHARACTER*1
-*> Specifies grading of matrix as follows:
-*> 'N' => no grading
-*> 'L' => matrix premultiplied by diag( DL )
-*> (only if matrix nonsymmetric)
-*> 'R' => matrix postmultiplied by diag( DR )
-*> (only if matrix nonsymmetric)
-*> 'B' => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DR )
-*> (only if matrix nonsymmetric)
-*> 'S' or 'H' => matrix premultiplied by diag( DL ) and
-*> postmultiplied by diag( DL )
-*> ('S' for symmetric, or 'H' for Hermitian)
-*> 'E' => matrix premultiplied by diag( DL ) and
-*> postmultiplied by inv( diag( DL ) )
-*> ( 'E' for eigenvalue invariance)
-*> (only if matrix nonsymmetric)
-*> Note: if GRADE='E', then M must equal N.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is REAL array, dimension (M)
-*> If MODEL=0, then on entry this array specifies the diagonal
-*> entries of a diagonal matrix used as described under GRADE
-*> above. If MODEL is not zero, then DL will be set according
-*> to MODEL and CONDL, analogous to the way D is set according
-*> to MODE and COND (except there is no DMAX parameter for DL).
-*> If GRADE='E', then DL cannot have zero entries.
-*> Not referenced if GRADE = 'N' or 'R'. Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] MODEL
-*> \verbatim
-*> MODEL is INTEGER
-*> This specifies how the diagonal array DL is to be computed,
-*> just as MODE specifies how D is to be computed.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] CONDL
-*> \verbatim
-*> CONDL is REAL
-*> When MODEL is not zero, this specifies the condition number
-*> of the computed DL. Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] DR
-*> \verbatim
-*> DR is REAL array, dimension (N)
-*> If MODER=0, then on entry this array specifies the diagonal
-*> entries of a diagonal matrix used as described under GRADE
-*> above. If MODER is not zero, then DR will be set according
-*> to MODER and CONDR, analogous to the way D is set according
-*> to MODE and COND (except there is no DMAX parameter for DR).
-*> Not referenced if GRADE = 'N', 'L', 'H', 'S' or 'E'.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] MODER
-*> \verbatim
-*> MODER is INTEGER
-*> This specifies how the diagonal array DR is to be computed,
-*> just as MODE specifies how D is to be computed.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] CONDR
-*> \verbatim
-*> CONDR is REAL
-*> When MODER is not zero, this specifies the condition number
-*> of the computed DR. Not modified.
-*> \endverbatim
-*>
-*> \param[in] PIVTNG
-*> \verbatim
-*> PIVTNG is CHARACTER*1
-*> On entry specifies pivoting permutations as follows:
-*> 'N' or ' ' => none.
-*> 'L' => left or row pivoting (matrix must be nonsymmetric).
-*> 'R' => right or column pivoting (matrix must be
-*> nonsymmetric).
-*> 'B' or 'F' => both or full pivoting, i.e., on both sides.
-*> In this case, M must equal N
-*>
-*> If two calls to SLATMR both have full bandwidth (KL = M-1
-*> and KU = N-1), and differ only in the PIVTNG and PACK
-*> parameters, then the matrices generated will differ only
-*> in the order of the rows and/or columns, and otherwise
-*> contain the same data. This consistency cannot be
-*> maintained with less than full bandwidth.
-*> \endverbatim
-*>
-*> \param[in] IPIVOT
-*> \verbatim
-*> IPIVOT is INTEGER array, dimension (N or M)
-*> This array specifies the permutation used. After the
-*> basic matrix is generated, the rows, columns, or both
-*> are permuted. If, say, row pivoting is selected, SLATMR
-*> starts with the *last* row and interchanges the M-th and
-*> IPIVOT(M)-th rows, then moves to the next-to-last row,
-*> interchanging the (M-1)-th and the IPIVOT(M-1)-th rows,
-*> and so on. In terms of "2-cycles", the permutation is
-*> (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M))
-*> where the rightmost cycle is applied first. This is the
-*> *inverse* of the effect of pivoting in LINPACK. The idea
-*> is that factoring (with pivoting) an identity matrix
-*> which has been inverse-pivoted in this way should
-*> result in a pivot vector identical to IPIVOT.
-*> Not referenced if PIVTNG = 'N'. Not modified.
-*> \endverbatim
-*>
-*> \param[in] SPARSE
-*> \verbatim
-*> SPARSE is REAL
-*> On entry specifies the sparsity of the matrix if a sparse
-*> matrix is to be generated. SPARSE should lie between
-*> 0 and 1. To generate a sparse matrix, for each matrix entry
-*> a uniform ( 0, 1 ) random number x is generated and
-*> compared to SPARSE; if x is larger the matrix entry
-*> is unchanged and if x is smaller the entry is set
-*> to zero. Thus on the average a fraction SPARSE of the
-*> entries will be set to zero.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> On entry specifies the lower bandwidth of the matrix. For
-*> example, KL=0 implies upper triangular, KL=1 implies upper
-*> Hessenberg, and KL at least M-1 implies the matrix is not
-*> banded. Must equal KU if matrix is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> On entry specifies the upper bandwidth of the matrix. For
-*> example, KU=0 implies lower triangular, KU=1 implies lower
-*> Hessenberg, and KU at least N-1 implies the matrix is not
-*> banded. Must equal KL if matrix is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> On entry specifies maximum entry of output matrix
-*> (output matrix will by multiplied by a constant so that
-*> its largest absolute entry equal ANORM)
-*> if ANORM is nonnegative. If ANORM is negative no scaling
-*> is done. Not modified.
-*> \endverbatim
-*>
-*> \param[in] PACK
-*> \verbatim
-*> PACK is CHARACTER*1
-*> On entry specifies packing of matrix as follows:
-*> 'N' => no packing
-*> 'U' => zero out all subdiagonal entries (if symmetric)
-*> 'L' => zero out all superdiagonal entries (if symmetric)
-*> 'C' => store the upper triangle columnwise
-*> (only if matrix symmetric or square upper triangular)
-*> 'R' => store the lower triangle columnwise
-*> (only if matrix symmetric or square lower triangular)
-*> (same as upper half rowwise if symmetric)
-*> 'B' => store the lower triangle in band storage scheme
-*> (only if matrix symmetric)
-*> 'Q' => store the upper triangle in band storage scheme
-*> (only if matrix symmetric)
-*> 'Z' => store the entire matrix in band storage scheme
-*> (pivoting can be provided for by using this
-*> option to store A in the trailing rows of
-*> the allocated storage)
-*>
-*> Using these options, the various LAPACK packed and banded
-*> storage schemes can be obtained:
-*> GB - use 'Z'
-*> PB, SB or TB - use 'B' or 'Q'
-*> PP, SP or TP - use 'C' or 'R'
-*>
-*> If two calls to SLATMR differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On exit A is the desired test matrix. Only those
-*> entries of A which are significant on output
-*> will be referenced (even if A is in packed or band
-*> storage format). The 'unoccupied corners' of A in
-*> band format will be zeroed out.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> on entry LDA specifies the first dimension of A as
-*> declared in the calling program.
-*> If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ).
-*> If PACK='C' or 'R', LDA must be at least 1.
-*> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N )
-*> If PACK='Z', LDA must be at least KUU+KLL+1, where
-*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension ( N or M)
-*> Workspace. Not referenced if PIVTNG = 'N'. Changed on exit.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error parameter on exit:
-*> 0 => normal return
-*> -1 => M negative or unequal to N and SYM='S' or 'H'
-*> -2 => N negative
-*> -3 => DIST illegal string
-*> -5 => SYM illegal string
-*> -7 => MODE not in range -6 to 6
-*> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string
-*> -11 => GRADE illegal string, or GRADE='E' and
-*> M not equal to N, or GRADE='L', 'R', 'B' or 'E' and
-*> SYM = 'S' or 'H'
-*> -12 => GRADE = 'E' and DL contains zero
-*> -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H',
-*> 'S' or 'E'
-*> -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E',
-*> and MODEL neither -6, 0 nor 6
-*> -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B'
-*> -17 => CONDR less than 1.0, GRADE='R' or 'B', and
-*> MODER neither -6, 0 nor 6
-*> -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and
-*> M not equal to N, or PIVTNG='L' or 'R' and SYM='S'
-*> or 'H'
-*> -19 => IPIVOT contains out of range number and
-*> PIVTNG not equal to 'N'
-*> -20 => KL negative
-*> -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL
-*> -22 => SPARSE not in range 0. to 1.
-*> -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q'
-*> and SYM='N', or PACK='C' and SYM='N' and either KL
-*> not equal to 0 or N not equal to M, or PACK='R' and
-*> SYM='N', and either KU not equal to 0 or N not equal
-*> to M
-*> -26 => LDA too small
-*> 1 => Error return from SLATM1 (computing D)
-*> 2 => Cannot scale diagonal to DMAX (max. entry is 0)
-*> 3 => Error return from SLATM1 (computing DL)
-*> 4 => Error return from SLATM1 (computing DR)
-*> 5 => ANORM is positive, but matrix constructed prior to
-*> attempting to scale it to have norm ANORM, is zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
- $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
- $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
- $ PACK, A, LDA, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
- INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
- REAL ANORM, COND, CONDL, CONDR, DMAX, SPARSE
-* ..
-* .. Array Arguments ..
- INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
- REAL A( LDA, * ), D( * ), DL( * ), DR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BADPVT, DZERO, FULBND
- INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
- $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
- $ MNSUB, MXSUB, NPVTS
- REAL ALPHA, ONORM, TEMP
-* ..
-* .. Local Arrays ..
- REAL TEMPA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLANGB, SLANGE, SLANSB, SLANSP, SLANSY, SLATM2,
- $ SLATM3
- EXTERNAL LSAME, SLANGB, SLANGE, SLANSB, SLANSP, SLANSY,
- $ SLATM2, SLATM3
-* ..
-* .. External Subroutines ..
- EXTERNAL SLATM1, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, MOD
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Decode SYM
-*
- IF( LSAME( SYM, 'S' ) ) THEN
- ISYM = 0
- ELSE IF( LSAME( SYM, 'N' ) ) THEN
- ISYM = 1
- ELSE IF( LSAME( SYM, 'H' ) ) THEN
- ISYM = 0
- ELSE
- ISYM = -1
- END IF
-*
-* Decode RSIGN
-*
- IF( LSAME( RSIGN, 'F' ) ) THEN
- IRSIGN = 0
- ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
- IRSIGN = 1
- ELSE
- IRSIGN = -1
- END IF
-*
-* Decode PIVTNG
-*
- IF( LSAME( PIVTNG, 'N' ) ) THEN
- IPVTNG = 0
- ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
- IPVTNG = 0
- ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
- IPVTNG = 1
- NPVTS = M
- ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
- IPVTNG = 2
- NPVTS = N
- ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
- IPVTNG = 3
- NPVTS = MIN( N, M )
- ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
- IPVTNG = 3
- NPVTS = MIN( N, M )
- ELSE
- IPVTNG = -1
- END IF
-*
-* Decode GRADE
-*
- IF( LSAME( GRADE, 'N' ) ) THEN
- IGRADE = 0
- ELSE IF( LSAME( GRADE, 'L' ) ) THEN
- IGRADE = 1
- ELSE IF( LSAME( GRADE, 'R' ) ) THEN
- IGRADE = 2
- ELSE IF( LSAME( GRADE, 'B' ) ) THEN
- IGRADE = 3
- ELSE IF( LSAME( GRADE, 'E' ) ) THEN
- IGRADE = 4
- ELSE IF( LSAME( GRADE, 'H' ) .OR. LSAME( GRADE, 'S' ) ) THEN
- IGRADE = 5
- ELSE
- IGRADE = -1
- END IF
-*
-* Decode PACK
-*
- IF( LSAME( PACK, 'N' ) ) THEN
- IPACK = 0
- ELSE IF( LSAME( PACK, 'U' ) ) THEN
- IPACK = 1
- ELSE IF( LSAME( PACK, 'L' ) ) THEN
- IPACK = 2
- ELSE IF( LSAME( PACK, 'C' ) ) THEN
- IPACK = 3
- ELSE IF( LSAME( PACK, 'R' ) ) THEN
- IPACK = 4
- ELSE IF( LSAME( PACK, 'B' ) ) THEN
- IPACK = 5
- ELSE IF( LSAME( PACK, 'Q' ) ) THEN
- IPACK = 6
- ELSE IF( LSAME( PACK, 'Z' ) ) THEN
- IPACK = 7
- ELSE
- IPACK = -1
- END IF
-*
-* Set certain internal parameters
-*
- MNMIN = MIN( M, N )
- KLL = MIN( KL, M-1 )
- KUU = MIN( KU, N-1 )
-*
-* If inv(DL) is used, check to see if DL has a zero entry.
-*
- DZERO = .FALSE.
- IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
- DO 10 I = 1, M
- IF( DL( I ).EQ.ZERO )
- $ DZERO = .TRUE.
- 10 CONTINUE
- END IF
-*
-* Check values in IPIVOT
-*
- BADPVT = .FALSE.
- IF( IPVTNG.GT.0 ) THEN
- DO 20 J = 1, NPVTS
- IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
- $ BADPVT = .TRUE.
- 20 CONTINUE
- END IF
-*
-* Set INFO if an error
-*
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.NE.N .AND. ISYM.EQ.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -3
- ELSE IF( ISYM.EQ.-1 ) THEN
- INFO = -5
- ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
- INFO = -7
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ COND.LT.ONE ) THEN
- INFO = -8
- ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
- $ IRSIGN.EQ.-1 ) THEN
- INFO = -10
- ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
- $ ( ( IGRADE.GE.1 .AND. IGRADE.LE.4 ) .AND. ISYM.EQ.0 ) )
- $ THEN
- INFO = -11
- ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
- INFO = -12
- ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
- $ IGRADE.EQ.5 ) .AND. ( MODEL.LT.-6 .OR. MODEL.GT.6 ) )
- $ THEN
- INFO = -13
- ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
- $ IGRADE.EQ.5 ) .AND. ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND.
- $ MODEL.NE.6 ) .AND. CONDL.LT.ONE ) THEN
- INFO = -14
- ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
- $ ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
- INFO = -16
- ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
- $ ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
- $ CONDR.LT.ONE ) THEN
- INFO = -17
- ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
- $ ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ISYM.EQ.0 ) )
- $ THEN
- INFO = -18
- ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
- INFO = -19
- ELSE IF( KL.LT.0 ) THEN
- INFO = -20
- ELSE IF( KU.LT.0 .OR. ( ISYM.EQ.0 .AND. KL.NE.KU ) ) THEN
- INFO = -21
- ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
- INFO = -22
- ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
- $ IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
- $ ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
- $ N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
- $ 0 .OR. M.NE.N ) ) ) THEN
- INFO = -24
- ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
- $ LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
- $ 4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
- $ 6 ) .AND. LDA.LT.KUU+1 ) .OR.
- $ ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
- INFO = -26
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATMR', -INFO )
- RETURN
- END IF
-*
-* Decide if we can pivot consistently
-*
- FULBND = .FALSE.
- IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
- $ FULBND = .TRUE.
-*
-* Initialize random number generator
-*
- DO 30 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 30 CONTINUE
-*
- ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
-*
-* 2) Set up D, DL, and DR, if indicated.
-*
-* Compute D according to COND and MODE
-*
- CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
- IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 40 I = 2, MNMIN
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 40 CONTINUE
- IF( TEMP.EQ.ZERO .AND. DMAX.NE.ZERO ) THEN
- INFO = 2
- RETURN
- END IF
- IF( TEMP.NE.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE
- ALPHA = ONE
- END IF
- DO 50 I = 1, MNMIN
- D( I ) = ALPHA*D( I )
- 50 CONTINUE
-*
- END IF
-*
-* Compute DL if grading set
-*
- IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
- $ 5 ) THEN
- CALL SLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- END IF
-*
-* Compute DR if grading set
-*
- IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
- CALL SLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = 4
- RETURN
- END IF
- END IF
-*
-* 3) Generate IWORK if pivoting
-*
- IF( IPVTNG.GT.0 ) THEN
- DO 60 I = 1, NPVTS
- IWORK( I ) = I
- 60 CONTINUE
- IF( FULBND ) THEN
- DO 70 I = 1, NPVTS
- K = IPIVOT( I )
- J = IWORK( I )
- IWORK( I ) = IWORK( K )
- IWORK( K ) = J
- 70 CONTINUE
- ELSE
- DO 80 I = NPVTS, 1, -1
- K = IPIVOT( I )
- J = IWORK( I )
- IWORK( I ) = IWORK( K )
- IWORK( K ) = J
- 80 CONTINUE
- END IF
- END IF
-*
-* 4) Generate matrices for each kind of PACKing
-* Always sweep matrix columnwise (if symmetric, upper
-* half only) so that matrix generated does not depend
-* on PACK
-*
- IF( FULBND ) THEN
-*
-* Use SLATM3 so matrices generated with differing PIVOTing only
-* differ only in the order of their rows and/or columns.
-*
- IF( IPACK.EQ.0 ) THEN
- IF( ISYM.EQ.0 ) THEN
- DO 100 J = 1, N
- DO 90 I = 1, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( ISUB, JSUB ) = TEMP
- A( JSUB, ISUB ) = TEMP
- 90 CONTINUE
- 100 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 120 J = 1, N
- DO 110 I = 1, M
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( ISUB, JSUB ) = TEMP
- 110 CONTINUE
- 120 CONTINUE
- END IF
-*
- ELSE IF( IPACK.EQ.1 ) THEN
-*
- DO 140 J = 1, N
- DO 130 I = 1, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MNSUB, MXSUB ) = TEMP
- IF( MNSUB.NE.MXSUB )
- $ A( MXSUB, MNSUB ) = ZERO
- 130 CONTINUE
- 140 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
- DO 160 J = 1, N
- DO 150 I = 1, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MXSUB, MNSUB ) = TEMP
- IF( MNSUB.NE.MXSUB )
- $ A( MNSUB, MXSUB ) = ZERO
- 150 CONTINUE
- 160 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
- DO 180 J = 1, N
- DO 170 I = 1, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
-*
-* Compute K = location of (ISUB,JSUB) entry in packed
-* array
-*
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
-*
-* Convert K to (IISUB,JJSUB) location
-*
- JJSUB = ( K-1 ) / LDA + 1
- IISUB = K - LDA*( JJSUB-1 )
-*
- A( IISUB, JJSUB ) = TEMP
- 170 CONTINUE
- 180 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
- DO 200 J = 1, N
- DO 190 I = 1, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
-*
-* Compute K = location of (I,J) entry in packed array
-*
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- IF( MNSUB.EQ.1 ) THEN
- K = MXSUB
- ELSE
- K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
- $ 2 + MXSUB - MNSUB + 1
- END IF
-*
-* Convert K to (IISUB,JJSUB) location
-*
- JJSUB = ( K-1 ) / LDA + 1
- IISUB = K - LDA*( JJSUB-1 )
-*
- A( IISUB, JJSUB ) = TEMP
- 190 CONTINUE
- 200 CONTINUE
-*
- ELSE IF( IPACK.EQ.5 ) THEN
-*
- DO 220 J = 1, N
- DO 210 I = J - KUU, J
- IF( I.LT.1 ) THEN
- A( J-I+1, I+N ) = ZERO
- ELSE
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MXSUB-MNSUB+1, MNSUB ) = TEMP
- END IF
- 210 CONTINUE
- 220 CONTINUE
-*
- ELSE IF( IPACK.EQ.6 ) THEN
-*
- DO 240 J = 1, N
- DO 230 I = J - KUU, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
- $ SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
- 230 CONTINUE
- 240 CONTINUE
-*
- ELSE IF( IPACK.EQ.7 ) THEN
-*
- IF( ISYM.EQ.0 ) THEN
- DO 260 J = 1, N
- DO 250 I = J - KUU, J
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- MNSUB = MIN( ISUB, JSUB )
- MXSUB = MAX( ISUB, JSUB )
- A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
- IF( I.LT.1 )
- $ A( J-I+1+KUU, I+N ) = ZERO
- IF( I.GE.1 .AND. MNSUB.NE.MXSUB )
- $ A( MXSUB-MNSUB+1+KUU, MNSUB ) = TEMP
- 250 CONTINUE
- 260 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 280 J = 1, N
- DO 270 I = J - KUU, J + KLL
- TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( ISUB-JSUB+KUU+1, JSUB ) = TEMP
- 270 CONTINUE
- 280 CONTINUE
- END IF
-*
- END IF
-*
- ELSE
-*
-* Use SLATM2
-*
- IF( IPACK.EQ.0 ) THEN
- IF( ISYM.EQ.0 ) THEN
- DO 300 J = 1, N
- DO 290 I = 1, J
- A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- A( J, I ) = A( I, J )
- 290 CONTINUE
- 300 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 320 J = 1, N
- DO 310 I = 1, M
- A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- 310 CONTINUE
- 320 CONTINUE
- END IF
-*
- ELSE IF( IPACK.EQ.1 ) THEN
-*
- DO 340 J = 1, N
- DO 330 I = 1, J
- A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
- $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
- IF( I.NE.J )
- $ A( J, I ) = ZERO
- 330 CONTINUE
- 340 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
- DO 360 J = 1, N
- DO 350 I = 1, J
- A( J, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
- $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
- IF( I.NE.J )
- $ A( I, J ) = ZERO
- 350 CONTINUE
- 360 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
- ISUB = 0
- JSUB = 1
- DO 380 J = 1, N
- DO 370 I = 1, J
- ISUB = ISUB + 1
- IF( ISUB.GT.LDA ) THEN
- ISUB = 1
- JSUB = JSUB + 1
- END IF
- A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- 370 CONTINUE
- 380 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
- IF( ISYM.EQ.0 ) THEN
- DO 400 J = 1, N
- DO 390 I = 1, J
-*
-* Compute K = location of (I,J) entry in packed array
-*
- IF( I.EQ.1 ) THEN
- K = J
- ELSE
- K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
- $ J - I + 1
- END IF
-*
-* Convert K to (ISUB,JSUB) location
-*
- JSUB = ( K-1 ) / LDA + 1
- ISUB = K - LDA*( JSUB-1 )
-*
- A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR,
- $ IPVTNG, IWORK, SPARSE )
- 390 CONTINUE
- 400 CONTINUE
- ELSE
- ISUB = 0
- JSUB = 1
- DO 420 J = 1, N
- DO 410 I = J, M
- ISUB = ISUB + 1
- IF( ISUB.GT.LDA ) THEN
- ISUB = 1
- JSUB = JSUB + 1
- END IF
- A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL, DR,
- $ IPVTNG, IWORK, SPARSE )
- 410 CONTINUE
- 420 CONTINUE
- END IF
-*
- ELSE IF( IPACK.EQ.5 ) THEN
-*
- DO 440 J = 1, N
- DO 430 I = J - KUU, J
- IF( I.LT.1 ) THEN
- A( J-I+1, I+N ) = ZERO
- ELSE
- A( J-I+1, I ) = SLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- END IF
- 430 CONTINUE
- 440 CONTINUE
-*
- ELSE IF( IPACK.EQ.6 ) THEN
-*
- DO 460 J = 1, N
- DO 450 I = J - KUU, J
- A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, IDIST,
- $ ISEED, D, IGRADE, DL, DR, IPVTNG,
- $ IWORK, SPARSE )
- 450 CONTINUE
- 460 CONTINUE
-*
- ELSE IF( IPACK.EQ.7 ) THEN
-*
- IF( ISYM.EQ.0 ) THEN
- DO 480 J = 1, N
- DO 470 I = J - KUU, J
- A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL,
- $ DR, IPVTNG, IWORK, SPARSE )
- IF( I.LT.1 )
- $ A( J-I+1+KUU, I+N ) = ZERO
- IF( I.GE.1 .AND. I.NE.J )
- $ A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
- 470 CONTINUE
- 480 CONTINUE
- ELSE IF( ISYM.EQ.1 ) THEN
- DO 500 J = 1, N
- DO 490 I = J - KUU, J + KLL
- A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU,
- $ IDIST, ISEED, D, IGRADE, DL,
- $ DR, IPVTNG, IWORK, SPARSE )
- 490 CONTINUE
- 500 CONTINUE
- END IF
-*
- END IF
-*
- END IF
-*
-* 5) Scaling the norm
-*
- IF( IPACK.EQ.0 ) THEN
- ONORM = SLANGE( 'M', M, N, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.1 ) THEN
- ONORM = SLANSY( 'M', 'U', N, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.2 ) THEN
- ONORM = SLANSY( 'M', 'L', N, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.3 ) THEN
- ONORM = SLANSP( 'M', 'U', N, A, TEMPA )
- ELSE IF( IPACK.EQ.4 ) THEN
- ONORM = SLANSP( 'M', 'L', N, A, TEMPA )
- ELSE IF( IPACK.EQ.5 ) THEN
- ONORM = SLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.6 ) THEN
- ONORM = SLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
- ELSE IF( IPACK.EQ.7 ) THEN
- ONORM = SLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
- END IF
-*
- IF( ANORM.GE.ZERO ) THEN
-*
- IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
-*
-* Desired scaling impossible
-*
- INFO = 5
- RETURN
-*
- ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
- $ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
-*
-* Scale carefully to avoid over / underflow
-*
- IF( IPACK.LE.2 ) THEN
- DO 510 J = 1, N
- CALL SSCAL( M, ONE / ONORM, A( 1, J ), 1 )
- CALL SSCAL( M, ANORM, A( 1, J ), 1 )
- 510 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
-*
- CALL SSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
- CALL SSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
- DO 520 J = 1, N
- CALL SSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
- CALL SSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
- 520 CONTINUE
-*
- END IF
-*
- ELSE
-*
-* Scale straightforwardly
-*
- IF( IPACK.LE.2 ) THEN
- DO 530 J = 1, N
- CALL SSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
- 530 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
-*
- CALL SSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
- DO 540 J = 1, N
- CALL SSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
- 540 CONTINUE
- END IF
-*
- END IF
-*
- END IF
-*
-* End of SLATMR
-*
- END
diff --git a/netlib/LAPACK/slatms.f b/netlib/LAPACK/slatms.f
deleted file mode 100644
index 9480e40..0000000
--- a/netlib/LAPACK/slatms.f
+++ /dev/null
@@ -1,1128 +0,0 @@
-*> \brief \b SLATMS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
-* KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIST, PACK, SYM
-* INTEGER INFO, KL, KU, LDA, M, MODE, N
-* REAL COND, DMAX
-* ..
-* .. Array Arguments ..
-* INTEGER ISEED( 4 )
-* REAL A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATMS generates random matrices with specified singular values
-*> (or symmetric/hermitian with specified eigenvalues)
-*> for testing LAPACK programs.
-*>
-*> SLATMS operates by applying the following sequence of
-*> operations:
-*>
-*> Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX, and SYM
-*> as described below.
-*>
-*> Generate a matrix with the appropriate band structure, by one
-*> of two methods:
-*>
-*> Method A:
-*> Generate a dense M x N matrix by multiplying D on the left
-*> and the right by random unitary matrices, then:
-*>
-*> Reduce the bandwidth according to KL and KU, using
-*> Householder transformations.
-*>
-*> Method B:
-*> Convert the bandwidth-0 (i.e., diagonal) matrix to a
-*> bandwidth-1 matrix using Givens rotations, "chasing"
-*> out-of-band elements back, much as in QR; then
-*> convert the bandwidth-1 to a bandwidth-2 matrix, etc.
-*> Note that for reasonably small bandwidths (relative to
-*> M and N) this requires less storage, as a dense matrix
-*> is not generated. Also, for symmetric matrices, only
-*> one triangle is generated.
-*>
-*> Method A is chosen if the bandwidth is a large fraction of the
-*> order of the matrix, and LDA is at least M (so a dense
-*> matrix can be stored.) Method B is chosen if the bandwidth
-*> is small (< 1/2 N for symmetric, < .3 N+M for
-*> non-symmetric), or LDA is less than M and not less than the
-*> bandwidth.
-*>
-*> Pack the matrix if desired. Options specified by PACK are:
-*> no packing
-*> zero out upper half (if symmetric)
-*> zero out lower half (if symmetric)
-*> store the upper half columnwise (if symmetric or upper
-*> triangular)
-*> store the lower half columnwise (if symmetric or lower
-*> triangular)
-*> store the lower triangle in banded format (if symmetric
-*> or lower triangular)
-*> store the upper triangle in banded format (if symmetric
-*> or upper triangular)
-*> store the entire matrix in banded format
-*> If Method B is chosen, and band format is specified, then the
-*> matrix will be generated in the band format, so no repacking
-*> will be necessary.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate the random eigen-/singular values.
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to SLATMS
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] SYM
-*> \verbatim
-*> SYM is CHARACTER*1
-*> If SYM='S' or 'H', the generated matrix is symmetric, with
-*> eigenvalues specified by D, COND, MODE, and DMAX; they
-*> may be positive, negative, or zero.
-*> If SYM='P', the generated matrix is symmetric, with
-*> eigenvalues (= singular values) specified by D, COND,
-*> MODE, and DMAX; they will not be negative.
-*> If SYM='N', the generated matrix is nonsymmetric, with
-*> singular values specified by D, COND, MODE, and DMAX;
-*> they will not be negative.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension ( MIN( M , N ) )
-*> This array is used to specify the singular values or
-*> eigenvalues of A (see SYM, above.) If MODE=0, then D is
-*> assumed to contain the singular/eigenvalues, otherwise
-*> they will be computed according to MODE, COND, and DMAX,
-*> and placed in D.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry this describes how the singular/eigenvalues are to
-*> be specified:
-*> MODE = 0 means use D as input
-*> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
-*> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then
-*> the elements of D will also be multiplied by a random
-*> sign (i.e., +1 or -1.)
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is REAL
-*> On entry, this is used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is REAL
-*> If MODE is neither -6, 0 nor 6, the contents of D, as
-*> computed according to MODE and COND, will be scaled by
-*> DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
-*> singular value (which is to say the norm) will be abs(DMAX).
-*> Note that DMAX need not be positive: if DMAX is negative
-*> (or zero), D will be scaled by a negative number (or zero).
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> This specifies the lower bandwidth of the matrix. For
-*> example, KL=0 implies upper triangular, KL=1 implies upper
-*> Hessenberg, and KL being at least M-1 means that the matrix
-*> has full lower bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> This specifies the upper bandwidth of the matrix. For
-*> example, KU=0 implies lower triangular, KU=1 implies lower
-*> Hessenberg, and KU being at least N-1 means that the matrix
-*> has full upper bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] PACK
-*> \verbatim
-*> PACK is CHARACTER*1
-*> This specifies packing of matrix as follows:
-*> 'N' => no packing
-*> 'U' => zero out all subdiagonal entries (if symmetric)
-*> 'L' => zero out all superdiagonal entries (if symmetric)
-*> 'C' => store the upper triangle columnwise
-*> (only if the matrix is symmetric or upper triangular)
-*> 'R' => store the lower triangle columnwise
-*> (only if the matrix is symmetric or lower triangular)
-*> 'B' => store the lower triangle in band storage scheme
-*> (only if matrix symmetric or lower triangular)
-*> 'Q' => store the upper triangle in band storage scheme
-*> (only if matrix symmetric or upper triangular)
-*> 'Z' => store the entire matrix in band storage scheme
-*> (pivoting can be provided for by using this
-*> option to store A in the trailing rows of
-*> the allocated storage)
-*>
-*> Using these options, the various LAPACK packed and banded
-*> storage schemes can be obtained:
-*> GB - use 'Z'
-*> PB, SB or TB - use 'B' or 'Q'
-*> PP, SP or TP - use 'C' or 'R'
-*>
-*> If two calls to SLATMS differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension ( LDA, N )
-*> On exit A is the desired test matrix. A is first generated
-*> in full (unpacked) form, and then packed, if so specified
-*> by PACK. Thus, the first M elements of the first N
-*> columns will always be modified. If PACK specifies a
-*> packed or banded storage scheme, all LDA elements of the
-*> first N columns will be modified; the elements of the
-*> array which do not correspond to elements of the generated
-*> matrix are set to zero.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> LDA specifies the first dimension of A as declared in the
-*> calling program. If PACK='N', 'U', 'L', 'C', or 'R', then
-*> LDA must be at least M. If PACK='B' or 'Q', then LDA must
-*> be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).
-*> If PACK='Z', LDA must be large enough to hold the packed
-*> array: MIN( KU, N-1) + MIN( KL, M-1) + 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ( 3*MAX( N , M ) )
-*> Workspace.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error code. On exit, INFO will be set to one of the
-*> following values:
-*> 0 => normal return
-*> -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
-*> -2 => N negative
-*> -3 => DIST illegal string
-*> -5 => SYM illegal string
-*> -7 => MODE not in range -6 to 6
-*> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -10 => KL negative
-*> -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL
-*> -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N';
-*> or PACK='C' or 'Q' and SYM='N' and KL is not zero;
-*> or PACK='R' or 'B' and SYM='N' and KU is not zero;
-*> or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not
-*> N.
-*> -14 => LDA is less than M, or PACK='Z' and LDA is less than
-*> MIN(KU,N-1) + MIN(KL,M-1) + 1.
-*> 1 => Error return from SLATM1
-*> 2 => Cannot scale to DMAX (max. sing. value is 0)
-*> 3 => Error return from SLAGGE or SLAGSY
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
- $ KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIST, PACK, SYM
- INTEGER INFO, KL, KU, LDA, M, MODE, N
- REAL COND, DMAX
-* ..
-* .. Array Arguments ..
- INTEGER ISEED( 4 )
- REAL A( LDA, * ), D( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN
- INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA,
- $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2,
- $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH,
- $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC,
- $ UUB
- REAL ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLARND
- EXTERNAL LSAME, SLARND
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAGGE, SLAGSY, SLAROT, SLARTG, SLATM1,
- $ SLASET, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, MAX, MIN, MOD, REAL, SIN
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Decode SYM
-*
- IF( LSAME( SYM, 'N' ) ) THEN
- ISYM = 1
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'P' ) ) THEN
- ISYM = 2
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'S' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE IF( LSAME( SYM, 'H' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE
- ISYM = -1
- END IF
-*
-* Decode PACK
-*
- ISYMPK = 0
- IF( LSAME( PACK, 'N' ) ) THEN
- IPACK = 0
- ELSE IF( LSAME( PACK, 'U' ) ) THEN
- IPACK = 1
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'L' ) ) THEN
- IPACK = 2
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'C' ) ) THEN
- IPACK = 3
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'R' ) ) THEN
- IPACK = 4
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'B' ) ) THEN
- IPACK = 5
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'Q' ) ) THEN
- IPACK = 6
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'Z' ) ) THEN
- IPACK = 7
- ELSE
- IPACK = -1
- END IF
-*
-* Set certain internal parameters
-*
- MNMIN = MIN( M, N )
- LLB = MIN( KL, M-1 )
- UUB = MIN( KU, N-1 )
- MR = MIN( M, N+LLB )
- NC = MIN( N, M+UUB )
-*
- IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN
- MINLDA = UUB + 1
- ELSE IF( IPACK.EQ.7 ) THEN
- MINLDA = LLB + UUB + 1
- ELSE
- MINLDA = M
- END IF
-*
-* Use Givens rotation method if bandwidth small enough,
-* or if LDA is too small to store the matrix unpacked.
-*
- GIVENS = .FALSE.
- IF( ISYM.EQ.1 ) THEN
- IF( REAL( LLB+UUB ).LT.0.3*REAL( MAX( 1, MR+NC ) ) )
- $ GIVENS = .TRUE.
- ELSE
- IF( 2*LLB.LT.M )
- $ GIVENS = .TRUE.
- END IF
- IF( LDA.LT.M .AND. LDA.GE.MINLDA )
- $ GIVENS = .TRUE.
-*
-* Set INFO if an error
-*
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -3
- ELSE IF( ISYM.EQ.-1 ) THEN
- INFO = -5
- ELSE IF( ABS( MODE ).GT.6 ) THEN
- INFO = -7
- ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
- $ THEN
- INFO = -8
- ELSE IF( KL.LT.0 ) THEN
- INFO = -10
- ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN
- INFO = -11
- ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR.
- $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR.
- $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR.
- $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN
- INFO = -12
- ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN
- INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATMS', -INFO )
- RETURN
- END IF
-*
-* Initialize random number generator
-*
- DO 10 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 10 CONTINUE
-*
- IF( MOD( ISEED( 4 ), 2 ).NE.1 )
- $ ISEED( 4 ) = ISEED( 4 ) + 1
-*
-* 2) Set up D if indicated.
-*
-* Compute D according to COND and MODE
-*
- CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Choose Top-Down if D is (apparently) increasing,
-* Bottom-Up if D is (apparently) decreasing.
-*
- IF( ABS( D( 1 ) ).LE.ABS( D( MNMIN ) ) ) THEN
- TOPDWN = .TRUE.
- ELSE
- TOPDWN = .FALSE.
- END IF
-*
- IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 20 I = 2, MNMIN
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 20 CONTINUE
-*
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE
- INFO = 2
- RETURN
- END IF
-*
- CALL SSCAL( MNMIN, ALPHA, D, 1 )
-*
- END IF
-*
-* 3) Generate Banded Matrix using Givens rotations.
-* Also the special case of UUB=LLB=0
-*
-* Compute Addressing constants to cover all
-* storage formats. Whether GE, SY, GB, or SB,
-* upper or lower triangle or both,
-* the (i,j)-th element is in
-* A( i - ISKEW*j + IOFFST, j )
-*
- IF( IPACK.GT.4 ) THEN
- ILDA = LDA - 1
- ISKEW = 1
- IF( IPACK.GT.5 ) THEN
- IOFFST = UUB + 1
- ELSE
- IOFFST = 1
- END IF
- ELSE
- ILDA = LDA
- ISKEW = 0
- IOFFST = 0
- END IF
-*
-* IPACKG is the format that the matrix is generated in. If this is
-* different from IPACK, then the matrix must be repacked at the
-* end. It also signals how to compute the norm, for scaling.
-*
- IPACKG = 0
- CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
-*
-* Diagonal Matrix -- We are done, unless it
-* is to be stored SP/PP/TP (PACK='R' or 'C')
-*
- IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
- IF( IPACK.LE.2 .OR. IPACK.GE.5 )
- $ IPACKG = IPACK
-*
- ELSE IF( GIVENS ) THEN
-*
-* Check whether to use Givens rotations,
-* Householder transformations, or nothing.
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- IF( IPACK.GT.4 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
-*
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
-*
- IF( TOPDWN ) THEN
- JKL = 0
- DO 50 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* Last row actually rotated is M
-* Last column actually rotated is MIN( M+JKU, N )
-*
- DO 40 JR = 1, MIN( M+JKU, N ) + JKL - 1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL )
- IF( JR.LT.M ) THEN
- IL = MIN( N, JR+JKU ) + 1 - ICOL
- CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C,
- $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IR = JR
- IC = ICOL
- DO 30 JCH = JR - JKL, 1, -JKL - JKU
- IF( IR.LT.M ) THEN
- CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- IROW = MAX( 1, JCH-JKU )
- IL = IR + 2 - IROW
- TEMP = ZERO
- ILTEMP = JCH.GT.JKU
- CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IROW-ISKEW*IC+IOFFST, IC ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), TEMP, C, S, DUMMY )
- ICOL = MAX( 1, JCH-JKU-JKL )
- IL = IC + 2 - ICOL
- EXTRA = ZERO
- CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
-*
- JKU = UUB
- DO 80 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
- DO 70 JC = 1, MIN( N+JKL, M ) + JKU - 1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU )
- IF( JC.LT.N ) THEN
- IL = MIN( M, JC+JKL ) + 1 - IROW
- CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C,
- $ S, A( IROW-ISKEW*JC+IOFFST, JC ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IC = JC
- IR = IROW
- DO 60 JCH = JC - JKU, 1, -JKL - JKU
- IF( IC.LT.N ) THEN
- CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- ICOL = MAX( 1, JCH-JKL )
- IL = IC + 2 - ICOL
- TEMP = ZERO
- ILTEMP = JCH.GT.JKL
- CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST,
- $ ICOL+1 ), TEMP, C, S, DUMMY )
- IROW = MAX( 1, JCH-JKL-JKU )
- IL = IR + 2 - IROW
- EXTRA = ZERO
- CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
-*
- ELSE
-*
-* Bottom-Up -- Start at the bottom right.
-*
- JKL = 0
- DO 110 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* First row actually rotated is M
-* First column actually rotated is MIN( M+JKU, N )
-*
- IENDCH = MIN( M, N+JKL ) - 1
- DO 100 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU+1 )
- IF( JC.GT.0 ) THEN
- IL = MIN( M, JC+JKL+1 ) + 1 - IROW
- CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL,
- $ C, S, A( IROW-ISKEW*JC+IOFFST,
- $ JC ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IC = JC
- DO 90 JCH = JC + JKL, IENDCH, JKL + JKU
- ILEXTR = IC.GT.0
- IF( ILEXTR ) THEN
- CALL SLARTG( A( JCH-ISKEW*IC+IOFFST, IC ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IC = MAX( 1, IC )
- ICOL = MIN( N-1, JCH+JKU )
- ILTEMP = JCH + JKU.LT.N
- TEMP = ZERO
- CALL SLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC,
- $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ),
- $ ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL SLAROT( .FALSE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, TEMP, EXTRA )
- IC = ICOL
- END IF
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
-*
- JKU = UUB
- DO 140 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
-* First row actually rotated is MIN( N+JKL, M )
-* First column actually rotated is N
-*
- IENDCH = MIN( N, M+JKU ) - 1
- DO 130 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL+1 )
- IF( JR.GT.0 ) THEN
- IL = MIN( N, JR+JKU+1 ) + 1 - ICOL
- CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL,
- $ C, S, A( JR-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IR = JR
- DO 120 JCH = JR + JKU, IENDCH, JKL + JKU
- ILEXTR = IR.GT.0
- IF( ILEXTR ) THEN
- CALL SLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IR = MAX( 1, IR )
- IROW = MIN( M-1, JCH+JKL )
- ILTEMP = JCH + JKL.LT.M
- TEMP = ZERO
- CALL SLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR,
- $ C, S, A( IR-ISKEW*JCH+IOFFST,
- $ JCH ), ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL SLAROT( .TRUE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ ILDA, TEMP, EXTRA )
- IR = IROW
- END IF
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
- END IF
-*
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- IPACKG = IPACK
- IOFFG = IOFFST
-*
- IF( TOPDWN ) THEN
-*
-* Top-Down -- Generate Upper triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 6
- IOFFG = UUB + 1
- ELSE
- IPACKG = 1
- END IF
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 170 K = 1, UUB
- DO 160 JC = 1, N - 1
- IROW = MAX( 1, JC-K )
- IL = MIN( JC+1, K+2 )
- EXTRA = ZERO
- TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 )
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- CALL SLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S,
- $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA,
- $ EXTRA, TEMP )
- CALL SLAROT( .TRUE., .TRUE., .FALSE.,
- $ MIN( K, N-JC )+1, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, DUMMY )
-*
-* Chase EXTRA back up the matrix
-*
- ICOL = JC
- DO 150 JCH = JC - K, 1, -K
- CALL SLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG,
- $ ICOL+1 ), EXTRA, C, S, DUMMY )
- TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 )
- CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S,
- $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- IROW = MAX( 1, JCH-K )
- IL = MIN( JCH+1, K+2 )
- EXTRA = ZERO
- CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C,
- $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ),
- $ ILDA, EXTRA, TEMP )
- ICOL = JCH
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
-*
-* If we need lower triangle, copy from upper. Note that
-* the order of copying is chosen to work for 'q' -> 'b'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN
- DO 190 JC = 1, N
- IROW = IOFFST - ISKEW*JC
- DO 180 JR = JC, MIN( N, JC+UUB )
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 180 CONTINUE
- 190 CONTINUE
- IF( IPACK.EQ.5 ) THEN
- DO 210 JC = N - UUB + 1, N
- DO 200 JR = N + 2 - JC, UUB + 1
- A( JR, JC ) = ZERO
- 200 CONTINUE
- 210 CONTINUE
- END IF
- IF( IPACKG.EQ.6 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- ELSE
-*
-* Bottom-Up -- Generate Lower triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 5
- IF( IPACK.EQ.6 )
- $ IOFFG = 1
- ELSE
- IPACKG = 2
- END IF
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 240 K = 1, UUB
- DO 230 JC = N - 1, 1, -1
- IL = MIN( N+1-JC, K+2 )
- EXTRA = ZERO
- TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC )
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = -SIN( ANGLE )
- CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, EXTRA )
- ICOL = MAX( 1, JC-K+1 )
- CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C,
- $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, DUMMY, TEMP )
-*
-* Chase EXTRA back down the matrix
-*
- ICOL = JC
- DO 220 JCH = JC + K, N - 1, K
- CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ EXTRA, C, S, DUMMY )
- TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH )
- CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, EXTRA, TEMP )
- IL = MIN( N+1-JCH, K+2 )
- EXTRA = ZERO
- CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C,
- $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- ICOL = JCH
- 220 CONTINUE
- 230 CONTINUE
- 240 CONTINUE
-*
-* If we need upper triangle, copy from lower. Note that
-* the order of copying is chosen to work for 'b' -> 'q'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN
- DO 260 JC = N, 1, -1
- IROW = IOFFST - ISKEW*JC
- DO 250 JR = JC, MAX( 1, JC-UUB ), -1
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 250 CONTINUE
- 260 CONTINUE
- IF( IPACK.EQ.6 ) THEN
- DO 280 JC = 1, UUB
- DO 270 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 270 CONTINUE
- 280 CONTINUE
- END IF
- IF( IPACKG.EQ.5 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-*
-* 4) Generate Banded Matrix by first
-* Rotating by random Unitary matrices,
-* then reducing the bandwidth using Householder
-* transformations.
-*
-* Note: we should get here only if LDA .ge. N
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- CALL SLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK,
- $ IINFO )
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- CALL SLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
-*
- END IF
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- END IF
-*
-* 5) Pack the matrix
-*
- IF( IPACK.NE.IPACKG ) THEN
- IF( IPACK.EQ.1 ) THEN
-*
-* 'U' -- Upper triangular, not packed
-*
- DO 300 J = 1, M
- DO 290 I = J + 1, M
- A( I, J ) = ZERO
- 290 CONTINUE
- 300 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
-* 'L' -- Lower triangular, not packed
-*
- DO 320 J = 2, M
- DO 310 I = 1, J - 1
- A( I, J ) = ZERO
- 310 CONTINUE
- 320 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
-* 'C' -- Upper triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 340 J = 1, M
- DO 330 I = 1, J
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 330 CONTINUE
- 340 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
-* 'R' -- Lower triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 360 J = 1, M
- DO 350 I = J, M
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 350 CONTINUE
- 360 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* 'B' -- The lower triangle is packed as a band matrix.
-* 'Q' -- The upper triangle is packed as a band matrix.
-* 'Z' -- The whole matrix is packed as a band matrix.
-*
- IF( IPACK.EQ.5 )
- $ UUB = 0
- IF( IPACK.EQ.6 )
- $ LLB = 0
-*
- DO 380 J = 1, UUB
- DO 370 I = MIN( J+LLB, M ), 1, -1
- A( I-J+UUB+1, J ) = A( I, J )
- 370 CONTINUE
- 380 CONTINUE
-*
- DO 400 J = UUB + 2, N
- DO 390 I = J - UUB, MIN( J+LLB, M )
- A( I-J+UUB+1, J ) = A( I, J )
- 390 CONTINUE
- 400 CONTINUE
- END IF
-*
-* If packed, zero out extraneous elements.
-*
-* Symmetric/Triangular Packed --
-* zero out everything after A(IROW,ICOL)
-*
- IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
- DO 420 JC = ICOL, M
- DO 410 JR = IROW + 1, LDA
- A( JR, JC ) = ZERO
- 410 CONTINUE
- IROW = 0
- 420 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* Packed Band --
-* 1st row is now in A( UUB+2-j, j), zero above it
-* m-th row is now in A( M+UUB-j,j), zero below it
-* last non-zero diagonal is now in A( UUB+LLB+1,j ),
-* zero below it, too.
-*
- IR1 = UUB + LLB + 2
- IR2 = UUB + M + 2
- DO 450 JC = 1, N
- DO 430 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 430 CONTINUE
- DO 440 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA
- A( JR, JC ) = ZERO
- 440 CONTINUE
- 450 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SLATMS
-*
- END
diff --git a/netlib/LAPACK/slatmt.f b/netlib/LAPACK/slatmt.f
deleted file mode 100644
index 7bdfeff..0000000
--- a/netlib/LAPACK/slatmt.f
+++ /dev/null
@@ -1,1139 +0,0 @@
-*> \brief \b SLATMT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
-* RANK, KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* REAL COND, DMAX
-* INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK
-* CHARACTER DIST, PACK, SYM
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( * ), WORK( * )
-* INTEGER ISEED( 4 )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATMT generates random matrices with specified singular values
-*> (or symmetric/hermitian with specified eigenvalues)
-*> for testing LAPACK programs.
-*>
-*> SLATMT operates by applying the following sequence of
-*> operations:
-*>
-*> Set the diagonal to D, where D may be input or
-*> computed according to MODE, COND, DMAX, and SYM
-*> as described below.
-*>
-*> Generate a matrix with the appropriate band structure, by one
-*> of two methods:
-*>
-*> Method A:
-*> Generate a dense M x N matrix by multiplying D on the left
-*> and the right by random unitary matrices, then:
-*>
-*> Reduce the bandwidth according to KL and KU, using
-*> Householder transformations.
-*>
-*> Method B:
-*> Convert the bandwidth-0 (i.e., diagonal) matrix to a
-*> bandwidth-1 matrix using Givens rotations, "chasing"
-*> out-of-band elements back, much as in QR; then
-*> convert the bandwidth-1 to a bandwidth-2 matrix, etc.
-*> Note that for reasonably small bandwidths (relative to
-*> M and N) this requires less storage, as a dense matrix
-*> is not generated. Also, for symmetric matrices, only
-*> one triangle is generated.
-*>
-*> Method A is chosen if the bandwidth is a large fraction of the
-*> order of the matrix, and LDA is at least M (so a dense
-*> matrix can be stored.) Method B is chosen if the bandwidth
-*> is small (< 1/2 N for symmetric, < .3 N+M for
-*> non-symmetric), or LDA is less than M and not less than the
-*> bandwidth.
-*>
-*> Pack the matrix if desired. Options specified by PACK are:
-*> no packing
-*> zero out upper half (if symmetric)
-*> zero out lower half (if symmetric)
-*> store the upper half columnwise (if symmetric or upper
-*> triangular)
-*> store the lower half columnwise (if symmetric or lower
-*> triangular)
-*> store the lower triangle in banded format (if symmetric
-*> or lower triangular)
-*> store the upper triangle in banded format (if symmetric
-*> or upper triangular)
-*> store the entire matrix in banded format
-*> If Method B is chosen, and band format is specified, then the
-*> matrix will be generated in the band format, so no repacking
-*> will be necessary.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of A. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DIST
-*> \verbatim
-*> DIST is CHARACTER*1
-*> On entry, DIST specifies the type of distribution to be used
-*> to generate the random eigen-/singular values.
-*> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
-*> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
-*> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] ISEED
-*> \verbatim
-*> ISEED is INTEGER array, dimension ( 4 )
-*> On entry ISEED specifies the seed of the random number
-*> generator. They should lie between 0 and 4095 inclusive,
-*> and ISEED(4) should be odd. The random number generator
-*> uses a linear congruential sequence limited to small
-*> integers, and so should produce machine independent
-*> random numbers. The values of ISEED are changed on
-*> exit, and can be used in the next call to SLATMT
-*> to continue the same random number sequence.
-*> Changed on exit.
-*> \endverbatim
-*>
-*> \param[in] SYM
-*> \verbatim
-*> SYM is CHARACTER*1
-*> If SYM='S' or 'H', the generated matrix is symmetric, with
-*> eigenvalues specified by D, COND, MODE, and DMAX; they
-*> may be positive, negative, or zero.
-*> If SYM='P', the generated matrix is symmetric, with
-*> eigenvalues (= singular values) specified by D, COND,
-*> MODE, and DMAX; they will not be negative.
-*> If SYM='N', the generated matrix is nonsymmetric, with
-*> singular values specified by D, COND, MODE, and DMAX;
-*> they will not be negative.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension ( MIN( M , N ) )
-*> This array is used to specify the singular values or
-*> eigenvalues of A (see SYM, above.) If MODE=0, then D is
-*> assumed to contain the singular/eigenvalues, otherwise
-*> they will be computed according to MODE, COND, and DMAX,
-*> and placed in D.
-*> Modified if MODE is nonzero.
-*> \endverbatim
-*>
-*> \param[in] MODE
-*> \verbatim
-*> MODE is INTEGER
-*> On entry this describes how the singular/eigenvalues are to
-*> be specified:
-*> MODE = 0 means use D as input
-*>
-*> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
-*> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
-*> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1))
-*>
-*> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
-*> MODE = 5 sets D to random numbers in the range
-*> ( 1/COND , 1 ) such that their logarithms
-*> are uniformly distributed.
-*> MODE = 6 set D to random numbers from same distribution
-*> as the rest of the matrix.
-*> MODE < 0 has the same meaning as ABS(MODE), except that
-*> the order of the elements of D is reversed.
-*> Thus if MODE is positive, D has entries ranging from
-*> 1 to 1/COND, if negative, from 1/COND to 1,
-*> If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then
-*> the elements of D will also be multiplied by a random
-*> sign (i.e., +1 or -1.)
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] COND
-*> \verbatim
-*> COND is REAL
-*> On entry, this is used as described under MODE above.
-*> If used, it must be >= 1. Not modified.
-*> \endverbatim
-*>
-*> \param[in] DMAX
-*> \verbatim
-*> DMAX is REAL
-*> If MODE is neither -6, 0 nor 6, the contents of D, as
-*> computed according to MODE and COND, will be scaled by
-*> DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
-*> singular value (which is to say the norm) will be abs(DMAX).
-*> Note that DMAX need not be positive: if DMAX is negative
-*> (or zero), D will be scaled by a negative number (or zero).
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The rank of matrix to be generated for modes 1,2,3 only.
-*> D( RANK+1:N ) = 0.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> This specifies the lower bandwidth of the matrix. For
-*> example, KL=0 implies upper triangular, KL=1 implies upper
-*> Hessenberg, and KL being at least M-1 means that the matrix
-*> has full lower bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> This specifies the upper bandwidth of the matrix. For
-*> example, KU=0 implies lower triangular, KU=1 implies lower
-*> Hessenberg, and KU being at least N-1 means that the matrix
-*> has full upper bandwidth. KL must equal KU if the matrix
-*> is symmetric.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in] PACK
-*> \verbatim
-*> PACK is CHARACTER*1
-*> This specifies packing of matrix as follows:
-*> 'N' => no packing
-*> 'U' => zero out all subdiagonal entries (if symmetric)
-*> 'L' => zero out all superdiagonal entries (if symmetric)
-*> 'C' => store the upper triangle columnwise
-*> (only if the matrix is symmetric or upper triangular)
-*> 'R' => store the lower triangle columnwise
-*> (only if the matrix is symmetric or lower triangular)
-*> 'B' => store the lower triangle in band storage scheme
-*> (only if matrix symmetric or lower triangular)
-*> 'Q' => store the upper triangle in band storage scheme
-*> (only if matrix symmetric or upper triangular)
-*> 'Z' => store the entire matrix in band storage scheme
-*> (pivoting can be provided for by using this
-*> option to store A in the trailing rows of
-*> the allocated storage)
-*>
-*> Using these options, the various LAPACK packed and banded
-*> storage schemes can be obtained:
-*> GB - use 'Z'
-*> PB, SB or TB - use 'B' or 'Q'
-*> PP, SP or TP - use 'C' or 'R'
-*>
-*> If two calls to SLATMT differ only in the PACK parameter,
-*> they will generate mathematically equivalent matrices.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension ( LDA, N )
-*> On exit A is the desired test matrix. A is first generated
-*> in full (unpacked) form, and then packed, if so specified
-*> by PACK. Thus, the first M elements of the first N
-*> columns will always be modified. If PACK specifies a
-*> packed or banded storage scheme, all LDA elements of the
-*> first N columns will be modified; the elements of the
-*> array which do not correspond to elements of the generated
-*> matrix are set to zero.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> LDA specifies the first dimension of A as declared in the
-*> calling program. If PACK='N', 'U', 'L', 'C', or 'R', then
-*> LDA must be at least M. If PACK='B' or 'Q', then LDA must
-*> be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).
-*> If PACK='Z', LDA must be large enough to hold the packed
-*> array: MIN( KU, N-1) + MIN( KL, M-1) + 1.
-*> Not modified.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension ( 3*MAX( N , M ) )
-*> Workspace.
-*> Modified.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> Error code. On exit, INFO will be set to one of the
-*> following values:
-*> 0 => normal return
-*> -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
-*> -2 => N negative
-*> -3 => DIST illegal string
-*> -5 => SYM illegal string
-*> -7 => MODE not in range -6 to 6
-*> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
-*> -10 => KL negative
-*> -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL
-*> -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N';
-*> or PACK='C' or 'Q' and SYM='N' and KL is not zero;
-*> or PACK='R' or 'B' and SYM='N' and KU is not zero;
-*> or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not
-*> N.
-*> -14 => LDA is less than M, or PACK='Z' and LDA is less than
-*> MIN(KU,N-1) + MIN(KL,M-1) + 1.
-*> 1 => Error return from SLATM7
-*> 2 => Cannot scale to DMAX (max. sing. value is 0)
-*> 3 => Error return from SLAGGE or SLAGSY
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup real_matgen
-*
-* =====================================================================
- SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
- $ RANK, KL, KU, PACK, A, LDA, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL COND, DMAX
- INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK
- CHARACTER DIST, PACK, SYM
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( * ), WORK( * )
- INTEGER ISEED( 4 )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
- REAL TWOPI
- PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 )
-* ..
-* .. Local Scalars ..
- REAL ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP
- INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA,
- $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2,
- $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH,
- $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC,
- $ UUB
- LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN
-* ..
-* .. External Functions ..
- REAL SLARND
- LOGICAL LSAME
- EXTERNAL SLARND, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLATM7, SCOPY, SLAGGE, SLAGSY, SLAROT,
- $ SLARTG, SLASET, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, MAX, MIN, MOD, REAL, SIN
-* ..
-* .. Executable Statements ..
-*
-* 1) Decode and Test the input parameters.
-* Initialize flags & seed.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Decode DIST
-*
- IF( LSAME( DIST, 'U' ) ) THEN
- IDIST = 1
- ELSE IF( LSAME( DIST, 'S' ) ) THEN
- IDIST = 2
- ELSE IF( LSAME( DIST, 'N' ) ) THEN
- IDIST = 3
- ELSE
- IDIST = -1
- END IF
-*
-* Decode SYM
-*
- IF( LSAME( SYM, 'N' ) ) THEN
- ISYM = 1
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'P' ) ) THEN
- ISYM = 2
- IRSIGN = 0
- ELSE IF( LSAME( SYM, 'S' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE IF( LSAME( SYM, 'H' ) ) THEN
- ISYM = 2
- IRSIGN = 1
- ELSE
- ISYM = -1
- END IF
-*
-* Decode PACK
-*
- ISYMPK = 0
- IF( LSAME( PACK, 'N' ) ) THEN
- IPACK = 0
- ELSE IF( LSAME( PACK, 'U' ) ) THEN
- IPACK = 1
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'L' ) ) THEN
- IPACK = 2
- ISYMPK = 1
- ELSE IF( LSAME( PACK, 'C' ) ) THEN
- IPACK = 3
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'R' ) ) THEN
- IPACK = 4
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'B' ) ) THEN
- IPACK = 5
- ISYMPK = 3
- ELSE IF( LSAME( PACK, 'Q' ) ) THEN
- IPACK = 6
- ISYMPK = 2
- ELSE IF( LSAME( PACK, 'Z' ) ) THEN
- IPACK = 7
- ELSE
- IPACK = -1
- END IF
-*
-* Set certain internal parameters
-*
- MNMIN = MIN( M, N )
- LLB = MIN( KL, M-1 )
- UUB = MIN( KU, N-1 )
- MR = MIN( M, N+LLB )
- NC = MIN( N, M+UUB )
-*
- IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN
- MINLDA = UUB + 1
- ELSE IF( IPACK.EQ.7 ) THEN
- MINLDA = LLB + UUB + 1
- ELSE
- MINLDA = M
- END IF
-*
-* Use Givens rotation method if bandwidth small enough,
-* or if LDA is too small to store the matrix unpacked.
-*
- GIVENS = .FALSE.
- IF( ISYM.EQ.1 ) THEN
- IF( REAL( LLB+UUB ).LT.0.3*REAL( MAX( 1, MR+NC ) ) )
- $ GIVENS = .TRUE.
- ELSE
- IF( 2*LLB.LT.M )
- $ GIVENS = .TRUE.
- END IF
- IF( LDA.LT.M .AND. LDA.GE.MINLDA )
- $ GIVENS = .TRUE.
-*
-* Set INFO if an error
-*
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( IDIST.EQ.-1 ) THEN
- INFO = -3
- ELSE IF( ISYM.EQ.-1 ) THEN
- INFO = -5
- ELSE IF( ABS( MODE ).GT.6 ) THEN
- INFO = -7
- ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
- $ THEN
- INFO = -8
- ELSE IF( KL.LT.0 ) THEN
- INFO = -10
- ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN
- INFO = -11
- ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR.
- $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR.
- $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR.
- $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN
- INFO = -12
- ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN
- INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATMT', -INFO )
- RETURN
- END IF
-*
-* Initialize random number generator
-*
- DO 100 I = 1, 4
- ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
- 100 CONTINUE
-*
- IF( MOD( ISEED( 4 ), 2 ).NE.1 )
- $ ISEED( 4 ) = ISEED( 4 ) + 1
-*
-* 2) Set up D if indicated.
-*
-* Compute D according to COND and MODE
-*
- CALL SLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, RANK,
- $ IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Choose Top-Down if D is (apparently) increasing,
-* Bottom-Up if D is (apparently) decreasing.
-*
- IF( ABS( D( 1 ) ).LE.ABS( D( RANK ) ) ) THEN
- TOPDWN = .TRUE.
- ELSE
- TOPDWN = .FALSE.
- END IF
-*
- IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
-*
-* Scale by DMAX
-*
- TEMP = ABS( D( 1 ) )
- DO 110 I = 2, RANK
- TEMP = MAX( TEMP, ABS( D( I ) ) )
- 110 CONTINUE
-*
- IF( TEMP.GT.ZERO ) THEN
- ALPHA = DMAX / TEMP
- ELSE
- INFO = 2
- RETURN
- END IF
-*
- CALL SSCAL( RANK, ALPHA, D, 1 )
-*
- END IF
-*
-* 3) Generate Banded Matrix using Givens rotations.
-* Also the special case of UUB=LLB=0
-*
-* Compute Addressing constants to cover all
-* storage formats. Whether GE, SY, GB, or SB,
-* upper or lower triangle or both,
-* the (i,j)-th element is in
-* A( i - ISKEW*j + IOFFST, j )
-*
- IF( IPACK.GT.4 ) THEN
- ILDA = LDA - 1
- ISKEW = 1
- IF( IPACK.GT.5 ) THEN
- IOFFST = UUB + 1
- ELSE
- IOFFST = 1
- END IF
- ELSE
- ILDA = LDA
- ISKEW = 0
- IOFFST = 0
- END IF
-*
-* IPACKG is the format that the matrix is generated in. If this is
-* different from IPACK, then the matrix must be repacked at the
-* end. It also signals how to compute the norm, for scaling.
-*
- IPACKG = 0
- CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
-*
-* Diagonal Matrix -- We are done, unless it
-* is to be stored SP/PP/TP (PACK='R' or 'C')
-*
- IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
- IF( IPACK.LE.2 .OR. IPACK.GE.5 )
- $ IPACKG = IPACK
-*
- ELSE IF( GIVENS ) THEN
-*
-* Check whether to use Givens rotations,
-* Householder transformations, or nothing.
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- IF( IPACK.GT.4 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
-*
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 )
-*
- IF( TOPDWN ) THEN
- JKL = 0
- DO 140 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* Last row actually rotated is M
-* Last column actually rotated is MIN( M+JKU, N )
-*
- DO 130 JR = 1, MIN( M+JKU, N ) + JKL - 1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL )
- IF( JR.LT.M ) THEN
- IL = MIN( N, JR+JKU ) + 1 - ICOL
- CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C,
- $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IR = JR
- IC = ICOL
- DO 120 JCH = JR - JKL, 1, -JKL - JKU
- IF( IR.LT.M ) THEN
- CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- IROW = MAX( 1, JCH-JKU )
- IL = IR + 2 - IROW
- TEMP = ZERO
- ILTEMP = JCH.GT.JKU
- CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IROW-ISKEW*IC+IOFFST, IC ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), TEMP, C, S, DUMMY )
- ICOL = MAX( 1, JCH-JKU-JKL )
- IL = IC + 2 - ICOL
- EXTRA = ZERO
- CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 120 CONTINUE
- 130 CONTINUE
- 140 CONTINUE
-*
- JKU = UUB
- DO 170 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
- DO 160 JC = 1, MIN( N+JKL, M ) + JKU - 1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU )
- IF( JC.LT.N ) THEN
- IL = MIN( M, JC+JKL ) + 1 - IROW
- CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C,
- $ S, A( IROW-ISKEW*JC+IOFFST, JC ),
- $ ILDA, EXTRA, DUMMY )
- END IF
-*
-* Chase "EXTRA" back up
-*
- IC = JC
- IR = IROW
- DO 150 JCH = JC - JKU, 1, -JKL - JKU
- IF( IC.LT.N ) THEN
- CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
- $ IC+1 ), EXTRA, C, S, DUMMY )
- END IF
- ICOL = MAX( 1, JCH-JKL )
- IL = IC + 2 - ICOL
- TEMP = ZERO
- ILTEMP = JCH.GT.JKL
- CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S,
- $ A( IR-ISKEW*ICOL+IOFFST, ICOL ),
- $ ILDA, TEMP, EXTRA )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST,
- $ ICOL+1 ), TEMP, C, S, DUMMY )
- IROW = MAX( 1, JCH-JKL-JKU )
- IL = IR + 2 - IROW
- EXTRA = ZERO
- CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE.,
- $ IL, C, -S, A( IROW-ISKEW*ICOL+
- $ IOFFST, ICOL ), ILDA, EXTRA,
- $ TEMP )
- IC = ICOL
- IR = IROW
- END IF
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
-*
- ELSE
-*
-* Bottom-Up -- Start at the bottom right.
-*
- JKL = 0
- DO 200 JKU = 1, UUB
-*
-* Transform from bandwidth JKL, JKU-1 to JKL, JKU
-*
-* First row actually rotated is M
-* First column actually rotated is MIN( M+JKU, N )
-*
- IENDCH = MIN( M, N+JKL ) - 1
- DO 190 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- IROW = MAX( 1, JC-JKU+1 )
- IF( JC.GT.0 ) THEN
- IL = MIN( M, JC+JKL+1 ) + 1 - IROW
- CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL,
- $ C, S, A( IROW-ISKEW*JC+IOFFST,
- $ JC ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IC = JC
- DO 180 JCH = JC + JKL, IENDCH, JKL + JKU
- ILEXTR = IC.GT.0
- IF( ILEXTR ) THEN
- CALL SLARTG( A( JCH-ISKEW*IC+IOFFST, IC ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IC = MAX( 1, IC )
- ICOL = MIN( N-1, JCH+JKU )
- ILTEMP = JCH + JKU.LT.N
- TEMP = ZERO
- CALL SLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC,
- $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ),
- $ ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL SLAROT( .FALSE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, TEMP, EXTRA )
- IC = ICOL
- END IF
- 180 CONTINUE
- 190 CONTINUE
- 200 CONTINUE
-*
- JKU = UUB
- DO 230 JKL = 1, LLB
-*
-* Transform from bandwidth JKL-1, JKU to JKL, JKU
-*
-* First row actually rotated is MIN( N+JKL, M )
-* First column actually rotated is N
-*
- IENDCH = MIN( N, M+JKU ) - 1
- DO 220 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1
- EXTRA = ZERO
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- ICOL = MAX( 1, JR-JKL+1 )
- IF( JR.GT.0 ) THEN
- IL = MIN( N, JR+JKU+1 ) + 1 - ICOL
- CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL,
- $ C, S, A( JR-ISKEW*ICOL+IOFFST,
- $ ICOL ), ILDA, DUMMY, EXTRA )
- END IF
-*
-* Chase "EXTRA" back down
-*
- IR = JR
- DO 210 JCH = JR + JKU, IENDCH, JKL + JKU
- ILEXTR = IR.GT.0
- IF( ILEXTR ) THEN
- CALL SLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ),
- $ EXTRA, C, S, DUMMY )
- END IF
- IR = MAX( 1, IR )
- IROW = MIN( M-1, JCH+JKL )
- ILTEMP = JCH + JKL.LT.M
- TEMP = ZERO
- CALL SLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR,
- $ C, S, A( IR-ISKEW*JCH+IOFFST,
- $ JCH ), ILDA, EXTRA, TEMP )
- IF( ILTEMP ) THEN
- CALL SLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ TEMP, C, S, DUMMY )
- IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
- EXTRA = ZERO
- CALL SLAROT( .TRUE., .TRUE.,
- $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
- $ A( IROW-ISKEW*JCH+IOFFST, JCH ),
- $ ILDA, TEMP, EXTRA )
- IR = IROW
- END IF
- 210 CONTINUE
- 220 CONTINUE
- 230 CONTINUE
- END IF
-*
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- IPACKG = IPACK
- IOFFG = IOFFST
-*
- IF( TOPDWN ) THEN
-*
-* Top-Down -- Generate Upper triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 6
- IOFFG = UUB + 1
- ELSE
- IPACKG = 1
- END IF
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 260 K = 1, UUB
- DO 250 JC = 1, N - 1
- IROW = MAX( 1, JC-K )
- IL = MIN( JC+1, K+2 )
- EXTRA = ZERO
- TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 )
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = SIN( ANGLE )
- CALL SLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S,
- $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA,
- $ EXTRA, TEMP )
- CALL SLAROT( .TRUE., .TRUE., .FALSE.,
- $ MIN( K, N-JC )+1, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, DUMMY )
-*
-* Chase EXTRA back up the matrix
-*
- ICOL = JC
- DO 240 JCH = JC - K, 1, -K
- CALL SLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG,
- $ ICOL+1 ), EXTRA, C, S, DUMMY )
- TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 )
- CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S,
- $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- IROW = MAX( 1, JCH-K )
- IL = MIN( JCH+1, K+2 )
- EXTRA = ZERO
- CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C,
- $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ),
- $ ILDA, EXTRA, TEMP )
- ICOL = JCH
- 240 CONTINUE
- 250 CONTINUE
- 260 CONTINUE
-*
-* If we need lower triangle, copy from upper. Note that
-* the order of copying is chosen to work for 'q' -> 'b'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN
- DO 280 JC = 1, N
- IROW = IOFFST - ISKEW*JC
- DO 270 JR = JC, MIN( N, JC+UUB )
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 270 CONTINUE
- 280 CONTINUE
- IF( IPACK.EQ.5 ) THEN
- DO 300 JC = N - UUB + 1, N
- DO 290 JR = N + 2 - JC, UUB + 1
- A( JR, JC ) = ZERO
- 290 CONTINUE
- 300 CONTINUE
- END IF
- IF( IPACKG.EQ.6 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- ELSE
-*
-* Bottom-Up -- Generate Lower triangle only
-*
- IF( IPACK.GE.5 ) THEN
- IPACKG = 5
- IF( IPACK.EQ.6 )
- $ IOFFG = 1
- ELSE
- IPACKG = 2
- END IF
- CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 )
-*
- DO 330 K = 1, UUB
- DO 320 JC = N - 1, 1, -1
- IL = MIN( N+1-JC, K+2 )
- EXTRA = ZERO
- TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC )
- ANGLE = TWOPI*SLARND( 1, ISEED )
- C = COS( ANGLE )
- S = -SIN( ANGLE )
- CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S,
- $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
- $ TEMP, EXTRA )
- ICOL = MAX( 1, JC-K+1 )
- CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C,
- $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, DUMMY, TEMP )
-*
-* Chase EXTRA back down the matrix
-*
- ICOL = JC
- DO 310 JCH = JC + K, N - 1, K
- CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ EXTRA, C, S, DUMMY )
- TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH )
- CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
- $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
- $ ILDA, EXTRA, TEMP )
- IL = MIN( N+1-JCH, K+2 )
- EXTRA = ZERO
- CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C,
- $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
- $ ILDA, TEMP, EXTRA )
- ICOL = JCH
- 310 CONTINUE
- 320 CONTINUE
- 330 CONTINUE
-*
-* If we need upper triangle, copy from lower. Note that
-* the order of copying is chosen to work for 'b' -> 'q'
-*
- IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN
- DO 350 JC = N, 1, -1
- IROW = IOFFST - ISKEW*JC
- DO 340 JR = JC, MAX( 1, JC-UUB ), -1
- A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
- 340 CONTINUE
- 350 CONTINUE
- IF( IPACK.EQ.6 ) THEN
- DO 370 JC = 1, UUB
- DO 360 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 360 CONTINUE
- 370 CONTINUE
- END IF
- IF( IPACKG.EQ.5 ) THEN
- IPACKG = IPACK
- ELSE
- IPACKG = 0
- END IF
- END IF
- END IF
- END IF
-*
- ELSE
-*
-* 4) Generate Banded Matrix by first
-* Rotating by random Unitary matrices,
-* then reducing the bandwidth using Householder
-* transformations.
-*
-* Note: we should get here only if LDA .ge. N
-*
- IF( ISYM.EQ.1 ) THEN
-*
-* Non-symmetric -- A = U D V
-*
- CALL SLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK,
- $ IINFO )
- ELSE
-*
-* Symmetric -- A = U D U'
-*
- CALL SLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
-*
- END IF
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- END IF
-*
-* 5) Pack the matrix
-*
- IF( IPACK.NE.IPACKG ) THEN
- IF( IPACK.EQ.1 ) THEN
-*
-* 'U' -- Upper triangular, not packed
-*
- DO 390 J = 1, M
- DO 380 I = J + 1, M
- A( I, J ) = ZERO
- 380 CONTINUE
- 390 CONTINUE
-*
- ELSE IF( IPACK.EQ.2 ) THEN
-*
-* 'L' -- Lower triangular, not packed
-*
- DO 410 J = 2, M
- DO 400 I = 1, J - 1
- A( I, J ) = ZERO
- 400 CONTINUE
- 410 CONTINUE
-*
- ELSE IF( IPACK.EQ.3 ) THEN
-*
-* 'C' -- Upper triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 430 J = 1, M
- DO 420 I = 1, J
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 420 CONTINUE
- 430 CONTINUE
-*
- ELSE IF( IPACK.EQ.4 ) THEN
-*
-* 'R' -- Lower triangle packed Columnwise.
-*
- ICOL = 1
- IROW = 0
- DO 450 J = 1, M
- DO 440 I = J, M
- IROW = IROW + 1
- IF( IROW.GT.LDA ) THEN
- IROW = 1
- ICOL = ICOL + 1
- END IF
- A( IROW, ICOL ) = A( I, J )
- 440 CONTINUE
- 450 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* 'B' -- The lower triangle is packed as a band matrix.
-* 'Q' -- The upper triangle is packed as a band matrix.
-* 'Z' -- The whole matrix is packed as a band matrix.
-*
- IF( IPACK.EQ.5 )
- $ UUB = 0
- IF( IPACK.EQ.6 )
- $ LLB = 0
-*
- DO 470 J = 1, UUB
- DO 460 I = MIN( J+LLB, M ), 1, -1
- A( I-J+UUB+1, J ) = A( I, J )
- 460 CONTINUE
- 470 CONTINUE
-*
- DO 490 J = UUB + 2, N
- DO 480 I = J - UUB, MIN( J+LLB, M )
- A( I-J+UUB+1, J ) = A( I, J )
- 480 CONTINUE
- 490 CONTINUE
- END IF
-*
-* If packed, zero out extraneous elements.
-*
-* Symmetric/Triangular Packed --
-* zero out everything after A(IROW,ICOL)
-*
- IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
- DO 510 JC = ICOL, M
- DO 500 JR = IROW + 1, LDA
- A( JR, JC ) = ZERO
- 500 CONTINUE
- IROW = 0
- 510 CONTINUE
-*
- ELSE IF( IPACK.GE.5 ) THEN
-*
-* Packed Band --
-* 1st row is now in A( UUB+2-j, j), zero above it
-* m-th row is now in A( M+UUB-j,j), zero below it
-* last non-zero diagonal is now in A( UUB+LLB+1,j ),
-* zero below it, too.
-*
- IR1 = UUB + LLB + 2
- IR2 = UUB + M + 2
- DO 540 JC = 1, N
- DO 520 JR = 1, UUB + 1 - JC
- A( JR, JC ) = ZERO
- 520 CONTINUE
- DO 530 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA
- A( JR, JC ) = ZERO
- 530 CONTINUE
- 540 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SLATMT
-*
- END
diff --git a/netlib/LAPACK/slatps.f b/netlib/LAPACK/slatps.f
deleted file mode 100644
index 4ce411f..0000000
--- a/netlib/LAPACK/slatps.f
+++ /dev/null
@@ -1,795 +0,0 @@
-*> \brief \b SLATPS solves a triangular system of equations with the matrix held in packed storage.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLATPS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatps.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatps.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatps.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE,
-* CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, N
-* REAL SCALE
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATPS solves one of the triangular systems
-*>
-*> A *x = s*b or A**T*x = s*b
-*>
-*> with scaling to prevent overflow, where A is an upper or lower
-*> triangular matrix stored in packed form. Here A**T denotes the
-*> transpose of A, x and b are n-element vectors, and s is a scaling
-*> factor, usually less than or equal to 1, chosen so that the
-*> components of x will be less than the overflow threshold. If the
-*> unscaled problem will not cause overflow, the Level 2 BLAS routine
-*> STPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
-*> then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is REAL array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, STPSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine STPSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call STPSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE,
- $ CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, N
- REAL SCALE
-* ..
-* .. Array Arguments ..
- REAL AP( * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, IP, J, JFIRST, JINC, JLAST, JLEN
- REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SASUM, SDOT, SLAMCH
- EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SSCAL, STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATPS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- IP = 1
- DO 10 J = 1, N
- CNORM( J ) = SASUM( J-1, AP( IP ), 1 )
- IP = IP + J
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- IP = 1
- DO 20 J = 1, N - 1
- CNORM( J ) = SASUM( N-J, AP( IP+1 ), 1 )
- IP = IP + N - J + 1
- 20 CONTINUE
- CNORM( N ) = ZERO
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = ISAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL SSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine STPSV can be used.
-*
- J = ISAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- IP = JFIRST*( JFIRST+1 ) / 2
- JLEN = N
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( AP( IP ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- IP = IP + JINC*JLEN
- JLEN = JLEN - 1
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- IP = JFIRST*( JFIRST+1 ) / 2
- JLEN = 1
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( AP( IP ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- JLEN = JLEN + 1
- IP = IP + JINC*JLEN
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL STPSV( UPLO, TRANS, DIAG, N, AP, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL SSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- IP = JFIRST*( JFIRST+1 ) / 2
- DO 100 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = AP( IP )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 95
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 95 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL SSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
- CALL SAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X,
- $ 1 )
- I = ISAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- IP = IP - J
- ELSE
- IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
- CALL SAXPY( N-J, -X( J )*TSCAL, AP( IP+1 ), 1,
- $ X( J+1 ), 1 )
- I = J + ISAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- IP = IP + N - J + 1
- END IF
- 100 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- IP = JFIRST*( JFIRST+1 ) / 2
- JLEN = 1
- DO 140 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = AP( IP )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call SDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- SUMJ = SDOT( J-1, AP( IP-J+1 ), 1, X, 1 )
- ELSE IF( J.LT.N ) THEN
- SUMJ = SDOT( N-J, AP( IP+1 ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- DO 110 I = 1, J - 1
- SUMJ = SUMJ + ( AP( IP-J+I )*USCAL )*X( I )
- 110 CONTINUE
- ELSE IF( J.LT.N ) THEN
- DO 120 I = 1, N - J
- SUMJ = SUMJ + ( AP( IP+I )*USCAL )*X( J+I )
- 120 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJS = AP( IP )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 135
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 130 I = 1, N
- X( I ) = ZERO
- 130 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 135 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- JLEN = JLEN + 1
- IP = IP + JINC*JLEN
- 140 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL SSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of SLATPS
-*
- END
diff --git a/netlib/LAPACK/slatrd.f b/netlib/LAPACK/slatrd.f
deleted file mode 100644
index 48bd4cf..0000000
--- a/netlib/LAPACK/slatrd.f
+++ /dev/null
@@ -1,336 +0,0 @@
-*> \brief \b SLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLATRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATRD reduces NB rows and columns of a real symmetric matrix A to
-*> symmetric tridiagonal form by an orthogonal similarity
-*> transformation Q**T * A * Q, and returns the matrices V and W which are
-*> needed to apply the transformation to the unreduced part of A.
-*>
-*> If UPLO = 'U', SLATRD reduces the last NB rows and columns of a
-*> matrix, of which the upper triangle is supplied;
-*> if UPLO = 'L', SLATRD reduces the first NB rows and columns of a
-*> matrix, of which the lower triangle is supplied.
-*>
-*> This is an auxiliary routine called by SSYTRD.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of rows and columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit:
-*> if UPLO = 'U', the last NB columns have been reduced to
-*> tridiagonal form, with the diagonal elements overwriting
-*> the diagonal elements of A; the elements above the diagonal
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors;
-*> if UPLO = 'L', the first NB columns have been reduced to
-*> tridiagonal form, with the diagonal elements overwriting
-*> the diagonal elements of A; the elements below the diagonal
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= (1,N).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
-*> elements of the last NB columns of the reduced matrix;
-*> if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
-*> the first NB columns of the reduced matrix.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> The scalar factors of the elementary reflectors, stored in
-*> TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (LDW,NB)
-*> The n-by-nb matrix W required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDW
-*> \verbatim
-*> LDW is INTEGER
-*> The leading dimension of the array W. LDW >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n) H(n-1) . . . H(n-nb+1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
-*> and tau in TAU(i-1).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
-*> and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the n-by-nb matrix V
-*> which is needed, with W, to apply the transformation to the unreduced
-*> part of the matrix, using a symmetric rank-2k update of the form:
-*> A := A - V*W**T - W*V**T.
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with n = 5 and nb = 2:
-*>
-*> if UPLO = 'U': if UPLO = 'L':
-*>
-*> ( a a a v4 v5 ) ( d )
-*> ( a a v4 v5 ) ( 1 d )
-*> ( a 1 v5 ) ( v1 1 a )
-*> ( d 1 ) ( v1 v2 a a )
-*> ( d ) ( v1 v2 a a a )
-*>
-*> where d denotes a diagonal element of the reduced matrix, a denotes
-*> an element of the original matrix that is unchanged, and vi denotes
-*> an element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, LDW, N, NB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, HALF
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, HALF = 0.5E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IW
- REAL ALPHA
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SGEMV, SLARFG, SSCAL, SSYMV
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Reduce last NB columns of upper triangle
-*
- DO 10 I = N, N - NB + 1, -1
- IW = I - N + NB
- IF( I.LT.N ) THEN
-*
-* Update A(1:i,i)
-*
- CALL SGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ),
- $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 )
- CALL SGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ),
- $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 )
- END IF
- IF( I.GT.1 ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(1:i-2,i)
-*
- CALL SLARFG( I-1, A( I-1, I ), A( 1, I ), 1, TAU( I-1 ) )
- E( I-1 ) = A( I-1, I )
- A( I-1, I ) = ONE
-*
-* Compute W(1:i-1,i)
-*
- CALL SSYMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1,
- $ ZERO, W( 1, IW ), 1 )
- IF( I.LT.N ) THEN
- CALL SGEMV( 'Transpose', I-1, N-I, ONE, W( 1, IW+1 ),
- $ LDW, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 )
- CALL SGEMV( 'No transpose', I-1, N-I, -ONE,
- $ A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE,
- $ W( 1, IW ), 1 )
- CALL SGEMV( 'Transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 )
- CALL SGEMV( 'No transpose', I-1, N-I, -ONE,
- $ W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE,
- $ W( 1, IW ), 1 )
- END IF
- CALL SSCAL( I-1, TAU( I-1 ), W( 1, IW ), 1 )
- ALPHA = -HALF*TAU( I-1 )*SDOT( I-1, W( 1, IW ), 1,
- $ A( 1, I ), 1 )
- CALL SAXPY( I-1, ALPHA, A( 1, I ), 1, W( 1, IW ), 1 )
- END IF
-*
- 10 CONTINUE
- ELSE
-*
-* Reduce first NB columns of lower triangle
-*
- DO 20 I = 1, NB
-*
-* Update A(i:n,i)
-*
- CALL SGEMV( 'No transpose', N-I+1, I-1, -ONE, A( I, 1 ),
- $ LDA, W( I, 1 ), LDW, ONE, A( I, I ), 1 )
- CALL SGEMV( 'No transpose', N-I+1, I-1, -ONE, W( I, 1 ),
- $ LDW, A( I, 1 ), LDA, ONE, A( I, I ), 1 )
- IF( I.LT.N ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(i+2:n,i)
-*
- CALL SLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAU( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Compute W(i+1:n,i)
-*
- CALL SSYMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA,
- $ A( I+1, I ), 1, ZERO, W( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), LDW,
- $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 )
- CALL SGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
- CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 )
- CALL SGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ),
- $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
- CALL SSCAL( N-I, TAU( I ), W( I+1, I ), 1 )
- ALPHA = -HALF*TAU( I )*SDOT( N-I, W( I+1, I ), 1,
- $ A( I+1, I ), 1 )
- CALL SAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 )
- END IF
-*
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SLATRD
-*
- END
diff --git a/netlib/LAPACK/slatrs.f b/netlib/LAPACK/slatrs.f
deleted file mode 100644
index b762a4b..0000000
--- a/netlib/LAPACK/slatrs.f
+++ /dev/null
@@ -1,787 +0,0 @@
-*> \brief \b SLATRS solves a triangular system of equations with the scale factor set to prevent overflow.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLATRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
-* CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, LDA, N
-* REAL SCALE
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATRS solves one of the triangular systems
-*>
-*> A *x = s*b or A**T*x = s*b
-*>
-*> with scaling to prevent overflow. Here A is an upper or lower
-*> triangular matrix, A**T denotes the transpose of A, x and b are
-*> n-element vectors, and s is a scaling factor, usually less than
-*> or equal to 1, chosen so that the components of x will be less than
-*> the overflow threshold. If the unscaled problem will not cause
-*> overflow, the Level 2 BLAS routine STRSV is called. If the matrix A
-*> is singular (A(j,j) = 0 for some j), then s is set to 0 and a
-*> non-trivial solution to A*x = 0 is returned.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading n by n
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading n by n lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max (1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is REAL array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, STRSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine STRSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call STRSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
- $ CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, LDA, N
- REAL SCALE
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, J, JFIRST, JINC, JLAST
- REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SASUM, SDOT, SLAMCH
- EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SSCAL, STRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLATRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- DO 10 J = 1, N
- CNORM( J ) = SASUM( J-1, A( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- DO 20 J = 1, N - 1
- CNORM( J ) = SASUM( N-J, A( J+1, J ), 1 )
- 20 CONTINUE
- CNORM( N ) = ZERO
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = ISAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL SSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine STRSV can be used.
-*
- J = ISAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( A( J, J ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( A( J, J ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL STRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL SSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- DO 100 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 95
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 95 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL SSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
- CALL SAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
- $ 1 )
- I = ISAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- ELSE
- IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
- CALL SAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
- $ X( J+1 ), 1 )
- I = J + ISAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- END IF
- 100 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- DO 140 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call SDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- SUMJ = SDOT( J-1, A( 1, J ), 1, X, 1 )
- ELSE IF( J.LT.N ) THEN
- SUMJ = SDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- DO 110 I = 1, J - 1
- SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
- 110 CONTINUE
- ELSE IF( J.LT.N ) THEN
- DO 120 I = J + 1, N
- SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
- 120 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 135
- END IF
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL SSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 130 I = 1, N
- X( I ) = ZERO
- 130 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 135 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- 140 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL SSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of SLATRS
-*
- END
diff --git a/netlib/LAPACK/slatrz.f b/netlib/LAPACK/slatrz.f
deleted file mode 100644
index 99cab45..0000000
--- a/netlib/LAPACK/slatrz.f
+++ /dev/null
@@ -1,200 +0,0 @@
-*> \brief \b SLATRZ factors an upper trapezoidal matrix by means of orthogonal transformations.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLATRZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatrz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatrz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatrz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATRZ( M, N, L, A, LDA, TAU, WORK )
-*
-* .. Scalar Arguments ..
-* INTEGER L, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
-*> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means
-*> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal
-*> matrix and, R and A1 are M-by-M upper triangular matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix A containing the
-*> meaningful part of the Householder vectors. N-M >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the leading M-by-N upper trapezoidal part of the
-*> array A must contain the matrix to be factorized.
-*> On exit, the leading M-by-M upper triangular part of A
-*> contains the upper triangular matrix R, and elements N-L+1 to
-*> N of the first M rows of A, with the array TAU, represent the
-*> orthogonal matrix Z as a product of M elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (M)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (M)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The factorization is obtained by Householder's method. The kth
-*> transformation matrix, Z( k ), which is used to introduce zeros into
-*> the ( m - k + 1 )th row of A, is given in the form
-*>
-*> Z( k ) = ( I 0 ),
-*> ( 0 T( k ) )
-*>
-*> where
-*>
-*> T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ),
-*> ( 0 )
-*> ( z( k ) )
-*>
-*> tau is a scalar and z( k ) is an l element vector. tau and z( k )
-*> are chosen to annihilate the elements of the kth row of A2.
-*>
-*> The scalar tau is returned in the kth element of TAU and the vector
-*> u( k ) in the kth row of A2, such that the elements of z( k ) are
-*> in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
-*> the upper triangular part of A1.
-*>
-*> Z is given by
-*>
-*> Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLATRZ( M, N, L, A, LDA, TAU, WORK )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER L, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFG, SLARZ
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
-* Quick return if possible
-*
- IF( M.EQ.0 ) THEN
- RETURN
- ELSE IF( M.EQ.N ) THEN
- DO 10 I = 1, N
- TAU( I ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- DO 20 I = M, 1, -1
-*
-* Generate elementary reflector H(i) to annihilate
-* [ A(i,i) A(i,n-l+1:n) ]
-*
- CALL SLARFG( L+1, A( I, I ), A( I, N-L+1 ), LDA, TAU( I ) )
-*
-* Apply H(i) to A(1:i-1,i:n) from the right
-*
- CALL SLARZ( 'Right', I-1, N-I+1, L, A( I, N-L+1 ), LDA,
- $ TAU( I ), A( 1, I ), LDA, WORK )
-*
- 20 CONTINUE
-*
- RETURN
-*
-* End of SLATRZ
-*
- END
diff --git a/netlib/LAPACK/slatzm.f b/netlib/LAPACK/slatzm.f
deleted file mode 100644
index f06bf66..0000000
--- a/netlib/LAPACK/slatzm.f
+++ /dev/null
@@ -1,221 +0,0 @@
-*> \brief \b SLATZM
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatzm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatzm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, LDC, M, N
-* REAL TAU
-* ..
-* .. Array Arguments ..
-* REAL C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine SORMRZ.
-*>
-*> SLATZM applies a Householder matrix generated by STZRQF to a matrix.
-*>
-*> Let P = I - tau*u*u**T, u = ( 1 ),
-*> ( v )
-*> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
-*> SIDE = 'R'.
-*>
-*> If SIDE equals 'L', let
-*> C = [ C1 ] 1
-*> [ C2 ] m-1
-*> n
-*> Then C is overwritten by P*C.
-*>
-*> If SIDE equals 'R', let
-*> C = [ C1, C2 ] m
-*> 1 n-1
-*> Then C is overwritten by C*P.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form P * C
-*> = 'R': form C * P
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension
-*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*> (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*> The vector v in the representation of P. V is not used
-*> if TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL
-*> The value tau in the representation of P.
-*> \endverbatim
-*>
-*> \param[in,out] C1
-*> \verbatim
-*> C1 is REAL array, dimension
-*> (LDC,N) if SIDE = 'L'
-*> (M,1) if SIDE = 'R'
-*> On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
-*> if SIDE = 'R'.
-*>
-*> On exit, the first row of P*C if SIDE = 'L', or the first
-*> column of C*P if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in,out] C2
-*> \verbatim
-*> C2 is REAL array, dimension
-*> (LDC, N) if SIDE = 'L'
-*> (LDC, N-1) if SIDE = 'R'
-*> On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
-*> m x (n - 1) matrix C2 if SIDE = 'R'.
-*>
-*> On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
-*> if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the arrays C1 and C2. LDC >= (1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L'
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, LDC, M, N
- REAL TAU
-* ..
-* .. Array Arguments ..
- REAL C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
- $ RETURN
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* w := (C1 + v**T * C2)**T
-*
- CALL SCOPY( N, C1, LDC, WORK, 1 )
- CALL SGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
- $ WORK, 1 )
-*
-* [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T
-* [ C2 ] [ C2 ] [ v ]
-*
- CALL SAXPY( N, -TAU, WORK, 1, C1, LDC )
- CALL SGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* 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 )
-*
-* [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
-*
- CALL SAXPY( M, -TAU, WORK, 1, C1, 1 )
- CALL SGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
- END IF
-*
- RETURN
-*
-* End of SLATZM
-*
- END
diff --git a/netlib/LAPACK/slauu2.f b/netlib/LAPACK/slauu2.f
deleted file mode 100644
index e00eb29..0000000
--- a/netlib/LAPACK/slauu2.f
+++ /dev/null
@@ -1,198 +0,0 @@
-*> \brief \b SLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAUU2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slauu2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slauu2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slauu2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAUU2( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAUU2 computes the product U * U**T or L**T * L, where the triangular
-*> factor U or L is stored in the upper or lower triangular part of
-*> the array A.
-*>
-*> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
-*> overwriting the factor U in A.
-*> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
-*> overwriting the factor L in A.
-*>
-*> This is the unblocked form of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the triangular factor stored in the array A
-*> is upper or lower triangular:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the triangular factor U or L. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the triangular factor U or L.
-*> On exit, if UPLO = 'U', the upper triangle of A is
-*> overwritten with the upper triangle of the product U * U**T;
-*> if UPLO = 'L', the lower triangle of A is overwritten with
-*> the lower triangle of the product L**T * L.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAUU2( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
- REAL AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAUU2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the product U * U**T.
-*
- DO 10 I = 1, N
- AII = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = SDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA )
- CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 )
- ELSE
- CALL SSCAL( I, AII, A( 1, I ), 1 )
- END IF
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the product L**T * L.
-*
- DO 20 I = 1, N
- AII = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = SDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 )
- CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, AII, A( I, 1 ), LDA )
- ELSE
- CALL SSCAL( I, AII, A( I, 1 ), LDA )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SLAUU2
-*
- END
diff --git a/netlib/LAPACK/slauum.f b/netlib/LAPACK/slauum.f
deleted file mode 100644
index 0915e28..0000000
--- a/netlib/LAPACK/slauum.f
+++ /dev/null
@@ -1,218 +0,0 @@
-*> \brief \b SLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLAUUM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slauum.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slauum.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slauum.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLAUUM( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SLAUUM computes the product U * U**T or L**T * L, where the triangular
-*> factor U or L is stored in the upper or lower triangular part of
-*> the array A.
-*>
-*> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
-*> overwriting the factor U in A.
-*> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
-*> overwriting the factor L in A.
-*>
-*> This is the blocked form of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the triangular factor stored in the array A
-*> is upper or lower triangular:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the triangular factor U or L. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the triangular factor U or L.
-*> On exit, if UPLO = 'U', the upper triangle of A is
-*> overwritten with the upper triangle of the product U * U**T;
-*> if UPLO = 'L', the lower triangle of A is overwritten with
-*> the lower triangle of the product L**T * L.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SLAUUM( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLAUU2, SSYRK, STRMM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SLAUUM', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SLAUUM', UPLO, N, -1, -1, -1 )
-*
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL SLAUU2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( UPPER ) THEN
-*
-* Compute the product U * U**T.
-*
- DO 10 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
- CALL STRMM( 'Right', 'Upper', 'Transpose', 'Non-unit',
- $ I-1, IB, ONE, A( I, I ), LDA, A( 1, I ),
- $ LDA )
- CALL SLAUU2( 'Upper', IB, A( I, I ), LDA, INFO )
- IF( I+IB.LE.N ) THEN
- CALL SGEMM( 'No transpose', 'Transpose', I-1, IB,
- $ N-I-IB+1, ONE, A( 1, I+IB ), LDA,
- $ A( I, I+IB ), LDA, ONE, A( 1, I ), LDA )
- CALL SSYRK( 'Upper', 'No transpose', IB, N-I-IB+1,
- $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ),
- $ LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute the product L**T * L.
-*
- DO 20 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
- CALL STRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB,
- $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA )
- CALL SLAUU2( 'Lower', IB, A( I, I ), LDA, INFO )
- IF( I+IB.LE.N ) THEN
- CALL SGEMM( 'Transpose', 'No transpose', IB, I-1,
- $ N-I-IB+1, ONE, A( I+IB, I ), LDA,
- $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA )
- CALL SSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE,
- $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA )
- END IF
- 20 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SLAUUM
-*
- END
diff --git a/netlib/LAPACK/sopgtr.f b/netlib/LAPACK/sopgtr.f
deleted file mode 100644
index c047512..0000000
--- a/netlib/LAPACK/sopgtr.f
+++ /dev/null
@@ -1,232 +0,0 @@
-*> \brief \b SOPGTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SOPGTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sopgtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sopgtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sopgtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SOPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDQ, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SOPGTR generates a real orthogonal matrix Q which is defined as the
-*> product of n-1 elementary reflectors H(i) of order n, as returned by
-*> SSPTRD using packed storage:
-*>
-*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular packed storage used in previous
-*> call to SSPTRD;
-*> = 'L': Lower triangular packed storage used in previous
-*> call to SSPTRD.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The vectors which define the elementary reflectors, as
-*> returned by SSPTRD.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SSPTRD.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> The N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N-1)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SOPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDQ, N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IINFO, IJ, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SORG2L, SORG2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SOPGTR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to SSPTRD with UPLO = 'U'
-*
-* Unpack the vectors which define the elementary reflectors and
-* set the last row and column of Q equal to those of the unit
-* matrix
-*
- IJ = 2
- DO 20 J = 1, N - 1
- DO 10 I = 1, J - 1
- Q( I, J ) = AP( IJ )
- IJ = IJ + 1
- 10 CONTINUE
- IJ = IJ + 2
- Q( N, J ) = ZERO
- 20 CONTINUE
- DO 30 I = 1, N - 1
- Q( I, N ) = ZERO
- 30 CONTINUE
- Q( N, N ) = ONE
-*
-* Generate Q(1:n-1,1:n-1)
-*
- CALL SORG2L( N-1, N-1, N-1, Q, LDQ, TAU, WORK, IINFO )
-*
- ELSE
-*
-* Q was determined by a call to SSPTRD with UPLO = 'L'.
-*
-* Unpack the vectors which define the elementary reflectors and
-* set the first row and column of Q equal to those of the unit
-* matrix
-*
- Q( 1, 1 ) = ONE
- DO 40 I = 2, N
- Q( I, 1 ) = ZERO
- 40 CONTINUE
- IJ = 3
- DO 60 J = 2, N
- Q( 1, J ) = ZERO
- DO 50 I = J + 1, N
- Q( I, J ) = AP( IJ )
- IJ = IJ + 1
- 50 CONTINUE
- IJ = IJ + 2
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Generate Q(2:n,2:n)
-*
- CALL SORG2R( N-1, N-1, N-1, Q( 2, 2 ), LDQ, TAU, WORK,
- $ IINFO )
- END IF
- END IF
- RETURN
-*
-* End of SOPGTR
-*
- END
diff --git a/netlib/LAPACK/sopmtr.f b/netlib/LAPACK/sopmtr.f
deleted file mode 100644
index ae2e758..0000000
--- a/netlib/LAPACK/sopmtr.f
+++ /dev/null
@@ -1,339 +0,0 @@
-*> \brief \b SOPMTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SOPMTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sopmtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sopmtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sopmtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, UPLO
-* INTEGER INFO, LDC, M, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SOPMTR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix of order nq, with nq = m if
-*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*> nq-1 elementary reflectors, as returned by SSPTRD using packed
-*> storage:
-*>
-*> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular packed storage used in previous
-*> call to SSPTRD;
-*> = 'L': Lower triangular packed storage used in previous
-*> call to SSPTRD.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension
-*> (M*(M+1)/2) if SIDE = 'L'
-*> (N*(N+1)/2) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by SSPTRD. AP is modified by the routine but
-*> restored on exit.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (M-1) if SIDE = 'L'
-*> or (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SSPTRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L'
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, UPLO
- INTEGER INFO, LDC, M, N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL FORWRD, LEFT, NOTRAN, UPPER
- INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ
- REAL AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- UPPER = LSAME( UPLO, 'U' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SOPMTR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to SSPTRD with UPLO = 'U'
-*
- FORWRD = ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN )
-*
- IF( FORWRD ) THEN
- I1 = 1
- I2 = NQ - 1
- I3 = 1
- II = 2
- ELSE
- I1 = NQ - 1
- I2 = 1
- I3 = -1
- II = NQ*( NQ+1 ) / 2 - 1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(1:i,1:n)
-*
- MI = I
- ELSE
-*
-* H(i) is applied to C(1:m,1:i)
-*
- NI = I
- END IF
-*
-* Apply H(i)
-*
- AII = AP( II )
- AP( II ) = ONE
- CALL SLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, LDC,
- $ WORK )
- AP( II ) = AII
-*
- IF( FORWRD ) THEN
- II = II + I + 2
- ELSE
- II = II - I - 1
- END IF
- 10 CONTINUE
- ELSE
-*
-* Q was determined by a call to SSPTRD with UPLO = 'L'.
-*
- FORWRD = ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN )
-*
- IF( FORWRD ) THEN
- I1 = 1
- I2 = NQ - 1
- I3 = 1
- II = 2
- ELSE
- I1 = NQ - 1
- I2 = 1
- I3 = -1
- II = NQ*( NQ+1 ) / 2 - 1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 20 I = I1, I2, I3
- AII = AP( II )
- AP( II ) = ONE
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i+1:m,1:n)
-*
- MI = M - I
- IC = I + 1
- ELSE
-*
-* H(i) is applied to C(1:m,i+1:n)
-*
- NI = N - I
- JC = I + 1
- END IF
-*
-* Apply H(i)
-*
- CALL SLARF( SIDE, MI, NI, AP( II ), 1, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
- AP( II ) = AII
-*
- IF( FORWRD ) THEN
- II = II + NQ - I + 1
- ELSE
- II = II - NQ + I - 2
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of SOPMTR
-*
- END
diff --git a/netlib/LAPACK/sorbdb.f b/netlib/LAPACK/sorbdb.f
deleted file mode 100644
index 433b3c0..0000000
--- a/netlib/LAPACK/sorbdb.f
+++ /dev/null
@@ -1,607 +0,0 @@
-*> \brief \b SORBDB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORBDB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorbdb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorbdb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorbdb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
-* X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,
-* TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIGNS, TRANS
-* INTEGER INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P,
-* $ Q
-* ..
-* .. Array Arguments ..
-* REAL PHI( * ), THETA( * )
-* REAL TAUP1( * ), TAUP2( * ), TAUQ1( * ), TAUQ2( * ),
-* $ WORK( * ), X11( LDX11, * ), X12( LDX12, * ),
-* $ X21( LDX21, * ), X22( LDX22, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORBDB simultaneously bidiagonalizes the blocks of an M-by-M
-*> partitioned orthogonal matrix X:
-*>
-*> [ B11 | B12 0 0 ]
-*> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T
-*> X = [-----------] = [---------] [----------------] [---------] .
-*> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ]
-*> [ 0 | 0 0 I ]
-*>
-*> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is
-*> not the case, then X must be transposed and/or permuted. This can be
-*> done in constant time using the TRANS and SIGNS options. See SORCSD
-*> for details.)
-*>
-*> The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by-
-*> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are
-*> represented implicitly by Householder vectors.
-*>
-*> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented
-*> implicitly by angles THETA, PHI.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER
-*> = 'T': X, U1, U2, V1T, and V2T are stored in row-major
-*> order;
-*> otherwise: X, U1, U2, V1T, and V2T are stored in column-
-*> major order.
-*> \endverbatim
-*>
-*> \param[in] SIGNS
-*> \verbatim
-*> SIGNS is CHARACTER
-*> = 'O': The lower-left block is made nonpositive (the
-*> "other" convention);
-*> otherwise: The upper-right block is made nonpositive (the
-*> "default" convention).
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows and columns in X.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows in X11 and X12. 0 <= P <= M.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is INTEGER
-*> The number of columns in X11 and X21. 0 <= Q <=
-*> MIN(P,M-P,M-Q).
-*> \endverbatim
-*>
-*> \param[in,out] X11
-*> \verbatim
-*> X11 is REAL array, dimension (LDX11,Q)
-*> On entry, the top-left block of the orthogonal matrix to be
-*> reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the columns of tril(X11) specify reflectors for P1,
-*> the rows of triu(X11,1) specify reflectors for Q1;
-*> else TRANS = 'T', and
-*> the rows of triu(X11) specify reflectors for P1,
-*> the columns of tril(X11,-1) specify reflectors for Q1.
-*> \endverbatim
-*>
-*> \param[in] LDX11
-*> \verbatim
-*> LDX11 is INTEGER
-*> The leading dimension of X11. If TRANS = 'N', then LDX11 >=
-*> P; else LDX11 >= Q.
-*> \endverbatim
-*>
-*> \param[in,out] X12
-*> \verbatim
-*> X12 is REAL array, dimension (LDX12,M-Q)
-*> On entry, the top-right block of the orthogonal matrix to
-*> be reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the rows of triu(X12) specify the first P reflectors for
-*> Q2;
-*> else TRANS = 'T', and
-*> the columns of tril(X12) specify the first P reflectors
-*> for Q2.
-*> \endverbatim
-*>
-*> \param[in] LDX12
-*> \verbatim
-*> LDX12 is INTEGER
-*> The leading dimension of X12. If TRANS = 'N', then LDX12 >=
-*> P; else LDX11 >= M-Q.
-*> \endverbatim
-*>
-*> \param[in,out] X21
-*> \verbatim
-*> X21 is REAL array, dimension (LDX21,Q)
-*> On entry, the bottom-left block of the orthogonal matrix to
-*> be reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the columns of tril(X21) specify reflectors for P2;
-*> else TRANS = 'T', and
-*> the rows of triu(X21) specify reflectors for P2.
-*> \endverbatim
-*>
-*> \param[in] LDX21
-*> \verbatim
-*> LDX21 is INTEGER
-*> The leading dimension of X21. If TRANS = 'N', then LDX21 >=
-*> M-P; else LDX21 >= Q.
-*> \endverbatim
-*>
-*> \param[in,out] X22
-*> \verbatim
-*> X22 is REAL array, dimension (LDX22,M-Q)
-*> On entry, the bottom-right block of the orthogonal matrix to
-*> be reduced. On exit, the form depends on TRANS:
-*> If TRANS = 'N', then
-*> the rows of triu(X22(Q+1:M-P,P+1:M-Q)) specify the last
-*> M-P-Q reflectors for Q2,
-*> else TRANS = 'T', and
-*> the columns of tril(X22(P+1:M-Q,Q+1:M-P)) specify the last
-*> M-P-Q reflectors for P2.
-*> \endverbatim
-*>
-*> \param[in] LDX22
-*> \verbatim
-*> LDX22 is INTEGER
-*> The leading dimension of X22. If TRANS = 'N', then LDX22 >=
-*> M-P; else LDX22 >= M-Q.
-*> \endverbatim
-*>
-*> \param[out] THETA
-*> \verbatim
-*> THETA is REAL array, dimension (Q)
-*> The entries of the bidiagonal blocks B11, B12, B21, B22 can
-*> be computed from the angles THETA and PHI. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] PHI
-*> \verbatim
-*> PHI is REAL array, dimension (Q-1)
-*> The entries of the bidiagonal blocks B11, B12, B21, B22 can
-*> be computed from the angles THETA and PHI. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP1
-*> \verbatim
-*> TAUP1 is REAL array, dimension (P)
-*> The scalar factors of the elementary reflectors that define
-*> P1.
-*> \endverbatim
-*>
-*> \param[out] TAUP2
-*> \verbatim
-*> TAUP2 is REAL array, dimension (M-P)
-*> The scalar factors of the elementary reflectors that define
-*> P2.
-*> \endverbatim
-*>
-*> \param[out] TAUQ1
-*> \verbatim
-*> TAUQ1 is REAL array, dimension (Q)
-*> The scalar factors of the elementary reflectors that define
-*> Q1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ2
-*> \verbatim
-*> TAUQ2 is REAL array, dimension (M-Q)
-*> The scalar factors of the elementary reflectors that define
-*> Q2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LWORK)
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= M-Q.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The bidiagonal blocks B11, B12, B21, and B22 are represented
-*> implicitly by angles THETA(1), ..., THETA(Q) and PHI(1), ...,
-*> PHI(Q-1). B11 and B21 are upper bidiagonal, while B21 and B22 are
-*> lower bidiagonal. Every entry in each bidiagonal band is a product
-*> of a sine or cosine of a THETA with a sine or cosine of a PHI. See
-*> [1] or SORCSD for details.
-*>
-*> P1, P2, Q1, and Q2 are represented as products of elementary
-*> reflectors. See SORCSD for details on generating P1, P2, Q1, and Q2
-*> using SORGQR and SORGLQ.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
-*> Algorithms, 50(1):33-65, 2009.
-*>
-* =====================================================================
- SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
- $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,
- $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIGNS, TRANS
- INTEGER INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P,
- $ Q
-* ..
-* .. Array Arguments ..
- REAL PHI( * ), THETA( * )
- REAL TAUP1( * ), TAUP2( * ), TAUQ1( * ), TAUQ2( * ),
- $ WORK( * ), X11( LDX11, * ), X12( LDX12, * ),
- $ X21( LDX21, * ), X22( LDX22, * )
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- REAL REALONE
- PARAMETER ( REALONE = 1.0E0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLMAJOR, LQUERY
- INTEGER I, LWORKMIN, LWORKOPT
- REAL Z1, Z2, Z3, Z4
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SLARF, SLARFGP, SSCAL, XERBLA
-* ..
-* .. External Functions ..
- REAL SNRM2
- LOGICAL LSAME
- EXTERNAL SNRM2, LSAME
-* ..
-* .. Intrinsic Functions
- INTRINSIC ATAN2, COS, MAX, SIN
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-*
- INFO = 0
- COLMAJOR = .NOT. LSAME( TRANS, 'T' )
- IF( .NOT. LSAME( SIGNS, 'O' ) ) THEN
- Z1 = REALONE
- Z2 = REALONE
- Z3 = REALONE
- Z4 = REALONE
- ELSE
- Z1 = REALONE
- Z2 = -REALONE
- Z3 = REALONE
- Z4 = -REALONE
- END IF
- LQUERY = LWORK .EQ. -1
-*
- IF( M .LT. 0 ) THEN
- INFO = -3
- ELSE IF( P .LT. 0 .OR. P .GT. M ) THEN
- INFO = -4
- ELSE IF( Q .LT. 0 .OR. Q .GT. P .OR. Q .GT. M-P .OR.
- $ Q .GT. M-Q ) THEN
- INFO = -5
- ELSE IF( COLMAJOR .AND. LDX11 .LT. MAX( 1, P ) ) THEN
- INFO = -7
- ELSE IF( .NOT.COLMAJOR .AND. LDX11 .LT. MAX( 1, Q ) ) THEN
- INFO = -7
- ELSE IF( COLMAJOR .AND. LDX12 .LT. MAX( 1, P ) ) THEN
- INFO = -9
- ELSE IF( .NOT.COLMAJOR .AND. LDX12 .LT. MAX( 1, M-Q ) ) THEN
- INFO = -9
- ELSE IF( COLMAJOR .AND. LDX21 .LT. MAX( 1, M-P ) ) THEN
- INFO = -11
- ELSE IF( .NOT.COLMAJOR .AND. LDX21 .LT. MAX( 1, Q ) ) THEN
- INFO = -11
- ELSE IF( COLMAJOR .AND. LDX22 .LT. MAX( 1, M-P ) ) THEN
- INFO = -13
- ELSE IF( .NOT.COLMAJOR .AND. LDX22 .LT. MAX( 1, M-Q ) ) THEN
- INFO = -13
- END IF
-*
-* Compute workspace
-*
- IF( INFO .EQ. 0 ) THEN
- LWORKOPT = M - Q
- LWORKMIN = M - Q
- WORK(1) = LWORKOPT
- IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN
- INFO = -21
- END IF
- END IF
- IF( INFO .NE. 0 ) THEN
- CALL XERBLA( 'xORBDB', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Handle column-major and row-major separately
-*
- IF( COLMAJOR ) THEN
-*
-* Reduce columns 1, ..., Q of X11, X12, X21, and X22
-*
- DO I = 1, Q
-*
- IF( I .EQ. 1 ) THEN
- CALL SSCAL( P-I+1, Z1, X11(I,I), 1 )
- ELSE
- CALL SSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), 1 )
- CALL SAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I,I-1),
- $ 1, X11(I,I), 1 )
- END IF
- IF( I .EQ. 1 ) THEN
- CALL SSCAL( M-P-I+1, Z2, X21(I,I), 1 )
- ELSE
- CALL SSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), 1 )
- CALL SAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I,I-1),
- $ 1, X21(I,I), 1 )
- END IF
-*
- THETA(I) = ATAN2( SNRM2( M-P-I+1, X21(I,I), 1 ),
- $ SNRM2( P-I+1, X11(I,I), 1 ) )
-*
- CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
- X11(I,I) = ONE
- CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
- X21(I,I) = ONE
-*
- CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
- $ X11(I,I+1), LDX11, WORK )
- CALL SLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I),
- $ X12(I,I), LDX12, WORK )
- CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
- $ X21(I,I+1), LDX21, WORK )
- CALL SLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I),
- $ X22(I,I), LDX22, WORK )
-*
- IF( I .LT. Q ) THEN
- CALL SSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1),
- $ LDX11 )
- CALL SAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I,I+1), LDX21,
- $ X11(I,I+1), LDX11 )
- END IF
- CALL SSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), LDX12 )
- CALL SAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), LDX22,
- $ X12(I,I), LDX12 )
-*
- IF( I .LT. Q )
- $ PHI(I) = ATAN2( SNRM2( Q-I, X11(I,I+1), LDX11 ),
- $ SNRM2( M-Q-I+1, X12(I,I), LDX12 ) )
-*
- IF( I .LT. Q ) THEN
- CALL SLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11,
- $ TAUQ1(I) )
- X11(I,I+1) = ONE
- END IF
- CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,
- $ TAUQ2(I) )
- X12(I,I) = ONE
-*
- IF( I .LT. Q ) THEN
- CALL SLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I),
- $ X11(I+1,I+1), LDX11, WORK )
- CALL SLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I),
- $ X21(I+1,I+1), LDX21, WORK )
- END IF
- CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
- $ X12(I+1,I), LDX12, WORK )
- CALL SLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
- $ X22(I+1,I), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns Q + 1, ..., P of X12, X22
-*
- DO I = Q + 1, P
-*
- CALL SSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), LDX12 )
- CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,
- $ TAUQ2(I) )
- X12(I,I) = ONE
-*
- CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
- $ X12(I+1,I), LDX12, WORK )
- IF( M-P-Q .GE. 1 )
- $ CALL SLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12,
- $ TAUQ2(I), X22(Q+1,I), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns P + 1, ..., M - Q of X12, X22
-*
- DO I = 1, M - P - Q
-*
- CALL SSCAL( M-P-Q-I+1, Z2*Z4, X22(Q+I,P+I), LDX22 )
- CALL SLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1),
- $ LDX22, TAUQ2(P+I) )
- X22(Q+I,P+I) = ONE
- CALL SLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22,
- $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK )
-*
- END DO
-*
- ELSE
-*
-* Reduce columns 1, ..., Q of X11, X12, X21, X22
-*
- DO I = 1, Q
-*
- IF( I .EQ. 1 ) THEN
- CALL SSCAL( P-I+1, Z1, X11(I,I), LDX11 )
- ELSE
- CALL SSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), LDX11 )
- CALL SAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I-1,I),
- $ LDX12, X11(I,I), LDX11 )
- END IF
- IF( I .EQ. 1 ) THEN
- CALL SSCAL( M-P-I+1, Z2, X21(I,I), LDX21 )
- ELSE
- CALL SSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), LDX21 )
- CALL SAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I-1,I),
- $ LDX22, X21(I,I), LDX21 )
- END IF
-*
- THETA(I) = ATAN2( SNRM2( M-P-I+1, X21(I,I), LDX21 ),
- $ SNRM2( P-I+1, X11(I,I), LDX11 ) )
-*
- CALL SLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) )
- X11(I,I) = ONE
- CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21,
- $ TAUP2(I) )
- X21(I,I) = ONE
-*
- CALL SLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I),
- $ X11(I+1,I), LDX11, WORK )
- CALL SLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, TAUP1(I),
- $ X12(I,I), LDX12, WORK )
- CALL SLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I),
- $ X21(I+1,I), LDX21, WORK )
- CALL SLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21,
- $ TAUP2(I), X22(I,I), LDX22, WORK )
-*
- IF( I .LT. Q ) THEN
- CALL SSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I+1,I), 1 )
- CALL SAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I+1,I), 1,
- $ X11(I+1,I), 1 )
- END IF
- CALL SSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), 1 )
- CALL SAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), 1,
- $ X12(I,I), 1 )
-*
- IF( I .LT. Q )
- $ PHI(I) = ATAN2( SNRM2( Q-I, X11(I+1,I), 1 ),
- $ SNRM2( M-Q-I+1, X12(I,I), 1 ) )
-*
- IF( I .LT. Q ) THEN
- CALL SLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, TAUQ1(I) )
- X11(I+1,I) = ONE
- END IF
- CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )
- X12(I,I) = ONE
-*
- IF( I .LT. Q ) THEN
- CALL SLARF( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I),
- $ X11(I+1,I+1), LDX11, WORK )
- CALL SLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I),
- $ X21(I+1,I+1), LDX21, WORK )
- END IF
- CALL SLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
- $ X12(I,I+1), LDX12, WORK )
- CALL SLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I),
- $ X22(I,I+1), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns Q + 1, ..., P of X12, X22
-*
- DO I = Q + 1, P
-*
- CALL SSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), 1 )
- CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )
- X12(I,I) = ONE
-*
- CALL SLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
- $ X12(I,I+1), LDX12, WORK )
- IF( M-P-Q .GE. 1 )
- $ CALL SLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I),
- $ X22(I,Q+1), LDX22, WORK )
-*
- END DO
-*
-* Reduce columns P + 1, ..., M - Q of X12, X22
-*
- DO I = 1, M - P - Q
-*
- CALL SSCAL( M-P-Q-I+1, Z2*Z4, X22(P+I,Q+I), 1 )
- CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1,
- $ TAUQ2(P+I) )
- X22(P+I,Q+I) = ONE
-*
- CALL SLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1,
- $ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK )
-*
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of SORBDB
-*
- END
-
diff --git a/netlib/LAPACK/sorcsd.f b/netlib/LAPACK/sorcsd.f
deleted file mode 100644
index f9a47d6..0000000
--- a/netlib/LAPACK/sorcsd.f
+++ /dev/null
@@ -1,602 +0,0 @@
-*> \brief \b SORCSD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORCSD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorcsd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorcsd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorcsd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS,
-* SIGNS, M, P, Q, X11, LDX11, X12,
-* LDX12, X21, LDX21, X22, LDX22, THETA,
-* U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
-* LDV2T, WORK, LWORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
-* INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LDX11, LDX12,
-* $ LDX21, LDX22, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL THETA( * )
-* REAL U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
-* $ V2T( LDV2T, * ), WORK( * ), X11( LDX11, * ),
-* $ X12( LDX12, * ), X21( LDX21, * ), X22( LDX22,
-* $ * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORCSD computes the CS decomposition of an M-by-M partitioned
-*> orthogonal matrix X:
-*>
-*> [ I 0 0 | 0 0 0 ]
-*> [ 0 C 0 | 0 -S 0 ]
-*> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T
-*> X = [-----------] = [---------] [---------------------] [---------] .
-*> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ]
-*> [ 0 S 0 | 0 C 0 ]
-*> [ 0 0 I | 0 0 0 ]
-*>
-*> X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P,
-*> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are
-*> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in
-*> which R = MIN(P,M-P,Q,M-Q).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU1
-*> \verbatim
-*> JOBU1 is CHARACTER
-*> = 'Y': U1 is computed;
-*> otherwise: U1 is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBU2
-*> \verbatim
-*> JOBU2 is CHARACTER
-*> = 'Y': U2 is computed;
-*> otherwise: U2 is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV1T
-*> \verbatim
-*> JOBV1T is CHARACTER
-*> = 'Y': V1T is computed;
-*> otherwise: V1T is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV2T
-*> \verbatim
-*> JOBV2T is CHARACTER
-*> = 'Y': V2T is computed;
-*> otherwise: V2T is not computed.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER
-*> = 'T': X, U1, U2, V1T, and V2T are stored in row-major
-*> order;
-*> otherwise: X, U1, U2, V1T, and V2T are stored in column-
-*> major order.
-*> \endverbatim
-*>
-*> \param[in] SIGNS
-*> \verbatim
-*> SIGNS is CHARACTER
-*> = 'O': The lower-left block is made nonpositive (the
-*> "other" convention);
-*> otherwise: The upper-right block is made nonpositive (the
-*> "default" convention).
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows and columns in X.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows in X11 and X12. 0 <= P <= M.
-*> \endverbatim
-*>
-*> \param[in] Q
-*> \verbatim
-*> Q is INTEGER
-*> The number of columns in X11 and X21. 0 <= Q <= M.
-*> \endverbatim
-*>
-*> \param[in,out] X11
-*> \verbatim
-*> X11 is REAL array, dimension (LDX11,Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX11
-*> \verbatim
-*> LDX11 is INTEGER
-*> The leading dimension of X11. LDX11 >= MAX(1,P).
-*> \endverbatim
-*>
-*> \param[in,out] X12
-*> \verbatim
-*> X12 is REAL array, dimension (LDX12,M-Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX12
-*> \verbatim
-*> LDX12 is INTEGER
-*> The leading dimension of X12. LDX12 >= MAX(1,P).
-*> \endverbatim
-*>
-*> \param[in,out] X21
-*> \verbatim
-*> X21 is REAL array, dimension (LDX21,Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX21
-*> \verbatim
-*> LDX21 is INTEGER
-*> The leading dimension of X11. LDX21 >= MAX(1,M-P).
-*> \endverbatim
-*>
-*> \param[in,out] X22
-*> \verbatim
-*> X22 is REAL array, dimension (LDX22,M-Q)
-*> On entry, part of the orthogonal matrix whose CSD is desired.
-*> \endverbatim
-*>
-*> \param[in] LDX22
-*> \verbatim
-*> LDX22 is INTEGER
-*> The leading dimension of X11. LDX22 >= MAX(1,M-P).
-*> \endverbatim
-*>
-*> \param[out] THETA
-*> \verbatim
-*> THETA is REAL array, dimension (R), in which R =
-*> MIN(P,M-P,Q,M-Q).
-*> C = DIAG( COS(THETA(1)), ... , COS(THETA(R)) ) and
-*> S = DIAG( SIN(THETA(1)), ... , SIN(THETA(R)) ).
-*> \endverbatim
-*>
-*> \param[out] U1
-*> \verbatim
-*> U1 is REAL array, dimension (P)
-*> If JOBU1 = 'Y', U1 contains the P-by-P orthogonal matrix U1.
-*> \endverbatim
-*>
-*> \param[in] LDU1
-*> \verbatim
-*> LDU1 is INTEGER
-*> The leading dimension of U1. If JOBU1 = 'Y', LDU1 >=
-*> MAX(1,P).
-*> \endverbatim
-*>
-*> \param[out] U2
-*> \verbatim
-*> U2 is REAL array, dimension (M-P)
-*> If JOBU2 = 'Y', U2 contains the (M-P)-by-(M-P) orthogonal
-*> matrix U2.
-*> \endverbatim
-*>
-*> \param[in] LDU2
-*> \verbatim
-*> LDU2 is INTEGER
-*> The leading dimension of U2. If JOBU2 = 'Y', LDU2 >=
-*> MAX(1,M-P).
-*> \endverbatim
-*>
-*> \param[out] V1T
-*> \verbatim
-*> V1T is REAL array, dimension (Q)
-*> If JOBV1T = 'Y', V1T contains the Q-by-Q matrix orthogonal
-*> matrix V1**T.
-*> \endverbatim
-*>
-*> \param[in] LDV1T
-*> \verbatim
-*> LDV1T is INTEGER
-*> The leading dimension of V1T. If JOBV1T = 'Y', LDV1T >=
-*> MAX(1,Q).
-*> \endverbatim
-*>
-*> \param[out] V2T
-*> \verbatim
-*> V2T is REAL array, dimension (M-Q)
-*> If JOBV2T = 'Y', V2T contains the (M-Q)-by-(M-Q) orthogonal
-*> matrix V2**T.
-*> \endverbatim
-*>
-*> \param[in] LDV2T
-*> \verbatim
-*> LDV2T is INTEGER
-*> The leading dimension of V2T. If JOBV2T = 'Y', LDV2T >=
-*> MAX(1,M-Q).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> If INFO > 0 on exit, WORK(2:R) contains the values PHI(1),
-*> ..., PHI(R-1) that, together with THETA(1), ..., THETA(R),
-*> define the matrix in intermediate bidiagonal-block form
-*> remaining after nonconvergence. INFO specifies the number
-*> of nonzero PHI's.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the work array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (M-MIN(P, M-P, Q, M-Q))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: SBBCSD did not converge. See the description of WORK
-*> above for details.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
-*> Algorithms, 50(1):33-65, 2009.
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS,
- $ SIGNS, M, P, Q, X11, LDX11, X12,
- $ LDX12, X21, LDX21, X22, LDX22, THETA,
- $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
- $ LDV2T, WORK, LWORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
- INTEGER INFO, LDU1, LDU2, LDV1T, LDV2T, LDX11, LDX12,
- $ LDX21, LDX22, LWORK, M, P, Q
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL THETA( * )
- REAL U1( LDU1, * ), U2( LDU2, * ), V1T( LDV1T, * ),
- $ V2T( LDV2T, * ), WORK( * ), X11( LDX11, * ),
- $ X12( LDX12, * ), X21( LDX21, * ), X22( LDX22,
- $ * )
-* ..
-*
-* ===================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0,
- $ ZERO = 0.0E+0 )
-* ..
-* .. Local Arrays ..
- REAL DUMMY(1)
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST, SIGNST
- INTEGER CHILDINFO, I, IB11D, IB11E, IB12D, IB12E,
- $ IB21D, IB21E, IB22D, IB22E, IBBCSD, IORBDB,
- $ IORGLQ, IORGQR, IPHI, ITAUP1, ITAUP2, ITAUQ1,
- $ ITAUQ2, J, LBBCSDWORK, LBBCSDWORKMIN,
- $ LBBCSDWORKOPT, LORBDBWORK, LORBDBWORKMIN,
- $ LORBDBWORKOPT, LORGLQWORK, LORGLQWORKMIN,
- $ LORGLQWORKOPT, LORGQRWORK, LORGQRWORKMIN,
- $ LORGQRWORKOPT, LWORKMIN, LWORKOPT
- LOGICAL COLMAJOR, DEFAULTSIGNS, LQUERY, WANTU1, WANTU2,
- $ WANTV1T, WANTV2T
-* ..
-* .. External Subroutines ..
- EXTERNAL SBBCSD, SLACPY, SLAPMR, SLAPMT, SLASCL, SLASET,
- $ SORBDB, SORGLQ, SORGQR, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions
- INTRINSIC INT, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test input arguments
-*
- INFO = 0
- WANTU1 = LSAME( JOBU1, 'Y' )
- WANTU2 = LSAME( JOBU2, 'Y' )
- WANTV1T = LSAME( JOBV1T, 'Y' )
- WANTV2T = LSAME( JOBV2T, 'Y' )
- COLMAJOR = .NOT. LSAME( TRANS, 'T' )
- DEFAULTSIGNS = .NOT. LSAME( SIGNS, 'O' )
- LQUERY = LWORK .EQ. -1
- IF( M .LT. 0 ) THEN
- INFO = -7
- ELSE IF( P .LT. 0 .OR. P .GT. M ) THEN
- INFO = -8
- ELSE IF( Q .LT. 0 .OR. Q .GT. M ) THEN
- INFO = -9
- ELSE IF( ( COLMAJOR .AND. LDX11 .LT. MAX(1,P) ) .OR.
- $ ( .NOT.COLMAJOR .AND. LDX11 .LT. MAX(1,Q) ) ) THEN
- INFO = -11
- ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN
- INFO = -20
- ELSE IF( WANTU2 .AND. LDU2 .LT. M-P ) THEN
- INFO = -22
- ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN
- INFO = -24
- ELSE IF( WANTV2T .AND. LDV2T .LT. M-Q ) THEN
- INFO = -26
- END IF
-*
-* Work with transpose if convenient
-*
- IF( INFO .EQ. 0 .AND. MIN( P, M-P ) .LT. MIN( Q, M-Q ) ) THEN
- IF( COLMAJOR ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
- IF( DEFAULTSIGNS ) THEN
- SIGNST = 'O'
- ELSE
- SIGNST = 'D'
- END IF
- CALL SORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M,
- $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22,
- $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1,
- $ U2, LDU2, WORK, LWORK, IWORK, INFO )
- RETURN
- END IF
-*
-* Work with permutation [ 0 I; I 0 ] * X * [ 0 I; I 0 ] if
-* convenient
-*
- IF( INFO .EQ. 0 .AND. M-Q .LT. Q ) THEN
- IF( DEFAULTSIGNS ) THEN
- SIGNST = 'O'
- ELSE
- SIGNST = 'D'
- END IF
- CALL SORCSD( JOBU2, JOBU1, JOBV2T, JOBV1T, TRANS, SIGNST, M,
- $ M-P, M-Q, X22, LDX22, X21, LDX21, X12, LDX12, X11,
- $ LDX11, THETA, U2, LDU2, U1, LDU1, V2T, LDV2T, V1T,
- $ LDV1T, WORK, LWORK, IWORK, INFO )
- RETURN
- END IF
-*
-* Compute workspace
-*
- IF( INFO .EQ. 0 ) THEN
-*
- IPHI = 2
- ITAUP1 = IPHI + MAX( 1, Q - 1 )
- ITAUP2 = ITAUP1 + MAX( 1, P )
- ITAUQ1 = ITAUP2 + MAX( 1, M - P )
- ITAUQ2 = ITAUQ1 + MAX( 1, Q )
- IORGQR = ITAUQ2 + MAX( 1, M - Q )
- CALL SORGQR( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1,
- $ CHILDINFO )
- LORGQRWORKOPT = INT( WORK(1) )
- LORGQRWORKMIN = MAX( 1, M - Q )
- IORGLQ = ITAUQ2 + MAX( 1, M - Q )
- CALL SORGLQ( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1,
- $ CHILDINFO )
- LORGLQWORKOPT = INT( WORK(1) )
- LORGLQWORKMIN = MAX( 1, M - Q )
- IORBDB = ITAUQ2 + MAX( 1, M - Q )
- CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
- $ X21, LDX21, X22, LDX22, DUMMY, DUMMY, DUMMY, DUMMY, DUMMY,
- $ DUMMY,WORK,-1,CHILDINFO )
- LORBDBWORKOPT = INT( WORK(1) )
- LORBDBWORKMIN = LORBDBWORKOPT
- IB11D = ITAUQ2 + MAX( 1, M - Q )
- IB11E = IB11D + MAX( 1, Q )
- IB12D = IB11E + MAX( 1, Q - 1 )
- IB12E = IB12D + MAX( 1, Q )
- IB21D = IB12E + MAX( 1, Q - 1 )
- IB21E = IB21D + MAX( 1, Q )
- IB22D = IB21E + MAX( 1, Q - 1 )
- IB22E = IB22D + MAX( 1, Q )
- IBBCSD = IB22E + MAX( 1, Q - 1 )
- CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q,
- $ DUMMY, DUMMY, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
- $ LDV2T, DUMMY, DUMMY, DUMMY, DUMMY, DUMMY, DUMMY,
- $ DUMMY, DUMMY, WORK, -1, CHILDINFO )
- LBBCSDWORKOPT = INT( WORK(1) )
- LBBCSDWORKMIN = LBBCSDWORKOPT
- LWORKOPT = MAX( IORGQR + LORGQRWORKOPT, IORGLQ + LORGLQWORKOPT,
- $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKOPT ) - 1
- LWORKMIN = MAX( IORGQR + LORGQRWORKMIN, IORGLQ + LORGLQWORKMIN,
- $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKMIN ) - 1
- WORK(1) = MAX(LWORKOPT,LWORKMIN)
-*
- IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN
- INFO = -22
- ELSE
- LORGQRWORK = LWORK - IORGQR + 1
- LORGLQWORK = LWORK - IORGLQ + 1
- LORBDBWORK = LWORK - IORBDB + 1
- LBBCSDWORK = LWORK - IBBCSD + 1
- END IF
- END IF
-*
-* Abort if any illegal arguments
-*
- IF( INFO .NE. 0 ) THEN
- CALL XERBLA( 'SORCSD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Transform to bidiagonal block form
-*
- CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21,
- $ LDX21, X22, LDX22, THETA, WORK(IPHI), WORK(ITAUP1),
- $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2),
- $ WORK(IORBDB), LORBDBWORK, CHILDINFO )
-*
-* Accumulate Householder reflectors
-*
- IF( COLMAJOR ) THEN
- IF( WANTU1 .AND. P .GT. 0 ) THEN
- CALL SLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 )
- CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR),
- $ LORGQRWORK, INFO)
- END IF
- IF( WANTU2 .AND. M-P .GT. 0 ) THEN
- CALL SLACPY( 'L', M-P, Q, X21, LDX21, U2, LDU2 )
- CALL SORGQR( M-P, M-P, Q, U2, LDU2, WORK(ITAUP2),
- $ WORK(IORGQR), LORGQRWORK, INFO )
- END IF
- IF( WANTV1T .AND. Q .GT. 0 ) THEN
- CALL SLACPY( 'U', Q-1, Q-1, X11(1,2), LDX11, V1T(2,2),
- $ LDV1T )
- V1T(1, 1) = ONE
- DO J = 2, Q
- V1T(1,J) = ZERO
- V1T(J,1) = ZERO
- END DO
- CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1),
- $ WORK(IORGLQ), LORGLQWORK, INFO )
- END IF
- IF( WANTV2T .AND. M-Q .GT. 0 ) THEN
- CALL SLACPY( 'U', P, M-Q, X12, LDX12, V2T, LDV2T )
- CALL SLACPY( 'U', M-P-Q, M-P-Q, X22(Q+1,P+1), LDX22,
- $ V2T(P+1,P+1), LDV2T )
- CALL SORGLQ( M-Q, M-Q, M-Q, V2T, LDV2T, WORK(ITAUQ2),
- $ WORK(IORGLQ), LORGLQWORK, INFO )
- END IF
- ELSE
- IF( WANTU1 .AND. P .GT. 0 ) THEN
- CALL SLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 )
- CALL SORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ),
- $ LORGLQWORK, INFO)
- END IF
- IF( WANTU2 .AND. M-P .GT. 0 ) THEN
- CALL SLACPY( 'U', Q, M-P, X21, LDX21, U2, LDU2 )
- CALL SORGLQ( M-P, M-P, Q, U2, LDU2, WORK(ITAUP2),
- $ WORK(IORGLQ), LORGLQWORK, INFO )
- END IF
- IF( WANTV1T .AND. Q .GT. 0 ) THEN
- CALL SLACPY( 'L', Q-1, Q-1, X11(2,1), LDX11, V1T(2,2),
- $ LDV1T )
- V1T(1, 1) = ONE
- DO J = 2, Q
- V1T(1,J) = ZERO
- V1T(J,1) = ZERO
- END DO
- CALL SORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1),
- $ WORK(IORGQR), LORGQRWORK, INFO )
- END IF
- IF( WANTV2T .AND. M-Q .GT. 0 ) THEN
- CALL SLACPY( 'L', M-Q, P, X12, LDX12, V2T, LDV2T )
- CALL SLACPY( 'L', M-P-Q, M-P-Q, X22(P+1,Q+1), LDX22,
- $ V2T(P+1,P+1), LDV2T )
- CALL SORGQR( M-Q, M-Q, M-Q, V2T, LDV2T, WORK(ITAUQ2),
- $ WORK(IORGQR), LORGQRWORK, INFO )
- END IF
- END IF
-*
-* Compute the CSD of the matrix in bidiagonal-block form
-*
- CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA,
- $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
- $ LDV2T, WORK(IB11D), WORK(IB11E), WORK(IB12D),
- $ WORK(IB12E), WORK(IB21D), WORK(IB21E), WORK(IB22D),
- $ WORK(IB22E), WORK(IBBCSD), LBBCSDWORK, INFO )
-*
-* Permute rows and columns to place identity submatrices in top-
-* left corner of (1,1)-block and/or bottom-right corner of (1,2)-
-* block and/or bottom-right corner of (2,1)-block and/or top-left
-* corner of (2,2)-block
-*
- IF( Q .GT. 0 .AND. WANTU2 ) THEN
- DO I = 1, Q
- IWORK(I) = M - P - Q + I
- END DO
- DO I = Q + 1, M - P
- IWORK(I) = I - Q
- END DO
- IF( COLMAJOR ) THEN
- CALL SLAPMT( .FALSE., M-P, M-P, U2, LDU2, IWORK )
- ELSE
- CALL SLAPMR( .FALSE., M-P, M-P, U2, LDU2, IWORK )
- END IF
- END IF
- IF( M .GT. 0 .AND. WANTV2T ) THEN
- DO I = 1, P
- IWORK(I) = M - P - Q + I
- END DO
- DO I = P + 1, M - Q
- IWORK(I) = I - P
- END DO
- IF( .NOT. COLMAJOR ) THEN
- CALL SLAPMT( .FALSE., M-Q, M-Q, V2T, LDV2T, IWORK )
- ELSE
- CALL SLAPMR( .FALSE., M-Q, M-Q, V2T, LDV2T, IWORK )
- END IF
- END IF
-*
- RETURN
-*
-* End SORCSD
-*
- END
-
diff --git a/netlib/LAPACK/sorg2l.f b/netlib/LAPACK/sorg2l.f
deleted file mode 100644
index 9e5c388..0000000
--- a/netlib/LAPACK/sorg2l.f
+++ /dev/null
@@ -1,198 +0,0 @@
-*> \brief \b SORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORG2L + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorg2l.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorg2l.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorg2l.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORG2L generates an m by n real matrix Q with orthonormal columns,
-*> which is defined as the last n columns of a product of k elementary
-*> reflectors of order m
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGEQLF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the (n-k+i)-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by SGEQLF in the last k columns of its array
-*> argument A.
-*> On exit, the m by n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQLF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, II, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORG2L', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Initialise columns 1:n-k to columns of the unit matrix
-*
- DO 20 J = 1, N - K
- DO 10 L = 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- A( M-N+J, J ) = ONE
- 20 CONTINUE
-*
- DO 40 I = 1, K
- II = N - K + I
-*
-* Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
-*
- A( M-N+II, II ) = ONE
- CALL SLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
- $ LDA, WORK )
- CALL SSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
- A( M-N+II, II ) = ONE - TAU( I )
-*
-* Set A(m-k+i+1:m,n-k+i) to zero
-*
- DO 30 L = M - N + II + 1, M
- A( L, II ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of SORG2L
-*
- END
diff --git a/netlib/LAPACK/sorg2r.f b/netlib/LAPACK/sorg2r.f
deleted file mode 100644
index 297b61a..0000000
--- a/netlib/LAPACK/sorg2r.f
+++ /dev/null
@@ -1,200 +0,0 @@
-*> \brief \b SORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORG2R + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorg2r.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorg2r.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorg2r.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORG2R generates an m by n real matrix Q with orthonormal columns,
-*> which is defined as the first n columns of a product of k elementary
-*> reflectors of order m
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGEQRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the i-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by SGEQRF in the first k columns of its array
-*> argument A.
-*> On exit, the m-by-n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORG2R', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Initialise columns k+1:n to columns of the unit matrix
-*
- DO 20 J = K + 1, N
- DO 10 L = 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- A( J, J ) = ONE
- 20 CONTINUE
-*
- DO 40 I = K, 1, -1
-*
-* Apply H(i) to A(i:m,i:n) from the left
-*
- IF( I.LT.N ) THEN
- A( I, I ) = ONE
- CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- END IF
- IF( I.LT.M )
- $ CALL SSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
- A( I, I ) = ONE - TAU( I )
-*
-* Set A(1:i-1,i) to zero
-*
- DO 30 L = 1, I - 1
- A( L, I ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of SORG2R
-*
- END
diff --git a/netlib/LAPACK/sorgbr.f b/netlib/LAPACK/sorgbr.f
deleted file mode 100644
index a525acd..0000000
--- a/netlib/LAPACK/sorgbr.f
+++ /dev/null
@@ -1,338 +0,0 @@
-*> \brief \b SORGBR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGBR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgbr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgbr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgbr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER VECT
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGBR generates one of the real orthogonal matrices Q or P**T
-*> determined by SGEBRD when reducing a real matrix A to bidiagonal
-*> form: A = Q * B * P**T. Q and P**T are defined as products of
-*> elementary reflectors H(i) or G(i) respectively.
-*>
-*> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
-*> is of order M:
-*> if m >= k, Q = H(1) H(2) . . . H(k) and SORGBR returns the first n
-*> columns of Q, where m >= n >= k;
-*> if m < k, Q = H(1) H(2) . . . H(m-1) and SORGBR returns Q as an
-*> M-by-M matrix.
-*>
-*> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
-*> is of order N:
-*> if k < n, P**T = G(k) . . . G(2) G(1) and SORGBR returns the first m
-*> rows of P**T, where n >= m >= k;
-*> if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as
-*> an N-by-N matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> Specifies whether the matrix Q or the matrix P**T is
-*> required, as defined in the transformation applied by SGEBRD:
-*> = 'Q': generate Q;
-*> = 'P': generate P**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q or P**T to be returned.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q or P**T to be returned.
-*> N >= 0.
-*> If VECT = 'Q', M >= N >= min(M,K);
-*> if VECT = 'P', N >= M >= min(N,K).
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> If VECT = 'Q', the number of columns in the original M-by-K
-*> matrix reduced by SGEBRD.
-*> If VECT = 'P', the number of rows in the original K-by-N
-*> matrix reduced by SGEBRD.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by SGEBRD.
-*> On exit, the M-by-N matrix Q or P**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension
-*> (min(M,K)) if VECT = 'Q'
-*> (min(N,K)) if VECT = 'P'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i) or G(i), which determines Q or P**T, as
-*> returned by SGEBRD in its array argument TAUQ or TAUP.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,min(M,N)).
-*> For optimum performance LWORK >= min(M,N)*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realGBcomputational
-*
-* =====================================================================
- SUBROUTINE SORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER VECT
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTQ
- INTEGER I, IINFO, J, LWKOPT, MN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SORGLQ, SORGQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- WANTQ = LSAME( VECT, 'Q' )
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
- $ K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
- $ MIN( N, K ) ) ) ) THEN
- INFO = -3
- ELSE IF( K.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = 1
- IF( WANTQ ) THEN
- IF( M.GE.K ) THEN
- CALL SORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
- ELSE
- IF( M.GT.1 ) THEN
- CALL SORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
- $ -1, IINFO )
- END IF
- END IF
- ELSE
- IF( K.LT.N ) THEN
- CALL SORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
- ELSE
- IF( N.GT.1 ) THEN
- CALL SORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ -1, IINFO )
- END IF
- END IF
- END IF
- LWKOPT = WORK( 1 )
- LWKOPT = MAX (LWKOPT, MN)
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGBR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- WORK( 1 ) = LWKOPT
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( WANTQ ) THEN
-*
-* Form Q, determined by a call to SGEBRD to reduce an m-by-k
-* matrix
-*
- IF( M.GE.K ) THEN
-*
-* If m >= k, assume m >= n >= k
-*
- CALL SORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* If m < k, assume m = n
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first row and column of Q
-* to those of the unit matrix
-*
- DO 20 J = M, 2, -1
- A( 1, J ) = ZERO
- DO 10 I = J + 1, M
- A( I, J ) = A( I, J-1 )
- 10 CONTINUE
- 20 CONTINUE
- A( 1, 1 ) = ONE
- DO 30 I = 2, M
- A( I, 1 ) = ZERO
- 30 CONTINUE
- IF( M.GT.1 ) THEN
-*
-* Form Q(2:m,2:m)
-*
- CALL SORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- ELSE
-*
-* Form P**T, determined by a call to SGEBRD to reduce a k-by-n
-* matrix
-*
- IF( K.LT.N ) THEN
-*
-* If k < n, assume k <= m <= n
-*
- CALL SORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* If k >= n, assume m = n
-*
-* Shift the vectors which define the elementary reflectors one
-* row downward, and set the first row and column of P**T to
-* those of the unit matrix
-*
- A( 1, 1 ) = ONE
- DO 40 I = 2, N
- A( I, 1 ) = ZERO
- 40 CONTINUE
- DO 60 J = 2, N
- DO 50 I = J - 1, 2, -1
- A( I, J ) = A( I-1, J )
- 50 CONTINUE
- A( 1, J ) = ZERO
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Form P**T(2:n,2:n)
-*
- CALL SORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORGBR
-*
- END
diff --git a/netlib/LAPACK/sorghr.f b/netlib/LAPACK/sorghr.f
deleted file mode 100644
index be54131..0000000
--- a/netlib/LAPACK/sorghr.f
+++ /dev/null
@@ -1,240 +0,0 @@
-*> \brief \b SORGHR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGHR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorghr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorghr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorghr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGHR generates a real orthogonal matrix Q which is defined as the
-*> product of IHI-ILO elementary reflectors of order N, as returned by
-*> SGEHRD:
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI must have the same values as in the previous call
-*> of SGEHRD. Q is equal to the unit matrix except in the
-*> submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by SGEHRD.
-*> On exit, the N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEHRD.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= IHI-ILO.
-*> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IINFO, J, LWKOPT, NB, NH
-* ..
-* .. External Subroutines ..
- EXTERNAL SORGQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NH = IHI - ILO
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'SORGQR', ' ', NH, NH, NH, -1 )
- LWKOPT = MAX( 1, NH )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGHR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first ilo and the last n-ihi
-* rows and columns to those of the unit matrix
-*
- DO 40 J = IHI, ILO + 1, -1
- DO 10 I = 1, J - 1
- A( I, J ) = ZERO
- 10 CONTINUE
- DO 20 I = J + 1, IHI
- A( I, J ) = A( I, J-1 )
- 20 CONTINUE
- DO 30 I = IHI + 1, N
- A( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- DO 60 J = 1, ILO
- DO 50 I = 1, N
- A( I, J ) = ZERO
- 50 CONTINUE
- A( J, J ) = ONE
- 60 CONTINUE
- DO 80 J = IHI + 1, N
- DO 70 I = 1, N
- A( I, J ) = ZERO
- 70 CONTINUE
- A( J, J ) = ONE
- 80 CONTINUE
-*
- IF( NH.GT.0 ) THEN
-*
-* Generate Q(ilo+1:ihi,ilo+1:ihi)
-*
- CALL SORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
- $ WORK, LWORK, IINFO )
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORGHR
-*
- END
diff --git a/netlib/LAPACK/sorgl2.f b/netlib/LAPACK/sorgl2.f
deleted file mode 100644
index 3043028..0000000
--- a/netlib/LAPACK/sorgl2.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b SORGL2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGL2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgl2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgl2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgl2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGL2 generates an m by n real matrix Q with orthonormal rows,
-*> which is defined as the first m rows of a product of k elementary
-*> reflectors of order n
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGELQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the i-th row must contain the vector which defines
-*> the elementary reflector H(i), for i = 1,2,...,k, as returned
-*> by SGELQF in the first k rows of its array argument A.
-*> On exit, the m-by-n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGELQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGL2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 )
- $ RETURN
-*
- IF( K.LT.M ) THEN
-*
-* Initialise rows k+1:m to rows of the unit matrix
-*
- DO 20 J = 1, N
- DO 10 L = K + 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- IF( J.GT.K .AND. J.LE.M )
- $ A( J, J ) = ONE
- 20 CONTINUE
- END IF
-*
- DO 40 I = K, 1, -1
-*
-* Apply H(i) to A(i:m,i:n) from the right
-*
- IF( I.LT.N ) THEN
- IF( I.LT.M ) THEN
- A( I, I ) = ONE
- CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
- $ TAU( I ), A( I+1, I ), LDA, WORK )
- END IF
- CALL SSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
- END IF
- A( I, I ) = ONE - TAU( I )
-*
-* Set A(i,1:i-1) to zero
-*
- DO 30 L = 1, I - 1
- A( I, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of SORGL2
-*
- END
diff --git a/netlib/LAPACK/sorglq.f b/netlib/LAPACK/sorglq.f
deleted file mode 100644
index 9239c24..0000000
--- a/netlib/LAPACK/sorglq.f
+++ /dev/null
@@ -1,289 +0,0 @@
-*> \brief \b SORGLQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGLQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorglq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorglq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorglq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGLQ generates an M-by-N real matrix Q with orthonormal rows,
-*> which is defined as the first M rows of a product of K elementary
-*> reflectors of order N
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGELQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the i-th row must contain the vector which defines
-*> the elementary reflector H(i), for i = 1,2,...,k, as returned
-*> by SGELQF in the first k rows of its array argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGELQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORGL2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'SORGLQ', ' ', M, N, K, -1 )
- LWKOPT = MAX( 1, M )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGLQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SORGLQ', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORGLQ', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the last block.
-* The first kk rows are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
-* Set A(kk+1:m,1:kk) to zero.
-*
- DO 20 J = 1, KK
- DO 10 I = KK + 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the last or only block.
-*
- IF( KK.LT.M )
- $ CALL SORGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
- $ TAU( KK+1 ), WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = KI + 1, 1, -NB
- IB = MIN( NB, K-I+1 )
- IF( I+IB.LE.M ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i+ib:m,i:n) from the right
-*
- CALL SLARFB( 'Right', 'Transpose', 'Forward', 'Rowwise',
- $ M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK,
- $ LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ),
- $ LDWORK )
- END IF
-*
-* Apply H**T to columns i:n of current block
-*
- CALL SORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
-* Set columns 1:i-1 of current block to zero
-*
- DO 40 J = 1, I - 1
- DO 30 L = I, I + IB - 1
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SORGLQ
-*
- END
diff --git a/netlib/LAPACK/sorgql.f b/netlib/LAPACK/sorgql.f
deleted file mode 100644
index a15dc3f..0000000
--- a/netlib/LAPACK/sorgql.f
+++ /dev/null
@@ -1,296 +0,0 @@
-*> \brief \b SORGQL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGQL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgql.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgql.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgql.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGQL generates an M-by-N real matrix Q with orthonormal columns,
-*> which is defined as the last N columns of a product of K elementary
-*> reflectors of order M
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGEQLF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the (n-k+i)-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by SGEQLF in the last k columns of its array
-*> argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQLF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
- $ NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORG2L, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'SORGQL', ' ', M, N, K, -1 )
- LWKOPT = N*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGQL', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SORGQL', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORGQL', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the first block.
-* The last kk columns are handled by the block method.
-*
- KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-* Set A(m-kk+1:m,1:n-kk) to zero.
-*
- DO 20 J = 1, N - KK
- DO 10 I = M - KK + 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the first or only block.
-*
- CALL SORG2L( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = K - KK + 1, K, NB
- IB = MIN( NB, K-I+1 )
- IF( N-K+I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
- $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
- CALL SLARFB( 'Left', 'No transpose', 'Backward',
- $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
- $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H to rows 1:m-k+i+ib-1 of current block
-*
- CALL SORG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
- $ TAU( I ), WORK, IINFO )
-*
-* Set rows m-k+i+ib:m of current block to zero
-*
- DO 40 J = N - K + I, N - K + I + IB - 1
- DO 30 L = M - K + I + IB, M
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SORGQL
-*
- END
diff --git a/netlib/LAPACK/sorgqr.f b/netlib/LAPACK/sorgqr.f
deleted file mode 100644
index d491346..0000000
--- a/netlib/LAPACK/sorgqr.f
+++ /dev/null
@@ -1,290 +0,0 @@
-*> \brief \b SORGQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGQR generates an M-by-N real matrix Q with orthonormal columns,
-*> which is defined as the first N columns of a product of K elementary
-*> reflectors of order M
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGEQRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the i-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by SGEQRF in the first k columns of its array
-*> argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORG2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'SORGQR', ' ', M, N, K, -1 )
- LWKOPT = MAX( 1, N )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGQR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SORGQR', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORGQR', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the last block.
-* The first kk columns are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
-* Set A(1:kk,kk+1:n) to zero.
-*
- DO 20 J = KK + 1, N
- DO 10 I = 1, KK
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the last or only block.
-*
- IF( KK.LT.N )
- $ CALL SORG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
- $ TAU( KK+1 ), WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = KI + 1, 1, -NB
- IB = MIN( NB, K-I+1 )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(i:m,i+ib:n) from the left
-*
- CALL SLARFB( 'Left', 'No transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H to rows i:m of current block
-*
- CALL SORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
-* Set rows 1:i-1 of current block to zero
-*
- DO 40 J = I, I + IB - 1
- DO 30 L = 1, I - 1
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SORGQR
-*
- END
diff --git a/netlib/LAPACK/sorgr2.f b/netlib/LAPACK/sorgr2.f
deleted file mode 100644
index b5f4a60..0000000
--- a/netlib/LAPACK/sorgr2.f
+++ /dev/null
@@ -1,202 +0,0 @@
-*> \brief \b SORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGR2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGR2 generates an m by n real matrix Q with orthonormal rows,
-*> which is defined as the last m rows of a product of k elementary
-*> reflectors of order n
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGERQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the (m-k+i)-th row must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by SGERQF in the last k rows of its array argument
-*> A.
-*> On exit, the m by n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGERQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGR2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, II, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGR2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 )
- $ RETURN
-*
- IF( K.LT.M ) THEN
-*
-* Initialise rows 1:m-k to rows of the unit matrix
-*
- DO 20 J = 1, N
- DO 10 L = 1, M - K
- A( L, J ) = ZERO
- 10 CONTINUE
- IF( J.GT.N-M .AND. J.LE.N-K )
- $ A( M-N+J, J ) = ONE
- 20 CONTINUE
- END IF
-*
- DO 40 I = 1, K
- II = M - K + I
-*
-* Apply H(i) to A(1:m-k+i,1:n-k+i) from the right
-*
- A( II, N-M+II ) = ONE
- CALL SLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, TAU( I ),
- $ A, LDA, WORK )
- CALL SSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA )
- A( II, N-M+II ) = ONE - TAU( I )
-*
-* Set A(m-k+i,n-k+i+1:n) to zero
-*
- DO 30 L = N - M + II + 1, N
- A( II, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of SORGR2
-*
- END
diff --git a/netlib/LAPACK/sorgrq.f b/netlib/LAPACK/sorgrq.f
deleted file mode 100644
index 5bafb88..0000000
--- a/netlib/LAPACK/sorgrq.f
+++ /dev/null
@@ -1,296 +0,0 @@
-*> \brief \b SORGRQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGRQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgrq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgrq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgrq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGRQ generates an M-by-N real matrix Q with orthonormal rows,
-*> which is defined as the last M rows of a product of K elementary
-*> reflectors of order N
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGERQF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the (m-k+i)-th row must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by SGERQF in the last k rows of its array argument
-*> A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGERQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORGR2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.LE.0 ) THEN
- LWKOPT = 1
- ELSE
- NB = ILAENV( 1, 'SORGRQ', ' ', M, N, K, -1 )
- LWKOPT = M*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGRQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SORGRQ', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORGRQ', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the first block.
-* The last kk rows are handled by the block method.
-*
- KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-* Set A(1:m-kk,n-kk+1:n) to zero.
-*
- DO 20 J = N - KK + 1, N
- DO 10 I = 1, M - KK
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the first or only block.
-*
- CALL SORGR2( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = K - KK + 1, K, NB
- IB = MIN( NB, K-I+1 )
- II = M - K + I
- IF( II.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
- $ A( II, 1 ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
-*
- CALL SLARFB( 'Right', 'Transpose', 'Backward', 'Rowwise',
- $ II-1, N-K+I+IB-1, IB, A( II, 1 ), LDA, WORK,
- $ LDWORK, A, LDA, WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H**T to columns 1:n-k+i+ib-1 of current block
-*
- CALL SORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ),
- $ WORK, IINFO )
-*
-* Set columns n-k+i+ib:n of current block to zero
-*
- DO 40 L = N - K + I + IB, N
- DO 30 J = II, II + IB - 1
- A( J, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of SORGRQ
-*
- END
diff --git a/netlib/LAPACK/sorgtr.f b/netlib/LAPACK/sorgtr.f
deleted file mode 100644
index 919b9bb..0000000
--- a/netlib/LAPACK/sorgtr.f
+++ /dev/null
@@ -1,255 +0,0 @@
-*> \brief \b SORGTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORGTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorgtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorgtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorgtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORGTR generates a real orthogonal matrix Q which is defined as the
-*> product of n-1 elementary reflectors of order N, as returned by
-*> SSYTRD:
-*>
-*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A contains elementary reflectors
-*> from SSYTRD;
-*> = 'L': Lower triangle of A contains elementary reflectors
-*> from SSYTRD.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by SSYTRD.
-*> On exit, the N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SSYTRD.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N-1).
-*> For optimum performance LWORK >= (N-1)*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER
- INTEGER I, IINFO, J, LWKOPT, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SORGQL, SORGQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF ( UPPER ) THEN
- NB = ILAENV( 1, 'SORGQL', ' ', N-1, N-1, N-1, -1 )
- ELSE
- NB = ILAENV( 1, 'SORGQR', ' ', N-1, N-1, N-1, -1 )
- END IF
- LWKOPT = MAX( 1, N-1 )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORGTR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to SSYTRD with UPLO = 'U'
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the left, and set the last row and column of Q to
-* those of the unit matrix
-*
- DO 20 J = 1, N - 1
- DO 10 I = 1, J - 1
- A( I, J ) = A( I, J+1 )
- 10 CONTINUE
- A( N, J ) = ZERO
- 20 CONTINUE
- DO 30 I = 1, N - 1
- A( I, N ) = ZERO
- 30 CONTINUE
- A( N, N ) = ONE
-*
-* Generate Q(1:n-1,1:n-1)
-*
- CALL SORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* Q was determined by a call to SSYTRD with UPLO = 'L'.
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first row and column of Q to
-* those of the unit matrix
-*
- DO 50 J = N, 2, -1
- A( 1, J ) = ZERO
- DO 40 I = J + 1, N
- A( I, J ) = A( I, J-1 )
- 40 CONTINUE
- 50 CONTINUE
- A( 1, 1 ) = ONE
- DO 60 I = 2, N
- A( I, 1 ) = ZERO
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Generate Q(2:n,2:n)
-*
- CALL SORGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORGTR
-*
- END
diff --git a/netlib/LAPACK/sorm2l.f b/netlib/LAPACK/sorm2l.f
deleted file mode 100644
index b0adc9e..0000000
--- a/netlib/LAPACK/sorm2l.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b SORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORM2L + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorm2l.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorm2l.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorm2l.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORM2L overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T * C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGEQLF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGEQLF in the last k columns of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQLF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, MI, NI, NQ
- REAL AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORM2L', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(1:m-k+i,1:n)
-*
- MI = M - K + I
- ELSE
-*
-* H(i) is applied to C(1:m,1:n-k+i)
-*
- NI = N - K + I
- END IF
-*
-* Apply H(i)
-*
- AII = A( NQ-K+I, I )
- A( NQ-K+I, I ) = ONE
- CALL SLARF( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC,
- $ WORK )
- A( NQ-K+I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of SORM2L
-*
- END
diff --git a/netlib/LAPACK/sorm2r.f b/netlib/LAPACK/sorm2r.f
deleted file mode 100644
index 4a6aaa4..0000000
--- a/netlib/LAPACK/sorm2r.f
+++ /dev/null
@@ -1,282 +0,0 @@
-*> \brief \b SORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORM2R + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorm2r.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorm2r.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorm2r.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORM2R overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGEQRF in the first k columns of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQRF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
- REAL AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORM2R', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL SLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
- $ LDC, WORK )
- A( I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of SORM2R
-*
- END
diff --git a/netlib/LAPACK/sormbr.f b/netlib/LAPACK/sormbr.f
deleted file mode 100644
index 83b9d63..0000000
--- a/netlib/LAPACK/sormbr.f
+++ /dev/null
@@ -1,374 +0,0 @@
-*> \brief \b SORMBR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMBR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormbr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormbr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormbr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
-* LDC, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, VECT
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> If VECT = 'Q', SORMBR overwrites the general real M-by-N matrix C
-*> with
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> If VECT = 'P', SORMBR overwrites the general real M-by-N matrix C
-*> with
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': P * C C * P
-*> TRANS = 'T': P**T * C C * P**T
-*>
-*> Here Q and P**T are the orthogonal matrices determined by SGEBRD when
-*> reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
-*> P**T are defined as products of elementary reflectors H(i) and G(i)
-*> respectively.
-*>
-*> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
-*> order of the orthogonal matrix Q or P**T that is applied.
-*>
-*> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
-*> if nq >= k, Q = H(1) H(2) . . . H(k);
-*> if nq < k, Q = H(1) H(2) . . . H(nq-1).
-*>
-*> If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
-*> if k < nq, P = G(1) G(2) . . . G(k);
-*> if k >= nq, P = G(1) G(2) . . . G(nq-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'Q': apply Q or Q**T;
-*> = 'P': apply P or P**T.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q, Q**T, P or P**T from the Left;
-*> = 'R': apply Q, Q**T, P or P**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q or P;
-*> = 'T': Transpose, apply Q**T or P**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> If VECT = 'Q', the number of columns in the original
-*> matrix reduced by SGEBRD.
-*> If VECT = 'P', the number of rows in the original
-*> matrix reduced by SGEBRD.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,min(nq,K)) if VECT = 'Q'
-*> (LDA,nq) if VECT = 'P'
-*> The vectors which define the elementary reflectors H(i) and
-*> G(i), whose products determine the matrices Q and P, as
-*> returned by SGEBRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If VECT = 'Q', LDA >= max(1,nq);
-*> if VECT = 'P', LDA >= max(1,min(nq,K)).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (min(nq,K))
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i) or G(i) which determines Q or P, as returned
-*> by SGEBRD in the array argument TAUQ or TAUP.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
-*> or P*C or P**T*C or C*P or C*P**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
- $ LDC, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, VECT
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SORMLQ, SORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- APPLYQ = LSAME( VECT, 'Q' )
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q or P and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( K.LT.0 ) THEN
- INFO = -6
- ELSE IF( ( APPLYQ .AND. LDA.LT.MAX( 1, NQ ) ) .OR.
- $ ( .NOT.APPLYQ .AND. LDA.LT.MAX( 1, MIN( NQ, K ) ) ) )
- $ THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( APPLYQ ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'SORMQR', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'SORMQR', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- ELSE
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'SORMLQ', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'SORMLQ', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMBR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = 1
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- IF( APPLYQ ) THEN
-*
-* Apply Q
-*
- IF( NQ.GE.K ) THEN
-*
-* Q was determined by a call to SGEBRD with nq >= k
-*
- CALL SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, IINFO )
- ELSE IF( NQ.GT.1 ) THEN
-*
-* Q was determined by a call to SGEBRD with nq < k
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- I1 = 2
- I2 = 1
- ELSE
- MI = M
- NI = N - 1
- I1 = 1
- I2 = 2
- END IF
- CALL SORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
- $ C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- ELSE
-*
-* Apply P
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
- IF( NQ.GT.K ) THEN
-*
-* P was determined by a call to SGEBRD with nq > k
-*
- CALL SORMLQ( SIDE, TRANST, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, IINFO )
- ELSE IF( NQ.GT.1 ) THEN
-*
-* P was determined by a call to SGEBRD with nq <= k
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- I1 = 2
- I2 = 1
- ELSE
- MI = M
- NI = N - 1
- I1 = 1
- I2 = 2
- END IF
- CALL SORMLQ( SIDE, TRANST, MI, NI, NQ-1, A( 1, 2 ), LDA,
- $ TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMBR
-*
- END
diff --git a/netlib/LAPACK/sormhr.f b/netlib/LAPACK/sormhr.f
deleted file mode 100644
index b08c5f7..0000000
--- a/netlib/LAPACK/sormhr.f
+++ /dev/null
@@ -1,296 +0,0 @@
-*> \brief \b SORMHR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMHR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormhr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormhr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormhr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
-* LDC, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMHR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix of order nq, with nq = m if
-*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*> IHI-ILO elementary reflectors, as returned by SGEHRD:
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI must have the same values as in the previous call
-*> of SGEHRD. Q is equal to the unit matrix except in the
-*> submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*> If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
-*> ILO = 1 and IHI = 0, if M = 0;
-*> if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
-*> ILO = 1 and IHI = 0, if N = 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L'
-*> (LDA,N) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by SGEHRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEHRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
- $ LDC, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NH = IHI - ILO
- LEFT = LSAME( SIDE, 'L' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
- $ THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
- INFO = -5
- ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'SORMQR', SIDE // TRANS, NH, N, NH, -1 )
- ELSE
- NB = ILAENV( 1, 'SORMQR', SIDE // TRANS, M, NH, NH, -1 )
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMHR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( LEFT ) THEN
- MI = NH
- NI = N
- I1 = ILO + 1
- I2 = 1
- ELSE
- MI = M
- NI = NH
- I1 = 1
- I2 = ILO + 1
- END IF
-*
- CALL SORMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
- $ TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMHR
-*
- END
diff --git a/netlib/LAPACK/sorml2.f b/netlib/LAPACK/sorml2.f
deleted file mode 100644
index 28a7754..0000000
--- a/netlib/LAPACK/sorml2.f
+++ /dev/null
@@ -1,282 +0,0 @@
-*> \brief \b SORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sgelqf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORML2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorml2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorml2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorml2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORML2 overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGELQF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGELQF in the first k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by SGELQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
- REAL AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORML2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL SLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
- A( I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of SORML2
-*
- END
diff --git a/netlib/LAPACK/sormlq.f b/netlib/LAPACK/sormlq.f
deleted file mode 100644
index 9652664..0000000
--- a/netlib/LAPACK/sormlq.f
+++ /dev/null
@@ -1,356 +0,0 @@
-*> \brief \b SORMLQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMLQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormlq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormlq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormlq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMLQ overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGELQF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGELQF in the first k rows of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by SGELQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
- $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- REAL T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORML2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size. NB may be at most NBMAX, where NBMAX
-* is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'SORMLQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMLQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORMLQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL SLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
- $ A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMLQ
-*
- END
diff --git a/netlib/LAPACK/sormql.f b/netlib/LAPACK/sormql.f
deleted file mode 100644
index ed41904..0000000
--- a/netlib/LAPACK/sormql.f
+++ /dev/null
@@ -1,351 +0,0 @@
-*> \brief \b SORMQL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMQL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormql.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormql.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormql.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMQL overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1)
-*>
-*> as returned by SGEQLF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGEQLF in the last k columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQLF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- INTEGER I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
- $ MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- REAL T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORM2L, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = MAX( 1, N )
- ELSE
- NQ = N
- NW = MAX( 1, M )
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
-*
-* Determine the block size. NB may be at most NBMAX, where
-* NBMAX is used to define the local array T.
-*
-*
- NB = MIN( NBMAX, ILAENV( 1, 'SORMQL', SIDE // TRANS, M, N,
- $ K, -1 ) )
- LWKOPT = NW*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMQL', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORMQL', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB,
- $ A( 1, I ), LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
-*
- MI = M - K + I + IB - 1
- ELSE
-*
-* H or H**T is applied to C(1:m,1:n-k+i+ib-1)
-*
- NI = N - K + I + IB - 1
- END IF
-*
-* Apply H or H**T
-*
- CALL SLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI,
- $ IB, A( 1, I ), LDA, T, LDT, C, LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMQL
-*
- END
diff --git a/netlib/LAPACK/sormqr.f b/netlib/LAPACK/sormqr.f
deleted file mode 100644
index 6e89d12..0000000
--- a/netlib/LAPACK/sormqr.f
+++ /dev/null
@@ -1,349 +0,0 @@
-*> \brief \b SORMQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMQR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGEQRF in the first k columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SGEQRF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
- $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- REAL T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORM2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size. NB may be at most NBMAX, where NBMAX
-* is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'SORMQR', SIDE // TRANS, M, N, K,
- $ -1 ) )
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMQR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORMQR', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL SLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL SLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
- $ IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
- $ WORK, LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMQR
-*
- END
diff --git a/netlib/LAPACK/sormr2.f b/netlib/LAPACK/sormr2.f
deleted file mode 100644
index 9530393..0000000
--- a/netlib/LAPACK/sormr2.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b SORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMR2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormr2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormr2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormr2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMR2 overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'T', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'T',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q' (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGERQF in the last k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by SGERQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, MI, NI, NQ
- REAL AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMR2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(1:m-k+i,1:n)
-*
- MI = M - K + I
- ELSE
-*
-* H(i) is applied to C(1:m,1:n-k+i)
-*
- NI = N - K + I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, NQ-K+I )
- A( I, NQ-K+I ) = ONE
- CALL SLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
- $ WORK )
- A( I, NQ-K+I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of SORMR2
-*
- END
diff --git a/netlib/LAPACK/sormr3.f b/netlib/LAPACK/sormr3.f
deleted file mode 100644
index 13bc19d..0000000
--- a/netlib/LAPACK/sormr3.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b SORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMR3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormr3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormr3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormr3.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, L, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMR3 overwrites the general real m by n matrix C with
-*>
-*> Q * C if SIDE = 'L' and TRANS = 'N', or
-*>
-*> Q**T* C if SIDE = 'L' and TRANS = 'C', or
-*>
-*> C * Q if SIDE = 'R' and TRANS = 'N', or
-*>
-*> C * Q**T if SIDE = 'R' and TRANS = 'C',
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix A containing
-*> the meaningful part of the Householder reflectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> STZRZF in the last k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by STZRZF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the m-by-n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, L, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JA, JC, MI, NI, NQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARZ, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
- $ ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMR3', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JA = M - L + 1
- JC = 1
- ELSE
- MI = M
- JA = N - L + 1
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) or H(i)**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) or H(i)**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i) or H(i)**T
-*
- CALL SLARZ( SIDE, MI, NI, L, A( I, JA ), LDA, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
-*
- 10 CONTINUE
-*
- RETURN
-*
-* End of SORMR3
-*
- END
diff --git a/netlib/LAPACK/sormrq.f b/netlib/LAPACK/sormrq.f
deleted file mode 100644
index 88eb5ec..0000000
--- a/netlib/LAPACK/sormrq.f
+++ /dev/null
@@ -1,357 +0,0 @@
-*> \brief \b SORMRQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMRQ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormrq.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormrq.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormrq.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMRQ overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by SGERQF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> SGERQF in the last k rows of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by SGERQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
- $ MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- REAL T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFB, SLARFT, SORMR2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = MAX( 1, N )
- ELSE
- NQ = N
- NW = MAX( 1, M )
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
-*
-* Determine the block size. NB may be at most NBMAX, where
-* NBMAX is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, N,
- $ K, -1 ) )
- LWKOPT = NW*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMRQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- ELSE
- MI = M
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,
- $ A( I, 1 ), LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
-*
- MI = M - K + I + IB - 1
- ELSE
-*
-* H or H**T is applied to C(1:m,1:n-k+i+ib-1)
-*
- NI = N - K + I + IB - 1
- END IF
-*
-* Apply H or H**T
-*
- CALL SLARFB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
- $ IB, A( I, 1 ), LDA, T, LDT, C, LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMRQ
-*
- END
diff --git a/netlib/LAPACK/sormrz.f b/netlib/LAPACK/sormrz.f
deleted file mode 100644
index 1f55f32..0000000
--- a/netlib/LAPACK/sormrz.f
+++ /dev/null
@@ -1,388 +0,0 @@
-*> \brief \b SORMRZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMRZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormrz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormrz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormrz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, L, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMRZ overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix defined as the product of k
-*> elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k)
-*>
-*> as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N
-*> if SIDE = 'R'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of columns of the matrix A containing
-*> the meaningful part of the Householder reflectors.
-*> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> STZRZF in the last k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,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), as returned by STZRZF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, L, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JA, JC,
- $ LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- REAL T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARZB, SLARZT, SORMR3, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = MAX( 1, N )
- ELSE
- NQ = N
- NW = MAX( 1, M )
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
- $ ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
-*
-* Determine the block size. NB may be at most NBMAX, where
-* NBMAX is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, N,
- $ K, -1 ) )
- LWKOPT = NW*NB
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMRZ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
- $ WORK, IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- JA = M - L + 1
- ELSE
- MI = M
- IC = 1
- JA = N - L + 1
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA,
- $ TAU( I ), T, LDT )
-*
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL SLARZB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
- $ IB, L, A( I, JA ), LDA, T, LDT, C( IC, JC ),
- $ LDC, WORK, LDWORK )
- 10 CONTINUE
-*
- END IF
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SORMRZ
-*
- END
diff --git a/netlib/LAPACK/sormtr.f b/netlib/LAPACK/sormtr.f
deleted file mode 100644
index 9935716..0000000
--- a/netlib/LAPACK/sormtr.f
+++ /dev/null
@@ -1,312 +0,0 @@
-*> \brief \b SORMTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SORMTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormtr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormtr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormtr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, UPLO
-* INTEGER INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( LDC, * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SORMTR overwrites the general real M-by-N matrix C with
-*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*>
-*> where Q is a real orthogonal matrix of order nq, with nq = m if
-*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*> nq-1 elementary reflectors, as returned by SSYTRD:
-*>
-*> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
-*>
-*> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A contains elementary reflectors
-*> from SSYTRD;
-*> = 'L': Lower triangle of A contains elementary reflectors
-*> from SSYTRD.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,M) if SIDE = 'L'
-*> (LDA,N) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by SSYTRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is REAL array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by SSYTRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, UPLO
- INTEGER INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, UPPER
- INTEGER I1, I2, IINFO, LWKOPT, MI, NI, NB, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SORMQL, SORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
- $ THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( UPPER ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'SORMQL', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'SORMQL', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- ELSE
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'SORMQR', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'SORMQR', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SORMTR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- ELSE
- MI = M
- NI = N - 1
- END IF
-*
- IF( UPPER ) THEN
-*
-* Q was determined by a call to SSYTRD with UPLO = 'U'
-*
- CALL SORMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C,
- $ LDC, WORK, LWORK, IINFO )
- ELSE
-*
-* Q was determined by a call to SSYTRD with UPLO = 'L'
-*
- IF( LEFT ) THEN
- I1 = 2
- I2 = 1
- ELSE
- I1 = 1
- I2 = 2
- END IF
- CALL SORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
- $ C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SORMTR
-*
- END
diff --git a/netlib/LAPACK/spbcon.f b/netlib/LAPACK/spbcon.f
deleted file mode 100644
index 3a9a818..0000000
--- a/netlib/LAPACK/spbcon.f
+++ /dev/null
@@ -1,271 +0,0 @@
-*> \brief \b SPBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite band matrix using the
-*> Cholesky factorization A = U**T*U or A = L*L**T computed by SPBTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular factor stored in AB;
-*> = 'L': Lower triangular factor stored in AB.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T of the band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of U or L is
-*> stored in the j-th column of the array AB as follows:
-*> if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> The 1-norm (or infinity-norm) of the symmetric band matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE
- REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL LSAME, ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATBS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = SLAMCH( 'Safe minimum' )
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- NORMIN = 'N'
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( UPPER ) THEN
-*
-* Multiply by inv(U**T).
-*
- CALL SLATBS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEL, WORK( 2*N+1 ),
- $ INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(U).
-*
- CALL SLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEU, WORK( 2*N+1 ),
- $ INFO )
- ELSE
-*
-* Multiply by inv(L).
-*
- CALL SLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEL, WORK( 2*N+1 ),
- $ INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(L**T).
-*
- CALL SLATBS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N,
- $ KD, AB, LDAB, WORK, SCALEU, WORK( 2*N+1 ),
- $ INFO )
- END IF
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- SCALE = SCALEL*SCALEU
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
-*
- RETURN
-*
-* End of SPBCON
-*
- END
diff --git a/netlib/LAPACK/spbequ.f b/netlib/LAPACK/spbequ.f
deleted file mode 100644
index ab5650f..0000000
--- a/netlib/LAPACK/spbequ.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b SPBEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite band matrix A and reduce its condition
-*> number (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular of A is stored;
-*> = 'L': Lower triangular of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangle of the symmetric band matrix A,
-*> stored in the first KD+1 rows of the array. The j-th column
-*> of A is stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, J
- REAL SMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
- IF( UPPER ) THEN
- J = KD + 1
- ELSE
- J = 1
- END IF
-*
-* Initialize SMIN and AMAX.
-*
- S( 1 ) = AB( J, 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
-*
-* Find the minimum and maximum diagonal elements.
-*
- DO 10 I = 2, N
- S( I ) = AB( J, I )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 20 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 20 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 30 I = 1, N
- S( I ) = ONE / SQRT( S( I ) )
- 30 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I))
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
- RETURN
-*
-* End of SPBEQU
-*
- END
diff --git a/netlib/LAPACK/spbrfs.f b/netlib/LAPACK/spbrfs.f
deleted file mode 100644
index fc230d9..0000000
--- a/netlib/LAPACK/spbrfs.f
+++ /dev/null
@@ -1,443 +0,0 @@
-*> \brief \b SPBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B,
-* LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite
-*> and banded, and provides error bounds and backward error estimates
-*> for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangle of the symmetric band matrix A,
-*> stored in the first KD+1 rows of the array. The j-th column
-*> of A is stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is REAL array, dimension (LDAFB,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T of the band matrix A as computed by
-*> SPBTRF, in the same storage format as A (see AB).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SPBTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B,
- $ LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, J, K, KASE, L, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, SPBTRS, SSBMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDAFB.LT.KD+1 ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = MIN( N+1, 2*KD+2 )
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SSBMV( UPLO, N, KD, -ONE, AB, LDAB, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- L = KD + 1 - K
- DO 40 I = MAX( 1, K-KD ), K - 1
- WORK( I ) = WORK( I ) + ABS( AB( L+I, K ) )*XK
- S = S + ABS( AB( L+I, K ) )*ABS( X( I, J ) )
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( AB( KD+1, K ) )*XK + S
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( AB( 1, K ) )*XK
- L = 1 - K
- DO 60 I = K + 1, MIN( N, K+KD )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, K ) )*XK
- S = S + ABS( AB( L+I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N,
- $ INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N,
- $ INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 120 CONTINUE
- CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SPBRFS
-*
- END
diff --git a/netlib/LAPACK/spbstf.f b/netlib/LAPACK/spbstf.f
deleted file mode 100644
index ca93d70..0000000
--- a/netlib/LAPACK/spbstf.f
+++ /dev/null
@@ -1,319 +0,0 @@
-*> \brief \b SPBSTF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBSTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbstf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbstf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbstf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBSTF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBSTF computes a split Cholesky factorization of a real
-*> symmetric positive definite band matrix A.
-*>
-*> This routine is designed to be used in conjunction with SSBGST.
-*>
-*> The factorization has the form A = S**T*S where S is a band matrix
-*> of the same bandwidth as A and the following structure:
-*>
-*> S = ( U )
-*> ( M L )
-*>
-*> where U is upper triangular of order m = (n+kd)/2, and L is lower
-*> triangular of order n-m.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first kd+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the factor S from the split Cholesky
-*> factorization A = S**T*S. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the factorization could not be completed,
-*> because the updated element a(i,i) was negative; the
-*> matrix A is not positive definite.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 7, KD = 2:
-*>
-*> S = ( s11 s12 s13 )
-*> ( s22 s23 s24 )
-*> ( s33 s34 )
-*> ( s44 )
-*> ( s53 s54 s55 )
-*> ( s64 s65 s66 )
-*> ( s75 s76 s77 )
-*>
-*> If UPLO = 'U', the array AB holds:
-*>
-*> on entry: on exit:
-*>
-*> * * a13 a24 a35 a46 a57 * * s13 s24 s53 s64 s75
-*> * a12 a23 a34 a45 a56 a67 * s12 s23 s34 s54 s65 s76
-*> a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
-*>
-*> If UPLO = 'L', the array AB holds:
-*>
-*> on entry: on exit:
-*>
-*> a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
-*> a21 a32 a43 a54 a65 a76 * s12 s23 s34 s54 s65 s76 *
-*> a31 a42 a53 a64 a64 * * s13 s24 s53 s64 s75 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPBSTF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, KLD, KM, M
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSYR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBSTF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- KLD = MAX( 1, LDAB-1 )
-*
-* Set the splitting point m.
-*
- M = ( N+KD ) / 2
-*
- IF( UPPER ) THEN
-*
-* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m).
-*
- DO 10 J = N, M + 1, -1
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( KD+1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( KD+1, J ) = AJJ
- KM = MIN( J-1, KD )
-*
-* Compute elements j-km:j-1 of the j-th column and update the
-* the leading submatrix within the band.
-*
- CALL SSCAL( KM, ONE / AJJ, AB( KD+1-KM, J ), 1 )
- CALL SSYR( 'Upper', KM, -ONE, AB( KD+1-KM, J ), 1,
- $ AB( KD+1, J-KM ), KLD )
- 10 CONTINUE
-*
-* Factorize the updated submatrix A(1:m,1:m) as U**T*U.
-*
- DO 20 J = 1, M
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( KD+1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( KD+1, J ) = AJJ
- KM = MIN( KD, M-J )
-*
-* Compute elements j+1:j+km of the j-th row and update the
-* trailing submatrix within the band.
-*
- IF( KM.GT.0 ) THEN
- CALL SSCAL( KM, ONE / AJJ, AB( KD, J+1 ), KLD )
- CALL SSYR( 'Upper', KM, -ONE, AB( KD, J+1 ), KLD,
- $ AB( KD+1, J+1 ), KLD )
- END IF
- 20 CONTINUE
- ELSE
-*
-* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m).
-*
- DO 30 J = N, M + 1, -1
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( 1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( 1, J ) = AJJ
- KM = MIN( J-1, KD )
-*
-* Compute elements j-km:j-1 of the j-th row and update the
-* trailing submatrix within the band.
-*
- CALL SSCAL( KM, ONE / AJJ, AB( KM+1, J-KM ), KLD )
- CALL SSYR( 'Lower', KM, -ONE, AB( KM+1, J-KM ), KLD,
- $ AB( 1, J-KM ), KLD )
- 30 CONTINUE
-*
-* Factorize the updated submatrix A(1:m,1:m) as U**T*U.
-*
- DO 40 J = 1, M
-*
-* Compute s(j,j) and test for non-positive-definiteness.
-*
- AJJ = AB( 1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 50
- AJJ = SQRT( AJJ )
- AB( 1, J ) = AJJ
- KM = MIN( KD, M-J )
-*
-* Compute elements j+1:j+km of the j-th column and update the
-* trailing submatrix within the band.
-*
- IF( KM.GT.0 ) THEN
- CALL SSCAL( KM, ONE / AJJ, AB( 2, J ), 1 )
- CALL SSYR( 'Lower', KM, -ONE, AB( 2, J ), 1,
- $ AB( 1, J+1 ), KLD )
- END IF
- 40 CONTINUE
- END IF
- RETURN
-*
- 50 CONTINUE
- INFO = J
- RETURN
-*
-* End of SPBSTF
-*
- END
diff --git a/netlib/LAPACK/spbsv.f b/netlib/LAPACK/spbsv.f
deleted file mode 100644
index 168d344..0000000
--- a/netlib/LAPACK/spbsv.f
+++ /dev/null
@@ -1,229 +0,0 @@
-*> \brief <b> SPBSV computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite band matrix and X
-*> and B are N-by-NRHS matrices.
-*>
-*> The Cholesky decomposition is used to factor A as
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular band matrix, and L is a lower
-*> triangular band matrix, with the same number of superdiagonals or
-*> subdiagonals as A. The factored form of A is then used to solve the
-*> system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
-*> See below for further details.
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of A is not
-*> positive definite, so the factorization could not be
-*> completed, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> On entry: On exit:
-*>
-*> * * a13 a24 a35 a46 * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> On entry: On exit:
-*>
-*> a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
-*> a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
-*> a31 a42 a53 a64 * * l31 l42 l53 l64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPBTRF, SPBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the Cholesky factorization A = U**T*U or A = L*L**T.
-*
- CALL SPBTRF( UPLO, N, KD, AB, LDAB, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of SPBSV
-*
- END
diff --git a/netlib/LAPACK/spbsvx.f b/netlib/LAPACK/spbsvx.f
deleted file mode 100644
index c0dfa99..0000000
--- a/netlib/LAPACK/spbsvx.f
+++ /dev/null
@@ -1,545 +0,0 @@
-*> \brief <b> SPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
-* EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, UPLO
-* INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), S( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
-*> compute the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite band matrix and X
-*> and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
-*>
-*> 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
-*> factor the matrix A (after equilibration if FACT = 'E') as
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular band matrix, and L is a lower
-*> triangular band matrix.
-*>
-*> 3. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(S) so that it solves the original system before
-*> equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFB contains the factored form of A.
-*> If EQUED = 'Y', the matrix A has been equilibrated
-*> with scaling factors given by S. AB and AFB will not
-*> be modified.
-*> = 'N': The matrix A will be copied to AFB and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFB and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right-hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array, except
-*> if FACT = 'F' and EQUED = 'Y', then A must contain the
-*> equilibrated matrix diag(S)*A*diag(S). The j-th column of A
-*> is stored in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
-*> See below for further details.
-*>
-*> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
-*> diag(S)*A*diag(S).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array A. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] AFB
-*> \verbatim
-*> AFB is REAL array, dimension (LDAFB,N)
-*> If FACT = 'F', then AFB is an input argument and on entry
-*> contains the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the band matrix
-*> A, in the same storage format as A (see AB). If EQUED = 'Y',
-*> then AFB is the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFB is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*>
-*> If FACT = 'E', then AFB is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the equilibrated
-*> matrix A (see the description of A for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> The scale factors for A; not accessed if EQUED = 'N'. S is
-*> an input argument if FACT = 'F'; otherwise, S is an output
-*> argument. If FACT = 'F' and EQUED = 'Y', each element of S
-*> must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
-*> B is overwritten by diag(S) * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
-*> the original system of equations. Note that if EQUED = 'Y',
-*> A and B are modified on exit, and the solution to the
-*> equilibrated system is inv(diag(S))*X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13
-*> a22 a23 a24
-*> a33 a34 a35
-*> a44 a45 a46
-*> a55 a56
-*> (aij=conjg(aji)) a66
-*>
-*> Band storage of the upper triangle of A:
-*>
-*> * * a13 a24 a35 a46
-*> * a12 a23 a34 a45 a56
-*> a11 a22 a33 a44 a55 a66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> a11 a22 a33 a44 a55 a66
-*> a21 a32 a43 a54 a65 *
-*> a31 a42 a53 a64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
- $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, UPLO
- INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), S( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL EQUIL, NOFACT, RCEQU, UPPER
- INTEGER I, INFEQU, J, J1, J2
- REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SLAQSB, SPBCON, SPBEQU, SPBRFS,
- $ SPBTRF, SPBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- UPPER = LSAME( UPLO, 'U' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- RCEQU = .FALSE.
- ELSE
- RCEQU = LSAME( EQUED, 'Y' )
- SMLNUM = SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -7
- ELSE IF( LDAFB.LT.KD+1 ) THEN
- INFO = -9
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -10
- ELSE
- IF( RCEQU ) THEN
- SMIN = BIGNUM
- SMAX = ZERO
- DO 10 J = 1, N
- SMIN = MIN( SMIN, S( J ) )
- SMAX = MAX( SMAX, S( J ) )
- 10 CONTINUE
- IF( SMIN.LE.ZERO ) THEN
- INFO = -11
- ELSE IF( N.GT.0 ) THEN
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
- ELSE
- SCOND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -15
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL SPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )
- RCEQU = LSAME( EQUED, 'Y' )
- END IF
- END IF
-*
-* Scale the right-hand side.
-*
- IF( RCEQU ) THEN
- DO 30 J = 1, NRHS
- DO 20 I = 1, N
- B( I, J ) = S( I )*B( I, J )
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the Cholesky factorization A = U**T *U or A = L*L**T.
-*
- IF( UPPER ) THEN
- DO 40 J = 1, N
- J1 = MAX( J-KD, 1 )
- CALL SCOPY( J-J1+1, AB( KD+1-J+J1, J ), 1,
- $ AFB( KD+1-J+J1, J ), 1 )
- 40 CONTINUE
- ELSE
- DO 50 J = 1, N
- J2 = MIN( J+KD, N )
- CALL SCOPY( J2-J+1, AB( 1, J ), 1, AFB( 1, J ), 1 )
- 50 CONTINUE
- END IF
-*
- CALL SPBTRF( UPLO, N, KD, AFB, LDAFB, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = SLANSB( '1', UPLO, N, KD, AB, LDAB, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* Compute the solution matrix X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SPBTRS( UPLO, N, KD, NRHS, AFB, LDAFB, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( RCEQU ) THEN
- DO 70 J = 1, NRHS
- DO 60 I = 1, N
- X( I, J ) = S( I )*X( I, J )
- 60 CONTINUE
- 70 CONTINUE
- DO 80 J = 1, NRHS
- FERR( J ) = FERR( J ) / SCOND
- 80 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of SPBSVX
-*
- END
diff --git a/netlib/LAPACK/spbtf2.f b/netlib/LAPACK/spbtf2.f
deleted file mode 100644
index 5e8a774..0000000
--- a/netlib/LAPACK/spbtf2.f
+++ /dev/null
@@ -1,263 +0,0 @@
-*> \brief \b SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbtf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbtf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbtf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBTF2( UPLO, N, KD, AB, LDAB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBTF2 computes the Cholesky factorization of a real symmetric
-*> positive definite band matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U , if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix, U**T is the transpose of U, and
-*> L is lower triangular.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, the leading minor of order k is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> On entry: On exit:
-*>
-*> * * a13 a24 a35 a46 * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> On entry: On exit:
-*>
-*> a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
-*> a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
-*> a31 a42 a53 a64 * * l31 l42 l53 l64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPBTF2( UPLO, N, KD, AB, LDAB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, KLD, KN
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSYR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- KLD = MAX( 1, LDAB-1 )
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T*U.
-*
- DO 10 J = 1, N
-*
-* Compute U(J,J) and test for non-positive-definiteness.
-*
- AJJ = AB( KD+1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 30
- AJJ = SQRT( AJJ )
- AB( KD+1, J ) = AJJ
-*
-* Compute elements J+1:J+KN of row J and update the
-* trailing submatrix within the band.
-*
- KN = MIN( KD, N-J )
- IF( KN.GT.0 ) THEN
- CALL SSCAL( KN, ONE / AJJ, AB( KD, J+1 ), KLD )
- CALL SSYR( 'Upper', KN, -ONE, AB( KD, J+1 ), KLD,
- $ AB( KD+1, J+1 ), KLD )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- DO 20 J = 1, N
-*
-* Compute L(J,J) and test for non-positive-definiteness.
-*
- AJJ = AB( 1, J )
- IF( AJJ.LE.ZERO )
- $ GO TO 30
- AJJ = SQRT( AJJ )
- AB( 1, J ) = AJJ
-*
-* Compute elements J+1:J+KN of column J and update the
-* trailing submatrix within the band.
-*
- KN = MIN( KD, N-J )
- IF( KN.GT.0 ) THEN
- CALL SSCAL( KN, ONE / AJJ, AB( 2, J ), 1 )
- CALL SSYR( 'Lower', KN, -ONE, AB( 2, J ), 1,
- $ AB( 1, J+1 ), KLD )
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
- 30 CONTINUE
- INFO = J
- RETURN
-*
-* End of SPBTF2
-*
- END
diff --git a/netlib/LAPACK/spbtrf.f b/netlib/LAPACK/spbtrf.f
deleted file mode 100644
index fa89fbc..0000000
--- a/netlib/LAPACK/spbtrf.f
+++ /dev/null
@@ -1,435 +0,0 @@
-*> \brief \b SPBTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbtrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbtrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbtrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBTRF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBTRF computes the Cholesky factorization of a real symmetric
-*> positive definite band matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T of the band
-*> matrix A, in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> N = 6, KD = 2, and UPLO = 'U':
-*>
-*> On entry: On exit:
-*>
-*> * * a13 a24 a35 a46 * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*>
-*> Similarly, if UPLO = 'L' the format of A is as follows:
-*>
-*> On entry: On exit:
-*>
-*> a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
-*> a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
-*> a31 a42 a53 a64 * * l31 l42 l53 l64 * *
-*>
-*> Array elements marked * are not used by the routine.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Peter Mayes and Giuseppe Radicati, IBM ECSEC, Rome, March 23, 1989
-*
-* =====================================================================
- SUBROUTINE SPBTRF( UPLO, N, KD, AB, LDAB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
- INTEGER NBMAX, LDWORK
- PARAMETER ( NBMAX = 32, LDWORK = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I2, I3, IB, II, J, JJ, NB
-* ..
-* .. Local Arrays ..
- REAL WORK( LDWORK, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SPBTF2, SPOTF2, SSYRK, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( ( .NOT.LSAME( UPLO, 'U' ) ) .AND.
- $ ( .NOT.LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment
-*
- NB = ILAENV( 1, 'SPBTRF', UPLO, N, KD, -1, -1 )
-*
-* The block size must not exceed the semi-bandwidth KD, and must not
-* exceed the limit set by the size of the local array WORK.
-*
- NB = MIN( NB, NBMAX )
-*
- IF( NB.LE.1 .OR. NB.GT.KD ) THEN
-*
-* Use unblocked code
-*
- CALL SPBTF2( UPLO, N, KD, AB, LDAB, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Compute the Cholesky factorization of a symmetric band
-* matrix, given the upper triangle of the matrix in band
-* storage.
-*
-* Zero the upper triangle of the work array.
-*
- DO 20 J = 1, NB
- DO 10 I = 1, J - 1
- WORK( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Process the band matrix one diagonal block at a time.
-*
- DO 70 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
-*
-* Factorize the diagonal block
-*
- CALL SPOTF2( UPLO, IB, AB( KD+1, I ), LDAB-1, II )
- IF( II.NE.0 ) THEN
- INFO = I + II - 1
- GO TO 150
- END IF
- IF( I+IB.LE.N ) THEN
-*
-* Update the relevant part of the trailing submatrix.
-* If A11 denotes the diagonal block which has just been
-* factorized, then we need to update the remaining
-* blocks in the diagram:
-*
-* A11 A12 A13
-* A22 A23
-* A33
-*
-* The numbers of rows and columns in the partitioning
-* are IB, I2, I3 respectively. The blocks A12, A22 and
-* A23 are empty if IB = KD. The upper triangle of A13
-* lies outside the band.
-*
- I2 = MIN( KD-IB, N-I-IB+1 )
- I3 = MIN( IB, N-I-KD+1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A12
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose',
- $ 'Non-unit', IB, I2, ONE, AB( KD+1, I ),
- $ LDAB-1, AB( KD+1-IB, I+IB ), LDAB-1 )
-*
-* Update A22
-*
- CALL SSYRK( 'Upper', 'Transpose', I2, IB, -ONE,
- $ AB( KD+1-IB, I+IB ), LDAB-1, ONE,
- $ AB( KD+1, I+IB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Copy the lower triangle of A13 into the work array.
-*
- DO 40 JJ = 1, I3
- DO 30 II = JJ, IB
- WORK( II, JJ ) = AB( II-JJ+1, JJ+I+KD-1 )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Update A13 (in the work array).
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose',
- $ 'Non-unit', IB, I3, ONE, AB( KD+1, I ),
- $ LDAB-1, WORK, LDWORK )
-*
-* Update A23
-*
- IF( I2.GT.0 )
- $ CALL SGEMM( 'Transpose', 'No Transpose', I2, I3,
- $ IB, -ONE, AB( KD+1-IB, I+IB ),
- $ LDAB-1, WORK, LDWORK, ONE,
- $ AB( 1+IB, I+KD ), LDAB-1 )
-*
-* Update A33
-*
- CALL SSYRK( 'Upper', 'Transpose', I3, IB, -ONE,
- $ WORK, LDWORK, ONE, AB( KD+1, I+KD ),
- $ LDAB-1 )
-*
-* Copy the lower triangle of A13 back into place.
-*
- DO 60 JJ = 1, I3
- DO 50 II = JJ, IB
- AB( II-JJ+1, JJ+I+KD-1 ) = WORK( II, JJ )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- END IF
- 70 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization of a symmetric band
-* matrix, given the lower triangle of the matrix in band
-* storage.
-*
-* Zero the lower triangle of the work array.
-*
- DO 90 J = 1, NB
- DO 80 I = J + 1, NB
- WORK( I, J ) = ZERO
- 80 CONTINUE
- 90 CONTINUE
-*
-* Process the band matrix one diagonal block at a time.
-*
- DO 140 I = 1, N, NB
- IB = MIN( NB, N-I+1 )
-*
-* Factorize the diagonal block
-*
- CALL SPOTF2( UPLO, IB, AB( 1, I ), LDAB-1, II )
- IF( II.NE.0 ) THEN
- INFO = I + II - 1
- GO TO 150
- END IF
- IF( I+IB.LE.N ) THEN
-*
-* Update the relevant part of the trailing submatrix.
-* If A11 denotes the diagonal block which has just been
-* factorized, then we need to update the remaining
-* blocks in the diagram:
-*
-* A11
-* A21 A22
-* A31 A32 A33
-*
-* The numbers of rows and columns in the partitioning
-* are IB, I2, I3 respectively. The blocks A21, A22 and
-* A32 are empty if IB = KD. The lower triangle of A31
-* lies outside the band.
-*
- I2 = MIN( KD-IB, N-I-IB+1 )
- I3 = MIN( IB, N-I-KD+1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A21
-*
- CALL STRSM( 'Right', 'Lower', 'Transpose',
- $ 'Non-unit', I2, IB, ONE, AB( 1, I ),
- $ LDAB-1, AB( 1+IB, I ), LDAB-1 )
-*
-* Update A22
-*
- CALL SSYRK( 'Lower', 'No Transpose', I2, IB, -ONE,
- $ AB( 1+IB, I ), LDAB-1, ONE,
- $ AB( 1, I+IB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Copy the upper triangle of A31 into the work array.
-*
- DO 110 JJ = 1, IB
- DO 100 II = 1, MIN( JJ, I3 )
- WORK( II, JJ ) = AB( KD+1-JJ+II, JJ+I-1 )
- 100 CONTINUE
- 110 CONTINUE
-*
-* Update A31 (in the work array).
-*
- CALL STRSM( 'Right', 'Lower', 'Transpose',
- $ 'Non-unit', I3, IB, ONE, AB( 1, I ),
- $ LDAB-1, WORK, LDWORK )
-*
-* Update A32
-*
- IF( I2.GT.0 )
- $ CALL SGEMM( 'No transpose', 'Transpose', I3, I2,
- $ IB, -ONE, WORK, LDWORK,
- $ AB( 1+IB, I ), LDAB-1, ONE,
- $ AB( 1+KD-IB, I+IB ), LDAB-1 )
-*
-* Update A33
-*
- CALL SSYRK( 'Lower', 'No Transpose', I3, IB, -ONE,
- $ WORK, LDWORK, ONE, AB( 1, I+KD ),
- $ LDAB-1 )
-*
-* Copy the upper triangle of A31 back into place.
-*
- DO 130 JJ = 1, IB
- DO 120 II = 1, MIN( JJ, I3 )
- AB( KD+1-JJ+II, JJ+I-1 ) = WORK( II, JJ )
- 120 CONTINUE
- 130 CONTINUE
- END IF
- END IF
- 140 CONTINUE
- END IF
- END IF
- RETURN
-*
- 150 CONTINUE
- RETURN
-*
-* End of SPBTRF
-*
- END
diff --git a/netlib/LAPACK/spbtrs.f b/netlib/LAPACK/spbtrs.f
deleted file mode 100644
index 3cc4049..0000000
--- a/netlib/LAPACK/spbtrs.f
+++ /dev/null
@@ -1,220 +0,0 @@
-*> \brief \b SPBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPBTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPBTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite band matrix A using the Cholesky factorization
-*> A = U**T*U or A = L*L**T computed by SPBTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular factor stored in AB;
-*> = 'L': Lower triangular factor stored in AB.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T of the band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of U or L is
-*> stored in the j-th column of the array AB as follows:
-*> if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL STBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KD.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B where A = U**T *U.
-*
- DO 10 J = 1, NRHS
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL STBSV( 'Upper', 'Transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Solve A*X = B where A = L*L**T.
-*
- DO 20 J = 1, NRHS
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL STBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL STBSV( 'Lower', 'Transpose', 'Non-unit', N, KD, AB,
- $ LDAB, B( 1, J ), 1 )
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SPBTRS
-*
- END
diff --git a/netlib/LAPACK/spftrf.f b/netlib/LAPACK/spftrf.f
deleted file mode 100644
index 3d73e0e..0000000
--- a/netlib/LAPACK/spftrf.f
+++ /dev/null
@@ -1,457 +0,0 @@
-*> \brief \b SPFTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPFTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spftrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spftrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spftrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER N, INFO
-* ..
-* .. Array Arguments ..
-* REAL A( 0: * )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPFTRF computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*>
-*> This is the block version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of RFP A is stored;
-*> = 'L': Lower triangle of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension ( N*(N+1)/2 );
-*> On entry, the symmetric matrix A in RFP format. RFP format is
-*> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N'
-*> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
-*> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is
-*> the transpose of RFP A as defined when
-*> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
-*> follows: If UPLO = 'U' the RFP A contains the NT elements of
-*> upper packed A. If UPLO = 'L' the RFP A contains the elements
-*> of lower packed A. The LDA of RFP A is (N+1)/2 when TRANSR =
-*> 'T'. When TRANSR is 'N' the LDA is N+1 when N is even and N
-*> is odd. See the Note below for more details.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization RFP A = U**T*U or RFP A = L*L**T.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER N, INFO
-* ..
-* .. Array Arguments ..
- REAL A( 0: * )
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SSYRK, SPOTRF, STRSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPFTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- ELSE
- NISODD = .TRUE.
- END IF
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(n1)
-*
- CALL SPOTRF( 'L', N1, A( 0 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'R', 'L', 'T', 'N', N2, N1, ONE, A( 0 ), N,
- $ A( N1 ), N )
- CALL SSYRK( 'U', 'N', N2, N1, -ONE, A( N1 ), N, ONE,
- $ A( N ), N )
- CALL SPOTRF( 'U', N2, A( N ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
-* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
-* T1 -> a(n2), T2 -> a(n1), S -> a(0)
-*
- CALL SPOTRF( 'L', N1, A( N2 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'L', 'L', 'N', 'N', N1, N2, ONE, A( N2 ), N,
- $ A( 0 ), N )
- CALL SSYRK( 'U', 'T', N2, N1, -ONE, A( 0 ), N, ONE,
- $ A( N1 ), N )
- CALL SPOTRF( 'U', N2, A( N1 ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is odd
-* T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1)
-* T1 -> a(0+0) , T2 -> a(1+0) , S -> a(0+n1*n1); lda=n1
-*
- CALL SPOTRF( 'U', N1, A( 0 ), N1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'L', 'U', 'T', 'N', N1, N2, ONE, A( 0 ), N1,
- $ A( N1*N1 ), N1 )
- CALL SSYRK( 'L', 'T', N2, N1, -ONE, A( N1*N1 ), N1, ONE,
- $ A( 1 ), N1 )
- CALL SPOTRF( 'L', N2, A( 1 ), N1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is odd
-* T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0)
-* T1 -> a(n2*n2), T2 -> a(n1*n2), S -> a(0); lda = n2
-*
- CALL SPOTRF( 'U', N1, A( N2*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'R', 'U', 'N', 'N', N2, N1, ONE, A( N2*N2 ),
- $ N2, A( 0 ), N2 )
- CALL SSYRK( 'L', 'N', N2, N1, -ONE, A( 0 ), N2, ONE,
- $ A( N1*N2 ), N2 )
- CALL SPOTRF( 'L', N2, A( N1*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- CALL SPOTRF( 'L', K, A( 1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'R', 'L', 'T', 'N', K, K, ONE, A( 1 ), N+1,
- $ A( K+1 ), N+1 )
- CALL SSYRK( 'U', 'N', K, K, -ONE, A( K+1 ), N+1, ONE,
- $ A( 0 ), N+1 )
- CALL SPOTRF( 'U', K, A( 0 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- CALL SPOTRF( 'L', K, A( K+1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'L', 'L', 'N', 'N', K, K, ONE, A( K+1 ),
- $ N+1, A( 0 ), N+1 )
- CALL SSYRK( 'U', 'T', K, K, -ONE, A( 0 ), N+1, ONE,
- $ A( K ), N+1 )
- CALL SPOTRF( 'U', K, A( K ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- CALL SPOTRF( 'U', K, A( 0+K ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'L', 'U', 'T', 'N', K, K, ONE, A( K ), N1,
- $ A( K*( K+1 ) ), K )
- CALL SSYRK( 'L', 'T', K, K, -ONE, A( K*( K+1 ) ), K, ONE,
- $ A( 0 ), K )
- CALL SPOTRF( 'L', K, A( 0 ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- CALL SPOTRF( 'U', K, A( K*( K+1 ) ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRSM( 'R', 'U', 'N', 'N', K, K, ONE,
- $ A( K*( K+1 ) ), K, A( 0 ), K )
- CALL SSYRK( 'L', 'N', K, K, -ONE, A( 0 ), K, ONE,
- $ A( K*K ), K )
- CALL SPOTRF( 'L', K, A( K*K ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SPFTRF
-*
- END
diff --git a/netlib/LAPACK/spftri.f b/netlib/LAPACK/spftri.f
deleted file mode 100644
index 22634de..0000000
--- a/netlib/LAPACK/spftri.f
+++ /dev/null
@@ -1,423 +0,0 @@
-*> \brief \b SPFTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPFTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spftri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spftri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spftri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N
-* .. Array Arguments ..
-* REAL A( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPFTRI computes the inverse of a real (symmetric) positive definite
-*> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
-*> computed by SPFTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension ( N*(N+1)/2 )
-*> On entry, the symmetric matrix A in RFP format. RFP format is
-*> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N'
-*> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
-*> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is
-*> the transpose of RFP A as defined when
-*> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
-*> follows: If UPLO = 'U' the RFP A contains the nt elements of
-*> upper packed A. If UPLO = 'L' the RFP A contains the elements
-*> of lower packed A. The LDA of RFP A is (N+1)/2 when TRANSR =
-*> 'T'. When TRANSR is 'N' the LDA is N+1 when N is even and N
-*> is odd. See the Note below for more details.
-*>
-*> On exit, the symmetric inverse of the original matrix, in the
-*> same storage format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the (i,i) element of the factor U or L is
-*> zero, and the inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N
-* .. Array Arguments ..
- REAL A( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, STFTRI, SLAUUM, STRMM, SSYRK
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPFTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Invert the triangular Cholesky factor U or L.
-*
- CALL STFTRI( TRANSR, UPLO, 'N', N, A, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- ELSE
- NISODD = .TRUE.
- END IF
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* Start execution of triangular matrix multiply: inv(U)*inv(U)^C or
-* inv(L)^C*inv(L). There are eight cases.
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:N1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(N1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(N1)
-*
- CALL SLAUUM( 'L', N1, A( 0 ), N, INFO )
- CALL SSYRK( 'L', 'T', N1, N2, ONE, A( N1 ), N, ONE,
- $ A( 0 ), N )
- CALL STRMM( 'L', 'U', 'N', 'N', N2, N1, ONE, A( N ), N,
- $ A( N1 ), N )
- CALL SLAUUM( 'U', N2, A( N ), N, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:N2-1)
-* T1 -> a(N1+1,0), T2 -> a(N1,0), S -> a(0,0)
-* T1 -> a(N2), T2 -> a(N1), S -> a(0)
-*
- CALL SLAUUM( 'L', N1, A( N2 ), N, INFO )
- CALL SSYRK( 'L', 'N', N1, N2, ONE, A( 0 ), N, ONE,
- $ A( N2 ), N )
- CALL STRMM( 'R', 'U', 'T', 'N', N1, N2, ONE, A( N1 ), N,
- $ A( 0 ), N )
- CALL SLAUUM( 'U', N2, A( N1 ), N, INFO )
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE, and N is odd
-* T1 -> a(0), T2 -> a(1), S -> a(0+N1*N1)
-*
- CALL SLAUUM( 'U', N1, A( 0 ), N1, INFO )
- CALL SSYRK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, ONE,
- $ A( 0 ), N1 )
- CALL STRMM( 'R', 'L', 'N', 'N', N1, N2, ONE, A( 1 ), N1,
- $ A( N1*N1 ), N1 )
- CALL SLAUUM( 'L', N2, A( 1 ), N1, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE, and N is odd
-* T1 -> a(0+N2*N2), T2 -> a(0+N1*N2), S -> a(0)
-*
- CALL SLAUUM( 'U', N1, A( N2*N2 ), N2, INFO )
- CALL SSYRK( 'U', 'T', N1, N2, ONE, A( 0 ), N2, ONE,
- $ A( N2*N2 ), N2 )
- CALL STRMM( 'L', 'L', 'T', 'N', N2, N1, ONE, A( N1*N2 ),
- $ N2, A( 0 ), N2 )
- CALL SLAUUM( 'L', N2, A( N1*N2 ), N2, INFO )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- CALL SLAUUM( 'L', K, A( 1 ), N+1, INFO )
- CALL SSYRK( 'L', 'T', K, K, ONE, A( K+1 ), N+1, ONE,
- $ A( 1 ), N+1 )
- CALL STRMM( 'L', 'U', 'N', 'N', K, K, ONE, A( 0 ), N+1,
- $ A( K+1 ), N+1 )
- CALL SLAUUM( 'U', K, A( 0 ), N+1, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- CALL SLAUUM( 'L', K, A( K+1 ), N+1, INFO )
- CALL SSYRK( 'L', 'N', K, K, ONE, A( 0 ), N+1, ONE,
- $ A( K+1 ), N+1 )
- CALL STRMM( 'R', 'U', 'T', 'N', K, K, ONE, A( K ), N+1,
- $ A( 0 ), N+1 )
- CALL SLAUUM( 'U', K, A( K ), N+1, INFO )
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE, and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1),
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- CALL SLAUUM( 'U', K, A( K ), K, INFO )
- CALL SSYRK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, ONE,
- $ A( K ), K )
- CALL STRMM( 'R', 'L', 'N', 'N', K, K, ONE, A( 0 ), K,
- $ A( K*( K+1 ) ), K )
- CALL SLAUUM( 'L', K, A( 0 ), K, INFO )
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE, and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0),
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- CALL SLAUUM( 'U', K, A( K*( K+1 ) ), K, INFO )
- CALL SSYRK( 'U', 'T', K, K, ONE, A( 0 ), K, ONE,
- $ A( K*( K+1 ) ), K )
- CALL STRMM( 'L', 'L', 'T', 'N', K, K, ONE, A( K*K ), K,
- $ A( 0 ), K )
- CALL SLAUUM( 'L', K, A( K*K ), K, INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SPFTRI
-*
- END
diff --git a/netlib/LAPACK/spftrs.f b/netlib/LAPACK/spftrs.f
deleted file mode 100644
index ff8aa11..0000000
--- a/netlib/LAPACK/spftrs.f
+++ /dev/null
@@ -1,280 +0,0 @@
-*> \brief \b SPFTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPFTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spftrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spftrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spftrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL A( 0: * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPFTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite matrix A using the Cholesky factorization
-*> A = U**T*U or A = L*L**T computed by SPFTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of RFP A is stored;
-*> = 'L': Lower triangle of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension ( N*(N+1)/2 )
-*> The triangular factor U or L from the Cholesky factorization
-*> of RFP A = U**H*U or RFP A = L*L**T, as computed by SPFTRF.
-*> See note below for more details about RFP A.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL A( 0: * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NORMALTRANSR
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, STFSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPFTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* start execution: there are two triangular solves
-*
- IF( LOWER ) THEN
- CALL STFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- CALL STFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- ELSE
- CALL STFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- CALL STFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B,
- $ LDB )
- END IF
-*
- RETURN
-*
-* End of SPFTRS
-*
- END
diff --git a/netlib/LAPACK/spocon.f b/netlib/LAPACK/spocon.f
deleted file mode 100644
index b652793..0000000
--- a/netlib/LAPACK/spocon.f
+++ /dev/null
@@ -1,253 +0,0 @@
-*> \brief \b SPOCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spocon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spocon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spocon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite matrix using the
-*> Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> The 1-norm (or infinity-norm) of the symmetric matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE
- REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL LSAME, ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATRS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = SLAMCH( 'Safe minimum' )
-*
-* Estimate the 1-norm of inv(A).
-*
- KASE = 0
- NORMIN = 'N'
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( UPPER ) THEN
-*
-* Multiply by inv(U**T).
-*
- CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(U).
-*
- CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(L).
-*
- CALL SLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(L**T).
-*
- CALL SLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- SCALE = SCALEL*SCALEU
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of SPOCON
-*
- END
diff --git a/netlib/LAPACK/spoequ.f b/netlib/LAPACK/spoequ.f
deleted file mode 100644
index 9a79d5c..0000000
--- a/netlib/LAPACK/spoequ.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief \b SPOEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spoequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spoequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spoequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOEQU( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite matrix A and reduce its condition number
-*> (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The N-by-N symmetric positive definite matrix whose scaling
-*> factors are to be computed. Only the diagonal elements of A
-*> are referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOEQU( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL SMIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Find the minimum and maximum diagonal elements.
-*
- S( 1 ) = A( 1, 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
- DO 10 I = 2, N
- S( I ) = A( I, I )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 20 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 20 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 30 I = 1, N
- S( I ) = ONE / SQRT( S( I ) )
- 30 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I))
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
- RETURN
-*
-* End of SPOEQU
-*
- END
diff --git a/netlib/LAPACK/spoequb.f b/netlib/LAPACK/spoequb.f
deleted file mode 100644
index 17be21f..0000000
--- a/netlib/LAPACK/spoequb.f
+++ /dev/null
@@ -1,215 +0,0 @@
-*> \brief \b SPOEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spoequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spoequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spoequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite matrix A and reduce its condition number
-*> (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The N-by-N symmetric positive definite matrix whose scaling
-*> factors are to be computed. Only the diagonal elements of A
-*> are referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- REAL SMIN, BASE, TMP
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT, LOG, INT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
-* Positive definite only performs 1 pass of equilibration.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOEQUB', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-
- BASE = SLAMCH( 'B' )
- TMP = -0.5 / LOG ( BASE )
-*
-* Find the minimum and maximum diagonal elements.
-*
- S( 1 ) = A( 1, 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
- DO 10 I = 2, N
- S( I ) = A( I, I )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 20 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 20 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 30 I = 1, N
- S( I ) = BASE ** INT( TMP * LOG( S( I ) ) )
- 30 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I)).
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
-*
- RETURN
-*
-* End of SPOEQUB
-*
- END
diff --git a/netlib/LAPACK/sporfs.f b/netlib/LAPACK/sporfs.f
deleted file mode 100644
index 435ce77..0000000
--- a/netlib/LAPACK/sporfs.f
+++ /dev/null
@@ -1,430 +0,0 @@
-*> \brief \b SPORFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPORFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sporfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sporfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sporfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X,
-* LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPORFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite,
-*> and provides error bounds and backward error estimates for the
-*> solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SPOTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, J, K, KASE, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, SPOTRS, SSYMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPORFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK + S
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SPORFS
-*
- END
diff --git a/netlib/LAPACK/sposv.f b/netlib/LAPACK/sposv.f
deleted file mode 100644
index 0fdcdb6..0000000
--- a/netlib/LAPACK/sposv.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief <b> SPOSV computes the solution to system of linear equations A * X = B for PO matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sposv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sposv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sposv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix and X and B
-*> are N-by-NRHS matrices.
-*>
-*> The Cholesky decomposition is used to factor A as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix. The factored form of A is then used to solve the system of
-*> equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of A is not
-*> positive definite, so the factorization could not be
-*> completed, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOsolve
-*
-* =====================================================================
- SUBROUTINE SPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPOTRF, SPOTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the Cholesky factorization A = U**T*U or A = L*L**T.
-*
- CALL SPOTRF( UPLO, N, A, LDA, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of SPOSV
-*
- END
diff --git a/netlib/LAPACK/sposvx.f b/netlib/LAPACK/sposvx.f
deleted file mode 100644
index 597550a..0000000
--- a/netlib/LAPACK/sposvx.f
+++ /dev/null
@@ -1,494 +0,0 @@
-*> \brief <b> SPOSVX computes the solution to system of linear equations A * X = B for PO matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sposvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sposvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sposvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
-* S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), S( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
-*> compute the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix and X and B
-*> are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
-*>
-*> 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
-*> factor the matrix A (after equilibration if FACT = 'E') as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix.
-*>
-*> 3. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(S) so that it solves the original system before
-*> equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AF contains the factored form of A.
-*> If EQUED = 'Y', the matrix A has been equilibrated
-*> with scaling factors given by S. A and AF will not
-*> be modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A, except if FACT = 'F' and
-*> EQUED = 'Y', then A must contain the equilibrated matrix
-*> diag(S)*A*diag(S). If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced. A is not modified if
-*> FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
-*> diag(S)*A*diag(S).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, in the same storage
-*> format as A. If EQUED .ne. 'N', then AF is the factored form
-*> of the equilibrated matrix diag(S)*A*diag(S).
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the original
-*> matrix A.
-*>
-*> If FACT = 'E', then AF is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T of the equilibrated
-*> matrix A (see the description of A for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> The scale factors for A; not accessed if EQUED = 'N'. S is
-*> an input argument if FACT = 'F'; otherwise, S is an output
-*> argument. If FACT = 'F' and EQUED = 'Y', each element of S
-*> must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
-*> B is overwritten by diag(S) * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
-*> the original system of equations. Note that if EQUED = 'Y',
-*> A and B are modified on exit, and the solution to the
-*> equilibrated system is inv(diag(S))*X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realPOsolve
-*
-* =====================================================================
- SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
- $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), S( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL EQUIL, NOFACT, RCEQU
- INTEGER I, INFEQU, J
- REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSY
- EXTERNAL LSAME, SLAMCH, SLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SLAQSY, SPOCON, SPOEQU, SPORFS, SPOTRF,
- $ SPOTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- RCEQU = .FALSE.
- ELSE
- RCEQU = LSAME( EQUED, 'Y' )
- SMLNUM = SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -9
- ELSE
- IF( RCEQU ) THEN
- SMIN = BIGNUM
- SMAX = ZERO
- DO 10 J = 1, N
- SMIN = MIN( SMIN, S( J ) )
- SMAX = MAX( SMAX, S( J ) )
- 10 CONTINUE
- IF( SMIN.LE.ZERO ) THEN
- INFO = -10
- ELSE IF( N.GT.0 ) THEN
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
- ELSE
- SCOND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL SPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
- RCEQU = LSAME( EQUED, 'Y' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( RCEQU ) THEN
- DO 30 J = 1, NRHS
- DO 20 I = 1, N
- B( I, J ) = S( I )*B( I, J )
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the Cholesky factorization A = U**T *U or A = L*L**T.
-*
- CALL SLACPY( UPLO, N, N, A, LDA, AF, LDAF )
- CALL SPOTRF( UPLO, N, AF, LDAF, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = SLANSY( '1', UPLO, N, A, LDA, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX,
- $ FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( RCEQU ) THEN
- DO 50 J = 1, NRHS
- DO 40 I = 1, N
- X( I, J ) = S( I )*X( I, J )
- 40 CONTINUE
- 50 CONTINUE
- DO 60 J = 1, NRHS
- FERR( J ) = FERR( J ) / SCOND
- 60 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of SPOSVX
-*
- END
diff --git a/netlib/LAPACK/spotf2.f b/netlib/LAPACK/spotf2.f
deleted file mode 100644
index a2ee180..0000000
--- a/netlib/LAPACK/spotf2.f
+++ /dev/null
@@ -1,230 +0,0 @@
-*> \brief \b SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spotf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spotf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spotf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOTF2( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOTF2 computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U , if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T *U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, the leading minor of order k is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOTF2( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- REAL SDOT
- EXTERNAL LSAME, SDOT, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T *U.
-*
- DO 10 J = 1, N
-*
-* Compute U(J,J) and test for non-positive-definiteness.
-*
- AJJ = A( J, J ) - SDOT( J-1, A( 1, J ), 1, A( 1, J ), 1 )
- IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 30
- END IF
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of row J.
-*
- IF( J.LT.N ) THEN
- CALL SGEMV( 'Transpose', J-1, N-J, -ONE, A( 1, J+1 ),
- $ LDA, A( 1, J ), 1, ONE, A( J, J+1 ), LDA )
- CALL SSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- DO 20 J = 1, N
-*
-* Compute L(J,J) and test for non-positive-definiteness.
-*
- AJJ = A( J, J ) - SDOT( J-1, A( J, 1 ), LDA, A( J, 1 ),
- $ LDA )
- IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 30
- END IF
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of column J.
-*
- IF( J.LT.N ) THEN
- CALL SGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, 1 ),
- $ LDA, A( J, 1 ), LDA, ONE, A( J+1, J ), 1 )
- CALL SSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
- END IF
- 20 CONTINUE
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = J
-*
- 40 CONTINUE
- RETURN
-*
-* End of SPOTF2
-*
- END
diff --git a/netlib/LAPACK/spotrf.f b/netlib/LAPACK/spotrf.f
deleted file mode 100644
index f9ea451..0000000
--- a/netlib/LAPACK/spotrf.f
+++ /dev/null
@@ -1,246 +0,0 @@
-*> \brief \b SPOTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spotrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spotrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spotrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOTRF( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOTRF computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*>
-*> This is the block version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOTRF( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SPOTF2, SSYRK, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- CALL SPOTF2( UPLO, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code.
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T*U.
-*
- DO 10 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
- CALL SSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
- $ A( 1, J ), LDA, ONE, A( J, J ), LDA )
- CALL SPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
- IF( J+JB.LE.N ) THEN
-*
-* Compute the current block row.
-*
- CALL SGEMM( 'Transpose', 'No transpose', JB, N-J-JB+1,
- $ J-1, -ONE, A( 1, J ), LDA, A( 1, J+JB ),
- $ LDA, ONE, A( J, J+JB ), LDA )
- CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
- $ JB, N-J-JB+1, ONE, A( J, J ), LDA,
- $ A( J, J+JB ), LDA )
- END IF
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- DO 20 J = 1, N, NB
-*
-* Update and factorize the current diagonal block and test
-* for non-positive-definiteness.
-*
- JB = MIN( NB, N-J+1 )
- CALL SSYRK( 'Lower', 'No transpose', JB, J-1, -ONE,
- $ A( J, 1 ), LDA, ONE, A( J, J ), LDA )
- CALL SPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
- IF( INFO.NE.0 )
- $ GO TO 30
- IF( J+JB.LE.N ) THEN
-*
-* Compute the current block column.
-*
- CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
- $ J-1, -ONE, A( J+JB, 1 ), LDA, A( J, 1 ),
- $ LDA, ONE, A( J+JB, J ), LDA )
- CALL STRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
- $ N-J-JB+1, JB, ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
- END IF
- 20 CONTINUE
- END IF
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = INFO + J - 1
-*
- 40 CONTINUE
- RETURN
-*
-* End of SPOTRF
-*
- END
diff --git a/netlib/LAPACK/spotri.f b/netlib/LAPACK/spotri.f
deleted file mode 100644
index 370c9e0..0000000
--- a/netlib/LAPACK/spotri.f
+++ /dev/null
@@ -1,159 +0,0 @@
-*> \brief \b SPOTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spotri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spotri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spotri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOTRI( UPLO, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOTRI computes the inverse of a real symmetric positive definite
-*> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
-*> computed by SPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, as computed by
-*> SPOTRF.
-*> On exit, the upper or lower triangle of the (symmetric)
-*> inverse of A, overwriting the input factor U or L.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the (i,i) element of the factor U or L is
-*> zero, and the inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOTRI( UPLO, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAUUM, STRTRI, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Invert the triangular Cholesky factor U or L.
-*
- CALL STRTRI( UPLO, 'Non-unit', N, A, LDA, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
-* Form inv(U) * inv(U)**T or inv(L)**T * inv(L).
-*
- CALL SLAUUM( UPLO, N, A, LDA, INFO )
-*
- RETURN
-*
-* End of SPOTRI
-*
- END
diff --git a/netlib/LAPACK/spotrs.f b/netlib/LAPACK/spotrs.f
deleted file mode 100644
index 6ee53d7..0000000
--- a/netlib/LAPACK/spotrs.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b SPOTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPOTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spotrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spotrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spotrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPOTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite matrix A using the Cholesky factorization
-*> A = U**T*U or A = L*L**T computed by SPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realPOcomputational
-*
-* =====================================================================
- SUBROUTINE SPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPOTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B where A = U**T *U.
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A*X = B where A = L*L**T.
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
- END IF
-*
- RETURN
-*
-* End of SPOTRS
-*
- END
diff --git a/netlib/LAPACK/sppcon.f b/netlib/LAPACK/sppcon.f
deleted file mode 100644
index 2bc6507..0000000
--- a/netlib/LAPACK/sppcon.f
+++ /dev/null
@@ -1,248 +0,0 @@
-*> \brief \b SPPCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sppcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sppcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sppcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite packed matrix using
-*> the Cholesky factorization A = U**T*U or A = L*L**T computed by
-*> SPPTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, packed columnwise in a linear
-*> array. The j-th column of U or L is stored in the array AP
-*> as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> The 1-norm (or infinity-norm) of the symmetric matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE
- REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL LSAME, ISAMAX, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATPS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = SLAMCH( 'Safe minimum' )
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- NORMIN = 'N'
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( UPPER ) THEN
-*
-* Multiply by inv(U**T).
-*
- CALL SLATPS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(U).
-*
- CALL SLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(L).
-*
- CALL SLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEL, WORK( 2*N+1 ), INFO )
- NORMIN = 'Y'
-*
-* Multiply by inv(L**T).
-*
- CALL SLATPS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N,
- $ AP, WORK, SCALEU, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- SCALE = SCALEL*SCALEU
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of SPPCON
-*
- END
diff --git a/netlib/LAPACK/sppequ.f b/netlib/LAPACK/sppequ.f
deleted file mode 100644
index 6d1a391..0000000
--- a/netlib/LAPACK/sppequ.f
+++ /dev/null
@@ -1,238 +0,0 @@
-*> \brief \b SPPEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPEQU + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sppequ.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sppequ.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sppequ.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPEQU computes row and column scalings intended to equilibrate a
-*> symmetric positive definite matrix A in packed storage and reduce
-*> its condition number (with respect to the two-norm). S contains the
-*> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
-*> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
-*> This choice of S puts the condition number of B within a factor N of
-*> the smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
- REAL AMAX, SCOND
-* ..
-* .. Array Arguments ..
- REAL AP( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, JJ
- REAL SMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- SCOND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Initialize SMIN and AMAX.
-*
- S( 1 ) = AP( 1 )
- SMIN = S( 1 )
- AMAX = S( 1 )
-*
- IF( UPPER ) THEN
-*
-* UPLO = 'U': Upper triangle of A is stored.
-* Find the minimum and maximum diagonal elements.
-*
- JJ = 1
- DO 10 I = 2, N
- JJ = JJ + I
- S( I ) = AP( JJ )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 10 CONTINUE
-*
- ELSE
-*
-* UPLO = 'L': Lower triangle of A is stored.
-* Find the minimum and maximum diagonal elements.
-*
- JJ = 1
- DO 20 I = 2, N
- JJ = JJ + N - I + 2
- S( I ) = AP( JJ )
- SMIN = MIN( SMIN, S( I ) )
- AMAX = MAX( AMAX, S( I ) )
- 20 CONTINUE
- END IF
-*
- IF( SMIN.LE.ZERO ) THEN
-*
-* Find the first non-positive diagonal element and return.
-*
- DO 30 I = 1, N
- IF( S( I ).LE.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 30 CONTINUE
- ELSE
-*
-* Set the scale factors to the reciprocals
-* of the diagonal elements.
-*
- DO 40 I = 1, N
- S( I ) = ONE / SQRT( S( I ) )
- 40 CONTINUE
-*
-* Compute SCOND = min(S(I)) / max(S(I))
-*
- SCOND = SQRT( SMIN ) / SQRT( AMAX )
- END IF
- RETURN
-*
-* End of SPPEQU
-*
- END
diff --git a/netlib/LAPACK/spprfs.f b/netlib/LAPACK/spprfs.f
deleted file mode 100644
index c42c5c1..0000000
--- a/netlib/LAPACK/spprfs.f
+++ /dev/null
@@ -1,421 +0,0 @@
-*> \brief \b SPPRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spprfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spprfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spprfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR,
-* BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite
-*> and packed, and provides error bounds and backward error estimates
-*> for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] AFP
-*> \verbatim
-*> AFP is REAL array, dimension (N*(N+1)/2)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, as computed by SPPTRF/CPPTRF,
-*> packed columnwise in a linear array in the same format as A
-*> (see AP).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SPPTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR,
- $ BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, IK, J, K, KASE, KK, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, SPPTRS, SSPMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ),
- $ 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- KK = 1
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- IK = KK
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( AP( KK+K-1 ) )*XK + S
- KK = KK + K
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( AP( KK ) )*XK
- IK = KK + 1
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- KK = KK + ( N-K+1 )
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SPPTRS( UPLO, N, 1, AFP, WORK( N+1 ), N, INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL SPPTRS( UPLO, N, 1, AFP, WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL SPPTRS( UPLO, N, 1, AFP, WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SPPRFS
-*
- END
diff --git a/netlib/LAPACK/sppsv.f b/netlib/LAPACK/sppsv.f
deleted file mode 100644
index 820fe38..0000000
--- a/netlib/LAPACK/sppsv.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief <b> SPPSV computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sppsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sppsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sppsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPSV( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix stored in
-*> packed format and X and B are N-by-NRHS matrices.
-*>
-*> The Cholesky decomposition is used to factor A as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix. The factored form of A is then used to solve the system of
-*> equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, in the same storage
-*> format as A.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i of A is not
-*> positive definite, so the factorization could not be
-*> completed, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = conjg(aji))
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPPSV( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPPTRF, SPPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the Cholesky factorization A = U**T*U or A = L*L**T.
-*
- CALL SPPTRF( UPLO, N, AP, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of SPPSV
-*
- END
diff --git a/netlib/LAPACK/sppsvx.f b/netlib/LAPACK/sppsvx.f
deleted file mode 100644
index 24144f3..0000000
--- a/netlib/LAPACK/sppsvx.f
+++ /dev/null
@@ -1,494 +0,0 @@
-*> \brief <b> SPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sppsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sppsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sppsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
-* X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), S( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
-*> compute the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric positive definite matrix stored in
-*> packed format and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
-*>
-*> 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
-*> factor the matrix A (after equilibration if FACT = 'E') as
-*> A = U**T* U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is a lower triangular
-*> matrix.
-*>
-*> 3. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(S) so that it solves the original system before
-*> equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFP contains the factored form of A.
-*> If EQUED = 'Y', the matrix A has been equilibrated
-*> with scaling factors given by S. AP and AFP will not
-*> be modified.
-*> = 'N': The matrix A will be copied to AFP and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFP and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array, except if FACT = 'F'
-*> and EQUED = 'Y', then A must contain the equilibrated matrix
-*> diag(S)*A*diag(S). The j-th column of A is stored in the
-*> array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details. A is not modified if
-*> FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
-*> diag(S)*A*diag(S).
-*> \endverbatim
-*>
-*> \param[in,out] AFP
-*> \verbatim
-*> AFP is REAL array, dimension
-*> (N*(N+1)/2)
-*> If FACT = 'F', then AFP is an input argument and on entry
-*> contains the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, in the same storage
-*> format as A. If EQUED .ne. 'N', then AFP is the factored
-*> form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFP is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T * U or A = L * L**T of the original
-*> matrix A.
-*>
-*> If FACT = 'E', then AFP is an output argument and on exit
-*> returns the triangular factor U or L from the Cholesky
-*> factorization A = U**T * U or A = L * L**T of the equilibrated
-*> matrix A (see the description of AP for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'Y': Equilibration was done, i.e., A has been replaced by
-*> diag(S) * A * diag(S).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> The scale factors for A; not accessed if EQUED = 'N'. S is
-*> an input argument if FACT = 'F'; otherwise, S is an output
-*> argument. If FACT = 'F' and EQUED = 'Y', each element of S
-*> must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
-*> B is overwritten by diag(S) * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
-*> the original system of equations. Note that if EQUED = 'Y',
-*> A and B are modified on exit, and the solution to the
-*> equilibrated system is inv(diag(S))*X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = conjg(aji))
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
- $ X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), S( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL EQUIL, NOFACT, RCEQU
- INTEGER I, INFEQU, J
- REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSP
- EXTERNAL LSAME, SLAMCH, SLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SLAQSP, SPPCON, SPPEQU, SPPRFS,
- $ SPPTRF, SPPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- RCEQU = .FALSE.
- ELSE
- RCEQU = LSAME( EQUED, 'Y' )
- SMLNUM = SLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -7
- ELSE
- IF( RCEQU ) THEN
- SMIN = BIGNUM
- SMAX = ZERO
- DO 10 J = 1, N
- SMIN = MIN( SMIN, S( J ) )
- SMAX = MAX( SMAX, S( J ) )
- 10 CONTINUE
- IF( SMIN.LE.ZERO ) THEN
- INFO = -8
- ELSE IF( N.GT.0 ) THEN
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
- ELSE
- SCOND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL SPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL SLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
- RCEQU = LSAME( EQUED, 'Y' )
- END IF
- END IF
-*
-* Scale the right-hand side.
-*
- IF( RCEQU ) THEN
- DO 30 J = 1, NRHS
- DO 20 I = 1, N
- B( I, J ) = S( I )*B( I, J )
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the Cholesky factorization A = U**T * U or A = L * L**T.
-*
- CALL SCOPY( N*( N+1 ) / 2, AP, 1, AFP, 1 )
- CALL SPPTRF( UPLO, N, AFP, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = SLANSP( 'I', UPLO, N, AP, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SPPCON( UPLO, N, AFP, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SPPTRS( UPLO, N, NRHS, AFP, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( RCEQU ) THEN
- DO 50 J = 1, NRHS
- DO 40 I = 1, N
- X( I, J ) = S( I )*X( I, J )
- 40 CONTINUE
- 50 CONTINUE
- DO 60 J = 1, NRHS
- FERR( J ) = FERR( J ) / SCOND
- 60 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of SPPSVX
-*
- END
diff --git a/netlib/LAPACK/spptrf.f b/netlib/LAPACK/spptrf.f
deleted file mode 100644
index 8ce6f05..0000000
--- a/netlib/LAPACK/spptrf.f
+++ /dev/null
@@ -1,240 +0,0 @@
-*> \brief \b SPPTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spptrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spptrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spptrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPTRF( UPLO, N, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPTRF computes the Cholesky factorization of a real symmetric
-*> positive definite matrix A stored in packed format.
-*>
-*> The factorization has the form
-*> A = U**T * U, if UPLO = 'U', or
-*> A = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*>
-*> On exit, if INFO = 0, the triangular factor U or L from the
-*> Cholesky factorization A = U**T*U or A = L*L**T, in the same
-*> storage format as A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the factorization could not be
-*> completed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = aji)
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPPTRF( UPLO, N, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JC, JJ
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSPR, STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization A = U**T*U.
-*
- JJ = 0
- DO 10 J = 1, N
- JC = JJ + 1
- JJ = JJ + J
-*
-* Compute elements 1:J-1 of column J.
-*
- IF( J.GT.1 )
- $ CALL STPSV( 'Upper', 'Transpose', 'Non-unit', J-1, AP,
- $ AP( JC ), 1 )
-*
-* Compute U(J,J) and test for non-positive-definiteness.
-*
- AJJ = AP( JJ ) - SDOT( J-1, AP( JC ), 1, AP( JC ), 1 )
- IF( AJJ.LE.ZERO ) THEN
- AP( JJ ) = AJJ
- GO TO 30
- END IF
- AP( JJ ) = SQRT( AJJ )
- 10 CONTINUE
- ELSE
-*
-* Compute the Cholesky factorization A = L*L**T.
-*
- JJ = 1
- DO 20 J = 1, N
-*
-* Compute L(J,J) and test for non-positive-definiteness.
-*
- AJJ = AP( JJ )
- IF( AJJ.LE.ZERO ) THEN
- AP( JJ ) = AJJ
- GO TO 30
- END IF
- AJJ = SQRT( AJJ )
- AP( JJ ) = AJJ
-*
-* Compute elements J+1:N of column J and update the trailing
-* submatrix.
-*
- IF( J.LT.N ) THEN
- CALL SSCAL( N-J, ONE / AJJ, AP( JJ+1 ), 1 )
- CALL SSPR( 'Lower', N-J, -ONE, AP( JJ+1 ), 1,
- $ AP( JJ+N-J+1 ) )
- JJ = JJ + N - J + 1
- END IF
- 20 CONTINUE
- END IF
- GO TO 40
-*
- 30 CONTINUE
- INFO = J
-*
- 40 CONTINUE
- RETURN
-*
-* End of SPPTRF
-*
- END
diff --git a/netlib/LAPACK/spptri.f b/netlib/LAPACK/spptri.f
deleted file mode 100644
index b95f86f..0000000
--- a/netlib/LAPACK/spptri.f
+++ /dev/null
@@ -1,188 +0,0 @@
-*> \brief \b SPPTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spptri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spptri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spptri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPTRI( UPLO, N, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPTRI computes the inverse of a real symmetric positive definite
-*> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
-*> computed by SPPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangular factor is stored in AP;
-*> = 'L': Lower triangular factor is stored in AP.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the triangular factor U or L from the Cholesky
-*> factorization A = U**T*U or A = L*L**T, packed columnwise as
-*> a linear array. The j-th column of U or L is stored in the
-*> array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
-*>
-*> On exit, the upper or lower triangle of the (symmetric)
-*> inverse of A, overwriting the input factor U or L.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the (i,i) element of the factor U or L is
-*> zero, and the inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPPTRI( UPLO, N, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, JC, JJ, JJN
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSPR, STPMV, STPTRI, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Invert the triangular Cholesky factor U or L.
-*
- CALL STPTRI( UPLO, 'Non-unit', N, AP, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Compute the product inv(U) * inv(U)**T.
-*
- JJ = 0
- DO 10 J = 1, N
- JC = JJ + 1
- JJ = JJ + J
- IF( J.GT.1 )
- $ CALL SSPR( 'Upper', J-1, ONE, AP( JC ), 1, AP )
- AJJ = AP( JJ )
- CALL SSCAL( J, AJJ, AP( JC ), 1 )
- 10 CONTINUE
-*
- ELSE
-*
-* Compute the product inv(L)**T * inv(L).
-*
- JJ = 1
- DO 20 J = 1, N
- JJN = JJ + N - J + 1
- AP( JJ ) = SDOT( N-J+1, AP( JJ ), 1, AP( JJ ), 1 )
- IF( J.LT.N )
- $ CALL STPMV( 'Lower', 'Transpose', 'Non-unit', N-J,
- $ AP( JJN ), AP( JJ+1 ), 1 )
- JJ = JJN
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SPPTRI
-*
- END
diff --git a/netlib/LAPACK/spptrs.f b/netlib/LAPACK/spptrs.f
deleted file mode 100644
index 957b309..0000000
--- a/netlib/LAPACK/spptrs.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b SPPTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPPTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spptrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spptrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spptrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPPTRS solves a system of linear equations A*X = B with a symmetric
-*> positive definite matrix A in packed storage using the Cholesky
-*> factorization A = U**T*U or A = L*L**T computed by SPPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The triangular factor U or L from the Cholesky factorization
-*> A = U**T*U or A = L*L**T, packed columnwise in a linear
-*> array. The j-th column of U or L is stored in the array AP
-*> as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPPTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B where A = U**T * U.
-*
- DO 10 I = 1, NRHS
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL STPSV( 'Upper', 'Transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL STPSV( 'Upper', 'No transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Solve A*X = B where A = L * L**T.
-*
- DO 20 I = 1, NRHS
-*
-* Solve L*Y = B, overwriting B with X.
-*
- CALL STPSV( 'Lower', 'No transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
-*
-* Solve L**T *X = Y, overwriting B with X.
-*
- CALL STPSV( 'Lower', 'Transpose', 'Non-unit', N, AP,
- $ B( 1, I ), 1 )
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SPPTRS
-*
- END
diff --git a/netlib/LAPACK/spstf2.f b/netlib/LAPACK/spstf2.f
deleted file mode 100644
index 67dbf7d..0000000
--- a/netlib/LAPACK/spstf2.f
+++ /dev/null
@@ -1,385 +0,0 @@
-*> \brief \b SPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric or complex Hermitian positive semi-definite matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPSTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spstf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spstf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spstf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* REAL TOL
-* INTEGER INFO, LDA, N, RANK
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), WORK( 2*N )
-* INTEGER PIV( N )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPSTF2 computes the Cholesky factorization with complete
-*> pivoting of a real symmetric positive semidefinite matrix A.
-*>
-*> The factorization has the form
-*> P**T * A * P = U**T * U , if UPLO = 'U',
-*> P**T * A * P = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular, and
-*> P is stored as vector PIV.
-*>
-*> This algorithm does not attempt to check that A is positive
-*> semidefinite. This version of the algorithm calls level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization as above.
-*> \endverbatim
-*>
-*> \param[out] PIV
-*> \verbatim
-*> PIV is INTEGER array, dimension (N)
-*> PIV is such that the nonzero entries are P( PIV(K), K ) = 1.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The rank of A given by the number of steps the algorithm
-*> completed.
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is REAL
-*> User defined tolerance. If TOL < 0, then N*U*MAX( A( K,K ) )
-*> will be used. The algorithm terminates at the (K-1)st step
-*> if the pivot <= TOL.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> Work space.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> < 0: If INFO = -K, the K-th argument had an illegal value,
-*> = 0: algorithm completed successfully, and
-*> > 0: the matrix A is either rank deficient with computed rank
-*> as returned in RANK, or is indefinite. See Section 7 of
-*> LAPACK Working Note #161 for further information.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL TOL
- INTEGER INFO, LDA, N, RANK
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), WORK( 2*N )
- INTEGER PIV( N )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL AJJ, SSTOP, STEMP
- INTEGER I, ITEMP, J, PVT
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- REAL SLAMCH
- LOGICAL LSAME, SISNAN
- EXTERNAL SLAMCH, LSAME, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT, MAXLOC
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPSTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize PIV
-*
- DO 100 I = 1, N
- PIV( I ) = I
- 100 CONTINUE
-*
-* Compute stopping value
-*
- PVT = 1
- AJJ = A( PVT, PVT )
- DO I = 2, N
- IF( A( I, I ).GT.AJJ ) THEN
- PVT = I
- AJJ = A( PVT, PVT )
- END IF
- END DO
- IF( AJJ.EQ.ZERO.OR.SISNAN( AJJ ) ) THEN
- RANK = 0
- INFO = 1
- GO TO 170
- END IF
-*
-* Compute stopping value if not supplied
-*
- IF( TOL.LT.ZERO ) THEN
- SSTOP = N * SLAMCH( 'Epsilon' ) * AJJ
- ELSE
- SSTOP = TOL
- END IF
-*
-* Set first half of WORK to zero, holds dot products
-*
- DO 110 I = 1, N
- WORK( I ) = 0
- 110 CONTINUE
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization P**T * A * P = U**T * U
-*
- DO 130 J = 1, N
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 120 I = J, N
-*
- IF( J.GT.1 ) THEN
- WORK( I ) = WORK( I ) + A( J-1, I )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 120 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.SSTOP.OR.SISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 160
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL SSWAP( J-1, A( 1, J ), 1, A( 1, PVT ), 1 )
- IF( PVT.LT.N )
- $ CALL SSWAP( N-PVT, A( J, PVT+1 ), LDA,
- $ A( PVT, PVT+1 ), LDA )
- CALL SSWAP( PVT-J-1, A( J, J+1 ), LDA, A( J+1, PVT ), 1 )
-*
-* Swap dot products and PIV
-*
- STEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = STEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of row J
-*
- IF( J.LT.N ) THEN
- CALL SGEMV( 'Trans', J-1, N-J, -ONE, A( 1, J+1 ), LDA,
- $ A( 1, J ), 1, ONE, A( J, J+1 ), LDA )
- CALL SSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
- END IF
-*
- 130 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization P**T * A * P = L * L**T
-*
- DO 150 J = 1, N
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 140 I = J, N
-*
- IF( J.GT.1 ) THEN
- WORK( I ) = WORK( I ) + A( I, J-1 )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 140 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.SSTOP.OR.SISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 160
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL SSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA )
- IF( PVT.LT.N )
- $ CALL SSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ),
- $ 1 )
- CALL SSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), LDA )
-*
-* Swap dot products and PIV
-*
- STEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = STEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of column J
-*
- IF( J.LT.N ) THEN
- CALL SGEMV( 'No Trans', N-J, J-1, -ONE, A( J+1, 1 ), LDA,
- $ A( J, 1 ), LDA, ONE, A( J+1, J ), 1 )
- CALL SSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
- END IF
-*
- 150 CONTINUE
-*
- END IF
-*
-* Ran to completion, A has full rank
-*
- RANK = N
-*
- GO TO 170
- 160 CONTINUE
-*
-* Rank is number of steps completed. Set INFO = 1 to signal
-* that the factorization cannot be used to solve a system.
-*
- RANK = J - 1
- INFO = 1
-*
- 170 CONTINUE
- RETURN
-*
-* End of SPSTF2
-*
- END
diff --git a/netlib/LAPACK/spstrf.f b/netlib/LAPACK/spstrf.f
deleted file mode 100644
index 76fb870..0000000
--- a/netlib/LAPACK/spstrf.f
+++ /dev/null
@@ -1,443 +0,0 @@
-*> \brief \b SPSTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPSTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spstrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spstrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spstrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* REAL TOL
-* INTEGER INFO, LDA, N, RANK
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), WORK( 2*N )
-* INTEGER PIV( N )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPSTRF computes the Cholesky factorization with complete
-*> pivoting of a real symmetric positive semidefinite matrix A.
-*>
-*> The factorization has the form
-*> P**T * A * P = U**T * U , if UPLO = 'U',
-*> P**T * A * P = L * L**T, if UPLO = 'L',
-*> where U is an upper triangular matrix and L is lower triangular, and
-*> P is stored as vector PIV.
-*>
-*> This algorithm does not attempt to check that A is positive
-*> semidefinite. This version of the algorithm calls level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the factor U or L from the Cholesky
-*> factorization as above.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] PIV
-*> \verbatim
-*> PIV is INTEGER array, dimension (N)
-*> PIV is such that the nonzero entries are P( PIV(K), K ) = 1.
-*> \endverbatim
-*>
-*> \param[out] RANK
-*> \verbatim
-*> RANK is INTEGER
-*> The rank of A given by the number of steps the algorithm
-*> completed.
-*> \endverbatim
-*>
-*> \param[in] TOL
-*> \verbatim
-*> TOL is REAL
-*> User defined tolerance. If TOL < 0, then N*U*MAX( A(K,K) )
-*> will be used. The algorithm terminates at the (K-1)st step
-*> if the pivot <= TOL.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> Work space.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> < 0: If INFO = -K, the K-th argument had an illegal value,
-*> = 0: algorithm completed successfully, and
-*> > 0: the matrix A is either rank deficient with computed rank
-*> as returned in RANK, or is indefinite. See Section 7 of
-*> LAPACK Working Note #161 for further information.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL TOL
- INTEGER INFO, LDA, N, RANK
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), WORK( 2*N )
- INTEGER PIV( N )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL AJJ, SSTOP, STEMP
- INTEGER I, ITEMP, J, JB, K, NB, PVT
- LOGICAL UPPER
-* ..
-* .. External Functions ..
- REAL SLAMCH
- INTEGER ILAENV
- LOGICAL LSAME, SISNAN
- EXTERNAL SLAMCH, ILAENV, LSAME, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SPSTF2, SSCAL, SSWAP, SSYRK, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT, MAXLOC
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPSTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get block size
-*
- NB = ILAENV( 1, 'SPOTRF', UPLO, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL SPSTF2( UPLO, N, A( 1, 1 ), LDA, PIV, RANK, TOL, WORK,
- $ INFO )
- GO TO 200
-*
- ELSE
-*
-* Initialize PIV
-*
- DO 100 I = 1, N
- PIV( I ) = I
- 100 CONTINUE
-*
-* Compute stopping value
-*
- PVT = 1
- AJJ = A( PVT, PVT )
- DO I = 2, N
- IF( A( I, I ).GT.AJJ ) THEN
- PVT = I
- AJJ = A( PVT, PVT )
- END IF
- END DO
- IF( AJJ.EQ.ZERO.OR.SISNAN( AJJ ) ) THEN
- RANK = 0
- INFO = 1
- GO TO 200
- END IF
-*
-* Compute stopping value if not supplied
-*
- IF( TOL.LT.ZERO ) THEN
- SSTOP = N * SLAMCH( 'Epsilon' ) * AJJ
- ELSE
- SSTOP = TOL
- END IF
-*
-*
- IF( UPPER ) THEN
-*
-* Compute the Cholesky factorization P**T * A * P = U**T * U
-*
- DO 140 K = 1, N, NB
-*
-* Account for last block not being NB wide
-*
- JB = MIN( NB, N-K+1 )
-*
-* Set relevant part of first half of WORK to zero,
-* holds dot products
-*
- DO 110 I = K, N
- WORK( I ) = 0
- 110 CONTINUE
-*
- DO 130 J = K, K + JB - 1
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 120 I = J, N
-*
- IF( J.GT.K ) THEN
- WORK( I ) = WORK( I ) + A( J-1, I )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 120 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.SSTOP.OR.SISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 190
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL SSWAP( J-1, A( 1, J ), 1, A( 1, PVT ), 1 )
- IF( PVT.LT.N )
- $ CALL SSWAP( N-PVT, A( J, PVT+1 ), LDA,
- $ A( PVT, PVT+1 ), LDA )
- CALL SSWAP( PVT-J-1, A( J, J+1 ), LDA,
- $ A( J+1, PVT ), 1 )
-*
-* Swap dot products and PIV
-*
- STEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = STEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of row J.
-*
- IF( J.LT.N ) THEN
- CALL SGEMV( 'Trans', J-K, N-J, -ONE, A( K, J+1 ),
- $ LDA, A( K, J ), 1, ONE, A( J, J+1 ),
- $ LDA )
- CALL SSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
- END IF
-*
- 130 CONTINUE
-*
-* Update trailing matrix, J already incremented
-*
- IF( K+JB.LE.N ) THEN
- CALL SSYRK( 'Upper', 'Trans', N-J+1, JB, -ONE,
- $ A( K, J ), LDA, ONE, A( J, J ), LDA )
- END IF
-*
- 140 CONTINUE
-*
- ELSE
-*
-* Compute the Cholesky factorization P**T * A * P = L * L**T
-*
- DO 180 K = 1, N, NB
-*
-* Account for last block not being NB wide
-*
- JB = MIN( NB, N-K+1 )
-*
-* Set relevant part of first half of WORK to zero,
-* holds dot products
-*
- DO 150 I = K, N
- WORK( I ) = 0
- 150 CONTINUE
-*
- DO 170 J = K, K + JB - 1
-*
-* Find pivot, test for exit, else swap rows and columns
-* Update dot products, compute possible pivots which are
-* stored in the second half of WORK
-*
- DO 160 I = J, N
-*
- IF( J.GT.K ) THEN
- WORK( I ) = WORK( I ) + A( I, J-1 )**2
- END IF
- WORK( N+I ) = A( I, I ) - WORK( I )
-*
- 160 CONTINUE
-*
- IF( J.GT.1 ) THEN
- ITEMP = MAXLOC( WORK( (N+J):(2*N) ), 1 )
- PVT = ITEMP + J - 1
- AJJ = WORK( N+PVT )
- IF( AJJ.LE.SSTOP.OR.SISNAN( AJJ ) ) THEN
- A( J, J ) = AJJ
- GO TO 190
- END IF
- END IF
-*
- IF( J.NE.PVT ) THEN
-*
-* Pivot OK, so can now swap pivot rows and columns
-*
- A( PVT, PVT ) = A( J, J )
- CALL SSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA )
- IF( PVT.LT.N )
- $ CALL SSWAP( N-PVT, A( PVT+1, J ), 1,
- $ A( PVT+1, PVT ), 1 )
- CALL SSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ),
- $ LDA )
-*
-* Swap dot products and PIV
-*
- STEMP = WORK( J )
- WORK( J ) = WORK( PVT )
- WORK( PVT ) = STEMP
- ITEMP = PIV( PVT )
- PIV( PVT ) = PIV( J )
- PIV( J ) = ITEMP
- END IF
-*
- AJJ = SQRT( AJJ )
- A( J, J ) = AJJ
-*
-* Compute elements J+1:N of column J.
-*
- IF( J.LT.N ) THEN
- CALL SGEMV( 'No Trans', N-J, J-K, -ONE,
- $ A( J+1, K ), LDA, A( J, K ), LDA, ONE,
- $ A( J+1, J ), 1 )
- CALL SSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
- END IF
-*
- 170 CONTINUE
-*
-* Update trailing matrix, J already incremented
-*
- IF( K+JB.LE.N ) THEN
- CALL SSYRK( 'Lower', 'No Trans', N-J+1, JB, -ONE,
- $ A( J, K ), LDA, ONE, A( J, J ), LDA )
- END IF
-*
- 180 CONTINUE
-*
- END IF
- END IF
-*
-* Ran to completion, A has full rank
-*
- RANK = N
-*
- GO TO 200
- 190 CONTINUE
-*
-* Rank is the number of steps completed. Set INFO = 1 to signal
-* that the factorization cannot be used to solve a system.
-*
- RANK = J - 1
- INFO = 1
-*
- 200 CONTINUE
- RETURN
-*
-* End of SPSTRF
-*
- END
diff --git a/netlib/LAPACK/sptcon.f b/netlib/LAPACK/sptcon.f
deleted file mode 100644
index 2d2b9b9..0000000
--- a/netlib/LAPACK/sptcon.f
+++ /dev/null
@@ -1,221 +0,0 @@
-*> \brief \b SPTCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sptcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sptcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sptcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTCON( N, D, E, ANORM, RCOND, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTCON computes the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric positive definite tridiagonal matrix
-*> using the factorization A = L*D*L**T or A = U**T*D*U computed by
-*> SPTTRF.
-*>
-*> Norm(inv(A)) is computed by a direct method, and the reciprocal of
-*> the condition number is computed as
-*> RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> factorization of A, as computed by SPTTRF.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) off-diagonal elements of the unit bidiagonal factor
-*> U or L from the factorization of A, as computed by SPTTRF.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> The 1-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
-*> 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The method used is described in Nicholas J. Higham, "Efficient
-*> Algorithms for Computing the Condition Number of a Tridiagonal
-*> Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SPTCON( N, D, E, ANORM, RCOND, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IX
- REAL AINVNM
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- EXTERNAL ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPTCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that D(1:N) is positive.
-*
- DO 10 I = 1, N
- IF( D( I ).LE.ZERO )
- $ RETURN
- 10 CONTINUE
-*
-* Solve M(A) * x = e, where M(A) = (m(i,j)) is given by
-*
-* m(i,j) = abs(A(i,j)), i = j,
-* m(i,j) = -abs(A(i,j)), i .ne. j,
-*
-* and e = [ 1, 1, ..., 1 ]**T. Note M(A) = M(L)*D*M(L)**T.
-*
-* Solve M(L) * x = e.
-*
- WORK( 1 ) = ONE
- DO 20 I = 2, N
- WORK( I ) = ONE + WORK( I-1 )*ABS( E( I-1 ) )
- 20 CONTINUE
-*
-* Solve D * M(L)**T * x = b.
-*
- WORK( N ) = WORK( N ) / D( N )
- DO 30 I = N - 1, 1, -1
- WORK( I ) = WORK( I ) / D( I ) + WORK( I+1 )*ABS( E( I ) )
- 30 CONTINUE
-*
-* Compute AINVNM = max(x(i)), 1<=i<=n.
-*
- IX = ISAMAX( N, WORK, 1 )
- AINVNM = ABS( WORK( IX ) )
-*
-* Compute the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of SPTCON
-*
- END
diff --git a/netlib/LAPACK/spteqr.f b/netlib/LAPACK/spteqr.f
deleted file mode 100644
index 5986e09..0000000
--- a/netlib/LAPACK/spteqr.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b SPTEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTEQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spteqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spteqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spteqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPZ
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTEQR computes all eigenvalues and, optionally, eigenvectors of a
-*> symmetric positive definite tridiagonal matrix by first factoring the
-*> matrix using SPTTRF, and then calling SBDSQR to compute the singular
-*> values of the bidiagonal factor.
-*>
-*> This routine computes the eigenvalues of the positive definite
-*> tridiagonal matrix to high relative accuracy. This means that if the
-*> eigenvalues range over many orders of magnitude in size, then the
-*> small eigenvalues and corresponding eigenvectors will be computed
-*> more accurately than, for example, with the standard QR method.
-*>
-*> The eigenvectors of a full or band symmetric positive definite matrix
-*> can also be found if SSYTRD, SSPTRD, or SSBTRD has been used to
-*> reduce this matrix to tridiagonal form. (The reduction to tridiagonal
-*> form, however, may preclude the possibility of obtaining high
-*> relative accuracy in the small eigenvalues of the original matrix, if
-*> these eigenvalues range over many orders of magnitude.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only.
-*> = 'V': Compute eigenvectors of original symmetric
-*> matrix also. Array Z contains the orthogonal
-*> matrix used to reduce the original matrix to
-*> tridiagonal form.
-*> = 'I': Compute eigenvectors of tridiagonal matrix also.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal
-*> matrix.
-*> On normal exit, D contains the eigenvalues, in descending
-*> order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', the orthogonal matrix used in the
-*> reduction to tridiagonal form.
-*> On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
-*> original symmetric matrix;
-*> if COMPZ = 'I', the orthonormal eigenvectors of the
-*> tridiagonal matrix.
-*> If INFO > 0 on exit, Z contains the eigenvectors associated
-*> with only the stored eigenvalues.
-*> If COMPZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> COMPZ = 'V' or 'I', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, and i is:
-*> <= N the Cholesky factorization of the matrix could
-*> not be performed because the i-th principal minor
-*> was not positive definite.
-*> > N the SVD algorithm failed to converge;
-*> if INFO = N+i, i off-diagonal elements of the
-*> bidiagonal factor did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTcomputational
-*
-* =====================================================================
- SUBROUTINE SPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER COMPZ
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SBDSQR, SLASET, SPTTRF, XERBLA
-* ..
-* .. Local Arrays ..
- REAL C( 1, 1 ), VT( 1, 1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ICOMPZ, NRU
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ICOMPZ = 0
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ICOMPZ = 2
- ELSE
- ICOMPZ = -1
- END IF
- IF( ICOMPZ.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
- $ N ) ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPTEQR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ICOMPZ.GT.0 )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
- IF( ICOMPZ.EQ.2 )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-* Call SPTTRF to factor the matrix.
-*
- CALL SPTTRF( N, D, E, INFO )
- IF( INFO.NE.0 )
- $ RETURN
- DO 10 I = 1, N
- D( I ) = SQRT( D( I ) )
- 10 CONTINUE
- DO 20 I = 1, N - 1
- E( I ) = E( I )*D( I )
- 20 CONTINUE
-*
-* Call SBDSQR to compute the singular values/vectors of the
-* bidiagonal factor.
-*
- IF( ICOMPZ.GT.0 ) THEN
- NRU = N
- ELSE
- NRU = 0
- END IF
- CALL SBDSQR( 'Lower', N, 0, NRU, 0, D, E, VT, 1, Z, LDZ, C, 1,
- $ WORK, INFO )
-*
-* Square the singular values.
-*
- IF( INFO.EQ.0 ) THEN
- DO 30 I = 1, N
- D( I ) = D( I )*D( I )
- 30 CONTINUE
- ELSE
- INFO = N + INFO
- END IF
-*
- RETURN
-*
-* End of SPTEQR
-*
- END
diff --git a/netlib/LAPACK/sptrfs.f b/netlib/LAPACK/sptrfs.f
deleted file mode 100644
index f39a408..0000000
--- a/netlib/LAPACK/sptrfs.f
+++ /dev/null
@@ -1,395 +0,0 @@
-*> \brief \b SPTRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sptrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sptrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sptrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR,
-* BERR, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ E( * ), EF( * ), FERR( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric positive definite
-*> and tridiagonal, and provides error bounds and backward error
-*> estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in] DF
-*> \verbatim
-*> DF is REAL array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> factorization computed by SPTTRF.
-*> \endverbatim
-*>
-*> \param[in] EF
-*> \verbatim
-*> EF is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal factor
-*> L from the factorization computed by SPTTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SPTTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j).
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTcomputational
-*
-* =====================================================================
- SUBROUTINE SPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR,
- $ BERR, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ E( * ), EF( * ), FERR( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER COUNT, I, IX, J, NZ
- REAL BI, CX, DX, EPS, EX, LSTRES, S, SAFE1, SAFE2,
- $ SAFMIN
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SPTTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SLAMCH
- EXTERNAL ISAMAX, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPTRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = 4
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 90 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X. Also compute
-* abs(A)*abs(x) + abs(b) for use in the backward error bound.
-*
- IF( N.EQ.1 ) THEN
- BI = B( 1, J )
- DX = D( 1 )*X( 1, J )
- WORK( N+1 ) = BI - DX
- WORK( 1 ) = ABS( BI ) + ABS( DX )
- ELSE
- BI = B( 1, J )
- DX = D( 1 )*X( 1, J )
- EX = E( 1 )*X( 2, J )
- WORK( N+1 ) = BI - DX - EX
- WORK( 1 ) = ABS( BI ) + ABS( DX ) + ABS( EX )
- DO 30 I = 2, N - 1
- BI = B( I, J )
- CX = E( I-1 )*X( I-1, J )
- DX = D( I )*X( I, J )
- EX = E( I )*X( I+1, J )
- WORK( N+I ) = BI - CX - DX - EX
- WORK( I ) = ABS( BI ) + ABS( CX ) + ABS( DX ) + ABS( EX )
- 30 CONTINUE
- BI = B( N, J )
- CX = E( N-1 )*X( N-1, J )
- DX = D( N )*X( N, J )
- WORK( N+N ) = BI - CX - DX
- WORK( N ) = ABS( BI ) + ABS( CX ) + ABS( DX )
- END IF
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- S = ZERO
- DO 40 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 40 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SPTTRS( N, 1, DF, EF, WORK( N+1 ), N, INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
- DO 50 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 50 CONTINUE
- IX = ISAMAX( N, WORK, 1 )
- FERR( J ) = WORK( IX )
-*
-* Estimate the norm of inv(A).
-*
-* Solve M(A) * x = e, where M(A) = (m(i,j)) is given by
-*
-* m(i,j) = abs(A(i,j)), i = j,
-* m(i,j) = -abs(A(i,j)), i .ne. j,
-*
-* and e = [ 1, 1, ..., 1 ]**T. Note M(A) = M(L)*D*M(L)**T.
-*
-* Solve M(L) * x = e.
-*
- WORK( 1 ) = ONE
- DO 60 I = 2, N
- WORK( I ) = ONE + WORK( I-1 )*ABS( EF( I-1 ) )
- 60 CONTINUE
-*
-* Solve D * M(L)**T * x = b.
-*
- WORK( N ) = WORK( N ) / DF( N )
- DO 70 I = N - 1, 1, -1
- WORK( I ) = WORK( I ) / DF( I ) + WORK( I+1 )*ABS( EF( I ) )
- 70 CONTINUE
-*
-* Compute norm(inv(A)) = max(x(i)), 1<=i<=n.
-*
- IX = ISAMAX( N, WORK, 1 )
- FERR( J ) = FERR( J )*ABS( WORK( IX ) )
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 80 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 80 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 90 CONTINUE
-*
- RETURN
-*
-* End of SPTRFS
-*
- END
diff --git a/netlib/LAPACK/sptsv.f b/netlib/LAPACK/sptsv.f
deleted file mode 100644
index c0dc904..0000000
--- a/netlib/LAPACK/sptsv.f
+++ /dev/null
@@ -1,167 +0,0 @@
-*> \brief <b> SPTSV computes the solution to system of linear equations A * X = B for PT matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sptsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sptsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sptsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTSV( N, NRHS, D, E, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTSV computes the solution to a real system of linear equations
-*> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
-*> matrix, and X and B are N-by-NRHS matrices.
-*>
-*> A is factored as A = L*D*L**T, and the factored form of A is then
-*> used to solve the system of equations.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A. On exit, the n diagonal elements of the diagonal matrix
-*> D from the factorization A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A. On exit, the (n-1) subdiagonal elements of the
-*> unit bidiagonal factor L from the L*D*L**T factorization of
-*> A. (E can also be regarded as the superdiagonal of the unit
-*> bidiagonal factor U from the U**T*D*U factorization of A.)
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the leading minor of order i is not
-*> positive definite, and the solution has not been
-*> computed. The factorization has not been completed
-*> unless i = N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTsolve
-*
-* =====================================================================
- SUBROUTINE SPTSV( N, NRHS, D, E, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL SPTTRF, SPTTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPTSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the L*D*L**T (or U**T*D*U) factorization of A.
-*
- CALL SPTTRF( N, D, E, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SPTTRS( N, NRHS, D, E, B, LDB, INFO )
- END IF
- RETURN
-*
-* End of SPTSV
-*
- END
diff --git a/netlib/LAPACK/sptsvx.f b/netlib/LAPACK/sptsvx.f
deleted file mode 100644
index 3c35fd9..0000000
--- a/netlib/LAPACK/sptsvx.f
+++ /dev/null
@@ -1,336 +0,0 @@
-*> \brief <b> SPTSVX computes the solution to system of linear equations A * X = B for PT matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sptsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sptsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sptsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
-* RCOND, FERR, BERR, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT
-* INTEGER INFO, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ E( * ), EF( * ), FERR( * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTSVX uses the factorization A = L*D*L**T to compute the solution
-*> to a real system of linear equations A*X = B, where A is an N-by-N
-*> symmetric positive definite tridiagonal matrix and X and B are
-*> N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
-*> is a unit lower bidiagonal matrix and D is diagonal. The
-*> factorization can also be regarded as having the form
-*> A = U**T*D*U.
-*>
-*> 2. If the leading i-by-i principal minor is not positive definite,
-*> then the routine returns with INFO = i. Otherwise, the factored
-*> form of A is used to estimate the condition number of the matrix
-*> A. If the reciprocal of the condition number is less than machine
-*> precision, INFO = N+1 is returned as a warning, but the routine
-*> still goes on to solve for X and compute error bounds as
-*> described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': On entry, DF and EF contain the factored form of A.
-*> D, E, DF, and EF will not be modified.
-*> = 'N': The matrix A will be copied to DF and EF and
-*> factored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the tridiagonal matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] DF
-*> \verbatim
-*> DF is REAL array, dimension (N)
-*> If FACT = 'F', then DF is an input argument and on entry
-*> contains the n diagonal elements of the diagonal matrix D
-*> from the L*D*L**T factorization of A.
-*> If FACT = 'N', then DF is an output argument and on exit
-*> contains the n diagonal elements of the diagonal matrix D
-*> from the L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] EF
-*> \verbatim
-*> EF is REAL array, dimension (N-1)
-*> If FACT = 'F', then EF is an input argument and on entry
-*> contains the (n-1) subdiagonal elements of the unit
-*> bidiagonal factor L from the L*D*L**T factorization of A.
-*> If FACT = 'N', then EF is an output argument and on exit
-*> contains the (n-1) subdiagonal elements of the unit
-*> bidiagonal factor L from the L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal condition number of the matrix A. If RCOND
-*> is less than the machine precision (in particular, if
-*> RCOND = 0), the matrix is singular to working precision.
-*> This condition is indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j).
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in any
-*> element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: the leading minor of order i of A is
-*> not positive definite, so the factorization
-*> could not be completed, and the solution has not
-*> been computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTsolve
-*
-* =====================================================================
- SUBROUTINE SPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
- $ RCOND, FERR, BERR, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT
- INTEGER INFO, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ E( * ), EF( * ), FERR( * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT
- REAL ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANST
- EXTERNAL LSAME, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SPTCON, SPTRFS, SPTTRF, SPTTRS,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPTSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the L*D*L**T (or U**T*D*U) factorization of A.
-*
- CALL SCOPY( N, D, 1, DF, 1 )
- IF( N.GT.1 )
- $ CALL SCOPY( N-1, E, 1, EF, 1 )
- CALL SPTTRF( N, DF, EF, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = SLANST( '1', N, D, E )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SPTCON( N, DF, EF, ANORM, RCOND, WORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SPTTRS( N, NRHS, DF, EF, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL SPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR,
- $ WORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of SPTSVX
-*
- END
diff --git a/netlib/LAPACK/spttrf.f b/netlib/LAPACK/spttrf.f
deleted file mode 100644
index 9fa77c2..0000000
--- a/netlib/LAPACK/spttrf.f
+++ /dev/null
@@ -1,211 +0,0 @@
-*> \brief \b SPTTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spttrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spttrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spttrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTTRF( N, D, E, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTTRF computes the L*D*L**T factorization of a real symmetric
-*> positive definite tridiagonal matrix A. The factorization may also
-*> be regarded as having the form A = U**T*D*U.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A. On exit, the n diagonal elements of the diagonal matrix
-*> D from the L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A. On exit, the (n-1) subdiagonal elements of the
-*> unit bidiagonal factor L from the L*D*L**T factorization of A.
-*> E can also be regarded as the superdiagonal of the unit
-*> bidiagonal factor U from the U**T*D*U factorization of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, the leading minor of order k is not
-*> positive definite; if k < N, the factorization could not
-*> be completed, while if k = N, the factorization was
-*> completed, but D(N) <= 0.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SPTTRF( N, D, E, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I4
- REAL EI
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'SPTTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Compute the L*D*L**T (or U**T*D*U) factorization of A.
-*
- I4 = MOD( N-1, 4 )
- DO 10 I = 1, I4
- IF( D( I ).LE.ZERO ) THEN
- INFO = I
- GO TO 30
- END IF
- EI = E( I )
- E( I ) = EI / D( I )
- D( I+1 ) = D( I+1 ) - E( I )*EI
- 10 CONTINUE
-*
- DO 20 I = I4 + 1, N - 4, 4
-*
-* Drop out of the loop if d(i) <= 0: the matrix is not positive
-* definite.
-*
- IF( D( I ).LE.ZERO ) THEN
- INFO = I
- GO TO 30
- END IF
-*
-* Solve for e(i) and d(i+1).
-*
- EI = E( I )
- E( I ) = EI / D( I )
- D( I+1 ) = D( I+1 ) - E( I )*EI
-*
- IF( D( I+1 ).LE.ZERO ) THEN
- INFO = I + 1
- GO TO 30
- END IF
-*
-* Solve for e(i+1) and d(i+2).
-*
- EI = E( I+1 )
- E( I+1 ) = EI / D( I+1 )
- D( I+2 ) = D( I+2 ) - E( I+1 )*EI
-*
- IF( D( I+2 ).LE.ZERO ) THEN
- INFO = I + 2
- GO TO 30
- END IF
-*
-* Solve for e(i+2) and d(i+3).
-*
- EI = E( I+2 )
- E( I+2 ) = EI / D( I+2 )
- D( I+3 ) = D( I+3 ) - E( I+2 )*EI
-*
- IF( D( I+3 ).LE.ZERO ) THEN
- INFO = I + 3
- GO TO 30
- END IF
-*
-* Solve for e(i+3) and d(i+4).
-*
- EI = E( I+3 )
- E( I+3 ) = EI / D( I+3 )
- D( I+4 ) = D( I+4 ) - E( I+3 )*EI
- 20 CONTINUE
-*
-* Check d(n) for positive definiteness.
-*
- IF( D( N ).LE.ZERO )
- $ INFO = N
-*
- 30 CONTINUE
- RETURN
-*
-* End of SPTTRF
-*
- END
diff --git a/netlib/LAPACK/spttrs.f b/netlib/LAPACK/spttrs.f
deleted file mode 100644
index 7ef2bb3..0000000
--- a/netlib/LAPACK/spttrs.f
+++ /dev/null
@@ -1,182 +0,0 @@
-*> \brief \b SPTTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spttrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spttrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spttrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTTRS( N, NRHS, D, E, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTTRS solves a tridiagonal system of the form
-*> A * X = B
-*> using the L*D*L**T factorization of A computed by SPTTRF. D is a
-*> diagonal matrix specified in the vector D, L is a unit bidiagonal
-*> matrix whose subdiagonal is specified in the vector E, and X and B
-*> are N by NRHS matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal factor
-*> L from the L*D*L**T factorization of A. E can also be regarded
-*> as the superdiagonal of the unit bidiagonal factor U from the
-*> factorization A = U**T*D*U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side vectors B for the system of
-*> linear equations.
-*> On exit, the solution vectors, X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTcomputational
-*
-* =====================================================================
- SUBROUTINE SPTTRS( N, NRHS, D, E, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER J, JB, NB
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SPTTS2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SPTTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Determine the number of right-hand sides to solve at a time.
-*
- IF( NRHS.EQ.1 ) THEN
- NB = 1
- ELSE
- NB = MAX( 1, ILAENV( 1, 'SPTTRS', ' ', N, NRHS, -1, -1 ) )
- END IF
-*
- IF( NB.GE.NRHS ) THEN
- CALL SPTTS2( N, NRHS, D, E, B, LDB )
- ELSE
- DO 10 J = 1, NRHS, NB
- JB = MIN( NRHS-J+1, NB )
- CALL SPTTS2( N, JB, D, E, B( 1, J ), LDB )
- 10 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SPTTRS
-*
- END
diff --git a/netlib/LAPACK/sptts2.f b/netlib/LAPACK/sptts2.f
deleted file mode 100644
index 3dd6bc6..0000000
--- a/netlib/LAPACK/sptts2.f
+++ /dev/null
@@ -1,158 +0,0 @@
-*> \brief \b SPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SPTTS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sptts2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sptts2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sptts2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SPTTS2( N, NRHS, D, E, B, LDB )
-*
-* .. Scalar Arguments ..
-* INTEGER LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL B( LDB, * ), D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SPTTS2 solves a tridiagonal system of the form
-*> A * X = B
-*> using the L*D*L**T factorization of A computed by SPTTRF. D is a
-*> diagonal matrix specified in the vector D, L is a unit bidiagonal
-*> matrix whose subdiagonal is specified in the vector E, and X and B
-*> are N by NRHS matrices.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the diagonal matrix D from the
-*> L*D*L**T factorization of A.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the unit bidiagonal factor
-*> L from the L*D*L**T factorization of A. E can also be regarded
-*> as the superdiagonal of the unit bidiagonal factor U from the
-*> factorization A = U**T*D*U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side vectors B for the system of
-*> linear equations.
-*> On exit, the solution vectors, X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realPTcomputational
-*
-* =====================================================================
- SUBROUTINE SPTTS2( N, NRHS, D, E, B, LDB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL B( LDB, * ), D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- IF( N.EQ.1 )
- $ CALL SSCAL( NRHS, 1. / D( 1 ), B, LDB )
- RETURN
- END IF
-*
-* Solve A * X = B using the factorization A = L*D*L**T,
-* overwriting each right hand side vector with its solution.
-*
- DO 30 J = 1, NRHS
-*
-* Solve L * x = b.
-*
- DO 10 I = 2, N
- B( I, J ) = B( I, J ) - B( I-1, J )*E( I-1 )
- 10 CONTINUE
-*
-* Solve D * L**T * x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- DO 20 I = N - 1, 1, -1
- B( I, J ) = B( I, J ) / D( I ) - B( I+1, J )*E( I )
- 20 CONTINUE
- 30 CONTINUE
-*
- RETURN
-*
-* End of SPTTS2
-*
- END
diff --git a/netlib/LAPACK/srscl.f b/netlib/LAPACK/srscl.f
deleted file mode 100644
index dacc5a7..0000000
--- a/netlib/LAPACK/srscl.f
+++ /dev/null
@@ -1,174 +0,0 @@
-*> \brief \b SRSCL multiplies a vector by the reciprocal of a real scalar.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SRSCL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/srscl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/srscl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/srscl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SRSCL( N, SA, SX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* REAL SA
-* ..
-* .. Array Arguments ..
-* REAL SX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SRSCL multiplies an n-element real vector x by the real scalar 1/a.
-*> This is done without overflow or underflow as long as
-*> the final result x/a does not overflow or underflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of components of the vector x.
-*> \endverbatim
-*>
-*> \param[in] SA
-*> \verbatim
-*> SA is REAL
-*> The scalar a which is used to divide each component of x.
-*> SA must be >= 0, or the subroutine will divide by zero.
-*> \endverbatim
-*>
-*> \param[in,out] SX
-*> \verbatim
-*> SX is REAL array, dimension
-*> (1+(N-1)*abs(INCX))
-*> The n-element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of the vector SX.
-*> > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE SRSCL( N, SA, SX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- REAL SA
-* ..
-* .. Array Arguments ..
- REAL SX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DONE
- REAL BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLABAD, SSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Get machine parameters
-*
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
-* Initialize the denominator to SA and the numerator to 1.
-*
- CDEN = SA
- CNUM = ONE
-*
- 10 CONTINUE
- CDEN1 = CDEN*SMLNUM
- CNUM1 = CNUM / BIGNUM
- IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
-*
-* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
-*
- MUL = SMLNUM
- DONE = .FALSE.
- CDEN = CDEN1
- ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
-*
-* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
-*
- MUL = BIGNUM
- DONE = .FALSE.
- CNUM = CNUM1
- ELSE
-*
-* Multiply X by CNUM / CDEN and return.
-*
- MUL = CNUM / CDEN
- DONE = .TRUE.
- END IF
-*
-* Scale the vector X by MUL
-*
- CALL SSCAL( N, MUL, SX, INCX )
-*
- IF( .NOT.DONE )
- $ GO TO 10
-*
- RETURN
-*
-* End of SRSCL
-*
- END
diff --git a/netlib/LAPACK/ssbev.f b/netlib/LAPACK/ssbev.f
deleted file mode 100644
index d9f67d3..0000000
--- a/netlib/LAPACK/ssbev.f
+++ /dev/null
@@ -1,287 +0,0 @@
-*> \brief <b> SSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KD, LDAB, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBEV computes all the eigenvalues and, optionally, eigenvectors of
-*> a real symmetric band matrix A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, AB is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the first
-*> superdiagonal and the diagonal of the tridiagonal matrix T
-*> are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
-*> the diagonal and first subdiagonal of T are returned in the
-*> first two rows of AB.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD + 1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (max(1,3*N-2))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KD, LDAB, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, WANTZ
- INTEGER IINFO, IMAX, INDE, INDWRK, ISCALE
- REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASCL, SSBTRD, SSCAL, SSTEQR, SSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBEV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( LOWER ) THEN
- W( 1 ) = AB( 1, 1 )
- ELSE
- W( 1 ) = AB( KD+1, 1 )
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = SLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- ELSE
- CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- END IF
- END IF
-*
-* Call SSBTRD to reduce symmetric band matrix to tridiagonal form.
-*
- INDE = 1
- INDWRK = INDE + N
- CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
- RETURN
-*
-* End of SSBEV
-*
- END
diff --git a/netlib/LAPACK/ssbevd.f b/netlib/LAPACK/ssbevd.f
deleted file mode 100644
index 292bd1c..0000000
--- a/netlib/LAPACK/ssbevd.f
+++ /dev/null
@@ -1,360 +0,0 @@
-*> \brief <b> SSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
-* LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBEVD computes all the eigenvalues and, optionally, eigenvectors of
-*> a real symmetric band matrix A. If eigenvectors are desired, it uses
-*> a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, AB is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the first
-*> superdiagonal and the diagonal of the tridiagonal matrix T
-*> are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
-*> the diagonal and first subdiagonal of T are returned in the
-*> first two rows of AB.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD + 1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> IF N <= 1, LWORK must be at least 1.
-*> If JOBZ = 'N' and N > 2, LWORK must be at least 2*N.
-*> If JOBZ = 'V' and N > 2, LWORK must be at least
-*> ( 1 + 5*N + 2*N**2 ).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
- $ LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, LQUERY, WANTZ
- INTEGER IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
- $ LLWRK2, LWMIN
- REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLACPY, SLASCL, SSBTRD, SSCAL, SSTEDC,
- $ SSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 5*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
- END IF
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -6
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = AB( 1, 1 )
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = SLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- ELSE
- CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- END IF
- END IF
-*
-* Call SSBTRD to reduce symmetric band matrix to tridiagonal form.
-*
- INDE = 1
- INDWRK = INDE + N
- INDWK2 = INDWRK + N*N
- LLWRK2 = LWORK - INDWK2 + 1
- CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, call SSTEDC.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
- $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
- CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N,
- $ ZERO, WORK( INDWK2 ), N )
- CALL SLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL SSCAL( N, ONE / SIGMA, W, 1 )
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of SSBEVD
-*
- END
diff --git a/netlib/LAPACK/ssbevx.f b/netlib/LAPACK/ssbevx.f
deleted file mode 100644
index 0fa1ac4..0000000
--- a/netlib/LAPACK/ssbevx.f
+++ /dev/null
@@ -1,536 +0,0 @@
-*> \brief <b> SSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
-* VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
-* IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric band matrix A. Eigenvalues and eigenvectors can
-*> be selected by specifying either a range of values or a range of
-*> indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found;
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found;
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*>
-*> On exit, AB is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the first
-*> superdiagonal and the diagonal of the tridiagonal matrix T
-*> are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
-*> the diagonal and first subdiagonal of T are returned in the
-*> first two rows of AB.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD + 1.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> If JOBZ = 'V', the N-by-N orthogonal matrix used in the
-*> reduction to tridiagonal form.
-*> If JOBZ = 'N', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. If JOBZ = 'V', then
-*> LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing AB to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (7*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
- $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
- $ IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ
- CHARACTER ORDER
- INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
- $ INDISP, INDIWO, INDWRK, ISCALE, ITMP1, J, JJ,
- $ NSPLIT
- REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SSBTRD, SSCAL,
- $ SSTEBZ, SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
- LOWER = LSAME( UPLO, 'L' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -7
- ELSE IF( WANTZ .AND. LDQ.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -11
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -13
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
- $ INFO = -18
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBEVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- M = 1
- IF( LOWER ) THEN
- TMP1 = AB( 1, 1 )
- ELSE
- TMP1 = AB( KD+1, 1 )
- END IF
- IF( VALEIG ) THEN
- IF( .NOT.( VL.LT.TMP1 .AND. VU.GE.TMP1 ) )
- $ M = 0
- END IF
- IF( M.EQ.1 ) THEN
- W( 1 ) = TMP1
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- END IF
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF ( VALEIG ) THEN
- VLL = VL
- VUU = VU
- ELSE
- VLL = ZERO
- VUU = ZERO
- ENDIF
- ANRM = SLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- ELSE
- CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
- END IF
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* Call SSBTRD to reduce symmetric band matrix to tridiagonal form.
-*
- INDD = 1
- INDE = INDD + N
- INDWRK = INDE + N
- CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, WORK( INDD ),
- $ WORK( INDE ), Q, LDQ, WORK( INDWRK ), IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal
-* to zero, then call SSTERF or SSTEQR. If this fails for some
-* eigenvalue, then try SSTEBZ.
-*
- TEST = .FALSE.
- IF (INDEIG) THEN
- IF (IL.EQ.1 .AND. IU.EQ.N) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
- CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- IF( .NOT.WANTZ ) THEN
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL SLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 30
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by SSTEIN.
-*
- DO 20 J = 1, M
- CALL SCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
- CALL SGEMV( 'N', N, N, ONE, Q, LDQ, WORK, 1, ZERO,
- $ Z( 1, J ), 1 )
- 20 CONTINUE
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 30 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 50 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 40 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 40 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSBEVX
-*
- END
diff --git a/netlib/LAPACK/ssbgst.f b/netlib/LAPACK/ssbgst.f
deleted file mode 100644
index a8addb8..0000000
--- a/netlib/LAPACK/ssbgst.f
+++ /dev/null
@@ -1,1434 +0,0 @@
-*> \brief \b SSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBGST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbgst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbgst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbgst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X,
-* LDX, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO, VECT
-* INTEGER INFO, KA, KB, LDAB, LDBB, LDX, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), BB( LDBB, * ), WORK( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBGST reduces a real symmetric-definite banded generalized
-*> eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
-*> such that C has the same bandwidth as A.
-*>
-*> B must have been previously factorized as S**T*S by SPBSTF, using a
-*> split Cholesky factorization. A is overwritten by C = X**T*A*X, where
-*> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the
-*> bandwidth of A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'N': do not form the transformation matrix X;
-*> = 'V': form X.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the transformed matrix X**T*A*X, stored in the same
-*> format as A.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in] BB
-*> \verbatim
-*> BB is REAL array, dimension (LDBB,N)
-*> The banded factor S from the split Cholesky factorization of
-*> B, as returned by SPBSTF, stored in the first KB+1 rows of
-*> the array.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,N)
-*> If VECT = 'V', the n-by-n matrix X.
-*> If VECT = 'N', the array X is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X.
-*> LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X,
- $ LDX, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO, VECT
- INTEGER INFO, KA, KB, LDAB, LDBB, LDX, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), BB( LDBB, * ), WORK( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPDATE, UPPER, WANTX
- INTEGER I, I0, I1, I2, INCA, J, J1, J1T, J2, J2T, K,
- $ KA1, KB1, KBT, L, M, NR, NRT, NX
- REAL BII, RA, RA1, T
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGER, SLAR2V, SLARGV, SLARTG, SLARTV, SLASET,
- $ SROT, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- WANTX = LSAME( VECT, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- KA1 = KA + 1
- KB1 = KB + 1
- INFO = 0
- IF( .NOT.WANTX .AND. .NOT.LSAME( VECT, 'N' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KA.LT.0 ) THEN
- INFO = -4
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -7
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -9
- ELSE IF( LDX.LT.1 .OR. WANTX .AND. LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBGST', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- INCA = LDAB*KA1
-*
-* Initialize X to the unit matrix, if needed
-*
- IF( WANTX )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, X, LDX )
-*
-* Set M to the splitting point m. It must be the same value as is
-* used in SPBSTF. The chosen value allows the arrays WORK and RWORK
-* to be of dimension (N).
-*
- M = ( N+KB ) / 2
-*
-* The routine works in two phases, corresponding to the two halves
-* of the split Cholesky factorization of B as S**T*S where
-*
-* S = ( U )
-* ( M L )
-*
-* with U upper triangular of order m, and L lower triangular of
-* order n-m. S has the same bandwidth as B.
-*
-* S is treated as a product of elementary matrices:
-*
-* S = S(m)*S(m-1)*...*S(2)*S(1)*S(m+1)*S(m+2)*...*S(n-1)*S(n)
-*
-* where S(i) is determined by the i-th row of S.
-*
-* In phase 1, the index i takes the values n, n-1, ... , m+1;
-* in phase 2, it takes the values 1, 2, ... , m.
-*
-* For each value of i, the current matrix A is updated by forming
-* inv(S(i))**T*A*inv(S(i)). This creates a triangular bulge outside
-* the band of A. The bulge is then pushed down toward the bottom of
-* A in phase 1, and up toward the top of A in phase 2, by applying
-* plane rotations.
-*
-* There are kb*(kb+1)/2 elements in the bulge, but at most 2*kb-1
-* of them are linearly independent, so annihilating a bulge requires
-* only 2*kb-1 plane rotations. The rotations are divided into a 1st
-* set of kb-1 rotations, and a 2nd set of kb rotations.
-*
-* Wherever possible, rotations are generated and applied in vector
-* operations of length NR between the indices J1 and J2 (sometimes
-* replaced by modified values NRT, J1T or J2T).
-*
-* The cosines and sines of the rotations are stored in the array
-* WORK. The cosines of the 1st set of rotations are stored in
-* elements n+2:n+m-kb-1 and the sines of the 1st set in elements
-* 2:m-kb-1; the cosines of the 2nd set are stored in elements
-* n+m-kb+1:2*n and the sines of the second set in elements m-kb+1:n.
-*
-* The bulges are not formed explicitly; nonzero elements outside the
-* band are created only when they are required for generating new
-* rotations; they are stored in the array WORK, in positions where
-* they are later overwritten by the sines of the rotations which
-* annihilate them.
-*
-* **************************** Phase 1 *****************************
-*
-* The logical structure of this phase is:
-*
-* UPDATE = .TRUE.
-* DO I = N, M + 1, -1
-* use S(i) to update A and create a new bulge
-* apply rotations to push all bulges KA positions downward
-* END DO
-* UPDATE = .FALSE.
-* DO I = M + KA + 1, N - 1
-* apply rotations to push all bulges KA positions downward
-* END DO
-*
-* To avoid duplicating code, the two loops are merged.
-*
- UPDATE = .TRUE.
- I = N + 1
- 10 CONTINUE
- IF( UPDATE ) THEN
- I = I - 1
- KBT = MIN( KB, I-1 )
- I0 = I - 1
- I1 = MIN( N, I+KA )
- I2 = I - KBT + KA1
- IF( I.LT.M+1 ) THEN
- UPDATE = .FALSE.
- I = I + 1
- I0 = M
- IF( KA.EQ.0 )
- $ GO TO 480
- GO TO 10
- END IF
- ELSE
- I = I + KA
- IF( I.GT.N-1 )
- $ GO TO 480
- END IF
-*
- IF( UPPER ) THEN
-*
-* Transform A, working with the upper triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( KB1, I )
- DO 20 J = I, I1
- AB( I-J+KA1, J ) = AB( I-J+KA1, J ) / BII
- 20 CONTINUE
- DO 30 J = MAX( 1, I-KA ), I
- AB( J-I+KA1, I ) = AB( J-I+KA1, I ) / BII
- 30 CONTINUE
- DO 60 K = I - KBT, I - 1
- DO 40 J = I - KBT, K
- AB( J-K+KA1, K ) = AB( J-K+KA1, K ) -
- $ BB( J-I+KB1, I )*AB( K-I+KA1, I ) -
- $ BB( K-I+KB1, I )*AB( J-I+KA1, I ) +
- $ AB( KA1, I )*BB( J-I+KB1, I )*
- $ BB( K-I+KB1, I )
- 40 CONTINUE
- DO 50 J = MAX( 1, I-KA ), I - KBT - 1
- AB( J-K+KA1, K ) = AB( J-K+KA1, K ) -
- $ BB( K-I+KB1, I )*AB( J-I+KA1, I )
- 50 CONTINUE
- 60 CONTINUE
- DO 80 J = I, I1
- DO 70 K = MAX( J-KA, I-KBT ), I - 1
- AB( K-J+KA1, J ) = AB( K-J+KA1, J ) -
- $ BB( K-I+KB1, I )*AB( I-J+KA1, J )
- 70 CONTINUE
- 80 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL SSCAL( N-M, ONE / BII, X( M+1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL SGER( N-M, KBT, -ONE, X( M+1, I ), 1,
- $ BB( KB1-KBT, I ), 1, X( M+1, I-KBT ), LDX )
- END IF
-*
-* store a(i,i1) in RA1 for use in next loop over K
-*
- RA1 = AB( I-I1+KA1, I1 )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions down toward the bottom of the
-* band
-*
- DO 130 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I-K+KA.LT.N .AND. I-K.GT.1 ) THEN
-*
-* generate rotation to annihilate a(i,i-k+ka+1)
-*
- CALL SLARTG( AB( K+1, I-K+KA ), RA1,
- $ WORK( N+I-K+KA-M ), WORK( I-K+KA-M ),
- $ RA )
-*
-* create nonzero element a(i-k,i-k+ka+1) outside the
-* band and store it in WORK(i-k)
-*
- T = -BB( KB1-K, I )*RA1
- WORK( I-K ) = WORK( N+I-K+KA-M )*T -
- $ WORK( I-K+KA-M )*AB( 1, I-K+KA )
- AB( 1, I-K+KA ) = WORK( I-K+KA-M )*T +
- $ WORK( N+I-K+KA-M )*AB( 1, I-K+KA )
- RA1 = RA
- END IF
- END IF
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MAX( J2, I+2*KA-K+1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( N-J2T+KA ) / KA1
- DO 90 J = J2T, J1, KA1
-*
-* create nonzero element a(j-ka,j+1) outside the band
-* and store it in WORK(j-m)
-*
- WORK( J-M ) = WORK( J-M )*AB( 1, J+1 )
- AB( 1, J+1 ) = WORK( N+J-M )*AB( 1, J+1 )
- 90 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL SLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), KA1,
- $ WORK( N+J2T-M ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the right
-*
- DO 100 L = 1, KA - 1
- CALL SLARTV( NR, AB( KA1-L, J2 ), INCA,
- $ AB( KA-L, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 100 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( KA1, J2 ), AB( KA1, J2+1 ),
- $ AB( KA, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the left
-*
- DO 110 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J2+KA1-L ), INCA,
- $ AB( L+1, J2+KA1-L ), INCA,
- $ WORK( N+J2-M ), WORK( J2-M ), KA1 )
- 110 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 120 J = J2, J1, KA1
- CALL SROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J-M ), WORK( J-M ) )
- 120 CONTINUE
- END IF
- 130 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.LE.N .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i-kbt,i-kbt+ka+1) outside the
-* band and store it in WORK(i-kbt)
-*
- WORK( I-KBT ) = -BB( KB1-KBT, I )*RA1
- END IF
- END IF
-*
- DO 170 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I - K - 1 + MAX( 2, K-I0+1 )*KA1
- ELSE
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the left
-*
- DO 140 L = KB - K, 1, -1
- NRT = ( N-J2+KA+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J2-L+1 ), INCA,
- $ AB( L+1, J2-L+1 ), INCA, WORK( N+J2-KA ),
- $ WORK( J2-KA ), KA1 )
- 140 CONTINUE
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- DO 150 J = J1, J2, -KA1
- WORK( J ) = WORK( J-KA )
- WORK( N+J ) = WORK( N+J-KA )
- 150 CONTINUE
- DO 160 J = J2, J1, KA1
-*
-* create nonzero element a(j-ka,j+1) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( 1, J+1 )
- AB( 1, J+1 ) = WORK( N+J )*AB( 1, J+1 )
- 160 CONTINUE
- IF( UPDATE ) THEN
- IF( I-K.LT.N-KA .AND. K.LE.KBT )
- $ WORK( I-K+KA ) = WORK( I-K )
- END IF
- 170 CONTINUE
-*
- DO 210 K = KB, 1, -1
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL SLARGV( NR, AB( 1, J2 ), INCA, WORK( J2 ), KA1,
- $ WORK( N+J2 ), KA1 )
-*
-* apply rotations in 2nd set from the right
-*
- DO 180 L = 1, KA - 1
- CALL SLARTV( NR, AB( KA1-L, J2 ), INCA,
- $ AB( KA-L, J2+1 ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 180 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( KA1, J2 ), AB( KA1, J2+1 ),
- $ AB( KA, J2+1 ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the left
-*
- DO 190 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J2+KA1-L ), INCA,
- $ AB( L+1, J2+KA1-L ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 190 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 200 J = J2, J1, KA1
- CALL SROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 200 CONTINUE
- END IF
- 210 CONTINUE
-*
- DO 230 K = 1, KB - 1
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
-*
-* finish applying rotations in 1st set from the left
-*
- DO 220 L = KB - K, 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J2+KA1-L ), INCA,
- $ AB( L+1, J2+KA1-L ), INCA,
- $ WORK( N+J2-M ), WORK( J2-M ), KA1 )
- 220 CONTINUE
- 230 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 240 J = N - 1, I - KB + 2*KA + 1, -1
- WORK( N+J-M ) = WORK( N+J-KA-M )
- WORK( J-M ) = WORK( J-KA-M )
- 240 CONTINUE
- END IF
-*
- ELSE
-*
-* Transform A, working with the lower triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( 1, I )
- DO 250 J = I, I1
- AB( J-I+1, I ) = AB( J-I+1, I ) / BII
- 250 CONTINUE
- DO 260 J = MAX( 1, I-KA ), I
- AB( I-J+1, J ) = AB( I-J+1, J ) / BII
- 260 CONTINUE
- DO 290 K = I - KBT, I - 1
- DO 270 J = I - KBT, K
- AB( K-J+1, J ) = AB( K-J+1, J ) -
- $ BB( I-J+1, J )*AB( I-K+1, K ) -
- $ BB( I-K+1, K )*AB( I-J+1, J ) +
- $ AB( 1, I )*BB( I-J+1, J )*
- $ BB( I-K+1, K )
- 270 CONTINUE
- DO 280 J = MAX( 1, I-KA ), I - KBT - 1
- AB( K-J+1, J ) = AB( K-J+1, J ) -
- $ BB( I-K+1, K )*AB( I-J+1, J )
- 280 CONTINUE
- 290 CONTINUE
- DO 310 J = I, I1
- DO 300 K = MAX( J-KA, I-KBT ), I - 1
- AB( J-K+1, K ) = AB( J-K+1, K ) -
- $ BB( I-K+1, K )*AB( J-I+1, I )
- 300 CONTINUE
- 310 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL SSCAL( N-M, ONE / BII, X( M+1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL SGER( N-M, KBT, -ONE, X( M+1, I ), 1,
- $ BB( KBT+1, I-KBT ), LDBB-1,
- $ X( M+1, I-KBT ), LDX )
- END IF
-*
-* store a(i1,i) in RA1 for use in next loop over K
-*
- RA1 = AB( I1-I+1, I )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions down toward the bottom of the
-* band
-*
- DO 360 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I-K+KA.LT.N .AND. I-K.GT.1 ) THEN
-*
-* generate rotation to annihilate a(i-k+ka+1,i)
-*
- CALL SLARTG( AB( KA1-K, I ), RA1, WORK( N+I-K+KA-M ),
- $ WORK( I-K+KA-M ), RA )
-*
-* create nonzero element a(i-k+ka+1,i-k) outside the
-* band and store it in WORK(i-k)
-*
- T = -BB( K+1, I-K )*RA1
- WORK( I-K ) = WORK( N+I-K+KA-M )*T -
- $ WORK( I-K+KA-M )*AB( KA1, I-K )
- AB( KA1, I-K ) = WORK( I-K+KA-M )*T +
- $ WORK( N+I-K+KA-M )*AB( KA1, I-K )
- RA1 = RA
- END IF
- END IF
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MAX( J2, I+2*KA-K+1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( N-J2T+KA ) / KA1
- DO 320 J = J2T, J1, KA1
-*
-* create nonzero element a(j+1,j-ka) outside the band
-* and store it in WORK(j-m)
-*
- WORK( J-M ) = WORK( J-M )*AB( KA1, J-KA+1 )
- AB( KA1, J-KA+1 ) = WORK( N+J-M )*AB( KA1, J-KA+1 )
- 320 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL SLARGV( NRT, AB( KA1, J2T-KA ), INCA, WORK( J2T-M ),
- $ KA1, WORK( N+J2T-M ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the left
-*
- DO 330 L = 1, KA - 1
- CALL SLARTV( NR, AB( L+1, J2-L ), INCA,
- $ AB( L+2, J2-L ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 330 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ),
- $ INCA, WORK( N+J2-M ), WORK( J2-M ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the right
-*
- DO 340 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J2 ), INCA,
- $ AB( KA1-L, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 340 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 350 J = J2, J1, KA1
- CALL SROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J-M ), WORK( J-M ) )
- 350 CONTINUE
- END IF
- 360 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.LE.N .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i-kbt+ka+1,i-kbt) outside the
-* band and store it in WORK(i-kbt)
-*
- WORK( I-KBT ) = -BB( KBT+1, I-KBT )*RA1
- END IF
- END IF
-*
- DO 400 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I - K - 1 + MAX( 2, K-I0+1 )*KA1
- ELSE
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the right
-*
- DO 370 L = KB - K, 1, -1
- NRT = ( N-J2+KA+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J2-KA ), INCA,
- $ AB( KA1-L, J2-KA+1 ), INCA,
- $ WORK( N+J2-KA ), WORK( J2-KA ), KA1 )
- 370 CONTINUE
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- DO 380 J = J1, J2, -KA1
- WORK( J ) = WORK( J-KA )
- WORK( N+J ) = WORK( N+J-KA )
- 380 CONTINUE
- DO 390 J = J2, J1, KA1
-*
-* create nonzero element a(j+1,j-ka) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( KA1, J-KA+1 )
- AB( KA1, J-KA+1 ) = WORK( N+J )*AB( KA1, J-KA+1 )
- 390 CONTINUE
- IF( UPDATE ) THEN
- IF( I-K.LT.N-KA .AND. K.LE.KBT )
- $ WORK( I-K+KA ) = WORK( I-K )
- END IF
- 400 CONTINUE
-*
- DO 440 K = KB, 1, -1
- J2 = I - K - 1 + MAX( 1, K-I0+1 )*KA1
- NR = ( N-J2+KA ) / KA1
- J1 = J2 + ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL SLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), KA1,
- $ WORK( N+J2 ), KA1 )
-*
-* apply rotations in 2nd set from the left
-*
- DO 410 L = 1, KA - 1
- CALL SLARTV( NR, AB( L+1, J2-L ), INCA,
- $ AB( L+2, J2-L ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 410 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ),
- $ INCA, WORK( N+J2 ), WORK( J2 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the right
-*
- DO 420 L = KA - 1, KB - K + 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J2 ), INCA,
- $ AB( KA1-L, J2+1 ), INCA, WORK( N+J2 ),
- $ WORK( J2 ), KA1 )
- 420 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 430 J = J2, J1, KA1
- CALL SROT( N-M, X( M+1, J ), 1, X( M+1, J+1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 430 CONTINUE
- END IF
- 440 CONTINUE
-*
- DO 460 K = 1, KB - 1
- J2 = I - K - 1 + MAX( 1, K-I0+2 )*KA1
-*
-* finish applying rotations in 1st set from the right
-*
- DO 450 L = KB - K, 1, -1
- NRT = ( N-J2+L ) / KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J2 ), INCA,
- $ AB( KA1-L, J2+1 ), INCA, WORK( N+J2-M ),
- $ WORK( J2-M ), KA1 )
- 450 CONTINUE
- 460 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 470 J = N - 1, I - KB + 2*KA + 1, -1
- WORK( N+J-M ) = WORK( N+J-KA-M )
- WORK( J-M ) = WORK( J-KA-M )
- 470 CONTINUE
- END IF
-*
- END IF
-*
- GO TO 10
-*
- 480 CONTINUE
-*
-* **************************** Phase 2 *****************************
-*
-* The logical structure of this phase is:
-*
-* UPDATE = .TRUE.
-* DO I = 1, M
-* use S(i) to update A and create a new bulge
-* apply rotations to push all bulges KA positions upward
-* END DO
-* UPDATE = .FALSE.
-* DO I = M - KA - 1, 2, -1
-* apply rotations to push all bulges KA positions upward
-* END DO
-*
-* To avoid duplicating code, the two loops are merged.
-*
- UPDATE = .TRUE.
- I = 0
- 490 CONTINUE
- IF( UPDATE ) THEN
- I = I + 1
- KBT = MIN( KB, M-I )
- I0 = I + 1
- I1 = MAX( 1, I-KA )
- I2 = I + KBT - KA1
- IF( I.GT.M ) THEN
- UPDATE = .FALSE.
- I = I - 1
- I0 = M + 1
- IF( KA.EQ.0 )
- $ RETURN
- GO TO 490
- END IF
- ELSE
- I = I - KA
- IF( I.LT.2 )
- $ RETURN
- END IF
-*
- IF( I.LT.M-KBT ) THEN
- NX = M
- ELSE
- NX = N
- END IF
-*
- IF( UPPER ) THEN
-*
-* Transform A, working with the upper triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( KB1, I )
- DO 500 J = I1, I
- AB( J-I+KA1, I ) = AB( J-I+KA1, I ) / BII
- 500 CONTINUE
- DO 510 J = I, MIN( N, I+KA )
- AB( I-J+KA1, J ) = AB( I-J+KA1, J ) / BII
- 510 CONTINUE
- DO 540 K = I + 1, I + KBT
- DO 520 J = K, I + KBT
- AB( K-J+KA1, J ) = AB( K-J+KA1, J ) -
- $ BB( I-J+KB1, J )*AB( I-K+KA1, K ) -
- $ BB( I-K+KB1, K )*AB( I-J+KA1, J ) +
- $ AB( KA1, I )*BB( I-J+KB1, J )*
- $ BB( I-K+KB1, K )
- 520 CONTINUE
- DO 530 J = I + KBT + 1, MIN( N, I+KA )
- AB( K-J+KA1, J ) = AB( K-J+KA1, J ) -
- $ BB( I-K+KB1, K )*AB( I-J+KA1, J )
- 530 CONTINUE
- 540 CONTINUE
- DO 560 J = I1, I
- DO 550 K = I + 1, MIN( J+KA, I+KBT )
- AB( J-K+KA1, K ) = AB( J-K+KA1, K ) -
- $ BB( I-K+KB1, K )*AB( J-I+KA1, I )
- 550 CONTINUE
- 560 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL SSCAL( NX, ONE / BII, X( 1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL SGER( NX, KBT, -ONE, X( 1, I ), 1, BB( KB, I+1 ),
- $ LDBB-1, X( 1, I+1 ), LDX )
- END IF
-*
-* store a(i1,i) in RA1 for use in next loop over K
-*
- RA1 = AB( I1-I+KA1, I )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions up toward the top of the band
-*
- DO 610 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I+K-KA1.GT.0 .AND. I+K.LT.M ) THEN
-*
-* generate rotation to annihilate a(i+k-ka-1,i)
-*
- CALL SLARTG( AB( K+1, I ), RA1, WORK( N+I+K-KA ),
- $ WORK( I+K-KA ), RA )
-*
-* create nonzero element a(i+k-ka-1,i+k) outside the
-* band and store it in WORK(m-kb+i+k)
-*
- T = -BB( KB1-K, I+K )*RA1
- WORK( M-KB+I+K ) = WORK( N+I+K-KA )*T -
- $ WORK( I+K-KA )*AB( 1, I+K )
- AB( 1, I+K ) = WORK( I+K-KA )*T +
- $ WORK( N+I+K-KA )*AB( 1, I+K )
- RA1 = RA
- END IF
- END IF
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MIN( J2, I-2*KA+K-1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( J2T+KA-1 ) / KA1
- DO 570 J = J1, J2T, KA1
-*
-* create nonzero element a(j-1,j+ka) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( 1, J+KA-1 )
- AB( 1, J+KA-1 ) = WORK( N+J )*AB( 1, J+KA-1 )
- 570 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL SLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), KA1,
- $ WORK( N+J1 ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the left
-*
- DO 580 L = 1, KA - 1
- CALL SLARTV( NR, AB( KA1-L, J1+L ), INCA,
- $ AB( KA-L, J1+L ), INCA, WORK( N+J1 ),
- $ WORK( J1 ), KA1 )
- 580 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( KA1, J1 ), AB( KA1, J1-1 ),
- $ AB( KA, J1 ), INCA, WORK( N+J1 ),
- $ WORK( J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the right
-*
- DO 590 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J1T ), INCA,
- $ AB( L+1, J1T-1 ), INCA, WORK( N+J1T ),
- $ WORK( J1T ), KA1 )
- 590 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 600 J = J1, J2, KA1
- CALL SROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 600 CONTINUE
- END IF
- 610 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.GT.0 .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i+kbt-ka-1,i+kbt) outside the
-* band and store it in WORK(m-kb+i+kbt)
-*
- WORK( M-KB+I+KBT ) = -BB( KB1-KBT, I+KBT )*RA1
- END IF
- END IF
-*
- DO 650 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I + K + 1 - MAX( 2, K+I0-M )*KA1
- ELSE
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the right
-*
- DO 620 L = KB - K, 1, -1
- NRT = ( J2+KA+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J1T+KA ), INCA,
- $ AB( L+1, J1T+KA-1 ), INCA,
- $ WORK( N+M-KB+J1T+KA ),
- $ WORK( M-KB+J1T+KA ), KA1 )
- 620 CONTINUE
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- DO 630 J = J1, J2, KA1
- WORK( M-KB+J ) = WORK( M-KB+J+KA )
- WORK( N+M-KB+J ) = WORK( N+M-KB+J+KA )
- 630 CONTINUE
- DO 640 J = J1, J2, KA1
-*
-* create nonzero element a(j-1,j+ka) outside the band
-* and store it in WORK(m-kb+j)
-*
- WORK( M-KB+J ) = WORK( M-KB+J )*AB( 1, J+KA-1 )
- AB( 1, J+KA-1 ) = WORK( N+M-KB+J )*AB( 1, J+KA-1 )
- 640 CONTINUE
- IF( UPDATE ) THEN
- IF( I+K.GT.KA1 .AND. K.LE.KBT )
- $ WORK( M-KB+I+K-KA ) = WORK( M-KB+I+K )
- END IF
- 650 CONTINUE
-*
- DO 690 K = KB, 1, -1
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL SLARGV( NR, AB( 1, J1+KA ), INCA, WORK( M-KB+J1 ),
- $ KA1, WORK( N+M-KB+J1 ), KA1 )
-*
-* apply rotations in 2nd set from the left
-*
- DO 660 L = 1, KA - 1
- CALL SLARTV( NR, AB( KA1-L, J1+L ), INCA,
- $ AB( KA-L, J1+L ), INCA,
- $ WORK( N+M-KB+J1 ), WORK( M-KB+J1 ), KA1 )
- 660 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( KA1, J1 ), AB( KA1, J1-1 ),
- $ AB( KA, J1 ), INCA, WORK( N+M-KB+J1 ),
- $ WORK( M-KB+J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the right
-*
- DO 670 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J1T ), INCA,
- $ AB( L+1, J1T-1 ), INCA,
- $ WORK( N+M-KB+J1T ), WORK( M-KB+J1T ),
- $ KA1 )
- 670 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 680 J = J1, J2, KA1
- CALL SROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+M-KB+J ), WORK( M-KB+J ) )
- 680 CONTINUE
- END IF
- 690 CONTINUE
-*
- DO 710 K = 1, KB - 1
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
-*
-* finish applying rotations in 1st set from the right
-*
- DO 700 L = KB - K, 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L, J1T ), INCA,
- $ AB( L+1, J1T-1 ), INCA, WORK( N+J1T ),
- $ WORK( J1T ), KA1 )
- 700 CONTINUE
- 710 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 720 J = 2, MIN( I+KB, M ) - 2*KA - 1
- WORK( N+J ) = WORK( N+J+KA )
- WORK( J ) = WORK( J+KA )
- 720 CONTINUE
- END IF
-*
- ELSE
-*
-* Transform A, working with the lower triangle
-*
- IF( UPDATE ) THEN
-*
-* Form inv(S(i))**T * A * inv(S(i))
-*
- BII = BB( 1, I )
- DO 730 J = I1, I
- AB( I-J+1, J ) = AB( I-J+1, J ) / BII
- 730 CONTINUE
- DO 740 J = I, MIN( N, I+KA )
- AB( J-I+1, I ) = AB( J-I+1, I ) / BII
- 740 CONTINUE
- DO 770 K = I + 1, I + KBT
- DO 750 J = K, I + KBT
- AB( J-K+1, K ) = AB( J-K+1, K ) -
- $ BB( J-I+1, I )*AB( K-I+1, I ) -
- $ BB( K-I+1, I )*AB( J-I+1, I ) +
- $ AB( 1, I )*BB( J-I+1, I )*
- $ BB( K-I+1, I )
- 750 CONTINUE
- DO 760 J = I + KBT + 1, MIN( N, I+KA )
- AB( J-K+1, K ) = AB( J-K+1, K ) -
- $ BB( K-I+1, I )*AB( J-I+1, I )
- 760 CONTINUE
- 770 CONTINUE
- DO 790 J = I1, I
- DO 780 K = I + 1, MIN( J+KA, I+KBT )
- AB( K-J+1, J ) = AB( K-J+1, J ) -
- $ BB( K-I+1, I )*AB( I-J+1, J )
- 780 CONTINUE
- 790 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by inv(S(i))
-*
- CALL SSCAL( NX, ONE / BII, X( 1, I ), 1 )
- IF( KBT.GT.0 )
- $ CALL SGER( NX, KBT, -ONE, X( 1, I ), 1, BB( 2, I ), 1,
- $ X( 1, I+1 ), LDX )
- END IF
-*
-* store a(i,i1) in RA1 for use in next loop over K
-*
- RA1 = AB( I-I1+1, I1 )
- END IF
-*
-* Generate and apply vectors of rotations to chase all the
-* existing bulges KA positions up toward the top of the band
-*
- DO 840 K = 1, KB - 1
- IF( UPDATE ) THEN
-*
-* Determine the rotations which would annihilate the bulge
-* which has in theory just been created
-*
- IF( I+K-KA1.GT.0 .AND. I+K.LT.M ) THEN
-*
-* generate rotation to annihilate a(i,i+k-ka-1)
-*
- CALL SLARTG( AB( KA1-K, I+K-KA ), RA1,
- $ WORK( N+I+K-KA ), WORK( I+K-KA ), RA )
-*
-* create nonzero element a(i+k,i+k-ka-1) outside the
-* band and store it in WORK(m-kb+i+k)
-*
- T = -BB( K+1, I )*RA1
- WORK( M-KB+I+K ) = WORK( N+I+K-KA )*T -
- $ WORK( I+K-KA )*AB( KA1, I+K-KA )
- AB( KA1, I+K-KA ) = WORK( I+K-KA )*T +
- $ WORK( N+I+K-KA )*AB( KA1, I+K-KA )
- RA1 = RA
- END IF
- END IF
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( UPDATE ) THEN
- J2T = MIN( J2, I-2*KA+K-1 )
- ELSE
- J2T = J2
- END IF
- NRT = ( J2T+KA-1 ) / KA1
- DO 800 J = J1, J2T, KA1
-*
-* create nonzero element a(j+ka,j-1) outside the band
-* and store it in WORK(j)
-*
- WORK( J ) = WORK( J )*AB( KA1, J-1 )
- AB( KA1, J-1 ) = WORK( N+J )*AB( KA1, J-1 )
- 800 CONTINUE
-*
-* generate rotations in 1st set to annihilate elements which
-* have been created outside the band
-*
- IF( NRT.GT.0 )
- $ CALL SLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), KA1,
- $ WORK( N+J1 ), KA1 )
- IF( NR.GT.0 ) THEN
-*
-* apply rotations in 1st set from the right
-*
- DO 810 L = 1, KA - 1
- CALL SLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ),
- $ INCA, WORK( N+J1 ), WORK( J1 ), KA1 )
- 810 CONTINUE
-*
-* apply rotations in 1st set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( 1, J1 ), AB( 1, J1-1 ),
- $ AB( 2, J1-1 ), INCA, WORK( N+J1 ),
- $ WORK( J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 1st set from the left
-*
- DO 820 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J1T-KA1+L ), INCA,
- $ AB( KA1-L, J1T-KA1+L ), INCA,
- $ WORK( N+J1T ), WORK( J1T ), KA1 )
- 820 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 1st set
-*
- DO 830 J = J1, J2, KA1
- CALL SROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+J ), WORK( J ) )
- 830 CONTINUE
- END IF
- 840 CONTINUE
-*
- IF( UPDATE ) THEN
- IF( I2.GT.0 .AND. KBT.GT.0 ) THEN
-*
-* create nonzero element a(i+kbt,i+kbt-ka-1) outside the
-* band and store it in WORK(m-kb+i+kbt)
-*
- WORK( M-KB+I+KBT ) = -BB( KBT+1, I )*RA1
- END IF
- END IF
-*
- DO 880 K = KB, 1, -1
- IF( UPDATE ) THEN
- J2 = I + K + 1 - MAX( 2, K+I0-M )*KA1
- ELSE
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- END IF
-*
-* finish applying rotations in 2nd set from the left
-*
- DO 850 L = KB - K, 1, -1
- NRT = ( J2+KA+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J1T+L-1 ), INCA,
- $ AB( KA1-L, J1T+L-1 ), INCA,
- $ WORK( N+M-KB+J1T+KA ),
- $ WORK( M-KB+J1T+KA ), KA1 )
- 850 CONTINUE
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- DO 860 J = J1, J2, KA1
- WORK( M-KB+J ) = WORK( M-KB+J+KA )
- WORK( N+M-KB+J ) = WORK( N+M-KB+J+KA )
- 860 CONTINUE
- DO 870 J = J1, J2, KA1
-*
-* create nonzero element a(j+ka,j-1) outside the band
-* and store it in WORK(m-kb+j)
-*
- WORK( M-KB+J ) = WORK( M-KB+J )*AB( KA1, J-1 )
- AB( KA1, J-1 ) = WORK( N+M-KB+J )*AB( KA1, J-1 )
- 870 CONTINUE
- IF( UPDATE ) THEN
- IF( I+K.GT.KA1 .AND. K.LE.KBT )
- $ WORK( M-KB+I+K-KA ) = WORK( M-KB+I+K )
- END IF
- 880 CONTINUE
-*
- DO 920 K = KB, 1, -1
- J2 = I + K + 1 - MAX( 1, K+I0-M )*KA1
- NR = ( J2+KA-1 ) / KA1
- J1 = J2 - ( NR-1 )*KA1
- IF( NR.GT.0 ) THEN
-*
-* generate rotations in 2nd set to annihilate elements
-* which have been created outside the band
-*
- CALL SLARGV( NR, AB( KA1, J1 ), INCA, WORK( M-KB+J1 ),
- $ KA1, WORK( N+M-KB+J1 ), KA1 )
-*
-* apply rotations in 2nd set from the right
-*
- DO 890 L = 1, KA - 1
- CALL SLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ),
- $ INCA, WORK( N+M-KB+J1 ), WORK( M-KB+J1 ),
- $ KA1 )
- 890 CONTINUE
-*
-* apply rotations in 2nd set from both sides to diagonal
-* blocks
-*
- CALL SLAR2V( NR, AB( 1, J1 ), AB( 1, J1-1 ),
- $ AB( 2, J1-1 ), INCA, WORK( N+M-KB+J1 ),
- $ WORK( M-KB+J1 ), KA1 )
-*
- END IF
-*
-* start applying rotations in 2nd set from the left
-*
- DO 900 L = KA - 1, KB - K + 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J1T-KA1+L ), INCA,
- $ AB( KA1-L, J1T-KA1+L ), INCA,
- $ WORK( N+M-KB+J1T ), WORK( M-KB+J1T ),
- $ KA1 )
- 900 CONTINUE
-*
- IF( WANTX ) THEN
-*
-* post-multiply X by product of rotations in 2nd set
-*
- DO 910 J = J1, J2, KA1
- CALL SROT( NX, X( 1, J ), 1, X( 1, J-1 ), 1,
- $ WORK( N+M-KB+J ), WORK( M-KB+J ) )
- 910 CONTINUE
- END IF
- 920 CONTINUE
-*
- DO 940 K = 1, KB - 1
- J2 = I + K + 1 - MAX( 1, K+I0-M+1 )*KA1
-*
-* finish applying rotations in 1st set from the left
-*
- DO 930 L = KB - K, 1, -1
- NRT = ( J2+L-1 ) / KA1
- J1T = J2 - ( NRT-1 )*KA1
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KA1-L+1, J1T-KA1+L ), INCA,
- $ AB( KA1-L, J1T-KA1+L ), INCA,
- $ WORK( N+J1T ), WORK( J1T ), KA1 )
- 930 CONTINUE
- 940 CONTINUE
-*
- IF( KB.GT.1 ) THEN
- DO 950 J = 2, MIN( I+KB, M ) - 2*KA - 1
- WORK( N+J ) = WORK( N+J+KA )
- WORK( J ) = WORK( J+KA )
- 950 CONTINUE
- END IF
-*
- END IF
-*
- GO TO 490
-*
-* End of SSBGST
-*
- END
diff --git a/netlib/LAPACK/ssbgv.f b/netlib/LAPACK/ssbgv.f
deleted file mode 100644
index 74c2678..0000000
--- a/netlib/LAPACK/ssbgv.f
+++ /dev/null
@@ -1,280 +0,0 @@
-*> \brief \b SSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbgv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbgv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbgv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z,
-* LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), BB( LDBB, * ), W( * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBGV computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite banded eigenproblem, of
-*> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
-*> and banded, and B is also positive definite.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the contents of AB are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in,out] BB
-*> \verbatim
-*> BB is REAL array, dimension (LDBB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix B, stored in the first kb+1 rows of the array. The
-*> j-th column of B is stored in the j-th column of the array BB
-*> as follows:
-*> if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
-*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
-*>
-*> On exit, the factor S from the split Cholesky factorization
-*> B = S**T*S, as returned by SPBSTF.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors, with the i-th column of Z holding the
-*> eigenvector associated with W(i). The eigenvectors are
-*> normalized so that Z**T*B*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is:
-*> <= N: the algorithm failed to converge:
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then SPBSTF
-*> returned INFO = i: B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z,
- $ LDZ, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), BB( LDBB, * ), W( * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER, WANTZ
- CHARACTER VECT
- INTEGER IINFO, INDE, INDWRK
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPBSTF, SSBGST, SSBTRD, SSTEQR, SSTERF, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KA.LT.0 ) THEN
- INFO = -4
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -7
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBGV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a split Cholesky factorization of B.
-*
- CALL SPBSTF( UPLO, N, KB, BB, LDBB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem.
-*
- INDE = 1
- INDWRK = INDE + N
- CALL SSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* Reduce to tridiagonal form.
-*
- IF( WANTZ ) THEN
- VECT = 'U'
- ELSE
- VECT = 'N'
- END IF
- CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
- $ INFO )
- END IF
- RETURN
-*
-* End of SSBGV
-*
- END
diff --git a/netlib/LAPACK/ssbgvd.f b/netlib/LAPACK/ssbgvd.f
deleted file mode 100644
index 822ae90..0000000
--- a/netlib/LAPACK/ssbgvd.f
+++ /dev/null
@@ -1,372 +0,0 @@
-*> \brief \b SSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBGVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbgvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbgvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbgvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W,
-* Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), BB( LDBB, * ), W( * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBGVD computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite banded eigenproblem, of the
-*> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and
-*> banded, and B is also positive definite. If eigenvectors are
-*> desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the contents of AB are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in,out] BB
-*> \verbatim
-*> BB is REAL array, dimension (LDBB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix B, stored in the first kb+1 rows of the array. The
-*> j-th column of B is stored in the j-th column of the array BB
-*> as follows:
-*> if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
-*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
-*>
-*> On exit, the factor S from the split Cholesky factorization
-*> B = S**T*S, as returned by SPBSTF.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors, with the i-th column of Z holding the
-*> eigenvector associated with W(i). The eigenvectors are
-*> normalized so Z**T*B*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LWORK >= 3*N.
-*> If JOBZ = 'V' and N > 1, LWORK >= 1 + 5*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if LIWORK > 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK >= 1.
-*> If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is:
-*> <= N: the algorithm failed to converge:
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then SPBSTF
-*> returned INFO = i: B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W,
- $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, KA, KB, LDAB, LDBB, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), BB( LDBB, * ), W( * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER VECT
- INTEGER IINFO, INDE, INDWK2, INDWRK, LIWMIN, LLWRK2,
- $ LWMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLACPY, SPBSTF, SSBGST, SSBTRD, SSTEDC,
- $ SSTERF, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 5*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
-*
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KA.LT.0 ) THEN
- INFO = -4
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -7
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -14
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -16
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBGVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a split Cholesky factorization of B.
-*
- CALL SPBSTF( UPLO, N, KB, BB, LDBB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem.
-*
- INDE = 1
- INDWRK = INDE + N
- INDWK2 = INDWRK + N*N
- LLWRK2 = LWORK - INDWK2 + 1
- CALL SSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* Reduce to tridiagonal form.
-*
- IF( WANTZ ) THEN
- VECT = 'U'
- ELSE
- VECT = 'N'
- END IF
- CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, call SSTEDC.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
- $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
- CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N,
- $ ZERO, WORK( INDWK2 ), N )
- CALL SLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
- END IF
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of SSBGVD
-*
- END
diff --git a/netlib/LAPACK/ssbgvx.f b/netlib/LAPACK/ssbgvx.f
deleted file mode 100644
index 3a66044..0000000
--- a/netlib/LAPACK/ssbgvx.f
+++ /dev/null
@@ -1,513 +0,0 @@
-*> \brief \b SSBGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBGVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbgvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbgvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbgvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
-* LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
-* LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
-* $ N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL AB( LDAB, * ), BB( LDBB, * ), Q( LDQ, * ),
-* $ W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBGVX computes selected eigenvalues, and optionally, eigenvectors
-*> of a real generalized symmetric-definite banded eigenproblem, of
-*> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
-*> and banded, and B is also positive definite. Eigenvalues and
-*> eigenvectors can be selected by specifying either all eigenvalues,
-*> a range of values or a range of indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KA
-*> \verbatim
-*> KA is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
-*> \endverbatim
-*>
-*> \param[in] KB
-*> \verbatim
-*> KB is INTEGER
-*> The number of superdiagonals of the matrix B if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first ka+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
-*>
-*> On exit, the contents of AB are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KA+1.
-*> \endverbatim
-*>
-*> \param[in,out] BB
-*> \verbatim
-*> BB is REAL array, dimension (LDBB, N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix B, stored in the first kb+1 rows of the array. The
-*> j-th column of B is stored in the j-th column of the array BB
-*> as follows:
-*> if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
-*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
-*>
-*> On exit, the factor S from the split Cholesky factorization
-*> B = S**T*S, as returned by SPBSTF.
-*> \endverbatim
-*>
-*> \param[in] LDBB
-*> \verbatim
-*> LDBB is INTEGER
-*> The leading dimension of the array BB. LDBB >= KB+1.
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ, N)
-*> If JOBZ = 'V', the n-by-n matrix used in the reduction of
-*> A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
-*> and consequently C to tridiagonal form.
-*> If JOBZ = 'N', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. If JOBZ = 'N',
-*> LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors, with the i-th column of Z holding the
-*> eigenvector associated with W(i). The eigenvectors are
-*> normalized so Z**T*B*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (7N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (M)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvalues that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0 : successful exit
-*> < 0 : if INFO = -i, the i-th argument had an illegal value
-*> <= N: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in IFAIL.
-*> > N : SPBSTF returned an error code; i.e.,
-*> if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE SSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
- $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
- $ LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
- $ N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL AB( LDAB, * ), BB( LDBB, * ), Q( LDQ, * ),
- $ W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
- CHARACTER ORDER, VECT
- INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP,
- $ INDIWO, INDWRK, ITMP1, J, JJ, NSPLIT
- REAL TMP1
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SGEMV, SLACPY, SPBSTF, SSBGST, SSBTRD,
- $ SSTEBZ, SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KA.LT.0 ) THEN
- INFO = -5
- ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KA+1 ) THEN
- INFO = -8
- ELSE IF( LDBB.LT.KB+1 ) THEN
- INFO = -10
- ELSE IF( LDQ.LT.1 .OR. ( WANTZ .AND. LDQ.LT.N ) ) THEN
- INFO = -12
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -14
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -15
- ELSE IF ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -16
- END IF
- END IF
- END IF
- IF( INFO.EQ.0) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -21
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBGVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a split Cholesky factorization of B.
-*
- CALL SPBSTF( UPLO, N, KB, BB, LDBB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem.
-*
- CALL SSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ,
- $ WORK, IINFO )
-*
-* Reduce symmetric band matrix to tridiagonal form.
-*
- INDD = 1
- INDE = INDD + N
- INDWRK = INDE + N
- IF( WANTZ ) THEN
- VECT = 'U'
- ELSE
- VECT = 'N'
- END IF
- CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, WORK( INDD ),
- $ WORK( INDE ), Q, LDQ, WORK( INDWRK ), IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal
-* to zero, then call SSTERF or SSTEQR. If this fails for some
-* eigenvalue, then try SSTEBZ.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
- CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL SLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
- CALL SSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 30
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired,
-* call SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply transformation matrix used in reduction to tridiagonal
-* form to eigenvectors returned by SSTEIN.
-*
- DO 20 J = 1, M
- CALL SCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
- CALL SGEMV( 'N', N, N, ONE, Q, LDQ, WORK, 1, ZERO,
- $ Z( 1, J ), 1 )
- 20 CONTINUE
- END IF
-*
- 30 CONTINUE
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 50 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 40 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 40 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSBGVX
-*
- END
diff --git a/netlib/LAPACK/ssbtrd.f b/netlib/LAPACK/ssbtrd.f
deleted file mode 100644
index 83bd8b7..0000000
--- a/netlib/LAPACK/ssbtrd.f
+++ /dev/null
@@ -1,641 +0,0 @@
-*> \brief \b SSBTRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSBTRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbtrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbtrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbtrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO, VECT
-* INTEGER INFO, KD, LDAB, LDQ, N
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), D( * ), E( * ), Q( LDQ, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSBTRD reduces a real symmetric band matrix A to symmetric
-*> tridiagonal form T by an orthogonal similarity transformation:
-*> Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'N': do not form Q;
-*> = 'V': form Q;
-*> = 'U': update a matrix X, by forming X*Q.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals of the matrix A if UPLO = 'U',
-*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> On entry, the upper or lower triangle of the symmetric band
-*> matrix A, stored in the first KD+1 rows of the array. The
-*> j-th column of A is stored in the j-th column of the array AB
-*> as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> On exit, the diagonal elements of AB are overwritten by the
-*> diagonal elements of the tridiagonal matrix T; if KD > 0, the
-*> elements on the first superdiagonal (if UPLO = 'U') or the
-*> first subdiagonal (if UPLO = 'L') are overwritten by the
-*> off-diagonal elements of T; the rest of AB is overwritten by
-*> values generated during the reduction.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, if VECT = 'U', then Q must contain an N-by-N
-*> matrix X; if VECT = 'N' or 'V', then Q need not be set.
-*>
-*> On exit:
-*> if VECT = 'V', Q contains the N-by-N orthogonal matrix Q;
-*> if VECT = 'U', Q contains the product X*Q;
-*> if VECT = 'N', the array Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by Linda Kaufman, Bell Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO, VECT
- INTEGER INFO, KD, LDAB, LDQ, N
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), D( * ), E( * ), Q( LDQ, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL INITQ, UPPER, WANTQ
- INTEGER I, I2, IBL, INCA, INCX, IQAEND, IQB, IQEND, J,
- $ J1, J1END, J1INC, J2, JEND, JIN, JINC, K, KD1,
- $ KDM1, KDN, L, LAST, LEND, NQ, NR, NRT
- REAL TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAR2V, SLARGV, SLARTG, SLARTV, SLASET, SROT,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INITQ = LSAME( VECT, 'V' )
- WANTQ = INITQ .OR. LSAME( VECT, 'U' )
- UPPER = LSAME( UPLO, 'U' )
- KD1 = KD + 1
- KDM1 = KD - 1
- INCX = LDAB - 1
- IQEND = 1
-*
- INFO = 0
- IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'N' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KD.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KD1 ) THEN
- INFO = -6
- ELSE IF( LDQ.LT.MAX( 1, N ) .AND. WANTQ ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSBTRD', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize Q to the unit matrix, if needed
-*
- IF( INITQ )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
-*
-* Wherever possible, plane rotations are generated and applied in
-* vector operations of length NR over the index set J1:J2:KD1.
-*
-* The cosines and sines of the plane rotations are stored in the
-* arrays D and WORK.
-*
- INCA = KD1*LDAB
- KDN = MIN( N-1, KD )
- IF( UPPER ) THEN
-*
- IF( KD.GT.1 ) THEN
-*
-* Reduce to tridiagonal form, working with upper triangle
-*
- NR = 0
- J1 = KDN + 2
- J2 = 1
-*
- DO 90 I = 1, N - 2
-*
-* Reduce i-th row of matrix to tridiagonal form
-*
- DO 80 K = KDN + 1, 2, -1
- J1 = J1 + KDN
- J2 = J2 + KDN
-*
- IF( NR.GT.0 ) THEN
-*
-* generate plane rotations to annihilate nonzero
-* elements which have been created outside the band
-*
- CALL SLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ),
- $ KD1, D( J1 ), KD1 )
-*
-* apply rotations from the right
-*
-*
-* Dependent on the the number of diagonals either
-* SLARTV or SROT is used
-*
- IF( NR.GE.2*KD-1 ) THEN
- DO 10 L = 1, KD - 1
- CALL SLARTV( NR, AB( L+1, J1-1 ), INCA,
- $ AB( L, J1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
- 10 CONTINUE
-*
- ELSE
- JEND = J1 + ( NR-1 )*KD1
- DO 20 JINC = J1, JEND, KD1
- CALL SROT( KDM1, AB( 2, JINC-1 ), 1,
- $ AB( 1, JINC ), 1, D( JINC ),
- $ WORK( JINC ) )
- 20 CONTINUE
- END IF
- END IF
-*
-*
- IF( K.GT.2 ) THEN
- IF( K.LE.N-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i,i+k-1)
-* within the band
-*
- CALL SLARTG( AB( KD-K+3, I+K-2 ),
- $ AB( KD-K+2, I+K-1 ), D( I+K-1 ),
- $ WORK( I+K-1 ), TEMP )
- AB( KD-K+3, I+K-2 ) = TEMP
-*
-* apply rotation from the right
-*
- CALL SROT( K-3, AB( KD-K+4, I+K-2 ), 1,
- $ AB( KD-K+3, I+K-1 ), 1, D( I+K-1 ),
- $ WORK( I+K-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KDN - 1
- END IF
-*
-* apply plane rotations from both sides to diagonal
-* blocks
-*
- IF( NR.GT.0 )
- $ CALL SLAR2V( NR, AB( KD1, J1-1 ), AB( KD1, J1 ),
- $ AB( KD, J1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
-*
-* apply plane rotations from the left
-*
- IF( NR.GT.0 ) THEN
- IF( 2*KD-1.LT.NR ) THEN
-*
-* Dependent on the the number of diagonals either
-* SLARTV or SROT is used
-*
- DO 30 L = 1, KD - 1
- IF( J2+L.GT.N ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( KD-L, J1+L ), INCA,
- $ AB( KD-L+1, J1+L ), INCA,
- $ D( J1 ), WORK( J1 ), KD1 )
- 30 CONTINUE
- ELSE
- J1END = J1 + KD1*( NR-2 )
- IF( J1END.GE.J1 ) THEN
- DO 40 JIN = J1, J1END, KD1
- CALL SROT( KD-1, AB( KD-1, JIN+1 ), INCX,
- $ AB( KD, JIN+1 ), INCX,
- $ D( JIN ), WORK( JIN ) )
- 40 CONTINUE
- END IF
- LEND = MIN( KDM1, N-J2 )
- LAST = J1END + KD1
- IF( LEND.GT.0 )
- $ CALL SROT( LEND, AB( KD-1, LAST+1 ), INCX,
- $ AB( KD, LAST+1 ), INCX, D( LAST ),
- $ WORK( LAST ) )
- END IF
- END IF
-*
- IF( WANTQ ) THEN
-*
-* accumulate product of plane rotations in Q
-*
- IF( INITQ ) THEN
-*
-* take advantage of the fact that Q was
-* initially the Identity matrix
-*
- IQEND = MAX( IQEND, J2 )
- I2 = MAX( 0, K-3 )
- IQAEND = 1 + I*KD
- IF( K.EQ.2 )
- $ IQAEND = IQAEND + KD
- IQAEND = MIN( IQAEND, IQEND )
- DO 50 J = J1, J2, KD1
- IBL = I - I2 / KDM1
- I2 = I2 + 1
- IQB = MAX( 1, J-IBL )
- NQ = 1 + IQAEND - IQB
- IQAEND = MIN( IQAEND+KD, IQEND )
- CALL SROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ),
- $ 1, D( J ), WORK( J ) )
- 50 CONTINUE
- ELSE
-*
- DO 60 J = J1, J2, KD1
- CALL SROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1,
- $ D( J ), WORK( J ) )
- 60 CONTINUE
- END IF
-*
- END IF
-*
- IF( J2+KDN.GT.N ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KDN - 1
- END IF
-*
- DO 70 J = J1, J2, KD1
-*
-* create nonzero element a(j-1,j+kd) outside the band
-* and store it in WORK
-*
- WORK( J+KD ) = WORK( J )*AB( 1, J+KD )
- AB( 1, J+KD ) = D( J )*AB( 1, J+KD )
- 70 CONTINUE
- 80 CONTINUE
- 90 CONTINUE
- END IF
-*
- IF( KD.GT.0 ) THEN
-*
-* copy off-diagonal elements to E
-*
- DO 100 I = 1, N - 1
- E( I ) = AB( KD, I+1 )
- 100 CONTINUE
- ELSE
-*
-* set E to zero if original matrix was diagonal
-*
- DO 110 I = 1, N - 1
- E( I ) = ZERO
- 110 CONTINUE
- END IF
-*
-* copy diagonal elements to D
-*
- DO 120 I = 1, N
- D( I ) = AB( KD1, I )
- 120 CONTINUE
-*
- ELSE
-*
- IF( KD.GT.1 ) THEN
-*
-* Reduce to tridiagonal form, working with lower triangle
-*
- NR = 0
- J1 = KDN + 2
- J2 = 1
-*
- DO 210 I = 1, N - 2
-*
-* Reduce i-th column of matrix to tridiagonal form
-*
- DO 200 K = KDN + 1, 2, -1
- J1 = J1 + KDN
- J2 = J2 + KDN
-*
- IF( NR.GT.0 ) THEN
-*
-* generate plane rotations to annihilate nonzero
-* elements which have been created outside the band
-*
- CALL SLARGV( NR, AB( KD1, J1-KD1 ), INCA,
- $ WORK( J1 ), KD1, D( J1 ), KD1 )
-*
-* apply plane rotations from one side
-*
-*
-* Dependent on the the number of diagonals either
-* SLARTV or SROT is used
-*
- IF( NR.GT.2*KD-1 ) THEN
- DO 130 L = 1, KD - 1
- CALL SLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA,
- $ AB( KD1-L+1, J1-KD1+L ), INCA,
- $ D( J1 ), WORK( J1 ), KD1 )
- 130 CONTINUE
- ELSE
- JEND = J1 + KD1*( NR-1 )
- DO 140 JINC = J1, JEND, KD1
- CALL SROT( KDM1, AB( KD, JINC-KD ), INCX,
- $ AB( KD1, JINC-KD ), INCX,
- $ D( JINC ), WORK( JINC ) )
- 140 CONTINUE
- END IF
-*
- END IF
-*
- IF( K.GT.2 ) THEN
- IF( K.LE.N-I+1 ) THEN
-*
-* generate plane rotation to annihilate a(i+k-1,i)
-* within the band
-*
- CALL SLARTG( AB( K-1, I ), AB( K, I ),
- $ D( I+K-1 ), WORK( I+K-1 ), TEMP )
- AB( K-1, I ) = TEMP
-*
-* apply rotation from the left
-*
- CALL SROT( K-3, AB( K-2, I+1 ), LDAB-1,
- $ AB( K-1, I+1 ), LDAB-1, D( I+K-1 ),
- $ WORK( I+K-1 ) )
- END IF
- NR = NR + 1
- J1 = J1 - KDN - 1
- END IF
-*
-* apply plane rotations from both sides to diagonal
-* blocks
-*
- IF( NR.GT.0 )
- $ CALL SLAR2V( NR, AB( 1, J1-1 ), AB( 1, J1 ),
- $ AB( 2, J1-1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
-*
-* apply plane rotations from the right
-*
-*
-* Dependent on the the number of diagonals either
-* SLARTV or SROT is used
-*
- IF( NR.GT.0 ) THEN
- IF( NR.GT.2*KD-1 ) THEN
- DO 150 L = 1, KD - 1
- IF( J2+L.GT.N ) THEN
- NRT = NR - 1
- ELSE
- NRT = NR
- END IF
- IF( NRT.GT.0 )
- $ CALL SLARTV( NRT, AB( L+2, J1-1 ), INCA,
- $ AB( L+1, J1 ), INCA, D( J1 ),
- $ WORK( J1 ), KD1 )
- 150 CONTINUE
- ELSE
- J1END = J1 + KD1*( NR-2 )
- IF( J1END.GE.J1 ) THEN
- DO 160 J1INC = J1, J1END, KD1
- CALL SROT( KDM1, AB( 3, J1INC-1 ), 1,
- $ AB( 2, J1INC ), 1, D( J1INC ),
- $ WORK( J1INC ) )
- 160 CONTINUE
- END IF
- LEND = MIN( KDM1, N-J2 )
- LAST = J1END + KD1
- IF( LEND.GT.0 )
- $ CALL SROT( LEND, AB( 3, LAST-1 ), 1,
- $ AB( 2, LAST ), 1, D( LAST ),
- $ WORK( LAST ) )
- END IF
- END IF
-*
-*
-*
- IF( WANTQ ) THEN
-*
-* accumulate product of plane rotations in Q
-*
- IF( INITQ ) THEN
-*
-* take advantage of the fact that Q was
-* initially the Identity matrix
-*
- IQEND = MAX( IQEND, J2 )
- I2 = MAX( 0, K-3 )
- IQAEND = 1 + I*KD
- IF( K.EQ.2 )
- $ IQAEND = IQAEND + KD
- IQAEND = MIN( IQAEND, IQEND )
- DO 170 J = J1, J2, KD1
- IBL = I - I2 / KDM1
- I2 = I2 + 1
- IQB = MAX( 1, J-IBL )
- NQ = 1 + IQAEND - IQB
- IQAEND = MIN( IQAEND+KD, IQEND )
- CALL SROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ),
- $ 1, D( J ), WORK( J ) )
- 170 CONTINUE
- ELSE
-*
- DO 180 J = J1, J2, KD1
- CALL SROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1,
- $ D( J ), WORK( J ) )
- 180 CONTINUE
- END IF
- END IF
-*
- IF( J2+KDN.GT.N ) THEN
-*
-* adjust J2 to keep within the bounds of the matrix
-*
- NR = NR - 1
- J2 = J2 - KDN - 1
- END IF
-*
- DO 190 J = J1, J2, KD1
-*
-* create nonzero element a(j+kd,j-1) outside the
-* band and store it in WORK
-*
- WORK( J+KD ) = WORK( J )*AB( KD1, J )
- AB( KD1, J ) = D( J )*AB( KD1, J )
- 190 CONTINUE
- 200 CONTINUE
- 210 CONTINUE
- END IF
-*
- IF( KD.GT.0 ) THEN
-*
-* copy off-diagonal elements to E
-*
- DO 220 I = 1, N - 1
- E( I ) = AB( 2, I )
- 220 CONTINUE
- ELSE
-*
-* set E to zero if original matrix was diagonal
-*
- DO 230 I = 1, N - 1
- E( I ) = ZERO
- 230 CONTINUE
- END IF
-*
-* copy diagonal elements to D
-*
- DO 240 I = 1, N
- D( I ) = AB( 1, I )
- 240 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSBTRD
-*
- END
diff --git a/netlib/LAPACK/ssfrk.f b/netlib/LAPACK/ssfrk.f
deleted file mode 100644
index 5531ffd..0000000
--- a/netlib/LAPACK/ssfrk.f
+++ /dev/null
@@ -1,543 +0,0 @@
-*> \brief \b SSFRK performs a symmetric rank-k operation for matrix in RFP format.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSFRK + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssfrk.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssfrk.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssfrk.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
-* C )
-*
-* .. Scalar Arguments ..
-* REAL ALPHA, BETA
-* INTEGER K, LDA, N
-* CHARACTER TRANS, TRANSR, UPLO
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), C( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Level 3 BLAS like routine for C in RFP Format.
-*>
-*> SSFRK performs one of the symmetric rank--k operations
-*>
-*> C := alpha*A*A**T + beta*C,
-*>
-*> or
-*>
-*> C := alpha*A**T*A + beta*C,
-*>
-*> where alpha and beta are real scalars, C is an n--by--n symmetric
-*> matrix and A is an n--by--k matrix in the first case and a k--by--n
-*> matrix in the second case.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal Form of RFP A is stored;
-*> = 'T': The Transpose Form of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the upper or lower
-*> triangular part of the array C is to be referenced as
-*> follows:
-*>
-*> UPLO = 'U' or 'u' Only the upper triangular part of C
-*> is to be referenced.
-*>
-*> UPLO = 'L' or 'l' Only the lower triangular part of C
-*> is to be referenced.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' C := alpha*A*A**T + beta*C.
-*>
-*> TRANS = 'T' or 't' C := alpha*A**T*A + beta*C.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix C. N must be
-*> at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> On entry with TRANS = 'N' or 'n', K specifies the number
-*> of columns of the matrix A, and on entry with TRANS = 'T'
-*> or 't', K specifies the number of rows of the matrix A. K
-*> must be at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array of DIMENSION (LDA,ka)
-*> where KA
-*> is K when TRANS = 'N' or 'n', and is N otherwise. Before
-*> entry with TRANS = 'N' or 'n', the leading N--by--K part of
-*> the array A must contain the matrix A, otherwise the leading
-*> K--by--N part of the array A must contain the matrix A.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. When TRANS = 'N' or 'n'
-*> then LDA must be at least max( 1, n ), otherwise LDA must
-*> be at least max( 1, k ).
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> On entry, BETA specifies the scalar beta.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (NT)
-*> NT = N*(N+1)/2. On entry, the symmetric matrix C in RFP
-*> Format. RFP Format is described by TRANSR, UPLO and N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
- $ C )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- REAL ALPHA, BETA
- INTEGER K, LDA, N
- CHARACTER TRANS, TRANSR, UPLO
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), C( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NORMALTRANSR, NISODD, NOTRANS
- INTEGER INFO, NROWA, J, NK, N1, N2
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SSYRK, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- NOTRANS = LSAME( TRANS, 'N' )
-*
- IF( NOTRANS ) THEN
- NROWA = N
- ELSE
- NROWA = K
- END IF
-*
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSFRK ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
-* The quick return case: ((ALPHA.EQ.0).AND.(BETA.NE.ZERO)) is not
-* done (it is in SSYRK for example) and left in the general case.
-*
- IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
- $ ( BETA.EQ.ONE ) ) )RETURN
-*
- IF( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ZERO ) ) THEN
- DO J = 1, ( ( N*( N+1 ) ) / 2 )
- C( J ) = ZERO
- END DO
- RETURN
- END IF
-*
-* C is N-by-N.
-* If N is odd, set NISODD = .TRUE., and N1 and N2.
-* If N is even, NISODD = .FALSE., and NK.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- NISODD = .FALSE.
- NK = N / 2
- ELSE
- NISODD = .TRUE.
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
- END IF
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
-*
- CALL SSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N )
- CALL SSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- $ BETA, C( N+1 ), N )
- CALL SGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'T'
-*
- CALL SSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N )
- CALL SSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- $ BETA, C( N+1 ), N )
- CALL SGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
-*
- END IF
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
-*
- CALL SSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2+1 ), N )
- CALL SSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
- $ BETA, C( N1+1 ), N )
- CALL SGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( N2, 1 ), LDA, BETA, C( 1 ), N )
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'T'
-*
- CALL SSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2+1 ), N )
- CALL SSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), LDA,
- $ BETA, C( N1+1 ), N )
- CALL SGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, N2 ), LDA, BETA, C( 1 ), N )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is odd, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'T', UPLO = 'L', and TRANS = 'N'
-*
- CALL SSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N1 )
- CALL SSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- $ BETA, C( 2 ), N1 )
- CALL SGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( N1+1, 1 ), LDA, BETA,
- $ C( N1*N1+1 ), N1 )
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', UPLO = 'L', and TRANS = 'T'
-*
- CALL SSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 1 ), N1 )
- CALL SSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- $ BETA, C( 2 ), N1 )
- CALL SGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, N1+1 ), LDA, BETA,
- $ C( N1*N1+1 ), N1 )
-*
- END IF
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is odd, TRANSR = 'T', UPLO = 'U', and TRANS = 'N'
-*
- CALL SSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2*N2+1 ), N2 )
- CALL SSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- $ BETA, C( N1*N2+1 ), N2 )
- CALL SGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', UPLO = 'U', and TRANS = 'T'
-*
- CALL SSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( N2*N2+1 ), N2 )
- CALL SSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- $ BETA, C( N1*N2+1 ), N2 )
- CALL SGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
-*
- CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 2 ), N+1 )
- CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( 1 ), N+1 )
- CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
- $ N+1 )
-*
- ELSE
-*
-* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'T'
-*
- CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( 2 ), N+1 )
- CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( 1 ), N+1 )
- CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
- $ N+1 )
-*
- END IF
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
-*
- CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+2 ), N+1 )
- CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( NK+1 ), N+1 )
- CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( NK+1, 1 ), LDA, BETA, C( 1 ),
- $ N+1 )
-*
- ELSE
-*
-* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'T'
-*
- CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+2 ), N+1 )
- CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( NK+1 ), N+1 )
- CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, NK+1 ), LDA, BETA, C( 1 ),
- $ N+1 )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'T', UPLO = 'L', and TRANS = 'N'
-*
- CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+1 ), NK )
- CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( 1 ), NK )
- CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( NK+1, 1 ), LDA, BETA,
- $ C( ( ( NK+1 )*NK )+1 ), NK )
-*
- ELSE
-*
-* N is even, TRANSR = 'T', UPLO = 'L', and TRANS = 'T'
-*
- CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK+1 ), NK )
- CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( 1 ), NK )
- CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ),
- $ LDA, A( 1, NK+1 ), LDA, BETA,
- $ C( ( ( NK+1 )*NK )+1 ), NK )
-*
- END IF
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* N is even, TRANSR = 'T', UPLO = 'U', and TRANS = 'N'
-*
- CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK*( NK+1 )+1 ), NK )
- CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- $ BETA, C( NK*NK+1 ), NK )
- CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
-*
- ELSE
-*
-* N is even, TRANSR = 'T', UPLO = 'U', and TRANS = 'T'
-*
- CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- $ BETA, C( NK*( NK+1 )+1 ), NK )
- CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- $ BETA, C( NK*NK+1 ), NK )
- CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ),
- $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of SSFRK
-*
- END
diff --git a/netlib/LAPACK/sspcon.f b/netlib/LAPACK/sspcon.f
deleted file mode 100644
index ae2f742..0000000
--- a/netlib/LAPACK/sspcon.f
+++ /dev/null
@@ -1,238 +0,0 @@
-*> \brief \b SSPCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric packed matrix A using the factorization
-*> A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSPTRF, stored as a
-*> packed triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSPTRF.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> The 1-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IP, KASE
- REAL AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SSPTRS, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.LE.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- IP = N*( N+1 ) / 2
- DO 10 I = N, 1, -1
- IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
- $ RETURN
- IP = IP - I
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- IP = 1
- DO 20 I = 1, N
- IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
- $ RETURN
- IP = IP + N - I + 1
- 20 CONTINUE
- END IF
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- 30 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
-*
-* Multiply by inv(L*D*L**T) or inv(U*D*U**T).
-*
- CALL SSPTRS( UPLO, N, 1, AP, IPIV, WORK, N, INFO )
- GO TO 30
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of SSPCON
-*
- END
diff --git a/netlib/LAPACK/sspev.f b/netlib/LAPACK/sspev.f
deleted file mode 100644
index 9f4b4b2..0000000
--- a/netlib/LAPACK/sspev.f
+++ /dev/null
@@ -1,262 +0,0 @@
-*> \brief <b> SSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPEV computes all the eigenvalues and, optionally, eigenvectors of a
-*> real symmetric matrix A in packed storage.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, AP is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
-*> and first superdiagonal of the tridiagonal matrix T overwrite
-*> the corresponding elements of A, and if UPLO = 'L', the
-*> diagonal and first subdiagonal of T overwrite the
-*> corresponding elements of A.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTZ
- INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE
- REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSP
- EXTERNAL LSAME, SLAMCH, SLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL SOPGTR, SSCAL, SSPTRD, SSTEQR, SSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPEV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = AP( 1 )
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = SLANSP( 'M', UPLO, N, AP, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
- END IF
-*
-* Call SSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- CALL SSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, first call
-* SOPGTR to generate the orthogonal matrix, then call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- INDWRK = INDTAU + N
- CALL SOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDTAU ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
- RETURN
-*
-* End of SSPEV
-*
- END
diff --git a/netlib/LAPACK/sspevd.f b/netlib/LAPACK/sspevd.f
deleted file mode 100644
index aea1e3f..0000000
--- a/netlib/LAPACK/sspevd.f
+++ /dev/null
@@ -1,337 +0,0 @@
-*> \brief <b> SSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
-* IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPEVD computes all the eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A in packed storage. If eigenvectors are
-*> desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, AP is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
-*> and first superdiagonal of the tridiagonal matrix T overwrite
-*> the corresponding elements of A, and if UPLO = 'L', the
-*> diagonal and first subdiagonal of T overwrite the
-*> corresponding elements of A.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the required LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK must be at least 1.
-*> If JOBZ = 'N' and N > 1, LWORK must be at least 2*N.
-*> If JOBZ = 'V' and N > 1, LWORK must be at least
-*> 1 + 6*N + N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the required sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the required sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTZ
- INTEGER IINFO, INDE, INDTAU, INDWRK, ISCALE, LIWMIN,
- $ LLWORK, LWMIN
- REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSP
- EXTERNAL LSAME, SLAMCH, SLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL SOPMTR, SSCAL, SSPTRD, SSTEDC, SSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
- END IF
- IWORK( 1 ) = LIWMIN
- WORK( 1 ) = LWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -9
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = AP( 1 )
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = SLANSP( 'M', UPLO, N, AP, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
- END IF
-*
-* Call SSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- CALL SSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, first call
-* SSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
-* tridiagonal matrix, then call SOPMTR to multiply it by the
-* Householder transformations represented in AP.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- INDWRK = INDTAU + N
- LLWORK = LWORK - INDWRK + 1
- CALL SSTEDC( 'I', N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
- $ LLWORK, IWORK, LIWORK, INFO )
- CALL SOPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL SSCAL( N, ONE / SIGMA, W, 1 )
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of SSPEVD
-*
- END
diff --git a/netlib/LAPACK/sspevx.f b/netlib/LAPACK/sspevx.f
deleted file mode 100644
index 565aedf..0000000
--- a/netlib/LAPACK/sspevx.f
+++ /dev/null
@@ -1,489 +0,0 @@
-*> \brief <b> SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, LDZ, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A in packed storage. Eigenvalues/vectors
-*> can be selected by specifying either a range of values or a range of
-*> indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found;
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found;
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, AP is overwritten by values generated during the
-*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
-*> and first superdiagonal of the tridiagonal matrix T overwrite
-*> the corresponding elements of A, and if UPLO = 'L', the
-*> diagonal and first subdiagonal of T overwrite the
-*> corresponding elements of A.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing AP to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the selected eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, LDZ, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
- CHARACTER ORDER
- INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
- $ INDISP, INDIWO, INDTAU, INDWRK, ISCALE, ITMP1,
- $ J, JJ, NSPLIT
- REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSP
- EXTERNAL LSAME, SLAMCH, SLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SOPGTR, SOPMTR, SSCAL, SSPTRD, SSTEBZ,
- $ SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) )
- $ THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -7
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -9
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
- $ INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPEVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = AP( 1 )
- ELSE
- IF( VL.LT.AP( 1 ) .AND. VU.GE.AP( 1 ) ) THEN
- M = 1
- W( 1 ) = AP( 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF ( VALEIG ) THEN
- VLL = VL
- VUU = VU
- ELSE
- VLL = ZERO
- VUU = ZERO
- ENDIF
- ANRM = SLANSP( 'M', UPLO, N, AP, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* Call SSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
- INDTAU = 1
- INDE = INDTAU + N
- INDD = INDE + N
- INDWRK = INDD + N
- CALL SSPTRD( UPLO, N, AP, WORK( INDD ), WORK( INDE ),
- $ WORK( INDTAU ), IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal
-* to zero, then call SSTERF or SOPGTR and SSTEQR. If this fails
-* for some eigenvalue, then try SSTEBZ.
-*
- TEST = .FALSE.
- IF (INDEIG) THEN
- IF (IL.EQ.1 .AND. IU.EQ.N) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
- CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- IF( .NOT.WANTZ ) THEN
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL SOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 20
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by SSTEIN.
-*
- CALL SOPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, LDZ,
- $ WORK( INDWRK ), IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 20 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 40 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 30 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 30 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSPEVX
-*
- END
diff --git a/netlib/LAPACK/sspgst.f b/netlib/LAPACK/sspgst.f
deleted file mode 100644
index dadd484..0000000
--- a/netlib/LAPACK/sspgst.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b SSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPGST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspgst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspgst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspgst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPGST( ITYPE, UPLO, N, AP, BP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITYPE, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), BP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPGST reduces a real symmetric-definite generalized eigenproblem
-*> to standard form, using packed storage.
-*>
-*> If ITYPE = 1, the problem is A*x = lambda*B*x,
-*> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*>
-*> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*> B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
-*>
-*> B must have been previously factorized as U**T*U or L*L**T by SPPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*> = 2 or 3: compute U*A*U**T or L**T*A*L.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored and B is factored as
-*> U**T*U;
-*> = 'L': Lower triangle of A is stored and B is factored as
-*> L*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, if INFO = 0, the transformed matrix, stored in the
-*> same format as A.
-*> \endverbatim
-*>
-*> \param[in] BP
-*> \verbatim
-*> BP is REAL array, dimension (N*(N+1)/2)
-*> The triangular factor from the Cholesky factorization of B,
-*> stored in the same format as A, as returned by SPPTRF.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSPGST( ITYPE, UPLO, N, AP, BP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITYPE, N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), BP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, HALF
- PARAMETER ( ONE = 1.0, HALF = 0.5 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, J1, J1J1, JJ, K, K1, K1K1, KK
- REAL AJJ, AKK, BJJ, BKK, CT
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SSCAL, SSPMV, SSPR2, STPMV, STPSV,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPGST', -INFO )
- RETURN
- END IF
-*
- IF( ITYPE.EQ.1 ) THEN
- IF( UPPER ) THEN
-*
-* Compute inv(U**T)*A*inv(U)
-*
-* J1 and JJ are the indices of A(1,j) and A(j,j)
-*
- JJ = 0
- DO 10 J = 1, N
- J1 = JJ + 1
- JJ = JJ + J
-*
-* Compute the j-th column of the upper triangle of A
-*
- BJJ = BP( JJ )
- CALL STPSV( UPLO, 'Transpose', 'Nonunit', J, BP,
- $ AP( J1 ), 1 )
- CALL SSPMV( UPLO, J-1, -ONE, AP, BP( J1 ), 1, ONE,
- $ AP( J1 ), 1 )
- CALL SSCAL( J-1, ONE / BJJ, AP( J1 ), 1 )
- AP( JJ ) = ( AP( JJ )-SDOT( J-1, AP( J1 ), 1, BP( J1 ),
- $ 1 ) ) / BJJ
- 10 CONTINUE
- ELSE
-*
-* Compute inv(L)*A*inv(L**T)
-*
-* KK and K1K1 are the indices of A(k,k) and A(k+1,k+1)
-*
- KK = 1
- DO 20 K = 1, N
- K1K1 = KK + N - K + 1
-*
-* Update the lower triangle of A(k:n,k:n)
-*
- AKK = AP( KK )
- BKK = BP( KK )
- AKK = AKK / BKK**2
- AP( KK ) = AKK
- IF( K.LT.N ) THEN
- CALL SSCAL( N-K, ONE / BKK, AP( KK+1 ), 1 )
- CT = -HALF*AKK
- CALL SAXPY( N-K, CT, BP( KK+1 ), 1, AP( KK+1 ), 1 )
- CALL SSPR2( UPLO, N-K, -ONE, AP( KK+1 ), 1,
- $ BP( KK+1 ), 1, AP( K1K1 ) )
- CALL SAXPY( N-K, CT, BP( KK+1 ), 1, AP( KK+1 ), 1 )
- CALL STPSV( UPLO, 'No transpose', 'Non-unit', N-K,
- $ BP( K1K1 ), AP( KK+1 ), 1 )
- END IF
- KK = K1K1
- 20 CONTINUE
- END IF
- ELSE
- IF( UPPER ) THEN
-*
-* Compute U*A*U**T
-*
-* K1 and KK are the indices of A(1,k) and A(k,k)
-*
- KK = 0
- DO 30 K = 1, N
- K1 = KK + 1
- KK = KK + K
-*
-* Update the upper triangle of A(1:k,1:k)
-*
- AKK = AP( KK )
- BKK = BP( KK )
- CALL STPMV( UPLO, 'No transpose', 'Non-unit', K-1, BP,
- $ AP( K1 ), 1 )
- CT = HALF*AKK
- CALL SAXPY( K-1, CT, BP( K1 ), 1, AP( K1 ), 1 )
- CALL SSPR2( UPLO, K-1, ONE, AP( K1 ), 1, BP( K1 ), 1,
- $ AP )
- CALL SAXPY( K-1, CT, BP( K1 ), 1, AP( K1 ), 1 )
- CALL SSCAL( K-1, BKK, AP( K1 ), 1 )
- AP( KK ) = AKK*BKK**2
- 30 CONTINUE
- ELSE
-*
-* Compute L**T *A*L
-*
-* JJ and J1J1 are the indices of A(j,j) and A(j+1,j+1)
-*
- JJ = 1
- DO 40 J = 1, N
- J1J1 = JJ + N - J + 1
-*
-* Compute the j-th column of the lower triangle of A
-*
- AJJ = AP( JJ )
- BJJ = BP( JJ )
- AP( JJ ) = AJJ*BJJ + SDOT( N-J, AP( JJ+1 ), 1,
- $ BP( JJ+1 ), 1 )
- CALL SSCAL( N-J, BJJ, AP( JJ+1 ), 1 )
- CALL SSPMV( UPLO, N-J, ONE, AP( J1J1 ), BP( JJ+1 ), 1,
- $ ONE, AP( JJ+1 ), 1 )
- CALL STPMV( UPLO, 'Transpose', 'Non-unit', N-J+1,
- $ BP( JJ ), AP( JJ ), 1 )
- JJ = J1J1
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of SSPGST
-*
- END
diff --git a/netlib/LAPACK/sspgv.f b/netlib/LAPACK/sspgv.f
deleted file mode 100644
index b6a0fe6..0000000
--- a/netlib/LAPACK/sspgv.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b SSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspgv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspgv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspgv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), BP( * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPGV computes all the eigenvalues and, optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
-*> Here A and B are assumed to be symmetric, stored in packed format,
-*> and B is also positive definite.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension
-*> (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the contents of AP are destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] BP
-*> \verbatim
-*> BP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> B, packed columnwise in a linear array. The j-th column of B
-*> is stored in the array BP as follows:
-*> if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*> if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*>
-*> On exit, the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T, in the same storage
-*> format as B.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors. The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: SPPTRF or SSPEV returned an error code:
-*> <= N: if INFO = i, SSPEV failed to converge;
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero.
-*> > N: if INFO = n + i, for 1 <= i <= n, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
- $ INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), BP( * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER, WANTZ
- CHARACTER TRANS
- INTEGER J, NEIG
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPPTRF, SSPEV, SSPGST, STPMV, STPSV, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPGV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL SPPTRF( UPLO, N, BP, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL SSPGST( ITYPE, UPLO, N, AP, BP, INFO )
- CALL SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- NEIG = N
- IF( INFO.GT.0 )
- $ NEIG = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- DO 10 J = 1, NEIG
- CALL STPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 10 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- DO 20 J = 1, NEIG
- CALL STPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 20 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of SSPGV
-*
- END
diff --git a/netlib/LAPACK/sspgvd.f b/netlib/LAPACK/sspgvd.f
deleted file mode 100644
index 17de0ed..0000000
--- a/netlib/LAPACK/sspgvd.f
+++ /dev/null
@@ -1,364 +0,0 @@
-*> \brief \b SSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPGVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspgvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspgvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspgvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
-* LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AP( * ), BP( * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPGVD computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
-*> B are assumed to be symmetric, stored in packed format, and B is also
-*> positive definite.
-*> If eigenvectors are desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the contents of AP are destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] BP
-*> \verbatim
-*> BP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> B, packed columnwise in a linear array. The j-th column of B
-*> is stored in the array BP as follows:
-*> if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*> if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*>
-*> On exit, the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T, in the same storage
-*> format as B.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
-*> eigenvectors. The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the required LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LWORK >= 2*N.
-*> If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the required sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1, LIWORK >= 1.
-*> If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the required sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: SPPTRF or SSPEVD returned an error code:
-*> <= N: if INFO = i, SSPEVD failed to converge;
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE SSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
- $ LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AP( * ), BP( * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER TRANS
- INTEGER J, LIWMIN, LWMIN, NEIG
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPPTRF, SSPEVD, SSPGST, STPMV, STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N
- END IF
- END IF
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPGVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of BP.
-*
- CALL SPPTRF( UPLO, N, BP, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL SSPGST( ITYPE, UPLO, N, AP, BP, INFO )
- CALL SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
- LWMIN = MAX( REAL( LWMIN ), REAL( WORK( 1 ) ) )
- LIWMIN = MAX( REAL( LIWMIN ), REAL( IWORK( 1 ) ) )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- NEIG = N
- IF( INFO.GT.0 )
- $ NEIG = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T *y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- DO 10 J = 1, NEIG
- CALL STPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 10 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T *y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- DO 20 J = 1, NEIG
- CALL STPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 20 CONTINUE
- END IF
- END IF
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of SSPGVD
-*
- END
diff --git a/netlib/LAPACK/sspgvx.f b/netlib/LAPACK/sspgvx.f
deleted file mode 100644
index 0fe1071..0000000
--- a/netlib/LAPACK/sspgvx.f
+++ /dev/null
@@ -1,408 +0,0 @@
-*> \brief \b SSPGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPGVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspgvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspgvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspgvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU,
-* IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
-* IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, ITYPE, IU, LDZ, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL AP( * ), BP( * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPGVX computes selected eigenvalues, and optionally, eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
-*> and B are assumed to be symmetric, stored in packed storage, and B
-*> is also positive definite. Eigenvalues and eigenvectors can be
-*> selected by specifying either a range of values or a range of indices
-*> for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A and B are stored;
-*> = 'L': Lower triangle of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix pencil (A,B). N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the contents of AP are destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] BP
-*> \verbatim
-*> BP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> B, packed columnwise in a linear array. The j-th column of B
-*> is stored in the array BP as follows:
-*> if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*> if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*>
-*> On exit, the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T, in the same storage
-*> format as B.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On normal exit, the first M elements contain the selected
-*> eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'N', then Z is not referenced.
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*>
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (8*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: SPPTRF or SSPEVX returned an error code:
-*> <= N: if INFO = i, SSPEVX failed to converge;
-*> i eigenvectors failed to converge. Their indices
-*> are stored in array IFAIL.
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE SSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU,
- $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK,
- $ IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, ITYPE, IU, LDZ, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL AP( * ), BP( * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, UPPER, VALEIG, WANTZ
- CHARACTER TRANS
- INTEGER J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPPTRF, SSPEVX, SSPGST, STPMV, STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- UPPER = LSAME( UPLO, 'U' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL ) THEN
- INFO = -9
- END IF
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 ) THEN
- INFO = -10
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -11
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -16
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPGVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL SPPTRF( UPLO, N, BP, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL SSPGST( ITYPE, UPLO, N, AP, BP, INFO )
- CALL SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M,
- $ W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- IF( INFO.GT.0 )
- $ M = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- DO 10 J = 1, M
- CALL STPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 10 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- DO 20 J = 1, M
- CALL STPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
- $ 1 )
- 20 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SSPGVX
-*
- END
diff --git a/netlib/LAPACK/ssprfs.f b/netlib/LAPACK/ssprfs.f
deleted file mode 100644
index 4516e44..0000000
--- a/netlib/LAPACK/ssprfs.f
+++ /dev/null
@@ -1,431 +0,0 @@
-*> \brief \b SSPRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssprfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssprfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssprfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX,
-* FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric indefinite
-*> and packed, and provides error bounds and backward error estimates
-*> for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] AFP
-*> \verbatim
-*> AFP is REAL array, dimension (N*(N+1)/2)
-*> The factored form of the matrix A. AFP contains the block
-*> diagonal matrix D and the multipliers used to obtain the
-*> factor U or L from the factorization A = U*D*U**T or
-*> A = L*D*L**T as computed by SSPTRF, stored as a packed
-*> triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSPTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SSPTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX,
- $ FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, IK, J, K, KASE, KK, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, SSPMV, SSPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ),
- $ 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- KK = 1
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- IK = KK
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( AP( KK+K-1 ) )*XK + S
- KK = KK + K
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( AP( KK ) )*XK
- IK = KK + 1
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( IK ) )*XK
- S = S + ABS( AP( IK ) )*ABS( X( I, J ) )
- IK = IK + 1
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- KK = KK + ( N-K+1 )
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N, INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL SSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N,
- $ INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL SSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SSPRFS
-*
- END
diff --git a/netlib/LAPACK/sspsv.f b/netlib/LAPACK/sspsv.f
deleted file mode 100644
index 87bb848..0000000
--- a/netlib/LAPACK/sspsv.f
+++ /dev/null
@@ -1,224 +0,0 @@
-*> \brief <b> SSPSV computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspsv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspsv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspsv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric matrix stored in packed format and X
-*> and B are N-by-NRHS matrices.
-*>
-*> The diagonal pivoting method is used to factor A as
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, D is symmetric and block diagonal with 1-by-1
-*> and 2-by-2 diagonal blocks. The factored form of A is then used to
-*> solve the system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
-*> a packed triangular matrix in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D, as
-*> determined by SSPTRF. If IPIV(k) > 0, then rows and columns
-*> k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
-*> diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
-*> then rows and columns k-1 and -IPIV(k) were interchanged and
-*> D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
-*> IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
-*> -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
-*> diagonal block.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, so the solution could not be
-*> computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = aji)
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSPTRF, SSPTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL SSPTRF( UPLO, N, AP, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
- END IF
- RETURN
-*
-* End of SSPSV
-*
- END
diff --git a/netlib/LAPACK/sspsvx.f b/netlib/LAPACK/sspsvx.f
deleted file mode 100644
index 41ccbf1..0000000
--- a/netlib/LAPACK/sspsvx.f
+++ /dev/null
@@ -1,386 +0,0 @@
-*> \brief <b> SSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspsvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspsvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspsvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
-* LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPSVX uses the diagonal pivoting factorization A = U*D*U**T or
-*> A = L*D*L**T to compute the solution to a real system of linear
-*> equations A * X = B, where A is an N-by-N symmetric matrix stored
-*> in packed format and X and B are N-by-NRHS matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the diagonal pivoting method is used to factor A as
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> 2. If some D(i,i)=0, so that D is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': On entry, AFP and IPIV contain the factored form of
-*> A. AP, AFP and IPIV will not be modified.
-*> = 'N': The matrix A will be copied to AFP and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangle of the symmetric matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in,out] AFP
-*> \verbatim
-*> AFP is REAL array, dimension
-*> (N*(N+1)/2)
-*> If FACT = 'F', then AFP is an input argument and on entry
-*> contains the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
-*> a packed triangular matrix in the same storage format as A.
-*>
-*> If FACT = 'N', then AFP is an output argument and on exit
-*> contains the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
-*> a packed triangular matrix in the same storage format as A.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains details of the interchanges and the block structure
-*> of D, as determined by SSPTRF.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains details of the interchanges and the block structure
-*> of D, as determined by SSPTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: D(i,i) is exactly zero. The factorization
-*> has been completed but the factor D is exactly
-*> singular, so the solution and error bounds could
-*> not be computed. RCOND = 0 is returned.
-*> = N+1: D is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The packed storage scheme is illustrated by the following example
-*> when N = 4, UPLO = 'U':
-*>
-*> Two-dimensional storage of the symmetric matrix A:
-*>
-*> a11 a12 a13 a14
-*> a22 a23 a24
-*> a33 a34 (aij = aji)
-*> a44
-*>
-*> Packed storage of the upper triangle of A:
-*>
-*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
- $ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL AFP( * ), AP( * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT
- REAL ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANSP
- EXTERNAL LSAME, SLAMCH, SLANSP
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SSPCON, SSPRFS, SSPTRF, SSPTRS,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL SCOPY( N*( N+1 ) / 2, AP, 1, AFP, 1 )
- CALL SSPTRF( UPLO, N, AFP, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = SLANSP( 'I', UPLO, N, AP, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SSPCON( UPLO, N, AFP, IPIV, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SSPTRS( UPLO, N, NRHS, AFP, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR,
- $ BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of SSPSVX
-*
- END
diff --git a/netlib/LAPACK/ssptrd.f b/netlib/LAPACK/ssptrd.f
deleted file mode 100644
index 530693e..0000000
--- a/netlib/LAPACK/ssptrd.f
+++ /dev/null
@@ -1,299 +0,0 @@
-*> \brief \b SSPTRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPTRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssptrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssptrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssptrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPTRD( UPLO, N, AP, D, E, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), D( * ), E( * ), TAU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPTRD reduces a real symmetric matrix A stored in packed form to
-*> symmetric tridiagonal form T by an orthogonal similarity
-*> transformation: Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
-*> of A are overwritten by the corresponding elements of the
-*> tridiagonal matrix T, and the elements above the first
-*> superdiagonal, with the array TAU, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; if UPLO
-*> = 'L', the diagonal and first subdiagonal of A are over-
-*> written by the corresponding elements of the tridiagonal
-*> matrix T, and the elements below the first subdiagonal, with
-*> the array TAU, represent the orthogonal matrix Q as a product
-*> of elementary reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n-1) . . . H(2) H(1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
-*> overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(n-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
-*> overwriting A(i+2:n,i), and tau is stored in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSPTRD( UPLO, N, AP, D, E, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL AP( * ), D( * ), E( * ), TAU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO, HALF
- PARAMETER ( ONE = 1.0, ZERO = 0.0, HALF = 1.0 / 2.0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, I1, I1I1, II
- REAL ALPHA, TAUI
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SLARFG, SSPMV, SSPR2, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPTRD', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Reduce the upper triangle of A.
-* I1 is the index in AP of A(1,I+1).
-*
- I1 = N*( N-1 ) / 2 + 1
- DO 10 I = N - 1, 1, -1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(1:i-1,i+1)
-*
- CALL SLARFG( I, AP( I1+I-1 ), AP( I1 ), 1, TAUI )
- E( I ) = AP( I1+I-1 )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(1:i,1:i)
-*
- AP( I1+I-1 ) = ONE
-*
-* Compute y := tau * A * v storing y in TAU(1:i)
-*
- CALL SSPMV( UPLO, I, TAUI, AP, AP( I1 ), 1, ZERO, TAU,
- $ 1 )
-*
-* Compute w := y - 1/2 * tau * (y**T *v) * v
-*
- ALPHA = -HALF*TAUI*SDOT( I, TAU, 1, AP( I1 ), 1 )
- CALL SAXPY( I, ALPHA, AP( I1 ), 1, TAU, 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL SSPR2( UPLO, I, -ONE, AP( I1 ), 1, TAU, 1, AP )
-*
- AP( I1+I-1 ) = E( I )
- END IF
- D( I+1 ) = AP( I1+I )
- TAU( I ) = TAUI
- I1 = I1 - I
- 10 CONTINUE
- D( 1 ) = AP( 1 )
- ELSE
-*
-* Reduce the lower triangle of A. II is the index in AP of
-* A(i,i) and I1I1 is the index of A(i+1,i+1).
-*
- II = 1
- DO 20 I = 1, N - 1
- I1I1 = II + N - I + 1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(i+2:n,i)
-*
- CALL SLARFG( N-I, AP( II+1 ), AP( II+2 ), 1, TAUI )
- E( I ) = AP( II+1 )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
- AP( II+1 ) = ONE
-*
-* Compute y := tau * A * v storing y in TAU(i:n-1)
-*
- CALL SSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1,
- $ ZERO, TAU( I ), 1 )
-*
-* Compute w := y - 1/2 * tau * (y**T *v) * v
-*
- ALPHA = -HALF*TAUI*SDOT( N-I, TAU( I ), 1, AP( II+1 ),
- $ 1 )
- CALL SAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL SSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1,
- $ AP( I1I1 ) )
-*
- AP( II+1 ) = E( I )
- END IF
- D( I ) = AP( II )
- TAU( I ) = TAUI
- II = I1I1
- 20 CONTINUE
- D( N ) = AP( II )
- END IF
-*
- RETURN
-*
-* End of SSPTRD
-*
- END
diff --git a/netlib/LAPACK/ssptrf.f b/netlib/LAPACK/ssptrf.f
deleted file mode 100644
index 592a0dd..0000000
--- a/netlib/LAPACK/ssptrf.f
+++ /dev/null
@@ -1,614 +0,0 @@
-*> \brief \b SSPTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssptrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssptrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssptrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPTRF( UPLO, N, AP, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPTRF computes the factorization of a real symmetric matrix A stored
-*> in packed format using the Bunch-Kaufman diagonal pivoting method:
-*>
-*> A = U*D*U**T or A = L*D*L**T
-*>
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangle of the symmetric matrix
-*> A, packed columnwise in a linear array. The j-th column of A
-*> is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L, stored as a packed triangular
-*> matrix overwriting A (see below for further details).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> 5-96 - Based on modifications by J. Lewis, Boeing Computer Services
-*> Company
-*>
-*> If UPLO = 'U', then A = U*D*U**T, where
-*> U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*> i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I v 0 ) k-s
-*> U(k) = ( 0 I 0 ) s
-*> ( 0 0 I ) n-k
-*> k-s s n-k
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*> If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*> and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*>
-*> If UPLO = 'L', then A = L*D*L**T, where
-*> L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*> i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*> n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I 0 0 ) k-1
-*> L(k) = ( 0 I 0 ) s
-*> ( 0 v I ) n-k-s+1
-*> k-1 s n-k-s+1
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*> If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*> and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSPTRF( UPLO, N, AP, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL EIGHT, SEVTEN
- PARAMETER ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IMAX, J, JMAX, K, KC, KK, KNC, KP, KPC,
- $ KSTEP, KX, NPP
- REAL ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
- $ ROWMAX, T, WK, WKM1, WKP1
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- EXTERNAL LSAME, ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSPR, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPTRF', -INFO )
- RETURN
- END IF
-*
-* Initialize ALPHA for use in choosing pivot block size.
-*
- ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
- IF( UPPER ) THEN
-*
-* Factorize A as U*D*U**T using the upper triangle of A
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2
-*
- K = N
- KC = ( N-1 )*N / 2 + 1
- 10 CONTINUE
- KNC = KC
-*
-* If K < 1, exit from loop
-*
- IF( K.LT.1 )
- $ GO TO 110
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( AP( KC+K-1 ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.GT.1 ) THEN
- IMAX = ISAMAX( K-1, AP( KC ), 1 )
- COLMAX = ABS( AP( KC+IMAX-1 ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
- ROWMAX = ZERO
- JMAX = IMAX
- KX = IMAX*( IMAX+1 ) / 2 + IMAX
- DO 20 J = IMAX + 1, K
- IF( ABS( AP( KX ) ).GT.ROWMAX ) THEN
- ROWMAX = ABS( AP( KX ) )
- JMAX = J
- END IF
- KX = KX + J
- 20 CONTINUE
- KPC = ( IMAX-1 )*IMAX / 2 + 1
- IF( IMAX.GT.1 ) THEN
- JMAX = ISAMAX( IMAX-1, AP( KPC ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( AP( KPC+JMAX-1 ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( AP( KPC+IMAX-1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K-1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K - KSTEP + 1
- IF( KSTEP.EQ.2 )
- $ KNC = KNC - K + 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the leading
-* submatrix A(1:k,1:k)
-*
- CALL SSWAP( KP-1, AP( KNC ), 1, AP( KPC ), 1 )
- KX = KPC + KP - 1
- DO 30 J = KP + 1, KK - 1
- KX = KX + J - 1
- T = AP( KNC+J-1 )
- AP( KNC+J-1 ) = AP( KX )
- AP( KX ) = T
- 30 CONTINUE
- T = AP( KNC+KK-1 )
- AP( KNC+KK-1 ) = AP( KPC+KP-1 )
- AP( KPC+KP-1 ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = AP( KC+K-2 )
- AP( KC+K-2 ) = AP( KC+KP-1 )
- AP( KC+KP-1 ) = T
- END IF
- END IF
-*
-* Update the leading submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = U(k)*D(k)
-*
-* where U(k) is the k-th column of U
-*
-* Perform a rank-1 update of A(1:k-1,1:k-1) as
-*
-* A := A - U(k)*D(k)*U(k)**T = A - W(k)*1/D(k)*W(k)**T
-*
- R1 = ONE / AP( KC+K-1 )
- CALL SSPR( UPLO, K-1, -R1, AP( KC ), 1, AP )
-*
-* Store U(k) in column k
-*
- CALL SSCAL( K-1, R1, AP( KC ), 1 )
- ELSE
-*
-* 2-by-2 pivot block D(k): columns k and k-1 now hold
-*
-* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
-*
-* where U(k) and U(k-1) are the k-th and (k-1)-th columns
-* of U
-*
-* Perform a rank-2 update of A(1:k-2,1:k-2) as
-*
-* A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
-* = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )**T
-*
- IF( K.GT.2 ) THEN
-*
- D12 = AP( K-1+( K-1 )*K / 2 )
- D22 = AP( K-1+( K-2 )*( K-1 ) / 2 ) / D12
- D11 = AP( K+( K-1 )*K / 2 ) / D12
- T = ONE / ( D11*D22-ONE )
- D12 = T / D12
-*
- DO 50 J = K - 2, 1, -1
- WKM1 = D12*( D11*AP( J+( K-2 )*( K-1 ) / 2 )-
- $ AP( J+( K-1 )*K / 2 ) )
- WK = D12*( D22*AP( J+( K-1 )*K / 2 )-
- $ AP( J+( K-2 )*( K-1 ) / 2 ) )
- DO 40 I = J, 1, -1
- AP( I+( J-1 )*J / 2 ) = AP( I+( J-1 )*J / 2 ) -
- $ AP( I+( K-1 )*K / 2 )*WK -
- $ AP( I+( K-2 )*( K-1 ) / 2 )*WKM1
- 40 CONTINUE
- AP( J+( K-1 )*K / 2 ) = WK
- AP( J+( K-2 )*( K-1 ) / 2 ) = WKM1
- 50 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K-1 ) = -KP
- END IF
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KSTEP
- KC = KNC - K
- GO TO 10
-*
- ELSE
-*
-* Factorize A as L*D*L**T using the lower triangle of A
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2
-*
- K = 1
- KC = 1
- NPP = N*( N+1 ) / 2
- 60 CONTINUE
- KNC = KC
-*
-* If K > N, exit from loop
-*
- IF( K.GT.N )
- $ GO TO 110
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( AP( KC ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.LT.N ) THEN
- IMAX = K + ISAMAX( N-K, AP( KC+1 ), 1 )
- COLMAX = ABS( AP( KC+IMAX-K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-* Column K is zero: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- ROWMAX = ZERO
- KX = KC + IMAX - K
- DO 70 J = K, IMAX - 1
- IF( ABS( AP( KX ) ).GT.ROWMAX ) THEN
- ROWMAX = ABS( AP( KX ) )
- JMAX = J
- END IF
- KX = KX + N - J
- 70 CONTINUE
- KPC = NPP - ( N-IMAX+1 )*( N-IMAX+2 ) / 2 + 1
- IF( IMAX.LT.N ) THEN
- JMAX = IMAX + ISAMAX( N-IMAX, AP( KPC+1 ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( AP( KPC+JMAX-IMAX ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( AP( KPC ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K+1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K + KSTEP - 1
- IF( KSTEP.EQ.2 )
- $ KNC = KNC + N - K + 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the trailing
-* submatrix A(k:n,k:n)
-*
- IF( KP.LT.N )
- $ CALL SSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ),
- $ 1 )
- KX = KNC + KP - KK
- DO 80 J = KK + 1, KP - 1
- KX = KX + N - J + 1
- T = AP( KNC+J-KK )
- AP( KNC+J-KK ) = AP( KX )
- AP( KX ) = T
- 80 CONTINUE
- T = AP( KNC )
- AP( KNC ) = AP( KPC )
- AP( KPC ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = AP( KC+1 )
- AP( KC+1 ) = AP( KC+KP-K )
- AP( KC+KP-K ) = T
- END IF
- END IF
-*
-* Update the trailing submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = L(k)*D(k)
-*
-* where L(k) is the k-th column of L
-*
- IF( K.LT.N ) THEN
-*
-* Perform a rank-1 update of A(k+1:n,k+1:n) as
-*
-* A := A - L(k)*D(k)*L(k)**T = A - W(k)*(1/D(k))*W(k)**T
-*
- R1 = ONE / AP( KC )
- CALL SSPR( UPLO, N-K, -R1, AP( KC+1 ), 1,
- $ AP( KC+N-K+1 ) )
-*
-* Store L(k) in column K
-*
- CALL SSCAL( N-K, R1, AP( KC+1 ), 1 )
- END IF
- ELSE
-*
-* 2-by-2 pivot block D(k): columns K and K+1 now hold
-*
-* ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th columns
-* of L
-*
- IF( K.LT.N-1 ) THEN
-*
-* Perform a rank-2 update of A(k+2:n,k+2:n) as
-*
-* A := A - ( L(k) L(k+1) )*D(k)*( L(k) L(k+1) )**T
-* = A - ( W(k) W(k+1) )*inv(D(k))*( W(k) W(k+1) )**T
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th
-* columns of L
-*
- D21 = AP( K+1+( K-1 )*( 2*N-K ) / 2 )
- D11 = AP( K+1+K*( 2*N-K-1 ) / 2 ) / D21
- D22 = AP( K+( K-1 )*( 2*N-K ) / 2 ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
-*
- DO 100 J = K + 2, N
- WK = D21*( D11*AP( J+( K-1 )*( 2*N-K ) / 2 )-
- $ AP( J+K*( 2*N-K-1 ) / 2 ) )
- WKP1 = D21*( D22*AP( J+K*( 2*N-K-1 ) / 2 )-
- $ AP( J+( K-1 )*( 2*N-K ) / 2 ) )
-*
- DO 90 I = J, N
- AP( I+( J-1 )*( 2*N-J ) / 2 ) = AP( I+( J-1 )*
- $ ( 2*N-J ) / 2 ) - AP( I+( K-1 )*( 2*N-K ) /
- $ 2 )*WK - AP( I+K*( 2*N-K-1 ) / 2 )*WKP1
- 90 CONTINUE
-*
- AP( J+( K-1 )*( 2*N-K ) / 2 ) = WK
- AP( J+K*( 2*N-K-1 ) / 2 ) = WKP1
-*
- 100 CONTINUE
- END IF
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K+1 ) = -KP
- END IF
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KSTEP
- KC = KNC + N - K + 2
- GO TO 60
-*
- END IF
-*
- 110 CONTINUE
- RETURN
-*
-* End of SSPTRF
-*
- END
diff --git a/netlib/LAPACK/ssptri.f b/netlib/LAPACK/ssptri.f
deleted file mode 100644
index 0b026e4..0000000
--- a/netlib/LAPACK/ssptri.f
+++ /dev/null
@@ -1,401 +0,0 @@
-*> \brief \b SSPTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssptri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssptri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssptri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPTRI( UPLO, N, AP, IPIV, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPTRI computes the inverse of a real symmetric indefinite matrix
-*> A in packed storage using the factorization A = U*D*U**T or
-*> A = L*D*L**T computed by SSPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the block diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by SSPTRF,
-*> stored as a packed triangular matrix.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix, stored as a packed triangular matrix. The j-th column
-*> of inv(A) is stored in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = inv(A)(i,j) for 1<=i<=j;
-*> if UPLO = 'L',
-*> AP(i + (j-1)*(2n-j)/2) = inv(A)(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSPTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSPTRI( UPLO, N, AP, IPIV, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, K, KC, KCNEXT, KP, KPC, KSTEP, KX, NPP
- REAL AK, AKKP1, AKP1, D, T, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SSPMV, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- KP = N*( N+1 ) / 2
- DO 10 INFO = N, 1, -1
- IF( IPIV( INFO ).GT.0 .AND. AP( KP ).EQ.ZERO )
- $ RETURN
- KP = KP - INFO
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- KP = 1
- DO 20 INFO = 1, N
- IF( IPIV( INFO ).GT.0 .AND. AP( KP ).EQ.ZERO )
- $ RETURN
- KP = KP + N - INFO + 1
- 20 CONTINUE
- END IF
- INFO = 0
-*
- IF( UPPER ) THEN
-*
-* Compute inv(A) from the factorization A = U*D*U**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- KC = 1
- 30 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 50
-*
- KCNEXT = KC + K
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- AP( KC+K-1 ) = ONE / AP( KC+K-1 )
-*
-* Compute column K of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL SCOPY( K-1, AP( KC ), 1, WORK, 1 )
- CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ),
- $ 1 )
- AP( KC+K-1 ) = AP( KC+K-1 ) -
- $ SDOT( K-1, WORK, 1, AP( KC ), 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( AP( KCNEXT+K-1 ) )
- AK = AP( KC+K-1 ) / T
- AKP1 = AP( KCNEXT+K ) / T
- AKKP1 = AP( KCNEXT+K-1 ) / T
- D = T*( AK*AKP1-ONE )
- AP( KC+K-1 ) = AKP1 / D
- AP( KCNEXT+K ) = AK / D
- AP( KCNEXT+K-1 ) = -AKKP1 / D
-*
-* Compute columns K and K+1 of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL SCOPY( K-1, AP( KC ), 1, WORK, 1 )
- CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ),
- $ 1 )
- AP( KC+K-1 ) = AP( KC+K-1 ) -
- $ SDOT( K-1, WORK, 1, AP( KC ), 1 )
- AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) -
- $ SDOT( K-1, AP( KC ), 1, AP( KCNEXT ),
- $ 1 )
- CALL SCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 )
- CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO,
- $ AP( KCNEXT ), 1 )
- AP( KCNEXT+K ) = AP( KCNEXT+K ) -
- $ SDOT( K-1, WORK, 1, AP( KCNEXT ), 1 )
- END IF
- KSTEP = 2
- KCNEXT = KCNEXT + K + 1
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the leading
-* submatrix A(1:k+1,1:k+1)
-*
- KPC = ( KP-1 )*KP / 2 + 1
- CALL SSWAP( KP-1, AP( KC ), 1, AP( KPC ), 1 )
- KX = KPC + KP - 1
- DO 40 J = KP + 1, K - 1
- KX = KX + J - 1
- TEMP = AP( KC+J-1 )
- AP( KC+J-1 ) = AP( KX )
- AP( KX ) = TEMP
- 40 CONTINUE
- TEMP = AP( KC+K-1 )
- AP( KC+K-1 ) = AP( KPC+KP-1 )
- AP( KPC+KP-1 ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = AP( KC+K+K-1 )
- AP( KC+K+K-1 ) = AP( KC+K+KP-1 )
- AP( KC+K+KP-1 ) = TEMP
- END IF
- END IF
-*
- K = K + KSTEP
- KC = KCNEXT
- GO TO 30
- 50 CONTINUE
-*
- ELSE
-*
-* Compute inv(A) from the factorization A = L*D*L**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- NPP = N*( N+1 ) / 2
- K = N
- KC = NPP
- 60 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 80
-*
- KCNEXT = KC - ( N-K+2 )
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- AP( KC ) = ONE / AP( KC )
-*
-* Compute column K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL SCOPY( N-K, AP( KC+1 ), 1, WORK, 1 )
- CALL SSPMV( UPLO, N-K, -ONE, AP( KC+N-K+1 ), WORK, 1,
- $ ZERO, AP( KC+1 ), 1 )
- AP( KC ) = AP( KC ) - SDOT( N-K, WORK, 1, AP( KC+1 ), 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( AP( KCNEXT+1 ) )
- AK = AP( KCNEXT ) / T
- AKP1 = AP( KC ) / T
- AKKP1 = AP( KCNEXT+1 ) / T
- D = T*( AK*AKP1-ONE )
- AP( KCNEXT ) = AKP1 / D
- AP( KC ) = AK / D
- AP( KCNEXT+1 ) = -AKKP1 / D
-*
-* Compute columns K-1 and K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL SCOPY( N-K, AP( KC+1 ), 1, WORK, 1 )
- CALL SSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1,
- $ ZERO, AP( KC+1 ), 1 )
- AP( KC ) = AP( KC ) - SDOT( N-K, WORK, 1, AP( KC+1 ), 1 )
- AP( KCNEXT+1 ) = AP( KCNEXT+1 ) -
- $ SDOT( N-K, AP( KC+1 ), 1,
- $ AP( KCNEXT+2 ), 1 )
- CALL SCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 )
- CALL SSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1,
- $ ZERO, AP( KCNEXT+2 ), 1 )
- AP( KCNEXT ) = AP( KCNEXT ) -
- $ SDOT( N-K, WORK, 1, AP( KCNEXT+2 ), 1 )
- END IF
- KSTEP = 2
- KCNEXT = KCNEXT - ( N-K+3 )
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the trailing
-* submatrix A(k-1:n,k-1:n)
-*
- KPC = NPP - ( N-KP+1 )*( N-KP+2 ) / 2 + 1
- IF( KP.LT.N )
- $ CALL SSWAP( N-KP, AP( KC+KP-K+1 ), 1, AP( KPC+1 ), 1 )
- KX = KC + KP - K
- DO 70 J = K + 1, KP - 1
- KX = KX + N - J + 1
- TEMP = AP( KC+J-K )
- AP( KC+J-K ) = AP( KX )
- AP( KX ) = TEMP
- 70 CONTINUE
- TEMP = AP( KC )
- AP( KC ) = AP( KPC )
- AP( KPC ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = AP( KC-N+K-1 )
- AP( KC-N+K-1 ) = AP( KC-N+KP-1 )
- AP( KC-N+KP-1 ) = TEMP
- END IF
- END IF
-*
- K = K - KSTEP
- KC = KCNEXT
- GO TO 60
- 80 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSPTRI
-*
- END
diff --git a/netlib/LAPACK/ssptrs.f b/netlib/LAPACK/ssptrs.f
deleted file mode 100644
index 782aa8d..0000000
--- a/netlib/LAPACK/ssptrs.f
+++ /dev/null
@@ -1,450 +0,0 @@
-*> \brief \b SSPTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSPTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssptrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssptrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssptrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSPTRS solves a system of linear equations A*X = B with a real
-*> symmetric matrix A stored in packed format using the factorization
-*> A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSPTRF, stored as a
-*> packed triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSPTRF.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, K, KC, KP
- REAL AK, AKM1, AKM1K, BK, BKM1, DENOM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSPTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B, where A = U*D*U**T.
-*
-* First solve U*D*X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- KC = N*( N+1 ) / 2 + 1
- 10 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 30
-*
- KC = KC - K
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL SGER( K-1, NRHS, -ONE, AP( KC ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL SSCAL( NRHS, ONE / AP( KC+K-1 ), B( K, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K-1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K-1 )
- $ CALL SSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in columns K-1 and K of A.
-*
- CALL SGER( K-2, NRHS, -ONE, AP( KC ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
- CALL SGER( K-2, NRHS, -ONE, AP( KC-( K-1 ) ), 1,
- $ B( K-1, 1 ), LDB, B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = AP( KC+K-2 )
- AKM1 = AP( KC-1 ) / AKM1K
- AK = AP( KC+K-1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 20 J = 1, NRHS
- BKM1 = B( K-1, J ) / AKM1K
- BK = B( K, J ) / AKM1K
- B( K-1, J ) = ( AK*BKM1-BK ) / DENOM
- B( K, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 20 CONTINUE
- KC = KC - K + 1
- K = K - 2
- END IF
-*
- GO TO 10
- 30 CONTINUE
-*
-* Next solve U**T*X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- KC = 1
- 40 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 50
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(U**T(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ),
- $ 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- KC = KC + K
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
-* stored in columns K and K+1 of A.
-*
- CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ),
- $ 1, ONE, B( K, 1 ), LDB )
- CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
- $ AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB )
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- KC = KC + 2*K + 1
- K = K + 2
- END IF
-*
- GO TO 40
- 50 CONTINUE
-*
- ELSE
-*
-* Solve A*X = B, where A = L*D*L**T.
-*
-* First solve L*D*X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- KC = 1
- 60 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 80
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL SGER( N-K, NRHS, -ONE, AP( KC+1 ), 1, B( K, 1 ),
- $ LDB, B( K+1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL SSCAL( NRHS, ONE / AP( KC ), B( K, 1 ), LDB )
- KC = KC + N - K + 1
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K+1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K+1 )
- $ CALL SSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in columns K and K+1 of A.
-*
- IF( K.LT.N-1 ) THEN
- CALL SGER( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ),
- $ LDB, B( K+2, 1 ), LDB )
- CALL SGER( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1,
- $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
- END IF
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = AP( KC+1 )
- AKM1 = AP( KC ) / AKM1K
- AK = AP( KC+N-K+1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 70 J = 1, NRHS
- BKM1 = B( K, J ) / AKM1K
- BK = B( K+1, J ) / AKM1K
- B( K, J ) = ( AK*BKM1-BK ) / DENOM
- B( K+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 70 CONTINUE
- KC = KC + 2*( N-K ) + 1
- K = K + 2
- END IF
-*
- GO TO 60
- 80 CONTINUE
-*
-* Next solve L**T*X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- KC = N*( N+1 ) / 2 + 1
- 90 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 100
-*
- KC = KC - ( N-K+1 )
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(L**T(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL SGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, AP( KC+1 ), 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(L**T(K-1)), where L(K-1) is the transformation
-* stored in columns K-1 and K of A.
-*
- IF( K.LT.N ) THEN
- CALL SGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, AP( KC+1 ), 1, ONE, B( K, 1 ), LDB )
- CALL SGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, AP( KC-( N-K ) ), 1, ONE, B( K-1, 1 ),
- $ LDB )
- END IF
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- KC = KC - ( N-K+2 )
- K = K - 2
- END IF
-*
- GO TO 90
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSPTRS
-*
- END
diff --git a/netlib/LAPACK/sstebz.f b/netlib/LAPACK/sstebz.f
deleted file mode 100644
index c526365..0000000
--- a/netlib/LAPACK/sstebz.f
+++ /dev/null
@@ -1,760 +0,0 @@
-*> \brief \b SSTEBZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEBZ + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstebz.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstebz.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstebz.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
-* M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ORDER, RANGE
-* INTEGER IL, INFO, IU, M, N, NSPLIT
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * )
-* REAL D( * ), E( * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEBZ computes the eigenvalues of a symmetric tridiagonal
-*> matrix T. The user may ask for all eigenvalues, all eigenvalues
-*> in the half-open interval (VL, VU], or the IL-th through IU-th
-*> eigenvalues.
-*>
-*> To avoid overflow, the matrix must be scaled so that its
-*> largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
-*> accuracy, it should not be much smaller than that.
-*>
-*> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
-*> Matrix", Report CS41, Computer Science Dept., Stanford
-*> University, July 21, 1966.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': ("All") all eigenvalues will be found.
-*> = 'V': ("Value") all eigenvalues in the half-open interval
-*> (VL, VU] will be found.
-*> = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
-*> entire matrix) will be found.
-*> \endverbatim
-*>
-*> \param[in] ORDER
-*> \verbatim
-*> ORDER is CHARACTER*1
-*> = 'B': ("By Block") the eigenvalues will be grouped by
-*> split-off block (see IBLOCK, ISPLIT) and
-*> ordered from smallest to largest within
-*> the block.
-*> = 'E': ("Entire matrix")
-*> the eigenvalues for the entire matrix
-*> will be ordered from smallest to
-*> largest.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the tridiagonal matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. Eigenvalues less than or equal
-*> to VL, or greater than VU, will not be returned. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute tolerance for the eigenvalues. An eigenvalue
-*> (or cluster) is considered to be located if it has been
-*> determined to lie in an interval whose width is ABSTOL or
-*> less. If ABSTOL is less than or equal to zero, then ULP*|T|
-*> will be used, where |T| means the 1-norm of T.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) off-diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The actual number of eigenvalues found. 0 <= M <= N.
-*> (See also the description of INFO=2,3.)
-*> \endverbatim
-*>
-*> \param[out] NSPLIT
-*> \verbatim
-*> NSPLIT is INTEGER
-*> The number of diagonal blocks in the matrix T.
-*> 1 <= NSPLIT <= N.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On exit, the first M elements of W will contain the
-*> eigenvalues. (SSTEBZ may use the remaining N-M elements as
-*> workspace.)
-*> \endverbatim
-*>
-*> \param[out] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> At each row/column j where E(j) is zero or small, the
-*> matrix T is considered to split into a block diagonal
-*> matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
-*> block (from 1 to the number of blocks) the eigenvalue W(i)
-*> belongs. (SSTEBZ may use the remaining N-M elements as
-*> workspace.)
-*> \endverbatim
-*>
-*> \param[out] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into submatrices.
-*> The first submatrix consists of rows/columns 1 to ISPLIT(1),
-*> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
-*> etc., and the NSPLIT-th consists of rows/columns
-*> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
-*> (Only the first NSPLIT elements will actually be used, but
-*> since the user cannot know a priori what value NSPLIT will
-*> have, N words must be reserved for ISPLIT.)
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: some or all of the eigenvalues failed to converge or
-*> were not computed:
-*> =1 or 3: Bisection failed to converge for some
-*> eigenvalues; these eigenvalues are flagged by a
-*> negative block number. The effect is that the
-*> eigenvalues may not be as accurate as the
-*> absolute and relative tolerances. This is
-*> generally caused by unexpectedly inaccurate
-*> arithmetic.
-*> =2 or 3: RANGE='I' only: Not all of the eigenvalues
-*> IL:IU were found.
-*> Effect: M < IU+1-IL
-*> Cause: non-monotonic arithmetic, causing the
-*> Sturm sequence to be non-monotonic.
-*> Cure: recalculate, using RANGE='A', and pick
-*> out eigenvalues IL:IU. In some cases,
-*> increasing the PARAMETER "FUDGE" may
-*> make things work.
-*> = 4: RANGE='I', and the Gershgorin interval
-*> initially used was too small. No eigenvalues
-*> were computed.
-*> Probable cause: your machine has sloppy
-*> floating-point arithmetic.
-*> Cure: Increase the PARAMETER "FUDGE",
-*> recompile, and try again.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> RELFAC REAL, default = 2.0e0
-*> The relative tolerance. An interval (a,b] lies within
-*> "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|),
-*> where "ulp" is the machine precision (distance from 1 to
-*> the next larger floating point number.)
-*>
-*> FUDGE REAL, default = 2
-*> A "fudge factor" to widen the Gershgorin intervals. Ideally,
-*> a value of 1 should work, but on machines with sloppy
-*> arithmetic, this needs to be larger. The default for
-*> publicly released versions should be large enough to handle
-*> the worst machine around. Note that this has no effect
-*> on accuracy of the solution.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
- $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER ORDER, RANGE
- INTEGER IL, INFO, IU, M, N, NSPLIT
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), ISPLIT( * ), IWORK( * )
- REAL D( * ), E( * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, HALF
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ HALF = 1.0E0 / TWO )
- REAL FUDGE, RELFAC
- PARAMETER ( FUDGE = 2.1E0, RELFAC = 2.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NCNVRG, TOOFEW
- INTEGER IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
- $ IM, IN, IOFF, IORDER, IOUT, IRANGE, ITMAX,
- $ ITMP1, IW, IWOFF, J, JB, JDISC, JE, NB, NWL,
- $ NWU
- REAL ATOLI, BNORM, GL, GU, PIVMIN, RTOLI, SAFEMN,
- $ TMP1, TMP2, TNORM, ULP, WKILL, WL, WLU, WU, WUL
-* ..
-* .. Local Arrays ..
- INTEGER IDUMMA( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH
- EXTERNAL LSAME, ILAENV, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAEBZ, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Decode RANGE
-*
- IF( LSAME( RANGE, 'A' ) ) THEN
- IRANGE = 1
- ELSE IF( LSAME( RANGE, 'V' ) ) THEN
- IRANGE = 2
- ELSE IF( LSAME( RANGE, 'I' ) ) THEN
- IRANGE = 3
- ELSE
- IRANGE = 0
- END IF
-*
-* Decode ORDER
-*
- IF( LSAME( ORDER, 'B' ) ) THEN
- IORDER = 2
- ELSE IF( LSAME( ORDER, 'E' ) ) THEN
- IORDER = 1
- ELSE
- IORDER = 0
- END IF
-*
-* Check for Errors
-*
- IF( IRANGE.LE.0 ) THEN
- INFO = -1
- ELSE IF( IORDER.LE.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( IRANGE.EQ.2 ) THEN
- IF( VL.GE.VU ) INFO = -5
- ELSE IF( IRANGE.EQ.3 .AND. ( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) )
- $ THEN
- INFO = -6
- ELSE IF( IRANGE.EQ.3 .AND. ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) )
- $ THEN
- INFO = -7
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEBZ', -INFO )
- RETURN
- END IF
-*
-* Initialize error flags
-*
- INFO = 0
- NCNVRG = .FALSE.
- TOOFEW = .FALSE.
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
-* Simplifications:
-*
- IF( IRANGE.EQ.3 .AND. IL.EQ.1 .AND. IU.EQ.N )
- $ IRANGE = 1
-*
-* Get machine constants
-* NB is the minimum vector length for vector bisection, or 0
-* if only scalar is to be done.
-*
- SAFEMN = SLAMCH( 'S' )
- ULP = SLAMCH( 'P' )
- RTOLI = ULP*RELFAC
- NB = ILAENV( 1, 'SSTEBZ', ' ', N, -1, -1, -1 )
- IF( NB.LE.1 )
- $ NB = 0
-*
-* Special Case when N=1
-*
- IF( N.EQ.1 ) THEN
- NSPLIT = 1
- ISPLIT( 1 ) = 1
- IF( IRANGE.EQ.2 .AND. ( VL.GE.D( 1 ) .OR. VU.LT.D( 1 ) ) ) THEN
- M = 0
- ELSE
- W( 1 ) = D( 1 )
- IBLOCK( 1 ) = 1
- M = 1
- END IF
- RETURN
- END IF
-*
-* Compute Splitting Points
-*
- NSPLIT = 1
- WORK( N ) = ZERO
- PIVMIN = ONE
-*
- DO 10 J = 2, N
- TMP1 = E( J-1 )**2
- IF( ABS( D( J )*D( J-1 ) )*ULP**2+SAFEMN.GT.TMP1 ) THEN
- ISPLIT( NSPLIT ) = J - 1
- NSPLIT = NSPLIT + 1
- WORK( J-1 ) = ZERO
- ELSE
- WORK( J-1 ) = TMP1
- PIVMIN = MAX( PIVMIN, TMP1 )
- END IF
- 10 CONTINUE
- ISPLIT( NSPLIT ) = N
- PIVMIN = PIVMIN*SAFEMN
-*
-* Compute Interval and ATOLI
-*
- IF( IRANGE.EQ.3 ) THEN
-*
-* RANGE='I': Compute the interval containing eigenvalues
-* IL through IU.
-*
-* Compute Gershgorin interval for entire (split) matrix
-* and use it as the initial interval
-*
- GU = D( 1 )
- GL = D( 1 )
- TMP1 = ZERO
-*
- DO 20 J = 1, N - 1
- TMP2 = SQRT( WORK( J ) )
- GU = MAX( GU, D( J )+TMP1+TMP2 )
- GL = MIN( GL, D( J )-TMP1-TMP2 )
- TMP1 = TMP2
- 20 CONTINUE
-*
- GU = MAX( GU, D( N )+TMP1 )
- GL = MIN( GL, D( N )-TMP1 )
- TNORM = MAX( ABS( GL ), ABS( GU ) )
- GL = GL - FUDGE*TNORM*ULP*N - FUDGE*TWO*PIVMIN
- GU = GU + FUDGE*TNORM*ULP*N + FUDGE*PIVMIN
-*
-* Compute Iteration parameters
-*
- ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- IF( ABSTOL.LE.ZERO ) THEN
- ATOLI = ULP*TNORM
- ELSE
- ATOLI = ABSTOL
- END IF
-*
- WORK( N+1 ) = GL
- WORK( N+2 ) = GL
- WORK( N+3 ) = GU
- WORK( N+4 ) = GU
- WORK( N+5 ) = GL
- WORK( N+6 ) = GU
- IWORK( 1 ) = -1
- IWORK( 2 ) = -1
- IWORK( 3 ) = N + 1
- IWORK( 4 ) = N + 1
- IWORK( 5 ) = IL - 1
- IWORK( 6 ) = IU
-*
- CALL SLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E,
- $ WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
- $ IWORK, W, IBLOCK, IINFO )
-*
- IF( IWORK( 6 ).EQ.IU ) THEN
- WL = WORK( N+1 )
- WLU = WORK( N+3 )
- NWL = IWORK( 1 )
- WU = WORK( N+4 )
- WUL = WORK( N+2 )
- NWU = IWORK( 4 )
- ELSE
- WL = WORK( N+2 )
- WLU = WORK( N+4 )
- NWL = IWORK( 2 )
- WU = WORK( N+3 )
- WUL = WORK( N+1 )
- NWU = IWORK( 3 )
- END IF
-*
- IF( NWL.LT.0 .OR. NWL.GE.N .OR. NWU.LT.1 .OR. NWU.GT.N ) THEN
- INFO = 4
- RETURN
- END IF
- ELSE
-*
-* RANGE='A' or 'V' -- Set ATOLI
-*
- TNORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ),
- $ ABS( D( N ) )+ABS( E( N-1 ) ) )
-*
- DO 30 J = 2, N - 1
- TNORM = MAX( TNORM, ABS( D( J ) )+ABS( E( J-1 ) )+
- $ ABS( E( J ) ) )
- 30 CONTINUE
-*
- IF( ABSTOL.LE.ZERO ) THEN
- ATOLI = ULP*TNORM
- ELSE
- ATOLI = ABSTOL
- END IF
-*
- IF( IRANGE.EQ.2 ) THEN
- WL = VL
- WU = VU
- ELSE
- WL = ZERO
- WU = ZERO
- END IF
- END IF
-*
-* Find Eigenvalues -- Loop Over Blocks and recompute NWL and NWU.
-* NWL accumulates the number of eigenvalues .le. WL,
-* NWU accumulates the number of eigenvalues .le. WU
-*
- M = 0
- IEND = 0
- INFO = 0
- NWL = 0
- NWU = 0
-*
- DO 70 JB = 1, NSPLIT
- IOFF = IEND
- IBEGIN = IOFF + 1
- IEND = ISPLIT( JB )
- IN = IEND - IOFF
-*
- IF( IN.EQ.1 ) THEN
-*
-* Special Case -- IN=1
-*
- IF( IRANGE.EQ.1 .OR. WL.GE.D( IBEGIN )-PIVMIN )
- $ NWL = NWL + 1
- IF( IRANGE.EQ.1 .OR. WU.GE.D( IBEGIN )-PIVMIN )
- $ NWU = NWU + 1
- IF( IRANGE.EQ.1 .OR. ( WL.LT.D( IBEGIN )-PIVMIN .AND. WU.GE.
- $ D( IBEGIN )-PIVMIN ) ) THEN
- M = M + 1
- W( M ) = D( IBEGIN )
- IBLOCK( M ) = JB
- END IF
- ELSE
-*
-* General Case -- IN > 1
-*
-* Compute Gershgorin Interval
-* and use it as the initial interval
-*
- GU = D( IBEGIN )
- GL = D( IBEGIN )
- TMP1 = ZERO
-*
- DO 40 J = IBEGIN, IEND - 1
- TMP2 = ABS( E( J ) )
- GU = MAX( GU, D( J )+TMP1+TMP2 )
- GL = MIN( GL, D( J )-TMP1-TMP2 )
- TMP1 = TMP2
- 40 CONTINUE
-*
- GU = MAX( GU, D( IEND )+TMP1 )
- GL = MIN( GL, D( IEND )-TMP1 )
- BNORM = MAX( ABS( GL ), ABS( GU ) )
- GL = GL - FUDGE*BNORM*ULP*IN - FUDGE*PIVMIN
- GU = GU + FUDGE*BNORM*ULP*IN + FUDGE*PIVMIN
-*
-* Compute ATOLI for the current submatrix
-*
- IF( ABSTOL.LE.ZERO ) THEN
- ATOLI = ULP*MAX( ABS( GL ), ABS( GU ) )
- ELSE
- ATOLI = ABSTOL
- END IF
-*
- IF( IRANGE.GT.1 ) THEN
- IF( GU.LT.WL ) THEN
- NWL = NWL + IN
- NWU = NWU + IN
- GO TO 70
- END IF
- GL = MAX( GL, WL )
- GU = MIN( GU, WU )
- IF( GL.GE.GU )
- $ GO TO 70
- END IF
-*
-* Set Up Initial Interval
-*
- WORK( N+1 ) = GL
- WORK( N+IN+1 ) = GU
- CALL SLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
-*
- NWL = NWL + IWORK( 1 )
- NWU = NWU + IWORK( IN+1 )
- IWOFF = M - IWORK( 1 )
-*
-* Compute Eigenvalues
-*
- ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) /
- $ LOG( TWO ) ) + 2
- CALL SLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
- $ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
- $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
- $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
-*
-* Copy Eigenvalues Into W and IBLOCK
-* Use -JB for block number for unconverged eigenvalues.
-*
- DO 60 J = 1, IOUT
- TMP1 = HALF*( WORK( J+N )+WORK( J+IN+N ) )
-*
-* Flag non-convergence.
-*
- IF( J.GT.IOUT-IINFO ) THEN
- NCNVRG = .TRUE.
- IB = -JB
- ELSE
- IB = JB
- END IF
- DO 50 JE = IWORK( J ) + 1 + IWOFF,
- $ IWORK( J+IN ) + IWOFF
- W( JE ) = TMP1
- IBLOCK( JE ) = IB
- 50 CONTINUE
- 60 CONTINUE
-*
- M = M + IM
- END IF
- 70 CONTINUE
-*
-* If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
-* If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
-*
- IF( IRANGE.EQ.3 ) THEN
- IM = 0
- IDISCL = IL - 1 - NWL
- IDISCU = NWU - IU
-*
- IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
- DO 80 JE = 1, M
- IF( W( JE ).LE.WLU .AND. IDISCL.GT.0 ) THEN
- IDISCL = IDISCL - 1
- ELSE IF( W( JE ).GE.WUL .AND. IDISCU.GT.0 ) THEN
- IDISCU = IDISCU - 1
- ELSE
- IM = IM + 1
- W( IM ) = W( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 80 CONTINUE
- M = IM
- END IF
- IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
-*
-* Code to deal with effects of bad arithmetic:
-* Some low eigenvalues to be discarded are not in (WL,WLU],
-* or high eigenvalues to be discarded are not in (WUL,WU]
-* so just kill off the smallest IDISCL/largest IDISCU
-* eigenvalues, by simply finding the smallest/largest
-* eigenvalue(s).
-*
-* (If N(w) is monotone non-decreasing, this should never
-* happen.)
-*
- IF( IDISCL.GT.0 ) THEN
- WKILL = WU
- DO 100 JDISC = 1, IDISCL
- IW = 0
- DO 90 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).LT.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 90 CONTINUE
- IBLOCK( IW ) = 0
- 100 CONTINUE
- END IF
- IF( IDISCU.GT.0 ) THEN
-*
- WKILL = WL
- DO 120 JDISC = 1, IDISCU
- IW = 0
- DO 110 JE = 1, M
- IF( IBLOCK( JE ).NE.0 .AND.
- $ ( W( JE ).GT.WKILL .OR. IW.EQ.0 ) ) THEN
- IW = JE
- WKILL = W( JE )
- END IF
- 110 CONTINUE
- IBLOCK( IW ) = 0
- 120 CONTINUE
- END IF
- IM = 0
- DO 130 JE = 1, M
- IF( IBLOCK( JE ).NE.0 ) THEN
- IM = IM + 1
- W( IM ) = W( JE )
- IBLOCK( IM ) = IBLOCK( JE )
- END IF
- 130 CONTINUE
- M = IM
- END IF
- IF( IDISCL.LT.0 .OR. IDISCU.LT.0 ) THEN
- TOOFEW = .TRUE.
- END IF
- END IF
-*
-* If ORDER='B', do nothing -- the eigenvalues are already sorted
-* by block.
-* If ORDER='E', sort the eigenvalues from smallest to largest
-*
- IF( IORDER.EQ.1 .AND. NSPLIT.GT.1 ) THEN
- DO 150 JE = 1, M - 1
- IE = 0
- TMP1 = W( JE )
- DO 140 J = JE + 1, M
- IF( W( J ).LT.TMP1 ) THEN
- IE = J
- TMP1 = W( J )
- END IF
- 140 CONTINUE
-*
- IF( IE.NE.0 ) THEN
- ITMP1 = IBLOCK( IE )
- W( IE ) = W( JE )
- IBLOCK( IE ) = IBLOCK( JE )
- W( JE ) = TMP1
- IBLOCK( JE ) = ITMP1
- END IF
- 150 CONTINUE
- END IF
-*
- INFO = 0
- IF( NCNVRG )
- $ INFO = INFO + 1
- IF( TOOFEW )
- $ INFO = INFO + 2
- RETURN
-*
-* End of SSTEBZ
-*
- END
diff --git a/netlib/LAPACK/sstedc.f b/netlib/LAPACK/sstedc.f
deleted file mode 100644
index 2169a20..0000000
--- a/netlib/LAPACK/sstedc.f
+++ /dev/null
@@ -1,488 +0,0 @@
-*> \brief \b SSTEBZ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEDC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstedc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstedc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstedc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPZ
-* INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEDC computes all eigenvalues and, optionally, eigenvectors of a
-*> symmetric tridiagonal matrix using the divide and conquer method.
-*> The eigenvectors of a full or band real symmetric matrix can also be
-*> found if SSYTRD or SSPTRD or SSBTRD has been used to reduce this
-*> matrix to tridiagonal form.
-*>
-*> This code makes very mild assumptions about floating point
-*> arithmetic. It will work on machines with a guard digit in
-*> add/subtract, or on those binary machines without guard digits
-*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
-*> It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none. See SLAED3 for details.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only.
-*> = 'I': Compute eigenvectors of tridiagonal matrix also.
-*> = 'V': Compute eigenvectors of original dense symmetric
-*> matrix also. On entry, Z contains the orthogonal
-*> matrix used to reduce the original matrix to
-*> tridiagonal form.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The dimension of the symmetric tridiagonal matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the diagonal elements of the tridiagonal matrix.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the subdiagonal elements of the tridiagonal matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> On entry, if COMPZ = 'V', then Z contains the orthogonal
-*> matrix used in the reduction to tridiagonal form.
-*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
-*> orthonormal eigenvectors of the original symmetric matrix,
-*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors
-*> of the symmetric tridiagonal matrix.
-*> If COMPZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If eigenvectors are desired, then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
-*> If COMPZ = 'V' and N > 1 then LWORK must be at least
-*> ( 1 + 3*N + 2*N*lg N + 4*N**2 ),
-*> where lg( N ) = smallest integer k such
-*> that 2**k >= N.
-*> If COMPZ = 'I' and N > 1 then LWORK must be at least
-*> ( 1 + 4*N + N**2 ).
-*> Note that for COMPZ = 'I' or 'V', then if N is less than or
-*> equal to the minimum divide size, usually 25, then LWORK need
-*> only be max(1,2*(N-1)).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
-*> If COMPZ = 'V' and N > 1 then LIWORK must be at least
-*> ( 6 + 6*N + 5*N*lg N ).
-*> If COMPZ = 'I' and N > 1 then LIWORK must be at least
-*> ( 3 + 5*N ).
-*> Note that for COMPZ = 'I' or 'V', then if N is less than or
-*> equal to the minimum divide size, usually 25, then LIWORK
-*> need only be 1.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: The algorithm failed to compute an eigenvalue while
-*> working on the submatrix lying in rows and columns
-*> INFO/(N+1) through mod(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee
-*>
-* =====================================================================
- SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPZ
- INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER FINISH, I, ICOMPZ, II, J, K, LGN, LIWMIN,
- $ LWMIN, M, SMLSIZ, START, STOREZ, STRTRW
- REAL EPS, ORGNRM, P, TINY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANST
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLACPY, SLAED0, SLASCL, SLASET, SLASRT,
- $ SSTEQR, SSTERF, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MOD, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ICOMPZ = 0
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ICOMPZ = 2
- ELSE
- ICOMPZ = -1
- END IF
- IF( ICOMPZ.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( LDZ.LT.1 ) .OR.
- $ ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -6
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Compute the workspace requirements
-*
- SMLSIZ = ILAENV( 9, 'SSTEDC', ' ', 0, 0, 0, 0 )
- IF( N.LE.1 .OR. ICOMPZ.EQ.0 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE IF( N.LE.SMLSIZ ) THEN
- LIWMIN = 1
- LWMIN = 2*( N - 1 )
- ELSE
- LGN = INT( LOG( REAL( N ) )/LOG( TWO ) )
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IF( 2**LGN.LT.N )
- $ LGN = LGN + 1
- IF( ICOMPZ.EQ.1 ) THEN
- LWMIN = 1 + 3*N + 2*N*LGN + 4*N**2
- LIWMIN = 6 + 6*N + 5*N*LGN
- ELSE IF( ICOMPZ.EQ.2 ) THEN
- LWMIN = 1 + 4*N + N**2
- LIWMIN = 3 + 5*N
- END IF
- END IF
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT. LQUERY ) THEN
- INFO = -8
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT. LQUERY ) THEN
- INFO = -10
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEDC', -INFO )
- RETURN
- ELSE IF (LQUERY) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( N.EQ.1 ) THEN
- IF( ICOMPZ.NE.0 )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* If the following conditional clause is removed, then the routine
-* will use the Divide and Conquer routine to compute only the
-* eigenvalues, which requires (3N + 3N**2) real workspace and
-* (2 + 5N + 2N lg(N)) integer workspace.
-* Since on many architectures SSTERF is much faster than any other
-* algorithm for finding eigenvalues only, it is used here
-* as the default. If the conditional clause is removed, then
-* information on the size of workspace needs to be changed.
-*
-* If COMPZ = 'N', use SSTERF to compute the eigenvalues.
-*
- IF( ICOMPZ.EQ.0 ) THEN
- CALL SSTERF( N, D, E, INFO )
- GO TO 50
- END IF
-*
-* If N is smaller than the minimum divide size (SMLSIZ+1), then
-* solve the problem with another solver.
-*
- IF( N.LE.SMLSIZ ) THEN
-*
- CALL SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
- ELSE
-*
-* If COMPZ = 'V', the Z matrix must be stored elsewhere for later
-* use.
-*
- IF( ICOMPZ.EQ.1 ) THEN
- STOREZ = 1 + N*N
- ELSE
- STOREZ = 1
- END IF
-*
- IF( ICOMPZ.EQ.2 ) THEN
- CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
- END IF
-*
-* Scale.
-*
- ORGNRM = SLANST( 'M', N, D, E )
- IF( ORGNRM.EQ.ZERO )
- $ GO TO 50
-*
- EPS = SLAMCH( 'Epsilon' )
-*
- START = 1
-*
-* while ( START <= N )
-*
- 10 CONTINUE
- IF( START.LE.N ) THEN
-*
-* Let FINISH be the position of the next subdiagonal entry
-* such that E( FINISH ) <= TINY or FINISH = N if no such
-* subdiagonal exists. The matrix identified by the elements
-* between START and FINISH constitutes an independent
-* sub-problem.
-*
- FINISH = START
- 20 CONTINUE
- IF( FINISH.LT.N ) THEN
- TINY = EPS*SQRT( ABS( D( FINISH ) ) )*
- $ SQRT( ABS( D( FINISH+1 ) ) )
- IF( ABS( E( FINISH ) ).GT.TINY ) THEN
- FINISH = FINISH + 1
- GO TO 20
- END IF
- END IF
-*
-* (Sub) Problem determined. Compute its size and solve it.
-*
- M = FINISH - START + 1
- IF( M.EQ.1 ) THEN
- START = FINISH + 1
- GO TO 10
- END IF
- IF( M.GT.SMLSIZ ) THEN
-*
-* Scale.
-*
- ORGNRM = SLANST( 'M', M, D( START ), E( START ) )
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M,
- $ INFO )
- CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ),
- $ M-1, INFO )
-*
- IF( ICOMPZ.EQ.1 ) THEN
- STRTRW = 1
- ELSE
- STRTRW = START
- END IF
- CALL SLAED0( ICOMPZ, N, M, D( START ), E( START ),
- $ Z( STRTRW, START ), LDZ, WORK( 1 ), N,
- $ WORK( STOREZ ), IWORK, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) +
- $ MOD( INFO, ( M+1 ) ) + START - 1
- GO TO 50
- END IF
-*
-* Scale back.
-*
- CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M,
- $ INFO )
-*
- ELSE
- IF( ICOMPZ.EQ.1 ) THEN
-*
-* Since QR won't update a Z matrix which is larger than
-* the length of D, we must solve the sub-problem in a
-* workspace and then multiply back into Z.
-*
- CALL SSTEQR( 'I', M, D( START ), E( START ), WORK, M,
- $ WORK( M*M+1 ), INFO )
- CALL SLACPY( 'A', N, M, Z( 1, START ), LDZ,
- $ WORK( STOREZ ), N )
- CALL SGEMM( 'N', 'N', N, M, M, ONE,
- $ WORK( STOREZ ), N, WORK, M, ZERO,
- $ Z( 1, START ), LDZ )
- ELSE IF( ICOMPZ.EQ.2 ) THEN
- CALL SSTEQR( 'I', M, D( START ), E( START ),
- $ Z( START, START ), LDZ, WORK, INFO )
- ELSE
- CALL SSTERF( M, D( START ), E( START ), INFO )
- END IF
- IF( INFO.NE.0 ) THEN
- INFO = START*( N+1 ) + FINISH
- GO TO 50
- END IF
- END IF
-*
- START = FINISH + 1
- GO TO 10
- END IF
-*
-* endwhile
-*
-* If the problem split any number of times, then the eigenvalues
-* will not be properly ordered. Here we permute the eigenvalues
-* (and the associated eigenvectors) into ascending order.
-*
- IF( M.NE.N ) THEN
- IF( ICOMPZ.EQ.0 ) THEN
-*
-* Use Quick Sort
-*
- CALL SLASRT( 'I', N, D, INFO )
-*
- ELSE
-*
-* Use Selection Sort to minimize swaps of eigenvectors
-*
- DO 40 II = 2, N
- I = II - 1
- K = I
- P = D( I )
- DO 30 J = II, N
- IF( D( J ).LT.P ) THEN
- K = J
- P = D( J )
- END IF
- 30 CONTINUE
- IF( K.NE.I ) THEN
- D( K ) = D( I )
- D( I ) = P
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
- END IF
- 40 CONTINUE
- END IF
- END IF
- END IF
-*
- 50 CONTINUE
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of SSTEDC
-*
- END
diff --git a/netlib/LAPACK/sstegr.f b/netlib/LAPACK/sstegr.f
deleted file mode 100644
index d98c451..0000000
--- a/netlib/LAPACK/sstegr.f
+++ /dev/null
@@ -1,293 +0,0 @@
-*> \brief \b SSTEGR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEGR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstegr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstegr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstegr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEGR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* REAL D( * ), E( * ), W( * ), WORK( * )
-* REAL Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEGR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has
-*> a well defined set of pairwise different real eigenvalues, the corresponding
-*> real eigenvectors are pairwise orthogonal.
-*>
-*> The spectrum may be computed either completely or partially by specifying
-*> either an interval (VL,VU] or a range of indices IL:IU for the desired
-*> eigenvalues.
-*>
-*> SSTEGR is a compatability wrapper around the improved SSTEMR routine.
-*> See SSTEMR for further details.
-*>
-*> One important change is that the ABSTOL parameter no longer provides any
-*> benefit and hence is no longer used.
-*>
-*> Note : SSTEGR and SSTEMR work only on machines which follow
-*> IEEE-754 floating-point standard in their handling of infinities and
-*> NaNs. Normal execution may create these exceptiona values and hence
-*> may abort due to a floating point exception in environments which
-*> do not conform to the IEEE-754 standard.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal matrix
-*> T. On exit, D is overwritten.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> On entry, the (N-1) subdiagonal elements of the tridiagonal
-*> matrix T in elements 1 to N-1 of E. E(N) need not be set on
-*> input, but is used internally as workspace.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> Unused. Was the absolute error tolerance for the
-*> eigenvalues/eigenvectors in previous versions.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix T
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> Supplying N columns is always safe.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th computed eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ). This is relevant in the case when the matrix
-*> is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal
-*> (and minimal) LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,18*N)
-*> if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (LIWORK)
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N)
-*> if the eigenvectors are desired, and LIWORK >= max(1,8*N)
-*> if only the eigenvalues are to be computed.
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = 1X, internal error in SLARRE,
-*> if INFO = 2X, internal error in SLARRV.
-*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
-*> the nonzero error code returned by SLARRE or
-*> SLARRV, respectively.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Inderjit Dhillon, IBM Almaden, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, LBNL/NERSC, USA \n
-*
-* =====================================================================
- SUBROUTINE SSTEGR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- REAL D( * ), E( * ), W( * ), WORK( * )
- REAL Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL TRYRAC
-* ..
-* .. External Subroutines ..
- EXTERNAL SSTEMR
-* ..
-* .. Executable Statements ..
- INFO = 0
- TRYRAC = .FALSE.
-
- CALL SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
- $ M, W, Z, LDZ, N, ISUPPZ, TRYRAC, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* End of SSTEGR
-*
- END
diff --git a/netlib/LAPACK/sstein.f b/netlib/LAPACK/sstein.f
deleted file mode 100644
index 0c2ab02..0000000
--- a/netlib/LAPACK/sstein.f
+++ /dev/null
@@ -1,452 +0,0 @@
-*> \brief \b SSTEIN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEIN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstein.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstein.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstein.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK,
-* IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDZ, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IBLOCK( * ), IFAIL( * ), ISPLIT( * ),
-* $ IWORK( * )
-* REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEIN computes the eigenvectors of a real symmetric tridiagonal
-*> matrix T corresponding to specified eigenvalues, using inverse
-*> iteration.
-*>
-*> The maximum number of iterations allowed for each eigenvector is
-*> specified by an internal parameter MAXITS (currently set to 5).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The n diagonal elements of the tridiagonal matrix T.
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The (n-1) subdiagonal elements of the tridiagonal matrix
-*> T, in elements 1 to N-1.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of eigenvectors to be found. 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[in] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements of W contain the eigenvalues for
-*> which eigenvectors are to be computed. The eigenvalues
-*> should be grouped by split-off block and ordered from
-*> smallest to largest within the block. ( The output array
-*> W from SSTEBZ with ORDER = 'B' is expected here. )
-*> \endverbatim
-*>
-*> \param[in] IBLOCK
-*> \verbatim
-*> IBLOCK is INTEGER array, dimension (N)
-*> The submatrix indices associated with the corresponding
-*> eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to
-*> the first submatrix from the top, =2 if W(i) belongs to
-*> the second submatrix, etc. ( The output array IBLOCK
-*> from SSTEBZ is expected here. )
-*> \endverbatim
-*>
-*> \param[in] ISPLIT
-*> \verbatim
-*> ISPLIT is INTEGER array, dimension (N)
-*> The splitting points, at which T breaks up into submatrices.
-*> The first submatrix consists of rows/columns 1 to
-*> ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
-*> through ISPLIT( 2 ), etc.
-*> ( The output array ISPLIT from SSTEBZ is expected here. )
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, M)
-*> The computed eigenvectors. The eigenvector associated
-*> with the eigenvalue W(i) is stored in the i-th column of
-*> Z. Any vector which fails to converge is set to its current
-*> iterate after MAXITS iterations.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (M)
-*> On normal exit, all elements of IFAIL are zero.
-*> If one or more eigenvectors fail to converge after
-*> MAXITS iterations, then their indices are stored in
-*> array IFAIL.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge
-*> in MAXITS iterations. Their indices are stored in
-*> array IFAIL.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> MAXITS INTEGER, default = 5
-*> The maximum number of iterations performed.
-*>
-*> EXTRA INTEGER, default = 2
-*> The number of iterations performed after norm growth
-*> criterion is satisfied, should be at least 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK,
- $ IWORK, IFAIL, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDZ, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IBLOCK( * ), IFAIL( * ), ISPLIT( * ),
- $ IWORK( * )
- REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TEN, ODM3, ODM1
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TEN = 1.0E+1,
- $ ODM3 = 1.0E-3, ODM1 = 1.0E-1 )
- INTEGER MAXITS, EXTRA
- PARAMETER ( MAXITS = 5, EXTRA = 2 )
-* ..
-* .. Local Scalars ..
- INTEGER B1, BLKSIZ, BN, GPIND, I, IINFO, INDRV1,
- $ INDRV2, INDRV3, INDRV4, INDRV5, ITS, J, J1,
- $ JBLK, JMAX, NBLK, NRMCHK
- REAL CTR, EPS, EPS1, NRM, ONENRM, ORTOL, PERTOL,
- $ SCL, SEP, STPCRT, TOL, XJ, XJM
-* ..
-* .. Local Arrays ..
- INTEGER ISEED( 4 )
-* ..
-* .. External Functions ..
- INTEGER ISAMAX
- REAL SASUM, SDOT, SLAMCH, SNRM2
- EXTERNAL ISAMAX, SASUM, SDOT, SLAMCH, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLAGTF, SLAGTS, SLARNV, SSCAL,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- DO 10 I = 1, M
- IFAIL( I ) = 0
- 10 CONTINUE
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( M.LT.0 .OR. M.GT.N ) THEN
- INFO = -4
- ELSE IF( LDZ.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE
- DO 20 J = 2, M
- IF( IBLOCK( J ).LT.IBLOCK( J-1 ) ) THEN
- INFO = -6
- GO TO 30
- END IF
- IF( IBLOCK( J ).EQ.IBLOCK( J-1 ) .AND. W( J ).LT.W( J-1 ) )
- $ THEN
- INFO = -5
- GO TO 30
- END IF
- 20 CONTINUE
- 30 CONTINUE
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEIN', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- EPS = SLAMCH( 'Precision' )
-*
-* Initialize seed for random number generator SLARNV.
-*
- DO 40 I = 1, 4
- ISEED( I ) = 1
- 40 CONTINUE
-*
-* Initialize pointers.
-*
- INDRV1 = 0
- INDRV2 = INDRV1 + N
- INDRV3 = INDRV2 + N
- INDRV4 = INDRV3 + N
- INDRV5 = INDRV4 + N
-*
-* Compute eigenvectors of matrix blocks.
-*
- J1 = 1
- DO 160 NBLK = 1, IBLOCK( M )
-*
-* Find starting and ending indices of block nblk.
-*
- IF( NBLK.EQ.1 ) THEN
- B1 = 1
- ELSE
- B1 = ISPLIT( NBLK-1 ) + 1
- END IF
- BN = ISPLIT( NBLK )
- BLKSIZ = BN - B1 + 1
- IF( BLKSIZ.EQ.1 )
- $ GO TO 60
- GPIND = B1
-*
-* Compute reorthogonalization criterion and stopping criterion.
-*
- ONENRM = ABS( D( B1 ) ) + ABS( E( B1 ) )
- ONENRM = MAX( ONENRM, ABS( D( BN ) )+ABS( E( BN-1 ) ) )
- DO 50 I = B1 + 1, BN - 1
- ONENRM = MAX( ONENRM, ABS( D( I ) )+ABS( E( I-1 ) )+
- $ ABS( E( I ) ) )
- 50 CONTINUE
- ORTOL = ODM3*ONENRM
-*
- STPCRT = SQRT( ODM1 / BLKSIZ )
-*
-* Loop through eigenvalues of block nblk.
-*
- 60 CONTINUE
- JBLK = 0
- DO 150 J = J1, M
- IF( IBLOCK( J ).NE.NBLK ) THEN
- J1 = J
- GO TO 160
- END IF
- JBLK = JBLK + 1
- XJ = W( J )
-*
-* Skip all the work if the block size is one.
-*
- IF( BLKSIZ.EQ.1 ) THEN
- WORK( INDRV1+1 ) = ONE
- GO TO 120
- END IF
-*
-* If eigenvalues j and j-1 are too close, add a relatively
-* small perturbation.
-*
- IF( JBLK.GT.1 ) THEN
- EPS1 = ABS( EPS*XJ )
- PERTOL = TEN*EPS1
- SEP = XJ - XJM
- IF( SEP.LT.PERTOL )
- $ XJ = XJM + PERTOL
- END IF
-*
- ITS = 0
- NRMCHK = 0
-*
-* Get random starting vector.
-*
- CALL SLARNV( 2, ISEED, BLKSIZ, WORK( INDRV1+1 ) )
-*
-* Copy the matrix T so it won't be destroyed in factorization.
-*
- CALL SCOPY( BLKSIZ, D( B1 ), 1, WORK( INDRV4+1 ), 1 )
- CALL SCOPY( BLKSIZ-1, E( B1 ), 1, WORK( INDRV2+2 ), 1 )
- CALL SCOPY( BLKSIZ-1, E( B1 ), 1, WORK( INDRV3+1 ), 1 )
-*
-* Compute LU factors with partial pivoting ( PT = LU )
-*
- TOL = ZERO
- CALL SLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, WORK( INDRV2+2 ),
- $ WORK( INDRV3+1 ), TOL, WORK( INDRV5+1 ), IWORK,
- $ IINFO )
-*
-* Update iteration count.
-*
- 70 CONTINUE
- ITS = ITS + 1
- IF( ITS.GT.MAXITS )
- $ GO TO 100
-*
-* Normalize and scale the righthand side vector Pb.
-*
- SCL = BLKSIZ*ONENRM*MAX( EPS,
- $ ABS( WORK( INDRV4+BLKSIZ ) ) ) /
- $ SASUM( BLKSIZ, WORK( INDRV1+1 ), 1 )
- CALL SSCAL( BLKSIZ, SCL, WORK( INDRV1+1 ), 1 )
-*
-* Solve the system LU = Pb.
-*
- CALL SLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), WORK( INDRV2+2 ),
- $ WORK( INDRV3+1 ), WORK( INDRV5+1 ), IWORK,
- $ WORK( INDRV1+1 ), TOL, IINFO )
-*
-* Reorthogonalize by modified Gram-Schmidt if eigenvalues are
-* close enough.
-*
- IF( JBLK.EQ.1 )
- $ GO TO 90
- IF( ABS( XJ-XJM ).GT.ORTOL )
- $ GPIND = J
- IF( GPIND.NE.J ) THEN
- DO 80 I = GPIND, J - 1
- CTR = -SDOT( BLKSIZ, WORK( INDRV1+1 ), 1, Z( B1, I ),
- $ 1 )
- CALL SAXPY( BLKSIZ, CTR, Z( B1, I ), 1,
- $ WORK( INDRV1+1 ), 1 )
- 80 CONTINUE
- END IF
-*
-* Check the infinity norm of the iterate.
-*
- 90 CONTINUE
- JMAX = ISAMAX( BLKSIZ, WORK( INDRV1+1 ), 1 )
- NRM = ABS( WORK( INDRV1+JMAX ) )
-*
-* Continue for additional iterations after norm reaches
-* stopping criterion.
-*
- IF( NRM.LT.STPCRT )
- $ GO TO 70
- NRMCHK = NRMCHK + 1
- IF( NRMCHK.LT.EXTRA+1 )
- $ GO TO 70
-*
- GO TO 110
-*
-* If stopping criterion was not satisfied, update info and
-* store eigenvector number in array ifail.
-*
- 100 CONTINUE
- INFO = INFO + 1
- IFAIL( INFO ) = J
-*
-* Accept iterate as jth eigenvector.
-*
- 110 CONTINUE
- SCL = ONE / SNRM2( BLKSIZ, WORK( INDRV1+1 ), 1 )
- JMAX = ISAMAX( BLKSIZ, WORK( INDRV1+1 ), 1 )
- IF( WORK( INDRV1+JMAX ).LT.ZERO )
- $ SCL = -SCL
- CALL SSCAL( BLKSIZ, SCL, WORK( INDRV1+1 ), 1 )
- 120 CONTINUE
- DO 130 I = 1, N
- Z( I, J ) = ZERO
- 130 CONTINUE
- DO 140 I = 1, BLKSIZ
- Z( B1+I-1, J ) = WORK( INDRV1+I )
- 140 CONTINUE
-*
-* Save the shift to check eigenvalue spacing at next
-* iteration.
-*
- XJM = XJ
-*
- 150 CONTINUE
- 160 CONTINUE
-*
- RETURN
-*
-* End of SSTEIN
-*
- END
diff --git a/netlib/LAPACK/sstemr.f b/netlib/LAPACK/sstemr.f
deleted file mode 100644
index ba859db..0000000
--- a/netlib/LAPACK/sstemr.f
+++ /dev/null
@@ -1,762 +0,0 @@
-*> \brief \b SSTEMR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEMR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstemr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstemr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstemr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
-* M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
-* IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* LOGICAL TRYRAC
-* INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
-* REAL VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* REAL D( * ), E( * ), W( * ), WORK( * )
-* REAL Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEMR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has
-*> a well defined set of pairwise different real eigenvalues, the corresponding
-*> real eigenvectors are pairwise orthogonal.
-*>
-*> The spectrum may be computed either completely or partially by specifying
-*> either an interval (VL,VU] or a range of indices IL:IU for the desired
-*> eigenvalues.
-*>
-*> Depending on the number of desired eigenvalues, these are computed either
-*> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are
-*> computed by the use of various suitable L D L^T factorizations near clusters
-*> of close eigenvalues (referred to as RRRs, Relatively Robust
-*> Representations). An informal sketch of the algorithm follows.
-*>
-*> For each unreduced block (submatrix) of T,
-*> (a) Compute T - sigma I = L D L^T, so that L and D
-*> define all the wanted eigenvalues to high relative accuracy.
-*> This means that small relative changes in the entries of D and L
-*> cause only small relative changes in the eigenvalues and
-*> eigenvectors. The standard (unfactored) representation of the
-*> tridiagonal matrix T does not have this property in general.
-*> (b) Compute the eigenvalues to suitable accuracy.
-*> If the eigenvectors are desired, the algorithm attains full
-*> accuracy of the computed eigenvalues only right before
-*> the corresponding vectors have to be computed, see steps c) and d).
-*> (c) For each cluster of close eigenvalues, select a new
-*> shift close to the cluster, find a new factorization, and refine
-*> the shifted eigenvalues to suitable accuracy.
-*> (d) For each eigenvalue with a large enough relative separation compute
-*> the corresponding eigenvector by forming a rank revealing twisted
-*> factorization. Go back to (c) for any clusters that remain.
-*>
-*> For more details, see:
-*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
-*> to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
-*> Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
-*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
-*> Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
-*> 2004. Also LAPACK Working Note 154.
-*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
-*> tridiagonal eigenvalue/eigenvector problem",
-*> Computer Science Division Technical Report No. UCB/CSD-97-971,
-*> UC Berkeley, May 1997.
-*>
-*> Further Details
-*> 1.SSTEMR works only on machines which follow IEEE-754
-*> floating-point standard in their handling of infinities and NaNs.
-*> This permits the use of efficient inner loops avoiding a check for
-*> zero divisors.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the N diagonal elements of the tridiagonal matrix
-*> T. On exit, D is overwritten.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N)
-*> On entry, the (N-1) subdiagonal elements of the tridiagonal
-*> matrix T in elements 1 to N-1 of E. E(N) need not be set on
-*> input, but is used internally as workspace.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*>
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*>
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix T
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and can be computed with a workspace
-*> query by setting NZC = -1, see below.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] NZC
-*> \verbatim
-*> NZC is INTEGER
-*> The number of eigenvectors to be held in the array Z.
-*> If RANGE = 'A', then NZC >= max(1,N).
-*> If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,VU].
-*> If RANGE = 'I', then NZC >= IU-IL+1.
-*> If NZC = -1, then a workspace query is assumed; the
-*> routine calculates the number of columns of the array Z that
-*> are needed to hold the eigenvectors.
-*> This value is returned as the first entry of the Z array, and
-*> no error message related to NZC is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th computed eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ). This is relevant in the case when the matrix
-*> is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
-*> \endverbatim
-*>
-*> \param[in,out] TRYRAC
-*> \verbatim
-*> TRYRAC is LOGICAL
-*> If TRYRAC.EQ..TRUE., indicates that the code should check whether
-*> the tridiagonal matrix defines its eigenvalues to high relative
-*> accuracy. If so, the code uses relative-accuracy preserving
-*> algorithms that might be (a bit) slower depending on the matrix.
-*> If the matrix does not define its eigenvalues to high relative
-*> accuracy, the code can uses possibly faster algorithms.
-*> If TRYRAC.EQ..FALSE., the code is not required to guarantee
-*> relatively accurate eigenvalues and can use the fastest possible
-*> techniques.
-*> On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix
-*> does not define its eigenvalues to high relative accuracy.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal
-*> (and minimal) LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,18*N)
-*> if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (LIWORK)
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N)
-*> if the eigenvectors are desired, and LIWORK >= max(1,8*N)
-*> if only the eigenvalues are to be computed.
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = 1X, internal error in SLARRE,
-*> if INFO = 2X, internal error in SLARRV.
-*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
-*> the nonzero error code returned by SLARRE or
-*> SLARRV, respectively.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Beresford Parlett, University of California, Berkeley, USA \n
-*> Jim Demmel, University of California, Berkeley, USA \n
-*> Inderjit Dhillon, University of Texas, Austin, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Christof Voemel, University of California, Berkeley, USA
-*
-* =====================================================================
- SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
- $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- LOGICAL TRYRAC
- INTEGER IL, INFO, IU, LDZ, NZC, LIWORK, LWORK, M, N
- REAL VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- REAL D( * ), E( * ), W( * ), WORK( * )
- REAL Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, FOUR, MINRGP
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0,
- $ FOUR = 4.0E0,
- $ MINRGP = 3.0E-3 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
- INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
- $ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
- $ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
- $ ITMP2, J, JBLK, JJ, LIWMIN, LWMIN, NSPLIT,
- $ NZCMIN, OFFSET, WBEGIN, WEND
- REAL BIGNUM, CS, EPS, PIVMIN, R1, R2, RMAX, RMIN,
- $ RTOL1, RTOL2, SAFMIN, SCALE, SMLNUM, SN,
- $ THRESH, TMP, TNRM, WL, WU
-* ..
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANST
- EXTERNAL LSAME, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAE2, SLAEV2, SLARRC, SLARRE, SLARRJ,
- $ SLARRR, SLARRV, SLASRT, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
- ZQUERY = ( NZC.EQ.-1 )
-
-* SSTEMR needs WORK of size 6*N, IWORK of size 3*N.
-* In addition, SLARRE needs WORK of size 6*N, IWORK of size 5*N.
-* Furthermore, SLARRV needs WORK of size 12*N, IWORK of size 7*N.
- IF( WANTZ ) THEN
- LWMIN = 18*N
- LIWMIN = 10*N
- ELSE
-* need less workspace if only the eigenvalues are wanted
- LWMIN = 12*N
- LIWMIN = 8*N
- ENDIF
-
- WL = ZERO
- WU = ZERO
- IIL = 0
- IIU = 0
-
- IF( VALEIG ) THEN
-* We do not reference VL, VU in the cases RANGE = 'I','A'
-* The interval (WL, WU] contains all the wanted eigenvalues.
-* It is either given by the user or computed in SLARRE.
- WL = VL
- WU = VU
- ELSEIF( INDEIG ) THEN
-* We do not reference IL, IU in the cases RANGE = 'V','A'
- IIL = IL
- IIU = IU
- ENDIF
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( VALEIG .AND. N.GT.0 .AND. WU.LE.WL ) THEN
- INFO = -7
- ELSE IF( INDEIG .AND. ( IIL.LT.1 .OR. IIL.GT.N ) ) THEN
- INFO = -8
- ELSE IF( INDEIG .AND. ( IIU.LT.IIL .OR. IIU.GT.N ) ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -13
- ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -17
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -19
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( WANTZ .AND. ALLEIG ) THEN
- NZCMIN = N
- ELSE IF( WANTZ .AND. VALEIG ) THEN
- CALL SLARRC( 'T', N, VL, VU, D, E, SAFMIN,
- $ NZCMIN, ITMP, ITMP2, INFO )
- ELSE IF( WANTZ .AND. INDEIG ) THEN
- NZCMIN = IIU-IIL+1
- ELSE
-* WANTZ .EQ. FALSE.
- NZCMIN = 0
- ENDIF
- IF( ZQUERY .AND. INFO.EQ.0 ) THEN
- Z( 1,1 ) = NZCMIN
- ELSE IF( NZC.LT.NZCMIN .AND. .NOT.ZQUERY ) THEN
- INFO = -14
- END IF
- END IF
-
- IF( INFO.NE.0 ) THEN
-*
- CALL XERBLA( 'SSTEMR', -INFO )
-*
- RETURN
- ELSE IF( LQUERY .OR. ZQUERY ) THEN
- RETURN
- END IF
-*
-* Handle N = 0, 1, and 2 cases immediately
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = D( 1 )
- ELSE
- IF( WL.LT.D( 1 ) .AND. WU.GE.D( 1 ) ) THEN
- M = 1
- W( 1 ) = D( 1 )
- END IF
- END IF
- IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- Z( 1, 1 ) = ONE
- ISUPPZ(1) = 1
- ISUPPZ(2) = 1
- END IF
- RETURN
- END IF
-*
- IF( N.EQ.2 ) THEN
- IF( .NOT.WANTZ ) THEN
- CALL SLAE2( D(1), E(1), D(2), R1, R2 )
- ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- CALL SLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
- END IF
- IF( ALLEIG.OR.
- $ (VALEIG.AND.(R2.GT.WL).AND.
- $ (R2.LE.WU)).OR.
- $ (INDEIG.AND.(IIL.EQ.1)) ) THEN
- M = M+1
- W( M ) = R2
- IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- Z( 1, M ) = -SN
- Z( 2, M ) = CS
-* Note: At most one of SN and CS can be zero.
- IF (SN.NE.ZERO) THEN
- IF (CS.NE.ZERO) THEN
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 2
- ELSE
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 1
- END IF
- ELSE
- ISUPPZ(2*M-1) = 2
- ISUPPZ(2*M) = 2
- END IF
- ENDIF
- ENDIF
- IF( ALLEIG.OR.
- $ (VALEIG.AND.(R1.GT.WL).AND.
- $ (R1.LE.WU)).OR.
- $ (INDEIG.AND.(IIU.EQ.2)) ) THEN
- M = M+1
- W( M ) = R1
- IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
- Z( 1, M ) = CS
- Z( 2, M ) = SN
-* Note: At most one of SN and CS can be zero.
- IF (SN.NE.ZERO) THEN
- IF (CS.NE.ZERO) THEN
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 2
- ELSE
- ISUPPZ(2*M-1) = 1
- ISUPPZ(2*M) = 1
- END IF
- ELSE
- ISUPPZ(2*M-1) = 2
- ISUPPZ(2*M) = 2
- END IF
- ENDIF
- ENDIF
- ELSE
-
-* Continue with general N
-
- INDGRS = 1
- INDERR = 2*N + 1
- INDGP = 3*N + 1
- INDD = 4*N + 1
- INDE2 = 5*N + 1
- INDWRK = 6*N + 1
-*
- IINSPL = 1
- IINDBL = N + 1
- IINDW = 2*N + 1
- IINDWK = 3*N + 1
-*
-* Scale matrix to allowable range, if necessary.
-* The allowable range is related to the PIVMIN parameter; see the
-* comments in SLARRD. The preference for scaling small values
-* up is heuristic; we expect users' matrices not to be close to the
-* RMAX threshold.
-*
- SCALE = ONE
- TNRM = SLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- SCALE = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- SCALE = RMAX / TNRM
- END IF
- IF( SCALE.NE.ONE ) THEN
- CALL SSCAL( N, SCALE, D, 1 )
- CALL SSCAL( N-1, SCALE, E, 1 )
- TNRM = TNRM*SCALE
- IF( VALEIG ) THEN
-* If eigenvalues in interval have to be found,
-* scale (WL, WU] accordingly
- WL = WL*SCALE
- WU = WU*SCALE
- ENDIF
- END IF
-*
-* Compute the desired eigenvalues of the tridiagonal after splitting
-* into smaller subblocks if the corresponding off-diagonal elements
-* are small
-* THRESH is the splitting parameter for SLARRE
-* A negative THRESH forces the old splitting criterion based on the
-* size of the off-diagonal. A positive THRESH switches to splitting
-* which preserves relative accuracy.
-*
- IF( TRYRAC ) THEN
-* Test whether the matrix warrants the more expensive relative approach.
- CALL SLARRR( N, D, E, IINFO )
- ELSE
-* The user does not care about relative accurately eigenvalues
- IINFO = -1
- ENDIF
-* Set the splitting criterion
- IF (IINFO.EQ.0) THEN
- THRESH = EPS
- ELSE
- THRESH = -EPS
-* relative accuracy is desired but T does not guarantee it
- TRYRAC = .FALSE.
- ENDIF
-*
- IF( TRYRAC ) THEN
-* Copy original diagonal, needed to guarantee relative accuracy
- CALL SCOPY(N,D,1,WORK(INDD),1)
- ENDIF
-* Store the squares of the offdiagonal values of T
- DO 5 J = 1, N-1
- WORK( INDE2+J-1 ) = E(J)**2
- 5 CONTINUE
-
-* Set the tolerance parameters for bisection
- IF( .NOT.WANTZ ) THEN
-* SLARRE computes the eigenvalues to full precision.
- RTOL1 = FOUR * EPS
- RTOL2 = FOUR * EPS
- ELSE
-* SLARRE computes the eigenvalues to less than full precision.
-* SLARRV will refine the eigenvalue approximations, and we can
-* need less accurate initial bisection in SLARRE.
-* Note: these settings do only affect the subset case and SLARRE
- RTOL1 = MAX( SQRT(EPS)*5.0E-2, FOUR * EPS )
- RTOL2 = MAX( SQRT(EPS)*5.0E-3, FOUR * EPS )
- ENDIF
- CALL SLARRE( RANGE, N, WL, WU, IIL, IIU, D, E,
- $ WORK(INDE2), RTOL1, RTOL2, THRESH, NSPLIT,
- $ IWORK( IINSPL ), M, W, WORK( INDERR ),
- $ WORK( INDGP ), IWORK( IINDBL ),
- $ IWORK( IINDW ), WORK( INDGRS ), PIVMIN,
- $ WORK( INDWRK ), IWORK( IINDWK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 10 + ABS( IINFO )
- RETURN
- END IF
-* Note that if RANGE .NE. 'V', SLARRE computes bounds on the desired
-* part of the spectrum. All desired eigenvalues are contained in
-* (WL,WU]
-
-
- IF( WANTZ ) THEN
-*
-* Compute the desired eigenvectors corresponding to the computed
-* eigenvalues
-*
- CALL SLARRV( N, WL, WU, D, E,
- $ PIVMIN, IWORK( IINSPL ), M,
- $ 1, M, MINRGP, RTOL1, RTOL2,
- $ W, WORK( INDERR ), WORK( INDGP ), IWORK( IINDBL ),
- $ IWORK( IINDW ), WORK( INDGRS ), Z, LDZ,
- $ ISUPPZ, WORK( INDWRK ), IWORK( IINDWK ), IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 20 + ABS( IINFO )
- RETURN
- END IF
- ELSE
-* SLARRE computes eigenvalues of the (shifted) root representation
-* SLARRV returns the eigenvalues of the unshifted matrix.
-* However, if the eigenvectors are not desired by the user, we need
-* to apply the corresponding shifts from SLARRE to obtain the
-* eigenvalues of the original matrix.
- DO 20 J = 1, M
- ITMP = IWORK( IINDBL+J-1 )
- W( J ) = W( J ) + E( IWORK( IINSPL+ITMP-1 ) )
- 20 CONTINUE
- END IF
-*
-
- IF ( TRYRAC ) THEN
-* Refine computed eigenvalues so that they are relatively accurate
-* with respect to the original matrix T.
- IBEGIN = 1
- WBEGIN = 1
- DO 39 JBLK = 1, IWORK( IINDBL+M-1 )
- IEND = IWORK( IINSPL+JBLK-1 )
- IN = IEND - IBEGIN + 1
- WEND = WBEGIN - 1
-* check if any eigenvalues have to be refined in this block
- 36 CONTINUE
- IF( WEND.LT.M ) THEN
- IF( IWORK( IINDBL+WEND ).EQ.JBLK ) THEN
- WEND = WEND + 1
- GO TO 36
- END IF
- END IF
- IF( WEND.LT.WBEGIN ) THEN
- IBEGIN = IEND + 1
- GO TO 39
- END IF
-
- OFFSET = IWORK(IINDW+WBEGIN-1)-1
- IFIRST = IWORK(IINDW+WBEGIN-1)
- ILAST = IWORK(IINDW+WEND-1)
- RTOL2 = FOUR * EPS
- CALL SLARRJ( IN,
- $ WORK(INDD+IBEGIN-1), WORK(INDE2+IBEGIN-1),
- $ IFIRST, ILAST, RTOL2, OFFSET, W(WBEGIN),
- $ WORK( INDERR+WBEGIN-1 ),
- $ WORK( INDWRK ), IWORK( IINDWK ), PIVMIN,
- $ TNRM, IINFO )
- IBEGIN = IEND + 1
- WBEGIN = WEND + 1
- 39 CONTINUE
- ENDIF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( SCALE.NE.ONE ) THEN
- CALL SSCAL( M, ONE / SCALE, W, 1 )
- END IF
- END IF
-*
-* If eigenvalues are not in increasing order, then sort them,
-* possibly along with eigenvectors.
-*
- IF( NSPLIT.GT.1 .OR. N.EQ.2 ) THEN
- IF( .NOT. WANTZ ) THEN
- CALL SLASRT( 'I', M, W, IINFO )
- IF( IINFO.NE.0 ) THEN
- INFO = 3
- RETURN
- END IF
- ELSE
- DO 60 J = 1, M - 1
- I = 0
- TMP = W( J )
- DO 50 JJ = J + 1, M
- IF( W( JJ ).LT.TMP ) THEN
- I = JJ
- TMP = W( JJ )
- END IF
- 50 CONTINUE
- IF( I.NE.0 ) THEN
- W( I ) = W( J )
- W( J ) = TMP
- IF( WANTZ ) THEN
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- ITMP = ISUPPZ( 2*I-1 )
- ISUPPZ( 2*I-1 ) = ISUPPZ( 2*J-1 )
- ISUPPZ( 2*J-1 ) = ITMP
- ITMP = ISUPPZ( 2*I )
- ISUPPZ( 2*I ) = ISUPPZ( 2*J )
- ISUPPZ( 2*J ) = ITMP
- END IF
- END IF
- 60 CONTINUE
- END IF
- ENDIF
-*
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of SSTEMR
-*
- END
diff --git a/netlib/LAPACK/ssteqr.f b/netlib/LAPACK/ssteqr.f
deleted file mode 100644
index c9fe9bf..0000000
--- a/netlib/LAPACK/ssteqr.f
+++ /dev/null
@@ -1,572 +0,0 @@
-*> \brief \b SSTEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEQR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssteqr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssteqr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssteqr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPZ
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEQR computes all eigenvalues and, optionally, eigenvectors of a
-*> symmetric tridiagonal matrix using the implicit QL or QR method.
-*> The eigenvectors of a full or band symmetric matrix can also be found
-*> if SSYTRD or SSPTRD or SSBTRD has been used to reduce this matrix to
-*> tridiagonal form.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only.
-*> = 'V': Compute eigenvalues and eigenvectors of the original
-*> symmetric matrix. On entry, Z must contain the
-*> orthogonal matrix used to reduce the original matrix
-*> to tridiagonal form.
-*> = 'I': Compute eigenvalues and eigenvectors of the
-*> tridiagonal matrix. Z is initialized to the identity
-*> matrix.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the diagonal elements of the tridiagonal matrix.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> On entry, if COMPZ = 'V', then Z contains the orthogonal
-*> matrix used in the reduction to tridiagonal form.
-*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
-*> orthonormal eigenvectors of the original symmetric matrix,
-*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors
-*> of the symmetric tridiagonal matrix.
-*> If COMPZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> eigenvectors are desired, then LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (max(1,2*N-2))
-*> If COMPZ = 'N', then WORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm has failed to find all the eigenvalues in
-*> a total of 30*N iterations; if INFO = i, then i
-*> elements of E have not converged to zero; on exit, D
-*> and E contain the elements of a symmetric tridiagonal
-*> matrix which is orthogonally similar to the original
-*> matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPZ
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, THREE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ THREE = 3.0E0 )
- INTEGER MAXIT
- PARAMETER ( MAXIT = 30 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
- $ LENDM1, LENDP1, LENDSV, LM1, LSV, M, MM, MM1,
- $ NM1, NMAXIT
- REAL ANORM, B, C, EPS, EPS2, F, G, P, R, RT1, RT2,
- $ S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANST, SLAPY2
- EXTERNAL LSAME, SLAMCH, SLANST, SLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAE2, SLAEV2, SLARTG, SLASCL, SLASET, SLASR,
- $ SLASRT, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
- IF( LSAME( COMPZ, 'N' ) ) THEN
- ICOMPZ = 0
- ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
- ICOMPZ = 1
- ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
- ICOMPZ = 2
- ELSE
- ICOMPZ = -1
- END IF
- IF( ICOMPZ.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
- $ N ) ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEQR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ICOMPZ.EQ.2 )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Determine the unit roundoff and over/underflow thresholds.
-*
- EPS = SLAMCH( 'E' )
- EPS2 = EPS**2
- SAFMIN = SLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- SSFMAX = SQRT( SAFMAX ) / THREE
- SSFMIN = SQRT( SAFMIN ) / EPS2
-*
-* Compute the eigenvalues and eigenvectors of the tridiagonal
-* matrix.
-*
- IF( ICOMPZ.EQ.2 )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
- NMAXIT = N*MAXIT
- JTOT = 0
-*
-* Determine where the matrix splits and choose QL or QR iteration
-* for each block, according to whether top or bottom diagonal
-* element is smaller.
-*
- L1 = 1
- NM1 = N - 1
-*
- 10 CONTINUE
- IF( L1.GT.N )
- $ GO TO 160
- IF( L1.GT.1 )
- $ E( L1-1 ) = ZERO
- IF( L1.LE.NM1 ) THEN
- DO 20 M = L1, NM1
- TST = ABS( E( M ) )
- IF( TST.EQ.ZERO )
- $ GO TO 30
- IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
- $ 1 ) ) ) )*EPS ) THEN
- E( M ) = ZERO
- GO TO 30
- END IF
- 20 CONTINUE
- END IF
- M = N
-*
- 30 CONTINUE
- L = L1
- LSV = L
- LEND = M
- LENDSV = LEND
- L1 = M + 1
- IF( LEND.EQ.L )
- $ GO TO 10
-*
-* Scale submatrix in rows and columns L to LEND
-*
- ANORM = SLANST( 'M', LEND-L+1, D( L ), E( L ) )
- ISCALE = 0
- IF( ANORM.EQ.ZERO )
- $ GO TO 10
- IF( ANORM.GT.SSFMAX ) THEN
- ISCALE = 1
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
- $ INFO )
- ELSE IF( ANORM.LT.SSFMIN ) THEN
- ISCALE = 2
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
- $ INFO )
- END IF
-*
-* Choose between QL and QR iteration
-*
- IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
- LEND = LSV
- L = LENDSV
- END IF
-*
- IF( LEND.GT.L ) THEN
-*
-* QL Iteration
-*
-* Look for small subdiagonal element.
-*
- 40 CONTINUE
- IF( L.NE.LEND ) THEN
- LENDM1 = LEND - 1
- DO 50 M = L, LENDM1
- TST = ABS( E( M ) )**2
- IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M+1 ) )+
- $ SAFMIN )GO TO 60
- 50 CONTINUE
- END IF
-*
- M = LEND
-*
- 60 CONTINUE
- IF( M.LT.LEND )
- $ E( M ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 80
-*
-* If remaining matrix is 2-by-2, use SLAE2 or SLAEV2
-* to compute its eigensystem.
-*
- IF( M.EQ.L+1 ) THEN
- IF( ICOMPZ.GT.0 ) THEN
- CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S )
- WORK( L ) = C
- WORK( N-1+L ) = S
- CALL SLASR( 'R', 'V', 'B', N, 2, WORK( L ),
- $ WORK( N-1+L ), Z( 1, L ), LDZ )
- ELSE
- CALL SLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
- END IF
- D( L ) = RT1
- D( L+1 ) = RT2
- E( L ) = ZERO
- L = L + 2
- IF( L.LE.LEND )
- $ GO TO 40
- GO TO 140
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 140
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- G = ( D( L+1 )-P ) / ( TWO*E( L ) )
- R = SLAPY2( G, ONE )
- G = D( M ) - P + ( E( L ) / ( G+SIGN( R, G ) ) )
-*
- S = ONE
- C = ONE
- P = ZERO
-*
-* Inner loop
-*
- MM1 = M - 1
- DO 70 I = MM1, L, -1
- F = S*E( I )
- B = C*E( I )
- CALL SLARTG( G, F, C, S, R )
- IF( I.NE.M-1 )
- $ E( I+1 ) = R
- G = D( I+1 ) - P
- R = ( D( I )-G )*S + TWO*C*B
- P = S*R
- D( I+1 ) = G + P
- G = C*R - B
-*
-* If eigenvectors are desired, then save rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- WORK( I ) = C
- WORK( N-1+I ) = -S
- END IF
-*
- 70 CONTINUE
-*
-* If eigenvectors are desired, then apply saved rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- MM = M - L + 1
- CALL SLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ),
- $ Z( 1, L ), LDZ )
- END IF
-*
- D( L ) = D( L ) - P
- E( L ) = G
- GO TO 40
-*
-* Eigenvalue found.
-*
- 80 CONTINUE
- D( L ) = P
-*
- L = L + 1
- IF( L.LE.LEND )
- $ GO TO 40
- GO TO 140
-*
- ELSE
-*
-* QR Iteration
-*
-* Look for small superdiagonal element.
-*
- 90 CONTINUE
- IF( L.NE.LEND ) THEN
- LENDP1 = LEND + 1
- DO 100 M = L, LENDP1, -1
- TST = ABS( E( M-1 ) )**2
- IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M-1 ) )+
- $ SAFMIN )GO TO 110
- 100 CONTINUE
- END IF
-*
- M = LEND
-*
- 110 CONTINUE
- IF( M.GT.LEND )
- $ E( M-1 ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 130
-*
-* If remaining matrix is 2-by-2, use SLAE2 or SLAEV2
-* to compute its eigensystem.
-*
- IF( M.EQ.L-1 ) THEN
- IF( ICOMPZ.GT.0 ) THEN
- CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S )
- WORK( M ) = C
- WORK( N-1+M ) = S
- CALL SLASR( 'R', 'V', 'F', N, 2, WORK( M ),
- $ WORK( N-1+M ), Z( 1, L-1 ), LDZ )
- ELSE
- CALL SLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
- END IF
- D( L-1 ) = RT1
- D( L ) = RT2
- E( L-1 ) = ZERO
- L = L - 2
- IF( L.GE.LEND )
- $ GO TO 90
- GO TO 140
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 140
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- G = ( D( L-1 )-P ) / ( TWO*E( L-1 ) )
- R = SLAPY2( G, ONE )
- G = D( M ) - P + ( E( L-1 ) / ( G+SIGN( R, G ) ) )
-*
- S = ONE
- C = ONE
- P = ZERO
-*
-* Inner loop
-*
- LM1 = L - 1
- DO 120 I = M, LM1
- F = S*E( I )
- B = C*E( I )
- CALL SLARTG( G, F, C, S, R )
- IF( I.NE.M )
- $ E( I-1 ) = R
- G = D( I ) - P
- R = ( D( I+1 )-G )*S + TWO*C*B
- P = S*R
- D( I ) = G + P
- G = C*R - B
-*
-* If eigenvectors are desired, then save rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- WORK( I ) = C
- WORK( N-1+I ) = S
- END IF
-*
- 120 CONTINUE
-*
-* If eigenvectors are desired, then apply saved rotations.
-*
- IF( ICOMPZ.GT.0 ) THEN
- MM = L - M + 1
- CALL SLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ),
- $ Z( 1, M ), LDZ )
- END IF
-*
- D( L ) = D( L ) - P
- E( LM1 ) = G
- GO TO 90
-*
-* Eigenvalue found.
-*
- 130 CONTINUE
- D( L ) = P
-*
- L = L - 1
- IF( L.GE.LEND )
- $ GO TO 90
- GO TO 140
-*
- END IF
-*
-* Undo scaling if necessary
-*
- 140 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
- CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ),
- $ N, INFO )
- ELSE IF( ISCALE.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
- CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ),
- $ N, INFO )
- END IF
-*
-* Check for no convergence to an eigenvalue after a total
-* of N*MAXIT iterations.
-*
- IF( JTOT.LT.NMAXIT )
- $ GO TO 10
- DO 150 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 150 CONTINUE
- GO TO 190
-*
-* Order eigenvalues and eigenvectors.
-*
- 160 CONTINUE
- IF( ICOMPZ.EQ.0 ) THEN
-*
-* Use Quick Sort
-*
- CALL SLASRT( 'I', N, D, INFO )
-*
- ELSE
-*
-* Use Selection Sort to minimize swaps of eigenvectors
-*
- DO 180 II = 2, N
- I = II - 1
- K = I
- P = D( I )
- DO 170 J = II, N
- IF( D( J ).LT.P ) THEN
- K = J
- P = D( J )
- END IF
- 170 CONTINUE
- IF( K.NE.I ) THEN
- D( K ) = D( I )
- D( I ) = P
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
- END IF
- 180 CONTINUE
- END IF
-*
- 190 CONTINUE
- RETURN
-*
-* End of SSTEQR
-*
- END
diff --git a/netlib/LAPACK/ssterf.f b/netlib/LAPACK/ssterf.f
deleted file mode 100644
index 58456e2..0000000
--- a/netlib/LAPACK/ssterf.f
+++ /dev/null
@@ -1,425 +0,0 @@
-*> \brief \b SSTERF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTERF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssterf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssterf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssterf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTERF( N, D, E, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTERF computes all eigenvalues of a symmetric tridiagonal matrix
-*> using the Pal-Walker-Kahan variant of the QL or QR algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix.
-*> On exit, E has been destroyed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm failed to find all of the eigenvalues in
-*> a total of 30*N iterations; if INFO = i, then i
-*> elements of E have not converged to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE SSTERF( N, D, E, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO, THREE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
- $ THREE = 3.0E0 )
- INTEGER MAXIT
- PARAMETER ( MAXIT = 30 )
-* ..
-* .. Local Scalars ..
- INTEGER I, ISCALE, JTOT, L, L1, LEND, LENDSV, LSV, M,
- $ NMAXIT
- REAL ALPHA, ANORM, BB, C, EPS, EPS2, GAMMA, OLDC,
- $ OLDGAM, P, R, RT1, RT2, RTE, S, SAFMAX, SAFMIN,
- $ SIGMA, SSFMAX, SSFMIN
-* ..
-* .. External Functions ..
- REAL SLAMCH, SLANST, SLAPY2
- EXTERNAL SLAMCH, SLANST, SLAPY2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAE2, SLASCL, SLASRT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'SSTERF', -INFO )
- RETURN
- END IF
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the unit roundoff for this environment.
-*
- EPS = SLAMCH( 'E' )
- EPS2 = EPS**2
- SAFMIN = SLAMCH( 'S' )
- SAFMAX = ONE / SAFMIN
- SSFMAX = SQRT( SAFMAX ) / THREE
- SSFMIN = SQRT( SAFMIN ) / EPS2
-*
-* Compute the eigenvalues of the tridiagonal matrix.
-*
- NMAXIT = N*MAXIT
- SIGMA = ZERO
- JTOT = 0
-*
-* Determine where the matrix splits and choose QL or QR iteration
-* for each block, according to whether top or bottom diagonal
-* element is smaller.
-*
- L1 = 1
-*
- 10 CONTINUE
- IF( L1.GT.N )
- $ GO TO 170
- IF( L1.GT.1 )
- $ E( L1-1 ) = ZERO
- DO 20 M = L1, N - 1
- IF( ABS( E( M ) ).LE.( SQRT( ABS( D( M ) ) )*
- $ SQRT( ABS( D( M+1 ) ) ) )*EPS ) THEN
- E( M ) = ZERO
- GO TO 30
- END IF
- 20 CONTINUE
- M = N
-*
- 30 CONTINUE
- L = L1
- LSV = L
- LEND = M
- LENDSV = LEND
- L1 = M + 1
- IF( LEND.EQ.L )
- $ GO TO 10
-*
-* Scale submatrix in rows and columns L to LEND
-*
- ANORM = SLANST( 'M', LEND-L+1, D( L ), E( L ) )
- ISCALE = 0
- IF( ANORM.EQ.ZERO )
- $ GO TO 10
- IF( ANORM.GT.SSFMAX ) THEN
- ISCALE = 1
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
- $ INFO )
- ELSE IF( ANORM.LT.SSFMIN ) THEN
- ISCALE = 2
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
- $ INFO )
- CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
- $ INFO )
- END IF
-*
- DO 40 I = L, LEND - 1
- E( I ) = E( I )**2
- 40 CONTINUE
-*
-* Choose between QL and QR iteration
-*
- IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
- LEND = LSV
- L = LENDSV
- END IF
-*
- IF( LEND.GE.L ) THEN
-*
-* QL Iteration
-*
-* Look for small subdiagonal element.
-*
- 50 CONTINUE
- IF( L.NE.LEND ) THEN
- DO 60 M = L, LEND - 1
- IF( ABS( E( M ) ).LE.EPS2*ABS( D( M )*D( M+1 ) ) )
- $ GO TO 70
- 60 CONTINUE
- END IF
- M = LEND
-*
- 70 CONTINUE
- IF( M.LT.LEND )
- $ E( M ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 90
-*
-* If remaining matrix is 2 by 2, use SLAE2 to compute its
-* eigenvalues.
-*
- IF( M.EQ.L+1 ) THEN
- RTE = SQRT( E( L ) )
- CALL SLAE2( D( L ), RTE, D( L+1 ), RT1, RT2 )
- D( L ) = RT1
- D( L+1 ) = RT2
- E( L ) = ZERO
- L = L + 2
- IF( L.LE.LEND )
- $ GO TO 50
- GO TO 150
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 150
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- RTE = SQRT( E( L ) )
- SIGMA = ( D( L+1 )-P ) / ( TWO*RTE )
- R = SLAPY2( SIGMA, ONE )
- SIGMA = P - ( RTE / ( SIGMA+SIGN( R, SIGMA ) ) )
-*
- C = ONE
- S = ZERO
- GAMMA = D( M ) - SIGMA
- P = GAMMA*GAMMA
-*
-* Inner loop
-*
- DO 80 I = M - 1, L, -1
- BB = E( I )
- R = P + BB
- IF( I.NE.M-1 )
- $ E( I+1 ) = S*R
- OLDC = C
- C = P / R
- S = BB / R
- OLDGAM = GAMMA
- ALPHA = D( I )
- GAMMA = C*( ALPHA-SIGMA ) - S*OLDGAM
- D( I+1 ) = OLDGAM + ( ALPHA-GAMMA )
- IF( C.NE.ZERO ) THEN
- P = ( GAMMA*GAMMA ) / C
- ELSE
- P = OLDC*BB
- END IF
- 80 CONTINUE
-*
- E( L ) = S*P
- D( L ) = SIGMA + GAMMA
- GO TO 50
-*
-* Eigenvalue found.
-*
- 90 CONTINUE
- D( L ) = P
-*
- L = L + 1
- IF( L.LE.LEND )
- $ GO TO 50
- GO TO 150
-*
- ELSE
-*
-* QR Iteration
-*
-* Look for small superdiagonal element.
-*
- 100 CONTINUE
- DO 110 M = L, LEND + 1, -1
- IF( ABS( E( M-1 ) ).LE.EPS2*ABS( D( M )*D( M-1 ) ) )
- $ GO TO 120
- 110 CONTINUE
- M = LEND
-*
- 120 CONTINUE
- IF( M.GT.LEND )
- $ E( M-1 ) = ZERO
- P = D( L )
- IF( M.EQ.L )
- $ GO TO 140
-*
-* If remaining matrix is 2 by 2, use SLAE2 to compute its
-* eigenvalues.
-*
- IF( M.EQ.L-1 ) THEN
- RTE = SQRT( E( L-1 ) )
- CALL SLAE2( D( L ), RTE, D( L-1 ), RT1, RT2 )
- D( L ) = RT1
- D( L-1 ) = RT2
- E( L-1 ) = ZERO
- L = L - 2
- IF( L.GE.LEND )
- $ GO TO 100
- GO TO 150
- END IF
-*
- IF( JTOT.EQ.NMAXIT )
- $ GO TO 150
- JTOT = JTOT + 1
-*
-* Form shift.
-*
- RTE = SQRT( E( L-1 ) )
- SIGMA = ( D( L-1 )-P ) / ( TWO*RTE )
- R = SLAPY2( SIGMA, ONE )
- SIGMA = P - ( RTE / ( SIGMA+SIGN( R, SIGMA ) ) )
-*
- C = ONE
- S = ZERO
- GAMMA = D( M ) - SIGMA
- P = GAMMA*GAMMA
-*
-* Inner loop
-*
- DO 130 I = M, L - 1
- BB = E( I )
- R = P + BB
- IF( I.NE.M )
- $ E( I-1 ) = S*R
- OLDC = C
- C = P / R
- S = BB / R
- OLDGAM = GAMMA
- ALPHA = D( I+1 )
- GAMMA = C*( ALPHA-SIGMA ) - S*OLDGAM
- D( I ) = OLDGAM + ( ALPHA-GAMMA )
- IF( C.NE.ZERO ) THEN
- P = ( GAMMA*GAMMA ) / C
- ELSE
- P = OLDC*BB
- END IF
- 130 CONTINUE
-*
- E( L-1 ) = S*P
- D( L ) = SIGMA + GAMMA
- GO TO 100
-*
-* Eigenvalue found.
-*
- 140 CONTINUE
- D( L ) = P
-*
- L = L - 1
- IF( L.GE.LEND )
- $ GO TO 100
- GO TO 150
-*
- END IF
-*
-* Undo scaling if necessary
-*
- 150 CONTINUE
- IF( ISCALE.EQ.1 )
- $ CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
- IF( ISCALE.EQ.2 )
- $ CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
- $ D( LSV ), N, INFO )
-*
-* Check for no convergence to an eigenvalue after a total
-* of N*MAXIT iterations.
-*
- IF( JTOT.LT.NMAXIT )
- $ GO TO 10
- DO 160 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 160 CONTINUE
- GO TO 180
-*
-* Sort eigenvalues in increasing order.
-*
- 170 CONTINUE
- CALL SLASRT( 'I', N, D, INFO )
-*
- 180 CONTINUE
- RETURN
-*
-* End of SSTERF
-*
- END
diff --git a/netlib/LAPACK/sstev.f b/netlib/LAPACK/sstev.f
deleted file mode 100644
index 3757224..0000000
--- a/netlib/LAPACK/sstev.f
+++ /dev/null
@@ -1,235 +0,0 @@
-*> \brief <b> SSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ
-* INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
-* REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEV computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric tridiagonal matrix A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A, stored in elements 1 to N-1 of E.
-*> On exit, the contents of E are destroyed.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with D(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (max(1,2*N-2))
-*> If JOBZ = 'N', WORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of E did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ
- INTEGER INFO, LDZ, N
-* ..
-* .. Array Arguments ..
- REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTZ
- INTEGER IMAX, ISCALE
- REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TNRM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANST
- EXTERNAL LSAME, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSTEQR, SSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -6
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEV ', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- TNRM = SLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( N, SIGMA, D, 1 )
- CALL SSCAL( N-1, SIGMA, E( 1 ), 1 )
- END IF
-*
-* For eigenvalues only, call SSTERF. For eigenvalues and
-* eigenvectors, call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, D, E, INFO )
- ELSE
- CALL SSTEQR( 'I', N, D, E, Z, LDZ, WORK, INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, D, 1 )
- END IF
-*
- RETURN
-*
-* End of SSTEV
-*
- END
diff --git a/netlib/LAPACK/sstevd.f b/netlib/LAPACK/sstevd.f
deleted file mode 100644
index c3a1fd3..0000000
--- a/netlib/LAPACK/sstevd.f
+++ /dev/null
@@ -1,302 +0,0 @@
-*> \brief <b> SSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ
-* INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEVD computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric tridiagonal matrix. If eigenvectors are desired, it
-*> uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, if INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A, stored in elements 1 to N-1 of E.
-*> On exit, the contents of E are destroyed.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, N)
-*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
-*> eigenvectors of the matrix A, with the i-th column of Z
-*> holding the eigenvector associated with D(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1 then LWORK must be at least
-*> ( 1 + 4*N + N**2 ).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of E did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ
- INTEGER INFO, LDZ, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTZ
- INTEGER ISCALE, LIWMIN, LWMIN
- REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TNRM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANST
- EXTERNAL LSAME, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSTEDC, SSTERF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- LIWMIN = 1
- LWMIN = 1
- IF( N.GT.1 .AND. WANTZ ) THEN
- LWMIN = 1 + 4*N + N**2
- LIWMIN = 3 + 5*N
- END IF
-*
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -6
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -8
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- TNRM = SLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( N, SIGMA, D, 1 )
- CALL SSCAL( N-1, SIGMA, E( 1 ), 1 )
- END IF
-*
-* For eigenvalues only, call SSTERF. For eigenvalues and
-* eigenvectors, call SSTEDC.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, D, E, INFO )
- ELSE
- CALL SSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK,
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL SSCAL( N, ONE / SIGMA, D, 1 )
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of SSTEVD
-*
- END
diff --git a/netlib/LAPACK/sstevr.f b/netlib/LAPACK/sstevr.f
deleted file mode 100644
index 556a78b..0000000
--- a/netlib/LAPACK/sstevr.f
+++ /dev/null
@@ -1,573 +0,0 @@
-*> \brief <b> SSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEVR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstevr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstevr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstevr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
-* M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEVR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix T. Eigenvalues and
-*> eigenvectors can be selected by specifying either a range of values
-*> or a range of indices for the desired eigenvalues.
-*>
-*> Whenever possible, SSTEVR calls SSTEMR to compute the
-*> eigenspectrum using Relatively Robust Representations. SSTEMR
-*> computes eigenvalues by the dqds algorithm, while orthogonal
-*> eigenvectors are computed from various "good" L D L^T representations
-*> (also known as Relatively Robust Representations). Gram-Schmidt
-*> orthogonalization is avoided as far as possible. More specifically,
-*> the various steps of the algorithm are as follows. For the i-th
-*> unreduced block of T,
-*> (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T
-*> is a relatively robust representation,
-*> (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high
-*> relative accuracy by the dqds algorithm,
-*> (c) If there is a cluster of close eigenvalues, "choose" sigma_i
-*> close to the cluster, and go to step (a),
-*> (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T,
-*> compute the corresponding eigenvector by forming a
-*> rank-revealing twisted factorization.
-*> The desired accuracy of the output can be specified by the input
-*> parameter ABSTOL.
-*>
-*> For more details, see "A new O(n^2) algorithm for the symmetric
-*> tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon,
-*> Computer Science Division Technical Report No. UCB//CSD-97-971,
-*> UC Berkeley, May 1997.
-*>
-*>
-*> Note 1 : SSTEVR calls SSTEMR when the full spectrum is requested
-*> on machines which conform to the ieee-754 floating point standard.
-*> SSTEVR calls SSTEBZ and SSTEIN on non-ieee machines and
-*> when partial spectrum requests are made.
-*>
-*> Normal execution of SSTEMR may create NaNs and infinities and
-*> hence may abort due to a floating point exception in environments
-*> which do not handle NaNs and infinities in the ieee standard default
-*> manner.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
-*> SSTEIN are called
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, D may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (max(1,N-1))
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A in elements 1 to N-1 of E.
-*> On exit, E may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*>
-*> If high relative accuracy is important, set ABSTOL to
-*> SLAMCH( 'Safe minimum' ). Doing so will guarantee that
-*> eigenvalues are computed to high relative accuracy when
-*> possible in future releases. The current code does not
-*> make any guarantees about high relative accuracy, but
-*> future releases will. See J. Barlow and J. Demmel,
-*> "Computing Accurate Eigensystems of Scaled Diagonally
-*> Dominant Matrices", LAPACK Working Note #7, for a discussion
-*> of which matrices define their eigenvalues to high relative
-*> accuracy.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ).
-*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal (and
-*> minimal) LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 20*N.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal (and
-*> minimal) LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= 10*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: Internal error
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Inderjit Dhillon, IBM Almaden, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Ken Stanley, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Jason Riedy, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*>
-* =====================================================================
- SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
- $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, LQUERY, VALEIG, WANTZ,
- $ TRYRAC
- CHARACTER ORDER
- INTEGER I, IEEEOK, IMAX, INDIBL, INDIFL, INDISP,
- $ INDIWO, ISCALE, J, JJ, LIWMIN, LWMIN, NSPLIT
- REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TMP1, TNRM, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANST
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEMR, SSTEIN, SSTERF,
- $ SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-*
-* Test the input parameters.
-*
- IEEEOK = ILAENV( 10, 'SSTEVR', 'N', 1, 2, 3, 4 )
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
- LWMIN = MAX( 1, 20*N )
- LIWMIN = MAX(1, 10*N )
-*
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -7
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -9
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -14
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -17
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -19
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEVR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = D( 1 )
- ELSE
- IF( VL.LT.D( 1 ) .AND. VU.GE.D( 1 ) ) THEN
- M = 1
- W( 1 ) = D( 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- VLL = VL
- VUU = VU
-*
- TNRM = SLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( N, SIGMA, D, 1 )
- CALL SSCAL( N-1, SIGMA, E( 1 ), 1 )
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-
-* Initialize indices into workspaces. Note: These indices are used only
-* if SSTERF or SSTEMR fail.
-
-* IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in SSTEBZ and
-* stores the block indices of each of the M<=N eigenvalues.
- INDIBL = 1
-* IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in SSTEBZ and
-* stores the starting and finishing indices of each block.
- INDISP = INDIBL + N
-* IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
-* that corresponding to eigenvectors that fail to converge in
-* SSTEIN. This information is discarded; if any fail, the driver
-* returns INFO > 0.
- INDIFL = INDISP + N
-* INDIWO is the offset of the remaining integer workspace.
- INDIWO = INDISP + N
-*
-* If all eigenvalues are desired, then
-* call SSTERF or SSTEMR. If this fails for some eigenvalue, then
-* try SSTEBZ.
-*
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. IEEEOK.EQ.1 ) THEN
- CALL SCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 )
- IF( .NOT.WANTZ ) THEN
- CALL SCOPY( N, D, 1, W, 1 )
- CALL SSTERF( N, W, WORK, INFO )
- ELSE
- CALL SCOPY( N, D, 1, WORK( N+1 ), 1 )
- IF (ABSTOL .LE. TWO*N*EPS) THEN
- TRYRAC = .TRUE.
- ELSE
- TRYRAC = .FALSE.
- END IF
- CALL SSTEMR( JOBZ, 'A', N, WORK( N+1 ), WORK, VL, VU, IL,
- $ IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC,
- $ WORK( 2*N+1 ), LWORK-2*N, IWORK, LIWORK, INFO )
-*
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 10
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
-
- CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
- $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), WORK,
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ),
- $ Z, LDZ, WORK, IWORK( INDIWO ), IWORK( INDIFL ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 10 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 30 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 20 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 20 CONTINUE
-*
- IF( I.NE.0 ) THEN
- W( I ) = W( J )
- W( J ) = TMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- END IF
- 30 CONTINUE
- END IF
-*
-* Causes problems with tests 19 & 20:
-* IF (wantz .and. INDEIG ) Z( 1,1) = Z(1,1) / 1.002 + .002
-*
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- RETURN
-*
-* End of SSTEVR
-*
- END
diff --git a/netlib/LAPACK/sstevx.f b/netlib/LAPACK/sstevx.f
deleted file mode 100644
index 58f86f2..0000000
--- a/netlib/LAPACK/sstevx.f
+++ /dev/null
@@ -1,457 +0,0 @@
-*> \brief <b> SSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSTEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
-* M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE
-* INTEGER IL, INFO, IU, LDZ, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSTEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric tridiagonal matrix A. Eigenvalues and
-*> eigenvectors can be selected by specifying either a range of values
-*> or a range of indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> On entry, the n diagonal elements of the tridiagonal matrix
-*> A.
-*> On exit, D may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is REAL array, dimension (max(1,N-1))
-*> On entry, the (n-1) subdiagonal elements of the tridiagonal
-*> matrix A in elements 1 to N-1 of E.
-*> On exit, E may be multiplied by a constant factor chosen
-*> to avoid over/underflow in computing the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less
-*> than or equal to zero, then EPS*|T| will be used in
-*> its place, where |T| is the 1-norm of the tridiagonal
-*> matrix.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M) )
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge (INFO > 0), then that
-*> column of Z contains the latest approximation to the
-*> eigenvector, and the index of the eigenvector is returned
-*> in IFAIL. If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHEReigen
-*
-* =====================================================================
- SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
- $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE
- INTEGER IL, INFO, IU, LDZ, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
- CHARACTER ORDER
- INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK,
- $ ISCALE, ITMP1, J, JJ, NSPLIT
- REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
- $ TMP1, TNRM, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH, SLANST
- EXTERNAL LSAME, SLAMCH, SLANST
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEIN, SSTEQR, SSTERF,
- $ SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -7
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -9
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
- $ INFO = -14
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSTEVX', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = D( 1 )
- ELSE
- IF( VL.LT.D( 1 ) .AND. VU.GE.D( 1 ) ) THEN
- M = 1
- W( 1 ) = D( 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- IF ( VALEIG ) THEN
- VLL = VL
- VUU = VU
- ELSE
- VLL = ZERO
- VUU = ZERO
- ENDIF
- TNRM = SLANST( 'M', N, D, E )
- IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / TNRM
- ELSE IF( TNRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / TNRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- CALL SSCAL( N, SIGMA, D, 1 )
- CALL SSCAL( N-1, SIGMA, E( 1 ), 1 )
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* If all eigenvalues are desired and ABSTOL is less than zero, then
-* call SSTERF or SSTEQR. If this fails for some eigenvalue, then
-* try SSTEBZ.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
- CALL SCOPY( N, D, 1, W, 1 )
- CALL SCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 )
- INDWRK = N + 1
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK, INFO )
- ELSE
- CALL SSTEQR( 'I', N, W, WORK, Z, LDZ, WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 10 I = 1, N
- IFAIL( I ) = 0
- 10 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 20
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDWRK = 1
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
- $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ),
- $ WORK( INDWRK ), IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ),
- $ Z, LDZ, WORK( INDWRK ), IWORK( INDIWO ), IFAIL,
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 20 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 40 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 30 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 30 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSTEVX
-*
- END
diff --git a/netlib/LAPACK/ssycon.f b/netlib/LAPACK/ssycon.f
deleted file mode 100644
index 7e614ce..0000000
--- a/netlib/LAPACK/ssycon.f
+++ /dev/null
@@ -1,244 +0,0 @@
-*> \brief \b SSYCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssycon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssycon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssycon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYCON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYCON estimates the reciprocal of the condition number (in the
-*> 1-norm) of a real symmetric matrix A using the factorization
-*> A = U*D*U**T or A = L*D*L**T computed by SSYTRF.
-*>
-*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is REAL
-*> The 1-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYCON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
- REAL ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, KASE
- REAL AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SSYTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.LE.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- DO 10 I = N, 1, -1
- IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- DO 20 I = 1, N
- IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
- $ RETURN
- 20 CONTINUE
- END IF
-*
-* Estimate the 1-norm of the inverse.
-*
- KASE = 0
- 30 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
-*
-* Multiply by inv(L*D*L**T) or inv(U*D*U**T).
-*
- CALL SSYTRS( UPLO, N, 1, A, LDA, IPIV, WORK, N, INFO )
- GO TO 30
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of SSYCON
-*
- END
diff --git a/netlib/LAPACK/ssyconv.f b/netlib/LAPACK/ssyconv.f
deleted file mode 100644
index 84dd3a4..0000000
--- a/netlib/LAPACK/ssyconv.f
+++ /dev/null
@@ -1,362 +0,0 @@
-*> \brief \b SSYCONV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYCONV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyconv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyconv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyconv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO, WAY
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYCONV convert A given by TRF into L and D and vice-versa.
-*> Get Non-diag elements of D (returned in workspace) and
-*> apply or reverse permutation done in TRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] WAY
-*> \verbatim
-*> WAY is CHARACTER*1
-*> = 'C': Convert
-*> = 'R': Revert
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO, WAY
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-*
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* .. Local Scalars ..
- LOGICAL UPPER, CONVERT
- INTEGER I, IP, J
- REAL TEMP
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- CONVERT = LSAME( WAY, 'C' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
-
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYCONV', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* A is UPPER
-*
-* Convert A (A is upper)
-*
-* Convert VALUE
-*
- IF ( CONVERT ) THEN
- I=N
- WORK(1)=ZERO
- DO WHILE ( I .GT. 1 )
- IF( IPIV(I) .LT. 0 ) THEN
- WORK(I)=A(I-1,I)
- A(I-1,I)=ZERO
- I=I-1
- ELSE
- WORK(I)=ZERO
- ENDIF
- I=I-1
- END DO
-*
-* Convert PERMUTATIONS
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0) THEN
- IP=IPIV(I)
- IF( I .LT. N) THEN
- DO 12 J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I,J)
- A(I,J)=TEMP
- 12 CONTINUE
- ENDIF
- ELSE
- IP=-IPIV(I)
- IF( I .LT. N) THEN
- DO 13 J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I-1,J)
- A(I-1,J)=TEMP
- 13 CONTINUE
- ENDIF
- I=I-1
- ENDIF
- I=I-1
- END DO
-
- ELSE
-*
-* Revert A (A is upper)
-*
-*
-* Revert PERMUTATIONS
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF( I .LT. N) THEN
- DO J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I,J)
- A(I,J)=TEMP
- END DO
- ENDIF
- ELSE
- IP=-IPIV(I)
- I=I+1
- IF( I .LT. N) THEN
- DO J= I+1,N
- TEMP=A(IP,J)
- A(IP,J)=A(I-1,J)
- A(I-1,J)=TEMP
- END DO
- ENDIF
- ENDIF
- I=I+1
- END DO
-*
-* Revert VALUE
-*
- I=N
- DO WHILE ( I .GT. 1 )
- IF( IPIV(I) .LT. 0 ) THEN
- A(I-1,I)=WORK(I)
- I=I-1
- ENDIF
- I=I-1
- END DO
- END IF
- ELSE
-*
-* A is LOWER
-*
- IF ( CONVERT ) THEN
-*
-* Convert A (A is lower)
-*
-*
-* Convert VALUE
-*
- I=1
- WORK(N)=ZERO
- DO WHILE ( I .LE. N )
- IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
- WORK(I)=A(I+1,I)
- A(I+1,I)=ZERO
- I=I+1
- ELSE
- WORK(I)=ZERO
- ENDIF
- I=I+1
- END DO
-*
-* Convert PERMUTATIONS
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .GT. 1) THEN
- DO 22 J= 1,I-1
- TEMP=A(IP,J)
- A(IP,J)=A(I,J)
- A(I,J)=TEMP
- 22 CONTINUE
- ENDIF
- ELSE
- IP=-IPIV(I)
- IF (I .GT. 1) THEN
- DO 23 J= 1,I-1
- TEMP=A(IP,J)
- A(IP,J)=A(I+1,J)
- A(I+1,J)=TEMP
- 23 CONTINUE
- ENDIF
- I=I+1
- ENDIF
- I=I+1
- END DO
- ELSE
-*
-* Revert A (A is lower)
-*
-*
-* Revert PERMUTATIONS
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .GT. 1) THEN
- DO J= 1,I-1
- TEMP=A(I,J)
- A(I,J)=A(IP,J)
- A(IP,J)=TEMP
- END DO
- ENDIF
- ELSE
- IP=-IPIV(I)
- I=I-1
- IF (I .GT. 1) THEN
- DO J= 1,I-1
- TEMP=A(I+1,J)
- A(I+1,J)=A(IP,J)
- A(IP,J)=TEMP
- END DO
- ENDIF
- ENDIF
- I=I-1
- END DO
-*
-* Revert VALUE
-*
- I=1
- DO WHILE ( I .LE. N-1 )
- IF( IPIV(I) .LT. 0 ) THEN
- A(I+1,I)=WORK(I)
- I=I+1
- ENDIF
- I=I+1
- END DO
- END IF
- END IF
-
- RETURN
-*
-* End of SSYCONV
-*
- END
diff --git a/netlib/LAPACK/ssyequb.f b/netlib/LAPACK/ssyequb.f
deleted file mode 100644
index b233b35..0000000
--- a/netlib/LAPACK/ssyequb.f
+++ /dev/null
@@ -1,342 +0,0 @@
-*> \brief \b SSYEQUB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYEQUB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyequb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyequb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyequb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, N
-* REAL AMAX, SCOND
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), S( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYEQUB computes row and column scalings intended to equilibrate a
-*> symmetric matrix A and reduce its condition number
-*> (with respect to the two-norm). S contains the scale factors,
-*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
-*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
-*> choice of S puts the condition number of B within a factor N of the
-*> smallest possible condition number over all possible diagonal
-*> scalings.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The N-by-N symmetric matrix whose scaling
-*> factors are to be computed. Only the diagonal elements of A
-*> are referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (N)
-*> If INFO = 0, S contains the scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] SCOND
-*> \verbatim
-*> SCOND is REAL
-*> If INFO = 0, S contains the ratio of the smallest S(i) to
-*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
-*> large nor too small, it is not worth scaling by S.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is REAL
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-*> \par References:
-* ================
-*>
-*> Livne, O.E. and Golub, G.H., "Scaling by Binormalization", \n
-*> Numerical Algorithms, vol. 35, no. 1, pp. 97-120, January 2004. \n
-*> DOI 10.1023/B:NUMA.0000016606.32820.69 \n
-*> Tech report version: http://ruready.utah.edu/archive/papers/bin.pdf
-*>
-* =====================================================================
- SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, N
- REAL AMAX, SCOND
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), S( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
- INTEGER MAX_ITER
- PARAMETER ( MAX_ITER = 100 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, ITER
- REAL AVG, STD, TOL, C0, C1, C2, T, U, SI, D, BASE,
- $ SMIN, SMAX, SMLNUM, BIGNUM, SCALE, SUMSQ
- LOGICAL UP
-* ..
-* .. External Functions ..
- REAL SLAMCH
- LOGICAL LSAME
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test input parameters.
-*
- INFO = 0
- IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -1
- ELSE IF ( N .LT. 0 ) THEN
- INFO = -2
- ELSE IF ( LDA .LT. MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF ( INFO .NE. 0 ) THEN
- CALL XERBLA( 'SSYEQUB', -INFO )
- RETURN
- END IF
-
- UP = LSAME( UPLO, 'U' )
- AMAX = ZERO
-*
-* Quick return if possible.
-*
- IF ( N .EQ. 0 ) THEN
- SCOND = ONE
- RETURN
- END IF
-
- DO I = 1, N
- S( I ) = ZERO
- END DO
-
- AMAX = ZERO
- IF ( UP ) THEN
- DO J = 1, N
- DO I = 1, J-1
- S( I ) = MAX( S( I ), ABS( A( I, J ) ) )
- S( J ) = MAX( S( J ), ABS( A( I, J ) ) )
- AMAX = MAX( AMAX, ABS( A(I, J) ) )
- END DO
- S( J ) = MAX( S( J ), ABS( A( J, J ) ) )
- AMAX = MAX( AMAX, ABS( A( J, J ) ) )
- END DO
- ELSE
- DO J = 1, N
- S( J ) = MAX( S( J ), ABS( A( J, J ) ) )
- AMAX = MAX( AMAX, ABS( A( J, J ) ) )
- DO I = J+1, N
- S( I ) = MAX( S( I ), ABS( A( I, J ) ) )
- S( J ) = MAX( S( J ), ABS( A( I, J ) ) )
- AMAX = MAX( AMAX, ABS( A( I, J ) ) )
- END DO
- END DO
- END IF
- DO J = 1, N
- S( J ) = 1.0 / S( J )
- END DO
-
- TOL = ONE / SQRT(2.0E0 * N)
-
- DO ITER = 1, MAX_ITER
- SCALE = 0.0
- SUMSQ = 0.0
-* BETA = |A|S
- DO I = 1, N
- WORK(I) = ZERO
- END DO
- IF ( UP ) THEN
- DO J = 1, N
- DO I = 1, J-1
- T = ABS( A( I, J ) )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) ) * S( J )
- WORK( J ) = WORK( J ) + ABS( A( I, J ) ) * S( I )
- END DO
- WORK( J ) = WORK( J ) + ABS( A( J, J ) ) * S( J )
- END DO
- ELSE
- DO J = 1, N
- WORK( J ) = WORK( J ) + ABS( A( J, J ) ) * S( J )
- DO I = J+1, N
- T = ABS( A( I, J ) )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) ) * S( J )
- WORK( J ) = WORK( J ) + ABS( A( I, J ) ) * S( I )
- END DO
- END DO
- END IF
-
-* avg = s^T beta / n
- AVG = 0.0
- DO I = 1, N
- AVG = AVG + S( I )*WORK( I )
- END DO
- AVG = AVG / N
-
- STD = 0.0
- DO I = 2*N+1, 3*N
- WORK( I ) = S( I-2*N ) * WORK( I-2*N ) - AVG
- END DO
- CALL SLASSQ( N, WORK( 2*N+1 ), 1, SCALE, SUMSQ )
- STD = SCALE * SQRT( SUMSQ / N )
-
- IF ( STD .LT. TOL * AVG ) GOTO 999
-
- DO I = 1, N
- T = ABS( A( I, I ) )
- SI = S( I )
- C2 = ( N-1 ) * T
- C1 = ( N-2 ) * ( WORK( I ) - T*SI )
- C0 = -(T*SI)*SI + 2*WORK( I )*SI - N*AVG
- D = C1*C1 - 4*C0*C2
-
- IF ( D .LE. 0 ) THEN
- INFO = -1
- RETURN
- END IF
- SI = -2*C0 / ( C1 + SQRT( D ) )
-
- D = SI - S( I )
- U = ZERO
- IF ( UP ) THEN
- DO J = 1, I
- T = ABS( A( J, I ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- DO J = I+1,N
- T = ABS( A( I, J ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- ELSE
- DO J = 1, I
- T = ABS( A( I, J ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- DO J = I+1,N
- T = ABS( A( J, I ) )
- U = U + S( J )*T
- WORK( J ) = WORK( J ) + D*T
- END DO
- END IF
-
- AVG = AVG + ( U + WORK( I ) ) * D / N
- S( I ) = SI
-
- END DO
-
- END DO
-
- 999 CONTINUE
-
- SMLNUM = SLAMCH( 'SAFEMIN' )
- BIGNUM = ONE / SMLNUM
- SMIN = BIGNUM
- SMAX = ZERO
- T = ONE / SQRT(AVG)
- BASE = SLAMCH( 'B' )
- U = ONE / LOG( BASE )
- DO I = 1, N
- S( I ) = BASE ** INT( U * LOG( S( I ) * T ) )
- SMIN = MIN( SMIN, S( I ) )
- SMAX = MAX( SMAX, S( I ) )
- END DO
- SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
-*
- END
diff --git a/netlib/LAPACK/ssyev.f b/netlib/LAPACK/ssyev.f
deleted file mode 100644
index d9b8ca3..0000000
--- a/netlib/LAPACK/ssyev.f
+++ /dev/null
@@ -1,286 +0,0 @@
-*> \brief <b> SSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYEV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyev.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyev.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyev.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYEV computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric matrix A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> orthonormal eigenvectors of the matrix A.
-*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
-*> or the upper triangle (if UPLO='U') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,3*N-1).
-*> For optimal efficiency, LWORK >= (NB+2)*N,
-*> where NB is the blocksize for SSYTRD returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the algorithm failed to converge; i
-*> off-diagonal elements of an intermediate tridiagonal
-*> form did not converge to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYeigen
-*
-* =====================================================================
- SUBROUTINE SSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, LQUERY, WANTZ
- INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
- $ LLWORK, LWKOPT, NB
- REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANSY
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF, SSYTRD,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( 1, ( NB+2 )*N )
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY )
- $ INFO = -8
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = A( 1, 1 )
- WORK( 1 ) = 2
- IF( WANTZ )
- $ A( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 )
- $ CALL SLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
-*
-* Call SSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- INDWRK = INDTAU + N
- LLWORK = LWORK - INDWRK + 1
- CALL SSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
- $ WORK( INDWRK ), LLWORK, IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, first call
-* SORGTR to generate the orthogonal matrix, then call SSTEQR.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
- $ LLWORK, IINFO )
- CALL SSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ),
- $ INFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = N
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SSYEV
-*
- END
diff --git a/netlib/LAPACK/ssyevd.f b/netlib/LAPACK/ssyevd.f
deleted file mode 100644
index 5e78379..0000000
--- a/netlib/LAPACK/ssyevd.f
+++ /dev/null
@@ -1,355 +0,0 @@
-*> \brief <b> SSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYEVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
-* LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, LDA, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYEVD computes all eigenvalues and, optionally, eigenvectors of a
-*> real symmetric matrix A. If eigenvectors are desired, it uses a
-*> divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*>
-*> Because of large use of BLAS of level 3, SSYEVD needs N**2 more
-*> workspace than SSYEVX.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> orthonormal eigenvectors of the matrix A.
-*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
-*> or the upper triangle (if UPLO='U') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array,
-*> dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK must be at least 1.
-*> If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
-*> If JOBZ = 'V' and N > 1, LWORK must be at least
-*> 1 + 6*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If N <= 1, LIWORK must be at least 1.
-*> If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
-*> If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i and JOBZ = 'N', then the algorithm failed
-*> to converge; i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> if INFO = i and JOBZ = 'V', then the algorithm failed
-*> to compute an eigenvalue while working on the submatrix
-*> lying in rows and columns INFO/(N+1) through
-*> mod(INFO,N+1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYeigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Jeff Rutter, Computer Science Division, University of California
-*> at Berkeley, USA \n
-*> Modified by Francoise Tisseur, University of Tennessee \n
-*> Modified description of INFO. Sven, 16 Feb 05. \n
-*>
-* =====================================================================
- SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
- $ LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, LDA, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
-*
- LOGICAL LOWER, LQUERY, WANTZ
- INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
- $ LIOPT, LIWMIN, LLWORK, LLWRK2, LOPT, LWMIN
- REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
- $ SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANSY
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, SSTERF,
- $ SSYTRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- LOWER = LSAME( UPLO, 'L' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- LOPT = LWMIN
- LIOPT = LIWMIN
- ELSE
- IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N + 1
- END IF
- LOPT = MAX( LWMIN, 2*N +
- $ ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
- LIOPT = LIWMIN
- END IF
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -8
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYEVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- W( 1 ) = A( 1, 1 )
- IF( WANTZ )
- $ A( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = SQRT( BIGNUM )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
- ISCALE = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 )
- $ CALL SLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
-*
-* Call SSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- INDE = 1
- INDTAU = INDE + N
- INDWRK = INDTAU + N
- LLWORK = LWORK - INDWRK + 1
- INDWK2 = INDWRK + N*N
- LLWRK2 = LWORK - INDWK2 + 1
-*
- CALL SSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
- $ WORK( INDWRK ), LLWORK, IINFO )
-*
-* For eigenvalues only, call SSTERF. For eigenvectors, first call
-* SSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
-* tridiagonal matrix, then call SORMTR to multiply it by the
-* Householder transformations stored in A.
-*
- IF( .NOT.WANTZ ) THEN
- CALL SSTERF( N, W, WORK( INDE ), INFO )
- ELSE
- CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
- $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
- CALL SORMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
- $ WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
- CALL SLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- IF( ISCALE.EQ.1 )
- $ CALL SSCAL( N, ONE / SIGMA, W, 1 )
-*
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- RETURN
-*
-* End of SSYEVD
-*
- END
diff --git a/netlib/LAPACK/ssyevr.f b/netlib/LAPACK/ssyevr.f
deleted file mode 100644
index bfe4258..0000000
--- a/netlib/LAPACK/ssyevr.f
+++ /dev/null
@@ -1,681 +0,0 @@
-*> \brief <b> SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYEVR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
-* IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER ISUPPZ( * ), IWORK( * )
-* REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYEVR computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be
-*> selected by specifying either a range of values or a range of
-*> indices for the desired eigenvalues.
-*>
-*> SSYEVR first reduces the matrix A to tridiagonal form T with a call
-*> to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute
-*> the eigenspectrum using Relatively Robust Representations. SSTEMR
-*> computes eigenvalues by the dqds algorithm, while orthogonal
-*> eigenvectors are computed from various "good" L D L^T representations
-*> (also known as Relatively Robust Representations). Gram-Schmidt
-*> orthogonalization is avoided as far as possible. More specifically,
-*> the various steps of the algorithm are as follows.
-*>
-*> For each unreduced block (submatrix) of T,
-*> (a) Compute T - sigma I = L D L^T, so that L and D
-*> define all the wanted eigenvalues to high relative accuracy.
-*> This means that small relative changes in the entries of D and L
-*> cause only small relative changes in the eigenvalues and
-*> eigenvectors. The standard (unfactored) representation of the
-*> tridiagonal matrix T does not have this property in general.
-*> (b) Compute the eigenvalues to suitable accuracy.
-*> If the eigenvectors are desired, the algorithm attains full
-*> accuracy of the computed eigenvalues only right before
-*> the corresponding vectors have to be computed, see steps c) and d).
-*> (c) For each cluster of close eigenvalues, select a new
-*> shift close to the cluster, find a new factorization, and refine
-*> the shifted eigenvalues to suitable accuracy.
-*> (d) For each eigenvalue with a large enough relative separation compute
-*> the corresponding eigenvector by forming a rank revealing twisted
-*> factorization. Go back to (c) for any clusters that remain.
-*>
-*> The desired accuracy of the output can be specified by the input
-*> parameter ABSTOL.
-*>
-*> For more details, see SSTEMR's documentation and:
-*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
-*> to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
-*> Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
-*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
-*> Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
-*> 2004. Also LAPACK Working Note 154.
-*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
-*> tridiagonal eigenvalue/eigenvector problem",
-*> Computer Science Division Technical Report No. UCB/CSD-97-971,
-*> UC Berkeley, May 1997.
-*>
-*>
-*> Note 1 : SSYEVR calls SSTEMR when the full spectrum is requested
-*> on machines which conform to the ieee-754 floating point standard.
-*> SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and
-*> when partial spectrum requests are made.
-*>
-*> Normal execution of SSTEMR may create NaNs and infinities and
-*> hence may abort due to a floating point exception in environments
-*> which do not handle NaNs and infinities in the ieee standard default
-*> manner.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
-*> SSTEIN are called
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, the lower triangle (if UPLO='L') or the upper
-*> triangle (if UPLO='U') of A, including the diagonal, is
-*> destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*>
-*> If high relative accuracy is important, set ABSTOL to
-*> SLAMCH( 'Safe minimum' ). Doing so will guarantee that
-*> eigenvalues are computed to high relative accuracy when
-*> possible in future releases. The current code does not
-*> make any guarantees about high relative accuracy, but
-*> future releases will. See J. Barlow and J. Demmel,
-*> "Computing Accurate Eigensystems of Scaled Diagonally
-*> Dominant Matrices", LAPACK Working Note #7, for a discussion
-*> of which matrices define their eigenvalues to high relative
-*> accuracy.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> The first M elements contain the selected eigenvalues in
-*> ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> Supplying N columns is always safe.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ISUPPZ
-*> \verbatim
-*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
-*> The support of the eigenvectors in Z, i.e., the indices
-*> indicating the nonzero elements in Z. The i-th eigenvector
-*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
-*> ISUPPZ( 2*i ).
-*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,26*N).
-*> For optimal efficiency, LWORK >= (NB+6)*N,
-*> where NB is the max of the blocksize for SSYTRD and SORMTR
-*> returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: Internal error
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYeigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Inderjit Dhillon, IBM Almaden, USA \n
-*> Osni Marques, LBNL/NERSC, USA \n
-*> Ken Stanley, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*> Jason Riedy, Computer Science Division, University of
-*> California at Berkeley, USA \n
-*>
-* =====================================================================
- SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
- $ IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER ISUPPZ( * ), IWORK( * )
- REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
- $ WANTZ, TRYRAC
- CHARACTER ORDER
- INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
- $ INDEE, INDIBL, INDIFL, INDISP, INDIWO, INDTAU,
- $ INDWK, INDWKN, ISCALE, J, JJ, LIWMIN,
- $ LLWORK, LLWRKN, LWKOPT, LWMIN, NB, NSPLIT
- REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANSY
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, SSTEIN,
- $ SSTERF, SSWAP, SSYTRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- IEEEOK = ILAENV( 10, 'SSYEVR', 'N', 1, 2, 3, 4 )
-*
- LOWER = LSAME( UPLO, 'L' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
-*
- LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
-*
- LWMIN = MAX( 1, 26*N )
- LIWMIN = MAX( 1, 10*N )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -8
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -10
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -15
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
- NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) )
- LWKOPT = MAX( ( NB+1 )*N, LWMIN )
- WORK( 1 ) = LWKOPT
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -18
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYEVR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = 26
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- ELSE
- IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- END IF
- END IF
- IF( WANTZ ) THEN
- Z( 1, 1 ) = ONE
- ISUPPZ( 1 ) = 1
- ISUPPZ( 2 ) = 1
- END IF
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF (VALEIG) THEN
- VLL = VL
- VUU = VU
- END IF
- ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- DO 10 J = 1, N
- CALL SSCAL( N-J+1, SIGMA, A( J, J ), 1 )
- 10 CONTINUE
- ELSE
- DO 20 J = 1, N
- CALL SSCAL( J, SIGMA, A( 1, J ), 1 )
- 20 CONTINUE
- END IF
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-
-* Initialize indices into workspaces. Note: The IWORK indices are
-* used only if SSTERF or SSTEMR fail.
-
-* WORK(INDTAU:INDTAU+N-1) stores the scalar factors of the
-* elementary reflectors used in SSYTRD.
- INDTAU = 1
-* WORK(INDD:INDD+N-1) stores the tridiagonal's diagonal entries.
- INDD = INDTAU + N
-* WORK(INDE:INDE+N-1) stores the off-diagonal entries of the
-* tridiagonal matrix from SSYTRD.
- INDE = INDD + N
-* WORK(INDDD:INDDD+N-1) is a copy of the diagonal entries over
-* -written by SSTEMR (the SSTERF path copies the diagonal to W).
- INDDD = INDE + N
-* WORK(INDEE:INDEE+N-1) is a copy of the off-diagonal entries over
-* -written while computing the eigenvalues in SSTERF and SSTEMR.
- INDEE = INDDD + N
-* INDWK is the starting offset of the left-over workspace, and
-* LLWORK is the remaining workspace size.
- INDWK = INDEE + N
- LLWORK = LWORK - INDWK + 1
-
-* IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in SSTEBZ and
-* stores the block indices of each of the M<=N eigenvalues.
- INDIBL = 1
-* IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in SSTEBZ and
-* stores the starting and finishing indices of each block.
- INDISP = INDIBL + N
-* IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
-* that corresponding to eigenvectors that fail to converge in
-* SSTEIN. This information is discarded; if any fail, the driver
-* returns INFO > 0.
- INDIFL = INDISP + N
-* INDIWO is the offset of the remaining integer workspace.
- INDIWO = INDIFL + N
-
-*
-* Call SSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- CALL SSYTRD( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ),
- $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO )
-*
-* If all eigenvalues are desired
-* then call SSTERF or SSTEMR and SORMTR.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN
- IF( .NOT.WANTZ ) THEN
- CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 )
-*
- IF (ABSTOL .LE. TWO*N*EPS) THEN
- TRYRAC = .TRUE.
- ELSE
- TRYRAC = .FALSE.
- END IF
- CALL SSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ),
- $ VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ,
- $ TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK,
- $ INFO )
-*
-*
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by SSTEIN.
-*
- IF( WANTZ .AND. INFO.EQ.0 ) THEN
- INDWKN = INDE
- LLWRKN = LWORK - INDWKN + 1
- CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA,
- $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
- $ LLWRKN, IINFO )
- END IF
- END IF
-*
-*
- IF( INFO.EQ.0 ) THEN
-* Everything worked. Skip SSTEBZ/SSTEIN. IWORK(:) are
-* undefined.
- M = N
- GO TO 30
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
-* Also call SSTEBZ and SSTEIN if SSTEMR fails.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
-
- CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWK ), IWORK( INDIWO ), IWORK( INDIFL ),
- $ INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by SSTEIN.
-*
- INDWKN = INDE
- LLWRKN = LWORK - INDWKN + 1
- CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
- $ LDZ, WORK( INDWKN ), LLWRKN, IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
-* Jump here if SSTEMR/SSTEIN succeeded.
- 30 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors. Note: We do not sort the IFAIL portion of IWORK.
-* It may not be initialized (if SSTEMR/SSTEIN succeeded), and we do
-* not return this detailed information to the user.
-*
- IF( WANTZ ) THEN
- DO 50 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 40 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 40 CONTINUE
-*
- IF( I.NE.0 ) THEN
- W( I ) = W( J )
- W( J ) = TMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- END IF
- 50 CONTINUE
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of SSYEVR
-*
- END
diff --git a/netlib/LAPACK/ssyevx.f b/netlib/LAPACK/ssyevx.f
deleted file mode 100644
index cbc8b1d..0000000
--- a/netlib/LAPACK/ssyevx.f
+++ /dev/null
@@ -1,547 +0,0 @@
-*> \brief <b> SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYEVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
-* ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK,
-* IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYEVX computes selected eigenvalues and, optionally, eigenvectors
-*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be
-*> selected by specifying either a range of values or a range of indices
-*> for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*> On exit, the lower triangle (if UPLO='L') or the upper
-*> triangle (if UPLO='U') of A, including the diagonal, is
-*> destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing A to tridiagonal form.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*>
-*> See "Computing Small Singular Values of Bidiagonal Matrices
-*> with Guaranteed High Relative Accuracy," by Demmel and
-*> Kahan, LAPACK Working Note #3.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On normal exit, the first M elements contain the selected
-*> eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> If JOBZ = 'N', then Z is not referenced.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= 1, when N <= 1;
-*> otherwise 8*N.
-*> For optimal efficiency, LWORK >= (NB+3)*N,
-*> where NB is the max of the blocksize for SSYTRD and SORMTR
-*> returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, then i eigenvectors failed to converge.
-*> Their indices are stored in array IFAIL.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYeigen
-*
-* =====================================================================
- SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
- $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK,
- $ IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
- $ WANTZ
- CHARACTER ORDER
- INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
- $ INDISP, INDIWO, INDTAU, INDWKN, INDWRK, ISCALE,
- $ ITMP1, J, JJ, LLWORK, LLWRKN, LWKMIN,
- $ LWKOPT, NB, NSPLIT
- REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
- $ SIGMA, SMLNUM, TMP1, VLL, VUU
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANSY
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, SSTEBZ,
- $ SSTEIN, SSTEQR, SSTERF, SSWAP, SSYTRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- LOWER = LSAME( UPLO, 'L' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -8
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -10
- END IF
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -15
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LWKMIN = 1
- WORK( 1 ) = LWKMIN
- ELSE
- LWKMIN = 8*N
- NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
- NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) )
- LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
- $ INFO = -17
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYEVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 ) THEN
- RETURN
- END IF
-*
- IF( N.EQ.1 ) THEN
- IF( ALLEIG .OR. INDEIG ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- ELSE
- IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
- M = 1
- W( 1 ) = A( 1, 1 )
- END IF
- END IF
- IF( WANTZ )
- $ Z( 1, 1 ) = ONE
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- EPS = SLAMCH( 'Precision' )
- SMLNUM = SAFMIN / EPS
- BIGNUM = ONE / SMLNUM
- RMIN = SQRT( SMLNUM )
- RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
-*
-* Scale matrix to allowable range, if necessary.
-*
- ISCALE = 0
- ABSTLL = ABSTOL
- IF( VALEIG ) THEN
- VLL = VL
- VUU = VU
- END IF
- ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
- IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
- ISCALE = 1
- SIGMA = RMIN / ANRM
- ELSE IF( ANRM.GT.RMAX ) THEN
- ISCALE = 1
- SIGMA = RMAX / ANRM
- END IF
- IF( ISCALE.EQ.1 ) THEN
- IF( LOWER ) THEN
- DO 10 J = 1, N
- CALL SSCAL( N-J+1, SIGMA, A( J, J ), 1 )
- 10 CONTINUE
- ELSE
- DO 20 J = 1, N
- CALL SSCAL( J, SIGMA, A( 1, J ), 1 )
- 20 CONTINUE
- END IF
- IF( ABSTOL.GT.0 )
- $ ABSTLL = ABSTOL*SIGMA
- IF( VALEIG ) THEN
- VLL = VL*SIGMA
- VUU = VU*SIGMA
- END IF
- END IF
-*
-* Call SSYTRD to reduce symmetric matrix to tridiagonal form.
-*
- INDTAU = 1
- INDE = INDTAU + N
- INDD = INDE + N
- INDWRK = INDD + N
- LLWORK = LWORK - INDWRK + 1
- CALL SSYTRD( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ),
- $ WORK( INDTAU ), WORK( INDWRK ), LLWORK, IINFO )
-*
-* If all eigenvalues are desired and ABSTOL is less than or equal to
-* zero, then call SSTERF or SORGTR and SSTEQR. If this fails for
-* some eigenvalue, then try SSTEBZ.
-*
- TEST = .FALSE.
- IF( INDEIG ) THEN
- IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
- TEST = .TRUE.
- END IF
- END IF
- IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
- CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
- INDEE = INDWRK + 2*N
- IF( .NOT.WANTZ ) THEN
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTERF( N, W, WORK( INDEE ), INFO )
- ELSE
- CALL SLACPY( 'A', N, N, A, LDA, Z, LDZ )
- CALL SORGTR( UPLO, N, Z, LDZ, WORK( INDTAU ),
- $ WORK( INDWRK ), LLWORK, IINFO )
- CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
- CALL SSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
- $ WORK( INDWRK ), INFO )
- IF( INFO.EQ.0 ) THEN
- DO 30 I = 1, N
- IFAIL( I ) = 0
- 30 CONTINUE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- M = N
- GO TO 40
- END IF
- INFO = 0
- END IF
-*
-* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
-*
- IF( WANTZ ) THEN
- ORDER = 'B'
- ELSE
- ORDER = 'E'
- END IF
- INDIBL = 1
- INDISP = INDIBL + N
- INDIWO = INDISP + N
- CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
- $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
- $ IWORK( INDIWO ), INFO )
-*
- IF( WANTZ ) THEN
- CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
- $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
- $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
-*
-* Apply orthogonal matrix used in reduction to tridiagonal
-* form to eigenvectors returned by SSTEIN.
-*
- INDWKN = INDE
- LLWRKN = LWORK - INDWKN + 1
- CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
- $ LDZ, WORK( INDWKN ), LLWRKN, IINFO )
- END IF
-*
-* If matrix was scaled, then rescale eigenvalues appropriately.
-*
- 40 CONTINUE
- IF( ISCALE.EQ.1 ) THEN
- IF( INFO.EQ.0 ) THEN
- IMAX = M
- ELSE
- IMAX = INFO - 1
- END IF
- CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
- END IF
-*
-* If eigenvalues are not in order, then sort them, along with
-* eigenvectors.
-*
- IF( WANTZ ) THEN
- DO 60 J = 1, M - 1
- I = 0
- TMP1 = W( J )
- DO 50 JJ = J + 1, M
- IF( W( JJ ).LT.TMP1 ) THEN
- I = JJ
- TMP1 = W( JJ )
- END IF
- 50 CONTINUE
-*
- IF( I.NE.0 ) THEN
- ITMP1 = IWORK( INDIBL+I-1 )
- W( I ) = W( J )
- IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
- W( J ) = TMP1
- IWORK( INDIBL+J-1 ) = ITMP1
- CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
- IF( INFO.NE.0 ) THEN
- ITMP1 = IFAIL( I )
- IFAIL( I ) = IFAIL( J )
- IFAIL( J ) = ITMP1
- END IF
- END IF
- 60 CONTINUE
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SSYEVX
-*
- END
diff --git a/netlib/LAPACK/ssygs2.f b/netlib/LAPACK/ssygs2.f
deleted file mode 100644
index 33a8c1d..0000000
--- a/netlib/LAPACK/ssygs2.f
+++ /dev/null
@@ -1,283 +0,0 @@
-*> \brief \b SSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorization results obtained from spotrf (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYGS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssygs2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssygs2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssygs2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYGS2 reduces a real symmetric-definite generalized eigenproblem
-*> to standard form.
-*>
-*> If ITYPE = 1, the problem is A*x = lambda*B*x,
-*> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*>
-*> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*> B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T *A*L.
-*>
-*> B must have been previously factorized as U**T *U or L*L**T by SPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*> = 2 or 3: compute U*A*U**T or L**T *A*L.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored, and how B has been factorized.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n by n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the transformed matrix, stored in the
-*> same format as A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> The triangular factor from the Cholesky factorization of B,
-*> as returned by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, HALF
- PARAMETER ( ONE = 1.0, HALF = 0.5 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER K
- REAL AKK, BKK, CT
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SSCAL, SSYR2, STRMV, STRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYGS2', -INFO )
- RETURN
- END IF
-*
- IF( ITYPE.EQ.1 ) THEN
- IF( UPPER ) THEN
-*
-* Compute inv(U**T)*A*inv(U)
-*
- DO 10 K = 1, N
-*
-* Update the upper triangle of A(k:n,k:n)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- AKK = AKK / BKK**2
- A( K, K ) = AKK
- IF( K.LT.N ) THEN
- CALL SSCAL( N-K, ONE / BKK, A( K, K+1 ), LDA )
- CT = -HALF*AKK
- CALL SAXPY( N-K, CT, B( K, K+1 ), LDB, A( K, K+1 ),
- $ LDA )
- CALL SSYR2( UPLO, N-K, -ONE, A( K, K+1 ), LDA,
- $ B( K, K+1 ), LDB, A( K+1, K+1 ), LDA )
- CALL SAXPY( N-K, CT, B( K, K+1 ), LDB, A( K, K+1 ),
- $ LDA )
- CALL STRSV( UPLO, 'Transpose', 'Non-unit', N-K,
- $ B( K+1, K+1 ), LDB, A( K, K+1 ), LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute inv(L)*A*inv(L**T)
-*
- DO 20 K = 1, N
-*
-* Update the lower triangle of A(k:n,k:n)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- AKK = AKK / BKK**2
- A( K, K ) = AKK
- IF( K.LT.N ) THEN
- CALL SSCAL( N-K, ONE / BKK, A( K+1, K ), 1 )
- CT = -HALF*AKK
- CALL SAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 )
- CALL SSYR2( UPLO, N-K, -ONE, A( K+1, K ), 1,
- $ B( K+1, K ), 1, A( K+1, K+1 ), LDA )
- CALL SAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 )
- CALL STRSV( UPLO, 'No transpose', 'Non-unit', N-K,
- $ B( K+1, K+1 ), LDB, A( K+1, K ), 1 )
- END IF
- 20 CONTINUE
- END IF
- ELSE
- IF( UPPER ) THEN
-*
-* Compute U*A*U**T
-*
- DO 30 K = 1, N
-*
-* Update the upper triangle of A(1:k,1:k)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- CALL STRMV( UPLO, 'No transpose', 'Non-unit', K-1, B,
- $ LDB, A( 1, K ), 1 )
- CT = HALF*AKK
- CALL SAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 )
- CALL SSYR2( UPLO, K-1, ONE, A( 1, K ), 1, B( 1, K ), 1,
- $ A, LDA )
- CALL SAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 )
- CALL SSCAL( K-1, BKK, A( 1, K ), 1 )
- A( K, K ) = AKK*BKK**2
- 30 CONTINUE
- ELSE
-*
-* Compute L**T *A*L
-*
- DO 40 K = 1, N
-*
-* Update the lower triangle of A(1:k,1:k)
-*
- AKK = A( K, K )
- BKK = B( K, K )
- CALL STRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, LDB,
- $ A( K, 1 ), LDA )
- CT = HALF*AKK
- CALL SAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA )
- CALL SSYR2( UPLO, K-1, ONE, A( K, 1 ), LDA, B( K, 1 ),
- $ LDB, A, LDA )
- CALL SAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA )
- CALL SSCAL( K-1, BKK, A( K, 1 ), LDA )
- A( K, K ) = AKK*BKK**2
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of SSYGS2
-*
- END
diff --git a/netlib/LAPACK/ssygst.f b/netlib/LAPACK/ssygst.f
deleted file mode 100644
index 1005107..0000000
--- a/netlib/LAPACK/ssygst.f
+++ /dev/null
@@ -1,321 +0,0 @@
-*> \brief \b SSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYGST + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssygst.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssygst.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssygst.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYGST reduces a real symmetric-definite generalized eigenproblem
-*> to standard form.
-*>
-*> If ITYPE = 1, the problem is A*x = lambda*B*x,
-*> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*>
-*> If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*> B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
-*>
-*> B must have been previously factorized as U**T*U or L*L**T by SPOTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*> = 2 or 3: compute U*A*U**T or L**T*A*L.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored and B is factored as
-*> U**T*U;
-*> = 'L': Lower triangle of A is stored and B is factored as
-*> L*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the transformed matrix, stored in the
-*> same format as A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> The triangular factor from the Cholesky factorization of B,
-*> as returned by SPOTRF.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, ITYPE, LDA, LDB, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, HALF
- PARAMETER ( ONE = 1.0, HALF = 0.5 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER K, KB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL SSYGS2, SSYMM, SSYR2K, STRMM, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYGST', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SSYGST', UPLO, N, -1, -1, -1 )
-*
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ITYPE.EQ.1 ) THEN
- IF( UPPER ) THEN
-*
-* Compute inv(U**T)*A*inv(U)
-*
- DO 10 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the upper triangle of A(k:n,k:n)
-*
- CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- IF( K+KB.LE.N ) THEN
- CALL STRSM( 'Left', UPLO, 'Transpose', 'Non-unit',
- $ KB, N-K-KB+1, ONE, B( K, K ), LDB,
- $ A( K, K+KB ), LDA )
- CALL SSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
- $ A( K, K ), LDA, B( K, K+KB ), LDB, ONE,
- $ A( K, K+KB ), LDA )
- CALL SSYR2K( UPLO, 'Transpose', N-K-KB+1, KB, -ONE,
- $ A( K, K+KB ), LDA, B( K, K+KB ), LDB,
- $ ONE, A( K+KB, K+KB ), LDA )
- CALL SSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
- $ A( K, K ), LDA, B( K, K+KB ), LDB, ONE,
- $ A( K, K+KB ), LDA )
- CALL STRSM( 'Right', UPLO, 'No transpose',
- $ 'Non-unit', KB, N-K-KB+1, ONE,
- $ B( K+KB, K+KB ), LDB, A( K, K+KB ),
- $ LDA )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Compute inv(L)*A*inv(L**T)
-*
- DO 20 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the lower triangle of A(k:n,k:n)
-*
- CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- IF( K+KB.LE.N ) THEN
- CALL STRSM( 'Right', UPLO, 'Transpose', 'Non-unit',
- $ N-K-KB+1, KB, ONE, B( K, K ), LDB,
- $ A( K+KB, K ), LDA )
- CALL SSYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
- $ A( K, K ), LDA, B( K+KB, K ), LDB, ONE,
- $ A( K+KB, K ), LDA )
- CALL SSYR2K( UPLO, 'No transpose', N-K-KB+1, KB,
- $ -ONE, A( K+KB, K ), LDA, B( K+KB, K ),
- $ LDB, ONE, A( K+KB, K+KB ), LDA )
- CALL SSYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
- $ A( K, K ), LDA, B( K+KB, K ), LDB, ONE,
- $ A( K+KB, K ), LDA )
- CALL STRSM( 'Left', UPLO, 'No transpose',
- $ 'Non-unit', N-K-KB+1, KB, ONE,
- $ B( K+KB, K+KB ), LDB, A( K+KB, K ),
- $ LDA )
- END IF
- 20 CONTINUE
- END IF
- ELSE
- IF( UPPER ) THEN
-*
-* Compute U*A*U**T
-*
- DO 30 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the upper triangle of A(1:k+kb-1,1:k+kb-1)
-*
- CALL STRMM( 'Left', UPLO, 'No transpose', 'Non-unit',
- $ K-1, KB, ONE, B, LDB, A( 1, K ), LDA )
- CALL SSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
- $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA )
- CALL SSYR2K( UPLO, 'No transpose', K-1, KB, ONE,
- $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A,
- $ LDA )
- CALL SSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
- $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA )
- CALL STRMM( 'Right', UPLO, 'Transpose', 'Non-unit',
- $ K-1, KB, ONE, B( K, K ), LDB, A( 1, K ),
- $ LDA )
- CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- 30 CONTINUE
- ELSE
-*
-* Compute L**T*A*L
-*
- DO 40 K = 1, N, NB
- KB = MIN( N-K+1, NB )
-*
-* Update the lower triangle of A(1:k+kb-1,1:k+kb-1)
-*
- CALL STRMM( 'Right', UPLO, 'No transpose', 'Non-unit',
- $ KB, K-1, ONE, B, LDB, A( K, 1 ), LDA )
- CALL SSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
- $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA )
- CALL SSYR2K( UPLO, 'Transpose', K-1, KB, ONE,
- $ A( K, 1 ), LDA, B( K, 1 ), LDB, ONE, A,
- $ LDA )
- CALL SSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
- $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA )
- CALL STRMM( 'Left', UPLO, 'Transpose', 'Non-unit', KB,
- $ K-1, ONE, B( K, K ), LDB, A( K, 1 ), LDA )
- CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
- $ B( K, K ), LDB, INFO )
- 40 CONTINUE
- END IF
- END IF
- END IF
- RETURN
-*
-* End of SSYGST
-*
- END
diff --git a/netlib/LAPACK/ssygv.f b/netlib/LAPACK/ssygv.f
deleted file mode 100644
index 8557929..0000000
--- a/netlib/LAPACK/ssygv.f
+++ /dev/null
@@ -1,314 +0,0 @@
-*> \brief \b SSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYGV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssygv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssygv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssygv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYGV computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
-*> Here A and B are assumed to be symmetric and B is also
-*> positive definite.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*>
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> matrix Z of eigenvectors. The eigenvectors are normalized
-*> as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
-*> or the lower triangle (if UPLO='L') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the symmetric positive definite matrix B.
-*> If UPLO = 'U', the leading N-by-N upper triangular part of B
-*> contains the upper triangular part of the matrix B.
-*> If UPLO = 'L', the leading N-by-N lower triangular part of B
-*> contains the lower triangular part of the matrix B.
-*>
-*> On exit, if INFO <= N, the part of B containing the matrix is
-*> overwritten by the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,3*N-1).
-*> For optimal efficiency, LWORK >= (NB+2)*N,
-*> where NB is the blocksize for SSYTRD returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: SPOTRF or SSYEV returned an error code:
-*> <= N: if INFO = i, SSYEV failed to converge;
-*> i off-diagonal elements of an intermediate
-*> tridiagonal form did not converge to zero;
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYeigen
-*
-* =====================================================================
- SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER TRANS
- INTEGER LWKMIN, LWKOPT, NB, NEIG
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPOTRF, SSYEV, SSYGST, STRMM, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- LWKMIN = MAX( 1, 3*N - 1 )
- NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( LWKMIN, ( NB + 2 )*N )
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYGV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL SPOTRF( UPLO, N, B, LDB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- CALL SSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- NEIG = N
- IF( INFO.GT.0 )
- $ NEIG = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
- $ B, LDB, A, LDA )
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
- $ B, LDB, A, LDA )
- END IF
- END IF
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SSYGV
-*
- END
diff --git a/netlib/LAPACK/ssygvd.f b/netlib/LAPACK/ssygvd.f
deleted file mode 100644
index d7f879d..0000000
--- a/netlib/LAPACK/ssygvd.f
+++ /dev/null
@@ -1,380 +0,0 @@
-*> \brief \b SSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYGVD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssygvd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssygvd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssygvd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
-* LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, UPLO
-* INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYGVD computes all the eigenvalues, and optionally, the eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
-*> B are assumed to be symmetric and B is also positive definite.
-*> If eigenvectors are desired, it uses a divide and conquer algorithm.
-*>
-*> The divide and conquer algorithm makes very mild assumptions about
-*> floating point arithmetic. It will work on machines with a guard
-*> digit in add/subtract, or on those binary machines without guard
-*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
-*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
-*> without guard digits, but we know of none.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangles of A and B are stored;
-*> = 'L': Lower triangles of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*>
-*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
-*> matrix Z of eigenvectors. The eigenvectors are normalized
-*> as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*> If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
-*> or the lower triangle (if UPLO='L') of A, including the
-*> diagonal, is destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, the symmetric matrix B. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of B contains the
-*> upper triangular part of the matrix B. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of B contains
-*> the lower triangular part of the matrix B.
-*>
-*> On exit, if INFO <= N, the part of B containing the matrix is
-*> overwritten by the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> If INFO = 0, the eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If N <= 1, LWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LWORK >= 2*N+1.
-*> If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal sizes of the WORK and IWORK
-*> arrays, returns these values as the first entries of the WORK
-*> and IWORK arrays, and no error message related to LWORK or
-*> LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If N <= 1, LIWORK >= 1.
-*> If JOBZ = 'N' and N > 1, LIWORK >= 1.
-*> If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal sizes of the WORK and
-*> IWORK arrays, returns these values as the first entries of
-*> the WORK and IWORK arrays, and no error message related to
-*> LWORK or LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: SPOTRF or SSYEVD returned an error code:
-*> <= N: if INFO = i and JOBZ = 'N', then the algorithm
-*> failed to converge; i off-diagonal elements of an
-*> intermediate tridiagonal form did not converge to
-*> zero;
-*> if INFO = i and JOBZ = 'V', then the algorithm
-*> failed to compute an eigenvalue while working on
-*> the submatrix lying in rows and columns INFO/(N+1)
-*> through mod(INFO,N+1);
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYeigen
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified so that no backsubstitution is performed if SSYEVD fails to
-*> converge (NEIG in old code could be greater than N causing out of
-*> bounds reference to A - reported by Ralf Meyer). Also corrected the
-*> description of INFO and the test on ITYPE. Sven, 16 Feb 05.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*>
-* =====================================================================
- SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
- $ LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, UPLO
- INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER, WANTZ
- CHARACTER TRANS
- INTEGER LIOPT, LIWMIN, LOPT, LWMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPOTRF, SSYEVD, SSYGST, STRMM, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- WANTZ = LSAME( JOBZ, 'V' )
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- INFO = 0
- IF( N.LE.1 ) THEN
- LIWMIN = 1
- LWMIN = 1
- ELSE IF( WANTZ ) THEN
- LIWMIN = 3 + 5*N
- LWMIN = 1 + 6*N + 2*N**2
- ELSE
- LIWMIN = 1
- LWMIN = 2*N + 1
- END IF
- LOPT = LWMIN
- LIOPT = LIWMIN
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -11
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYGVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form a Cholesky factorization of B.
-*
- CALL SPOTRF( UPLO, N, B, LDB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- CALL SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK,
- $ INFO )
- LOPT = MAX( REAL( LOPT ), REAL( WORK( 1 ) ) )
- LIOPT = MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) )
-*
- IF( WANTZ .AND. INFO.EQ.0 ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, N, ONE,
- $ B, LDB, A, LDA )
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, N, ONE,
- $ B, LDB, A, LDA )
- END IF
- END IF
-*
- WORK( 1 ) = LOPT
- IWORK( 1 ) = LIOPT
-*
- RETURN
-*
-* End of SSYGVD
-*
- END
diff --git a/netlib/LAPACK/ssygvx.f b/netlib/LAPACK/ssygvx.f
deleted file mode 100644
index db1c3fc..0000000
--- a/netlib/LAPACK/ssygvx.f
+++ /dev/null
@@ -1,458 +0,0 @@
-*> \brief \b SSYGST
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYGVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssygvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssygvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssygvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB,
-* VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
-* LWORK, IWORK, IFAIL, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBZ, RANGE, UPLO
-* INTEGER IL, INFO, ITYPE, IU, LDA, LDB, LDZ, LWORK, M, N
-* REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
-* INTEGER IFAIL( * ), IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYGVX computes selected eigenvalues, and optionally, eigenvectors
-*> of a real generalized symmetric-definite eigenproblem, of the form
-*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
-*> and B are assumed to be symmetric and B is also positive definite.
-*> Eigenvalues and eigenvectors can be selected by specifying either a
-*> range of values or a range of indices for the desired eigenvalues.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITYPE
-*> \verbatim
-*> ITYPE is INTEGER
-*> Specifies the problem type to be solved:
-*> = 1: A*x = (lambda)*B*x
-*> = 2: A*B*x = (lambda)*x
-*> = 3: B*A*x = (lambda)*x
-*> \endverbatim
-*>
-*> \param[in] JOBZ
-*> \verbatim
-*> JOBZ is CHARACTER*1
-*> = 'N': Compute eigenvalues only;
-*> = 'V': Compute eigenvalues and eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] RANGE
-*> \verbatim
-*> RANGE is CHARACTER*1
-*> = 'A': all eigenvalues will be found.
-*> = 'V': all eigenvalues in the half-open interval (VL,VU]
-*> will be found.
-*> = 'I': the IL-th through IU-th eigenvalues will be found.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A and B are stored;
-*> = 'L': Lower triangle of A and B are stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix pencil (A,B). N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of A contains the
-*> upper triangular part of the matrix A. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of A contains
-*> the lower triangular part of the matrix A.
-*>
-*> On exit, the lower triangle (if UPLO='L') or the upper
-*> triangle (if UPLO='U') of A, including the diagonal, is
-*> destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDA, N)
-*> On entry, the symmetric matrix B. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of B contains the
-*> upper triangular part of the matrix B. If UPLO = 'L',
-*> the leading N-by-N lower triangular part of B contains
-*> the lower triangular part of the matrix B.
-*>
-*> On exit, if INFO <= N, the part of B containing the matrix is
-*> overwritten by the triangular factor U or L from the Cholesky
-*> factorization B = U**T*U or B = L*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL
-*> \endverbatim
-*>
-*> \param[in] VU
-*> \verbatim
-*> VU is REAL
-*> If RANGE='V', the lower and upper bounds of the interval to
-*> be searched for eigenvalues. VL < VU.
-*> Not referenced if RANGE = 'A' or 'I'.
-*> \endverbatim
-*>
-*> \param[in] IL
-*> \verbatim
-*> IL is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IU
-*> \verbatim
-*> IU is INTEGER
-*> If RANGE='I', the indices (in ascending order) of the
-*> smallest and largest eigenvalues to be returned.
-*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
-*> Not referenced if RANGE = 'A' or 'V'.
-*> \endverbatim
-*>
-*> \param[in] ABSTOL
-*> \verbatim
-*> ABSTOL is REAL
-*> The absolute error tolerance for the eigenvalues.
-*> An approximate eigenvalue is accepted as converged
-*> when it is determined to lie in an interval [a,b]
-*> of width less than or equal to
-*>
-*> ABSTOL + EPS * max( |a|,|b| ) ,
-*>
-*> where EPS is the machine precision. If ABSTOL is less than
-*> or equal to zero, then EPS*|T| will be used in its place,
-*> where |T| is the 1-norm of the tridiagonal matrix obtained
-*> by reducing C to tridiagonal form, where C is the symmetric
-*> matrix of the standard symmetric problem to which the
-*> generalized problem is transformed.
-*>
-*> Eigenvalues will be computed most accurately when ABSTOL is
-*> set to twice the underflow threshold 2*DLAMCH('S'), not zero.
-*> If this routine returns with INFO>0, indicating that some
-*> eigenvectors did not converge, try setting ABSTOL to
-*> 2*SLAMCH('S').
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of eigenvalues found. 0 <= M <= N.
-*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
-*> \endverbatim
-*>
-*> \param[out] W
-*> \verbatim
-*> W is REAL array, dimension (N)
-*> On normal exit, the first M elements contain the selected
-*> eigenvalues in ascending order.
-*> \endverbatim
-*>
-*> \param[out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ, max(1,M))
-*> If JOBZ = 'N', then Z is not referenced.
-*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
-*> contain the orthonormal eigenvectors of the matrix A
-*> corresponding to the selected eigenvalues, with the i-th
-*> column of Z holding the eigenvector associated with W(i).
-*> The eigenvectors are normalized as follows:
-*> if ITYPE = 1 or 2, Z**T*B*Z = I;
-*> if ITYPE = 3, Z**T*inv(B)*Z = I.
-*>
-*> If an eigenvector fails to converge, then that column of Z
-*> contains the latest approximation to the eigenvector, and the
-*> index of the eigenvector is returned in IFAIL.
-*> Note: the user must ensure that at least max(1,M) columns are
-*> supplied in the array Z; if RANGE = 'V', the exact value of M
-*> is not known in advance and an upper bound must be used.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1, and if
-*> JOBZ = 'V', LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,8*N).
-*> For optimal efficiency, LWORK >= (NB+3)*N,
-*> where NB is the blocksize for SSYTRD returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (5*N)
-*> \endverbatim
-*>
-*> \param[out] IFAIL
-*> \verbatim
-*> IFAIL is INTEGER array, dimension (N)
-*> If JOBZ = 'V', then if INFO = 0, the first M elements of
-*> IFAIL are zero. If INFO > 0, then IFAIL contains the
-*> indices of the eigenvectors that failed to converge.
-*> If JOBZ = 'N', then IFAIL is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: SPOTRF or SSYEVX returned an error code:
-*> <= N: if INFO = i, SSYEVX failed to converge;
-*> i eigenvectors failed to converge. Their indices
-*> are stored in array IFAIL.
-*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
-*> minor of order i of B is not positive definite.
-*> The factorization of B could not be completed and
-*> no eigenvalues or eigenvectors were computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYeigen
-*
-*> \par Contributors:
-* ==================
-*>
-*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-* =====================================================================
- SUBROUTINE SSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB,
- $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
- $ LWORK, IWORK, IFAIL, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBZ, RANGE, UPLO
- INTEGER IL, INFO, ITYPE, IU, LDA, LDB, LDZ, LWORK, M, N
- REAL ABSTOL, VL, VU
-* ..
-* .. Array Arguments ..
- INTEGER IFAIL( * ), IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLEIG, INDEIG, LQUERY, UPPER, VALEIG, WANTZ
- CHARACTER TRANS
- INTEGER LWKMIN, LWKOPT, NB
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SPOTRF, SSYEVX, SSYGST, STRMM, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- UPPER = LSAME( UPLO, 'U' )
- WANTZ = LSAME( JOBZ, 'V' )
- ALLEIG = LSAME( RANGE, 'A' )
- VALEIG = LSAME( RANGE, 'V' )
- INDEIG = LSAME( RANGE, 'I' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- INFO = 0
- IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
- INFO = -1
- ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
- INFO = -3
- ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE
- IF( VALEIG ) THEN
- IF( N.GT.0 .AND. VU.LE.VL )
- $ INFO = -11
- ELSE IF( INDEIG ) THEN
- IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
- INFO = -13
- END IF
- END IF
- END IF
- IF (INFO.EQ.0) THEN
- IF (LDZ.LT.1 .OR. (WANTZ .AND. LDZ.LT.N)) THEN
- INFO = -18
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- LWKMIN = MAX( 1, 8*N )
- NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYGVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = 0
- IF( N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Form a Cholesky factorization of B.
-*
- CALL SPOTRF( UPLO, N, B, LDB, INFO )
- IF( INFO.NE.0 ) THEN
- INFO = N + INFO
- RETURN
- END IF
-*
-* Transform problem to standard eigenvalue problem and solve.
-*
- CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
- CALL SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL,
- $ M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
-*
- IF( WANTZ ) THEN
-*
-* Backtransform eigenvectors to the original problem.
-*
- IF( INFO.GT.0 )
- $ M = INFO - 1
- IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
-*
-* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
-* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
-*
- IF( UPPER ) THEN
- TRANS = 'N'
- ELSE
- TRANS = 'T'
- END IF
-*
- CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B,
- $ LDB, Z, LDZ )
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* For B*A*x=(lambda)*x;
-* backtransform eigenvectors: x = L*y or U**T*y
-*
- IF( UPPER ) THEN
- TRANS = 'T'
- ELSE
- TRANS = 'N'
- END IF
-*
- CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B,
- $ LDB, Z, LDZ )
- END IF
- END IF
-*
-* Set WORK(1) to optimal workspace size.
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SSYGVX
-*
- END
diff --git a/netlib/LAPACK/ssyrfs.f b/netlib/LAPACK/ssyrfs.f
deleted file mode 100644
index a7da716..0000000
--- a/netlib/LAPACK/ssyrfs.f
+++ /dev/null
@@ -1,441 +0,0 @@
-*> \brief \b SSYRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
-* X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYRFS improves the computed solution to a system of linear
-*> equations when the coefficient matrix is symmetric indefinite, and
-*> provides error bounds and backward error estimates for the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> The factored form of the matrix A. AF contains the block
-*> diagonal matrix D and the multipliers used to obtain the
-*> factor U or L from the factorization A = U*D*U**T or
-*> A = L*D*L**T as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by SSYTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
- $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
- REAL TWO
- PARAMETER ( TWO = 2.0E+0 )
- REAL THREE
- PARAMETER ( THREE = 3.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER COUNT, I, J, K, KASE, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, SSYMV, SSYTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - A * X
-*
- CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL SSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- DO 50 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- DO 40 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 40 CONTINUE
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK + S
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- XK = ABS( X( K, J ) )
- WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK
- DO 60 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(A))*
-* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(A) is the inverse of A
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(A)*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(A) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(A**T).
-*
- CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE IF( KASE.EQ.2 ) THEN
-*
-* Multiply by inv(A)*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of SSYRFS
-*
- END
diff --git a/netlib/LAPACK/ssysv.f b/netlib/LAPACK/ssysv.f
deleted file mode 100644
index 07eb1e2..0000000
--- a/netlib/LAPACK/ssysv.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief <b> SSYSV computes the solution to system of linear equations A * X = B for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYSV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssysv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssysv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssysv.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-* LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, LWORK, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYSV computes the solution to a real system of linear equations
-*> A * X = B,
-*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
-*> matrices.
-*>
-*> The diagonal pivoting method is used to factor A as
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
-*> used to solve the system of equations A * X = B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, if INFO = 0, the block diagonal matrix D and the
-*> multipliers used to obtain the factor U or L from the
-*> factorization A = U*D*U**T or A = L*D*L**T as computed by
-*> SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D, as
-*> determined by SSYTRF. If IPIV(k) > 0, then rows and columns
-*> k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
-*> diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
-*> then rows and columns k-1 and -IPIV(k) were interchanged and
-*> D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
-*> IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
-*> -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
-*> diagonal block.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of WORK. LWORK >= 1, and for best performance
-*> LWORK >= max(1,N*NB), where NB is the optimal blocksize for
-*> SSYTRF.
-*> for LWORK < N, TRS will be done with Level BLAS 2
-*> for LWORK >= N, TRS will be done with Level BLAS 3
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, so the solution could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYsolve
-*
-* =====================================================================
- SUBROUTINE SSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
- $ LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, LWORK, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER LWKOPT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SSYTRF, SSYTRS, SSYTRS2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- LWKOPT = 1
- ELSE
- CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
- LWKOPT = WORK(1)
- END IF
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYSV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- IF ( LWORK.LT.N ) THEN
-*
-* Solve with TRS ( Use Level BLAS 2)
-*
- CALL SSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
- ELSE
-*
-* Solve with TRS2 ( Use Level BLAS 3)
-*
- CALL SSYTRS2( UPLO,N,NRHS,A,LDA,IPIV,B,LDB,WORK,INFO )
-*
- END IF
-*
- END IF
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SSYSV
-*
- END
diff --git a/netlib/LAPACK/ssysvx.f b/netlib/LAPACK/ssysvx.f
deleted file mode 100644
index 00e1649..0000000
--- a/netlib/LAPACK/ssysvx.f
+++ /dev/null
@@ -1,416 +0,0 @@
-*> \brief <b> SSYSVX computes the solution to system of linear equations A * X = B for SY matrices</b>
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYSVX + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssysvx.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssysvx.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssysvx.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
-* LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, UPLO
-* INTEGER INFO, LDA, LDAF, LDB, LDX, LWORK, N, NRHS
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYSVX uses the diagonal pivoting factorization to compute the
-*> solution to a real system of linear equations A * X = B,
-*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
-*> matrices.
-*>
-*> Error bounds on the solution and a condition estimate are also
-*> provided.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the diagonal pivoting method is used to factor A.
-*> The form of the factorization is
-*> A = U * D * U**T, if UPLO = 'U', or
-*> A = L * D * L**T, if UPLO = 'L',
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> 2. If some D(i,i)=0, so that D is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': On entry, AF and IPIV contain the factored form of
-*> A. AF and IPIV will not be modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of A contains the upper triangular part
-*> of the matrix A, and the strictly lower triangular part of A
-*> is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of A contains the lower triangular part of
-*> the matrix A, and the strictly upper triangular part of A is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is REAL array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T as computed by SSYTRF.
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L from the factorization
-*> A = U*D*U**T or A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains details of the interchanges and the block structure
-*> of D, as determined by SSYTRF.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains details of the interchanges and the block structure
-*> of D, as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of WORK. LWORK >= max(1,3*N), and for best
-*> performance, when FACT = 'N', LWORK >= max(1,3*N,N*NB), where
-*> NB is the optimal blocksize for SSYTRF.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: D(i,i) is exactly zero. The factorization
-*> has been completed but the factor D is exactly
-*> singular, so the solution and error bounds could
-*> not be computed. RCOND = 0 is returned.
-*> = N+1: D is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realSYsolve
-*
-* =====================================================================
- SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
- $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK,
- $ IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, UPLO
- INTEGER INFO, LDA, LDAF, LDB, LDX, LWORK, N, NRHS
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, NOFACT
- INTEGER LWKOPT, NB
- REAL ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- REAL SLAMCH, SLANSY
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACPY, SSYCON, SSYRFS, SSYTRF, SSYTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
- $ THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -11
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN
- INFO = -18
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- LWKOPT = MAX( 1, 3*N )
- IF( NOFACT ) THEN
- NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
- LWKOPT = MAX( LWKOPT, N*NB )
- END IF
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYSVX', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the factorization A = U*D*U**T or A = L*D*L**T.
-*
- CALL SLACPY( UPLO, N, N, A, LDA, AF, LDAF )
- CALL SSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, LWORK, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- ANORM = SLANSY( 'I', UPLO, N, A, LDA, WORK )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL SSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* Compute the solution vectors X.
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL SSYTRS( UPLO, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of SSYSVX
-*
- END
diff --git a/netlib/LAPACK/ssyswapr.f b/netlib/LAPACK/ssyswapr.f
deleted file mode 100644
index 1900751..0000000
--- a/netlib/LAPACK/ssyswapr.f
+++ /dev/null
@@ -1,193 +0,0 @@
-*> \brief \b SSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYSWAPR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyswapr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyswapr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyswapr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER I1, I2, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, N )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYSWAPR applies an elementary permutation on the rows and the columns of
-*> a symmetric matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the NB diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by SSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] I1
-*> \verbatim
-*> I1 is INTEGER
-*> Index of the first row to swap
-*> \endverbatim
-*>
-*> \param[in] I2
-*> \verbatim
-*> I2 is INTEGER
-*> Index of the second row to swap
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYauxiliary
-*
-* =====================================================================
- SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER I1, I2, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, N )
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
- REAL TMP
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSWAP
-* ..
-* .. Executable Statements ..
-*
- UPPER = LSAME( UPLO, 'U' )
- IF (UPPER) THEN
-*
-* UPPER
-* first swap
-* - swap column I1 and I2 from I1 to I1-1
- CALL SSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
-*
-* second swap :
-* - swap A(I1,I1) and A(I2,I2)
-* - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
- TMP=A(I1,I1)
- A(I1,I1)=A(I2,I2)
- A(I2,I2)=TMP
-*
- DO I=1,I2-I1-1
- TMP=A(I1,I1+I)
- A(I1,I1+I)=A(I1+I,I2)
- A(I1+I,I2)=TMP
- END DO
-*
-* third swap
-* - swap row I1 and I2 from I2+1 to N
- DO I=I2+1,N
- TMP=A(I1,I)
- A(I1,I)=A(I2,I)
- A(I2,I)=TMP
- END DO
-*
- ELSE
-*
-* LOWER
-* first swap
-* - swap row I1 and I2 from I1 to I1-1
- CALL SSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
-*
-* second swap :
-* - swap A(I1,I1) and A(I2,I2)
-* - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
- TMP=A(I1,I1)
- A(I1,I1)=A(I2,I2)
- A(I2,I2)=TMP
-*
- DO I=1,I2-I1-1
- TMP=A(I1+I,I1)
- A(I1+I,I1)=A(I2,I1+I)
- A(I2,I1+I)=TMP
- END DO
-*
-* third swap
-* - swap col I1 and I2 from I2+1 to N
- DO I=I2+1,N
- TMP=A(I,I1)
- A(I,I1)=A(I,I2)
- A(I,I2)=TMP
- END DO
-*
- ENDIF
- END SUBROUTINE SSYSWAPR
-
diff --git a/netlib/LAPACK/ssytd2.f b/netlib/LAPACK/ssytd2.f
deleted file mode 100644
index e5e3c20..0000000
--- a/netlib/LAPACK/ssytd2.f
+++ /dev/null
@@ -1,322 +0,0 @@
-*> \brief \b SSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity transformation (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTD2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytd2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytd2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytd2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( * ), E( * ), TAU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
-*> form T by an orthogonal similarity transformation: Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
-*> of A are overwritten by the corresponding elements of the
-*> tridiagonal matrix T, and the elements above the first
-*> superdiagonal, with the array TAU, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; if UPLO
-*> = 'L', the diagonal and first subdiagonal of A are over-
-*> written by the corresponding elements of the tridiagonal
-*> matrix T, and the elements below the first subdiagonal, with
-*> the array TAU, represent the orthogonal matrix Q as a product
-*> of elementary reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n-1) . . . H(2) H(1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*> A(1:i-1,i+1), and tau in TAU(i).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(n-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
-*> and tau in TAU(i).
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with n = 5:
-*>
-*> if UPLO = 'U': if UPLO = 'L':
-*>
-*> ( d e v2 v3 v4 ) ( d )
-*> ( d e v3 v4 ) ( e d )
-*> ( d e v4 ) ( v1 e d )
-*> ( d e ) ( v1 v2 e d )
-*> ( d ) ( v1 v2 v3 e d )
-*>
-*> where d and e denote diagonal and off-diagonal elements of T, and vi
-*> denotes an element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( * ), E( * ), TAU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO, HALF
- PARAMETER ( ONE = 1.0, ZERO = 0.0, HALF = 1.0 / 2.0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I
- REAL ALPHA, TAUI
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SLARFG, SSYMV, SSYR2, XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTD2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Reduce the upper triangle of A
-*
- DO 10 I = N - 1, 1, -1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(1:i-1,i+1)
-*
- CALL SLARFG( I, A( I, I+1 ), A( 1, I+1 ), 1, TAUI )
- E( I ) = A( I, I+1 )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(1:i,1:i)
-*
- A( I, I+1 ) = ONE
-*
-* Compute x := tau * A * v storing x in TAU(1:i)
-*
- CALL SSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO,
- $ TAU, 1 )
-*
-* Compute w := x - 1/2 * tau * (x**T * v) * v
-*
- ALPHA = -HALF*TAUI*SDOT( I, TAU, 1, A( 1, I+1 ), 1 )
- CALL SAXPY( I, ALPHA, A( 1, I+1 ), 1, TAU, 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL SSYR2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A,
- $ LDA )
-*
- A( I, I+1 ) = E( I )
- END IF
- D( I+1 ) = A( I+1, I+1 )
- TAU( I ) = TAUI
- 10 CONTINUE
- D( 1 ) = A( 1, 1 )
- ELSE
-*
-* Reduce the lower triangle of A
-*
- DO 20 I = 1, N - 1
-*
-* Generate elementary reflector H(i) = I - tau * v * v**T
-* to annihilate A(i+2:n,i)
-*
- CALL SLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAUI )
- E( I ) = A( I+1, I )
-*
- IF( TAUI.NE.ZERO ) THEN
-*
-* Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
- A( I+1, I ) = ONE
-*
-* Compute x := tau * A * v storing y in TAU(i:n-1)
-*
- CALL SSYMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA,
- $ A( I+1, I ), 1, ZERO, TAU( I ), 1 )
-*
-* Compute w := x - 1/2 * tau * (x**T * v) * v
-*
- ALPHA = -HALF*TAUI*SDOT( N-I, TAU( I ), 1, A( I+1, I ),
- $ 1 )
- CALL SAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 )
-*
-* Apply the transformation as a rank-2 update:
-* A := A - v * w**T - w * v**T
-*
- CALL SSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1,
- $ A( I+1, I+1 ), LDA )
-*
- A( I+1, I ) = E( I )
- END IF
- D( I ) = A( I, I )
- TAU( I ) = TAUI
- 20 CONTINUE
- D( N ) = A( N, N )
- END IF
-*
- RETURN
-*
-* End of SSYTD2
-*
- END
diff --git a/netlib/LAPACK/ssytf2.f b/netlib/LAPACK/ssytf2.f
deleted file mode 100644
index 68e4dee..0000000
--- a/netlib/LAPACK/ssytf2.f
+++ /dev/null
@@ -1,598 +0,0 @@
-*> \brief \b SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTF2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytf2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytf2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytf2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTF2( UPLO, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTF2 computes the factorization of a real symmetric matrix A using
-*> the Bunch-Kaufman diagonal pivoting method:
-*>
-*> A = U*D*U**T or A = L*D*L**T
-*>
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, U**T is the transpose of U, and D is symmetric and
-*> block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the upper or lower triangular part of the
-*> symmetric matrix A is stored:
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> n-by-n upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n-by-n lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L (see below for further details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, D(k,k) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', then A = U*D*U**T, where
-*> U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*> i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I v 0 ) k-s
-*> U(k) = ( 0 I 0 ) s
-*> ( 0 0 I ) n-k
-*> k-s s n-k
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*> If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*> and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*>
-*> If UPLO = 'L', then A = L*D*L**T, where
-*> L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*> i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*> n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I 0 0 ) k-1
-*> L(k) = ( 0 I 0 ) s
-*> ( 0 v I ) n-k-s+1
-*> k-1 s n-k-s+1
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*> If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*> and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> \verbatim
-*>
-*> 09-29-06 - patch from
-*> Bobby Cheng, MathWorks
-*>
-*> Replace l.204 and l.372
-*> IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*> by
-*> IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN
-*>
-*> 01-01-96 - Based on modifications by
-*> J. Lewis, Boeing Computer Services Company
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> 1-96 - Based on modifications by J. Lewis, Boeing Computer Services
-*> Company
-*>
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE SSYTF2( UPLO, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL EIGHT, SEVTEN
- PARAMETER ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IMAX, J, JMAX, K, KK, KP, KSTEP
- REAL ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
- $ ROWMAX, T, WK, WKM1, WKP1
-* ..
-* .. External Functions ..
- LOGICAL LSAME, SISNAN
- INTEGER ISAMAX
- EXTERNAL LSAME, ISAMAX, SISNAN
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSWAP, SSYR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTF2', -INFO )
- RETURN
- END IF
-*
-* Initialize ALPHA for use in choosing pivot block size.
-*
- ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
- IF( UPPER ) THEN
-*
-* Factorize A as U*D*U**T using the upper triangle of A
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2
-*
- K = N
- 10 CONTINUE
-*
-* If K < 1, exit from loop
-*
- IF( K.LT.1 )
- $ GO TO 70
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( A( K, K ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.GT.1 ) THEN
- IMAX = ISAMAX( K-1, A( 1, K ), 1 )
- COLMAX = ABS( A( IMAX, K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN
-*
-* Column K is zero or contains a NaN: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = IMAX + ISAMAX( K-IMAX, A( IMAX, IMAX+1 ), LDA )
- ROWMAX = ABS( A( IMAX, JMAX ) )
- IF( IMAX.GT.1 ) THEN
- JMAX = ISAMAX( IMAX-1, A( 1, IMAX ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K-1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K - KSTEP + 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the leading
-* submatrix A(1:k,1:k)
-*
- CALL SSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
- CALL SSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ),
- $ LDA )
- T = A( KK, KK )
- A( KK, KK ) = A( KP, KP )
- A( KP, KP ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = A( K-1, K )
- A( K-1, K ) = A( KP, K )
- A( KP, K ) = T
- END IF
- END IF
-*
-* Update the leading submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = U(k)*D(k)
-*
-* where U(k) is the k-th column of U
-*
-* Perform a rank-1 update of A(1:k-1,1:k-1) as
-*
-* A := A - U(k)*D(k)*U(k)**T = A - W(k)*1/D(k)*W(k)**T
-*
- R1 = ONE / A( K, K )
- CALL SSYR( UPLO, K-1, -R1, A( 1, K ), 1, A, LDA )
-*
-* Store U(k) in column k
-*
- CALL SSCAL( K-1, R1, A( 1, K ), 1 )
- ELSE
-*
-* 2-by-2 pivot block D(k): columns k and k-1 now hold
-*
-* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
-*
-* where U(k) and U(k-1) are the k-th and (k-1)-th columns
-* of U
-*
-* Perform a rank-2 update of A(1:k-2,1:k-2) as
-*
-* A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
-* = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )**T
-*
- IF( K.GT.2 ) THEN
-*
- D12 = A( K-1, K )
- D22 = A( K-1, K-1 ) / D12
- D11 = A( K, K ) / D12
- T = ONE / ( D11*D22-ONE )
- D12 = T / D12
-*
- DO 30 J = K - 2, 1, -1
- WKM1 = D12*( D11*A( J, K-1 )-A( J, K ) )
- WK = D12*( D22*A( J, K )-A( J, K-1 ) )
- DO 20 I = J, 1, -1
- A( I, J ) = A( I, J ) - A( I, K )*WK -
- $ A( I, K-1 )*WKM1
- 20 CONTINUE
- A( J, K ) = WK
- A( J, K-1 ) = WKM1
- 30 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K-1 ) = -KP
- END IF
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KSTEP
- GO TO 10
-*
- ELSE
-*
-* Factorize A as L*D*L**T using the lower triangle of A
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2
-*
- K = 1
- 40 CONTINUE
-*
-* If K > N, exit from loop
-*
- IF( K.GT.N )
- $ GO TO 70
- KSTEP = 1
-*
-* Determine rows and columns to be interchanged and whether
-* a 1-by-1 or 2-by-2 pivot block will be used
-*
- ABSAKK = ABS( A( K, K ) )
-*
-* IMAX is the row-index of the largest off-diagonal element in
-* column K, and COLMAX is its absolute value
-*
- IF( K.LT.N ) THEN
- IMAX = K + ISAMAX( N-K, A( K+1, K ), 1 )
- COLMAX = ABS( A( IMAX, K ) )
- ELSE
- COLMAX = ZERO
- END IF
-*
- IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN
-*
-* Column K is zero or contains a NaN: set INFO and continue
-*
- IF( INFO.EQ.0 )
- $ INFO = K
- KP = K
- ELSE
- IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE
-*
-* JMAX is the column-index of the largest off-diagonal
-* element in row IMAX, and ROWMAX is its absolute value
-*
- JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), LDA )
- ROWMAX = ABS( A( IMAX, JMAX ) )
- IF( IMAX.LT.N ) THEN
- JMAX = IMAX + ISAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 )
- ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) )
- END IF
-*
- IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-* no interchange, use 1-by-1 pivot block
-*
- KP = K
- ELSE IF( ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
-*
-* interchange rows and columns K and IMAX, use 1-by-1
-* pivot block
-*
- KP = IMAX
- ELSE
-*
-* interchange rows and columns K+1 and IMAX, use 2-by-2
-* pivot block
-*
- KP = IMAX
- KSTEP = 2
- END IF
- END IF
-*
- KK = K + KSTEP - 1
- IF( KP.NE.KK ) THEN
-*
-* Interchange rows and columns KK and KP in the trailing
-* submatrix A(k:n,k:n)
-*
- IF( KP.LT.N )
- $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
- CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
- $ LDA )
- T = A( KK, KK )
- A( KK, KK ) = A( KP, KP )
- A( KP, KP ) = T
- IF( KSTEP.EQ.2 ) THEN
- T = A( K+1, K )
- A( K+1, K ) = A( KP, K )
- A( KP, K ) = T
- END IF
- END IF
-*
-* Update the trailing submatrix
-*
- IF( KSTEP.EQ.1 ) THEN
-*
-* 1-by-1 pivot block D(k): column k now holds
-*
-* W(k) = L(k)*D(k)
-*
-* where L(k) is the k-th column of L
-*
- IF( K.LT.N ) THEN
-*
-* Perform a rank-1 update of A(k+1:n,k+1:n) as
-*
-* A := A - L(k)*D(k)*L(k)**T = A - W(k)*(1/D(k))*W(k)**T
-*
- D11 = ONE / A( K, K )
- CALL SSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
- $ A( K+1, K+1 ), LDA )
-*
-* Store L(k) in column K
-*
- CALL SSCAL( N-K, D11, A( K+1, K ), 1 )
- END IF
- ELSE
-*
-* 2-by-2 pivot block D(k)
-*
- IF( K.LT.N-1 ) THEN
-*
-* Perform a rank-2 update of A(k+2:n,k+2:n) as
-*
-* A := A - ( (A(k) A(k+1))*D(k)**(-1) ) * (A(k) A(k+1))**T
-*
-* where L(k) and L(k+1) are the k-th and (k+1)-th
-* columns of L
-*
- D21 = A( K+1, K )
- D11 = A( K+1, K+1 ) / D21
- D22 = A( K, K ) / D21
- T = ONE / ( D11*D22-ONE )
- D21 = T / D21
-*
- DO 60 J = K + 2, N
-*
- WK = D21*( D11*A( J, K )-A( J, K+1 ) )
- WKP1 = D21*( D22*A( J, K+1 )-A( J, K ) )
-*
- DO 50 I = J, N
- A( I, J ) = A( I, J ) - A( I, K )*WK -
- $ A( I, K+1 )*WKP1
- 50 CONTINUE
-*
- A( J, K ) = WK
- A( J, K+1 ) = WKP1
-*
- 60 CONTINUE
- END IF
- END IF
- END IF
-*
-* Store details of the interchanges in IPIV
-*
- IF( KSTEP.EQ.1 ) THEN
- IPIV( K ) = KP
- ELSE
- IPIV( K ) = -KP
- IPIV( K+1 ) = -KP
- END IF
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KSTEP
- GO TO 40
-*
- END IF
-*
- 70 CONTINUE
-*
- RETURN
-*
-* End of SSYTF2
-*
- END
diff --git a/netlib/LAPACK/ssytrd.f b/netlib/LAPACK/ssytrd.f
deleted file mode 100644
index 765374b..0000000
--- a/netlib/LAPACK/ssytrd.f
+++ /dev/null
@@ -1,376 +0,0 @@
-*> \brief \b SSYTRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRD + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrd.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrd.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrd.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), D( * ), E( * ), TAU( * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRD reduces a real symmetric matrix A to real symmetric
-*> tridiagonal form T by an orthogonal similarity transformation:
-*> Q**T * A * Q = T.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
-*> of A are overwritten by the corresponding elements of the
-*> tridiagonal matrix T, and the elements above the first
-*> superdiagonal, with the array TAU, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; if UPLO
-*> = 'L', the diagonal and first subdiagonal of A are over-
-*> written by the corresponding elements of the tridiagonal
-*> matrix T, and the elements below the first subdiagonal, with
-*> the array TAU, represent the orthogonal matrix Q as a product
-*> of elementary reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is REAL array, dimension (N)
-*> The diagonal elements of the tridiagonal matrix T:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is REAL array, dimension (N-1)
-*> The off-diagonal elements of the tridiagonal matrix T:
-*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 1.
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(n-1) . . . H(2) H(1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*> A(1:i-1,i+1), and tau in TAU(i).
-*>
-*> If UPLO = 'L', the matrix Q is represented as a product of elementary
-*> reflectors
-*>
-*> Q = H(1) H(2) . . . H(n-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
-*> and tau in TAU(i).
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with n = 5:
-*>
-*> if UPLO = 'U': if UPLO = 'L':
-*>
-*> ( d e v2 v3 v4 ) ( d )
-*> ( d e v3 v4 ) ( e d )
-*> ( d e v4 ) ( v1 e d )
-*> ( d e ) ( v1 v2 e d )
-*> ( d ) ( v1 v2 v3 e d )
-*>
-*> where d and e denote diagonal and off-diagonal elements of T, and vi
-*> denotes an element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), D( * ), E( * ), TAU( * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER
- INTEGER I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL SLATRD, SSYR2K, SSYTD2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size.
-*
- NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NX = N
- IWS = 1
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
-*
-* Determine when to cross over from blocked to unblocked code
-* (last block is always handled by unblocked code).
-*
- NX = MAX( NB, ILAENV( 3, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
- IF( NX.LT.N ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: determine the
-* minimum value of NB, and reduce NB or force use of
-* unblocked code by setting NX = N.
-*
- NB = MAX( LWORK / LDWORK, 1 )
- NBMIN = ILAENV( 2, 'SSYTRD', UPLO, N, -1, -1, -1 )
- IF( NB.LT.NBMIN )
- $ NX = N
- END IF
- ELSE
- NX = N
- END IF
- ELSE
- NB = 1
- END IF
-*
- IF( UPPER ) THEN
-*
-* Reduce the upper triangle of A.
-* Columns 1:kk are handled by the unblocked method.
-*
- KK = N - ( ( N-NX+NB-1 ) / NB )*NB
- DO 20 I = N - NB + 1, KK + 1, -NB
-*
-* Reduce columns i:i+nb-1 to tridiagonal form and form the
-* matrix W which is needed to update the unreduced part of
-* the matrix
-*
- CALL SLATRD( UPLO, I+NB-1, NB, A, LDA, E, TAU, WORK,
- $ LDWORK )
-*
-* Update the unreduced submatrix A(1:i-1,1:i-1), using an
-* update of the form: A := A - V*W**T - W*V**T
-*
- CALL SSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, I ),
- $ LDA, WORK, LDWORK, ONE, A, LDA )
-*
-* Copy superdiagonal elements back into A, and diagonal
-* elements into D
-*
- DO 10 J = I, I + NB - 1
- A( J-1, J ) = E( J-1 )
- D( J ) = A( J, J )
- 10 CONTINUE
- 20 CONTINUE
-*
-* Use unblocked code to reduce the last or only block
-*
- CALL SSYTD2( UPLO, KK, A, LDA, D, E, TAU, IINFO )
- ELSE
-*
-* Reduce the lower triangle of A
-*
- DO 40 I = 1, N - NX, NB
-*
-* Reduce columns i:i+nb-1 to tridiagonal form and form the
-* matrix W which is needed to update the unreduced part of
-* the matrix
-*
- CALL SLATRD( UPLO, N-I+1, NB, A( I, I ), LDA, E( I ),
- $ TAU( I ), WORK, LDWORK )
-*
-* Update the unreduced submatrix A(i+ib:n,i+ib:n), using
-* an update of the form: A := A - V*W**T - W*V**T
-*
- CALL SSYR2K( UPLO, 'No transpose', N-I-NB+1, NB, -ONE,
- $ A( I+NB, I ), LDA, WORK( NB+1 ), LDWORK, ONE,
- $ A( I+NB, I+NB ), LDA )
-*
-* Copy subdiagonal elements back into A, and diagonal
-* elements into D
-*
- DO 30 J = I, I + NB - 1
- A( J+1, J ) = E( J )
- D( J ) = A( J, J )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Use unblocked code to reduce the last or only block
-*
- CALL SSYTD2( UPLO, N-I+1, A( I, I ), LDA, D( I ), E( I ),
- $ TAU( I ), IINFO )
- END IF
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SSYTRD
-*
- END
diff --git a/netlib/LAPACK/ssytrf.f b/netlib/LAPACK/ssytrf.f
deleted file mode 100644
index 9869331..0000000
--- a/netlib/LAPACK/ssytrf.f
+++ /dev/null
@@ -1,363 +0,0 @@
-*> \brief \b SSYTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRF computes the factorization of a real symmetric matrix A using
-*> the Bunch-Kaufman diagonal pivoting method. The form of the
-*> factorization is
-*>
-*> A = U*D*U**T or A = L*D*L**T
-*>
-*> where U (or L) is a product of permutation and unit upper (lower)
-*> triangular matrices, and D is symmetric and block diagonal with
-*> 1-by-1 and 2-by-2 diagonal blocks.
-*>
-*> This is the blocked version of the algorithm, calling Level 3 BLAS.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*>
-*> On exit, the block diagonal matrix D and the multipliers used
-*> to obtain the factor U or L (see below for further details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D.
-*> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*> interchanged and D(k,k) is a 1-by-1 diagonal block.
-*> If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*> columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*> is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
-*> IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*> interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of WORK. LWORK >=1. For best performance
-*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> If UPLO = 'U', then A = U*D*U**T, where
-*> U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*> i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I v 0 ) k-s
-*> U(k) = ( 0 I 0 ) s
-*> ( 0 0 I ) n-k
-*> k-s s n-k
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*> If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*> and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*>
-*> If UPLO = 'L', then A = L*D*L**T, where
-*> L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*> i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*> n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*> and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
-*> defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*> that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*>
-*> ( I 0 0 ) k-1
-*> L(k) = ( 0 I 0 ) s
-*> ( 0 v I ) n-k-s+1
-*> k-1 s n-k-s+1
-*>
-*> If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*> If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*> and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY, UPPER
- INTEGER IINFO, IWS, J, K, KB, LDWORK, LWKOPT, NB, NBMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASYF, SSYTF2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size
-*
- NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = N
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
- NB = MAX( LWORK / LDWORK, 1 )
- NBMIN = MAX( 2, ILAENV( 2, 'SSYTRF', UPLO, N, -1, -1, -1 ) )
- END IF
- ELSE
- IWS = 1
- END IF
- IF( NB.LT.NBMIN )
- $ NB = N
-*
- IF( UPPER ) THEN
-*
-* Factorize A as U*D*U**T using the upper triangle of A
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* KB, where KB is the number of columns factorized by SLASYF;
-* KB is either NB or NB-1, or K for the last block
-*
- K = N
- 10 CONTINUE
-*
-* If K < 1, exit from loop
-*
- IF( K.LT.1 )
- $ GO TO 40
-*
- IF( K.GT.NB ) THEN
-*
-* Factorize columns k-kb+1:k of A and use blocked code to
-* update columns 1:k-kb
-*
- CALL SLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, LDWORK,
- $ IINFO )
- ELSE
-*
-* Use unblocked code to factorize columns 1:k of A
-*
- CALL SSYTF2( UPLO, K, A, LDA, IPIV, IINFO )
- KB = K
- END IF
-*
-* Set INFO on the first occurrence of a zero pivot
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO
-*
-* Decrease K and return to the start of the main loop
-*
- K = K - KB
- GO TO 10
-*
- ELSE
-*
-* Factorize A as L*D*L**T using the lower triangle of A
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* KB, where KB is the number of columns factorized by SLASYF;
-* KB is either NB or NB-1, or N-K+1 for the last block
-*
- K = 1
- 20 CONTINUE
-*
-* If K > N, exit from loop
-*
- IF( K.GT.N )
- $ GO TO 40
-*
- IF( K.LE.N-NB ) THEN
-*
-* Factorize columns k:k+kb-1 of A and use blocked code to
-* update columns k+kb:n
-*
- CALL SLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ),
- $ WORK, LDWORK, IINFO )
- ELSE
-*
-* Use unblocked code to factorize columns k:n of A
-*
- CALL SSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO )
- KB = N - K + 1
- END IF
-*
-* Set INFO on the first occurrence of a zero pivot
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + K - 1
-*
-* Adjust IPIV
-*
- DO 30 J = K, K + KB - 1
- IF( IPIV( J ).GT.0 ) THEN
- IPIV( J ) = IPIV( J ) + K - 1
- ELSE
- IPIV( J ) = IPIV( J ) - K + 1
- END IF
- 30 CONTINUE
-*
-* Increase K and return to the start of the main loop
-*
- K = K + KB
- GO TO 20
-*
- END IF
-*
- 40 CONTINUE
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of SSYTRF
-*
- END
diff --git a/netlib/LAPACK/ssytri.f b/netlib/LAPACK/ssytri.f
deleted file mode 100644
index 0e47244..0000000
--- a/netlib/LAPACK/ssytri.f
+++ /dev/null
@@ -1,382 +0,0 @@
-*> \brief \b SSYTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRI computes the inverse of a real symmetric indefinite matrix
-*> A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*> SSYTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the block diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by SSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER K, KP, KSTEP
- REAL AK, AKKP1, AKP1, D, T, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT
- EXTERNAL LSAME, SDOT
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SSWAP, SSYMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- DO 10 INFO = N, 1, -1
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- DO 20 INFO = 1, N
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 20 CONTINUE
- END IF
- INFO = 0
-*
- IF( UPPER ) THEN
-*
-* Compute inv(A) from the factorization A = U*D*U**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- 30 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 40
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- A( K, K ) = ONE / A( K, K )
-*
-* Compute column K of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL SCOPY( K-1, A( 1, K ), 1, WORK, 1 )
- CALL SSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
- $ A( 1, K ), 1 )
- A( K, K ) = A( K, K ) - SDOT( K-1, WORK, 1, A( 1, K ),
- $ 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( A( K, K+1 ) )
- AK = A( K, K ) / T
- AKP1 = A( K+1, K+1 ) / T
- AKKP1 = A( K, K+1 ) / T
- D = T*( AK*AKP1-ONE )
- A( K, K ) = AKP1 / D
- A( K+1, K+1 ) = AK / D
- A( K, K+1 ) = -AKKP1 / D
-*
-* Compute columns K and K+1 of the inverse.
-*
- IF( K.GT.1 ) THEN
- CALL SCOPY( K-1, A( 1, K ), 1, WORK, 1 )
- CALL SSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
- $ A( 1, K ), 1 )
- A( K, K ) = A( K, K ) - SDOT( K-1, WORK, 1, A( 1, K ),
- $ 1 )
- A( K, K+1 ) = A( K, K+1 ) -
- $ SDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 )
- CALL SCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 )
- CALL SSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
- $ A( 1, K+1 ), 1 )
- A( K+1, K+1 ) = A( K+1, K+1 ) -
- $ SDOT( K-1, WORK, 1, A( 1, K+1 ), 1 )
- END IF
- KSTEP = 2
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the leading
-* submatrix A(1:k+1,1:k+1)
-*
- CALL SSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 )
- CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA )
- TEMP = A( K, K )
- A( K, K ) = A( KP, KP )
- A( KP, KP ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = A( K, K+1 )
- A( K, K+1 ) = A( KP, K+1 )
- A( KP, K+1 ) = TEMP
- END IF
- END IF
-*
- K = K + KSTEP
- GO TO 30
- 40 CONTINUE
-*
- ELSE
-*
-* Compute inv(A) from the factorization A = L*D*L**T.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- 50 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 60
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Invert the diagonal block.
-*
- A( K, K ) = ONE / A( K, K )
-*
-* Compute column K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL SCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
- CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
- $ ZERO, A( K+1, K ), 1 )
- A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, K ),
- $ 1 )
- END IF
- KSTEP = 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Invert the diagonal block.
-*
- T = ABS( A( K, K-1 ) )
- AK = A( K-1, K-1 ) / T
- AKP1 = A( K, K ) / T
- AKKP1 = A( K, K-1 ) / T
- D = T*( AK*AKP1-ONE )
- A( K-1, K-1 ) = AKP1 / D
- A( K, K ) = AK / D
- A( K, K-1 ) = -AKKP1 / D
-*
-* Compute columns K-1 and K of the inverse.
-*
- IF( K.LT.N ) THEN
- CALL SCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
- CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
- $ ZERO, A( K+1, K ), 1 )
- A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, K ),
- $ 1 )
- A( K, K-1 ) = A( K, K-1 ) -
- $ SDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ),
- $ 1 )
- CALL SCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 )
- CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
- $ ZERO, A( K+1, K-1 ), 1 )
- A( K-1, K-1 ) = A( K-1, K-1 ) -
- $ SDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 )
- END IF
- KSTEP = 2
- END IF
-*
- KP = ABS( IPIV( K ) )
- IF( KP.NE.K ) THEN
-*
-* Interchange rows and columns K and KP in the trailing
-* submatrix A(k-1:n,k-1:n)
-*
- IF( KP.LT.N )
- $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 )
- CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA )
- TEMP = A( K, K )
- A( K, K ) = A( KP, KP )
- A( KP, KP ) = TEMP
- IF( KSTEP.EQ.2 ) THEN
- TEMP = A( K, K-1 )
- A( K, K-1 ) = A( KP, K-1 )
- A( KP, K-1 ) = TEMP
- END IF
- END IF
-*
- K = K - KSTEP
- GO TO 50
- 60 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSYTRI
-*
- END
diff --git a/netlib/LAPACK/ssytri2.f b/netlib/LAPACK/ssytri2.f
deleted file mode 100644
index 2110bab..0000000
--- a/netlib/LAPACK/ssytri2.f
+++ /dev/null
@@ -1,205 +0,0 @@
-*> \brief \b SSYTRI2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRI2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytri2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytri2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytri2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRI2 computes the inverse of a REAL symmetric indefinite matrix
-*> A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*> SSYTRF. SSYTRI2 sets the LEADING DIMENSION of the workspace
-*> before calling SSYTRI2X that actually computes the inverse.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the NB diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by SSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the NB structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N+NB+1)*(NB+3)
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> WORK is size >= (N+NB+1)*(NB+3)
-*> If LDWORK = -1, then a workspace query is assumed; the routine
-*> calculates:
-*> - the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array,
-*> - and no error message related to LDWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL UPPER, LQUERY
- INTEGER MINSIZE, NBMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SSYTRI2X
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- LQUERY = ( LWORK.EQ.-1 )
-* Get blocksize
- NBMAX = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
- IF ( NBMAX .GE. N ) THEN
- MINSIZE = N
- ELSE
- MINSIZE = (N+NBMAX+1)*(NBMAX+3)
- END IF
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
-*
-* Quick return if possible
-*
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRI2', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- WORK(1)=MINSIZE
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
-
- IF( NBMAX .GE. N ) THEN
- CALL SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
- ELSE
- CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
- END IF
- RETURN
-*
-* End of SSYTRI2
-*
- END
diff --git a/netlib/LAPACK/ssytri2x.f b/netlib/LAPACK/ssytri2x.f
deleted file mode 100644
index d542142..0000000
--- a/netlib/LAPACK/ssytri2x.f
+++ /dev/null
@@ -1,590 +0,0 @@
-*> \brief \b SSYTRI2X
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRI2X + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytri2x.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytri2x.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytri2x.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, N, NB
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), WORK( N+NB+1,* )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRI2X computes the inverse of a real symmetric indefinite matrix
-*> A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*> SSYTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the NNB diagonal matrix D and the multipliers
-*> used to obtain the factor U or L as computed by SSYTRF.
-*>
-*> On exit, if INFO = 0, the (symmetric) inverse of the original
-*> matrix. If UPLO = 'U', the upper triangular part of the
-*> inverse is formed and the part of A below the diagonal is not
-*> referenced; if UPLO = 'L' the lower triangular part of the
-*> inverse is formed and the part of A above the diagonal is
-*> not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the NNB structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N+NNB+1,NNB+3)
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> Block size
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
-*> inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, N, NB
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), WORK( N+NB+1,* )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IINFO, IP, K, CUT, NNB
- INTEGER COUNT
- INTEGER J, U11, INVD
-
- REAL AK, AKKP1, AKP1, D, T
- REAL U01_I_J, U01_IP1_J
- REAL U11_I_J, U11_IP1_J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSYCONV, XERBLA, STRTRI
- EXTERNAL SGEMM, STRMM, SSYSWAPR
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
-*
-* Quick return if possible
-*
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRI2X', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
-*
-* Convert A
-* Workspace got Non-diag elements of D
-*
- CALL SSYCONV( UPLO, 'C', N, A, LDA, IPIV, WORK, IINFO )
-*
-* Check that the diagonal matrix D is nonsingular.
-*
- IF( UPPER ) THEN
-*
-* Upper triangular storage: examine D from bottom to top
-*
- DO INFO = N, 1, -1
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- END DO
- ELSE
-*
-* Lower triangular storage: examine D from top to bottom.
-*
- DO INFO = 1, N
- IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- END DO
- END IF
- INFO = 0
-*
-* Splitting Workspace
-* U01 is a block (N,NB+1)
-* The first element of U01 is in WORK(1,1)
-* U11 is a block (NB+1,NB+1)
-* The first element of U11 is in WORK(N+1,1)
- U11 = N
-* INVD is a block (N,2)
-* The first element of INVD is in WORK(1,INVD)
- INVD = NB+2
-
- IF( UPPER ) THEN
-*
-* invA = P * inv(U**T)*inv(D)*inv(U)*P**T.
-*
- CALL STRTRI( UPLO, 'U', N, A, LDA, INFO )
-*
-* inv(D) and inv(D)*inv(U)
-*
- K=1
- DO WHILE ( K .LE. N )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal NNB
- WORK(K,INVD) = ONE / A( K, K )
- WORK(K,INVD+1) = 0
- K=K+1
- ELSE
-* 2 x 2 diagonal NNB
- T = WORK(K+1,1)
- AK = A( K, K ) / T
- AKP1 = A( K+1, K+1 ) / T
- AKKP1 = WORK(K+1,1) / T
- D = T*( AK*AKP1-ONE )
- WORK(K,INVD) = AKP1 / D
- WORK(K+1,INVD+1) = AK / D
- WORK(K,INVD+1) = -AKKP1 / D
- WORK(K+1,INVD) = -AKKP1 / D
- K=K+2
- END IF
- END DO
-*
-* inv(U**T) = (inv(U))**T
-*
-* inv(U**T)*inv(D)*inv(U)
-*
- CUT=N
- DO WHILE (CUT .GT. 0)
- NNB=NB
- IF (CUT .LE. NNB) THEN
- NNB=CUT
- ELSE
- COUNT = 0
-* count negative elements,
- DO I=CUT+1-NNB,CUT
- IF (IPIV(I) .LT. 0) COUNT=COUNT+1
- END DO
-* need a even number for a clear cut
- IF (MOD(COUNT,2) .EQ. 1) NNB=NNB+1
- END IF
-
- CUT=CUT-NNB
-*
-* U01 Block
-*
- DO I=1,CUT
- DO J=1,NNB
- WORK(I,J)=A(I,CUT+J)
- END DO
- END DO
-*
-* U11 Block
-*
- DO I=1,NNB
- WORK(U11+I,I)=ONE
- DO J=1,I-1
- WORK(U11+I,J)=ZERO
- END DO
- DO J=I+1,NNB
- WORK(U11+I,J)=A(CUT+I,CUT+J)
- END DO
- END DO
-*
-* invD*U01
-*
- I=1
- DO WHILE (I .LE. CUT)
- IF (IPIV(I) > 0) THEN
- DO J=1,NNB
- WORK(I,J)=WORK(I,INVD)*WORK(I,J)
- END DO
- I=I+1
- ELSE
- DO J=1,NNB
- U01_I_J = WORK(I,J)
- U01_IP1_J = WORK(I+1,J)
- WORK(I,J)=WORK(I,INVD)*U01_I_J+
- $ WORK(I,INVD+1)*U01_IP1_J
- WORK(I+1,J)=WORK(I+1,INVD)*U01_I_J+
- $ WORK(I+1,INVD+1)*U01_IP1_J
- END DO
- I=I+2
- END IF
- END DO
-*
-* invD1*U11
-*
- I=1
- DO WHILE (I .LE. NNB)
- IF (IPIV(CUT+I) > 0) THEN
- DO J=I,NNB
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J)
- END DO
- I=I+1
- ELSE
- DO J=I,NNB
- U11_I_J = WORK(U11+I,J)
- U11_IP1_J = WORK(U11+I+1,J)
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J) +
- $ WORK(CUT+I,INVD+1)*WORK(U11+I+1,J)
- WORK(U11+I+1,J)=WORK(CUT+I+1,INVD)*U11_I_J+
- $ WORK(CUT+I+1,INVD+1)*U11_IP1_J
- END DO
- I=I+2
- END IF
- END DO
-*
-* U11**T*invD1*U11->U11
-*
- CALL STRMM('L','U','T','U',NNB, NNB,
- $ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
-*
- DO I=1,NNB
- DO J=I,NNB
- A(CUT+I,CUT+J)=WORK(U11+I,J)
- END DO
- END DO
-*
-* U01**T*invD*U01->A(CUT+I,CUT+J)
-*
- CALL SGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
- $ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
-*
-* U11 = U11**T*invD1*U11 + U01**T*invD*U01
-*
- DO I=1,NNB
- DO J=I,NNB
- A(CUT+I,CUT+J)=A(CUT+I,CUT+J)+WORK(U11+I,J)
- END DO
- END DO
-*
-* U01 = U00**T*invD0*U01
-*
- CALL STRMM('L',UPLO,'T','U',CUT, NNB,
- $ ONE,A,LDA,WORK,N+NB+1)
-
-*
-* Update U01
-*
- DO I=1,CUT
- DO J=1,NNB
- A(I,CUT+J)=WORK(I,J)
- END DO
- END DO
-*
-* Next Block
-*
- END DO
-*
-* Apply PERMUTATIONS P and P**T: P * inv(U**T)*inv(D)*inv(U) *P**T
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP )
- IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I )
- ELSE
- IP=-IPIV(I)
- I=I+1
- IF ( (I-1) .LT. IP)
- $ CALL SSYSWAPR( UPLO, N, A, LDA, I-1 ,IP )
- IF ( (I-1) .GT. IP)
- $ CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I-1 )
- ENDIF
- I=I+1
- END DO
- ELSE
-*
-* LOWER...
-*
-* invA = P * inv(U**T)*inv(D)*inv(U)*P**T.
-*
- CALL STRTRI( UPLO, 'U', N, A, LDA, INFO )
-*
-* inv(D) and inv(D)*inv(U)
-*
- K=N
- DO WHILE ( K .GE. 1 )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal NNB
- WORK(K,INVD) = ONE / A( K, K )
- WORK(K,INVD+1) = 0
- K=K-1
- ELSE
-* 2 x 2 diagonal NNB
- T = WORK(K-1,1)
- AK = A( K-1, K-1 ) / T
- AKP1 = A( K, K ) / T
- AKKP1 = WORK(K-1,1) / T
- D = T*( AK*AKP1-ONE )
- WORK(K-1,INVD) = AKP1 / D
- WORK(K,INVD) = AK / D
- WORK(K,INVD+1) = -AKKP1 / D
- WORK(K-1,INVD+1) = -AKKP1 / D
- K=K-2
- END IF
- END DO
-*
-* inv(U**T) = (inv(U))**T
-*
-* inv(U**T)*inv(D)*inv(U)
-*
- CUT=0
- DO WHILE (CUT .LT. N)
- NNB=NB
- IF (CUT + NNB .GT. N) THEN
- NNB=N-CUT
- ELSE
- COUNT = 0
-* count negative elements,
- DO I=CUT+1,CUT+NNB
- IF (IPIV(I) .LT. 0) COUNT=COUNT+1
- END DO
-* need a even number for a clear cut
- IF (MOD(COUNT,2) .EQ. 1) NNB=NNB+1
- END IF
-* L21 Block
- DO I=1,N-CUT-NNB
- DO J=1,NNB
- WORK(I,J)=A(CUT+NNB+I,CUT+J)
- END DO
- END DO
-* L11 Block
- DO I=1,NNB
- WORK(U11+I,I)=ONE
- DO J=I+1,NNB
- WORK(U11+I,J)=ZERO
- END DO
- DO J=1,I-1
- WORK(U11+I,J)=A(CUT+I,CUT+J)
- END DO
- END DO
-*
-* invD*L21
-*
- I=N-CUT-NNB
- DO WHILE (I .GE. 1)
- IF (IPIV(CUT+NNB+I) > 0) THEN
- DO J=1,NNB
- WORK(I,J)=WORK(CUT+NNB+I,INVD)*WORK(I,J)
- END DO
- I=I-1
- ELSE
- DO J=1,NNB
- U01_I_J = WORK(I,J)
- U01_IP1_J = WORK(I-1,J)
- WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
- $ WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
- WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
- $ WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
- END DO
- I=I-2
- END IF
- END DO
-*
-* invD1*L11
-*
- I=NNB
- DO WHILE (I .GE. 1)
- IF (IPIV(CUT+I) > 0) THEN
- DO J=1,NNB
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J)
- END DO
- I=I-1
- ELSE
- DO J=1,NNB
- U11_I_J = WORK(U11+I,J)
- U11_IP1_J = WORK(U11+I-1,J)
- WORK(U11+I,J)=WORK(CUT+I,INVD)*WORK(U11+I,J) +
- $ WORK(CUT+I,INVD+1)*U11_IP1_J
- WORK(U11+I-1,J)=WORK(CUT+I-1,INVD+1)*U11_I_J+
- $ WORK(CUT+I-1,INVD)*U11_IP1_J
- END DO
- I=I-2
- END IF
- END DO
-*
-* L11**T*invD1*L11->L11
-*
- CALL STRMM('L',UPLO,'T','U',NNB, NNB,
- $ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
-
-*
- DO I=1,NNB
- DO J=1,I
- A(CUT+I,CUT+J)=WORK(U11+I,J)
- END DO
- END DO
-*
- IF ( (CUT+NNB) .LT. N ) THEN
-*
-* L21**T*invD2*L21->A(CUT+I,CUT+J)
-*
- CALL SGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1)
- $ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
-
-*
-* L11 = L11**T*invD1*L11 + U01**T*invD*U01
-*
- DO I=1,NNB
- DO J=1,I
- A(CUT+I,CUT+J)=A(CUT+I,CUT+J)+WORK(U11+I,J)
- END DO
- END DO
-*
-* L01 = L22**T*invD2*L21
-*
- CALL STRMM('L',UPLO,'T','U', N-NNB-CUT, NNB,
- $ ONE,A(CUT+NNB+1,CUT+NNB+1),LDA,WORK,N+NB+1)
-*
-* Update L21
-*
- DO I=1,N-CUT-NNB
- DO J=1,NNB
- A(CUT+NNB+I,CUT+J)=WORK(I,J)
- END DO
- END DO
-
- ELSE
-*
-* L11 = L11**T*invD1*L11
-*
- DO I=1,NNB
- DO J=1,I
- A(CUT+I,CUT+J)=WORK(U11+I,J)
- END DO
- END DO
- END IF
-*
-* Next Block
-*
- CUT=CUT+NNB
- END DO
-*
-* Apply PERMUTATIONS P and P**T: P * inv(U**T)*inv(D)*inv(U) *P**T
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0 ) THEN
- IP=IPIV(I)
- IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP )
- IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I )
- ELSE
- IP=-IPIV(I)
- IF ( I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP )
- IF ( I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I )
- I=I-1
- ENDIF
- I=I-1
- END DO
- END IF
-*
- RETURN
-*
-* End of SSYTRI2X
-*
- END
-
diff --git a/netlib/LAPACK/ssytrs.f b/netlib/LAPACK/ssytrs.f
deleted file mode 100644
index fb5f655..0000000
--- a/netlib/LAPACK/ssytrs.f
+++ /dev/null
@@ -1,445 +0,0 @@
-*> \brief \b SSYTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRS solves a system of linear equations A*X = B with a real
-*> symmetric matrix A using the factorization A = U*D*U**T or
-*> A = L*D*L**T computed by SSYTRF.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER J, K, KP
- REAL AK, AKM1, AKM1K, BK, BKM1, DENOM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SGER, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B, where A = U*D*U**T.
-*
-* First solve U*D*X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- 10 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 30
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL SGER( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL SSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K-1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K-1 )
- $ CALL SSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(U(K)), where U(K) is the transformation
-* stored in columns K-1 and K of A.
-*
- CALL SGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
- $ B( 1, 1 ), LDB )
- CALL SGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
- $ LDB, B( 1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = A( K-1, K )
- AKM1 = A( K-1, K-1 ) / AKM1K
- AK = A( K, K ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 20 J = 1, NRHS
- BKM1 = B( K-1, J ) / AKM1K
- BK = B( K, J ) / AKM1K
- B( K-1, J ) = ( AK*BKM1-BK ) / DENOM
- B( K, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 20 CONTINUE
- K = K - 2
- END IF
-*
- GO TO 10
- 30 CONTINUE
-*
-* Next solve U**T *X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- 40 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 50
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(U**T(K)), where U(K) is the transformation
-* stored in column K of A.
-*
- CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
- $ 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
-* stored in columns K and K+1 of A.
-*
- CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
- $ 1, ONE, B( K, 1 ), LDB )
- CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
- $ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB )
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K + 2
- END IF
-*
- GO TO 40
- 50 CONTINUE
-*
- ELSE
-*
-* Solve A*X = B, where A = L*D*L**T.
-*
-* First solve L*D*X = B, overwriting B with X.
-*
-* K is the main loop index, increasing from 1 to N in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = 1
- 60 CONTINUE
-*
-* If K > N, exit from loop.
-*
- IF( K.GT.N )
- $ GO TO 80
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL SGER( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ),
- $ LDB, B( K+1, 1 ), LDB )
-*
-* Multiply by the inverse of the diagonal block.
-*
- CALL SSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
- K = K + 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Interchange rows K+1 and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K+1 )
- $ CALL SSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-* Multiply by inv(L(K)), where L(K) is the transformation
-* stored in columns K and K+1 of A.
-*
- IF( K.LT.N-1 ) THEN
- CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ),
- $ LDB, B( K+2, 1 ), LDB )
- CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1,
- $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
- END IF
-*
-* Multiply by the inverse of the diagonal block.
-*
- AKM1K = A( K+1, K )
- AKM1 = A( K, K ) / AKM1K
- AK = A( K+1, K+1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 70 J = 1, NRHS
- BKM1 = B( K, J ) / AKM1K
- BK = B( K+1, J ) / AKM1K
- B( K, J ) = ( AK*BKM1-BK ) / DENOM
- B( K+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 70 CONTINUE
- K = K + 2
- END IF
-*
- GO TO 60
- 80 CONTINUE
-*
-* Next solve L**T *X = B, overwriting B with X.
-*
-* K is the main loop index, decreasing from N to 1 in steps of
-* 1 or 2, depending on the size of the diagonal blocks.
-*
- K = N
- 90 CONTINUE
-*
-* If K < 1, exit from loop.
-*
- IF( K.LT.1 )
- $ GO TO 100
-*
- IF( IPIV( K ).GT.0 ) THEN
-*
-* 1 x 1 diagonal block
-*
-* Multiply by inv(L**T(K)), where L(K) is the transformation
-* stored in column K of A.
-*
- IF( K.LT.N )
- $ CALL SGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
-*
-* Interchange rows K and IPIV(K).
-*
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K - 1
- ELSE
-*
-* 2 x 2 diagonal block
-*
-* Multiply by inv(L**T(K-1)), where L(K-1) is the transformation
-* stored in columns K-1 and K of A.
-*
- IF( K.LT.N ) THEN
- CALL SGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
- CALL SGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
- $ LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
- $ LDB )
- END IF
-*
-* Interchange rows K and -IPIV(K).
-*
- KP = -IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K = K - 2
- END IF
-*
- GO TO 90
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SSYTRS
-*
- END
diff --git a/netlib/LAPACK/ssytrs2.f b/netlib/LAPACK/ssytrs2.f
deleted file mode 100644
index 5a1d7df..0000000
--- a/netlib/LAPACK/ssytrs2.f
+++ /dev/null
@@ -1,356 +0,0 @@
-*> \brief \b SSYTRS2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SSYTRS2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrs2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrs2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrs2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> SSYTRS2 solves a system of linear equations A*X = B with a real
-*> symmetric matrix A using the factorization A = U*D*U**T or
-*> A = L*D*L**T computed by SSYTRF and converted by SSYCONV.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the details of the factorization are stored
-*> as an upper or lower triangular matrix.
-*> = 'U': Upper triangular, form is A = U*D*U**T;
-*> = 'L': Lower triangular, form is A = L*D*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The block diagonal matrix D and the multipliers used to
-*> obtain the factor U or L as computed by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> Details of the interchanges and the block structure of D
-*> as determined by SSYTRF.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE SSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UPPER
- INTEGER I, IINFO, J, K, KP
- REAL AK, AKM1, AKM1K, BK, BKM1, DENOM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, SSYCONV, SSWAP, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SSYTRS2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Convert A
-*
- CALL SSYCONV( UPLO, 'C', N, A, LDA, IPIV, WORK, IINFO )
-*
- IF( UPPER ) THEN
-*
-* Solve A*X = B, where A = U*D*U**T.
-*
-* P**T * B
- K=N
- DO WHILE ( K .GE. 1 )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K-1 and -IPIV(K).
- KP = -IPIV( K )
- IF( KP.EQ.-IPIV( K-1 ) )
- $ CALL SSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-2
- END IF
- END DO
-*
-* Compute (U \P**T * B) -> B [ (U \P**T * B) ]
-*
- CALL STRSM('L','U','N','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* Compute D \ B -> B [ D \ (U \P**T * B) ]
-*
- I=N
- DO WHILE ( I .GE. 1 )
- IF( IPIV(I) .GT. 0 ) THEN
- CALL SSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
- ELSEIF ( I .GT. 1) THEN
- IF ( IPIV(I-1) .EQ. IPIV(I) ) THEN
- AKM1K = WORK(I)
- AKM1 = A( I-1, I-1 ) / AKM1K
- AK = A( I, I ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 15 J = 1, NRHS
- BKM1 = B( I-1, J ) / AKM1K
- BK = B( I, J ) / AKM1K
- B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
- B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 15 CONTINUE
- I = I - 1
- ENDIF
- ENDIF
- I = I - 1
- END DO
-*
-* Compute (U**T \ B) -> B [ U**T \ (D \ (U \P**T * B) ) ]
-*
- CALL STRSM('L','U','T','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* P * B [ P * (U**T \ (D \ (U \P**T * B) )) ]
-*
- K=1
- DO WHILE ( K .LE. N )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K-1 and -IPIV(K).
- KP = -IPIV( K )
- IF( K .LT. N .AND. KP.EQ.-IPIV( K+1 ) )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+2
- ENDIF
- END DO
-*
- ELSE
-*
-* Solve A*X = B, where A = L*D*L**T.
-*
-* P**T * B
- K=1
- DO WHILE ( K .LE. N )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K and -IPIV(K+1).
- KP = -IPIV( K+1 )
- IF( KP.EQ.-IPIV( K ) )
- $ CALL SSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
- K=K+2
- ENDIF
- END DO
-*
-* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
-*
- CALL STRSM('L','L','N','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* Compute D \ B -> B [ D \ (L \P**T * B) ]
-*
- I=1
- DO WHILE ( I .LE. N )
- IF( IPIV(I) .GT. 0 ) THEN
- CALL SSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
- ELSE
- AKM1K = WORK(I)
- AKM1 = A( I, I ) / AKM1K
- AK = A( I+1, I+1 ) / AKM1K
- DENOM = AKM1*AK - ONE
- DO 25 J = 1, NRHS
- BKM1 = B( I, J ) / AKM1K
- BK = B( I+1, J ) / AKM1K
- B( I, J ) = ( AK*BKM1-BK ) / DENOM
- B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
- 25 CONTINUE
- I = I + 1
- ENDIF
- I = I + 1
- END DO
-*
-* Compute (L**T \ B) -> B [ L**T \ (D \ (L \P**T * B) ) ]
-*
- CALL STRSM('L','L','T','U',N,NRHS,ONE,A,LDA,B,LDB)
-*
-* P * B [ P * (L**T \ (D \ (L \P**T * B) )) ]
-*
- K=N
- DO WHILE ( K .GE. 1 )
- IF( IPIV( K ).GT.0 ) THEN
-* 1 x 1 diagonal block
-* Interchange rows K and IPIV(K).
- KP = IPIV( K )
- IF( KP.NE.K )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-1
- ELSE
-* 2 x 2 diagonal block
-* Interchange rows K-1 and -IPIV(K).
- KP = -IPIV( K )
- IF( K.GT.1 .AND. KP.EQ.-IPIV( K-1 ) )
- $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
- K=K-2
- ENDIF
- END DO
-*
- END IF
-*
-* Revert A
-*
- CALL SSYCONV( UPLO, 'R', N, A, LDA, IPIV, WORK, IINFO )
-*
- RETURN
-*
-* End of SSYTRS2
-*
- END
diff --git a/netlib/LAPACK/stbcon.f b/netlib/LAPACK/stbcon.f
deleted file mode 100644
index 6f1efa1..0000000
--- a/netlib/LAPACK/stbcon.f
+++ /dev/null
@@ -1,284 +0,0 @@
-*> \brief \b STBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STBCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stbcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stbcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stbcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER INFO, KD, LDAB, N
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STBCON estimates the reciprocal of the condition number of a
-*> triangular band matrix A, in either the 1-norm or the infinity-norm.
-*>
-*> The norm of A is computed and an estimate is obtained for
-*> norm(inv(A)), then the reciprocal of the condition number is
-*> computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals or subdiagonals of the
-*> triangular band matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first kd+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER INFO, KD, LDAB, N
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, ONENRM, UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- REAL AINVNM, ANORM, SCALE, SMLNUM, XNORM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH, SLANTB
- EXTERNAL LSAME, ISAMAX, SLAMCH, SLANTB
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATBS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- END IF
-*
- RCOND = ZERO
- SMLNUM = SLAMCH( 'Safe minimum' )*REAL( MAX( 1, N ) )
-*
-* Compute the norm of the triangular matrix A.
-*
- ANORM = SLANTB( NORM, UPLO, DIAG, N, KD, AB, LDAB, WORK )
-*
-* Continue only if ANORM > 0.
-*
- IF( ANORM.GT.ZERO ) THEN
-*
-* Estimate the norm of the inverse of A.
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(A).
-*
- CALL SLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD,
- $ AB, LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(A**T).
-*
- CALL SLATBS( UPLO, 'Transpose', DIAG, NORMIN, N, KD, AB,
- $ LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO )
- END IF
- NORMIN = 'Y'
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- XNORM = ABS( WORK( IX ) )
- IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / ANORM ) / AINVNM
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of STBCON
-*
- END
diff --git a/netlib/LAPACK/stbrfs.f b/netlib/LAPACK/stbrfs.f
deleted file mode 100644
index 625d21e..0000000
--- a/netlib/LAPACK/stbrfs.f
+++ /dev/null
@@ -1,485 +0,0 @@
-*> \brief \b STBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STBRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stbrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stbrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stbrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
-* LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AB( LDAB, * ), B( LDB, * ), BERR( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STBRFS provides error bounds and backward error estimates for the
-*> solution to a system of linear equations with a triangular band
-*> coefficient matrix.
-*>
-*> The solution matrix X must be computed by STBTRS or some other
-*> means before entering this routine. STBRFS does not do iterative
-*> refinement because doing so cannot improve the backward error.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals or subdiagonals of the
-*> triangular band matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first kd+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> The solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
- $ LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, KD, LDAB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AB( LDAB, * ), B( LDB, * ), BERR( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- CHARACTER TRANST
- INTEGER I, J, K, KASE, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, STBMV, STBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = KD + 2
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 250 J = 1, NRHS
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A or A**T, depending on TRANS.
-*
- CALL SCOPY( N, X( 1, J ), 1, WORK( N+1 ), 1 )
- CALL STBMV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, WORK( N+1 ),
- $ 1 )
- CALL SAXPY( N, -ONE, B( 1, J ), 1, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 20 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 20 CONTINUE
-*
- IF( NOTRAN ) THEN
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 40 K = 1, N
- XK = ABS( X( K, J ) )
- DO 30 I = MAX( 1, K-KD ), K
- WORK( I ) = WORK( I ) +
- $ ABS( AB( KD+1+I-K, K ) )*XK
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 K = 1, N
- XK = ABS( X( K, J ) )
- DO 50 I = MAX( 1, K-KD ), K - 1
- WORK( I ) = WORK( I ) +
- $ ABS( AB( KD+1+I-K, K ) )*XK
- 50 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 60 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 80 K = 1, N
- XK = ABS( X( K, J ) )
- DO 70 I = K, MIN( N, K+KD )
- WORK( I ) = WORK( I ) + ABS( AB( 1+I-K, K ) )*XK
- 70 CONTINUE
- 80 CONTINUE
- ELSE
- DO 100 K = 1, N
- XK = ABS( X( K, J ) )
- DO 90 I = K + 1, MIN( N, K+KD )
- WORK( I ) = WORK( I ) + ABS( AB( 1+I-K, K ) )*XK
- 90 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 100 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Compute abs(A**T)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 120 K = 1, N
- S = ZERO
- DO 110 I = MAX( 1, K-KD ), K
- S = S + ABS( AB( KD+1+I-K, K ) )*
- $ ABS( X( I, J ) )
- 110 CONTINUE
- WORK( K ) = WORK( K ) + S
- 120 CONTINUE
- ELSE
- DO 140 K = 1, N
- S = ABS( X( K, J ) )
- DO 130 I = MAX( 1, K-KD ), K - 1
- S = S + ABS( AB( KD+1+I-K, K ) )*
- $ ABS( X( I, J ) )
- 130 CONTINUE
- WORK( K ) = WORK( K ) + S
- 140 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 160 K = 1, N
- S = ZERO
- DO 150 I = K, MIN( N, K+KD )
- S = S + ABS( AB( 1+I-K, K ) )*ABS( X( I, J ) )
- 150 CONTINUE
- WORK( K ) = WORK( K ) + S
- 160 CONTINUE
- ELSE
- DO 180 K = 1, N
- S = ABS( X( K, J ) )
- DO 170 I = K + 1, MIN( N, K+KD )
- S = S + ABS( AB( 1+I-K, K ) )*ABS( X( I, J ) )
- 170 CONTINUE
- WORK( K ) = WORK( K ) + S
- 180 CONTINUE
- END IF
- END IF
- END IF
- S = ZERO
- DO 190 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 190 CONTINUE
- BERR( J ) = S
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 200 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 200 CONTINUE
-*
- KASE = 0
- 210 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL STBSV( UPLO, TRANST, DIAG, N, KD, AB, LDAB,
- $ WORK( N+1 ), 1 )
- DO 220 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 220 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 230 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 230 CONTINUE
- CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB,
- $ WORK( N+1 ), 1 )
- END IF
- GO TO 210
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 240 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 240 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of STBRFS
-*
- END
diff --git a/netlib/LAPACK/stbtrs.f b/netlib/LAPACK/stbtrs.f
deleted file mode 100644
index c0806b9..0000000
--- a/netlib/LAPACK/stbtrs.f
+++ /dev/null
@@ -1,244 +0,0 @@
-*> \brief \b STBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STBTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stbtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stbtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stbtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
-* LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STBTRS solves a triangular system of the form
-*>
-*> A * X = B or A**T * X = B,
-*>
-*> where A is a triangular band matrix of order N, and B is an
-*> N-by NRHS matrix. A check is made to verify that A is nonsingular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of superdiagonals or subdiagonals of the
-*> triangular band matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is REAL array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first kd+1 rows of AB. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the
-*> solutions X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
- $ LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, KD, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL STBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOUNIT = LSAME( DIAG, 'N' )
- UPPER = LSAME( UPLO, 'U' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( KD.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- IF( UPPER ) THEN
- DO 10 INFO = 1, N
- IF( AB( KD+1, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
- DO 20 INFO = 1, N
- IF( AB( 1, INFO ).EQ.ZERO )
- $ RETURN
- 20 CONTINUE
- END IF
- END IF
- INFO = 0
-*
-* Solve A * X = B or A**T * X = B.
-*
- DO 30 J = 1, NRHS
- CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 )
- 30 CONTINUE
-*
- RETURN
-*
-* End of STBTRS
-*
- END
diff --git a/netlib/LAPACK/stfsm.f b/netlib/LAPACK/stfsm.f
deleted file mode 100644
index 74d7540..0000000
--- a/netlib/LAPACK/stfsm.f
+++ /dev/null
@@ -1,1005 +0,0 @@
-*> \brief \b STFSM solves a matrix equation (one operand is a triangular matrix in RFP format).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STFSM + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stfsm.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stfsm.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stfsm.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
-* B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO
-* INTEGER LDB, M, N
-* REAL ALPHA
-* ..
-* .. Array Arguments ..
-* REAL A( 0: * ), B( 0: LDB-1, 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> Level 3 BLAS like routine for A in RFP Format.
-*>
-*> STFSM solves the matrix equation
-*>
-*> op( A )*X = alpha*B or X*op( A ) = alpha*B
-*>
-*> where alpha is a scalar, X and B are m by n matrices, A is a unit, or
-*> non-unit, upper or lower triangular matrix and op( A ) is one of
-*>
-*> op( A ) = A or op( A ) = A**T.
-*>
-*> A is in Rectangular Full Packed (RFP) Format.
-*>
-*> The matrix X is overwritten on B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal Form of RFP A is stored;
-*> = 'T': The Transpose Form of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> On entry, SIDE specifies whether op( A ) appears on the left
-*> or right of X as follows:
-*>
-*> SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*>
-*> SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the RFP matrix A came from
-*> an upper or lower triangular matrix as follows:
-*> UPLO = 'U' or 'u' RFP A came from an upper triangular matrix
-*> UPLO = 'L' or 'l' RFP A came from a lower triangular matrix
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the form of op( A ) to be used
-*> in the matrix multiplication as follows:
-*>
-*> TRANS = 'N' or 'n' op( A ) = A.
-*>
-*> TRANS = 'T' or 't' op( A ) = A'.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not RFP A is unit
-*> triangular as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*>
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of B. M must be at
-*> least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of B. N must be
-*> at least zero.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha. When alpha is
-*> zero then A is not referenced and B need not be set before
-*> entry.
-*> Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (NT)
-*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
-*> RFP Format is described by TRANSR, UPLO and N as follows:
-*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
-*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
-*> TRANSR = 'T' then RFP is the transpose of RFP A as
-*> defined when TRANSR = 'N'. The contents of RFP A are defined
-*> by UPLO as follows: If UPLO = 'U' the RFP A contains the NT
-*> elements of upper packed A either in normal or
-*> transpose Format. If UPLO = 'L' the RFP A contains
-*> the NT elements of lower packed A either in normal or
-*> transpose Format. The LDA of RFP A is (N+1)/2 when
-*> TRANSR = 'T'. When TRANSR is 'N' the LDA is N+1 when N is
-*> even and is N when is odd.
-*> See the Note below for more details. Unchanged on exit.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, DIMENSION (LDB,N)
-*> Before entry, the leading m by n part of the array B must
-*> contain the right-hand side matrix B, and on exit is
-*> overwritten by the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> On entry, LDB specifies the first dimension of B as declared
-*> in the calling (sub) program. LDB must be at least
-*> max( 1, m ).
-*> Unchanged on exit.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
- $ B, LDB )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO
- INTEGER LDB, M, N
- REAL ALPHA
-* ..
-* .. Array Arguments ..
- REAL A( 0: * ), B( 0: LDB-1, 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, LSIDE, MISODD, NISODD, NORMALTRANSR,
- $ NOTRANS
- INTEGER M1, M2, N1, N2, K, INFO, I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LSIDE = LSAME( SIDE, 'L' )
- LOWER = LSAME( UPLO, 'L' )
- NOTRANS = LSAME( TRANS, 'N' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSIDE .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -4
- ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
- $ THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -6
- ELSE IF( N.LT.0 ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STFSM ', -INFO )
- RETURN
- END IF
-*
-* Quick return when ( (N.EQ.0).OR.(M.EQ.0) )
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
- $ RETURN
-*
-* Quick return when ALPHA.EQ.(0D+0)
-*
- IF( ALPHA.EQ.ZERO ) THEN
- DO 20 J = 0, N - 1
- DO 10 I = 0, M - 1
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
- IF( LSIDE ) THEN
-*
-* SIDE = 'L'
-*
-* A is M-by-M.
-* If M is odd, set NISODD = .TRUE., and M1 and M2.
-* If M is even, NISODD = .FALSE., and M.
-*
- IF( MOD( M, 2 ).EQ.0 ) THEN
- MISODD = .FALSE.
- K = M / 2
- ELSE
- MISODD = .TRUE.
- IF( LOWER ) THEN
- M2 = M / 2
- M1 = M - M2
- ELSE
- M1 = M / 2
- M2 = M - M1
- END IF
- END IF
-*
- IF( MISODD ) THEN
-*
-* SIDE = 'L' and N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'L', N is odd, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'N'
-*
- IF( M.EQ.1 ) THEN
- CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
- $ A, M, B, LDB )
- ELSE
- CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
- $ A( 0 ), M, B, LDB )
- CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ),
- $ M, B, LDB, ALPHA, B( M1, 0 ), LDB )
- CALL STRSM( 'L', 'U', 'T', DIAG, M2, N, ONE,
- $ A( M ), M, B( M1, 0 ), LDB )
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'T'
-*
- IF( M.EQ.1 ) THEN
- CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ALPHA,
- $ A( 0 ), M, B, LDB )
- ELSE
- CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
- $ A( M ), M, B( M1, 0 ), LDB )
- CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ),
- $ M, B( M1, 0 ), LDB, ALPHA, B, LDB )
- CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ONE,
- $ A( 0 ), M, B, LDB )
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
- $ A( M2 ), M, B, LDB )
- CALL SGEMM( 'T', 'N', M2, N, M1, -ONE, A( 0 ), M,
- $ B, LDB, ALPHA, B( M1, 0 ), LDB )
- CALL STRSM( 'L', 'U', 'T', DIAG, M2, N, ONE,
- $ A( M1 ), M, B( M1, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
- $ A( M1 ), M, B( M1, 0 ), LDB )
- CALL SGEMM( 'N', 'N', M1, N, M2, -ONE, A( 0 ), M,
- $ B( M1, 0 ), LDB, ALPHA, B, LDB )
- CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ONE,
- $ A( M2 ), M, B, LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'L', N is odd, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'N'
-*
- IF( M.EQ.1 ) THEN
- CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA,
- $ A( 0 ), M1, B, LDB )
- ELSE
- CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA,
- $ A( 0 ), M1, B, LDB )
- CALL SGEMM( 'T', 'N', M2, N, M1, -ONE,
- $ A( M1*M1 ), M1, B, LDB, ALPHA,
- $ B( M1, 0 ), LDB )
- CALL STRSM( 'L', 'L', 'N', DIAG, M2, N, ONE,
- $ A( 1 ), M1, B( M1, 0 ), LDB )
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'T'
-*
- IF( M.EQ.1 ) THEN
- CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA,
- $ A( 0 ), M1, B, LDB )
- ELSE
- CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA,
- $ A( 1 ), M1, B( M1, 0 ), LDB )
- CALL SGEMM( 'N', 'N', M1, N, M2, -ONE,
- $ A( M1*M1 ), M1, B( M1, 0 ), LDB,
- $ ALPHA, B, LDB )
- CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ONE,
- $ A( 0 ), M1, B, LDB )
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA,
- $ A( M2*M2 ), M2, B, LDB )
- CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( 0 ), M2,
- $ B, LDB, ALPHA, B( M1, 0 ), LDB )
- CALL STRSM( 'L', 'L', 'N', DIAG, M2, N, ONE,
- $ A( M1*M2 ), M2, B( M1, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA,
- $ A( M1*M2 ), M2, B( M1, 0 ), LDB )
- CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( 0 ), M2,
- $ B( M1, 0 ), LDB, ALPHA, B, LDB )
- CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ONE,
- $ A( M2*M2 ), M2, B, LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'L' and N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'L', N is even, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL STRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
- $ A( 1 ), M+1, B, LDB )
- CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( K+1 ),
- $ M+1, B, LDB, ALPHA, B( K, 0 ), LDB )
- CALL STRSM( 'L', 'U', 'T', DIAG, K, N, ONE,
- $ A( 0 ), M+1, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL STRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
- $ A( 0 ), M+1, B( K, 0 ), LDB )
- CALL SGEMM( 'T', 'N', K, N, K, -ONE, A( K+1 ),
- $ M+1, B( K, 0 ), LDB, ALPHA, B, LDB )
- CALL STRSM( 'L', 'L', 'T', DIAG, K, N, ONE,
- $ A( 1 ), M+1, B, LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL STRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
- $ A( K+1 ), M+1, B, LDB )
- CALL SGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), M+1,
- $ B, LDB, ALPHA, B( K, 0 ), LDB )
- CALL STRSM( 'L', 'U', 'T', DIAG, K, N, ONE,
- $ A( K ), M+1, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'T'
- CALL STRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
- $ A( K ), M+1, B( K, 0 ), LDB )
- CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), M+1,
- $ B( K, 0 ), LDB, ALPHA, B, LDB )
- CALL STRSM( 'L', 'L', 'T', DIAG, K, N, ONE,
- $ A( K+1 ), M+1, B, LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'L', N is even, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL STRSM( 'L', 'U', 'T', DIAG, K, N, ALPHA,
- $ A( K ), K, B, LDB )
- CALL SGEMM( 'T', 'N', K, N, K, -ONE,
- $ A( K*( K+1 ) ), K, B, LDB, ALPHA,
- $ B( K, 0 ), LDB )
- CALL STRSM( 'L', 'L', 'N', DIAG, K, N, ONE,
- $ A( 0 ), K, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL STRSM( 'L', 'L', 'T', DIAG, K, N, ALPHA,
- $ A( 0 ), K, B( K, 0 ), LDB )
- CALL SGEMM( 'N', 'N', K, N, K, -ONE,
- $ A( K*( K+1 ) ), K, B( K, 0 ), LDB,
- $ ALPHA, B, LDB )
- CALL STRSM( 'L', 'U', 'N', DIAG, K, N, ONE,
- $ A( K ), K, B, LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IF( .NOT.NOTRANS ) THEN
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL STRSM( 'L', 'U', 'T', DIAG, K, N, ALPHA,
- $ A( K*( K+1 ) ), K, B, LDB )
- CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), K, B,
- $ LDB, ALPHA, B( K, 0 ), LDB )
- CALL STRSM( 'L', 'L', 'N', DIAG, K, N, ONE,
- $ A( K*K ), K, B( K, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='L', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'T'
-*
- CALL STRSM( 'L', 'L', 'T', DIAG, K, N, ALPHA,
- $ A( K*K ), K, B( K, 0 ), LDB )
- CALL SGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), K,
- $ B( K, 0 ), LDB, ALPHA, B, LDB )
- CALL STRSM( 'L', 'U', 'N', DIAG, K, N, ONE,
- $ A( K*( K+1 ) ), K, B, LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R'
-*
-* A is N-by-N.
-* If N is odd, set NISODD = .TRUE., and N1 and N2.
-* If N is even, NISODD = .FALSE., and K.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- NISODD = .FALSE.
- K = N / 2
- ELSE
- NISODD = .TRUE.
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
- END IF
-*
- IF( NISODD ) THEN
-*
-* SIDE = 'R' and N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'R', N is odd, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'N'
-*
- CALL STRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA,
- $ A( N ), N, B( 0, N1 ), LDB )
- CALL SGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL STRSM( 'R', 'L', 'N', DIAG, M, N1, ONE,
- $ A( 0 ), N, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
-* TRANS = 'T'
-*
- CALL STRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA,
- $ A( 0 ), N, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL STRSM( 'R', 'U', 'N', DIAG, M, N2, ONE,
- $ A( N ), N, B( 0, N1 ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL STRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA,
- $ A( N2 ), N, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL STRSM( 'R', 'U', 'N', DIAG, M, N2, ONE,
- $ A( N1 ), N, B( 0, N1 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL STRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA,
- $ A( N1 ), N, B( 0, N1 ), LDB )
- CALL SGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB )
- CALL STRSM( 'R', 'L', 'N', DIAG, M, N1, ONE,
- $ A( N2 ), N, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R', N is odd, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'N'
-*
- CALL STRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
- $ A( 1 ), N1, B( 0, N1 ), LDB )
- CALL SGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL STRSM( 'R', 'U', 'T', DIAG, M, N1, ONE,
- $ A( 0 ), N1, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'L', and
-* TRANS = 'T'
-*
- CALL STRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
- $ A( 0 ), N1, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL STRSM( 'R', 'L', 'T', DIAG, M, N2, ONE,
- $ A( 1 ), N1, B( 0, N1 ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'N'
-*
- CALL STRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
- $ A( N2*N2 ), N2, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ),
- $ LDB )
- CALL STRSM( 'R', 'L', 'T', DIAG, M, N2, ONE,
- $ A( N1*N2 ), N2, B( 0, N1 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is odd, TRANSR = 'T', UPLO = 'U', and
-* TRANS = 'T'
-*
- CALL STRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
- $ A( N1*N2 ), N2, B( 0, N1 ), LDB )
- CALL SGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ),
- $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL STRSM( 'R', 'U', 'T', DIAG, M, N1, ONE,
- $ A( N2*N2 ), N2, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R' and N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* SIDE = 'R', N is even, and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL STRSM( 'R', 'U', 'T', DIAG, M, K, ALPHA,
- $ A( 0 ), N+1, B( 0, K ), LDB )
- CALL SGEMM( 'N', 'N', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( K+1 ), N+1, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL STRSM( 'R', 'L', 'N', DIAG, M, K, ONE,
- $ A( 1 ), N+1, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL STRSM( 'R', 'L', 'T', DIAG, M, K, ALPHA,
- $ A( 1 ), N+1, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'T', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( K+1 ), N+1, ALPHA, B( 0, K ),
- $ LDB )
- CALL STRSM( 'R', 'U', 'N', DIAG, M, K, ONE,
- $ A( 0 ), N+1, B( 0, K ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL STRSM( 'R', 'L', 'T', DIAG, M, K, ALPHA,
- $ A( K+1 ), N+1, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'N', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), N+1, ALPHA, B( 0, K ),
- $ LDB )
- CALL STRSM( 'R', 'U', 'N', DIAG, M, K, ONE,
- $ A( K ), N+1, B( 0, K ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'N', UPLO = 'U',
-* and TRANS = 'T'
-*
- CALL STRSM( 'R', 'U', 'T', DIAG, M, K, ALPHA,
- $ A( K ), N+1, B( 0, K ), LDB )
- CALL SGEMM( 'N', 'T', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( 0 ), N+1, ALPHA, B( 0, 0 ),
- $ LDB )
- CALL STRSM( 'R', 'L', 'N', DIAG, M, K, ONE,
- $ A( K+1 ), N+1, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* SIDE = 'R', N is even, and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'N'
-*
- CALL STRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
- $ A( 0 ), K, B( 0, K ), LDB )
- CALL SGEMM( 'N', 'T', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( ( K+1 )*K ), K, ALPHA,
- $ B( 0, 0 ), LDB )
- CALL STRSM( 'R', 'U', 'T', DIAG, M, K, ONE,
- $ A( K ), K, B( 0, 0 ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'L',
-* and TRANS = 'T'
-*
- CALL STRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
- $ A( K ), K, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'N', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( ( K+1 )*K ), K, ALPHA,
- $ B( 0, K ), LDB )
- CALL STRSM( 'R', 'L', 'T', DIAG, M, K, ONE,
- $ A( 0 ), K, B( 0, K ), LDB )
-*
- END IF
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IF( NOTRANS ) THEN
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'N'
-*
- CALL STRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
- $ A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
- CALL SGEMM( 'N', 'T', M, K, K, -ONE, B( 0, 0 ),
- $ LDB, A( 0 ), K, ALPHA, B( 0, K ), LDB )
- CALL STRSM( 'R', 'L', 'T', DIAG, M, K, ONE,
- $ A( K*K ), K, B( 0, K ), LDB )
-*
- ELSE
-*
-* SIDE ='R', N is even, TRANSR = 'T', UPLO = 'U',
-* and TRANS = 'T'
-*
- CALL STRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
- $ A( K*K ), K, B( 0, K ), LDB )
- CALL SGEMM( 'N', 'N', M, K, K, -ONE, B( 0, K ),
- $ LDB, A( 0 ), K, ALPHA, B( 0, 0 ), LDB )
- CALL STRSM( 'R', 'U', 'T', DIAG, M, K, ONE,
- $ A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- END IF
- END IF
-*
- RETURN
-*
-* End of STFSM
-*
- END
diff --git a/netlib/LAPACK/stftri.f b/netlib/LAPACK/stftri.f
deleted file mode 100644
index 681fa3b..0000000
--- a/netlib/LAPACK/stftri.f
+++ /dev/null
@@ -1,472 +0,0 @@
-*> \brief \b STFTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STFTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stftri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stftri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stftri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO, DIAG
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL A( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STFTRI computes the inverse of a triangular matrix A stored in RFP
-*> format.
-*>
-*> This is a Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': The Normal TRANSR of RFP A is stored;
-*> = 'T': The Transpose TRANSR of RFP A is stored.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (NT);
-*> NT=N*(N+1)/2. On entry, the triangular factor of a Hermitian
-*> Positive Definite matrix A in RFP format. RFP format is
-*> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N'
-*> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
-*> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is
-*> the transpose of RFP A as defined when
-*> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
-*> follows: If UPLO = 'U' the RFP A contains the nt elements of
-*> upper packed A; If UPLO = 'L' the RFP A contains the nt
-*> elements of lower packed A. The LDA of RFP A is (N+1)/2 when
-*> TRANSR = 'T'. When TRANSR is 'N' the LDA is N+1 when N is
-*> even and N is odd. See the Note below for more details.
-*>
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO, DIAG
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL A( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, STRMM, STRTRI
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
- $ THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STFTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- ELSE
- NISODD = .TRUE.
- END IF
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(n1)
-*
- CALL STRTRI( 'L', DIAG, N1, A( 0 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'L', 'N', DIAG, N2, N1, -ONE, A( 0 ),
- $ N, A( N1 ), N )
- CALL STRTRI( 'U', DIAG, N2, A( N ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'U', 'T', DIAG, N2, N1, ONE, A( N ), N,
- $ A( N1 ), N )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
-* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
-* T1 -> a(n2), T2 -> a(n1), S -> a(0)
-*
- CALL STRTRI( 'L', DIAG, N1, A( N2 ), N, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'L', 'T', DIAG, N1, N2, -ONE, A( N2 ),
- $ N, A( 0 ), N )
- CALL STRTRI( 'U', DIAG, N2, A( N1 ), N, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'U', 'N', DIAG, N1, N2, ONE, A( N1 ),
- $ N, A( 0 ), N )
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is odd
-* T1 -> a(0), T2 -> a(1), S -> a(0+n1*n1)
-*
- CALL STRTRI( 'U', DIAG, N1, A( 0 ), N1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'U', 'N', DIAG, N1, N2, -ONE, A( 0 ),
- $ N1, A( N1*N1 ), N1 )
- CALL STRTRI( 'L', DIAG, N2, A( 1 ), N1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'L', 'T', DIAG, N1, N2, ONE, A( 1 ),
- $ N1, A( N1*N1 ), N1 )
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is odd
-* T1 -> a(0+n2*n2), T2 -> a(0+n1*n2), S -> a(0)
-*
- CALL STRTRI( 'U', DIAG, N1, A( N2*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'U', 'T', DIAG, N2, N1, -ONE,
- $ A( N2*N2 ), N2, A( 0 ), N2 )
- CALL STRTRI( 'L', DIAG, N2, A( N1*N2 ), N2, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + N1
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'L', 'N', DIAG, N2, N1, ONE,
- $ A( N1*N2 ), N2, A( 0 ), N2 )
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- CALL STRTRI( 'L', DIAG, K, A( 1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'L', 'N', DIAG, K, K, -ONE, A( 1 ),
- $ N+1, A( K+1 ), N+1 )
- CALL STRTRI( 'U', DIAG, K, A( 0 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'U', 'T', DIAG, K, K, ONE, A( 0 ), N+1,
- $ A( K+1 ), N+1 )
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- CALL STRTRI( 'L', DIAG, K, A( K+1 ), N+1, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'L', 'T', DIAG, K, K, -ONE, A( K+1 ),
- $ N+1, A( 0 ), N+1 )
- CALL STRTRI( 'U', DIAG, K, A( K ), N+1, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'U', 'N', DIAG, K, K, ONE, A( K ), N+1,
- $ A( 0 ), N+1 )
- END IF
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- CALL STRTRI( 'U', DIAG, K, A( K ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'U', 'N', DIAG, K, K, -ONE, A( K ), K,
- $ A( K*( K+1 ) ), K )
- CALL STRTRI( 'L', DIAG, K, A( 0 ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'L', 'T', DIAG, K, K, ONE, A( 0 ), K,
- $ A( K*( K+1 ) ), K )
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- CALL STRTRI( 'U', DIAG, K, A( K*( K+1 ) ), K, INFO )
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'R', 'U', 'T', DIAG, K, K, -ONE,
- $ A( K*( K+1 ) ), K, A( 0 ), K )
- CALL STRTRI( 'L', DIAG, K, A( K*K ), K, INFO )
- IF( INFO.GT.0 )
- $ INFO = INFO + K
- IF( INFO.GT.0 )
- $ RETURN
- CALL STRMM( 'L', 'L', 'N', DIAG, K, K, ONE, A( K*K ), K,
- $ A( 0 ), K )
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STFTRI
-*
- END
diff --git a/netlib/LAPACK/stfttp.f b/netlib/LAPACK/stfttp.f
deleted file mode 100644
index e2dfbbe..0000000
--- a/netlib/LAPACK/stfttp.f
+++ /dev/null
@@ -1,517 +0,0 @@
-*> \brief \b STFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STFTTP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stfttp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stfttp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stfttp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STFTTP( TRANSR, UPLO, N, ARF, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL AP( 0: * ), ARF( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STFTTP copies a triangular matrix A from rectangular full packed
-*> format (TF) to standard packed format (TP).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF is in Normal format;
-*> = 'T': ARF is in Transpose format;
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ARF
-*> \verbatim
-*> ARF is REAL array, dimension ( N*(N+1)/2 ),
-*> On entry, the upper or lower triangular matrix A stored in
-*> RFP format. For a further discussion see Notes below.
-*> \endverbatim
-*>
-*> \param[out] AP
-*> \verbatim
-*> AP is REAL array, dimension ( N*(N+1)/2 ),
-*> On exit, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STFTTP( TRANSR, UPLO, N, ARF, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL AP( 0: * ), ARF( 0: * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K, NT
- INTEGER I, J, IJ
- INTEGER IJP, JP, LDA, JS
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STFTTP', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( NORMALTRANSR ) THEN
- AP( 0 ) = ARF( 0 )
- ELSE
- AP( 0 ) = ARF( 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:NT-1)
-*
- NT = N*( N+1 ) / 2
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
-* set lda of ARF^C; ARF^C is (0:(N+1)/2-1,0:N-noe)
-* where noe = 0 if n is even, noe = 1 if n is odd
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- LDA = N + 1
- ELSE
- NISODD = .TRUE.
- LDA = N
- END IF
-*
-* ARF^C has lda rows and n+1-noe cols
-*
- IF( .NOT.NORMALTRANSR )
- $ LDA = ( N+1 ) / 2
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
-* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
-* T1 -> a(0), T2 -> a(n), S -> a(n1); lda = n
-*
- IJP = 0
- JP = 0
- DO J = 0, N2
- DO I = J, N - 1
- IJ = I + JP
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, N2 - 1
- DO J = 1 + I, N2
- IJ = I + J*LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
-* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
-* T1 -> a(n2), T2 -> a(n1), S -> a(0)
-*
- IJP = 0
- DO J = 0, N1 - 1
- IJ = N2 + J
- DO I = 0, J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = N1, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is odd
-* T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1)
-* T1 -> a(0+0) , T2 -> a(1+0) , S -> a(0+n1*n1); lda=n1
-*
- IJP = 0
- DO I = 0, N2
- DO IJ = I*( LDA+1 ), N*LDA - 1, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
- JS = 1
- DO J = 0, N2 - 1
- DO IJ = JS, JS + N2 - J - 1
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is odd
-* T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0)
-* T1 -> a(n2*n2), T2 -> a(n1*n2), S -> a(0); lda = n2
-*
- IJP = 0
- JS = N2*LDA
- DO J = 0, N1 - 1
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, N1
- DO IJ = I, I + ( N1+I )*LDA, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
-* T1 -> a(1), T2 -> a(0), S -> a(k+1)
-*
- IJP = 0
- JP = 0
- DO J = 0, K - 1
- DO I = J, N - 1
- IJ = 1 + I + JP
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, K - 1
- DO J = I, K - 1
- IJ = I + J*LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
-* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
-* T1 -> a(k+1), T2 -> a(k), S -> a(0)
-*
- IJP = 0
- DO J = 0, K - 1
- IJ = K + 1 + J
- DO I = 0, J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = K, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* SRPA for LOWER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
-* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
-*
- IJP = 0
- DO I = 0, K - 1
- DO IJ = I + ( I+1 )*LDA, ( N+1 )*LDA - 1, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
- JS = 0
- DO J = 0, K - 1
- DO IJ = JS, JS + K - J - 1
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* SRPA for UPPER, TRANSPOSE and N is even (see paper)
-* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
-* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
-*
- IJP = 0
- JS = ( K+1 )*LDA
- DO J = 0, K - 1
- DO IJ = JS, JS + J
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, K - 1
- DO IJ = I, I + ( K+I )*LDA, LDA
- AP( IJP ) = ARF( IJ )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of STFTTP
-*
- END
diff --git a/netlib/LAPACK/stfttr.f b/netlib/LAPACK/stfttr.f
deleted file mode 100644
index 490778f..0000000
--- a/netlib/LAPACK/stfttr.f
+++ /dev/null
@@ -1,495 +0,0 @@
-*> \brief \b STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STFTTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stfttr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stfttr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stfttr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STFTTR copies a triangular matrix A from rectangular full packed
-*> format (TF) to standard full format (TR).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF is in Normal format;
-*> = 'T': ARF is in Transpose format.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices ARF and A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ARF
-*> \verbatim
-*> ARF is REAL array, dimension (N*(N+1)/2).
-*> On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
-*> matrix A in RFP format. See the "Notes" below for more
-*> details.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On exit, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE STFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K, NT, NX2, NP1X2
- INTEGER I, J, L, IJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STFTTR', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- IF( N.EQ.1 ) THEN
- A( 0, 0 ) = ARF( 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:nt-1)
-*
- NT = N*( N+1 ) / 2
-*
-* set N1 and N2 depending on LOWER: for N even N1=N2=K
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
-* If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
-* N--by--(N+1)/2.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- IF( .NOT.LOWER )
- $ NP1X2 = N + N + 2
- ELSE
- NISODD = .TRUE.
- IF( .NOT.LOWER )
- $ NX2 = N + N
- END IF
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2
- DO I = N1, N2 + J
- A( N2+J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N
- DO J = N - 1, N1, -1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = J - N1, N1 - 1
- A( J-N1, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- IJ = IJ - NX2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2 - 1
- DO I = 0, J
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = N1 + J, N - 1
- A( I, N1+J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = N2, N - 1
- DO I = 0, N1 - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, N1
- DO I = N1, N - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, N1 - 1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = N2 + J, N - 1
- A( N2+J, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, K - 1
- DO I = K, K + J
- A( K+J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N - 1
- DO J = N - 1, K, -1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = J - K, K - 1
- A( J-K, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- IJ = IJ - NP1X2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- J = K
- DO I = K, N - 1
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO I = K + 1 + J, N - 1
- A( I, K+1+J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = K - 1, N - 1
- DO I = 0, K - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, K
- DO I = K, N - 1
- A( J, I ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- DO L = K + 1 + J, N - 1
- A( K+1+J, L ) = ARF( IJ )
- IJ = IJ + 1
- END DO
- END DO
-* Note that here, on exit of the loop, J = K-1
- DO I = 0, J
- A( I, J ) = ARF( IJ )
- IJ = IJ + 1
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of STFTTR
-*
- END
diff --git a/netlib/LAPACK/stgevc.f b/netlib/LAPACK/stgevc.f
deleted file mode 100644
index bbf3f8c..0000000
--- a/netlib/LAPACK/stgevc.f
+++ /dev/null
@@ -1,1211 +0,0 @@
-*> \brief \b STGEVC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGEVC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgevc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgevc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgevc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
-* LDVL, VR, LDVR, MM, M, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, SIDE
-* INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* REAL P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGEVC computes some or all of the right and/or left eigenvectors of
-*> a pair of real matrices (S,P), where S is a quasi-triangular matrix
-*> and P is upper triangular. Matrix pairs of this type are produced by
-*> the generalized Schur factorization of a matrix pair (A,B):
-*>
-*> A = Q*S*Z**T, B = Q*P*Z**T
-*>
-*> as computed by SGGHRD + SHGEQZ.
-*>
-*> The right eigenvector x and the left eigenvector y of (S,P)
-*> corresponding to an eigenvalue w are defined by:
-*>
-*> S*x = w*P*x, (y**H)*S = w*(y**H)*P,
-*>
-*> where y**H denotes the conjugate tranpose of y.
-*> The eigenvalues are not input to this routine, but are computed
-*> directly from the diagonal blocks of S and P.
-*>
-*> This routine returns the matrices X and/or Y of right and left
-*> eigenvectors of (S,P), or the products Z*X and/or Q*Y,
-*> where Z and Q are input matrices.
-*> If Q and Z are the orthogonal factors from the generalized Schur
-*> factorization of a matrix pair (A,B), then Z*X and Q*Y
-*> are the matrices of right and left eigenvectors of (A,B).
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute all right and/or left eigenvectors;
-*> = 'B': compute all right and/or left eigenvectors,
-*> backtransformed by the matrices in VR and/or VL;
-*> = 'S': compute selected right and/or left eigenvectors,
-*> specified by the logical array SELECT.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY='S', SELECT specifies the eigenvectors to be
-*> computed. If w(j) is a real eigenvalue, the corresponding
-*> real eigenvector is computed if SELECT(j) is .TRUE..
-*> If w(j) and w(j+1) are the real and imaginary parts of a
-*> complex eigenvalue, the corresponding complex eigenvector
-*> is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
-*> and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
-*> set to .FALSE..
-*> Not referenced if HOWMNY = 'A' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices S and P. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is REAL array, dimension (LDS,N)
-*> The upper quasi-triangular matrix S from a generalized Schur
-*> factorization, as computed by SHGEQZ.
-*> \endverbatim
-*>
-*> \param[in] LDS
-*> \verbatim
-*> LDS is INTEGER
-*> The leading dimension of array S. LDS >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is REAL array, dimension (LDP,N)
-*> The upper triangular matrix P from a generalized Schur
-*> factorization, as computed by SHGEQZ.
-*> 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
-*> of S must be in positive diagonal form.
-*> \endverbatim
-*>
-*> \param[in] LDP
-*> \verbatim
-*> LDP is INTEGER
-*> The leading dimension of array P. LDP >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,MM)
-*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of left Schur vectors returned by SHGEQZ).
-*> On exit, if SIDE = 'L' or 'B', VL contains:
-*> if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
-*> if HOWMNY = 'B', the matrix Q*Y;
-*> if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
-*> SELECT, stored consecutively in the columns of
-*> VL, in the same order as their eigenvalues.
-*>
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part, and the second the imaginary part.
-*>
-*> Not referenced if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of array VL. LDVL >= 1, and if
-*> SIDE = 'L' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,MM)
-*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*> contain an N-by-N matrix Z (usually the orthogonal matrix Z
-*> of right Schur vectors returned by SHGEQZ).
-*>
-*> On exit, if SIDE = 'R' or 'B', VR contains:
-*> if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
-*> if HOWMNY = 'B' or 'b', the matrix Z*X;
-*> if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
-*> specified by SELECT, stored consecutively in the
-*> columns of VR, in the same order as their
-*> eigenvalues.
-*>
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part and the second the imaginary part.
-*>
-*> Not referenced if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> SIDE = 'R' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR actually
-*> used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
-*> is set to N. Each selected real eigenvector occupies one
-*> column and each selected complex eigenvector occupies two
-*> columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (6*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: the 2-by-2 block (INFO:INFO+1) does not have a complex
-*> eigenvalue.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Allocation of workspace:
-*> ---------- -- ---------
-*>
-*> WORK( j ) = 1-norm of j-th column of A, above the diagonal
-*> WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
-*> WORK( 2*N+1:3*N ) = real part of eigenvector
-*> WORK( 3*N+1:4*N ) = imaginary part of eigenvector
-*> WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
-*> WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
-*>
-*> Rowwise vs. columnwise solution methods:
-*> ------- -- ---------- -------- -------
-*>
-*> Finding a generalized eigenvector consists basically of solving the
-*> singular triangular system
-*>
-*> (A - w B) x = 0 (for right) or: (A - w B)**H y = 0 (for left)
-*>
-*> Consider finding the i-th right eigenvector (assume all eigenvalues
-*> are real). The equation to be solved is:
-*> n i
-*> 0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. . .,1
-*> k=j k=j
-*>
-*> where C = (A - w B) (The components v(i+1:n) are 0.)
-*>
-*> The "rowwise" method is:
-*>
-*> (1) v(i) := 1
-*> for j = i-1,. . .,1:
-*> i
-*> (2) compute s = - sum C(j,k) v(k) and
-*> k=j+1
-*>
-*> (3) v(j) := s / C(j,j)
-*>
-*> Step 2 is sometimes called the "dot product" step, since it is an
-*> inner product between the j-th row and the portion of the eigenvector
-*> that has been computed so far.
-*>
-*> The "columnwise" method consists basically in doing the sums
-*> for all the rows in parallel. As each v(j) is computed, the
-*> contribution of v(j) times the j-th column of C is added to the
-*> partial sums. Since FORTRAN arrays are stored columnwise, this has
-*> the advantage that at each step, the elements of C that are accessed
-*> are adjacent to one another, whereas with the rowwise method, the
-*> elements accessed at a step are spaced LDS (and LDP) words apart.
-*>
-*> When finding left eigenvectors, the matrix in question is the
-*> transpose of the one in storage, so the rowwise method then
-*> actually accesses columns of A and B at each step, and so is the
-*> preferred method.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
- $ LDVL, VR, LDVR, MM, M, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- REAL P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, SAFETY
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0,
- $ SAFETY = 1.0E+2 )
-* ..
-* .. Local Scalars ..
- LOGICAL COMPL, COMPR, IL2BY2, ILABAD, ILALL, ILBACK,
- $ ILBBAD, ILCOMP, ILCPLX, LSA, LSB
- INTEGER I, IBEG, IEIG, IEND, IHWMNY, IINFO, IM, ISIDE,
- $ J, JA, JC, JE, JR, JW, NA, NW
- REAL ACOEF, ACOEFA, ANORM, ASCALE, BCOEFA, BCOEFI,
- $ BCOEFR, BIG, BIGNUM, BNORM, BSCALE, CIM2A,
- $ CIM2B, CIMAGA, CIMAGB, CRE2A, CRE2B, CREALA,
- $ CREALB, DMIN, SAFMIN, SALFAR, SBETA, SCALE,
- $ SMALL, TEMP, TEMP2, TEMP2I, TEMP2R, ULP, XMAX,
- $ XSCALE
-* ..
-* .. Local Arrays ..
- REAL BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
- $ SUMP( 2, 2 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SLABAD, SLACPY, SLAG2, SLALN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters
-*
- IF( LSAME( HOWMNY, 'A' ) ) THEN
- IHWMNY = 1
- ILALL = .TRUE.
- ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'S' ) ) THEN
- IHWMNY = 2
- ILALL = .FALSE.
- ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
- IHWMNY = 3
- ILALL = .TRUE.
- ILBACK = .TRUE.
- ELSE
- IHWMNY = -1
- ILALL = .TRUE.
- END IF
-*
- IF( LSAME( SIDE, 'R' ) ) THEN
- ISIDE = 1
- COMPL = .FALSE.
- COMPR = .TRUE.
- ELSE IF( LSAME( SIDE, 'L' ) ) THEN
- ISIDE = 2
- COMPL = .TRUE.
- COMPR = .FALSE.
- ELSE IF( LSAME( SIDE, 'B' ) ) THEN
- ISIDE = 3
- COMPL = .TRUE.
- COMPR = .TRUE.
- ELSE
- ISIDE = -1
- END IF
-*
- INFO = 0
- IF( ISIDE.LT.0 ) THEN
- INFO = -1
- ELSE IF( IHWMNY.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGEVC', -INFO )
- RETURN
- END IF
-*
-* Count the number of eigenvectors to be computed
-*
- IF( .NOT.ILALL ) THEN
- IM = 0
- ILCPLX = .FALSE.
- DO 10 J = 1, N
- IF( ILCPLX ) THEN
- ILCPLX = .FALSE.
- GO TO 10
- END IF
- IF( J.LT.N ) THEN
- IF( S( J+1, J ).NE.ZERO )
- $ ILCPLX = .TRUE.
- END IF
- IF( ILCPLX ) THEN
- IF( SELECT( J ) .OR. SELECT( J+1 ) )
- $ IM = IM + 2
- ELSE
- IF( SELECT( J ) )
- $ IM = IM + 1
- END IF
- 10 CONTINUE
- ELSE
- IM = N
- END IF
-*
-* Check 2-by-2 diagonal blocks of A, B
-*
- ILABAD = .FALSE.
- ILBBAD = .FALSE.
- DO 20 J = 1, N - 1
- IF( S( J+1, J ).NE.ZERO ) THEN
- IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
- $ P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
- IF( J.LT.N-1 ) THEN
- IF( S( J+2, J+1 ).NE.ZERO )
- $ ILABAD = .TRUE.
- END IF
- END IF
- 20 CONTINUE
-*
- IF( ILABAD ) THEN
- INFO = -5
- ELSE IF( ILBBAD ) THEN
- INFO = -7
- ELSE IF( COMPL .AND. LDVL.LT.N .OR. LDVL.LT.1 ) THEN
- INFO = -10
- ELSE IF( COMPR .AND. LDVR.LT.N .OR. LDVR.LT.1 ) THEN
- INFO = -12
- ELSE IF( MM.LT.IM ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGEVC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- M = IM
- IF( N.EQ.0 )
- $ RETURN
-*
-* Machine Constants
-*
- SAFMIN = SLAMCH( 'Safe minimum' )
- BIG = ONE / SAFMIN
- CALL SLABAD( SAFMIN, BIG )
- ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
- SMALL = SAFMIN*N / ULP
- BIG = ONE / SMALL
- BIGNUM = ONE / ( SAFMIN*N )
-*
-* Compute the 1-norm of each column of the strictly upper triangular
-* part (i.e., excluding all elements belonging to the diagonal
-* blocks) of A and B to check for possible overflow in the
-* triangular solver.
-*
- ANORM = ABS( S( 1, 1 ) )
- IF( N.GT.1 )
- $ ANORM = ANORM + ABS( S( 2, 1 ) )
- BNORM = ABS( P( 1, 1 ) )
- WORK( 1 ) = ZERO
- WORK( N+1 ) = ZERO
-*
- DO 50 J = 2, N
- TEMP = ZERO
- TEMP2 = ZERO
- IF( S( J, J-1 ).EQ.ZERO ) THEN
- IEND = J - 1
- ELSE
- IEND = J - 2
- END IF
- DO 30 I = 1, IEND
- TEMP = TEMP + ABS( S( I, J ) )
- TEMP2 = TEMP2 + ABS( P( I, J ) )
- 30 CONTINUE
- WORK( J ) = TEMP
- WORK( N+J ) = TEMP2
- DO 40 I = IEND + 1, MIN( J+1, N )
- TEMP = TEMP + ABS( S( I, J ) )
- TEMP2 = TEMP2 + ABS( P( I, J ) )
- 40 CONTINUE
- ANORM = MAX( ANORM, TEMP )
- BNORM = MAX( BNORM, TEMP2 )
- 50 CONTINUE
-*
- ASCALE = ONE / MAX( ANORM, SAFMIN )
- BSCALE = ONE / MAX( BNORM, SAFMIN )
-*
-* Left eigenvectors
-*
- IF( COMPL ) THEN
- IEIG = 0
-*
-* Main loop over eigenvalues
-*
- ILCPLX = .FALSE.
- DO 220 JE = 1, N
-*
-* Skip this iteration if (a) HOWMNY='S' and SELECT=.FALSE., or
-* (b) this would be the second of a complex pair.
-* Check for complex eigenvalue, so as to be sure of which
-* entry(-ies) of SELECT to look at.
-*
- IF( ILCPLX ) THEN
- ILCPLX = .FALSE.
- GO TO 220
- END IF
- NW = 1
- IF( JE.LT.N ) THEN
- IF( S( JE+1, JE ).NE.ZERO ) THEN
- ILCPLX = .TRUE.
- NW = 2
- END IF
- END IF
- IF( ILALL ) THEN
- ILCOMP = .TRUE.
- ELSE IF( ILCPLX ) THEN
- ILCOMP = SELECT( JE ) .OR. SELECT( JE+1 )
- ELSE
- ILCOMP = SELECT( JE )
- END IF
- IF( .NOT.ILCOMP )
- $ GO TO 220
-*
-* Decide if (a) singular pencil, (b) real eigenvalue, or
-* (c) complex eigenvalue.
-*
- IF( .NOT.ILCPLX ) THEN
- IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
-*
-* Singular matrix pencil -- return unit eigenvector
-*
- IEIG = IEIG + 1
- DO 60 JR = 1, N
- VL( JR, IEIG ) = ZERO
- 60 CONTINUE
- VL( IEIG, IEIG ) = ONE
- GO TO 220
- END IF
- END IF
-*
-* Clear vector
-*
- DO 70 JR = 1, NW*N
- WORK( 2*N+JR ) = ZERO
- 70 CONTINUE
-* T
-* Compute coefficients in ( a A - b B ) y = 0
-* a is ACOEF
-* b is BCOEFR + i*BCOEFI
-*
- IF( .NOT.ILCPLX ) THEN
-*
-* Real eigenvalue
-*
- TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
- $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
- SBETA = ( TEMP*P( JE, JE ) )*BSCALE
- ACOEF = SBETA*ASCALE
- BCOEFR = SALFAR*BSCALE
- BCOEFI = ZERO
-*
-* Scale to avoid underflow
-*
- SCALE = ONE
- LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEF ).LT.SMALL
- LSB = ABS( SALFAR ).GE.SAFMIN .AND. ABS( BCOEFR ).LT.
- $ SMALL
- IF( LSA )
- $ SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
- IF( LSB )
- $ SCALE = MAX( SCALE, ( SMALL / ABS( SALFAR ) )*
- $ MIN( BNORM, BIG ) )
- IF( LSA .OR. LSB ) THEN
- SCALE = MIN( SCALE, ONE /
- $ ( SAFMIN*MAX( ONE, ABS( ACOEF ),
- $ ABS( BCOEFR ) ) ) )
- IF( LSA ) THEN
- ACOEF = ASCALE*( SCALE*SBETA )
- ELSE
- ACOEF = SCALE*ACOEF
- END IF
- IF( LSB ) THEN
- BCOEFR = BSCALE*( SCALE*SALFAR )
- ELSE
- BCOEFR = SCALE*BCOEFR
- END IF
- END IF
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR )
-*
-* First component is 1
-*
- WORK( 2*N+JE ) = ONE
- XMAX = ONE
- ELSE
-*
-* Complex eigenvalue
-*
- CALL SLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
- $ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
- $ BCOEFI )
- BCOEFI = -BCOEFI
- IF( BCOEFI.EQ.ZERO ) THEN
- INFO = JE
- RETURN
- END IF
-*
-* Scale to avoid over/underflow
-*
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- SCALE = ONE
- IF( ACOEFA*ULP.LT.SAFMIN .AND. ACOEFA.GE.SAFMIN )
- $ SCALE = ( SAFMIN / ULP ) / ACOEFA
- IF( BCOEFA*ULP.LT.SAFMIN .AND. BCOEFA.GE.SAFMIN )
- $ SCALE = MAX( SCALE, ( SAFMIN / ULP ) / BCOEFA )
- IF( SAFMIN*ACOEFA.GT.ASCALE )
- $ SCALE = ASCALE / ( SAFMIN*ACOEFA )
- IF( SAFMIN*BCOEFA.GT.BSCALE )
- $ SCALE = MIN( SCALE, BSCALE / ( SAFMIN*BCOEFA ) )
- IF( SCALE.NE.ONE ) THEN
- ACOEF = SCALE*ACOEF
- ACOEFA = ABS( ACOEF )
- BCOEFR = SCALE*BCOEFR
- BCOEFI = SCALE*BCOEFI
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- END IF
-*
-* Compute first two components of eigenvector
-*
- TEMP = ACOEF*S( JE+1, JE )
- TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
- TEMP2I = -BCOEFI*P( JE, JE )
- IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
- WORK( 2*N+JE ) = ONE
- WORK( 3*N+JE ) = ZERO
- WORK( 2*N+JE+1 ) = -TEMP2R / TEMP
- WORK( 3*N+JE+1 ) = -TEMP2I / TEMP
- ELSE
- WORK( 2*N+JE+1 ) = ONE
- WORK( 3*N+JE+1 ) = ZERO
- TEMP = ACOEF*S( JE, JE+1 )
- WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
- $ S( JE+1, JE+1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
- END IF
- XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
- $ ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
- END IF
-*
- DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-* T
-* Triangular solve of (a A - b B) y = 0
-*
-* T
-* (rowwise in (a A - b B) , or columnwise in (a A - b B) )
-*
- IL2BY2 = .FALSE.
-*
- DO 160 J = JE + NW, N
- IF( IL2BY2 ) THEN
- IL2BY2 = .FALSE.
- GO TO 160
- END IF
-*
- NA = 1
- BDIAG( 1 ) = P( J, J )
- IF( J.LT.N ) THEN
- IF( S( J+1, J ).NE.ZERO ) THEN
- IL2BY2 = .TRUE.
- BDIAG( 2 ) = P( J+1, J+1 )
- NA = 2
- END IF
- END IF
-*
-* Check whether scaling is necessary for dot products
-*
- XSCALE = ONE / MAX( ONE, XMAX )
- TEMP = MAX( WORK( J ), WORK( N+J ),
- $ ACOEFA*WORK( J )+BCOEFA*WORK( N+J ) )
- IF( IL2BY2 )
- $ TEMP = MAX( TEMP, WORK( J+1 ), WORK( N+J+1 ),
- $ ACOEFA*WORK( J+1 )+BCOEFA*WORK( N+J+1 ) )
- IF( TEMP.GT.BIGNUM*XSCALE ) THEN
- DO 90 JW = 0, NW - 1
- DO 80 JR = JE, J - 1
- WORK( ( JW+2 )*N+JR ) = XSCALE*
- $ WORK( ( JW+2 )*N+JR )
- 80 CONTINUE
- 90 CONTINUE
- XMAX = XMAX*XSCALE
- END IF
-*
-* Compute dot products
-*
-* j-1
-* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
-* k=je
-*
-* To reduce the op count, this is done as
-*
-* _ j-1 _ j-1
-* a*conjg( sum S(k,j)*x(k) ) - b*conjg( sum P(k,j)*x(k) )
-* k=je k=je
-*
-* which may cause underflow problems if A or B are close
-* to underflow. (E.g., less than SMALL.)
-*
-*
- DO 120 JW = 1, NW
- DO 110 JA = 1, NA
- SUMS( JA, JW ) = ZERO
- SUMP( JA, JW ) = ZERO
-*
- DO 100 JR = JE, J - 1
- SUMS( JA, JW ) = SUMS( JA, JW ) +
- $ S( JR, J+JA-1 )*
- $ WORK( ( JW+1 )*N+JR )
- SUMP( JA, JW ) = SUMP( JA, JW ) +
- $ P( JR, J+JA-1 )*
- $ WORK( ( JW+1 )*N+JR )
- 100 CONTINUE
- 110 CONTINUE
- 120 CONTINUE
-*
- DO 130 JA = 1, NA
- IF( ILCPLX ) THEN
- SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
- $ BCOEFR*SUMP( JA, 1 ) -
- $ BCOEFI*SUMP( JA, 2 )
- SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
- $ BCOEFR*SUMP( JA, 2 ) +
- $ BCOEFI*SUMP( JA, 1 )
- ELSE
- SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
- $ BCOEFR*SUMP( JA, 1 )
- END IF
- 130 CONTINUE
-*
-* T
-* Solve ( a A - b B ) y = SUM(,)
-* with scaling and perturbation of the denominator
-*
- CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
- $ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
- $ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
- $ IINFO )
- IF( SCALE.LT.ONE ) THEN
- DO 150 JW = 0, NW - 1
- DO 140 JR = JE, J - 1
- WORK( ( JW+2 )*N+JR ) = SCALE*
- $ WORK( ( JW+2 )*N+JR )
- 140 CONTINUE
- 150 CONTINUE
- XMAX = SCALE*XMAX
- END IF
- XMAX = MAX( XMAX, TEMP )
- 160 CONTINUE
-*
-* Copy eigenvector to VL, back transforming if
-* HOWMNY='B'.
-*
- IEIG = IEIG + 1
- IF( ILBACK ) THEN
- DO 170 JW = 0, NW - 1
- CALL SGEMV( 'N', N, N+1-JE, ONE, VL( 1, JE ), LDVL,
- $ WORK( ( JW+2 )*N+JE ), 1, ZERO,
- $ WORK( ( JW+4 )*N+1 ), 1 )
- 170 CONTINUE
- CALL SLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, JE ),
- $ LDVL )
- IBEG = 1
- ELSE
- CALL SLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, IEIG ),
- $ LDVL )
- IBEG = JE
- END IF
-*
-* Scale eigenvector
-*
- XMAX = ZERO
- IF( ILCPLX ) THEN
- DO 180 J = IBEG, N
- XMAX = MAX( XMAX, ABS( VL( J, IEIG ) )+
- $ ABS( VL( J, IEIG+1 ) ) )
- 180 CONTINUE
- ELSE
- DO 190 J = IBEG, N
- XMAX = MAX( XMAX, ABS( VL( J, IEIG ) ) )
- 190 CONTINUE
- END IF
-*
- IF( XMAX.GT.SAFMIN ) THEN
- XSCALE = ONE / XMAX
-*
- DO 210 JW = 0, NW - 1
- DO 200 JR = IBEG, N
- VL( JR, IEIG+JW ) = XSCALE*VL( JR, IEIG+JW )
- 200 CONTINUE
- 210 CONTINUE
- END IF
- IEIG = IEIG + NW - 1
-*
- 220 CONTINUE
- END IF
-*
-* Right eigenvectors
-*
- IF( COMPR ) THEN
- IEIG = IM + 1
-*
-* Main loop over eigenvalues
-*
- ILCPLX = .FALSE.
- DO 500 JE = N, 1, -1
-*
-* Skip this iteration if (a) HOWMNY='S' and SELECT=.FALSE., or
-* (b) this would be the second of a complex pair.
-* Check for complex eigenvalue, so as to be sure of which
-* entry(-ies) of SELECT to look at -- if complex, SELECT(JE)
-* or SELECT(JE-1).
-* If this is a complex pair, the 2-by-2 diagonal block
-* corresponding to the eigenvalue is in rows/columns JE-1:JE
-*
- IF( ILCPLX ) THEN
- ILCPLX = .FALSE.
- GO TO 500
- END IF
- NW = 1
- IF( JE.GT.1 ) THEN
- IF( S( JE, JE-1 ).NE.ZERO ) THEN
- ILCPLX = .TRUE.
- NW = 2
- END IF
- END IF
- IF( ILALL ) THEN
- ILCOMP = .TRUE.
- ELSE IF( ILCPLX ) THEN
- ILCOMP = SELECT( JE ) .OR. SELECT( JE-1 )
- ELSE
- ILCOMP = SELECT( JE )
- END IF
- IF( .NOT.ILCOMP )
- $ GO TO 500
-*
-* Decide if (a) singular pencil, (b) real eigenvalue, or
-* (c) complex eigenvalue.
-*
- IF( .NOT.ILCPLX ) THEN
- IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
-*
-* Singular matrix pencil -- unit eigenvector
-*
- IEIG = IEIG - 1
- DO 230 JR = 1, N
- VR( JR, IEIG ) = ZERO
- 230 CONTINUE
- VR( IEIG, IEIG ) = ONE
- GO TO 500
- END IF
- END IF
-*
-* Clear vector
-*
- DO 250 JW = 0, NW - 1
- DO 240 JR = 1, N
- WORK( ( JW+2 )*N+JR ) = ZERO
- 240 CONTINUE
- 250 CONTINUE
-*
-* Compute coefficients in ( a A - b B ) x = 0
-* a is ACOEF
-* b is BCOEFR + i*BCOEFI
-*
- IF( .NOT.ILCPLX ) THEN
-*
-* Real eigenvalue
-*
- TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
- $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
- SBETA = ( TEMP*P( JE, JE ) )*BSCALE
- ACOEF = SBETA*ASCALE
- BCOEFR = SALFAR*BSCALE
- BCOEFI = ZERO
-*
-* Scale to avoid underflow
-*
- SCALE = ONE
- LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEF ).LT.SMALL
- LSB = ABS( SALFAR ).GE.SAFMIN .AND. ABS( BCOEFR ).LT.
- $ SMALL
- IF( LSA )
- $ SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
- IF( LSB )
- $ SCALE = MAX( SCALE, ( SMALL / ABS( SALFAR ) )*
- $ MIN( BNORM, BIG ) )
- IF( LSA .OR. LSB ) THEN
- SCALE = MIN( SCALE, ONE /
- $ ( SAFMIN*MAX( ONE, ABS( ACOEF ),
- $ ABS( BCOEFR ) ) ) )
- IF( LSA ) THEN
- ACOEF = ASCALE*( SCALE*SBETA )
- ELSE
- ACOEF = SCALE*ACOEF
- END IF
- IF( LSB ) THEN
- BCOEFR = BSCALE*( SCALE*SALFAR )
- ELSE
- BCOEFR = SCALE*BCOEFR
- END IF
- END IF
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR )
-*
-* First component is 1
-*
- WORK( 2*N+JE ) = ONE
- XMAX = ONE
-*
-* Compute contribution from column JE of A and B to sum
-* (See "Further Details", above.)
-*
- DO 260 JR = 1, JE - 1
- WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
- $ ACOEF*S( JR, JE )
- 260 CONTINUE
- ELSE
-*
-* Complex eigenvalue
-*
- CALL SLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
- $ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
- $ BCOEFI )
- IF( BCOEFI.EQ.ZERO ) THEN
- INFO = JE - 1
- RETURN
- END IF
-*
-* Scale to avoid over/underflow
-*
- ACOEFA = ABS( ACOEF )
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- SCALE = ONE
- IF( ACOEFA*ULP.LT.SAFMIN .AND. ACOEFA.GE.SAFMIN )
- $ SCALE = ( SAFMIN / ULP ) / ACOEFA
- IF( BCOEFA*ULP.LT.SAFMIN .AND. BCOEFA.GE.SAFMIN )
- $ SCALE = MAX( SCALE, ( SAFMIN / ULP ) / BCOEFA )
- IF( SAFMIN*ACOEFA.GT.ASCALE )
- $ SCALE = ASCALE / ( SAFMIN*ACOEFA )
- IF( SAFMIN*BCOEFA.GT.BSCALE )
- $ SCALE = MIN( SCALE, BSCALE / ( SAFMIN*BCOEFA ) )
- IF( SCALE.NE.ONE ) THEN
- ACOEF = SCALE*ACOEF
- ACOEFA = ABS( ACOEF )
- BCOEFR = SCALE*BCOEFR
- BCOEFI = SCALE*BCOEFI
- BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
- END IF
-*
-* Compute first two components of eigenvector
-* and contribution to sums
-*
- TEMP = ACOEF*S( JE, JE-1 )
- TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
- TEMP2I = -BCOEFI*P( JE, JE )
- IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
- WORK( 2*N+JE ) = ONE
- WORK( 3*N+JE ) = ZERO
- WORK( 2*N+JE-1 ) = -TEMP2R / TEMP
- WORK( 3*N+JE-1 ) = -TEMP2I / TEMP
- ELSE
- WORK( 2*N+JE-1 ) = ONE
- WORK( 3*N+JE-1 ) = ZERO
- TEMP = ACOEF*S( JE-1, JE )
- WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
- $ S( JE-1, JE-1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
- END IF
-*
- XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
- $ ABS( WORK( 2*N+JE-1 ) )+ABS( WORK( 3*N+JE-1 ) ) )
-*
-* Compute contribution from columns JE and JE-1
-* of A and B to the sums.
-*
- CREALA = ACOEF*WORK( 2*N+JE-1 )
- CIMAGA = ACOEF*WORK( 3*N+JE-1 )
- CREALB = BCOEFR*WORK( 2*N+JE-1 ) -
- $ BCOEFI*WORK( 3*N+JE-1 )
- CIMAGB = BCOEFI*WORK( 2*N+JE-1 ) +
- $ BCOEFR*WORK( 3*N+JE-1 )
- CRE2A = ACOEF*WORK( 2*N+JE )
- CIM2A = ACOEF*WORK( 3*N+JE )
- CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
- CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
- DO 270 JR = 1, JE - 2
- WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
- $ CREALB*P( JR, JE-1 ) -
- $ CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
- WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
- $ CIMAGB*P( JR, JE-1 ) -
- $ CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
- 270 CONTINUE
- END IF
-*
- DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-* Columnwise triangular solve of (a A - b B) x = 0
-*
- IL2BY2 = .FALSE.
- DO 370 J = JE - NW, 1, -1
-*
-* If a 2-by-2 block, is in position j-1:j, wait until
-* next iteration to process it (when it will be j:j+1)
-*
- IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
- IF( S( J, J-1 ).NE.ZERO ) THEN
- IL2BY2 = .TRUE.
- GO TO 370
- END IF
- END IF
- BDIAG( 1 ) = P( J, J )
- IF( IL2BY2 ) THEN
- NA = 2
- BDIAG( 2 ) = P( J+1, J+1 )
- ELSE
- NA = 1
- END IF
-*
-* Compute x(j) (and x(j+1), if 2-by-2 block)
-*
- CALL SLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
- $ LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
- $ N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
- $ IINFO )
- IF( SCALE.LT.ONE ) THEN
-*
- DO 290 JW = 0, NW - 1
- DO 280 JR = 1, JE
- WORK( ( JW+2 )*N+JR ) = SCALE*
- $ WORK( ( JW+2 )*N+JR )
- 280 CONTINUE
- 290 CONTINUE
- END IF
- XMAX = MAX( SCALE*XMAX, TEMP )
-*
- DO 310 JW = 1, NW
- DO 300 JA = 1, NA
- WORK( ( JW+1 )*N+J+JA-1 ) = SUM( JA, JW )
- 300 CONTINUE
- 310 CONTINUE
-*
-* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
-*
- IF( J.GT.1 ) THEN
-*
-* Check whether scaling is necessary for sum.
-*
- XSCALE = ONE / MAX( ONE, XMAX )
- TEMP = ACOEFA*WORK( J ) + BCOEFA*WORK( N+J )
- IF( IL2BY2 )
- $ TEMP = MAX( TEMP, ACOEFA*WORK( J+1 )+BCOEFA*
- $ WORK( N+J+1 ) )
- TEMP = MAX( TEMP, ACOEFA, BCOEFA )
- IF( TEMP.GT.BIGNUM*XSCALE ) THEN
-*
- DO 330 JW = 0, NW - 1
- DO 320 JR = 1, JE
- WORK( ( JW+2 )*N+JR ) = XSCALE*
- $ WORK( ( JW+2 )*N+JR )
- 320 CONTINUE
- 330 CONTINUE
- XMAX = XMAX*XSCALE
- END IF
-*
-* Compute the contributions of the off-diagonals of
-* column j (and j+1, if 2-by-2 block) of A and B to the
-* sums.
-*
-*
- DO 360 JA = 1, NA
- IF( ILCPLX ) THEN
- CREALA = ACOEF*WORK( 2*N+J+JA-1 )
- CIMAGA = ACOEF*WORK( 3*N+J+JA-1 )
- CREALB = BCOEFR*WORK( 2*N+J+JA-1 ) -
- $ BCOEFI*WORK( 3*N+J+JA-1 )
- CIMAGB = BCOEFI*WORK( 2*N+J+JA-1 ) +
- $ BCOEFR*WORK( 3*N+J+JA-1 )
- DO 340 JR = 1, J - 1
- WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*S( JR, J+JA-1 ) +
- $ CREALB*P( JR, J+JA-1 )
- WORK( 3*N+JR ) = WORK( 3*N+JR ) -
- $ CIMAGA*S( JR, J+JA-1 ) +
- $ CIMAGB*P( JR, J+JA-1 )
- 340 CONTINUE
- ELSE
- CREALA = ACOEF*WORK( 2*N+J+JA-1 )
- CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
- DO 350 JR = 1, J - 1
- WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*S( JR, J+JA-1 ) +
- $ CREALB*P( JR, J+JA-1 )
- 350 CONTINUE
- END IF
- 360 CONTINUE
- END IF
-*
- IL2BY2 = .FALSE.
- 370 CONTINUE
-*
-* Copy eigenvector to VR, back transforming if
-* HOWMNY='B'.
-*
- IEIG = IEIG - NW
- IF( ILBACK ) THEN
-*
- DO 410 JW = 0, NW - 1
- DO 380 JR = 1, N
- WORK( ( JW+4 )*N+JR ) = WORK( ( JW+2 )*N+1 )*
- $ VR( JR, 1 )
- 380 CONTINUE
-*
-* A series of compiler directives to defeat
-* vectorization for the next loop
-*
-*
- DO 400 JC = 2, JE
- DO 390 JR = 1, N
- WORK( ( JW+4 )*N+JR ) = WORK( ( JW+4 )*N+JR ) +
- $ WORK( ( JW+2 )*N+JC )*VR( JR, JC )
- 390 CONTINUE
- 400 CONTINUE
- 410 CONTINUE
-*
- DO 430 JW = 0, NW - 1
- DO 420 JR = 1, N
- VR( JR, IEIG+JW ) = WORK( ( JW+4 )*N+JR )
- 420 CONTINUE
- 430 CONTINUE
-*
- IEND = N
- ELSE
- DO 450 JW = 0, NW - 1
- DO 440 JR = 1, N
- VR( JR, IEIG+JW ) = WORK( ( JW+2 )*N+JR )
- 440 CONTINUE
- 450 CONTINUE
-*
- IEND = JE
- END IF
-*
-* Scale eigenvector
-*
- XMAX = ZERO
- IF( ILCPLX ) THEN
- DO 460 J = 1, IEND
- XMAX = MAX( XMAX, ABS( VR( J, IEIG ) )+
- $ ABS( VR( J, IEIG+1 ) ) )
- 460 CONTINUE
- ELSE
- DO 470 J = 1, IEND
- XMAX = MAX( XMAX, ABS( VR( J, IEIG ) ) )
- 470 CONTINUE
- END IF
-*
- IF( XMAX.GT.SAFMIN ) THEN
- XSCALE = ONE / XMAX
- DO 490 JW = 0, NW - 1
- DO 480 JR = 1, IEND
- VR( JR, IEIG+JW ) = XSCALE*VR( JR, IEIG+JW )
- 480 CONTINUE
- 490 CONTINUE
- END IF
- 500 CONTINUE
- END IF
-*
- RETURN
-*
-* End of STGEVC
-*
- END
diff --git a/netlib/LAPACK/stgex2.f b/netlib/LAPACK/stgex2.f
deleted file mode 100644
index 7630b11..0000000
--- a/netlib/LAPACK/stgex2.f
+++ /dev/null
@@ -1,699 +0,0 @@
-*> \brief \b STGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGEX2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgex2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgex2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgex2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-* LDZ, J1, N1, N2, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ, WANTZ
-* INTEGER INFO, J1, LDA, LDB, LDQ, LDZ, LWORK, N, N1, N2
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
-*> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
-*> (A, B) by an orthogonal equivalence transformation.
-*>
-*> (A, B) must be in generalized real Schur canonical form (as returned
-*> by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
-*> diagonal blocks. B is upper triangular.
-*>
-*> Optionally, the matrices Q and Z of generalized Schur vectors are
-*> updated.
-*>
-*> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T
-*> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> .TRUE. : update the left transformation matrix Q;
-*> .FALSE.: do not update Q.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> .TRUE. : update the right transformation matrix Z;
-*> .FALSE.: do not update Z.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL arrays, dimensions (LDA,N)
-*> On entry, the matrix A in the pair (A, B).
-*> On exit, the updated matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL arrays, dimensions (LDB,N)
-*> On entry, the matrix B in the pair (A, B).
-*> On exit, the updated matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDZ,N)
-*> On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
-*> On exit, the updated matrix Q.
-*> Not referenced if WANTQ = .FALSE..
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1.
-*> If WANTQ = .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
-*> On exit, the updated matrix Z.
-*> Not referenced if WANTZ = .FALSE..
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If WANTZ = .TRUE., LDZ >= N.
-*> \endverbatim
-*>
-*> \param[in] J1
-*> \verbatim
-*> J1 is INTEGER
-*> The index to the first block (A11, B11). 1 <= J1 <= N.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The order of the first block (A11, B11). N1 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> The order of the second block (A22, B22). N2 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK)).
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= MAX( N*(N2+N1), (N2+N1)*(N2+N1)*2 )
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: Successful exit
-*> >0: If INFO = 1, the transformed matrix (A, B) would be
-*> too far from generalized Schur form; the blocks are
-*> not swapped and (A, B) and (Q, Z) are unchanged.
-*> The problem of swapping is too ill-conditioned.
-*> <0: If INFO = -16: LWORK is too small. Appropriate value
-*> for LWORK is returned in WORK(1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realGEauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> In the current code both weak and strong stability tests are
-*> performed. The user can omit the strong stability test by changing
-*> the internal logical parameter WANDS to .FALSE.. See ref. [2] for
-*> details.
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*>
-*> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*> Estimation: Theory, Algorithms and Software,
-*> Report UMINF - 94.04, Department of Computing Science, Umea
-*> University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*> Note 87. To appear in Numerical Algorithms, 1996.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, J1, N1, N2, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ, WANTZ
- INTEGER INFO, J1, LDA, LDB, LDQ, LDZ, LWORK, N, N1, N2
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-* Replaced various illegal calls to SCOPY by calls to SLASET, or by DO
-* loops. Sven Hammarling, 1/5/02.
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
- REAL TWENTY
- PARAMETER ( TWENTY = 2.0E+01 )
- INTEGER LDST
- PARAMETER ( LDST = 4 )
- LOGICAL WANDS
- PARAMETER ( WANDS = .TRUE. )
-* ..
-* .. Local Scalars ..
- LOGICAL STRONG, WEAK
- INTEGER I, IDUM, LINFO, M
- REAL BQRA21, BRQA21, DDUM, DNORM, DSCALE, DSUM, EPS,
- $ F, G, SA, SB, SCALE, SMLNUM, SS, THRESH, WS
-* ..
-* .. Local Arrays ..
- INTEGER IWORK( LDST )
- REAL AI( 2 ), AR( 2 ), BE( 2 ), IR( LDST, LDST ),
- $ IRCOP( LDST, LDST ), LI( LDST, LDST ),
- $ LICOP( LDST, LDST ), S( LDST, LDST ),
- $ SCPY( LDST, LDST ), T( LDST, LDST ),
- $ TAUL( LDST ), TAUR( LDST ), TCPY( LDST, LDST )
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGEQR2, SGERQ2, SLACPY, SLAGV2, SLARTG,
- $ SLASET, SLASSQ, SORG2R, SORGR2, SORM2R, SORMR2,
- $ SROT, SSCAL, STGSY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.LE.1 .OR. N1.LE.0 .OR. N2.LE.0 )
- $ RETURN
- IF( N1.GT.N .OR. ( J1+N1 ).GT.N )
- $ RETURN
- M = N1 + N2
- IF( LWORK.LT.MAX( N*M, M*M*2 ) ) THEN
- INFO = -16
- WORK( 1 ) = MAX( N*M, M*M*2 )
- RETURN
- END IF
-*
- WEAK = .FALSE.
- STRONG = .FALSE.
-*
-* Make a local copy of selected block
-*
- CALL SLASET( 'Full', LDST, LDST, ZERO, ZERO, LI, LDST )
- CALL SLASET( 'Full', LDST, LDST, ZERO, ZERO, IR, LDST )
- CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, S, LDST )
- CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, T, LDST )
-*
-* Compute threshold for testing acceptance of swapping.
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- DSCALE = ZERO
- DSUM = ONE
- CALL SLACPY( 'Full', M, M, S, LDST, WORK, M )
- CALL SLASSQ( M*M, WORK, 1, DSCALE, DSUM )
- CALL SLACPY( 'Full', M, M, T, LDST, WORK, M )
- CALL SLASSQ( M*M, WORK, 1, DSCALE, DSUM )
- DNORM = DSCALE*SQRT( DSUM )
-*
-* THRES has been changed from
-* THRESH = MAX( TEN*EPS*SA, SMLNUM )
-* to
-* THRESH = MAX( TWENTY*EPS*SA, SMLNUM )
-* on 04/01/10.
-* "Bug" reported by Ondra Kamenik, confirmed by Julie Langou, fixed by
-* Jim Demmel and Guillaume Revy. See forum post 1783.
-*
- THRESH = MAX( TWENTY*EPS*DNORM, SMLNUM )
-*
- IF( M.EQ.2 ) THEN
-*
-* CASE 1: Swap 1-by-1 and 1-by-1 blocks.
-*
-* Compute orthogonal QL and RQ that swap 1-by-1 and 1-by-1 blocks
-* using Givens rotations and perform the swap tentatively.
-*
- F = S( 2, 2 )*T( 1, 1 ) - T( 2, 2 )*S( 1, 1 )
- G = S( 2, 2 )*T( 1, 2 ) - T( 2, 2 )*S( 1, 2 )
- SB = ABS( T( 2, 2 ) )
- SA = ABS( S( 2, 2 ) )
- CALL SLARTG( F, G, IR( 1, 2 ), IR( 1, 1 ), DDUM )
- IR( 2, 1 ) = -IR( 1, 2 )
- IR( 2, 2 ) = IR( 1, 1 )
- CALL SROT( 2, S( 1, 1 ), 1, S( 1, 2 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- CALL SROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- IF( SA.GE.SB ) THEN
- CALL SLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
- $ DDUM )
- ELSE
- CALL SLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
- $ DDUM )
- END IF
- CALL SROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, LI( 1, 1 ),
- $ LI( 2, 1 ) )
- CALL SROT( 2, T( 1, 1 ), LDST, T( 2, 1 ), LDST, LI( 1, 1 ),
- $ LI( 2, 1 ) )
- LI( 2, 2 ) = LI( 1, 1 )
- LI( 1, 2 ) = -LI( 2, 1 )
-*
-* Weak stability test:
-* |S21| + |T21| <= O(EPS * F-norm((S, T)))
-*
- WS = ABS( S( 2, 1 ) ) + ABS( T( 2, 1 ) )
- WEAK = WS.LE.THRESH
- IF( .NOT.WEAK )
- $ GO TO 70
-*
- IF( WANDS ) THEN
-*
-* Strong stability test:
-* F-norm((A-QL**T*S*QR, B-QL**T*T*QR)) <= O(EPS*F-norm((A, B)))
-*
- CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
- $ M )
- CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
- $ WORK, M )
- CALL SGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- DSCALE = ZERO
- DSUM = ONE
- CALL SLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-*
- CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
- $ M )
- CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL SGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- CALL SLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
- SS = DSCALE*SQRT( DSUM )
- STRONG = SS.LE.THRESH
- IF( .NOT.STRONG )
- $ GO TO 70
- END IF
-*
-* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
-* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
-*
- CALL SROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- CALL SROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- CALL SROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA,
- $ LI( 1, 1 ), LI( 2, 1 ) )
- CALL SROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB,
- $ LI( 1, 1 ), LI( 2, 1 ) )
-*
-* Set N1-by-N2 (2,1) - blocks to ZERO.
-*
- A( J1+1, J1 ) = ZERO
- B( J1+1, J1 ) = ZERO
-*
-* Accumulate transformations into Q and Z if requested.
-*
- IF( WANTZ )
- $ CALL SROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, IR( 1, 1 ),
- $ IR( 2, 1 ) )
- IF( WANTQ )
- $ CALL SROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, LI( 1, 1 ),
- $ LI( 2, 1 ) )
-*
-* Exit with INFO = 0 if swap was successfully performed.
-*
- RETURN
-*
- ELSE
-*
-* CASE 2: Swap 1-by-1 and 2-by-2 blocks, or 2-by-2
-* and 2-by-2 blocks.
-*
-* Solve the generalized Sylvester equation
-* S11 * R - L * S22 = SCALE * S12
-* T11 * R - L * T22 = SCALE * T12
-* for R and L. Solutions in LI and IR.
-*
- CALL SLACPY( 'Full', N1, N2, T( 1, N1+1 ), LDST, LI, LDST )
- CALL SLACPY( 'Full', N1, N2, S( 1, N1+1 ), LDST,
- $ IR( N2+1, N1+1 ), LDST )
- CALL STGSY2( 'N', 0, N1, N2, S, LDST, S( N1+1, N1+1 ), LDST,
- $ IR( N2+1, N1+1 ), LDST, T, LDST, T( N1+1, N1+1 ),
- $ LDST, LI, LDST, SCALE, DSUM, DSCALE, IWORK, IDUM,
- $ LINFO )
-*
-* Compute orthogonal matrix QL:
-*
-* QL**T * LI = [ TL ]
-* [ 0 ]
-* where
-* LI = [ -L ]
-* [ SCALE * identity(N2) ]
-*
- DO 10 I = 1, N2
- CALL SSCAL( N1, -ONE, LI( 1, I ), 1 )
- LI( N1+I, I ) = SCALE
- 10 CONTINUE
- CALL SGEQR2( M, N2, LI, LDST, TAUL, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL SORG2R( M, M, N2, LI, LDST, TAUL, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Compute orthogonal matrix RQ:
-*
-* IR * RQ**T = [ 0 TR],
-*
-* where IR = [ SCALE * identity(N1), R ]
-*
- DO 20 I = 1, N1
- IR( N2+I, I ) = SCALE
- 20 CONTINUE
- CALL SGERQ2( N1, M, IR( N2+1, 1 ), LDST, TAUR, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL SORGR2( M, M, N1, IR, LDST, TAUR, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Perform the swapping tentatively:
-*
- CALL SGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
- $ WORK, M )
- CALL SGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, S,
- $ LDST )
- CALL SGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL SGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, T,
- $ LDST )
- CALL SLACPY( 'F', M, M, S, LDST, SCPY, LDST )
- CALL SLACPY( 'F', M, M, T, LDST, TCPY, LDST )
- CALL SLACPY( 'F', M, M, IR, LDST, IRCOP, LDST )
- CALL SLACPY( 'F', M, M, LI, LDST, LICOP, LDST )
-*
-* Triangularize the B-part by an RQ factorization.
-* Apply transformation (from left) to A-part, giving S.
-*
- CALL SGERQ2( M, M, T, LDST, TAUR, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL SORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, WORK,
- $ LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL SORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, WORK,
- $ LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Compute F-norm(S21) in BRQA21. (T21 is 0.)
-*
- DSCALE = ZERO
- DSUM = ONE
- DO 30 I = 1, N2
- CALL SLASSQ( N1, S( N2+1, I ), 1, DSCALE, DSUM )
- 30 CONTINUE
- BRQA21 = DSCALE*SQRT( DSUM )
-*
-* Triangularize the B-part by a QR factorization.
-* Apply transformation (from right) to A-part, giving S.
-*
- CALL SGEQR2( M, M, TCPY, LDST, TAUL, WORK, LINFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
- CALL SORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, LDST,
- $ WORK, INFO )
- CALL SORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, LDST,
- $ WORK, INFO )
- IF( LINFO.NE.0 )
- $ GO TO 70
-*
-* Compute F-norm(S21) in BQRA21. (T21 is 0.)
-*
- DSCALE = ZERO
- DSUM = ONE
- DO 40 I = 1, N2
- CALL SLASSQ( N1, SCPY( N2+1, I ), 1, DSCALE, DSUM )
- 40 CONTINUE
- BQRA21 = DSCALE*SQRT( DSUM )
-*
-* Decide which method to use.
-* Weak stability test:
-* F-norm(S21) <= O(EPS * F-norm((S, T)))
-*
- IF( BQRA21.LE.BRQA21 .AND. BQRA21.LE.THRESH ) THEN
- CALL SLACPY( 'F', M, M, SCPY, LDST, S, LDST )
- CALL SLACPY( 'F', M, M, TCPY, LDST, T, LDST )
- CALL SLACPY( 'F', M, M, IRCOP, LDST, IR, LDST )
- CALL SLACPY( 'F', M, M, LICOP, LDST, LI, LDST )
- ELSE IF( BRQA21.GE.THRESH ) THEN
- GO TO 70
- END IF
-*
-* Set lower triangle of B-part to zero
-*
- CALL SLASET( 'Lower', M-1, M-1, ZERO, ZERO, T(2,1), LDST )
-*
- IF( WANDS ) THEN
-*
-* Strong stability test:
-* F-norm((A-QL*S*QR**T, B-QL*T*QR**T)) <= O(EPS*F-norm((A,B)))
-*
- CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
- $ M )
- CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
- $ WORK, M )
- CALL SGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- DSCALE = ZERO
- DSUM = ONE
- CALL SLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-*
- CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
- $ M )
- CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL SGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
- $ WORK( M*M+1 ), M )
- CALL SLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
- SS = DSCALE*SQRT( DSUM )
- STRONG = ( SS.LE.THRESH )
- IF( .NOT.STRONG )
- $ GO TO 70
-*
- END IF
-*
-* If the swap is accepted ("weakly" and "strongly"), apply the
-* transformations and set N1-by-N2 (2,1)-block to zero.
-*
- CALL SLASET( 'Full', N1, N2, ZERO, ZERO, S(N2+1,1), LDST )
-*
-* copy back M-by-M diagonal block starting at index J1 of (A, B)
-*
- CALL SLACPY( 'F', M, M, S, LDST, A( J1, J1 ), LDA )
- CALL SLACPY( 'F', M, M, T, LDST, B( J1, J1 ), LDB )
- CALL SLASET( 'Full', LDST, LDST, ZERO, ZERO, T, LDST )
-*
-* Standardize existing 2-by-2 blocks.
-*
- DO 50 I = 1, M*M
- WORK(I) = ZERO
- 50 CONTINUE
- WORK( 1 ) = ONE
- T( 1, 1 ) = ONE
- IDUM = LWORK - M*M - 2
- IF( N2.GT.1 ) THEN
- CALL SLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, BE,
- $ WORK( 1 ), WORK( 2 ), T( 1, 1 ), T( 2, 1 ) )
- WORK( M+1 ) = -WORK( 2 )
- WORK( M+2 ) = WORK( 1 )
- T( N2, N2 ) = T( 1, 1 )
- T( 1, 2 ) = -T( 2, 1 )
- END IF
- WORK( M*M ) = ONE
- T( M, M ) = ONE
-*
- IF( N1.GT.1 ) THEN
- CALL SLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), LDB,
- $ TAUR, TAUL, WORK( M*M+1 ), WORK( N2*M+N2+1 ),
- $ WORK( N2*M+N2+2 ), T( N2+1, N2+1 ),
- $ T( M, M-1 ) )
- WORK( M*M ) = WORK( N2*M+N2+1 )
- WORK( M*M-1 ) = -WORK( N2*M+N2+2 )
- T( M, M ) = T( N2+1, N2+1 )
- T( M-1, M ) = -T( M, M-1 )
- END IF
- CALL SGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, J1+N2 ),
- $ LDA, ZERO, WORK( M*M+1 ), N2 )
- CALL SLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, J1+N2 ),
- $ LDA )
- CALL SGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, J1+N2 ),
- $ LDB, ZERO, WORK( M*M+1 ), N2 )
- CALL SLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, J1+N2 ),
- $ LDB )
- CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, WORK, M, ZERO,
- $ WORK( M*M+1 ), M )
- CALL SLACPY( 'Full', M, M, WORK( M*M+1 ), M, LI, LDST )
- CALL SGEMM( 'N', 'N', N2, N1, N1, ONE, A( J1, J1+N2 ), LDA,
- $ T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
- CALL SLACPY( 'Full', N2, N1, WORK, N2, A( J1, J1+N2 ), LDA )
- CALL SGEMM( 'N', 'N', N2, N1, N1, ONE, B( J1, J1+N2 ), LDB,
- $ T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
- CALL SLACPY( 'Full', N2, N1, WORK, N2, B( J1, J1+N2 ), LDB )
- CALL SGEMM( 'T', 'N', M, M, M, ONE, IR, LDST, T, LDST, ZERO,
- $ WORK, M )
- CALL SLACPY( 'Full', M, M, WORK, M, IR, LDST )
-*
-* Accumulate transformations into Q and Z if requested.
-*
- IF( WANTQ ) THEN
- CALL SGEMM( 'N', 'N', N, M, M, ONE, Q( 1, J1 ), LDQ, LI,
- $ LDST, ZERO, WORK, N )
- CALL SLACPY( 'Full', N, M, WORK, N, Q( 1, J1 ), LDQ )
-*
- END IF
-*
- IF( WANTZ ) THEN
- CALL SGEMM( 'N', 'N', N, M, M, ONE, Z( 1, J1 ), LDZ, IR,
- $ LDST, ZERO, WORK, N )
- CALL SLACPY( 'Full', N, M, WORK, N, Z( 1, J1 ), LDZ )
-*
- END IF
-*
-* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
-* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
-*
- I = J1 + M
- IF( I.LE.N ) THEN
- CALL SGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
- $ A( J1, I ), LDA, ZERO, WORK, M )
- CALL SLACPY( 'Full', M, N-I+1, WORK, M, A( J1, I ), LDA )
- CALL SGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
- $ B( J1, I ), LDB, ZERO, WORK, M )
- CALL SLACPY( 'Full', M, N-I+1, WORK, M, B( J1, I ), LDB )
- END IF
- I = J1 - 1
- IF( I.GT.0 ) THEN
- CALL SGEMM( 'N', 'N', I, M, M, ONE, A( 1, J1 ), LDA, IR,
- $ LDST, ZERO, WORK, I )
- CALL SLACPY( 'Full', I, M, WORK, I, A( 1, J1 ), LDA )
- CALL SGEMM( 'N', 'N', I, M, M, ONE, B( 1, J1 ), LDB, IR,
- $ LDST, ZERO, WORK, I )
- CALL SLACPY( 'Full', I, M, WORK, I, B( 1, J1 ), LDB )
- END IF
-*
-* Exit with INFO = 0 if swap was successfully performed.
-*
- RETURN
-*
- END IF
-*
-* Exit with INFO = 1 if swap was rejected.
-*
- 70 CONTINUE
-*
- INFO = 1
- RETURN
-*
-* End of STGEX2
-*
- END
diff --git a/netlib/LAPACK/stgexc.f b/netlib/LAPACK/stgexc.f
deleted file mode 100644
index 3991fc1..0000000
--- a/netlib/LAPACK/stgexc.f
+++ /dev/null
@@ -1,544 +0,0 @@
-*> \brief \b STGEXC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGEXC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgexc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgexc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgexc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-* LDZ, IFST, ILST, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ, WANTZ
-* INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGEXC reorders the generalized real Schur decomposition of a real
-*> matrix pair (A,B) using an orthogonal equivalence transformation
-*>
-*> (A, B) = Q * (A, B) * Z**T,
-*>
-*> so that the diagonal block of (A, B) with row index IFST is moved
-*> to row ILST.
-*>
-*> (A, B) must be in generalized real Schur canonical form (as returned
-*> by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
-*> diagonal blocks. B is upper triangular.
-*>
-*> Optionally, the matrices Q and Z of generalized Schur vectors are
-*> updated.
-*>
-*> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T
-*> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> .TRUE. : update the left transformation matrix Q;
-*> .FALSE.: do not update Q.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> .TRUE. : update the right transformation matrix Z;
-*> .FALSE.: do not update Z.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the matrix A in generalized real Schur canonical
-*> form.
-*> On exit, the updated matrix A, again in generalized
-*> real Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the matrix B in generalized real Schur canonical
-*> form (A,B).
-*> On exit, the updated matrix B, again in generalized
-*> real Schur canonical form (A,B).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDZ,N)
-*> On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
-*> On exit, the updated matrix Q.
-*> If WANTQ = .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1.
-*> If WANTQ = .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
-*> On exit, the updated matrix Z.
-*> If WANTZ = .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1.
-*> If WANTZ = .TRUE., LDZ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] IFST
-*> \verbatim
-*> IFST is INTEGER
-*> \endverbatim
-*>
-*> \param[in,out] ILST
-*> \verbatim
-*> ILST is INTEGER
-*> Specify the reordering of the diagonal blocks of (A, B).
-*> The block with row index IFST is moved to row ILST, by a
-*> sequence of swapping between adjacent blocks.
-*> On exit, if IFST pointed on entry to the second row of
-*> a 2-by-2 block, it is changed to point to the first row;
-*> ILST always points to the first row of the block in its
-*> final position (which may differ from its input value by
-*> +1 or -1). 1 <= IFST, ILST <= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: successful exit.
-*> <0: if INFO = -i, the i-th argument had an illegal value.
-*> =1: The transformed matrix pair (A, B) would be too far
-*> from generalized Schur form; the problem is ill-
-*> conditioned. (A, B) may have been partially reordered,
-*> and ILST points to the first row of the current
-*> position of the block being moved.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, IFST, ILST, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ, WANTZ
- INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER HERE, LWMIN, NBF, NBL, NBNEXT
-* ..
-* .. External Subroutines ..
- EXTERNAL STGEX2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test input arguments.
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
- INFO = -9
- ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -11
- ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
- INFO = -12
- ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.LE.1 ) THEN
- LWMIN = 1
- ELSE
- LWMIN = 4*N + 16
- END IF
- WORK(1) = LWMIN
-*
- IF (LWORK.LT.LWMIN .AND. .NOT.LQUERY) THEN
- INFO = -15
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGEXC', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the first row of the specified block and find out
-* if it is 1-by-1 or 2-by-2.
-*
- IF( IFST.GT.1 ) THEN
- IF( A( IFST, IFST-1 ).NE.ZERO )
- $ IFST = IFST - 1
- END IF
- NBF = 1
- IF( IFST.LT.N ) THEN
- IF( A( IFST+1, IFST ).NE.ZERO )
- $ NBF = 2
- END IF
-*
-* Determine the first row of the final block
-* and find out if it is 1-by-1 or 2-by-2.
-*
- IF( ILST.GT.1 ) THEN
- IF( A( ILST, ILST-1 ).NE.ZERO )
- $ ILST = ILST - 1
- END IF
- NBL = 1
- IF( ILST.LT.N ) THEN
- IF( A( ILST+1, ILST ).NE.ZERO )
- $ NBL = 2
- END IF
- IF( IFST.EQ.ILST )
- $ RETURN
-*
- IF( IFST.LT.ILST ) THEN
-*
-* Update ILST.
-*
- IF( NBF.EQ.2 .AND. NBL.EQ.1 )
- $ ILST = ILST - 1
- IF( NBF.EQ.1 .AND. NBL.EQ.2 )
- $ ILST = ILST + 1
-*
- HERE = IFST
-*
- 10 CONTINUE
-*
-* Swap with next one below.
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1-by-1 or 2-by-2.
-*
- NBNEXT = 1
- IF( HERE+NBF+1.LE.N ) THEN
- IF( A( HERE+NBF+1, HERE+NBF ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE, NBF, NBNEXT, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + NBNEXT
-*
-* Test if 2-by-2 block breaks into two 1-by-1 blocks.
-*
- IF( NBF.EQ.2 ) THEN
- IF( A( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1-by-1 blocks, each of which
-* must be swapped individually.
-*
- NBNEXT = 1
- IF( HERE+3.LE.N ) THEN
- IF( A( HERE+3, HERE+2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE+1, 1, NBNEXT, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 1
-*
- ELSE
-*
-* Recompute NBNEXT in case of 2-by-2 split.
-*
- IF( A( HERE+2, HERE+1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2-by-2 block did not split.
-*
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK,
- $ INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 2
- ELSE
-*
-* 2-by-2 block did split.
-*
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 1
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 1
- END IF
-*
- END IF
- END IF
- IF( HERE.LT.ILST )
- $ GO TO 10
- ELSE
- HERE = IFST
-*
- 20 CONTINUE
-*
-* Swap with next one below.
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1-by-1 or 2-by-2.
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( A( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE-NBNEXT, NBNEXT, NBF, WORK, LWORK,
- $ INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - NBNEXT
-*
-* Test if 2-by-2 block breaks into two 1-by-1 blocks.
-*
- IF( NBF.EQ.2 ) THEN
- IF( A( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1-by-1 blocks, each of which
-* must be swapped individually.
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( A( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE-NBNEXT, NBNEXT, 1, WORK, LWORK,
- $ INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
- $ LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 1
- ELSE
-*
-* Recompute NBNEXT in case of 2-by-2 split.
-*
- IF( A( HERE, HERE-1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2-by-2 block did not split.
-*
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE-1, 2, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 2
- ELSE
-*
-* 2-by-2 block did split.
-*
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 1
- CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 1
- END IF
- END IF
- END IF
- IF( HERE.GT.ILST )
- $ GO TO 20
- END IF
- ILST = HERE
- WORK( 1 ) = LWMIN
- RETURN
-*
-* End of STGEXC
-*
- END
diff --git a/netlib/LAPACK/stgsen.f b/netlib/LAPACK/stgsen.f
deleted file mode 100644
index 90e1d94..0000000
--- a/netlib/LAPACK/stgsen.f
+++ /dev/null
@@ -1,863 +0,0 @@
-*> \brief \b STGSEN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGSEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgsen.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgsen.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgsen.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
-* ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
-* PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ, WANTZ
-* INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
-* $ M, N
-* REAL PL, PR
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-* $ B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
-* $ WORK( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGSEN reorders the generalized real Schur decomposition of a real
-*> matrix pair (A, B) (in terms of an orthonormal equivalence trans-
-*> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues
-*> appears in the leading diagonal blocks of the upper quasi-triangular
-*> matrix A and the upper triangular B. The leading columns of Q and
-*> Z form orthonormal bases of the corresponding left and right eigen-
-*> spaces (deflating subspaces). (A, B) must be in generalized real
-*> Schur canonical form (as returned by SGGES), i.e. A is block upper
-*> triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
-*> triangular.
-*>
-*> STGSEN also computes the generalized eigenvalues
-*>
-*> w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
-*>
-*> of the reordered matrix pair (A, B).
-*>
-*> Optionally, STGSEN computes the estimates of reciprocal condition
-*> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
-*> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
-*> between the matrix pairs (A11, B11) and (A22,B22) that correspond to
-*> the selected cluster and the eigenvalues outside the cluster, resp.,
-*> and norms of "projections" onto left and right eigenspaces w.r.t.
-*> the selected cluster in the (1,1)-block.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies whether condition numbers are required for the
-*> cluster of eigenvalues (PL and PR) or the deflating subspaces
-*> (Difu and Difl):
-*> =0: Only reorder w.r.t. SELECT. No extras.
-*> =1: Reciprocal of norms of "projections" onto left and right
-*> eigenspaces w.r.t. the selected cluster (PL and PR).
-*> =2: Upper bounds on Difu and Difl. F-norm-based estimate
-*> (DIF(1:2)).
-*> =3: Estimate of Difu and Difl. 1-norm-based estimate
-*> (DIF(1:2)).
-*> About 5 times as expensive as IJOB = 2.
-*> =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
-*> version to get it all.
-*> =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
-*> \endverbatim
-*>
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> .TRUE. : update the left transformation matrix Q;
-*> .FALSE.: do not update Q.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> .TRUE. : update the right transformation matrix Z;
-*> .FALSE.: do not update Z.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> SELECT specifies the eigenvalues in the selected cluster.
-*> To select a real eigenvalue w(j), SELECT(j) must be set to
-*> .TRUE.. To select a complex conjugate pair of eigenvalues
-*> w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
-*> either SELECT(j) or SELECT(j+1) or both must be set to
-*> .TRUE.; a complex conjugate pair of eigenvalues must be
-*> either both included in the cluster or both excluded.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension(LDA,N)
-*> On entry, the upper quasi-triangular matrix A, with (A, B) in
-*> generalized real Schur canonical form.
-*> On exit, A is overwritten by the reordered matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension(LDB,N)
-*> On entry, the upper triangular matrix B, with (A, B) in
-*> generalized real Schur canonical form.
-*> On exit, B is overwritten by the reordered matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ALPHAR
-*> \verbatim
-*> ALPHAR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] ALPHAI
-*> \verbatim
-*> ALPHAI is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*>
-*> On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*> be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
-*> and BETA(j),j=1,...,N are the diagonals of the complex Schur
-*> form (S,T) that would result if the 2-by-2 diagonal blocks of
-*> the real generalized Schur form of (A,B) were further reduced
-*> to triangular form using complex unitary transformations.
-*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*> positive, then the j-th and (j+1)-st eigenvalues are a
-*> complex conjugate pair, with ALPHAI(j+1) negative.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
-*> On exit, Q has been postmultiplied by the left orthogonal
-*> transformation matrix which reorder (A, B); The leading M
-*> columns of Q form orthonormal bases for the specified pair of
-*> left eigenspaces (deflating subspaces).
-*> If WANTQ = .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= 1;
-*> and if WANTQ = .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is REAL array, dimension (LDZ,N)
-*> On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
-*> On exit, Z has been postmultiplied by the left orthogonal
-*> transformation matrix which reorder (A, B); The leading M
-*> columns of Z form orthonormal bases for the specified pair of
-*> left eigenspaces (deflating subspaces).
-*> If WANTZ = .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= 1;
-*> If WANTZ = .TRUE., LDZ >= N.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The dimension of the specified pair of left and right eigen-
-*> spaces (deflating subspaces). 0 <= M <= N.
-*> \endverbatim
-*>
-*> \param[out] PL
-*> \verbatim
-*> PL is REAL
-*> \endverbatim
-*>
-*> \param[out] PR
-*> \verbatim
-*> PR is REAL
-*>
-*> If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
-*> reciprocal of the norm of "projections" onto left and right
-*> eigenspaces with respect to the selected cluster.
-*> 0 < PL, PR <= 1.
-*> If M = 0 or M = N, PL = PR = 1.
-*> If IJOB = 0, 2 or 3, PL and PR are not referenced.
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is REAL array, dimension (2).
-*> If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
-*> If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
-*> Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
-*> estimates of Difu and Difl.
-*> If M = 0 or N, DIF(1:2) = F-norm([A, B]).
-*> If IJOB = 0 or 1, DIF is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= 4*N+16.
-*> If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
-*> If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK. LIWORK >= 1.
-*> If IJOB = 1, 2 or 4, LIWORK >= N+6.
-*> If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: Successful exit.
-*> <0: If INFO = -i, the i-th argument had an illegal value.
-*> =1: Reordering of (A, B) failed because the transformed
-*> matrix pair (A, B) would be too far from generalized
-*> Schur form; the problem is very ill-conditioned.
-*> (A, B) may have been partially reordered.
-*> If requested, 0 is returned in DIF(*), PL and PR.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> STGSEN first collects the selected eigenvalues by computing
-*> orthogonal U and W that move them to the top left corner of (A, B).
-*> In other words, the selected eigenvalues are the eigenvalues of
-*> (A11, B11) in:
-*>
-*> U**T*(A, B)*W = (A11 A12) (B11 B12) n1
-*> ( 0 A22),( 0 B22) n2
-*> n1 n2 n1 n2
-*>
-*> where N = n1+n2 and U**T means the transpose of U. The first n1 columns
-*> of U and W span the specified pair of left and right eigenspaces
-*> (deflating subspaces) of (A, B).
-*>
-*> If (A, B) has been obtained from the generalized real Schur
-*> decomposition of a matrix pair (C, D) = Q*(A, B)*Z**T, then the
-*> reordered generalized real Schur form of (C, D) is given by
-*>
-*> (C, D) = (Q*U)*(U**T*(A, B)*W)*(Z*W)**T,
-*>
-*> and the first n1 columns of Q*U and Z*W span the corresponding
-*> deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
-*>
-*> Note that if the selected eigenvalue is sufficiently ill-conditioned,
-*> then its value may differ significantly from its value before
-*> reordering.
-*>
-*> The reciprocal condition numbers of the left and right eigenspaces
-*> spanned by the first n1 columns of U and W (or Q*U and Z*W) may
-*> be returned in DIF(1:2), corresponding to Difu and Difl, resp.
-*>
-*> The Difu and Difl are defined as:
-*>
-*> Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
-*> and
-*> Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
-*>
-*> where sigma-min(Zu) is the smallest singular value of the
-*> (2*n1*n2)-by-(2*n1*n2) matrix
-*>
-*> Zu = [ kron(In2, A11) -kron(A22**T, In1) ]
-*> [ kron(In2, B11) -kron(B22**T, In1) ].
-*>
-*> Here, Inx is the identity matrix of size nx and A22**T is the
-*> transpose of A22. kron(X, Y) is the Kronecker product between
-*> the matrices X and Y.
-*>
-*> When DIF(2) is small, small changes in (A, B) can cause large changes
-*> in the deflating subspace. An approximate (asymptotic) bound on the
-*> maximum angular error in the computed deflating subspaces is
-*>
-*> EPS * norm((A, B)) / DIF(2),
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal norm of the projectors on the left and right
-*> eigenspaces associated with (A11, B11) may be returned in PL and PR.
-*> They are computed as follows. First we compute L and R so that
-*> P*(A, B)*Q is block diagonal, where
-*>
-*> P = ( I -L ) n1 Q = ( I R ) n1
-*> ( 0 I ) n2 and ( 0 I ) n2
-*> n1 n2 n1 n2
-*>
-*> and (L, R) is the solution to the generalized Sylvester equation
-*>
-*> A11*R - L*A22 = -A12
-*> B11*R - L*B22 = -B12
-*>
-*> Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
-*> An approximate (asymptotic) bound on the average absolute error of
-*> the selected eigenvalues is
-*>
-*> EPS * norm((A, B)) / PL.
-*>
-*> There are also global error bounds which valid for perturbations up
-*> to a certain restriction: A lower bound (x) on the smallest
-*> F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
-*> coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
-*> (i.e. (A + E, B + F), is
-*>
-*> x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
-*>
-*> An approximate bound on x can be computed from DIF(1:2), PL and PR.
-*>
-*> If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
-*> (L', R') and unperturbed (L, R) left and right deflating subspaces
-*> associated with the selected cluster in the (1,1)-blocks can be
-*> bounded as
-*>
-*> max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
-*> max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
-*>
-*> See LAPACK User's Guide section 4.11 or the following references
-*> for more information.
-*>
-*> Note that if the default method for computing the Frobenius-norm-
-*> based estimate DIF is not wanted (see SLATDF), then the parameter
-*> IDIFJB (see below) should be changed from 3 to 4 (routine SLATDF
-*> (IJOB = 2 will be used)). See STGSYL for more details.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*>
-*> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*> Estimation: Theory, Algorithms and Software,
-*> Report UMINF - 94.04, Department of Computing Science, Umea
-*> University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*> Note 87. To appear in Numerical Algorithms, 1996.
-*>
-*> [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*> for Solving the Generalized Sylvester Equation and Estimating the
-*> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*> Department of Computing Science, Umea University, S-901 87 Umea,
-*> Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*> Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
-*> 1996.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
- $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
- $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ, WANTZ
- INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
- $ M, N
- REAL PL, PR
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
- $ WORK( * ), Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER IDIFJB
- PARAMETER ( IDIFJB = 3 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, PAIR, SWAP, WANTD, WANTD1, WANTD2,
- $ WANTP
- INTEGER I, IERR, IJB, K, KASE, KK, KS, LIWMIN, LWMIN,
- $ MN2, N1, N2
- REAL DSCALE, DSUM, EPS, RDSCAL, SMLNUM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLACPY, SLAG2, SLASSQ, STGEXC, STGSYL,
- $ XERBLA
-* ..
-* .. External Functions ..
- REAL SLAMCH
- EXTERNAL SLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
- IF( IJOB.LT.0 .OR. IJOB.GT.5 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -14
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
- INFO = -16
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGSEN', -INFO )
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- IERR = 0
-*
- WANTP = IJOB.EQ.1 .OR. IJOB.GE.4
- WANTD1 = IJOB.EQ.2 .OR. IJOB.EQ.4
- WANTD2 = IJOB.EQ.3 .OR. IJOB.EQ.5
- WANTD = WANTD1 .OR. WANTD2
-*
-* Set M to the dimension of the specified pair of deflating
-* subspaces.
-*
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
-*
- IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
- LWMIN = MAX( 1, 4*N+16, 2*M*(N-M) )
- LIWMIN = MAX( 1, N+6 )
- ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN
- LWMIN = MAX( 1, 4*N+16, 4*M*(N-M) )
- LIWMIN = MAX( 1, 2*M*(N-M), N+6 )
- ELSE
- LWMIN = MAX( 1, 4*N+16 )
- LIWMIN = 1
- END IF
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -22
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -24
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGSEN', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.N .OR. M.EQ.0 ) THEN
- IF( WANTP ) THEN
- PL = ONE
- PR = ONE
- END IF
- IF( WANTD ) THEN
- DSCALE = ZERO
- DSUM = ONE
- DO 20 I = 1, N
- CALL SLASSQ( N, A( 1, I ), 1, DSCALE, DSUM )
- CALL SLASSQ( N, B( 1, I ), 1, DSCALE, DSUM )
- 20 CONTINUE
- DIF( 1 ) = DSCALE*SQRT( DSUM )
- DIF( 2 ) = DIF( 1 )
- END IF
- GO TO 60
- END IF
-*
-* Collect the selected blocks at the top-left corner of (A, B).
-*
- KS = 0
- PAIR = .FALSE.
- DO 30 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
-*
- SWAP = SELECT( K )
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).NE.ZERO ) THEN
- PAIR = .TRUE.
- SWAP = SWAP .OR. SELECT( K+1 )
- END IF
- END IF
-*
- IF( SWAP ) THEN
- KS = KS + 1
-*
-* Swap the K-th block to position KS.
-* Perform the reordering of diagonal blocks in (A, B)
-* by orthogonal transformation matrices and update
-* Q and Z accordingly (if requested):
-*
- KK = K
- IF( K.NE.KS )
- $ CALL STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
- $ Z, LDZ, KK, KS, WORK, LWORK, IERR )
-*
- IF( IERR.GT.0 ) THEN
-*
-* Swap is rejected: exit.
-*
- INFO = 1
- IF( WANTP ) THEN
- PL = ZERO
- PR = ZERO
- END IF
- IF( WANTD ) THEN
- DIF( 1 ) = ZERO
- DIF( 2 ) = ZERO
- END IF
- GO TO 60
- END IF
-*
- IF( PAIR )
- $ KS = KS + 1
- END IF
- END IF
- 30 CONTINUE
- IF( WANTP ) THEN
-*
-* Solve generalized Sylvester equation for R and L
-* and compute PL and PR.
-*
- N1 = M
- N2 = N - M
- I = N1 + 1
- IJB = 0
- CALL SLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 )
- CALL SLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
- $ N1 )
- CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
- $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
- $ DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
- $ LWORK-2*N1*N2, IWORK, IERR )
-*
-* Estimate the reciprocal of norms of "projections" onto left
-* and right eigenspaces.
-*
- RDSCAL = ZERO
- DSUM = ONE
- CALL SLASSQ( N1*N2, WORK, 1, RDSCAL, DSUM )
- PL = RDSCAL*SQRT( DSUM )
- IF( PL.EQ.ZERO ) THEN
- PL = ONE
- ELSE
- PL = DSCALE / ( SQRT( DSCALE*DSCALE / PL+PL )*SQRT( PL ) )
- END IF
- RDSCAL = ZERO
- DSUM = ONE
- CALL SLASSQ( N1*N2, WORK( N1*N2+1 ), 1, RDSCAL, DSUM )
- PR = RDSCAL*SQRT( DSUM )
- IF( PR.EQ.ZERO ) THEN
- PR = ONE
- ELSE
- PR = DSCALE / ( SQRT( DSCALE*DSCALE / PR+PR )*SQRT( PR ) )
- END IF
- END IF
-*
- IF( WANTD ) THEN
-*
-* Compute estimates of Difu and Difl.
-*
- IF( WANTD1 ) THEN
- N1 = M
- N2 = N - M
- I = N1 + 1
- IJB = IDIFJB
-*
-* Frobenius norm-based Difu-estimate.
-*
- CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
- $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
- $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ),
- $ LWORK-2*N1*N2, IWORK, IERR )
-*
-* Frobenius norm-based Difl-estimate.
-*
- CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
- $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
- $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ),
- $ LWORK-2*N1*N2, IWORK, IERR )
- ELSE
-*
-*
-* Compute 1-norm-based estimates of Difu and Difl using
-* reversed communication with SLACN2. In each step a
-* generalized Sylvester equation or a transposed variant
-* is solved.
-*
- KASE = 0
- N1 = M
- N2 = N - M
- I = N1 + 1
- IJB = 0
- MN2 = 2*N1*N2
-*
-* 1-norm-based estimate of Difu.
-*
- 40 CONTINUE
- CALL SLACN2( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 1 ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Solve generalized Sylvester equation.
-*
- CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
- $ WORK, N1, B, LDB, B( I, I ), LDB,
- $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- ELSE
-*
-* Solve the transposed variant.
-*
- CALL STGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA,
- $ WORK, N1, B, LDB, B( I, I ), LDB,
- $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- END IF
- GO TO 40
- END IF
- DIF( 1 ) = DSCALE / DIF( 1 )
-*
-* 1-norm-based estimate of Difl.
-*
- 50 CONTINUE
- CALL SLACN2( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 2 ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Solve generalized Sylvester equation.
-*
- CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
- $ WORK, N2, B( I, I ), LDB, B, LDB,
- $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- ELSE
-*
-* Solve the transposed variant.
-*
- CALL STGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA,
- $ WORK, N2, B( I, I ), LDB, B, LDB,
- $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
- $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
- $ IERR )
- END IF
- GO TO 50
- END IF
- DIF( 2 ) = DSCALE / DIF( 2 )
-*
- END IF
- END IF
-*
- 60 CONTINUE
-*
-* Compute generalized eigenvalues of reordered pair (A, B) and
-* normalize the generalized Schur form.
-*
- PAIR = .FALSE.
- DO 70 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
-*
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).NE.ZERO ) THEN
- PAIR = .TRUE.
- END IF
- END IF
-*
- IF( PAIR ) THEN
-*
-* Compute the eigenvalue(s) at position K.
-*
- WORK( 1 ) = A( K, K )
- WORK( 2 ) = A( K+1, K )
- WORK( 3 ) = A( K, K+1 )
- WORK( 4 ) = A( K+1, K+1 )
- WORK( 5 ) = B( K, K )
- WORK( 6 ) = B( K+1, K )
- WORK( 7 ) = B( K, K+1 )
- WORK( 8 ) = B( K+1, K+1 )
- CALL SLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ),
- $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ),
- $ ALPHAI( K ) )
- ALPHAI( K+1 ) = -ALPHAI( K )
-*
- ELSE
-*
- IF( SIGN( ONE, B( K, K ) ).LT.ZERO ) THEN
-*
-* If B(K,K) is negative, make it positive
-*
- DO 80 I = 1, N
- A( K, I ) = -A( K, I )
- B( K, I ) = -B( K, I )
- IF( WANTQ ) Q( I, K ) = -Q( I, K )
- 80 CONTINUE
- END IF
-*
- ALPHAR( K ) = A( K, K )
- ALPHAI( K ) = ZERO
- BETA( K ) = B( K, K )
-*
- END IF
- END IF
- 70 CONTINUE
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of STGSEN
-*
- END
diff --git a/netlib/LAPACK/stgsja.f b/netlib/LAPACK/stgsja.f
deleted file mode 100644
index 36a06d9..0000000
--- a/netlib/LAPACK/stgsja.f
+++ /dev/null
@@ -1,655 +0,0 @@
-*> \brief \b STGSJA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGSJA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgsja.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgsja.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgsja.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
-* LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV,
-* Q, LDQ, WORK, NCYCLE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBQ, JOBU, JOBV
-* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N,
-* $ NCYCLE, P
-* REAL TOLA, TOLB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), ALPHA( * ), B( LDB, * ),
-* $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
-* $ V( LDV, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGSJA computes the generalized singular value decomposition (GSVD)
-*> of two real upper triangular (or trapezoidal) matrices A and B.
-*>
-*> On entry, it is assumed that matrices A and B have the following
-*> forms, which may be obtained by the preprocessing subroutine SGGSVP
-*> from a general M-by-N matrix A and P-by-N matrix B:
-*>
-*> N-K-L K L
-*> A = K ( 0 A12 A13 ) if M-K-L >= 0;
-*> L ( 0 0 A23 )
-*> M-K-L ( 0 0 0 )
-*>
-*> N-K-L K L
-*> A = K ( 0 A12 A13 ) if M-K-L < 0;
-*> M-K ( 0 0 A23 )
-*>
-*> N-K-L K L
-*> B = L ( 0 0 B13 )
-*> P-L ( 0 0 0 )
-*>
-*> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
-*> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
-*> otherwise A23 is (M-K)-by-L upper trapezoidal.
-*>
-*> On exit,
-*>
-*> U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ),
-*>
-*> where U, V and Q are orthogonal matrices.
-*> R is a nonsingular upper triangular matrix, and D1 and D2 are
-*> ``diagonal'' matrices, which are of the following structures:
-*>
-*> If M-K-L >= 0,
-*>
-*> K L
-*> D1 = K ( I 0 )
-*> L ( 0 C )
-*> M-K-L ( 0 0 )
-*>
-*> K L
-*> D2 = L ( 0 S )
-*> P-L ( 0 0 )
-*>
-*> N-K-L K L
-*> ( 0 R ) = K ( 0 R11 R12 ) K
-*> L ( 0 0 R22 ) L
-*>
-*> where
-*>
-*> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
-*> S = diag( BETA(K+1), ... , BETA(K+L) ),
-*> C**2 + S**2 = I.
-*>
-*> R is stored in A(1:K+L,N-K-L+1:N) on exit.
-*>
-*> If M-K-L < 0,
-*>
-*> K M-K K+L-M
-*> D1 = K ( I 0 0 )
-*> M-K ( 0 C 0 )
-*>
-*> K M-K K+L-M
-*> D2 = M-K ( 0 S 0 )
-*> K+L-M ( 0 0 I )
-*> P-L ( 0 0 0 )
-*>
-*> N-K-L K M-K K+L-M
-*> ( 0 R ) = K ( 0 R11 R12 R13 )
-*> M-K ( 0 0 R22 R23 )
-*> K+L-M ( 0 0 0 R33 )
-*>
-*> where
-*> C = diag( ALPHA(K+1), ... , ALPHA(M) ),
-*> S = diag( BETA(K+1), ... , BETA(M) ),
-*> C**2 + S**2 = I.
-*>
-*> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
-*> ( 0 R22 R23 )
-*> in B(M-K+1:L,N+M-K-L+1:N) on exit.
-*>
-*> The computation of the orthogonal transformation matrices U, V or Q
-*> is optional. These matrices may either be formed explicitly, or they
-*> may be postmultiplied into input matrices U1, V1, or Q1.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> = 'U': U must contain an orthogonal matrix U1 on entry, and
-*> the product U1*U is returned;
-*> = 'I': U is initialized to the unit matrix, and the
-*> orthogonal matrix U is returned;
-*> = 'N': U is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBV
-*> \verbatim
-*> JOBV is CHARACTER*1
-*> = 'V': V must contain an orthogonal matrix V1 on entry, and
-*> the product V1*V is returned;
-*> = 'I': V is initialized to the unit matrix, and the
-*> orthogonal matrix V is returned;
-*> = 'N': V is not computed.
-*> \endverbatim
-*>
-*> \param[in] JOBQ
-*> \verbatim
-*> JOBQ is CHARACTER*1
-*> = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
-*> the product Q1*Q is returned;
-*> = 'I': Q is initialized to the unit matrix, and the
-*> orthogonal matrix Q is returned;
-*> = 'N': Q is not computed.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] P
-*> \verbatim
-*> P is INTEGER
-*> The number of rows of the matrix B. P >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrices A and B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*>
-*> K and L specify the subblocks in the input matrices A and B:
-*> A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
-*> of A and B, whose GSVD is going to be computed by STGSJA.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
-*> matrix R or part of R. See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the P-by-N matrix B.
-*> On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
-*> a part of R. See Purpose for details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,P).
-*> \endverbatim
-*>
-*> \param[in] TOLA
-*> \verbatim
-*> TOLA is REAL
-*> \endverbatim
-*>
-*> \param[in] TOLB
-*> \verbatim
-*> TOLB is REAL
-*>
-*> TOLA and TOLB are the convergence criteria for the Jacobi-
-*> Kogbetliantz iteration procedure. Generally, they are the
-*> same as used in the preprocessing step, say
-*> TOLA = max(M,N)*norm(A)*MACHEPS,
-*> TOLB = max(P,N)*norm(B)*MACHEPS.
-*> \endverbatim
-*>
-*> \param[out] ALPHA
-*> \verbatim
-*> ALPHA is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] BETA
-*> \verbatim
-*> BETA is REAL array, dimension (N)
-*>
-*> On exit, ALPHA and BETA contain the generalized singular
-*> value pairs of A and B;
-*> ALPHA(1:K) = 1,
-*> BETA(1:K) = 0,
-*> and if M-K-L >= 0,
-*> ALPHA(K+1:K+L) = diag(C),
-*> BETA(K+1:K+L) = diag(S),
-*> or if M-K-L < 0,
-*> ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
-*> BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
-*> Furthermore, if K+L < N,
-*> ALPHA(K+L+1:N) = 0 and
-*> BETA(K+L+1:N) = 0.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is REAL array, dimension (LDU,M)
-*> On entry, if JOBU = 'U', U must contain a matrix U1 (usually
-*> the orthogonal matrix returned by SGGSVP).
-*> On exit,
-*> if JOBU = 'I', U contains the orthogonal matrix U;
-*> if JOBU = 'U', U contains the product U1*U.
-*> If JOBU = 'N', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,M) if
-*> JOBU = 'U'; LDU >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is REAL array, dimension (LDV,P)
-*> On entry, if JOBV = 'V', V must contain a matrix V1 (usually
-*> the orthogonal matrix returned by SGGSVP).
-*> On exit,
-*> if JOBV = 'I', V contains the orthogonal matrix V;
-*> if JOBV = 'V', V contains the product V1*V.
-*> If JOBV = 'N', V is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,P) if
-*> JOBV = 'V'; LDV >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
-*> the orthogonal matrix returned by SGGSVP).
-*> On exit,
-*> if JOBQ = 'I', Q contains the orthogonal matrix Q;
-*> if JOBQ = 'Q', Q contains the product Q1*Q.
-*> If JOBQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N) if
-*> JOBQ = 'Q'; LDQ >= 1 otherwise.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] NCYCLE
-*> \verbatim
-*> NCYCLE is INTEGER
-*> The number of cycles required for convergence.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> = 1: the procedure does not converge after MAXIT cycles.
-*> \endverbatim
-*>
-*> \verbatim
-*> Internal Parameters
-*> ===================
-*>
-*> MAXIT INTEGER
-*> MAXIT specifies the total loops that the iterative procedure
-*> may take. If after MAXIT cycles, the routine fails to
-*> converge, we return INFO = 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> STGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
-*> min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
-*> matrix B13 to the form:
-*>
-*> U1**T *A13*Q1 = C1*R1; V1**T *B13*Q1 = S1*R1,
-*>
-*> where U1, V1 and Q1 are orthogonal matrix, and Z**T is the transpose
-*> of Z. C1 and S1 are diagonal matrices satisfying
-*>
-*> C1**2 + S1**2 = I,
-*>
-*> and R1 is an L-by-L nonsingular upper triangular matrix.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
- $ LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV,
- $ Q, LDQ, WORK, NCYCLE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBQ, JOBU, JOBV
- INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N,
- $ NCYCLE, P
- REAL TOLA, TOLB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
- $ V( LDV, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER MAXIT
- PARAMETER ( MAXIT = 40 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
-*
- LOGICAL INITQ, INITU, INITV, UPPER, WANTQ, WANTU, WANTV
- INTEGER I, J, KCYCLE
- REAL A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, ERROR,
- $ GAMMA, RWK, SNQ, SNU, SNV, SSMIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SCOPY, SLAGS2, SLAPLL, SLARTG, SLASET, SROT,
- $ SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- INITU = LSAME( JOBU, 'I' )
- WANTU = INITU .OR. LSAME( JOBU, 'U' )
-*
- INITV = LSAME( JOBV, 'I' )
- WANTV = INITV .OR. LSAME( JOBV, 'V' )
-*
- INITQ = LSAME( JOBQ, 'I' )
- WANTQ = INITQ .OR. LSAME( JOBQ, 'Q' )
-*
- INFO = 0
- IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( P.LT.0 ) THEN
- INFO = -5
- ELSE IF( N.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
- INFO = -12
- ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
- INFO = -18
- ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
- INFO = -20
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -22
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGSJA', -INFO )
- RETURN
- END IF
-*
-* Initialize U, V and Q, if necessary
-*
- IF( INITU )
- $ CALL SLASET( 'Full', M, M, ZERO, ONE, U, LDU )
- IF( INITV )
- $ CALL SLASET( 'Full', P, P, ZERO, ONE, V, LDV )
- IF( INITQ )
- $ CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
-*
-* Loop until convergence
-*
- UPPER = .FALSE.
- DO 40 KCYCLE = 1, MAXIT
-*
- UPPER = .NOT.UPPER
-*
- DO 20 I = 1, L - 1
- DO 10 J = I + 1, L
-*
- A1 = ZERO
- A2 = ZERO
- A3 = ZERO
- IF( K+I.LE.M )
- $ A1 = A( K+I, N-L+I )
- IF( K+J.LE.M )
- $ A3 = A( K+J, N-L+J )
-*
- B1 = B( I, N-L+I )
- B3 = B( J, N-L+J )
-*
- IF( UPPER ) THEN
- IF( K+I.LE.M )
- $ A2 = A( K+I, N-L+J )
- B2 = B( I, N-L+J )
- ELSE
- IF( K+J.LE.M )
- $ A2 = A( K+J, N-L+I )
- B2 = B( J, N-L+I )
- END IF
-*
- CALL SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU,
- $ CSV, SNV, CSQ, SNQ )
-*
-* Update (K+I)-th and (K+J)-th rows of matrix A: U**T *A
-*
- IF( K+J.LE.M )
- $ CALL SROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ),
- $ LDA, CSU, SNU )
-*
-* Update I-th and J-th rows of matrix B: V**T *B
-*
- CALL SROT( L, B( J, N-L+1 ), LDB, B( I, N-L+1 ), LDB,
- $ CSV, SNV )
-*
-* Update (N-L+I)-th and (N-L+J)-th columns of matrices
-* A and B: A*Q and B*Q
-*
- CALL SROT( MIN( K+L, M ), A( 1, N-L+J ), 1,
- $ A( 1, N-L+I ), 1, CSQ, SNQ )
-*
- CALL SROT( L, B( 1, N-L+J ), 1, B( 1, N-L+I ), 1, CSQ,
- $ SNQ )
-*
- IF( UPPER ) THEN
- IF( K+I.LE.M )
- $ A( K+I, N-L+J ) = ZERO
- B( I, N-L+J ) = ZERO
- ELSE
- IF( K+J.LE.M )
- $ A( K+J, N-L+I ) = ZERO
- B( J, N-L+I ) = ZERO
- END IF
-*
-* Update orthogonal matrices U, V, Q, if desired.
-*
- IF( WANTU .AND. K+J.LE.M )
- $ CALL SROT( M, U( 1, K+J ), 1, U( 1, K+I ), 1, CSU,
- $ SNU )
-*
- IF( WANTV )
- $ CALL SROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV )
-*
- IF( WANTQ )
- $ CALL SROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ,
- $ SNQ )
-*
- 10 CONTINUE
- 20 CONTINUE
-*
- IF( .NOT.UPPER ) THEN
-*
-* The matrices A13 and B13 were lower triangular at the start
-* of the cycle, and are now upper triangular.
-*
-* Convergence test: test the parallelism of the corresponding
-* rows of A and B.
-*
- ERROR = ZERO
- DO 30 I = 1, MIN( L, M-K )
- CALL SCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 )
- CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 )
- CALL SLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN )
- ERROR = MAX( ERROR, SSMIN )
- 30 CONTINUE
-*
- IF( ABS( ERROR ).LE.MIN( TOLA, TOLB ) )
- $ GO TO 50
- END IF
-*
-* End of cycle loop
-*
- 40 CONTINUE
-*
-* The algorithm has not converged after MAXIT cycles.
-*
- INFO = 1
- GO TO 100
-*
- 50 CONTINUE
-*
-* If ERROR <= MIN(TOLA,TOLB), then the algorithm has converged.
-* Compute the generalized singular value pairs (ALPHA, BETA), and
-* set the triangular matrix R to array A.
-*
- DO 60 I = 1, K
- ALPHA( I ) = ONE
- BETA( I ) = ZERO
- 60 CONTINUE
-*
- DO 70 I = 1, MIN( L, M-K )
-*
- A1 = A( K+I, N-L+I )
- B1 = B( I, N-L+I )
-*
- IF( A1.NE.ZERO ) THEN
- GAMMA = B1 / A1
-*
-* change sign if necessary
-*
- IF( GAMMA.LT.ZERO ) THEN
- CALL SSCAL( L-I+1, -ONE, B( I, N-L+I ), LDB )
- IF( WANTV )
- $ CALL SSCAL( P, -ONE, V( 1, I ), 1 )
- END IF
-*
- CALL SLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ),
- $ RWK )
-*
- IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN
- CALL SSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ),
- $ LDA )
- ELSE
- CALL SSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ),
- $ LDB )
- CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
- $ LDA )
- END IF
-*
- ELSE
-*
- ALPHA( K+I ) = ZERO
- BETA( K+I ) = ONE
- CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
- $ LDA )
-*
- END IF
-*
- 70 CONTINUE
-*
-* Post-assignment
-*
- DO 80 I = M + 1, K + L
- ALPHA( I ) = ZERO
- BETA( I ) = ONE
- 80 CONTINUE
-*
- IF( K+L.LT.N ) THEN
- DO 90 I = K + L + 1, N
- ALPHA( I ) = ZERO
- BETA( I ) = ZERO
- 90 CONTINUE
- END IF
-*
- 100 CONTINUE
- NCYCLE = KCYCLE
- RETURN
-*
-* End of STGSJA
-*
- END
diff --git a/netlib/LAPACK/stgsna.f b/netlib/LAPACK/stgsna.f
deleted file mode 100644
index 2873098..0000000
--- a/netlib/LAPACK/stgsna.f
+++ /dev/null
@@ -1,700 +0,0 @@
-*> \brief \b STGSNA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGSNA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgsna.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgsna.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgsna.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
-* LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, JOB
-* INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), DIF( * ), S( * ),
-* $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGSNA estimates reciprocal condition numbers for specified
-*> eigenvalues and/or eigenvectors of a matrix pair (A, B) in
-*> generalized real Schur canonical form (or of any matrix pair
-*> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where
-*> Z**T denotes the transpose of Z.
-*>
-*> (A, B) must be in generalized real Schur form (as returned by SGGES),
-*> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal
-*> blocks. B is upper triangular.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies whether condition numbers are required for
-*> eigenvalues (S) or eigenvectors (DIF):
-*> = 'E': for eigenvalues only (S);
-*> = 'V': for eigenvectors only (DIF);
-*> = 'B': for both eigenvalues and eigenvectors (S and DIF).
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute condition numbers for all eigenpairs;
-*> = 'S': compute condition numbers for selected eigenpairs
-*> specified by the array SELECT.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenpairs for which
-*> condition numbers are required. To select condition numbers
-*> for the eigenpair corresponding to a real eigenvalue w(j),
-*> SELECT(j) must be set to .TRUE.. To select condition numbers
-*> corresponding to a complex conjugate pair of eigenvalues w(j)
-*> and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
-*> set to .TRUE..
-*> If HOWMNY = 'A', SELECT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the square matrix pair (A, B). N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The upper quasi-triangular matrix A in the pair (A,B).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> The upper triangular matrix B in the pair (A,B).
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,M)
-*> If JOB = 'E' or 'B', VL must contain left eigenvectors of
-*> (A, B), corresponding to the eigenpairs specified by HOWMNY
-*> and SELECT. The eigenvectors must be stored in consecutive
-*> columns of VL, as returned by STGEVC.
-*> If JOB = 'V', VL is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1.
-*> If JOB = 'E' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,M)
-*> If JOB = 'E' or 'B', VR must contain right eigenvectors of
-*> (A, B), corresponding to the eigenpairs specified by HOWMNY
-*> and SELECT. The eigenvectors must be stored in consecutive
-*> columns ov VR, as returned by STGEVC.
-*> If JOB = 'V', VR is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1.
-*> If JOB = 'E' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (MM)
-*> If JOB = 'E' or 'B', the reciprocal condition numbers of the
-*> selected eigenvalues, stored in consecutive elements of the
-*> array. For a complex conjugate pair of eigenvalues two
-*> consecutive elements of S are set to the same value. Thus
-*> S(j), DIF(j), and the j-th columns of VL and VR all
-*> correspond to the same eigenpair (but not in general the
-*> j-th eigenpair, unless all eigenpairs are selected).
-*> If JOB = 'V', S is not referenced.
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is REAL array, dimension (MM)
-*> If JOB = 'V' or 'B', the estimated reciprocal condition
-*> numbers of the selected eigenvectors, stored in consecutive
-*> elements of the array. For a complex eigenvector two
-*> consecutive elements of DIF are set to the same value. If
-*> the eigenvalues cannot be reordered to compute DIF(j), DIF(j)
-*> is set to 0; this can only occur when the true value would be
-*> very small anyway.
-*> If JOB = 'E', DIF is not referenced.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of elements in the arrays S and DIF. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of elements of the arrays S and DIF used to store
-*> the specified condition numbers; for each selected real
-*> eigenvalue one element is used, and for each selected complex
-*> conjugate pair of eigenvalues, two elements are used.
-*> If HOWMNY = 'A', M is set to N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N + 6)
-*> If JOB = 'E', IWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: Successful exit
-*> <0: If INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The reciprocal of the condition number of a generalized eigenvalue
-*> w = (a, b) is defined as
-*>
-*> S(w) = (|u**TAv|**2 + |u**TBv|**2)**(1/2) / (norm(u)*norm(v))
-*>
-*> where u and v are the left and right eigenvectors of (A, B)
-*> corresponding to w; |z| denotes the absolute value of the complex
-*> number, and norm(u) denotes the 2-norm of the vector u.
-*> The pair (a, b) corresponds to an eigenvalue w = a/b (= u**TAv/u**TBv)
-*> of the matrix pair (A, B). If both a and b equal zero, then (A B) is
-*> singular and S(I) = -1 is returned.
-*>
-*> An approximate error bound on the chordal distance between the i-th
-*> computed generalized eigenvalue w and the corresponding exact
-*> eigenvalue lambda is
-*>
-*> chord(w, lambda) <= EPS * norm(A, B) / S(I)
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal of the condition number DIF(i) of right eigenvector u
-*> and left eigenvector v corresponding to the generalized eigenvalue w
-*> is defined as follows:
-*>
-*> a) If the i-th eigenvalue w = (a,b) is real
-*>
-*> Suppose U and V are orthogonal transformations such that
-*>
-*> U**T*(A, B)*V = (S, T) = ( a * ) ( b * ) 1
-*> ( 0 S22 ),( 0 T22 ) n-1
-*> 1 n-1 1 n-1
-*>
-*> Then the reciprocal condition number DIF(i) is
-*>
-*> Difl((a, b), (S22, T22)) = sigma-min( Zl ),
-*>
-*> where sigma-min(Zl) denotes the smallest singular value of the
-*> 2(n-1)-by-2(n-1) matrix
-*>
-*> Zl = [ kron(a, In-1) -kron(1, S22) ]
-*> [ kron(b, In-1) -kron(1, T22) ] .
-*>
-*> Here In-1 is the identity matrix of size n-1. kron(X, Y) is the
-*> Kronecker product between the matrices X and Y.
-*>
-*> Note that if the default method for computing DIF(i) is wanted
-*> (see SLATDF), then the parameter DIFDRI (see below) should be
-*> changed from 3 to 4 (routine SLATDF(IJOB = 2 will be used)).
-*> See STGSYL for more details.
-*>
-*> b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair,
-*>
-*> Suppose U and V are orthogonal transformations such that
-*>
-*> U**T*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2
-*> ( 0 S22 ),( 0 T22) n-2
-*> 2 n-2 2 n-2
-*>
-*> and (S11, T11) corresponds to the complex conjugate eigenvalue
-*> pair (w, conjg(w)). There exist unitary matrices U1 and V1 such
-*> that
-*>
-*> U1**T*S11*V1 = ( s11 s12 ) and U1**T*T11*V1 = ( t11 t12 )
-*> ( 0 s22 ) ( 0 t22 )
-*>
-*> where the generalized eigenvalues w = s11/t11 and
-*> conjg(w) = s22/t22.
-*>
-*> Then the reciprocal condition number DIF(i) is bounded by
-*>
-*> min( d1, max( 1, |real(s11)/real(s22)| )*d2 )
-*>
-*> where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where
-*> Z1 is the complex 2-by-2 matrix
-*>
-*> Z1 = [ s11 -s22 ]
-*> [ t11 -t22 ],
-*>
-*> This is done by computing (using real arithmetic) the
-*> roots of the characteristical polynomial det(Z1**T * Z1 - lambda I),
-*> where Z1**T denotes the transpose of Z1 and det(X) denotes
-*> the determinant of X.
-*>
-*> and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an
-*> upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2)
-*>
-*> Z2 = [ kron(S11**T, In-2) -kron(I2, S22) ]
-*> [ kron(T11**T, In-2) -kron(I2, T22) ]
-*>
-*> Note that if the default method for computing DIF is wanted (see
-*> SLATDF), then the parameter DIFDRI (see below) should be changed
-*> from 3 to 4 (routine SLATDF(IJOB = 2 will be used)). See STGSYL
-*> for more details.
-*>
-*> For each eigenvalue/vector specified by SELECT, DIF stores a
-*> Frobenius norm-based estimate of Difl.
-*>
-*> An approximate error bound for the i-th computed eigenvector VL(i) or
-*> VR(i) is given by
-*>
-*> EPS * norm(A, B) / DIF(i).
-*>
-*> See ref. [2-3] for more details and further references.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*>
-*> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*> Estimation: Theory, Algorithms and Software,
-*> Report UMINF - 94.04, Department of Computing Science, Umea
-*> University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*> Note 87. To appear in Numerical Algorithms, 1996.
-*>
-*> [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*> for Solving the Generalized Sylvester Equation and Estimating the
-*> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*> Department of Computing Science, Umea University, S-901 87 Umea,
-*> Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*> Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
-*> No 1, 1996.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
- $ LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, JOB
- INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), DIF( * ), S( * ),
- $ VL( LDVL, * ), VR( LDVR, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER DIFDRI
- PARAMETER ( DIFDRI = 3 )
- REAL ZERO, ONE, TWO, FOUR
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
- $ FOUR = 4.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, PAIR, SOMCON, WANTBH, WANTDF, WANTS
- INTEGER I, IERR, IFST, ILST, IZ, K, KS, LWMIN, N1, N2
- REAL ALPHAI, ALPHAR, ALPRQT, BETA, C1, C2, COND,
- $ EPS, LNRM, RNRM, ROOT1, ROOT2, SCALE, SMLNUM,
- $ TMPII, TMPIR, TMPRI, TMPRR, UHAV, UHAVI, UHBV,
- $ UHBVI
-* ..
-* .. Local Arrays ..
- REAL DUMMY( 1 ), DUMMY1( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT, SLAMCH, SLAPY2, SNRM2
- EXTERNAL LSAME, SDOT, SLAMCH, SLAPY2, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMV, SLACPY, SLAG2, STGEXC, STGSYL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- WANTBH = LSAME( JOB, 'B' )
- WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
- WANTDF = LSAME( JOB, 'V' ) .OR. WANTBH
-*
- SOMCON = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.WANTS .AND. .NOT.WANTDF ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( HOWMNY, 'A' ) .AND. .NOT.SOMCON ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( WANTS .AND. LDVL.LT.N ) THEN
- INFO = -10
- ELSE IF( WANTS .AND. LDVR.LT.N ) THEN
- INFO = -12
- ELSE
-*
-* Set M to the number of eigenpairs for which condition numbers
-* are required, and test MM.
-*
- IF( SOMCON ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( A( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( N.EQ.0 ) THEN
- LWMIN = 1
- ELSE IF( LSAME( JOB, 'V' ) .OR. LSAME( JOB, 'B' ) ) THEN
- LWMIN = 2*N*( N + 2 ) + 16
- ELSE
- LWMIN = N
- END IF
- WORK( 1 ) = LWMIN
-*
- IF( MM.LT.M ) THEN
- INFO = -15
- ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -18
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGSNA', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- KS = 0
- PAIR = .FALSE.
-*
- DO 20 K = 1, N
-*
-* Determine whether A(k,k) begins a 1-by-1 or 2-by-2 block.
-*
- IF( PAIR ) THEN
- PAIR = .FALSE.
- GO TO 20
- ELSE
- IF( K.LT.N )
- $ PAIR = A( K+1, K ).NE.ZERO
- END IF
-*
-* Determine whether condition numbers are required for the k-th
-* eigenpair.
-*
- IF( SOMCON ) THEN
- IF( PAIR ) THEN
- IF( .NOT.SELECT( K ) .AND. .NOT.SELECT( K+1 ) )
- $ GO TO 20
- ELSE
- IF( .NOT.SELECT( K ) )
- $ GO TO 20
- END IF
- END IF
-*
- KS = KS + 1
-*
- IF( WANTS ) THEN
-*
-* Compute the reciprocal condition number of the k-th
-* eigenvalue.
-*
- IF( PAIR ) THEN
-*
-* Complex eigenvalue pair.
-*
- RNRM = SLAPY2( SNRM2( N, VR( 1, KS ), 1 ),
- $ SNRM2( N, VR( 1, KS+1 ), 1 ) )
- LNRM = SLAPY2( SNRM2( N, VL( 1, KS ), 1 ),
- $ SNRM2( N, VL( 1, KS+1 ), 1 ) )
- CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- TMPRR = SDOT( N, WORK, 1, VL( 1, KS ), 1 )
- TMPRI = SDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS+1 ), 1,
- $ ZERO, WORK, 1 )
- TMPII = SDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- TMPIR = SDOT( N, WORK, 1, VL( 1, KS ), 1 )
- UHAV = TMPRR + TMPII
- UHAVI = TMPIR - TMPRI
- CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- TMPRR = SDOT( N, WORK, 1, VL( 1, KS ), 1 )
- TMPRI = SDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS+1 ), 1,
- $ ZERO, WORK, 1 )
- TMPII = SDOT( N, WORK, 1, VL( 1, KS+1 ), 1 )
- TMPIR = SDOT( N, WORK, 1, VL( 1, KS ), 1 )
- UHBV = TMPRR + TMPII
- UHBVI = TMPIR - TMPRI
- UHAV = SLAPY2( UHAV, UHAVI )
- UHBV = SLAPY2( UHBV, UHBVI )
- COND = SLAPY2( UHAV, UHBV )
- S( KS ) = COND / ( RNRM*LNRM )
- S( KS+1 ) = S( KS )
-*
- ELSE
-*
-* Real eigenvalue.
-*
- RNRM = SNRM2( N, VR( 1, KS ), 1 )
- LNRM = SNRM2( N, VL( 1, KS ), 1 )
- CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- UHAV = SDOT( N, WORK, 1, VL( 1, KS ), 1 )
- CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO,
- $ WORK, 1 )
- UHBV = SDOT( N, WORK, 1, VL( 1, KS ), 1 )
- COND = SLAPY2( UHAV, UHBV )
- IF( COND.EQ.ZERO ) THEN
- S( KS ) = -ONE
- ELSE
- S( KS ) = COND / ( RNRM*LNRM )
- END IF
- END IF
- END IF
-*
- IF( WANTDF ) THEN
- IF( N.EQ.1 ) THEN
- DIF( KS ) = SLAPY2( A( 1, 1 ), B( 1, 1 ) )
- GO TO 20
- END IF
-*
-* Estimate the reciprocal condition number of the k-th
-* eigenvectors.
- IF( PAIR ) THEN
-*
-* Copy the 2-by 2 pencil beginning at (A(k,k), B(k, k)).
-* Compute the eigenvalue(s) at position K.
-*
- WORK( 1 ) = A( K, K )
- WORK( 2 ) = A( K+1, K )
- WORK( 3 ) = A( K, K+1 )
- WORK( 4 ) = A( K+1, K+1 )
- WORK( 5 ) = B( K, K )
- WORK( 6 ) = B( K+1, K )
- WORK( 7 ) = B( K, K+1 )
- WORK( 8 ) = B( K+1, K+1 )
- CALL SLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA,
- $ DUMMY1( 1 ), ALPHAR, DUMMY( 1 ), ALPHAI )
- ALPRQT = ONE
- C1 = TWO*( ALPHAR*ALPHAR+ALPHAI*ALPHAI+BETA*BETA )
- C2 = FOUR*BETA*BETA*ALPHAI*ALPHAI
- ROOT1 = C1 + SQRT( C1*C1-4.0*C2 )
- ROOT2 = C2 / ROOT1
- ROOT1 = ROOT1 / TWO
- COND = MIN( SQRT( ROOT1 ), SQRT( ROOT2 ) )
- END IF
-*
-* Copy the matrix (A, B) to the array WORK and swap the
-* diagonal block beginning at A(k,k) to the (1,1) position.
-*
- CALL SLACPY( 'Full', N, N, A, LDA, WORK, N )
- CALL SLACPY( 'Full', N, N, B, LDB, WORK( N*N+1 ), N )
- IFST = K
- ILST = 1
-*
- CALL STGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), N,
- $ DUMMY, 1, DUMMY1, 1, IFST, ILST,
- $ WORK( N*N*2+1 ), LWORK-2*N*N, IERR )
-*
- IF( IERR.GT.0 ) THEN
-*
-* Ill-conditioned problem - swap rejected.
-*
- DIF( KS ) = ZERO
- ELSE
-*
-* Reordering successful, solve generalized Sylvester
-* equation for R and L,
-* A22 * R - L * A11 = A12
-* B22 * R - L * B11 = B12,
-* and compute estimate of Difl((A11,B11), (A22, B22)).
-*
- N1 = 1
- IF( WORK( 2 ).NE.ZERO )
- $ N1 = 2
- N2 = N - N1
- IF( N2.EQ.0 ) THEN
- DIF( KS ) = COND
- ELSE
- I = N*N + 1
- IZ = 2*N*N + 1
- CALL STGSYL( 'N', DIFDRI, N2, N1, WORK( N*N1+N1+1 ),
- $ N, WORK, N, WORK( N1+1 ), N,
- $ WORK( N*N1+N1+I ), N, WORK( I ), N,
- $ WORK( N1+I ), N, SCALE, DIF( KS ),
- $ WORK( IZ+1 ), LWORK-2*N*N, IWORK, IERR )
-*
- IF( PAIR )
- $ DIF( KS ) = MIN( MAX( ONE, ALPRQT )*DIF( KS ),
- $ COND )
- END IF
- END IF
- IF( PAIR )
- $ DIF( KS+1 ) = DIF( KS )
- END IF
- IF( PAIR )
- $ KS = KS + 1
-*
- 20 CONTINUE
- WORK( 1 ) = LWMIN
- RETURN
-*
-* End of STGSNA
-*
- END
diff --git a/netlib/LAPACK/stgsy2.f b/netlib/LAPACK/stgsy2.f
deleted file mode 100644
index d7014df..0000000
--- a/netlib/LAPACK/stgsy2.f
+++ /dev/null
@@ -1,1075 +0,0 @@
-*> \brief \b STGSY2 solves the generalized Sylvester equation (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGSY2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgsy2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgsy2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgsy2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-* LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
-* IWORK, PQ, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N,
-* $ PQ
-* REAL RDSCAL, RDSUM, SCALE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
-* $ D( LDD, * ), E( LDE, * ), F( LDF, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGSY2 solves the generalized Sylvester equation:
-*>
-*> A * R - L * B = scale * C (1)
-*> D * R - L * E = scale * F,
-*>
-*> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
-*> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
-*> N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
-*> must be in generalized Schur canonical form, i.e. A, B are upper
-*> quasi triangular and D, E are upper triangular. The solution (R, L)
-*> overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
-*> chosen to avoid overflow.
-*>
-*> In matrix notation solving equation (1) corresponds to solve
-*> Z*x = scale*b, where Z is defined as
-*>
-*> Z = [ kron(In, A) -kron(B**T, Im) ] (2)
-*> [ kron(In, D) -kron(E**T, Im) ],
-*>
-*> Ik is the identity matrix of size k and X**T is the transpose of X.
-*> kron(X, Y) is the Kronecker product between the matrices X and Y.
-*> In the process of solving (1), we solve a number of such systems
-*> where Dim(In), Dim(In) = 1 or 2.
-*>
-*> If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y,
-*> which is equivalent to solve for R and L in
-*>
-*> A**T * R + D**T * L = scale * C (3)
-*> R * B**T + L * E**T = scale * -F
-*>
-*> This case is used to compute an estimate of Dif[(A, D), (B, E)] =
-*> sigma_min(Z) using reverse communicaton with SLACON.
-*>
-*> STGSY2 also (IJOB >= 1) contributes to the computation in STGSYL
-*> of an upper bound on the separation between to matrix pairs. Then
-*> the input (A, D), (B, E) are sub-pencils of the matrix pair in
-*> STGSYL. See STGSYL for details.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N', solve the generalized Sylvester equation (1).
-*> = 'T': solve the 'transposed' system (3).
-*> \endverbatim
-*>
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies what kind of functionality to be performed.
-*> = 0: solve (1) only.
-*> = 1: A contribution from this subsystem to a Frobenius
-*> norm-based estimate of the separation between two matrix
-*> pairs is computed. (look ahead strategy is used).
-*> = 2: A contribution from this subsystem to a Frobenius
-*> norm-based estimate of the separation between two matrix
-*> pairs is computed. (SGECON on sub-systems is used.)
-*> Not referenced if TRANS = 'T'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the order of A and D, and the row
-*> dimension of C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of B and E, and the column
-*> dimension of C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, M)
-*> On entry, A contains an upper quasi triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the matrix A. LDA >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> On entry, B contains an upper quasi triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the matrix B. LDB >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC, N)
-*> On entry, C contains the right-hand-side of the first matrix
-*> equation in (1).
-*> On exit, if IJOB = 0, C has been overwritten by the
-*> solution R.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the matrix C. LDC >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (LDD, M)
-*> On entry, D contains an upper triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDD
-*> \verbatim
-*> LDD is INTEGER
-*> The leading dimension of the matrix D. LDD >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (LDE, N)
-*> On entry, E contains an upper triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] LDE
-*> \verbatim
-*> LDE is INTEGER
-*> The leading dimension of the matrix E. LDE >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] F
-*> \verbatim
-*> F is REAL array, dimension (LDF, N)
-*> On entry, F contains the right-hand-side of the second matrix
-*> equation in (1).
-*> On exit, if IJOB = 0, F has been overwritten by the
-*> solution L.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of the matrix F. LDF >= max(1, M).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
-*> R and L (C and F on entry) will hold the solutions to a
-*> slightly perturbed system but the input matrices A, B, D and
-*> E have not been changed. If SCALE = 0, R and L will hold the
-*> solutions to the homogeneous system with C = F = 0. Normally,
-*> SCALE = 1.
-*> \endverbatim
-*>
-*> \param[in,out] RDSUM
-*> \verbatim
-*> RDSUM is REAL
-*> On entry, the sum of squares of computed contributions to
-*> the Dif-estimate under computation by STGSYL, where the
-*> scaling factor RDSCAL (see below) has been factored out.
-*> On exit, the corresponding sum of squares updated with the
-*> contributions from the current sub-system.
-*> If TRANS = 'T' RDSUM is not touched.
-*> NOTE: RDSUM only makes sense when STGSY2 is called by STGSYL.
-*> \endverbatim
-*>
-*> \param[in,out] RDSCAL
-*> \verbatim
-*> RDSCAL is REAL
-*> On entry, scaling factor used to prevent overflow in RDSUM.
-*> On exit, RDSCAL is updated w.r.t. the current contributions
-*> in RDSUM.
-*> If TRANS = 'T', RDSCAL is not touched.
-*> NOTE: RDSCAL only makes sense when STGSY2 is called by
-*> STGSYL.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (M+N+2)
-*> \endverbatim
-*>
-*> \param[out] PQ
-*> \verbatim
-*> PQ is INTEGER
-*> On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
-*> 8-by-8) solved by this routine.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, if INFO is set to
-*> =0: Successful exit
-*> <0: If INFO = -i, the i-th argument had an illegal value.
-*> >0: The matrix pairs (A, D) and (B, E) have common or very
-*> close eigenvalues.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realSYauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
- SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
- $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
- $ IWORK, PQ, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N,
- $ PQ
- REAL RDSCAL, RDSUM, SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ D( LDD, * ), E( LDE, * ), F( LDF, * )
-* ..
-*
-* =====================================================================
-* Replaced various illegal calls to SCOPY by calls to SLASET.
-* Sven Hammarling, 27/5/02.
-*
-* .. Parameters ..
- INTEGER LDZ
- PARAMETER ( LDZ = 8 )
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER I, IE, IERR, II, IS, ISP1, J, JE, JJ, JS, JSP1,
- $ K, MB, NB, P, Q, ZDIM
- REAL ALPHA, SCALOC
-* ..
-* .. Local Arrays ..
- INTEGER IPIV( LDZ ), JPIV( LDZ )
- REAL RHS( LDZ ), Z( LDZ, LDZ )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMM, SGEMV, SGER, SGESC2,
- $ SGETC2, SSCAL, SLASET, SLATDF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test input parameters
-*
- INFO = 0
- IERR = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -1
- ELSE IF( NOTRAN ) THEN
- IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.2 ) ) THEN
- INFO = -2
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( M.LE.0 ) THEN
- INFO = -3
- ELSE IF( N.LE.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
- INFO = -12
- ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
- INFO = -16
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGSY2', -INFO )
- RETURN
- END IF
-*
-* Determine block structure of A
-*
- PQ = 0
- P = 0
- I = 1
- 10 CONTINUE
- IF( I.GT.M )
- $ GO TO 20
- P = P + 1
- IWORK( P ) = I
- IF( I.EQ.M )
- $ GO TO 20
- IF( A( I+1, I ).NE.ZERO ) THEN
- I = I + 2
- ELSE
- I = I + 1
- END IF
- GO TO 10
- 20 CONTINUE
- IWORK( P+1 ) = M + 1
-*
-* Determine block structure of B
-*
- Q = P + 1
- J = 1
- 30 CONTINUE
- IF( J.GT.N )
- $ GO TO 40
- Q = Q + 1
- IWORK( Q ) = J
- IF( J.EQ.N )
- $ GO TO 40
- IF( B( J+1, J ).NE.ZERO ) THEN
- J = J + 2
- ELSE
- J = J + 1
- END IF
- GO TO 30
- 40 CONTINUE
- IWORK( Q+1 ) = N + 1
- PQ = P*( Q-P-1 )
-*
- IF( NOTRAN ) THEN
-*
-* Solve (I, J) - subsystem
-* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-* for I = P, P - 1, ..., 1; J = 1, 2, ..., Q
-*
- SCALE = ONE
- SCALOC = ONE
- DO 120 J = P + 2, Q
- JS = IWORK( J )
- JSP1 = JS + 1
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- DO 110 I = P, 1, -1
-*
- IS = IWORK( I )
- ISP1 = IS + 1
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- ZDIM = MB*NB*2
-*
- IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 2-by-2 system Z * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = D( IS, IS )
- Z( 1, 2 ) = -B( JS, JS )
- Z( 2, 2 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = F( IS, JS )
-*
-* Solve Z * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- IF( IJOB.EQ.0 ) THEN
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 50 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 50 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL SLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- F( IS, JS ) = RHS( 2 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- ALPHA = -RHS( 1 )
- CALL SAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, JS ),
- $ 1 )
- CALL SAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, JS ),
- $ 1 )
- END IF
- IF( J.LT.Q ) THEN
- CALL SAXPY( N-JE, RHS( 2 ), B( JS, JE+1 ), LDB,
- $ C( IS, JE+1 ), LDC )
- CALL SAXPY( N-JE, RHS( 2 ), E( JS, JE+1 ), LDE,
- $ F( IS, JE+1 ), LDF )
- END IF
-*
- ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build a 4-by-4 system Z * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = ZERO
- Z( 3, 1 ) = D( IS, IS )
- Z( 4, 1 ) = ZERO
-*
- Z( 1, 2 ) = ZERO
- Z( 2, 2 ) = A( IS, IS )
- Z( 3, 2 ) = ZERO
- Z( 4, 2 ) = D( IS, IS )
-*
- Z( 1, 3 ) = -B( JS, JS )
- Z( 2, 3 ) = -B( JS, JSP1 )
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = -E( JS, JSP1 )
-*
- Z( 1, 4 ) = -B( JSP1, JS )
- Z( 2, 4 ) = -B( JSP1, JSP1 )
- Z( 3, 4 ) = ZERO
- Z( 4, 4 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( IS, JSP1 )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( IS, JSP1 )
-*
-* Solve Z * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- IF( IJOB.EQ.0 ) THEN
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 60 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 60 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL SLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( IS, JSP1 ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( IS, JSP1 ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL SGER( IS-1, NB, -ONE, A( 1, IS ), 1, RHS( 1 ),
- $ 1, C( 1, JS ), LDC )
- CALL SGER( IS-1, NB, -ONE, D( 1, IS ), 1, RHS( 1 ),
- $ 1, F( 1, JS ), LDF )
- END IF
- IF( J.LT.Q ) THEN
- CALL SAXPY( N-JE, RHS( 3 ), B( JS, JE+1 ), LDB,
- $ C( IS, JE+1 ), LDC )
- CALL SAXPY( N-JE, RHS( 3 ), E( JS, JE+1 ), LDE,
- $ F( IS, JE+1 ), LDF )
- CALL SAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), LDB,
- $ C( IS, JE+1 ), LDC )
- CALL SAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), LDE,
- $ F( IS, JE+1 ), LDF )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 4-by-4 system Z * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( ISP1, IS )
- Z( 3, 1 ) = D( IS, IS )
- Z( 4, 1 ) = ZERO
-*
- Z( 1, 2 ) = A( IS, ISP1 )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 3, 2 ) = D( IS, ISP1 )
- Z( 4, 2 ) = D( ISP1, ISP1 )
-*
- Z( 1, 3 ) = -B( JS, JS )
- Z( 2, 3 ) = ZERO
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = ZERO
-*
- Z( 1, 4 ) = ZERO
- Z( 2, 4 ) = -B( JS, JS )
- Z( 3, 4 ) = ZERO
- Z( 4, 4 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( ISP1, JS )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( ISP1, JS )
-*
-* Solve Z * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
- IF( IJOB.EQ.0 ) THEN
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 70 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 70 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL SLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( ISP1, JS ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( ISP1, JS ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL SGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), LDA,
- $ RHS( 1 ), 1, ONE, C( 1, JS ), 1 )
- CALL SGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), LDD,
- $ RHS( 1 ), 1, ONE, F( 1, JS ), 1 )
- END IF
- IF( J.LT.Q ) THEN
- CALL SGER( MB, N-JE, ONE, RHS( 3 ), 1,
- $ B( JS, JE+1 ), LDB, C( IS, JE+1 ), LDC )
- CALL SGER( MB, N-JE, ONE, RHS( 3 ), 1,
- $ E( JS, JE+1 ), LDE, F( IS, JE+1 ), LDF )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build an 8-by-8 system Z * x = RHS
-*
- CALL SLASET( 'F', LDZ, LDZ, ZERO, ZERO, Z, LDZ )
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( ISP1, IS )
- Z( 5, 1 ) = D( IS, IS )
-*
- Z( 1, 2 ) = A( IS, ISP1 )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 5, 2 ) = D( IS, ISP1 )
- Z( 6, 2 ) = D( ISP1, ISP1 )
-*
- Z( 3, 3 ) = A( IS, IS )
- Z( 4, 3 ) = A( ISP1, IS )
- Z( 7, 3 ) = D( IS, IS )
-*
- Z( 3, 4 ) = A( IS, ISP1 )
- Z( 4, 4 ) = A( ISP1, ISP1 )
- Z( 7, 4 ) = D( IS, ISP1 )
- Z( 8, 4 ) = D( ISP1, ISP1 )
-*
- Z( 1, 5 ) = -B( JS, JS )
- Z( 3, 5 ) = -B( JS, JSP1 )
- Z( 5, 5 ) = -E( JS, JS )
- Z( 7, 5 ) = -E( JS, JSP1 )
-*
- Z( 2, 6 ) = -B( JS, JS )
- Z( 4, 6 ) = -B( JS, JSP1 )
- Z( 6, 6 ) = -E( JS, JS )
- Z( 8, 6 ) = -E( JS, JSP1 )
-*
- Z( 1, 7 ) = -B( JSP1, JS )
- Z( 3, 7 ) = -B( JSP1, JSP1 )
- Z( 7, 7 ) = -E( JSP1, JSP1 )
-*
- Z( 2, 8 ) = -B( JSP1, JS )
- Z( 4, 8 ) = -B( JSP1, JSP1 )
- Z( 8, 8 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- K = 1
- II = MB*NB + 1
- DO 80 JJ = 0, NB - 1
- CALL SCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
- CALL SCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
- K = K + MB
- II = II + MB
- 80 CONTINUE
-*
-* Solve Z * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
- IF( IJOB.EQ.0 ) THEN
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
- $ SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 90 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 90 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- ELSE
- CALL SLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
- $ RDSCAL, IPIV, JPIV )
- END IF
-*
-* Unpack solution vector(s)
-*
- K = 1
- II = MB*NB + 1
- DO 100 JJ = 0, NB - 1
- CALL SCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
- CALL SCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
- K = K + MB
- II = II + MB
- 100 CONTINUE
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL SGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ A( 1, IS ), LDA, RHS( 1 ), MB, ONE,
- $ C( 1, JS ), LDC )
- CALL SGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ D( 1, IS ), LDD, RHS( 1 ), MB, ONE,
- $ F( 1, JS ), LDF )
- END IF
- IF( J.LT.Q ) THEN
- K = MB*NB + 1
- CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
- $ MB, B( JS, JE+1 ), LDB, ONE,
- $ C( IS, JE+1 ), LDC )
- CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
- $ MB, E( JS, JE+1 ), LDE, ONE,
- $ F( IS, JE+1 ), LDF )
- END IF
-*
- END IF
-*
- 110 CONTINUE
- 120 CONTINUE
- ELSE
-*
-* Solve (I, J) - subsystem
-* A(I, I)**T * R(I, J) + D(I, I)**T * L(J, J) = C(I, J)
-* R(I, I) * B(J, J) + L(I, J) * E(J, J) = -F(I, J)
-* for I = 1, 2, ..., P, J = Q, Q - 1, ..., 1
-*
- SCALE = ONE
- SCALOC = ONE
- DO 200 I = 1, P
-*
- IS = IWORK( I )
- ISP1 = IS + 1
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- DO 190 J = Q, P + 2, -1
-*
- JS = IWORK( J )
- JSP1 = JS + 1
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- ZDIM = MB*NB*2
- IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 2-by-2 system Z**T * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = -B( JS, JS )
- Z( 1, 2 ) = D( IS, IS )
- Z( 2, 2 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = F( IS, JS )
-*
-* Solve Z**T * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 130 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 130 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- F( IS, JS ) = RHS( 2 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- ALPHA = RHS( 1 )
- CALL SAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, 1 ),
- $ LDF )
- ALPHA = RHS( 2 )
- CALL SAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, 1 ),
- $ LDF )
- END IF
- IF( I.LT.P ) THEN
- ALPHA = -RHS( 1 )
- CALL SAXPY( M-IE, ALPHA, A( IS, IE+1 ), LDA,
- $ C( IE+1, JS ), 1 )
- ALPHA = -RHS( 2 )
- CALL SAXPY( M-IE, ALPHA, D( IS, IE+1 ), LDD,
- $ C( IE+1, JS ), 1 )
- END IF
-*
- ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build a 4-by-4 system Z**T * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = ZERO
- Z( 3, 1 ) = -B( JS, JS )
- Z( 4, 1 ) = -B( JSP1, JS )
-*
- Z( 1, 2 ) = ZERO
- Z( 2, 2 ) = A( IS, IS )
- Z( 3, 2 ) = -B( JS, JSP1 )
- Z( 4, 2 ) = -B( JSP1, JSP1 )
-*
- Z( 1, 3 ) = D( IS, IS )
- Z( 2, 3 ) = ZERO
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = ZERO
-*
- Z( 1, 4 ) = ZERO
- Z( 2, 4 ) = D( IS, IS )
- Z( 3, 4 ) = -E( JS, JSP1 )
- Z( 4, 4 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( IS, JSP1 )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( IS, JSP1 )
-*
-* Solve Z**T * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 140 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 140 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( IS, JSP1 ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( IS, JSP1 ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL SAXPY( JS-1, RHS( 1 ), B( 1, JS ), 1,
- $ F( IS, 1 ), LDF )
- CALL SAXPY( JS-1, RHS( 2 ), B( 1, JSP1 ), 1,
- $ F( IS, 1 ), LDF )
- CALL SAXPY( JS-1, RHS( 3 ), E( 1, JS ), 1,
- $ F( IS, 1 ), LDF )
- CALL SAXPY( JS-1, RHS( 4 ), E( 1, JSP1 ), 1,
- $ F( IS, 1 ), LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL SGER( M-IE, NB, -ONE, A( IS, IE+1 ), LDA,
- $ RHS( 1 ), 1, C( IE+1, JS ), LDC )
- CALL SGER( M-IE, NB, -ONE, D( IS, IE+1 ), LDD,
- $ RHS( 3 ), 1, C( IE+1, JS ), LDC )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-* Build a 4-by-4 system Z**T * x = RHS
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( IS, ISP1 )
- Z( 3, 1 ) = -B( JS, JS )
- Z( 4, 1 ) = ZERO
-*
- Z( 1, 2 ) = A( ISP1, IS )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 3, 2 ) = ZERO
- Z( 4, 2 ) = -B( JS, JS )
-*
- Z( 1, 3 ) = D( IS, IS )
- Z( 2, 3 ) = D( IS, ISP1 )
- Z( 3, 3 ) = -E( JS, JS )
- Z( 4, 3 ) = ZERO
-*
- Z( 1, 4 ) = ZERO
- Z( 2, 4 ) = D( ISP1, ISP1 )
- Z( 3, 4 ) = ZERO
- Z( 4, 4 ) = -E( JS, JS )
-*
-* Set up right hand side(s)
-*
- RHS( 1 ) = C( IS, JS )
- RHS( 2 ) = C( ISP1, JS )
- RHS( 3 ) = F( IS, JS )
- RHS( 4 ) = F( ISP1, JS )
-*
-* Solve Z**T * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 150 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 150 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- C( IS, JS ) = RHS( 1 )
- C( ISP1, JS ) = RHS( 2 )
- F( IS, JS ) = RHS( 3 )
- F( ISP1, JS ) = RHS( 4 )
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL SGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, JS ),
- $ 1, F( IS, 1 ), LDF )
- CALL SGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, JS ),
- $ 1, F( IS, 1 ), LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL SGEMV( 'T', MB, M-IE, -ONE, A( IS, IE+1 ),
- $ LDA, RHS( 1 ), 1, ONE, C( IE+1, JS ),
- $ 1 )
- CALL SGEMV( 'T', MB, M-IE, -ONE, D( IS, IE+1 ),
- $ LDD, RHS( 3 ), 1, ONE, C( IE+1, JS ),
- $ 1 )
- END IF
-*
- ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-* Build an 8-by-8 system Z**T * x = RHS
-*
- CALL SLASET( 'F', LDZ, LDZ, ZERO, ZERO, Z, LDZ )
-*
- Z( 1, 1 ) = A( IS, IS )
- Z( 2, 1 ) = A( IS, ISP1 )
- Z( 5, 1 ) = -B( JS, JS )
- Z( 7, 1 ) = -B( JSP1, JS )
-*
- Z( 1, 2 ) = A( ISP1, IS )
- Z( 2, 2 ) = A( ISP1, ISP1 )
- Z( 6, 2 ) = -B( JS, JS )
- Z( 8, 2 ) = -B( JSP1, JS )
-*
- Z( 3, 3 ) = A( IS, IS )
- Z( 4, 3 ) = A( IS, ISP1 )
- Z( 5, 3 ) = -B( JS, JSP1 )
- Z( 7, 3 ) = -B( JSP1, JSP1 )
-*
- Z( 3, 4 ) = A( ISP1, IS )
- Z( 4, 4 ) = A( ISP1, ISP1 )
- Z( 6, 4 ) = -B( JS, JSP1 )
- Z( 8, 4 ) = -B( JSP1, JSP1 )
-*
- Z( 1, 5 ) = D( IS, IS )
- Z( 2, 5 ) = D( IS, ISP1 )
- Z( 5, 5 ) = -E( JS, JS )
-*
- Z( 2, 6 ) = D( ISP1, ISP1 )
- Z( 6, 6 ) = -E( JS, JS )
-*
- Z( 3, 7 ) = D( IS, IS )
- Z( 4, 7 ) = D( IS, ISP1 )
- Z( 5, 7 ) = -E( JS, JSP1 )
- Z( 7, 7 ) = -E( JSP1, JSP1 )
-*
- Z( 4, 8 ) = D( ISP1, ISP1 )
- Z( 6, 8 ) = -E( JS, JSP1 )
- Z( 8, 8 ) = -E( JSP1, JSP1 )
-*
-* Set up right hand side(s)
-*
- K = 1
- II = MB*NB + 1
- DO 160 JJ = 0, NB - 1
- CALL SCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
- CALL SCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
- K = K + MB
- II = II + MB
- 160 CONTINUE
-*
-*
-* Solve Z**T * x = RHS
-*
- CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
- IF( IERR.GT.0 )
- $ INFO = IERR
-*
- CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
- IF( SCALOC.NE.ONE ) THEN
- DO 170 K = 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 170 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Unpack solution vector(s)
-*
- K = 1
- II = MB*NB + 1
- DO 180 JJ = 0, NB - 1
- CALL SCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
- CALL SCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
- K = K + MB
- II = II + MB
- 180 CONTINUE
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE,
- $ C( IS, JS ), LDC, B( 1, JS ), LDB, ONE,
- $ F( IS, 1 ), LDF )
- CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE,
- $ F( IS, JS ), LDF, E( 1, JS ), LDE, ONE,
- $ F( IS, 1 ), LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL SGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ A( IS, IE+1 ), LDA, C( IS, JS ), LDC,
- $ ONE, C( IE+1, JS ), LDC )
- CALL SGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ D( IS, IE+1 ), LDD, F( IS, JS ), LDF,
- $ ONE, C( IE+1, JS ), LDC )
- END IF
-*
- END IF
-*
- 190 CONTINUE
- 200 CONTINUE
-*
- END IF
- RETURN
-*
-* End of STGSY2
-*
- END
diff --git a/netlib/LAPACK/stgsyl.f b/netlib/LAPACK/stgsyl.f
deleted file mode 100644
index 44c66bc..0000000
--- a/netlib/LAPACK/stgsyl.f
+++ /dev/null
@@ -1,682 +0,0 @@
-*> \brief \b STGSYL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STGSYL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stgsyl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stgsyl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stgsyl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-* LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
-* $ LWORK, M, N
-* REAL DIF, SCALE
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
-* $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STGSYL solves the generalized Sylvester equation:
-*>
-*> A * R - L * B = scale * C (1)
-*> D * R - L * E = scale * F
-*>
-*> where R and L are unknown m-by-n matrices, (A, D), (B, E) and
-*> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
-*> respectively, with real entries. (A, D) and (B, E) must be in
-*> generalized (real) Schur canonical form, i.e. A, B are upper quasi
-*> triangular and D, E are upper triangular.
-*>
-*> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
-*> scaling factor chosen to avoid overflow.
-*>
-*> In matrix notation (1) is equivalent to solve Zx = scale b, where
-*> Z is defined as
-*>
-*> Z = [ kron(In, A) -kron(B**T, Im) ] (2)
-*> [ kron(In, D) -kron(E**T, Im) ].
-*>
-*> Here Ik is the identity matrix of size k and X**T is the transpose of
-*> X. kron(X, Y) is the Kronecker product between the matrices X and Y.
-*>
-*> If TRANS = 'T', STGSYL solves the transposed system Z**T*y = scale*b,
-*> which is equivalent to solve for R and L in
-*>
-*> A**T * R + D**T * L = scale * C (3)
-*> R * B**T + L * E**T = scale * -F
-*>
-*> This case (TRANS = 'T') is used to compute an one-norm-based estimate
-*> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
-*> and (B,E), using SLACON.
-*>
-*> If IJOB >= 1, STGSYL computes a Frobenius norm-based estimate
-*> of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
-*> reciprocal of the smallest singular value of Z. See [1-2] for more
-*> information.
-*>
-*> This is a level 3 BLAS algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N', solve the generalized Sylvester equation (1).
-*> = 'T', solve the 'transposed' system (3).
-*> \endverbatim
-*>
-*> \param[in] IJOB
-*> \verbatim
-*> IJOB is INTEGER
-*> Specifies what kind of functionality to be performed.
-*> =0: solve (1) only.
-*> =1: The functionality of 0 and 3.
-*> =2: The functionality of 0 and 4.
-*> =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*> (look ahead strategy IJOB = 1 is used).
-*> =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*> ( SGECON on sub-systems is used ).
-*> Not referenced if TRANS = 'T'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The order of the matrices A and D, and the row dimension of
-*> the matrices C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices B and E, and the column dimension
-*> of the matrices C, F, R and L.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA, M)
-*> The upper quasi triangular matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB, N)
-*> The upper quasi triangular matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC, N)
-*> On entry, C contains the right-hand-side of the first matrix
-*> equation in (1) or (3).
-*> On exit, if IJOB = 0, 1 or 2, C has been overwritten by
-*> the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
-*> the solution achieved during the computation of the
-*> Dif-estimate.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is REAL array, dimension (LDD, M)
-*> The upper triangular matrix D.
-*> \endverbatim
-*>
-*> \param[in] LDD
-*> \verbatim
-*> LDD is INTEGER
-*> The leading dimension of the array D. LDD >= max(1, M).
-*> \endverbatim
-*>
-*> \param[in] E
-*> \verbatim
-*> E is REAL array, dimension (LDE, N)
-*> The upper triangular matrix E.
-*> \endverbatim
-*>
-*> \param[in] LDE
-*> \verbatim
-*> LDE is INTEGER
-*> The leading dimension of the array E. LDE >= max(1, N).
-*> \endverbatim
-*>
-*> \param[in,out] F
-*> \verbatim
-*> F is REAL array, dimension (LDF, N)
-*> On entry, F contains the right-hand-side of the second matrix
-*> equation in (1) or (3).
-*> On exit, if IJOB = 0, 1 or 2, F has been overwritten by
-*> the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
-*> the solution achieved during the computation of the
-*> Dif-estimate.
-*> \endverbatim
-*>
-*> \param[in] LDF
-*> \verbatim
-*> LDF is INTEGER
-*> The leading dimension of the array F. LDF >= max(1, M).
-*> \endverbatim
-*>
-*> \param[out] DIF
-*> \verbatim
-*> DIF is REAL
-*> On exit DIF is the reciprocal of a lower bound of the
-*> reciprocal of the Dif-function, i.e. DIF is an upper bound of
-*> Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
-*> IF IJOB = 0 or TRANS = 'T', DIF is not touched.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> On exit SCALE is the scaling factor in (1) or (3).
-*> If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
-*> to a slightly perturbed system but the input matrices A, B, D
-*> and E have not been changed. If SCALE = 0, C and F hold the
-*> solutions R and L, respectively, to the homogeneous system
-*> with C = F = 0. Normally, SCALE = 1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK > = 1.
-*> If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (M+N+6)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> =0: successful exit
-*> <0: If INFO = -i, the i-th argument had an illegal value.
-*> >0: (A, D) and (B, E) have common or close eigenvalues.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*> Umea University, S-901 87 Umea, Sweden.
-*
-*> \par References:
-* ================
-*>
-*> \verbatim
-*>
-*> [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*> for Solving the Generalized Sylvester Equation and Estimating the
-*> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*> Department of Computing Science, Umea University, S-901 87 Umea,
-*> Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*> Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
-*> No 1, 1996.
-*>
-*> [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
-*> Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
-*> Appl., 15(4):1045-1060, 1994
-*>
-*> [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
-*> Condition Estimators for Solving the Generalized Sylvester
-*> Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
-*> July 1989, pp 745-751.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
- $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
- $ LWORK, M, N
- REAL DIF, SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
- $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-* Replaced various illegal calls to SCOPY by calls to SLASET.
-* Sven Hammarling, 1/5/02.
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, NOTRAN
- INTEGER I, IE, IFUNC, IROUND, IS, ISOLVE, J, JE, JS, K,
- $ LINFO, LWMIN, MB, NB, P, PPQQ, PQ, Q
- REAL DSCALE, DSUM, SCALE2, SCALOC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SLACPY, SLASET, SSCAL, STGSY2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, REAL, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test input parameters
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -1
- ELSE IF( NOTRAN ) THEN
- IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.4 ) ) THEN
- INFO = -2
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( M.LE.0 ) THEN
- INFO = -3
- ELSE IF( N.LE.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
- INFO = -12
- ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
- INFO = -16
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( NOTRAN ) THEN
- IF( IJOB.EQ.1 .OR. IJOB.EQ.2 ) THEN
- LWMIN = MAX( 1, 2*M*N )
- ELSE
- LWMIN = 1
- END IF
- ELSE
- LWMIN = 1
- END IF
- WORK( 1 ) = LWMIN
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STGSYL', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- SCALE = 1
- IF( NOTRAN ) THEN
- IF( IJOB.NE.0 ) THEN
- DIF = 0
- END IF
- END IF
- RETURN
- END IF
-*
-* Determine optimal block sizes MB and NB
-*
- MB = ILAENV( 2, 'STGSYL', TRANS, M, N, -1, -1 )
- NB = ILAENV( 5, 'STGSYL', TRANS, M, N, -1, -1 )
-*
- ISOLVE = 1
- IFUNC = 0
- IF( NOTRAN ) THEN
- IF( IJOB.GE.3 ) THEN
- IFUNC = IJOB - 2
- CALL SLASET( 'F', M, N, ZERO, ZERO, C, LDC )
- CALL SLASET( 'F', M, N, ZERO, ZERO, F, LDF )
- ELSE IF( IJOB.GE.1 .AND. NOTRAN ) THEN
- ISOLVE = 2
- END IF
- END IF
-*
- IF( ( MB.LE.1 .AND. NB.LE.1 ) .OR. ( MB.GE.M .AND. NB.GE.N ) )
- $ THEN
-*
- DO 30 IROUND = 1, ISOLVE
-*
-* Use unblocked Level 2 solver
-*
- DSCALE = ZERO
- DSUM = ONE
- PQ = 0
- CALL STGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D,
- $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE,
- $ IWORK, PQ, INFO )
- IF( DSCALE.NE.ZERO ) THEN
- IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
- DIF = SQRT( REAL( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
- ELSE
- DIF = SQRT( REAL( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
- END IF
- END IF
-*
- IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
- IF( NOTRAN ) THEN
- IFUNC = IJOB
- END IF
- SCALE2 = SCALE
- CALL SLACPY( 'F', M, N, C, LDC, WORK, M )
- CALL SLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
- CALL SLASET( 'F', M, N, ZERO, ZERO, C, LDC )
- CALL SLASET( 'F', M, N, ZERO, ZERO, F, LDF )
- ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
- CALL SLACPY( 'F', M, N, WORK, M, C, LDC )
- CALL SLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
- SCALE = SCALE2
- END IF
- 30 CONTINUE
-*
- RETURN
- END IF
-*
-* Determine block structure of A
-*
- P = 0
- I = 1
- 40 CONTINUE
- IF( I.GT.M )
- $ GO TO 50
- P = P + 1
- IWORK( P ) = I
- I = I + MB
- IF( I.GE.M )
- $ GO TO 50
- IF( A( I, I-1 ).NE.ZERO )
- $ I = I + 1
- GO TO 40
- 50 CONTINUE
-*
- IWORK( P+1 ) = M + 1
- IF( IWORK( P ).EQ.IWORK( P+1 ) )
- $ P = P - 1
-*
-* Determine block structure of B
-*
- Q = P + 1
- J = 1
- 60 CONTINUE
- IF( J.GT.N )
- $ GO TO 70
- Q = Q + 1
- IWORK( Q ) = J
- J = J + NB
- IF( J.GE.N )
- $ GO TO 70
- IF( B( J, J-1 ).NE.ZERO )
- $ J = J + 1
- GO TO 60
- 70 CONTINUE
-*
- IWORK( Q+1 ) = N + 1
- IF( IWORK( Q ).EQ.IWORK( Q+1 ) )
- $ Q = Q - 1
-*
- IF( NOTRAN ) THEN
-*
- DO 150 IROUND = 1, ISOLVE
-*
-* Solve (I, J)-subsystem
-* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-* for I = P, P - 1,..., 1; J = 1, 2,..., Q
-*
- DSCALE = ZERO
- DSUM = ONE
- PQ = 0
- SCALE = ONE
- DO 130 J = P + 2, Q
- JS = IWORK( J )
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- DO 120 I = P, 1, -1
- IS = IWORK( I )
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- PPQQ = 0
- CALL STGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
- $ B( JS, JS ), LDB, C( IS, JS ), LDC,
- $ D( IS, IS ), LDD, E( JS, JS ), LDE,
- $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
- $ IWORK( Q+2 ), PPQQ, LINFO )
- IF( LINFO.GT.0 )
- $ INFO = LINFO
-*
- PQ = PQ + PPQQ
- IF( SCALOC.NE.ONE ) THEN
- DO 80 K = 1, JS - 1
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 80 CONTINUE
- DO 90 K = JS, JE
- CALL SSCAL( IS-1, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( IS-1, SCALOC, F( 1, K ), 1 )
- 90 CONTINUE
- DO 100 K = JS, JE
- CALL SSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
- CALL SSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
- 100 CONTINUE
- DO 110 K = JE + 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 110 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Substitute R(I, J) and L(I, J) into remaining
-* equation.
-*
- IF( I.GT.1 ) THEN
- CALL SGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ A( 1, IS ), LDA, C( IS, JS ), LDC, ONE,
- $ C( 1, JS ), LDC )
- CALL SGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
- $ D( 1, IS ), LDD, C( IS, JS ), LDC, ONE,
- $ F( 1, JS ), LDF )
- END IF
- IF( J.LT.Q ) THEN
- CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE,
- $ F( IS, JS ), LDF, B( JS, JE+1 ), LDB,
- $ ONE, C( IS, JE+1 ), LDC )
- CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE,
- $ F( IS, JS ), LDF, E( JS, JE+1 ), LDE,
- $ ONE, F( IS, JE+1 ), LDF )
- END IF
- 120 CONTINUE
- 130 CONTINUE
- IF( DSCALE.NE.ZERO ) THEN
- IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
- DIF = SQRT( REAL( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
- ELSE
- DIF = SQRT( REAL( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
- END IF
- END IF
- IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
- IF( NOTRAN ) THEN
- IFUNC = IJOB
- END IF
- SCALE2 = SCALE
- CALL SLACPY( 'F', M, N, C, LDC, WORK, M )
- CALL SLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
- CALL SLASET( 'F', M, N, ZERO, ZERO, C, LDC )
- CALL SLASET( 'F', M, N, ZERO, ZERO, F, LDF )
- ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
- CALL SLACPY( 'F', M, N, WORK, M, C, LDC )
- CALL SLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
- SCALE = SCALE2
- END IF
- 150 CONTINUE
-*
- ELSE
-*
-* Solve transposed (I, J)-subsystem
-* A(I, I)**T * R(I, J) + D(I, I)**T * L(I, J) = C(I, J)
-* R(I, J) * B(J, J)**T + L(I, J) * E(J, J)**T = -F(I, J)
-* for I = 1,2,..., P; J = Q, Q-1,..., 1
-*
- SCALE = ONE
- DO 210 I = 1, P
- IS = IWORK( I )
- IE = IWORK( I+1 ) - 1
- MB = IE - IS + 1
- DO 200 J = Q, P + 2, -1
- JS = IWORK( J )
- JE = IWORK( J+1 ) - 1
- NB = JE - JS + 1
- CALL STGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
- $ B( JS, JS ), LDB, C( IS, JS ), LDC,
- $ D( IS, IS ), LDD, E( JS, JS ), LDE,
- $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
- $ IWORK( Q+2 ), PPQQ, LINFO )
- IF( LINFO.GT.0 )
- $ INFO = LINFO
- IF( SCALOC.NE.ONE ) THEN
- DO 160 K = 1, JS - 1
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 160 CONTINUE
- DO 170 K = JS, JE
- CALL SSCAL( IS-1, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( IS-1, SCALOC, F( 1, K ), 1 )
- 170 CONTINUE
- DO 180 K = JS, JE
- CALL SSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
- CALL SSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
- 180 CONTINUE
- DO 190 K = JE + 1, N
- CALL SSCAL( M, SCALOC, C( 1, K ), 1 )
- CALL SSCAL( M, SCALOC, F( 1, K ), 1 )
- 190 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
-*
-* Substitute R(I, J) and L(I, J) into remaining equation.
-*
- IF( J.GT.P+2 ) THEN
- CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, JS ),
- $ LDC, B( 1, JS ), LDB, ONE, F( IS, 1 ),
- $ LDF )
- CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, JS ),
- $ LDF, E( 1, JS ), LDE, ONE, F( IS, 1 ),
- $ LDF )
- END IF
- IF( I.LT.P ) THEN
- CALL SGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ A( IS, IE+1 ), LDA, C( IS, JS ), LDC, ONE,
- $ C( IE+1, JS ), LDC )
- CALL SGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
- $ D( IS, IE+1 ), LDD, F( IS, JS ), LDF, ONE,
- $ C( IE+1, JS ), LDC )
- END IF
- 200 CONTINUE
- 210 CONTINUE
-*
- END IF
-*
- WORK( 1 ) = LWMIN
-*
- RETURN
-*
-* End of STGSYL
-*
- END
diff --git a/netlib/LAPACK/stpcon.f b/netlib/LAPACK/stpcon.f
deleted file mode 100644
index 2e4ce62..0000000
--- a/netlib/LAPACK/stpcon.f
+++ /dev/null
@@ -1,267 +0,0 @@
-*> \brief \b STPCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER INFO, N
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AP( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPCON estimates the reciprocal of the condition number of a packed
-*> triangular matrix A, in either the 1-norm or the infinity-norm.
-*>
-*> The norm of A is computed and an estimate is obtained for
-*> norm(inv(A)), then the reciprocal of the condition number is
-*> computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER INFO, N
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AP( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, ONENRM, UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- REAL AINVNM, ANORM, SCALE, SMLNUM, XNORM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH, SLANTP
- EXTERNAL LSAME, ISAMAX, SLAMCH, SLANTP
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATPS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- END IF
-*
- RCOND = ZERO
- SMLNUM = SLAMCH( 'Safe minimum' )*REAL( MAX( 1, N ) )
-*
-* Compute the norm of the triangular matrix A.
-*
- ANORM = SLANTP( NORM, UPLO, DIAG, N, AP, WORK )
-*
-* Continue only if ANORM > 0.
-*
- IF( ANORM.GT.ZERO ) THEN
-*
-* Estimate the norm of the inverse of A.
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(A).
-*
- CALL SLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP,
- $ WORK, SCALE, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(A**T).
-*
- CALL SLATPS( UPLO, 'Transpose', DIAG, NORMIN, N, AP,
- $ WORK, SCALE, WORK( 2*N+1 ), INFO )
- END IF
- NORMIN = 'Y'
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- XNORM = ABS( WORK( IX ) )
- IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / ANORM ) / AINVNM
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of STPCON
-*
- END
diff --git a/netlib/LAPACK/stpmqrt.f b/netlib/LAPACK/stpmqrt.f
deleted file mode 100644
index 848507f..0000000
--- a/netlib/LAPACK/stpmqrt.f
+++ /dev/null
@@ -1,366 +0,0 @@
-*> \brief \b STPMQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPMQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpmqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpmqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpmqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
-* A, LDA, B, LDB, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
-* ..
-* .. Array Arguments ..
-* REAL V( LDV, * ), A( LDA, * ), B( LDB, * ), T( LDT, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPMQRT applies a real orthogonal matrix Q obtained from a
-*> "triangular-pentagonal" real block reflector H to a general
-*> real matrix C, which consists of two blocks A and B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q^H from the Left;
-*> = 'R': apply Q or Q^H from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q^H.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix B. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The order of the trapezoidal part of V.
-*> K >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size used for the storage of T. K >= NB >= 1.
-*> This must be the same value of NB used to generate T
-*> in CTPQRT.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> CTPQRT in B. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDV >= max(1,M);
-*> if SIDE = 'R', LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,K)
-*> The upper triangular factors of the block reflectors
-*> as returned by CTPQRT, stored as a NB-by-K matrix.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,N) if SIDE = 'L' or
-*> (LDA,K) if SIDE = 'R'
-*> On entry, the K-by-N or M-by-K matrix A.
-*> On exit, A is overwritten by the corresponding block of
-*> Q*C or Q^H*C or C*Q or C*Q^H. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDC >= max(1,K);
-*> If SIDE = 'R', LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the M-by-N matrix B.
-*> On exit, B is overwritten by the corresponding block of
-*> Q*C or Q^H*C or C*Q or C*Q^H. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B.
-*> LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array. The dimension of WORK is
-*> N*NB if SIDE = 'L', or M*NB if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The columns of the pentagonal matrix V contain the elementary reflectors
-*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a
-*> trapezoidal block V2:
-*>
-*> V = [V1]
-*> [V2].
-*>
-*> The size of the trapezoidal block V2 is determined by the parameter L,
-*> where 0 <= L <= K; V2 is upper trapezoidal, consisting of the first L
-*> rows of a K-by-K upper triangular matrix. If L=K, V2 is upper triangular;
-*> if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
-*>
-*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is M-by-K.
-*> [B]
-*>
-*> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is N-by-K.
-*>
-*> The real orthogonal matrix Q is formed from V and T.
-*>
-*> If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
-*>
-*> If TRANS='C' and SIDE='L', C is on exit replaced with Q^H * C.
-*>
-*> If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
-*>
-*> If TRANS='C' and SIDE='R', C is on exit replaced with C * Q^H.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
- $ A, LDA, B, LDB, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
-* ..
-* .. Array Arguments ..
- REAL V( LDV, * ), A( LDA, * ), B( LDB, * ), T( LDT, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, MB, LB, KF, Q
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SLARFB
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* .. Test the input arguments ..
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- RIGHT = LSAME( SIDE, 'R' )
- TRAN = LSAME( TRANS, 'T' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
- IF( LEFT ) THEN
- Q = M
- ELSE IF ( RIGHT ) THEN
- Q = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
- INFO = -1
- ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 ) THEN
- INFO = -5
- ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
- INFO = -6
- ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN
- INFO = -7
- ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
- INFO = -9
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -11
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -13
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -15
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPMQRT', -INFO )
- RETURN
- END IF
-*
-* .. Quick return if possible ..
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
-*
- IF( LEFT .AND. TRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( M-L+I+IB-1, M )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-M+L-I+1
- END IF
- CALL STPRFB( 'L', 'T', 'F', 'C', MB, N, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( I, 1 ), LDA, B, LDB, WORK, IB )
- END DO
-*
- ELSE IF( RIGHT .AND. NOTRAN ) THEN
-*
- DO I = 1, K, NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( N-L+I+IB-1, N )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-N+L-I+1
- END IF
- CALL STPRFB( 'R', 'N', 'F', 'C', M, MB, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( 1, I ), LDA, B, LDB, WORK, M )
- END DO
-*
- ELSE IF( LEFT .AND. NOTRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( M-L+I+IB-1, M )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-M+L-I+1
- END IF
- CALL STPRFB( 'L', 'N', 'F', 'C', MB, N, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( I, 1 ), LDA, B, LDB, WORK, IB )
- END DO
-*
- ELSE IF( RIGHT .AND. TRAN ) THEN
-*
- KF = ((K-1)/NB)*NB+1
- DO I = KF, 1, -NB
- IB = MIN( NB, K-I+1 )
- MB = MIN( N-L+I+IB-1, N )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-N+L-I+1
- END IF
- CALL STPRFB( 'R', 'T', 'F', 'C', M, MB, IB, LB,
- $ V( 1, I ), LDV, T( 1, I ), LDT,
- $ A( 1, I ), LDA, B, LDB, WORK, M )
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of STPMQRT
-*
- END
diff --git a/netlib/LAPACK/stpqrt.f b/netlib/LAPACK/stpqrt.f
deleted file mode 100644
index d9efb26..0000000
--- a/netlib/LAPACK/stpqrt.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b STPQRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPQRT + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpqrt.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpqrt.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpqrt.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPQRT computes a blocked QR factorization of a real
-*> "triangular-pentagonal" matrix C, which is composed of a
-*> triangular block A and pentagonal block B, using the compact
-*> WY representation for Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix B.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B, and the order of the
-*> triangular matrix A.
-*> N >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of rows of the upper trapezoidal part of B.
-*> MIN(M,N) >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The block size to be used in the blocked QR. N >= NB >= 1.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the upper triangular N-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the pentagonal M-by-N matrix B. The first M-L rows
-*> are rectangular, and the last L rows are upper trapezoidal.
-*> On exit, B contains the pentagonal matrix V. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> The upper triangular block reflectors stored in compact form
-*> as a sequence of upper triangular blocks. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (NB*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The input matrix C is a (N+M)-by-N matrix
-*>
-*> C = [ A ]
-*> [ B ]
-*>
-*> where A is an upper triangular N-by-N matrix, and B is M-by-N pentagonal
-*> matrix consisting of a (M-L)-by-N rectangular matrix B1 on top of a L-by-N
-*> upper trapezoidal matrix B2:
-*>
-*> B = [ B1 ] <- (M-L)-by-N rectangular
-*> [ B2 ] <- L-by-N upper trapezoidal.
-*>
-*> The upper trapezoidal matrix B2 consists of the first L rows of a
-*> N-by-N upper triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
-*> B is rectangular M-by-N; if M=L=N, B is upper triangular.
-*>
-*> The matrix W stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal (of A) in the (N+M)-by-N input matrix C
-*>
-*> C = [ A ] <- upper triangular N-by-N
-*> [ B ] <- M-by-N pentagonal
-*>
-*> so that W can be represented as
-*>
-*> W = [ I ] <- identity, N-by-N
-*> [ V ] <- M-by-N, same form as B.
-*>
-*> Thus, all of information needed for W is contained on exit in B, which
-*> we call V above. Note that V has the same form as B; that is,
-*>
-*> V = [ V1 ] <- (M-L)-by-N rectangular
-*> [ V2 ] <- L-by-N upper trapezoidal.
-*>
-*> The columns of V represent the vectors which define the H(i)'s.
-*>
-*> The number of blocks is B = ceiling(N/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = N - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
-*>
-*> T = [T1 T2 ... TB].
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- INTEGER I, IB, LB, MB, IINFO
-* ..
-* .. External Subroutines ..
- EXTERNAL STPQRT2, STPRFB, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
- INFO = -3
- ELSE IF( NB.LT.1 .OR. NB.GT.N ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -8
- ELSE IF( LDT.LT.NB ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPQRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) RETURN
-*
- DO I = 1, N, NB
-*
-* Compute the QR factorization of the current block
-*
- IB = MIN( N-I+1, NB )
- MB = MIN( M-L+I+IB-1, M )
- IF( I.GE.L ) THEN
- LB = 0
- ELSE
- LB = MB-M+L-I+1
- END IF
-*
- CALL STPQRT2( MB, IB, LB, A(I,I), LDA, B( 1, I ), LDB,
- $ T(1, I ), LDT, IINFO )
-*
-* Update by applying H^H to B(:,I+IB:N) from the left
-*
- IF( I+IB.LE.N ) THEN
- CALL STPRFB( 'L', 'T', 'F', 'C', MB, N-I-IB+1, IB, LB,
- $ B( 1, I ), LDB, T( 1, I ), LDT,
- $ A( I, I+IB ), LDA, B( 1, I+IB ), LDB,
- $ WORK, IB )
- END IF
- END DO
- RETURN
-*
-* End of STPQRT
-*
- END
diff --git a/netlib/LAPACK/stpqrt2.f b/netlib/LAPACK/stpqrt2.f
deleted file mode 100644
index beb2b97..0000000
--- a/netlib/LAPACK/stpqrt2.f
+++ /dev/null
@@ -1,302 +0,0 @@
-*> \brief \b STPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPQRT2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpqrt2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpqrt2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpqrt2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, LDT, N, M, L
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), T( LDT, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPQRT2 computes a QR factorization of a real "triangular-pentagonal"
-*> matrix C, which is composed of a triangular block A and pentagonal block B,
-*> using the compact WY representation for Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The total number of rows of the matrix B.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B, and the order of
-*> the triangular matrix A.
-*> N >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The number of rows of the upper trapezoidal part of B.
-*> MIN(M,N) >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the upper triangular N-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the upper triangular matrix R.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the pentagonal M-by-N matrix B. The first M-L rows
-*> are rectangular, and the last L rows are upper trapezoidal.
-*> On exit, B contains the pentagonal matrix V. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> The N-by-N upper triangular factor T of the block reflector.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The input matrix C is a (N+M)-by-N matrix
-*>
-*> C = [ A ]
-*> [ B ]
-*>
-*> where A is an upper triangular N-by-N matrix, and B is M-by-N pentagonal
-*> matrix consisting of a (M-L)-by-N rectangular matrix B1 on top of a L-by-N
-*> upper trapezoidal matrix B2:
-*>
-*> B = [ B1 ] <- (M-L)-by-N rectangular
-*> [ B2 ] <- L-by-N upper trapezoidal.
-*>
-*> The upper trapezoidal matrix B2 consists of the first L rows of a
-*> N-by-N upper triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
-*> B is rectangular M-by-N; if M=L=N, B is upper triangular.
-*>
-*> The matrix W stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal (of A) in the (N+M)-by-N input matrix C
-*>
-*> C = [ A ] <- upper triangular N-by-N
-*> [ B ] <- M-by-N pentagonal
-*>
-*> so that W can be represented as
-*>
-*> W = [ I ] <- identity, N-by-N
-*> [ V ] <- M-by-N, same form as B.
-*>
-*> Thus, all of information needed for W is contained on exit in B, which
-*> we call V above. Note that V has the same form as B; that is,
-*>
-*> V = [ V1 ] <- (M-L)-by-N rectangular
-*> [ V2 ] <- L-by-N upper trapezoidal.
-*>
-*> The columns of V represent the vectors which define the H(i)'s.
-*> The (M+N)-by-(M+N) block reflector H is then given by
-*>
-*> H = I - W * T * W^H
-*>
-*> where W^H is the conjugate transpose of W and T is the upper triangular
-*> factor of the block reflector.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LDT, N, M, L
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), T( LDT, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER( ONE = 1.0, ZERO = 0.0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, P, MP, NP
- REAL ALPHA
-* ..
-* .. External Subroutines ..
- EXTERNAL SLARFG, SGEMV, SGER, STRMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
- INFO = -7
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPQRT2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 ) RETURN
-*
- DO I = 1, N
-*
-* Generate elementary reflector H(I) to annihilate B(:,I)
-*
- P = M-L+MIN( L, I )
- CALL SLARFG( P+1, A( I, I ), B( 1, I ), 1, T( I, 1 ) )
- IF( I.LT.N ) THEN
-*
-* W(1:N-I) := C(I:M,I+1:N)^H * C(I:M,I) [use W = T(:,N)]
-*
- DO J = 1, N-I
- T( J, N ) = (A( I, I+J ))
- END DO
- CALL SGEMV( 'T', P, N-I, ONE, B( 1, I+1 ), LDB,
- $ B( 1, I ), 1, ONE, T( 1, N ), 1 )
-*
-* C(I:M,I+1:N) = C(I:m,I+1:N) + alpha*C(I:M,I)*W(1:N-1)^H
-*
- ALPHA = -(T( I, 1 ))
- DO J = 1, N-I
- A( I, I+J ) = A( I, I+J ) + ALPHA*(T( J, N ))
- END DO
- CALL SGER( P, N-I, ALPHA, B( 1, I ), 1,
- $ T( 1, N ), 1, B( 1, I+1 ), LDB )
- END IF
- END DO
-*
- DO I = 2, N
-*
-* T(1:I-1,I) := C(I:M,1:I-1)^H * (alpha * C(I:M,I))
-*
- ALPHA = -T( I, 1 )
-
- DO J = 1, I-1
- T( J, I ) = ZERO
- END DO
- P = MIN( I-1, L )
- MP = MIN( M-L+1, M )
- NP = MIN( P+1, N )
-*
-* Triangular part of B2
-*
- DO J = 1, P
- T( J, I ) = ALPHA*B( M-L+J, I )
- END DO
- CALL STRMV( 'U', 'T', 'N', P, B( MP, 1 ), LDB,
- $ T( 1, I ), 1 )
-*
-* Rectangular part of B2
-*
- CALL SGEMV( 'T', L, I-1-P, ALPHA, B( MP, NP ), LDB,
- $ B( MP, I ), 1, ZERO, T( NP, I ), 1 )
-*
-* B1
-*
- CALL SGEMV( 'T', M-L, I-1, ALPHA, B, LDB, B( 1, I ), 1,
- $ ONE, T( 1, I ), 1 )
-*
-* T(1:I-1,I) := T(1:I-1,1:I-1) * T(1:I-1,I)
-*
- CALL STRMV( 'U', 'N', 'N', I-1, T, LDT, T( 1, I ), 1 )
-*
-* T(I,I) = tau(I)
-*
- T( I, I ) = T( I, 1 )
- T( I, 1 ) = ZERO
- END DO
-
-*
-* End of STPQRT2
-*
- END
diff --git a/netlib/LAPACK/stprfb.f b/netlib/LAPACK/stprfb.f
deleted file mode 100644
index 01383ae..0000000
--- a/netlib/LAPACK/stprfb.f
+++ /dev/null
@@ -1,811 +0,0 @@
-*> \brief \b STPRFB applies a real or complex "triangular-pentagonal" blocked reflector to a real or complex matrix, which is composed of two blocks.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPRFB + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stprfb.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stprfb.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stprfb.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L,
-* V, LDV, T, LDT, A, LDA, B, LDB, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, L, LDA, LDB, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPRFB applies a real "triangular-pentagonal" block reflector H or its
-*> conjugate transpose H^H to a real matrix C, which is composed of two
-*> blocks A and B, either from the left or right.
-*>
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H^H from the Left
-*> = 'R': apply H or H^H from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'C': apply H^H (Conjugate transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = '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
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columns
-*> = 'R': Rows
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix B.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix B.
-*> N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T, i.e. the number of elementary
-*> reflectors whose product defines the block reflector.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] L
-*> \verbatim
-*> L is INTEGER
-*> The order of the trapezoidal part of V.
-*> K >= L >= 0. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is REAL array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
-*> The pentagonal matrix V, which contains the elementary reflectors
-*> H(1), H(2), ..., H(K). See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
-*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*> if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,K)
-*> The triangular K-by-K matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T.
-*> LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension
-*> (LDA,N) if SIDE = 'L' or (LDA,K) if SIDE = 'R'
-*> On entry, the K-by-N or M-by-K matrix A.
-*> On exit, A is overwritten by the corresponding block of
-*> H*C or H^H*C or C*H or C*H^H. See Futher Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDC >= max(1,K);
-*> If SIDE = 'R', LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> On entry, the M-by-N matrix B.
-*> On exit, B is overwritten by the corresponding block of
-*> H*C or H^H*C or C*H or C*H^H. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B.
-*> LDB >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension
-*> (LDWORK,N) if SIDE = 'L',
-*> (LDWORK,K) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= K;
-*> if SIDE = 'R', LDWORK >= M.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix C is a composite matrix formed from blocks A and B.
-*> The block B is of size M-by-N; if SIDE = 'R', A is of size M-by-K,
-*> and if SIDE = 'L', A is of size K-by-N.
-*>
-*> If SIDE = 'R' and DIRECT = 'F', C = [A B].
-*>
-*> If SIDE = 'L' and DIRECT = 'F', C = [A]
-*> [B].
-*>
-*> If SIDE = 'R' and DIRECT = 'B', C = [B A].
-*>
-*> If SIDE = 'L' and DIRECT = 'B', C = [B]
-*> [A].
-*>
-*> The pentagonal matrix V is composed of a rectangular block V1 and a
-*> trapezoidal block V2. The size of the trapezoidal block is determined by
-*> the parameter L, where 0<=L<=K. If L=K, the V2 block of V is triangular;
-*> if L=0, there is no trapezoidal block, thus V = V1 is rectangular.
-*>
-*> If DIRECT = 'F' and STOREV = 'C': V = [V1]
-*> [V2]
-*> - V2 is upper trapezoidal (first L rows of K-by-K upper triangular)
-*>
-*> If DIRECT = 'F' and STOREV = 'R': V = [V1 V2]
-*>
-*> - V2 is lower trapezoidal (first L columns of K-by-K lower triangular)
-*>
-*> If DIRECT = 'B' and STOREV = 'C': V = [V2]
-*> [V1]
-*> - V2 is lower trapezoidal (last L rows of K-by-K lower triangular)
-*>
-*> If DIRECT = 'B' and STOREV = 'R': V = [V2 V1]
-*>
-*> - V2 is upper trapezoidal (last L columns of K-by-K upper triangular)
-*>
-*> If STOREV = 'C' and SIDE = 'L', V is M-by-K with V2 L-by-K.
-*>
-*> If STOREV = 'C' and SIDE = 'R', V is N-by-K with V2 L-by-K.
-*>
-*> If STOREV = 'R' and SIDE = 'L', V is K-by-M with V2 K-by-L.
-*>
-*> If STOREV = 'R' and SIDE = 'R', V is K-by-N with V2 K-by-L.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L,
- $ V, LDV, T, LDT, A, LDA, B, LDB, WORK, LDWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, L, LDA, LDB, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), T( LDT, * ),
- $ V( LDV, * ), WORK( LDWORK, * )
-* ..
-*
-* ==========================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0, ZERO = 0.0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, MP, NP, KP
- LOGICAL LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, STRMM
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 .OR. L.LT.0 ) RETURN
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
- COLUMN = .TRUE.
- ROW = .FALSE.
- ELSE IF ( LSAME( STOREV, 'R' ) ) THEN
- COLUMN = .FALSE.
- ROW = .TRUE.
- ELSE
- COLUMN = .FALSE.
- ROW = .FALSE.
- END IF
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
- LEFT = .TRUE.
- RIGHT = .FALSE.
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
- LEFT = .FALSE.
- RIGHT = .TRUE.
- ELSE
- LEFT = .FALSE.
- RIGHT = .FALSE.
- END IF
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
- FORWARD = .TRUE.
- BACKWARD = .FALSE.
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- FORWARD = .FALSE.
- BACKWARD = .TRUE.
- ELSE
- FORWARD = .FALSE.
- BACKWARD = .FALSE.
- END IF
-*
-* ---------------------------------------------------------------------------
-*
- IF( COLUMN .AND. FORWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I ] (K-by-K)
-* [ V ] (M-by-K)
-*
-* Form H C or H^H C where C = [ A ] (K-by-N)
-* [ B ] (M-by-N)
-*
-* H = I - W T W^H or H^H = I - W T^H W^H
-*
-* A = A - T (A + V^H B) or A = A - T^H (A + V^H B)
-* B = B - V T (A + V^H B) or B = B - V T^H (A + V^H B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( M-L+1, M )
- KP = MIN( L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( I, J ) = B( M-L+I, J )
- END DO
- END DO
- CALL STRMM( 'L', 'U', 'T', 'N', L, N, ONE, V( MP, 1 ), LDV,
- $ WORK, LDWORK )
- CALL SGEMM( 'T', 'N', L, N, M-L, ONE, V, LDV, B, LDB,
- $ ONE, WORK, LDWORK )
- CALL SGEMM( 'T', 'N', K-L, N, M, ONE, V( 1, KP ), LDV,
- $ B, LDB, ZERO, WORK( KP, 1 ), LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'N', 'N', M-L, N, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, B, LDB )
- CALL SGEMM( 'N', 'N', L, N, K-L, -ONE, V( MP, KP ), LDV,
- $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB )
- CALL STRMM( 'L', 'U', 'N', 'N', L, N, ONE, V( MP, 1 ), LDV,
- $ WORK, LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( M-L+I, J ) = B( M-L+I, J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( COLUMN .AND. FORWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I ] (K-by-K)
-* [ V ] (N-by-K)
-*
-* Form C H or C H^H where C = [ A B ] (A is M-by-K, B is M-by-N)
-*
-* H = I - W T W^H or H^H = I - W T^H W^H
-*
-* A = A - (A + B V) T or A = A - (A + B V) T^H
-* B = B - (A + B V) T V^H or B = B - (A + B V) T^H V^H
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( N-L+1, N )
- KP = MIN( L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, J ) = B( I, N-L+J )
- END DO
- END DO
- CALL STRMM( 'R', 'U', 'N', 'N', M, L, ONE, V( NP, 1 ), LDV,
- $ WORK, LDWORK )
- CALL SGEMM( 'N', 'N', M, L, N-L, ONE, B, LDB,
- $ V, LDV, ONE, WORK, LDWORK )
- CALL SGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB,
- $ V( 1, KP ), LDV, ZERO, WORK( 1, KP ), LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'N', 'T', M, N-L, K, -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL SGEMM( 'N', 'T', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK,
- $ V( NP, KP ), LDV, ONE, B( 1, NP ), LDB )
- CALL STRMM( 'R', 'U', 'T', 'N', M, L, ONE, V( NP, 1 ), LDV,
- $ WORK, LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, N-L+J ) = B( I, N-L+J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( COLUMN .AND. BACKWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V ] (M-by-K)
-* [ I ] (K-by-K)
-*
-* Form H C or H^H C where C = [ B ] (M-by-N)
-* [ A ] (K-by-N)
-*
-* H = I - W T W^H or H^H = I - W T^H W^H
-*
-* A = A - T (A + V^H B) or A = A - T^H (A + V^H B)
-* B = B - V T (A + V^H B) or B = B - V T^H (A + V^H B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( L+1, M )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( K-L+I, J ) = B( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'L', 'L', 'T', 'N', L, N, ONE, V( 1, KP ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- CALL SGEMM( 'T', 'N', L, N, M-L, ONE, V( MP, KP ), LDV,
- $ B( MP, 1 ), LDB, ONE, WORK( KP, 1 ), LDWORK )
- CALL SGEMM( 'T', 'N', K-L, N, M, ONE, V, LDV,
- $ B, LDB, ZERO, WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'L', 'L', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'N', 'N', M-L, N, K, -ONE, V( MP, 1 ), LDV,
- $ WORK, LDWORK, ONE, B( MP, 1 ), LDB )
- CALL SGEMM( 'N', 'N', L, N, K-L, -ONE, V, LDV,
- $ WORK, LDWORK, ONE, B, LDB )
- CALL STRMM( 'L', 'L', 'N', 'N', L, N, ONE, V( 1, KP ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( I, J ) = B( I, J ) - WORK( K-L+I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( COLUMN .AND. BACKWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V ] (N-by-K)
-* [ I ] (K-by-K)
-*
-* Form C H or C H^H where C = [ B A ] (B is M-by-N, A is M-by-K)
-*
-* H = I - W T W^H or H^H = I - W T^H W^H
-*
-* A = A - (A + B V) T or A = A - (A + B V) T^H
-* B = B - (A + B V) T V^H or B = B - (A + B V) T^H V^H
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( L+1, N )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, K-L+J ) = B( I, J )
- END DO
- END DO
- CALL STRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, KP ), LDV,
- $ WORK( 1, KP ), LDWORK )
- CALL SGEMM( 'N', 'N', M, L, N-L, ONE, B( 1, NP ), LDB,
- $ V( NP, KP ), LDV, ONE, WORK( 1, KP ), LDWORK )
- CALL SGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB,
- $ V, LDV, ZERO, WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'N', 'T', M, N-L, K, -ONE, WORK, LDWORK,
- $ V( NP, 1 ), LDV, ONE, B( 1, NP ), LDB )
- CALL SGEMM( 'N', 'T', M, L, K-L, -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL STRMM( 'R', 'L', 'T', 'N', M, L, ONE, V( 1, KP ), LDV,
- $ WORK( 1, KP ), LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, J ) = B( I, J ) - WORK( I, K-L+J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. FORWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I V ] ( I is K-by-K, V is K-by-M )
-*
-* Form H C or H^H C where C = [ A ] (K-by-N)
-* [ B ] (M-by-N)
-*
-* H = I - W^H T W or H^H = I - W^H T^H W
-*
-* A = A - T (A + V B) or A = A - T^H (A + V B)
-* B = B - V^H T (A + V B) or B = B - V^H T^H (A + V B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( M-L+1, M )
- KP = MIN( L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( I, J ) = B( M-L+I, J )
- END DO
- END DO
- CALL STRMM( 'L', 'L', 'N', 'N', L, N, ONE, V( 1, MP ), LDV,
- $ WORK, LDB )
- CALL SGEMM( 'N', 'N', L, N, M-L, ONE, V, LDV,B, LDB,
- $ ONE, WORK, LDWORK )
- CALL SGEMM( 'N', 'N', K-L, N, M, ONE, V( KP, 1 ), LDV,
- $ B, LDB, ZERO, WORK( KP, 1 ), LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'T', 'N', M-L, N, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, B, LDB )
- CALL SGEMM( 'T', 'N', L, N, K-L, -ONE, V( KP, MP ), LDV,
- $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB )
- CALL STRMM( 'L', 'L', 'T', 'N', L, N, ONE, V( 1, MP ), LDV,
- $ WORK, LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( M-L+I, J ) = B( M-L+I, J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. FORWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ I V ] ( I is K-by-K, V is K-by-N )
-*
-* Form C H or C H^H where C = [ A B ] (A is M-by-K, B is M-by-N)
-*
-* H = I - W^H T W or H^H = I - W^H T^H W
-*
-* A = A - (A + B V^H) T or A = A - (A + B V^H) T^H
-* B = B - (A + B V^H) T V or B = B - (A + B V^H) T^H V
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( N-L+1, N )
- KP = MIN( L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, J ) = B( I, N-L+J )
- END DO
- END DO
- CALL STRMM( 'R', 'L', 'T', 'N', M, L, ONE, V( 1, NP ), LDV,
- $ WORK, LDWORK )
- CALL SGEMM( 'N', 'T', M, L, N-L, ONE, B, LDB, V, LDV,
- $ ONE, WORK, LDWORK )
- CALL SGEMM( 'N', 'T', M, K-L, N, ONE, B, LDB,
- $ V( KP, 1 ), LDV, ZERO, WORK( 1, KP ), LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL SGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK,
- $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB )
- CALL STRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV,
- $ WORK, LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, N-L+J ) = B( I, N-L+J ) - WORK( I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. BACKWARD .AND. LEFT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V I ] ( I is K-by-K, V is K-by-M )
-*
-* Form H C or H^H C where C = [ B ] (M-by-N)
-* [ A ] (K-by-N)
-*
-* H = I - W^H T W or H^H = I - W^H T^H W
-*
-* A = A - T (A + V B) or A = A - T^H (A + V B)
-* B = B - V^H T (A + V B) or B = B - V^H T^H (A + V B)
-*
-* ---------------------------------------------------------------------------
-*
- MP = MIN( L+1, M )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, N
- DO I = 1, L
- WORK( K-L+I, J ) = B( I, J )
- END DO
- END DO
- CALL STRMM( 'L', 'U', 'N', 'N', L, N, ONE, V( KP, 1 ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- CALL SGEMM( 'N', 'N', L, N, M-L, ONE, V( KP, MP ), LDV,
- $ B( MP, 1 ), LDB, ONE, WORK( KP, 1 ), LDWORK )
- CALL SGEMM( 'N', 'N', K-L, N, M, ONE, V, LDV, B, LDB,
- $ ZERO, WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'L', 'L ', TRANS, 'N', K, N, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, N
- DO I = 1, K
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'T', 'N', M-L, N, K, -ONE, V( 1, MP ), LDV,
- $ WORK, LDWORK, ONE, B( MP, 1 ), LDB )
- CALL SGEMM( 'T', 'N', L, N, K-L, -ONE, V, LDV,
- $ WORK, LDWORK, ONE, B, LDB )
- CALL STRMM( 'L', 'U', 'T', 'N', L, N, ONE, V( KP, 1 ), LDV,
- $ WORK( KP, 1 ), LDWORK )
- DO J = 1, N
- DO I = 1, L
- B( I, J ) = B( I, J ) - WORK( K-L+I, J )
- END DO
- END DO
-*
-* ---------------------------------------------------------------------------
-*
- ELSE IF( ROW .AND. BACKWARD .AND. RIGHT ) THEN
-*
-* ---------------------------------------------------------------------------
-*
-* Let W = [ V I ] ( I is K-by-K, V is K-by-N )
-*
-* Form C H or C H^H where C = [ B A ] (A is M-by-K, B is M-by-N)
-*
-* H = I - W^H T W or H^H = I - W^H T^H W
-*
-* A = A - (A + B V^H) T or A = A - (A + B V^H) T^H
-* B = B - (A + B V^H) T V or B = B - (A + B V^H) T^H V
-*
-* ---------------------------------------------------------------------------
-*
- NP = MIN( L+1, N )
- KP = MIN( K-L+1, K )
-*
- DO J = 1, L
- DO I = 1, M
- WORK( I, K-L+J ) = B( I, J )
- END DO
- END DO
- CALL STRMM( 'R', 'U', 'T', 'N', M, L, ONE, V( KP, 1 ), LDV,
- $ WORK( 1, KP ), LDWORK )
- CALL SGEMM( 'N', 'T', M, L, N-L, ONE, B( 1, NP ), LDB,
- $ V( KP, NP ), LDV, ONE, WORK( 1, KP ), LDWORK )
- CALL SGEMM( 'N', 'T', M, K-L, N, ONE, B, LDB, V, LDV,
- $ ZERO, WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- WORK( I, J ) = WORK( I, J ) + A( I, J )
- END DO
- END DO
-*
- CALL STRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT,
- $ WORK, LDWORK )
-*
- DO J = 1, K
- DO I = 1, M
- A( I, J ) = A( I, J ) - WORK( I, J )
- END DO
- END DO
-*
- CALL SGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK,
- $ V( 1, NP ), LDV, ONE, B( 1, NP ), LDB )
- CALL SGEMM( 'N', 'N', M, L, K-L , -ONE, WORK, LDWORK,
- $ V, LDV, ONE, B, LDB )
- CALL STRMM( 'R', 'U', 'N', 'N', M, L, ONE, V( KP, 1 ), LDV,
- $ WORK( 1, KP ), LDWORK )
- DO J = 1, L
- DO I = 1, M
- B( I, J ) = B( I, J ) - WORK( I, K-L+J )
- END DO
- END DO
-*
- END IF
-*
- RETURN
-*
-* End of STPRFB
-*
- END
diff --git a/netlib/LAPACK/stprfs.f b/netlib/LAPACK/stprfs.f
deleted file mode 100644
index a8c8b12..0000000
--- a/netlib/LAPACK/stprfs.f
+++ /dev/null
@@ -1,473 +0,0 @@
-*> \brief \b STPRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stprfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stprfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stprfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX,
-* FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL AP( * ), B( LDB, * ), BERR( * ), FERR( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPRFS provides error bounds and backward error estimates for the
-*> solution to a system of linear equations with a triangular packed
-*> coefficient matrix.
-*>
-*> The solution matrix X must be computed by STPTRS or some other
-*> means before entering this routine. STPRFS does not do iterative
-*> refinement because doing so cannot improve the backward error.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> If DIAG = 'U', the diagonal elements of A are not referenced
-*> and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> The solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX,
- $ FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL AP( * ), B( LDB, * ), BERR( * ), FERR( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- CHARACTER TRANST
- INTEGER I, J, K, KASE, KC, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, STPMV, STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 250 J = 1, NRHS
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A or A**T, depending on TRANS.
-*
- CALL SCOPY( N, X( 1, J ), 1, WORK( N+1 ), 1 )
- CALL STPMV( UPLO, TRANS, DIAG, N, AP, WORK( N+1 ), 1 )
- CALL SAXPY( N, -ONE, B( 1, J ), 1, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 20 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 20 CONTINUE
-*
- IF( NOTRAN ) THEN
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- KC = 1
- IF( NOUNIT ) THEN
- DO 40 K = 1, N
- XK = ABS( X( K, J ) )
- DO 30 I = 1, K
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-1 ) )*XK
- 30 CONTINUE
- KC = KC + K
- 40 CONTINUE
- ELSE
- DO 60 K = 1, N
- XK = ABS( X( K, J ) )
- DO 50 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-1 ) )*XK
- 50 CONTINUE
- WORK( K ) = WORK( K ) + XK
- KC = KC + K
- 60 CONTINUE
- END IF
- ELSE
- KC = 1
- IF( NOUNIT ) THEN
- DO 80 K = 1, N
- XK = ABS( X( K, J ) )
- DO 70 I = K, N
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-K ) )*XK
- 70 CONTINUE
- KC = KC + N - K + 1
- 80 CONTINUE
- ELSE
- DO 100 K = 1, N
- XK = ABS( X( K, J ) )
- DO 90 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( AP( KC+I-K ) )*XK
- 90 CONTINUE
- WORK( K ) = WORK( K ) + XK
- KC = KC + N - K + 1
- 100 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Compute abs(A**T)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- KC = 1
- IF( NOUNIT ) THEN
- DO 120 K = 1, N
- S = ZERO
- DO 110 I = 1, K
- S = S + ABS( AP( KC+I-1 ) )*ABS( X( I, J ) )
- 110 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + K
- 120 CONTINUE
- ELSE
- DO 140 K = 1, N
- S = ABS( X( K, J ) )
- DO 130 I = 1, K - 1
- S = S + ABS( AP( KC+I-1 ) )*ABS( X( I, J ) )
- 130 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + K
- 140 CONTINUE
- END IF
- ELSE
- KC = 1
- IF( NOUNIT ) THEN
- DO 160 K = 1, N
- S = ZERO
- DO 150 I = K, N
- S = S + ABS( AP( KC+I-K ) )*ABS( X( I, J ) )
- 150 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + N - K + 1
- 160 CONTINUE
- ELSE
- DO 180 K = 1, N
- S = ABS( X( K, J ) )
- DO 170 I = K + 1, N
- S = S + ABS( AP( KC+I-K ) )*ABS( X( I, J ) )
- 170 CONTINUE
- WORK( K ) = WORK( K ) + S
- KC = KC + N - K + 1
- 180 CONTINUE
- END IF
- END IF
- END IF
- S = ZERO
- DO 190 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 190 CONTINUE
- BERR( J ) = S
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 200 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 200 CONTINUE
-*
- KASE = 0
- 210 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL STPSV( UPLO, TRANST, DIAG, N, AP, WORK( N+1 ), 1 )
- DO 220 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 220 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 230 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 230 CONTINUE
- CALL STPSV( UPLO, TRANS, DIAG, N, AP, WORK( N+1 ), 1 )
- END IF
- GO TO 210
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 240 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 240 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of STPRFS
-*
- END
diff --git a/netlib/LAPACK/stptri.f b/netlib/LAPACK/stptri.f
deleted file mode 100644
index 19790c3..0000000
--- a/netlib/LAPACK/stptri.f
+++ /dev/null
@@ -1,241 +0,0 @@
-*> \brief \b STPTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stptri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stptri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stptri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPTRI( UPLO, DIAG, N, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPTRI computes the inverse of a real upper or lower triangular
-*> matrix A stored in packed format.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> On entry, the upper or lower triangular matrix A, stored
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*((2*n-j)/2) = A(i,j) for j<=i<=n.
-*> See below for further details.
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same packed storage format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A triangular matrix A can be transferred to packed storage using one
-*> of the following program segments:
-*>
-*> UPLO = 'U': UPLO = 'L':
-*>
-*> JC = 1 JC = 1
-*> DO 2 J = 1, N DO 2 J = 1, N
-*> DO 1 I = 1, J DO 1 I = J, N
-*> AP(JC+I-1) = A(I,J) AP(JC+I-J) = A(I,J)
-*> 1 CONTINUE 1 CONTINUE
-*> JC = JC + J JC = JC + N - J + 1
-*> 2 CONTINUE 2 CONTINUE
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STPTRI( UPLO, DIAG, N, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JC, JCLAST, JJ
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, STPMV, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPTRI', -INFO )
- RETURN
- END IF
-*
-* Check for singularity if non-unit.
-*
- IF( NOUNIT ) THEN
- IF( UPPER ) THEN
- JJ = 0
- DO 10 INFO = 1, N
- JJ = JJ + INFO
- IF( AP( JJ ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- ELSE
- JJ = 1
- DO 20 INFO = 1, N
- IF( AP( JJ ).EQ.ZERO )
- $ RETURN
- JJ = JJ + N - INFO + 1
- 20 CONTINUE
- END IF
- INFO = 0
- END IF
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix.
-*
- JC = 1
- DO 30 J = 1, N
- IF( NOUNIT ) THEN
- AP( JC+J-1 ) = ONE / AP( JC+J-1 )
- AJJ = -AP( JC+J-1 )
- ELSE
- AJJ = -ONE
- END IF
-*
-* Compute elements 1:j-1 of j-th column.
-*
- CALL STPMV( 'Upper', 'No transpose', DIAG, J-1, AP,
- $ AP( JC ), 1 )
- CALL SSCAL( J-1, AJJ, AP( JC ), 1 )
- JC = JC + J
- 30 CONTINUE
-*
- ELSE
-*
-* Compute inverse of lower triangular matrix.
-*
- JC = N*( N+1 ) / 2
- DO 40 J = N, 1, -1
- IF( NOUNIT ) THEN
- AP( JC ) = ONE / AP( JC )
- AJJ = -AP( JC )
- ELSE
- AJJ = -ONE
- END IF
- IF( J.LT.N ) THEN
-*
-* Compute elements j+1:n of j-th column.
-*
- CALL STPMV( 'Lower', 'No transpose', DIAG, N-J,
- $ AP( JCLAST ), AP( JC+1 ), 1 )
- CALL SSCAL( N-J, AJJ, AP( JC+1 ), 1 )
- END IF
- JCLAST = JC
- JC = JC - N + J - 2
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of STPTRI
-*
- END
diff --git a/netlib/LAPACK/stptrs.f b/netlib/LAPACK/stptrs.f
deleted file mode 100644
index c7e8efc..0000000
--- a/netlib/LAPACK/stptrs.f
+++ /dev/null
@@ -1,228 +0,0 @@
-*> \brief \b STPTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stptrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stptrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stptrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL AP( * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPTRS solves a triangular system of the form
-*>
-*> A * X = B or A**T * X = B,
-*>
-*> where A is a triangular matrix of order N stored in packed format,
-*> and B is an N-by-NRHS matrix. A check is made to verify that A is
-*> nonsingular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2)
-*> The upper or lower triangular matrix A, packed columnwise in
-*> a linear array. The j-th column of A is stored in the array
-*> AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the
-*> solutions X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL AP( * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL STPSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- IF( UPPER ) THEN
- JC = 1
- DO 10 INFO = 1, N
- IF( AP( JC+INFO-1 ).EQ.ZERO )
- $ RETURN
- JC = JC + INFO
- 10 CONTINUE
- ELSE
- JC = 1
- DO 20 INFO = 1, N
- IF( AP( JC ).EQ.ZERO )
- $ RETURN
- JC = JC + N - INFO + 1
- 20 CONTINUE
- END IF
- END IF
- INFO = 0
-*
-* Solve A * x = b or A**T * x = b.
-*
- DO 30 J = 1, NRHS
- CALL STPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 )
- 30 CONTINUE
-*
- RETURN
-*
-* End of STPTRS
-*
- END
diff --git a/netlib/LAPACK/stpttf.f b/netlib/LAPACK/stpttf.f
deleted file mode 100644
index a2c0151..0000000
--- a/netlib/LAPACK/stpttf.f
+++ /dev/null
@@ -1,502 +0,0 @@
-*> \brief \b STPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPTTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpttf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpttf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpttf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPTTF( TRANSR, UPLO, N, AP, ARF, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* REAL AP( 0: * ), ARF( 0: * )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPTTF copies a triangular matrix A from standard packed format (TP)
-*> to rectangular full packed format (TF).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF in Normal format is wanted;
-*> = 'T': ARF in Conjugate-transpose format is wanted.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension ( N*(N+1)/2 ),
-*> On entry, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] ARF
-*> \verbatim
-*> ARF is REAL array, dimension ( N*(N+1)/2 ),
-*> On exit, the upper or lower triangular matrix A stored in
-*> RFP format. For a further discussion see Notes below.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STPTTF( TRANSR, UPLO, N, AP, ARF, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- REAL AP( 0: * ), ARF( 0: * )
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER N1, N2, K, NT
- INTEGER I, J, IJ
- INTEGER IJP, JP, LDA, JS
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPTTF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( NORMALTRANSR ) THEN
- ARF( 0 ) = AP( 0 )
- ELSE
- ARF( 0 ) = AP( 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:NT-1)
-*
- NT = N*( N+1 ) / 2
-*
-* Set N1 and N2 depending on LOWER
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE.
-* If N is even, set K = N/2 and NISODD = .FALSE.
-*
-* set lda of ARF^C; ARF^C is (0:(N+1)/2-1,0:N-noe)
-* where noe = 0 if n is even, noe = 1 if n is odd
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- LDA = N + 1
- ELSE
- NISODD = .TRUE.
- LDA = N
- END IF
-*
-* ARF^C has lda rows and n+1-noe cols
-*
- IF( .NOT.NORMALTRANSR )
- $ LDA = ( N+1 ) / 2
-*
-* start execution: there are eight cases
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IJP = 0
- JP = 0
- DO J = 0, N2
- DO I = J, N - 1
- IJ = I + JP
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, N2 - 1
- DO J = 1 + I, N2
- IJ = I + J*LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IJP = 0
- DO J = 0, N1 - 1
- IJ = N2 + J
- DO I = 0, J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = N1, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IJP = 0
- DO I = 0, N2
- DO IJ = I*( LDA+1 ), N*LDA - 1, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
- JS = 1
- DO J = 0, N2 - 1
- DO IJ = JS, JS + N2 - J - 1
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IJP = 0
- JS = N2*LDA
- DO J = 0, N1 - 1
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, N1
- DO IJ = I, I + ( N1+I )*LDA, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IJP = 0
- JP = 0
- DO J = 0, K - 1
- DO I = J, N - 1
- IJ = 1 + I + JP
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JP = JP + LDA
- END DO
- DO I = 0, K - 1
- DO J = I, K - 1
- IJ = I + J*LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IJP = 0
- DO J = 0, K - 1
- IJ = K + 1 + J
- DO I = 0, J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- IJ = IJ + LDA
- END DO
- END DO
- JS = 0
- DO J = K, N - 1
- IJ = JS
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IJP = 0
- DO I = 0, K - 1
- DO IJ = I + ( I+1 )*LDA, ( N+1 )*LDA - 1, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
- JS = 0
- DO J = 0, K - 1
- DO IJ = JS, JS + K - J - 1
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA + 1
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IJP = 0
- JS = ( K+1 )*LDA
- DO J = 0, K - 1
- DO IJ = JS, JS + J
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- JS = JS + LDA
- END DO
- DO I = 0, K - 1
- DO IJ = I, I + ( K+I )*LDA, LDA
- ARF( IJ ) = AP( IJP )
- IJP = IJP + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of STPTTF
-*
- END
diff --git a/netlib/LAPACK/stpttr.f b/netlib/LAPACK/stpttr.f
deleted file mode 100644
index 3e0c4f7..0000000
--- a/netlib/LAPACK/stpttr.f
+++ /dev/null
@@ -1,176 +0,0 @@
-*> \brief \b STPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STPTTR + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpttr.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpttr.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpttr.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STPTTR( UPLO, N, AP, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STPTTR copies a triangular matrix A from standard packed format (TP)
-*> to standard full format (TR).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular.
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] AP
-*> \verbatim
-*> AP is REAL array, dimension ( N*(N+1)/2 ),
-*> On entry, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] A
-*> \verbatim
-*> A is REAL array, dimension ( LDA, N )
-*> On exit, the triangular matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STPTTR( UPLO, N, AP, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER
- INTEGER I, J, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STPTTR', -INFO )
- RETURN
- END IF
-*
- IF( LOWER ) THEN
- K = 0
- DO J = 1, N
- DO I = J, N
- K = K + 1
- A( I, J ) = AP( K )
- END DO
- END DO
- ELSE
- K = 0
- DO J = 1, N
- DO I = 1, J
- K = K + 1
- A( I, J ) = AP( K )
- END DO
- END DO
- END IF
-*
-*
- RETURN
-*
-* End of STPTTR
-*
- END
diff --git a/netlib/LAPACK/strcon.f b/netlib/LAPACK/strcon.f
deleted file mode 100644
index 37384e6..0000000
--- a/netlib/LAPACK/strcon.f
+++ /dev/null
@@ -1,276 +0,0 @@
-*> \brief \b STRCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRCON + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strcon.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strcon.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strcon.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
-* IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER INFO, LDA, N
-* REAL RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRCON estimates the reciprocal of the condition number of a
-*> triangular matrix A, in either the 1-norm or the infinity-norm.
-*>
-*> The norm of A is computed and an estimate is obtained for
-*> norm(inv(A)), then the reciprocal of the condition number is
-*> computed as
-*> RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is REAL
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
- $ IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER INFO, LDA, N
- REAL RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, ONENRM, UPPER
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- REAL AINVNM, ANORM, SCALE, SMLNUM, XNORM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SLAMCH, SLANTR
- EXTERNAL LSAME, ISAMAX, SLAMCH, SLANTR
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLATRS, SRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, REAL
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- END IF
-*
- RCOND = ZERO
- SMLNUM = SLAMCH( 'Safe minimum' )*REAL( MAX( 1, N ) )
-*
-* Compute the norm of the triangular matrix A.
-*
- ANORM = SLANTR( NORM, UPLO, DIAG, N, N, A, LDA, WORK )
-*
-* Continue only if ANORM > 0.
-*
- IF( ANORM.GT.ZERO ) THEN
-*
-* Estimate the norm of the inverse of A.
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(A).
-*
- CALL SLATRS( UPLO, 'No transpose', DIAG, NORMIN, N, A,
- $ LDA, WORK, SCALE, WORK( 2*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(A**T).
-*
- CALL SLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, LDA,
- $ WORK, SCALE, WORK( 2*N+1 ), INFO )
- END IF
- NORMIN = 'Y'
-*
-* Multiply by 1/SCALE if doing so will not cause overflow.
-*
- IF( SCALE.NE.ONE ) THEN
- IX = ISAMAX( N, WORK, 1 )
- XNORM = ABS( WORK( IX ) )
- IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL SRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / ANORM ) / AINVNM
- END IF
-*
- 20 CONTINUE
- RETURN
-*
-* End of STRCON
-*
- END
diff --git a/netlib/LAPACK/strevc.f b/netlib/LAPACK/strevc.f
deleted file mode 100644
index 2cc7d25..0000000
--- a/netlib/LAPACK/strevc.f
+++ /dev/null
@@ -1,1077 +0,0 @@
-*> \brief \b STREVC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STREVC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strevc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strevc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strevc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-* LDVR, MM, M, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, SIDE
-* INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* REAL T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STREVC computes some or all of the right and/or left eigenvectors of
-*> a real upper quasi-triangular matrix T.
-*> Matrices of this type are produced by the Schur factorization of
-*> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR.
-*>
-*> The right eigenvector x and the left eigenvector y of T corresponding
-*> to an eigenvalue w are defined by:
-*>
-*> T*x = w*x, (y**T)*T = w*(y**T)
-*>
-*> where y**T denotes the transpose of y.
-*> The eigenvalues are not input to this routine, but are read directly
-*> from the diagonal blocks of T.
-*>
-*> This routine returns the matrices X and/or Y of right and left
-*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
-*> input matrix. If Q is the orthogonal factor that reduces a matrix
-*> A to Schur form T, then Q*X and Q*Y are the matrices of right and
-*> left eigenvectors of A.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute all right and/or left eigenvectors;
-*> = 'B': compute all right and/or left eigenvectors,
-*> backtransformed by the matrices in VR and/or VL;
-*> = 'S': compute selected right and/or left eigenvectors,
-*> as indicated by the logical array SELECT.
-*> \endverbatim
-*>
-*> \param[in,out] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be
-*> computed.
-*> If w(j) is a real eigenvalue, the corresponding real
-*> eigenvector is computed if SELECT(j) is .TRUE..
-*> If w(j) and w(j+1) are the real and imaginary parts of a
-*> complex eigenvalue, the corresponding complex eigenvector is
-*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
-*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
-*> .FALSE..
-*> Not referenced if HOWMNY = 'A' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> The upper quasi-triangular matrix T in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,MM)
-*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of Schur vectors returned by SHSEQR).
-*> On exit, if SIDE = 'L' or 'B', VL contains:
-*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-*> if HOWMNY = 'B', the matrix Q*Y;
-*> if HOWMNY = 'S', the left eigenvectors of T specified by
-*> SELECT, stored consecutively in the columns
-*> of VL, in the same order as their
-*> eigenvalues.
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part, and the second the imaginary part.
-*> Not referenced if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1, and if
-*> SIDE = 'L' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,MM)
-*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of Schur vectors returned by SHSEQR).
-*> On exit, if SIDE = 'R' or 'B', VR contains:
-*> if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-*> if HOWMNY = 'B', the matrix Q*X;
-*> if HOWMNY = 'S', the right eigenvectors of T specified by
-*> SELECT, stored consecutively in the columns
-*> of VR, in the same order as their
-*> eigenvalues.
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part and the second the imaginary part.
-*> Not referenced if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> SIDE = 'R' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR actually
-*> used to store the eigenvectors.
-*> If HOWMNY = 'A' or 'B', M is set to N.
-*> Each selected real eigenvector occupies one column and each
-*> selected complex eigenvector occupies two columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The algorithm used in this program is basically backward (forward)
-*> substitution, with scaling to make the the code robust against
-*> possible overflow.
-*>
-*> Each eigenvector is normalized so that the element of largest
-*> magnitude has magnitude 1; here the magnitude of a complex number
-*> (x,y) is taken to be |x| + |y|.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
- $ LDVR, MM, M, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- REAL T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLV, BOTHV, LEFTV, OVER, PAIR, RIGHTV, SOMEV
- INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, N2
- REAL BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE,
- $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR,
- $ XNORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ISAMAX
- REAL SDOT, SLAMCH
- EXTERNAL LSAME, ISAMAX, SDOT, SLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SLABAD, SLALN2, SSCAL,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Local Arrays ..
- REAL X( 2, 2 )
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- BOTHV = LSAME( SIDE, 'B' )
- RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
- LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
- ALLV = LSAME( HOWMNY, 'A' )
- OVER = LSAME( HOWMNY, 'B' )
- SOMEV = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -1
- ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
- INFO = -8
- ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
- INFO = -10
- ELSE
-*
-* Set M to the number of columns required to store the selected
-* eigenvectors, standardize the array SELECT if necessary, and
-* test MM.
-*
- IF( SOMEV ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 J = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- SELECT( J ) = .FALSE.
- ELSE
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).EQ.ZERO ) THEN
- IF( SELECT( J ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN
- SELECT( J ) = .TRUE.
- M = M + 2
- END IF
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( MM.LT.M ) THEN
- INFO = -11
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STREVC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set the constants to control overflow.
-*
- UNFL = SLAMCH( 'Safe minimum' )
- OVFL = ONE / UNFL
- CALL SLABAD( UNFL, OVFL )
- ULP = SLAMCH( 'Precision' )
- SMLNUM = UNFL*( N / ULP )
- BIGNUM = ( ONE-ULP ) / SMLNUM
-*
-* Compute 1-norm of each column of strictly upper triangular
-* part of T to control overflow in triangular solver.
-*
- WORK( 1 ) = ZERO
- DO 30 J = 2, N
- WORK( J ) = ZERO
- DO 20 I = 1, J - 1
- WORK( J ) = WORK( J ) + ABS( T( I, J ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Index IP is used to specify the real or complex eigenvalue:
-* IP = 0, real eigenvalue,
-* 1, first of conjugate complex pair: (wr,wi)
-* -1, second of conjugate complex pair: (wr,wi)
-*
- N2 = 2*N
-*
- IF( RIGHTV ) THEN
-*
-* Compute right eigenvectors.
-*
- IP = 0
- IS = M
- DO 140 KI = N, 1, -1
-*
- IF( IP.EQ.1 )
- $ GO TO 130
- IF( KI.EQ.1 )
- $ GO TO 40
- IF( T( KI, KI-1 ).EQ.ZERO )
- $ GO TO 40
- IP = -1
-*
- 40 CONTINUE
- IF( SOMEV ) THEN
- IF( IP.EQ.0 ) THEN
- IF( .NOT.SELECT( KI ) )
- $ GO TO 130
- ELSE
- IF( .NOT.SELECT( KI-1 ) )
- $ GO TO 130
- END IF
- END IF
-*
-* Compute the KI-th eigenvalue (WR,WI).
-*
- WR = T( KI, KI )
- WI = ZERO
- IF( IP.NE.0 )
- $ WI = SQRT( ABS( T( KI, KI-1 ) ) )*
- $ SQRT( ABS( T( KI-1, KI ) ) )
- SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
- IF( IP.EQ.0 ) THEN
-*
-* Real right eigenvector
-*
- WORK( KI+N ) = ONE
-*
-* Form right-hand side
-*
- DO 50 K = 1, KI - 1
- WORK( K+N ) = -T( K, KI )
- 50 CONTINUE
-*
-* Solve the upper quasi-triangular system:
-* (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
-*
- JNXT = KI - 1
- DO 60 J = KI - 1, 1, -1
- IF( J.GT.JNXT )
- $ GO TO 60
- J1 = J
- J2 = J
- JNXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
- CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale X(1,1) to avoid overflow when updating
-* the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
-*
-* Update right-hand side
-*
- CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
- CALL SLALN2( .FALSE., 2, 1, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ WORK( J-1+N ), N, WR, ZERO, X, 2,
- $ SCALE, XNORM, IERR )
-*
-* Scale X(1,1) and X(2,1) to avoid overflow when
-* updating the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- BETA = MAX( WORK( J-1 ), WORK( J ) )
- IF( BETA.GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- X( 2, 1 ) = X( 2, 1 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 )
- WORK( J-1+N ) = X( 1, 1 )
- WORK( J+N ) = X( 2, 1 )
-*
-* Update right-hand side
-*
- CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
- $ WORK( 1+N ), 1 )
- CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- END IF
- 60 CONTINUE
-*
-* Copy the vector x or Q*x to VR and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL SCOPY( KI, WORK( 1+N ), 1, VR( 1, IS ), 1 )
-*
- II = ISAMAX( KI, VR( 1, IS ), 1 )
- REMAX = ONE / ABS( VR( II, IS ) )
- CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
- DO 70 K = KI + 1, N
- VR( K, IS ) = ZERO
- 70 CONTINUE
- ELSE
- IF( KI.GT.1 )
- $ CALL SGEMV( 'N', N, KI-1, ONE, VR, LDVR,
- $ WORK( 1+N ), 1, WORK( KI+N ),
- $ VR( 1, KI ), 1 )
-*
- II = ISAMAX( N, VR( 1, KI ), 1 )
- REMAX = ONE / ABS( VR( II, KI ) )
- CALL SSCAL( N, REMAX, VR( 1, KI ), 1 )
- END IF
-*
- ELSE
-*
-* Complex right eigenvector.
-*
-* Initial solve
-* [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
-* [ (T(KI,KI-1) T(KI,KI) ) ]
-*
- IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN
- WORK( KI-1+N ) = ONE
- WORK( KI+N2 ) = WI / T( KI-1, KI )
- ELSE
- WORK( KI-1+N ) = -WI / T( KI, KI-1 )
- WORK( KI+N2 ) = ONE
- END IF
- WORK( KI+N ) = ZERO
- WORK( KI-1+N2 ) = ZERO
-*
-* Form right-hand side
-*
- DO 80 K = 1, KI - 2
- WORK( K+N ) = -WORK( KI-1+N )*T( K, KI-1 )
- WORK( K+N2 ) = -WORK( KI+N2 )*T( K, KI )
- 80 CONTINUE
-*
-* Solve upper quasi-triangular system:
-* (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
-*
- JNXT = KI - 2
- DO 90 J = KI - 2, 1, -1
- IF( J.GT.JNXT )
- $ GO TO 90
- J1 = J
- J2 = J
- JNXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
- CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR, WI,
- $ X, 2, SCALE, XNORM, IERR )
-*
-* Scale X(1,1) and X(1,2) to avoid overflow when
-* updating the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- X( 1, 2 ) = X( 1, 2 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 )
- CALL SSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
-*
-* Update the right-hand side
-*
- CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- CALL SAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1,
- $ WORK( 1+N2 ), 1 )
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
- CALL SLALN2( .FALSE., 2, 2, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ WORK( J-1+N ), N, WR, WI, X, 2, SCALE,
- $ XNORM, IERR )
-*
-* Scale X to avoid overflow when updating
-* the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- BETA = MAX( WORK( J-1 ), WORK( J ) )
- IF( BETA.GT.BIGNUM / XNORM ) THEN
- REC = ONE / XNORM
- X( 1, 1 ) = X( 1, 1 )*REC
- X( 1, 2 ) = X( 1, 2 )*REC
- X( 2, 1 ) = X( 2, 1 )*REC
- X( 2, 2 ) = X( 2, 2 )*REC
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL SSCAL( KI, SCALE, WORK( 1+N ), 1 )
- CALL SSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
- END IF
- WORK( J-1+N ) = X( 1, 1 )
- WORK( J+N ) = X( 2, 1 )
- WORK( J-1+N2 ) = X( 1, 2 )
- WORK( J+N2 ) = X( 2, 2 )
-*
-* Update the right-hand side
-*
- CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
- $ WORK( 1+N ), 1 )
- CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- CALL SAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1,
- $ WORK( 1+N2 ), 1 )
- CALL SAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
- $ WORK( 1+N2 ), 1 )
- END IF
- 90 CONTINUE
-*
-* Copy the vector x or Q*x to VR and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL SCOPY( KI, WORK( 1+N ), 1, VR( 1, IS-1 ), 1 )
- CALL SCOPY( KI, WORK( 1+N2 ), 1, VR( 1, IS ), 1 )
-*
- EMAX = ZERO
- DO 100 K = 1, KI
- EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+
- $ ABS( VR( K, IS ) ) )
- 100 CONTINUE
-*
- REMAX = ONE / EMAX
- CALL SSCAL( KI, REMAX, VR( 1, IS-1 ), 1 )
- CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
- DO 110 K = KI + 1, N
- VR( K, IS-1 ) = ZERO
- VR( K, IS ) = ZERO
- 110 CONTINUE
-*
- ELSE
-*
- IF( KI.GT.2 ) THEN
- CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR,
- $ WORK( 1+N ), 1, WORK( KI-1+N ),
- $ VR( 1, KI-1 ), 1 )
- CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR,
- $ WORK( 1+N2 ), 1, WORK( KI+N2 ),
- $ VR( 1, KI ), 1 )
- ELSE
- CALL SSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 )
- CALL SSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 )
- END IF
-*
- EMAX = ZERO
- DO 120 K = 1, N
- EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+
- $ ABS( VR( K, KI ) ) )
- 120 CONTINUE
- REMAX = ONE / EMAX
- CALL SSCAL( N, REMAX, VR( 1, KI-1 ), 1 )
- CALL SSCAL( N, REMAX, VR( 1, KI ), 1 )
- END IF
- END IF
-*
- IS = IS - 1
- IF( IP.NE.0 )
- $ IS = IS - 1
- 130 CONTINUE
- IF( IP.EQ.1 )
- $ IP = 0
- IF( IP.EQ.-1 )
- $ IP = 1
- 140 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
-*
-* Compute left eigenvectors.
-*
- IP = 0
- IS = 1
- DO 260 KI = 1, N
-*
- IF( IP.EQ.-1 )
- $ GO TO 250
- IF( KI.EQ.N )
- $ GO TO 150
- IF( T( KI+1, KI ).EQ.ZERO )
- $ GO TO 150
- IP = 1
-*
- 150 CONTINUE
- IF( SOMEV ) THEN
- IF( .NOT.SELECT( KI ) )
- $ GO TO 250
- END IF
-*
-* Compute the KI-th eigenvalue (WR,WI).
-*
- WR = T( KI, KI )
- WI = ZERO
- IF( IP.NE.0 )
- $ WI = SQRT( ABS( T( KI, KI+1 ) ) )*
- $ SQRT( ABS( T( KI+1, KI ) ) )
- SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
- IF( IP.EQ.0 ) THEN
-*
-* Real left eigenvector.
-*
- WORK( KI+N ) = ONE
-*
-* Form right-hand side
-*
- DO 160 K = KI + 1, N
- WORK( K+N ) = -T( KI, K )
- 160 CONTINUE
-*
-* Solve the quasi-triangular system:
-* (T(KI+1:N,KI+1:N) - WR)**T*X = SCALE*WORK
-*
- VMAX = ONE
- VCRIT = BIGNUM
-*
- JNXT = KI + 1
- DO 170 J = KI + 1, N
- IF( J.LT.JNXT )
- $ GO TO 170
- J1 = J
- J2 = J
- JNXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side.
-*
- IF( WORK( J ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ SDOT( J-KI-1, T( KI+1, J ), 1,
- $ WORK( KI+1+N ), 1 )
-*
-* Solve (T(J,J)-WR)**T*X = WORK
-*
- CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
- VMAX = MAX( ABS( WORK( J+N ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side.
-*
- BETA = MAX( WORK( J ), WORK( J+1 ) )
- IF( BETA.GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ SDOT( J-KI-1, T( KI+1, J ), 1,
- $ WORK( KI+1+N ), 1 )
-*
- WORK( J+1+N ) = WORK( J+1+N ) -
- $ SDOT( J-KI-1, T( KI+1, J+1 ), 1,
- $ WORK( KI+1+N ), 1 )
-*
-* Solve
-* [T(J,J)-WR T(J,J+1) ]**T* X = SCALE*( WORK1 )
-* [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 )
-*
- CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
- WORK( J+1+N ) = X( 2, 1 )
-*
- VMAX = MAX( ABS( WORK( J+N ) ),
- $ ABS( WORK( J+1+N ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- END IF
- 170 CONTINUE
-*
-* Copy the vector x or Q*x to VL and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
-*
- II = ISAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
- REMAX = ONE / ABS( VL( II, IS ) )
- CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
-*
- DO 180 K = 1, KI - 1
- VL( K, IS ) = ZERO
- 180 CONTINUE
-*
- ELSE
-*
- IF( KI.LT.N )
- $ CALL SGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL,
- $ WORK( KI+1+N ), 1, WORK( KI+N ),
- $ VL( 1, KI ), 1 )
-*
- II = ISAMAX( N, VL( 1, KI ), 1 )
- REMAX = ONE / ABS( VL( II, KI ) )
- CALL SSCAL( N, REMAX, VL( 1, KI ), 1 )
-*
- END IF
-*
- ELSE
-*
-* Complex left eigenvector.
-*
-* Initial solve:
-* ((T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI))*X = 0.
-* ((T(KI+1,KI) T(KI+1,KI+1)) )
-*
- IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN
- WORK( KI+N ) = WI / T( KI, KI+1 )
- WORK( KI+1+N2 ) = ONE
- ELSE
- WORK( KI+N ) = ONE
- WORK( KI+1+N2 ) = -WI / T( KI+1, KI )
- END IF
- WORK( KI+1+N ) = ZERO
- WORK( KI+N2 ) = ZERO
-*
-* Form right-hand side
-*
- DO 190 K = KI + 2, N
- WORK( K+N ) = -WORK( KI+N )*T( KI, K )
- WORK( K+N2 ) = -WORK( KI+1+N2 )*T( KI+1, K )
- 190 CONTINUE
-*
-* Solve complex quasi-triangular system:
-* ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
-*
- VMAX = ONE
- VCRIT = BIGNUM
-*
- JNXT = KI + 2
- DO 200 J = KI + 2, N
- IF( J.LT.JNXT )
- $ GO TO 200
- J1 = J
- J2 = J
- JNXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
-* Scale if necessary to avoid overflow when
-* forming the right-hand side elements.
-*
- IF( WORK( J ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- CALL SSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ SDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N ), 1 )
- WORK( J+N2 ) = WORK( J+N2 ) -
- $ SDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
-* Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2
-*
- CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ -WI, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- CALL SSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
- VMAX = MAX( ABS( WORK( J+N ) ),
- $ ABS( WORK( J+N2 ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side elements.
-*
- BETA = MAX( WORK( J ), WORK( J+1 ) )
- IF( BETA.GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL SSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- CALL SSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ SDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N ), 1 )
-*
- WORK( J+N2 ) = WORK( J+N2 ) -
- $ SDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
- WORK( J+1+N ) = WORK( J+1+N ) -
- $ SDOT( J-KI-2, T( KI+2, J+1 ), 1,
- $ WORK( KI+2+N ), 1 )
-*
- WORK( J+1+N2 ) = WORK( J+1+N2 ) -
- $ SDOT( J-KI-2, T( KI+2, J+1 ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
-* Solve 2-by-2 complex linear equation
-* ([T(j,j) T(j,j+1) ]**T-(wr-i*wi)*I)*X = SCALE*B
-* ([T(j+1,j) T(j+1,j+1)] )
-*
- CALL SLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ -WI, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL SSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- CALL SSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
- WORK( J+1+N ) = X( 2, 1 )
- WORK( J+1+N2 ) = X( 2, 2 )
- VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ),
- $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- END IF
- 200 CONTINUE
-*
-* Copy the vector x or Q*x to VL and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
- CALL SCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ),
- $ 1 )
-*
- EMAX = ZERO
- DO 220 K = KI, N
- EMAX = MAX( EMAX, ABS( VL( K, IS ) )+
- $ ABS( VL( K, IS+1 ) ) )
- 220 CONTINUE
- REMAX = ONE / EMAX
- CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
- CALL SSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 )
-*
- DO 230 K = 1, KI - 1
- VL( K, IS ) = ZERO
- VL( K, IS+1 ) = ZERO
- 230 CONTINUE
- ELSE
- IF( KI.LT.N-1 ) THEN
- CALL SGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
- $ LDVL, WORK( KI+2+N ), 1, WORK( KI+N ),
- $ VL( 1, KI ), 1 )
- CALL SGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
- $ LDVL, WORK( KI+2+N2 ), 1,
- $ WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
- ELSE
- CALL SSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 )
- CALL SSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
- END IF
-*
- EMAX = ZERO
- DO 240 K = 1, N
- EMAX = MAX( EMAX, ABS( VL( K, KI ) )+
- $ ABS( VL( K, KI+1 ) ) )
- 240 CONTINUE
- REMAX = ONE / EMAX
- CALL SSCAL( N, REMAX, VL( 1, KI ), 1 )
- CALL SSCAL( N, REMAX, VL( 1, KI+1 ), 1 )
-*
- END IF
-*
- END IF
-*
- IS = IS + 1
- IF( IP.NE.0 )
- $ IS = IS + 1
- 250 CONTINUE
- IF( IP.EQ.-1 )
- $ IP = 0
- IF( IP.EQ.1 )
- $ IP = -1
-*
- 260 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of STREVC
-*
- END
diff --git a/netlib/LAPACK/strexc.f b/netlib/LAPACK/strexc.f
deleted file mode 100644
index 3e2ca3b..0000000
--- a/netlib/LAPACK/strexc.f
+++ /dev/null
@@ -1,426 +0,0 @@
-*> \brief \b STREXC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STREXC + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strexc.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strexc.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strexc.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ
-* INTEGER IFST, ILST, INFO, LDQ, LDT, N
-* ..
-* .. Array Arguments ..
-* REAL Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STREXC reorders the real Schur factorization of a real matrix
-*> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
-*> moved to row ILST.
-*>
-*> The real Schur form T is reordered by an orthogonal similarity
-*> transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
-*> is updated by postmultiplying it with Z.
-*>
-*> T must be in Schur canonical form (as returned by SHSEQR), that is,
-*> block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*> 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'V': update the matrix Q of Schur vectors;
-*> = 'N': do not update Q.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> Schur canonical form.
-*> On exit, the reordered upper quasi-triangular matrix, again
-*> in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*> On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*> orthogonal transformation matrix Z which reorders T.
-*> If COMPQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IFST
-*> \verbatim
-*> IFST is INTEGER
-*> \endverbatim
-*>
-*> \param[in,out] ILST
-*> \verbatim
-*> ILST is INTEGER
-*>
-*> Specify the reordering of the diagonal blocks of T.
-*> The block with row index IFST is moved to row ILST, by a
-*> sequence of transpositions between adjacent blocks.
-*> On exit, if IFST pointed on entry to the second row of a
-*> 2-by-2 block, it is changed to point to the first row; ILST
-*> always points to the first row of the block in its final
-*> position (which may differ from its input value by +1 or -1).
-*> 1 <= IFST <= N; 1 <= ILST <= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: two adjacent blocks were too close to swap (the problem
-*> is very ill-conditioned); T may have been partially
-*> reordered, and ILST points to the first row of the
-*> current position of the block being moved.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ
- INTEGER IFST, ILST, INFO, LDQ, LDT, N
-* ..
-* .. Array Arguments ..
- REAL Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTQ
- INTEGER HERE, NBF, NBL, NBNEXT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAEXC, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input arguments.
-*
- INFO = 0
- WANTQ = LSAME( COMPQ, 'V' )
- IF( .NOT.WANTQ .AND. .NOT.LSAME( COMPQ, 'N' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
- INFO = -6
- ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
- INFO = -7
- ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STREXC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the first row of specified block
-* and find out it is 1 by 1 or 2 by 2.
-*
- IF( IFST.GT.1 ) THEN
- IF( T( IFST, IFST-1 ).NE.ZERO )
- $ IFST = IFST - 1
- END IF
- NBF = 1
- IF( IFST.LT.N ) THEN
- IF( T( IFST+1, IFST ).NE.ZERO )
- $ NBF = 2
- END IF
-*
-* Determine the first row of the final block
-* and find out it is 1 by 1 or 2 by 2.
-*
- IF( ILST.GT.1 ) THEN
- IF( T( ILST, ILST-1 ).NE.ZERO )
- $ ILST = ILST - 1
- END IF
- NBL = 1
- IF( ILST.LT.N ) THEN
- IF( T( ILST+1, ILST ).NE.ZERO )
- $ NBL = 2
- END IF
-*
- IF( IFST.EQ.ILST )
- $ RETURN
-*
- IF( IFST.LT.ILST ) THEN
-*
-* Update ILST
-*
- IF( NBF.EQ.2 .AND. NBL.EQ.1 )
- $ ILST = ILST - 1
- IF( NBF.EQ.1 .AND. NBL.EQ.2 )
- $ ILST = ILST + 1
-*
- HERE = IFST
-*
- 10 CONTINUE
-*
-* Swap block with next one below
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1 by 1 or 2 by 2
-*
- NBNEXT = 1
- IF( HERE+NBF+1.LE.N ) THEN
- IF( T( HERE+NBF+1, HERE+NBF ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBF, NBNEXT,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + NBNEXT
-*
-* Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
- IF( NBF.EQ.2 ) THEN
- IF( T( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1 by 1 blocks each of which
-* must be swapped individually
-*
- NBNEXT = 1
- IF( HERE+3.LE.N ) THEN
- IF( T( HERE+3, HERE+2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, NBNEXT,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1 by 1 blocks, no problems possible
-*
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT,
- $ WORK, INFO )
- HERE = HERE + 1
- ELSE
-*
-* Recompute NBNEXT in case 2 by 2 split
-*
- IF( T( HERE+2, HERE+1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2 by 2 Block did not split
-*
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1,
- $ NBNEXT, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 2
- ELSE
-*
-* 2 by 2 Block did split
-*
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
- $ WORK, INFO )
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1,
- $ WORK, INFO )
- HERE = HERE + 2
- END IF
- END IF
- END IF
- IF( HERE.LT.ILST )
- $ GO TO 10
-*
- ELSE
-*
- HERE = IFST
- 20 CONTINUE
-*
-* Swap block with next one above
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1 by 1 or 2 by 2
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( T( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
- $ NBF, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - NBNEXT
-*
-* Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
- IF( NBF.EQ.2 ) THEN
- IF( T( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1 by 1 blocks each of which
-* must be swapped individually
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( T( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
- $ 1, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1 by 1 blocks, no problems possible
-*
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1,
- $ WORK, INFO )
- HERE = HERE - 1
- ELSE
-*
-* Recompute NBNEXT in case 2 by 2 split
-*
- IF( T( HERE, HERE-1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2 by 2 Block did not split
-*
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 2
- ELSE
-*
-* 2 by 2 Block did split
-*
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
- $ WORK, INFO )
- CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1,
- $ WORK, INFO )
- HERE = HERE - 2
- END IF
- END IF
- END IF
- IF( HERE.GT.ILST )
- $ GO TO 20
- END IF
- ILST = HERE
-*
- RETURN
-*
-* End of STREXC
-*
- END
diff --git a/netlib/LAPACK/strrfs.f b/netlib/LAPACK/strrfs.f
deleted file mode 100644
index e04f3d4..0000000
--- a/netlib/LAPACK/strrfs.f
+++ /dev/null
@@ -1,472 +0,0 @@
-*> \brief \b STRRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRRFS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strrfs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strrfs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strrfs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
-* LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* REAL A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRRFS provides error bounds and backward error estimates for the
-*> solution to a system of linear equations with a triangular
-*> coefficient matrix.
-*>
-*> The solution matrix X must be computed by STRTRS or some other
-*> means before entering this routine. STRRFS does not do iterative
-*> refinement because doing so cannot improve the backward error.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array, dimension (LDX,NRHS)
-*> The solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is REAL array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is REAL array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDA, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- REAL A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- CHARACTER TRANST
- INTEGER I, J, K, KASE, NZ
- REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLACN2, STRMV, STRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLAMCH
- EXTERNAL LSAME, SLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = SLAMCH( 'Epsilon' )
- SAFMIN = SLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 250 J = 1, NRHS
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A or A**T, depending on TRANS.
-*
- CALL SCOPY( N, X( 1, J ), 1, WORK( N+1 ), 1 )
- CALL STRMV( UPLO, TRANS, DIAG, N, A, LDA, WORK( N+1 ), 1 )
- CALL SAXPY( N, -ONE, B( 1, J ), 1, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 20 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 20 CONTINUE
-*
- IF( NOTRAN ) THEN
-*
-* Compute abs(A)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 40 K = 1, N
- XK = ABS( X( K, J ) )
- DO 30 I = 1, K
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 K = 1, N
- XK = ABS( X( K, J ) )
- DO 50 I = 1, K - 1
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 50 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 60 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 80 K = 1, N
- XK = ABS( X( K, J ) )
- DO 70 I = K, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 70 CONTINUE
- 80 CONTINUE
- ELSE
- DO 100 K = 1, N
- XK = ABS( X( K, J ) )
- DO 90 I = K + 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 90 CONTINUE
- WORK( K ) = WORK( K ) + XK
- 100 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Compute abs(A**T)*abs(X) + abs(B).
-*
- IF( UPPER ) THEN
- IF( NOUNIT ) THEN
- DO 120 K = 1, N
- S = ZERO
- DO 110 I = 1, K
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 110 CONTINUE
- WORK( K ) = WORK( K ) + S
- 120 CONTINUE
- ELSE
- DO 140 K = 1, N
- S = ABS( X( K, J ) )
- DO 130 I = 1, K - 1
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 130 CONTINUE
- WORK( K ) = WORK( K ) + S
- 140 CONTINUE
- END IF
- ELSE
- IF( NOUNIT ) THEN
- DO 160 K = 1, N
- S = ZERO
- DO 150 I = K, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 150 CONTINUE
- WORK( K ) = WORK( K ) + S
- 160 CONTINUE
- ELSE
- DO 180 K = 1, N
- S = ABS( X( K, J ) )
- DO 170 I = K + 1, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 170 CONTINUE
- WORK( K ) = WORK( K ) + S
- 180 CONTINUE
- END IF
- END IF
- END IF
- S = ZERO
- DO 190 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 190 CONTINUE
- BERR( J ) = S
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use SLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 200 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 200 CONTINUE
-*
- KASE = 0
- 210 CONTINUE
- CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL STRSV( UPLO, TRANST, DIAG, N, A, LDA, WORK( N+1 ),
- $ 1 )
- DO 220 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 220 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 230 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 230 CONTINUE
- CALL STRSV( UPLO, TRANS, DIAG, N, A, LDA, WORK( N+1 ),
- $ 1 )
- END IF
- GO TO 210
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 240 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 240 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 250 CONTINUE
-*
- RETURN
-*
-* End of STRRFS
-*
- END
diff --git a/netlib/LAPACK/strsen.f b/netlib/LAPACK/strsen.f
deleted file mode 100644
index 593dd70..0000000
--- a/netlib/LAPACK/strsen.f
+++ /dev/null
@@ -1,571 +0,0 @@
-*> \brief \b STRSEN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRSEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strsen.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strsen.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strsen.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI,
-* M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ, JOB
-* INTEGER INFO, LDQ, LDT, LIWORK, LWORK, M, N
-* REAL S, SEP
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* REAL Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ),
-* $ WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRSEN reorders the real Schur factorization of a real matrix
-*> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
-*> the leading diagonal blocks of the upper quasi-triangular matrix T,
-*> and the leading columns of Q form an orthonormal basis of the
-*> corresponding right invariant subspace.
-*>
-*> Optionally the routine computes the reciprocal condition numbers of
-*> the cluster of eigenvalues and/or the invariant subspace.
-*>
-*> T must be in Schur canonical form (as returned by SHSEQR), that is,
-*> block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*> 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies whether condition numbers are required for the
-*> cluster of eigenvalues (S) or the invariant subspace (SEP):
-*> = 'N': none;
-*> = 'E': for eigenvalues only (S);
-*> = 'V': for invariant subspace only (SEP);
-*> = 'B': for both eigenvalues and invariant subspace (S and
-*> SEP).
-*> \endverbatim
-*>
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'V': update the matrix Q of Schur vectors;
-*> = 'N': do not update Q.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> SELECT specifies the eigenvalues in the selected cluster. To
-*> select a real eigenvalue w(j), SELECT(j) must be set to
-*> .TRUE.. To select a complex conjugate pair of eigenvalues
-*> w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
-*> either SELECT(j) or SELECT(j+1) or both must be set to
-*> .TRUE.; a complex conjugate pair of eigenvalues must be
-*> either both included in the cluster or both excluded.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> canonical form.
-*> On exit, T is overwritten by the reordered matrix T, again in
-*> Schur canonical form, with the selected eigenvalues in the
-*> leading diagonal blocks.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is REAL array, dimension (LDQ,N)
-*> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*> On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*> orthogonal transformation matrix which reorders T; the
-*> leading M columns of Q form an orthonormal basis for the
-*> specified invariant subspace.
-*> If COMPQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is REAL array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is REAL array, dimension (N)
-*>
-*> The real and imaginary parts, respectively, of the reordered
-*> eigenvalues of T. The eigenvalues are stored in the same
-*> order as on the diagonal of T, with WR(i) = T(i,i) and, if
-*> T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
-*> WI(i+1) = -WI(i). Note that if a complex eigenvalue is
-*> sufficiently ill-conditioned, then its value may differ
-*> significantly from its value before reordering.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The dimension of the specified invariant subspace.
-*> 0 < = M <= N.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL
-*> If JOB = 'E' or 'B', S is a lower bound on the reciprocal
-*> condition number for the selected cluster of eigenvalues.
-*> S cannot underestimate the true reciprocal condition number
-*> by more than a factor of sqrt(N). If M = 0 or N, S = 1.
-*> If JOB = 'N' or 'V', S is not referenced.
-*> \endverbatim
-*>
-*> \param[out] SEP
-*> \verbatim
-*> SEP is REAL
-*> If JOB = 'V' or 'B', SEP is the estimated reciprocal
-*> condition number of the specified invariant subspace. If
-*> M = 0 or N, SEP = norm(T).
-*> If JOB = 'N' or 'E', SEP is not referenced.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If JOB = 'N', LWORK >= max(1,N);
-*> if JOB = 'E', LWORK >= max(1,M*(N-M));
-*> if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
-*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*> \endverbatim
-*>
-*> \param[in] LIWORK
-*> \verbatim
-*> LIWORK is INTEGER
-*> The dimension of the array IWORK.
-*> If JOB = 'N' or 'E', LIWORK >= 1;
-*> if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
-*>
-*> If LIWORK = -1, then a workspace query is assumed; the
-*> routine only calculates the optimal size of the IWORK array,
-*> returns this value as the first entry of the IWORK array, and
-*> no error message related to LIWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: reordering of T failed because some eigenvalues are too
-*> close to separate (the problem is very ill-conditioned);
-*> T may have been partially reordered, and WR and WI
-*> contain the eigenvalues in the same order as in T; S and
-*> SEP (if requested) are set to zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> STRSEN first collects the selected eigenvalues by computing an
-*> orthogonal transformation Z to move them to the top left corner of T.
-*> In other words, the selected eigenvalues are the eigenvalues of T11
-*> in:
-*>
-*> Z**T * T * Z = ( T11 T12 ) n1
-*> ( 0 T22 ) n2
-*> n1 n2
-*>
-*> where N = n1+n2 and Z**T means the transpose of Z. The first n1 columns
-*> of Z span the specified invariant subspace of T.
-*>
-*> If T has been obtained from the real Schur factorization of a matrix
-*> A = Q*T*Q**T, then the reordered real Schur factorization of A is given
-*> by A = (Q*Z)*(Z**T*T*Z)*(Q*Z)**T, and the first n1 columns of Q*Z span
-*> the corresponding invariant subspace of A.
-*>
-*> The reciprocal condition number of the average of the eigenvalues of
-*> T11 may be returned in S. S lies between 0 (very badly conditioned)
-*> and 1 (very well conditioned). It is computed as follows. First we
-*> compute R so that
-*>
-*> P = ( I R ) n1
-*> ( 0 0 ) n2
-*> n1 n2
-*>
-*> is the projector on the invariant subspace associated with T11.
-*> R is the solution of the Sylvester equation:
-*>
-*> T11*R - R*T22 = T12.
-*>
-*> Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
-*> the two-norm of M. Then S is computed as the lower bound
-*>
-*> (1 + F-norm(R)**2)**(-1/2)
-*>
-*> on the reciprocal of 2-norm(P), the true reciprocal condition number.
-*> S cannot underestimate 1 / 2-norm(P) by more than a factor of
-*> sqrt(N).
-*>
-*> An approximate error bound for the computed average of the
-*> eigenvalues of T11 is
-*>
-*> EPS * norm(T) / S
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal condition number of the right invariant subspace
-*> spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
-*> SEP is defined as the separation of T11 and T22:
-*>
-*> sep( T11, T22 ) = sigma-min( C )
-*>
-*> where sigma-min(C) is the smallest singular value of the
-*> n1*n2-by-n1*n2 matrix
-*>
-*> C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
-*>
-*> I(m) is an m by m identity matrix, and kprod denotes the Kronecker
-*> product. We estimate sigma-min(C) by the reciprocal of an estimate of
-*> the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
-*> cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
-*>
-*> When SEP is small, small changes in T can cause large changes in
-*> the invariant subspace. An approximate bound on the maximum angular
-*> error in the computed right invariant subspace is
-*>
-*> EPS * norm(T) / SEP
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI,
- $ M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ, JOB
- INTEGER INFO, LDQ, LDT, LIWORK, LWORK, M, N
- REAL S, SEP
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- REAL Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ),
- $ WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, PAIR, SWAP, WANTBH, WANTQ, WANTS,
- $ WANTSP
- INTEGER IERR, K, KASE, KK, KS, LIWMIN, LWMIN, N1, N2,
- $ NN
- REAL EST, RNORM, SCALE
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SLANGE
- EXTERNAL LSAME, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLACN2, SLACPY, STREXC, STRSYL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- WANTBH = LSAME( JOB, 'B' )
- WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
- WANTSP = LSAME( JOB, 'V' ) .OR. WANTBH
- WANTQ = LSAME( COMPQ, 'V' )
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.WANTS .AND. .NOT.WANTSP )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
- INFO = -8
- ELSE
-*
-* Set M to the dimension of the specified invariant subspace,
-* and test LWORK and LIWORK.
-*
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( T( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
-*
- N1 = M
- N2 = N - M
- NN = N1*N2
-*
- IF( WANTSP ) THEN
- LWMIN = MAX( 1, 2*NN )
- LIWMIN = MAX( 1, NN )
- ELSE IF( LSAME( JOB, 'N' ) ) THEN
- LWMIN = MAX( 1, N )
- LIWMIN = 1
- ELSE IF( LSAME( JOB, 'E' ) ) THEN
- LWMIN = MAX( 1, NN )
- LIWMIN = 1
- END IF
-*
- IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -15
- ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
- INFO = -17
- END IF
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRSEN', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( M.EQ.N .OR. M.EQ.0 ) THEN
- IF( WANTS )
- $ S = ONE
- IF( WANTSP )
- $ SEP = SLANGE( '1', N, N, T, LDT, WORK )
- GO TO 40
- END IF
-*
-* Collect the selected blocks at the top-left corner of T.
-*
- KS = 0
- PAIR = .FALSE.
- DO 20 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- SWAP = SELECT( K )
- IF( K.LT.N ) THEN
- IF( T( K+1, K ).NE.ZERO ) THEN
- PAIR = .TRUE.
- SWAP = SWAP .OR. SELECT( K+1 )
- END IF
- END IF
- IF( SWAP ) THEN
- KS = KS + 1
-*
-* Swap the K-th block to position KS.
-*
- IERR = 0
- KK = K
- IF( K.NE.KS )
- $ CALL STREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, WORK,
- $ IERR )
- IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN
-*
-* Blocks too close to swap: exit.
-*
- INFO = 1
- IF( WANTS )
- $ S = ZERO
- IF( WANTSP )
- $ SEP = ZERO
- GO TO 40
- END IF
- IF( PAIR )
- $ KS = KS + 1
- END IF
- END IF
- 20 CONTINUE
-*
- IF( WANTS ) THEN
-*
-* Solve Sylvester equation for R:
-*
-* T11*R - R*T22 = scale*T12
-*
- CALL SLACPY( 'F', N1, N2, T( 1, N1+1 ), LDT, WORK, N1 )
- CALL STRSYL( 'N', 'N', -1, N1, N2, T, LDT, T( N1+1, N1+1 ),
- $ LDT, WORK, N1, SCALE, IERR )
-*
-* Estimate the reciprocal of the condition number of the cluster
-* of eigenvalues.
-*
- RNORM = SLANGE( 'F', N1, N2, WORK, N1, WORK )
- IF( RNORM.EQ.ZERO ) THEN
- S = ONE
- ELSE
- S = SCALE / ( SQRT( SCALE*SCALE / RNORM+RNORM )*
- $ SQRT( RNORM ) )
- END IF
- END IF
-*
- IF( WANTSP ) THEN
-*
-* Estimate sep(T11,T22).
-*
- EST = ZERO
- KASE = 0
- 30 CONTINUE
- CALL SLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Solve T11*R - R*T22 = scale*X.
-*
- CALL STRSYL( 'N', 'N', -1, N1, N2, T, LDT,
- $ T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
- $ IERR )
- ELSE
-*
-* Solve T11**T*R - R*T22**T = scale*X.
-*
- CALL STRSYL( 'T', 'T', -1, N1, N2, T, LDT,
- $ T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
- $ IERR )
- END IF
- GO TO 30
- END IF
-*
- SEP = SCALE / EST
- END IF
-*
- 40 CONTINUE
-*
-* Store the output eigenvalues in WR and WI.
-*
- DO 50 K = 1, N
- WR( K ) = T( K, K )
- WI( K ) = ZERO
- 50 CONTINUE
- DO 60 K = 1, N - 1
- IF( T( K+1, K ).NE.ZERO ) THEN
- WI( K ) = SQRT( ABS( T( K, K+1 ) ) )*
- $ SQRT( ABS( T( K+1, K ) ) )
- WI( K+1 ) = -WI( K )
- END IF
- 60 CONTINUE
-*
- WORK( 1 ) = LWMIN
- IWORK( 1 ) = LIWMIN
-*
- RETURN
-*
-* End of STRSEN
-*
- END
diff --git a/netlib/LAPACK/strsna.f b/netlib/LAPACK/strsna.f
deleted file mode 100644
index e53205c..0000000
--- a/netlib/LAPACK/strsna.f
+++ /dev/null
@@ -1,603 +0,0 @@
-*> \brief \b STRSNA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRSNA + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strsna.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strsna.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strsna.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-* LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, JOB
-* INTEGER INFO, LDT, LDVL, LDVR, LDWORK, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* INTEGER IWORK( * )
-* REAL S( * ), SEP( * ), T( LDT, * ), VL( LDVL, * ),
-* $ VR( LDVR, * ), WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRSNA estimates reciprocal condition numbers for specified
-*> eigenvalues and/or right eigenvectors of a real upper
-*> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
-*> orthogonal).
-*>
-*> T must be in Schur canonical form (as returned by SHSEQR), that is,
-*> block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*> 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies whether condition numbers are required for
-*> eigenvalues (S) or eigenvectors (SEP):
-*> = 'E': for eigenvalues only (S);
-*> = 'V': for eigenvectors only (SEP);
-*> = 'B': for both eigenvalues and eigenvectors (S and SEP).
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute condition numbers for all eigenpairs;
-*> = 'S': compute condition numbers for selected eigenpairs
-*> specified by the array SELECT.
-*> \endverbatim
-*>
-*> \param[in] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenpairs for which
-*> condition numbers are required. To select condition numbers
-*> for the eigenpair corresponding to a real eigenvalue w(j),
-*> SELECT(j) must be set to .TRUE.. To select condition numbers
-*> corresponding to a complex conjugate pair of eigenvalues w(j)
-*> and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
-*> set to .TRUE..
-*> If HOWMNY = 'A', SELECT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is REAL array, dimension (LDT,N)
-*> The upper quasi-triangular matrix T, in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] VL
-*> \verbatim
-*> VL is REAL array, dimension (LDVL,M)
-*> If JOB = 'E' or 'B', VL must contain left eigenvectors of T
-*> (or of any Q*T*Q**T with Q orthogonal), corresponding to the
-*> eigenpairs specified by HOWMNY and SELECT. The eigenvectors
-*> must be stored in consecutive columns of VL, as returned by
-*> SHSEIN or STREVC.
-*> If JOB = 'V', VL is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL.
-*> LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in] VR
-*> \verbatim
-*> VR is REAL array, dimension (LDVR,M)
-*> If JOB = 'E' or 'B', VR must contain right eigenvectors of T
-*> (or of any Q*T*Q**T with Q orthogonal), corresponding to the
-*> eigenpairs specified by HOWMNY and SELECT. The eigenvectors
-*> must be stored in consecutive columns of VR, as returned by
-*> SHSEIN or STREVC.
-*> If JOB = 'V', VR is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR.
-*> LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is REAL array, dimension (MM)
-*> If JOB = 'E' or 'B', the reciprocal condition numbers of the
-*> selected eigenvalues, stored in consecutive elements of the
-*> array. For a complex conjugate pair of eigenvalues two
-*> consecutive elements of S are set to the same value. Thus
-*> S(j), SEP(j), and the j-th columns of VL and VR all
-*> correspond to the same eigenpair (but not in general the
-*> j-th eigenpair, unless all eigenpairs are selected).
-*> If JOB = 'V', S is not referenced.
-*> \endverbatim
-*>
-*> \param[out] SEP
-*> \verbatim
-*> SEP is REAL array, dimension (MM)
-*> If JOB = 'V' or 'B', the estimated reciprocal condition
-*> numbers of the selected eigenvectors, stored in consecutive
-*> elements of the array. For a complex eigenvector two
-*> consecutive elements of SEP are set to the same value. If
-*> the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
-*> is set to 0; this can only occur when the true value would be
-*> very small anyway.
-*> If JOB = 'E', SEP is not referenced.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of elements in the arrays S (if JOB = 'E' or 'B')
-*> and/or SEP (if JOB = 'V' or 'B'). MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of elements of the arrays S and/or SEP actually
-*> used to store the estimated condition numbers.
-*> If HOWMNY = 'A', M is set to N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (LDWORK,N+6)
-*> If JOB = 'E', WORK is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (2*(N-1))
-*> If JOB = 'E', IWORK is not referenced.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The reciprocal of the condition number of an eigenvalue lambda is
-*> defined as
-*>
-*> S(lambda) = |v**T*u| / (norm(u)*norm(v))
-*>
-*> where u and v are the right and left eigenvectors of T corresponding
-*> to lambda; v**T denotes the transpose of v, and norm(u)
-*> denotes the Euclidean norm. These reciprocal condition numbers always
-*> lie between zero (very badly conditioned) and one (very well
-*> conditioned). If n = 1, S(lambda) is defined to be 1.
-*>
-*> An approximate error bound for a computed eigenvalue W(i) is given by
-*>
-*> EPS * norm(T) / S(i)
-*>
-*> where EPS is the machine precision.
-*>
-*> The reciprocal of the condition number of the right eigenvector u
-*> corresponding to lambda is defined as follows. Suppose
-*>
-*> T = ( lambda c )
-*> ( 0 T22 )
-*>
-*> Then the reciprocal condition number is
-*>
-*> SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
-*>
-*> where sigma-min denotes the smallest singular value. We approximate
-*> the smallest singular value by the reciprocal of an estimate of the
-*> one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
-*> defined to be abs(T(1,1)).
-*>
-*> An approximate error bound for a computed right eigenvector VR(i)
-*> is given by
-*>
-*> EPS * norm(T) / SEP(i)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
- $ LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, JOB
- INTEGER INFO, LDT, LDVL, LDVR, LDWORK, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- INTEGER IWORK( * )
- REAL S( * ), SEP( * ), T( LDT, * ), VL( LDVL, * ),
- $ VR( LDVR, * ), WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL PAIR, SOMCON, WANTBH, WANTS, WANTSP
- INTEGER I, IERR, IFST, ILST, J, K, KASE, KS, N2, NN
- REAL BIGNUM, COND, CS, DELTA, DUMM, EPS, EST, LNRM,
- $ MU, PROD, PROD1, PROD2, RNRM, SCALE, SMLNUM, SN
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
- REAL DUMMY( 1 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT, SLAMCH, SLAPY2, SNRM2
- EXTERNAL LSAME, SDOT, SLAMCH, SLAPY2, SNRM2
-* ..
-* .. External Subroutines ..
- EXTERNAL SLABAD, SLACN2, SLACPY, SLAQTR, STREXC, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- WANTBH = LSAME( JOB, 'B' )
- WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
- WANTSP = LSAME( JOB, 'V' ) .OR. WANTBH
-*
- SOMCON = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- IF( .NOT.WANTS .AND. .NOT.WANTSP ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( HOWMNY, 'A' ) .AND. .NOT.SOMCON ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVL.LT.1 .OR. ( WANTS .AND. LDVL.LT.N ) ) THEN
- INFO = -8
- ELSE IF( LDVR.LT.1 .OR. ( WANTS .AND. LDVR.LT.N ) ) THEN
- INFO = -10
- ELSE
-*
-* Set M to the number of eigenpairs for which condition numbers
-* are required, and test MM.
-*
- IF( SOMCON ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 K = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- ELSE
- IF( K.LT.N ) THEN
- IF( T( K+1, K ).EQ.ZERO ) THEN
- IF( SELECT( K ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( K ) .OR. SELECT( K+1 ) )
- $ M = M + 2
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( MM.LT.M ) THEN
- INFO = -13
- ELSE IF( LDWORK.LT.1 .OR. ( WANTSP .AND. LDWORK.LT.N ) ) THEN
- INFO = -16
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRSNA', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( N.EQ.1 ) THEN
- IF( SOMCON ) THEN
- IF( .NOT.SELECT( 1 ) )
- $ RETURN
- END IF
- IF( WANTS )
- $ S( 1 ) = ONE
- IF( WANTSP )
- $ SEP( 1 ) = ABS( T( 1, 1 ) )
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
-*
- KS = 0
- PAIR = .FALSE.
- DO 60 K = 1, N
-*
-* Determine whether T(k,k) begins a 1-by-1 or 2-by-2 block.
-*
- IF( PAIR ) THEN
- PAIR = .FALSE.
- GO TO 60
- ELSE
- IF( K.LT.N )
- $ PAIR = T( K+1, K ).NE.ZERO
- END IF
-*
-* Determine whether condition numbers are required for the k-th
-* eigenpair.
-*
- IF( SOMCON ) THEN
- IF( PAIR ) THEN
- IF( .NOT.SELECT( K ) .AND. .NOT.SELECT( K+1 ) )
- $ GO TO 60
- ELSE
- IF( .NOT.SELECT( K ) )
- $ GO TO 60
- END IF
- END IF
-*
- KS = KS + 1
-*
- IF( WANTS ) THEN
-*
-* Compute the reciprocal condition number of the k-th
-* eigenvalue.
-*
- IF( .NOT.PAIR ) THEN
-*
-* Real eigenvalue.
-*
- PROD = SDOT( N, VR( 1, KS ), 1, VL( 1, KS ), 1 )
- RNRM = SNRM2( N, VR( 1, KS ), 1 )
- LNRM = SNRM2( N, VL( 1, KS ), 1 )
- S( KS ) = ABS( PROD ) / ( RNRM*LNRM )
- ELSE
-*
-* Complex eigenvalue.
-*
- PROD1 = SDOT( N, VR( 1, KS ), 1, VL( 1, KS ), 1 )
- PROD1 = PROD1 + SDOT( N, VR( 1, KS+1 ), 1, VL( 1, KS+1 ),
- $ 1 )
- PROD2 = SDOT( N, VL( 1, KS ), 1, VR( 1, KS+1 ), 1 )
- PROD2 = PROD2 - SDOT( N, VL( 1, KS+1 ), 1, VR( 1, KS ),
- $ 1 )
- RNRM = SLAPY2( SNRM2( N, VR( 1, KS ), 1 ),
- $ SNRM2( N, VR( 1, KS+1 ), 1 ) )
- LNRM = SLAPY2( SNRM2( N, VL( 1, KS ), 1 ),
- $ SNRM2( N, VL( 1, KS+1 ), 1 ) )
- COND = SLAPY2( PROD1, PROD2 ) / ( RNRM*LNRM )
- S( KS ) = COND
- S( KS+1 ) = COND
- END IF
- END IF
-*
- IF( WANTSP ) THEN
-*
-* Estimate the reciprocal condition number of the k-th
-* eigenvector.
-*
-* Copy the matrix T to the array WORK and swap the diagonal
-* block beginning at T(k,k) to the (1,1) position.
-*
- CALL SLACPY( 'Full', N, N, T, LDT, WORK, LDWORK )
- IFST = K
- ILST = 1
- CALL STREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, IFST, ILST,
- $ WORK( 1, N+1 ), IERR )
-*
- IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN
-*
-* Could not swap because blocks not well separated
-*
- SCALE = ONE
- EST = BIGNUM
- ELSE
-*
-* Reordering successful
-*
- IF( WORK( 2, 1 ).EQ.ZERO ) THEN
-*
-* Form C = T22 - lambda*I in WORK(2:N,2:N).
-*
- DO 20 I = 2, N
- WORK( I, I ) = WORK( I, I ) - WORK( 1, 1 )
- 20 CONTINUE
- N2 = 1
- NN = N - 1
- ELSE
-*
-* Triangularize the 2 by 2 block by unitary
-* transformation U = [ cs i*ss ]
-* [ i*ss cs ].
-* such that the (1,1) position of WORK is complex
-* eigenvalue lambda with positive imaginary part. (2,2)
-* position of WORK is the complex eigenvalue lambda
-* with negative imaginary part.
-*
- MU = SQRT( ABS( WORK( 1, 2 ) ) )*
- $ SQRT( ABS( WORK( 2, 1 ) ) )
- DELTA = SLAPY2( MU, WORK( 2, 1 ) )
- CS = MU / DELTA
- SN = -WORK( 2, 1 ) / DELTA
-*
-* Form
-*
-* C**T = WORK(2:N,2:N) + i*[rwork(1) ..... rwork(n-1) ]
-* [ mu ]
-* [ .. ]
-* [ .. ]
-* [ mu ]
-* where C**T is transpose of matrix C,
-* and RWORK is stored starting in the N+1-st column of
-* WORK.
-*
- DO 30 J = 3, N
- WORK( 2, J ) = CS*WORK( 2, J )
- WORK( J, J ) = WORK( J, J ) - WORK( 1, 1 )
- 30 CONTINUE
- WORK( 2, 2 ) = ZERO
-*
- WORK( 1, N+1 ) = TWO*MU
- DO 40 I = 2, N - 1
- WORK( I, N+1 ) = SN*WORK( 1, I+1 )
- 40 CONTINUE
- N2 = 2
- NN = 2*( N-1 )
- END IF
-*
-* Estimate norm(inv(C**T))
-*
- EST = ZERO
- KASE = 0
- 50 CONTINUE
- CALL SLACN2( NN, WORK( 1, N+2 ), WORK( 1, N+4 ), IWORK,
- $ EST, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
- IF( N2.EQ.1 ) THEN
-*
-* Real eigenvalue: solve C**T*x = scale*c.
-*
- CALL SLAQTR( .TRUE., .TRUE., N-1, WORK( 2, 2 ),
- $ LDWORK, DUMMY, DUMM, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
- ELSE
-*
-* Complex eigenvalue: solve
-* C**T*(p+iq) = scale*(c+id) in real arithmetic.
-*
- CALL SLAQTR( .TRUE., .FALSE., N-1, WORK( 2, 2 ),
- $ LDWORK, WORK( 1, N+1 ), MU, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
- END IF
- ELSE
- IF( N2.EQ.1 ) THEN
-*
-* Real eigenvalue: solve C*x = scale*c.
-*
- CALL SLAQTR( .FALSE., .TRUE., N-1, WORK( 2, 2 ),
- $ LDWORK, DUMMY, DUMM, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
- ELSE
-*
-* Complex eigenvalue: solve
-* C*(p+iq) = scale*(c+id) in real arithmetic.
-*
- CALL SLAQTR( .FALSE., .FALSE., N-1,
- $ WORK( 2, 2 ), LDWORK,
- $ WORK( 1, N+1 ), MU, SCALE,
- $ WORK( 1, N+4 ), WORK( 1, N+6 ),
- $ IERR )
-*
- END IF
- END IF
-*
- GO TO 50
- END IF
- END IF
-*
- SEP( KS ) = SCALE / MAX( EST, SMLNUM )
- IF( PAIR )
- $ SEP( KS+1 ) = SEP( KS )
- END IF
-*
- IF( PAIR )
- $ KS = KS + 1
-*
- 60 CONTINUE
- RETURN
-*
-* End of STRSNA
-*
- END
diff --git a/netlib/LAPACK/strsyl.f b/netlib/LAPACK/strsyl.f
deleted file mode 100644
index db8649e..0000000
--- a/netlib/LAPACK/strsyl.f
+++ /dev/null
@@ -1,1002 +0,0 @@
-*> \brief \b STRSYL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRSYL + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strsyl.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strsyl.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strsyl.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
-* LDC, SCALE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANA, TRANB
-* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
-* REAL SCALE
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), C( LDC, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRSYL solves the real Sylvester matrix equation:
-*>
-*> op(A)*X + X*op(B) = scale*C or
-*> op(A)*X - X*op(B) = scale*C,
-*>
-*> where op(A) = A or A**T, and A and B are both upper quasi-
-*> triangular. A is M-by-M and B is N-by-N; the right hand side C and
-*> the solution X are M-by-N; and scale is an output scale factor, set
-*> <= 1 to avoid overflow in X.
-*>
-*> A and B must be in Schur canonical form (as returned by SHSEQR), that
-*> is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
-*> each 2-by-2 diagonal block has its diagonal elements equal and its
-*> off-diagonal elements of opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANA
-*> \verbatim
-*> TRANA is CHARACTER*1
-*> Specifies the option op(A):
-*> = 'N': op(A) = A (No transpose)
-*> = 'T': op(A) = A**T (Transpose)
-*> = 'C': op(A) = A**H (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] TRANB
-*> \verbatim
-*> TRANB is CHARACTER*1
-*> Specifies the option op(B):
-*> = 'N': op(B) = B (No transpose)
-*> = 'T': op(B) = B**T (Transpose)
-*> = 'C': op(B) = B**H (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] ISGN
-*> \verbatim
-*> ISGN is INTEGER
-*> Specifies the sign in the equation:
-*> = +1: solve op(A)*X + X*op(B) = scale*C
-*> = -1: solve op(A)*X - X*op(B) = scale*C
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The order of the matrix A, and the number of rows in the
-*> matrices X and C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B, and the number of columns in the
-*> matrices X and C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,M)
-*> The upper quasi-triangular matrix A, in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,N)
-*> The upper quasi-triangular matrix B, in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array, dimension (LDC,N)
-*> On entry, the M-by-N right hand side matrix C.
-*> On exit, C is overwritten by the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M)
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is REAL
-*> The scale factor, scale, set <= 1 to avoid overflow in X.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: A and B have common or very close eigenvalues; perturbed
-*> values were used to solve the equation (but the matrices
-*> A and B are unchanged).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realSYcomputational
-*
-* =====================================================================
- SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
- $ LDC, SCALE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANA, TRANB
- INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
- REAL SCALE
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * ), C( LDC, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRNA, NOTRNB
- INTEGER IERR, J, K, K1, K2, KNEXT, L, L1, L2, LNEXT
- REAL A11, BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
- $ SMLNUM, SUML, SUMR, XNORM
-* ..
-* .. Local Arrays ..
- REAL DUM( 1 ), VEC( 2, 2 ), X( 2, 2 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- REAL SDOT, SLAMCH, SLANGE
- EXTERNAL LSAME, SDOT, SLAMCH, SLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL SLABAD, SLALN2, SLASY2, SSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, REAL
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test input parameters
-*
- NOTRNA = LSAME( TRANA, 'N' )
- NOTRNB = LSAME( TRANB, 'N' )
-*
- INFO = 0
- IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
- $ LSAME( TRANA, 'C' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
- $ LSAME( TRANB, 'C' ) ) THEN
- INFO = -2
- ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRSYL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- SCALE = ONE
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = SLAMCH( 'P' )
- SMLNUM = SLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL SLABAD( SMLNUM, BIGNUM )
- SMLNUM = SMLNUM*REAL( M*N ) / EPS
- BIGNUM = ONE / SMLNUM
-*
- SMIN = MAX( SMLNUM, EPS*SLANGE( 'M', M, M, A, LDA, DUM ),
- $ EPS*SLANGE( 'M', N, N, B, LDB, DUM ) )
-*
- SGN = ISGN
-*
- IF( NOTRNA .AND. NOTRNB ) THEN
-*
-* Solve A*X + ISGN*X*B = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* bottom-left corner column by column by
-*
-* A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-* Where
-* M L-1
-* R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)].
-* I=K+1 J=1
-*
-* Start column loop (index = L)
-* L1 (L2) : column index of the first (first) row of X(K,L).
-*
- LNEXT = 1
- DO 70 L = 1, N
- IF( L.LT.LNEXT )
- $ GO TO 70
- IF( L.EQ.N ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L+1, L ).NE.ZERO ) THEN
- L1 = L
- L2 = L + 1
- LNEXT = L + 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L + 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L).
-*
- KNEXT = M
- DO 60 K = M, 1, -1
- IF( K.GT.KNEXT )
- $ GO TO 60
- IF( K.EQ.1 ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K, K-1 ).NE.ZERO ) THEN
- K1 = K - 1
- K2 = K
- KNEXT = K - 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K - 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 10 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 10 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 20 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 20 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L2 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 40 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 40 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL SLASY2( .FALSE., .FALSE., ISGN, 2, 2,
- $ A( K1, K1 ), LDA, B( L1, L1 ), LDB, VEC,
- $ 2, SCALOC, X, 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 50 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 50 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 60 CONTINUE
-*
- 70 CONTINUE
-*
- ELSE IF( .NOT.NOTRNA .AND. NOTRNB ) THEN
-*
-* Solve A**T *X + ISGN*X*B = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* upper-left corner column by column by
-*
-* A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-* Where
-* K-1 L-1
-* R(K,L) = SUM [A(I,K)**T*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)]
-* I=1 J=1
-*
-* Start column loop (index = L)
-* L1 (L2): column index of the first (last) row of X(K,L)
-*
- LNEXT = 1
- DO 130 L = 1, N
- IF( L.LT.LNEXT )
- $ GO TO 130
- IF( L.EQ.N ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L+1, L ).NE.ZERO ) THEN
- L1 = L
- L2 = L + 1
- LNEXT = L + 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L + 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L)
-*
- KNEXT = 1
- DO 120 K = 1, M
- IF( K.LT.KNEXT )
- $ GO TO 120
- IF( K.EQ.M ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K+1, K ).NE.ZERO ) THEN
- K1 = K
- K2 = K + 1
- KNEXT = K + 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K + 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 80 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 80 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 90 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 90 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 100 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 100 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
- SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL SLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ),
- $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
- $ 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 110 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 110 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 120 CONTINUE
- 130 CONTINUE
-*
- ELSE IF( .NOT.NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-* Solve A**T*X + ISGN*X*B**T = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* top-right corner column by column by
-*
-* A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
-*
-* Where
-* K-1 N
-* R(K,L) = SUM [A(I,K)**T*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
-* I=1 J=L+1
-*
-* Start column loop (index = L)
-* L1 (L2): column index of the first (last) row of X(K,L)
-*
- LNEXT = N
- DO 190 L = N, 1, -1
- IF( L.GT.LNEXT )
- $ GO TO 190
- IF( L.EQ.1 ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L, L-1 ).NE.ZERO ) THEN
- L1 = L - 1
- L2 = L
- LNEXT = L - 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L - 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L)
-*
- KNEXT = 1
- DO 180 K = 1, M
- IF( K.LT.KNEXT )
- $ GO TO 180
- IF( K.EQ.M ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K+1, K ).NE.ZERO ) THEN
- K1 = K
- K2 = K + 1
- KNEXT = K + 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K + 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
- $ B( L1, MIN( L1+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 140 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 140 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 150 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 150 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 160 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 160 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
- SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
- SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN(L2+1, N ) ), LDB )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL SLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
- $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
- $ 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 170 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 170 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 180 CONTINUE
- 190 CONTINUE
-*
- ELSE IF( NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-* Solve A*X + ISGN*X*B**T = scale*C.
-*
-* The (K,L)th block of X is determined starting from
-* bottom-right corner column by column by
-*
-* A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
-*
-* Where
-* M N
-* R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
-* I=K+1 J=L+1
-*
-* Start column loop (index = L)
-* L1 (L2): column index of the first (last) row of X(K,L)
-*
- LNEXT = N
- DO 250 L = N, 1, -1
- IF( L.GT.LNEXT )
- $ GO TO 250
- IF( L.EQ.1 ) THEN
- L1 = L
- L2 = L
- ELSE
- IF( B( L, L-1 ).NE.ZERO ) THEN
- L1 = L - 1
- L2 = L
- LNEXT = L - 2
- ELSE
- L1 = L
- L2 = L
- LNEXT = L - 1
- END IF
- END IF
-*
-* Start row loop (index = K)
-* K1 (K2): row index of the first (last) row of X(K,L)
-*
- KNEXT = M
- DO 240 K = M, 1, -1
- IF( K.GT.KNEXT )
- $ GO TO 240
- IF( K.EQ.1 ) THEN
- K1 = K
- K2 = K
- ELSE
- IF( A( K, K-1 ).NE.ZERO ) THEN
- K1 = K - 1
- K2 = K
- KNEXT = K - 2
- ELSE
- K1 = K
- K2 = K
- KNEXT = K - 1
- END IF
- END IF
-*
- IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
- SUML = SDOT( M-K1, A( K1, MIN(K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = SDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
- $ B( L1, MIN( L1+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
- SCALOC = ONE
-*
- A11 = A( K1, K1 ) + SGN*B( L1, L1 )
- DA11 = ABS( A11 )
- IF( DA11.LE.SMIN ) THEN
- A11 = SMIN
- DA11 = SMIN
- INFO = 1
- END IF
- DB = ABS( VEC( 1, 1 ) )
- IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
- IF( DB.GT.BIGNUM*DA11 )
- $ SCALOC = ONE / DB
- END IF
- X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 200 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 200 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
-*
- ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
- $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 210 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 210 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K2, L1 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
- SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L1 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
- SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
- $ C( MIN( K1+1, M ), L2 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
- CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
- $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
- $ ZERO, X, 2, SCALOC, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 220 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 220 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 2, 1 )
-*
- ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
- SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L1 ), 1 )
- SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L1, MIN( L2+1, N ) ), LDB )
- VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
- SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
- $ C( MIN( K2+1, M ), L2 ), 1 )
- SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
- $ B( L2, MIN( L2+1, N ) ), LDB )
- VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
- CALL SLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
- $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
- $ 2, XNORM, IERR )
- IF( IERR.NE.0 )
- $ INFO = 1
-*
- IF( SCALOC.NE.ONE ) THEN
- DO 230 J = 1, N
- CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
- 230 CONTINUE
- SCALE = SCALE*SCALOC
- END IF
- C( K1, L1 ) = X( 1, 1 )
- C( K1, L2 ) = X( 1, 2 )
- C( K2, L1 ) = X( 2, 1 )
- C( K2, L2 ) = X( 2, 2 )
- END IF
-*
- 240 CONTINUE
- 250 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of STRSYL
-*
- END
diff --git a/netlib/LAPACK/strti2.f b/netlib/LAPACK/strti2.f
deleted file mode 100644
index 20eea39..0000000
--- a/netlib/LAPACK/strti2.f
+++ /dev/null
@@ -1,212 +0,0 @@
-*> \brief \b STRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRTI2 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strti2.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strti2.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strti2.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRTI2 computes the inverse of a real upper or lower triangular
-*> matrix.
-*>
-*> This is the Level 2 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading n by n upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced. If DIAG = 'U', the
-*> diagonal elements of A are also not referenced and are
-*> assumed to be 1.
-*>
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J
- REAL AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SSCAL, STRMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRTI2', -INFO )
- RETURN
- END IF
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix.
-*
- DO 10 J = 1, N
- IF( NOUNIT ) THEN
- A( J, J ) = ONE / A( J, J )
- AJJ = -A( J, J )
- ELSE
- AJJ = -ONE
- END IF
-*
-* Compute elements 1:j-1 of j-th column.
-*
- CALL STRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
- $ A( 1, J ), 1 )
- CALL SSCAL( J-1, AJJ, A( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Compute inverse of lower triangular matrix.
-*
- DO 20 J = N, 1, -1
- IF( NOUNIT ) THEN
- A( J, J ) = ONE / A( J, J )
- AJJ = -A( J, J )
- ELSE
- AJJ = -ONE
- END IF
- IF( J.LT.N ) THEN
-*
-* Compute elements j+1:n of j-th column.
-*
- CALL STRMV( 'Lower', 'No transpose', DIAG, N-J,
- $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
- CALL SSCAL( N-J, AJJ, A( J+1, J ), 1 )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of STRTI2
-*
- END
diff --git a/netlib/LAPACK/strtri.f b/netlib/LAPACK/strtri.f
deleted file mode 100644
index d9dbf84..0000000
--- a/netlib/LAPACK/strtri.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b STRTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRTRI + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strtri.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strtri.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strtri.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRTRI computes the inverse of a real upper or lower triangular
-*> matrix A.
-*>
-*> This is the Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced. If DIAG = 'U', the
-*> diagonal elements of A are also not referenced and are
-*> assumed to be 1.
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JB, NB, NN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL STRMM, STRSM, STRTI2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity if non-unit.
-*
- IF( NOUNIT ) THEN
- DO 10 INFO = 1, N
- IF( A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- INFO = 0
- END IF
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL STRTI2( UPLO, DIAG, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix
-*
- DO 20 J = 1, N, NB
- JB = MIN( NB, N-J+1 )
-*
-* Compute rows 1:j-1 of current block column
-*
- CALL STRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
- $ JB, ONE, A, LDA, A( 1, J ), LDA )
- CALL STRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
- $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
-*
-* Compute inverse of current diagonal block
-*
- CALL STRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
- 20 CONTINUE
- ELSE
-*
-* Compute inverse of lower triangular matrix
-*
- NN = ( ( N-1 ) / NB )*NB + 1
- DO 30 J = NN, 1, -NB
- JB = MIN( NB, N-J+1 )
- IF( J+JB.LE.N ) THEN
-*
-* Compute rows j+jb:n of current block column
-*
- CALL STRMM( 'Left', 'Lower', 'No transpose', DIAG,
- $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
- $ A( J+JB, J ), LDA )
- CALL STRSM( 'Right', 'Lower', 'No transpose', DIAG,
- $ N-J-JB+1, JB, -ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
- END IF
-*
-* Compute inverse of current diagonal block
-*
- CALL STRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
- 30 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of STRTRI
-*
- END
diff --git a/netlib/LAPACK/strtrs.f b/netlib/LAPACK/strtrs.f
deleted file mode 100644
index 51c6a4e..0000000
--- a/netlib/LAPACK/strtrs.f
+++ /dev/null
@@ -1,226 +0,0 @@
-*> \brief \b STRTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRTRS + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strtrs.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strtrs.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strtrs.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRTRS solves a triangular system of the form
-*>
-*> A * X = B or A**T * X = B,
-*>
-*> where A is a triangular matrix of order N, and B is an N-by-NRHS
-*> matrix. A check is made to verify that A is nonsingular.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the solutions
-*> X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- DO 10 INFO = 1, N
- IF( A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- END IF
- INFO = 0
-*
-* Solve A * x = b or A**T * x = b.
-*
- CALL STRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
- $ LDB )
-*
- RETURN
-*
-* End of STRTRS
-*
- END
diff --git a/netlib/LAPACK/strttf.f b/netlib/LAPACK/strttf.f
deleted file mode 100644
index c42ea20..0000000
--- a/netlib/LAPACK/strttf.f
+++ /dev/null
@@ -1,492 +0,0 @@
-*> \brief \b STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRTTF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strttf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strttf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strttf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANSR, UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRTTF copies a triangular matrix A from standard full format (TR)
-*> to rectangular full packed format (TF) .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSR
-*> \verbatim
-*> TRANSR is CHARACTER*1
-*> = 'N': ARF in Normal form is wanted;
-*> = 'T': ARF in Transpose form is wanted.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': Upper triangle of A is stored;
-*> = 'L': Lower triangle of A is stored.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N).
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the matrix A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ARF
-*> \verbatim
-*> ARF is REAL array, dimension (NT).
-*> NT=N*(N+1)/2. On exit, the triangular matrix A in RFP format.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> We first consider Rectangular Full Packed (RFP) Format when N is
-*> even. We give an example where N = 6.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 05 00
-*> 11 12 13 14 15 10 11
-*> 22 23 24 25 20 21 22
-*> 33 34 35 30 31 32 33
-*> 44 45 40 41 42 43 44
-*> 55 50 51 52 53 54 55
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
-*> the transpose of the first three columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
-*> the transpose of the last three columns of AP lower.
-*> This covers the case N even and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 03 04 05 33 43 53
-*> 13 14 15 00 44 54
-*> 23 24 25 10 11 55
-*> 33 34 35 20 21 22
-*> 00 44 45 30 31 32
-*> 01 11 55 40 41 42
-*> 02 12 22 50 51 52
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*>
-*> RFP A RFP A
-*>
-*> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
-*> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
-*> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
-*>
-*>
-*> We then consider Rectangular Full Packed (RFP) Format when N is
-*> odd. We give an example where N = 5.
-*>
-*> AP is Upper AP is Lower
-*>
-*> 00 01 02 03 04 00
-*> 11 12 13 14 10 11
-*> 22 23 24 20 21 22
-*> 33 34 30 31 32 33
-*> 44 40 41 42 43 44
-*>
-*>
-*> Let TRANSR = 'N'. RFP holds AP as follows:
-*> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
-*> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
-*> the transpose of the first two columns of AP upper.
-*> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
-*> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
-*> the transpose of the last two columns of AP lower.
-*> This covers the case N odd and TRANSR = 'N'.
-*>
-*> RFP A RFP A
-*>
-*> 02 03 04 00 33 43
-*> 12 13 14 10 11 44
-*> 22 23 24 20 21 22
-*> 00 33 34 30 31 32
-*> 01 11 44 40 41 42
-*>
-*> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
-*> transpose of RFP A above. One therefore gets:
-*>
-*> RFP A RFP A
-*>
-*> 02 12 22 00 01 00 10 20 30 40 50
-*> 03 13 23 33 11 33 11 21 31 41 51
-*> 04 14 24 34 44 43 44 22 32 42 52
-*> \endverbatim
-*
-* =====================================================================
- SUBROUTINE STRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER TRANSR, UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( 0: LDA-1, 0: * ), ARF( 0: * )
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, NISODD, NORMALTRANSR
- INTEGER I, IJ, J, K, L, N1, N2, NT, NX2, NP1X2
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MOD
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NORMALTRANSR = LSAME( TRANSR, 'N' )
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRTTF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 ) THEN
- IF( N.EQ.1 ) THEN
- ARF( 0 ) = A( 0, 0 )
- END IF
- RETURN
- END IF
-*
-* Size of array ARF(0:nt-1)
-*
- NT = N*( N+1 ) / 2
-*
-* Set N1 and N2 depending on LOWER: for N even N1=N2=K
-*
- IF( LOWER ) THEN
- N2 = N / 2
- N1 = N - N2
- ELSE
- N1 = N / 2
- N2 = N - N1
- END IF
-*
-* If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
-* If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
-* N--by--(N+1)/2.
-*
- IF( MOD( N, 2 ).EQ.0 ) THEN
- K = N / 2
- NISODD = .FALSE.
- IF( .NOT.LOWER )
- $ NP1X2 = N + N + 2
- ELSE
- NISODD = .TRUE.
- IF( .NOT.LOWER )
- $ NX2 = N + N
- END IF
-*
- IF( NISODD ) THEN
-*
-* N is odd
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is odd and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2
- DO I = N1, N2 + J
- ARF( IJ ) = A( N2+J, I )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N
- DO J = N - 1, N1, -1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = J - N1, N1 - 1
- ARF( IJ ) = A( J-N1, L )
- IJ = IJ + 1
- END DO
- IJ = IJ - NX2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is odd and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is odd, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, N2 - 1
- DO I = 0, J
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- DO I = N1 + J, N - 1
- ARF( IJ ) = A( I, N1+J )
- IJ = IJ + 1
- END DO
- END DO
- DO J = N2, N - 1
- DO I = 0, N1 - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is odd, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, N1
- DO I = N1, N - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, N1 - 1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = N2 + J, N - 1
- ARF( IJ ) = A( N2+J, L )
- IJ = IJ + 1
- END DO
- END DO
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N is even
-*
- IF( NORMALTRANSR ) THEN
-*
-* N is even and TRANSR = 'N'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'N', and UPLO = 'L'
-*
- IJ = 0
- DO J = 0, K - 1
- DO I = K, K + J
- ARF( IJ ) = A( K+J, I )
- IJ = IJ + 1
- END DO
- DO I = J, N - 1
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'N', and UPLO = 'U'
-*
- IJ = NT - N - 1
- DO J = N - 1, K, -1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = J - K, K - 1
- ARF( IJ ) = A( J-K, L )
- IJ = IJ + 1
- END DO
- IJ = IJ - NP1X2
- END DO
-*
- END IF
-*
- ELSE
-*
-* N is even and TRANSR = 'T'
-*
- IF( LOWER ) THEN
-*
-* N is even, TRANSR = 'T', and UPLO = 'L'
-*
- IJ = 0
- J = K
- DO I = K, N - 1
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- DO I = K + 1 + J, N - 1
- ARF( IJ ) = A( I, K+1+J )
- IJ = IJ + 1
- END DO
- END DO
- DO J = K - 1, N - 1
- DO I = 0, K - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
-*
- ELSE
-*
-* N is even, TRANSR = 'T', and UPLO = 'U'
-*
- IJ = 0
- DO J = 0, K
- DO I = K, N - 1
- ARF( IJ ) = A( J, I )
- IJ = IJ + 1
- END DO
- END DO
- DO J = 0, K - 2
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
- DO L = K + 1 + J, N - 1
- ARF( IJ ) = A( K+1+J, L )
- IJ = IJ + 1
- END DO
- END DO
-* Note that here, on exit of the loop, J = K-1
- DO I = 0, J
- ARF( IJ ) = A( I, J )
- IJ = IJ + 1
- END DO
-*
- END IF
-*
- END IF
-*
- END IF
-*
- RETURN
-*
-* End of STRTTF
-*
- END
diff --git a/netlib/LAPACK/strttp.f b/netlib/LAPACK/strttp.f
deleted file mode 100644
index 4b2391b..0000000
--- a/netlib/LAPACK/strttp.f
+++ /dev/null
@@ -1,175 +0,0 @@
-*> \brief \b STRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP).
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STRTTP + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strttp.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strttp.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strttp.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRTTP( UPLO, N, A, LDA, AP, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), AP( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STRTTP copies a triangular matrix A from full format (TR) to standard
-*> packed format (TP).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular.
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrices AP and A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On exit, the triangular matrix A. If UPLO = 'U', the leading
-*> N-by-N upper triangular part of A contains the upper
-*> triangular part of the matrix A, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of A contains the lower
-*> triangular part of the matrix A, and the strictly upper
-*> triangular part of A is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] AP
-*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2
-*> On exit, the upper or lower triangular matrix A, packed
-*> columnwise in a linear array. The j-th column of A is stored
-*> in the array AP as follows:
-*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup realOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE STRTTP( UPLO, N, A, LDA, AP, INFO )
-*
-* -- LAPACK computational routine (version 3.4.2) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* September 2012
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), AP( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER
- INTEGER I, J, K
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STRTTP', -INFO )
- RETURN
- END IF
-*
- IF( LOWER ) THEN
- K = 0
- DO J = 1, N
- DO I = J, N
- K = K + 1
- AP( K ) = A( I, J )
- END DO
- END DO
- ELSE
- K = 0
- DO J = 1, N
- DO I = 1, J
- K = K + 1
- AP( K ) = A( I, J )
- END DO
- END DO
- END IF
-*
- RETURN
-*
-* End of STRTTP
-*
- END
diff --git a/netlib/LAPACK/stzrqf.f b/netlib/LAPACK/stzrqf.f
deleted file mode 100644
index f2969fc..0000000
--- a/netlib/LAPACK/stzrqf.f
+++ /dev/null
@@ -1,232 +0,0 @@
-*> \brief \b STZRQF
-*
-* =========== DOCUMENTATION ===========
-*
-* 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>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stzrqf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stzrqf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STZRQF( M, N, A, LDA, TAU, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This routine is deprecated and has been replaced by routine STZRZF.
-*>
-*> STZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
-*> to upper triangular form by means of orthogonal transformations.
-*>
-*> The upper trapezoidal matrix A is factored as
-*>
-*> A = ( R 0 ) * Z,
-*>
-*> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
-*> triangular matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= M.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the leading M-by-N upper trapezoidal part of the
-*> array A must contain the matrix to be factorized.
-*> On exit, the leading M-by-M upper triangular part of A
-*> contains the upper triangular matrix R, and elements M+1 to
-*> N of the first M rows of A, with the array TAU, represent the
-*> orthogonal matrix Z as a product of M elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (M)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The factorization is obtained by Householder's method. The kth
-*> transformation matrix, Z( k ), which is used to introduce zeros into
-*> the ( m - k + 1 )th row of A, is given in the form
-*>
-*> Z( k ) = ( I 0 ),
-*> ( 0 T( k ) )
-*>
-*> where
-*>
-*> T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ),
-*> ( 0 )
-*> ( z( k ) )
-*>
-*> tau is a scalar and z( k ) is an ( n - m ) element vector.
-*> tau and z( k ) are chosen to annihilate the elements of the kth row
-*> of X.
-*>
-*> The scalar tau is returned in the kth element of TAU and the vector
-*> u( k ) in the kth row of A, such that the elements of z( k ) are
-*> in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
-*> the upper triangular part of A.
-*>
-*> Z is given by
-*>
-*> Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STZRQF( M, N, A, LDA, TAU, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K, M1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SGEMV, SGER, SLARFG, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STZRQF', -INFO )
- RETURN
- END IF
-*
-* Perform the factorization.
-*
- IF( M.EQ.0 )
- $ RETURN
- IF( M.EQ.N ) THEN
- DO 10 I = 1, N
- TAU( I ) = ZERO
- 10 CONTINUE
- ELSE
- M1 = MIN( M+1, N )
- DO 20 K = M, 1, -1
-*
-* 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 ) )
-*
- IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN
-*
-* We now perform the operation A := A*P( k ).
-*
-* Use the first ( k - 1 ) elements of TAU to store a( k ),
-* where a( k ) consists of the first ( k - 1 ) elements of
-* the kth column of A. Also let B denote the first
-* ( k - 1 ) rows of the last ( n - m ) columns of A.
-*
- CALL SCOPY( K-1, A( 1, K ), 1, TAU, 1 )
-*
-* Form w = a( k ) + B*z( k ) in TAU.
-*
- CALL SGEMV( 'No transpose', K-1, N-M, ONE, A( 1, M1 ),
- $ LDA, A( K, M1 ), LDA, ONE, TAU, 1 )
-*
-* Now form a( k ) := a( k ) - tau*w
-* 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 )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of STZRQF
-*
- END
diff --git a/netlib/LAPACK/stzrzf.f b/netlib/LAPACK/stzrzf.f
deleted file mode 100644
index 9b2b498..0000000
--- a/netlib/LAPACK/stzrzf.f
+++ /dev/null
@@ -1,313 +0,0 @@
-*> \brief \b STZRZF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download STZRZF + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stzrzf.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stzrzf.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stzrzf.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
-*> to upper triangular form by means of orthogonal transformations.
-*>
-*> The upper trapezoidal matrix A is factored as
-*>
-*> A = ( R 0 ) * Z,
-*>
-*> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
-*> triangular matrix.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= M.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the leading M-by-N upper trapezoidal part of the
-*> array A must contain the matrix to be factorized.
-*> On exit, the leading M-by-M upper triangular part of A
-*> contains the upper triangular matrix R, and elements M+1 to
-*> N of the first M rows of A, with the array TAU, represent the
-*> orthogonal matrix Z as a product of M elementary reflectors.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is REAL array, dimension (M)
-*> The scalar factors of the elementary reflectors.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The N-by-N matrix Z can be computed by
-*>
-*> Z = Z(1)*Z(2)* ... *Z(M)
-*>
-*> where each N-by-N Z(k) is given by
-*>
-*> Z(k) = I - tau(k)*v(k)*v(k)**T
-*>
-*> with v(k) is the kth row vector of the M-by-N matrix
-*>
-*> V = ( I A(:,M+1:N) )
-*>
-*> I is the M-by-M identity matrix, A(:,M+1:N)
-*> is the output stored in A on exit from DTZRZF,
-*> and tau(k) is the kth element of the array TAU.
-*>
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IWS, KI, KK, LDWORK, LWKMIN, LWKOPT,
- $ M1, MU, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, SLARZB, SLARZT, SLATRZ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( M.EQ.0 .OR. M.EQ.N ) THEN
- LWKOPT = 1
- LWKMIN = 1
- ELSE
-*
-* Determine the block size.
-*
- NB = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- LWKMIN = MAX( 1, M )
- END IF
- WORK( 1 ) = LWKOPT
-*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'STZRZF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 ) THEN
- RETURN
- ELSE IF( M.EQ.N ) THEN
- DO 10 I = 1, N
- TAU( I ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 1
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.M ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'SGERQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.M ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'SGERQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.M .AND. NX.LT.M ) THEN
-*
-* Use blocked code initially.
-* The last kk rows are handled by the block method.
-*
- M1 = MIN( M+1, N )
- KI = ( ( M-NX-1 ) / NB )*NB
- KK = MIN( M, KI+NB )
-*
- DO 20 I = M - KK + KI + 1, M - KK + 1, -NB
- IB = MIN( M-I+1, NB )
-*
-* Compute the TZ factorization of the current block
-* A(i:i+ib-1,i:n)
-*
- CALL SLATRZ( IB, N-I+1, N-M, A( I, I ), LDA, TAU( I ),
- $ WORK )
- IF( I.GT.1 ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i+ib-1) . . . H(i+1) H(i)
-*
- CALL SLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(1:i-1,i:n) from the right
-*
- CALL SLARZB( 'Right', 'No transpose', 'Backward',
- $ 'Rowwise', I-1, N-I+1, IB, N-M, A( I, M1 ),
- $ LDA, WORK, LDWORK, A( 1, I ), LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 20 CONTINUE
- MU = I + NB - 1
- ELSE
- MU = M
- END IF
-*
-* Use unblocked code to factor the last or only block
-*
- IF( MU.GT.0 )
- $ CALL SLATRZ( MU, N, N-M, A, LDA, TAU, WORK )
-*
- WORK( 1 ) = LWKOPT
-*
- RETURN
-*
-* End of STZRZF
-*
- END
diff --git a/netlib/LAPACK/xerbla_array.f b/netlib/LAPACK/xerbla_array.f
deleted file mode 100644
index a1307ca..0000000
--- a/netlib/LAPACK/xerbla_array.f
+++ /dev/null
@@ -1,129 +0,0 @@
-*> \brief \b XERBLA_ARRAY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download XERBLA_ARRAY + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/xerbla_array.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/xerbla_array.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/xerbla_array.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO)
-*
-* .. Scalar Arguments ..
-* INTEGER SRNAME_LEN, INFO
-* ..
-* .. Array Arguments ..
-* CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK
-*> and BLAS error handler. Rather than taking a Fortran string argument
-*> as the function's name, XERBLA_ARRAY takes an array of single
-*> characters along with the array's length. XERBLA_ARRAY then copies
-*> up to 32 characters of that array into a Fortran string and passes
-*> that to XERBLA. If called with a non-positive SRNAME_LEN,
-*> XERBLA_ARRAY will call XERBLA with a string of all blank characters.
-*>
-*> Say some macro or other device makes XERBLA_ARRAY available to C99
-*> by a name lapack_xerbla and with a common Fortran calling convention.
-*> Then a C99 program could invoke XERBLA via:
-*> {
-*> int flen = strlen(__func__);
-*> lapack_xerbla(__func__, &flen, &info);
-*> }
-*>
-*> Providing XERBLA_ARRAY is not necessary for intercepting LAPACK
-*> errors. XERBLA_ARRAY calls XERBLA.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SRNAME_ARRAY
-*> \verbatim
-*> SRNAME_ARRAY is CHARACTER(1) array, dimension (SRNAME_LEN)
-*> The name of the routine which called XERBLA_ARRAY.
-*> \endverbatim
-*>
-*> \param[in] SRNAME_LEN
-*> \verbatim
-*> SRNAME_LEN is INTEGER
-*> The length of the name in SRNAME_ARRAY.
-*> \endverbatim
-*>
-*> \param[in] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> The position of the invalid parameter in the parameter list
-*> of the calling routine.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO)
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER SRNAME_LEN, INFO
-* ..
-* .. Array Arguments ..
- CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
-* ..
-*
-* =====================================================================
-*
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Local Arrays ..
- CHARACTER*32 SRNAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN, LEN
-* ..
-* .. External Functions ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
- SRNAME = ''
- DO I = 1, MIN( SRNAME_LEN, LEN( SRNAME ) )
- SRNAME( I:I ) = SRNAME_ARRAY( I )
- END DO
-
- CALL XERBLA( SRNAME, INFO )
-
- RETURN
- END
diff --git a/netlib/LAPACKE/lapacke.h b/netlib/LAPACKE/lapacke.h
deleted file mode 100644
index e0367a2..0000000
--- a/netlib/LAPACKE/lapacke.h
+++ /dev/null
@@ -1,16305 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#ifndef _LAPACKE_H_
-#define _LAPACKE_H_
-
-/*
-* Turn on HAVE_LAPACK_CONFIG_H to redefine C-LAPACK datatypes
-*/
-#ifdef HAVE_LAPACK_CONFIG_H
-#include "lapacke_config.h"
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif /* __cplusplus */
-
-#include <stdlib.h>
-
-#ifndef lapack_int
-#define lapack_int int
-#endif
-
-#ifndef lapack_logical
-#define lapack_logical lapack_int
-#endif
-
-/* Complex types are structures equivalent to the
-* Fortran complex types COMPLEX(4) and COMPLEX(8).
-*
-* One can also redefine the types with his own types
-* for example by including in the code definitions like
-*
-* #define lapack_complex_float std::complex<float>
-* #define lapack_complex_double std::complex<double>
-*
-* or define these types in the command line:
-*
-* -Dlapack_complex_float="std::complex<float>"
-* -Dlapack_complex_double="std::complex<double>"
-*/
-
-#ifndef LAPACK_COMPLEX_CUSTOM
-
-/* Complex type (single precision) */
-#ifndef lapack_complex_float
-#include <complex.h>
-#define lapack_complex_float float _Complex
-#endif
-
-#ifndef lapack_complex_float_real
-#define lapack_complex_float_real(z) (creal(z))
-#endif
-
-#ifndef lapack_complex_float_imag
-#define lapack_complex_float_imag(z) (cimag(z))
-#endif
-
-lapack_complex_float lapack_make_complex_float( float re, float im );
-
-/* Complex type (double precision) */
-#ifndef lapack_complex_double
-#include <complex.h>
-#define lapack_complex_double double _Complex
-#endif
-
-#ifndef lapack_complex_double_real
-#define lapack_complex_double_real(z) (creal(z))
-#endif
-
-#ifndef lapack_complex_double_imag
-#define lapack_complex_double_imag(z) (cimag(z))
-#endif
-
-lapack_complex_double lapack_make_complex_double( double re, double im );
-
-#endif
-
-#ifndef LAPACKE_malloc
-#define LAPACKE_malloc( size ) malloc( size )
-#endif
-#ifndef LAPACKE_free
-#define LAPACKE_free( p ) free( p )
-#endif
-
-#define LAPACK_C2INT( x ) (lapack_int)(*((float*)&x ))
-#define LAPACK_Z2INT( x ) (lapack_int)(*((double*)&x ))
-
-#define LAPACK_ROW_MAJOR 101
-#define LAPACK_COL_MAJOR 102
-
-#define LAPACK_WORK_MEMORY_ERROR -1010
-#define LAPACK_TRANSPOSE_MEMORY_ERROR -1011
-
-/* Callback logical functions of one, two, or three arguments are used
-* to select eigenvalues to sort to the top left of the Schur form.
-* The value is selected if function returns TRUE (non-zero). */
-
-typedef lapack_logical (*LAPACK_S_SELECT2) ( const float*, const float* );
-typedef lapack_logical (*LAPACK_S_SELECT3)
- ( const float*, const float*, const float* );
-typedef lapack_logical (*LAPACK_D_SELECT2) ( const double*, const double* );
-typedef lapack_logical (*LAPACK_D_SELECT3)
- ( const double*, const double*, const double* );
-
-typedef lapack_logical (*LAPACK_C_SELECT1) ( const lapack_complex_float* );
-typedef lapack_logical (*LAPACK_C_SELECT2)
- ( const lapack_complex_float*, const lapack_complex_float* );
-typedef lapack_logical (*LAPACK_Z_SELECT1) ( const lapack_complex_double* );
-typedef lapack_logical (*LAPACK_Z_SELECT2)
- ( const lapack_complex_double*, const lapack_complex_double* );
-
-#include "lapacke_mangling.h"
-
-#define LAPACK_lsame LAPACK_GLOBAL(lsame,LSAME)
-lapack_logical LAPACK_lsame( char* ca, char* cb,
- lapack_int lca, lapack_int lcb );
-
-/* C-LAPACK function prototypes */
-
-lapack_int LAPACKE_sbdsdc( int matrix_order, char uplo, char compq,
- lapack_int n, float* d, float* e, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt, float* q,
- lapack_int* iq );
-lapack_int LAPACKE_dbdsdc( int matrix_order, char uplo, char compq,
- lapack_int n, double* d, double* e, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* q, lapack_int* iq );
-
-lapack_int LAPACKE_sbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, float* vt, lapack_int ldvt,
- float* u, lapack_int ldu, float* c, lapack_int ldc );
-lapack_int LAPACKE_dbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, double* vt, lapack_int ldvt,
- double* u, lapack_int ldu, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_cbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, lapack_complex_float* vt,
- lapack_int ldvt, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* c,
- lapack_int ldc );
-lapack_int LAPACKE_zbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, lapack_complex_double* vt,
- lapack_int ldvt, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_sdisna( char job, lapack_int m, lapack_int n, const float* d,
- float* sep );
-lapack_int LAPACKE_ddisna( char job, lapack_int m, lapack_int n,
- const double* d, double* sep );
-
-lapack_int LAPACKE_sgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, float* ab, lapack_int ldab, float* d,
- float* e, float* q, lapack_int ldq, float* pt,
- lapack_int ldpt, float* c, lapack_int ldc );
-lapack_int LAPACKE_dgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq,
- double* pt, lapack_int ldpt, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_cgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_float* ab,
- lapack_int ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* pt, lapack_int ldpt,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_double* ab,
- lapack_int ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* pt, lapack_int ldpt,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, const lapack_int* ipiv, float anorm,
- float* rcond );
-lapack_int LAPACKE_dgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond );
-lapack_int LAPACKE_cgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab, lapack_int ldab,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax );
-
-lapack_int LAPACKE_sgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab, lapack_int ldab,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab, const float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab, const double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb, lapack_int ldafb,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* afb, lapack_int ldafb,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const float* ab, lapack_int ldab,
- const float* afb, lapack_int ldafb,
- const lapack_int* ipiv, const float* r,
- const float* c, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const lapack_int* ipiv, const double* r,
- const double* c, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const lapack_complex_float* ab,
- lapack_int ldab, const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* r, const float* c,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const lapack_complex_double* ab,
- lapack_int ldab, const lapack_complex_double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* r, const double* c,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_sgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, float* ab,
- lapack_int ldab, lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, double* ab,
- lapack_int ldab, lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot );
-lapack_int LAPACKE_dgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot );
-lapack_int LAPACKE_cgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- float* r, float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* rpivot );
-lapack_int LAPACKE_zgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- double* r, double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* rpivot );
-
-lapack_int LAPACKE_sgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-lapack_int LAPACKE_cgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- float* r, float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- double* r, double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_sgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, float* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_dgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, double* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_cgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* scale,
- lapack_int m, float* v, lapack_int ldv );
-lapack_int LAPACKE_dgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* scale,
- lapack_int m, double* v, lapack_int ldv );
-lapack_int LAPACKE_cgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* scale,
- lapack_int m, lapack_complex_float* v,
- lapack_int ldv );
-lapack_int LAPACKE_zgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* scale,
- lapack_int m, lapack_complex_double* v,
- lapack_int ldv );
-
-lapack_int LAPACKE_sgebal( int matrix_order, char job, lapack_int n, float* a,
- lapack_int lda, lapack_int* ilo, lapack_int* ihi,
- float* scale );
-lapack_int LAPACKE_dgebal( int matrix_order, char job, lapack_int n, double* a,
- lapack_int lda, lapack_int* ilo, lapack_int* ihi,
- double* scale );
-lapack_int LAPACKE_cgebal( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi, float* scale );
-lapack_int LAPACKE_zgebal( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi, double* scale );
-
-lapack_int LAPACKE_sgebrd( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tauq, float* taup );
-lapack_int LAPACKE_dgebrd( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tauq, double* taup );
-lapack_int LAPACKE_cgebrd( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* d,
- float* e, lapack_complex_float* tauq,
- lapack_complex_float* taup );
-lapack_int LAPACKE_zgebrd( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda, double* d,
- double* e, lapack_complex_double* tauq,
- lapack_complex_double* taup );
-
-lapack_int LAPACKE_sgecon( int matrix_order, char norm, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond );
-lapack_int LAPACKE_dgecon( int matrix_order, char norm, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond );
-lapack_int LAPACKE_cgecon( int matrix_order, char norm, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond );
-lapack_int LAPACKE_zgecon( int matrix_order, char norm, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond );
-
-lapack_int LAPACKE_sgeequ( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgeequ( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequ( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgeequ( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax );
-
-lapack_int LAPACKE_sgeequb( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgeequb( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequb( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgeequb( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgees( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, lapack_int n, float* a,
- lapack_int lda, lapack_int* sdim, float* wr,
- float* wi, float* vs, lapack_int ldvs );
-lapack_int LAPACKE_dgees( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, lapack_int n, double* a,
- lapack_int lda, lapack_int* sdim, double* wr,
- double* wi, double* vs, lapack_int ldvs );
-lapack_int LAPACKE_cgees( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs );
-lapack_int LAPACKE_zgees( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs );
-
-lapack_int LAPACKE_sgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, char sense, lapack_int n,
- float* a, lapack_int lda, lapack_int* sdim,
- float* wr, float* wi, float* vs, lapack_int ldvs,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_dgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, char sense, lapack_int n,
- double* a, lapack_int lda, lapack_int* sdim,
- double* wr, double* wi, double* vs, lapack_int ldvs,
- double* rconde, double* rcondv );
-lapack_int LAPACKE_cgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_zgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs,
- double* rconde, double* rcondv );
-
-lapack_int LAPACKE_sgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* wr,
- float* wi, float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_dgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda, double* wr,
- double* wi, double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_cgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_zgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr );
-
-lapack_int LAPACKE_sgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* wr, float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv );
-lapack_int LAPACKE_dgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* wr, double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- double* abnrm, double* rconde, double* rcondv );
-lapack_int LAPACKE_cgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- float* scale, float* abnrm, float* rconde,
- float* rcondv );
-lapack_int LAPACKE_zgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int ldvl, lapack_complex_double* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- double* scale, double* abnrm, double* rconde,
- double* rcondv );
-
-lapack_int LAPACKE_sgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- float* tau );
-lapack_int LAPACKE_dgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- double* tau );
-lapack_int LAPACKE_cgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* tau );
-lapack_int LAPACKE_zgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgejsv( int matrix_order, char joba, char jobu, char jobv,
- char jobr, char jobt, char jobp, lapack_int m,
- lapack_int n, float* a, lapack_int lda, float* sva,
- float* u, lapack_int ldu, float* v, lapack_int ldv,
- float* stat, lapack_int* istat );
-lapack_int LAPACKE_dgejsv( int matrix_order, char joba, char jobu, char jobv,
- char jobr, char jobt, char jobp, lapack_int m,
- lapack_int n, double* a, lapack_int lda, double* sva,
- double* u, lapack_int ldu, double* v, lapack_int ldv,
- double* stat, lapack_int* istat );
-
-lapack_int LAPACKE_sgelq2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgelq2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgelq2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgelq2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgelqf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgelqf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgelqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgelqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_dgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-lapack_int LAPACKE_cgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_zgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-
-lapack_int LAPACKE_sgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_dgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-lapack_int LAPACKE_cgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_zgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-
-lapack_int LAPACKE_sgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_dgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* jpvt,
- double rcond, lapack_int* rank );
-lapack_int LAPACKE_cgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_zgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* jpvt, double rcond,
- lapack_int* rank );
-
-lapack_int LAPACKE_sgeqlf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqlf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqlf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqlf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqp3( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau );
-lapack_int LAPACKE_dgeqp3( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau );
-lapack_int LAPACKE_cgeqp3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqp3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqpf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau );
-lapack_int LAPACKE_dgeqpf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau );
-lapack_int LAPACKE_cgeqpf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqpf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqr2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqr2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqr2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqr2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqrf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqrf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_cgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* r,
- const float* c, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* r,
- const double* c, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* r,
- const float* c, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* r,
- const double* c, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_sgerqf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgerqf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgerqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgerqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, float* a, lapack_int lda, float* s,
- float* u, lapack_int ldu, float* vt,
- lapack_int ldvt );
-lapack_int LAPACKE_dgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, double* a, lapack_int lda, double* s,
- double* u, lapack_int ldu, double* vt,
- lapack_int ldvt );
-lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* s, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* vt,
- lapack_int ldvt );
-lapack_int LAPACKE_zgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* s, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* vt,
- lapack_int ldvt );
-
-lapack_int LAPACKE_sgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* a, lapack_int lda, lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- lapack_int* iter );
-lapack_int LAPACKE_zcgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_int* iter );
-
-lapack_int LAPACKE_sgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, float* a, lapack_int lda,
- float* s, float* u, lapack_int ldu, float* vt,
- lapack_int ldvt, float* superb );
-lapack_int LAPACKE_dgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt, double* superb );
-lapack_int LAPACKE_cgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* s, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* vt,
- lapack_int ldvt, float* superb );
-lapack_int LAPACKE_zgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* s, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* vt,
- lapack_int ldvt, double* superb );
-
-lapack_int LAPACKE_sgesvj( int matrix_order, char joba, char jobu, char jobv,
- lapack_int m, lapack_int n, float* a, lapack_int lda,
- float* sva, lapack_int mv, float* v, lapack_int ldv,
- float* stat );
-lapack_int LAPACKE_dgesvj( int matrix_order, char joba, char jobu, char jobv,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* sva, lapack_int mv,
- double* v, lapack_int ldv, double* stat );
-
-lapack_int LAPACKE_sgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot );
-lapack_int LAPACKE_dgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot );
-lapack_int LAPACKE_cgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot );
-lapack_int LAPACKE_zgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot );
-
-lapack_int LAPACKE_sgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_sgetf2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetf2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetf2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetf2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetrf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetrf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetri( int matrix_order, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dgetri( int matrix_order, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_cgetri( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zgetri( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* lscale,
- const float* rscale, lapack_int m, float* v,
- lapack_int ldv );
-lapack_int LAPACKE_dggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* lscale,
- const double* rscale, lapack_int m, double* v,
- lapack_int ldv );
-lapack_int LAPACKE_cggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* lscale,
- const float* rscale, lapack_int m,
- lapack_complex_float* v, lapack_int ldv );
-lapack_int LAPACKE_zggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* lscale,
- const double* rscale, lapack_int m,
- lapack_complex_double* v, lapack_int ldv );
-
-lapack_int LAPACKE_sggbal( int matrix_order, char job, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale );
-lapack_int LAPACKE_dggbal( int matrix_order, char job, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale );
-lapack_int LAPACKE_cggbal( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale );
-lapack_int LAPACKE_zggbal( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale );
-
-lapack_int LAPACKE_sgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_S_SELECT3 selctg, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- lapack_int* sdim, float* alphar, float* alphai,
- float* beta, float* vsl, lapack_int ldvsl, float* vsr,
- lapack_int ldvsr );
-lapack_int LAPACKE_dgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_D_SELECT3 selctg, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int ldvsl,
- double* vsr, lapack_int ldvsr );
-lapack_int LAPACKE_cgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_C_SELECT2 selctg, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* vsl,
- lapack_int ldvsl, lapack_complex_float* vsr,
- lapack_int ldvsr );
-lapack_int LAPACKE_zgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_Z_SELECT2 selctg, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr );
-
-lapack_int LAPACKE_sggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, char sense,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* sdim, float* alphar,
- float* alphai, float* beta, float* vsl,
- lapack_int ldvsl, float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_dggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, char sense,
- lapack_int n, double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* sdim, double* alphar,
- double* alphai, double* beta, double* vsl,
- lapack_int ldvsl, double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv );
-lapack_int LAPACKE_cggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_C_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int ldvsl,
- lapack_complex_float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_zggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_Z_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv );
-
-lapack_int LAPACKE_sggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_dggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alphar, double* alphai,
- double* beta, double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_cggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_zggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr );
-
-lapack_int LAPACKE_sggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_dggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv );
-lapack_int LAPACKE_cggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- float* lscale, float* rscale, float* abnrm,
- float* bbnrm, float* rconde, float* rcondv );
-lapack_int LAPACKE_zggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale, double* abnrm, double* bbnrm,
- double* rconde, double* rcondv );
-
-lapack_int LAPACKE_sggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* d, float* x, float* y );
-lapack_int LAPACKE_dggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* d, double* x, double* y );
-lapack_int LAPACKE_cggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* d,
- lapack_complex_float* x, lapack_complex_float* y );
-lapack_int LAPACKE_zggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* d,
- lapack_complex_double* x, lapack_complex_double* y );
-
-lapack_int LAPACKE_sgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* a, lapack_int lda, float* b, lapack_int ldb,
- float* q, lapack_int ldq, float* z, lapack_int ldz );
-lapack_int LAPACKE_dgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* a, lapack_int lda, double* b, lapack_int ldb,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz );
-lapack_int LAPACKE_cgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* c, float* d, float* x );
-lapack_int LAPACKE_dgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* c, double* d, double* x );
-lapack_int LAPACKE_cgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* c,
- lapack_complex_float* d, lapack_complex_float* x );
-lapack_int LAPACKE_zgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* c,
- lapack_complex_double* d, lapack_complex_double* x );
-
-lapack_int LAPACKE_sggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda, float* taua,
- float* b, lapack_int ldb, float* taub );
-lapack_int LAPACKE_dggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub );
-lapack_int LAPACKE_cggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub );
-lapack_int LAPACKE_zggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub );
-
-lapack_int LAPACKE_sggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda, float* taua,
- float* b, lapack_int ldb, float* taub );
-lapack_int LAPACKE_dggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub );
-lapack_int LAPACKE_cggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub );
-lapack_int LAPACKE_zggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub );
-
-lapack_int LAPACKE_sggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alpha, float* beta, float* u, lapack_int ldu,
- float* v, lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* iwork );
-lapack_int LAPACKE_dggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alpha, double* beta, double* u,
- lapack_int ldu, double* v, lapack_int ldv, double* q,
- lapack_int ldq, lapack_int* iwork );
-lapack_int LAPACKE_cggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float* alpha, float* beta, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* v,
- lapack_int ldv, lapack_complex_float* q,
- lapack_int ldq, lapack_int* iwork );
-lapack_int LAPACKE_zggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* alpha, double* beta,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l, float* u,
- lapack_int ldu, float* v, lapack_int ldv, float* q,
- lapack_int ldq );
-lapack_int LAPACKE_dggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double tola, double tolb, lapack_int* k,
- lapack_int* l, double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq );
-lapack_int LAPACKE_cggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq );
-lapack_int LAPACKE_zggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double tola, double tolb, lapack_int* k,
- lapack_int* l, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* v,
- lapack_int ldv, lapack_complex_double* q,
- lapack_int ldq );
-
-lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl,
- const float* d, const float* du, const float* du2,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl,
- const double* d, const double* du, const double* du2,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-lapack_int LAPACKE_cgtcon( char norm, lapack_int n,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zgtcon( char norm, lapack_int n,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl, const float* d,
- const float* du, const float* dlf, const float* df,
- const float* duf, const float* du2,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl, const double* d,
- const double* du, const double* dlf,
- const double* df, const double* duf,
- const double* du2, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* dlf,
- const lapack_complex_float* df,
- const lapack_complex_float* duf,
- const lapack_complex_float* du2,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* dlf,
- const lapack_complex_double* df,
- const lapack_complex_double* duf,
- const lapack_complex_double* du2,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* dl, float* d, float* du, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* dl, double* d, double* du, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* dl, lapack_complex_float* d,
- lapack_complex_float* du, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* dl, lapack_complex_double* d,
- lapack_complex_double* du, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const float* dl,
- const float* d, const float* du, float* dlf,
- float* df, float* duf, float* du2, lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const double* dl,
- const double* d, const double* du, double* dlf,
- double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- lapack_complex_float* dlf, lapack_complex_float* df,
- lapack_complex_float* duf, lapack_complex_float* du2,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- lapack_complex_double* dlf,
- lapack_complex_double* df,
- lapack_complex_double* duf,
- lapack_complex_double* du2, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_sgttrf( lapack_int n, float* dl, float* d, float* du,
- float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_dgttrf( lapack_int n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv );
-lapack_int LAPACKE_cgttrf( lapack_int n, lapack_complex_float* dl,
- lapack_complex_float* d, lapack_complex_float* du,
- lapack_complex_float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_zgttrf( lapack_int n, lapack_complex_double* dl,
- lapack_complex_double* d, lapack_complex_double* du,
- lapack_complex_double* du2, lapack_int* ipiv );
-
-lapack_int LAPACKE_sgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl, const float* d,
- const float* du, const float* du2,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl, const double* d,
- const double* du, const double* du2,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab, float* w, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab, double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_chbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab, float* w, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab, double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_chbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* q, lapack_int ldq, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* bb, lapack_int ldbb,
- lapack_complex_float* x, lapack_int ldx );
-lapack_int LAPACKE_zhbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* bb, lapack_int ldbb,
- lapack_complex_double* x, lapack_int ldx );
-
-lapack_int LAPACKE_chbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_chbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb,
- lapack_complex_float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- lapack_complex_double* q, lapack_int ldq, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int ldq );
-lapack_int LAPACKE_zhbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int ldq );
-
-lapack_int LAPACKE_checon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zhecon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_cheequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zheequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_cheev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_zheev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda, double* w );
-
-lapack_int LAPACKE_cheevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_zheevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* w );
-
-lapack_int LAPACKE_cheevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_zheevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z, lapack_int ldz,
- lapack_int* isuppz );
-
-lapack_int LAPACKE_cheevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_zheevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chegst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhegst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chegv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* w );
-lapack_int LAPACKE_zhegv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* w );
-
-lapack_int LAPACKE_chegvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* w );
-lapack_int LAPACKE_zhegvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* w );
-
-lapack_int LAPACKE_chegvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhegvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_cherfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zherfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_cherfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zherfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_chesv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zhesv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chesvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zhesvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_chesvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zhesvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_chetrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* d,
- float* e, lapack_complex_float* tau );
-lapack_int LAPACKE_zhetrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda, double* d,
- double* e, lapack_complex_double* tau );
-
-lapack_int LAPACKE_chetrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zhetrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_chetri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zhetri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-
-lapack_int LAPACKE_chetrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zhetrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, float alpha,
- const lapack_complex_float* a, lapack_int lda,
- float beta, lapack_complex_float* c );
-lapack_int LAPACKE_zhfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, double alpha,
- const lapack_complex_double* a, lapack_int lda,
- double beta, lapack_complex_double* c );
-
-lapack_int LAPACKE_shgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* h, lapack_int ldh, float* t, lapack_int ldt,
- float* alphar, float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz );
-lapack_int LAPACKE_dhgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* h, lapack_int ldh, double* t, lapack_int ldt,
- double* alphar, double* alphai, double* beta,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz );
-lapack_int LAPACKE_chgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zhpcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_chpev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* ap, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* ap, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_float* ap, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhpevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_double* ap, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chpgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* ap,
- const lapack_complex_float* bp );
-lapack_int LAPACKE_zhpgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* ap,
- const lapack_complex_double* bp );
-
-lapack_int LAPACKE_chpgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_complex_float* bp,
- float vl, float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_zhpgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_complex_double* bp,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zhprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_chpsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhpsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chpsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zhpsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_chptrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, float* d, float* e,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zhptrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, double* d, double* e,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_chptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zhptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_chptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, const lapack_int* ipiv );
-lapack_int LAPACKE_zhptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, const lapack_int* ipiv );
-
-lapack_int LAPACKE_chptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_shsein( int matrix_order, char job, char eigsrc, char initv,
- lapack_logical* select, lapack_int n, const float* h,
- lapack_int ldh, float* wr, const float* wi,
- float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_dhsein( int matrix_order, char job, char eigsrc, char initv,
- lapack_logical* select, lapack_int n,
- const double* h, lapack_int ldh, double* wr,
- const double* wi, double* vl, lapack_int ldvl,
- double* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m, lapack_int* ifaill,
- lapack_int* ifailr );
-lapack_int LAPACKE_chsein( int matrix_order, char job, char eigsrc, char initv,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_zhsein( int matrix_order, char job, char eigsrc, char initv,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int ldvl, lapack_complex_double* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr );
-
-lapack_int LAPACKE_shseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi, float* h,
- lapack_int ldh, float* wr, float* wi, float* z,
- lapack_int ldz );
-lapack_int LAPACKE_dhseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi, double* h,
- lapack_int ldh, double* wr, double* wi, double* z,
- lapack_int ldz );
-lapack_int LAPACKE_chseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi,
- lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* w, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi,
- lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_clacgv( lapack_int n, lapack_complex_float* x,
- lapack_int incx );
-lapack_int LAPACKE_zlacgv( lapack_int n, lapack_complex_double* x,
- lapack_int incx );
-
-lapack_int LAPACKE_slacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dlacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_clacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zlacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_zlag2c( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_float* sa, lapack_int ldsa );
-
-lapack_int LAPACKE_slag2d( int matrix_order, lapack_int m, lapack_int n,
- const float* sa, lapack_int ldsa, double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_dlag2s( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, float* sa,
- lapack_int ldsa );
-
-lapack_int LAPACKE_clag2z( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* sa, lapack_int ldsa,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- float* a, lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_dlagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- double* a, lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_clagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* iseed );
-lapack_int LAPACKE_zlagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* iseed );
-
-float LAPACKE_slamch( char cmach );
-double LAPACKE_dlamch( char cmach );
-
-float LAPACKE_slange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const float* a, lapack_int lda );
-double LAPACKE_dlange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const double* a, lapack_int lda );
-float LAPACKE_clange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda );
-double LAPACKE_zlange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda );
-
-float LAPACKE_clanhe( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda );
-double LAPACKE_zlanhe( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda );
-
-float LAPACKE_slansy( int matrix_order, char norm, char uplo, lapack_int n,
- const float* a, lapack_int lda );
-double LAPACKE_dlansy( int matrix_order, char norm, char uplo, lapack_int n,
- const double* a, lapack_int lda );
-float LAPACKE_clansy( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda );
-double LAPACKE_zlansy( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda );
-
-float LAPACKE_slantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda );
-double LAPACKE_dlantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda );
-float LAPACKE_clantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const lapack_complex_float* a,
- lapack_int lda );
-double LAPACKE_zlantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const lapack_complex_double* a,
- lapack_int lda );
-
-
-lapack_int LAPACKE_slarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc );
-lapack_int LAPACKE_dlarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_clarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_float* v,
- lapack_int ldv, const lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* c,
- lapack_int ldc );
-lapack_int LAPACKE_zlarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_double* v,
- lapack_int ldv, const lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_slarfg( lapack_int n, float* alpha, float* x,
- lapack_int incx, float* tau );
-lapack_int LAPACKE_dlarfg( lapack_int n, double* alpha, double* x,
- lapack_int incx, double* tau );
-lapack_int LAPACKE_clarfg( lapack_int n, lapack_complex_float* alpha,
- lapack_complex_float* x, lapack_int incx,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zlarfg( lapack_int n, lapack_complex_double* alpha,
- lapack_complex_double* x, lapack_int incx,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_slarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* tau, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dlarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* tau, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_clarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* tau,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zlarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* tau,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_slarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const float* v, float tau, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dlarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const double* v, double tau, double* c,
- lapack_int ldc, double* work );
-lapack_int LAPACKE_clarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_float* v,
- lapack_complex_float tau, lapack_complex_float* c,
- lapack_int ldc, lapack_complex_float* work );
-lapack_int LAPACKE_zlarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_double* v,
- lapack_complex_double tau, lapack_complex_double* c,
- lapack_int ldc, lapack_complex_double* work );
-
-lapack_int LAPACKE_slarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- float* x );
-lapack_int LAPACKE_dlarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- double* x );
-lapack_int LAPACKE_clarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- lapack_complex_float* x );
-lapack_int LAPACKE_zlarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- lapack_complex_double* x );
-
-lapack_int LAPACKE_slaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, float alpha, float beta, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, double alpha, double beta, double* a,
- lapack_int lda );
-lapack_int LAPACKE_claset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_float alpha,
- lapack_complex_float beta, lapack_complex_float* a,
- lapack_int lda );
-lapack_int LAPACKE_zlaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_double alpha,
- lapack_complex_double beta, lapack_complex_double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_slasrt( char id, lapack_int n, float* d );
-lapack_int LAPACKE_dlasrt( char id, lapack_int n, double* d );
-
-lapack_int LAPACKE_slaswp( int matrix_order, lapack_int n, float* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_dlaswp( int matrix_order, lapack_int n, double* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_claswp( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int k1, lapack_int k2, const lapack_int* ipiv,
- lapack_int incx );
-lapack_int LAPACKE_zlaswp( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int k1, lapack_int k2, const lapack_int* ipiv,
- lapack_int incx );
-
-lapack_int LAPACKE_slatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, float* d,
- lapack_int mode, float cond, float dmax,
- lapack_int kl, lapack_int ku, char pack, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, double* d,
- lapack_int mode, double cond, double dmax,
- lapack_int kl, lapack_int ku, char pack, double* a,
- lapack_int lda );
-lapack_int LAPACKE_clatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, float* d,
- lapack_int mode, float cond, float dmax,
- lapack_int kl, lapack_int ku, char pack,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, double* d,
- lapack_int mode, double cond, double dmax,
- lapack_int kl, lapack_int ku, char pack,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slauum( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlauum( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda );
-lapack_int LAPACKE_clauum( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlauum( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_sopgtr( int matrix_order, char uplo, lapack_int n,
- const float* ap, const float* tau, float* q,
- lapack_int ldq );
-lapack_int LAPACKE_dopgtr( int matrix_order, char uplo, lapack_int n,
- const double* ap, const double* tau, double* q,
- lapack_int ldq );
-
-lapack_int LAPACKE_sopmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const float* ap,
- const float* tau, float* c, lapack_int ldc );
-lapack_int LAPACKE_dopmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const double* ap,
- const double* tau, double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sorgbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, double* a,
- lapack_int lda, const double* tau );
-
-lapack_int LAPACKE_sorghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgtr( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const float* tau );
-lapack_int LAPACKE_dorgtr( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, const double* tau );
-
-lapack_int LAPACKE_sormbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc );
-lapack_int LAPACKE_dormhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc );
-lapack_int LAPACKE_dormrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* tau, float* c,
- lapack_int ldc );
-lapack_int LAPACKE_dormtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* tau, double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_spbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float anorm, float* rcond );
-lapack_int LAPACKE_dpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab, lapack_int ldab,
- double anorm, double* rcond );
-lapack_int LAPACKE_cpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float anorm, float* rcond );
-lapack_int LAPACKE_zpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double anorm, double* rcond );
-
-lapack_int LAPACKE_spbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_dpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab, lapack_int ldab,
- double* s, double* scond, double* amax );
-lapack_int LAPACKE_cpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_zpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax );
-
-lapack_int LAPACKE_spbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb, lapack_int ldafb,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* afb, lapack_int ldafb,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb, lapack_int ldafb,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* afb, lapack_int ldafb,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_spbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, float* bb, lapack_int ldbb );
-lapack_int LAPACKE_dpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, double* bb, lapack_int ldbb );
-lapack_int LAPACKE_cpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_float* bb,
- lapack_int ldbb );
-lapack_int LAPACKE_zpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_double* bb,
- lapack_int ldbb );
-
-lapack_int LAPACKE_spbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* afb, lapack_int ldafb,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* afb, lapack_int ldafb,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* afb, lapack_int ldafb,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_zpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* afb, lapack_int ldafb,
- char* equed, double* s, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr );
-
-lapack_int LAPACKE_spbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab );
-lapack_int LAPACKE_dpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab );
-lapack_int LAPACKE_cpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab );
-lapack_int LAPACKE_zpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab );
-
-lapack_int LAPACKE_spbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spftrf( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftri( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftri( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftri( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftri( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spocon( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond );
-lapack_int LAPACKE_dpocon( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond );
-lapack_int LAPACKE_cpocon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond );
-lapack_int LAPACKE_zpocon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond );
-
-lapack_int LAPACKE_spoequ( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequ( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpoequ( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequ( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_spoequb( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequb( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpoequb( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequb( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_sporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_cporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_zporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* ferr, double* berr );
-
-lapack_int LAPACKE_sporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af, lapack_int ldaf,
- const float* s, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af, lapack_int ldaf,
- const double* s, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const float* s, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const double* s, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_sposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- lapack_int* iter );
-lapack_int LAPACKE_zcposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_int* iter );
-
-lapack_int LAPACKE_sposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* af,
- lapack_int ldaf, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_dposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* af, lapack_int ldaf, char* equed, double* s,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-lapack_int LAPACKE_cposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* af,
- lapack_int ldaf, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* af,
- lapack_int ldaf, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_sposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_dposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- char* equed, double* s, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_spotrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dpotrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda );
-lapack_int LAPACKE_cpotrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotri( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dpotri( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda );
-lapack_int LAPACKE_cpotri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sppcon( int matrix_order, char uplo, lapack_int n,
- const float* ap, float anorm, float* rcond );
-lapack_int LAPACKE_dppcon( int matrix_order, char uplo, lapack_int n,
- const double* ap, double anorm, double* rcond );
-lapack_int LAPACKE_cppcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float anorm,
- float* rcond );
-lapack_int LAPACKE_zppcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sppequ( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dppequ( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cppequ( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float* s,
- float* scond, float* amax );
-lapack_int LAPACKE_zppequ( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double* s,
- double* scond, double* amax );
-
-lapack_int LAPACKE_spprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, const float* afp,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, const double* afp,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* afp, char* equed,
- float* s, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* afp,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_complex_float* afp, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_complex_double* afp, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_spptrf( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptrf( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptri( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptri( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spstrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, lapack_int* piv, lapack_int* rank,
- float tol );
-lapack_int LAPACKE_dpstrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, lapack_int* piv, lapack_int* rank,
- double tol );
-lapack_int LAPACKE_cpstrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, float tol );
-lapack_int LAPACKE_zpstrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, double tol );
-
-lapack_int LAPACKE_sptcon( lapack_int n, const float* d, const float* e,
- float anorm, float* rcond );
-lapack_int LAPACKE_dptcon( lapack_int n, const double* d, const double* e,
- double anorm, double* rcond );
-lapack_int LAPACKE_cptcon( lapack_int n, const float* d,
- const lapack_complex_float* e, float anorm,
- float* rcond );
-lapack_int LAPACKE_zptcon( lapack_int n, const double* d,
- const lapack_complex_double* e, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_spteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dpteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz );
-lapack_int LAPACKE_cpteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zpteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_sptrfs( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, const float* df,
- const float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dptrfs( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, const double* df,
- const double* ef, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* ferr,
- double* berr );
-lapack_int LAPACKE_cptrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, const float* df,
- const lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zptrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e, const double* df,
- const lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, float* e, float* b, lapack_int ldb );
-lapack_int LAPACKE_dptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, double* e, double* b, lapack_int ldb );
-lapack_int LAPACKE_cptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d, const float* e,
- float* df, float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d, const double* e,
- double* df, double* ef, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-lapack_int LAPACKE_cptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, float* df,
- lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e, double* df,
- lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_spttrf( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dpttrf( lapack_int n, double* d, double* e );
-lapack_int LAPACKE_cpttrf( lapack_int n, float* d, lapack_complex_float* e );
-lapack_int LAPACKE_zpttrf( lapack_int n, double* d, lapack_complex_double* e );
-
-lapack_int LAPACKE_spttrs( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpttrs( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpttrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpttrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* w,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab, double* w,
- double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* w,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* q, lapack_int ldq,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, const float* bb, lapack_int ldbb,
- float* x, lapack_int ldx );
-lapack_int LAPACKE_dsbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, const double* bb, lapack_int ldbb,
- double* x, lapack_int ldx );
-
-lapack_int LAPACKE_ssbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, float* bb, lapack_int ldbb, float* w,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, double* bb, lapack_int ldbb,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, float* bb, lapack_int ldbb,
- float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, double* bb, lapack_int ldbb,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* q, lapack_int ldq,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* d,
- float* e, float* q, lapack_int ldq );
-lapack_int LAPACKE_dsbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq );
-
-lapack_int LAPACKE_ssfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, float alpha,
- const float* a, lapack_int lda, float beta,
- float* c );
-lapack_int LAPACKE_dsfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, double alpha,
- const double* a, lapack_int lda, double beta,
- double* c );
-
-lapack_int LAPACKE_sspcon( int matrix_order, char uplo, lapack_int n,
- const float* ap, const lapack_int* ipiv, float anorm,
- float* rcond );
-lapack_int LAPACKE_dspcon( int matrix_order, char uplo, lapack_int n,
- const double* ap, const lapack_int* ipiv,
- double anorm, double* rcond );
-lapack_int LAPACKE_cspcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zspcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sspev( int matrix_order, char jobz, char uplo, lapack_int n,
- float* ap, float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspev( int matrix_order, char jobz, char uplo, lapack_int n,
- double* ap, double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspevd( int matrix_order, char jobz, char uplo, lapack_int n,
- float* ap, float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspevd( int matrix_order, char jobz, char uplo, lapack_int n,
- double* ap, double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* ap, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dspevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* ap, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_sspgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* ap, const float* bp );
-lapack_int LAPACKE_dspgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* ap, const double* bp );
-
-lapack_int LAPACKE_sspgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* ap,
- float* bp, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- float* z, lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_dspgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* ap,
- double* bp, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, const float* afp,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dsprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, const double* afp,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_csprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zsprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* afp,
- lapack_int* ipiv, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* afp,
- lapack_int* ipiv, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_ssptrd( int matrix_order, char uplo, lapack_int n, float* ap,
- float* d, float* e, float* tau );
-lapack_int LAPACKE_dsptrd( int matrix_order, char uplo, lapack_int n,
- double* ap, double* d, double* e, double* tau );
-
-lapack_int LAPACKE_ssptrf( int matrix_order, char uplo, lapack_int n, float* ap,
- lapack_int* ipiv );
-lapack_int LAPACKE_dsptrf( int matrix_order, char uplo, lapack_int n,
- double* ap, lapack_int* ipiv );
-lapack_int LAPACKE_csptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zsptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_ssptri( int matrix_order, char uplo, lapack_int n, float* ap,
- const lapack_int* ipiv );
-lapack_int LAPACKE_dsptri( int matrix_order, char uplo, lapack_int n,
- double* ap, const lapack_int* ipiv );
-lapack_int LAPACKE_csptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, const lapack_int* ipiv );
-lapack_int LAPACKE_zsptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, const lapack_int* ipiv );
-
-lapack_int LAPACKE_ssptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dsptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_csptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zsptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- const float* d, const float* e, lapack_int* m,
- lapack_int* nsplit, float* w, lapack_int* iblock,
- lapack_int* isplit );
-lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, const double* d, const double* e,
- lapack_int* m, lapack_int* nsplit, double* w,
- lapack_int* iblock, lapack_int* isplit );
-
-lapack_int LAPACKE_sstedc( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dstedc( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz );
-lapack_int LAPACKE_cstedc( int matrix_order, char compz, lapack_int n, float* d,
- float* e, lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zstedc( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_sstegr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_dstegr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz );
-lapack_int LAPACKE_cstegr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* isuppz );
-lapack_int LAPACKE_zstegr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* isuppz );
-
-lapack_int LAPACKE_sstein( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock, const lapack_int* isplit,
- float* z, lapack_int ldz, lapack_int* ifailv );
-lapack_int LAPACKE_dstein( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock, const lapack_int* isplit,
- double* z, lapack_int ldz, lapack_int* ifailv );
-lapack_int LAPACKE_cstein( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock, const lapack_int* isplit,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* ifailv );
-lapack_int LAPACKE_zstein( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock, const lapack_int* isplit,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifailv );
-
-lapack_int LAPACKE_sstemr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* m,
- float* w, float* z, lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac );
-lapack_int LAPACKE_dstemr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, double* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac );
-lapack_int LAPACKE_cstemr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* m,
- float* w, lapack_complex_float* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac );
-lapack_int LAPACKE_zstemr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac );
-
-lapack_int LAPACKE_ssteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dsteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz );
-lapack_int LAPACKE_csteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zsteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_ssterf( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dsterf( lapack_int n, double* d, double* e );
-
-lapack_int LAPACKE_sstev( int matrix_order, char jobz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dstev( int matrix_order, char jobz, lapack_int n, double* d,
- double* e, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sstevd( int matrix_order, char jobz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dstevd( int matrix_order, char jobz, lapack_int n, double* d,
- double* e, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sstevr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_dstevr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz );
-
-lapack_int LAPACKE_sstevx( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dstevx( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssycon( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_dsycon( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-lapack_int LAPACKE_csycon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zsycon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_ssyequb( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* s,
- float* scond, float* amax );
-lapack_int LAPACKE_dsyequb( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax );
-lapack_int LAPACKE_csyequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zsyequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_ssyev( int matrix_order, char jobz, char uplo, lapack_int n,
- float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_dsyev( int matrix_order, char jobz, char uplo, lapack_int n,
- double* a, lapack_int lda, double* w );
-
-lapack_int LAPACKE_ssyevd( int matrix_order, char jobz, char uplo, lapack_int n,
- float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_dsyevd( int matrix_order, char jobz, char uplo, lapack_int n,
- double* a, lapack_int lda, double* w );
-
-lapack_int LAPACKE_ssyevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* a, lapack_int lda, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_dsyevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* a, lapack_int lda, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz );
-
-lapack_int LAPACKE_ssyevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* a, lapack_int lda, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsyevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* a, lapack_int lda, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssygst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* a, lapack_int lda,
- const float* b, lapack_int ldb );
-lapack_int LAPACKE_dsygst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* a, lapack_int lda,
- const double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssygv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* w );
-lapack_int LAPACKE_dsygv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* w );
-
-lapack_int LAPACKE_ssygvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* w );
-lapack_int LAPACKE_dsygvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* w );
-
-lapack_int LAPACKE_ssygvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsygvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dsyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_csyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zsyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_ssyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* s,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dsyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* s,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-lapack_int LAPACKE_csyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zsyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_ssysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dsysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_csysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zsysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* af, lapack_int ldaf, lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dsysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- double* af, lapack_int ldaf, lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr );
-lapack_int LAPACKE_csysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zsysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_ssysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dsysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-lapack_int LAPACKE_csysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zsysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_ssytrd( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, float* d, float* e, float* tau );
-lapack_int LAPACKE_dsytrd( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, double* d, double* e, double* tau );
-
-lapack_int LAPACKE_ssytrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dsytrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_csytrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zsytrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_ssytri( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dsytri( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_csytri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zsytri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-
-lapack_int LAPACKE_ssytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dsytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_csytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zsytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd, const float* ab,
- lapack_int ldab, float* rcond );
-lapack_int LAPACKE_dtbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd, const double* ab,
- lapack_int ldab, double* rcond );
-lapack_int LAPACKE_ctbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_float* ab, lapack_int ldab,
- float* rcond );
-lapack_int LAPACKE_ztbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_double* ab, lapack_int ldab,
- double* rcond );
-
-lapack_int LAPACKE_stbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const float* ab, lapack_int ldab, const float* b,
- lapack_int ldb, const float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dtbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_ctbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_ztbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_stbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const float* ab, lapack_int ldab, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- float alpha, const float* a, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- double alpha, const double* a, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- lapack_complex_float alpha,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- lapack_complex_double alpha,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, float* a );
-lapack_int LAPACKE_dtftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, double* a );
-lapack_int LAPACKE_ctftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_ztftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_stfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* ap );
-lapack_int LAPACKE_dtfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* ap );
-lapack_int LAPACKE_ctfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dtfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* a,
- lapack_int lda );
-lapack_int LAPACKE_ctfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_stgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* s, lapack_int lds, const float* p,
- lapack_int ldp, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_dtgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* s, lapack_int lds, const double* p,
- lapack_int ldp, double* vl, lapack_int ldvl,
- double* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_ctgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* s, lapack_int lds,
- const lapack_complex_float* p, lapack_int ldp,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* s, lapack_int lds,
- const lapack_complex_double* p, lapack_int ldp,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-
-lapack_int LAPACKE_stgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_dtgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb, double* q,
- lapack_int ldq, double* z, lapack_int ldz,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_ctgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_stgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- lapack_int* m, float* pl, float* pr, float* dif );
-lapack_int LAPACKE_dtgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- double* a, lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* q, lapack_int ldq, double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr, double* dif );
-lapack_int LAPACKE_ctgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* z,
- lapack_int ldz, lapack_int* m, float* pl, float* pr,
- float* dif );
-lapack_int LAPACKE_ztgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr, double* dif );
-
-lapack_int LAPACKE_stgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, float* a, lapack_int lda,
- float* b, lapack_int ldb, float tola, float tolb,
- float* alpha, float* beta, float* u, lapack_int ldu,
- float* v, lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* ncycle );
-lapack_int LAPACKE_dtgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double tola, double tolb, double* alpha,
- double* beta, double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- lapack_int* ncycle );
-lapack_int LAPACKE_ctgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float tola, float tolb, float* alpha,
- float* beta, lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int* ncycle );
-lapack_int LAPACKE_ztgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double tola, double tolb,
- double* alpha, double* beta,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int* ncycle );
-
-lapack_int LAPACKE_stgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* vl, lapack_int ldvl,
- const float* vr, lapack_int ldvr, float* s,
- float* dif, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_dtgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* a, lapack_int lda, const double* b,
- lapack_int ldb, const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* dif, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ctgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* dif, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* vl, lapack_int ldvl,
- const lapack_complex_double* vr, lapack_int ldvr,
- double* s, double* dif, lapack_int mm,
- lapack_int* m );
-
-lapack_int LAPACKE_stgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- float* c, lapack_int ldc, const float* d,
- lapack_int ldd, const float* e, lapack_int lde,
- float* f, lapack_int ldf, float* scale, float* dif );
-lapack_int LAPACKE_dtgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- double* c, lapack_int ldc, const double* d,
- lapack_int ldd, const double* e, lapack_int lde,
- double* f, lapack_int ldf, double* scale,
- double* dif );
-lapack_int LAPACKE_ctgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- const lapack_complex_float* d, lapack_int ldd,
- const lapack_complex_float* e, lapack_int lde,
- lapack_complex_float* f, lapack_int ldf,
- float* scale, float* dif );
-lapack_int LAPACKE_ztgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- const lapack_complex_double* d, lapack_int ldd,
- const lapack_complex_double* e, lapack_int lde,
- lapack_complex_double* f, lapack_int ldf,
- double* scale, double* dif );
-
-lapack_int LAPACKE_stpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const float* ap, float* rcond );
-lapack_int LAPACKE_dtpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const double* ap, double* rcond );
-lapack_int LAPACKE_ctpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_float* ap,
- float* rcond );
-lapack_int LAPACKE_ztpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_double* ap,
- double* rcond );
-
-lapack_int LAPACKE_stprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* ap,
- const float* b, lapack_int ldb, const float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dtprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* ap,
- const double* b, lapack_int ldb, const double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_ctprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_ztprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_stptri( int matrix_order, char uplo, char diag, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dtptri( int matrix_order, char uplo, char diag, lapack_int n,
- double* ap );
-lapack_int LAPACKE_ctptri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztptri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* ap,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dtptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* ap,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_ctptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const float* ap, float* arf );
-lapack_int LAPACKE_dtpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const double* ap, double* arf );
-lapack_int LAPACKE_ctpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* ap,
- lapack_complex_float* arf );
-lapack_int LAPACKE_ztpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* ap,
- lapack_complex_double* arf );
-
-lapack_int LAPACKE_stpttr( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* a, lapack_int lda );
-lapack_int LAPACKE_dtpttr( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* a, lapack_int lda );
-lapack_int LAPACKE_ctpttr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztpttr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_strcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const float* a, lapack_int lda,
- float* rcond );
-lapack_int LAPACKE_dtrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const double* a, lapack_int lda,
- double* rcond );
-lapack_int LAPACKE_ctrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* rcond );
-lapack_int LAPACKE_ztrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* rcond );
-
-lapack_int LAPACKE_strevc( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n, const float* t,
- lapack_int ldt, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_dtrevc( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ctrevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztrevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-
-lapack_int LAPACKE_strexc( int matrix_order, char compq, lapack_int n, float* t,
- lapack_int ldt, float* q, lapack_int ldq,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_dtrexc( int matrix_order, char compq, lapack_int n,
- double* t, lapack_int ldt, double* q, lapack_int ldq,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_ctrexc( int matrix_order, char compq, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztrexc( int matrix_order, char compq, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_strrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_dtrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- const double* x, lapack_int ldx, double* ferr,
- double* berr );
-lapack_int LAPACKE_ctrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_ztrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_strsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n, float* t,
- lapack_int ldt, float* q, lapack_int ldq, float* wr,
- float* wi, lapack_int* m, float* s, float* sep );
-lapack_int LAPACKE_dtrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- double* t, lapack_int ldt, double* q, lapack_int ldq,
- double* wr, double* wi, lapack_int* m, double* s,
- double* sep );
-lapack_int LAPACKE_ctrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* w, lapack_int* m, float* s,
- float* sep );
-lapack_int LAPACKE_ztrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* w, lapack_int* m, double* s,
- double* sep );
-
-lapack_int LAPACKE_strsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, const float* vl,
- lapack_int ldvl, const float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_dtrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, const double* vl,
- lapack_int ldvl, const double* vr, lapack_int ldvr,
- double* s, double* sep, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_ctrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* t, lapack_int ldt,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* t, lapack_int ldt,
- const lapack_complex_double* vl, lapack_int ldvl,
- const lapack_complex_double* vr, lapack_int ldvr,
- double* s, double* sep, lapack_int mm,
- lapack_int* m );
-
-lapack_int LAPACKE_strsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_dtrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, const double* b,
- lapack_int ldb, double* c, lapack_int ldc,
- double* scale );
-lapack_int LAPACKE_ctrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_ztrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- double* scale );
-
-lapack_int LAPACKE_strtri( int matrix_order, char uplo, char diag, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dtrtri( int matrix_order, char uplo, char diag, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_ctrtri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztrtri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_strtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_strttf( int matrix_order, char transr, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* arf );
-lapack_int LAPACKE_dtrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* arf );
-lapack_int LAPACKE_ctrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* arf );
-lapack_int LAPACKE_ztrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* arf );
-
-lapack_int LAPACKE_strttp( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* ap );
-lapack_int LAPACKE_dtrttp( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* ap );
-lapack_int LAPACKE_ctrttp( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztrttp( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stzrzf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dtzrzf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_ctzrzf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_ztzrzf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cunghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zunghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cunglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zunglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungtr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau );
-lapack_int LAPACKE_zungtr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cunmbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cupgtr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* q, lapack_int ldq );
-lapack_int LAPACKE_zupgtr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* q, lapack_int ldq );
-
-lapack_int LAPACKE_cupmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zupmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sbdsdc_work( int matrix_order, char uplo, char compq,
- lapack_int n, float* d, float* e, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt,
- float* q, lapack_int* iq, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dbdsdc_work( int matrix_order, char uplo, char compq,
- lapack_int n, double* d, double* e, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* q, lapack_int* iq, double* work,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, float* vt, lapack_int ldvt,
- float* u, lapack_int ldu, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, double* vt,
- lapack_int ldvt, double* u, lapack_int ldu,
- double* c, lapack_int ldc, double* work );
-lapack_int LAPACKE_cbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, lapack_complex_float* vt,
- lapack_int ldvt, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_zbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, lapack_complex_double* vt,
- lapack_int ldvt, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* c,
- lapack_int ldc, double* work );
-
-lapack_int LAPACKE_sdisna_work( char job, lapack_int m, lapack_int n,
- const float* d, float* sep );
-lapack_int LAPACKE_ddisna_work( char job, lapack_int m, lapack_int n,
- const double* d, double* sep );
-
-lapack_int LAPACKE_sgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, float* ab, lapack_int ldab,
- float* d, float* e, float* q, lapack_int ldq,
- float* pt, lapack_int ldpt, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq,
- double* pt, lapack_int ldpt, double* c,
- lapack_int ldc, double* work );
-lapack_int LAPACKE_cgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_float* ab,
- lapack_int ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* pt, lapack_int ldpt,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_double* ab,
- lapack_int ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* pt, lapack_int ldpt,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_zgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_zgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const float* afb, lapack_int ldafb,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab,
- const lapack_complex_double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* r, const float* c, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* r, const double* c,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs,
- const lapack_complex_float* ab,
- lapack_int ldab,
- const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* r, const float* c,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab,
- const lapack_complex_double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* r, const double* c,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, float* ab,
- lapack_int ldab, lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, double* ab,
- lapack_int ldab, lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- float* r, float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- double* r, double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, float* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_dgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, double* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_cgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* scale, lapack_int m, float* v,
- lapack_int ldv );
-lapack_int LAPACKE_dgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* scale, lapack_int m, double* v,
- lapack_int ldv );
-lapack_int LAPACKE_cgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* scale, lapack_int m,
- lapack_complex_float* v, lapack_int ldv );
-lapack_int LAPACKE_zgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* scale, lapack_int m,
- lapack_complex_double* v, lapack_int ldv );
-
-lapack_int LAPACKE_sgebal_work( int matrix_order, char job, lapack_int n,
- float* a, lapack_int lda, lapack_int* ilo,
- lapack_int* ihi, float* scale );
-lapack_int LAPACKE_dgebal_work( int matrix_order, char job, lapack_int n,
- double* a, lapack_int lda, lapack_int* ilo,
- lapack_int* ihi, double* scale );
-lapack_int LAPACKE_cgebal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi,
- float* scale );
-lapack_int LAPACKE_zgebal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi,
- double* scale );
-
-lapack_int LAPACKE_sgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tauq, float* taup, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tauq, double* taup, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_cgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float* d, float* e, lapack_complex_float* tauq,
- lapack_complex_float* taup,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* d, double* e,
- lapack_complex_double* tauq,
- lapack_complex_double* taup,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgecon_work( int matrix_order, char norm, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgecon_work( int matrix_order, char norm, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgecon_work( int matrix_order, char norm, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgecon_work( int matrix_order, char norm, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r,
- float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_dgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_zgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r,
- float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_dgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_zgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, lapack_int n, float* a,
- lapack_int lda, lapack_int* sdim, float* wr,
- float* wi, float* vs, lapack_int ldvs,
- float* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, lapack_int n, double* a,
- lapack_int lda, lapack_int* sdim, double* wr,
- double* wi, double* vs, lapack_int ldvs,
- double* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_logical* bwork );
-lapack_int LAPACKE_zgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, char sense,
- lapack_int n, float* a, lapack_int lda,
- lapack_int* sdim, float* wr, float* wi,
- float* vs, lapack_int ldvs, float* rconde,
- float* rcondv, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, char sense,
- lapack_int n, double* a, lapack_int lda,
- lapack_int* sdim, double* wr, double* wi,
- double* vs, lapack_int ldvs, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, char sense,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_int* sdim,
- lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs,
- float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_logical* bwork );
-lapack_int LAPACKE_zgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, char sense,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_int* sdim,
- lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs,
- double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda,
- float* wr, float* wi, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda,
- double* wr, double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* w,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* wr, float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* wr, double* wi,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, double* scale, double* abnrm,
- double* rconde, double* rcondv, double* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_cgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* w,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- double* abnrm, double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- float* tau, float* work, lapack_int lwork );
-lapack_int LAPACKE_dgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- double* tau, double* work, lapack_int lwork );
-lapack_int LAPACKE_cgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgejsv_work( int matrix_order, char joba, char jobu,
- char jobv, char jobr, char jobt, char jobp,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* sva, float* u,
- lapack_int ldu, float* v, lapack_int ldv,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgejsv_work( int matrix_order, char joba, char jobu,
- char jobv, char jobr, char jobt, char jobp,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* sva, double* u,
- lapack_int ldu, double* v, lapack_int ldv,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work );
-lapack_int LAPACKE_dgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work );
-lapack_int LAPACKE_cgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work );
-lapack_int LAPACKE_zgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_sgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* s, float rcond,
- lapack_int* rank, float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_cgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int* iwork );
-lapack_int LAPACKE_zgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* s, float rcond,
- lapack_int* rank, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_cgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_sgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, lapack_int* jpvt,
- float rcond, lapack_int* rank, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* jpvt,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_cgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* jpvt, double rcond,
- lapack_int* rank, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_sgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau, float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau, double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau, float* work );
-lapack_int LAPACKE_dgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau, double* work );
-lapack_int LAPACKE_cgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work );
-lapack_int LAPACKE_dgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work );
-lapack_int LAPACKE_cgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work );
-lapack_int LAPACKE_zgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_sgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* r, const float* c, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* r, const double* c,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* r, const float* c,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* r, const double* c,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, float* a, lapack_int lda,
- float* s, float* u, lapack_int ldu, float* vt,
- lapack_int ldvt, float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, double* a, lapack_int lda,
- double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt, double* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_cgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* s,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* vt, lapack_int ldvt,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork );
-lapack_int LAPACKE_zgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* s,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* vt, lapack_int ldvt,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork );
-
-lapack_int LAPACKE_sgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* a, lapack_int lda, lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* work, float* swork,
- lapack_int* iter );
-lapack_int LAPACKE_zcgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_complex_double* work,
- lapack_complex_float* swork, double* rwork,
- lapack_int* iter );
-
-lapack_int LAPACKE_sgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* s, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* s, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float* s, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* vt,
- lapack_int ldvt, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* s, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* vt,
- lapack_int ldvt, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_sgesvj_work( int matrix_order, char joba, char jobu,
- char jobv, lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* sva, lapack_int mv,
- float* v, lapack_int ldv, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgesvj_work( int matrix_order, char joba, char jobu,
- char jobv, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* sva,
- lapack_int mv, double* v, lapack_int ldv,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetri_work( int matrix_order, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgetri_work( int matrix_order, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgetri_work( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgetri_work( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* lscale, const float* rscale,
- lapack_int m, float* v, lapack_int ldv );
-lapack_int LAPACKE_dggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* lscale, const double* rscale,
- lapack_int m, double* v, lapack_int ldv );
-lapack_int LAPACKE_cggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* lscale, const float* rscale,
- lapack_int m, lapack_complex_float* v,
- lapack_int ldv );
-lapack_int LAPACKE_zggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* lscale, const double* rscale,
- lapack_int m, lapack_complex_double* v,
- lapack_int ldv );
-
-lapack_int LAPACKE_sggbal_work( int matrix_order, char job, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale,
- float* work );
-lapack_int LAPACKE_dggbal_work( int matrix_order, char job, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* work );
-lapack_int LAPACKE_cggbal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* work );
-lapack_int LAPACKE_zggbal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* work );
-
-lapack_int LAPACKE_sgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* sdim, float* alphar,
- float* alphai, float* beta, float* vsl,
- lapack_int ldvsl, float* vsr, lapack_int ldvsr,
- float* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* sdim, double* alphar,
- double* alphai, double* beta, double* vsl,
- lapack_int ldvsl, double* vsr, lapack_int ldvsr,
- double* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_C_SELECT2 selctg, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int ldvsl,
- lapack_complex_float* vsr, lapack_int ldvsr,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_logical* bwork );
-lapack_int LAPACKE_zgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_Z_SELECT2 selctg, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, char sense,
- lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, lapack_int* sdim,
- float* alphar, float* alphai, float* beta,
- float* vsl, lapack_int ldvsl, float* vsr,
- lapack_int ldvsr, float* rconde, float* rcondv,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, char sense,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* sdim,
- double* alphar, double* alphai, double* beta,
- double* vsl, lapack_int ldvsl, double* vsr,
- lapack_int ldvsr, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_C_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int ldvsl,
- lapack_complex_float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork,
- lapack_int liwork, lapack_logical* bwork );
-lapack_int LAPACKE_zggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_Z_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork,
- lapack_int liwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* alphar,
- double* alphai, double* beta, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta,
- float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale,
- float* abnrm, float* bbnrm, float* rconde,
- float* rcondv, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_logical* bwork );
-lapack_int LAPACKE_dggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* abnrm, double* bbnrm, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_logical* bwork );
-lapack_int LAPACKE_cggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm,
- float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_zggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork,
- lapack_logical* bwork );
-
-lapack_int LAPACKE_sggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* d, float* x,
- float* y, float* work, lapack_int lwork );
-lapack_int LAPACKE_dggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* d, double* x,
- double* y, double* work, lapack_int lwork );
-lapack_int LAPACKE_cggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* d,
- lapack_complex_float* x,
- lapack_complex_float* y,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* d,
- lapack_complex_double* x,
- lapack_complex_double* y,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* q, lapack_int ldq,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* q, lapack_int ldq,
- double* z, lapack_int ldz );
-lapack_int LAPACKE_cgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* c, float* d,
- float* x, float* work, lapack_int lwork );
-lapack_int LAPACKE_dgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* c, double* d,
- double* x, double* work, lapack_int lwork );
-lapack_int LAPACKE_cgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* c,
- lapack_complex_float* d,
- lapack_complex_float* x,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* c,
- lapack_complex_double* d,
- lapack_complex_double* x,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda,
- float* taua, float* b, lapack_int ldb,
- float* taub, float* work, lapack_int lwork );
-lapack_int LAPACKE_dggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub, double* work, lapack_int lwork );
-lapack_int LAPACKE_cggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda,
- float* taua, float* b, lapack_int ldb,
- float* taub, float* work, lapack_int lwork );
-lapack_int LAPACKE_dggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub, double* work, lapack_int lwork );
-lapack_int LAPACKE_cggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alpha, float* beta,
- float* u, lapack_int ldu, float* v,
- lapack_int ldv, float* q, lapack_int ldq,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alpha, double* beta,
- double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float* alpha, float* beta,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork );
-lapack_int LAPACKE_zggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* alpha, double* beta,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l,
- float* u, lapack_int ldu, float* v,
- lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* iwork, float* tau, float* work );
-lapack_int LAPACKE_dggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double tola,
- double tolb, lapack_int* k, lapack_int* l,
- double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- lapack_int* iwork, double* tau, double* work );
-lapack_int LAPACKE_cggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float tola, float tolb,
- lapack_int* k, lapack_int* l,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int* iwork, float* rwork,
- lapack_complex_float* tau,
- lapack_complex_float* work );
-lapack_int LAPACKE_zggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double tola, double tolb,
- lapack_int* k, lapack_int* l,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int* iwork, double* rwork,
- lapack_complex_double* tau,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_sgtcon_work( char norm, lapack_int n, const float* dl,
- const float* d, const float* du,
- const float* du2, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgtcon_work( char norm, lapack_int n, const double* dl,
- const double* d, const double* du,
- const double* du2, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgtcon_work( char norm, lapack_int n,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zgtcon_work( char norm, lapack_int n,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_sgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl,
- const float* d, const float* du,
- const float* dlf, const float* df,
- const float* duf, const float* du2,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl,
- const double* d, const double* du,
- const double* dlf, const double* df,
- const double* duf, const double* du2,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* dlf,
- const lapack_complex_float* df,
- const lapack_complex_float* duf,
- const lapack_complex_float* du2,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* dlf,
- const lapack_complex_double* df,
- const lapack_complex_double* duf,
- const lapack_complex_double* du2,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* dl, float* d, float* du, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* dl, double* d, double* du, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* dl,
- lapack_complex_float* d,
- lapack_complex_float* du,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* dl,
- lapack_complex_double* d,
- lapack_complex_double* du,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const float* dl,
- const float* d, const float* du, float* dlf,
- float* df, float* duf, float* du2,
- lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const double* dl,
- const double* d, const double* du, double* dlf,
- double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- lapack_complex_float* dlf,
- lapack_complex_float* df,
- lapack_complex_float* duf,
- lapack_complex_float* du2, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- lapack_complex_double* dlf,
- lapack_complex_double* df,
- lapack_complex_double* duf,
- lapack_complex_double* du2, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgttrf_work( lapack_int n, float* dl, float* d, float* du,
- float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_dgttrf_work( lapack_int n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv );
-lapack_int LAPACKE_cgttrf_work( lapack_int n, lapack_complex_float* dl,
- lapack_complex_float* d,
- lapack_complex_float* du,
- lapack_complex_float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_zgttrf_work( lapack_int n, lapack_complex_double* dl,
- lapack_complex_double* d,
- lapack_complex_double* du,
- lapack_complex_double* du2, lapack_int* ipiv );
-
-lapack_int LAPACKE_sgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl,
- const float* d, const float* du,
- const float* du2, const lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl,
- const double* d, const double* du,
- const double* du2, const lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zhbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* q, lapack_int ldq,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- float* rwork, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_zhbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* q, lapack_int ldq,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* bb, lapack_int ldbb,
- lapack_complex_float* x, lapack_int ldx,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* bb,
- lapack_int ldbb, lapack_complex_double* x,
- lapack_int ldx, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zhbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* bb,
- lapack_int ldbb, lapack_complex_float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* bb,
- lapack_int ldbb, lapack_complex_double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- float* d, float* e, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* work );
-lapack_int LAPACKE_zhbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- double* d, double* e, lapack_complex_double* q,
- lapack_int ldq, lapack_complex_double* work );
-
-lapack_int LAPACKE_checon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zhecon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_cheequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax,
- lapack_complex_float* work );
-lapack_int LAPACKE_zheequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_cheev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* w,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zheev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* w,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_cheevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* w,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_zheevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* w,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_cheevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* isuppz,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_zheevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_int* isuppz,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_cheevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zheevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chegst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhegst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chegv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* w,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zhegv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* w, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_chegvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float* w, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhegvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* w, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chegvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhegvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_cherfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zherfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_cherfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* s, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zherfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chesv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zhesv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_chesvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zhesvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_chesvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zhesvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chetrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float* d, float* e, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zhetrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* d, double* e,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_chetrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* work,
- lapack_int lwork );
-lapack_int LAPACKE_zhetrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_chetri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zhetri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_chetrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zhetrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- float alpha, const lapack_complex_float* a,
- lapack_int lda, float beta,
- lapack_complex_float* c );
-lapack_int LAPACKE_zhfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- double alpha, const lapack_complex_double* a,
- lapack_int lda, double beta,
- lapack_complex_double* c );
-
-lapack_int LAPACKE_shgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* h, lapack_int ldh,
- float* t, lapack_int ldt, float* alphar,
- float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dhgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* h, lapack_int ldh,
- double* t, lapack_int ldt, double* alphar,
- double* alphai, double* beta, double* q,
- lapack_int ldq, double* z, lapack_int ldz,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_chgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* h,
- lapack_int ldh, lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zhgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* h,
- lapack_int ldh, lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_chpcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zhpcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_chpev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* ap, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhpev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* ap,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chpevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* ap,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhpevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* ap,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chpevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_float* ap, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhpevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_double* ap, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chpgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* ap,
- const lapack_complex_float* bp );
-lapack_int LAPACKE_zhpgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* ap,
- const lapack_complex_double* bp );
-
-lapack_int LAPACKE_chpgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhpgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_chpgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_zhpgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_chpgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* ap,
- lapack_complex_float* bp, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhpgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* ap,
- lapack_complex_double* bp, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_chpsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhpsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chpsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhpsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_chptrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, float* d, float* e,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zhptrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, double* d, double* e,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_chptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zhptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_chptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zhptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_chptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_shsein_work( int matrix_order, char job, char eigsrc,
- char initv, lapack_logical* select,
- lapack_int n, const float* h, lapack_int ldh,
- float* wr, const float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_dhsein_work( int matrix_order, char job, char eigsrc,
- char initv, lapack_logical* select,
- lapack_int n, const double* h, lapack_int ldh,
- double* wr, const double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_chsein_work( int matrix_order, char job, char eigsrc,
- char initv, const lapack_logical* select,
- lapack_int n, const lapack_complex_float* h,
- lapack_int ldh, lapack_complex_float* w,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_float* work, float* rwork,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_zhsein_work( int matrix_order, char job, char eigsrc,
- char initv, const lapack_logical* select,
- lapack_int n, const lapack_complex_double* h,
- lapack_int ldh, lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, double* rwork,
- lapack_int* ifaill, lapack_int* ifailr );
-
-lapack_int LAPACKE_shseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* h, lapack_int ldh, float* wr, float* wi,
- float* z, lapack_int ldz, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dhseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* h, lapack_int ldh, double* wr,
- double* wi, double* z, lapack_int ldz,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_chseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zhseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_clacgv_work( lapack_int n, lapack_complex_float* x,
- lapack_int incx );
-lapack_int LAPACKE_zlacgv_work( lapack_int n, lapack_complex_double* x,
- lapack_int incx );
-
-lapack_int LAPACKE_slacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dlacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_clacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zlacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_zlag2c_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_float* sa, lapack_int ldsa );
-
-lapack_int LAPACKE_slag2d_work( int matrix_order, lapack_int m, lapack_int n,
- const float* sa, lapack_int ldsa, double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_dlag2s_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, float* sa,
- lapack_int ldsa );
-
-lapack_int LAPACKE_clag2z_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* sa, lapack_int ldsa,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- float* a, lapack_int lda, lapack_int* iseed,
- float* work );
-lapack_int LAPACKE_dlagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- double* a, lapack_int lda, lapack_int* iseed,
- double* work );
-lapack_int LAPACKE_clagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* iseed, lapack_complex_float* work );
-lapack_int LAPACKE_zlagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* iseed,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_claghe_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_float* work );
-lapack_int LAPACKE_zlaghe_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_slagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, float* a, lapack_int lda,
- lapack_int* iseed, float* work );
-lapack_int LAPACKE_dlagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, double* a, lapack_int lda,
- lapack_int* iseed, double* work );
-lapack_int LAPACKE_clagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_float* work );
-lapack_int LAPACKE_zlagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_slapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, float* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_dlapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, double* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_clapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n,
- lapack_complex_float* x, lapack_int ldx,
- lapack_int* k );
-lapack_int LAPACKE_zlapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n,
- lapack_complex_double* x, lapack_int ldx,
- lapack_int* k );
-
-lapack_int LAPACKE_slartgp_work( float f, float g, float* cs, float* sn,
- float* r );
-lapack_int LAPACKE_dlartgp_work( double f, double g, double* cs, double* sn,
- double* r );
-
-lapack_int LAPACKE_slartgs_work( float x, float y, float sigma, float* cs,
- float* sn );
-lapack_int LAPACKE_dlartgs_work( double x, double y, double sigma, double* cs,
- double* sn );
-
-float LAPACKE_slapy2_work( float x, float y );
-double LAPACKE_dlapy2_work( double x, double y );
-
-float LAPACKE_slapy3_work( float x, float y, float z );
-double LAPACKE_dlapy3_work( double x, double y, double z );
-
-float LAPACKE_slamch_work( char cmach );
-double LAPACKE_dlamch_work( char cmach );
-
-float LAPACKE_slange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* work );
-double LAPACKE_dlange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* work );
-float LAPACKE_clange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* work );
-double LAPACKE_zlange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* work );
-
-float LAPACKE_clanhe_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* work );
-double LAPACKE_zlanhe_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* work );
-
-float LAPACKE_slansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* work );
-double LAPACKE_dlansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* work );
-float LAPACKE_clansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* work );
-double LAPACKE_zlansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* work );
-
-float LAPACKE_slantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n, const float* a,
- lapack_int lda, float* work );
-double LAPACKE_dlantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* work );
-float LAPACKE_clantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* work );
-double LAPACKE_zlantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* work );
-
-lapack_int LAPACKE_slarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* c, lapack_int ldc, float* work,
- lapack_int ldwork );
-lapack_int LAPACKE_dlarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* c, lapack_int ldc, double* work,
- lapack_int ldwork );
-lapack_int LAPACKE_clarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int ldwork );
-lapack_int LAPACKE_zlarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work,
- lapack_int ldwork );
-
-lapack_int LAPACKE_slarfg_work( lapack_int n, float* alpha, float* x,
- lapack_int incx, float* tau );
-lapack_int LAPACKE_dlarfg_work( lapack_int n, double* alpha, double* x,
- lapack_int incx, double* tau );
-lapack_int LAPACKE_clarfg_work( lapack_int n, lapack_complex_float* alpha,
- lapack_complex_float* x, lapack_int incx,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zlarfg_work( lapack_int n, lapack_complex_double* alpha,
- lapack_complex_double* x, lapack_int incx,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_slarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* tau, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dlarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* tau, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_clarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* tau,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zlarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* tau,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_slarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const float* v, float tau,
- float* c, lapack_int ldc, float* work );
-lapack_int LAPACKE_dlarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const double* v, double tau,
- double* c, lapack_int ldc, double* work );
-lapack_int LAPACKE_clarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_float* v,
- lapack_complex_float tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work );
-lapack_int LAPACKE_zlarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_double* v,
- lapack_complex_double tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_slarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, float* x );
-lapack_int LAPACKE_dlarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, double* x );
-lapack_int LAPACKE_clarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, lapack_complex_float* x );
-lapack_int LAPACKE_zlarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, lapack_complex_double* x );
-
-lapack_int LAPACKE_slaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, float alpha, float beta, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, double alpha, double beta,
- double* a, lapack_int lda );
-lapack_int LAPACKE_claset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_float alpha,
- lapack_complex_float beta,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_double alpha,
- lapack_complex_double beta,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slasrt_work( char id, lapack_int n, float* d );
-lapack_int LAPACKE_dlasrt_work( char id, lapack_int n, double* d );
-
-lapack_int LAPACKE_slaswp_work( int matrix_order, lapack_int n, float* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_dlaswp_work( int matrix_order, lapack_int n, double* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_claswp_work( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_zlaswp_work( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-
-lapack_int LAPACKE_slatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- float* d, lapack_int mode, float cond,
- float dmax, lapack_int kl, lapack_int ku,
- char pack, float* a, lapack_int lda,
- float* work );
-lapack_int LAPACKE_dlatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- double* d, lapack_int mode, double cond,
- double dmax, lapack_int kl, lapack_int ku,
- char pack, double* a, lapack_int lda,
- double* work );
-lapack_int LAPACKE_clatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- float* d, lapack_int mode, float cond,
- float dmax, lapack_int kl, lapack_int ku,
- char pack, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* work );
-lapack_int LAPACKE_zlatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- double* d, lapack_int mode, double cond,
- double dmax, lapack_int kl, lapack_int ku,
- char pack, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* work );
-
-lapack_int LAPACKE_slauum_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dlauum_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_clauum_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlauum_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_sopgtr_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, const float* tau, float* q,
- lapack_int ldq, float* work );
-lapack_int LAPACKE_dopgtr_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, const double* tau, double* q,
- lapack_int ldq, double* work );
-
-lapack_int LAPACKE_sopmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const float* ap, const float* tau, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dopmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const double* ap, const double* tau, double* c,
- lapack_int ldc, double* work );
-
-lapack_int LAPACKE_sorgbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, float* a,
- lapack_int lda, const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, double* a,
- lapack_int lda, const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgtr_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, const float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dorgtr_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const double* tau,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_spbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab,
- lapack_int ldab, double anorm, double* rcond,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float anorm, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_dpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_zpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax );
-
-lapack_int LAPACKE_spbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb,
- lapack_int ldafb, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab,
- const lapack_complex_double* afb,
- lapack_int ldafb,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, float* bb, lapack_int ldbb );
-lapack_int LAPACKE_dpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, double* bb, lapack_int ldbb );
-lapack_int LAPACKE_cpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_float* bb,
- lapack_int ldbb );
-lapack_int LAPACKE_zpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_double* bb,
- lapack_int ldbb );
-
-lapack_int LAPACKE_spbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- float* ab, lapack_int ldab, float* afb,
- lapack_int ldafb, char* equed, float* s,
- float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- double* ab, lapack_int ldab, double* afb,
- lapack_int ldafb, char* equed, double* s,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork );
-lapack_int LAPACKE_cpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* afb, lapack_int ldafb,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* afb, lapack_int ldafb,
- char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab );
-lapack_int LAPACKE_dpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab );
-lapack_int LAPACKE_cpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab );
-lapack_int LAPACKE_zpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab );
-
-lapack_int LAPACKE_spbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_spftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spocon_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dpocon_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cpocon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpocon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spoequ_work( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequ_work( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpoequ_work( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequ_work( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_spoequb_work( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequb_work( int matrix_order, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax );
-lapack_int LAPACKE_cpoequb_work( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequb_work( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_sporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af,
- lapack_int ldaf, const float* s,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const double* s,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const float* s,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* work, float* swork,
- lapack_int* iter );
-lapack_int LAPACKE_zcposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_complex_double* work,
- lapack_complex_float* swork, double* rwork,
- lapack_int* iter );
-
-lapack_int LAPACKE_sposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_spotrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dpotrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_cpotrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotri_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dpotri_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_cpotri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sppcon_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float anorm, float* rcond,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dppcon_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double anorm, double* rcond,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cppcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float anorm,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zppcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double anorm,
- double* rcond, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sppequ_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dppequ_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cppequ_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float* s,
- float* scond, float* amax );
-lapack_int LAPACKE_zppequ_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double* s,
- double* scond, double* amax );
-
-lapack_int LAPACKE_spprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const float* afp, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const double* afp, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* ap,
- float* afp, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* ap,
- double* afp, char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* ap,
- lapack_complex_float* afp, char* equed,
- float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* ap,
- lapack_complex_double* afp, char* equed,
- double* s, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_spptrf_work( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptrf_work( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptri_work( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptri_work( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spstrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, lapack_int* piv,
- lapack_int* rank, float tol, float* work );
-lapack_int LAPACKE_dpstrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, lapack_int* piv,
- lapack_int* rank, double tol, double* work );
-lapack_int LAPACKE_cpstrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, float tol,
- float* work );
-lapack_int LAPACKE_zpstrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, double tol,
- double* work );
-
-lapack_int LAPACKE_sptcon_work( lapack_int n, const float* d, const float* e,
- float anorm, float* rcond, float* work );
-lapack_int LAPACKE_dptcon_work( lapack_int n, const double* d, const double* e,
- double anorm, double* rcond, double* work );
-lapack_int LAPACKE_cptcon_work( lapack_int n, const float* d,
- const lapack_complex_float* e, float anorm,
- float* rcond, float* work );
-lapack_int LAPACKE_zptcon_work( lapack_int n, const double* d,
- const lapack_complex_double* e, double anorm,
- double* rcond, double* work );
-
-lapack_int LAPACKE_spteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dpteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work );
-lapack_int LAPACKE_cpteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, lapack_complex_float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_zpteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_sptrfs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, const float* df,
- const float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* ferr,
- float* berr, float* work );
-lapack_int LAPACKE_dptrfs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e,
- const double* df, const double* ef,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work );
-lapack_int LAPACKE_cptrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, const float* df,
- const lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zptrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e,
- const double* df,
- const lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, float* e, float* b, lapack_int ldb );
-lapack_int LAPACKE_dptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, double* e, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d, const float* e,
- float* df, float* ef, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work );
-lapack_int LAPACKE_dptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const double* e, double* df, double* ef,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work );
-lapack_int LAPACKE_cptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, float* df,
- lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e, double* df,
- lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spttrf_work( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dpttrf_work( lapack_int n, double* d, double* e );
-lapack_int LAPACKE_cpttrf_work( lapack_int n, float* d,
- lapack_complex_float* e );
-lapack_int LAPACKE_zpttrf_work( lapack_int n, double* d,
- lapack_complex_double* e );
-
-lapack_int LAPACKE_spttrs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpttrs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpttrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpttrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* w, float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_dsbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* w, double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_ssbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- float* ab, lapack_int ldab, float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- double* ab, lapack_int ldab, double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, const float* bb,
- lapack_int ldbb, float* x, lapack_int ldx,
- float* work );
-lapack_int LAPACKE_dsbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, const double* bb,
- lapack_int ldbb, double* x, lapack_int ldx,
- double* work );
-
-lapack_int LAPACKE_ssbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* w, float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_dsbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* w, double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_ssbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, float* ab, lapack_int ldab,
- float* bb, lapack_int ldbb, float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, double* ab, lapack_int ldab,
- double* bb, lapack_int ldbb, double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* d, float* e, float* q,
- lapack_int ldq, float* work );
-lapack_int LAPACKE_dsbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* d, double* e,
- double* q, lapack_int ldq, double* work );
-
-lapack_int LAPACKE_ssfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- float alpha, const float* a, lapack_int lda,
- float beta, float* c );
-lapack_int LAPACKE_dsfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- double alpha, const double* a, lapack_int lda,
- double beta, double* c );
-
-lapack_int LAPACKE_sspcon_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dspcon_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cspcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zspcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_sspev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* ap, float* w, float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_dspev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* ap, double* w, double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_sspevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* ap, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dspevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* ap, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sspevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* ap, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dspevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* ap, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, double* work,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_sspgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* ap, const float* bp );
-lapack_int LAPACKE_dspgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* ap, const double* bp );
-
-lapack_int LAPACKE_sspgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dspgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz,
- double* work );
-
-lapack_int LAPACKE_sspgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dspgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sspgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* ap,
- float* bp, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_dspgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* ap,
- double* bp, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const float* afp, const lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dsprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const double* afp, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_csprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zsprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const float* ap,
- float* afp, lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const double* ap,
- double* afp, lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_ssptrd_work( int matrix_order, char uplo, lapack_int n,
- float* ap, float* d, float* e, float* tau );
-lapack_int LAPACKE_dsptrd_work( int matrix_order, char uplo, lapack_int n,
- double* ap, double* d, double* e, double* tau );
-
-lapack_int LAPACKE_ssptrf_work( int matrix_order, char uplo, lapack_int n,
- float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_dsptrf_work( int matrix_order, char uplo, lapack_int n,
- double* ap, lapack_int* ipiv );
-lapack_int LAPACKE_csptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zsptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_ssptri_work( int matrix_order, char uplo, lapack_int n,
- float* ap, const lapack_int* ipiv,
- float* work );
-lapack_int LAPACKE_dsptri_work( int matrix_order, char uplo, lapack_int n,
- double* ap, const lapack_int* ipiv,
- double* work );
-lapack_int LAPACKE_csptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zsptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_ssptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_csptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zsptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sstebz_work( char range, char order, lapack_int n, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, const float* d, const float* e,
- lapack_int* m, lapack_int* nsplit, float* w,
- lapack_int* iblock, lapack_int* isplit,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dstebz_work( char range, char order, lapack_int n, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, const double* d, const double* e,
- lapack_int* m, lapack_int* nsplit, double* w,
- lapack_int* iblock, lapack_int* isplit,
- double* work, lapack_int* iwork );
-
-lapack_int LAPACKE_sstedc_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dstedc_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_cstedc_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zstedc_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_sstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_cstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* isuppz, double* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_sstein_work( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock,
- const lapack_int* isplit, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifailv );
-lapack_int LAPACKE_dstein_work( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock,
- const lapack_int* isplit, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifailv );
-lapack_int LAPACKE_cstein_work( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock,
- const lapack_int* isplit,
- lapack_complex_float* z, lapack_int ldz,
- float* work, lapack_int* iwork,
- lapack_int* ifailv );
-lapack_int LAPACKE_zstein_work( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock,
- const lapack_int* isplit,
- lapack_complex_double* z, lapack_int ldz,
- double* work, lapack_int* iwork,
- lapack_int* ifailv );
-
-lapack_int LAPACKE_sstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_cstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac, double* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_ssteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dsteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work );
-lapack_int LAPACKE_csteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, lapack_complex_float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_zsteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_ssterf_work( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dsterf_work( lapack_int n, double* d, double* e );
-
-lapack_int LAPACKE_sstev_work( int matrix_order, char jobz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dstev_work( int matrix_order, char jobz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work );
-
-lapack_int LAPACKE_sstevd_work( int matrix_order, char jobz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dstevd_work( int matrix_order, char jobz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sstevr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dstevr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sstevx_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dstevx_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, double* work,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_ssycon_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dsycon_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_csycon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zsycon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_ssyequb_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* s,
- float* scond, float* amax, float* work );
-lapack_int LAPACKE_dsyequb_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax, double* work );
-lapack_int LAPACKE_csyequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax,
- lapack_complex_float* work );
-lapack_int LAPACKE_zsyequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_ssyev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* a, lapack_int lda, float* w,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dsyev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* a, lapack_int lda,
- double* w, double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssyevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* a, lapack_int lda,
- float* w, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsyevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* a, lapack_int lda,
- double* w, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssyevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dsyevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssyevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_dsyevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_ssygst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* a, lapack_int lda,
- const float* b, lapack_int ldb );
-lapack_int LAPACKE_dsygst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* a, lapack_int lda,
- const double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssygv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* w, float* work, lapack_int lwork );
-lapack_int LAPACKE_dsygv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* w, double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssygvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* w, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsygvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* w, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssygvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dsygvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_ssyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dsyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_csyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zsyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_ssyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* s, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dsyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* s, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_csyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* s, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zsyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_ssysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- lapack_int* ipiv, float* b, lapack_int ldb,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dsysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- lapack_int* ipiv, double* b, lapack_int ldb,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_csysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zsysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dsysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_csysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zsysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_ssysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dsysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_csysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zsysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_ssytrd_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tau, float* work, lapack_int lwork );
-lapack_int LAPACKE_dsytrd_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tau, double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssytrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dsytrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_csytrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* work,
- lapack_int lwork );
-lapack_int LAPACKE_zsytrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_ssytri_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv, float* work );
-lapack_int LAPACKE_dsytri_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv, double* work );
-lapack_int LAPACKE_csytri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zsytri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_ssytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_csytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zsytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const float* ab, lapack_int ldab, float* rcond,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const double* ab, lapack_int ldab,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const lapack_complex_float* ab, lapack_int ldab,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_ztbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const lapack_complex_double* ab,
- lapack_int ldab, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const lapack_complex_float* ab,
- lapack_int ldab, const lapack_complex_float* b,
- lapack_int ldb, const lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, const lapack_complex_double* b,
- lapack_int ldb, const lapack_complex_double* x,
- lapack_int ldx, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_ztbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_stfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, float alpha, const float* a,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dtfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, double alpha, const double* a,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_ctfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, lapack_complex_float alpha,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, lapack_complex_double alpha,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n, float* a );
-lapack_int LAPACKE_dtftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n, double* a );
-lapack_int LAPACKE_ctftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n,
- lapack_complex_float* a );
-lapack_int LAPACKE_ztftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n,
- lapack_complex_double* a );
-
-lapack_int LAPACKE_stfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* ap );
-lapack_int LAPACKE_dtfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* ap );
-lapack_int LAPACKE_ctfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dtfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* a,
- lapack_int lda );
-lapack_int LAPACKE_ctfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_stgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* s, lapack_int lds, const float* p,
- lapack_int ldp, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m, float* work );
-lapack_int LAPACKE_dtgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* s, lapack_int lds,
- const double* p, lapack_int ldp, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work );
-lapack_int LAPACKE_ctgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* s, lapack_int lds,
- const lapack_complex_float* p, lapack_int ldp,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* s, lapack_int lds,
- const lapack_complex_double* p, lapack_int ldp,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* q, lapack_int ldq, float* z,
- lapack_int ldz, lapack_int* ifst,
- lapack_int* ilst, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dtgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz, lapack_int* ifst,
- lapack_int* ilst, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_ctgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_stgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* q, lapack_int ldq, float* z,
- lapack_int ldz, lapack_int* m, float* pl,
- float* pr, float* dif, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dtgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alphar, double* alphai,
- double* beta, double* q, lapack_int ldq,
- double* z, lapack_int ldz, lapack_int* m,
- double* pl, double* pr, double* dif,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_ctgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* m, float* pl, float* pr, float* dif,
- lapack_complex_float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_ztgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr,
- double* dif, lapack_complex_double* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_stgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float tola, float tolb,
- float* alpha, float* beta, float* u,
- lapack_int ldu, float* v, lapack_int ldv,
- float* q, lapack_int ldq, float* work,
- lapack_int* ncycle );
-lapack_int LAPACKE_dtgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double tola, double tolb,
- double* alpha, double* beta, double* u,
- lapack_int ldu, double* v, lapack_int ldv,
- double* q, lapack_int ldq, double* work,
- lapack_int* ncycle );
-lapack_int LAPACKE_ctgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float tola, float tolb, float* alpha,
- float* beta, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* v,
- lapack_int ldv, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* work,
- lapack_int* ncycle );
-lapack_int LAPACKE_ztgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double tola, double tolb, double* alpha,
- double* beta, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* v,
- lapack_int ldv, lapack_complex_double* q,
- lapack_int ldq, lapack_complex_double* work,
- lapack_int* ncycle );
-
-lapack_int LAPACKE_stgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* vl,
- lapack_int ldvl, const float* vr,
- lapack_int ldvr, float* s, float* dif,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_dtgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb,
- const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* dif, lapack_int mm, lapack_int* m,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ctgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* dif, lapack_int mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_ztgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* vl,
- lapack_int ldvl,
- const lapack_complex_double* vr,
- lapack_int ldvr, double* s, double* dif,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, lapack_int lwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_stgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- float* c, lapack_int ldc, const float* d,
- lapack_int ldd, const float* e, lapack_int lde,
- float* f, lapack_int ldf, float* scale,
- float* dif, float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dtgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- double* c, lapack_int ldc, const double* d,
- lapack_int ldd, const double* e, lapack_int lde,
- double* f, lapack_int ldf, double* scale,
- double* dif, double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ctgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- const lapack_complex_float* d, lapack_int ldd,
- const lapack_complex_float* e, lapack_int lde,
- lapack_complex_float* f, lapack_int ldf,
- float* scale, float* dif,
- lapack_complex_float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ztgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- const lapack_complex_double* d, lapack_int ldd,
- const lapack_complex_double* e, lapack_int lde,
- lapack_complex_double* f, lapack_int ldf,
- double* scale, double* dif,
- lapack_complex_double* work, lapack_int lwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_stpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const float* ap,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const double* ap,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_float* ap, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_double* ap, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* ap, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* ap, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, float* ap );
-lapack_int LAPACKE_dtptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, double* ap );
-lapack_int LAPACKE_ctptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_float* ap );
-lapack_int LAPACKE_ztptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_double* ap );
-
-lapack_int LAPACKE_stptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* ap, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* ap, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* ap, float* arf );
-lapack_int LAPACKE_dtpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* ap, double* arf );
-lapack_int LAPACKE_ctpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* ap,
- lapack_complex_float* arf );
-lapack_int LAPACKE_ztpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* ap,
- lapack_complex_double* arf );
-
-lapack_int LAPACKE_stpttr_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* a, lapack_int lda );
-lapack_int LAPACKE_dtpttr_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* a, lapack_int lda );
-lapack_int LAPACKE_ctpttr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztpttr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_strcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const float* a,
- lapack_int lda, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dtrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const double* a,
- lapack_int lda, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_ztrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* rcond, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_strevc_work( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, float* work );
-lapack_int LAPACKE_dtrevc_work( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work );
-lapack_int LAPACKE_ctrevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztrevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_strexc_work( int matrix_order, char compq, lapack_int n,
- float* t, lapack_int ldt, float* q,
- lapack_int ldq, lapack_int* ifst,
- lapack_int* ilst, float* work );
-lapack_int LAPACKE_dtrexc_work( int matrix_order, char compq, lapack_int n,
- double* t, lapack_int ldt, double* q,
- lapack_int ldq, lapack_int* ifst,
- lapack_int* ilst, double* work );
-lapack_int LAPACKE_ctrexc_work( int matrix_order, char compq, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztrexc_work( int matrix_order, char compq, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_strrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dtrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb,
- const double* x, lapack_int ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork );
-lapack_int LAPACKE_ctrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_strsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- float* t, lapack_int ldt, float* q,
- lapack_int ldq, float* wr, float* wi,
- lapack_int* m, float* s, float* sep,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dtrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- double* t, lapack_int ldt, double* q,
- lapack_int ldq, double* wr, double* wi,
- lapack_int* m, double* s, double* sep,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_ctrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* w, lapack_int* m,
- float* s, float* sep,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_ztrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* w, lapack_int* m,
- double* s, double* sep,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_strsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, const float* vl,
- lapack_int ldvl, const float* vr,
- lapack_int ldvr, float* s, float* sep,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int ldwork, lapack_int* iwork );
-lapack_int LAPACKE_dtrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt,
- const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* sep, lapack_int mm, lapack_int* m,
- double* work, lapack_int ldwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ctrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* t, lapack_int ldt,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int ldwork, float* rwork );
-lapack_int LAPACKE_ztrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* t, lapack_int ldt,
- const lapack_complex_double* vl,
- lapack_int ldvl,
- const lapack_complex_double* vr,
- lapack_int ldvr, double* s, double* sep,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, lapack_int ldwork,
- double* rwork );
-
-lapack_int LAPACKE_strsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_dtrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb, double* c,
- lapack_int ldc, double* scale );
-lapack_int LAPACKE_ctrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_ztrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- double* scale );
-
-lapack_int LAPACKE_strtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, float* a, lapack_int lda );
-lapack_int LAPACKE_dtrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, double* a, lapack_int lda );
-lapack_int LAPACKE_ctrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda );
-lapack_int LAPACKE_ztrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_strtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_strttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* arf );
-lapack_int LAPACKE_dtrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* arf );
-lapack_int LAPACKE_ctrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* arf );
-lapack_int LAPACKE_ztrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* arf );
-
-lapack_int LAPACKE_strttp_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* ap );
-lapack_int LAPACKE_dtrttp_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* ap );
-lapack_int LAPACKE_ctrttp_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztrttp_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dtzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_ctzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_ztzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k,
- lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k,
- lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungtr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungtr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cupgtr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* work );
-lapack_int LAPACKE_zupgtr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_cupmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work );
-lapack_int LAPACKE_zupmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_claghe( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_zlaghe( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed );
-
-lapack_int LAPACKE_slagsy( int matrix_order, lapack_int n, lapack_int k,
- const float* d, float* a, lapack_int lda,
- lapack_int* iseed );
-lapack_int LAPACKE_dlagsy( int matrix_order, lapack_int n, lapack_int k,
- const double* d, double* a, lapack_int lda,
- lapack_int* iseed );
-lapack_int LAPACKE_clagsy( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_zlagsy( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed );
-
-lapack_int LAPACKE_slapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, float* x, lapack_int ldx,
- lapack_int* k );
-lapack_int LAPACKE_dlapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, double* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_clapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, lapack_complex_float* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_zlapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, lapack_complex_double* x,
- lapack_int ldx, lapack_int* k );
-
-
-float LAPACKE_slapy2( float x, float y );
-double LAPACKE_dlapy2( double x, double y );
-
-float LAPACKE_slapy3( float x, float y, float z );
-double LAPACKE_dlapy3( double x, double y, double z );
-
-lapack_int LAPACKE_slartgp( float f, float g, float* cs, float* sn, float* r );
-lapack_int LAPACKE_dlartgp( double f, double g, double* cs, double* sn,
- double* r );
-
-lapack_int LAPACKE_slartgs( float x, float y, float sigma, float* cs,
- float* sn );
-lapack_int LAPACKE_dlartgs( double x, double y, double sigma, double* cs,
- double* sn );
-
-
-//LAPACK 3.3.0
-lapack_int LAPACKE_cbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, float* theta, float* phi,
- lapack_complex_float* u1, lapack_int ldu1,
- lapack_complex_float* u2, lapack_int ldu2,
- lapack_complex_float* v1t, lapack_int ldv1t,
- lapack_complex_float* v2t, lapack_int ldv2t,
- float* b11d, float* b11e, float* b12d, float* b12e,
- float* b21d, float* b21e, float* b22d, float* b22e );
-lapack_int LAPACKE_cbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- float* theta, float* phi,
- lapack_complex_float* u1, lapack_int ldu1,
- lapack_complex_float* u2, lapack_int ldu2,
- lapack_complex_float* v1t, lapack_int ldv1t,
- lapack_complex_float* v2t, lapack_int ldv2t,
- float* b11d, float* b11e, float* b12d,
- float* b12e, float* b21d, float* b21e,
- float* b22d, float* b22e, float* rwork,
- lapack_int lrwork );
-lapack_int LAPACKE_cheswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_cheswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_chetri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_chetri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_chetri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_chetri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int nb );
-lapack_int LAPACKE_chetrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_chetrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work );
-lapack_int LAPACKE_csyconv( int matrix_order, char uplo, char way, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_csyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_csyswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_csyswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_csytri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_csytri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_csytri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_csytri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int nb );
-lapack_int LAPACKE_csytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_csytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work );
-lapack_int LAPACKE_cunbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_float* x11, lapack_int ldx11,
- lapack_complex_float* x12, lapack_int ldx12,
- lapack_complex_float* x21, lapack_int ldx21,
- lapack_complex_float* x22, lapack_int ldx22,
- float* theta, float* phi,
- lapack_complex_float* taup1,
- lapack_complex_float* taup2,
- lapack_complex_float* tauq1,
- lapack_complex_float* tauq2 );
-lapack_int LAPACKE_cunbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_float* x11, lapack_int ldx11,
- lapack_complex_float* x12, lapack_int ldx12,
- lapack_complex_float* x21, lapack_int ldx21,
- lapack_complex_float* x22, lapack_int ldx22,
- float* theta, float* phi,
- lapack_complex_float* taup1,
- lapack_complex_float* taup2,
- lapack_complex_float* tauq1,
- lapack_complex_float* tauq2,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_cuncsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_float* x11, lapack_int ldx11,
- lapack_complex_float* x12, lapack_int ldx12,
- lapack_complex_float* x21, lapack_int ldx21,
- lapack_complex_float* x22, lapack_int ldx22,
- float* theta, lapack_complex_float* u1,
- lapack_int ldu1, lapack_complex_float* u2,
- lapack_int ldu2, lapack_complex_float* v1t,
- lapack_int ldv1t, lapack_complex_float* v2t,
- lapack_int ldv2t );
-lapack_int LAPACKE_cuncsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, lapack_complex_float* x11,
- lapack_int ldx11, lapack_complex_float* x12,
- lapack_int ldx12, lapack_complex_float* x21,
- lapack_int ldx21, lapack_complex_float* x22,
- lapack_int ldx22, float* theta,
- lapack_complex_float* u1, lapack_int ldu1,
- lapack_complex_float* u2, lapack_int ldu2,
- lapack_complex_float* v1t, lapack_int ldv1t,
- lapack_complex_float* v2t, lapack_int ldv2t,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, double* theta,
- double* phi, double* u1, lapack_int ldu1, double* u2,
- lapack_int ldu2, double* v1t, lapack_int ldv1t,
- double* v2t, lapack_int ldv2t, double* b11d,
- double* b11e, double* b12d, double* b12e,
- double* b21d, double* b21e, double* b22d,
- double* b22e );
-lapack_int LAPACKE_dbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- double* theta, double* phi, double* u1,
- lapack_int ldu1, double* u2, lapack_int ldu2,
- double* v1t, lapack_int ldv1t, double* v2t,
- lapack_int ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_dorbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2 );
-lapack_int LAPACKE_dorbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* u1, lapack_int ldu1, double* u2,
- lapack_int ldu2, double* v1t, lapack_int ldv1t,
- double* v2t, lapack_int ldv2t );
-lapack_int LAPACKE_dorcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, double* x11, lapack_int ldx11,
- double* x12, lapack_int ldx12, double* x21,
- lapack_int ldx21, double* x22, lapack_int ldx22,
- double* theta, double* u1, lapack_int ldu1,
- double* u2, lapack_int ldu2, double* v1t,
- lapack_int ldv1t, double* v2t, lapack_int ldv2t,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dsyconv( int matrix_order, char uplo, char way, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dsyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, double* a, lapack_int lda,
- const lapack_int* ipiv, double* work );
-lapack_int LAPACKE_dsyswapr( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_dsyswapr_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_dsytri2( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dsytri2_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_dsytri2x( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv,
- lapack_int nb );
-lapack_int LAPACKE_dsytri2x_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv, double* work,
- lapack_int nb );
-lapack_int LAPACKE_dsytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_dsytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb, double* work );
-lapack_int LAPACKE_sbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, float* theta, float* phi,
- float* u1, lapack_int ldu1, float* u2,
- lapack_int ldu2, float* v1t, lapack_int ldv1t,
- float* v2t, lapack_int ldv2t, float* b11d,
- float* b11e, float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e );
-lapack_int LAPACKE_sbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- float* theta, float* phi, float* u1,
- lapack_int ldu1, float* u2, lapack_int ldu2,
- float* v1t, lapack_int ldv1t, float* v2t,
- lapack_int ldv2t, float* b11d, float* b11e,
- float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_sorbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q, float* x11,
- lapack_int ldx11, float* x12, lapack_int ldx12,
- float* x21, lapack_int ldx21, float* x22,
- lapack_int ldx22, float* theta, float* phi,
- float* taup1, float* taup2, float* tauq1,
- float* tauq2 );
-lapack_int LAPACKE_sorbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- float* x11, lapack_int ldx11, float* x12,
- lapack_int ldx12, float* x21, lapack_int ldx21,
- float* x22, lapack_int ldx22, float* theta,
- float* phi, float* taup1, float* taup2,
- float* tauq1, float* tauq2, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_sorcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q, float* x11,
- lapack_int ldx11, float* x12, lapack_int ldx12,
- float* x21, lapack_int ldx21, float* x22,
- lapack_int ldx22, float* theta, float* u1,
- lapack_int ldu1, float* u2, lapack_int ldu2,
- float* v1t, lapack_int ldv1t, float* v2t,
- lapack_int ldv2t );
-lapack_int LAPACKE_sorcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, float* x11, lapack_int ldx11,
- float* x12, lapack_int ldx12, float* x21,
- lapack_int ldx21, float* x22, lapack_int ldx22,
- float* theta, float* u1, lapack_int ldu1,
- float* u2, lapack_int ldu2, float* v1t,
- lapack_int ldv1t, float* v2t, lapack_int ldv2t,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ssyconv( int matrix_order, char uplo, char way, lapack_int n,
- float* a, lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_ssyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, float* a, lapack_int lda,
- const lapack_int* ipiv, float* work );
-lapack_int LAPACKE_ssyswapr( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_ssyswapr_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_ssytri2( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_ssytri2_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_ssytri2x( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, const lapack_int* ipiv,
- lapack_int nb );
-lapack_int LAPACKE_ssytri2x_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv, float* work,
- lapack_int nb );
-lapack_int LAPACKE_ssytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_ssytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a,
- lapack_int lda, const lapack_int* ipiv,
- float* b, lapack_int ldb, float* work );
-lapack_int LAPACKE_zbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, double* theta,
- double* phi, lapack_complex_double* u1,
- lapack_int ldu1, lapack_complex_double* u2,
- lapack_int ldu2, lapack_complex_double* v1t,
- lapack_int ldv1t, lapack_complex_double* v2t,
- lapack_int ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e );
-lapack_int LAPACKE_zbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- double* theta, double* phi,
- lapack_complex_double* u1, lapack_int ldu1,
- lapack_complex_double* u2, lapack_int ldu2,
- lapack_complex_double* v1t, lapack_int ldv1t,
- lapack_complex_double* v2t, lapack_int ldv2t,
- double* b11d, double* b11e, double* b12d,
- double* b12e, double* b21d, double* b21e,
- double* b22d, double* b22e, double* rwork,
- lapack_int lrwork );
-lapack_int LAPACKE_zheswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zheswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zhetri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zhetri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_zhetri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_zhetri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int nb );
-lapack_int LAPACKE_zhetrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-lapack_int LAPACKE_zhetrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work );
-lapack_int LAPACKE_zsyconv( int matrix_order, char uplo, char way, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zsyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* work );
-lapack_int LAPACKE_zsyswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zsyswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zsytri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zsytri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_zsytri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_zsytri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int nb );
-lapack_int LAPACKE_zsytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-lapack_int LAPACKE_zsytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work );
-lapack_int LAPACKE_zunbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_double* x11, lapack_int ldx11,
- lapack_complex_double* x12, lapack_int ldx12,
- lapack_complex_double* x21, lapack_int ldx21,
- lapack_complex_double* x22, lapack_int ldx22,
- double* theta, double* phi,
- lapack_complex_double* taup1,
- lapack_complex_double* taup2,
- lapack_complex_double* tauq1,
- lapack_complex_double* tauq2 );
-lapack_int LAPACKE_zunbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_double* x11, lapack_int ldx11,
- lapack_complex_double* x12, lapack_int ldx12,
- lapack_complex_double* x21, lapack_int ldx21,
- lapack_complex_double* x22, lapack_int ldx22,
- double* theta, double* phi,
- lapack_complex_double* taup1,
- lapack_complex_double* taup2,
- lapack_complex_double* tauq1,
- lapack_complex_double* tauq2,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_zuncsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_double* x11, lapack_int ldx11,
- lapack_complex_double* x12, lapack_int ldx12,
- lapack_complex_double* x21, lapack_int ldx21,
- lapack_complex_double* x22, lapack_int ldx22,
- double* theta, lapack_complex_double* u1,
- lapack_int ldu1, lapack_complex_double* u2,
- lapack_int ldu2, lapack_complex_double* v1t,
- lapack_int ldv1t, lapack_complex_double* v2t,
- lapack_int ldv2t );
-lapack_int LAPACKE_zuncsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, lapack_complex_double* x11,
- lapack_int ldx11, lapack_complex_double* x12,
- lapack_int ldx12, lapack_complex_double* x21,
- lapack_int ldx21, lapack_complex_double* x22,
- lapack_int ldx22, double* theta,
- lapack_complex_double* u1, lapack_int ldu1,
- lapack_complex_double* u2, lapack_int ldu2,
- lapack_complex_double* v1t, lapack_int ldv1t,
- lapack_complex_double* v2t, lapack_int ldv2t,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork );
-//LAPACK 3.4.0
-lapack_int LAPACKE_sgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc );
-lapack_int LAPACKE_dgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_cgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_float* v,
- lapack_int ldv, const lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* c,
- lapack_int ldc );
-lapack_int LAPACKE_zgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_double* v,
- lapack_int ldv, const lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_sgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* t,
- lapack_int ldt );
-lapack_int LAPACKE_zgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* t,
- lapack_int ldt );
-
-lapack_int LAPACKE_sgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_sgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_dtpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb, double* a,
- lapack_int lda, double* b, lapack_int ldb, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_ctpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_ztpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- float* a, lapack_int lda,
- float* b, lapack_int ldb,
- float* t, lapack_int ldt );
-lapack_int LAPACKE_dtpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- double* a, lapack_int lda,
- double* b, lapack_int ldb,
- double* t, lapack_int ldt );
-lapack_int LAPACKE_ctpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_ztpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* a, lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc, double* work );
-lapack_int LAPACKE_cgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_float* v,
- lapack_int ldv, const lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* c,
- lapack_int ldc, lapack_complex_float* work );
-lapack_int LAPACKE_zgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_double* v,
- lapack_int ldv, const lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* c,
- lapack_int ldc, lapack_complex_double* work );
-
-lapack_int LAPACKE_sgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, float* a, lapack_int lda,
- float* t, lapack_int ldt, float* work );
-lapack_int LAPACKE_dgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, double* a, lapack_int lda,
- double* t, lapack_int ldt, double* work );
-lapack_int LAPACKE_cgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* work );
-lapack_int LAPACKE_zgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* work );
-
-lapack_int LAPACKE_sgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_sgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* work );
-lapack_int LAPACKE_dtpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const double* v,
- lapack_int ldv, const double* t,
- lapack_int ldt, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* work );
-lapack_int LAPACKE_ctpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work );
-lapack_int LAPACKE_ztpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_dtpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* t, lapack_int ldt, double* work );
-lapack_int LAPACKE_ctpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* work );
-lapack_int LAPACKE_ztpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_stpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- float* a, lapack_int lda,
- float* b, lapack_int ldb,
- float* t, lapack_int ldt );
-lapack_int LAPACKE_dtpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- double* a, lapack_int lda,
- double* b, lapack_int ldb,
- double* t, lapack_int ldt );
-lapack_int LAPACKE_ctpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_ztpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const float* v, lapack_int ldv, const float* t,
- lapack_int ldt, float* a, lapack_int lda,
- float* b, lapack_int ldb, const float* work,
- lapack_int ldwork );
-lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- const double* work, lapack_int ldwork );
-lapack_int LAPACKE_ctprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- const float* work, lapack_int ldwork );
-lapack_int LAPACKE_ztprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- const double* work, lapack_int ldwork );
-//LAPACK 3.X.X
-lapack_int LAPACKE_csyr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float alpha,
- const lapack_complex_float* x, lapack_int incx,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zsyr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double alpha,
- const lapack_complex_double* x, lapack_int incx,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_csyr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float alpha,
- const lapack_complex_float* x,
- lapack_int incx, lapack_complex_float* a,
- lapack_int lda );
-lapack_int LAPACKE_zsyr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double alpha,
- const lapack_complex_double* x,
- lapack_int incx, lapack_complex_double* a,
- lapack_int lda );
-void LAPACKE_ilaver( const lapack_int* vers_major,
- const lapack_int* vers_minor,
- const lapack_int* vers_patch );
-
-
-#define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF)
-#define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF)
-#define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF)
-#define LAPACK_zgetrf LAPACK_GLOBAL(zgetrf,ZGETRF)
-#define LAPACK_sgbtrf LAPACK_GLOBAL(sgbtrf,SGBTRF)
-#define LAPACK_dgbtrf LAPACK_GLOBAL(dgbtrf,DGBTRF)
-#define LAPACK_cgbtrf LAPACK_GLOBAL(cgbtrf,CGBTRF)
-#define LAPACK_zgbtrf LAPACK_GLOBAL(zgbtrf,ZGBTRF)
-#define LAPACK_sgttrf LAPACK_GLOBAL(sgttrf,SGTTRF)
-#define LAPACK_dgttrf LAPACK_GLOBAL(dgttrf,DGTTRF)
-#define LAPACK_cgttrf LAPACK_GLOBAL(cgttrf,CGTTRF)
-#define LAPACK_zgttrf LAPACK_GLOBAL(zgttrf,ZGTTRF)
-#define LAPACK_spotrf LAPACK_GLOBAL(spotrf,SPOTRF)
-#define LAPACK_dpotrf LAPACK_GLOBAL(dpotrf,DPOTRF)
-#define LAPACK_cpotrf LAPACK_GLOBAL(cpotrf,CPOTRF)
-#define LAPACK_zpotrf LAPACK_GLOBAL(zpotrf,ZPOTRF)
-#define LAPACK_dpstrf LAPACK_GLOBAL(dpstrf,DPSTRF)
-#define LAPACK_spstrf LAPACK_GLOBAL(spstrf,SPSTRF)
-#define LAPACK_zpstrf LAPACK_GLOBAL(zpstrf,ZPSTRF)
-#define LAPACK_cpstrf LAPACK_GLOBAL(cpstrf,CPSTRF)
-#define LAPACK_dpftrf LAPACK_GLOBAL(dpftrf,DPFTRF)
-#define LAPACK_spftrf LAPACK_GLOBAL(spftrf,SPFTRF)
-#define LAPACK_zpftrf LAPACK_GLOBAL(zpftrf,ZPFTRF)
-#define LAPACK_cpftrf LAPACK_GLOBAL(cpftrf,CPFTRF)
-#define LAPACK_spptrf LAPACK_GLOBAL(spptrf,SPPTRF)
-#define LAPACK_dpptrf LAPACK_GLOBAL(dpptrf,DPPTRF)
-#define LAPACK_cpptrf LAPACK_GLOBAL(cpptrf,CPPTRF)
-#define LAPACK_zpptrf LAPACK_GLOBAL(zpptrf,ZPPTRF)
-#define LAPACK_spbtrf LAPACK_GLOBAL(spbtrf,SPBTRF)
-#define LAPACK_dpbtrf LAPACK_GLOBAL(dpbtrf,DPBTRF)
-#define LAPACK_cpbtrf LAPACK_GLOBAL(cpbtrf,CPBTRF)
-#define LAPACK_zpbtrf LAPACK_GLOBAL(zpbtrf,ZPBTRF)
-#define LAPACK_spttrf LAPACK_GLOBAL(spttrf,SPTTRF)
-#define LAPACK_dpttrf LAPACK_GLOBAL(dpttrf,DPTTRF)
-#define LAPACK_cpttrf LAPACK_GLOBAL(cpttrf,CPTTRF)
-#define LAPACK_zpttrf LAPACK_GLOBAL(zpttrf,ZPTTRF)
-#define LAPACK_ssytrf LAPACK_GLOBAL(ssytrf,SSYTRF)
-#define LAPACK_dsytrf LAPACK_GLOBAL(dsytrf,DSYTRF)
-#define LAPACK_csytrf LAPACK_GLOBAL(csytrf,CSYTRF)
-#define LAPACK_zsytrf LAPACK_GLOBAL(zsytrf,ZSYTRF)
-#define LAPACK_chetrf LAPACK_GLOBAL(chetrf,CHETRF)
-#define LAPACK_zhetrf LAPACK_GLOBAL(zhetrf,ZHETRF)
-#define LAPACK_ssptrf LAPACK_GLOBAL(ssptrf,SSPTRF)
-#define LAPACK_dsptrf LAPACK_GLOBAL(dsptrf,DSPTRF)
-#define LAPACK_csptrf LAPACK_GLOBAL(csptrf,CSPTRF)
-#define LAPACK_zsptrf LAPACK_GLOBAL(zsptrf,ZSPTRF)
-#define LAPACK_chptrf LAPACK_GLOBAL(chptrf,CHPTRF)
-#define LAPACK_zhptrf LAPACK_GLOBAL(zhptrf,ZHPTRF)
-#define LAPACK_sgetrs LAPACK_GLOBAL(sgetrs,SGETRS)
-#define LAPACK_dgetrs LAPACK_GLOBAL(dgetrs,DGETRS)
-#define LAPACK_cgetrs LAPACK_GLOBAL(cgetrs,CGETRS)
-#define LAPACK_zgetrs LAPACK_GLOBAL(zgetrs,ZGETRS)
-#define LAPACK_sgbtrs LAPACK_GLOBAL(sgbtrs,SGBTRS)
-#define LAPACK_dgbtrs LAPACK_GLOBAL(dgbtrs,DGBTRS)
-#define LAPACK_cgbtrs LAPACK_GLOBAL(cgbtrs,CGBTRS)
-#define LAPACK_zgbtrs LAPACK_GLOBAL(zgbtrs,ZGBTRS)
-#define LAPACK_sgttrs LAPACK_GLOBAL(sgttrs,SGTTRS)
-#define LAPACK_dgttrs LAPACK_GLOBAL(dgttrs,DGTTRS)
-#define LAPACK_cgttrs LAPACK_GLOBAL(cgttrs,CGTTRS)
-#define LAPACK_zgttrs LAPACK_GLOBAL(zgttrs,ZGTTRS)
-#define LAPACK_spotrs LAPACK_GLOBAL(spotrs,SPOTRS)
-#define LAPACK_dpotrs LAPACK_GLOBAL(dpotrs,DPOTRS)
-#define LAPACK_cpotrs LAPACK_GLOBAL(cpotrs,CPOTRS)
-#define LAPACK_zpotrs LAPACK_GLOBAL(zpotrs,ZPOTRS)
-#define LAPACK_dpftrs LAPACK_GLOBAL(dpftrs,DPFTRS)
-#define LAPACK_spftrs LAPACK_GLOBAL(spftrs,SPFTRS)
-#define LAPACK_zpftrs LAPACK_GLOBAL(zpftrs,ZPFTRS)
-#define LAPACK_cpftrs LAPACK_GLOBAL(cpftrs,CPFTRS)
-#define LAPACK_spptrs LAPACK_GLOBAL(spptrs,SPPTRS)
-#define LAPACK_dpptrs LAPACK_GLOBAL(dpptrs,DPPTRS)
-#define LAPACK_cpptrs LAPACK_GLOBAL(cpptrs,CPPTRS)
-#define LAPACK_zpptrs LAPACK_GLOBAL(zpptrs,ZPPTRS)
-#define LAPACK_spbtrs LAPACK_GLOBAL(spbtrs,SPBTRS)
-#define LAPACK_dpbtrs LAPACK_GLOBAL(dpbtrs,DPBTRS)
-#define LAPACK_cpbtrs LAPACK_GLOBAL(cpbtrs,CPBTRS)
-#define LAPACK_zpbtrs LAPACK_GLOBAL(zpbtrs,ZPBTRS)
-#define LAPACK_spttrs LAPACK_GLOBAL(spttrs,SPTTRS)
-#define LAPACK_dpttrs LAPACK_GLOBAL(dpttrs,DPTTRS)
-#define LAPACK_cpttrs LAPACK_GLOBAL(cpttrs,CPTTRS)
-#define LAPACK_zpttrs LAPACK_GLOBAL(zpttrs,ZPTTRS)
-#define LAPACK_ssytrs LAPACK_GLOBAL(ssytrs,SSYTRS)
-#define LAPACK_dsytrs LAPACK_GLOBAL(dsytrs,DSYTRS)
-#define LAPACK_csytrs LAPACK_GLOBAL(csytrs,CSYTRS)
-#define LAPACK_zsytrs LAPACK_GLOBAL(zsytrs,ZSYTRS)
-#define LAPACK_chetrs LAPACK_GLOBAL(chetrs,CHETRS)
-#define LAPACK_zhetrs LAPACK_GLOBAL(zhetrs,ZHETRS)
-#define LAPACK_ssptrs LAPACK_GLOBAL(ssptrs,SSPTRS)
-#define LAPACK_dsptrs LAPACK_GLOBAL(dsptrs,DSPTRS)
-#define LAPACK_csptrs LAPACK_GLOBAL(csptrs,CSPTRS)
-#define LAPACK_zsptrs LAPACK_GLOBAL(zsptrs,ZSPTRS)
-#define LAPACK_chptrs LAPACK_GLOBAL(chptrs,CHPTRS)
-#define LAPACK_zhptrs LAPACK_GLOBAL(zhptrs,ZHPTRS)
-#define LAPACK_strtrs LAPACK_GLOBAL(strtrs,STRTRS)
-#define LAPACK_dtrtrs LAPACK_GLOBAL(dtrtrs,DTRTRS)
-#define LAPACK_ctrtrs LAPACK_GLOBAL(ctrtrs,CTRTRS)
-#define LAPACK_ztrtrs LAPACK_GLOBAL(ztrtrs,ZTRTRS)
-#define LAPACK_stptrs LAPACK_GLOBAL(stptrs,STPTRS)
-#define LAPACK_dtptrs LAPACK_GLOBAL(dtptrs,DTPTRS)
-#define LAPACK_ctptrs LAPACK_GLOBAL(ctptrs,CTPTRS)
-#define LAPACK_ztptrs LAPACK_GLOBAL(ztptrs,ZTPTRS)
-#define LAPACK_stbtrs LAPACK_GLOBAL(stbtrs,STBTRS)
-#define LAPACK_dtbtrs LAPACK_GLOBAL(dtbtrs,DTBTRS)
-#define LAPACK_ctbtrs LAPACK_GLOBAL(ctbtrs,CTBTRS)
-#define LAPACK_ztbtrs LAPACK_GLOBAL(ztbtrs,ZTBTRS)
-#define LAPACK_sgecon LAPACK_GLOBAL(sgecon,SGECON)
-#define LAPACK_dgecon LAPACK_GLOBAL(dgecon,DGECON)
-#define LAPACK_cgecon LAPACK_GLOBAL(cgecon,CGECON)
-#define LAPACK_zgecon LAPACK_GLOBAL(zgecon,ZGECON)
-#define LAPACK_sgbcon LAPACK_GLOBAL(sgbcon,SGBCON)
-#define LAPACK_dgbcon LAPACK_GLOBAL(dgbcon,DGBCON)
-#define LAPACK_cgbcon LAPACK_GLOBAL(cgbcon,CGBCON)
-#define LAPACK_zgbcon LAPACK_GLOBAL(zgbcon,ZGBCON)
-#define LAPACK_sgtcon LAPACK_GLOBAL(sgtcon,SGTCON)
-#define LAPACK_dgtcon LAPACK_GLOBAL(dgtcon,DGTCON)
-#define LAPACK_cgtcon LAPACK_GLOBAL(cgtcon,CGTCON)
-#define LAPACK_zgtcon LAPACK_GLOBAL(zgtcon,ZGTCON)
-#define LAPACK_spocon LAPACK_GLOBAL(spocon,SPOCON)
-#define LAPACK_dpocon LAPACK_GLOBAL(dpocon,DPOCON)
-#define LAPACK_cpocon LAPACK_GLOBAL(cpocon,CPOCON)
-#define LAPACK_zpocon LAPACK_GLOBAL(zpocon,ZPOCON)
-#define LAPACK_sppcon LAPACK_GLOBAL(sppcon,SPPCON)
-#define LAPACK_dppcon LAPACK_GLOBAL(dppcon,DPPCON)
-#define LAPACK_cppcon LAPACK_GLOBAL(cppcon,CPPCON)
-#define LAPACK_zppcon LAPACK_GLOBAL(zppcon,ZPPCON)
-#define LAPACK_spbcon LAPACK_GLOBAL(spbcon,SPBCON)
-#define LAPACK_dpbcon LAPACK_GLOBAL(dpbcon,DPBCON)
-#define LAPACK_cpbcon LAPACK_GLOBAL(cpbcon,CPBCON)
-#define LAPACK_zpbcon LAPACK_GLOBAL(zpbcon,ZPBCON)
-#define LAPACK_sptcon LAPACK_GLOBAL(sptcon,SPTCON)
-#define LAPACK_dptcon LAPACK_GLOBAL(dptcon,DPTCON)
-#define LAPACK_cptcon LAPACK_GLOBAL(cptcon,CPTCON)
-#define LAPACK_zptcon LAPACK_GLOBAL(zptcon,ZPTCON)
-#define LAPACK_ssycon LAPACK_GLOBAL(ssycon,SSYCON)
-#define LAPACK_dsycon LAPACK_GLOBAL(dsycon,DSYCON)
-#define LAPACK_csycon LAPACK_GLOBAL(csycon,CSYCON)
-#define LAPACK_zsycon LAPACK_GLOBAL(zsycon,ZSYCON)
-#define LAPACK_checon LAPACK_GLOBAL(checon,CHECON)
-#define LAPACK_zhecon LAPACK_GLOBAL(zhecon,ZHECON)
-#define LAPACK_sspcon LAPACK_GLOBAL(sspcon,SSPCON)
-#define LAPACK_dspcon LAPACK_GLOBAL(dspcon,DSPCON)
-#define LAPACK_cspcon LAPACK_GLOBAL(cspcon,CSPCON)
-#define LAPACK_zspcon LAPACK_GLOBAL(zspcon,ZSPCON)
-#define LAPACK_chpcon LAPACK_GLOBAL(chpcon,CHPCON)
-#define LAPACK_zhpcon LAPACK_GLOBAL(zhpcon,ZHPCON)
-#define LAPACK_strcon LAPACK_GLOBAL(strcon,STRCON)
-#define LAPACK_dtrcon LAPACK_GLOBAL(dtrcon,DTRCON)
-#define LAPACK_ctrcon LAPACK_GLOBAL(ctrcon,CTRCON)
-#define LAPACK_ztrcon LAPACK_GLOBAL(ztrcon,ZTRCON)
-#define LAPACK_stpcon LAPACK_GLOBAL(stpcon,STPCON)
-#define LAPACK_dtpcon LAPACK_GLOBAL(dtpcon,DTPCON)
-#define LAPACK_ctpcon LAPACK_GLOBAL(ctpcon,CTPCON)
-#define LAPACK_ztpcon LAPACK_GLOBAL(ztpcon,ZTPCON)
-#define LAPACK_stbcon LAPACK_GLOBAL(stbcon,STBCON)
-#define LAPACK_dtbcon LAPACK_GLOBAL(dtbcon,DTBCON)
-#define LAPACK_ctbcon LAPACK_GLOBAL(ctbcon,CTBCON)
-#define LAPACK_ztbcon LAPACK_GLOBAL(ztbcon,ZTBCON)
-#define LAPACK_sgerfs LAPACK_GLOBAL(sgerfs,SGERFS)
-#define LAPACK_dgerfs LAPACK_GLOBAL(dgerfs,DGERFS)
-#define LAPACK_cgerfs LAPACK_GLOBAL(cgerfs,CGERFS)
-#define LAPACK_zgerfs LAPACK_GLOBAL(zgerfs,ZGERFS)
-#define LAPACK_dgerfsx LAPACK_GLOBAL(dgerfsx,DGERFSX)
-#define LAPACK_sgerfsx LAPACK_GLOBAL(sgerfsx,SGERFSX)
-#define LAPACK_zgerfsx LAPACK_GLOBAL(zgerfsx,ZGERFSX)
-#define LAPACK_cgerfsx LAPACK_GLOBAL(cgerfsx,CGERFSX)
-#define LAPACK_sgbrfs LAPACK_GLOBAL(sgbrfs,SGBRFS)
-#define LAPACK_dgbrfs LAPACK_GLOBAL(dgbrfs,DGBRFS)
-#define LAPACK_cgbrfs LAPACK_GLOBAL(cgbrfs,CGBRFS)
-#define LAPACK_zgbrfs LAPACK_GLOBAL(zgbrfs,ZGBRFS)
-#define LAPACK_dgbrfsx LAPACK_GLOBAL(dgbrfsx,DGBRFSX)
-#define LAPACK_sgbrfsx LAPACK_GLOBAL(sgbrfsx,SGBRFSX)
-#define LAPACK_zgbrfsx LAPACK_GLOBAL(zgbrfsx,ZGBRFSX)
-#define LAPACK_cgbrfsx LAPACK_GLOBAL(cgbrfsx,CGBRFSX)
-#define LAPACK_sgtrfs LAPACK_GLOBAL(sgtrfs,SGTRFS)
-#define LAPACK_dgtrfs LAPACK_GLOBAL(dgtrfs,DGTRFS)
-#define LAPACK_cgtrfs LAPACK_GLOBAL(cgtrfs,CGTRFS)
-#define LAPACK_zgtrfs LAPACK_GLOBAL(zgtrfs,ZGTRFS)
-#define LAPACK_sporfs LAPACK_GLOBAL(sporfs,SPORFS)
-#define LAPACK_dporfs LAPACK_GLOBAL(dporfs,DPORFS)
-#define LAPACK_cporfs LAPACK_GLOBAL(cporfs,CPORFS)
-#define LAPACK_zporfs LAPACK_GLOBAL(zporfs,ZPORFS)
-#define LAPACK_dporfsx LAPACK_GLOBAL(dporfsx,DPORFSX)
-#define LAPACK_sporfsx LAPACK_GLOBAL(sporfsx,SPORFSX)
-#define LAPACK_zporfsx LAPACK_GLOBAL(zporfsx,ZPORFSX)
-#define LAPACK_cporfsx LAPACK_GLOBAL(cporfsx,CPORFSX)
-#define LAPACK_spprfs LAPACK_GLOBAL(spprfs,SPPRFS)
-#define LAPACK_dpprfs LAPACK_GLOBAL(dpprfs,DPPRFS)
-#define LAPACK_cpprfs LAPACK_GLOBAL(cpprfs,CPPRFS)
-#define LAPACK_zpprfs LAPACK_GLOBAL(zpprfs,ZPPRFS)
-#define LAPACK_spbrfs LAPACK_GLOBAL(spbrfs,SPBRFS)
-#define LAPACK_dpbrfs LAPACK_GLOBAL(dpbrfs,DPBRFS)
-#define LAPACK_cpbrfs LAPACK_GLOBAL(cpbrfs,CPBRFS)
-#define LAPACK_zpbrfs LAPACK_GLOBAL(zpbrfs,ZPBRFS)
-#define LAPACK_sptrfs LAPACK_GLOBAL(sptrfs,SPTRFS)
-#define LAPACK_dptrfs LAPACK_GLOBAL(dptrfs,DPTRFS)
-#define LAPACK_cptrfs LAPACK_GLOBAL(cptrfs,CPTRFS)
-#define LAPACK_zptrfs LAPACK_GLOBAL(zptrfs,ZPTRFS)
-#define LAPACK_ssyrfs LAPACK_GLOBAL(ssyrfs,SSYRFS)
-#define LAPACK_dsyrfs LAPACK_GLOBAL(dsyrfs,DSYRFS)
-#define LAPACK_csyrfs LAPACK_GLOBAL(csyrfs,CSYRFS)
-#define LAPACK_zsyrfs LAPACK_GLOBAL(zsyrfs,ZSYRFS)
-#define LAPACK_dsyrfsx LAPACK_GLOBAL(dsyrfsx,DSYRFSX)
-#define LAPACK_ssyrfsx LAPACK_GLOBAL(ssyrfsx,SSYRFSX)
-#define LAPACK_zsyrfsx LAPACK_GLOBAL(zsyrfsx,ZSYRFSX)
-#define LAPACK_csyrfsx LAPACK_GLOBAL(csyrfsx,CSYRFSX)
-#define LAPACK_cherfs LAPACK_GLOBAL(cherfs,CHERFS)
-#define LAPACK_zherfs LAPACK_GLOBAL(zherfs,ZHERFS)
-#define LAPACK_zherfsx LAPACK_GLOBAL(zherfsx,ZHERFSX)
-#define LAPACK_cherfsx LAPACK_GLOBAL(cherfsx,CHERFSX)
-#define LAPACK_ssprfs LAPACK_GLOBAL(ssprfs,SSPRFS)
-#define LAPACK_dsprfs LAPACK_GLOBAL(dsprfs,DSPRFS)
-#define LAPACK_csprfs LAPACK_GLOBAL(csprfs,CSPRFS)
-#define LAPACK_zsprfs LAPACK_GLOBAL(zsprfs,ZSPRFS)
-#define LAPACK_chprfs LAPACK_GLOBAL(chprfs,CHPRFS)
-#define LAPACK_zhprfs LAPACK_GLOBAL(zhprfs,ZHPRFS)
-#define LAPACK_strrfs LAPACK_GLOBAL(strrfs,STRRFS)
-#define LAPACK_dtrrfs LAPACK_GLOBAL(dtrrfs,DTRRFS)
-#define LAPACK_ctrrfs LAPACK_GLOBAL(ctrrfs,CTRRFS)
-#define LAPACK_ztrrfs LAPACK_GLOBAL(ztrrfs,ZTRRFS)
-#define LAPACK_stprfs LAPACK_GLOBAL(stprfs,STPRFS)
-#define LAPACK_dtprfs LAPACK_GLOBAL(dtprfs,DTPRFS)
-#define LAPACK_ctprfs LAPACK_GLOBAL(ctprfs,CTPRFS)
-#define LAPACK_ztprfs LAPACK_GLOBAL(ztprfs,ZTPRFS)
-#define LAPACK_stbrfs LAPACK_GLOBAL(stbrfs,STBRFS)
-#define LAPACK_dtbrfs LAPACK_GLOBAL(dtbrfs,DTBRFS)
-#define LAPACK_ctbrfs LAPACK_GLOBAL(ctbrfs,CTBRFS)
-#define LAPACK_ztbrfs LAPACK_GLOBAL(ztbrfs,ZTBRFS)
-#define LAPACK_sgetri LAPACK_GLOBAL(sgetri,SGETRI)
-#define LAPACK_dgetri LAPACK_GLOBAL(dgetri,DGETRI)
-#define LAPACK_cgetri LAPACK_GLOBAL(cgetri,CGETRI)
-#define LAPACK_zgetri LAPACK_GLOBAL(zgetri,ZGETRI)
-#define LAPACK_spotri LAPACK_GLOBAL(spotri,SPOTRI)
-#define LAPACK_dpotri LAPACK_GLOBAL(dpotri,DPOTRI)
-#define LAPACK_cpotri LAPACK_GLOBAL(cpotri,CPOTRI)
-#define LAPACK_zpotri LAPACK_GLOBAL(zpotri,ZPOTRI)
-#define LAPACK_dpftri LAPACK_GLOBAL(dpftri,DPFTRI)
-#define LAPACK_spftri LAPACK_GLOBAL(spftri,SPFTRI)
-#define LAPACK_zpftri LAPACK_GLOBAL(zpftri,ZPFTRI)
-#define LAPACK_cpftri LAPACK_GLOBAL(cpftri,CPFTRI)
-#define LAPACK_spptri LAPACK_GLOBAL(spptri,SPPTRI)
-#define LAPACK_dpptri LAPACK_GLOBAL(dpptri,DPPTRI)
-#define LAPACK_cpptri LAPACK_GLOBAL(cpptri,CPPTRI)
-#define LAPACK_zpptri LAPACK_GLOBAL(zpptri,ZPPTRI)
-#define LAPACK_ssytri LAPACK_GLOBAL(ssytri,SSYTRI)
-#define LAPACK_dsytri LAPACK_GLOBAL(dsytri,DSYTRI)
-#define LAPACK_csytri LAPACK_GLOBAL(csytri,CSYTRI)
-#define LAPACK_zsytri LAPACK_GLOBAL(zsytri,ZSYTRI)
-#define LAPACK_chetri LAPACK_GLOBAL(chetri,CHETRI)
-#define LAPACK_zhetri LAPACK_GLOBAL(zhetri,ZHETRI)
-#define LAPACK_ssptri LAPACK_GLOBAL(ssptri,SSPTRI)
-#define LAPACK_dsptri LAPACK_GLOBAL(dsptri,DSPTRI)
-#define LAPACK_csptri LAPACK_GLOBAL(csptri,CSPTRI)
-#define LAPACK_zsptri LAPACK_GLOBAL(zsptri,ZSPTRI)
-#define LAPACK_chptri LAPACK_GLOBAL(chptri,CHPTRI)
-#define LAPACK_zhptri LAPACK_GLOBAL(zhptri,ZHPTRI)
-#define LAPACK_strtri LAPACK_GLOBAL(strtri,STRTRI)
-#define LAPACK_dtrtri LAPACK_GLOBAL(dtrtri,DTRTRI)
-#define LAPACK_ctrtri LAPACK_GLOBAL(ctrtri,CTRTRI)
-#define LAPACK_ztrtri LAPACK_GLOBAL(ztrtri,ZTRTRI)
-#define LAPACK_dtftri LAPACK_GLOBAL(dtftri,DTFTRI)
-#define LAPACK_stftri LAPACK_GLOBAL(stftri,STFTRI)
-#define LAPACK_ztftri LAPACK_GLOBAL(ztftri,ZTFTRI)
-#define LAPACK_ctftri LAPACK_GLOBAL(ctftri,CTFTRI)
-#define LAPACK_stptri LAPACK_GLOBAL(stptri,STPTRI)
-#define LAPACK_dtptri LAPACK_GLOBAL(dtptri,DTPTRI)
-#define LAPACK_ctptri LAPACK_GLOBAL(ctptri,CTPTRI)
-#define LAPACK_ztptri LAPACK_GLOBAL(ztptri,ZTPTRI)
-#define LAPACK_sgeequ LAPACK_GLOBAL(sgeequ,SGEEQU)
-#define LAPACK_dgeequ LAPACK_GLOBAL(dgeequ,DGEEQU)
-#define LAPACK_cgeequ LAPACK_GLOBAL(cgeequ,CGEEQU)
-#define LAPACK_zgeequ LAPACK_GLOBAL(zgeequ,ZGEEQU)
-#define LAPACK_dgeequb LAPACK_GLOBAL(dgeequb,DGEEQUB)
-#define LAPACK_sgeequb LAPACK_GLOBAL(sgeequb,SGEEQUB)
-#define LAPACK_zgeequb LAPACK_GLOBAL(zgeequb,ZGEEQUB)
-#define LAPACK_cgeequb LAPACK_GLOBAL(cgeequb,CGEEQUB)
-#define LAPACK_sgbequ LAPACK_GLOBAL(sgbequ,SGBEQU)
-#define LAPACK_dgbequ LAPACK_GLOBAL(dgbequ,DGBEQU)
-#define LAPACK_cgbequ LAPACK_GLOBAL(cgbequ,CGBEQU)
-#define LAPACK_zgbequ LAPACK_GLOBAL(zgbequ,ZGBEQU)
-#define LAPACK_dgbequb LAPACK_GLOBAL(dgbequb,DGBEQUB)
-#define LAPACK_sgbequb LAPACK_GLOBAL(sgbequb,SGBEQUB)
-#define LAPACK_zgbequb LAPACK_GLOBAL(zgbequb,ZGBEQUB)
-#define LAPACK_cgbequb LAPACK_GLOBAL(cgbequb,CGBEQUB)
-#define LAPACK_spoequ LAPACK_GLOBAL(spoequ,SPOEQU)
-#define LAPACK_dpoequ LAPACK_GLOBAL(dpoequ,DPOEQU)
-#define LAPACK_cpoequ LAPACK_GLOBAL(cpoequ,CPOEQU)
-#define LAPACK_zpoequ LAPACK_GLOBAL(zpoequ,ZPOEQU)
-#define LAPACK_dpoequb LAPACK_GLOBAL(dpoequb,DPOEQUB)
-#define LAPACK_spoequb LAPACK_GLOBAL(spoequb,SPOEQUB)
-#define LAPACK_zpoequb LAPACK_GLOBAL(zpoequb,ZPOEQUB)
-#define LAPACK_cpoequb LAPACK_GLOBAL(cpoequb,CPOEQUB)
-#define LAPACK_sppequ LAPACK_GLOBAL(sppequ,SPPEQU)
-#define LAPACK_dppequ LAPACK_GLOBAL(dppequ,DPPEQU)
-#define LAPACK_cppequ LAPACK_GLOBAL(cppequ,CPPEQU)
-#define LAPACK_zppequ LAPACK_GLOBAL(zppequ,ZPPEQU)
-#define LAPACK_spbequ LAPACK_GLOBAL(spbequ,SPBEQU)
-#define LAPACK_dpbequ LAPACK_GLOBAL(dpbequ,DPBEQU)
-#define LAPACK_cpbequ LAPACK_GLOBAL(cpbequ,CPBEQU)
-#define LAPACK_zpbequ LAPACK_GLOBAL(zpbequ,ZPBEQU)
-#define LAPACK_dsyequb LAPACK_GLOBAL(dsyequb,DSYEQUB)
-#define LAPACK_ssyequb LAPACK_GLOBAL(ssyequb,SSYEQUB)
-#define LAPACK_zsyequb LAPACK_GLOBAL(zsyequb,ZSYEQUB)
-#define LAPACK_csyequb LAPACK_GLOBAL(csyequb,CSYEQUB)
-#define LAPACK_zheequb LAPACK_GLOBAL(zheequb,ZHEEQUB)
-#define LAPACK_cheequb LAPACK_GLOBAL(cheequb,CHEEQUB)
-#define LAPACK_sgesv LAPACK_GLOBAL(sgesv,SGESV)
-#define LAPACK_dgesv LAPACK_GLOBAL(dgesv,DGESV)
-#define LAPACK_cgesv LAPACK_GLOBAL(cgesv,CGESV)
-#define LAPACK_zgesv LAPACK_GLOBAL(zgesv,ZGESV)
-#define LAPACK_dsgesv LAPACK_GLOBAL(dsgesv,DSGESV)
-#define LAPACK_zcgesv LAPACK_GLOBAL(zcgesv,ZCGESV)
-#define LAPACK_sgesvx LAPACK_GLOBAL(sgesvx,SGESVX)
-#define LAPACK_dgesvx LAPACK_GLOBAL(dgesvx,DGESVX)
-#define LAPACK_cgesvx LAPACK_GLOBAL(cgesvx,CGESVX)
-#define LAPACK_zgesvx LAPACK_GLOBAL(zgesvx,ZGESVX)
-#define LAPACK_dgesvxx LAPACK_GLOBAL(dgesvxx,DGESVXX)
-#define LAPACK_sgesvxx LAPACK_GLOBAL(sgesvxx,SGESVXX)
-#define LAPACK_zgesvxx LAPACK_GLOBAL(zgesvxx,ZGESVXX)
-#define LAPACK_cgesvxx LAPACK_GLOBAL(cgesvxx,CGESVXX)
-#define LAPACK_sgbsv LAPACK_GLOBAL(sgbsv,SGBSV)
-#define LAPACK_dgbsv LAPACK_GLOBAL(dgbsv,DGBSV)
-#define LAPACK_cgbsv LAPACK_GLOBAL(cgbsv,CGBSV)
-#define LAPACK_zgbsv LAPACK_GLOBAL(zgbsv,ZGBSV)
-#define LAPACK_sgbsvx LAPACK_GLOBAL(sgbsvx,SGBSVX)
-#define LAPACK_dgbsvx LAPACK_GLOBAL(dgbsvx,DGBSVX)
-#define LAPACK_cgbsvx LAPACK_GLOBAL(cgbsvx,CGBSVX)
-#define LAPACK_zgbsvx LAPACK_GLOBAL(zgbsvx,ZGBSVX)
-#define LAPACK_dgbsvxx LAPACK_GLOBAL(dgbsvxx,DGBSVXX)
-#define LAPACK_sgbsvxx LAPACK_GLOBAL(sgbsvxx,SGBSVXX)
-#define LAPACK_zgbsvxx LAPACK_GLOBAL(zgbsvxx,ZGBSVXX)
-#define LAPACK_cgbsvxx LAPACK_GLOBAL(cgbsvxx,CGBSVXX)
-#define LAPACK_sgtsv LAPACK_GLOBAL(sgtsv,SGTSV)
-#define LAPACK_dgtsv LAPACK_GLOBAL(dgtsv,DGTSV)
-#define LAPACK_cgtsv LAPACK_GLOBAL(cgtsv,CGTSV)
-#define LAPACK_zgtsv LAPACK_GLOBAL(zgtsv,ZGTSV)
-#define LAPACK_sgtsvx LAPACK_GLOBAL(sgtsvx,SGTSVX)
-#define LAPACK_dgtsvx LAPACK_GLOBAL(dgtsvx,DGTSVX)
-#define LAPACK_cgtsvx LAPACK_GLOBAL(cgtsvx,CGTSVX)
-#define LAPACK_zgtsvx LAPACK_GLOBAL(zgtsvx,ZGTSVX)
-#define LAPACK_sposv LAPACK_GLOBAL(sposv,SPOSV)
-#define LAPACK_dposv LAPACK_GLOBAL(dposv,DPOSV)
-#define LAPACK_cposv LAPACK_GLOBAL(cposv,CPOSV)
-#define LAPACK_zposv LAPACK_GLOBAL(zposv,ZPOSV)
-#define LAPACK_dsposv LAPACK_GLOBAL(dsposv,DSPOSV)
-#define LAPACK_zcposv LAPACK_GLOBAL(zcposv,ZCPOSV)
-#define LAPACK_sposvx LAPACK_GLOBAL(sposvx,SPOSVX)
-#define LAPACK_dposvx LAPACK_GLOBAL(dposvx,DPOSVX)
-#define LAPACK_cposvx LAPACK_GLOBAL(cposvx,CPOSVX)
-#define LAPACK_zposvx LAPACK_GLOBAL(zposvx,ZPOSVX)
-#define LAPACK_dposvxx LAPACK_GLOBAL(dposvxx,DPOSVXX)
-#define LAPACK_sposvxx LAPACK_GLOBAL(sposvxx,SPOSVXX)
-#define LAPACK_zposvxx LAPACK_GLOBAL(zposvxx,ZPOSVXX)
-#define LAPACK_cposvxx LAPACK_GLOBAL(cposvxx,CPOSVXX)
-#define LAPACK_sppsv LAPACK_GLOBAL(sppsv,SPPSV)
-#define LAPACK_dppsv LAPACK_GLOBAL(dppsv,DPPSV)
-#define LAPACK_cppsv LAPACK_GLOBAL(cppsv,CPPSV)
-#define LAPACK_zppsv LAPACK_GLOBAL(zppsv,ZPPSV)
-#define LAPACK_sppsvx LAPACK_GLOBAL(sppsvx,SPPSVX)
-#define LAPACK_dppsvx LAPACK_GLOBAL(dppsvx,DPPSVX)
-#define LAPACK_cppsvx LAPACK_GLOBAL(cppsvx,CPPSVX)
-#define LAPACK_zppsvx LAPACK_GLOBAL(zppsvx,ZPPSVX)
-#define LAPACK_spbsv LAPACK_GLOBAL(spbsv,SPBSV)
-#define LAPACK_dpbsv LAPACK_GLOBAL(dpbsv,DPBSV)
-#define LAPACK_cpbsv LAPACK_GLOBAL(cpbsv,CPBSV)
-#define LAPACK_zpbsv LAPACK_GLOBAL(zpbsv,ZPBSV)
-#define LAPACK_spbsvx LAPACK_GLOBAL(spbsvx,SPBSVX)
-#define LAPACK_dpbsvx LAPACK_GLOBAL(dpbsvx,DPBSVX)
-#define LAPACK_cpbsvx LAPACK_GLOBAL(cpbsvx,CPBSVX)
-#define LAPACK_zpbsvx LAPACK_GLOBAL(zpbsvx,ZPBSVX)
-#define LAPACK_sptsv LAPACK_GLOBAL(sptsv,SPTSV)
-#define LAPACK_dptsv LAPACK_GLOBAL(dptsv,DPTSV)
-#define LAPACK_cptsv LAPACK_GLOBAL(cptsv,CPTSV)
-#define LAPACK_zptsv LAPACK_GLOBAL(zptsv,ZPTSV)
-#define LAPACK_sptsvx LAPACK_GLOBAL(sptsvx,SPTSVX)
-#define LAPACK_dptsvx LAPACK_GLOBAL(dptsvx,DPTSVX)
-#define LAPACK_cptsvx LAPACK_GLOBAL(cptsvx,CPTSVX)
-#define LAPACK_zptsvx LAPACK_GLOBAL(zptsvx,ZPTSVX)
-#define LAPACK_ssysv LAPACK_GLOBAL(ssysv,SSYSV)
-#define LAPACK_dsysv LAPACK_GLOBAL(dsysv,DSYSV)
-#define LAPACK_csysv LAPACK_GLOBAL(csysv,CSYSV)
-#define LAPACK_zsysv LAPACK_GLOBAL(zsysv,ZSYSV)
-#define LAPACK_ssysvx LAPACK_GLOBAL(ssysvx,SSYSVX)
-#define LAPACK_dsysvx LAPACK_GLOBAL(dsysvx,DSYSVX)
-#define LAPACK_csysvx LAPACK_GLOBAL(csysvx,CSYSVX)
-#define LAPACK_zsysvx LAPACK_GLOBAL(zsysvx,ZSYSVX)
-#define LAPACK_dsysvxx LAPACK_GLOBAL(dsysvxx,DSYSVXX)
-#define LAPACK_ssysvxx LAPACK_GLOBAL(ssysvxx,SSYSVXX)
-#define LAPACK_zsysvxx LAPACK_GLOBAL(zsysvxx,ZSYSVXX)
-#define LAPACK_csysvxx LAPACK_GLOBAL(csysvxx,CSYSVXX)
-#define LAPACK_chesv LAPACK_GLOBAL(chesv,CHESV)
-#define LAPACK_zhesv LAPACK_GLOBAL(zhesv,ZHESV)
-#define LAPACK_chesvx LAPACK_GLOBAL(chesvx,CHESVX)
-#define LAPACK_zhesvx LAPACK_GLOBAL(zhesvx,ZHESVX)
-#define LAPACK_zhesvxx LAPACK_GLOBAL(zhesvxx,ZHESVXX)
-#define LAPACK_chesvxx LAPACK_GLOBAL(chesvxx,CHESVXX)
-#define LAPACK_sspsv LAPACK_GLOBAL(sspsv,SSPSV)
-#define LAPACK_dspsv LAPACK_GLOBAL(dspsv,DSPSV)
-#define LAPACK_cspsv LAPACK_GLOBAL(cspsv,CSPSV)
-#define LAPACK_zspsv LAPACK_GLOBAL(zspsv,ZSPSV)
-#define LAPACK_sspsvx LAPACK_GLOBAL(sspsvx,SSPSVX)
-#define LAPACK_dspsvx LAPACK_GLOBAL(dspsvx,DSPSVX)
-#define LAPACK_cspsvx LAPACK_GLOBAL(cspsvx,CSPSVX)
-#define LAPACK_zspsvx LAPACK_GLOBAL(zspsvx,ZSPSVX)
-#define LAPACK_chpsv LAPACK_GLOBAL(chpsv,CHPSV)
-#define LAPACK_zhpsv LAPACK_GLOBAL(zhpsv,ZHPSV)
-#define LAPACK_chpsvx LAPACK_GLOBAL(chpsvx,CHPSVX)
-#define LAPACK_zhpsvx LAPACK_GLOBAL(zhpsvx,ZHPSVX)
-#define LAPACK_sgeqrf LAPACK_GLOBAL(sgeqrf,SGEQRF)
-#define LAPACK_dgeqrf LAPACK_GLOBAL(dgeqrf,DGEQRF)
-#define LAPACK_cgeqrf LAPACK_GLOBAL(cgeqrf,CGEQRF)
-#define LAPACK_zgeqrf LAPACK_GLOBAL(zgeqrf,ZGEQRF)
-#define LAPACK_sgeqpf LAPACK_GLOBAL(sgeqpf,SGEQPF)
-#define LAPACK_dgeqpf LAPACK_GLOBAL(dgeqpf,DGEQPF)
-#define LAPACK_cgeqpf LAPACK_GLOBAL(cgeqpf,CGEQPF)
-#define LAPACK_zgeqpf LAPACK_GLOBAL(zgeqpf,ZGEQPF)
-#define LAPACK_sgeqp3 LAPACK_GLOBAL(sgeqp3,SGEQP3)
-#define LAPACK_dgeqp3 LAPACK_GLOBAL(dgeqp3,DGEQP3)
-#define LAPACK_cgeqp3 LAPACK_GLOBAL(cgeqp3,CGEQP3)
-#define LAPACK_zgeqp3 LAPACK_GLOBAL(zgeqp3,ZGEQP3)
-#define LAPACK_sorgqr LAPACK_GLOBAL(sorgqr,SORGQR)
-#define LAPACK_dorgqr LAPACK_GLOBAL(dorgqr,DORGQR)
-#define LAPACK_sormqr LAPACK_GLOBAL(sormqr,SORMQR)
-#define LAPACK_dormqr LAPACK_GLOBAL(dormqr,DORMQR)
-#define LAPACK_cungqr LAPACK_GLOBAL(cungqr,CUNGQR)
-#define LAPACK_zungqr LAPACK_GLOBAL(zungqr,ZUNGQR)
-#define LAPACK_cunmqr LAPACK_GLOBAL(cunmqr,CUNMQR)
-#define LAPACK_zunmqr LAPACK_GLOBAL(zunmqr,ZUNMQR)
-#define LAPACK_sgelqf LAPACK_GLOBAL(sgelqf,SGELQF)
-#define LAPACK_dgelqf LAPACK_GLOBAL(dgelqf,DGELQF)
-#define LAPACK_cgelqf LAPACK_GLOBAL(cgelqf,CGELQF)
-#define LAPACK_zgelqf LAPACK_GLOBAL(zgelqf,ZGELQF)
-#define LAPACK_sorglq LAPACK_GLOBAL(sorglq,SORGLQ)
-#define LAPACK_dorglq LAPACK_GLOBAL(dorglq,DORGLQ)
-#define LAPACK_sormlq LAPACK_GLOBAL(sormlq,SORMLQ)
-#define LAPACK_dormlq LAPACK_GLOBAL(dormlq,DORMLQ)
-#define LAPACK_cunglq LAPACK_GLOBAL(cunglq,CUNGLQ)
-#define LAPACK_zunglq LAPACK_GLOBAL(zunglq,ZUNGLQ)
-#define LAPACK_cunmlq LAPACK_GLOBAL(cunmlq,CUNMLQ)
-#define LAPACK_zunmlq LAPACK_GLOBAL(zunmlq,ZUNMLQ)
-#define LAPACK_sgeqlf LAPACK_GLOBAL(sgeqlf,SGEQLF)
-#define LAPACK_dgeqlf LAPACK_GLOBAL(dgeqlf,DGEQLF)
-#define LAPACK_cgeqlf LAPACK_GLOBAL(cgeqlf,CGEQLF)
-#define LAPACK_zgeqlf LAPACK_GLOBAL(zgeqlf,ZGEQLF)
-#define LAPACK_sorgql LAPACK_GLOBAL(sorgql,SORGQL)
-#define LAPACK_dorgql LAPACK_GLOBAL(dorgql,DORGQL)
-#define LAPACK_cungql LAPACK_GLOBAL(cungql,CUNGQL)
-#define LAPACK_zungql LAPACK_GLOBAL(zungql,ZUNGQL)
-#define LAPACK_sormql LAPACK_GLOBAL(sormql,SORMQL)
-#define LAPACK_dormql LAPACK_GLOBAL(dormql,DORMQL)
-#define LAPACK_cunmql LAPACK_GLOBAL(cunmql,CUNMQL)
-#define LAPACK_zunmql LAPACK_GLOBAL(zunmql,ZUNMQL)
-#define LAPACK_sgerqf LAPACK_GLOBAL(sgerqf,SGERQF)
-#define LAPACK_dgerqf LAPACK_GLOBAL(dgerqf,DGERQF)
-#define LAPACK_cgerqf LAPACK_GLOBAL(cgerqf,CGERQF)
-#define LAPACK_zgerqf LAPACK_GLOBAL(zgerqf,ZGERQF)
-#define LAPACK_sorgrq LAPACK_GLOBAL(sorgrq,SORGRQ)
-#define LAPACK_dorgrq LAPACK_GLOBAL(dorgrq,DORGRQ)
-#define LAPACK_cungrq LAPACK_GLOBAL(cungrq,CUNGRQ)
-#define LAPACK_zungrq LAPACK_GLOBAL(zungrq,ZUNGRQ)
-#define LAPACK_sormrq LAPACK_GLOBAL(sormrq,SORMRQ)
-#define LAPACK_dormrq LAPACK_GLOBAL(dormrq,DORMRQ)
-#define LAPACK_cunmrq LAPACK_GLOBAL(cunmrq,CUNMRQ)
-#define LAPACK_zunmrq LAPACK_GLOBAL(zunmrq,ZUNMRQ)
-#define LAPACK_stzrzf LAPACK_GLOBAL(stzrzf,STZRZF)
-#define LAPACK_dtzrzf LAPACK_GLOBAL(dtzrzf,DTZRZF)
-#define LAPACK_ctzrzf LAPACK_GLOBAL(ctzrzf,CTZRZF)
-#define LAPACK_ztzrzf LAPACK_GLOBAL(ztzrzf,ZTZRZF)
-#define LAPACK_sormrz LAPACK_GLOBAL(sormrz,SORMRZ)
-#define LAPACK_dormrz LAPACK_GLOBAL(dormrz,DORMRZ)
-#define LAPACK_cunmrz LAPACK_GLOBAL(cunmrz,CUNMRZ)
-#define LAPACK_zunmrz LAPACK_GLOBAL(zunmrz,ZUNMRZ)
-#define LAPACK_sggqrf LAPACK_GLOBAL(sggqrf,SGGQRF)
-#define LAPACK_dggqrf LAPACK_GLOBAL(dggqrf,DGGQRF)
-#define LAPACK_cggqrf LAPACK_GLOBAL(cggqrf,CGGQRF)
-#define LAPACK_zggqrf LAPACK_GLOBAL(zggqrf,ZGGQRF)
-#define LAPACK_sggrqf LAPACK_GLOBAL(sggrqf,SGGRQF)
-#define LAPACK_dggrqf LAPACK_GLOBAL(dggrqf,DGGRQF)
-#define LAPACK_cggrqf LAPACK_GLOBAL(cggrqf,CGGRQF)
-#define LAPACK_zggrqf LAPACK_GLOBAL(zggrqf,ZGGRQF)
-#define LAPACK_sgebrd LAPACK_GLOBAL(sgebrd,SGEBRD)
-#define LAPACK_dgebrd LAPACK_GLOBAL(dgebrd,DGEBRD)
-#define LAPACK_cgebrd LAPACK_GLOBAL(cgebrd,CGEBRD)
-#define LAPACK_zgebrd LAPACK_GLOBAL(zgebrd,ZGEBRD)
-#define LAPACK_sgbbrd LAPACK_GLOBAL(sgbbrd,SGBBRD)
-#define LAPACK_dgbbrd LAPACK_GLOBAL(dgbbrd,DGBBRD)
-#define LAPACK_cgbbrd LAPACK_GLOBAL(cgbbrd,CGBBRD)
-#define LAPACK_zgbbrd LAPACK_GLOBAL(zgbbrd,ZGBBRD)
-#define LAPACK_sorgbr LAPACK_GLOBAL(sorgbr,SORGBR)
-#define LAPACK_dorgbr LAPACK_GLOBAL(dorgbr,DORGBR)
-#define LAPACK_sormbr LAPACK_GLOBAL(sormbr,SORMBR)
-#define LAPACK_dormbr LAPACK_GLOBAL(dormbr,DORMBR)
-#define LAPACK_cungbr LAPACK_GLOBAL(cungbr,CUNGBR)
-#define LAPACK_zungbr LAPACK_GLOBAL(zungbr,ZUNGBR)
-#define LAPACK_cunmbr LAPACK_GLOBAL(cunmbr,CUNMBR)
-#define LAPACK_zunmbr LAPACK_GLOBAL(zunmbr,ZUNMBR)
-#define LAPACK_sbdsqr LAPACK_GLOBAL(sbdsqr,SBDSQR)
-#define LAPACK_dbdsqr LAPACK_GLOBAL(dbdsqr,DBDSQR)
-#define LAPACK_cbdsqr LAPACK_GLOBAL(cbdsqr,CBDSQR)
-#define LAPACK_zbdsqr LAPACK_GLOBAL(zbdsqr,ZBDSQR)
-#define LAPACK_sbdsdc LAPACK_GLOBAL(sbdsdc,SBDSDC)
-#define LAPACK_dbdsdc LAPACK_GLOBAL(dbdsdc,DBDSDC)
-#define LAPACK_ssytrd LAPACK_GLOBAL(ssytrd,SSYTRD)
-#define LAPACK_dsytrd LAPACK_GLOBAL(dsytrd,DSYTRD)
-#define LAPACK_sorgtr LAPACK_GLOBAL(sorgtr,SORGTR)
-#define LAPACK_dorgtr LAPACK_GLOBAL(dorgtr,DORGTR)
-#define LAPACK_sormtr LAPACK_GLOBAL(sormtr,SORMTR)
-#define LAPACK_dormtr LAPACK_GLOBAL(dormtr,DORMTR)
-#define LAPACK_chetrd LAPACK_GLOBAL(chetrd,CHETRD)
-#define LAPACK_zhetrd LAPACK_GLOBAL(zhetrd,ZHETRD)
-#define LAPACK_cungtr LAPACK_GLOBAL(cungtr,CUNGTR)
-#define LAPACK_zungtr LAPACK_GLOBAL(zungtr,ZUNGTR)
-#define LAPACK_cunmtr LAPACK_GLOBAL(cunmtr,CUNMTR)
-#define LAPACK_zunmtr LAPACK_GLOBAL(zunmtr,ZUNMTR)
-#define LAPACK_ssptrd LAPACK_GLOBAL(ssptrd,SSPTRD)
-#define LAPACK_dsptrd LAPACK_GLOBAL(dsptrd,DSPTRD)
-#define LAPACK_sopgtr LAPACK_GLOBAL(sopgtr,SOPGTR)
-#define LAPACK_dopgtr LAPACK_GLOBAL(dopgtr,DOPGTR)
-#define LAPACK_sopmtr LAPACK_GLOBAL(sopmtr,SOPMTR)
-#define LAPACK_dopmtr LAPACK_GLOBAL(dopmtr,DOPMTR)
-#define LAPACK_chptrd LAPACK_GLOBAL(chptrd,CHPTRD)
-#define LAPACK_zhptrd LAPACK_GLOBAL(zhptrd,ZHPTRD)
-#define LAPACK_cupgtr LAPACK_GLOBAL(cupgtr,CUPGTR)
-#define LAPACK_zupgtr LAPACK_GLOBAL(zupgtr,ZUPGTR)
-#define LAPACK_cupmtr LAPACK_GLOBAL(cupmtr,CUPMTR)
-#define LAPACK_zupmtr LAPACK_GLOBAL(zupmtr,ZUPMTR)
-#define LAPACK_ssbtrd LAPACK_GLOBAL(ssbtrd,SSBTRD)
-#define LAPACK_dsbtrd LAPACK_GLOBAL(dsbtrd,DSBTRD)
-#define LAPACK_chbtrd LAPACK_GLOBAL(chbtrd,CHBTRD)
-#define LAPACK_zhbtrd LAPACK_GLOBAL(zhbtrd,ZHBTRD)
-#define LAPACK_ssterf LAPACK_GLOBAL(ssterf,SSTERF)
-#define LAPACK_dsterf LAPACK_GLOBAL(dsterf,DSTERF)
-#define LAPACK_ssteqr LAPACK_GLOBAL(ssteqr,SSTEQR)
-#define LAPACK_dsteqr LAPACK_GLOBAL(dsteqr,DSTEQR)
-#define LAPACK_csteqr LAPACK_GLOBAL(csteqr,CSTEQR)
-#define LAPACK_zsteqr LAPACK_GLOBAL(zsteqr,ZSTEQR)
-#define LAPACK_sstemr LAPACK_GLOBAL(sstemr,SSTEMR)
-#define LAPACK_dstemr LAPACK_GLOBAL(dstemr,DSTEMR)
-#define LAPACK_cstemr LAPACK_GLOBAL(cstemr,CSTEMR)
-#define LAPACK_zstemr LAPACK_GLOBAL(zstemr,ZSTEMR)
-#define LAPACK_sstedc LAPACK_GLOBAL(sstedc,SSTEDC)
-#define LAPACK_dstedc LAPACK_GLOBAL(dstedc,DSTEDC)
-#define LAPACK_cstedc LAPACK_GLOBAL(cstedc,CSTEDC)
-#define LAPACK_zstedc LAPACK_GLOBAL(zstedc,ZSTEDC)
-#define LAPACK_sstegr LAPACK_GLOBAL(sstegr,SSTEGR)
-#define LAPACK_dstegr LAPACK_GLOBAL(dstegr,DSTEGR)
-#define LAPACK_cstegr LAPACK_GLOBAL(cstegr,CSTEGR)
-#define LAPACK_zstegr LAPACK_GLOBAL(zstegr,ZSTEGR)
-#define LAPACK_spteqr LAPACK_GLOBAL(spteqr,SPTEQR)
-#define LAPACK_dpteqr LAPACK_GLOBAL(dpteqr,DPTEQR)
-#define LAPACK_cpteqr LAPACK_GLOBAL(cpteqr,CPTEQR)
-#define LAPACK_zpteqr LAPACK_GLOBAL(zpteqr,ZPTEQR)
-#define LAPACK_sstebz LAPACK_GLOBAL(sstebz,SSTEBZ)
-#define LAPACK_dstebz LAPACK_GLOBAL(dstebz,DSTEBZ)
-#define LAPACK_sstein LAPACK_GLOBAL(sstein,SSTEIN)
-#define LAPACK_dstein LAPACK_GLOBAL(dstein,DSTEIN)
-#define LAPACK_cstein LAPACK_GLOBAL(cstein,CSTEIN)
-#define LAPACK_zstein LAPACK_GLOBAL(zstein,ZSTEIN)
-#define LAPACK_sdisna LAPACK_GLOBAL(sdisna,SDISNA)
-#define LAPACK_ddisna LAPACK_GLOBAL(ddisna,DDISNA)
-#define LAPACK_ssygst LAPACK_GLOBAL(ssygst,SSYGST)
-#define LAPACK_dsygst LAPACK_GLOBAL(dsygst,DSYGST)
-#define LAPACK_chegst LAPACK_GLOBAL(chegst,CHEGST)
-#define LAPACK_zhegst LAPACK_GLOBAL(zhegst,ZHEGST)
-#define LAPACK_sspgst LAPACK_GLOBAL(sspgst,SSPGST)
-#define LAPACK_dspgst LAPACK_GLOBAL(dspgst,DSPGST)
-#define LAPACK_chpgst LAPACK_GLOBAL(chpgst,CHPGST)
-#define LAPACK_zhpgst LAPACK_GLOBAL(zhpgst,ZHPGST)
-#define LAPACK_ssbgst LAPACK_GLOBAL(ssbgst,SSBGST)
-#define LAPACK_dsbgst LAPACK_GLOBAL(dsbgst,DSBGST)
-#define LAPACK_chbgst LAPACK_GLOBAL(chbgst,CHBGST)
-#define LAPACK_zhbgst LAPACK_GLOBAL(zhbgst,ZHBGST)
-#define LAPACK_spbstf LAPACK_GLOBAL(spbstf,SPBSTF)
-#define LAPACK_dpbstf LAPACK_GLOBAL(dpbstf,DPBSTF)
-#define LAPACK_cpbstf LAPACK_GLOBAL(cpbstf,CPBSTF)
-#define LAPACK_zpbstf LAPACK_GLOBAL(zpbstf,ZPBSTF)
-#define LAPACK_sgehrd LAPACK_GLOBAL(sgehrd,SGEHRD)
-#define LAPACK_dgehrd LAPACK_GLOBAL(dgehrd,DGEHRD)
-#define LAPACK_cgehrd LAPACK_GLOBAL(cgehrd,CGEHRD)
-#define LAPACK_zgehrd LAPACK_GLOBAL(zgehrd,ZGEHRD)
-#define LAPACK_sorghr LAPACK_GLOBAL(sorghr,SORGHR)
-#define LAPACK_dorghr LAPACK_GLOBAL(dorghr,DORGHR)
-#define LAPACK_sormhr LAPACK_GLOBAL(sormhr,SORMHR)
-#define LAPACK_dormhr LAPACK_GLOBAL(dormhr,DORMHR)
-#define LAPACK_cunghr LAPACK_GLOBAL(cunghr,CUNGHR)
-#define LAPACK_zunghr LAPACK_GLOBAL(zunghr,ZUNGHR)
-#define LAPACK_cunmhr LAPACK_GLOBAL(cunmhr,CUNMHR)
-#define LAPACK_zunmhr LAPACK_GLOBAL(zunmhr,ZUNMHR)
-#define LAPACK_sgebal LAPACK_GLOBAL(sgebal,SGEBAL)
-#define LAPACK_dgebal LAPACK_GLOBAL(dgebal,DGEBAL)
-#define LAPACK_cgebal LAPACK_GLOBAL(cgebal,CGEBAL)
-#define LAPACK_zgebal LAPACK_GLOBAL(zgebal,ZGEBAL)
-#define LAPACK_sgebak LAPACK_GLOBAL(sgebak,SGEBAK)
-#define LAPACK_dgebak LAPACK_GLOBAL(dgebak,DGEBAK)
-#define LAPACK_cgebak LAPACK_GLOBAL(cgebak,CGEBAK)
-#define LAPACK_zgebak LAPACK_GLOBAL(zgebak,ZGEBAK)
-#define LAPACK_shseqr LAPACK_GLOBAL(shseqr,SHSEQR)
-#define LAPACK_dhseqr LAPACK_GLOBAL(dhseqr,DHSEQR)
-#define LAPACK_chseqr LAPACK_GLOBAL(chseqr,CHSEQR)
-#define LAPACK_zhseqr LAPACK_GLOBAL(zhseqr,ZHSEQR)
-#define LAPACK_shsein LAPACK_GLOBAL(shsein,SHSEIN)
-#define LAPACK_dhsein LAPACK_GLOBAL(dhsein,DHSEIN)
-#define LAPACK_chsein LAPACK_GLOBAL(chsein,CHSEIN)
-#define LAPACK_zhsein LAPACK_GLOBAL(zhsein,ZHSEIN)
-#define LAPACK_strevc LAPACK_GLOBAL(strevc,STREVC)
-#define LAPACK_dtrevc LAPACK_GLOBAL(dtrevc,DTREVC)
-#define LAPACK_ctrevc LAPACK_GLOBAL(ctrevc,CTREVC)
-#define LAPACK_ztrevc LAPACK_GLOBAL(ztrevc,ZTREVC)
-#define LAPACK_strsna LAPACK_GLOBAL(strsna,STRSNA)
-#define LAPACK_dtrsna LAPACK_GLOBAL(dtrsna,DTRSNA)
-#define LAPACK_ctrsna LAPACK_GLOBAL(ctrsna,CTRSNA)
-#define LAPACK_ztrsna LAPACK_GLOBAL(ztrsna,ZTRSNA)
-#define LAPACK_strexc LAPACK_GLOBAL(strexc,STREXC)
-#define LAPACK_dtrexc LAPACK_GLOBAL(dtrexc,DTREXC)
-#define LAPACK_ctrexc LAPACK_GLOBAL(ctrexc,CTREXC)
-#define LAPACK_ztrexc LAPACK_GLOBAL(ztrexc,ZTREXC)
-#define LAPACK_strsen LAPACK_GLOBAL(strsen,STRSEN)
-#define LAPACK_dtrsen LAPACK_GLOBAL(dtrsen,DTRSEN)
-#define LAPACK_ctrsen LAPACK_GLOBAL(ctrsen,CTRSEN)
-#define LAPACK_ztrsen LAPACK_GLOBAL(ztrsen,ZTRSEN)
-#define LAPACK_strsyl LAPACK_GLOBAL(strsyl,STRSYL)
-#define LAPACK_dtrsyl LAPACK_GLOBAL(dtrsyl,DTRSYL)
-#define LAPACK_ctrsyl LAPACK_GLOBAL(ctrsyl,CTRSYL)
-#define LAPACK_ztrsyl LAPACK_GLOBAL(ztrsyl,ZTRSYL)
-#define LAPACK_sgghrd LAPACK_GLOBAL(sgghrd,SGGHRD)
-#define LAPACK_dgghrd LAPACK_GLOBAL(dgghrd,DGGHRD)
-#define LAPACK_cgghrd LAPACK_GLOBAL(cgghrd,CGGHRD)
-#define LAPACK_zgghrd LAPACK_GLOBAL(zgghrd,ZGGHRD)
-#define LAPACK_sggbal LAPACK_GLOBAL(sggbal,SGGBAL)
-#define LAPACK_dggbal LAPACK_GLOBAL(dggbal,DGGBAL)
-#define LAPACK_cggbal LAPACK_GLOBAL(cggbal,CGGBAL)
-#define LAPACK_zggbal LAPACK_GLOBAL(zggbal,ZGGBAL)
-#define LAPACK_sggbak LAPACK_GLOBAL(sggbak,SGGBAK)
-#define LAPACK_dggbak LAPACK_GLOBAL(dggbak,DGGBAK)
-#define LAPACK_cggbak LAPACK_GLOBAL(cggbak,CGGBAK)
-#define LAPACK_zggbak LAPACK_GLOBAL(zggbak,ZGGBAK)
-#define LAPACK_shgeqz LAPACK_GLOBAL(shgeqz,SHGEQZ)
-#define LAPACK_dhgeqz LAPACK_GLOBAL(dhgeqz,DHGEQZ)
-#define LAPACK_chgeqz LAPACK_GLOBAL(chgeqz,CHGEQZ)
-#define LAPACK_zhgeqz LAPACK_GLOBAL(zhgeqz,ZHGEQZ)
-#define LAPACK_stgevc LAPACK_GLOBAL(stgevc,STGEVC)
-#define LAPACK_dtgevc LAPACK_GLOBAL(dtgevc,DTGEVC)
-#define LAPACK_ctgevc LAPACK_GLOBAL(ctgevc,CTGEVC)
-#define LAPACK_ztgevc LAPACK_GLOBAL(ztgevc,ZTGEVC)
-#define LAPACK_stgexc LAPACK_GLOBAL(stgexc,STGEXC)
-#define LAPACK_dtgexc LAPACK_GLOBAL(dtgexc,DTGEXC)
-#define LAPACK_ctgexc LAPACK_GLOBAL(ctgexc,CTGEXC)
-#define LAPACK_ztgexc LAPACK_GLOBAL(ztgexc,ZTGEXC)
-#define LAPACK_stgsen LAPACK_GLOBAL(stgsen,STGSEN)
-#define LAPACK_dtgsen LAPACK_GLOBAL(dtgsen,DTGSEN)
-#define LAPACK_ctgsen LAPACK_GLOBAL(ctgsen,CTGSEN)
-#define LAPACK_ztgsen LAPACK_GLOBAL(ztgsen,ZTGSEN)
-#define LAPACK_stgsyl LAPACK_GLOBAL(stgsyl,STGSYL)
-#define LAPACK_dtgsyl LAPACK_GLOBAL(dtgsyl,DTGSYL)
-#define LAPACK_ctgsyl LAPACK_GLOBAL(ctgsyl,CTGSYL)
-#define LAPACK_ztgsyl LAPACK_GLOBAL(ztgsyl,ZTGSYL)
-#define LAPACK_stgsna LAPACK_GLOBAL(stgsna,STGSNA)
-#define LAPACK_dtgsna LAPACK_GLOBAL(dtgsna,DTGSNA)
-#define LAPACK_ctgsna LAPACK_GLOBAL(ctgsna,CTGSNA)
-#define LAPACK_ztgsna LAPACK_GLOBAL(ztgsna,ZTGSNA)
-#define LAPACK_sggsvp LAPACK_GLOBAL(sggsvp,SGGSVP)
-#define LAPACK_dggsvp LAPACK_GLOBAL(dggsvp,DGGSVP)
-#define LAPACK_cggsvp LAPACK_GLOBAL(cggsvp,CGGSVP)
-#define LAPACK_zggsvp LAPACK_GLOBAL(zggsvp,ZGGSVP)
-#define LAPACK_stgsja LAPACK_GLOBAL(stgsja,STGSJA)
-#define LAPACK_dtgsja LAPACK_GLOBAL(dtgsja,DTGSJA)
-#define LAPACK_ctgsja LAPACK_GLOBAL(ctgsja,CTGSJA)
-#define LAPACK_ztgsja LAPACK_GLOBAL(ztgsja,ZTGSJA)
-#define LAPACK_sgels LAPACK_GLOBAL(sgels,SGELS)
-#define LAPACK_dgels LAPACK_GLOBAL(dgels,DGELS)
-#define LAPACK_cgels LAPACK_GLOBAL(cgels,CGELS)
-#define LAPACK_zgels LAPACK_GLOBAL(zgels,ZGELS)
-#define LAPACK_sgelsy LAPACK_GLOBAL(sgelsy,SGELSY)
-#define LAPACK_dgelsy LAPACK_GLOBAL(dgelsy,DGELSY)
-#define LAPACK_cgelsy LAPACK_GLOBAL(cgelsy,CGELSY)
-#define LAPACK_zgelsy LAPACK_GLOBAL(zgelsy,ZGELSY)
-#define LAPACK_sgelss LAPACK_GLOBAL(sgelss,SGELSS)
-#define LAPACK_dgelss LAPACK_GLOBAL(dgelss,DGELSS)
-#define LAPACK_cgelss LAPACK_GLOBAL(cgelss,CGELSS)
-#define LAPACK_zgelss LAPACK_GLOBAL(zgelss,ZGELSS)
-#define LAPACK_sgelsd LAPACK_GLOBAL(sgelsd,SGELSD)
-#define LAPACK_dgelsd LAPACK_GLOBAL(dgelsd,DGELSD)
-#define LAPACK_cgelsd LAPACK_GLOBAL(cgelsd,CGELSD)
-#define LAPACK_zgelsd LAPACK_GLOBAL(zgelsd,ZGELSD)
-#define LAPACK_sgglse LAPACK_GLOBAL(sgglse,SGGLSE)
-#define LAPACK_dgglse LAPACK_GLOBAL(dgglse,DGGLSE)
-#define LAPACK_cgglse LAPACK_GLOBAL(cgglse,CGGLSE)
-#define LAPACK_zgglse LAPACK_GLOBAL(zgglse,ZGGLSE)
-#define LAPACK_sggglm LAPACK_GLOBAL(sggglm,SGGGLM)
-#define LAPACK_dggglm LAPACK_GLOBAL(dggglm,DGGGLM)
-#define LAPACK_cggglm LAPACK_GLOBAL(cggglm,CGGGLM)
-#define LAPACK_zggglm LAPACK_GLOBAL(zggglm,ZGGGLM)
-#define LAPACK_ssyev LAPACK_GLOBAL(ssyev,SSYEV)
-#define LAPACK_dsyev LAPACK_GLOBAL(dsyev,DSYEV)
-#define LAPACK_cheev LAPACK_GLOBAL(cheev,CHEEV)
-#define LAPACK_zheev LAPACK_GLOBAL(zheev,ZHEEV)
-#define LAPACK_ssyevd LAPACK_GLOBAL(ssyevd,SSYEVD)
-#define LAPACK_dsyevd LAPACK_GLOBAL(dsyevd,DSYEVD)
-#define LAPACK_cheevd LAPACK_GLOBAL(cheevd,CHEEVD)
-#define LAPACK_zheevd LAPACK_GLOBAL(zheevd,ZHEEVD)
-#define LAPACK_ssyevx LAPACK_GLOBAL(ssyevx,SSYEVX)
-#define LAPACK_dsyevx LAPACK_GLOBAL(dsyevx,DSYEVX)
-#define LAPACK_cheevx LAPACK_GLOBAL(cheevx,CHEEVX)
-#define LAPACK_zheevx LAPACK_GLOBAL(zheevx,ZHEEVX)
-#define LAPACK_ssyevr LAPACK_GLOBAL(ssyevr,SSYEVR)
-#define LAPACK_dsyevr LAPACK_GLOBAL(dsyevr,DSYEVR)
-#define LAPACK_cheevr LAPACK_GLOBAL(cheevr,CHEEVR)
-#define LAPACK_zheevr LAPACK_GLOBAL(zheevr,ZHEEVR)
-#define LAPACK_sspev LAPACK_GLOBAL(sspev,SSPEV)
-#define LAPACK_dspev LAPACK_GLOBAL(dspev,DSPEV)
-#define LAPACK_chpev LAPACK_GLOBAL(chpev,CHPEV)
-#define LAPACK_zhpev LAPACK_GLOBAL(zhpev,ZHPEV)
-#define LAPACK_sspevd LAPACK_GLOBAL(sspevd,SSPEVD)
-#define LAPACK_dspevd LAPACK_GLOBAL(dspevd,DSPEVD)
-#define LAPACK_chpevd LAPACK_GLOBAL(chpevd,CHPEVD)
-#define LAPACK_zhpevd LAPACK_GLOBAL(zhpevd,ZHPEVD)
-#define LAPACK_sspevx LAPACK_GLOBAL(sspevx,SSPEVX)
-#define LAPACK_dspevx LAPACK_GLOBAL(dspevx,DSPEVX)
-#define LAPACK_chpevx LAPACK_GLOBAL(chpevx,CHPEVX)
-#define LAPACK_zhpevx LAPACK_GLOBAL(zhpevx,ZHPEVX)
-#define LAPACK_ssbev LAPACK_GLOBAL(ssbev,SSBEV)
-#define LAPACK_dsbev LAPACK_GLOBAL(dsbev,DSBEV)
-#define LAPACK_chbev LAPACK_GLOBAL(chbev,CHBEV)
-#define LAPACK_zhbev LAPACK_GLOBAL(zhbev,ZHBEV)
-#define LAPACK_ssbevd LAPACK_GLOBAL(ssbevd,SSBEVD)
-#define LAPACK_dsbevd LAPACK_GLOBAL(dsbevd,DSBEVD)
-#define LAPACK_chbevd LAPACK_GLOBAL(chbevd,CHBEVD)
-#define LAPACK_zhbevd LAPACK_GLOBAL(zhbevd,ZHBEVD)
-#define LAPACK_ssbevx LAPACK_GLOBAL(ssbevx,SSBEVX)
-#define LAPACK_dsbevx LAPACK_GLOBAL(dsbevx,DSBEVX)
-#define LAPACK_chbevx LAPACK_GLOBAL(chbevx,CHBEVX)
-#define LAPACK_zhbevx LAPACK_GLOBAL(zhbevx,ZHBEVX)
-#define LAPACK_sstev LAPACK_GLOBAL(sstev,SSTEV)
-#define LAPACK_dstev LAPACK_GLOBAL(dstev,DSTEV)
-#define LAPACK_sstevd LAPACK_GLOBAL(sstevd,SSTEVD)
-#define LAPACK_dstevd LAPACK_GLOBAL(dstevd,DSTEVD)
-#define LAPACK_sstevx LAPACK_GLOBAL(sstevx,SSTEVX)
-#define LAPACK_dstevx LAPACK_GLOBAL(dstevx,DSTEVX)
-#define LAPACK_sstevr LAPACK_GLOBAL(sstevr,SSTEVR)
-#define LAPACK_dstevr LAPACK_GLOBAL(dstevr,DSTEVR)
-#define LAPACK_sgees LAPACK_GLOBAL(sgees,SGEES)
-#define LAPACK_dgees LAPACK_GLOBAL(dgees,DGEES)
-#define LAPACK_cgees LAPACK_GLOBAL(cgees,CGEES)
-#define LAPACK_zgees LAPACK_GLOBAL(zgees,ZGEES)
-#define LAPACK_sgeesx LAPACK_GLOBAL(sgeesx,SGEESX)
-#define LAPACK_dgeesx LAPACK_GLOBAL(dgeesx,DGEESX)
-#define LAPACK_cgeesx LAPACK_GLOBAL(cgeesx,CGEESX)
-#define LAPACK_zgeesx LAPACK_GLOBAL(zgeesx,ZGEESX)
-#define LAPACK_sgeev LAPACK_GLOBAL(sgeev,SGEEV)
-#define LAPACK_dgeev LAPACK_GLOBAL(dgeev,DGEEV)
-#define LAPACK_cgeev LAPACK_GLOBAL(cgeev,CGEEV)
-#define LAPACK_zgeev LAPACK_GLOBAL(zgeev,ZGEEV)
-#define LAPACK_sgeevx LAPACK_GLOBAL(sgeevx,SGEEVX)
-#define LAPACK_dgeevx LAPACK_GLOBAL(dgeevx,DGEEVX)
-#define LAPACK_cgeevx LAPACK_GLOBAL(cgeevx,CGEEVX)
-#define LAPACK_zgeevx LAPACK_GLOBAL(zgeevx,ZGEEVX)
-#define LAPACK_sgesvd LAPACK_GLOBAL(sgesvd,SGESVD)
-#define LAPACK_dgesvd LAPACK_GLOBAL(dgesvd,DGESVD)
-#define LAPACK_cgesvd LAPACK_GLOBAL(cgesvd,CGESVD)
-#define LAPACK_zgesvd LAPACK_GLOBAL(zgesvd,ZGESVD)
-#define LAPACK_sgesdd LAPACK_GLOBAL(sgesdd,SGESDD)
-#define LAPACK_dgesdd LAPACK_GLOBAL(dgesdd,DGESDD)
-#define LAPACK_cgesdd LAPACK_GLOBAL(cgesdd,CGESDD)
-#define LAPACK_zgesdd LAPACK_GLOBAL(zgesdd,ZGESDD)
-#define LAPACK_dgejsv LAPACK_GLOBAL(dgejsv,DGEJSV)
-#define LAPACK_sgejsv LAPACK_GLOBAL(sgejsv,SGEJSV)
-#define LAPACK_dgesvj LAPACK_GLOBAL(dgesvj,DGESVJ)
-#define LAPACK_sgesvj LAPACK_GLOBAL(sgesvj,SGESVJ)
-#define LAPACK_sggsvd LAPACK_GLOBAL(sggsvd,SGGSVD)
-#define LAPACK_dggsvd LAPACK_GLOBAL(dggsvd,DGGSVD)
-#define LAPACK_cggsvd LAPACK_GLOBAL(cggsvd,CGGSVD)
-#define LAPACK_zggsvd LAPACK_GLOBAL(zggsvd,ZGGSVD)
-#define LAPACK_ssygv LAPACK_GLOBAL(ssygv,SSYGV)
-#define LAPACK_dsygv LAPACK_GLOBAL(dsygv,DSYGV)
-#define LAPACK_chegv LAPACK_GLOBAL(chegv,CHEGV)
-#define LAPACK_zhegv LAPACK_GLOBAL(zhegv,ZHEGV)
-#define LAPACK_ssygvd LAPACK_GLOBAL(ssygvd,SSYGVD)
-#define LAPACK_dsygvd LAPACK_GLOBAL(dsygvd,DSYGVD)
-#define LAPACK_chegvd LAPACK_GLOBAL(chegvd,CHEGVD)
-#define LAPACK_zhegvd LAPACK_GLOBAL(zhegvd,ZHEGVD)
-#define LAPACK_ssygvx LAPACK_GLOBAL(ssygvx,SSYGVX)
-#define LAPACK_dsygvx LAPACK_GLOBAL(dsygvx,DSYGVX)
-#define LAPACK_chegvx LAPACK_GLOBAL(chegvx,CHEGVX)
-#define LAPACK_zhegvx LAPACK_GLOBAL(zhegvx,ZHEGVX)
-#define LAPACK_sspgv LAPACK_GLOBAL(sspgv,SSPGV)
-#define LAPACK_dspgv LAPACK_GLOBAL(dspgv,DSPGV)
-#define LAPACK_chpgv LAPACK_GLOBAL(chpgv,CHPGV)
-#define LAPACK_zhpgv LAPACK_GLOBAL(zhpgv,ZHPGV)
-#define LAPACK_sspgvd LAPACK_GLOBAL(sspgvd,SSPGVD)
-#define LAPACK_dspgvd LAPACK_GLOBAL(dspgvd,DSPGVD)
-#define LAPACK_chpgvd LAPACK_GLOBAL(chpgvd,CHPGVD)
-#define LAPACK_zhpgvd LAPACK_GLOBAL(zhpgvd,ZHPGVD)
-#define LAPACK_sspgvx LAPACK_GLOBAL(sspgvx,SSPGVX)
-#define LAPACK_dspgvx LAPACK_GLOBAL(dspgvx,DSPGVX)
-#define LAPACK_chpgvx LAPACK_GLOBAL(chpgvx,CHPGVX)
-#define LAPACK_zhpgvx LAPACK_GLOBAL(zhpgvx,ZHPGVX)
-#define LAPACK_ssbgv LAPACK_GLOBAL(ssbgv,SSBGV)
-#define LAPACK_dsbgv LAPACK_GLOBAL(dsbgv,DSBGV)
-#define LAPACK_chbgv LAPACK_GLOBAL(chbgv,CHBGV)
-#define LAPACK_zhbgv LAPACK_GLOBAL(zhbgv,ZHBGV)
-#define LAPACK_ssbgvd LAPACK_GLOBAL(ssbgvd,SSBGVD)
-#define LAPACK_dsbgvd LAPACK_GLOBAL(dsbgvd,DSBGVD)
-#define LAPACK_chbgvd LAPACK_GLOBAL(chbgvd,CHBGVD)
-#define LAPACK_zhbgvd LAPACK_GLOBAL(zhbgvd,ZHBGVD)
-#define LAPACK_ssbgvx LAPACK_GLOBAL(ssbgvx,SSBGVX)
-#define LAPACK_dsbgvx LAPACK_GLOBAL(dsbgvx,DSBGVX)
-#define LAPACK_chbgvx LAPACK_GLOBAL(chbgvx,CHBGVX)
-#define LAPACK_zhbgvx LAPACK_GLOBAL(zhbgvx,ZHBGVX)
-#define LAPACK_sgges LAPACK_GLOBAL(sgges,SGGES)
-#define LAPACK_dgges LAPACK_GLOBAL(dgges,DGGES)
-#define LAPACK_cgges LAPACK_GLOBAL(cgges,CGGES)
-#define LAPACK_zgges LAPACK_GLOBAL(zgges,ZGGES)
-#define LAPACK_sggesx LAPACK_GLOBAL(sggesx,SGGESX)
-#define LAPACK_dggesx LAPACK_GLOBAL(dggesx,DGGESX)
-#define LAPACK_cggesx LAPACK_GLOBAL(cggesx,CGGESX)
-#define LAPACK_zggesx LAPACK_GLOBAL(zggesx,ZGGESX)
-#define LAPACK_sggev LAPACK_GLOBAL(sggev,SGGEV)
-#define LAPACK_dggev LAPACK_GLOBAL(dggev,DGGEV)
-#define LAPACK_cggev LAPACK_GLOBAL(cggev,CGGEV)
-#define LAPACK_zggev LAPACK_GLOBAL(zggev,ZGGEV)
-#define LAPACK_sggevx LAPACK_GLOBAL(sggevx,SGGEVX)
-#define LAPACK_dggevx LAPACK_GLOBAL(dggevx,DGGEVX)
-#define LAPACK_cggevx LAPACK_GLOBAL(cggevx,CGGEVX)
-#define LAPACK_zggevx LAPACK_GLOBAL(zggevx,ZGGEVX)
-#define LAPACK_dsfrk LAPACK_GLOBAL(dsfrk,DSFRK)
-#define LAPACK_ssfrk LAPACK_GLOBAL(ssfrk,SSFRK)
-#define LAPACK_zhfrk LAPACK_GLOBAL(zhfrk,ZHFRK)
-#define LAPACK_chfrk LAPACK_GLOBAL(chfrk,CHFRK)
-#define LAPACK_dtfsm LAPACK_GLOBAL(dtfsm,DTFSM)
-#define LAPACK_stfsm LAPACK_GLOBAL(stfsm,STFSM)
-#define LAPACK_ztfsm LAPACK_GLOBAL(ztfsm,ZTFSM)
-#define LAPACK_ctfsm LAPACK_GLOBAL(ctfsm,CTFSM)
-#define LAPACK_dtfttp LAPACK_GLOBAL(dtfttp,DTFTTP)
-#define LAPACK_stfttp LAPACK_GLOBAL(stfttp,STFTTP)
-#define LAPACK_ztfttp LAPACK_GLOBAL(ztfttp,ZTFTTP)
-#define LAPACK_ctfttp LAPACK_GLOBAL(ctfttp,CTFTTP)
-#define LAPACK_dtfttr LAPACK_GLOBAL(dtfttr,DTFTTR)
-#define LAPACK_stfttr LAPACK_GLOBAL(stfttr,STFTTR)
-#define LAPACK_ztfttr LAPACK_GLOBAL(ztfttr,ZTFTTR)
-#define LAPACK_ctfttr LAPACK_GLOBAL(ctfttr,CTFTTR)
-#define LAPACK_dtpttf LAPACK_GLOBAL(dtpttf,DTPTTF)
-#define LAPACK_stpttf LAPACK_GLOBAL(stpttf,STPTTF)
-#define LAPACK_ztpttf LAPACK_GLOBAL(ztpttf,ZTPTTF)
-#define LAPACK_ctpttf LAPACK_GLOBAL(ctpttf,CTPTTF)
-#define LAPACK_dtpttr LAPACK_GLOBAL(dtpttr,DTPTTR)
-#define LAPACK_stpttr LAPACK_GLOBAL(stpttr,STPTTR)
-#define LAPACK_ztpttr LAPACK_GLOBAL(ztpttr,ZTPTTR)
-#define LAPACK_ctpttr LAPACK_GLOBAL(ctpttr,CTPTTR)
-#define LAPACK_dtrttf LAPACK_GLOBAL(dtrttf,DTRTTF)
-#define LAPACK_strttf LAPACK_GLOBAL(strttf,STRTTF)
-#define LAPACK_ztrttf LAPACK_GLOBAL(ztrttf,ZTRTTF)
-#define LAPACK_ctrttf LAPACK_GLOBAL(ctrttf,CTRTTF)
-#define LAPACK_dtrttp LAPACK_GLOBAL(dtrttp,DTRTTP)
-#define LAPACK_strttp LAPACK_GLOBAL(strttp,STRTTP)
-#define LAPACK_ztrttp LAPACK_GLOBAL(ztrttp,ZTRTTP)
-#define LAPACK_ctrttp LAPACK_GLOBAL(ctrttp,CTRTTP)
-#define LAPACK_sgeqrfp LAPACK_GLOBAL(sgeqrfp,SGEQRFP)
-#define LAPACK_dgeqrfp LAPACK_GLOBAL(dgeqrfp,DGEQRFP)
-#define LAPACK_cgeqrfp LAPACK_GLOBAL(cgeqrfp,CGEQRFP)
-#define LAPACK_zgeqrfp LAPACK_GLOBAL(zgeqrfp,ZGEQRFP)
-#define LAPACK_clacgv LAPACK_GLOBAL(clacgv,CLACGV)
-#define LAPACK_zlacgv LAPACK_GLOBAL(zlacgv,ZLACGV)
-#define LAPACK_slarnv LAPACK_GLOBAL(slarnv,SLARNV)
-#define LAPACK_dlarnv LAPACK_GLOBAL(dlarnv,DLARNV)
-#define LAPACK_clarnv LAPACK_GLOBAL(clarnv,CLARNV)
-#define LAPACK_zlarnv LAPACK_GLOBAL(zlarnv,ZLARNV)
-#define LAPACK_sgeqr2 LAPACK_GLOBAL(sgeqr2,SGEQR2)
-#define LAPACK_dgeqr2 LAPACK_GLOBAL(dgeqr2,DGEQR2)
-#define LAPACK_cgeqr2 LAPACK_GLOBAL(cgeqr2,CGEQR2)
-#define LAPACK_zgeqr2 LAPACK_GLOBAL(zgeqr2,ZGEQR2)
-#define LAPACK_slacpy LAPACK_GLOBAL(slacpy,SLACPY)
-#define LAPACK_dlacpy LAPACK_GLOBAL(dlacpy,DLACPY)
-#define LAPACK_clacpy LAPACK_GLOBAL(clacpy,CLACPY)
-#define LAPACK_zlacpy LAPACK_GLOBAL(zlacpy,ZLACPY)
-#define LAPACK_sgetf2 LAPACK_GLOBAL(sgetf2,SGETF2)
-#define LAPACK_dgetf2 LAPACK_GLOBAL(dgetf2,DGETF2)
-#define LAPACK_cgetf2 LAPACK_GLOBAL(cgetf2,CGETF2)
-#define LAPACK_zgetf2 LAPACK_GLOBAL(zgetf2,ZGETF2)
-#define LAPACK_slaswp LAPACK_GLOBAL(slaswp,SLASWP)
-#define LAPACK_dlaswp LAPACK_GLOBAL(dlaswp,DLASWP)
-#define LAPACK_claswp LAPACK_GLOBAL(claswp,CLASWP)
-#define LAPACK_zlaswp LAPACK_GLOBAL(zlaswp,ZLASWP)
-#define LAPACK_slange LAPACK_GLOBAL(slange,SLANGE)
-#define LAPACK_dlange LAPACK_GLOBAL(dlange,DLANGE)
-#define LAPACK_clange LAPACK_GLOBAL(clange,CLANGE)
-#define LAPACK_zlange LAPACK_GLOBAL(zlange,ZLANGE)
-#define LAPACK_clanhe LAPACK_GLOBAL(clanhe,CLANHE)
-#define LAPACK_zlanhe LAPACK_GLOBAL(zlanhe,ZLANHE)
-#define LAPACK_slansy LAPACK_GLOBAL(slansy,SLANSY)
-#define LAPACK_dlansy LAPACK_GLOBAL(dlansy,DLANSY)
-#define LAPACK_clansy LAPACK_GLOBAL(clansy,CLANSY)
-#define LAPACK_zlansy LAPACK_GLOBAL(zlansy,ZLANSY)
-#define LAPACK_slantr LAPACK_GLOBAL(slantr,SLANTR)
-#define LAPACK_dlantr LAPACK_GLOBAL(dlantr,DLANTR)
-#define LAPACK_clantr LAPACK_GLOBAL(clantr,CLANTR)
-#define LAPACK_zlantr LAPACK_GLOBAL(zlantr,ZLANTR)
-#define LAPACK_slamch LAPACK_GLOBAL(slamch,SLAMCH)
-#define LAPACK_dlamch LAPACK_GLOBAL(dlamch,DLAMCH)
-#define LAPACK_sgelq2 LAPACK_GLOBAL(sgelq2,SGELQ2)
-#define LAPACK_dgelq2 LAPACK_GLOBAL(dgelq2,DGELQ2)
-#define LAPACK_cgelq2 LAPACK_GLOBAL(cgelq2,CGELQ2)
-#define LAPACK_zgelq2 LAPACK_GLOBAL(zgelq2,ZGELQ2)
-#define LAPACK_slarfb LAPACK_GLOBAL(slarfb,SLARFB)
-#define LAPACK_dlarfb LAPACK_GLOBAL(dlarfb,DLARFB)
-#define LAPACK_clarfb LAPACK_GLOBAL(clarfb,CLARFB)
-#define LAPACK_zlarfb LAPACK_GLOBAL(zlarfb,ZLARFB)
-#define LAPACK_slarfg LAPACK_GLOBAL(slarfg,SLARFG)
-#define LAPACK_dlarfg LAPACK_GLOBAL(dlarfg,DLARFG)
-#define LAPACK_clarfg LAPACK_GLOBAL(clarfg,CLARFG)
-#define LAPACK_zlarfg LAPACK_GLOBAL(zlarfg,ZLARFG)
-#define LAPACK_slarft LAPACK_GLOBAL(slarft,SLARFT)
-#define LAPACK_dlarft LAPACK_GLOBAL(dlarft,DLARFT)
-#define LAPACK_clarft LAPACK_GLOBAL(clarft,CLARFT)
-#define LAPACK_zlarft LAPACK_GLOBAL(zlarft,ZLARFT)
-#define LAPACK_slarfx LAPACK_GLOBAL(slarfx,SLARFX)
-#define LAPACK_dlarfx LAPACK_GLOBAL(dlarfx,DLARFX)
-#define LAPACK_clarfx LAPACK_GLOBAL(clarfx,CLARFX)
-#define LAPACK_zlarfx LAPACK_GLOBAL(zlarfx,ZLARFX)
-#define LAPACK_slatms LAPACK_GLOBAL(slatms,SLATMS)
-#define LAPACK_dlatms LAPACK_GLOBAL(dlatms,DLATMS)
-#define LAPACK_clatms LAPACK_GLOBAL(clatms,CLATMS)
-#define LAPACK_zlatms LAPACK_GLOBAL(zlatms,ZLATMS)
-#define LAPACK_slag2d LAPACK_GLOBAL(slag2d,SLAG2D)
-#define LAPACK_dlag2s LAPACK_GLOBAL(dlag2s,DLAG2S)
-#define LAPACK_clag2z LAPACK_GLOBAL(clag2z,CLAG2Z)
-#define LAPACK_zlag2c LAPACK_GLOBAL(zlag2c,ZLAG2C)
-#define LAPACK_slauum LAPACK_GLOBAL(slauum,SLAUUM)
-#define LAPACK_dlauum LAPACK_GLOBAL(dlauum,DLAUUM)
-#define LAPACK_clauum LAPACK_GLOBAL(clauum,CLAUUM)
-#define LAPACK_zlauum LAPACK_GLOBAL(zlauum,ZLAUUM)
-#define LAPACK_slagge LAPACK_GLOBAL(slagge,SLAGGE)
-#define LAPACK_dlagge LAPACK_GLOBAL(dlagge,DLAGGE)
-#define LAPACK_clagge LAPACK_GLOBAL(clagge,CLAGGE)
-#define LAPACK_zlagge LAPACK_GLOBAL(zlagge,ZLAGGE)
-#define LAPACK_slaset LAPACK_GLOBAL(slaset,SLASET)
-#define LAPACK_dlaset LAPACK_GLOBAL(dlaset,DLASET)
-#define LAPACK_claset LAPACK_GLOBAL(claset,CLASET)
-#define LAPACK_zlaset LAPACK_GLOBAL(zlaset,ZLASET)
-#define LAPACK_slasrt LAPACK_GLOBAL(slasrt,SLASRT)
-#define LAPACK_dlasrt LAPACK_GLOBAL(dlasrt,DLASRT)
-#define LAPACK_slagsy LAPACK_GLOBAL(slagsy,SLAGSY)
-#define LAPACK_dlagsy LAPACK_GLOBAL(dlagsy,DLAGSY)
-#define LAPACK_clagsy LAPACK_GLOBAL(clagsy,CLAGSY)
-#define LAPACK_zlagsy LAPACK_GLOBAL(zlagsy,ZLAGSY)
-#define LAPACK_claghe LAPACK_GLOBAL(claghe,CLAGHE)
-#define LAPACK_zlaghe LAPACK_GLOBAL(zlaghe,ZLAGHE)
-#define LAPACK_slapmr LAPACK_GLOBAL(slapmr,SLAPMR)
-#define LAPACK_dlapmr LAPACK_GLOBAL(dlapmr,DLAPMR)
-#define LAPACK_clapmr LAPACK_GLOBAL(clapmr,CLAPMR)
-#define LAPACK_zlapmr LAPACK_GLOBAL(zlapmr,ZLAPMR)
-#define LAPACK_slapy2 LAPACK_GLOBAL(slapy2,SLAPY2)
-#define LAPACK_dlapy2 LAPACK_GLOBAL(dlapy2,DLAPY2)
-#define LAPACK_slapy3 LAPACK_GLOBAL(slapy3,SLAPY3)
-#define LAPACK_dlapy3 LAPACK_GLOBAL(dlapy3,DLAPY3)
-#define LAPACK_slartgp LAPACK_GLOBAL(slartgp,SLARTGP)
-#define LAPACK_dlartgp LAPACK_GLOBAL(dlartgp,DLARTGP)
-#define LAPACK_slartgs LAPACK_GLOBAL(slartgs,SLARTGS)
-#define LAPACK_dlartgs LAPACK_GLOBAL(dlartgs,DLARTGS)
-// LAPACK 3.3.0
-#define LAPACK_cbbcsd LAPACK_GLOBAL(cbbcsd,CBBCSD)
-#define LAPACK_cheswapr LAPACK_GLOBAL(cheswapr,CHESWAPR)
-#define LAPACK_chetri2 LAPACK_GLOBAL(chetri2,CHETRI2)
-#define LAPACK_chetri2x LAPACK_GLOBAL(chetri2x,CHETRI2X)
-#define LAPACK_chetrs2 LAPACK_GLOBAL(chetrs2,CHETRS2)
-#define LAPACK_csyconv LAPACK_GLOBAL(csyconv,CSYCONV)
-#define LAPACK_csyswapr LAPACK_GLOBAL(csyswapr,CSYSWAPR)
-#define LAPACK_csytri2 LAPACK_GLOBAL(csytri2,CSYTRI2)
-#define LAPACK_csytri2x LAPACK_GLOBAL(csytri2x,CSYTRI2X)
-#define LAPACK_csytrs2 LAPACK_GLOBAL(csytrs2,CSYTRS2)
-#define LAPACK_cunbdb LAPACK_GLOBAL(cunbdb,CUNBDB)
-#define LAPACK_cuncsd LAPACK_GLOBAL(cuncsd,CUNCSD)
-#define LAPACK_dbbcsd LAPACK_GLOBAL(dbbcsd,DBBCSD)
-#define LAPACK_dorbdb LAPACK_GLOBAL(dorbdb,DORBDB)
-#define LAPACK_dorcsd LAPACK_GLOBAL(dorcsd,DORCSD)
-#define LAPACK_dsyconv LAPACK_GLOBAL(dsyconv,DSYCONV)
-#define LAPACK_dsyswapr LAPACK_GLOBAL(dsyswapr,DSYSWAPR)
-#define LAPACK_dsytri2 LAPACK_GLOBAL(dsytri2,DSYTRI2)
-#define LAPACK_dsytri2x LAPACK_GLOBAL(dsytri2x,DSYTRI2X)
-#define LAPACK_dsytrs2 LAPACK_GLOBAL(dsytrs2,DSYTRS2)
-#define LAPACK_sbbcsd LAPACK_GLOBAL(sbbcsd,SBBCSD)
-#define LAPACK_sorbdb LAPACK_GLOBAL(sorbdb,SORBDB)
-#define LAPACK_sorcsd LAPACK_GLOBAL(sorcsd,SORCSD)
-#define LAPACK_ssyconv LAPACK_GLOBAL(ssyconv,SSYCONV)
-#define LAPACK_ssyswapr LAPACK_GLOBAL(ssyswapr,SSYSWAPR)
-#define LAPACK_ssytri2 LAPACK_GLOBAL(ssytri2,SSYTRI2)
-#define LAPACK_ssytri2x LAPACK_GLOBAL(ssytri2x,SSYTRI2X)
-#define LAPACK_ssytrs2 LAPACK_GLOBAL(ssytrs2,SSYTRS2)
-#define LAPACK_zbbcsd LAPACK_GLOBAL(zbbcsd,ZBBCSD)
-#define LAPACK_zheswapr LAPACK_GLOBAL(zheswapr,ZHESWAPR)
-#define LAPACK_zhetri2 LAPACK_GLOBAL(zhetri2,ZHETRI2)
-#define LAPACK_zhetri2x LAPACK_GLOBAL(zhetri2x,ZHETRI2X)
-#define LAPACK_zhetrs2 LAPACK_GLOBAL(zhetrs2,ZHETRS2)
-#define LAPACK_zsyconv LAPACK_GLOBAL(zsyconv,ZSYCONV)
-#define LAPACK_zsyswapr LAPACK_GLOBAL(zsyswapr,ZSYSWAPR)
-#define LAPACK_zsytri2 LAPACK_GLOBAL(zsytri2,ZSYTRI2)
-#define LAPACK_zsytri2x LAPACK_GLOBAL(zsytri2x,ZSYTRI2X)
-#define LAPACK_zsytrs2 LAPACK_GLOBAL(zsytrs2,ZSYTRS2)
-#define LAPACK_zunbdb LAPACK_GLOBAL(zunbdb,ZUNBDB)
-#define LAPACK_zuncsd LAPACK_GLOBAL(zuncsd,ZUNCSD)
-// LAPACK 3.4.0
-#define LAPACK_sgemqrt LAPACK_GLOBAL(sgemqrt,SGEMQRT)
-#define LAPACK_dgemqrt LAPACK_GLOBAL(dgemqrt,DGEMQRT)
-#define LAPACK_cgemqrt LAPACK_GLOBAL(cgemqrt,CGEMQRT)
-#define LAPACK_zgemqrt LAPACK_GLOBAL(zgemqrt,ZGEMQRT)
-#define LAPACK_sgeqrt LAPACK_GLOBAL(sgeqrt,SGEQRT)
-#define LAPACK_dgeqrt LAPACK_GLOBAL(dgeqrt,DGEQRT)
-#define LAPACK_cgeqrt LAPACK_GLOBAL(cgeqrt,CGEQRT)
-#define LAPACK_zgeqrt LAPACK_GLOBAL(zgeqrt,ZGEQRT)
-#define LAPACK_sgeqrt2 LAPACK_GLOBAL(sgeqrt2,SGEQRT2)
-#define LAPACK_dgeqrt2 LAPACK_GLOBAL(dgeqrt2,DGEQRT2)
-#define LAPACK_cgeqrt2 LAPACK_GLOBAL(cgeqrt2,CGEQRT2)
-#define LAPACK_zgeqrt2 LAPACK_GLOBAL(zgeqrt2,ZGEQRT2)
-#define LAPACK_sgeqrt3 LAPACK_GLOBAL(sgeqrt3,SGEQRT3)
-#define LAPACK_dgeqrt3 LAPACK_GLOBAL(dgeqrt3,DGEQRT3)
-#define LAPACK_cgeqrt3 LAPACK_GLOBAL(cgeqrt3,CGEQRT3)
-#define LAPACK_zgeqrt3 LAPACK_GLOBAL(zgeqrt3,ZGEQRT3)
-#define LAPACK_stpmqrt LAPACK_GLOBAL(stpmqrt,STPMQRT)
-#define LAPACK_dtpmqrt LAPACK_GLOBAL(dtpmqrt,DTPMQRT)
-#define LAPACK_ctpmqrt LAPACK_GLOBAL(ctpmqrt,CTPMQRT)
-#define LAPACK_ztpmqrt LAPACK_GLOBAL(ztpmqrt,ZTPMQRT)
-#define LAPACK_dtpqrt LAPACK_GLOBAL(dtpqrt,DTPQRT)
-#define LAPACK_ctpqrt LAPACK_GLOBAL(ctpqrt,CTPQRT)
-#define LAPACK_ztpqrt LAPACK_GLOBAL(ztpqrt,ZTPQRT)
-#define LAPACK_stpqrt2 LAPACK_GLOBAL(stpqrt2,STPQRT2)
-#define LAPACK_dtpqrt2 LAPACK_GLOBAL(dtpqrt2,DTPQRT2)
-#define LAPACK_ctpqrt2 LAPACK_GLOBAL(ctpqrt2,CTPQRT2)
-#define LAPACK_ztpqrt2 LAPACK_GLOBAL(ztpqrt2,ZTPQRT2)
-#define LAPACK_stprfb LAPACK_GLOBAL(stprfb,STPRFB)
-#define LAPACK_dtprfb LAPACK_GLOBAL(dtprfb,DTPRFB)
-#define LAPACK_ctprfb LAPACK_GLOBAL(ctprfb,CTPRFB)
-#define LAPACK_ztprfb LAPACK_GLOBAL(ztprfb,ZTPRFB)
-// LAPACK 3.X.X
-#define LAPACK_csyr LAPACK_GLOBAL(csyr,CSYR)
-#define LAPACK_zsyr LAPACK_GLOBAL(zsyr,ZSYR)
-#define LAPACK_ilaver LAPACK_GLOBAL(ilaver,ILAVER)
-
-void LAPACK_sgetrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgetrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgetrf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_zgetrf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_sgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, float* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, double* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_complex_float* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_zgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_complex_double* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_sgttrf( lapack_int* n, float* dl, float* d, float* du, float* du2,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgttrf( lapack_int* n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgttrf( lapack_int* n, lapack_complex_float* dl,
- lapack_complex_float* d, lapack_complex_float* du,
- lapack_complex_float* du2, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_zgttrf( lapack_int* n, lapack_complex_double* dl,
- lapack_complex_double* d, lapack_complex_double* du,
- lapack_complex_double* du2, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_spotrf( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dpotrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_cpotrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_zpotrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dpstrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* piv, lapack_int* rank, double* tol,
- double* work, lapack_int *info );
-void LAPACK_spstrf( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* piv, lapack_int* rank, float* tol, float* work,
- lapack_int *info );
-void LAPACK_zpstrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* piv, lapack_int* rank,
- double* tol, double* work, lapack_int *info );
-void LAPACK_cpstrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* piv, lapack_int* rank,
- float* tol, float* work, lapack_int *info );
-void LAPACK_dpftrf( char* transr, char* uplo, lapack_int* n, double* a,
- lapack_int *info );
-void LAPACK_spftrf( char* transr, char* uplo, lapack_int* n, float* a,
- lapack_int *info );
-void LAPACK_zpftrf( char* transr, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int *info );
-void LAPACK_cpftrf( char* transr, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int *info );
-void LAPACK_spptrf( char* uplo, lapack_int* n, float* ap, lapack_int *info );
-void LAPACK_dpptrf( char* uplo, lapack_int* n, double* ap, lapack_int *info );
-void LAPACK_cpptrf( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_zpptrf( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_spbtrf( char* uplo, lapack_int* n, lapack_int* kd, float* ab,
- lapack_int* ldab, lapack_int *info );
-void LAPACK_dpbtrf( char* uplo, lapack_int* n, lapack_int* kd, double* ab,
- lapack_int* ldab, lapack_int *info );
-void LAPACK_cpbtrf( char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab,
- lapack_int *info );
-void LAPACK_zpbtrf( char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab,
- lapack_int *info );
-void LAPACK_spttrf( lapack_int* n, float* d, float* e, lapack_int *info );
-void LAPACK_dpttrf( lapack_int* n, double* d, double* e, lapack_int *info );
-void LAPACK_cpttrf( lapack_int* n, float* d, lapack_complex_float* e,
- lapack_int *info );
-void LAPACK_zpttrf( lapack_int* n, double* d, lapack_complex_double* e,
- lapack_int *info );
-void LAPACK_ssytrf( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ipiv, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dsytrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ipiv, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_csytrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zsytrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chetrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zhetrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ssptrf( char* uplo, lapack_int* n, float* ap, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_dsptrf( char* uplo, lapack_int* n, double* ap, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_csptrf( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_zsptrf( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_chptrf( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_zhptrf( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_sgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const lapack_int* ipiv,
- float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const lapack_int* ipiv,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const float* ab, lapack_int* ldab,
- const lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const double* ab, lapack_int* ldab,
- const lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_float* ab,
- lapack_int* ldab, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_double* ab,
- lapack_int* ldab, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* dl, const float* d, const float* du,
- const float* du2, const lapack_int* ipiv, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* dl, const double* d, const double* du,
- const double* du2, const lapack_int* ipiv, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spotrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpotrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cpotrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zpotrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* a, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_spptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cpptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zpptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_spbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const float* ab, lapack_int* ldab, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const double* ab, lapack_int* ldab, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spttrs( lapack_int* n, lapack_int* nrhs, const float* d,
- const float* e, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpttrs( lapack_int* n, lapack_int* nrhs, const double* d,
- const double* e, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cpttrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* d,
- const lapack_complex_float* e, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zpttrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* d, const lapack_complex_double* e,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ssytrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, const lapack_int* ipiv, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dsytrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const lapack_int* ipiv,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_csytrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zsytrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_chetrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zhetrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_ssptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, const lapack_int* ipiv, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dsptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, const lapack_int* ipiv, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_csptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zsptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_chptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zhptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_strtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* a, lapack_int* lda, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dtrtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* a, lapack_int* lda,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_ctrtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ztrtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_stptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* ap, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dtptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* ap, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_ctptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ztptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_stbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const float* ab,
- lapack_int* ldab, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dtbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const double* ab,
- lapack_int* ldab, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ctbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ztbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sgecon( char* norm, lapack_int* n, const float* a, lapack_int* lda,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgecon( char* norm, lapack_int* n, const double* a, lapack_int* lda,
- double* anorm, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgecon( char* norm, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* anorm, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgecon( char* norm, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* anorm, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const float* ab, lapack_int* ldab, const lapack_int* ipiv,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const double* ab, lapack_int* ldab, const lapack_int* ipiv,
- double* anorm, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_int* ipiv, float* anorm, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_int* ipiv, double* anorm, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgtcon( char* norm, lapack_int* n, const float* dl, const float* d,
- const float* du, const float* du2, const lapack_int* ipiv,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgtcon( char* norm, lapack_int* n, const double* dl,
- const double* d, const double* du, const double* du2,
- const lapack_int* ipiv, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgtcon( char* norm, lapack_int* n, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2, const lapack_int* ipiv,
- float* anorm, float* rcond, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zgtcon( char* norm, lapack_int* n, const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2, const lapack_int* ipiv,
- double* anorm, double* rcond, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_spocon( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dpocon( char* uplo, lapack_int* n, const double* a, lapack_int* lda,
- double* anorm, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cpocon( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* anorm, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zpocon( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* anorm, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sppcon( char* uplo, lapack_int* n, const float* ap, float* anorm,
- float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dppcon( char* uplo, lapack_int* n, const double* ap, double* anorm,
- double* rcond, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cppcon( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- float* anorm, float* rcond, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zppcon( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- double* anorm, double* rcond, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_spbcon( char* uplo, lapack_int* n, lapack_int* kd, const float* ab,
- lapack_int* ldab, float* anorm, float* rcond, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dpbcon( char* uplo, lapack_int* n, lapack_int* kd, const double* ab,
- lapack_int* ldab, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cpbcon( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_float* ab, lapack_int* ldab,
- float* anorm, float* rcond, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zpbcon( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_double* ab, lapack_int* ldab,
- double* anorm, double* rcond, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sptcon( lapack_int* n, const float* d, const float* e, float* anorm,
- float* rcond, float* work, lapack_int *info );
-void LAPACK_dptcon( lapack_int* n, const double* d, const double* e,
- double* anorm, double* rcond, double* work,
- lapack_int *info );
-void LAPACK_cptcon( lapack_int* n, const float* d,
- const lapack_complex_float* e, float* anorm, float* rcond,
- float* work, lapack_int *info );
-void LAPACK_zptcon( lapack_int* n, const double* d,
- const lapack_complex_double* e, double* anorm,
- double* rcond, double* work, lapack_int *info );
-void LAPACK_ssycon( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- const lapack_int* ipiv, float* anorm, float* rcond,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dsycon( char* uplo, lapack_int* n, const double* a, lapack_int* lda,
- const lapack_int* ipiv, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_csycon( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv, float* anorm,
- float* rcond, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zsycon( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv, double* anorm,
- double* rcond, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_checon( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv, float* anorm,
- float* rcond, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zhecon( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv, double* anorm,
- double* rcond, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_sspcon( char* uplo, lapack_int* n, const float* ap,
- const lapack_int* ipiv, float* anorm, float* rcond,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dspcon( char* uplo, lapack_int* n, const double* ap,
- const lapack_int* ipiv, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cspcon( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- const lapack_int* ipiv, float* anorm, float* rcond,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zspcon( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- const lapack_int* ipiv, double* anorm, double* rcond,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_chpcon( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- const lapack_int* ipiv, float* anorm, float* rcond,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zhpcon( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- const lapack_int* ipiv, double* anorm, double* rcond,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_strcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const float* a, lapack_int* lda, float* rcond, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtrcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const double* a, lapack_int* lda, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_ctrcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- float* rcond, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztrcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- double* rcond, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const float* ap, float* rcond, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const double* ap, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_float* ap, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_double* ap, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const float* ab, lapack_int* ldab,
- float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dtbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const double* ab, lapack_int* ldab,
- double* rcond, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const lapack_complex_float* ab,
- lapack_int* ldab, float* rcond, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_ztbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const lapack_complex_double* ab,
- lapack_int* ldab, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const lapack_int* ipiv, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* r,
- const double* c, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const lapack_int* ipiv, const float* r,
- const float* c, const float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const double* r, const double* c,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* r, const float* c,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const float* ab, lapack_int* ldab,
- const float* afb, lapack_int* ldafb, const lapack_int* ipiv,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const double* ab, lapack_int* ldab,
- const double* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_float* ab,
- lapack_int* ldab, const lapack_complex_float* afb,
- lapack_int* ldafb, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_double* ab,
- lapack_int* ldab, const lapack_complex_double* afb,
- lapack_int* ldafb, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_dgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, const double* ab,
- lapack_int* ldab, const double* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const double* r, const double* c,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, const float* ab,
- lapack_int* ldab, const float* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const float* r, const float* c,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const double* r, const double* c,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const float* r, const float* c,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* dl, const float* d, const float* du,
- const float* dlf, const float* df, const float* duf,
- const float* du2, const lapack_int* ipiv, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* dl, const double* d, const double* du,
- const double* dlf, const double* df, const double* duf,
- const double* du2, const lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* dlf,
- const lapack_complex_float* df,
- const lapack_complex_float* duf,
- const lapack_complex_float* du2, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* dlf,
- const lapack_complex_double* df,
- const lapack_complex_double* duf,
- const lapack_complex_double* du2, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sporfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, const float* af, lapack_int* ldaf,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dporfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cporfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zporfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_dporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const double* s, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_sporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const float* s, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const double* s, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const float* s, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_spprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, const float* afp, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dpprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, const double* afp, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cpprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zpprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_spbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const float* ab, lapack_int* ldab, const float* afb,
- lapack_int* ldafb, const float* b, lapack_int* ldb,
- float* x, lapack_int* ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const double* ab, lapack_int* ldab, const double* afb,
- lapack_int* ldafb, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* afb, lapack_int* ldafb,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* afb, lapack_int* ldafb,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sptrfs( lapack_int* n, lapack_int* nrhs, const float* d,
- const float* e, const float* df, const float* ef,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int *info );
-void LAPACK_dptrfs( lapack_int* n, lapack_int* nrhs, const double* d,
- const double* e, const double* df, const double* ef,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* ferr, double* berr, double* work,
- lapack_int *info );
-void LAPACK_cptrfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* d,
- const lapack_complex_float* e, const float* df,
- const lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zptrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* d, const lapack_complex_double* e,
- const double* df, const lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssyrfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, const float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* b, lapack_int* ldb,
- float* x, lapack_int* ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dsyrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_csyrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zsyrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dsyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* s,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_ssyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const lapack_int* ipiv, const float* s,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zsyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_csyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_cherfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zherfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_zherfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cherfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ssprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, const float* afp, const lapack_int* ipiv,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dsprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, const double* afp, const lapack_int* ipiv,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_csprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* afp, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zsprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_chprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* afp, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_strrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* a, lapack_int* lda,
- const float* b, lapack_int* ldb, const float* x,
- lapack_int* ldx, float* ferr, float* berr, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtrrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* a, lapack_int* lda,
- const double* b, lapack_int* ldb, const double* x,
- lapack_int* ldx, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctrrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* b,
- lapack_int* ldb, const lapack_complex_float* x,
- lapack_int* ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztrrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* b,
- lapack_int* ldb, const lapack_complex_double* x,
- lapack_int* ldx, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* ap, const float* b,
- lapack_int* ldb, const float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dtprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* ap, const double* b,
- lapack_int* ldb, const double* x, lapack_int* ldx,
- double* ferr, double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* b, lapack_int* ldb,
- const lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* b, lapack_int* ldb,
- const lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_stbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const float* ab,
- lapack_int* ldab, const float* b, lapack_int* ldb,
- const float* x, lapack_int* ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dtbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const double* ab,
- lapack_int* ldab, const double* b, lapack_int* ldb,
- const double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* b, lapack_int* ldb,
- const lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* b, lapack_int* ldb,
- const lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sgetri( lapack_int* n, float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgetri( lapack_int* n, double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgetri( lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zgetri( lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_spotri( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dpotri( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_cpotri( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_zpotri( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dpftri( char* transr, char* uplo, lapack_int* n, double* a,
- lapack_int *info );
-void LAPACK_spftri( char* transr, char* uplo, lapack_int* n, float* a,
- lapack_int *info );
-void LAPACK_zpftri( char* transr, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int *info );
-void LAPACK_cpftri( char* transr, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int *info );
-void LAPACK_spptri( char* uplo, lapack_int* n, float* ap, lapack_int *info );
-void LAPACK_dpptri( char* uplo, lapack_int* n, double* ap, lapack_int *info );
-void LAPACK_cpptri( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_zpptri( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_ssytri( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work, lapack_int *info );
-void LAPACK_dsytri( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work, lapack_int *info );
-void LAPACK_csytri( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zsytri( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_chetri( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zhetri( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_ssptri( char* uplo, lapack_int* n, float* ap,
- const lapack_int* ipiv, float* work, lapack_int *info );
-void LAPACK_dsptri( char* uplo, lapack_int* n, double* ap,
- const lapack_int* ipiv, double* work, lapack_int *info );
-void LAPACK_csptri( char* uplo, lapack_int* n, lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zsptri( char* uplo, lapack_int* n, lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_chptri( char* uplo, lapack_int* n, lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zhptri( char* uplo, lapack_int* n, lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_strtri( char* uplo, char* diag, lapack_int* n, float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dtrtri( char* uplo, char* diag, lapack_int* n, double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_ctrtri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_ztrtri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dtftri( char* transr, char* uplo, char* diag, lapack_int* n,
- double* a, lapack_int *info );
-void LAPACK_stftri( char* transr, char* uplo, char* diag, lapack_int* n,
- float* a, lapack_int *info );
-void LAPACK_ztftri( char* transr, char* uplo, char* diag, lapack_int* n,
- lapack_complex_double* a, lapack_int *info );
-void LAPACK_ctftri( char* transr, char* uplo, char* diag, lapack_int* n,
- lapack_complex_float* a, lapack_int *info );
-void LAPACK_stptri( char* uplo, char* diag, lapack_int* n, float* ap,
- lapack_int *info );
-void LAPACK_dtptri( char* uplo, char* diag, lapack_int* n, double* ap,
- lapack_int *info );
-void LAPACK_ctptri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_float* ap, lapack_int *info );
-void LAPACK_ztptri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_double* ap, lapack_int *info );
-void LAPACK_sgeequ( lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_dgeequ( lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_cgeequ( lapack_int* m, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_zgeequ( lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* r,
- double* c, double* rowcnd, double* colcnd, double* amax,
- lapack_int *info );
-void LAPACK_dgeequb( lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_sgeequb( lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_zgeequb( lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* r,
- double* c, double* rowcnd, double* colcnd, double* amax,
- lapack_int *info );
-void LAPACK_cgeequb( lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* r,
- float* c, float* rowcnd, float* colcnd, float* amax,
- lapack_int *info );
-void LAPACK_sgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* ab, lapack_int* ldab, float* r,
- float* c, float* rowcnd, float* colcnd, float* amax,
- lapack_int *info );
-void LAPACK_dgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* ab, lapack_int* ldab,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax, lapack_int *info );
-void LAPACK_cgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_float* ab,
- lapack_int* ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_zgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_double* ab,
- lapack_int* ldab, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_dgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* ab, lapack_int* ldab,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax, lapack_int *info );
-void LAPACK_sgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* ab, lapack_int* ldab,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax, lapack_int *info );
-void LAPACK_zgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_double* ab,
- lapack_int* ldab, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_cgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_float* ab,
- lapack_int* ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_spoequ( lapack_int* n, const float* a, lapack_int* lda, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_dpoequ( lapack_int* n, const double* a, lapack_int* lda, double* s,
- double* scond, double* amax, lapack_int *info );
-void LAPACK_cpoequ( lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_int *info );
-void LAPACK_zpoequ( lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_int *info );
-void LAPACK_dpoequb( lapack_int* n, const double* a, lapack_int* lda, double* s,
- double* scond, double* amax, lapack_int *info );
-void LAPACK_spoequb( lapack_int* n, const float* a, lapack_int* lda, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_zpoequb( lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_int *info );
-void LAPACK_cpoequb( lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_int *info );
-void LAPACK_sppequ( char* uplo, lapack_int* n, const float* ap, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_dppequ( char* uplo, lapack_int* n, const double* ap, double* s,
- double* scond, double* amax, lapack_int *info );
-void LAPACK_cppequ( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- float* s, float* scond, float* amax, lapack_int *info );
-void LAPACK_zppequ( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- double* s, double* scond, double* amax, lapack_int *info );
-void LAPACK_spbequ( char* uplo, lapack_int* n, lapack_int* kd, const float* ab,
- lapack_int* ldab, float* s, float* scond, float* amax,
- lapack_int *info );
-void LAPACK_dpbequ( char* uplo, lapack_int* n, lapack_int* kd, const double* ab,
- lapack_int* ldab, double* s, double* scond, double* amax,
- lapack_int *info );
-void LAPACK_cpbequ( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_float* ab, lapack_int* ldab, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_zpbequ( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_double* ab, lapack_int* ldab,
- double* s, double* scond, double* amax, lapack_int *info );
-void LAPACK_dsyequb( char* uplo, lapack_int* n, const double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- double* work, lapack_int *info );
-void LAPACK_ssyequb( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- float* s, float* scond, float* amax, float* work,
- lapack_int *info );
-void LAPACK_zsyequb( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_csyequb( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zheequb( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_cheequb( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_sgesv( lapack_int* n, lapack_int* nrhs, float* a, lapack_int* lda,
- lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda,
- lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dsgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda,
- lapack_int* ipiv, double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* work, float* swork,
- lapack_int* iter, lapack_int *info );
-void LAPACK_zcgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- lapack_complex_double* work, lapack_complex_float* swork,
- double* rwork, lapack_int* iter, lapack_int *info );
-void LAPACK_sgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, float* ab, lapack_int* ldab,
- lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, double* ab, lapack_int* ldab,
- lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, lapack_complex_float* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, lapack_complex_double* ab,
- lapack_int* ldab, lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, float* ab,
- lapack_int* ldab, float* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, float* r, float* c, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, double* ab,
- lapack_int* ldab, double* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* afb,
- lapack_int* ldafb, lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, lapack_complex_double* ab,
- lapack_int* ldab, lapack_complex_double* afb,
- lapack_int* ldafb, lapack_int* ipiv, char* equed, double* r,
- double* c, lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, double* ab,
- lapack_int* ldab, double* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, float* ab,
- lapack_int* ldab, float* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs,
- lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* afb,
- lapack_int* ldafb, lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgtsv( lapack_int* n, lapack_int* nrhs, float* dl, float* d,
- float* du, float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dgtsv( lapack_int* n, lapack_int* nrhs, double* dl, double* d,
- double* du, double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cgtsv( lapack_int* n, lapack_int* nrhs, lapack_complex_float* dl,
- lapack_complex_float* d, lapack_complex_float* du,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zgtsv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* dl,
- lapack_complex_double* d, lapack_complex_double* du,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const float* dl, const float* d, const float* du,
- float* dlf, float* df, float* duf, float* du2,
- lapack_int* ipiv, const float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const double* dl, const double* d, const double* du,
- double* dlf, double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du, lapack_complex_float* dlf,
- lapack_complex_float* df, lapack_complex_float* duf,
- lapack_complex_float* du2, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du, lapack_complex_double* dlf,
- lapack_complex_double* df, lapack_complex_double* duf,
- lapack_complex_double* du2, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sposv( char* uplo, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dposv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cposv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zposv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dsposv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* work, float* swork,
- lapack_int* iter, lapack_int *info );
-void LAPACK_zcposv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx,
- lapack_complex_double* work, lapack_complex_float* swork,
- double* rwork, lapack_int* iter, lapack_int *info );
-void LAPACK_sposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- char* equed, float* s, float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- char* equed, double* s, double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf, char* equed,
- float* s, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf, char* equed,
- double* s, lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- char* equed, double* s, double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_sposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- char* equed, float* s, float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* rpvgrw, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf, char* equed,
- double* s, lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf, char* equed,
- float* s, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sppsv( char* uplo, lapack_int* n, lapack_int* nrhs, float* ap,
- float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dppsv( char* uplo, lapack_int* n, lapack_int* nrhs, double* ap,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cppsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zppsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* ap, float* afp, char* equed, float* s, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* ap, double* afp, char* equed, double* s, double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_complex_float* afp,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_complex_double* afp,
- char* equed, double* s, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_spbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- float* ab, lapack_int* ldab, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- double* ab, lapack_int* ldab, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, float* ab, lapack_int* ldab, float* afb,
- lapack_int* ldafb, char* equed, float* s, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, double* ab, lapack_int* ldab, double* afb,
- lapack_int* ldafb, char* equed, double* s, double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* afb,
- lapack_int* ldafb, char* equed, float* s,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, lapack_complex_double* ab,
- lapack_int* ldab, lapack_complex_double* afb,
- lapack_int* ldafb, char* equed, double* s,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sptsv( lapack_int* n, lapack_int* nrhs, float* d, float* e,
- float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dptsv( lapack_int* n, lapack_int* nrhs, double* d, double* e,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cptsv( lapack_int* n, lapack_int* nrhs, float* d,
- lapack_complex_float* e, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zptsv( lapack_int* n, lapack_int* nrhs, double* d,
- lapack_complex_double* e, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sptsvx( char* fact, lapack_int* n, lapack_int* nrhs, const float* d,
- const float* e, float* df, float* ef, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int *info );
-void LAPACK_dptsvx( char* fact, lapack_int* n, lapack_int* nrhs,
- const double* d, const double* e, double* df, double* ef,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* ferr, double* berr,
- double* work, lapack_int *info );
-void LAPACK_cptsvx( char* fact, lapack_int* n, lapack_int* nrhs, const float* d,
- const lapack_complex_float* e, float* df,
- lapack_complex_float* ef, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zptsvx( char* fact, lapack_int* n, lapack_int* nrhs,
- const double* d, const lapack_complex_double* e, double* df,
- lapack_complex_double* ef, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssysv( char* uplo, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, lapack_int* ipiv, float* b, lapack_int* ldb,
- float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dsysv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, lapack_int* ipiv, double* b,
- lapack_int* ldb, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_csysv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zsysv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ssysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, float* af,
- lapack_int* ldaf, lapack_int* ipiv, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dsysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, double* af,
- lapack_int* ldaf, lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_csysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zsysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_dsysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* s, double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ssysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* s, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zsysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_csysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_chesv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zhesv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chesvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zhesvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_zhesvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_chesvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sspsv( char* uplo, lapack_int* n, lapack_int* nrhs, float* ap,
- lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dspsv( char* uplo, lapack_int* n, lapack_int* nrhs, double* ap,
- lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cspsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zspsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, float* afp, lapack_int* ipiv,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, double* afp, lapack_int* ipiv,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, lapack_complex_float* afp,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, lapack_complex_double* afp,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_chpsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zhpsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_chpsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, lapack_complex_float* afp,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhpsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, lapack_complex_double* afp,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgeqrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgeqrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgeqrf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgeqrf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgeqpf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* jpvt, float* tau, float* work,
- lapack_int *info );
-void LAPACK_dgeqpf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* jpvt, double* tau, double* work,
- lapack_int *info );
-void LAPACK_cgeqpf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_float* tau, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgeqpf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_double* tau, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sgeqp3( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* jpvt, float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgeqp3( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* jpvt, double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgeqp3( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int *info );
-void LAPACK_zgeqp3( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int *info );
-void LAPACK_sorgqr( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgqr( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungqr( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungqr( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgelqf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgelqf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgelqf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgelqf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sorglq( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorglq( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cunglq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zunglq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgeqlf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgeqlf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgeqlf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgeqlf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sorgql( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgql( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungql( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungql( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cunmql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgerqf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgerqf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgerqf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgerqf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sorgrq( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgrq( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungrq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungrq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cunmrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_stzrzf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dtzrzf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ctzrzf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ztzrzf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, const float* a,
- lapack_int* lda, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dormrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, const double* a,
- lapack_int* lda, const double* tau, double* c,
- lapack_int* ldc, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sggqrf( lapack_int* n, lapack_int* m, lapack_int* p, float* a,
- lapack_int* lda, float* taua, float* b, lapack_int* ldb,
- float* taub, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggqrf( lapack_int* n, lapack_int* m, lapack_int* p, double* a,
- lapack_int* lda, double* taua, double* b, lapack_int* ldb,
- double* taub, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cggqrf( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* taua, lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zggqrf( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* taua, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sggrqf( lapack_int* m, lapack_int* p, lapack_int* n, float* a,
- lapack_int* lda, float* taua, float* b, lapack_int* ldb,
- float* taub, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggrqf( lapack_int* m, lapack_int* p, lapack_int* n, double* a,
- lapack_int* lda, double* taua, double* b, lapack_int* ldb,
- double* taub, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cggrqf( lapack_int* m, lapack_int* p, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* taua, lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zggrqf( lapack_int* m, lapack_int* p, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* taua, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgebrd( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* d, float* e, float* tauq, float* taup, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgebrd( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* d, double* e, double* tauq, double* taup,
- double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_cgebrd( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, float* d, float* e,
- lapack_complex_float* tauq, lapack_complex_float* taup,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgebrd( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, double* d, double* e,
- lapack_complex_double* tauq, lapack_complex_double* taup,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, float* ab, lapack_int* ldab,
- float* d, float* e, float* q, lapack_int* ldq, float* pt,
- lapack_int* ldpt, float* c, lapack_int* ldc, float* work,
- lapack_int *info );
-void LAPACK_dgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, double* ab,
- lapack_int* ldab, double* d, double* e, double* q,
- lapack_int* ldq, double* pt, lapack_int* ldpt, double* c,
- lapack_int* ldc, double* work, lapack_int *info );
-void LAPACK_cgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, lapack_complex_float* ab,
- lapack_int* ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* pt, lapack_int* ldpt,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, lapack_complex_double* ab,
- lapack_int* ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* pt, lapack_int* ldpt,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sorgbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- float* a, lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- double* a, lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k, const float* a,
- lapack_int* lda, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dormbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k, const double* a,
- lapack_int* lda, const double* tau, double* c,
- lapack_int* ldc, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cungbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, float* d, float* e,
- float* vt, lapack_int* ldvt, float* u, lapack_int* ldu,
- float* c, lapack_int* ldc, float* work, lapack_int *info );
-void LAPACK_dbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, double* d, double* e,
- double* vt, lapack_int* ldvt, double* u, lapack_int* ldu,
- double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_cbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, float* d, float* e,
- lapack_complex_float* vt, lapack_int* ldvt,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* c, lapack_int* ldc, float* work,
- lapack_int *info );
-void LAPACK_zbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, double* d, double* e,
- lapack_complex_double* vt, lapack_int* ldvt,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_sbdsdc( char* uplo, char* compq, lapack_int* n, float* d, float* e,
- float* u, lapack_int* ldu, float* vt, lapack_int* ldvt,
- float* q, lapack_int* iq, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dbdsdc( char* uplo, char* compq, lapack_int* n, double* d,
- double* e, double* u, lapack_int* ldu, double* vt,
- lapack_int* ldvt, double* q, lapack_int* iq, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ssytrd( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- float* d, float* e, float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dsytrd( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- double* d, double* e, double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sorgtr( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- const float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dorgtr( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- const double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_chetrd( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, float* d, float* e,
- lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zhetrd( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, double* d, double* e,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungtr( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zungtr( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ssptrd( char* uplo, lapack_int* n, float* ap, float* d, float* e,
- float* tau, lapack_int *info );
-void LAPACK_dsptrd( char* uplo, lapack_int* n, double* ap, double* d, double* e,
- double* tau, lapack_int *info );
-void LAPACK_sopgtr( char* uplo, lapack_int* n, const float* ap,
- const float* tau, float* q, lapack_int* ldq, float* work,
- lapack_int *info );
-void LAPACK_dopgtr( char* uplo, lapack_int* n, const double* ap,
- const double* tau, double* q, lapack_int* ldq, double* work,
- lapack_int *info );
-void LAPACK_sopmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const float* ap, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int *info );
-void LAPACK_dopmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const double* ap, const double* tau,
- double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_chptrd( char* uplo, lapack_int* n, lapack_complex_float* ap,
- float* d, float* e, lapack_complex_float* tau,
- lapack_int *info );
-void LAPACK_zhptrd( char* uplo, lapack_int* n, lapack_complex_double* ap,
- double* d, double* e, lapack_complex_double* tau,
- lapack_int *info );
-void LAPACK_cupgtr( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- const lapack_complex_float* tau, lapack_complex_float* q,
- lapack_int* ldq, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zupgtr( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- const lapack_complex_double* tau, lapack_complex_double* q,
- lapack_int* ldq, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_cupmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_float* ap,
- const lapack_complex_float* tau, lapack_complex_float* c,
- lapack_int* ldc, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zupmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_double* ap,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_ssbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- float* ab, lapack_int* ldab, float* d, float* e, float* q,
- lapack_int* ldq, float* work, lapack_int *info );
-void LAPACK_dsbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- double* ab, lapack_int* ldab, double* d, double* e,
- double* q, lapack_int* ldq, double* work,
- lapack_int *info );
-void LAPACK_chbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab, float* d,
- float* e, lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zhbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab, double* d,
- double* e, lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_ssterf( lapack_int* n, float* d, float* e, lapack_int *info );
-void LAPACK_dsterf( lapack_int* n, double* d, double* e, lapack_int *info );
-void LAPACK_ssteqr( char* compz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dsteqr( char* compz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_csteqr( char* compz, lapack_int* n, float* d, float* e,
- lapack_complex_float* z, lapack_int* ldz, float* work,
- lapack_int *info );
-void LAPACK_zsteqr( char* compz, lapack_int* n, double* d, double* e,
- lapack_complex_double* z, lapack_int* ldz, double* work,
- lapack_int *info );
-void LAPACK_sstemr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- lapack_int* nzc, lapack_int* isuppz, lapack_logical* tryrac,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dstemr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, lapack_int* m, double* w, double* z,
- lapack_int* ldz, lapack_int* nzc, lapack_int* isuppz,
- lapack_logical* tryrac, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cstemr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_int* nzc, lapack_int* isuppz,
- lapack_logical* tryrac, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_zstemr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int* ldz, lapack_int* nzc,
- lapack_int* isuppz, lapack_logical* tryrac, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_sstedc( char* compz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dstedc( char* compz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cstedc( char* compz, lapack_int* n, float* d, float* e,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zstedc( char* compz, lapack_int* n, double* d, double* e,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sstegr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, lapack_int* isuppz, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_dstegr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, lapack_int* isuppz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_cstegr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_int* isuppz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_zstegr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_int* isuppz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_spteqr( char* compz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dpteqr( char* compz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_cpteqr( char* compz, lapack_int* n, float* d, float* e,
- lapack_complex_float* z, lapack_int* ldz, float* work,
- lapack_int *info );
-void LAPACK_zpteqr( char* compz, lapack_int* n, double* d, double* e,
- lapack_complex_double* z, lapack_int* ldz, double* work,
- lapack_int *info );
-void LAPACK_sstebz( char* range, char* order, lapack_int* n, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- const float* d, const float* e, lapack_int* m,
- lapack_int* nsplit, float* w, lapack_int* iblock,
- lapack_int* isplit, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dstebz( char* range, char* order, lapack_int* n, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- const double* d, const double* e, lapack_int* m,
- lapack_int* nsplit, double* w, lapack_int* iblock,
- lapack_int* isplit, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_sstein( lapack_int* n, const float* d, const float* e,
- lapack_int* m, const float* w, const lapack_int* iblock,
- const lapack_int* isplit, float* z, lapack_int* ldz,
- float* work, lapack_int* iwork, lapack_int* ifailv,
- lapack_int *info );
-void LAPACK_dstein( lapack_int* n, const double* d, const double* e,
- lapack_int* m, const double* w, const lapack_int* iblock,
- const lapack_int* isplit, double* z, lapack_int* ldz,
- double* work, lapack_int* iwork, lapack_int* ifailv,
- lapack_int *info );
-void LAPACK_cstein( lapack_int* n, const float* d, const float* e,
- lapack_int* m, const float* w, const lapack_int* iblock,
- const lapack_int* isplit, lapack_complex_float* z,
- lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifailv, lapack_int *info );
-void LAPACK_zstein( lapack_int* n, const double* d, const double* e,
- lapack_int* m, const double* w, const lapack_int* iblock,
- const lapack_int* isplit, lapack_complex_double* z,
- lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifailv, lapack_int *info );
-void LAPACK_sdisna( char* job, lapack_int* m, lapack_int* n, const float* d,
- float* sep, lapack_int *info );
-void LAPACK_ddisna( char* job, lapack_int* m, lapack_int* n, const double* d,
- double* sep, lapack_int *info );
-void LAPACK_ssygst( lapack_int* itype, char* uplo, lapack_int* n, float* a,
- lapack_int* lda, const float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dsygst( lapack_int* itype, char* uplo, lapack_int* n, double* a,
- lapack_int* lda, const double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_chegst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zhegst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sspgst( lapack_int* itype, char* uplo, lapack_int* n, float* ap,
- const float* bp, lapack_int *info );
-void LAPACK_dspgst( lapack_int* itype, char* uplo, lapack_int* n, double* ap,
- const double* bp, lapack_int *info );
-void LAPACK_chpgst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_float* ap, const lapack_complex_float* bp,
- lapack_int *info );
-void LAPACK_zhpgst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_double* ap, const lapack_complex_double* bp,
- lapack_int *info );
-void LAPACK_ssbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, float* ab, lapack_int* ldab,
- const float* bb, lapack_int* ldbb, float* x,
- lapack_int* ldx, float* work, lapack_int *info );
-void LAPACK_dsbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, double* ab, lapack_int* ldab,
- const double* bb, lapack_int* ldbb, double* x,
- lapack_int* ldx, double* work, lapack_int *info );
-void LAPACK_chbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* bb, lapack_int* ldbb,
- lapack_complex_float* x, lapack_int* ldx,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* bb, lapack_int* ldbb,
- lapack_complex_double* x, lapack_int* ldx,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_spbstf( char* uplo, lapack_int* n, lapack_int* kb, float* bb,
- lapack_int* ldbb, lapack_int *info );
-void LAPACK_dpbstf( char* uplo, lapack_int* n, lapack_int* kb, double* bb,
- lapack_int* ldbb, lapack_int *info );
-void LAPACK_cpbstf( char* uplo, lapack_int* n, lapack_int* kb,
- lapack_complex_float* bb, lapack_int* ldbb,
- lapack_int *info );
-void LAPACK_zpbstf( char* uplo, lapack_int* n, lapack_int* kb,
- lapack_complex_double* bb, lapack_int* ldbb,
- lapack_int *info );
-void LAPACK_sgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a,
- lapack_int* lda, float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a,
- lapack_int* lda, double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sorghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, const float* a,
- lapack_int* lda, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dormhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, const double* a,
- lapack_int* lda, const double* tau, double* c,
- lapack_int* ldc, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zunghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* c,
- lapack_int* ldc, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zunmhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sgebal( char* job, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- lapack_int *info );
-void LAPACK_dgebal( char* job, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- lapack_int *info );
-void LAPACK_cgebal( char* job, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ilo, lapack_int* ihi,
- float* scale, lapack_int *info );
-void LAPACK_zgebal( char* job, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ilo, lapack_int* ihi,
- double* scale, lapack_int *info );
-void LAPACK_sgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* scale, lapack_int* m,
- float* v, lapack_int* ldv, lapack_int *info );
-void LAPACK_dgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* scale, lapack_int* m,
- double* v, lapack_int* ldv, lapack_int *info );
-void LAPACK_cgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* scale, lapack_int* m,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_zgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* scale, lapack_int* m,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_shseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, float* h, lapack_int* ldh, float* wr,
- float* wi, float* z, lapack_int* ldz, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dhseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, double* h, lapack_int* ldh, double* wr,
- double* wi, double* z, lapack_int* ldz, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_chseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_float* h, lapack_int* ldh,
- lapack_complex_float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zhseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_double* h, lapack_int* ldh,
- lapack_complex_double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_shsein( char* job, char* eigsrc, char* initv,
- lapack_logical* select, lapack_int* n, const float* h,
- lapack_int* ldh, float* wr, const float* wi, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, float* work,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_dhsein( char* job, char* eigsrc, char* initv,
- lapack_logical* select, lapack_int* n, const double* h,
- lapack_int* ldh, double* wr, const double* wi, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, double* work,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_chsein( char* job, char* eigsrc, char* initv,
- const lapack_logical* select, lapack_int* n,
- const lapack_complex_float* h, lapack_int* ldh,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int* ldvl, lapack_complex_float* vr,
- lapack_int* ldvr, lapack_int* mm, lapack_int* m,
- lapack_complex_float* work, float* rwork,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_zhsein( char* job, char* eigsrc, char* initv,
- const lapack_logical* select, lapack_int* n,
- const lapack_complex_double* h, lapack_int* ldh,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_int* mm, lapack_int* m,
- lapack_complex_double* work, double* rwork,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_strevc( char* side, char* howmny, lapack_logical* select,
- lapack_int* n, const float* t, lapack_int* ldt, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, float* work,
- lapack_int *info );
-void LAPACK_dtrevc( char* side, char* howmny, lapack_logical* select,
- lapack_int* n, const double* t, lapack_int* ldt, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, double* work,
- lapack_int *info );
-void LAPACK_ctrevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztrevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* vl, lapack_int* ldvl,
- lapack_complex_double* vr, lapack_int* ldvr, lapack_int* mm,
- lapack_int* m, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_strsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const float* t, lapack_int* ldt,
- const float* vl, lapack_int* ldvl, const float* vr,
- lapack_int* ldvr, float* s, float* sep, lapack_int* mm,
- lapack_int* m, float* work, lapack_int* ldwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtrsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const double* t, lapack_int* ldt,
- const double* vl, lapack_int* ldvl, const double* vr,
- lapack_int* ldvr, double* s, double* sep, lapack_int* mm,
- lapack_int* m, double* work, lapack_int* ldwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctrsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_float* t,
- lapack_int* ldt, const lapack_complex_float* vl,
- lapack_int* ldvl, const lapack_complex_float* vr,
- lapack_int* ldvr, float* s, float* sep, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int* ldwork, float* rwork, lapack_int *info );
-void LAPACK_ztrsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_double* t,
- lapack_int* ldt, const lapack_complex_double* vl,
- lapack_int* ldvl, const lapack_complex_double* vr,
- lapack_int* ldvr, double* s, double* sep, lapack_int* mm,
- lapack_int* m, lapack_complex_double* work,
- lapack_int* ldwork, double* rwork, lapack_int *info );
-void LAPACK_strexc( char* compq, lapack_int* n, float* t, lapack_int* ldt,
- float* q, lapack_int* ldq, lapack_int* ifst,
- lapack_int* ilst, float* work, lapack_int *info );
-void LAPACK_dtrexc( char* compq, lapack_int* n, double* t, lapack_int* ldt,
- double* q, lapack_int* ldq, lapack_int* ifst,
- lapack_int* ilst, double* work, lapack_int *info );
-void LAPACK_ctrexc( char* compq, lapack_int* n, lapack_complex_float* t,
- lapack_int* ldt, lapack_complex_float* q, lapack_int* ldq,
- lapack_int* ifst, lapack_int* ilst, lapack_int *info );
-void LAPACK_ztrexc( char* compq, lapack_int* n, lapack_complex_double* t,
- lapack_int* ldt, lapack_complex_double* q, lapack_int* ldq,
- lapack_int* ifst, lapack_int* ilst, lapack_int *info );
-void LAPACK_strsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, float* t, lapack_int* ldt, float* q,
- lapack_int* ldq, float* wr, float* wi, lapack_int* m,
- float* s, float* sep, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dtrsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, double* t, lapack_int* ldt, double* q,
- lapack_int* ldq, double* wr, double* wi, lapack_int* m,
- double* s, double* sep, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_ctrsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* w, lapack_int* m, float* s,
- float* sep, lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ztrsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* w, lapack_int* m, double* s,
- double* sep, lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_strsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const float* a, lapack_int* lda,
- const float* b, lapack_int* ldb, float* c, lapack_int* ldc,
- float* scale, lapack_int *info );
-void LAPACK_dtrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const double* a, lapack_int* lda,
- const double* b, lapack_int* ldb, double* c,
- lapack_int* ldc, double* scale, lapack_int *info );
-void LAPACK_ctrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* c, lapack_int* ldc,
- float* scale, lapack_int *info );
-void LAPACK_ztrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* c, lapack_int* ldc,
- double* scale, lapack_int *info );
-void LAPACK_sgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* q, lapack_int* ldq, float* z,
- lapack_int* ldz, lapack_int *info );
-void LAPACK_dgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* q, lapack_int* ldq, double* z,
- lapack_int* ldz, lapack_int *info );
-void LAPACK_cgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_int *info );
-void LAPACK_zgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_int *info );
-void LAPACK_sggbal( char* job, lapack_int* n, float* a, lapack_int* lda,
- float* b, lapack_int* ldb, lapack_int* ilo, lapack_int* ihi,
- float* lscale, float* rscale, float* work,
- lapack_int *info );
-void LAPACK_dggbal( char* job, lapack_int* n, double* a, lapack_int* lda,
- double* b, lapack_int* ldb, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* work, lapack_int *info );
-void LAPACK_cggbal( char* job, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* b, lapack_int* ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* work, lapack_int *info );
-void LAPACK_zggbal( char* job, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* b, lapack_int* ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale, double* work, lapack_int *info );
-void LAPACK_sggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* lscale, const float* rscale,
- lapack_int* m, float* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_dggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* lscale, const double* rscale,
- lapack_int* m, double* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_cggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* lscale, const float* rscale,
- lapack_int* m, lapack_complex_float* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_zggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* lscale, const double* rscale,
- lapack_int* m, lapack_complex_double* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_shgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, float* h, lapack_int* ldh,
- float* t, lapack_int* ldt, float* alphar, float* alphai,
- float* beta, float* q, lapack_int* ldq, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dhgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, double* h,
- lapack_int* ldh, double* t, lapack_int* ldt, double* alphar,
- double* alphai, double* beta, double* q, lapack_int* ldq,
- double* z, lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, lapack_complex_float* h,
- lapack_int* ldh, lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zhgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, lapack_complex_double* h,
- lapack_int* ldh, lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_stgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const float* s, lapack_int* lds,
- const float* p, lapack_int* ldp, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, float* work,
- lapack_int *info );
-void LAPACK_dtgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const double* s, lapack_int* lds,
- const double* p, lapack_int* ldp, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, double* work,
- lapack_int *info );
-void LAPACK_ctgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_float* s,
- lapack_int* lds, const lapack_complex_float* p,
- lapack_int* ldp, lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_double* s,
- lapack_int* lds, const lapack_complex_double* p,
- lapack_int* ldp, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_int* mm, lapack_int* m,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* q, lapack_int* ldq, float* z, lapack_int* ldz,
- lapack_int* ifst, lapack_int* ilst, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dtgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* q, lapack_int* ldq, double* z, lapack_int* ldz,
- lapack_int* ifst, lapack_int* ilst, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_ctgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz, lapack_int* ifst,
- lapack_int* ilst, lapack_int *info );
-void LAPACK_ztgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz, lapack_int* ifst,
- lapack_int* ilst, lapack_int *info );
-void LAPACK_stgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* alphar, float* alphai, float* beta,
- float* q, lapack_int* ldq, float* z, lapack_int* ldz,
- lapack_int* m, float* pl, float* pr, float* dif,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dtgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* alphar, double* alphai,
- double* beta, double* q, lapack_int* ldq, double* z,
- lapack_int* ldz, lapack_int* m, double* pl, double* pr,
- double* dif, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_ctgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz, lapack_int* m,
- float* pl, float* pr, float* dif,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_ztgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz, lapack_int* m,
- double* pl, double* pr, double* dif,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_stgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const float* a, lapack_int* lda, const float* b,
- lapack_int* ldb, float* c, lapack_int* ldc, const float* d,
- lapack_int* ldd, const float* e, lapack_int* lde, float* f,
- lapack_int* ldf, float* scale, float* dif, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_dtgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const double* a, lapack_int* lda, const double* b,
- lapack_int* ldb, double* c, lapack_int* ldc,
- const double* d, lapack_int* ldd, const double* e,
- lapack_int* lde, double* f, lapack_int* ldf, double* scale,
- double* dif, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* c, lapack_int* ldc,
- const lapack_complex_float* d, lapack_int* ldd,
- const lapack_complex_float* e, lapack_int* lde,
- lapack_complex_float* f, lapack_int* ldf, float* scale,
- float* dif, lapack_complex_float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ztgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* c, lapack_int* ldc,
- const lapack_complex_double* d, lapack_int* ldd,
- const lapack_complex_double* e, lapack_int* lde,
- lapack_complex_double* f, lapack_int* ldf, double* scale,
- double* dif, lapack_complex_double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_stgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const float* a, lapack_int* lda,
- const float* b, lapack_int* ldb, const float* vl,
- lapack_int* ldvl, const float* vr, lapack_int* ldvr,
- float* s, float* dif, lapack_int* mm, lapack_int* m,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dtgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const double* a, lapack_int* lda,
- const double* b, lapack_int* ldb, const double* vl,
- lapack_int* ldvl, const double* vr, lapack_int* ldvr,
- double* s, double* dif, lapack_int* mm, lapack_int* m,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* b,
- lapack_int* ldb, const lapack_complex_float* vl,
- lapack_int* ldvl, const lapack_complex_float* vr,
- lapack_int* ldvr, float* s, float* dif, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_ztgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* b,
- lapack_int* ldb, const lapack_complex_double* vl,
- lapack_int* ldvl, const lapack_complex_double* vr,
- lapack_int* ldvr, double* s, double* dif, lapack_int* mm,
- lapack_int* m, lapack_complex_double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_sggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, float* a, lapack_int* lda,
- float* b, lapack_int* ldb, float* tola, float* tolb,
- lapack_int* k, lapack_int* l, float* u, lapack_int* ldu,
- float* v, lapack_int* ldv, float* q, lapack_int* ldq,
- lapack_int* iwork, float* tau, float* work,
- lapack_int *info );
-void LAPACK_dggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, double* a, lapack_int* lda,
- double* b, lapack_int* ldb, double* tola, double* tolb,
- lapack_int* k, lapack_int* l, double* u, lapack_int* ldu,
- double* v, lapack_int* ldv, double* q, lapack_int* ldq,
- lapack_int* iwork, double* tau, double* work,
- lapack_int *info );
-void LAPACK_cggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* b, lapack_int* ldb,
- float* tola, float* tolb, lapack_int* k, lapack_int* l,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_complex_float* q, lapack_int* ldq, lapack_int* iwork,
- float* rwork, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* b, lapack_int* ldb,
- double* tola, double* tolb, lapack_int* k, lapack_int* l,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_int* iwork, double* rwork,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_stgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* tola, float* tolb, float* alpha, float* beta,
- float* u, lapack_int* ldu, float* v, lapack_int* ldv,
- float* q, lapack_int* ldq, float* work, lapack_int* ncycle,
- lapack_int *info );
-void LAPACK_dtgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* tola, double* tolb, double* alpha, double* beta,
- double* u, lapack_int* ldu, double* v, lapack_int* ldv,
- double* q, lapack_int* ldq, double* work,
- lapack_int* ncycle, lapack_int *info );
-void LAPACK_ctgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* tola,
- float* tolb, float* alpha, float* beta,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* work, lapack_int* ncycle,
- lapack_int *info );
-void LAPACK_ztgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* tola,
- double* tolb, double* alpha, double* beta,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* work, lapack_int* ncycle,
- lapack_int *info );
-void LAPACK_sgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_cgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int* jpvt, float* rcond, lapack_int* rank,
- float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int* jpvt, double* rcond, lapack_int* rank,
- double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_cgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int* jpvt,
- float* rcond, lapack_int* rank, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int *info );
-void LAPACK_zgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, lapack_int* jpvt,
- double* rcond, lapack_int* rank,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int *info );
-void LAPACK_zgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_dgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_zgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgglse( lapack_int* m, lapack_int* n, lapack_int* p, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* c,
- float* d, float* x, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgglse( lapack_int* m, lapack_int* n, lapack_int* p, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* c,
- double* d, double* x, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgglse( lapack_int* m, lapack_int* n, lapack_int* p,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* c, lapack_complex_float* d,
- lapack_complex_float* x, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zgglse( lapack_int* m, lapack_int* n, lapack_int* p,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* c, lapack_complex_double* d,
- lapack_complex_double* x, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sggglm( lapack_int* n, lapack_int* m, lapack_int* p, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* d,
- float* x, float* y, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggglm( lapack_int* n, lapack_int* m, lapack_int* p, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* d,
- double* x, double* y, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cggglm( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* d, lapack_complex_float* x,
- lapack_complex_float* y, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zggglm( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* d, lapack_complex_double* x,
- lapack_complex_double* y, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_ssyev( char* jobz, char* uplo, lapack_int* n, float* a,
- lapack_int* lda, float* w, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dsyev( char* jobz, char* uplo, lapack_int* n, double* a,
- lapack_int* lda, double* w, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cheev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zheev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_ssyevd( char* jobz, char* uplo, lapack_int* n, float* a,
- lapack_int* lda, float* w, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dsyevd( char* jobz, char* uplo, lapack_int* n, double* a,
- lapack_int* lda, double* w, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cheevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zheevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssyevx( char* jobz, char* range, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dsyevx( char* jobz, char* range, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_cheevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_zheevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_ssyevr( char* jobz, char* range, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- lapack_int* isuppz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dsyevr( char* jobz, char* range, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, double* z, lapack_int* ldz,
- lapack_int* isuppz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cheevr( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_int* isuppz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zheevr( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_int* isuppz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sspev( char* jobz, char* uplo, lapack_int* n, float* ap, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dspev( char* jobz, char* uplo, lapack_int* n, double* ap, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_chpev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhpev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sspevd( char* jobz, char* uplo, lapack_int* n, float* ap, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dspevd( char* jobz, char* uplo, lapack_int* n, double* ap,
- double* w, double* z, lapack_int* ldz, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_chpevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* lrwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_zhpevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sspevx( char* jobz, char* range, char* uplo, lapack_int* n,
- float* ap, float* vl, float* vu, lapack_int* il,
- lapack_int* iu, float* abstol, lapack_int* m, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dspevx( char* jobz, char* range, char* uplo, lapack_int* n,
- double* ap, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_chpevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_float* ap, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_zhpevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_double* ap, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_ssbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- float* ab, lapack_int* ldab, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dsbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- double* ab, lapack_int* ldab, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_chbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int *info );
-void LAPACK_zhbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- float* ab, lapack_int* ldab, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dsbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- double* ab, lapack_int* ldab, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_chbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, float* ab, lapack_int* ldab, float* q,
- lapack_int* ldq, float* vl, float* vu, lapack_int* il,
- lapack_int* iu, float* abstol, lapack_int* m, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dsbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, double* ab, lapack_int* ldab, double* q,
- lapack_int* ldq, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_chbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* q, lapack_int* ldq, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_zhbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* q, lapack_int* ldq, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_sstev( char* jobz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dstev( char* jobz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_sstevd( char* jobz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dstevd( char* jobz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_sstevx( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dstevx( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_sstevr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, lapack_int* isuppz, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_dstevr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, lapack_int* isuppz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sgees( char* jobvs, char* sort, LAPACK_S_SELECT2 select,
- lapack_int* n, float* a, lapack_int* lda, lapack_int* sdim,
- float* wr, float* wi, float* vs, lapack_int* ldvs,
- float* work, lapack_int* lwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dgees( char* jobvs, char* sort, LAPACK_D_SELECT2 select,
- lapack_int* n, double* a, lapack_int* lda, lapack_int* sdim,
- double* wr, double* wi, double* vs, lapack_int* ldvs,
- double* work, lapack_int* lwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cgees( char* jobvs, char* sort, LAPACK_C_SELECT1 select,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int* ldvs,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_zgees( char* jobvs, char* sort, LAPACK_Z_SELECT1 select,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int* ldvs,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_logical* bwork, lapack_int *info );
-void LAPACK_sgeesx( char* jobvs, char* sort, LAPACK_S_SELECT2 select,
- char* sense, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* sdim, float* wr, float* wi, float* vs,
- lapack_int* ldvs, float* rconde, float* rcondv, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_dgeesx( char* jobvs, char* sort, LAPACK_D_SELECT2 select,
- char* sense, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* sdim, double* wr, double* wi, double* vs,
- lapack_int* ldvs, double* rconde, double* rcondv,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cgeesx( char* jobvs, char* sort, LAPACK_C_SELECT1 select,
- char* sense, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int* ldvs, float* rconde,
- float* rcondv, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_zgeesx( char* jobvs, char* sort, LAPACK_Z_SELECT1 select,
- char* sense, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int* ldvs, double* rconde,
- double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_sgeev( char* jobvl, char* jobvr, lapack_int* n, float* a,
- lapack_int* lda, float* wr, float* wi, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgeev( char* jobvl, char* jobvr, lapack_int* n, double* a,
- lapack_int* lda, double* wr, double* wi, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgeev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int* ldvl, lapack_complex_float* vr, lapack_int* ldvr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zgeev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int *info );
-void LAPACK_sgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, float* a, lapack_int* lda, float* wr,
- float* wi, float* vl, lapack_int* ldvl, float* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- float* scale, float* abnrm, float* rconde, float* rcondv,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, double* a, lapack_int* lda, double* wr,
- double* wi, double* vl, lapack_int* ldvl, double* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- double* scale, double* abnrm, double* rconde,
- double* rcondv, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int* ldvl, lapack_complex_float* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- float* scale, float* abnrm, float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- double* scale, double* abnrm, double* rconde,
- double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int *info );
-void LAPACK_sgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- float* a, lapack_int* lda, float* s, float* u,
- lapack_int* ldu, float* vt, lapack_int* ldvt, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- double* a, lapack_int* lda, double* s, double* u,
- lapack_int* ldu, double* vt, lapack_int* ldvt, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* s,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* vt, lapack_int* ldvt,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* s,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* vt, lapack_int* ldvt,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sgesdd( char* jobz, lapack_int* m, lapack_int* n, float* a,
- lapack_int* lda, float* s, float* u, lapack_int* ldu,
- float* vt, lapack_int* ldvt, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dgesdd( char* jobz, lapack_int* m, lapack_int* n, double* a,
- lapack_int* lda, double* s, double* u, lapack_int* ldu,
- double* vt, lapack_int* ldvt, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgesdd( char* jobz, lapack_int* m, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* s,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* vt, lapack_int* ldvt,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zgesdd( char* jobz, lapack_int* m, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* s,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* vt, lapack_int* ldvt,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_dgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt,
- char* jobp, lapack_int* m, lapack_int* n, double* a,
- lapack_int* lda, double* sva, double* u, lapack_int* ldu,
- double* v, lapack_int* ldv, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_sgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt,
- char* jobp, lapack_int* m, lapack_int* n, float* a,
- lapack_int* lda, float* sva, float* u, lapack_int* ldu,
- float* v, lapack_int* ldv, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dgesvj( char* joba, char* jobu, char* jobv, lapack_int* m,
- lapack_int* n, double* a, lapack_int* lda, double* sva,
- lapack_int* mv, double* v, lapack_int* ldv, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sgesvj( char* joba, char* jobu, char* jobv, lapack_int* m,
- lapack_int* n, float* a, lapack_int* lda, float* sva,
- lapack_int* mv, float* v, lapack_int* ldv, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* alpha, float* beta, float* u, lapack_int* ldu,
- float* v, lapack_int* ldv, float* q, lapack_int* ldq,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* alpha, double* beta, double* u, lapack_int* ldu,
- double* v, lapack_int* ldv, double* q, lapack_int* ldq,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* alpha,
- float* beta, lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* work, float* rwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_zggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* alpha,
- double* beta, lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ssygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* w, float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dsygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* w, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chegv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zhegv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_ssygvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* w, float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dsygvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* w, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_chegvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhegvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssygvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* vl, float* vu, lapack_int* il,
- lapack_int* iu, float* abstol, lapack_int* m, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_dsygvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_chegvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_zhegvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_sspgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* ap, float* bp, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int *info );
-void LAPACK_dspgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* ap, double* bp, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_chpgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int *info );
-void LAPACK_zhpgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, lapack_complex_double* bp,
- double* w, lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sspgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* ap, float* bp, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dspgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* ap, double* bp, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_chpgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, lapack_complex_float* bp,
- float* w, lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhpgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, lapack_complex_double* bp,
- double* w, lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sspgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, float* ap, float* bp, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* iwork, lapack_int* ifail,
- lapack_int *info );
-void LAPACK_dspgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, double* ap, double* bp, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int* iwork, lapack_int* ifail,
- lapack_int *info );
-void LAPACK_chpgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_float* ap,
- lapack_complex_float* bp, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_zhpgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_double* ap,
- lapack_complex_double* bp, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_ssbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, float* ab, lapack_int* ldab, float* bb,
- lapack_int* ldbb, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int *info );
-void LAPACK_dsbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, double* ab, lapack_int* ldab, double* bb,
- lapack_int* ldbb, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int *info );
-void LAPACK_chbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* bb, lapack_int* ldbb, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int *info );
-void LAPACK_zhbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* bb, lapack_int* ldbb, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, float* ab, lapack_int* ldab, float* bb,
- lapack_int* ldbb, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dsbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, double* ab, lapack_int* ldab, double* bb,
- lapack_int* ldbb, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_chbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* bb, lapack_int* ldbb, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* bb, lapack_int* ldbb, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, float* ab, lapack_int* ldab,
- float* bb, lapack_int* ldbb, float* q, lapack_int* ldq,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dsbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, double* ab,
- lapack_int* ldab, double* bb, lapack_int* ldbb, double* q,
- lapack_int* ldq, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_chbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* bb,
- lapack_int* ldbb, lapack_complex_float* q, lapack_int* ldq,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_zhbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, lapack_complex_double* ab,
- lapack_int* ldab, lapack_complex_double* bb,
- lapack_int* ldbb, lapack_complex_double* q, lapack_int* ldq,
- double* vl, double* vu, lapack_int* il, lapack_int* iu,
- double* abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_sgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_S_SELECT3 selctg, lapack_int* n, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, lapack_int* sdim,
- float* alphar, float* alphai, float* beta, float* vsl,
- lapack_int* ldvsl, float* vsr, lapack_int* ldvsr,
- float* work, lapack_int* lwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_D_SELECT3 selctg, lapack_int* n, double* a,
- lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int* ldvsl, double* vsr,
- lapack_int* ldvsr, double* work, lapack_int* lwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_cgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_C_SELECT2 selctg, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int* ldvsl,
- lapack_complex_float* vsr, lapack_int* ldvsr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_zgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_Z_SELECT2 selctg, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int* ldvsl,
- lapack_complex_double* vsr, lapack_int* ldvsr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_logical* bwork, lapack_int *info );
-void LAPACK_sggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_S_SELECT3 selctg, char* sense, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int* sdim, float* alphar, float* alphai, float* beta,
- float* vsl, lapack_int* ldvsl, float* vsr,
- lapack_int* ldvsr, float* rconde, float* rcondv,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_D_SELECT3 selctg, char* sense, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int* ldvsl, double* vsr,
- lapack_int* ldvsr, double* rconde, double* rcondv,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_C_SELECT2 selctg, char* sense, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int* ldvsl,
- lapack_complex_float* vsr, lapack_int* ldvsr, float* rconde,
- float* rcondv, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_zggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_Z_SELECT2 selctg, char* sense, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int* ldvsl,
- lapack_complex_double* vsr, lapack_int* ldvsr,
- double* rconde, double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_sggev( char* jobvl, char* jobvr, lapack_int* n, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* alphar,
- float* alphai, float* beta, float* vl, lapack_int* ldvl,
- float* vr, lapack_int* ldvr, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggev( char* jobvl, char* jobvr, lapack_int* n, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* alphar,
- double* alphai, double* beta, double* vl, lapack_int* ldvl,
- double* vr, lapack_int* ldvr, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cggev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zggev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int* ldvl,
- lapack_complex_double* vr, lapack_int* ldvr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* alphar, float* alphai, float* beta,
- float* vl, lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm, float* rconde,
- float* rcondv, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* alphar, double* alphai,
- double* beta, double* vl, lapack_int* ldvl, double* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale, float* abnrm,
- float* bbnrm, float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* iwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_zggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int* ldvl,
- lapack_complex_double* vr, lapack_int* ldvr,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale, double* abnrm, double* bbnrm,
- double* rconde, double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_dsfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, double* alpha, const double* a,
- lapack_int* lda, double* beta, double* c );
-void LAPACK_ssfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, float* alpha, const float* a, lapack_int* lda,
- float* beta, float* c );
-void LAPACK_zhfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, double* alpha, const lapack_complex_double* a,
- lapack_int* lda, double* beta, lapack_complex_double* c );
-void LAPACK_chfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, float* alpha, const lapack_complex_float* a,
- lapack_int* lda, float* beta, lapack_complex_float* c );
-void LAPACK_dtfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n, double* alpha,
- const double* a, double* b, lapack_int* ldb );
-void LAPACK_stfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n, float* alpha,
- const float* a, float* b, lapack_int* ldb );
-void LAPACK_ztfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n,
- lapack_complex_double* alpha, const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int* ldb );
-void LAPACK_ctfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n,
- lapack_complex_float* alpha, const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int* ldb );
-void LAPACK_dtfttp( char* transr, char* uplo, lapack_int* n, const double* arf,
- double* ap, lapack_int *info );
-void LAPACK_stfttp( char* transr, char* uplo, lapack_int* n, const float* arf,
- float* ap, lapack_int *info );
-void LAPACK_ztfttp( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* arf, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_ctfttp( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* arf, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_dtfttr( char* transr, char* uplo, lapack_int* n, const double* arf,
- double* a, lapack_int* lda, lapack_int *info );
-void LAPACK_stfttr( char* transr, char* uplo, lapack_int* n, const float* arf,
- float* a, lapack_int* lda, lapack_int *info );
-void LAPACK_ztfttr( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* arf, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_ctfttr( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* arf, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dtpttf( char* transr, char* uplo, lapack_int* n, const double* ap,
- double* arf, lapack_int *info );
-void LAPACK_stpttf( char* transr, char* uplo, lapack_int* n, const float* ap,
- float* arf, lapack_int *info );
-void LAPACK_ztpttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* ap, lapack_complex_double* arf,
- lapack_int *info );
-void LAPACK_ctpttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* ap, lapack_complex_float* arf,
- lapack_int *info );
-void LAPACK_dtpttr( char* uplo, lapack_int* n, const double* ap, double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_stpttr( char* uplo, lapack_int* n, const float* ap, float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_ztpttr( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_ctpttr( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- lapack_complex_float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dtrttf( char* transr, char* uplo, lapack_int* n, const double* a,
- lapack_int* lda, double* arf, lapack_int *info );
-void LAPACK_strttf( char* transr, char* uplo, lapack_int* n, const float* a,
- lapack_int* lda, float* arf, lapack_int *info );
-void LAPACK_ztrttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* arf, lapack_int *info );
-void LAPACK_ctrttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* arf, lapack_int *info );
-void LAPACK_dtrttp( char* uplo, lapack_int* n, const double* a, lapack_int* lda,
- double* ap, lapack_int *info );
-void LAPACK_strttp( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- float* ap, lapack_int *info );
-void LAPACK_ztrttp( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_ctrttp( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_sgeqrfp( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgeqrfp( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgeqrfp( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgeqrfp( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_clacgv( lapack_int* n, lapack_complex_float* x, lapack_int* incx );
-void LAPACK_zlacgv( lapack_int* n, lapack_complex_double* x, lapack_int* incx );
-void LAPACK_slarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- float* x );
-void LAPACK_dlarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- double* x );
-void LAPACK_clarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- lapack_complex_float* x );
-void LAPACK_zlarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- lapack_complex_double* x );
-void LAPACK_sgeqr2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int *info );
-void LAPACK_dgeqr2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int *info );
-void LAPACK_cgeqr2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgeqr2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slacpy( char* uplo, lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* b, lapack_int* ldb );
-void LAPACK_dlacpy( char* uplo, lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* b, lapack_int* ldb );
-void LAPACK_clacpy( char* uplo, lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb );
-void LAPACK_zlacpy( char* uplo, lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb );
-void LAPACK_sgetf2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgetf2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgetf2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_zgetf2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_slaswp( lapack_int* n, float* a, lapack_int* lda, lapack_int* k1,
- lapack_int* k2, const lapack_int* ipiv, lapack_int* incx );
-void LAPACK_dlaswp( lapack_int* n, double* a, lapack_int* lda, lapack_int* k1,
- lapack_int* k2, const lapack_int* ipiv, lapack_int* incx );
-void LAPACK_claswp( lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_int* k1, lapack_int* k2, const lapack_int* ipiv,
- lapack_int* incx );
-void LAPACK_zlaswp( lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_int* k1, lapack_int* k2, const lapack_int* ipiv,
- lapack_int* incx );
-float LAPACK_slange( char* norm, lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* work );
-double LAPACK_dlange( char* norm, lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* work );
-float LAPACK_clange( char* norm, lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* work );
-double LAPACK_zlange( char* norm, lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* work );
-float LAPACK_clanhe( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* work );
-double LAPACK_zlanhe( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* work );
-float LAPACK_slansy( char* norm, char* uplo, lapack_int* n, const float* a,
- lapack_int* lda, float* work );
-double LAPACK_dlansy( char* norm, char* uplo, lapack_int* n, const double* a,
- lapack_int* lda, double* work );
-float LAPACK_clansy( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* work );
-double LAPACK_zlansy( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* work );
-float LAPACK_slantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const float* a, lapack_int* lda, float* work );
-double LAPACK_dlantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const double* a, lapack_int* lda, double* work );
-float LAPACK_clantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const lapack_complex_float* a, lapack_int* lda,
- float* work );
-double LAPACK_zlantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const lapack_complex_double* a, lapack_int* lda,
- double* work );
-float LAPACK_slamch( char* cmach );
-double LAPACK_dlamch( char* cmach );
-void LAPACK_sgelq2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int *info );
-void LAPACK_dgelq2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int *info );
-void LAPACK_cgelq2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgelq2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, const float* v,
- lapack_int* ldv, const float* t, lapack_int* ldt, float* c,
- lapack_int* ldc, float* work, lapack_int* ldwork );
-void LAPACK_dlarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k,
- const double* v, lapack_int* ldv, const double* t,
- lapack_int* ldt, double* c, lapack_int* ldc, double* work,
- lapack_int* ldwork );
-void LAPACK_clarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* ldwork );
-void LAPACK_zlarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* ldwork );
-void LAPACK_slarfg( lapack_int* n, float* alpha, float* x, lapack_int* incx,
- float* tau );
-void LAPACK_dlarfg( lapack_int* n, double* alpha, double* x, lapack_int* incx,
- double* tau );
-void LAPACK_clarfg( lapack_int* n, lapack_complex_float* alpha,
- lapack_complex_float* x, lapack_int* incx,
- lapack_complex_float* tau );
-void LAPACK_zlarfg( lapack_int* n, lapack_complex_double* alpha,
- lapack_complex_double* x, lapack_int* incx,
- lapack_complex_double* tau );
-void LAPACK_slarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const float* v, lapack_int* ldv, const float* tau, float* t,
- lapack_int* ldt );
-void LAPACK_dlarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const double* v, lapack_int* ldv, const double* tau,
- double* t, lapack_int* ldt );
-void LAPACK_clarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* tau, lapack_complex_float* t,
- lapack_int* ldt );
-void LAPACK_zlarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* tau, lapack_complex_double* t,
- lapack_int* ldt );
-void LAPACK_slarfx( char* side, lapack_int* m, lapack_int* n, const float* v,
- float* tau, float* c, lapack_int* ldc, float* work );
-void LAPACK_dlarfx( char* side, lapack_int* m, lapack_int* n, const double* v,
- double* tau, double* c, lapack_int* ldc, double* work );
-void LAPACK_clarfx( char* side, lapack_int* m, lapack_int* n,
- const lapack_complex_float* v, lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work );
-void LAPACK_zlarfx( char* side, lapack_int* m, lapack_int* n,
- const lapack_complex_double* v, lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work );
-void LAPACK_slatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, float* d, lapack_int* mode, float* cond,
- float* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- float* a, lapack_int* lda, float* work, lapack_int *info );
-void LAPACK_dlatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, double* d, lapack_int* mode, double* cond,
- double* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- double* a, lapack_int* lda, double* work,
- lapack_int *info );
-void LAPACK_clatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, float* d, lapack_int* mode, float* cond,
- float* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, double* d, lapack_int* mode, double* cond,
- double* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slag2d( lapack_int* m, lapack_int* n, const float* sa,
- lapack_int* ldsa, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dlag2s( lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, float* sa, lapack_int* ldsa,
- lapack_int *info );
-void LAPACK_clag2z( lapack_int* m, lapack_int* n,
- const lapack_complex_float* sa, lapack_int* ldsa,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_zlag2c( lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_float* sa, lapack_int* ldsa,
- lapack_int *info );
-void LAPACK_slauum( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dlauum( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_clauum( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_zlauum( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_slagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* d, float* a, lapack_int* lda,
- lapack_int* iseed, float* work, lapack_int *info );
-void LAPACK_dlagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* d, double* a, lapack_int* lda,
- lapack_int* iseed, double* work, lapack_int *info );
-void LAPACK_clagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* d, lapack_complex_float* a,
- lapack_int* lda, lapack_int* iseed,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* d, lapack_complex_double* a,
- lapack_int* lda, lapack_int* iseed,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slaset( char* uplo, lapack_int* m, lapack_int* n, float* alpha,
- float* beta, float* a, lapack_int* lda );
-void LAPACK_dlaset( char* uplo, lapack_int* m, lapack_int* n, double* alpha,
- double* beta, double* a, lapack_int* lda );
-void LAPACK_claset( char* uplo, lapack_int* m, lapack_int* n,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* a, lapack_int* lda );
-void LAPACK_zlaset( char* uplo, lapack_int* m, lapack_int* n,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* a, lapack_int* lda );
-void LAPACK_slasrt( char* id, lapack_int* n, float* d, lapack_int *info );
-void LAPACK_dlasrt( char* id, lapack_int* n, double* d, lapack_int *info );
-void LAPACK_claghe( lapack_int* n, lapack_int* k, const float* d,
- lapack_complex_float* a, lapack_int* lda, lapack_int* iseed,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlaghe( lapack_int* n, lapack_int* k, const double* d,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int* iseed, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_slagsy( lapack_int* n, lapack_int* k, const float* d, float* a,
- lapack_int* lda, lapack_int* iseed, float* work,
- lapack_int *info );
-void LAPACK_dlagsy( lapack_int* n, lapack_int* k, const double* d, double* a,
- lapack_int* lda, lapack_int* iseed, double* work,
- lapack_int *info );
-void LAPACK_clagsy( lapack_int* n, lapack_int* k, const float* d,
- lapack_complex_float* a, lapack_int* lda, lapack_int* iseed,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlagsy( lapack_int* n, lapack_int* k, const double* d,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int* iseed, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_slapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- float* x, lapack_int* ldx, lapack_int* k );
-void LAPACK_dlapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- double* x, lapack_int* ldx, lapack_int* k );
-void LAPACK_clapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- lapack_complex_float* x, lapack_int* ldx, lapack_int* k );
-void LAPACK_zlapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- lapack_complex_double* x, lapack_int* ldx, lapack_int* k );
-float LAPACK_slapy2( float* x, float* y );
-double LAPACK_dlapy2( double* x, double* y );
-float LAPACK_slapy3( float* x, float* y, float* z );
-double LAPACK_dlapy3( double* x, double* y, double* z );
-void LAPACK_slartgp( float* f, float* g, float* cs, float* sn, float* r );
-void LAPACK_dlartgp( double* f, double* g, double* cs, double* sn, double* r );
-void LAPACK_slartgs( float* x, float* y, float* sigma, float* cs, float* sn );
-void LAPACK_dlartgs( double* x, double* y, double* sigma, double* cs,
- double* sn );
-// LAPACK 3.3.0
-void LAPACK_cbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- float* theta, float* phi,
- lapack_complex_float* u1, lapack_int* ldu1,
- lapack_complex_float* u2, lapack_int* ldu2,
- lapack_complex_float* v1t, lapack_int* ldv1t,
- lapack_complex_float* v2t, lapack_int* ldv2t,
- float* b11d, float* b11e, float* b12d,
- float* b12e, float* b21d, float* b21e,
- float* b22d, float* b22e, float* rwork,
- lapack_int* lrwork , lapack_int *info );
-void LAPACK_cheswapr( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_chetri2( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_chetri2x( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* nb , lapack_int *info );
-void LAPACK_chetrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work , lapack_int *info );
-void LAPACK_csyconv( char* uplo, char* way,
- lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* work , lapack_int *info );
-void LAPACK_csyswapr( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_csytri2( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_csytri2x( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* nb , lapack_int *info );
-void LAPACK_csytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work , lapack_int *info );
-void LAPACK_cunbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- lapack_complex_float* x11, lapack_int* ldx11,
- lapack_complex_float* x12, lapack_int* ldx12,
- lapack_complex_float* x21, lapack_int* ldx21,
- lapack_complex_float* x22, lapack_int* ldx22,
- float* theta, float* phi,
- lapack_complex_float* taup1,
- lapack_complex_float* taup2,
- lapack_complex_float* tauq1,
- lapack_complex_float* tauq2,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_cuncsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, lapack_complex_float* x11,
- lapack_int* ldx11, lapack_complex_float* x12,
- lapack_int* ldx12, lapack_complex_float* x21,
- lapack_int* ldx21, lapack_complex_float* x22,
- lapack_int* ldx22, float* theta,
- lapack_complex_float* u1, lapack_int* ldu1,
- lapack_complex_float* u2, lapack_int* ldu2,
- lapack_complex_float* v1t, lapack_int* ldv1t,
- lapack_complex_float* v2t, lapack_int* ldv2t,
- lapack_complex_float* work, lapack_int* lwork,
- float* rwork, lapack_int* lrwork,
- lapack_int* iwork , lapack_int *info );
-void LAPACK_dbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- double* theta, double* phi, double* u1,
- lapack_int* ldu1, double* u2, lapack_int* ldu2,
- double* v1t, lapack_int* ldv1t, double* v2t,
- lapack_int* ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e,
- double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_dorbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- double* x11, lapack_int* ldx11, double* x12,
- lapack_int* ldx12, double* x21, lapack_int* ldx21,
- double* x22, lapack_int* ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2, double* work,
- lapack_int* lwork , lapack_int *info );
-void LAPACK_dorcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, double* x11, lapack_int* ldx11,
- double* x12, lapack_int* ldx12, double* x21,
- lapack_int* ldx21, double* x22, lapack_int* ldx22,
- double* theta, double* u1, lapack_int* ldu1,
- double* u2, lapack_int* ldu2, double* v1t,
- lapack_int* ldv1t, double* v2t, lapack_int* ldv2t,
- double* work, lapack_int* lwork,
- lapack_int* iwork , lapack_int *info );
-void LAPACK_dsyconv( char* uplo, char* way,
- lapack_int* n, double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work , lapack_int *info );
-void LAPACK_dsyswapr( char* uplo, lapack_int* n,
- double* a, lapack_int* i1, lapack_int* i2 );
-void LAPACK_dsytri2( char* uplo, lapack_int* n,
- double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_dsytri2x( char* uplo, lapack_int* n,
- double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work,
- lapack_int* nb , lapack_int *info );
-void LAPACK_dsytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const double* a,
- lapack_int* lda, const lapack_int* ipiv,
- double* b, lapack_int* ldb, double* work , lapack_int *info );
-void LAPACK_sbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- float* theta, float* phi, float* u1,
- lapack_int* ldu1, float* u2, lapack_int* ldu2,
- float* v1t, lapack_int* ldv1t, float* v2t,
- lapack_int* ldv2t, float* b11d, float* b11e,
- float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e,
- float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_sorbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- float* x11, lapack_int* ldx11, float* x12,
- lapack_int* ldx12, float* x21, lapack_int* ldx21,
- float* x22, lapack_int* ldx22, float* theta,
- float* phi, float* taup1, float* taup2,
- float* tauq1, float* tauq2, float* work,
- lapack_int* lwork , lapack_int *info );
-void LAPACK_sorcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, float* x11, lapack_int* ldx11,
- float* x12, lapack_int* ldx12, float* x21,
- lapack_int* ldx21, float* x22, lapack_int* ldx22,
- float* theta, float* u1, lapack_int* ldu1,
- float* u2, lapack_int* ldu2, float* v1t,
- lapack_int* ldv1t, float* v2t, lapack_int* ldv2t,
- float* work, lapack_int* lwork,
- lapack_int* iwork , lapack_int *info );
-void LAPACK_ssyconv( char* uplo, char* way,
- lapack_int* n, float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work , lapack_int *info );
-void LAPACK_ssyswapr( char* uplo, lapack_int* n,
- float* a, lapack_int* i1, lapack_int* i2 );
-void LAPACK_ssytri2( char* uplo, lapack_int* n,
- float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_ssytri2x( char* uplo, lapack_int* n,
- float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work,
- lapack_int* nb , lapack_int *info );
-void LAPACK_ssytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const float* a,
- lapack_int* lda, const lapack_int* ipiv,
- float* b, lapack_int* ldb, float* work , lapack_int *info );
-void LAPACK_zbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- double* theta, double* phi,
- lapack_complex_double* u1, lapack_int* ldu1,
- lapack_complex_double* u2, lapack_int* ldu2,
- lapack_complex_double* v1t, lapack_int* ldv1t,
- lapack_complex_double* v2t, lapack_int* ldv2t,
- double* b11d, double* b11e, double* b12d,
- double* b12e, double* b21d, double* b21e,
- double* b22d, double* b22e, double* rwork,
- lapack_int* lrwork , lapack_int *info );
-void LAPACK_zheswapr( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_zhetri2( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_zhetri2x( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* nb , lapack_int *info );
-void LAPACK_zhetrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work , lapack_int *info );
-void LAPACK_zsyconv( char* uplo, char* way,
- lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_double* work , lapack_int *info );
-void LAPACK_zsyswapr( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_zsytri2( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_zsytri2x( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* nb , lapack_int *info );
-void LAPACK_zsytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work , lapack_int *info );
-void LAPACK_zunbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- lapack_complex_double* x11, lapack_int* ldx11,
- lapack_complex_double* x12, lapack_int* ldx12,
- lapack_complex_double* x21, lapack_int* ldx21,
- lapack_complex_double* x22, lapack_int* ldx22,
- double* theta, double* phi,
- lapack_complex_double* taup1,
- lapack_complex_double* taup2,
- lapack_complex_double* tauq1,
- lapack_complex_double* tauq2,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_zuncsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, lapack_complex_double* x11,
- lapack_int* ldx11, lapack_complex_double* x12,
- lapack_int* ldx12, lapack_complex_double* x21,
- lapack_int* ldx21, lapack_complex_double* x22,
- lapack_int* ldx22, double* theta,
- lapack_complex_double* u1, lapack_int* ldu1,
- lapack_complex_double* u2, lapack_int* ldu2,
- lapack_complex_double* v1t, lapack_int* ldv1t,
- lapack_complex_double* v2t, lapack_int* ldv2t,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork,
- lapack_int* iwork , lapack_int *info );
-// LAPACK 3.4.0
-void LAPACK_sgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb, const float* v,
- lapack_int* ldv, const float* t, lapack_int* ldt, float* c,
- lapack_int* ldc, float* work, lapack_int *info );
-void LAPACK_dgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb, const double* v,
- lapack_int* ldv, const double* t, lapack_int* ldt,
- double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_cgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_sgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, float* a,
- lapack_int* lda, float* t, lapack_int* ldt, float* work,
- lapack_int *info );
-void LAPACK_dgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, double* a,
- lapack_int* lda, double* t, lapack_int* ldt, double* work,
- lapack_int *info );
-void LAPACK_cgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_sgeqrt2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_dgeqrt2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_cgeqrt2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_zgeqrt2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_sgeqrt3( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_dgeqrt3( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_cgeqrt3( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_zgeqrt3( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_stpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const float* v, lapack_int* ldv, const float* t,
- lapack_int* ldt, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* work, lapack_int *info );
-void LAPACK_dtpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const double* v, lapack_int* ldv, const double* t,
- lapack_int* ldt, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* work, lapack_int *info );
-void LAPACK_ctpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_ztpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_dtpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* t, lapack_int* ldt, double* work,
- lapack_int *info );
-void LAPACK_ctpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_ztpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_stpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- float* a, lapack_int* lda,
- float* b, lapack_int* ldb,
- float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_dtpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- double* a, lapack_int* lda,
- double* b, lapack_int* ldb,
- double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_ctpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_ztpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_stprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const float* v, lapack_int* ldv, const float* t,
- lapack_int* ldt, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, const float* work,
- lapack_int* ldwork );
-void LAPACK_dtprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const double* v, lapack_int* ldv, const double* t,
- lapack_int* ldt, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, const double* work,
- lapack_int* ldwork );
-void LAPACK_ctprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- const float* work, lapack_int* ldwork );
-void LAPACK_ztprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- const double* work, lapack_int* ldwork );
-// LAPACK 3.X.X
-void LAPACK_csyr( char* uplo, lapack_int* n, lapack_complex_float* alpha,
- const lapack_complex_float* x, lapack_int* incx,
- lapack_complex_float* a, lapack_int* lda );
-void LAPACK_zsyr( char* uplo, lapack_int* n, lapack_complex_double* alpha,
- const lapack_complex_double* x, lapack_int* incx,
- lapack_complex_double* a, lapack_int* lda );
-void LAPACK_ilaver( const lapack_int* vers_major, const lapack_int* vers_minor,
- const lapack_int* vers_patch );
-
-#ifdef __cplusplus
-}
-#endif /* __cplusplus */
-
-#endif /* _LAPACKE_H_ */
diff --git a/netlib/LAPACKE/lapacke_config.h b/netlib/LAPACKE/lapacke_config.h
deleted file mode 100644
index 1e2509b..0000000
--- a/netlib/LAPACKE/lapacke_config.h
+++ /dev/null
@@ -1,119 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK
-* Author: Intel Corporation
-* Generated May, 2011
-*****************************************************************************/
-
-#ifndef _LAPACKE_CONFIG_H_
-#define _LAPACKE_CONFIG_H_
-
-#ifdef __cplusplus
-#if defined(LAPACK_COMPLEX_CPP)
-#include <complex>
-#endif
-extern "C" {
-#endif /* __cplusplus */
-
-#include <stdlib.h>
-
-#ifndef lapack_int
-#if defined(LAPACK_ILP64)
-#define lapack_int long
-#else
-#define lapack_int int
-#endif
-#endif
-
-#ifndef lapack_logical
-#define lapack_logical lapack_int
-#endif
-
-#ifndef LAPACK_COMPLEX_CUSTOM
-
-#if defined(LAPACK_COMPLEX_STRUCTURE)
-
-typedef struct { float real, imag; } _lapack_complex_float;
-typedef struct { double real, imag; } _lapack_complex_double;
-#define lapack_complex_float _lapack_complex_float
-#define lapack_complex_double _lapack_complex_double
-#define lapack_complex_float_real(z) ((z).real)
-#define lapack_complex_float_imag(z) ((z).imag)
-#define lapack_complex_double_real(z) ((z).real)
-#define lapack_complex_double_imag(z) ((z).imag)
-
-#elif defined(LAPACK_COMPLEX_C99)
-
-#include <complex.h>
-#define lapack_complex_float float _Complex
-#define lapack_complex_double double _Complex
-#define lapack_complex_float_real(z) (creal(z))
-#define lapack_complex_float_imag(z) (cimag(z))
-#define lapack_complex_double_real(z) (creal(z))
-#define lapack_complex_double_imag(z) (cimag(z))
-
-#elif defined(LAPACK_COMPLEX_CPP)
-
-#define lapack_complex_float std::complex<float>
-#define lapack_complex_double std::complex<double>
-#define lapack_complex_float_real(z) ((z).real())
-#define lapack_complex_float_imag(z) ((z).imag())
-#define lapack_complex_double_real(z) ((z).real())
-#define lapack_complex_double_imag(z) ((z).imag())
-
-#else
-
-#include <complex.h>
-#define lapack_complex_float float _Complex
-#define lapack_complex_double double _Complex
-#define lapack_complex_float_real(z) (creal(z))
-#define lapack_complex_float_imag(z) (cimag(z))
-#define lapack_complex_double_real(z) (creal(z))
-#define lapack_complex_double_imag(z) (cimag(z))
-
-#endif
-
-lapack_complex_float lapack_make_complex_float( float re, float im );
-lapack_complex_double lapack_make_complex_double( double re, double im );
-
-#endif
-
-#ifndef LAPACK_malloc
-#define LAPACK_malloc( size ) malloc( size )
-#endif
-
-#ifndef LAPACK_free
-#define LAPACK_free( p ) free( p )
-#endif
-
-#ifdef __cplusplus
-}
-#endif /* __cplusplus */
-
-#endif /* _LAPACKE_CONFIG_H_ */
diff --git a/netlib/LAPACKE/lapacke_d_nancheck.c b/netlib/LAPACKE/lapacke_d_nancheck.c
deleted file mode 100644
index 1771ced..0000000
--- a/netlib/LAPACKE/lapacke_d_nancheck.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a vector for NaN entries. */
-
-lapack_logical LAPACKE_d_nancheck( lapack_int n,
- const double *x,
- lapack_int incx )
-{
- lapack_int i, inc;
-
- if( incx == 0 ) return (lapack_logical) LAPACK_DISNAN( x[0] );
- inc = ( incx > 0 ) ? incx : -incx ;
-
- for( i = 0; i < n*inc; i+=inc ) {
- if( LAPACK_DISNAN( x[i] ) )
- return (lapack_logical) 1;
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_dbbcsd.c b/netlib/LAPACKE/lapacke_dbbcsd.c
deleted file mode 100644
index 9afb8bb..0000000
--- a/netlib/LAPACKE/lapacke_dbbcsd.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dbbcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, double* theta,
- double* phi, double* u1, lapack_int ldu1, double* u2,
- lapack_int ldu2, double* v1t, lapack_int ldv1t,
- double* v2t, lapack_int ldv2t, double* b11d,
- double* b11e, double* b12d, double* b12e,
- double* b21d, double* b21e, double* b22d,
- double* b22e )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dbbcsd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( q, theta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nrows_u1, p, u1, ldu1 ) ) {
- return -12;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nrows_u2, m-p, u2, ldu2 ) ) {
- return -14;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v1t, q, v1t, ldv1t ) ) {
- return -16;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v2t, m-q, v2t, ldv2t ) ) {
- return -18;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dbbcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2,
- v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e,
- b21d, b21e, b22d, b22e, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dbbcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2,
- v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e,
- b21d, b21e, b22d, b22e, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbbcsd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dbbcsd_work.c b/netlib/LAPACKE/lapacke_dbbcsd_work.c
deleted file mode 100644
index 21d5879..0000000
--- a/netlib/LAPACKE/lapacke_dbbcsd_work.c
+++ /dev/null
@@ -1,199 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dbbcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- double* theta, double* phi, double* u1,
- lapack_int ldu1, double* u2, lapack_int ldu2,
- double* v1t, lapack_int ldv1t, double* v2t,
- lapack_int ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
- &ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- double* u1_t = NULL;
- double* u2_t = NULL;
- double* v1t_t = NULL;
- double* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
- v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
- b22d, b22e, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_dge_trans( matrix_order, nrows_u1, p, u1, ldu1, u1_t,
- ldu1_t );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_dge_trans( matrix_order, nrows_u2, m-p, u2, ldu2, u2_t,
- ldu2_t );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_dge_trans( matrix_order, nrows_v1t, q, v1t, ldv1t, v1t_t,
- ldv1t_t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_dge_trans( matrix_order, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
- ldv2t_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
- &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
- b21e, b22d, b22e, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dbdsdc.c b/netlib/LAPACKE/lapacke_dbdsdc.c
deleted file mode 100644
index 717ba3c..0000000
--- a/netlib/LAPACKE/lapacke_dbdsdc.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dbdsdc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dbdsdc( int matrix_order, char uplo, char compq,
- lapack_int n, double* d, double* e, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* q, lapack_int* iq )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- size_t lwork;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dbdsdc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- lwork = (size_t)3*MAX(1,n)*MAX(1,n)+4*MAX(1,n);
- } else if( LAPACKE_lsame( compq, 'p' ) ) {
- lwork = MAX(1,6*n);
- } else if( LAPACKE_lsame( compq, 'n' ) ) {
- lwork = MAX(1,4*n);
- } else {
- lwork = 1; /* Any value */
- }
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,8*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dbdsdc_work( matrix_order, uplo, compq, n, d, e, u, ldu, vt,
- ldvt, q, iq, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbdsdc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dbdsdc_work.c b/netlib/LAPACKE/lapacke_dbdsdc_work.c
deleted file mode 100644
index b1b84f0..0000000
--- a/netlib/LAPACKE/lapacke_dbdsdc_work.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dbdsdc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dbdsdc_work( int matrix_order, char uplo, char compq,
- lapack_int n, double* d, double* e, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* q, lapack_int* iq, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u, &ldu, vt, &ldvt, q, iq, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldu_t = MAX(1,n);
- lapack_int ldvt_t = MAX(1,n);
- double* u_t = NULL;
- double* vt_t = NULL;
- /* Check leading dimension(s) */
- if( ldu < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
- return info;
- }
- if( ldvt < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( compq, 'i' ) ) {
- vt_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u_t, &ldu_t, vt_t, &ldvt_t, q,
- iq, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_free( vt_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dbdsqr.c b/netlib/LAPACKE/lapacke_dbdsqr.c
deleted file mode 100644
index 7f1714d..0000000
--- a/netlib/LAPACKE/lapacke_dbdsqr.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dbdsqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, double* vt, lapack_int ldvt,
- double* u, lapack_int ldu, double* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dbdsqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( ncc != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, ncc, c, ldc ) ) {
- return -13;
- }
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -8;
- }
- if( nru != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_order, nru, n, u, ldu ) ) {
- return -11;
- }
- }
- if( ncvt != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, ncvt, vt, ldvt ) ) {
- return -9;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dbdsqr_work( matrix_order, uplo, n, ncvt, nru, ncc, d, e, vt,
- ldvt, u, ldu, c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbdsqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dbdsqr_work.c b/netlib/LAPACKE/lapacke_dbdsqr_work.c
deleted file mode 100644
index a3de068..0000000
--- a/netlib/LAPACKE/lapacke_dbdsqr_work.c
+++ /dev/null
@@ -1,145 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dbdsqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, double* vt,
- lapack_int ldvt, double* u, lapack_int ldu,
- double* c, lapack_int ldc, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt, &ldvt, u, &ldu,
- c, &ldc, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldc_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,nru);
- lapack_int ldvt_t = MAX(1,n);
- double* vt_t = NULL;
- double* u_t = NULL;
- double* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldc < ncc ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info );
- return info;
- }
- if( ldu < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info );
- return info;
- }
- if( ldvt < ncvt ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( ncvt != 0 ) {
- vt_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,ncvt) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( nru != 0 ) {
- u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( ncc != 0 ) {
- c_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,ncc) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- if( ncvt != 0 ) {
- LAPACKE_dge_trans( matrix_order, n, ncvt, vt, ldvt, vt_t, ldvt_t );
- }
- if( nru != 0 ) {
- LAPACKE_dge_trans( matrix_order, nru, n, u, ldu, u_t, ldu_t );
- }
- if( ncc != 0 ) {
- LAPACKE_dge_trans( matrix_order, n, ncc, c, ldc, c_t, ldc_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t,
- &ldu_t, c_t, &ldc_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( ncvt != 0 ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt,
- ldvt );
- }
- if( nru != 0 ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu );
- }
- if( ncc != 0 ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc );
- }
- /* Release memory and exit */
- if( ncc != 0 ) {
- LAPACKE_free( c_t );
- }
-exit_level_2:
- if( nru != 0 ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- if( ncvt != 0 ) {
- LAPACKE_free( vt_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ddisna.c b/netlib/LAPACKE/lapacke_ddisna.c
deleted file mode 100644
index b5cb340..0000000
--- a/netlib/LAPACKE/lapacke_ddisna.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ddisna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ddisna( char job, lapack_int m, lapack_int n,
- const double* d, double* sep )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
- return -4;
- }
-#endif
- return LAPACKE_ddisna_work( job, m, n, d, sep );
-}
diff --git a/netlib/LAPACKE/lapacke_ddisna_work.c b/netlib/LAPACKE/lapacke_ddisna_work.c
deleted file mode 100644
index f3ec282..0000000
--- a/netlib/LAPACKE/lapacke_ddisna_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ddisna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ddisna_work( char job, lapack_int m, lapack_int n,
- const double* d, double* sep )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_ddisna( &job, &m, &n, d, sep, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgb_nancheck.c b/netlib/LAPACKE/lapacke_dgb_nancheck.c
deleted file mode 100644
index fc86962..0000000
--- a/netlib/LAPACKE/lapacke_dgb_nancheck.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dgb_nancheck( int matrix_order, lapack_int m,
- lapack_int n, lapack_int kl,
- lapack_int ku,
- const double *ab,
- lapack_int ldab )
-{
- lapack_int i, j;
-
- if( ab == NULL ) return (lapack_logical) 0;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- for( j = 0; j < n; j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN3( ldab, m+ku-j, kl+ku+1 );
- i++ ) {
- if( LAPACK_DISNAN( ab[i+(size_t)j*ldab] ) )
- return (lapack_logical) 1;
- }
- }
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- for( j = 0; j < MIN( n, ldab ); j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) {
- if( LAPACK_DISNAN( ab[(size_t)i*ldab+j] ) )
- return (lapack_logical) 1;
- }
- }
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_dgb_trans.c b/netlib/LAPACKE/lapacke_dgb_trans.c
deleted file mode 100644
index b48986e..0000000
--- a/netlib/LAPACKE/lapacke_dgb_trans.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input general band matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dgb_trans( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- lapack_int i, j;
-
- if( in == NULL || out == NULL ) return;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- for( j = 0; j < MIN( ldout, n ); j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN3( ldin, m+ku-j, kl+ku+1 );
- i++ ) {
- out[(size_t)i*ldout+j] = in[i+(size_t)j*ldin];
- }
- }
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- /* TODO: interchange loops for performance.
- * This is just reference impemeltation.
- */
- for( j = 0; j < MIN( n, ldin ); j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN3( ldout, m+ku-j, kl+ku+1 );
- i++ ) {
- out[i+(size_t)j*ldout] = in[(size_t)i*ldin+j];
- }
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dgbbrd.c b/netlib/LAPACKE/lapacke_dgbbrd.c
deleted file mode 100644
index 7301804..0000000
--- a/netlib/LAPACKE/lapacke_dgbbrd.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbbrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq,
- double* pt, lapack_int ldpt, double* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbbrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, m, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( ncc != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_order, m, ncc, c, ldc ) ) {
- return -16;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*MAX(m,n)) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgbbrd_work( matrix_order, vect, m, n, ncc, kl, ku, ab, ldab,
- d, e, q, ldq, pt, ldpt, c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbbrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbbrd_work.c b/netlib/LAPACKE/lapacke_dgbbrd_work.c
deleted file mode 100644
index 77800d5..0000000
--- a/netlib/LAPACKE/lapacke_dgbbrd_work.c
+++ /dev/null
@@ -1,156 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbbrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq,
- double* pt, lapack_int ldpt, double* c,
- lapack_int ldc, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab, &ldab, d, e, q, &ldq,
- pt, &ldpt, c, &ldc, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- lapack_int ldc_t = MAX(1,m);
- lapack_int ldpt_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,m);
- double* ab_t = NULL;
- double* q_t = NULL;
- double* pt_t = NULL;
- double* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
- return info;
- }
- if( ldc < ncc ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
- return info;
- }
- if( ldpt < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
- return info;
- }
- if( ldq < m ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,m) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
- pt_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldpt_t * MAX(1,n) );
- if( pt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( ncc != 0 ) {
- c_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,ncc) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
- if( ncc != 0 ) {
- LAPACKE_dge_trans( matrix_order, m, ncc, c, ldc, c_t, ldc_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t,
- &ldq_t, pt_t, &ldpt_t, c_t, &ldc_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt );
- }
- if( ncc != 0 ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc );
- }
- /* Release memory and exit */
- if( ncc != 0 ) {
- LAPACKE_free( c_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
- LAPACKE_free( pt_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbcon.c b/netlib/LAPACKE/lapacke_dgbcon.c
deleted file mode 100644
index 3cbb425..0000000
--- a/netlib/LAPACKE/lapacke_dgbcon.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgbcon_work( matrix_order, norm, n, kl, ku, ab, ldab, ipiv,
- anorm, rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbcon_work.c b/netlib/LAPACKE/lapacke_dgbcon_work.c
deleted file mode 100644
index 0c89b0d..0000000
--- a/netlib/LAPACKE/lapacke_dgbcon_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbcon( &norm, &n, &kl, &ku, ab, &ldab, ipiv, &anorm, rcond,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgbcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, n, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbcon( &norm, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &anorm, rcond,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbequ.c b/netlib/LAPACKE/lapacke_dgbequ.c
deleted file mode 100644
index ecc9430..0000000
--- a/netlib/LAPACKE/lapacke_dgbequ.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, m, n, kl, ku, ab, ldab ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dgbequ_work( matrix_order, m, n, kl, ku, ab, ldab, r, c,
- rowcnd, colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dgbequ_work.c b/netlib/LAPACKE/lapacke_dgbequ_work.c
deleted file mode 100644
index b9127db..0000000
--- a/netlib/LAPACKE/lapacke_dgbequ_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbequ( &m, &n, &kl, &ku, ab, &ldab, r, c, rowcnd, colcnd, amax,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgbequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbequ( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd,
- amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbequb.c b/netlib/LAPACKE/lapacke_dgbequb.c
deleted file mode 100644
index 9df3f65..0000000
--- a/netlib/LAPACKE/lapacke_dgbequb.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, m, n, kl, ku, ab, ldab ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dgbequb_work( matrix_order, m, n, kl, ku, ab, ldab, r, c,
- rowcnd, colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dgbequb_work.c b/netlib/LAPACKE/lapacke_dgbequb_work.c
deleted file mode 100644
index 7b6b65f..0000000
--- a/netlib/LAPACKE/lapacke_dgbequb_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbequb( &m, &n, &kl, &ku, ab, &ldab, r, c, rowcnd, colcnd, amax,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgbequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbequb( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd,
- amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbrfs.c b/netlib/LAPACKE/lapacke_dgbrfs.c
deleted file mode 100644
index ba60da4..0000000
--- a/netlib/LAPACKE/lapacke_dgbrfs.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab, const double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -14;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgbrfs_work( matrix_order, trans, n, kl, ku, nrhs, ab, ldab,
- afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbrfs_work.c b/netlib/LAPACKE/lapacke_dgbrfs_work.c
deleted file mode 100644
index 1baca5c..0000000
--- a/netlib/LAPACKE/lapacke_dgbrfs_work.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbrfs( &trans, &n, &kl, &ku, &nrhs, ab, &ldab, afb, &ldafb,
- ipiv, b, &ldb, x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- lapack_int ldafb_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* ab_t = NULL;
- double* afb_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (double*)LAPACKE_malloc( sizeof(double) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, n, n, kl, ku, ab, ldab, ab_t, ldab_t );
- LAPACKE_dgb_trans( matrix_order, n, n, kl, kl+ku, afb, ldafb, afb_t,
- ldafb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbrfs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t,
- &ldafb_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbsv.c b/netlib/LAPACKE/lapacke_dgbsv.c
deleted file mode 100644
index 1483379..0000000
--- a/netlib/LAPACKE/lapacke_dgbsv.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, double* ab,
- lapack_int ldab, lapack_int* ipiv, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
-#endif
- return LAPACKE_dgbsv_work( matrix_order, n, kl, ku, nrhs, ab, ldab, ipiv, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dgbsv_work.c b/netlib/LAPACKE/lapacke_dgbsv_work.c
deleted file mode 100644
index b39ea82..0000000
--- a/netlib/LAPACKE/lapacke_dgbsv_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, double* ab,
- lapack_int ldab, lapack_int* ipiv, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbsv( &n, &kl, &ku, &nrhs, ab, &ldab, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- double* ab_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgbsv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgbsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, n, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbsv( &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbsvx.c b/netlib/LAPACKE/lapacke_dgbsvx.c
deleted file mode 100644
index f315d6b..0000000
--- a/netlib/LAPACKE/lapacke_dgbsvx.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -15;
- }
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -14;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgbsvx_work( matrix_order, fact, trans, n, kl, ku, nrhs, ab,
- ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x,
- ldx, rcond, ferr, berr, work, iwork );
- /* Backup significant data from working array(s) */
- *rpivot = work[0];
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbsvx_work.c b/netlib/LAPACKE/lapacke_dgbsvx_work.c
deleted file mode 100644
index 26b8dc0..0000000
--- a/netlib/LAPACKE/lapacke_dgbsvx_work.c
+++ /dev/null
@@ -1,151 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab, &ldab, afb,
- &ldafb, ipiv, equed, r, c, b, &ldb, x, &ldx, rcond, ferr,
- berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- lapack_int ldafb_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* ab_t = NULL;
- double* afb_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (double*)LAPACKE_malloc( sizeof(double) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, n, n, kl, ku, ab, ldab, ab_t, ldab_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dgb_trans( matrix_order, n, n, kl, kl+ku, afb, ldafb, afb_t,
- ldafb_t );
- }
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t,
- &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t,
- rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab,
- ldab );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t,
- ldafb_t, afb, ldafb );
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- }
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbtrf.c b/netlib/LAPACKE/lapacke_dgbtrf.c
deleted file mode 100644
index fc36795..0000000
--- a/netlib/LAPACKE/lapacke_dgbtrf.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, double* ab,
- lapack_int ldab, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbtrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, m, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dgbtrf_work( matrix_order, m, n, kl, ku, ab, ldab, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_dgbtrf_work.c b/netlib/LAPACKE/lapacke_dgbtrf_work.c
deleted file mode 100644
index 4500307..0000000
--- a/netlib/LAPACKE/lapacke_dgbtrf_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, double* ab,
- lapack_int ldab, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbtrf( &m, &n, &kl, &ku, ab, &ldab, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgbtrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, m, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbtrf( &m, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dgb_trans( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab,
- ldab );
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbtrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbtrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgbtrs.c b/netlib/LAPACKE/lapacke_dgbtrs.c
deleted file mode 100644
index 8ed1b9d..0000000
--- a/netlib/LAPACKE/lapacke_dgbtrs.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const lapack_int* ipiv, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgbtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, kl+ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
-#endif
- return LAPACKE_dgbtrs_work( matrix_order, trans, n, kl, ku, nrhs, ab, ldab,
- ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dgbtrs_work.c b/netlib/LAPACKE/lapacke_dgbtrs_work.c
deleted file mode 100644
index a8b1bda..0000000
--- a/netlib/LAPACKE/lapacke_dgbtrs_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const lapack_int* ipiv, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgbtrs( &trans, &n, &kl, &ku, &nrhs, ab, &ldab, ipiv, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- double* ab_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dgb_trans( matrix_order, n, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgbtrs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t,
- &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dge_nancheck.c b/netlib/LAPACKE/lapacke_dge_nancheck.c
deleted file mode 100644
index 27938cd..0000000
--- a/netlib/LAPACKE/lapacke_dge_nancheck.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dge_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const double *a,
- lapack_int lda )
-{
- lapack_int i, j;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- for( j = 0; j < n; j++ ) {
- for( i = 0; i < MIN( m, lda ); i++ ) {
- if( LAPACK_DISNAN( a[i+(size_t)j*lda] ) )
- return (lapack_logical) 1;
- }
- }
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- for( i = 0; i < m; i++ ) {
- for( j = 0; j < MIN( n, lda ); j++ ) {
- if( LAPACK_DISNAN( a[(size_t)i*lda+j] ) )
- return (lapack_logical) 1;
- }
- }
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_dge_trans.c b/netlib/LAPACKE/lapacke_dge_trans.c
deleted file mode 100644
index 689a3ec..0000000
--- a/netlib/LAPACKE/lapacke_dge_trans.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input general matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dge_trans( int matrix_order, lapack_int m, lapack_int n,
- const double* in, lapack_int ldin,
- double* out, lapack_int ldout )
-{
- lapack_int i, j, x, y;
-
- if( in == NULL || out == NULL ) return;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- x = n;
- y = m;
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- x = m;
- y = n;
- } else {
- /* Unknown input layout */
- return;
- }
-
- /* In case of incorrect m, n, ldin or ldout the function does nothing */
- for( i = 0; i < MIN( y, ldin ); i++ ) {
- for( j = 0; j < MIN( x, ldout ); j++ ) {
- out[ (size_t)i*ldout + j ] = in[ (size_t)j*ldin + i ];
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dgebak.c b/netlib/LAPACKE/lapacke_dgebak.c
deleted file mode 100644
index ff3fca7..0000000
--- a/netlib/LAPACKE/lapacke_dgebak.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgebak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* scale,
- lapack_int m, double* v, lapack_int ldv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgebak", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, scale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, m, v, ldv ) ) {
- return -9;
- }
-#endif
- return LAPACKE_dgebak_work( matrix_order, job, side, n, ilo, ihi, scale, m,
- v, ldv );
-}
diff --git a/netlib/LAPACKE/lapacke_dgebak_work.c b/netlib/LAPACKE/lapacke_dgebak_work.c
deleted file mode 100644
index 4d7c889..0000000
--- a/netlib/LAPACKE/lapacke_dgebak_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgebak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* scale, lapack_int m, double* v,
- lapack_int ldv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v, &ldv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldv_t = MAX(1,n);
- double* v_t = NULL;
- /* Check leading dimension(s) */
- if( ldv < m ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgebak_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,m) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv );
- /* Release memory and exit */
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgebak_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgebak_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgebal.c b/netlib/LAPACKE/lapacke_dgebal.c
deleted file mode 100644
index d1fd12a..0000000
--- a/netlib/LAPACKE/lapacke_dgebal.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgebal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgebal( int matrix_order, char job, lapack_int n, double* a,
- lapack_int lda, lapack_int* ilo, lapack_int* ihi,
- double* scale )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgebal", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- }
-#endif
- return LAPACKE_dgebal_work( matrix_order, job, n, a, lda, ilo, ihi, scale );
-}
diff --git a/netlib/LAPACKE/lapacke_dgebal_work.c b/netlib/LAPACKE/lapacke_dgebal_work.c
deleted file mode 100644
index 411ccab..0000000
--- a/netlib/LAPACKE/lapacke_dgebal_work.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgebal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgebal_work( int matrix_order, char job, lapack_int n,
- double* a, lapack_int lda, lapack_int* ilo,
- lapack_int* ihi, double* scale )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgebal( &job, &n, a, &lda, ilo, ihi, scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgebal_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- LAPACKE_free( a_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgebal_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgebal_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgebrd.c b/netlib/LAPACKE/lapacke_dgebrd.c
deleted file mode 100644
index 27659da..0000000
--- a/netlib/LAPACKE/lapacke_dgebrd.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgebrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgebrd( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tauq, double* taup )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgebrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgebrd_work( matrix_order, m, n, a, lda, d, e, tauq, taup,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgebrd_work( matrix_order, m, n, a, lda, d, e, tauq, taup,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgebrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgebrd_work.c b/netlib/LAPACKE/lapacke_dgebrd_work.c
deleted file mode 100644
index b55911d..0000000
--- a/netlib/LAPACKE/lapacke_dgebrd_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgebrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tauq, double* taup, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgebrd( &m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgebrd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgebrd( &m, &n, a, &lda_t, d, e, tauq, taup, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgebrd( &m, &n, a_t, &lda_t, d, e, tauq, taup, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgebrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgebrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgecon.c b/netlib/LAPACKE/lapacke_dgecon.c
deleted file mode 100644
index 8a76d54..0000000
--- a/netlib/LAPACKE/lapacke_dgecon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgecon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgecon( int matrix_order, char norm, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgecon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgecon_work( matrix_order, norm, n, a, lda, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgecon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgecon_work.c b/netlib/LAPACKE/lapacke_dgecon_work.c
deleted file mode 100644
index 33525c6..0000000
--- a/netlib/LAPACKE/lapacke_dgecon_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgecon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgecon_work( int matrix_order, char norm, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgecon( &norm, &n, a, &lda, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgecon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgecon( &norm, &n, a_t, &lda_t, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgecon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgecon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeequ.c b/netlib/LAPACKE/lapacke_dgeequ.c
deleted file mode 100644
index 33a4fb1..0000000
--- a/netlib/LAPACKE/lapacke_dgeequ.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeequ( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgeequ_work( matrix_order, m, n, a, lda, r, c, rowcnd,
- colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dgeequ_work.c b/netlib/LAPACKE/lapacke_dgeequ_work.c
deleted file mode 100644
index 684ba93..0000000
--- a/netlib/LAPACKE/lapacke_dgeequ_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeequ( &m, &n, a, &lda, r, c, rowcnd, colcnd, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeequb.c b/netlib/LAPACKE/lapacke_dgeequb.c
deleted file mode 100644
index 853e200..0000000
--- a/netlib/LAPACKE/lapacke_dgeequb.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeequb( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgeequb_work( matrix_order, m, n, a, lda, r, c, rowcnd,
- colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dgeequb_work.c b/netlib/LAPACKE/lapacke_dgeequb_work.c
deleted file mode 100644
index ffe29ac..0000000
--- a/netlib/LAPACKE/lapacke_dgeequb_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeequb( &m, &n, a, &lda, r, c, rowcnd, colcnd, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeequb( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgees.c b/netlib/LAPACKE/lapacke_dgees.c
deleted file mode 100644
index 09be6a4..0000000
--- a/netlib/LAPACKE/lapacke_dgees.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgees
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgees( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, lapack_int n, double* a,
- lapack_int lda, lapack_int* sdim, double* wr,
- double* wi, double* vs, lapack_int ldvs )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgees", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dgees_work( matrix_order, jobvs, sort, select, n, a, lda,
- sdim, wr, wi, vs, ldvs, &work_query, lwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgees_work( matrix_order, jobvs, sort, select, n, a, lda,
- sdim, wr, wi, vs, ldvs, work, lwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgees", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgees_work.c b/netlib/LAPACKE/lapacke_dgees_work.c
deleted file mode 100644
index 6c8e27e..0000000
--- a/netlib/LAPACKE/lapacke_dgees_work.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgees
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, lapack_int n, double* a,
- lapack_int lda, lapack_int* sdim, double* wr,
- double* wi, double* vs, lapack_int ldvs,
- double* work, lapack_int lwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgees( &jobvs, &sort, select, &n, a, &lda, sdim, wr, wi, vs,
- &ldvs, work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvs_t = MAX(1,n);
- double* a_t = NULL;
- double* vs_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgees_work", info );
- return info;
- }
- if( ldvs < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dgees_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgees( &jobvs, &sort, select, &n, a, &lda_t, sdim, wr, wi,
- vs, &ldvs_t, work, &lwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- vs_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvs_t * MAX(1,n) );
- if( vs_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, wr, wi,
- vs_t, &ldvs_t, work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_free( vs_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgees_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgees_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeesx.c b/netlib/LAPACKE/lapacke_dgeesx.c
deleted file mode 100644
index 55fd78f..0000000
--- a/netlib/LAPACKE/lapacke_dgeesx.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, char sense, lapack_int n,
- double* a, lapack_int lda, lapack_int* sdim,
- double* wr, double* wi, double* vs, lapack_int ldvs,
- double* rconde, double* rcondv )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeesx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeesx_work( matrix_order, jobvs, sort, select, sense, n, a,
- lda, sdim, wr, wi, vs, ldvs, rconde, rcondv,
- &work_query, lwork, &iwork_query, liwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeesx_work( matrix_order, jobvs, sort, select, sense, n, a,
- lda, sdim, wr, wi, vs, ldvs, rconde, rcondv,
- work, lwork, iwork, liwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeesx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeesx_work.c b/netlib/LAPACKE/lapacke_dgeesx_work.c
deleted file mode 100644
index 731801d..0000000
--- a/netlib/LAPACKE/lapacke_dgeesx_work.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, char sense,
- lapack_int n, double* a, lapack_int lda,
- lapack_int* sdim, double* wr, double* wi,
- double* vs, lapack_int ldvs, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeesx( &jobvs, &sort, select, &sense, &n, a, &lda, sdim, wr, wi,
- vs, &ldvs, rconde, rcondv, work, &lwork, iwork, &liwork,
- bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvs_t = MAX(1,n);
- double* a_t = NULL;
- double* vs_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgeesx_work", info );
- return info;
- }
- if( ldvs < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dgeesx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dgeesx( &jobvs, &sort, select, &sense, &n, a, &lda_t, sdim,
- wr, wi, vs, &ldvs_t, rconde, rcondv, work, &lwork,
- iwork, &liwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- vs_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvs_t * MAX(1,n) );
- if( vs_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeesx( &jobvs, &sort, select, &sense, &n, a_t, &lda_t, sdim, wr,
- wi, vs_t, &ldvs_t, rconde, rcondv, work, &lwork, iwork,
- &liwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_free( vs_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeesx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeesx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeev.c b/netlib/LAPACKE/lapacke_dgeev.c
deleted file mode 100644
index b92e1ff..0000000
--- a/netlib/LAPACKE/lapacke_dgeev.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda, double* wr,
- double* wi, double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeev_work( matrix_order, jobvl, jobvr, n, a, lda, wr, wi,
- vl, ldvl, vr, ldvr, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeev_work( matrix_order, jobvl, jobvr, n, a, lda, wr, wi,
- vl, ldvl, vr, ldvr, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeev_work.c b/netlib/LAPACKE/lapacke_dgeev_work.c
deleted file mode 100644
index 0510d00..0000000
--- a/netlib/LAPACKE/lapacke_dgeev_work.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda,
- double* wr, double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeev( &jobvl, &jobvr, &n, a, &lda, wr, wi, vl, &ldvl, vr, &ldvr,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* a_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgeev_work", info );
- return info;
- }
- if( ldvl < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgeev_work", info );
- return info;
- }
- if( ldvr < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dgeev_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgeev( &jobvl, &jobvr, &n, a, &lda_t, wr, wi, vl, &ldvl_t,
- vr, &ldvr_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeev( &jobvl, &jobvr, &n, a_t, &lda_t, wr, wi, vl_t, &ldvl_t,
- vr_t, &ldvr_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeevx.c b/netlib/LAPACKE/lapacke_dgeevx.c
deleted file mode 100644
index e0473b2..0000000
--- a/netlib/LAPACKE/lapacke_dgeevx.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* wr, double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- double* abnrm, double* rconde, double* rcondv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- iwork = (lapack_int*)
- LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*n-2) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi,
- scale, abnrm, rconde, rcondv, &work_query,
- lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi,
- scale, abnrm, rconde, rcondv, work, lwork,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeevx_work.c b/netlib/LAPACKE/lapacke_dgeevx_work.c
deleted file mode 100644
index 8a71430..0000000
--- a/netlib/LAPACKE/lapacke_dgeevx_work.c
+++ /dev/null
@@ -1,142 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* wr, double* wi,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, double* scale, double* abnrm,
- double* rconde, double* rcondv, double* work,
- lapack_int lwork, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda, wr, wi, vl,
- &ldvl, vr, &ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* a_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
- return info;
- }
- if( ldvl < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
- return info;
- }
- if( ldvr < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda_t, wr,
- wi, vl, &ldvl_t, vr, &ldvr_t, ilo, ihi, scale, abnrm,
- rconde, rcondv, work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, wr, wi,
- vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm,
- rconde, rcondv, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgehrd.c b/netlib/LAPACKE/lapacke_dgehrd.c
deleted file mode 100644
index ffefe3f..0000000
--- a/netlib/LAPACKE/lapacke_dgehrd.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgehrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgehrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgehrd_work( matrix_order, n, ilo, ihi, a, lda, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgehrd_work( matrix_order, n, ilo, ihi, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgehrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgehrd_work.c b/netlib/LAPACKE/lapacke_dgehrd_work.c
deleted file mode 100644
index 35f20d2..0000000
--- a/netlib/LAPACKE/lapacke_dgehrd_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgehrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- double* tau, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgehrd( &n, &ilo, &ihi, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgehrd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgehrd( &n, &ilo, &ihi, a, &lda_t, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgehrd( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgehrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgehrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgejsv.c b/netlib/LAPACKE/lapacke_dgejsv.c
deleted file mode 100644
index 2ac3db1..0000000
--- a/netlib/LAPACKE/lapacke_dgejsv.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgejsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgejsv( int matrix_order, char joba, char jobu, char jobv,
- char jobr, char jobt, char jobp, lapack_int m,
- lapack_int n, double* a, lapack_int lda, double* sva,
- double* u, lapack_int ldu, double* v, lapack_int ldv,
- double* stat, lapack_int* istat )
-{
- lapack_int info = 0;
- lapack_int lwork = (!( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ||
- LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ||
- LAPACKE_lsame( joba, 'e' ) ||
- LAPACKE_lsame( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) :
- ( (!( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ||
- LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- ( LAPACKE_lsame( joba, 'e' ) ||
- LAPACKE_lsame( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) :
- ( ( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) &&
- (!( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) ) ? MAX(7,2*n+m) :
- ( ( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- (!( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) ) ? MAX(7,2*n+m) :
- ( ( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) &&
- ( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- !LAPACKE_lsame( jobv, 'j' ) ? MAX(1,6*n+2*n*n) :
- ( ( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) &&
- ( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) :
- 1) ) ) ) ) );
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int i;
- lapack_int nu, nv;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgejsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nu, n, u, ldu ) ) {
- return -13;
- }
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nv, n, v, ldv ) ) {
- return -15;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+3*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgejsv_work( matrix_order, joba, jobu, jobv, jobr, jobt,
- jobp, m, n, a, lda, sva, u, ldu, v, ldv, work,
- lwork, iwork );
- /* Backup significant data from working array(s) */
- for( i=0; i<7; i++ ) {
- stat[i] = work[i];
- }
- for( i=0; i<3; i++ ) {
- istat[i] = iwork[i];
- }
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgejsv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgejsv_work.c b/netlib/LAPACKE/lapacke_dgejsv_work.c
deleted file mode 100644
index ee5f40e..0000000
--- a/netlib/LAPACKE/lapacke_dgejsv_work.c
+++ /dev/null
@@ -1,147 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgejsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgejsv_work( int matrix_order, char joba, char jobu,
- char jobv, char jobr, char jobt, char jobp,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* sva, double* u,
- lapack_int ldu, double* v, lapack_int ldv,
- double* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a,
- &lda, sva, u, &ldu, v, &ldv, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- lapack_int nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- lapack_int lda_t = MAX(1,m);
- lapack_int ldu_t = MAX(1,nu);
- lapack_int ldv_t = MAX(1,nv);
- double* a_t = NULL;
- double* u_t = NULL;
- double* v_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgejsv_work", info );
- return info;
- }
- if( ldu < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dgejsv_work", info );
- return info;
- }
- if( ldv < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dgejsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- LAPACKE_dge_trans( matrix_order, nu, n, u, ldu, u_t, ldu_t );
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- LAPACKE_dge_trans( matrix_order, nv, n, v, ldv, v_t, ldv_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a_t,
- &lda_t, sva, u_t, &ldu_t, v_t, &ldv_t, work, &lwork,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nu, n, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgejsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgejsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelq2.c b/netlib/LAPACKE/lapacke_dgelq2.c
deleted file mode 100644
index 2388d9d..0000000
--- a/netlib/LAPACKE/lapacke_dgelq2.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgelq2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelq2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgelq2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgelq2_work( matrix_order, m, n, a, lda, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelq2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelq2_work.c b/netlib/LAPACKE/lapacke_dgelq2_work.c
deleted file mode 100644
index bf54be2..0000000
--- a/netlib/LAPACKE/lapacke_dgelq2_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgelq2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgelq2( &m, &n, a, &lda, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgelq2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgelq2( &m, &n, a_t, &lda_t, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelq2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgelq2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelqf.c b/netlib/LAPACKE/lapacke_dgelqf.c
deleted file mode 100644
index 4d283d8..0000000
--- a/netlib/LAPACKE/lapacke_dgelqf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgelqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelqf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgelqf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgelqf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgelqf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelqf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelqf_work.c b/netlib/LAPACKE/lapacke_dgelqf_work.c
deleted file mode 100644
index e37f2de..0000000
--- a/netlib/LAPACKE/lapacke_dgelqf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgelqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgelqf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgelqf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgelqf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgelqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelqf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgelqf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgels.c b/netlib/LAPACKE/lapacke_dgels.c
deleted file mode 100644
index 6db4ac2..0000000
--- a/netlib/LAPACKE/lapacke_dgels.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgels
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgels", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgels_work( matrix_order, trans, m, n, nrhs, a, lda, b, ldb,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgels_work( matrix_order, trans, m, n, nrhs, a, lda, b, ldb,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgels", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgels_work.c b/netlib/LAPACKE/lapacke_dgels_work.c
deleted file mode 100644
index 526692b..0000000
--- a/netlib/LAPACKE/lapacke_dgels_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgels
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgels( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgels_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgels_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgels( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgels( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgels_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgels_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelsd.c b/netlib/LAPACKE/lapacke_dgelsd.c
deleted file mode 100644
index baee621..0000000
--- a/netlib/LAPACKE/lapacke_dgelsd.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgelsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s, double rcond,
- lapack_int* rank )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- /* Additional scalars declarations for work arrays */
- lapack_int liwork;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgelsd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgelsd_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, &work_query, lwork, &iwork_query );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgelsd_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelsd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelsd_work.c b/netlib/LAPACKE/lapacke_dgelsd_work.c
deleted file mode 100644
index a586236..0000000
--- a/netlib/LAPACKE/lapacke_dgelsd_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgelsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgelsd( &m, &n, &nrhs, a, &lda, b, &ldb, s, &rcond, rank, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgelsd_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgelsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgelsd( &m, &n, &nrhs, a, &lda_t, b, &ldb_t, s, &rcond, rank,
- work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgelsd( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelsd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgelsd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelss.c b/netlib/LAPACKE/lapacke_dgelss.c
deleted file mode 100644
index 550a1d9..0000000
--- a/netlib/LAPACKE/lapacke_dgelss.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgelss
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s, double rcond,
- lapack_int* rank )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgelss", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgelss_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgelss_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelss", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelss_work.c b/netlib/LAPACKE/lapacke_dgelss_work.c
deleted file mode 100644
index 35f363d..0000000
--- a/netlib/LAPACKE/lapacke_dgelss_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgelss
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgelss( &m, &n, &nrhs, a, &lda, b, &ldb, s, &rcond, rank, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgelss_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgelss_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgelss( &m, &n, &nrhs, a, &lda_t, b, &ldb_t, s, &rcond, rank,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgelss( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelss_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgelss_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelsy.c b/netlib/LAPACKE/lapacke_dgelsy.c
deleted file mode 100644
index ed5751b..0000000
--- a/netlib/LAPACKE/lapacke_dgelsy.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgelsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* jpvt,
- double rcond, lapack_int* rank )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgelsy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgelsy_work( matrix_order, m, n, nrhs, a, lda, b, ldb, jpvt,
- rcond, rank, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgelsy_work( matrix_order, m, n, nrhs, a, lda, b, ldb, jpvt,
- rcond, rank, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelsy", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgelsy_work.c b/netlib/LAPACKE/lapacke_dgelsy_work.c
deleted file mode 100644
index 6fdf94c..0000000
--- a/netlib/LAPACKE/lapacke_dgelsy_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgelsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* jpvt,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgelsy( &m, &n, &nrhs, a, &lda, b, &ldb, jpvt, &rcond, rank,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgelsy_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgelsy_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgelsy( &m, &n, &nrhs, a, &lda_t, b, &ldb_t, jpvt, &rcond,
- rank, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgelsy( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, jpvt, &rcond,
- rank, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgelsy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgelsy_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgemqrt.c b/netlib/LAPACKE/lapacke_dgemqrt.c
deleted file mode 100644
index f3e55ac..0000000
--- a/netlib/LAPACKE/lapacke_dgemqrt.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgemqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgemqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_order, ldt, nb, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) * MAX(1,nb) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgemqrt_work( matrix_order, side, trans, m, n, k, nb, v, ldv,
- t, ldt, c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgemqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgemqrt_work.c b/netlib/LAPACKE/lapacke_dgemqrt_work.c
deleted file mode 100644
index 80e0ff2..0000000
--- a/netlib/LAPACKE/lapacke_dgemqrt_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgemqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgemqrt( &side, &trans, &m, &n, &k, &nb, v, &ldv, t, &ldt, c,
- &ldc, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldc_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- lapack_int ldv_t = MAX(1,ldv);
- double* v_t = NULL;
- double* t_t = NULL;
- double* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info );
- return info;
- }
- if( ldt < nb ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info );
- return info;
- }
- if( ldv < k ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,k) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,nb) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
- LAPACKE_dge_trans( matrix_order, ldt, nb, t, ldt, t_t, ldt_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t,
- &ldt_t, c_t, &ldc_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqlf.c b/netlib/LAPACKE/lapacke_dgeqlf.c
deleted file mode 100644
index 4e3e3d1..0000000
--- a/netlib/LAPACKE/lapacke_dgeqlf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqlf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqlf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqlf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeqlf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqlf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqlf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqlf_work.c b/netlib/LAPACKE/lapacke_dgeqlf_work.c
deleted file mode 100644
index 7ff8f16..0000000
--- a/netlib/LAPACKE/lapacke_dgeqlf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqlf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqlf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqlf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgeqlf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqlf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqlf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqlf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqp3.c b/netlib/LAPACKE/lapacke_dgeqp3.c
deleted file mode 100644
index 3be5af0..0000000
--- a/netlib/LAPACKE/lapacke_dgeqp3.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqp3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqp3( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqp3", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeqp3_work( matrix_order, m, n, a, lda, jpvt, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqp3_work( matrix_order, m, n, a, lda, jpvt, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqp3", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqp3_work.c b/netlib/LAPACKE/lapacke_dgeqp3_work.c
deleted file mode 100644
index 8d25db2..0000000
--- a/netlib/LAPACKE/lapacke_dgeqp3_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqp3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqp3( &m, &n, a, &lda, jpvt, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqp3_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgeqp3( &m, &n, a, &lda_t, jpvt, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqp3( &m, &n, a_t, &lda_t, jpvt, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqp3_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqp3_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqpf.c b/netlib/LAPACKE/lapacke_dgeqpf.c
deleted file mode 100644
index 3acecbc..0000000
--- a/netlib/LAPACKE/lapacke_dgeqpf.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqpf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqpf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqpf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqpf_work( matrix_order, m, n, a, lda, jpvt, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqpf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqpf_work.c b/netlib/LAPACKE/lapacke_dgeqpf_work.c
deleted file mode 100644
index 12707ae..0000000
--- a/netlib/LAPACKE/lapacke_dgeqpf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqpf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqpf( &m, &n, a, &lda, jpvt, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqpf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqpf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqpf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqr2.c b/netlib/LAPACKE/lapacke_dgeqr2.c
deleted file mode 100644
index ba427be..0000000
--- a/netlib/LAPACKE/lapacke_dgeqr2.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqr2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqr2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqr2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqr2_work( matrix_order, m, n, a, lda, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqr2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqr2_work.c b/netlib/LAPACKE/lapacke_dgeqr2_work.c
deleted file mode 100644
index faa6aae..0000000
--- a/netlib/LAPACKE/lapacke_dgeqr2_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqr2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqr2( &m, &n, a, &lda, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqr2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqr2( &m, &n, a_t, &lda_t, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqr2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqr2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrf.c b/netlib/LAPACKE/lapacke_dgeqrf.c
deleted file mode 100644
index e41778a..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeqrf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqrf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrf_work.c b/netlib/LAPACKE/lapacke_dgeqrf_work.c
deleted file mode 100644
index 0b10a81..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgeqrf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrfp.c b/netlib/LAPACKE/lapacke_dgeqrfp.c
deleted file mode 100644
index c5d0a47..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrfp.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqrfp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrfp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgeqrfp_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqrfp_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrfp", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrfp_work.c b/netlib/LAPACKE/lapacke_dgeqrfp_work.c
deleted file mode 100644
index 6284c32..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrfp_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqrfp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrfp( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqrfp_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgeqrfp( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrfp( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrfp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqrfp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrt.c b/netlib/LAPACKE/lapacke_dgeqrt.c
deleted file mode 100644
index e80ce29..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrt.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, double* a, lapack_int lda, double* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,nb) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgeqrt_work( matrix_order, m, n, nb, a, lda, t, ldt, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrt2.c b/netlib/LAPACKE/lapacke_dgeqrt2.c
deleted file mode 100644
index 64f8a31..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrt2.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgeqrt2_work( matrix_order, m, n, a, lda, t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrt2_work.c b/netlib/LAPACKE/lapacke_dgeqrt2_work.c
deleted file mode 100644
index 1712a4a..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrt2_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrt2( &m, &n, a, &lda, t, &ldt, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,n);
- double* a_t = NULL;
- double* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrt2( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrt3.c b/netlib/LAPACKE/lapacke_dgeqrt3.c
deleted file mode 100644
index 4ffe27f..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrt3.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgeqrt3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt3", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgeqrt3_work( matrix_order, m, n, a, lda, t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrt3_work.c b/netlib/LAPACKE/lapacke_dgeqrt3_work.c
deleted file mode 100644
index 32b9f1a..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrt3_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqrt3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrt3( &m, &n, a, &lda, t, &ldt, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,n);
- double* a_t = NULL;
- double* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgeqrt_work.c b/netlib/LAPACKE/lapacke_dgeqrt_work.c
deleted file mode 100644
index 3798841..0000000
--- a/netlib/LAPACKE/lapacke_dgeqrt_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgeqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, double* a, lapack_int lda,
- double* t, lapack_int ldt, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrt( &m, &n, &nb, a, &lda, t, &ldt, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- double* a_t = NULL;
- double* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info );
- return info;
- }
- if( ldt < MIN(m,n) ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,MIN(m,n)) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgeqrt( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, ldt, MIN(m,n), t_t, ldt_t, t,
- ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgerfs.c b/netlib/LAPACKE/lapacke_dgerfs.c
deleted file mode 100644
index 9a34333..0000000
--- a/netlib/LAPACKE/lapacke_dgerfs.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgerfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgerfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgerfs_work( matrix_order, trans, n, nrhs, a, lda, af, ldaf,
- ipiv, b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgerfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgerfs_work.c b/netlib/LAPACKE/lapacke_dgerfs_work.c
deleted file mode 100644
index 9907c22..0000000
--- a/netlib/LAPACKE/lapacke_dgerfs_work.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgerfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgerfs( &trans, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b, &ldb, x,
- &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* af_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgerfs_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgerfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgerfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dgerfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (double*)LAPACKE_malloc( sizeof(double) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgerfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgerfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgerqf.c b/netlib/LAPACKE/lapacke_dgerqf.c
deleted file mode 100644
index ca33b32..0000000
--- a/netlib/LAPACKE/lapacke_dgerqf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgerqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgerqf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgerqf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgerqf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgerqf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgerqf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgerqf_work.c b/netlib/LAPACKE/lapacke_dgerqf_work.c
deleted file mode 100644
index 063d0bd..0000000
--- a/netlib/LAPACKE/lapacke_dgerqf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgerqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgerqf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgerqf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgerqf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgerqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgerqf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgerqf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesdd.c b/netlib/LAPACKE/lapacke_dgesdd.c
deleted file mode 100644
index b198b91..0000000
--- a/netlib/LAPACKE/lapacke_dgesdd.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgesdd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, double* a, lapack_int lda, double* s,
- double* u, lapack_int ldu, double* vt,
- lapack_int ldvt )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgesdd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)
- LAPACKE_malloc( sizeof(lapack_int) * MAX(1,8*MIN(m,n)) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
- ldvt, &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
- ldvt, work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesdd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesdd_work.c b/netlib/LAPACKE/lapacke_dgesdd_work.c
deleted file mode 100644
index 1d8bb4c..0000000
--- a/netlib/LAPACKE/lapacke_dgesdd_work.c
+++ /dev/null
@@ -1,153 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgesdd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, double* a, lapack_int lda,
- double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt, double* work,
- lapack_int lwork, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgesdd( &jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) ||
- LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? m : 1;
- lapack_int ncols_u = ( LAPACKE_lsame( jobz, 'a' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? m :
- ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1);
- lapack_int nrows_vt = ( LAPACKE_lsame( jobz, 'a' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? n :
- ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1);
- lapack_int lda_t = MAX(1,m);
- lapack_int ldu_t = MAX(1,nrows_u);
- lapack_int ldvt_t = MAX(1,nrows_vt);
- double* a_t = NULL;
- double* u_t = NULL;
- double* vt_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgesdd_work", info );
- return info;
- }
- if( ldu < ncols_u ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgesdd_work", info );
- return info;
- }
- if( ldvt < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgesdd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgesdd( &jobz, &m, &n, a, &lda_t, s, u, &ldu_t, vt, &ldvt_t,
- work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) {
- u_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) {
- vt_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
- u, ldu );
- }
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt,
- ldvt );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) {
- LAPACKE_free( vt_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesdd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgesdd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesv.c b/netlib/LAPACKE/lapacke_dgesv.c
deleted file mode 100644
index 92d116c..0000000
--- a/netlib/LAPACKE/lapacke_dgesv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgesv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dgesv_work( matrix_order, n, nrhs, a, lda, ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dgesv_work.c b/netlib/LAPACKE/lapacke_dgesv_work.c
deleted file mode 100644
index 5472627..0000000
--- a/netlib/LAPACKE/lapacke_dgesv_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgesv( &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgesv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgesv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgesv( &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgesv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesvd.c b/netlib/LAPACKE/lapacke_dgesvd.c
deleted file mode 100644
index 3109536..0000000
--- a/netlib/LAPACKE/lapacke_dgesvd.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgesvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt, double* superb )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int i;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgesvd_work( matrix_order, jobu, jobvt, m, n, a, lda, s, u,
- ldu, vt, ldvt, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgesvd_work( matrix_order, jobu, jobvt, m, n, a, lda, s, u,
- ldu, vt, ldvt, work, lwork );
- /* Backup significant data from working array(s) */
- for( i=0; i<MIN(m,n)-1; i++ ) {
- superb[i] = work[i+1];
- }
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesvd_work.c b/netlib/LAPACKE/lapacke_dgesvd_work.c
deleted file mode 100644
index 82e64c2..0000000
--- a/netlib/LAPACKE/lapacke_dgesvd_work.c
+++ /dev/null
@@ -1,144 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgesvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* s, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgesvd( &jobu, &jobvt, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) ||
- LAPACKE_lsame( jobu, 's' ) ) ? m : 1;
- lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m :
- ( LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1);
- lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'a' ) ? n :
- ( LAPACKE_lsame( jobvt, 's' ) ? MIN(m,n) : 1);
- lapack_int lda_t = MAX(1,m);
- lapack_int ldu_t = MAX(1,nrows_u);
- lapack_int ldvt_t = MAX(1,nrows_vt);
- double* a_t = NULL;
- double* u_t = NULL;
- double* vt_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
- return info;
- }
- if( ldu < ncols_u ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
- return info;
- }
- if( ldvt < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgesvd( &jobu, &jobvt, &m, &n, a, &lda_t, s, u, &ldu_t, vt,
- &ldvt_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
- u_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
- vt_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgesvd( &jobu, &jobvt, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
- u, ldu );
- }
- if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt,
- ldvt );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
- LAPACKE_free( vt_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesvj.c b/netlib/LAPACKE/lapacke_dgesvj.c
deleted file mode 100644
index 3118648..0000000
--- a/netlib/LAPACKE/lapacke_dgesvj.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgesvj
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvj( int matrix_order, char joba, char jobu, char jobv,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* sva, lapack_int mv,
- double* v, lapack_int ldv, double* stat )
-{
- lapack_int info = 0;
- lapack_int lwork = MAX(6,m+n);
- double* work = NULL;
- lapack_int i;
- lapack_int nrows_v;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvj", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n :
- ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1);
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v, n, v, ldv ) ) {
- return -11;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work[0] = stat[0]; /* Significant if jobu = 'c' */
- /* Call middle-level interface */
- info = LAPACKE_dgesvj_work( matrix_order, joba, jobu, jobv, m, n, a, lda,
- sva, mv, v, ldv, work, lwork );
- /* Backup significant data from working array(s) */
- for( i=0; i<6; i++ ) {
- stat[i] = work[i];
- }
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvj", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesvj_work.c b/netlib/LAPACKE/lapacke_dgesvj_work.c
deleted file mode 100644
index 61ccd1e..0000000
--- a/netlib/LAPACKE/lapacke_dgesvj_work.c
+++ /dev/null
@@ -1,113 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgesvj
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvj_work( int matrix_order, char joba, char jobu,
- char jobv, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* sva,
- lapack_int mv, double* v, lapack_int ldv,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgesvj( &joba, &jobu, &jobv, &m, &n, a, &lda, sva, &mv, v, &ldv,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n :
- ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1);
- lapack_int lda_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,nrows_v);
- double* a_t = NULL;
- double* v_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgesvj_work", info );
- return info;
- }
- if( ldv < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dgesvj_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( jobv, 'a' ) ) {
- LAPACKE_dge_trans( matrix_order, nrows_v, n, v, ldv, v_t, ldv_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dgesvj( &joba, &jobu, &jobv, &m, &n, a_t, &lda_t, sva, &mv, v_t,
- &ldv_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v,
- ldv );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvj_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgesvj_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesvx.c b/netlib/LAPACKE/lapacke_dgesvx.c
deleted file mode 100644
index b56867a..0000000
--- a/netlib/LAPACKE/lapacke_dgesvx.c
+++ /dev/null
@@ -1,103 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgesvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, af, ldaf ) ) {
- return -8;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -13;
- }
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgesvx_work( matrix_order, fact, trans, n, nrhs, a, lda, af,
- ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond,
- ferr, berr, work, iwork );
- /* Backup significant data from working array(s) */
- *rpivot = work[0];
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgesvx_work.c b/netlib/LAPACKE/lapacke_dgesvx_work.c
deleted file mode 100644
index 78b2402..0000000
--- a/netlib/LAPACKE/lapacke_dgesvx_work.c
+++ /dev/null
@@ -1,147 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgesvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgesvx( &fact, &trans, &n, &nrhs, a, &lda, af, &ldaf, ipiv,
- equed, r, c, b, &ldb, x, &ldx, rcond, ferr, berr, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* af_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dgesvx_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgesvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dgesvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dgesvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (double*)LAPACKE_malloc( sizeof(double) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t );
- }
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgesvx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
- ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr,
- berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf );
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- }
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgesvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgesvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgetf2.c b/netlib/LAPACKE/lapacke_dgetf2.c
deleted file mode 100644
index 1c86594..0000000
--- a/netlib/LAPACKE/lapacke_dgetf2.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgetf2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetf2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgetf2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgetf2_work( matrix_order, m, n, a, lda, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_dgetf2_work.c b/netlib/LAPACKE/lapacke_dgetf2_work.c
deleted file mode 100644
index 665bd26..0000000
--- a/netlib/LAPACKE/lapacke_dgetf2_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgetf2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgetf2( &m, &n, a, &lda, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgetf2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgetf2( &m, &n, a_t, &lda_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgetf2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgetf2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgetrf.c b/netlib/LAPACKE/lapacke_dgetrf.c
deleted file mode 100644
index 9af541f..0000000
--- a/netlib/LAPACKE/lapacke_dgetrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgetrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetrf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgetrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgetrf_work( matrix_order, m, n, a, lda, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_dgetrf_work.c b/netlib/LAPACKE/lapacke_dgetrf_work.c
deleted file mode 100644
index 67927b1..0000000
--- a/netlib/LAPACKE/lapacke_dgetrf_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgetrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgetrf( &m, &n, a, &lda, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dgetrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgetrf( &m, &n, a_t, &lda_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgetrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgetrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgetri.c b/netlib/LAPACKE/lapacke_dgetri.c
deleted file mode 100644
index d3b9b8d..0000000
--- a/netlib/LAPACKE/lapacke_dgetri.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgetri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetri( int matrix_order, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgetri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -3;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgetri_work( matrix_order, n, a, lda, ipiv, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgetri_work( matrix_order, n, a, lda, ipiv, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgetri", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgetri_work.c b/netlib/LAPACKE/lapacke_dgetri_work.c
deleted file mode 100644
index bbdf09c..0000000
--- a/netlib/LAPACKE/lapacke_dgetri_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgetri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetri_work( int matrix_order, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgetri( &n, a, &lda, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_dgetri_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgetri( &n, a, &lda_t, ipiv, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgetri( &n, a_t, &lda_t, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgetri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgetri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgetrs.c b/netlib/LAPACKE/lapacke_dgetrs.c
deleted file mode 100644
index ce3cf9f..0000000
--- a/netlib/LAPACKE/lapacke_dgetrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgetrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgetrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_dgetrs_work( matrix_order, trans, n, nrhs, a, lda, ipiv, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dgetrs_work.c b/netlib/LAPACKE/lapacke_dgetrs_work.c
deleted file mode 100644
index 2e5d5b9..0000000
--- a/netlib/LAPACKE/lapacke_dgetrs_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgetrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgetrs( &trans, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgetrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dgetrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgetrs( &trans, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgetrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgetrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgg_nancheck.c b/netlib/LAPACKE/lapacke_dgg_nancheck.c
deleted file mode 100644
index fc94561..0000000
--- a/netlib/LAPACKE/lapacke_dgg_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dgg_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const double *a,
- lapack_int lda )
-{
- return LAPACKE_dge_nancheck( matrix_order, m, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dgg_trans.c b/netlib/LAPACKE/lapacke_dgg_trans.c
deleted file mode 100644
index 544d605..0000000
--- a/netlib/LAPACKE/lapacke_dgg_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input general matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dgg_trans( int matrix_order, lapack_int m, lapack_int n,
- const double* in, lapack_int ldin,
- double* out, lapack_int ldout )
-{
- LAPACKE_dge_trans( matrix_order, m, n, in, ldin, out, ldout );
-}
diff --git a/netlib/LAPACKE/lapacke_dggbak.c b/netlib/LAPACKE/lapacke_dggbak.c
deleted file mode 100644
index 0565477..0000000
--- a/netlib/LAPACKE/lapacke_dggbak.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggbak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* lscale,
- const double* rscale, lapack_int m, double* v,
- lapack_int ldv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggbak", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, lscale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, rscale, 1 ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, m, v, ldv ) ) {
- return -10;
- }
-#endif
- return LAPACKE_dggbak_work( matrix_order, job, side, n, ilo, ihi, lscale,
- rscale, m, v, ldv );
-}
diff --git a/netlib/LAPACKE/lapacke_dggbak_work.c b/netlib/LAPACKE/lapacke_dggbak_work.c
deleted file mode 100644
index 373edd8..0000000
--- a/netlib/LAPACKE/lapacke_dggbak_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggbak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* lscale, const double* rscale,
- lapack_int m, double* v, lapack_int ldv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v, &ldv,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldv_t = MAX(1,n);
- double* v_t = NULL;
- /* Check leading dimension(s) */
- if( ldv < m ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dggbak_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,m) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t,
- &ldv_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv );
- /* Release memory and exit */
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggbak_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggbak_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggbal.c b/netlib/LAPACKE/lapacke_dggbal.c
deleted file mode 100644
index b8954b5..0000000
--- a/netlib/LAPACKE/lapacke_dggbal.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggbal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggbal( int matrix_order, char job, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggbal", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -6;
- }
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) {
- lwork = MAX(1,6*n);
- } else {
- lwork = 1;
- }
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggbal_work( matrix_order, job, n, a, lda, b, ldb, ilo, ihi,
- lscale, rscale, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggbal", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggbal_work.c b/netlib/LAPACKE/lapacke_dggbal_work.c
deleted file mode 100644
index f13cfdd..0000000
--- a/netlib/LAPACKE/lapacke_dggbal_work.c
+++ /dev/null
@@ -1,126 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggbal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggbal_work( int matrix_order, char job, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggbal( &job, &n, a, &lda, b, &ldb, ilo, ihi, lscale, rscale,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dggbal_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dggbal_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale,
- rscale, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_free( b_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_free( a_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggbal_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggbal_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgges.c b/netlib/LAPACKE/lapacke_dgges.c
deleted file mode 100644
index 36bb13a..0000000
--- a/netlib/LAPACKE/lapacke_dgges.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgges
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_D_SELECT3 selctg, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int ldvsl,
- double* vsr, lapack_int ldvsr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgges", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dgges_work( matrix_order, jobvsl, jobvsr, sort, selctg, n, a,
- lda, b, ldb, sdim, alphar, alphai, beta, vsl,
- ldvsl, vsr, ldvsr, &work_query, lwork, bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgges_work( matrix_order, jobvsl, jobvsr, sort, selctg, n, a,
- lda, b, ldb, sdim, alphar, alphai, beta, vsl,
- ldvsl, vsr, ldvsr, work, lwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgges", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgges_work.c b/netlib/LAPACKE/lapacke_dgges_work.c
deleted file mode 100644
index 6e6ded7..0000000
--- a/netlib/LAPACKE/lapacke_dgges_work.c
+++ /dev/null
@@ -1,160 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgges
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* sdim, double* alphar,
- double* alphai, double* beta, double* vsl,
- lapack_int ldvsl, double* vsr, lapack_int ldvsr,
- double* work, lapack_int lwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgges( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda, b, &ldb,
- sdim, alphar, alphai, beta, vsl, &ldvsl, vsr, &ldvsr,
- work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvsl_t = MAX(1,n);
- lapack_int ldvsr_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* vsl_t = NULL;
- double* vsr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgges_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgges_work", info );
- return info;
- }
- if( ldvsl < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dgges_work", info );
- return info;
- }
- if( ldvsr < n ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_dgges_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgges( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda_t, b,
- &ldb_t, sdim, alphar, alphai, beta, vsl, &ldvsl_t,
- vsr, &ldvsr_t, work, &lwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- vsl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) );
- if( vsl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- vsr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) );
- if( vsr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgges( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t,
- &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t,
- vsr_t, &ldvsr_t, work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl,
- ldvsl );
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr,
- ldvsr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_free( vsr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_free( vsl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgges_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgges_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggesx.c b/netlib/LAPACKE/lapacke_dggesx.c
deleted file mode 100644
index dd70e96..0000000
--- a/netlib/LAPACKE/lapacke_dggesx.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, char sense,
- lapack_int n, double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* sdim, double* alphar,
- double* alphai, double* beta, double* vsl,
- lapack_int ldvsl, double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggesx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dggesx_work( matrix_order, jobvsl, jobvsr, sort, selctg,
- sense, n, a, lda, b, ldb, sdim, alphar, alphai,
- beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
- &work_query, lwork, &iwork_query, liwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggesx_work( matrix_order, jobvsl, jobvsr, sort, selctg,
- sense, n, a, lda, b, ldb, sdim, alphar, alphai,
- beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
- work, lwork, iwork, liwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- LAPACKE_free( iwork );
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggesx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggesx_work.c b/netlib/LAPACKE/lapacke_dggesx_work.c
deleted file mode 100644
index 889b81e..0000000
--- a/netlib/LAPACKE/lapacke_dggesx_work.c
+++ /dev/null
@@ -1,165 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, char sense,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* sdim,
- double* alphar, double* alphai, double* beta,
- double* vsl, lapack_int ldvsl, double* vsr,
- lapack_int ldvsr, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a, &lda, b,
- &ldb, sdim, alphar, alphai, beta, vsl, &ldvsl, vsr,
- &ldvsr, rconde, rcondv, work, &lwork, iwork, &liwork,
- bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvsl_t = MAX(1,n);
- lapack_int ldvsr_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* vsl_t = NULL;
- double* vsr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dggesx_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dggesx_work", info );
- return info;
- }
- if( ldvsl < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dggesx_work", info );
- return info;
- }
- if( ldvsr < n ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dggesx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a,
- &lda_t, b, &ldb_t, sdim, alphar, alphai, beta, vsl,
- &ldvsl_t, vsr, &ldvsr_t, rconde, rcondv, work,
- &lwork, iwork, &liwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- vsl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) );
- if( vsl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- vsr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) );
- if( vsr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a_t, &lda_t,
- b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t,
- vsr_t, &ldvsr_t, rconde, rcondv, work, &lwork, iwork,
- &liwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl,
- ldvsl );
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr,
- ldvsr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_free( vsr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_free( vsl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggesx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggesx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggev.c b/netlib/LAPACKE/lapacke_dggev.c
deleted file mode 100644
index 36ce3d1..0000000
--- a/netlib/LAPACKE/lapacke_dggev.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alphar, double* alphai,
- double* beta, double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dggev_work( matrix_order, jobvl, jobvr, n, a, lda, b, ldb,
- alphar, alphai, beta, vl, ldvl, vr, ldvr,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggev_work( matrix_order, jobvl, jobvr, n, a, lda, b, ldb,
- alphar, alphai, beta, vl, ldvl, vr, ldvr, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggev_work.c b/netlib/LAPACKE/lapacke_dggev_work.c
deleted file mode 100644
index ce3342d..0000000
--- a/netlib/LAPACKE/lapacke_dggev_work.c
+++ /dev/null
@@ -1,161 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* alphar,
- double* alphai, double* beta, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggev( &jobvl, &jobvr, &n, a, &lda, b, &ldb, alphar, alphai,
- beta, vl, &ldvl, vr, &ldvr, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1;
- lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1;
- lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1;
- lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1;
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,nrows_vl);
- lapack_int ldvr_t = MAX(1,nrows_vr);
- double* a_t = NULL;
- double* b_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dggev_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dggev_work", info );
- return info;
- }
- if( ldvl < ncols_vl ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dggev_work", info );
- return info;
- }
- if( ldvr < ncols_vr ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dggev_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dggev( &jobvl, &jobvr, &n, a, &lda_t, b, &ldb_t, alphar,
- alphai, beta, vl, &ldvl_t, vr, &ldvr_t, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,ncols_vl) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,ncols_vr) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar,
- alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t,
- ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t,
- ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggevx.c b/netlib/LAPACKE/lapacke_dggevx.c
deleted file mode 100644
index d962b2e..0000000
--- a/netlib/LAPACKE/lapacke_dggevx.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dggevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr,
- ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm,
- rconde, rcondv, &work_query, lwork, iwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_2;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr,
- ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm,
- rconde, rcondv, work, lwork, iwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_1:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggevx_work.c b/netlib/LAPACKE/lapacke_dggevx_work.c
deleted file mode 100644
index b4dc803..0000000
--- a/netlib/LAPACKE/lapacke_dggevx_work.c
+++ /dev/null
@@ -1,163 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* abnrm, double* bbnrm, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda, b, &ldb,
- alphar, alphai, beta, vl, &ldvl, vr, &ldvr, ilo, ihi,
- lscale, rscale, abnrm, bbnrm, rconde, rcondv, work,
- &lwork, iwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dggevx_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dggevx_work", info );
- return info;
- }
- if( ldvl < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dggevx_work", info );
- return info;
- }
- if( ldvr < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dggevx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dggevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda_t, b,
- &ldb_t, alphar, alphai, beta, vl, &ldvl_t, vr,
- &ldvr_t, ilo, ihi, lscale, rscale, abnrm, bbnrm,
- rconde, rcondv, work, &lwork, iwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, b_t,
- &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t,
- &ldvr_t, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde,
- rcondv, work, &lwork, iwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggglm.c b/netlib/LAPACKE/lapacke_dggglm.c
deleted file mode 100644
index fc65ed2..0000000
--- a/netlib/LAPACKE/lapacke_dggglm.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggglm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* d, double* x, double* y )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggglm", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, p, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dggglm_work( matrix_order, n, m, p, a, lda, b, ldb, d, x, y,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggglm_work( matrix_order, n, m, p, a, lda, b, ldb, d, x, y,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggglm", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggglm_work.c b/netlib/LAPACKE/lapacke_dggglm_work.c
deleted file mode 100644
index 75ff2a6..0000000
--- a/netlib/LAPACKE/lapacke_dggglm_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggglm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* d, double* x,
- double* y, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggglm( &n, &m, &p, a, &lda, b, &ldb, d, x, y, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dggglm_work", info );
- return info;
- }
- if( ldb < p ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dggglm_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dggglm( &n, &m, &p, a, &lda_t, b, &ldb_t, d, x, y, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,p) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, p, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggglm_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggglm_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgghrd.c b/netlib/LAPACKE/lapacke_dgghrd.c
deleted file mode 100644
index 339f385..0000000
--- a/netlib/LAPACKE/lapacke_dgghrd.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgghrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* a, lapack_int lda, double* b, lapack_int ldb,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgghrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -13;
- }
- }
-#endif
- return LAPACKE_dgghrd_work( matrix_order, compq, compz, n, ilo, ihi, a, lda,
- b, ldb, q, ldq, z, ldz );
-}
diff --git a/netlib/LAPACKE/lapacke_dgghrd_work.c b/netlib/LAPACKE/lapacke_dgghrd_work.c
deleted file mode 100644
index 864dfee..0000000
--- a/netlib/LAPACKE/lapacke_dgghrd_work.c
+++ /dev/null
@@ -1,150 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgghrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* q, lapack_int ldq,
- double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgghrd( &compq, &compz, &n, &ilo, &ihi, a, &lda, b, &ldb, q,
- &ldq, z, &ldz, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* q_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgghrd_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dgghrd_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dgghrd_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dgghrd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t,
- q_t, &ldq_t, z_t, &ldz_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgghrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgghrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgglse.c b/netlib/LAPACKE/lapacke_dgglse.c
deleted file mode 100644
index 8cbeeb5..0000000
--- a/netlib/LAPACKE/lapacke_dgglse.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgglse
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* c, double* d, double* x )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgglse", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( m, c, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( p, d, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dgglse_work( matrix_order, m, n, p, a, lda, b, ldb, c, d, x,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgglse_work( matrix_order, m, n, p, a, lda, b, ldb, c, d, x,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgglse", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgglse_work.c b/netlib/LAPACKE/lapacke_dgglse_work.c
deleted file mode 100644
index f9f768e..0000000
--- a/netlib/LAPACKE/lapacke_dgglse_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgglse
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* c, double* d,
- double* x, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgglse( &m, &n, &p, a, &lda, b, &ldb, c, d, x, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dgglse_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgglse_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dgglse( &m, &n, &p, a, &lda_t, b, &ldb_t, c, d, x, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgglse( &m, &n, &p, a_t, &lda_t, b_t, &ldb_t, c, d, x, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgglse_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgglse_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggqrf.c b/netlib/LAPACKE/lapacke_dggqrf.c
deleted file mode 100644
index de9d612..0000000
--- a/netlib/LAPACKE/lapacke_dggqrf.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggqrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, p, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dggqrf_work( matrix_order, n, m, p, a, lda, taua, b, ldb,
- taub, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggqrf_work( matrix_order, n, m, p, a, lda, taua, b, ldb,
- taub, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggqrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggqrf_work.c b/netlib/LAPACKE/lapacke_dggqrf_work.c
deleted file mode 100644
index 76d560a..0000000
--- a/netlib/LAPACKE/lapacke_dggqrf_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggqrf( &n, &m, &p, a, &lda, taua, b, &ldb, taub, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dggqrf_work", info );
- return info;
- }
- if( ldb < p ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dggqrf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dggqrf( &n, &m, &p, a, &lda_t, taua, b, &ldb_t, taub, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,p) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, p, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggqrf( &n, &m, &p, a_t, &lda_t, taua, b_t, &ldb_t, taub, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggqrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggqrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggrqf.c b/netlib/LAPACKE/lapacke_dggrqf.c
deleted file mode 100644
index 15436d2..0000000
--- a/netlib/LAPACKE/lapacke_dggrqf.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggrqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggrqf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dggrqf_work( matrix_order, m, p, n, a, lda, taua, b, ldb,
- taub, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggrqf_work( matrix_order, m, p, n, a, lda, taua, b, ldb,
- taub, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggrqf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggrqf_work.c b/netlib/LAPACKE/lapacke_dggrqf_work.c
deleted file mode 100644
index 33417d7..0000000
--- a/netlib/LAPACKE/lapacke_dggrqf_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggrqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggrqf( &m, &p, &n, a, &lda, taua, b, &ldb, taub, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dggrqf_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dggrqf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dggrqf( &m, &p, &n, a, &lda_t, taua, b, &ldb_t, taub, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggrqf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggrqf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggsvd.c b/netlib/LAPACKE/lapacke_dggsvd.c
deleted file mode 100644
index 06166d2..0000000
--- a/netlib/LAPACKE/lapacke_dggsvd.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggsvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alpha, double* beta, double* u,
- lapack_int ldu, double* v, lapack_int ldv, double* q,
- lapack_int ldq, lapack_int* iwork )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggsvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,MAX3(3*n,m,p)+n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggsvd_work( matrix_order, jobu, jobv, jobq, m, n, p, k, l,
- a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q,
- ldq, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggsvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggsvd_work.c b/netlib/LAPACKE/lapacke_dggsvd_work.c
deleted file mode 100644
index d833d74..0000000
--- a/netlib/LAPACKE/lapacke_dggsvd_work.c
+++ /dev/null
@@ -1,170 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggsvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alpha, double* beta,
- double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb,
- alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,p);
- double* a_t = NULL;
- double* b_t = NULL;
- double* u_t = NULL;
- double* v_t = NULL;
- double* q_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- return info;
- }
- if( ldu < m ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- return info;
- }
- if( ldv < p ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,p) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t,
- &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t,
- &ldq_t, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv );
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_4:
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggsvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggsvp.c b/netlib/LAPACKE/lapacke_dggsvp.c
deleted file mode 100644
index 14783db..0000000
--- a/netlib/LAPACKE/lapacke_dggsvp.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dggsvp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double tola, double tolb, lapack_int* k,
- lapack_int* l, double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* tau = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dggsvp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -13;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- tau = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( tau == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,MAX3(3*n,m,p)) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_dggsvp_work( matrix_order, jobu, jobv, jobq, m, p, n, a, lda,
- b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q,
- ldq, iwork, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- LAPACKE_free( tau );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggsvp", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dggsvp_work.c b/netlib/LAPACKE/lapacke_dggsvp_work.c
deleted file mode 100644
index 2f5f300..0000000
--- a/netlib/LAPACKE/lapacke_dggsvp_work.c
+++ /dev/null
@@ -1,170 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dggsvp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double tola,
- double tolb, lapack_int* k, lapack_int* l,
- double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- lapack_int* iwork, double* tau, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dggsvp( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda, b, &ldb, &tola,
- &tolb, k, l, u, &ldu, v, &ldv, q, &ldq, iwork, tau, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,p);
- double* a_t = NULL;
- double* b_t = NULL;
- double* u_t = NULL;
- double* v_t = NULL;
- double* q_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- return info;
- }
- if( ldu < m ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- return info;
- }
- if( ldv < m ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,m) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dggsvp( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t,
- &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t,
- q_t, &ldq_t, iwork, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv );
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_4:
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dggsvp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgt_nancheck.c b/netlib/LAPACKE/lapacke_dgt_nancheck.c
deleted file mode 100644
index feeaeba..0000000
--- a/netlib/LAPACKE/lapacke_dgt_nancheck.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dgt_nancheck( lapack_int n,
- const double *dl,
- const double *d,
- const double *du )
-{
- return LAPACKE_d_nancheck( n-1, dl, 1 )
- || LAPACKE_d_nancheck( n , d, 1 )
- || LAPACKE_d_nancheck( n-1, du, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_dgtcon.c b/netlib/LAPACKE/lapacke_dgtcon.c
deleted file mode 100644
index b8f3296..0000000
--- a/netlib/LAPACKE/lapacke_dgtcon.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgtcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl,
- const double* d, const double* du, const double* du2,
- const lapack_int* ipiv, double anorm, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgtcon_work( norm, n, dl, d, du, du2, ipiv, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgtcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgtcon_work.c b/netlib/LAPACKE/lapacke_dgtcon_work.c
deleted file mode 100644
index d977d64..0000000
--- a/netlib/LAPACKE/lapacke_dgtcon_work.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgtcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtcon_work( char norm, lapack_int n, const double* dl,
- const double* d, const double* du,
- const double* du2, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dgtcon( &norm, &n, dl, d, du, du2, ipiv, &anorm, rcond, work, iwork,
- &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgtrfs.c b/netlib/LAPACKE/lapacke_dgtrfs.c
deleted file mode 100644
index 18ca961..0000000
--- a/netlib/LAPACKE/lapacke_dgtrfs.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgtrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl, const double* d,
- const double* du, const double* dlf,
- const double* df, const double* duf,
- const double* du2, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgtrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -15;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgtrfs_work( matrix_order, trans, n, nrhs, dl, d, du, dlf,
- df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgtrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgtrfs_work.c b/netlib/LAPACKE/lapacke_dgtrfs_work.c
deleted file mode 100644
index 1a998c4..0000000
--- a/netlib/LAPACKE/lapacke_dgtrfs_work.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgtrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl,
- const double* d, const double* du,
- const double* dlf, const double* df,
- const double* duf, const double* du2,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b,
- &ldb, x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv,
- b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgtsv.c b/netlib/LAPACKE/lapacke_dgtsv.c
deleted file mode 100644
index 638fc3d..0000000
--- a/netlib/LAPACKE/lapacke_dgtsv.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgtsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* dl, double* d, double* du, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgtsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dgtsv_work( matrix_order, n, nrhs, dl, d, du, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dgtsv_work.c b/netlib/LAPACKE/lapacke_dgtsv_work.c
deleted file mode 100644
index 36e08e3..0000000
--- a/netlib/LAPACKE/lapacke_dgtsv_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgtsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* dl, double* d, double* du, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgtsv( &n, &nrhs, dl, d, du, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dgtsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgtsv( &n, &nrhs, dl, d, du, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgtsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgtsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgtsvx.c b/netlib/LAPACKE/lapacke_dgtsvx.c
deleted file mode 100644
index c9a0c39..0000000
--- a/netlib/LAPACKE/lapacke_dgtsvx.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgtsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const double* dl,
- const double* d, const double* du, double* dlf,
- double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgtsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -10;
- }
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) {
- return -9;
- }
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -12;
- }
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) {
- return -11;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dgtsvx_work( matrix_order, fact, trans, n, nrhs, dl, d, du,
- dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond,
- ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgtsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgtsvx_work.c b/netlib/LAPACKE/lapacke_dgtsvx_work.c
deleted file mode 100644
index 572c6d9..0000000
--- a/netlib/LAPACKE/lapacke_dgtsvx_work.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgtsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const double* dl,
- const double* d, const double* du, double* dlf,
- double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2,
- ipiv, b, &ldb, x, &ldx, rcond, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2,
- ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgttrf.c b/netlib/LAPACKE/lapacke_dgttrf.c
deleted file mode 100644
index 056b8cd..0000000
--- a/netlib/LAPACKE/lapacke_dgttrf.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgttrf( lapack_int n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dgttrf_work( n, dl, d, du, du2, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_dgttrf_work.c b/netlib/LAPACKE/lapacke_dgttrf_work.c
deleted file mode 100644
index 5daa1cf..0000000
--- a/netlib/LAPACKE/lapacke_dgttrf_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgttrf_work( lapack_int n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dgttrf( &n, dl, d, du, du2, ipiv, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dgttrs.c b/netlib/LAPACKE/lapacke_dgttrs.c
deleted file mode 100644
index d3f3926..0000000
--- a/netlib/LAPACKE/lapacke_dgttrs.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl, const double* d,
- const double* du, const double* du2,
- const lapack_int* ipiv, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dgttrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -8;
- }
-#endif
- return LAPACKE_dgttrs_work( matrix_order, trans, n, nrhs, dl, d, du, du2,
- ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dgttrs_work.c b/netlib/LAPACKE/lapacke_dgttrs_work.c
deleted file mode 100644
index 1c27815..0000000
--- a/netlib/LAPACKE/lapacke_dgttrs_work.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl,
- const double* d, const double* du,
- const double* du2, const lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dgttrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dgttrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dgttrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dhgeqz.c b/netlib/LAPACKE/lapacke_dhgeqz.c
deleted file mode 100644
index cdbdf9d..0000000
--- a/netlib/LAPACKE/lapacke_dhgeqz.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dhgeqz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dhgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* h, lapack_int ldh, double* t, lapack_int ldt,
- double* alphar, double* alphai, double* beta,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dhgeqz", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, h, ldh ) ) {
- return -8;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -15;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -17;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dhgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
- ldh, t, ldt, alphar, alphai, beta, q, ldq, z,
- ldz, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dhgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
- ldh, t, ldt, alphar, alphai, beta, q, ldq, z,
- ldz, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dhgeqz", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dhgeqz_work.c b/netlib/LAPACKE/lapacke_dhgeqz_work.c
deleted file mode 100644
index 9ac3fee..0000000
--- a/netlib/LAPACKE/lapacke_dhgeqz_work.c
+++ /dev/null
@@ -1,161 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dhgeqz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dhgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* h, lapack_int ldh,
- double* t, lapack_int ldt, double* alphar,
- double* alphai, double* beta, double* q,
- lapack_int ldq, double* z, lapack_int ldz,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dhgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h, &ldh, t, &ldt,
- alphar, alphai, beta, q, &ldq, z, &ldz, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldh_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldt_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* h_t = NULL;
- double* t_t = NULL;
- double* q_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldh < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dhgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h, &ldh_t, t,
- &ldt_t, alphar, alphai, beta, q, &ldq_t, z, &ldz_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- h_t = (double*)LAPACKE_malloc( sizeof(double) * ldh_t * MAX(1,n) );
- if( h_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
- LAPACKE_dge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dhgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h_t, &ldh_t, t_t,
- &ldt_t, alphar, alphai, beta, q_t, &ldq_t, z_t, &ldz_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( h_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dhs_nancheck.c b/netlib/LAPACKE/lapacke_dhs_nancheck.c
deleted file mode 100644
index 7af62a9..0000000
--- a/netlib/LAPACKE/lapacke_dhs_nancheck.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dhs_nancheck( int matrix_order, lapack_int n,
- const double *a,
- lapack_int lda )
-{
- lapack_logical subdiag_nans;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- /* Check subdiagonal first */
- if( matrix_order == LAPACK_COL_MAJOR ) {
- subdiag_nans = LAPACKE_d_nancheck( n-1, &a[1], lda+1 );
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- subdiag_nans = LAPACKE_d_nancheck( n-1, &a[lda], lda+1 );
- } else {
- return (lapack_logical) 0;
- }
-
- /* Check upper triangular if subdiagonal has no NaNs. */
- return subdiag_nans || LAPACKE_dtr_nancheck( matrix_order, 'u', 'n',
- n, a, lda);
-}
diff --git a/netlib/LAPACKE/lapacke_dhs_trans.c b/netlib/LAPACKE/lapacke_dhs_trans.c
deleted file mode 100644
index b631d11..0000000
--- a/netlib/LAPACKE/lapacke_dhs_trans.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input Hessenberg matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dhs_trans( int matrix_order, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- if( in == NULL || out == NULL ) return;
-
- /* Convert subdiagonal first */
- if( matrix_order == LAPACK_COL_MAJOR ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1,
- &out[ldout], ldout+1 );
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1,
- &out[1], ldout+1 );
- } else {
- return;
- }
-
- /* Convert upper triangular. */
- LAPACKE_dtr_trans( matrix_order, 'u', 'n', n, in, ldin, out, ldout);
-}
diff --git a/netlib/LAPACKE/lapacke_dhsein.c b/netlib/LAPACKE/lapacke_dhsein.c
deleted file mode 100644
index c18c60e..0000000
--- a/netlib/LAPACKE/lapacke_dhsein.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dhsein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dhsein( int matrix_order, char job, char eigsrc, char initv,
- lapack_logical* select, lapack_int n,
- const double* h, lapack_int ldh, double* wr,
- const double* wi, double* vl, lapack_int ldvl,
- double* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m, lapack_int* ifaill,
- lapack_int* ifailr )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dhsein", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -13;
- }
- }
- if( LAPACKE_d_nancheck( n, wi, 1 ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( n, wr, 1 ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) * MAX(1,n+2) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dhsein_work( matrix_order, job, eigsrc, initv, select, n, h,
- ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work,
- ifaill, ifailr );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dhsein", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dhsein_work.c b/netlib/LAPACKE/lapacke_dhsein_work.c
deleted file mode 100644
index c76650e..0000000
--- a/netlib/LAPACKE/lapacke_dhsein_work.c
+++ /dev/null
@@ -1,142 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dhsein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dhsein_work( int matrix_order, char job, char eigsrc,
- char initv, lapack_logical* select,
- lapack_int n, const double* h, lapack_int ldh,
- double* wr, const double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work,
- lapack_int* ifaill, lapack_int* ifailr )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dhsein( &job, &eigsrc, &initv, select, &n, h, &ldh, wr, wi, vl,
- &ldvl, vr, &ldvr, &mm, m, work, ifaill, ifailr, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldh_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* h_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldh < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dhsein_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dhsein_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dhsein_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- h_t = (double*)LAPACKE_malloc( sizeof(double) * ldh_t * MAX(1,n) );
- if( h_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
- if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) &&
- LAPACKE_lsame( initv, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) &&
- LAPACKE_lsame( initv, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dhsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, wr, wi,
- vl_t, &ldvl_t, vr_t, &ldvr_t, &mm, m, work, ifaill,
- ifailr, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
- ldvl );
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
- ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( h_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dhsein_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dhsein_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dhseqr.c b/netlib/LAPACKE/lapacke_dhseqr.c
deleted file mode 100644
index d0c1978..0000000
--- a/netlib/LAPACKE/lapacke_dhseqr.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dhseqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dhseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi, double* h,
- lapack_int ldh, double* wr, double* wi, double* z,
- lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dhseqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -11;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dhseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh,
- wr, wi, z, ldz, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dhseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh,
- wr, wi, z, ldz, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dhseqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dhseqr_work.c b/netlib/LAPACKE/lapacke_dhseqr_work.c
deleted file mode 100644
index e58f045..0000000
--- a/netlib/LAPACKE/lapacke_dhseqr_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dhseqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dhseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* h, lapack_int ldh, double* wr,
- double* wi, double* z, lapack_int ldz,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dhseqr( &job, &compz, &n, &ilo, &ihi, h, &ldh, wr, wi, z, &ldz,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldh_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* h_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldh < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dhseqr_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dhseqr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dhseqr( &job, &compz, &n, &ilo, &ihi, h, &ldh_t, wr, wi, z,
- &ldz_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- h_t = (double*)LAPACKE_malloc( sizeof(double) * ldh_t * MAX(1,n) );
- if( h_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dhseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, wr, wi, z_t,
- &ldz_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh );
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( h_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dhseqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dhseqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlacpy.c b/netlib/LAPACKE/lapacke_dlacpy.c
deleted file mode 100644
index 433d613..0000000
--- a/netlib/LAPACKE/lapacke_dlacpy.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlacpy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlacpy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dlacpy_work( matrix_order, uplo, m, n, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dlacpy_work.c b/netlib/LAPACKE/lapacke_dlacpy_work.c
deleted file mode 100644
index bac3055..0000000
--- a/netlib/LAPACKE/lapacke_dlacpy_work.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlacpy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlacpy( &uplo, &m, &n, a, &lda, b, &ldb );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,m);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlag2s.c b/netlib/LAPACKE/lapacke_dlag2s.c
deleted file mode 100644
index 7891aba..0000000
--- a/netlib/LAPACKE/lapacke_dlag2s.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlag2s
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlag2s( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, float* sa,
- lapack_int ldsa )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlag2s", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dlag2s_work( matrix_order, m, n, a, lda, sa, ldsa );
-}
diff --git a/netlib/LAPACKE/lapacke_dlag2s_work.c b/netlib/LAPACKE/lapacke_dlag2s_work.c
deleted file mode 100644
index 61bfe07..0000000
--- a/netlib/LAPACKE/lapacke_dlag2s_work.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlag2s
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlag2s_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, float* sa,
- lapack_int ldsa )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlag2s( &m, &n, a, &lda, sa, &ldsa, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldsa_t = MAX(1,m);
- double* a_t = NULL;
- float* sa_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dlag2s_work", info );
- return info;
- }
- if( ldsa < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dlag2s_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- sa_t = (float*)LAPACKE_malloc( sizeof(float) * ldsa_t * MAX(1,n) );
- if( sa_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlag2s( &m, &n, a_t, &lda_t, sa_t, &ldsa_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, sa_t, ldsa_t, sa, ldsa );
- /* Release memory and exit */
- LAPACKE_free( sa_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlag2s_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlag2s_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlagge.c b/netlib/LAPACKE/lapacke_dlagge.c
deleted file mode 100644
index 4db6715..0000000
--- a/netlib/LAPACKE/lapacke_dlagge.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlagge
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- double* a, lapack_int lda, lapack_int* iseed )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlagge", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m+n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dlagge_work( matrix_order, m, n, kl, ku, d, a, lda, iseed,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlagge", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlagge_work.c b/netlib/LAPACKE/lapacke_dlagge_work.c
deleted file mode 100644
index f241d8b..0000000
--- a/netlib/LAPACKE/lapacke_dlagge_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlagge
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- double* a, lapack_int lda, lapack_int* iseed,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlagge( &m, &n, &kl, &ku, d, a, &lda, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dlagge_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dlagge( &m, &n, &kl, &ku, d, a_t, &lda_t, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlagge_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlagge_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlagsy.c b/netlib/LAPACKE/lapacke_dlagsy.c
deleted file mode 100644
index 4b4038b..0000000
--- a/netlib/LAPACKE/lapacke_dlagsy.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlagsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlagsy( int matrix_order, lapack_int n, lapack_int k,
- const double* d, double* a, lapack_int lda,
- lapack_int* iseed )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlagsy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dlagsy_work( matrix_order, n, k, d, a, lda, iseed, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlagsy", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlagsy_work.c b/netlib/LAPACKE/lapacke_dlagsy_work.c
deleted file mode 100644
index df158c4..0000000
--- a/netlib/LAPACKE/lapacke_dlagsy_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlagsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, double* a, lapack_int lda,
- lapack_int* iseed, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlagsy( &n, &k, d, a, &lda, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dlagsy_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dlagsy( &n, &k, d, a_t, &lda_t, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlagsy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlagsy_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlamch.c b/netlib/LAPACKE/lapacke_dlamch.c
deleted file mode 100644
index 500e624..0000000
--- a/netlib/LAPACKE/lapacke_dlamch.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlamch
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlamch( char cmach )
-{
- return LAPACKE_dlamch_work( cmach );
-}
diff --git a/netlib/LAPACKE/lapacke_dlamch_work.c b/netlib/LAPACKE/lapacke_dlamch_work.c
deleted file mode 100644
index d2d7f86..0000000
--- a/netlib/LAPACKE/lapacke_dlamch_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlamch
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlamch_work( char cmach )
-{
- lapack_int info = 0;
- double res;
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlamch( &cmach );
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlange.c b/netlib/LAPACKE/lapacke_dlange.c
deleted file mode 100644
index 7c2334b..0000000
--- a/netlib/LAPACKE/lapacke_dlange.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlange
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const double* a, lapack_int lda )
-{
- lapack_int info = 0;
- double res = 0.;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlange", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( norm, 'i' ) ) {
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- res = LAPACKE_dlange_work( matrix_order, norm, m, n, a, lda, work );
- /* Release memory and exit */
- if( LAPACKE_lsame( norm, 'i' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlange", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlange_work.c b/netlib/LAPACKE/lapacke_dlange_work.c
deleted file mode 100644
index d91e9f1..0000000
--- a/netlib/LAPACKE/lapacke_dlange_work.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlange
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* work )
-{
- lapack_int info = 0;
- double res = 0.;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlange( &norm, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dlange_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlange( &norm, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlange_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlange_work", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlansy.c b/netlib/LAPACKE/lapacke_dlansy.c
deleted file mode 100644
index 5e6721e..0000000
--- a/netlib/LAPACKE/lapacke_dlansy.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlansy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlansy( int matrix_order, char norm, char uplo, lapack_int n,
- const double* a, lapack_int lda )
-{
- lapack_int info = 0;
- double res = 0.;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlansy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- res = LAPACKE_dlansy_work( matrix_order, norm, uplo, n, a, lda, work );
- /* Release memory and exit */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlansy", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlansy_work.c b/netlib/LAPACKE/lapacke_dlansy_work.c
deleted file mode 100644
index 6f7e83e..0000000
--- a/netlib/LAPACKE/lapacke_dlansy_work.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlansy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* work )
-{
- lapack_int info = 0;
- double res = 0.;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlansy( &norm, &uplo, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dlansy_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlansy( &norm, &uplo, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlansy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlansy_work", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlantr.c b/netlib/LAPACKE/lapacke_dlantr.c
deleted file mode 100644
index 522122c..0000000
--- a/netlib/LAPACKE/lapacke_dlantr.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlantr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- double res = 0.;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlantr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- res = LAPACKE_dlantr_work( matrix_order, norm, uplo, diag, m, n, a, lda,
- work );
- /* Release memory and exit */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlantr", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlantr_work.c b/netlib/LAPACKE/lapacke_dlantr_work.c
deleted file mode 100644
index 0a937bd..0000000
--- a/netlib/LAPACKE/lapacke_dlantr_work.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlantr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* work )
-{
- lapack_int info = 0;
- double res = 0.;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtr_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlapmr.c b/netlib/LAPACKE/lapacke_dlapmr.c
deleted file mode 100644
index 279d284..0000000
--- a/netlib/LAPACKE/lapacke_dlapmr.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlapmr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, double* x,
- lapack_int ldx, lapack_int* k )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlapmr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, x, ldx ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dlapmr_work( matrix_order, forwrd, m, n, x, ldx, k );
-}
diff --git a/netlib/LAPACKE/lapacke_dlapmr_work.c b/netlib/LAPACKE/lapacke_dlapmr_work.c
deleted file mode 100644
index e88128f..0000000
--- a/netlib/LAPACKE/lapacke_dlapmr_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlapmr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, double* x,
- lapack_int ldx, lapack_int* k )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlapmr( &forwrd, &m, &n, x, &ldx, k );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldx_t = MAX(1,m);
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldx < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dlapmr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,n) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlapmr( &forwrd, &m, &n, x_t, &ldx_t, k );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlapmr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlapmr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlapy2.c b/netlib/LAPACKE/lapacke_dlapy2.c
deleted file mode 100644
index 4d636bb..0000000
--- a/netlib/LAPACKE/lapacke_dlapy2.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlapy2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlapy2( double x, double y )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
-#endif
- return LAPACKE_dlapy2_work( x, y );
-}
diff --git a/netlib/LAPACKE/lapacke_dlapy2_work.c b/netlib/LAPACKE/lapacke_dlapy2_work.c
deleted file mode 100644
index 61ba740..0000000
--- a/netlib/LAPACKE/lapacke_dlapy2_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlapy2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlapy2_work( double x, double y )
-{
- double res = 0.;
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlapy2( &x, &y );
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlapy3.c b/netlib/LAPACKE/lapacke_dlapy3.c
deleted file mode 100644
index 45bbaba..0000000
--- a/netlib/LAPACKE/lapacke_dlapy3.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlapy3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlapy3( double x, double y, double z )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( 1, &z, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dlapy3_work( x, y, z );
-}
diff --git a/netlib/LAPACKE/lapacke_dlapy3_work.c b/netlib/LAPACKE/lapacke_dlapy3_work.c
deleted file mode 100644
index 1bd6dd3..0000000
--- a/netlib/LAPACKE/lapacke_dlapy3_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlapy3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-double LAPACKE_dlapy3_work( double x, double y, double z )
-{
- double res = 0.;
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlapy3( &x, &y, &z );
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_dlarfb.c b/netlib/LAPACKE/lapacke_dlarfb.c
deleted file mode 100644
index dd226fc..0000000
--- a/netlib/LAPACKE/lapacke_dlarfb.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlarfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
- double* work = NULL;
- lapack_int ncols_v, nrows_v;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -13;
- }
- if( LAPACKE_dge_nancheck( matrix_order, k, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_dtr_nancheck( matrix_order, 'l', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v-k, ncols_v, &v[k*ldv],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
- return -8;
- }
- if( LAPACKE_dtr_nancheck( matrix_order, 'u', 'u', k,
- &v[(nrows_v-k)*ldv], ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v-k, ncols_v, v, ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_dtr_nancheck( matrix_order, 'u', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v, ncols_v-k, &v[k],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
- return -8;
- }
- if( LAPACKE_dtr_nancheck( matrix_order, 'l', 'u', k, &v[ncols_v-k],
- ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v, ncols_v-k, v, ldv ) )
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * ldwork * MAX(1,k) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dlarfb_work( matrix_order, side, trans, direct, storev, m, n,
- k, v, ldv, t, ldt, c, ldc, work, ldwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlarfb_work.c b/netlib/LAPACKE/lapacke_dlarfb_work.c
deleted file mode 100644
index 5f76131..0000000
--- a/netlib/LAPACKE/lapacke_dlarfb_work.c
+++ /dev/null
@@ -1,155 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlarfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* c, lapack_int ldc, double* work,
- lapack_int ldwork )
-{
- lapack_int info = 0;
- lapack_int nrows_v, ncols_v;
- lapack_int ldc_t, ldt_t, ldv_t;
- double *v_t = NULL, *t_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlarfb( &side, &trans, &direct, &storev, &m, &n, &k, v, &ldv, t,
- &ldt, c, &ldc, work, &ldwork );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- ldc_t = MAX(1,m);
- ldt_t = MAX(1,k);
- ldv_t = MAX(1,nrows_v);
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
- return info;
- }
- if( ldt < k ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
- return info;
- }
- if( ldv < ncols_v ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,ncols_v) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,k) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- LAPACKE_dtr_trans( matrix_order, 'l', 'u', k, v, ldv, v_t, ldv_t );
- LAPACKE_dge_trans( matrix_order, nrows_v-k, ncols_v, &v[k*ldv], ldv,
- &v_t[k], ldv_t );
- } else if( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", -8 );
- return -8;
- }
- LAPACKE_dtr_trans( matrix_order, 'u', 'u', k, &v[(nrows_v-k)*ldv],
- ldv, &v_t[nrows_v-k], ldv_t );
- LAPACKE_dge_trans( matrix_order, nrows_v-k, ncols_v, v, ldv, v_t,
- ldv_t );
- } else if( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( direct, 'f' ) ) {
- LAPACKE_dtr_trans( matrix_order, 'u', 'u', k, v, ldv, v_t, ldv_t );
- LAPACKE_dge_trans( matrix_order, nrows_v, ncols_v-k, &v[k], ldv,
- &v_t[k*ldv_t], ldv_t );
- } else if( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", -8 );
- return -8;
- }
- LAPACKE_dtr_trans( matrix_order, 'l', 'u', k, &v[ncols_v-k], ldv,
- &v_t[(ncols_v-k)*ldv_t], ldv_t );
- LAPACKE_dge_trans( matrix_order, nrows_v, ncols_v-k, v, ldv, v_t,
- ldv_t );
- }
- LAPACKE_dge_trans( matrix_order, k, k, t, ldt, t_t, ldt_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t,
- t_t, &ldt_t, c_t, &ldc_t, work, &ldwork );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlarfg.c b/netlib/LAPACKE/lapacke_dlarfg.c
deleted file mode 100644
index 33e4b29..0000000
--- a/netlib/LAPACKE/lapacke_dlarfg.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlarfg
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarfg( lapack_int n, double* alpha, double* x,
- lapack_int incx, double* tau )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, alpha, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dlarfg_work( n, alpha, x, incx, tau );
-}
diff --git a/netlib/LAPACKE/lapacke_dlarfg_work.c b/netlib/LAPACKE/lapacke_dlarfg_work.c
deleted file mode 100644
index cd23c09..0000000
--- a/netlib/LAPACKE/lapacke_dlarfg_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlarfg
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarfg_work( lapack_int n, double* alpha, double* x,
- lapack_int incx, double* tau )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dlarfg( &n, alpha, x, &incx, tau );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlarft.c b/netlib/LAPACKE/lapacke_dlarft.c
deleted file mode 100644
index f1a66c3..0000000
--- a/netlib/LAPACKE/lapacke_dlarft.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlarft
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* tau, double* t,
- lapack_int ldt )
-{
- lapack_int ncols_v, nrows_v;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlarft", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_v, ncols_v, v, ldv ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dlarft_work( matrix_order, direct, storev, n, k, v, ldv, tau,
- t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_dlarft_work.c b/netlib/LAPACKE/lapacke_dlarft_work.c
deleted file mode 100644
index 2e6a719..0000000
--- a/netlib/LAPACKE/lapacke_dlarft_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlarft
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* tau, double* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- lapack_int nrows_v, ncols_v;
- lapack_int ldt_t, ldv_t;
- double *v_t = NULL, *t_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlarft( &direct, &storev, &n, &k, v, &ldv, tau, t, &ldt );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- ldt_t = MAX(1,k);
- ldv_t = MAX(1,nrows_v);
- /* Check leading dimension(s) */
- if( ldt < k ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dlarft_work", info );
- return info;
- }
- if( ldv < ncols_v ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dlarft_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,ncols_v) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,k) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, nrows_v, ncols_v, v, ldv, v_t, ldv_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t,
- &ldt_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlarft_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlarft_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlarfx.c b/netlib/LAPACKE/lapacke_dlarfx.c
deleted file mode 100644
index 099e5c6..0000000
--- a/netlib/LAPACKE/lapacke_dlarfx.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlarfx
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const double* v, double tau, double* c,
- lapack_int ldc, double* work )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlarfx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &tau, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( m, v, 1 ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dlarfx_work( matrix_order, side, m, n, v, tau, c, ldc,
- work );
-}
diff --git a/netlib/LAPACKE/lapacke_dlarfx_work.c b/netlib/LAPACKE/lapacke_dlarfx_work.c
deleted file mode 100644
index 2635bf3..0000000
--- a/netlib/LAPACKE/lapacke_dlarfx_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlarfx
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const double* v, double tau,
- double* c, lapack_int ldc, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlarfx( &side, &m, &n, v, &tau, c, &ldc, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldc_t = MAX(1,m);
- double* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dlarfx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlarfx( &side, &m, &n, v, &tau, c_t, &ldc_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlarfx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlarfx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlarnv.c b/netlib/LAPACKE/lapacke_dlarnv.c
deleted file mode 100644
index 8d82546..0000000
--- a/netlib/LAPACKE/lapacke_dlarnv.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlarnv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- double* x )
-{
- return LAPACKE_dlarnv_work( idist, iseed, n, x );
-}
diff --git a/netlib/LAPACKE/lapacke_dlarnv_work.c b/netlib/LAPACKE/lapacke_dlarnv_work.c
deleted file mode 100644
index fcb649c..0000000
--- a/netlib/LAPACKE/lapacke_dlarnv_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlarnv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, double* x )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dlarnv( &idist, iseed, &n, x );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlartgp.c b/netlib/LAPACKE/lapacke_dlartgp.c
deleted file mode 100644
index 2613305..0000000
--- a/netlib/LAPACKE/lapacke_dlartgp.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlartgp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlartgp( double f, double g, double* cs, double* sn,
- double* r )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &f, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &g, 1 ) ) {
- return -2;
- }
-#endif
- return LAPACKE_dlartgp_work( f, g, cs, sn, r );
-}
diff --git a/netlib/LAPACKE/lapacke_dlartgp_work.c b/netlib/LAPACKE/lapacke_dlartgp_work.c
deleted file mode 100644
index d66913a..0000000
--- a/netlib/LAPACKE/lapacke_dlartgp_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlartgp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlartgp_work( double f, double g, double* cs, double* sn,
- double* r )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dlartgp( &f, &g, cs, sn, r );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlartgs.c b/netlib/LAPACKE/lapacke_dlartgs.c
deleted file mode 100644
index 2c0c031..0000000
--- a/netlib/LAPACKE/lapacke_dlartgs.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlartgs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlartgs( double x, double y, double sigma, double* cs,
- double* sn )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &sigma, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
-#endif
- return LAPACKE_dlartgs_work( x, y, sigma, cs, sn );
-}
diff --git a/netlib/LAPACKE/lapacke_dlartgs_work.c b/netlib/LAPACKE/lapacke_dlartgs_work.c
deleted file mode 100644
index 16ded77..0000000
--- a/netlib/LAPACKE/lapacke_dlartgs_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlartgs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlartgs_work( double x, double y, double sigma, double* cs,
- double* sn )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dlartgs( &x, &y, &sigma, cs, sn );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlaset.c b/netlib/LAPACKE/lapacke_dlaset.c
deleted file mode 100644
index 349ca0a..0000000
--- a/netlib/LAPACKE/lapacke_dlaset.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlaset
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, double alpha, double beta, double* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlaset", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dlaset_work( matrix_order, uplo, m, n, alpha, beta, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dlaset_work.c b/netlib/LAPACKE/lapacke_dlaset_work.c
deleted file mode 100644
index 132f375..0000000
--- a/netlib/LAPACKE/lapacke_dlaset_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlaset
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, double alpha, double beta,
- double* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlaset( &uplo, &m, &n, &alpha, &beta, a, &lda );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dlaset_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlaset( &uplo, &m, &n, &alpha, &beta, a_t, &lda_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlaset_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlaset_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlasrt.c b/netlib/LAPACKE/lapacke_dlasrt.c
deleted file mode 100644
index ba8a244..0000000
--- a/netlib/LAPACKE/lapacke_dlasrt.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlasrt
-* Author: Intel Corporation
-* Generated May, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlasrt( char id, lapack_int n, double* d )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dlasrt_work( id, n, d );
-}
diff --git a/netlib/LAPACKE/lapacke_dlasrt_work.c b/netlib/LAPACKE/lapacke_dlasrt_work.c
deleted file mode 100644
index 715506d..0000000
--- a/netlib/LAPACKE/lapacke_dlasrt_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlasrt
-* Author: Intel Corporation
-* Generated May, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlasrt_work( char id, lapack_int n, double* d )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dlasrt( &id, &n, d, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlaswp.c b/netlib/LAPACKE/lapacke_dlaswp.c
deleted file mode 100644
index 3ea3fc1..0000000
--- a/netlib/LAPACKE/lapacke_dlaswp.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlaswp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlaswp( int matrix_order, lapack_int n, double* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlaswp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, lda, n, a, lda ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dlaswp_work( matrix_order, n, a, lda, k1, k2, ipiv, incx );
-}
diff --git a/netlib/LAPACKE/lapacke_dlaswp_work.c b/netlib/LAPACKE/lapacke_dlaswp_work.c
deleted file mode 100644
index dfe0274..0000000
--- a/netlib/LAPACKE/lapacke_dlaswp_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlaswp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlaswp_work( int matrix_order, lapack_int n, double* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlaswp( &n, a, &lda, &k1, &k2, ipiv, &incx );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,lda);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_dlaswp_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, lda, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlaswp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlaswp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlatms.c b/netlib/LAPACKE/lapacke_dlatms.c
deleted file mode 100644
index ade498d..0000000
--- a/netlib/LAPACKE/lapacke_dlatms.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlatms
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, double* d,
- lapack_int mode, double cond, double dmax,
- lapack_int kl, lapack_int ku, char pack, double* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlatms", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*(MAX(n,m))) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dlatms_work( matrix_order, m, n, dist, iseed, sym, d, mode,
- cond, dmax, kl, ku, pack, a, lda, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlatms", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlatms_work.c b/netlib/LAPACKE/lapacke_dlatms_work.c
deleted file mode 100644
index 1b86959..0000000
--- a/netlib/LAPACKE/lapacke_dlatms_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlatms
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- double* d, lapack_int mode, double cond,
- double dmax, lapack_int kl, lapack_int ku,
- char pack, double* a, lapack_int lda,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl,
- &ku, &pack, a, &lda, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dlatms_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl,
- &ku, &pack, a_t, &lda_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlatms_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlatms_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dlauum.c b/netlib/LAPACKE/lapacke_dlauum.c
deleted file mode 100644
index c4182be..0000000
--- a/netlib/LAPACKE/lapacke_dlauum.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dlauum
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlauum( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dlauum", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dlauum_work( matrix_order, uplo, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dlauum_work.c b/netlib/LAPACKE/lapacke_dlauum_work.c
deleted file mode 100644
index 10a49a9..0000000
--- a/netlib/LAPACKE/lapacke_dlauum_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dlauum
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dlauum_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dlauum( &uplo, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dlauum_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dlauum( &uplo, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dlauum_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dlauum_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dopgtr.c b/netlib/LAPACKE/lapacke_dopgtr.c
deleted file mode 100644
index 0efda7f..0000000
--- a/netlib/LAPACKE/lapacke_dopgtr.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dopgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dopgtr( int matrix_order, char uplo, lapack_int n,
- const double* ap, const double* tau, double* q,
- lapack_int ldq )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dopgtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n-1) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dopgtr_work( matrix_order, uplo, n, ap, tau, q, ldq, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dopgtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dopgtr_work.c b/netlib/LAPACKE/lapacke_dopgtr_work.c
deleted file mode 100644
index 7a8db1c..0000000
--- a/netlib/LAPACKE/lapacke_dopgtr_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dopgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dopgtr_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, const double* tau, double* q,
- lapack_int ldq, double* work )
-{
- lapack_int info = 0;
- lapack_int ldq_t;
- double *q_t = NULL, *ap_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dopgtr( &uplo, &n, ap, tau, q, &ldq, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- ldq_t = MAX(1,n);
- /* Check leading dimension(s) */
- if( ldq < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dopgtr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dopgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( q_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dopgtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dopgtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dopmtr.c b/netlib/LAPACKE/lapacke_dopmtr.c
deleted file mode 100644
index c025530..0000000
--- a/netlib/LAPACKE/lapacke_dopmtr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dopmtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dopmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const double* ap,
- const double* tau, double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- double* work = NULL;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dopmtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dsp_nancheck( r, ap ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
- return -8;
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( side, 'l' ) ) {
- lwork = MAX(1,n);
- } else if( LAPACKE_lsame( side, 'r' ) ) {
- lwork = MAX(1,m);
- } else {
- lwork = 1; /* Any value */
- }
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dopmtr_work( matrix_order, side, uplo, trans, m, n, ap, tau,
- c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dopmtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dopmtr_work.c b/netlib/LAPACKE/lapacke_dopmtr_work.c
deleted file mode 100644
index 5ddf4f8..0000000
--- a/netlib/LAPACKE/lapacke_dopmtr_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dopmtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dopmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const double* ap, const double* tau, double* c,
- lapack_int ldc, double* work )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int ldc_t;
- double *c_t = NULL, *ap_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dopmtr( &side, &uplo, &trans, &m, &n, ap, tau, c, &ldc, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dopmtr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,r) * MAX(2,r+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- LAPACKE_dsp_trans( matrix_order, uplo, r, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dopmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( c_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dopmtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dopmtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorbdb.c b/netlib/LAPACKE/lapacke_dorbdb.c
deleted file mode 100644
index 9f6c899..0000000
--- a/netlib/LAPACKE/lapacke_dorbdb.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorbdb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2 )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorbdb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x11, q, x11, ldx11 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x12, m-q, x12, ldx12 ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x21, q, x21, ldx21 ) ) {
- return -11;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x22, m-q, x22, ldx22 ) ) {
- return -13;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorbdb_work( matrix_order, trans, signs, m, p, q, x11, ldx11,
- x12, ldx12, x21, ldx21, x22, ldx22, theta, phi,
- taup1, taup2, tauq1, tauq2, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorbdb_work( matrix_order, trans, signs, m, p, q, x11, ldx11,
- x12, ldx12, x21, ldx21, x22, ldx22, theta, phi,
- taup1, taup2, tauq1, tauq2, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorbdb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorbdb_work.c b/netlib/LAPACKE/lapacke_dorbdb_work.c
deleted file mode 100644
index 247cc52..0000000
--- a/netlib/LAPACKE/lapacke_dorbdb_work.c
+++ /dev/null
@@ -1,160 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorbdb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
- x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
- tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- double* x11_t = NULL;
- double* x12_t = NULL;
- double* x21_t = NULL;
- double* x22_t = NULL;
- /* Check leading dimension(s) */
- if( ldx11 < q ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
- &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (double*)LAPACKE_malloc( sizeof(double) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (double*)LAPACKE_malloc( sizeof(double) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_dge_trans( matrix_order, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_dge_trans( matrix_order, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_dge_trans( matrix_order, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
- &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- /* Release memory and exit */
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorcsd.c b/netlib/LAPACKE/lapacke_dorcsd.c
deleted file mode 100644
index f394cf1..0000000
--- a/netlib/LAPACKE/lapacke_dorcsd.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* u1, lapack_int ldu1, double* u2,
- lapack_int ldu2, double* v1t, lapack_int ldv1t,
- double* v2t, lapack_int ldv2t )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorcsd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x11, q, x11, ldx11 ) ) {
- return -11;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x12, m-q, x12, ldx12 ) ) {
- return -13;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x21, q, x21, ldx21 ) ) {
- return -15;
- }
- if( LAPACKE_dge_nancheck( matrix_order, nrows_x22, m-q, x22, ldx22 ) ) {
- return -17;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-q) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dorcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, signs, m, p, q, x11, ldx11, x12, ldx12,
- x21, ldx21, x22, ldx22, theta, u1, ldu1, u2,
- ldu2, v1t, ldv1t, v2t, ldv2t, &work_query,
- lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, signs, m, p, q, x11, ldx11, x12, ldx12,
- x21, ldx21, x22, ldx22, theta, u1, ldu1, u2,
- ldu2, v1t, ldv1t, v2t, ldv2t, work, lwork,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorcsd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorcsd_work.c b/netlib/LAPACKE/lapacke_dorcsd_work.c
deleted file mode 100644
index 759d604..0000000
--- a/netlib/LAPACKE/lapacke_dorcsd_work.c
+++ /dev/null
@@ -1,264 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, double* x11, lapack_int ldx11,
- double* x12, lapack_int ldx12, double* x21,
- lapack_int ldx21, double* x22, lapack_int ldx22,
- double* theta, double* u1, lapack_int ldu1,
- double* u2, lapack_int ldu2, double* v1t,
- lapack_int ldv1t, double* v2t, lapack_int ldv2t,
- double* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
- theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- double* x11_t = NULL;
- double* x12_t = NULL;
- double* x21_t = NULL;
- double* x22_t = NULL;
- double* u1_t = NULL;
- double* u2_t = NULL;
- double* v1t_t = NULL;
- double* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -25;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -27;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx11 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
- &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
- x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
- &ldv1t_t, v2t, &ldv2t_t, work, &lwork, iwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (double*)LAPACKE_malloc( sizeof(double) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (double*)LAPACKE_malloc( sizeof(double) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_6;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_7;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_dge_trans( matrix_order, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_dge_trans( matrix_order, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_dge_trans( matrix_order, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
- x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
- v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_7:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_6:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_5:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_4:
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgbr.c b/netlib/LAPACKE/lapacke_dorgbr.c
deleted file mode 100644
index 04f5ba0..0000000
--- a/netlib/LAPACKE/lapacke_dorgbr.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorgbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, double* a,
- lapack_int lda, const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorgbr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( MIN(m,k), tau, 1 ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorgbr_work( matrix_order, vect, m, n, k, a, lda, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorgbr_work( matrix_order, vect, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgbr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgbr_work.c b/netlib/LAPACKE/lapacke_dorgbr_work.c
deleted file mode 100644
index 95916ee..0000000
--- a/netlib/LAPACKE/lapacke_dorgbr_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorgbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, double* a,
- lapack_int lda, const double* tau, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorgbr( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dorgbr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorgbr( &vect, &m, &n, &k, a, &lda_t, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorgbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgbr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorgbr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorghr.c b/netlib/LAPACKE/lapacke_dorghr.c
deleted file mode 100644
index 59c9082..0000000
--- a/netlib/LAPACKE/lapacke_dorghr.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorghr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorghr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorghr_work( matrix_order, n, ilo, ihi, a, lda, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorghr_work( matrix_order, n, ilo, ihi, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorghr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorghr_work.c b/netlib/LAPACKE/lapacke_dorghr_work.c
deleted file mode 100644
index 0229267..0000000
--- a/netlib/LAPACKE/lapacke_dorghr_work.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorghr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorghr( &n, &ilo, &ihi, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dorghr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorghr( &n, &ilo, &ihi, a, &lda_t, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorghr( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorghr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorghr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorglq.c b/netlib/LAPACKE/lapacke_dorglq.c
deleted file mode 100644
index 6d56fee..0000000
--- a/netlib/LAPACKE/lapacke_dorglq.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorglq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorglq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorglq_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorglq_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorglq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorglq_work.c b/netlib/LAPACKE/lapacke_dorglq_work.c
deleted file mode 100644
index 2a636ec..0000000
--- a/netlib/LAPACKE/lapacke_dorglq_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorglq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorglq( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dorglq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorglq( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorglq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorglq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorglq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgql.c b/netlib/LAPACKE/lapacke_dorgql.c
deleted file mode 100644
index cd55363..0000000
--- a/netlib/LAPACKE/lapacke_dorgql.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorgql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorgql", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorgql_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorgql_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgql", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgql_work.c b/netlib/LAPACKE/lapacke_dorgql_work.c
deleted file mode 100644
index b01dcdd..0000000
--- a/netlib/LAPACKE/lapacke_dorgql_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorgql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorgql( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dorgql_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorgql( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorgql( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgql_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorgql_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgqr.c b/netlib/LAPACKE/lapacke_dorgqr.c
deleted file mode 100644
index 6748390..0000000
--- a/netlib/LAPACKE/lapacke_dorgqr.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorgqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorgqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorgqr_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorgqr_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgqr_work.c b/netlib/LAPACKE/lapacke_dorgqr_work.c
deleted file mode 100644
index 8d256bc..0000000
--- a/netlib/LAPACKE/lapacke_dorgqr_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorgqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorgqr( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dorgqr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorgqr( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorgqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorgqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgrq.c b/netlib/LAPACKE/lapacke_dorgrq.c
deleted file mode 100644
index 9e501b6..0000000
--- a/netlib/LAPACKE/lapacke_dorgrq.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorgrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorgrq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorgrq_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorgrq_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgrq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgrq_work.c b/netlib/LAPACKE/lapacke_dorgrq_work.c
deleted file mode 100644
index 59382c0..0000000
--- a/netlib/LAPACKE/lapacke_dorgrq_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorgrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorgrq( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dorgrq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorgrq( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorgrq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgrq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorgrq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgtr.c b/netlib/LAPACKE/lapacke_dorgtr.c
deleted file mode 100644
index 8901e08..0000000
--- a/netlib/LAPACKE/lapacke_dorgtr.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dorgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgtr( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, const double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dorgtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dorgtr_work( matrix_order, uplo, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dorgtr_work( matrix_order, uplo, n, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dorgtr_work.c b/netlib/LAPACKE/lapacke_dorgtr_work.c
deleted file mode 100644
index d9bcc34..0000000
--- a/netlib/LAPACKE/lapacke_dorgtr_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dorgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dorgtr_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorgtr( &uplo, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dorgtr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorgtr( &uplo, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorgtr( &uplo, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorgtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dorgtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormbr.c b/netlib/LAPACKE/lapacke_dormbr.c
deleted file mode 100644
index 3ddd33b..0000000
--- a/netlib/LAPACKE/lapacke_dormbr.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int nq, r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormbr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- if( LAPACKE_dge_nancheck( matrix_order, r, MIN(nq,k), a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( MIN(nq,k), tau, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormbr_work( matrix_order, vect, side, trans, m, n, k, a,
- lda, tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormbr_work( matrix_order, vect, side, trans, m, n, k, a,
- lda, tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormbr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormbr_work.c b/netlib/LAPACKE/lapacke_dormbr_work.c
deleted file mode 100644
index 2ce4ace..0000000
--- a/netlib/LAPACKE/lapacke_dormbr_work.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int nq, r;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormbr( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < MIN(nq,k) ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dormbr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dormbr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormbr( &vect, &side, &trans, &m, &n, &k, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)
- LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,MIN(nq,k)) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, r, MIN(nq,k), a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormbr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormbr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormhr.c b/netlib/LAPACKE/lapacke_dormhr.c
deleted file mode 100644
index dd9dd62..0000000
--- a/netlib/LAPACKE/lapacke_dormhr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormhr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormhr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_order, r, r, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormhr_work( matrix_order, side, trans, m, n, ilo, ihi, a,
- lda, tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormhr_work( matrix_order, side, trans, m, n, ilo, ihi, a,
- lda, tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormhr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormhr_work.c b/netlib/LAPACKE/lapacke_dormhr_work.c
deleted file mode 100644
index ebe1859..0000000
--- a/netlib/LAPACKE/lapacke_dormhr_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormhr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormhr( &side, &trans, &m, &n, &ilo, &ihi, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < r ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dormhr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dormhr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormhr( &side, &trans, &m, &n, &ilo, &ihi, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,r) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, r, r, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormhr( &side, &trans, &m, &n, &ilo, &ihi, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormhr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormhr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormlq.c b/netlib/LAPACKE/lapacke_dormlq.c
deleted file mode 100644
index 06e4ea6..0000000
--- a/netlib/LAPACKE/lapacke_dormlq.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormlq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormlq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormlq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormlq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormlq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormlq_work.c b/netlib/LAPACKE/lapacke_dormlq_work.c
deleted file mode 100644
index 9a7a997..0000000
--- a/netlib/LAPACKE/lapacke_dormlq_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormlq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lda_t = MAX(1,k);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormql.c b/netlib/LAPACKE/lapacke_dormql.c
deleted file mode 100644
index 490f6cc..0000000
--- a/netlib/LAPACKE/lapacke_dormql.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormql", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_order, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormql_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormql_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormql", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormql_work.c b/netlib/LAPACKE/lapacke_dormql_work.c
deleted file mode 100644
index 5f999c8..0000000
--- a/netlib/LAPACKE/lapacke_dormql_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormql( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < k ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dormql_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dormql_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormql( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,k) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, r, k, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormql_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormql_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormqr.c b/netlib/LAPACKE/lapacke_dormqr.c
deleted file mode 100644
index bccbb05..0000000
--- a/netlib/LAPACKE/lapacke_dormqr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_order, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormqr_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormqr_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormqr_work.c b/netlib/LAPACKE/lapacke_dormqr_work.c
deleted file mode 100644
index ff3111b..0000000
--- a/netlib/LAPACKE/lapacke_dormqr_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormqr( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < k ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormqr( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,k) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, r, k, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormrq.c b/netlib/LAPACKE/lapacke_dormrq.c
deleted file mode 100644
index 5c8af94..0000000
--- a/netlib/LAPACKE/lapacke_dormrq.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormrq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormrq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormrq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormrq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormrq_work.c b/netlib/LAPACKE/lapacke_dormrq_work.c
deleted file mode 100644
index bb200c7..0000000
--- a/netlib/LAPACKE/lapacke_dormrq_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormrq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lda_t = MAX(1,k);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dormrq_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dormrq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormrq( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormrq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormrq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormrq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormrz.c b/netlib/LAPACKE/lapacke_dormrz.c
deleted file mode 100644
index 07b94f7..0000000
--- a/netlib/LAPACKE/lapacke_dormrz.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormrz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormrz", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormrz_work( matrix_order, side, trans, m, n, k, l, a, lda,
- tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormrz_work( matrix_order, side, trans, m, n, k, l, a, lda,
- tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormrz", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormrz_work.c b/netlib/LAPACKE/lapacke_dormrz_work.c
deleted file mode 100644
index c01c569..0000000
--- a/netlib/LAPACKE/lapacke_dormrz_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormrz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormrz( &side, &trans, &m, &n, &k, &l, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lda_t = MAX(1,k);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dormrz_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dormrz_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormrz( &side, &trans, &m, &n, &k, &l, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormrz( &side, &trans, &m, &n, &k, &l, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormrz_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormrz_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormtr.c b/netlib/LAPACKE/lapacke_dormtr.c
deleted file mode 100644
index 317e124..0000000
--- a/netlib/LAPACKE/lapacke_dormtr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dormtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* tau, double* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dormtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_order, r, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dormtr_work( matrix_order, side, uplo, trans, m, n, a, lda,
- tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dormtr_work( matrix_order, side, uplo, trans, m, n, a, lda,
- tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dormtr_work.c b/netlib/LAPACKE/lapacke_dormtr_work.c
deleted file mode 100644
index 4430226..0000000
--- a/netlib/LAPACKE/lapacke_dormtr_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dormtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dormtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r, lda_t, ldc_t;
- double *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dormtr( &side, &uplo, &trans, &m, &n, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < r ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dormtr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dormtr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dormtr( &side, &uplo, &trans, &m, &n, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,r) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, r, r, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dormtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dormtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dormtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpb_nancheck.c b/netlib/LAPACKE/lapacke_dpb_nancheck.c
deleted file mode 100644
index 8ea609b..0000000
--- a/netlib/LAPACKE/lapacke_dpb_nancheck.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dpb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const double* ab,
- lapack_int ldab )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- return LAPACKE_dgb_nancheck( matrix_order, n, n, 0, kd, ab, ldab );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- return LAPACKE_dgb_nancheck( matrix_order, n, n, kd, 0, ab, ldab );
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_dpb_trans.c b/netlib/LAPACKE/lapacke_dpb_trans.c
deleted file mode 100644
index 1365e59..0000000
--- a/netlib/LAPACKE/lapacke_dpb_trans.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric banded matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dpb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- LAPACKE_dgb_trans( matrix_order, n, n, 0, kd, in, ldin, out, ldout );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- LAPACKE_dgb_trans( matrix_order, n, n, kd, 0, in, ldin, out, ldout );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dpbcon.c b/netlib/LAPACKE/lapacke_dpbcon.c
deleted file mode 100644
index 4279876..0000000
--- a/netlib/LAPACKE/lapacke_dpbcon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab, lapack_int ldab,
- double anorm, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpbcon_work( matrix_order, uplo, n, kd, ab, ldab, anorm,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbcon_work.c b/netlib/LAPACKE/lapacke_dpbcon_work.c
deleted file mode 100644
index e685d1f..0000000
--- a/netlib/LAPACKE/lapacke_dpbcon_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab,
- lapack_int ldab, double anorm, double* rcond,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbcon( &uplo, &n, &kd, ab, &ldab, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dpbcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbcon( &uplo, &n, &kd, ab_t, &ldab_t, &anorm, rcond, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbequ.c b/netlib/LAPACKE/lapacke_dpbequ.c
deleted file mode 100644
index 0e86760..0000000
--- a/netlib/LAPACKE/lapacke_dpbequ.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab, lapack_int ldab,
- double* s, double* scond, double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dpbequ_work( matrix_order, uplo, n, kd, ab, ldab, s, scond,
- amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dpbequ_work.c b/netlib/LAPACKE/lapacke_dpbequ_work.c
deleted file mode 100644
index cf168ff..0000000
--- a/netlib/LAPACKE/lapacke_dpbequ_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbequ( &uplo, &n, &kd, ab, &ldab, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dpbequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbequ( &uplo, &n, &kd, ab_t, &ldab_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbrfs.c b/netlib/LAPACKE/lapacke_dpbrfs.c
deleted file mode 100644
index b759907..0000000
--- a/netlib/LAPACKE/lapacke_dpbrfs.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* afb, lapack_int ldafb,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, afb, ldafb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpbrfs_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, afb,
- ldafb, b, ldb, x, ldx, ferr, berr, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbrfs_work.c b/netlib/LAPACKE/lapacke_dpbrfs_work.c
deleted file mode 100644
index ea3d4ee..0000000
--- a/netlib/LAPACKE/lapacke_dpbrfs_work.c
+++ /dev/null
@@ -1,135 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbrfs( &uplo, &n, &kd, &nrhs, ab, &ldab, afb, &ldafb, b, &ldb,
- x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldafb_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* ab_t = NULL;
- double* afb_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (double*)LAPACKE_malloc( sizeof(double) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, afb, ldafb, afb_t,
- ldafb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbrfs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t,
- b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbstf.c b/netlib/LAPACKE/lapacke_dpbstf.c
deleted file mode 100644
index 23ae0f0..0000000
--- a/netlib/LAPACKE/lapacke_dpbstf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbstf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, double* bb, lapack_int ldbb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbstf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dpbstf_work( matrix_order, uplo, n, kb, bb, ldbb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpbstf_work.c b/netlib/LAPACKE/lapacke_dpbstf_work.c
deleted file mode 100644
index 09881e7..0000000
--- a/netlib/LAPACKE/lapacke_dpbstf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbstf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, double* bb, lapack_int ldbb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbstf( &uplo, &n, &kb, bb, &ldbb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldbb_t = MAX(1,kb+1);
- double* bb_t = NULL;
- /* Check leading dimension(s) */
- if( ldbb < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dpbstf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- bb_t = (double*)LAPACKE_malloc( sizeof(double) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbstf( &uplo, &n, &kb, bb_t, &ldbb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- /* Release memory and exit */
- LAPACKE_free( bb_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbstf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbstf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbsv.c b/netlib/LAPACKE/lapacke_dpbsv.c
deleted file mode 100644
index fc52b05..0000000
--- a/netlib/LAPACKE/lapacke_dpbsv.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_dpbsv_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpbsv_work.c b/netlib/LAPACKE/lapacke_dpbsv_work.c
deleted file mode 100644
index f105e61..0000000
--- a/netlib/LAPACKE/lapacke_dpbsv_work.c
+++ /dev/null
@@ -1,100 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbsv( &uplo, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- double* ab_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dpbsv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dpbsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbsv( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbsvx.c b/netlib/LAPACKE/lapacke_dpbsvx.c
deleted file mode 100644
index 0acd920..0000000
--- a/netlib/LAPACKE/lapacke_dpbsvx.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* afb, lapack_int ldafb,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, afb, ldafb ) ) {
- return -9;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpbsvx_work( matrix_order, fact, uplo, n, kd, nrhs, ab, ldab,
- afb, ldafb, equed, s, b, ldb, x, ldx, rcond,
- ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbsvx_work.c b/netlib/LAPACKE/lapacke_dpbsvx_work.c
deleted file mode 100644
index cd9e232..0000000
--- a/netlib/LAPACKE/lapacke_dpbsvx_work.c
+++ /dev/null
@@ -1,146 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- double* ab, lapack_int ldab, double* afb,
- lapack_int ldafb, char* equed, double* s,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbsvx( &fact, &uplo, &n, &kd, &nrhs, ab, &ldab, afb, &ldafb,
- equed, s, b, &ldb, x, &ldx, rcond, ferr, berr, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldafb_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* ab_t = NULL;
- double* afb_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (double*)LAPACKE_malloc( sizeof(double) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, afb, ldafb, afb_t,
- ldafb_t );
- }
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbsvx( &fact, &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t,
- &ldafb_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t,
- afb, ldafb );
- }
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbtrf.c b/netlib/LAPACKE/lapacke_dpbtrf.c
deleted file mode 100644
index f8b2602..0000000
--- a/netlib/LAPACKE/lapacke_dpbtrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbtrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dpbtrf_work( matrix_order, uplo, n, kd, ab, ldab );
-}
diff --git a/netlib/LAPACKE/lapacke_dpbtrf_work.c b/netlib/LAPACKE/lapacke_dpbtrf_work.c
deleted file mode 100644
index d1c9faa..0000000
--- a/netlib/LAPACKE/lapacke_dpbtrf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbtrf( &uplo, &n, &kd, ab, &ldab, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dpbtrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbtrf( &uplo, &n, &kd, ab_t, &ldab_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbtrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbtrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpbtrs.c b/netlib/LAPACKE/lapacke_dpbtrs.c
deleted file mode 100644
index 880cc97..0000000
--- a/netlib/LAPACKE/lapacke_dpbtrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const double* ab,
- lapack_int ldab, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpbtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_dpbtrs_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpbtrs_work.c b/netlib/LAPACKE/lapacke_dpbtrs_work.c
deleted file mode 100644
index b78efdd..0000000
--- a/netlib/LAPACKE/lapacke_dpbtrs_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpbtrs( &uplo, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- double* ab_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpf_nancheck.c b/netlib/LAPACKE/lapacke_dpf_nancheck.c
deleted file mode 100644
index 86433a9..0000000
--- a/netlib/LAPACKE/lapacke_dpf_nancheck.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo, transr or
- * matrix_order.
- */
-
-lapack_logical LAPACKE_dpf_nancheck( lapack_int n,
- const double *a )
-{
- lapack_int len = n*(n+1)/2;
- return LAPACKE_d_nancheck( len, a, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_dpf_trans.c b/netlib/LAPACKE/lapacke_dpf_trans.c
deleted file mode 100644
index 3b4ccfe..0000000
--- a/netlib/LAPACKE/lapacke_dpf_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input RFP matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dpf_trans( int matrix_order, char transr, char uplo,
- lapack_int n, const double *in,
- double *out )
-{
- LAPACKE_dtf_trans( matrix_order, transr, uplo, 'n', n, in, out );
-}
diff --git a/netlib/LAPACKE/lapacke_dpftrf.c b/netlib/LAPACKE/lapacke_dpftrf.c
deleted file mode 100644
index 1f1ef62..0000000
--- a/netlib/LAPACKE/lapacke_dpftrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpftrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, double* a )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpftrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, a ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dpftrf_work( matrix_order, transr, uplo, n, a );
-}
diff --git a/netlib/LAPACKE/lapacke_dpftrf_work.c b/netlib/LAPACKE/lapacke_dpftrf_work.c
deleted file mode 100644
index e20e985..0000000
--- a/netlib/LAPACKE/lapacke_dpftrf_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpftrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, double* a )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpftrf( &transr, &uplo, &n, a, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpf_trans( matrix_order, transr, uplo, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpftrf( &transr, &uplo, &n, a_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpftrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpftrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpftri.c b/netlib/LAPACKE/lapacke_dpftri.c
deleted file mode 100644
index 8e2fdc8..0000000
--- a/netlib/LAPACKE/lapacke_dpftri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpftri( int matrix_order, char transr, char uplo,
- lapack_int n, double* a )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpftri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, a ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dpftri_work( matrix_order, transr, uplo, n, a );
-}
diff --git a/netlib/LAPACKE/lapacke_dpftri_work.c b/netlib/LAPACKE/lapacke_dpftri_work.c
deleted file mode 100644
index 8958323..0000000
--- a/netlib/LAPACKE/lapacke_dpftri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, double* a )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpftri( &transr, &uplo, &n, a, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpf_trans( matrix_order, transr, uplo, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpftri( &transr, &uplo, &n, a_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpftri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpftri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpftrs.c b/netlib/LAPACKE/lapacke_dpftrs.c
deleted file mode 100644
index 43e624f..0000000
--- a/netlib/LAPACKE/lapacke_dpftrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpftrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpftrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, a ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dpftrs_work( matrix_order, transr, uplo, n, nrhs, a, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpftrs_work.c b/netlib/LAPACKE/lapacke_dpftrs_work.c
deleted file mode 100644
index 78508b3..0000000
--- a/netlib/LAPACKE/lapacke_dpftrs_work.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpftrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpftrs( &transr, &uplo, &n, &nrhs, a, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dpftrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- a_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dpf_trans( matrix_order, transr, uplo, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpftrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpftrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpo_nancheck.c b/netlib/LAPACKE/lapacke_dpo_nancheck.c
deleted file mode 100644
index ae8902a..0000000
--- a/netlib/LAPACKE/lapacke_dpo_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dpo_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const double *a,
- lapack_int lda )
-{
- return LAPACKE_dtr_nancheck( matrix_order, uplo, 'n', n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dpo_trans.c b/netlib/LAPACKE/lapacke_dpo_trans.c
deleted file mode 100644
index 9aee578..0000000
--- a/netlib/LAPACKE/lapacke_dpo_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dpo_trans( int matrix_order, char uplo, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- LAPACKE_dtr_trans( matrix_order, uplo, 'n', n, in, ldin, out, ldout );
-}
diff --git a/netlib/LAPACKE/lapacke_dpocon.c b/netlib/LAPACKE/lapacke_dpocon.c
deleted file mode 100644
index 9aa81c5..0000000
--- a/netlib/LAPACKE/lapacke_dpocon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpocon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpocon( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpocon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpocon_work( matrix_order, uplo, n, a, lda, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpocon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpocon_work.c b/netlib/LAPACKE/lapacke_dpocon_work.c
deleted file mode 100644
index a1f9192..0000000
--- a/netlib/LAPACKE/lapacke_dpocon_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpocon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpocon_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpocon( &uplo, &n, a, &lda, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dpocon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpocon( &uplo, &n, a_t, &lda_t, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpocon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpocon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpoequ.c b/netlib/LAPACKE/lapacke_dpoequ.c
deleted file mode 100644
index 496145a..0000000
--- a/netlib/LAPACKE/lapacke_dpoequ.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpoequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpoequ( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpoequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dpoequ_work( matrix_order, n, a, lda, s, scond, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dpoequ_work.c b/netlib/LAPACKE/lapacke_dpoequ_work.c
deleted file mode 100644
index 369c0bf..0000000
--- a/netlib/LAPACKE/lapacke_dpoequ_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpoequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpoequ_work( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpoequ( &n, a, &lda, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_dpoequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpoequ( &n, a_t, &lda_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpoequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpoequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpoequb.c b/netlib/LAPACKE/lapacke_dpoequb.c
deleted file mode 100644
index b73b966..0000000
--- a/netlib/LAPACKE/lapacke_dpoequb.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpoequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpoequb( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpoequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dpoequb_work( matrix_order, n, a, lda, s, scond, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dpoequb_work.c b/netlib/LAPACKE/lapacke_dpoequb_work.c
deleted file mode 100644
index ac41324..0000000
--- a/netlib/LAPACKE/lapacke_dpoequb_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpoequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpoequb_work( int matrix_order, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpoequb( &n, a, &lda, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_dpoequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpoequb( &n, a_t, &lda_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpoequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpoequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dporfs.c b/netlib/LAPACKE/lapacke_dporfs.c
deleted file mode 100644
index f7197c2..0000000
--- a/netlib/LAPACKE/lapacke_dporfs.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dporfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dporfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -11;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dporfs_work( matrix_order, uplo, n, nrhs, a, lda, af, ldaf,
- b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dporfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dporfs_work.c b/netlib/LAPACKE/lapacke_dporfs_work.c
deleted file mode 100644
index 0b4e871..0000000
--- a/netlib/LAPACKE/lapacke_dporfs_work.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dporfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dporfs( &uplo, &n, &nrhs, a, &lda, af, &ldaf, b, &ldb, x, &ldx,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* af_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dporfs_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dporfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dporfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dporfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (double*)LAPACKE_malloc( sizeof(double) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dpo_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dporfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dporfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dporfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dposv.c b/netlib/LAPACKE/lapacke_dposv.c
deleted file mode 100644
index 284c174..0000000
--- a/netlib/LAPACKE/lapacke_dposv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dposv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dposv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dposv_work( matrix_order, uplo, n, nrhs, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dposv_work.c b/netlib/LAPACKE/lapacke_dposv_work.c
deleted file mode 100644
index 51eedd2..0000000
--- a/netlib/LAPACKE/lapacke_dposv_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dposv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dposv( &uplo, &n, &nrhs, a, &lda, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dposv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dposv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dposv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dposv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dposvx.c b/netlib/LAPACKE/lapacke_dposvx.c
deleted file mode 100644
index f446d49..0000000
--- a/netlib/LAPACKE/lapacke_dposvx.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dposvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* af, lapack_int ldaf, char* equed, double* s,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dposvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -8;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dposvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af,
- ldaf, equed, s, b, ldb, x, ldx, rcond, ferr,
- berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dposvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dposvx_work.c b/netlib/LAPACKE/lapacke_dposvx_work.c
deleted file mode 100644
index 5da1ea5..0000000
--- a/netlib/LAPACKE/lapacke_dposvx_work.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dposvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dposvx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, equed, s, b,
- &ldb, x, &ldx, rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* af_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dposvx_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dposvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dposvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dposvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (double*)LAPACKE_malloc( sizeof(double) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dpo_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- }
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
- equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
- ldaf );
- }
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dposvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dposvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpotrf.c b/netlib/LAPACKE/lapacke_dpotrf.c
deleted file mode 100644
index c59a66b..0000000
--- a/netlib/LAPACKE/lapacke_dpotrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpotrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpotrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpotrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dpotrf_work( matrix_order, uplo, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dpotrf_work.c b/netlib/LAPACKE/lapacke_dpotrf_work.c
deleted file mode 100644
index 00bdde2..0000000
--- a/netlib/LAPACKE/lapacke_dpotrf_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpotrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpotrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpotrf( &uplo, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dpotrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpotrf( &uplo, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpotrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpotrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpotri.c b/netlib/LAPACKE/lapacke_dpotri.c
deleted file mode 100644
index d2c9365..0000000
--- a/netlib/LAPACKE/lapacke_dpotri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpotri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpotri( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpotri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dpotri_work( matrix_order, uplo, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dpotri_work.c b/netlib/LAPACKE/lapacke_dpotri_work.c
deleted file mode 100644
index 7072000..0000000
--- a/netlib/LAPACKE/lapacke_dpotri_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpotri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpotri_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpotri( &uplo, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dpotri_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpotri( &uplo, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpotri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpotri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpotrs.c b/netlib/LAPACKE/lapacke_dpotrs.c
deleted file mode 100644
index 4a20aab..0000000
--- a/netlib/LAPACKE/lapacke_dpotrs.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpotrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpotrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dpotrs_work( matrix_order, uplo, n, nrhs, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpotrs_work.c b/netlib/LAPACKE/lapacke_dpotrs_work.c
deleted file mode 100644
index 3378f43..0000000
--- a/netlib/LAPACKE/lapacke_dpotrs_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpotrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpotrs( &uplo, &n, &nrhs, a, &lda, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dpotrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dpotrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpotrs( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpotrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpotrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpp_nancheck.c b/netlib/LAPACKE/lapacke_dpp_nancheck.c
deleted file mode 100644
index a11365f..0000000
--- a/netlib/LAPACKE/lapacke_dpp_nancheck.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo or matrix_order.
- */
-
-lapack_logical LAPACKE_dpp_nancheck( lapack_int n,
- const double *ap )
-{
- lapack_int len = n*(n+1)/2;
- return LAPACKE_d_nancheck( len, ap, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_dpp_trans.c b/netlib/LAPACKE/lapacke_dpp_trans.c
deleted file mode 100644
index bd4a4b4..0000000
--- a/netlib/LAPACKE/lapacke_dpp_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric packed matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dpp_trans( int matrix_order, char uplo, lapack_int n,
- const double *in,
- double *out )
-{
- LAPACKE_dtp_trans( matrix_order, uplo, 'n', n, in, out );
-}
diff --git a/netlib/LAPACKE/lapacke_dppcon.c b/netlib/LAPACKE/lapacke_dppcon.c
deleted file mode 100644
index bc7f066..0000000
--- a/netlib/LAPACKE/lapacke_dppcon.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dppcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppcon( int matrix_order, char uplo, lapack_int n,
- const double* ap, double anorm, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dppcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -5;
- }
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dppcon_work( matrix_order, uplo, n, ap, anorm, rcond, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dppcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dppcon_work.c b/netlib/LAPACKE/lapacke_dppcon_work.c
deleted file mode 100644
index c19ac3f..0000000
--- a/netlib/LAPACKE/lapacke_dppcon_work.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dppcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppcon_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double anorm, double* rcond,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dppcon( &uplo, &n, ap, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dppcon( &uplo, &n, ap_t, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dppcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dppcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dppequ.c b/netlib/LAPACKE/lapacke_dppequ.c
deleted file mode 100644
index c47f335..0000000
--- a/netlib/LAPACKE/lapacke_dppequ.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dppequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppequ( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* s, double* scond,
- double* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dppequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dppequ_work( matrix_order, uplo, n, ap, s, scond, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_dppequ_work.c b/netlib/LAPACKE/lapacke_dppequ_work.c
deleted file mode 100644
index 3488215..0000000
--- a/netlib/LAPACKE/lapacke_dppequ_work.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dppequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppequ_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* s, double* scond,
- double* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dppequ( &uplo, &n, ap, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dppequ( &uplo, &n, ap_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dppequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dppequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpprfs.c b/netlib/LAPACKE/lapacke_dpprfs.c
deleted file mode 100644
index ab2bf62..0000000
--- a/netlib/LAPACKE/lapacke_dpprfs.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, const double* afp,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpprfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpprfs_work( matrix_order, uplo, n, nrhs, ap, afp, b, ldb, x,
- ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpprfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpprfs_work.c b/netlib/LAPACKE/lapacke_dpprfs_work.c
deleted file mode 100644
index 38d012b..0000000
--- a/netlib/LAPACKE/lapacke_dpprfs_work.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const double* afp, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpprfs( &uplo, &n, &nrhs, ap, afp, b, &ldb, x, &ldx, ferr, berr,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- double* ap_t = NULL;
- double* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_dpp_trans( matrix_order, uplo, n, afp, afp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dppsv.c b/netlib/LAPACKE/lapacke_dppsv.c
deleted file mode 100644
index 215d7a8..0000000
--- a/netlib/LAPACKE/lapacke_dppsv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dppsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dppsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dppsv_work( matrix_order, uplo, n, nrhs, ap, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dppsv_work.c b/netlib/LAPACKE/lapacke_dppsv_work.c
deleted file mode 100644
index fa38f9c..0000000
--- a/netlib/LAPACKE/lapacke_dppsv_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dppsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dppsv( &uplo, &n, &nrhs, ap, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dppsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dppsv( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dppsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dppsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dppsvx.c b/netlib/LAPACKE/lapacke_dppsvx.c
deleted file mode 100644
index ce2b7b0..0000000
--- a/netlib/LAPACKE/lapacke_dppsvx.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dppsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* afp,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dppsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpp_nancheck( n, afp ) ) {
- return -7;
- }
- }
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -9;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dppsvx_work( matrix_order, fact, uplo, n, nrhs, ap, afp,
- equed, s, b, ldb, x, ldx, rcond, ferr, berr,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dppsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dppsvx_work.c b/netlib/LAPACKE/lapacke_dppsvx_work.c
deleted file mode 100644
index cba95e8..0000000
--- a/netlib/LAPACKE/lapacke_dppsvx_work.c
+++ /dev/null
@@ -1,131 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dppsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* ap,
- double* afp, char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dppsvx( &fact, &uplo, &n, &nrhs, ap, afp, equed, s, b, &ldb, x,
- &ldx, rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- double* ap_t = NULL;
- double* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dppsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dppsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dpp_trans( matrix_order, uplo, n, afp, afp_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t,
- &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp );
- }
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dppsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dppsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpptrf.c b/netlib/LAPACKE/lapacke_dpptrf.c
deleted file mode 100644
index 1c8e1b6..0000000
--- a/netlib/LAPACKE/lapacke_dpptrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpptrf( int matrix_order, char uplo, lapack_int n,
- double* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpptrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dpptrf_work( matrix_order, uplo, n, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_dpptrf_work.c b/netlib/LAPACKE/lapacke_dpptrf_work.c
deleted file mode 100644
index 1788559..0000000
--- a/netlib/LAPACKE/lapacke_dpptrf_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpptrf_work( int matrix_order, char uplo, lapack_int n,
- double* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpptrf( &uplo, &n, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpptrf( &uplo, &n, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpptrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpptrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpptri.c b/netlib/LAPACKE/lapacke_dpptri.c
deleted file mode 100644
index 2c97cf5..0000000
--- a/netlib/LAPACKE/lapacke_dpptri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpptri( int matrix_order, char uplo, lapack_int n,
- double* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpptri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dpptri_work( matrix_order, uplo, n, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_dpptri_work.c b/netlib/LAPACKE/lapacke_dpptri_work.c
deleted file mode 100644
index dd3b7d2..0000000
--- a/netlib/LAPACKE/lapacke_dpptri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpptri_work( int matrix_order, char uplo, lapack_int n,
- double* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpptri( &uplo, &n, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpptri( &uplo, &n, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpptri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpptri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpptrs.c b/netlib/LAPACKE/lapacke_dpptrs.c
deleted file mode 100644
index 2cfb3d2..0000000
--- a/netlib/LAPACKE/lapacke_dpptrs.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpptrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dpptrs_work( matrix_order, uplo, n, nrhs, ap, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpptrs_work.c b/netlib/LAPACKE/lapacke_dpptrs_work.c
deleted file mode 100644
index c8d0a20..0000000
--- a/netlib/LAPACKE/lapacke_dpptrs_work.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpptrs( &uplo, &n, &nrhs, ap, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dpptrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpptrs( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpptrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpptrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpstrf.c b/netlib/LAPACKE/lapacke_dpstrf.c
deleted file mode 100644
index 74d30e1..0000000
--- a/netlib/LAPACKE/lapacke_dpstrf.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpstrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpstrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, lapack_int* piv, lapack_int* rank,
- double tol )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpstrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpstrf_work( matrix_order, uplo, n, a, lda, piv, rank, tol,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpstrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpstrf_work.c b/netlib/LAPACKE/lapacke_dpstrf_work.c
deleted file mode 100644
index 995cc1d..0000000
--- a/netlib/LAPACKE/lapacke_dpstrf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpstrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpstrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, lapack_int* piv,
- lapack_int* rank, double tol, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpstrf( &uplo, &n, a, &lda, piv, rank, &tol, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dpstrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpstrf( &uplo, &n, a_t, &lda_t, piv, rank, &tol, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpstrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpstrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpt_nancheck.c b/netlib/LAPACKE/lapacke_dpt_nancheck.c
deleted file mode 100644
index aa46c07..0000000
--- a/netlib/LAPACKE/lapacke_dpt_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dpt_nancheck( lapack_int n,
- const double *d,
- const double *e )
-{
- return LAPACKE_d_nancheck( n, d, 1 )
- || LAPACKE_d_nancheck( n-1, e, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_dptcon.c b/netlib/LAPACKE/lapacke_dptcon.c
deleted file mode 100644
index 7b5def4..0000000
--- a/netlib/LAPACKE/lapacke_dptcon.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dptcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptcon( lapack_int n, const double* d, const double* e,
- double anorm, double* rcond )
-{
- lapack_int info = 0;
- double* work = NULL;
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -3;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dptcon_work( n, d, e, anorm, rcond, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dptcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dptcon_work.c b/netlib/LAPACKE/lapacke_dptcon_work.c
deleted file mode 100644
index 29cf9a2..0000000
--- a/netlib/LAPACKE/lapacke_dptcon_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dptcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptcon_work( lapack_int n, const double* d, const double* e,
- double anorm, double* rcond, double* work )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dptcon( &n, d, e, &anorm, rcond, work, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpteqr.c b/netlib/LAPACKE/lapacke_dpteqr.c
deleted file mode 100644
index d031894..0000000
--- a/netlib/LAPACKE/lapacke_dpteqr.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpteqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -6;
- }
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( compz, 'n' ) ) {
- lwork = 1;
- } else {
- lwork = MAX(1,4*n-4);
- }
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dpteqr_work( matrix_order, compz, n, d, e, z, ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpteqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpteqr_work.c b/netlib/LAPACKE/lapacke_dpteqr_work.c
deleted file mode 100644
index 8327ddc..0000000
--- a/netlib/LAPACKE/lapacke_dpteqr_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpteqr( &compz, &n, d, e, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dpteqr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dpteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- /* Release memory and exit */
- LAPACKE_free( z_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpteqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpteqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dptrfs.c b/netlib/LAPACKE/lapacke_dptrfs.c
deleted file mode 100644
index 54e2ffe..0000000
--- a/netlib/LAPACKE/lapacke_dptrfs.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dptrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptrfs( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, const double* df,
- const double* ef, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* ferr,
- double* berr )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dptrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dptrfs_work( matrix_order, n, nrhs, d, e, df, ef, b, ldb, x,
- ldx, ferr, berr, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dptrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dptrfs_work.c b/netlib/LAPACKE/lapacke_dptrfs_work.c
deleted file mode 100644
index 64ff4ef..0000000
--- a/netlib/LAPACKE/lapacke_dptrfs_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dptrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptrfs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e,
- const double* df, const double* ef,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dptrfs( &n, &nrhs, d, e, df, ef, b, &ldb, x, &ldx, ferr, berr,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dptrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dptrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dptrfs( &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, ferr,
- berr, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dptrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dptrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dptsv.c b/netlib/LAPACKE/lapacke_dptsv.c
deleted file mode 100644
index 5e60c7a..0000000
--- a/netlib/LAPACKE/lapacke_dptsv.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dptsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, double* e, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dptsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dptsv_work( matrix_order, n, nrhs, d, e, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dptsv_work.c b/netlib/LAPACKE/lapacke_dptsv_work.c
deleted file mode 100644
index 4c755a1..0000000
--- a/netlib/LAPACKE/lapacke_dptsv_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dptsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, double* e, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dptsv( &n, &nrhs, d, e, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dptsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dptsv( &n, &nrhs, d, e, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dptsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dptsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dptsvx.c b/netlib/LAPACKE/lapacke_dptsvx.c
deleted file mode 100644
index c813359..0000000
--- a/netlib/LAPACKE/lapacke_dptsvx.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dptsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d, const double* e,
- double* df, double* ef, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dptsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dptsvx_work( matrix_order, fact, n, nrhs, d, e, df, ef, b,
- ldb, x, ldx, rcond, ferr, berr, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dptsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dptsvx_work.c b/netlib/LAPACKE/lapacke_dptsvx_work.c
deleted file mode 100644
index e8f1747..0000000
--- a/netlib/LAPACKE/lapacke_dptsvx_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dptsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const double* e, double* df, double* ef,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dptsvx( &fact, &n, &nrhs, d, e, df, ef, b, &ldb, x, &ldx, rcond,
- ferr, berr, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dptsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dptsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t,
- rcond, ferr, berr, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dptsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dptsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpttrf.c b/netlib/LAPACKE/lapacke_dpttrf.c
deleted file mode 100644
index d665270..0000000
--- a/netlib/LAPACKE/lapacke_dpttrf.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpttrf( lapack_int n, double* d, double* e )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dpttrf_work( n, d, e );
-}
diff --git a/netlib/LAPACKE/lapacke_dpttrf_work.c b/netlib/LAPACKE/lapacke_dpttrf_work.c
deleted file mode 100644
index 1d41209..0000000
--- a/netlib/LAPACKE/lapacke_dpttrf_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpttrf_work( lapack_int n, double* d, double* e )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dpttrf( &n, d, e, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dpttrs.c b/netlib/LAPACKE/lapacke_dpttrs.c
deleted file mode 100644
index 5060496..0000000
--- a/netlib/LAPACKE/lapacke_dpttrs.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dpttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpttrs( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dpttrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dpttrs_work( matrix_order, n, nrhs, d, e, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dpttrs_work.c b/netlib/LAPACKE/lapacke_dpttrs_work.c
deleted file mode 100644
index cd09693..0000000
--- a/netlib/LAPACKE/lapacke_dpttrs_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dpttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dpttrs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dpttrs( &n, &nrhs, d, e, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dpttrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dpttrs( &n, &nrhs, d, e, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dpttrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dpttrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsb_nancheck.c b/netlib/LAPACKE/lapacke_dsb_nancheck.c
deleted file mode 100644
index 95abc71..0000000
--- a/netlib/LAPACKE/lapacke_dsb_nancheck.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dsb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const double* ab,
- lapack_int ldab )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- return LAPACKE_dgb_nancheck( matrix_order, n, n, 0, kd, ab, ldab );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- return LAPACKE_dgb_nancheck( matrix_order, n, n, kd, 0, ab, ldab );
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_dsb_trans.c b/netlib/LAPACKE/lapacke_dsb_trans.c
deleted file mode 100644
index 064a4ef..0000000
--- a/netlib/LAPACKE/lapacke_dsb_trans.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetrical band matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dsb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- LAPACKE_dgb_trans( matrix_order, n, n, 0, kd, in, ldin, out, ldout );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- LAPACKE_dgb_trans( matrix_order, n, n, kd, 0, in, ldin, out, ldout );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dsbev.c b/netlib/LAPACKE/lapacke_dsbev.c
deleted file mode 100644
index b5003a2..0000000
--- a/netlib/LAPACKE/lapacke_dsbev.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab, double* w,
- double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n-2) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbev_work( matrix_order, jobz, uplo, n, kd, ab, ldab, w, z,
- ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbev_work.c b/netlib/LAPACKE/lapacke_dsbev_work.c
deleted file mode 100644
index 2856486..0000000
--- a/netlib/LAPACKE/lapacke_dsbev_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* w, double* z,
- lapack_int ldz, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbev( &jobz, &uplo, &n, &kd, ab, &ldab, w, z, &ldz, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldz_t = MAX(1,n);
- double* ab_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsbev_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsbev_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbev( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbevd.c b/netlib/LAPACKE/lapacke_dsbevd.c
deleted file mode 100644
index 3583f7f..0000000
--- a/netlib/LAPACKE/lapacke_dsbevd.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab,
- double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsbevd_work( matrix_order, jobz, uplo, n, kd, ab, ldab, w, z,
- ldz, &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbevd_work( matrix_order, jobz, uplo, n, kd, ab, ldab, w, z,
- ldz, work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbevd_work.c b/netlib/LAPACKE/lapacke_dsbevd_work.c
deleted file mode 100644
index afc1f92..0000000
--- a/netlib/LAPACKE/lapacke_dsbevd_work.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbevd( &jobz, &uplo, &n, &kd, ab, &ldab, w, z, &ldz, work,
- &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldz_t = MAX(1,n);
- double* ab_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsbevd_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsbevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dsbevd( &jobz, &uplo, &n, &kd, ab, &ldab_t, w, z, &ldz_t,
- work, &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbevx.c b/netlib/LAPACKE/lapacke_dsbevx.c
deleted file mode 100644
index 5924150..0000000
--- a/netlib/LAPACKE/lapacke_dsbevx.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* q, lapack_int ldq,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,7*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbevx_work( matrix_order, jobz, range, uplo, n, kd, ab,
- ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z,
- ldz, work, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbevx_work.c b/netlib/LAPACKE/lapacke_dsbevx_work.c
deleted file mode 100644
index b3e038c..0000000
--- a/netlib/LAPACKE/lapacke_dsbevx_work.c
+++ /dev/null
@@ -1,139 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- double* ab, lapack_int ldab, double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbevx( &jobz, &range, &uplo, &n, &kd, ab, &ldab, q, &ldq, &vl,
- &vu, &il, &iu, &abstol, m, w, z, &ldz, work, iwork,
- ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* ab_t = NULL;
- double* q_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsbevx_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsbevx_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dsbevx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t,
- &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t,
- work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgst.c b/netlib/LAPACKE/lapacke_dsbgst.c
deleted file mode 100644
index 8d21dd7..0000000
--- a/netlib/LAPACKE/lapacke_dsbgst.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, const double* bb, lapack_int ldbb,
- double* x, lapack_int ldx )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgst", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbgst_work( matrix_order, vect, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, x, ldx, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgst", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgst_work.c b/netlib/LAPACKE/lapacke_dsbgst_work.c
deleted file mode 100644
index 5aabf4f..0000000
--- a/netlib/LAPACKE/lapacke_dsbgst_work.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, const double* bb,
- lapack_int ldbb, double* x, lapack_int ldx,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgst( &vect, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, x,
- &ldx, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldx_t = MAX(1,n);
- double* ab_t = NULL;
- double* bb_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsbgst_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsbgst_work", info );
- return info;
- }
- if( ldx < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dsbgst_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (double*)LAPACKE_malloc( sizeof(double) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( vect, 'v' ) ) {
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,n) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_dsb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
- x_t, &ldx_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_free( x_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgst_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbgst_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgv.c b/netlib/LAPACKE/lapacke_dsbgv.c
deleted file mode 100644
index 57029b4..0000000
--- a/netlib/LAPACKE/lapacke_dsbgv.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, double* bb, lapack_int ldbb,
- double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbgv_work( matrix_order, jobz, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, w, z, ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgv_work.c b/netlib/LAPACKE/lapacke_dsbgv_work.c
deleted file mode 100644
index 549818b..0000000
--- a/netlib/LAPACKE/lapacke_dsbgv_work.c
+++ /dev/null
@@ -1,125 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* w, double* z,
- lapack_int ldz, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgv( &jobz, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, w, z,
- &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldz_t = MAX(1,n);
- double* ab_t = NULL;
- double* bb_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsbgv_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsbgv_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dsbgv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (double*)LAPACKE_malloc( sizeof(double) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_dsb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgv( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
- w, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbgv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgvd.c b/netlib/LAPACKE/lapacke_dsbgvd.c
deleted file mode 100644
index 843a9e3..0000000
--- a/netlib/LAPACKE/lapacke_dsbgvd.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, double* bb, lapack_int ldbb,
- double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsbgvd_work( matrix_order, jobz, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, w, z, ldz, &work_query, lwork,
- &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbgvd_work( matrix_order, jobz, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, w, z, ldz, work, lwork, iwork,
- liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgvd_work.c b/netlib/LAPACKE/lapacke_dsbgvd_work.c
deleted file mode 100644
index acfe842..0000000
--- a/netlib/LAPACKE/lapacke_dsbgvd_work.c
+++ /dev/null
@@ -1,132 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgvd( &jobz, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, w, z,
- &ldz, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldz_t = MAX(1,n);
- double* ab_t = NULL;
- double* bb_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dsbgvd( &jobz, &uplo, &n, &ka, &kb, ab, &ldab_t, bb, &ldbb_t,
- w, z, &ldz_t, work, &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (double*)LAPACKE_malloc( sizeof(double) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_dsb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgvd( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
- w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgvx.c b/netlib/LAPACKE/lapacke_dsbgvx.c
deleted file mode 100644
index 5fc5cd9..0000000
--- a/netlib/LAPACKE/lapacke_dsbgvx.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* q, lapack_int ldq,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -18;
- }
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -14;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -15;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,7*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbgvx_work( matrix_order, jobz, range, uplo, n, ka, kb, ab,
- ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol,
- m, w, z, ldz, work, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbgvx_work.c b/netlib/LAPACKE/lapacke_dsbgvx_work.c
deleted file mode 100644
index 2716c62..0000000
--- a/netlib/LAPACKE/lapacke_dsbgvx_work.c
+++ /dev/null
@@ -1,152 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, double* ab, lapack_int ldab,
- double* bb, lapack_int ldbb, double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb,
- q, &ldq, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz,
- work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* ab_t = NULL;
- double* bb_t = NULL;
- double* q_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -22;
- LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (double*)LAPACKE_malloc( sizeof(double) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_dsb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t,
- &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w,
- z_t, &ldz_t, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbtrd.c b/netlib/LAPACKE/lapacke_dsbtrd.c
deleted file mode 100644
index f7e76b6..0000000
--- a/netlib/LAPACKE/lapacke_dsbtrd.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsbtrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsbtrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsbtrd_work( matrix_order, vect, uplo, n, kd, ab, ldab, d, e,
- q, ldq, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbtrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsbtrd_work.c b/netlib/LAPACKE/lapacke_dsbtrd_work.c
deleted file mode 100644
index 2ae1ae2..0000000
--- a/netlib/LAPACKE/lapacke_dsbtrd_work.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsbtrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* d, double* e,
- double* q, lapack_int ldq, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsbtrd( &vect, &uplo, &n, &kd, ab, &ldab, d, e, q, &ldq, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldq_t = MAX(1,n);
- double* ab_t = NULL;
- double* q_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dsbtrd( &vect, &uplo, &n, &kd, ab_t, &ldab_t, d, e, q_t, &ldq_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsfrk.c b/netlib/LAPACKE/lapacke_dsfrk.c
deleted file mode 100644
index 3b4092f..0000000
--- a/netlib/LAPACKE/lapacke_dsfrk.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsfrk
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, double alpha,
- const double* a, lapack_int lda, double beta,
- double* c )
-{
- lapack_int ka, na;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsfrk", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- if( LAPACKE_dge_nancheck( matrix_order, na, ka, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_dpf_nancheck( n, c ) ) {
- return -11;
- }
-#endif
- return LAPACKE_dsfrk_work( matrix_order, transr, uplo, trans, n, k, alpha,
- a, lda, beta, c );
-}
diff --git a/netlib/LAPACKE/lapacke_dsfrk_work.c b/netlib/LAPACKE/lapacke_dsfrk_work.c
deleted file mode 100644
index 6f44de0..0000000
--- a/netlib/LAPACKE/lapacke_dsfrk_work.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsfrk
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- double alpha, const double* a, lapack_int lda,
- double beta, double* c )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsfrk( &transr, &uplo, &trans, &n, &k, &alpha, a, &lda, &beta,
- c );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- lapack_int ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- lapack_int lda_t = MAX(1,na);
- double* a_t = NULL;
- double* c_t = NULL;
- /* Check leading dimension(s) */
- if( lda < ka ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsfrk_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,ka) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, na, ka, a, lda, a_t, lda_t );
- LAPACKE_dpf_trans( matrix_order, transr, uplo, n, c, c_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t,
- &beta, c_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsfrk_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsfrk_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsgesv.c b/netlib/LAPACKE/lapacke_dsgesv.c
deleted file mode 100644
index 78888e1..0000000
--- a/netlib/LAPACKE/lapacke_dsgesv.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- lapack_int* iter )
-{
- lapack_int info = 0;
- float* swork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsgesv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- swork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) * MAX(1,n+nrhs) );
- if( swork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) * MAX(1,nrhs) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsgesv_work( matrix_order, n, nrhs, a, lda, ipiv, b, ldb, x,
- ldx, work, swork, iter );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( swork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsgesv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsgesv_work.c b/netlib/LAPACKE/lapacke_dsgesv_work.c
deleted file mode 100644
index a2cc959..0000000
--- a/netlib/LAPACKE/lapacke_dsgesv_work.c
+++ /dev/null
@@ -1,117 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* work, float* swork,
- lapack_int* iter )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsgesv( &n, &nrhs, a, &lda, ipiv, b, &ldb, x, &ldx, work, swork,
- iter, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsgesv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsgesv_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsgesv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsgesv( &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, x_t, &ldx_t,
- work, swork, iter, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsgesv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsgesv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsp_nancheck.c b/netlib/LAPACKE/lapacke_dsp_nancheck.c
deleted file mode 100644
index 4abd8c0..0000000
--- a/netlib/LAPACKE/lapacke_dsp_nancheck.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo or matrix_order.
- */
-
-lapack_logical LAPACKE_dsp_nancheck( lapack_int n,
- const double *ap )
-{
- lapack_int len = n*(n+1)/2;
- return LAPACKE_d_nancheck( len, ap, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_dsp_trans.c b/netlib/LAPACKE/lapacke_dsp_trans.c
deleted file mode 100644
index a0b7965..0000000
--- a/netlib/LAPACKE/lapacke_dsp_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric packed matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dsp_trans( int matrix_order, char uplo, lapack_int n,
- const double *in,
- double *out )
-{
- LAPACKE_dtp_trans( matrix_order, uplo, 'n', n, in, out );
-}
diff --git a/netlib/LAPACKE/lapacke_dspcon.c b/netlib/LAPACKE/lapacke_dspcon.c
deleted file mode 100644
index 4104869..0000000
--- a/netlib/LAPACKE/lapacke_dspcon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspcon( int matrix_order, char uplo, lapack_int n,
- const double* ap, const lapack_int* ipiv,
- double anorm, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspcon_work( matrix_order, uplo, n, ap, ipiv, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspcon_work.c b/netlib/LAPACKE/lapacke_dspcon_work.c
deleted file mode 100644
index 8973c1e..0000000
--- a/netlib/LAPACKE/lapacke_dspcon_work.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspcon_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspcon( &uplo, &n, ap, ipiv, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspev.c b/netlib/LAPACKE/lapacke_dspev.c
deleted file mode 100644
index 6c604cc..0000000
--- a/netlib/LAPACKE/lapacke_dspev.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspev( int matrix_order, char jobz, char uplo, lapack_int n,
- double* ap, double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspev_work( matrix_order, jobz, uplo, n, ap, w, z, ldz,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspev_work.c b/netlib/LAPACKE/lapacke_dspev_work.c
deleted file mode 100644
index e8d840c..0000000
--- a/netlib/LAPACKE/lapacke_dspev_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* ap, double* w, double* z,
- lapack_int ldz, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspev( &jobz, &uplo, &n, ap, w, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dspev_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspev( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspevd.c b/netlib/LAPACKE/lapacke_dspevd.c
deleted file mode 100644
index 23eda54..0000000
--- a/netlib/LAPACKE/lapacke_dspevd.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspevd( int matrix_order, char jobz, char uplo, lapack_int n,
- double* ap, double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dspevd_work( matrix_order, jobz, uplo, n, ap, w, z, ldz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspevd_work( matrix_order, jobz, uplo, n, ap, w, z, ldz,
- work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspevd_work.c b/netlib/LAPACKE/lapacke_dspevd_work.c
deleted file mode 100644
index b84c63d..0000000
--- a/netlib/LAPACKE/lapacke_dspevd_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* ap, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspevd( &jobz, &uplo, &n, ap, w, z, &ldz, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dspevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dspevd( &jobz, &uplo, &n, ap, w, z, &ldz_t, work, &lwork,
- iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork,
- iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspevx.c b/netlib/LAPACKE/lapacke_dspevx.c
deleted file mode 100644
index 3dbc02b..0000000
--- a/netlib/LAPACKE/lapacke_dspevx.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* ap, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,8*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspevx_work( matrix_order, jobz, range, uplo, n, ap, vl, vu,
- il, iu, abstol, m, w, z, ldz, work, iwork,
- ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspevx_work.c b/netlib/LAPACKE/lapacke_dspevx_work.c
deleted file mode 100644
index e7e241f..0000000
--- a/netlib/LAPACKE/lapacke_dspevx_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* ap, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, double* work,
- lapack_int* iwork, lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspevx( &jobz, &range, &uplo, &n, ap, &vl, &vu, &il, &iu,
- &abstol, m, w, z, &ldz, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dspevx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspevx( &jobz, &range, &uplo, &n, ap_t, &vl, &vu, &il, &iu,
- &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgst.c b/netlib/LAPACKE/lapacke_dspgst.c
deleted file mode 100644
index 609d5d7..0000000
--- a/netlib/LAPACKE/lapacke_dspgst.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* ap, const double* bp )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspgst", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dspgst_work( matrix_order, itype, uplo, n, ap, bp );
-}
diff --git a/netlib/LAPACKE/lapacke_dspgst_work.c b/netlib/LAPACKE/lapacke_dspgst_work.c
deleted file mode 100644
index 65a2511..0000000
--- a/netlib/LAPACKE/lapacke_dspgst_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* ap, const double* bp )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspgst( &itype, &uplo, &n, ap, bp, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- double* bp_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspgst( &itype, &uplo, &n, ap_t, bp_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_1:
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgst_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspgst_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgv.c b/netlib/LAPACKE/lapacke_dspgv.c
deleted file mode 100644
index 3d09383..0000000
--- a/netlib/LAPACKE/lapacke_dspgv.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspgv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspgv_work( matrix_order, itype, jobz, uplo, n, ap, bp, w, z,
- ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgv_work.c b/netlib/LAPACKE/lapacke_dspgv_work.c
deleted file mode 100644
index 3c0fc31..0000000
--- a/netlib/LAPACKE/lapacke_dspgv_work.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspgv( &itype, &jobz, &uplo, &n, ap, bp, w, z, &ldz, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- double* ap_t = NULL;
- double* bp_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dspgv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- bp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspgv( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_2:
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspgv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgvd.c b/netlib/LAPACKE/lapacke_dspgvd.c
deleted file mode 100644
index 836e82c..0000000
--- a/netlib/LAPACKE/lapacke_dspgvd.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspgvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dspgvd_work( matrix_order, itype, jobz, uplo, n, ap, bp, w,
- z, ldz, &work_query, lwork, &iwork_query,
- liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspgvd_work( matrix_order, itype, jobz, uplo, n, ap, bp, w,
- z, ldz, work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgvd_work.c b/netlib/LAPACKE/lapacke_dspgvd_work.c
deleted file mode 100644
index 1cbcd23..0000000
--- a/netlib/LAPACKE/lapacke_dspgvd_work.c
+++ /dev/null
@@ -1,119 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspgvd( &itype, &jobz, &uplo, &n, ap, bp, w, z, &ldz, work,
- &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- double* ap_t = NULL;
- double* bp_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dspgvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dspgvd( &itype, &jobz, &uplo, &n, ap, bp, w, z, &ldz_t, work,
- &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- bp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspgvd( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_2:
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspgvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgvx.c b/netlib/LAPACKE/lapacke_dspgvx.c
deleted file mode 100644
index 8d1eb38..0000000
--- a/netlib/LAPACKE/lapacke_dspgvx.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* ap,
- double* bp, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspgvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -13;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -7;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -8;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -9;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,8*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspgvx_work( matrix_order, itype, jobz, range, uplo, n, ap,
- bp, vl, vu, il, iu, abstol, m, w, z, ldz, work,
- iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspgvx_work.c b/netlib/LAPACKE/lapacke_dspgvx_work.c
deleted file mode 100644
index e913574..0000000
--- a/netlib/LAPACKE/lapacke_dspgvx_work.c
+++ /dev/null
@@ -1,121 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* ap,
- double* bp, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspgvx( &itype, &jobz, &range, &uplo, &n, ap, bp, &vl, &vu, &il,
- &iu, &abstol, m, w, z, &ldz, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- double* ap_t = NULL;
- double* bp_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dspgvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- bp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu,
- &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_2:
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspgvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspgvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsposv.c b/netlib/LAPACKE/lapacke_dsposv.c
deleted file mode 100644
index 082806e..0000000
--- a/netlib/LAPACKE/lapacke_dsposv.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsposv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- lapack_int* iter )
-{
- lapack_int info = 0;
- float* swork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsposv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- swork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) * MAX(1,n+nrhs) );
- if( swork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) * MAX(1,nrhs) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsposv_work( matrix_order, uplo, n, nrhs, a, lda, b, ldb, x,
- ldx, work, swork, iter );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( swork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsposv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsposv_work.c b/netlib/LAPACKE/lapacke_dsposv_work.c
deleted file mode 100644
index 8592135..0000000
--- a/netlib/LAPACKE/lapacke_dsposv_work.c
+++ /dev/null
@@ -1,117 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsposv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* work, float* swork,
- lapack_int* iter )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsposv( &uplo, &n, &nrhs, a, &lda, b, &ldb, x, &ldx, work, swork,
- iter, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsposv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsposv_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsposv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dpo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t,
- work, swork, iter, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsposv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsposv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsprfs.c b/netlib/LAPACKE/lapacke_dsprfs.c
deleted file mode 100644
index 4421dba..0000000
--- a/netlib/LAPACKE/lapacke_dsprfs.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, const double* afp,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsprfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsprfs_work( matrix_order, uplo, n, nrhs, ap, afp, ipiv, b,
- ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsprfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsprfs_work.c b/netlib/LAPACKE/lapacke_dsprfs_work.c
deleted file mode 100644
index 45e8bac..0000000
--- a/netlib/LAPACKE/lapacke_dsprfs_work.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const double* afp, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsprfs( &uplo, &n, &nrhs, ap, afp, ipiv, b, &ldb, x, &ldx, ferr,
- berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- double* ap_t = NULL;
- double* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsprfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dsprfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, afp, afp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t,
- &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsprfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsprfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspsv.c b/netlib/LAPACKE/lapacke_dspsv.c
deleted file mode 100644
index e4d432b..0000000
--- a/netlib/LAPACKE/lapacke_dspsv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dspsv_work( matrix_order, uplo, n, nrhs, ap, ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dspsv_work.c b/netlib/LAPACKE/lapacke_dspsv_work.c
deleted file mode 100644
index 5a4a40e..0000000
--- a/netlib/LAPACKE/lapacke_dspsv_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspsv( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dspsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dspsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspsvx.c b/netlib/LAPACKE/lapacke_dspsvx.c
deleted file mode 100644
index 0cb51db..0000000
--- a/netlib/LAPACKE/lapacke_dspsvx.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dspsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* afp,
- lapack_int* ipiv, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dspsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dsp_nancheck( n, afp ) ) {
- return -7;
- }
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dspsvx_work( matrix_order, fact, uplo, n, nrhs, ap, afp,
- ipiv, b, ldb, x, ldx, rcond, ferr, berr, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dspsvx_work.c b/netlib/LAPACKE/lapacke_dspsvx_work.c
deleted file mode 100644
index 3969b2b..0000000
--- a/netlib/LAPACKE/lapacke_dspsvx_work.c
+++ /dev/null
@@ -1,126 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dspsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const double* ap,
- double* afp, lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dspsvx( &fact, &uplo, &n, &nrhs, ap, afp, ipiv, b, &ldb, x, &ldx,
- rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- double* ap_t = NULL;
- double* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dspsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dspsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dsp_trans( matrix_order, uplo, n, afp, afp_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dspsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t,
- x_t, &ldx_t, rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- if( LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp );
- }
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dspsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dspsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsptrd.c b/netlib/LAPACKE/lapacke_dsptrd.c
deleted file mode 100644
index 1e21821..0000000
--- a/netlib/LAPACKE/lapacke_dsptrd.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsptrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptrd( int matrix_order, char uplo, lapack_int n,
- double* ap, double* d, double* e, double* tau )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsptrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dsptrd_work( matrix_order, uplo, n, ap, d, e, tau );
-}
diff --git a/netlib/LAPACKE/lapacke_dsptrd_work.c b/netlib/LAPACKE/lapacke_dsptrd_work.c
deleted file mode 100644
index 0a99504..0000000
--- a/netlib/LAPACKE/lapacke_dsptrd_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsptrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptrd_work( int matrix_order, char uplo, lapack_int n,
- double* ap, double* d, double* e, double* tau )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsptrd( &uplo, &n, ap, d, e, tau, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsptrd( &uplo, &n, ap_t, d, e, tau, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsptrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsptrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsptrf.c b/netlib/LAPACKE/lapacke_dsptrf.c
deleted file mode 100644
index c8f9e6f..0000000
--- a/netlib/LAPACKE/lapacke_dsptrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptrf( int matrix_order, char uplo, lapack_int n,
- double* ap, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsptrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dsptrf_work( matrix_order, uplo, n, ap, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_dsptrf_work.c b/netlib/LAPACKE/lapacke_dsptrf_work.c
deleted file mode 100644
index 62e6098..0000000
--- a/netlib/LAPACKE/lapacke_dsptrf_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptrf_work( int matrix_order, char uplo, lapack_int n,
- double* ap, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsptrf( &uplo, &n, ap, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsptrf( &uplo, &n, ap_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsptrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsptrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsptri.c b/netlib/LAPACKE/lapacke_dsptri.c
deleted file mode 100644
index 242d753..0000000
--- a/netlib/LAPACKE/lapacke_dsptri.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptri( int matrix_order, char uplo, lapack_int n,
- double* ap, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsptri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsptri_work( matrix_order, uplo, n, ap, ipiv, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsptri", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsptri_work.c b/netlib/LAPACKE/lapacke_dsptri_work.c
deleted file mode 100644
index d6bd097..0000000
--- a/netlib/LAPACKE/lapacke_dsptri_work.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptri_work( int matrix_order, char uplo, lapack_int n,
- double* ap, const lapack_int* ipiv,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsptri( &uplo, &n, ap, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsptri( &uplo, &n, ap_t, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsptri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsptri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsptrs.c b/netlib/LAPACKE/lapacke_dsptrs.c
deleted file mode 100644
index 03fd8b8..0000000
--- a/netlib/LAPACKE/lapacke_dsptrs.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const lapack_int* ipiv, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsptrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dsptrs_work( matrix_order, uplo, n, nrhs, ap, ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dsptrs_work.c b/netlib/LAPACKE/lapacke_dsptrs_work.c
deleted file mode 100644
index 5937f7d..0000000
--- a/netlib/LAPACKE/lapacke_dsptrs_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const lapack_int* ipiv, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsptrs( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsptrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dsp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsptrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsptrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dst_nancheck.c b/netlib/LAPACKE/lapacke_dst_nancheck.c
deleted file mode 100644
index 7a6a33f..0000000
--- a/netlib/LAPACKE/lapacke_dst_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dst_nancheck( lapack_int n,
- const double *d,
- const double *e )
-{
- return LAPACKE_d_nancheck( n, d, 1 )
- || LAPACKE_d_nancheck( n-1, e, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_dstebz.c b/netlib/LAPACKE/lapacke_dstebz.c
deleted file mode 100644
index fb1646c..0000000
--- a/netlib/LAPACKE/lapacke_dstebz.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstebz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, const double* d, const double* e,
- lapack_int* m, lapack_int* nsplit, double* w,
- lapack_int* iblock, lapack_int* isplit )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -4;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -5;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,3*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstebz_work( range, order, n, vl, vu, il, iu, abstol, d, e,
- m, nsplit, w, iblock, isplit, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstebz", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstebz_work.c b/netlib/LAPACKE/lapacke_dstebz_work.c
deleted file mode 100644
index 12e16c6..0000000
--- a/netlib/LAPACKE/lapacke_dstebz_work.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstebz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstebz_work( char range, char order, lapack_int n, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, const double* d, const double* e,
- lapack_int* m, lapack_int* nsplit, double* w,
- lapack_int* iblock, lapack_int* isplit,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dstebz( &range, &order, &n, &vl, &vu, &il, &iu, &abstol, d, e, m,
- nsplit, w, iblock, isplit, work, iwork, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstedc.c b/netlib/LAPACKE/lapacke_dstedc.c
deleted file mode 100644
index b385015..0000000
--- a/netlib/LAPACKE/lapacke_dstedc.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstedc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstedc( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstedc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -6;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dstedc_work( matrix_order, compz, n, d, e, z, ldz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstedc_work( matrix_order, compz, n, d, e, z, ldz, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstedc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstedc_work.c b/netlib/LAPACKE/lapacke_dstedc_work.c
deleted file mode 100644
index b6f528a..0000000
--- a/netlib/LAPACKE/lapacke_dstedc_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstedc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstedc_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstedc( &compz, &n, d, e, z, &ldz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dstedc_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dstedc( &compz, &n, d, e, z, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstedc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstedc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstegr.c b/netlib/LAPACKE/lapacke_dstegr.c
deleted file mode 100644
index aefa71e..0000000
--- a/netlib/LAPACKE/lapacke_dstegr.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstegr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstegr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstegr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dstegr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, &work_query,
- lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstegr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, work, lwork,
- iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstegr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstegr_work.c b/netlib/LAPACKE/lapacke_dstegr_work.c
deleted file mode 100644
index 0bec653..0000000
--- a/netlib/LAPACKE/lapacke_dstegr_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstegr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstegr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z, &ldz, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < *m ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dstegr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dstegr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol,
- m, w, z, &ldz_t, isuppz, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- /* Let be always 'n' instead of 'm' */
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstegr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z_t, &ldz_t, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstegr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstegr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstein.c b/netlib/LAPACKE/lapacke_dstein.c
deleted file mode 100644
index 9cbabc1..0000000
--- a/netlib/LAPACKE/lapacke_dstein.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstein( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock, const lapack_int* isplit,
- double* z, lapack_int ldz, lapack_int* ifailv )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstein", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, w, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,5*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstein_work( matrix_order, n, d, e, m, w, iblock, isplit, z,
- ldz, work, iwork, ifailv );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstein", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstein_work.c b/netlib/LAPACKE/lapacke_dstein_work.c
deleted file mode 100644
index b80d15f..0000000
--- a/netlib/LAPACKE/lapacke_dstein_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstein_work( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock,
- const lapack_int* isplit, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifailv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstein( &n, d, e, &m, w, iblock, isplit, z, &ldz, work, iwork,
- ifailv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < m ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dstein_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,m) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstein( &n, d, e, &m, w, iblock, isplit, z_t, &ldz_t, work,
- iwork, ifailv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz );
- /* Release memory and exit */
- LAPACKE_free( z_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstein_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstein_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstemr.c b/netlib/LAPACKE/lapacke_dstemr.c
deleted file mode 100644
index 0ccf623..0000000
--- a/netlib/LAPACKE/lapacke_dstemr.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstemr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstemr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, double* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstemr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dstemr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, m, w, z, ldz, nzc, isuppz, tryrac,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstemr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, m, w, z, ldz, nzc, isuppz, tryrac, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstemr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstemr_work.c b/netlib/LAPACKE/lapacke_dstemr_work.c
deleted file mode 100644
index 794807c..0000000
--- a/netlib/LAPACKE/lapacke_dstemr_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstemr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z,
- &ldz, &nzc, isuppz, tryrac, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dstemr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z,
- &ldz_t, &nzc, isuppz, tryrac, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z_t,
- &ldz_t, &nzc, isuppz, tryrac, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstemr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstemr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsteqr.c b/netlib/LAPACKE/lapacke_dsteqr.c
deleted file mode 100644
index 2a53c47..0000000
--- a/netlib/LAPACKE/lapacke_dsteqr.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsteqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -6;
- }
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( compz, 'n' ) ) {
- lwork = 1;
- } else {
- lwork = MAX(1,2*n-2);
- }
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsteqr_work( matrix_order, compz, n, d, e, z, ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsteqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsteqr_work.c b/netlib/LAPACKE/lapacke_dsteqr_work.c
deleted file mode 100644
index 02e1d3b..0000000
--- a/netlib/LAPACKE/lapacke_dsteqr_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsteqr( &compz, &n, d, e, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsteqr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dsteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsteqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsteqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsterf.c b/netlib/LAPACKE/lapacke_dsterf.c
deleted file mode 100644
index 29f46cf..0000000
--- a/netlib/LAPACKE/lapacke_dsterf.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsterf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsterf( lapack_int n, double* d, double* e )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_dsterf_work( n, d, e );
-}
diff --git a/netlib/LAPACKE/lapacke_dsterf_work.c b/netlib/LAPACKE/lapacke_dsterf_work.c
deleted file mode 100644
index b405fbb..0000000
--- a/netlib/LAPACKE/lapacke_dsterf_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsterf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsterf_work( lapack_int n, double* d, double* e )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_dsterf( &n, d, e, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstev.c b/netlib/LAPACKE/lapacke_dstev.c
deleted file mode 100644
index 3c4f76b..0000000
--- a/netlib/LAPACKE/lapacke_dstev.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstev( int matrix_order, char jobz, lapack_int n, double* d,
- double* e, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n-2) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- info = LAPACKE_dstev_work( matrix_order, jobz, n, d, e, z, ldz, work );
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstev_work.c b/netlib/LAPACKE/lapacke_dstev_work.c
deleted file mode 100644
index 889ee9a..0000000
--- a/netlib/LAPACKE/lapacke_dstev_work.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstev_work( int matrix_order, char jobz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstev( &jobz, &n, d, e, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dstev_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstev( &jobz, &n, d, e, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstevd.c b/netlib/LAPACKE/lapacke_dstevd.c
deleted file mode 100644
index 74193d9..0000000
--- a/netlib/LAPACKE/lapacke_dstevd.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstevd( int matrix_order, char jobz, lapack_int n, double* d,
- double* e, double* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dstevd_work( matrix_order, jobz, n, d, e, z, ldz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstevd_work( matrix_order, jobz, n, d, e, z, ldz, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstevd_work.c b/netlib/LAPACKE/lapacke_dstevd_work.c
deleted file mode 100644
index c154e0b..0000000
--- a/netlib/LAPACKE/lapacke_dstevd_work.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstevd_work( int matrix_order, char jobz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstevd( &jobz, &n, d, e, z, &ldz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dstevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dstevd( &jobz, &n, d, e, z, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstevd( &jobz, &n, d, e, z_t, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstevr.c b/netlib/LAPACKE/lapacke_dstevr.c
deleted file mode 100644
index 40e8553..0000000
--- a/netlib/LAPACKE/lapacke_dstevr.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstevr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstevr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dstevr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, &work_query,
- lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstevr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, work, lwork,
- iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstevr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstevr_work.c b/netlib/LAPACKE/lapacke_dstevr_work.c
deleted file mode 100644
index 1061a7a..0000000
--- a/netlib/LAPACKE/lapacke_dstevr_work.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstevr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z, &ldz, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dstevr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol,
- m, w, z, &ldz_t, isuppz, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z_t, &ldz_t, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstevr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstevr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstevx.c b/netlib/LAPACKE/lapacke_dstevx.c
deleted file mode 100644
index 08eebef..0000000
--- a/netlib/LAPACKE/lapacke_dstevx.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dstevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstevx( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dstevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,5*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dstevx_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, work, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dstevx_work.c b/netlib/LAPACKE/lapacke_dstevx_work.c
deleted file mode 100644
index 513be20..0000000
--- a/netlib/LAPACKE/lapacke_dstevx_work.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dstevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dstevx_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, double* work,
- lapack_int* iwork, lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dstevx( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z, &ldz, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dstevx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dstevx( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z_t, &ldz_t, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dstevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dstevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsy_nancheck.c b/netlib/LAPACKE/lapacke_dsy_nancheck.c
deleted file mode 100644
index 6d0e052..0000000
--- a/netlib/LAPACKE/lapacke_dsy_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dsy_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const double *a,
- lapack_int lda )
-{
- return LAPACKE_dtr_nancheck( matrix_order, uplo, 'n', n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dsy_trans.c b/netlib/LAPACKE/lapacke_dsy_trans.c
deleted file mode 100644
index f651088..0000000
--- a/netlib/LAPACKE/lapacke_dsy_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dsy_trans( int matrix_order, char uplo, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- LAPACKE_dtr_trans( matrix_order, uplo, 'n', n, in, ldin, out, ldout );
-}
diff --git a/netlib/LAPACKE/lapacke_dsycon.c b/netlib/LAPACKE/lapacke_dsycon.c
deleted file mode 100644
index 46c0798..0000000
--- a/netlib/LAPACKE/lapacke_dsycon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsycon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsycon( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsycon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsycon_work( matrix_order, uplo, n, a, lda, ipiv, anorm,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsycon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsycon_work.c b/netlib/LAPACKE/lapacke_dsycon_work.c
deleted file mode 100644
index 2d9e229..0000000
--- a/netlib/LAPACKE/lapacke_dsycon_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsycon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsycon_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsycon( &uplo, &n, a, &lda, ipiv, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsycon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsycon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsycon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsycon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyconv.c b/netlib/LAPACKE/lapacke_dsyconv.c
deleted file mode 100644
index 885ba46..0000000
--- a/netlib/LAPACKE/lapacke_dsyconv.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyconv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyconv( int matrix_order, char uplo, char way, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyconv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, lda, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyconv_work( matrix_order, uplo, way, n, a, lda, ipiv,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyconv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyconv_work.c b/netlib/LAPACKE/lapacke_dsyconv_work.c
deleted file mode 100644
index c06fc99..0000000
--- a/netlib/LAPACKE/lapacke_dsyconv_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyconv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, double* a, lapack_int lda,
- const lapack_int* ipiv, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,lda);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsyconv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, lda, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyconv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyconv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyequb.c b/netlib/LAPACKE/lapacke_dsyequb.c
deleted file mode 100644
index f9ee692..0000000
--- a/netlib/LAPACKE/lapacke_dsyequb.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyequb( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyequb_work( matrix_order, uplo, n, a, lda, s, scond, amax,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyequb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyequb_work.c b/netlib/LAPACKE/lapacke_dsyequb_work.c
deleted file mode 100644
index d74e780..0000000
--- a/netlib/LAPACKE/lapacke_dsyequb_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyequb_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyequb( &uplo, &n, a, &lda, s, scond, amax, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsyequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyev.c b/netlib/LAPACKE/lapacke_dsyev.c
deleted file mode 100644
index 4aaec30..0000000
--- a/netlib/LAPACKE/lapacke_dsyev.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyev( int matrix_order, char jobz, char uplo, lapack_int n,
- double* a, lapack_int lda, double* w )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsyev_work( matrix_order, jobz, uplo, n, a, lda, w,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyev_work( matrix_order, jobz, uplo, n, a, lda, w, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyev_work.c b/netlib/LAPACKE/lapacke_dsyev_work.c
deleted file mode 100644
index f0cc266..0000000
--- a/netlib/LAPACKE/lapacke_dsyev_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* a, lapack_int lda,
- double* w, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyev( &jobz, &uplo, &n, a, &lda, w, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsyev_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsyev( &jobz, &uplo, &n, a, &lda_t, w, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyevd.c b/netlib/LAPACKE/lapacke_dsyevd.c
deleted file mode 100644
index 23e3b50..0000000
--- a/netlib/LAPACKE/lapacke_dsyevd.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyevd( int matrix_order, char jobz, char uplo, lapack_int n,
- double* a, lapack_int lda, double* w )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsyevd_work( matrix_order, jobz, uplo, n, a, lda, w,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyevd_work( matrix_order, jobz, uplo, n, a, lda, w, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyevd_work.c b/netlib/LAPACKE/lapacke_dsyevd_work.c
deleted file mode 100644
index 23b4ef1..0000000
--- a/netlib/LAPACKE/lapacke_dsyevd_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* a, lapack_int lda,
- double* w, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyevd( &jobz, &uplo, &n, a, &lda, w, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsyevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dsyevd( &jobz, &uplo, &n, a, &lda_t, w, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyevr.c b/netlib/LAPACKE/lapacke_dsyevr.c
deleted file mode 100644
index 5a1af91..0000000
--- a/netlib/LAPACKE/lapacke_dsyevr.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* a, lapack_int lda, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsyevr_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, isuppz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyevr_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, isuppz, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyevr_work.c b/netlib/LAPACKE/lapacke_dsyevr_work.c
deleted file mode 100644
index 3d99391..0000000
--- a/netlib/LAPACKE/lapacke_dsyevr_work.c
+++ /dev/null
@@ -1,124 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyevr( &jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il, &iu,
- &abstol, m, w, z, &ldz, isuppz, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int lda_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* a_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsyevr_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dsyevr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dsyevr( &jobz, &range, &uplo, &n, a, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z, &ldz_t, isuppz, work, &lwork,
- iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork,
- iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyevr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyevx.c b/netlib/LAPACKE/lapacke_dsyevx.c
deleted file mode 100644
index fc8e54f..0000000
--- a/netlib/LAPACKE/lapacke_dsyevx.c
+++ /dev/null
@@ -1,103 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* a, lapack_int lda, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, &work_query,
- lwork, iwork, ifail );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, work, lwork,
- iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyevx_work.c b/netlib/LAPACKE/lapacke_dsyevx_work.c
deleted file mode 100644
index 259c9ee..0000000
--- a/netlib/LAPACKE/lapacke_dsyevx_work.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyevx( &jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il, &iu,
- &abstol, m, w, z, &ldz, work, &lwork, iwork, ifail,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int lda_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* a_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsyevx_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dsyevx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsyevx( &jobz, &range, &uplo, &n, a, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z, &ldz_t, work, &lwork, iwork,
- ifail, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyevx( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork,
- ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygst.c b/netlib/LAPACKE/lapacke_dsygst.c
deleted file mode 100644
index 892a9c8..0000000
--- a/netlib/LAPACKE/lapacke_dsygst.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsygst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* a, lapack_int lda,
- const double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsygst", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_dsygst_work( matrix_order, itype, uplo, n, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dsygst_work.c b/netlib/LAPACKE/lapacke_dsygst_work.c
deleted file mode 100644
index 0237692..0000000
--- a/netlib/LAPACKE/lapacke_dsygst_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsygst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* a, lapack_int lda,
- const double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsygst( &itype, &uplo, &n, a, &lda, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsygst_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsygst_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsygst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygst_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsygst_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygv.c b/netlib/LAPACKE/lapacke_dsygv.c
deleted file mode 100644
index dfbde79..0000000
--- a/netlib/LAPACKE/lapacke_dsygv.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsygv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* w )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsygv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsygv_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsygv_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygv_work.c b/netlib/LAPACKE/lapacke_dsygv_work.c
deleted file mode 100644
index f04753e..0000000
--- a/netlib/LAPACKE/lapacke_dsygv_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsygv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* w, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsygv( &itype, &jobz, &uplo, &n, a, &lda, b, &ldb, w, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsygv_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsygv_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsygv( &itype, &jobz, &uplo, &n, a, &lda_t, b, &ldb_t, w,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsygv( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsygv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygvd.c b/netlib/LAPACKE/lapacke_dsygvd.c
deleted file mode 100644
index b3b46bf..0000000
--- a/netlib/LAPACKE/lapacke_dsygvd.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsygvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* w )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsygvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsygvd_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, &work_query, lwork, &iwork_query,
- liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsygvd_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygvd_work.c b/netlib/LAPACKE/lapacke_dsygvd_work.c
deleted file mode 100644
index 2dd7542..0000000
--- a/netlib/LAPACKE/lapacke_dsygvd_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsygvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* w, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a, &lda, b, &ldb, w, work,
- &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsygvd_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsygvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a, &lda_t, b, &ldb_t, w,
- work, &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsygvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygvx.c b/netlib/LAPACKE/lapacke_dsygvx.c
deleted file mode 100644
index 8f88d28..0000000
--- a/netlib/LAPACKE/lapacke_dsygvx.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsygvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsygvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dsygvx_work( matrix_order, itype, jobz, range, uplo, n, a,
- lda, b, ldb, vl, vu, il, iu, abstol, m, w, z,
- ldz, &work_query, lwork, iwork, ifail );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsygvx_work( matrix_order, itype, jobz, range, uplo, n, a,
- lda, b, ldb, vl, vu, il, iu, abstol, m, w, z,
- ldz, work, lwork, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsygvx_work.c b/netlib/LAPACKE/lapacke_dsygvx_work.c
deleted file mode 100644
index 189ec95..0000000
--- a/netlib/LAPACKE/lapacke_dsygvx_work.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsygvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsygvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsygvx( &itype, &jobz, &range, &uplo, &n, a, &lda, b, &ldb, &vl,
- &vu, &il, &iu, &abstol, m, w, z, &ldz, work, &lwork,
- iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsygvx_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dsygvx_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dsygvx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsygvx( &itype, &jobz, &range, &uplo, &n, a, &lda_t, b,
- &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz_t,
- work, &lwork, iwork, ifail, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsygvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t,
- &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t,
- work, &lwork, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsygvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsygvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyrfs.c b/netlib/LAPACKE/lapacke_dsyrfs.c
deleted file mode 100644
index 6e1ae09..0000000
--- a/netlib/LAPACKE/lapacke_dsyrfs.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsyrfs_work( matrix_order, uplo, n, nrhs, a, lda, af, ldaf,
- ipiv, b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyrfs_work.c b/netlib/LAPACKE/lapacke_dsyrfs_work.c
deleted file mode 100644
index dff75ac..0000000
--- a/netlib/LAPACKE/lapacke_dsyrfs_work.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyrfs( &uplo, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b, &ldb, x,
- &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* af_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (double*)LAPACKE_malloc( sizeof(double) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dsy_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyrfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsysv.c b/netlib/LAPACKE/lapacke_dsysv.c
deleted file mode 100644
index e9fb172..0000000
--- a/netlib/LAPACKE/lapacke_dsysv.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsysv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- lapack_int* ipiv, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsysv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsysv_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsysv_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsysv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsysv_work.c b/netlib/LAPACKE/lapacke_dsysv_work.c
deleted file mode 100644
index c362c19..0000000
--- a/netlib/LAPACKE/lapacke_dsysv_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsysv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- lapack_int* ipiv, double* b, lapack_int ldb,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsysv( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsysv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsysv_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsysv( &uplo, &n, &nrhs, a, &lda_t, ipiv, b, &ldb_t, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsysv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsysv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsysvx.c b/netlib/LAPACKE/lapacke_dsysvx.c
deleted file mode 100644
index ef6aa9f..0000000
--- a/netlib/LAPACKE/lapacke_dsysvx.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsysvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- double* af, lapack_int ldaf, lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsysvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -8;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -11;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dsysvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af,
- ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr,
- &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsysvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af,
- ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr,
- work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsysvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsysvx_work.c b/netlib/LAPACKE/lapacke_dsysvx_work.c
deleted file mode 100644
index 7f549a6..0000000
--- a/netlib/LAPACKE/lapacke_dsysvx_work.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsysvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsysvx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b,
- &ldb, x, &ldx, rcond, ferr, berr, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* af_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dsysvx_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsysvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dsysvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dsysvx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsysvx( &fact, &uplo, &n, &nrhs, a, &lda_t, af, &ldaf_t,
- ipiv, b, &ldb_t, x, &ldx_t, rcond, ferr, berr, work,
- &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (double*)LAPACKE_malloc( sizeof(double) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_dsy_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- }
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsysvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
- ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
- ldaf );
- }
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsysvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsysvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsyswapr.c b/netlib/LAPACKE/lapacke_dsyswapr.c
deleted file mode 100644
index d2b10a9..0000000
--- a/netlib/LAPACKE/lapacke_dsyswapr.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsyswapr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyswapr( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int i1, lapack_int i2 )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsyswapr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, n ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dsyswapr_work( matrix_order, uplo, n, a, i1, i2 );
-}
diff --git a/netlib/LAPACKE/lapacke_dsyswapr_work.c b/netlib/LAPACKE/lapacke_dsyswapr_work.c
deleted file mode 100644
index 87cafc8..0000000
--- a/netlib/LAPACKE/lapacke_dsyswapr_work.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsyswapr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsyswapr_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int i1, lapack_int i2 )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsyswapr( &uplo, &n, a, &i1, &i2 );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * n * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, n, a_t, n );
- /* Call LAPACK function and adjust info */
- LAPACK_dsyswapr( &uplo, &n, a_t, &i1, &i2 );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsyswapr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsyswapr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrd.c b/netlib/LAPACKE/lapacke_dsytrd.c
deleted file mode 100644
index 238d268..0000000
--- a/netlib/LAPACKE/lapacke_dsytrd.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrd( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, double* d, double* e, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsytrd_work( matrix_order, uplo, n, a, lda, d, e, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsytrd_work( matrix_order, uplo, n, a, lda, d, e, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrd_work.c b/netlib/LAPACKE/lapacke_dsytrd_work.c
deleted file mode 100644
index a3daa3f..0000000
--- a/netlib/LAPACKE/lapacke_dsytrd_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrd_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tau, double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrd( &uplo, &n, a, &lda, d, e, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsytrd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsytrd( &uplo, &n, a, &lda_t, d, e, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrd( &uplo, &n, a_t, &lda_t, d, e, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrf.c b/netlib/LAPACKE/lapacke_dsytrf.c
deleted file mode 100644
index 08eca65..0000000
--- a/netlib/LAPACKE/lapacke_dsytrf.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, lapack_int* ipiv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsytrf_work( matrix_order, uplo, n, a, lda, ipiv,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsytrf_work( matrix_order, uplo, n, a, lda, ipiv, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrf_work.c b/netlib/LAPACKE/lapacke_dsytrf_work.c
deleted file mode 100644
index 147c3cf..0000000
--- a/netlib/LAPACKE/lapacke_dsytrf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsytrf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytri.c b/netlib/LAPACKE/lapacke_dsytri.c
deleted file mode 100644
index 21127a8..0000000
--- a/netlib/LAPACKE/lapacke_dsytri.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytri( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsytri_work( matrix_order, uplo, n, a, lda, ipiv, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytri2.c b/netlib/LAPACKE/lapacke_dsytri2.c
deleted file mode 100644
index a097ad5..0000000
--- a/netlib/LAPACKE/lapacke_dsytri2.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytri2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytri2( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_complex_double* work = NULL;
- lapack_complex_double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dsytri2_work( matrix_order, uplo, n, a, lda, ipiv,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = LAPACK_Z2INT( work_query );
- /* Allocate memory for work arrays */
- work = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsytri2_work( matrix_order, uplo, n, a, lda, ipiv, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytri2_work.c b/netlib/LAPACKE/lapacke_dsytri2_work.c
deleted file mode 100644
index 48e2689..0000000
--- a/netlib/LAPACKE/lapacke_dsytri2_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytri2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytri2_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytri2( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsytri2_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dsytri2( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytri2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytri2x.c b/netlib/LAPACKE/lapacke_dsytri2x.c
deleted file mode 100644
index 5438b78..0000000
--- a/netlib/LAPACKE/lapacke_dsytri2x.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytri2x
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytri2x( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv,
- lapack_int nb )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri2x", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n+nb+1)*(+1) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsytri2x_work( matrix_order, uplo, n, a, lda, ipiv, work,
- nb );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri2x", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytri2x_work.c b/netlib/LAPACKE/lapacke_dsytri2x_work.c
deleted file mode 100644
index 0a7bfe6..0000000
--- a/netlib/LAPACKE/lapacke_dsytri2x_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytri2x
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytri2x_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv, double* work,
- lapack_int nb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytri2x( &uplo, &n, a, &lda, ipiv, work, &nb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsytri2x_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri2x_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytri2x_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytri_work.c b/netlib/LAPACKE/lapacke_dsytri_work.c
deleted file mode 100644
index 39f257c..0000000
--- a/netlib/LAPACKE/lapacke_dsytri_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytri_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytri( &uplo, &n, a, &lda, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dsytri_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytri( &uplo, &n, a_t, &lda_t, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrs.c b/netlib/LAPACKE/lapacke_dsytrs.c
deleted file mode 100644
index 2e3c237..0000000
--- a/netlib/LAPACKE/lapacke_dsytrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_dsytrs_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrs2.c b/netlib/LAPACKE/lapacke_dsytrs2.c
deleted file mode 100644
index 3c08407..0000000
--- a/netlib/LAPACKE/lapacke_dsytrs2.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dsytrs2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrs2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dsytrs2_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrs2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrs2_work.c b/netlib/LAPACKE/lapacke_dsytrs2_work.c
deleted file mode 100644
index d74e4df..0000000
--- a/netlib/LAPACKE/lapacke_dsytrs2_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytrs2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrs2( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dsytrs_work.c b/netlib/LAPACKE/lapacke_dsytrs_work.c
deleted file mode 100644
index 25ceaf0..0000000
--- a/netlib/LAPACKE/lapacke_dsytrs_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dsytrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dsytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrs( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dsytrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dsytrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dsy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dsytrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dsytrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dsytrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtb_nancheck.c b/netlib/LAPACKE/lapacke_dtb_nancheck.c
deleted file mode 100644
index bbe4651..0000000
--- a/netlib/LAPACKE/lapacke_dtb_nancheck.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dtb_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const double* ab,
- lapack_int ldab )
-{
- lapack_logical colmaj, upper, unit;
-
- if( ab == NULL ) return (lapack_logical) 0;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
-
- if( unit ) {
- /* Unit case, diagonal should be excluded from the check for NaN. */
- if( colmaj ) {
- if( upper ) {
- return LAPACKE_dgb_nancheck( matrix_order, n-1, n-1, 0, kd-1,
- &ab[ldab], ldab );
- } else {
- return LAPACKE_dgb_nancheck( matrix_order, n-1, n-1, kd-1, 0,
- &ab[1], ldab );
- }
- } else {
- if( upper ) {
- return LAPACKE_dgb_nancheck( matrix_order, n-1, n-1, 0, kd-1,
- &ab[1], ldab );
- } else {
- return LAPACKE_dgb_nancheck( matrix_order, n-1, n-1, kd-1, 0,
- &ab[ldab], ldab );
- }
- }
- } else {
- /* Non-unit case */
- if( upper ) {
- return LAPACKE_dgb_nancheck( matrix_order, n, n, 0, kd, ab, ldab );
- } else {
- return LAPACKE_dgb_nancheck( matrix_order, n, n, kd, 0, ab, ldab );
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtb_trans.c b/netlib/LAPACKE/lapacke_dtb_trans.c
deleted file mode 100644
index ff4c845..0000000
--- a/netlib/LAPACKE/lapacke_dtb_trans.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input triangular banded matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dtb_trans( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- lapack_logical colmaj, upper, unit;
-
- if( in == NULL || out == NULL ) return;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return;
- }
-
- if( unit ) {
- /* Unit case, diagonal excluded from transposition */
- if( colmaj ) {
- if( upper ) {
- LAPACKE_dgb_trans( matrix_order, n-1, n-1, 0, kd-1,
- &in[ldin], ldin, &out[1], ldout );
- } else {
- LAPACKE_dgb_trans( matrix_order, n-1, n-1, kd-1, 0,
- &in[1], ldin, &out[ldout], ldout );
- }
- } else {
- if( upper ) {
- LAPACKE_dgb_trans( matrix_order, n-1, n-1, 0, kd-1,
- &in[1], ldin, &out[ldout], ldout );
- } else {
- LAPACKE_dgb_trans( matrix_order, n-1, n-1, kd-1, 0,
- &in[ldin], ldin, &out[1], ldout );
- }
- }
- } else {
- /* Non-unit case */
- if( upper ) {
- LAPACKE_dgb_trans( matrix_order, n, n, 0, kd, in, ldin, out,
- ldout );
- } else {
- LAPACKE_dgb_trans( matrix_order, n, n, kd, 0, in, ldin, out,
- ldout );
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtbcon.c b/netlib/LAPACKE/lapacke_dtbcon.c
deleted file mode 100644
index c064510..0000000
--- a/netlib/LAPACKE/lapacke_dtbcon.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd, const double* ab,
- lapack_int ldab, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtbcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtb_nancheck( matrix_order, uplo, diag, n, kd, ab, ldab ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtbcon_work( matrix_order, norm, uplo, diag, n, kd, ab, ldab,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtbcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtbcon_work.c b/netlib/LAPACKE/lapacke_dtbcon_work.c
deleted file mode 100644
index eb1bfea..0000000
--- a/netlib/LAPACKE/lapacke_dtbcon_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const double* ab, lapack_int ldab,
- double* rcond, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtbcon( &norm, &uplo, &diag, &n, &kd, ab, &ldab, rcond, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- double* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dtbcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtb_trans( matrix_order, uplo, diag, n, kd, ab, ldab, ab_t,
- ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtbcon( &norm, &uplo, &diag, &n, &kd, ab_t, &ldab_t, rcond, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtbcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtbcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtbrfs.c b/netlib/LAPACKE/lapacke_dtbrfs.c
deleted file mode 100644
index 301c67f..0000000
--- a/netlib/LAPACKE/lapacke_dtbrfs.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtbrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtb_nancheck( matrix_order, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtbrfs_work( matrix_order, uplo, trans, diag, n, kd, nrhs,
- ab, ldab, b, ldb, x, ldx, ferr, berr, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtbrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtbrfs_work.c b/netlib/LAPACKE/lapacke_dtbrfs_work.c
deleted file mode 100644
index fbc5908..0000000
--- a/netlib/LAPACKE/lapacke_dtbrfs_work.c
+++ /dev/null
@@ -1,117 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab, &ldab, b, &ldb,
- x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* ab_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dtb_trans( matrix_order, uplo, diag, n, kd, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtbtrs.c b/netlib/LAPACKE/lapacke_dtbtrs.c
deleted file mode 100644
index 7138d04..0000000
--- a/netlib/LAPACKE/lapacke_dtbtrs.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtbtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtb_nancheck( matrix_order, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
-#endif
- return LAPACKE_dtbtrs_work( matrix_order, uplo, trans, diag, n, kd, nrhs,
- ab, ldab, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dtbtrs_work.c b/netlib/LAPACKE/lapacke_dtbtrs_work.c
deleted file mode 100644
index e6356ef..0000000
--- a/netlib/LAPACKE/lapacke_dtbtrs_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab, &ldab, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- double* ab_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dtb_trans( matrix_order, uplo, diag, n, kd, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t,
- &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtf_nancheck.c b/netlib/LAPACKE/lapacke_dtf_nancheck.c
deleted file mode 100644
index c9d5a0e..0000000
--- a/netlib/LAPACKE/lapacke_dtf_nancheck.c
+++ /dev/null
@@ -1,157 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dtf_nancheck( int matrix_order, char transr,
- char uplo, char diag,
- lapack_int n,
- const double *a )
-{
- lapack_int len;
- lapack_logical rowmaj, ntr, lower, unit;
- lapack_int n1, n2, k;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- rowmaj = (matrix_order == LAPACK_ROW_MAJOR);
- ntr = LAPACKE_lsame( transr, 'n' );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !rowmaj && ( matrix_order != LAPACK_COL_MAJOR ) ) ||
- ( !ntr && !LAPACKE_lsame( transr, 't' )
- && !LAPACKE_lsame( transr, 'c' ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
-
- if( unit ) {
- /* Unit case, diagonal should be excluded from the check for NaN.
- * Decoding RFP and checking both triangulars and rectangular
- * for NaNs.
- */
- if( lower ) {
- n2 = n / 2;
- n1 = n - n2;
- } else {
- n1 = n / 2;
- n2 = n - n1;
- }
- if( n % 2 == 1 ) {
- /* N is odd */
- if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) {
- /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */
- if( lower ) {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n1, &a[0], n )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n2, n1,
- &a[n1], n )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n2, &a[n], n );
- } else {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n1, &a[n2], n )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n1, n2,
- &a[0], n )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n2, &a[n1], n );
- }
- } else {
- /* N is odd and
- ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */
- if( lower ) {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n1, &a[0], n1 )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n1, n2,
- &a[1], n1 )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n2, &a[1], n1 );
- } else {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n1, &a[(size_t)n2*n2], n2 )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n2, n1,
- &a[0], n2 )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n2, &a[(size_t)n1*n2], n2 );
- }
- }
- } else {
- /* N is even */
- k = n / 2;
- if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) {
- /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */
- if( lower ) {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[1], n+1 )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[k+1], n+1 )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[0], n+1 );
- } else {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[k+1], n+1 )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[0], n+1 )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[k], n+1 );
- }
- } else {
- /* N is even and
- ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */
- if( lower ) {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[k], k )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[(size_t)k*(k+1)], k )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[0], k );
- } else {
- return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[(size_t)k*(k+1)], k )
- || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[0], k )
- || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[(size_t)k*k], k );
- }
- }
- }
- } else {
- /* Non-unit case - just check whole array for NaNs. */
- len = n*(n+1)/2;
- return LAPACKE_dge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtf_trans.c b/netlib/LAPACKE/lapacke_dtf_trans.c
deleted file mode 100644
index 0b05a48..0000000
--- a/netlib/LAPACKE/lapacke_dtf_trans.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input RFP matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- * This functions does copy diagonal for both unit and non-unit cases.
- */
-
-void LAPACKE_dtf_trans( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, const double *in,
- double *out )
-{
- lapack_int row, col;
- lapack_logical rowmaj, ntr, lower, unit;
-
- if( in == NULL || out == NULL ) return ;
-
- rowmaj = (matrix_order == LAPACK_ROW_MAJOR);
- ntr = LAPACKE_lsame( transr, 'n' );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !rowmaj && ( matrix_order != LAPACK_COL_MAJOR ) ) ||
- ( !ntr && !LAPACKE_lsame( transr, 't' ) &&
- !LAPACKE_lsame( transr, 'c' ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if input parameters are wrong */
- return;
- }
-
- /* Determine parameters of array representing RFP */
- if( ntr ) {
- if( n%2 == 0 ) {
- row = n + 1;
- col = n / 2;
- } else {
- row = n;
- col = (n + 1) / 2;
- }
- } else {
- if( n%2 == 0 ) {
- row = n / 2;
- col = n + 1;
- } else {
- row = (n + 1) / 2;
- col = n;
- }
- }
-
- /* Perform conversion: */
- if( rowmaj ) {
- LAPACKE_dge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row );
- } else {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtfsm.c b/netlib/LAPACKE/lapacke_dtfsm.c
deleted file mode 100644
index 9c852d1..0000000
--- a/netlib/LAPACKE/lapacke_dtfsm.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtfsm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- double alpha, const double* a, double* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtfsm", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( IS_D_NONZERO(alpha) ) {
- if( LAPACKE_dtf_nancheck( matrix_order, transr, uplo, diag, n, a ) ) {
- return -10;
- }
- }
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -9;
- }
- if( IS_D_NONZERO(alpha) ) {
- if( LAPACKE_dge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -11;
- }
- }
-#endif
- return LAPACKE_dtfsm_work( matrix_order, transr, side, uplo, trans, diag, m,
- n, alpha, a, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dtfsm_work.c b/netlib/LAPACKE/lapacke_dtfsm_work.c
deleted file mode 100644
index 82bd712..0000000
--- a/netlib/LAPACKE/lapacke_dtfsm_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtfsm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, double alpha, const double* a,
- double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a,
- b, &ldb );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,m);
- double* b_t = NULL;
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dtfsm_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( IS_D_NONZERO(alpha) ) {
- a_t = (double*)
- LAPACKE_malloc( sizeof(double) *
- ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- if( IS_D_NONZERO(alpha) ) {
- LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- }
- if( IS_D_NONZERO(alpha) ) {
- LAPACKE_dtf_trans( matrix_order, transr, uplo, diag, n, a, a_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
- b_t, &ldb_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- if( IS_D_NONZERO(alpha) ) {
- LAPACKE_free( a_t );
- }
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtfsm_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtfsm_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtftri.c b/netlib/LAPACKE/lapacke_dtftri.c
deleted file mode 100644
index 38d1411..0000000
--- a/netlib/LAPACKE/lapacke_dtftri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, double* a )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtftri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtf_nancheck( matrix_order, transr, uplo, diag, n, a ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dtftri_work( matrix_order, transr, uplo, diag, n, a );
-}
diff --git a/netlib/LAPACKE/lapacke_dtftri_work.c b/netlib/LAPACKE/lapacke_dtftri_work.c
deleted file mode 100644
index b029561..0000000
--- a/netlib/LAPACKE/lapacke_dtftri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n, double* a )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtftri( &transr, &uplo, &diag, &n, a, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtf_trans( matrix_order, transr, uplo, diag, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtftri( &transr, &uplo, &diag, &n, a_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dtf_trans( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtftri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtftri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtfttp.c b/netlib/LAPACKE/lapacke_dtfttp.c
deleted file mode 100644
index a3260c0..0000000
--- a/netlib/LAPACKE/lapacke_dtfttp.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtfttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtfttp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, arf ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dtfttp_work( matrix_order, transr, uplo, n, arf, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_dtfttp_work.c b/netlib/LAPACKE/lapacke_dtfttp_work.c
deleted file mode 100644
index f7d6cb2..0000000
--- a/netlib/LAPACKE/lapacke_dtfttp_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtfttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtfttp( &transr, &uplo, &n, arf, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- double* arf_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpf_trans( matrix_order, transr, uplo, n, arf, arf_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtfttp( &transr, &uplo, &n, arf_t, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtfttp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtfttp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtfttr.c b/netlib/LAPACKE/lapacke_dtfttr.c
deleted file mode 100644
index d12e297..0000000
--- a/netlib/LAPACKE/lapacke_dtfttr.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtfttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtfttr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, arf ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dtfttr_work( matrix_order, transr, uplo, n, arf, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dtfttr_work.c b/netlib/LAPACKE/lapacke_dtfttr_work.c
deleted file mode 100644
index 6317396..0000000
--- a/netlib/LAPACKE/lapacke_dtfttr_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtfttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtfttr( &transr, &uplo, &n, arf, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- double* arf_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtfttr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpf_trans( matrix_order, transr, uplo, n, arf, arf_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtfttr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtfttr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgevc.c b/netlib/LAPACKE/lapacke_dtgevc.c
deleted file mode 100644
index 33af610..0000000
--- a/netlib/LAPACKE/lapacke_dtgevc.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtgevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* s, lapack_int lds, const double* p,
- lapack_int ldp, double* vl, lapack_int ldvl,
- double* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtgevc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, p, ldp ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, s, lds ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -10;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,6*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtgevc_work( matrix_order, side, howmny, select, n, s, lds,
- p, ldp, vl, ldvl, vr, ldvr, mm, m, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgevc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgevc_work.c b/netlib/LAPACKE/lapacke_dtgevc_work.c
deleted file mode 100644
index 22d990e..0000000
--- a/netlib/LAPACKE/lapacke_dtgevc_work.c
+++ /dev/null
@@ -1,155 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtgevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* s, lapack_int lds,
- const double* p, lapack_int ldp, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtgevc( &side, &howmny, select, &n, s, &lds, p, &ldp, vl, &ldvl,
- vr, &ldvr, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldp_t = MAX(1,n);
- lapack_int lds_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* s_t = NULL;
- double* p_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldp < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtgevc_work", info );
- return info;
- }
- if( lds < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtgevc_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtgevc_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dtgevc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- s_t = (double*)LAPACKE_malloc( sizeof(double) * lds_t * MAX(1,n) );
- if( s_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- p_t = (double*)LAPACKE_malloc( sizeof(double) * ldp_t * MAX(1,n) );
- if( p_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, s, lds, s_t, lds_t );
- LAPACKE_dge_trans( matrix_order, n, n, p, ldp, p_t, ldp_t );
- if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtgevc( &side, &howmny, select, &n, s_t, &lds_t, p_t, &ldp_t,
- vl_t, &ldvl_t, vr_t, &ldvr_t, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
- ldvl );
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
- ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( p_t );
-exit_level_1:
- LAPACKE_free( s_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgevc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtgevc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgexc.c b/netlib/LAPACKE/lapacke_dtgexc.c
deleted file mode 100644
index 19ffd05..0000000
--- a/netlib/LAPACKE/lapacke_dtgexc.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtgexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb, double* q,
- lapack_int ldq, double* z, lapack_int ldz,
- lapack_int* ifst, lapack_int* ilst )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtgexc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -7;
- }
- if( wantq ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -9;
- }
- }
- if( wantz ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -11;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dtgexc_work( matrix_order, wantq, wantz, n, a, lda, b, ldb,
- q, ldq, z, ldz, ifst, ilst, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtgexc_work( matrix_order, wantq, wantz, n, a, lda, b, ldb,
- q, ldq, z, ldz, ifst, ilst, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgexc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgexc_work.c b/netlib/LAPACKE/lapacke_dtgexc_work.c
deleted file mode 100644
index 69dee95..0000000
--- a/netlib/LAPACKE/lapacke_dtgexc_work.c
+++ /dev/null
@@ -1,158 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtgexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz, lapack_int* ifst,
- lapack_int* ilst, double* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtgexc( &wantq, &wantz, &n, a, &lda, b, &ldb, q, &ldq, z, &ldz,
- ifst, ilst, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* q_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dtgexc_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dtgexc_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dtgexc_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dtgexc_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dtgexc( &wantq, &wantz, &n, a, &lda_t, b, &ldb_t, q, &ldq_t,
- z, &ldz_t, ifst, ilst, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( wantq ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( wantz ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( wantq ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( wantz ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t,
- &ldq_t, z_t, &ldz_t, ifst, ilst, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( wantq ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( wantz ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( wantz ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( wantq ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgexc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtgexc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsen.c b/netlib/LAPACKE/lapacke_dtgsen.c
deleted file mode 100644
index b9144c1..0000000
--- a/netlib/LAPACKE/lapacke_dtgsen.c
+++ /dev/null
@@ -1,113 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtgsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- double* a, lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* q, lapack_int ldq, double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr, double* dif )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsen", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( wantq ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -14;
- }
- }
- if( wantz ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -16;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dtgsen_work( matrix_order, ijob, wantq, wantz, select, n, a,
- lda, b, ldb, alphar, alphai, beta, q, ldq, z,
- ldz, m, pl, pr, dif, &work_query, lwork,
- &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( ijob != 0 ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtgsen_work( matrix_order, ijob, wantq, wantz, select, n, a,
- lda, b, ldb, alphar, alphai, beta, q, ldq, z,
- ldz, m, pl, pr, dif, work, lwork, iwork,
- liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( ijob != 0 ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsen", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsen_work.c b/netlib/LAPACKE/lapacke_dtgsen_work.c
deleted file mode 100644
index 58c786d..0000000
--- a/netlib/LAPACKE/lapacke_dtgsen_work.c
+++ /dev/null
@@ -1,165 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtgsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alphar, double* alphai,
- double* beta, double* q, lapack_int ldq,
- double* z, lapack_int ldz, lapack_int* m,
- double* pl, double* pr, double* dif,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsen( &ijob, &wantq, &wantz, select, &n, a, &lda, b, &ldb,
- alphar, alphai, beta, q, &ldq, z, &ldz, m, pl, pr, dif,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* q_t = NULL;
- double* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dtgsen_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dtgsen_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dtgsen_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dtgsen_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dtgsen( &ijob, &wantq, &wantz, select, &n, a, &lda_t, b,
- &ldb_t, alphar, alphai, beta, q, &ldq_t, z, &ldz_t,
- m, pl, pr, dif, work, &lwork, iwork, &liwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( wantq ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( wantz ) {
- z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( wantq ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( wantz ) {
- LAPACKE_dge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsen( &ijob, &wantq, &wantz, select, &n, a_t, &lda_t, b_t,
- &ldb_t, alphar, alphai, beta, q_t, &ldq_t, z_t, &ldz_t,
- m, pl, pr, dif, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( wantq ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( wantz ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( wantz ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( wantq ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsen_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtgsen_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsja.c b/netlib/LAPACKE/lapacke_dtgsja.c
deleted file mode 100644
index b9e8185..0000000
--- a/netlib/LAPACKE/lapacke_dtgsja.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtgsja
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double tola, double tolb, double* alpha,
- double* beta, double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- lapack_int* ncycle )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsja", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -22;
- }
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, m, m, u, ldu ) ) {
- return -18;
- }
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, p, p, v, ldv ) ) {
- return -20;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtgsja_work( matrix_order, jobu, jobv, jobq, m, p, n, k, l,
- a, lda, b, ldb, tola, tolb, alpha, beta, u, ldu,
- v, ldv, q, ldq, work, ncycle );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsja", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsja_work.c b/netlib/LAPACKE/lapacke_dtgsja_work.c
deleted file mode 100644
index 2384f36..0000000
--- a/netlib/LAPACKE/lapacke_dtgsja_work.c
+++ /dev/null
@@ -1,180 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtgsja
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double tola, double tolb,
- double* alpha, double* beta, double* u,
- lapack_int ldu, double* v, lapack_int ldv,
- double* q, lapack_int ldq, double* work,
- lapack_int* ncycle )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a, &lda, b,
- &ldb, &tola, &tolb, alpha, beta, u, &ldu, v, &ldv, q,
- &ldq, work, ncycle, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,p);
- double* a_t = NULL;
- double* b_t = NULL;
- double* u_t = NULL;
- double* v_t = NULL;
- double* q_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- return info;
- }
- if( ldu < m ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- return info;
- }
- if( ldv < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,p) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_dge_trans( matrix_order, m, m, u, ldu, u_t, ldu_t );
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, p, p, v, ldv, v_t, ldv_t );
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t,
- b_t, &ldb_t, &tola, &tolb, alpha, beta, u_t, &ldu_t, v_t,
- &ldv_t, q_t, &ldq_t, work, ncycle, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv );
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_4:
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtgsja_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsna.c b/netlib/LAPACKE/lapacke_dtgsna.c
deleted file mode 100644
index 29ccf22..0000000
--- a/netlib/LAPACKE/lapacke_dtgsna.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtgsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* a, lapack_int lda, const double* b,
- lapack_int ldb, const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* dif, lapack_int mm, lapack_int* m )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsna", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -10;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dtgsna_work( matrix_order, job, howmny, select, n, a, lda, b,
- ldb, vl, ldvl, vr, ldvr, s, dif, mm, m,
- &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Call middle-level interface */
- info = LAPACKE_dtgsna_work( matrix_order, job, howmny, select, n, a, lda, b,
- ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work,
- lwork, iwork );
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( work );
- }
-exit_level_1:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsna", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsna_work.c b/netlib/LAPACKE/lapacke_dtgsna_work.c
deleted file mode 100644
index 7ece7fe..0000000
--- a/netlib/LAPACKE/lapacke_dtgsna_work.c
+++ /dev/null
@@ -1,155 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtgsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb,
- const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* dif, lapack_int mm, lapack_int* m,
- double* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsna( &job, &howmny, select, &n, a, &lda, b, &ldb, vl, &ldvl,
- vr, &ldvr, s, dif, &mm, m, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtgsna_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtgsna_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtgsna_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dtgsna_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dtgsna( &job, &howmny, select, &n, a, &lda_t, b, &ldb_t, vl,
- &ldvl_t, vr, &ldvr_t, s, dif, &mm, m, work, &lwork,
- iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsna( &job, &howmny, select, &n, a_t, &lda_t, b_t, &ldb_t,
- vl_t, &ldvl_t, vr_t, &ldvr_t, s, dif, &mm, m, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsna_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtgsna_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsyl.c b/netlib/LAPACKE/lapacke_dtgsyl.c
deleted file mode 100644
index 65239ea..0000000
--- a/netlib/LAPACKE/lapacke_dtgsyl.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtgsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- double* c, lapack_int ldc, const double* d,
- lapack_int ldd, const double* e, lapack_int lde,
- double* f, lapack_int ldf, double* scale,
- double* dif )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsyl", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, m, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, m, d, ldd ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, e, lde ) ) {
- return -14;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, f, ldf ) ) {
- return -16;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+n+6) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_dtgsyl_work( matrix_order, trans, ijob, m, n, a, lda, b, ldb,
- c, ldc, d, ldd, e, lde, f, ldf, scale, dif,
- &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtgsyl_work( matrix_order, trans, ijob, m, n, a, lda, b, ldb,
- c, ldc, d, ldd, e, lde, f, ldf, scale, dif,
- work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsyl", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtgsyl_work.c b/netlib/LAPACKE/lapacke_dtgsyl_work.c
deleted file mode 100644
index 6a0f225..0000000
--- a/netlib/LAPACKE/lapacke_dtgsyl_work.c
+++ /dev/null
@@ -1,174 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtgsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- double* c, lapack_int ldc, const double* d,
- lapack_int ldd, const double* e, lapack_int lde,
- double* f, lapack_int ldf, double* scale,
- double* dif, double* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsyl( &trans, &ijob, &m, &n, a, &lda, b, &ldb, c, &ldc, d,
- &ldd, e, &lde, f, &ldf, scale, dif, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldc_t = MAX(1,m);
- lapack_int ldd_t = MAX(1,m);
- lapack_int lde_t = MAX(1,n);
- lapack_int ldf_t = MAX(1,m);
- double* a_t = NULL;
- double* b_t = NULL;
- double* c_t = NULL;
- double* d_t = NULL;
- double* e_t = NULL;
- double* f_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- return info;
- }
- if( ldd < m ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- return info;
- }
- if( lde < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- return info;
- }
- if( ldf < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dtgsyl( &trans, &ijob, &m, &n, a, &lda_t, b, &ldb_t, c,
- &ldc_t, d, &ldd_t, e, &lde_t, f, &ldf_t, scale, dif,
- work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- d_t = (double*)LAPACKE_malloc( sizeof(double) * ldd_t * MAX(1,m) );
- if( d_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- e_t = (double*)LAPACKE_malloc( sizeof(double) * lde_t * MAX(1,n) );
- if( e_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- f_t = (double*)LAPACKE_malloc( sizeof(double) * ldf_t * MAX(1,n) );
- if( f_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- LAPACKE_dge_trans( matrix_order, m, m, d, ldd, d_t, ldd_t );
- LAPACKE_dge_trans( matrix_order, n, n, e, lde, e_t, lde_t );
- LAPACKE_dge_trans( matrix_order, m, n, f, ldf, f_t, ldf_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtgsyl( &trans, &ijob, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t,
- &ldc_t, d_t, &ldd_t, e_t, &lde_t, f_t, &ldf_t, scale,
- dif, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf );
- /* Release memory and exit */
- LAPACKE_free( f_t );
-exit_level_5:
- LAPACKE_free( e_t );
-exit_level_4:
- LAPACKE_free( d_t );
-exit_level_3:
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtp_nancheck.c b/netlib/LAPACKE/lapacke_dtp_nancheck.c
deleted file mode 100644
index fc4228f..0000000
--- a/netlib/LAPACKE/lapacke_dtp_nancheck.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo or matrix_order.
- */
-
-lapack_logical LAPACKE_dtp_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const double *ap )
-{
- lapack_int i, len;
- lapack_logical colmaj, upper, unit;
-
- if( ap == NULL ) return (lapack_logical) 0;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
-
- if( unit ) {
- /* Unit case, diagonal should be excluded from the check for NaN. */
-
- /* Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
- for( i = 1; i < n; i++ )
- if( LAPACKE_d_nancheck( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) )
- return (lapack_logical) 1;
- } else {
- for( i = 0; i < n-1; i++ )
- if( LAPACKE_d_nancheck( n-i-1,
- &ap[ (size_t)i+1 + i*((size_t)2*n-i+1)/2 ], 1 ) )
- return (lapack_logical) 1;
- }
- return (lapack_logical) 0;
- } else {
- /* Non-unit case - just check whole array for NaNs. */
- len = n*(n+1)/2;
- return LAPACKE_d_nancheck( len, ap, 1 );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtp_trans.c b/netlib/LAPACKE/lapacke_dtp_trans.c
deleted file mode 100644
index 81b58e0..0000000
--- a/netlib/LAPACKE/lapacke_dtp_trans.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input triangular packed matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_dtp_trans( int matrix_order, char uplo, char diag,
- lapack_int n, const double *in,
- double *out )
-{
- lapack_int i, j, st;
- lapack_logical colmaj, upper, unit;
-
- if( in == NULL || out == NULL ) return ;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return;
- }
- if( unit ) {
- /* If unit, then don't touch diagonal, start from 1st column or row */
- st = 1;
- } else {
- /* If non-unit, then check diagonal also, starting from [0,0] */
- st = 0;
- }
-
- /* Perform conversion:
- * Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
- for( j = st; j < n; j++ ) {
- for( i = 0; i < j+1-st; i++ ) {
- out[ j-i + (i*(2*n-i+1))/2 ] = in[ ((j+1)*j)/2 + i ];
- }
- }
- } else {
- for( j = 0; j < n-st; j++ ) {
- for( i = j+st; i < n; i++ ) {
- out[ j + ((i+1)*i)/2 ] = in[ (j*(2*n-j+1))/2 + i-j ];
- }
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtpcon.c b/netlib/LAPACKE/lapacke_dtpcon.c
deleted file mode 100644
index 8d1e3ad..0000000
--- a/netlib/LAPACKE/lapacke_dtpcon.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtpcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const double* ap, double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtpcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtpcon_work( matrix_order, norm, uplo, diag, n, ap, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpcon_work.c b/netlib/LAPACKE/lapacke_dtpcon_work.c
deleted file mode 100644
index bc8c839..0000000
--- a/netlib/LAPACKE/lapacke_dtpcon_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtpcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const double* ap,
- double* rcond, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtpcon( &norm, &uplo, &diag, &n, ap, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtpcon( &norm, &uplo, &diag, &n, ap_t, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtpcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpmqrt.c b/netlib/LAPACKE/lapacke_dtpmqrt.c
deleted file mode 100644
index b09eabe..0000000
--- a/netlib/LAPACKE/lapacke_dtpmqrt.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtpmqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* a, lapack_int lda, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtpmqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -13;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_dge_nancheck( matrix_order, ldt, nb, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_dge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) * MAX(1,nb) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtpmqrt_work( matrix_order, side, trans, m, n, k, l, nb, v,
- ldv, t, ldt, a, lda, b, ldb, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpmqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpmqrt_work.c b/netlib/LAPACKE/lapacke_dtpmqrt_work.c
deleted file mode 100644
index 9120c0f..0000000
--- a/netlib/LAPACKE/lapacke_dtpmqrt_work.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtpmqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const double* v,
- lapack_int ldv, const double* t,
- lapack_int ldt, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v, &ldv, t, &ldt, a,
- &lda, b, &ldb, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int r = LAPACKE_lsame( side, 'r' ) ? k : k;
- lapack_int lda_t = MAX(1,k);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- lapack_int ldv_t = MAX(1,ldv);
- double* v_t = NULL;
- double* t_t = NULL;
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
- return info;
- }
- if( ldt < nb ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
- return info;
- }
- if( ldv < k ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,k) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,nb) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
- LAPACKE_dge_trans( matrix_order, ldt, nb, t, ldt, t_t, ldt_t );
- LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
- &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_3:
- LAPACKE_free( a_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpqrt.c b/netlib/LAPACKE/lapacke_dtpqrt.c
deleted file mode 100644
index 0f701e3..0000000
--- a/netlib/LAPACKE/lapacke_dtpqrt.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtpqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb, double* a,
- lapack_int lda, double* b, lapack_int ldb, double* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtpqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,nb) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtpqrt_work( matrix_order, m, n, l, nb, a, lda, b, ldb, t,
- ldt, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpqrt2.c b/netlib/LAPACKE/lapacke_dtpqrt2.c
deleted file mode 100644
index 1963737..0000000
--- a/netlib/LAPACKE/lapacke_dtpqrt2.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtpqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* t, lapack_int ldt )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtpqrt2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -6;
- }
-#endif
- return LAPACKE_dtpqrt2_work( matrix_order, m, n, l, a, lda, b, ldb, t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_dtpqrt2_work.c b/netlib/LAPACKE/lapacke_dtpqrt2_work.c
deleted file mode 100644
index 558f73a..0000000
--- a/netlib/LAPACKE/lapacke_dtpqrt2_work.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtpqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* t, lapack_int ldt )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtpqrt2( &m, &n, &l, a, &lda, b, &ldb, t, &ldt, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpqrt_work.c b/netlib/LAPACKE/lapacke_dtpqrt_work.c
deleted file mode 100644
index 1c6b582..0000000
--- a/netlib/LAPACKE/lapacke_dtpqrt_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtpqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* t, lapack_int ldt, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtpqrt( &m, &n, &l, &nb, a, &lda, b, &ldb, t, &ldt, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,nb);
- double* a_t = NULL;
- double* b_t = NULL;
- double* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtpqrt( &m, &n, &l, &nb, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtprfb.c b/netlib/LAPACKE/lapacke_dtprfb.c
deleted file mode 100644
index e01e2d5..0000000
--- a/netlib/LAPACKE/lapacke_dtprfb.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtprfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* a, lapack_int lda, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- lapack_int ldwork;
- lapack_int work_size;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtprfb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_dge_nancheck( matrix_order, ldt, k, t, ldt ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
- return -10;
- }
-#endif
- if (side=='l' || side=='L') {
- ldwork = k;
- work_size = MAX(1,ldwork) * MAX(1,n);
- }
- else {
- ldwork = m;
- work_size = MAX(1,ldwork) * MAX(1,k);
- }
- /* Allocate memory for working array(s) */
- work = (double*)
- LAPACKE_malloc( sizeof(double) * MAX(1,ldwork) * MAX(n,k) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtprfb_work( matrix_order, side, trans, direct, storev, m, n,
- k, l, v, ldv, t, ldt, a, lda, b, ldb, work,
- ldwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtprfb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtprfb_work.c b/netlib/LAPACKE/lapacke_dtprfb_work.c
deleted file mode 100644
index 07fb69e..0000000
--- a/netlib/LAPACKE/lapacke_dtprfb_work.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtprfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- const double* work, lapack_int ldwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv,
- t, &ldt, a, &lda, b, &ldb, work, &ldwork );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int r = LAPACKE_lsame( side, 'r' ) ? k : k;
- lapack_int lda_t = MAX(1,k);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- lapack_int ldv_t = MAX(1,ldv);
- double* v_t = NULL;
- double* t_t = NULL;
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
- return info;
- }
- if( ldt < k ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
- return info;
- }
- if( ldv < k ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,k) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,k) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
- LAPACKE_dge_trans( matrix_order, ldt, k, t, ldt, t_t, ldt_t );
- LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t,
- &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work,
- &ldwork );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_3:
- LAPACKE_free( a_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtprfs.c b/netlib/LAPACKE/lapacke_dtprfs.c
deleted file mode 100644
index f542035..0000000
--- a/netlib/LAPACKE/lapacke_dtprfs.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* ap,
- const double* b, lapack_int ldb, const double* x,
- lapack_int ldx, double* ferr, double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtprfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtprfs_work( matrix_order, uplo, trans, diag, n, nrhs, ap, b,
- ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtprfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtprfs_work.c b/netlib/LAPACKE/lapacke_dtprfs_work.c
deleted file mode 100644
index bea07ac..0000000
--- a/netlib/LAPACKE/lapacke_dtprfs_work.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* ap, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtprfs( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* b_t = NULL;
- double* x_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtprfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtprfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- LAPACKE_dtp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtprfs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, x_t,
- &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtprfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtprfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtptri.c b/netlib/LAPACKE/lapacke_dtptri.c
deleted file mode 100644
index 30b1743..0000000
--- a/netlib/LAPACKE/lapacke_dtptri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtptri( int matrix_order, char uplo, char diag, lapack_int n,
- double* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtptri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dtptri_work( matrix_order, uplo, diag, n, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_dtptri_work.c b/netlib/LAPACKE/lapacke_dtptri_work.c
deleted file mode 100644
index ce5c73a..0000000
--- a/netlib/LAPACKE/lapacke_dtptri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, double* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtptri( &uplo, &diag, &n, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtptri( &uplo, &diag, &n, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dtp_trans( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtptri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtptri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtptrs.c b/netlib/LAPACKE/lapacke_dtptrs.c
deleted file mode 100644
index 79defd6..0000000
--- a/netlib/LAPACKE/lapacke_dtptrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* ap,
- double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtptrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_dtptrs_work( matrix_order, uplo, trans, diag, n, nrhs, ap, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dtptrs_work.c b/netlib/LAPACKE/lapacke_dtptrs_work.c
deleted file mode 100644
index 7fa0fae..0000000
--- a/netlib/LAPACKE/lapacke_dtptrs_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* ap, double* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtptrs( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- double* b_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtptrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dtp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtptrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtptrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpttf.c b/netlib/LAPACKE/lapacke_dtpttf.c
deleted file mode 100644
index 3a27a68..0000000
--- a/netlib/LAPACKE/lapacke_dtpttf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtpttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const double* ap, double* arf )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtpttf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dtpttf_work( matrix_order, transr, uplo, n, ap, arf );
-}
diff --git a/netlib/LAPACKE/lapacke_dtpttf_work.c b/netlib/LAPACKE/lapacke_dtpttf_work.c
deleted file mode 100644
index aa2e1de..0000000
--- a/netlib/LAPACKE/lapacke_dtpttf_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtpttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* ap, double* arf )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtpttf( &transr, &uplo, &n, ap, arf, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- double* ap_t = NULL;
- double* arf_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtpttf( &transr, &uplo, &n, ap_t, arf_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpttf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtpttf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtpttr.c b/netlib/LAPACKE/lapacke_dtpttr.c
deleted file mode 100644
index d82e56f..0000000
--- a/netlib/LAPACKE/lapacke_dtpttr.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtpttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpttr( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* a, lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtpttr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dtpttr_work( matrix_order, uplo, n, ap, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dtpttr_work.c b/netlib/LAPACKE/lapacke_dtpttr_work.c
deleted file mode 100644
index 0c4df62..0000000
--- a/netlib/LAPACKE/lapacke_dtpttr_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtpttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtpttr_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtpttr( &uplo, &n, ap, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dtpttr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dpp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtpttr( &uplo, &n, ap_t, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtpttr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtpttr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtr_nancheck.c b/netlib/LAPACKE/lapacke_dtr_nancheck.c
deleted file mode 100644
index b10c9ae..0000000
--- a/netlib/LAPACKE/lapacke_dtr_nancheck.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_dtr_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const double *a,
- lapack_int lda )
-{
- lapack_int i, j, st;
- lapack_logical colmaj, lower, unit;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
- if( unit ) {
- /* If unit, then don't touch diagonal, start from 1st column or row */
- st = 1;
- } else {
- /* If non-unit, then check diagonal also, starting from [0,0] */
- st = 0;
- }
-
- /* Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || lower ) && !( colmaj && lower ) ) {
- for( j = st; j < n; j++ ) {
- for( i = 0; i < MIN( j+1-st, lda ); i++ ) {
- if( LAPACK_DISNAN( a[i+j*lda] ) )
- return (lapack_logical) 1;
- }
- }
- } else {
- for( j = 0; j < n-st; j++ ) {
- for( i = j+st; i < MIN( n, lda ); i++ ) {
- if( LAPACK_DISNAN( a[i+j*lda] ) )
- return (lapack_logical) 1;
- }
- }
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_dtr_trans.c b/netlib/LAPACKE/lapacke_dtr_trans.c
deleted file mode 100644
index fa61bbc..0000000
--- a/netlib/LAPACKE/lapacke_dtr_trans.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input triangular matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_dtr_trans( int matrix_order, char uplo, char diag, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout )
-{
- lapack_int i, j, st;
- lapack_logical colmaj, lower, unit;
-
- if( in == NULL || out == NULL ) return ;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return;
- }
- if( unit ) {
- /* If unit, then don't touch diagonal, start from 1st column or row */
- st = 1;
- } else {
- /* If non-unit, then check diagonal also, starting from [0,0] */
- st = 0;
- }
-
- /* Perform conversion:
- * Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || lower ) && !( colmaj && lower ) ) {
- for( j = st; j < MIN( n, ldout ); j++ ) {
- for( i = 0; i < MIN( j+1-st, ldin ); i++ ) {
- out[ j+i*ldout ] = in[ i+j*ldin ];
- }
- }
- } else {
- for( j = 0; j < MIN( n-st, ldout ); j++ ) {
- for( i = j+st; i < MIN( n, ldin ); i++ ) {
- out[ j+i*ldout ] = in[ i+j*ldin ];
- }
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_dtrcon.c b/netlib/LAPACKE/lapacke_dtrcon.c
deleted file mode 100644
index e10e4a2..0000000
--- a/netlib/LAPACKE/lapacke_dtrcon.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const double* a, lapack_int lda,
- double* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtrcon_work( matrix_order, norm, uplo, diag, n, a, lda,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrcon_work.c b/netlib/LAPACKE/lapacke_dtrcon_work.c
deleted file mode 100644
index 5c3ab67..0000000
--- a/netlib/LAPACKE/lapacke_dtrcon_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const double* a,
- lapack_int lda, double* rcond, double* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrcon( &norm, &uplo, &diag, &n, a, &lda, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtrcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtr_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrcon( &norm, &uplo, &diag, &n, a_t, &lda_t, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrevc.c b/netlib/LAPACKE/lapacke_dtrevc.c
deleted file mode 100644
index b0eec1f..0000000
--- a/netlib/LAPACKE/lapacke_dtrevc.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrevc( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrevc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtrevc_work( matrix_order, side, howmny, select, n, t, ldt,
- vl, ldvl, vr, ldvr, mm, m, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrevc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrevc_work.c b/netlib/LAPACKE/lapacke_dtrevc_work.c
deleted file mode 100644
index f3035b8..0000000
--- a/netlib/LAPACKE/lapacke_dtrevc_work.c
+++ /dev/null
@@ -1,139 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrevc_work( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrevc( &side, &howmny, select, &n, t, &ldt, vl, &ldvl, vr,
- &ldvr, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldt_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* t_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtrevc_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtrevc_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtrevc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtrevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t,
- vr_t, &ldvr_t, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
- ldvl );
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
- ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrevc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrevc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrexc.c b/netlib/LAPACKE/lapacke_dtrexc.c
deleted file mode 100644
index 7f0773e..0000000
--- a/netlib/LAPACKE/lapacke_dtrexc.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrexc( int matrix_order, char compq, lapack_int n,
- double* t, lapack_int ldt, double* q, lapack_int ldq,
- lapack_int* ifst, lapack_int* ilst )
-{
- lapack_int info = 0;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrexc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -6;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtrexc_work( matrix_order, compq, n, t, ldt, q, ldq, ifst,
- ilst, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrexc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrexc_work.c b/netlib/LAPACKE/lapacke_dtrexc_work.c
deleted file mode 100644
index e237c25..0000000
--- a/netlib/LAPACKE/lapacke_dtrexc_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrexc_work( int matrix_order, char compq, lapack_int n,
- double* t, lapack_int ldt, double* q,
- lapack_int ldq, lapack_int* ifst,
- lapack_int* ilst, double* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrexc( &compq, &n, t, &ldt, q, &ldq, ifst, ilst, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldt_t = MAX(1,n);
- double* t_t = NULL;
- double* q_t = NULL;
- /* Check leading dimension(s) */
- if( ldq < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, ifst, ilst, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrrfs.c b/netlib/LAPACKE/lapacke_dtrrfs.c
deleted file mode 100644
index 3a664f0..0000000
--- a/netlib/LAPACKE/lapacke_dtrrfs.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- const double* x, lapack_int ldx, double* ferr,
- double* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -11;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtrrfs_work( matrix_order, uplo, trans, diag, n, nrhs, a,
- lda, b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrrfs_work.c b/netlib/LAPACKE/lapacke_dtrrfs_work.c
deleted file mode 100644
index ecada29..0000000
--- a/netlib/LAPACKE/lapacke_dtrrfs_work.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb,
- const double* x, lapack_int ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrrfs( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x,
- &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- double* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dtr_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrsen.c b/netlib/LAPACKE/lapacke_dtrsen.c
deleted file mode 100644
index 31298a7..0000000
--- a/netlib/LAPACKE/lapacke_dtrsen.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- double* t, lapack_int ldt, double* q, lapack_int ldq,
- double* wr, double* wi, lapack_int* m, double* s,
- double* sep )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- double* work = NULL;
- lapack_int iwork_query;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsen", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -8;
- }
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dtrsen_work( matrix_order, job, compq, select, n, t, ldt, q,
- ldq, wr, wi, m, s, sep, &work_query, lwork,
- &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtrsen_work( matrix_order, job, compq, select, n, t, ldt, q,
- ldq, wr, wi, m, s, sep, work, lwork, iwork,
- liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsen", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrsen_work.c b/netlib/LAPACKE/lapacke_dtrsen_work.c
deleted file mode 100644
index 0c5a30b..0000000
--- a/netlib/LAPACKE/lapacke_dtrsen_work.c
+++ /dev/null
@@ -1,121 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- double* t, lapack_int ldt, double* q,
- lapack_int ldq, double* wr, double* wi,
- lapack_int* m, double* s, double* sep,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrsen( &job, &compq, select, &n, t, &ldt, q, &ldq, wr, wi, m, s,
- sep, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldt_t = MAX(1,n);
- double* t_t = NULL;
- double* q_t = NULL;
- /* Check leading dimension(s) */
- if( ldq < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtrsen_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtrsen_work", info );
- return info;
- }
- /* Allocate memory for temporary array T */
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrix T */
- LAPACKE_dge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_dtrsen( &job, &compq, select, &n, t_t, &ldt_t, q, &ldq_t, wr,
- wi, m, s, sep, work, &lwork, iwork, &liwork, &info );
- LAPACKE_free( t_t );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtrsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, wr,
- wi, m, s, sep, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsen_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrsen_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrsna.c b/netlib/LAPACKE/lapacke_dtrsna.c
deleted file mode 100644
index 1bdd005..0000000
--- a/netlib/LAPACKE/lapacke_dtrsna.c
+++ /dev/null
@@ -1,100 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, const double* vl,
- lapack_int ldvl, const double* vr, lapack_int ldvr,
- double* s, double* sep, lapack_int mm,
- lapack_int* m )
-{
- lapack_int info = 0;
- lapack_int ldwork = LAPACKE_lsame( job, 'e' ) ? 1 : MAX(1,n) ;
- lapack_int* iwork = NULL;
- double* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsna", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- iwork = (lapack_int*)
- LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*(n-1)) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- work = (double*)LAPACKE_malloc( sizeof(double) * ldwork * MAX(1,n+6) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Call middle-level interface */
- info = LAPACKE_dtrsna_work( matrix_order, job, howmny, select, n, t, ldt,
- vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork,
- iwork );
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( work );
- }
-exit_level_1:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsna", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrsna_work.c b/netlib/LAPACKE/lapacke_dtrsna_work.c
deleted file mode 100644
index eba7026..0000000
--- a/netlib/LAPACKE/lapacke_dtrsna_work.c
+++ /dev/null
@@ -1,132 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt,
- const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* sep, lapack_int mm, lapack_int* m,
- double* work, lapack_int ldwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrsna( &job, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr,
- s, sep, &mm, m, work, &ldwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldt_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- double* t_t = NULL;
- double* vl_t = NULL;
- double* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_dtrsna_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_dtrsna_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_dtrsna_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vl_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vr_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_dge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dtrsna( &job, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t,
- vr_t, &ldvr_t, s, sep, &mm, m, work, &ldwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsna_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrsna_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrsyl.c b/netlib/LAPACKE/lapacke_dtrsyl.c
deleted file mode 100644
index b1c5410..0000000
--- a/netlib/LAPACKE/lapacke_dtrsyl.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, const double* b,
- lapack_int ldb, double* c, lapack_int ldc,
- double* scale )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsyl", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
-#endif
- return LAPACKE_dtrsyl_work( matrix_order, trana, tranb, isgn, m, n, a, lda,
- b, ldb, c, ldc, scale );
-}
diff --git a/netlib/LAPACKE/lapacke_dtrsyl_work.c b/netlib/LAPACKE/lapacke_dtrsyl_work.c
deleted file mode 100644
index 786a5ca..0000000
--- a/netlib/LAPACKE/lapacke_dtrsyl_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb, double* c,
- lapack_int ldc, double* scale )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrsyl( &trana, &tranb, &isgn, &m, &n, a, &lda, b, &ldb, c, &ldc,
- scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldc_t = MAX(1,m);
- double* a_t = NULL;
- double* b_t = NULL;
- double* c_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, m, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t,
- c_t, &ldc_t, scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrtri.c b/netlib/LAPACKE/lapacke_dtrtri.c
deleted file mode 100644
index b3d6277..0000000
--- a/netlib/LAPACKE/lapacke_dtrtri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrtri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrtri( int matrix_order, char uplo, char diag, lapack_int n,
- double* a, lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrtri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dtrtri_work( matrix_order, uplo, diag, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_dtrtri_work.c b/netlib/LAPACKE/lapacke_dtrtri_work.c
deleted file mode 100644
index 987926e..0000000
--- a/netlib/LAPACKE/lapacke_dtrtri_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrtri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, double* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrtri( &uplo, &diag, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dtrtri_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dtr_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrtri( &uplo, &diag, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dtr_trans( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a,
- lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrtri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrtri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrtrs.c b/netlib/LAPACKE/lapacke_dtrtrs.c
deleted file mode 100644
index 353a53a..0000000
--- a/netlib/LAPACKE/lapacke_dtrtrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, double* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
-#endif
- return LAPACKE_dtrtrs_work( matrix_order, uplo, trans, diag, n, nrhs, a,
- lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_dtrtrs_work.c b/netlib/LAPACKE/lapacke_dtrtrs_work.c
deleted file mode 100644
index c697c2f..0000000
--- a/netlib/LAPACKE/lapacke_dtrtrs_work.c
+++ /dev/null
@@ -1,100 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* a, lapack_int lda, double* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrtrs( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- double* a_t = NULL;
- double* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dtr_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrtrs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t,
- &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrttf.c b/netlib/LAPACKE/lapacke_dtrttf.c
deleted file mode 100644
index 7ed6b5f..0000000
--- a/netlib/LAPACKE/lapacke_dtrttf.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* arf )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrttf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- return LAPACKE_dtrttf_work( matrix_order, transr, uplo, n, a, lda, arf );
-}
diff --git a/netlib/LAPACKE/lapacke_dtrttf_work.c b/netlib/LAPACKE/lapacke_dtrttf_work.c
deleted file mode 100644
index 4948adb..0000000
--- a/netlib/LAPACKE/lapacke_dtrttf_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* arf )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrttf( &transr, &uplo, &n, a, &lda, arf, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- double* arf_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_dtrttf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrttf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrttf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtrttp.c b/netlib/LAPACKE/lapacke_dtrttp.c
deleted file mode 100644
index 6a1368a..0000000
--- a/netlib/LAPACKE/lapacke_dtrttp.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtrttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrttp( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtrttp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_dtrttp_work( matrix_order, uplo, n, a, lda, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_dtrttp_work.c b/netlib/LAPACKE/lapacke_dtrttp_work.c
deleted file mode 100644
index 066fb9e..0000000
--- a/netlib/LAPACKE/lapacke_dtrttp_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtrttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtrttp_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtrttp( &uplo, &n, a, &lda, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- double* a_t = NULL;
- double* ap_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dtrttp_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (double*)
- LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtrttp( &uplo, &n, a_t, &lda_t, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtrttp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtrttp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtzrzf.c b/netlib/LAPACKE/lapacke_dtzrzf.c
deleted file mode 100644
index 64650b7..0000000
--- a/netlib/LAPACKE/lapacke_dtzrzf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dtzrzf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtzrzf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- double* work = NULL;
- double work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_dtzrzf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_dtzrzf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_dtzrzf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtzrzf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_dtzrzf_work.c b/netlib/LAPACKE/lapacke_dtzrzf_work.c
deleted file mode 100644
index 806b64b..0000000
--- a/netlib/LAPACKE/lapacke_dtzrzf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dtzrzf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dtzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dtzrzf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_dtzrzf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dtzrzf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dtzrzf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dtzrzf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_dtzrzf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ilaver.c b/netlib/LAPACKE/lapacke_ilaver.c
deleted file mode 100644
index bec1d90..0000000
--- a/netlib/LAPACKE/lapacke_ilaver.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function dgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-void LAPACKE_ilaver( const lapack_int* vers_major,
- const lapack_int* vers_minor,
- const lapack_int* vers_patch )
-{
- /* Call LAPACK function */
- LAPACK_ilaver( vers_major, vers_minor, vers_patch );
- return ;
-}
diff --git a/netlib/LAPACKE/lapacke_lsame.c b/netlib/LAPACKE/lapacke_lsame.c
deleted file mode 100644
index 641e9db..0000000
--- a/netlib/LAPACKE/lapacke_lsame.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK lsame
-* Author: Intel Corporation
-* Created in January, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_logical LAPACKE_lsame( char ca, char cb )
-{
- return (lapack_logical) LAPACK_lsame( &ca, &cb, 1, 1 );
-}
-
-
diff --git a/netlib/LAPACKE/lapacke_make_complex_double.c b/netlib/LAPACKE/lapacke_make_complex_double.c
deleted file mode 100644
index f6fb74b..0000000
--- a/netlib/LAPACKE/lapacke_make_complex_double.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in May, 2010
-*****************************************************************************/
-#include "lapacke.h"
-#include "lapacke_utils.h"
-
-#ifndef LAPACK_COMPLEX_CUSTOM
-lapack_complex_double lapack_make_complex_double( double re, double im ) {
- lapack_complex_double z;
-#if defined(LAPACK_COMPLEX_STRUCTURE)
- z.real = re;
- z.imag = im;
-#elif defined(LAPACK_COMPLEX_C99)
- z = re + im * I;
-#elif defined(LAPACK_COMPLEX_CPP)
- z = std::complex<double>(re,im);
-#else /* C99 is default */
- z = re + im*I;
-#endif
- return z;
-}
-#endif
diff --git a/netlib/LAPACKE/lapacke_make_complex_float.c b/netlib/LAPACKE/lapacke_make_complex_float.c
deleted file mode 100644
index c04eb08..0000000
--- a/netlib/LAPACKE/lapacke_make_complex_float.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in May, 2010
-*****************************************************************************/
-#include "lapacke.h"
-#include "lapacke_utils.h"
-
-#ifndef LAPACK_COMPLEX_CUSTOM
-lapack_complex_float lapack_make_complex_float( float re, float im ) {
- lapack_complex_float z;
-#if defined(LAPACK_COMPLEX_STRUCTURE)
- z.real = re;
- z.imag = im;
-#elif defined(LAPACK_COMPLEX_C99)
- z = re + im * I;
-#elif defined(LAPACK_COMPLEX_CPP)
- z = std::complex<float>(re,im);
-#else /* C99 is default */
- z = re + im*I;
-#endif
- return z;
-}
-#endif
diff --git a/netlib/LAPACKE/lapacke_mangling.h b/netlib/LAPACKE/lapacke_mangling.h
deleted file mode 100644
index 6211fd1..0000000
--- a/netlib/LAPACKE/lapacke_mangling.h
+++ /dev/null
@@ -1,17 +0,0 @@
-#ifndef LAPACK_HEADER_INCLUDED
-#define LAPACK_HEADER_INCLUDED
-
-#ifndef LAPACK_GLOBAL
-#if defined(LAPACK_GLOBAL_PATTERN_LC) || defined(ADD_)
-#define LAPACK_GLOBAL(lcname,UCNAME) lcname##_
-#elif defined(LAPACK_GLOBAL_PATTERN_UC) || defined(UPPER)
-#define LAPACK_GLOBAL(lcname,UCNAME) UCNAME
-#elif defined(LAPACK_GLOBAL_PATTERN_MC) || defined(NOCHANGE)
-#define LAPACK_GLOBAL(lcname,UCNAME) lcname
-#else
-#define LAPACK_GLOBAL(lcname,UCNAME) lcname##_
-#endif
-#endif
-
-#endif
-
diff --git a/netlib/LAPACKE/lapacke_mangling_with_flags.h b/netlib/LAPACKE/lapacke_mangling_with_flags.h
deleted file mode 100644
index 6211fd1..0000000
--- a/netlib/LAPACKE/lapacke_mangling_with_flags.h
+++ /dev/null
@@ -1,17 +0,0 @@
-#ifndef LAPACK_HEADER_INCLUDED
-#define LAPACK_HEADER_INCLUDED
-
-#ifndef LAPACK_GLOBAL
-#if defined(LAPACK_GLOBAL_PATTERN_LC) || defined(ADD_)
-#define LAPACK_GLOBAL(lcname,UCNAME) lcname##_
-#elif defined(LAPACK_GLOBAL_PATTERN_UC) || defined(UPPER)
-#define LAPACK_GLOBAL(lcname,UCNAME) UCNAME
-#elif defined(LAPACK_GLOBAL_PATTERN_MC) || defined(NOCHANGE)
-#define LAPACK_GLOBAL(lcname,UCNAME) lcname
-#else
-#define LAPACK_GLOBAL(lcname,UCNAME) lcname##_
-#endif
-#endif
-
-#endif
-
diff --git a/netlib/LAPACKE/lapacke_s_nancheck.c b/netlib/LAPACKE/lapacke_s_nancheck.c
deleted file mode 100644
index 194f687..0000000
--- a/netlib/LAPACKE/lapacke_s_nancheck.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a vector for NaN entries. */
-
-lapack_logical LAPACKE_s_nancheck( lapack_int n,
- const float *x,
- lapack_int incx )
-{
- lapack_int i, inc;
-
- if( incx == 0 ) return (lapack_logical) LAPACK_SISNAN( x[0] );
- inc = ( incx > 0 ) ? incx : -incx ;
-
- for( i = 0; i < n*inc; i+=inc ) {
- if( LAPACK_SISNAN( x[i] ) )
- return (lapack_logical) 1;
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_sbbcsd.c b/netlib/LAPACKE/lapacke_sbbcsd.c
deleted file mode 100644
index 4b3e8ed..0000000
--- a/netlib/LAPACKE/lapacke_sbbcsd.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sbbcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, float* theta, float* phi,
- float* u1, lapack_int ldu1, float* u2,
- lapack_int ldu2, float* v1t, lapack_int ldv1t,
- float* v2t, lapack_int ldv2t, float* b11d,
- float* b11e, float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sbbcsd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( q, theta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nrows_u1, p, u1, ldu1 ) ) {
- return -12;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nrows_u2, m-p, u2, ldu2 ) ) {
- return -14;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v1t, q, v1t, ldv1t ) ) {
- return -16;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v2t, m-q, v2t, ldv2t ) ) {
- return -18;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sbbcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2,
- v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e,
- b21d, b21e, b22d, b22e, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sbbcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2,
- v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e,
- b21d, b21e, b22d, b22e, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbbcsd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sbbcsd_work.c b/netlib/LAPACKE/lapacke_sbbcsd_work.c
deleted file mode 100644
index 7cfd06f..0000000
--- a/netlib/LAPACKE/lapacke_sbbcsd_work.c
+++ /dev/null
@@ -1,198 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sbbcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- float* theta, float* phi, float* u1,
- lapack_int ldu1, float* u2, lapack_int ldu2,
- float* v1t, lapack_int ldv1t, float* v2t,
- lapack_int ldv2t, float* b11d, float* b11e,
- float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
- &ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- float* u1_t = NULL;
- float* u2_t = NULL;
- float* v1t_t = NULL;
- float* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
- v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
- b22d, b22e, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_sge_trans( matrix_order, nrows_u1, p, u1, ldu1, u1_t,
- ldu1_t );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_sge_trans( matrix_order, nrows_u2, m-p, u2, ldu2, u2_t,
- ldu2_t );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_sge_trans( matrix_order, nrows_v1t, q, v1t, ldv1t, v1t_t,
- ldv1t_t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_sge_trans( matrix_order, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
- ldv2t_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
- &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
- b21e, b22d, b22e, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sbdsdc.c b/netlib/LAPACKE/lapacke_sbdsdc.c
deleted file mode 100644
index 98071cf..0000000
--- a/netlib/LAPACKE/lapacke_sbdsdc.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sbdsdc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sbdsdc( int matrix_order, char uplo, char compq,
- lapack_int n, float* d, float* e, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt, float* q,
- lapack_int* iq )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- size_t lwork;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sbdsdc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- lwork = (size_t)3*MAX(1,n)*MAX(1,n)+4*MAX(1,n);
- } else if( LAPACKE_lsame( compq, 'p' ) ) {
- lwork = MAX(1,6*n);
- } else if( LAPACKE_lsame( compq, 'n' ) ) {
- lwork = MAX(1,4*n);
- } else {
- lwork = 1; /* Any value */
- }
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,8*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sbdsdc_work( matrix_order, uplo, compq, n, d, e, u, ldu, vt,
- ldvt, q, iq, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbdsdc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sbdsdc_work.c b/netlib/LAPACKE/lapacke_sbdsdc_work.c
deleted file mode 100644
index b95a5c3..0000000
--- a/netlib/LAPACKE/lapacke_sbdsdc_work.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sbdsdc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sbdsdc_work( int matrix_order, char uplo, char compq,
- lapack_int n, float* d, float* e, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt,
- float* q, lapack_int* iq, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sbdsdc( &uplo, &compq, &n, d, e, u, &ldu, vt, &ldvt, q, iq, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldu_t = MAX(1,n);
- lapack_int ldvt_t = MAX(1,n);
- float* u_t = NULL;
- float* vt_t = NULL;
- /* Check leading dimension(s) */
- if( ldu < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info );
- return info;
- }
- if( ldvt < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,n) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( compq, 'i' ) ) {
- vt_t = (float*)LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,n) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sbdsdc( &uplo, &compq, &n, d, e, u_t, &ldu_t, vt_t, &ldvt_t, q,
- iq, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_free( vt_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( compq, 'i' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sbdsqr.c b/netlib/LAPACKE/lapacke_sbdsqr.c
deleted file mode 100644
index 090789c..0000000
--- a/netlib/LAPACKE/lapacke_sbdsqr.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sbdsqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, float* vt, lapack_int ldvt,
- float* u, lapack_int ldu, float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sbdsqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( ncc != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, ncc, c, ldc ) ) {
- return -13;
- }
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -8;
- }
- if( nru != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_order, nru, n, u, ldu ) ) {
- return -11;
- }
- }
- if( ncvt != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, ncvt, vt, ldvt ) ) {
- return -9;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sbdsqr_work( matrix_order, uplo, n, ncvt, nru, ncc, d, e, vt,
- ldvt, u, ldu, c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbdsqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sbdsqr_work.c b/netlib/LAPACKE/lapacke_sbdsqr_work.c
deleted file mode 100644
index 83e5ec2..0000000
--- a/netlib/LAPACKE/lapacke_sbdsqr_work.c
+++ /dev/null
@@ -1,144 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sbdsqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, float* vt, lapack_int ldvt,
- float* u, lapack_int ldu, float* c,
- lapack_int ldc, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt, &ldvt, u, &ldu,
- c, &ldc, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldc_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,nru);
- lapack_int ldvt_t = MAX(1,n);
- float* vt_t = NULL;
- float* u_t = NULL;
- float* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldc < ncc ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info );
- return info;
- }
- if( ldu < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info );
- return info;
- }
- if( ldvt < ncvt ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( ncvt != 0 ) {
- vt_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,ncvt) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( nru != 0 ) {
- u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,n) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( ncc != 0 ) {
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,ncc) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- if( ncvt != 0 ) {
- LAPACKE_sge_trans( matrix_order, n, ncvt, vt, ldvt, vt_t, ldvt_t );
- }
- if( nru != 0 ) {
- LAPACKE_sge_trans( matrix_order, nru, n, u, ldu, u_t, ldu_t );
- }
- if( ncc != 0 ) {
- LAPACKE_sge_trans( matrix_order, n, ncc, c, ldc, c_t, ldc_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t,
- &ldu_t, c_t, &ldc_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( ncvt != 0 ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt,
- ldvt );
- }
- if( nru != 0 ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu );
- }
- if( ncc != 0 ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc );
- }
- /* Release memory and exit */
- if( ncc != 0 ) {
- LAPACKE_free( c_t );
- }
-exit_level_2:
- if( nru != 0 ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- if( ncvt != 0 ) {
- LAPACKE_free( vt_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sdisna.c b/netlib/LAPACKE/lapacke_sdisna.c
deleted file mode 100644
index 07be8c5..0000000
--- a/netlib/LAPACKE/lapacke_sdisna.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sdisna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sdisna( char job, lapack_int m, lapack_int n, const float* d,
- float* sep )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sdisna_work( job, m, n, d, sep );
-}
diff --git a/netlib/LAPACKE/lapacke_sdisna_work.c b/netlib/LAPACKE/lapacke_sdisna_work.c
deleted file mode 100644
index 48a8393..0000000
--- a/netlib/LAPACKE/lapacke_sdisna_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sdisna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sdisna_work( char job, lapack_int m, lapack_int n,
- const float* d, float* sep )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_sdisna( &job, &m, &n, d, sep, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgb_nancheck.c b/netlib/LAPACKE/lapacke_sgb_nancheck.c
deleted file mode 100644
index 2cec711..0000000
--- a/netlib/LAPACKE/lapacke_sgb_nancheck.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_sgb_nancheck( int matrix_order, lapack_int m,
- lapack_int n, lapack_int kl,
- lapack_int ku,
- const float *ab,
- lapack_int ldab )
-{
- lapack_int i, j;
-
- if( ab == NULL ) return (lapack_logical) 0;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- for( j = 0; j < n; j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN3( ldab, m+ku-j, kl+ku+1 );
- i++ ) {
- if( LAPACK_SISNAN( ab[i+(size_t)j*ldab] ) )
- return (lapack_logical) 1;
- }
- }
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- for( j = 0; j < MIN( n, ldab ); j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) {
- if( LAPACK_SISNAN( ab[(size_t)i*ldab+j] ) )
- return (lapack_logical) 1;
- }
- }
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_sgb_trans.c b/netlib/LAPACKE/lapacke_sgb_trans.c
deleted file mode 100644
index 88a2944..0000000
--- a/netlib/LAPACKE/lapacke_sgb_trans.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input general band matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_sgb_trans( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- lapack_int i, j;
-
- if( in == NULL || out == NULL ) return;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- for( j = 0; j < MIN( ldout, n ); j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN3( ldin, m+ku-j, kl+ku+1 );
- i++ ) {
- out[(size_t)i*ldout+j] = in[i+(size_t)j*ldin];
- }
- }
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- /* TODO: interchange loops for performance.
- * This is just reference impemeltation.
- */
- for( j = 0; j < MIN( n, ldin ); j++ ) {
- for( i = MAX( ku-j, 0 ); i < MIN3( ldout, m+ku-j, kl+ku+1 );
- i++ ) {
- out[i+(size_t)j*ldout] = in[(size_t)i*ldin+j];
- }
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_sgbbrd.c b/netlib/LAPACKE/lapacke_sgbbrd.c
deleted file mode 100644
index 071f4df..0000000
--- a/netlib/LAPACKE/lapacke_sgbbrd.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbbrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, float* ab, lapack_int ldab, float* d,
- float* e, float* q, lapack_int ldq, float* pt,
- lapack_int ldpt, float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbbrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, m, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( ncc != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_order, m, ncc, c, ldc ) ) {
- return -16;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*MAX(m,n)) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgbbrd_work( matrix_order, vect, m, n, ncc, kl, ku, ab, ldab,
- d, e, q, ldq, pt, ldpt, c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbbrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbbrd_work.c b/netlib/LAPACKE/lapacke_sgbbrd_work.c
deleted file mode 100644
index 04a6f5b..0000000
--- a/netlib/LAPACKE/lapacke_sgbbrd_work.c
+++ /dev/null
@@ -1,154 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbbrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, float* ab, lapack_int ldab,
- float* d, float* e, float* q, lapack_int ldq,
- float* pt, lapack_int ldpt, float* c,
- lapack_int ldc, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab, &ldab, d, e, q, &ldq,
- pt, &ldpt, c, &ldc, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- lapack_int ldc_t = MAX(1,m);
- lapack_int ldpt_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,m);
- float* ab_t = NULL;
- float* q_t = NULL;
- float* pt_t = NULL;
- float* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info );
- return info;
- }
- if( ldc < ncc ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info );
- return info;
- }
- if( ldpt < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info );
- return info;
- }
- if( ldq < m ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,m) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
- pt_t = (float*)LAPACKE_malloc( sizeof(float) * ldpt_t * MAX(1,n) );
- if( pt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( ncc != 0 ) {
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,ncc) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
- if( ncc != 0 ) {
- LAPACKE_sge_trans( matrix_order, m, ncc, c, ldc, c_t, ldc_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t,
- &ldq_t, pt_t, &ldpt_t, c_t, &ldc_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt );
- }
- if( ncc != 0 ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc );
- }
- /* Release memory and exit */
- if( ncc != 0 ) {
- LAPACKE_free( c_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
- LAPACKE_free( pt_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbcon.c b/netlib/LAPACKE/lapacke_sgbcon.c
deleted file mode 100644
index c401d53..0000000
--- a/netlib/LAPACKE/lapacke_sgbcon.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, const lapack_int* ipiv, float anorm,
- float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgbcon_work( matrix_order, norm, n, kl, ku, ab, ldab, ipiv,
- anorm, rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbcon_work.c b/netlib/LAPACKE/lapacke_sgbcon_work.c
deleted file mode 100644
index f73fc85..0000000
--- a/netlib/LAPACKE/lapacke_sgbcon_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbcon( &norm, &n, &kl, &ku, ab, &ldab, ipiv, &anorm, rcond,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgbcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, n, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbcon( &norm, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &anorm, rcond,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbequ.c b/netlib/LAPACKE/lapacke_sgbequ.c
deleted file mode 100644
index 44d0e9a..0000000
--- a/netlib/LAPACKE/lapacke_sgbequ.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, m, n, kl, ku, ab, ldab ) ) {
- return -6;
- }
-#endif
- return LAPACKE_sgbequ_work( matrix_order, m, n, kl, ku, ab, ldab, r, c,
- rowcnd, colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_sgbequ_work.c b/netlib/LAPACKE/lapacke_sgbequ_work.c
deleted file mode 100644
index 4597118..0000000
--- a/netlib/LAPACKE/lapacke_sgbequ_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbequ( &m, &n, &kl, &ku, ab, &ldab, r, c, rowcnd, colcnd, amax,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgbequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbequ( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd,
- amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbequb.c b/netlib/LAPACKE/lapacke_sgbequb.c
deleted file mode 100644
index 394c2a8..0000000
--- a/netlib/LAPACKE/lapacke_sgbequb.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, m, n, kl, ku, ab, ldab ) ) {
- return -6;
- }
-#endif
- return LAPACKE_sgbequb_work( matrix_order, m, n, kl, ku, ab, ldab, r, c,
- rowcnd, colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_sgbequb_work.c b/netlib/LAPACKE/lapacke_sgbequb_work.c
deleted file mode 100644
index acdd1aa..0000000
--- a/netlib/LAPACKE/lapacke_sgbequb_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbequb( &m, &n, &kl, &ku, ab, &ldab, r, c, rowcnd, colcnd, amax,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgbequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbequb( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd,
- amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbrfs.c b/netlib/LAPACKE/lapacke_sgbrfs.c
deleted file mode 100644
index 726837a..0000000
--- a/netlib/LAPACKE/lapacke_sgbrfs.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab, const float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -14;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgbrfs_work( matrix_order, trans, n, kl, ku, nrhs, ab, ldab,
- afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbrfs_work.c b/netlib/LAPACKE/lapacke_sgbrfs_work.c
deleted file mode 100644
index ed9fad8..0000000
--- a/netlib/LAPACKE/lapacke_sgbrfs_work.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const float* afb, lapack_int ldafb,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbrfs( &trans, &n, &kl, &ku, &nrhs, ab, &ldab, afb, &ldafb,
- ipiv, b, &ldb, x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- lapack_int ldafb_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* ab_t = NULL;
- float* afb_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (float*)LAPACKE_malloc( sizeof(float) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, n, n, kl, ku, ab, ldab, ab_t, ldab_t );
- LAPACKE_sgb_trans( matrix_order, n, n, kl, kl+ku, afb, ldafb, afb_t,
- ldafb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbrfs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t,
- &ldafb_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbsv.c b/netlib/LAPACKE/lapacke_sgbsv.c
deleted file mode 100644
index 8342465..0000000
--- a/netlib/LAPACKE/lapacke_sgbsv.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, float* ab,
- lapack_int ldab, lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
-#endif
- return LAPACKE_sgbsv_work( matrix_order, n, kl, ku, nrhs, ab, ldab, ipiv, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sgbsv_work.c b/netlib/LAPACKE/lapacke_sgbsv_work.c
deleted file mode 100644
index 72c4fba..0000000
--- a/netlib/LAPACKE/lapacke_sgbsv_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, float* ab,
- lapack_int ldab, lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbsv( &n, &kl, &ku, &nrhs, ab, &ldab, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- float* ab_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgbsv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgbsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, n, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbsv( &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbsvx.c b/netlib/LAPACKE/lapacke_sgbsvx.c
deleted file mode 100644
index 7bdef0b..0000000
--- a/netlib/LAPACKE/lapacke_sgbsvx.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -15;
- }
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -14;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgbsvx_work( matrix_order, fact, trans, n, kl, ku, nrhs, ab,
- ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x,
- ldx, rcond, ferr, berr, work, iwork );
- /* Backup significant data from working array(s) */
- *rpivot = work[0];
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbsvx_work.c b/netlib/LAPACKE/lapacke_sgbsvx_work.c
deleted file mode 100644
index 7757a79..0000000
--- a/netlib/LAPACKE/lapacke_sgbsvx_work.c
+++ /dev/null
@@ -1,151 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab, &ldab, afb,
- &ldafb, ipiv, equed, r, c, b, &ldb, x, &ldx, rcond, ferr,
- berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kl+ku+1);
- lapack_int ldafb_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* ab_t = NULL;
- float* afb_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (float*)LAPACKE_malloc( sizeof(float) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, n, n, kl, ku, ab, ldab, ab_t, ldab_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_sgb_trans( matrix_order, n, n, kl, kl+ku, afb, ldafb, afb_t,
- ldafb_t );
- }
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t,
- &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t,
- rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab,
- ldab );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t,
- ldafb_t, afb, ldafb );
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- }
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbtrf.c b/netlib/LAPACKE/lapacke_sgbtrf.c
deleted file mode 100644
index 80a27e3..0000000
--- a/netlib/LAPACKE/lapacke_sgbtrf.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, float* ab,
- lapack_int ldab, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbtrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, m, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
-#endif
- return LAPACKE_sgbtrf_work( matrix_order, m, n, kl, ku, ab, ldab, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_sgbtrf_work.c b/netlib/LAPACKE/lapacke_sgbtrf_work.c
deleted file mode 100644
index 34ca7d6..0000000
--- a/netlib/LAPACKE/lapacke_sgbtrf_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, float* ab,
- lapack_int ldab, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbtrf( &m, &n, &kl, &ku, ab, &ldab, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgbtrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, m, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbtrf( &m, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sgb_trans( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab,
- ldab );
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbtrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbtrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgbtrs.c b/netlib/LAPACKE/lapacke_sgbtrs.c
deleted file mode 100644
index 28d51c9..0000000
--- a/netlib/LAPACKE/lapacke_sgbtrs.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const lapack_int* ipiv, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgbtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_order, n, n, kl, kl+ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
-#endif
- return LAPACKE_sgbtrs_work( matrix_order, trans, n, kl, ku, nrhs, ab, ldab,
- ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sgbtrs_work.c b/netlib/LAPACKE/lapacke_sgbtrs_work.c
deleted file mode 100644
index 220600f..0000000
--- a/netlib/LAPACKE/lapacke_sgbtrs_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgbtrs( &trans, &n, &kl, &ku, &nrhs, ab, &ldab, ipiv, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,2*kl+ku+1);
- lapack_int ldb_t = MAX(1,n);
- float* ab_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sgb_trans( matrix_order, n, n, kl, kl+ku, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgbtrs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t,
- &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sge_nancheck.c b/netlib/LAPACKE/lapacke_sge_nancheck.c
deleted file mode 100644
index 6c0401c..0000000
--- a/netlib/LAPACKE/lapacke_sge_nancheck.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_sge_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const float *a,
- lapack_int lda )
-{
- lapack_int i, j;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- for( j = 0; j < n; j++ ) {
- for( i = 0; i < MIN( m, lda ); i++ ) {
- if( LAPACK_SISNAN( a[i+(size_t)j*lda] ) )
- return (lapack_logical) 1;
- }
- }
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- for( i = 0; i < m; i++ ) {
- for( j = 0; j < MIN( n, lda ); j++ ) {
- if( LAPACK_SISNAN( a[(size_t)i*lda+j] ) )
- return (lapack_logical) 1;
- }
- }
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_sge_trans.c b/netlib/LAPACKE/lapacke_sge_trans.c
deleted file mode 100644
index 6af9484..0000000
--- a/netlib/LAPACKE/lapacke_sge_trans.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input general matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_sge_trans( int matrix_order, lapack_int m, lapack_int n,
- const float* in, lapack_int ldin,
- float* out, lapack_int ldout )
-{
- lapack_int i, j, x, y;
-
- if( in == NULL || out == NULL ) return;
-
- if( matrix_order == LAPACK_COL_MAJOR ) {
- x = n;
- y = m;
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- x = m;
- y = n;
- } else {
- /* Unknown input layout */
- return;
- }
-
- /* In case of incorrect m, n, ldin or ldout the function does nothing */
- for( i = 0; i < MIN( y, ldin ); i++ ) {
- for( j = 0; j < MIN( x, ldout ); j++ ) {
- out[ (size_t)i*ldout + j ] = in[ (size_t)j*ldin + i ];
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_sgebak.c b/netlib/LAPACKE/lapacke_sgebak.c
deleted file mode 100644
index 8bdbb18..0000000
--- a/netlib/LAPACKE/lapacke_sgebak.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgebak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* scale,
- lapack_int m, float* v, lapack_int ldv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgebak", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, scale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, m, v, ldv ) ) {
- return -9;
- }
-#endif
- return LAPACKE_sgebak_work( matrix_order, job, side, n, ilo, ihi, scale, m,
- v, ldv );
-}
diff --git a/netlib/LAPACKE/lapacke_sgebak_work.c b/netlib/LAPACKE/lapacke_sgebak_work.c
deleted file mode 100644
index 89f3561..0000000
--- a/netlib/LAPACKE/lapacke_sgebak_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgebak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* scale, lapack_int m, float* v,
- lapack_int ldv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v, &ldv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldv_t = MAX(1,n);
- float* v_t = NULL;
- /* Check leading dimension(s) */
- if( ldv < m ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgebak_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv );
- /* Release memory and exit */
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgebak_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgebak_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgebal.c b/netlib/LAPACKE/lapacke_sgebal.c
deleted file mode 100644
index 7e415fb..0000000
--- a/netlib/LAPACKE/lapacke_sgebal.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgebal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgebal( int matrix_order, char job, lapack_int n, float* a,
- lapack_int lda, lapack_int* ilo, lapack_int* ihi,
- float* scale )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgebal", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- }
-#endif
- return LAPACKE_sgebal_work( matrix_order, job, n, a, lda, ilo, ihi, scale );
-}
diff --git a/netlib/LAPACKE/lapacke_sgebal_work.c b/netlib/LAPACKE/lapacke_sgebal_work.c
deleted file mode 100644
index 6289637..0000000
--- a/netlib/LAPACKE/lapacke_sgebal_work.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgebal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgebal_work( int matrix_order, char job, lapack_int n,
- float* a, lapack_int lda, lapack_int* ilo,
- lapack_int* ihi, float* scale )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgebal( &job, &n, a, &lda, ilo, ihi, scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgebal_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- LAPACKE_free( a_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgebal_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgebal_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgebrd.c b/netlib/LAPACKE/lapacke_sgebrd.c
deleted file mode 100644
index 05a7d06..0000000
--- a/netlib/LAPACKE/lapacke_sgebrd.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgebrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgebrd( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tauq, float* taup )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgebrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgebrd_work( matrix_order, m, n, a, lda, d, e, tauq, taup,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgebrd_work( matrix_order, m, n, a, lda, d, e, tauq, taup,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgebrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgebrd_work.c b/netlib/LAPACKE/lapacke_sgebrd_work.c
deleted file mode 100644
index 085b94f..0000000
--- a/netlib/LAPACKE/lapacke_sgebrd_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgebrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tauq, float* taup, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgebrd( &m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgebrd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgebrd( &m, &n, a, &lda_t, d, e, tauq, taup, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgebrd( &m, &n, a_t, &lda_t, d, e, tauq, taup, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgebrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgebrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgecon.c b/netlib/LAPACKE/lapacke_sgecon.c
deleted file mode 100644
index aeec1d8..0000000
--- a/netlib/LAPACKE/lapacke_sgecon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgecon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgecon( int matrix_order, char norm, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgecon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgecon_work( matrix_order, norm, n, a, lda, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgecon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgecon_work.c b/netlib/LAPACKE/lapacke_sgecon_work.c
deleted file mode 100644
index c23a043..0000000
--- a/netlib/LAPACKE/lapacke_sgecon_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgecon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgecon_work( int matrix_order, char norm, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgecon( &norm, &n, a, &lda, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgecon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgecon( &norm, &n, a_t, &lda_t, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgecon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgecon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeequ.c b/netlib/LAPACKE/lapacke_sgeequ.c
deleted file mode 100644
index 5868c1e..0000000
--- a/netlib/LAPACKE/lapacke_sgeequ.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeequ( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgeequ_work( matrix_order, m, n, a, lda, r, c, rowcnd,
- colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_sgeequ_work.c b/netlib/LAPACKE/lapacke_sgeequ_work.c
deleted file mode 100644
index aaad098..0000000
--- a/netlib/LAPACKE/lapacke_sgeequ_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r,
- float* c, float* rowcnd, float* colcnd,
- float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeequ( &m, &n, a, &lda, r, c, rowcnd, colcnd, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeequb.c b/netlib/LAPACKE/lapacke_sgeequb.c
deleted file mode 100644
index 4de35e9..0000000
--- a/netlib/LAPACKE/lapacke_sgeequb.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeequb( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgeequb_work( matrix_order, m, n, a, lda, r, c, rowcnd,
- colcnd, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_sgeequb_work.c b/netlib/LAPACKE/lapacke_sgeequb_work.c
deleted file mode 100644
index 20f22c4..0000000
--- a/netlib/LAPACKE/lapacke_sgeequb_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r,
- float* c, float* rowcnd, float* colcnd,
- float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeequb( &m, &n, a, &lda, r, c, rowcnd, colcnd, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeequb( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgees.c b/netlib/LAPACKE/lapacke_sgees.c
deleted file mode 100644
index afcc05d..0000000
--- a/netlib/LAPACKE/lapacke_sgees.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgees
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgees( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, lapack_int n, float* a,
- lapack_int lda, lapack_int* sdim, float* wr,
- float* wi, float* vs, lapack_int ldvs )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgees", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sgees_work( matrix_order, jobvs, sort, select, n, a, lda,
- sdim, wr, wi, vs, ldvs, &work_query, lwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgees_work( matrix_order, jobvs, sort, select, n, a, lda,
- sdim, wr, wi, vs, ldvs, work, lwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgees", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgees_work.c b/netlib/LAPACKE/lapacke_sgees_work.c
deleted file mode 100644
index 7541e9b..0000000
--- a/netlib/LAPACKE/lapacke_sgees_work.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgees
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, lapack_int n, float* a,
- lapack_int lda, lapack_int* sdim, float* wr,
- float* wi, float* vs, lapack_int ldvs,
- float* work, lapack_int lwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgees( &jobvs, &sort, select, &n, a, &lda, sdim, wr, wi, vs,
- &ldvs, work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvs_t = MAX(1,n);
- float* a_t = NULL;
- float* vs_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgees_work", info );
- return info;
- }
- if( ldvs < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sgees_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgees( &jobvs, &sort, select, &n, a, &lda_t, sdim, wr, wi,
- vs, &ldvs_t, work, &lwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- vs_t = (float*)LAPACKE_malloc( sizeof(float) * ldvs_t * MAX(1,n) );
- if( vs_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, wr, wi,
- vs_t, &ldvs_t, work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_free( vs_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgees_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgees_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeesx.c b/netlib/LAPACKE/lapacke_sgeesx.c
deleted file mode 100644
index 2a53772..0000000
--- a/netlib/LAPACKE/lapacke_sgeesx.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, char sense, lapack_int n,
- float* a, lapack_int lda, lapack_int* sdim,
- float* wr, float* wi, float* vs, lapack_int ldvs,
- float* rconde, float* rcondv )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeesx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeesx_work( matrix_order, jobvs, sort, select, sense, n, a,
- lda, sdim, wr, wi, vs, ldvs, rconde, rcondv,
- &work_query, lwork, &iwork_query, liwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeesx_work( matrix_order, jobvs, sort, select, sense, n, a,
- lda, sdim, wr, wi, vs, ldvs, rconde, rcondv,
- work, lwork, iwork, liwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeesx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeesx_work.c b/netlib/LAPACKE/lapacke_sgeesx_work.c
deleted file mode 100644
index bbba80a..0000000
--- a/netlib/LAPACKE/lapacke_sgeesx_work.c
+++ /dev/null
@@ -1,119 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, char sense,
- lapack_int n, float* a, lapack_int lda,
- lapack_int* sdim, float* wr, float* wi,
- float* vs, lapack_int ldvs, float* rconde,
- float* rcondv, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeesx( &jobvs, &sort, select, &sense, &n, a, &lda, sdim, wr, wi,
- vs, &ldvs, rconde, rcondv, work, &lwork, iwork, &liwork,
- bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvs_t = MAX(1,n);
- float* a_t = NULL;
- float* vs_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgeesx_work", info );
- return info;
- }
- if( ldvs < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sgeesx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sgeesx( &jobvs, &sort, select, &sense, &n, a, &lda_t, sdim,
- wr, wi, vs, &ldvs_t, rconde, rcondv, work, &lwork,
- iwork, &liwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- vs_t = (float*)LAPACKE_malloc( sizeof(float) * ldvs_t * MAX(1,n) );
- if( vs_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeesx( &jobvs, &sort, select, &sense, &n, a_t, &lda_t, sdim, wr,
- wi, vs_t, &ldvs_t, rconde, rcondv, work, &lwork, iwork,
- &liwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvs, 'v' ) ) {
- LAPACKE_free( vs_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeesx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeesx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeev.c b/netlib/LAPACKE/lapacke_sgeev.c
deleted file mode 100644
index 9f17d73..0000000
--- a/netlib/LAPACKE/lapacke_sgeev.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* wr,
- float* wi, float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeev_work( matrix_order, jobvl, jobvr, n, a, lda, wr, wi,
- vl, ldvl, vr, ldvr, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeev_work( matrix_order, jobvl, jobvr, n, a, lda, wr, wi,
- vl, ldvl, vr, ldvr, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeev_work.c b/netlib/LAPACKE/lapacke_sgeev_work.c
deleted file mode 100644
index e201703..0000000
--- a/netlib/LAPACKE/lapacke_sgeev_work.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda,
- float* wr, float* wi, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeev( &jobvl, &jobvr, &n, a, &lda, wr, wi, vl, &ldvl, vr, &ldvr,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* a_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgeev_work", info );
- return info;
- }
- if( ldvl < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgeev_work", info );
- return info;
- }
- if( ldvr < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sgeev_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgeev( &jobvl, &jobvr, &n, a, &lda_t, wr, wi, vl, &ldvl_t,
- vr, &ldvr_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,n) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,n) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeev( &jobvl, &jobvr, &n, a_t, &lda_t, wr, wi, vl_t, &ldvl_t,
- vr_t, &ldvr_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeevx.c b/netlib/LAPACKE/lapacke_sgeevx.c
deleted file mode 100644
index 77c18a1..0000000
--- a/netlib/LAPACKE/lapacke_sgeevx.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* wr, float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- iwork = (lapack_int*)
- LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*n-2) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi,
- scale, abnrm, rconde, rcondv, &work_query,
- lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi,
- scale, abnrm, rconde, rcondv, work, lwork,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeevx_work.c b/netlib/LAPACKE/lapacke_sgeevx_work.c
deleted file mode 100644
index 115221b..0000000
--- a/netlib/LAPACKE/lapacke_sgeevx_work.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* wr, float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv,
- float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda, wr, wi, vl,
- &ldvl, vr, &ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* a_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgeevx_work", info );
- return info;
- }
- if( ldvl < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sgeevx_work", info );
- return info;
- }
- if( ldvr < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sgeevx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda_t, wr,
- wi, vl, &ldvl_t, vr, &ldvr_t, ilo, ihi, scale, abnrm,
- rconde, rcondv, work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,n) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,n) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, wr, wi,
- vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm,
- rconde, rcondv, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgehrd.c b/netlib/LAPACKE/lapacke_sgehrd.c
deleted file mode 100644
index 56b6ef7..0000000
--- a/netlib/LAPACKE/lapacke_sgehrd.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgehrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgehrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgehrd_work( matrix_order, n, ilo, ihi, a, lda, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgehrd_work( matrix_order, n, ilo, ihi, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgehrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgehrd_work.c b/netlib/LAPACKE/lapacke_sgehrd_work.c
deleted file mode 100644
index 8594f25..0000000
--- a/netlib/LAPACKE/lapacke_sgehrd_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgehrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- float* tau, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgehrd( &n, &ilo, &ihi, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgehrd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgehrd( &n, &ilo, &ihi, a, &lda_t, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgehrd( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgehrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgehrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgejsv.c b/netlib/LAPACKE/lapacke_sgejsv.c
deleted file mode 100644
index 249023b..0000000
--- a/netlib/LAPACKE/lapacke_sgejsv.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgejsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgejsv( int matrix_order, char joba, char jobu, char jobv,
- char jobr, char jobt, char jobp, lapack_int m,
- lapack_int n, float* a, lapack_int lda, float* sva,
- float* u, lapack_int ldu, float* v, lapack_int ldv,
- float* stat, lapack_int* istat )
-{
- lapack_int info = 0;
- lapack_int lwork = (!( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ||
- LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ||
- LAPACKE_lsame( joba, 'e' ) ||
- LAPACKE_lsame( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) :
- ( (!( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ||
- LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- ( LAPACKE_lsame( joba, 'e' ) ||
- LAPACKE_lsame( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) :
- ( ( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) &&
- (!( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) ) ? MAX(7,2*n+m) :
- ( ( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- (!( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) ) ? MAX(7,2*n+m) :
- ( ( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) &&
- ( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- !LAPACKE_lsame( jobv, 'j' ) ? MAX(1,6*n+2*n*n) :
- ( ( LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'f' ) ) &&
- ( LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'j' ) ) &&
- LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) :
- 1) ) ) ) ) );
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int i;
- lapack_int nu, nv;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgejsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nu, n, u, ldu ) ) {
- return -13;
- }
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nv, n, v, ldv ) ) {
- return -15;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+3*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgejsv_work( matrix_order, joba, jobu, jobv, jobr, jobt,
- jobp, m, n, a, lda, sva, u, ldu, v, ldv, work,
- lwork, iwork );
- /* Backup significant data from working array(s) */
- for( i=0; i<7; i++ ) {
- stat[i] = work[i];
- }
- for( i=0; i<3; i++ ) {
- istat[i] = iwork[i];
- }
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgejsv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgejsv_work.c b/netlib/LAPACKE/lapacke_sgejsv_work.c
deleted file mode 100644
index f090d5e..0000000
--- a/netlib/LAPACKE/lapacke_sgejsv_work.c
+++ /dev/null
@@ -1,147 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgejsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgejsv_work( int matrix_order, char joba, char jobu,
- char jobv, char jobr, char jobt, char jobp,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* sva, float* u,
- lapack_int ldu, float* v, lapack_int ldv,
- float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a,
- &lda, sva, u, &ldu, v, &ldv, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- lapack_int nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- lapack_int lda_t = MAX(1,m);
- lapack_int ldu_t = MAX(1,nu);
- lapack_int ldv_t = MAX(1,nv);
- float* a_t = NULL;
- float* u_t = NULL;
- float* v_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgejsv_work", info );
- return info;
- }
- if( ldu < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sgejsv_work", info );
- return info;
- }
- if( ldv < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_sgejsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,n) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- LAPACKE_sge_trans( matrix_order, nu, n, u, ldu, u_t, ldu_t );
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- LAPACKE_sge_trans( matrix_order, nv, n, v, ldv, v_t, ldv_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a_t,
- &lda_t, sva, u_t, &ldu_t, v_t, &ldv_t, work, &lwork,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nu, n, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) ||
- LAPACKE_lsame( jobv, 'w' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) ||
- LAPACKE_lsame( jobu, 'w' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgejsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgejsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelq2.c b/netlib/LAPACKE/lapacke_sgelq2.c
deleted file mode 100644
index 233c085..0000000
--- a/netlib/LAPACKE/lapacke_sgelq2.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgelq2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelq2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgelq2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgelq2_work( matrix_order, m, n, a, lda, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelq2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelq2_work.c b/netlib/LAPACKE/lapacke_sgelq2_work.c
deleted file mode 100644
index f4762fb..0000000
--- a/netlib/LAPACKE/lapacke_sgelq2_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgelq2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgelq2( &m, &n, a, &lda, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgelq2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgelq2( &m, &n, a_t, &lda_t, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelq2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgelq2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelqf.c b/netlib/LAPACKE/lapacke_sgelqf.c
deleted file mode 100644
index 94abbbf..0000000
--- a/netlib/LAPACKE/lapacke_sgelqf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgelqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelqf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgelqf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgelqf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgelqf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelqf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelqf_work.c b/netlib/LAPACKE/lapacke_sgelqf_work.c
deleted file mode 100644
index 7aebc18..0000000
--- a/netlib/LAPACKE/lapacke_sgelqf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgelqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgelqf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgelqf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgelqf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgelqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelqf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgelqf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgels.c b/netlib/LAPACKE/lapacke_sgels.c
deleted file mode 100644
index 18809f9..0000000
--- a/netlib/LAPACKE/lapacke_sgels.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgels
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgels", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgels_work( matrix_order, trans, m, n, nrhs, a, lda, b, ldb,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgels_work( matrix_order, trans, m, n, nrhs, a, lda, b, ldb,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgels", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgels_work.c b/netlib/LAPACKE/lapacke_sgels_work.c
deleted file mode 100644
index 8d2bfc4..0000000
--- a/netlib/LAPACKE/lapacke_sgels_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgels
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgels( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgels_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgels_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgels( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgels( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgels_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgels_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelsd.c b/netlib/LAPACKE/lapacke_sgelsd.c
deleted file mode 100644
index dbcce67..0000000
--- a/netlib/LAPACKE/lapacke_sgelsd.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgelsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- /* Additional scalars declarations for work arrays */
- lapack_int liwork;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgelsd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgelsd_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, &work_query, lwork, &iwork_query );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgelsd_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelsd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelsd_work.c b/netlib/LAPACKE/lapacke_sgelsd_work.c
deleted file mode 100644
index 8ab278a..0000000
--- a/netlib/LAPACKE/lapacke_sgelsd_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgelsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* s, float rcond,
- lapack_int* rank, float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgelsd( &m, &n, &nrhs, a, &lda, b, &ldb, s, &rcond, rank, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgelsd_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgelsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgelsd( &m, &n, &nrhs, a, &lda_t, b, &ldb_t, s, &rcond, rank,
- work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgelsd( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelsd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgelsd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelss.c b/netlib/LAPACKE/lapacke_sgelss.c
deleted file mode 100644
index 9bf44d4..0000000
--- a/netlib/LAPACKE/lapacke_sgelss.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgelss
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgelss", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgelss_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgelss_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
- rcond, rank, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelss", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelss_work.c b/netlib/LAPACKE/lapacke_sgelss_work.c
deleted file mode 100644
index b671259..0000000
--- a/netlib/LAPACKE/lapacke_sgelss_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgelss
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* s, float rcond,
- lapack_int* rank, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgelss( &m, &n, &nrhs, a, &lda, b, &ldb, s, &rcond, rank, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgelss_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgelss_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgelss( &m, &n, &nrhs, a, &lda_t, b, &ldb_t, s, &rcond, rank,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgelss( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelss_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgelss_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelsy.c b/netlib/LAPACKE/lapacke_sgelsy.c
deleted file mode 100644
index 2a8e520..0000000
--- a/netlib/LAPACKE/lapacke_sgelsy.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgelsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgelsy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgelsy_work( matrix_order, m, n, nrhs, a, lda, b, ldb, jpvt,
- rcond, rank, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgelsy_work( matrix_order, m, n, nrhs, a, lda, b, ldb, jpvt,
- rcond, rank, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelsy", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgelsy_work.c b/netlib/LAPACKE/lapacke_sgelsy_work.c
deleted file mode 100644
index 07be400..0000000
--- a/netlib/LAPACKE/lapacke_sgelsy_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgelsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, lapack_int* jpvt,
- float rcond, lapack_int* rank, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgelsy( &m, &n, &nrhs, a, &lda, b, &ldb, jpvt, &rcond, rank,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,MAX(m,n));
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgelsy_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgelsy_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgelsy( &m, &n, &nrhs, a, &lda_t, b, &ldb_t, jpvt, &rcond,
- rank, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, MAX(m,n), nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgelsy( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, jpvt, &rcond,
- rank, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b,
- ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgelsy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgelsy_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgemqrt.c b/netlib/LAPACKE/lapacke_sgemqrt.c
deleted file mode 100644
index 38e055e..0000000
--- a/netlib/LAPACKE/lapacke_sgemqrt.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgemqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgemqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_order, ldt, nb, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) * MAX(1,nb) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgemqrt_work( matrix_order, side, trans, m, n, k, nb, v, ldv,
- t, ldt, c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgemqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgemqrt_work.c b/netlib/LAPACKE/lapacke_sgemqrt_work.c
deleted file mode 100644
index 44ad789..0000000
--- a/netlib/LAPACKE/lapacke_sgemqrt_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgemqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgemqrt( &side, &trans, &m, &n, &k, &nb, v, &ldv, t, &ldt, c,
- &ldc, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldc_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- lapack_int ldv_t = MAX(1,ldv);
- float* v_t = NULL;
- float* t_t = NULL;
- float* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info );
- return info;
- }
- if( ldt < nb ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info );
- return info;
- }
- if( ldv < k ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,k) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,nb) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
- LAPACKE_sge_trans( matrix_order, ldt, nb, t, ldt, t_t, ldt_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t,
- &ldt_t, c_t, &ldc_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqlf.c b/netlib/LAPACKE/lapacke_sgeqlf.c
deleted file mode 100644
index f728d66..0000000
--- a/netlib/LAPACKE/lapacke_sgeqlf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqlf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqlf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqlf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeqlf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqlf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqlf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqlf_work.c b/netlib/LAPACKE/lapacke_sgeqlf_work.c
deleted file mode 100644
index e4e13db..0000000
--- a/netlib/LAPACKE/lapacke_sgeqlf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqlf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqlf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqlf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgeqlf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqlf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqlf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqlf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqp3.c b/netlib/LAPACKE/lapacke_sgeqp3.c
deleted file mode 100644
index 88db945..0000000
--- a/netlib/LAPACKE/lapacke_sgeqp3.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqp3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqp3( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqp3", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeqp3_work( matrix_order, m, n, a, lda, jpvt, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqp3_work( matrix_order, m, n, a, lda, jpvt, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqp3", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqp3_work.c b/netlib/LAPACKE/lapacke_sgeqp3_work.c
deleted file mode 100644
index 02646ea..0000000
--- a/netlib/LAPACKE/lapacke_sgeqp3_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqp3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqp3( &m, &n, a, &lda, jpvt, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqp3_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgeqp3( &m, &n, a, &lda_t, jpvt, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqp3( &m, &n, a_t, &lda_t, jpvt, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqp3_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqp3_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqpf.c b/netlib/LAPACKE/lapacke_sgeqpf.c
deleted file mode 100644
index 93853dc..0000000
--- a/netlib/LAPACKE/lapacke_sgeqpf.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqpf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqpf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqpf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqpf_work( matrix_order, m, n, a, lda, jpvt, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqpf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqpf_work.c b/netlib/LAPACKE/lapacke_sgeqpf_work.c
deleted file mode 100644
index 081b26e..0000000
--- a/netlib/LAPACKE/lapacke_sgeqpf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqpf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqpf( &m, &n, a, &lda, jpvt, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqr2.c b/netlib/LAPACKE/lapacke_sgeqr2.c
deleted file mode 100644
index d9b84d0..0000000
--- a/netlib/LAPACKE/lapacke_sgeqr2.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqr2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqr2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqr2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqr2_work( matrix_order, m, n, a, lda, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqr2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqr2_work.c b/netlib/LAPACKE/lapacke_sgeqr2_work.c
deleted file mode 100644
index f84ae31..0000000
--- a/netlib/LAPACKE/lapacke_sgeqr2_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqr2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqr2( &m, &n, a, &lda, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqr2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqr2( &m, &n, a_t, &lda_t, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqr2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqr2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrf.c b/netlib/LAPACKE/lapacke_sgeqrf.c
deleted file mode 100644
index 50a3195..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeqrf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqrf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrf_work.c b/netlib/LAPACKE/lapacke_sgeqrf_work.c
deleted file mode 100644
index dad4870..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqrf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgeqrf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrfp.c b/netlib/LAPACKE/lapacke_sgeqrfp.c
deleted file mode 100644
index dc8ab6e..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrfp.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqrfp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrfp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgeqrfp_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqrfp_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrfp", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrfp_work.c b/netlib/LAPACKE/lapacke_sgeqrfp_work.c
deleted file mode 100644
index 534d482..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrfp_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqrfp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrfp( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqrfp_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgeqrfp( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrfp( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrfp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqrfp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrt.c b/netlib/LAPACKE/lapacke_sgeqrt.c
deleted file mode 100644
index f8a9ee8..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrt.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, float* a, lapack_int lda, float* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,nb) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgeqrt_work( matrix_order, m, n, nb, a, lda, t, ldt, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrt2.c b/netlib/LAPACKE/lapacke_sgeqrt2.c
deleted file mode 100644
index 5bc351a..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrt2.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t, lapack_int ldt )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgeqrt2_work( matrix_order, m, n, a, lda, t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrt2_work.c b/netlib/LAPACKE/lapacke_sgeqrt2_work.c
deleted file mode 100644
index 4101c8e..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrt2_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrt2( &m, &n, a, &lda, t, &ldt, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,n);
- float* a_t = NULL;
- float* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrt2( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrt3.c b/netlib/LAPACKE/lapacke_sgeqrt3.c
deleted file mode 100644
index ae417b8..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrt3.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgeqrt3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t, lapack_int ldt )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt3", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgeqrt3_work( matrix_order, m, n, a, lda, t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrt3_work.c b/netlib/LAPACKE/lapacke_sgeqrt3_work.c
deleted file mode 100644
index 78b380e..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrt3_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqrt3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrt3( &m, &n, a, &lda, t, &ldt, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,n);
- float* a_t = NULL;
- float* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgeqrt_work.c b/netlib/LAPACKE/lapacke_sgeqrt_work.c
deleted file mode 100644
index 78f6009..0000000
--- a/netlib/LAPACKE/lapacke_sgeqrt_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgeqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, float* a, lapack_int lda,
- float* t, lapack_int ldt, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrt( &m, &n, &nb, a, &lda, t, &ldt, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- float* a_t = NULL;
- float* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info );
- return info;
- }
- if( ldt < MIN(m,n) ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,MIN(m,n)) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgeqrt( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, ldt, MIN(m,n), t_t, ldt_t, t,
- ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgerfs.c b/netlib/LAPACKE/lapacke_sgerfs.c
deleted file mode 100644
index 51faead..0000000
--- a/netlib/LAPACKE/lapacke_sgerfs.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgerfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgerfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgerfs_work( matrix_order, trans, n, nrhs, a, lda, af, ldaf,
- ipiv, b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgerfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgerfs_work.c b/netlib/LAPACKE/lapacke_sgerfs_work.c
deleted file mode 100644
index d87c6db..0000000
--- a/netlib/LAPACKE/lapacke_sgerfs_work.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgerfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgerfs( &trans, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b, &ldb, x,
- &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* af_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgerqf.c b/netlib/LAPACKE/lapacke_sgerqf.c
deleted file mode 100644
index f008bfc..0000000
--- a/netlib/LAPACKE/lapacke_sgerqf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgerqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgerqf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgerqf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgerqf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgerqf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgerqf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgerqf_work.c b/netlib/LAPACKE/lapacke_sgerqf_work.c
deleted file mode 100644
index aec8c32..0000000
--- a/netlib/LAPACKE/lapacke_sgerqf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgerqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgerqf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgerqf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgerqf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgerqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgerqf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgerqf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesdd.c b/netlib/LAPACKE/lapacke_sgesdd.c
deleted file mode 100644
index 0958daf..0000000
--- a/netlib/LAPACKE/lapacke_sgesdd.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgesdd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, float* a, lapack_int lda, float* s,
- float* u, lapack_int ldu, float* vt,
- lapack_int ldvt )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgesdd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)
- LAPACKE_malloc( sizeof(lapack_int) * MAX(1,8*MIN(m,n)) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
- ldvt, &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
- ldvt, work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesdd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesdd_work.c b/netlib/LAPACKE/lapacke_sgesdd_work.c
deleted file mode 100644
index a002dd6..0000000
--- a/netlib/LAPACKE/lapacke_sgesdd_work.c
+++ /dev/null
@@ -1,152 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgesdd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, float* a, lapack_int lda,
- float* s, float* u, lapack_int ldu, float* vt,
- lapack_int ldvt, float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgesdd( &jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) ||
- LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? m : 1;
- lapack_int ncols_u = ( LAPACKE_lsame( jobz, 'a' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? m :
- ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1);
- lapack_int nrows_vt = ( LAPACKE_lsame( jobz, 'a' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? n :
- ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1);
- lapack_int lda_t = MAX(1,m);
- lapack_int ldu_t = MAX(1,nrows_u);
- lapack_int ldvt_t = MAX(1,nrows_vt);
- float* a_t = NULL;
- float* u_t = NULL;
- float* vt_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgesdd_work", info );
- return info;
- }
- if( ldu < ncols_u ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgesdd_work", info );
- return info;
- }
- if( ldvt < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgesdd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgesdd( &jobz, &m, &n, a, &lda_t, s, u, &ldu_t, vt, &ldvt_t,
- work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) {
- u_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) {
- vt_t = (float*)LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,n) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
- u, ldu );
- }
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt,
- ldvt );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) {
- LAPACKE_free( vt_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) ||
- ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesdd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgesdd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesv.c b/netlib/LAPACKE/lapacke_sgesv.c
deleted file mode 100644
index 5eaf38b..0000000
--- a/netlib/LAPACKE/lapacke_sgesv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* a, lapack_int lda, lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgesv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_sgesv_work( matrix_order, n, nrhs, a, lda, ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sgesv_work.c b/netlib/LAPACKE/lapacke_sgesv_work.c
deleted file mode 100644
index 89fa6ae..0000000
--- a/netlib/LAPACKE/lapacke_sgesv_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgesv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* a, lapack_int lda, lapack_int* ipiv,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgesv( &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgesv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgesv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgesv( &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgesv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesvd.c b/netlib/LAPACKE/lapacke_sgesvd.c
deleted file mode 100644
index 180ac59..0000000
--- a/netlib/LAPACKE/lapacke_sgesvd.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgesvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, float* a, lapack_int lda,
- float* s, float* u, lapack_int ldu, float* vt,
- lapack_int ldvt, float* superb )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int i;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgesvd_work( matrix_order, jobu, jobvt, m, n, a, lda, s, u,
- ldu, vt, ldvt, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgesvd_work( matrix_order, jobu, jobvt, m, n, a, lda, s, u,
- ldu, vt, ldvt, work, lwork );
- /* Backup significant data from working array(s) */
- for( i=0; i<MIN(m,n)-1; i++ ) {
- superb[i] = work[i+1];
- }
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesvd_work.c b/netlib/LAPACKE/lapacke_sgesvd_work.c
deleted file mode 100644
index 8093d21..0000000
--- a/netlib/LAPACKE/lapacke_sgesvd_work.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgesvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* s, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgesvd( &jobu, &jobvt, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) ||
- LAPACKE_lsame( jobu, 's' ) ) ? m : 1;
- lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m :
- ( LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1);
- lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'a' ) ? n :
- ( LAPACKE_lsame( jobvt, 's' ) ? MIN(m,n) : 1);
- lapack_int lda_t = MAX(1,m);
- lapack_int ldu_t = MAX(1,nrows_u);
- lapack_int ldvt_t = MAX(1,nrows_vt);
- float* a_t = NULL;
- float* u_t = NULL;
- float* vt_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
- return info;
- }
- if( ldu < ncols_u ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
- return info;
- }
- if( ldvt < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgesvd( &jobu, &jobvt, &m, &n, a, &lda_t, s, u, &ldu_t, vt,
- &ldvt_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
- u_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
- vt_t = (float*)LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,n) );
- if( vt_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgesvd( &jobu, &jobvt, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
- u, ldu );
- }
- if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt,
- ldvt );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
- LAPACKE_free( vt_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesvj.c b/netlib/LAPACKE/lapacke_sgesvj.c
deleted file mode 100644
index 2856a9d..0000000
--- a/netlib/LAPACKE/lapacke_sgesvj.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgesvj
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvj( int matrix_order, char joba, char jobu, char jobv,
- lapack_int m, lapack_int n, float* a, lapack_int lda,
- float* sva, lapack_int mv, float* v, lapack_int ldv,
- float* stat )
-{
- lapack_int info = 0;
- lapack_int lwork = MAX(6,m+n);
- float* work = NULL;
- lapack_int i;
- lapack_int nrows_v;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvj", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n :
- ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1);
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v, n, v, ldv ) ) {
- return -11;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work[0] = stat[0]; /* Significant if jobu = 'c' */
- /* Call middle-level interface */
- info = LAPACKE_sgesvj_work( matrix_order, joba, jobu, jobv, m, n, a, lda,
- sva, mv, v, ldv, work, lwork );
- /* Backup significant data from working array(s) */
- for( i=0; i<6; i++ ) {
- stat[i] = work[i];
- }
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvj", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesvj_work.c b/netlib/LAPACKE/lapacke_sgesvj_work.c
deleted file mode 100644
index eae725b..0000000
--- a/netlib/LAPACKE/lapacke_sgesvj_work.c
+++ /dev/null
@@ -1,113 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgesvj
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvj_work( int matrix_order, char joba, char jobu,
- char jobv, lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* sva, lapack_int mv,
- float* v, lapack_int ldv, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgesvj( &joba, &jobu, &jobv, &m, &n, a, &lda, sva, &mv, v, &ldv,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n :
- ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1);
- lapack_int lda_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,nrows_v);
- float* a_t = NULL;
- float* v_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgesvj_work", info );
- return info;
- }
- if( ldv < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sgesvj_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( jobv, 'a' ) ) {
- LAPACKE_sge_trans( matrix_order, nrows_v, n, v, ldv, v_t, ldv_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sgesvj( &joba, &jobu, &jobv, &m, &n, a_t, &lda_t, sva, &mv, v_t,
- &ldv_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v,
- ldv );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvj_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgesvj_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesvx.c b/netlib/LAPACKE/lapacke_sgesvx.c
deleted file mode 100644
index c26463a..0000000
--- a/netlib/LAPACKE/lapacke_sgesvx.c
+++ /dev/null
@@ -1,103 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgesvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, af, ldaf ) ) {
- return -8;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -13;
- }
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgesvx_work( matrix_order, fact, trans, n, nrhs, a, lda, af,
- ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond,
- ferr, berr, work, iwork );
- /* Backup significant data from working array(s) */
- *rpivot = work[0];
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgesvx_work.c b/netlib/LAPACKE/lapacke_sgesvx_work.c
deleted file mode 100644
index 54a07f1..0000000
--- a/netlib/LAPACKE/lapacke_sgesvx_work.c
+++ /dev/null
@@ -1,147 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgesvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgesvx( &fact, &trans, &n, &nrhs, a, &lda, af, &ldaf, ipiv,
- equed, r, c, b, &ldb, x, &ldx, rcond, ferr, berr, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* af_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sgesvx_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgesvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sgesvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sgesvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t );
- }
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgesvx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
- ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr,
- berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf );
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- }
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgesvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgesvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgetf2.c b/netlib/LAPACKE/lapacke_sgetf2.c
deleted file mode 100644
index c3dcc21..0000000
--- a/netlib/LAPACKE/lapacke_sgetf2.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgetf2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetf2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgetf2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgetf2_work( matrix_order, m, n, a, lda, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_sgetf2_work.c b/netlib/LAPACKE/lapacke_sgetf2_work.c
deleted file mode 100644
index c8057cb..0000000
--- a/netlib/LAPACKE/lapacke_sgetf2_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgetf2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgetf2( &m, &n, a, &lda, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgetf2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgetf2( &m, &n, a_t, &lda_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgetf2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgetf2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgetrf.c b/netlib/LAPACKE/lapacke_sgetrf.c
deleted file mode 100644
index d2e3e00..0000000
--- a/netlib/LAPACKE/lapacke_sgetrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgetrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetrf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgetrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgetrf_work( matrix_order, m, n, a, lda, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_sgetrf_work.c b/netlib/LAPACKE/lapacke_sgetrf_work.c
deleted file mode 100644
index 06c39e8..0000000
--- a/netlib/LAPACKE/lapacke_sgetrf_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgetrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgetrf( &m, &n, a, &lda, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sgetrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgetrf( &m, &n, a_t, &lda_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgetrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgetrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgetri.c b/netlib/LAPACKE/lapacke_sgetri.c
deleted file mode 100644
index 67c2d50..0000000
--- a/netlib/LAPACKE/lapacke_sgetri.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgetri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetri( int matrix_order, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgetri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -3;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgetri_work( matrix_order, n, a, lda, ipiv, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgetri_work( matrix_order, n, a, lda, ipiv, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgetri", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgetri_work.c b/netlib/LAPACKE/lapacke_sgetri_work.c
deleted file mode 100644
index 7b357c4..0000000
--- a/netlib/LAPACKE/lapacke_sgetri_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgetri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetri_work( int matrix_order, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgetri( &n, a, &lda, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_sgetri_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgetri( &n, a, &lda_t, ipiv, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgetri( &n, a_t, &lda_t, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgetri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgetri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgetrs.c b/netlib/LAPACKE/lapacke_sgetrs.c
deleted file mode 100644
index dfdac06..0000000
--- a/netlib/LAPACKE/lapacke_sgetrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgetrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgetrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_sgetrs_work( matrix_order, trans, n, nrhs, a, lda, ipiv, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sgetrs_work.c b/netlib/LAPACKE/lapacke_sgetrs_work.c
deleted file mode 100644
index 5cc2968..0000000
--- a/netlib/LAPACKE/lapacke_sgetrs_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgetrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgetrs( &trans, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgetrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sgetrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgetrs( &trans, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgetrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgetrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgg_nancheck.c b/netlib/LAPACKE/lapacke_sgg_nancheck.c
deleted file mode 100644
index 769f111..0000000
--- a/netlib/LAPACKE/lapacke_sgg_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_sgg_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const float *a,
- lapack_int lda )
-{
- return LAPACKE_sge_nancheck( matrix_order, m, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_sgg_trans.c b/netlib/LAPACKE/lapacke_sgg_trans.c
deleted file mode 100644
index da50837..0000000
--- a/netlib/LAPACKE/lapacke_sgg_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input general matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_sgg_trans( int matrix_order, lapack_int m, lapack_int n,
- const float* in, lapack_int ldin,
- float* out, lapack_int ldout )
-{
- LAPACKE_sge_trans( matrix_order, m, n, in, ldin, out, ldout );
-}
diff --git a/netlib/LAPACKE/lapacke_sggbak.c b/netlib/LAPACKE/lapacke_sggbak.c
deleted file mode 100644
index 722db16..0000000
--- a/netlib/LAPACKE/lapacke_sggbak.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggbak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* lscale,
- const float* rscale, lapack_int m, float* v,
- lapack_int ldv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggbak", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, lscale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, rscale, 1 ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, m, v, ldv ) ) {
- return -10;
- }
-#endif
- return LAPACKE_sggbak_work( matrix_order, job, side, n, ilo, ihi, lscale,
- rscale, m, v, ldv );
-}
diff --git a/netlib/LAPACKE/lapacke_sggbak_work.c b/netlib/LAPACKE/lapacke_sggbak_work.c
deleted file mode 100644
index ad6c287..0000000
--- a/netlib/LAPACKE/lapacke_sggbak_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggbak
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* lscale, const float* rscale,
- lapack_int m, float* v, lapack_int ldv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v, &ldv,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldv_t = MAX(1,n);
- float* v_t = NULL;
- /* Check leading dimension(s) */
- if( ldv < m ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sggbak_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t,
- &ldv_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv );
- /* Release memory and exit */
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggbak_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggbak_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggbal.c b/netlib/LAPACKE/lapacke_sggbal.c
deleted file mode 100644
index 27fea7e..0000000
--- a/netlib/LAPACKE/lapacke_sggbal.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggbal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggbal( int matrix_order, char job, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggbal", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -6;
- }
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) {
- lwork = MAX(1,6*n);
- } else {
- lwork = 1;
- }
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggbal_work( matrix_order, job, n, a, lda, b, ldb, ilo, ihi,
- lscale, rscale, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggbal", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggbal_work.c b/netlib/LAPACKE/lapacke_sggbal_work.c
deleted file mode 100644
index 505852a..0000000
--- a/netlib/LAPACKE/lapacke_sggbal_work.c
+++ /dev/null
@@ -1,126 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggbal
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggbal_work( int matrix_order, char job, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggbal( &job, &n, a, &lda, b, &ldb, ilo, ihi, lscale, rscale,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sggbal_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sggbal_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale,
- rscale, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_free( b_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- LAPACKE_free( a_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggbal_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggbal_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgges.c b/netlib/LAPACKE/lapacke_sgges.c
deleted file mode 100644
index ce6462a..0000000
--- a/netlib/LAPACKE/lapacke_sgges.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgges
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_S_SELECT3 selctg, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- lapack_int* sdim, float* alphar, float* alphai,
- float* beta, float* vsl, lapack_int ldvsl, float* vsr,
- lapack_int ldvsr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgges", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sgges_work( matrix_order, jobvsl, jobvsr, sort, selctg, n, a,
- lda, b, ldb, sdim, alphar, alphai, beta, vsl,
- ldvsl, vsr, ldvsr, &work_query, lwork, bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgges_work( matrix_order, jobvsl, jobvsr, sort, selctg, n, a,
- lda, b, ldb, sdim, alphar, alphai, beta, vsl,
- ldvsl, vsr, ldvsr, work, lwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgges", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgges_work.c b/netlib/LAPACKE/lapacke_sgges_work.c
deleted file mode 100644
index 056f013..0000000
--- a/netlib/LAPACKE/lapacke_sgges_work.c
+++ /dev/null
@@ -1,160 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgges
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* sdim, float* alphar,
- float* alphai, float* beta, float* vsl,
- lapack_int ldvsl, float* vsr, lapack_int ldvsr,
- float* work, lapack_int lwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgges( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda, b, &ldb,
- sdim, alphar, alphai, beta, vsl, &ldvsl, vsr, &ldvsr,
- work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvsl_t = MAX(1,n);
- lapack_int ldvsr_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* vsl_t = NULL;
- float* vsr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgges_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgges_work", info );
- return info;
- }
- if( ldvsl < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_sgges_work", info );
- return info;
- }
- if( ldvsr < n ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_sgges_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgges( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda_t, b,
- &ldb_t, sdim, alphar, alphai, beta, vsl, &ldvsl_t,
- vsr, &ldvsr_t, work, &lwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- vsl_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvsl_t * MAX(1,n) );
- if( vsl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- vsr_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvsr_t * MAX(1,n) );
- if( vsr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgges( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t,
- &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t,
- vsr_t, &ldvsr_t, work, &lwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl,
- ldvsl );
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr,
- ldvsr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_free( vsr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_free( vsl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgges_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgges_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggesx.c b/netlib/LAPACKE/lapacke_sggesx.c
deleted file mode 100644
index 6a85381..0000000
--- a/netlib/LAPACKE/lapacke_sggesx.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, char sense,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* sdim, float* alphar,
- float* alphai, float* beta, float* vsl,
- lapack_int ldvsl, float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggesx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sort, 's' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sggesx_work( matrix_order, jobvsl, jobvsr, sort, selctg,
- sense, n, a, lda, b, ldb, sdim, alphar, alphai,
- beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
- &work_query, lwork, &iwork_query, liwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggesx_work( matrix_order, jobvsl, jobvsr, sort, selctg,
- sense, n, a, lda, b, ldb, sdim, alphar, alphai,
- beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
- work, lwork, iwork, liwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- LAPACKE_free( iwork );
-exit_level_1:
- if( LAPACKE_lsame( sort, 's' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggesx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggesx_work.c b/netlib/LAPACKE/lapacke_sggesx_work.c
deleted file mode 100644
index e8f7704..0000000
--- a/netlib/LAPACKE/lapacke_sggesx_work.c
+++ /dev/null
@@ -1,165 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggesx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, char sense,
- lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, lapack_int* sdim,
- float* alphar, float* alphai, float* beta,
- float* vsl, lapack_int ldvsl, float* vsr,
- lapack_int ldvsr, float* rconde, float* rcondv,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a, &lda, b,
- &ldb, sdim, alphar, alphai, beta, vsl, &ldvsl, vsr,
- &ldvsr, rconde, rcondv, work, &lwork, iwork, &liwork,
- bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvsl_t = MAX(1,n);
- lapack_int ldvsr_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* vsl_t = NULL;
- float* vsr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sggesx_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sggesx_work", info );
- return info;
- }
- if( ldvsl < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sggesx_work", info );
- return info;
- }
- if( ldvsr < n ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_sggesx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a,
- &lda_t, b, &ldb_t, sdim, alphar, alphai, beta, vsl,
- &ldvsl_t, vsr, &ldvsr_t, rconde, rcondv, work,
- &lwork, iwork, &liwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- vsl_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvsl_t * MAX(1,n) );
- if( vsl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- vsr_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvsr_t * MAX(1,n) );
- if( vsr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a_t, &lda_t,
- b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t,
- vsr_t, &ldvsr_t, rconde, rcondv, work, &lwork, iwork,
- &liwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl,
- ldvsl );
- }
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr,
- ldvsr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvsr, 'v' ) ) {
- LAPACKE_free( vsr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvsl, 'v' ) ) {
- LAPACKE_free( vsl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggesx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggesx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggev.c b/netlib/LAPACKE/lapacke_sggev.c
deleted file mode 100644
index a0436ba..0000000
--- a/netlib/LAPACKE/lapacke_sggev.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sggev_work( matrix_order, jobvl, jobvr, n, a, lda, b, ldb,
- alphar, alphai, beta, vl, ldvl, vr, ldvr,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggev_work( matrix_order, jobvl, jobvr, n, a, lda, b, ldb,
- alphar, alphai, beta, vl, ldvl, vr, ldvr, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggev_work.c b/netlib/LAPACKE/lapacke_sggev_work.c
deleted file mode 100644
index 94abb14..0000000
--- a/netlib/LAPACKE/lapacke_sggev_work.c
+++ /dev/null
@@ -1,161 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggev( &jobvl, &jobvr, &n, a, &lda, b, &ldb, alphar, alphai,
- beta, vl, &ldvl, vr, &ldvr, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1;
- lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1;
- lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1;
- lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1;
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,nrows_vl);
- lapack_int ldvr_t = MAX(1,nrows_vr);
- float* a_t = NULL;
- float* b_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sggev_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sggev_work", info );
- return info;
- }
- if( ldvl < ncols_vl ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sggev_work", info );
- return info;
- }
- if( ldvr < ncols_vr ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sggev_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sggev( &jobvl, &jobvr, &n, a, &lda_t, b, &ldb_t, alphar,
- alphai, beta, vl, &ldvl_t, vr, &ldvr_t, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,ncols_vl) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,ncols_vr) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar,
- alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t,
- ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t,
- ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggevx.c b/netlib/LAPACKE/lapacke_sggevx.c
deleted file mode 100644
index d3084b0..0000000
--- a/netlib/LAPACKE/lapacke_sggevx.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm,
- float* rconde, float* rcondv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_logical* bwork = NULL;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- bwork = (lapack_logical*)
- LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
- if( bwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sggevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr,
- ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm,
- rconde, rcondv, &work_query, lwork, iwork,
- bwork );
- if( info != 0 ) {
- goto exit_level_2;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
- lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr,
- ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm,
- rconde, rcondv, work, lwork, iwork, bwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_1:
- if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) ||
- LAPACKE_lsame( sense, 'v' ) ) {
- LAPACKE_free( bwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggevx_work.c b/netlib/LAPACKE/lapacke_sggevx_work.c
deleted file mode 100644
index 71779a8..0000000
--- a/netlib/LAPACKE/lapacke_sggevx_work.c
+++ /dev/null
@@ -1,161 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta,
- float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale,
- float* abnrm, float* bbnrm, float* rconde,
- float* rcondv, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_logical* bwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda, b, &ldb,
- alphar, alphai, beta, vl, &ldvl, vr, &ldvr, ilo, ihi,
- lscale, rscale, abnrm, bbnrm, rconde, rcondv, work,
- &lwork, iwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sggevx_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sggevx_work", info );
- return info;
- }
- if( ldvl < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sggevx_work", info );
- return info;
- }
- if( ldvr < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sggevx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sggevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda_t, b,
- &ldb_t, alphar, alphai, beta, vl, &ldvl_t, vr,
- &ldvr_t, ilo, ihi, lscale, rscale, abnrm, bbnrm,
- rconde, rcondv, work, &lwork, iwork, bwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,n) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,n) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, b_t,
- &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t,
- &ldvr_t, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde,
- rcondv, work, &lwork, iwork, bwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
- }
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobvr, 'v' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobvl, 'v' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggglm.c b/netlib/LAPACKE/lapacke_sggglm.c
deleted file mode 100644
index d17e48e..0000000
--- a/netlib/LAPACKE/lapacke_sggglm.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggglm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* d, float* x, float* y )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggglm", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, p, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sggglm_work( matrix_order, n, m, p, a, lda, b, ldb, d, x, y,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggglm_work( matrix_order, n, m, p, a, lda, b, ldb, d, x, y,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggglm", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggglm_work.c b/netlib/LAPACKE/lapacke_sggglm_work.c
deleted file mode 100644
index 728f289..0000000
--- a/netlib/LAPACKE/lapacke_sggglm_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggglm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* d, float* x,
- float* y, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggglm( &n, &m, &p, a, &lda, b, &ldb, d, x, y, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sggglm_work", info );
- return info;
- }
- if( ldb < p ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sggglm_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sggglm( &n, &m, &p, a, &lda_t, b, &ldb_t, d, x, y, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,p) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, p, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggglm_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggglm_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgghrd.c b/netlib/LAPACKE/lapacke_sgghrd.c
deleted file mode 100644
index 73131e7..0000000
--- a/netlib/LAPACKE/lapacke_sgghrd.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgghrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* a, lapack_int lda, float* b, lapack_int ldb,
- float* q, lapack_int ldq, float* z, lapack_int ldz )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgghrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -13;
- }
- }
-#endif
- return LAPACKE_sgghrd_work( matrix_order, compq, compz, n, ilo, ihi, a, lda,
- b, ldb, q, ldq, z, ldz );
-}
diff --git a/netlib/LAPACKE/lapacke_sgghrd_work.c b/netlib/LAPACKE/lapacke_sgghrd_work.c
deleted file mode 100644
index 003ae4b..0000000
--- a/netlib/LAPACKE/lapacke_sgghrd_work.c
+++ /dev/null
@@ -1,150 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgghrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* q, lapack_int ldq,
- float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgghrd( &compq, &compz, &n, &ilo, &ihi, a, &lda, b, &ldb, q,
- &ldq, z, &ldz, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* q_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t,
- q_t, &ldq_t, z_t, &ldz_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgglse.c b/netlib/LAPACKE/lapacke_sgglse.c
deleted file mode 100644
index 3a62edb..0000000
--- a/netlib/LAPACKE/lapacke_sgglse.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgglse
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* c, float* d, float* x )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgglse", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( m, c, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( p, d, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sgglse_work( matrix_order, m, n, p, a, lda, b, ldb, c, d, x,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgglse_work( matrix_order, m, n, p, a, lda, b, ldb, c, d, x,
- work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgglse", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgglse_work.c b/netlib/LAPACKE/lapacke_sgglse_work.c
deleted file mode 100644
index 66630e4..0000000
--- a/netlib/LAPACKE/lapacke_sgglse_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgglse
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* c, float* d,
- float* x, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgglse( &m, &n, &p, a, &lda, b, &ldb, c, d, x, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sgglse_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgglse_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sgglse( &m, &n, &p, a, &lda_t, b, &ldb_t, c, d, x, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgglse( &m, &n, &p, a_t, &lda_t, b_t, &ldb_t, c, d, x, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgglse_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgglse_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggqrf.c b/netlib/LAPACKE/lapacke_sggqrf.c
deleted file mode 100644
index 8733bbf..0000000
--- a/netlib/LAPACKE/lapacke_sggqrf.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda, float* taua,
- float* b, lapack_int ldb, float* taub )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggqrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, p, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sggqrf_work( matrix_order, n, m, p, a, lda, taua, b, ldb,
- taub, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggqrf_work( matrix_order, n, m, p, a, lda, taua, b, ldb,
- taub, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggqrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggqrf_work.c b/netlib/LAPACKE/lapacke_sggqrf_work.c
deleted file mode 100644
index a6d2757..0000000
--- a/netlib/LAPACKE/lapacke_sggqrf_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggqrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda,
- float* taua, float* b, lapack_int ldb,
- float* taub, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggqrf( &n, &m, &p, a, &lda, taua, b, &ldb, taub, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sggqrf_work", info );
- return info;
- }
- if( ldb < p ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sggqrf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sggqrf( &n, &m, &p, a, &lda_t, taua, b, &ldb_t, taub, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,p) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, p, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggqrf( &n, &m, &p, a_t, &lda_t, taua, b_t, &ldb_t, taub, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggqrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggqrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggrqf.c b/netlib/LAPACKE/lapacke_sggrqf.c
deleted file mode 100644
index eab11bb..0000000
--- a/netlib/LAPACKE/lapacke_sggrqf.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggrqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda, float* taua,
- float* b, lapack_int ldb, float* taub )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggrqf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sggrqf_work( matrix_order, m, p, n, a, lda, taua, b, ldb,
- taub, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggrqf_work( matrix_order, m, p, n, a, lda, taua, b, ldb,
- taub, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggrqf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggrqf_work.c b/netlib/LAPACKE/lapacke_sggrqf_work.c
deleted file mode 100644
index b7985ee..0000000
--- a/netlib/LAPACKE/lapacke_sggrqf_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggrqf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda,
- float* taua, float* b, lapack_int ldb,
- float* taub, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggrqf( &m, &p, &n, a, &lda, taua, b, &ldb, taub, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sggrqf_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sggrqf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sggrqf( &m, &p, &n, a, &lda_t, taua, b, &ldb_t, taub, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggrqf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggrqf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggsvd.c b/netlib/LAPACKE/lapacke_sggsvd.c
deleted file mode 100644
index 582894e..0000000
--- a/netlib/LAPACKE/lapacke_sggsvd.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggsvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alpha, float* beta, float* u, lapack_int ldu,
- float* v, lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggsvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,MAX3(3*n,m,p)+n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggsvd_work( matrix_order, jobu, jobv, jobq, m, n, p, k, l,
- a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q,
- ldq, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggsvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggsvd_work.c b/netlib/LAPACKE/lapacke_sggsvd_work.c
deleted file mode 100644
index 281b6c4..0000000
--- a/netlib/LAPACKE/lapacke_sggsvd_work.c
+++ /dev/null
@@ -1,170 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggsvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alpha, float* beta,
- float* u, lapack_int ldu, float* v,
- lapack_int ldv, float* q, lapack_int ldq,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb,
- alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,p);
- float* a_t = NULL;
- float* b_t = NULL;
- float* u_t = NULL;
- float* v_t = NULL;
- float* q_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- return info;
- }
- if( ldu < m ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- return info;
- }
- if( ldv < p ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,p) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t,
- &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t,
- &ldq_t, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv );
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_4:
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggsvp.c b/netlib/LAPACKE/lapacke_sggsvp.c
deleted file mode 100644
index 90ff3a6..0000000
--- a/netlib/LAPACKE/lapacke_sggsvp.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sggsvp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l, float* u,
- lapack_int ldu, float* v, lapack_int ldv, float* q,
- lapack_int ldq )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* tau = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sggsvp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -13;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- tau = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( tau == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,MAX3(3*n,m,p)) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Call middle-level interface */
- info = LAPACKE_sggsvp_work( matrix_order, jobu, jobv, jobq, m, p, n, a, lda,
- b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q,
- ldq, iwork, tau, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_2:
- LAPACKE_free( tau );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggsvp", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sggsvp_work.c b/netlib/LAPACKE/lapacke_sggsvp_work.c
deleted file mode 100644
index 11bc7c0..0000000
--- a/netlib/LAPACKE/lapacke_sggsvp_work.c
+++ /dev/null
@@ -1,170 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sggsvp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l,
- float* u, lapack_int ldu, float* v,
- lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* iwork, float* tau, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sggsvp( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda, b, &ldb, &tola,
- &tolb, k, l, u, &ldu, v, &ldv, q, &ldq, iwork, tau, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,p);
- float* a_t = NULL;
- float* b_t = NULL;
- float* u_t = NULL;
- float* v_t = NULL;
- float* q_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- return info;
- }
- if( ldu < m ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- return info;
- }
- if( ldv < m ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sggsvp( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t,
- &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t,
- q_t, &ldq_t, iwork, tau, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv );
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_4:
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sggsvp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgt_nancheck.c b/netlib/LAPACKE/lapacke_sgt_nancheck.c
deleted file mode 100644
index ea4f763..0000000
--- a/netlib/LAPACKE/lapacke_sgt_nancheck.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_sgt_nancheck( lapack_int n,
- const float *dl,
- const float *d,
- const float *du )
-{
- return LAPACKE_s_nancheck( n-1, dl, 1 )
- || LAPACKE_s_nancheck( n , d, 1 )
- || LAPACKE_s_nancheck( n-1, du, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_sgtcon.c b/netlib/LAPACKE/lapacke_sgtcon.c
deleted file mode 100644
index f3818c5..0000000
--- a/netlib/LAPACKE/lapacke_sgtcon.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgtcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl,
- const float* d, const float* du, const float* du2,
- const lapack_int* ipiv, float anorm, float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgtcon_work( norm, n, dl, d, du, du2, ipiv, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgtcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgtcon_work.c b/netlib/LAPACKE/lapacke_sgtcon_work.c
deleted file mode 100644
index 97fab5a..0000000
--- a/netlib/LAPACKE/lapacke_sgtcon_work.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgtcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtcon_work( char norm, lapack_int n, const float* dl,
- const float* d, const float* du,
- const float* du2, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_sgtcon( &norm, &n, dl, d, du, du2, ipiv, &anorm, rcond, work, iwork,
- &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgtrfs.c b/netlib/LAPACKE/lapacke_sgtrfs.c
deleted file mode 100644
index 222a5cc..0000000
--- a/netlib/LAPACKE/lapacke_sgtrfs.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgtrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl, const float* d,
- const float* du, const float* dlf, const float* df,
- const float* duf, const float* du2,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgtrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -15;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgtrfs_work( matrix_order, trans, n, nrhs, dl, d, du, dlf,
- df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgtrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgtrfs_work.c b/netlib/LAPACKE/lapacke_sgtrfs_work.c
deleted file mode 100644
index d898f61..0000000
--- a/netlib/LAPACKE/lapacke_sgtrfs_work.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgtrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl,
- const float* d, const float* du,
- const float* dlf, const float* df,
- const float* duf, const float* du2,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b,
- &ldb, x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv,
- b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgtsv.c b/netlib/LAPACKE/lapacke_sgtsv.c
deleted file mode 100644
index f2b36f2..0000000
--- a/netlib/LAPACKE/lapacke_sgtsv.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgtsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* dl, float* d, float* du, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgtsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -6;
- }
-#endif
- return LAPACKE_sgtsv_work( matrix_order, n, nrhs, dl, d, du, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sgtsv_work.c b/netlib/LAPACKE/lapacke_sgtsv_work.c
deleted file mode 100644
index 097393d..0000000
--- a/netlib/LAPACKE/lapacke_sgtsv_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgtsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* dl, float* d, float* du, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgtsv( &n, &nrhs, dl, d, du, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sgtsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgtsv( &n, &nrhs, dl, d, du, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgtsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgtsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgtsvx.c b/netlib/LAPACKE/lapacke_sgtsvx.c
deleted file mode 100644
index decab1b..0000000
--- a/netlib/LAPACKE/lapacke_sgtsvx.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgtsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const float* dl,
- const float* d, const float* du, float* dlf,
- float* df, float* duf, float* du2, lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgtsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -10;
- }
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
- return -9;
- }
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -12;
- }
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
- return -11;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sgtsvx_work( matrix_order, fact, trans, n, nrhs, dl, d, du,
- dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond,
- ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgtsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgtsvx_work.c b/netlib/LAPACKE/lapacke_sgtsvx_work.c
deleted file mode 100644
index 8cbe4ae..0000000
--- a/netlib/LAPACKE/lapacke_sgtsvx_work.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgtsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const float* dl,
- const float* d, const float* du, float* dlf,
- float* df, float* duf, float* du2,
- lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2,
- ipiv, b, &ldb, x, &ldx, rcond, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2,
- ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgttrf.c b/netlib/LAPACKE/lapacke_sgttrf.c
deleted file mode 100644
index 3d418a5..0000000
--- a/netlib/LAPACKE/lapacke_sgttrf.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgttrf( lapack_int n, float* dl, float* d, float* du,
- float* du2, lapack_int* ipiv )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sgttrf_work( n, dl, d, du, du2, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_sgttrf_work.c b/netlib/LAPACKE/lapacke_sgttrf_work.c
deleted file mode 100644
index 4e70f3f..0000000
--- a/netlib/LAPACKE/lapacke_sgttrf_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgttrf_work( lapack_int n, float* dl, float* d, float* du,
- float* du2, lapack_int* ipiv )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_sgttrf( &n, dl, d, du, du2, ipiv, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sgttrs.c b/netlib/LAPACKE/lapacke_sgttrs.c
deleted file mode 100644
index 6c896a3..0000000
--- a/netlib/LAPACKE/lapacke_sgttrs.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sgttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl, const float* d,
- const float* du, const float* du2,
- const lapack_int* ipiv, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sgttrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -8;
- }
-#endif
- return LAPACKE_sgttrs_work( matrix_order, trans, n, nrhs, dl, d, du, du2,
- ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sgttrs_work.c b/netlib/LAPACKE/lapacke_sgttrs_work.c
deleted file mode 100644
index bf0f218..0000000
--- a/netlib/LAPACKE/lapacke_sgttrs_work.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl,
- const float* d, const float* du,
- const float* du2, const lapack_int* ipiv,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sgttrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sgttrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sgttrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_shgeqz.c b/netlib/LAPACKE/lapacke_shgeqz.c
deleted file mode 100644
index 749ca8f..0000000
--- a/netlib/LAPACKE/lapacke_shgeqz.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function shgeqz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_shgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* h, lapack_int ldh, float* t, lapack_int ldt,
- float* alphar, float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_shgeqz", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, h, ldh ) ) {
- return -8;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -15;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -17;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_shgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
- ldh, t, ldt, alphar, alphai, beta, q, ldq, z,
- ldz, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_shgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
- ldh, t, ldt, alphar, alphai, beta, q, ldq, z,
- ldz, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_shgeqz", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_shgeqz_work.c b/netlib/LAPACKE/lapacke_shgeqz_work.c
deleted file mode 100644
index aa59e43..0000000
--- a/netlib/LAPACKE/lapacke_shgeqz_work.c
+++ /dev/null
@@ -1,161 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function shgeqz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_shgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* h, lapack_int ldh,
- float* t, lapack_int ldt, float* alphar,
- float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_shgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h, &ldh, t, &ldt,
- alphar, alphai, beta, q, &ldq, z, &ldz, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldh_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldt_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* h_t = NULL;
- float* t_t = NULL;
- float* q_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldh < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_shgeqz_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_shgeqz_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_shgeqz_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_shgeqz_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_shgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h, &ldh_t, t,
- &ldt_t, alphar, alphai, beta, q, &ldq_t, z, &ldz_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- h_t = (float*)LAPACKE_malloc( sizeof(float) * ldh_t * MAX(1,n) );
- if( h_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
- LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_shgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h_t, &ldh_t, t_t,
- &ldt_t, alphar, alphai, beta, q_t, &ldq_t, z_t, &ldz_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( h_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_shgeqz_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_shgeqz_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_shs_nancheck.c b/netlib/LAPACKE/lapacke_shs_nancheck.c
deleted file mode 100644
index 45fce94..0000000
--- a/netlib/LAPACKE/lapacke_shs_nancheck.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_shs_nancheck( int matrix_order, lapack_int n,
- const float *a,
- lapack_int lda )
-{
- lapack_logical subdiag_nans;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- /* Check subdiagonal first */
- if( matrix_order == LAPACK_COL_MAJOR ) {
- subdiag_nans = LAPACKE_s_nancheck( n-1, &a[1], lda+1 );
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- subdiag_nans = LAPACKE_s_nancheck( n-1, &a[lda], lda+1 );
- } else {
- return (lapack_logical) 0;
- }
-
- /* Check upper triangular if subdiagonal has no NaNs. */
- return subdiag_nans || LAPACKE_str_nancheck( matrix_order, 'u', 'n',
- n, a, lda);
-}
diff --git a/netlib/LAPACKE/lapacke_shs_trans.c b/netlib/LAPACKE/lapacke_shs_trans.c
deleted file mode 100644
index 3b9d23f..0000000
--- a/netlib/LAPACKE/lapacke_shs_trans.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input Hessenberg matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_shs_trans( int matrix_order, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- if( in == NULL || out == NULL ) return;
-
- /* Convert subdiagonal first */
- if( matrix_order == LAPACK_COL_MAJOR ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1,
- &out[ldout], ldout+1 );
- } else if ( matrix_order == LAPACK_ROW_MAJOR ) {
- LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1,
- &out[1], ldout+1 );
- } else {
- return;
- }
-
- /* Convert upper triangular. */
- LAPACKE_str_trans( matrix_order, 'u', 'n', n, in, ldin, out, ldout);
-}
diff --git a/netlib/LAPACKE/lapacke_shsein.c b/netlib/LAPACKE/lapacke_shsein.c
deleted file mode 100644
index 76e2918..0000000
--- a/netlib/LAPACKE/lapacke_shsein.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function shsein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_shsein( int matrix_order, char job, char eigsrc, char initv,
- lapack_logical* select, lapack_int n, const float* h,
- lapack_int ldh, float* wr, const float* wi,
- float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_shsein", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -13;
- }
- }
- if( LAPACKE_s_nancheck( n, wi, 1 ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( n, wr, 1 ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) * MAX(1,n+2) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_shsein_work( matrix_order, job, eigsrc, initv, select, n, h,
- ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work,
- ifaill, ifailr );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_shsein", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_shsein_work.c b/netlib/LAPACKE/lapacke_shsein_work.c
deleted file mode 100644
index 24b6a9a..0000000
--- a/netlib/LAPACKE/lapacke_shsein_work.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function shsein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_shsein_work( int matrix_order, char job, char eigsrc,
- char initv, lapack_logical* select,
- lapack_int n, const float* h, lapack_int ldh,
- float* wr, const float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int* ifaill, lapack_int* ifailr )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_shsein( &job, &eigsrc, &initv, select, &n, h, &ldh, wr, wi, vl,
- &ldvl, vr, &ldvr, &mm, m, work, ifaill, ifailr, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldh_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* h_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldh < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_shsein_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_shsein_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_shsein_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- h_t = (float*)LAPACKE_malloc( sizeof(float) * ldh_t * MAX(1,n) );
- if( h_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
- if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) &&
- LAPACKE_lsame( initv, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) &&
- LAPACKE_lsame( initv, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_shsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, wr, wi,
- vl_t, &ldvl_t, vr_t, &ldvr_t, &mm, m, work, ifaill,
- ifailr, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
- ldvl );
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
- ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( h_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_shsein_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_shsein_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_shseqr.c b/netlib/LAPACKE/lapacke_shseqr.c
deleted file mode 100644
index fe29778..0000000
--- a/netlib/LAPACKE/lapacke_shseqr.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function shseqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_shseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi, float* h,
- lapack_int ldh, float* wr, float* wi, float* z,
- lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_shseqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -11;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_shseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh,
- wr, wi, z, ldz, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_shseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh,
- wr, wi, z, ldz, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_shseqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_shseqr_work.c b/netlib/LAPACKE/lapacke_shseqr_work.c
deleted file mode 100644
index 4b0b191..0000000
--- a/netlib/LAPACKE/lapacke_shseqr_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function shseqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_shseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* h, lapack_int ldh, float* wr, float* wi,
- float* z, lapack_int ldz, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h, &ldh, wr, wi, z, &ldz,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldh_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* h_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldh < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_shseqr_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_shseqr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h, &ldh_t, wr, wi, z,
- &ldz_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- h_t = (float*)LAPACKE_malloc( sizeof(float) * ldh_t * MAX(1,n) );
- if( h_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, wr, wi, z_t,
- &ldz_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh );
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( h_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_shseqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_shseqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slacpy.c b/netlib/LAPACKE/lapacke_slacpy.c
deleted file mode 100644
index b352485..0000000
--- a/netlib/LAPACKE/lapacke_slacpy.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slacpy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slacpy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- return LAPACKE_slacpy_work( matrix_order, uplo, m, n, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_slacpy_work.c b/netlib/LAPACKE/lapacke_slacpy_work.c
deleted file mode 100644
index 7471548..0000000
--- a/netlib/LAPACKE/lapacke_slacpy_work.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slacpy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slacpy( &uplo, &m, &n, a, &lda, b, &ldb );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,m);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_slacpy_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_slacpy_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slacpy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slacpy_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slag2d.c b/netlib/LAPACKE/lapacke_slag2d.c
deleted file mode 100644
index a215ca0..0000000
--- a/netlib/LAPACKE/lapacke_slag2d.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slag2d
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slag2d( int matrix_order, lapack_int m, lapack_int n,
- const float* sa, lapack_int ldsa, double* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slag2d", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, sa, ldsa ) ) {
- return -4;
- }
-#endif
- return LAPACKE_slag2d_work( matrix_order, m, n, sa, ldsa, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_slag2d_work.c b/netlib/LAPACKE/lapacke_slag2d_work.c
deleted file mode 100644
index 8a31aed..0000000
--- a/netlib/LAPACKE/lapacke_slag2d_work.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slag2d
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slag2d_work( int matrix_order, lapack_int m, lapack_int n,
- const float* sa, lapack_int ldsa, double* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slag2d( &m, &n, sa, &ldsa, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldsa_t = MAX(1,m);
- float* sa_t = NULL;
- double* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_slag2d_work", info );
- return info;
- }
- if( ldsa < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_slag2d_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- sa_t = (float*)LAPACKE_malloc( sizeof(float) * ldsa_t * MAX(1,n) );
- if( sa_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, sa, ldsa, sa_t, ldsa_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slag2d( &m, &n, sa_t, &ldsa_t, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_1:
- LAPACKE_free( sa_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slag2d_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slag2d_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slagge.c b/netlib/LAPACKE/lapacke_slagge.c
deleted file mode 100644
index d5baec6..0000000
--- a/netlib/LAPACKE/lapacke_slagge.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slagge
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- float* a, lapack_int lda, lapack_int* iseed )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slagge", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m+n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_slagge_work( matrix_order, m, n, kl, ku, d, a, lda, iseed,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slagge", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slagge_work.c b/netlib/LAPACKE/lapacke_slagge_work.c
deleted file mode 100644
index 25949b7..0000000
--- a/netlib/LAPACKE/lapacke_slagge_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slagge
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- float* a, lapack_int lda, lapack_int* iseed,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slagge( &m, &n, &kl, &ku, d, a, &lda, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_slagge_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call LAPACK function and adjust info */
- LAPACK_slagge( &m, &n, &kl, &ku, d, a_t, &lda_t, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slagge_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slagge_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slagsy.c b/netlib/LAPACKE/lapacke_slagsy.c
deleted file mode 100644
index 1dd9468..0000000
--- a/netlib/LAPACKE/lapacke_slagsy.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slagsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slagsy( int matrix_order, lapack_int n, lapack_int k,
- const float* d, float* a, lapack_int lda,
- lapack_int* iseed )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slagsy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_slagsy_work( matrix_order, n, k, d, a, lda, iseed, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slagsy", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slagsy_work.c b/netlib/LAPACKE/lapacke_slagsy_work.c
deleted file mode 100644
index da8ff40..0000000
--- a/netlib/LAPACKE/lapacke_slagsy_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slagsy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, float* a, lapack_int lda,
- lapack_int* iseed, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slagsy( &n, &k, d, a, &lda, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_slagsy_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call LAPACK function and adjust info */
- LAPACK_slagsy( &n, &k, d, a_t, &lda_t, iseed, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slagsy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slagsy_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slamch.c b/netlib/LAPACKE/lapacke_slamch.c
deleted file mode 100644
index 0f25b2a..0000000
--- a/netlib/LAPACKE/lapacke_slamch.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slamch
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slamch( char cmach )
-{
- return LAPACKE_slamch_work( cmach );
-}
diff --git a/netlib/LAPACKE/lapacke_slamch_work.c b/netlib/LAPACKE/lapacke_slamch_work.c
deleted file mode 100644
index ab4767a..0000000
--- a/netlib/LAPACKE/lapacke_slamch_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slamch
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slamch_work( char cmach )
-{
- lapack_int info = 0;
- float res;
- /* Call LAPACK function and adjust info */
- res = LAPACK_slamch( &cmach );
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slange.c b/netlib/LAPACKE/lapacke_slange.c
deleted file mode 100644
index 207fc83..0000000
--- a/netlib/LAPACKE/lapacke_slange.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slange
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const float* a, lapack_int lda )
-{
- lapack_int info = 0;
- float res = 0.;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slange", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( norm, 'i' ) ) {
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- res = LAPACKE_slange_work( matrix_order, norm, m, n, a, lda, work );
- /* Release memory and exit */
- if( LAPACKE_lsame( norm, 'i' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slange", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slange_work.c b/netlib/LAPACKE/lapacke_slange_work.c
deleted file mode 100644
index ceef0d4..0000000
--- a/netlib/LAPACKE/lapacke_slange_work.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slange
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* work )
-{
- lapack_int info = 0;
- float res = 0.;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- res = LAPACK_slange( &norm, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_slange_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_slange( &norm, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slange_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slange_work", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slansy.c b/netlib/LAPACKE/lapacke_slansy.c
deleted file mode 100644
index 105ce46..0000000
--- a/netlib/LAPACKE/lapacke_slansy.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slansy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slansy( int matrix_order, char norm, char uplo, lapack_int n,
- const float* a, lapack_int lda )
-{
- lapack_int info = 0;
- float res = 0.;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slansy", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- res = LAPACKE_slansy_work( matrix_order, norm, uplo, n, a, lda, work );
- /* Release memory and exit */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slansy", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slansy_work.c b/netlib/LAPACKE/lapacke_slansy_work.c
deleted file mode 100644
index d301194..0000000
--- a/netlib/LAPACKE/lapacke_slansy_work.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slansy
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* work )
-{
- lapack_int info = 0;
- float res = 0.;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- res = LAPACK_slansy( &norm, &uplo, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_slansy_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_slansy( &norm, &uplo, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slansy_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slansy_work", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slantr.c b/netlib/LAPACKE/lapacke_slantr.c
deleted file mode 100644
index d6a5120..0000000
--- a/netlib/LAPACKE/lapacke_slantr.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slantr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- float res = 0.;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slantr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- res = LAPACKE_slantr_work( matrix_order, norm, uplo, diag, m, n, a, lda,
- work );
- /* Release memory and exit */
- if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) ||
- LAPACKE_lsame( norm, '0' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slantr", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slantr_work.c b/netlib/LAPACKE/lapacke_slantr_work.c
deleted file mode 100644
index 2389468..0000000
--- a/netlib/LAPACKE/lapacke_slantr_work.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slantr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* work )
-{
- lapack_int info = 0;
- float res = 0.;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_slantr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_str_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slantr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slantr_work", info );
- }
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slapmr.c b/netlib/LAPACKE/lapacke_slapmr.c
deleted file mode 100644
index 456804b..0000000
--- a/netlib/LAPACKE/lapacke_slapmr.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slapmr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, float* x, lapack_int ldx,
- lapack_int* k )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slapmr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, x, ldx ) ) {
- return -5;
- }
-#endif
- return LAPACKE_slapmr_work( matrix_order, forwrd, m, n, x, ldx, k );
-}
diff --git a/netlib/LAPACKE/lapacke_slapmr_work.c b/netlib/LAPACKE/lapacke_slapmr_work.c
deleted file mode 100644
index f46d47a..0000000
--- a/netlib/LAPACKE/lapacke_slapmr_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slapmr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, float* x,
- lapack_int ldx, lapack_int* k )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slapmr( &forwrd, &m, &n, x, &ldx, k );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldx_t = MAX(1,m);
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldx < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_slapmr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,n) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slapmr( &forwrd, &m, &n, x_t, &ldx_t, k );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slapmr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slapmr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slapy2.c b/netlib/LAPACKE/lapacke_slapy2.c
deleted file mode 100644
index 8410862..0000000
--- a/netlib/LAPACKE/lapacke_slapy2.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slapy2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slapy2( float x, float y )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
-#endif
- return LAPACKE_slapy2_work( x, y );
-}
diff --git a/netlib/LAPACKE/lapacke_slapy2_work.c b/netlib/LAPACKE/lapacke_slapy2_work.c
deleted file mode 100644
index 00507b3..0000000
--- a/netlib/LAPACKE/lapacke_slapy2_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slapy2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slapy2_work( float x, float y )
-{
- float res = 0.;
- /* Call LAPACK function and adjust info */
- res = LAPACK_slapy2( &x, &y );
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slapy3.c b/netlib/LAPACKE/lapacke_slapy3.c
deleted file mode 100644
index c6eea25..0000000
--- a/netlib/LAPACKE/lapacke_slapy3.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slapy3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slapy3( float x, float y, float z )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( 1, &z, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_slapy3_work( x, y, z );
-}
diff --git a/netlib/LAPACKE/lapacke_slapy3_work.c b/netlib/LAPACKE/lapacke_slapy3_work.c
deleted file mode 100644
index 381c579..0000000
--- a/netlib/LAPACKE/lapacke_slapy3_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slapy3
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-float LAPACKE_slapy3_work( float x, float y, float z )
-{
- float res = 0.;
- /* Call LAPACK function and adjust info */
- res = LAPACK_slapy3( &x, &y, &z );
- return res;
-}
diff --git a/netlib/LAPACKE/lapacke_slarfb.c b/netlib/LAPACKE/lapacke_slarfb.c
deleted file mode 100644
index 6cf2959..0000000
--- a/netlib/LAPACKE/lapacke_slarfb.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slarfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
- float* work = NULL;
- lapack_int ncols_v, nrows_v;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slarfb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -13;
- }
- if( LAPACKE_sge_nancheck( matrix_order, k, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_str_nancheck( matrix_order, 'l', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v-k, ncols_v, &v[k*ldv],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
- return -8;
- }
- if( LAPACKE_str_nancheck( matrix_order, 'u', 'u', k,
- &v[(nrows_v-k)*ldv], ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v-k, ncols_v, v, ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_str_nancheck( matrix_order, 'u', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v, ncols_v-k, &v[k],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
- return -8;
- }
- if( LAPACKE_str_nancheck( matrix_order, 'l', 'u', k, &v[ncols_v-k],
- ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v, ncols_v-k, v, ldv ) )
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * ldwork * MAX(1,k) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_slarfb_work( matrix_order, side, trans, direct, storev, m, n,
- k, v, ldv, t, ldt, c, ldc, work, ldwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slarfb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slarfb_work.c b/netlib/LAPACKE/lapacke_slarfb_work.c
deleted file mode 100644
index bbdfef3..0000000
--- a/netlib/LAPACKE/lapacke_slarfb_work.c
+++ /dev/null
@@ -1,154 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slarfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* c, lapack_int ldc, float* work,
- lapack_int ldwork )
-{
- lapack_int info = 0;
- lapack_int nrows_v, ncols_v;
- lapack_int ldc_t, ldt_t, ldv_t;
- float *v_t = NULL, *t_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slarfb( &side, &trans, &direct, &storev, &m, &n, &k, v, &ldv, t,
- &ldt, c, &ldc, work, &ldwork );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- ldc_t = MAX(1,m);
- ldt_t = MAX(1,k);
- ldv_t = MAX(1,nrows_v);
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
- return info;
- }
- if( ldt < k ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
- return info;
- }
- if( ldv < ncols_v ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,ncols_v) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,k) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- LAPACKE_str_trans( matrix_order, 'l', 'u', k, v, ldv, v_t, ldv_t );
- LAPACKE_sge_trans( matrix_order, nrows_v-k, ncols_v, &v[k*ldv], ldv,
- &v_t[k], ldv_t );
- } else if( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_slarfb_work", -8 );
- return -8;
- }
- LAPACKE_str_trans( matrix_order, 'u', 'u', k, &v[(nrows_v-k)*ldv],
- ldv, &v_t[nrows_v-k], ldv_t );
- LAPACKE_sge_trans( matrix_order, nrows_v-k, ncols_v, v, ldv, v_t,
- ldv_t );
- } else if( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( direct, 'f' ) ) {
- LAPACKE_str_trans( matrix_order, 'u', 'u', k, v, ldv, v_t, ldv_t );
- LAPACKE_sge_trans( matrix_order, nrows_v, ncols_v-k, &v[k], ldv,
- &v_t[k*ldv_t], ldv_t );
- } else if( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_slarfb_work", -8 );
- return -8;
- }
- LAPACKE_str_trans( matrix_order, 'l', 'u', k, &v[ncols_v-k], ldv,
- &v_t[(ncols_v-k)*ldv_t], ldv_t );
- LAPACKE_sge_trans( matrix_order, nrows_v, ncols_v-k, v, ldv, v_t,
- ldv_t );
- }
- LAPACKE_sge_trans( matrix_order, k, k, t, ldt, t_t, ldt_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t,
- t_t, &ldt_t, c_t, &ldc_t, work, &ldwork );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slarfg.c b/netlib/LAPACKE/lapacke_slarfg.c
deleted file mode 100644
index f5a4eb1..0000000
--- a/netlib/LAPACKE/lapacke_slarfg.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slarfg
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarfg( lapack_int n, float* alpha, float* x,
- lapack_int incx, float* tau )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, alpha, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
- return -3;
- }
-#endif
- return LAPACKE_slarfg_work( n, alpha, x, incx, tau );
-}
diff --git a/netlib/LAPACKE/lapacke_slarfg_work.c b/netlib/LAPACKE/lapacke_slarfg_work.c
deleted file mode 100644
index 2fd23bf..0000000
--- a/netlib/LAPACKE/lapacke_slarfg_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slarfg
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarfg_work( lapack_int n, float* alpha, float* x,
- lapack_int incx, float* tau )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_slarfg( &n, alpha, x, &incx, tau );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slarft.c b/netlib/LAPACKE/lapacke_slarft.c
deleted file mode 100644
index 0573783..0000000
--- a/netlib/LAPACKE/lapacke_slarft.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slarft
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* tau, float* t,
- lapack_int ldt )
-{
- lapack_int ncols_v, nrows_v;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slarft", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_v, ncols_v, v, ldv ) ) {
- return -6;
- }
-#endif
- return LAPACKE_slarft_work( matrix_order, direct, storev, n, k, v, ldv, tau,
- t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_slarft_work.c b/netlib/LAPACKE/lapacke_slarft_work.c
deleted file mode 100644
index 7579fcd..0000000
--- a/netlib/LAPACKE/lapacke_slarft_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slarft
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* tau, float* t,
- lapack_int ldt )
-{
- lapack_int info = 0;
- lapack_int nrows_v, ncols_v;
- lapack_int ldt_t, ldv_t;
- float *v_t = NULL, *t_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slarft( &direct, &storev, &n, &k, v, &ldv, tau, t, &ldt );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- ldt_t = MAX(1,k);
- ldv_t = MAX(1,nrows_v);
- /* Check leading dimension(s) */
- if( ldt < k ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_slarft_work", info );
- return info;
- }
- if( ldv < ncols_v ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_slarft_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,ncols_v) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,k) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, nrows_v, ncols_v, v, ldv, v_t, ldv_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t,
- &ldt_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slarft_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slarft_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slarfx.c b/netlib/LAPACKE/lapacke_slarfx.c
deleted file mode 100644
index c932e51..0000000
--- a/netlib/LAPACKE/lapacke_slarfx.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slarfx
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const float* v, float tau, float* c,
- lapack_int ldc, float* work )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slarfx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &tau, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( m, v, 1 ) ) {
- return -5;
- }
-#endif
- return LAPACKE_slarfx_work( matrix_order, side, m, n, v, tau, c, ldc,
- work );
-}
diff --git a/netlib/LAPACKE/lapacke_slarfx_work.c b/netlib/LAPACKE/lapacke_slarfx_work.c
deleted file mode 100644
index 8880c03..0000000
--- a/netlib/LAPACKE/lapacke_slarfx_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slarfx
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const float* v, float tau,
- float* c, lapack_int ldc, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slarfx( &side, &m, &n, v, &tau, c, &ldc, work );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldc_t = MAX(1,m);
- float* c_t = NULL;
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_slarfx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slarfx( &side, &m, &n, v, &tau, c_t, &ldc_t, work );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slarfx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slarfx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slarnv.c b/netlib/LAPACKE/lapacke_slarnv.c
deleted file mode 100644
index aff176d..0000000
--- a/netlib/LAPACKE/lapacke_slarnv.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slarnv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- float* x )
-{
- return LAPACKE_slarnv_work( idist, iseed, n, x );
-}
diff --git a/netlib/LAPACKE/lapacke_slarnv_work.c b/netlib/LAPACKE/lapacke_slarnv_work.c
deleted file mode 100644
index 38362b0..0000000
--- a/netlib/LAPACKE/lapacke_slarnv_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slarnv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, float* x )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_slarnv( &idist, iseed, &n, x );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slartgp.c b/netlib/LAPACKE/lapacke_slartgp.c
deleted file mode 100644
index 2b48b85..0000000
--- a/netlib/LAPACKE/lapacke_slartgp.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slartgp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slartgp( float f, float g, float* cs, float* sn, float* r )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &f, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &g, 1 ) ) {
- return -2;
- }
-#endif
- return LAPACKE_slartgp_work( f, g, cs, sn, r );
-}
diff --git a/netlib/LAPACKE/lapacke_slartgp_work.c b/netlib/LAPACKE/lapacke_slartgp_work.c
deleted file mode 100644
index 26f05aa..0000000
--- a/netlib/LAPACKE/lapacke_slartgp_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slartgp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slartgp_work( float f, float g, float* cs, float* sn,
- float* r )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_slartgp( &f, &g, cs, sn, r );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slartgs.c b/netlib/LAPACKE/lapacke_slartgs.c
deleted file mode 100644
index 3da6df1..0000000
--- a/netlib/LAPACKE/lapacke_slartgs.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slartgs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slartgs( float x, float y, float sigma, float* cs,
- float* sn )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &sigma, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
-#endif
- return LAPACKE_slartgs_work( x, y, sigma, cs, sn );
-}
diff --git a/netlib/LAPACKE/lapacke_slartgs_work.c b/netlib/LAPACKE/lapacke_slartgs_work.c
deleted file mode 100644
index a7ac3cf..0000000
--- a/netlib/LAPACKE/lapacke_slartgs_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slartgs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slartgs_work( float x, float y, float sigma, float* cs,
- float* sn )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_slartgs( &x, &y, &sigma, cs, sn );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slaset.c b/netlib/LAPACKE/lapacke_slaset.c
deleted file mode 100644
index b92f9c8..0000000
--- a/netlib/LAPACKE/lapacke_slaset.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slaset
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, float alpha, float beta, float* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slaset", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
- return -6;
- }
-#endif
- return LAPACKE_slaset_work( matrix_order, uplo, m, n, alpha, beta, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_slaset_work.c b/netlib/LAPACKE/lapacke_slaset_work.c
deleted file mode 100644
index 1a34097..0000000
--- a/netlib/LAPACKE/lapacke_slaset_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slaset
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, float alpha, float beta, float* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slaset( &uplo, &m, &n, &alpha, &beta, a, &lda );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_slaset_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slaset( &uplo, &m, &n, &alpha, &beta, a_t, &lda_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slaset_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slaset_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slasrt.c b/netlib/LAPACKE/lapacke_slasrt.c
deleted file mode 100644
index d426fb2..0000000
--- a/netlib/LAPACKE/lapacke_slasrt.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slasrt
-* Author: Intel Corporation
-* Generated May, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slasrt( char id, lapack_int n, float* d )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_slasrt_work( id, n, d );
-}
diff --git a/netlib/LAPACKE/lapacke_slasrt_work.c b/netlib/LAPACKE/lapacke_slasrt_work.c
deleted file mode 100644
index e9384c0..0000000
--- a/netlib/LAPACKE/lapacke_slasrt_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slasrt
-* Author: Intel Corporation
-* Generated May, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slasrt_work( char id, lapack_int n, float* d )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_slasrt( &id, &n, d, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slaswp.c b/netlib/LAPACKE/lapacke_slaswp.c
deleted file mode 100644
index 6f83cd8..0000000
--- a/netlib/LAPACKE/lapacke_slaswp.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slaswp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slaswp( int matrix_order, lapack_int n, float* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slaswp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, lda, n, a, lda ) ) {
- return -3;
- }
-#endif
- return LAPACKE_slaswp_work( matrix_order, n, a, lda, k1, k2, ipiv, incx );
-}
diff --git a/netlib/LAPACKE/lapacke_slaswp_work.c b/netlib/LAPACKE/lapacke_slaswp_work.c
deleted file mode 100644
index 4d72675..0000000
--- a/netlib/LAPACKE/lapacke_slaswp_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slaswp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slaswp_work( int matrix_order, lapack_int n, float* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slaswp( &n, a, &lda, &k1, &k2, ipiv, &incx );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,lda);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_slaswp_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, lda, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slaswp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slaswp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slatms.c b/netlib/LAPACKE/lapacke_slatms.c
deleted file mode 100644
index 68d47cc..0000000
--- a/netlib/LAPACKE/lapacke_slatms.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slatms
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, float* d,
- lapack_int mode, float cond, float dmax,
- lapack_int kl, lapack_int ku, char pack, float* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slatms", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*(MAX(n,m))) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_slatms_work( matrix_order, m, n, dist, iseed, sym, d, mode,
- cond, dmax, kl, ku, pack, a, lda, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slatms", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slatms_work.c b/netlib/LAPACKE/lapacke_slatms_work.c
deleted file mode 100644
index f9edf18..0000000
--- a/netlib/LAPACKE/lapacke_slatms_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slatms
-* Author: Intel Corporation
-* Generated April, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- float* d, lapack_int mode, float cond,
- float dmax, lapack_int kl, lapack_int ku,
- char pack, float* a, lapack_int lda,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl,
- &ku, &pack, a, &lda, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_slatms_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl,
- &ku, &pack, a_t, &lda_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slatms_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slatms_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_slauum.c b/netlib/LAPACKE/lapacke_slauum.c
deleted file mode 100644
index 9775fc9..0000000
--- a/netlib/LAPACKE/lapacke_slauum.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function slauum
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slauum( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_slauum", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_slauum_work( matrix_order, uplo, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_slauum_work.c b/netlib/LAPACKE/lapacke_slauum_work.c
deleted file mode 100644
index a0e180f..0000000
--- a/netlib/LAPACKE/lapacke_slauum_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function slauum
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_slauum_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_slauum( &uplo, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_slauum_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_slauum( &uplo, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_slauum_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_slauum_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sopgtr.c b/netlib/LAPACKE/lapacke_sopgtr.c
deleted file mode 100644
index 2f541c2..0000000
--- a/netlib/LAPACKE/lapacke_sopgtr.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sopgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sopgtr( int matrix_order, char uplo, lapack_int n,
- const float* ap, const float* tau, float* q,
- lapack_int ldq )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sopgtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n-1) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sopgtr_work( matrix_order, uplo, n, ap, tau, q, ldq, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sopgtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sopgtr_work.c b/netlib/LAPACKE/lapacke_sopgtr_work.c
deleted file mode 100644
index 5ea7b7f..0000000
--- a/netlib/LAPACKE/lapacke_sopgtr_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sopgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sopgtr_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, const float* tau, float* q,
- lapack_int ldq, float* work )
-{
- lapack_int info = 0;
- lapack_int ldq_t;
- float *q_t = NULL, *ap_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sopgtr( &uplo, &n, ap, tau, q, &ldq, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- ldq_t = MAX(1,n);
- /* Check leading dimension(s) */
- if( ldq < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sopgtr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sopgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( q_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sopgtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sopgtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sopmtr.c b/netlib/LAPACKE/lapacke_sopmtr.c
deleted file mode 100644
index 0125f45..0000000
--- a/netlib/LAPACKE/lapacke_sopmtr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sopmtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sopmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const float* ap,
- const float* tau, float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- float* work = NULL;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sopmtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_ssp_nancheck( r, ap ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
- return -8;
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( side, 'l' ) ) {
- lwork = MAX(1,n);
- } else if( LAPACKE_lsame( side, 'r' ) ) {
- lwork = MAX(1,m);
- } else {
- lwork = 1; /* Any value */
- }
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sopmtr_work( matrix_order, side, uplo, trans, m, n, ap, tau,
- c, ldc, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sopmtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sopmtr_work.c b/netlib/LAPACKE/lapacke_sopmtr_work.c
deleted file mode 100644
index a1fcd8b..0000000
--- a/netlib/LAPACKE/lapacke_sopmtr_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sopmtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sopmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const float* ap, const float* tau, float* c,
- lapack_int ldc, float* work )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int ldc_t;
- float *ap_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sopmtr( &side, &uplo, &trans, &m, &n, ap, tau, c, &ldc, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( ldc < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sopmtr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,r) * MAX(2,r+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- LAPACKE_ssp_trans( matrix_order, uplo, r, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sopmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( c_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sopmtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sopmtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorbdb.c b/netlib/LAPACKE/lapacke_sorbdb.c
deleted file mode 100644
index db6566e..0000000
--- a/netlib/LAPACKE/lapacke_sorbdb.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorbdb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q, float* x11,
- lapack_int ldx11, float* x12, lapack_int ldx12,
- float* x21, lapack_int ldx21, float* x22,
- lapack_int ldx22, float* theta, float* phi,
- float* taup1, float* taup2, float* tauq1,
- float* tauq2 )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorbdb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x11, q, x11, ldx11 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x12, m-q, x12, ldx12 ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x21, q, x21, ldx21 ) ) {
- return -11;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x22, m-q, x22, ldx22 ) ) {
- return -13;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorbdb_work( matrix_order, trans, signs, m, p, q, x11, ldx11,
- x12, ldx12, x21, ldx21, x22, ldx22, theta, phi,
- taup1, taup2, tauq1, tauq2, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorbdb_work( matrix_order, trans, signs, m, p, q, x11, ldx11,
- x12, ldx12, x21, ldx21, x22, ldx22, theta, phi,
- taup1, taup2, tauq1, tauq2, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorbdb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorbdb_work.c b/netlib/LAPACKE/lapacke_sorbdb_work.c
deleted file mode 100644
index 7d262fc..0000000
--- a/netlib/LAPACKE/lapacke_sorbdb_work.c
+++ /dev/null
@@ -1,158 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorbdb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- float* x11, lapack_int ldx11, float* x12,
- lapack_int ldx12, float* x21, lapack_int ldx21,
- float* x22, lapack_int ldx22, float* theta,
- float* phi, float* taup1, float* taup2,
- float* tauq1, float* tauq2, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
- x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
- tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- float* x11_t = NULL;
- float* x12_t = NULL;
- float* x21_t = NULL;
- float* x22_t = NULL;
- /* Check leading dimension(s) */
- if( ldx11 < q ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
- &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (float*)LAPACKE_malloc( sizeof(float) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (float*)LAPACKE_malloc( sizeof(float) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_sge_trans( matrix_order, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_sge_trans( matrix_order, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_sge_trans( matrix_order, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
- &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- /* Release memory and exit */
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorcsd.c b/netlib/LAPACKE/lapacke_sorcsd.c
deleted file mode 100644
index 485a6c2..0000000
--- a/netlib/LAPACKE/lapacke_sorcsd.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q, float* x11,
- lapack_int ldx11, float* x12, lapack_int ldx12,
- float* x21, lapack_int ldx21, float* x22,
- lapack_int ldx22, float* theta, float* u1,
- lapack_int ldu1, float* u2, lapack_int ldu2,
- float* v1t, lapack_int ldv1t, float* v2t,
- lapack_int ldv2t )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorcsd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x11, q, x11, ldx11 ) ) {
- return -11;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x12, m-q, x12, ldx12 ) ) {
- return -13;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x21, q, x21, ldx21 ) ) {
- return -15;
- }
- if( LAPACKE_sge_nancheck( matrix_order, nrows_x22, m-q, x22, ldx22 ) ) {
- return -17;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-q) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_sorcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, signs, m, p, q, x11, ldx11, x12, ldx12,
- x21, ldx21, x22, ldx22, theta, u1, ldu1, u2,
- ldu2, v1t, ldv1t, v2t, ldv2t, &work_query,
- lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorcsd_work( matrix_order, jobu1, jobu2, jobv1t, jobv2t,
- trans, signs, m, p, q, x11, ldx11, x12, ldx12,
- x21, ldx21, x22, ldx22, theta, u1, ldu1, u2,
- ldu2, v1t, ldv1t, v2t, ldv2t, work, lwork,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorcsd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorcsd_work.c b/netlib/LAPACKE/lapacke_sorcsd_work.c
deleted file mode 100644
index 6cc2565..0000000
--- a/netlib/LAPACKE/lapacke_sorcsd_work.c
+++ /dev/null
@@ -1,261 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorcsd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, float* x11, lapack_int ldx11,
- float* x12, lapack_int ldx12, float* x21,
- lapack_int ldx21, float* x22, lapack_int ldx22,
- float* theta, float* u1, lapack_int ldu1,
- float* u2, lapack_int ldu2, float* v1t,
- lapack_int ldv1t, float* v2t, lapack_int ldv2t,
- float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
- theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- float* x11_t = NULL;
- float* x12_t = NULL;
- float* x21_t = NULL;
- float* x22_t = NULL;
- float* u1_t = NULL;
- float* u2_t = NULL;
- float* v1t_t = NULL;
- float* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -25;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -27;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx11 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
- &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
- x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
- &ldv1t_t, v2t, &ldv2t_t, work, &lwork, iwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (float*)LAPACKE_malloc( sizeof(float) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (float*)LAPACKE_malloc( sizeof(float) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_6;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_7;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_sge_trans( matrix_order, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_sge_trans( matrix_order, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_sge_trans( matrix_order, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
- x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
- v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_7:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_6:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_5:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_4:
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgbr.c b/netlib/LAPACKE/lapacke_sorgbr.c
deleted file mode 100644
index 6b76a91..0000000
--- a/netlib/LAPACKE/lapacke_sorgbr.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorgbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, float* a, lapack_int lda,
- const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorgbr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( MIN(m,k), tau, 1 ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorgbr_work( matrix_order, vect, m, n, k, a, lda, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorgbr_work( matrix_order, vect, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgbr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgbr_work.c b/netlib/LAPACKE/lapacke_sorgbr_work.c
deleted file mode 100644
index a2b3cd7..0000000
--- a/netlib/LAPACKE/lapacke_sorgbr_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorgbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, float* a,
- lapack_int lda, const float* tau, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorgbr( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sorgbr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorgbr( &vect, &m, &n, &k, a, &lda_t, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorgbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgbr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorgbr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorghr.c b/netlib/LAPACKE/lapacke_sorghr.c
deleted file mode 100644
index 7fb40a3..0000000
--- a/netlib/LAPACKE/lapacke_sorghr.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorghr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorghr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorghr_work( matrix_order, n, ilo, ihi, a, lda, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorghr_work( matrix_order, n, ilo, ihi, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorghr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorghr_work.c b/netlib/LAPACKE/lapacke_sorghr_work.c
deleted file mode 100644
index 6a1af20..0000000
--- a/netlib/LAPACKE/lapacke_sorghr_work.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorghr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorghr( &n, &ilo, &ihi, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sorghr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorghr( &n, &ilo, &ihi, a, &lda_t, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorghr( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorghr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorghr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorglq.c b/netlib/LAPACKE/lapacke_sorglq.c
deleted file mode 100644
index eda1a61..0000000
--- a/netlib/LAPACKE/lapacke_sorglq.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorglq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorglq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorglq_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorglq_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorglq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorglq_work.c b/netlib/LAPACKE/lapacke_sorglq_work.c
deleted file mode 100644
index 6c2bc5d..0000000
--- a/netlib/LAPACKE/lapacke_sorglq_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorglq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorglq( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sorglq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorglq( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorglq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorglq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorglq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgql.c b/netlib/LAPACKE/lapacke_sorgql.c
deleted file mode 100644
index 543766d..0000000
--- a/netlib/LAPACKE/lapacke_sorgql.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorgql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorgql", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorgql_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorgql_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgql", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgql_work.c b/netlib/LAPACKE/lapacke_sorgql_work.c
deleted file mode 100644
index 50caf12..0000000
--- a/netlib/LAPACKE/lapacke_sorgql_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorgql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorgql( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sorgql_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorgql( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorgql( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgql_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorgql_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgqr.c b/netlib/LAPACKE/lapacke_sorgqr.c
deleted file mode 100644
index 45108f8..0000000
--- a/netlib/LAPACKE/lapacke_sorgqr.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorgqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorgqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorgqr_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorgqr_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgqr_work.c b/netlib/LAPACKE/lapacke_sorgqr_work.c
deleted file mode 100644
index edec07c..0000000
--- a/netlib/LAPACKE/lapacke_sorgqr_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorgqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorgqr( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sorgqr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorgqr( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorgqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorgqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgrq.c b/netlib/LAPACKE/lapacke_sorgrq.c
deleted file mode 100644
index 00b0ae1..0000000
--- a/netlib/LAPACKE/lapacke_sorgrq.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorgrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorgrq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorgrq_work( matrix_order, m, n, k, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorgrq_work( matrix_order, m, n, k, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgrq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgrq_work.c b/netlib/LAPACKE/lapacke_sorgrq_work.c
deleted file mode 100644
index 03e40e2..0000000
--- a/netlib/LAPACKE/lapacke_sorgrq_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorgrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorgrq( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sorgrq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorgrq( &m, &n, &k, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorgrq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgrq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorgrq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgtr.c b/netlib/LAPACKE/lapacke_sorgtr.c
deleted file mode 100644
index d53e9b2..0000000
--- a/netlib/LAPACKE/lapacke_sorgtr.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sorgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgtr( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sorgtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sorgtr_work( matrix_order, uplo, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sorgtr_work( matrix_order, uplo, n, a, lda, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sorgtr_work.c b/netlib/LAPACKE/lapacke_sorgtr_work.c
deleted file mode 100644
index 4584270..0000000
--- a/netlib/LAPACKE/lapacke_sorgtr_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sorgtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sorgtr_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, const float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorgtr( &uplo, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_sorgtr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorgtr( &uplo, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorgtr( &uplo, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorgtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sorgtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormbr.c b/netlib/LAPACKE/lapacke_sormbr.c
deleted file mode 100644
index a9382e2..0000000
--- a/netlib/LAPACKE/lapacke_sormbr.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int nq, r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormbr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- if( LAPACKE_sge_nancheck( matrix_order, r, MIN(nq,k), a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( MIN(nq,k), tau, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormbr_work( matrix_order, vect, side, trans, m, n, k, a,
- lda, tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormbr_work( matrix_order, vect, side, trans, m, n, k, a,
- lda, tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormbr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormbr_work.c b/netlib/LAPACKE/lapacke_sormbr_work.c
deleted file mode 100644
index 2ebbc83..0000000
--- a/netlib/LAPACKE/lapacke_sormbr_work.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormbr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int nq, r;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < MIN(nq,k) ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)
- LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,MIN(nq,k)) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, r, MIN(nq,k), a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormhr.c b/netlib/LAPACKE/lapacke_sormhr.c
deleted file mode 100644
index e3a7c95..0000000
--- a/netlib/LAPACKE/lapacke_sormhr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormhr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormhr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_order, r, r, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormhr_work( matrix_order, side, trans, m, n, ilo, ihi, a,
- lda, tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormhr_work( matrix_order, side, trans, m, n, ilo, ihi, a,
- lda, tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormhr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormhr_work.c b/netlib/LAPACKE/lapacke_sormhr_work.c
deleted file mode 100644
index f4f40de..0000000
--- a/netlib/LAPACKE/lapacke_sormhr_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormhr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormhr( &side, &trans, &m, &n, &ilo, &ihi, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < r ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sormhr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sormhr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormhr( &side, &trans, &m, &n, &ilo, &ihi, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,r) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, r, r, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormhr( &side, &trans, &m, &n, &ilo, &ihi, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormhr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormhr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormlq.c b/netlib/LAPACKE/lapacke_sormlq.c
deleted file mode 100644
index c59e185..0000000
--- a/netlib/LAPACKE/lapacke_sormlq.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormlq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormlq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormlq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormlq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormlq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormlq_work.c b/netlib/LAPACKE/lapacke_sormlq_work.c
deleted file mode 100644
index 7a7464d..0000000
--- a/netlib/LAPACKE/lapacke_sormlq_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormlq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lda_t = MAX(1,k);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormql.c b/netlib/LAPACKE/lapacke_sormql.c
deleted file mode 100644
index 6cd66c6..0000000
--- a/netlib/LAPACKE/lapacke_sormql.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormql", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_order, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormql_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormql_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormql", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormql_work.c b/netlib/LAPACKE/lapacke_sormql_work.c
deleted file mode 100644
index 3a58009..0000000
--- a/netlib/LAPACKE/lapacke_sormql_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormql
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormql( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < k ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sormql_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sormql_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormql( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,k) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, r, k, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormql_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormql_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormqr.c b/netlib/LAPACKE/lapacke_sormqr.c
deleted file mode 100644
index ac7ada1..0000000
--- a/netlib/LAPACKE/lapacke_sormqr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_order, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormqr_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormqr_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormqr_work.c b/netlib/LAPACKE/lapacke_sormqr_work.c
deleted file mode 100644
index b59c361..0000000
--- a/netlib/LAPACKE/lapacke_sormqr_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormqr( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < k ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sormqr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sormqr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormqr( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,k) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, r, k, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormrq.c b/netlib/LAPACKE/lapacke_sormrq.c
deleted file mode 100644
index 76968fd..0000000
--- a/netlib/LAPACKE/lapacke_sormrq.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormrq", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormrq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormrq_work( matrix_order, side, trans, m, n, k, a, lda, tau,
- c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormrq", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormrq_work.c b/netlib/LAPACKE/lapacke_sormrq_work.c
deleted file mode 100644
index c12bcc4..0000000
--- a/netlib/LAPACKE/lapacke_sormrq_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormrq
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormrq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lda_t = MAX(1,k);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sormrq_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sormrq_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormrq( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormrq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormrq_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormrq_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormrz.c b/netlib/LAPACKE/lapacke_sormrz.c
deleted file mode 100644
index bfae98d..0000000
--- a/netlib/LAPACKE/lapacke_sormrz.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormrz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormrz", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -10;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormrz_work( matrix_order, side, trans, m, n, k, l, a, lda,
- tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormrz_work( matrix_order, side, trans, m, n, k, l, a, lda,
- tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormrz", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormrz_work.c b/netlib/LAPACKE/lapacke_sormrz_work.c
deleted file mode 100644
index 4d6cd91..0000000
--- a/netlib/LAPACKE/lapacke_sormrz_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormrz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormrz( &side, &trans, &m, &n, &k, &l, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lda_t = MAX(1,k);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sormrz_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sormrz_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormrz( &side, &trans, &m, &n, &k, &l, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormrz( &side, &trans, &m, &n, &k, &l, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormrz_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormrz_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormtr.c b/netlib/LAPACKE/lapacke_sormtr.c
deleted file mode 100644
index f3cad2e..0000000
--- a/netlib/LAPACKE/lapacke_sormtr.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sormtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* tau, float* c,
- lapack_int ldc )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- lapack_int r;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sormtr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_order, r, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sormtr_work( matrix_order, side, uplo, trans, m, n, a, lda,
- tau, c, ldc, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sormtr_work( matrix_order, side, uplo, trans, m, n, a, lda,
- tau, c, ldc, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormtr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sormtr_work.c b/netlib/LAPACKE/lapacke_sormtr_work.c
deleted file mode 100644
index 9c14088..0000000
--- a/netlib/LAPACKE/lapacke_sormtr_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sormtr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sormtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- lapack_int r, lda_t, ldc_t;
- float *a_t = NULL, *c_t = NULL;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sormtr( &side, &uplo, &trans, &m, &n, a, &lda, tau, c, &ldc,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- lda_t = MAX(1,r);
- ldc_t = MAX(1,m);
- /* Check leading dimension(s) */
- if( lda < r ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sormtr_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sormtr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sormtr( &side, &uplo, &trans, &m, &n, a, &lda_t, tau, c,
- &ldc_t, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,r) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, r, r, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sormtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t,
- &ldc_t, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sormtr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sormtr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spb_nancheck.c b/netlib/LAPACKE/lapacke_spb_nancheck.c
deleted file mode 100644
index c652c59..0000000
--- a/netlib/LAPACKE/lapacke_spb_nancheck.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_spb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const float* ab,
- lapack_int ldab )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- return LAPACKE_sgb_nancheck( matrix_order, n, n, 0, kd, ab, ldab );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- return LAPACKE_sgb_nancheck( matrix_order, n, n, kd, 0, ab, ldab );
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_spb_trans.c b/netlib/LAPACKE/lapacke_spb_trans.c
deleted file mode 100644
index 962cb59..0000000
--- a/netlib/LAPACKE/lapacke_spb_trans.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric banded matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_spb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- LAPACKE_sgb_trans( matrix_order, n, n, 0, kd, in, ldin, out, ldout );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- LAPACKE_sgb_trans( matrix_order, n, n, kd, 0, in, ldin, out, ldout );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_spbcon.c b/netlib/LAPACKE/lapacke_spbcon.c
deleted file mode 100644
index 6e63ca2..0000000
--- a/netlib/LAPACKE/lapacke_spbcon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float anorm, float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_spbcon_work( matrix_order, uplo, n, kd, ab, ldab, anorm,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbcon_work.c b/netlib/LAPACKE/lapacke_spbcon_work.c
deleted file mode 100644
index 19cc69f..0000000
--- a/netlib/LAPACKE/lapacke_spbcon_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float anorm, float* rcond, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbcon( &uplo, &n, &kd, ab, &ldab, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_spbcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbcon( &uplo, &n, &kd, ab_t, &ldab_t, &anorm, rcond, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbequ.c b/netlib/LAPACKE/lapacke_spbequ.c
deleted file mode 100644
index ed57486..0000000
--- a/netlib/LAPACKE/lapacke_spbequ.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float* s, float* scond, float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
-#endif
- return LAPACKE_spbequ_work( matrix_order, uplo, n, kd, ab, ldab, s, scond,
- amax );
-}
diff --git a/netlib/LAPACKE/lapacke_spbequ_work.c b/netlib/LAPACKE/lapacke_spbequ_work.c
deleted file mode 100644
index 7cc40f3..0000000
--- a/netlib/LAPACKE/lapacke_spbequ_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float* s, float* scond, float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbequ( &uplo, &n, &kd, ab, &ldab, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_spbequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbequ( &uplo, &n, &kd, ab_t, &ldab_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbrfs.c b/netlib/LAPACKE/lapacke_spbrfs.c
deleted file mode 100644
index 9cc799d..0000000
--- a/netlib/LAPACKE/lapacke_spbrfs.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb, lapack_int ldafb,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, afb, ldafb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_spbrfs_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, afb,
- ldafb, b, ldb, x, ldx, ferr, berr, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbrfs_work.c b/netlib/LAPACKE/lapacke_spbrfs_work.c
deleted file mode 100644
index 600d3ca..0000000
--- a/netlib/LAPACKE/lapacke_spbrfs_work.c
+++ /dev/null
@@ -1,135 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb,
- lapack_int ldafb, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbrfs( &uplo, &n, &kd, &nrhs, ab, &ldab, afb, &ldafb, b, &ldb,
- x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldafb_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* ab_t = NULL;
- float* afb_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_spbrfs_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_spbrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_spbrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_spbrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (float*)LAPACKE_malloc( sizeof(float) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, afb, ldafb, afb_t,
- ldafb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbrfs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t,
- b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbstf.c b/netlib/LAPACKE/lapacke_spbstf.c
deleted file mode 100644
index 0e9fe42..0000000
--- a/netlib/LAPACKE/lapacke_spbstf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbstf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, float* bb, lapack_int ldbb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbstf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -5;
- }
-#endif
- return LAPACKE_spbstf_work( matrix_order, uplo, n, kb, bb, ldbb );
-}
diff --git a/netlib/LAPACKE/lapacke_spbstf_work.c b/netlib/LAPACKE/lapacke_spbstf_work.c
deleted file mode 100644
index ca985d5..0000000
--- a/netlib/LAPACKE/lapacke_spbstf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbstf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, float* bb, lapack_int ldbb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbstf( &uplo, &n, &kb, bb, &ldbb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldbb_t = MAX(1,kb+1);
- float* bb_t = NULL;
- /* Check leading dimension(s) */
- if( ldbb < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_spbstf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- bb_t = (float*)LAPACKE_malloc( sizeof(float) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbstf( &uplo, &n, &kb, bb_t, &ldbb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- /* Release memory and exit */
- LAPACKE_free( bb_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbstf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbstf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbsv.c b/netlib/LAPACKE/lapacke_spbsv.c
deleted file mode 100644
index 668c0f3..0000000
--- a/netlib/LAPACKE/lapacke_spbsv.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_spbsv_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_spbsv_work.c b/netlib/LAPACKE/lapacke_spbsv_work.c
deleted file mode 100644
index 11c7b25..0000000
--- a/netlib/LAPACKE/lapacke_spbsv_work.c
+++ /dev/null
@@ -1,100 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbsv( &uplo, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- float* ab_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_spbsv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_spbsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbsv( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbsvx.c b/netlib/LAPACKE/lapacke_spbsvx.c
deleted file mode 100644
index cdb02a0..0000000
--- a/netlib/LAPACKE/lapacke_spbsvx.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* afb, lapack_int ldafb,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, afb, ldafb ) ) {
- return -9;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_spbsvx_work( matrix_order, fact, uplo, n, kd, nrhs, ab, ldab,
- afb, ldafb, equed, s, b, ldb, x, ldx, rcond,
- ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbsvx_work.c b/netlib/LAPACKE/lapacke_spbsvx_work.c
deleted file mode 100644
index 80b331d..0000000
--- a/netlib/LAPACKE/lapacke_spbsvx_work.c
+++ /dev/null
@@ -1,146 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- float* ab, lapack_int ldab, float* afb,
- lapack_int ldafb, char* equed, float* s,
- float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbsvx( &fact, &uplo, &n, &kd, &nrhs, ab, &ldab, afb, &ldafb,
- equed, s, b, &ldb, x, &ldx, rcond, ferr, berr, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldafb_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* ab_t = NULL;
- float* afb_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_spbsvx_work", info );
- return info;
- }
- if( ldafb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_spbsvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_spbsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_spbsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- afb_t = (float*)LAPACKE_malloc( sizeof(float) * ldafb_t * MAX(1,n) );
- if( afb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, afb, ldafb, afb_t,
- ldafb_t );
- }
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbsvx( &fact, &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t,
- &ldafb_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t,
- afb, ldafb );
- }
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( afb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbtrf.c b/netlib/LAPACKE/lapacke_spbtrf.c
deleted file mode 100644
index 3b2ba21..0000000
--- a/netlib/LAPACKE/lapacke_spbtrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbtrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
-#endif
- return LAPACKE_spbtrf_work( matrix_order, uplo, n, kd, ab, ldab );
-}
diff --git a/netlib/LAPACKE/lapacke_spbtrf_work.c b/netlib/LAPACKE/lapacke_spbtrf_work.c
deleted file mode 100644
index 11c905d..0000000
--- a/netlib/LAPACKE/lapacke_spbtrf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbtrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbtrf( &uplo, &n, &kd, ab, &ldab, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_spbtrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbtrf( &uplo, &n, &kd, ab_t, &ldab_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbtrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbtrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spbtrs.c b/netlib/LAPACKE/lapacke_spbtrs.c
deleted file mode 100644
index 82b18b0..0000000
--- a/netlib/LAPACKE/lapacke_spbtrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spbtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_spbtrs_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_spbtrs_work.c b/netlib/LAPACKE/lapacke_spbtrs_work.c
deleted file mode 100644
index 1e3541e..0000000
--- a/netlib/LAPACKE/lapacke_spbtrs_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- float* ab_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spf_nancheck.c b/netlib/LAPACKE/lapacke_spf_nancheck.c
deleted file mode 100644
index 91412f0..0000000
--- a/netlib/LAPACKE/lapacke_spf_nancheck.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo, transr or
- * matrix_order.
- */
-
-lapack_logical LAPACKE_spf_nancheck( lapack_int n,
- const float *a )
-{
- lapack_int len = n*(n+1)/2;
- return LAPACKE_s_nancheck( len, a, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_spf_trans.c b/netlib/LAPACKE/lapacke_spf_trans.c
deleted file mode 100644
index 15b3d9b..0000000
--- a/netlib/LAPACKE/lapacke_spf_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input RFP matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_spf_trans( int matrix_order, char transr, char uplo,
- lapack_int n, const float *in,
- float *out )
-{
- LAPACKE_stf_trans( matrix_order, transr, uplo, 'n', n, in, out );
-}
diff --git a/netlib/LAPACKE/lapacke_spftrf.c b/netlib/LAPACKE/lapacke_spftrf.c
deleted file mode 100644
index b82e172..0000000
--- a/netlib/LAPACKE/lapacke_spftrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spftrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spftrf( int matrix_order, char transr, char uplo,
- lapack_int n, float* a )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spftrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, a ) ) {
- return -5;
- }
-#endif
- return LAPACKE_spftrf_work( matrix_order, transr, uplo, n, a );
-}
diff --git a/netlib/LAPACKE/lapacke_spftrf_work.c b/netlib/LAPACKE/lapacke_spftrf_work.c
deleted file mode 100644
index 27c7d5a..0000000
--- a/netlib/LAPACKE/lapacke_spftrf_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spftrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, float* a )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spftrf( &transr, &uplo, &n, a, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spf_trans( matrix_order, transr, uplo, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spftrf( &transr, &uplo, &n, a_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spftrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spftrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spftri.c b/netlib/LAPACKE/lapacke_spftri.c
deleted file mode 100644
index 537679d..0000000
--- a/netlib/LAPACKE/lapacke_spftri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spftri( int matrix_order, char transr, char uplo,
- lapack_int n, float* a )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spftri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, a ) ) {
- return -5;
- }
-#endif
- return LAPACKE_spftri_work( matrix_order, transr, uplo, n, a );
-}
diff --git a/netlib/LAPACKE/lapacke_spftri_work.c b/netlib/LAPACKE/lapacke_spftri_work.c
deleted file mode 100644
index 4b02434..0000000
--- a/netlib/LAPACKE/lapacke_spftri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, float* a )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spftri( &transr, &uplo, &n, a, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spf_trans( matrix_order, transr, uplo, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spftri( &transr, &uplo, &n, a_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spftri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spftri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spftrs.c b/netlib/LAPACKE/lapacke_spftrs.c
deleted file mode 100644
index f9a4b62..0000000
--- a/netlib/LAPACKE/lapacke_spftrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spftrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spftrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, a ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_spftrs_work( matrix_order, transr, uplo, n, nrhs, a, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_spftrs_work.c b/netlib/LAPACKE/lapacke_spftrs_work.c
deleted file mode 100644
index a71a562..0000000
--- a/netlib/LAPACKE/lapacke_spftrs_work.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spftrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spftrs( &transr, &uplo, &n, &nrhs, a, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_spftrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- a_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_spf_trans( matrix_order, transr, uplo, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spftrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spftrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spo_nancheck.c b/netlib/LAPACKE/lapacke_spo_nancheck.c
deleted file mode 100644
index aea1d02..0000000
--- a/netlib/LAPACKE/lapacke_spo_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_spo_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const float *a,
- lapack_int lda )
-{
- return LAPACKE_str_nancheck( matrix_order, uplo, 'n', n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_spo_trans.c b/netlib/LAPACKE/lapacke_spo_trans.c
deleted file mode 100644
index b485c4d..0000000
--- a/netlib/LAPACKE/lapacke_spo_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_spo_trans( int matrix_order, char uplo, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- LAPACKE_str_trans( matrix_order, uplo, 'n', n, in, ldin, out, ldout );
-}
diff --git a/netlib/LAPACKE/lapacke_spocon.c b/netlib/LAPACKE/lapacke_spocon.c
deleted file mode 100644
index 7b7b9d6..0000000
--- a/netlib/LAPACKE/lapacke_spocon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spocon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spocon( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spocon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_spocon_work( matrix_order, uplo, n, a, lda, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spocon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spocon_work.c b/netlib/LAPACKE/lapacke_spocon_work.c
deleted file mode 100644
index ab7ccb6..0000000
--- a/netlib/LAPACKE/lapacke_spocon_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spocon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spocon_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spocon( &uplo, &n, a, &lda, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_spocon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spocon( &uplo, &n, a_t, &lda_t, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spocon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spocon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spoequ.c b/netlib/LAPACKE/lapacke_spoequ.c
deleted file mode 100644
index 10e6a08..0000000
--- a/netlib/LAPACKE/lapacke_spoequ.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spoequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spoequ( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond, float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spoequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -3;
- }
-#endif
- return LAPACKE_spoequ_work( matrix_order, n, a, lda, s, scond, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_spoequ_work.c b/netlib/LAPACKE/lapacke_spoequ_work.c
deleted file mode 100644
index 61ff7bc..0000000
--- a/netlib/LAPACKE/lapacke_spoequ_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spoequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spoequ_work( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spoequ( &n, a, &lda, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_spoequ_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spoequ( &n, a_t, &lda_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spoequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spoequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spoequb.c b/netlib/LAPACKE/lapacke_spoequb.c
deleted file mode 100644
index 985f90e..0000000
--- a/netlib/LAPACKE/lapacke_spoequb.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spoequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spoequb( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spoequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -3;
- }
-#endif
- return LAPACKE_spoequb_work( matrix_order, n, a, lda, s, scond, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_spoequb_work.c b/netlib/LAPACKE/lapacke_spoequb_work.c
deleted file mode 100644
index 8408423..0000000
--- a/netlib/LAPACKE/lapacke_spoequb_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spoequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spoequb_work( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spoequb( &n, a, &lda, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -4;
- LAPACKE_xerbla( "LAPACKE_spoequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spoequb( &n, a_t, &lda_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spoequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spoequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sporfs.c b/netlib/LAPACKE/lapacke_sporfs.c
deleted file mode 100644
index 0c8f44c..0000000
--- a/netlib/LAPACKE/lapacke_sporfs.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sporfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sporfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -11;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sporfs_work( matrix_order, uplo, n, nrhs, a, lda, af, ldaf,
- b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sporfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sporfs_work.c b/netlib/LAPACKE/lapacke_sporfs_work.c
deleted file mode 100644
index 38ce8a6..0000000
--- a/netlib/LAPACKE/lapacke_sporfs_work.c
+++ /dev/null
@@ -1,132 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sporfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sporfs( &uplo, &n, &nrhs, a, &lda, af, &ldaf, b, &ldb, x, &ldx,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* af_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sporfs_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sporfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sporfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sporfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_spo_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sporfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sporfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sporfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sposv.c b/netlib/LAPACKE/lapacke_sposv.c
deleted file mode 100644
index 5603842..0000000
--- a/netlib/LAPACKE/lapacke_sposv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sposv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sposv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_sposv_work( matrix_order, uplo, n, nrhs, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sposv_work.c b/netlib/LAPACKE/lapacke_sposv_work.c
deleted file mode 100644
index 7e9ce96..0000000
--- a/netlib/LAPACKE/lapacke_sposv_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sposv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sposv( &uplo, &n, &nrhs, a, &lda, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_sposv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sposv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sposv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sposv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sposvx.c b/netlib/LAPACKE/lapacke_sposvx.c
deleted file mode 100644
index a52b24f..0000000
--- a/netlib/LAPACKE/lapacke_sposvx.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sposvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* af,
- lapack_int ldaf, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sposvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -8;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sposvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af,
- ldaf, equed, s, b, ldb, x, ldx, rcond, ferr,
- berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sposvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sposvx_work.c b/netlib/LAPACKE/lapacke_sposvx_work.c
deleted file mode 100644
index 6490ef5..0000000
--- a/netlib/LAPACKE/lapacke_sposvx_work.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sposvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sposvx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, equed, s, b,
- &ldb, x, &ldx, rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* af_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sposvx_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sposvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sposvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sposvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_spo_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- }
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
- equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
- ldaf );
- }
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sposvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sposvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spotrf.c b/netlib/LAPACKE/lapacke_spotrf.c
deleted file mode 100644
index 5722d9e..0000000
--- a/netlib/LAPACKE/lapacke_spotrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spotrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spotrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spotrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_spotrf_work( matrix_order, uplo, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_spotrf_work.c b/netlib/LAPACKE/lapacke_spotrf_work.c
deleted file mode 100644
index 1b46926..0000000
--- a/netlib/LAPACKE/lapacke_spotrf_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spotrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spotrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spotrf( &uplo, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_spotrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spotrf( &uplo, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spotrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spotrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spotri.c b/netlib/LAPACKE/lapacke_spotri.c
deleted file mode 100644
index af4dc72..0000000
--- a/netlib/LAPACKE/lapacke_spotri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spotri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spotri( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spotri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_spotri_work( matrix_order, uplo, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_spotri_work.c b/netlib/LAPACKE/lapacke_spotri_work.c
deleted file mode 100644
index b4703a0..0000000
--- a/netlib/LAPACKE/lapacke_spotri_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spotri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spotri_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spotri( &uplo, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_spotri_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spotri( &uplo, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spotri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spotri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spotrs.c b/netlib/LAPACKE/lapacke_spotrs.c
deleted file mode 100644
index d644ece..0000000
--- a/netlib/LAPACKE/lapacke_spotrs.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spotrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spotrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_spotrs_work( matrix_order, uplo, n, nrhs, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_spotrs_work.c b/netlib/LAPACKE/lapacke_spotrs_work.c
deleted file mode 100644
index 0ca7e40..0000000
--- a/netlib/LAPACKE/lapacke_spotrs_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spotrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spotrs( &uplo, &n, &nrhs, a, &lda, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_spotrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_spotrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spotrs( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spotrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spotrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spp_nancheck.c b/netlib/LAPACKE/lapacke_spp_nancheck.c
deleted file mode 100644
index 9c416e0..0000000
--- a/netlib/LAPACKE/lapacke_spp_nancheck.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo or matrix_order.
- */
-
-lapack_logical LAPACKE_spp_nancheck( lapack_int n,
- const float *ap )
-{
- lapack_int len = n*(n+1)/2;
- return LAPACKE_s_nancheck( len, ap, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_spp_trans.c b/netlib/LAPACKE/lapacke_spp_trans.c
deleted file mode 100644
index 6e49f2e..0000000
--- a/netlib/LAPACKE/lapacke_spp_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric packed matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_spp_trans( int matrix_order, char uplo, lapack_int n,
- const float *in,
- float *out )
-{
- LAPACKE_stp_trans( matrix_order, uplo, 'n', n, in, out );
-}
diff --git a/netlib/LAPACKE/lapacke_sppcon.c b/netlib/LAPACKE/lapacke_sppcon.c
deleted file mode 100644
index 60dbc88..0000000
--- a/netlib/LAPACKE/lapacke_sppcon.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sppcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppcon( int matrix_order, char uplo, lapack_int n,
- const float* ap, float anorm, float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sppcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -5;
- }
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sppcon_work( matrix_order, uplo, n, ap, anorm, rcond, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sppcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sppcon_work.c b/netlib/LAPACKE/lapacke_sppcon_work.c
deleted file mode 100644
index 4dfe73d..0000000
--- a/netlib/LAPACKE/lapacke_sppcon_work.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sppcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppcon_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float anorm, float* rcond,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sppcon( &uplo, &n, ap, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sppcon( &uplo, &n, ap_t, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sppcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sppcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sppequ.c b/netlib/LAPACKE/lapacke_sppequ.c
deleted file mode 100644
index 98bb4c0..0000000
--- a/netlib/LAPACKE/lapacke_sppequ.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sppequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppequ( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* s, float* scond,
- float* amax )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sppequ", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_sppequ_work( matrix_order, uplo, n, ap, s, scond, amax );
-}
diff --git a/netlib/LAPACKE/lapacke_sppequ_work.c b/netlib/LAPACKE/lapacke_sppequ_work.c
deleted file mode 100644
index 1dd9fc9..0000000
--- a/netlib/LAPACKE/lapacke_sppequ_work.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sppequ
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppequ_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* s, float* scond,
- float* amax )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sppequ( &uplo, &n, ap, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sppequ( &uplo, &n, ap_t, s, scond, amax, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sppequ_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sppequ_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spprfs.c b/netlib/LAPACKE/lapacke_spprfs.c
deleted file mode 100644
index ce743a6..0000000
--- a/netlib/LAPACKE/lapacke_spprfs.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, const float* afp,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spprfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_spprfs_work( matrix_order, uplo, n, nrhs, ap, afp, b, ldb, x,
- ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spprfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spprfs_work.c b/netlib/LAPACKE/lapacke_spprfs_work.c
deleted file mode 100644
index 4058b0b..0000000
--- a/netlib/LAPACKE/lapacke_spprfs_work.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const float* afp, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spprfs( &uplo, &n, &nrhs, ap, afp, b, &ldb, x, &ldx, ferr, berr,
- work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- float* ap_t = NULL;
- float* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_spprfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_spprfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_spp_trans( matrix_order, uplo, n, afp, afp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spprfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spprfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sppsv.c b/netlib/LAPACKE/lapacke_sppsv.c
deleted file mode 100644
index 24a4afa..0000000
--- a/netlib/LAPACKE/lapacke_sppsv.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sppsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sppsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
-#endif
- return LAPACKE_sppsv_work( matrix_order, uplo, n, nrhs, ap, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sppsv_work.c b/netlib/LAPACKE/lapacke_sppsv_work.c
deleted file mode 100644
index 6fe5d80..0000000
--- a/netlib/LAPACKE/lapacke_sppsv_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sppsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sppsv( &uplo, &n, &nrhs, ap, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sppsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sppsv( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sppsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sppsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sppsvx.c b/netlib/LAPACKE/lapacke_sppsvx.c
deleted file mode 100644
index 0998c2f..0000000
--- a/netlib/LAPACKE/lapacke_sppsvx.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sppsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* afp, char* equed,
- float* s, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sppsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spp_nancheck( n, afp ) ) {
- return -7;
- }
- }
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -9;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sppsvx_work( matrix_order, fact, uplo, n, nrhs, ap, afp,
- equed, s, b, ldb, x, ldx, rcond, ferr, berr,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sppsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sppsvx_work.c b/netlib/LAPACKE/lapacke_sppsvx_work.c
deleted file mode 100644
index 9a00f36..0000000
--- a/netlib/LAPACKE/lapacke_sppsvx_work.c
+++ /dev/null
@@ -1,131 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sppsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* ap,
- float* afp, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sppsvx( &fact, &uplo, &n, &nrhs, ap, afp, equed, s, b, &ldb, x,
- &ldx, rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- float* ap_t = NULL;
- float* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sppsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sppsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_spp_trans( matrix_order, uplo, n, afp, afp_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t,
- &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- }
- if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp );
- }
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sppsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sppsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spptrf.c b/netlib/LAPACKE/lapacke_spptrf.c
deleted file mode 100644
index 133d1b1..0000000
--- a/netlib/LAPACKE/lapacke_spptrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spptrf( int matrix_order, char uplo, lapack_int n,
- float* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spptrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_spptrf_work( matrix_order, uplo, n, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_spptrf_work.c b/netlib/LAPACKE/lapacke_spptrf_work.c
deleted file mode 100644
index 2eb60cf..0000000
--- a/netlib/LAPACKE/lapacke_spptrf_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spptrf_work( int matrix_order, char uplo, lapack_int n,
- float* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spptrf( &uplo, &n, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spptrf( &uplo, &n, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spptrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spptrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spptri.c b/netlib/LAPACKE/lapacke_spptri.c
deleted file mode 100644
index a113ab4..0000000
--- a/netlib/LAPACKE/lapacke_spptri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spptri( int matrix_order, char uplo, lapack_int n,
- float* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spptri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_spptri_work( matrix_order, uplo, n, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_spptri_work.c b/netlib/LAPACKE/lapacke_spptri_work.c
deleted file mode 100644
index 728796a..0000000
--- a/netlib/LAPACKE/lapacke_spptri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spptri_work( int matrix_order, char uplo, lapack_int n,
- float* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spptri( &uplo, &n, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spptri( &uplo, &n, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spptri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spptri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spptrs.c b/netlib/LAPACKE/lapacke_spptrs.c
deleted file mode 100644
index 5ba7ccc..0000000
--- a/netlib/LAPACKE/lapacke_spptrs.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spptrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
-#endif
- return LAPACKE_spptrs_work( matrix_order, uplo, n, nrhs, ap, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_spptrs_work.c b/netlib/LAPACKE/lapacke_spptrs_work.c
deleted file mode 100644
index fb98fd8..0000000
--- a/netlib/LAPACKE/lapacke_spptrs_work.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spptrs( &uplo, &n, &nrhs, ap, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_spptrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spptrs( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spptrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spptrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spstrf.c b/netlib/LAPACKE/lapacke_spstrf.c
deleted file mode 100644
index 9436190..0000000
--- a/netlib/LAPACKE/lapacke_spstrf.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spstrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spstrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, lapack_int* piv, lapack_int* rank,
- float tol )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spstrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_spstrf_work( matrix_order, uplo, n, a, lda, piv, rank, tol,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spstrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spstrf_work.c b/netlib/LAPACKE/lapacke_spstrf_work.c
deleted file mode 100644
index 3a323d0..0000000
--- a/netlib/LAPACKE/lapacke_spstrf_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spstrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spstrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, lapack_int* piv,
- lapack_int* rank, float tol, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spstrf( &uplo, &n, a, &lda, piv, rank, &tol, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_spstrf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spstrf( &uplo, &n, a_t, &lda_t, piv, rank, &tol, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spstrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spstrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spt_nancheck.c b/netlib/LAPACKE/lapacke_spt_nancheck.c
deleted file mode 100644
index 67cdaf3..0000000
--- a/netlib/LAPACKE/lapacke_spt_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_spt_nancheck( lapack_int n,
- const float *d,
- const float *e )
-{
- return LAPACKE_s_nancheck( n, d, 1 )
- || LAPACKE_s_nancheck( n-1, e, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_sptcon.c b/netlib/LAPACKE/lapacke_sptcon.c
deleted file mode 100644
index 8894593..0000000
--- a/netlib/LAPACKE/lapacke_sptcon.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sptcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptcon( lapack_int n, const float* d, const float* e,
- float anorm, float* rcond )
-{
- lapack_int info = 0;
- float* work = NULL;
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -3;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sptcon_work( n, d, e, anorm, rcond, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sptcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sptcon_work.c b/netlib/LAPACKE/lapacke_sptcon_work.c
deleted file mode 100644
index c1da2df..0000000
--- a/netlib/LAPACKE/lapacke_sptcon_work.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sptcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptcon_work( lapack_int n, const float* d, const float* e,
- float anorm, float* rcond, float* work )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_sptcon( &n, d, e, &anorm, rcond, work, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spteqr.c b/netlib/LAPACKE/lapacke_spteqr.c
deleted file mode 100644
index 1351175..0000000
--- a/netlib/LAPACKE/lapacke_spteqr.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spteqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -6;
- }
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( compz, 'n' ) ) {
- lwork = 1;
- } else {
- lwork = MAX(1,4*n-4);
- }
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_spteqr_work( matrix_order, compz, n, d, e, z, ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spteqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spteqr_work.c b/netlib/LAPACKE/lapacke_spteqr_work.c
deleted file mode 100644
index 8b6000a..0000000
--- a/netlib/LAPACKE/lapacke_spteqr_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spteqr( &compz, &n, d, e, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_spteqr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_spteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- /* Release memory and exit */
- LAPACKE_free( z_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spteqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spteqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sptrfs.c b/netlib/LAPACKE/lapacke_sptrfs.c
deleted file mode 100644
index 0b59a6a..0000000
--- a/netlib/LAPACKE/lapacke_sptrfs.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sptrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptrfs( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, const float* df,
- const float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* ferr, float* berr )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sptrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sptrfs_work( matrix_order, n, nrhs, d, e, df, ef, b, ldb, x,
- ldx, ferr, berr, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sptrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sptrfs_work.c b/netlib/LAPACKE/lapacke_sptrfs_work.c
deleted file mode 100644
index 45efef9..0000000
--- a/netlib/LAPACKE/lapacke_sptrfs_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sptrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptrfs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, const float* df,
- const float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* ferr,
- float* berr, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sptrfs( &n, &nrhs, d, e, df, ef, b, &ldb, x, &ldx, ferr, berr,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_sptrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_sptrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sptrfs( &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, ferr,
- berr, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sptrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sptrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sptsv.c b/netlib/LAPACKE/lapacke_sptsv.c
deleted file mode 100644
index d3550d7..0000000
--- a/netlib/LAPACKE/lapacke_sptsv.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sptsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, float* e, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sptsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
-#endif
- return LAPACKE_sptsv_work( matrix_order, n, nrhs, d, e, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sptsv_work.c b/netlib/LAPACKE/lapacke_sptsv_work.c
deleted file mode 100644
index f7993e5..0000000
--- a/netlib/LAPACKE/lapacke_sptsv_work.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sptsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, float* e, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sptsv( &n, &nrhs, d, e, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sptsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sptsv( &n, &nrhs, d, e, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sptsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sptsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sptsvx.c b/netlib/LAPACKE/lapacke_sptsvx.c
deleted file mode 100644
index 820c2a6..0000000
--- a/netlib/LAPACKE/lapacke_sptsvx.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sptsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d, const float* e,
- float* df, float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sptsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sptsvx_work( matrix_order, fact, n, nrhs, d, e, df, ef, b,
- ldb, x, ldx, rcond, ferr, berr, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sptsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sptsvx_work.c b/netlib/LAPACKE/lapacke_sptsvx_work.c
deleted file mode 100644
index 65636bb..0000000
--- a/netlib/LAPACKE/lapacke_sptsvx_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sptsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d, const float* e,
- float* df, float* ef, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sptsvx( &fact, &n, &nrhs, d, e, df, ef, b, &ldb, x, &ldx, rcond,
- ferr, berr, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t,
- rcond, ferr, berr, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spttrf.c b/netlib/LAPACKE/lapacke_spttrf.c
deleted file mode 100644
index 3083eff..0000000
--- a/netlib/LAPACKE/lapacke_spttrf.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spttrf( lapack_int n, float* d, float* e )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_spttrf_work( n, d, e );
-}
diff --git a/netlib/LAPACKE/lapacke_spttrf_work.c b/netlib/LAPACKE/lapacke_spttrf_work.c
deleted file mode 100644
index 1f511da..0000000
--- a/netlib/LAPACKE/lapacke_spttrf_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spttrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spttrf_work( lapack_int n, float* d, float* e )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_spttrf( &n, d, e, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_spttrs.c b/netlib/LAPACKE/lapacke_spttrs.c
deleted file mode 100644
index 2a0d938..0000000
--- a/netlib/LAPACKE/lapacke_spttrs.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function spttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spttrs( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_spttrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
-#endif
- return LAPACKE_spttrs_work( matrix_order, n, nrhs, d, e, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_spttrs_work.c b/netlib/LAPACKE/lapacke_spttrs_work.c
deleted file mode 100644
index deca966..0000000
--- a/netlib/LAPACKE/lapacke_spttrs_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function spttrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_spttrs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_spttrs( &n, &nrhs, d, e, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_spttrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_spttrs( &n, &nrhs, d, e, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_spttrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_spttrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssb_nancheck.c b/netlib/LAPACKE/lapacke_ssb_nancheck.c
deleted file mode 100644
index 7b4ab05..0000000
--- a/netlib/LAPACKE/lapacke_ssb_nancheck.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_ssb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const float* ab,
- lapack_int ldab )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- return LAPACKE_sgb_nancheck( matrix_order, n, n, 0, kd, ab, ldab );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- return LAPACKE_sgb_nancheck( matrix_order, n, n, kd, 0, ab, ldab );
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_ssb_trans.c b/netlib/LAPACKE/lapacke_ssb_trans.c
deleted file mode 100644
index 969dfd4..0000000
--- a/netlib/LAPACKE/lapacke_ssb_trans.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetrical band matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_ssb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- if( LAPACKE_lsame( uplo, 'u' ) ) {
- LAPACKE_sgb_trans( matrix_order, n, n, 0, kd, in, ldin, out, ldout );
- } else if( LAPACKE_lsame( uplo, 'l' ) ) {
- LAPACKE_sgb_trans( matrix_order, n, n, kd, 0, in, ldin, out, ldout );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_ssbev.c b/netlib/LAPACKE/lapacke_ssbev.c
deleted file mode 100644
index 3ad0e28..0000000
--- a/netlib/LAPACKE/lapacke_ssbev.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* w,
- float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n-2) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbev_work( matrix_order, jobz, uplo, n, kd, ab, ldab, w, z,
- ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbev_work.c b/netlib/LAPACKE/lapacke_ssbev_work.c
deleted file mode 100644
index 893194c..0000000
--- a/netlib/LAPACKE/lapacke_ssbev_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* w, float* z,
- lapack_int ldz, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbev( &jobz, &uplo, &n, &kd, ab, &ldab, w, z, &ldz, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldz_t = MAX(1,n);
- float* ab_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssbev_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssbev_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbev( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbevd.c b/netlib/LAPACKE/lapacke_ssbevd.c
deleted file mode 100644
index 707f19e..0000000
--- a/netlib/LAPACKE/lapacke_ssbevd.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* w,
- float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssbevd_work( matrix_order, jobz, uplo, n, kd, ab, ldab, w, z,
- ldz, &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbevd_work( matrix_order, jobz, uplo, n, kd, ab, ldab, w, z,
- ldz, work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbevd_work.c b/netlib/LAPACKE/lapacke_ssbevd_work.c
deleted file mode 100644
index 622dd7d..0000000
--- a/netlib/LAPACKE/lapacke_ssbevd_work.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbevd( &jobz, &uplo, &n, &kd, ab, &ldab, w, z, &ldz, work,
- &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldz_t = MAX(1,n);
- float* ab_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssbevd_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssbevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_ssbevd( &jobz, &uplo, &n, &kd, ab, &ldab_t, w, z, &ldz_t,
- work, &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbevx.c b/netlib/LAPACKE/lapacke_ssbevx.c
deleted file mode 100644
index 05ba22c..0000000
--- a/netlib/LAPACKE/lapacke_ssbevx.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,7*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbevx_work( matrix_order, jobz, range, uplo, n, kd, ab,
- ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z,
- ldz, work, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbevx_work.c b/netlib/LAPACKE/lapacke_ssbevx_work.c
deleted file mode 100644
index fb2bada..0000000
--- a/netlib/LAPACKE/lapacke_ssbevx_work.c
+++ /dev/null
@@ -1,139 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- float* ab, lapack_int ldab, float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab, &ldab, q, &ldq, &vl,
- &vu, &il, &iu, &abstol, m, w, z, &ldz, work, iwork,
- ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* ab_t = NULL;
- float* q_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t,
- &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t,
- work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgst.c b/netlib/LAPACKE/lapacke_ssbgst.c
deleted file mode 100644
index 32dd0f0..0000000
--- a/netlib/LAPACKE/lapacke_ssbgst.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, const float* bb, lapack_int ldbb,
- float* x, lapack_int ldx )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgst", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbgst_work( matrix_order, vect, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, x, ldx, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgst", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgst_work.c b/netlib/LAPACKE/lapacke_ssbgst_work.c
deleted file mode 100644
index 2ec38c0..0000000
--- a/netlib/LAPACKE/lapacke_ssbgst_work.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, const float* bb,
- lapack_int ldbb, float* x, lapack_int ldx,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgst( &vect, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, x,
- &ldx, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldx_t = MAX(1,n);
- float* ab_t = NULL;
- float* bb_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
- return info;
- }
- if( ldx < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (float*)LAPACKE_malloc( sizeof(float) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( vect, 'v' ) ) {
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,n) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_ssb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
- x_t, &ldx_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_free( x_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgv.c b/netlib/LAPACKE/lapacke_ssbgv.c
deleted file mode 100644
index b7ff8a8..0000000
--- a/netlib/LAPACKE/lapacke_ssbgv.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, float* bb, lapack_int ldbb, float* w,
- float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbgv_work( matrix_order, jobz, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, w, z, ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgv_work.c b/netlib/LAPACKE/lapacke_ssbgv_work.c
deleted file mode 100644
index 6af9113..0000000
--- a/netlib/LAPACKE/lapacke_ssbgv_work.c
+++ /dev/null
@@ -1,125 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* w, float* z,
- lapack_int ldz, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgv( &jobz, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, w, z,
- &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldz_t = MAX(1,n);
- float* ab_t = NULL;
- float* bb_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssbgv_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssbgv_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_ssbgv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (float*)LAPACKE_malloc( sizeof(float) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_ssb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgv( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
- w, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbgv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgvd.c b/netlib/LAPACKE/lapacke_ssbgvd.c
deleted file mode 100644
index 8a4cfd3..0000000
--- a/netlib/LAPACKE/lapacke_ssbgvd.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, float* bb, lapack_int ldbb,
- float* w, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -9;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssbgvd_work( matrix_order, jobz, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, w, z, ldz, &work_query, lwork,
- &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbgvd_work( matrix_order, jobz, uplo, n, ka, kb, ab, ldab,
- bb, ldbb, w, z, ldz, work, lwork, iwork,
- liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgvd_work.c b/netlib/LAPACKE/lapacke_ssbgvd_work.c
deleted file mode 100644
index f47f52e..0000000
--- a/netlib/LAPACKE/lapacke_ssbgvd_work.c
+++ /dev/null
@@ -1,132 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgvd( &jobz, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, w, z,
- &ldz, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldz_t = MAX(1,n);
- float* ab_t = NULL;
- float* bb_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_ssbgvd( &jobz, &uplo, &n, &ka, &kb, ab, &ldab_t, bb, &ldbb_t,
- w, z, &ldz_t, work, &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (float*)LAPACKE_malloc( sizeof(float) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_ssb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgvd( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
- w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgvx.c b/netlib/LAPACKE/lapacke_ssbgvx.c
deleted file mode 100644
index f51bd9a..0000000
--- a/netlib/LAPACKE/lapacke_ssbgvx.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, ka, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -18;
- }
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kb, bb, ldbb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -14;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -15;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,7*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbgvx_work( matrix_order, jobz, range, uplo, n, ka, kb, ab,
- ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol,
- m, w, z, ldz, work, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbgvx_work.c b/netlib/LAPACKE/lapacke_ssbgvx_work.c
deleted file mode 100644
index 6515982..0000000
--- a/netlib/LAPACKE/lapacke_ssbgvx_work.c
+++ /dev/null
@@ -1,152 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, float* ab, lapack_int ldab,
- float* bb, lapack_int ldbb, float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb,
- q, &ldq, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz,
- work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,ka+1);
- lapack_int ldbb_t = MAX(1,kb+1);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* ab_t = NULL;
- float* bb_t = NULL;
- float* q_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info );
- return info;
- }
- if( ldbb < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -22;
- LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bb_t = (float*)LAPACKE_malloc( sizeof(float) * ldbb_t * MAX(1,n) );
- if( bb_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
- LAPACKE_ssb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t,
- &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w,
- z_t, &ldz_t, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
- ldab );
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
- ldbb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( bb_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbtrd.c b/netlib/LAPACKE/lapacke_ssbtrd.c
deleted file mode 100644
index dd2b9b6..0000000
--- a/netlib/LAPACKE/lapacke_ssbtrd.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssbtrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* d,
- float* e, float* q, lapack_int ldq )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssbtrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssbtrd_work( matrix_order, vect, uplo, n, kd, ab, ldab, d, e,
- q, ldq, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbtrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssbtrd_work.c b/netlib/LAPACKE/lapacke_ssbtrd_work.c
deleted file mode 100644
index fb730a7..0000000
--- a/netlib/LAPACKE/lapacke_ssbtrd_work.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssbtrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* d, float* e, float* q,
- lapack_int ldq, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssbtrd( &vect, &uplo, &n, &kd, ab, &ldab, d, e, q, &ldq, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldq_t = MAX(1,n);
- float* ab_t = NULL;
- float* q_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t );
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_ssbtrd( &vect, &uplo, &n, &kd, ab_t, &ldab_t, d, e, q_t, &ldq_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
- ldab );
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssfrk.c b/netlib/LAPACKE/lapacke_ssfrk.c
deleted file mode 100644
index 2a6ac48..0000000
--- a/netlib/LAPACKE/lapacke_ssfrk.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssfrk
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, float alpha,
- const float* a, lapack_int lda, float beta, float* c )
-{
- lapack_int ka, na;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssfrk", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- if( LAPACKE_sge_nancheck( matrix_order, na, ka, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_spf_nancheck( n, c ) ) {
- return -11;
- }
-#endif
- return LAPACKE_ssfrk_work( matrix_order, transr, uplo, trans, n, k, alpha,
- a, lda, beta, c );
-}
diff --git a/netlib/LAPACKE/lapacke_ssfrk_work.c b/netlib/LAPACKE/lapacke_ssfrk_work.c
deleted file mode 100644
index 13145ac..0000000
--- a/netlib/LAPACKE/lapacke_ssfrk_work.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssfrk
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- float alpha, const float* a, lapack_int lda,
- float beta, float* c )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a, &lda, &beta,
- c );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- lapack_int ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- lapack_int lda_t = MAX(1,na);
- float* a_t = NULL;
- float* c_t = NULL;
- /* Check leading dimension(s) */
- if( lda < ka ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssfrk_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,ka) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- c_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, na, ka, a, lda, a_t, lda_t );
- LAPACKE_spf_trans( matrix_order, transr, uplo, n, c, c_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t,
- &beta, c_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssfrk_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssfrk_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssp_nancheck.c b/netlib/LAPACKE/lapacke_ssp_nancheck.c
deleted file mode 100644
index 5e3b7cc..0000000
--- a/netlib/LAPACKE/lapacke_ssp_nancheck.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo or matrix_order.
- */
-
-lapack_logical LAPACKE_ssp_nancheck( lapack_int n,
- const float *ap )
-{
- lapack_int len = n*(n+1)/2;
- return LAPACKE_s_nancheck( len, ap, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_ssp_trans.c b/netlib/LAPACKE/lapacke_ssp_trans.c
deleted file mode 100644
index 95f6033..0000000
--- a/netlib/LAPACKE/lapacke_ssp_trans.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric packed matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_ssp_trans( int matrix_order, char uplo, lapack_int n,
- const float *in,
- float *out )
-{
- LAPACKE_stp_trans( matrix_order, uplo, 'n', n, in, out );
-}
-
diff --git a/netlib/LAPACKE/lapacke_sspcon.c b/netlib/LAPACKE/lapacke_sspcon.c
deleted file mode 100644
index 12706ad..0000000
--- a/netlib/LAPACKE/lapacke_sspcon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspcon( int matrix_order, char uplo, lapack_int n,
- const float* ap, const lapack_int* ipiv, float anorm,
- float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspcon_work( matrix_order, uplo, n, ap, ipiv, anorm, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspcon_work.c b/netlib/LAPACKE/lapacke_sspcon_work.c
deleted file mode 100644
index beab795..0000000
--- a/netlib/LAPACKE/lapacke_sspcon_work.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspcon_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspcon( &uplo, &n, ap, ipiv, &anorm, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspev.c b/netlib/LAPACKE/lapacke_sspev.c
deleted file mode 100644
index 21466f0..0000000
--- a/netlib/LAPACKE/lapacke_sspev.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspev( int matrix_order, char jobz, char uplo, lapack_int n,
- float* ap, float* w, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspev_work( matrix_order, jobz, uplo, n, ap, w, z, ldz,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspev_work.c b/netlib/LAPACKE/lapacke_sspev_work.c
deleted file mode 100644
index e02cbd4..0000000
--- a/netlib/LAPACKE/lapacke_sspev_work.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* ap, float* w, float* z,
- lapack_int ldz, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspev( &jobz, &uplo, &n, ap, w, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sspev_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspev( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspevd.c b/netlib/LAPACKE/lapacke_sspevd.c
deleted file mode 100644
index eece4f7..0000000
--- a/netlib/LAPACKE/lapacke_sspevd.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspevd( int matrix_order, char jobz, char uplo, lapack_int n,
- float* ap, float* w, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sspevd_work( matrix_order, jobz, uplo, n, ap, w, z, ldz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspevd_work( matrix_order, jobz, uplo, n, ap, w, z, ldz,
- work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspevd_work.c b/netlib/LAPACKE/lapacke_sspevd_work.c
deleted file mode 100644
index 606b97a..0000000
--- a/netlib/LAPACKE/lapacke_sspevd_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* ap, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspevd( &jobz, &uplo, &n, ap, w, z, &ldz, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sspevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sspevd( &jobz, &uplo, &n, ap, w, z, &ldz_t, work, &lwork,
- iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork,
- iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspevx.c b/netlib/LAPACKE/lapacke_sspevx.c
deleted file mode 100644
index 497d7ed..0000000
--- a/netlib/LAPACKE/lapacke_sspevx.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* ap, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,8*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspevx_work( matrix_order, jobz, range, uplo, n, ap, vl, vu,
- il, iu, abstol, m, w, z, ldz, work, iwork,
- ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspevx_work.c b/netlib/LAPACKE/lapacke_sspevx_work.c
deleted file mode 100644
index f2b6a9d..0000000
--- a/netlib/LAPACKE/lapacke_sspevx_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* ap, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspevx( &jobz, &range, &uplo, &n, ap, &vl, &vu, &il, &iu,
- &abstol, m, w, z, &ldz, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sspevx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspevx( &jobz, &range, &uplo, &n, ap_t, &vl, &vu, &il, &iu,
- &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgst.c b/netlib/LAPACKE/lapacke_sspgst.c
deleted file mode 100644
index f4dde6f..0000000
--- a/netlib/LAPACKE/lapacke_sspgst.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* ap, const float* bp )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspgst", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -6;
- }
-#endif
- return LAPACKE_sspgst_work( matrix_order, itype, uplo, n, ap, bp );
-}
diff --git a/netlib/LAPACKE/lapacke_sspgst_work.c b/netlib/LAPACKE/lapacke_sspgst_work.c
deleted file mode 100644
index e24e3d9..0000000
--- a/netlib/LAPACKE/lapacke_sspgst_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspgst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* ap, const float* bp )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspgst( &itype, &uplo, &n, ap, bp, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- float* bp_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- bp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspgst( &itype, &uplo, &n, ap_t, bp_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_1:
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgst_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspgst_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgv.c b/netlib/LAPACKE/lapacke_sspgv.c
deleted file mode 100644
index 128bd56..0000000
--- a/netlib/LAPACKE/lapacke_sspgv.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspgv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspgv_work( matrix_order, itype, jobz, uplo, n, ap, bp, w, z,
- ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgv_work.c b/netlib/LAPACKE/lapacke_sspgv_work.c
deleted file mode 100644
index 9b2e069..0000000
--- a/netlib/LAPACKE/lapacke_sspgv_work.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspgv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspgv( &itype, &jobz, &uplo, &n, ap, bp, w, z, &ldz, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- float* ap_t = NULL;
- float* bp_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sspgv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- bp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspgv( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t,
- work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_2:
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspgv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgvd.c b/netlib/LAPACKE/lapacke_sspgvd.c
deleted file mode 100644
index 4c314e5..0000000
--- a/netlib/LAPACKE/lapacke_sspgvd.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspgvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -7;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sspgvd_work( matrix_order, itype, jobz, uplo, n, ap, bp, w,
- z, ldz, &work_query, lwork, &iwork_query,
- liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspgvd_work( matrix_order, itype, jobz, uplo, n, ap, bp, w,
- z, ldz, work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgvd_work.c b/netlib/LAPACKE/lapacke_sspgvd_work.c
deleted file mode 100644
index a3984e1..0000000
--- a/netlib/LAPACKE/lapacke_sspgvd_work.c
+++ /dev/null
@@ -1,119 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspgvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspgvd( &itype, &jobz, &uplo, &n, ap, bp, w, z, &ldz, work,
- &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- float* ap_t = NULL;
- float* bp_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sspgvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sspgvd( &itype, &jobz, &uplo, &n, ap, bp, w, z, &ldz_t, work,
- &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- bp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspgvd( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_2:
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspgvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgvx.c b/netlib/LAPACKE/lapacke_sspgvx.c
deleted file mode 100644
index 1c33548..0000000
--- a/netlib/LAPACKE/lapacke_sspgvx.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* ap,
- float* bp, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- float* z, lapack_int ldz, lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspgvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -13;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -7;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -8;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -9;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,8*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspgvx_work( matrix_order, itype, jobz, range, uplo, n, ap,
- bp, vl, vu, il, iu, abstol, m, w, z, ldz, work,
- iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspgvx_work.c b/netlib/LAPACKE/lapacke_sspgvx_work.c
deleted file mode 100644
index 32dacac..0000000
--- a/netlib/LAPACKE/lapacke_sspgvx_work.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspgvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* ap,
- float* bp, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int* iwork, lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspgvx( &itype, &jobz, &range, &uplo, &n, ap, bp, &vl, &vu, &il,
- &iu, &abstol, m, w, z, &ldz, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- float* ap_t = NULL;
- float* bp_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sspgvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- bp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( bp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, bp, bp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu,
- &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp );
- /* Release memory and exit */
- LAPACKE_free( bp_t );
-exit_level_2:
- LAPACKE_free( ap_t );
-exit_level_1:
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspgvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspgvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssprfs.c b/netlib/LAPACKE/lapacke_ssprfs.c
deleted file mode 100644
index 89b5512..0000000
--- a/netlib/LAPACKE/lapacke_ssprfs.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, const float* afp,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssprfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssprfs_work( matrix_order, uplo, n, nrhs, ap, afp, ipiv, b,
- ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssprfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssprfs_work.c b/netlib/LAPACKE/lapacke_ssprfs_work.c
deleted file mode 100644
index 8c3acd7..0000000
--- a/netlib/LAPACKE/lapacke_ssprfs_work.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const float* afp, const lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssprfs( &uplo, &n, &nrhs, ap, afp, ipiv, b, &ldb, x, &ldx, ferr,
- berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- float* ap_t = NULL;
- float* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssprfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_ssprfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, afp, afp_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t,
- &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssprfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssprfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspsv.c b/netlib/LAPACKE/lapacke_sspsv.c
deleted file mode 100644
index 3b1a3b0..0000000
--- a/netlib/LAPACKE/lapacke_sspsv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, lapack_int* ipiv,
- float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspsv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_sspsv_work( matrix_order, uplo, n, nrhs, ap, ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_sspsv_work.c b/netlib/LAPACKE/lapacke_sspsv_work.c
deleted file mode 100644
index 03c156d..0000000
--- a/netlib/LAPACKE/lapacke_sspsv_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspsv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, lapack_int* ipiv,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspsv( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sspsv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sspsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspsv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspsv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspsvx.c b/netlib/LAPACKE/lapacke_sspsvx.c
deleted file mode 100644
index 0dfb4ef..0000000
--- a/netlib/LAPACKE/lapacke_sspsvx.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sspsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* afp,
- lapack_int* ipiv, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sspsvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_ssp_nancheck( n, afp ) ) {
- return -7;
- }
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sspsvx_work( matrix_order, fact, uplo, n, nrhs, ap, afp,
- ipiv, b, ldb, x, ldx, rcond, ferr, berr, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspsvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sspsvx_work.c b/netlib/LAPACKE/lapacke_sspsvx_work.c
deleted file mode 100644
index 7406705..0000000
--- a/netlib/LAPACKE/lapacke_sspsvx_work.c
+++ /dev/null
@@ -1,126 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sspsvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const float* ap,
- float* afp, lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sspsvx( &fact, &uplo, &n, &nrhs, ap, afp, ipiv, b, &ldb, x, &ldx,
- rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- float* ap_t = NULL;
- float* afp_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sspsvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sspsvx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- afp_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( afp_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_ssp_trans( matrix_order, uplo, n, afp, afp_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sspsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t,
- x_t, &ldx_t, rcond, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- if( LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp );
- }
- /* Release memory and exit */
- LAPACKE_free( afp_t );
-exit_level_3:
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sspsvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sspsvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssptrd.c b/netlib/LAPACKE/lapacke_ssptrd.c
deleted file mode 100644
index 72c33cb..0000000
--- a/netlib/LAPACKE/lapacke_ssptrd.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssptrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptrd( int matrix_order, char uplo, lapack_int n, float* ap,
- float* d, float* e, float* tau )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssptrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_ssptrd_work( matrix_order, uplo, n, ap, d, e, tau );
-}
diff --git a/netlib/LAPACKE/lapacke_ssptrd_work.c b/netlib/LAPACKE/lapacke_ssptrd_work.c
deleted file mode 100644
index bb809db..0000000
--- a/netlib/LAPACKE/lapacke_ssptrd_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssptrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptrd_work( int matrix_order, char uplo, lapack_int n,
- float* ap, float* d, float* e, float* tau )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssptrd( &uplo, &n, ap, d, e, tau, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssptrd( &uplo, &n, ap_t, d, e, tau, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssptrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssptrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssptrf.c b/netlib/LAPACKE/lapacke_ssptrf.c
deleted file mode 100644
index dad59f1..0000000
--- a/netlib/LAPACKE/lapacke_ssptrf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptrf( int matrix_order, char uplo, lapack_int n, float* ap,
- lapack_int* ipiv )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssptrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_ssptrf_work( matrix_order, uplo, n, ap, ipiv );
-}
diff --git a/netlib/LAPACKE/lapacke_ssptrf_work.c b/netlib/LAPACKE/lapacke_ssptrf_work.c
deleted file mode 100644
index 3bf2101..0000000
--- a/netlib/LAPACKE/lapacke_ssptrf_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssptrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptrf_work( int matrix_order, char uplo, lapack_int n,
- float* ap, lapack_int* ipiv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssptrf( &uplo, &n, ap, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssptrf( &uplo, &n, ap_t, ipiv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssptrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssptrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssptri.c b/netlib/LAPACKE/lapacke_ssptri.c
deleted file mode 100644
index 8026d15..0000000
--- a/netlib/LAPACKE/lapacke_ssptri.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptri( int matrix_order, char uplo, lapack_int n, float* ap,
- const lapack_int* ipiv )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssptri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssptri_work( matrix_order, uplo, n, ap, ipiv, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssptri", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssptri_work.c b/netlib/LAPACKE/lapacke_ssptri_work.c
deleted file mode 100644
index c123822..0000000
--- a/netlib/LAPACKE/lapacke_ssptri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptri_work( int matrix_order, char uplo, lapack_int n,
- float* ap, const lapack_int* ipiv, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssptri( &uplo, &n, ap, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssptri( &uplo, &n, ap_t, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssptri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssptri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssptrs.c b/netlib/LAPACKE/lapacke_ssptrs.c
deleted file mode 100644
index 55b6bb1..0000000
--- a/netlib/LAPACKE/lapacke_ssptrs.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const lapack_int* ipiv, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssptrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_ssptrs_work( matrix_order, uplo, n, nrhs, ap, ipiv, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_ssptrs_work.c b/netlib/LAPACKE/lapacke_ssptrs_work.c
deleted file mode 100644
index f4d8552..0000000
--- a/netlib/LAPACKE/lapacke_ssptrs_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssptrs( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssptrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssptrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssptrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sst_nancheck.c b/netlib/LAPACKE/lapacke_sst_nancheck.c
deleted file mode 100644
index e82a26a..0000000
--- a/netlib/LAPACKE/lapacke_sst_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_sst_nancheck( lapack_int n,
- const float *d,
- const float *e )
-{
- return LAPACKE_s_nancheck( n, d, 1 )
- || LAPACKE_s_nancheck( n-1, e, 1 );
-}
diff --git a/netlib/LAPACKE/lapacke_sstebz.c b/netlib/LAPACKE/lapacke_sstebz.c
deleted file mode 100644
index 9225729..0000000
--- a/netlib/LAPACKE/lapacke_sstebz.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstebz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- const float* d, const float* e, lapack_int* m,
- lapack_int* nsplit, float* w, lapack_int* iblock,
- lapack_int* isplit )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -4;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -5;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,3*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstebz_work( range, order, n, vl, vu, il, iu, abstol, d, e,
- m, nsplit, w, iblock, isplit, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstebz", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstebz_work.c b/netlib/LAPACKE/lapacke_sstebz_work.c
deleted file mode 100644
index c1aa94c..0000000
--- a/netlib/LAPACKE/lapacke_sstebz_work.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstebz
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstebz_work( char range, char order, lapack_int n, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, const float* d, const float* e,
- lapack_int* m, lapack_int* nsplit, float* w,
- lapack_int* iblock, lapack_int* isplit,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_sstebz( &range, &order, &n, &vl, &vu, &il, &iu, &abstol, d, e, m,
- nsplit, w, iblock, isplit, work, iwork, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstedc.c b/netlib/LAPACKE/lapacke_sstedc.c
deleted file mode 100644
index 423286e..0000000
--- a/netlib/LAPACKE/lapacke_sstedc.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstedc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstedc( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstedc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -6;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sstedc_work( matrix_order, compz, n, d, e, z, ldz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstedc_work( matrix_order, compz, n, d, e, z, ldz, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstedc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstedc_work.c b/netlib/LAPACKE/lapacke_sstedc_work.c
deleted file mode 100644
index 309de42..0000000
--- a/netlib/LAPACKE/lapacke_sstedc_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstedc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstedc_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstedc( &compz, &n, d, e, z, &ldz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sstedc_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sstedc( &compz, &n, d, e, z, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstedc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstedc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstegr.c b/netlib/LAPACKE/lapacke_sstegr.c
deleted file mode 100644
index 5170d4f..0000000
--- a/netlib/LAPACKE/lapacke_sstegr.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstegr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstegr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstegr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sstegr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, &work_query,
- lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstegr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, work, lwork,
- iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstegr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstegr_work.c b/netlib/LAPACKE/lapacke_sstegr_work.c
deleted file mode 100644
index 90188d2..0000000
--- a/netlib/LAPACKE/lapacke_sstegr_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstegr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstegr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z, &ldz, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < *m ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sstegr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sstegr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol,
- m, w, z, &ldz_t, isuppz, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- /* Let be always 'n' instead of 'm' */
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstegr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z_t, &ldz_t, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstegr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstegr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstein.c b/netlib/LAPACKE/lapacke_sstein.c
deleted file mode 100644
index e932abd..0000000
--- a/netlib/LAPACKE/lapacke_sstein.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstein( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock, const lapack_int* isplit,
- float* z, lapack_int ldz, lapack_int* ifailv )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstein", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, w, 1 ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,5*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstein_work( matrix_order, n, d, e, m, w, iblock, isplit, z,
- ldz, work, iwork, ifailv );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstein", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstein_work.c b/netlib/LAPACKE/lapacke_sstein_work.c
deleted file mode 100644
index 3aec799..0000000
--- a/netlib/LAPACKE/lapacke_sstein_work.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstein
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstein_work( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock,
- const lapack_int* isplit, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifailv )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstein( &n, d, e, &m, w, iblock, isplit, z, &ldz, work, iwork,
- ifailv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < m ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sstein_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,m) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstein( &n, d, e, &m, w, iblock, isplit, z_t, &ldz_t, work,
- iwork, ifailv, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz );
- /* Release memory and exit */
- LAPACKE_free( z_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstein_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstein_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstemr.c b/netlib/LAPACKE/lapacke_sstemr.c
deleted file mode 100644
index 3db6fbe..0000000
--- a/netlib/LAPACKE/lapacke_sstemr.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstemr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstemr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* m,
- float* w, float* z, lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstemr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sstemr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, m, w, z, ldz, nzc, isuppz, tryrac,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstemr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, m, w, z, ldz, nzc, isuppz, tryrac, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstemr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstemr_work.c b/netlib/LAPACKE/lapacke_sstemr_work.c
deleted file mode 100644
index 384aecc..0000000
--- a/netlib/LAPACKE/lapacke_sstemr_work.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstemr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z,
- &ldz, &nzc, isuppz, tryrac, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sstemr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z,
- &ldz_t, &nzc, isuppz, tryrac, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z_t,
- &ldz_t, &nzc, isuppz, tryrac, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstemr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstemr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssteqr.c b/netlib/LAPACKE/lapacke_ssteqr.c
deleted file mode 100644
index cc409f8..0000000
--- a/netlib/LAPACKE/lapacke_ssteqr.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- /* Additional scalars declarations for work arrays */
- lapack_int lwork;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssteqr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -6;
- }
- }
-#endif
- /* Additional scalars initializations for work arrays */
- if( LAPACKE_lsame( compz, 'n' ) ) {
- lwork = 1;
- } else {
- lwork = MAX(1,2*n-2);
- }
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssteqr_work( matrix_order, compz, n, d, e, z, ldz, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssteqr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssteqr_work.c b/netlib/LAPACKE/lapacke_ssteqr_work.c
deleted file mode 100644
index 3047504..0000000
--- a/netlib/LAPACKE/lapacke_ssteqr_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssteqr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssteqr( &compz, &n, d, e, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssteqr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_ssteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssteqr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssteqr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssterf.c b/netlib/LAPACKE/lapacke_ssterf.c
deleted file mode 100644
index d42384d..0000000
--- a/netlib/LAPACKE/lapacke_ssterf.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssterf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssterf( lapack_int n, float* d, float* e )
-{
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -3;
- }
-#endif
- return LAPACKE_ssterf_work( n, d, e );
-}
diff --git a/netlib/LAPACKE/lapacke_ssterf_work.c b/netlib/LAPACKE/lapacke_ssterf_work.c
deleted file mode 100644
index 7e22c2f..0000000
--- a/netlib/LAPACKE/lapacke_ssterf_work.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssterf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssterf_work( lapack_int n, float* d, float* e )
-{
- lapack_int info = 0;
- /* Call LAPACK function and adjust info */
- LAPACK_ssterf( &n, d, e, &info );
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstev.c b/netlib/LAPACKE/lapacke_sstev.c
deleted file mode 100644
index d60bef4..0000000
--- a/netlib/LAPACKE/lapacke_sstev.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstev( int matrix_order, char jobz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n-2) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call middle-level interface */
- info = LAPACKE_sstev_work( matrix_order, jobz, n, d, e, z, ldz, work );
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( work );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstev_work.c b/netlib/LAPACKE/lapacke_sstev_work.c
deleted file mode 100644
index 0b9afc5..0000000
--- a/netlib/LAPACKE/lapacke_sstev_work.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstev_work( int matrix_order, char jobz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstev( &jobz, &n, d, e, z, &ldz, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sstev_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstev( &jobz, &n, d, e, z_t, &ldz_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstevd.c b/netlib/LAPACKE/lapacke_sstevd.c
deleted file mode 100644
index 15e5a30..0000000
--- a/netlib/LAPACKE/lapacke_sstevd.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstevd( int matrix_order, char jobz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sstevd_work( matrix_order, jobz, n, d, e, z, ldz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstevd_work( matrix_order, jobz, n, d, e, z, ldz, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstevd_work.c b/netlib/LAPACKE/lapacke_sstevd_work.c
deleted file mode 100644
index 62fee85..0000000
--- a/netlib/LAPACKE/lapacke_sstevd_work.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstevd_work( int matrix_order, char jobz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstevd( &jobz, &n, d, e, z, &ldz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_sstevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sstevd( &jobz, &n, d, e, z, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstevd( &jobz, &n, d, e, z_t, &ldz_t, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstevr.c b/netlib/LAPACKE/lapacke_sstevr.c
deleted file mode 100644
index de1cea4..0000000
--- a/netlib/LAPACKE/lapacke_sstevr.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstevr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstevr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_sstevr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, &work_query,
- lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstevr_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, isuppz, work, lwork,
- iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstevr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstevr_work.c b/netlib/LAPACKE/lapacke_sstevr_work.c
deleted file mode 100644
index d5ee71d..0000000
--- a/netlib/LAPACKE/lapacke_sstevr_work.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstevr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z, &ldz, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sstevr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_sstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol,
- m, w, z, &ldz_t, isuppz, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z_t, &ldz_t, isuppz, work, &lwork, iwork, &liwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstevr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstevr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstevx.c b/netlib/LAPACKE/lapacke_sstevx.c
deleted file mode 100644
index 56bca6b..0000000
--- a/netlib/LAPACKE/lapacke_sstevx.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function sstevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstevx( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_sstevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,5*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_sstevx_work( matrix_order, jobz, range, n, d, e, vl, vu, il,
- iu, abstol, m, w, z, ldz, work, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_sstevx_work.c b/netlib/LAPACKE/lapacke_sstevx_work.c
deleted file mode 100644
index 52d9696..0000000
--- a/netlib/LAPACKE/lapacke_sstevx_work.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sstevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sstevx_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sstevx( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z, &ldz, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int ldz_t = MAX(1,n);
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( ldz < ncols_z ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sstevx_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sstevx( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
- w, z_t, &ldz_t, work, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sstevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_sstevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssy_nancheck.c b/netlib/LAPACKE/lapacke_ssy_nancheck.c
deleted file mode 100644
index 2894a82..0000000
--- a/netlib/LAPACKE/lapacke_ssy_nancheck.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_ssy_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const float *a,
- lapack_int lda )
-{
- return LAPACKE_str_nancheck( matrix_order, uplo, 'n', n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_ssy_trans.c b/netlib/LAPACKE/lapacke_ssy_trans.c
deleted file mode 100644
index ad49462..0000000
--- a/netlib/LAPACKE/lapacke_ssy_trans.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input symmetric matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_ssy_trans( int matrix_order, char uplo, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- LAPACKE_str_trans( matrix_order, uplo, 'n', n, in, ldin, out, ldout );
-}
diff --git a/netlib/LAPACKE/lapacke_ssycon.c b/netlib/LAPACKE/lapacke_ssycon.c
deleted file mode 100644
index 58f3388..0000000
--- a/netlib/LAPACKE/lapacke_ssycon.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssycon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssycon( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssycon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssycon_work( matrix_order, uplo, n, a, lda, ipiv, anorm,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssycon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssycon_work.c b/netlib/LAPACKE/lapacke_ssycon_work.c
deleted file mode 100644
index 266b913..0000000
--- a/netlib/LAPACKE/lapacke_ssycon_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssycon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssycon_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssycon( &uplo, &n, a, &lda, ipiv, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssycon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssycon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssycon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssycon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyconv.c b/netlib/LAPACKE/lapacke_ssyconv.c
deleted file mode 100644
index f379fcc..0000000
--- a/netlib/LAPACKE/lapacke_ssyconv.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyconv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyconv( int matrix_order, char uplo, char way, lapack_int n,
- float* a, lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyconv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, lda, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyconv_work( matrix_order, uplo, way, n, a, lda, ipiv,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyconv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyconv_work.c b/netlib/LAPACKE/lapacke_ssyconv_work.c
deleted file mode 100644
index 497d63f..0000000
--- a/netlib/LAPACKE/lapacke_ssyconv_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyconv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, float* a, lapack_int lda,
- const lapack_int* ipiv, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,lda);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssyconv_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, lda, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyconv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyconv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyequb.c b/netlib/LAPACKE/lapacke_ssyequb.c
deleted file mode 100644
index 2b7ff0a..0000000
--- a/netlib/LAPACKE/lapacke_ssyequb.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyequb( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* s,
- float* scond, float* amax )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyequb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyequb_work( matrix_order, uplo, n, a, lda, s, scond, amax,
- work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyequb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyequb_work.c b/netlib/LAPACKE/lapacke_ssyequb_work.c
deleted file mode 100644
index ad6377d..0000000
--- a/netlib/LAPACKE/lapacke_ssyequb_work.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyequb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyequb_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* s,
- float* scond, float* amax, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyequb( &uplo, &n, a, &lda, s, scond, amax, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssyequb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyequb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyequb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyev.c b/netlib/LAPACKE/lapacke_ssyev.c
deleted file mode 100644
index 3cbce41..0000000
--- a/netlib/LAPACKE/lapacke_ssyev.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyev( int matrix_order, char jobz, char uplo, lapack_int n,
- float* a, lapack_int lda, float* w )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyev", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssyev_work( matrix_order, jobz, uplo, n, a, lda, w,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyev_work( matrix_order, jobz, uplo, n, a, lda, w, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyev", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyev_work.c b/netlib/LAPACKE/lapacke_ssyev_work.c
deleted file mode 100644
index e1fa92a..0000000
--- a/netlib/LAPACKE/lapacke_ssyev_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyev
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* a, lapack_int lda, float* w,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyev( &jobz, &uplo, &n, a, &lda, w, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssyev_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssyev( &jobz, &uplo, &n, a, &lda_t, w, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyev_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyev_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyevd.c b/netlib/LAPACKE/lapacke_ssyevd.c
deleted file mode 100644
index ffdebd0..0000000
--- a/netlib/LAPACKE/lapacke_ssyevd.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyevd( int matrix_order, char jobz, char uplo, lapack_int n,
- float* a, lapack_int lda, float* w )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssyevd_work( matrix_order, jobz, uplo, n, a, lda, w,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyevd_work( matrix_order, jobz, uplo, n, a, lda, w, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyevd_work.c b/netlib/LAPACKE/lapacke_ssyevd_work.c
deleted file mode 100644
index c9923e4..0000000
--- a/netlib/LAPACKE/lapacke_ssyevd_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyevd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* a, lapack_int lda,
- float* w, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyevd( &jobz, &uplo, &n, a, &lda, w, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssyevd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_ssyevd( &jobz, &uplo, &n, a, &lda_t, w, work, &lwork, iwork,
- &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyevd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyevr.c b/netlib/LAPACKE/lapacke_ssyevr.c
deleted file mode 100644
index 555c979..0000000
--- a/netlib/LAPACKE/lapacke_ssyevr.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* a, lapack_int lda, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssyevr_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, isuppz,
- &work_query, lwork, &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyevr_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, isuppz, work,
- lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevr", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyevr_work.c b/netlib/LAPACKE/lapacke_ssyevr_work.c
deleted file mode 100644
index 11d49aa..0000000
--- a/netlib/LAPACKE/lapacke_ssyevr_work.c
+++ /dev/null
@@ -1,124 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyevr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyevr( &jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il, &iu,
- &abstol, m, w, z, &ldz, isuppz, work, &lwork, iwork,
- &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int lda_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* a_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssyevr_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_ssyevr_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_ssyevr( &jobz, &range, &uplo, &n, a, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z, &ldz_t, isuppz, work, &lwork,
- iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork,
- iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyevr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyevx.c b/netlib/LAPACKE/lapacke_ssyevx.c
deleted file mode 100644
index 23a08dd..0000000
--- a/netlib/LAPACKE/lapacke_ssyevx.c
+++ /dev/null
@@ -1,103 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* a, lapack_int lda, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_ssyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, &work_query,
- lwork, iwork, ifail );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
- vu, il, iu, abstol, m, w, z, ldz, work, lwork,
- iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyevx_work.c b/netlib/LAPACKE/lapacke_ssyevx_work.c
deleted file mode 100644
index 7b309c0..0000000
--- a/netlib/LAPACKE/lapacke_ssyevx_work.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyevx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyevx( &jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il, &iu,
- &abstol, m, w, z, &ldz, work, &lwork, iwork, ifail,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int lda_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* a_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssyevx_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_ssyevx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssyevx( &jobz, &range, &uplo, &n, a, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z, &ldz_t, work, &lwork, iwork,
- ifail, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyevx( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il,
- &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork,
- ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyevx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyevx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygst.c b/netlib/LAPACKE/lapacke_ssygst.c
deleted file mode 100644
index 46a9170..0000000
--- a/netlib/LAPACKE/lapacke_ssygst.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssygst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* a, lapack_int lda,
- const float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssygst", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -7;
- }
-#endif
- return LAPACKE_ssygst_work( matrix_order, itype, uplo, n, a, lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_ssygst_work.c b/netlib/LAPACKE/lapacke_ssygst_work.c
deleted file mode 100644
index 71b42bc..0000000
--- a/netlib/LAPACKE/lapacke_ssygst_work.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssygst
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* a, lapack_int lda,
- const float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssygst( &itype, &uplo, &n, a, &lda, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssygst_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssygst_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssygst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygst_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssygst_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygv.c b/netlib/LAPACKE/lapacke_ssygv.c
deleted file mode 100644
index 2e837e1..0000000
--- a/netlib/LAPACKE/lapacke_ssygv.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssygv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* w )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssygv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssygv_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssygv_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygv_work.c b/netlib/LAPACKE/lapacke_ssygv_work.c
deleted file mode 100644
index b8108e0..0000000
--- a/netlib/LAPACKE/lapacke_ssygv_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssygv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* w, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssygv( &itype, &jobz, &uplo, &n, a, &lda, b, &ldb, w, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssygv_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssygv_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssygv( &itype, &jobz, &uplo, &n, a, &lda_t, b, &ldb_t, w,
- work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssygv( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w,
- work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssygv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygvd.c b/netlib/LAPACKE/lapacke_ssygvd.c
deleted file mode 100644
index e037157..0000000
--- a/netlib/LAPACKE/lapacke_ssygvd.c
+++ /dev/null
@@ -1,92 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssygvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* w )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssygvd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssygvd_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, &work_query, lwork, &iwork_query,
- liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssygvd_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
- ldb, w, work, lwork, iwork, liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygvd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygvd_work.c b/netlib/LAPACKE/lapacke_ssygvd_work.c
deleted file mode 100644
index 8bfaa46..0000000
--- a/netlib/LAPACKE/lapacke_ssygvd_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssygvd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* w, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssygvd( &itype, &jobz, &uplo, &n, a, &lda, b, &ldb, w, work,
- &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssygvd_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssygvd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_ssygvd( &itype, &jobz, &uplo, &n, a, &lda_t, b, &ldb_t, w,
- work, &lwork, iwork, &liwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssygvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygvd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssygvd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygvx.c b/netlib/LAPACKE/lapacke_ssygvx.c
deleted file mode 100644
index 8c9df2a..0000000
--- a/netlib/LAPACKE/lapacke_ssygvx.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssygvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssygvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
- }
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_ssygvx_work( matrix_order, itype, jobz, range, uplo, n, a,
- lda, b, ldb, vl, vu, il, iu, abstol, m, w, z,
- ldz, &work_query, lwork, iwork, ifail );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssygvx_work( matrix_order, itype, jobz, range, uplo, n, a,
- lda, b, ldb, vl, vu, il, iu, abstol, m, w, z,
- ldz, work, lwork, iwork, ifail );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssygvx_work.c b/netlib/LAPACKE/lapacke_ssygvx_work.c
deleted file mode 100644
index f3e44c3..0000000
--- a/netlib/LAPACKE/lapacke_ssygvx_work.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssygvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssygvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int* ifail )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a, &lda, b, &ldb, &vl,
- &vu, &il, &iu, &abstol, m, w, z, &ldz, work, &lwork,
- iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
- ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
- return info;
- }
- if( ldz < ncols_z ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a, &lda_t, b,
- &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz_t,
- work, &lwork, iwork, ifail, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t,
- &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t,
- work, &lwork, iwork, ifail, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
- ldz );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobz, 'v' ) ) {
- LAPACKE_free( z_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyrfs.c b/netlib/LAPACKE/lapacke_ssyrfs.c
deleted file mode 100644
index e656b1d..0000000
--- a/netlib/LAPACKE/lapacke_ssyrfs.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssyrfs_work( matrix_order, uplo, n, nrhs, a, lda, af, ldaf,
- ipiv, b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyrfs_work.c b/netlib/LAPACKE/lapacke_ssyrfs_work.c
deleted file mode 100644
index 678740f..0000000
--- a/netlib/LAPACKE/lapacke_ssyrfs_work.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyrfs( &uplo, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b, &ldb, x,
- &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* af_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_ssy_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyrfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssysv.c b/netlib/LAPACKE/lapacke_ssysv.c
deleted file mode 100644
index 4d3fae7..0000000
--- a/netlib/LAPACKE/lapacke_ssysv.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssysv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- lapack_int* ipiv, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssysv", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssysv_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb, &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssysv_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssysv", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssysv_work.c b/netlib/LAPACKE/lapacke_ssysv_work.c
deleted file mode 100644
index ec7dd9f..0000000
--- a/netlib/LAPACKE/lapacke_ssysv_work.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssysv
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- lapack_int* ipiv, float* b, lapack_int ldb,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssysv( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssysv_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssysv_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssysv( &uplo, &n, &nrhs, a, &lda_t, ipiv, b, &ldb_t, work,
- &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
- &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssysv_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssysv_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssysvx.c b/netlib/LAPACKE/lapacke_ssysvx.c
deleted file mode 100644
index c657792..0000000
--- a/netlib/LAPACKE/lapacke_ssysvx.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssysvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* af, lapack_int ldaf, lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssysvx", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
- return -8;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -11;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_ssysvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af,
- ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr,
- &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssysvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af,
- ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr,
- work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssysvx", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssysvx_work.c b/netlib/LAPACKE/lapacke_ssysvx_work.c
deleted file mode 100644
index 197d74e..0000000
--- a/netlib/LAPACKE/lapacke_ssysvx_work.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssysvx
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssysvx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b,
- &ldb, x, &ldx, rcond, ferr, berr, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldaf_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* af_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_ssysvx_work", info );
- return info;
- }
- if( ldaf < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssysvx_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_ssysvx_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_ssysvx_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssysvx( &fact, &uplo, &n, &nrhs, a, &lda_t, af, &ldaf_t,
- ipiv, b, &ldb_t, x, &ldx_t, rcond, ferr, berr, work,
- &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
- if( af_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- if( LAPACKE_lsame( fact, 'f' ) ) {
- LAPACKE_ssy_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t );
- }
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssysvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
- ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( fact, 'n' ) ) {
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
- ldaf );
- }
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_3:
- LAPACKE_free( b_t );
-exit_level_2:
- LAPACKE_free( af_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssysvx_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssysvx_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssyswapr.c b/netlib/LAPACKE/lapacke_ssyswapr.c
deleted file mode 100644
index 0220607..0000000
--- a/netlib/LAPACKE/lapacke_ssyswapr.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssyswapr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyswapr( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int i1, lapack_int i2 )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssyswapr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, n ) ) {
- return -4;
- }
-#endif
- return LAPACKE_ssyswapr_work( matrix_order, uplo, n, a, i1, i2 );
-}
diff --git a/netlib/LAPACKE/lapacke_ssyswapr_work.c b/netlib/LAPACKE/lapacke_ssyswapr_work.c
deleted file mode 100644
index b1a4f91..0000000
--- a/netlib/LAPACKE/lapacke_ssyswapr_work.c
+++ /dev/null
@@ -1,72 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssyswapr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssyswapr_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int i1, lapack_int i2 )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssyswapr( &uplo, &n, a, &i1, &i2 );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * n * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, n, a_t, n );
- /* Call LAPACK function and adjust info */
- LAPACK_ssyswapr( &uplo, &n, a_t, &i1, &i2 );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssyswapr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssyswapr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrd.c b/netlib/LAPACKE/lapacke_ssytrd.c
deleted file mode 100644
index d9c0d8b..0000000
--- a/netlib/LAPACKE/lapacke_ssytrd.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrd( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, float* d, float* e, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrd", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssytrd_work( matrix_order, uplo, n, a, lda, d, e, tau,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssytrd_work( matrix_order, uplo, n, a, lda, d, e, tau, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrd", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrd_work.c b/netlib/LAPACKE/lapacke_ssytrd_work.c
deleted file mode 100644
index 3488cbc..0000000
--- a/netlib/LAPACKE/lapacke_ssytrd_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytrd
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrd_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tau, float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrd( &uplo, &n, a, &lda, d, e, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssytrd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssytrd( &uplo, &n, a, &lda_t, d, e, tau, work, &lwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrd( &uplo, &n, a_t, &lda_t, d, e, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrd_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytrd_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrf.c b/netlib/LAPACKE/lapacke_ssytrf.c
deleted file mode 100644
index 2f907ae..0000000
--- a/netlib/LAPACKE/lapacke_ssytrf.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, lapack_int* ipiv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssytrf_work( matrix_order, uplo, n, a, lda, ipiv,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssytrf_work( matrix_order, uplo, n, a, lda, ipiv, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrf_work.c b/netlib/LAPACKE/lapacke_ssytrf_work.c
deleted file mode 100644
index 4b1a1fe..0000000
--- a/netlib/LAPACKE/lapacke_ssytrf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytrf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssytrf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytrf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytri.c b/netlib/LAPACKE/lapacke_ssytri.c
deleted file mode 100644
index 26e2c6d..0000000
--- a/netlib/LAPACKE/lapacke_ssytri.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytri( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssytri_work( matrix_order, uplo, n, a, lda, ipiv, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytri2.c b/netlib/LAPACKE/lapacke_ssytri2.c
deleted file mode 100644
index 3ab675d..0000000
--- a/netlib/LAPACKE/lapacke_ssytri2.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytri2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytri2( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_complex_float* work = NULL;
- lapack_complex_float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_ssytri2_work( matrix_order, uplo, n, a, lda, ipiv,
- &work_query, lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = LAPACK_C2INT( work_query );
- /* Allocate memory for work arrays */
- work = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssytri2_work( matrix_order, uplo, n, a, lda, ipiv, work,
- lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytri2_work.c b/netlib/LAPACKE/lapacke_ssytri2_work.c
deleted file mode 100644
index 0353bd1..0000000
--- a/netlib/LAPACKE/lapacke_ssytri2_work.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytri2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytri2_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytri2( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssytri2_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_ssytri2( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytri2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytri2x.c b/netlib/LAPACKE/lapacke_ssytri2x.c
deleted file mode 100644
index 12e7b8e..0000000
--- a/netlib/LAPACKE/lapacke_ssytri2x.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytri2x
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytri2x( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, const lapack_int* ipiv,
- lapack_int nb )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri2x", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n+nb+1)*(+1) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssytri2x_work( matrix_order, uplo, n, a, lda, ipiv, work,
- nb );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri2x", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytri2x_work.c b/netlib/LAPACKE/lapacke_ssytri2x_work.c
deleted file mode 100644
index 6fc8e45..0000000
--- a/netlib/LAPACKE/lapacke_ssytri2x_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytri2x
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytri2x_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv, float* work,
- lapack_int nb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytri2x( &uplo, &n, a, &lda, ipiv, work, &nb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssytri2x_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri2x_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytri2x_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytri_work.c b/netlib/LAPACKE/lapacke_ssytri_work.c
deleted file mode 100644
index c649951..0000000
--- a/netlib/LAPACKE/lapacke_ssytri_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytri_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytri( &uplo, &n, a, &lda, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_ssytri_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytri( &uplo, &n, a_t, &lda_t, ipiv, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrs.c b/netlib/LAPACKE/lapacke_ssytrs.c
deleted file mode 100644
index fec0501..0000000
--- a/netlib/LAPACKE/lapacke_ssytrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_ssytrs_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrs2.c b/netlib/LAPACKE/lapacke_ssytrs2.c
deleted file mode 100644
index ab921cb..0000000
--- a/netlib/LAPACKE/lapacke_ssytrs2.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function ssytrs2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrs2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_ssytrs2_work( matrix_order, uplo, n, nrhs, a, lda, ipiv, b,
- ldb, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrs2", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrs2_work.c b/netlib/LAPACKE/lapacke_ssytrs2_work.c
deleted file mode 100644
index 8b6d7fb..0000000
--- a/netlib/LAPACKE/lapacke_ssytrs2_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytrs2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a,
- lapack_int lda, const lapack_int* ipiv,
- float* b, lapack_int ldb, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrs2( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_ssytrs_work.c b/netlib/LAPACKE/lapacke_ssytrs_work.c
deleted file mode 100644
index b4d7433..0000000
--- a/netlib/LAPACKE/lapacke_ssytrs_work.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function ssytrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_ssytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrs( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_ssytrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_ssytrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_ssy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_ssytrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_ssytrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_ssytrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stb_nancheck.c b/netlib/LAPACKE/lapacke_stb_nancheck.c
deleted file mode 100644
index f8c3608..0000000
--- a/netlib/LAPACKE/lapacke_stb_nancheck.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_stb_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const float* ab,
- lapack_int ldab )
-{
- lapack_logical colmaj, upper, unit;
-
- if( ab == NULL ) return (lapack_logical) 0;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
-
- if( unit ) {
- /* Unit case, diagonal should be excluded from the check for NaN. */
- if( colmaj ) {
- if( upper ) {
- return LAPACKE_sgb_nancheck( matrix_order, n-1, n-1, 0, kd-1,
- &ab[ldab], ldab );
- } else {
- return LAPACKE_sgb_nancheck( matrix_order, n-1, n-1, kd-1, 0,
- &ab[1], ldab );
- }
- } else {
- if( upper ) {
- return LAPACKE_sgb_nancheck( matrix_order, n-1, n-1, 0, kd-1,
- &ab[1], ldab );
- } else {
- return LAPACKE_sgb_nancheck( matrix_order, n-1, n-1, kd-1, 0,
- &ab[ldab], ldab );
- }
- }
- } else {
- /* Non-unit case */
- if( upper ) {
- return LAPACKE_sgb_nancheck( matrix_order, n, n, 0, kd, ab, ldab );
- } else {
- return LAPACKE_sgb_nancheck( matrix_order, n, n, kd, 0, ab, ldab );
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_stb_trans.c b/netlib/LAPACKE/lapacke_stb_trans.c
deleted file mode 100644
index e52a8e4..0000000
--- a/netlib/LAPACKE/lapacke_stb_trans.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input triangular banded matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_stb_trans( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- lapack_logical colmaj, upper, unit;
-
- if( in == NULL || out == NULL ) return;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return;
- }
-
- if( unit ) {
- /* Unit case, diagonal excluded from transposition */
- if( colmaj ) {
- if( upper ) {
- LAPACKE_sgb_trans( matrix_order, n-1, n-1, 0, kd-1,
- &in[ldin], ldin, &out[1], ldout );
- } else {
- LAPACKE_sgb_trans( matrix_order, n-1, n-1, kd-1, 0,
- &in[1], ldin, &out[ldout], ldout );
- }
- } else {
- if( upper ) {
- LAPACKE_sgb_trans( matrix_order, n-1, n-1, 0, kd-1,
- &in[1], ldin, &out[ldout], ldout );
- } else {
- LAPACKE_sgb_trans( matrix_order, n-1, n-1, kd-1, 0,
- &in[ldin], ldin, &out[1], ldout );
- }
- }
- } else {
- /* Non-unit case */
- if( upper ) {
- LAPACKE_sgb_trans( matrix_order, n, n, 0, kd, in, ldin, out,
- ldout );
- } else {
- LAPACKE_sgb_trans( matrix_order, n, n, kd, 0, in, ldin, out,
- ldout );
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_stbcon.c b/netlib/LAPACKE/lapacke_stbcon.c
deleted file mode 100644
index 90f7f0b..0000000
--- a/netlib/LAPACKE/lapacke_stbcon.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd, const float* ab,
- lapack_int ldab, float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stbcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stb_nancheck( matrix_order, uplo, diag, n, kd, ab, ldab ) ) {
- return -7;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_stbcon_work( matrix_order, norm, uplo, diag, n, kd, ab, ldab,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stbcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stbcon_work.c b/netlib/LAPACKE/lapacke_stbcon_work.c
deleted file mode 100644
index b2ebfac..0000000
--- a/netlib/LAPACKE/lapacke_stbcon_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stbcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const float* ab, lapack_int ldab, float* rcond,
- float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stbcon( &norm, &uplo, &diag, &n, &kd, ab, &ldab, rcond, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- float* ab_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_stbcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_stb_trans( matrix_order, uplo, diag, n, kd, ab, ldab, ab_t,
- ldab_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stbcon( &norm, &uplo, &diag, &n, &kd, ab_t, &ldab_t, rcond, work,
- iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stbcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stbcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stbrfs.c b/netlib/LAPACKE/lapacke_stbrfs.c
deleted file mode 100644
index 5eaa410..0000000
--- a/netlib/LAPACKE/lapacke_stbrfs.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const float* ab, lapack_int ldab, const float* b,
- lapack_int ldb, const float* x, lapack_int ldx,
- float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stbrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stb_nancheck( matrix_order, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -12;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_stbrfs_work( matrix_order, uplo, trans, diag, n, kd, nrhs,
- ab, ldab, b, ldb, x, ldx, ferr, berr, work,
- iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stbrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stbrfs_work.c b/netlib/LAPACKE/lapacke_stbrfs_work.c
deleted file mode 100644
index 605d6e4..0000000
--- a/netlib/LAPACKE/lapacke_stbrfs_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stbrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab, &ldab, b, &ldb,
- x, &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* ab_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stbrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stbrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_stbrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_stb_trans( matrix_order, uplo, diag, n, kd, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stbrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stbrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stbtrs.c b/netlib/LAPACKE/lapacke_stbtrs.c
deleted file mode 100644
index b85a1b1..0000000
--- a/netlib/LAPACKE/lapacke_stbtrs.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const float* ab, lapack_int ldab, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stbtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stb_nancheck( matrix_order, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -10;
- }
-#endif
- return LAPACKE_stbtrs_work( matrix_order, uplo, trans, diag, n, kd, nrhs,
- ab, ldab, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_stbtrs_work.c b/netlib/LAPACKE/lapacke_stbtrs_work.c
deleted file mode 100644
index a7bdd58..0000000
--- a/netlib/LAPACKE/lapacke_stbtrs_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stbtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab, &ldab, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldab_t = MAX(1,kd+1);
- lapack_int ldb_t = MAX(1,n);
- float* ab_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( ldab < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stbtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stbtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
- if( ab_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_stb_trans( matrix_order, uplo, diag, n, kd, ab, ldab, ab_t,
- ldab_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t,
- &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( ab_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stbtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stbtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stf_nancheck.c b/netlib/LAPACKE/lapacke_stf_nancheck.c
deleted file mode 100644
index 24c51e5..0000000
--- a/netlib/LAPACKE/lapacke_stf_nancheck.c
+++ /dev/null
@@ -1,158 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_stf_nancheck( int matrix_order, char transr,
- char uplo, char diag,
- lapack_int n,
- const float *a )
-{
- lapack_int len;
- lapack_logical rowmaj, ntr, lower, unit;
- lapack_int n1, n2, k;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- rowmaj = (matrix_order == LAPACK_ROW_MAJOR);
- ntr = LAPACKE_lsame( transr, 'n' );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !rowmaj && ( matrix_order != LAPACK_COL_MAJOR ) ) ||
- ( !ntr && !LAPACKE_lsame( transr, 't' )
- && !LAPACKE_lsame( transr, 'c' ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
-
- if( unit ) {
- /* Unit case, diagonal should be excluded from the check for NaN.
- * Decoding RFP and checking both triangulars and rectangular
- * for NaNs.
- */
- if( lower ) {
- n2 = n / 2;
- n1 = n - n2;
- } else {
- n1 = n / 2;
- n2 = n - n1;
- }
- if( n % 2 == 1 ) {
- /* N is odd */
- if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) {
- /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */
- if( lower ) {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n1, &a[0], n )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n2, n1,
- &a[n1], n )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n2, &a[n], n );
- } else {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n1, &a[n2], n )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n1, n2,
- &a[0], n )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n2, &a[n1], n );
- }
- } else {
- /* N is odd and
- ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */
- if( lower ) {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n1, &a[0], n1 )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n1, n2,
- &a[1], n1 )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n2, &a[1], n1 );
- } else {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- n1, &a[(size_t)n2*n2], n2 )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n2, n1,
- &a[0], n2 )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- n2, &a[(size_t)n1*n2], n2 );
- }
- }
- } else {
- /* N is even */
- k = n / 2;
- if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) {
- /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */
- if( lower ) {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[1], n+1 )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[k+1], n+1 )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[0], n+1 );
- } else {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[k+1], n+1 )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[0], n+1 )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[k], n+1 );
- }
- } else {
- /* N is even and
- * ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR )
- */
- if( lower ) {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[k], k )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[(size_t)k*(k+1)], k )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[0], k );
- } else {
- return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
- k, &a[(size_t)k*(k+1)], k )
- || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k,
- &a[0], k )
- || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
- k, &a[(size_t)k*k], k );
- }
- }
- }
- } else {
- /* Non-unit case - just check whole array for NaNs. */
- len = n*(n+1)/2;
- return LAPACKE_sge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_stf_trans.c b/netlib/LAPACKE/lapacke_stf_trans.c
deleted file mode 100644
index e67fa7f..0000000
--- a/netlib/LAPACKE/lapacke_stf_trans.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input RFP matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- * This functions does copy diagonal for both unit and non-unit cases.
- */
-
-void LAPACKE_stf_trans( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, const float *in,
- float *out )
-{
- lapack_int row, col;
- lapack_logical rowmaj, ntr, lower, unit;
-
- if( in == NULL || out == NULL ) return ;
-
- rowmaj = (matrix_order == LAPACK_ROW_MAJOR);
- ntr = LAPACKE_lsame( transr, 'n' );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !rowmaj && ( matrix_order != LAPACK_COL_MAJOR ) ) ||
- ( !ntr && !LAPACKE_lsame( transr, 't' ) &&
- !LAPACKE_lsame( transr, 'c' ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if input parameters are wrong */
- return;
- }
-
- /* Determine parameters of array representing RFP */
- if( ntr ) {
- if( n%2 == 0 ) {
- row = n + 1;
- col = n / 2;
- } else {
- row = n;
- col = (n + 1) / 2;
- }
- } else {
- if( n%2 == 0 ) {
- row = n / 2;
- col = n + 1;
- } else {
- row = (n + 1) / 2;
- col = n;
- }
- }
-
- /* Perform conversion: */
- if( rowmaj ) {
- LAPACKE_sge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row );
- } else {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_stfsm.c b/netlib/LAPACKE/lapacke_stfsm.c
deleted file mode 100644
index 5985241..0000000
--- a/netlib/LAPACKE/lapacke_stfsm.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stfsm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- float alpha, const float* a, float* b,
- lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stfsm", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( IS_S_NONZERO(alpha) ) {
- if( LAPACKE_stf_nancheck( matrix_order, transr, uplo, diag, n, a ) ) {
- return -10;
- }
- }
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -9;
- }
- if( IS_S_NONZERO(alpha) ) {
- if( LAPACKE_sge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -11;
- }
- }
-#endif
- return LAPACKE_stfsm_work( matrix_order, transr, side, uplo, trans, diag, m,
- n, alpha, a, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_stfsm_work.c b/netlib/LAPACKE/lapacke_stfsm_work.c
deleted file mode 100644
index 3d3d0a7..0000000
--- a/netlib/LAPACKE/lapacke_stfsm_work.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stfsm
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, float alpha, const float* a,
- float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a,
- b, &ldb );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,m);
- float* b_t = NULL;
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( IS_S_NONZERO(alpha) ) {
- a_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- if( IS_S_NONZERO(alpha) ) {
- LAPACKE_sge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- }
- if( IS_S_NONZERO(alpha) ) {
- LAPACKE_stf_trans( matrix_order, transr, uplo, diag, n, a, a_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
- b_t, &ldb_t );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- if( IS_S_NONZERO(alpha) ) {
- LAPACKE_free( a_t );
- }
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stftri.c b/netlib/LAPACKE/lapacke_stftri.c
deleted file mode 100644
index b4527af..0000000
--- a/netlib/LAPACKE/lapacke_stftri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, float* a )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stftri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stf_nancheck( matrix_order, transr, uplo, diag, n, a ) ) {
- return -6;
- }
-#endif
- return LAPACKE_stftri_work( matrix_order, transr, uplo, diag, n, a );
-}
diff --git a/netlib/LAPACKE/lapacke_stftri_work.c b/netlib/LAPACKE/lapacke_stftri_work.c
deleted file mode 100644
index 045bd47..0000000
--- a/netlib/LAPACKE/lapacke_stftri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stftri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n, float* a )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stftri( &transr, &uplo, &diag, &n, a, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* a_t = NULL;
- /* Allocate memory for temporary array(s) */
- a_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_stf_trans( matrix_order, transr, uplo, diag, n, a, a_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stftri( &transr, &uplo, &diag, &n, a_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_stf_trans( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stftri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stftri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stfttp.c b/netlib/LAPACKE/lapacke_stfttp.c
deleted file mode 100644
index 72ef5fb..0000000
--- a/netlib/LAPACKE/lapacke_stfttp.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stfttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stfttp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, arf ) ) {
- return -5;
- }
-#endif
- return LAPACKE_stfttp_work( matrix_order, transr, uplo, n, arf, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_stfttp_work.c b/netlib/LAPACKE/lapacke_stfttp_work.c
deleted file mode 100644
index b17c9d5..0000000
--- a/netlib/LAPACKE/lapacke_stfttp_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stfttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stfttp( &transr, &uplo, &n, arf, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- float* arf_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spf_trans( matrix_order, transr, uplo, n, arf, arf_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stfttp( &transr, &uplo, &n, arf_t, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stfttp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stfttp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stfttr.c b/netlib/LAPACKE/lapacke_stfttr.c
deleted file mode 100644
index e290657..0000000
--- a/netlib/LAPACKE/lapacke_stfttr.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stfttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* a,
- lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stfttr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, arf ) ) {
- return -5;
- }
-#endif
- return LAPACKE_stfttr_work( matrix_order, transr, uplo, n, arf, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_stfttr_work.c b/netlib/LAPACKE/lapacke_stfttr_work.c
deleted file mode 100644
index 2eaacf2..0000000
--- a/netlib/LAPACKE/lapacke_stfttr_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stfttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* a,
- lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stfttr( &transr, &uplo, &n, arf, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- float* arf_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_stfttr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spf_trans( matrix_order, transr, uplo, n, arf, arf_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stfttr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stfttr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgevc.c b/netlib/LAPACKE/lapacke_stgevc.c
deleted file mode 100644
index 584d7ba..0000000
--- a/netlib/LAPACKE/lapacke_stgevc.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stgevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* s, lapack_int lds, const float* p,
- lapack_int ldp, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stgevc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, p, ldp ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, s, lds ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -10;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,6*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_stgevc_work( matrix_order, side, howmny, select, n, s, lds,
- p, ldp, vl, ldvl, vr, ldvr, mm, m, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgevc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgevc_work.c b/netlib/LAPACKE/lapacke_stgevc_work.c
deleted file mode 100644
index c9fd100..0000000
--- a/netlib/LAPACKE/lapacke_stgevc_work.c
+++ /dev/null
@@ -1,153 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stgevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* s, lapack_int lds, const float* p,
- lapack_int ldp, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stgevc( &side, &howmny, select, &n, s, &lds, p, &ldp, vl, &ldvl,
- vr, &ldvr, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldp_t = MAX(1,n);
- lapack_int lds_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* s_t = NULL;
- float* p_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldp < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stgevc_work", info );
- return info;
- }
- if( lds < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_stgevc_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stgevc_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_stgevc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- s_t = (float*)LAPACKE_malloc( sizeof(float) * lds_t * MAX(1,n) );
- if( s_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- p_t = (float*)LAPACKE_malloc( sizeof(float) * ldp_t * MAX(1,n) );
- if( p_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, s, lds, s_t, lds_t );
- LAPACKE_sge_trans( matrix_order, n, n, p, ldp, p_t, ldp_t );
- if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_stgevc( &side, &howmny, select, &n, s_t, &lds_t, p_t, &ldp_t,
- vl_t, &ldvl_t, vr_t, &ldvr_t, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
- ldvl );
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
- ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( p_t );
-exit_level_1:
- LAPACKE_free( s_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgevc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stgevc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgexc.c b/netlib/LAPACKE/lapacke_stgexc.c
deleted file mode 100644
index 379865e..0000000
--- a/netlib/LAPACKE/lapacke_stgexc.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stgexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- lapack_int* ifst, lapack_int* ilst )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stgexc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -7;
- }
- if( wantq ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -9;
- }
- }
- if( wantz ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -11;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_stgexc_work( matrix_order, wantq, wantz, n, a, lda, b, ldb,
- q, ldq, z, ldz, ifst, ilst, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_stgexc_work( matrix_order, wantq, wantz, n, a, lda, b, ldb,
- q, ldq, z, ldz, ifst, ilst, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgexc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgexc_work.c b/netlib/LAPACKE/lapacke_stgexc_work.c
deleted file mode 100644
index 64a853d..0000000
--- a/netlib/LAPACKE/lapacke_stgexc_work.c
+++ /dev/null
@@ -1,158 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stgexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* q, lapack_int ldq, float* z,
- lapack_int ldz, lapack_int* ifst,
- lapack_int* ilst, float* work,
- lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stgexc( &wantq, &wantz, &n, a, &lda, b, &ldb, q, &ldq, z, &ldz,
- ifst, ilst, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* q_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_stgexc_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_stgexc_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_stgexc_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_stgexc_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_stgexc( &wantq, &wantz, &n, a, &lda_t, b, &ldb_t, q, &ldq_t,
- z, &ldz_t, ifst, ilst, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( wantq ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( wantz ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( wantq ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( wantz ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_stgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t,
- &ldq_t, z_t, &ldz_t, ifst, ilst, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( wantq ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( wantz ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( wantz ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( wantq ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgexc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stgexc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsen.c b/netlib/LAPACKE/lapacke_stgsen.c
deleted file mode 100644
index 41fea0c..0000000
--- a/netlib/LAPACKE/lapacke_stgsen.c
+++ /dev/null
@@ -1,113 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stgsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- lapack_int* m, float* pl, float* pr, float* dif )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stgsen", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( wantq ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -14;
- }
- }
- if( wantz ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) {
- return -16;
- }
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_stgsen_work( matrix_order, ijob, wantq, wantz, select, n, a,
- lda, b, ldb, alphar, alphai, beta, q, ldq, z,
- ldz, m, pl, pr, dif, &work_query, lwork,
- &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( ijob != 0 ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_stgsen_work( matrix_order, ijob, wantq, wantz, select, n, a,
- lda, b, ldb, alphar, alphai, beta, q, ldq, z,
- ldz, m, pl, pr, dif, work, lwork, iwork,
- liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( ijob != 0 ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsen", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsen_work.c b/netlib/LAPACKE/lapacke_stgsen_work.c
deleted file mode 100644
index e5436b4..0000000
--- a/netlib/LAPACKE/lapacke_stgsen_work.c
+++ /dev/null
@@ -1,165 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stgsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* q, lapack_int ldq, float* z,
- lapack_int ldz, lapack_int* m, float* pl,
- float* pr, float* dif, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stgsen( &ijob, &wantq, &wantz, select, &n, a, &lda, b, &ldb,
- alphar, alphai, beta, q, &ldq, z, &ldz, m, pl, pr, dif,
- work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldz_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* q_t = NULL;
- float* z_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_stgsen_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_stgsen_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_stgsen_work", info );
- return info;
- }
- if( ldz < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_stgsen_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_stgsen( &ijob, &wantq, &wantz, select, &n, a, &lda_t, b,
- &ldb_t, alphar, alphai, beta, q, &ldq_t, z, &ldz_t,
- m, pl, pr, dif, work, &lwork, iwork, &liwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( wantq ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( wantz ) {
- z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
- if( z_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( wantq ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- if( wantz ) {
- LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_stgsen( &ijob, &wantq, &wantz, select, &n, a_t, &lda_t, b_t,
- &ldb_t, alphar, alphai, beta, q_t, &ldq_t, z_t, &ldz_t,
- m, pl, pr, dif, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
- if( wantq ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- if( wantz ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
- }
- /* Release memory and exit */
- if( wantz ) {
- LAPACKE_free( z_t );
- }
-exit_level_3:
- if( wantq ) {
- LAPACKE_free( q_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsen_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stgsen_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsja.c b/netlib/LAPACKE/lapacke_stgsja.c
deleted file mode 100644
index a2aeb3a..0000000
--- a/netlib/LAPACKE/lapacke_stgsja.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stgsja
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, float* a, lapack_int lda,
- float* b, lapack_int ldb, float tola, float tolb,
- float* alpha, float* beta, float* u, lapack_int ldu,
- float* v, lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* ncycle )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stgsja", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, p, n, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -22;
- }
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, m, m, u, ldu ) ) {
- return -18;
- }
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, p, p, v, ldv ) ) {
- return -20;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_stgsja_work( matrix_order, jobu, jobv, jobq, m, p, n, k, l,
- a, lda, b, ldb, tola, tolb, alpha, beta, u, ldu,
- v, ldv, q, ldq, work, ncycle );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsja", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsja_work.c b/netlib/LAPACKE/lapacke_stgsja_work.c
deleted file mode 100644
index 9ae9bf7..0000000
--- a/netlib/LAPACKE/lapacke_stgsja_work.c
+++ /dev/null
@@ -1,180 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stgsja
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float tola, float tolb,
- float* alpha, float* beta, float* u,
- lapack_int ldu, float* v, lapack_int ldv,
- float* q, lapack_int ldq, float* work,
- lapack_int* ncycle )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a, &lda, b,
- &ldb, &tola, &tolb, alpha, beta, u, &ldu, v, &ldv, q,
- &ldq, work, ncycle, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,p);
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldu_t = MAX(1,m);
- lapack_int ldv_t = MAX(1,p);
- float* a_t = NULL;
- float* b_t = NULL;
- float* u_t = NULL;
- float* v_t = NULL;
- float* q_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- return info;
- }
- if( ldq < n ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- return info;
- }
- if( ldu < m ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- return info;
- }
- if( ldv < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) );
- if( u_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,p) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
- if( LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_sge_trans( matrix_order, m, m, u, ldu, u_t, ldu_t );
- }
- if( LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, p, p, v, ldv, v_t, ldv_t );
- }
- if( LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_stgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t,
- b_t, &ldb_t, &tola, &tolb, alpha, beta, u_t, &ldu_t, v_t,
- &ldv_t, q_t, &ldq_t, work, ncycle, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv );
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_4:
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- LAPACKE_free( v_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- LAPACKE_free( u_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stgsja_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsna.c b/netlib/LAPACKE/lapacke_stgsna.c
deleted file mode 100644
index a44bc61..0000000
--- a/netlib/LAPACKE/lapacke_stgsna.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stgsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* vl, lapack_int ldvl,
- const float* vr, lapack_int ldvr, float* s,
- float* dif, lapack_int mm, lapack_int* m )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stgsna", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -10;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -12;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_stgsna_work( matrix_order, job, howmny, select, n, a, lda, b,
- ldb, vl, ldvl, vr, ldvr, s, dif, mm, m,
- &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Call middle-level interface */
- info = LAPACKE_stgsna_work( matrix_order, job, howmny, select, n, a, lda, b,
- ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work,
- lwork, iwork );
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( work );
- }
-exit_level_1:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsna", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsna_work.c b/netlib/LAPACKE/lapacke_stgsna_work.c
deleted file mode 100644
index bdc3cdf..0000000
--- a/netlib/LAPACKE/lapacke_stgsna_work.c
+++ /dev/null
@@ -1,152 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stgsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* vl,
- lapack_int ldvl, const float* vr,
- lapack_int ldvr, float* s, float* dif,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int lwork, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stgsna( &job, &howmny, select, &n, a, &lda, b, &ldb, vl, &ldvl,
- vr, &ldvr, s, dif, &mm, m, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_stgsna_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stgsna_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stgsna_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_stgsna_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_stgsna( &job, &howmny, select, &n, a, &lda_t, b, &ldb_t, vl,
- &ldvl_t, vr, &ldvr_t, s, dif, &mm, m, work, &lwork,
- iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_stgsna( &job, &howmny, select, &n, a_t, &lda_t, b_t, &ldb_t,
- vl_t, &ldvl_t, vr_t, &ldvr_t, s, dif, &mm, m, work,
- &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsna_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stgsna_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsyl.c b/netlib/LAPACKE/lapacke_stgsyl.c
deleted file mode 100644
index 6f9f863..0000000
--- a/netlib/LAPACKE/lapacke_stgsyl.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stgsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- float* c, lapack_int ldc, const float* d,
- lapack_int ldd, const float* e, lapack_int lde,
- float* f, lapack_int ldf, float* scale, float* dif )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stgsyl", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, m, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, m, d, ldd ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, e, lde ) ) {
- return -14;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, f, ldf ) ) {
- return -16;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+n+6) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Query optimal working array(s) size */
- info = LAPACKE_stgsyl_work( matrix_order, trans, ijob, m, n, a, lda, b, ldb,
- c, ldc, d, ldd, e, lde, f, ldf, scale, dif,
- &work_query, lwork, iwork );
- if( info != 0 ) {
- goto exit_level_1;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_stgsyl_work( matrix_order, trans, ijob, m, n, a, lda, b, ldb,
- c, ldc, d, ldd, e, lde, f, ldf, scale, dif,
- work, lwork, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsyl", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stgsyl_work.c b/netlib/LAPACKE/lapacke_stgsyl_work.c
deleted file mode 100644
index c498a8f..0000000
--- a/netlib/LAPACKE/lapacke_stgsyl_work.c
+++ /dev/null
@@ -1,174 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stgsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- float* c, lapack_int ldc, const float* d,
- lapack_int ldd, const float* e, lapack_int lde,
- float* f, lapack_int ldf, float* scale,
- float* dif, float* work, lapack_int lwork,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stgsyl( &trans, &ijob, &m, &n, a, &lda, b, &ldb, c, &ldc, d,
- &ldd, e, &lde, f, &ldf, scale, dif, work, &lwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldc_t = MAX(1,m);
- lapack_int ldd_t = MAX(1,m);
- lapack_int lde_t = MAX(1,n);
- lapack_int ldf_t = MAX(1,m);
- float* a_t = NULL;
- float* b_t = NULL;
- float* c_t = NULL;
- float* d_t = NULL;
- float* e_t = NULL;
- float* f_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- return info;
- }
- if( ldd < m ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- return info;
- }
- if( lde < n ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- return info;
- }
- if( ldf < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_stgsyl( &trans, &ijob, &m, &n, a, &lda_t, b, &ldb_t, c,
- &ldc_t, d, &ldd_t, e, &lde_t, f, &ldf_t, scale, dif,
- work, &lwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- d_t = (float*)LAPACKE_malloc( sizeof(float) * ldd_t * MAX(1,m) );
- if( d_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- e_t = (float*)LAPACKE_malloc( sizeof(float) * lde_t * MAX(1,n) );
- if( e_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- f_t = (float*)LAPACKE_malloc( sizeof(float) * ldf_t * MAX(1,n) );
- if( f_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- LAPACKE_sge_trans( matrix_order, m, m, d, ldd, d_t, ldd_t );
- LAPACKE_sge_trans( matrix_order, n, n, e, lde, e_t, lde_t );
- LAPACKE_sge_trans( matrix_order, m, n, f, ldf, f_t, ldf_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stgsyl( &trans, &ijob, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t,
- &ldc_t, d_t, &ldd_t, e_t, &lde_t, f_t, &ldf_t, scale,
- dif, work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf );
- /* Release memory and exit */
- LAPACKE_free( f_t );
-exit_level_5:
- LAPACKE_free( e_t );
-exit_level_4:
- LAPACKE_free( d_t );
-exit_level_3:
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stgsyl_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stp_nancheck.c b/netlib/LAPACKE/lapacke_stp_nancheck.c
deleted file mode 100644
index 9f479a7..0000000
--- a/netlib/LAPACKE/lapacke_stp_nancheck.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries.
- * Since matrix in packed format stored continiously it just required to
- * check 1d array for NaNs. It doesn't depend upon uplo or matrix_order.
- */
-
-lapack_logical LAPACKE_stp_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const float *ap )
-{
- lapack_int i, len;
- lapack_logical colmaj, upper, unit;
-
- if( ap == NULL ) return (lapack_logical) 0;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
-
- if( unit ) {
- /* Unit case, diagonal should be excluded from the check for NaN. */
-
- /* Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
- for( i = 1; i < n; i++ )
- if( LAPACKE_s_nancheck( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) )
- return (lapack_logical) 1;
- } else {
- for( i = 0; i < n-1; i++ )
- if( LAPACKE_s_nancheck( n-i-1,
- &ap[ (size_t)i+1 + i*((size_t)2*n-i+1)/2 ], 1 ) )
- return (lapack_logical) 1;
- }
- return (lapack_logical) 0;
- } else {
- /* Non-unit case - just check whole array for NaNs. */
- len = n*(n+1)/2;
- return LAPACKE_s_nancheck( len, ap, 1 );
- }
-}
diff --git a/netlib/LAPACKE/lapacke_stp_trans.c b/netlib/LAPACKE/lapacke_stp_trans.c
deleted file mode 100644
index bd9d4fd..0000000
--- a/netlib/LAPACKE/lapacke_stp_trans.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input triangular packed matrix from row-major(C) to
- * column-major(Fortran) layout or vice versa.
- */
-
-void LAPACKE_stp_trans( int matrix_order, char uplo, char diag,
- lapack_int n, const float *in,
- float *out )
-{
- lapack_int i, j, st;
- lapack_logical colmaj, upper, unit;
-
- if( in == NULL || out == NULL ) return ;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- upper = LAPACKE_lsame( uplo, 'u' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return;
- }
- if( unit ) {
- /* If unit, then don't touch diagonal, start from 1st column or row */
- st = 1;
- } else {
- /* If non-unit, then check diagonal also, starting from [0,0] */
- st = 0;
- }
-
- /* Perform conversion:
- * Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
- for( j = st; j < n; j++ ) {
- for( i = 0; i < j+1-st; i++ ) {
- out[ j-i + (i*(2*n-i+1))/2 ] = in[ ((j+1)*j)/2 + i ];
- }
- }
- } else {
- for( j = 0; j < n-st; j++ ) {
- for( i = j+st; i < n; i++ ) {
- out[ j + ((i+1)*i)/2 ] = in[ (j*(2*n-j+1))/2 + i-j ];
- }
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_stpcon.c b/netlib/LAPACKE/lapacke_stpcon.c
deleted file mode 100644
index ced778e..0000000
--- a/netlib/LAPACKE/lapacke_stpcon.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stpcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const float* ap, float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stpcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_stpcon_work( matrix_order, norm, uplo, diag, n, ap, rcond,
- work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stpcon_work.c b/netlib/LAPACKE/lapacke_stpcon_work.c
deleted file mode 100644
index e03c6b1..0000000
--- a/netlib/LAPACKE/lapacke_stpcon_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stpcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const float* ap,
- float* rcond, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stpcon( &norm, &uplo, &diag, &n, ap, rcond, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_stp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stpcon( &norm, &uplo, &diag, &n, ap_t, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stpcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stpmqrt.c b/netlib/LAPACKE/lapacke_stpmqrt.c
deleted file mode 100644
index 335f76c..0000000
--- a/netlib/LAPACKE/lapacke_stpmqrt.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function stpmqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stpmqrt", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -13;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_sge_nancheck( matrix_order, ldt, nb, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_sge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
- return -9;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) * MAX(1,nb) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_stpmqrt_work( matrix_order, side, trans, m, n, k, l, nb, v,
- ldv, t, ldt, a, lda, b, ldb, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpmqrt", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stpmqrt_work.c b/netlib/LAPACKE/lapacke_stpmqrt_work.c
deleted file mode 100644
index 3b35e43..0000000
--- a/netlib/LAPACKE/lapacke_stpmqrt_work.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stpmqrt
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v, &ldv, t, &ldt, a,
- &lda, b, &ldb, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int r = LAPACKE_lsame( side, 'r' ) ? k : k;
- lapack_int lda_t = MAX(1,k);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- lapack_int ldv_t = MAX(1,ldv);
- float* v_t = NULL;
- float* t_t = NULL;
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
- return info;
- }
- if( ldt < nb ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
- return info;
- }
- if( ldv < k ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,k) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,nb) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
- LAPACKE_sge_trans( matrix_order, ldt, nb, t, ldt, t_t, ldt_t );
- LAPACKE_sge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
- &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_3:
- LAPACKE_free( a_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stpqrt2.c b/netlib/LAPACKE/lapacke_stpqrt2.c
deleted file mode 100644
index 81a5f9c..0000000
--- a/netlib/LAPACKE/lapacke_stpqrt2.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function stpqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- float* a, lapack_int lda, float* b, lapack_int ldb,
- float* t, lapack_int ldt )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stpqrt2", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -6;
- }
-#endif
- return LAPACKE_stpqrt2_work( matrix_order, m, n, l, a, lda, b, ldb, t, ldt );
-}
diff --git a/netlib/LAPACKE/lapacke_stpqrt2_work.c b/netlib/LAPACKE/lapacke_stpqrt2_work.c
deleted file mode 100644
index f4ac18c..0000000
--- a/netlib/LAPACKE/lapacke_stpqrt2_work.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stpqrt2
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* t, lapack_int ldt )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stpqrt2( &m, &n, &l, a, &lda, b, &ldb, t, &ldt, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* t_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- /* Release memory and exit */
- LAPACKE_free( t_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stprfb.c b/netlib/LAPACKE/lapacke_stprfb.c
deleted file mode 100644
index 48d8998..0000000
--- a/netlib/LAPACKE/lapacke_stprfb.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native high-level C interface to LAPACK function stprfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b, lapack_int ldb)
-{
- lapack_int info = 0;
- lapack_int ldwork;
- lapack_int work_size;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stprfb", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, k, m, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_sge_nancheck( matrix_order, ldt, k, t, ldt ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
- return -10;
- }
-#endif
- if (side=='l' || side=='L') {
- ldwork = k;
- work_size = MAX(1,ldwork) * MAX(1,n);
- }
- else {
- ldwork = m;
- work_size = MAX(1,ldwork) * MAX(1,k);
- }
- /* Allocate memory for working array(s) */
- work = (float*)
- LAPACKE_malloc( sizeof(float) * MAX(1,ldwork) * MAX(n,k) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_stprfb_work( matrix_order, side, trans, direct, storev, m, n,
- k, l, v, ldv, t, ldt, a, lda, b, ldb, work,
- ldwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stprfb", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stprfb_work.c b/netlib/LAPACKE/lapacke_stprfb_work.c
deleted file mode 100644
index 11b002b..0000000
--- a/netlib/LAPACKE/lapacke_stprfb_work.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stprfb
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const float* v, lapack_int ldv, const float* t,
- lapack_int ldt, float* a, lapack_int lda,
- float* b, lapack_int ldb, const float* work,
- lapack_int ldwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv,
- t, &ldt, a, &lda, b, &ldb, work, &ldwork );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int r = LAPACKE_lsame( side, 'r' ) ? k : k;
- lapack_int lda_t = MAX(1,k);
- lapack_int ldb_t = MAX(1,m);
- lapack_int ldt_t = MAX(1,ldt);
- lapack_int ldv_t = MAX(1,ldv);
- float* v_t = NULL;
- float* t_t = NULL;
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
- return info;
- }
- if( ldt < k ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
- return info;
- }
- if( ldv < k ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,k) );
- if( v_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,k) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
- LAPACKE_sge_trans( matrix_order, ldt, k, t, ldt, t_t, ldt_t );
- LAPACKE_sge_trans( matrix_order, k, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t,
- &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work,
- &ldwork );
- info = 0; /* LAPACK call is ok! */
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_3:
- LAPACKE_free( a_t );
-exit_level_2:
- LAPACKE_free( t_t );
-exit_level_1:
- LAPACKE_free( v_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stprfs.c b/netlib/LAPACKE/lapacke_stprfs.c
deleted file mode 100644
index 3d41b9f..0000000
--- a/netlib/LAPACKE/lapacke_stprfs.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* ap,
- const float* b, lapack_int ldb, const float* x,
- lapack_int ldx, float* ferr, float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stprfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -10;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_stprfs_work( matrix_order, uplo, trans, diag, n, nrhs, ap, b,
- ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stprfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stprfs_work.c b/netlib/LAPACKE/lapacke_stprfs_work.c
deleted file mode 100644
index 62d358b..0000000
--- a/netlib/LAPACKE/lapacke_stprfs_work.c
+++ /dev/null
@@ -1,109 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stprfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* ap, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stprfs( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx,
- ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* b_t = NULL;
- float* x_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stprfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_stprfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- LAPACKE_stp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stprfs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, x_t,
- &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_2:
- LAPACKE_free( x_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stprfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stprfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stptri.c b/netlib/LAPACKE/lapacke_stptri.c
deleted file mode 100644
index 1b3fd03..0000000
--- a/netlib/LAPACKE/lapacke_stptri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stptri( int matrix_order, char uplo, char diag, lapack_int n,
- float* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stptri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -5;
- }
-#endif
- return LAPACKE_stptri_work( matrix_order, uplo, diag, n, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_stptri_work.c b/netlib/LAPACKE/lapacke_stptri_work.c
deleted file mode 100644
index 9e73e2b..0000000
--- a/netlib/LAPACKE/lapacke_stptri_work.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stptri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, float* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stptri( &uplo, &diag, &n, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_stp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stptri( &uplo, &diag, &n, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_stp_trans( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stptri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stptri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stptrs.c b/netlib/LAPACKE/lapacke_stptrs.c
deleted file mode 100644
index d5c13c7..0000000
--- a/netlib/LAPACKE/lapacke_stptrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* ap,
- float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stptrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -8;
- }
-#endif
- return LAPACKE_stptrs_work( matrix_order, uplo, trans, diag, n, nrhs, ap, b,
- ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_stptrs_work.c b/netlib/LAPACKE/lapacke_stptrs_work.c
deleted file mode 100644
index 0f3342b..0000000
--- a/netlib/LAPACKE/lapacke_stptrs_work.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stptrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* ap, float* b, lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldb_t = MAX(1,n);
- float* b_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( ldb < nrhs ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_stptrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_stp_trans( matrix_order, uplo, diag, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( b_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stptrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stptrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stpttf.c b/netlib/LAPACKE/lapacke_stpttf.c
deleted file mode 100644
index 16a5c28..0000000
--- a/netlib/LAPACKE/lapacke_stpttf.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stpttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const float* ap, float* arf )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stpttf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
-#endif
- return LAPACKE_stpttf_work( matrix_order, transr, uplo, n, ap, arf );
-}
diff --git a/netlib/LAPACKE/lapacke_stpttf_work.c b/netlib/LAPACKE/lapacke_stpttf_work.c
deleted file mode 100644
index 5dbf70b..0000000
--- a/netlib/LAPACKE/lapacke_stpttf_work.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stpttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* ap, float* arf )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stpttf( &transr, &uplo, &n, ap, arf, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- float* ap_t = NULL;
- float* arf_t = NULL;
- /* Allocate memory for temporary array(s) */
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stpttf( &transr, &uplo, &n, ap_t, arf_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( ap_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpttf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stpttf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stpttr.c b/netlib/LAPACKE/lapacke_stpttr.c
deleted file mode 100644
index 6e87aba..0000000
--- a/netlib/LAPACKE/lapacke_stpttr.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stpttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpttr( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* a, lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stpttr", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
- }
-#endif
- return LAPACKE_stpttr_work( matrix_order, uplo, n, ap, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_stpttr_work.c b/netlib/LAPACKE/lapacke_stpttr_work.c
deleted file mode 100644
index c453084..0000000
--- a/netlib/LAPACKE/lapacke_stpttr_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stpttr
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stpttr_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stpttr( &uplo, &n, ap, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_stpttr_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_spp_trans( matrix_order, uplo, n, ap, ap_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stpttr( &uplo, &n, ap_t, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stpttr_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stpttr_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_str_nancheck.c b/netlib/LAPACKE/lapacke_str_nancheck.c
deleted file mode 100644
index 730ea70..0000000
--- a/netlib/LAPACKE/lapacke_str_nancheck.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-#include "lapacke_utils.h"
-
-/* Check a matrix for NaN entries. */
-
-lapack_logical LAPACKE_str_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const float *a,
- lapack_int lda )
-{
- lapack_int i, j, st;
- lapack_logical colmaj, lower, unit;
-
- if( a == NULL ) return (lapack_logical) 0;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return (lapack_logical) 0;
- }
- if( unit ) {
- /* If unit, then don't touch diagonal, start from 1st column or row */
- st = 1;
- } else {
- /* If non-unit, then check diagonal also, starting from [0,0] */
- st = 0;
- }
-
- /* Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || lower ) && !( colmaj && lower ) ) {
- for( j = st; j < n; j++ ) {
- for( i = 0; i < MIN( j+1-st, lda ); i++ ) {
- if( LAPACK_SISNAN( a[i+j*lda] ) )
- return (lapack_logical) 1;
- }
- }
- } else {
- for( j = 0; j < n-st; j++ ) {
- for( i = j+st; i < MIN( n, lda ); i++ ) {
- if( LAPACK_SISNAN( a[i+j*lda] ) )
- return (lapack_logical) 1;
- }
- }
- }
- return (lapack_logical) 0;
-}
diff --git a/netlib/LAPACKE/lapacke_str_trans.c b/netlib/LAPACKE/lapacke_str_trans.c
deleted file mode 100644
index 85526ec..0000000
--- a/netlib/LAPACKE/lapacke_str_trans.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility function
-* Author: Intel Corporation
-* Created in February, 2010
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-/* Converts input triangular matrix from row-major(C) to column-major(Fortran)
- * layout or vice versa.
- */
-
-void LAPACKE_str_trans( int matrix_order, char uplo, char diag, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout )
-{
- lapack_int i, j, st;
- lapack_logical colmaj, lower, unit;
-
- if( in == NULL || out == NULL ) return ;
-
- colmaj = ( matrix_order == LAPACK_COL_MAJOR );
- lower = LAPACKE_lsame( uplo, 'l' );
- unit = LAPACKE_lsame( diag, 'u' );
-
- if( ( !colmaj && ( matrix_order != LAPACK_ROW_MAJOR ) ) ||
- ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
- ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
- /* Just exit if any of input parameters are wrong */
- return;
- }
- if( unit ) {
- /* If unit, then don't touch diagonal, start from 1st column or row */
- st = 1;
- } else {
- /* If non-unit, then check diagonal also, starting from [0,0] */
- st = 0;
- }
-
- /* Perform conversion:
- * Since col_major upper and row_major lower are equal,
- * and col_major lower and row_major upper are equals too -
- * using one code for equal cases. XOR( colmaj, upper )
- */
- if( ( colmaj || lower ) && !( colmaj && lower ) ) {
- for( j = st; j < MIN( n, ldout ); j++ ) {
- for( i = 0; i < MIN( j+1-st, ldin ); i++ ) {
- out[ j+i*ldout ] = in[ i+j*ldin ];
- }
- }
- } else {
- for( j = 0; j < MIN( n-st, ldout ); j++ ) {
- for( i = j+st; i < MIN( n, ldin ); i++ ) {
- out[ j+i*ldout ] = in[ i+j*ldin ];
- }
- }
- }
-}
diff --git a/netlib/LAPACKE/lapacke_strcon.c b/netlib/LAPACKE/lapacke_strcon.c
deleted file mode 100644
index e920747..0000000
--- a/netlib/LAPACKE/lapacke_strcon.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const float* a, lapack_int lda,
- float* rcond )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strcon", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -6;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_strcon_work( matrix_order, norm, uplo, diag, n, a, lda,
- rcond, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strcon", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strcon_work.c b/netlib/LAPACKE/lapacke_strcon_work.c
deleted file mode 100644
index c3e76de..0000000
--- a/netlib/LAPACKE/lapacke_strcon_work.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strcon
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const float* a,
- lapack_int lda, float* rcond, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strcon( &norm, &uplo, &diag, &n, a, &lda, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_strcon_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_str_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strcon( &norm, &uplo, &diag, &n, a_t, &lda_t, rcond, work, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strcon_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strcon_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strevc.c b/netlib/LAPACKE/lapacke_strevc.c
deleted file mode 100644
index 4c076d7..0000000
--- a/netlib/LAPACKE/lapacke_strevc.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strevc( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n, const float* t,
- lapack_int ldt, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strevc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_strevc_work( matrix_order, side, howmny, select, n, t, ldt,
- vl, ldvl, vr, ldvr, mm, m, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strevc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strevc_work.c b/netlib/LAPACKE/lapacke_strevc_work.c
deleted file mode 100644
index 9093fe0..0000000
--- a/netlib/LAPACKE/lapacke_strevc_work.c
+++ /dev/null
@@ -1,137 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strevc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strevc_work( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strevc( &side, &howmny, select, &n, t, &ldt, vl, &ldvl, vr,
- &ldvr, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldt_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* t_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_strevc_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_strevc_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_strevc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) &&
- LAPACKE_lsame( howmny, 'b' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_strevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t,
- vr_t, &ldvr_t, &mm, m, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
- ldvl );
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
- ldvr );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strevc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strevc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strexc.c b/netlib/LAPACKE/lapacke_strexc.c
deleted file mode 100644
index f544a1e..0000000
--- a/netlib/LAPACKE/lapacke_strexc.c
+++ /dev/null
@@ -1,73 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strexc( int matrix_order, char compq, lapack_int n, float* t,
- lapack_int ldt, float* q, lapack_int ldq,
- lapack_int* ifst, lapack_int* ilst )
-{
- lapack_int info = 0;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strexc", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -6;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -4;
- }
-#endif
- /* Allocate memory for working array(s) */
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_strexc_work( matrix_order, compq, n, t, ldt, q, ldq, ifst,
- ilst, work );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strexc", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strexc_work.c b/netlib/LAPACKE/lapacke_strexc_work.c
deleted file mode 100644
index 1ed9edf..0000000
--- a/netlib/LAPACKE/lapacke_strexc_work.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strexc
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strexc_work( int matrix_order, char compq, lapack_int n,
- float* t, lapack_int ldt, float* q,
- lapack_int ldq, lapack_int* ifst,
- lapack_int* ilst, float* work )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strexc( &compq, &n, t, &ldt, q, &ldq, ifst, ilst, work, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldt_t = MAX(1,n);
- float* t_t = NULL;
- float* q_t = NULL;
- /* Check leading dimension(s) */
- if( ldq < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_strexc_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_strexc_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_strexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, ifst, ilst, work,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strexc_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strexc_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strrfs.c b/netlib/LAPACKE/lapacke_strrfs.c
deleted file mode 100644
index e8d9b3c..0000000
--- a/netlib/LAPACKE/lapacke_strrfs.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr )
-{
- lapack_int info = 0;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strrfs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
- return -11;
- }
-#endif
- /* Allocate memory for working array(s) */
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_strrfs_work( matrix_order, uplo, trans, diag, n, nrhs, a,
- lda, b, ldb, x, ldx, ferr, berr, work, iwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- LAPACKE_free( iwork );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strrfs", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strrfs_work.c b/netlib/LAPACKE/lapacke_strrfs_work.c
deleted file mode 100644
index 1d8bf77..0000000
--- a/netlib/LAPACKE/lapacke_strrfs_work.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strrfs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strrfs( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x,
- &ldx, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldx_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- float* x_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_strrfs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_strrfs_work", info );
- return info;
- }
- if( ldx < nrhs ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_strrfs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
- if( x_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_str_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t,
- &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- LAPACKE_free( x_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strrfs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strrfs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strsen.c b/netlib/LAPACKE/lapacke_strsen.c
deleted file mode 100644
index fb1b008..0000000
--- a/netlib/LAPACKE/lapacke_strsen.c
+++ /dev/null
@@ -1,100 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n, float* t,
- lapack_int ldt, float* q, lapack_int ldq, float* wr,
- float* wi, lapack_int* m, float* s, float* sep )
-{
- lapack_int info = 0;
- lapack_int liwork = -1;
- lapack_int lwork = -1;
- lapack_int* iwork = NULL;
- float* work = NULL;
- lapack_int iwork_query;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strsen", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
- return -8;
- }
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -6;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_strsen_work( matrix_order, job, compq, select, n, t, ldt, q,
- ldq, wr, wi, m, s, sep, &work_query, lwork,
- &iwork_query, liwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- liwork = (lapack_int)iwork_query;
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Call middle-level interface */
- info = LAPACKE_strsen_work( matrix_order, job, compq, select, n, t, ldt, q,
- ldq, wr, wi, m, s, sep, work, lwork, iwork,
- liwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_1:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strsen", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strsen_work.c b/netlib/LAPACKE/lapacke_strsen_work.c
deleted file mode 100644
index d4f7068..0000000
--- a/netlib/LAPACKE/lapacke_strsen_work.c
+++ /dev/null
@@ -1,121 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strsen
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- float* t, lapack_int ldt, float* q,
- lapack_int ldq, float* wr, float* wi,
- lapack_int* m, float* s, float* sep,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strsen( &job, &compq, select, &n, t, &ldt, q, &ldq, wr, wi, m, s,
- sep, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldq_t = MAX(1,n);
- lapack_int ldt_t = MAX(1,n);
- float* t_t = NULL;
- float* q_t = NULL;
- /* Check leading dimension(s) */
- if( ldq < n ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_strsen_work", info );
- return info;
- }
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_strsen_work", info );
- return info;
- }
- /* Allocate memory for temporary array T */
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrix T */
- LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- /* Query optimal working array(s) size if requested */
- if( liwork == -1 || lwork == -1 ) {
- LAPACK_strsen( &job, &compq, select, &n, t_t, &ldt_t, q, &ldq_t, wr,
- wi, m, s, sep, work, &lwork, iwork, &liwork, &info );
- LAPACKE_free( t_t );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
- if( q_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_strsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, wr,
- wi, m, s, sep, work, &lwork, iwork, &liwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- LAPACKE_free( q_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strsen_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strsen_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strsna.c b/netlib/LAPACKE/lapacke_strsna.c
deleted file mode 100644
index 12bd638..0000000
--- a/netlib/LAPACKE/lapacke_strsna.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, const float* vl,
- lapack_int ldvl, const float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm, lapack_int* m )
-{
- lapack_int info = 0;
- lapack_int ldwork = LAPACKE_lsame( job, 'e' ) ? 1 : MAX(1,n) ;
- lapack_int* iwork = NULL;
- float* work = NULL;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strsna", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
- return -8;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
- return -10;
- }
- }
-#endif
- /* Allocate memory for working array(s) */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- iwork = (lapack_int*)
- LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*(n-1)) );
- if( iwork == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- work = (float*)LAPACKE_malloc( sizeof(float) * ldwork * MAX(1,n+6) );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- /* Call middle-level interface */
- info = LAPACKE_strsna_work( matrix_order, job, howmny, select, n, t, ldt,
- vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork,
- iwork );
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( work );
- }
-exit_level_1:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
- LAPACKE_free( iwork );
- }
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strsna", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strsna_work.c b/netlib/LAPACKE/lapacke_strsna_work.c
deleted file mode 100644
index 87c4354..0000000
--- a/netlib/LAPACKE/lapacke_strsna_work.c
+++ /dev/null
@@ -1,129 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strsna
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, const float* vl,
- lapack_int ldvl, const float* vr,
- lapack_int ldvr, float* s, float* sep,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int ldwork, lapack_int* iwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strsna( &job, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr,
- s, sep, &mm, m, work, &ldwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int ldt_t = MAX(1,n);
- lapack_int ldvl_t = MAX(1,n);
- lapack_int ldvr_t = MAX(1,n);
- float* t_t = NULL;
- float* vl_t = NULL;
- float* vr_t = NULL;
- /* Check leading dimension(s) */
- if( ldt < n ) {
- info = -7;
- LAPACKE_xerbla( "LAPACKE_strsna_work", info );
- return info;
- }
- if( ldvl < mm ) {
- info = -9;
- LAPACKE_xerbla( "LAPACKE_strsna_work", info );
- return info;
- }
- if( ldvr < mm ) {
- info = -11;
- LAPACKE_xerbla( "LAPACKE_strsna_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
- if( t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) );
- if( vl_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) );
- if( vr_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_sge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_strsna( &job, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t,
- vr_t, &ldvr_t, s, sep, &mm, m, work, &ldwork, iwork,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vr_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- LAPACKE_free( vl_t );
- }
-exit_level_1:
- LAPACKE_free( t_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strsna_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strsna_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strsyl.c b/netlib/LAPACKE/lapacke_strsyl.c
deleted file mode 100644
index a92af8b..0000000
--- a/netlib/LAPACKE/lapacke_strsyl.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, float* c, lapack_int ldc,
- float* scale )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strsyl", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_order, m, n, c, ldc ) ) {
- return -11;
- }
-#endif
- return LAPACKE_strsyl_work( matrix_order, trana, tranb, isgn, m, n, a, lda,
- b, ldb, c, ldc, scale );
-}
diff --git a/netlib/LAPACKE/lapacke_strsyl_work.c b/netlib/LAPACKE/lapacke_strsyl_work.c
deleted file mode 100644
index 552ffdd..0000000
--- a/netlib/LAPACKE/lapacke_strsyl_work.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strsyl
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, float* c, lapack_int ldc,
- float* scale )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strsyl( &trana, &tranb, &isgn, &m, &n, a, &lda, b, &ldb, c, &ldc,
- scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_int ldb_t = MAX(1,n);
- lapack_int ldc_t = MAX(1,m);
- float* a_t = NULL;
- float* b_t = NULL;
- float* c_t = NULL;
- /* Check leading dimension(s) */
- if( lda < m ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_strsyl_work", info );
- return info;
- }
- if( ldb < n ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_strsyl_work", info );
- return info;
- }
- if( ldc < n ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_strsyl_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
- if( c_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, m, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
- LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t,
- c_t, &ldc_t, scale, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
- /* Release memory and exit */
- LAPACKE_free( c_t );
-exit_level_2:
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strsyl_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strsyl_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strtri.c b/netlib/LAPACKE/lapacke_strtri.c
deleted file mode 100644
index 89e3a6a..0000000
--- a/netlib/LAPACKE/lapacke_strtri.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strtri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strtri( int matrix_order, char uplo, char diag, lapack_int n,
- float* a, lapack_int lda )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strtri", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -5;
- }
-#endif
- return LAPACKE_strtri_work( matrix_order, uplo, diag, n, a, lda );
-}
diff --git a/netlib/LAPACKE/lapacke_strtri_work.c b/netlib/LAPACKE/lapacke_strtri_work.c
deleted file mode 100644
index 1846f04..0000000
--- a/netlib/LAPACKE/lapacke_strtri_work.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strtri
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, float* a, lapack_int lda )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strtri( &uplo, &diag, &n, a, &lda, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_strtri_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_str_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strtri( &uplo, &diag, &n, a_t, &lda_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_str_trans( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a,
- lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strtri_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strtri_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strtrs.c b/netlib/LAPACKE/lapacke_strtrs.c
deleted file mode 100644
index d2e4b51..0000000
--- a/netlib/LAPACKE/lapacke_strtrs.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, float* b, lapack_int ldb )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strtrs", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_order, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
- return -9;
- }
-#endif
- return LAPACKE_strtrs_work( matrix_order, uplo, trans, diag, n, nrhs, a,
- lda, b, ldb );
-}
diff --git a/netlib/LAPACKE/lapacke_strtrs_work.c b/netlib/LAPACKE/lapacke_strtrs_work.c
deleted file mode 100644
index 740f30b..0000000
--- a/netlib/LAPACKE/lapacke_strtrs_work.c
+++ /dev/null
@@ -1,100 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strtrs
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* a, lapack_int lda, float* b,
- lapack_int ldb )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strtrs( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb,
- &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- lapack_int ldb_t = MAX(1,n);
- float* a_t = NULL;
- float* b_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_strtrs_work", info );
- return info;
- }
- if( ldb < nrhs ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_strtrs_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
- if( b_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_str_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t );
- LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strtrs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t,
- &ldb_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
- /* Release memory and exit */
- LAPACKE_free( b_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strtrs_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strtrs_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strttf.c b/netlib/LAPACKE/lapacke_strttf.c
deleted file mode 100644
index 796b947..0000000
--- a/netlib/LAPACKE/lapacke_strttf.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strttf( int matrix_order, char transr, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* arf )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strttf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -5;
- }
-#endif
- return LAPACKE_strttf_work( matrix_order, transr, uplo, n, a, lda, arf );
-}
diff --git a/netlib/LAPACKE/lapacke_strttf_work.c b/netlib/LAPACKE/lapacke_strttf_work.c
deleted file mode 100644
index e995cc9..0000000
--- a/netlib/LAPACKE/lapacke_strttf_work.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strttf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* arf )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strttf( &transr, &uplo, &n, a, &lda, arf, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- float* arf_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -6;
- LAPACKE_xerbla( "LAPACKE_strttf_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- arf_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( arf_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf );
- /* Release memory and exit */
- LAPACKE_free( arf_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strttf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strttf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_strttp.c b/netlib/LAPACKE/lapacke_strttp.c
deleted file mode 100644
index 597a266..0000000
--- a/netlib/LAPACKE/lapacke_strttp.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function strttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strttp( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* ap )
-{
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_strttp", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) {
- return -4;
- }
-#endif
- return LAPACKE_strttp_work( matrix_order, uplo, n, a, lda, ap );
-}
diff --git a/netlib/LAPACKE/lapacke_strttp_work.c b/netlib/LAPACKE/lapacke_strttp_work.c
deleted file mode 100644
index 51e3969..0000000
--- a/netlib/LAPACKE/lapacke_strttp_work.c
+++ /dev/null
@@ -1,90 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function strttp
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_strttp_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* ap )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_strttp( &uplo, &n, a, &lda, ap, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,n);
- float* a_t = NULL;
- float* ap_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_strttp_work", info );
- return info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- ap_t = (float*)
- LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
- if( ap_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_strttp( &uplo, &n, a_t, &lda_t, ap_t, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
- /* Release memory and exit */
- LAPACKE_free( ap_t );
-exit_level_1:
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_strttp_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_strttp_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stzrzf.c b/netlib/LAPACKE/lapacke_stzrzf.c
deleted file mode 100644
index 5feb1f5..0000000
--- a/netlib/LAPACKE/lapacke_stzrzf.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native high-level C interface to LAPACK function stzrzf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stzrzf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau )
-{
- lapack_int info = 0;
- lapack_int lwork = -1;
- float* work = NULL;
- float work_query;
- if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
- LAPACKE_xerbla( "LAPACKE_stzrzf", -1 );
- return -1;
- }
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_order, m, n, a, lda ) ) {
- return -4;
- }
-#endif
- /* Query optimal working array(s) size */
- info = LAPACKE_stzrzf_work( matrix_order, m, n, a, lda, tau, &work_query,
- lwork );
- if( info != 0 ) {
- goto exit_level_0;
- }
- lwork = (lapack_int)work_query;
- /* Allocate memory for work arrays */
- work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
- if( work == NULL ) {
- info = LAPACK_WORK_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Call middle-level interface */
- info = LAPACKE_stzrzf_work( matrix_order, m, n, a, lda, tau, work, lwork );
- /* Release memory and exit */
- LAPACKE_free( work );
-exit_level_0:
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stzrzf", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_stzrzf_work.c b/netlib/LAPACKE/lapacke_stzrzf_work.c
deleted file mode 100644
index fb68731..0000000
--- a/netlib/LAPACKE/lapacke_stzrzf_work.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2011, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function stzrzf
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_stzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork )
-{
- lapack_int info = 0;
- if( matrix_order == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_stzrzf( &m, &n, a, &lda, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_order == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
- /* Check leading dimension(s) */
- if( lda < n ) {
- info = -5;
- LAPACKE_xerbla( "LAPACKE_stzrzf_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_stzrzf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- LAPACK_stzrzf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
- /* Release memory and exit */
- LAPACKE_free( a_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_stzrzf_work", info );
- }
- } else {
- info = -1;
- LAPACKE_xerbla( "LAPACKE_stzrzf_work", info );
- }
- return info;
-}
diff --git a/netlib/LAPACKE/lapacke_utils.h b/netlib/LAPACKE/lapacke_utils.h
deleted file mode 100644
index 95f144e..0000000
--- a/netlib/LAPACKE/lapacke_utils.h
+++ /dev/null
@@ -1,579 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK utility functions
-* Author: Intel Corporation
-* Created in January, 2010
-*****************************************************************************/
-
-#ifndef _LAPACKE_UTILS_H_
-#define _LAPACKE_UTILS_H_
-
-#include "lapacke.h"
-
-#ifdef __cplusplus
-extern "C" {
-#endif /* __cplusplus */
-
-#ifndef ABS
-#define ABS(x) (((x) < 0) ? -(x) : (x))
-#endif
-#ifndef MAX
-#define MAX(x,y) (((x) > (y)) ? (x) : (y))
-#endif
-#ifndef MIN
-#define MIN(x,y) (((x) < (y)) ? (x) : (y))
-#endif
-#ifndef MAX3
-#define MAX3(x,y,z) (((x) > MAX(y,z)) ? (x) : MAX(y,z))
-#endif
-#ifndef MIN3
-#define MIN3(x,y,z) (((x) < MIN(y,z)) ? (x) : MIN(y,z))
-#endif
-
-#define IS_S_NONZERO(x) ( (x) < 0 || (x) > 0 )
-#define IS_D_NONZERO(x) ( (x) < 0 || (x) > 0 )
-#define IS_C_NONZERO(x) ( IS_S_NONZERO(*((float*)&x)) || \
- IS_S_NONZERO(*(((float*)&x)+1)) )
-#define IS_Z_NONZERO(x) ( IS_D_NONZERO(*((double*)&x)) || \
- IS_D_NONZERO(*(((double*)&x)+1)) )
-
-/* Error handler */
-void LAPACKE_xerbla( const char *name, lapack_int info );
-
-/* Compare two chars (case-insensitive) */
-lapack_logical LAPACKE_lsame( char ca, char cb );
-
-/* Functions to convert column-major to row-major 2d arrays and vice versa. */
-void LAPACKE_cgb_trans( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_cge_trans( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* in, lapack_int ldin,
- lapack_complex_float* out, lapack_int ldout );
-void LAPACKE_cgg_trans( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* in, lapack_int ldin,
- lapack_complex_float* out, lapack_int ldout );
-void LAPACKE_chb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_che_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_chp_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float *in,
- lapack_complex_float *out );
-void LAPACKE_chs_trans( int matrix_order, lapack_int n,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_cpb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_cpf_trans( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float *in,
- lapack_complex_float *out );
-void LAPACKE_cpo_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_cpp_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float *in,
- lapack_complex_float *out );
-void LAPACKE_csp_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float *in,
- lapack_complex_float *out );
-void LAPACKE_csy_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_ctb_trans( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-void LAPACKE_ctf_trans( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, const lapack_complex_float *in,
- lapack_complex_float *out );
-void LAPACKE_ctp_trans( int matrix_order, char uplo, char diag,
- lapack_int n, const lapack_complex_float *in,
- lapack_complex_float *out );
-void LAPACKE_ctr_trans( int matrix_order, char uplo, char diag, lapack_int n,
- const lapack_complex_float *in, lapack_int ldin,
- lapack_complex_float *out, lapack_int ldout );
-
-void LAPACKE_dgb_trans( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dge_trans( int matrix_order, lapack_int m, lapack_int n,
- const double* in, lapack_int ldin,
- double* out, lapack_int ldout );
-void LAPACKE_dgg_trans( int matrix_order, lapack_int m, lapack_int n,
- const double* in, lapack_int ldin,
- double* out, lapack_int ldout );
-void LAPACKE_dhs_trans( int matrix_order, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dpb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dpf_trans( int matrix_order, char transr, char uplo,
- lapack_int n, const double *in,
- double *out );
-void LAPACKE_dpo_trans( int matrix_order, char uplo, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dpp_trans( int matrix_order, char uplo, lapack_int n,
- const double *in,
- double *out );
-void LAPACKE_dsb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dsp_trans( int matrix_order, char uplo, lapack_int n,
- const double *in,
- double *out );
-void LAPACKE_dsy_trans( int matrix_order, char uplo, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dtb_trans( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-void LAPACKE_dtf_trans( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, const double *in,
- double *out );
-void LAPACKE_dtp_trans( int matrix_order, char uplo, char diag,
- lapack_int n, const double *in,
- double *out );
-void LAPACKE_dtr_trans( int matrix_order, char uplo, char diag, lapack_int n,
- const double *in, lapack_int ldin,
- double *out, lapack_int ldout );
-
-void LAPACKE_sgb_trans( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_sge_trans( int matrix_order, lapack_int m, lapack_int n,
- const float* in, lapack_int ldin,
- float* out, lapack_int ldout );
-void LAPACKE_sgg_trans( int matrix_order, lapack_int m, lapack_int n,
- const float* in, lapack_int ldin,
- float* out, lapack_int ldout );
-void LAPACKE_shs_trans( int matrix_order, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_spb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_spf_trans( int matrix_order, char transr, char uplo,
- lapack_int n, const float *in,
- float *out );
-void LAPACKE_spo_trans( int matrix_order, char uplo, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_spp_trans( int matrix_order, char uplo, lapack_int n,
- const float *in,
- float *out );
-void LAPACKE_ssb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_ssp_trans( int matrix_order, char uplo, lapack_int n,
- const float *in,
- float *out );
-void LAPACKE_ssy_trans( int matrix_order, char uplo, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_stb_trans( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-void LAPACKE_stf_trans( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, const float *in,
- float *out );
-void LAPACKE_stp_trans( int matrix_order, char uplo, char diag,
- lapack_int n, const float *in,
- float *out );
-void LAPACKE_str_trans( int matrix_order, char uplo, char diag, lapack_int n,
- const float *in, lapack_int ldin,
- float *out, lapack_int ldout );
-
-void LAPACKE_zgb_trans( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_zge_trans( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* in, lapack_int ldin,
- lapack_complex_double* out, lapack_int ldout );
-void LAPACKE_zgg_trans( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* in, lapack_int ldin,
- lapack_complex_double* out, lapack_int ldout );
-void LAPACKE_zhb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_zhe_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_zhp_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double *in,
- lapack_complex_double *out );
-void LAPACKE_zhs_trans( int matrix_order, lapack_int n,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_zpb_trans( int matrix_order, char uplo, lapack_int n,
- lapack_int kd,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_zpf_trans( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double *in,
- lapack_complex_double *out );
-void LAPACKE_zpo_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_zpp_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double *in,
- lapack_complex_double *out );
-void LAPACKE_zsp_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double *in,
- lapack_complex_double *out );
-void LAPACKE_zsy_trans( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_ztb_trans( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-void LAPACKE_ztf_trans( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, const lapack_complex_double *in,
- lapack_complex_double *out );
-void LAPACKE_ztp_trans( int matrix_order, char uplo, char diag,
- lapack_int n, const lapack_complex_double *in,
- lapack_complex_double *out );
-void LAPACKE_ztr_trans( int matrix_order, char uplo, char diag, lapack_int n,
- const lapack_complex_double *in, lapack_int ldin,
- lapack_complex_double *out, lapack_int ldout );
-
-/* NaN checkers */
-#define LAPACK_SISNAN( x ) ( x != x )
-#define LAPACK_DISNAN( x ) ( x != x )
-#define LAPACK_CISNAN( x ) ( LAPACK_SISNAN(*((float*) &x)) || \
- LAPACK_SISNAN(*(((float*) &x)+1)) )
-#define LAPACK_ZISNAN( x ) ( LAPACK_DISNAN(*((double*)&x)) || \
- LAPACK_DISNAN(*(((double*)&x)+1)) )
-
-/* NaN checkers for vectors */
-lapack_logical LAPACKE_c_nancheck( lapack_int n,
- const lapack_complex_float *x,
- lapack_int incx );
-lapack_logical LAPACKE_d_nancheck( lapack_int n,
- const double *x,
- lapack_int incx );
-lapack_logical LAPACKE_s_nancheck( lapack_int n,
- const float *x,
- lapack_int incx );
-lapack_logical LAPACKE_z_nancheck( lapack_int n,
- const lapack_complex_double *x,
- lapack_int incx );
-/* NaN checkers for matrices */
-lapack_logical LAPACKE_cgb_nancheck( int matrix_order, lapack_int m,
- lapack_int n, lapack_int kl,
- lapack_int ku,
- const lapack_complex_float *ab,
- lapack_int ldab );
-lapack_logical LAPACKE_cge_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-lapack_logical LAPACKE_cgg_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-lapack_logical LAPACKE_cgt_nancheck( lapack_int n,
- const lapack_complex_float *dl,
- const lapack_complex_float *d,
- const lapack_complex_float *du );
-lapack_logical LAPACKE_chb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const lapack_complex_float* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_che_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-lapack_logical LAPACKE_chp_nancheck( lapack_int n,
- const lapack_complex_float *ap );
-lapack_logical LAPACKE_chs_nancheck( int matrix_order, lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-lapack_logical LAPACKE_cpb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const lapack_complex_float* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_cpf_nancheck( lapack_int n,
- const lapack_complex_float *a );
-lapack_logical LAPACKE_cpo_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-lapack_logical LAPACKE_cpp_nancheck( lapack_int n,
- const lapack_complex_float *ap );
-lapack_logical LAPACKE_cpt_nancheck( lapack_int n,
- const float *d,
- const lapack_complex_float *e );
-lapack_logical LAPACKE_csp_nancheck( lapack_int n,
- const lapack_complex_float *ap );
-lapack_logical LAPACKE_cst_nancheck( lapack_int n,
- const lapack_complex_float *d,
- const lapack_complex_float *e );
-lapack_logical LAPACKE_csy_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-lapack_logical LAPACKE_ctb_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_float* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_ctf_nancheck( int matrix_order, char transr,
- char uplo, char diag,
- lapack_int n,
- const lapack_complex_float *a );
-lapack_logical LAPACKE_ctp_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const lapack_complex_float *ap );
-lapack_logical LAPACKE_ctr_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const lapack_complex_float *a,
- lapack_int lda );
-
-lapack_logical LAPACKE_dgb_nancheck( int matrix_order, lapack_int m,
- lapack_int n, lapack_int kl,
- lapack_int ku,
- const double *ab,
- lapack_int ldab );
-lapack_logical LAPACKE_dge_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const double *a,
- lapack_int lda );
-lapack_logical LAPACKE_dgg_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const double *a,
- lapack_int lda );
-lapack_logical LAPACKE_dgt_nancheck( lapack_int n,
- const double *dl,
- const double *d,
- const double *du );
-lapack_logical LAPACKE_dhs_nancheck( int matrix_order, lapack_int n,
- const double *a,
- lapack_int lda );
-lapack_logical LAPACKE_dpb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const double* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_dpf_nancheck( lapack_int n,
- const double *a );
-lapack_logical LAPACKE_dpo_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const double *a,
- lapack_int lda );
-lapack_logical LAPACKE_dpp_nancheck( lapack_int n,
- const double *ap );
-lapack_logical LAPACKE_dpt_nancheck( lapack_int n,
- const double *d,
- const double *e );
-lapack_logical LAPACKE_dsb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const double* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_dsp_nancheck( lapack_int n,
- const double *ap );
-lapack_logical LAPACKE_dst_nancheck( lapack_int n,
- const double *d,
- const double *e );
-lapack_logical LAPACKE_dsy_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const double *a,
- lapack_int lda );
-lapack_logical LAPACKE_dtb_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const double* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_dtf_nancheck( int matrix_order, char transr,
- char uplo, char diag,
- lapack_int n,
- const double *a );
-lapack_logical LAPACKE_dtp_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const double *ap );
-lapack_logical LAPACKE_dtr_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const double *a,
- lapack_int lda );
-
-lapack_logical LAPACKE_sgb_nancheck( int matrix_order, lapack_int m,
- lapack_int n, lapack_int kl,
- lapack_int ku,
- const float *ab,
- lapack_int ldab );
-lapack_logical LAPACKE_sge_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const float *a,
- lapack_int lda );
-lapack_logical LAPACKE_sgg_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const float *a,
- lapack_int lda );
-lapack_logical LAPACKE_sgt_nancheck( lapack_int n,
- const float *dl,
- const float *d,
- const float *du );
-lapack_logical LAPACKE_shs_nancheck( int matrix_order, lapack_int n,
- const float *a,
- lapack_int lda );
-lapack_logical LAPACKE_spb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const float* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_spf_nancheck( lapack_int n,
- const float *a );
-lapack_logical LAPACKE_spo_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const float *a,
- lapack_int lda );
-lapack_logical LAPACKE_spp_nancheck( lapack_int n,
- const float *ap );
-lapack_logical LAPACKE_spt_nancheck( lapack_int n,
- const float *d,
- const float *e );
-lapack_logical LAPACKE_ssb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const float* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_ssp_nancheck( lapack_int n,
- const float *ap );
-lapack_logical LAPACKE_sst_nancheck( lapack_int n,
- const float *d,
- const float *e );
-lapack_logical LAPACKE_ssy_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const float *a,
- lapack_int lda );
-lapack_logical LAPACKE_stb_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const float* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_stf_nancheck( int matrix_order, char transr,
- char uplo, char diag,
- lapack_int n,
- const float *a );
-lapack_logical LAPACKE_stp_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const float *ap );
-lapack_logical LAPACKE_str_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const float *a,
- lapack_int lda );
-
-lapack_logical LAPACKE_zgb_nancheck( int matrix_order, lapack_int m,
- lapack_int n, lapack_int kl,
- lapack_int ku,
- const lapack_complex_double *ab,
- lapack_int ldab );
-lapack_logical LAPACKE_zge_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-lapack_logical LAPACKE_zgg_nancheck( int matrix_order, lapack_int m,
- lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-lapack_logical LAPACKE_zgt_nancheck( lapack_int n,
- const lapack_complex_double *dl,
- const lapack_complex_double *d,
- const lapack_complex_double *du );
-lapack_logical LAPACKE_zhb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const lapack_complex_double* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_zhe_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-lapack_logical LAPACKE_zhp_nancheck( lapack_int n,
- const lapack_complex_double *ap );
-lapack_logical LAPACKE_zhs_nancheck( int matrix_order, lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-lapack_logical LAPACKE_zpb_nancheck( int matrix_order, char uplo,
- lapack_int n, lapack_int kd,
- const lapack_complex_double* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_zpf_nancheck( lapack_int n,
- const lapack_complex_double *a );
-lapack_logical LAPACKE_zpo_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-lapack_logical LAPACKE_zpp_nancheck( lapack_int n,
- const lapack_complex_double *ap );
-lapack_logical LAPACKE_zpt_nancheck( lapack_int n,
- const double *d,
- const lapack_complex_double *e );
-lapack_logical LAPACKE_zsp_nancheck( lapack_int n,
- const lapack_complex_double *ap );
-lapack_logical LAPACKE_zst_nancheck( lapack_int n,
- const lapack_complex_double *d,
- const lapack_complex_double *e );
-lapack_logical LAPACKE_zsy_nancheck( int matrix_order, char uplo,
- lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-lapack_logical LAPACKE_ztb_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_double* ab,
- lapack_int ldab );
-lapack_logical LAPACKE_ztf_nancheck( int matrix_order, char transr,
- char uplo, char diag,
- lapack_int n,
- const lapack_complex_double *a );
-lapack_logical LAPACKE_ztp_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const lapack_complex_double *ap );
-lapack_logical LAPACKE_ztr_nancheck( int matrix_order, char uplo, char diag,
- lapack_int n,
- const lapack_complex_double *a,
- lapack_int lda );
-
-#ifdef __cplusplus
-}
-#endif /* __cplusplus */
-
-#endif /* _LAPACKE_UTILS_H_ */
diff --git a/netlib/LAPACKE/lapacke_xerbla.c b/netlib/LAPACKE/lapacke_xerbla.c
deleted file mode 100644
index de4761f..0000000
--- a/netlib/LAPACKE/lapacke_xerbla.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK lsame
-* Author: Intel Corporation
-* Created in January, 2010
-*****************************************************************************/
-
-#include <stdio.h>
-#include "lapacke_utils.h"
-
-void LAPACKE_xerbla( const char *name, lapack_int info )
-{
- if( info == LAPACK_WORK_MEMORY_ERROR ) {
- printf( "Not enough memory to allocate work array in %s\n", name );
- } else if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- printf( "Not enough memory to transpose matrix in %s\n", name );
- } else if( info < 0 ) {
- printf( "Wrong parameter %d in %s\n", -(int) info, name );
- }
-}
diff --git a/netlib/README b/netlib/README
deleted file mode 100644
index d47a657..0000000
--- a/netlib/README
+++ /dev/null
@@ -1,39 +0,0 @@
-This folder contains the netlib reference implementations.
-
-The netlib API is a Fortran API. The recommended C interface is via
-the CBLAS wrapper (for BLAS) and the LAPACKE wrapper (for LAPACK).
-
-netlib-java uses the C interface for native calls.
-
-Note that the CLAPACK effort is a translation of the Fortran codes into C
-and is therefore not as performant as the original Fortran codes - we
-do not use CLAPACK.
-
-There is no official C interface to ARPACK:
-[ARPACK-1287](http://forge.scilab.org/index.php/p/arpack-ng/issues/1287/).
-
-Files extracted from:
-
- http://www.netlib.org/blas/blas.tgz
- http://www.netlib.org/blas/blast-forum/cblas.tgz
-
- http://www.netlib.org/lapack/lapack-3.4.2.tgz (from various folders)
- http://www.netlib.org/lapack/lapacke_mangling.h (missing file)
-
- http://forge.scilab.org/index.php/p/arpack-ng/downloads/607/
- http://www.caam.rice.edu/software/ARPACK/ARPACK++/arpack++.tar.gz (modified arpack.h)
-
-Complex and double complex routines are not included because they are not
-supported by netlib-java.
-
-The following files have been removed because they don't compile:
-
-BLAS/xerbla.c
-LAPACK/xerbla.f
-LAPACK/*_extended.f
-LAPACK/{d,s}{gb,ge,po,sy}{rfs,svx}x.f
-LAPACKE/lapacke_{d,s}{gb,ge,po,sy}{rfs,svx}x{_work,}.c
-
-
-LAPACK ships with a bundled version of BLAS, but we use the original BLAS.
-Likewise for ARPACK and BLAS/LAPACK.
diff --git a/netlib/symbol.map b/netlib/symbol.map
deleted file mode 100644
index 3f498b2..0000000
--- a/netlib/symbol.map
+++ /dev/null
@@ -1 +0,0 @@
-{ global: Java_*; _Java_*; local: *; };
\ No newline at end of file
diff --git a/perf/logging.properties b/perf/logging.properties
deleted file mode 100644
index eb7f538..0000000
--- a/perf/logging.properties
+++ /dev/null
@@ -1,9 +0,0 @@
-handlers = java.util.logging.ConsoleHandler
-java.util.logging.ConsoleHandler.level = ALL
-java.util.logging.ConsoleHandler.formatter = com.github.fommil.logging.CustomFormatter
-com.github.fommil.logging.CustomFormatter.format = %L: %m [%c] (%n) %e %E %S
-com.github.fommil.logging.CustomFormatter.stackExclude = \
- org.jetbrains. com.intellij java. sun. com.sun
-
-com.github.fommil.level = ALL
-.level = WARNING
diff --git a/perf/pom.xml b/perf/pom.xml
deleted file mode 100644
index 5d328ad..0000000
--- a/perf/pom.xml
+++ /dev/null
@@ -1,86 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <!--
-
- mvn compile assembly:single
- # F2J
- java -Djava.util.logging.config.file=logging.properties -Dcom.github.fommil.netlib.BLAS=com.github.fommil.netlib.F2jBLAS -Dcom.github.fommil.netlib.LAPACK=com.github.fommil.netlib.F2jLAPACK -Dcom.github.fommil.netlib.ARPACK=com.github.fommil.netlib.F2jARPACK -jar target/perf-*-jar-with-dependencies.jar
- # native_ref
- java -Djava.util.logging.config.file=logging.properties -Dcom.github.fommil.netlib.BLAS=com.github.fommil.netlib.NativeRefBLAS -Dcom.github.fommil.netlib.LAPACK=com.github.fommil.netlib.NativeRefLAPACK -Dcom.github.fommil.netlib.ARPACK=com.github.fommil.netlib.NativeRefARPACK -jar target/perf-*-jar-with-dependencies.jar
- # native_system
- java -Djava.util.logging.config.file=logging.properties -jar target/perf-*-jar-with-dependencies.jar
-
- and potentially (e.g. on raspberrypi)
-
-/usr/bin/java -Dperf.max=75 -Djvm.type=jdk7 -Djava.util.logging.config.file=logging.properties -jar target/perf-1.1-jar-with-dependencies.jar
-/usr/bin/java -jamvm -Dperf.max=75 -Djvm.type=jamvm -Djava.util.logging.config.file=logging.properties -jar target/perf-1.1-jar-with-dependencies.jar
-/usr/bin/java -avian -Dperf.max=75 -Djvm.type=avian -Djava.util.logging.config.file=logging.properties -jar target/perf-1.1-jar-with-dependencies.jar
-/opt/jdk8/bin/java -Dperf.max=75 -Djvm.type=jdk8 -Djava.util.logging.config.file=logging.properties -jar target/perf-1.1-jar-with-dependencies.jar
-/opt/jdk8/bin/java -Dperf.max=75 -Djava.util.logging.config.file=logging.properties -Dcom.github.fommil.netlib.BLAS=com.github.fommil.netlib.NativeRefBLAS -Dcom.github.fommil.netlib.LAPACK=com.github.fommil.netlib.NativeRefLAPACK -Dcom.github.fommil.netlib.ARPACK=com.github.fommil.netlib.NativeRefARPACK -jar target/perf-1.1-jar-with-dependencies.jar
-/opt/jdk8/bin/java -Dperf.max=75 -Djava.util.logging.config.file=logging.properties -Dcom.github.fommil.netlib.BLAS=com.github.fommil.netlib.NativeSystemBLAS -Dcom.github.fommil.netlib.LAPACK=com.github.fommil.netlib.NativeSystemLAPACK -Dcom.github.fommil.netlib.ARPACK=com.github.fommil.netlib.NativeSystemARPACK -jar target/perf-1.1-jar-with-dependencies.jar
- -->
-
- <parent>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.2-SNAPSHOT</version>
- </parent>
-
- <artifactId>perf</artifactId>
- <packaging>jar</packaging>
-
- <properties>
- <exec.mainClass>com.github.fommil.netlib.Benchmarks</exec.mainClass>
- </properties>
-
- <dependencies>
- <dependency>
- <groupId>net.sf.opencsv</groupId>
- <artifactId>opencsv</artifactId>
- </dependency>
- <dependency>
- <groupId>com.github.fommil</groupId>
- <artifactId>java-logging</artifactId>
- </dependency>
- <dependency>
- <groupId>${project.parent.groupId}</groupId>
- <version>${project.parent.version}</version>
- <artifactId>all</artifactId>
- <type>pom</type>
- </dependency>
- <dependency>
- <groupId>com.google.guava</groupId>
- <artifactId>guava</artifactId>
- </dependency>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- </dependency>
- </dependencies>
-
- <build>
- <plugins>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- </plugin>
- <plugin>
- <artifactId>maven-assembly-plugin</artifactId>
- <configuration>
- <archive>
- <manifest>
- <mainClass>${exec.mainClass}</mainClass>
- </manifest>
- </archive>
- <descriptorRefs>
- <descriptorRef>jar-with-dependencies</descriptorRef>
- </descriptorRefs>
- </configuration>
- </plugin>
- </plugins>
- </build>
-</project>
diff --git a/perf/results/linux-arm-avian-ddot-f2jblas.csv.gz b/perf/results/linux-arm-avian-ddot-f2jblas.csv.gz
deleted file mode 100644
index a9b0266..0000000
Binary files a/perf/results/linux-arm-avian-ddot-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-avian-dgemm-f2jblas.csv.gz b/perf/results/linux-arm-avian-dgemm-f2jblas.csv.gz
deleted file mode 100644
index ca87cf2..0000000
Binary files a/perf/results/linux-arm-avian-dgemm-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-avian-dgetri-f2jblas.csv.gz b/perf/results/linux-arm-avian-dgetri-f2jblas.csv.gz
deleted file mode 100644
index 6659568..0000000
Binary files a/perf/results/linux-arm-avian-dgetri-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-avian-linpack-f2jblas.csv.gz b/perf/results/linux-arm-avian-linpack-f2jblas.csv.gz
deleted file mode 100644
index ed46230..0000000
Binary files a/perf/results/linux-arm-avian-linpack-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-ddot-CBLAS.csv.gz b/perf/results/linux-arm-ddot-CBLAS.csv.gz
deleted file mode 100644
index a499514..0000000
Binary files a/perf/results/linux-arm-ddot-CBLAS.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-ddot-atlas.csv.gz b/perf/results/linux-arm-ddot-atlas.csv.gz
deleted file mode 100644
index d0d565a..0000000
Binary files a/perf/results/linux-arm-ddot-atlas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-ddot-nativerefblas.csv.gz b/perf/results/linux-arm-ddot-nativerefblas.csv.gz
deleted file mode 100644
index 3e0cdd5..0000000
Binary files a/perf/results/linux-arm-ddot-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-ddot-nativesystemblas.csv.gz b/perf/results/linux-arm-ddot-nativesystemblas.csv.gz
deleted file mode 100644
index f374152..0000000
Binary files a/perf/results/linux-arm-ddot-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgemm-CBLAS.csv.gz b/perf/results/linux-arm-dgemm-CBLAS.csv.gz
deleted file mode 100644
index eb68e0a..0000000
Binary files a/perf/results/linux-arm-dgemm-CBLAS.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgemm-atlas.csv.gz b/perf/results/linux-arm-dgemm-atlas.csv.gz
deleted file mode 100644
index facfe8c..0000000
Binary files a/perf/results/linux-arm-dgemm-atlas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgemm-nativerefblas.csv.gz b/perf/results/linux-arm-dgemm-nativerefblas.csv.gz
deleted file mode 100644
index 46a4223..0000000
Binary files a/perf/results/linux-arm-dgemm-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgemm-nativesystemblas.csv.gz b/perf/results/linux-arm-dgemm-nativesystemblas.csv.gz
deleted file mode 100644
index ecbcdfb..0000000
Binary files a/perf/results/linux-arm-dgemm-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgetri-CBLAS.csv.gz b/perf/results/linux-arm-dgetri-CBLAS.csv.gz
deleted file mode 100644
index 79b964e..0000000
Binary files a/perf/results/linux-arm-dgetri-CBLAS.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgetri-atlas.csv.gz b/perf/results/linux-arm-dgetri-atlas.csv.gz
deleted file mode 100644
index ac1ed79..0000000
Binary files a/perf/results/linux-arm-dgetri-atlas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgetri-nativerefblas.csv.gz b/perf/results/linux-arm-dgetri-nativerefblas.csv.gz
deleted file mode 100644
index 3494bea..0000000
Binary files a/perf/results/linux-arm-dgetri-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-dgetri-nativesystemblas.csv.gz b/perf/results/linux-arm-dgetri-nativesystemblas.csv.gz
deleted file mode 100644
index 3b9d9a1..0000000
Binary files a/perf/results/linux-arm-dgetri-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jamvm-ddot-f2jblas.csv.gz b/perf/results/linux-arm-jamvm-ddot-f2jblas.csv.gz
deleted file mode 100644
index a88d08b..0000000
Binary files a/perf/results/linux-arm-jamvm-ddot-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jamvm-dgemm-f2jblas.csv.gz b/perf/results/linux-arm-jamvm-dgemm-f2jblas.csv.gz
deleted file mode 100644
index ff59d58..0000000
Binary files a/perf/results/linux-arm-jamvm-dgemm-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jamvm-dgetri-f2jblas.csv.gz b/perf/results/linux-arm-jamvm-dgetri-f2jblas.csv.gz
deleted file mode 100644
index aed4bb7..0000000
Binary files a/perf/results/linux-arm-jamvm-dgetri-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jamvm-linpack-f2jblas.csv.gz b/perf/results/linux-arm-jamvm-linpack-f2jblas.csv.gz
deleted file mode 100644
index 24a4ac3..0000000
Binary files a/perf/results/linux-arm-jamvm-linpack-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk7-ddot-f2jblas.csv.gz b/perf/results/linux-arm-jdk7-ddot-f2jblas.csv.gz
deleted file mode 100644
index f3ea34d..0000000
Binary files a/perf/results/linux-arm-jdk7-ddot-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk7-dgemm-f2jblas.csv.gz b/perf/results/linux-arm-jdk7-dgemm-f2jblas.csv.gz
deleted file mode 100644
index 750050e..0000000
Binary files a/perf/results/linux-arm-jdk7-dgemm-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk7-dgetri-f2jblas.csv.gz b/perf/results/linux-arm-jdk7-dgetri-f2jblas.csv.gz
deleted file mode 100644
index 32828d6..0000000
Binary files a/perf/results/linux-arm-jdk7-dgetri-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk7-linpack-f2jblas.csv.gz b/perf/results/linux-arm-jdk7-linpack-f2jblas.csv.gz
deleted file mode 100644
index 4e95f73..0000000
Binary files a/perf/results/linux-arm-jdk7-linpack-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk8-ddot-f2jblas.csv.gz b/perf/results/linux-arm-jdk8-ddot-f2jblas.csv.gz
deleted file mode 100644
index 79a3852..0000000
Binary files a/perf/results/linux-arm-jdk8-ddot-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk8-dgemm-f2jblas.csv.gz b/perf/results/linux-arm-jdk8-dgemm-f2jblas.csv.gz
deleted file mode 100644
index 60615d7..0000000
Binary files a/perf/results/linux-arm-jdk8-dgemm-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk8-dgetri-f2jblas.csv.gz b/perf/results/linux-arm-jdk8-dgetri-f2jblas.csv.gz
deleted file mode 100644
index fa1f389..0000000
Binary files a/perf/results/linux-arm-jdk8-dgetri-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-jdk8-linpack-f2jblas.csv.gz b/perf/results/linux-arm-jdk8-linpack-f2jblas.csv.gz
deleted file mode 100644
index 51d8c95..0000000
Binary files a/perf/results/linux-arm-jdk8-linpack-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-linpack-nativerefblas.csv.gz b/perf/results/linux-arm-linpack-nativerefblas.csv.gz
deleted file mode 100644
index dee4d28..0000000
Binary files a/perf/results/linux-arm-linpack-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/linux-arm-linpack-nativesystemblas.csv.gz b/perf/results/linux-arm-linpack-nativesystemblas.csv.gz
deleted file mode 100644
index 1a7ca36..0000000
Binary files a/perf/results/linux-arm-linpack-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-CBLAS.csv.gz b/perf/results/mac_os_x-x86_64-ddot-CBLAS.csv.gz
deleted file mode 100644
index 73ced70..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-CBLAS.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-atlas.csv.gz b/perf/results/mac_os_x-x86_64-ddot-atlas.csv.gz
deleted file mode 100644
index ff66766..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-atlas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-cuda.csv.gz b/perf/results/mac_os_x-x86_64-ddot-cuda.csv.gz
deleted file mode 100644
index 64044d7..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-cuda.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-cuda_nooh.csv.gz b/perf/results/mac_os_x-x86_64-ddot-cuda_nooh.csv.gz
deleted file mode 100644
index c76451e..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-cuda_nooh.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-f2jblas.csv.gz b/perf/results/mac_os_x-x86_64-ddot-f2jblas.csv.gz
deleted file mode 100644
index 2a17b3e..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-mkl.csv.gz b/perf/results/mac_os_x-x86_64-ddot-mkl.csv.gz
deleted file mode 100644
index e109f9f..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-mkl.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-nativerefblas.csv.gz b/perf/results/mac_os_x-x86_64-ddot-nativerefblas.csv.gz
deleted file mode 100644
index 348b762..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-nativesystemblas.csv.gz b/perf/results/mac_os_x-x86_64-ddot-nativesystemblas.csv.gz
deleted file mode 100644
index dd74a99..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-ddot-veclib.csv.gz b/perf/results/mac_os_x-x86_64-ddot-veclib.csv.gz
deleted file mode 100644
index 7a6c0fc..0000000
Binary files a/perf/results/mac_os_x-x86_64-ddot-veclib.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-CBLAS.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-CBLAS.csv.gz
deleted file mode 100644
index 54d5d66..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-CBLAS.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-atlas.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-atlas.csv.gz
deleted file mode 100644
index 46be47d..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-atlas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-cuda.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-cuda.csv.gz
deleted file mode 100644
index ac4ba78..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-cuda.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-cuda_nooh.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-cuda_nooh.csv.gz
deleted file mode 100644
index 92eb2fc..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-cuda_nooh.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-f2jblas.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-f2jblas.csv.gz
deleted file mode 100644
index a9dd33a..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-mkl.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-mkl.csv.gz
deleted file mode 100644
index 94c8b7c..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-mkl.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-nativerefblas.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-nativerefblas.csv.gz
deleted file mode 100644
index 760dc12..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-nativesystemblas.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-nativesystemblas.csv.gz
deleted file mode 100644
index 8fea10a..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgemm-veclib.csv.gz b/perf/results/mac_os_x-x86_64-dgemm-veclib.csv.gz
deleted file mode 100644
index 5c801eb..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgemm-veclib.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-CBLAS.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-CBLAS.csv.gz
deleted file mode 100644
index 9db1d45..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-CBLAS.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-atlas.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-atlas.csv.gz
deleted file mode 100644
index 899be9b..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-atlas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-f2jblas.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-f2jblas.csv.gz
deleted file mode 100644
index 3c188db..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-mkl.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-mkl.csv.gz
deleted file mode 100644
index b47fff5..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-mkl.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-nativerefblas.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-nativerefblas.csv.gz
deleted file mode 100644
index 1c2475f..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-nativesystemblas.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-nativesystemblas.csv.gz
deleted file mode 100644
index f37a641..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dgetri-veclib.csv.gz b/perf/results/mac_os_x-x86_64-dgetri-veclib.csv.gz
deleted file mode 100644
index b027233..0000000
Binary files a/perf/results/mac_os_x-x86_64-dgetri-veclib.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dsaupd-f2jblas.csv.gz b/perf/results/mac_os_x-x86_64-dsaupd-f2jblas.csv.gz
deleted file mode 100644
index afca259..0000000
Binary files a/perf/results/mac_os_x-x86_64-dsaupd-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dsaupd-nativerefblas.csv.gz b/perf/results/mac_os_x-x86_64-dsaupd-nativerefblas.csv.gz
deleted file mode 100644
index 94bc28e..0000000
Binary files a/perf/results/mac_os_x-x86_64-dsaupd-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-dsaupd-nativesystemblas.csv.gz b/perf/results/mac_os_x-x86_64-dsaupd-nativesystemblas.csv.gz
deleted file mode 100644
index f0dc83d..0000000
Binary files a/perf/results/mac_os_x-x86_64-dsaupd-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-linpack-f2jblas.csv.gz b/perf/results/mac_os_x-x86_64-linpack-f2jblas.csv.gz
deleted file mode 100644
index e288d44..0000000
Binary files a/perf/results/mac_os_x-x86_64-linpack-f2jblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-linpack-nativerefblas.csv.gz b/perf/results/mac_os_x-x86_64-linpack-nativerefblas.csv.gz
deleted file mode 100644
index 1ab2d64..0000000
Binary files a/perf/results/mac_os_x-x86_64-linpack-nativerefblas.csv.gz and /dev/null differ
diff --git a/perf/results/mac_os_x-x86_64-linpack-nativesystemblas.csv.gz b/perf/results/mac_os_x-x86_64-linpack-nativesystemblas.csv.gz
deleted file mode 100644
index b1e2508..0000000
Binary files a/perf/results/mac_os_x-x86_64-linpack-nativesystemblas.csv.gz and /dev/null differ
diff --git a/perf/results/plot.R b/perf/results/plot.R
deleted file mode 100644
index a1865ab..0000000
--- a/perf/results/plot.R
+++ /dev/null
@@ -1,178 +0,0 @@
-library(stringr)
-
-# this quickly-knocked-up-only-to-be-run-once file produces
-# (pretty ugly) performance charts of netlib-java on various
-# platforms.
-
-# for A in ddot dgemm dgetri dsaupd ; do convert -density 300 -depth 8 -quality 85 $A.pdf $A.png ; done
-
-benchmarks = c("linpack")
-pBenchmarks = c("ddot", "dgemm", "dgetri", "dsaupd")
-targets = c("linux-amd64", "linux-i386", "mac_os_x-x86_64", "windows_8-amd64", "windows_8-x86")
-impls = c("f2jblas", "nativerefblas")
-
-par(cex = 1.5, cex.lab=1.5, cex.axis=1.5, cex.main=1.5, cex.sub=1.5, family="Palatino")
-
-setPdfOut <- function(filename){
- if (interactive()) {
- quartz()
- } else {
- pdf(filename, width=11, height=8.5)
- }
-}
-
-# calls f(file, target, implementation, count) for every file that matches the
-# pattern expected for the benchmark b
-foreachResult = function(f, b) {
- regex = paste("(.*)-", b, "-(.*)\\.csv.gz", sep="")
- files = list.files(pattern=regex)
- count = 0
- for (file in files) {
- groups = str_match(file, regex)
- t = groups[1,2]
- i = groups[1,3]
- count = count + 1
- f(file, t, i, count)
- }
-}
-
-printer = function(f, t, i, c) {
- print(paste(f, t, i, c))
-}
-
-
-doPlot = function(data, col, sym) {
- # could potentially do a confidence plot like
- # https://github.com/fommil/golf-stats/blob/master/SbsScraper/R/golfStats.R
-
- d = data.frame(data)
- dd = c()
- for (x in unique(data[,1])) {
- sub = subset(d, size == x)
- avg = mean(sub[,2])
- dd = rbind(dd, c(x, avg))
- }
- points(dd, pch=as.numeric(sym), lwd=1, col=col)
-}
-
-# nobody would be proud of this function...
-getPlotParams = function(t, i) {
- if (regexpr("arm", t) > 0) {
- sym = 8
- } else if (regexpr("linux", t) > 0) {
- sym = 3
- } else if (regexpr("mac", t) > 0) {
- sym = 20
- } else if (regexpr("win", t) > 0) {
- sym = 4
- }
-
- if (regexpr("nativeref", i) > 0) {
- col = "red"
- }
- else if (regexpr("nativesystem", i) > 0) {
- col = "cyan"
- }
- else if (regexpr("jamvm", t) > 0) {
- col = "magenta"
- }
- else if (regexpr("avian", t) > 0) {
- col = "blue"
- }
- else if (regexpr("jdk7", t) > 0) {
- col = "orange"
- }
- else if (regexpr("veclib", i) > 0) {
- col = "black"
- }
- else if (regexpr("CBLAS", i) > 0) {
- col = "tomato1"
- }
- else if (regexpr("mkl", i) > 0) {
- col = "orange"
- }
- else if (regexpr("atlas", i) > 0) {
- col = "gray"
- }
- else if (regexpr("cuda_nooh", i) > 0) {
- col = "blue"
- }
- else if (regexpr("cuda", i) > 0) {
- col = "purple"
- }
- else if (regexpr("clblas", i) > 0) {
- col = "brown"
- }
- else {
- col = "yellow"
- }
-
- c(col, sym)
-}
-
-leg = c()
-addData = function(f, t, i, c) {
- data = read.csv(gzfile(f), col.names=c("size", "time"))
- data[,2] = data[,2] / 1000000000
- settings = getPlotParams(t, i)
- col = settings[1]
- sym = settings[2]
-
- doPlot(data, col, sym)
- myleg <- rbind(leg, c(paste(t, i), col, sym))
- assign("leg", myleg, env=globalenv())
-}
-
-addDataSingle = function(f, t, i, c) {
- data = read.csv(f, col.names=c("time"))
- data[,1] = data[,1] / 1000000000
- settings = getPlotParams(t, i)
- col = settings[1]
- sym = settings[2]
-
- points(data[,1], pch=as.numeric(sym), lwd=1, col=col)
-
- myleg <- rbind(leg, c(paste(t, i), col, sym))
- assign("leg", myleg, env=globalenv())
- print(leg)
-}
-
-logAxis = function(type, lims) {
- x1 <- floor(log10(lims))
- pow <- seq(x1[1], x1[2]+1)
- ticksat <- as.vector(sapply(pow, function(p) (1:10)*10^p))
- axis(type, 10^pow)
- axis(type, ticksat, labels=NA, tcl=-0.25, lwd=0, lwd.ticks=1)
-}
-
-for (b in benchmarks) {
- assign("leg", c(), env=globalenv())
- xlim = c(0, 10)
- ylim = c(1e-04, 100)
- setPdfOut(paste("./", b, ".pdf", sep=""))
-
- plot(c(), xlab="Iteration", ylab="Time (seconds)", log="y", xlim=xlim, ylim=ylim, main=paste(b, "Performance"))
-
- foreachResult(addDataSingle, b)
-
- logAxis(2, ylim)
-
- legend("topright", legend=leg[,1], pch=as.numeric(leg[,3]), col=leg[,2], bty="n")
-}
-
-
-for (b in pBenchmarks) {
- assign("leg", c(), env=globalenv())
- xlim = c(10, 1e06)
- ylim = c(1e-06, 1)
- setPdfOut(paste("./", b, ".pdf", sep=""))
- plot(1:100, xlab="Array (size)", ylab="Time (seconds)", log="xy", xaxt="n", yaxt="n", xlim=xlim, ylim=ylim, main=paste(b, "Performance"))
-
- foreachResult(addData, b)
-
- logAxis(1, xlim)
- logAxis(2, ylim)
-
- legend("topleft", legend=leg[,1], pch=as.numeric(leg[,3]), col=leg[,2], bty="n")
-}
-
diff --git a/perf/src/main/c/clwrapper.c b/perf/src/main/c/clwrapper.c
deleted file mode 100644
index 44e1ad8..0000000
--- a/perf/src/main/c/clwrapper.c
+++ /dev/null
@@ -1,125 +0,0 @@
-#include <stdio.h>
-#include <stdlib.h>
-
-#include <cblas.h>
-#include <clBlas.h>
-
-void
-cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const double alpha, const double *A,
- const int lda, const double *B, const int ldb,
- const double beta, double *C, const int ldc)
-{
- cl_int err;
- cl_platform_id platform = 0;
- cl_device_id device = 0;
- cl_context_properties props[3] = {CL_CONTEXT_PLATFORM, 0, 0};
- cl_context ctx = 0;
- cl_command_queue queue = 0;
- cl_mem bufA , bufB, bufC;
- cl_event event = NULL;
- cl_uint available = 0;
- int ret = 0;
-
- // HACK: ignore order / trans
- clblasOrder order = clblasColumnMajor;
- clblasTranspose transA = clblasNoTrans;
- clblasTranspose transB = clblasNoTrans;
-
-
- /* Setup OpenCL environment. */
- err = clGetPlatformIDs(1, &platform, &available);
- if (err != CL_SUCCESS) {
- printf("clGetPlatformIDs() failed with %d and %d\n", err, available);
- exit(1);
- }
- printf("found %d OpenCL platforms\n", available);
-
- // CL_DEVICE_TYPE_GPU forces GPU use
- err = clGetDeviceIDs(platform, CL_DEVICE_TYPE_DEFAULT, 1, &device, &available);
- if (err != CL_SUCCESS) {
- printf("clGetDeviceIDs() failed with %d\n", err);
- exit(1);
- }
- printf("found %d OpenCL devices\n", available);
-
- props[1] = (cl_context_properties) platform;
- ctx = clCreateContext(props, 1, &device, NULL, NULL, &err);
- if (err != CL_SUCCESS) {
- printf("clCreateContext() failed with %d\n", err);
- exit(1);
- }
- printf("created context\n");
-
- queue = clCreateCommandQueue(ctx, device, 0, &err);
- if (err != CL_SUCCESS) {
- printf("clCreateCommandQueue() failed with %d\n", err);
- clReleaseContext(ctx);
- exit(1);
- }
- printf("created command queue\n");
-
- /* Setup clblas. */
- err = clblasSetup();
- if (err != CL_SUCCESS) {
- printf("clblasSetup() failed with %d\n", err);
- clReleaseCommandQueue(queue);
- clReleaseContext(ctx);
- exit(1);
- }
- printf("setup clblas\n");
-
- /* Prepare OpenCL memory objects and place matrices inside them. */
- bufA = clCreateBuffer(ctx, CL_MEM_READ_ONLY, M * K * sizeof(*A), NULL, &err);
- bufB = clCreateBuffer(ctx, CL_MEM_READ_ONLY, K * N * sizeof(*B), NULL, &err);
- bufC = clCreateBuffer(ctx, CL_MEM_READ_WRITE, M * N * sizeof(*C), NULL, &err);
- printf("created buffers\n");
-
-
- err = clEnqueueWriteBuffer(queue, bufA, CL_TRUE, 0, M * K * sizeof(double), A, 0, NULL, NULL);
- err = clEnqueueWriteBuffer(queue, bufB, CL_TRUE, 0, K * N * sizeof(double), B, 0, NULL, NULL);
- err = clEnqueueWriteBuffer(queue, bufC, CL_TRUE, 0, M * N * sizeof(double), C, 0, NULL, NULL);
- printf("enqueud buffers\n");
-
- /*
- * Call clblas extended function. Perform gemm for the lower right
- * sub-matrices
- */
- err = clblasDgemm(order, transA, transB, M, N, K,
- alpha, bufA, 0, lda,
- bufB, 0, ldb, beta,
- bufC, 0, ldc,
- 1, &queue, 0, NULL, &event);
- if (err != CL_SUCCESS) {
- printf("clblasSgemmEx() failed with %d\n", err);
- ret = 1;
- } else {
- printf("no errors for calculation\n");
- fflush(stdout);
- /* Wait for calculations to be finished. */
- err = clWaitForEvents(1, &event);
-
- /* Fetch results of calculations from GPU memory. */
- err = clEnqueueReadBuffer(queue, bufC, CL_TRUE, 0,
- M * N * sizeof(double),
- C, 0, NULL, NULL);
- printf("got result\n");
- }
-
- /* Release OpenCL memory objects. */
- clReleaseMemObject(bufC);
- clReleaseMemObject(bufB);
- clReleaseMemObject(bufA);
- printf("released\n");
-
- /* Finalize work with clblas. */
- clblasTeardown();
- printf("teardown clblas\n");
-
- /* Release OpenCL working objects. */
- clReleaseCommandQueue(queue);
- printf("release command queue\n");
- clReleaseContext(ctx);
- printf("release context\n");
-}
\ No newline at end of file
diff --git a/perf/src/main/c/common.c b/perf/src/main/c/common.c
deleted file mode 100644
index ed1fb71..0000000
--- a/perf/src/main/c/common.c
+++ /dev/null
@@ -1,54 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include <cblas.h>
-
-
-#include <time.h>
-#include <sys/time.h>
-
-// http://stackoverflow.com/questions/5167269
-#ifdef __MACH__
-#include <mach/clock.h>
-#include <mach/mach.h>
-#endif
-
-
-// http://stackoverflow.com/questions/7034930
-double drand() {
- return (rand()+1.0)/(RAND_MAX+1.0);
-}
-
-double random_normal() {
- return sqrt(-2*log(drand())) * cos(2*M_PI*drand());
-}
-
-double* random_array(int size) {
- double *a = malloc(sizeof(double) * size);
- int i;
-
- for (i = 0 ; i < size; i++) {
- a[i] = random_normal();
- }
-
- return a;
-}
-
-long currentTimeNanos() {
-struct timespec ts;
-
-#ifdef __MACH__
-clock_serv_t cclock;
-mach_timespec_t mts;
-host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
-clock_get_time(cclock, &mts);
-mach_port_deallocate(mach_task_self(), cclock);
-ts.tv_sec = mts.tv_sec;
-ts.tv_nsec = mts.tv_nsec;
-
-#else
-clock_gettime(CLOCK_REALTIME, &ts);
-#endif
-
-return (ts.tv_sec * 1000000000) + ts.tv_nsec;
-}
diff --git a/perf/src/main/c/common.h b/perf/src/main/c/common.h
deleted file mode 100644
index 53b9e85..0000000
--- a/perf/src/main/c/common.h
+++ /dev/null
@@ -1,3 +0,0 @@
-long currentTimeNanos();
-
-double* random_array(int size);
\ No newline at end of file
diff --git a/perf/src/main/c/cudaddottest.c b/perf/src/main/c/cudaddottest.c
deleted file mode 100644
index 206da64..0000000
--- a/perf/src/main/c/cudaddottest.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/*
-
-
-gcc-mp-4.8 -O3 cudaddottest.c common.c -o cudaddottest -I../../../../netlib/CBLAS -I/usr/local/cuda/include/ -L/usr/local/cuda/lib -lcublas
-export DYLD_LIBRARY_PATH=/usr/local/cuda/lib
-./cudaddottest > ../../../results/mac_os_x-x86_64-ddot-cuda_nooh.csv
-
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include <cblas.h>
-#include "common.h"
-#include <cublas.h>
-
-void checkStatus(char* message, cublasStatus status) {
- if (status != CUBLAS_STATUS_SUCCESS) {
- fprintf (stderr, "!!!! %s fail %d\n", message, status);
- exit(EXIT_FAILURE);
- }
-}
-
-long benchmark(int size) {
- long requestStart, requestEnd;
- int incx = 1, incy = 1, n = size;
- double *cuA, *cuB;
- cublasStatus status;
-
-
- double* a = random_array(size);
- double* b = random_array(size);
-
- status = cublasAlloc(n, sizeof(double),(void**)&cuA);
- checkStatus("A", status);
- status = cublasAlloc(n, sizeof(double),(void**)&cuB);
- checkStatus("B", status);
-
- status = cublasSetVector(n, sizeof(double), a, incx, cuA, incx);
- checkStatus("setA", status);
-
- status = cublasSetVector(n, sizeof(double), b, incy, cuB, incy);
- checkStatus("setB", status);
-
- requestStart = currentTimeNanos();
-
- cublasDdot(n, cuA, incx, cuB, incy);
-
- requestEnd = currentTimeNanos();
-
- status = cublasFree(cuA);
- checkStatus("freeA", status);
- status = cublasFree(cuB);
- checkStatus("freeB", status);
-
- free(a);
- free(b);
-
- return (requestEnd - requestStart);
- }
-
-main()
-{
- cublasStatus status;
-
- status = cublasInit();
- checkStatus("init", status);
-
- srand(time(NULL));
-
- double factor = 6.0 / 100.0;
- int i, j;
- for (i = 0 ; i < 10 ; i++) {
- for (j = 1 ; j <= 100 ; j++) {
- int size = (int) pow(10.0, factor * j);
- if (size < 10) continue;
- long took = benchmark(size);
- printf("\"%d\",\"%lu\"\n", size, took);
- }
- }
-}
\ No newline at end of file
diff --git a/perf/src/main/c/cudadgemmtest.c b/perf/src/main/c/cudadgemmtest.c
deleted file mode 100644
index b100e77..0000000
--- a/perf/src/main/c/cudadgemmtest.c
+++ /dev/null
@@ -1,127 +0,0 @@
-/*
-CUDA speed test without the memory overhead
-
-gcc-mp-4.8 -O3 cudadgemmtest.c common.c -o cudadgemmtest -I../../../../netlib/CBLAS -I/usr/local/cuda/include/ -L/usr/local/cuda/lib -lcublas
-export DYLD_LIBRARY_PATH=/usr/local/cuda/lib
-./cudadgemmtest > ../../../results/mac_os_x-x86_64-dgemm-cuda_nooh.csv
-
-
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include <cblas.h>
-#include "common.h"
-#include <cublas.h>
-
-
-// does AB == C ? If not, complain on stderr
-void test(int m, double* a, double *b, double *c) {
- int i, j, k, exact = 0, wrong = 0;
- double diff;
- double* d = calloc(m * m, sizeof(double));
- for (i = 0 ; i < m ; i++) {
- for (j = 0 ; j < m ; j++) {
- for (k = 0 ; k < m ; k++) {
- d[i + j * m] += a[i + k * m] * b[j * m + k];
- }
- }
- }
- for (i = 0 ; i < m ; i++) {
- for (j = 0 ; j < m ; j++) {
- diff = c[i * m + j] - d[i * m + j];
- if (diff != 0.0) {
- exact++;
- }
- if (abs(diff) > 0.000001) {
- wrong++;
- }
- }
- }
- free(d);
- if (wrong > 0) {
- fprintf(stderr, "not exact = %d, wrong = %d\n", exact, wrong);
- }
-}
-
-void checkStatus(char* message, cublasStatus status) {
- if (status != CUBLAS_STATUS_SUCCESS) {
- fprintf (stderr, "!!!! %s fail %d\n", message, status);
- exit(EXIT_FAILURE);
- }
-}
-
-long benchmark(int size) {
- int m = sqrt(size);
- long requestStart, requestEnd;
-
- double* a = random_array(m * m);
- double* b = random_array(m * m);
- double* c = calloc(m * m, sizeof(double));
-
- double *cuA, *cuB, *cuC;
- cublasStatus status;
-
- status = cublasAlloc(m * m, sizeof(double),(void**)&cuA);
- checkStatus("A", status);
- status = cublasAlloc(m * m, sizeof(double),(void**)&cuB);
- checkStatus("B", status);
- status = cublasAlloc(m * m, sizeof(double),(void**)&cuC);
- checkStatus("C", status);
-
- status = cublasSetMatrix(m, m, sizeof(double), a, m, cuA, m);
- checkStatus("setA", status);
-
- status = cublasSetMatrix(m, m, sizeof(double), b, m, cuB, m);
- checkStatus("setB", status);
-
- requestStart = currentTimeNanos();
-
- cublasDgemm('N', 'N', m, m, m, 1, cuA, m, cuB, m, 0, cuC, m);
-
- requestEnd = currentTimeNanos();
-
- status = cublasGetMatrix(m, m, sizeof(double), cuC, m, c, m);
- checkStatus("setB", status);
-
- status = cublasFree(cuA);
- checkStatus("freeA", status);
- status = cublasFree(cuB);
- checkStatus("freeB", status);
- status = cublasFree(cuC);
- checkStatus("freeC", status);
-
-#ifdef __TEST__
- test(m, a, b, c);
-#endif
-
-
- free(a);
- free(b);
- free(c);
-
- return (requestEnd - requestStart);
- }
-
-main()
-{
- cublasStatus status;
-
- srand(time(NULL));
-
- status = cublasInit();
- checkStatus("init", status);
-
- double factor = 6.0 / 100.0;
- int i, j;
- for (i = 0 ; i < 10 ; i++) {
- for (j = 1 ; j <= 100 ; j++) {
- int size = (int) pow(10.0, factor * j);
- if (size < 10) continue;
- long took = benchmark(size);
- printf("\"%d\",\"%lu\"\n", size, took);
- fflush(stdout);
- }
- }
-}
\ No newline at end of file
diff --git a/perf/src/main/c/cudawrapper.c b/perf/src/main/c/cudawrapper.c
deleted file mode 100644
index 9b9f6a2..0000000
--- a/perf/src/main/c/cudawrapper.c
+++ /dev/null
@@ -1,85 +0,0 @@
-#include <cublas.h>
-#include <cblas.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-void checkStatus(char* message, cublasStatus status) {
- if (status != CUBLAS_STATUS_SUCCESS) {
- fprintf (stderr, "!!!! %s fail %d\n", message, status);
- exit(EXIT_FAILURE);
- }
-}
-
-double cblas_ddot (const int n, const double *x, const int incx, const double *y, const int incy) {
- double result;
- double *cuA, *cuB;
- cublasStatus status;
-
- status = cublasInit();
- checkStatus("init", status);
- status = cublasAlloc(n, sizeof(double),(void**)&cuA);
- checkStatus("A", status);
- status = cublasAlloc(n, sizeof(double),(void**)&cuB);
- checkStatus("B", status);
-
- status = cublasSetVector(n, sizeof(double), x, incx, cuA, incx);
- checkStatus("setA", status);
-
- status = cublasSetVector(n, sizeof(double), y, incy, cuB, incy);
- checkStatus("setB", status);
-
- result = cublasDdot(n, cuA, incx, cuB, incy);
-
- status = cublasFree(cuA);
- checkStatus("freeA", status);
- status = cublasFree(cuB);
- checkStatus("freeB", status);
-
-// cublasShutdown();
-
- return result;
-}
-
-
-void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
- const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
- const int K, const double alpha, const double *A,
- const int lda, const double *B, const int ldb,
- const double beta, double *C, const int ldc) {
- double *cuA, *cuB, *cuC;
- cublasStatus status;
-
- status = cublasInit();
- checkStatus("init", status);
- status = cublasAlloc(M * N, sizeof(double),(void**)&cuA);
- checkStatus("A", status);
- status = cublasAlloc(N * K, sizeof(double),(void**)&cuB);
- checkStatus("B", status);
- status = cublasAlloc(M * K, sizeof(double),(void**)&cuC);
- checkStatus("C", status);
-
- status = cublasSetMatrix(M, N, sizeof(double), A, lda, cuA, lda);
- checkStatus("setA", status);
-
- status = cublasSetMatrix(M, N, sizeof(double), B, ldb, cuB, ldb);
- checkStatus("setB", status);
-
- // status = cublasSetMatrix(M, N, sizeof(double), C, ldc, cuC, ldc);
- // checkStatus("setC", status);
-
- // HACK: ignore trans
- cublasDgemm('N', 'N', M, N, K, alpha, cuA, lda, cuB, ldb, beta, cuC, ldc);
- //checkStatus("dgemm", status);
-
- status = cublasGetMatrix(M, N, sizeof(double), cuC, ldc, C, ldc);
- checkStatus("setB", status);
-
- status = cublasFree(cuA);
- checkStatus("freeA", status);
- status = cublasFree(cuB);
- checkStatus("freeB", status);
- status = cublasFree(cuC);
- checkStatus("freeC", status);
-
-// cublasShutdown();
-}
\ No newline at end of file
diff --git a/perf/src/main/c/ddottest.c b/perf/src/main/c/ddottest.c
deleted file mode 100644
index b30efc3..0000000
--- a/perf/src/main/c/ddottest.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
-
-cp ../../../../native_ref/<target binary> libnetlib.so
-
-gcc-mp-4.8 -O3 ddottest.c common.c -o ddottest -L. -lnetlib -I../../../../netlib/CBLAS
-./ddottest > ../../../results/mac_os_x-x86_64-ddot-CBLAS.csv
-
-gcc-mp-4.8 -O3 ddottest.c common.c -o ddottest -I/System/Library/Frameworks/vecLib.framework/Headers -framework veclib
-./ddottest > ../../../results/mac_os_x-x86_64-ddot-veclib.csv
-
-gcc-mp-4.8 -O3 ddottest.c common.c -o ddottest -I/opt/local/include /opt/local/lib/libatlas.a /opt/local/lib/libcblas.a /opt/local/lib/liblapack.a /opt/local/lib/libf77blas.a -lgfortran
-./ddottest > ../../../results/mac_os_x-x86_64-ddot-atlas.csv
-
-gcc-mp-4.8 -O3 ddottest.c common.c -o ddottest -I../../../../netlib/CBLAS -L/opt/intel/composerxe/mkl/lib -lmkl_rt
-export DYLD_LIBRARY_PATH=/opt/intel/composerxe/mkl/lib:/opt/intel/composerxe/lib/
-./ddottest > ../../../results/mac_os_x-x86_64-ddot-mkl.csv
-
-gcc-mp-4.8 -O3 ddottest.c cudawrapper.c common.c -o ddottest -I../../../../netlib/CBLAS -I/usr/local/cuda/include/ -L/usr/local/cuda/lib -lcublas
-export DYLD_LIBRARY_PATH=/usr/local/cuda/lib
-./ddottest > ../../../results/mac_os_x-x86_64-ddot-cuda.csv
-
-
-
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include <cblas.h>
-#include "common.h"
-
-long benchmark(int size) {
- long requestStart, requestEnd;
-
- double* a = random_array(size);
- double* b = random_array(size);
-
- requestStart = currentTimeNanos();
-
- cblas_ddot(size, a, 1, b, 1);
-
- requestEnd = currentTimeNanos();
-
- free(a);
- free(b);
-
- return (requestEnd - requestStart);
- }
-
-main()
-{
- srand(time(NULL));
-
- double factor = 6.0 / 100.0;
- int i, j;
- for (i = 0 ; i < 10 ; i++) {
- for (j = 1 ; j <= 100 ; j++) {
- int size = (int) pow(10.0, factor * j);
- if (size < 10) continue;
- long took = benchmark(size);
- printf("\"%d\",\"%lu\"\n", size, took);
- }
- }
-}
\ No newline at end of file
diff --git a/perf/src/main/c/dgemmtest.c b/perf/src/main/c/dgemmtest.c
deleted file mode 100644
index 4589c16..0000000
--- a/perf/src/main/c/dgemmtest.c
+++ /dev/null
@@ -1,103 +0,0 @@
-/*
-
-cp ../../../../native_ref/<target binary> libnetlib.so
-
-gcc-mp-4.8 -O3 dgemmtest.c common.c -o dgemmtest -L. -lnetlib -I../../../../netlib/CBLAS
-./dgemmtest > ../../../results/mac_os_x-x86_64-dgemm-CBLAS.csv
-
-gcc-mp-4.8 -O3 dgemmtest.c common.c -o dgemmtest -I/System/Library/Frameworks/vecLib.framework/Headers -framework veclib
-./dgemmtest > ../../../results/mac_os_x-x86_64-dgemm-veclib.csv
-
-gcc-mp-4.8 -O3 dgemmtest.c common.c -o dgemmtest -I/opt/local/include /opt/local/lib/libatlas.a /opt/local/lib/libcblas.a /opt/local/lib/liblapack.a /opt/local/lib/libf77blas.a -lgfortran
-./dgemmtest > ../../../results/mac_os_x-x86_64-dgemm-atlas.csv
-
-gcc-mp-4.8 -O3 dgemmtest.c common.c -o dgemmtest -I../../../../netlib/CBLAS -L/opt/intel/composerxe/mkl/lib -lmkl_rt
-export DYLD_LIBRARY_PATH=/opt/intel/composerxe/mkl/lib:/opt/intel/composerxe/lib/
-./dgemmtest > ../../../results/mac_os_x-x86_64-dgemm-mkl.csv
-
-gcc-mp-4.8 -O3 dgemmtest.c cudawrapper.c common.c -o dgemmtest -I../../../../netlib/CBLAS -I/usr/local/cuda/include/ -L/usr/local/cuda/lib -lcublas
-export DYLD_LIBRARY_PATH=/usr/local/cuda/lib
-./dgemmtest > ../../../results/mac_os_x-x86_64-dgemm-cuda.csv
-
-CLB=/Users/samuel/Documents/Projects/clBLAS/src
-gcc-mp-4.8 -O3 dgemmtest.c clwrapper.c common.c -o dgemmtest -I../../../../netlib/CBLAS -I$CLB -I$CLB/include -L. -lclBLAS -framework OpenCL
-./dgemmtest > ../../../results/mac_os_x-x86_64-dgemm-clblas.csv
-
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include <cblas.h>
-#include "common.h"
-
-// does AB == C ? If not, complain on stderr
-void test(int m, double* a, double *b, double *c) {
- int i, j, k, exact = 0, wrong = 0;
- double diff;
- double* d = calloc(m * m, sizeof(double));
- for (i = 0 ; i < m ; i++) {
- for (j = 0 ; j < m ; j++) {
- for (k = 0 ; k < m ; k++) {
- d[i + j * m] += a[i + k * m] * b[j * m + k];
- }
- }
- }
- for (i = 0 ; i < m ; i++) {
- for (j = 0 ; j < m ; j++) {
- diff = c[i * m + j] - d[i * m + j];
- if (diff != 0.0) {
- exact++;
- }
- if (abs(diff) > 0.000001) {
- wrong++;
- }
- }
- }
- free(d);
- if (wrong > 0) {
- fprintf(stderr, "not exact = %d, wrong = %d\n", exact, wrong);
- }
-}
-
-long benchmark(int size) {
- int m = sqrt(size);
- long requestStart, requestEnd;
-
- double* a = random_array(m * m);
- double* b = random_array(m * m);
- double* c = calloc(m * m, sizeof(double));
-
- requestStart = currentTimeNanos();
-
- cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, m, m, m, 1, a, m, b, m, 0, c, m);
-
- requestEnd = currentTimeNanos();
-
-#ifdef __TEST__
- test(m, a, b, c);
-#endif
-
- free(a);
- free(b);
- free(c);
-
- return (requestEnd - requestStart);
- }
-
-main()
-{
- srand(time(NULL));
-
- double factor = 6.0 / 100.0;
- int i, j;
- for (i = 0 ; i < 10 ; i++) {
- for (j = 1 ; j <= 100 ; j++) {
- int size = (int) pow(10.0, factor * j);
- if (size < 10) continue;
- long took = benchmark(size);
- printf("\"%d\",\"%lu\"\n", size, took);
- fflush(stdout);
- }
- }
-}
\ No newline at end of file
diff --git a/perf/src/main/c/dgetritest.c b/perf/src/main/c/dgetritest.c
deleted file mode 100644
index ab2f9ac..0000000
--- a/perf/src/main/c/dgetritest.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/*
-
-cp ../../../../native_ref/<target binary> libnetlib.so
-
-gcc-mp-4.8 -O3 dgetritest.c common.c -o dgetritest -L. -lnetlib -I../../../../netlib/CBLAS -I../../../../netlib/LAPACKE
-./dgetritest > ../../../results/mac_os_x-x86_64-dgetri-CBLAS.csv
-
-gcc-mp-4.8 -O3 dgetritest.c common.c -o dgetritest -I/System/Library/Frameworks/vecLib.framework/Headers -framework veclib
-./dgetritest > ../../../results/mac_os_x-x86_64-dgetri-veclib.csv
-
-gcc-mp-4.8 -O3 dgetritest.c common.c -o dgetritest -I/opt/local/include /opt/local/lib/libatlas.a /opt/local/lib/libcblas.a /opt/local/lib/liblapack.a /opt/local/lib/libf77blas.a -lgfortran
-./dgetritest > ../../../results/mac_os_x-x86_64-dgetri-atlas.csv
-
-gcc-mp-4.8 -O3 dgetritest.c common.c -o dgetritest -I../../../../netlib/CBLAS -L/opt/intel/composerxe/mkl/lib -lmkl_rt
-export DYLD_LIBRARY_PATH=/opt/intel/composerxe/mkl/lib:/opt/intel/composerxe/lib/
-./dgetritest > ../../../results/mac_os_x-x86_64-dgetri-mkl.csv
-
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include "common.h"
-
-long benchmark(int size) {
- int m = sqrt(size);
- long requestStart, requestEnd;
-
- // random matrices are full rank (and can always be inverted if square)
- // http://www.sciencedirect.com/science/article/pii/S0096300306009040
- double* a = random_array(m * m);
- int bSize = m * m;
- double* b = calloc(bSize, sizeof(double));
- int* p = calloc(m, sizeof(int));
- int info = 0;
-
- requestStart = currentTimeNanos();
-
- // calling raw fortran because OS X doesn't have LAPACKE
- dgetrf_( &m, &m, a, &m, p, &info );
- dgetri_( &m, a, &m, p, b, &bSize, &info );
-
- requestEnd = currentTimeNanos();
-
- free(a);
- free(b);
- free(p);
-
- return (requestEnd - requestStart);
- }
-
-main()
-{
- srand(time(NULL));
-
- double factor = 6.0 / 100.0;
- int i, j;
- for (i = 0 ; i < 10 ; i++) {
- for (j = 1 ; j <= 100 ; j++) {
- int size = (int) pow(10.0, factor * j);
- if (size < 10) continue;
- long took = benchmark(size);
- printf("\"%d\",\"%lu\"\n", size, took);
- }
- }
-}
\ No newline at end of file
diff --git a/perf/src/main/java/com/github/fommil/netlib/Benchmark.java b/perf/src/main/java/com/github/fommil/netlib/Benchmark.java
deleted file mode 100644
index 095c700..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Benchmark.java
+++ /dev/null
@@ -1,15 +0,0 @@
-package com.github.fommil.netlib;
-
-/**
- * @author Sam Halliday
- */
-public interface Benchmark {
-
- // returns nanoseconds spent in computations
- long benchmark();
-
- public interface Parameterised {
- // size is a parameter > 0
- long benchmark(int size);
- }
-}
diff --git a/perf/src/main/java/com/github/fommil/netlib/Benchmarks.java b/perf/src/main/java/com/github/fommil/netlib/Benchmarks.java
deleted file mode 100644
index c8ae48b..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Benchmarks.java
+++ /dev/null
@@ -1,114 +0,0 @@
-package com.github.fommil.netlib;
-
-import au.com.bytecode.opencsv.CSVWriter;
-import com.google.common.collect.Lists;
-import lombok.Cleanup;
-import lombok.extern.java.Log;
-
-import java.io.File;
-import java.io.FileWriter;
-import java.util.List;
-import java.util.Random;
-
-import static java.lang.System.getProperty;
-
-/**
- * @author Sam Halliday
- */
- at Log
-public class Benchmarks {
-
- public static void main(String[] args) throws Exception {
- int reps = Integer.valueOf(getProperty("perf.reps", "10"));
- int sets = Integer.valueOf(getProperty("perf.max", "100"));
-
- // make sure we're all loaded
- BLAS.getInstance();
- LAPACK.getInstance();
- ARPACK.getInstance();
-
- List<Benchmark> benchmarks = Lists.newArrayList();
-// benchmarks.add(new Linpack());
-
- List<Benchmark.Parameterised> pBenchmarks = Lists.newArrayList();
- pBenchmarks.add(new Ddot());
- pBenchmarks.add(new Dgemm());
- pBenchmarks.add(new Dgetri());
- pBenchmarks.add(new Dsaupd());
-
- for (Benchmark b : benchmarks) {
- File file = new File(getTarget(b) + ".csv");
- log.info("writing to " + file);
- @Cleanup CSVWriter csv = new CSVWriter(new FileWriter(file));
- for (int i = 0; i < sets; i++) {
- long result = b.benchmark();
- csv.writeNext(new String[]{Long.toString(result)});
- }
- }
-
- double factor = 6 / 100.0;
- for (Benchmark.Parameterised b : pBenchmarks) {
- File file = new File(getTarget(b) + ".csv");
- log.info("writing to " + file);
- @Cleanup CSVWriter csv = new CSVWriter(new FileWriter(file));
- for (int i = 0; i < reps; i++) {
- log.info(file + " rep " + i);
- for (int j = sets; j > 0; j--) {
- int size = (int) Math.pow(10, factor * j);
- if (size < 10) continue;
- try {
- long result = b.benchmark(size);
- csv.writeNext(new String[]{Integer.toString(size), Long.toString(result)});
- } catch (IllegalArgumentException e) {
- log.info("skipping a datum...");
- }
- }
- }
- }
- }
-
- private static String getTarget(Object o) {
- return (getProperty("os.name") + "-"
- + getProperty("os.arch") + "-"
- + getJvm()
- + o.getClass().getSimpleName() + "-"
- + BLAS.getInstance().getClass().getSimpleName()
- ).toLowerCase().replace(" ", "_");
- }
-
- private static String getJvm() {
- if (getProperty("jvm.type") == null) return "";
- return getProperty("jvm.type") + "-";
- }
-
- // return array of size n with normally distributed elements
- public static double[] randomArray(int n) {
- assert n > 0;
- Random random = new Random();
- double[] array = new double[n];
- for (int i = 0; i < n; i++) {
- array[i] = random.nextGaussian();
- }
- return array;
- }
-
- public static boolean within(double a, double b, double epsilon) {
- return ((a - b) <= epsilon);
- }
-
- public static boolean isUnit(double[] a, int m, double epsilon) {
- for (int i = 0; i < m; i++) {
- int diag = m * i + i;
- if (!Benchmarks.within(a[diag], 1, epsilon)) {
- log.info("bad value (1) != " + a[diag]);
- return false;
- }
- for (int j = 0; j < m; j++)
- if (j != i && !Benchmarks.within(a[i * m + j], 0, epsilon)) {
- log.info("bad value (0) != " + a[i * m + j]);
- return false;
- }
- }
- return true;
- }
-}
diff --git a/perf/src/main/java/com/github/fommil/netlib/Ddot.java b/perf/src/main/java/com/github/fommil/netlib/Ddot.java
deleted file mode 100644
index 79c2171..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Ddot.java
+++ /dev/null
@@ -1,27 +0,0 @@
-package com.github.fommil.netlib;
-
-import com.google.common.base.Stopwatch;
-
-import java.util.concurrent.TimeUnit;
-
-import static com.github.fommil.netlib.Benchmarks.randomArray;
-
-/**
- * @author Sam Halliday
- */
-public class Ddot implements Benchmark.Parameterised {
-
- @Override
- public long benchmark(int size) {
- Stopwatch stopwatch = new Stopwatch();
-
- double[] array1 = randomArray(size);
- double[] array2 = randomArray(size);
- stopwatch.start();
- BLAS.getInstance().ddot(size, array1, 1, array2, 1);
- stopwatch.stop();
-
- return stopwatch.elapsed(TimeUnit.NANOSECONDS);
- }
-
-}
diff --git a/perf/src/main/java/com/github/fommil/netlib/Dgemm.java b/perf/src/main/java/com/github/fommil/netlib/Dgemm.java
deleted file mode 100644
index e2c2953..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Dgemm.java
+++ /dev/null
@@ -1,26 +0,0 @@
-package com.github.fommil.netlib;
-
-import com.google.common.base.Stopwatch;
-
-import java.util.concurrent.TimeUnit;
-
-/**
- * @author Sam Halliday
- */
-public class Dgemm implements Benchmark.Parameterised {
- @Override
- public long benchmark(int size) {
- int m = (int) Math.sqrt(size);
-
- double[] a = Benchmarks.randomArray(m * m);
- double[] b = Benchmarks.randomArray(m * m);
- double[] c = new double[m * m];
-
- Stopwatch watch = new Stopwatch();
- watch.start();
- BLAS.getInstance().dgemm("N", "N", m, m, m, 1, a, m, b, m, 0, c, m);
- watch.stop();
-
- return watch.elapsed(TimeUnit.NANOSECONDS);
- }
-}
diff --git a/perf/src/main/java/com/github/fommil/netlib/Dgetri.java b/perf/src/main/java/com/github/fommil/netlib/Dgetri.java
deleted file mode 100644
index 94869b1..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Dgetri.java
+++ /dev/null
@@ -1,51 +0,0 @@
-package com.github.fommil.netlib;
-
-import com.google.common.base.Stopwatch;
-import lombok.extern.java.Log;
-import org.netlib.util.intW;
-
-import java.util.Arrays;
-import java.util.concurrent.TimeUnit;
-
-/**
- * @author Sam Halliday
- */
- at Log
-public class Dgetri implements Benchmark.Parameterised {
- @Override
- public long benchmark(int size) {
- int m = (int) Math.sqrt(size);
-
- // random matrices are full rank (and can always be inverted if square)
- // http://www.sciencedirect.com/science/article/pii/S0096300306009040
- double[] a = Benchmarks.randomArray(m * m);
- double[] aOrig = Arrays.copyOf(a, a.length);
- double[] b = new double[1];
- int[] p = new int[m];
- intW info = new intW(0);
-
- Stopwatch watch = new Stopwatch();
-
- LAPACK.getInstance().dgetri(m, a, m, p, b, -1, info);
- //log.info(m + " supposedly has optimal work of " + b[0]);
- b = new double[(int)b[0]];
-
- watch.start();
- LAPACK.getInstance().dgetrf(m, m, a, m, p, info);
- if (info.val != 0)
- throw new IllegalArgumentException();
- LAPACK.getInstance().dgetri(m, a, m, p, b, b.length, info);
- if (info.val != 0)
- throw new IllegalArgumentException();
- watch.stop();
-
- // quick check
- double[] c = new double[m * m];
- BLAS.getInstance().dgemm("N", "N", m, m, m, 1, aOrig, m, a, m, 0, c, m);
- if (!Benchmarks.isUnit(c, m, 0.000001)) {
- Dgetri.log.warning("failed to invert matrix");
- }
-
- return watch.elapsed(TimeUnit.NANOSECONDS);
- }
-}
diff --git a/perf/src/main/java/com/github/fommil/netlib/Dsaupd.java b/perf/src/main/java/com/github/fommil/netlib/Dsaupd.java
deleted file mode 100644
index b529918..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Dsaupd.java
+++ /dev/null
@@ -1,121 +0,0 @@
-package com.github.fommil.netlib;
-
-import com.google.common.base.Stopwatch;
-import lombok.extern.java.Log;
-import org.netlib.util.doubleW;
-import org.netlib.util.intW;
-
-import java.util.Arrays;
-import java.util.concurrent.TimeUnit;
-
-/**
- * Port of dssimp from the ARPACK distribution (although note that DSSIMP is incredibly memory inefficient as it
- * confuses N with NX and ends up setting all memory requirements to be needlessly quadratic).
- *
- * @author Sam Halliday
- * @see <a href="http://forge.scilab.org/index.php/p/arpack-ng/source/tree/master/EXAMPLES/SIMPLE/dssimp.f">ddsimp.f</a>
- */
- at Log
-public class Dsaupd implements Benchmark.Parameterised {
-
- private ARPACK arpack = ARPACK.getInstance();
-
- @Override
- public long benchmark(int size) {
- int n = (int) Math.sqrt(size);
-
- // calculate 10% of the eigenvalues
- int eigenvalues = Math.max(1, n / 10);
-
- double tolerance = 0.0;
- int ldv = n;
- intW nev = new intW(eigenvalues);
-
- int ncv = Math.min(2 * eigenvalues, n);
- String bmat = "I";
- String which = "LM";
- doubleW tol = new doubleW(tolerance);
- intW info = new intW(0);
- int[] iparam = new int[11];
- iparam[0] = 1;
- iparam[2] = 300;
- iparam[6] = 1;
- intW ido = new intW(0);
-
- // used for initial residual (if info != 0)
- // and eventually the output residual
- double[] resid = new double[n];
- // Lanczos basis vectors
- double[] v = new double[ldv * ncv];
- // Arnoldi reverse communication
- double[] workd = new double[3 * n];
- // private work array
- double[] workl = new double[ncv * (ncv + 8)];
- int[] ipntr = new int[11];
-
- Stopwatch watch = new Stopwatch();
- watch.start();
-
- int i = 0;
- while (true) {
- i++;
- arpack.dsaupd(ido, bmat, n, which, nev.val, tol, resid, ncv, v, ldv, iparam, ipntr, workd, workl, workl.length, info);
- if (ido.val != -1 && ido.val != 1) break;
-
- // could be refactored to handle the other types of mode
-
- watch.stop();
- av(n, workd, ipntr[0] - 1, ipntr[1] - 1);
- watch.start();
- }
-
- watch.stop();
-
- log.info(i + " iterations for " + n);
-
- if (info.val < 0) throw new IllegalStateException("info = " + info.val);
-
-// double[] d = new double[2 * ncv];
-// boolean[] select = new boolean[ncv];
-// intW ierr = new intW(0);
-// double sigma = 0.0;
-// arpack.dseupd(eigenvectors, "All", select, d, v, ldv, sigma, bmat, n, which, nev, tol.val, resid, ncv, v, ldv, iparam, ipntr, workd, workl, workl.length, ierr);
-// if (ierr.val != 0) throw new IllegalStateException("ierr = " + ierr.val);
-
- return watch.elapsed(TimeUnit.NANOSECONDS);
- }
-
- /*
- | Perform matrix vector multiplication |
- | y <--- OP*x |
-
- Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
- tridiagonal matrix
-
- | T -I |
- |-I T -I |
- OP = | -I T |
- | ... -I|
- | -I T|
- */
- private void av(int n, double[] work, int input_offset, int output_offset) {
- double[] x = Arrays.copyOfRange(work, input_offset, input_offset + n);
- double[] y = new double[n];
-
- // let T = 2, I = 1
- // matrix applied to x, results in y...
- for (int row = 0; row < n; row++) {
- for (int col = 0; col < n; col++) {
- if (col == (row - 1) || col == (row + 1)) {
- y[row] = y[row] - x[col];
- } else if (row == col) {
- y[row] = y[row] + 2 * x[col];
- }
- }
- }
-
- for (int i = 0; i < n; i++) {
- work[i + output_offset] = y[i];
- }
- }
-}
diff --git a/perf/src/main/java/com/github/fommil/netlib/Linpack.java b/perf/src/main/java/com/github/fommil/netlib/Linpack.java
deleted file mode 100644
index b0cc9d7..0000000
--- a/perf/src/main/java/com/github/fommil/netlib/Linpack.java
+++ /dev/null
@@ -1,299 +0,0 @@
-package com.github.fommil.netlib;
-
-import com.google.common.base.Stopwatch;
-import lombok.extern.java.Log;
-
-import java.util.concurrent.TimeUnit;
-
-/**
- * Routines that give a bit of a workout of BLAS.
- *
- * @author Sam Halliday (adapted to netlib-java)
- * @author David M. Doolin (bugfixes)
- * @author Jonathan Hardwick (Java optimisations)
- * @author Reed Wade (Java translation)
- * @author Jack Dongarra (bugfixes)
- * @author Bonnie Toy (C translation)
- * @see <a href="http://www.netlib.org/linpack/">LINPACK</a>
- */
- at Log
-public class Linpack implements Benchmark {
-
- private BLAS blas = BLAS.getInstance();
-
- public static void main(String[] args) {
- Linpack linpack = new Linpack();
- linpack.benchmark();
- }
-
- @Override
- public long benchmark() {
- double a[][] = new double[200][201];
- double b[] = new double[200];
- int n = 100, lda = 201;
- int ipvt[] = new int[200];
-
- double ops = (2.0 * (n * n * n)) / 3.0 + 2.0 * (n * n);
-
- matgen(a, n, b);
-
- Stopwatch watch = new Stopwatch();
- watch.start();
- dgefa(a, lda, n, ipvt);
- dgesl(a, lda, n, ipvt, b, 0);
- watch.stop();
-
- long total = watch.elapsed(TimeUnit.NANOSECONDS);
- double mflops = 1000 * ops / total;
-
- log.info("Mflops: " + mflops);
- return total;
- }
-
- final double matgen(double a[][], int n, double b[]) {
- double norma;
- int init, i, j;
-
- init = 1325;
- norma = 0.0;
-/* Next two for() statements switched. Solver wants
-matrix in column order. --dmd 3/3/97
-*/
- for (i = 0; i < n; i++) {
- for (j = 0; j < n; j++) {
- init = 3125 * init % 65536;
- a[j][i] = (init - 32768.0) / 16384.0;
- norma = (a[j][i] > norma) ? a[j][i] : norma;
- }
- }
- for (i = 0; i < n; i++) {
- b[i] = 0.0;
- }
- for (j = 0; j < n; j++) {
- for (i = 0; i < n; i++) {
- b[i] += a[j][i];
- }
- }
-
- return norma;
- }
-
-
- /*
- dgefa factors a double precision matrix by gaussian elimination.
-
- dgefa is usually called by dgeco, but it can be called
- directly with a saving in time if rcond is not needed.
- (time for dgeco) = (1 + 9/n)*(time for dgefa) .
-
- on entry
-
- a double precision[n][lda]
- the matrix to be factored.
-
- lda integer
- the leading dimension of the array a .
-
- n integer
- the order of the matrix a .
-
- on return
-
- a an upper triangular matrix and the multipliers
- which were used to obtain it.
- the factorization can be written a = l*u where
- l is a product of permutation and unit lower
- triangular matrices and u is upper triangular.
-
- ipvt integer[n]
- an integer vector of pivot indices.
-
- info integer
- = 0 normal value.
- = k if u[k][k] .eq. 0.0 . this is not an error
- condition for this subroutine, but it does
- indicate that dgesl or dgedi will divide by zero
- if called. use rcond in dgeco for a reliable
- indication of singularity.
-
- linpack. this version dated 08/14/78.
- cleve moler, university of new mexico, argonne national lab.
-
- functions
-
- blas daxpy,dscal,idamax
- */
- final int dgefa(double a[][], int lda, int n, int ipvt[]) {
- double[] col_k, col_j;
- double t;
- int j, k, kp1, l, nm1;
- int info;
-
- // gaussian elimination with partial pivoting
-
- info = 0;
- nm1 = n - 1;
- if (nm1 >= 0) {
- for (k = 0; k < nm1; k++) {
- col_k = a[k];
- kp1 = k + 1;
-
- // find l = pivot index
-
- l = blas.idamax(n - k, col_k, k, 1) + k;
- ipvt[k] = l;
-
- // zero pivot implies this column already triangularized
-
- if (col_k[l] != 0) {
-
- // interchange if necessary
-
- if (l != k) {
- t = col_k[l];
- col_k[l] = col_k[k];
- col_k[k] = t;
- }
-
- // compute multipliers
-
- t = -1.0 / col_k[k];
- blas.dscal(n - (kp1), t, col_k, kp1, 1);
-
- // row elimination with column indexing
-
- for (j = kp1; j < n; j++) {
- col_j = a[j];
- t = col_j[l];
- if (l != k) {
- col_j[l] = col_j[k];
- col_j[k] = t;
- }
- blas.daxpy(n - (kp1), t, col_k, kp1, 1,
- col_j, kp1, 1);
- }
- } else {
- info = k;
- }
- }
- }
- ipvt[n - 1] = n - 1;
- if (a[(n - 1)][(n - 1)] == 0) info = n - 1;
-
- return info;
- }
-
-
- /*
- dgesl solves the double precision system
- a * x = b or trans(a) * x = b
- using the factors computed by dgeco or dgefa.
-
- on entry
-
- a double precision[n][lda]
- the output from dgeco or dgefa.
-
- lda integer
- the leading dimension of the array a .
-
- n integer
- the order of the matrix a .
-
- ipvt integer[n]
- the pivot vector from dgeco or dgefa.
-
- b double precision[n]
- the right hand side vector.
-
- job integer
- = 0 to solve a*x = b ,
- = nonzero to solve trans(a)*x = b where
- trans(a) is the transpose.
-
- on return
-
- b the solution vector x .
-
- error condition
-
- a division by zero will occur if the input factor contains a
- zero on the diagonal. technically this indicates singularity
- but it is often caused by improper arguments or improper
- setting of lda . it will not occur if the subroutines are
- called correctly and if dgeco has set rcond .gt. 0.0
- or dgefa has set info .eq. 0 .
-
- to compute inverse(a) * c where c is a matrix
- with p columns
- dgeco(a,lda,n,ipvt,rcond,z)
- if (!rcond is too small){
- for (j=0,j<p,j++)
- dgesl(a,lda,n,ipvt,c[j][0],0);
- }
-
- linpack. this version dated 08/14/78 .
- cleve moler, university of new mexico, argonne national lab.
-
- functions
-
- blas daxpy,ddot
- */
- final void dgesl(double a[][], int lda, int n, int ipvt[], double b[], int job) {
- double t;
- int k, kb, l, nm1, kp1;
-
- nm1 = n - 1;
- if (job == 0) {
-
- // job = 0 , solve a * x = b. first solve l*y = b
-
- if (nm1 >= 1) {
- for (k = 0; k < nm1; k++) {
- l = ipvt[k];
- t = b[l];
- if (l != k) {
- b[l] = b[k];
- b[k] = t;
- }
- kp1 = k + 1;
- blas.daxpy(n - (kp1), t, a[k], kp1, 1, b, kp1, 1);
- }
- }
-
- // now solve u*x = y
-
- for (kb = 0; kb < n; kb++) {
- k = n - (kb + 1);
- b[k] /= a[k][k];
- t = -b[k];
- blas.daxpy(k, t, a[k], 0, 1, b, 0, 1);
- }
- } else {
-
- // job = nonzero, solve trans(a) * x = b. first solve trans(u)*y = b
-
- for (k = 0; k < n; k++) {
- t = blas.ddot(k, a[k], 0, 1, b, 0, 1);
- b[k] = (b[k] - t) / a[k][k];
- }
-
- // now solve trans(l)*x = y
-
- if (nm1 >= 1) {
- for (kb = 1; kb < nm1; kb++) {
- k = n - (kb + 1);
- kp1 = k + 1;
- b[k] += blas.ddot(n - (kp1), a[k], kp1, 1, b, kp1, 1);
- l = ipvt[k];
- if (l != k) {
- t = b[l];
- b[l] = b[k];
- b[k] = t;
- }
- }
- }
- }
- }
-
-}
diff --git a/perf/src/test/java/com/github/fommil/netlib/BLASTest.java b/perf/src/test/java/com/github/fommil/netlib/BLASTest.java
deleted file mode 100644
index 9d13376..0000000
--- a/perf/src/test/java/com/github/fommil/netlib/BLASTest.java
+++ /dev/null
@@ -1,40 +0,0 @@
-package com.github.fommil.netlib;
-
-import org.junit.Assert;
-import org.junit.Test;
-
-import java.util.Arrays;
-
-public class BLASTest {
- private final BLAS blas = BLAS.getInstance();
-
- @Test
- public void offsets() {
- double[] matrix = new double[]{
- 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1
- };
- blas.dscal(5, 2.0, matrix, 2, 5);
- double[] expected = new double[]{
- 1, 1, 2, 1, 1,
- 1, 1, 2, 1, 1,
- 1, 1, 2, 1, 1,
- 1, 1, 2, 1, 1,
- 1, 1, 2, 1, 1
- };
- Assert.assertArrayEquals(Arrays.toString(matrix), expected, matrix, 0.0);
- }
-
- @Test
- public void ddot() {
- double[] dx = {1.1, 2.2, 3.3, 4.4};
- double[] dy = {1.1, 2.2, 3.3, 4.4};
- int n = dx.length;
-
- double answer = blas.ddot(n, dx, 1, dy, 1);
- assert Math.abs(answer - 36.3) < 0.00001d;
- }
-}
diff --git a/perf/src/test/java/com/github/fommil/netlib/LAPACKTest.java b/perf/src/test/java/com/github/fommil/netlib/LAPACKTest.java
deleted file mode 100644
index 0ed8120..0000000
--- a/perf/src/test/java/com/github/fommil/netlib/LAPACKTest.java
+++ /dev/null
@@ -1,78 +0,0 @@
-package com.github.fommil.netlib;
-
-import com.google.common.base.Stopwatch;
-import org.junit.Assert;
-import org.junit.Test;
-
-import java.util.logging.Logger;
-
-public class LAPACKTest {
- private LAPACK jLAPACK = LAPACK.getInstance();
-
- private static Logger log = Logger.getLogger(LAPACKTest.class.getName());
-
- @Test
- public void dgesvd() {
- double [] correct = new double[] {41.319080801703045, 4.036396452114566, 2.264037407750103, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0};
- Stopwatch watch = new Stopwatch();
- watch.start();
- for (int i = 0; i < 1000; i++) {
- double[] jAns = testDgesvd1(jLAPACK);
- Assert.assertArrayEquals(correct, jAns, 0.00001);
- }
- watch.stop();
- log.info("1000 gesvd in " + watch);
- }
-
- @Test
- public void dsygv() {
- double [] correct = new double []{0.38773165525286146, 1.0842530684697642, 2.3704016288236445};
- Stopwatch watch = new Stopwatch();
- watch.start();
- for (int i = 0; i < 1000; i++) {
- double[] jAns = testDsygv1(jLAPACK);
- Assert.assertArrayEquals(correct, jAns, 0.00001);
- }
- watch.stop();
- log.info("1000 sygv in " + watch);
- }
-
- private double[] testDgesvd1(LAPACK lapack) {
- int M = 5;
- int N = 3;
- double[] m = {18.91, 14.91, -6.15, -18.15, 27.5, -1.59, -1.59, -2.25,
- -1.59, -2.25, -1.59, 1.59, 0.0, 1.59, 0.0
- };
-
- double[] s = new double[m.length];
- double[] u = new double[M * M];
- double[] vt = new double[N * N];
- double[] work =
- new double[Math.max(3 * Math.min(M, N) + Math.max(M, N),
- 5 * Math.min(M, N))];
- org.netlib.util.intW info = new org.netlib.util.intW(2);
-
- lapack.dgesvd("A", "A", M, N, m, M, s, u, M, vt, N, work, work.length,
- info);
-
- return s;
- }
-
- private double[] testDsygv1(LAPACK lapack) {
- int itype = 1;
- int n = 3;
- double[] a = {1.0, 2.0, 4.0, 0.0, 3.0, 5.0, 0.0, 0.0, 6.0};
- int lda = 3;
- double[] b = {2.5298, 0.6405, 0.2091, 0.3798, 2.7833, 0.6808, 0.4611,
- 0.5678, 2.7942
- };
- int ldb = 3;
- double[] w = new double[n];
- int lwork = 9;
- double[] work = new double[lwork];
- org.netlib.util.intW info = new org.netlib.util.intW(0);
-
- lapack.dsygv(itype, "N", "U", n, a, lda, b, ldb, w, work, lwork, info);
- return w;
- }
-}
diff --git a/pom.xml b/pom.xml
deleted file mode 100644
index d71d7c6..0000000
--- a/pom.xml
+++ /dev/null
@@ -1,269 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0"
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
- <modelVersion>4.0.0</modelVersion>
-
- <!--
- NOTE: generator is not part of the reactor and
- must be build/released separately. Also, the
- release plugin **TOTALLY SUCKS** for git modules
- (especially the setup here) so we need to do
- manual version name changes and deploys.
-
- # Deploying requires two machines (OS X and Linux)...
-
- # to RELEASE, do the version line and append
- # -Durl=https://oss.sonatype.org/service/local/staging/deploy/maven2/
- mvn versions:set -DnewVersion=1.0
- # MANUALLY update all the xbuild and all, perf modules (sigh)
- # after release, create a release tag on git and do the same again
- git tag 1.0
- git push -tags (use double dash... XML is too puny to handle it)
-
- # OS X (Mountain Lion, see build poms for macports setup)
- mvn clean
- mvn compile
- mvn deploy -Psonatype-oss-release
-
- # Linux (Debian Wheezy 64 bit, see xbuild poms for apt-get and crosstool-ng setup)
- cd native_ref/xbuilds
- mvn clean
- mvn compile
- mvn deploy -Psonatype-oss-release
-
- cd native_system/xbuilds
- mvn clean
- mvn compile
- mvn deploy -Psonatype-oss-release
-
-
- # (OS X or Linux) Oober project
- cd all
- mvn clean
- mvn deploy -Psonatype-oss-release
-
-
- # To delete unwanted files from sonatype (use sparingly)
- curl -X DELETE -u <username>:<password> https://oss.sonatype.org/content/repositories/snapshots/com/github/fommil/netlib/
- curl -X DELETE -u <username>:<password> https://oss.sonatype.org/content/repositories/snapshots/com/googlecode/netlib-java/
-
- # For release, follow this process for the same order
- -> https://oss.sonatype.org
- -> "Staging Repositories"
- -> "close"
- -> wait for confirmation -> "release"
- -->
-
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>parent</artifactId>
- <version>1.2-SNAPSHOT</version>
- <packaging>pom</packaging>
-
- <modules>
- <module>core</module>
- <module>legacy</module>
- <module>native_ref</module>
- <module>native_system</module>
- </modules>
-
- <properties>
- <project.build.sourceEncoding>UTF-8</project.build.sourceEncoding>
- </properties>
- <prerequisites>
- <maven>3.0.3</maven>
- </prerequisites>
-
- <parent>
- <groupId>org.sonatype.oss</groupId>
- <artifactId>oss-parent</artifactId>
- <version>7</version>
- </parent>
- <name>netlib for Java</name>
- <description>Mission-critical components for linear algebra systems.</description>
- <url>https://github.com/fommil/netlib-java</url>
- <licenses>
- <license>
- <!-- Being the license of the original Fortran code. -->
- <name>BSD 3 Clause</name>
- <url>http://opensource.org/licenses/BSD-3-Clause</url>
- </license>
- </licenses>
- <!-- SCM appears to not support the multi-module setup we have here -->
- <scm>
- <url>https://github.com/fommil/netlib-java</url>
- <connection>scm:git:git at github.com:fommil/netlib-java.git</connection>
- <developerConnection>scm:git:git at github.com:fommil/netlib-java.git</developerConnection>
- </scm>
- <developers>
- <developer>
- <name>Sam Halliday</name>
- <id>fommil</id>
- <email>sam.halliday at gmail.com</email>
- </developer>
- </developers>
- <issueManagement>
- <system>github</system>
- <url>https://github.com/fommil/netlib-java/issues</url>
- </issueManagement>
-
- <repositories>
- <repository>
- <id>sonatype-snapshots</id>
- <url>https://oss.sonatype.org/content/repositories/snapshots/</url>
- <releases>
- <enabled>false</enabled>
- </releases>
- <snapshots>
- <enabled>true</enabled>
- </snapshots>
- </repository>
- <repository>
- <id>sonatype-releases</id>
- <url>https://oss.sonatype.org/content/repositories/releases/</url>
- <releases>
- <enabled>true</enabled>
- </releases>
- <snapshots>
- <enabled>false</enabled>
- </snapshots>
- </repository>
- </repositories>
-
- <pluginRepositories>
- <pluginRepository>
- <id>sonatype-plugins-snapshots</id>
- <url>https://oss.sonatype.org/content/repositories/snapshots/</url>
- <releases>
- <enabled>false</enabled>
- </releases>
- <snapshots>
- <enabled>true</enabled>
- </snapshots>
- </pluginRepository>
- <!-- Only needed during releases -->
- <pluginRepository>
- <id>sonatype-releases</id>
- <url>https://oss.sonatype.org/content/repositories/releases/</url>
- <releases>
- <enabled>true</enabled>
- </releases>
- <snapshots>
- <enabled>false</enabled>
- </snapshots>
- </pluginRepository>
- </pluginRepositories>
-
- <!-- mvn versions:display-dependency-updates -->
- <dependencyManagement>
- <dependencies>
- <dependency>
- <groupId>org.projectlombok</groupId>
- <artifactId>lombok</artifactId>
- <version>1.12.2</version>
- <scope>provided</scope>
- </dependency>
- <dependency>
- <groupId>com.google.guava</groupId>
- <artifactId>guava</artifactId>
- <version>15.0</version>
- </dependency>
- <dependency>
- <groupId>com.google.code.findbugs</groupId>
- <artifactId>jsr305</artifactId>
- <version>2.0.2</version>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <classifier>javadoc</classifier>
- <scope>provided</scope>
- <version>0.1</version>
- </dependency>
- <dependency>
- <groupId>net.sourceforge.f2j</groupId>
- <artifactId>arpack_combined_all</artifactId>
- <version>0.1</version>
- </dependency>
- <dependency>
- <groupId>com.github.fommil</groupId>
- <artifactId>jniloader</artifactId>
- <version>1.1</version>
- </dependency>
- <dependency>
- <groupId>net.sf.opencsv</groupId>
- <artifactId>opencsv</artifactId>
- <version>2.3</version>
- </dependency>
- <dependency>
- <groupId>com.github.fommil</groupId>
- <artifactId>java-logging</artifactId>
- <version>1.1</version>
- </dependency>
- </dependencies>
- </dependencyManagement>
-
- <dependencies>
- <dependency>
- <groupId>junit</groupId>
- <artifactId>junit</artifactId>
- <version>4.11</version>
- <scope>test</scope>
- </dependency>
- </dependencies>
-
- <!-- mvn versions:display-plugin-updates -->
- <build>
- <pluginManagement>
- <plugins>
- <plugin>
- <groupId>com.github.fommil.netlib</groupId>
- <artifactId>generator</artifactId>
- <version>${project.version}</version>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-gpg-plugin</artifactId>
- <version>1.4</version>
- <executions>
- <execution>
- <id>sign-artifacts</id>
- <phase>verify</phase>
- <goals>
- <goal>sign</goal>
- </goals>
- </execution>
- </executions>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-compiler-plugin</artifactId>
- <version>3.1</version>
- <configuration>
- <source>1.6</source>
- <target>1.6</target>
- </configuration>
- </plugin>
- <plugin>
- <groupId>org.codehaus.mojo</groupId>
- <artifactId>native-maven-plugin</artifactId>
- <version>1.0-alpha-7</version>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-jar-plugin</artifactId>
- <version>2.4</version>
- </plugin>
- <plugin>
- <groupId>org.apache.maven.plugins</groupId>
- <artifactId>maven-surefire-plugin</artifactId>
- <version>2.16</version>
- <configuration>
- <argLine>-Xmx2g</argLine>
- </configuration>
- </plugin>
- </plugins>
- </pluginManagement>
- </build>
-
-</project>
diff --git a/src/org/netlib/arpack/ARPACK.java b/src/org/netlib/arpack/ARPACK.java
new file mode 100644
index 0000000..1062fdf
--- /dev/null
+++ b/src/org/netlib/arpack/ARPACK.java
@@ -0,0 +1,1122 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.arpack;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * ARPACK provider which will attempt to access a native implementation
+ * and falling back to use F2J if none is available.
+ *
+ * @see http://sourceforge.net/projects/f2j
+ * @see http://www.netlib.org/arpack/
+ * @author Samuel Halliday
+ */
+public abstract class ARPACK {
+
+ static private final ARPACK current;
+ static {
+ Logger logger = Logger.getLogger("org.netlib.arpack");
+ if (NativeARPACK.INSTANCE.isLoaded) {
+ current = NativeARPACK.INSTANCE;
+ logger.config("Using JNI for ARPACK");
+ } else {
+ current = JARPACK.INSTANCE;
+ logger.config("Using F2J as JNI failed for ARPACK");
+ }
+ }
+
+ public static ARPACK getInstance() {
+ return current;
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg7
+ * @param arg8
+ */
+ public void dmout(int arg1, int arg2, int arg3, double[] arg4, int arg6, int arg7, String arg8) {
+ org.netlib.arpack.Dmout.dmout(arg1, arg2, arg3, arg4, 0, arg6, arg7, arg8);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ */
+ public void dvout(int arg1, int arg2, double[] arg3, int arg5, String arg6) {
+ org.netlib.arpack.Dvout.dvout(arg1, arg2, arg3, 0, arg5, arg6);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ */
+ public int icnteq(int arg1, int[] arg2, int arg4) {
+ return org.netlib.arpack.Icnteq.icnteq(arg1, arg2, 0, arg4);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ */
+ public void icopy(int arg1, int[] arg2, int arg4, int[] arg5, int arg7) {
+ org.netlib.arpack.Icopy.icopy(arg1, arg2, 0, arg4, arg5, 0, arg7);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ */
+ public void iset(int arg1, int arg2, int[] arg3, int arg5) {
+ org.netlib.arpack.Iset.iset(arg1, arg2, arg3, 0, arg5);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ */
+ public void iswap(int arg1, int[] arg2, int arg4, int[] arg5, int arg7) {
+ org.netlib.arpack.Iswap.iswap(arg1, arg2, 0, arg4, arg5, 0, arg7);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ */
+ public void ivout(int arg1, int arg2, int[] arg3, int arg5, String arg6) {
+ org.netlib.arpack.Ivout.ivout(arg1, arg2, arg3, 0, arg5, arg6);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ */
+ public void second(floatW arg1) {
+ org.netlib.arpack.Second.second(arg1);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg7
+ * @param arg8
+ */
+ public void smout(int arg1, int arg2, int arg3, float[] arg4, int arg6, int arg7, String arg8) {
+ org.netlib.arpack.Smout.smout(arg1, arg2, arg3, arg4, 0, arg6, arg7, arg8);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ */
+ public void svout(int arg1, int arg2, float[] arg3, int arg5, String arg6) {
+ org.netlib.arpack.Svout.svout(arg1, arg2, arg3, 0, arg5, arg6);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg17
+ */
+ public void dgetv0(intW arg1, String arg2, int arg3, boolean arg4, int arg5, int arg6, double[] arg7, int arg9, double[] arg10, doubleW arg12, int[] arg13, double[] arg15, intW arg17) {
+ org.netlib.arpack.Dgetv0.dgetv0(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, 0, arg17);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ * @param arg8
+ * @param arg10
+ * @param arg12
+ * @param arg14
+ */
+ public void dlaqrb(boolean arg1, int arg2, int arg3, int arg4, double[] arg5, int arg7, double[] arg8, double[] arg10, double[] arg12, intW arg14) {
+ org.netlib.arpack.Dlaqrb.dlaqrb(arg1, arg2, arg3, arg4, arg5, 0, arg7, arg8, 0, arg10, 0, arg12, 0, arg14);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg16
+ * @param arg18
+ * @param arg20
+ */
+ public void dnaitr(intW arg1, String arg2, int arg3, int arg4, int arg5, int arg6, double[] arg7, doubleW arg9, double[] arg10, int arg12, double[] arg13, int arg15, int[] arg16, double[] arg18, intW arg20) {
+ org.netlib.arpack.Dnaitr.dnaitr(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, arg16, 0, arg18, 0, arg20);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ * @param arg11
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg18
+ * @param arg19
+ * @param arg21
+ */
+ public void dnapps(int arg1, intW arg2, int arg3, double[] arg4, double[] arg6, double[] arg8, int arg10, double[] arg11, int arg13, double[] arg14, double[] arg16, int arg18, double[] arg19, double[] arg21) {
+ org.netlib.arpack.Dnapps.dnapps(arg1, arg2, arg3, arg4, 0, arg6, 0, arg8, 0, arg10, arg11, 0, arg13, arg14, 0, arg16, 0, arg18, arg19, 0, arg21, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg8
+ * @param arg10
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ * @param arg19
+ * @param arg20
+ * @param arg22
+ * @param arg24
+ * @param arg26
+ * @param arg28
+ * @param arg29
+ * @param arg31
+ * @param arg33
+ * @param arg35
+ */
+ public void dnaup2(intW arg1, String arg2, int arg3, String arg4, intW arg5, intW arg6, double arg7, double[] arg8, int arg10, int arg11, int arg12, intW arg13, double[] arg14, int arg16, double[] arg17, int arg19, double[] arg20, double[] arg22, double[] arg24, double[] arg26, int arg28, double[] arg29, int[] arg31, double[] arg33, intW arg35) {
+ org.netlib.arpack.Dnaup2.dnaup2(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, 0, arg10, arg11, arg12, arg13, arg14, 0, arg16, arg17, 0, arg19, arg20, 0, arg22, 0, arg24, 0, arg26, 0, arg28, arg29, 0, arg31, 0, arg33, 0, arg35);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg17
+ * @param arg19
+ * @param arg21
+ * @param arg22
+ */
+ public abstract void dnaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, doubleW arg6, double[] arg7, int arg9, double[] arg10, int arg12, int[] arg13, int[] arg15, double[] arg17, double[] arg19, int arg21, intW arg22);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg9
+ */
+ public void dnconv(int arg1, double[] arg2, double[] arg4, double[] arg6, double arg8, intW arg9) {
+ org.netlib.arpack.Dnconv.dnconv(arg1, arg2, 0, arg4, 0, arg6, 0, arg8, arg9);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ * @param arg12
+ * @param arg14
+ * @param arg15
+ * @param arg17
+ */
+ public void dneigh(double arg1, intW arg2, double[] arg3, int arg5, double[] arg6, double[] arg8, double[] arg10, double[] arg12, int arg14, double[] arg15, intW arg17) {
+ org.netlib.arpack.Dneigh.dneigh(arg1, arg2, arg3, 0, arg5, arg6, 0, arg8, 0, arg10, 0, arg12, 0, arg14, arg15, 0, arg17);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ * @param arg18
+ * @param arg19
+ * @param arg20
+ * @param arg21
+ * @param arg23
+ * @param arg24
+ * @param arg26
+ * @param arg27
+ * @param arg29
+ * @param arg31
+ * @param arg33
+ * @param arg35
+ * @param arg36
+ */
+ public abstract void dneupd(boolean arg1, String arg2, boolean[] arg3, double[] arg5, double[] arg7, double[] arg9, int arg11, double arg12, double arg13, double[] arg14, String arg16, int arg17, String arg18, intW arg19, double arg20, double[] arg21, int arg23, double[] arg24, int arg26, int[] arg27, int[] arg29, double[] arg31, double[] arg33, int arg35, intW arg36);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ * @param arg11
+ * @param arg13
+ */
+ public void dngets(int arg1, String arg2, intW arg3, intW arg4, double[] arg5, double[] arg7, double[] arg9, double[] arg11, double[] arg13) {
+ org.netlib.arpack.Dngets.dngets(arg1, arg2, arg3, arg4, arg5, 0, arg7, 0, arg9, 0, arg11, 0, arg13, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg16
+ * @param arg18
+ * @param arg20
+ */
+ public void dsaitr(intW arg1, String arg2, int arg3, int arg4, int arg5, int arg6, double[] arg7, doubleW arg9, double[] arg10, int arg12, double[] arg13, int arg15, int[] arg16, double[] arg18, intW arg20) {
+ org.netlib.arpack.Dsaitr.dsaitr(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, arg16, 0, arg18, 0, arg20);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg9
+ * @param arg11
+ * @param arg12
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ */
+ public void dsapps(int arg1, int arg2, int arg3, double[] arg4, double[] arg6, int arg8, double[] arg9, int arg11, double[] arg12, double[] arg14, int arg16, double[] arg17) {
+ org.netlib.arpack.Dsapps.dsapps(arg1, arg2, arg3, arg4, 0, arg6, 0, arg8, arg9, 0, arg11, arg12, 0, arg14, 0, arg16, arg17, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg8
+ * @param arg10
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ * @param arg19
+ * @param arg20
+ * @param arg22
+ * @param arg24
+ * @param arg26
+ * @param arg27
+ * @param arg29
+ * @param arg31
+ * @param arg33
+ */
+ public void dsaup2(intW arg1, String arg2, int arg3, String arg4, intW arg5, intW arg6, double arg7, double[] arg8, int arg10, int arg11, int arg12, intW arg13, double[] arg14, int arg16, double[] arg17, int arg19, double[] arg20, double[] arg22, double[] arg24, int arg26, double[] arg27, int[] arg29, double[] arg31, intW arg33) {
+ org.netlib.arpack.Dsaup2.dsaup2(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, 0, arg10, arg11, arg12, arg13, arg14, 0, arg16, arg17, 0, arg19, arg20, 0, arg22, 0, arg24, 0, arg26, arg27, 0, arg29, 0, arg31, 0, arg33);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg17
+ * @param arg19
+ * @param arg21
+ * @param arg22
+ */
+ public abstract void dsaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, doubleW arg6, double[] arg7, int arg9, double[] arg10, int arg12, int[] arg13, int[] arg15, double[] arg17, double[] arg19, int arg21, intW arg22);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg6
+ * @param arg7
+ */
+ public void dsconv(int arg1, double[] arg2, double[] arg4, double arg6, intW arg7) {
+ org.netlib.arpack.Dsconv.dsconv(arg1, arg2, 0, arg4, 0, arg6, arg7);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ * @param arg12
+ */
+ public void dseigt(double arg1, int arg2, double[] arg3, int arg5, double[] arg6, double[] arg8, double[] arg10, intW arg12) {
+ org.netlib.arpack.Dseigt.dseigt(arg1, arg2, arg3, 0, arg5, arg6, 0, arg8, 0, arg10, 0, arg12);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ */
+ public void dsesrt(String arg1, boolean arg2, int arg3, double[] arg4, int arg6, double[] arg7, int arg9) {
+ org.netlib.arpack.Dsesrt.dsesrt(arg1, arg2, arg3, arg4, 0, arg6, arg7, 0, arg9);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg15
+ * @param arg16
+ * @param arg18
+ * @param arg19
+ * @param arg21
+ * @param arg22
+ * @param arg24
+ * @param arg26
+ * @param arg28
+ * @param arg30
+ * @param arg31
+ */
+ public abstract void dseupd(boolean arg1, String arg2, boolean[] arg3, double[] arg5, double[] arg7, int arg9, double arg10, String arg11, int arg12, String arg13, intW arg14, double arg15, double[] arg16, int arg18, double[] arg19, int arg21, int[] arg22, int[] arg24, double[] arg26, double[] arg28, int arg30, intW arg31);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ */
+ public void dsgets(int arg1, String arg2, intW arg3, intW arg4, double[] arg5, double[] arg7, double[] arg9) {
+ org.netlib.arpack.Dsgets.dsgets(arg1, arg2, arg3, arg4, arg5, 0, arg7, 0, arg9, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ */
+ public void dsortc(String arg1, boolean arg2, int arg3, double[] arg4, double[] arg6, double[] arg8) {
+ org.netlib.arpack.Dsortc.dsortc(arg1, arg2, arg3, arg4, 0, arg6, 0, arg8, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ */
+ public void dsortr(String arg1, boolean arg2, int arg3, double[] arg4, double[] arg6) {
+ org.netlib.arpack.Dsortr.dsortr(arg1, arg2, arg3, arg4, 0, arg6, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ */
+ public void dstatn() {
+ org.netlib.arpack.Dstatn.dstatn();
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ */
+ public void dstats() {
+ org.netlib.arpack.Dstats.dstats();
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ */
+ public void dstqrb(int arg1, double[] arg2, double[] arg4, double[] arg6, double[] arg8, intW arg10) {
+ org.netlib.arpack.Dstqrb.dstqrb(arg1, arg2, 0, arg4, 0, arg6, 0, arg8, 0, arg10);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg17
+ */
+ public void sgetv0(intW arg1, String arg2, int arg3, boolean arg4, int arg5, int arg6, float[] arg7, int arg9, float[] arg10, floatW arg12, int[] arg13, float[] arg15, intW arg17) {
+ org.netlib.arpack.Sgetv0.sgetv0(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, 0, arg17);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ * @param arg8
+ * @param arg10
+ * @param arg12
+ * @param arg14
+ */
+ public void slaqrb(boolean arg1, int arg2, int arg3, int arg4, float[] arg5, int arg7, float[] arg8, float[] arg10, float[] arg12, intW arg14) {
+ org.netlib.arpack.Slaqrb.slaqrb(arg1, arg2, arg3, arg4, arg5, 0, arg7, arg8, 0, arg10, 0, arg12, 0, arg14);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg16
+ * @param arg18
+ * @param arg20
+ */
+ public void snaitr(intW arg1, String arg2, int arg3, int arg4, int arg5, int arg6, float[] arg7, floatW arg9, float[] arg10, int arg12, float[] arg13, int arg15, int[] arg16, float[] arg18, intW arg20) {
+ org.netlib.arpack.Snaitr.snaitr(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, arg16, 0, arg18, 0, arg20);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ * @param arg11
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg18
+ * @param arg19
+ * @param arg21
+ */
+ public void snapps(int arg1, intW arg2, int arg3, float[] arg4, float[] arg6, float[] arg8, int arg10, float[] arg11, int arg13, float[] arg14, float[] arg16, int arg18, float[] arg19, float[] arg21) {
+ org.netlib.arpack.Snapps.snapps(arg1, arg2, arg3, arg4, 0, arg6, 0, arg8, 0, arg10, arg11, 0, arg13, arg14, 0, arg16, 0, arg18, arg19, 0, arg21, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg8
+ * @param arg10
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ * @param arg19
+ * @param arg20
+ * @param arg22
+ * @param arg24
+ * @param arg26
+ * @param arg28
+ * @param arg29
+ * @param arg31
+ * @param arg33
+ * @param arg35
+ */
+ public void snaup2(intW arg1, String arg2, int arg3, String arg4, intW arg5, intW arg6, float arg7, float[] arg8, int arg10, int arg11, int arg12, intW arg13, float[] arg14, int arg16, float[] arg17, int arg19, float[] arg20, float[] arg22, float[] arg24, float[] arg26, int arg28, float[] arg29, int[] arg31, float[] arg33, intW arg35) {
+ org.netlib.arpack.Snaup2.snaup2(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, 0, arg10, arg11, arg12, arg13, arg14, 0, arg16, arg17, 0, arg19, arg20, 0, arg22, 0, arg24, 0, arg26, 0, arg28, arg29, 0, arg31, 0, arg33, 0, arg35);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg17
+ * @param arg19
+ * @param arg21
+ * @param arg22
+ */
+ public abstract void snaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, floatW arg6, float[] arg7, int arg9, float[] arg10, int arg12, int[] arg13, int[] arg15, float[] arg17, float[] arg19, int arg21, intW arg22);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg9
+ */
+ public void snconv(int arg1, float[] arg2, float[] arg4, float[] arg6, float arg8, intW arg9) {
+ org.netlib.arpack.Snconv.snconv(arg1, arg2, 0, arg4, 0, arg6, 0, arg8, arg9);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ * @param arg12
+ * @param arg14
+ * @param arg15
+ * @param arg17
+ */
+ public void sneigh(float arg1, intW arg2, float[] arg3, int arg5, float[] arg6, float[] arg8, float[] arg10, float[] arg12, int arg14, float[] arg15, intW arg17) {
+ org.netlib.arpack.Sneigh.sneigh(arg1, arg2, arg3, 0, arg5, arg6, 0, arg8, 0, arg10, 0, arg12, 0, arg14, arg15, 0, arg17);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ * @param arg18
+ * @param arg19
+ * @param arg20
+ * @param arg21
+ * @param arg23
+ * @param arg24
+ * @param arg26
+ * @param arg27
+ * @param arg29
+ * @param arg31
+ * @param arg33
+ * @param arg35
+ * @param arg36
+ */
+ public abstract void sneupd(boolean arg1, String arg2, boolean[] arg3, float[] arg5, float[] arg7, float[] arg9, int arg11, float arg12, float arg13, float[] arg14, String arg16, int arg17, String arg18, intW arg19, float arg20, float[] arg21, int arg23, float[] arg24, int arg26, int[] arg27, int[] arg29, float[] arg31, float[] arg33, int arg35, intW arg36);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ * @param arg11
+ * @param arg13
+ */
+ public void sngets(int arg1, String arg2, intW arg3, intW arg4, float[] arg5, float[] arg7, float[] arg9, float[] arg11, float[] arg13) {
+ org.netlib.arpack.Sngets.sngets(arg1, arg2, arg3, arg4, arg5, 0, arg7, 0, arg9, 0, arg11, 0, arg13, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg16
+ * @param arg18
+ * @param arg20
+ */
+ public void ssaitr(intW arg1, String arg2, int arg3, int arg4, int arg5, int arg6, float[] arg7, floatW arg9, float[] arg10, int arg12, float[] arg13, int arg15, int[] arg16, float[] arg18, intW arg20) {
+ org.netlib.arpack.Ssaitr.ssaitr(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, arg16, 0, arg18, 0, arg20);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg9
+ * @param arg11
+ * @param arg12
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ */
+ public void ssapps(int arg1, int arg2, int arg3, float[] arg4, float[] arg6, int arg8, float[] arg9, int arg11, float[] arg12, float[] arg14, int arg16, float[] arg17) {
+ org.netlib.arpack.Ssapps.ssapps(arg1, arg2, arg3, arg4, 0, arg6, 0, arg8, arg9, 0, arg11, arg12, 0, arg14, 0, arg16, arg17, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg8
+ * @param arg10
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg16
+ * @param arg17
+ * @param arg19
+ * @param arg20
+ * @param arg22
+ * @param arg24
+ * @param arg26
+ * @param arg27
+ * @param arg29
+ * @param arg31
+ * @param arg33
+ */
+ public void ssaup2(intW arg1, String arg2, int arg3, String arg4, intW arg5, intW arg6, float arg7, float[] arg8, int arg10, int arg11, int arg12, intW arg13, float[] arg14, int arg16, float[] arg17, int arg19, float[] arg20, float[] arg22, float[] arg24, int arg26, float[] arg27, int[] arg29, float[] arg31, intW arg33) {
+ org.netlib.arpack.Ssaup2.ssaup2(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, 0, arg10, arg11, arg12, arg13, arg14, 0, arg16, arg17, 0, arg19, arg20, 0, arg22, 0, arg24, 0, arg26, arg27, 0, arg29, 0, arg31, 0, arg33);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg12
+ * @param arg13
+ * @param arg15
+ * @param arg17
+ * @param arg19
+ * @param arg21
+ * @param arg22
+ */
+ public abstract void ssaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, floatW arg6, float[] arg7, int arg9, float[] arg10, int arg12, int[] arg13, int[] arg15, float[] arg17, float[] arg19, int arg21, intW arg22);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg6
+ * @param arg7
+ */
+ public void ssconv(int arg1, float[] arg2, float[] arg4, float arg6, intW arg7) {
+ org.netlib.arpack.Ssconv.ssconv(arg1, arg2, 0, arg4, 0, arg6, arg7);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ * @param arg12
+ */
+ public void sseigt(float arg1, int arg2, float[] arg3, int arg5, float[] arg6, float[] arg8, float[] arg10, intW arg12) {
+ org.netlib.arpack.Sseigt.sseigt(arg1, arg2, arg3, 0, arg5, arg6, 0, arg8, 0, arg10, 0, arg12);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg7
+ * @param arg9
+ */
+ public void ssesrt(String arg1, boolean arg2, int arg3, float[] arg4, int arg6, float[] arg7, int arg9) {
+ org.netlib.arpack.Ssesrt.ssesrt(arg1, arg2, arg3, arg4, 0, arg6, arg7, 0, arg9);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ * @param arg10
+ * @param arg11
+ * @param arg12
+ * @param arg13
+ * @param arg14
+ * @param arg15
+ * @param arg16
+ * @param arg18
+ * @param arg19
+ * @param arg21
+ * @param arg22
+ * @param arg24
+ * @param arg26
+ * @param arg28
+ * @param arg30
+ * @param arg31
+ */
+ public abstract void sseupd(boolean arg1, String arg2, boolean[] arg3, float[] arg5, float[] arg7, int arg9, float arg10, String arg11, int arg12, String arg13, intW arg14, float arg15, float[] arg16, int arg18, float[] arg19, int arg21, int[] arg22, int[] arg24, float[] arg26, float[] arg28, int arg30, intW arg31);
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg5
+ * @param arg7
+ * @param arg9
+ */
+ public void ssgets(int arg1, String arg2, intW arg3, intW arg4, float[] arg5, float[] arg7, float[] arg9) {
+ org.netlib.arpack.Ssgets.ssgets(arg1, arg2, arg3, arg4, arg5, 0, arg7, 0, arg9, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ */
+ public void ssortc(String arg1, boolean arg2, int arg3, float[] arg4, float[] arg6, float[] arg8) {
+ org.netlib.arpack.Ssortc.ssortc(arg1, arg2, arg3, arg4, 0, arg6, 0, arg8, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg3
+ * @param arg4
+ * @param arg6
+ */
+ public void ssortr(String arg1, boolean arg2, int arg3, float[] arg4, float[] arg6) {
+ org.netlib.arpack.Ssortr.ssortr(arg1, arg2, arg3, arg4, 0, arg6, 0);
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ */
+ public void sstatn() {
+ org.netlib.arpack.Sstatn.sstatn();
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ */
+ public void sstats() {
+ org.netlib.arpack.Sstats.sstats();
+ }
+
+ /**
+ * No documentation was available when generating this method.
+ *
+ * @param arg1
+ * @param arg2
+ * @param arg4
+ * @param arg6
+ * @param arg8
+ * @param arg10
+ */
+ public void sstqrb(int arg1, float[] arg2, float[] arg4, float[] arg6, float[] arg8, intW arg10) {
+ org.netlib.arpack.Sstqrb.sstqrb(arg1, arg2, 0, arg4, 0, arg6, 0, arg8, 0, arg10);
+ }
+
+}
diff --git a/src/org/netlib/arpack/JARPACK.java b/src/org/netlib/arpack/JARPACK.java
new file mode 100644
index 0000000..930559e
--- /dev/null
+++ b/src/org/netlib/arpack/JARPACK.java
@@ -0,0 +1,100 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.arpack;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * ARPACK provider implementation which uses F2J.
+ *
+ * @see http://sourceforge.net/projects/f2j
+ * @author Samuel Halliday
+ */
+final class JARPACK extends ARPACK {
+
+ static final ARPACK INSTANCE = new JARPACK();
+
+ private JARPACK() {
+ }
+
+ @Override
+ public void dnaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, doubleW arg6, double[] arg7, int arg9, double[] arg10, int arg12, int[] arg13, int[] arg15, double[] arg17, double[] arg19, int arg21, intW arg22) {
+ org.netlib.arpack.Dnaupd.dnaupd(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, 0, arg17, 0, arg19, 0, arg21, arg22);
+ }
+
+ @Override
+ public void dneupd(boolean arg1, String arg2, boolean[] arg3, double[] arg5, double[] arg7, double[] arg9, int arg11, double arg12, double arg13, double[] arg14, String arg16, int arg17, String arg18, intW arg19, double arg20, double[] arg21, int arg23, double[] arg24, int arg26, int[] arg27, int[] arg29, double[] arg31, double[] arg33, int arg35, intW arg36) {
+ org.netlib.arpack.Dneupd.dneupd(arg1, arg2, arg3, 0, arg5, 0, arg7, 0, arg9, 0, arg11, arg12, arg13, arg14, 0, arg16, arg17, arg18, arg19, arg20, arg21, 0, arg23, arg24, 0, arg26, arg27, 0, arg29, 0, arg31, 0, arg33, 0, arg35, arg36);
+ }
+
+ @Override
+ public void dsaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, doubleW arg6, double[] arg7, int arg9, double[] arg10, int arg12, int[] arg13, int[] arg15, double[] arg17, double[] arg19, int arg21, intW arg22) {
+ org.netlib.arpack.Dsaupd.dsaupd(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, 0, arg17, 0, arg19, 0, arg21, arg22);
+ }
+
+ @Override
+ public void dseupd(boolean arg1, String arg2, boolean[] arg3, double[] arg5, double[] arg7, int arg9, double arg10, String arg11, int arg12, String arg13, intW arg14, double arg15, double[] arg16, int arg18, double[] arg19, int arg21, int[] arg22, int[] arg24, double[] arg26, double[] arg28, int arg30, intW arg31) {
+ org.netlib.arpack.Dseupd.dseupd(arg1, arg2, arg3, 0, arg5, 0, arg7, 0, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, 0, arg18, arg19, 0, arg21, arg22, 0, arg24, 0, arg26, 0, arg28, 0, arg30, arg31);
+ }
+
+ @Override
+ public void snaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, floatW arg6, float[] arg7, int arg9, float[] arg10, int arg12, int[] arg13, int[] arg15, float[] arg17, float[] arg19, int arg21, intW arg22) {
+ org.netlib.arpack.Snaupd.snaupd(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, 0, arg17, 0, arg19, 0, arg21, arg22);
+ }
+
+ @Override
+ public void sneupd(boolean arg1, String arg2, boolean[] arg3, float[] arg5, float[] arg7, float[] arg9, int arg11, float arg12, float arg13, float[] arg14, String arg16, int arg17, String arg18, intW arg19, float arg20, float[] arg21, int arg23, float[] arg24, int arg26, int[] arg27, int[] arg29, float[] arg31, float[] arg33, int arg35, intW arg36) {
+ org.netlib.arpack.Sneupd.sneupd(arg1, arg2, arg3, 0, arg5, 0, arg7, 0, arg9, 0, arg11, arg12, arg13, arg14, 0, arg16, arg17, arg18, arg19, arg20, arg21, 0, arg23, arg24, 0, arg26, arg27, 0, arg29, 0, arg31, 0, arg33, 0, arg35, arg36);
+ }
+
+ @Override
+ public void ssaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, floatW arg6, float[] arg7, int arg9, float[] arg10, int arg12, int[] arg13, int[] arg15, float[] arg17, float[] arg19, int arg21, intW arg22) {
+ org.netlib.arpack.Ssaupd.ssaupd(arg1, arg2, arg3, arg4, arg5, arg6, arg7, 0, arg9, arg10, 0, arg12, arg13, 0, arg15, 0, arg17, 0, arg19, 0, arg21, arg22);
+ }
+
+ @Override
+ public void sseupd(boolean arg1, String arg2, boolean[] arg3, float[] arg5, float[] arg7, int arg9, float arg10, String arg11, int arg12, String arg13, intW arg14, float arg15, float[] arg16, int arg18, float[] arg19, int arg21, int[] arg22, int[] arg24, float[] arg26, float[] arg28, int arg30, intW arg31) {
+ org.netlib.arpack.Sseupd.sseupd(arg1, arg2, arg3, 0, arg5, 0, arg7, 0, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, 0, arg18, arg19, 0, arg21, arg22, 0, arg24, 0, arg26, 0, arg28, 0, arg30, arg31);
+ }
+
+}
diff --git a/src/org/netlib/arpack/NativeARPACK.java b/src/org/netlib/arpack/NativeARPACK.java
new file mode 100644
index 0000000..5354132
--- /dev/null
+++ b/src/org/netlib/arpack/NativeARPACK.java
@@ -0,0 +1,99 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.arpack;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+import org.netlib.utils.JNIMethods;
+
+/**
+ * ARPACK provider implementation which uses the Java Native Interface to access
+ * system netlib libraries.
+ *
+ * @see http://www.netlib.org/
+ * @author Samuel Halliday
+ */
+final class NativeARPACK extends ARPACK {
+
+ // singleton
+ protected static final NativeARPACK INSTANCE = new NativeARPACK();
+
+ // indicates if the JNI loaded OK. If this is false, calls to the native
+ // methods will fail with UnsatisfiedLinkError
+ protected final boolean isLoaded;
+
+ private NativeARPACK() {
+ String libname = JNIMethods.getPortableLibraryName("jniarpack");
+ try {
+ System.loadLibrary(libname);
+ } catch (UnsatisfiedLinkError e) {
+ isLoaded = false;
+ return;
+ }
+ isLoaded = true;
+ }
+
+ @Override
+ public native void dnaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, doubleW arg6, double[] arg7, int arg9, double[] arg10, int arg12, int[] arg13, int[] arg15, double[] arg17, double[] arg19, int arg21, intW arg22);
+
+ @Override
+ public native void dneupd(boolean arg1, String arg2, boolean[] arg3, double[] arg5, double[] arg7, double[] arg9, int arg11, double arg12, double arg13, double[] arg14, String arg16, int arg17, String arg18, intW arg19, double arg20, double[] arg21, int arg23, double[] arg24, int arg26, int[] arg27, int[] arg29, double[] arg31, double[] arg33, int arg35, intW arg36);
+
+ @Override
+ public native void dsaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, doubleW arg6, double[] arg7, int arg9, double[] arg10, int arg12, int[] arg13, int[] arg15, double[] arg17, double[] arg19, int arg21, intW arg22);
+
+ @Override
+ public native void dseupd(boolean arg1, String arg2, boolean[] arg3, double[] arg5, double[] arg7, int arg9, double arg10, String arg11, int arg12, String arg13, intW arg14, double arg15, double[] arg16, int arg18, double[] arg19, int arg21, int[] arg22, int[] arg24, double[] arg26, double[] arg28, int arg30, intW arg31);
+
+ @Override
+ public native void snaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, floatW arg6, float[] arg7, int arg9, float[] arg10, int arg12, int[] arg13, int[] arg15, float[] arg17, float[] arg19, int arg21, intW arg22);
+
+ @Override
+ public native void sneupd(boolean arg1, String arg2, boolean[] arg3, float[] arg5, float[] arg7, float[] arg9, int arg11, float arg12, float arg13, float[] arg14, String arg16, int arg17, String arg18, intW arg19, float arg20, float[] arg21, int arg23, float[] arg24, int arg26, int[] arg27, int[] arg29, float[] arg31, float[] arg33, int arg35, intW arg36);
+
+ @Override
+ public native void ssaupd(intW arg1, String arg2, int arg3, String arg4, int arg5, floatW arg6, float[] arg7, int arg9, float[] arg10, int arg12, int[] arg13, int[] arg15, float[] arg17, float[] arg19, int arg21, intW arg22);
+
+ @Override
+ public native void sseupd(boolean arg1, String arg2, boolean[] arg3, float[] arg5, float[] arg7, int arg9, float arg10, String arg11, int arg12, String arg13, intW arg14, float arg15, float[] arg16, int arg18, float[] arg19, int arg21, int[] arg22, int[] arg24, float[] arg26, float[] arg28, int arg30, intW arg31);
+
+}
diff --git a/src/org/netlib/blas/BLAS.java b/src/org/netlib/blas/BLAS.java
new file mode 100644
index 0000000..1d90bd3
--- /dev/null
+++ b/src/org/netlib/blas/BLAS.java
@@ -0,0 +1,6352 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.blas;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * BLAS provider which will attempt to access a native implementation
+ * and falling back to use F2J if none is available.
+ *
+ * @see http://sourceforge.net/projects/f2j
+ * @see http://www.netlib.org/blas/
+ * @author Samuel Halliday
+ */
+public abstract class BLAS {
+
+ static private final BLAS current;
+ static {
+ Logger logger = Logger.getLogger("org.netlib.blas");
+ if (NativeBLAS.INSTANCE.isLoaded) {
+ current = NativeBLAS.INSTANCE;
+ logger.config("Using JNI for BLAS");
+ } else {
+ current = JBLAS.INSTANCE;
+ logger.config("Using F2J as JNI failed for BLAS");
+ }
+ }
+
+ public static BLAS getInstance() {
+ return current;
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ takes the sum of the absolute values.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ */
+ public abstract double dasum(int n, double[] dx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ constant times a vector plus a vector.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param da
+ * @param dx
+ * @param incx
+ * @param dy
+ * @param incy
+ */
+ public abstract void daxpy(int n, double da, double[] dx, int incx, double[] dy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ copies a vector, x, to a vector, y.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ * @param dy
+ * @param incy
+ */
+ public abstract void dcopy(int n, double[] dx, int incx, double[] dy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ forms the dot product of two vectors.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ * @param dy
+ * @param incy
+ */
+ public abstract double ddot(int n, double[] dx, int incx, double[] dy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ KL - INTEGER.
+ On entry, KL specifies the number of sub-diagonals of the
+ matrix A. KL must satisfy 0 .le. KL.
+ Unchanged on exit.
+
+ KU - INTEGER.
+ On entry, KU specifies the number of super-diagonals of the
+
+ matrix A. KU must satisfy 0 .le. KU.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading ( kl + ku + 1 ) by n part of the
+ array A must contain the matrix of coefficients, supplied
+ column by column, with the leading diagonal of the matrix in
+ row ( ku + 1 ) of the array, the first super-diagonal
+ starting at position 2 in row ku, the first sub-diagonal
+ starting at position 1 in row ( ku + 2 ), and so on.
+ Elements in the array A that do not correspond to elements
+ in the band matrix (such as the top left ku by ku triangle)
+
+ are not referenced.
+ The following program segment will transfer a band matrix
+ from conventional full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ K = KU + 1 - J
+ DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+ A( K + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( kl + ku + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void dgbmv(String trans, int m, int n, int kl, int ku, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEMM performs one of the matrix-matrix operations
+
+ C := alpha*op( A )*op( B ) + beta*C,
+
+ where op( X ) is one of
+
+ op( X ) = X or op( X ) = X',
+
+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n', op( A ) = A.
+
+ TRANSA = 'T' or 't', op( A ) = A'.
+
+ TRANSA = 'C' or 'c', op( A ) = A'.
+
+ Unchanged on exit.
+
+ TRANSB - CHARACTER*1.
+ On entry, TRANSB specifies the form of op( B ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSB = 'N' or 'n', op( B ) = B.
+
+ TRANSB = 'T' or 't', op( B ) = B'.
+
+ TRANSB = 'C' or 'c', op( B ) = B'.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix
+ op( A ) and of the matrix C. M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix
+ op( B ) and the number of columns of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of columns of the matrix
+ op( A ) and the number of rows of the matrix op( B ). K must
+ be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANSA = 'N' or 'n', and is m otherwise.
+ Before entry with TRANSA = 'N' or 'n', the leading m by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by m part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, k ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+ n when TRANSB = 'N' or 'n', and is k otherwise.
+ Before entry with TRANSB = 'N' or 'n', the leading k by n
+ part of the array B must contain the matrix B, otherwise
+ the leading n by k part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
+ LDB must be at least max( 1, k ), otherwise LDB must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n matrix
+ ( alpha*op( A )*op( B ) + beta*C ).
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param transa
+ * @param transb
+ * @param m
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void dgemm(String transa, String transb, int m, int n, int k, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void dgemv(String trans, int m, int n, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+
+ vector and A is an m by n matrix.
+
+ Arguments
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param a
+ * @param lda
+ */
+ public abstract void dger(int m, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DNRM2 returns the euclidean norm of a vector via the function
+ name, so that
+
+ DNRM2 := sqrt( x'*x )
+
+
+ -- This version written on 25-October-1982.
+ Modified on 14-October-1993 to inline the call to DLASSQ.
+ Sven Hammarling, Nag Ltd.
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ */
+ public abstract double dnrm2(int n, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ applies a plane rotation.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ * @param dy
+ * @param incy
+ * @param c
+ * @param s
+ */
+ public abstract void drot(int n, double[] dx, int incx, double[] dy, int incy, double c, double s);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ construct givens plane rotation.
+ jack dongarra, linpack, 3/11/78.
+
+
+ .. Local Scalars ..
+</pre>
+ * @param da
+ * @param db
+ * @param c
+ * @param s
+ */
+ public abstract void drotg(doubleW da, doubleW db, doubleW c, doubleW s);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+
+
+ (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
+ (DY**T)
+
+ DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+ LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
+ WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
+
+ (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
+ H=( ) ( ) ( ) ( )
+ (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
+ SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ number of elements in input vector(s)
+
+ DX (input/output) DOUBLE PRECISION array, dimension N
+ double precision vector with 5 elements
+
+ INCX (input) INTEGER
+ storage spacing between elements of DX
+
+ DY (input/output) DOUBLE PRECISION array, dimension N
+ double precision vector with N elements
+
+ INCY (input) INTEGER
+ storage spacing between elements of DY
+
+ DPARAM (input/output) DOUBLE PRECISION array, dimension 5
+ DPARAM(1)=DFLAG
+ DPARAM(2)=DH11
+ DPARAM(3)=DH21
+ DPARAM(4)=DH12
+ DPARAM(5)=DH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ * @param dy
+ * @param incy
+ * @param dparam
+ */
+ public abstract void drotm(int n, double[] dx, int incx, double[] dy, int incy, double[] dparam);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+
+ THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*
+
+ DY2)**T.
+ WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
+
+ (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
+ H=( ) ( ) ( ) ( )
+ (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
+ LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
+ RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
+ VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
+
+ THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+ INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+ OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+
+
+ Arguments
+ =========
+
+ DD1 (input/output) DOUBLE PRECISION
+
+ DD2 (input/output) DOUBLE PRECISION
+
+ DX1 (input/output) DOUBLE PRECISION
+
+ DY1 (input) DOUBLE PRECISION
+
+ DPARAM (input/output) DOUBLE PRECISION array, dimension 5
+ DPARAM(1)=DFLAG
+ DPARAM(2)=DH11
+ DPARAM(3)=DH21
+ DPARAM(4)=DH12
+ DPARAM(5)=DH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param dd1
+ * @param dd2
+ * @param dx1
+ * @param dy1
+ * @param dparam
+ */
+ public abstract void drotmg(doubleW dd1, doubleW dd2, doubleW dx1, double dy1, double[] dparam);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric band matrix, with k super-diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the band matrix A is being supplied as
+ follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ being supplied.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ being supplied.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of super-diagonals of the
+ matrix A. K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer the upper
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer the lower
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void dsbmv(String uplo, int n, int k, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+*
+ scales a vector by a constant.
+ uses unrolled loops for increment equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param da
+ * @param dx
+ * @param incx
+ */
+ public abstract void dscal(int n, double da, double[] dx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param ap
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void dspmv(String uplo, int n, double alpha, double[] ap, double[] x, int incx, double beta, double[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param ap
+ */
+ public abstract void dspr(String uplo, int n, double alpha, double[] x, int incx, double[] ap);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param ap
+ */
+ public abstract void dspr2(String uplo, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] ap);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ interchanges two vectors.
+ uses unrolled loops for increments equal one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ * @param dy
+ * @param incy
+ */
+ public abstract void dswap(int n, double[] dx, int incx, double[] dy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYMM performs one of the matrix-matrix operations
+
+ C := alpha*A*B + beta*C,
+
+ or
+
+ C := alpha*B*A + beta*C,
+
+ where alpha and beta are scalars, A is a symmetric matrix and B and
+ C are m by n matrices.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether the symmetric matrix A
+ appears on the left or right in the operation as follows:
+
+ SIDE = 'L' or 'l' C := alpha*A*B + beta*C,
+
+ SIDE = 'R' or 'r' C := alpha*B*A + beta*C,
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the symmetric matrix A is to be
+ referenced as follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of the
+ symmetric matrix is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of the
+ symmetric matrix is to be referenced.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix C.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix C.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ m when SIDE = 'L' or 'l' and is n otherwise.
+ Before entry with SIDE = 'L' or 'l', the m by m part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading m by m upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading m by m lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Before entry with SIDE = 'R' or 'r', the n by n part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading n by n upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading n by n lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n updated
+ matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void dsymm(String side, String uplo, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void dsymv(String uplo, int n, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param a
+ * @param lda
+ */
+ public abstract void dsyr(String uplo, int n, double alpha, double[] x, int incx, double[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an n
+
+ by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param a
+ * @param lda
+ */
+ public abstract void dsyr2(String uplo, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYR2K performs one of the symmetric rank 2k operations
+
+ C := alpha*A*B' + alpha*B*A' + beta*C,
+
+ or
+
+ C := alpha*A'*B + alpha*B'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A and B are n by k matrices in the first case and k by n
+ matrices in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +
+ beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrices A and B, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrices A and B. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array B must contain the matrix B, otherwise
+ the leading k by n part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDB must be at least max( 1, n ), otherwise LDB must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void dsyr2k(String uplo, String trans, int n, int k, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYRK performs one of the symmetric rank k operations
+
+ C := alpha*A*A' + beta*C,
+
+ or
+
+ C := alpha*A'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A is an n by k matrix in the first case and a k by n matrix
+ in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrix A, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrix A. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void dsyrk(String uplo, String trans, int n, int k, double alpha, double[] a, int lda, double beta, double[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void dtbmv(String uplo, String trans, String diag, int n, int k, double[] a, int lda, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular band matrix, with ( k + 1 )
+ diagonals.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void dtbsv(String uplo, String trans, String diag, int n, int k, double[] a, int lda, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param ap
+ * @param x
+ * @param incx
+ */
+ public abstract void dtpmv(String uplo, String trans, String diag, int n, double[] ap, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix, supplied in packed form.
+
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - DOUBLE PRECISION array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param ap
+ * @param x
+ * @param incx
+ */
+ public abstract void dtpsv(String uplo, String trans, String diag, int n, double[] ap, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRMM performs one of the matrix-matrix operations
+
+ B := alpha*op( A )*B, or B := alpha*B*op( A ),
+
+ where alpha is a scalar, B is an m by n matrix, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) multiplies B from
+ the left or right as follows:
+
+ SIDE = 'L' or 'l' B := alpha*op( A )*B.
+
+ SIDE = 'R' or 'r' B := alpha*B*op( A ).
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B, and on exit is overwritten by the
+ transformed matrix.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param transa
+ * @param diag
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ */
+ public abstract void dtrmm(String side, String uplo, String transa, String diag, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void dtrmv(String uplo, String trans, String diag, int n, double[] a, int lda, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSM solves one of the matrix equations
+
+ op( A )*X = alpha*B, or X*op( A ) = alpha*B,
+
+ where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ The matrix X is overwritten on B.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) appears on the left
+ or right of X as follows:
+
+ SIDE = 'L' or 'l' op( A )*X = alpha*B.
+
+ SIDE = 'R' or 'r' X*op( A ) = alpha*B.
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the right-hand side matrix B, and on exit is
+ overwritten by the solution matrix X.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param transa
+ * @param diag
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ */
+ public abstract void dtrsm(String side, String uplo, String transa, String diag, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void dtrsv(String uplo, String trans, String diag, int n, double[] a, int lda, double[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ finds the index of element having max. absolute value.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param dx
+ * @param incx
+ */
+ public abstract int idamax(int n, double[] dx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ finds the index of element having max. absolute value.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ */
+ public abstract int isamax(int n, float[] sx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
+ case.
+
+ Arguments
+ =========
+
+ CA (input) CHARACTER*1
+
+ CB (input) CHARACTER*1
+ CA and CB specify the single characters to be compared.
+
+ =====================================================================
+
+
+ .. Intrinsic Functions ..
+</pre>
+ * @param ca
+ * @param cb
+ */
+ public boolean lsame(String ca, String cb) {
+ return org.netlib.blas.Lsame.lsame(ca, cb);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ takes the sum of the absolute values.
+ uses unrolled loops for increment equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ */
+ public abstract float sasum(int n, float[] sx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SAXPY constant times a vector plus a vector.
+ uses unrolled loop for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sa
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ */
+ public abstract void saxpy(int n, float sa, float[] sx, int incx, float[] sy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ copies a vector, x, to a vector, y.
+ uses unrolled loops for increments equal to 1.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ */
+ public abstract void scopy(int n, float[] sx, int incx, float[] sy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ forms the dot product of two vectors.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ */
+ public abstract float sdot(int n, float[] sx, int incx, float[] sy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ PURPOSE
+ =======
+
+ Compute the inner product of two vectors with extended
+ precision accumulation.
+
+ Returns S.P. result with dot product accumulated in D.P.
+ SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
+ where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+ defined in a similar way using INCY.
+
+ AUTHOR
+ ======
+ Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
+ Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
+
+ ARGUMENTS
+ =========
+
+ N (input) INTEGER
+ number of elements in input vector(s)
+
+ SB (input) REAL
+ single precision scalar to be added to inner product
+
+ SX (input) REAL array, dimension (N)
+ single precision vector with N elements
+
+ INCX (input) INTEGER
+ storage spacing between elements of SX
+
+ SY (input) REAL array, dimension (N)
+ single precision vector with N elements
+
+ INCY (input) INTEGER
+ storage spacing between elements of SY
+
+ SDSDOT (output) REAL
+ single precision dot product (SB if N .LE. 0)
+
+ REFERENCES
+ ==========
+
+ C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+ Krogh, Basic linear algebra subprograms for Fortran
+ usage, Algorithm No. 539, Transactions on Mathematical
+ Software 5, 3 (September 1979), pp. 308-323.
+
+ REVISION HISTORY (YYMMDD)
+ ==========================
+
+ 791001 DATE WRITTEN
+ 890531 Changed all specific intrinsics to generic. (WRB)
+ 890831 Modified array declarations. (WRB)
+ 890831 REVISION DATE from Version 3.2
+ 891214 Prologue converted to Version 4.0 format. (BAB)
+ 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+ 920501 Reformatted the REFERENCES section. (WRB)
+ 070118 Reformat to LAPACK coding style
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sb
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ */
+ public abstract float sdsdot(int n, float sb, float[] sx, int incx, float[] sy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ KL - INTEGER.
+ On entry, KL specifies the number of sub-diagonals of the
+ matrix A. KL must satisfy 0 .le. KL.
+ Unchanged on exit.
+
+ KU - INTEGER.
+ On entry, KU specifies the number of super-diagonals of the
+
+ matrix A. KU must satisfy 0 .le. KU.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry, the leading ( kl + ku + 1 ) by n part of the
+ array A must contain the matrix of coefficients, supplied
+ column by column, with the leading diagonal of the matrix in
+ row ( ku + 1 ) of the array, the first super-diagonal
+ starting at position 2 in row ku, the first sub-diagonal
+ starting at position 1 in row ( ku + 2 ), and so on.
+ Elements in the array A that do not correspond to elements
+ in the band matrix (such as the top left ku by ku triangle)
+
+ are not referenced.
+ The following program segment will transfer a band matrix
+ from conventional full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ K = KU + 1 - J
+ DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+ A( K + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( kl + ku + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void sgbmv(String trans, int m, int n, int kl, int ku, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEMM performs one of the matrix-matrix operations
+
+ C := alpha*op( A )*op( B ) + beta*C,
+
+ where op( X ) is one of
+
+ op( X ) = X or op( X ) = X',
+
+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n', op( A ) = A.
+
+ TRANSA = 'T' or 't', op( A ) = A'.
+
+ TRANSA = 'C' or 'c', op( A ) = A'.
+
+ Unchanged on exit.
+
+ TRANSB - CHARACTER*1.
+ On entry, TRANSB specifies the form of op( B ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSB = 'N' or 'n', op( B ) = B.
+
+ TRANSB = 'T' or 't', op( B ) = B'.
+
+ TRANSB = 'C' or 'c', op( B ) = B'.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix
+ op( A ) and of the matrix C. M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix
+ op( B ) and the number of columns of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of columns of the matrix
+ op( A ) and the number of rows of the matrix op( B ). K must
+ be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANSA = 'N' or 'n', and is m otherwise.
+ Before entry with TRANSA = 'N' or 'n', the leading m by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by m part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, k ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, kb ), where kb is
+ n when TRANSB = 'N' or 'n', and is k otherwise.
+ Before entry with TRANSB = 'N' or 'n', the leading k by n
+ part of the array B must contain the matrix B, otherwise
+ the leading n by k part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
+ LDB must be at least max( 1, k ), otherwise LDB must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n matrix
+ ( alpha*op( A )*op( B ) + beta*C ).
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param transa
+ * @param transb
+ * @param m
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void sgemm(String transa, String transb, int m, int n, int k, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Arguments
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void sgemv(String trans, int m, int n, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+
+ vector and A is an m by n matrix.
+
+ Arguments
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param a
+ * @param lda
+ */
+ public abstract void sger(int m, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SNRM2 returns the euclidean norm of a vector via the function
+ name, so that
+
+ SNRM2 := sqrt( x'*x ).
+
+ Further Details
+ ===============
+
+ -- This version written on 25-October-1982.
+ Modified on 14-October-1993 to inline the call to SLASSQ.
+ Sven Hammarling, Nag Ltd.
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ */
+ public abstract float snrm2(int n, float[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ applies a plane rotation.
+
+ Further Details
+ ===============
+
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ * @param c
+ * @param s
+ */
+ public abstract void srot(int n, float[] sx, int incx, float[] sy, int incy, float c, float s);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ construct givens plane rotation.
+ jack dongarra, linpack, 3/11/78.
+
+
+ .. Local Scalars ..
+</pre>
+ * @param sa
+ * @param sb
+ * @param c
+ * @param s
+ */
+ public abstract void srotg(floatW sa, floatW sb, floatW c, floatW s);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+
+
+ (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
+ (DX**T)
+
+ SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+ LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
+ WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
+
+ (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
+ H=( ) ( ) ( ) ( )
+ (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
+ SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ number of elements in input vector(s)
+
+ SX (input/output) REAL array, dimension N
+ double precision vector with 5 elements
+
+ INCX (input) INTEGER
+ storage spacing between elements of SX
+
+ SY (input/output) REAL array, dimension N
+ double precision vector with N elements
+
+ INCY (input) INTEGER
+ storage spacing between elements of SY
+
+ SPARAM (input/output) REAL array, dimension 5
+ SPARAM(1)=SFLAG
+ SPARAM(2)=SH11
+ SPARAM(3)=SH21
+ SPARAM(4)=SH12
+ SPARAM(5)=SH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ * @param sparam
+ */
+ public abstract void srotm(int n, float[] sx, int incx, float[] sy, int incy, float[] sparam);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+
+ THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)*
+ SY2)**T.
+ WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+
+ SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
+
+ (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
+ H=( ) ( ) ( ) ( )
+ (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
+ LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22
+ RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE
+ VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.)
+
+ THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+ INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+ OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+
+
+ Arguments
+ =========
+
+
+ SD1 (input/output) REAL
+
+ SD2 (input/output) REAL
+
+ SX1 (input/output) REAL
+
+ SY1 (input) REAL
+
+
+ SPARAM (input/output) REAL array, dimension 5
+ SPARAM(1)=SFLAG
+ SPARAM(2)=SH11
+ SPARAM(3)=SH21
+ SPARAM(4)=SH12
+ SPARAM(5)=SH22
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param sd1
+ * @param sd2
+ * @param sx1
+ * @param sy1
+ * @param sparam
+ */
+ public abstract void srotmg(floatW sd1, floatW sd2, floatW sx1, float sy1, float[] sparam);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric band matrix, with k super-diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the band matrix A is being supplied as
+ follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ being supplied.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ being supplied.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of super-diagonals of the
+ matrix A. K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer the upper
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the symmetric matrix, supplied column by
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer the lower
+ triangular part of a symmetric band matrix from conventional
+ full matrix storage to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ Y - REAL array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the
+ vector y. On exit, Y is overwritten by the updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void ssbmv(String uplo, int n, int k, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ scales a vector by a constant.
+ uses unrolled loops for increment equal to 1.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sa
+ * @param sx
+ * @param incx
+ */
+ public abstract void sscal(int n, float sa, float[] sx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param ap
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void sspmv(String uplo, int n, float alpha, float[] ap, float[] x, int incx, float beta, float[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param ap
+ */
+ public abstract void sspr(String uplo, int n, float alpha, float[] x, int incx, float[] ap);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an
+ n by n symmetric matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the matrix A is supplied in the packed
+ array AP as follows:
+
+ UPLO = 'U' or 'u' The upper triangular part of A is
+ supplied in AP.
+
+ UPLO = 'L' or 'l' The lower triangular part of A is
+ supplied in AP.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+ and a( 2, 2 ) respectively, and so on. On exit, the array
+ AP is overwritten by the upper triangular part of the
+ updated matrix.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular part of the symmetric matrix
+ packed sequentially, column by column, so that AP( 1 )
+ contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+ and a( 3, 1 ) respectively, and so on. On exit, the array
+ AP is overwritten by the lower triangular part of the
+ updated matrix.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param ap
+ */
+ public abstract void sspr2(String uplo, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] ap);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ interchanges two vectors.
+ uses unrolled loops for increments equal to 1.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sx
+ * @param incx
+ * @param sy
+ * @param incy
+ */
+ public abstract void sswap(int n, float[] sx, int incx, float[] sy, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYMM performs one of the matrix-matrix operations
+
+ C := alpha*A*B + beta*C,
+
+ or
+
+ C := alpha*B*A + beta*C,
+
+ where alpha and beta are scalars, A is a symmetric matrix and B and
+ C are m by n matrices.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether the symmetric matrix A
+ appears on the left or right in the operation as follows:
+
+ SIDE = 'L' or 'l' C := alpha*A*B + beta*C,
+
+ SIDE = 'R' or 'r' C := alpha*B*A + beta*C,
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the symmetric matrix A is to be
+ referenced as follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of the
+ symmetric matrix is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of the
+ symmetric matrix is to be referenced.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix C.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix C.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ m when SIDE = 'L' or 'l' and is n otherwise.
+ Before entry with SIDE = 'L' or 'l', the m by m part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading m by m upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading m by m lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Before entry with SIDE = 'R' or 'r', the n by n part of
+ the array A must contain the symmetric matrix, such that
+ when UPLO = 'U' or 'u', the leading n by n upper triangular
+ part of the array A must contain the upper triangular part
+ of the symmetric matrix and the strictly lower triangular
+ part of A is not referenced, and when UPLO = 'L' or 'l',
+ the leading n by n lower triangular part of the array A
+ must contain the lower triangular part of the symmetric
+ matrix and the strictly upper triangular part of A is not
+ referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry, the leading m 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 array C is overwritten by the m by n updated
+ matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void ssymm(String side, String uplo, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ * @param beta
+ * @param y
+ * @param incy
+ */
+ public abstract void ssymv(String uplo, int n, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYR performs the symmetric rank 1 operation
+
+ A := alpha*x*x' + A,
+
+ where alpha is a real scalar, x is an n element vector and A is an
+ n by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param a
+ * @param lda
+ */
+ public abstract void ssyr(String uplo, int n, float alpha, float[] x, int incx, float[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an n
+
+ by n symmetric matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param a
+ * @param lda
+ */
+ public abstract void ssyr2(String uplo, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYR2K performs one of the symmetric rank 2k operations
+
+ C := alpha*A*B' + alpha*B*A' + beta*C,
+
+ or
+
+ C := alpha*A'*B + alpha*B'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A and B are n by k matrices in the first case and k by n
+ matrices in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +
+ beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrices A and B, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrices A and B. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, kb ), where kb is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array B must contain the matrix B, otherwise
+ the leading k by n part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDB must be at least max( 1, n ), otherwise LDB must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void ssyr2k(String uplo, String trans, int n, int k, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYRK performs one of the symmetric rank k operations
+
+ C := alpha*A*A' + beta*C,
+
+ or
+
+ C := alpha*A'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A is an n by k matrix in the first case and a k by n matrix
+ in the second case.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrix A, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrix A. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - REAL .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - REAL array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+
+ upper triangular part of the array C must contain the upper
+
+ triangular part of the symmetric matrix and the strictly
+
+ lower triangular part of C is not referenced. On exit, the
+
+ upper triangular part of the array C is overwritten by the
+
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+
+ lower triangular part of the array C must contain the lower
+
+ triangular part of the symmetric matrix and the strictly
+
+ upper triangular part of C is not referenced. On exit, the
+
+ lower triangular part of the array C is overwritten by the
+
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param n
+ * @param k
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param beta
+ * @param c
+ * @param Ldc
+ */
+ public abstract void ssyrk(String uplo, String trans, int n, int k, float alpha, float[] a, int lda, float beta, float[] c, int Ldc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void stbmv(String uplo, String trans, String diag, int n, int k, float[] a, int lda, float[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular band matrix, with ( k + 1 )
+ diagonals.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with UPLO = 'U' or 'u', K specifies the number of
+ super-diagonals of the matrix A.
+ On entry with UPLO = 'L' or 'l', K specifies the number of
+ sub-diagonals of the matrix A.
+ K must satisfy 0 .le. K.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+ by n part of the array A must contain the upper triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row
+ ( k + 1 ) of the array, the first super-diagonal starting at
+ position 2 in row k, and so on. The top left k by k triangle
+ of the array A is not referenced.
+ The following program segment will transfer an upper
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = K + 1 - J
+ DO 10, I = MAX( 1, J - K ), J
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+ by n part of the array A must contain the lower triangular
+ band part of the matrix of coefficients, supplied column by
+
+ column, with the leading diagonal of the matrix in row 1 of
+
+ the array, the first sub-diagonal starting at position 1 in
+
+ row 2, and so on. The bottom right k by k triangle of the
+ array A is not referenced.
+ The following program segment will transfer a lower
+ triangular band matrix from conventional full matrix storage
+ to band storage:
+
+ DO 20, J = 1, N
+ M = 1 - J
+ DO 10, I = J, MIN( N, J + K )
+ A( M + I, J ) = matrix( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+
+ Note that when DIAG = 'U' or 'u' the elements of the array A
+ corresponding to the diagonal elements of the matrix are not
+ referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ ( k + 1 ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void stbsv(String uplo, String trans, String diag, int n, int k, float[] a, int lda, float[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix, supplied in packed form.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param ap
+ * @param x
+ * @param incx
+ */
+ public abstract void stpmv(String uplo, String trans, String diag, int n, float[] ap, float[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix, supplied in packed form.
+
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ AP - REAL array of DIMENSION at least
+ ( ( n*( n + 1 ) )/2 ).
+ Before entry with UPLO = 'U' or 'u', the array AP must
+ contain the upper triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+ respectively, and so on.
+ Before entry with UPLO = 'L' or 'l', the array AP must
+ contain the lower triangular matrix packed sequentially,
+ column by column, so that AP( 1 ) contains a( 1, 1 ),
+ AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+ respectively, and so on.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced, but are assumed to be unity.
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param ap
+ * @param x
+ * @param incx
+ */
+ public abstract void stpsv(String uplo, String trans, String diag, int n, float[] ap, float[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRMM performs one of the matrix-matrix operations
+
+ B := alpha*op( A )*B, or B := alpha*B*op( A ),
+
+ where alpha is a scalar, B is an m by n matrix, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) multiplies B from
+ the left or right as follows:
+
+ SIDE = 'L' or 'l' B := alpha*op( A )*B.
+
+ SIDE = 'R' or 'r' B := alpha*B*op( A ).
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B, and on exit is overwritten by the
+ transformed matrix.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param transa
+ * @param diag
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ */
+ public abstract void strmm(String side, String uplo, String transa, String diag, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void strmv(String uplo, String trans, String diag, int n, float[] a, int lda, float[] x, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSM solves one of the matrix equations
+
+ op( A )*X = alpha*B, or X*op( A ) = alpha*B,
+
+ where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ The matrix X is overwritten on B.
+
+ Arguments
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) appears on the left
+ or right of X as follows:
+
+ SIDE = 'L' or 'l' op( A )*X = alpha*B.
+
+ SIDE = 'R' or 'r' X*op( A ) = alpha*B.
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - REAL .
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - REAL array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the right-hand side matrix B, and on exit is
+ overwritten by the solution matrix X.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ .. External Functions ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param transa
+ * @param diag
+ * @param m
+ * @param n
+ * @param alpha
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ */
+ public abstract void strsm(String side, String uplo, String transa, String diag, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Arguments
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' A'*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - REAL array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+
+ triangular matrix and the strictly lower triangular part of
+
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+
+ triangular matrix and the strictly upper triangular part of
+
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - REAL array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param x
+ * @param incx
+ */
+ public abstract void strsv(String uplo, String trans, String diag, int n, float[] a, int lda, float[] x, int incx);
+
+}
diff --git a/src/org/netlib/blas/JBLAS.java b/src/org/netlib/blas/JBLAS.java
new file mode 100644
index 0000000..37911bb
--- /dev/null
+++ b/src/org/netlib/blas/JBLAS.java
@@ -0,0 +1,405 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.blas;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * BLAS provider implementation which uses F2J.
+ *
+ * @see http://sourceforge.net/projects/f2j
+ * @author Samuel Halliday
+ */
+final class JBLAS extends BLAS {
+
+ static final BLAS INSTANCE = new JBLAS();
+
+ private JBLAS() {
+ }
+
+ @Override
+ public double dasum(int n, double[] dx, int incx) {
+ return org.netlib.blas.Dasum.dasum(n, dx, 0, incx);
+ }
+
+ @Override
+ public void daxpy(int n, double da, double[] dx, int incx, double[] dy, int incy) {
+ org.netlib.blas.Daxpy.daxpy(n, da, dx, 0, incx, dy, 0, incy);
+ }
+
+ @Override
+ public void dcopy(int n, double[] dx, int incx, double[] dy, int incy) {
+ org.netlib.blas.Dcopy.dcopy(n, dx, 0, incx, dy, 0, incy);
+ }
+
+ @Override
+ public double ddot(int n, double[] dx, int incx, double[] dy, int incy) {
+ return org.netlib.blas.Ddot.ddot(n, dx, 0, incx, dy, 0, incy);
+ }
+
+ @Override
+ public void dgbmv(String trans, int m, int n, int kl, int ku, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy) {
+ org.netlib.blas.Dgbmv.dgbmv(trans, m, n, kl, ku, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void dgemm(String transa, String transb, int m, int n, int k, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc) {
+ org.netlib.blas.Dgemm.dgemm(transa, transb, m, n, k, alpha, a, 0, lda, b, 0, ldb, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void dgemv(String trans, int m, int n, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy) {
+ org.netlib.blas.Dgemv.dgemv(trans, m, n, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void dger(int m, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] a, int lda) {
+ org.netlib.blas.Dger.dger(m, n, alpha, x, 0, incx, y, 0, incy, a, 0, lda);
+ }
+
+ @Override
+ public double dnrm2(int n, double[] x, int incx) {
+ return org.netlib.blas.Dnrm2.dnrm2(n, x, 0, incx);
+ }
+
+ @Override
+ public void drot(int n, double[] dx, int incx, double[] dy, int incy, double c, double s) {
+ org.netlib.blas.Drot.drot(n, dx, 0, incx, dy, 0, incy, c, s);
+ }
+
+ @Override
+ public void drotg(doubleW da, doubleW db, doubleW c, doubleW s) {
+ org.netlib.blas.Drotg.drotg(da, db, c, s);
+ }
+
+ @Override
+ public void drotm(int n, double[] dx, int incx, double[] dy, int incy, double[] dparam) {
+ org.netlib.blas.Drotm.drotm(n, dx, 0, incx, dy, 0, incy, dparam, 0);
+ }
+
+ @Override
+ public void drotmg(doubleW dd1, doubleW dd2, doubleW dx1, double dy1, double[] dparam) {
+ org.netlib.blas.Drotmg.drotmg(dd1, dd2, dx1, dy1, dparam, 0);
+ }
+
+ @Override
+ public void dsbmv(String uplo, int n, int k, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy) {
+ org.netlib.blas.Dsbmv.dsbmv(uplo, n, k, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void dscal(int n, double da, double[] dx, int incx) {
+ org.netlib.blas.Dscal.dscal(n, da, dx, 0, incx);
+ }
+
+ @Override
+ public void dspmv(String uplo, int n, double alpha, double[] ap, double[] x, int incx, double beta, double[] y, int incy) {
+ org.netlib.blas.Dspmv.dspmv(uplo, n, alpha, ap, 0, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void dspr(String uplo, int n, double alpha, double[] x, int incx, double[] ap) {
+ org.netlib.blas.Dspr.dspr(uplo, n, alpha, x, 0, incx, ap, 0);
+ }
+
+ @Override
+ public void dspr2(String uplo, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] ap) {
+ org.netlib.blas.Dspr2.dspr2(uplo, n, alpha, x, 0, incx, y, 0, incy, ap, 0);
+ }
+
+ @Override
+ public void dswap(int n, double[] dx, int incx, double[] dy, int incy) {
+ org.netlib.blas.Dswap.dswap(n, dx, 0, incx, dy, 0, incy);
+ }
+
+ @Override
+ public void dsymm(String side, String uplo, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc) {
+ org.netlib.blas.Dsymm.dsymm(side, uplo, m, n, alpha, a, 0, lda, b, 0, ldb, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void dsymv(String uplo, int n, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy) {
+ org.netlib.blas.Dsymv.dsymv(uplo, n, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void dsyr(String uplo, int n, double alpha, double[] x, int incx, double[] a, int lda) {
+ org.netlib.blas.Dsyr.dsyr(uplo, n, alpha, x, 0, incx, a, 0, lda);
+ }
+
+ @Override
+ public void dsyr2(String uplo, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] a, int lda) {
+ org.netlib.blas.Dsyr2.dsyr2(uplo, n, alpha, x, 0, incx, y, 0, incy, a, 0, lda);
+ }
+
+ @Override
+ public void dsyr2k(String uplo, String trans, int n, int k, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc) {
+ org.netlib.blas.Dsyr2k.dsyr2k(uplo, trans, n, k, alpha, a, 0, lda, b, 0, ldb, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void dsyrk(String uplo, String trans, int n, int k, double alpha, double[] a, int lda, double beta, double[] c, int Ldc) {
+ org.netlib.blas.Dsyrk.dsyrk(uplo, trans, n, k, alpha, a, 0, lda, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void dtbmv(String uplo, String trans, String diag, int n, int k, double[] a, int lda, double[] x, int incx) {
+ org.netlib.blas.Dtbmv.dtbmv(uplo, trans, diag, n, k, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public void dtbsv(String uplo, String trans, String diag, int n, int k, double[] a, int lda, double[] x, int incx) {
+ org.netlib.blas.Dtbsv.dtbsv(uplo, trans, diag, n, k, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public void dtpmv(String uplo, String trans, String diag, int n, double[] ap, double[] x, int incx) {
+ org.netlib.blas.Dtpmv.dtpmv(uplo, trans, diag, n, ap, 0, x, 0, incx);
+ }
+
+ @Override
+ public void dtpsv(String uplo, String trans, String diag, int n, double[] ap, double[] x, int incx) {
+ org.netlib.blas.Dtpsv.dtpsv(uplo, trans, diag, n, ap, 0, x, 0, incx);
+ }
+
+ @Override
+ public void dtrmm(String side, String uplo, String transa, String diag, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb) {
+ org.netlib.blas.Dtrmm.dtrmm(side, uplo, transa, diag, m, n, alpha, a, 0, lda, b, 0, ldb);
+ }
+
+ @Override
+ public void dtrmv(String uplo, String trans, String diag, int n, double[] a, int lda, double[] x, int incx) {
+ org.netlib.blas.Dtrmv.dtrmv(uplo, trans, diag, n, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public void dtrsm(String side, String uplo, String transa, String diag, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb) {
+ org.netlib.blas.Dtrsm.dtrsm(side, uplo, transa, diag, m, n, alpha, a, 0, lda, b, 0, ldb);
+ }
+
+ @Override
+ public void dtrsv(String uplo, String trans, String diag, int n, double[] a, int lda, double[] x, int incx) {
+ org.netlib.blas.Dtrsv.dtrsv(uplo, trans, diag, n, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public int idamax(int n, double[] dx, int incx) {
+ return org.netlib.blas.Idamax.idamax(n, dx, 0, incx);
+ }
+
+ @Override
+ public int isamax(int n, float[] sx, int incx) {
+ return org.netlib.blas.Isamax.isamax(n, sx, 0, incx);
+ }
+
+ @Override
+ public float sasum(int n, float[] sx, int incx) {
+ return org.netlib.blas.Sasum.sasum(n, sx, 0, incx);
+ }
+
+ @Override
+ public void saxpy(int n, float sa, float[] sx, int incx, float[] sy, int incy) {
+ org.netlib.blas.Saxpy.saxpy(n, sa, sx, 0, incx, sy, 0, incy);
+ }
+
+ @Override
+ public void scopy(int n, float[] sx, int incx, float[] sy, int incy) {
+ org.netlib.blas.Scopy.scopy(n, sx, 0, incx, sy, 0, incy);
+ }
+
+ @Override
+ public float sdot(int n, float[] sx, int incx, float[] sy, int incy) {
+ return org.netlib.blas.Sdot.sdot(n, sx, 0, incx, sy, 0, incy);
+ }
+
+ @Override
+ public float sdsdot(int n, float sb, float[] sx, int incx, float[] sy, int incy) {
+ return org.netlib.blas.Sdsdot.sdsdot(n, sb, sx, 0, incx, sy, 0, incy);
+ }
+
+ @Override
+ public void sgbmv(String trans, int m, int n, int kl, int ku, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy) {
+ org.netlib.blas.Sgbmv.sgbmv(trans, m, n, kl, ku, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void sgemm(String transa, String transb, int m, int n, int k, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc) {
+ org.netlib.blas.Sgemm.sgemm(transa, transb, m, n, k, alpha, a, 0, lda, b, 0, ldb, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void sgemv(String trans, int m, int n, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy) {
+ org.netlib.blas.Sgemv.sgemv(trans, m, n, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void sger(int m, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] a, int lda) {
+ org.netlib.blas.Sger.sger(m, n, alpha, x, 0, incx, y, 0, incy, a, 0, lda);
+ }
+
+ @Override
+ public float snrm2(int n, float[] x, int incx) {
+ return org.netlib.blas.Snrm2.snrm2(n, x, 0, incx);
+ }
+
+ @Override
+ public void srot(int n, float[] sx, int incx, float[] sy, int incy, float c, float s) {
+ org.netlib.blas.Srot.srot(n, sx, 0, incx, sy, 0, incy, c, s);
+ }
+
+ @Override
+ public void srotg(floatW sa, floatW sb, floatW c, floatW s) {
+ org.netlib.blas.Srotg.srotg(sa, sb, c, s);
+ }
+
+ @Override
+ public void srotm(int n, float[] sx, int incx, float[] sy, int incy, float[] sparam) {
+ org.netlib.blas.Srotm.srotm(n, sx, 0, incx, sy, 0, incy, sparam, 0);
+ }
+
+ @Override
+ public void srotmg(floatW sd1, floatW sd2, floatW sx1, float sy1, float[] sparam) {
+ org.netlib.blas.Srotmg.srotmg(sd1, sd2, sx1, sy1, sparam, 0);
+ }
+
+ @Override
+ public void ssbmv(String uplo, int n, int k, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy) {
+ org.netlib.blas.Ssbmv.ssbmv(uplo, n, k, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void sscal(int n, float sa, float[] sx, int incx) {
+ org.netlib.blas.Sscal.sscal(n, sa, sx, 0, incx);
+ }
+
+ @Override
+ public void sspmv(String uplo, int n, float alpha, float[] ap, float[] x, int incx, float beta, float[] y, int incy) {
+ org.netlib.blas.Sspmv.sspmv(uplo, n, alpha, ap, 0, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void sspr(String uplo, int n, float alpha, float[] x, int incx, float[] ap) {
+ org.netlib.blas.Sspr.sspr(uplo, n, alpha, x, 0, incx, ap, 0);
+ }
+
+ @Override
+ public void sspr2(String uplo, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] ap) {
+ org.netlib.blas.Sspr2.sspr2(uplo, n, alpha, x, 0, incx, y, 0, incy, ap, 0);
+ }
+
+ @Override
+ public void sswap(int n, float[] sx, int incx, float[] sy, int incy) {
+ org.netlib.blas.Sswap.sswap(n, sx, 0, incx, sy, 0, incy);
+ }
+
+ @Override
+ public void ssymm(String side, String uplo, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc) {
+ org.netlib.blas.Ssymm.ssymm(side, uplo, m, n, alpha, a, 0, lda, b, 0, ldb, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void ssymv(String uplo, int n, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy) {
+ org.netlib.blas.Ssymv.ssymv(uplo, n, alpha, a, 0, lda, x, 0, incx, beta, y, 0, incy);
+ }
+
+ @Override
+ public void ssyr(String uplo, int n, float alpha, float[] x, int incx, float[] a, int lda) {
+ org.netlib.blas.Ssyr.ssyr(uplo, n, alpha, x, 0, incx, a, 0, lda);
+ }
+
+ @Override
+ public void ssyr2(String uplo, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] a, int lda) {
+ org.netlib.blas.Ssyr2.ssyr2(uplo, n, alpha, x, 0, incx, y, 0, incy, a, 0, lda);
+ }
+
+ @Override
+ public void ssyr2k(String uplo, String trans, int n, int k, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc) {
+ org.netlib.blas.Ssyr2k.ssyr2k(uplo, trans, n, k, alpha, a, 0, lda, b, 0, ldb, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void ssyrk(String uplo, String trans, int n, int k, float alpha, float[] a, int lda, float beta, float[] c, int Ldc) {
+ org.netlib.blas.Ssyrk.ssyrk(uplo, trans, n, k, alpha, a, 0, lda, beta, c, 0, Ldc);
+ }
+
+ @Override
+ public void stbmv(String uplo, String trans, String diag, int n, int k, float[] a, int lda, float[] x, int incx) {
+ org.netlib.blas.Stbmv.stbmv(uplo, trans, diag, n, k, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public void stbsv(String uplo, String trans, String diag, int n, int k, float[] a, int lda, float[] x, int incx) {
+ org.netlib.blas.Stbsv.stbsv(uplo, trans, diag, n, k, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public void stpmv(String uplo, String trans, String diag, int n, float[] ap, float[] x, int incx) {
+ org.netlib.blas.Stpmv.stpmv(uplo, trans, diag, n, ap, 0, x, 0, incx);
+ }
+
+ @Override
+ public void stpsv(String uplo, String trans, String diag, int n, float[] ap, float[] x, int incx) {
+ org.netlib.blas.Stpsv.stpsv(uplo, trans, diag, n, ap, 0, x, 0, incx);
+ }
+
+ @Override
+ public void strmm(String side, String uplo, String transa, String diag, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb) {
+ org.netlib.blas.Strmm.strmm(side, uplo, transa, diag, m, n, alpha, a, 0, lda, b, 0, ldb);
+ }
+
+ @Override
+ public void strmv(String uplo, String trans, String diag, int n, float[] a, int lda, float[] x, int incx) {
+ org.netlib.blas.Strmv.strmv(uplo, trans, diag, n, a, 0, lda, x, 0, incx);
+ }
+
+ @Override
+ public void strsm(String side, String uplo, String transa, String diag, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb) {
+ org.netlib.blas.Strsm.strsm(side, uplo, transa, diag, m, n, alpha, a, 0, lda, b, 0, ldb);
+ }
+
+ @Override
+ public void strsv(String uplo, String trans, String diag, int n, float[] a, int lda, float[] x, int incx) {
+ org.netlib.blas.Strsv.strsv(uplo, trans, diag, n, a, 0, lda, x, 0, incx);
+ }
+
+}
diff --git a/src/org/netlib/blas/NativeBLAS.java b/src/org/netlib/blas/NativeBLAS.java
new file mode 100644
index 0000000..78cc795
--- /dev/null
+++ b/src/org/netlib/blas/NativeBLAS.java
@@ -0,0 +1,282 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.blas;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+import org.netlib.utils.JNIMethods;
+
+/**
+ * BLAS provider implementation which uses the Java Native Interface to access
+ * system netlib libraries.
+ *
+ * @see http://www.netlib.org/
+ * @author Samuel Halliday
+ */
+final class NativeBLAS extends BLAS {
+
+ // singleton
+ protected static final NativeBLAS INSTANCE = new NativeBLAS();
+
+ // indicates if the JNI loaded OK. If this is false, calls to the native
+ // methods will fail with UnsatisfiedLinkError
+ protected final boolean isLoaded;
+
+ private NativeBLAS() {
+ String libname = JNIMethods.getPortableLibraryName("jniblas");
+ try {
+ System.loadLibrary(libname);
+ } catch (UnsatisfiedLinkError e) {
+ isLoaded = false;
+ return;
+ }
+ isLoaded = true;
+ }
+
+ @Override
+ public native double dasum(int n, double[] dx, int incx);
+
+ @Override
+ public native void daxpy(int n, double da, double[] dx, int incx, double[] dy, int incy);
+
+ @Override
+ public native void dcopy(int n, double[] dx, int incx, double[] dy, int incy);
+
+ @Override
+ public native double ddot(int n, double[] dx, int incx, double[] dy, int incy);
+
+ @Override
+ public native void dgbmv(String trans, int m, int n, int kl, int ku, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ @Override
+ public native void dgemm(String transa, String transb, int m, int n, int k, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc);
+
+ @Override
+ public native void dgemv(String trans, int m, int n, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ @Override
+ public native void dger(int m, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] a, int lda);
+
+ @Override
+ public native double dnrm2(int n, double[] x, int incx);
+
+ @Override
+ public native void drot(int n, double[] dx, int incx, double[] dy, int incy, double c, double s);
+
+ @Override
+ public native void drotg(doubleW da, doubleW db, doubleW c, doubleW s);
+
+ @Override
+ public native void drotm(int n, double[] dx, int incx, double[] dy, int incy, double[] dparam);
+
+ @Override
+ public native void drotmg(doubleW dd1, doubleW dd2, doubleW dx1, double dy1, double[] dparam);
+
+ @Override
+ public native void dsbmv(String uplo, int n, int k, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ @Override
+ public native void dscal(int n, double da, double[] dx, int incx);
+
+ @Override
+ public native void dspmv(String uplo, int n, double alpha, double[] ap, double[] x, int incx, double beta, double[] y, int incy);
+
+ @Override
+ public native void dspr(String uplo, int n, double alpha, double[] x, int incx, double[] ap);
+
+ @Override
+ public native void dspr2(String uplo, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] ap);
+
+ @Override
+ public native void dswap(int n, double[] dx, int incx, double[] dy, int incy);
+
+ @Override
+ public native void dsymm(String side, String uplo, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc);
+
+ @Override
+ public native void dsymv(String uplo, int n, double alpha, double[] a, int lda, double[] x, int incx, double beta, double[] y, int incy);
+
+ @Override
+ public native void dsyr(String uplo, int n, double alpha, double[] x, int incx, double[] a, int lda);
+
+ @Override
+ public native void dsyr2(String uplo, int n, double alpha, double[] x, int incx, double[] y, int incy, double[] a, int lda);
+
+ @Override
+ public native void dsyr2k(String uplo, String trans, int n, int k, double alpha, double[] a, int lda, double[] b, int ldb, double beta, double[] c, int Ldc);
+
+ @Override
+ public native void dsyrk(String uplo, String trans, int n, int k, double alpha, double[] a, int lda, double beta, double[] c, int Ldc);
+
+ @Override
+ public native void dtbmv(String uplo, String trans, String diag, int n, int k, double[] a, int lda, double[] x, int incx);
+
+ @Override
+ public native void dtbsv(String uplo, String trans, String diag, int n, int k, double[] a, int lda, double[] x, int incx);
+
+ @Override
+ public native void dtpmv(String uplo, String trans, String diag, int n, double[] ap, double[] x, int incx);
+
+ @Override
+ public native void dtpsv(String uplo, String trans, String diag, int n, double[] ap, double[] x, int incx);
+
+ @Override
+ public native void dtrmm(String side, String uplo, String transa, String diag, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb);
+
+ @Override
+ public native void dtrmv(String uplo, String trans, String diag, int n, double[] a, int lda, double[] x, int incx);
+
+ @Override
+ public native void dtrsm(String side, String uplo, String transa, String diag, int m, int n, double alpha, double[] a, int lda, double[] b, int ldb);
+
+ @Override
+ public native void dtrsv(String uplo, String trans, String diag, int n, double[] a, int lda, double[] x, int incx);
+
+ @Override
+ public native int idamax(int n, double[] dx, int incx);
+
+ @Override
+ public native int isamax(int n, float[] sx, int incx);
+
+ @Override
+ public native float sasum(int n, float[] sx, int incx);
+
+ @Override
+ public native void saxpy(int n, float sa, float[] sx, int incx, float[] sy, int incy);
+
+ @Override
+ public native void scopy(int n, float[] sx, int incx, float[] sy, int incy);
+
+ @Override
+ public native float sdot(int n, float[] sx, int incx, float[] sy, int incy);
+
+ @Override
+ public native float sdsdot(int n, float sb, float[] sx, int incx, float[] sy, int incy);
+
+ @Override
+ public native void sgbmv(String trans, int m, int n, int kl, int ku, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ @Override
+ public native void sgemm(String transa, String transb, int m, int n, int k, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc);
+
+ @Override
+ public native void sgemv(String trans, int m, int n, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ @Override
+ public native void sger(int m, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] a, int lda);
+
+ @Override
+ public native float snrm2(int n, float[] x, int incx);
+
+ @Override
+ public native void srot(int n, float[] sx, int incx, float[] sy, int incy, float c, float s);
+
+ @Override
+ public native void srotg(floatW sa, floatW sb, floatW c, floatW s);
+
+ @Override
+ public native void srotm(int n, float[] sx, int incx, float[] sy, int incy, float[] sparam);
+
+ @Override
+ public native void srotmg(floatW sd1, floatW sd2, floatW sx1, float sy1, float[] sparam);
+
+ @Override
+ public native void ssbmv(String uplo, int n, int k, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ @Override
+ public native void sscal(int n, float sa, float[] sx, int incx);
+
+ @Override
+ public native void sspmv(String uplo, int n, float alpha, float[] ap, float[] x, int incx, float beta, float[] y, int incy);
+
+ @Override
+ public native void sspr(String uplo, int n, float alpha, float[] x, int incx, float[] ap);
+
+ @Override
+ public native void sspr2(String uplo, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] ap);
+
+ @Override
+ public native void sswap(int n, float[] sx, int incx, float[] sy, int incy);
+
+ @Override
+ public native void ssymm(String side, String uplo, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc);
+
+ @Override
+ public native void ssymv(String uplo, int n, float alpha, float[] a, int lda, float[] x, int incx, float beta, float[] y, int incy);
+
+ @Override
+ public native void ssyr(String uplo, int n, float alpha, float[] x, int incx, float[] a, int lda);
+
+ @Override
+ public native void ssyr2(String uplo, int n, float alpha, float[] x, int incx, float[] y, int incy, float[] a, int lda);
+
+ @Override
+ public native void ssyr2k(String uplo, String trans, int n, int k, float alpha, float[] a, int lda, float[] b, int ldb, float beta, float[] c, int Ldc);
+
+ @Override
+ public native void ssyrk(String uplo, String trans, int n, int k, float alpha, float[] a, int lda, float beta, float[] c, int Ldc);
+
+ @Override
+ public native void stbmv(String uplo, String trans, String diag, int n, int k, float[] a, int lda, float[] x, int incx);
+
+ @Override
+ public native void stbsv(String uplo, String trans, String diag, int n, int k, float[] a, int lda, float[] x, int incx);
+
+ @Override
+ public native void stpmv(String uplo, String trans, String diag, int n, float[] ap, float[] x, int incx);
+
+ @Override
+ public native void stpsv(String uplo, String trans, String diag, int n, float[] ap, float[] x, int incx);
+
+ @Override
+ public native void strmm(String side, String uplo, String transa, String diag, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb);
+
+ @Override
+ public native void strmv(String uplo, String trans, String diag, int n, float[] a, int lda, float[] x, int incx);
+
+ @Override
+ public native void strsm(String side, String uplo, String transa, String diag, int m, int n, float alpha, float[] a, int lda, float[] b, int ldb);
+
+ @Override
+ public native void strsv(String uplo, String trans, String diag, int n, float[] a, int lda, float[] x, int incx);
+
+}
diff --git a/src/org/netlib/generate/JNIGenerator.java b/src/org/netlib/generate/JNIGenerator.java
new file mode 100644
index 0000000..e3b9f93
--- /dev/null
+++ b/src/org/netlib/generate/JNIGenerator.java
@@ -0,0 +1,617 @@
+/*
+ * Copyright ThinkTank Maths Limited 2006, 2007
+ *
+ * This file is free software: you can redistribute it and/or modify it under the terms of
+ * the GNU General Public License as published by the Free Software Foundation, either
+ * version 3 of the License, or (at your option) any later version.
+ *
+ * This file is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
+ * without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ * PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with this file.
+ * If not, see <http://www.gnu.org/licenses/>.
+ *
+ * For the avoidance of doubt, source code generated by this program is not considered
+ * a derivative work.
+ */
+package org.netlib.generate;
+
+import java.io.BufferedReader;
+import java.io.File;
+import java.io.FileInputStream;
+import java.io.IOException;
+import java.io.InputStreamReader;
+import java.util.ArrayList;
+import java.util.Arrays;
+import java.util.HashMap;
+import java.util.HashSet;
+import java.util.List;
+import java.util.Map;
+import java.util.Set;
+import java.util.regex.Matcher;
+import java.util.regex.Pattern;
+
+/**
+ * This is a stand alone application that takes either a javah JNI header file (or String
+ * definitions of the method) as input and creates template C code, converting as many
+ * variables into native C types as possible, such as arrays. Some object types (such as
+ * netlib primitive wrappers, intW and doubleW) are supported. There are a lot of
+ * workarounds to accommodate the inconsistent nature of the CBLAS library which is
+ * sometimes C-ish and sometimes Fortran-ish and sometimes require extra parameters and
+ * sometimes don't.
+ * <p>
+ * An instance is created for each native method,
+ * <p>
+ * Note: this could potentially be made a lot more generic, e.g by taking in a class that
+ * implements some clean subset of the methods in here. (i.e. factor out the F2J specific
+ * stuff).
+ *
+ * @author Samuel Halliday
+ */
+class JNIGenerator {
+
+ /** Pattern to find the declaration in a javah output file */
+ private static final Pattern namePattern =
+ Pattern.compile("JNIEXPORT.+?\\(");
+
+ // these BLAS functions need an ordering parameter
+ private static final Set<String> NEED_CBLAS_ORDERING =
+ new HashSet<String>(Arrays.asList("cblas_sgemv", "cblas_sgbmv",
+ "cblas_strmv", "cblas_stbmv", "cblas_stpmv", "cblas_strsv",
+ "cblas_stbsv", "cblas_stpsv", "cblas_dgemv", "cblas_dgbmv",
+ "cblas_dtrmv", "cblas_dtbmv", "cblas_dtpmv", "cblas_dtrsv",
+ "cblas_dtbsv", "cblas_dtpsv", "cblas_cgemv", "cblas_cgbmv",
+ "cblas_ctrmv", "cblas_ctbmv", "cblas_ctpmv", "cblas_ctrsv",
+ "cblas_ctbsv", "cblas_ctpsv", "cblas_zgemv", "cblas_zgbmv",
+ "cblas_ztrmv", "cblas_ztbmv", "cblas_ztpmv", "cblas_ztrsv",
+ "cblas_ztbsv", "cblas_ztpsv", "cblas_ssymv", "cblas_ssbmv",
+ "cblas_sspmv", "cblas_sger", "cblas_ssyr", "cblas_sspr",
+ "cblas_ssyr2", "cblas_sspr2", "cblas_dsymv", "cblas_dsbmv",
+ "cblas_dspmv", "cblas_dger", "cblas_dsyr", "cblas_dspr",
+ "cblas_dsyr2", "cblas_dspr2", "cblas_chemv", "cblas_chbmv",
+ "cblas_chpmv", "cblas_cgeru", "cblas_cgerc", "cblas_cher",
+ "cblas_chpr", "cblas_cher2", "cblas_chpr2", "cblas_zhemv",
+ "cblas_zhbmv", "cblas_zhpmv", "cblas_zgeru", "cblas_zgerc",
+ "cblas_zher", "cblas_zhpr", "cblas_zher2", "cblas_zhpr2",
+ "cblas_sgemm", "cblas_ssymm", "cblas_ssyrk", "cblas_ssyr2k",
+ "cblas_strmm", "cblas_strsm", "cblas_dgemm", "cblas_dsymm",
+ "cblas_dsyrk", "cblas_dsyr2k", "cblas_dtrmm", "cblas_dtrsm",
+ "cblas_cgemm", "cblas_csymm", "cblas_csyrk", "cblas_csyr2k",
+ "cblas_ctrmm", "cblas_ctrsm", "cblas_zgemm", "cblas_zsymm",
+ "cblas_zsyrk", "cblas_zsyr2k", "cblas_ztrmm", "cblas_ztrsm",
+ "cblas_chemm", "cblas_cherk", "cblas_cher2k", "cblas_zhemm",
+ "cblas_zherk", "cblas_zher2k"));
+
+ /** Pattern to find the declaration of signatures in a javah output file */
+ private static final Pattern sigPattern =
+ Pattern.compile("Signature: \\((.+?)\\)");
+
+ /**
+ * Mapping from signature letters to C types. Created statically below.
+ *
+ * @see http://java.sun.com/javase/6/docs/technotes/guides/jni/spec/types.html#wp16432
+ */
+ private static final Map<String, String> types =
+ new HashMap<String, String>();
+
+ /** Use direct access to Java arrays from C land. */
+ private static final boolean USE_CRITICAL_ARRAYS = true;
+
+ // some, but not all standard signatures and their C type
+ static {
+ /* These are if the JNI descriptions of Java types are used */
+ types.put("Z", "jboolean");
+ types.put("B", "jbyte");
+ types.put("C", "jchar");
+ types.put("S", "jshort");
+ types.put("I", "jint");
+ types.put("J", "jlong");
+ types.put("F", "jfloat");
+ types.put("D", "jdouble");
+ types.put("Ljava/lang/String", "jstring");
+ types.put("[I", "jintArray");
+ types.put("[D", "jdoubleArray");
+ types.put("[Z", "jbooleanArray");
+ types.put("Lorg/netlib/util/intW", "intW");
+ types.put("Lorg/netlib/util/doubleW", "doubleW");
+
+ /* These are if the Java type has been passed in */
+ types.put("boolean", "jboolean");
+ types.put("byte", "jbyte");
+ types.put("char", "jchar");
+ types.put("short", "jshort");
+ types.put("int", "jint");
+ types.put("long", "jlong");
+ types.put("float", "jfloat");
+ types.put("double", "jdouble");
+ types.put("String", "jstring");
+ types.put("int[]", "jintArray");
+ types.put("double[]", "jdoubleArray");
+ types.put("float[]", "jfloatArray");
+ types.put("boolean[]", "jbooleanArray");
+ types.put("intW", "intW");
+ types.put("doubleW", "doubleW");
+ types.put("floatW", "floatW");
+ types.put("StringW", "StringW");
+ types.put("booleanW", "booleanW");
+ }
+
+ /**
+ * Take in a javah output file and print the JNI code to stdout.
+ *
+ * @param args
+ * @throws IOException
+ */
+ public static void main(String[] args) throws IOException {
+ if (args.length < 1)
+ throw new IllegalArgumentException("Must pass a filename");
+ File file = new File(args[0]);
+ if (!file.exists())
+ throw new IllegalArgumentException(args[0]
+ + " was not a valid filename");
+
+ String pre = "";
+ String post = "";
+ if (args.length > 1) {
+ // prefix to method calls is arg 2
+ pre = args[1];
+ if (args.length > 2) {
+ // postfix to method calls is arg 3
+ post = args[2];
+ }
+ }
+
+ FileInputStream stream = new FileInputStream(file);
+ InputStreamReader streamReader = new InputStreamReader(stream, "UTF-8");
+ BufferedReader reader = new BufferedReader(streamReader);
+ // matcher doesn't work on readers for some crazy reason, must get String
+ StringBuilder builder = new StringBuilder();
+ String line;
+ while ((line = reader.readLine()) != null) {
+ builder.append(line);
+ }
+ reader.close();
+ Matcher matcher =
+ Pattern.compile("/\\*[^#]+?JNIEXPORT.+?\\);", Pattern.MULTILINE).matcher(
+ builder.toString());
+ System.out.println("#include <jni.h>\n\n");
+ while (matcher.find()) {
+ // go through the file finding matches to the pattern
+ JNIGenerator generator =
+ new JNIGenerator(matcher.group(), pre, post, false);
+ System.out.println(generator.getTemplate());
+ }
+ }
+
+ /** Set this to true if you're auto-generating CBLAS code (turns on some hacks) */
+ private final boolean blasHack;
+
+ /** Stores the JNI C code that cleans up the parameters and propagates changes back */
+ private final StringBuilder cleanup = new StringBuilder();
+
+ /** The names of the parameters in C land, after initialisation. */
+ private final List<String> cNames = new ArrayList<String>();
+
+ /** Stores the JNI C code that initialises the parameters */
+ private final StringBuilder init = new StringBuilder();
+
+ /**
+ * Apologies... this actually stores the start of the JNI C signature rather than the
+ * method name. This should probably be cleaned up but could potentially lead to less
+ * stability in code generated from javah output.
+ */
+ private final String name;
+
+ /** The names of the parameters to the method, in order */
+ private final List<String> names = new ArrayList<String>();
+
+ /** characters to append to the Java method name to get the C function name */
+ private final String post;
+
+ /**
+ * For any workarounds needed after initialisation (e.g. building int arrays out of
+ * boolean arrays)
+ */
+ private final StringBuilder postInit = new StringBuilder();
+
+ /** characters to prepend to the Java method name to get the C function name */
+ private final String pre;
+
+ // contains a list of signatures objects passed in, in the order
+ // presented in the javadocs
+ private final List<String> signatures = new ArrayList<String>();
+
+ /**
+ * The constructor to use when creating JNI code from the C header file.
+ *
+ * @param method
+ * containing the javadoc portion as well as the declaration
+ * @param post
+ * @param pre
+ */
+ public JNIGenerator(String method, String pre, String post, boolean blasHack) {
+ assert (method != null) && (pre != null) && (post != null);
+ this.pre = pre;
+ this.post = post;
+ this.blasHack = blasHack;
+ // System.out.println(method);
+ Matcher sigMatcher = sigPattern.matcher(method);
+ sigMatcher.find();
+ String signature = sigMatcher.group(1);
+ // System.out.println(signature);
+ int offset = 0;
+ while (offset < signature.length()) {
+ if (signature.startsWith(";", offset)) {
+ // ignore semicolons, which simply separate java objects
+ offset++;
+ continue;
+ }
+ boolean matched = false;
+ for (String sig : types.keySet()) {
+ if (signature.startsWith(sig, offset)) {
+ String type = types.get(sig);
+ signatures.add(type);
+ // System.out.println(type);
+ offset = offset + sig.length();
+ matched = true;
+ break;
+ }
+ }
+ if (!matched)
+ throw new RuntimeException("Type "
+ + signature.substring(offset)
+ + " not implemented yet, sorry!");
+ }
+ // now the signatures list is created, get the name of the function
+ Matcher nameMatcher = namePattern.matcher(method);
+ nameMatcher.find();
+ name = nameMatcher.group();
+ for (int i = 0; i < signatures.size(); i++) {
+ names.add("arg" + (i + 1));
+ }
+ }
+
+ /**
+ * The constructor to use when generating the JNI code directly from the class files.
+ *
+ * @param pre
+ * the string to prepend to the C function
+ * @param post
+ * the string to postpend to the C function
+ * @param methodName
+ * the name of the method in Java land (with package part)
+ * @param types
+ * the types of the parameters to the method
+ * @param names
+ * the names of the parameters to the method
+ * @param returnType
+ * the Java return type (try to use primitives)
+ * @param blasHack
+ * set to true if generating CBLAS code
+ */
+ public JNIGenerator(String pre, String post, String methodName,
+ List<String> types, List<String> names, String returnType,
+ boolean blasHack) {
+ this.pre = pre;
+ this.post = post;
+ this.blasHack = blasHack;
+ if (!returnType.equals("void")) {
+ returnType = "j" + returnType;
+ }
+ name =
+ "JNIEXPORT " + returnType + " JNICALL Java_"
+ + methodName.replace(".", "_") + " (";
+ this.names.addAll(names);
+ for (String type : types) {
+ String sig = JNIGenerator.types.get(type);
+ assert sig != null : type + " not supported yet";
+ signatures.add(sig);
+ }
+ }
+
+ public String getTemplate() {
+ StringBuilder builder = new StringBuilder();
+ builder.append(name);
+ builder.append("JNIEnv * env, jobject calling_obj");
+ if (signatures.size() > 0)
+ builder.append(", ");
+ for (int i = 0; i < signatures.size(); i++) {
+ String sig = signatures.get(i);
+ if ("intW".equals(sig) || "doubleW".equals(sig)
+ || "floatW".equals(sig) || "booleanW".equals(sig)
+ || "StringW".equals(sig)) {
+ sig = "jobject";
+ }
+ builder.append(sig + " " + names.get(i));
+ if (i != signatures.size() - 1)
+ builder.append(", ");
+ }
+ builder.append("){\n");
+
+ for (int i = 0; i < signatures.size(); i++) {
+ initArgs(i, signatures.get(i));
+ cleanupArgs(i, signatures.get(i));
+ }
+
+ builder.append(init);
+
+ String returnType =
+ name.replaceAll("JNIEXPORT ", "").replaceAll(" JNICALL.*", "");
+ if (!"void".equals(returnType)) {
+ builder.append("\t" + returnType + " returnValue;\n");
+ }
+
+ builder.append(postInit);
+
+ builder.append("\n\t");
+ String cName = guessCFunctionName();
+ if (!"void".equals(returnType)) {
+ builder.append("returnValue = ");
+ }
+ builder.append(cName + "(");
+ if (NEED_CBLAS_ORDERING.contains(cName)) {
+ builder.append("F2J_JNI_ORDER, ");
+ }
+
+ for (int i = 0; i < signatures.size(); i++) {
+ builder.append(parameterise(i));
+ if (i != signatures.size() - 1) {
+ builder.append(", ");
+ }
+ }
+ // hack for ilaenv in LAPACK
+ if (guessCFunctionName().equals("ilaenv_")) {
+ builder.append(", " + "(*env)->GetStringLength(env, "
+ + names.get(1) + ")");
+ builder.append(", " + "(*env)->GetStringLength(env, "
+ + names.get(2) + ")");
+ }
+
+ builder.append(");");
+ builder.append("\n\n");
+
+ // if (cleanup.length() > 0) {
+ // builder.append("\t// Clean up and propagate changes\n");
+ // }
+ builder.append(cleanup);
+
+ if (!"void".equals(returnType)) {
+ builder.append("\n\treturn returnValue;\n");
+ }
+
+ builder.append("}\n");
+
+ if (USE_CRITICAL_ARRAYS)
+ return builder.toString().replaceAll("Get\\w+?ArrayElements",
+ "GetPrimitiveArrayCritical").replaceAll(
+ "Release\\w+?ArrayElements", "ReleasePrimitiveArrayCritical");
+ return builder.toString();
+ }
+
+ private void cleanupArgs(int arg, String type) {
+ String jName = names.get(arg);
+ String cName = cNames.get(arg);
+ if (type.equals("jstring")) {
+ // release UTF-8 array
+ cleanup.append("\t(*env)->ReleaseStringUTFChars(env, " + jName
+ + ", " + cName + ");\n");
+ } else if (type.equals("jintArray")) {
+ // release the array, allows changes to back propagate
+ cleanup.append("\t(*env)->ReleaseIntArrayElements(env, " + jName
+ + ", " + cName + ", 0);\n");
+ } else if (type.equals("jdoubleArray")) {
+ // release the array, allows changes to back propagate
+ cleanup.append("\t(*env)->ReleaseDoubleArrayElements(env, " + jName
+ + ", " + cName + ", 0);\n");
+ } else if (type.equals("jfloatArray")) {
+ // release the array, allows changes to back propagate
+ cleanup.append("\t(*env)->ReleaseFloatArrayElements(env, " + jName
+ + ", " + cName + ", 0);\n");
+ } else if (type.equals("jbooleanArray")) {
+ // release the array, allows changes to back propagate
+ // this requires copying the boolean entries back again
+ cleanup.append("\tfor (" + cName + "i = 0 ; " + cName + "i < "
+ + cName + "Size ; " + cName + "i++){\n");
+ cleanup.append("\t\tif (" + cName + "[" + cName + "i] == 0){\n");
+ cleanup.append("\t\t\t" + cName + "Tmp[" + cName
+ + "i] = JNI_FALSE;\n");
+ cleanup.append("\t\t} else {\n");
+ cleanup.append("\t\t\t" + cName + "Tmp[" + cName
+ + "i] = JNI_TRUE;\n");
+ cleanup.append("\t\t}\n\t}\n");
+ cleanup.append("\t(*env)->ReleaseBooleanArrayElements(env, "
+ + jName + ", " + cName + "Tmp, 0);\n");
+ } else if (type.equals("intW")) {
+ cleanup.append("\t(*env)->SetIntField(env, " + jName + ", " + cName
+ + "Id, " + cName + ");\n");
+ } else if (type.equals("doubleW")) {
+ cleanup.append("\t(*env)->SetDoubleField(env, " + jName + ", "
+ + cName + "Id, " + cName + ");\n");
+ } else if (type.equals("floatW")) {
+ cleanup.append("\t(*env)->SetFloatField(env, " + jName + ", "
+ + cName + "Id, " + cName + ");\n");
+ } else if (type.equals("StringW")) {
+ cleanup.append("\tjstring " + cName
+ + "StringNew = (*env)->NewStringUTF(env, " + cName + ");\n");
+ cleanup.append("\t(*env)->SetObjectField(env, " + jName + ", "
+ + cName + "Id, " + cName + "StringNew);\n");
+ } else if (type.equals("booleanW")) {
+ // cast int -> unsigned byte
+ cleanup.append("\t(*env)->SetBooleanField(env, " + jName + ", "
+ + cName + "Id, (jboolean)" + cName + ");\n");
+ }
+ }
+
+ /**
+ * @return a guess of the C land function name, using {@link #pre} {@link #name} and
+ * {@link #post}
+ */
+ private String guessCFunctionName() {
+ String guess = name.replaceAll(".*_", "").replaceAll("\\W.*", "");
+ return pre + guess + post;
+ }
+
+ private void initArgs(int arg, String type) {
+ String jName = names.get(arg);
+ String cName = "jni_" + jName;
+
+ if (type.equals("jboolean")) {
+ // need to deal with booleans, as C uses ints, java uses unsigned bytes
+ // (the logical type from f2c)
+ init.append("\tlogical " + cName + " = (logical)" + jName + ";\n");
+ cNames.add(cName);
+ } else if (type.equals("jbyte")) {
+ // machine dependent
+ cNames.add(jName);
+ } else if (type.equals("jchar")) {
+ // always an unsigned short
+ cNames.add(jName);
+ } else if (type.equals("jshort")) {
+ // always a short
+ cNames.add(jName);
+ } else if (type.equals("jint")) {
+ // machine dependent
+ cNames.add(jName);
+ } else if (type.equals("jlong")) {
+ // machine dependent
+ cNames.add(jName);
+ } else if (type.equals("jfloat")) {
+ // always a float
+ cNames.add(jName);
+ } else if (type.equals("jdouble")) {
+ // always a double
+ cNames.add(jName);
+ } else if (type.equals("jstring")) {
+ // need to convert into UTF-8 array
+ // we also cast to (char *) from (const char *)
+ init.append("\tchar * " + cName
+ + " = (char *)(*env)->GetStringUTFChars(env, " + jName
+ + ", JNI_FALSE);\n");
+ cNames.add(cName);
+ } else if (type.equals("jintArray")) {
+ // need to get the pointer to the array
+ init.append("\tjint * " + cName
+ + " = (*env)->GetIntArrayElements(env, " + jName
+ + ", JNI_FALSE);\n\tcheck_memory(env, " + cName + ");\n");
+ cNames.add(cName);
+ } else if (type.equals("jdoubleArray")) {
+ // need to get the pointer to the array
+ init.append("\tjdouble * " + cName
+ + " = (*env)->GetDoubleArrayElements(env, " + jName
+ + ", JNI_FALSE);\n\tcheck_memory(env, " + cName + ");\n");
+ cNames.add(cName);
+ } else if (type.equals("jfloatArray")) {
+ // need to get the pointer to the array
+ init.append("\tjfloat * " + cName
+ + " = (*env)->GetFloatArrayElements(env, " + jName
+ + ", JNI_FALSE);\n\tcheck_memory(env, " + cName + ");\n");
+ cNames.add(cName);
+ } else if (type.equals("jbooleanArray")) {
+ // need to get the pointer to the array and convert to int array
+ init.append("\tjboolean * " + cName
+ + "Tmp = (*env)->GetBooleanArrayElements(env, " + jName
+ + ", JNI_FALSE);\n");
+ init.append("\tjint " + cName
+ + "Size = (*env)->GetArrayLength(env, " + jName + ");\n");
+ // must use the f2c "logical" type here
+ init.append("\tlogical " + cName + "[" + cName + "Size];\n");
+ init.append("\tint " + cName + "i;\n");
+ // copy over boolean bytes to int array
+ postInit.append("\tfor (" + cName + "i = 0 ; " + cName + "i < "
+ + cName + "Size ; " + cName + "i++){\n" + "\t\tif ("
+ + cName + "Tmp[" + cName + "i] == JNI_FALSE){\n" + "\t\t\t"
+ + cName + "[" + cName + "i] = 0;\n" + "\t\t} else {\n"
+ + "\t\t\t" + cName + "[" + cName + "i] = 1;"
+ + "\n\t\t}\n\t}\n");
+ cNames.add(cName);
+ } else if (type.equals("intW")) {
+ init.append("\tjclass " + cName
+ + "Class = (*env)->GetObjectClass(env, " + jName + ");\n");
+ init.append("\tjfieldID " + cName + "Id = (*env)->GetFieldID(env, "
+ + cName + "Class, \"val\", \"I\");\n");
+ init.append("\tjint " + cName + " = (*env)->GetIntField(env, "
+ + jName + ", " + cName + "Id);\n");
+ cNames.add(cName);
+ } else if (type.equals("doubleW")) {
+ init.append("\tjclass " + cName
+ + "Class = (*env)->GetObjectClass(env, " + jName + ");\n");
+ init.append("\tjfieldID " + cName + "Id = (*env)->GetFieldID(env, "
+ + cName + "Class, \"val\", \"D\");\n");
+ init.append("\tjdouble " + cName
+ + " = (*env)->GetDoubleField(env, " + jName + ", " + cName
+ + "Id);\n");
+ cNames.add(cName);
+ } else if (type.equals("floatW")) {
+ init.append("\tjclass " + cName
+ + "Class = (*env)->GetObjectClass(env, " + jName + ");\n");
+ init.append("\tjfieldID " + cName + "Id = (*env)->GetFieldID(env, "
+ + cName + "Class, \"val\", \"D\");\n");
+ init.append("\tjfloat " + cName + " = (*env)->GetFloatField(env, "
+ + jName + ", " + cName + "Id);\n");
+ cNames.add(cName);
+ } else if (type.equals("StringW")) {
+ init.append("\tjclass " + cName
+ + "Class = (*env)->GetObjectClass(env, " + jName + ");\n");
+ init.append("\tjfieldID " + cName + "Id = (*env)->GetFieldID(env, "
+ + cName + "Class, \"val\", \"Ljava/lang/String;\");\n");
+ init.append("\tjstring " + cName
+ + "String = (jstring)((*env)->GetObjectField(env, " + jName
+ + ", " + cName + "Id));\n");
+ init.append("\tchar * " + cName
+ + " = (char *)(*env)->GetStringUTFChars(env, " + cName
+ + "String, JNI_FALSE);\n");
+ cNames.add(cName);
+ } else if (type.equals("booleanW")) {
+ init.append("\tjclass " + cName
+ + "Class = (*env)->GetObjectClass(env, " + jName + ");\n");
+ init.append("\tjfieldID " + cName + "Id = (*env)->GetFieldID(env, "
+ + cName + "Class, \"val\", \"I\");\n");
+ init.append("\tjboolean " + cName
+ + "Boolean = (*env)->GetBooleanField(env, " + jName + ", "
+ + cName + "Id);\n");
+ // don't forget C and Java treat 'boolean's differently
+ init.append("\tlogical " + cName + " = (logical)" + cName
+ + "Boolean;\n");
+ cNames.add(cName);
+ } else
+ throw new RuntimeException("unknown type " + type);
+ assert cNames.size() == arg + 1;
+ }
+
+ /**
+ * @param i
+ * @return the version of the variable to send to the C function
+ */
+ private String parameterise(int i) {
+ // total hack
+ if (("".equals(pre) && "_".equals(post))
+ || (blasHack && (guessCFunctionName().equals("cblas_drotg")
+ || guessCFunctionName().equals("cblas_srotg")
+ || ((i != 3) && guessCFunctionName().equals(
+ "cblas_srotmg")) || ((i != 3) && guessCFunctionName().equals(
+ "cblas_drotmg"))))) {
+ // assume we're calling a fortran function and need to reference ints and
+ // doubles
+ String type = signatures.get(i);
+ if ("jint".equals(type) || "jdouble".equals(type)
+ || "jfloat".equals(type) || "jboolean".equals(type)
+ || "intW".equals(type) || "doubleW".equals(type)
+ || "booleanW".equals(type) || "floatW".equals(type))
+ return "&" + cNames.get(i);
+ }
+ // CBLAS needs some wrapper code
+ if (blasHack) {
+ if (cNames.get(i).startsWith("jni_trans"))
+ return "getTrans(" + cNames.get(i) + ")";
+ if (cNames.get(i).startsWith("jni_uplo"))
+ return "getUpLo(" + cNames.get(i) + ")";
+ if (cNames.get(i).startsWith("jni_diag"))
+ return "getDiag(" + cNames.get(i) + ")";
+ if (cNames.get(i).startsWith("jni_side"))
+ return "getSide(" + cNames.get(i) + ")";
+ }
+ // do the simple thing... no referencing
+ return cNames.get(i);
+ }
+}
diff --git a/src/org/netlib/generate/JavaGenerator.java b/src/org/netlib/generate/JavaGenerator.java
new file mode 100644
index 0000000..fda8e9d
--- /dev/null
+++ b/src/org/netlib/generate/JavaGenerator.java
@@ -0,0 +1,970 @@
+/*
+ * Copyright ThinkTank Maths Limited 2006, 2007
+ *
+ * This file is free software: you can redistribute it and/or modify it under the terms of
+ * the GNU General Public License as published by the Free Software Foundation, either
+ * version 3 of the License, or (at your option) any later version.
+ *
+ * This file is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
+ * without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ * PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with this file.
+ * If not, see <http://www.gnu.org/licenses/>.
+ *
+ * For the avoidance of doubt, source code generated by this program is not considered
+ * a derivative work.
+ */
+package org.netlib.generate;
+
+import java.io.ByteArrayOutputStream;
+import java.io.File;
+import java.io.FileInputStream;
+import java.io.FileNotFoundException;
+import java.io.FileOutputStream;
+import java.io.IOException;
+import java.io.OutputStreamWriter;
+import java.lang.reflect.Method;
+import java.lang.reflect.Type;
+import java.net.URISyntaxException;
+import java.net.URL;
+import java.net.URLClassLoader;
+import java.util.ArrayList;
+import java.util.Arrays;
+import java.util.Collections;
+import java.util.Enumeration;
+import java.util.HashMap;
+import java.util.HashSet;
+import java.util.List;
+import java.util.Map;
+import java.util.Set;
+import java.util.jar.JarEntry;
+import java.util.jar.JarFile;
+import java.util.regex.Matcher;
+import java.util.regex.Pattern;
+import java.util.zip.ZipEntry;
+import java.util.zip.ZipInputStream;
+
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * Due to the depressing number of LAPACK routines, it is much more efficient to
+ * auto-generate the Java code for the wrapper and corresponding Java and JNI
+ * implementations.
+ * <p>
+ * Warning: this code is very monolithic and horrible. It was written in a hurry for a
+ * one-off run. It is probably very hard to understand and not at all elegant. Efforts
+ * have been best spent on making sure the output code is elegant as it is the stuff that
+ * actually matters.
+ *
+ * @author Samuel Halliday
+ */
+class JavaGenerator {
+
+ class Doublet<A, B> {
+ public A a;
+ public B b;
+
+ public Doublet(A a, B b) {
+ this.a = a;
+ this.b = b;
+ }
+
+ @Override
+ public String toString() {
+ return a + " " + b;
+ }
+ }
+
+ interface IClassFilter {
+ /**
+ * @param className
+ * @return true if the class with the given name is acceptable.
+ */
+ public boolean isValid(String className);
+ }
+
+ private static final Map<Type, String> classDefs =
+ new HashMap<Type, String>();
+
+ static {
+ /*
+ * The complete(ish) list of parameter types for F2J methods. Typically an array
+ * is followed by an int specifying the offset.
+ */
+ classDefs.put(String.class, "String");
+ classDefs.put(Integer.TYPE, "int");
+ classDefs.put(Double.TYPE, "double");
+ classDefs.put(Boolean.TYPE, "boolean");
+ classDefs.put(Float.TYPE, "float");
+ classDefs.put(intW.class, "intW");
+ classDefs.put(doubleW.class, "doubleW");
+ classDefs.put(booleanW.class, "booleanW");
+ classDefs.put(floatW.class, "floatW");
+ classDefs.put(StringW.class, "StringW");
+ classDefs.put(int[].class, "int[]");
+ classDefs.put(double[].class, "double[]");
+ classDefs.put(boolean[].class, "boolean[]");
+ classDefs.put(float[].class, "float[]");
+ }
+
+ public static void main(String[] args) throws Exception {
+ // create the BLAS wrapper
+ JavaGenerator blas =
+ new JavaGenerator("org.netlib.blas", "BLAS",
+ "lib/f2j/jlapack-0.8-javadoc.zip");
+ writeToFile(blas.getAbstractWrapper(), "src/org/netlib/blas/BLAS.java");
+ writeToFile(blas.getJavaWrapper(), "src/org/netlib/blas/JBLAS.java");
+ writeToFile(blas.getJNIWrapper(), "src/org/netlib/blas/NativeBLAS.java");
+ writeToFile(blas.getJNIC(), "jni/org_netlib_blas_NativeBLAS.c");
+
+ // create the LAPACK wrapper
+ JavaGenerator lapack =
+ new JavaGenerator("org.netlib.lapack", "LAPACK",
+ "lib/f2j/jlapack-0.8-javadoc.zip");
+ writeToFile(lapack.getAbstractWrapper(),
+ "src/org/netlib/lapack/LAPACK.java");
+ writeToFile(lapack.getJavaWrapper(),
+ "src/org/netlib/lapack/JLAPACK.java");
+ writeToFile(lapack.getJNIWrapper(),
+ "src/org/netlib/lapack/NativeLAPACK.java");
+ writeToFile(lapack.getJNIC(), "jni/org_netlib_lapack_NativeLAPACK.c");
+
+ // create the ARPACK wrapper
+ // TODO: add the ARPACK javadocs here
+ JavaGenerator arpack =
+ new JavaGenerator("org.netlib.arpack", "ARPACK", "");
+ writeToFile(arpack.getAbstractWrapper(),
+ "src/org/netlib/arpack/ARPACK.java");
+ writeToFile(arpack.getJavaWrapper(),
+ "src/org/netlib/arpack/JARPACK.java");
+ writeToFile(arpack.getJNIWrapper(),
+ "src/org/netlib/arpack/NativeARPACK.java");
+ writeToFile(arpack.getJNIC(), "jni/org_netlib_arpack_NativeARPACK.c");
+ }
+
+ static void writeToFile(String string, String filename) throws IOException {
+ FileOutputStream out = new FileOutputStream(filename);
+ OutputStreamWriter writer = new OutputStreamWriter(out, "UTF-8");
+ writer.write(string);
+ writer.close();
+ }
+
+ /**
+ * The generated files are licenced under the BSD licence, the same as the netlib
+ * sources.
+ */
+ private final String COPYRIGHT =
+ "/*\n * Copyright 2003-2007 Keith Seymour.\n"
+ + " * Copyright 1992-2007 The University of Tennessee. All rights reserved.\n"
+ + " * \n"
+ + " * Redistribution and use in source and binary forms, with or without\n"
+ + " * modification, are permitted provided that the following conditions are\n"
+ + " * met:\n"
+ + " * \n"
+ + " * - Redistributions of source code must retain the above copyright\n"
+ + " * notice, this list of conditions and the following disclaimer.\n"
+ + " * \n"
+ + " * - Redistributions in binary form must reproduce the above copyright\n"
+ + " * notice, this list of conditions and the following disclaimer listed\n"
+ + " * in this license in the documentation and/or other materials\n"
+ + " * provided with the distribution.\n"
+ + " * \n"
+ + " * - Neither the name of the copyright holders nor the names of its\n"
+ + " * contributors may be used to endorse or promote products derived from\n"
+ + " * this software without specific prior written permission.\n"
+ + " * \n"
+ + " * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n"
+ + " * \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n"
+ + " * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n"
+ + " * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n"
+ + " * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n"
+ + " * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n"
+ + " * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n"
+ + " * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n"
+ + " * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n"
+ + " * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n"
+ + " * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n"
+ + " * \n" + " * This file was auto-generated by the "
+ + JavaGenerator.class.getCanonicalName()
+ + "\n * program, a part of netlib-java.\n * \n"
+ + " * @see http://code.google.com/p/netlib-java/\n" + " */\n";
+
+ private final String javadocs;
+
+ private final String javaWrapper;
+
+ private final String jniC;
+
+ private final String jniWrapper;
+
+ private final String pkg;
+
+ private String post;
+
+ private String pre;
+
+ private final String topWrapper;
+
+ private final String wrapperName;
+
+ /**
+ * Some F2J methods take parameters that I don't know how to deal with in the JNI, so
+ * we'll simply make sure the wrapper always sends them to the F2J implementation.
+ */
+ private final Set<String> dontUseJNI = new HashSet<String>();
+
+ /**
+ * @param packageName
+ * @param wrapperName
+ * @param javadocs
+ * @throws IOException
+ */
+ JavaGenerator(String packageName, String wrapperName, String javadocs)
+ throws IOException {
+ pkg = packageName;
+ this.javadocs = javadocs;
+ this.wrapperName = wrapperName;
+ // hack for fortran/C names. BLAS is different to the other netlib libs
+ if (wrapperName.equals("BLAS")) {
+ pre = "cblas_";
+ post = "";
+ } else {
+ pre = "";
+ post = "_";
+ }
+
+ List<Class<?>> classes = getClasses(pkg, new IClassFilter() {
+ public boolean isValid(String className) {
+ assert className != null;
+ assert className.startsWith(pkg);
+ String shortName = className.substring(pkg.length() + 1);
+ if (shortName.toUpperCase().equals(shortName))
+ // all caps mean the "convenience" F2J libs
+ // or the wrapper class we are trying to create!
+ return false;
+ if (shortName.startsWith("Native"))
+ // these are the JNI classes
+ return false;
+ if (shortName.contains("$"))
+ // inner classes
+ return false;
+ if (shortName.endsWith("Test"))
+ // test cases
+ return false;
+ return true;
+ }
+ });
+
+ List<Method> methods = new ArrayList<Method>();
+ for (Class<?> clazz : classes) {
+ Method[] ms = clazz.getDeclaredMethods();
+ for (Method m : ms) {
+ // F2J methods have the same name as their containing class
+ String name = m.getName();
+ String className = clazz.getSimpleName();
+ if (!name.equals(className.toLowerCase()))
+ continue;
+ methods.add(m);
+ break;
+ }
+ }
+ StringBuilder topWrapper = new StringBuilder();
+ StringBuilder javaWrapper = new StringBuilder();
+ StringBuilder jniWrapper = new StringBuilder();
+ StringBuilder jniC = new StringBuilder();
+ topWrapper.append(COPYRIGHT);
+ javaWrapper.append(COPYRIGHT);
+ jniWrapper.append(COPYRIGHT);
+ jniC.append(COPYRIGHT);
+
+ topWrapper.append("package " + pkg + ";\n\n");
+ topWrapper.append("import java.util.logging.Logger;\n");
+ topWrapper.append("import org.netlib.util.StringW;\n");
+ topWrapper.append("import org.netlib.util.booleanW;\n");
+ topWrapper.append("import org.netlib.util.doubleW;\n");
+ topWrapper.append("import org.netlib.util.floatW;\n");
+ topWrapper.append("import org.netlib.util.intW;\n\n");
+ topWrapper.append("/**\n");
+ topWrapper.append(" * "
+ + wrapperName
+ + " provider which will attempt to access a native implementation\n");
+ topWrapper.append(" * and falling back to use F2J if none is available.\n *\n");
+ topWrapper.append(" * @see http://sourceforge.net/projects/f2j\n");
+ topWrapper.append(" * @see http://www.netlib.org/"
+ + wrapperName.toLowerCase() + "/\n");
+ topWrapper.append(" * @author Samuel Halliday\n");
+ topWrapper.append(" */\n");
+ topWrapper.append("public abstract class " + wrapperName + " {\n\n");
+ topWrapper.append(topWrapperLoader(wrapperName));
+
+ javaWrapper.append("package " + pkg + ";\n\n");
+ javaWrapper.append("import java.util.logging.Logger;\n");
+ javaWrapper.append("import org.netlib.util.StringW;\n");
+ javaWrapper.append("import org.netlib.util.booleanW;\n");
+ javaWrapper.append("import org.netlib.util.doubleW;\n");
+ javaWrapper.append("import org.netlib.util.floatW;\n");
+ javaWrapper.append("import org.netlib.util.intW;\n\n");
+ javaWrapper.append("/**\n");
+ javaWrapper.append(" * " + wrapperName
+ + " provider implementation which uses F2J.\n *\n");
+ javaWrapper.append(" * @see http://sourceforge.net/projects/f2j\n");
+ javaWrapper.append(" * @author Samuel Halliday\n");
+ javaWrapper.append(" */\n");
+ javaWrapper.append("final class J" + wrapperName + " extends "
+ + wrapperName + " {\n\n");
+ javaWrapper.append("\tstatic final " + wrapperName
+ + " INSTANCE = new J" + wrapperName + "();\n\n");
+ javaWrapper.append("\tprivate J" + wrapperName + "() {\n");
+ javaWrapper.append("\t}\n\n");
+
+ jniWrapper.append("package " + pkg + ";\n\n");
+ jniWrapper.append("import java.util.logging.Logger;\n");
+ jniWrapper.append("import org.netlib.util.StringW;\n");
+ jniWrapper.append("import org.netlib.util.booleanW;\n");
+ jniWrapper.append("import org.netlib.util.doubleW;\n");
+ jniWrapper.append("import org.netlib.util.floatW;\n");
+ jniWrapper.append("import org.netlib.util.intW;\n");
+ jniWrapper.append("import org.netlib.utils.JNIMethods;\n\n");
+ jniWrapper.append("/**\n");
+ jniWrapper.append(" * "
+ + wrapperName
+ + " provider implementation which uses the Java Native Interface to access\n");
+ jniWrapper.append(" * system netlib libraries.\n *\n");
+ jniWrapper.append(" * @see http://www.netlib.org/\n");
+ jniWrapper.append(" * @author Samuel Halliday\n");
+ jniWrapper.append(" */\n");
+ jniWrapper.append("final class Native" + wrapperName + " extends "
+ + wrapperName + " {\n\n");
+ jniWrapper.append(jniWrapperLoader(wrapperName));
+
+ jniC.append("\n#include \"f2j_jni.h\"\n");
+ jniC.append("#include \"" + pkg.toLowerCase().replace(".", "_")
+ + "_Native" + wrapperName + ".h\"\n\n");
+
+ for (Method method : methods) {
+ System.out.println("Generating " + method.getName());
+ Type[] params = method.getGenericParameterTypes();
+ for (Type param : params) {
+ if (classDefs.containsKey(param))
+ continue;
+
+ System.err.println(method.getName() + " has a " + param
+ + " parameter, so we'll not generate a JNI");
+ dontUseJNI.add(method.getName());
+ }
+
+ String[] wrapper = createWrapper(method);
+ topWrapper.append(wrapper[0]);
+ javaWrapper.append(wrapper[1]);
+ jniWrapper.append(wrapper[2]);
+ jniC.append(wrapper[3]);
+ }
+ topWrapper.append("}\n");
+ javaWrapper.append("}\n");
+ jniWrapper.append("}\n");
+
+ // System.out.print(topWrapper);
+ this.topWrapper = topWrapper.toString();
+ this.javaWrapper = javaWrapper.toString();
+ this.jniWrapper = jniWrapper.toString();
+ this.jniC = jniC.toString();
+ }
+
+ /**
+ * @return the Java source code for the top level abstract class for the package
+ */
+ public String getAbstractWrapper() {
+ return topWrapper;
+ }
+
+ /**
+ * @return the Java source code for the F2J delegate class
+ */
+ public String getJavaWrapper() {
+ return javaWrapper;
+ }
+
+ /**
+ * @return the C source code for the JNI code
+ */
+ public String getJNIC() {
+ return jniC;
+ }
+
+ /**
+ * @return the Java source code for the JNI delegate class
+ */
+ public String getJNIWrapper() {
+ return jniWrapper;
+ }
+
+ /**
+ * @param s
+ * @return a capitalised version of the input
+ */
+ private String capitalize(String s) {
+ if (s.length() == 0)
+ return s;
+ return s.substring(0, 1).toUpperCase() + s.substring(1).toLowerCase();
+ }
+
+ /**
+ * @param method
+ * @param typeAndName
+ * @return
+ */
+ private String createJavaWrapper(Method method,
+ List<Doublet<String, String>> typeAndName) {
+ // no need for javadocs
+ StringBuilder builder = new StringBuilder();
+ builder.append("\t at Override\n");
+ builder.append("\tpublic "
+ + method.getReturnType().getName().toLowerCase() + " "
+ + method.getName() + "(");
+ for (int i = 0; i < typeAndName.size(); i++) {
+ Doublet<String, String> tm = typeAndName.get(i);
+ String type = tm.a;
+ String name = tm.b;
+ builder.append(type + " " + name);
+ if (i != typeAndName.size() - 1)
+ builder.append(", ");
+ }
+ builder.append(") {\n\t\t");
+ if (!method.getReturnType().equals(Void.TYPE))
+ builder.append("return ");
+
+ String n = method.getName();
+ builder.append(pkg + "." + capitalize(n) + "." + n + "(");
+ for (int i = 0; i < typeAndName.size(); i++) {
+ Doublet<String, String> tm = typeAndName.get(i);
+ String type = tm.a;
+ String name = tm.b;
+ builder.append(name);
+ if (type.contains("[]")) {
+ // offset is always zero
+ builder.append(", 0");
+ }
+ if (i != typeAndName.size() - 1)
+ builder.append(", ");
+ }
+ builder.append(");\n\t}\n\n");
+ return builder.toString();
+ }
+
+ /**
+ * @param method
+ * @param typeAndName
+ * @return
+ */
+ private String createJNICode(Method method,
+ List<Doublet<String, String>> typeAndName) {
+ List<String> names = new ArrayList<String>();
+ List<String> types = new ArrayList<String>();
+ for (Doublet<String, String> tn : typeAndName) {
+ types.add(tn.a);
+ names.add(tn.b);
+ }
+ String name = pkg + ".Native" + wrapperName + "." + method.getName();
+ String rtn = method.getReturnType().getName().toLowerCase();
+ // cblas hack
+ String pre = this.pre;
+ String post = this.post;
+ if (wrapperName.equals("BLAS") && method.getName().equals("lsame")) {
+ pre = "";
+ post = "_";
+ }
+
+ JNIGenerator jni =
+ new JNIGenerator(pre, post, name, types, names, rtn,
+ wrapperName.equals("BLAS") ? true : false);
+ return jni.getTemplate() + "\n";
+ }
+
+ /**
+ * @param method
+ * @param typeAndName
+ * @return
+ */
+ private String createJNIWrapper(Method method,
+ List<Doublet<String, String>> typeAndName) {
+ // no need for javadocs
+ StringBuilder builder = new StringBuilder();
+ builder.append("\t at Override\n");
+ builder.append("\tpublic native "
+ + method.getReturnType().getName().toLowerCase() + " "
+ + method.getName() + "(");
+ for (int i = 0; i < typeAndName.size(); i++) {
+ Doublet<String, String> tm = typeAndName.get(i);
+ String type = tm.a;
+ String name = tm.b;
+ builder.append(type + " " + name);
+ if (i != typeAndName.size() - 1)
+ builder.append(", ");
+ }
+ builder.append(");\n\n");
+ return builder.toString();
+ }
+
+ /**
+ * @param javadocs
+ * @param typeAndName
+ * @return
+ */
+ private String createTopJavaDocs(String javadocs,
+ List<Doublet<String, String>> typeAndName) {
+ StringBuilder builder = new StringBuilder();
+ builder.append("\t/**\n");
+ builder.append(javadocs);
+ for (int i = 0; i < typeAndName.size(); i++) {
+ builder.append("\t * @param " + typeAndName.get(i).b + "\n");
+ }
+ builder.append("\t */\n");
+ return builder.toString();
+ }
+
+ /**
+ * @param method
+ * @param typeAndName
+ * @param javadocs
+ * @return
+ */
+ private String createTopWrapper(Method method,
+ List<Doublet<String, String>> typeAndName, String javadocs) {
+ StringBuilder builder = new StringBuilder();
+ builder.append(createTopJavaDocs(javadocs, typeAndName));
+ builder.append("\tpublic abstract "
+ + method.getReturnType().toString().toLowerCase() + " "
+ + method.getName() + "(");
+ for (int i = 0; i < typeAndName.size(); i++) {
+ builder.append(typeAndName.get(i).a + " " + typeAndName.get(i).b);
+ if (i != typeAndName.size() - 1)
+ builder.append(", ");
+ }
+ builder.append(");\n\n");
+ return builder.toString();
+ }
+
+ /**
+ * A list of methods not defined in headers on OS X Leopard or Ubuntu Gutsy. These are
+ * most likely subroutines that should not be a part of the API, but we leave them in
+ * anyway.
+ */
+ static final Set<String> notSupportedByJNI =
+ new HashSet<String>(Arrays.asList(
+ /* These are BLAS/LAPACK not defined on OS X Leopard */
+ "disnan", "dlacn2", "dlag2s", "dlahr2", "dlaisnan", "dlaneg",
+ "dlaqr0", "dlaqr1", "dlaqr2", "dlaqr3", "dlaqr4", "dlaqr5",
+ "dlarra", "dlarrc", "dlarrd", "dlarrj", "dlarrk", "dlarrr",
+ "dlazq3", "dlazq4", "dsgesv", "dstemr", "ilaver", "iparmq",
+ "sisnan", "slag2d", "slahr2", "slaisnan", "slaneg", "slaqr0",
+ "slaqr1", "slaqr2", "slaqr3", "slaqr4", "slaqr5", "slarra",
+ "slarrc", "slarrj", "slarrr", "sstemr", "slacn2", "slarrd",
+ "slarrk", "slazq3", "slazq4",
+ /* These are BLAS not defined on Ubuntu Gutsy (LAPACK 3.0) */
+ "lsame",
+ /*
+ * These are LAPACK and not defined in LAPACK 3.0
+ * http://www.netlib.org/clapack/clapack.h
+ */
+ "dlangb", "dlange", "dlangt", "dlanhs", "dlansb", "dlansp",
+ "dlanst", "dlansy", "dlantb", "dlantp", "dlantr", "dlapy2",
+ "dlapy3", "lsamen", "slangb", "slange", "slangt", "slanhs",
+ "slansb", "slansp", "slanst", "slansy", "slantb", "slantp",
+ "slantr", "slapy2", "slapy3", "dlamc3", "dsecnd", "second",
+ "slamch", "slamc3",
+ /*
+ * The following is not defined in clapack.h bet really should be!
+ * So we're leaving it in and we'll suffer the compile time warning.
+ */
+ // "dlamch",
+ /* these are not defined in the ARPACK headers */
+ "dmout", "dvout", "icnteq", "icopy", "iset", "iswap", "ivout",
+ "smout", "svout", "dgetv0", "dlaqrb", "dnaitr", "dnapps",
+ "dnaup2", "dnconv", "dneigh", "dngets", "dsaitr", "dsapps",
+ "dsaup2", "dsconv", "dseigt", "dsesrt", "dsgets", "dsortc",
+ "dsortr", "dstatn", "dstats", "dstqrb", "sgetv0", "slaqrb",
+ "snaitr", "snapps", "snaup2", "snconv", "sneigh", "sngets",
+ "ssaitr", "ssapps", "ssaup2", "ssconv", "sseigt", "ssesrt",
+ "ssgets", "ssortc", "ssortr", "sstatn", "sstats", "sstqrb"));
+
+ /** A list of methods where F2J has a different signature than in OS X Leopard */
+ static final List<String> incompatibleWithJni =
+ Arrays.asList("dlar1v", "dlarrb", "dlarre", "dlarrf", "dlarrv",
+ "slar1v", "slarrb", "slarre", "slarrf", "slarrv");
+
+ /**
+ * @param method
+ * @return the 4D array of wrappers. The first is the abstract portion, the second is
+ * the F2J wrapper, the third is the JNI wrapper and the forth is the C JNI
+ * code.
+ * @throws IOException
+ */
+ private String[] createWrapper(Method method) throws IOException {
+ String name = method.getName();
+ String[] parts = new String[4];
+
+ Map<String, String[]> fromDocs = getParameterNames(method);
+ String javadocs = fromDocs.keySet().iterator().next();
+ String[] names = fromDocs.values().iterator().next();
+ Class<?>[] paramTypes = method.getParameterTypes();
+ List<Doublet<String, String>> typeAndName =
+ typeAndName(paramTypes, names);
+ // some exceptional methods
+ if (notSupportedByJNI.contains(name)
+ || incompatibleWithJni.contains(name)
+ || dontUseJNI.contains(name)) {
+ String javaWrapper = createJavaWrapper(method, typeAndName);
+ String javaDocs = createTopJavaDocs(javadocs, typeAndName);
+ parts[0] = javaWrapper.replace("@Override\n", javaDocs);
+ System.err.println("Forcing F2J for " + name);
+ parts[1] = "";
+ parts[2] = "";
+ parts[3] = "";
+ return parts;
+ }
+ parts[0] = createTopWrapper(method, typeAndName, javadocs);
+ parts[1] = createJavaWrapper(method, typeAndName);
+ parts[2] = createJNIWrapper(method, typeAndName);
+ parts[3] = createJNICode(method, typeAndName);
+ return parts;
+ }
+
+ /**
+ * This convenience method will examine the classpath and find any classes which are
+ * in the requested package. A filter can be specified to exclude results.
+ *
+ * @param packageName
+ * @param filter
+ * @return all classes in a given package
+ * @see http://forum.java.sun.com/thread.jspa?threadID=757391&messageID=4326850
+ */
+ private List<Class<?>> getClasses(String packageName, IClassFilter filter) {
+ String packagePath = packageName.replace('.', '/');
+// ArrayList<URL> classpath = new ArrayList<URL>();
+// String[] classpathString = System.getProperty("java.class.path").split(":");
+// for (int i = 0 ; i < classpathString.length ; i++){
+// if (classpathString[i] == null)
+// continue;
+// try {
+// URL url = new URL("file:" + classpathString[i]);
+// classpath.add(url);
+// } catch (MalformedURLException ex) {
+// Logger.getLogger(JavaGenerator.class.getName()).
+// log(Level.SEVERE, classpathString[i] + " " + ex.getMessage());
+// }
+// }
+ URL [] classpath = ((URLClassLoader) ClassLoader.getSystemClassLoader()).getURLs();
+ List<Class<?>> result = new ArrayList<Class<?>>();
+ System.out.println(Arrays.toString(classpath));
+ for (URL url : classpath) {
+ File file;
+ try {
+ file = new File(url.toURI());
+ } catch (URISyntaxException e1) {
+ continue;
+ }
+ if (file.getPath().endsWith(".jar")) {
+ // class path is a jar file
+ JarFile jarFile;
+ try {
+ jarFile = new JarFile(file);
+ } catch (IOException e) {
+ continue;
+ }
+ for (Enumeration<JarEntry> entries = jarFile.entries(); entries.hasMoreElements();) {
+ String entryName = (entries.nextElement()).getName();
+ if (entryName.matches(packagePath + "/\\w*\\.class")) {
+ // get only class files in package dir
+ ClassLoader classLoader =
+ new URLClassLoader(new URL[] { url });
+ String className =
+ entryName.replace('/', '.').substring(0,
+ entryName.lastIndexOf('.'));
+ if (!filter.isValid(className))
+ continue;
+ Class<?> clazz;
+ try {
+ clazz = classLoader.loadClass(className);
+ } catch (ClassNotFoundException e) {
+ continue;
+ }
+ result.add(clazz);
+ }
+ }
+ } else {
+ // class path is a directory
+ File packageDirectory =
+ new File(file.getPath() + "/" + packagePath);
+ for (File f : packageDirectory.listFiles()) {
+ if (f.getPath().endsWith(".class")) {
+ String className =
+ packageName
+ + "."
+ + f.getName().substring(0,
+ f.getName().lastIndexOf('.'));
+ if (!filter.isValid(className))
+ continue;
+ ClassLoader classLoader =
+ new URLClassLoader(new URL[] { url });
+ Class<?> clazz;
+ try {
+ clazz = classLoader.loadClass(className);
+ } catch (ClassNotFoundException e) {
+ continue;
+ }
+ result.add(clazz);
+ }
+ }
+ }
+ }
+ return result;
+ }
+
+ /**
+ * Note that we cannot use a library like Paranamer here because the information is
+ * not in the bytecode. We look in the Javadocs!
+ *
+ * @param method
+ * @return a singleton map from the javadoc description to the parameter names of the
+ * method, in order. (Yes, I know this is a hack)
+ * @throws IOException
+ */
+ private Map<String, String[]> getParameterNames(Method method)
+ throws IOException {
+ ZipInputStream in;
+ try {
+ in = new ZipInputStream(new FileInputStream(javadocs));
+ } catch (FileNotFoundException e) {
+ // no javadocs available, just return arg1 ... argN
+ int size = method.getGenericParameterTypes().length;
+ String[] names = new String[size];
+ for (int i = 0; i < size; i++) {
+ names[i] = "arg" + (i + 1);
+ }
+ String docs =
+ "\t * No documentation was available when generating this method.\n\t * \n";
+ return Collections.singletonMap(docs, names);
+ }
+ ZipEntry entry;
+ // deal with the capitalisation of LAPACK classes... clashes there
+ String m = method.getName();
+ String p =
+ pkg.replace(".", "/") + "/" + m.substring(0, 1).toUpperCase()
+ + m.substring(1) + ".html";
+ try {
+ while ((entry = in.getNextEntry()) != null) {
+ String name = entry.getName();
+ if (name.endsWith(p)) {
+ ByteArrayOutputStream out = new ByteArrayOutputStream();
+ // Transfer bytes from the ZIP file to the output stream
+ byte[] buf = new byte[1024];
+ int len;
+ while ((len = in.read(buf)) > 0) {
+ out.write(buf, 0, len);
+ }
+ String javadoc = new String(out.toByteArray());
+ out.close();
+ String[] names = parseParameterNames(method, javadoc);
+ String documentation =
+ parseJavadocDescription(method, javadoc);
+ return Collections.singletonMap(documentation, names);
+ }
+ }
+ throw new RuntimeException("getParameterNames failed");
+ } finally {
+ in.close();
+ }
+ }
+
+ private String jniWrapperLoader(String wrapperName) {
+ StringBuilder b = new StringBuilder();
+ b.append("\t// singleton\n");
+ b.append("\tprotected static final Native" + wrapperName
+ + " INSTANCE = new Native" + wrapperName + "();\n\n");
+ b.append("\t// indicates if the JNI loaded OK. If this is false, calls to the native\n");
+ b.append("\t// methods will fail with UnsatisfiedLinkError\n");
+ b.append("\tprotected final boolean isLoaded;\n\n");
+ b.append("\tprivate Native" + wrapperName + "() {\n");
+ b.append("\t\tString libname = JNIMethods.getPortableLibraryName(\"jni"
+ + wrapperName.toLowerCase() + "\");\n");
+ b.append("\t\ttry {\n");
+ b.append("\t\t\tSystem.loadLibrary(libname);\n");
+ b.append("\t\t} catch (UnsatisfiedLinkError e) {\n");
+ b.append("\t\t\tisLoaded = false;\n");
+ b.append("\t\t\treturn;\n");
+ b.append("\t\t}\n");
+ b.append("\t\tisLoaded = true;\n");
+ b.append("\t}\n\n");
+ return b.toString();
+ }
+
+ /**
+ * @param method
+ * @param javadoc
+ * @return
+ */
+ private String parseJavadocDescription(Method method, String javadoc) {
+ Pattern pattern =
+ Pattern.compile("seymour at cs.utk.edu</a> with any questions.\n<p>");
+ Matcher matcher = pattern.matcher(javadoc);
+ boolean matched = matcher.find();
+ assert matched;
+ int start = matcher.end();
+ int end = javadoc.indexOf("</pre>", start);
+ javadoc =
+ javadoc.substring(start, end).replaceAll("\n \\*", "\n").replaceAll(
+ "\n c", "\n");
+ return "<pre>" + javadoc + "</pre>\n";
+ }
+
+ /**
+ * @param method
+ * @param javadoc
+ * @return
+ */
+ private String[] parseParameterNames(Method method, String javadoc) {
+ int n = method.getParameterTypes().length;
+ String[] names = new String[n];
+ // this is the worst regex code I've ever written... I'm being lazy
+ int begin = javadoc.indexOf("METHOD SUMMARY");
+ Pattern pattern =
+ Pattern.compile("\\Q>" + method.getName() + "</A></B>(\\E");
+ Matcher matcher = pattern.matcher(javadoc);
+ boolean matched = matcher.find(begin);
+ assert matched;
+ // this begin is the real beginning of our search
+ begin = matcher.end();
+ // we need to cap the region to look at
+ pattern = Pattern.compile("\\Q)</CODE>\\E");
+ matcher = pattern.matcher(javadoc);
+ matched = matcher.find(begin);
+ assert matched;
+ int end = matcher.start();
+ pattern = Pattern.compile(" ([^,]*)(,|$)");
+ matcher = pattern.matcher(javadoc);
+ matcher.region(begin, end);
+ int cnt = 0;
+ while (matcher.find()) {
+ String name = matcher.group(1);
+ names[cnt] = name;
+ cnt++;
+ }
+ assert cnt == n;
+ return names;
+ // int n = method.getParameterTypes().length;
+ // String[] names = new String[n];
+ // for (int i = 0; i < n; i++) {
+ // names[i] = "arg" + (i + 1);
+ // }
+ // return names;
+ }
+
+ private String topWrapperLoader(String wrapperName) {
+ // use static initialisation
+ StringBuilder builder = new StringBuilder();
+ builder.append("\tstatic private final " + wrapperName + " current;\n");
+ builder.append("\tstatic {\n");
+ builder.append("\t\tLogger logger = Logger.getLogger(\"org.netlib." + wrapperName.toLowerCase() + "\");\n");
+ builder.append("\t\tif (Native" + wrapperName + ".INSTANCE.isLoaded) {\n");
+ builder.append("\t\t\tcurrent = Native" + wrapperName + ".INSTANCE;\n");
+ builder.append("\t\t\tlogger.config(\"Using JNI for " + wrapperName + "\");\n");
+ builder.append("\t\t} else {\n");
+ builder.append("\t\t\tcurrent = J" + wrapperName + ".INSTANCE;\n");
+ builder.append("\t\t\tlogger.config(\"Using F2J as JNI failed for " + wrapperName + "\");\n");
+ builder.append("\t\t}\n");
+
+ if ("LAPACK".equals(wrapperName)) {
+ // workaround bug 5
+ builder.append("\t\tcurrent.slamch(\"E\");\n");
+ builder.append("\t\tcurrent.dlamch(\"E\");\n");
+ }
+
+ builder.append("\t}\n\n");
+ builder.append("\tpublic static " + wrapperName + " getInstance() {\n");
+ builder.append("\t\treturn current;\n");
+ builder.append("\t}\n\n");
+
+// // leading dimension helper methods
+// builder.append("\t/**\n");
+// builder.append("\t * <code>max(1, M)</code> provided as a convenience for 'leading
+// dimension' calculations\n\t * \n");
+// builder.append("\t * @param n\n");
+// builder.append("\t */\n");
+// builder.append("\tstatic public int ld(int n) {\n");
+// builder.append("\t\treturn Math.max(1, n);\n");
+// builder.append("\t}\n");
+// builder.append("\t/**\n");
+// builder.append("\t * <code>max(1, max(M, N))</code> provided as a convenience for
+// 'leading dimension' calculations\n\t * \n");
+// builder.append("\t * @param m\n");
+// builder.append("\t * @param n\n");
+// builder.append("\t */\n");
+// builder.append("\tstatic public int ld(int m, int n) {\n");
+// builder.append("\t\treturn Math.max(1, Math.max(m, n));\n");
+// builder.append("\t}\n\n");
+
+ return builder.toString();
+
+ // the following is an alternative using lazy initialisation
+// StringBuilder builder = new StringBuilder();
+// builder.append("\tstatic private volatile " + wrapperName
+// + " current = null;\n\n");
+// builder.append("\tprivate static final Object currentLock = new Object();\n\n");
+// builder.append("\tpublic static final " + wrapperName
+// + " getInstance() {\n");
+// builder.append("\t\tsynchronized (currentLock) {\n");
+// builder.append("\t\t\t// synchronised lazy initialisation\n");
+// builder.append("\t\t\tif (current == null) {\n");
+// builder.append("\t\t\t\tLogger logger = Logger.getLogger(\"org.netlib\");\n");
+// builder.append("\t\t\t\t// test the JNI implementation\n");
+// builder.append("\t\t\t\tif (Native" + wrapperName
+// + ".INSTANCE.isLoaded) {\n");
+// builder.append("\t\t\t\t\tcurrent = Native" + wrapperName + ".INSTANCE;\n");
+// builder.append("\t\t\t\t\tlogger.info(\"Using JNI for " + wrapperName + "\");\n");
+// builder.append("\t\t\t\t} else {\n");
+// builder.append("\t\t\t\t\t// otherwise use F2J\n");
+// builder.append("\t\t\t\t\tcurrent = J" + wrapperName + ".INSTANCE;\n");
+// builder.append("\t\t\t\t\tlogger.info(\"Using F2J as JNI failed for "
+// + wrapperName + "\");\n");
+// builder.append("\t\t\t\t}\n");
+// builder.append("\t\t\t}\n");
+// builder.append("\t\t\treturn current;\n");
+// builder.append("\t\t}\n");
+// builder.append("\t}\n");
+// return builder.toString();
+ }
+
+ /**
+ * @param paramTypes
+ * @param names
+ * @return
+ */
+ private List<Doublet<String, String>> typeAndName(Class<?>[] paramTypes,
+ String[] names) {
+ assert names.length == paramTypes.length;
+ List<Doublet<String, String>> l =
+ new ArrayList<Doublet<String, String>>();
+ Class<?> lastType = Void.TYPE;
+ for (int i = 0; i < names.length; i++) {
+ Class<?> type = paramTypes[i];
+ if (type.equals(Integer.TYPE)
+ && (lastType.equals(double[].class)
+ || lastType.equals(int[].class)
+ || lastType.equals(boolean[].class) || lastType.equals(float[].class))) {
+ lastType = type;
+ continue;
+ }
+ String t = classDefs.get(type);
+ if (t == null)
+ t = "Object";
+ l.add(new Doublet<String, String>(t, names[i]));
+ lastType = type;
+ }
+ return l;
+ }
+}
diff --git a/src/org/netlib/lapack/JLAPACK.java b/src/org/netlib/lapack/JLAPACK.java
new file mode 100644
index 0000000..f5f43af
--- /dev/null
+++ b/src/org/netlib/lapack/JLAPACK.java
@@ -0,0 +1,3195 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.lapack;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * LAPACK provider implementation which uses F2J.
+ *
+ * @see http://sourceforge.net/projects/f2j
+ * @author Samuel Halliday
+ */
+final class JLAPACK extends LAPACK {
+
+ static final LAPACK INSTANCE = new JLAPACK();
+
+ private JLAPACK() {
+ }
+
+ @Override
+ public void dbdsdc(String uplo, String compq, int n, double[] d, double[] e, double[] u, int ldu, double[] vt, int ldvt, double[] q, int[] iq, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dbdsdc.dbdsdc(uplo, compq, n, d, 0, e, 0, u, 0, ldu, vt, 0, ldvt, q, 0, iq, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dbdsqr(String uplo, int n, int ncvt, int nru, int ncc, double[] d, double[] e, double[] vt, int ldvt, double[] u, int ldu, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dbdsqr.dbdsqr(uplo, n, ncvt, nru, ncc, d, 0, e, 0, vt, 0, ldvt, u, 0, ldu, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void ddisna(String job, int m, int n, double[] d, double[] sep, intW info) {
+ org.netlib.lapack.Ddisna.ddisna(job, m, n, d, 0, sep, 0, info);
+ }
+
+ @Override
+ public void dgbbrd(String vect, int m, int n, int ncc, int kl, int ku, double[] ab, int ldab, double[] d, double[] e, double[] q, int ldq, double[] pt, int ldpt, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dgbbrd.dgbbrd(vect, m, n, ncc, kl, ku, ab, 0, ldab, d, 0, e, 0, q, 0, ldq, pt, 0, ldpt, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dgbcon(String norm, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgbcon.dgbcon(norm, n, kl, ku, ab, 0, ldab, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgbequ(int m, int n, int kl, int ku, double[] ab, int ldab, double[] r, double[] c, doubleW rowcnd, doubleW colcnd, doubleW amax, intW info) {
+ org.netlib.lapack.Dgbequ.dgbequ(m, n, kl, ku, ab, 0, ldab, r, 0, c, 0, rowcnd, colcnd, amax, info);
+ }
+
+ @Override
+ public void dgbrfs(String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgbrfs.dgbrfs(trans, n, kl, ku, nrhs, ab, 0, ldab, afb, 0, ldafb, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgbsv(int n, int kl, int ku, int nrhs, double[] ab, int ldab, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dgbsv.dgbsv(n, kl, ku, nrhs, ab, 0, ldab, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dgbsvx(String fact, String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, int[] ipiv, StringW equed, double[] r, double[] c, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgbsvx.dgbsvx(fact, trans, n, kl, ku, nrhs, ab, 0, ldab, afb, 0, ldafb, ipiv, 0, equed, r, 0, c, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgbtf2(int m, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, intW info) {
+ org.netlib.lapack.Dgbtf2.dgbtf2(m, n, kl, ku, ab, 0, ldab, ipiv, 0, info);
+ }
+
+ @Override
+ public void dgbtrf(int m, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, intW info) {
+ org.netlib.lapack.Dgbtrf.dgbtrf(m, n, kl, ku, ab, 0, ldab, ipiv, 0, info);
+ }
+
+ @Override
+ public void dgbtrs(String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dgbtrs.dgbtrs(trans, n, kl, ku, nrhs, ab, 0, ldab, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dgebak(String job, String side, int n, int ilo, int ihi, double[] scale, int m, double[] v, int ldv, intW info) {
+ org.netlib.lapack.Dgebak.dgebak(job, side, n, ilo, ihi, scale, 0, m, v, 0, ldv, info);
+ }
+
+ @Override
+ public void dgebal(String job, int n, double[] a, int lda, intW ilo, intW ihi, double[] scale, intW info) {
+ org.netlib.lapack.Dgebal.dgebal(job, n, a, 0, lda, ilo, ihi, scale, 0, info);
+ }
+
+ @Override
+ public void dgebd2(int m, int n, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] work, intW info) {
+ org.netlib.lapack.Dgebd2.dgebd2(m, n, a, 0, lda, d, 0, e, 0, tauq, 0, taup, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgebrd(int m, int n, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgebrd.dgebrd(m, n, a, 0, lda, d, 0, e, 0, tauq, 0, taup, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgecon(String norm, int n, double[] a, int lda, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgecon.dgecon(norm, n, a, 0, lda, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgeequ(int m, int n, double[] a, int lda, double[] r, double[] c, doubleW rowcnd, doubleW colcnd, doubleW amax, intW info) {
+ org.netlib.lapack.Dgeequ.dgeequ(m, n, a, 0, lda, r, 0, c, 0, rowcnd, colcnd, amax, info);
+ }
+
+ @Override
+ public void dgeev(String jobvl, String jobvr, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgeev.dgeev(jobvl, jobvr, n, a, 0, lda, wr, 0, wi, 0, vl, 0, ldvl, vr, 0, ldvr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgeevx(String balanc, String jobvl, String jobvr, String sense, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, intW ilo, intW ihi, double[] scale, doubleW abnrm, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dgeevx.dgeevx(balanc, jobvl, jobvr, sense, n, a, 0, lda, wr, 0, wi, 0, vl, 0, ldvl, vr, 0, ldvr, ilo, ihi, scale, 0, abnrm, rconde, 0, rcondv, 0, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dgegs(String jobvsl, String jobvsr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vsl, int ldvsl, double[] vsr, int ldvsr, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgegs.dgegs(jobvsl, jobvsr, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vsl, 0, ldvsl, vsr, 0, ldvsr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgegv(String jobvl, String jobvr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgegv.dgegv(jobvl, jobvr, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vl, 0, ldvl, vr, 0, ldvr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgehd2(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dgehd2.dgehd2(n, ilo, ihi, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgehrd(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgehrd.dgehrd(n, ilo, ihi, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgelq2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dgelq2.dgelq2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgelqf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgelqf.dgelqf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgels(String trans, int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgels.dgels(trans, m, n, nrhs, a, 0, lda, b, 0, ldb, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgelsd(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] s, double rcond, intW rank, double[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dgelsd.dgelsd(m, n, nrhs, a, 0, lda, b, 0, ldb, s, 0, rcond, rank, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dgelss(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] s, double rcond, intW rank, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgelss.dgelss(m, n, nrhs, a, 0, lda, b, 0, ldb, s, 0, rcond, rank, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgelsx(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, int[] jpvt, double rcond, intW rank, double[] work, intW info) {
+ org.netlib.lapack.Dgelsx.dgelsx(m, n, nrhs, a, 0, lda, b, 0, ldb, jpvt, 0, rcond, rank, work, 0, info);
+ }
+
+ @Override
+ public void dgelsy(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, int[] jpvt, double rcond, intW rank, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgelsy.dgelsy(m, n, nrhs, a, 0, lda, b, 0, ldb, jpvt, 0, rcond, rank, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgeql2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dgeql2.dgeql2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgeqlf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgeqlf.dgeqlf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgeqp3(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgeqp3.dgeqp3(m, n, a, 0, lda, jpvt, 0, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgeqpf(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dgeqpf.dgeqpf(m, n, a, 0, lda, jpvt, 0, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgeqr2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dgeqr2.dgeqr2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgeqrf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgeqrf.dgeqrf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgerfs(String trans, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgerfs.dgerfs(trans, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgerq2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dgerq2.dgerq2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgerqf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgerqf.dgerqf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgesc2(int n, double[] a, int lda, double[] rhs, int[] ipiv, int[] jpiv, doubleW scale) {
+ org.netlib.lapack.Dgesc2.dgesc2(n, a, 0, lda, rhs, 0, ipiv, 0, jpiv, 0, scale);
+ }
+
+ @Override
+ public void dgesdd(String jobz, int m, int n, double[] a, int lda, double[] s, double[] u, int ldu, double[] vt, int ldvt, double[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dgesdd.dgesdd(jobz, m, n, a, 0, lda, s, 0, u, 0, ldu, vt, 0, ldvt, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dgesv(int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dgesv.dgesv(n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dgesvd(String jobu, String jobvt, int m, int n, double[] a, int lda, double[] s, double[] u, int ldu, double[] vt, int ldvt, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgesvd.dgesvd(jobu, jobvt, m, n, a, 0, lda, s, 0, u, 0, ldu, vt, 0, ldvt, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgesvx(String fact, String trans, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, StringW equed, double[] r, double[] c, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgesvx.dgesvx(fact, trans, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, equed, r, 0, c, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgetc2(int n, double[] a, int lda, int[] ipiv, int[] jpiv, intW info) {
+ org.netlib.lapack.Dgetc2.dgetc2(n, a, 0, lda, ipiv, 0, jpiv, 0, info);
+ }
+
+ @Override
+ public void dgetf2(int m, int n, double[] a, int lda, int[] ipiv, intW info) {
+ org.netlib.lapack.Dgetf2.dgetf2(m, n, a, 0, lda, ipiv, 0, info);
+ }
+
+ @Override
+ public void dgetrf(int m, int n, double[] a, int lda, int[] ipiv, intW info) {
+ org.netlib.lapack.Dgetrf.dgetrf(m, n, a, 0, lda, ipiv, 0, info);
+ }
+
+ @Override
+ public void dgetri(int n, double[] a, int lda, int[] ipiv, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgetri.dgetri(n, a, 0, lda, ipiv, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgetrs(String trans, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dgetrs.dgetrs(trans, n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dggbak(String job, String side, int n, int ilo, int ihi, double[] lscale, double[] rscale, int m, double[] v, int ldv, intW info) {
+ org.netlib.lapack.Dggbak.dggbak(job, side, n, ilo, ihi, lscale, 0, rscale, 0, m, v, 0, ldv, info);
+ }
+
+ @Override
+ public void dggbal(String job, int n, double[] a, int lda, double[] b, int ldb, intW ilo, intW ihi, double[] lscale, double[] rscale, double[] work, intW info) {
+ org.netlib.lapack.Dggbal.dggbal(job, n, a, 0, lda, b, 0, ldb, ilo, ihi, lscale, 0, rscale, 0, work, 0, info);
+ }
+
+ @Override
+ public void dggev(String jobvl, String jobvr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dggev.dggev(jobvl, jobvr, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vl, 0, ldvl, vr, 0, ldvr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dggevx(String balanc, String jobvl, String jobvr, String sense, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, intW ilo, intW ihi, double[] lscale, double[] rscale, doubleW abnrm, doubleW bbnrm, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Dggevx.dggevx(balanc, jobvl, jobvr, sense, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vl, 0, ldvl, vr, 0, ldvr, ilo, ihi, lscale, 0, rscale, 0, abnrm, bbnrm, rconde, 0, rcondv, 0, work, 0, lwork, iwork, 0, bwork, 0, info);
+ }
+
+ @Override
+ public void dggglm(int n, int m, int p, double[] a, int lda, double[] b, int ldb, double[] d, double[] x, double[] y, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dggglm.dggglm(n, m, p, a, 0, lda, b, 0, ldb, d, 0, x, 0, y, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dgghrd(String compq, String compz, int n, int ilo, int ihi, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, intW info) {
+ org.netlib.lapack.Dgghrd.dgghrd(compq, compz, n, ilo, ihi, a, 0, lda, b, 0, ldb, q, 0, ldq, z, 0, ldz, info);
+ }
+
+ @Override
+ public void dgglse(int m, int n, int p, double[] a, int lda, double[] b, int ldb, double[] c, double[] d, double[] x, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dgglse.dgglse(m, n, p, a, 0, lda, b, 0, ldb, c, 0, d, 0, x, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dggqrf(int n, int m, int p, double[] a, int lda, double[] taua, double[] b, int ldb, double[] taub, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dggqrf.dggqrf(n, m, p, a, 0, lda, taua, 0, b, 0, ldb, taub, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dggrqf(int m, int p, int n, double[] a, int lda, double[] taua, double[] b, int ldb, double[] taub, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dggrqf.dggrqf(m, p, n, a, 0, lda, taua, 0, b, 0, ldb, taub, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dggsvd(String jobu, String jobv, String jobq, int m, int n, int p, intW k, intW l, double[] a, int lda, double[] b, int ldb, double[] alpha, double[] beta, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dggsvd.dggsvd(jobu, jobv, jobq, m, n, p, k, l, a, 0, lda, b, 0, ldb, alpha, 0, beta, 0, u, 0, ldu, v, 0, ldv, q, 0, ldq, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dggsvp(String jobu, String jobv, String jobq, int m, int p, int n, double[] a, int lda, double[] b, int ldb, double tola, double tolb, intW k, intW l, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, int[] iwork, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dggsvp.dggsvp(jobu, jobv, jobq, m, p, n, a, 0, lda, b, 0, ldb, tola, tolb, k, l, u, 0, ldu, v, 0, ldv, q, 0, ldq, iwork, 0, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dgtcon(String norm, int n, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgtcon.dgtcon(norm, n, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgtrfs(String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] dlf, double[] df, double[] duf, double[] du2, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgtrfs.dgtrfs(trans, n, nrhs, dl, 0, d, 0, du, 0, dlf, 0, df, 0, duf, 0, du2, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgtsv(int n, int nrhs, double[] dl, double[] d, double[] du, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dgtsv.dgtsv(n, nrhs, dl, 0, d, 0, du, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dgtsvx(String fact, String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] dlf, double[] df, double[] duf, double[] du2, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dgtsvx.dgtsvx(fact, trans, n, nrhs, dl, 0, d, 0, du, 0, dlf, 0, df, 0, duf, 0, du2, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dgttrf(int n, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, intW info) {
+ org.netlib.lapack.Dgttrf.dgttrf(n, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, info);
+ }
+
+ @Override
+ public void dgttrs(String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dgttrs.dgttrs(trans, n, nrhs, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dgtts2(int itrans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double[] b, int ldb) {
+ org.netlib.lapack.Dgtts2.dgtts2(itrans, n, nrhs, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, b, 0, ldb);
+ }
+
+ @Override
+ public void dhgeqz(String job, String compq, String compz, int n, int ilo, int ihi, double[] h, int ldh, double[] t, int ldt, double[] alphar, double[] alphai, double[] beta, double[] q, int ldq, double[] z, int ldz, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dhgeqz.dhgeqz(job, compq, compz, n, ilo, ihi, h, 0, ldh, t, 0, ldt, alphar, 0, alphai, 0, beta, 0, q, 0, ldq, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dhsein(String side, String eigsrc, String initv, boolean[] select, int n, double[] h, int ldh, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, int[] ifaill, int[] ifailr, intW info) {
+ org.netlib.lapack.Dhsein.dhsein(side, eigsrc, initv, select, 0, n, h, 0, ldh, wr, 0, wi, 0, vl, 0, ldvl, vr, 0, ldvr, mm, m, work, 0, ifaill, 0, ifailr, 0, info);
+ }
+
+ @Override
+ public void dhseqr(String job, String compz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, double[] z, int ldz, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dhseqr.dhseqr(job, compz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dlabad(doubleW small, doubleW large) {
+ org.netlib.lapack.Dlabad.dlabad(small, large);
+ }
+
+ @Override
+ public void dlabrd(int m, int n, int nb, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] x, int ldx, double[] y, int ldy) {
+ org.netlib.lapack.Dlabrd.dlabrd(m, n, nb, a, 0, lda, d, 0, e, 0, tauq, 0, taup, 0, x, 0, ldx, y, 0, ldy);
+ }
+
+ @Override
+ public void dlacon(int n, double[] v, double[] x, int[] isgn, doubleW est, intW kase) {
+ org.netlib.lapack.Dlacon.dlacon(n, v, 0, x, 0, isgn, 0, est, kase);
+ }
+
+ @Override
+ public void dlacpy(String uplo, int m, int n, double[] a, int lda, double[] b, int ldb) {
+ org.netlib.lapack.Dlacpy.dlacpy(uplo, m, n, a, 0, lda, b, 0, ldb);
+ }
+
+ @Override
+ public void dladiv(double a, double b, double c, double d, doubleW p, doubleW q) {
+ org.netlib.lapack.Dladiv.dladiv(a, b, c, d, p, q);
+ }
+
+ @Override
+ public void dlae2(double a, double b, double c, doubleW rt1, doubleW rt2) {
+ org.netlib.lapack.Dlae2.dlae2(a, b, c, rt1, rt2);
+ }
+
+ @Override
+ public void dlaebz(int ijob, int nitmax, int n, int mmax, int minp, int nbmin, double abstol, double reltol, double pivmin, double[] d, double[] e, double[] e2, int[] nval, double[] ab, double[] c, intW mout, int[] nab, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlaebz.dlaebz(ijob, nitmax, n, mmax, minp, nbmin, abstol, reltol, pivmin, d, 0, e, 0, e2, 0, nval, 0, ab, 0, c, 0, mout, nab, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlaed0(int icompq, int qsiz, int n, double[] d, double[] e, double[] q, int ldq, double[] qstore, int ldqs, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlaed0.dlaed0(icompq, qsiz, n, d, 0, e, 0, q, 0, ldq, qstore, 0, ldqs, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlaed1(int n, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlaed1.dlaed1(n, d, 0, q, 0, ldq, indxq, 0, rho, cutpnt, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlaed2(intW k, int n, int n1, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, double[] z, double[] dlamda, double[] w, double[] q2, int[] indx, int[] indxc, int[] indxp, int[] coltyp, intW info) {
+ org.netlib.lapack.Dlaed2.dlaed2(k, n, n1, d, 0, q, 0, ldq, indxq, 0, rho, z, 0, dlamda, 0, w, 0, q2, 0, indx, 0, indxc, 0, indxp, 0, coltyp, 0, info);
+ }
+
+ @Override
+ public void dlaed3(int k, int n, int n1, double[] d, double[] q, int ldq, double rho, double[] dlamda, double[] q2, int[] indx, int[] ctot, double[] w, double[] s, intW info) {
+ org.netlib.lapack.Dlaed3.dlaed3(k, n, n1, d, 0, q, 0, ldq, rho, dlamda, 0, q2, 0, indx, 0, ctot, 0, w, 0, s, 0, info);
+ }
+
+ @Override
+ public void dlaed4(int n, int i, double[] d, double[] z, double[] delta, double rho, doubleW dlam, intW info) {
+ org.netlib.lapack.Dlaed4.dlaed4(n, i, d, 0, z, 0, delta, 0, rho, dlam, info);
+ }
+
+ @Override
+ public void dlaed5(int i, double[] d, double[] z, double[] delta, double rho, doubleW dlam) {
+ org.netlib.lapack.Dlaed5.dlaed5(i, d, 0, z, 0, delta, 0, rho, dlam);
+ }
+
+ @Override
+ public void dlaed6(int kniter, boolean orgati, double rho, double[] d, double[] z, double finit, doubleW tau, intW info) {
+ org.netlib.lapack.Dlaed6.dlaed6(kniter, orgati, rho, d, 0, z, 0, finit, tau, info);
+ }
+
+ @Override
+ public void dlaed7(int icompq, int n, int qsiz, int tlvls, int curlvl, int curpbm, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] qstore, int[] qptr, int[] prmptr, int[] perm, int[] givptr, int[] givcol, double[] givnum, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlaed7.dlaed7(icompq, n, qsiz, tlvls, curlvl, curpbm, d, 0, q, 0, ldq, indxq, 0, rho, cutpnt, qstore, 0, qptr, 0, prmptr, 0, perm, 0, givptr, 0, givcol, 0, givnum, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlaed8(int icompq, intW k, int n, int qsiz, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] z, double[] dlamda, double[] q2, int ldq2, double[] w, int[] perm, intW givptr, int[] givcol, double[] givnum, int[] indxp, int[] indx, intW info) {
+ org.netlib.lapack.Dlaed8.dlaed8(icompq, k, n, qsiz, d, 0, q, 0, ldq, indxq, 0, rho, cutpnt, z, 0, dlamda, 0, q2, 0, ldq2, w, 0, perm, 0, givptr, givcol, 0, givnum, 0, indxp, 0, indx, 0, info);
+ }
+
+ @Override
+ public void dlaed9(int k, int kstart, int kstop, int n, double[] d, double[] q, int ldq, double rho, double[] dlamda, double[] w, double[] s, int lds, intW info) {
+ org.netlib.lapack.Dlaed9.dlaed9(k, kstart, kstop, n, d, 0, q, 0, ldq, rho, dlamda, 0, w, 0, s, 0, lds, info);
+ }
+
+ @Override
+ public void dlaeda(int n, int tlvls, int curlvl, int curpbm, int[] prmptr, int[] perm, int[] givptr, int[] givcol, double[] givnum, double[] q, int[] qptr, double[] z, double[] ztemp, intW info) {
+ org.netlib.lapack.Dlaeda.dlaeda(n, tlvls, curlvl, curpbm, prmptr, 0, perm, 0, givptr, 0, givcol, 0, givnum, 0, q, 0, qptr, 0, z, 0, ztemp, 0, info);
+ }
+
+ @Override
+ public void dlaein(boolean rightv, boolean noinit, int n, double[] h, int ldh, double wr, double wi, double[] vr, double[] vi, double[] b, int ldb, double[] work, double eps3, double smlnum, double bignum, intW info) {
+ org.netlib.lapack.Dlaein.dlaein(rightv, noinit, n, h, 0, ldh, wr, wi, vr, 0, vi, 0, b, 0, ldb, work, 0, eps3, smlnum, bignum, info);
+ }
+
+ @Override
+ public void dlaev2(double a, double b, double c, doubleW rt1, doubleW rt2, doubleW cs1, doubleW sn1) {
+ org.netlib.lapack.Dlaev2.dlaev2(a, b, c, rt1, rt2, cs1, sn1);
+ }
+
+ @Override
+ public void dlaexc(boolean wantq, int n, double[] t, int ldt, double[] q, int ldq, int j1, int n1, int n2, double[] work, intW info) {
+ org.netlib.lapack.Dlaexc.dlaexc(wantq, n, t, 0, ldt, q, 0, ldq, j1, n1, n2, work, 0, info);
+ }
+
+ @Override
+ public void dlag2(double[] a, int lda, double[] b, int ldb, double safmin, doubleW scale1, doubleW scale2, doubleW wr1, doubleW wr2, doubleW wi) {
+ org.netlib.lapack.Dlag2.dlag2(a, 0, lda, b, 0, ldb, safmin, scale1, scale2, wr1, wr2, wi);
+ }
+
+ @Override
+ public void dlags2(boolean upper, double a1, double a2, double a3, double b1, double b2, double b3, doubleW csu, doubleW snu, doubleW csv, doubleW snv, doubleW csq, doubleW snq) {
+ org.netlib.lapack.Dlags2.dlags2(upper, a1, a2, a3, b1, b2, b3, csu, snu, csv, snv, csq, snq);
+ }
+
+ @Override
+ public void dlagtf(int n, double[] a, double lambda, double[] b, double[] c, double tol, double[] d, int[] in, intW info) {
+ org.netlib.lapack.Dlagtf.dlagtf(n, a, 0, lambda, b, 0, c, 0, tol, d, 0, in, 0, info);
+ }
+
+ @Override
+ public void dlagtm(String trans, int n, int nrhs, double alpha, double[] dl, double[] d, double[] du, double[] x, int ldx, double beta, double[] b, int ldb) {
+ org.netlib.lapack.Dlagtm.dlagtm(trans, n, nrhs, alpha, dl, 0, d, 0, du, 0, x, 0, ldx, beta, b, 0, ldb);
+ }
+
+ @Override
+ public void dlagts(int job, int n, double[] a, double[] b, double[] c, double[] d, int[] in, double[] y, doubleW tol, intW info) {
+ org.netlib.lapack.Dlagts.dlagts(job, n, a, 0, b, 0, c, 0, d, 0, in, 0, y, 0, tol, info);
+ }
+
+ @Override
+ public void dlagv2(double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, doubleW csl, doubleW snl, doubleW csr, doubleW snr) {
+ org.netlib.lapack.Dlagv2.dlagv2(a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, csl, snl, csr, snr);
+ }
+
+ @Override
+ public void dlahqr(boolean wantt, boolean wantz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, int iloz, int ihiz, double[] z, int ldz, intW info) {
+ org.netlib.lapack.Dlahqr.dlahqr(wantt, wantz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, iloz, ihiz, z, 0, ldz, info);
+ }
+
+ @Override
+ public void dlahrd(int n, int k, int nb, double[] a, int lda, double[] tau, double[] t, int ldt, double[] y, int ldy) {
+ org.netlib.lapack.Dlahrd.dlahrd(n, k, nb, a, 0, lda, tau, 0, t, 0, ldt, y, 0, ldy);
+ }
+
+ @Override
+ public void dlaic1(int job, int j, double[] x, double sest, double[] w, double gamma, doubleW sestpr, doubleW s, doubleW c) {
+ org.netlib.lapack.Dlaic1.dlaic1(job, j, x, 0, sest, w, 0, gamma, sestpr, s, c);
+ }
+
+ @Override
+ public void dlaln2(boolean ltrans, int na, int nw, double smin, double ca, double[] a, int lda, double d1, double d2, double[] b, int ldb, double wr, double wi, double[] x, int ldx, doubleW scale, doubleW xnorm, intW info) {
+ org.netlib.lapack.Dlaln2.dlaln2(ltrans, na, nw, smin, ca, a, 0, lda, d1, d2, b, 0, ldb, wr, wi, x, 0, ldx, scale, xnorm, info);
+ }
+
+ @Override
+ public void dlals0(int icompq, int nl, int nr, int sqre, int nrhs, double[] b, int ldb, double[] bx, int ldbx, int[] perm, int givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, double[] poles, double[] difl, double[] difr, double[] z, int k, double c, double s, double[] work, intW info) {
+ org.netlib.lapack.Dlals0.dlals0(icompq, nl, nr, sqre, nrhs, b, 0, ldb, bx, 0, ldbx, perm, 0, givptr, givcol, 0, ldgcol, givnum, 0, ldgnum, poles, 0, difl, 0, difr, 0, z, 0, k, c, s, work, 0, info);
+ }
+
+ @Override
+ public void dlalsa(int icompq, int smlsiz, int n, int nrhs, double[] b, int ldb, double[] bx, int ldbx, double[] u, int ldu, double[] vt, int[] k, double[] difl, double[] difr, double[] z, double[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, double[] givnum, double[] c, double[] s, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlalsa.dlalsa(icompq, smlsiz, n, nrhs, b, 0, ldb, bx, 0, ldbx, u, 0, ldu, vt, 0, k, 0, difl, 0, difr, 0, z, 0, poles, 0, givptr, 0, givcol, 0, ldgcol, perm, 0, givnum, 0, c, 0, s, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlalsd(String uplo, int smlsiz, int n, int nrhs, double[] d, double[] e, double[] b, int ldb, double rcond, intW rank, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlalsd.dlalsd(uplo, smlsiz, n, nrhs, d, 0, e, 0, b, 0, ldb, rcond, rank, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlamrg(int n1, int n2, double[] a, int dtrd1, int dtrd2, int[] index) {
+ org.netlib.lapack.Dlamrg.dlamrg(n1, n2, a, 0, dtrd1, dtrd2, index, 0);
+ }
+
+ @Override
+ public void dlanv2(doubleW a, doubleW b, doubleW c, doubleW d, doubleW rt1r, doubleW rt1i, doubleW rt2r, doubleW rt2i, doubleW cs, doubleW sn) {
+ org.netlib.lapack.Dlanv2.dlanv2(a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn);
+ }
+
+ @Override
+ public void dlapll(int n, double[] x, int incx, double[] y, int incy, doubleW ssmin) {
+ org.netlib.lapack.Dlapll.dlapll(n, x, 0, incx, y, 0, incy, ssmin);
+ }
+
+ @Override
+ public void dlapmt(boolean forwrd, int m, int n, double[] x, int ldx, int[] k) {
+ org.netlib.lapack.Dlapmt.dlapmt(forwrd, m, n, x, 0, ldx, k, 0);
+ }
+
+ @Override
+ public void dlaqgb(int m, int n, int kl, int ku, double[] ab, int ldab, double[] r, double[] c, double rowcnd, double colcnd, double amax, StringW equed) {
+ org.netlib.lapack.Dlaqgb.dlaqgb(m, n, kl, ku, ab, 0, ldab, r, 0, c, 0, rowcnd, colcnd, amax, equed);
+ }
+
+ @Override
+ public void dlaqge(int m, int n, double[] a, int lda, double[] r, double[] c, double rowcnd, double colcnd, double amax, StringW equed) {
+ org.netlib.lapack.Dlaqge.dlaqge(m, n, a, 0, lda, r, 0, c, 0, rowcnd, colcnd, amax, equed);
+ }
+
+ @Override
+ public void dlaqp2(int m, int n, int offset, double[] a, int lda, int[] jpvt, double[] tau, double[] vn1, double[] vn2, double[] work) {
+ org.netlib.lapack.Dlaqp2.dlaqp2(m, n, offset, a, 0, lda, jpvt, 0, tau, 0, vn1, 0, vn2, 0, work, 0);
+ }
+
+ @Override
+ public void dlaqps(int m, int n, int offset, int nb, intW kb, double[] a, int lda, int[] jpvt, double[] tau, double[] vn1, double[] vn2, double[] auxv, double[] f, int ldf) {
+ org.netlib.lapack.Dlaqps.dlaqps(m, n, offset, nb, kb, a, 0, lda, jpvt, 0, tau, 0, vn1, 0, vn2, 0, auxv, 0, f, 0, ldf);
+ }
+
+ @Override
+ public void dlaqsb(String uplo, int n, int kd, double[] ab, int ldab, double[] s, double scond, double amax, StringW equed) {
+ org.netlib.lapack.Dlaqsb.dlaqsb(uplo, n, kd, ab, 0, ldab, s, 0, scond, amax, equed);
+ }
+
+ @Override
+ public void dlaqsp(String uplo, int n, double[] ap, double[] s, double scond, double amax, StringW equed) {
+ org.netlib.lapack.Dlaqsp.dlaqsp(uplo, n, ap, 0, s, 0, scond, amax, equed);
+ }
+
+ @Override
+ public void dlaqsy(String uplo, int n, double[] a, int lda, double[] s, double scond, double amax, StringW equed) {
+ org.netlib.lapack.Dlaqsy.dlaqsy(uplo, n, a, 0, lda, s, 0, scond, amax, equed);
+ }
+
+ @Override
+ public void dlaqtr(boolean ltran, boolean lreal, int n, double[] t, int ldt, double[] b, double w, doubleW scale, double[] x, double[] work, intW info) {
+ org.netlib.lapack.Dlaqtr.dlaqtr(ltran, lreal, n, t, 0, ldt, b, 0, w, scale, x, 0, work, 0, info);
+ }
+
+ @Override
+ public void dlar2v(int n, double[] x, double[] y, double[] z, int incx, double[] c, double[] s, int incc) {
+ org.netlib.lapack.Dlar2v.dlar2v(n, x, 0, y, 0, z, 0, incx, c, 0, s, 0, incc);
+ }
+
+ @Override
+ public void dlarf(String side, int m, int n, double[] v, int incv, double tau, double[] c, int Ldc, double[] work) {
+ org.netlib.lapack.Dlarf.dlarf(side, m, n, v, 0, incv, tau, c, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void dlarfb(String side, String trans, String direct, String storev, int m, int n, int k, double[] v, int ldv, double[] t, int ldt, double[] c, int Ldc, double[] work, int ldwork) {
+ org.netlib.lapack.Dlarfb.dlarfb(side, trans, direct, storev, m, n, k, v, 0, ldv, t, 0, ldt, c, 0, Ldc, work, 0, ldwork);
+ }
+
+ @Override
+ public void dlarfg(int n, doubleW alpha, double[] x, int incx, doubleW tau) {
+ org.netlib.lapack.Dlarfg.dlarfg(n, alpha, x, 0, incx, tau);
+ }
+
+ @Override
+ public void dlarft(String direct, String storev, int n, int k, double[] v, int ldv, double[] tau, double[] t, int ldt) {
+ org.netlib.lapack.Dlarft.dlarft(direct, storev, n, k, v, 0, ldv, tau, 0, t, 0, ldt);
+ }
+
+ @Override
+ public void dlarfx(String side, int m, int n, double[] v, double tau, double[] c, int Ldc, double[] work) {
+ org.netlib.lapack.Dlarfx.dlarfx(side, m, n, v, 0, tau, c, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void dlargv(int n, double[] x, int incx, double[] y, int incy, double[] c, int incc) {
+ org.netlib.lapack.Dlargv.dlargv(n, x, 0, incx, y, 0, incy, c, 0, incc);
+ }
+
+ @Override
+ public void dlarnv(int idist, int[] iseed, int n, double[] x) {
+ org.netlib.lapack.Dlarnv.dlarnv(idist, iseed, 0, n, x, 0);
+ }
+
+ @Override
+ public void dlartg(double f, double g, doubleW cs, doubleW sn, doubleW r) {
+ org.netlib.lapack.Dlartg.dlartg(f, g, cs, sn, r);
+ }
+
+ @Override
+ public void dlartv(int n, double[] x, int incx, double[] y, int incy, double[] c, double[] s, int incc) {
+ org.netlib.lapack.Dlartv.dlartv(n, x, 0, incx, y, 0, incy, c, 0, s, 0, incc);
+ }
+
+ @Override
+ public void dlaruv(int[] iseed, int n, double[] x) {
+ org.netlib.lapack.Dlaruv.dlaruv(iseed, 0, n, x, 0);
+ }
+
+ @Override
+ public void dlarz(String side, int m, int n, int l, double[] v, int incv, double tau, double[] c, int Ldc, double[] work) {
+ org.netlib.lapack.Dlarz.dlarz(side, m, n, l, v, 0, incv, tau, c, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void dlarzb(String side, String trans, String direct, String storev, int m, int n, int k, int l, double[] v, int ldv, double[] t, int ldt, double[] c, int Ldc, double[] work, int ldwork) {
+ org.netlib.lapack.Dlarzb.dlarzb(side, trans, direct, storev, m, n, k, l, v, 0, ldv, t, 0, ldt, c, 0, Ldc, work, 0, ldwork);
+ }
+
+ @Override
+ public void dlarzt(String direct, String storev, int n, int k, double[] v, int ldv, double[] tau, double[] t, int ldt) {
+ org.netlib.lapack.Dlarzt.dlarzt(direct, storev, n, k, v, 0, ldv, tau, 0, t, 0, ldt);
+ }
+
+ @Override
+ public void dlas2(double f, double g, double h, doubleW ssmin, doubleW ssmax) {
+ org.netlib.lapack.Dlas2.dlas2(f, g, h, ssmin, ssmax);
+ }
+
+ @Override
+ public void dlascl(String type, int kl, int ku, double cfrom, double cto, int m, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dlascl.dlascl(type, kl, ku, cfrom, cto, m, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dlasd0(int n, int sqre, double[] d, double[] e, double[] u, int ldu, double[] vt, int ldvt, int smlsiz, int[] iwork, double[] work, intW info) {
+ org.netlib.lapack.Dlasd0.dlasd0(n, sqre, d, 0, e, 0, u, 0, ldu, vt, 0, ldvt, smlsiz, iwork, 0, work, 0, info);
+ }
+
+ @Override
+ public void dlasd1(int nl, int nr, int sqre, double[] d, doubleW alpha, doubleW beta, double[] u, int ldu, double[] vt, int ldvt, int[] idxq, int[] iwork, double[] work, intW info) {
+ org.netlib.lapack.Dlasd1.dlasd1(nl, nr, sqre, d, 0, alpha, beta, u, 0, ldu, vt, 0, ldvt, idxq, 0, iwork, 0, work, 0, info);
+ }
+
+ @Override
+ public void dlasd2(int nl, int nr, int sqre, intW k, double[] d, double[] z, double alpha, double beta, double[] u, int ldu, double[] vt, int ldvt, double[] dsigma, double[] u2, int ldu2, double[] vt2, int ldvt2, int[] idxp, int[] idx, int[] idxc, int[] idxq, int[] coltyp, intW info) {
+ org.netlib.lapack.Dlasd2.dlasd2(nl, nr, sqre, k, d, 0, z, 0, alpha, beta, u, 0, ldu, vt, 0, ldvt, dsigma, 0, u2, 0, ldu2, vt2, 0, ldvt2, idxp, 0, idx, 0, idxc, 0, idxq, 0, coltyp, 0, info);
+ }
+
+ @Override
+ public void dlasd3(int nl, int nr, int sqre, int k, double[] d, double[] q, int ldq, double[] dsigma, double[] u, int ldu, double[] u2, int ldu2, double[] vt, int ldvt, double[] vt2, int ldvt2, int[] idxc, int[] ctot, double[] z, intW info) {
+ org.netlib.lapack.Dlasd3.dlasd3(nl, nr, sqre, k, d, 0, q, 0, ldq, dsigma, 0, u, 0, ldu, u2, 0, ldu2, vt, 0, ldvt, vt2, 0, ldvt2, idxc, 0, ctot, 0, z, 0, info);
+ }
+
+ @Override
+ public void dlasd4(int n, int i, double[] d, double[] z, double[] delta, double rho, doubleW sigma, double[] work, intW info) {
+ org.netlib.lapack.Dlasd4.dlasd4(n, i, d, 0, z, 0, delta, 0, rho, sigma, work, 0, info);
+ }
+
+ @Override
+ public void dlasd5(int i, double[] d, double[] z, double[] delta, double rho, doubleW dsigma, double[] work) {
+ org.netlib.lapack.Dlasd5.dlasd5(i, d, 0, z, 0, delta, 0, rho, dsigma, work, 0);
+ }
+
+ @Override
+ public void dlasd6(int icompq, int nl, int nr, int sqre, double[] d, double[] vf, double[] vl, doubleW alpha, doubleW beta, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, double[] poles, double[] difl, double[] difr, double[] z, intW k, doubleW c, doubleW s, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlasd6.dlasd6(icompq, nl, nr, sqre, d, 0, vf, 0, vl, 0, alpha, beta, idxq, 0, perm, 0, givptr, givcol, 0, ldgcol, givnum, 0, ldgnum, poles, 0, difl, 0, difr, 0, z, 0, k, c, s, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlasd7(int icompq, int nl, int nr, int sqre, intW k, double[] d, double[] z, double[] zw, double[] vf, double[] vfw, double[] vl, double[] vlw, double alpha, double beta, double[] dsigma, int[] idx, int[] idxp, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, doubleW c, doubleW s, intW info) {
+ org.netlib.lapack.Dlasd7.dlasd7(icompq, nl, nr, sqre, k, d, 0, z, 0, zw, 0, vf, 0, vfw, 0, vl, 0, vlw, 0, alpha, beta, dsigma, 0, idx, 0, idxp, 0, idxq, 0, perm, 0, givptr, givcol, 0, ldgcol, givnum, 0, ldgnum, c, s, info);
+ }
+
+ @Override
+ public void dlasd8(int icompq, int k, double[] d, double[] z, double[] vf, double[] vl, double[] difl, double[] difr, int lddifr, double[] dsigma, double[] work, intW info) {
+ org.netlib.lapack.Dlasd8.dlasd8(icompq, k, d, 0, z, 0, vf, 0, vl, 0, difl, 0, difr, 0, lddifr, dsigma, 0, work, 0, info);
+ }
+
+ @Override
+ public void dlasda(int icompq, int smlsiz, int n, int sqre, double[] d, double[] e, double[] u, int ldu, double[] vt, int[] k, double[] difl, double[] difr, double[] z, double[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, double[] givnum, double[] c, double[] s, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlasda.dlasda(icompq, smlsiz, n, sqre, d, 0, e, 0, u, 0, ldu, vt, 0, k, 0, difl, 0, difr, 0, z, 0, poles, 0, givptr, 0, givcol, 0, ldgcol, perm, 0, givnum, 0, c, 0, s, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dlasdq(String uplo, int sqre, int n, int ncvt, int nru, int ncc, double[] d, double[] e, double[] vt, int ldvt, double[] u, int ldu, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dlasdq.dlasdq(uplo, sqre, n, ncvt, nru, ncc, d, 0, e, 0, vt, 0, ldvt, u, 0, ldu, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dlasdt(int n, intW lvl, intW nd, int[] inode, int[] ndiml, int[] ndimr, int msub) {
+ org.netlib.lapack.Dlasdt.dlasdt(n, lvl, nd, inode, 0, ndiml, 0, ndimr, 0, msub);
+ }
+
+ @Override
+ public void dlaset(String uplo, int m, int n, double alpha, double beta, double[] a, int lda) {
+ org.netlib.lapack.Dlaset.dlaset(uplo, m, n, alpha, beta, a, 0, lda);
+ }
+
+ @Override
+ public void dlasq1(int n, double[] d, double[] e, double[] work, intW info) {
+ org.netlib.lapack.Dlasq1.dlasq1(n, d, 0, e, 0, work, 0, info);
+ }
+
+ @Override
+ public void dlasq2(int n, double[] z, intW info) {
+ org.netlib.lapack.Dlasq2.dlasq2(n, z, 0, info);
+ }
+
+ @Override
+ public void dlasq3(int i0, intW n0, double[] z, int pp, doubleW dmin, doubleW sigma, doubleW desig, doubleW qmax, intW nfail, intW iter, intW ndiv, boolean ieee) {
+ org.netlib.lapack.Dlasq3.dlasq3(i0, n0, z, 0, pp, dmin, sigma, desig, qmax, nfail, iter, ndiv, ieee);
+ }
+
+ @Override
+ public void dlasq4(int i0, int n0, double[] z, int pp, int n0in, double dmin, double dmin1, double dmin2, double dn, double dn1, double dn2, doubleW tau, intW ttype) {
+ org.netlib.lapack.Dlasq4.dlasq4(i0, n0, z, 0, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, tau, ttype);
+ }
+
+ @Override
+ public void dlasq5(int i0, int n0, double[] z, int pp, double tau, doubleW dmin, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dnm1, doubleW dnm2, boolean ieee) {
+ org.netlib.lapack.Dlasq5.dlasq5(i0, n0, z, 0, pp, tau, dmin, dmin1, dmin2, dn, dnm1, dnm2, ieee);
+ }
+
+ @Override
+ public void dlasq6(int i0, int n0, double[] z, int pp, doubleW dmin, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dnm1, doubleW dnm2) {
+ org.netlib.lapack.Dlasq6.dlasq6(i0, n0, z, 0, pp, dmin, dmin1, dmin2, dn, dnm1, dnm2);
+ }
+
+ @Override
+ public void dlasr(String side, String pivot, String direct, int m, int n, double[] c, double[] s, double[] a, int lda) {
+ org.netlib.lapack.Dlasr.dlasr(side, pivot, direct, m, n, c, 0, s, 0, a, 0, lda);
+ }
+
+ @Override
+ public void dlasrt(String id, int n, double[] d, intW info) {
+ org.netlib.lapack.Dlasrt.dlasrt(id, n, d, 0, info);
+ }
+
+ @Override
+ public void dlassq(int n, double[] x, int incx, doubleW scale, doubleW sumsq) {
+ org.netlib.lapack.Dlassq.dlassq(n, x, 0, incx, scale, sumsq);
+ }
+
+ @Override
+ public void dlasv2(double f, double g, double h, doubleW ssmin, doubleW ssmax, doubleW snr, doubleW csr, doubleW snl, doubleW csl) {
+ org.netlib.lapack.Dlasv2.dlasv2(f, g, h, ssmin, ssmax, snr, csr, snl, csl);
+ }
+
+ @Override
+ public void dlaswp(int n, double[] a, int lda, int k1, int k2, int[] ipiv, int incx) {
+ org.netlib.lapack.Dlaswp.dlaswp(n, a, 0, lda, k1, k2, ipiv, 0, incx);
+ }
+
+ @Override
+ public void dlasy2(boolean ltranl, boolean ltranr, int isgn, int n1, int n2, double[] tl, int ldtl, double[] tr, int ldtr, double[] b, int ldb, doubleW scale, double[] x, int ldx, doubleW xnorm, intW info) {
+ org.netlib.lapack.Dlasy2.dlasy2(ltranl, ltranr, isgn, n1, n2, tl, 0, ldtl, tr, 0, ldtr, b, 0, ldb, scale, x, 0, ldx, xnorm, info);
+ }
+
+ @Override
+ public void dlasyf(String uplo, int n, int nb, intW kb, double[] a, int lda, int[] ipiv, double[] w, int ldw, intW info) {
+ org.netlib.lapack.Dlasyf.dlasyf(uplo, n, nb, kb, a, 0, lda, ipiv, 0, w, 0, ldw, info);
+ }
+
+ @Override
+ public void dlatbs(String uplo, String trans, String diag, String normin, int n, int kd, double[] ab, int ldab, double[] x, doubleW scale, double[] cnorm, intW info) {
+ org.netlib.lapack.Dlatbs.dlatbs(uplo, trans, diag, normin, n, kd, ab, 0, ldab, x, 0, scale, cnorm, 0, info);
+ }
+
+ @Override
+ public void dlatdf(int ijob, int n, double[] z, int ldz, double[] rhs, doubleW rdsum, doubleW rdscal, int[] ipiv, int[] jpiv) {
+ org.netlib.lapack.Dlatdf.dlatdf(ijob, n, z, 0, ldz, rhs, 0, rdsum, rdscal, ipiv, 0, jpiv, 0);
+ }
+
+ @Override
+ public void dlatps(String uplo, String trans, String diag, String normin, int n, double[] ap, double[] x, doubleW scale, double[] cnorm, intW info) {
+ org.netlib.lapack.Dlatps.dlatps(uplo, trans, diag, normin, n, ap, 0, x, 0, scale, cnorm, 0, info);
+ }
+
+ @Override
+ public void dlatrd(String uplo, int n, int nb, double[] a, int lda, double[] e, double[] tau, double[] w, int ldw) {
+ org.netlib.lapack.Dlatrd.dlatrd(uplo, n, nb, a, 0, lda, e, 0, tau, 0, w, 0, ldw);
+ }
+
+ @Override
+ public void dlatrs(String uplo, String trans, String diag, String normin, int n, double[] a, int lda, double[] x, doubleW scale, double[] cnorm, intW info) {
+ org.netlib.lapack.Dlatrs.dlatrs(uplo, trans, diag, normin, n, a, 0, lda, x, 0, scale, cnorm, 0, info);
+ }
+
+ @Override
+ public void dlatrz(int m, int n, int l, double[] a, int lda, double[] tau, double[] work) {
+ org.netlib.lapack.Dlatrz.dlatrz(m, n, l, a, 0, lda, tau, 0, work, 0);
+ }
+
+ @Override
+ public void dlatzm(String side, int m, int n, double[] v, int incv, double tau, double[] c1, double[] c2, int Ldc, double[] work) {
+ org.netlib.lapack.Dlatzm.dlatzm(side, m, n, v, 0, incv, tau, c1, 0, c2, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void dlauu2(String uplo, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dlauu2.dlauu2(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dlauum(String uplo, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dlauum.dlauum(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dopgtr(String uplo, int n, double[] ap, double[] tau, double[] q, int ldq, double[] work, intW info) {
+ org.netlib.lapack.Dopgtr.dopgtr(uplo, n, ap, 0, tau, 0, q, 0, ldq, work, 0, info);
+ }
+
+ @Override
+ public void dopmtr(String side, String uplo, String trans, int m, int n, double[] ap, double[] tau, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dopmtr.dopmtr(side, uplo, trans, m, n, ap, 0, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dorg2l(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dorg2l.dorg2l(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dorg2r(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dorg2r.dorg2r(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dorgbr(String vect, int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorgbr.dorgbr(vect, m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorghr(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorghr.dorghr(n, ilo, ihi, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorgl2(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dorgl2.dorgl2(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dorglq(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorglq.dorglq(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorgql(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorgql.dorgql(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorgqr(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorgqr.dorgqr(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorgr2(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info) {
+ org.netlib.lapack.Dorgr2.dorgr2(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void dorgrq(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorgrq.dorgrq(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorgtr(String uplo, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dorgtr.dorgtr(uplo, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorm2l(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dorm2l.dorm2l(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dorm2r(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dorm2r.dorm2r(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dormbr(String vect, String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormbr.dormbr(vect, side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dormhr(String side, String trans, int m, int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormhr.dormhr(side, trans, m, n, ilo, ihi, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dorml2(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dorml2.dorml2(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dormlq(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormlq.dormlq(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dormql(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormql.dormql(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dormqr(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormqr.dormqr(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dormr2(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dormr2.dormr2(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dormr3(String side, String trans, int m, int n, int k, int l, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info) {
+ org.netlib.lapack.Dormr3.dormr3(side, trans, m, n, k, l, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void dormrq(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormrq.dormrq(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dormrz(String side, String trans, int m, int n, int k, int l, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormrz.dormrz(side, trans, m, n, k, l, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dormtr(String side, String uplo, String trans, int m, int n, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dormtr.dormtr(side, uplo, trans, m, n, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dpbcon(String uplo, int n, int kd, double[] ab, int ldab, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dpbcon.dpbcon(uplo, n, kd, ab, 0, ldab, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dpbequ(String uplo, int n, int kd, double[] ab, int ldab, double[] s, doubleW scond, doubleW amax, intW info) {
+ org.netlib.lapack.Dpbequ.dpbequ(uplo, n, kd, ab, 0, ldab, s, 0, scond, amax, info);
+ }
+
+ @Override
+ public void dpbrfs(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dpbrfs.dpbrfs(uplo, n, kd, nrhs, ab, 0, ldab, afb, 0, ldafb, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dpbstf(String uplo, int n, int kd, double[] ab, int ldab, intW info) {
+ org.netlib.lapack.Dpbstf.dpbstf(uplo, n, kd, ab, 0, ldab, info);
+ }
+
+ @Override
+ public void dpbsv(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dpbsv.dpbsv(uplo, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dpbsvx(String fact, String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dpbsvx.dpbsvx(fact, uplo, n, kd, nrhs, ab, 0, ldab, afb, 0, ldafb, equed, s, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dpbtf2(String uplo, int n, int kd, double[] ab, int ldab, intW info) {
+ org.netlib.lapack.Dpbtf2.dpbtf2(uplo, n, kd, ab, 0, ldab, info);
+ }
+
+ @Override
+ public void dpbtrf(String uplo, int n, int kd, double[] ab, int ldab, intW info) {
+ org.netlib.lapack.Dpbtrf.dpbtrf(uplo, n, kd, ab, 0, ldab, info);
+ }
+
+ @Override
+ public void dpbtrs(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dpbtrs.dpbtrs(uplo, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dpocon(String uplo, int n, double[] a, int lda, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dpocon.dpocon(uplo, n, a, 0, lda, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dpoequ(int n, double[] a, int lda, double[] s, doubleW scond, doubleW amax, intW info) {
+ org.netlib.lapack.Dpoequ.dpoequ(n, a, 0, lda, s, 0, scond, amax, info);
+ }
+
+ @Override
+ public void dporfs(String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dporfs.dporfs(uplo, n, nrhs, a, 0, lda, af, 0, ldaf, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dposv(String uplo, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dposv.dposv(uplo, n, nrhs, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dposvx(String fact, String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dposvx.dposvx(fact, uplo, n, nrhs, a, 0, lda, af, 0, ldaf, equed, s, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dpotf2(String uplo, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dpotf2.dpotf2(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dpotrf(String uplo, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dpotrf.dpotrf(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dpotri(String uplo, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dpotri.dpotri(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dpotrs(String uplo, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dpotrs.dpotrs(uplo, n, nrhs, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dppcon(String uplo, int n, double[] ap, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dppcon.dppcon(uplo, n, ap, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dppequ(String uplo, int n, double[] ap, double[] s, doubleW scond, doubleW amax, intW info) {
+ org.netlib.lapack.Dppequ.dppequ(uplo, n, ap, 0, s, 0, scond, amax, info);
+ }
+
+ @Override
+ public void dpprfs(String uplo, int n, int nrhs, double[] ap, double[] afp, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dpprfs.dpprfs(uplo, n, nrhs, ap, 0, afp, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dppsv(String uplo, int n, int nrhs, double[] ap, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dppsv.dppsv(uplo, n, nrhs, ap, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dppsvx(String fact, String uplo, int n, int nrhs, double[] ap, double[] afp, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dppsvx.dppsvx(fact, uplo, n, nrhs, ap, 0, afp, 0, equed, s, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dpptrf(String uplo, int n, double[] ap, intW info) {
+ org.netlib.lapack.Dpptrf.dpptrf(uplo, n, ap, 0, info);
+ }
+
+ @Override
+ public void dpptri(String uplo, int n, double[] ap, intW info) {
+ org.netlib.lapack.Dpptri.dpptri(uplo, n, ap, 0, info);
+ }
+
+ @Override
+ public void dpptrs(String uplo, int n, int nrhs, double[] ap, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dpptrs.dpptrs(uplo, n, nrhs, ap, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dptcon(int n, double[] d, double[] e, double anorm, doubleW rcond, double[] work, intW info) {
+ org.netlib.lapack.Dptcon.dptcon(n, d, 0, e, 0, anorm, rcond, work, 0, info);
+ }
+
+ @Override
+ public void dpteqr(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dpteqr.dpteqr(compz, n, d, 0, e, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dptrfs(int n, int nrhs, double[] d, double[] e, double[] df, double[] ef, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, intW info) {
+ org.netlib.lapack.Dptrfs.dptrfs(n, nrhs, d, 0, e, 0, df, 0, ef, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, info);
+ }
+
+ @Override
+ public void dptsv(int n, int nrhs, double[] d, double[] e, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dptsv.dptsv(n, nrhs, d, 0, e, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dptsvx(String fact, int n, int nrhs, double[] d, double[] e, double[] df, double[] ef, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, intW info) {
+ org.netlib.lapack.Dptsvx.dptsvx(fact, n, nrhs, d, 0, e, 0, df, 0, ef, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, info);
+ }
+
+ @Override
+ public void dpttrf(int n, double[] d, double[] e, intW info) {
+ org.netlib.lapack.Dpttrf.dpttrf(n, d, 0, e, 0, info);
+ }
+
+ @Override
+ public void dpttrs(int n, int nrhs, double[] d, double[] e, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dpttrs.dpttrs(n, nrhs, d, 0, e, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dptts2(int n, int nrhs, double[] d, double[] e, double[] b, int ldb) {
+ org.netlib.lapack.Dptts2.dptts2(n, nrhs, d, 0, e, 0, b, 0, ldb);
+ }
+
+ @Override
+ public void drscl(int n, double sa, double[] sx, int incx) {
+ org.netlib.lapack.Drscl.drscl(n, sa, sx, 0, incx);
+ }
+
+ @Override
+ public void dsbev(String jobz, String uplo, int n, int kd, double[] ab, int ldab, double[] w, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dsbev.dsbev(jobz, uplo, n, kd, ab, 0, ldab, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dsbevd(String jobz, String uplo, int n, int kd, double[] ab, int ldab, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dsbevd.dsbevd(jobz, uplo, n, kd, ab, 0, ldab, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dsbevx(String jobz, String range, String uplo, int n, int kd, double[] ab, int ldab, double[] q, int ldq, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dsbevx.dsbevx(jobz, range, uplo, n, kd, ab, 0, ldab, q, 0, ldq, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsbgst(String vect, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] x, int ldx, double[] work, intW info) {
+ org.netlib.lapack.Dsbgst.dsbgst(vect, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, x, 0, ldx, work, 0, info);
+ }
+
+ @Override
+ public void dsbgv(String jobz, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] w, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dsbgv.dsbgv(jobz, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dsbgvd(String jobz, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dsbgvd.dsbgvd(jobz, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dsbgvx(String jobz, String range, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] q, int ldq, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dsbgvx.dsbgvx(jobz, range, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, q, 0, ldq, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsbtrd(String vect, String uplo, int n, int kd, double[] ab, int ldab, double[] d, double[] e, double[] q, int ldq, double[] work, intW info) {
+ org.netlib.lapack.Dsbtrd.dsbtrd(vect, uplo, n, kd, ab, 0, ldab, d, 0, e, 0, q, 0, ldq, work, 0, info);
+ }
+
+ @Override
+ public void dspcon(String uplo, int n, double[] ap, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dspcon.dspcon(uplo, n, ap, 0, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dspev(String jobz, String uplo, int n, double[] ap, double[] w, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dspev.dspev(jobz, uplo, n, ap, 0, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dspevd(String jobz, String uplo, int n, double[] ap, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dspevd.dspevd(jobz, uplo, n, ap, 0, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dspevx(String jobz, String range, String uplo, int n, double[] ap, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dspevx.dspevx(jobz, range, uplo, n, ap, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dspgst(int itype, String uplo, int n, double[] ap, double[] bp, intW info) {
+ org.netlib.lapack.Dspgst.dspgst(itype, uplo, n, ap, 0, bp, 0, info);
+ }
+
+ @Override
+ public void dspgv(int itype, String jobz, String uplo, int n, double[] ap, double[] bp, double[] w, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dspgv.dspgv(itype, jobz, uplo, n, ap, 0, bp, 0, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dspgvd(int itype, String jobz, String uplo, int n, double[] ap, double[] bp, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dspgvd.dspgvd(itype, jobz, uplo, n, ap, 0, bp, 0, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dspgvx(int itype, String jobz, String range, String uplo, int n, double[] ap, double[] bp, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dspgvx.dspgvx(itype, jobz, range, uplo, n, ap, 0, bp, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsprfs(String uplo, int n, int nrhs, double[] ap, double[] afp, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dsprfs.dsprfs(uplo, n, nrhs, ap, 0, afp, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dspsv(String uplo, int n, int nrhs, double[] ap, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dspsv.dspsv(uplo, n, nrhs, ap, 0, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dspsvx(String fact, String uplo, int n, int nrhs, double[] ap, double[] afp, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dspsvx.dspsvx(fact, uplo, n, nrhs, ap, 0, afp, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dsptrd(String uplo, int n, double[] ap, double[] d, double[] e, double[] tau, intW info) {
+ org.netlib.lapack.Dsptrd.dsptrd(uplo, n, ap, 0, d, 0, e, 0, tau, 0, info);
+ }
+
+ @Override
+ public void dsptrf(String uplo, int n, double[] ap, int[] ipiv, intW info) {
+ org.netlib.lapack.Dsptrf.dsptrf(uplo, n, ap, 0, ipiv, 0, info);
+ }
+
+ @Override
+ public void dsptri(String uplo, int n, double[] ap, int[] ipiv, double[] work, intW info) {
+ org.netlib.lapack.Dsptri.dsptri(uplo, n, ap, 0, ipiv, 0, work, 0, info);
+ }
+
+ @Override
+ public void dsptrs(String uplo, int n, int nrhs, double[] ap, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dsptrs.dsptrs(uplo, n, nrhs, ap, 0, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dstebz(String range, String order, int n, double vl, double vu, int il, int iu, double abstol, double[] d, double[] e, intW m, intW nsplit, double[] w, int[] iblock, int[] isplit, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dstebz.dstebz(range, order, n, vl, vu, il, iu, abstol, d, 0, e, 0, m, nsplit, w, 0, iblock, 0, isplit, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dstedc(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dstedc.dstedc(compz, n, d, 0, e, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dstegr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dstegr.dstegr(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, isuppz, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dstein(int n, double[] d, double[] e, int m, double[] w, int[] iblock, int[] isplit, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dstein.dstein(n, d, 0, e, 0, m, w, 0, iblock, 0, isplit, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsteqr(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dsteqr.dsteqr(compz, n, d, 0, e, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dsterf(int n, double[] d, double[] e, intW info) {
+ org.netlib.lapack.Dsterf.dsterf(n, d, 0, e, 0, info);
+ }
+
+ @Override
+ public void dstev(String jobz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info) {
+ org.netlib.lapack.Dstev.dstev(jobz, n, d, 0, e, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void dstevd(String jobz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dstevd.dstevd(jobz, n, d, 0, e, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dstevr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dstevr.dstevr(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, isuppz, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dstevx(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dstevx.dstevx(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsycon(String uplo, int n, double[] a, int lda, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dsycon.dsycon(uplo, n, a, 0, lda, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dsyev(String jobz, String uplo, int n, double[] a, int lda, double[] w, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dsyev.dsyev(jobz, uplo, n, a, 0, lda, w, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dsyevd(String jobz, String uplo, int n, double[] a, int lda, double[] w, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dsyevd.dsyevd(jobz, uplo, n, a, 0, lda, w, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dsyevr(String jobz, String range, String uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dsyevr.dsyevr(jobz, range, uplo, n, a, 0, lda, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, isuppz, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dsyevx(String jobz, String range, String uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dsyevx.dsyevx(jobz, range, uplo, n, a, 0, lda, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsygs2(int itype, String uplo, int n, double[] a, int lda, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dsygs2.dsygs2(itype, uplo, n, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dsygst(int itype, String uplo, int n, double[] a, int lda, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dsygst.dsygst(itype, uplo, n, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dsygv(int itype, String jobz, String uplo, int n, double[] a, int lda, double[] b, int ldb, double[] w, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dsygv.dsygv(itype, jobz, uplo, n, a, 0, lda, b, 0, ldb, w, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dsygvd(int itype, String jobz, String uplo, int n, double[] a, int lda, double[] b, int ldb, double[] w, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dsygvd.dsygvd(itype, jobz, uplo, n, a, 0, lda, b, 0, ldb, w, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dsygvx(int itype, String jobz, String range, String uplo, int n, double[] a, int lda, double[] b, int ldb, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Dsygvx.dsygvx(itype, jobz, range, uplo, n, a, 0, lda, b, 0, ldb, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void dsyrfs(String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dsyrfs.dsyrfs(uplo, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dsysv(String uplo, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dsysv.dsysv(uplo, n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dsysvx(String fact, String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dsysvx.dsysvx(fact, uplo, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dsytd2(String uplo, int n, double[] a, int lda, double[] d, double[] e, double[] tau, intW info) {
+ org.netlib.lapack.Dsytd2.dsytd2(uplo, n, a, 0, lda, d, 0, e, 0, tau, 0, info);
+ }
+
+ @Override
+ public void dsytf2(String uplo, int n, double[] a, int lda, int[] ipiv, intW info) {
+ org.netlib.lapack.Dsytf2.dsytf2(uplo, n, a, 0, lda, ipiv, 0, info);
+ }
+
+ @Override
+ public void dsytrd(String uplo, int n, double[] a, int lda, double[] d, double[] e, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dsytrd.dsytrd(uplo, n, a, 0, lda, d, 0, e, 0, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dsytrf(String uplo, int n, double[] a, int lda, int[] ipiv, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dsytrf.dsytrf(uplo, n, a, 0, lda, ipiv, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dsytri(String uplo, int n, double[] a, int lda, int[] ipiv, double[] work, intW info) {
+ org.netlib.lapack.Dsytri.dsytri(uplo, n, a, 0, lda, ipiv, 0, work, 0, info);
+ }
+
+ @Override
+ public void dsytrs(String uplo, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dsytrs.dsytrs(uplo, n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dtbcon(String norm, String uplo, String diag, int n, int kd, double[] ab, int ldab, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dtbcon.dtbcon(norm, uplo, diag, n, kd, ab, 0, ldab, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dtbrfs(String uplo, String trans, String diag, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dtbrfs.dtbrfs(uplo, trans, diag, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dtbtrs(String uplo, String trans, String diag, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dtbtrs.dtbtrs(uplo, trans, diag, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dtgevc(String side, String howmny, boolean[] select, int n, double[] s, int lds, double[] p, int ldp, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, intW info) {
+ org.netlib.lapack.Dtgevc.dtgevc(side, howmny, select, 0, n, s, 0, lds, p, 0, ldp, vl, 0, ldvl, vr, 0, ldvr, mm, m, work, 0, info);
+ }
+
+ @Override
+ public void dtgex2(boolean wantq, boolean wantz, int n, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, int j1, int n1, int n2, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dtgex2.dtgex2(wantq, wantz, n, a, 0, lda, b, 0, ldb, q, 0, ldq, z, 0, ldz, j1, n1, n2, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dtgexc(boolean wantq, boolean wantz, int n, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, intW ifst, intW ilst, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dtgexc.dtgexc(wantq, wantz, n, a, 0, lda, b, 0, ldb, q, 0, ldq, z, 0, ldz, ifst, ilst, work, 0, lwork, info);
+ }
+
+ @Override
+ public void dtgsen(int ijob, boolean wantq, boolean wantz, boolean[] select, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] q, int ldq, double[] z, int ldz, intW m, doubleW pl, doubleW pr, double[] dif, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dtgsen.dtgsen(ijob, wantq, wantz, select, 0, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, q, 0, ldq, z, 0, ldz, m, pl, pr, dif, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dtgsja(String jobu, String jobv, String jobq, int m, int p, int n, int k, int l, double[] a, int lda, double[] b, int ldb, double tola, double tolb, double[] alpha, double[] beta, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, double[] work, intW ncycle, intW info) {
+ org.netlib.lapack.Dtgsja.dtgsja(jobu, jobv, jobq, m, p, n, k, l, a, 0, lda, b, 0, ldb, tola, tolb, alpha, 0, beta, 0, u, 0, ldu, v, 0, ldv, q, 0, ldq, work, 0, ncycle, info);
+ }
+
+ @Override
+ public void dtgsna(String job, String howmny, boolean[] select, int n, double[] a, int lda, double[] b, int ldb, double[] vl, int ldvl, double[] vr, int ldvr, double[] s, double[] dif, int mm, intW m, double[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dtgsna.dtgsna(job, howmny, select, 0, n, a, 0, lda, b, 0, ldb, vl, 0, ldvl, vr, 0, ldvr, s, 0, dif, 0, mm, m, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dtgsy2(String trans, int ijob, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, double[] d, int ldd, double[] e, int lde, double[] f, int ldf, doubleW scale, doubleW rdsum, doubleW rdscal, int[] iwork, intW pq, intW info) {
+ org.netlib.lapack.Dtgsy2.dtgsy2(trans, ijob, m, n, a, 0, lda, b, 0, ldb, c, 0, Ldc, d, 0, ldd, e, 0, lde, f, 0, ldf, scale, rdsum, rdscal, iwork, 0, pq, info);
+ }
+
+ @Override
+ public void dtgsyl(String trans, int ijob, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, double[] d, int ldd, double[] e, int lde, double[] f, int ldf, doubleW scale, doubleW dif, double[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dtgsyl.dtgsyl(trans, ijob, m, n, a, 0, lda, b, 0, ldb, c, 0, Ldc, d, 0, ldd, e, 0, lde, f, 0, ldf, scale, dif, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dtpcon(String norm, String uplo, String diag, int n, double[] ap, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dtpcon.dtpcon(norm, uplo, diag, n, ap, 0, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dtprfs(String uplo, String trans, String diag, int n, int nrhs, double[] ap, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dtprfs.dtprfs(uplo, trans, diag, n, nrhs, ap, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dtptri(String uplo, String diag, int n, double[] ap, intW info) {
+ org.netlib.lapack.Dtptri.dtptri(uplo, diag, n, ap, 0, info);
+ }
+
+ @Override
+ public void dtptrs(String uplo, String trans, String diag, int n, int nrhs, double[] ap, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dtptrs.dtptrs(uplo, trans, diag, n, nrhs, ap, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dtrcon(String norm, String uplo, String diag, int n, double[] a, int lda, doubleW rcond, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dtrcon.dtrcon(norm, uplo, diag, n, a, 0, lda, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dtrevc(String side, String howmny, boolean[] select, int n, double[] t, int ldt, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, intW info) {
+ org.netlib.lapack.Dtrevc.dtrevc(side, howmny, select, 0, n, t, 0, ldt, vl, 0, ldvl, vr, 0, ldvr, mm, m, work, 0, info);
+ }
+
+ @Override
+ public void dtrexc(String compq, int n, double[] t, int ldt, double[] q, int ldq, intW ifst, intW ilst, double[] work, intW info) {
+ org.netlib.lapack.Dtrexc.dtrexc(compq, n, t, 0, ldt, q, 0, ldq, ifst, ilst, work, 0, info);
+ }
+
+ @Override
+ public void dtrrfs(String uplo, String trans, String diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dtrrfs.dtrrfs(uplo, trans, diag, n, nrhs, a, 0, lda, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void dtrsen(String job, String compq, boolean[] select, int n, double[] t, int ldt, double[] q, int ldq, double[] wr, double[] wi, intW m, doubleW s, doubleW sep, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dtrsen.dtrsen(job, compq, select, 0, n, t, 0, ldt, q, 0, ldq, wr, 0, wi, 0, m, s, sep, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void dtrsna(String job, String howmny, boolean[] select, int n, double[] t, int ldt, double[] vl, int ldvl, double[] vr, int ldvr, double[] s, double[] sep, int mm, intW m, double[] work, int ldwork, int[] iwork, intW info) {
+ org.netlib.lapack.Dtrsna.dtrsna(job, howmny, select, 0, n, t, 0, ldt, vl, 0, ldvl, vr, 0, ldvr, s, 0, sep, 0, mm, m, work, 0, ldwork, iwork, 0, info);
+ }
+
+ @Override
+ public void dtrsyl(String trana, String tranb, int isgn, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, doubleW scale, intW info) {
+ org.netlib.lapack.Dtrsyl.dtrsyl(trana, tranb, isgn, m, n, a, 0, lda, b, 0, ldb, c, 0, Ldc, scale, info);
+ }
+
+ @Override
+ public void dtrti2(String uplo, String diag, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dtrti2.dtrti2(uplo, diag, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dtrtri(String uplo, String diag, int n, double[] a, int lda, intW info) {
+ org.netlib.lapack.Dtrtri.dtrtri(uplo, diag, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void dtrtrs(String uplo, String trans, String diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info) {
+ org.netlib.lapack.Dtrtrs.dtrtrs(uplo, trans, diag, n, nrhs, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void dtzrqf(int m, int n, double[] a, int lda, double[] tau, intW info) {
+ org.netlib.lapack.Dtzrqf.dtzrqf(m, n, a, 0, lda, tau, 0, info);
+ }
+
+ @Override
+ public void dtzrzf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dtzrzf.dtzrzf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public int ieeeck(int ispec, float zero, float one) {
+ return org.netlib.lapack.Ieeeck.ieeeck(ispec, zero, one);
+ }
+
+ @Override
+ public int ilaenv(int ispec, String name, String opts, int n1, int n2, int n3, int n4) {
+ return org.netlib.lapack.Ilaenv.ilaenv(ispec, name, opts, n1, n2, n3, n4);
+ }
+
+ @Override
+ public void sbdsdc(String uplo, String compq, int n, float[] d, float[] e, float[] u, int ldu, float[] vt, int ldvt, float[] q, int[] iq, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sbdsdc.sbdsdc(uplo, compq, n, d, 0, e, 0, u, 0, ldu, vt, 0, ldvt, q, 0, iq, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sbdsqr(String uplo, int n, int ncvt, int nru, int ncc, float[] d, float[] e, float[] vt, int ldvt, float[] u, int ldu, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sbdsqr.sbdsqr(uplo, n, ncvt, nru, ncc, d, 0, e, 0, vt, 0, ldvt, u, 0, ldu, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sdisna(String job, int m, int n, float[] d, float[] sep, intW info) {
+ org.netlib.lapack.Sdisna.sdisna(job, m, n, d, 0, sep, 0, info);
+ }
+
+ @Override
+ public void sgbbrd(String vect, int m, int n, int ncc, int kl, int ku, float[] ab, int ldab, float[] d, float[] e, float[] q, int ldq, float[] pt, int ldpt, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sgbbrd.sgbbrd(vect, m, n, ncc, kl, ku, ab, 0, ldab, d, 0, e, 0, q, 0, ldq, pt, 0, ldpt, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sgbcon(String norm, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgbcon.sgbcon(norm, n, kl, ku, ab, 0, ldab, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgbequ(int m, int n, int kl, int ku, float[] ab, int ldab, float[] r, float[] c, floatW rowcnd, floatW colcnd, floatW amax, intW info) {
+ org.netlib.lapack.Sgbequ.sgbequ(m, n, kl, ku, ab, 0, ldab, r, 0, c, 0, rowcnd, colcnd, amax, info);
+ }
+
+ @Override
+ public void sgbrfs(String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgbrfs.sgbrfs(trans, n, kl, ku, nrhs, ab, 0, ldab, afb, 0, ldafb, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgbsv(int n, int kl, int ku, int nrhs, float[] ab, int ldab, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sgbsv.sgbsv(n, kl, ku, nrhs, ab, 0, ldab, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sgbsvx(String fact, String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, int[] ipiv, StringW equed, float[] r, float[] c, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgbsvx.sgbsvx(fact, trans, n, kl, ku, nrhs, ab, 0, ldab, afb, 0, ldafb, ipiv, 0, equed, r, 0, c, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgbtf2(int m, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, intW info) {
+ org.netlib.lapack.Sgbtf2.sgbtf2(m, n, kl, ku, ab, 0, ldab, ipiv, 0, info);
+ }
+
+ @Override
+ public void sgbtrf(int m, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, intW info) {
+ org.netlib.lapack.Sgbtrf.sgbtrf(m, n, kl, ku, ab, 0, ldab, ipiv, 0, info);
+ }
+
+ @Override
+ public void sgbtrs(String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sgbtrs.sgbtrs(trans, n, kl, ku, nrhs, ab, 0, ldab, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sgebak(String job, String side, int n, int ilo, int ihi, float[] scale, int m, float[] v, int ldv, intW info) {
+ org.netlib.lapack.Sgebak.sgebak(job, side, n, ilo, ihi, scale, 0, m, v, 0, ldv, info);
+ }
+
+ @Override
+ public void sgebal(String job, int n, float[] a, int lda, intW ilo, intW ihi, float[] scale, intW info) {
+ org.netlib.lapack.Sgebal.sgebal(job, n, a, 0, lda, ilo, ihi, scale, 0, info);
+ }
+
+ @Override
+ public void sgebd2(int m, int n, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] work, intW info) {
+ org.netlib.lapack.Sgebd2.sgebd2(m, n, a, 0, lda, d, 0, e, 0, tauq, 0, taup, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgebrd(int m, int n, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgebrd.sgebrd(m, n, a, 0, lda, d, 0, e, 0, tauq, 0, taup, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgecon(String norm, int n, float[] a, int lda, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgecon.sgecon(norm, n, a, 0, lda, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgeequ(int m, int n, float[] a, int lda, float[] r, float[] c, floatW rowcnd, floatW colcnd, floatW amax, intW info) {
+ org.netlib.lapack.Sgeequ.sgeequ(m, n, a, 0, lda, r, 0, c, 0, rowcnd, colcnd, amax, info);
+ }
+
+ @Override
+ public void sgeev(String jobvl, String jobvr, int n, float[] a, int lda, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgeev.sgeev(jobvl, jobvr, n, a, 0, lda, wr, 0, wi, 0, vl, 0, ldvl, vr, 0, ldvr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgeevx(String balanc, String jobvl, String jobvr, String sense, int n, float[] a, int lda, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, intW ilo, intW ihi, float[] scale, floatW abnrm, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Sgeevx.sgeevx(balanc, jobvl, jobvr, sense, n, a, 0, lda, wr, 0, wi, 0, vl, 0, ldvl, vr, 0, ldvr, ilo, ihi, scale, 0, abnrm, rconde, 0, rcondv, 0, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void sgegs(String jobvsl, String jobvsr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vsl, int ldvsl, float[] vsr, int ldvsr, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgegs.sgegs(jobvsl, jobvsr, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vsl, 0, ldvsl, vsr, 0, ldvsr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgegv(String jobvl, String jobvr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgegv.sgegv(jobvl, jobvr, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vl, 0, ldvl, vr, 0, ldvr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgehd2(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sgehd2.sgehd2(n, ilo, ihi, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgehrd(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgehrd.sgehrd(n, ilo, ihi, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgelq2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sgelq2.sgelq2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgelqf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgelqf.sgelqf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgels(String trans, int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgels.sgels(trans, m, n, nrhs, a, 0, lda, b, 0, ldb, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgelsd(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] s, float rcond, intW rank, float[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Sgelsd.sgelsd(m, n, nrhs, a, 0, lda, b, 0, ldb, s, 0, rcond, rank, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void sgelss(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] s, float rcond, intW rank, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgelss.sgelss(m, n, nrhs, a, 0, lda, b, 0, ldb, s, 0, rcond, rank, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgelsx(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, int[] jpvt, float rcond, intW rank, float[] work, intW info) {
+ org.netlib.lapack.Sgelsx.sgelsx(m, n, nrhs, a, 0, lda, b, 0, ldb, jpvt, 0, rcond, rank, work, 0, info);
+ }
+
+ @Override
+ public void sgelsy(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, int[] jpvt, float rcond, intW rank, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgelsy.sgelsy(m, n, nrhs, a, 0, lda, b, 0, ldb, jpvt, 0, rcond, rank, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgeql2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sgeql2.sgeql2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgeqlf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgeqlf.sgeqlf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgeqp3(int m, int n, float[] a, int lda, int[] jpvt, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgeqp3.sgeqp3(m, n, a, 0, lda, jpvt, 0, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgeqpf(int m, int n, float[] a, int lda, int[] jpvt, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sgeqpf.sgeqpf(m, n, a, 0, lda, jpvt, 0, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgeqr2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sgeqr2.sgeqr2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgeqrf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgeqrf.sgeqrf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgerfs(String trans, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgerfs.sgerfs(trans, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgerq2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sgerq2.sgerq2(m, n, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgerqf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgerqf.sgerqf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgesc2(int n, float[] a, int lda, float[] rhs, int[] ipiv, int[] jpiv, floatW scale) {
+ org.netlib.lapack.Sgesc2.sgesc2(n, a, 0, lda, rhs, 0, ipiv, 0, jpiv, 0, scale);
+ }
+
+ @Override
+ public void sgesdd(String jobz, int m, int n, float[] a, int lda, float[] s, float[] u, int ldu, float[] vt, int ldvt, float[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Sgesdd.sgesdd(jobz, m, n, a, 0, lda, s, 0, u, 0, ldu, vt, 0, ldvt, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void sgesv(int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sgesv.sgesv(n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sgesvd(String jobu, String jobvt, int m, int n, float[] a, int lda, float[] s, float[] u, int ldu, float[] vt, int ldvt, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgesvd.sgesvd(jobu, jobvt, m, n, a, 0, lda, s, 0, u, 0, ldu, vt, 0, ldvt, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgesvx(String fact, String trans, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, StringW equed, float[] r, float[] c, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgesvx.sgesvx(fact, trans, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, equed, r, 0, c, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgetc2(int n, float[] a, int lda, int[] ipiv, int[] jpiv, intW info) {
+ org.netlib.lapack.Sgetc2.sgetc2(n, a, 0, lda, ipiv, 0, jpiv, 0, info);
+ }
+
+ @Override
+ public void sgetf2(int m, int n, float[] a, int lda, int[] ipiv, intW info) {
+ org.netlib.lapack.Sgetf2.sgetf2(m, n, a, 0, lda, ipiv, 0, info);
+ }
+
+ @Override
+ public void sgetrf(int m, int n, float[] a, int lda, int[] ipiv, intW info) {
+ org.netlib.lapack.Sgetrf.sgetrf(m, n, a, 0, lda, ipiv, 0, info);
+ }
+
+ @Override
+ public void sgetri(int n, float[] a, int lda, int[] ipiv, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgetri.sgetri(n, a, 0, lda, ipiv, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgetrs(String trans, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sgetrs.sgetrs(trans, n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sggbak(String job, String side, int n, int ilo, int ihi, float[] lscale, float[] rscale, int m, float[] v, int ldv, intW info) {
+ org.netlib.lapack.Sggbak.sggbak(job, side, n, ilo, ihi, lscale, 0, rscale, 0, m, v, 0, ldv, info);
+ }
+
+ @Override
+ public void sggbal(String job, int n, float[] a, int lda, float[] b, int ldb, intW ilo, intW ihi, float[] lscale, float[] rscale, float[] work, intW info) {
+ org.netlib.lapack.Sggbal.sggbal(job, n, a, 0, lda, b, 0, ldb, ilo, ihi, lscale, 0, rscale, 0, work, 0, info);
+ }
+
+ @Override
+ public void sggev(String jobvl, String jobvr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sggev.sggev(jobvl, jobvr, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vl, 0, ldvl, vr, 0, ldvr, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sggevx(String balanc, String jobvl, String jobvr, String sense, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, intW ilo, intW ihi, float[] lscale, float[] rscale, floatW abnrm, floatW bbnrm, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Sggevx.sggevx(balanc, jobvl, jobvr, sense, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, vl, 0, ldvl, vr, 0, ldvr, ilo, ihi, lscale, 0, rscale, 0, abnrm, bbnrm, rconde, 0, rcondv, 0, work, 0, lwork, iwork, 0, bwork, 0, info);
+ }
+
+ @Override
+ public void sggglm(int n, int m, int p, float[] a, int lda, float[] b, int ldb, float[] d, float[] x, float[] y, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sggglm.sggglm(n, m, p, a, 0, lda, b, 0, ldb, d, 0, x, 0, y, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sgghrd(String compq, String compz, int n, int ilo, int ihi, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, intW info) {
+ org.netlib.lapack.Sgghrd.sgghrd(compq, compz, n, ilo, ihi, a, 0, lda, b, 0, ldb, q, 0, ldq, z, 0, ldz, info);
+ }
+
+ @Override
+ public void sgglse(int m, int n, int p, float[] a, int lda, float[] b, int ldb, float[] c, float[] d, float[] x, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sgglse.sgglse(m, n, p, a, 0, lda, b, 0, ldb, c, 0, d, 0, x, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sggqrf(int n, int m, int p, float[] a, int lda, float[] taua, float[] b, int ldb, float[] taub, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sggqrf.sggqrf(n, m, p, a, 0, lda, taua, 0, b, 0, ldb, taub, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sggrqf(int m, int p, int n, float[] a, int lda, float[] taua, float[] b, int ldb, float[] taub, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sggrqf.sggrqf(m, p, n, a, 0, lda, taua, 0, b, 0, ldb, taub, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sggsvd(String jobu, String jobv, String jobq, int m, int n, int p, intW k, intW l, float[] a, int lda, float[] b, int ldb, float[] alpha, float[] beta, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sggsvd.sggsvd(jobu, jobv, jobq, m, n, p, k, l, a, 0, lda, b, 0, ldb, alpha, 0, beta, 0, u, 0, ldu, v, 0, ldv, q, 0, ldq, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sggsvp(String jobu, String jobv, String jobq, int m, int p, int n, float[] a, int lda, float[] b, int ldb, float tola, float tolb, intW k, intW l, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, int[] iwork, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sggsvp.sggsvp(jobu, jobv, jobq, m, p, n, a, 0, lda, b, 0, ldb, tola, tolb, k, l, u, 0, ldu, v, 0, ldv, q, 0, ldq, iwork, 0, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sgtcon(String norm, int n, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgtcon.sgtcon(norm, n, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgtrfs(String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] dlf, float[] df, float[] duf, float[] du2, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgtrfs.sgtrfs(trans, n, nrhs, dl, 0, d, 0, du, 0, dlf, 0, df, 0, duf, 0, du2, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgtsv(int n, int nrhs, float[] dl, float[] d, float[] du, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sgtsv.sgtsv(n, nrhs, dl, 0, d, 0, du, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sgtsvx(String fact, String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] dlf, float[] df, float[] duf, float[] du2, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sgtsvx.sgtsvx(fact, trans, n, nrhs, dl, 0, d, 0, du, 0, dlf, 0, df, 0, duf, 0, du2, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sgttrf(int n, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, intW info) {
+ org.netlib.lapack.Sgttrf.sgttrf(n, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, info);
+ }
+
+ @Override
+ public void sgttrs(String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sgttrs.sgttrs(trans, n, nrhs, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sgtts2(int itrans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float[] b, int ldb) {
+ org.netlib.lapack.Sgtts2.sgtts2(itrans, n, nrhs, dl, 0, d, 0, du, 0, du2, 0, ipiv, 0, b, 0, ldb);
+ }
+
+ @Override
+ public void shgeqz(String job, String compq, String compz, int n, int ilo, int ihi, float[] h, int ldh, float[] t, int ldt, float[] alphar, float[] alphai, float[] beta, float[] q, int ldq, float[] z, int ldz, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Shgeqz.shgeqz(job, compq, compz, n, ilo, ihi, h, 0, ldh, t, 0, ldt, alphar, 0, alphai, 0, beta, 0, q, 0, ldq, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ @Override
+ public void shsein(String side, String eigsrc, String initv, boolean[] select, int n, float[] h, int ldh, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, int[] ifaill, int[] ifailr, intW info) {
+ org.netlib.lapack.Shsein.shsein(side, eigsrc, initv, select, 0, n, h, 0, ldh, wr, 0, wi, 0, vl, 0, ldvl, vr, 0, ldvr, mm, m, work, 0, ifaill, 0, ifailr, 0, info);
+ }
+
+ @Override
+ public void shseqr(String job, String compz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, float[] z, int ldz, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Shseqr.shseqr(job, compz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ @Override
+ public void slabad(floatW small, floatW large) {
+ org.netlib.lapack.Slabad.slabad(small, large);
+ }
+
+ @Override
+ public void slabrd(int m, int n, int nb, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] x, int ldx, float[] y, int ldy) {
+ org.netlib.lapack.Slabrd.slabrd(m, n, nb, a, 0, lda, d, 0, e, 0, tauq, 0, taup, 0, x, 0, ldx, y, 0, ldy);
+ }
+
+ @Override
+ public void slacon(int n, float[] v, float[] x, int[] isgn, floatW est, intW kase) {
+ org.netlib.lapack.Slacon.slacon(n, v, 0, x, 0, isgn, 0, est, kase);
+ }
+
+ @Override
+ public void slacpy(String uplo, int m, int n, float[] a, int lda, float[] b, int ldb) {
+ org.netlib.lapack.Slacpy.slacpy(uplo, m, n, a, 0, lda, b, 0, ldb);
+ }
+
+ @Override
+ public void sladiv(float a, float b, float c, float d, floatW p, floatW q) {
+ org.netlib.lapack.Sladiv.sladiv(a, b, c, d, p, q);
+ }
+
+ @Override
+ public void slae2(float a, float b, float c, floatW rt1, floatW rt2) {
+ org.netlib.lapack.Slae2.slae2(a, b, c, rt1, rt2);
+ }
+
+ @Override
+ public void slaebz(int ijob, int nitmax, int n, int mmax, int minp, int nbmin, float abstol, float reltol, float pivmin, float[] d, float[] e, float[] e2, int[] nval, float[] ab, float[] c, intW mout, int[] nab, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slaebz.slaebz(ijob, nitmax, n, mmax, minp, nbmin, abstol, reltol, pivmin, d, 0, e, 0, e2, 0, nval, 0, ab, 0, c, 0, mout, nab, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slaed0(int icompq, int qsiz, int n, float[] d, float[] e, float[] q, int ldq, float[] qstore, int ldqs, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slaed0.slaed0(icompq, qsiz, n, d, 0, e, 0, q, 0, ldq, qstore, 0, ldqs, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slaed1(int n, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slaed1.slaed1(n, d, 0, q, 0, ldq, indxq, 0, rho, cutpnt, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slaed2(intW k, int n, int n1, float[] d, float[] q, int ldq, int[] indxq, floatW rho, float[] z, float[] dlamda, float[] w, float[] q2, int[] indx, int[] indxc, int[] indxp, int[] coltyp, intW info) {
+ org.netlib.lapack.Slaed2.slaed2(k, n, n1, d, 0, q, 0, ldq, indxq, 0, rho, z, 0, dlamda, 0, w, 0, q2, 0, indx, 0, indxc, 0, indxp, 0, coltyp, 0, info);
+ }
+
+ @Override
+ public void slaed3(int k, int n, int n1, float[] d, float[] q, int ldq, float rho, float[] dlamda, float[] q2, int[] indx, int[] ctot, float[] w, float[] s, intW info) {
+ org.netlib.lapack.Slaed3.slaed3(k, n, n1, d, 0, q, 0, ldq, rho, dlamda, 0, q2, 0, indx, 0, ctot, 0, w, 0, s, 0, info);
+ }
+
+ @Override
+ public void slaed4(int n, int i, float[] d, float[] z, float[] delta, float rho, floatW dlam, intW info) {
+ org.netlib.lapack.Slaed4.slaed4(n, i, d, 0, z, 0, delta, 0, rho, dlam, info);
+ }
+
+ @Override
+ public void slaed5(int i, float[] d, float[] z, float[] delta, float rho, floatW dlam) {
+ org.netlib.lapack.Slaed5.slaed5(i, d, 0, z, 0, delta, 0, rho, dlam);
+ }
+
+ @Override
+ public void slaed6(int kniter, boolean orgati, float rho, float[] d, float[] z, float finit, floatW tau, intW info) {
+ org.netlib.lapack.Slaed6.slaed6(kniter, orgati, rho, d, 0, z, 0, finit, tau, info);
+ }
+
+ @Override
+ public void slaed7(int icompq, int n, int qsiz, int tlvls, int curlvl, int curpbm, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] qstore, int[] qptr, int[] prmptr, int[] perm, int[] givptr, int[] givcol, float[] givnum, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slaed7.slaed7(icompq, n, qsiz, tlvls, curlvl, curpbm, d, 0, q, 0, ldq, indxq, 0, rho, cutpnt, qstore, 0, qptr, 0, prmptr, 0, perm, 0, givptr, 0, givcol, 0, givnum, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slaed8(int icompq, intW k, int n, int qsiz, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] z, float[] dlamda, float[] q2, int ldq2, float[] w, int[] perm, intW givptr, int[] givcol, float[] givnum, int[] indxp, int[] indx, intW info) {
+ org.netlib.lapack.Slaed8.slaed8(icompq, k, n, qsiz, d, 0, q, 0, ldq, indxq, 0, rho, cutpnt, z, 0, dlamda, 0, q2, 0, ldq2, w, 0, perm, 0, givptr, givcol, 0, givnum, 0, indxp, 0, indx, 0, info);
+ }
+
+ @Override
+ public void slaed9(int k, int kstart, int kstop, int n, float[] d, float[] q, int ldq, float rho, float[] dlamda, float[] w, float[] s, int lds, intW info) {
+ org.netlib.lapack.Slaed9.slaed9(k, kstart, kstop, n, d, 0, q, 0, ldq, rho, dlamda, 0, w, 0, s, 0, lds, info);
+ }
+
+ @Override
+ public void slaeda(int n, int tlvls, int curlvl, int curpbm, int[] prmptr, int[] perm, int[] givptr, int[] givcol, float[] givnum, float[] q, int[] qptr, float[] z, float[] ztemp, intW info) {
+ org.netlib.lapack.Slaeda.slaeda(n, tlvls, curlvl, curpbm, prmptr, 0, perm, 0, givptr, 0, givcol, 0, givnum, 0, q, 0, qptr, 0, z, 0, ztemp, 0, info);
+ }
+
+ @Override
+ public void slaein(boolean rightv, boolean noinit, int n, float[] h, int ldh, float wr, float wi, float[] vr, float[] vi, float[] b, int ldb, float[] work, float eps3, float smlnum, float bignum, intW info) {
+ org.netlib.lapack.Slaein.slaein(rightv, noinit, n, h, 0, ldh, wr, wi, vr, 0, vi, 0, b, 0, ldb, work, 0, eps3, smlnum, bignum, info);
+ }
+
+ @Override
+ public void slaev2(float a, float b, float c, floatW rt1, floatW rt2, floatW cs1, floatW sn1) {
+ org.netlib.lapack.Slaev2.slaev2(a, b, c, rt1, rt2, cs1, sn1);
+ }
+
+ @Override
+ public void slaexc(boolean wantq, int n, float[] t, int ldt, float[] q, int ldq, int j1, int n1, int n2, float[] work, intW info) {
+ org.netlib.lapack.Slaexc.slaexc(wantq, n, t, 0, ldt, q, 0, ldq, j1, n1, n2, work, 0, info);
+ }
+
+ @Override
+ public void slag2(float[] a, int lda, float[] b, int ldb, float safmin, floatW scale1, floatW scale2, floatW wr1, floatW wr2, floatW wi) {
+ org.netlib.lapack.Slag2.slag2(a, 0, lda, b, 0, ldb, safmin, scale1, scale2, wr1, wr2, wi);
+ }
+
+ @Override
+ public void slags2(boolean upper, float a1, float a2, float a3, float b1, float b2, float b3, floatW csu, floatW snu, floatW csv, floatW snv, floatW csq, floatW snq) {
+ org.netlib.lapack.Slags2.slags2(upper, a1, a2, a3, b1, b2, b3, csu, snu, csv, snv, csq, snq);
+ }
+
+ @Override
+ public void slagtf(int n, float[] a, float lambda, float[] b, float[] c, float tol, float[] d, int[] in, intW info) {
+ org.netlib.lapack.Slagtf.slagtf(n, a, 0, lambda, b, 0, c, 0, tol, d, 0, in, 0, info);
+ }
+
+ @Override
+ public void slagtm(String trans, int n, int nrhs, float alpha, float[] dl, float[] d, float[] du, float[] x, int ldx, float beta, float[] b, int ldb) {
+ org.netlib.lapack.Slagtm.slagtm(trans, n, nrhs, alpha, dl, 0, d, 0, du, 0, x, 0, ldx, beta, b, 0, ldb);
+ }
+
+ @Override
+ public void slagts(int job, int n, float[] a, float[] b, float[] c, float[] d, int[] in, float[] y, floatW tol, intW info) {
+ org.netlib.lapack.Slagts.slagts(job, n, a, 0, b, 0, c, 0, d, 0, in, 0, y, 0, tol, info);
+ }
+
+ @Override
+ public void slagv2(float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, floatW csl, floatW snl, floatW csr, floatW snr) {
+ org.netlib.lapack.Slagv2.slagv2(a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, csl, snl, csr, snr);
+ }
+
+ @Override
+ public void slahqr(boolean wantt, boolean wantz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, int iloz, int ihiz, float[] z, int ldz, intW info) {
+ org.netlib.lapack.Slahqr.slahqr(wantt, wantz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, iloz, ihiz, z, 0, ldz, info);
+ }
+
+ @Override
+ public void slahrd(int n, int k, int nb, float[] a, int lda, float[] tau, float[] t, int ldt, float[] y, int ldy) {
+ org.netlib.lapack.Slahrd.slahrd(n, k, nb, a, 0, lda, tau, 0, t, 0, ldt, y, 0, ldy);
+ }
+
+ @Override
+ public void slaic1(int job, int j, float[] x, float sest, float[] w, float gamma, floatW sestpr, floatW s, floatW c) {
+ org.netlib.lapack.Slaic1.slaic1(job, j, x, 0, sest, w, 0, gamma, sestpr, s, c);
+ }
+
+ @Override
+ public void slaln2(boolean ltrans, int na, int nw, float smin, float ca, float[] a, int lda, float d1, float d2, float[] b, int ldb, float wr, float wi, float[] x, int ldx, floatW scale, floatW xnorm, intW info) {
+ org.netlib.lapack.Slaln2.slaln2(ltrans, na, nw, smin, ca, a, 0, lda, d1, d2, b, 0, ldb, wr, wi, x, 0, ldx, scale, xnorm, info);
+ }
+
+ @Override
+ public void slals0(int icompq, int nl, int nr, int sqre, int nrhs, float[] b, int ldb, float[] bx, int ldbx, int[] perm, int givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, float[] poles, float[] difl, float[] difr, float[] z, int k, float c, float s, float[] work, intW info) {
+ org.netlib.lapack.Slals0.slals0(icompq, nl, nr, sqre, nrhs, b, 0, ldb, bx, 0, ldbx, perm, 0, givptr, givcol, 0, ldgcol, givnum, 0, ldgnum, poles, 0, difl, 0, difr, 0, z, 0, k, c, s, work, 0, info);
+ }
+
+ @Override
+ public void slalsa(int icompq, int smlsiz, int n, int nrhs, float[] b, int ldb, float[] bx, int ldbx, float[] u, int ldu, float[] vt, int[] k, float[] difl, float[] difr, float[] z, float[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, float[] givnum, float[] c, float[] s, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slalsa.slalsa(icompq, smlsiz, n, nrhs, b, 0, ldb, bx, 0, ldbx, u, 0, ldu, vt, 0, k, 0, difl, 0, difr, 0, z, 0, poles, 0, givptr, 0, givcol, 0, ldgcol, perm, 0, givnum, 0, c, 0, s, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slalsd(String uplo, int smlsiz, int n, int nrhs, float[] d, float[] e, float[] b, int ldb, float rcond, intW rank, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slalsd.slalsd(uplo, smlsiz, n, nrhs, d, 0, e, 0, b, 0, ldb, rcond, rank, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slamrg(int n1, int n2, float[] a, int strd1, int strd2, int[] index) {
+ org.netlib.lapack.Slamrg.slamrg(n1, n2, a, 0, strd1, strd2, index, 0);
+ }
+
+ @Override
+ public void slanv2(floatW a, floatW b, floatW c, floatW d, floatW rt1r, floatW rt1i, floatW rt2r, floatW rt2i, floatW cs, floatW sn) {
+ org.netlib.lapack.Slanv2.slanv2(a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn);
+ }
+
+ @Override
+ public void slapll(int n, float[] x, int incx, float[] y, int incy, floatW ssmin) {
+ org.netlib.lapack.Slapll.slapll(n, x, 0, incx, y, 0, incy, ssmin);
+ }
+
+ @Override
+ public void slapmt(boolean forwrd, int m, int n, float[] x, int ldx, int[] k) {
+ org.netlib.lapack.Slapmt.slapmt(forwrd, m, n, x, 0, ldx, k, 0);
+ }
+
+ @Override
+ public void slaqgb(int m, int n, int kl, int ku, float[] ab, int ldab, float[] r, float[] c, float rowcnd, float colcnd, float amax, StringW equed) {
+ org.netlib.lapack.Slaqgb.slaqgb(m, n, kl, ku, ab, 0, ldab, r, 0, c, 0, rowcnd, colcnd, amax, equed);
+ }
+
+ @Override
+ public void slaqge(int m, int n, float[] a, int lda, float[] r, float[] c, float rowcnd, float colcnd, float amax, StringW equed) {
+ org.netlib.lapack.Slaqge.slaqge(m, n, a, 0, lda, r, 0, c, 0, rowcnd, colcnd, amax, equed);
+ }
+
+ @Override
+ public void slaqp2(int m, int n, int offset, float[] a, int lda, int[] jpvt, float[] tau, float[] vn1, float[] vn2, float[] work) {
+ org.netlib.lapack.Slaqp2.slaqp2(m, n, offset, a, 0, lda, jpvt, 0, tau, 0, vn1, 0, vn2, 0, work, 0);
+ }
+
+ @Override
+ public void slaqps(int m, int n, int offset, int nb, intW kb, float[] a, int lda, int[] jpvt, float[] tau, float[] vn1, float[] vn2, float[] auxv, float[] f, int ldf) {
+ org.netlib.lapack.Slaqps.slaqps(m, n, offset, nb, kb, a, 0, lda, jpvt, 0, tau, 0, vn1, 0, vn2, 0, auxv, 0, f, 0, ldf);
+ }
+
+ @Override
+ public void slaqsb(String uplo, int n, int kd, float[] ab, int ldab, float[] s, float scond, float amax, StringW equed) {
+ org.netlib.lapack.Slaqsb.slaqsb(uplo, n, kd, ab, 0, ldab, s, 0, scond, amax, equed);
+ }
+
+ @Override
+ public void slaqsp(String uplo, int n, float[] ap, float[] s, float scond, float amax, StringW equed) {
+ org.netlib.lapack.Slaqsp.slaqsp(uplo, n, ap, 0, s, 0, scond, amax, equed);
+ }
+
+ @Override
+ public void slaqsy(String uplo, int n, float[] a, int lda, float[] s, float scond, float amax, StringW equed) {
+ org.netlib.lapack.Slaqsy.slaqsy(uplo, n, a, 0, lda, s, 0, scond, amax, equed);
+ }
+
+ @Override
+ public void slaqtr(boolean ltran, boolean lreal, int n, float[] t, int ldt, float[] b, float w, floatW scale, float[] x, float[] work, intW info) {
+ org.netlib.lapack.Slaqtr.slaqtr(ltran, lreal, n, t, 0, ldt, b, 0, w, scale, x, 0, work, 0, info);
+ }
+
+ @Override
+ public void slar2v(int n, float[] x, float[] y, float[] z, int incx, float[] c, float[] s, int incc) {
+ org.netlib.lapack.Slar2v.slar2v(n, x, 0, y, 0, z, 0, incx, c, 0, s, 0, incc);
+ }
+
+ @Override
+ public void slarf(String side, int m, int n, float[] v, int incv, float tau, float[] c, int Ldc, float[] work) {
+ org.netlib.lapack.Slarf.slarf(side, m, n, v, 0, incv, tau, c, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void slarfb(String side, String trans, String direct, String storev, int m, int n, int k, float[] v, int ldv, float[] t, int ldt, float[] c, int Ldc, float[] work, int ldwork) {
+ org.netlib.lapack.Slarfb.slarfb(side, trans, direct, storev, m, n, k, v, 0, ldv, t, 0, ldt, c, 0, Ldc, work, 0, ldwork);
+ }
+
+ @Override
+ public void slarfg(int n, floatW alpha, float[] x, int incx, floatW tau) {
+ org.netlib.lapack.Slarfg.slarfg(n, alpha, x, 0, incx, tau);
+ }
+
+ @Override
+ public void slarft(String direct, String storev, int n, int k, float[] v, int ldv, float[] tau, float[] t, int ldt) {
+ org.netlib.lapack.Slarft.slarft(direct, storev, n, k, v, 0, ldv, tau, 0, t, 0, ldt);
+ }
+
+ @Override
+ public void slarfx(String side, int m, int n, float[] v, float tau, float[] c, int Ldc, float[] work) {
+ org.netlib.lapack.Slarfx.slarfx(side, m, n, v, 0, tau, c, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void slargv(int n, float[] x, int incx, float[] y, int incy, float[] c, int incc) {
+ org.netlib.lapack.Slargv.slargv(n, x, 0, incx, y, 0, incy, c, 0, incc);
+ }
+
+ @Override
+ public void slarnv(int idist, int[] iseed, int n, float[] x) {
+ org.netlib.lapack.Slarnv.slarnv(idist, iseed, 0, n, x, 0);
+ }
+
+ @Override
+ public void slartg(float f, float g, floatW cs, floatW sn, floatW r) {
+ org.netlib.lapack.Slartg.slartg(f, g, cs, sn, r);
+ }
+
+ @Override
+ public void slartv(int n, float[] x, int incx, float[] y, int incy, float[] c, float[] s, int incc) {
+ org.netlib.lapack.Slartv.slartv(n, x, 0, incx, y, 0, incy, c, 0, s, 0, incc);
+ }
+
+ @Override
+ public void slaruv(int[] iseed, int n, float[] x) {
+ org.netlib.lapack.Slaruv.slaruv(iseed, 0, n, x, 0);
+ }
+
+ @Override
+ public void slarz(String side, int m, int n, int l, float[] v, int incv, float tau, float[] c, int Ldc, float[] work) {
+ org.netlib.lapack.Slarz.slarz(side, m, n, l, v, 0, incv, tau, c, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void slarzb(String side, String trans, String direct, String storev, int m, int n, int k, int l, float[] v, int ldv, float[] t, int ldt, float[] c, int Ldc, float[] work, int ldwork) {
+ org.netlib.lapack.Slarzb.slarzb(side, trans, direct, storev, m, n, k, l, v, 0, ldv, t, 0, ldt, c, 0, Ldc, work, 0, ldwork);
+ }
+
+ @Override
+ public void slarzt(String direct, String storev, int n, int k, float[] v, int ldv, float[] tau, float[] t, int ldt) {
+ org.netlib.lapack.Slarzt.slarzt(direct, storev, n, k, v, 0, ldv, tau, 0, t, 0, ldt);
+ }
+
+ @Override
+ public void slas2(float f, float g, float h, floatW ssmin, floatW ssmax) {
+ org.netlib.lapack.Slas2.slas2(f, g, h, ssmin, ssmax);
+ }
+
+ @Override
+ public void slascl(String type, int kl, int ku, float cfrom, float cto, int m, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Slascl.slascl(type, kl, ku, cfrom, cto, m, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void slasd0(int n, int sqre, float[] d, float[] e, float[] u, int ldu, float[] vt, int ldvt, int smlsiz, int[] iwork, float[] work, intW info) {
+ org.netlib.lapack.Slasd0.slasd0(n, sqre, d, 0, e, 0, u, 0, ldu, vt, 0, ldvt, smlsiz, iwork, 0, work, 0, info);
+ }
+
+ @Override
+ public void slasd1(int nl, int nr, int sqre, float[] d, floatW alpha, floatW beta, float[] u, int ldu, float[] vt, int ldvt, int[] idxq, int[] iwork, float[] work, intW info) {
+ org.netlib.lapack.Slasd1.slasd1(nl, nr, sqre, d, 0, alpha, beta, u, 0, ldu, vt, 0, ldvt, idxq, 0, iwork, 0, work, 0, info);
+ }
+
+ @Override
+ public void slasd2(int nl, int nr, int sqre, intW k, float[] d, float[] z, float alpha, float beta, float[] u, int ldu, float[] vt, int ldvt, float[] dsigma, float[] u2, int ldu2, float[] vt2, int ldvt2, int[] idxp, int[] idx, int[] idxc, int[] idxq, int[] coltyp, intW info) {
+ org.netlib.lapack.Slasd2.slasd2(nl, nr, sqre, k, d, 0, z, 0, alpha, beta, u, 0, ldu, vt, 0, ldvt, dsigma, 0, u2, 0, ldu2, vt2, 0, ldvt2, idxp, 0, idx, 0, idxc, 0, idxq, 0, coltyp, 0, info);
+ }
+
+ @Override
+ public void slasd3(int nl, int nr, int sqre, int k, float[] d, float[] q, int ldq, float[] dsigma, float[] u, int ldu, float[] u2, int ldu2, float[] vt, int ldvt, float[] vt2, int ldvt2, int[] idxc, int[] ctot, float[] z, intW info) {
+ org.netlib.lapack.Slasd3.slasd3(nl, nr, sqre, k, d, 0, q, 0, ldq, dsigma, 0, u, 0, ldu, u2, 0, ldu2, vt, 0, ldvt, vt2, 0, ldvt2, idxc, 0, ctot, 0, z, 0, info);
+ }
+
+ @Override
+ public void slasd4(int n, int i, float[] d, float[] z, float[] delta, float rho, floatW sigma, float[] work, intW info) {
+ org.netlib.lapack.Slasd4.slasd4(n, i, d, 0, z, 0, delta, 0, rho, sigma, work, 0, info);
+ }
+
+ @Override
+ public void slasd5(int i, float[] d, float[] z, float[] delta, float rho, floatW dsigma, float[] work) {
+ org.netlib.lapack.Slasd5.slasd5(i, d, 0, z, 0, delta, 0, rho, dsigma, work, 0);
+ }
+
+ @Override
+ public void slasd6(int icompq, int nl, int nr, int sqre, float[] d, float[] vf, float[] vl, floatW alpha, floatW beta, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, float[] poles, float[] difl, float[] difr, float[] z, intW k, floatW c, floatW s, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slasd6.slasd6(icompq, nl, nr, sqre, d, 0, vf, 0, vl, 0, alpha, beta, idxq, 0, perm, 0, givptr, givcol, 0, ldgcol, givnum, 0, ldgnum, poles, 0, difl, 0, difr, 0, z, 0, k, c, s, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slasd7(int icompq, int nl, int nr, int sqre, intW k, float[] d, float[] z, float[] zw, float[] vf, float[] vfw, float[] vl, float[] vlw, float alpha, float beta, float[] dsigma, int[] idx, int[] idxp, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, floatW c, floatW s, intW info) {
+ org.netlib.lapack.Slasd7.slasd7(icompq, nl, nr, sqre, k, d, 0, z, 0, zw, 0, vf, 0, vfw, 0, vl, 0, vlw, 0, alpha, beta, dsigma, 0, idx, 0, idxp, 0, idxq, 0, perm, 0, givptr, givcol, 0, ldgcol, givnum, 0, ldgnum, c, s, info);
+ }
+
+ @Override
+ public void slasd8(int icompq, int k, float[] d, float[] z, float[] vf, float[] vl, float[] difl, float[] difr, int lddifr, float[] dsigma, float[] work, intW info) {
+ org.netlib.lapack.Slasd8.slasd8(icompq, k, d, 0, z, 0, vf, 0, vl, 0, difl, 0, difr, 0, lddifr, dsigma, 0, work, 0, info);
+ }
+
+ @Override
+ public void slasda(int icompq, int smlsiz, int n, int sqre, float[] d, float[] e, float[] u, int ldu, float[] vt, int[] k, float[] difl, float[] difr, float[] z, float[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, float[] givnum, float[] c, float[] s, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slasda.slasda(icompq, smlsiz, n, sqre, d, 0, e, 0, u, 0, ldu, vt, 0, k, 0, difl, 0, difr, 0, z, 0, poles, 0, givptr, 0, givcol, 0, ldgcol, perm, 0, givnum, 0, c, 0, s, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void slasdq(String uplo, int sqre, int n, int ncvt, int nru, int ncc, float[] d, float[] e, float[] vt, int ldvt, float[] u, int ldu, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Slasdq.slasdq(uplo, sqre, n, ncvt, nru, ncc, d, 0, e, 0, vt, 0, ldvt, u, 0, ldu, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void slasdt(int n, intW lvl, intW nd, int[] inode, int[] ndiml, int[] ndimr, int msub) {
+ org.netlib.lapack.Slasdt.slasdt(n, lvl, nd, inode, 0, ndiml, 0, ndimr, 0, msub);
+ }
+
+ @Override
+ public void slaset(String uplo, int m, int n, float alpha, float beta, float[] a, int lda) {
+ org.netlib.lapack.Slaset.slaset(uplo, m, n, alpha, beta, a, 0, lda);
+ }
+
+ @Override
+ public void slasq1(int n, float[] d, float[] e, float[] work, intW info) {
+ org.netlib.lapack.Slasq1.slasq1(n, d, 0, e, 0, work, 0, info);
+ }
+
+ @Override
+ public void slasq2(int n, float[] z, intW info) {
+ org.netlib.lapack.Slasq2.slasq2(n, z, 0, info);
+ }
+
+ @Override
+ public void slasq3(int i0, intW n0, float[] z, int pp, floatW dmin, floatW sigma, floatW desig, floatW qmax, intW nfail, intW iter, intW ndiv, boolean ieee) {
+ org.netlib.lapack.Slasq3.slasq3(i0, n0, z, 0, pp, dmin, sigma, desig, qmax, nfail, iter, ndiv, ieee);
+ }
+
+ @Override
+ public void slasq4(int i0, int n0, float[] z, int pp, int n0in, float dmin, float dmin1, float dmin2, float dn, float dn1, float dn2, floatW tau, intW ttype) {
+ org.netlib.lapack.Slasq4.slasq4(i0, n0, z, 0, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, tau, ttype);
+ }
+
+ @Override
+ public void slasq5(int i0, int n0, float[] z, int pp, float tau, floatW dmin, floatW dmin1, floatW dmin2, floatW dn, floatW dnm1, floatW dnm2, boolean ieee) {
+ org.netlib.lapack.Slasq5.slasq5(i0, n0, z, 0, pp, tau, dmin, dmin1, dmin2, dn, dnm1, dnm2, ieee);
+ }
+
+ @Override
+ public void slasq6(int i0, int n0, float[] z, int pp, floatW dmin, floatW dmin1, floatW dmin2, floatW dn, floatW dnm1, floatW dnm2) {
+ org.netlib.lapack.Slasq6.slasq6(i0, n0, z, 0, pp, dmin, dmin1, dmin2, dn, dnm1, dnm2);
+ }
+
+ @Override
+ public void slasr(String side, String pivot, String direct, int m, int n, float[] c, float[] s, float[] a, int lda) {
+ org.netlib.lapack.Slasr.slasr(side, pivot, direct, m, n, c, 0, s, 0, a, 0, lda);
+ }
+
+ @Override
+ public void slasrt(String id, int n, float[] d, intW info) {
+ org.netlib.lapack.Slasrt.slasrt(id, n, d, 0, info);
+ }
+
+ @Override
+ public void slassq(int n, float[] x, int incx, floatW scale, floatW sumsq) {
+ org.netlib.lapack.Slassq.slassq(n, x, 0, incx, scale, sumsq);
+ }
+
+ @Override
+ public void slasv2(float f, float g, float h, floatW ssmin, floatW ssmax, floatW snr, floatW csr, floatW snl, floatW csl) {
+ org.netlib.lapack.Slasv2.slasv2(f, g, h, ssmin, ssmax, snr, csr, snl, csl);
+ }
+
+ @Override
+ public void slaswp(int n, float[] a, int lda, int k1, int k2, int[] ipiv, int incx) {
+ org.netlib.lapack.Slaswp.slaswp(n, a, 0, lda, k1, k2, ipiv, 0, incx);
+ }
+
+ @Override
+ public void slasy2(boolean ltranl, boolean ltranr, int isgn, int n1, int n2, float[] tl, int ldtl, float[] tr, int ldtr, float[] b, int ldb, floatW scale, float[] x, int ldx, floatW xnorm, intW info) {
+ org.netlib.lapack.Slasy2.slasy2(ltranl, ltranr, isgn, n1, n2, tl, 0, ldtl, tr, 0, ldtr, b, 0, ldb, scale, x, 0, ldx, xnorm, info);
+ }
+
+ @Override
+ public void slasyf(String uplo, int n, int nb, intW kb, float[] a, int lda, int[] ipiv, float[] w, int ldw, intW info) {
+ org.netlib.lapack.Slasyf.slasyf(uplo, n, nb, kb, a, 0, lda, ipiv, 0, w, 0, ldw, info);
+ }
+
+ @Override
+ public void slatbs(String uplo, String trans, String diag, String normin, int n, int kd, float[] ab, int ldab, float[] x, floatW scale, float[] cnorm, intW info) {
+ org.netlib.lapack.Slatbs.slatbs(uplo, trans, diag, normin, n, kd, ab, 0, ldab, x, 0, scale, cnorm, 0, info);
+ }
+
+ @Override
+ public void slatdf(int ijob, int n, float[] z, int ldz, float[] rhs, floatW rdsum, floatW rdscal, int[] ipiv, int[] jpiv) {
+ org.netlib.lapack.Slatdf.slatdf(ijob, n, z, 0, ldz, rhs, 0, rdsum, rdscal, ipiv, 0, jpiv, 0);
+ }
+
+ @Override
+ public void slatps(String uplo, String trans, String diag, String normin, int n, float[] ap, float[] x, floatW scale, float[] cnorm, intW info) {
+ org.netlib.lapack.Slatps.slatps(uplo, trans, diag, normin, n, ap, 0, x, 0, scale, cnorm, 0, info);
+ }
+
+ @Override
+ public void slatrd(String uplo, int n, int nb, float[] a, int lda, float[] e, float[] tau, float[] w, int ldw) {
+ org.netlib.lapack.Slatrd.slatrd(uplo, n, nb, a, 0, lda, e, 0, tau, 0, w, 0, ldw);
+ }
+
+ @Override
+ public void slatrs(String uplo, String trans, String diag, String normin, int n, float[] a, int lda, float[] x, floatW scale, float[] cnorm, intW info) {
+ org.netlib.lapack.Slatrs.slatrs(uplo, trans, diag, normin, n, a, 0, lda, x, 0, scale, cnorm, 0, info);
+ }
+
+ @Override
+ public void slatrz(int m, int n, int l, float[] a, int lda, float[] tau, float[] work) {
+ org.netlib.lapack.Slatrz.slatrz(m, n, l, a, 0, lda, tau, 0, work, 0);
+ }
+
+ @Override
+ public void slatzm(String side, int m, int n, float[] v, int incv, float tau, float[] c1, float[] c2, int Ldc, float[] work) {
+ org.netlib.lapack.Slatzm.slatzm(side, m, n, v, 0, incv, tau, c1, 0, c2, 0, Ldc, work, 0);
+ }
+
+ @Override
+ public void slauu2(String uplo, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Slauu2.slauu2(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void slauum(String uplo, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Slauum.slauum(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void sopgtr(String uplo, int n, float[] ap, float[] tau, float[] q, int ldq, float[] work, intW info) {
+ org.netlib.lapack.Sopgtr.sopgtr(uplo, n, ap, 0, tau, 0, q, 0, ldq, work, 0, info);
+ }
+
+ @Override
+ public void sopmtr(String side, String uplo, String trans, int m, int n, float[] ap, float[] tau, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sopmtr.sopmtr(side, uplo, trans, m, n, ap, 0, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sorg2l(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sorg2l.sorg2l(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sorg2r(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sorg2r.sorg2r(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sorgbr(String vect, int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorgbr.sorgbr(vect, m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorghr(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorghr.sorghr(n, ilo, ihi, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorgl2(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sorgl2.sorgl2(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sorglq(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorglq.sorglq(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorgql(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorgql.sorgql(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorgqr(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorgqr.sorgqr(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorgr2(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info) {
+ org.netlib.lapack.Sorgr2.sorgr2(m, n, k, a, 0, lda, tau, 0, work, 0, info);
+ }
+
+ @Override
+ public void sorgrq(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorgrq.sorgrq(m, n, k, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorgtr(String uplo, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sorgtr.sorgtr(uplo, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorm2l(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sorm2l.sorm2l(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sorm2r(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sorm2r.sorm2r(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sormbr(String vect, String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormbr.sormbr(vect, side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sormhr(String side, String trans, int m, int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormhr.sormhr(side, trans, m, n, ilo, ihi, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sorml2(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sorml2.sorml2(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sormlq(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormlq.sormlq(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sormql(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormql.sormql(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sormqr(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormqr.sormqr(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sormr2(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sormr2.sormr2(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sormr3(String side, String trans, int m, int n, int k, int l, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info) {
+ org.netlib.lapack.Sormr3.sormr3(side, trans, m, n, k, l, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, info);
+ }
+
+ @Override
+ public void sormrq(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormrq.sormrq(side, trans, m, n, k, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sormrz(String side, String trans, int m, int n, int k, int l, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormrz.sormrz(side, trans, m, n, k, l, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void sormtr(String side, String uplo, String trans, int m, int n, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Sormtr.sormtr(side, uplo, trans, m, n, a, 0, lda, tau, 0, c, 0, Ldc, work, 0, lwork, info);
+ }
+
+ @Override
+ public void spbcon(String uplo, int n, int kd, float[] ab, int ldab, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Spbcon.spbcon(uplo, n, kd, ab, 0, ldab, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void spbequ(String uplo, int n, int kd, float[] ab, int ldab, float[] s, floatW scond, floatW amax, intW info) {
+ org.netlib.lapack.Spbequ.spbequ(uplo, n, kd, ab, 0, ldab, s, 0, scond, amax, info);
+ }
+
+ @Override
+ public void spbrfs(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Spbrfs.spbrfs(uplo, n, kd, nrhs, ab, 0, ldab, afb, 0, ldafb, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void spbstf(String uplo, int n, int kd, float[] ab, int ldab, intW info) {
+ org.netlib.lapack.Spbstf.spbstf(uplo, n, kd, ab, 0, ldab, info);
+ }
+
+ @Override
+ public void spbsv(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Spbsv.spbsv(uplo, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, info);
+ }
+
+ @Override
+ public void spbsvx(String fact, String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Spbsvx.spbsvx(fact, uplo, n, kd, nrhs, ab, 0, ldab, afb, 0, ldafb, equed, s, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void spbtf2(String uplo, int n, int kd, float[] ab, int ldab, intW info) {
+ org.netlib.lapack.Spbtf2.spbtf2(uplo, n, kd, ab, 0, ldab, info);
+ }
+
+ @Override
+ public void spbtrf(String uplo, int n, int kd, float[] ab, int ldab, intW info) {
+ org.netlib.lapack.Spbtrf.spbtrf(uplo, n, kd, ab, 0, ldab, info);
+ }
+
+ @Override
+ public void spbtrs(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Spbtrs.spbtrs(uplo, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, info);
+ }
+
+ @Override
+ public void spocon(String uplo, int n, float[] a, int lda, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Spocon.spocon(uplo, n, a, 0, lda, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void spoequ(int n, float[] a, int lda, float[] s, floatW scond, floatW amax, intW info) {
+ org.netlib.lapack.Spoequ.spoequ(n, a, 0, lda, s, 0, scond, amax, info);
+ }
+
+ @Override
+ public void sporfs(String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sporfs.sporfs(uplo, n, nrhs, a, 0, lda, af, 0, ldaf, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sposv(String uplo, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sposv.sposv(uplo, n, nrhs, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sposvx(String fact, String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sposvx.sposvx(fact, uplo, n, nrhs, a, 0, lda, af, 0, ldaf, equed, s, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void spotf2(String uplo, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Spotf2.spotf2(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void spotrf(String uplo, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Spotrf.spotrf(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void spotri(String uplo, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Spotri.spotri(uplo, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void spotrs(String uplo, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Spotrs.spotrs(uplo, n, nrhs, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sppcon(String uplo, int n, float[] ap, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sppcon.sppcon(uplo, n, ap, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sppequ(String uplo, int n, float[] ap, float[] s, floatW scond, floatW amax, intW info) {
+ org.netlib.lapack.Sppequ.sppequ(uplo, n, ap, 0, s, 0, scond, amax, info);
+ }
+
+ @Override
+ public void spprfs(String uplo, int n, int nrhs, float[] ap, float[] afp, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Spprfs.spprfs(uplo, n, nrhs, ap, 0, afp, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sppsv(String uplo, int n, int nrhs, float[] ap, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sppsv.sppsv(uplo, n, nrhs, ap, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sppsvx(String fact, String uplo, int n, int nrhs, float[] ap, float[] afp, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sppsvx.sppsvx(fact, uplo, n, nrhs, ap, 0, afp, 0, equed, s, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void spptrf(String uplo, int n, float[] ap, intW info) {
+ org.netlib.lapack.Spptrf.spptrf(uplo, n, ap, 0, info);
+ }
+
+ @Override
+ public void spptri(String uplo, int n, float[] ap, intW info) {
+ org.netlib.lapack.Spptri.spptri(uplo, n, ap, 0, info);
+ }
+
+ @Override
+ public void spptrs(String uplo, int n, int nrhs, float[] ap, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Spptrs.spptrs(uplo, n, nrhs, ap, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sptcon(int n, float[] d, float[] e, float anorm, floatW rcond, float[] work, intW info) {
+ org.netlib.lapack.Sptcon.sptcon(n, d, 0, e, 0, anorm, rcond, work, 0, info);
+ }
+
+ @Override
+ public void spteqr(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Spteqr.spteqr(compz, n, d, 0, e, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void sptrfs(int n, int nrhs, float[] d, float[] e, float[] df, float[] ef, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, intW info) {
+ org.netlib.lapack.Sptrfs.sptrfs(n, nrhs, d, 0, e, 0, df, 0, ef, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, info);
+ }
+
+ @Override
+ public void sptsv(int n, int nrhs, float[] d, float[] e, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sptsv.sptsv(n, nrhs, d, 0, e, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sptsvx(String fact, int n, int nrhs, float[] d, float[] e, float[] df, float[] ef, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, intW info) {
+ org.netlib.lapack.Sptsvx.sptsvx(fact, n, nrhs, d, 0, e, 0, df, 0, ef, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, info);
+ }
+
+ @Override
+ public void spttrf(int n, float[] d, float[] e, intW info) {
+ org.netlib.lapack.Spttrf.spttrf(n, d, 0, e, 0, info);
+ }
+
+ @Override
+ public void spttrs(int n, int nrhs, float[] d, float[] e, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Spttrs.spttrs(n, nrhs, d, 0, e, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sptts2(int n, int nrhs, float[] d, float[] e, float[] b, int ldb) {
+ org.netlib.lapack.Sptts2.sptts2(n, nrhs, d, 0, e, 0, b, 0, ldb);
+ }
+
+ @Override
+ public void srscl(int n, float sa, float[] sx, int incx) {
+ org.netlib.lapack.Srscl.srscl(n, sa, sx, 0, incx);
+ }
+
+ @Override
+ public void ssbev(String jobz, String uplo, int n, int kd, float[] ab, int ldab, float[] w, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Ssbev.ssbev(jobz, uplo, n, kd, ab, 0, ldab, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void ssbevd(String jobz, String uplo, int n, int kd, float[] ab, int ldab, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Ssbevd.ssbevd(jobz, uplo, n, kd, ab, 0, ldab, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void ssbevx(String jobz, String range, String uplo, int n, int kd, float[] ab, int ldab, float[] q, int ldq, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Ssbevx.ssbevx(jobz, range, uplo, n, kd, ab, 0, ldab, q, 0, ldq, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssbgst(String vect, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] x, int ldx, float[] work, intW info) {
+ org.netlib.lapack.Ssbgst.ssbgst(vect, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, x, 0, ldx, work, 0, info);
+ }
+
+ @Override
+ public void ssbgv(String jobz, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] w, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Ssbgv.ssbgv(jobz, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void ssbgvd(String jobz, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Ssbgvd.ssbgvd(jobz, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void ssbgvx(String jobz, String range, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] q, int ldq, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Ssbgvx.ssbgvx(jobz, range, uplo, n, ka, kb, ab, 0, ldab, bb, 0, ldbb, q, 0, ldq, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssbtrd(String vect, String uplo, int n, int kd, float[] ab, int ldab, float[] d, float[] e, float[] q, int ldq, float[] work, intW info) {
+ org.netlib.lapack.Ssbtrd.ssbtrd(vect, uplo, n, kd, ab, 0, ldab, d, 0, e, 0, q, 0, ldq, work, 0, info);
+ }
+
+ @Override
+ public void sspcon(String uplo, int n, float[] ap, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sspcon.sspcon(uplo, n, ap, 0, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sspev(String jobz, String uplo, int n, float[] ap, float[] w, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Sspev.sspev(jobz, uplo, n, ap, 0, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void sspevd(String jobz, String uplo, int n, float[] ap, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sspevd.sspevd(jobz, uplo, n, ap, 0, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void sspevx(String jobz, String range, String uplo, int n, float[] ap, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Sspevx.sspevx(jobz, range, uplo, n, ap, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void sspgst(int itype, String uplo, int n, float[] ap, float[] bp, intW info) {
+ org.netlib.lapack.Sspgst.sspgst(itype, uplo, n, ap, 0, bp, 0, info);
+ }
+
+ @Override
+ public void sspgv(int itype, String jobz, String uplo, int n, float[] ap, float[] bp, float[] w, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Sspgv.sspgv(itype, jobz, uplo, n, ap, 0, bp, 0, w, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void sspgvd(int itype, String jobz, String uplo, int n, float[] ap, float[] bp, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sspgvd.sspgvd(itype, jobz, uplo, n, ap, 0, bp, 0, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void sspgvx(int itype, String jobz, String range, String uplo, int n, float[] ap, float[] bp, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Sspgvx.sspgvx(itype, jobz, range, uplo, n, ap, 0, bp, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssprfs(String uplo, int n, int nrhs, float[] ap, float[] afp, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Ssprfs.ssprfs(uplo, n, nrhs, ap, 0, afp, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sspsv(String uplo, int n, int nrhs, float[] ap, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Sspsv.sspsv(uplo, n, nrhs, ap, 0, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sspsvx(String fact, String uplo, int n, int nrhs, float[] ap, float[] afp, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sspsvx.sspsvx(fact, uplo, n, nrhs, ap, 0, afp, 0, ipiv, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void ssptrd(String uplo, int n, float[] ap, float[] d, float[] e, float[] tau, intW info) {
+ org.netlib.lapack.Ssptrd.ssptrd(uplo, n, ap, 0, d, 0, e, 0, tau, 0, info);
+ }
+
+ @Override
+ public void ssptrf(String uplo, int n, float[] ap, int[] ipiv, intW info) {
+ org.netlib.lapack.Ssptrf.ssptrf(uplo, n, ap, 0, ipiv, 0, info);
+ }
+
+ @Override
+ public void ssptri(String uplo, int n, float[] ap, int[] ipiv, float[] work, intW info) {
+ org.netlib.lapack.Ssptri.ssptri(uplo, n, ap, 0, ipiv, 0, work, 0, info);
+ }
+
+ @Override
+ public void ssptrs(String uplo, int n, int nrhs, float[] ap, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Ssptrs.ssptrs(uplo, n, nrhs, ap, 0, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void sstebz(String range, String order, int n, float vl, float vu, int il, int iu, float abstol, float[] d, float[] e, intW m, intW nsplit, float[] w, int[] iblock, int[] isplit, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Sstebz.sstebz(range, order, n, vl, vu, il, iu, abstol, d, 0, e, 0, m, nsplit, w, 0, iblock, 0, isplit, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void sstedc(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sstedc.sstedc(compz, n, d, 0, e, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void sstegr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sstegr.sstegr(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, isuppz, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void sstein(int n, float[] d, float[] e, int m, float[] w, int[] iblock, int[] isplit, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Sstein.sstein(n, d, 0, e, 0, m, w, 0, iblock, 0, isplit, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssteqr(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Ssteqr.ssteqr(compz, n, d, 0, e, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void ssterf(int n, float[] d, float[] e, intW info) {
+ org.netlib.lapack.Ssterf.ssterf(n, d, 0, e, 0, info);
+ }
+
+ @Override
+ public void sstev(String jobz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info) {
+ org.netlib.lapack.Sstev.sstev(jobz, n, d, 0, e, 0, z, 0, ldz, work, 0, info);
+ }
+
+ @Override
+ public void sstevd(String jobz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sstevd.sstevd(jobz, n, d, 0, e, 0, z, 0, ldz, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void sstevr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sstevr.sstevr(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, isuppz, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void sstevx(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Sstevx.sstevx(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssycon(String uplo, int n, float[] a, int lda, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Ssycon.ssycon(uplo, n, a, 0, lda, ipiv, 0, anorm, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void ssyev(String jobz, String uplo, int n, float[] a, int lda, float[] w, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Ssyev.ssyev(jobz, uplo, n, a, 0, lda, w, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void ssyevd(String jobz, String uplo, int n, float[] a, int lda, float[] w, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Ssyevd.ssyevd(jobz, uplo, n, a, 0, lda, w, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void ssyevr(String jobz, String range, String uplo, int n, float[] a, int lda, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Ssyevr.ssyevr(jobz, range, uplo, n, a, 0, lda, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, isuppz, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void ssyevx(String jobz, String range, String uplo, int n, float[] a, int lda, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Ssyevx.ssyevx(jobz, range, uplo, n, a, 0, lda, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssygs2(int itype, String uplo, int n, float[] a, int lda, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Ssygs2.ssygs2(itype, uplo, n, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void ssygst(int itype, String uplo, int n, float[] a, int lda, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Ssygst.ssygst(itype, uplo, n, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void ssygv(int itype, String jobz, String uplo, int n, float[] a, int lda, float[] b, int ldb, float[] w, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Ssygv.ssygv(itype, jobz, uplo, n, a, 0, lda, b, 0, ldb, w, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void ssygvd(int itype, String jobz, String uplo, int n, float[] a, int lda, float[] b, int ldb, float[] w, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Ssygvd.ssygvd(itype, jobz, uplo, n, a, 0, lda, b, 0, ldb, w, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void ssygvx(int itype, String jobz, String range, String uplo, int n, float[] a, int lda, float[] b, int ldb, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int[] ifail, intW info) {
+ org.netlib.lapack.Ssygvx.ssygvx(itype, jobz, range, uplo, n, a, 0, lda, b, 0, ldb, vl, vu, il, iu, abstol, m, w, 0, z, 0, ldz, work, 0, lwork, iwork, 0, ifail, 0, info);
+ }
+
+ @Override
+ public void ssyrfs(String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Ssyrfs.ssyrfs(uplo, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void ssysv(String uplo, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Ssysv.ssysv(uplo, n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, work, 0, lwork, info);
+ }
+
+ @Override
+ public void ssysvx(String fact, String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Ssysvx.ssysvx(fact, uplo, n, nrhs, a, 0, lda, af, 0, ldaf, ipiv, 0, b, 0, ldb, x, 0, ldx, rcond, ferr, 0, berr, 0, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void ssytd2(String uplo, int n, float[] a, int lda, float[] d, float[] e, float[] tau, intW info) {
+ org.netlib.lapack.Ssytd2.ssytd2(uplo, n, a, 0, lda, d, 0, e, 0, tau, 0, info);
+ }
+
+ @Override
+ public void ssytf2(String uplo, int n, float[] a, int lda, int[] ipiv, intW info) {
+ org.netlib.lapack.Ssytf2.ssytf2(uplo, n, a, 0, lda, ipiv, 0, info);
+ }
+
+ @Override
+ public void ssytrd(String uplo, int n, float[] a, int lda, float[] d, float[] e, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Ssytrd.ssytrd(uplo, n, a, 0, lda, d, 0, e, 0, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void ssytrf(String uplo, int n, float[] a, int lda, int[] ipiv, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Ssytrf.ssytrf(uplo, n, a, 0, lda, ipiv, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public void ssytri(String uplo, int n, float[] a, int lda, int[] ipiv, float[] work, intW info) {
+ org.netlib.lapack.Ssytri.ssytri(uplo, n, a, 0, lda, ipiv, 0, work, 0, info);
+ }
+
+ @Override
+ public void ssytrs(String uplo, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Ssytrs.ssytrs(uplo, n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void stbcon(String norm, String uplo, String diag, int n, int kd, float[] ab, int ldab, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Stbcon.stbcon(norm, uplo, diag, n, kd, ab, 0, ldab, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void stbrfs(String uplo, String trans, String diag, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Stbrfs.stbrfs(uplo, trans, diag, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void stbtrs(String uplo, String trans, String diag, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Stbtrs.stbtrs(uplo, trans, diag, n, kd, nrhs, ab, 0, ldab, b, 0, ldb, info);
+ }
+
+ @Override
+ public void stgevc(String side, String howmny, boolean[] select, int n, float[] s, int lds, float[] p, int ldp, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, intW info) {
+ org.netlib.lapack.Stgevc.stgevc(side, howmny, select, 0, n, s, 0, lds, p, 0, ldp, vl, 0, ldvl, vr, 0, ldvr, mm, m, work, 0, info);
+ }
+
+ @Override
+ public void stgex2(boolean wantq, boolean wantz, int n, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, int j1, int n1, int n2, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Stgex2.stgex2(wantq, wantz, n, a, 0, lda, b, 0, ldb, q, 0, ldq, z, 0, ldz, j1, n1, n2, work, 0, lwork, info);
+ }
+
+ @Override
+ public void stgexc(boolean wantq, boolean wantz, int n, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, intW ifst, intW ilst, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Stgexc.stgexc(wantq, wantz, n, a, 0, lda, b, 0, ldb, q, 0, ldq, z, 0, ldz, ifst, ilst, work, 0, lwork, info);
+ }
+
+ @Override
+ public void stgsen(int ijob, boolean wantq, boolean wantz, boolean[] select, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] q, int ldq, float[] z, int ldz, intW m, floatW pl, floatW pr, float[] dif, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Stgsen.stgsen(ijob, wantq, wantz, select, 0, n, a, 0, lda, b, 0, ldb, alphar, 0, alphai, 0, beta, 0, q, 0, ldq, z, 0, ldz, m, pl, pr, dif, 0, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void stgsja(String jobu, String jobv, String jobq, int m, int p, int n, int k, int l, float[] a, int lda, float[] b, int ldb, float tola, float tolb, float[] alpha, float[] beta, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, float[] work, intW ncycle, intW info) {
+ org.netlib.lapack.Stgsja.stgsja(jobu, jobv, jobq, m, p, n, k, l, a, 0, lda, b, 0, ldb, tola, tolb, alpha, 0, beta, 0, u, 0, ldu, v, 0, ldv, q, 0, ldq, work, 0, ncycle, info);
+ }
+
+ @Override
+ public void stgsna(String job, String howmny, boolean[] select, int n, float[] a, int lda, float[] b, int ldb, float[] vl, int ldvl, float[] vr, int ldvr, float[] s, float[] dif, int mm, intW m, float[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Stgsna.stgsna(job, howmny, select, 0, n, a, 0, lda, b, 0, ldb, vl, 0, ldvl, vr, 0, ldvr, s, 0, dif, 0, mm, m, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void stgsy2(String trans, int ijob, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, float[] d, int ldd, float[] e, int lde, float[] f, int ldf, floatW scale, floatW rdsum, floatW rdscal, int[] iwork, intW pq, intW info) {
+ org.netlib.lapack.Stgsy2.stgsy2(trans, ijob, m, n, a, 0, lda, b, 0, ldb, c, 0, Ldc, d, 0, ldd, e, 0, lde, f, 0, ldf, scale, rdsum, rdscal, iwork, 0, pq, info);
+ }
+
+ @Override
+ public void stgsyl(String trans, int ijob, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, float[] d, int ldd, float[] e, int lde, float[] f, int ldf, floatW scale, floatW dif, float[] work, int lwork, int[] iwork, intW info) {
+ org.netlib.lapack.Stgsyl.stgsyl(trans, ijob, m, n, a, 0, lda, b, 0, ldb, c, 0, Ldc, d, 0, ldd, e, 0, lde, f, 0, ldf, scale, dif, work, 0, lwork, iwork, 0, info);
+ }
+
+ @Override
+ public void stpcon(String norm, String uplo, String diag, int n, float[] ap, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Stpcon.stpcon(norm, uplo, diag, n, ap, 0, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void stprfs(String uplo, String trans, String diag, int n, int nrhs, float[] ap, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Stprfs.stprfs(uplo, trans, diag, n, nrhs, ap, 0, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void stptri(String uplo, String diag, int n, float[] ap, intW info) {
+ org.netlib.lapack.Stptri.stptri(uplo, diag, n, ap, 0, info);
+ }
+
+ @Override
+ public void stptrs(String uplo, String trans, String diag, int n, int nrhs, float[] ap, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Stptrs.stptrs(uplo, trans, diag, n, nrhs, ap, 0, b, 0, ldb, info);
+ }
+
+ @Override
+ public void strcon(String norm, String uplo, String diag, int n, float[] a, int lda, floatW rcond, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Strcon.strcon(norm, uplo, diag, n, a, 0, lda, rcond, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void strevc(String side, String howmny, boolean[] select, int n, float[] t, int ldt, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, intW info) {
+ org.netlib.lapack.Strevc.strevc(side, howmny, select, 0, n, t, 0, ldt, vl, 0, ldvl, vr, 0, ldvr, mm, m, work, 0, info);
+ }
+
+ @Override
+ public void strexc(String compq, int n, float[] t, int ldt, float[] q, int ldq, intW ifst, intW ilst, float[] work, intW info) {
+ org.netlib.lapack.Strexc.strexc(compq, n, t, 0, ldt, q, 0, ldq, ifst, ilst, work, 0, info);
+ }
+
+ @Override
+ public void strrfs(String uplo, String trans, String diag, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Strrfs.strrfs(uplo, trans, diag, n, nrhs, a, 0, lda, b, 0, ldb, x, 0, ldx, ferr, 0, berr, 0, work, 0, iwork, 0, info);
+ }
+
+ @Override
+ public void strsen(String job, String compq, boolean[] select, int n, float[] t, int ldt, float[] q, int ldq, float[] wr, float[] wi, intW m, floatW s, floatW sep, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Strsen.strsen(job, compq, select, 0, n, t, 0, ldt, q, 0, ldq, wr, 0, wi, 0, m, s, sep, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ @Override
+ public void strsna(String job, String howmny, boolean[] select, int n, float[] t, int ldt, float[] vl, int ldvl, float[] vr, int ldvr, float[] s, float[] sep, int mm, intW m, float[] work, int ldwork, int[] iwork, intW info) {
+ org.netlib.lapack.Strsna.strsna(job, howmny, select, 0, n, t, 0, ldt, vl, 0, ldvl, vr, 0, ldvr, s, 0, sep, 0, mm, m, work, 0, ldwork, iwork, 0, info);
+ }
+
+ @Override
+ public void strsyl(String trana, String tranb, int isgn, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, floatW scale, intW info) {
+ org.netlib.lapack.Strsyl.strsyl(trana, tranb, isgn, m, n, a, 0, lda, b, 0, ldb, c, 0, Ldc, scale, info);
+ }
+
+ @Override
+ public void strti2(String uplo, String diag, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Strti2.strti2(uplo, diag, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void strtri(String uplo, String diag, int n, float[] a, int lda, intW info) {
+ org.netlib.lapack.Strtri.strtri(uplo, diag, n, a, 0, lda, info);
+ }
+
+ @Override
+ public void strtrs(String uplo, String trans, String diag, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info) {
+ org.netlib.lapack.Strtrs.strtrs(uplo, trans, diag, n, nrhs, a, 0, lda, b, 0, ldb, info);
+ }
+
+ @Override
+ public void stzrqf(int m, int n, float[] a, int lda, float[] tau, intW info) {
+ org.netlib.lapack.Stzrqf.stzrqf(m, n, a, 0, lda, tau, 0, info);
+ }
+
+ @Override
+ public void stzrzf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Stzrzf.stzrzf(m, n, a, 0, lda, tau, 0, work, 0, lwork, info);
+ }
+
+ @Override
+ public double dlamch(String cmach) {
+ return org.netlib.lapack.Dlamch.dlamch(cmach);
+ }
+
+ @Override
+ public void dlamc1(intW beta, intW t, booleanW rnd, booleanW ieee1) {
+ org.netlib.lapack.Dlamc1.dlamc1(beta, t, rnd, ieee1);
+ }
+
+ @Override
+ public void dlamc2(intW beta, intW t, booleanW rnd, doubleW eps, intW emin, doubleW rmin, intW emax, doubleW rmax) {
+ org.netlib.lapack.Dlamc2.dlamc2(beta, t, rnd, eps, emin, rmin, emax, rmax);
+ }
+
+ @Override
+ public void dlamc4(intW emin, double start, int base) {
+ org.netlib.lapack.Dlamc4.dlamc4(emin, start, base);
+ }
+
+ @Override
+ public void dlamc5(int beta, int p, int emin, boolean ieee, intW emax, doubleW rmax) {
+ org.netlib.lapack.Dlamc5.dlamc5(beta, p, emin, ieee, emax, rmax);
+ }
+
+ @Override
+ public void slamc1(intW beta, intW t, booleanW rnd, booleanW ieee1) {
+ org.netlib.lapack.Slamc1.slamc1(beta, t, rnd, ieee1);
+ }
+
+ @Override
+ public void slamc2(intW beta, intW t, booleanW rnd, floatW eps, intW emin, floatW rmin, intW emax, floatW rmax) {
+ org.netlib.lapack.Slamc2.slamc2(beta, t, rnd, eps, emin, rmin, emax, rmax);
+ }
+
+ @Override
+ public void slamc4(intW emin, float start, int base) {
+ org.netlib.lapack.Slamc4.slamc4(emin, start, base);
+ }
+
+ @Override
+ public void slamc5(int beta, int p, int emin, boolean ieee, intW emax, floatW rmax) {
+ org.netlib.lapack.Slamc5.slamc5(beta, p, emin, ieee, emax, rmax);
+ }
+
+}
diff --git a/src/org/netlib/lapack/LAPACK.java b/src/org/netlib/lapack/LAPACK.java
new file mode 100644
index 0000000..3ab0e93
--- /dev/null
+++ b/src/org/netlib/lapack/LAPACK.java
@@ -0,0 +1,80189 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.lapack;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+
+/**
+ * LAPACK provider which will attempt to access a native implementation
+ * and falling back to use F2J if none is available.
+ *
+ * @see http://sourceforge.net/projects/f2j
+ * @see http://www.netlib.org/lapack/
+ * @author Samuel Halliday
+ */
+public abstract class LAPACK {
+
+ static private final LAPACK current;
+ static {
+ Logger logger = Logger.getLogger("org.netlib.lapack");
+ if (NativeLAPACK.INSTANCE.isLoaded) {
+ current = NativeLAPACK.INSTANCE;
+ logger.config("Using JNI for LAPACK");
+ } else {
+ current = JLAPACK.INSTANCE;
+ logger.config("Using F2J as JNI failed for LAPACK");
+ }
+ current.slamch("E");
+ current.dlamch("E");
+ }
+
+ public static LAPACK getInstance() {
+ return current;
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DBDSDC computes the singular value decomposition (SVD) of a real
+ N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
+ using a divide and conquer method, where S is a diagonal matrix
+ with non-negative diagonal elements (the singular values of B), and
+ U and VT are orthogonal matrices of left and right singular vectors,
+
+ respectively. DBDSDC can be used to compute all singular values,
+ and optionally, singular vectors or singular vectors in compact form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLASD3 for details.
+
+ The code currently calls DLASDQ if singular values only are desired.
+
+ However, it can be slightly modified to compute singular values
+ using the divide and conquer method.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal.
+ = 'L': B is lower bidiagonal.
+
+ COMPQ (input) CHARACTER*1
+ Specifies whether singular vectors are to be computed
+ as follows:
+ = 'N': Compute singular values only;
+ = 'P': Compute singular values and compute singular
+ vectors in compact form;
+ = 'I': Compute singular values and singular vectors.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the elements of E contain the offdiagonal
+ elements of the bidiagonal matrix whose SVD is desired.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, U contains the left singular vectors
+ of the bidiagonal matrix.
+ For other values of COMPQ, U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1.
+ If singular vectors are desired, then LDU >= max( 1, N ).
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, VT' contains the right singular
+ vectors of the bidiagonal matrix.
+ For other values of COMPQ, VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1.
+ If singular vectors are desired, then LDVT >= max( 1, N ).
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, Q contains all the DOUBLE PRECISION data in
+ LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, Q is not referenced.
+
+ IQ (output) INTEGER array, dimension (LDIQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, IQ contains all INTEGER data in
+ LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, IQ is not referenced.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+
+ If COMPQ = 'N' then LWORK >= (4 * N).
+ If COMPQ = 'P' then LWORK >= (6 * N).
+ If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value.
+ The update process of divide and conquer failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+ Changed dimension statement in comment describing E from (N) to
+ (N-1). Sven, 17 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param compq
+ * @param n
+ * @param d
+ * @param e
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param q
+ * @param iq
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dbdsdc(String uplo, String compq, int n, double[] d, double[] e, double[] u, int ldu, double[] vt, int ldvt, double[] q, int[] iq, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DBDSQR computes the singular values and, optionally, the right and/or
+ left singular vectors from the singular value decomposition (SVD) of
+
+ a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+ zero-shift QR algorithm. The SVD of B has the form
+
+ B = Q * S * P**T
+
+ where S is the diagonal matrix of singular values, Q is an orthogonal
+ matrix of left singular vectors, and P is an orthogonal matrix of
+ right singular vectors. If left singular vectors are requested, this
+ subroutine actually returns U*Q instead of Q, and, if right singular
+
+ vectors are requested, this subroutine returns P**T*VT instead of
+ P**T, for given real input matrices U and VT. When U and VT are the
+
+ orthogonal matrices that reduce a general matrix A to bidiagonal
+ form: A = U*B*VT, as computed by DGEBRD, then
+
+ A = (U*Q) * S * (P**T*VT)
+
+ is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+
+ for a given real input matrix C.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
+ no. 5, pp. 873-912, Sept 1990) and
+ "Accurate singular values and differential qd algorithms," by
+ B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
+ Department, University of California at Berkeley, July 1992
+ for a detailed description of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal;
+ = 'L': B is lower bidiagonal.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ NCVT (input) INTEGER
+ The number of columns of the matrix VT. NCVT >= 0.
+
+ NRU (input) INTEGER
+ The number of rows of the matrix U. NRU >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B in decreasing
+ order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the N-1 offdiagonal elements of the bidiagonal
+ matrix B.
+ On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
+ will contain the diagonal and superdiagonal elements of a
+ bidiagonal matrix orthogonally equivalent to the one given
+ as input.
+
+ VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
+ On entry, an N-by-NCVT matrix VT.
+ On exit, VT is overwritten by P**T * VT.
+ Not referenced if NCVT = 0.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT.
+ LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
+ On entry, an NRU-by-N matrix U.
+ On exit, U is overwritten by U * Q.
+ Not referenced if NRU = 0.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,NRU).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
+ On entry, an N-by-NCC matrix C.
+ On exit, C is overwritten by Q**T * C.
+ Not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ if NCVT = NRU = NCC = 0, (max(1, 4*N)) otherwise
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm did not converge; D and E contain the
+ elements of a bidiagonal matrix which is orthogonally
+ similar to the input matrix B; if INFO = i, i
+ elements of E have not converged to zero.
+
+ Internal Parameters
+ ===================
+
+ TOLMUL DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
+ TOLMUL controls the convergence criterion of the QR loop.
+ If it is positive, TOLMUL*EPS is the desired relative
+ precision in the computed singular values.
+ If it is negative, abs(TOLMUL*EPS*sigma_max) is the
+ desired absolute accuracy in the computed singular
+ values (corresponds to relative accuracy
+ abs(TOLMUL*EPS) in the largest singular value.
+ abs(TOLMUL) should be between 1 and 1/EPS, and preferably
+ between 10 (for fast convergence) and .1/EPS
+ (for there to be some accuracy in the results).
+ Default is to lose at either one eighth or 2 of the
+ available decimal digits in each computed singular value
+ (whichever is smaller).
+
+ MAXITR INTEGER, default = 6
+ MAXITR controls the maximum number of passes of the
+ algorithm through its inner loop. The algorithms stops
+ (and so fails to converge) if the number of passes
+ through the inner loop exceeds MAXITR*N**2.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ncvt
+ * @param nru
+ * @param ncc
+ * @param d
+ * @param e
+ * @param vt
+ * @param ldvt
+ * @param u
+ * @param ldu
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dbdsqr(String uplo, int n, int ncvt, int nru, int ncc, double[] d, double[] e, double[] vt, int ldvt, double[] u, int ldu, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DDISNA computes the reciprocal condition numbers for the eigenvectors
+ of a real symmetric or complex Hermitian matrix or for the left or
+ right singular vectors of a general m-by-n matrix. The reciprocal
+ condition number is the 'gap' between the corresponding eigenvalue or
+ singular value and the nearest other one.
+
+ The bound on the error, measured by angle in radians, in the I-th
+ computed vector is given by
+
+ DLAMCH( 'E' ) * ( ANORM / SEP( I ) )
+
+ where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
+
+ to be smaller than DLAMCH( 'E' )*ANORM in order to limit the size of
+
+ the error bound.
+
+ DDISNA may also be used to compute error bounds for eigenvectors of
+ the generalized symmetric definite eigenproblem.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies for which problem the reciprocal condition numbers
+
+ should be computed:
+ = 'E': the eigenvectors of a symmetric/Hermitian matrix;
+ = 'L': the left singular vectors of a general matrix;
+ = 'R': the right singular vectors of a general matrix.
+
+ M (input) INTEGER
+ The number of rows of the matrix. M >= 0.
+
+ N (input) INTEGER
+ If JOB = 'L' or 'R', the number of columns of the matrix,
+ in which case N >= 0. Ignored if JOB = 'E'.
+
+ D (input) DOUBLE PRECISION array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+
+ The eigenvalues (if JOB = 'E') or singular values (if JOB =
+ 'L' or 'R') of the matrix, in either increasing or decreasing
+ order. If singular values, they must be non-negative.
+
+ SEP (output) DOUBLE PRECISION array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+ The reciprocal condition numbers of the vectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param m
+ * @param n
+ * @param d
+ * @param sep
+ * @param info
+ */
+ public abstract void ddisna(String job, int m, int n, double[] d, double[] sep, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBBRD reduces a real general m-by-n band matrix A to upper
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ The routine computes B, and optionally forms Q or P', or computes
+ Q'*C for a given matrix C.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether or not the matrices Q and P' are to be
+ formed.
+ = 'N': do not form Q or P';
+ = 'Q': form Q only;
+ = 'P': form P' only;
+ = 'B': form both.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals of the matrix A. KU >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the m-by-n band matrix A, stored in rows 1 to
+ KL+KU+1. The j-th column of A is stored in the j-th column of
+ the array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+ On exit, A is overwritten by values generated during the
+ reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KL+KU+1.
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B.
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The superdiagonal elements of the bidiagonal matrix B.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,M)
+ If VECT = 'Q' or 'B', the m-by-m orthogonal matrix Q.
+ If VECT = 'N' or 'P', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise.
+
+ PT (output) DOUBLE PRECISION array, dimension (LDPT,N)
+ If VECT = 'P' or 'B', the n-by-n orthogonal matrix P'.
+ If VECT = 'N' or 'Q', the array PT is not referenced.
+
+ LDPT (input) INTEGER
+ The leading dimension of the array PT.
+ LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,NCC)
+ On entry, an m-by-ncc matrix C.
+ On exit, C is overwritten by Q'*C.
+ C is not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param m
+ * @param n
+ * @param ncc
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param d
+ * @param e
+ * @param q
+ * @param ldq
+ * @param pt
+ * @param ldpt
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dgbbrd(String vect, int m, int n, int ncc, int kl, int ku, double[] ab, int ldab, double[] d, double[] e, double[] q, int ldq, double[] pt, int ldpt, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBCON estimates the reciprocal of the condition number of a real
+ general band matrix A, in either the 1-norm or the infinity-norm,
+ using the LU factorization computed by DGBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by DGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ ANORM (input) DOUBLE PRECISION
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgbcon(String norm, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBEQU computes row and column scalings intended to equilibrate an
+ M-by-N band matrix A and reduce its condition number. R returns the
+
+ row scale factors and C the column scale factors, chosen to try to
+ make the largest element in each row and column of the matrix B with
+
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ R (output) DOUBLE PRECISION array, dimension (M)
+ If INFO = 0, or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) DOUBLE PRECISION
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) DOUBLE PRECISION
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param info
+ */
+ public abstract void dgbequ(int m, int n, int kl, int ku, double[] ab, int ldab, double[] r, double[] c, doubleW rowcnd, doubleW colcnd, doubleW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is banded, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The original band matrix A, stored in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input) DOUBLE PRECISION array, dimension (LDAFB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by DGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
+
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGBTRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DGBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgbrfs(String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBSV computes the solution to a real system of linear equations
+ A * X = B, where A is a band matrix of order N with KL subdiagonals
+ and KU superdiagonals, and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as A = L * U, where L is a product of permutation
+ and unit lower triangular matrices with KL subdiagonals, and U is
+ upper triangular with KL+KU superdiagonals. The factored form of A
+ is then used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * * + + + * * * u14 u25 u36
+ * * + + + + * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dgbsv(int n, int kl, int ku, int nrhs, double[] ab, int ldab, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B, A**T * X = B, or A**H * X = B,
+
+ where A is a band matrix of order N with KL subdiagonals and KU
+ superdiagonals, and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed by this subroutine:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = L * U,
+ where L is a product of permutation and unit lower triangular
+ matrices with KL subdiagonals, and U is upper triangular with
+ KL+KU superdiagonals.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB and IPIV contain the factored form of
+ A. If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ AB, AFB, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
+
+ If FACT = 'F' and EQUED is not 'N', then A must have been
+ equilibrated by the scaling factors in R and/or C. AB is not
+ modified if FACT = 'F' or 'N', or if FACT = 'E' and
+ EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input or output) DOUBLE PRECISION array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains details of the LU factorization of the band matrix
+ A, as computed by DGBTRF. U is stored as an upper triangular
+ band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
+ and the multipliers used during the factorization are stored
+
+ in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
+ the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns details of the LU factorization of A.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns details of the LU factorization of the equilibrated
+ matrix A (see the description of AB for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
+
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = L*U
+ as computed by DGBTRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) DOUBLE PRECISION array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (3*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param trans
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param ipiv
+ * @param equed
+ * @param r
+ * @param c
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgbsvx(String fact, String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, int[] ipiv, StringW equed, double[] r, double[] c, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBTF2 computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * * + + + * * * u14 u25 u36
+ * * + + + + * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U, because of fill-in resulting from the row
+ interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dgbtf2(int m, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBTRF computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * * + + + * * * u14 u25 u36
+ * * + + + + * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dgbtrf(int m, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGBTRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general band matrix A using the LU factorization computed
+ by DGBTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by DGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dgbtrs(String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBAK forms the right or left eigenvectors of a real general matrix
+
+ by backward transformation on the computed eigenvectors of the
+ balanced matrix output by DGEBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N', do nothing, return immediately;
+ = 'P', do backward transformation for permutation only;
+ = 'S', do backward transformation for scaling only;
+ = 'B', do backward transformations for both permutation and
+ scaling.
+ JOB must be the same as the argument JOB supplied to DGEBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by DGEBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ SCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutation and scaling factors, as returned
+ by DGEBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by DHSEIN or DTREVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param side
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param scale
+ * @param m
+ * @param v
+ * @param ldv
+ * @param info
+ */
+ public abstract void dgebak(String job, String side, int n, int ilo, int ihi, double[] scale, int m, double[] v, int ldv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBAL balances a general real matrix A. This involves, first,
+ permuting A by a similarity transformation to isolate eigenvalues
+ in the first 1 to ILO-1 and last IHI+1 to N elements on the
+ diagonal; and second, applying a diagonal similarity transformation
+ to rows and columns ILO to IHI to make the rows and columns as
+ close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrix, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A:
+ = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+ for i = 1,...,N;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ SCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied to
+ A. If P(j) is the index of the row and column interchanged
+ with row and column j and D(j) is the scaling factor
+ applied to row and column j, then
+ SCALE(j) = P(j) for j = 1,...,ILO-1
+ = D(j) for j = ILO,...,IHI
+ = P(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The permutations consist of row and column interchanges which put
+ the matrix in the form
+
+ ( T1 X Y )
+ P A P = ( 0 B Z )
+ ( 0 0 T2 )
+
+ where T1 and T2 are upper triangular matrices whose eigenvalues lie
+ along the diagonal. The column indices ILO and IHI mark the starting
+ and ending columns of the submatrix B. Balancing consists of applying
+ a diagonal similarity transformation inv(D) * B * D to make the
+ 1-norms of each row of B and its corresponding column nearly equal.
+ The output matrix is
+
+ ( T1 X*D Y )
+ ( 0 inv(D)*B*D inv(D)*Z ).
+ ( 0 0 T2 )
+
+ Information about the permutations P and the diagonal matrix D is
+ returned in the vector SCALE.
+
+ This subroutine is based on the EISPACK routine BALANC.
+
+ Modified by Tzu-Yi Chen, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param n
+ * @param a
+ * @param lda
+ * @param ilo
+ * @param ihi
+ * @param scale
+ * @param info
+ */
+ public abstract void dgebal(String job, int n, double[] a, int lda, intW ilo, intW ihi, double[] scale, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBD2 reduces a real general m by n matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tauq
+ * @param taup
+ * @param work
+ * @param info
+ */
+ public abstract void dgebd2(int m, int n, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEBRD reduces a general real M-by-N matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
+
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,M,N).
+ For optimum performance LWORK >= (M+N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tauq
+ * @param taup
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgebrd(int m, int n, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGECON estimates the reciprocal of the condition number of a general
+
+ real matrix A, in either the 1-norm or the infinity-norm, using
+ the LU factorization computed by DGETRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) DOUBLE PRECISION
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param a
+ * @param lda
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgecon(String norm, int n, double[] a, int lda, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEEQU computes row and column scalings intended to equilibrate an
+ M-by-N matrix A and reduce its condition number. R returns the row
+ scale factors and C the column scale factors, chosen to try to make
+ the largest element in each row and column of the matrix B with
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The M-by-N matrix whose equilibration factors are
+ to be computed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ R (output) DOUBLE PRECISION array, dimension (M)
+ If INFO = 0 or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) DOUBLE PRECISION
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) DOUBLE PRECISION
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param info
+ */
+ public abstract void dgeequ(int m, int n, double[] a, int lda, double[] r, double[] c, doubleW rowcnd, doubleW colcnd, doubleW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEES computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left.
+ The leading columns of Z then form an orthonormal basis for the
+ invariant subspace corresponding to the selected eigenvalues.
+
+ A matrix is in real Schur form if it is upper quasi-triangular with
+ 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
+ form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
+ conjugate pair of eigenvalues is selected, then both complex
+
+ eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO is set to N+2 (see INFO below).
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues in the same order
+ that they appear on the diagonal of the output Schur form T.
+
+ Complex conjugate pairs of eigenvalues will appear
+ consecutively with the eigenvalue having the positive
+ imaginary part first.
+
+ VS (output) DOUBLE PRECISION array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1; if
+ JOBVS = 'V', LDVS >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the matrix which reduces A
+
+ to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvs
+ * @param sort
+ * @param select
+ * @param n
+ * @param a
+ * @param lda
+ * @param sdim
+ * @param wr
+ * @param wi
+ * @param vs
+ * @param ldvs
+ * @param work
+ * @param lwork
+ * @param bwork
+ * @param info
+ */
+ public void dgees(String jobvs, String sort, Object select, int n, double[] a, int lda, intW sdim, double[] wr, double[] wi, double[] vs, int ldvs, double[] work, int lwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Dgees.dgees(jobvs, sort, select, n, a, 0, lda, sdim, wr, 0, wi, 0, vs, 0, ldvs, work, 0, lwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEESX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left;
+ computes a reciprocal condition number for the average of the
+ selected eigenvalues (RCONDE); and computes a reciprocal condition
+ number for the right invariant subspace corresponding to the
+ selected eigenvalues (RCONDV). The leading columns of Z form an
+ orthonormal basis for this invariant subspace.
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
+ these quantities are called s and sep respectively).
+
+ A real matrix is in real Schur form if it is upper quasi-triangular
+ with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
+
+ the form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a
+ complex conjugate pair of eigenvalues is selected, then both
+
+ are. Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO may be set to N+3 (see INFO below).
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for average of selected eigenvalues only;
+ = 'V': Computed for selected right invariant subspace only;
+ = 'B': Computed for both.
+ If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the N-by-N matrix A.
+ On exit, A is overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts, respectively,
+ of the computed eigenvalues, in the same order that they
+ appear on the diagonal of the output Schur form T. Complex
+ conjugate pairs of eigenvalues appear consecutively with the
+
+ eigenvalue having the positive imaginary part first.
+
+ VS (output) DOUBLE PRECISION array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1, and if
+ JOBVS = 'V', LDVS >= N.
+
+ RCONDE (output) DOUBLE PRECISION
+ If SENSE = 'E' or 'B', RCONDE contains the reciprocal
+ condition number for the average of the selected eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) DOUBLE PRECISION
+ If SENSE = 'V' or 'B', RCONDV contains the reciprocal
+ condition number for the selected right invariant subspace.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ Also, if SENSE = 'E' or 'V' or 'B',
+ LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
+ selected eigenvalues computed by this routine. Note that
+ N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
+ returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
+
+ 'B' this may not be large enough.
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates upper bounds on the optimal sizes of the
+ arrays WORK and IWORK, returns these values as the first
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
+
+ Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
+
+ only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
+ may not be large enough.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates upper bounds on the optimal sizes of
+
+ the arrays WORK and IWORK, returns these values as the first
+
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the transformation which
+ reduces A to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvs
+ * @param sort
+ * @param select
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param sdim
+ * @param wr
+ * @param wi
+ * @param vs
+ * @param ldvs
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param bwork
+ * @param info
+ */
+ public void dgeesx(String jobvs, String sort, Object select, String sense, int n, double[] a, int lda, intW sdim, double[] wr, double[] wi, double[] vs, int ldvs, doubleW rconde, doubleW rcondv, double[] work, int lwork, int[] iwork, int liwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Dgeesx.dgeesx(jobvs, sort, select, sense, n, a, 0, lda, sdim, wr, 0, wi, 0, vs, 0, ldvs, rconde, rcondv, work, 0, lwork, iwork, 0, liwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEEV computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1; if
+ JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N), and
+ if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
+ performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors have been computed;
+ elements i+1:N of WR and WI contain eigenvalues which
+ have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvl
+ * @param jobvr
+ * @param n
+ * @param a
+ * @param lda
+ * @param wr
+ * @param wi
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgeev(String jobvl, String jobvr, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEEVX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
+ (RCONDE), and reciprocal condition numbers for the right
+ eigenvectors (RCONDV).
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Balancing a matrix means permuting the rows and columns to make it
+ more nearly upper triangular, and applying a diagonal similarity
+ transformation D * A * D**(-1), where D is a diagonal matrix, to
+ make its rows and columns closer in norm and the condition numbers
+ of its eigenvalues and eigenvectors smaller. The computed
+ reciprocal condition numbers correspond to the balanced matrix.
+ Permuting rows and columns will not change the condition numbers
+ (in exact arithmetic) but diagonal scaling will. For further
+ explanation of balancing, see section 4.10.2 of the LAPACK
+ Users' Guide.
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Indicates how the input matrix should be diagonally scaled
+ and/or permuted to improve the conditioning of its
+ eigenvalues.
+ = 'N': Do not diagonally scale or permute;
+ = 'P': Perform permutations to make the matrix more nearly
+ upper triangular. Do not diagonally scale;
+ = 'S': Diagonally scale the matrix, i.e. replace A by
+ D*A*D**(-1), where D is a diagonal matrix chosen
+ to make the rows and columns of A more equal in
+ norm. Do not permute;
+ = 'B': Both diagonally scale and permute A.
+
+ Computed reciprocal condition numbers will be for the matrix
+
+ after balancing and/or permuting. Permuting does not change
+ condition numbers (in exact arithmetic), but balancing does.
+
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVL must = 'V'.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVR must = 'V'.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for eigenvalues only;
+ = 'V': Computed for right eigenvectors only;
+ = 'B': Computed for eigenvalues and right eigenvectors.
+
+ If SENSE = 'E' or 'B', both left and right eigenvectors
+ must also be computed (JOBVL = 'V' and JOBVR = 'V').
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten. If JOBVL = 'V' or
+ JOBVR = 'V', A contains the real Schur form of the balanced
+ version of the input matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues will appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values determined when A was
+ balanced. The balanced A(i,j) = 0 if I > J and
+ J = 1,...,ILO-1 or I = IHI+1,...,N.
+
+ SCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ when balancing A. If P(j) is the index of the row and column
+ interchanged with row and column j, and D(j) is the scaling
+ factor applied to row and column j, then
+ SCALE(J) = P(J), for J = 1,...,ILO-1
+ = D(J), for J = ILO,...,IHI
+ = P(J) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) DOUBLE PRECISION
+ The one-norm of the balanced matrix (the maximum
+ of the sum of absolute values of elements of any column).
+
+ RCONDE (output) DOUBLE PRECISION array, dimension (N)
+ RCONDE(j) is the reciprocal condition number of the j-th
+ eigenvalue.
+
+ RCONDV (output) DOUBLE PRECISION array, dimension (N)
+ RCONDV(j) is the reciprocal condition number of the j-th
+ right eigenvector.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. If SENSE = 'N' or 'E',
+ LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
+ LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (2*N-2)
+ If SENSE = 'N' or 'E', not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors or condition numbers
+ have been computed; elements 1:ILO-1 and i+1:N of WR
+ and WI contain eigenvalues which have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param balanc
+ * @param jobvl
+ * @param jobvr
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param wr
+ * @param wi
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param ilo
+ * @param ihi
+ * @param scale
+ * @param abnrm
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgeevx(String balanc, String jobvl, String jobvr, String sense, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, intW ilo, intW ihi, double[] scale, doubleW abnrm, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGGES.
+
+ DGEGS computes the eigenvalues, real Schur form, and, optionally,
+ left and or/right Schur vectors of a real matrix pair (A,B).
+ Given two square matrices A and B, the generalized real Schur
+ factorization has the form
+
+ A = Q*S*Z**T, B = Q*T*Z**T
+
+ where Q and Z are orthogonal matrices, T is upper triangular, and S
+ is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
+ blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
+ of eigenvalues of (A,B). The columns of Q are the left Schur vectors
+ and the columns of Z are the right Schur vectors.
+
+ If only the eigenvalues of (A,B) are needed, the driver routine
+ DGEGV should be used instead. See DGEGV for a description of the
+ eigenvalues of the generalized nonsymmetric eigenvalue problem
+ (GNEP).
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors (returned in VSL).
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors (returned in VSR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A.
+ On exit, the upper quasi-triangular matrix S from the
+ generalized real Schur factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B.
+ On exit, the upper triangular matrix T from the generalized
+ real Schur factorization.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and (j+1)-st
+ eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+ If JOBVSL = 'V', the matrix of left Schur vectors Q.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+ If JOBVSR = 'V', the matrix of right Schur vectors Z.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,4*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for DGEQRF, DORMQR, and DORGQR.) Then compute:
+ NB -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR
+ The optimal LWORK is 2*N + N*(NB+1).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from DGGBAL
+ =N+2: error return from DGEQRF
+ =N+3: error return from DORMQR
+ =N+4: error return from DORGQR
+ =N+5: error return from DGGHRD
+ =N+6: error return from DHGEQZ (other than failed
+ iteration)
+ =N+7: error return from DGGBAK (computing VSL)
+ =N+8: error return from DGGBAK (computing VSR)
+ =N+9: error return from DLASCL (various places)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvsl
+ * @param jobvsr
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vsl
+ * @param ldvsl
+ * @param vsr
+ * @param ldvsr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgegs(String jobvsl, String jobvsr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vsl, int ldvsl, double[] vsr, int ldvsr, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGGEV.
+
+ DGEGV computes the eigenvalues and, optionally, the left and/or right
+ eigenvectors of a real matrix pair (A,B).
+ Given two square matrices A and B,
+ the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+ eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+ that
+
+ A*x = lambda*B*x.
+
+ An alternate form is to find the eigenvalues mu and corresponding
+ eigenvectors y such that
+
+ mu*A*y = B*y.
+
+ These two forms are equivalent with mu = 1/lambda and x = y if
+ neither lambda nor mu is zero. In order to deal with the case that
+ lambda or mu is zero or small, two values alpha and beta are returned
+ for each eigenvalue, such that lambda = alpha/beta and
+ mu = beta/alpha.
+
+ The vectors x and y in the above equations are right eigenvectors of
+
+ the matrix pair (A,B). Vectors u and v satisfying
+
+ u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+
+ are left eigenvectors of (A,B).
+
+ Note: this routine performs "full balancing" on A and B -- see
+ "Further Details", below.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors (returned
+ in VL).
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors (returned
+
+ in VR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit A
+ contains the real Schur form of A from the generalized Schur
+
+ factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only the diagonal
+ blocks from the Schur form will be correct. See DGGHRD and
+ DHGEQZ for details.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+ upper triangular matrix obtained from B in the generalized
+ Schur factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only those elements of
+ B corresponding to the diagonal blocks from the Schur form of
+ A will be correct. See DGGHRD and DHGEQZ for details.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue of
+ GNEP.
+
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored
+ in the columns of VL, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ u(j) = VL(:,j) + i*VL(:,j+1)
+ and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvectors
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors x(j) are stored
+ in the columns of VR, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then x(j) = VR(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ x(j) = VR(:,j) + i*VR(:,j+1)
+ and
+ x(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvalues
+
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for DGEQRF, DORMQR, and DORGQR.) Then compute:
+ NB -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR;
+
+ The optimal LWORK is:
+ 2*N + MAX( 6*N, N*(NB+1) ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from DGGBAL
+ =N+2: error return from DGEQRF
+ =N+3: error return from DORMQR
+ =N+4: error return from DORGQR
+ =N+5: error return from DGGHRD
+ =N+6: error return from DHGEQZ (other than failed
+ iteration)
+ =N+7: error return from DTGEVC
+ =N+8: error return from DGGBAK (computing VL)
+ =N+9: error return from DGGBAK (computing VR)
+ =N+10: error return from DLASCL (various calls)
+
+ Further Details
+ ===============
+
+ Balancing
+ ---------
+
+ This driver calls DGGBAL to both permute and scale rows and columns
+ of A and B. The permutations PL and PR are chosen so that PL*A*PR
+ and PL*B*R will be upper triangular except for the diagonal blocks
+ A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
+ possible. The diagonal scaling matrices DL and DR are chosen so
+ that the pair DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
+ one (except for the elements that start out zero.)
+
+ After the eigenvalues and eigenvectors of the balanced matrices
+ have been computed, DGGBAK transforms the eigenvectors back to what
+ they would have been (in perfect arithmetic) if they had not been
+ balanced.
+
+ Contents of A and B on Exit
+ -------- -- - --- - -- ----
+
+ If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
+ both), then on exit the arrays A and B will contain the real Schur
+ form[*] of the "balanced" versions of A and B. If no eigenvectors
+ are computed, then only the diagonal blocks will be correct.
+
+ [*] See DHGEQZ, DGEGS, or read the book "Matrix Computations",
+ by Golub & van Loan, pub. by Johns Hopkins U. Press.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvl
+ * @param jobvr
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgegv(String jobvl, String jobvr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= max(1,N).
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the n by n general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dgehd2(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEHRD reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+ zero.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's DGEHRD
+ subroutine incorporating improvements proposed by Quintana-Orti and
+ Van de Geijn (2005).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgehrd(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELQ2 computes an LQ factorization of a real m by n matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m by min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dgelq2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELQF computes an LQ factorization of a real M-by-N matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m-by-min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgelqf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELS solves overdetermined or underdetermined real linear systems
+ involving an M-by-N matrix A, or its transpose, using a QR or LQ
+ factorization of A. It is assumed that A has full rank.
+
+ The following options are provided:
+
+ 1. If TRANS = 'N' and m >= n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A*X ||.
+
+ 2. If TRANS = 'N' and m < n: find the minimum norm solution of
+ an underdetermined system A * X = B.
+
+ 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
+ an undetermined system A**T * X = B.
+
+ 4. If TRANS = 'T' and m < n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A**T * X ||.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N': the linear system involves A;
+ = 'T': the linear system involves A**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of the matrices B and X. NRHS >=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if M >= N, A is overwritten by details of its QR
+ factorization as returned by DGEQRF;
+ if M < N, A is overwritten by details of its LQ
+ factorization as returned by DGELQF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the matrix B of right hand side vectors, stored
+ columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+ if TRANS = 'T'.
+ On exit, if INFO = 0, B is overwritten by the solution
+ vectors, stored columnwise:
+ if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+ squares solution vectors; the residual sum of squares for the
+ solution in each column is given by the sum of squares of
+ elements N+1 to M in that column;
+ if TRANS = 'N' and m < n, rows 1 to N of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m < n, rows 1 to M of B contain the
+ least squares solution vectors; the residual sum of squares
+ for the solution in each column is given by the sum of
+ squares of elements M+1 to N in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= MAX(1,M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= max( 1, MN + max( MN, NRHS ) ).
+ For optimal performance,
+ LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
+ where MN = min(M,N) and NB is the optimum block size.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of the
+ triangular factor of A is zero, so that A does not have
+ full rank; the least squares solution could not be
+ computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgels(String trans, int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELSD computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize 2-norm(| b - A*x |)
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The problem is solved in three steps:
+ (1) Reduce the coefficient matrix A to bidiagonal form with
+ Householder transformations, reducing the original problem
+ into a "bidiagonal least squares problem" (BLS)
+ (2) Solve the BLS using a divide and conquer approach.
+ (3) Apply back all the Householder tranformations to solve
+ the original least squares problem.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK must be at least 1.
+ The exact minimum amount of workspace needed depends on M,
+ N and NRHS. As long as LWORK is at least
+ 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
+ if M is greater than or equal to N or
+ 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
+ if M is less than N, the code will execute correctly.
+ SMLSIZ is returned by ILAENV and is equal to the maximum
+ size of the subproblems at the bottom of the computation
+ tree (usually about 25), and
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
+ where MINMN = MIN( M,N ).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param s
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgelsd(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] s, double rcond, intW rank, double[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELSS computes the minimum norm solution to a real linear least
+ squares problem:
+
+ Minimize 2-norm(| b - A*x |).
+
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
+
+ X.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the first min(m,n) rows of A are overwritten with
+ its right singular vectors, stored rowwise.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1, and also:
+ LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param s
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgelss(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] s, double rcond, intW rank, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGELSY.
+
+ DGELSX computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+ If m >= n and RANK = n, the residual sum-of-squares for
+ the solution in the i-th column is given by the sum of
+ squares of elements N+1:M in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is an
+ initial column, otherwise it is a free column. Before
+ the QR factorization of A, all initial columns are
+ permuted to the leading positions; only the remaining
+ free columns are moved as a result of column pivoting
+ during the factorization.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param jpvt
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param info
+ */
+ public abstract void dgelsx(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, int[] jpvt, double rcond, intW rank, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGELSY computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ This routine is basically identical to the original xGELSX except
+ three differences:
+ o The call to the subroutine xGEQPF has been substituted by the
+ the call to the subroutine xGEQP3. This subroutine is a Blas-3
+ version of the QR factorization with column pivoting.
+ o Matrix B (the right hand side) is updated with Blas-3.
+ o The permutation of matrix B (the right hand side) is faster and
+ more simple.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of AP, otherwise column i is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of AP
+ was the k-th column of A.
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ The unblocked strategy requires that:
+ LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
+ where MN = min( M, N ).
+ The block algorithm requires that:
+ LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
+ where NB is an upper bound on the blocksize returned
+ by ILAENV for the routines DGEQP3, DTZRZF, STZRQF, DORMQR,
+ and DORMRZ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param jpvt
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgelsy(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, int[] jpvt, double rcond, intW rank, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQL2 computes a QL factorization of a real m by n matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the m by n lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dgeql2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQLF computes a QL factorization of a real M-by-N matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the M-by-N lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgeqlf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQP3 computes a QR factorization with column pivoting of a
+ matrix A: A*P = Q*R using Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper trapezoidal matrix R; the elements below
+
+ the diagonal, together with the array TAU, represent the
+ orthogonal matrix Q as a product of min(M,N) elementary
+ reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(J).ne.0, the J-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(J)=0,
+ the J-th column of A is a free column.
+ On exit, if JPVT(J)=K, then the J-th column of A*P was the
+ the K-th column of A.
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO=0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 3*N+1.
+ For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real/complex scalar, and v is a real/complex vector
+ with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
+ A(i+1:m,i), and tau in TAU(i).
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgeqp3(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DGEQP3.
+
+ DGEQPF computes a QR factorization with column pivoting of a
+ real M-by-N matrix A: A*P = Q*R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper triangular matrix R; the elements
+ below the diagonal, together with the array TAU,
+ represent the orthogonal matrix Q as a product of
+ min(m,n) elementary reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(n)
+
+ Each H(i) has the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
+
+
+ The matrix P is represented in jpvt as follows: If
+ jpvt(j) = i
+ then the jth column of P is the ith canonical unit vector.
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dgeqpf(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQR2 computes a QR factorization of a real m by n matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(m,n) by n upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dgeqr2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGEQRF computes a QR factorization of a real M-by-N matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of min(m,n) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgeqrf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGERFS improves the computed solution to a system of linear
+ equations and provides error bounds and backward error estimates for
+
+ the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The original N-by-N matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DGETRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgerfs(String trans, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGERQ2 computes an RQ factorization of a real m by n matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the m by n upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAU, represent the orthogonal matrix
+ Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dgerq2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGERQF computes an RQ factorization of a real M-by-N matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the M-by-N upper trapezoidal matrix R;
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of min(m,n) elementary
+ reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgerqf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESC2 solves a system of linear equations
+
+ A * X = scale* RHS
+
+ with a general N-by-N matrix A using the LU factorization with
+ complete pivoting computed by DGETC2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix A computed by DGETC2: A = P * L * U * Q
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, N).
+
+ RHS (input/output) DOUBLE PRECISION array, dimension (N).
+ On entry, the right hand side vector b.
+ On exit, the solution vector X.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ 0 <= SCALE <= 1 to prevent owerflow in the solution.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param rhs
+ * @param ipiv
+ * @param jpiv
+ * @param scale
+ */
+ public abstract void dgesc2(int n, double[] a, int lda, double[] rhs, int[] ipiv, int[] jpiv, doubleW scale);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESDD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and right singular
+ vectors. If singular vectors are desired, it uses a
+ divide-and-conquer algorithm.
+
+ The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns VT = V**T, not V.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U and all N rows of V**T are
+ returned in the arrays U and VT;
+ = 'S': the first min(M,N) columns of U and the first
+ min(M,N) rows of V**T are returned in the arrays U
+ and VT;
+ = 'O': If M >= N, the first N columns of U are overwritten
+ on the array A and all rows of V**T are returned in
+ the array VT;
+ otherwise, all columns of U are returned in the
+ array U and the first M rows of V**T are overwritten
+
+ in the array A;
+ = 'N': no columns of U or rows of V**T are computed.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBZ = 'O', A is overwritten with the first N columns
+ of U (the left singular vectors, stored
+ columnwise) if M >= N;
+ A is overwritten with the first M rows
+ of V**T (the right singular vectors, stored
+ rowwise) otherwise.
+ if JOBZ .ne. 'O', the contents of A are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,UCOL)
+ UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
+ UCOL = min(M,N) if JOBZ = 'S'.
+ If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
+
+ orthogonal matrix U;
+ if JOBZ = 'S', U contains the first min(M,N) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
+ N-by-N orthogonal matrix V**T;
+ if JOBZ = 'S', VT contains the first min(M,N) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
+ if JOBZ = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ If JOBZ = 'N',
+ LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)).
+ If JOBZ = 'O',
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+ If JOBZ = 'S' or 'A'
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+ For good performance, LWORK should generally be larger.
+ If LWORK = -1 but other input arguments are legal, WORK(1)
+ returns the optimal LWORK.
+
+ IWORK (workspace) INTEGER array, dimension (8*min(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: DBDSDC did not converge, updating process failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgesdd(String jobz, int m, int n, double[] a, int lda, double[] s, double[] u, int ldu, double[] vt, int ldvt, double[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as
+ A = P * L * U,
+ where P is a permutation matrix, L is unit lower triangular, and U is
+ upper triangular. The factored form of A is then used to solve the
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dgesv(int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESVD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and/or right singular
+
+ vectors. The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns V**T, not V.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U are returned in array U:
+ = 'S': the first min(m,n) columns of U (the left singular
+ vectors) are returned in the array U;
+ = 'O': the first min(m,n) columns of U (the left singular
+ vectors) are overwritten on the array A;
+ = 'N': no columns of U (no left singular vectors) are
+ computed.
+
+ JOBVT (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix
+ V**T:
+ = 'A': all N rows of V**T are returned in the array VT;
+ = 'S': the first min(m,n) rows of V**T (the right singular
+ vectors) are returned in the array VT;
+ = 'O': the first min(m,n) rows of V**T (the right singular
+ vectors) are overwritten on the array A;
+ = 'N': no rows of V**T (no right singular vectors) are
+ computed.
+
+ JOBVT and JOBU cannot both be 'O'.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBU = 'O', A is overwritten with the first min(m,n)
+ columns of U (the left singular vectors,
+ stored columnwise);
+ if JOBVT = 'O', A is overwritten with the first min(m,n)
+ rows of V**T (the right singular vectors,
+ stored rowwise);
+ if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
+ are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,UCOL)
+ (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
+ If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
+ if JOBU = 'S', U contains the first min(m,n) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBU = 'N' or 'O', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBU = 'S' or 'A', LDU >= M.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
+ V**T;
+ if JOBVT = 'S', VT contains the first min(m,n) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBVT = 'N' or 'O', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+ if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
+ superdiagonal elements of an upper bidiagonal matrix B
+ whose diagonal is in S (not necessarily sorted). B
+ satisfies A = U * B * VT, so it has the same singular values
+
+ as A, and singular vectors related by U and VT.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if DBDSQR did not converge, INFO specifies how many
+ superdiagonals of an intermediate bidiagonal form B
+ did not converge to zero. See the description of WORK
+ above for details.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobu
+ * @param jobvt
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgesvd(String jobu, String jobvt, int m, int n, double[] a, int lda, double[] s, double[] u, int ldu, double[] vt, int ldvt, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGESVX uses the LU factorization to compute the solution to a real
+ system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = P * L * U,
+ where P is a permutation matrix, L is a unit lower triangular
+ matrix, and U is upper triangular.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF and IPIV contain the factored form of A.
+ If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ A, AF, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
+ not 'N', then A must have been equilibrated by the scaling
+ factors in R and/or C. A is not modified if FACT = 'F' or
+ 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
+
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the factors L and U from the factorization
+ A = P*L*U as computed by DGETRF. If EQUED .ne. 'N', then
+ AF is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the original matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the equilibrated matrix A (see the description of A for
+ the form of the equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = P*L*U
+ as computed by DGETRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) DOUBLE PRECISION array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (4*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization has
+ been completed, but the factor U is exactly
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param equed
+ * @param r
+ * @param c
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgesvx(String fact, String trans, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, StringW equed, double[] r, double[] c, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETC2 computes an LU factorization with complete pivoting of the
+ n-by-n matrix A. The factorization has the form A = P * L * U * Q,
+ where P and Q are permutation matrices, L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ This is the Level 2 BLAS algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the n-by-n matrix A to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U*Q; the unit diagonal elements of L are not stored.
+
+ If U(k, k) appears to be less than SMIN, U(k, k) is given the
+ value of SMIN, i.e., giving a nonsingular perturbed system.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, U(k, k) is likely to produce owerflow if
+ we try to solve for x in Ax = b. So U is perturbed to
+ avoid the overflow.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param jpiv
+ * @param info
+ */
+ public abstract void dgetc2(int n, double[] a, int lda, int[] ipiv, int[] jpiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETF2 computes an LU factorization of a general m-by-n matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dgetf2(int m, int n, double[] a, int lda, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETRF computes an LU factorization of a general M-by-N matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dgetrf(int m, int n, double[] a, int lda, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETRI computes the inverse of a matrix using the LU factorization
+ computed by DGETRF.
+
+ This method inverts U and then computes inv(A) by solving the system
+
+ inv(A)*L = inv(U) for inv(A).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the factors L and U from the factorization
+ A = P*L*U as computed by DGETRF.
+ On exit, if INFO = 0, the inverse of the original matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimal performance LWORK >= N*NB, where NB is
+ the optimal blocksize returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
+ singular and its inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgetri(int n, double[] a, int lda, int[] ipiv, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGETRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general N-by-N matrix A using the LU factorization computed
+ by DGETRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dgetrs(String trans, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGBAK forms the right or left eigenvectors of a real generalized
+ eigenvalue problem A*x = lambda*B*x, by backward transformation on
+ the computed eigenvectors of the balanced pair of matrices output by
+
+ DGGBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N': do nothing, return immediately;
+ = 'P': do backward transformation for permutation only;
+ = 'S': do backward transformation for scaling only;
+ = 'B': do backward transformations for both permutation and
+
+ scaling.
+ JOB must be the same as the argument JOB supplied to DGGBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by DGGBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ LSCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the left side of A and B, as returned by DGGBAL.
+
+ RSCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the right side of A and B, as returned by DGGBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by DTGEVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the matrix V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. Ward, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param job
+ * @param side
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param lscale
+ * @param rscale
+ * @param m
+ * @param v
+ * @param ldv
+ * @param info
+ */
+ public abstract void dggbak(String job, String side, int n, int ilo, int ihi, double[] lscale, double[] rscale, int m, double[] v, int ldv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGBAL balances a pair of general real matrices (A,B). This
+ involves, first, permuting A and B by similarity transformations to
+ isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
+ elements on the diagonal; and second, applying a diagonal similarity
+
+ transformation to rows and columns ILO to IHI to make the rows
+ and columns as close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrices, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors in the
+ generalized eigenvalue problem A*x = lambda*B*x.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A and B:
+ = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
+ and RSCALE(I) = 1.0 for i = 1,...,N.
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the input matrix B.
+ On exit, B is overwritten by the balanced matrix.
+ If JOB = 'N', B is not referenced.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If P(j) is the index of the
+ row interchanged with row j, and D(j)
+ is the scaling factor applied to row j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If P(j) is the index of the
+ column interchanged with column j, and D(j)
+ is the scaling factor applied to column j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ WORK (workspace) REAL array, dimension (lwork)
+ lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
+
+ at least 1 when JOB = 'N' or 'P'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. WARD, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param ilo
+ * @param ihi
+ * @param lscale
+ * @param rscale
+ * @param work
+ * @param info
+ */
+ public abstract void dggbal(String job, int n, double[] a, int lda, double[] b, int ldb, intW ilo, intW ihi, double[] lscale, double[] rscale, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
+ the generalized eigenvalues, the generalized real Schur form (S,T),
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T.The
+ leading columns of VSL and VSR then form an orthonormal basis for the
+ corresponding left and right eigenspaces (deflating subspaces).
+
+ (If only the generalized eigenvalues are needed, use the driver
+ DGGEV instead, which is faster.)
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG);
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three DOUBLE PRECISI
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+
+ Note that in the ill-conditioned case, a selected complex
+ eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
+
+ BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
+ in this case.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else LWORK >= 8*N+16.
+ For good performance , LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in DTGSEN.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvsl
+ * @param jobvsr
+ * @param sort
+ * @param selctg
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param sdim
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vsl
+ * @param ldvsl
+ * @param vsr
+ * @param ldvsr
+ * @param work
+ * @param lwork
+ * @param bwork
+ * @param info
+ */
+ public void dgges(String jobvsl, String jobvsr, String sort, Object selctg, int n, double[] a, int lda, double[] b, int ldb, intW sdim, double[] alphar, double[] alphai, double[] beta, double[] vsl, int ldvsl, double[] vsr, int ldvsr, double[] work, int lwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Dgges.dgges(jobvsl, jobvsr, sort, selctg, n, a, 0, lda, b, 0, ldb, sdim, alphar, 0, alphai, 0, beta, 0, vsl, 0, ldvsl, vsr, 0, ldvsr, work, 0, lwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGESX computes for a pair of N-by-N real nonsymmetric matrices
+ (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T; computes
+ a reciprocal condition number for the average of the selected
+ eigenvalues (RCONDE); and computes a reciprocal condition number for
+
+ the right and left deflating subspaces corresponding to the selected
+
+ eigenvalues (RCONDV). The leading columns of VSL and VSR then form
+ an orthonormal basis for the corresponding left and right eigenspaces
+ (deflating subspaces).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or for both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG).
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three DOUBLE PRECISI
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer satisfy
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
+
+ since ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned), in this
+ case INFO is set to N+3.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N' : None are computed;
+ = 'E' : Computed for average of selected eigenvalues only;
+ = 'V' : Computed for selected deflating subspaces only;
+ = 'B' : Computed for both.
+ If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ RCONDE (output) DOUBLE PRECISION array, dimension ( 2 )
+ If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
+ reciprocal condition numbers for the average of the selected
+
+ eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) DOUBLE PRECISION array, dimension ( 2 )
+ If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
+ reciprocal condition numbers for the selected deflating
+ subspaces.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
+ LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
+ LWORK >= max( 8*N, 6*N+16 ).
+ Note that 2*SDIM*(N-SDIM) <= N*N/2.
+ Note also that an error is only returned if
+ LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
+ this may not be large enough.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the bound on the optimal size of the WORK
+ array and the minimum size of the IWORK array, returns these
+
+ values as the first entries of the WORK and IWORK arrays, and
+ no error message related to LWORK or LIWORK is issued by
+ XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
+ LIWORK >= N+6.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the bound on the optimal size of the
+
+ WORK array and the minimum size of the IWORK array, returns
+ these values as the first entries of the WORK and IWORK
+ arrays, and no error message related to LWORK or LIWORK is
+ issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in DTGSEN.
+
+ Further details
+ ===============
+
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / RCONDE( 1 ).
+
+ An approximate (asymptotic) bound on the maximum angular error in
+ the computed deflating subspaces is
+
+ EPS * norm((A, B)) / RCONDV( 2 ).
+
+ See LAPACK User's Guide, section 4.11 for more information.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvsl
+ * @param jobvsr
+ * @param sort
+ * @param selctg
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param sdim
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vsl
+ * @param ldvsl
+ * @param vsr
+ * @param ldvsr
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param bwork
+ * @param info
+ */
+ public void dggesx(String jobvsl, String jobvsr, String sort, Object selctg, String sense, int n, double[] a, int lda, double[] b, int ldb, intW sdim, double[] alphar, double[] alphai, double[] beta, double[] vsl, int ldvsl, double[] vsr, int ldvsr, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, int liwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Dggesx.dggesx(jobvsl, jobvsr, sort, selctg, sense, n, a, 0, lda, b, 0, ldb, sdim, alphar, 0, alphai, 0, beta, 0, vsl, 0, ldvsl, vsr, 0, ldvsr, rconde, 0, rcondv, 0, work, 0, lwork, iwork, 0, liwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j).
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B .
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ alpha/beta. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ =N+2: error return from DTGEVC.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvl
+ * @param jobvr
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dggev(String jobvl, String jobvr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
+ the eigenvalues (RCONDE), and reciprocal condition numbers for the
+ right eigenvectors (RCONDV).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j) .
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B.
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Specifies the balance option to be performed.
+ = 'N': do not diagonally scale or permute;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+ Computed reciprocal condition numbers will be for the
+ matrices after permuting and/or balancing. Permuting does
+ not change condition numbers (in exact arithmetic), but
+ balancing does.
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': none are computed;
+ = 'E': computed for eigenvalues only;
+ = 'V': computed for eigenvectors only;
+ = 'B': computed for eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then A contains the first part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then B contains the second part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If PL(j) is the index of the
+ row interchanged with row j, and DL(j) is the scaling
+ factor applied to row j, then
+ LSCALE(j) = PL(j) for j = 1,...,ILO-1
+ = DL(j) for j = ILO,...,IHI
+ = PL(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If PR(j) is the index of the
+ column interchanged with column j, and DR(j) is the scaling
+ factor applied to column j, then
+ RSCALE(j) = PR(j) for j = 1,...,ILO-1
+ = DR(j) for j = ILO,...,IHI
+ = PR(j) for j = IHI+1,...,N
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) DOUBLE PRECISION
+ The one-norm of the balanced matrix A.
+
+ BBNRM (output) DOUBLE PRECISION
+ The one-norm of the balanced matrix B.
+
+ RCONDE (output) DOUBLE PRECISION array, dimension (N)
+ If SENSE = 'E' or 'B', the reciprocal condition numbers of
+ the eigenvalues, stored in consecutive elements of the array.
+ For a complex conjugate pair of eigenvalues two consecutive
+ elements of RCONDE are set to the same value. Thus RCONDE(j),
+ RCONDV(j), and the j-th columns of VL and VR all correspond
+ to the j-th eigenpair.
+ If SENSE = 'N or 'V', RCONDE is not referenced.
+
+ RCONDV (output) DOUBLE PRECISION array, dimension (N)
+ If SENSE = 'V' or 'B', the estimated reciprocal condition
+ numbers of the eigenvectors, stored in consecutive elements
+ of the array. For a complex eigenvector two consecutive
+ elements of RCONDV are set to the same value. If the
+ eigenvalues cannot be reordered to compute RCONDV(j),
+ RCONDV(j) is set to 0; this can only occur when the true
+ value would be very small anyway.
+ If SENSE = 'N' or 'E', RCONDV is not referenced.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,2*N).
+ If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
+ LWORK >= max(1,6*N).
+ If SENSE = 'E' or 'B', LWORK >= max(1,10*N).
+ If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N+6)
+ If SENSE = 'E', IWORK is not referenced.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ If SENSE = 'N', BWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ =N+2: error return from DTGEVC.
+
+ Further Details
+ ===============
+
+ Balancing a matrix pair (A,B) includes, first, permuting rows and
+ columns to isolate eigenvalues, second, applying diagonal similarity
+
+ transformation to the rows and columns to make the rows and columns
+ as close in norm as possible. The computed reciprocal condition
+ numbers correspond to the balanced matrix. Permuting rows and columns
+ will not change the condition numbers (in exact arithmetic) but
+ diagonal scaling will. For further explanation of balancing, see
+ section 4.11.1.2 of LAPACK Users' Guide.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)
+
+ An approximate error bound for the angle between the i-th computed
+ eigenvector VL(i) or VR(i) is given by
+
+ EPS * norm(ABNRM, BBNRM) / DIF(i).
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see section 4.11 of LAPACK User's Guide.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param balanc
+ * @param jobvl
+ * @param jobvr
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param ilo
+ * @param ihi
+ * @param lscale
+ * @param rscale
+ * @param abnrm
+ * @param bbnrm
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param bwork
+ * @param info
+ */
+ public abstract void dggevx(String balanc, String jobvl, String jobvr, String sense, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, intW ilo, intW ihi, double[] lscale, double[] rscale, doubleW abnrm, doubleW bbnrm, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, boolean[] bwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGGLM solves a general Gauss-Markov linear model (GLM) problem:
+
+ minimize || y ||_2 subject to d = A*x + B*y
+ x
+
+ where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
+ given N-vector. It is assumed that M <= N <= M+P, and
+
+ rank(A) = M and rank( A B ) = N.
+
+ Under these assumptions, the constrained equation is always
+ consistent, and there is a unique solution x and a minimal 2-norm
+ solution y, which is obtained using a generalized QR factorization
+ of the matrices (A, B) given by
+
+ A = Q*(R), B = Q*T*Z.
+ (0)
+
+ In particular, if matrix B is square nonsingular, then the problem
+ GLM is equivalent to the following weighted linear least squares
+ problem
+
+ minimize || inv(B)*(d-A*x) ||_2
+ x
+
+ where inv(B) denotes the inverse of B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. 0 <= M <= N.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= N-M.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the upper triangular part of the array A contains
+ the M-by-M upper triangular matrix R.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)th subdiagonal
+ contain the N-by-P upper trapezoidal matrix T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D is the left hand side of the GLM equation.
+ On exit, D is destroyed.
+
+ X (output) DOUBLE PRECISION array, dimension (M)
+ Y (output) DOUBLE PRECISION array, dimension (P)
+ On exit, X and Y are the solutions of the GLM problem.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N+M+P).
+ For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ DGEQRF, SGERQF, DORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with A in the
+
+ generalized QR factorization of the pair (A, B) is
+ singular, so that rank(A) < M; the least squares
+ solution could not be computed.
+ = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal
+ factor T associated with B in the generalized QR
+ factorization of the pair (A, B) is singular, so that
+ rank( A B ) < N; the least squares solution could not
+ be computed.
+
+ ===================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param m
+ * @param p
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param d
+ * @param x
+ * @param y
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dggglm(int n, int m, int p, double[] a, int lda, double[] b, int ldb, double[] d, double[] x, double[] y, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGHRD reduces a pair of real matrices (A,B) to generalized upper
+ Hessenberg form using orthogonal transformations, where A is a
+ general matrix and B is upper triangular. The form of the
+ generalized eigenvalue problem is
+ A*x = lambda*B*x,
+ and B is typically made upper triangular by computing its QR
+ factorization and moving the orthogonal matrix Q to the left side
+ of the equation.
+
+ This subroutine simultaneously reduces A to a Hessenberg matrix H:
+ Q**T*A*Z = H
+ and transforms B to another upper triangular matrix T:
+ Q**T*B*Z = T
+ in order to reduce the problem to its standard form
+ H*y = lambda*T*y
+ where y = Z**T*x.
+
+ The orthogonal matrices Q and Z are determined as products of Givens
+
+ rotations. They may either be formed explicitly, or they may be
+ postmultiplied into input matrices Q1 and Z1, so that
+
+ Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+
+ Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+
+ If Q1 is the orthogonal matrix from the QR factorization of B in the
+
+ original equation A*x = lambda*B*x, then DGGHRD reduces the original
+
+ problem to generalized Hessenberg form.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'N': do not compute Q;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry,
+ and the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': do not compute Z;
+ = 'I': Z is initialized to the unit matrix, and the
+ orthogonal matrix Z is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry,
+ and the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of A which are to be
+ reduced. It is assumed that A is already upper triangular
+ in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+ normally set by a previous call to SGGBAL; otherwise they
+ should be set to 1 and N respectively.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ rest is set to zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the N-by-N upper triangular matrix B.
+ On exit, the upper triangular matrix T = Q**T B Z. The
+ elements below the diagonal are set to zero.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+ typically from the QR factorization of B.
+ On exit, if COMPQ='I', the orthogonal matrix Q, and if
+ COMPQ = 'V', the product Q1*Q.
+ Not referenced if COMPQ='N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+ On exit, if COMPZ='I', the orthogonal matrix Z, and if
+ COMPZ = 'V', the product Z1*Z.
+ Not referenced if COMPZ='N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z.
+ LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ This routine reduces A to Hessenberg and B to triangular form by
+ an unblocked reduction, as described in _Matrix_Computations_,
+ by Golub and Van Loan (Johns Hopkins Press.)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compq
+ * @param compz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param info
+ */
+ public abstract void dgghrd(String compq, String compz, int n, int ilo, int ihi, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGLSE solves the linear equality-constrained least squares (LSE)
+ problem:
+
+ minimize || c - A*x ||_2 subject to B*x = d
+
+ where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
+ M-vector, and d is a given P-vector. It is assumed that
+ P <= N <= M+P, and
+
+ rank(B) = P and rank( (A) ) = N.
+ ( (B) )
+
+ These conditions ensure that the LSE problem has a unique solution,
+ which is obtained using a generalized RQ factorization of the
+ matrices (B, A) given by
+
+ B = (0 R)*Q, A = Z*T*Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. 0 <= P <= N <= M+P.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the upper triangle of the subarray B(1:P,N-P+1:N)
+ contains the P-by-P upper triangular matrix R.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ C (input/output) DOUBLE PRECISION array, dimension (M)
+ On entry, C contains the right hand side vector for the
+ least squares part of the LSE problem.
+ On exit, the residual sum of squares for the solution
+ is given by the sum of squares of elements N-P+1 to M of
+ vector C.
+
+ D (input/output) DOUBLE PRECISION array, dimension (P)
+ On entry, D contains the right hand side vector for the
+ constrained equation.
+ On exit, D is destroyed.
+
+ X (output) DOUBLE PRECISION array, dimension (N)
+ On exit, X is the solution of the LSE problem.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M+N+P).
+ For optimum performance LWORK >= P+min(M,N)+max(M,N)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ DGEQRF, SGERQF, DORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with B in the
+
+ generalized RQ factorization of the pair (B, A) is
+ singular, so that rank(B) < P; the least squares
+ solution could not be computed.
+ = 2: the (N-P) by (N-P) part of the upper trapezoidal factor
+ T associated with A in the generalized RQ factorization
+ of the pair (B, A) is singular, so that
+ rank( (A) ) < N; the least squares solution could not
+ ( (B) )
+ be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param p
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param d
+ * @param x
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dgglse(int m, int n, int p, double[] a, int lda, double[] b, int ldb, double[] c, double[] d, double[] x, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGQRF computes a generalized QR factorization of an N-by-M matrix A
+
+ and an N-by-P matrix B:
+
+ A = Q*R, B = Q*T*Z,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
+ ( 0 ) N-M N M-N
+ M
+
+ where R11 is upper triangular, and
+
+ if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
+ P-N N ( T21 ) P
+ P
+
+ where T12 or T21 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GQR factorization
+
+ of A and B implicitly gives the QR factorization of inv(B)*A:
+
+ inv(B)*A = Z'*(inv(T)*R)
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(N,M)-by-M upper trapezoidal matrix R (R is
+ upper triangular if N >= M); the elements below the diagonal,
+ with the array TAUA, represent the orthogonal matrix Q as a
+ product of min(N,M) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAUA (output) DOUBLE PRECISION array, dimension (min(N,M))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)-th subdiagonal
+
+ contain the N-by-P upper trapezoidal matrix T; the remaining
+
+ elements, with the array TAUB, represent the orthogonal
+ matrix Z as a product of elementary reflectors (see Further
+ Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ TAUB (output) DOUBLE PRECISION array, dimension (min(N,P))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the QR factorization
+ of an N-by-M matrix, NB2 is the optimal blocksize for the
+ RQ factorization of an N-by-P matrix, and NB3 is the optimal
+
+ blocksize for a call of DORMQR.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(n,m).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine DORGQR.
+ To use Q to update another matrix, use LAPACK subroutine DORMQR.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(n,p).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(p-k+i+1:p) = 0 and v(p-k+i) = 1; v(1:p-k+i-1) is stored on exit in
+
+ B(n-k+i,1:p-k+i-1), and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine DORGRQ.
+ To use Z to update another matrix, use LAPACK subroutine DORMRQ.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param m
+ * @param p
+ * @param a
+ * @param lda
+ * @param taua
+ * @param b
+ * @param ldb
+ * @param taub
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dggqrf(int n, int m, int p, double[] a, int lda, double[] taua, double[] b, int ldb, double[] taub, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGRQF computes a generalized RQ factorization of an M-by-N matrix A
+
+ and a P-by-N matrix B:
+
+ A = R*Q, B = Z*T*Q,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
+ N-M M ( R21 ) N
+ N
+
+ where R12 or R21 is upper triangular, and
+
+ if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
+ ( 0 ) P-N P N-P
+ N
+
+ where T11 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GRQ factorization
+
+ of A and B implicitly gives the RQ factorization of A*inv(B):
+
+ A*inv(B) = (R*inv(T))*Z'
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, if M <= N, the upper triangle of the subarray
+ A(1:M,N-M+1:N) contains the M-by-M upper triangular matrix R;
+ if M > N, the elements on and above the (M-N)-th subdiagonal
+
+ contain the M-by-N upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAUA, represent the orthogonal
+ matrix Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAUA (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(P,N)-by-N upper trapezoidal matrix T (T is
+ upper triangular if P >= N); the elements below the diagonal,
+ with the array TAUB, represent the orthogonal matrix Z as a
+ product of elementary reflectors (see Further Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TAUB (output) DOUBLE PRECISION array, dimension (min(P,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the RQ factorization
+ of an M-by-N matrix, NB2 is the optimal blocksize for the
+ QR factorization of a P-by-N matrix, and NB3 is the optimal
+ blocksize for a call of DORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INF0= -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine DORGRQ.
+ To use Q to update another matrix, use LAPACK subroutine DORMRQ.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(p,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i),
+
+ and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine DORGQR.
+ To use Z to update another matrix, use LAPACK subroutine DORMQR.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param p
+ * @param n
+ * @param a
+ * @param lda
+ * @param taua
+ * @param b
+ * @param ldb
+ * @param taub
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dggrqf(int m, int p, int n, double[] a, int lda, double[] taua, double[] b, int ldb, double[] taub, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGSVD computes the generalized singular value decomposition (GSVD)
+ of an M-by-N real matrix A and P-by-N real matrix B:
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R )
+
+ where U, V and Q are orthogonal matrices, and Z' is the transpose
+ of Z. Let K+L = the effective numerical rank of the matrix (A',B')',
+ then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
+ D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
+ following structures, respectively:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 )
+ L ( 0 0 R22 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The routine computes C, S, R, and optionally the orthogonal
+ transformation matrices U, V and Q.
+
+ In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
+ A and B implicitly gives the SVD of A*inv(B):
+ A*inv(B) = U*(D1*inv(D2))*V'.
+ If ( A',B')' has orthonormal columns, then the GSVD of A and B is
+ also equal to the CS decomposition of A and B. Furthermore, the GSVD
+
+ can be used to derive the solution of the eigenvalue problem:
+ A'*A x = lambda* B'*B x.
+ In some literature, the GSVD of A and B is presented in the form
+ U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 )
+ where U and V are orthogonal and X is nonsingular, D1 and D2 are
+ ``diagonal''. The former GSVD form can be converted to the latter
+ form by taking the nonsingular matrix X as
+
+ X = Q*( I 0 )
+ ( 0 inv(R) ).
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in the Purpose section.
+ K + L = effective numerical rank of (A',B')'.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular matrix R, or part of R.
+ See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix R if M-K-L < 0.
+ See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ ALPHA (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = C,
+ BETA(K+1:K+L) = S,
+ or if M-K-L < 0,
+ ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
+ BETA(K+1:M) =S, BETA(M+1:K+L) =1
+ and
+ ALPHA(K+L+1:N) = 0
+ BETA(K+L+1:N) = 0
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,M)
+ If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) DOUBLE PRECISION array, dimension (LDV,P)
+ If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) DOUBLE PRECISION array,
+ dimension (max(3*N,M,P)+N)
+
+ IWORK (workspace/output) INTEGER array, dimension (N)
+ On exit, IWORK stores the sorting information. More
+ precisely, the following loop will sort ALPHA
+ for I = K+1, min(M,K+L)
+ swap ALPHA(I) and ALPHA(IWORK(I))
+ endfor
+ such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, the Jacobi-type procedure failed to
+ converge. For further details, see subroutine DTGSJA.
+
+
+ Internal Parameters
+ ===================
+
+ TOLA DOUBLE PRECISION
+ TOLB DOUBLE PRECISION
+ TOLA and TOLB are the thresholds to determine the effective
+ rank of (A',B')'. Generally, they are set to
+ TOLA = MAX(M,N)*norm(A)*MAZHEPS,
+ TOLB = MAX(P,N)*norm(B)*MAZHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ Further Details
+ ===============
+
+ 2-96 Based on modifications by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param jobu
+ * @param jobv
+ * @param jobq
+ * @param m
+ * @param n
+ * @param p
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param v
+ * @param ldv
+ * @param q
+ * @param ldq
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dggsvd(String jobu, String jobv, String jobq, int m, int n, int p, intW k, intW l, double[] a, int lda, double[] b, int ldb, double[] alpha, double[] beta, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGGSVP computes orthogonal matrices U, V and Q such that
+
+ N-K-L K L
+ U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ V'*B*Q = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
+ numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the
+ transpose of Z.
+
+ This decomposition is the preprocessing step for computing the
+ Generalized Singular Value Decomposition (GSVD), see subroutine
+ DGGSVD.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular (or trapezoidal) matrix
+ described in the Purpose section.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix described in
+ the Purpose section.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) DOUBLE PRECISION
+ TOLB (input) DOUBLE PRECISION
+ TOLA and TOLB are the thresholds to determine the effective
+ numerical rank of matrix B and a subblock of A. Generally,
+ they are set to
+ TOLA = MAX(M,N)*norm(A)*MAZHEPS,
+ TOLB = MAX(P,N)*norm(B)*MAZHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in Purpose.
+ K + L = effective numerical rank of (A',B')'.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,M)
+ If JOBU = 'U', U contains the orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) DOUBLE PRECISION array, dimension (LDV,M)
+ If JOBV = 'V', V contains the orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ TAU (workspace) DOUBLE PRECISION array, dimension (N)
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(3*N,M,P))
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+
+ Further Details
+ ===============
+
+ The subroutine uses LAPACK subroutine DGEQPF for the QR factorization
+ with column pivoting to detect the effective numerical rank of the
+ a matrix. It may be replaced by a better rank determination strategy.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobu
+ * @param jobv
+ * @param jobq
+ * @param m
+ * @param p
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param tola
+ * @param tolb
+ * @param k
+ * @param l
+ * @param u
+ * @param ldu
+ * @param v
+ * @param ldv
+ * @param q
+ * @param ldq
+ * @param iwork
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dggsvp(String jobu, String jobv, String jobq, int m, int p, int n, double[] a, int lda, double[] b, int ldb, double tola, double tolb, intW k, intW l, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, int[] iwork, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTCON estimates the reciprocal of the condition number of a real
+ tridiagonal matrix A using the LU factorization as computed by
+ DGTTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by DGTTRF.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ ANORM (input) DOUBLE PRECISION
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgtcon(String norm, int n, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is tridiagonal, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by DGTTRF.
+
+ DF (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DUF (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DGTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param dlf
+ * @param df
+ * @param duf
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgtrfs(String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] dlf, double[] df, double[] duf, double[] du2, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTSV solves the equation
+
+ A*X = B,
+
+ where A is an n by n tridiagonal matrix, by Gaussian elimination with
+ partial pivoting.
+
+ Note that the equation A'*X = B may be solved by interchanging the
+
+ order of the arguments DU and DL.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-2) elements of the
+ second super-diagonal of the upper triangular matrix U from
+ the LU factorization of A, in DL(1), ..., DL(n-2).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of U.
+
+ DU (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N by NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero, and the solution
+ has not been computed. The factorization has not been
+ completed unless i = N.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dgtsv(int n, int nrhs, double[] dl, double[] d, double[] du, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B or A**T * X = B,
+ where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
+
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
+ as A = L * U, where L is a product of permutation and unit lower
+ bidiagonal matrices and U is upper triangular with nonzeros in
+ only the main diagonal and first two superdiagonals.
+
+ 2. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
+ form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
+ will not be modified.
+ = 'N': The matrix will be copied to DLF, DF, and DUF
+ and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input or output) DOUBLE PRECISION array, dimension (N-1)
+ If FACT = 'F', then DLF is an input argument and on entry
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A as computed by DGTTRF.
+
+ If FACT = 'N', then DLF is an output argument and on exit
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A.
+
+ DF (input or output) DOUBLE PRECISION array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ DUF (input or output) DOUBLE PRECISION array, dimension (N-1)
+ If FACT = 'F', then DUF is an input argument and on entry
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ If FACT = 'N', then DUF is an output argument and on exit
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ DU2 (input or output) DOUBLE PRECISION array, dimension (N-2)
+ If FACT = 'F', then DU2 is an input argument and on entry
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ If FACT = 'N', then DU2 is an output argument and on exit
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the LU factorization of A as
+
+ computed by DGTTRF.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the LU factorization of A;
+ row i of the matrix was interchanged with row IPIV(i).
+ IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
+ a row interchange was not required.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has not been completed unless i = N, but the
+ factor U is exactly singular, so the solution
+ and error bounds could not be computed.
+ RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param dlf
+ * @param df
+ * @param duf
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dgtsvx(String fact, String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] dlf, double[] df, double[] duf, double[] du2, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTTRF computes an LU factorization of a real tridiagonal matrix A
+ using elimination with partial pivoting and row interchanges.
+
+ The factorization has the form
+ A = L * U
+ where L is a product of permutation and unit lower bidiagonal
+ matrices and U is upper triangular with nonzeros in only the main
+ diagonal and first two superdiagonals.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ DL (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-1) multipliers that
+ define the matrix L from the LU factorization of A.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of the
+ upper triangular matrix U from the LU factorization of A.
+
+ DU (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ DU2 (output) DOUBLE PRECISION array, dimension (N-2)
+ On exit, DU2 is overwritten by the (n-2) elements of the
+ second super-diagonal of U.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dgttrf(int n, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTTRS solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by DGTTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dgttrs(String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DGTTS2 solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by DGTTRF.
+
+ Arguments
+ =========
+
+ ITRANS (input) INTEGER
+ Specifies the form of the system of equations.
+ = 0: A * X = B (No transpose)
+ = 1: A'* X = B (Transpose)
+ = 2: A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) DOUBLE PRECISION array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param itrans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ */
+ public abstract void dgtts2(int itrans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+ where H is an upper Hessenberg matrix and T is upper triangular,
+ using the double-shift QZ method.
+ Matrix pairs of this type are produced by the reduction to
+ generalized upper Hessenberg form of a real matrix pair (A,B):
+
+ A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+
+ as computed by DGGHRD.
+
+ If JOB='S', then the Hessenberg-triangular pair (H,T) is
+ also reduced to generalized Schur form,
+
+ H = Q*S*Z**T, T = Q*P*Z**T,
+
+ where Q and Z are orthogonal matrices, P is an upper triangular
+ matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+ diagonal blocks.
+
+ The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+ (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+
+ eigenvalues.
+
+ Additionally, the 2-by-2 upper triangular diagonal blocks of P
+ corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+
+ form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+ P(j,j) > 0, and P(j+1,j+1) > 0.
+
+ Optionally, the orthogonal matrix Q from the generalized Schur
+ factorization may be postmultiplied into an input matrix Q1, and the
+
+ orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+ If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced
+ the matrix pair (A,B) to generalized upper Hessenberg form, then the
+
+ output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+ generalized Schur factorization of (A,B):
+
+ A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+
+ To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently
+ of (A,B)) are computed as a pair of values (alpha,beta), where alpha
+ complex and beta real.
+ If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+ generalized nonsymmetric eigenvalue problem (GNEP)
+ A*x = lambda*B*x
+ and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+ alternate form of the GNEP
+ mu*A*y = B*y.
+ Real eigenvalues can be read directly from the generalized Schur
+ form:
+ alpha = S(i,i), beta = P(i,i).
+
+ Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
+
+ Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
+ pp. 241--256.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': Compute eigenvalues only;
+ = 'S': Compute eigenvalues and the Schur form.
+
+ COMPQ (input) CHARACTER*1
+ = 'N': Left Schur vectors (Q) are not computed;
+ = 'I': Q is initialized to the unit matrix and the matrix Q
+ of left Schur vectors of (H,T) is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry and
+ the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Right Schur vectors (Z) are not computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of right Schur vectors of (H,T) is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry and
+ the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices H, T, Q, and Z. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of H which are in
+ Hessenberg form. It is assumed that A is already upper
+ triangular in rows and columns 1:ILO-1 and IHI+1:N.
+ If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH, N)
+ On entry, the N-by-N upper Hessenberg matrix H.
+ On exit, if JOB = 'S', H contains the upper quasi-triangular
+
+ matrix S from the generalized Schur factorization;
+ 2-by-2 diagonal blocks (corresponding to complex conjugate
+ pairs of eigenvalues) are returned in standard form, with
+ H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+ If JOB = 'E', the diagonal blocks of H match those of S, but
+
+ the rest of H is unspecified.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max( 1, N ).
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT, N)
+ On entry, the N-by-N upper triangular matrix T.
+ On exit, if JOB = 'S', T contains the upper triangular
+ matrix P from the generalized Schur factorization;
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of
+ are reduced to positive diagonal form, i.e., if H(j+1,j) is
+ non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+ T(j+1,j+1) > 0.
+ If JOB = 'E', the diagonal blocks of T match those of P, but
+
+ the rest of T is unspecified.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max( 1, N ).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+
+ vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+ of left Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If COMPQ='V' or 'I', then LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of
+ right Schur vectors of (H,T), and if COMPZ = 'V', the
+ orthogonal matrix of right Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If COMPZ='V' or 'I', then LDZ >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1,...,N: the QZ iteration did not converge. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO+1,...,N should be correct.
+ = N+1,...,2*N: the shift calculation failed. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO-N+1,...,N should be correct.
+
+ Further Details
+ ===============
+
+ Iteration counters:
+
+ JITER -- counts iterations.
+ IITER -- counts iterations run since ILAST was last
+ changed. This is therefore reset only when a 1-by-1 or
+ 2-by-2 block deflates off the bottom.
+
+ =====================================================================
+
+ .. Parameters ..
+ $ SAFETY = 1.0E+0 )
+</pre>
+ * @param job
+ * @param compq
+ * @param compz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param t
+ * @param ldt
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dhgeqz(String job, String compq, String compz, int n, int ilo, int ihi, double[] h, int ldh, double[] t, int ldt, double[] alphar, double[] alphai, double[] beta, double[] q, int ldq, double[] z, int ldz, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DHSEIN uses inverse iteration to find specified right and/or left
+ eigenvectors of a real upper Hessenberg matrix H.
+
+ The right eigenvector x and the left eigenvector y of the matrix H
+ corresponding to an eigenvalue w are defined by:
+
+ H * x = w * x, y**h * H = w * y**h
+
+ where y**h denotes the conjugate transpose of the vector y.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ EIGSRC (input) CHARACTER*1
+ Specifies the source of eigenvalues supplied in (WR,WI):
+ = 'Q': the eigenvalues were found using DHSEQR; thus, if
+ H has zero subdiagonal elements, and so is
+ block-triangular, then the j-th eigenvalue can be
+ assumed to be an eigenvalue of the block containing
+ the j-th row/column. This property allows DHSEIN to
+ perform inverse iteration on just one diagonal block.
+
+ = 'N': no assumptions are made on the correspondence
+ between eigenvalues and diagonal blocks. In this
+ case, DHSEIN must always perform inverse iteration
+ using the whole matrix H.
+
+ INITV (input) CHARACTER*1
+ = 'N': no initial vectors are supplied;
+ = 'U': user-supplied initial vectors are stored in the arrays
+ VL and/or VR.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ Specifies the eigenvectors to be computed. To select the
+ real eigenvector corresponding to a real eigenvalue WR(j),
+ SELECT(j) must be set to .TRUE.. To select the complex
+ eigenvector corresponding to a complex eigenvalue
+ (WR(j),WI(j)), with complex conjugate (WR(j+1),WI(j+1)),
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; then on exit SELECT(j) is .TRUE. and SELECT(j+1) is
+ .FALSE..
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) DOUBLE PRECISION array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input/output) DOUBLE PRECISION array, dimension (N)
+ WI (input) DOUBLE PRECISION array, dimension (N)
+ On entry, the real and imaginary parts of the eigenvalues of
+
+ H; a complex conjugate pair of eigenvalues must be stored in
+
+ consecutive elements of WR and WI.
+ On exit, WR may have been altered since close eigenvalues
+ are perturbed slightly in searching for independent
+ eigenvectors.
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if INITV = 'U' and SIDE = 'L' or 'B', VL must
+ contain starting vectors for the inverse iteration for the
+ left eigenvectors; the starting vector for each eigenvector
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'L' or 'B', the left eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VL, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'R', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if INITV = 'U' and SIDE = 'R' or 'B', VR must
+ contain starting vectors for the inverse iteration for the
+ right eigenvectors; the starting vector for each eigenvector
+
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'R' or 'B', the right eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VR, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'L', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR required to
+
+ store the eigenvectors; each selected real eigenvector
+ occupies one column and each selected complex eigenvector
+ occupies two columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ((N+2)*N)
+
+ IFAILL (output) INTEGER array, dimension (MM)
+ If SIDE = 'L' or 'B', IFAILL(i) = j > 0 if the left
+ eigenvector in the i-th column of VL (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILL(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VL hold a complex eigenvector, then IFAILL(i) and
+
+ IFAILL(i+1) are set to the same value.
+ If SIDE = 'R', IFAILL is not referenced.
+
+ IFAILR (output) INTEGER array, dimension (MM)
+ If SIDE = 'R' or 'B', IFAILR(i) = j > 0 if the right
+ eigenvector in the i-th column of VR (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILR(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VR hold a complex eigenvector, then IFAILR(i) and
+
+ IFAILR(i+1) are set to the same value.
+ If SIDE = 'L', IFAILR is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, i is the number of eigenvectors which
+ failed to converge; see IFAILL and IFAILR for further
+ details.
+
+ Further Details
+ ===============
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x|+|y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param eigsrc
+ * @param initv
+ * @param select
+ * @param n
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param mm
+ * @param m
+ * @param work
+ * @param ifaill
+ * @param ifailr
+ * @param info
+ */
+ public abstract void dhsein(String side, String eigsrc, String initv, boolean[] select, int n, double[] h, int ldh, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, int[] ifaill, int[] ifailr, intW info);
+
+ /**
+<pre>
+
+ ..
+ Purpose
+ =======
+
+ DHSEQR computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': compute eigenvalues only;
+ = 'S': compute eigenvalues and the Schur form T.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': no Schur vectors are computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of Schur vectors of H is returned;
+ = 'V': Z must contain an orthogonal matrix Q on entry, and
+
+ the product Q*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL, and then passed to DGEHRD
+
+ when the matrix output by DGEBAL is reduced to Hessenberg
+ form. Otherwise ILO and IHI should be set to 1 and N
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and JOB = 'S', then H contains the
+ upper quasi-triangular matrix T from the Schur decomposition
+ (the Schur form); 2-by-2 diagonal blocks (corresponding to
+ complex conjugate pairs of eigenvalues) are returned in
+ standard form, with H(i,i) = H(i+1,i+1) and
+ H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
+ contents of H are unspecified on exit. (The output value of
+ H when INFO.GT.0 is given under the description of INFO
+ below.)
+
+ Unlike earlier versions of DHSEQR, this subroutine may
+ explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
+ or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues. If two eigenvalues are computed as a complex
+ conjugate pair, they are stored in consecutive elements of
+ WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
+ WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
+
+ the same order as on the diagonal of the Schur form returned
+ in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
+ diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ If COMPZ = 'N', Z is not referenced.
+ If COMPZ = 'I', on entry Z need not be set and on exit,
+ if INFO = 0, Z contains the orthogonal matrix Z of the Schur
+ vectors of H. If COMPZ = 'V', on entry Z must contain an
+ N-by-N matrix Q, which is assumed to be equal to the unit
+ matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
+ if INFO = 0, Z contains Q*Z.
+ Normally Q is the orthogonal matrix generated by DORGHR
+ after the call to DGEHRD which formed the Hessenberg matrix
+
+ H. (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if COMPZ = 'I' or
+ COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then DHSEQR does a workspace query.
+ In this case, DHSEQR checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .LT. 0: if INFO = -i, the i-th argument had an illegal
+ value
+ .GT. 0: if INFO = i, DHSEQR failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and JOB = 'E', then on exit, the
+ remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and JOB = 'S', then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and COMPZ = 'V', then on exit
+
+ (final value of Z) = (initial value of Z)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'I', then on exit
+ (final value of Z) = U
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'N', then Z is not
+ accessed.
+
+ ================================================================
+ Default values supplied by
+ ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
+ It is suggested that these defaults be adjusted in order
+ to attain best performance in each particular
+ computational environment.
+
+ ISPEC=1: The DLAHQR vs DLAQR0 crossover point.
+ Default: 75. (Must be at least 11.)
+
+ ISPEC=2: Recommended deflation window size.
+ This depends on ILO, IHI and NS. NS is the
+ number of simultaneous shifts returned
+ by ILAENV(ISPEC=4). (See ISPEC=4 below.)
+ The default for (IHI-ILO+1).LE.500 is NS.
+ The default for (IHI-ILO+1).GT.500 is 3*NS/2.
+
+ ISPEC=3: Nibble crossover point. (See ILAENV for
+ details.) Default: 14% of deflation window
+ size.
+
+ ISPEC=4: Number of simultaneous shifts, NS, in
+ a multi-shift QR iteration.
+
+ If IHI-ILO+1 is ...
+
+ greater than ...but less ... the
+ or equal to ... than default is
+
+ 1 30 NS - 2(+)
+ 30 60 NS - 4(+)
+ 60 150 NS = 10(+)
+ 150 590 NS = **
+ 590 3000 NS = 64
+ 3000 6000 NS = 128
+ 6000 infinity NS = 256
+
+ (+) By default some or all matrices of this order
+ are passed to the implicit double shift routine
+
+ DLAHQR and NS is ignored. See ISPEC=1 above
+ and comments in IPARM for details.
+
+ The asterisks (**) indicate an ad-hoc
+ function of N increasing from 10 to 64.
+
+ ISPEC=5: Select structured matrix multiply.
+ (See ILAENV for details.) Default: 3.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . DLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== NL allocates some local workspace to help small matrices
+ . through a rare DLAHQR failure. NL .GT. NTINY = 11 is
+ . required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
+ . mended. (The default value of NMIN is 75.) Using NL = 49
+ . allows up to six simultaneous shifts and a 16-by-16
+ . deflation window. ====
+
+</pre>
+ * @param job
+ * @param compz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dhseqr(String job, String compz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, double[] z, int ldz, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DISNAN returns .TRUE. if its argument is NaN, and .FALSE.
+ otherwise. To be replaced by the Fortran 2003 intrinsic in the
+ future.
+
+ Arguments
+ =========
+
+ DIN (input) DOUBLE PRECISION
+ Input to test for NaN.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param din
+ */
+ public boolean disnan(double din) {
+ return org.netlib.lapack.Disnan.disnan(din);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLABAD takes as input the values computed by DLAMCH for underflow and
+ overflow, and returns the square root of each of these values if the
+
+ log of LARGE is sufficiently large. This subroutine is intended to
+ identify machines with a large exponent range, such as the Crays, and
+ redefine the underflow and overflow limits to be the square roots of
+
+ the values computed by DLAMCH. This subroutine is needed because
+ DLAMCH does not compensate for poor arithmetic in the upper half of
+ the exponent range, as is found on a Cray.
+
+ Arguments
+ =========
+
+ SMALL (input/output) DOUBLE PRECISION
+ On entry, the underflow threshold as computed by DLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of SMALL, otherwise unchanged.
+
+ LARGE (input/output) DOUBLE PRECISION
+ On entry, the overflow threshold as computed by DLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of LARGE, otherwise unchanged.
+
+ =====================================================================
+
+ .. Intrinsic Functions ..
+</pre>
+ * @param small
+ * @param large
+ */
+ public abstract void dlabad(doubleW small, doubleW large);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLABRD reduces the first NB rows and columns of a real general
+ m by n matrix A to upper or lower bidiagonal form by an orthogonal
+ transformation Q' * A * P, and returns the matrices X and Y which
+ are needed to apply the transformation to the unreduced part of A.
+
+ If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
+
+ bidiagonal form.
+
+ This is an auxiliary routine called by DGEBRD
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A.
+
+ N (input) INTEGER
+ The number of columns in the matrix A.
+
+ NB (input) INTEGER
+ The number of leading rows and columns of A to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit, the first NB rows and columns of the matrix are
+ overwritten; the rest of the array is unchanged.
+ If m >= n, elements on and below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors; and
+ elements above the diagonal in the first NB rows, with the
+
+ array TAUP, represent the orthogonal matrix P as a product
+
+ of elementary reflectors.
+ If m < n, elements below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors, and
+ elements on and above the diagonal in the first NB rows,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (NB)
+ The diagonal elements of the first NB rows and columns of
+ the reduced matrix. D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (NB)
+ The off-diagonal elements of the first NB rows and columns of
+ the reduced matrix.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NB)
+ The m-by-nb matrix X required to update the unreduced part
+ of A.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= M.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y required to update the unreduced part
+ of A.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors.
+
+ If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
+ A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The elements of the vectors v and u together form the m-by-nb matrix
+
+ V and the nb-by-n matrix U' which are needed, with X and Y, to apply
+
+ the transformation to the unreduced part of the matrix, using a block
+ update of the form: A := A - V*Y' - X*U'.
+
+ The contents of A on exit are illustrated by the following examples
+ with nb = 2:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
+ ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
+ ( v1 v2 a a a ) ( v1 1 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix which is unchanged,
+ vi denotes an element of the vector defining H(i), and ui an element
+
+ of the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nb
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tauq
+ * @param taup
+ * @param x
+ * @param ldx
+ * @param y
+ * @param ldy
+ */
+ public abstract void dlabrd(int m, int n, int nb, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] x, int ldx, double[] y, int ldy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLACN2 estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) DOUBLE PRECISION array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and DLACN2 must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) DOUBLE PRECISION
+ On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
+ unchanged from the previous call to DLACN2.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to DLACN2, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from DLACN2, KASE will again be 0.
+
+ ISAVE (input/output) INTEGER array, dimension (3)
+ ISAVE is used to save variables between calls to DLACN2
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ This is a thread safe version of DLACON, which uses the array ISAVE
+ in place of a SAVE statement, as follows:
+
+ DLACON DLACN2
+ JUMP ISAVE(1)
+ J ISAVE(2)
+ ITER ISAVE(3)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param v
+ * @param x
+ * @param isgn
+ * @param est
+ * @param kase
+ * @param isave
+ */
+ public void dlacn2(int n, double[] v, double[] x, int[] isgn, doubleW est, intW kase, int[] isave) {
+ org.netlib.lapack.Dlacn2.dlacn2(n, v, 0, x, 0, isgn, 0, est, kase, isave, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLACON estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) DOUBLE PRECISION array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and DLACON must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) DOUBLE PRECISION
+ On entry with KASE = 1 or 2 and JUMP = 3, EST should be
+ unchanged from the previous call to DLACON.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to DLACON, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from DLACON, KASE will again be 0.
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param v
+ * @param x
+ * @param isgn
+ * @param est
+ * @param kase
+ */
+ public abstract void dlacon(int n, double[] v, double[] x, int[] isgn, doubleW est, intW kase);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLACPY copies all or part of a two-dimensional matrix A to another
+ matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper triangle
+
+ or trapezoid is accessed; if UPLO = 'L', only the lower
+ triangle or trapezoid is accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) DOUBLE PRECISION array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ */
+ public abstract void dlacpy(String uplo, int m, int n, double[] a, int lda, double[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLADIV performs complex division in real arithmetic
+
+ a + i*b
+ p + i*q = ---------
+ c + i*d
+
+ The algorithm is due to Robert L. Smith and can be found
+ in D. Knuth, The art of Computer Programming, Vol.2, p.195
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ B (input) DOUBLE PRECISION
+ C (input) DOUBLE PRECISION
+ D (input) DOUBLE PRECISION
+ The scalars a, b, c, and d in the above expression.
+
+ P (output) DOUBLE PRECISION
+ Q (output) DOUBLE PRECISION
+ The scalars p and q in the above expression.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param d
+ * @param p
+ * @param q
+ */
+ public abstract void dladiv(double a, double b, double c, double d, doubleW p, doubleW q);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, and RT2
+ is the eigenvalue of smaller absolute value.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) DOUBLE PRECISION
+ The (1,2) and (2,1) elements of the 2-by-2 matrix.
+
+ C (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) DOUBLE PRECISION
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) DOUBLE PRECISION
+ The eigenvalue of smaller absolute value.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param rt1
+ * @param rt2
+ */
+ public abstract void dlae2(double a, double b, double c, doubleW rt1, doubleW rt2);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEBZ contains the iteration loops which compute and use the
+ function N(w), which is the count of eigenvalues of a symmetric
+ tridiagonal matrix T less than or equal to its argument w. It
+ performs a choice of two types of loops:
+
+ IJOB=1, followed by
+ IJOB=2: It takes as input a list of intervals and returns a list of
+ sufficiently small intervals whose union contains the same
+ eigenvalues as the union of the original intervals.
+ The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
+ The output interval (AB(j,1),AB(j,2)] will contain
+ eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
+
+ IJOB=3: It performs a binary search in each input interval
+ (AB(j,1),AB(j,2)] for a point w(j) such that
+ N(w(j))=NVAL(j), and uses C(j) as the starting point of
+ the search. If such a w(j) is found, then on output
+ AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
+
+ (AB(j,1),AB(j,2)] will be a small interval containing the
+ point where N(w) jumps through NVAL(j), unless that point
+ lies outside the initial interval.
+
+ Note that the intervals are in all cases half-open intervals,
+ i.e., of the form (a,b] , which includes b but not a .
+
+ To avoid underflow, the matrix should be scaled so that its largest
+ element is no greater than overflow**(1/2) * underflow**(1/4)
+ in absolute value. To assure the most accurate computation
+ of small eigenvalues, the matrix should be scaled to be
+ not much smaller than that, either.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966
+
+ Note: the arguments are, in general, *not* checked for unreasonable
+ values.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies what is to be done:
+ = 1: Compute NAB for the initial intervals.
+ = 2: Perform bisection iteration to find eigenvalues of T.
+ = 3: Perform bisection iteration to invert N(w), i.e.,
+ to find a point which has a specified number of
+ eigenvalues of T to its left.
+ Other values will cause DLAEBZ to return with INFO=-1.
+
+ NITMAX (input) INTEGER
+ The maximum number of "levels" of bisection to be
+ performed, i.e., an interval of width W will not be made
+ smaller than 2^(-NITMAX) * W. If not all intervals
+ have converged after NITMAX iterations, then INFO is set
+ to the number of non-converged intervals.
+
+ N (input) INTEGER
+ The dimension n of the tridiagonal matrix T. It must be at
+ least 1.
+
+ MMAX (input) INTEGER
+ The maximum number of intervals. If more than MMAX intervals
+ are generated, then DLAEBZ will quit with INFO=MMAX+1.
+
+ MINP (input) INTEGER
+ The initial number of intervals. It may not be greater than
+
+ MMAX.
+
+ NBMIN (input) INTEGER
+ The smallest number of intervals that should be processed
+ using a vector loop. If zero, then only the scalar loop
+ will be used.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The minimum (absolute) width of an interval. When an
+ interval is narrower than ABSTOL, or than RELTOL times the
+ larger (in magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. This must be at least
+ zero.
+
+ RELTOL (input) DOUBLE PRECISION
+ The minimum relative width of an interval. When an interval
+
+ is narrower than ABSTOL, or than RELTOL times the larger (in
+
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum absolute value of a "pivot" in the Sturm
+ sequence loop. This *must* be at least max |e(j)**2| *
+ safe_min and at least safe_min, where safe_min is at least
+ the smallest number that can divide one without overflow.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N)
+ The offdiagonal elements of the tridiagonal matrix T in
+ positions 1 through N-1. E(N) is arbitrary.
+
+ E2 (input) DOUBLE PRECISION array, dimension (N)
+ The squares of the offdiagonal elements of the tridiagonal
+ matrix T. E2(N) is ignored.
+
+ NVAL (input/output) INTEGER array, dimension (MINP)
+ If IJOB=1 or 2, not referenced.
+ If IJOB=3, the desired values of N(w). The elements of NVAL
+
+ will be reordered to correspond with the intervals in AB.
+ Thus, NVAL(j) on output will not, in general be the same as
+ NVAL(j) on input, but it will correspond with the interval
+ (AB(j,1),AB(j,2)] on output.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (MMAX,2)
+ The endpoints of the intervals. AB(j,1) is a(j), the left
+ endpoint of the j-th interval, and AB(j,2) is b(j), the
+ right endpoint of the j-th interval. The input intervals
+ will, in general, be modified, split, and reordered by the
+ calculation.
+
+ C (input/output) DOUBLE PRECISION array, dimension (MMAX)
+ If IJOB=1, ignored.
+ If IJOB=2, workspace.
+ If IJOB=3, then on input C(j) should be initialized to the
+ first search point in the binary search.
+
+ MOUT (output) INTEGER
+ If IJOB=1, the number of eigenvalues in the intervals.
+ If IJOB=2 or 3, the number of intervals output.
+ If IJOB=3, MOUT will equal MINP.
+
+ NAB (input/output) INTEGER array, dimension (MMAX,2)
+ If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)).
+ If IJOB=2, then on input, NAB(i,j) should be set. It must
+ satisfy the condition:
+ N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)),
+ which means that in interval i only eigenvalues
+ NAB(i,1)+1,...,NAB(i,2) will be considered. Usually,
+ NAB(i,j)=N(AB(i,j)), from a previous call to DLAEBZ with
+ IJOB=1.
+ On output, NAB(i,j) will contain
+ max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of
+
+ the input interval that the output interval
+ (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the
+ the input values of NAB(k,1) and NAB(k,2).
+ If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)),
+ unless N(w) > NVAL(i) for all search points w , in which
+
+ case NAB(i,1) will not be modified, i.e., the output
+ value will be the same as the input value (modulo
+ reorderings -- see NVAL and AB), or unless N(w) < NVAL(i)
+
+ for all search points w , in which case NAB(i,2) will
+ not be modified. Normally, NAB should be set to some
+ distinctive value(s) before DLAEBZ is called.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MMAX)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (MMAX)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: All intervals converged.
+ = 1--MMAX: The last INFO intervals did not converge.
+ = MMAX+1: More than MMAX intervals were generated.
+
+ Further Details
+ ===============
+
+ This routine is intended to be called only by other LAPACK
+ routines, thus the interface is less user-friendly. It is intended
+ for two purposes:
+
+ (a) finding eigenvalues. In this case, DLAEBZ should have one or
+ more initial intervals set up in AB, and DLAEBZ should be called
+
+ with IJOB=1. This sets up NAB, and also counts the eigenvalues.
+
+ Intervals with no eigenvalues would usually be thrown out at
+ this point. Also, if not all the eigenvalues in an interval i
+ are desired, NAB(i,1) can be increased or NAB(i,2) decreased.
+ For example, set NAB(i,1)=NAB(i,2)-1 to get the largest
+ eigenvalue. DLAEBZ is then called with IJOB=2 and MMAX
+ no smaller than the value of MOUT returned by the call with
+ IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1
+ through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the
+ tolerance specified by ABSTOL and RELTOL.
+
+ (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l).
+ In this case, start with a Gershgorin interval (a,b). Set up
+ AB to contain 2 search intervals, both initially (a,b). One
+ NVAL element should contain f-1 and the other should contain l
+ , while C should contain a and b, resp. NAB(i,1) should be -1
+ and NAB(i,2) should be N+1, to flag an error if the desired
+ interval does not lie in (a,b). DLAEBZ is then called with
+ IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals --
+
+ j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while
+ if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r
+ >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and
+ N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and
+ w(l-r)=...=w(l+k) are handled similarly.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param ijob
+ * @param nitmax
+ * @param n
+ * @param mmax
+ * @param minp
+ * @param nbmin
+ * @param abstol
+ * @param reltol
+ * @param pivmin
+ * @param d
+ * @param e
+ * @param e2
+ * @param nval
+ * @param ab
+ * @param c
+ * @param mout
+ * @param nab
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlaebz(int ijob, int nitmax, int n, int mmax, int minp, int nbmin, double abstol, double reltol, double pivmin, double[] d, double[] e, double[] e2, int[] nval, double[] ab, double[] c, intW mout, int[] nab, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED0 computes all eigenvalues and corresponding eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+ = 2: Compute eigenvalues and eigenvectors of tridiagonal
+ matrix.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the main diagonal of the tridiagonal matrix.
+ On exit, its eigenvalues.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, Q must contain an N-by-N orthogonal matrix.
+ If ICOMPQ = 0 Q is not referenced.
+ If ICOMPQ = 1 On entry, Q is a subset of the columns of the
+ orthogonal matrix used to reduce the full
+ matrix to tridiagonal form corresponding to
+ the subset of the full matrix which is being
+
+ decomposed at this time.
+ If ICOMPQ = 2 On entry, Q will be the identity matrix.
+ On exit, Q contains the eigenvectors of the
+ tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If eigenvectors are
+ desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
+
+ QSTORE (workspace) DOUBLE PRECISION array, dimension (LDQS, N)
+ Referenced only when ICOMPQ = 1. Used to store parts of
+ the eigenvector matrix when the updating matrix multiplies
+ take place.
+
+ LDQS (input) INTEGER
+ The leading dimension of the array QSTORE. If ICOMPQ = 1,
+ then LDQS >= max(1,N). In any case, LDQS >= 1.
+
+ WORK (workspace) DOUBLE PRECISION array,
+ If ICOMPQ = 0 or 1, the dimension of WORK must be at least
+ 1 + 3*N + 2*N*lg N + 2*N**2
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of WORK must be at least
+ 4*N + N**2.
+
+ IWORK (workspace) INTEGER array,
+ If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
+ 6 + 6*N + 5*N*lg N.
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of IWORK must be at least
+ 3 + 5*N.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param qsiz
+ * @param n
+ * @param d
+ * @param e
+ * @param q
+ * @param ldq
+ * @param qstore
+ * @param ldqs
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlaed0(int icompq, int qsiz, int n, double[] d, double[] e, double[] q, int ldq, double[] qstore, int ldqs, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED1 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and eigenvectors of a tridiagonal matrix. DLAED7 handles
+ the case in which eigenvalues only or eigenvalues and eigenvectors
+ of a full symmetric matrix (which was reduced to tridiagonal form)
+ are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED2.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by DLAED3).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ On entry, the permutation which separately sorts the two
+ subproblems in D into ascending order.
+ On exit, the permutation which will reintegrate the
+ subproblems back into sorted order,
+ i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
+
+ RHO (input) DOUBLE PRECISION
+ The subdiagonal entry used to create the rank-1 modification.
+
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= CUTPNT <= N/2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N + N**2)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param cutpnt
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlaed1(int n, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED2 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation. 0 <= K <=N.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the eigenvalues of the two submatrices to
+ be combined.
+ On exit, D contains the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, Q contains the eigenvectors of two submatrices in
+ the two square blocks with corners at (1,1), (N1,N1)
+ and (N1+1, N1+1), (N,N).
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have N1 added to their
+ values. Destroyed on exit.
+
+ RHO (input/output) DOUBLE PRECISION
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ DLAED3.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On entry, Z contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+ On exit, the contents of Z have been destroyed by the updating
+ process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ DLAED3 to form the secular equation.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first k values of the final deflation-altered z-vector
+ which will be passed to DLAED3.
+
+ Q2 (output) DOUBLE PRECISION array, dimension (N1**2+(N-N1)**2)
+ A copy of the first K eigenvectors which will be used by
+ DLAED3 in a matrix multiply (DGEMM) to solve for the new
+ eigenvectors.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of DLAMDA into
+ ascending order.
+
+ INDXC (output) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups: the first group contains non-zero
+ elements only at and above N1, the second contains
+ non-zero elements only below N1, and the third is dense.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ During execution, a label which will indicate which of the
+ following types a column in the Q2 matrix is:
+ 1 : non-zero in the upper half only;
+ 2 : dense;
+ 3 : non-zero in the lower half only;
+ 4 : deflated.
+ On exit, COLTYP(i) is the number of columns of type i,
+ for i=1 to 4 only.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param k
+ * @param n
+ * @param n1
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param z
+ * @param dlamda
+ * @param w
+ * @param q2
+ * @param indx
+ * @param indxc
+ * @param indxp
+ * @param coltyp
+ * @param info
+ */
+ public abstract void dlaed2(intW k, int n, int n1, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, double[] z, double[] dlamda, double[] w, double[] q2, int[] indx, int[] indxc, int[] indxp, int[] coltyp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED3 finds the roots of the secular equation, as defined by the
+ values in D, W, and RHO, between 1 and K. It makes the
+ appropriate calls to DLAED4 and then updates the eigenvectors by
+ multiplying the matrix of eigenvectors of the pair of eigensystems
+ being combined by the matrix of eigenvectors of the K-by-K system
+ which is solved here.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ DLAED4. K >= 0.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (deflation may result in N>K).
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading submatrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ D(I) contains the updated eigenvalues for
+ 1 <= I <= K.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ Initially the first K columns are used as workspace.
+ On output the columns 1 to K contain
+ the updated eigenvectors.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ RHO (input) DOUBLE PRECISION
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input/output) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation. May be changed on output by
+ having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
+
+ Cray-2, or Cray C-90, as described above.
+
+ Q2 (input) DOUBLE PRECISION array, dimension (LDQ2, N)
+ The first K columns of this matrix contain the non-deflated
+ eigenvectors for the split problem.
+
+ INDX (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups (see DLAED2).
+ The rows of the eigenvectors found by DLAED4 must be likewise
+ permuted before the matrix multiply can take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in Q, as described in INDX. The fourth column type is any
+ column which has been deflated.
+
+ W (input/output) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector. Destroyed on
+ output.
+
+ S (workspace) DOUBLE PRECISION array, dimension (N1 + 1)*K
+ Will contain the eigenvectors of the repaired matrix which
+ will be multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max(1,K).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param k
+ * @param n
+ * @param n1
+ * @param d
+ * @param q
+ * @param ldq
+ * @param rho
+ * @param dlamda
+ * @param q2
+ * @param indx
+ * @param ctot
+ * @param w
+ * @param s
+ * @param info
+ */
+ public abstract void dlaed3(int k, int n, int n1, double[] d, double[] q, int ldq, double rho, double[] dlamda, double[] q2, int[] indx, int[] ctot, double[] w, double[] s, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th updated eigenvalue of a symmetric
+ rank-one modification to a diagonal matrix whose elements are
+ given in the array d, and that
+
+ D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The original eigenvalues. It is assumed that they are in
+ order, D(I) < D(J) for I < J.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension (N)
+ If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. If N = 2, see DLAED5
+
+ for detail. The vector DELTA contains the information necessar
+ to construct the eigenvectors by DLAED3 and DLAED9.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param dlam
+ * @param info
+ */
+ public abstract void dlaed4(int n, int i, double[] d, double[] z, double[] delta, double rho, doubleW dlam, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th eigenvalue of a symmetric rank-one
+
+ modification of a 2-by-2 diagonal matrix
+
+ diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal elements in the array D are assumed to satisfy
+
+ D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) DOUBLE PRECISION array, dimension (2)
+ The original eigenvalues. We assume D(1) < D(2).
+
+ Z (input) DOUBLE PRECISION array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension (2)
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param dlam
+ */
+ public abstract void dlaed5(int i, double[] d, double[] z, double[] delta, double rho, doubleW dlam);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED6 computes the positive or negative root (closest to the origin)
+ of
+ z(1) z(2) z(3)
+ f(x) = rho + --------- + ---------- + ---------
+ d(1)-x d(2)-x d(3)-x
+
+ It is assumed that
+
+ if ORGATI = .true. the root is between d(2) and d(3);
+ otherwise it is between d(1) and d(2)
+
+ This routine will be called by DLAED4 when necessary. In most cases,
+
+ the root sought is the smallest in magnitude, though it might not be
+
+ in some extremely rare situations.
+
+ Arguments
+ =========
+
+ KNITER (input) INTEGER
+ Refer to DLAED4 for its significance.
+
+ ORGATI (input) LOGICAL
+ If ORGATI is true, the needed root is between d(2) and
+ d(3); otherwise it is between d(1) and d(2). See
+ DLAED4 for further details.
+
+ RHO (input) DOUBLE PRECISION
+ Refer to the equation f(x) above.
+
+ D (input) DOUBLE PRECISION array, dimension (3)
+ D satisfies d(1) < d(2) < d(3).
+
+ Z (input) DOUBLE PRECISION array, dimension (3)
+ Each of the elements in z must be positive.
+
+ FINIT (input) DOUBLE PRECISION
+ The value of f at 0. It is more accurate than the one
+ evaluated inside this routine (if someone wants to do
+ so).
+
+ TAU (output) DOUBLE PRECISION
+ The root of the equation f(x).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, failure to converge
+
+ Further Details
+ ===============
+
+ 30/06/99: Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ 10/02/03: This version has a few statements commented out for thread
+
+ safety (machine parameters are computed on each entry). SJH.
+
+ 05/10/06: Modified from a new version of Ren-Cang Li, use
+ Gragg-Thornton-Warner cubic convergent scheme for better stability
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param kniter
+ * @param orgati
+ * @param rho
+ * @param d
+ * @param z
+ * @param finit
+ * @param tau
+ * @param info
+ */
+ public abstract void dlaed6(int kniter, boolean orgati, double rho, double[] d, double[] z, double finit, doubleW tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED7 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and optionally eigenvectors of a dense symmetric matrix
+ that has been reduced to tridiagonal form. DLAED1 handles
+ the case in which all eigenvalues and eigenvectors of a symmetric
+ tridiagonal matrix are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED8.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by DLAED9).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= CURLVL <= TLVLS.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (output) INTEGER array, dimension (N)
+ The permutation which will reintegrate the subproblem just
+ solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
+ will be in ascending order.
+
+ RHO (input) DOUBLE PRECISION
+ The subdiagonal element used to create the rank-1
+ modification.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ QSTORE (input/output) DOUBLE PRECISION array, dimension (N**2+1)
+ Stores eigenvectors of submatrices encountered during
+ divide and conquer, packed together. QPTR points to
+ beginning of the submatrices.
+
+ QPTR (input/output) INTEGER array, dimension (N+2)
+ List of indices pointing to beginning of submatrices stored
+ in QSTORE. The submatrices are numbered starting at the
+ bottom left of the divide and conquer tree, from left to
+ right and bottom to top.
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and also the size of
+ the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N+QSIZ*N)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param n
+ * @param qsiz
+ * @param tlvls
+ * @param curlvl
+ * @param curpbm
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param cutpnt
+ * @param qstore
+ * @param qptr
+ * @param prmptr
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param givnum
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlaed7(int icompq, int n, int qsiz, int tlvls, int curlvl, int curpbm, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] qstore, int[] qptr, int[] prmptr, int[] perm, int[] givptr, int[] givcol, double[] givnum, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED8 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny element in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the two submatrices to be
+ combined. On exit, the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If ICOMPQ = 0, Q is not referenced. Otherwise,
+ on entry, Q contains the eigenvectors of the partially solved
+
+ system which has been previously updated in matrix
+ multiplies with other partially solved eigensystems.
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have CUTPNT added to
+ their values in order to be accurate.
+
+ RHO (input/output) DOUBLE PRECISION
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ DLAED3.
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On entry, Z contains the updating vector (the last row of
+ the first sub-eigenvector matrix and the first row of the
+ second sub-eigenvector matrix).
+ On exit, the contents of Z are destroyed by the updating
+ process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ DLAED3 to form the secular equation.
+
+ Q2 (output) DOUBLE PRECISION array, dimension (LDQ2,N)
+ If ICOMPQ = 0, Q2 is not referenced. Otherwise,
+ a copy of the first K eigenvectors which will be used by
+ DLAED7 in a matrix multiply (DGEMM) to update the new
+ eigenvectors.
+
+ LDQ2 (input) INTEGER
+ The leading dimension of the array Q2. LDQ2 >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first k values of the final deflation-altered z-vector and
+ will be passed to DLAED3.
+
+ PERM (output) INTEGER array, dimension (N)
+ The permutations (from deflation and sorting) to be applied
+ to each eigenblock.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (output) INTEGER array, dimension (2, N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension (2, N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of D into ascending
+
+ order.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param k
+ * @param n
+ * @param qsiz
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param cutpnt
+ * @param z
+ * @param dlamda
+ * @param q2
+ * @param ldq2
+ * @param w
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param givnum
+ * @param indxp
+ * @param indx
+ * @param info
+ */
+ public abstract void dlaed8(int icompq, intW k, int n, int qsiz, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] z, double[] dlamda, double[] q2, int ldq2, double[] w, int[] perm, intW givptr, int[] givcol, double[] givnum, int[] indxp, int[] indx, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAED9 finds the roots of the secular equation, as defined by the
+ values in D, Z, and RHO, between KSTART and KSTOP. It makes the
+ appropriate calls to DLAED4 and then stores the new matrix of
+ eigenvectors for use in calculating the next level of Z vectors.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ DLAED4. K >= 0.
+
+ KSTART (input) INTEGER
+ KSTOP (input) INTEGER
+ The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
+ are to be computed. 1 <= KSTART <= KSTOP <= K.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (delation may result in N > K).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ D(I) contains the updated eigenvalues
+ for KSTART <= I <= KSTOP.
+
+ Q (workspace) DOUBLE PRECISION array, dimension (LDQ,N)
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max( 1, N ).
+
+ RHO (input) DOUBLE PRECISION
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ W (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector.
+
+ S (output) DOUBLE PRECISION array, dimension (LDS, K)
+ Will contain the eigenvectors of the repaired matrix which
+ will be stored for subsequent Z vector calculation and
+ multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max( 1, K ).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param k
+ * @param kstart
+ * @param kstop
+ * @param n
+ * @param d
+ * @param q
+ * @param ldq
+ * @param rho
+ * @param dlamda
+ * @param w
+ * @param s
+ * @param lds
+ * @param info
+ */
+ public abstract void dlaed9(int k, int kstart, int kstop, int n, double[] d, double[] q, int ldq, double rho, double[] dlamda, double[] w, double[] s, int lds, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEDA computes the Z vector corresponding to the merge step in the
+ CURLVLth step of the merge process with TLVLS steps for the CURPBMth
+
+ problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= curlvl <= tlvls.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and incidentally the
+ size of the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ Q (input) DOUBLE PRECISION array, dimension (N**2)
+ Contains the square eigenblocks from previous levels, the
+ starting positions for blocks are given by QPTR.
+
+ QPTR (input) INTEGER array, dimension (N+2)
+ Contains a list of pointers which indicate where in Q an
+ eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
+ the size of the block.
+
+ Z (output) DOUBLE PRECISION array, dimension (N)
+ On output this vector contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+
+ ZTEMP (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param tlvls
+ * @param curlvl
+ * @param curpbm
+ * @param prmptr
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param givnum
+ * @param q
+ * @param qptr
+ * @param z
+ * @param ztemp
+ * @param info
+ */
+ public abstract void dlaeda(int n, int tlvls, int curlvl, int curpbm, int[] prmptr, int[] perm, int[] givptr, int[] givcol, double[] givnum, double[] q, int[] qptr, double[] z, double[] ztemp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEIN uses inverse iteration to find a right or left eigenvector
+ corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg
+ matrix H.
+
+ Arguments
+ =========
+
+ RIGHTV (input) LOGICAL
+ = .TRUE. : compute right eigenvector;
+ = .FALSE.: compute left eigenvector.
+
+ NOINIT (input) LOGICAL
+ = .TRUE. : no initial vector supplied in (VR,VI).
+ = .FALSE.: initial vector supplied in (VR,VI).
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) DOUBLE PRECISION array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input) DOUBLE PRECISION
+ WI (input) DOUBLE PRECISION
+ The real and imaginary parts of the eigenvalue of H whose
+ corresponding right or left eigenvector is to be computed.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (N)
+ VI (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, if NOINIT = .FALSE. and WI = 0.0, VR must contain
+ a real starting vector for inverse iteration using the real
+ eigenvalue WR; if NOINIT = .FALSE. and WI.ne.0.0, VR and VI
+ must contain the real and imaginary parts of a complex
+ starting vector for inverse iteration using the complex
+ eigenvalue (WR,WI); otherwise VR and VI need not be set.
+ On exit, if WI = 0.0 (real eigenvalue), VR contains the
+ computed real eigenvector; if WI.ne.0.0 (complex eigenvalue),
+ VR and VI contain the real and imaginary parts of the
+ computed complex eigenvector. The eigenvector is normalized
+ so that the component of largest magnitude has magnitude 1;
+ here the magnitude of a complex number (x,y) is taken to be
+ |x| + |y|.
+ VI is not referenced if WI = 0.0.
+
+ B (workspace) DOUBLE PRECISION array, dimension (LDB,N)
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= N+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ EPS3 (input) DOUBLE PRECISION
+ A small machine-dependent value which is used to perturb
+ close eigenvalues, and to replace zero pivots.
+
+ SMLNUM (input) DOUBLE PRECISION
+ A machine-dependent value close to the underflow threshold.
+
+ BIGNUM (input) DOUBLE PRECISION
+ A machine-dependent value close to the overflow threshold.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: inverse iteration did not converge; VR is set to the
+ last iterate, and so is VI if WI.ne.0.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param rightv
+ * @param noinit
+ * @param n
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param vr
+ * @param vi
+ * @param b
+ * @param ldb
+ * @param work
+ * @param eps3
+ * @param smlnum
+ * @param bignum
+ * @param info
+ */
+ public abstract void dlaein(boolean rightv, boolean noinit, int n, double[] h, int ldh, double wr, double wi, double[] vr, double[] vi, double[] b, int ldb, double[] work, double eps3, double smlnum, double bignum, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
+ eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
+ eigenvector for RT1, giving the decomposition
+
+ [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
+ [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) DOUBLE PRECISION
+ The (1,2) element and the conjugate of the (2,1) element of
+ the 2-by-2 matrix.
+
+ C (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) DOUBLE PRECISION
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) DOUBLE PRECISION
+ The eigenvalue of smaller absolute value.
+
+ CS1 (output) DOUBLE PRECISION
+ SN1 (output) DOUBLE PRECISION
+ The vector (CS1, SN1) is a unit right eigenvector for RT1.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ CS1 and SN1 are accurate to a few ulps barring over/underflow.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param rt1
+ * @param rt2
+ * @param cs1
+ * @param sn1
+ */
+ public abstract void dlaev2(double a, double b, double c, doubleW rt1, doubleW rt2, doubleW cs1, doubleW sn1);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
+
+ an upper quasi-triangular matrix T by an orthogonal similarity
+ transformation.
+
+ T must be in Schur canonical form, that is, block upper triangular
+ with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
+ has its diagonal elemnts equal and its off-diagonal elements of
+ opposite sign.
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ = .TRUE. : accumulate the transformation in the matrix Q;
+ = .FALSE.: do not accumulate the transformation.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, the updated matrix T, again in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
+ On exit, if WANTQ is .TRUE., the updated matrix Q.
+ If WANTQ is .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
+
+ J1 (input) INTEGER
+ The index of the first row of the first block T11.
+
+ N1 (input) INTEGER
+ The order of the first block T11. N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block T22. N2 = 0, 1 or 2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: the transformed matrix T would be too far from Schur
+ form; the blocks are not swapped and T and Q are
+ unchanged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param wantq
+ * @param n
+ * @param t
+ * @param ldt
+ * @param q
+ * @param ldq
+ * @param j1
+ * @param n1
+ * @param n2
+ * @param work
+ * @param info
+ */
+ public abstract void dlaexc(boolean wantq, int n, double[] t, int ldt, double[] q, int ldq, int j1, int n1, int n2, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
+ problem A - w B, with scaling as necessary to avoid over-/underflow.
+
+ The scaling factor "s" results in a modified eigenvalue equation
+
+ s A - w B
+
+ where s is a non-negative scaling factor chosen so that w, w B,
+ and s A do not overflow and, if possible, do not underflow, either.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
+
+ is less than 1/SAFMIN. Entries less than
+ sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= 2.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, 2)
+ On entry, the 2 x 2 upper triangular matrix B. It is
+ assumed that the one-norm of B is less than 1/SAFMIN. The
+ diagonals should be at least sqrt(SAFMIN) times the largest
+ element of B (in absolute value); if a diagonal is smaller
+ than that, then +/- sqrt(SAFMIN) will be used instead of
+ that diagonal.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= 2.
+
+ SAFMIN (input) DOUBLE PRECISION
+ The smallest positive number s.t. 1/SAFMIN does not
+ overflow. (This should always be DLAMCH('S') -- it is an
+ argument in order to avoid having to call DLAMCH frequently.)
+
+ SCALE1 (output) DOUBLE PRECISION
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the first eigenvalue. If
+ the eigenvalues are complex, then the eigenvalues are
+ ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
+ exponent range of the machine), SCALE1=SCALE2, and SCALE1
+ will always be positive. If the eigenvalues are real, then
+ the first (real) eigenvalue is WR1 / SCALE1 , but this may
+ overflow or underflow, and in fact, SCALE1 may be zero or
+ less than the underflow threshhold if the exact eigenvalue
+ is sufficiently large.
+
+ SCALE2 (output) DOUBLE PRECISION
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the second eigenvalue. If
+
+ the eigenvalues are complex, then SCALE2=SCALE1. If the
+ eigenvalues are real, then the second (real) eigenvalue is
+ WR2 / SCALE2 , but this may overflow or underflow, and in
+ fact, SCALE2 may be zero or less than the underflow
+ threshhold if the exact eigenvalue is sufficiently large.
+
+ WR1 (output) DOUBLE PRECISION
+ If the eigenvalue is real, then WR1 is SCALE1 times the
+ eigenvalue closest to the (2,2) element of A B**(-1). If the
+ eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
+
+ part of the eigenvalues.
+
+ WR2 (output) DOUBLE PRECISION
+ If the eigenvalue is real, then WR2 is SCALE2 times the
+ other eigenvalue. If the eigenvalue is complex, then
+ WR1=WR2 is SCALE1 times the real part of the eigenvalues.
+
+ WI (output) DOUBLE PRECISION
+ If the eigenvalue is real, then WI is zero. If the
+ eigenvalue is complex, then WI is SCALE1 times the imaginary
+
+ part of the eigenvalues. WI will always be non-negative.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param safmin
+ * @param scale1
+ * @param scale2
+ * @param wr1
+ * @param wr2
+ * @param wi
+ */
+ public abstract void dlag2(double[] a, int lda, double[] b, int ldb, double safmin, doubleW scale1, doubleW scale2, doubleW wr1, doubleW wr2, doubleW wi);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE
+ PRECISION matrix, A.
+
+ RMAX is the overflow for the SINGLE PRECISION arithmetic
+ DLAG2S checks that all the entries of A are between -RMAX and
+ RMAX. If not the convertion is aborted and a flag is raised.
+
+ This is a helper routine so there is no argument checking.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of lines of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N coefficient matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ SA (output) REAL array, dimension (LDSA,N)
+ On exit, if INFO=0, the M-by-N coefficient matrix SA.
+
+ LDSA (input) INTEGER
+ The leading dimension of the array SA. LDSA >= max(1,M).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, the (i,j) entry of the matrix A has
+ overflowed when moving from DOUBLE PRECISION to SINGLE
+
+ k is given by k = (i-1)*LDA+j
+
+ =========
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param sa
+ * @param ldsa
+ * @param info
+ */
+ public void dlag2s(int m, int n, double[] a, int lda, float[] sa, int ldsa, intW info) {
+ org.netlib.lapack.Dlag2s.dlag2s(m, n, a, 0, lda, sa, 0, ldsa, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
+ that if ( UPPER ) then
+
+ U'*A*Q = U'*( A1 A2 )*Q = ( x 0 )
+ ( 0 A3 ) ( x x )
+ and
+ V'*B*Q = V'*( B1 B2 )*Q = ( x 0 )
+ ( 0 B3 ) ( x x )
+
+ or if ( .NOT.UPPER ) then
+
+ U'*A*Q = U'*( A1 0 )*Q = ( x x )
+ ( A2 A3 ) ( 0 x )
+ and
+ V'*B*Q = V'*( B1 0 )*Q = ( x x )
+ ( B2 B3 ) ( 0 x )
+
+ The rows of the transformed A and B are parallel, where
+
+ U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
+ ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
+
+ Z' denotes the transpose of Z.
+
+
+ Arguments
+ =========
+
+ UPPER (input) LOGICAL
+ = .TRUE.: the input matrices A and B are upper triangular.
+ = .FALSE.: the input matrices A and B are lower triangular.
+
+ A1 (input) DOUBLE PRECISION
+ A2 (input) DOUBLE PRECISION
+ A3 (input) DOUBLE PRECISION
+ On entry, A1, A2 and A3 are elements of the input 2-by-2
+ upper (lower) triangular matrix A.
+
+ B1 (input) DOUBLE PRECISION
+ B2 (input) DOUBLE PRECISION
+ B3 (input) DOUBLE PRECISION
+ On entry, B1, B2 and B3 are elements of the input 2-by-2
+ upper (lower) triangular matrix B.
+
+ CSU (output) DOUBLE PRECISION
+ SNU (output) DOUBLE PRECISION
+ The desired orthogonal matrix U.
+
+ CSV (output) DOUBLE PRECISION
+ SNV (output) DOUBLE PRECISION
+ The desired orthogonal matrix V.
+
+ CSQ (output) DOUBLE PRECISION
+ SNQ (output) DOUBLE PRECISION
+ The desired orthogonal matrix Q.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param upper
+ * @param a1
+ * @param a2
+ * @param a3
+ * @param b1
+ * @param b2
+ * @param b3
+ * @param csu
+ * @param snu
+ * @param csv
+ * @param snv
+ * @param csq
+ * @param snq
+ */
+ public abstract void dlags2(boolean upper, double a1, double a2, double a3, double b1, double b2, double b3, doubleW csu, doubleW snu, doubleW csv, doubleW snv, doubleW csq, doubleW snq);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
+ tridiagonal matrix and lambda is a scalar, as
+
+ T - lambda*I = PLU,
+
+ where P is a permutation matrix, L is a unit lower tridiagonal matrix
+ with at most one non-zero sub-diagonal elements per column and U is
+ an upper triangular matrix with at most two non-zero super-diagonal
+ elements per column.
+
+ The factorization is obtained by Gaussian elimination with partial
+ pivoting and implicit row scaling.
+
+ The parameter LAMBDA is included in the routine so that DLAGTF may
+ be used, in conjunction with DLAGTS, to obtain eigenvectors of T by
+ inverse iteration.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, A must contain the diagonal elements of T.
+
+ On exit, A is overwritten by the n diagonal elements of the
+ upper triangular matrix U of the factorization of T.
+
+ LAMBDA (input) DOUBLE PRECISION
+ On entry, the scalar lambda.
+
+ B (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, B must contain the (n-1) super-diagonal elements of
+ T.
+
+ On exit, B is overwritten by the (n-1) super-diagonal
+ elements of the matrix U of the factorization of T.
+
+ C (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, C must contain the (n-1) sub-diagonal elements of
+ T.
+
+ On exit, C is overwritten by the (n-1) sub-diagonal elements
+
+ of the matrix L of the factorization of T.
+
+ TOL (input) DOUBLE PRECISION
+ On entry, a relative tolerance used to indicate whether or
+ not the matrix (T - lambda*I) is nearly singular. TOL should
+
+ normally be chose as approximately the largest relative error
+ in the elements of T. For example, if the elements of T are
+ correct to about 4 significant figures, then TOL should be
+ set to about 5*10**(-4). If TOL is supplied as less than eps,
+ where eps is the relative machine precision, then the value
+ eps is used in place of TOL.
+
+ D (output) DOUBLE PRECISION array, dimension (N-2)
+ On exit, D is overwritten by the (n-2) second super-diagonal
+
+ elements of the matrix U of the factorization of T.
+
+ IN (output) INTEGER array, dimension (N)
+ On exit, IN contains details of the permutation matrix P. If
+
+ an interchange occurred at the kth step of the elimination,
+ then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
+ returns the smallest positive integer j such that
+
+ abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
+
+ where norm( A(j) ) denotes the sum of the absolute values of
+
+ the jth row of the matrix A. If no such j exists then IN(n)
+ is returned as zero. If IN(n) is returned as positive, then a
+ diagonal element of U is small, indicating that
+ (T - lambda*I) is singular or nearly singular,
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -k, the kth argument had an illegal value
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lambda
+ * @param b
+ * @param c
+ * @param tol
+ * @param d
+ * @param in
+ * @param info
+ */
+ public abstract void dlagtf(int n, double[] a, double lambda, double[] b, double[] c, double tol, double[] d, int[] in, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGTM performs a matrix-vector product of the form
+
+ B := alpha * A * X + beta * B
+
+ where A is a tridiagonal matrix of order N, B and X are N by NRHS
+ matrices, and alpha and beta are real scalars, each of which may be
+ 0., 1., or -1.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': No transpose, B := alpha * A * X + beta * B
+ = 'T': Transpose, B := alpha * A'* X + beta * B
+ = 'C': Conjugate transpose = Transpose
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices X and B.
+
+ ALPHA (input) DOUBLE PRECISION
+ The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 0.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal elements of T.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of T.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) super-diagonal elements of T.
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The N by NRHS matrix X.
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(N,1).
+
+ BETA (input) DOUBLE PRECISION
+ The scalar beta. BETA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix B.
+ On exit, B is overwritten by the matrix expression
+ B := alpha * A * X + beta * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(N,1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param alpha
+ * @param dl
+ * @param d
+ * @param du
+ * @param x
+ * @param ldx
+ * @param beta
+ * @param b
+ * @param ldb
+ */
+ public abstract void dlagtm(String trans, int n, int nrhs, double alpha, double[] dl, double[] d, double[] du, double[] x, int ldx, double beta, double[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGTS may be used to solve one of the systems of equations
+
+ (T - lambda*I)*x = y or (T - lambda*I)'*x = y,
+
+ where T is an n by n tridiagonal matrix, for x, following the
+ factorization of (T - lambda*I) as
+
+ (T - lambda*I) = P*L*U ,
+
+ by routine DLAGTF. The choice of equation to be solved is
+ controlled by the argument JOB, and in each case there is an option
+ to perturb zero or very small diagonal elements of U, this option
+ being intended for use in applications such as inverse iteration.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ Specifies the job to be performed by DLAGTS as follows:
+ = 1: The equations (T - lambda*I)x = y are to be solved,
+ but diagonal elements of U are not to be perturbed.
+ = -1: The equations (T - lambda*I)x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+ = 2: The equations (T - lambda*I)'x = y are to be solved,
+
+ but diagonal elements of U are not to be perturbed.
+ = -2: The equations (T - lambda*I)'x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input) DOUBLE PRECISION array, dimension (N)
+ On entry, A must contain the diagonal elements of U as
+ returned from DLAGTF.
+
+ B (input) DOUBLE PRECISION array, dimension (N-1)
+ On entry, B must contain the first super-diagonal elements of
+ U as returned from DLAGTF.
+
+ C (input) DOUBLE PRECISION array, dimension (N-1)
+ On entry, C must contain the sub-diagonal elements of L as
+ returned from DLAGTF.
+
+ D (input) DOUBLE PRECISION array, dimension (N-2)
+ On entry, D must contain the second super-diagonal elements
+ of U as returned from DLAGTF.
+
+ IN (input) INTEGER array, dimension (N)
+ On entry, IN must contain details of the matrix P as returned
+ from DLAGTF.
+
+ Y (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side vector y.
+ On exit, Y is overwritten by the solution vector x.
+
+ TOL (input/output) DOUBLE PRECISION
+ On entry, with JOB .lt. 0, TOL should be the minimum
+ perturbation to be made to very small diagonal elements of U.
+ TOL should normally be chosen as about eps*norm(U), where eps
+ is the relative machine precision, but if TOL is supplied as
+
+ non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
+ If JOB .gt. 0 then TOL is not referenced.
+
+ On exit, TOL is changed as described above, only if TOL is
+ non-positive on entry. Otherwise TOL is unchanged.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -i, the i-th argument had an illegal value
+
+ .gt. 0: overflow would occur when computing the INFO(th)
+ element of the solution vector x. This can only occur
+ when JOB is supplied as positive and either means
+ that a diagonal element of U is very small, or that
+ the elements of the right-hand side vector y are very
+ large.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param n
+ * @param a
+ * @param b
+ * @param c
+ * @param d
+ * @param in
+ * @param y
+ * @param tol
+ * @param info
+ */
+ public abstract void dlagts(int job, int n, double[] a, double[] b, double[] c, double[] d, int[] in, double[] y, doubleW tol, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAGV2 computes the Generalized Schur factorization of a real 2-by-2
+
+ matrix pencil (A,B) where B is upper triangular. This routine
+ computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
+ SNR such that
+
+ 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
+ types), then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
+
+ 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
+ then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
+
+ where b11 >= b22 > 0.
+
+
+ Arguments
+ =========
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A.
+ On exit, A is overwritten by the ``A-part'' of the
+ generalized Schur form.
+
+ LDA (input) INTEGER
+ THe leading dimension of the array A. LDA >= 2.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, 2)
+ On entry, the upper triangular 2 x 2 matrix B.
+ On exit, B is overwritten by the ``B-part'' of the
+ generalized Schur form.
+
+ LDB (input) INTEGER
+ THe leading dimension of the array B. LDB >= 2.
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (2)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (2)
+ BETA (output) DOUBLE PRECISION array, dimension (2)
+ (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
+ pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
+ be zero.
+
+ CSL (output) DOUBLE PRECISION
+ The cosine of the left rotation matrix.
+
+ SNL (output) DOUBLE PRECISION
+ The sine of the left rotation matrix.
+
+ CSR (output) DOUBLE PRECISION
+ The cosine of the right rotation matrix.
+
+ SNR (output) DOUBLE PRECISION
+ The sine of the right rotation matrix.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param csl
+ * @param snl
+ * @param csr
+ * @param snr
+ */
+ public abstract void dlagv2(double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, doubleW csl, doubleW snl, doubleW csr, doubleW snr);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAHQR is an auxiliary routine called by DHSEQR to update the
+ eigenvalues and Schur decomposition already computed by DHSEQR, by
+ dealing with the Hessenberg submatrix in rows and columns ILO to
+ IHI.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper quasi-triangular in
+ rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
+ ILO = 1). DLAHQR works primarily with the Hessenberg
+ submatrix in rows and columns ILO to IHI, but applies
+ transformations to all of H if WANTT is .TRUE..
+ 1 <= ILO <= max(1,IHI); IHI <= N.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO is zero and if WANTT is .TRUE., H is upper
+ quasi-triangular in rows and columns ILO:IHI, with any
+ 2-by-2 diagonal blocks in standard form. If INFO is zero
+ and WANTT is .FALSE., the contents of H are unspecified on
+ exit. The output state of H if INFO is nonzero is given
+ below under the description of INFO.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+ eigenvalues ILO to IHI are stored in the corresponding
+ elements of WR and WI. If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
+ eigenvalues are stored in the same order as on the diagonal
+ of the Schur form returned in H, with WR(i) = H(i,i), and, if
+ H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
+ WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ If WANTZ is .TRUE., on entry Z must contain the current
+ matrix Z of transformations accumulated by DHSEQR, and on
+ exit Z has been updated; transformations are applied only to
+
+ the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+ If WANTZ is .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: If INFO = i, DLAHQR failed to compute all the
+ eigenvalues ILO to IHI in a total of 30 iterations
+ per eigenvalue; elements i+1:ihi of WR and WI
+ contain those eigenvalues which have been
+ successfully computed.
+
+ If INFO .GT. 0 and WANTT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the
+ eigenvalues of the upper Hessenberg matrix rows
+ and columns ILO thorugh INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+ (*) (initial value of H)*U = U*(final value of H)
+ where U is an orthognal matrix. The final
+ value of H is upper Hessenberg and triangular in
+ rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+ (final value of Z) = (initial value of Z)*U
+ where U is the orthogonal matrix in (*)
+ (regardless of the value of WANTT.)
+
+ Further Details
+ ===============
+
+ 02-96 Based on modifications by
+ David Day, Sandia National Laboratory, USA
+
+ 12-04 Further modifications by
+ Ralph Byers, University of Kansas, USA
+
+ This is a modified version of DLAHQR from LAPACK version 3.0.
+ It is (1) more robust against overflow and underflow and
+ (2) adopts the more conservative Ahues & Tisseur stopping
+ criterion (LAWN 122, 1997).
+
+ =========================================================
+
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param info
+ */
+ public abstract void dlahqr(boolean wantt, boolean wantz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, int iloz, int ihiz, double[] z, int ldz, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an auxiliary routine called by DGEHRD.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+ K < N.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
+
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) DOUBLE PRECISION array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a a a a a )
+ ( a a a a a )
+ ( a a a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's DLAHRD
+ incorporating improvements proposed by Quintana-Orti and Van de
+ Gejin. Note that the entries of A(1:K,2:NB) differ from those
+ returned by the original LAPACK routine. This function is
+ not backward compatible with LAPACK3.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param k
+ * @param nb
+ * @param a
+ * @param lda
+ * @param tau
+ * @param t
+ * @param ldt
+ * @param y
+ * @param ldy
+ */
+ public void dlahr2(int n, int k, int nb, double[] a, int lda, double[] tau, double[] t, int ldt, double[] y, int ldy) {
+ org.netlib.lapack.Dlahr2.dlahr2(n, k, nb, a, 0, lda, tau, 0, t, 0, ldt, y, 0, ldy);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an OBSOLETE auxiliary routine.
+ This routine will be 'deprecated' in a future release.
+ Please use the new routine DLAHR2 instead.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
+
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) DOUBLE PRECISION array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a h a a a )
+ ( a h a a a )
+ ( a h a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param k
+ * @param nb
+ * @param a
+ * @param lda
+ * @param tau
+ * @param t
+ * @param ldt
+ * @param y
+ * @param ldy
+ */
+ public abstract void dlahrd(int n, int k, int nb, double[] a, int lda, double[] tau, double[] t, int ldt, double[] y, int ldy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAIC1 applies one step of incremental condition estimation in
+ its simplest version:
+
+ Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
+ lower triangular matrix L, such that
+ twonorm(L*x) = sest
+ Then DLAIC1 computes sestpr, s, c such that
+ the vector
+ [ s*x ]
+ xhat = [ c ]
+ is an approximate singular vector of
+ [ L 0 ]
+ Lhat = [ w' gamma ]
+ in the sense that
+ twonorm(Lhat*xhat) = sestpr.
+
+ Depending on JOB, an estimate for the largest or smallest singular
+ value is computed.
+
+ Note that [s c]' and sestpr**2 is an eigenpair of the system
+
+ diag(sest*sest, 0) + [alpha gamma] * [ alpha ]
+ [ gamma ]
+
+ where alpha = x'*w.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ = 1: an estimate for the largest singular value is computed.
+
+ = 2: an estimate for the smallest singular value is computed.
+
+ J (input) INTEGER
+ Length of X and W
+
+ X (input) DOUBLE PRECISION array, dimension (J)
+ The j-vector x.
+
+ SEST (input) DOUBLE PRECISION
+ Estimated singular value of j by j matrix L
+
+ W (input) DOUBLE PRECISION array, dimension (J)
+ The j-vector w.
+
+ GAMMA (input) DOUBLE PRECISION
+ The diagonal element gamma.
+
+ SESTPR (output) DOUBLE PRECISION
+ Estimated singular value of (j+1) by (j+1) matrix Lhat.
+
+ S (output) DOUBLE PRECISION
+ Sine needed in forming xhat.
+
+ C (output) DOUBLE PRECISION
+ Cosine needed in forming xhat.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param j
+ * @param x
+ * @param sest
+ * @param w
+ * @param gamma
+ * @param sestpr
+ * @param s
+ * @param c
+ */
+ public abstract void dlaic1(int job, int j, double[] x, double sest, double[] w, double gamma, doubleW sestpr, doubleW s, doubleW c);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is not for general use. It exists solely to avoid
+ over-optimization in DISNAN.
+
+ DLAISNAN checks for NaNs by comparing its two arguments for
+ inequality. NaN is the only floating-point value where NaN != NaN
+ returns .TRUE. To check for NaNs, pass the same variable as both
+ arguments.
+
+ Strictly speaking, Fortran does not allow aliasing of function
+ arguments. So a compiler must assume that the two arguments are
+ not the same variable, and the test will not be optimized away.
+ Interprocedural or whole-program optimization may delete this
+ test. The ISNAN functions will be replaced by the correct
+ Fortran 03 intrinsic once the intrinsic is widely available.
+
+ Arguments
+ =========
+
+ DIN1 (input) DOUBLE PRECISION
+ DIN2 (input) DOUBLE PRECISION
+ Two numbers to compare for inequality.
+
+ =====================================================================
+
+ .. Executable Statements ..
+</pre>
+ * @param din1
+ * @param din2
+ */
+ public boolean dlaisnan(double din1, double din2) {
+ return org.netlib.lapack.Dlaisnan.dlaisnan(din1, din2);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALN2 solves a system of the form (ca A - w D ) X = s B
+ or (ca A' - w D) X = s B with possible scaling ("s") and
+ perturbation of A. (A' means A-transpose.)
+
+ A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
+ real diagonal matrix, w is a real or complex value, and X and B are
+ NA x 1 matrices -- real if w is real, complex if w is complex. NA
+ may be 1 or 2.
+
+ If w is complex, X and B are represented as NA x 2 matrices,
+ the first column of each being the real part and the second
+ being the imaginary part.
+
+ "s" is a scaling factor (.LE. 1), computed by DLALN2, which is
+ so chosen that X can be computed without overflow. X is further
+ scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
+ than overflow.
+
+ If both singular values of (ca A - w D) are less than SMIN,
+ SMIN*identity will be used instead of (ca A - w D). If only one
+ singular value is less than SMIN, one element of (ca A - w D) will be
+ perturbed enough to make the smallest singular value roughly SMIN.
+ If both singular values are at least SMIN, (ca A - w D) will not be
+ perturbed. In any case, the perturbation will be at most some small
+
+ multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
+ are computed by infinity-norm approximations, and thus will only be
+ correct to a factor of 2 or so.
+
+ Note: all input quantities are assumed to be smaller than overflow
+ by a reasonable factor. (See BIGNUM.)
+
+ Arguments
+ ==========
+
+ LTRANS (input) LOGICAL
+ =.TRUE.: A-transpose will be used.
+ =.FALSE.: A will be used (not transposed.)
+
+ NA (input) INTEGER
+ The size of the matrix A. It may (only) be 1 or 2.
+
+ NW (input) INTEGER
+ 1 if "w" is real, 2 if "w" is complex. It may only be 1
+ or 2.
+
+ SMIN (input) DOUBLE PRECISION
+ The desired lower bound on the singular values of A. This
+ should be a safe distance away from underflow or overflow,
+ say, between (underflow/machine precision) and (machine
+ precision * overflow ). (See BIGNUM and ULP.)
+
+ CA (input) DOUBLE PRECISION
+ The coefficient c, which A is multiplied by.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,NA)
+ The NA x NA matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of A. It must be at least NA.
+
+ D1 (input) DOUBLE PRECISION
+ The 1,1 element in the diagonal matrix D.
+
+ D2 (input) DOUBLE PRECISION
+ The 2,2 element in the diagonal matrix D. Not used if NW=1.
+
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NW)
+ The NA x NW matrix B (right-hand side). If NW=2 ("w" is
+ complex), column 1 contains the real part of B and column 2
+ contains the imaginary part.
+
+ LDB (input) INTEGER
+ The leading dimension of B. It must be at least NA.
+
+ WR (input) DOUBLE PRECISION
+ The real part of the scalar "w".
+
+ WI (input) DOUBLE PRECISION
+ The imaginary part of the scalar "w". Not used if NW=1.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NW)
+ The NA x NW matrix X (unknowns), as computed by DLALN2.
+ If NW=2 ("w" is complex), on exit, column 1 will contain
+ the real part of X and column 2 will contain the imaginary
+ part.
+
+ LDX (input) INTEGER
+ The leading dimension of X. It must be at least NA.
+
+ SCALE (output) DOUBLE PRECISION
+ The scale factor that B must be multiplied by to insure
+ that overflow does not occur when computing X. Thus,
+ (ca A - w D) X will be SCALE*B, not B (ignoring
+ perturbations of A.) It will be at most 1.
+
+ XNORM (output) DOUBLE PRECISION
+ The infinity-norm of X, when X is regarded as an NA x NW
+ real matrix.
+
+ INFO (output) INTEGER
+ An error flag. It will be set to zero if no error occurs,
+ a negative number if an argument is in error, or a positive
+ number if ca A - w D had to be perturbed.
+ The possible values are:
+ = 0: No error occurred, and (ca A - w D) did not have to be
+ perturbed.
+ = 1: (ca A - w D) had to be perturbed to make its smallest
+ (or only) singular value greater than SMIN.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param ltrans
+ * @param na
+ * @param nw
+ * @param smin
+ * @param ca
+ * @param a
+ * @param lda
+ * @param d1
+ * @param d2
+ * @param b
+ * @param ldb
+ * @param wr
+ * @param wi
+ * @param x
+ * @param ldx
+ * @param scale
+ * @param xnorm
+ * @param info
+ */
+ public abstract void dlaln2(boolean ltrans, int na, int nw, double smin, double ca, double[] a, int lda, double d1, double d2, double[] b, int ldb, double wr, double wi, double[] x, int ldx, doubleW scale, doubleW xnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALS0 applies back the multiplying factors of either the left or the
+ right singular vector matrix of a diagonal matrix appended by a row
+ to the right hand side matrix B in solving the least squares problem
+
+ using the divide-and-conquer SVD approach.
+
+ For the left singular vector matrix, three types of orthogonal
+ matrices are involved:
+
+ (1L) Givens rotations: the number of such rotations is GIVPTR; the
+ pairs of columns/rows they were applied to are stored in GIVCOL;
+ and the C- and S-values of these rotations are stored in GIVNUM.
+
+ (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
+
+ row, and for J=2:N, PERM(J)-th row of B is to be moved to the
+ J-th row.
+
+ (3L) The left singular vector matrix of the remaining matrix.
+
+ For the right singular vector matrix, four types of orthogonal
+ matrices are involved:
+
+ (1R) The right singular vector matrix of the remaining matrix.
+
+ (2R) If SQRE = 1, one extra Givens rotation to generate the right
+ null space.
+
+ (3R) The inverse transformation of (2L).
+
+ (4R) The inverse transformation of (1L).
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Left singular vector matrix.
+ = 1: Right singular vector matrix.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB must be at least
+ max(1,MAX( M, N ) ).
+
+ BX (workspace) DOUBLE PRECISION array, dimension ( LDBX, NRHS )
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ PERM (input) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) applied
+ to the two blocks.
+
+ GIVPTR (input) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of rows/columns
+ involved in a Givens rotation.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value used in the
+ corresponding Givens rotation.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of arrays DIFR, POLES and
+ GIVNUM, must be at least K.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On entry, POLES(1:K, 1) contains the new singular
+ values obtained from solving the secular equation, and
+ POLES(1:K, 2) is an array containing the poles in the secular
+
+ equation.
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( K ).
+ On entry, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ).
+ On entry, DIFR(I, 1) contains the distances between I-th
+ updated (undeflated) singular value and the I+1-th
+ (undeflated) old singular value. And DIFR(I, 2) is the
+ normalizing factor for the I-th right singular vector.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ Contain the components of the deflation-adjusted updating row
+
+ vector.
+
+ K (input) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (input) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (input) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( K )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param nrhs
+ * @param b
+ * @param ldb
+ * @param bx
+ * @param ldbx
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param givnum
+ * @param ldgnum
+ * @param poles
+ * @param difl
+ * @param difr
+ * @param z
+ * @param k
+ * @param c
+ * @param s
+ * @param work
+ * @param info
+ */
+ public abstract void dlals0(int icompq, int nl, int nr, int sqre, int nrhs, double[] b, int ldb, double[] bx, int ldbx, int[] perm, int givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, double[] poles, double[] difl, double[] difr, double[] z, int k, double c, double s, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALSA is an itermediate step in solving the least squares problem
+ by computing the SVD of the coefficient matrix in compact form (The
+ singular vectors are computed as products of simple orthorgonal
+ matrices.).
+
+ If ICOMPQ = 0, DLALSA applies the inverse of the left singular vector
+ matrix of an upper bidiagonal matrix to the right hand side; and if
+ ICOMPQ = 1, DLALSA applies the right singular vector matrix to the
+ right hand side. The singular vector matrices were generated in
+ compact form by DLALSA.
+
+ Arguments
+ =========
+
+
+ ICOMPQ (input) INTEGER
+ Specifies whether the left or the right singular vector
+ matrix is involved.
+ = 0: Left singular vector matrix
+ = 1: Right singular vector matrix
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row and column dimensions of the upper bidiagonal matrix.
+
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M.
+ On output, B contains the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,MAX( M, N ) ).
+
+ BX (output) DOUBLE PRECISION array, dimension ( LDBX, NRHS )
+ On exit, the result of applying the left or right singular
+ vector matrix to B.
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ U (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ ).
+ On entry, U contains the left singular vector matrices of all
+
+ subproblems at the bottom level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR,
+ POLES, GIVNUM, and Z.
+
+ VT (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ+1 ).
+ On entry, VT' contains the right singular vector matrices of
+ all subproblems at the bottom level.
+
+ K (input) INTEGER array, dimension ( N ).
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
+ distances between singular values on the I-th level and
+ singular values on the (I -1)-th level, and DIFR(*, 2 * I)
+ record the normalizing factors of the right singular vectors
+ matrices of subproblems on I-th level.
+
+ Z (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ On entry, Z(1, I) contains the components of the deflation-
+ adjusted updating row vector for subproblems on the I-th
+ level.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
+ singular values involved in the secular equations on the I-th
+
+ level.
+
+ GIVPTR (input) INTEGER array, dimension ( N ).
+ On entry, GIVPTR( I ) records the number of Givens
+ rotations performed on the I-th problem on the computation
+ tree.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
+ On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
+
+ locations of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (input) INTEGER array, dimension ( LDGCOL, NLVL ).
+ On entry, PERM(*, I) records permutations done on the I-th
+ level of the computation tree.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
+ values of Givens rotations performed on the I-th level on the
+
+ computation tree.
+
+ C (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ S( I ) contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) DOUBLE PRECISION array.
+ The dimension must be at least N.
+
+ IWORK (workspace) INTEGER array.
+ The dimension must be at least 3 * N
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param smlsiz
+ * @param n
+ * @param nrhs
+ * @param b
+ * @param ldb
+ * @param bx
+ * @param ldbx
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param k
+ * @param difl
+ * @param difr
+ * @param z
+ * @param poles
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param perm
+ * @param givnum
+ * @param c
+ * @param s
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlalsa(int icompq, int smlsiz, int n, int nrhs, double[] b, int ldb, double[] bx, int ldbx, double[] u, int ldu, double[] vt, int[] k, double[] difl, double[] difr, double[] z, double[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, double[] givnum, double[] c, double[] s, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLALSD uses the singular value decomposition of A to solve the least
+
+ squares problem of finding X to minimize the Euclidean norm of each
+ column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
+ are N-by-NRHS. The solution X overwrites B.
+
+ The singular values of A smaller than RCOND times the largest
+ singular value are treated as zero in solving the least squares
+ problem; in this case a minimum norm solution is returned.
+ The actual singular values are returned in D in ascending order.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': D and E define an upper bidiagonal matrix.
+ = 'L': D and E define a lower bidiagonal matrix.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The dimension of the bidiagonal matrix. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of columns of B. NRHS must be at least 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit, if INFO = 0, D contains its singular values.
+
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ Contains the super-diagonal entries of the bidiagonal matrix.
+
+ On exit, E has been destroyed.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On input, B contains the right hand sides of the least
+ squares problem. On output, B contains the solution X.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,N).
+
+ RCOND (input) DOUBLE PRECISION
+ The singular values of A less than or equal to RCOND times
+ the largest singular value are treated as zero in solving
+ the least squares problem. If RCOND is negative,
+ machine precision is used instead.
+ For example, if diag(S)*X=B were the least squares problem,
+ where diag(S) is a diagonal matrix of singular values, the
+ solution would be X(i) = B(i) / S(i) if S(i) is greater than
+ RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
+ RCOND*max(S).
+
+ RANK (output) INTEGER
+ The number of singular values of A greater than RCOND times
+ the largest singular value.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension at least
+ (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
+ where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
+
+ IWORK (workspace) INTEGER array, dimension at least
+ (3*N*NLVL + 11*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value while
+
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through MOD(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param smlsiz
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlalsd(String uplo, int smlsiz, int n, int nrhs, double[] d, double[] e, double[] b, int ldb, double rcond, intW rank, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMRG will create a permutation list which will merge the elements
+ of A (which is composed of two independently sorted sets) into a
+ single set which is sorted in ascending order.
+
+ Arguments
+ =========
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ These arguements contain the respective lengths of the two
+ sorted lists to be merged.
+
+ A (input) DOUBLE PRECISION array, dimension (N1+N2)
+ The first N1 elements of A contain a list of numbers which
+ are sorted in either ascending or descending order. Likewise
+
+ for the final N2 elements.
+
+ DTRD1 (input) INTEGER
+ DTRD2 (input) INTEGER
+ These are the strides to be taken through the array A.
+ Allowable strides are 1 and -1. They indicate whether a
+ subset of A is sorted in ascending (DTRDx = 1) or descending
+ (DTRDx = -1) order.
+
+ INDEX (output) INTEGER array, dimension (N1+N2)
+ On exit this array will contain a permutation such that
+ if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
+ sorted in ascending order.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n1
+ * @param n2
+ * @param a
+ * @param dtrd1
+ * @param dtrd2
+ * @param index
+ */
+ public abstract void dlamrg(int n1, int n2, double[] a, int dtrd1, int dtrd2, int[] index);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANEG computes the Sturm count, the number of negative pivots
+ encountered while factoring tridiagonal T - sigma I = L D L^T.
+ This implementation works directly on the factors without forming
+ the tridiagonal matrix T. The Sturm count is also the number of
+ eigenvalues of T less than sigma.
+
+ This routine is called from DLARRB.
+
+ The current routine does not use the PIVMIN parameter but rather
+ requires IEEE-754 propagation of Infinities and NaNs. This
+ routine also has no input range restrictions but does require
+ default exception handling such that x/0 produces Inf when x is
+ non-zero, and Inf/Inf produces NaN. For more information, see:
+
+ Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
+ Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
+ Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
+ (Tech report version in LAWN 172 with the same title.)
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ SIGMA (input) DOUBLE PRECISION
+ Shift amount in T - sigma I = L D L^T.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence. May be used
+ when zero pivots are encountered on non-IEEE-754
+ architectures.
+
+ R (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+ Jason Riedy, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param lld
+ * @param sigma
+ * @param pivmin
+ * @param r
+ */
+ public int dlaneg(int n, double[] d, double[] lld, double sigma, double pivmin, int r) {
+ return org.netlib.lapack.Dlaneg.dlaneg(n, d, 0, lld, 0, sigma, pivmin, r);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANGB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
+
+ Description
+ ===========
+
+ DLANGB returns the value
+
+ DLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGB as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANGB is
+ set to zero.
+
+ KL (input) INTEGER
+ The number of sub-diagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of super-diagonals of the matrix A. KU >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param work
+ */
+ public double dlangb(String norm, int n, int kl, int ku, double[] ab, int ldab, double[] work) {
+ return org.netlib.lapack.Dlangb.dlangb(norm, n, kl, ku, ab, 0, ldab, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANGE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real matrix A.
+
+ Description
+ ===========
+
+ DLANGE returns the value
+
+ DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGE as described
+ above.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0. When M = 0,
+ DLANGE is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0. When N = 0,
+
+ DLANGE is set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public double dlange(String norm, int m, int n, double[] a, int lda, double[] work) {
+ return org.netlib.lapack.Dlange.dlange(norm, m, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANGT returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real tridiagonal matrix A.
+
+ Description
+ ===========
+
+ DLANGT returns the value
+
+ DLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGT as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANGT is
+ set to zero.
+
+ DL (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal elements of A.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param dl
+ * @param d
+ * @param du
+ */
+ public double dlangt(String norm, int n, double[] dl, double[] d, double[] du) {
+ return org.netlib.lapack.Dlangt.dlangt(norm, n, dl, 0, d, 0, du, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANHS returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ Hessenberg matrix A.
+
+ Description
+ ===========
+
+ DLANHS returns the value
+
+ DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANHS as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANHS is
+ set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The n by n upper Hessenberg matrix A; the part of A below the
+ first sub-diagonal is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public double dlanhs(String norm, int n, double[] a, int lda, double[] work) {
+ return org.netlib.lapack.Dlanhs.dlanhs(norm, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANSB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n symmetric band matrix A, with k super-diagonals.
+
+ Description
+ ===========
+
+ DLANSB returns the value
+
+ DLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ band matrix A is supplied.
+ = 'U': Upper triangular part is supplied
+ = 'L': Lower triangular part is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals or sub-diagonals of the
+ band matrix A. K >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first K+1 rows of AB. The j-th column of A is
+
+ stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param n
+ * @param k
+ * @param ab
+ * @param ldab
+ * @param work
+ */
+ public double dlansb(String norm, String uplo, int n, int k, double[] ab, int ldab, double[] work) {
+ return org.netlib.lapack.Dlansb.dlansb(norm, uplo, n, k, ab, 0, ldab, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANSP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ DLANSP returns the value
+
+ DLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is supplied.
+ = 'U': Upper triangular part of A is supplied
+ = 'L': Lower triangular part of A is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSP is
+ set to zero.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param work
+ */
+ public double dlansp(String norm, String uplo, int n, double[] ap, double[] work) {
+ return org.netlib.lapack.Dlansp.dlansp(norm, uplo, n, ap, 0, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANST returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric tridiagonal matrix A.
+
+ Description
+ ===========
+
+ DLANST returns the value
+
+ DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANST as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANST is
+ set to zero.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal or super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param d
+ * @param e
+ */
+ public double dlanst(String norm, int n, double[] d, double[] e) {
+ return org.netlib.lapack.Dlanst.dlanst(norm, n, d, 0, e, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANSY returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A.
+
+ Description
+ ===========
+
+ DLANSY returns the value
+
+ DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSY as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is to be referenced.
+ = 'U': Upper triangular part of A is referenced
+ = 'L': Lower triangular part of A is referenced
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSY is
+ set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public double dlansy(String norm, String uplo, int n, double[] a, int lda, double[] work) {
+ return org.netlib.lapack.Dlansy.dlansy(norm, uplo, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANTB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n triangular band matrix A, with ( k + 1 ) diagonals.
+
+ Description
+ ===========
+
+ DLANTB returns the value
+
+ DLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANTB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANTB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals of the matrix A if UPLO = 'L'.
+ K >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first k+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+ Note that when DIAG = 'U', the elements of the array AB
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param k
+ * @param ab
+ * @param ldab
+ * @param work
+ */
+ public double dlantb(String norm, String uplo, String diag, int n, int k, double[] ab, int ldab, double[] work) {
+ return org.netlib.lapack.Dlantb.dlantb(norm, uplo, diag, n, k, ab, 0, ldab, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANTP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ triangular matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ DLANTP returns the value
+
+ DLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANTP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANTP is
+ set to zero.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ Note that when DIAG = 'U', the elements of the array AP
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param ap
+ * @param work
+ */
+ public double dlantp(String norm, String uplo, String diag, int n, double[] ap, double[] work) {
+ return org.netlib.lapack.Dlantp.dlantp(norm, uplo, diag, n, ap, 0, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANTR returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ trapezoidal or triangular matrix A.
+
+ Description
+ ===========
+
+ DLANTR returns the value
+
+ DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANTR as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower trapezoidal.
+ = 'U': Upper trapezoidal
+ = 'L': Lower trapezoidal
+ Note that A is triangular instead of trapezoidal if M = N.
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A has unit diagonal.
+ = 'N': Non-unit diagonal
+ = 'U': Unit diagonal
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0, and if
+ UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0, and if
+ UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The trapezoidal matrix A (A is triangular if M = N).
+ If UPLO = 'U', the leading m by n upper trapezoidal part of
+ the array A contains the upper trapezoidal matrix, and the
+ strictly lower triangular part of A is not referenced.
+ If UPLO = 'L', the leading m by n lower trapezoidal part of
+ the array A contains the lower trapezoidal matrix, and the
+ strictly upper triangular part of A is not referenced. Note
+
+ that when DIAG = 'U', the diagonal elements of A are not
+ referenced and are assumed to be one.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public double dlantr(String norm, String uplo, String diag, int m, int n, double[] a, int lda, double[] work) {
+ return org.netlib.lapack.Dlantr.dlantr(norm, uplo, diag, m, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
+ matrix in standard form:
+
+ [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
+ [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
+
+ where either
+ 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
+ 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
+ conjugate eigenvalues.
+
+ Arguments
+ =========
+
+ A (input/output) DOUBLE PRECISION
+ B (input/output) DOUBLE PRECISION
+ C (input/output) DOUBLE PRECISION
+ D (input/output) DOUBLE PRECISION
+ On entry, the elements of the input matrix.
+ On exit, they are overwritten by the elements of the
+ standardised Schur form.
+
+ RT1R (output) DOUBLE PRECISION
+ RT1I (output) DOUBLE PRECISION
+ RT2R (output) DOUBLE PRECISION
+ RT2I (output) DOUBLE PRECISION
+ The real and imaginary parts of the eigenvalues. If the
+ eigenvalues are a complex conjugate pair, RT1I > 0.
+
+ CS (output) DOUBLE PRECISION
+ SN (output) DOUBLE PRECISION
+ Parameters of the rotation matrix.
+
+ Further Details
+ ===============
+
+ Modified by V. Sima, Research Institute for Informatics, Bucharest,
+ Romania, to reduce the risk of cancellation errors,
+ when computing real eigenvalues, and to ensure, if possible, that
+ abs(RT1R) >= abs(RT2R).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param d
+ * @param rt1r
+ * @param rt1i
+ * @param rt2r
+ * @param rt2i
+ * @param cs
+ * @param sn
+ */
+ public abstract void dlanv2(doubleW a, doubleW b, doubleW c, doubleW d, doubleW rt1r, doubleW rt1i, doubleW rt2r, doubleW rt2i, doubleW cs, doubleW sn);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given two column vectors X and Y, let
+
+ A = ( X Y ).
+
+ The subroutine first computes the QR factorization of A = Q*R,
+ and then computes the SVD of the 2-by-2 upper triangular matrix R.
+ The smaller singular value of R is returned in SSMIN, which is used
+ as the measurement of the linear dependency of the vectors X and Y.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of the vectors X and Y.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ On entry, X contains the N-vector X.
+ On exit, X is overwritten.
+
+ INCX (input) INTEGER
+ The increment between successive elements of X. INCX > 0.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCY)
+ On entry, Y contains the N-vector Y.
+ On exit, Y is overwritten.
+
+ INCY (input) INTEGER
+ The increment between successive elements of Y. INCY > 0.
+
+ SSMIN (output) DOUBLE PRECISION
+ The smallest singular value of the N-by-2 matrix A = ( X Y ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param ssmin
+ */
+ public abstract void dlapll(int n, double[] x, int incx, double[] y, int incy, doubleW ssmin);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAPMT rearranges the columns of the M by N matrix X as specified
+ by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+ If FORWRD = .TRUE., forward permutation:
+
+ X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+
+ If FORWRD = .FALSE., backward permutation:
+
+ X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+
+ Arguments
+ =========
+
+ FORWRD (input) LOGICAL
+ = .TRUE., forward permutation
+ = .FALSE., backward permutation
+
+ M (input) INTEGER
+ The number of rows of the matrix X. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix X. N >= 0.
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,N)
+ On entry, the M by N matrix X.
+ On exit, X contains the permuted matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X, LDX >= MAX(1,M).
+
+ K (input/output) INTEGER array, dimension (N)
+ On entry, K contains the permutation vector. K is used as
+ internal workspace, but reset to its original value on
+ output.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param forwrd
+ * @param m
+ * @param n
+ * @param x
+ * @param ldx
+ * @param k
+ */
+ public abstract void dlapmt(boolean forwrd, int m, int n, double[] x, int ldx, int[] k);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+
+ overflow.
+
+ Arguments
+ =========
+
+ X (input) DOUBLE PRECISION
+ Y (input) DOUBLE PRECISION
+ X and Y specify the values x and y.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param x
+ * @param y
+ */
+ public double dlapy2(double x, double y) {
+ return org.netlib.lapack.Dlapy2.dlapy2(x, y);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+ unnecessary overflow.
+
+ Arguments
+ =========
+
+ X (input) DOUBLE PRECISION
+ Y (input) DOUBLE PRECISION
+ Z (input) DOUBLE PRECISION
+ X, Y and Z specify the values x, y and z.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param x
+ * @param y
+ * @param z
+ */
+ public double dlapy3(double x, double y, double z) {
+ return org.netlib.lapack.Dlapy3.dlapy3(x, y, z);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQGB equilibrates a general M by N band matrix A with KL
+ subdiagonals and KU superdiagonals using the row and scaling factors
+
+ in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, the equilibrated matrix, in the same storage format
+
+ as A. See EQUED for the form of the equilibrated matrix.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDA >= KL+KU+1.
+
+ R (input) DOUBLE PRECISION array, dimension (M)
+ The row scale factors for A.
+
+ C (input) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) DOUBLE PRECISION
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) DOUBLE PRECISION
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param equed
+ */
+ public abstract void dlaqgb(int m, int n, int kl, int ku, double[] ab, int ldab, double[] r, double[] c, double rowcnd, double colcnd, double amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQGE equilibrates a general M by N matrix A using the row and
+ column scaling factors in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M by N matrix A.
+ On exit, the equilibrated matrix. See EQUED for the form of
+
+ the equilibrated matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ R (input) DOUBLE PRECISION array, dimension (M)
+ The row scale factors for A.
+
+ C (input) DOUBLE PRECISION array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) DOUBLE PRECISION
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) DOUBLE PRECISION
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param equed
+ */
+ public abstract void dlaqge(int m, int n, double[] a, int lda, double[] r, double[] c, double rowcnd, double colcnd, double amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQP2 computes a QR factorization with column pivoting of
+ the block A(OFFSET+1:M,1:N).
+ The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ OFFSET (input) INTEGER
+ The number of rows of the matrix A that must be pivoted
+ but no factorized. OFFSET >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
+ the triangular factor obtained; the elements in block
+ A(OFFSET+1:M,1:N) below the diagonal, together with the
+ array TAU, represent the orthogonal matrix Q as a product of
+
+ elementary reflectors. Block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the exact column norms.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param offset
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param vn1
+ * @param vn2
+ * @param work
+ */
+ public abstract void dlaqp2(int m, int n, int offset, double[] a, int lda, int[] jpvt, double[] tau, double[] vn1, double[] vn2, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQPS computes a step of QR factorization with column pivoting
+ of a real M-by-N matrix A by using Blas-3. It tries to factorize
+ NB columns from A starting from the row OFFSET+1, and updates all
+ of the matrix with Blas-3 xGEMM.
+
+ In some cases, due to catastrophic cancellations, it cannot
+ factorize NB columns. Hence, the actual number of factorized
+ columns is returned in KB.
+
+ Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ OFFSET (input) INTEGER
+ The number of rows of A that have been factorized in
+ previous steps.
+
+ NB (input) INTEGER
+ The number of columns to factorize.
+
+ KB (output) INTEGER
+ The number of columns actually factorized.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, block A(OFFSET+1:M,1:KB) is the triangular
+ factor obtained and block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+ The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
+ been updated.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ JPVT(I) = K <==> Column K of the full matrix A has been
+ permuted into position I in AP.
+
+ TAU (output) DOUBLE PRECISION array, dimension (KB)
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) DOUBLE PRECISION array, dimension (N)
+ The vector with the exact column norms.
+
+ AUXV (input/output) DOUBLE PRECISION array, dimension (NB)
+ Auxiliar vector.
+
+ F (input/output) DOUBLE PRECISION array, dimension (LDF,NB)
+ Matrix F' = L*Y'*A.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1,N).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param offset
+ * @param nb
+ * @param kb
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param vn1
+ * @param vn2
+ * @param auxv
+ * @param f
+ * @param ldf
+ */
+ public abstract void dlaqps(int m, int n, int offset, int nb, intW kb, double[] a, int lda, int[] jpvt, double[] tau, double[] vn1, double[] vn2, double[] auxv, double[] f, int ldf);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQR0 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to DGEBAL, and then passed to DGEHRD when the
+
+ matrix output by DGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (IHI)
+ WI (output) DOUBLE PRECISION array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then DLAQR0 does a workspace query.
+ In this case, DLAQR0 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, DLAQR0 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . DLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public void dlaqr0(boolean wantt, boolean wantz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, int iloz, int ihiz, double[] z, int ldz, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dlaqr0.dlaqr0(wantt, wantz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, iloz, ihiz, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a
+ scalar multiple of the first column of the product
+
+ (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
+
+ scaling to avoid overflows and most underflows. It
+ is assumed that either
+
+ 1) sr1 = sr2 and si1 = -si2
+ or
+ 2) si1 = si2 = 0.
+
+ This is useful for starting double implicit shift bulges
+ in the QR algorithm.
+
+
+ N (input) integer
+ Order of the matrix H. N must be either 2 or 3.
+
+ H (input) DOUBLE PRECISION array of dimension (LDH,N)
+ The 2-by-2 or 3-by-3 matrix H in (*).
+
+ LDH (input) integer
+ The leading dimension of H as declared in
+ the calling procedure. LDH.GE.N
+
+ SR1 (input) DOUBLE PRECISION
+ SI1 The shifts in (*).
+ SR2
+ SI2
+
+ V (output) DOUBLE PRECISION array of dimension N
+ A scalar multiple of the first column of the
+ matrix K in (*).
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param h
+ * @param ldh
+ * @param sr1
+ * @param si1
+ * @param sr2
+ * @param si2
+ * @param v
+ */
+ public void dlaqr1(int n, double[] h, int ldh, double sr1, double si1, double sr2, double si2, double[] v) {
+ org.netlib.lapack.Dlaqr1.dlaqr1(n, h, 0, ldh, sr1, si1, sr2, si2, v, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ This subroutine is identical to DLAQR3 except that it avoids
+ recursion by calling DLAHQR instead of DLAQR4.
+
+
+ ******************************************************************
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+ ******************************************************************
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) DOUBLE PRECISION array, dimension KBOT
+ SI (output) DOUBLE PRECISION array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) DOUBLE PRECISION array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) DOUBLE PRECISION array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) DOUBLE PRECISION array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) DOUBLE PRECISION array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; DLAQR2
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ktop
+ * @param kbot
+ * @param nw
+ * @param h
+ * @param ldh
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param ns
+ * @param nd
+ * @param sr
+ * @param si
+ * @param v
+ * @param ldv
+ * @param nh
+ * @param t
+ * @param ldt
+ * @param nv
+ * @param wv
+ * @param ldwv
+ * @param work
+ * @param lwork
+ */
+ public void dlaqr2(boolean wantt, boolean wantz, int n, int ktop, int kbot, int nw, double[] h, int ldh, int iloz, int ihiz, double[] z, int ldz, intW ns, intW nd, double[] sr, double[] si, double[] v, int ldv, int nh, double[] t, int ldt, int nv, double[] wv, int ldwv, double[] work, int lwork) {
+ org.netlib.lapack.Dlaqr2.dlaqr2(wantt, wantz, n, ktop, kbot, nw, h, 0, ldh, iloz, ihiz, z, 0, ldz, ns, nd, sr, 0, si, 0, v, 0, ldv, nh, t, 0, ldt, nv, wv, 0, ldwv, work, 0, lwork);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ ******************************************************************
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+ ******************************************************************
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) DOUBLE PRECISION array, dimension KBOT
+ SI (output) DOUBLE PRECISION array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) DOUBLE PRECISION array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) DOUBLE PRECISION array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) DOUBLE PRECISION array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) DOUBLE PRECISION array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; DLAQR3
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ==================================================================
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ktop
+ * @param kbot
+ * @param nw
+ * @param h
+ * @param ldh
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param ns
+ * @param nd
+ * @param sr
+ * @param si
+ * @param v
+ * @param ldv
+ * @param nh
+ * @param t
+ * @param ldt
+ * @param nv
+ * @param wv
+ * @param ldwv
+ * @param work
+ * @param lwork
+ */
+ public void dlaqr3(boolean wantt, boolean wantz, int n, int ktop, int kbot, int nw, double[] h, int ldh, int iloz, int ihiz, double[] z, int ldz, intW ns, intW nd, double[] sr, double[] si, double[] v, int ldv, int nh, double[] t, int ldt, int nv, double[] wv, int ldwv, double[] work, int lwork) {
+ org.netlib.lapack.Dlaqr3.dlaqr3(wantt, wantz, n, ktop, kbot, nw, h, 0, ldh, iloz, ihiz, z, 0, ldz, ns, nd, sr, 0, si, 0, v, 0, ldv, nh, t, 0, ldt, nv, wv, 0, ldwv, work, 0, lwork);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ This subroutine implements one level of recursion for DLAQR0.
+ It is a complete implementation of the small bulge multi-shift
+ QR algorithm. It may be called by DLAQR0 and, for large enough
+ deflation window size, it may be called by DLAQR3. This
+ subroutine is identical to DLAQR0 except that it calls DLAQR2
+ instead of DLAQR3.
+
+ Purpose
+ =======
+
+ DLAQR4 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to DGEBAL, and then passed to DGEHRD when the
+
+ matrix output by DGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (IHI)
+ WI (output) DOUBLE PRECISION array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then DLAQR4 does a workspace query.
+ In this case, DLAQR4 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, DLAQR4 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . DLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public void dlaqr4(boolean wantt, boolean wantz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, int iloz, int ihiz, double[] z, int ldz, double[] work, int lwork, intW info) {
+ org.netlib.lapack.Dlaqr4.dlaqr4(wantt, wantz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, iloz, ihiz, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ This auxiliary subroutine called by DLAQR0 performs a
+ single small-bulge multi-shift QR sweep.
+
+ WANTT (input) logical scalar
+ WANTT = .true. if the quasi-triangular Schur factor
+ is being computed. WANTT is set to .false. otherwise.
+
+ WANTZ (input) logical scalar
+ WANTZ = .true. if the orthogonal Schur factor is being
+ computed. WANTZ is set to .false. otherwise.
+
+ KACC22 (input) integer with value 0, 1, or 2.
+ Specifies the computation mode of far-from-diagonal
+ orthogonal updates.
+ = 0: DLAQR5 does not accumulate reflections and does not
+ use matrix-matrix multiply to update far-from-diagonal
+ matrix entries.
+ = 1: DLAQR5 accumulates reflections and uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries.
+ = 2: DLAQR5 accumulates reflections, uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries,
+ and takes advantage of 2-by-2 block structure during
+ matrix multiplies.
+
+ N (input) integer scalar
+ N is the order of the Hessenberg matrix H upon which this
+
+ subroutine operates.
+
+ KTOP (input) integer scalar
+ KBOT (input) integer scalar
+ These are the first and last rows and columns of an
+ isolated diagonal block upon which the QR sweep is to be
+ applied. It is assumed without a check that
+ either KTOP = 1 or H(KTOP,KTOP-1) = 0
+ and
+ either KBOT = N or H(KBOT+1,KBOT) = 0.
+
+ NSHFTS (input) integer scalar
+ NSHFTS gives the number of simultaneous shifts. NSHFTS
+ must be positive and even.
+
+ SR (input) DOUBLE PRECISION array of size (NSHFTS)
+ SI (input) DOUBLE PRECISION array of size (NSHFTS)
+ SR contains the real parts and SI contains the imaginary
+ parts of the NSHFTS shifts of origin that define the
+ multi-shift QR sweep.
+
+ H (input/output) DOUBLE PRECISION array of size (LDH,N)
+ On input H contains a Hessenberg matrix. On output a
+ multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
+
+ to the isolated diagonal block in rows and columns KTOP
+ through KBOT.
+
+ LDH (input) integer scalar
+ LDH is the leading dimension of H just as declared in the
+
+ calling procedure. LDH.GE.MAX(1,N).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
+
+ Z (input/output) DOUBLE PRECISION array of size (LDZ,IHI)
+ If WANTZ = .TRUE., then the QR Sweep orthogonal
+ similarity transformation is accumulated into
+ Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ = .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer scalar
+ LDA is the leading dimension of Z just as declared in
+ the calling procedure. LDZ.GE.N.
+
+ V (workspace) DOUBLE PRECISION array of size (LDV,NSHFTS/2)
+
+
+ LDV (input) integer scalar
+ LDV is the leading dimension of V as declared in the
+ calling procedure. LDV.GE.3.
+
+ U (workspace) DOUBLE PRECISION array of size
+ (LDU,3*NSHFTS-3)
+
+ LDU (input) integer scalar
+ LDU is the leading dimension of U just as declared in the
+
+ in the calling subroutine. LDU.GE.3*NSHFTS-3.
+
+ NH (input) integer scalar
+ NH is the number of columns in array WH available for
+ workspace. NH.GE.1.
+
+ WH (workspace) DOUBLE PRECISION array of size (LDWH,NH)
+
+ LDWH (input) integer scalar
+ Leading dimension of WH just as declared in the
+ calling procedure. LDWH.GE.3*NSHFTS-3.
+
+ NV (input) integer scalar
+ NV is the number of rows in WV agailable for workspace.
+ NV.GE.1.
+
+ WV (workspace) DOUBLE PRECISION array of size
+ (LDWV,3*NSHFTS-3)
+
+ LDWV (input) integer scalar
+ LDWV is the leading dimension of WV as declared in the
+ in the calling subroutine. LDWV.GE.NV.
+
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ============================================================
+ Reference:
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and
+ Level 3 Performance, SIAM Journal of Matrix Analysis,
+ volume 23, pages 929--947, 2002.
+
+ ============================================================
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param kacc22
+ * @param n
+ * @param ktop
+ * @param kbot
+ * @param nshfts
+ * @param sr
+ * @param si
+ * @param h
+ * @param ldh
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param v
+ * @param ldv
+ * @param u
+ * @param ldu
+ * @param nv
+ * @param wv
+ * @param ldwv
+ * @param nh
+ * @param wh
+ * @param ldwh
+ */
+ public void dlaqr5(boolean wantt, boolean wantz, int kacc22, int n, int ktop, int kbot, int nshfts, double[] sr, double[] si, double[] h, int ldh, int iloz, int ihiz, double[] z, int ldz, double[] v, int ldv, double[] u, int ldu, int nv, double[] wv, int ldwv, int nh, double[] wh, int ldwh) {
+ org.netlib.lapack.Dlaqr5.dlaqr5(wantt, wantz, kacc22, n, ktop, kbot, nshfts, sr, 0, si, 0, h, 0, ldh, iloz, ihiz, z, 0, ldz, v, 0, ldv, u, 0, ldu, nv, wv, 0, ldwv, nh, wh, 0, ldwh);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQSB equilibrates a symmetric band matrix A using the scaling
+ factors in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ S (input) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) DOUBLE PRECISION
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param s
+ * @param scond
+ * @param amax
+ * @param equed
+ */
+ public abstract void dlaqsb(String uplo, int n, int kd, double[] ab, int ldab, double[] s, double scond, double amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQSP equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the equilibrated matrix: diag(S) * A * diag(S), in
+
+ the same storage format as A.
+
+ S (input) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) DOUBLE PRECISION
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param s
+ * @param scond
+ * @param amax
+ * @param equed
+ */
+ public abstract void dlaqsp(String uplo, int n, double[] ap, double[] s, double scond, double amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQSY equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if EQUED = 'Y', the equilibrated matrix:
+ diag(S) * A * diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ S (input) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) DOUBLE PRECISION
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) DOUBLE PRECISION
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param scond
+ * @param amax
+ * @param equed
+ */
+ public abstract void dlaqsy(String uplo, int n, double[] a, int lda, double[] s, double scond, double amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAQTR solves the real quasi-triangular system
+
+ op(T)*p = scale*c, if LREAL = .TRUE.
+
+ or the complex quasi-triangular systems
+
+ op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
+
+ in real arithmetic, where T is upper quasi-triangular.
+ If LREAL = .FALSE., then the first diagonal block of T must be
+ 1 by 1, B is the specially structured matrix
+
+ B = [ b(1) b(2) ... b(n) ]
+ [ w ]
+ [ w ]
+ [ . ]
+ [ w ]
+
+ op(A) = A or A', A' denotes the conjugate transpose of
+ matrix A.
+
+ On input, X = [ c ]. On output, X = [ p ].
+ [ d ] [ q ]
+
+ This subroutine is designed for the condition number estimation
+ in routine DTRSNA.
+
+ Arguments
+ =========
+
+ LTRAN (input) LOGICAL
+ On entry, LTRAN specifies the option of conjugate transpose:
+
+ = .FALSE., op(T+i*B) = T+i*B,
+ = .TRUE., op(T+i*B) = (T+i*B)'.
+
+ LREAL (input) LOGICAL
+ On entry, LREAL specifies the input matrix structure:
+ = .FALSE., the input is complex
+ = .TRUE., the input is real
+
+ N (input) INTEGER
+ On entry, N specifies the order of T+i*B. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, T contains a matrix in Schur canonical form.
+ If LREAL = .FALSE., then the first diagonal block of T mu
+ be 1 by 1.
+
+ LDT (input) INTEGER
+ The leading dimension of the matrix T. LDT >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (N)
+ On entry, B contains the elements to form the matrix
+ B as described above.
+ If LREAL = .TRUE., B is not referenced.
+
+ W (input) DOUBLE PRECISION
+ On entry, W is the diagonal element of the matrix B.
+ If LREAL = .TRUE., W is not referenced.
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, SCALE is the scale factor.
+
+ X (input/output) DOUBLE PRECISION array, dimension (2*N)
+ On entry, X contains the right hand side of the system.
+ On exit, X is overwritten by the solution.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: the some diagonal 1 by 1 block has been perturbed by
+
+ a small number SMIN to keep nonsingularity.
+ 2: the some diagonal 2 by 2 block has been perturbed by
+
+ a small number in DLALN2 to keep nonsingularity.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param ltran
+ * @param lreal
+ * @param n
+ * @param t
+ * @param ldt
+ * @param b
+ * @param w
+ * @param scale
+ * @param x
+ * @param work
+ * @param info
+ */
+ public abstract void dlaqtr(boolean ltran, boolean lreal, int n, double[] t, int ldt, double[] b, double w, doubleW scale, double[] x, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAR1V computes the (scaled) r-th column of the inverse of
+ the sumbmatrix in rows B1 through BN of the tridiagonal matrix
+ L D L^T - sigma I. When sigma is close to an eigenvalue, the
+ computed vector is an accurate eigenvector. Usually, r corresponds
+ to the index where the eigenvector is largest in magnitude.
+ The following steps accomplish this computation :
+ (a) Stationary qd transform, L D L^T - sigma I = L(+) D(+) L(+)^T,
+ (b) Progressive qd transform, L D L^T - sigma I = U(-) D(-) U(-)^T,
+ (c) Computation of the diagonal elements of the inverse of
+ L D L^T - sigma I by combining the above transforms, and choosing
+ r as the index where the diagonal of the inverse is (one of the)
+
+ largest in magnitude.
+ (d) Computation of the (scaled) r-th column of the inverse using the
+
+ twisted factorization obtained by combining the top part of the
+ the stationary and the bottom part of the progressive transform.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix L D L^T.
+
+ B1 (input) INTEGER
+ First index of the submatrix of L D L^T.
+
+ BN (input) INTEGER
+ Last index of the submatrix of L D L^T.
+
+ LAMBDA (input) DOUBLE PRECISION
+ The shift. In order to compute an accurate eigenvector,
+ LAMBDA should be a good approximation to an eigenvalue
+ of L D L^T.
+
+ L (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal matrix
+ L, in elements 1 to N-1.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D.
+
+ LD (input) DOUBLE PRECISION array, dimension (N-1)
+ The n-1 elements L(i)*D(i).
+
+ LLD (input) DOUBLE PRECISION array, dimension (N-1)
+ The n-1 elements L(i)*L(i)*D(i).
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence.
+
+ GAPTOL (input) DOUBLE PRECISION
+ Tolerance that indicates when eigenvector entries are neglig
+ w.r.t. their contribution to the residual.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, all entries of Z must be set to 0.
+ On output, Z contains the (scaled) r-th column of the
+ inverse. The scaling is such that Z(R) equals 1.
+
+ WANTNC (input) LOGICAL
+ Specifies whether NEGCNT has to be computed.
+
+ NEGCNT (output) INTEGER
+ If WANTNC is .TRUE. then NEGCNT = the number of pivots < piv
+ in the matrix factorization L D L^T, and NEGCNT = -1 otherw
+
+ ZTZ (output) DOUBLE PRECISION
+ The square of the 2-norm of Z.
+
+ MINGMA (output) DOUBLE PRECISION
+ The reciprocal of the largest (in magnitude) diagonal
+ element of the inverse of L D L^T - sigma I.
+
+ R (input/output) INTEGER
+ The twist index for the twisted factorization used to
+ compute Z.
+ On input, 0 <= R <= N. If R is input as 0, R is set to
+ the index where (L D L^T - sigma I)^{-1} is largest
+ in magnitude. If 1 <= R <= N, R is unchanged.
+ On output, R contains the twist index used to compute Z.
+ Ideally, R designates the position of the maximum entry in t
+ eigenvector.
+
+ ISUPPZ (output) INTEGER array, dimension (2)
+ The support of the vector in Z, i.e., the vector Z is
+ nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
+
+ NRMINV (output) DOUBLE PRECISION
+ NRMINV = 1/SQRT( ZTZ )
+
+ RESID (output) DOUBLE PRECISION
+ The residual of the FP vector.
+ RESID = ABS( MINGMA )/SQRT( ZTZ )
+
+ RQCORR (output) DOUBLE PRECISION
+ The Rayleigh Quotient correction to LAMBDA.
+ RQCORR = MINGMA*TMP
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param b1
+ * @param bn
+ * @param lambda
+ * @param d
+ * @param l
+ * @param ld
+ * @param lld
+ * @param pivmin
+ * @param gaptol
+ * @param z
+ * @param wantnc
+ * @param negcnt
+ * @param ztz
+ * @param mingma
+ * @param r
+ * @param isuppz
+ * @param nrminv
+ * @param resid
+ * @param rqcorr
+ * @param work
+ */
+ public void dlar1v(int n, int b1, int bn, double lambda, double[] d, double[] l, double[] ld, double[] lld, double pivmin, double gaptol, double[] z, boolean wantnc, intW negcnt, doubleW ztz, doubleW mingma, intW r, int[] isuppz, doubleW nrminv, doubleW resid, doubleW rqcorr, double[] work) {
+ org.netlib.lapack.Dlar1v.dlar1v(n, b1, bn, lambda, d, 0, l, 0, ld, 0, lld, 0, pivmin, gaptol, z, 0, wantnc, negcnt, ztz, mingma, r, isuppz, 0, nrminv, resid, rqcorr, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAR2V applies a vector of real plane rotations from both sides to
+ a sequence of 2-by-2 real symmetric matrices, defined by the elements
+ of the vectors x, y and z. For i = 1,2,...,n
+
+ ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) )
+ ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector y.
+
+ Z (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector z.
+
+ INCX (input) INTEGER
+ The increment between elements of X, Y and Z. INCX > 0.
+
+ C (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param x
+ * @param y
+ * @param z
+ * @param incx
+ * @param c
+ * @param s
+ * @param incc
+ */
+ public abstract void dlar2v(int n, double[] x, double[] y, double[] z, int incx, double[] c, double[] s, int incc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARF applies a real elementary reflector H to a real m by n matrix
+ C, from either the left or the right. H is represented in the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of H. V is not used if
+ TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param v
+ * @param incv
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ */
+ public abstract void dlarf(String side, int m, int n, double[] v, int incv, double tau, double[] c, int Ldc, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARFB applies a real block reflector H or its transpose H' to a
+ real m by n matrix C, from either the left or the right.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'T': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ V (input) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,M) if STOREV = 'R' and SIDE = 'L'
+
+ (LDV,N) if STOREV = 'R' and SIDE = 'R'
+
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+ if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+ if STOREV = 'R', LDV >= K.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,K)
+ The triangular k by k matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param direct
+ * @param storev
+ * @param m
+ * @param n
+ * @param k
+ * @param v
+ * @param ldv
+ * @param t
+ * @param ldt
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param ldwork
+ */
+ public abstract void dlarfb(String side, String trans, String direct, String storev, int m, int n, int k, double[] v, int ldv, double[] t, int ldt, double[] c, int Ldc, double[] work, int ldwork);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARFG generates a real elementary reflector H of order n, such
+ that
+
+ H * ( alpha ) = ( beta ), H' * H = I.
+ ( x ) ( 0 )
+
+ where alpha and beta are scalars, and x is an (n-1)-element real
+ vector. H is represented in the form
+
+ H = I - tau * ( 1 ) * ( 1 v' ) ,
+ ( v )
+
+ where tau is a real scalar and v is a real (n-1)-element
+ vector.
+
+ If the elements of x are all zero, then tau = 0 and H is taken to be
+
+ the unit matrix.
+
+ Otherwise 1 <= tau <= 2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the elementary reflector.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ On entry, the value alpha.
+ On exit, it is overwritten with the value beta.
+
+ X (input/output) DOUBLE PRECISION array, dimension
+ (1+(N-2)*abs(INCX))
+ On entry, the vector x.
+ On exit, it is overwritten with the vector v.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ TAU (output) DOUBLE PRECISION
+ The value tau.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param tau
+ */
+ public abstract void dlarfg(int n, doubleW alpha, double[] x, int incx, doubleW tau);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ 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'
+
+ 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 * V
+
+ Arguments
+ =========
+
+ DIRECT (input) 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)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ 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 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param direct
+ * @param storev
+ * @param n
+ * @param k
+ * @param v
+ * @param ldv
+ * @param tau
+ * @param t
+ * @param ldt
+ */
+ public abstract void dlarft(String direct, String storev, int n, int k, double[] v, int ldv, double[] tau, double[] t, int ldt);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARFX applies a real elementary reflector H to a real m by n
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix
+
+ This version uses inline code if H has order < 11.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
+ or (N) if SIDE = 'R'
+ The vector v in the representation of H.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= (1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+ WORK is not referenced if H has order < 11.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param v
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ */
+ public abstract void dlarfx(String side, int m, int n, double[] v, double tau, double[] c, int Ldc, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARGV generates a vector of real plane rotations, determined by
+ elements of the real vectors x and y. For i = 1,2,...,n
+
+ ( c(i) s(i) ) ( x(i) ) = ( a(i) )
+ ( -s(i) c(i) ) ( y(i) ) = ( 0 )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be generated.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ On entry, the vector x.
+ On exit, x(i) is overwritten by a(i), for i = 1,...,n.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCY)
+ On entry, the vector y.
+ On exit, the sines of the plane rotations.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (output) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C. INCC > 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param c
+ * @param incc
+ */
+ public abstract void dlargv(int n, double[] x, int incx, double[] y, int incy, double[] c, int incc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARNV returns a vector of n random real numbers from a uniform or
+ normal distribution.
+
+ Arguments
+ =========
+
+ IDIST (input) INTEGER
+ Specifies the distribution of the random numbers:
+ = 1: uniform (0,1)
+ = 2: uniform (-1,1)
+ = 3: normal (0,1)
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated.
+
+ X (output) DOUBLE PRECISION array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine calls the auxiliary routine DLARUV to generate random
+ real numbers from a uniform (0,1) distribution, in batches of up to
+ 128 using vectorisable code. The Box-Muller method is used to
+ transform numbers from a uniform to a normal distribution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param idist
+ * @param iseed
+ * @param n
+ * @param x
+ */
+ public abstract void dlarnv(int idist, int[] iseed, int n, double[] x);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Compute the splitting points with threshold SPLTOL.
+ DLARRA sets any "small" off-diagonal elements to zero.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
+ are set to zero, the other entries of E are untouched.
+
+ E2 (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ SPLTOL (input) DOUBLE PRECISION
+ The threshold for splitting. Two criteria can be used:
+ SPLTOL<0 : criterion based on absolute off-diagonal value
+ SPLTOL>0 : criterion that preserves relative accuracy
+
+ TNRM (input) DOUBLE PRECISION
+ The norm of the matrix.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param e2
+ * @param spltol
+ * @param tnrm
+ * @param nsplit
+ * @param isplit
+ * @param info
+ */
+ public void dlarra(int n, double[] d, double[] e, double[] e2, double spltol, double tnrm, intW nsplit, int[] isplit, intW info) {
+ org.netlib.lapack.Dlarra.dlarra(n, d, 0, e, 0, e2, 0, spltol, tnrm, nsplit, isplit, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the relatively robust representation(RRR) L D L^T, DLARRB
+ does "limited" bisection to refine the eigenvalues of L D L^T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses and their gaps are input in WERR
+ and WGAP, respectively. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL1 (input) DOUBLE PRECISION
+ RTOL2 (input) DOUBLE PRECISION
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+ where GAP is the (estimated) distance to the nearest
+ eigenvalue.
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFS
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WGAP (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On input, the (estimated) gaps between consecutive
+ eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap betwe
+ eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST
+ then WGAP(IFIRST-OFFSET) must be set to ZERO.
+ On output, these gaps are refined.
+
+ WERR (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of the matrix.
+
+ TWIST (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+ TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L
+ TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U
+ TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param lld
+ * @param ifirst
+ * @param ilast
+ * @param rtol1
+ * @param rtol2
+ * @param offset
+ * @param w
+ * @param wgap
+ * @param werr
+ * @param work
+ * @param iwork
+ * @param pivmin
+ * @param spdiam
+ * @param twist
+ * @param info
+ */
+ public void dlarrb(int n, double[] d, double[] lld, int ifirst, int ilast, double rtol1, double rtol2, int offset, double[] w, double[] wgap, double[] werr, double[] work, int[] iwork, double pivmin, double spdiam, int twist, intW info) {
+ org.netlib.lapack.Dlarrb.dlarrb(n, d, 0, lld, 0, ifirst, ilast, rtol1, rtol2, offset, w, 0, wgap, 0, werr, 0, work, 0, iwork, 0, pivmin, spdiam, twist, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Find the number of eigenvalues of the symmetric tridiagonal matrix T
+
+ that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
+ if JOBT = 'L'.
+
+ Arguments
+ =========
+
+ JOBT (input) CHARACTER*1
+ = 'T': Compute Sturm count for matrix T.
+ = 'L': Compute Sturm count for matrix L D L^T.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ The lower and upper bounds for the eigenvalues.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N diagonal elements of the tridiagonal matrix
+ JOBT = 'L': The N diagonal elements of the diagonal matrix D.
+
+ E (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
+ JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ EIGCNT (output) INTEGER
+ The number of eigenvalues of the symmetric tridiagonal matrix
+ that are in the interval (VL,VU]
+
+ LCNT (output) INTEGER
+ RCNT (output) INTEGER
+ The left and right negcounts of the interval.
+
+ INFO (output) INTEGER
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobt
+ * @param n
+ * @param vl
+ * @param vu
+ * @param d
+ * @param e
+ * @param pivmin
+ * @param eigcnt
+ * @param lcnt
+ * @param rcnt
+ * @param info
+ */
+ public void dlarrc(String jobt, int n, double vl, double vu, double[] d, double[] e, double pivmin, intW eigcnt, intW lcnt, intW rcnt, intW info) {
+ org.netlib.lapack.Dlarrc.dlarrc(jobt, n, vl, vu, d, 0, e, 0, pivmin, eigcnt, lcnt, rcnt, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARRD computes the eigenvalues of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from DSTEMR.
+ The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ GERS (input) DOUBLE PRECISION array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ RELTOL (input) DOUBLE PRECISION
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ E2 (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ NSPLIT (input) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalue approximations. DLARRD computes an interval
+ I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
+ approximation is given as the interval midpoint
+ W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
+ WERR(j) = abs( a_j - b_j)/2
+
+ WERR (output) DOUBLE PRECISION array, dimension (N)
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ WL (output) DOUBLE PRECISION
+ WU (output) DOUBLE PRECISION
+ The interval (WL, WU] contains all the wanted eigenvalues.
+ If RANGE='V', then WL=VL and WU=VU.
+ If RANGE='A', then WL and WU are the global Gerschgorin bound
+ on the spectrum.
+ If RANGE='I', then WL and WU are computed by DLAEBZ from the
+
+ index range specified.
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (DLARRD may use the remaining N-M elements as
+ workspace.)
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
+ i-th eigenvalue W(i) is the j-th eigenvalue in block k.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ FUDGE DOUBLE PRECISION, default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ Based on contributions by
+ W. Kahan, University of California, Berkeley, USA
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param range
+ * @param order
+ * @param n
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param gers
+ * @param reltol
+ * @param d
+ * @param e
+ * @param e2
+ * @param pivmin
+ * @param nsplit
+ * @param isplit
+ * @param m
+ * @param w
+ * @param werr
+ * @param wl
+ * @param wu
+ * @param iblock
+ * @param indexw
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public void dlarrd(String range, String order, int n, double vl, double vu, int il, int iu, double[] gers, double reltol, double[] d, double[] e, double[] e2, double pivmin, int nsplit, int[] isplit, intW m, double[] w, double[] werr, doubleW wl, doubleW wu, int[] iblock, int[] indexw, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlarrd.dlarrd(range, order, n, vl, vu, il, iu, gers, 0, reltol, d, 0, e, 0, e2, 0, pivmin, nsplit, isplit, 0, m, w, 0, werr, 0, wl, wu, iblock, 0, indexw, 0, work, 0, iwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ To find the desired eigenvalues of a given real symmetric
+ tridiagonal matrix T, DLARRE sets any "small" off-diagonal
+ elements to zero, and for each unreduced block T_i, it finds
+ (a) a suitable shift at one end of the block's spectrum,
+ (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
+ (c) eigenvalues of each L_i D_i L_i^T.
+ The representations and eigenvalues found are then used by
+ DSTEMR to compute the eigenvectors of T.
+ The accuracy varies depending on whether bisection is used to
+ find a few eigenvalues or the dqds algorithm (subroutine DLASQ2) to
+ conpute all and then discard any unwanted one.
+ As an added benefit, DLARRE also outputs the n
+ Gerschgorin intervals for the matrices L_i D_i L_i^T.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input/output) DOUBLE PRECISION
+ VU (input/output) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds for the eigenvalues.
+ Eigenvalues less than or equal to VL, or greater than VU,
+ will not be returned. VL < VU.
+ If RANGE='I' or ='A', DLARRE computes bounds on the desired
+ part of the spectrum.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+ On exit, the N diagonal elements of the diagonal
+ matrices D_i.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, E contains the subdiagonal elements of the unit
+ bidiagonal matrices L_i. The entries E( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, contain the base points sigma_i on output.
+
+
+ E2 (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ RTOL1 (input) DOUBLE PRECISION
+ RTOL2 (input) DOUBLE PRECISION
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ SPLTOL (input) DOUBLE PRECISION
+ The threshold for splitting.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+ M (output) INTEGER
+ The total number of eigenvalues (of all L_i D_i L_i^T)
+ found.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the eigenvalues. The
+ eigenvalues of each of the blocks, L_i D_i L_i^T, are
+ sorted in ascending order ( DLARRE may use the
+ remaining N-M elements as workspace).
+
+ WERR (output) DOUBLE PRECISION array, dimension (N)
+ The error bound on the corresponding eigenvalue in W.
+
+ WGAP (output) DOUBLE PRECISION array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+ The gap is only with respect to the eigenvalues of the same b
+ as each block has its own representation tree.
+ Exception: at the right end of a block we store the left gap
+
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in block 2
+
+ GERS (output) DOUBLE PRECISION array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ PIVMIN (output) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (6*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: A problem occured in DLARRE.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in DLARRD.
+ = 2: No base representation could be found in MAXTRY iterati
+ Increasing MAXTRY and recompilation might be a remedy.
+
+ =-3: Problem in DLARRB when computing the refined root
+ representation for DLASQ2.
+ =-4: Problem in DLARRB when preforming bisection on the
+ desired part of the spectrum.
+ =-5: Problem in DLASQ2.
+ =-6: Problem in DLASQ2.
+
+ Further Details
+ The base representations are required to suffer very little
+ element growth and consequently define all their eigenvalues to
+ high relative accuracy.
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param range
+ * @param n
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param d
+ * @param e
+ * @param e2
+ * @param rtol1
+ * @param rtol2
+ * @param spltol
+ * @param nsplit
+ * @param isplit
+ * @param m
+ * @param w
+ * @param werr
+ * @param wgap
+ * @param iblock
+ * @param indexw
+ * @param gers
+ * @param pivmin
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public void dlarre(String range, int n, doubleW vl, doubleW vu, int il, int iu, double[] d, double[] e, double[] e2, double rtol1, double rtol2, double spltol, intW nsplit, int[] isplit, intW m, double[] w, double[] werr, double[] wgap, int[] iblock, int[] indexw, double[] gers, doubleW pivmin, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlarre.dlarre(range, n, vl, vu, il, iu, d, 0, e, 0, e2, 0, rtol1, rtol2, spltol, nsplit, isplit, 0, m, w, 0, werr, 0, wgap, 0, iblock, 0, indexw, 0, gers, 0, pivmin, work, 0, iwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial representation L D L^T and its cluster of close
+ eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
+
+ W( CLEND ), DLARRF finds a new relatively robust representation
+ L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
+ eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix (subblock, if the matrix splitted).
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ L (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) subdiagonal elements of the unit bidiagonal
+ matrix L.
+
+ LD (input) DOUBLE PRECISION array, dimension (N-1)
+ The (N-1) elements L(i)*D(i).
+
+ CLSTRT (input) INTEGER
+ The index of the first eigenvalue in the cluster.
+
+ CLEND (input) INTEGER
+ The index of the last eigenvalue in the cluster.
+
+ W (input) DOUBLE PRECISION array, dimension >= (CLEND-CLSTRT+1
+ The eigenvalue APPROXIMATIONS of L D L^T in ascending order.
+
+ W( CLSTRT ) through W( CLEND ) form the cluster of relatively
+ close eigenalues.
+
+ WGAP (input/output) DOUBLE PRECISION array, dimension >= (CLEND-C
+ The separation from the right neighbor eigenvalue in W.
+
+ WERR (input) DOUBLE PRECISION array, dimension >= (CLEND-CLSTRT+1
+ WERR contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue APPROXIMATION in W
+
+ SPDIAM (input) estimate of the spectral diameter obtained from the
+ Gerschgorin intervals
+
+ CLGAPL, CLGAPR (input) absolute gap on each end of the cluster.
+ Set by the calling routine to protect against shifts too clos
+ to eigenvalues outside the cluster.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ SIGMA (output) DOUBLE PRECISION
+ The shift used to form L(+) D(+) L(+)^T.
+
+ DPLUS (output) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the diagonal matrix D(+).
+
+ LPLUS (output) DOUBLE PRECISION array, dimension (N-1)
+ The first (N-1) elements of LPLUS contain the subdiagonal
+ elements of the unit bidiagonal matrix L(+).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ Workspace.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param l
+ * @param ld
+ * @param clstrt
+ * @param clend
+ * @param w
+ * @param wgap
+ * @param werr
+ * @param spdiam
+ * @param clgapl
+ * @param clgapr
+ * @param pivmin
+ * @param sigma
+ * @param dplus
+ * @param lplus
+ * @param work
+ * @param info
+ */
+ public void dlarrf(int n, double[] d, double[] l, double[] ld, int clstrt, int clend, double[] w, double[] wgap, double[] werr, double spdiam, double clgapl, double clgapr, double pivmin, doubleW sigma, double[] dplus, double[] lplus, double[] work, intW info) {
+ org.netlib.lapack.Dlarrf.dlarrf(n, d, 0, l, 0, ld, 0, clstrt, clend, w, 0, wgap, 0, werr, 0, spdiam, clgapl, clgapr, pivmin, sigma, dplus, 0, lplus, 0, work, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial eigenvalue approximations of T, DLARRJ
+ does bisection to refine the eigenvalues of T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses in WERR. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of T.
+
+ E2 (input) DOUBLE PRECISION array, dimension (N-1)
+ The Squares of the (N-1) subdiagonal elements of T.
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL (input) DOUBLE PRECISION
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WERR (input/output) DOUBLE PRECISION array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of T.
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e2
+ * @param ifirst
+ * @param ilast
+ * @param rtol
+ * @param offset
+ * @param w
+ * @param werr
+ * @param work
+ * @param iwork
+ * @param pivmin
+ * @param spdiam
+ * @param info
+ */
+ public void dlarrj(int n, double[] d, double[] e2, int ifirst, int ilast, double rtol, int offset, double[] w, double[] werr, double[] work, int[] iwork, double pivmin, double spdiam, intW info) {
+ org.netlib.lapack.Dlarrj.dlarrj(n, d, 0, e2, 0, ifirst, ilast, rtol, offset, w, 0, werr, 0, work, 0, iwork, 0, pivmin, spdiam, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARRK computes one eigenvalue of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from DSTEMR.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ IW (input) INTEGER
+ The index of the eigenvalues to be returned.
+
+ GL (input) DOUBLE PRECISION
+ GU (input) DOUBLE PRECISION
+ An upper and a lower bound on the eigenvalue.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E2 (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ RELTOL (input) DOUBLE PRECISION
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ W (output) DOUBLE PRECISION
+
+ WERR (output) DOUBLE PRECISION
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ INFO (output) INTEGER
+ = 0: Eigenvalue converged
+ = -1: Eigenvalue did NOT converge
+
+ Internal Parameters
+ ===================
+
+ FUDGE DOUBLE PRECISION, default = 2
+ A "fudge factor" to widen the Gershgorin intervals.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param iw
+ * @param gl
+ * @param gu
+ * @param d
+ * @param e2
+ * @param pivmin
+ * @param reltol
+ * @param w
+ * @param werr
+ * @param info
+ */
+ public void dlarrk(int n, int iw, double gl, double gu, double[] d, double[] e2, double pivmin, double reltol, doubleW w, doubleW werr, intW info) {
+ org.netlib.lapack.Dlarrk.dlarrk(n, iw, gl, gu, d, 0, e2, 0, pivmin, reltol, w, werr, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ Perform tests to decide whether the symmetric tridiagonal matrix T
+ warrants expensive computations which guarantee high relative accurac
+ in the eigenvalues.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The N diagonal elements of the tridiagonal matrix T.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) is set to ZERO.
+
+ INFO (output) INTEGER
+ INFO = 0(default) : the matrix warrants computations preservi
+ relative accuracy.
+ INFO = 1 : the matrix warrants computations guarante
+ only absolute accuracy.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param info
+ */
+ public void dlarrr(int n, double[] d, double[] e, intW info) {
+ org.netlib.lapack.Dlarrr.dlarrr(n, d, 0, e, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARRV computes the eigenvectors of the tridiagonal matrix
+ T = L D L^T given L, D and APPROXIMATIONS to the eigenvalues of L D L
+ The input eigenvalues should have been computed by DLARRE.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ Lower and upper bounds of the interval that contains the desi
+ eigenvalues. VL < VU. Needed to compute gaps on the left or r
+ end of the extremal eigenvalues in the desired RANGE.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the diagonal matrix D.
+ On exit, D may be overwritten.
+
+ L (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the unit
+ bidiagonal matrix L are in elements 1 to N-1 of L
+ (if the matrix is not splitted.) At the end of each block
+ is stored the corresponding shift as given by DLARRE.
+ On exit, L is overwritten.
+
+ PIVMIN (in) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+
+ M (input) INTEGER
+ The total number of input eigenvalues. 0 <= M <= N.
+
+ DOL (input) INTEGER
+ DOU (input) INTEGER
+ If the user wants to compute only selected eigenvectors from
+ the eigenvalues supplied, he can specify an index range DOL:D
+ Or else the setting DOL=1, DOU=M should be applied.
+ Note that DOL and DOU refer to the order in which the eigenva
+ are stored in W.
+ If the user wants to compute only selected eigenpairs, then
+ the columns DOL-1 to DOU+1 of the eigenvector space Z contain
+ computed eigenvectors. All other columns of Z are set to zero
+
+ MINRGP (input) DOUBLE PRECISION
+
+ RTOL1 (input) DOUBLE PRECISION
+ RTOL2 (input) DOUBLE PRECISION
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ W (input/output) DOUBLE PRECISION array, dimension (N)
+ The first M elements of W contain the APPROXIMATE eigenvalues
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block ( The output array
+ W from DLARRE is expected here ). Furthermore, they are with
+
+ respect to the shift of the corresponding root representation
+ for their block. On exit, W holds the eigenvalues of the
+ UNshifted matrix.
+
+ WERR (input/output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue in W
+
+ WGAP (input/output) DOUBLE PRECISION array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (input) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in the second bl
+
+ GERS (input) DOUBLE PRECISION array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should
+ be computed from the original UNshifted matrix.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If INFO = 0, the first M columns of Z contain the
+ orthonormal eigenvectors of the matrix T
+ corresponding to the input eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The I-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*I-1 ) through
+ ISUPPZ( 2*I ).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (12*N)
+
+ IWORK (workspace) INTEGER array, dimension (7*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ > 0: A problem occured in DLARRV.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in DLARRB when refining a child's eigenvalues.
+
+ =-2: Problem in DLARRF when computing the RRR of a child.
+ When a child is inside a tight cluster, it can be diffi
+ to find an RRR. A partial remedy from the user's point
+ view is to make the parameter MINRGP smaller and recomp
+ However, as the orthogonality of the computed vectors i
+ proportional to 1/MINRGP, the user should be aware that
+ he might be trading in precision when he decreases MINR
+ =-3: Problem in DLARRB when refining a single eigenvalue
+ after the Rayleigh correction was rejected.
+ = 5: The Rayleigh Quotient Iteration failed to converge to
+ full accuracy in MAXITR steps.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param vl
+ * @param vu
+ * @param d
+ * @param l
+ * @param pivmin
+ * @param isplit
+ * @param m
+ * @param dol
+ * @param dou
+ * @param minrgp
+ * @param rtol1
+ * @param rtol2
+ * @param w
+ * @param werr
+ * @param wgap
+ * @param iblock
+ * @param indexw
+ * @param gers
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public void dlarrv(int n, double vl, double vu, double[] d, double[] l, double pivmin, int[] isplit, int m, int dol, int dou, double minrgp, doubleW rtol1, doubleW rtol2, double[] w, double[] werr, double[] wgap, int[] iblock, int[] indexw, double[] gers, double[] z, int ldz, int[] isuppz, double[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Dlarrv.dlarrv(n, vl, vu, d, 0, l, 0, pivmin, isplit, 0, m, dol, dou, minrgp, rtol1, rtol2, w, 0, werr, 0, wgap, 0, iblock, 0, indexw, 0, gers, 0, z, 0, ldz, isuppz, 0, work, 0, iwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARTG generate a plane rotation so that
+
+ [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+ [ -SN CS ] [ G ] [ 0 ]
+
+ This is a slower, more accurate version of the BLAS1 routine DROTG,
+ with the following other differences:
+ F and G are unchanged on return.
+ If G=0, then CS=1 and SN=0.
+ If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+ floating point operations (saves work in DBDSQR when
+ there are zeros on the diagonal).
+
+ If F exceeds G in magnitude, CS will be positive.
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The first component of vector to be rotated.
+
+ G (input) DOUBLE PRECISION
+ The second component of vector to be rotated.
+
+ CS (output) DOUBLE PRECISION
+ The cosine of the rotation.
+
+ SN (output) DOUBLE PRECISION
+ The sine of the rotation.
+
+ R (output) DOUBLE PRECISION
+ The nonzero component of the rotated vector.
+
+ This version has a few statements commented out for thread safety
+ (machine parameters are computed on each entry). 10 feb 03, SJH.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param f
+ * @param g
+ * @param cs
+ * @param sn
+ * @param r
+ */
+ public abstract void dlartg(double f, double g, doubleW cs, doubleW sn, doubleW r);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARTV applies a vector of real plane rotations to elements of the
+ real vectors x and y. For i = 1,2,...,n
+
+ ( x(i) ) := ( c(i) s(i) ) ( x(i) )
+ ( y(i) ) ( -s(i) c(i) ) ( y(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) DOUBLE PRECISION array,
+ dimension (1+(N-1)*INCY)
+ The vector y.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param c
+ * @param s
+ * @param incc
+ */
+ public abstract void dlartv(int n, double[] x, int incx, double[] y, int incy, double[] c, double[] s, int incc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARUV returns a vector of n random real numbers from a uniform (0,1)
+ distribution (n <= 128).
+
+ This is an auxiliary routine called by DLARNV and ZLARNV.
+
+ Arguments
+ =========
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated. N <= 128.
+
+ X (output) DOUBLE PRECISION array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine uses a multiplicative congruential method with modulus
+ 2**48 and multiplier 33952834046453 (see G.S.Fishman,
+ 'Multiplicative congruential random number generators with modulus
+ 2**b: an exhaustive analysis for b = 32 and a partial analysis for
+ b = 48', Math. Comp. 189, pp 331-344, 1990).
+
+ 48-bit integers are stored in 4 integer array elements with 12 bits
+ per element. Hence the routine is portable across machines with
+ integers of 32 bits or more.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param iseed
+ * @param n
+ * @param x
+ */
+ public abstract void dlaruv(int[] iseed, int n, double[] x);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARZ applies a real elementary reflector H to a real M-by-N
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+
+ H is a product of k elementary reflectors as returned by DTZRZF.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ L (input) INTEGER
+ The number of entries of the vector V containing
+ the meaningful part of the Householder vectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) DOUBLE PRECISION array, dimension (1+(L-1)*abs(INCV))
+ The vector v in the representation of H as returned by
+ DTZRZF. V is not used if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param l
+ * @param v
+ * @param incv
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ */
+ public abstract void dlarz(String side, int m, int n, int l, double[] v, int incv, double tau, double[] c, int Ldc, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARZB applies a real block reflector H or its transpose H**T to
+ a real distributed M-by-N C from the left or the right.
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'C': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise (not supported yet)
+
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ L (input) INTEGER
+ The number of columns of the matrix V containing the
+ meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) DOUBLE PRECISION array, dimension (LDV,NV).
+ If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,K)
+ The triangular K-by-K matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param direct
+ * @param storev
+ * @param m
+ * @param n
+ * @param k
+ * @param l
+ * @param v
+ * @param ldv
+ * @param t
+ * @param ldt
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param ldwork
+ */
+ public abstract void dlarzb(String side, String trans, String direct, String storev, int m, int n, int k, int l, double[] v, int ldv, double[] t, int ldt, double[] c, int Ldc, double[] work, int ldwork);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLARZT 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'
+
+ 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 * V
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ DIRECT (input) 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, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise (not supported yet)
+
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+
+ ______V_____
+ ( v1 v2 v3 ) / \
+ ( v1 v2 v3 ) ( v1 v1 v1 v1 v1 . . . . 1 )
+ V = ( v1 v2 v3 ) ( v2 v2 v2 v2 v2 . . . 1 )
+ ( v1 v2 v3 ) ( v3 v3 v3 v3 v3 . . 1 )
+ ( v1 v2 v3 )
+ . . .
+ . . .
+ 1 . .
+ 1 .
+ 1
+
+ DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+
+ ______V_____
+ 1 / \
+ . 1 ( 1 . . . . v1 v1 v1 v1 v1 )
+ . . 1 ( . 1 . . . v2 v2 v2 v2 v2 )
+ . . . ( . . 1 . . v3 v3 v3 v3 v3 )
+ . . .
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ V = ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param direct
+ * @param storev
+ * @param n
+ * @param k
+ * @param v
+ * @param ldv
+ * @param tau
+ * @param t
+ * @param ldt
+ */
+ public abstract void dlarzt(String direct, String storev, int n, int k, double[] v, int ldv, double[] tau, double[] t, int ldt);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAS2 computes the singular values of the 2-by-2 matrix
+ [ F G ]
+ [ 0 H ].
+ On return, SSMIN is the smaller singular value and SSMAX is the
+ larger singular value.
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) DOUBLE PRECISION
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) DOUBLE PRECISION
+ The smaller singular value.
+
+ SSMAX (output) DOUBLE PRECISION
+ The larger singular value.
+
+ Further Details
+ ===============
+
+ Barring over/underflow, all output quantities are correct to within
+ a few units in the last place (ulps), even in the absence of a guard
+
+ digit in addition/subtraction.
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows, or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ ====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param f
+ * @param g
+ * @param h
+ * @param ssmin
+ * @param ssmax
+ */
+ public abstract void dlas2(double f, double g, double h, doubleW ssmin, doubleW ssmax);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASCL multiplies the M by N real matrix A by the real scalar
+ CTO/CFROM. This is done without over/underflow as long as the final
+
+ result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+
+ A may be full, upper triangular, lower triangular, upper Hessenberg,
+
+ or banded.
+
+ Arguments
+ =========
+
+ TYPE (input) CHARACTER*1
+ TYPE indices the storage type of the input matrix.
+ = 'G': A is a full matrix.
+ = 'L': A is a lower triangular matrix.
+ = 'U': A is an upper triangular matrix.
+ = 'H': A is an upper Hessenberg matrix.
+ = 'B': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the lower
+ half stored.
+ = 'Q': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the upper
+ half stored.
+ = 'Z': A is a band matrix with lower bandwidth KL and upper
+
+ bandwidth KU.
+
+ KL (input) INTEGER
+ The lower bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ KU (input) INTEGER
+ The upper bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ CFROM (input) DOUBLE PRECISION
+ CTO (input) DOUBLE PRECISION
+ The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+ without over/underflow if the final result CTO*A(I,J)/CFROM
+ can be represented without over/underflow. CFROM must be
+ nonzero.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ The matrix to be multiplied by CTO/CFROM. See TYPE for the
+ storage type.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ 0 - successful exit
+ <0 - if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param type
+ * @param kl
+ * @param ku
+ * @param cfrom
+ * @param cto
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dlascl(String type, int kl, int ku, double cfrom, double cto, int m, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, DLASD0 computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M
+ matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
+ The algorithm computes orthogonal matrices U and VT such that
+ B = U * S * VT. The singular values S are overwritten on D.
+
+ A related subroutine, DLASDA, computes only the singular values,
+ and optionally, the singular vectors in compact form.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the row dimension of the upper bidiagonal matrix.
+ This is also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N+1;
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix.
+ On exit D, if INFO = 0, contains its singular values.
+
+ E (input) DOUBLE PRECISION array, dimension (M-1)
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array, dimension at least (LDQ, N)
+ On exit, U contains the left singular vectors.
+
+ LDU (input) INTEGER
+ On entry, leading dimension of U.
+
+ VT (output) DOUBLE PRECISION array, dimension at least (LDVT, M)
+
+ On exit, VT' contains the right singular vectors.
+
+ LDVT (input) INTEGER
+ On entry, leading dimension of VT.
+
+ SMLSIZ (input) INTEGER
+ On entry, maximum size of the subproblems at the
+ bottom of the computation tree.
+
+ IWORK (workspace) INTEGER work array.
+ Dimension must be at least (8 * N)
+
+ WORK (workspace) DOUBLE PRECISION work array.
+ Dimension must be at least (3 * M**2 + 2 * M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sqre
+ * @param d
+ * @param e
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param smlsiz
+ * @param iwork
+ * @param work
+ * @param info
+ */
+ public abstract void dlasd0(int n, int sqre, double[] d, double[] e, double[] u, int ldu, double[] vt, int ldvt, int smlsiz, int[] iwork, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
+ where N = NL + NR + 1 and M = N + SQRE. DLASD1 is called from DLASD0.
+
+ A related subroutine DLASD7 handles the case in which the singular
+ values (and the singular vectors in factored form) are desired.
+
+ DLASD1 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The left singular vectors of the original matrix are stored in U, and
+ the transpose of the right singular vectors are stored in VT, and the
+ singular values are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or when there are zeros in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLASD2.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the square roots of the
+ roots of the secular equation via the routine DLASD4 (as called
+ by DLASD3). This routine also calculates the singular vectors of
+ the current problem.
+
+ The final stage consists of computing the updated singular vectors
+ directly using the updated singular values. The singular vectors
+
+ for the current problem are multiplied with the singular vectors
+ from the overall problem.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) DOUBLE PRECISION array,
+ dimension (N = NL+NR+1).
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block; and D(NL+2:N) contains the singular values of
+ the lower block. On exit D(1:N) contains the singular values
+ of the modified matrix.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) DOUBLE PRECISION array, dimension(LDU,N)
+ On entry U(1:NL, 1:NL) contains the left singular vectors of
+ the upper block; U(NL+2:N, NL+2:N) contains the left singular
+
+ vectors of the lower block. On exit U contains the left
+ singular vectors of the bidiagonal matrix.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max( 1, N ).
+
+ VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M)
+ where M = N + SQRE.
+ On entry VT(1:NL+1, 1:NL+1)' contains the right singular
+ vectors of the upper block; VT(NL+2:M, NL+2:M)' contains
+ the right singular vectors of the lower block. On exit
+ VT' contains the right singular vectors of the
+ bidiagonal matrix.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= max( 1, M ).
+
+ IDXQ (output) INTEGER array, dimension(N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ IWORK (workspace) INTEGER array, dimension( 4 * N )
+
+ WORK (workspace) DOUBLE PRECISION array, dimension( 3*M**2 + 2*M )
+
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+
+</pre>
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param d
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param idxq
+ * @param iwork
+ * @param work
+ * @param info
+ */
+ public abstract void dlasd1(int nl, int nr, int sqre, double[] d, doubleW alpha, doubleW beta, double[] u, int ldu, double[] vt, int ldvt, int[] idxq, int[] iwork, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD2 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ singular values are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ DLASD2 is called from DLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) DOUBLE PRECISION array, dimension(N)
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) DOUBLE PRECISION array, dimension(N)
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) DOUBLE PRECISION array, dimension(LDU,N)
+ On entry U contains the left singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL, NL), and (NL+2, NL+2), (N,N).
+ On exit U contains the trailing (N-K) updated left singular
+ vectors (those which were deflated) in its last N-K columns.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M)
+ On entry VT' contains the right singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL+1, NL+1), and (NL+2, NL+2), (M,M).
+ On exit VT' contains the trailing (N-K) updated right singular
+ vectors (those which were deflated) in its last N-K columns.
+ In case SQRE =1, the last row of VT spans the right null
+ space.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= M.
+
+ DSIGMA (output) DOUBLE PRECISION array, dimension (N)
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ U2 (output) DOUBLE PRECISION array, dimension(LDU2,N)
+ Contains a copy of the first K-1 left singular vectors which
+ will be used by DLASD3 in a matrix multiply (DGEMM) to solve
+ for the new left singular vectors. U2 is arranged into four
+ blocks. The first block contains a column with 1 at NL+1 and
+ zero everywhere else; the second block contains non-zero
+ entries only at and above NL; the third contains non-zero
+ entries only below NL+1; and the fourth is dense.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT2 (output) DOUBLE PRECISION array, dimension(LDVT2,N)
+ VT2' contains a copy of the first K right singular vectors
+ which will be used by DLASD3 in a matrix multiply (DGEMM) to
+ solve for the new right singular vectors. VT2 is arranged into
+ three blocks. The first block contains a row that corresponds
+
+ to the special 0 diagonal element in SIGMA; the second block
+ contains non-zeros only at and before NL +1; the third block
+ contains non-zeros only at and after NL +2.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= M.
+
+ IDXP (workspace) INTEGER array dimension(N)
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDX (workspace) INTEGER array dimension(N)
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXC (output) INTEGER array dimension(N)
+ This will contain the permutation used to arrange the columns
+
+ of the deflated U matrix into three groups: the first group
+ contains non-zero entries only at and above NL, the second
+ contains non-zero entries only below NL+2, and the third is
+ dense.
+
+ IDXQ (input/output) INTEGER array dimension(N)
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first hlaf of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ COLTYP (workspace/output) INTEGER array dimension(N)
+ As workspace, this will contain a label which will indicate
+ which of the following types a column in the U2 matrix or a
+ row in the VT2 matrix is:
+ 1 : non-zero in the upper half only
+ 2 : non-zero in the lower half only
+ 3 : dense
+ 4 : deflated
+
+ On exit, it is an array of dimension 4, with COLTYP(I) being
+ the dimension of the I-th type columns.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param k
+ * @param d
+ * @param z
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param dsigma
+ * @param u2
+ * @param ldu2
+ * @param vt2
+ * @param ldvt2
+ * @param idxp
+ * @param idx
+ * @param idxc
+ * @param idxq
+ * @param coltyp
+ * @param info
+ */
+ public abstract void dlasd2(int nl, int nr, int sqre, intW k, double[] d, double[] z, double alpha, double beta, double[] u, int ldu, double[] vt, int ldvt, double[] dsigma, double[] u2, int ldu2, double[] vt2, int ldvt2, int[] idxp, int[] idx, int[] idxc, int[] idxq, int[] coltyp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD3 finds all the square roots of the roots of the secular
+ equation, as defined by the values in D and Z. It makes the
+ appropriate calls to DLASD4 and then updates the singular
+ vectors by matrix multiplication.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ DLASD3 is called from DLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (input) INTEGER
+ The size of the secular equation, 1 =< K = < N.
+
+ D (output) DOUBLE PRECISION array, dimension(K)
+ On exit the square roots of the roots of the secular equation,
+ in ascending order.
+
+ Q (workspace) DOUBLE PRECISION array,
+ dimension at least (LDQ,K).
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= K.
+
+ DSIGMA (input) DOUBLE PRECISION array, dimension(K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU, N)
+ The last N - K columns of this matrix contain the deflated
+ left singular vectors.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ U2 (input/output) DOUBLE PRECISION array, dimension (LDU2, N)
+ The first K columns of this matrix contain the non-deflated
+ left singular vectors for the split problem.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT, M)
+ The last M - K columns of VT' contain the deflated
+ right singular vectors.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= N.
+
+ VT2 (input/output) DOUBLE PRECISION array, dimension (LDVT2, N)
+ The first K columns of VT2' contain the non-deflated
+ right singular vectors for the split problem.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= N.
+
+ IDXC (input) INTEGER array, dimension ( N )
+ The permutation used to arrange the columns of U (and rows of
+
+ VT) into three groups: the first group contains non-zero
+ entries only at and above (or before) NL +1; the second
+ contains non-zero entries only at and below (or after) NL+2;
+ and the third is dense. The first column of U and the row of
+ VT are treated separately, however.
+
+ The rows of the singular vectors found by DLASD4
+ must be likewise permuted before the matrix multiplies can
+ take place.
+
+ CTOT (input) INTEGER array, dimension ( 4 )
+ A count of the total number of the various types of columns
+ in U (or rows in VT), as described in IDXC. The fourth column
+
+ type is any column which has been deflated.
+
+ Z (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param k
+ * @param d
+ * @param q
+ * @param ldq
+ * @param dsigma
+ * @param u
+ * @param ldu
+ * @param u2
+ * @param ldu2
+ * @param vt
+ * @param ldvt
+ * @param vt2
+ * @param ldvt2
+ * @param idxc
+ * @param ctot
+ * @param z
+ * @param info
+ */
+ public abstract void dlasd3(int nl, int nr, int sqre, int k, double[] d, double[] q, int ldq, double[] dsigma, double[] u, int ldu, double[] u2, int ldu2, double[] vt, int ldvt, double[] vt2, int ldvt2, int[] idxc, int[] ctot, double[] z, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th updated
+ eigenvalue of a positive symmetric rank-one modification to
+ a positive diagonal matrix whose entries are given as the squares
+ of the corresponding entries in the array d, and that
+
+ 0 <= D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) * diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) DOUBLE PRECISION array, dimension ( N )
+ The original eigenvalues. It is assumed that they are in
+ order, 0 <= D(I) < D(J) for I < J.
+
+ Z (input) DOUBLE PRECISION array, dimension ( N )
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension ( N )
+ If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. The vector DELTA
+ contains the information necessary to construct the
+ (singular) eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ SIGMA (output) DOUBLE PRECISION
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( N )
+ If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
+ component. If N = 1, then WORK( 1 ) = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param sigma
+ * @param work
+ * @param info
+ */
+ public abstract void dlasd4(int n, int i, double[] d, double[] z, double[] delta, double rho, doubleW sigma, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th eigenvalue
+ of a positive symmetric rank-one modification of a 2-by-2 diagonal
+ matrix
+
+ diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal entries in the array D are assumed to satisfy
+
+ 0 <= D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) DOUBLE PRECISION array, dimension ( 2 )
+ The original eigenvalues. We assume 0 <= D(1) < D(2).
+
+ Z (input) DOUBLE PRECISION array, dimension ( 2 )
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension ( 2 )
+ Contains (D(j) - sigma_I) in its j-th component.
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DSIGMA (output) DOUBLE PRECISION
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( 2 )
+ WORK contains (D(j) + sigma_I) in its j-th component.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param dsigma
+ * @param work
+ */
+ public abstract void dlasd5(int i, double[] d, double[] z, double[] delta, double rho, doubleW dsigma, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD6 computes the SVD of an updated upper bidiagonal matrix B
+ obtained by merging two smaller ones by appending a row. This
+ routine is used only for the problem which requires all singular
+ values and optionally singular vector matrices in factored form.
+ B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
+ A related subroutine, DLASD1, handles the case in which all singular
+
+ values and singular vectors of the bidiagonal matrix are desired.
+
+ DLASD6 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The singular values of B can be computed using D1, D2, the first
+ components of all the right singular vectors of the lower block, and
+
+ the last components of all the right singular vectors of the upper
+ block. These components are stored and updated in VF and VL,
+ respectively, in DLASD6. Hence U and VT are not explicitly
+ referenced.
+
+ The singular values are stored in D. The algorithm consists of two
+ stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or if there is a zero
+ in the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLASD7.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the roots of the
+ secular equation via the routine DLASD4 (as called by DLASD8).
+
+ This routine also updates VF and VL and computes the distances
+
+ between the updated singular values and the old singular
+ values.
+
+ DLASD6 is called from DLASDA.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( NL+NR+1 ).
+
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block, and D(NL+2:N) contains the singular values
+ of the lower block. On exit D(1:N) contains the singular
+ values of the modified matrix.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors of
+
+ the lower block. On exit, VL contains the last components of
+ all right singular vectors of the bidiagonal matrix.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ IDXQ (output) INTEGER array, dimension ( N )
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM and POLES, must be at least N.
+
+ POLES (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On exit, POLES(1,*) is an array containing the new singular
+ values obtained from solving the secular equation, and
+ POLES(2,*) is an array containing the poles in the secular
+ equation. Not referenced if ICOMPQ = 0.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( N )
+ On exit, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ On exit, DIFR(I, 1) is the distance between I-th updated
+ (undeflated) singular value and the I+1-th (undeflated) old
+ singular value.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ See DLASD8 for details on DIFL and DIFR.
+
+ Z (output) DOUBLE PRECISION array, dimension ( M )
+ The first elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (output) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( 4 * M )
+
+ IWORK (workspace) INTEGER array, dimension ( 3 * N )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param d
+ * @param vf
+ * @param vl
+ * @param alpha
+ * @param beta
+ * @param idxq
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param givnum
+ * @param ldgnum
+ * @param poles
+ * @param difl
+ * @param difr
+ * @param z
+ * @param k
+ * @param c
+ * @param s
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlasd6(int icompq, int nl, int nr, int sqre, double[] d, double[] vf, double[] vl, doubleW alpha, doubleW beta, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, double[] poles, double[] difl, double[] difr, double[] z, intW k, doubleW c, doubleW s, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD7 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem. There
+ are two ways in which deflation can occur: when two or more singular
+ values are close together or if there is a tiny entry in the Z
+ vector. For each such occurrence the order of the related
+ secular equation problem is reduced by one.
+
+ DLASD7 is called from DLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper
+ bidiagonal matrix in compact form.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix, this is
+ the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( N )
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) DOUBLE PRECISION array, dimension ( M )
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ZW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for Z.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VFW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for VF.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors
+ of the lower block. On exit, VL contains the last components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VLW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for VL.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ DSIGMA (output) DOUBLE PRECISION array, dimension ( N )
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ IDX (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXP (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDXQ (input) INTEGER array, dimension ( N )
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first half of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each singular block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM, must be at least N.
+
+ C (output) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param k
+ * @param d
+ * @param z
+ * @param zw
+ * @param vf
+ * @param vfw
+ * @param vl
+ * @param vlw
+ * @param alpha
+ * @param beta
+ * @param dsigma
+ * @param idx
+ * @param idxp
+ * @param idxq
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param givnum
+ * @param ldgnum
+ * @param c
+ * @param s
+ * @param info
+ */
+ public abstract void dlasd7(int icompq, int nl, int nr, int sqre, intW k, double[] d, double[] z, double[] zw, double[] vf, double[] vfw, double[] vl, double[] vlw, double alpha, double beta, double[] dsigma, int[] idx, int[] idxp, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, doubleW c, doubleW s, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASD8 finds the square roots of the roots of the secular equation,
+ as defined by the values in DSIGMA and Z. It makes the appropriate
+ calls to DLASD4, and stores, for each element in D, the distance
+ to its two nearest poles (elements in DSIGMA). It also updates
+ the arrays VF and VL, the first and last components of all the
+ right singular vectors of the original bidiagonal matrix.
+
+ DLASD8 is called from DLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form in the calling routine:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved
+ by DLASD4. K >= 1.
+
+ D (output) DOUBLE PRECISION array, dimension ( K )
+ On output, D contains the updated singular values.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( K )
+ On entry, VF contains information passed through DBEDE8.
+ On exit, VF contains the first K components of the first
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( K )
+ On entry, VL contains information passed through DBEDE8.
+ On exit, VL contains the first K components of the last
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( K )
+ On exit, DIFL(I) = D(I) - DSIGMA(I).
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
+ dimension ( K ) if ICOMPQ = 0.
+ On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
+ defined and will not be referenced.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ LDDIFR (input) INTEGER
+ The leading dimension of DIFR, must be at least K.
+
+ DSIGMA (input) DOUBLE PRECISION array, dimension ( K )
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension at least 3 * K
+
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param k
+ * @param d
+ * @param z
+ * @param vf
+ * @param vl
+ * @param difl
+ * @param difr
+ * @param lddifr
+ * @param dsigma
+ * @param work
+ * @param info
+ */
+ public abstract void dlasd8(int icompq, int k, double[] d, double[] z, double[] vf, double[] vl, double[] difl, double[] difr, int lddifr, double[] dsigma, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, DLASDA computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
+ B with diagonal D and offdiagonal E, where M = N + SQRE. The
+ algorithm computes the singular values in the SVD B = U * S * VT.
+ The orthogonal matrices U and VT are optionally computed in
+ compact form.
+
+ A related subroutine, DLASD0, computes the singular values and
+ the singular vectors in explicit form.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper bidiagonal
+ matrix in compact form.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row dimension of the upper bidiagonal matrix. This is
+ also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N + 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( N )
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit D, if INFO = 0, contains its singular values.
+
+
+ E (input) DOUBLE PRECISION array, dimension ( M-1 )
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array,
+ dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
+ GIVNUM, and Z.
+
+ VT (output) DOUBLE PRECISION array,
+ dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT' contains the right
+
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ K (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
+ secular equation on the computation tree.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( LDU, NLVL ),
+ where NLVL = floor(log_2 (N/SMLSIZ))).
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
+
+ record distances between singular values on the I-th
+ level and singular values on the (I -1)-th level, and
+ DIFR(1:N, 2 * I ) contains the normalizing factors for
+ the right singular vector matrix. See DLASD8 for details.
+
+ Z (output) DOUBLE PRECISION array,
+ dimension ( LDU, NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ The first K elements of Z(1, I) contain the components of
+ the deflation-adjusted updating row vector for subproblems
+ on the I-th level.
+
+ POLES (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
+ POLES(1, 2*I) contain the new and old singular values
+ involved in the secular equations on the I-th level.
+
+ GIVPTR (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1, and not referenced if
+ ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
+ the number of Givens rotations performed on the I-th
+ problem on the computation tree.
+
+ GIVCOL (output) INTEGER array,
+ dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
+ of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (output) INTEGER array,
+ dimension ( LDGCOL, NLVL ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
+ permutations done on the I-th level of the computation tree.
+
+ GIVNUM (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
+ values of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ C (output) DOUBLE PRECISION array,
+ dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
+
+ If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
+
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (output) DOUBLE PRECISION array, dimension ( N ) if
+ ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
+ and the I-th subproblem is not square, on exit, S( I )
+ contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
+
+ IWORK (workspace) INTEGER array.
+ Dimension must be at least (7 * N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param smlsiz
+ * @param n
+ * @param sqre
+ * @param d
+ * @param e
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param k
+ * @param difl
+ * @param difr
+ * @param z
+ * @param poles
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param perm
+ * @param givnum
+ * @param c
+ * @param s
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dlasda(int icompq, int smlsiz, int n, int sqre, double[] d, double[] e, double[] u, int ldu, double[] vt, int[] k, double[] difl, double[] difr, double[] z, double[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, double[] givnum, double[] c, double[] s, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASDQ computes the singular value decomposition (SVD) of a real
+ (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
+ E, accumulating the transformations if desired. Letting B denote
+ the input bidiagonal matrix, the algorithm computes orthogonal
+ matrices Q and P such that B = Q * S * P' (P' denotes the transpose
+ of P). The singular values S are overwritten on D.
+
+ The input matrix U is changed to U * Q if desired.
+ The input matrix VT is changed to P' * VT if desired.
+ The input matrix C is changed to Q' * C if desired.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3, for a detailed description of the algorithm.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ On entry, UPLO specifies whether the input bidiagonal matrix
+ is upper or lower bidiagonal, and wether it is square are
+ not.
+ UPLO = 'U' or 'u' B is upper bidiagonal.
+ UPLO = 'L' or 'l' B is lower bidiagonal.
+
+ SQRE (input) INTEGER
+ = 0: then the input matrix is N-by-N.
+ = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
+ (N+1)-by-N if UPLU = 'L'.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ N (input) INTEGER
+ On entry, N specifies the number of rows and columns
+ in the matrix. N must be at least 0.
+
+ NCVT (input) INTEGER
+ On entry, NCVT specifies the number of columns of
+ the matrix VT. NCVT must be at least 0.
+
+ NRU (input) INTEGER
+ On entry, NRU specifies the number of rows of
+ the matrix U. NRU must be at least 0.
+
+ NCC (input) INTEGER
+ On entry, NCC specifies the number of columns of
+ the matrix C. NCC must be at least 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the diagonal entries of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in ascending order.
+
+ E (input/output) DOUBLE PRECISION array.
+ dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
+ On entry, the entries of E contain the offdiagonal entries
+ of the bidiagonal matrix whose SVD is desired. On normal
+ exit, E will contain 0. If the algorithm does not converge,
+ D and E will contain the diagonal and superdiagonal entries
+ of a bidiagonal matrix orthogonally equivalent to the one
+ given as input.
+
+ VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
+ On entry, contains a matrix which on exit has been
+ premultiplied by P', dimension N-by-NCVT if SQRE = 0
+ and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
+
+ LDVT (input) INTEGER
+ On entry, LDVT specifies the leading dimension of VT as
+ declared in the calling (sub) program. LDVT must be at
+ least 1. If NCVT is nonzero LDVT must also be at least N.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
+ On entry, contains a matrix which on exit has been
+ postmultiplied by Q, dimension NRU-by-N if SQRE = 0
+ and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
+
+ LDU (input) INTEGER
+ On entry, LDU specifies the leading dimension of U as
+ declared in the calling (sub) program. LDU must be at
+ least max( 1, NRU ) .
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
+ On entry, contains an N-by-NCC matrix which on exit
+ has been premultiplied by Q' dimension N-by-NCC if SQRE = 0
+ and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
+
+ LDC (input) INTEGER
+ On entry, LDC specifies the leading dimension of C as
+ declared in the calling (sub) program. LDC must be at
+ least 1. If NCC is nonzero, LDC must also be at least N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+ Workspace. Only referenced if one of NCVT, NRU, or NCC is
+ nonzero, and if N is at least 2.
+
+ INFO (output) INTEGER
+ On exit, a value of 0 indicates a successful exit.
+ If INFO < 0, argument number -INFO is illegal.
+ If INFO > 0, the algorithm did not converge, and INFO
+ specifies how many superdiagonals did not converge.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param sqre
+ * @param n
+ * @param ncvt
+ * @param nru
+ * @param ncc
+ * @param d
+ * @param e
+ * @param vt
+ * @param ldvt
+ * @param u
+ * @param ldu
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dlasdq(String uplo, int sqre, int n, int ncvt, int nru, int ncc, double[] d, double[] e, double[] vt, int ldvt, double[] u, int ldu, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASDT creates a tree of subproblems for bidiagonal divide and
+ conquer.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the number of diagonal elements of the
+ bidiagonal matrix.
+
+ LVL (output) INTEGER
+ On exit, the number of levels on the computation tree.
+
+ ND (output) INTEGER
+ On exit, the number of nodes on the tree.
+
+ INODE (output) INTEGER array, dimension ( N )
+ On exit, centers of subproblems.
+
+ NDIML (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of left children.
+
+ NDIMR (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of right children.
+
+ MSUB (input) INTEGER.
+ On entry, the maximum row dimension each subproblem at the
+ bottom of the tree can be of.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param lvl
+ * @param nd
+ * @param inode
+ * @param ndiml
+ * @param ndimr
+ * @param msub
+ */
+ public abstract void dlasdt(int n, intW lvl, intW nd, int[] inode, int[] ndiml, int[] ndimr, int msub);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASET initializes an m-by-n matrix A to BETA on the diagonal and
+ ALPHA on the offdiagonals.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be set.
+ = 'U': Upper triangular part is set; the strictly lower
+
+ triangular part of A is not changed.
+ = 'L': Lower triangular part is set; the strictly upper
+
+ triangular part of A is not changed.
+ Otherwise: All of the matrix A is set.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ ALPHA (input) DOUBLE PRECISION
+ The constant to which the offdiagonal elements are to be set.
+
+ BETA (input) DOUBLE PRECISION
+ The constant to which the diagonal elements are to be set.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On exit, the leading m-by-n submatrix of A is set as follows:
+
+ if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+ if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+ otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+
+ and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param m
+ * @param n
+ * @param alpha
+ * @param beta
+ * @param a
+ * @param lda
+ */
+ public abstract void dlaset(String uplo, int m, int n, double alpha, double beta, double[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ1 computes the singular values of a real N-by-N bidiagonal
+ matrix with diagonal D and off-diagonal E. The singular values
+ are computed to high relative accuracy, in the absence of
+ denormalization, underflow and overflow. The algorithm was first
+ presented in
+
+ "Accurate singular values and differential qd algorithms" by K. V.
+ Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
+ 1994,
+
+ and the present implementation is described in "An implementation of
+
+ the dqds Algorithm (Positive Case)", LAPACK Working Note.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the diagonal elements of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in decreasing order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, elements E(1:N-1) contain the off-diagonal elements
+ of the bidiagonal matrix whose SVD is desired.
+ On exit, E is overwritten.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param work
+ * @param info
+ */
+ public abstract void dlasq1(int n, double[] d, double[] e, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ2 computes all the eigenvalues of the symmetric positive
+ definite tridiagonal matrix associated with the qd array Z to high
+ relative accuracy are computed to high relative accuracy, in the
+ absence of denormalization, underflow and overflow.
+
+ To see the relation of Z to the tridiagonal matrix, let L be a
+ unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
+ let U be an upper bidiagonal matrix with 1's above and diagonal
+ Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
+ symmetric tridiagonal to which it is similar.
+
+ Note : DLASQ2 defines a logical variable, IEEE, which is true
+ on machines which follow ieee-754 floating-point standard in their
+ handling of infinities and NaNs, and false otherwise. This variable
+ is passed to DLAZQ3.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ Z (workspace) DOUBLE PRECISION array, dimension ( 4*N )
+ On entry Z holds the qd array. On exit, entries 1 to N hold
+ the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
+ trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
+ N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
+ holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
+ shifts that failed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if the i-th argument is a scalar and had an illegal
+ value, then INFO = -i, if the i-th argument is an
+ array and the j-entry had an illegal value, then
+ INFO = -(i*100+j)
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ Further Details
+ ===============
+ Local Variables: I0:N0 defines a current unreduced segment of Z.
+ The shifts are accumulated in SIGMA. Iteration count is in ITER.
+ Ping-pong is controlled by PP (alternates between 0 and 1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param z
+ * @param info
+ */
+ public abstract void dlasq2(int n, double[] z, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ SIGMA (output) DOUBLE PRECISION
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) DOUBLE PRECISION
+ Lower order part of SIGMA
+
+ QMAX (input) DOUBLE PRECISION
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param dmin
+ * @param sigma
+ * @param desig
+ * @param qmax
+ * @param nfail
+ * @param iter
+ * @param ndiv
+ * @param ieee
+ */
+ public abstract void dlasq3(int i0, intW n0, double[] z, int pp, doubleW dmin, doubleW sigma, doubleW desig, doubleW qmax, intW nfail, intW iter, intW ndiv, boolean ieee);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) DOUBLE PRECISION
+ d(N)
+
+ DN1 (input) DOUBLE PRECISION
+ d(N-1)
+
+ DN2 (input) DOUBLE PRECISION
+ d(N-2)
+
+ TAU (output) DOUBLE PRECISION
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param n0in
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dn1
+ * @param dn2
+ * @param tau
+ * @param ttype
+ */
+ public abstract void dlasq4(int i0, int n0, double[] z, int pp, int n0in, double dmin, double dmin1, double dmin2, double dn, double dn1, double dn2, doubleW tau, intW ttype);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ5 computes one dqds transform in ping-pong form, one
+ version for IEEE machines another for non IEEE machines.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ TAU (input) DOUBLE PRECISION
+ This is the shift.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) DOUBLE PRECISION
+ d(N0), the last value of d.
+
+ DNM1 (output) DOUBLE PRECISION
+ d(N0-1).
+
+ DNM2 (output) DOUBLE PRECISION
+ d(N0-2).
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic.
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param tau
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dnm1
+ * @param dnm2
+ * @param ieee
+ */
+ public abstract void dlasq5(int i0, int n0, double[] z, int pp, double tau, doubleW dmin, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dnm1, doubleW dnm2, boolean ieee);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASQ6 computes one dqd (shift equal to zero) transform in
+ ping-pong form, with protection against underflow and overflow.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) DOUBLE PRECISION
+ d(N0), the last value of d.
+
+ DNM1 (output) DOUBLE PRECISION
+ d(N0-1).
+
+ DNM2 (output) DOUBLE PRECISION
+ d(N0-2).
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dnm1
+ * @param dnm2
+ */
+ public abstract void dlasq6(int i0, int n0, double[] z, int pp, doubleW dmin, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dnm1, doubleW dnm2);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASR applies a sequence of plane rotations to a real matrix A,
+ from either the left or the right.
+
+ When SIDE = 'L', the transformation takes the form
+
+ A := P*A
+
+ and when SIDE = 'R', the transformation takes the form
+
+ A := A*P**T
+
+ where P is an orthogonal matrix consisting of a sequence of z plane
+ rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+ and P**T is the transpose of P.
+
+ When DIRECT = 'F' (Forward sequence), then
+
+ P = P(z-1) * ... * P(2) * P(1)
+
+ and when DIRECT = 'B' (Backward sequence), then
+
+ P = P(1) * P(2) * ... * P(z-1)
+
+ where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+
+
+ R(k) = ( c(k) s(k) )
+ = ( -s(k) c(k) ).
+
+ When PIVOT = 'V' (Variable pivot), the rotation is performed
+ for the plane (k,k+1), i.e., P(k) has the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears as a rank-2 modification to the identity matrix in
+ rows and columns k and k+1.
+
+ When PIVOT = 'T' (Top pivot), the rotation is performed for the
+ plane (1,k+1), so P(k) has the form
+
+ P(k) = ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears in rows and columns 1 and k+1.
+
+ Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+ performed for the plane (k,z), giving P(k) the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+
+ where R(k) appears in rows and columns k and z. The rotations are
+ performed without ever forming P(k) explicitly.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ Specifies whether the plane rotation matrix P is applied to
+ A on the left or the right.
+ = 'L': Left, compute A := P*A
+ = 'R': Right, compute A:= A*P**T
+
+ PIVOT (input) CHARACTER*1
+ Specifies the plane for which P(k) is a plane rotation
+ matrix.
+ = 'V': Variable pivot, the plane (k,k+1)
+ = 'T': Top pivot, the plane (1,k+1)
+ = 'B': Bottom pivot, the plane (k,z)
+
+ DIRECT (input) CHARACTER*1
+ Specifies whether P is a forward or backward sequence of
+ plane rotations.
+ = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+ = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
+
+ M (input) INTEGER
+ The number of rows of the matrix A. If m <= 1, an immediate
+
+ return is effected.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. If n <= 1, an
+ immediate return is effected.
+
+ C (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The cosines c(k) of the plane rotations.
+
+ S (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The sines s(k) of the plane rotations. The 2-by-2 plane
+ rotation part of the matrix P(k), R(k), has the form
+ R(k) = ( c(k) s(k) )
+ ( -s(k) c(k) ).
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ The M-by-N matrix A. On exit, A is overwritten by P*A if
+ SIDE = 'R' or by A*P**T if SIDE = 'L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param pivot
+ * @param direct
+ * @param m
+ * @param n
+ * @param c
+ * @param s
+ * @param a
+ * @param lda
+ */
+ public abstract void dlasr(String side, String pivot, String direct, int m, int n, double[] c, double[] s, double[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Sort the numbers in D in increasing order (if ID = 'I') or
+ in decreasing order (if ID = 'D' ).
+
+ Use Quick Sort, reverting to Insertion sort on arrays of
+ size <= 20. Dimension of STACK limits N to about 2**32.
+
+ Arguments
+ =========
+
+ ID (input) CHARACTER*1
+ = 'I': sort D in increasing order;
+ = 'D': sort D in decreasing order.
+
+ N (input) INTEGER
+ The length of the array D.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the array to be sorted.
+ On exit, D has been sorted into increasing order
+ (D(1) <= ... <= D(N) ) or into decreasing order
+ (D(1) >= ... >= D(N) ), depending on ID.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param id
+ * @param n
+ * @param d
+ * @param info
+ */
+ public abstract void dlasrt(String id, int n, double[] d, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASSQ returns the values scl and smsq such that
+
+ ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+
+
+ where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+ assumed to be non-negative and scl returns the value
+
+ scl = max( scale, abs( x( i ) ) ).
+
+ scale and sumsq must be supplied in SCALE and SUMSQ and
+ scl and smsq are overwritten on SCALE and SUMSQ respectively.
+
+ The routine makes only one pass through the vector x.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of elements to be used from the vector X.
+
+ X (input) DOUBLE PRECISION array, dimension (N)
+ The vector for which a scaled sum of squares is computed.
+ x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector X.
+ INCX > 0.
+
+ SCALE (input/output) DOUBLE PRECISION
+ On entry, the value scale in the equation above.
+ On exit, SCALE is overwritten with scl , the scaling factor
+
+ for the sum of squares.
+
+ SUMSQ (input/output) DOUBLE PRECISION
+ On entry, the value sumsq in the equation above.
+ On exit, SUMSQ is overwritten with smsq , the basic sum of
+ squares from which scl has been factored out.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param scale
+ * @param sumsq
+ */
+ public abstract void dlassq(int n, double[] x, int incx, doubleW scale, doubleW sumsq);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASV2 computes the singular value decomposition of a 2-by-2
+ triangular matrix
+ [ F G ]
+ [ 0 H ].
+ On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+ smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+
+ right singular vectors for abs(SSMAX), giving the decomposition
+
+ [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+ [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) DOUBLE PRECISION
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) DOUBLE PRECISION
+ abs(SSMIN) is the smaller singular value.
+
+ SSMAX (output) DOUBLE PRECISION
+ abs(SSMAX) is the larger singular value.
+
+ SNL (output) DOUBLE PRECISION
+ CSL (output) DOUBLE PRECISION
+ The vector (CSL, SNL) is a unit left singular vector for the
+
+ singular value abs(SSMAX).
+
+ SNR (output) DOUBLE PRECISION
+ CSR (output) DOUBLE PRECISION
+ The vector (CSR, SNR) is a unit right singular vector for the
+ singular value abs(SSMAX).
+
+ Further Details
+ ===============
+
+ Any input parameter may be aliased with any output parameter.
+
+ Barring over/underflow and assuming a guard digit in subtraction, all
+ output quantities are correct to within a few units in the last
+ place (ulps).
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param f
+ * @param g
+ * @param h
+ * @param ssmin
+ * @param ssmax
+ * @param snr
+ * @param csr
+ * @param snl
+ * @param csl
+ */
+ public abstract void dlasv2(double f, double g, double h, doubleW ssmin, doubleW ssmax, doubleW snr, doubleW csr, doubleW snl, doubleW csl);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASWP performs a series of row interchanges on the matrix A.
+ One row interchange is initiated for each of rows K1 through K2 of A.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of columns of the matrix A.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the matrix of column dimension N to which the row
+ interchanges will be applied.
+ On exit, the permuted matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+
+ K1 (input) INTEGER
+ The first element of IPIV for which a row interchange will
+ be done.
+
+ K2 (input) INTEGER
+ The last element of IPIV for which a row interchange will
+ be done.
+
+ IPIV (input) INTEGER array, dimension (K2*abs(INCX))
+ The vector of pivot indices. Only the elements in positions
+
+ K1 through K2 of IPIV are accessed.
+ IPIV(K) = L implies rows K and L are to be interchanged.
+
+ INCX (input) INTEGER
+ The increment between successive values of IPIV. If IPIV
+ is negative, the pivots are applied in reverse order.
+
+ Further Details
+ ===============
+
+ Modified by
+ R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param k1
+ * @param k2
+ * @param ipiv
+ * @param incx
+ */
+ public abstract void dlaswp(int n, double[] a, int lda, int k1, int k2, int[] ipiv, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
+
+ op(TL)*X + ISGN*X*op(TR) = SCALE*B,
+
+ where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
+
+ -1. op(T) = T or T', where T' denotes the transpose of T.
+
+ Arguments
+ =========
+
+ LTRANL (input) LOGICAL
+ On entry, LTRANL specifies the op(TL):
+ = .FALSE., op(TL) = TL,
+ = .TRUE., op(TL) = TL'.
+
+ LTRANR (input) LOGICAL
+ On entry, LTRANR specifies the op(TR):
+ = .FALSE., op(TR) = TR,
+ = .TRUE., op(TR) = TR'.
+
+ ISGN (input) INTEGER
+ On entry, ISGN specifies the sign of the equation
+ as described before. ISGN may only be 1 or -1.
+
+ N1 (input) INTEGER
+ On entry, N1 specifies the order of matrix TL.
+ N1 may only be 0, 1 or 2.
+
+ N2 (input) INTEGER
+ On entry, N2 specifies the order of matrix TR.
+ N2 may only be 0, 1 or 2.
+
+ TL (input) DOUBLE PRECISION array, dimension (LDTL,2)
+ On entry, TL contains an N1 by N1 matrix.
+
+ LDTL (input) INTEGER
+ The leading dimension of the matrix TL. LDTL >= max(1,N1).
+
+ TR (input) DOUBLE PRECISION array, dimension (LDTR,2)
+ On entry, TR contains an N2 by N2 matrix.
+
+ LDTR (input) INTEGER
+ The leading dimension of the matrix TR. LDTR >= max(1,N2).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,2)
+ On entry, the N1 by N2 matrix B contains the right-hand
+ side of the equation.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1,N1).
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ less than or equal to 1 to prevent the solution overflowing.
+
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,2)
+ On exit, X contains the N1 by N2 solution.
+
+ LDX (input) INTEGER
+ The leading dimension of the matrix X. LDX >= max(1,N1).
+
+ XNORM (output) DOUBLE PRECISION
+ On exit, XNORM is the infinity-norm of the solution.
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: TL and TR have too close eigenvalues, so TL or
+ TR is perturbed to get a nonsingular equation.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param ltranl
+ * @param ltranr
+ * @param isgn
+ * @param n1
+ * @param n2
+ * @param tl
+ * @param ldtl
+ * @param tr
+ * @param ldtr
+ * @param b
+ * @param ldb
+ * @param scale
+ * @param x
+ * @param ldx
+ * @param xnorm
+ * @param info
+ */
+ public abstract void dlasy2(boolean ltranl, boolean ltranr, int isgn, int n1, int n2, double[] tl, int ldtl, double[] tr, int ldtr, double[] b, int ldb, doubleW scale, double[] x, int ldx, doubleW xnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLASYF computes a partial factorization of a real symmetric matrix A
+
+ using the Bunch-Kaufman diagonal pivoting method. The partial
+ factorization has the form:
+
+ A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
+ ( 0 U22 ) ( 0 D ) ( U12' U22' )
+
+ A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L'
+ ( L21 I ) ( 0 A22 ) ( 0 I )
+
+ where the order of D is at most NB. The actual order is returned in
+ the argument KB, and is either NB or NB-1, or N if N <= NB.
+
+ DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code
+ (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
+ A22 (if UPLO = 'L').
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NB (input) INTEGER
+ The maximum number of columns of the matrix A that should be
+
+ factored. NB should be at least 2 to allow for 2-by-2 pivot
+
+ blocks.
+
+ KB (output) INTEGER
+ The number of columns of A that were actually factored.
+ KB is either NB-1 or NB, or N if N <= NB.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, A contains details of the partial factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If UPLO = 'U', only the last KB elements of IPIV are set;
+ if UPLO = 'L', only the first KB elements are set.
+
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ W (workspace) DOUBLE PRECISION array, dimension (LDW,NB)
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nb
+ * @param kb
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param w
+ * @param ldw
+ * @param info
+ */
+ public abstract void dlasyf(String uplo, int n, int nb, intW kb, double[] a, int lda, int[] ipiv, double[] w, int ldw, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATBS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular band matrix. Here A' denotes the transpose of A, x and b
+
+ are n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine DTBSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of subdiagonals or superdiagonals in the
+ triangular matrix A. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first KD+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, DTBSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTBSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call DTBSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param normin
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param x
+ * @param scale
+ * @param cnorm
+ * @param info
+ */
+ public abstract void dlatbs(String uplo, String trans, String diag, String normin, int n, int kd, double[] ab, int ldab, double[] x, doubleW scale, double[] cnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATDF uses the LU factorization of the n-by-n matrix Z computed by
+ DGETC2 and computes a contribution to the reciprocal Dif-estimate
+ by solving Z * x = b for x, and choosing the r.h.s. b such that
+ the norm of x is as large as possible. On entry RHS = b holds the
+ contribution from earlier solved sub-systems, and on return RHS = x.
+
+
+ The factorization of Z returned by DGETC2 has the form Z = P*L*U*Q,
+ where P and Q are permutation matrices. L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ IJOB = 2: First compute an approximative null-vector e
+ of Z using DGECON, e is normalized and solve for
+ Zx = +-e - f with the sign giving the greater value
+ of 2-norm(x). About 5 times as expensive as Default.
+ IJOB .ne. 2: Local look ahead strategy where all entries of
+ the r.h.s. b is choosen as either +1 or -1 (Default).
+
+ N (input) INTEGER
+ The number of columns of the matrix Z.
+
+ Z (input) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix Z computed by DGETC2: Z = P * L * U * Q
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDA >= max(1, N).
+
+ RHS (input/output) DOUBLE PRECISION array, dimension N.
+ On entry, RHS contains contributions from other subsystems.
+ On exit, RHS contains the solution of the subsystem with
+ entries acoording to the value of IJOB (see above).
+
+ RDSUM (input/output) DOUBLE PRECISION
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by DTGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
+
+ RDSCAL (input/output) DOUBLE PRECISION
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when DTGSY2 is called by
+ DTGSYL.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ This routine is a further developed implementation of algorithm
+ BSOLVE in [1] using complete pivoting in the LU factorization.
+
+ [1] Bo Kagstrom and Lars Westin,
+ Generalized Schur Methods with Condition Estimators for
+ Solving the Generalized Sylvester Equation, IEEE Transactions
+ on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
+
+ [2] Peter Poromaa,
+ On Efficient and Robust Estimators for the Separation
+ between two Regular Matrix Pairs with Applications in
+ Condition Estimation. Report IMINF-95.05, Departement of
+ Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param ijob
+ * @param n
+ * @param z
+ * @param ldz
+ * @param rhs
+ * @param rdsum
+ * @param rdscal
+ * @param ipiv
+ * @param jpiv
+ */
+ public abstract void dlatdf(int ijob, int n, double[] z, int ldz, double[] rhs, doubleW rdsum, doubleW rdscal, int[] ipiv, int[] jpiv);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATPS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular matrix stored in packed form. Here A' denotes the
+ transpose of A, x and b are n-element vectors, and s is a scaling
+ factor, usually less than or equal to 1, chosen so that the
+ components of x will be less than the overflow threshold. If the
+ unscaled problem will not cause overflow, the Level 2 BLAS routine
+ DTPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
+ then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, DTPSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTPSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call DTPSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param normin
+ * @param n
+ * @param ap
+ * @param x
+ * @param scale
+ * @param cnorm
+ * @param info
+ */
+ public abstract void dlatps(String uplo, String trans, String diag, String normin, int n, double[] ap, double[] x, doubleW scale, double[] cnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATRD reduces NB rows and columns of a real symmetric matrix A to
+ symmetric tridiagonal form by an orthogonal similarity
+ transformation Q' * A * Q, and returns the matrices V and W which are
+ needed to apply the transformation to the unreduced part of A.
+
+ If UPLO = 'U', DLATRD reduces the last NB rows and columns of a
+ matrix, of which the upper triangle is supplied;
+ if UPLO = 'L', DLATRD reduces the first NB rows and columns of a
+ matrix, of which the lower triangle is supplied.
+
+ This is an auxiliary routine called by DSYTRD.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NB (input) INTEGER
+ The number of rows and columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit:
+ if UPLO = 'U', the last NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements above the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+
+ product of elementary reflectors;
+ if UPLO = 'L', the first NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements below the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= (1,N).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+ elements of the last NB columns of the reduced matrix;
+ if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+ the first NB columns of the reduced matrix.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors, stored in
+ TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+
+ See Further Details.
+
+ W (output) DOUBLE PRECISION array, dimension (LDW,NB)
+ The n-by-nb matrix W required to update the unreduced part
+ of A.
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n) H(n-1) . . . H(n-nb+1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+
+ and tau in TAU(i-1).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and tau in TAU(i).
+
+ The elements of the vectors v together form the n-by-nb matrix V
+ which is needed, with W, to apply the transformation to the unreduced
+ part of the matrix, using a symmetric rank-2k update of the form:
+ A := A - V*W' - W*V'.
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5 and nb = 2:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( a a a v4 v5 ) ( d )
+ ( a a v4 v5 ) ( 1 d )
+ ( a 1 v5 ) ( v1 1 a )
+ ( d 1 ) ( v1 v2 a a )
+ ( d ) ( v1 v2 a a a )
+
+ where d denotes a diagonal element of the reduced matrix, a denotes
+ an element of the original matrix that is unchanged, and vi denotes
+ an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nb
+ * @param a
+ * @param lda
+ * @param e
+ * @param tau
+ * @param w
+ * @param ldw
+ */
+ public abstract void dlatrd(String uplo, int n, int nb, double[] a, int lda, double[] e, double[] tau, double[] w, int ldw);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATRS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow. Here A is an upper or lower
+ triangular matrix, A' denotes the transpose of A, x and b are
+ n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine DTRSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max (1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, DTRSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param normin
+ * @param n
+ * @param a
+ * @param lda
+ * @param x
+ * @param scale
+ * @param cnorm
+ * @param info
+ */
+ public abstract void dlatrs(String uplo, String trans, String diag, String normin, int n, double[] a, int lda, double[] x, doubleW scale, double[] cnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
+ [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means
+ of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal
+ matrix and, R and A1 are M-by-M upper triangular matrices.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing the
+ meaningful part of the Householder vectors. N-M >= L >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements N-L+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an l element vector. tau and z( k )
+ are chosen to annihilate the elements of the kth row of A2.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A2, such that the elements of z( k ) are
+ in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A1.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param l
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ */
+ public abstract void dlatrz(int m, int n, int l, double[] a, int lda, double[] tau, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DORMRZ.
+
+ DLATZM applies a Householder matrix generated by DTZRQF to a matrix.
+
+
+ Let P = I - tau*u*u', u = ( 1 ),
+ ( v )
+ where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
+ SIDE = 'R'.
+
+ If SIDE equals 'L', let
+ C = [ C1 ] 1
+ [ C2 ] m-1
+ n
+ Then C is overwritten by P*C.
+
+ If SIDE equals 'R', let
+ C = [ C1, C2 ] m
+ 1 n-1
+ Then C is overwritten by C*P.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form P * C
+ = 'R': form C * P
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of P. V is not used
+ if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of P.
+
+ C1 (input/output) DOUBLE PRECISION array, dimension
+ (LDC,N) if SIDE = 'L'
+ (M,1) if SIDE = 'R'
+ On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
+ if SIDE = 'R'.
+
+ On exit, the first row of P*C if SIDE = 'L', or the first
+ column of C*P if SIDE = 'R'.
+
+ C2 (input/output) DOUBLE PRECISION array, dimension
+ (LDC, N) if SIDE = 'L'
+ (LDC, N-1) if SIDE = 'R'
+ On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
+ m x (n - 1) matrix C2 if SIDE = 'R'.
+
+ On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
+ if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the arrays C1 and C2. LDC >= (1,M).
+
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param v
+ * @param incv
+ * @param tau
+ * @param c1
+ * @param c2
+ * @param Ldc
+ * @param work
+ */
+ public abstract void dlatzm(String side, int m, int n, double[] v, int incv, double tau, double[] c1, double[] c2, int Ldc, double[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAUU2 computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the unblocked form of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dlauu2(String uplo, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAUUM computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the blocked form of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dlauum(String uplo, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAZQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ SIGMA (output) DOUBLE PRECISION
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) DOUBLE PRECISION
+ Lower order part of SIGMA
+
+ QMAX (input) DOUBLE PRECISION
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
+
+ TTYPE (input/output) INTEGER
+ Shift type. TTYPE is passed as an argument in order to save
+ its value between calls to DLAZQ3
+
+ DMIN1 (input/output) REAL
+ DMIN2 (input/output) REAL
+ DN (input/output) REAL
+ DN1 (input/output) REAL
+ DN2 (input/output) REAL
+ TAU (input/output) REAL
+ These are passed as arguments in order to save their values
+ between calls to DLAZQ3
+
+ This is a thread safe version of DLASQ3, which passes TTYPE, DMIN1,
+ DMIN2, DN, DN1. DN2 and TAU through the argument list in place of
+ declaring them in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param dmin
+ * @param sigma
+ * @param desig
+ * @param qmax
+ * @param nfail
+ * @param iter
+ * @param ndiv
+ * @param ieee
+ * @param ttype
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dn1
+ * @param dn2
+ * @param tau
+ */
+ public void dlazq3(int i0, intW n0, double[] z, int pp, doubleW dmin, doubleW sigma, doubleW desig, doubleW qmax, intW nfail, intW iter, intW ndiv, boolean ieee, intW ttype, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dn1, doubleW dn2, doubleW tau) {
+ org.netlib.lapack.Dlazq3.dlazq3(i0, n0, z, 0, pp, dmin, sigma, desig, qmax, nfail, iter, ndiv, ieee, ttype, dmin1, dmin2, dn, dn1, dn2, tau);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAZQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) DOUBLE PRECISION
+ d(N)
+
+ DN1 (input) DOUBLE PRECISION
+ d(N-1)
+
+ DN2 (input) DOUBLE PRECISION
+ d(N-2)
+
+ TAU (output) DOUBLE PRECISION
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ G (input/output) DOUBLE PRECISION
+ G is passed as an argument in order to save its value between
+ calls to DLAZQ4
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ This is a thread safe version of DLASQ4, which passes G through the
+ argument list in place of declaring G in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param n0in
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dn1
+ * @param dn2
+ * @param tau
+ * @param ttype
+ * @param g
+ */
+ public void dlazq4(int i0, int n0, double[] z, int pp, int n0in, double dmin, double dmin1, double dmin2, double dn, double dn1, double dn2, doubleW tau, intW ttype, doubleW g) {
+ org.netlib.lapack.Dlazq4.dlazq4(i0, n0, z, 0, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, tau, ttype, g);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DOPGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors H(i) of order n, as returned by
+
+ DSPTRD using packed storage:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to DSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to DSPTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The vectors which define the elementary reflectors, as
+ returned by DSPTRD.
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSPTRD.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ The N-by-N orthogonal matrix Q.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N-1)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param tau
+ * @param q
+ * @param ldq
+ * @param work
+ * @param info
+ */
+ public abstract void dopgtr(String uplo, int n, double[] ap, double[] tau, double[] q, int ldq, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DOPMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by DSPTRD using packed
+ storage:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to DSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to DSPTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension
+ (M*(M+1)/2) if SIDE = 'L'
+ (N*(N+1)/2) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DSPTRD. AP is modified by the routine but
+ restored on exit.
+
+ TAU (input) DOUBLE PRECISION array, dimension (M-1) if SIDE = 'L'
+ or (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSPTRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param trans
+ * @param m
+ * @param n
+ * @param ap
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dopmtr(String side, String uplo, String trans, int m, int n, double[] ap, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORG2L generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the last n columns of a product of k elementary
+ reflectors of order m
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQLF in the last k columns of its array
+ argument A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dorg2l(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORG2R generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the first n columns of a product of k elementary
+
+ reflectors of order m
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQRF in the first k columns of its array
+ argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dorg2r(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGBR generates one of the real orthogonal matrices Q or P**T
+ determined by DGEBRD when reducing a real matrix A to bidiagonal
+ form: A = Q * B * P**T. Q and P**T are defined as products of
+ elementary reflectors H(i) or G(i) respectively.
+
+ If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
+ is of order M:
+ if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
+ columns of Q, where m >= n >= k;
+ if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
+ M-by-M matrix.
+
+ If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
+ is of order N:
+ if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
+
+ rows of P**T, where n >= m >= k;
+ if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
+ an N-by-N matrix.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether the matrix Q or the matrix P**T is
+ required, as defined in the transformation applied by DGEBRD:
+ = 'Q': generate Q;
+ = 'P': generate P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix Q or P**T to be returned.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q or P**T to be returned.
+ N >= 0.
+ If VECT = 'Q', M >= N >= min(M,K);
+ if VECT = 'P', N >= M >= min(N,K).
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original M-by-K
+ matrix reduced by DGEBRD.
+ If VECT = 'P', the number of rows in the original K-by-N
+ matrix reduced by DGEBRD.
+ K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DGEBRD.
+ On exit, the M-by-N matrix Q or P**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (min(M,K)) if VECT = 'Q'
+ (min(N,K)) if VECT = 'P'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i), which determines Q or P**T, as
+ returned by DGEBRD in its array argument TAUQ or TAUP.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,min(M,N)).
+ For optimum performance LWORK >= min(M,N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorgbr(String vect, int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGHR generates a real orthogonal matrix Q which is defined as the
+ product of IHI-ILO elementary reflectors of order N, as returned by
+ DGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of DGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DGEHRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEHRD.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= IHI-ILO.
+ For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorghr(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGL2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the first m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by DGELQF in the first k rows of its array argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dorgl2(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGLQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the first M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by DGELQF in the first k rows of its array argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorglq(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGQL generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the last N columns of a product of K elementary
+ reflectors of order M
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQLF in the last k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorgql(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGQR generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the first N columns of a product of K elementary
+
+ reflectors of order M
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGEQRF in the first k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorgqr(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGR2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the last m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGERQF in the last k rows of its array argument
+ A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void dorgr2(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGRQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the last M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by DGERQF in the last k rows of its array argument
+ A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorgrq(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors of order N, as returned by
+ DSYTRD:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from DSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from DSYTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DSYTRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSYTRD.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N-1).
+ For optimum performance LWORK >= (N-1)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dorgtr(String uplo, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORM2L overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dorm2l(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORM2R overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dorm2r(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ If VECT = 'Q', DORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': P * C C * P
+ TRANS = 'T': P**T * C C * P**T
+
+ Here Q and P**T are the orthogonal matrices determined by DGEBRD when
+ reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
+
+ P**T are defined as products of elementary reflectors H(i) and G(i)
+ respectively.
+
+ Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
+ order of the orthogonal matrix Q or P**T that is applied.
+
+ If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
+ if nq >= k, Q = H(1) H(2) . . . H(k);
+ if nq < k, Q = H(1) H(2) . . . H(nq-1).
+
+ If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
+ if k < nq, P = G(1) G(2) . . . G(k);
+ if k >= nq, P = G(1) G(2) . . . G(nq-1).
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'Q': apply Q or Q**T;
+ = 'P': apply P or P**T.
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q, Q**T, P or P**T from the Left;
+ = 'R': apply Q, Q**T, P or P**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q or P;
+ = 'T': Transpose, apply Q**T or P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original
+ matrix reduced by DGEBRD.
+ If VECT = 'P', the number of rows in the original
+ matrix reduced by DGEBRD.
+ K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,min(nq,K)) if VECT = 'Q'
+ (LDA,nq) if VECT = 'P'
+ The vectors which define the elementary reflectors H(i) and
+ G(i), whose products determine the matrices Q and P, as
+ returned by DGEBRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If VECT = 'Q', LDA >= max(1,nq);
+ if VECT = 'P', LDA >= max(1,min(nq,K)).
+
+ TAU (input) DOUBLE PRECISION array, dimension (min(nq,K))
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i) which determines Q or P, as returned
+ by DGEBRD in the array argument TAUQ or TAUP.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
+ or P*C or P**T*C or C*P or C*P**T.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param vect
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormbr(String vect, String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMHR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ IHI-ILO elementary reflectors, as returned by DGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of DGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
+ ILO = 1 and IHI = 0, if M = 0;
+ if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
+ ILO = 1 and IHI = 0, if N = 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DGEHRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEHRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormhr(String side, String trans, int m, int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORML2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dorml2(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMLQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormlq(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMQL overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormql(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMQR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormqr(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMR2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dormr2(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMR3 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DTZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DTZRZF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void dormr3(String side, String trans, int m, int n, int k, int l, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMRQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGERQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormrq(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMRZ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ DTZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DTZRZF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormrz(String side, String trans, int m, int n, int k, int l, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DORMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by DSYTRD:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from DSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from DSYTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DSYTRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSYTRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param trans
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dormtr(String side, String uplo, String trans, int m, int n, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite band matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm (or infinity-norm) of the symmetric band matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dpbcon(String uplo, int n, int kd, double[] ab, int ldab, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite band matrix A and reduce its condition
+ number (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular of A is stored;
+ = 'L': Lower triangular of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ S (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) DOUBLE PRECISION
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param s
+ * @param scond
+ * @param amax
+ * @param info
+ */
+ public abstract void dpbequ(String uplo, int n, int kd, double[] ab, int ldab, double[] s, doubleW scond, doubleW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and banded, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ AFB (input) DOUBLE PRECISION array, dimension (LDAFB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A as computed by
+
+ DPBTRF, in the same storage format as A (see AB).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dpbrfs(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBSTF computes a split Cholesky factorization of a real
+ symmetric positive definite band matrix A.
+
+ This routine is designed to be used in conjunction with DSBGST.
+
+ The factorization has the form A = S**T*S where S is a band matrix
+
+ of the same bandwidth as A and the following structure:
+
+ S = ( U )
+ ( M L )
+
+ where U is upper triangular of order m = (n+kd)/2, and L is lower
+ triangular of order n-m.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first kd+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the factor S from the split Cholesky
+ factorization A = S**T*S. See Further Details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the factorization could not be completed,
+ because the updated element a(i,i) was negative; the
+ matrix A is not positive definite.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 7, KD = 2:
+
+ S = ( s11 s12 s13 )
+ ( s22 s23 s24 )
+ ( s33 s34 )
+ ( s44 )
+ ( s53 s54 s55 )
+ ( s64 s65 s66 )
+ ( s75 s76 s77 )
+
+ If UPLO = 'U', the array AB holds:
+
+ on entry: on exit:
+
+ * * a13 a24 a35 a46 a57 * * s13 s24 s53 s64 s75
+
+ * a12 a23 a34 a45 a56 a67 * s12 s23 s34 s54 s65 s76
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+
+ If UPLO = 'L', the array AB holds:
+
+ on entry: on exit:
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+ a21 a32 a43 a54 a65 a76 * s12 s23 s34 s54 s65 s76 *
+ a31 a42 a53 a64 a64 * * s13 s24 s53 s64 s75 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param info
+ */
+ public abstract void dpbstf(String uplo, int n, int kd, double[] ab, int ldab, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix, with the same number of superdiagonals or
+ subdiagonals as A. The factored form of A is then used to solve the
+
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * * a13 a24 a35 a46 * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dpbsv(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AB and AFB will not
+ be modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right-hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array, except
+
+ if FACT = 'F' and EQUED = 'Y', then A must contain the
+ equilibrated matrix diag(S)*A*diag(S). The j-th column of A
+
+ is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ AFB (input or output) DOUBLE PRECISION array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the band matrix
+ A, in the same storage format as A (see AB). If EQUED = 'Y',
+ then AFB is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13
+ a22 a23 a24
+ a33 a34 a35
+ a44 a45 a46
+ a55 a56
+ (aij=conjg(aji)) a66
+
+ Band storage of the upper triangle of A:
+
+ * * a13 a24 a35 a46
+ * a12 a23 a34 a45 a56
+ a11 a22 a33 a44 a55 a66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ a11 a22 a33 a44 a55 a66
+ a21 a32 a43 a54 a65 *
+ a31 a42 a53 a64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param equed
+ * @param s
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dpbsvx(String fact, String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBTF2 computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix, U' is the transpose of U, and
+
+ L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * * a13 a24 a35 a46 * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param info
+ */
+ public abstract void dpbtf2(String uplo, int n, int kd, double[] ab, int ldab, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBTRF computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * * a13 a24 a35 a46 * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ Contributed by
+ Peter Mayes and Giuseppe Radicati, IBM ECSEC, Rome, March 23, 1989
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param info
+ */
+ public abstract void dpbtrf(String uplo, int n, int kd, double[] ab, int ldab, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPBTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite band matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by DPBTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dpbtrs(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dpocon(String uplo, int n, double[] a, int lda, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A and reduce its condition number
+
+ (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The N-by-N symmetric positive definite matrix whose scaling
+ factors are to be computed. Only the diagonal elements of A
+
+ are referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ S (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) DOUBLE PRECISION
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param scond
+ * @param amax
+ * @param info
+ */
+ public abstract void dpoequ(int n, double[] a, int lda, double[] s, doubleW scond, doubleW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPORFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite,
+ and provides error bounds and backward error estimates for the
+ solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPOTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPOTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dporfs(String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dposv(String uplo, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. A and AF will not
+ be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A, except if FACT = 'F' and
+ EQUED = 'Y', then A must contain the equilibrated matrix
+ diag(S)*A*diag(S). If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
+
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A. If EQUED .ne. 'N', then AF is the factored form
+ of the equilibrated matrix diag(S)*A*diag(S).
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the original
+ matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param equed
+ * @param s
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dposvx(String fact, String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTF2 computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dpotf2(String uplo, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the block version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dpotrf(String uplo, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by DPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, as computed by
+ DPOTRF.
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dpotri(String uplo, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPOTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by DPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dpotrs(String uplo, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite packed matrix using
+ the Cholesky factorization A = U**T*U or A = L*L**T computed by
+ DPPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dppcon(String uplo, int n, double[] ap, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A in packed storage and reduce
+ its condition number (with respect to the two-norm). S contains the
+
+ scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
+
+ B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
+ This choice of S puts the condition number of B within a factor N of
+
+ the smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ S (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) DOUBLE PRECISION
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) DOUBLE PRECISION
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param s
+ * @param scond
+ * @param amax
+ * @param info
+ */
+ public abstract void dppequ(String uplo, int n, double[] ap, double[] s, doubleW scond, doubleW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ AFP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by DPPTRF/ZPPTRF,
+ packed columnwise in a linear array in the same format as A
+ (see AP).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dpprfs(String uplo, int n, int nrhs, double[] ap, double[] afp, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dppsv(String uplo, int n, int nrhs, double[] ap, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFP contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AP and AFP will not
+ be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array, except if FACT = 'F'
+
+ and EQUED = 'Y', then A must contain the equilibrated matrix
+
+ diag(S)*A*diag(S). The j-th column of A is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ AFP (input or output) DOUBLE PRECISION array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L', in the same storage
+ format as A. If EQUED .ne. 'N', then AFP is the factored
+ form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the original matrix A.
+
+
+ If FACT = 'E', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the equilibrated
+ matrix A (see the description of AP for the form of the
+ equilibrated matrix).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) DOUBLE PRECISION array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param equed
+ * @param s
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dppsvx(String fact, String uplo, int n, int nrhs, double[] ap, double[] afp, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A stored in packed format.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T, in the same
+
+ storage format as A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ======= =======
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param info
+ */
+ public abstract void dpptrf(String uplo, int n, double[] ap, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by DPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor is stored in AP;
+ = 'L': Lower triangular factor is stored in AP.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, packed columnwise as
+
+ a linear array. The j-th column of U or L is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param info
+ */
+ public abstract void dpptri(String uplo, int n, double[] ap, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPPTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A in packed storage using the Cholesky
+ factorization A = U**T*U or A = L*L**T computed by DPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dpptrs(String uplo, int n, int nrhs, double[] ap, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTCON computes the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite tridiagonal matrix
+ using the factorization A = L*D*L**T or A = U**T*D*U computed by
+ DPTTRF.
+
+ Norm(inv(A)) is computed by a direct method, and the reciprocal of
+ the condition number is computed as
+ RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization of A, as computed by DPTTRF.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) off-diagonal elements of the unit bidiagonal factor
+ U or L from the factorization of A, as computed by DPTTRF.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
+ 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The method used is described in Nicholas J. Higham, "Efficient
+ Algorithms for Computing the Condition Number of a Tridiagonal
+ Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param info
+ */
+ public abstract void dptcon(int n, double[] d, double[] e, double anorm, doubleW rcond, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric positive definite tridiagonal matrix by first factoring the
+ matrix using DPTTRF, and then calling DBDSQR to compute the singular
+
+ values of the bidiagonal factor.
+
+ This routine computes the eigenvalues of the positive definite
+ tridiagonal matrix to high relative accuracy. This means that if the
+ eigenvalues range over many orders of magnitude in size, then the
+ small eigenvalues and corresponding eigenvectors will be computed
+ more accurately than, for example, with the standard QR method.
+
+ The eigenvectors of a full or band symmetric positive definite matrix
+ can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to
+ reduce this matrix to tridiagonal form. (The reduction to tridiagonal
+ form, however, may preclude the possibility of obtaining high
+ relative accuracy in the small eigenvalues of the original matrix, if
+ these eigenvalues range over many orders of magnitude.)
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvectors of original symmetric
+ matrix also. Array Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal
+ matrix.
+ On normal exit, D contains the eigenvalues, in descending
+ order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix used in the
+ reduction to tridiagonal form.
+ On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
+
+ original symmetric matrix;
+ if COMPZ = 'I', the orthonormal eigenvectors of the
+ tridiagonal matrix.
+ If INFO > 0 on exit, Z contains the eigenvectors associated
+ with only the stored eigenvalues.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ COMPZ = 'V' or 'I', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is:
+ <= N the Cholesky factorization of the matrix could
+ not be performed because the i-th principal minor
+ was not positive definite.
+ > N the SVD algorithm failed to converge;
+ if INFO = N+i, i off-diagonal elements of the
+ bidiagonal factor did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dpteqr(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and tridiagonal, and provides error bounds and backward error
+ estimates for the solution.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization computed by DPTTRF.
+
+ EF (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the factorization computed by DPTTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DPTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param df
+ * @param ef
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param info
+ */
+ public abstract void dptrfs(int n, int nrhs, double[] d, double[] e, double[] df, double[] ef, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTSV computes the solution to a real system of linear equations
+ A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
+ matrix, and X and B are N-by-NRHS matrices.
+
+ A is factored as A = L*D*L**T, and the factored form of A is then
+ used to solve the system of equations.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the factorization A = L*D*L**T.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L**T factorization of
+ A. (E can also be regarded as the superdiagonal of the unit
+
+ bidiagonal factor U from the U**T*D*U factorization of A.)
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the solution has not been
+ computed. The factorization has not been completed
+ unless i = N.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dptsv(int n, int nrhs, double[] d, double[] e, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTSVX uses the factorization A = L*D*L**T to compute the solution
+ to a real system of linear equations A*X = B, where A is an N-by-N
+ symmetric positive definite tridiagonal matrix and X and B are
+ N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
+ is a unit lower bidiagonal matrix and D is diagonal. The
+ factorization can also be regarded as having the form
+ A = U**T*D*U.
+
+ 2. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, DF and EF contain the factored form of A.
+ D, E, DF, and EF will not be modified.
+ = 'N': The matrix A will be copied to DF and EF and
+ factored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input or output) DOUBLE PRECISION array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+
+ EF (input or output) DOUBLE PRECISION array, dimension (N-1)
+ If FACT = 'F', then EF is an input argument and on entry
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+ If FACT = 'N', then EF is an output argument and on exit
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal condition number of the matrix A. If RCOND
+ is less than the machine precision (in particular, if
+ RCOND = 0), the matrix is singular to working precision.
+ This condition is indicated by a return code of INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in any
+ element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param df
+ * @param ef
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param info
+ */
+ public abstract void dptsvx(String fact, int n, int nrhs, double[] d, double[] e, double[] df, double[] ef, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTTRF computes the L*D*L' factorization of a real symmetric
+ positive definite tridiagonal matrix A. The factorization may also
+ be regarded as having the form A = U'*D*U.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the L*D*L' factorization of A.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L' factorization of A.
+
+ E can also be regarded as the superdiagonal of the unit
+ bidiagonal factor U from the U'*D*U factorization of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite; if k < N, the factorization could not
+ be completed, while if k = N, the factorization was
+ completed, but D(N) <= 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param info
+ */
+ public abstract void dpttrf(int n, double[] d, double[] e, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTTRS solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by DPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dpttrs(int n, int nrhs, double[] d, double[] e, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DPTTS2 solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by DPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ */
+ public abstract void dptts2(int n, int nrhs, double[] d, double[] e, double[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DRSCL multiplies an n-element real vector x by the real scalar 1/a.
+ This is done without overflow or underflow as long as
+ the final result x/a does not overflow or underflow.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of components of the vector x.
+
+ SA (input) DOUBLE PRECISION
+ The scalar a which is used to divide each component of x.
+ SA must be >= 0, or the subroutine will divide by zero.
+
+ SX (input/output) DOUBLE PRECISION array, dimension
+ (1+(N-1)*abs(INCX))
+ The n-element vector x.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector SX.
+ > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
+
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param sa
+ * @param sx
+ * @param incx
+ */
+ public abstract void drscl(int n, double sa, double[] sx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBEV computes all the eigenvalues and, optionally, eigenvectors of
+ a real symmetric band matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,3*N-2))
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dsbev(String jobz, String uplo, int n, int kd, double[] ab, int ldab, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBEVD computes all the eigenvalues and, optionally, eigenvectors of
+
+ a real symmetric band matrix A. If eigenvectors are desired, it uses
+
+ a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ IF N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 2, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 2, LWORK must be at least
+ ( 1 + 5*N + 2*N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array LIWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dsbevd(String jobz, String uplo, int n, int kd, double[] ab, int ldab, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric band matrix A. Eigenvalues and eigenvectors can
+
+ be selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ, N)
+ If JOBZ = 'V', the N-by-N orthogonal matrix used in the
+ reduction to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'V', then
+ LDQ >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AB to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (7*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param q
+ * @param ldq
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dsbevx(String jobz, String range, String uplo, int n, int kd, double[] ab, int ldab, double[] q, int ldq, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGST reduces a real symmetric-definite banded generalized
+ eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
+ such that C has the same bandwidth as A.
+
+ B must have been previously factorized as S**T*S by DPBSTF, using a
+ split Cholesky factorization. A is overwritten by C = X**T*A*X, where
+ X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the
+ bandwidth of A.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form the transformation matrix X;
+ = 'V': form X.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= KB >= 0.
+
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the transformed matrix X**T*A*X, stored in the same
+
+ format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input) DOUBLE PRECISION array, dimension (LDBB,N)
+ The banded factor S from the split Cholesky factorization of
+
+ B, as returned by DPBSTF, stored in the first KB+1 rows of
+ the array.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,N)
+ If VECT = 'V', the n-by-n matrix X.
+ If VECT = 'N', the array X is not referenced.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X.
+ LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param x
+ * @param ldx
+ * @param work
+ * @param info
+ */
+ public abstract void dsbgst(String vect, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] x, int ldx, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+ and banded, and B is also positive definite.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) DOUBLE PRECISION array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by DPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so that Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dsbgv(String jobz, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of the
+
+ form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and
+
+ banded, and B is also positive definite. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) DOUBLE PRECISION array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by DPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 3*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 5*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if LIWORK > 0, IWORK(1) returns the optimal LIWORK.
+
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dsbgvd(String jobz, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+
+ and banded, and B is also positive definite. Eigenvalues and
+ eigenvectors can be selected by specifying either all eigenvalues,
+ a range of values or a range of indices for the desired eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) DOUBLE PRECISION array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by DPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ, N)
+ If JOBZ = 'V', the n-by-n matrix used in the reduction of
+ A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
+ and consequently C to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'N',
+ LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (7*N)
+
+ IWORK (workspace/output) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvalues that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ < 0 : if INFO = -i, the i-th argument had an illegal value
+ <= N: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in IFAIL.
+ > N : DPBSTF returned an error code; i.e.,
+ if INFO = N + i, for 1 <= i <= N, then the leading
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param q
+ * @param ldq
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dsbgvx(String jobz, String range, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] q, int ldq, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSBTRD reduces a real symmetric band matrix A to symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form Q;
+ = 'V': form Q;
+ = 'U': update a matrix X, by forming X*Q.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ On exit, the diagonal elements of AB are overwritten by the
+ diagonal elements of the tridiagonal matrix T; if KD > 0, the
+ elements on the first superdiagonal (if UPLO = 'U') or the
+ first subdiagonal (if UPLO = 'L') are overwritten by the
+ off-diagonal elements of T; the rest of AB is overwritten by
+
+ values generated during the reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if VECT = 'U', then Q must contain an N-by-N
+ matrix X; if VECT = 'N' or 'V', then Q need not be set.
+
+ On exit:
+ if VECT = 'V', Q contains the N-by-N orthogonal matrix Q;
+ if VECT = 'U', Q contains the product X*Q;
+ if VECT = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Modified by Linda Kaufman, Bell Labs.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param d
+ * @param e
+ * @param q
+ * @param ldq
+ * @param work
+ * @param info
+ */
+ public abstract void dsbtrd(String vect, String uplo, int n, int kd, double[] ab, int ldab, double[] d, double[] e, double[] q, int ldq, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ DSGESV first attempts to factorize the matrix in SINGLE PRECISION
+ and use this factorization within an iterative refinement procedure t
+ produce a solution with DOUBLE PRECISION normwise backward error
+ quality (see below). If the approach fails the method switches to a
+ DOUBLE PRECISION factorization and solve.
+
+ The iterative refinement is not going to be a winning strategy if
+ the ratio SINGLE PRECISION performance over DOUBLE PRECISION performa
+ is too small. A reasonable strategy should take the number of right-h
+ sides and the size of the matrix into account. This might be done wit
+ call to ILAENV in the future. Up to now, we always try iterative refi
+
+ The iterative refinement process is stopped if
+ ITER > ITERMAX
+ or for all the RHS we have:
+ RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX
+ where
+ o ITER is the number of the current iteration in the iterative
+ refinement process
+ o RNRM is the infinity-norm of the residual
+ o XNRM is the infinity-norm of the solution
+ o ANRM is the infinity-operator-norm of the matrix A
+ o EPS is the machine epsilon returned by DLAMCH('Epsilon')
+ The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 respectively
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input or input/ouptut) DOUBLE PRECISION array,
+ dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, if iterative refinement has been successfully used
+ (INFO.EQ.0 and ITER.GE.0, see description below), then A is
+ unchanged, if double precision factorization has been used
+ (INFO.EQ.0 and ITER.LT.0, see description below), then the
+ array A contains the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+ Corresponds either to the single precision factorization
+ (if INFO.EQ.0 and ITER.GE.0) or the double precision
+ factorization (if INFO.EQ.0 and ITER.LT.0).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS matrix of right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N*NRHS)
+ This array is used to hold the residual vectors.
+
+ SWORK (workspace) REAL array, dimension (N*(N+NRHS))
+ This array is used to use the single precision matrix and the
+ right-hand sides or solutions in single precision.
+
+ ITER (output) INTEGER
+ < 0: iterative refinement has failed, double precision
+ factorization has been performed
+ -1 : taking into account machine parameters, N, NRHS, it
+ is a priori not worth working in SINGLE PRECISION
+ -2 : overflow of an entry when moving from double to
+ SINGLE PRECISION
+ -3 : failure of SGETRF
+ -31: stop the iterative refinement after the 30th
+ iterations
+ > 0: iterative refinement has been sucessfully used.
+ Returns the number of iterations
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) computed in DOUBLE PRECISION is
+ exactly zero. The factorization has been completed,
+ but the factor U is exactly singular, so the solution
+ could not be computed.
+
+ =========
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param work
+ * @param swork
+ * @param iter
+ * @param info
+ */
+ public void dsgesv(int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] work, float[] swork, intW iter, intW info) {
+ org.netlib.lapack.Dsgesv.dsgesv(n, nrhs, a, 0, lda, ipiv, 0, b, 0, ldb, x, 0, ldx, work, 0, swork, 0, iter, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric packed matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by DSPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dspcon(String uplo, int n, double[] ap, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPEV computes all the eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A in packed storage.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dspev(String jobz, String uplo, int n, double[] ap, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPEVD computes all the eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dspevd(String jobz, String uplo, int n, double[] ap, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. Eigenvalues/vectors
+
+ can be selected by specifying either a range of values or a range of
+
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AP to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the selected eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dspevx(String jobz, String range, String uplo, int n, double[] ap, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form, using packed storage.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by DPPTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ BP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The triangular factor from the Cholesky factorization of B,
+ stored in the same format as A, as returned by DPPTRF.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param info
+ */
+ public abstract void dspgst(int itype, String uplo, int n, double[] ap, double[] bp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGV computes all the eigenvalues and, optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric, stored in packed format,
+ and B is also positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension
+ (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPPTRF or DSPEV returned an error code:
+ <= N: if INFO = i, DSPEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero.
+ > N: if INFO = n + i, for 1 <= i <= n, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dspgv(int itype, String jobz, String uplo, int n, double[] ap, double[] bp, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric, stored in packed format, and B is also
+ positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPPTRF or DSPEVD returned an error code:
+ <= N: if INFO = i, DSPEVD failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dspgvd(int itype, String jobz, String uplo, int n, double[] ap, double[] bp, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric, stored in packed storage, and B
+ is also positive definite. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPPTRF or DSPEVX returned an error code:
+ <= N: if INFO = i, DSPEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dspgvx(int itype, String jobz, String range, String uplo, int n, double[] ap, double[] bp, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ AFP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The factored form of the matrix A. AFP contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by DSPTRF, stored as a packed
+ triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DSPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dsprfs(String uplo, int n, int nrhs, double[] ap, double[] afp, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix stored in packed format and X
+ and B are N-by-NRHS matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, D is symmetric and block diagonal with 1-by-1
+ and 2-by-2 diagonal blocks. The factored form of A is then used to
+ solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by DSPTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, so the solution could not be
+ computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dspsv(String uplo, int n, int nrhs, double[] ap, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPSVX uses the diagonal pivoting factorization A = U*D*U**T or
+ A = L*D*L**T to compute the solution to a real system of linear
+ equations A * X = B, where A is an N-by-N symmetric matrix stored
+ in packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AFP and IPIV contain the factored form of
+ A. AP, AFP and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ See below for further details.
+
+ AFP (input or output) DOUBLE PRECISION array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSPTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSPTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dspsvx(String fact, String uplo, int n, int nrhs, double[] ap, double[] afp, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRD reduces a real symmetric matrix A stored in packed form to
+ symmetric tridiagonal form T by an orthogonal similarity
+ transformation: Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
+ overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
+ overwriting A(i+2:n,i), and tau is stored in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param d
+ * @param e
+ * @param tau
+ * @param info
+ */
+ public abstract void dsptrd(String uplo, int n, double[] ap, double[] d, double[] e, double[] tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRF computes the factorization of a real symmetric matrix A stored
+ in packed format using the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L, stored as a packed triangular
+ matrix overwriting A (see below for further details).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 5-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dsptrf(String uplo, int n, double[] ap, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRI computes the inverse of a real symmetric indefinite matrix
+ A in packed storage using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by DSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by DSPTRF,
+ stored as a packed triangular matrix.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix, stored as a packed triangular matrix. The j-th column
+ of inv(A) is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = inv(A)(i,j) for 1<=i<=j;
+ if UPLO = 'L',
+ AP(i + (j-1)*(2n-j)/2) = inv(A)(i,j) for j<=i<=n.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param ipiv
+ * @param work
+ * @param info
+ */
+ public abstract void dsptri(String uplo, int n, double[] ap, int[] ipiv, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSPTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A stored in packed format using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by DSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSPTRF.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dsptrs(String uplo, int n, int nrhs, double[] ap, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEBZ computes the eigenvalues of a symmetric tridiagonal
+ matrix T. The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER*1
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER*1
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute tolerance for the eigenvalues. An eigenvalue
+ (or cluster) is considered to be located if it has been
+ determined to lie in an interval whose width is ABSTOL or
+ less. If ABSTOL is less than or equal to zero, then ULP*|T|
+
+ will be used, where |T| means the 1-norm of T.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ NSPLIT (output) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalues. (DSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (DSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ RELFAC DOUBLE PRECISION, default = 2.0e0
+ The relative tolerance. An interval (a,b] lies within
+ "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|),
+ where "ulp" is the machine precision (distance from 1 to
+ the next larger floating point number.)
+
+ FUDGE DOUBLE PRECISION, default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param range
+ * @param order
+ * @param n
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param d
+ * @param e
+ * @param m
+ * @param nsplit
+ * @param w
+ * @param iblock
+ * @param isplit
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dstebz(String range, String order, int n, double vl, double vu, int il, int iu, double abstol, double[] d, double[] e, intW m, intW nsplit, double[] w, int[] iblock, int[] isplit, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEDC computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+ The eigenvectors of a full or band real symmetric matrix can also be
+
+ found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLAED3 for details.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+ = 'V': Compute eigenvectors of original dense symmetric
+ matrix also. On entry, Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the subdiagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 3*N + 2*N*lg N + 3*N**2 ),
+ where lg( N ) = smallest integer k such
+ that 2**k >= N.
+ If COMPZ = 'I' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LWORK need
+ only be max(1,2*(N-1)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LIWORK must be at least
+ ( 6 + 6*N + 5*N*lg N ).
+ If COMPZ = 'I' and N > 1 then LIWORK must be at least
+ ( 3 + 5*N ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LIWORK
+ need only be 1.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dstedc(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEGR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ DSTEGR is a compatability wrapper around the improved DSTEMR routine.
+ See DSTEMR for further details.
+
+ One important change is that the ABSTOL parameter no longer provides
+ benefit and hence is no longer used.
+
+ Note : DSTEGR and DSTEMR work only on machines which follow
+ IEEE-754 floating-point standard in their handling of infinities and
+
+ NaNs. Normal execution may create these exceptiona values and hence
+
+ may abort due to a floating point exception in environments which
+ do not conform to the IEEE-754 standard.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ Unused. Was the absolute error tolerance for the
+ eigenvalues/eigenvectors in previous versions.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in DLARRE,
+ if INFO = 2X, internal error in DLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by DLARRE or
+ DLARRV, respectively.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dstegr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEIN computes the eigenvectors of a real symmetric tridiagonal
+ matrix T corresponding to specified eigenvalues, using inverse
+ iteration.
+
+ The maximum number of iterations allowed for each eigenvector is
+ specified by an internal parameter MAXITS (currently set to 5).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix
+ T, in elements 1 to N-1.
+
+ M (input) INTEGER
+ The number of eigenvectors to be found. 0 <= M <= N.
+
+ W (input) DOUBLE PRECISION array, dimension (N)
+ The first M elements of W contain the eigenvalues for
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block. ( The output array
+ W from DSTEBZ with ORDER = 'B' is expected here. )
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The submatrix indices associated with the corresponding
+ eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to
+ the first submatrix from the top, =2 if W(i) belongs to
+ the second submatrix, etc. ( The output array IBLOCK
+ from DSTEBZ is expected here. )
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+ ( The output array ISPLIT from DSTEBZ is expected here. )
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, M)
+ The computed eigenvectors. The eigenvector associated
+ with the eigenvalue W(i) is stored in the i-th column of
+ Z. Any vector which fails to converge is set to its current
+
+ iterate after MAXITS iterations.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ On normal exit, all elements of IFAIL are zero.
+ If one or more eigenvectors fail to converge after
+ MAXITS iterations, then their indices are stored in
+ array IFAIL.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge
+ in MAXITS iterations. Their indices are stored in
+ array IFAIL.
+
+ Internal Parameters
+ ===================
+
+ MAXITS INTEGER, default = 5
+ The maximum number of iterations performed.
+
+ EXTRA INTEGER, default = 2
+ The number of iterations performed after norm growth
+ criterion is satisfied, should be at least 1.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param m
+ * @param w
+ * @param iblock
+ * @param isplit
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dstein(int n, double[] d, double[] e, int m, double[] w, int[] iblock, int[] isplit, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEMR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ Depending on the number of desired eigenvalues, these are computed ei
+ by bisection or the dqds algorithm. Numerically orthogonal eigenvecto
+ computed by the use of various suitable L D L^T factorizations near c
+ of close eigenvalues (referred to as RRRs, Relatively Robust
+ Representations). An informal sketch of the algorithm follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ For more details, see:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+ Notes:
+ 1.DSTEMR works only on machines which follow IEEE-754
+ floating-point standard in their handling of infinities and NaNs.
+ This permits the use of efficient inner loops avoiding a check for
+ zero divisors.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and can be computed with a workspace
+
+ query by setting NZC = -1, see below.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ NZC (input) INTEGER
+ The number of eigenvectors to be held in the array Z.
+ If RANGE = 'A', then NZC >= max(1,N).
+ If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,
+ If RANGE = 'I', then NZC >= IU-IL+1.
+ If NZC = -1, then a workspace query is assumed; the
+ routine calculates the number of columns of the array Z that
+
+ are needed to hold the eigenvectors.
+ This value is returned as the first entry of the Z array, and
+ no error message related to NZC is issued by XERBLA.
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ TRYRAC (input/output) LOGICAL
+ If TRYRAC.EQ..TRUE., indicates that the code should check whe
+ the tridiagonal matrix defines its eigenvalues to high relati
+ accuracy. If so, the code uses relative-accuracy preserving
+
+ algorithms that might be (a bit) slower depending on the matr
+ If the matrix does not define its eigenvalues to high relativ
+ accuracy, the code can uses possibly faster algorithms.
+ If TRYRAC.EQ..FALSE., the code is not required to guarantee
+ relatively accurate eigenvalues and can use the fastest possi
+ techniques.
+ On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix
+ does not define its eigenvalues to high relative accuracy.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in DLARRE,
+ if INFO = 2X, internal error in DLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by DLARRE or
+ DLARRV, respectively.
+
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param nzc
+ * @param isuppz
+ * @param tryrac
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public void dstemr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, intW m, double[] w, double[] z, int ldz, int nzc, int[] isuppz, booleanW tryrac, double[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Dstemr.dstemr(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, m, w, 0, z, 0, ldz, nzc, isuppz, 0, tryrac, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the implicit QL or QR method.
+ The eigenvectors of a full or band symmetric matrix can also be found
+ if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to
+
+ tridiagonal form.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvalues and eigenvectors of the original
+
+ symmetric matrix. On entry, Z must contain the
+ orthogonal matrix used to reduce the original matrix
+
+ to tridiagonal form.
+ = 'I': Compute eigenvalues and eigenvectors of the
+ tridiagonal matrix. Z is initialized to the identity
+ matrix.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
+
+ If COMPZ = 'N', then WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm has failed to find all the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero; on exit, D
+ and E contain the elements of a symmetric tridiagonal
+ matrix which is orthogonally similar to the original
+ matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dsteqr(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
+ using the Pal-Walker-Kahan variant of the QL or QR algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix.
+
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed to find all of the eigenvalues in
+
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param info
+ */
+ public abstract void dsterf(int n, double[] d, double[] e, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
+
+ If JOBZ = 'N', WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void dstev(String jobz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix. If eigenvectors are desired, it
+ uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
+
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dstevd(String jobz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Whenever possible, DSTEVR calls DSTEMR to compute the
+ eigenspectrum using Relatively Robust Representations. DSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows. For the i-th
+ unreduced block of T,
+ (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T
+ is a relatively robust representation,
+ (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high
+ relative accuracy by the dqds algorithm,
+ (c) If there is a cluster of close eigenvalues, "choose" sigma_i
+ close to the cluster, and go to step (a),
+ (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T,
+ compute the corresponding eigenvector by forming a
+ rank-revealing twisted factorization.
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon,
+ Computer Science Division Technical Report No. UCB//CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of DSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+********* For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
+********* DSTEIN are called
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) DOUBLE PRECISION array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ DLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+********* Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal (and
+ minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,20*N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal (and
+ minimal) LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dstevr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSTEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix A. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) DOUBLE PRECISION array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less
+ than or equal to zero, then EPS*|T| will be used in
+ its place, where |T| is the 1-norm of the tridiagonal
+ matrix.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge (INFO > 0), then that
+ column of Z contains the latest approximation to the
+ eigenvector, and the index of the eigenvector is returned
+ in IFAIL. If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dstevx(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by DSYTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ ANORM (input) DOUBLE PRECISION
+ The 1-norm of the original matrix A.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dsycon(String uplo, int n, double[] a, int lda, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for DSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param w
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dsyev(String jobz, String uplo, int n, double[] a, int lda, double[] w, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A. If eigenvectors are desired, it uses a
+ divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Because of large use of BLAS of level 3, DSYEVD needs N**2 more
+ workspace than DSYEVX.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i and JOBZ = 'N', then the algorithm failed
+ to converge; i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ if INFO = i and JOBZ = 'V', then the algorithm failed
+ to compute an eigenvalue while working on the submatrix
+ lying in rows and columns INFO/(N+1) through
+ mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ Modified description of INFO. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param w
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dsyevd(String jobz, String uplo, int n, double[] a, int lda, double[] w, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ DSYEVR first reduces the matrix A to tridiagonal form T with a call
+ to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute
+ the eigenspectrum using Relatively Robust Representations. DSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see DSTEMR's documentation and:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : DSYEVR calls DSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ DSYEVR calls DSTEBZ and SSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of DSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+********* For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
+********* DSTEIN are called
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ DLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+********* Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,26*N).
+ For optimal efficiency, LWORK >= (NB+6)*N,
+ where NB is the max of the blocksize for DSYTRD and DORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+ Jason Riedy, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dsyevr(String jobz, String range, String uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= 1, when N <= 1;
+ otherwise 8*N.
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the max of the blocksize for DSYTRD and DORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dsyevx(String jobz, String range, String uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGS2 reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U')*A*inv(U) or inv(L)*A*inv(L')
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U` or L'*A*L.
+
+ B must have been previously factorized as U'*U or L*L' by DPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U')*A*inv(U) or inv(L)*A*inv(L');
+ = 2 or 3: compute U*A*U' or L'*A*L.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored, and how B has been factorized.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by DPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dsygs2(int itype, String uplo, int n, double[] a, int lda, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by DPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by DPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dsygst(int itype, String uplo, int n, double[] a, int lda, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric and B is also
+ positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the symmetric positive definite matrix B.
+ If UPLO = 'U', the leading N-by-N upper triangular part of B
+
+ contains the upper triangular part of the matrix B.
+ If UPLO = 'L', the leading N-by-N lower triangular part of B
+
+ contains the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for DSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPOTRF or DSYEV returned an error code:
+ <= N: if INFO = i, DSYEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param w
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dsygv(int itype, String jobz, String uplo, int n, double[] a, int lda, double[] b, int ldb, double[] w, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric and B is also positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK >= 1.
+ If JOBZ = 'N' and N > 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPOTRF or DSYEVD returned an error code:
+ <= N: if INFO = i and JOBZ = 'N', then the algorithm
+ failed to converge; i off-diagonal elements of an
+ intermediate tridiagonal form did not converge to
+ zero;
+ if INFO = i and JOBZ = 'V', then the algorithm
+ failed to compute an eigenvalue while working on
+ the submatrix lying in rows and columns INFO/(N+1)
+
+ through mod(INFO,N+1);
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ Modified so that no backsubstitution is performed if DSYEVD fails to
+
+ converge (NEIG in old code could be greater than N causing out of
+ bounds reference to A - reported by Ralf Meyer). Also corrected the
+
+ description of INFO and the test on ITYPE. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param w
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dsygvd(int itype, String jobz, String uplo, int n, double[] a, int lda, double[] b, int ldb, double[] w, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric and B is also positive definite.
+ Eigenvalues and eigenvectors can be selected by specifying either a
+ range of values or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) DOUBLE PRECISION
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*DLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,8*N).
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the blocksize for DSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: DPOTRF or DSYEVX returned an error code:
+ <= N: if INFO = i, DSYEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void dsygvx(int itype, String jobz, String range, String uplo, int n, double[] a, int lda, double[] b, int ldb, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite, and
+ provides error bounds and backward error estimates for the solution.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
+ The factored form of the matrix A. AF contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by DSYTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by DSYTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dsyrfs(String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
+ used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the block diagonal matrix D and the
+ multipliers used to obtain the factor U or L from the
+ factorization A = U*D*U**T or A = L*D*L**T as computed by
+ DSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by DSYTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= 1, and for best performance
+ LWORK >= max(1,N*NB), where NB is the optimal blocksize for
+ DSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dsysv(String uplo, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYSVX uses the diagonal pivoting factorization to compute the
+ solution to a real system of linear equations A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A.
+ The form of the factorization is
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AF and IPIV contain the factored form of
+ A. AF and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
+
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by DSYTRF.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the block diagonal matrix D and the multipliers used
+
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSYTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by DSYTRF.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= max(1,3*N), and for best
+ performance, when FACT = 'N', LWORK >= max(1,3*N,N*NB), where
+ NB is the optimal blocksize for DSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dsysvx(String fact, String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
+ form T by an orthogonal similarity transformation: Q' * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tau
+ * @param info
+ */
+ public abstract void dsytd2(String uplo, int n, double[] a, int lda, double[] d, double[] e, double[] tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTF2 computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U' or A = L*D*L'
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, U' is the transpose of U, and D is symmetric and
+ block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 09-29-06 - patch from
+ Bobby Cheng, MathWorks
+
+ Replace l.204 and l.372
+ IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+ by
+ IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
+
+ 01-01-96 - Based on modifications by
+ J. Lewis, Boeing Computer Services Company
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ 1-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param info
+ */
+ public abstract void dsytf2(String uplo, int n, double[] a, int lda, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRD reduces a real symmetric matrix A to real symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dsytrd(String uplo, int n, double[] a, int lda, double[] d, double[] e, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRF computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method. The form of the
+ factorization is
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >=1. For best performance
+ LWORK >= N*NB, where NB is the block size returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, and division by zero will occur if it
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dsytrf(String uplo, int n, double[] a, int lda, int[] ipiv, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRI computes the inverse of a real symmetric indefinite matrix
+ A using the factorization A = U*D*U**T or A = L*D*L**T computed by
+ DSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by DSYTRF.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix. If UPLO = 'U', the upper triangular part of the
+ inverse is formed and the part of A below the diagonal is not
+ referenced; if UPLO = 'L' the lower triangular part of the
+ inverse is formed and the part of A above the diagonal is
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param work
+ * @param info
+ */
+ public abstract void dsytri(String uplo, int n, double[] a, int lda, int[] ipiv, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DSYTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by DSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by DSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by DSYTRF.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dsytrs(String uplo, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBCON estimates the reciprocal of the condition number of a
+ triangular band matrix A, in either the 1-norm or the infinity-norm.
+
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtbcon(String norm, String uplo, String diag, int n, int kd, double[] ab, int ldab, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular band
+ coefficient matrix.
+
+ The solution matrix X must be computed by DTBTRS or some other
+ means before entering this routine. DTBRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtbrfs(String uplo, String trans, String diag, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTBTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular band matrix of order N, and B is an
+ N-by NRHS matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dtbtrs(String uplo, String trans, String diag, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ DTGEVC computes some or all of the right and/or left eigenvectors of
+
+ a pair of real matrices (S,P), where S is a quasi-triangular matrix
+ and P is upper triangular. Matrix pairs of this type are produced by
+ the generalized Schur factorization of a matrix pair (A,B):
+
+ A = Q*S*Z**T, B = Q*P*Z**T
+
+ as computed by DGGHRD + DHGEQZ.
+
+ The right eigenvector x and the left eigenvector y of (S,P)
+ corresponding to an eigenvalue w are defined by:
+
+ S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+
+ where y**H denotes the conjugate tranpose of y.
+ The eigenvalues are not input to this routine, but are computed
+ directly from the diagonal blocks of S and P.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+ where Z and Q are input matrices.
+ If Q and Z are the orthogonal factors from the generalized Schur
+ factorization of a matrix pair (A,B), then Z*X and Q*Y
+ are the matrices of right and left eigenvectors of (A,B).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ specified by the logical array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY='S', SELECT specifies the eigenvectors to be
+ computed. If w(j) is a real eigenvalue, the corresponding
+ real eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector
+ is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+ and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+ set to .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrices S and P. N >= 0.
+
+ S (input) DOUBLE PRECISION array, dimension (LDS,N)
+ The upper quasi-triangular matrix S from a generalized Schur
+
+ factorization, as computed by DHGEQZ.
+
+ LDS (input) INTEGER
+ The leading dimension of array S. LDS >= max(1,N).
+
+ P (input) DOUBLE PRECISION array, dimension (LDP,N)
+ The upper triangular matrix P from a generalized Schur
+ factorization, as computed by DHGEQZ.
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+ of S must be in positive diagonal form.
+
+ LDP (input) INTEGER
+ The leading dimension of array P. LDP >= max(1,N).
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of left Schur vectors returned by DHGEQZ).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
+
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
+
+ SELECT, stored consecutively in the columns of
+ VL, in the same order as their eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Z (usually the orthogonal matrix Z
+ of right Schur vectors returned by DHGEQZ).
+
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+ if HOWMNY = 'B' or 'b', the matrix Z*X;
+ if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+ specified by SELECT, stored consecutively in the
+
+ columns of VR, in the same order as their
+ eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
+ is set to N. Each selected real eigenvector occupies one
+ column and each selected complex eigenvector occupies two
+ columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (6*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the 2-by-2 block (INFO:INFO+1) does not have a complex
+
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Allocation of workspace:
+ ---------- -- ---------
+
+ WORK( j ) = 1-norm of j-th column of A, above the diagonal
+ WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
+ WORK( 2*N+1:3*N ) = real part of eigenvector
+ WORK( 3*N+1:4*N ) = imaginary part of eigenvector
+ WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
+ WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
+
+ Rowwise vs. columnwise solution methods:
+ ------- -- ---------- -------- -------
+
+ Finding a generalized eigenvector consists basically of solving the
+ singular triangular system
+
+ (A - w B) x = 0 (for right) or: (A - w B)**H y = 0 (for left)
+
+ Consider finding the i-th right eigenvector (assume all eigenvalues
+ are real). The equation to be solved is:
+ n i
+ 0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. . .,1
+ k=j k=j
+
+ where C = (A - w B) (The components v(i+1:n) are 0.)
+
+ The "rowwise" method is:
+
+ (1) v(i) := 1
+ for j = i-1,. . .,1:
+ i
+ (2) compute s = - sum C(j,k) v(k) and
+ k=j+1
+
+ (3) v(j) := s / C(j,j)
+
+ Step 2 is sometimes called the "dot product" step, since it is an
+ inner product between the j-th row and the portion of the eigenvector
+ that has been computed so far.
+
+ The "columnwise" method consists basically in doing the sums
+ for all the rows in parallel. As each v(j) is computed, the
+ contribution of v(j) times the j-th column of C is added to the
+ partial sums. Since FORTRAN arrays are stored columnwise, this has
+ the advantage that at each step, the elements of C that are accessed
+
+ are adjacent to one another, whereas with the rowwise method, the
+ elements accessed at a step are spaced LDS (and LDP) words apart.
+
+ When finding left eigenvectors, the matrix in question is the
+ transpose of the one in storage, so the rowwise method then
+ actually accesses columns of A and B at each step, and so is the
+ preferred method.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param howmny
+ * @param select
+ * @param n
+ * @param s
+ * @param lds
+ * @param p
+ * @param ldp
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param mm
+ * @param m
+ * @param work
+ * @param info
+ */
+ public abstract void dtgevc(String side, String howmny, boolean[] select, int n, double[] s, int lds, double[] p, int ldp, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
+ of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
+ (A, B) by an orthogonal equivalence transformation.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION arrays, dimensions (LDA,N)
+ On entry, the matrix A in the pair (A, B).
+ On exit, the updated matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION arrays, dimensions (LDB,N)
+ On entry, the matrix B in the pair (A, B).
+ On exit, the updated matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ Not referenced if WANTQ = .FALSE..
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ Not referenced if WANTZ = .FALSE..
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ J1 (input) INTEGER
+ The index to the first block (A11, B11). 1 <= J1 <= N.
+
+ N1 (input) INTEGER
+ The order of the first block (A11, B11). N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block (A22, B22). N2 = 0, 1 or 2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX( 1, N*(N2+N1), (N2+N1)*(N2+N1)*2 )
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ >0: If INFO = 1, the transformed matrix (A, B) would be
+ too far from generalized Schur form; the blocks are
+ not swapped and (A, B) and (Q, Z) are unchanged.
+ The problem of swapping is too ill-conditioned.
+ <0: If INFO = -16: LWORK is too small. Appropriate value
+ for LWORK is returned in WORK(1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ In the current code both weak and strong stability tests are
+ performed. The user can omit the strong stability test by changing
+ the internal logical parameter WANDS to .FALSE.. See ref. [2] for
+ details.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ =====================================================================
+ Replaced various illegal calls to DCOPY by calls to DLASET, or by DO
+
+ loops. Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+ * @param wantq
+ * @param wantz
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param j1
+ * @param n1
+ * @param n2
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dtgex2(boolean wantq, boolean wantz, int n, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, int j1, int n1, int n2, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGEXC reorders the generalized real Schur decomposition of a real
+ matrix pair (A,B) using an orthogonal equivalence transformation
+
+ (A, B) = Q * (A, B) * Z',
+
+ so that the diagonal block of (A, B) with row index IFST is moved
+ to row ILST.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the matrix A in generalized real Schur canonical
+ form.
+ On exit, the updated matrix A, again in generalized
+ real Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the matrix B in generalized real Schur canonical
+ form (A,B).
+ On exit, the updated matrix B, again in generalized
+ real Schur canonical form (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of (A, B).
+ The block with row index IFST is moved to row ILST, by a
+ sequence of swapping between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of
+ a 2-by-2 block, it is changed to point to the first row;
+ ILST always points to the first row of the block in its
+ final position (which may differ from its input value by
+ +1 or -1). 1 <= IFST, ILST <= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: successful exit.
+ <0: if INFO = -i, the i-th argument had an illegal value.
+ =1: The transformed matrix pair (A, B) would be too far
+ from generalized Schur form; the problem is ill-
+ conditioned. (A, B) may have been partially reordered,
+
+ and ILST points to the first row of the current
+ position of the block being moved.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param wantq
+ * @param wantz
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param ifst
+ * @param ilst
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dtgexc(boolean wantq, boolean wantz, int n, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, intW ifst, intW ilst, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSEN reorders the generalized real Schur decomposition of a real
+ matrix pair (A, B) (in terms of an orthonormal equivalence trans-
+ formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
+ appears in the leading diagonal blocks of the upper quasi-triangular
+
+ matrix A and the upper triangular B. The leading columns of Q and
+ Z form orthonormal bases of the corresponding left and right eigen-
+ spaces (deflating subspaces). (A, B) must be in generalized real
+ Schur canonical form (as returned by DGGES), i.e. A is block upper
+ triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
+ triangular.
+
+ DTGSEN also computes the generalized eigenvalues
+
+ w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
+
+ of the reordered matrix pair (A, B).
+
+ Optionally, DTGSEN computes the estimates of reciprocal condition
+ numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
+ (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
+ between the matrix pairs (A11, B11) and (A22,B22) that correspond to
+
+ the selected cluster and the eigenvalues outside the cluster, resp.,
+
+ and norms of "projections" onto left and right eigenspaces w.r.t.
+ the selected cluster in the (1,1)-block.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (PL and PR) or the deflating subspaces
+ (Difu and Difl):
+ =0: Only reorder w.r.t. SELECT. No extras.
+ =1: Reciprocal of norms of "projections" onto left and right
+ eigenspaces w.r.t. the selected cluster (PL and PR).
+ =2: Upper bounds on Difu and Difl. F-norm-based estimate
+ (DIF(1:2)).
+ =3: Estimate of Difu and Difl. 1-norm-based estimate
+ (DIF(1:2)).
+ About 5 times as expensive as IJOB = 2.
+ =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
+ version to get it all.
+ =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster.
+ To select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension(LDA,N)
+ On entry, the upper quasi-triangular matrix A, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, A is overwritten by the reordered matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension(LDB,N)
+ On entry, the upper triangular matrix B, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, B is overwritten by the reordered matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+ ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real generalized Schur form of (A,B) were further reduced
+ to triangular form using complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
+ On exit, Q has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Q form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1;
+ and if WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
+ On exit, Z has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Z form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1;
+ If WANTZ = .TRUE., LDZ >= N.
+
+ M (output) INTEGER
+ The dimension of the specified pair of left and right eigen-
+
+ spaces (deflating subspaces). 0 <= M <= N.
+
+ PL (output) DOUBLE PRECISION
+ PR (output) DOUBLE PRECISION
+ If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
+ reciprocal of the norm of "projections" onto left and right
+ eigenspaces with respect to the selected cluster.
+ 0 < PL, PR <= 1.
+ If M = 0 or M = N, PL = PR = 1.
+ If IJOB = 0, 2 or 3, PL and PR are not referenced.
+
+ DIF (output) DOUBLE PRECISION array, dimension (2).
+ If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
+
+ If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
+ Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
+ estimates of Difu and Difl.
+ If M = 0 or N, DIF(1:2) = F-norm([A, B]).
+ If IJOB = 0 or 1, DIF is not referenced.
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 4*N+16.
+ If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
+ If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ IF IJOB = 0, IWORK is not referenced. Otherwise,
+ on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= 1.
+ If IJOB = 1, 2 or 4, LIWORK >= N+6.
+ If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: Successful exit.
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ =1: Reordering of (A, B) failed because the transformed
+ matrix pair (A, B) would be too far from generalized
+ Schur form; the problem is very ill-conditioned.
+ (A, B) may have been partially reordered.
+ If requested, 0 is returned in DIF(*), PL and PR.
+
+ Further Details
+ ===============
+
+ DTGSEN first collects the selected eigenvalues by computing
+ orthogonal U and W that move them to the top left corner of (A, B).
+ In other words, the selected eigenvalues are the eigenvalues of
+ (A11, B11) in:
+
+ U'*(A, B)*W = (A11 A12) (B11 B12) n1
+ ( 0 A22),( 0 B22) n2
+ n1 n2 n1 n2
+
+ where N = n1+n2 and U' means the transpose of U. The first n1 columns
+ of U and W span the specified pair of left and right eigenspaces
+ (deflating subspaces) of (A, B).
+
+ If (A, B) has been obtained from the generalized real Schur
+ decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
+ reordered generalized real Schur form of (C, D) is given by
+
+ (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
+
+ and the first n1 columns of Q*U and Z*W span the corresponding
+ deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
+
+ Note that if the selected eigenvalue is sufficiently ill-conditioned,
+ then its value may differ significantly from its value before
+ reordering.
+
+ The reciprocal condition numbers of the left and right eigenspaces
+ spanned by the first n1 columns of U and W (or Q*U and Z*W) may
+ be returned in DIF(1:2), corresponding to Difu and Difl, resp.
+
+ The Difu and Difl are defined as:
+
+ Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
+ and
+ Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
+
+ where sigma-min(Zu) is the smallest singular value of the
+ (2*n1*n2)-by-(2*n1*n2) matrix
+
+ Zu = [ kron(In2, A11) -kron(A22', In1) ]
+ [ kron(In2, B11) -kron(B22', In1) ].
+
+ Here, Inx is the identity matrix of size nx and A22' is the
+ transpose of A22. kron(X, Y) is the Kronecker product between
+ the matrices X and Y.
+
+ When DIF(2) is small, small changes in (A, B) can cause large changes
+ in the deflating subspace. An approximate (asymptotic) bound on the
+ maximum angular error in the computed deflating subspaces is
+
+ EPS * norm((A, B)) / DIF(2),
+
+ where EPS is the machine precision.
+
+ The reciprocal norm of the projectors on the left and right
+ eigenspaces associated with (A11, B11) may be returned in PL and PR.
+
+ They are computed as follows. First we compute L and R so that
+ P*(A, B)*Q is block diagonal, where
+
+ P = ( I -L ) n1 Q = ( I R ) n1
+ ( 0 I ) n2 and ( 0 I ) n2
+ n1 n2 n1 n2
+
+ and (L, R) is the solution to the generalized Sylvester equation
+
+ A11*R - L*A22 = -A12
+ B11*R - L*B22 = -B12
+
+ Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / PL.
+
+ There are also global error bounds which valid for perturbations up
+ to a certain restriction: A lower bound (x) on the smallest
+ F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
+ coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
+ (i.e. (A + E, B + F), is
+
+ x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
+
+
+ An approximate bound on x can be computed from DIF(1:2), PL and PR.
+
+ If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
+ (L', R') and unperturbed (L, R) left and right deflating subspaces
+ associated with the selected cluster in the (1,1)-blocks can be
+ bounded as
+
+ max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
+
+ max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
+
+
+ See LAPACK User's Guide section 4.11 or the following references
+ for more information.
+
+ Note that if the default method for computing the Frobenius-norm-
+ based estimate DIF is not wanted (see DLATDF), then the parameter
+ IDIFJB (see below) should be changed from 3 to 4 (routine DLATDF
+ (IJOB = 2 will be used)). See DTGSYL for more details.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
+ 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param ijob
+ * @param wantq
+ * @param wantz
+ * @param select
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param m
+ * @param pl
+ * @param pr
+ * @param dif
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dtgsen(int ijob, boolean wantq, boolean wantz, boolean[] select, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] q, int ldq, double[] z, int ldz, intW m, doubleW pl, doubleW pr, double[] dif, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSJA computes the generalized singular value decomposition (GSVD)
+ of two real upper triangular (or trapezoidal) matrices A and B.
+
+ On entry, it is assumed that matrices A and B have the following
+ forms, which may be obtained by the preprocessing subroutine DGGSVP
+ from a general M-by-N matrix A and P-by-N matrix B:
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ B = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal.
+
+ On exit,
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ),
+
+ where U, V and Q are orthogonal matrices, Z' denotes the transpose
+ of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are
+ ``diagonal'' matrices, which are of the following structures:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 ) K
+ L ( 0 0 R22 ) L
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
+
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The computation of the orthogonal transformation matrices U, V or Q
+ is optional. These matrices may either be formed explicitly, or they
+ may be postmultiplied into input matrices U1, V1, or Q1.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': U must contain an orthogonal matrix U1 on entry, and
+
+ the product U1*U is returned;
+ = 'I': U is initialized to the unit matrix, and the
+ orthogonal matrix U is returned;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': V must contain an orthogonal matrix V1 on entry, and
+
+ the product V1*V is returned;
+ = 'I': V is initialized to the unit matrix, and the
+ orthogonal matrix V is returned;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
+
+ the product Q1*Q is returned;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ K (input) INTEGER
+ L (input) INTEGER
+ K and L specify the subblocks in the input matrices A and B:
+
+ A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
+ of A and B, whose GSVD is going to be computed by DTGSJA.
+ See Further details.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
+ matrix R or part of R. See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
+ a part of R. See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) DOUBLE PRECISION
+ TOLB (input) DOUBLE PRECISION
+ TOLA and TOLB are the convergence criteria for the Jacobi-
+ Kogbetliantz iteration procedure. Generally, they are the
+ same as used in the preprocessing step, say
+ TOLA = max(M,N)*norm(A)*MAZHEPS,
+ TOLB = max(P,N)*norm(B)*MAZHEPS.
+
+ ALPHA (output) DOUBLE PRECISION array, dimension (N)
+ BETA (output) DOUBLE PRECISION array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = diag(C),
+ BETA(K+1:K+L) = diag(S),
+ or if M-K-L < 0,
+ ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
+ BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
+ Furthermore, if K+L < N,
+ ALPHA(K+L+1:N) = 0 and
+ BETA(K+L+1:N) = 0.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU,M)
+ On entry, if JOBU = 'U', U must contain a matrix U1 (usually
+
+ the orthogonal matrix returned by DGGSVP).
+ On exit,
+ if JOBU = 'I', U contains the orthogonal matrix U;
+ if JOBU = 'U', U contains the product U1*U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,P)
+ On entry, if JOBV = 'V', V must contain a matrix V1 (usually
+
+ the orthogonal matrix returned by DGGSVP).
+ On exit,
+ if JOBV = 'I', V contains the orthogonal matrix V;
+ if JOBV = 'V', V contains the product V1*V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
+
+ the orthogonal matrix returned by DGGSVP).
+ On exit,
+ if JOBQ = 'I', Q contains the orthogonal matrix Q;
+ if JOBQ = 'Q', Q contains the product Q1*Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ NCYCLE (output) INTEGER
+ The number of cycles required for convergence.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the procedure does not converge after MAXIT cycles.
+
+ Internal Parameters
+ ===================
+
+ MAXIT INTEGER
+ MAXIT specifies the total loops that the iterative procedure
+
+ may take. If after MAXIT cycles, the routine fails to
+ converge, we return INFO = 1.
+
+ Further Details
+ ===============
+
+ DTGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
+ min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
+ matrix B13 to the form:
+
+ U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1,
+
+ where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose
+ of Z. C1 and S1 are diagonal matrices satisfying
+
+ C1**2 + S1**2 = I,
+
+ and R1 is an L-by-L nonsingular upper triangular matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobu
+ * @param jobv
+ * @param jobq
+ * @param m
+ * @param p
+ * @param n
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param tola
+ * @param tolb
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param v
+ * @param ldv
+ * @param q
+ * @param ldq
+ * @param work
+ * @param ncycle
+ * @param info
+ */
+ public abstract void dtgsja(String jobu, String jobv, String jobq, int m, int p, int n, int k, int l, double[] a, int lda, double[] b, int ldb, double tola, double tolb, double[] alpha, double[] beta, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, double[] work, intW ncycle, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or eigenvectors of a matrix pair (A, B) in
+ generalized real Schur canonical form (or of any matrix pair
+ (Q*A*Z', Q*B*Z') with orthogonal matrices Q and Z, where
+ Z' denotes the transpose of Z.
+
+ (A, B) must be in generalized real Schur form (as returned by DGGES),
+ i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal
+ blocks. B is upper triangular.
+
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (DIF):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (DIF);
+ = 'B': for both eigenvalues and eigenvectors (S and DIF).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the square matrix pair (A, B). N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The upper quasi-triangular matrix A in the pair (A,B).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The upper triangular matrix B in the pair (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) DOUBLE PRECISION array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns of VL, as returned by DTGEVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1.
+ If JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) DOUBLE PRECISION array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns ov VR, as returned by DTGEVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1.
+ If JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), DIF(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ DIF (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of DIF are set to the same value. If
+ the eigenvalues cannot be reordered to compute DIF(j), DIF(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', DIF is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S and DIF. MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and DIF used to store
+
+ the specified condition numbers; for each selected real
+ eigenvalue one element is used, and for each selected complex
+ conjugate pair of eigenvalues, two elements are used.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N + 6)
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value
+
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of a generalized eigenvalue
+ w = (a, b) is defined as
+
+ S(w) = (|u'Av|**2 + |u'Bv|**2)**(1/2) / (norm(u)*norm(v))
+
+ where u and v are the left and right eigenvectors of (A, B)
+ corresponding to w; |z| denotes the absolute value of the complex
+ number, and norm(u) denotes the 2-norm of the vector u.
+ The pair (a, b) corresponds to an eigenvalue w = a/b (= u'Av/u'Bv)
+ of the matrix pair (A, B). If both a and b equal zero, then (A B) is
+
+ singular and S(I) = -1 is returned.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(A, B) / S(I)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number DIF(i) of right eigenvector u
+
+ and left eigenvector v corresponding to the generalized eigenvalue w
+
+ is defined as follows:
+
+ a) If the i-th eigenvalue w = (a,b) is real
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( a * ) ( b * ) 1
+ ( 0 S22 ),( 0 T22 ) n-1
+ 1 n-1 1 n-1
+
+ Then the reciprocal condition number DIF(i) is
+
+ Difl((a, b), (S22, T22)) = sigma-min( Zl ),
+
+ where sigma-min(Zl) denotes the smallest singular value of the
+ 2(n-1)-by-2(n-1) matrix
+
+ Zl = [ kron(a, In-1) -kron(1, S22) ]
+ [ kron(b, In-1) -kron(1, T22) ] .
+
+ Here In-1 is the identity matrix of size n-1. kron(X, Y) is the
+ Kronecker product between the matrices X and Y.
+
+ Note that if the default method for computing DIF(i) is wanted
+ (see DLATDF), then the parameter DIFDRI (see below) should be
+ changed from 3 to 4 (routine DLATDF(IJOB = 2 will be used)).
+ See DTGSYL for more details.
+
+ b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair,
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2
+ ( 0 S22 ),( 0 T22) n-2
+ 2 n-2 2 n-2
+
+ and (S11, T11) corresponds to the complex conjugate eigenvalue
+ pair (w, conjg(w)). There exist unitary matrices U1 and V1 such
+ that
+
+ U1'*S11*V1 = ( s11 s12 ) and U1'*T11*V1 = ( t11 t12 )
+ ( 0 s22 ) ( 0 t22 )
+
+ where the generalized eigenvalues w = s11/t11 and
+ conjg(w) = s22/t22.
+
+ Then the reciprocal condition number DIF(i) is bounded by
+
+ min( d1, max( 1, |real(s11)/real(s22)| )*d2 )
+
+ where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where
+ Z1 is the complex 2-by-2 matrix
+
+ Z1 = [ s11 -s22 ]
+ [ t11 -t22 ],
+
+ This is done by computing (using real arithmetic) the
+ roots of the characteristical polynomial det(Z1' * Z1 - lambda I),
+ where Z1' denotes the conjugate transpose of Z1 and det(X) denotes
+ the determinant of X.
+
+ and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an
+
+ upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2)
+
+ Z2 = [ kron(S11', In-2) -kron(I2, S22) ]
+ [ kron(T11', In-2) -kron(I2, T22) ]
+
+ Note that if the default method for computing DIF is wanted (see
+ DLATDF), then the parameter DIFDRI (see below) should be changed
+ from 3 to 4 (routine DLATDF(IJOB = 2 will be used)). See DTGSYL
+ for more details.
+
+ For each eigenvalue/vector specified by SELECT, DIF stores a
+ Frobenius norm-based estimate of Difl.
+
+ An approximate error bound for the i-th computed eigenvector VL(i) or
+ VR(i) is given by
+
+ EPS * norm(A, B) / DIF(i).
+
+ See ref. [2-3] for more details and further references.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param howmny
+ * @param select
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param s
+ * @param dif
+ * @param mm
+ * @param m
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtgsna(String job, String howmny, boolean[] select, int n, double[] a, int lda, double[] b, int ldb, double[] vl, int ldvl, double[] vr, int ldvr, double[] s, double[] dif, int mm, intW m, double[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSY2 solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F,
+
+ using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
+
+ (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
+ N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
+ must be in generalized Schur canonical form, i.e. A, B are upper
+ quasi triangular and D, E are upper triangular. The solution (R, L)
+ overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
+ chosen to avoid overflow.
+
+ In matrix notation solving equation (1) corresponds to solve
+ Z*x = scale*b, where Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ],
+
+ Ik is the identity matrix of size k and X' is the transpose of X.
+ kron(X, Y) is the Kronecker product between the matrices X and Y.
+ In the process of solving (1), we solve a number of such systems
+ where Dim(In), Dim(In) = 1 or 2.
+
+ If TRANS = 'T', solve the transposed system Z'*y = scale*b for y,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * -F
+
+ This case is used to compute an estimate of Dif[(A, D), (B, E)] =
+ sigma_min(Z) using reverse communicaton with DLACON.
+
+ DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL
+ of an upper bound on the separation between to matrix pairs. Then
+ the input (A, D), (B, E) are sub-pencils of the matrix pair in
+ DTGSYL. See DTGSYL for details.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T': solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ = 0: solve (1) only.
+ = 1: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (look ahead strategy is used).
+ = 2: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (DGECON on sub-systems is used.)
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ On entry, M specifies the order of A and D, and the row
+ dimension of C, F, R and L.
+
+ N (input) INTEGER
+ On entry, N specifies the order of B and E, and the column
+ dimension of C, F, R and L.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, M)
+ On entry, A contains an upper quasi triangular matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the matrix A. LDA >= max(1, M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, N)
+ On entry, B contains an upper quasi triangular matrix.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1, N).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1).
+ On exit, if IJOB = 0, C has been overwritten by the
+ solution R.
+
+ LDC (input) INTEGER
+ The leading dimension of the matrix C. LDC >= max(1, M).
+
+ D (input) DOUBLE PRECISION array, dimension (LDD, M)
+ On entry, D contains an upper triangular matrix.
+
+ LDD (input) INTEGER
+ The leading dimension of the matrix D. LDD >= max(1, M).
+
+ E (input) DOUBLE PRECISION array, dimension (LDE, N)
+ On entry, E contains an upper triangular matrix.
+
+ LDE (input) INTEGER
+ The leading dimension of the matrix E. LDE >= max(1, N).
+
+ F (input/output) DOUBLE PRECISION array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1).
+ On exit, if IJOB = 0, F has been overwritten by the
+ solution L.
+
+ LDF (input) INTEGER
+ The leading dimension of the matrix F. LDF >= max(1, M).
+
+ SCALE (output) DOUBLE PRECISION
+ On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
+ R and L (C and F on entry) will hold the solutions to a
+ slightly perturbed system but the input matrices A, B, D and
+
+ E have not been changed. If SCALE = 0, R and L will hold the
+
+ solutions to the homogeneous system with C = F = 0. Normally,
+ SCALE = 1.
+
+ RDSUM (input/output) DOUBLE PRECISION
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by DTGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when DTGSY2 is called by DTGSYL.
+
+ RDSCAL (input/output) DOUBLE PRECISION
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when DTGSY2 is called by
+ DTGSYL.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+2)
+
+ PQ (output) INTEGER
+ On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
+ 8-by-8) solved by this routine.
+
+ INFO (output) INTEGER
+ On exit, if INFO is set to
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: The matrix pairs (A, D) and (B, E) have common or very
+
+ close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+ Replaced various illegal calls to DCOPY by calls to DLASET.
+ Sven Hammarling, 27/5/02.
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param ijob
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param Ldc
+ * @param d
+ * @param ldd
+ * @param e
+ * @param lde
+ * @param f
+ * @param ldf
+ * @param scale
+ * @param rdsum
+ * @param rdscal
+ * @param iwork
+ * @param pq
+ * @param info
+ */
+ public abstract void dtgsy2(String trans, int ijob, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, double[] d, int ldd, double[] e, int lde, double[] f, int ldf, doubleW scale, doubleW rdsum, doubleW rdscal, int[] iwork, intW pq, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTGSYL solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F
+
+ where R and L are unknown m-by-n matrices, (A, D), (B, E) and
+ (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
+ respectively, with real entries. (A, D) and (B, E) must be in
+ generalized (real) Schur canonical form, i.e. A, B are upper quasi
+ triangular and D, E are upper triangular.
+
+ The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
+ scaling factor chosen to avoid overflow.
+
+ In matrix notation (1) is equivalent to solve Zx = scale b, where
+ Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ].
+
+ Here Ik is the identity matrix of size k and X' is the transpose of
+ X. kron(X, Y) is the Kronecker product between the matrices X and Y.
+
+
+ If TRANS = 'T', DTGSYL solves the transposed system Z'*y = scale*b,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * (-F)
+
+ This case (TRANS = 'T') is used to compute an one-norm-based estimate
+ of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
+ and (B,E), using DLACON.
+
+ If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate
+ of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
+
+ reciprocal of the smallest singular value of Z. See [1-2] for more
+ information.
+
+ This is a level 3 BLAS algorithm.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T', solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ =0: solve (1) only.
+ =1: The functionality of 0 and 3.
+ =2: The functionality of 0 and 4.
+ =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ (look ahead strategy IJOB = 1 is used).
+ =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ ( DGECON on sub-systems is used ).
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ The order of the matrices A and D, and the row dimension of
+ the matrices C, F, R and L.
+
+ N (input) INTEGER
+ The order of the matrices B and E, and the column dimension
+ of the matrices C, F, R and L.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, M)
+ The upper quasi triangular matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, N)
+ The upper quasi triangular matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1, N).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, C has been overwritten by
+ the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1, M).
+
+ D (input) DOUBLE PRECISION array, dimension (LDD, M)
+ The upper triangular matrix D.
+
+ LDD (input) INTEGER
+ The leading dimension of the array D. LDD >= max(1, M).
+
+ E (input) DOUBLE PRECISION array, dimension (LDE, N)
+ The upper triangular matrix E.
+
+ LDE (input) INTEGER
+ The leading dimension of the array E. LDE >= max(1, N).
+
+ F (input/output) DOUBLE PRECISION array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, F has been overwritten by
+ the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1, M).
+
+ DIF (output) DOUBLE PRECISION
+ On exit DIF is the reciprocal of a lower bound of the
+ reciprocal of the Dif-function, i.e. DIF is an upper bound of
+ Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
+ IF IJOB = 0 or TRANS = 'T', DIF is not touched.
+
+ SCALE (output) DOUBLE PRECISION
+ On exit SCALE is the scaling factor in (1) or (3).
+ If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
+
+ to a slightly perturbed system but the input matrices A, B, D
+ and E have not been changed. If SCALE = 0, C and F hold the
+ solutions R and L, respectively, to the homogeneous system
+ with C = F = 0. Normally, SCALE = 1.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK > = 1.
+ If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+6)
+
+ INFO (output) INTEGER
+ =0: successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: (A, D) and (B, E) have common or close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
+ Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
+ Appl., 15(4):1045-1060, 1994
+
+ [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
+ Condition Estimators for Solving the Generalized Sylvester
+ Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
+ July 1989, pp 745-751.
+
+ =====================================================================
+ Replaced various illegal calls to DCOPY by calls to DLASET.
+ Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param ijob
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param Ldc
+ * @param d
+ * @param ldd
+ * @param e
+ * @param lde
+ * @param f
+ * @param ldf
+ * @param scale
+ * @param dif
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtgsyl(String trans, int ijob, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, double[] d, int ldd, double[] e, int lde, double[] f, int ldf, doubleW scale, doubleW dif, double[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPCON estimates the reciprocal of the condition number of a packed
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param ap
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtpcon(String norm, String uplo, String diag, int n, double[] ap, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular packed
+ coefficient matrix.
+
+ The solution matrix X must be computed by DTPTRS or some other
+ means before entering this routine. DTPRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtprfs(String uplo, String trans, String diag, int n, int nrhs, double[] ap, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPTRI computes the inverse of a real upper or lower triangular
+ matrix A stored in packed format.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+
+ On entry, the upper or lower triangular matrix A, stored
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*((2*n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same packed storage format.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+ Further Details
+ ===============
+
+ A triangular matrix A can be transferred to packed storage using one
+
+ of the following program segments:
+
+ UPLO = 'U': UPLO = 'L':
+
+ JC = 1 JC = 1
+ DO 2 J = 1, N DO 2 J = 1, N
+ DO 1 I = 1, J DO 1 I = J, N
+ AP(JC+I-1) = A(I,J) AP(JC+I-J) = A(I,J)
+ 1 CONTINUE 1 CONTINUE
+ JC = JC + J JC = JC + N - J + 1
+ 2 CONTINUE 2 CONTINUE
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param ap
+ * @param info
+ */
+ public abstract void dtptri(String uplo, String diag, int n, double[] ap, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTPTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N stored in packed format,
+ and B is an N-by-NRHS matrix. A check is made to verify that A is
+ nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dtptrs(String uplo, String trans, String diag, int n, int nrhs, double[] ap, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRCON estimates the reciprocal of the condition number of a
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ RCOND (output) DOUBLE PRECISION
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtrcon(String norm, String uplo, String diag, int n, double[] a, int lda, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTREVC computes some or all of the right and/or left eigenvectors of
+
+ a real upper quasi-triangular matrix T.
+ Matrices of this type are produced by the Schur factorization of
+ a real general matrix: A = Q*T*Q**T, as computed by DHSEQR.
+
+ The right eigenvector x and the left eigenvector y of T corresponding
+ to an eigenvalue w are defined by:
+
+ T*x = w*x, (y**H)*T = w*(y**H)
+
+ where y**H denotes the conjugate transpose of y.
+ The eigenvalues are not input to this routine, but are read directly
+
+ from the diagonal blocks of T.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+ input matrix. If Q is the orthogonal factor that reduces a matrix
+ A to Schur form T, then Q*X and Q*Y are the matrices of right and
+ left eigenvectors of A.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ as indicated by the logical array SELECT.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+ computed.
+ If w(j) is a real eigenvalue, the corresponding real
+ eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector is
+
+ computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+ on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+
+ .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ The upper quasi-triangular matrix T in Schur canonical form.
+
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by DHSEQR).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VL, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by DHSEQR).
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*X;
+ if HOWMNY = 'S', the right eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VR, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors.
+ If HOWMNY = 'A' or 'B', M is set to N.
+ Each selected real eigenvector occupies one column and each
+ selected complex eigenvector occupies two columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The algorithm used in this program is basically backward (forward)
+ substitution, with scaling to make the the code robust against
+ possible overflow.
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x| + |y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param howmny
+ * @param select
+ * @param n
+ * @param t
+ * @param ldt
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param mm
+ * @param m
+ * @param work
+ * @param info
+ */
+ public abstract void dtrevc(String side, String howmny, boolean[] select, int n, double[] t, int ldt, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTREXC reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
+
+ moved to row ILST.
+
+ The real Schur form T is reordered by an orthogonal similarity
+ transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
+ is updated by postmultiplying it with Z.
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ Schur canonical form.
+ On exit, the reordered upper quasi-triangular matrix, again
+ in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix Z which reorders T.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of T.
+ The block with row index IFST is moved to row ILST, by a
+ sequence of transpositions between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of a
+ 2-by-2 block, it is changed to point to the first row; ILST
+ always points to the first row of the block in its final
+ position (which may differ from its input value by +1 or -1).
+ 1 <= IFST <= N; 1 <= ILST <= N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: two adjacent blocks were too close to swap (the problem
+ is very ill-conditioned); T may have been partially
+ reordered, and ILST points to the first row of the
+ current position of the block being moved.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compq
+ * @param n
+ * @param t
+ * @param ldt
+ * @param q
+ * @param ldq
+ * @param ifst
+ * @param ilst
+ * @param work
+ * @param info
+ */
+ public abstract void dtrexc(String compq, int n, double[] t, int ldt, double[] q, int ldq, intW ifst, intW ilst, double[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular
+ coefficient matrix.
+
+ The solution matrix X must be computed by DTRTRS or some other
+ means before entering this routine. DTRRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) DOUBLE PRECISION array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) DOUBLE PRECISION array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtrrfs(String uplo, String trans, String diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSEN reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
+ the leading diagonal blocks of the upper quasi-triangular matrix T,
+ and the leading columns of Q form an orthonormal basis of the
+ corresponding right invariant subspace.
+
+ Optionally the routine computes the reciprocal condition numbers of
+ the cluster of eigenvalues and/or the invariant subspace.
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elemnts equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (S) or the invariant subspace (SEP):
+ = 'N': none;
+ = 'E': for eigenvalues only (S);
+ = 'V': for invariant subspace only (SEP);
+ = 'B': for both eigenvalues and invariant subspace (S and
+ SEP).
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster. To
+
+ select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, T is overwritten by the reordered matrix T, again in
+ Schur canonical form, with the selected eigenvalues in the
+ leading diagonal blocks.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix which reorders T; the
+ leading M columns of Q form an orthonormal basis for the
+ specified invariant subspace.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the reordered
+
+ eigenvalues of T. The eigenvalues are stored in the same
+ order as on the diagonal of T, with WR(i) = T(i,i) and, if
+ T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
+ WI(i+1) = -WI(i). Note that if a complex eigenvalue is
+ sufficiently ill-conditioned, then its value may differ
+ significantly from its value before reordering.
+
+ M (output) INTEGER
+ The dimension of the specified invariant subspace.
+ 0 < = M <= N.
+
+ S (output) DOUBLE PRECISION
+ If JOB = 'E' or 'B', S is a lower bound on the reciprocal
+ condition number for the selected cluster of eigenvalues.
+ S cannot underestimate the true reciprocal condition number
+ by more than a factor of sqrt(N). If M = 0 or N, S = 1.
+ If JOB = 'N' or 'V', S is not referenced.
+
+ SEP (output) DOUBLE PRECISION
+ If JOB = 'V' or 'B', SEP is the estimated reciprocal
+ condition number of the specified invariant subspace. If
+ M = 0 or N, SEP = norm(T).
+ If JOB = 'N' or 'E', SEP is not referenced.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOB = 'N', LWORK >= max(1,N);
+ if JOB = 'E', LWORK >= max(1,M*(N-M));
+ if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOB = 'N' or 'E', LIWORK >= 1;
+ if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: reordering of T failed because some eigenvalues are too
+
+ close to separate (the problem is very ill-conditioned);
+ T may have been partially reordered, and WR and WI
+ contain the eigenvalues in the same order as in T; S and
+ SEP (if requested) are set to zero.
+
+ Further Details
+ ===============
+
+ DTRSEN first collects the selected eigenvalues by computing an
+ orthogonal transformation Z to move them to the top left corner of T.
+ In other words, the selected eigenvalues are the eigenvalues of T11
+ in:
+
+ Z'*T*Z = ( T11 T12 ) n1
+ ( 0 T22 ) n2
+ n1 n2
+
+ where N = n1+n2 and Z' means the transpose of Z. The first n1 columns
+ of Z span the specified invariant subspace of T.
+
+ If T has been obtained from the real Schur factorization of a matrix
+
+ A = Q*T*Q', then the reordered real Schur factorization of A is given
+ by A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span
+ the corresponding invariant subspace of A.
+
+ The reciprocal condition number of the average of the eigenvalues of
+
+ T11 may be returned in S. S lies between 0 (very badly conditioned)
+ and 1 (very well conditioned). It is computed as follows. First we
+ compute R so that
+
+ P = ( I R ) n1
+ ( 0 0 ) n2
+ n1 n2
+
+ is the projector on the invariant subspace associated with T11.
+ R is the solution of the Sylvester equation:
+
+ T11*R - R*T22 = T12.
+
+ Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
+ the two-norm of M. Then S is computed as the lower bound
+
+ (1 + F-norm(R)**2)**(-1/2)
+
+ on the reciprocal of 2-norm(P), the true reciprocal condition number.
+ S cannot underestimate 1 / 2-norm(P) by more than a factor of
+ sqrt(N).
+
+ An approximate error bound for the computed average of the
+ eigenvalues of T11 is
+
+ EPS * norm(T) / S
+
+ where EPS is the machine precision.
+
+ The reciprocal condition number of the right invariant subspace
+ spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
+
+ SEP is defined as the separation of T11 and T22:
+
+ sep( T11, T22 ) = sigma-min( C )
+
+ where sigma-min(C) is the smallest singular value of the
+ n1*n2-by-n1*n2 matrix
+
+ C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
+
+ I(m) is an m by m identity matrix, and kprod denotes the Kronecker
+ product. We estimate sigma-min(C) by the reciprocal of an estimate of
+ the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
+ cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
+
+ When SEP is small, small changes in T can cause large changes in
+ the invariant subspace. An approximate bound on the maximum angular
+ error in the computed right invariant subspace is
+
+ EPS * norm(T) / SEP
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param compq
+ * @param select
+ * @param n
+ * @param t
+ * @param ldt
+ * @param q
+ * @param ldq
+ * @param wr
+ * @param wi
+ * @param m
+ * @param s
+ * @param sep
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void dtrsen(String job, String compq, boolean[] select, int n, double[] t, int ldt, double[] q, int ldq, double[] wr, double[] wi, intW m, doubleW s, doubleW sep, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or right eigenvectors of a real upper
+ quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
+ orthogonal).
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (SEP):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (SEP);
+ = 'B': for both eigenvalues and eigenvectors (S and SEP).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ The upper quasi-triangular matrix T, in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input) DOUBLE PRECISION array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of T
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VL, as returned by
+ DHSEIN or DTREVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) DOUBLE PRECISION array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of T
+
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VR, as returned by
+ DHSEIN or DTREVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), SEP(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ SEP (output) DOUBLE PRECISION array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of SEP are set to the same value. If
+ the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', SEP is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S (if JOB = 'E' or 'B')
+
+ and/or SEP (if JOB = 'V' or 'B'). MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and/or SEP actually
+ used to store the estimated condition numbers.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,N+6)
+ If JOB = 'E', WORK is not referenced.
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
+
+ IWORK (workspace) INTEGER array, dimension (2*(N-1))
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of an eigenvalue lambda is
+ defined as
+
+ S(lambda) = |v'*u| / (norm(u)*norm(v))
+
+ where u and v are the right and left eigenvectors of T corresponding
+
+ to lambda; v' denotes the conjugate-transpose of v, and norm(u)
+ denotes the Euclidean norm. These reciprocal condition numbers always
+ lie between zero (very badly conditioned) and one (very well
+ conditioned). If n = 1, S(lambda) is defined to be 1.
+
+ An approximate error bound for a computed eigenvalue W(i) is given by
+
+ EPS * norm(T) / S(i)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number of the right eigenvector u
+ corresponding to lambda is defined as follows. Suppose
+
+ T = ( lambda c )
+ ( 0 T22 )
+
+ Then the reciprocal condition number is
+
+ SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
+
+ where sigma-min denotes the smallest singular value. We approximate
+ the smallest singular value by the reciprocal of an estimate of the
+ one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
+ defined to be abs(T(1,1)).
+
+ An approximate error bound for a computed right eigenvector VR(i)
+ is given by
+
+ EPS * norm(T) / SEP(i)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param howmny
+ * @param select
+ * @param n
+ * @param t
+ * @param ldt
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param s
+ * @param sep
+ * @param mm
+ * @param m
+ * @param work
+ * @param ldwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void dtrsna(String job, String howmny, boolean[] select, int n, double[] t, int ldt, double[] vl, int ldvl, double[] vr, int ldvr, double[] s, double[] sep, int mm, intW m, double[] work, int ldwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRSYL solves the real Sylvester matrix equation:
+
+ op(A)*X + X*op(B) = scale*C or
+ op(A)*X - X*op(B) = scale*C,
+
+ where op(A) = A or A**T, and A and B are both upper quasi-
+ triangular. A is M-by-M and B is N-by-N; the right hand side C and
+ the solution X are M-by-N; and scale is an output scale factor, set
+ <= 1 to avoid overflow in X.
+
+ A and B must be in Schur canonical form (as returned by DHSEQR), that
+ is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
+ each 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ TRANA (input) CHARACTER*1
+ Specifies the option op(A):
+ = 'N': op(A) = A (No transpose)
+ = 'T': op(A) = A**T (Transpose)
+ = 'C': op(A) = A**H (Conjugate transpose = Transpose)
+
+ TRANB (input) CHARACTER*1
+ Specifies the option op(B):
+ = 'N': op(B) = B (No transpose)
+ = 'T': op(B) = B**T (Transpose)
+ = 'C': op(B) = B**H (Conjugate transpose = Transpose)
+
+ ISGN (input) INTEGER
+ Specifies the sign in the equation:
+ = +1: solve op(A)*X + X*op(B) = scale*C
+ = -1: solve op(A)*X - X*op(B) = scale*C
+
+ M (input) INTEGER
+ The order of the matrix A, and the number of rows in the
+ matrices X and C. M >= 0.
+
+ N (input) INTEGER
+ The order of the matrix B, and the number of columns in the
+ matrices X and C. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,M)
+ The upper quasi-triangular matrix A, in Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,N)
+ The upper quasi-triangular matrix B, in Schur canonical form.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N right hand side matrix C.
+ On exit, C is overwritten by the solution matrix X.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M)
+
+ SCALE (output) DOUBLE PRECISION
+ The scale factor, scale, set <= 1 to avoid overflow in X.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: A and B have common or very close eigenvalues; perturbed
+ values were used to solve the equation (but the matrices
+ A and B are unchanged).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trana
+ * @param tranb
+ * @param isgn
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param Ldc
+ * @param scale
+ * @param info
+ */
+ public abstract void dtrsyl(String trana, String tranb, int isgn, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, doubleW scale, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRTI2 computes the inverse of a real upper or lower triangular
+ matrix.
+
+ This is the Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading n by n upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dtrti2(String uplo, String diag, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRTRI computes the inverse of a real upper or lower triangular
+ matrix A.
+
+ This is the Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void dtrtri(String uplo, String diag, int n, double[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTRTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N, and B is an N-by-NRHS
+ matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the solutions
+ X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void dtrtrs(String uplo, String trans, String diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine DTZRZF.
+
+ DTZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param info
+ */
+ public abstract void dtzrqf(int m, int n, double[] a, int lda, double[] tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,L
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void dtzrzf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ IEEECK is called from the ILAENV to verify that Infinity and
+ possibly NaN arithmetic is safe (i.e. will not trap).
+
+ Arguments
+ =========
+
+ ISPEC (input) INTEGER
+ Specifies whether to test just for inifinity arithmetic
+ or whether to test for infinity and NaN arithmetic.
+ = 0: Verify infinity arithmetic only.
+ = 1: Verify infinity and NaN arithmetic.
+
+ ZERO (input) REAL
+ Must contain the value 0.0
+ This is passed to prevent the compiler from optimizing
+ away this code.
+
+ ONE (input) REAL
+ Must contain the value 1.0
+ This is passed to prevent the compiler from optimizing
+ away this code.
+
+ RETURN VALUE: INTEGER
+ = 0: Arithmetic failed to produce the correct answers
+ = 1: Arithmetic produced the correct answers
+
+ .. Local Scalars ..
+</pre>
+ * @param ispec
+ * @param zero
+ * @param one
+ */
+ public abstract int ieeeck(int ispec, float zero, float one);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ ILAENV is called from the LAPACK routines to choose problem-dependent
+ parameters for the local environment. See ISPEC for a description of
+ the parameters.
+
+ ILAENV returns an INTEGER
+ if ILAENV >= 0: ILAENV returns the value of the parameter specified b
+ if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal valu
+
+ This version provides a set of parameters which should give good,
+ but not optimal, performance on many of the currently available
+ computers. Users are encouraged to modify this subroutine to set
+ the tuning parameters for their particular machine using the option
+ and problem size information in the arguments.
+
+ This routine will not function correctly if it is converted to all
+ lower case. Converting it to all upper case is allowed.
+
+ Arguments
+ =========
+
+ ISPEC (input) INTEGER
+ Specifies the parameter to be returned as the value of
+ ILAENV.
+ = 1: the optimal blocksize; if this value is 1, an unblocked
+
+ algorithm will give the best performance.
+ = 2: the minimum block size for which the block routine
+ should be used; if the usable block size is less than
+ this value, an unblocked routine should be used.
+ = 3: the crossover point (in a block routine, for N less
+ than this value, an unblocked routine should be used)
+ = 4: the number of shifts, used in the nonsymmetric
+ eigenvalue routines (DEPRECATED)
+ = 5: the minimum column dimension for blocking to be used;
+ rectangular blocks must have dimension at least k by m,
+
+ where k is given by ILAENV(2,...) and m by ILAENV(5,...)
+ = 6: the crossover point for the SVD (when reducing an m by n
+ matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
+
+ this value, a QR factorization is used first to reduce
+ the matrix to a triangular form.)
+ = 7: the number of processors
+ = 8: the crossover point for the multishift QR method
+ for nonsymmetric eigenvalue problems (DEPRECATED)
+ = 9: maximum size of the subproblems at the bottom of the
+ computation tree in the divide-and-conquer algorithm
+ (used by xGELSD and xGESDD)
+ =10: ieee NaN arithmetic can be trusted not to trap
+ =11: infinity arithmetic can be trusted not to trap
+ 12 <= ISPEC <= 16:
+ xHSEQR or one of its subroutines,
+ see IPARMQ for detailed explanation
+
+ NAME (input) CHARACTER*(*)
+ The name of the calling subroutine, in either upper case or
+ lower case.
+
+ OPTS (input) CHARACTER*(*)
+ The character options to the subroutine NAME, concatenated
+ into a single character string. For example, UPLO = 'U',
+ TRANS = 'T', and DIAG = 'N' for a triangular routine would
+ be specified as OPTS = 'UTN'.
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ N3 (input) INTEGER
+ N4 (input) INTEGER
+ Problem dimensions for the subroutine NAME; these may not all
+ be required.
+
+ Further Details
+ ===============
+
+ The following conventions have been used when calling ILAENV from the
+ LAPACK routines:
+ 1) OPTS is a concatenation of all of the character options to
+ subroutine NAME, in the same order that they appear in the
+ argument list for NAME, even if they are not used in determining
+
+ the value of the parameter specified by ISPEC.
+ 2) The problem dimensions N1, N2, N3, N4 are specified in the order
+
+ that they appear in the argument list for NAME. N1 is used
+ first, N2 second, and so on, and unused problem dimensions are
+ passed a value of -1.
+ 3) The parameter value returned by ILAENV is checked for validity in
+ the calling subroutine. For example, ILAENV is used to retrieve
+
+ the optimal blocksize for STRTRI as follows:
+
+ NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
+ IF( NB.LE.1 ) NB = MAX( 1, N )
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param ispec
+ * @param name
+ * @param opts
+ * @param n1
+ * @param n2
+ * @param n3
+ * @param n4
+ */
+ public abstract int ilaenv(int ispec, String name, String opts, int n1, int n2, int n3, int n4);
+
+ /**
+<pre>
+
+
+ -- LAPACK routine (version 3.1.1) --
+ Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+ January 2007
+ ..
+
+ Purpose
+ =======
+
+ This subroutine return the Lapack version
+
+ Arguments
+ =========
+ VERS_MAJOR (output) INTEGER
+ return the lapack major version
+ VERS_MINOR (output) INTEGER
+ return the lapack minor version from the major version
+ VERS_PATCH (output) INTEGER
+ return the lapack patch version from the minor version
+ =====================================================================
+
+</pre>
+ * @param vers_major
+ * @param vers_minor
+ * @param vers_patch
+ */
+ public void ilaver(intW vers_major, intW vers_minor, intW vers_patch) {
+ org.netlib.lapack.Ilaver.ilaver(vers_major, vers_minor, vers_patch);
+ }
+
+ /**
+<pre>
+
+
+ Purpose
+ =======
+
+ This program sets problem and machine dependent parameters
+ useful for xHSEQR and its subroutines. It is called whenever
+ ILAENV is called with 12 <= ISPEC <= 16
+
+ Arguments
+ =========
+
+ ISPEC (input) integer scalar
+ ISPEC specifies which tunable parameter IPARMQ should
+ return.
+
+ ISPEC=12: (INMIN) Matrices of order nmin or less
+ are sent directly to xLAHQR, the implicit
+ double shift QR algorithm. NMIN must be
+ at least 11.
+
+ ISPEC=13: (INWIN) Size of the deflation window.
+ This is best set greater than or equal to
+ the number of simultaneous shifts NS.
+ Larger matrices benefit from larger deflation
+ windows.
+
+ ISPEC=14: (INIBL) Determines when to stop nibbling and
+ invest in an (expensive) multi-shift QR sweep.
+
+ If the aggressive early deflation subroutine
+ finds LD converged eigenvalues from an order
+ NW deflation window and LD.GT.(NW*NIBBLE)/100,
+
+ then the next QR sweep is skipped and early
+ deflation is applied immediately to the
+ remaining active diagonal block. Setting
+ IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
+ multi-shift QR sweep whenever early deflation
+ finds a converged eigenvalue. Setting
+ IPARMQ(ISPEC=14) greater than or equal to 100
+ prevents TTQRE from skipping a multi-shift
+ QR sweep.
+
+ ISPEC=15: (NSHFTS) The number of simultaneous shifts in
+ a multi-shift QR iteration.
+
+ ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
+ following meanings.
+ 0: During the multi-shift QR sweep,
+ xLAQR5 does not accumulate reflections and
+
+ does not use matrix-matrix multiply to
+ update the far-from-diagonal matrix
+ entries.
+ 1: During the multi-shift QR sweep,
+ xLAQR5 and/or xLAQRaccumulates reflections
+ matrix-matrix multiply to update the
+ far-from-diagonal matrix entries.
+ 2: During the multi-shift QR sweep.
+ xLAQR5 accumulates reflections and takes
+ advantage of 2-by-2 block structure during
+
+ matrix-matrix multiplies.
+ (If xTRMM is slower than xGEMM, then
+ IPARMQ(ISPEC=16)=1 may be more efficient than
+ IPARMQ(ISPEC=16)=2 despite the greater level of
+ arithmetic work implied by the latter choice.)
+
+
+ NAME (input) character string
+ Name of the calling subroutine
+
+ OPTS (input) character string
+ This is a concatenation of the string arguments to
+ TTQRE.
+
+ N (input) integer scalar
+ N is the order of the Hessenberg matrix H.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular
+ in rows and columns 1:ILO-1 and IHI+1:N.
+
+ LWORK (input) integer scalar
+ The amount of workspace available.
+
+ Further Details
+ ===============
+
+ Little is known about how best to choose these parameters.
+ It is possible to use different values of the parameters
+ for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
+
+ It is probably best to choose different parameters for
+ different matrices and different parameters at different
+ times during the iteration, but this has not been
+ implemented --- yet.
+
+
+ The best choices of most of the parameters depend
+ in an ill-understood way on the relative execution
+ rate of xLAQR3 and xLAQR5 and on the nature of each
+ particular eigenvalue problem. Experiment may be the
+ only practical way to determine which choices are most
+ effective.
+
+ Following is a list of default values supplied by IPARMQ.
+ These defaults may be adjusted in order to attain better
+ performance in any particular computational environment.
+
+ IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
+ Default: 75. (Must be at least 11.)
+
+ IPARMQ(ISPEC=13) Recommended deflation window size.
+ This depends on ILO, IHI and NS, the
+ number of simultaneous shifts returned
+ by IPARMQ(ISPEC=15). The default for
+ (IHI-ILO+1).LE.500 is NS. The default
+ for (IHI-ILO+1).GT.500 is 3*NS/2.
+
+ IPARMQ(ISPEC=14) Nibble crossover point. Default: 14.
+
+ IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
+ a multi-shift QR iteration.
+
+ If IHI-ILO+1 is ...
+
+ greater than ...but less ... the
+ or equal to ... than default is
+
+ 0 30 NS = 2+
+ 30 60 NS = 4+
+ 60 150 NS = 10
+ 150 590 NS = **
+ 590 3000 NS = 64
+ 3000 6000 NS = 128
+ 6000 infinity NS = 256
+
+ (+) By default matrices of this order are
+ passed to the implicit double shift routine
+ xLAHQR. See IPARMQ(ISPEC=12) above. These
+ values of NS are used only in case of a rare
+ xLAHQR failure.
+
+ (**) The asterisks (**) indicate an ad-hoc
+ function increasing from 10 to 64.
+
+ IPARMQ(ISPEC=16) Select structured matrix multiply.
+ (See ISPEC=16 above for details.)
+ Default: 3.
+
+ ================================================================
+ .. Parameters ..
+</pre>
+ * @param ispec
+ * @param name
+ * @param opts
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param lwork
+ */
+ public int iparmq(int ispec, String name, String opts, int n, int ilo, int ihi, int lwork) {
+ return org.netlib.lapack.Iparmq.iparmq(ispec, name, opts, n, ilo, ihi, lwork);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ LSAMEN tests if the first N letters of CA are the same as the
+ first N letters of CB, regardless of case.
+ LSAMEN returns .TRUE. if CA and CB are equivalent except for case
+ and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA )
+ or LEN( CB ) is less than N.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of characters in CA and CB to be compared.
+
+ CA (input) CHARACTER*(*)
+ CB (input) CHARACTER*(*)
+ CA and CB specify two character strings of length at least N.
+ Only the first N characters of each string will be accessed.
+
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param ca
+ * @param cb
+ */
+ public boolean lsamen(int n, String ca, String cb) {
+ return org.netlib.lapack.Lsamen.lsamen(n, ca, cb);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SBDSDC computes the singular value decomposition (SVD) of a real
+ N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
+ using a divide and conquer method, where S is a diagonal matrix
+ with non-negative diagonal elements (the singular values of B), and
+ U and VT are orthogonal matrices of left and right singular vectors,
+
+ respectively. SBDSDC can be used to compute all singular values,
+ and optionally, singular vectors or singular vectors in compact form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See SLASD3 for details.
+
+ The code currently calls SLASDQ if singular values only are desired.
+
+ However, it can be slightly modified to compute singular values
+ using the divide and conquer method.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal.
+ = 'L': B is lower bidiagonal.
+
+ COMPQ (input) CHARACTER*1
+ Specifies whether singular vectors are to be computed
+ as follows:
+ = 'N': Compute singular values only;
+ = 'P': Compute singular values and compute singular
+ vectors in compact form;
+ = 'I': Compute singular values and singular vectors.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the elements of E contain the offdiagonal
+ elements of the bidiagonal matrix whose SVD is desired.
+ On exit, E has been destroyed.
+
+ U (output) REAL array, dimension (LDU,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, U contains the left singular vectors
+ of the bidiagonal matrix.
+ For other values of COMPQ, U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1.
+ If singular vectors are desired, then LDU >= max( 1, N ).
+
+ VT (output) REAL array, dimension (LDVT,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, VT' contains the right singular
+ vectors of the bidiagonal matrix.
+ For other values of COMPQ, VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1.
+ If singular vectors are desired, then LDVT >= max( 1, N ).
+
+ Q (output) REAL array, dimension (LDQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, Q contains all the REAL data in
+ LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, Q is not referenced.
+
+ IQ (output) INTEGER array, dimension (LDIQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, IQ contains all INTEGER data in
+ LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, IQ is not referenced.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK))
+ If COMPQ = 'N' then LWORK >= (4 * N).
+ If COMPQ = 'P' then LWORK >= (6 * N).
+ If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value.
+ The update process of divide and conquer failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+ =====================================================================
+ Changed dimension statement in comment describing E from (N) to
+ (N-1). Sven, 17 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param compq
+ * @param n
+ * @param d
+ * @param e
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param q
+ * @param iq
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sbdsdc(String uplo, String compq, int n, float[] d, float[] e, float[] u, int ldu, float[] vt, int ldvt, float[] q, int[] iq, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SBDSQR computes the singular values and, optionally, the right and/or
+ left singular vectors from the singular value decomposition (SVD) of
+
+ a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+ zero-shift QR algorithm. The SVD of B has the form
+
+ B = Q * S * P**T
+
+ where S is the diagonal matrix of singular values, Q is an orthogonal
+ matrix of left singular vectors, and P is an orthogonal matrix of
+ right singular vectors. If left singular vectors are requested, this
+ subroutine actually returns U*Q instead of Q, and, if right singular
+
+ vectors are requested, this subroutine returns P**T*VT instead of
+ P**T, for given real input matrices U and VT. When U and VT are the
+
+ orthogonal matrices that reduce a general matrix A to bidiagonal
+ form: A = U*B*VT, as computed by SGEBRD, then
+
+ A = (U*Q) * S * (P**T*VT)
+
+ is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+
+ for a given real input matrix C.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
+ no. 5, pp. 873-912, Sept 1990) and
+ "Accurate singular values and differential qd algorithms," by
+ B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
+ Department, University of California at Berkeley, July 1992
+ for a detailed description of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal;
+ = 'L': B is lower bidiagonal.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ NCVT (input) INTEGER
+ The number of columns of the matrix VT. NCVT >= 0.
+
+ NRU (input) INTEGER
+ The number of rows of the matrix U. NRU >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B in decreasing
+ order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the N-1 offdiagonal elements of the bidiagonal
+ matrix B.
+ On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
+ will contain the diagonal and superdiagonal elements of a
+ bidiagonal matrix orthogonally equivalent to the one given
+ as input.
+
+ VT (input/output) REAL array, dimension (LDVT, NCVT)
+ On entry, an N-by-NCVT matrix VT.
+ On exit, VT is overwritten by P**T * VT.
+ Not referenced if NCVT = 0.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT.
+ LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
+
+ U (input/output) REAL array, dimension (LDU, N)
+ On entry, an NRU-by-N matrix U.
+ On exit, U is overwritten by U * Q.
+ Not referenced if NRU = 0.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,NRU).
+
+ C (input/output) REAL array, dimension (LDC, NCC)
+ On entry, an N-by-NCC matrix C.
+ On exit, C is overwritten by Q**T * C.
+ Not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
+
+ WORK (workspace) REAL array, dimension (2*N)
+ if NCVT = NRU = NCC = 0, (max(1, 4*N)) otherwise
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm did not converge; D and E contain the
+ elements of a bidiagonal matrix which is orthogonally
+ similar to the input matrix B; if INFO = i, i
+ elements of E have not converged to zero.
+
+ Internal Parameters
+ ===================
+
+ TOLMUL REAL, default = max(10,min(100,EPS**(-1/8)))
+ TOLMUL controls the convergence criterion of the QR loop.
+ If it is positive, TOLMUL*EPS is the desired relative
+ precision in the computed singular values.
+ If it is negative, abs(TOLMUL*EPS*sigma_max) is the
+ desired absolute accuracy in the computed singular
+ values (corresponds to relative accuracy
+ abs(TOLMUL*EPS) in the largest singular value.
+ abs(TOLMUL) should be between 1 and 1/EPS, and preferably
+ between 10 (for fast convergence) and .1/EPS
+ (for there to be some accuracy in the results).
+ Default is to lose at either one eighth or 2 of the
+ available decimal digits in each computed singular value
+ (whichever is smaller).
+
+ MAXITR INTEGER, default = 6
+ MAXITR controls the maximum number of passes of the
+ algorithm through its inner loop. The algorithms stops
+ (and so fails to converge) if the number of passes
+ through the inner loop exceeds MAXITR*N**2.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ncvt
+ * @param nru
+ * @param ncc
+ * @param d
+ * @param e
+ * @param vt
+ * @param ldvt
+ * @param u
+ * @param ldu
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sbdsqr(String uplo, int n, int ncvt, int nru, int ncc, float[] d, float[] e, float[] vt, int ldvt, float[] u, int ldu, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SDISNA computes the reciprocal condition numbers for the eigenvectors
+ of a real symmetric or complex Hermitian matrix or for the left or
+ right singular vectors of a general m-by-n matrix. The reciprocal
+ condition number is the 'gap' between the corresponding eigenvalue or
+ singular value and the nearest other one.
+
+ The bound on the error, measured by angle in radians, in the I-th
+ computed vector is given by
+
+ SLAMCH( 'E' ) * ( ANORM / SEP( I ) )
+
+ where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
+
+ to be smaller than SLAMCH( 'E' )*ANORM in order to limit the size of
+
+ the error bound.
+
+ SDISNA may also be used to compute error bounds for eigenvectors of
+ the generalized symmetric definite eigenproblem.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies for which problem the reciprocal condition numbers
+
+ should be computed:
+ = 'E': the eigenvectors of a symmetric/Hermitian matrix;
+ = 'L': the left singular vectors of a general matrix;
+ = 'R': the right singular vectors of a general matrix.
+
+ M (input) INTEGER
+ The number of rows of the matrix. M >= 0.
+
+ N (input) INTEGER
+ If JOB = 'L' or 'R', the number of columns of the matrix,
+ in which case N >= 0. Ignored if JOB = 'E'.
+
+ D (input) REAL array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+
+ The eigenvalues (if JOB = 'E') or singular values (if JOB =
+ 'L' or 'R') of the matrix, in either increasing or decreasing
+ order. If singular values, they must be non-negative.
+
+ SEP (output) REAL array, dimension (M) if JOB = 'E'
+ dimension (min(M,N)) if JOB = 'L' or 'R'
+ The reciprocal condition numbers of the vectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param m
+ * @param n
+ * @param d
+ * @param sep
+ * @param info
+ */
+ public abstract void sdisna(String job, int m, int n, float[] d, float[] sep, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBBRD reduces a real general m-by-n band matrix A to upper
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ The routine computes B, and optionally forms Q or P', or computes
+ Q'*C for a given matrix C.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether or not the matrices Q and P' are to be
+ formed.
+ = 'N': do not form Q or P';
+ = 'Q': form Q only;
+ = 'P': form P' only;
+ = 'B': form both.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals of the matrix A. KU >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the m-by-n band matrix A, stored in rows 1 to
+ KL+KU+1. The j-th column of A is stored in the j-th column of
+ the array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+ On exit, A is overwritten by values generated during the
+ reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KL+KU+1.
+
+ D (output) REAL array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B.
+
+ E (output) REAL array, dimension (min(M,N)-1)
+ The superdiagonal elements of the bidiagonal matrix B.
+
+ Q (output) REAL array, dimension (LDQ,M)
+ If VECT = 'Q' or 'B', the m-by-m orthogonal matrix Q.
+ If VECT = 'N' or 'P', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise.
+
+ PT (output) REAL array, dimension (LDPT,N)
+ If VECT = 'P' or 'B', the n-by-n orthogonal matrix P'.
+ If VECT = 'N' or 'Q', the array PT is not referenced.
+
+ LDPT (input) INTEGER
+ The leading dimension of the array PT.
+ LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise.
+
+ C (input/output) REAL array, dimension (LDC,NCC)
+ On entry, an m-by-ncc matrix C.
+ On exit, C is overwritten by Q'*C.
+ C is not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0.
+
+ WORK (workspace) REAL array, dimension (2*max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param m
+ * @param n
+ * @param ncc
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param d
+ * @param e
+ * @param q
+ * @param ldq
+ * @param pt
+ * @param ldpt
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sgbbrd(String vect, int m, int n, int ncc, int kl, int ku, float[] ab, int ldab, float[] d, float[] e, float[] q, int ldq, float[] pt, int ldpt, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBCON estimates the reciprocal of the condition number of a real
+ general band matrix A, in either the 1-norm or the infinity-norm,
+ using the LU factorization computed by SGBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) REAL array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by SGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ ANORM (input) REAL
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgbcon(String norm, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBEQU computes row and column scalings intended to equilibrate an
+ M-by-N band matrix A and reduce its condition number. R returns the
+
+ row scale factors and C the column scale factors, chosen to try to
+ make the largest element in each row and column of the matrix B with
+
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ R (output) REAL array, dimension (M)
+ If INFO = 0, or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) REAL array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) REAL
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) REAL
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param info
+ */
+ public abstract void sgbequ(int m, int n, int kl, int ku, float[] ab, int ldab, float[] r, float[] c, floatW rowcnd, floatW colcnd, floatW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is banded, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The original band matrix A, stored in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input) REAL array, dimension (LDAFB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by SGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
+
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGBTRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SGBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgbrfs(String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBSV computes the solution to a real system of linear equations
+ A * X = B, where A is a band matrix of order N with KL subdiagonals
+ and KU superdiagonals, and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as A = L * U, where L is a product of permutation
+ and unit lower triangular matrices with KL subdiagonals, and U is
+ upper triangular with KL+KU superdiagonals. The factored form of A
+ is then used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * * + + + * * * u14 u25 u36
+ * * + + + + * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sgbsv(int n, int kl, int ku, int nrhs, float[] ab, int ldab, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B, A**T * X = B, or A**H * X = B,
+
+ where A is a band matrix of order N with KL subdiagonals and KU
+ superdiagonals, and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed by this subroutine:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = L * U,
+ where L is a product of permutation and unit lower triangular
+ matrices with KL subdiagonals, and U is upper triangular with
+ KL+KU superdiagonals.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB and IPIV contain the factored form of
+ A. If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ AB, AFB, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
+
+ If FACT = 'F' and EQUED is not 'N', then A must have been
+ equilibrated by the scaling factors in R and/or C. AB is not
+ modified if FACT = 'F' or 'N', or if FACT = 'E' and
+ EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ AFB (input or output) REAL array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains details of the LU factorization of the band matrix
+ A, as computed by SGBTRF. U is stored as an upper triangular
+ band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
+ and the multipliers used during the factorization are stored
+
+ in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
+ the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns details of the LU factorization of A.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns details of the LU factorization of the equilibrated
+ matrix A (see the description of AB for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
+
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = L*U
+ as computed by SGBTRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) REAL array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) REAL array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) REAL array, dimension (3*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+
+ value of RCOND would suggest.
+ =====================================================================
+ Moved setting of INFO = N+1 so INFO does not subsequently get
+ overwritten. Sven, 17 Mar 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param trans
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param ipiv
+ * @param equed
+ * @param r
+ * @param c
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgbsvx(String fact, String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, int[] ipiv, StringW equed, float[] r, float[] c, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBTF2 computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * * + + + * * * u14 u25 u36
+ * * + + + + * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U, because of fill-in resulting from the row
+ interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param info
+ */
+ public abstract void sgbtf2(int m, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBTRF computes an LU factorization of a real m-by-n band matrix A
+ using partial pivoting with row interchanges.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows KL+1 to
+ 2*KL+KU+1; rows 1 to KL of the array need not be set.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, details of the factorization: U is stored as an
+ upper triangular band matrix with KL+KU superdiagonals in
+ rows 1 to KL+KU+1, and the multipliers used during the
+ factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+ See below for further details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ M = N = 6, KL = 2, KU = 1:
+
+ On entry: On exit:
+
+ * * * + + + * * * u14 u25 u36
+ * * + + + + * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+ a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
+ a31 a42 a53 a64 * * m31 m42 m53 m64 * *
+
+ Array elements marked * are not used by the routine; elements marked
+
+ + need not be set on entry, but are required by the routine to store
+
+ elements of U because of fill-in resulting from the row interchanges.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param info
+ */
+ public abstract void sgbtrf(int m, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGBTRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general band matrix A using the LU factorization computed
+ by SGBTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ Details of the LU factorization of the band matrix A, as
+ computed by SGBTRF. U is stored as an upper triangular band
+
+ matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
+ the multipliers used during the factorization are stored in
+ rows KL+KU+2 to 2*KL+KU+1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= N, row i of the matrix was
+ interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param kl
+ * @param ku
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sgbtrs(String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBAK forms the right or left eigenvectors of a real general matrix
+
+ by backward transformation on the computed eigenvectors of the
+ balanced matrix output by SGEBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N', do nothing, return immediately;
+ = 'P', do backward transformation for permutation only;
+ = 'S', do backward transformation for scaling only;
+ = 'B', do backward transformations for both permutation and
+ scaling.
+ JOB must be the same as the argument JOB supplied to SGEBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by SGEBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ SCALE (input) REAL array, dimension (N)
+ Details of the permutation and scaling factors, as returned
+ by SGEBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) REAL array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by SHSEIN or STREVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param side
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param scale
+ * @param m
+ * @param v
+ * @param ldv
+ * @param info
+ */
+ public abstract void sgebak(String job, String side, int n, int ilo, int ihi, float[] scale, int m, float[] v, int ldv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBAL balances a general real matrix A. This involves, first,
+ permuting A by a similarity transformation to isolate eigenvalues
+ in the first 1 to ILO-1 and last IHI+1 to N elements on the
+ diagonal; and second, applying a diagonal similarity transformation
+ to rows and columns ILO to IHI to make the rows and columns as
+ close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrix, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A:
+ = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+ for i = 1,...,N;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ SCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied to
+ A. If P(j) is the index of the row and column interchanged
+ with row and column j and D(j) is the scaling factor
+ applied to row and column j, then
+ SCALE(j) = P(j) for j = 1,...,ILO-1
+ = D(j) for j = ILO,...,IHI
+ = P(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The permutations consist of row and column interchanges which put
+ the matrix in the form
+
+ ( T1 X Y )
+ P A P = ( 0 B Z )
+ ( 0 0 T2 )
+
+ where T1 and T2 are upper triangular matrices whose eigenvalues lie
+ along the diagonal. The column indices ILO and IHI mark the starting
+ and ending columns of the submatrix B. Balancing consists of applying
+ a diagonal similarity transformation inv(D) * B * D to make the
+ 1-norms of each row of B and its corresponding column nearly equal.
+ The output matrix is
+
+ ( T1 X*D Y )
+ ( 0 inv(D)*B*D inv(D)*Z ).
+ ( 0 0 T2 )
+
+ Information about the permutations P and the diagonal matrix D is
+ returned in the vector SCALE.
+
+ This subroutine is based on the EISPACK routine BALANC.
+
+ Modified by Tzu-Yi Chen, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param n
+ * @param a
+ * @param lda
+ * @param ilo
+ * @param ihi
+ * @param scale
+ * @param info
+ */
+ public abstract void sgebal(String job, int n, float[] a, int lda, intW ilo, intW ihi, float[] scale, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBD2 reduces a real general m by n matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) REAL array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) REAL array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace) REAL array, dimension (max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tauq
+ * @param taup
+ * @param work
+ * @param info
+ */
+ public abstract void sgebd2(int m, int n, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEBRD reduces a general real M-by-N matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
+
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) REAL array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) REAL array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,M,N).
+ For optimum performance LWORK >= (M+N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+
+ the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tauq
+ * @param taup
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgebrd(int m, int n, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGECON estimates the reciprocal of the condition number of a general
+
+ real matrix A, in either the 1-norm or the infinity-norm, using
+ the LU factorization computed by SGETRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by SGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) REAL
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param a
+ * @param lda
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgecon(String norm, int n, float[] a, int lda, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEEQU computes row and column scalings intended to equilibrate an
+ M-by-N matrix A and reduce its condition number. R returns the row
+ scale factors and C the column scale factors, chosen to try to make
+ the largest element in each row and column of the matrix B with
+ elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
+
+ R(i) and C(j) are restricted to be between SMLNUM = smallest safe
+ number and BIGNUM = largest safe number. Use of these scaling
+ factors is not guaranteed to reduce the condition number of A but
+ works well in practice.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The M-by-N matrix whose equilibration factors are
+ to be computed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ R (output) REAL array, dimension (M)
+ If INFO = 0 or INFO > M, R contains the row scale factors
+ for A.
+
+ C (output) REAL array, dimension (N)
+ If INFO = 0, C contains the column scale factors for A.
+
+ ROWCND (output) REAL
+ If INFO = 0 or INFO > M, ROWCND contains the ratio of the
+ smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
+ AMAX is neither too large nor too small, it is not worth
+ scaling by R.
+
+ COLCND (output) REAL
+ If INFO = 0, COLCND contains the ratio of the smallest
+ C(i) to the largest C(i). If COLCND >= 0.1, it is not
+ worth scaling by C.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= M: the i-th row of A is exactly zero
+ > M: the (i-M)-th column of A is exactly zero
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param info
+ */
+ public abstract void sgeequ(int m, int n, float[] a, int lda, float[] r, float[] c, floatW rowcnd, floatW colcnd, floatW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEES computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left.
+ The leading columns of Z then form an orthonormal basis for the
+ invariant subspace corresponding to the selected eigenvalues.
+
+ A matrix is in real Schur form if it is upper quasi-triangular with
+ 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
+ form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two REAL arguments
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
+ conjugate pair of eigenvalues is selected, then both complex
+
+ eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO is set to N+2 (see INFO below).
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues in the same order
+ that they appear on the diagonal of the output Schur form T.
+
+ Complex conjugate pairs of eigenvalues will appear
+ consecutively with the eigenvalue having the positive
+ imaginary part first.
+
+ VS (output) REAL array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1; if
+ JOBVS = 'V', LDVS >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the matrix which reduces A
+
+ to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvs
+ * @param sort
+ * @param select
+ * @param n
+ * @param a
+ * @param lda
+ * @param sdim
+ * @param wr
+ * @param wi
+ * @param vs
+ * @param ldvs
+ * @param work
+ * @param lwork
+ * @param bwork
+ * @param info
+ */
+ public void sgees(String jobvs, String sort, Object select, int n, float[] a, int lda, intW sdim, float[] wr, float[] wi, float[] vs, int ldvs, float[] work, int lwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Sgees.sgees(jobvs, sort, select, n, a, 0, lda, sdim, wr, 0, wi, 0, vs, 0, ldvs, work, 0, lwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEESX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues, the real Schur form T, and, optionally, the matrix of
+ Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T).
+
+
+ Optionally, it also orders the eigenvalues on the diagonal of the
+ real Schur form so that selected eigenvalues are at the top left;
+ computes a reciprocal condition number for the average of the
+ selected eigenvalues (RCONDE); and computes a reciprocal condition
+ number for the right invariant subspace corresponding to the
+ selected eigenvalues (RCONDV). The leading columns of Z form an
+ orthonormal basis for this invariant subspace.
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
+ these quantities are called s and sep respectively).
+
+ A real matrix is in real Schur form if it is upper quasi-triangular
+ with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
+
+ the form
+ [ a b ]
+ [ c a ]
+
+ where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
+
+ Arguments
+ =========
+
+ JOBVS (input) CHARACTER*1
+ = 'N': Schur vectors are not computed;
+ = 'V': Schur vectors are computed.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELECT).
+
+ SELECT (external procedure) LOGICAL FUNCTION of two REAL arguments
+ SELECT must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'S', SELECT is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ If SORT = 'N', SELECT is not referenced.
+ An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
+ SELECT(WR(j),WI(j)) is true; i.e., if either one of a
+ complex conjugate pair of eigenvalues is selected, then both
+
+ are. Note that a selected complex eigenvalue may no longer
+ satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
+ ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned); in this
+ case INFO may be set to N+3 (see INFO below).
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for average of selected eigenvalues only;
+ = 'V': Computed for selected right invariant subspace only;
+ = 'B': Computed for both.
+ If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the N-by-N matrix A.
+ On exit, A is overwritten by its real Schur form T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELECT is true. (Complex conjugate
+ pairs for which SELECT is true for either
+ eigenvalue count as 2.)
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts, respectively,
+ of the computed eigenvalues, in the same order that they
+ appear on the diagonal of the output Schur form T. Complex
+ conjugate pairs of eigenvalues appear consecutively with the
+
+ eigenvalue having the positive imaginary part first.
+
+ VS (output) REAL array, dimension (LDVS,N)
+ If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
+
+ vectors.
+ If JOBVS = 'N', VS is not referenced.
+
+ LDVS (input) INTEGER
+ The leading dimension of the array VS. LDVS >= 1, and if
+ JOBVS = 'V', LDVS >= N.
+
+ RCONDE (output) REAL
+ If SENSE = 'E' or 'B', RCONDE contains the reciprocal
+ condition number for the average of the selected eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) REAL
+ If SENSE = 'V' or 'B', RCONDV contains the reciprocal
+ condition number for the selected right invariant subspace.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N).
+ Also, if SENSE = 'E' or 'V' or 'B',
+ LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
+ selected eigenvalues computed by this routine. Note that
+ N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
+ returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
+
+ 'B' this may not be large enough.
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates upper bounds on the optimal sizes of the
+ arrays WORK and IWORK, returns these values as the first
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
+
+ Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
+
+ only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
+ may not be large enough.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates upper bounds on the optimal sizes of
+
+ the arrays WORK and IWORK, returns these values as the first
+
+ entries of the WORK and IWORK arrays, and no error messages
+ related to LWORK or LIWORK are issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is
+ <= N: the QR algorithm failed to compute all the
+ eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
+ contain those eigenvalues which have converged; if
+ JOBVS = 'V', VS contains the transformation which
+ reduces A to its partially converged Schur form.
+ = N+1: the eigenvalues could not be reordered because some
+ eigenvalues were too close to separate (the problem
+
+ is very ill-conditioned);
+ = N+2: after reordering, roundoff changed values of some
+ complex eigenvalues so that leading eigenvalues in
+ the Schur form no longer satisfy SELECT=.TRUE. This
+ could also be caused by underflow due to scaling.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvs
+ * @param sort
+ * @param select
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param sdim
+ * @param wr
+ * @param wi
+ * @param vs
+ * @param ldvs
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param bwork
+ * @param info
+ */
+ public void sgeesx(String jobvs, String sort, Object select, String sense, int n, float[] a, int lda, intW sdim, float[] wr, float[] wi, float[] vs, int ldvs, floatW rconde, floatW rcondv, float[] work, int lwork, int[] iwork, int liwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Sgeesx.sgeesx(jobvs, sort, select, sense, n, a, 0, lda, sdim, wr, 0, wi, 0, vs, 0, ldvs, rconde, rcondv, work, 0, lwork, iwork, 0, liwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEEV computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1; if
+ JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N), and
+ if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
+ performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors have been computed;
+ elements i+1:N of WR and WI contain eigenvalues which
+ have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvl
+ * @param jobvr
+ * @param n
+ * @param a
+ * @param lda
+ * @param wr
+ * @param wi
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgeev(String jobvl, String jobvr, int n, float[] a, int lda, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEEVX computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
+ (RCONDE), and reciprocal condition numbers for the right
+ eigenvectors (RCONDV).
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Balancing a matrix means permuting the rows and columns to make it
+ more nearly upper triangular, and applying a diagonal similarity
+ transformation D * A * D**(-1), where D is a diagonal matrix, to
+ make its rows and columns closer in norm and the condition numbers
+ of its eigenvalues and eigenvectors smaller. The computed
+ reciprocal condition numbers correspond to the balanced matrix.
+ Permuting rows and columns will not change the condition numbers
+ (in exact arithmetic) but diagonal scaling will. For further
+ explanation of balancing, see section 4.10.2 of the LAPACK
+ Users' Guide.
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Indicates how the input matrix should be diagonally scaled
+ and/or permuted to improve the conditioning of its
+ eigenvalues.
+ = 'N': Do not diagonally scale or permute;
+ = 'P': Perform permutations to make the matrix more nearly
+ upper triangular. Do not diagonally scale;
+ = 'S': Diagonally scale the matrix, i.e. replace A by
+ D*A*D**(-1), where D is a diagonal matrix chosen
+ to make the rows and columns of A more equal in
+ norm. Do not permute;
+ = 'B': Both diagonally scale and permute A.
+
+ Computed reciprocal condition numbers will be for the matrix
+
+ after balancing and/or permuting. Permuting does not change
+ condition numbers (in exact arithmetic), but balancing does.
+
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVL must = 'V'.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+ If SENSE = 'E' or 'B', JOBVR must = 'V'.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': None are computed;
+ = 'E': Computed for eigenvalues only;
+ = 'V': Computed for right eigenvectors only;
+ = 'B': Computed for eigenvalues and right eigenvectors.
+
+ If SENSE = 'E' or 'B', both left and right eigenvectors
+ must also be computed (JOBVL = 'V' and JOBVR = 'V').
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten. If JOBVL = 'V' or
+ JOBVR = 'V', A contains the real Schur form of the balanced
+ version of the input matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues will appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values determined when A was
+ balanced. The balanced A(i,j) = 0 if I > J and
+ J = 1,...,ILO-1 or I = IHI+1,...,N.
+
+ SCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ when balancing A. If P(j) is the index of the row and column
+ interchanged with row and column j, and D(j) is the scaling
+ factor applied to row and column j, then
+ SCALE(J) = P(J), for J = 1,...,ILO-1
+ = D(J), for J = ILO,...,IHI
+ = P(J) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) REAL
+ The one-norm of the balanced matrix (the maximum
+ of the sum of absolute values of elements of any column).
+
+ RCONDE (output) REAL array, dimension (N)
+ RCONDE(j) is the reciprocal condition number of the j-th
+ eigenvalue.
+
+ RCONDV (output) REAL array, dimension (N)
+ RCONDV(j) is the reciprocal condition number of the j-th
+ right eigenvector.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. If SENSE = 'N' or 'E',
+ LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
+ LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (2*N-2)
+ If SENSE = 'N' or 'E', not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors or condition numbers
+ have been computed; elements 1:ILO-1 and i+1:N of WR
+ and WI contain eigenvalues which have converged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param balanc
+ * @param jobvl
+ * @param jobvr
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param wr
+ * @param wi
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param ilo
+ * @param ihi
+ * @param scale
+ * @param abnrm
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgeevx(String balanc, String jobvl, String jobvr, String sense, int n, float[] a, int lda, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, intW ilo, intW ihi, float[] scale, floatW abnrm, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGGES.
+
+ SGEGS computes the eigenvalues, real Schur form, and, optionally,
+ left and or/right Schur vectors of a real matrix pair (A,B).
+ Given two square matrices A and B, the generalized real Schur
+ factorization has the form
+
+ A = Q*S*Z**T, B = Q*T*Z**T
+
+ where Q and Z are orthogonal matrices, T is upper triangular, and S
+ is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
+ blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
+ of eigenvalues of (A,B). The columns of Q are the left Schur vectors
+ and the columns of Z are the right Schur vectors.
+
+ If only the eigenvalues of (A,B) are needed, the driver routine
+ SGEGV should be used instead. See SGEGV for a description of the
+ eigenvalues of the generalized nonsymmetric eigenvalue problem
+ (GNEP).
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors (returned in VSL).
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors (returned in VSR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A.
+ On exit, the upper quasi-triangular matrix S from the
+ generalized real Schur factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B.
+ On exit, the upper triangular matrix T from the generalized
+ real Schur factorization.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) REAL array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and (j+1)-st
+ eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) REAL array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VSL (output) REAL array, dimension (LDVSL,N)
+ If JOBVSL = 'V', the matrix of left Schur vectors Q.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) REAL array, dimension (LDVSR,N)
+ If JOBVSR = 'V', the matrix of right Schur vectors Z.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,4*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for SGEQRF, SORMQR, and SORGQR.) Then compute:
+ NB -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR
+ The optimal LWORK is 2*N + N*(NB+1).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from SGGBAL
+ =N+2: error return from SGEQRF
+ =N+3: error return from SORMQR
+ =N+4: error return from SORGQR
+ =N+5: error return from SGGHRD
+ =N+6: error return from SHGEQZ (other than failed
+ iteration)
+ =N+7: error return from SGGBAK (computing VSL)
+ =N+8: error return from SGGBAK (computing VSR)
+ =N+9: error return from SLASCL (various places)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvsl
+ * @param jobvsr
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vsl
+ * @param ldvsl
+ * @param vsr
+ * @param ldvsr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgegs(String jobvsl, String jobvsr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vsl, int ldvsl, float[] vsr, int ldvsr, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGGEV.
+
+ SGEGV computes the eigenvalues and, optionally, the left and/or right
+ eigenvectors of a real matrix pair (A,B).
+ Given two square matrices A and B,
+ the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+ eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+ that
+
+ A*x = lambda*B*x.
+
+ An alternate form is to find the eigenvalues mu and corresponding
+ eigenvectors y such that
+
+ mu*A*y = B*y.
+
+ These two forms are equivalent with mu = 1/lambda and x = y if
+ neither lambda nor mu is zero. In order to deal with the case that
+ lambda or mu is zero or small, two values alpha and beta are returned
+ for each eigenvalue, such that lambda = alpha/beta and
+ mu = beta/alpha.
+
+ The vectors x and y in the above equations are right eigenvectors of
+
+ the matrix pair (A,B). Vectors u and v satisfying
+
+ u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+
+ are left eigenvectors of (A,B).
+
+ Note: this routine performs "full balancing" on A and B -- see
+ "Further Details", below.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors (returned
+ in VL).
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors (returned
+
+ in VR).
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit A
+ contains the real Schur form of A from the generalized Schur
+
+ factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only the diagonal
+ blocks from the Schur form will be correct. See SGGHRD and
+ SHGEQZ for details.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B.
+ If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+ upper triangular matrix obtained from B in the generalized
+ Schur factorization of the pair (A,B) after balancing.
+ If no eigenvectors were computed, then only those elements of
+ B corresponding to the diagonal blocks from the Schur form of
+ A will be correct. See SGGHRD and SHGEQZ for details.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue of
+ GNEP.
+
+ ALPHAI (output) REAL array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+ eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) REAL array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored
+ in the columns of VL, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ u(j) = VL(:,j) + i*VL(:,j+1)
+ and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvectors
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors x(j) are stored
+ in the columns of VR, in the same order as their eigenvalues.
+ If the j-th eigenvalue is real, then x(j) = VR(:,j).
+ If the j-th and (j+1)-st eigenvalues form a complex conjugate
+ pair, then
+ x(j) = VR(:,j) + i*VR(:,j+1)
+ and
+ x(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ Each eigenvector is scaled so that its largest component has
+
+ abs(real part) + abs(imag. part) = 1, except for eigenvalues
+
+ corresponding to an eigenvalue with alpha = beta = 0, which
+ are set to zero.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+ To compute the optimal value of LWORK, call ILAENV to get
+ blocksizes (for SGEQRF, SORMQR, and SORGQR.) Then compute:
+ NB -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR;
+
+ The optimal LWORK is:
+ 2*N + MAX( 6*N, N*(NB+1) ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: errors that usually indicate LAPACK problems:
+ =N+1: error return from SGGBAL
+ =N+2: error return from SGEQRF
+ =N+3: error return from SORMQR
+ =N+4: error return from SORGQR
+ =N+5: error return from SGGHRD
+ =N+6: error return from SHGEQZ (other than failed
+ iteration)
+ =N+7: error return from STGEVC
+ =N+8: error return from SGGBAK (computing VL)
+ =N+9: error return from SGGBAK (computing VR)
+ =N+10: error return from SLASCL (various calls)
+
+ Further Details
+ ===============
+
+ Balancing
+ ---------
+
+ This driver calls SGGBAL to both permute and scale rows and columns
+ of A and B. The permutations PL and PR are chosen so that PL*A*PR
+ and PL*B*R will be upper triangular except for the diagonal blocks
+ A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
+ possible. The diagonal scaling matrices DL and DR are chosen so
+ that the pair DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
+ one (except for the elements that start out zero.)
+
+ After the eigenvalues and eigenvectors of the balanced matrices
+ have been computed, SGGBAK transforms the eigenvectors back to what
+ they would have been (in perfect arithmetic) if they had not been
+ balanced.
+
+ Contents of A and B on Exit
+ -------- -- - --- - -- ----
+
+ If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
+ both), then on exit the arrays A and B will contain the real Schur
+ form[*] of the "balanced" versions of A and B. If no eigenvectors
+ are computed, then only the diagonal blocks will be correct.
+
+ [*] See SHGEQZ, SGEGS, or read the book "Matrix Computations",
+ by Golub & van Loan, pub. by Johns Hopkins U. Press.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvl
+ * @param jobvr
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgegv(String jobvl, String jobvr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEHD2 reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to SGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= max(1,N).
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the n by n general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sgehd2(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEHRD reduces a real general matrix A to upper Hessenberg form H by
+
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to SGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+ zero.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's SGEHRD
+ subroutine incorporating improvements proposed by Quintana-Orti and
+ Van de Geijn (2005).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgehrd(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELQ2 computes an LQ factorization of a real m by n matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m by min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sgelq2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELQF computes an LQ factorization of a real M-by-N matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and below the diagonal of the array
+
+ contain the m-by-min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgelqf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELS solves overdetermined or underdetermined real linear systems
+ involving an M-by-N matrix A, or its transpose, using a QR or LQ
+ factorization of A. It is assumed that A has full rank.
+
+ The following options are provided:
+
+ 1. If TRANS = 'N' and m >= n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A*X ||.
+
+ 2. If TRANS = 'N' and m < n: find the minimum norm solution of
+ an underdetermined system A * X = B.
+
+ 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
+ an undetermined system A**T * X = B.
+
+ 4. If TRANS = 'T' and m < n: find the least squares solution of
+ an overdetermined system, i.e., solve the least squares problem
+ minimize || B - A**T * X ||.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N': the linear system involves A;
+ = 'T': the linear system involves A**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of the matrices B and X. NRHS >=0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if M >= N, A is overwritten by details of its QR
+ factorization as returned by SGEQRF;
+ if M < N, A is overwritten by details of its LQ
+ factorization as returned by SGELQF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the matrix B of right hand side vectors, stored
+ columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+ if TRANS = 'T'.
+ On exit, if INFO = 0, B is overwritten by the solution
+ vectors, stored columnwise:
+ if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+ squares solution vectors; the residual sum of squares for the
+ solution in each column is given by the sum of squares of
+ elements N+1 to M in that column;
+ if TRANS = 'N' and m < n, rows 1 to N of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+ minimum norm solution vectors;
+ if TRANS = 'T' and m < n, rows 1 to M of B contain the
+ least squares solution vectors; the residual sum of squares
+ for the solution in each column is given by the sum of
+ squares of elements M+1 to N in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= MAX(1,M,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= max( 1, MN + max( MN, NRHS ) ).
+ For optimal performance,
+ LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
+ where MN = min(M,N) and NB is the optimum block size.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of the
+ triangular factor of A is zero, so that A does not have
+ full rank; the least squares solution could not be
+ computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgels(String trans, int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELSD computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize 2-norm(| b - A*x |)
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The problem is solved in three steps:
+ (1) Reduce the coefficient matrix A to bidiagonal form with
+ Householder transformations, reducing the original problem
+ into a "bidiagonal least squares problem" (BLS)
+ (2) Solve the BLS using a divide and conquer approach.
+ (3) Apply back all the Householder tranformations to solve
+ the original least squares problem.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK must be at least 1.
+ The exact minimum amount of workspace needed depends on M,
+ N and NRHS. As long as LWORK is at least
+ 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
+ if M is greater than or equal to N or
+ 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
+ if M is less than N, the code will execute correctly.
+ SMLSIZ is returned by ILAENV and is equal to the maximum
+ size of the subproblems at the bottom of the computation
+ tree (usually about 25), and
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the array WORK and the
+ minimum size of the array IWORK, and returns these values as
+
+ the first entries of the WORK and IWORK arrays, and no error
+
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ LIWORK >= max(1, 3*MINMN*NLVL + 11*MINMN),
+ where MINMN = MIN( M,N ).
+ On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param s
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgelsd(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] s, float rcond, intW rank, float[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELSS computes the minimum norm solution to a real linear least
+ squares problem:
+
+ Minimize 2-norm(| b - A*x |).
+
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
+
+ X.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+
+ value.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the first min(m,n) rows of A are overwritten with
+ its right singular vectors, stored rowwise.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1, and also:
+ LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param s
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgelss(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] s, float rcond, intW rank, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGELSY.
+
+ SGELSX computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+ If m >= n and RANK = n, the residual sum-of-squares for
+ the solution in the i-th column is given by the sum of
+ squares of elements N+1:M in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is an
+ initial column, otherwise it is a free column. Before
+ the QR factorization of A, all initial columns are
+ permuted to the leading positions; only the remaining
+ free columns are moved as a result of column pivoting
+ during the factorization.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace) REAL array, dimension
+ (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param jpvt
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param info
+ */
+ public abstract void sgelsx(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, int[] jpvt, float rcond, intW rank, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGELSY computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize || A * X - B ||
+ using a complete orthogonal factorization of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The routine first computes a QR factorization with column pivoting:
+ A * P = Q * [ R11 R12 ]
+ [ 0 R22 ]
+ with R11 defined as the largest leading submatrix whose estimated
+ condition number is less than 1/RCOND. The order of R11, RANK,
+ is the effective rank of A.
+
+ Then, R22 is considered to be negligible, and R12 is annihilated
+ by orthogonal transformations from the right, arriving at the
+ complete orthogonal factorization:
+ A * P = Q * [ T11 0 ] * Z
+ [ 0 0 ]
+ The minimum-norm solution is then
+ X = P * Z' [ inv(T11)*Q1'*B ]
+ [ 0 ]
+ where Q1 consists of the first RANK columns of Q.
+
+ This routine is basically identical to the original xGELSX except
+ three differences:
+ o The call to the subroutine xGEQPF has been substituted by the
+ the call to the subroutine xGEQP3. This subroutine is a Blas-3
+ version of the QR factorization with column pivoting.
+ o Matrix B (the right hand side) is updated with Blas-3.
+ o The permutation of matrix B (the right hand side) is faster and
+ more simple.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of
+ columns of matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been overwritten by details of its
+ complete orthogonal factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of AP, otherwise column i is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of AP
+ was the k-th column of A.
+
+ RCOND (input) REAL
+ RCOND is used to determine the effective rank of A, which
+ is defined as the order of the largest leading triangular
+ submatrix R11 in the QR factorization with pivoting of A,
+ whose estimated condition number < 1/RCOND.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the order of the submatrix
+ R11. This is the same as the order of the submatrix T11
+ in the complete orthogonal factorization of A.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ The unblocked strategy requires that:
+ LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
+ where MN = min( M, N ).
+ The block algorithm requires that:
+ LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
+ where NB is an upper bound on the blocksize returned
+ by ILAENV for the routines SGEQP3, STZRZF, STZRQF, SORMQR,
+ and SORMRZ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param jpvt
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgelsy(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, int[] jpvt, float rcond, intW rank, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQL2 computes a QL factorization of a real m by n matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the m by n lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sgeql2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQLF computes a QL factorization of a real M-by-N matrix A:
+ A = Q * L.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m >= n, the lower triangle of the subarray
+ A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
+ if m <= n, the elements on and below the (n-m)-th
+ superdiagonal contain the M-by-N lower trapezoidal matrix L;
+
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of elementary reflectors
+ (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
+
+ A(1:m-k+i-1,n-k+i), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgeqlf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQP3 computes a QR factorization with column pivoting of a
+ matrix A: A*P = Q*R using Level 3 BLAS.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper trapezoidal matrix R; the elements below
+
+ the diagonal, together with the array TAU, represent the
+ orthogonal matrix Q as a product of min(M,N) elementary
+ reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(J).ne.0, the J-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(J)=0,
+ the J-th column of A is a free column.
+ On exit, if JPVT(J)=K, then the J-th column of A*P was the
+ the K-th column of A.
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO=0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 3*N+1.
+ For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real/complex scalar, and v is a real/complex vector
+ with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
+ A(i+1:m,i), and tau in TAU(i).
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgeqp3(int m, int n, float[] a, int lda, int[] jpvt, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SGEQP3.
+
+ SGEQPF computes a QR factorization with column pivoting of a
+ real M-by-N matrix A: A*P = Q*R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of the array contains the
+ min(M,N)-by-N upper triangular matrix R; the elements
+ below the diagonal, together with the array TAU,
+ represent the orthogonal matrix Q as a product of
+ min(m,n) elementary reflectors.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(n)
+
+ Each H(i) has the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
+
+
+ The matrix P is represented in jpvt as follows: If
+ jpvt(j) = i
+ then the jth column of P is the ith canonical unit vector.
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sgeqpf(int m, int n, float[] a, int lda, int[] jpvt, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQR2 computes a QR factorization of a real m by n matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(m,n) by n upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sgeqr2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGEQRF computes a QR factorization of a real M-by-N matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of min(m,n) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+
+ and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgeqrf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGERFS improves the computed solution to a system of linear
+ equations and provides error bounds and backward error estimates for
+
+ the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The original N-by-N matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) REAL array, dimension (LDAF,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by SGETRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SGETRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgerfs(String trans, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGERQ2 computes an RQ factorization of a real m by n matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the m by n upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAU, represent the orthogonal matrix
+ Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sgerq2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGERQF computes an RQ factorization of a real M-by-N matrix A:
+ A = R * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if m <= n, the upper triangle of the subarray
+ A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
+ if m >= n, the elements on and above the (m-n)-th subdiagonal
+ contain the M-by-N upper trapezoidal matrix R;
+ the remaining elements, with the array TAU, represent the
+ orthogonal matrix Q as a product of min(m,n) elementary
+ reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgerqf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESC2 solves a system of linear equations
+
+ A * X = scale* RHS
+
+ with a general N-by-N matrix A using the LU factorization with
+ complete pivoting computed by SGETC2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ A (input) REAL array, dimension (LDA,N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix A computed by SGETC2: A = P * L * U * Q
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, N).
+
+ RHS (input/output) REAL array, dimension (N).
+ On entry, the right hand side vector b.
+ On exit, the solution vector X.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ SCALE (output) REAL
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ 0 <= SCALE <= 1 to prevent owerflow in the solution.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param rhs
+ * @param ipiv
+ * @param jpiv
+ * @param scale
+ */
+ public abstract void sgesc2(int n, float[] a, int lda, float[] rhs, int[] ipiv, int[] jpiv, floatW scale);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESDD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and right singular
+ vectors. If singular vectors are desired, it uses a
+ divide-and-conquer algorithm.
+
+ The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns VT = V**T, not V.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U and all N rows of V**T are
+ returned in the arrays U and VT;
+ = 'S': the first min(M,N) columns of U and the first
+ min(M,N) rows of V**T are returned in the arrays U
+ and VT;
+ = 'O': If M >= N, the first N columns of U are overwritten
+ on the array A and all rows of V**T are returned in
+ the array VT;
+ otherwise, all columns of U are returned in the
+ array U and the first M rows of V**T are overwritten
+
+ in the array A;
+ = 'N': no columns of U or rows of V**T are computed.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBZ = 'O', A is overwritten with the first N columns
+ of U (the left singular vectors, stored
+ columnwise) if M >= N;
+ A is overwritten with the first M rows
+ of V**T (the right singular vectors, stored
+ rowwise) otherwise.
+ if JOBZ .ne. 'O', the contents of A are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) REAL array, dimension (LDU,UCOL)
+ UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
+ UCOL = min(M,N) if JOBZ = 'S'.
+ If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
+
+ orthogonal matrix U;
+ if JOBZ = 'S', U contains the first min(M,N) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
+
+ VT (output) REAL array, dimension (LDVT,N)
+ If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
+ N-by-N orthogonal matrix V**T;
+ if JOBZ = 'S', VT contains the first min(M,N) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
+ if JOBZ = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ If JOBZ = 'N',
+ LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)).
+ If JOBZ = 'O',
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+ If JOBZ = 'S' or 'A'
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+ For good performance, LWORK should generally be larger.
+ If LWORK = -1 but other input arguments are legal, WORK(1)
+ returns the optimal LWORK.
+
+ IWORK (workspace) INTEGER array, dimension (8*min(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: SBDSDC did not converge, updating process failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgesdd(String jobz, int m, int n, float[] a, int lda, float[] s, float[] u, int ldu, float[] vt, int ldvt, float[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as
+ A = P * L * U,
+ where P is a permutation matrix, L is unit lower triangular, and U is
+ upper triangular. The factored form of A is then used to solve the
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sgesv(int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESVD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and/or right singular
+
+ vectors. The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns V**T, not V.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+
+ = 'A': all M columns of U are returned in array U:
+ = 'S': the first min(m,n) columns of U (the left singular
+ vectors) are returned in the array U;
+ = 'O': the first min(m,n) columns of U (the left singular
+ vectors) are overwritten on the array A;
+ = 'N': no columns of U (no left singular vectors) are
+ computed.
+
+ JOBVT (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix
+ V**T:
+ = 'A': all N rows of V**T are returned in the array VT;
+ = 'S': the first min(m,n) rows of V**T (the right singular
+ vectors) are returned in the array VT;
+ = 'O': the first min(m,n) rows of V**T (the right singular
+ vectors) are overwritten on the array A;
+ = 'N': no rows of V**T (no right singular vectors) are
+ computed.
+
+ JOBVT and JOBU cannot both be 'O'.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBU = 'O', A is overwritten with the first min(m,n)
+ columns of U (the left singular vectors,
+ stored columnwise);
+ if JOBVT = 'O', A is overwritten with the first min(m,n)
+ rows of V**T (the right singular vectors,
+ stored rowwise);
+ if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
+ are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) REAL array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) REAL array, dimension (LDU,UCOL)
+ (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
+ If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
+ if JOBU = 'S', U contains the first min(m,n) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBU = 'N' or 'O', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBU = 'S' or 'A', LDU >= M.
+
+ VT (output) REAL array, dimension (LDVT,N)
+ If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
+ V**T;
+ if JOBVT = 'S', VT contains the first min(m,n) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBVT = 'N' or 'O', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+ if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
+ superdiagonal elements of an upper bidiagonal matrix B
+ whose diagonal is in S (not necessarily sorted). B
+ satisfies A = U * B * VT, so it has the same singular values
+
+ as A, and singular vectors related by U and VT.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if SBDSQR did not converge, INFO specifies how many
+ superdiagonals of an intermediate bidiagonal form B
+ did not converge to zero. See the description of WORK
+ above for details.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobu
+ * @param jobvt
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgesvd(String jobu, String jobvt, int m, int n, float[] a, int lda, float[] s, float[] u, int ldu, float[] vt, int ldvt, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGESVX uses the LU factorization to compute the solution to a real
+ system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
+ TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
+ TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
+ or diag(C)*B (if TRANS = 'T' or 'C').
+
+ 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
+ matrix A (after equilibration if FACT = 'E') as
+ A = P * L * U,
+ where P is a permutation matrix, L is a unit lower triangular
+ matrix, and U is upper triangular.
+
+ 3. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
+ that it solves the original system before equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF and IPIV contain the factored form of A.
+ If EQUED is not 'N', the matrix A has been
+ equilibrated with scaling factors given by R and C.
+ A, AF, and IPIV are not modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Transpose)
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
+ not 'N', then A must have been equilibrated by the scaling
+ factors in R and/or C. A is not modified if FACT = 'F' or
+ 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+ On exit, if EQUED .ne. 'N', A is scaled as follows:
+ EQUED = 'R': A := diag(R) * A
+ EQUED = 'C': A := A * diag(C)
+ EQUED = 'B': A := diag(R) * A * diag(C).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) REAL array, dimension (LDAF,N)
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the factors L and U from the factorization
+ A = P*L*U as computed by SGETRF. If EQUED .ne. 'N', then
+ AF is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the original matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the factors L and U from the factorization A = P*L*U
+
+ of the equilibrated matrix A (see the description of A for
+ the form of the equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the factorization A = P*L*U
+ as computed by SGETRF; row i of the matrix was interchanged
+ with row IPIV(i).
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the original matrix A.
+
+ If FACT = 'E', then IPIV is an output argument and on exit
+ contains the pivot indices from the factorization A = P*L*U
+ of the equilibrated matrix A.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ R (input or output) REAL array, dimension (N)
+ The row scale factors for A. If EQUED = 'R' or 'B', A is
+ multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
+ is not accessed. R is an input argument if FACT = 'F';
+ otherwise, R is an output argument. If FACT = 'F' and
+ EQUED = 'R' or 'B', each element of R must be positive.
+
+ C (input or output) REAL array, dimension (N)
+ The column scale factors for A. If EQUED = 'C' or 'B', A is
+
+ multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
+
+ is not accessed. C is an input argument if FACT = 'F';
+ otherwise, C is an output argument. If FACT = 'F' and
+ EQUED = 'C' or 'B', each element of C must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit,
+ if EQUED = 'N', B is not modified;
+ if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
+ diag(R)*B;
+ if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
+ overwritten by diag(C)*B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
+ to the original system of equations. Note that A and B are
+ modified on exit if EQUED .ne. 'N', and the solution to the
+ equilibrated system is inv(diag(C))*X if TRANS = 'N' and
+ EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
+ and EQUED = 'R' or 'B'.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) REAL array, dimension (4*N)
+ On exit, WORK(1) contains the reciprocal pivot growth
+ factor norm(A)/norm(U). The "max absolute element" norm is
+ used. If WORK(1) is much less than 1, then the stability
+ of the LU factorization of the (equilibrated) matrix A
+ could be poor. This also means that the solution X, condition
+ estimator RCOND, and forward error bound FERR could be
+ unreliable. If factorization fails with 0<INFO<=N, then
+ WORK(1) contains the reciprocal pivot growth factor for the
+ leading INFO columns of A.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization has
+ been completed, but the factor U is exactly
+ singular, so the solution and error bounds
+ could not be computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param equed
+ * @param r
+ * @param c
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgesvx(String fact, String trans, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, StringW equed, float[] r, float[] c, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETC2 computes an LU factorization with complete pivoting of the
+ n-by-n matrix A. The factorization has the form A = P * L * U * Q,
+ where P and Q are permutation matrices, L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ This is the Level 2 BLAS algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the n-by-n matrix A to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U*Q; the unit diagonal elements of L are not stored.
+
+ If U(k, k) appears to be less than SMIN, U(k, k) is given the
+ value of SMIN, i.e., giving a nonsingular perturbed system.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (output) INTEGER array, dimension(N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, U(k, k) is likely to produce owerflow if
+ we try to solve for x in Ax = b. So U is perturbed to
+ avoid the overflow.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param jpiv
+ * @param info
+ */
+ public abstract void sgetc2(int n, float[] a, int lda, int[] ipiv, int[] jpiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETF2 computes an LU factorization of a general m-by-n matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param info
+ */
+ public abstract void sgetf2(int m, int n, float[] a, int lda, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETRF computes an LU factorization of a general M-by-N matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param info
+ */
+ public abstract void sgetrf(int m, int n, float[] a, int lda, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETRI computes the inverse of a matrix using the LU factorization
+ computed by SGETRF.
+
+ This method inverts U and then computes inv(A) by solving the system
+
+ inv(A)*L = inv(U) for inv(A).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the factors L and U from the factorization
+ A = P*L*U as computed by SGETRF.
+ On exit, if INFO = 0, the inverse of the original matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimal performance LWORK >= N*NB, where NB is
+ the optimal blocksize returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
+ singular and its inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgetri(int n, float[] a, int lda, int[] ipiv, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGETRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general N-by-N matrix A using the LU factorization computed
+ by SGETRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by SGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from SGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sgetrs(String trans, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGBAK forms the right or left eigenvectors of a real generalized
+ eigenvalue problem A*x = lambda*B*x, by backward transformation on
+ the computed eigenvectors of the balanced pair of matrices output by
+
+ SGGBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N': do nothing, return immediately;
+ = 'P': do backward transformation for permutation only;
+ = 'S': do backward transformation for scaling only;
+ = 'B': do backward transformations for both permutation and
+
+ scaling.
+ JOB must be the same as the argument JOB supplied to SGGBAL.
+
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by SGGBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ LSCALE (input) REAL array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the left side of A and B, as returned by SGGBAL.
+
+ RSCALE (input) REAL array, dimension (N)
+ Details of the permutations and/or scaling factors applied
+ to the right side of A and B, as returned by SGGBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) REAL array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by STGEVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the matrix V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. Ward, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param job
+ * @param side
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param lscale
+ * @param rscale
+ * @param m
+ * @param v
+ * @param ldv
+ * @param info
+ */
+ public abstract void sggbak(String job, String side, int n, int ilo, int ihi, float[] lscale, float[] rscale, int m, float[] v, int ldv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGBAL balances a pair of general real matrices (A,B). This
+ involves, first, permuting A and B by similarity transformations to
+ isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
+ elements on the diagonal; and second, applying a diagonal similarity
+
+ transformation to rows and columns ILO to IHI to make the rows
+ and columns as close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrices, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors in the
+ generalized eigenvalue problem A*x = lambda*B*x.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A and B:
+ = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
+ and RSCALE(I) = 1.0 for i = 1,...,N.
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the input matrix B.
+ On exit, B is overwritten by the balanced matrix.
+ If JOB = 'N', B is not referenced.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If P(j) is the index of the
+ row interchanged with row j, and D(j)
+ is the scaling factor applied to row j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If P(j) is the index of the
+ column interchanged with column j, and D(j)
+ is the scaling factor applied to column j, then
+ LSCALE(j) = P(j) for J = 1,...,ILO-1
+ = D(j) for J = ILO,...,IHI
+ = P(j) for J = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ WORK (workspace) REAL array, dimension (lwork)
+ lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
+
+ at least 1 when JOB = 'N' or 'P'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ See R.C. WARD, Balancing the generalized eigenvalue problem,
+ SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param ilo
+ * @param ihi
+ * @param lscale
+ * @param rscale
+ * @param work
+ * @param info
+ */
+ public abstract void sggbal(String job, int n, float[] a, int lda, float[] b, int ldb, intW ilo, intW ihi, float[] lscale, float[] rscale, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
+ the generalized eigenvalues, the generalized real Schur form (S,T),
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T.The
+ leading columns of VSL and VSR then form an orthonormal basis for the
+ corresponding left and right eigenspaces (deflating subspaces).
+
+ (If only the generalized eigenvalues are needed, use the driver
+ SGGEV instead, which is faster.)
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG);
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three REAL arguments
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+
+ Note that in the ill-conditioned case, a selected complex
+ eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
+
+ BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
+ in this case.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) REAL array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) REAL array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else LWORK >= max(8*N,6*N+16).
+ For good performance , LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ.
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in STGSEN.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvsl
+ * @param jobvsr
+ * @param sort
+ * @param selctg
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param sdim
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vsl
+ * @param ldvsl
+ * @param vsr
+ * @param ldvsr
+ * @param work
+ * @param lwork
+ * @param bwork
+ * @param info
+ */
+ public void sgges(String jobvsl, String jobvsr, String sort, Object selctg, int n, float[] a, int lda, float[] b, int ldb, intW sdim, float[] alphar, float[] alphai, float[] beta, float[] vsl, int ldvsl, float[] vsr, int ldvsr, float[] work, int lwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Sgges.sgges(jobvsl, jobvsr, sort, selctg, n, a, 0, lda, b, 0, ldb, sdim, alphar, 0, alphai, 0, beta, 0, vsl, 0, ldvsl, vsr, 0, ldvsr, work, 0, lwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGESX computes for a pair of N-by-N real nonsymmetric matrices
+ (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
+ optionally, the left and/or right matrices of Schur vectors (VSL and
+
+ VSR). This gives the generalized Schur factorization
+
+ (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )
+
+ Optionally, it also orders the eigenvalues so that a selected cluster
+ of eigenvalues appears in the leading diagonal blocks of the upper
+ quasi-triangular matrix S and the upper triangular matrix T; computes
+ a reciprocal condition number for the average of the selected
+ eigenvalues (RCONDE); and computes a reciprocal condition number for
+
+ the right and left deflating subspaces corresponding to the selected
+
+ eigenvalues (RCONDV). The leading columns of VSL and VSR then form
+ an orthonormal basis for the corresponding left and right eigenspaces
+ (deflating subspaces).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+ or a ratio alpha/beta = w, such that A - w*B is singular. It is
+ usually represented as the pair (alpha,beta), as there is a
+ reasonable interpretation for beta=0 or for both being zero.
+
+ A pair of matrices (S,T) is in generalized real Schur form if T is
+ upper triangular with non-negative diagonal and S is block upper
+ triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+ to real generalized eigenvalues, while 2-by-2 blocks of S will be
+ "standardized" by making the corresponding elements of T have the
+ form:
+ [ a 0 ]
+ [ 0 b ]
+
+ and the pair of corresponding 2-by-2 blocks in S and T will have a
+ complex conjugate pair of generalized eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBVSL (input) CHARACTER*1
+ = 'N': do not compute the left Schur vectors;
+ = 'V': compute the left Schur vectors.
+
+ JOBVSR (input) CHARACTER*1
+ = 'N': do not compute the right Schur vectors;
+ = 'V': compute the right Schur vectors.
+
+ SORT (input) CHARACTER*1
+ Specifies whether or not to order the eigenvalues on the
+ diagonal of the generalized Schur form.
+ = 'N': Eigenvalues are not ordered;
+ = 'S': Eigenvalues are ordered (see SELCTG).
+
+ SELCTG (external procedure) LOGICAL FUNCTION of three REAL arguments
+ SELCTG must be declared EXTERNAL in the calling subroutine.
+ If SORT = 'N', SELCTG is not referenced.
+ If SORT = 'S', SELCTG is used to select eigenvalues to sort
+ to the top left of the Schur form.
+ An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+ one of a complex conjugate pair of eigenvalues is selected,
+ then both complex eigenvalues are selected.
+ Note that a selected complex eigenvalue may no longer satisfy
+ SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
+
+ since ordering may change the value of complex eigenvalues
+ (especially if the eigenvalue is ill-conditioned), in this
+ case INFO is set to N+3.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N' : None are computed;
+ = 'E' : Computed for average of selected eigenvalues only;
+ = 'V' : Computed for selected deflating subspaces only;
+ = 'B' : Computed for both.
+ If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VSL, and VSR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the first of the pair of matrices.
+ On exit, A has been overwritten by its generalized Schur
+ form S.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the second of the pair of matrices.
+ On exit, B has been overwritten by its generalized Schur
+ form T.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ SDIM (output) INTEGER
+ If SORT = 'N', SDIM = 0.
+ If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+ for which SELCTG is true. (Complex conjugate pairs for which
+ SELCTG is true for either eigenvalue count as 2.)
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real Schur form of (A,B) were further reduced to
+ triangular form using 2-by-2 complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio.
+ However, ALPHAR and ALPHAI will be always less than and
+ usually comparable with norm(A) in magnitude, and BETA always
+ less than and usually comparable with norm(B).
+
+ VSL (output) REAL array, dimension (LDVSL,N)
+ If JOBVSL = 'V', VSL will contain the left Schur vectors.
+ Not referenced if JOBVSL = 'N'.
+
+ LDVSL (input) INTEGER
+ The leading dimension of the matrix VSL. LDVSL >=1, and
+ if JOBVSL = 'V', LDVSL >= N.
+
+ VSR (output) REAL array, dimension (LDVSR,N)
+ If JOBVSR = 'V', VSR will contain the right Schur vectors.
+ Not referenced if JOBVSR = 'N'.
+
+ LDVSR (input) INTEGER
+ The leading dimension of the matrix VSR. LDVSR >= 1, and
+ if JOBVSR = 'V', LDVSR >= N.
+
+ RCONDE (output) REAL array, dimension ( 2 )
+ If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
+ reciprocal condition numbers for the average of the selected
+
+ eigenvalues.
+ Not referenced if SENSE = 'N' or 'V'.
+
+ RCONDV (output) REAL array, dimension ( 2 )
+ If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
+ reciprocal condition numbers for the selected deflating
+ subspaces.
+ Not referenced if SENSE = 'N' or 'E'.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
+ LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
+ LWORK >= max( 8*N, 6*N+16 ).
+ Note that 2*SDIM*(N-SDIM) <= N*N/2.
+ Note also that an error is only returned if
+ LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
+ this may not be large enough.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the bound on the optimal size of the WORK
+ array and the minimum size of the IWORK array, returns these
+
+ values as the first entries of the WORK and IWORK arrays, and
+ no error message related to LWORK or LIWORK is issued by
+ XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
+ LIWORK >= N+6.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the bound on the optimal size of the
+
+ WORK array and the minimum size of the IWORK array, returns
+ these values as the first entries of the WORK and IWORK
+ arrays, and no error message related to LWORK or LIWORK is
+ issued by XERBLA.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ Not referenced if SORT = 'N'.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. (A,B) are not in Schur
+ form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ
+ =N+2: after reordering, roundoff changed values of
+ some complex eigenvalues so that leading
+ eigenvalues in the Generalized Schur form no
+ longer satisfy SELCTG=.TRUE. This could also
+ be caused due to scaling.
+ =N+3: reordering failed in STGSEN.
+
+ Further details
+ ===============
+
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / RCONDE( 1 ).
+
+ An approximate (asymptotic) bound on the maximum angular error in
+ the computed deflating subspaces is
+
+ EPS * norm((A, B)) / RCONDV( 2 ).
+
+ See LAPACK User's Guide, section 4.11 for more information.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvsl
+ * @param jobvsr
+ * @param sort
+ * @param selctg
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param sdim
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vsl
+ * @param ldvsl
+ * @param vsr
+ * @param ldvsr
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param bwork
+ * @param info
+ */
+ public void sggesx(String jobvsl, String jobvsr, String sort, Object selctg, String sense, int n, float[] a, int lda, float[] b, int ldb, intW sdim, float[] alphar, float[] alphai, float[] beta, float[] vsl, int ldvsl, float[] vsr, int ldvsr, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, int liwork, boolean[] bwork, intW info) {
+ org.netlib.lapack.Sggesx.sggesx(jobvsl, jobvsr, sort, selctg, sense, n, a, 0, lda, b, 0, ldb, sdim, alphar, 0, alphai, 0, beta, 0, vsl, 0, ldvsl, vsr, 0, ldvsr, rconde, 0, rcondv, 0, work, 0, lwork, iwork, 0, liwork, bwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j).
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B .
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ alpha/beta. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector is scaled so the largest component has
+ abs(real part)+abs(imag. part)=1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,8*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ.
+ =N+2: error return from STGEVC.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobvl
+ * @param jobvr
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sggev(String jobvl, String jobvr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
+ the generalized eigenvalues, and optionally, the left and/or right
+ generalized eigenvectors.
+
+ Optionally also, it computes a balancing transformation to improve
+ the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
+ LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
+ the eigenvalues (RCONDE), and reciprocal condition numbers for the
+ right eigenvectors (RCONDV).
+
+ A generalized eigenvalue for a pair of matrices (A,B) is a scalar
+ lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
+ singular. It is usually represented as the pair (alpha,beta), as
+ there is a reasonable interpretation for beta=0, and even for both
+ being zero.
+
+ The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
+
+ of (A,B) satisfies
+
+ A * v(j) = lambda(j) * B * v(j) .
+
+ The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
+ of (A,B) satisfies
+
+ u(j)**H * A = lambda(j) * u(j)**H * B.
+
+ where u(j)**H is the conjugate-transpose of u(j).
+
+
+ Arguments
+ =========
+
+ BALANC (input) CHARACTER*1
+ Specifies the balance option to be performed.
+ = 'N': do not diagonally scale or permute;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+ Computed reciprocal condition numbers will be for the
+ matrices after permuting and/or balancing. Permuting does
+ not change condition numbers (in exact arithmetic), but
+ balancing does.
+
+ JOBVL (input) CHARACTER*1
+ = 'N': do not compute the left generalized eigenvectors;
+ = 'V': compute the left generalized eigenvectors.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': do not compute the right generalized eigenvectors;
+ = 'V': compute the right generalized eigenvectors.
+
+ SENSE (input) CHARACTER*1
+ Determines which reciprocal condition numbers are computed.
+ = 'N': none are computed;
+ = 'E': computed for eigenvalues only;
+ = 'V': computed for eigenvectors only;
+ = 'B': computed for eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrices A, B, VL, and VR. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the matrix A in the pair (A,B).
+ On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then A contains the first part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDA (input) INTEGER
+ The leading dimension of A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the matrix B in the pair (A,B).
+ On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
+ or both, then B contains the second part of the real Schur
+ form of the "balanced" versions of the input A and B.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. If ALPHAI(j) is zero, then
+ the j-th eigenvalue is real; if positive, then the j-th and
+ (j+1)-st eigenvalues are a complex conjugate pair, with
+ ALPHAI(j+1) negative.
+
+ Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+ may easily over- or underflow, and BETA(j) may even be zero.
+
+ Thus, the user should avoid naively computing the ratio
+ ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
+ than and usually comparable with norm(A) in magnitude, and
+ BETA always less than and usually comparable with norm(B).
+
+ VL (output) REAL array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ u(j) = VL(:,j), the j-th column of VL. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVL = 'N'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the matrix VL. LDVL >= 1, and
+ if JOBVL = 'V', LDVL >= N.
+
+ VR (output) REAL array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order as
+ their eigenvalues. If the j-th eigenvalue is real, then
+ v(j) = VR(:,j), the j-th column of VR. If the j-th and
+ (j+1)-th eigenvalues form a complex conjugate pair, then
+ v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
+
+ Each eigenvector will be scaled so the largest component have
+ abs(real part) + abs(imag. part) = 1.
+ Not referenced if JOBVR = 'N'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the matrix VR. LDVR >= 1, and
+ if JOBVR = 'V', LDVR >= N.
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are integer values such that on exit
+ A(i,j) = 0 and B(i,j) = 0 if i > j and
+ j = 1,...,ILO-1 or i = IHI+1,...,N.
+ If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
+
+ LSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the left side of A and B. If PL(j) is the index of the
+ row interchanged with row j, and DL(j) is the scaling
+ factor applied to row j, then
+ LSCALE(j) = PL(j) for j = 1,...,ILO-1
+ = DL(j) for j = ILO,...,IHI
+ = PL(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ RSCALE (output) REAL array, dimension (N)
+ Details of the permutations and scaling factors applied
+ to the right side of A and B. If PR(j) is the index of the
+ column interchanged with column j, and DR(j) is the scaling
+ factor applied to column j, then
+ RSCALE(j) = PR(j) for j = 1,...,ILO-1
+ = DR(j) for j = ILO,...,IHI
+ = PR(j) for j = IHI+1,...,N
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ ABNRM (output) REAL
+ The one-norm of the balanced matrix A.
+
+ BBNRM (output) REAL
+ The one-norm of the balanced matrix B.
+
+ RCONDE (output) REAL array, dimension (N)
+ If SENSE = 'E' or 'B', the reciprocal condition numbers of
+ the eigenvalues, stored in consecutive elements of the array.
+ For a complex conjugate pair of eigenvalues two consecutive
+ elements of RCONDE are set to the same value. Thus RCONDE(j),
+ RCONDV(j), and the j-th columns of VL and VR all correspond
+ to the j-th eigenpair.
+ If SENSE = 'N' or 'V', RCONDE is not referenced.
+
+ RCONDV (output) REAL array, dimension (N)
+ If SENSE = 'V' or 'B', the estimated reciprocal condition
+ numbers of the eigenvectors, stored in consecutive elements
+ of the array. For a complex eigenvector two consecutive
+ elements of RCONDV are set to the same value. If the
+ eigenvalues cannot be reordered to compute RCONDV(j),
+ RCONDV(j) is set to 0; this can only occur when the true
+ value would be very small anyway.
+ If SENSE = 'N' or 'E', RCONDV is not referenced.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,2*N).
+ If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
+ LWORK >= max(1,6*N).
+ If SENSE = 'E', LWORK >= max(1,10*N).
+ If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N+6)
+ If SENSE = 'E', IWORK is not referenced.
+
+ BWORK (workspace) LOGICAL array, dimension (N)
+ If SENSE = 'N', BWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1,...,N:
+ The QZ iteration failed. No eigenvectors have been
+ calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
+ should be correct for j=INFO+1,...,N.
+ > N: =N+1: other than QZ iteration failed in SHGEQZ.
+ =N+2: error return from STGEVC.
+
+ Further Details
+ ===============
+
+ Balancing a matrix pair (A,B) includes, first, permuting rows and
+ columns to isolate eigenvalues, second, applying diagonal similarity
+
+ transformation to the rows and columns to make the rows and columns
+ as close in norm as possible. The computed reciprocal condition
+ numbers correspond to the balanced matrix. Permuting rows and columns
+ will not change the condition numbers (in exact arithmetic) but
+ diagonal scaling will. For further explanation of balancing, see
+ section 4.11.1.2 of LAPACK Users' Guide.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)
+
+ An approximate error bound for the angle between the i-th computed
+ eigenvector VL(i) or VR(i) is given by
+
+ EPS * norm(ABNRM, BBNRM) / DIF(i).
+
+ For further explanation of the reciprocal condition numbers RCONDE
+ and RCONDV, see section 4.11 of LAPACK User's Guide.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param balanc
+ * @param jobvl
+ * @param jobvr
+ * @param sense
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param ilo
+ * @param ihi
+ * @param lscale
+ * @param rscale
+ * @param abnrm
+ * @param bbnrm
+ * @param rconde
+ * @param rcondv
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param bwork
+ * @param info
+ */
+ public abstract void sggevx(String balanc, String jobvl, String jobvr, String sense, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, intW ilo, intW ihi, float[] lscale, float[] rscale, floatW abnrm, floatW bbnrm, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, boolean[] bwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGGLM solves a general Gauss-Markov linear model (GLM) problem:
+
+ minimize || y ||_2 subject to d = A*x + B*y
+ x
+
+ where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
+ given N-vector. It is assumed that M <= N <= M+P, and
+
+ rank(A) = M and rank( A B ) = N.
+
+ Under these assumptions, the constrained equation is always
+ consistent, and there is a unique solution x and a minimal 2-norm
+ solution y, which is obtained using a generalized QR factorization
+ of the matrices (A, B) given by
+
+ A = Q*(R), B = Q*T*Z.
+ (0)
+
+ In particular, if matrix B is square nonsingular, then the problem
+ GLM is equivalent to the following weighted linear least squares
+ problem
+
+ minimize || inv(B)*(d-A*x) ||_2
+ x
+
+ where inv(B) denotes the inverse of B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. 0 <= M <= N.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= N-M.
+
+ A (input/output) REAL array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the upper triangular part of the array A contains
+ the M-by-M upper triangular matrix R.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)th subdiagonal
+ contain the N-by-P upper trapezoidal matrix T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D is the left hand side of the GLM equation.
+ On exit, D is destroyed.
+
+ X (output) REAL array, dimension (M)
+ Y (output) REAL array, dimension (P)
+ On exit, X and Y are the solutions of the GLM problem.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N+M+P).
+ For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ SGEQRF, SGERQF, SORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with A in the
+
+ generalized QR factorization of the pair (A, B) is
+ singular, so that rank(A) < M; the least squares
+ solution could not be computed.
+ = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal
+ factor T associated with B in the generalized QR
+ factorization of the pair (A, B) is singular, so that
+ rank( A B ) < N; the least squares solution could not
+ be computed.
+
+ ===================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param m
+ * @param p
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param d
+ * @param x
+ * @param y
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sggglm(int n, int m, int p, float[] a, int lda, float[] b, int ldb, float[] d, float[] x, float[] y, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGHRD reduces a pair of real matrices (A,B) to generalized upper
+ Hessenberg form using orthogonal transformations, where A is a
+ general matrix and B is upper triangular. The form of the
+ generalized eigenvalue problem is
+ A*x = lambda*B*x,
+ and B is typically made upper triangular by computing its QR
+ factorization and moving the orthogonal matrix Q to the left side
+ of the equation.
+
+ This subroutine simultaneously reduces A to a Hessenberg matrix H:
+ Q**T*A*Z = H
+ and transforms B to another upper triangular matrix T:
+ Q**T*B*Z = T
+ in order to reduce the problem to its standard form
+ H*y = lambda*T*y
+ where y = Z**T*x.
+
+ The orthogonal matrices Q and Z are determined as products of Givens
+
+ rotations. They may either be formed explicitly, or they may be
+ postmultiplied into input matrices Q1 and Z1, so that
+
+ Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+
+ Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+
+ If Q1 is the orthogonal matrix from the QR factorization of B in the
+
+ original equation A*x = lambda*B*x, then SGGHRD reduces the original
+
+ problem to generalized Hessenberg form.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'N': do not compute Q;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry,
+ and the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': do not compute Z;
+ = 'I': Z is initialized to the unit matrix, and the
+ orthogonal matrix Z is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry,
+ and the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of A which are to be
+ reduced. It is assumed that A is already upper triangular
+ in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+ normally set by a previous call to SGGBAL; otherwise they
+ should be set to 1 and N respectively.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ rest is set to zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the N-by-N upper triangular matrix B.
+ On exit, the upper triangular matrix T = Q**T B Z. The
+ elements below the diagonal are set to zero.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+ typically from the QR factorization of B.
+ On exit, if COMPQ='I', the orthogonal matrix Q, and if
+ COMPQ = 'V', the product Q1*Q.
+ Not referenced if COMPQ='N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+ On exit, if COMPZ='I', the orthogonal matrix Z, and if
+ COMPZ = 'V', the product Z1*Z.
+ Not referenced if COMPZ='N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z.
+ LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ This routine reduces A to Hessenberg and B to triangular form by
+ an unblocked reduction, as described in _Matrix_Computations_,
+ by Golub and Van Loan (Johns Hopkins Press.)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compq
+ * @param compz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param info
+ */
+ public abstract void sgghrd(String compq, String compz, int n, int ilo, int ihi, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGLSE solves the linear equality-constrained least squares (LSE)
+ problem:
+
+ minimize || c - A*x ||_2 subject to B*x = d
+
+ where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
+ M-vector, and d is a given P-vector. It is assumed that
+ P <= N <= M+P, and
+
+ rank(B) = P and rank( (A) ) = N.
+ ( (B) )
+
+ These conditions ensure that the LSE problem has a unique solution,
+ which is obtained using a generalized RQ factorization of the
+ matrices (B, A) given by
+
+ B = (0 R)*Q, A = Z*T*Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. 0 <= P <= N <= M+P.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(M,N)-by-N upper trapezoidal matrix T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the upper triangle of the subarray B(1:P,N-P+1:N)
+ contains the P-by-P upper triangular matrix R.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ C (input/output) REAL array, dimension (M)
+ On entry, C contains the right hand side vector for the
+ least squares part of the LSE problem.
+ On exit, the residual sum of squares for the solution
+ is given by the sum of squares of elements N-P+1 to M of
+ vector C.
+
+ D (input/output) REAL array, dimension (P)
+ On entry, D contains the right hand side vector for the
+ constrained equation.
+ On exit, D is destroyed.
+
+ X (output) REAL array, dimension (N)
+ On exit, X is the solution of the LSE problem.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M+N+P).
+ For optimum performance LWORK >= P+min(M,N)+max(M,N)*NB,
+ where NB is an upper bound for the optimal blocksizes for
+ SGEQRF, SGERQF, SORMQR and SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the upper triangular factor R associated with B in the
+
+ generalized RQ factorization of the pair (B, A) is
+ singular, so that rank(B) < P; the least squares
+ solution could not be computed.
+ = 2: the (N-P) by (N-P) part of the upper trapezoidal factor
+ T associated with A in the generalized RQ factorization
+ of the pair (B, A) is singular, so that
+ rank( (A) ) < N; the least squares solution could not
+ ( (B) )
+ be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param p
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param d
+ * @param x
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sgglse(int m, int n, int p, float[] a, int lda, float[] b, int ldb, float[] c, float[] d, float[] x, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGQRF computes a generalized QR factorization of an N-by-M matrix A
+
+ and an N-by-P matrix B:
+
+ A = Q*R, B = Q*T*Z,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
+ ( 0 ) N-M N M-N
+ M
+
+ where R11 is upper triangular, and
+
+ if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
+ P-N N ( T21 ) P
+ P
+
+ where T12 or T21 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GQR factorization
+
+ of A and B implicitly gives the QR factorization of inv(B)*A:
+
+ inv(B)*A = Z'*(inv(T)*R)
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows of the matrices A and B. N >= 0.
+
+ M (input) INTEGER
+ The number of columns of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of columns of the matrix B. P >= 0.
+
+ A (input/output) REAL array, dimension (LDA,M)
+ On entry, the N-by-M matrix A.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(N,M)-by-M upper trapezoidal matrix R (R is
+ upper triangular if N >= M); the elements below the diagonal,
+ with the array TAUA, represent the orthogonal matrix Q as a
+ product of min(N,M) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAUA (output) REAL array, dimension (min(N,M))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) REAL array, dimension (LDB,P)
+ On entry, the N-by-P matrix B.
+ On exit, if N <= P, the upper triangle of the subarray
+ B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
+ if N > P, the elements on and above the (N-P)-th subdiagonal
+
+ contain the N-by-P upper trapezoidal matrix T; the remaining
+
+ elements, with the array TAUB, represent the orthogonal
+ matrix Z as a product of elementary reflectors (see Further
+ Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ TAUB (output) REAL array, dimension (min(N,P))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the QR factorization
+ of an N-by-M matrix, NB2 is the optimal blocksize for the
+ RQ factorization of an N-by-P matrix, and NB3 is the optimal
+
+ blocksize for a call of SORMQR.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(n,m).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine SORGQR.
+ To use Q to update another matrix, use LAPACK subroutine SORMQR.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(n,p).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(p-k+i+1:p) = 0 and v(p-k+i) = 1; v(1:p-k+i-1) is stored on exit in
+
+ B(n-k+i,1:p-k+i-1), and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine SORGRQ.
+ To use Z to update another matrix, use LAPACK subroutine SORMRQ.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param m
+ * @param p
+ * @param a
+ * @param lda
+ * @param taua
+ * @param b
+ * @param ldb
+ * @param taub
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sggqrf(int n, int m, int p, float[] a, int lda, float[] taua, float[] b, int ldb, float[] taub, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGRQF computes a generalized RQ factorization of an M-by-N matrix A
+
+ and a P-by-N matrix B:
+
+ A = R*Q, B = Z*T*Q,
+
+ where Q is an N-by-N orthogonal matrix, Z is a P-by-P orthogonal
+ matrix, and R and T assume one of the forms:
+
+ if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
+ N-M M ( R21 ) N
+ N
+
+ where R12 or R21 is upper triangular, and
+
+ if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
+ ( 0 ) P-N P N-P
+ N
+
+ where T11 is upper triangular.
+
+ In particular, if B is square and nonsingular, the GRQ factorization
+
+ of A and B implicitly gives the RQ factorization of A*inv(B):
+
+ A*inv(B) = (R*inv(T))*Z'
+
+ where inv(B) denotes the inverse of the matrix B, and Z' denotes the
+
+ transpose of the matrix Z.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, if M <= N, the upper triangle of the subarray
+ A(1:M,N-M+1:N) contains the M-by-M upper triangular matrix R;
+ if M > N, the elements on and above the (M-N)-th subdiagonal
+
+ contain the M-by-N upper trapezoidal matrix R; the remaining
+
+ elements, with the array TAUA, represent the orthogonal
+ matrix Q as a product of elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAUA (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q (see Further Details).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, the elements on and above the diagonal of the array
+
+ contain the min(P,N)-by-N upper trapezoidal matrix T (T is
+ upper triangular if P >= N); the elements below the diagonal,
+ with the array TAUB, represent the orthogonal matrix Z as a
+ product of elementary reflectors (see Further Details).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TAUB (output) REAL array, dimension (min(P,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Z (see Further Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N,M,P).
+ For optimum performance LWORK >= max(N,M,P)*max(NB1,NB2,NB3),
+ where NB1 is the optimal blocksize for the RQ factorization
+ of an M-by-N matrix, NB2 is the optimal blocksize for the
+ QR factorization of a P-by-N matrix, and NB3 is the optimal
+ blocksize for a call of SORMRQ.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INF0= -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taua * v * v'
+
+ where taua is a real scalar, and v is a real vector with
+ v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+
+ A(m-k+i,1:n-k+i-1), and taua in TAUA(i).
+ To form Q explicitly, use LAPACK subroutine SORGRQ.
+ To use Q to update another matrix, use LAPACK subroutine SORMRQ.
+
+ The matrix Z is represented as a product of elementary reflectors
+
+ Z = H(1) H(2) . . . H(k), where k = min(p,n).
+
+ Each H(i) has the form
+
+ H(i) = I - taub * v * v'
+
+ where taub is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i),
+
+ and taub in TAUB(i).
+ To form Z explicitly, use LAPACK subroutine SORGQR.
+ To use Z to update another matrix, use LAPACK subroutine SORMQR.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param p
+ * @param n
+ * @param a
+ * @param lda
+ * @param taua
+ * @param b
+ * @param ldb
+ * @param taub
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sggrqf(int m, int p, int n, float[] a, int lda, float[] taua, float[] b, int ldb, float[] taub, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGSVD computes the generalized singular value decomposition (GSVD)
+ of an M-by-N real matrix A and P-by-N real matrix B:
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R )
+
+ where U, V and Q are orthogonal matrices, and Z' is the transpose
+ of Z. Let K+L = the effective numerical rank of the matrix (A',B')',
+ then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
+ D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
+ following structures, respectively:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 )
+ L ( 0 0 R22 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The routine computes C, S, R, and optionally the orthogonal
+ transformation matrices U, V and Q.
+
+ In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
+ A and B implicitly gives the SVD of A*inv(B):
+ A*inv(B) = U*(D1*inv(D2))*V'.
+ If ( A',B')' has orthonormal columns, then the GSVD of A and B is
+ also equal to the CS decomposition of A and B. Furthermore, the GSVD
+
+ can be used to derive the solution of the eigenvalue problem:
+ A'*A x = lambda* B'*B x.
+ In some literature, the GSVD of A and B is presented in the form
+ U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 )
+ where U and V are orthogonal and X is nonsingular, D1 and D2 are
+ ``diagonal''. The former GSVD form can be converted to the latter
+ form by taking the nonsingular matrix X as
+
+ X = Q*( I 0 )
+ ( 0 inv(R) ).
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in the Purpose section.
+ K + L = effective numerical rank of (A',B')'.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular matrix R, or part of R.
+ See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix R if M-K-L < 0.
+ See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ ALPHA (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = C,
+ BETA(K+1:K+L) = S,
+ or if M-K-L < 0,
+ ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
+ BETA(K+1:M) =S, BETA(M+1:K+L) =1
+ and
+ ALPHA(K+L+1:N) = 0
+ BETA(K+L+1:N) = 0
+
+ U (output) REAL array, dimension (LDU,M)
+ If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) REAL array, dimension (LDV,P)
+ If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) REAL array,
+ dimension (max(3*N,M,P)+N)
+
+ IWORK (workspace/output) INTEGER array, dimension (N)
+ On exit, IWORK stores the sorting information. More
+ precisely, the following loop will sort ALPHA
+ for I = K+1, min(M,K+L)
+ swap ALPHA(I) and ALPHA(IWORK(I))
+ endfor
+ such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, the Jacobi-type procedure failed to
+ converge. For further details, see subroutine STGSJA.
+
+
+ Internal Parameters
+ ===================
+
+ TOLA REAL
+ TOLB REAL
+ TOLA and TOLB are the thresholds to determine the effective
+ rank of (A',B')'. Generally, they are set to
+ TOLA = MAX(M,N)*norm(A)*MACHEPS,
+ TOLB = MAX(P,N)*norm(B)*MACHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ Further Details
+ ===============
+
+ 2-96 Based on modifications by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param jobu
+ * @param jobv
+ * @param jobq
+ * @param m
+ * @param n
+ * @param p
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param v
+ * @param ldv
+ * @param q
+ * @param ldq
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sggsvd(String jobu, String jobv, String jobq, int m, int n, int p, intW k, intW l, float[] a, int lda, float[] b, int ldb, float[] alpha, float[] beta, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGGSVP computes orthogonal matrices U, V and Q such that
+
+ N-K-L K L
+ U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ V'*B*Q = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
+ numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the
+ transpose of Z.
+
+ This decomposition is the preprocessing step for computing the
+ Generalized Singular Value Decomposition (GSVD), see subroutine
+ SGGSVD.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': Orthogonal matrix U is computed;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': Orthogonal matrix V is computed;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Orthogonal matrix Q is computed;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A contains the triangular (or trapezoidal) matrix
+ described in the Purpose section.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, B contains the triangular matrix described in
+ the Purpose section.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) REAL
+ TOLB (input) REAL
+ TOLA and TOLB are the thresholds to determine the effective
+ numerical rank of matrix B and a subblock of A. Generally,
+ they are set to
+ TOLA = MAX(M,N)*norm(A)*MACHEPS,
+ TOLB = MAX(P,N)*norm(B)*MACHEPS.
+ The size of TOLA and TOLB may affect the size of backward
+ errors of the decomposition.
+
+ K (output) INTEGER
+ L (output) INTEGER
+ On exit, K and L specify the dimension of the subblocks
+ described in Purpose.
+ K + L = effective numerical rank of (A',B')'.
+
+ U (output) REAL array, dimension (LDU,M)
+ If JOBU = 'U', U contains the orthogonal matrix U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (output) REAL array, dimension (LDV,M)
+ If JOBV = 'V', V contains the orthogonal matrix V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ If JOBQ = 'Q', Q contains the orthogonal matrix Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ TAU (workspace) REAL array, dimension (N)
+
+ WORK (workspace) REAL array, dimension (max(3*N,M,P))
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+
+ Further Details
+ ===============
+
+ The subroutine uses LAPACK subroutine SGEQPF for the QR factorization
+ with column pivoting to detect the effective numerical rank of the
+ a matrix. It may be replaced by a better rank determination strategy.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobu
+ * @param jobv
+ * @param jobq
+ * @param m
+ * @param p
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param tola
+ * @param tolb
+ * @param k
+ * @param l
+ * @param u
+ * @param ldu
+ * @param v
+ * @param ldv
+ * @param q
+ * @param ldq
+ * @param iwork
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sggsvp(String jobu, String jobv, String jobq, int m, int p, int n, float[] a, int lda, float[] b, int ldb, float tola, float tolb, intW k, intW l, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, int[] iwork, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTCON estimates the reciprocal of the condition number of a real
+ tridiagonal matrix A using the LU factorization as computed by
+ SGTTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by SGTTRF.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ ANORM (input) REAL
+ If NORM = '1' or 'O', the 1-norm of the original matrix A.
+ If NORM = 'I', the infinity-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgtcon(String norm, int n, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is tridiagonal, and provides
+ error bounds and backward error estimates for the solution.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A as computed by SGTTRF.
+
+ DF (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DUF (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first superdiagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second superdiagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SGTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param dlf
+ * @param df
+ * @param duf
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgtrfs(String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] dlf, float[] df, float[] duf, float[] du2, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTSV solves the equation
+
+ A*X = B,
+
+ where A is an n by n tridiagonal matrix, by Gaussian elimination with
+ partial pivoting.
+
+ Note that the equation A'*X = B may be solved by interchanging the
+
+ order of the arguments DU and DL.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input/output) REAL array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-2) elements of the
+ second super-diagonal of the upper triangular matrix U from
+ the LU factorization of A, in DL(1), ..., DL(n-2).
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of U.
+
+ DU (input/output) REAL array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N by NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero, and the solution
+ has not been computed. The factorization has not been
+ completed unless i = N.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sgtsv(int n, int nrhs, float[] dl, float[] d, float[] du, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTSVX uses the LU factorization to compute the solution to a real
+ system of linear equations A * X = B or A**T * X = B,
+ where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
+
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
+ as A = L * U, where L is a product of permutation and unit lower
+ bidiagonal matrices and U is upper triangular with nonzeros in
+ only the main diagonal and first two superdiagonals.
+
+ 2. If some U(i,i)=0, so that U is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
+ form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
+ will not be modified.
+ = 'N': The matrix will be copied to DLF, DF, and DUF
+ and factored.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of A.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) superdiagonal elements of A.
+
+ DLF (input or output) REAL array, dimension (N-1)
+ If FACT = 'F', then DLF is an input argument and on entry
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A as computed by SGTTRF.
+
+ If FACT = 'N', then DLF is an output argument and on exit
+ contains the (n-1) multipliers that define the matrix L from
+
+ the LU factorization of A.
+
+ DF (input or output) REAL array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the upper triangular
+ matrix U from the LU factorization of A.
+
+ DUF (input or output) REAL array, dimension (N-1)
+ If FACT = 'F', then DUF is an input argument and on entry
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ If FACT = 'N', then DUF is an output argument and on exit
+ contains the (n-1) elements of the first superdiagonal of U.
+
+
+ DU2 (input or output) REAL array, dimension (N-2)
+ If FACT = 'F', then DU2 is an input argument and on entry
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ If FACT = 'N', then DU2 is an output argument and on exit
+ contains the (n-2) elements of the second superdiagonal of
+ U.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains the pivot indices from the LU factorization of A as
+
+ computed by SGTTRF.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains the pivot indices from the LU factorization of A;
+ row i of the matrix was interchanged with row IPIV(i).
+ IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
+ a row interchange was not required.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: U(i,i) is exactly zero. The factorization
+ has not been completed unless i = N, but the
+ factor U is exactly singular, so the solution
+ and error bounds could not be computed.
+ RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param dlf
+ * @param df
+ * @param duf
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sgtsvx(String fact, String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] dlf, float[] df, float[] duf, float[] du2, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTTRF computes an LU factorization of a real tridiagonal matrix A
+ using elimination with partial pivoting and row interchanges.
+
+ The factorization has the form
+ A = L * U
+ where L is a product of permutation and unit lower bidiagonal
+ matrices and U is upper triangular with nonzeros in only the main
+ diagonal and first two superdiagonals.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ DL (input/output) REAL array, dimension (N-1)
+ On entry, DL must contain the (n-1) sub-diagonal elements of
+
+ A.
+
+ On exit, DL is overwritten by the (n-1) multipliers that
+ define the matrix L from the LU factorization of A.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D must contain the diagonal elements of A.
+
+ On exit, D is overwritten by the n diagonal elements of the
+ upper triangular matrix U from the LU factorization of A.
+
+ DU (input/output) REAL array, dimension (N-1)
+ On entry, DU must contain the (n-1) super-diagonal elements
+ of A.
+
+ On exit, DU is overwritten by the (n-1) elements of the first
+ super-diagonal of U.
+
+ DU2 (output) REAL array, dimension (N-2)
+ On exit, DU2 is overwritten by the (n-2) elements of the
+ second super-diagonal of U.
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param info
+ */
+ public abstract void sgttrf(int n, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTTRS solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by SGTTRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations.
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sgttrs(String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SGTTS2 solves one of the systems of equations
+ A*X = B or A'*X = B,
+ with a tridiagonal matrix A using the LU factorization computed
+ by SGTTRF.
+
+ Arguments
+ =========
+
+ ITRANS (input) INTEGER
+ Specifies the form of the system of equations.
+ = 0: A * X = B (No transpose)
+ = 1: A'* X = B (Transpose)
+ = 2: A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) multipliers that define the matrix L from the
+ LU factorization of A.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the upper triangular matrix U from
+ the LU factorization of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) elements of the first super-diagonal of U.
+
+ DU2 (input) REAL array, dimension (N-2)
+ The (n-2) elements of the second super-diagonal of U.
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices; for 1 <= i <= n, row i of the matrix was
+ interchanged with row IPIV(i). IPIV(i) will always be either
+ i or i+1; IPIV(i) = i indicates a row interchange was not
+ required.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the matrix of right hand side vectors B.
+ On exit, B is overwritten by the solution vectors X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param itrans
+ * @param n
+ * @param nrhs
+ * @param dl
+ * @param d
+ * @param du
+ * @param du2
+ * @param ipiv
+ * @param b
+ * @param ldb
+ */
+ public abstract void sgtts2(int itrans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+ where H is an upper Hessenberg matrix and T is upper triangular,
+ using the double-shift QZ method.
+ Matrix pairs of this type are produced by the reduction to
+ generalized upper Hessenberg form of a real matrix pair (A,B):
+
+ A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+
+ as computed by SGGHRD.
+
+ If JOB='S', then the Hessenberg-triangular pair (H,T) is
+ also reduced to generalized Schur form,
+
+ H = Q*S*Z**T, T = Q*P*Z**T,
+
+ where Q and Z are orthogonal matrices, P is an upper triangular
+ matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+ diagonal blocks.
+
+ The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+ (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+
+ eigenvalues.
+
+ Additionally, the 2-by-2 upper triangular diagonal blocks of P
+ corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+
+ form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+ P(j,j) > 0, and P(j+1,j+1) > 0.
+
+ Optionally, the orthogonal matrix Q from the generalized Schur
+ factorization may be postmultiplied into an input matrix Q1, and the
+
+ orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+ If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced
+ the matrix pair (A,B) to generalized upper Hessenberg form, then the
+
+ output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+ generalized Schur factorization of (A,B):
+
+ A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+
+ To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently
+ of (A,B)) are computed as a pair of values (alpha,beta), where alpha
+ complex and beta real.
+ If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+ generalized nonsymmetric eigenvalue problem (GNEP)
+ A*x = lambda*B*x
+ and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+ alternate form of the GNEP
+ mu*A*y = B*y.
+ Real eigenvalues can be read directly from the generalized Schur
+ form:
+ alpha = S(i,i), beta = P(i,i).
+
+ Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
+
+ Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
+ pp. 241--256.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': Compute eigenvalues only;
+ = 'S': Compute eigenvalues and the Schur form.
+
+ COMPQ (input) CHARACTER*1
+ = 'N': Left Schur vectors (Q) are not computed;
+ = 'I': Q is initialized to the unit matrix and the matrix Q
+ of left Schur vectors of (H,T) is returned;
+ = 'V': Q must contain an orthogonal matrix Q1 on entry and
+ the product Q1*Q is returned.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Right Schur vectors (Z) are not computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of right Schur vectors of (H,T) is returned;
+ = 'V': Z must contain an orthogonal matrix Z1 on entry and
+ the product Z1*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrices H, T, Q, and Z. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI mark the rows and columns of H which are in
+ Hessenberg form. It is assumed that A is already upper
+ triangular in rows and columns 1:ILO-1 and IHI+1:N.
+ If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+
+ H (input/output) REAL array, dimension (LDH, N)
+ On entry, the N-by-N upper Hessenberg matrix H.
+ On exit, if JOB = 'S', H contains the upper quasi-triangular
+
+ matrix S from the generalized Schur factorization;
+ 2-by-2 diagonal blocks (corresponding to complex conjugate
+ pairs of eigenvalues) are returned in standard form, with
+ H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+ If JOB = 'E', the diagonal blocks of H match those of S, but
+
+ the rest of H is unspecified.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max( 1, N ).
+
+ T (input/output) REAL array, dimension (LDT, N)
+ On entry, the N-by-N upper triangular matrix T.
+ On exit, if JOB = 'S', T contains the upper triangular
+ matrix P from the generalized Schur factorization;
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of
+ are reduced to positive diagonal form, i.e., if H(j+1,j) is
+ non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+ T(j+1,j+1) > 0.
+ If JOB = 'E', the diagonal blocks of T match those of P, but
+
+ the rest of T is unspecified.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max( 1, N ).
+
+ ALPHAR (output) REAL array, dimension (N)
+ The real parts of each scalar alpha defining an eigenvalue
+ of GNEP.
+
+ ALPHAI (output) REAL array, dimension (N)
+ The imaginary parts of each scalar alpha defining an
+ eigenvalue of GNEP.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
+
+ BETA (output) REAL array, dimension (N)
+ The scalars beta that define the eigenvalues of GNEP.
+ Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+ beta = BETA(j) represent the j-th eigenvalue of the matrix
+ pair (A,B), in one of the forms lambda = alpha/beta or
+ mu = beta/alpha. Since either lambda or mu may overflow,
+ they should not, in general, be computed.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+
+ vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+ of left Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If COMPQ='V' or 'I', then LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+ the reduction of (A,B) to generalized Hessenberg form.
+ On exit, if COMPZ = 'I', the orthogonal matrix of
+ right Schur vectors of (H,T), and if COMPZ = 'V', the
+ orthogonal matrix of right Schur vectors of (A,B).
+ Not referenced if COMPZ = 'N'.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If COMPZ='V' or 'I', then LDZ >= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1,...,N: the QZ iteration did not converge. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO+1,...,N should be correct.
+ = N+1,...,2*N: the shift calculation failed. (H,T) is not
+ in Schur form, but ALPHAR(i), ALPHAI(i), and
+ BETA(i), i=INFO-N+1,...,N should be correct.
+
+ Further Details
+ ===============
+
+ Iteration counters:
+
+ JITER -- counts iterations.
+ IITER -- counts iterations run since ILAST was last
+ changed. This is therefore reset only when a 1-by-1 or
+ 2-by-2 block deflates off the bottom.
+
+ =====================================================================
+
+ .. Parameters ..
+ $ SAFETY = 1.0E+0 )
+</pre>
+ * @param job
+ * @param compq
+ * @param compz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param t
+ * @param ldt
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void shgeqz(String job, String compq, String compz, int n, int ilo, int ihi, float[] h, int ldh, float[] t, int ldt, float[] alphar, float[] alphai, float[] beta, float[] q, int ldq, float[] z, int ldz, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SHSEIN uses inverse iteration to find specified right and/or left
+ eigenvectors of a real upper Hessenberg matrix H.
+
+ The right eigenvector x and the left eigenvector y of the matrix H
+ corresponding to an eigenvalue w are defined by:
+
+ H * x = w * x, y**h * H = w * y**h
+
+ where y**h denotes the conjugate transpose of the vector y.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ EIGSRC (input) CHARACTER*1
+ Specifies the source of eigenvalues supplied in (WR,WI):
+ = 'Q': the eigenvalues were found using SHSEQR; thus, if
+ H has zero subdiagonal elements, and so is
+ block-triangular, then the j-th eigenvalue can be
+ assumed to be an eigenvalue of the block containing
+ the j-th row/column. This property allows SHSEIN to
+ perform inverse iteration on just one diagonal block.
+
+ = 'N': no assumptions are made on the correspondence
+ between eigenvalues and diagonal blocks. In this
+ case, SHSEIN must always perform inverse iteration
+ using the whole matrix H.
+
+ INITV (input) CHARACTER*1
+ = 'N': no initial vectors are supplied;
+ = 'U': user-supplied initial vectors are stored in the arrays
+ VL and/or VR.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ Specifies the eigenvectors to be computed. To select the
+ real eigenvector corresponding to a real eigenvalue WR(j),
+ SELECT(j) must be set to .TRUE.. To select the complex
+ eigenvector corresponding to a complex eigenvalue
+ (WR(j),WI(j)), with complex conjugate (WR(j+1),WI(j+1)),
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; then on exit SELECT(j) is .TRUE. and SELECT(j+1) is
+ .FALSE..
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) REAL array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input/output) REAL array, dimension (N)
+ WI (input) REAL array, dimension (N)
+ On entry, the real and imaginary parts of the eigenvalues of
+
+ H; a complex conjugate pair of eigenvalues must be stored in
+
+ consecutive elements of WR and WI.
+ On exit, WR may have been altered since close eigenvalues
+ are perturbed slightly in searching for independent
+ eigenvectors.
+
+ VL (input/output) REAL array, dimension (LDVL,MM)
+ On entry, if INITV = 'U' and SIDE = 'L' or 'B', VL must
+ contain starting vectors for the inverse iteration for the
+ left eigenvectors; the starting vector for each eigenvector
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'L' or 'B', the left eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VL, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'R', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+
+ VR (input/output) REAL array, dimension (LDVR,MM)
+ On entry, if INITV = 'U' and SIDE = 'R' or 'B', VR must
+ contain starting vectors for the inverse iteration for the
+ right eigenvectors; the starting vector for each eigenvector
+
+ must be in the same column(s) in which the eigenvector will
+ be stored.
+ On exit, if SIDE = 'R' or 'B', the right eigenvectors
+ specified by SELECT will be stored consecutively in the
+ columns of VR, in the same order as their eigenvalues. A
+ complex eigenvector corresponding to a complex eigenvalue is
+
+ stored in two consecutive columns, the first holding the real
+ part and the second the imaginary part.
+ If SIDE = 'L', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR required to
+
+ store the eigenvectors; each selected real eigenvector
+ occupies one column and each selected complex eigenvector
+ occupies two columns.
+
+ WORK (workspace) REAL array, dimension ((N+2)*N)
+
+ IFAILL (output) INTEGER array, dimension (MM)
+ If SIDE = 'L' or 'B', IFAILL(i) = j > 0 if the left
+ eigenvector in the i-th column of VL (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILL(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VL hold a complex eigenvector, then IFAILL(i) and
+
+ IFAILL(i+1) are set to the same value.
+ If SIDE = 'R', IFAILL is not referenced.
+
+ IFAILR (output) INTEGER array, dimension (MM)
+ If SIDE = 'R' or 'B', IFAILR(i) = j > 0 if the right
+ eigenvector in the i-th column of VR (corresponding to the
+ eigenvalue w(j)) failed to converge; IFAILR(i) = 0 if the
+ eigenvector converged satisfactorily. If the i-th and (i+1)th
+ columns of VR hold a complex eigenvector, then IFAILR(i) and
+
+ IFAILR(i+1) are set to the same value.
+ If SIDE = 'L', IFAILR is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, i is the number of eigenvectors which
+ failed to converge; see IFAILL and IFAILR for further
+ details.
+
+ Further Details
+ ===============
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x|+|y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param eigsrc
+ * @param initv
+ * @param select
+ * @param n
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param mm
+ * @param m
+ * @param work
+ * @param ifaill
+ * @param ifailr
+ * @param info
+ */
+ public abstract void shsein(String side, String eigsrc, String initv, boolean[] select, int n, float[] h, int ldh, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, int[] ifaill, int[] ifailr, intW info);
+
+ /**
+<pre>
+
+ ..
+ Purpose
+ =======
+
+ SHSEQR computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': compute eigenvalues only;
+ = 'S': compute eigenvalues and the Schur form T.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': no Schur vectors are computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of Schur vectors of H is returned;
+ = 'V': Z must contain an orthogonal matrix Q on entry, and
+
+ the product Q*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to SGEBAL, and then passed to SGEHRD
+
+ when the matrix output by SGEBAL is reduced to Hessenberg
+ form. Otherwise ILO and IHI should be set to 1 and N
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and JOB = 'S', then H contains the
+ upper quasi-triangular matrix T from the Schur decomposition
+ (the Schur form); 2-by-2 diagonal blocks (corresponding to
+ complex conjugate pairs of eigenvalues) are returned in
+ standard form, with H(i,i) = H(i+1,i+1) and
+ H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
+ contents of H are unspecified on exit. (The output value of
+ H when INFO.GT.0 is given under the description of INFO
+ below.)
+
+ Unlike earlier versions of SHSEQR, this subroutine may
+ explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
+ or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues. If two eigenvalues are computed as a complex
+ conjugate pair, they are stored in consecutive elements of
+ WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
+ WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
+
+ the same order as on the diagonal of the Schur form returned
+ in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
+ diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ If COMPZ = 'N', Z is not referenced.
+ If COMPZ = 'I', on entry Z need not be set and on exit,
+ if INFO = 0, Z contains the orthogonal matrix Z of the Schur
+ vectors of H. If COMPZ = 'V', on entry Z must contain an
+ N-by-N matrix Q, which is assumed to be equal to the unit
+ matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
+ if INFO = 0, Z contains Q*Z.
+ Normally Q is the orthogonal matrix generated by SORGHR
+ after the call to SGEHRD which formed the Hessenberg matrix
+
+ H. (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if COMPZ = 'I' or
+ COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then SHSEQR does a workspace query.
+ In this case, SHSEQR checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .LT. 0: if INFO = -i, the i-th argument had an illegal
+ value
+ .GT. 0: if INFO = i, SHSEQR failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and JOB = 'E', then on exit, the
+ remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and JOB = 'S', then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and COMPZ = 'V', then on exit
+
+ (final value of Z) = (initial value of Z)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'I', then on exit
+ (final value of Z) = U
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of JOB.)
+
+ If INFO .GT. 0 and COMPZ = 'N', then Z is not
+ accessed.
+
+ ================================================================
+ Default values supplied by
+ ILAENV(ISPEC,'SHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
+ It is suggested that these defaults be adjusted in order
+ to attain best performance in each particular
+ computational environment.
+
+ ISPEC=1: The SLAHQR vs SLAQR0 crossover point.
+ Default: 75. (Must be at least 11.)
+
+ ISPEC=2: Recommended deflation window size.
+ This depends on ILO, IHI and NS. NS is the
+ number of simultaneous shifts returned
+ by ILAENV(ISPEC=4). (See ISPEC=4 below.)
+ The default for (IHI-ILO+1).LE.500 is NS.
+ The default for (IHI-ILO+1).GT.500 is 3*NS/2.
+
+ ISPEC=3: Nibble crossover point. (See ILAENV for
+ details.) Default: 14% of deflation window
+ size.
+
+ ISPEC=4: Number of simultaneous shifts, NS, in
+ a multi-shift QR iteration.
+
+ If IHI-ILO+1 is ...
+
+ greater than ...but less ... the
+ or equal to ... than default is
+
+ 1 30 NS - 2(+)
+ 30 60 NS - 4(+)
+ 60 150 NS = 10(+)
+ 150 590 NS = **
+ 590 3000 NS = 64
+ 3000 6000 NS = 128
+ 6000 infinity NS = 256
+
+ (+) By default some or all matrices of this order
+ are passed to the implicit double shift routine
+
+ SLAHQR and NS is ignored. See ISPEC=1 above
+ and comments in IPARM for details.
+
+ The asterisks (**) indicate an ad-hoc
+ function of N increasing from 10 to 64.
+
+ ISPEC=5: Select structured matrix multiply.
+ (See ILAENV for details.) Default: 3.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . SLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== NL allocates some local workspace to help small matrices
+ . through a rare SLAHQR failure. NL .GT. NTINY = 11 is
+ . required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
+ . mended. (The default value of NMIN is 75.) Using NL = 49
+ . allows up to six simultaneous shifts and a 16-by-16
+ . deflation window. ====
+
+</pre>
+ * @param job
+ * @param compz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void shseqr(String job, String compz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, float[] z, int ldz, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SISNAN returns .TRUE. if its argument is NaN, and .FALSE.
+ otherwise. To be replaced by the Fortran 2003 intrinsic in the
+ future.
+
+ Arguments
+ =========
+
+ SIN (input) REAL
+ Input to test for NaN.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param sin
+ */
+ public boolean sisnan(float sin) {
+ return org.netlib.lapack.Sisnan.sisnan(sin);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLABAD takes as input the values computed by SLAMCH for underflow and
+ overflow, and returns the square root of each of these values if the
+
+ log of LARGE is sufficiently large. This subroutine is intended to
+ identify machines with a large exponent range, such as the Crays, and
+ redefine the underflow and overflow limits to be the square roots of
+
+ the values computed by SLAMCH. This subroutine is needed because
+ SLAMCH does not compensate for poor arithmetic in the upper half of
+ the exponent range, as is found on a Cray.
+
+ Arguments
+ =========
+
+ SMALL (input/output) REAL
+ On entry, the underflow threshold as computed by SLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of SMALL, otherwise unchanged.
+
+ LARGE (input/output) REAL
+ On entry, the overflow threshold as computed by SLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of LARGE, otherwise unchanged.
+
+ =====================================================================
+
+ .. Intrinsic Functions ..
+</pre>
+ * @param small
+ * @param large
+ */
+ public abstract void slabad(floatW small, floatW large);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLABRD reduces the first NB rows and columns of a real general
+ m by n matrix A to upper or lower bidiagonal form by an orthogonal
+ transformation Q' * A * P, and returns the matrices X and Y which
+ are needed to apply the transformation to the unreduced part of A.
+
+ If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
+
+ bidiagonal form.
+
+ This is an auxiliary routine called by SGEBRD
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A.
+
+ N (input) INTEGER
+ The number of columns in the matrix A.
+
+ NB (input) INTEGER
+ The number of leading rows and columns of A to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit, the first NB rows and columns of the matrix are
+ overwritten; the rest of the array is unchanged.
+ If m >= n, elements on and below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors; and
+ elements above the diagonal in the first NB rows, with the
+
+ array TAUP, represent the orthogonal matrix P as a product
+
+ of elementary reflectors.
+ If m < n, elements below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors, and
+ elements on and above the diagonal in the first NB rows,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) REAL array, dimension (NB)
+ The diagonal elements of the first NB rows and columns of
+ the reduced matrix. D(i) = A(i,i).
+
+ E (output) REAL array, dimension (NB)
+ The off-diagonal elements of the first NB rows and columns of
+ the reduced matrix.
+
+ TAUQ (output) REAL array dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) REAL array, dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ X (output) REAL array, dimension (LDX,NB)
+ The m-by-nb matrix X required to update the unreduced part
+ of A.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= M.
+
+ Y (output) REAL array, dimension (LDY,NB)
+ The n-by-nb matrix Y required to update the unreduced part
+ of A.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors.
+
+ If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
+ A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The elements of the vectors v and u together form the m-by-nb matrix
+
+ V and the nb-by-n matrix U' which are needed, with X and Y, to apply
+
+ the transformation to the unreduced part of the matrix, using a block
+ update of the form: A := A - V*Y' - X*U'.
+
+ The contents of A on exit are illustrated by the following examples
+ with nb = 2:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
+ ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
+ ( v1 v2 a a a ) ( v1 1 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix which is unchanged,
+ vi denotes an element of the vector defining H(i), and ui an element
+
+ of the vector defining G(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param nb
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tauq
+ * @param taup
+ * @param x
+ * @param ldx
+ * @param y
+ * @param ldy
+ */
+ public abstract void slabrd(int m, int n, int nb, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] x, int ldx, float[] y, int ldy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLACN2 estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) REAL array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) REAL array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and SLACN2 must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) REAL
+ On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
+ unchanged from the previous call to SLACN2.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to SLACN2, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from SLACN2, KASE will again be 0.
+
+ ISAVE (input/output) INTEGER array, dimension (3)
+ ISAVE is used to save variables between calls to SLACN2
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ This is a thread safe version of SLACON, which uses the array ISAVE
+ in place of a SAVE statement, as follows:
+
+ SLACON SLACN2
+ JUMP ISAVE(1)
+ J ISAVE(2)
+ ITER ISAVE(3)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param v
+ * @param x
+ * @param isgn
+ * @param est
+ * @param kase
+ * @param isave
+ */
+ public void slacn2(int n, float[] v, float[] x, int[] isgn, floatW est, intW kase, int[] isave) {
+ org.netlib.lapack.Slacn2.slacn2(n, v, 0, x, 0, isgn, 0, est, kase, isave, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLACON estimates the 1-norm of a square, real matrix A.
+ Reverse communication is used for evaluating matrix-vector products.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 1.
+
+ V (workspace) REAL array, dimension (N)
+ On the final return, V = A*W, where EST = norm(V)/norm(W)
+ (W is not returned).
+
+ X (input/output) REAL array, dimension (N)
+ On an intermediate return, X should be overwritten by
+ A * X, if KASE=1,
+ A' * X, if KASE=2,
+ and SLACON must be re-called with all the other parameters
+ unchanged.
+
+ ISGN (workspace) INTEGER array, dimension (N)
+
+ EST (input/output) REAL
+ On entry with KASE = 1 or 2 and JUMP = 3, EST should be
+ unchanged from the previous call to SLACON.
+ On exit, EST is an estimate (a lower bound) for norm(A).
+
+ KASE (input/output) INTEGER
+ On the initial call to SLACON, KASE should be 0.
+ On an intermediate return, KASE will be 1 or 2, indicating
+ whether X should be overwritten by A * X or A' * X.
+ On the final return from SLACON, KASE will again be 0.
+
+ Further Details
+ ======= =======
+
+ Contributed by Nick Higham, University of Manchester.
+ Originally named SONEST, dated March 16, 1988.
+
+ Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+ a real or complex matrix, with applications to condition estimation",
+ ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param v
+ * @param x
+ * @param isgn
+ * @param est
+ * @param kase
+ */
+ public abstract void slacon(int n, float[] v, float[] x, int[] isgn, floatW est, intW kase);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLACPY copies all or part of a two-dimensional matrix A to another
+ matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper triangle
+
+ or trapezoid is accessed; if UPLO = 'L', only the lower
+ triangle or trapezoid is accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) REAL array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ */
+ public abstract void slacpy(String uplo, int m, int n, float[] a, int lda, float[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLADIV performs complex division in real arithmetic
+
+ a + i*b
+ p + i*q = ---------
+ c + i*d
+
+ The algorithm is due to Robert L. Smith and can be found
+ in D. Knuth, The art of Computer Programming, Vol.2, p.195
+
+ Arguments
+ =========
+
+ A (input) REAL
+ B (input) REAL
+ C (input) REAL
+ D (input) REAL
+ The scalars a, b, c, and d in the above expression.
+
+ P (output) REAL
+ Q (output) REAL
+ The scalars p and q in the above expression.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param d
+ * @param p
+ * @param q
+ */
+ public abstract void sladiv(float a, float b, float c, float d, floatW p, floatW q);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, and RT2
+ is the eigenvalue of smaller absolute value.
+
+ Arguments
+ =========
+
+ A (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) REAL
+ The (1,2) and (2,1) elements of the 2-by-2 matrix.
+
+ C (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) REAL
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) REAL
+ The eigenvalue of smaller absolute value.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param rt1
+ * @param rt2
+ */
+ public abstract void slae2(float a, float b, float c, floatW rt1, floatW rt2);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEBZ contains the iteration loops which compute and use the
+ function N(w), which is the count of eigenvalues of a symmetric
+ tridiagonal matrix T less than or equal to its argument w. It
+ performs a choice of two types of loops:
+
+ IJOB=1, followed by
+ IJOB=2: It takes as input a list of intervals and returns a list of
+ sufficiently small intervals whose union contains the same
+ eigenvalues as the union of the original intervals.
+ The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
+ The output interval (AB(j,1),AB(j,2)] will contain
+ eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
+
+ IJOB=3: It performs a binary search in each input interval
+ (AB(j,1),AB(j,2)] for a point w(j) such that
+ N(w(j))=NVAL(j), and uses C(j) as the starting point of
+ the search. If such a w(j) is found, then on output
+ AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
+
+ (AB(j,1),AB(j,2)] will be a small interval containing the
+ point where N(w) jumps through NVAL(j), unless that point
+ lies outside the initial interval.
+
+ Note that the intervals are in all cases half-open intervals,
+ i.e., of the form (a,b] , which includes b but not a .
+
+ To avoid underflow, the matrix should be scaled so that its largest
+ element is no greater than overflow**(1/2) * underflow**(1/4)
+ in absolute value. To assure the most accurate computation
+ of small eigenvalues, the matrix should be scaled to be
+ not much smaller than that, either.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966
+
+ Note: the arguments are, in general, *not* checked for unreasonable
+ values.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies what is to be done:
+ = 1: Compute NAB for the initial intervals.
+ = 2: Perform bisection iteration to find eigenvalues of T.
+ = 3: Perform bisection iteration to invert N(w), i.e.,
+ to find a point which has a specified number of
+ eigenvalues of T to its left.
+ Other values will cause SLAEBZ to return with INFO=-1.
+
+ NITMAX (input) INTEGER
+ The maximum number of "levels" of bisection to be
+ performed, i.e., an interval of width W will not be made
+ smaller than 2^(-NITMAX) * W. If not all intervals
+ have converged after NITMAX iterations, then INFO is set
+ to the number of non-converged intervals.
+
+ N (input) INTEGER
+ The dimension n of the tridiagonal matrix T. It must be at
+ least 1.
+
+ MMAX (input) INTEGER
+ The maximum number of intervals. If more than MMAX intervals
+ are generated, then SLAEBZ will quit with INFO=MMAX+1.
+
+ MINP (input) INTEGER
+ The initial number of intervals. It may not be greater than
+
+ MMAX.
+
+ NBMIN (input) INTEGER
+ The smallest number of intervals that should be processed
+ using a vector loop. If zero, then only the scalar loop
+ will be used.
+
+ ABSTOL (input) REAL
+ The minimum (absolute) width of an interval. When an
+ interval is narrower than ABSTOL, or than RELTOL times the
+ larger (in magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. This must be at least
+ zero.
+
+ RELTOL (input) REAL
+ The minimum relative width of an interval. When an interval
+
+ is narrower than ABSTOL, or than RELTOL times the larger (in
+
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ PIVMIN (input) REAL
+ The minimum absolute value of a "pivot" in the Sturm
+ sequence loop. This *must* be at least max |e(j)**2| *
+ safe_min and at least safe_min, where safe_min is at least
+ the smallest number that can divide one without overflow.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N)
+ The offdiagonal elements of the tridiagonal matrix T in
+ positions 1 through N-1. E(N) is arbitrary.
+
+ E2 (input) REAL array, dimension (N)
+ The squares of the offdiagonal elements of the tridiagonal
+ matrix T. E2(N) is ignored.
+
+ NVAL (input/output) INTEGER array, dimension (MINP)
+ If IJOB=1 or 2, not referenced.
+ If IJOB=3, the desired values of N(w). The elements of NVAL
+
+ will be reordered to correspond with the intervals in AB.
+ Thus, NVAL(j) on output will not, in general be the same as
+ NVAL(j) on input, but it will correspond with the interval
+ (AB(j,1),AB(j,2)] on output.
+
+ AB (input/output) REAL array, dimension (MMAX,2)
+ The endpoints of the intervals. AB(j,1) is a(j), the left
+ endpoint of the j-th interval, and AB(j,2) is b(j), the
+ right endpoint of the j-th interval. The input intervals
+ will, in general, be modified, split, and reordered by the
+ calculation.
+
+ C (input/output) REAL array, dimension (MMAX)
+ If IJOB=1, ignored.
+ If IJOB=2, workspace.
+ If IJOB=3, then on input C(j) should be initialized to the
+ first search point in the binary search.
+
+ MOUT (output) INTEGER
+ If IJOB=1, the number of eigenvalues in the intervals.
+ If IJOB=2 or 3, the number of intervals output.
+ If IJOB=3, MOUT will equal MINP.
+
+ NAB (input/output) INTEGER array, dimension (MMAX,2)
+ If IJOB=1, then on output NAB(i,j) will be set to N(AB(i,j)).
+ If IJOB=2, then on input, NAB(i,j) should be set. It must
+ satisfy the condition:
+ N(AB(i,1)) <= NAB(i,1) <= NAB(i,2) <= N(AB(i,2)),
+ which means that in interval i only eigenvalues
+ NAB(i,1)+1,...,NAB(i,2) will be considered. Usually,
+ NAB(i,j)=N(AB(i,j)), from a previous call to SLAEBZ with
+ IJOB=1.
+ On output, NAB(i,j) will contain
+ max(na(k),min(nb(k),N(AB(i,j)))), where k is the index of
+
+ the input interval that the output interval
+ (AB(j,1),AB(j,2)] came from, and na(k) and nb(k) are the
+ the input values of NAB(k,1) and NAB(k,2).
+ If IJOB=3, then on output, NAB(i,j) contains N(AB(i,j)),
+ unless N(w) > NVAL(i) for all search points w , in which
+
+ case NAB(i,1) will not be modified, i.e., the output
+ value will be the same as the input value (modulo
+ reorderings -- see NVAL and AB), or unless N(w) < NVAL(i)
+
+ for all search points w , in which case NAB(i,2) will
+ not be modified. Normally, NAB should be set to some
+ distinctive value(s) before SLAEBZ is called.
+
+ WORK (workspace) REAL array, dimension (MMAX)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (MMAX)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: All intervals converged.
+ = 1--MMAX: The last INFO intervals did not converge.
+ = MMAX+1: More than MMAX intervals were generated.
+
+ Further Details
+ ===============
+
+ This routine is intended to be called only by other LAPACK
+ routines, thus the interface is less user-friendly. It is intended
+ for two purposes:
+
+ (a) finding eigenvalues. In this case, SLAEBZ should have one or
+ more initial intervals set up in AB, and SLAEBZ should be called
+
+ with IJOB=1. This sets up NAB, and also counts the eigenvalues.
+
+ Intervals with no eigenvalues would usually be thrown out at
+ this point. Also, if not all the eigenvalues in an interval i
+ are desired, NAB(i,1) can be increased or NAB(i,2) decreased.
+ For example, set NAB(i,1)=NAB(i,2)-1 to get the largest
+ eigenvalue. SLAEBZ is then called with IJOB=2 and MMAX
+ no smaller than the value of MOUT returned by the call with
+ IJOB=1. After this (IJOB=2) call, eigenvalues NAB(i,1)+1
+ through NAB(i,2) are approximately AB(i,1) (or AB(i,2)) to the
+ tolerance specified by ABSTOL and RELTOL.
+
+ (b) finding an interval (a',b'] containing eigenvalues w(f),...,w(l).
+ In this case, start with a Gershgorin interval (a,b). Set up
+ AB to contain 2 search intervals, both initially (a,b). One
+ NVAL element should contain f-1 and the other should contain l
+ , while C should contain a and b, resp. NAB(i,1) should be -1
+ and NAB(i,2) should be N+1, to flag an error if the desired
+ interval does not lie in (a,b). SLAEBZ is then called with
+ IJOB=3. On exit, if w(f-1) < w(f), then one of the intervals --
+
+ j -- will have AB(j,1)=AB(j,2) and NAB(j,1)=NAB(j,2)=f-1, while
+ if, to the specified tolerance, w(f-k)=...=w(f+r), k > 0 and r
+ >= 0, then the interval will have N(AB(j,1))=NAB(j,1)=f-k and
+ N(AB(j,2))=NAB(j,2)=f+r. The cases w(l) < w(l+1) and
+ w(l-r)=...=w(l+k) are handled similarly.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param ijob
+ * @param nitmax
+ * @param n
+ * @param mmax
+ * @param minp
+ * @param nbmin
+ * @param abstol
+ * @param reltol
+ * @param pivmin
+ * @param d
+ * @param e
+ * @param e2
+ * @param nval
+ * @param ab
+ * @param c
+ * @param mout
+ * @param nab
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slaebz(int ijob, int nitmax, int n, int mmax, int minp, int nbmin, float abstol, float reltol, float pivmin, float[] d, float[] e, float[] e2, int[] nval, float[] ab, float[] c, intW mout, int[] nab, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED0 computes all eigenvalues and corresponding eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+ = 2: Compute eigenvalues and eigenvectors of tridiagonal
+ matrix.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the main diagonal of the tridiagonal matrix.
+ On exit, its eigenvalues.
+
+ E (input) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, Q must contain an N-by-N orthogonal matrix.
+ If ICOMPQ = 0 Q is not referenced.
+ If ICOMPQ = 1 On entry, Q is a subset of the columns of the
+ orthogonal matrix used to reduce the full
+ matrix to tridiagonal form corresponding to
+ the subset of the full matrix which is being
+
+ decomposed at this time.
+ If ICOMPQ = 2 On entry, Q will be the identity matrix.
+ On exit, Q contains the eigenvectors of the
+ tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If eigenvectors are
+ desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
+
+ QSTORE (workspace) REAL array, dimension (LDQS, N)
+ Referenced only when ICOMPQ = 1. Used to store parts of
+ the eigenvector matrix when the updating matrix multiplies
+ take place.
+
+ LDQS (input) INTEGER
+ The leading dimension of the array QSTORE. If ICOMPQ = 1,
+ then LDQS >= max(1,N). In any case, LDQS >= 1.
+
+ WORK (workspace) REAL array,
+ If ICOMPQ = 0 or 1, the dimension of WORK must be at least
+ 1 + 3*N + 2*N*lg N + 2*N**2
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of WORK must be at least
+ 4*N + N**2.
+
+ IWORK (workspace) INTEGER array,
+ If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
+ 6 + 6*N + 5*N*lg N.
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of IWORK must be at least
+ 3 + 5*N.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param qsiz
+ * @param n
+ * @param d
+ * @param e
+ * @param q
+ * @param ldq
+ * @param qstore
+ * @param ldqs
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slaed0(int icompq, int qsiz, int n, float[] d, float[] e, float[] q, int ldq, float[] qstore, int ldqs, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED1 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and eigenvectors of a tridiagonal matrix. SLAED7 handles
+ the case in which eigenvalues only or eigenvalues and eigenvectors
+ of a full symmetric matrix (which was reduced to tridiagonal form)
+ are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLAED2.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine SLAED4 (as called by SLAED3).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ On entry, the permutation which separately sorts the two
+ subproblems in D into ascending order.
+ On exit, the permutation which will reintegrate the
+ subproblems back into sorted order,
+ i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
+
+ RHO (input) REAL
+ The subdiagonal entry used to create the rank-1 modification.
+
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= CUTPNT <= N/2.
+
+ WORK (workspace) REAL array, dimension (4*N + N**2)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param cutpnt
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slaed1(int n, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED2 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation. 0 <= K <=N.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D contains the eigenvalues of the two submatrices to
+ be combined.
+ On exit, D contains the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, Q contains the eigenvectors of two submatrices in
+ the two square blocks with corners at (1,1), (N1,N1)
+ and (N1+1, N1+1), (N,N).
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have N1 added to their
+ values. Destroyed on exit.
+
+ RHO (input/output) REAL
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ SLAED3.
+
+ Z (input) REAL array, dimension (N)
+ On entry, Z contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+ On exit, the contents of Z have been destroyed by the updating
+ process.
+
+ DLAMDA (output) REAL array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ SLAED3 to form the secular equation.
+
+ W (output) REAL array, dimension (N)
+ The first k values of the final deflation-altered z-vector
+ which will be passed to SLAED3.
+
+ Q2 (output) REAL array, dimension (N1**2+(N-N1)**2)
+ A copy of the first K eigenvectors which will be used by
+ SLAED3 in a matrix multiply (SGEMM) to solve for the new
+ eigenvectors.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of DLAMDA into
+ ascending order.
+
+ INDXC (output) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups: the first group contains non-zero
+ elements only at and above N1, the second contains
+ non-zero elements only below N1, and the third is dense.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ During execution, a label which will indicate which of the
+ following types a column in the Q2 matrix is:
+ 1 : non-zero in the upper half only;
+ 2 : dense;
+ 3 : non-zero in the lower half only;
+ 4 : deflated.
+ On exit, COLTYP(i) is the number of columns of type i,
+ for i=1 to 4 only.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param k
+ * @param n
+ * @param n1
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param z
+ * @param dlamda
+ * @param w
+ * @param q2
+ * @param indx
+ * @param indxc
+ * @param indxp
+ * @param coltyp
+ * @param info
+ */
+ public abstract void slaed2(intW k, int n, int n1, float[] d, float[] q, int ldq, int[] indxq, floatW rho, float[] z, float[] dlamda, float[] w, float[] q2, int[] indx, int[] indxc, int[] indxp, int[] coltyp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED3 finds the roots of the secular equation, as defined by the
+ values in D, W, and RHO, between 1 and K. It makes the
+ appropriate calls to SLAED4 and then updates the eigenvectors by
+ multiplying the matrix of eigenvectors of the pair of eigensystems
+ being combined by the matrix of eigenvectors of the K-by-K system
+ which is solved here.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ SLAED4. K >= 0.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (deflation may result in N>K).
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading submatrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (output) REAL array, dimension (N)
+ D(I) contains the updated eigenvalues for
+ 1 <= I <= K.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ Initially the first K columns are used as workspace.
+ On output the columns 1 to K contain
+ the updated eigenvectors.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ RHO (input) REAL
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input/output) REAL array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation. May be changed on output by
+ having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
+
+ Cray-2, or Cray C-90, as described above.
+
+ Q2 (input) REAL array, dimension (LDQ2, N)
+ The first K columns of this matrix contain the non-deflated
+ eigenvectors for the split problem.
+
+ INDX (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups (see SLAED2).
+ The rows of the eigenvectors found by SLAED4 must be likewise
+ permuted before the matrix multiply can take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in Q, as described in INDX. The fourth column type is any
+ column which has been deflated.
+
+ W (input/output) REAL array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector. Destroyed on
+ output.
+
+ S (workspace) REAL array, dimension (N1 + 1)*K
+ Will contain the eigenvectors of the repaired matrix which
+ will be multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max(1,K).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param k
+ * @param n
+ * @param n1
+ * @param d
+ * @param q
+ * @param ldq
+ * @param rho
+ * @param dlamda
+ * @param q2
+ * @param indx
+ * @param ctot
+ * @param w
+ * @param s
+ * @param info
+ */
+ public abstract void slaed3(int k, int n, int n1, float[] d, float[] q, int ldq, float rho, float[] dlamda, float[] q2, int[] indx, int[] ctot, float[] w, float[] s, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th updated eigenvalue of a symmetric
+ rank-one modification to a diagonal matrix whose elements are
+ given in the array d, and that
+
+ D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) REAL array, dimension (N)
+ The original eigenvalues. It is assumed that they are in
+ order, D(I) < D(J) for I < J.
+
+ Z (input) REAL array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (N)
+ If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5
+
+ for detail. The vector DELTA contains the information necessar
+ to construct the eigenvectors by SLAED3 and SLAED9.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) REAL
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param dlam
+ * @param info
+ */
+ public abstract void slaed4(int n, int i, float[] d, float[] z, float[] delta, float rho, floatW dlam, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th eigenvalue of a symmetric rank-one
+
+ modification of a 2-by-2 diagonal matrix
+
+ diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal elements in the array D are assumed to satisfy
+
+ D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) REAL array, dimension (2)
+ The original eigenvalues. We assume D(1) < D(2).
+
+ Z (input) REAL array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (2)
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) REAL
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param dlam
+ */
+ public abstract void slaed5(int i, float[] d, float[] z, float[] delta, float rho, floatW dlam);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED6 computes the positive or negative root (closest to the origin)
+ of
+ z(1) z(2) z(3)
+ f(x) = rho + --------- + ---------- + ---------
+ d(1)-x d(2)-x d(3)-x
+
+ It is assumed that
+
+ if ORGATI = .true. the root is between d(2) and d(3);
+ otherwise it is between d(1) and d(2)
+
+ This routine will be called by SLAED4 when necessary. In most cases,
+
+ the root sought is the smallest in magnitude, though it might not be
+
+ in some extremely rare situations.
+
+ Arguments
+ =========
+
+ KNITER (input) INTEGER
+ Refer to SLAED4 for its significance.
+
+ ORGATI (input) LOGICAL
+ If ORGATI is true, the needed root is between d(2) and
+ d(3); otherwise it is between d(1) and d(2). See
+ SLAED4 for further details.
+
+ RHO (input) REAL
+ Refer to the equation f(x) above.
+
+ D (input) REAL array, dimension (3)
+ D satisfies d(1) < d(2) < d(3).
+
+ Z (input) REAL array, dimension (3)
+ Each of the elements in z must be positive.
+
+ FINIT (input) REAL
+ The value of f at 0. It is more accurate than the one
+ evaluated inside this routine (if someone wants to do
+ so).
+
+ TAU (output) REAL
+ The root of the equation f(x).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, failure to converge
+
+ Further Details
+ ===============
+
+ 30/06/99: Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ 10/02/03: This version has a few statements commented out for thread
+ (machine parameters are computed on each entry). SJH.
+
+ 05/10/06: Modified from a new version of Ren-Cang Li, use
+ Gragg-Thornton-Warner cubic convergent scheme for better stability
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param kniter
+ * @param orgati
+ * @param rho
+ * @param d
+ * @param z
+ * @param finit
+ * @param tau
+ * @param info
+ */
+ public abstract void slaed6(int kniter, boolean orgati, float rho, float[] d, float[] z, float finit, floatW tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED7 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and optionally eigenvectors of a dense symmetric matrix
+ that has been reduced to tridiagonal form. SLAED1 handles
+ the case in which all eigenvalues and eigenvectors of a symmetric
+ tridiagonal matrix are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLAED8.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine SLAED4 (as called by SLAED9).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= CURLVL <= TLVLS.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) REAL array, dimension (LDQ, N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (output) INTEGER array, dimension (N)
+ The permutation which will reintegrate the subproblem just
+ solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
+ will be in ascending order.
+
+ RHO (input) REAL
+ The subdiagonal element used to create the rank-1
+ modification.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ QSTORE (input/output) REAL array, dimension (N**2+1)
+ Stores eigenvectors of submatrices encountered during
+ divide and conquer, packed together. QPTR points to
+ beginning of the submatrices.
+
+ QPTR (input/output) INTEGER array, dimension (N+2)
+ List of indices pointing to beginning of submatrices stored
+ in QSTORE. The submatrices are numbered starting at the
+ bottom left of the divide and conquer tree, from left to
+ right and bottom to top.
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and also the size of
+ the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) REAL array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ WORK (workspace) REAL array, dimension (3*N+QSIZ*N)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param n
+ * @param qsiz
+ * @param tlvls
+ * @param curlvl
+ * @param curpbm
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param cutpnt
+ * @param qstore
+ * @param qptr
+ * @param prmptr
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param givnum
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slaed7(int icompq, int n, int qsiz, int tlvls, int curlvl, int curpbm, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] qstore, int[] qptr, int[] prmptr, int[] perm, int[] givptr, int[] givcol, float[] givnum, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED8 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny element in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+
+ to reduce the original matrix to tridiagonal form.
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the eigenvalues of the two submatrices to be
+ combined. On exit, the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ If ICOMPQ = 0, Q is not referenced. Otherwise,
+ on entry, Q contains the eigenvectors of the partially solved
+
+ system which has been previously updated in matrix
+ multiplies with other partially solved eigensystems.
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have CUTPNT added to
+ their values in order to be accurate.
+
+ RHO (input/output) REAL
+ On entry, the off-diagonal element associated with the rank-1
+
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ SLAED3.
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ Z (input) REAL array, dimension (N)
+ On entry, Z contains the updating vector (the last row of
+ the first sub-eigenvector matrix and the first row of the
+ second sub-eigenvector matrix).
+ On exit, the contents of Z are destroyed by the updating
+ process.
+
+ DLAMDA (output) REAL array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ SLAED3 to form the secular equation.
+
+ Q2 (output) REAL array, dimension (LDQ2,N)
+ If ICOMPQ = 0, Q2 is not referenced. Otherwise,
+ a copy of the first K eigenvectors which will be used by
+ SLAED7 in a matrix multiply (SGEMM) to update the new
+ eigenvectors.
+
+ LDQ2 (input) INTEGER
+ The leading dimension of the array Q2. LDQ2 >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ The first k values of the final deflation-altered z-vector and
+ will be passed to SLAED3.
+
+ PERM (output) INTEGER array, dimension (N)
+ The permutations (from deflation and sorting) to be applied
+ to each eigenblock.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (output) INTEGER array, dimension (2, N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (output) REAL array, dimension (2, N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of D into ascending
+
+ order.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param k
+ * @param n
+ * @param qsiz
+ * @param d
+ * @param q
+ * @param ldq
+ * @param indxq
+ * @param rho
+ * @param cutpnt
+ * @param z
+ * @param dlamda
+ * @param q2
+ * @param ldq2
+ * @param w
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param givnum
+ * @param indxp
+ * @param indx
+ * @param info
+ */
+ public abstract void slaed8(int icompq, intW k, int n, int qsiz, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] z, float[] dlamda, float[] q2, int ldq2, float[] w, int[] perm, intW givptr, int[] givcol, float[] givnum, int[] indxp, int[] indx, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAED9 finds the roots of the secular equation, as defined by the
+ values in D, Z, and RHO, between KSTART and KSTOP. It makes the
+ appropriate calls to SLAED4 and then stores the new matrix of
+ eigenvectors for use in calculating the next level of Z vectors.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+
+ SLAED4. K >= 0.
+
+ KSTART (input) INTEGER
+ KSTOP (input) INTEGER
+ The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
+ are to be computed. 1 <= KSTART <= KSTOP <= K.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (delation may result in N > K).
+
+ D (output) REAL array, dimension (N)
+ D(I) contains the updated eigenvalues
+ for KSTART <= I <= KSTOP.
+
+ Q (workspace) REAL array, dimension (LDQ,N)
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max( 1, N ).
+
+ RHO (input) REAL
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input) REAL array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ W (input) REAL array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector.
+
+ S (output) REAL array, dimension (LDS, K)
+ Will contain the eigenvectors of the repaired matrix which
+ will be stored for subsequent Z vector calculation and
+ multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max( 1, K ).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param k
+ * @param kstart
+ * @param kstop
+ * @param n
+ * @param d
+ * @param q
+ * @param ldq
+ * @param rho
+ * @param dlamda
+ * @param w
+ * @param s
+ * @param lds
+ * @param info
+ */
+ public abstract void slaed9(int k, int kstart, int kstop, int n, float[] d, float[] q, int ldq, float rho, float[] dlamda, float[] w, float[] s, int lds, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEDA computes the Z vector corresponding to the merge step in the
+ CURLVLth step of the merge process with TLVLS steps for the CURPBMth
+
+ problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= curlvl <= tlvls.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and incidentally the
+ size of the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) REAL array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ Q (input) REAL array, dimension (N**2)
+ Contains the square eigenblocks from previous levels, the
+ starting positions for blocks are given by QPTR.
+
+ QPTR (input) INTEGER array, dimension (N+2)
+ Contains a list of pointers which indicate where in Q an
+ eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
+ the size of the block.
+
+ Z (output) REAL array, dimension (N)
+ On output this vector contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+
+ ZTEMP (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param tlvls
+ * @param curlvl
+ * @param curpbm
+ * @param prmptr
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param givnum
+ * @param q
+ * @param qptr
+ * @param z
+ * @param ztemp
+ * @param info
+ */
+ public abstract void slaeda(int n, int tlvls, int curlvl, int curpbm, int[] prmptr, int[] perm, int[] givptr, int[] givcol, float[] givnum, float[] q, int[] qptr, float[] z, float[] ztemp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEIN uses inverse iteration to find a right or left eigenvector
+ corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg
+ matrix H.
+
+ Arguments
+ =========
+
+ RIGHTV (input) LOGICAL
+ = .TRUE. : compute right eigenvector;
+ = .FALSE.: compute left eigenvector.
+
+ NOINIT (input) LOGICAL
+ = .TRUE. : no initial vector supplied in (VR,VI).
+ = .FALSE.: initial vector supplied in (VR,VI).
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ H (input) REAL array, dimension (LDH,N)
+ The upper Hessenberg matrix H.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (input) REAL
+ WI (input) REAL
+ The real and imaginary parts of the eigenvalue of H whose
+ corresponding right or left eigenvector is to be computed.
+
+ VR (input/output) REAL array, dimension (N)
+ VI (input/output) REAL array, dimension (N)
+ On entry, if NOINIT = .FALSE. and WI = 0.0, VR must contain
+ a real starting vector for inverse iteration using the real
+ eigenvalue WR; if NOINIT = .FALSE. and WI.ne.0.0, VR and VI
+ must contain the real and imaginary parts of a complex
+ starting vector for inverse iteration using the complex
+ eigenvalue (WR,WI); otherwise VR and VI need not be set.
+ On exit, if WI = 0.0 (real eigenvalue), VR contains the
+ computed real eigenvector; if WI.ne.0.0 (complex eigenvalue),
+ VR and VI contain the real and imaginary parts of the
+ computed complex eigenvector. The eigenvector is normalized
+ so that the component of largest magnitude has magnitude 1;
+ here the magnitude of a complex number (x,y) is taken to be
+ |x| + |y|.
+ VI is not referenced if WI = 0.0.
+
+ B (workspace) REAL array, dimension (LDB,N)
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= N+1.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ EPS3 (input) REAL
+ A small machine-dependent value which is used to perturb
+ close eigenvalues, and to replace zero pivots.
+
+ SMLNUM (input) REAL
+ A machine-dependent value close to the underflow threshold.
+
+ BIGNUM (input) REAL
+ A machine-dependent value close to the overflow threshold.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: inverse iteration did not converge; VR is set to the
+ last iterate, and so is VI if WI.ne.0.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param rightv
+ * @param noinit
+ * @param n
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param vr
+ * @param vi
+ * @param b
+ * @param ldb
+ * @param work
+ * @param eps3
+ * @param smlnum
+ * @param bignum
+ * @param info
+ */
+ public abstract void slaein(boolean rightv, boolean noinit, int n, float[] h, int ldh, float wr, float wi, float[] vr, float[] vi, float[] b, int ldb, float[] work, float eps3, float smlnum, float bignum, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
+ eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
+ eigenvector for RT1, giving the decomposition
+
+ [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
+ [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
+
+ Arguments
+ =========
+
+ A (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) REAL
+ The (1,2) element and the conjugate of the (2,1) element of
+ the 2-by-2 matrix.
+
+ C (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) REAL
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) REAL
+ The eigenvalue of smaller absolute value.
+
+ CS1 (output) REAL
+ SN1 (output) REAL
+ The vector (CS1, SN1) is a unit right eigenvector for RT1.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ CS1 and SN1 are accurate to a few ulps barring over/underflow.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param rt1
+ * @param rt2
+ * @param cs1
+ * @param sn1
+ */
+ public abstract void slaev2(float a, float b, float c, floatW rt1, floatW rt2, floatW cs1, floatW sn1);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
+
+ an upper quasi-triangular matrix T by an orthogonal similarity
+ transformation.
+
+ T must be in Schur canonical form, that is, block upper triangular
+ with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
+ has its diagonal elemnts equal and its off-diagonal elements of
+ opposite sign.
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ = .TRUE. : accumulate the transformation in the matrix Q;
+ = .FALSE.: do not accumulate the transformation.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) REAL array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, the updated matrix T, again in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
+ On exit, if WANTQ is .TRUE., the updated matrix Q.
+ If WANTQ is .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
+
+ J1 (input) INTEGER
+ The index of the first row of the first block T11.
+
+ N1 (input) INTEGER
+ The order of the first block T11. N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block T22. N2 = 0, 1 or 2.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ = 1: the transformed matrix T would be too far from Schur
+ form; the blocks are not swapped and T and Q are
+ unchanged.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param wantq
+ * @param n
+ * @param t
+ * @param ldt
+ * @param q
+ * @param ldq
+ * @param j1
+ * @param n1
+ * @param n2
+ * @param work
+ * @param info
+ */
+ public abstract void slaexc(boolean wantq, int n, float[] t, int ldt, float[] q, int ldq, int j1, int n1, int n2, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
+ problem A - w B, with scaling as necessary to avoid over-/underflow.
+
+ The scaling factor "s" results in a modified eigenvalue equation
+
+ s A - w B
+
+ where s is a non-negative scaling factor chosen so that w, w B,
+ and s A do not overflow and, if possible, do not underflow, either.
+
+ Arguments
+ =========
+
+ A (input) REAL array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
+
+ is less than 1/SAFMIN. Entries less than
+ sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= 2.
+
+ B (input) REAL array, dimension (LDB, 2)
+ On entry, the 2 x 2 upper triangular matrix B. It is
+ assumed that the one-norm of B is less than 1/SAFMIN. The
+ diagonals should be at least sqrt(SAFMIN) times the largest
+ element of B (in absolute value); if a diagonal is smaller
+ than that, then +/- sqrt(SAFMIN) will be used instead of
+ that diagonal.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= 2.
+
+ SAFMIN (input) REAL
+ The smallest positive number s.t. 1/SAFMIN does not
+ overflow. (This should always be SLAMCH('S') -- it is an
+ argument in order to avoid having to call SLAMCH frequently.)
+
+ SCALE1 (output) REAL
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the first eigenvalue. If
+ the eigenvalues are complex, then the eigenvalues are
+ ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
+ exponent range of the machine), SCALE1=SCALE2, and SCALE1
+ will always be positive. If the eigenvalues are real, then
+ the first (real) eigenvalue is WR1 / SCALE1 , but this may
+ overflow or underflow, and in fact, SCALE1 may be zero or
+ less than the underflow threshhold if the exact eigenvalue
+ is sufficiently large.
+
+ SCALE2 (output) REAL
+ A scaling factor used to avoid over-/underflow in the
+ eigenvalue equation which defines the second eigenvalue. If
+
+ the eigenvalues are complex, then SCALE2=SCALE1. If the
+ eigenvalues are real, then the second (real) eigenvalue is
+ WR2 / SCALE2 , but this may overflow or underflow, and in
+ fact, SCALE2 may be zero or less than the underflow
+ threshhold if the exact eigenvalue is sufficiently large.
+
+ WR1 (output) REAL
+ If the eigenvalue is real, then WR1 is SCALE1 times the
+ eigenvalue closest to the (2,2) element of A B**(-1). If the
+ eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
+
+ part of the eigenvalues.
+
+ WR2 (output) REAL
+ If the eigenvalue is real, then WR2 is SCALE2 times the
+ other eigenvalue. If the eigenvalue is complex, then
+ WR1=WR2 is SCALE1 times the real part of the eigenvalues.
+
+ WI (output) REAL
+ If the eigenvalue is real, then WI is zero. If the
+ eigenvalue is complex, then WI is SCALE1 times the imaginary
+
+ part of the eigenvalues. WI will always be non-negative.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param safmin
+ * @param scale1
+ * @param scale2
+ * @param wr1
+ * @param wr2
+ * @param wi
+ */
+ public abstract void slag2(float[] a, int lda, float[] b, int ldb, float safmin, floatW scale1, floatW scale2, floatW wr1, floatW wr2, floatW wi);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAG2D converts a SINGLE PRECISION matrix, SA, to a DOUBLE
+ PRECISION matrix, A.
+
+ Note that while it is possible to overflow while converting
+ from double to single, it is not possible to overflow when
+ converting from single to double.
+
+ This is a helper routine so there is no argument checking.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of lines of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ SA (output) REAL array, dimension (LDSA,N)
+ On exit, the M-by-N coefficient matrix SA.
+
+ LDSA (input) INTEGER
+ The leading dimension of the array SA. LDSA >= max(1,M).
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N coefficient matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ =========
+
+ .. Local Scalars ..
+</pre>
+ * @param m
+ * @param n
+ * @param sa
+ * @param ldsa
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public void slag2d(int m, int n, float[] sa, int ldsa, double[] a, int lda, intW info) {
+ org.netlib.lapack.Slag2d.slag2d(m, n, sa, 0, ldsa, a, 0, lda, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
+ that if ( UPPER ) then
+
+ U'*A*Q = U'*( A1 A2 )*Q = ( x 0 )
+ ( 0 A3 ) ( x x )
+ and
+ V'*B*Q = V'*( B1 B2 )*Q = ( x 0 )
+ ( 0 B3 ) ( x x )
+
+ or if ( .NOT.UPPER ) then
+
+ U'*A*Q = U'*( A1 0 )*Q = ( x x )
+ ( A2 A3 ) ( 0 x )
+ and
+ V'*B*Q = V'*( B1 0 )*Q = ( x x )
+ ( B2 B3 ) ( 0 x )
+
+ The rows of the transformed A and B are parallel, where
+
+ U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
+ ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
+
+ Z' denotes the transpose of Z.
+
+
+ Arguments
+ =========
+
+ UPPER (input) LOGICAL
+ = .TRUE.: the input matrices A and B are upper triangular.
+ = .FALSE.: the input matrices A and B are lower triangular.
+
+ A1 (input) REAL
+ A2 (input) REAL
+ A3 (input) REAL
+ On entry, A1, A2 and A3 are elements of the input 2-by-2
+ upper (lower) triangular matrix A.
+
+ B1 (input) REAL
+ B2 (input) REAL
+ B3 (input) REAL
+ On entry, B1, B2 and B3 are elements of the input 2-by-2
+ upper (lower) triangular matrix B.
+
+ CSU (output) REAL
+ SNU (output) REAL
+ The desired orthogonal matrix U.
+
+ CSV (output) REAL
+ SNV (output) REAL
+ The desired orthogonal matrix V.
+
+ CSQ (output) REAL
+ SNQ (output) REAL
+ The desired orthogonal matrix Q.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param upper
+ * @param a1
+ * @param a2
+ * @param a3
+ * @param b1
+ * @param b2
+ * @param b3
+ * @param csu
+ * @param snu
+ * @param csv
+ * @param snv
+ * @param csq
+ * @param snq
+ */
+ public abstract void slags2(boolean upper, float a1, float a2, float a3, float b1, float b2, float b3, floatW csu, floatW snu, floatW csv, floatW snv, floatW csq, floatW snq);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
+ tridiagonal matrix and lambda is a scalar, as
+
+ T - lambda*I = PLU,
+
+ where P is a permutation matrix, L is a unit lower tridiagonal matrix
+ with at most one non-zero sub-diagonal elements per column and U is
+ an upper triangular matrix with at most two non-zero super-diagonal
+ elements per column.
+
+ The factorization is obtained by Gaussian elimination with partial
+ pivoting and implicit row scaling.
+
+ The parameter LAMBDA is included in the routine so that SLAGTF may
+ be used, in conjunction with SLAGTS, to obtain eigenvectors of T by
+ inverse iteration.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input/output) REAL array, dimension (N)
+ On entry, A must contain the diagonal elements of T.
+
+ On exit, A is overwritten by the n diagonal elements of the
+ upper triangular matrix U of the factorization of T.
+
+ LAMBDA (input) REAL
+ On entry, the scalar lambda.
+
+ B (input/output) REAL array, dimension (N-1)
+ On entry, B must contain the (n-1) super-diagonal elements of
+ T.
+
+ On exit, B is overwritten by the (n-1) super-diagonal
+ elements of the matrix U of the factorization of T.
+
+ C (input/output) REAL array, dimension (N-1)
+ On entry, C must contain the (n-1) sub-diagonal elements of
+ T.
+
+ On exit, C is overwritten by the (n-1) sub-diagonal elements
+
+ of the matrix L of the factorization of T.
+
+ TOL (input) REAL
+ On entry, a relative tolerance used to indicate whether or
+ not the matrix (T - lambda*I) is nearly singular. TOL should
+
+ normally be chose as approximately the largest relative error
+ in the elements of T. For example, if the elements of T are
+ correct to about 4 significant figures, then TOL should be
+ set to about 5*10**(-4). If TOL is supplied as less than eps,
+ where eps is the relative machine precision, then the value
+ eps is used in place of TOL.
+
+ D (output) REAL array, dimension (N-2)
+ On exit, D is overwritten by the (n-2) second super-diagonal
+
+ elements of the matrix U of the factorization of T.
+
+ IN (output) INTEGER array, dimension (N)
+ On exit, IN contains details of the permutation matrix P. If
+
+ an interchange occurred at the kth step of the elimination,
+ then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
+ returns the smallest positive integer j such that
+
+ abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
+
+ where norm( A(j) ) denotes the sum of the absolute values of
+
+ the jth row of the matrix A. If no such j exists then IN(n)
+ is returned as zero. If IN(n) is returned as positive, then a
+ diagonal element of U is small, indicating that
+ (T - lambda*I) is singular or nearly singular,
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -k, the kth argument had an illegal value
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lambda
+ * @param b
+ * @param c
+ * @param tol
+ * @param d
+ * @param in
+ * @param info
+ */
+ public abstract void slagtf(int n, float[] a, float lambda, float[] b, float[] c, float tol, float[] d, int[] in, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGTM performs a matrix-vector product of the form
+
+ B := alpha * A * X + beta * B
+
+ where A is a tridiagonal matrix of order N, B and X are N by NRHS
+ matrices, and alpha and beta are real scalars, each of which may be
+ 0., 1., or -1.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': No transpose, B := alpha * A * X + beta * B
+ = 'T': Transpose, B := alpha * A'* X + beta * B
+ = 'C': Conjugate transpose = Transpose
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices X and B.
+
+ ALPHA (input) REAL
+ The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 0.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) sub-diagonal elements of T.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of T.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) super-diagonal elements of T.
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The N by NRHS matrix X.
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(N,1).
+
+ BETA (input) REAL
+ The scalar beta. BETA must be 0., 1., or -1.; otherwise,
+ it is assumed to be 1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N by NRHS matrix B.
+ On exit, B is overwritten by the matrix expression
+ B := alpha * A * X + beta * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(N,1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param n
+ * @param nrhs
+ * @param alpha
+ * @param dl
+ * @param d
+ * @param du
+ * @param x
+ * @param ldx
+ * @param beta
+ * @param b
+ * @param ldb
+ */
+ public abstract void slagtm(String trans, int n, int nrhs, float alpha, float[] dl, float[] d, float[] du, float[] x, int ldx, float beta, float[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGTS may be used to solve one of the systems of equations
+
+ (T - lambda*I)*x = y or (T - lambda*I)'*x = y,
+
+ where T is an n by n tridiagonal matrix, for x, following the
+ factorization of (T - lambda*I) as
+
+ (T - lambda*I) = P*L*U ,
+
+ by routine SLAGTF. The choice of equation to be solved is
+ controlled by the argument JOB, and in each case there is an option
+ to perturb zero or very small diagonal elements of U, this option
+ being intended for use in applications such as inverse iteration.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ Specifies the job to be performed by SLAGTS as follows:
+ = 1: The equations (T - lambda*I)x = y are to be solved,
+ but diagonal elements of U are not to be perturbed.
+ = -1: The equations (T - lambda*I)x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+ = 2: The equations (T - lambda*I)'x = y are to be solved,
+
+ but diagonal elements of U are not to be perturbed.
+ = -2: The equations (T - lambda*I)'x = y are to be solved
+ and, if overflow would otherwise occur, the diagonal
+ elements of U are to be perturbed. See argument TOL
+ below.
+
+ N (input) INTEGER
+ The order of the matrix T.
+
+ A (input) REAL array, dimension (N)
+ On entry, A must contain the diagonal elements of U as
+ returned from SLAGTF.
+
+ B (input) REAL array, dimension (N-1)
+ On entry, B must contain the first super-diagonal elements of
+ U as returned from SLAGTF.
+
+ C (input) REAL array, dimension (N-1)
+ On entry, C must contain the sub-diagonal elements of L as
+ returned from SLAGTF.
+
+ D (input) REAL array, dimension (N-2)
+ On entry, D must contain the second super-diagonal elements
+ of U as returned from SLAGTF.
+
+ IN (input) INTEGER array, dimension (N)
+ On entry, IN must contain details of the matrix P as returned
+ from SLAGTF.
+
+ Y (input/output) REAL array, dimension (N)
+ On entry, the right hand side vector y.
+ On exit, Y is overwritten by the solution vector x.
+
+ TOL (input/output) REAL
+ On entry, with JOB .lt. 0, TOL should be the minimum
+ perturbation to be made to very small diagonal elements of U.
+ TOL should normally be chosen as about eps*norm(U), where eps
+ is the relative machine precision, but if TOL is supplied as
+
+ non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
+ If JOB .gt. 0 then TOL is not referenced.
+
+ On exit, TOL is changed as described above, only if TOL is
+ non-positive on entry. Otherwise TOL is unchanged.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ .lt. 0: if INFO = -i, the i-th argument had an illegal value
+
+ .gt. 0: overflow would occur when computing the INFO(th)
+ element of the solution vector x. This can only occur
+ when JOB is supplied as positive and either means
+ that a diagonal element of U is very small, or that
+ the elements of the right-hand side vector y are very
+ large.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param n
+ * @param a
+ * @param b
+ * @param c
+ * @param d
+ * @param in
+ * @param y
+ * @param tol
+ * @param info
+ */
+ public abstract void slagts(int job, int n, float[] a, float[] b, float[] c, float[] d, int[] in, float[] y, floatW tol, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAGV2 computes the Generalized Schur factorization of a real 2-by-2
+
+ matrix pencil (A,B) where B is upper triangular. This routine
+ computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
+ SNR such that
+
+ 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
+ types), then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
+
+ 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
+ then
+
+ [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+ [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+
+ [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+ [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
+
+ where b11 >= b22 > 0.
+
+
+ Arguments
+ =========
+
+ A (input/output) REAL array, dimension (LDA, 2)
+ On entry, the 2 x 2 matrix A.
+ On exit, A is overwritten by the ``A-part'' of the
+ generalized Schur form.
+
+ LDA (input) INTEGER
+ THe leading dimension of the array A. LDA >= 2.
+
+ B (input/output) REAL array, dimension (LDB, 2)
+ On entry, the upper triangular 2 x 2 matrix B.
+ On exit, B is overwritten by the ``B-part'' of the
+ generalized Schur form.
+
+ LDB (input) INTEGER
+ THe leading dimension of the array B. LDB >= 2.
+
+ ALPHAR (output) REAL array, dimension (2)
+ ALPHAI (output) REAL array, dimension (2)
+ BETA (output) REAL array, dimension (2)
+ (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
+ pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
+ be zero.
+
+ CSL (output) REAL
+ The cosine of the left rotation matrix.
+
+ SNL (output) REAL
+ The sine of the left rotation matrix.
+
+ CSR (output) REAL
+ The cosine of the right rotation matrix.
+
+ SNR (output) REAL
+ The sine of the right rotation matrix.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param csl
+ * @param snl
+ * @param csr
+ * @param snr
+ */
+ public abstract void slagv2(float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, floatW csl, floatW snl, floatW csr, floatW snr);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAHQR is an auxiliary routine called by SHSEQR to update the
+ eigenvalues and Schur decomposition already computed by SHSEQR, by
+ dealing with the Hessenberg submatrix in rows and columns ILO to
+ IHI.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper quasi-triangular in
+ rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
+ ILO = 1). SLAHQR works primarily with the Hessenberg
+ submatrix in rows and columns ILO to IHI, but applies
+ transformations to all of H if WANTT is .TRUE..
+ 1 <= ILO <= max(1,IHI); IHI <= N.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO is zero and if WANTT is .TRUE., H is upper
+ quasi-triangular in rows and columns ILO:IHI, with any
+ 2-by-2 diagonal blocks in standard form. If INFO is zero
+ and WANTT is .FALSE., the contents of H are unspecified on
+ exit. The output state of H if INFO is nonzero is given
+ below under the description of INFO.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+ eigenvalues ILO to IHI are stored in the corresponding
+ elements of WR and WI. If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
+ eigenvalues are stored in the same order as on the diagonal
+ of the Schur form returned in H, with WR(i) = H(i,i), and, if
+ H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
+ WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ If WANTZ is .TRUE., on entry Z must contain the current
+ matrix Z of transformations accumulated by SHSEQR, and on
+ exit Z has been updated; transformations are applied only to
+
+ the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+ If WANTZ is .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: If INFO = i, SLAHQR failed to compute all the
+ eigenvalues ILO to IHI in a total of 30 iterations
+ per eigenvalue; elements i+1:ihi of WR and WI
+ contain those eigenvalues which have been
+ successfully computed.
+
+ If INFO .GT. 0 and WANTT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the
+ eigenvalues of the upper Hessenberg matrix rows
+ and columns ILO thorugh INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+ (*) (initial value of H)*U = U*(final value of H)
+ where U is an orthognal matrix. The final
+ value of H is upper Hessenberg and triangular in
+ rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+ (final value of Z) = (initial value of Z)*U
+ where U is the orthogonal matrix in (*)
+ (regardless of the value of WANTT.)
+
+ Further Details
+ ===============
+
+ 02-96 Based on modifications by
+ David Day, Sandia National Laboratory, USA
+
+ 12-04 Further modifications by
+ Ralph Byers, University of Kansas, USA
+
+ This is a modified version of SLAHQR from LAPACK version 3.0.
+ It is (1) more robust against overflow and underflow and
+ (2) adopts the more conservative Ahues & Tisseur stopping
+ criterion (LAWN 122, 1997).
+
+ =========================================================
+
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param info
+ */
+ public abstract void slahqr(boolean wantt, boolean wantz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, int iloz, int ihiz, float[] z, int ldz, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an auxiliary routine called by SGEHRD.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+ K < N.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N-K+1)
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) REAL array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) REAL array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a a a a a )
+ ( a a a a a )
+ ( a a a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ This file is a slight modification of LAPACK-3.0's SLAHRD
+ incorporating improvements proposed by Quintana-Orti and Van de
+ Gejin. Note that the entries of A(1:K,2:NB) differ from those
+ returned by the original LAPACK routine. This function is
+ not backward compatible with LAPACK3.0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param k
+ * @param nb
+ * @param a
+ * @param lda
+ * @param tau
+ * @param t
+ * @param ldt
+ * @param y
+ * @param ldy
+ */
+ public void slahr2(int n, int k, int nb, float[] a, int lda, float[] tau, float[] t, int ldt, float[] y, int ldy) {
+ org.netlib.lapack.Slahr2.slahr2(n, k, nb, a, 0, lda, tau, 0, t, 0, ldt, y, 0, ldy);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an OBSOLETE auxiliary routine.
+ This routine will be 'deprecated' in a future release.
+ Please use the new routine SLAHR2 instead.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N-K+1)
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+
+ product of elementary reflectors. The other columns of A are
+
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) REAL array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+
+ Details.
+
+ T (output) REAL array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) REAL array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a h a a a )
+ ( a h a a a )
+ ( a h a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+
+ element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param k
+ * @param nb
+ * @param a
+ * @param lda
+ * @param tau
+ * @param t
+ * @param ldt
+ * @param y
+ * @param ldy
+ */
+ public abstract void slahrd(int n, int k, int nb, float[] a, int lda, float[] tau, float[] t, int ldt, float[] y, int ldy);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAIC1 applies one step of incremental condition estimation in
+ its simplest version:
+
+ Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
+ lower triangular matrix L, such that
+ twonorm(L*x) = sest
+ Then SLAIC1 computes sestpr, s, c such that
+ the vector
+ [ s*x ]
+ xhat = [ c ]
+ is an approximate singular vector of
+ [ L 0 ]
+ Lhat = [ w' gamma ]
+ in the sense that
+ twonorm(Lhat*xhat) = sestpr.
+
+ Depending on JOB, an estimate for the largest or smallest singular
+ value is computed.
+
+ Note that [s c]' and sestpr**2 is an eigenpair of the system
+
+ diag(sest*sest, 0) + [alpha gamma] * [ alpha ]
+ [ gamma ]
+
+ where alpha = x'*w.
+
+ Arguments
+ =========
+
+ JOB (input) INTEGER
+ = 1: an estimate for the largest singular value is computed.
+
+ = 2: an estimate for the smallest singular value is computed.
+
+ J (input) INTEGER
+ Length of X and W
+
+ X (input) REAL array, dimension (J)
+ The j-vector x.
+
+ SEST (input) REAL
+ Estimated singular value of j by j matrix L
+
+ W (input) REAL array, dimension (J)
+ The j-vector w.
+
+ GAMMA (input) REAL
+ The diagonal element gamma.
+
+ SESTPR (output) REAL
+ Estimated singular value of (j+1) by (j+1) matrix Lhat.
+
+ S (output) REAL
+ Sine needed in forming xhat.
+
+ C (output) REAL
+ Cosine needed in forming xhat.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param j
+ * @param x
+ * @param sest
+ * @param w
+ * @param gamma
+ * @param sestpr
+ * @param s
+ * @param c
+ */
+ public abstract void slaic1(int job, int j, float[] x, float sest, float[] w, float gamma, floatW sestpr, floatW s, floatW c);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is not for general use. It exists solely to avoid
+ over-optimization in SISNAN.
+
+ SLAISNAN checks for NaNs by comparing its two arguments for
+ inequality. NaN is the only floating-point value where NaN != NaN
+ returns .TRUE. To check for NaNs, pass the same variable as both
+ arguments.
+
+ Strictly speaking, Fortran does not allow aliasing of function
+ arguments. So a compiler must assume that the two arguments are
+ not the same variable, and the test will not be optimized away.
+ Interprocedural or whole-program optimization may delete this
+ test. The ISNAN functions will be replaced by the correct
+ Fortran 03 intrinsic once the intrinsic is widely available.
+
+ Arguments
+ =========
+
+ SIN1 (input) REAL
+ SIN2 (input) REAL
+ Two numbers to compare for inequality.
+
+ =====================================================================
+
+ .. Executable Statements ..
+</pre>
+ * @param sin1
+ * @param sin2
+ */
+ public boolean slaisnan(float sin1, float sin2) {
+ return org.netlib.lapack.Slaisnan.slaisnan(sin1, sin2);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALN2 solves a system of the form (ca A - w D ) X = s B
+ or (ca A' - w D) X = s B with possible scaling ("s") and
+ perturbation of A. (A' means A-transpose.)
+
+ A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
+ real diagonal matrix, w is a real or complex value, and X and B are
+ NA x 1 matrices -- real if w is real, complex if w is complex. NA
+ may be 1 or 2.
+
+ If w is complex, X and B are represented as NA x 2 matrices,
+ the first column of each being the real part and the second
+ being the imaginary part.
+
+ "s" is a scaling factor (.LE. 1), computed by SLALN2, which is
+ so chosen that X can be computed without overflow. X is further
+ scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
+ than overflow.
+
+ If both singular values of (ca A - w D) are less than SMIN,
+ SMIN*identity will be used instead of (ca A - w D). If only one
+ singular value is less than SMIN, one element of (ca A - w D) will be
+ perturbed enough to make the smallest singular value roughly SMIN.
+ If both singular values are at least SMIN, (ca A - w D) will not be
+ perturbed. In any case, the perturbation will be at most some small
+
+ multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
+ are computed by infinity-norm approximations, and thus will only be
+ correct to a factor of 2 or so.
+
+ Note: all input quantities are assumed to be smaller than overflow
+ by a reasonable factor. (See BIGNUM.)
+
+ Arguments
+ ==========
+
+ LTRANS (input) LOGICAL
+ =.TRUE.: A-transpose will be used.
+ =.FALSE.: A will be used (not transposed.)
+
+ NA (input) INTEGER
+ The size of the matrix A. It may (only) be 1 or 2.
+
+ NW (input) INTEGER
+ 1 if "w" is real, 2 if "w" is complex. It may only be 1
+ or 2.
+
+ SMIN (input) REAL
+ The desired lower bound on the singular values of A. This
+ should be a safe distance away from underflow or overflow,
+ say, between (underflow/machine precision) and (machine
+ precision * overflow ). (See BIGNUM and ULP.)
+
+ CA (input) REAL
+ The coefficient c, which A is multiplied by.
+
+ A (input) REAL array, dimension (LDA,NA)
+ The NA x NA matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of A. It must be at least NA.
+
+ D1 (input) REAL
+ The 1,1 element in the diagonal matrix D.
+
+ D2 (input) REAL
+ The 2,2 element in the diagonal matrix D. Not used if NW=1.
+
+
+ B (input) REAL array, dimension (LDB,NW)
+ The NA x NW matrix B (right-hand side). If NW=2 ("w" is
+ complex), column 1 contains the real part of B and column 2
+ contains the imaginary part.
+
+ LDB (input) INTEGER
+ The leading dimension of B. It must be at least NA.
+
+ WR (input) REAL
+ The real part of the scalar "w".
+
+ WI (input) REAL
+ The imaginary part of the scalar "w". Not used if NW=1.
+
+ X (output) REAL array, dimension (LDX,NW)
+ The NA x NW matrix X (unknowns), as computed by SLALN2.
+ If NW=2 ("w" is complex), on exit, column 1 will contain
+ the real part of X and column 2 will contain the imaginary
+ part.
+
+ LDX (input) INTEGER
+ The leading dimension of X. It must be at least NA.
+
+ SCALE (output) REAL
+ The scale factor that B must be multiplied by to insure
+ that overflow does not occur when computing X. Thus,
+ (ca A - w D) X will be SCALE*B, not B (ignoring
+ perturbations of A.) It will be at most 1.
+
+ XNORM (output) REAL
+ The infinity-norm of X, when X is regarded as an NA x NW
+ real matrix.
+
+ INFO (output) INTEGER
+ An error flag. It will be set to zero if no error occurs,
+ a negative number if an argument is in error, or a positive
+ number if ca A - w D had to be perturbed.
+ The possible values are:
+ = 0: No error occurred, and (ca A - w D) did not have to be
+ perturbed.
+ = 1: (ca A - w D) had to be perturbed to make its smallest
+ (or only) singular value greater than SMIN.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param ltrans
+ * @param na
+ * @param nw
+ * @param smin
+ * @param ca
+ * @param a
+ * @param lda
+ * @param d1
+ * @param d2
+ * @param b
+ * @param ldb
+ * @param wr
+ * @param wi
+ * @param x
+ * @param ldx
+ * @param scale
+ * @param xnorm
+ * @param info
+ */
+ public abstract void slaln2(boolean ltrans, int na, int nw, float smin, float ca, float[] a, int lda, float d1, float d2, float[] b, int ldb, float wr, float wi, float[] x, int ldx, floatW scale, floatW xnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALS0 applies back the multiplying factors of either the left or the
+ right singular vector matrix of a diagonal matrix appended by a row
+ to the right hand side matrix B in solving the least squares problem
+
+ using the divide-and-conquer SVD approach.
+
+ For the left singular vector matrix, three types of orthogonal
+ matrices are involved:
+
+ (1L) Givens rotations: the number of such rotations is GIVPTR; the
+ pairs of columns/rows they were applied to are stored in GIVCOL;
+ and the C- and S-values of these rotations are stored in GIVNUM.
+
+ (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
+
+ row, and for J=2:N, PERM(J)-th row of B is to be moved to the
+ J-th row.
+
+ (3L) The left singular vector matrix of the remaining matrix.
+
+ For the right singular vector matrix, four types of orthogonal
+ matrices are involved:
+
+ (1R) The right singular vector matrix of the remaining matrix.
+
+ (2R) If SQRE = 1, one extra Givens rotation to generate the right
+ null space.
+
+ (3R) The inverse transformation of (2L).
+
+ (4R) The inverse transformation of (1L).
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Left singular vector matrix.
+ = 1: Right singular vector matrix.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) REAL array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB must be at least
+ max(1,MAX( M, N ) ).
+
+ BX (workspace) REAL array, dimension ( LDBX, NRHS )
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ PERM (input) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) applied
+ to the two blocks.
+
+ GIVPTR (input) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of rows/columns
+ involved in a Givens rotation.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (input) REAL array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value used in the
+ corresponding Givens rotation.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of arrays DIFR, POLES and
+ GIVNUM, must be at least K.
+
+ POLES (input) REAL array, dimension ( LDGNUM, 2 )
+ On entry, POLES(1:K, 1) contains the new singular
+ values obtained from solving the secular equation, and
+ POLES(1:K, 2) is an array containing the poles in the secular
+
+ equation.
+
+ DIFL (input) REAL array, dimension ( K ).
+ On entry, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (input) REAL array, dimension ( LDGNUM, 2 ).
+ On entry, DIFR(I, 1) contains the distances between I-th
+ updated (undeflated) singular value and the I+1-th
+ (undeflated) old singular value. And DIFR(I, 2) is the
+ normalizing factor for the I-th right singular vector.
+
+ Z (input) REAL array, dimension ( K )
+ Contain the components of the deflation-adjusted updating row
+
+ vector.
+
+ K (input) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (input) REAL
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (input) REAL
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) REAL array, dimension ( K )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param nrhs
+ * @param b
+ * @param ldb
+ * @param bx
+ * @param ldbx
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param givnum
+ * @param ldgnum
+ * @param poles
+ * @param difl
+ * @param difr
+ * @param z
+ * @param k
+ * @param c
+ * @param s
+ * @param work
+ * @param info
+ */
+ public abstract void slals0(int icompq, int nl, int nr, int sqre, int nrhs, float[] b, int ldb, float[] bx, int ldbx, int[] perm, int givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, float[] poles, float[] difl, float[] difr, float[] z, int k, float c, float s, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALSA is an itermediate step in solving the least squares problem
+ by computing the SVD of the coefficient matrix in compact form (The
+ singular vectors are computed as products of simple orthorgonal
+ matrices.).
+
+ If ICOMPQ = 0, SLALSA applies the inverse of the left singular vector
+ matrix of an upper bidiagonal matrix to the right hand side; and if
+ ICOMPQ = 1, SLALSA applies the right singular vector matrix to the
+ right hand side. The singular vector matrices were generated in
+ compact form by SLALSA.
+
+ Arguments
+ =========
+
+
+ ICOMPQ (input) INTEGER
+ Specifies whether the left or the right singular vector
+ matrix is involved.
+ = 0: Left singular vector matrix
+ = 1: Right singular vector matrix
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row and column dimensions of the upper bidiagonal matrix.
+
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) REAL array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M.
+ On output, B contains the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,MAX( M, N ) ).
+
+ BX (output) REAL array, dimension ( LDBX, NRHS )
+ On exit, the result of applying the left or right singular
+ vector matrix to B.
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ U (input) REAL array, dimension ( LDU, SMLSIZ ).
+ On entry, U contains the left singular vector matrices of all
+
+ subproblems at the bottom level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR,
+ POLES, GIVNUM, and Z.
+
+ VT (input) REAL array, dimension ( LDU, SMLSIZ+1 ).
+ On entry, VT' contains the right singular vector matrices of
+ all subproblems at the bottom level.
+
+ K (input) INTEGER array, dimension ( N ).
+
+ DIFL (input) REAL array, dimension ( LDU, NLVL ).
+ where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
+
+ DIFR (input) REAL array, dimension ( LDU, 2 * NLVL ).
+ On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
+ distances between singular values on the I-th level and
+ singular values on the (I -1)-th level, and DIFR(*, 2 * I)
+ record the normalizing factors of the right singular vectors
+ matrices of subproblems on I-th level.
+
+ Z (input) REAL array, dimension ( LDU, NLVL ).
+ On entry, Z(1, I) contains the components of the deflation-
+ adjusted updating row vector for subproblems on the I-th
+ level.
+
+ POLES (input) REAL array, dimension ( LDU, 2 * NLVL ).
+ On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
+ singular values involved in the secular equations on the I-th
+
+ level.
+
+ GIVPTR (input) INTEGER array, dimension ( N ).
+ On entry, GIVPTR( I ) records the number of Givens
+ rotations performed on the I-th problem on the computation
+ tree.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
+ On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
+
+ locations of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (input) INTEGER array, dimension ( LDGCOL, NLVL ).
+ On entry, PERM(*, I) records permutations done on the I-th
+ level of the computation tree.
+
+ GIVNUM (input) REAL array, dimension ( LDU, 2 * NLVL ).
+ On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
+ values of Givens rotations performed on the I-th level on the
+
+ computation tree.
+
+ C (input) REAL array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (input) REAL array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ S( I ) contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) REAL array.
+ The dimension must be at least N.
+
+ IWORK (workspace) INTEGER array.
+ The dimension must be at least 3 * N
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param smlsiz
+ * @param n
+ * @param nrhs
+ * @param b
+ * @param ldb
+ * @param bx
+ * @param ldbx
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param k
+ * @param difl
+ * @param difr
+ * @param z
+ * @param poles
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param perm
+ * @param givnum
+ * @param c
+ * @param s
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slalsa(int icompq, int smlsiz, int n, int nrhs, float[] b, int ldb, float[] bx, int ldbx, float[] u, int ldu, float[] vt, int[] k, float[] difl, float[] difr, float[] z, float[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, float[] givnum, float[] c, float[] s, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLALSD uses the singular value decomposition of A to solve the least
+
+ squares problem of finding X to minimize the Euclidean norm of each
+ column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
+ are N-by-NRHS. The solution X overwrites B.
+
+ The singular values of A smaller than RCOND times the largest
+ singular value are treated as zero in solving the least squares
+ problem; in this case a minimum norm solution is returned.
+ The actual singular values are returned in D in ascending order.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': D and E define an upper bidiagonal matrix.
+ = 'L': D and E define a lower bidiagonal matrix.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The dimension of the bidiagonal matrix. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of columns of B. NRHS must be at least 1.
+
+ D (input/output) REAL array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit, if INFO = 0, D contains its singular values.
+
+
+ E (input/output) REAL array, dimension (N-1)
+ Contains the super-diagonal entries of the bidiagonal matrix.
+
+ On exit, E has been destroyed.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On input, B contains the right hand sides of the least
+ squares problem. On output, B contains the solution X.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,N).
+
+ RCOND (input) REAL
+ The singular values of A less than or equal to RCOND times
+ the largest singular value are treated as zero in solving
+ the least squares problem. If RCOND is negative,
+ machine precision is used instead.
+ For example, if diag(S)*X=B were the least squares problem,
+ where diag(S) is a diagonal matrix of singular values, the
+ solution would be X(i) = B(i) / S(i) if S(i) is greater than
+ RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
+ RCOND*max(S).
+
+ RANK (output) INTEGER
+ The number of singular values of A greater than RCOND times
+ the largest singular value.
+
+ WORK (workspace) REAL array, dimension at least
+ (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
+ where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
+
+ IWORK (workspace) INTEGER array, dimension at least
+ (3*N*NLVL + 11*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value while
+
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through MOD(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param smlsiz
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ * @param rcond
+ * @param rank
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slalsd(String uplo, int smlsiz, int n, int nrhs, float[] d, float[] e, float[] b, int ldb, float rcond, intW rank, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMRG will create a permutation list which will merge the elements
+ of A (which is composed of two independently sorted sets) into a
+ single set which is sorted in ascending order.
+
+ Arguments
+ =========
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ These arguements contain the respective lengths of the two
+ sorted lists to be merged.
+
+ A (input) REAL array, dimension (N1+N2)
+ The first N1 elements of A contain a list of numbers which
+ are sorted in either ascending or descending order. Likewise
+
+ for the final N2 elements.
+
+ STRD1 (input) INTEGER
+ STRD2 (input) INTEGER
+ These are the strides to be taken through the array A.
+ Allowable strides are 1 and -1. They indicate whether a
+ subset of A is sorted in ascending (STRDx = 1) or descending
+ (STRDx = -1) order.
+
+ INDEX (output) INTEGER array, dimension (N1+N2)
+ On exit this array will contain a permutation such that
+ if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
+ sorted in ascending order.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n1
+ * @param n2
+ * @param a
+ * @param strd1
+ * @param strd2
+ * @param index
+ */
+ public abstract void slamrg(int n1, int n2, float[] a, int strd1, int strd2, int[] index);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANEG computes the Sturm count, the number of negative pivots
+ encountered while factoring tridiagonal T - sigma I = L D L^T.
+ This implementation works directly on the factors without forming
+ the tridiagonal matrix T. The Sturm count is also the number of
+ eigenvalues of T less than sigma.
+
+ This routine is called from SLARRB.
+
+ The current routine does not use the PIVMIN parameter but rather
+ requires IEEE-754 propagation of Infinities and NaNs. This
+ routine also has no input range restrictions but does require
+ default exception handling such that x/0 produces Inf when x is
+ non-zero, and Inf/Inf produces NaN. For more information, see:
+
+ Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
+ Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
+ Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
+ (Tech report version in LAWN 172 with the same title.)
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) REAL array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ SIGMA (input) REAL
+ Shift amount in T - sigma I = L D L^T.
+
+ PIVMIN (input) REAL
+ The minimum pivot in the Sturm sequence. May be used
+ when zero pivots are encountered on non-IEEE-754
+ architectures.
+
+ R (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+ Jason Riedy, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param lld
+ * @param sigma
+ * @param pivmin
+ * @param r
+ */
+ public int slaneg(int n, float[] d, float[] lld, float sigma, float pivmin, int r) {
+ return org.netlib.lapack.Slaneg.slaneg(n, d, 0, lld, 0, sigma, pivmin, r);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANGB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
+
+ Description
+ ===========
+
+ SLANGB returns the value
+
+ SLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANGB as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANGB is
+ set to zero.
+
+ KL (input) INTEGER
+ The number of sub-diagonals of the matrix A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of super-diagonals of the matrix A. KU >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The band matrix A, stored in rows 1 to KL+KU+1. The j-th
+ column of A is stored in the j-th column of the array AB as
+ follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KL+KU+1.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param work
+ */
+ public float slangb(String norm, int n, int kl, int ku, float[] ab, int ldab, float[] work) {
+ return org.netlib.lapack.Slangb.slangb(norm, n, kl, ku, ab, 0, ldab, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANGE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real matrix A.
+
+ Description
+ ===========
+
+ SLANGE returns the value
+
+ SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANGE as described
+ above.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0. When M = 0,
+ SLANGE is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0. When N = 0,
+
+ SLANGE is set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The m by n matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public float slange(String norm, int m, int n, float[] a, int lda, float[] work) {
+ return org.netlib.lapack.Slange.slange(norm, m, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANGT returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real tridiagonal matrix A.
+
+ Description
+ ===========
+
+ SLANGT returns the value
+
+ SLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANGT as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANGT is
+ set to zero.
+
+ DL (input) REAL array, dimension (N-1)
+ The (n-1) sub-diagonal elements of A.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of A.
+
+ DU (input) REAL array, dimension (N-1)
+ The (n-1) super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param dl
+ * @param d
+ * @param du
+ */
+ public float slangt(String norm, int n, float[] dl, float[] d, float[] du) {
+ return org.netlib.lapack.Slangt.slangt(norm, n, dl, 0, d, 0, du, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANHS returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ Hessenberg matrix A.
+
+ Description
+ ===========
+
+ SLANHS returns the value
+
+ SLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANHS as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANHS is
+ set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The n by n upper Hessenberg matrix A; the part of A below the
+ first sub-diagonal is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public float slanhs(String norm, int n, float[] a, int lda, float[] work) {
+ return org.netlib.lapack.Slanhs.slanhs(norm, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANSB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n symmetric band matrix A, with k super-diagonals.
+
+ Description
+ ===========
+
+ SLANSB returns the value
+
+ SLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANSB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ band matrix A is supplied.
+ = 'U': Upper triangular part is supplied
+ = 'L': Lower triangular part is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANSB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals or sub-diagonals of the
+ band matrix A. K >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first K+1 rows of AB. The j-th column of A is
+
+ stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param n
+ * @param k
+ * @param ab
+ * @param ldab
+ * @param work
+ */
+ public float slansb(String norm, String uplo, int n, int k, float[] ab, int ldab, float[] work) {
+ return org.netlib.lapack.Slansb.slansb(norm, uplo, n, k, ab, 0, ldab, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANSP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ SLANSP returns the value
+
+ SLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANSP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is supplied.
+ = 'U': Upper triangular part of A is supplied
+ = 'L': Lower triangular part of A is supplied
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANSP is
+ set to zero.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param work
+ */
+ public float slansp(String norm, String uplo, int n, float[] ap, float[] work) {
+ return org.netlib.lapack.Slansp.slansp(norm, uplo, n, ap, 0, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANST returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric tridiagonal matrix A.
+
+ Description
+ ===========
+
+ SLANST returns the value
+
+ SLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANST as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANST is
+ set to zero.
+
+ D (input) REAL array, dimension (N)
+ The diagonal elements of A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) sub-diagonal or super-diagonal elements of A.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param n
+ * @param d
+ * @param e
+ */
+ public float slanst(String norm, int n, float[] d, float[] e) {
+ return org.netlib.lapack.Slanst.slanst(norm, n, d, 0, e, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANSY returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A.
+
+ Description
+ ===========
+
+ SLANSY returns the value
+
+ SLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANSY as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is to be referenced.
+ = 'U': Upper triangular part of A is referenced
+ = 'L': Lower triangular part of A is referenced
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANSY is
+ set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public float slansy(String norm, String uplo, int n, float[] a, int lda, float[] work) {
+ return org.netlib.lapack.Slansy.slansy(norm, uplo, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANTB returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of an
+ n by n triangular band matrix A, with ( k + 1 ) diagonals.
+
+ Description
+ ===========
+
+ SLANTB returns the value
+
+ SLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANTB as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANTB is
+ set to zero.
+
+ K (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals of the matrix A if UPLO = 'L'.
+ K >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first k+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
+ Note that when DIAG = 'U', the elements of the array AB
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= K+1.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param k
+ * @param ab
+ * @param ldab
+ * @param work
+ */
+ public float slantb(String norm, String uplo, String diag, int n, int k, float[] ab, int ldab, float[] work) {
+ return org.netlib.lapack.Slantb.slantb(norm, uplo, diag, n, k, ab, 0, ldab, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANTP returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ triangular matrix A, supplied in packed form.
+
+ Description
+ ===========
+
+ SLANTP returns the value
+
+ SLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANTP as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, SLANTP is
+ set to zero.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ Note that when DIAG = 'U', the elements of the array AP
+ corresponding to the diagonal elements of the matrix A are
+ not referenced, but are assumed to be one.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param ap
+ * @param work
+ */
+ public float slantp(String norm, String uplo, String diag, int n, float[] ap, float[] work) {
+ return org.netlib.lapack.Slantp.slantp(norm, uplo, diag, n, ap, 0, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANTR returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ trapezoidal or triangular matrix A.
+
+ Description
+ ===========
+
+ SLANTR returns the value
+
+ SLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a consistent matrix no
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in SLANTR as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower trapezoidal.
+ = 'U': Upper trapezoidal
+ = 'L': Lower trapezoidal
+ Note that A is triangular instead of trapezoidal if M = N.
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A has unit diagonal.
+ = 'N': Non-unit diagonal
+ = 'U': Unit diagonal
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0, and if
+ UPLO = 'U', M <= N. When M = 0, SLANTR is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0, and if
+ UPLO = 'L', N <= M. When N = 0, SLANTR is set to zero.
+
+ A (input) REAL array, dimension (LDA,N)
+ The trapezoidal matrix A (A is triangular if M = N).
+ If UPLO = 'U', the leading m by n upper trapezoidal part of
+ the array A contains the upper trapezoidal matrix, and the
+ strictly lower triangular part of A is not referenced.
+ If UPLO = 'L', the leading m by n lower trapezoidal part of
+ the array A contains the lower trapezoidal matrix, and the
+ strictly upper triangular part of A is not referenced. Note
+
+ that when DIAG = 'U', the diagonal elements of A are not
+ referenced and are assumed to be one.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param work
+ */
+ public float slantr(String norm, String uplo, String diag, int m, int n, float[] a, int lda, float[] work) {
+ return org.netlib.lapack.Slantr.slantr(norm, uplo, diag, m, n, a, 0, lda, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
+ matrix in standard form:
+
+ [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
+ [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
+
+ where either
+ 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
+ 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
+ conjugate eigenvalues.
+
+ Arguments
+ =========
+
+ A (input/output) REAL
+ B (input/output) REAL
+ C (input/output) REAL
+ D (input/output) REAL
+ On entry, the elements of the input matrix.
+ On exit, they are overwritten by the elements of the
+ standardised Schur form.
+
+ RT1R (output) REAL
+ RT1I (output) REAL
+ RT2R (output) REAL
+ RT2I (output) REAL
+ The real and imaginary parts of the eigenvalues. If the
+ eigenvalues are a complex conjugate pair, RT1I > 0.
+
+ CS (output) REAL
+ SN (output) REAL
+ Parameters of the rotation matrix.
+
+ Further Details
+ ===============
+
+ Modified by V. Sima, Research Institute for Informatics, Bucharest,
+ Romania, to reduce the risk of cancellation errors,
+ when computing real eigenvalues, and to ensure, if possible, that
+ abs(RT1R) >= abs(RT2R).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param a
+ * @param b
+ * @param c
+ * @param d
+ * @param rt1r
+ * @param rt1i
+ * @param rt2r
+ * @param rt2i
+ * @param cs
+ * @param sn
+ */
+ public abstract void slanv2(floatW a, floatW b, floatW c, floatW d, floatW rt1r, floatW rt1i, floatW rt2r, floatW rt2i, floatW cs, floatW sn);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given two column vectors X and Y, let
+
+ A = ( X Y ).
+
+ The subroutine first computes the QR factorization of A = Q*R,
+ and then computes the SVD of the 2-by-2 upper triangular matrix R.
+ The smaller singular value of R is returned in SSMIN, which is used
+ as the measurement of the linear dependency of the vectors X and Y.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of the vectors X and Y.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ On entry, X contains the N-vector X.
+ On exit, X is overwritten.
+
+ INCX (input) INTEGER
+ The increment between successive elements of X. INCX > 0.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCY)
+ On entry, Y contains the N-vector Y.
+ On exit, Y is overwritten.
+
+ INCY (input) INTEGER
+ The increment between successive elements of Y. INCY > 0.
+
+ SSMIN (output) REAL
+ The smallest singular value of the N-by-2 matrix A = ( X Y ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param ssmin
+ */
+ public abstract void slapll(int n, float[] x, int incx, float[] y, int incy, floatW ssmin);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAPMT rearranges the columns of the M by N matrix X as specified
+ by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+ If FORWRD = .TRUE., forward permutation:
+
+ X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+
+ If FORWRD = .FALSE., backward permutation:
+
+ X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+
+ Arguments
+ =========
+
+ FORWRD (input) LOGICAL
+ = .TRUE., forward permutation
+ = .FALSE., backward permutation
+
+ M (input) INTEGER
+ The number of rows of the matrix X. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix X. N >= 0.
+
+ X (input/output) REAL array, dimension (LDX,N)
+ On entry, the M by N matrix X.
+ On exit, X contains the permuted matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X, LDX >= MAX(1,M).
+
+ K (input/output) INTEGER array, dimension (N)
+ On entry, K contains the permutation vector. K is used as
+ internal workspace, but reset to its original value on
+ output.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param forwrd
+ * @param m
+ * @param n
+ * @param x
+ * @param ldx
+ * @param k
+ */
+ public abstract void slapmt(boolean forwrd, int m, int n, float[] x, int ldx, int[] k);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+
+ overflow.
+
+ Arguments
+ =========
+
+ X (input) REAL
+ Y (input) REAL
+ X and Y specify the values x and y.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param x
+ * @param y
+ */
+ public float slapy2(float x, float y) {
+ return org.netlib.lapack.Slapy2.slapy2(x, y);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+ unnecessary overflow.
+
+ Arguments
+ =========
+
+ X (input) REAL
+ Y (input) REAL
+ Z (input) REAL
+ X, Y and Z specify the values x, y and z.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param x
+ * @param y
+ * @param z
+ */
+ public float slapy3(float x, float y, float z) {
+ return org.netlib.lapack.Slapy3.slapy3(x, y, z);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQGB equilibrates a general M by N band matrix A with KL
+ subdiagonals and KU superdiagonals using the row and scaling factors
+
+ in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ KL (input) INTEGER
+ The number of subdiagonals within the band of A. KL >= 0.
+
+ KU (input) INTEGER
+ The number of superdiagonals within the band of A. KU >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
+ The j-th column of A is stored in the j-th column of the
+ array AB as follows:
+ AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
+
+ On exit, the equilibrated matrix, in the same storage format
+
+ as A. See EQUED for the form of the equilibrated matrix.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDA >= KL+KU+1.
+
+ R (input) REAL array, dimension (M)
+ The row scale factors for A.
+
+ C (input) REAL array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) REAL
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) REAL
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param kl
+ * @param ku
+ * @param ab
+ * @param ldab
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param equed
+ */
+ public abstract void slaqgb(int m, int n, int kl, int ku, float[] ab, int ldab, float[] r, float[] c, float rowcnd, float colcnd, float amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQGE equilibrates a general M by N matrix A using the row and
+ column scaling factors in the vectors R and C.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M by N matrix A.
+ On exit, the equilibrated matrix. See EQUED for the form of
+
+ the equilibrated matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ R (input) REAL array, dimension (M)
+ The row scale factors for A.
+
+ C (input) REAL array, dimension (N)
+ The column scale factors for A.
+
+ ROWCND (input) REAL
+ Ratio of the smallest R(i) to the largest R(i).
+
+ COLCND (input) REAL
+ Ratio of the smallest C(i) to the largest C(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration
+ = 'R': Row equilibration, i.e., A has been premultiplied by
+
+ diag(R).
+ = 'C': Column equilibration, i.e., A has been postmultiplied
+ by diag(C).
+ = 'B': Both row and column equilibration, i.e., A has been
+ replaced by diag(R) * A * diag(C).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if row or column scaling
+ should be done based on the ratio of the row or column scaling
+ factors. If ROWCND < THRESH, row scaling is done, and if
+ COLCND < THRESH, column scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if row scaling
+ should be done based on the absolute size of the largest matrix
+ element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param r
+ * @param c
+ * @param rowcnd
+ * @param colcnd
+ * @param amax
+ * @param equed
+ */
+ public abstract void slaqge(int m, int n, float[] a, int lda, float[] r, float[] c, float rowcnd, float colcnd, float amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQP2 computes a QR factorization with column pivoting of
+ the block A(OFFSET+1:M,1:N).
+ The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ OFFSET (input) INTEGER
+ The number of rows of the matrix A that must be pivoted
+ but no factorized. OFFSET >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
+ the triangular factor obtained; the elements in block
+ A(OFFSET+1:M,1:N) below the diagonal, together with the
+ array TAU, represent the orthogonal matrix Q as a product of
+
+ elementary reflectors. Block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+ to the front of A*P (a leading column); if JPVT(i) = 0,
+ the i-th column of A is a free column.
+ On exit, if JPVT(i) = k, then the i-th column of A*P
+ was the k-th column of A.
+
+ TAU (output) REAL array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) REAL array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) REAL array, dimension (N)
+ The vector with the exact column norms.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param offset
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param vn1
+ * @param vn2
+ * @param work
+ */
+ public abstract void slaqp2(int m, int n, int offset, float[] a, int lda, int[] jpvt, float[] tau, float[] vn1, float[] vn2, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQPS computes a step of QR factorization with column pivoting
+ of a real M-by-N matrix A by using Blas-3. It tries to factorize
+ NB columns from A starting from the row OFFSET+1, and updates all
+ of the matrix with Blas-3 xGEMM.
+
+ In some cases, due to catastrophic cancellations, it cannot
+ factorize NB columns. Hence, the actual number of factorized
+ columns is returned in KB.
+
+ Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0
+
+ OFFSET (input) INTEGER
+ The number of rows of A that have been factorized in
+ previous steps.
+
+ NB (input) INTEGER
+ The number of columns to factorize.
+
+ KB (output) INTEGER
+ The number of columns actually factorized.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, block A(OFFSET+1:M,1:KB) is the triangular
+ factor obtained and block A(1:OFFSET,1:N) has been
+ accordingly pivoted, but no factorized.
+ The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
+ been updated.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ JPVT (input/output) INTEGER array, dimension (N)
+ JPVT(I) = K <==> Column K of the full matrix A has been
+ permuted into position I in AP.
+
+ TAU (output) REAL array, dimension (KB)
+ The scalar factors of the elementary reflectors.
+
+ VN1 (input/output) REAL array, dimension (N)
+ The vector with the partial column norms.
+
+ VN2 (input/output) REAL array, dimension (N)
+ The vector with the exact column norms.
+
+ AUXV (input/output) REAL array, dimension (NB)
+ Auxiliar vector.
+
+ F (input/output) REAL array, dimension (LDF,NB)
+ Matrix F' = L*Y'*A.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1,N).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+ X. Sun, Computer Science Dept., Duke University, USA
+
+ Partial column norm updating strategy modified by
+ Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+ University of Zagreb, Croatia.
+ June 2006.
+ For more details see LAPACK Working Note 176.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param offset
+ * @param nb
+ * @param kb
+ * @param a
+ * @param lda
+ * @param jpvt
+ * @param tau
+ * @param vn1
+ * @param vn2
+ * @param auxv
+ * @param f
+ * @param ldf
+ */
+ public abstract void slaqps(int m, int n, int offset, int nb, intW kb, float[] a, int lda, int[] jpvt, float[] tau, float[] vn1, float[] vn2, float[] auxv, float[] f, int ldf);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQR0 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to SGEBAL, and then passed to SGEHRD when the
+
+ matrix output by SGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) REAL array, dimension (IHI)
+ WI (output) REAL array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) REAL array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then SLAQR0 does a workspace query.
+ In this case, SLAQR0 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, SLAQR0 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . SLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public void slaqr0(boolean wantt, boolean wantz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, int iloz, int ihiz, float[] z, int ldz, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Slaqr0.slaqr0(wantt, wantz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, iloz, ihiz, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Given a 2-by-2 or 3-by-3 matrix H, SLAQR1 sets v to a
+ scalar multiple of the first column of the product
+
+ (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
+
+ scaling to avoid overflows and most underflows. It
+ is assumed that either
+
+ 1) sr1 = sr2 and si1 = -si2
+ or
+ 2) si1 = si2 = 0.
+
+ This is useful for starting double implicit shift bulges
+ in the QR algorithm.
+
+
+ N (input) integer
+ Order of the matrix H. N must be either 2 or 3.
+
+ H (input) REAL array of dimension (LDH,N)
+ The 2-by-2 or 3-by-3 matrix H in (*).
+
+ LDH (input) integer
+ The leading dimension of H as declared in
+ the calling procedure. LDH.GE.N
+
+ SR1 (input) REAL
+ SI1 The shifts in (*).
+ SR2
+ SI2
+
+ V (output) REAL array of dimension N
+ A scalar multiple of the first column of the
+ matrix K in (*).
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param h
+ * @param ldh
+ * @param sr1
+ * @param si1
+ * @param sr2
+ * @param si2
+ * @param v
+ */
+ public void slaqr1(int n, float[] h, int ldh, float sr1, float si1, float sr2, float si2, float[] v) {
+ org.netlib.lapack.Slaqr1.slaqr1(n, h, 0, ldh, sr1, si1, sr2, si2, v, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ This subroutine is identical to SLAQR3 except that it avoids
+ recursion by calling SLAHQR instead of SLAQR4.
+
+
+ ******************************************************************
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+ ******************************************************************
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) REAL array, dimension KBOT
+ SI (output) REAL array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) REAL array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) REAL array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) REAL array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) REAL array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; SLAQR2
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ==================================================================
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ktop
+ * @param kbot
+ * @param nw
+ * @param h
+ * @param ldh
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param ns
+ * @param nd
+ * @param sr
+ * @param si
+ * @param v
+ * @param ldv
+ * @param nh
+ * @param t
+ * @param ldt
+ * @param nv
+ * @param wv
+ * @param ldwv
+ * @param work
+ * @param lwork
+ */
+ public void slaqr2(boolean wantt, boolean wantz, int n, int ktop, int kbot, int nw, float[] h, int ldh, int iloz, int ihiz, float[] z, int ldz, intW ns, intW nd, float[] sr, float[] si, float[] v, int ldv, int nh, float[] t, int ldt, int nv, float[] wv, int ldwv, float[] work, int lwork) {
+ org.netlib.lapack.Slaqr2.slaqr2(wantt, wantz, n, ktop, kbot, nw, h, 0, ldh, iloz, ihiz, z, 0, ldz, ns, nd, sr, 0, si, 0, v, 0, ldv, nh, t, 0, ldt, nv, wv, 0, ldwv, work, 0, lwork);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ ******************************************************************
+ Aggressive early deflation:
+
+ This subroutine accepts as input an upper Hessenberg matrix
+ H and performs an orthogonal similarity transformation
+ designed to detect and deflate fully converged eigenvalues from
+ a trailing principal submatrix. On output H has been over-
+ written by a new Hessenberg matrix that is a perturbation of
+ an orthogonal similarity transformation of H. It is to be
+ hoped that the final version of H has many zero subdiagonal
+ entries.
+
+ ******************************************************************
+ WANTT (input) LOGICAL
+ If .TRUE., then the Hessenberg matrix H is fully updated
+ so that the quasi-triangular Schur factor may be
+ computed (in cooperation with the calling subroutine).
+ If .FALSE., then only enough of H is updated to preserve
+ the eigenvalues.
+
+ WANTZ (input) LOGICAL
+ If .TRUE., then the orthogonal matrix Z is updated so
+ so that the orthogonal Schur factor may be computed
+ (in cooperation with the calling subroutine).
+ If .FALSE., then Z is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix H and (if WANTZ is .TRUE.) the
+ order of the orthogonal matrix Z.
+
+ KTOP (input) INTEGER
+ It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
+ KBOT and KTOP together determine an isolated block
+ along the diagonal of the Hessenberg matrix.
+
+ KBOT (input) INTEGER
+ It is assumed without a check that either
+ KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
+ determine an isolated block along the diagonal of the
+ Hessenberg matrix.
+
+ NW (input) INTEGER
+ Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On input the initial N-by-N section of H stores the
+ Hessenberg matrix undergoing aggressive early deflation.
+ On output H has been transformed by an orthogonal
+ similarity transformation, perturbed, and the returned
+ to Hessenberg form that (it is to be hoped) has some
+ zero subdiagonal entries.
+
+ LDH (input) integer
+ Leading dimension of H just as declared in the calling
+ subroutine. N .LE. LDH
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ IF WANTZ is .TRUE., then on output, the orthogonal
+ similarity transformation mentioned above has been
+ accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ is .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer
+ The leading dimension of Z just as declared in the
+ calling subroutine. 1 .LE. LDZ.
+
+ NS (output) integer
+ The number of unconverged (ie approximate) eigenvalues
+ returned in SR and SI that may be used as shifts by the
+ calling subroutine.
+
+ ND (output) integer
+ The number of converged eigenvalues uncovered by this
+ subroutine.
+
+ SR (output) REAL array, dimension KBOT
+ SI (output) REAL array, dimension KBOT
+ On output, the real and imaginary parts of approximate
+ eigenvalues that may be used for shifts are stored in
+ SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
+ SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
+ The real and imaginary parts of converged eigenvalues
+ are stored in SR(KBOT-ND+1) through SR(KBOT) and
+ SI(KBOT-ND+1) through SI(KBOT), respectively.
+
+ V (workspace) REAL array, dimension (LDV,NW)
+ An NW-by-NW work array.
+
+ LDV (input) integer scalar
+ The leading dimension of V just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ NH (input) integer scalar
+ The number of columns of T. NH.GE.NW.
+
+ T (workspace) REAL array, dimension (LDT,NW)
+
+ LDT (input) integer
+ The leading dimension of T just as declared in the
+ calling subroutine. NW .LE. LDT
+
+ NV (input) integer
+ The number of rows of work array WV available for
+ workspace. NV.GE.NW.
+
+ WV (workspace) REAL array, dimension (LDWV,NW)
+
+ LDWV (input) integer
+ The leading dimension of W just as declared in the
+ calling subroutine. NW .LE. LDV
+
+ WORK (workspace) REAL array, dimension LWORK.
+ On exit, WORK(1) is set to an estimate of the optimal value
+ of LWORK for the given values of N, NW, KTOP and KBOT.
+
+ LWORK (input) integer
+ The dimension of the work array WORK. LWORK = 2*NW
+ suffices, but greater efficiency may result from larger
+ values of LWORK.
+
+ If LWORK = -1, then a workspace query is assumed; SLAQR3
+ only estimates the optimal workspace size for the given
+ values of N, NW, KTOP and KBOT. The estimate is returned
+ in WORK(1). No error message related to LWORK is issued
+ by XERBLA. Neither H nor Z are accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ==================================================================
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ktop
+ * @param kbot
+ * @param nw
+ * @param h
+ * @param ldh
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param ns
+ * @param nd
+ * @param sr
+ * @param si
+ * @param v
+ * @param ldv
+ * @param nh
+ * @param t
+ * @param ldt
+ * @param nv
+ * @param wv
+ * @param ldwv
+ * @param work
+ * @param lwork
+ */
+ public void slaqr3(boolean wantt, boolean wantz, int n, int ktop, int kbot, int nw, float[] h, int ldh, int iloz, int ihiz, float[] z, int ldz, intW ns, intW nd, float[] sr, float[] si, float[] v, int ldv, int nh, float[] t, int ldt, int nv, float[] wv, int ldwv, float[] work, int lwork) {
+ org.netlib.lapack.Slaqr3.slaqr3(wantt, wantz, n, ktop, kbot, nw, h, 0, ldh, iloz, ihiz, z, 0, ldz, ns, nd, sr, 0, si, 0, v, 0, ldv, nh, t, 0, ldt, nv, wv, 0, ldwv, work, 0, lwork);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ This subroutine implements one level of recursion for SLAQR0.
+ It is a complete implementation of the small bulge multi-shift
+ QR algorithm. It may be called by SLAQR0 and, for large enough
+ deflation window size, it may be called by SLAQR3. This
+ subroutine is identical to SLAQR0 except that it calls SLAQR2
+ instead of SLAQR3.
+
+ Purpose
+ =======
+
+ SLAQR4 computes the eigenvalues of a Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the
+ Schur form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal
+ matrix Q so that this routine can give the Schur factorization
+ of a matrix A which has been reduced to the Hessenberg form H
+ by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N .GE. 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
+ H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
+ previous call to SGEBAL, and then passed to SGEHRD when the
+
+ matrix output by SGEBAL is reduced to Hessenberg form.
+ Otherwise, ILO and IHI should be set to 1 and N,
+ respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
+ If N = 0, then ILO = 1 and IHI = 0.
+
+ H (input/output) REAL array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if INFO = 0 and WANTT is .TRUE., then H contains
+ the upper quasi-triangular matrix T from the Schur
+ decomposition (the Schur form); 2-by-2 diagonal blocks
+ (corresponding to complex conjugate pairs of eigenvalues)
+ are returned in standard form, with H(i,i) = H(i+1,i+1)
+ and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
+ .FALSE., then the contents of H are unspecified on exit.
+ (The output value of H when INFO.GT.0 is given under the
+ description of INFO below.)
+
+ This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
+ j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH .GE. max(1,N).
+
+ WR (output) REAL array, dimension (IHI)
+ WI (output) REAL array, dimension (IHI)
+ The real and imaginary parts, respectively, of the computed
+
+ eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
+ and WI(ILO:IHI). If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
+ the eigenvalues are stored in the same order as on the
+ diagonal of the Schur form returned in H, with
+ WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
+ block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
+
+ Z (input/output) REAL array, dimension (LDZ,IHI)
+ If WANTZ is .FALSE., then Z is not referenced.
+ If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
+ replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
+ orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
+ (The output value of Z when INFO.GT.0 is given under
+ the description of INFO below.)
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. if WANTZ is .TRUE.
+ then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
+
+ WORK (workspace/output) REAL array, dimension LWORK
+ On exit, if LWORK = -1, WORK(1) returns an estimate of
+ the optimal value for LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK .GE. max(1,N)
+ is sufficient, but LWORK typically as large as 6*N may
+ be required for optimal performance. A workspace query
+ to determine the optimal workspace size is recommended.
+
+ If LWORK = -1, then SLAQR4 does a workspace query.
+ In this case, SLAQR4 checks the input parameters and
+ estimates the optimal workspace size for the given
+ values of N, ILO and IHI. The estimate is returned
+ in WORK(1). No error message related to LWORK is
+ issued by XERBLA. Neither H nor Z are accessed.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ .GT. 0: if INFO = i, SLAQR4 failed to compute all of
+ the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
+ and WI contain those eigenvalues which have been
+ successfully computed. (Failures are rare.)
+
+ If INFO .GT. 0 and WANT is .FALSE., then on exit,
+ the remaining unconverged eigenvalues are the eigen-
+ values of the upper Hessenberg matrix rows and
+ columns ILO through INFO of the final, output
+ value of H.
+
+ If INFO .GT. 0 and WANTT is .TRUE., then on exit
+
+ (*) (initial value of H)*U = U*(final value of H)
+
+ where U is an orthogonal matrix. The final
+ value of H is upper Hessenberg and quasi-triangular
+ in rows and columns INFO+1 through IHI.
+
+ If INFO .GT. 0 and WANTZ is .TRUE., then on exit
+
+ (final value of Z(ILO:IHI,ILOZ:IHIZ)
+ = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
+
+ where U is the orthogonal matrix in (*) (regard-
+ less of the value of WANTT.)
+
+ If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
+ accessed.
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ================================================================
+ References:
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
+ Performance, SIAM Journal of Matrix Analysis, volume 23, pages
+ 929--947, 2002.
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part II: Aggressive Early Deflation, SIAM Journal
+ of Matrix Analysis, volume 23, pages 948--973, 2002.
+
+ ================================================================
+ .. Parameters ..
+
+ ==== Matrices of order NTINY or smaller must be processed by
+ . SLAHQR because of insufficient subdiagonal scratch space.
+ . (This is a hard limit.) ====
+
+ ==== Exceptional deflation windows: try to cure rare
+ . slow convergence by increasing the size of the
+ . deflation window after KEXNW iterations. =====
+
+ ==== Exceptional shifts: try to cure rare slow convergence
+ . with ad-hoc exceptional shifts every KEXSH iterations.
+ . The constants WILK1 and WILK2 are used to form the
+ . exceptional shifts. ====
+
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param h
+ * @param ldh
+ * @param wr
+ * @param wi
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public void slaqr4(boolean wantt, boolean wantz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, int iloz, int ihiz, float[] z, int ldz, float[] work, int lwork, intW info) {
+ org.netlib.lapack.Slaqr4.slaqr4(wantt, wantz, n, ilo, ihi, h, 0, ldh, wr, 0, wi, 0, iloz, ihiz, z, 0, ldz, work, 0, lwork, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ This auxiliary subroutine called by SLAQR0 performs a
+ single small-bulge multi-shift QR sweep.
+
+ WANTT (input) logical scalar
+ WANTT = .true. if the quasi-triangular Schur factor
+ is being computed. WANTT is set to .false. otherwise.
+
+ WANTZ (input) logical scalar
+ WANTZ = .true. if the orthogonal Schur factor is being
+ computed. WANTZ is set to .false. otherwise.
+
+ KACC22 (input) integer with value 0, 1, or 2.
+ Specifies the computation mode of far-from-diagonal
+ orthogonal updates.
+ = 0: SLAQR5 does not accumulate reflections and does not
+ use matrix-matrix multiply to update far-from-diagonal
+ matrix entries.
+ = 1: SLAQR5 accumulates reflections and uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries.
+ = 2: SLAQR5 accumulates reflections, uses matrix-matrix
+ multiply to update the far-from-diagonal matrix entries,
+ and takes advantage of 2-by-2 block structure during
+ matrix multiplies.
+
+ N (input) integer scalar
+ N is the order of the Hessenberg matrix H upon which this
+
+ subroutine operates.
+
+ KTOP (input) integer scalar
+ KBOT (input) integer scalar
+ These are the first and last rows and columns of an
+ isolated diagonal block upon which the QR sweep is to be
+ applied. It is assumed without a check that
+ either KTOP = 1 or H(KTOP,KTOP-1) = 0
+ and
+ either KBOT = N or H(KBOT+1,KBOT) = 0.
+
+ NSHFTS (input) integer scalar
+ NSHFTS gives the number of simultaneous shifts. NSHFTS
+ must be positive and even.
+
+ SR (input) REAL array of size (NSHFTS)
+ SI (input) REAL array of size (NSHFTS)
+ SR contains the real parts and SI contains the imaginary
+ parts of the NSHFTS shifts of origin that define the
+ multi-shift QR sweep.
+
+ H (input/output) REAL array of size (LDH,N)
+ On input H contains a Hessenberg matrix. On output a
+ multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
+
+ to the isolated diagonal block in rows and columns KTOP
+ through KBOT.
+
+ LDH (input) integer scalar
+ LDH is the leading dimension of H just as declared in the
+
+ calling procedure. LDH.GE.MAX(1,N).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
+
+ Z (input/output) REAL array of size (LDZ,IHI)
+ If WANTZ = .TRUE., then the QR Sweep orthogonal
+ similarity transformation is accumulated into
+ Z(ILOZ:IHIZ,ILO:IHI) from the right.
+ If WANTZ = .FALSE., then Z is unreferenced.
+
+ LDZ (input) integer scalar
+ LDA is the leading dimension of Z just as declared in
+ the calling procedure. LDZ.GE.N.
+
+ V (workspace) REAL array of size (LDV,NSHFTS/2)
+
+ LDV (input) integer scalar
+ LDV is the leading dimension of V as declared in the
+ calling procedure. LDV.GE.3.
+
+ U (workspace) REAL array of size
+ (LDU,3*NSHFTS-3)
+
+ LDU (input) integer scalar
+ LDU is the leading dimension of U just as declared in the
+
+ in the calling subroutine. LDU.GE.3*NSHFTS-3.
+
+ NH (input) integer scalar
+ NH is the number of columns in array WH available for
+ workspace. NH.GE.1.
+
+ WH (workspace) REAL array of size (LDWH,NH)
+
+ LDWH (input) integer scalar
+ Leading dimension of WH just as declared in the
+ calling procedure. LDWH.GE.3*NSHFTS-3.
+
+ NV (input) integer scalar
+ NV is the number of rows in WV agailable for workspace.
+ NV.GE.1.
+
+ WV (workspace) REAL array of size
+ (LDWV,3*NSHFTS-3)
+
+ LDWV (input) integer scalar
+ LDWV is the leading dimension of WV as declared in the
+ in the calling subroutine. LDWV.GE.NV.
+
+
+ ================================================================
+ Based on contributions by
+ Karen Braman and Ralph Byers, Department of Mathematics,
+ University of Kansas, USA
+
+ ============================================================
+ Reference:
+
+ K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
+ Algorithm Part I: Maintaining Well Focused Shifts, and
+ Level 3 Performance, SIAM Journal of Matrix Analysis,
+ volume 23, pages 929--947, 2002.
+
+ ============================================================
+ .. Parameters ..
+</pre>
+ * @param wantt
+ * @param wantz
+ * @param kacc22
+ * @param n
+ * @param ktop
+ * @param kbot
+ * @param nshfts
+ * @param sr
+ * @param si
+ * @param h
+ * @param ldh
+ * @param iloz
+ * @param ihiz
+ * @param z
+ * @param ldz
+ * @param v
+ * @param ldv
+ * @param u
+ * @param ldu
+ * @param nv
+ * @param wv
+ * @param ldwv
+ * @param nh
+ * @param wh
+ * @param ldwh
+ */
+ public void slaqr5(boolean wantt, boolean wantz, int kacc22, int n, int ktop, int kbot, int nshfts, float[] sr, float[] si, float[] h, int ldh, int iloz, int ihiz, float[] z, int ldz, float[] v, int ldv, float[] u, int ldu, int nv, float[] wv, int ldwv, int nh, float[] wh, int ldwh) {
+ org.netlib.lapack.Slaqr5.slaqr5(wantt, wantz, kacc22, n, ktop, kbot, nshfts, sr, 0, si, 0, h, 0, ldh, iloz, ihiz, z, 0, ldz, v, 0, ldv, u, 0, ldu, nv, wv, 0, ldwv, nh, wh, 0, ldwh);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQSB equilibrates a symmetric band matrix A using the scaling
+ factors in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ S (input) REAL array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) REAL
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param s
+ * @param scond
+ * @param amax
+ * @param equed
+ */
+ public abstract void slaqsb(String uplo, int n, int kd, float[] ab, int ldab, float[] s, float scond, float amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQSP equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the equilibrated matrix: diag(S) * A * diag(S), in
+
+ the same storage format as A.
+
+ S (input) REAL array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) REAL
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param s
+ * @param scond
+ * @param amax
+ * @param equed
+ */
+ public abstract void slaqsp(String uplo, int n, float[] ap, float[] s, float scond, float amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQSY equilibrates a symmetric matrix A using the scaling factors
+ in the vector S.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if EQUED = 'Y', the equilibrated matrix:
+ diag(S) * A * diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ S (input) REAL array, dimension (N)
+ The scale factors for A.
+
+ SCOND (input) REAL
+ Ratio of the smallest S(i) to the largest S(i).
+
+ AMAX (input) REAL
+ Absolute value of largest matrix entry.
+
+ EQUED (output) CHARACTER*1
+ Specifies whether or not equilibration was done.
+ = 'N': No equilibration.
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+
+ Internal Parameters
+ ===================
+
+ THRESH is a threshold value used to decide if scaling should be done
+
+ based on the ratio of the scaling factors. If SCOND < THRESH,
+ scaling is done.
+
+ LARGE and SMALL are threshold values used to decide if scaling should
+ be done based on the absolute size of the largest matrix element.
+ If AMAX > LARGE or AMAX < SMALL, scaling is done.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param scond
+ * @param amax
+ * @param equed
+ */
+ public abstract void slaqsy(String uplo, int n, float[] a, int lda, float[] s, float scond, float amax, StringW equed);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAQTR solves the real quasi-triangular system
+
+ op(T)*p = scale*c, if LREAL = .TRUE.
+
+ or the complex quasi-triangular systems
+
+ op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
+
+ in real arithmetic, where T is upper quasi-triangular.
+ If LREAL = .FALSE., then the first diagonal block of T must be
+ 1 by 1, B is the specially structured matrix
+
+ B = [ b(1) b(2) ... b(n) ]
+ [ w ]
+ [ w ]
+ [ . ]
+ [ w ]
+
+ op(A) = A or A', A' denotes the conjugate transpose of
+ matrix A.
+
+ On input, X = [ c ]. On output, X = [ p ].
+ [ d ] [ q ]
+
+ This subroutine is designed for the condition number estimation
+ in routine STRSNA.
+
+ Arguments
+ =========
+
+ LTRAN (input) LOGICAL
+ On entry, LTRAN specifies the option of conjugate transpose:
+
+ = .FALSE., op(T+i*B) = T+i*B,
+ = .TRUE., op(T+i*B) = (T+i*B)'.
+
+ LREAL (input) LOGICAL
+ On entry, LREAL specifies the input matrix structure:
+ = .FALSE., the input is complex
+ = .TRUE., the input is real
+
+ N (input) INTEGER
+ On entry, N specifies the order of T+i*B. N >= 0.
+
+ T (input) REAL array, dimension (LDT,N)
+ On entry, T contains a matrix in Schur canonical form.
+ If LREAL = .FALSE., then the first diagonal block of T must
+ be 1 by 1.
+
+ LDT (input) INTEGER
+ The leading dimension of the matrix T. LDT >= max(1,N).
+
+ B (input) REAL array, dimension (N)
+ On entry, B contains the elements to form the matrix
+ B as described above.
+ If LREAL = .TRUE., B is not referenced.
+
+ W (input) REAL
+ On entry, W is the diagonal element of the matrix B.
+ If LREAL = .TRUE., W is not referenced.
+
+ SCALE (output) REAL
+ On exit, SCALE is the scale factor.
+
+ X (input/output) REAL array, dimension (2*N)
+ On entry, X contains the right hand side of the system.
+ On exit, X is overwritten by the solution.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: the some diagonal 1 by 1 block has been perturbed by
+
+ a small number SMIN to keep nonsingularity.
+ 2: the some diagonal 2 by 2 block has been perturbed by
+
+ a small number in SLALN2 to keep nonsingularity.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param ltran
+ * @param lreal
+ * @param n
+ * @param t
+ * @param ldt
+ * @param b
+ * @param w
+ * @param scale
+ * @param x
+ * @param work
+ * @param info
+ */
+ public abstract void slaqtr(boolean ltran, boolean lreal, int n, float[] t, int ldt, float[] b, float w, floatW scale, float[] x, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAR1V computes the (scaled) r-th column of the inverse of
+ the sumbmatrix in rows B1 through BN of the tridiagonal matrix
+ L D L^T - sigma I. When sigma is close to an eigenvalue, the
+ computed vector is an accurate eigenvector. Usually, r corresponds
+ to the index where the eigenvector is largest in magnitude.
+ The following steps accomplish this computation :
+ (a) Stationary qd transform, L D L^T - sigma I = L(+) D(+) L(+)^T,
+ (b) Progressive qd transform, L D L^T - sigma I = U(-) D(-) U(-)^T,
+ (c) Computation of the diagonal elements of the inverse of
+ L D L^T - sigma I by combining the above transforms, and choosing
+ r as the index where the diagonal of the inverse is (one of the)
+
+ largest in magnitude.
+ (d) Computation of the (scaled) r-th column of the inverse using the
+
+ twisted factorization obtained by combining the top part of the
+ the stationary and the bottom part of the progressive transform.
+
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix L D L^T.
+
+ B1 (input) INTEGER
+ First index of the submatrix of L D L^T.
+
+ BN (input) INTEGER
+ Last index of the submatrix of L D L^T.
+
+ LAMBDA (input) REAL
+ The shift. In order to compute an accurate eigenvector,
+ LAMBDA should be a good approximation to an eigenvalue
+ of L D L^T.
+
+ L (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal matrix
+ L, in elements 1 to N-1.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D.
+
+ LD (input) REAL array, dimension (N-1)
+ The n-1 elements L(i)*D(i).
+
+ LLD (input) REAL array, dimension (N-1)
+ The n-1 elements L(i)*L(i)*D(i).
+
+ PIVMIN (input) REAL
+ The minimum pivot in the Sturm sequence.
+
+ GAPTOL (input) REAL
+ Tolerance that indicates when eigenvector entries are neglig
+ w.r.t. their contribution to the residual.
+
+ Z (input/output) REAL array, dimension (N)
+ On input, all entries of Z must be set to 0.
+ On output, Z contains the (scaled) r-th column of the
+ inverse. The scaling is such that Z(R) equals 1.
+
+ WANTNC (input) LOGICAL
+ Specifies whether NEGCNT has to be computed.
+
+ NEGCNT (output) INTEGER
+ If WANTNC is .TRUE. then NEGCNT = the number of pivots < piv
+ in the matrix factorization L D L^T, and NEGCNT = -1 otherw
+
+ ZTZ (output) REAL
+ The square of the 2-norm of Z.
+
+ MINGMA (output) REAL
+ The reciprocal of the largest (in magnitude) diagonal
+ element of the inverse of L D L^T - sigma I.
+
+ R (input/output) INTEGER
+ The twist index for the twisted factorization used to
+ compute Z.
+ On input, 0 <= R <= N. If R is input as 0, R is set to
+ the index where (L D L^T - sigma I)^{-1} is largest
+ in magnitude. If 1 <= R <= N, R is unchanged.
+ On output, R contains the twist index used to compute Z.
+ Ideally, R designates the position of the maximum entry in t
+ eigenvector.
+
+ ISUPPZ (output) INTEGER array, dimension (2)
+ The support of the vector in Z, i.e., the vector Z is
+ nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
+
+ NRMINV (output) REAL
+ NRMINV = 1/SQRT( ZTZ )
+
+ RESID (output) REAL
+ The residual of the FP vector.
+ RESID = ABS( MINGMA )/SQRT( ZTZ )
+
+ RQCORR (output) REAL
+ The Rayleigh Quotient correction to LAMBDA.
+ RQCORR = MINGMA*TMP
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param b1
+ * @param bn
+ * @param lambda
+ * @param d
+ * @param l
+ * @param ld
+ * @param lld
+ * @param pivmin
+ * @param gaptol
+ * @param z
+ * @param wantnc
+ * @param negcnt
+ * @param ztz
+ * @param mingma
+ * @param r
+ * @param isuppz
+ * @param nrminv
+ * @param resid
+ * @param rqcorr
+ * @param work
+ */
+ public void slar1v(int n, int b1, int bn, float lambda, float[] d, float[] l, float[] ld, float[] lld, float pivmin, float gaptol, float[] z, boolean wantnc, intW negcnt, floatW ztz, floatW mingma, intW r, int[] isuppz, floatW nrminv, floatW resid, floatW rqcorr, float[] work) {
+ org.netlib.lapack.Slar1v.slar1v(n, b1, bn, lambda, d, 0, l, 0, ld, 0, lld, 0, pivmin, gaptol, z, 0, wantnc, negcnt, ztz, mingma, r, isuppz, 0, nrminv, resid, rqcorr, work, 0);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAR2V applies a vector of real plane rotations from both sides to
+ a sequence of 2-by-2 real symmetric matrices, defined by the elements
+ of the vectors x, y and z. For i = 1,2,...,n
+
+ ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) )
+ ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector y.
+
+ Z (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector z.
+
+ INCX (input) INTEGER
+ The increment between elements of X, Y and Z. INCX > 0.
+
+ C (input) REAL array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) REAL array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param x
+ * @param y
+ * @param z
+ * @param incx
+ * @param c
+ * @param s
+ * @param incc
+ */
+ public abstract void slar2v(int n, float[] x, float[] y, float[] z, int incx, float[] c, float[] s, int incc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARF applies a real elementary reflector H to a real m by n matrix
+ C, from either the left or the right. H is represented in the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) REAL array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of H. V is not used if
+ TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) REAL
+ The value tau in the representation of H.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param v
+ * @param incv
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ */
+ public abstract void slarf(String side, int m, int n, float[] v, int incv, float tau, float[] c, int Ldc, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARFB applies a real block reflector H or its transpose H' to a
+ real m by n matrix C, from either the left or the right.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'T': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ V (input) REAL array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,M) if STOREV = 'R' and SIDE = 'L'
+
+ (LDV,N) if STOREV = 'R' and SIDE = 'R'
+
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+ if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+ if STOREV = 'R', LDV >= K.
+
+ T (input) REAL array, dimension (LDT,K)
+ The triangular k by k matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= max(1,M).
+
+ WORK (workspace) REAL array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param direct
+ * @param storev
+ * @param m
+ * @param n
+ * @param k
+ * @param v
+ * @param ldv
+ * @param t
+ * @param ldt
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param ldwork
+ */
+ public abstract void slarfb(String side, String trans, String direct, String storev, int m, int n, int k, float[] v, int ldv, float[] t, int ldt, float[] c, int Ldc, float[] work, int ldwork);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARFG generates a real elementary reflector H of order n, such
+ that
+
+ H * ( alpha ) = ( beta ), H' * H = I.
+ ( x ) ( 0 )
+
+ where alpha and beta are scalars, and x is an (n-1)-element real
+ vector. H is represented in the form
+
+ H = I - tau * ( 1 ) * ( 1 v' ) ,
+ ( v )
+
+ where tau is a real scalar and v is a real (n-1)-element
+ vector.
+
+ If the elements of x are all zero, then tau = 0 and H is taken to be
+
+ the unit matrix.
+
+ Otherwise 1 <= tau <= 2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the elementary reflector.
+
+ ALPHA (input/output) REAL
+ On entry, the value alpha.
+ On exit, it is overwritten with the value beta.
+
+ X (input/output) REAL array, dimension
+ (1+(N-2)*abs(INCX))
+ On entry, the vector x.
+ On exit, it is overwritten with the vector v.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ TAU (output) REAL
+ The value tau.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param alpha
+ * @param x
+ * @param incx
+ * @param tau
+ */
+ public abstract void slarfg(int n, floatW alpha, float[] x, int incx, floatW tau);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ 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'
+
+ 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 * V
+
+ Arguments
+ =========
+
+ DIRECT (input) 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)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) REAL array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ 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 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param direct
+ * @param storev
+ * @param n
+ * @param k
+ * @param v
+ * @param ldv
+ * @param tau
+ * @param t
+ * @param ldt
+ */
+ public abstract void slarft(String direct, String storev, int n, int k, float[] v, int ldv, float[] tau, float[] t, int ldt);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARFX applies a real elementary reflector H to a real m by n
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix
+
+ This version uses inline code if H has order < 11.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) REAL array, dimension (M) if SIDE = 'L'
+ or (N) if SIDE = 'R'
+ The vector v in the representation of H.
+
+ TAU (input) REAL
+ The value tau in the representation of H.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= (1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+ WORK is not referenced if H has order < 11.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param v
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ */
+ public abstract void slarfx(String side, int m, int n, float[] v, float tau, float[] c, int Ldc, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARGV generates a vector of real plane rotations, determined by
+ elements of the real vectors x and y. For i = 1,2,...,n
+
+ ( c(i) s(i) ) ( x(i) ) = ( a(i) )
+ ( -s(i) c(i) ) ( y(i) ) = ( 0 )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be generated.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ On entry, the vector x.
+ On exit, x(i) is overwritten by a(i), for i = 1,...,n.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCY)
+ On entry, the vector y.
+ On exit, the sines of the plane rotations.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (output) REAL array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C. INCC > 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param c
+ * @param incc
+ */
+ public abstract void slargv(int n, float[] x, int incx, float[] y, int incy, float[] c, int incc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARNV returns a vector of n random real numbers from a uniform or
+ normal distribution.
+
+ Arguments
+ =========
+
+ IDIST (input) INTEGER
+ Specifies the distribution of the random numbers:
+ = 1: uniform (0,1)
+ = 2: uniform (-1,1)
+ = 3: normal (0,1)
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated.
+
+ X (output) REAL array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine calls the auxiliary routine SLARUV to generate random
+ real numbers from a uniform (0,1) distribution, in batches of up to
+ 128 using vectorisable code. The Box-Muller method is used to
+ transform numbers from a uniform to a normal distribution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param idist
+ * @param iseed
+ * @param n
+ * @param x
+ */
+ public abstract void slarnv(int idist, int[] iseed, int n, float[] x);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Compute the splitting points with threshold SPLTOL.
+ SLARRA sets any "small" off-diagonal elements to zero.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
+ are set to zero, the other entries of E are untouched.
+
+ E2 (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ SPLTOL (input) REAL
+ The threshold for splitting. Two criteria can be used:
+ SPLTOL<0 : criterion based on absolute off-diagonal value
+ SPLTOL>0 : criterion that preserves relative accuracy
+
+ TNRM (input) REAL
+ The norm of the matrix.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param e2
+ * @param spltol
+ * @param tnrm
+ * @param nsplit
+ * @param isplit
+ * @param info
+ */
+ public void slarra(int n, float[] d, float[] e, float[] e2, float spltol, float tnrm, intW nsplit, int[] isplit, intW info) {
+ org.netlib.lapack.Slarra.slarra(n, d, 0, e, 0, e2, 0, spltol, tnrm, nsplit, isplit, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the relatively robust representation(RRR) L D L^T, SLARRB
+ does "limited" bisection to refine the eigenvalues of L D L^T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses and their gaps are input in WERR
+ and WGAP, respectively. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ LLD (input) REAL array, dimension (N-1)
+ The (N-1) elements L(i)*L(i)*D(i).
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL1 (input) REAL
+ RTOL2 (input) REAL
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+ where GAP is the (estimated) distance to the nearest
+ eigenvalue.
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W, WGAP and WERR, i.e., the IFIRST-OFFS
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) REAL array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WGAP (input/output) REAL array, dimension (N-1)
+ On input, the (estimated) gaps between consecutive
+ eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap betwe
+ eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST
+ then WGAP(IFIRST-OFFSET) must be set to ZERO.
+ On output, these gaps are refined.
+
+ WERR (input/output) REAL array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) REAL array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of the matrix.
+
+ TWIST (input) INTEGER
+ The twist index for the twisted factorization that is used
+ for the negcount.
+ TWIST = N: Compute negcount from L D L^T - LAMBDA I = L+ D+ L
+ TWIST = 1: Compute negcount from L D L^T - LAMBDA I = U- D- U
+ TWIST = R: Compute negcount from L D L^T - LAMBDA I = N(r) D(
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param lld
+ * @param ifirst
+ * @param ilast
+ * @param rtol1
+ * @param rtol2
+ * @param offset
+ * @param w
+ * @param wgap
+ * @param werr
+ * @param work
+ * @param iwork
+ * @param pivmin
+ * @param spdiam
+ * @param twist
+ * @param info
+ */
+ public void slarrb(int n, float[] d, float[] lld, int ifirst, int ilast, float rtol1, float rtol2, int offset, float[] w, float[] wgap, float[] werr, float[] work, int[] iwork, float pivmin, float spdiam, int twist, intW info) {
+ org.netlib.lapack.Slarrb.slarrb(n, d, 0, lld, 0, ifirst, ilast, rtol1, rtol2, offset, w, 0, wgap, 0, werr, 0, work, 0, iwork, 0, pivmin, spdiam, twist, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Find the number of eigenvalues of the symmetric tridiagonal matrix T
+
+ that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
+ if JOBT = 'L'.
+
+ Arguments
+ =========
+
+ JOBT (input) CHARACTER*1
+ = 'T': Compute Sturm count for matrix T.
+ = 'L': Compute Sturm count for matrix L D L^T.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input) DOUBLE PRECISION
+ VU (input) DOUBLE PRECISION
+ The lower and upper bounds for the eigenvalues.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N diagonal elements of the tridiagonal matrix
+ JOBT = 'L': The N diagonal elements of the diagonal matrix D.
+
+ E (input) DOUBLE PRECISION array, dimension (N)
+ JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
+ JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ EIGCNT (output) INTEGER
+ The number of eigenvalues of the symmetric tridiagonal matrix
+ that are in the interval (VL,VU]
+
+ LCNT (output) INTEGER
+ RCNT (output) INTEGER
+ The left and right negcounts of the interval.
+
+ INFO (output) INTEGER
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobt
+ * @param n
+ * @param vl
+ * @param vu
+ * @param d
+ * @param e
+ * @param pivmin
+ * @param eigcnt
+ * @param lcnt
+ * @param rcnt
+ * @param info
+ */
+ public void slarrc(String jobt, int n, float vl, float vu, float[] d, float[] e, float pivmin, intW eigcnt, intW lcnt, intW rcnt, intW info) {
+ org.netlib.lapack.Slarrc.slarrc(jobt, n, vl, vu, d, 0, e, 0, pivmin, eigcnt, lcnt, rcnt, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARRD computes the eigenvalues of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from SSTEMR.
+ The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ GERS (input) REAL array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ RELTOL (input) REAL
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ E2 (input) REAL array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) REAL
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ NSPLIT (input) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ W (output) REAL array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalue approximations. SLARRD computes an interval
+ I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
+ approximation is given as the interval midpoint
+ W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
+ WERR(j) = abs( a_j - b_j)/2
+
+ WERR (output) REAL array, dimension (N)
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ WL (output) REAL
+ WU (output) REAL
+ The interval (WL, WU] contains all the wanted eigenvalues.
+ If RANGE='V', then WL=VL and WU=VU.
+ If RANGE='A', then WL and WU are the global Gerschgorin bound
+ on the spectrum.
+ If RANGE='I', then WL and WU are computed by SLAEBZ from the
+
+ index range specified.
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (SLARRD may use the remaining N-M elements as
+ workspace.)
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
+ i-th eigenvalue W(i) is the j-th eigenvalue in block k.
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ FUDGE REAL , default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ Based on contributions by
+ W. Kahan, University of California, Berkeley, USA
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param range
+ * @param order
+ * @param n
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param gers
+ * @param reltol
+ * @param d
+ * @param e
+ * @param e2
+ * @param pivmin
+ * @param nsplit
+ * @param isplit
+ * @param m
+ * @param w
+ * @param werr
+ * @param wl
+ * @param wu
+ * @param iblock
+ * @param indexw
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public void slarrd(String range, String order, int n, float vl, float vu, int il, int iu, float[] gers, float reltol, float[] d, float[] e, float[] e2, float pivmin, int nsplit, int[] isplit, intW m, float[] w, float[] werr, floatW wl, floatW wu, int[] iblock, int[] indexw, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slarrd.slarrd(range, order, n, vl, vu, il, iu, gers, 0, reltol, d, 0, e, 0, e2, 0, pivmin, nsplit, isplit, 0, m, w, 0, werr, 0, wl, wu, iblock, 0, indexw, 0, work, 0, iwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ To find the desired eigenvalues of a given real symmetric
+ tridiagonal matrix T, SLARRE sets any "small" off-diagonal
+ elements to zero, and for each unreduced block T_i, it finds
+ (a) a suitable shift at one end of the block's spectrum,
+ (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
+ (c) eigenvalues of each L_i D_i L_i^T.
+ The representations and eigenvalues found are then used by
+ SSTEMR to compute the eigenvectors of T.
+ The accuracy varies depending on whether bisection is used to
+ find a few eigenvalues or the dqds algorithm (subroutine SLASQ2) to
+ conpute all and then discard any unwanted one.
+ As an added benefit, SLARRE also outputs the n
+ Gerschgorin intervals for the matrices L_i D_i L_i^T.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ VL (input/output) REAL
+ VU (input/output) REAL
+ If RANGE='V', the lower and upper bounds for the eigenvalues.
+ Eigenvalues less than or equal to VL, or greater than VU,
+ will not be returned. VL < VU.
+ If RANGE='I' or ='A', SLARRE computes bounds on the desired
+ part of the spectrum.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal
+ matrix T.
+ On exit, the N diagonal elements of the diagonal
+ matrices D_i.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) need not be set.
+ On exit, E contains the subdiagonal elements of the unit
+ bidiagonal matrices L_i. The entries E( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, contain the base points sigma_i on output.
+
+
+ E2 (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the SQUARES of the
+
+ subdiagonal elements of the tridiagonal matrix T;
+ E2(N) need not be set.
+ On exit, the entries E2( ISPLIT( I ) ),
+ 1 <= I <= NSPLIT, have been set to zero
+
+ RTOL1 (input) REAL
+ RTOL2 (input) REAL
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ SPLTOL (input) REAL
+ The threshold for splitting.
+
+ NSPLIT (output) INTEGER
+ The number of blocks T splits into. 1 <= NSPLIT <= N.
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to ISPLIT(1),
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+
+ M (output) INTEGER
+ The total number of eigenvalues (of all L_i D_i L_i^T)
+ found.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the eigenvalues. The
+ eigenvalues of each of the blocks, L_i D_i L_i^T, are
+ sorted in ascending order ( SLARRE may use the
+ remaining N-M elements as workspace).
+
+ WERR (output) REAL array, dimension (N)
+ The error bound on the corresponding eigenvalue in W.
+
+ WGAP (output) REAL array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+ The gap is only with respect to the eigenvalues of the same b
+ as each block has its own representation tree.
+ Exception: at the right end of a block we store the left gap
+
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (output) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in block 2
+
+ GERS (output) REAL array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)).
+
+ PIVMIN (output) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ WORK (workspace) REAL array, dimension (6*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+ Workspace.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: A problem occured in SLARRE.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in SLARRD.
+ = 2: No base representation could be found in MAXTRY iterati
+ Increasing MAXTRY and recompilation might be a remedy.
+
+ =-3: Problem in SLARRB when computing the refined root
+ representation for SLASQ2.
+ =-4: Problem in SLARRB when preforming bisection on the
+ desired part of the spectrum.
+ =-5: Problem in SLASQ2.
+ =-6: Problem in SLASQ2.
+
+ Further Details
+ The base representations are required to suffer very little
+ element growth and consequently define all their eigenvalues to
+ high relative accuracy.
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param range
+ * @param n
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param d
+ * @param e
+ * @param e2
+ * @param rtol1
+ * @param rtol2
+ * @param spltol
+ * @param nsplit
+ * @param isplit
+ * @param m
+ * @param w
+ * @param werr
+ * @param wgap
+ * @param iblock
+ * @param indexw
+ * @param gers
+ * @param pivmin
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public void slarre(String range, int n, floatW vl, floatW vu, int il, int iu, float[] d, float[] e, float[] e2, float rtol1, float rtol2, float spltol, intW nsplit, int[] isplit, intW m, float[] w, float[] werr, float[] wgap, int[] iblock, int[] indexw, float[] gers, floatW pivmin, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slarre.slarre(range, n, vl, vu, il, iu, d, 0, e, 0, e2, 0, rtol1, rtol2, spltol, nsplit, isplit, 0, m, w, 0, werr, 0, wgap, 0, iblock, 0, indexw, 0, gers, 0, pivmin, work, 0, iwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial representation L D L^T and its cluster of close
+ eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
+
+ W( CLEND ), SLARRF finds a new relatively robust representation
+ L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
+ eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix (subblock, if the matrix splitted).
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D.
+
+ L (input) REAL array, dimension (N-1)
+ The (N-1) subdiagonal elements of the unit bidiagonal
+ matrix L.
+
+ LD (input) REAL array, dimension (N-1)
+ The (N-1) elements L(i)*D(i).
+
+ CLSTRT (input) INTEGER
+ The index of the first eigenvalue in the cluster.
+
+ CLEND (input) INTEGER
+ The index of the last eigenvalue in the cluster.
+
+ W (input) REAL array, dimension >= (CLEND-CLSTRT+1
+ The eigenvalue APPROXIMATIONS of L D L^T in ascending order.
+
+ W( CLSTRT ) through W( CLEND ) form the cluster of relatively
+ close eigenalues.
+
+ WGAP (input/output) REAL array, dimension >= (CLEND-C
+ The separation from the right neighbor eigenvalue in W.
+
+ WERR (input) REAL array, dimension >= (CLEND-CLSTRT+1
+ WERR contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue APPROXIMATION in W
+
+ SPDIAM (input) estimate of the spectral diameter obtained from the
+ Gerschgorin intervals
+
+ CLGAPL, CLGAPR (input) absolute gap on each end of the cluster.
+ Set by the calling routine to protect against shifts too clos
+ to eigenvalues outside the cluster.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ SIGMA (output) REAL
+ The shift used to form L(+) D(+) L(+)^T.
+
+ DPLUS (output) REAL array, dimension (N)
+ The N diagonal elements of the diagonal matrix D(+).
+
+ LPLUS (output) REAL array, dimension (N-1)
+ The first (N-1) elements of LPLUS contain the subdiagonal
+ elements of the unit bidiagonal matrix L(+).
+
+ WORK (workspace) REAL array, dimension (2*N)
+ Workspace.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param l
+ * @param ld
+ * @param clstrt
+ * @param clend
+ * @param w
+ * @param wgap
+ * @param werr
+ * @param spdiam
+ * @param clgapl
+ * @param clgapr
+ * @param pivmin
+ * @param sigma
+ * @param dplus
+ * @param lplus
+ * @param work
+ * @param info
+ */
+ public void slarrf(int n, float[] d, float[] l, float[] ld, int clstrt, int clend, float[] w, float[] wgap, float[] werr, float spdiam, float clgapl, float clgapr, float pivmin, floatW sigma, float[] dplus, float[] lplus, float[] work, intW info) {
+ org.netlib.lapack.Slarrf.slarrf(n, d, 0, l, 0, ld, 0, clstrt, clend, w, 0, wgap, 0, werr, 0, spdiam, clgapl, clgapr, pivmin, sigma, dplus, 0, lplus, 0, work, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Given the initial eigenvalue approximations of T, SLARRJ
+ does bisection to refine the eigenvalues of T,
+ W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initi
+ guesses for these eigenvalues are input in W, the corresponding estim
+ of the error in these guesses in WERR. During bisection, intervals
+ [left, right] are maintained by storing their mid-points and
+ semi-widths in the arrays W and WERR respectively.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of T.
+
+ E2 (input) REAL array, dimension (N-1)
+ The Squares of the (N-1) subdiagonal elements of T.
+
+ IFIRST (input) INTEGER
+ The index of the first eigenvalue to be computed.
+
+ ILAST (input) INTEGER
+ The index of the last eigenvalue to be computed.
+
+ RTOL (input) REAL
+ Tolerance for the convergence of the bisection intervals.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).
+
+ OFFSET (input) INTEGER
+ Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
+ through ILAST-OFFSET elements of these arrays are to be used.
+
+ W (input/output) REAL array, dimension (N)
+ On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
+ estimates of the eigenvalues of L D L^T indexed IFIRST throug
+ ILAST.
+ On output, these estimates are refined.
+
+ WERR (input/output) REAL array, dimension (N)
+ On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET )
+ the errors in the estimates of the corresponding elements in
+ On output, these errors are refined.
+
+ WORK (workspace) REAL array, dimension (2*N)
+ Workspace.
+
+ IWORK (workspace) INTEGER array, dimension (2*N)
+ Workspace.
+
+ PIVMIN (input) DOUBLE PRECISION
+ The minimum pivot in the Sturm sequence for T.
+
+ SPDIAM (input) DOUBLE PRECISION
+ The spectral diameter of T.
+
+ INFO (output) INTEGER
+ Error flag.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e2
+ * @param ifirst
+ * @param ilast
+ * @param rtol
+ * @param offset
+ * @param w
+ * @param werr
+ * @param work
+ * @param iwork
+ * @param pivmin
+ * @param spdiam
+ * @param info
+ */
+ public void slarrj(int n, float[] d, float[] e2, int ifirst, int ilast, float rtol, int offset, float[] w, float[] werr, float[] work, int[] iwork, float pivmin, float spdiam, intW info) {
+ org.netlib.lapack.Slarrj.slarrj(n, d, 0, e2, 0, ifirst, ilast, rtol, offset, w, 0, werr, 0, work, 0, iwork, 0, pivmin, spdiam, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARRK computes one eigenvalue of a symmetric tridiagonal
+ matrix T to suitable accuracy. This is an auxiliary code to be
+ called from SSTEMR.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ IW (input) INTEGER
+ The index of the eigenvalues to be returned.
+
+ GL (input) REAL
+ GU (input) REAL
+ An upper and a lower bound on the eigenvalue.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E2 (input) REAL array, dimension (N-1)
+ The (n-1) squared off-diagonal elements of the tridiagonal ma
+
+ PIVMIN (input) REAL
+ The minimum pivot allowed in the Sturm sequence for T.
+
+ RELTOL (input) REAL
+ The minimum relative width of an interval. When an interval
+
+ is narrower than RELTOL times the larger (in
+ magnitude) endpoint, then it is considered to be
+ sufficiently small, i.e., converged. Note: this should
+ always be at least radix*machine epsilon.
+
+ W (output) REAL
+
+ WERR (output) REAL
+ The error bound on the corresponding eigenvalue approximation
+ in W.
+
+ INFO (output) INTEGER
+ = 0: Eigenvalue converged
+ = -1: Eigenvalue did NOT converge
+
+ Internal Parameters
+ ===================
+
+ FUDGE REAL , default = 2
+ A "fudge factor" to widen the Gershgorin intervals.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param iw
+ * @param gl
+ * @param gu
+ * @param d
+ * @param e2
+ * @param pivmin
+ * @param reltol
+ * @param w
+ * @param werr
+ * @param info
+ */
+ public void slarrk(int n, int iw, float gl, float gu, float[] d, float[] e2, float pivmin, float reltol, floatW w, floatW werr, intW info) {
+ org.netlib.lapack.Slarrk.slarrk(n, iw, gl, gu, d, 0, e2, 0, pivmin, reltol, w, werr, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ Perform tests to decide whether the symmetric tridiagonal matrix T
+ warrants expensive computations which guarantee high relative accurac
+ in the eigenvalues.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N > 0.
+
+ D (input) REAL array, dimension (N)
+ The N diagonal elements of the tridiagonal matrix T.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the first (N-1) entries contain the subdiagonal
+ elements of the tridiagonal matrix T; E(N) is set to ZERO.
+
+ INFO (output) INTEGER
+ INFO = 0(default) : the matrix warrants computations preservi
+ relative accuracy.
+ INFO = 1 : the matrix warrants computations guarante
+ only absolute accuracy.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param info
+ */
+ public void slarrr(int n, float[] d, float[] e, intW info) {
+ org.netlib.lapack.Slarrr.slarrr(n, d, 0, e, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARRV computes the eigenvectors of the tridiagonal matrix
+ T = L D L^T given L, D and APPROXIMATIONS to the eigenvalues of L D L
+ The input eigenvalues should have been computed by SLARRE.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ VL (input) REAL
+ VU (input) REAL
+ Lower and upper bounds of the interval that contains the desi
+ eigenvalues. VL < VU. Needed to compute gaps on the left or r
+ end of the extremal eigenvalues in the desired RANGE.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the diagonal matrix D.
+ On exit, D may be overwritten.
+
+ L (input/output) REAL array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the unit
+ bidiagonal matrix L are in elements 1 to N-1 of L
+ (if the matrix is not splitted.) At the end of each block
+ is stored the corresponding shift as given by SLARRE.
+ On exit, L is overwritten.
+
+ PIVMIN (in) DOUBLE PRECISION
+ The minimum pivot allowed in the Sturm sequence.
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into blocks.
+ The first block consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+
+ M (input) INTEGER
+ The total number of input eigenvalues. 0 <= M <= N.
+
+ DOL (input) INTEGER
+ DOU (input) INTEGER
+ If the user wants to compute only selected eigenvectors from
+ the eigenvalues supplied, he can specify an index range DOL:D
+ Or else the setting DOL=1, DOU=M should be applied.
+ Note that DOL and DOU refer to the order in which the eigenva
+ are stored in W.
+ If the user wants to compute only selected eigenpairs, then
+ the columns DOL-1 to DOU+1 of the eigenvector space Z contain
+ computed eigenvectors. All other columns of Z are set to zero
+
+ MINRGP (input) REAL
+
+ RTOL1 (input) REAL
+ RTOL2 (input) REAL
+ Parameters for bisection.
+ An interval [LEFT,RIGHT] has converged if
+ RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) )
+
+ W (input/output) REAL array, dimension (N)
+ The first M elements of W contain the APPROXIMATE eigenvalues
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block ( The output array
+ W from SLARRE is expected here ). Furthermore, they are with
+
+ respect to the shift of the corresponding root representation
+ for their block. On exit, W holds the eigenvalues of the
+ UNshifted matrix.
+
+ WERR (input/output) REAL array, dimension (N)
+ The first M elements contain the semiwidth of the uncertainty
+ interval of the corresponding eigenvalue in W
+
+ WGAP (input/output) REAL array, dimension (N)
+ The separation from the right neighbor eigenvalue in W.
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The indices of the blocks (submatrices) associated with the
+ corresponding eigenvalues in W; IBLOCK(i)=1 if eigenvalue
+ W(i) belongs to the first block from the top, =2 if W(i)
+ belongs to the second block, etc.
+
+ INDEXW (input) INTEGER array, dimension (N)
+ The indices of the eigenvalues within each block (submatrix);
+ for example, INDEXW(i)= 10 and IBLOCK(i)=2 imply that the
+ i-th eigenvalue W(i) is the 10-th eigenvalue in the second bl
+
+ GERS (input) REAL array, dimension (2*N)
+ The N Gerschgorin intervals (the i-th Gerschgorin interval
+ is (GERS(2*i-1), GERS(2*i)). The Gerschgorin intervals should
+ be computed from the original UNshifted matrix.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If INFO = 0, the first M columns of Z contain the
+ orthonormal eigenvectors of the matrix T
+ corresponding to the input eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The I-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*I-1 ) through
+ ISUPPZ( 2*I ).
+
+ WORK (workspace) REAL array, dimension (12*N)
+
+ IWORK (workspace) INTEGER array, dimension (7*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+
+ > 0: A problem occured in SLARRV.
+ < 0: One of the called subroutines signaled an internal prob
+ Needs inspection of the corresponding parameter IINFO
+ for further information.
+
+ =-1: Problem in SLARRB when refining a child's eigenvalues.
+
+ =-2: Problem in SLARRF when computing the RRR of a child.
+ When a child is inside a tight cluster, it can be diffi
+ to find an RRR. A partial remedy from the user's point
+ view is to make the parameter MINRGP smaller and recomp
+ However, as the orthogonality of the computed vectors i
+ proportional to 1/MINRGP, the user should be aware that
+ he might be trading in precision when he decreases MINR
+ =-3: Problem in SLARRB when refining a single eigenvalue
+ after the Rayleigh correction was rejected.
+ = 5: The Rayleigh Quotient Iteration failed to converge to
+ full accuracy in MAXITR steps.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param vl
+ * @param vu
+ * @param d
+ * @param l
+ * @param pivmin
+ * @param isplit
+ * @param m
+ * @param dol
+ * @param dou
+ * @param minrgp
+ * @param rtol1
+ * @param rtol2
+ * @param w
+ * @param werr
+ * @param wgap
+ * @param iblock
+ * @param indexw
+ * @param gers
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public void slarrv(int n, float vl, float vu, float[] d, float[] l, float pivmin, int[] isplit, int m, int dol, int dou, float minrgp, floatW rtol1, floatW rtol2, float[] w, float[] werr, float[] wgap, int[] iblock, int[] indexw, float[] gers, float[] z, int ldz, int[] isuppz, float[] work, int[] iwork, intW info) {
+ org.netlib.lapack.Slarrv.slarrv(n, vl, vu, d, 0, l, 0, pivmin, isplit, 0, m, dol, dou, minrgp, rtol1, rtol2, w, 0, werr, 0, wgap, 0, iblock, 0, indexw, 0, gers, 0, z, 0, ldz, isuppz, 0, work, 0, iwork, 0, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARTG generate a plane rotation so that
+
+ [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+ [ -SN CS ] [ G ] [ 0 ]
+
+ This is a slower, more accurate version of the BLAS1 routine SROTG,
+ with the following other differences:
+ F and G are unchanged on return.
+ If G=0, then CS=1 and SN=0.
+ If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+ floating point operations (saves work in SBDSQR when
+ there are zeros on the diagonal).
+
+ If F exceeds G in magnitude, CS will be positive.
+
+ Arguments
+ =========
+
+ F (input) REAL
+ The first component of vector to be rotated.
+
+ G (input) REAL
+ The second component of vector to be rotated.
+
+ CS (output) REAL
+ The cosine of the rotation.
+
+ SN (output) REAL
+ The sine of the rotation.
+
+ R (output) REAL
+ The nonzero component of the rotated vector.
+
+ This version has a few statements commented out for thread safety
+ (machine parameters are computed on each entry). 10 feb 03, SJH.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param f
+ * @param g
+ * @param cs
+ * @param sn
+ * @param r
+ */
+ public abstract void slartg(float f, float g, floatW cs, floatW sn, floatW r);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARTV applies a vector of real plane rotations to elements of the
+ real vectors x and y. For i = 1,2,...,n
+
+ ( x(i) ) := ( c(i) s(i) ) ( x(i) )
+ ( y(i) ) ( -s(i) c(i) ) ( y(i) )
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of plane rotations to be applied.
+
+ X (input/output) REAL array,
+ dimension (1+(N-1)*INCX)
+ The vector x.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ Y (input/output) REAL array,
+ dimension (1+(N-1)*INCY)
+ The vector y.
+
+ INCY (input) INTEGER
+ The increment between elements of Y. INCY > 0.
+
+ C (input) REAL array, dimension (1+(N-1)*INCC)
+ The cosines of the plane rotations.
+
+ S (input) REAL array, dimension (1+(N-1)*INCC)
+ The sines of the plane rotations.
+
+ INCC (input) INTEGER
+ The increment between elements of C and S. INCC > 0.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param y
+ * @param incy
+ * @param c
+ * @param s
+ * @param incc
+ */
+ public abstract void slartv(int n, float[] x, int incx, float[] y, int incy, float[] c, float[] s, int incc);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARUV returns a vector of n random real numbers from a uniform (0,1)
+ distribution (n <= 128).
+
+ This is an auxiliary routine called by SLARNV and CLARNV.
+
+ Arguments
+ =========
+
+ ISEED (input/output) INTEGER array, dimension (4)
+ On entry, the seed of the random number generator; the array
+
+ elements must be between 0 and 4095, and ISEED(4) must be
+ odd.
+ On exit, the seed is updated.
+
+ N (input) INTEGER
+ The number of random numbers to be generated. N <= 128.
+
+ X (output) REAL array, dimension (N)
+ The generated random numbers.
+
+ Further Details
+ ===============
+
+ This routine uses a multiplicative congruential method with modulus
+ 2**48 and multiplier 33952834046453 (see G.S.Fishman,
+ 'Multiplicative congruential random number generators with modulus
+ 2**b: an exhaustive analysis for b = 32 and a partial analysis for
+ b = 48', Math. Comp. 189, pp 331-344, 1990).
+
+ 48-bit integers are stored in 4 integer array elements with 12 bits
+ per element. Hence the routine is portable across machines with
+ integers of 32 bits or more.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param iseed
+ * @param n
+ * @param x
+ */
+ public abstract void slaruv(int[] iseed, int n, float[] x);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARZ applies a real elementary reflector H to a real M-by-N
+ matrix C, from either the left or the right. H is represented in the
+
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+
+ H is a product of k elementary reflectors as returned by STZRZF.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ L (input) INTEGER
+ The number of entries of the vector V containing
+ the meaningful part of the Householder vectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) REAL array, dimension (1+(L-1)*abs(INCV))
+ The vector v in the representation of H as returned by
+ STZRZF. V is not used if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) REAL
+ The value tau in the representation of H.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param l
+ * @param v
+ * @param incv
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ */
+ public abstract void slarz(String side, int m, int n, int l, float[] v, int incv, float tau, float[] c, int Ldc, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARZB applies a real block reflector H or its transpose H**T to
+ a real distributed M-by-N C from the left or the right.
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'C': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise (not supported yet)
+
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ L (input) INTEGER
+ The number of columns of the matrix V containing the
+ meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ V (input) REAL array, dimension (LDV,NV).
+ If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
+
+ T (input) REAL array, dimension (LDT,K)
+ The triangular K-by-K matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param direct
+ * @param storev
+ * @param m
+ * @param n
+ * @param k
+ * @param l
+ * @param v
+ * @param ldv
+ * @param t
+ * @param ldt
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param ldwork
+ */
+ public abstract void slarzb(String side, String trans, String direct, String storev, int m, int n, int k, int l, float[] v, int ldv, float[] t, int ldt, float[] c, int Ldc, float[] work, int ldwork);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLARZT 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'
+
+ 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 * V
+
+ Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+
+ Arguments
+ =========
+
+ DIRECT (input) 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, not supported yet)
+
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise (not supported yet)
+
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) REAL array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) 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.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+
+ ______V_____
+ ( v1 v2 v3 ) / \
+ ( v1 v2 v3 ) ( v1 v1 v1 v1 v1 . . . . 1 )
+ V = ( v1 v2 v3 ) ( v2 v2 v2 v2 v2 . . . 1 )
+ ( v1 v2 v3 ) ( v3 v3 v3 v3 v3 . . 1 )
+ ( v1 v2 v3 )
+ . . .
+ . . .
+ 1 . .
+ 1 .
+ 1
+
+ DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+
+ ______V_____
+ 1 / \
+ . 1 ( 1 . . . . v1 v1 v1 v1 v1 )
+ . . 1 ( . 1 . . . v2 v2 v2 v2 v2 )
+ . . . ( . . 1 . . v3 v3 v3 v3 v3 )
+ . . .
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ V = ( v1 v2 v3 )
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param direct
+ * @param storev
+ * @param n
+ * @param k
+ * @param v
+ * @param ldv
+ * @param tau
+ * @param t
+ * @param ldt
+ */
+ public abstract void slarzt(String direct, String storev, int n, int k, float[] v, int ldv, float[] tau, float[] t, int ldt);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAS2 computes the singular values of the 2-by-2 matrix
+ [ F G ]
+ [ 0 H ].
+ On return, SSMIN is the smaller singular value and SSMAX is the
+ larger singular value.
+
+ Arguments
+ =========
+
+ F (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) REAL
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) REAL
+ The smaller singular value.
+
+ SSMAX (output) REAL
+ The larger singular value.
+
+ Further Details
+ ===============
+
+ Barring over/underflow, all output quantities are correct to within
+ a few units in the last place (ulps), even in the absence of a guard
+
+ digit in addition/subtraction.
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows, or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ ====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param f
+ * @param g
+ * @param h
+ * @param ssmin
+ * @param ssmax
+ */
+ public abstract void slas2(float f, float g, float h, floatW ssmin, floatW ssmax);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASCL multiplies the M by N real matrix A by the real scalar
+ CTO/CFROM. This is done without over/underflow as long as the final
+
+ result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+
+ A may be full, upper triangular, lower triangular, upper Hessenberg,
+
+ or banded.
+
+ Arguments
+ =========
+
+ TYPE (input) CHARACTER*1
+ TYPE indices the storage type of the input matrix.
+ = 'G': A is a full matrix.
+ = 'L': A is a lower triangular matrix.
+ = 'U': A is an upper triangular matrix.
+ = 'H': A is an upper Hessenberg matrix.
+ = 'B': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the lower
+ half stored.
+ = 'Q': A is a symmetric band matrix with lower bandwidth KL
+
+ and upper bandwidth KU and with the only the upper
+ half stored.
+ = 'Z': A is a band matrix with lower bandwidth KL and upper
+
+ bandwidth KU.
+
+ KL (input) INTEGER
+ The lower bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ KU (input) INTEGER
+ The upper bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ CFROM (input) REAL
+ CTO (input) REAL
+ The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+ without over/underflow if the final result CTO*A(I,J)/CFROM
+ can be represented without over/underflow. CFROM must be
+ nonzero.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ The matrix to be multiplied by CTO/CFROM. See TYPE for the
+ storage type.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ 0 - successful exit
+ <0 - if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param type
+ * @param kl
+ * @param ku
+ * @param cfrom
+ * @param cto
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void slascl(String type, int kl, int ku, float cfrom, float cto, int m, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, SLASD0 computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M
+ matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
+ The algorithm computes orthogonal matrices U and VT such that
+ B = U * S * VT. The singular values S are overwritten on D.
+
+ A related subroutine, SLASDA, computes only the singular values,
+ and optionally, the singular vectors in compact form.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the row dimension of the upper bidiagonal matrix.
+ This is also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N+1;
+
+ D (input/output) REAL array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix.
+ On exit D, if INFO = 0, contains its singular values.
+
+ E (input) REAL array, dimension (M-1)
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) REAL array, dimension at least (LDQ, N)
+ On exit, U contains the left singular vectors.
+
+ LDU (input) INTEGER
+ On entry, leading dimension of U.
+
+ VT (output) REAL array, dimension at least (LDVT, M)
+ On exit, VT' contains the right singular vectors.
+
+ LDVT (input) INTEGER
+ On entry, leading dimension of VT.
+
+ SMLSIZ (input) INTEGER
+ On entry, maximum size of the subproblems at the
+ bottom of the computation tree.
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ WORK (workspace) REAL array, dimension (3*M**2+2*M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param sqre
+ * @param d
+ * @param e
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param smlsiz
+ * @param iwork
+ * @param work
+ * @param info
+ */
+ public abstract void slasd0(int n, int sqre, float[] d, float[] e, float[] u, int ldu, float[] vt, int ldvt, int smlsiz, int[] iwork, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
+ where N = NL + NR + 1 and M = N + SQRE. SLASD1 is called from SLASD0.
+
+ A related subroutine SLASD7 handles the case in which the singular
+ values (and the singular vectors in factored form) are desired.
+
+ SLASD1 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The left singular vectors of the original matrix are stored in U, and
+ the transpose of the right singular vectors are stored in VT, and the
+ singular values are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or when there are zeros in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLASD2.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the square roots of the
+ roots of the secular equation via the routine SLASD4 (as called
+ by SLASD3). This routine also calculates the singular vectors of
+ the current problem.
+
+ The final stage consists of computing the updated singular vectors
+ directly using the updated singular values. The singular vectors
+
+ for the current problem are multiplied with the singular vectors
+ from the overall problem.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) REAL array, dimension (NL+NR+1).
+ N = NL+NR+1
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block; and D(NL+2:N) contains the singular values of
+ the lower block. On exit D(1:N) contains the singular values
+ of the modified matrix.
+
+ ALPHA (input/output) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) REAL array, dimension (LDU,N)
+ On entry U(1:NL, 1:NL) contains the left singular vectors of
+ the upper block; U(NL+2:N, NL+2:N) contains the left singular
+
+ vectors of the lower block. On exit U contains the left
+ singular vectors of the bidiagonal matrix.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max( 1, N ).
+
+ VT (input/output) REAL array, dimension (LDVT,M)
+ where M = N + SQRE.
+ On entry VT(1:NL+1, 1:NL+1)' contains the right singular
+ vectors of the upper block; VT(NL+2:M, NL+2:M)' contains
+ the right singular vectors of the lower block. On exit
+ VT' contains the right singular vectors of the
+ bidiagonal matrix.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= max( 1, M ).
+
+ IDXQ (output) INTEGER array, dimension (N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ WORK (workspace) REAL array, dimension (3*M**2+2*M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+
+</pre>
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param d
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param idxq
+ * @param iwork
+ * @param work
+ * @param info
+ */
+ public abstract void slasd1(int nl, int nr, int sqre, float[] d, floatW alpha, floatW beta, float[] u, int ldu, float[] vt, int ldvt, int[] idxq, int[] iwork, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD2 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ singular values are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+
+ equation problem is reduced by one.
+
+ SLASD2 is called from SLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) REAL array, dimension (N)
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) REAL array, dimension (N)
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ALPHA (input) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) REAL array, dimension (LDU,N)
+ On entry U contains the left singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL, NL), and (NL+2, NL+2), (N,N).
+ On exit U contains the trailing (N-K) updated left singular
+ vectors (those which were deflated) in its last N-K columns.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ VT (input/output) REAL array, dimension (LDVT,M)
+ On entry VT' contains the right singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL+1, NL+1), and (NL+2, NL+2), (M,M).
+ On exit VT' contains the trailing (N-K) updated right singular
+ vectors (those which were deflated) in its last N-K columns.
+ In case SQRE =1, the last row of VT spans the right null
+ space.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= M.
+
+ DSIGMA (output) REAL array, dimension (N)
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ U2 (output) REAL array, dimension (LDU2,N)
+ Contains a copy of the first K-1 left singular vectors which
+ will be used by SLASD3 in a matrix multiply (SGEMM) to solve
+ for the new left singular vectors. U2 is arranged into four
+ blocks. The first block contains a column with 1 at NL+1 and
+ zero everywhere else; the second block contains non-zero
+ entries only at and above NL; the third contains non-zero
+ entries only below NL+1; and the fourth is dense.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT2 (output) REAL array, dimension (LDVT2,N)
+ VT2' contains a copy of the first K right singular vectors
+ which will be used by SLASD3 in a matrix multiply (SGEMM) to
+ solve for the new right singular vectors. VT2 is arranged into
+ three blocks. The first block contains a row that corresponds
+
+ to the special 0 diagonal element in SIGMA; the second block
+ contains non-zeros only at and before NL +1; the third block
+ contains non-zeros only at and after NL +2.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= M.
+
+ IDXP (workspace) INTEGER array, dimension (N)
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDX (workspace) INTEGER array, dimension (N)
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXC (output) INTEGER array, dimension (N)
+ This will contain the permutation used to arrange the columns
+
+ of the deflated U matrix into three groups: the first group
+ contains non-zero entries only at and above NL, the second
+ contains non-zero entries only below NL+2, and the third is
+ dense.
+
+ IDXQ (input/output) INTEGER array, dimension (N)
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first hlaf of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ As workspace, this will contain a label which will indicate
+ which of the following types a column in the U2 matrix or a
+ row in the VT2 matrix is:
+ 1 : non-zero in the upper half only
+ 2 : non-zero in the lower half only
+ 3 : dense
+ 4 : deflated
+
+ On exit, it is an array of dimension 4, with COLTYP(I) being
+ the dimension of the I-th type columns.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param k
+ * @param d
+ * @param z
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param ldvt
+ * @param dsigma
+ * @param u2
+ * @param ldu2
+ * @param vt2
+ * @param ldvt2
+ * @param idxp
+ * @param idx
+ * @param idxc
+ * @param idxq
+ * @param coltyp
+ * @param info
+ */
+ public abstract void slasd2(int nl, int nr, int sqre, intW k, float[] d, float[] z, float alpha, float beta, float[] u, int ldu, float[] vt, int ldvt, float[] dsigma, float[] u2, int ldu2, float[] vt2, int ldvt2, int[] idxp, int[] idx, int[] idxc, int[] idxq, int[] coltyp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD3 finds all the square roots of the roots of the secular
+ equation, as defined by the values in D and Z. It makes the
+ appropriate calls to SLASD4 and then updates the singular
+ vectors by matrix multiplication.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ SLASD3 is called from SLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (input) INTEGER
+ The size of the secular equation, 1 =< K = < N.
+
+ D (output) REAL array, dimension(K)
+ On exit the square roots of the roots of the secular equation,
+ in ascending order.
+
+ Q (workspace) REAL array,
+ dimension at least (LDQ,K).
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= K.
+
+ DSIGMA (input/output) REAL array, dimension(K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ U (output) REAL array, dimension (LDU, N)
+ The last N - K columns of this matrix contain the deflated
+ left singular vectors.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ U2 (input) REAL array, dimension (LDU2, N)
+ The first K columns of this matrix contain the non-deflated
+ left singular vectors for the split problem.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT (output) REAL array, dimension (LDVT, M)
+ The last M - K columns of VT' contain the deflated
+ right singular vectors.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= N.
+
+ VT2 (input/output) REAL array, dimension (LDVT2, N)
+ The first K columns of VT2' contain the non-deflated
+ right singular vectors for the split problem.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= N.
+
+ IDXC (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of U (and rows of
+
+ VT) into three groups: the first group contains non-zero
+ entries only at and above (or before) NL +1; the second
+ contains non-zero entries only at and below (or after) NL+2;
+ and the third is dense. The first column of U and the row of
+ VT are treated separately, however.
+
+ The rows of the singular vectors found by SLASD4
+ must be likewise permuted before the matrix multiplies can
+ take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in U (or rows in VT), as described in IDXC. The fourth column
+
+ type is any column which has been deflated.
+
+ Z (input/output) REAL array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param k
+ * @param d
+ * @param q
+ * @param ldq
+ * @param dsigma
+ * @param u
+ * @param ldu
+ * @param u2
+ * @param ldu2
+ * @param vt
+ * @param ldvt
+ * @param vt2
+ * @param ldvt2
+ * @param idxc
+ * @param ctot
+ * @param z
+ * @param info
+ */
+ public abstract void slasd3(int nl, int nr, int sqre, int k, float[] d, float[] q, int ldq, float[] dsigma, float[] u, int ldu, float[] u2, int ldu2, float[] vt, int ldvt, float[] vt2, int ldvt2, int[] idxc, int[] ctot, float[] z, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th updated
+ eigenvalue of a positive symmetric rank-one modification to
+ a positive diagonal matrix whose entries are given as the squares
+ of the corresponding entries in the array d, and that
+
+ 0 <= D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) * diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) REAL array, dimension ( N )
+ The original eigenvalues. It is assumed that they are in
+ order, 0 <= D(I) < D(J) for I < J.
+
+ Z (input) REAL array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (N)
+ If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. The vector DELTA
+ contains the information necessary to construct the
+ (singular) eigenvectors.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ SIGMA (output) REAL
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) REAL array, dimension (N)
+ If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
+ component. If N = 1, then WORK( 1 ) = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param sigma
+ * @param work
+ * @param info
+ */
+ public abstract void slasd4(int n, int i, float[] d, float[] z, float[] delta, float rho, floatW sigma, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th eigenvalue
+ of a positive symmetric rank-one modification of a 2-by-2 diagonal
+ matrix
+
+ diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal entries in the array D are assumed to satisfy
+
+ 0 <= D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) REAL array, dimension (2)
+ The original eigenvalues. We assume 0 <= D(1) < D(2).
+
+ Z (input) REAL array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) REAL array, dimension (2)
+ Contains (D(j) - sigma_I) in its j-th component.
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) REAL
+ The scalar in the symmetric updating formula.
+
+ DSIGMA (output) REAL
+ The computed sigma_I, the I-th updated eigenvalue.
+
+ WORK (workspace) REAL array, dimension (2)
+ WORK contains (D(j) + sigma_I) in its j-th component.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i
+ * @param d
+ * @param z
+ * @param delta
+ * @param rho
+ * @param dsigma
+ * @param work
+ */
+ public abstract void slasd5(int i, float[] d, float[] z, float[] delta, float rho, floatW dsigma, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD6 computes the SVD of an updated upper bidiagonal matrix B
+ obtained by merging two smaller ones by appending a row. This
+ routine is used only for the problem which requires all singular
+ values and optionally singular vector matrices in factored form.
+ B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
+ A related subroutine, SLASD1, handles the case in which all singular
+
+ values and singular vectors of the bidiagonal matrix are desired.
+
+ SLASD6 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The singular values of B can be computed using D1, D2, the first
+ components of all the right singular vectors of the lower block, and
+
+ the last components of all the right singular vectors of the upper
+ block. These components are stored and updated in VF and VL,
+ respectively, in SLASD6. Hence U and VT are not explicitly
+ referenced.
+
+ The singular values are stored in D. The algorithm consists of two
+ stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or if there is a zero
+ in the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine SLASD7.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the roots of the
+ secular equation via the routine SLASD4 (as called by SLASD8).
+
+ This routine also updates VF and VL and computes the distances
+
+ between the updated singular values and the old singular
+ values.
+
+ SLASD6 is called from SLASDA.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) REAL array, dimension (NL+NR+1).
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block, and D(NL+2:N) contains the singular values
+ of the lower block. On exit D(1:N) contains the singular
+ values of the modified matrix.
+
+ VF (input/output) REAL array, dimension (M)
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VL (input/output) REAL array, dimension (M)
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors of
+
+ the lower block. On exit, VL contains the last components of
+ all right singular vectors of the bidiagonal matrix.
+
+ ALPHA (input/output) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input/output) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ IDXQ (output) INTEGER array, dimension (N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) REAL array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM and POLES, must be at least N.
+
+ POLES (output) REAL array, dimension ( LDGNUM, 2 )
+ On exit, POLES(1,*) is an array containing the new singular
+ values obtained from solving the secular equation, and
+ POLES(2,*) is an array containing the poles in the secular
+ equation. Not referenced if ICOMPQ = 0.
+
+ DIFL (output) REAL array, dimension ( N )
+ On exit, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (output) REAL array,
+ dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ On exit, DIFR(I, 1) is the distance between I-th updated
+ (undeflated) singular value and the I+1-th (undeflated) old
+ singular value.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ See SLASD8 for details on DIFL and DIFR.
+
+ Z (output) REAL array, dimension ( M )
+ The first elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (output) REAL
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) REAL
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) REAL array, dimension ( 4 * M )
+
+ IWORK (workspace) INTEGER array, dimension ( 3 * N )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param d
+ * @param vf
+ * @param vl
+ * @param alpha
+ * @param beta
+ * @param idxq
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param givnum
+ * @param ldgnum
+ * @param poles
+ * @param difl
+ * @param difr
+ * @param z
+ * @param k
+ * @param c
+ * @param s
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slasd6(int icompq, int nl, int nr, int sqre, float[] d, float[] vf, float[] vl, floatW alpha, floatW beta, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, float[] poles, float[] difl, float[] difr, float[] z, intW k, floatW c, floatW s, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD7 merges the two sets of singular values together into a single
+
+ sorted set. Then it tries to deflate the size of the problem. There
+ are two ways in which deflation can occur: when two or more singular
+ values are close together or if there is a tiny entry in the Z
+ vector. For each such occurrence the order of the related
+ secular equation problem is reduced by one.
+
+ SLASD7 is called from SLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper
+ bidiagonal matrix in compact form.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix, this is
+ the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) REAL array, dimension ( N )
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) REAL array, dimension ( M )
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ZW (workspace) REAL array, dimension ( M )
+ Workspace for Z.
+
+ VF (input/output) REAL array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+
+ of all right singular vectors of the bidiagonal matrix.
+
+ VFW (workspace) REAL array, dimension ( M )
+ Workspace for VF.
+
+ VL (input/output) REAL array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors
+ of the lower block. On exit, VL contains the last components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VLW (workspace) REAL array, dimension ( M )
+ Workspace for VL.
+
+ ALPHA (input) REAL
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) REAL
+ Contains the off-diagonal element associated with the added
+ row.
+
+ DSIGMA (output) REAL array, dimension ( N )
+ Contains a copy of the diagonal elements (K-1 singular values
+
+ and one zero) in the secular equation.
+
+ IDX (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXP (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDXQ (input) INTEGER array, dimension ( N )
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+
+ the first half of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each singular block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) REAL array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM, must be at least N.
+
+ C (output) REAL
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) REAL
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param nl
+ * @param nr
+ * @param sqre
+ * @param k
+ * @param d
+ * @param z
+ * @param zw
+ * @param vf
+ * @param vfw
+ * @param vl
+ * @param vlw
+ * @param alpha
+ * @param beta
+ * @param dsigma
+ * @param idx
+ * @param idxp
+ * @param idxq
+ * @param perm
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param givnum
+ * @param ldgnum
+ * @param c
+ * @param s
+ * @param info
+ */
+ public abstract void slasd7(int icompq, int nl, int nr, int sqre, intW k, float[] d, float[] z, float[] zw, float[] vf, float[] vfw, float[] vl, float[] vlw, float alpha, float beta, float[] dsigma, int[] idx, int[] idxp, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, floatW c, floatW s, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASD8 finds the square roots of the roots of the secular equation,
+ as defined by the values in DSIGMA and Z. It makes the appropriate
+ calls to SLASD4, and stores, for each element in D, the distance
+ to its two nearest poles (elements in DSIGMA). It also updates
+ the arrays VF and VL, the first and last components of all the
+ right singular vectors of the original bidiagonal matrix.
+
+ SLASD8 is called from SLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form in the calling routine:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved
+ by SLASD4. K >= 1.
+
+ D (output) REAL array, dimension ( K )
+ On output, D contains the updated singular values.
+
+ Z (input) REAL array, dimension ( K )
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ VF (input/output) REAL array, dimension ( K )
+ On entry, VF contains information passed through DBEDE8.
+ On exit, VF contains the first K components of the first
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ VL (input/output) REAL array, dimension ( K )
+ On entry, VL contains information passed through DBEDE8.
+ On exit, VL contains the first K components of the last
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ DIFL (output) REAL array, dimension ( K )
+ On exit, DIFL(I) = D(I) - DSIGMA(I).
+
+ DIFR (output) REAL array,
+ dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
+ dimension ( K ) if ICOMPQ = 0.
+ On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
+ defined and will not be referenced.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ LDDIFR (input) INTEGER
+ The leading dimension of DIFR, must be at least K.
+
+ DSIGMA (input) REAL array, dimension ( K )
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ WORK (workspace) REAL array, dimension at least 3 * K
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param k
+ * @param d
+ * @param z
+ * @param vf
+ * @param vl
+ * @param difl
+ * @param difr
+ * @param lddifr
+ * @param dsigma
+ * @param work
+ * @param info
+ */
+ public abstract void slasd8(int icompq, int k, float[] d, float[] z, float[] vf, float[] vl, float[] difl, float[] difr, int lddifr, float[] dsigma, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, SLASDA computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
+ B with diagonal D and offdiagonal E, where M = N + SQRE. The
+ algorithm computes the singular values in the SVD B = U * S * VT.
+ The orthogonal matrices U and VT are optionally computed in
+ compact form.
+
+ A related subroutine, SLASD0, computes the singular values and
+ the singular vectors in explicit form.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper bidiagonal
+ matrix in compact form.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row dimension of the upper bidiagonal matrix. This is
+ also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N + 1.
+
+ D (input/output) REAL array, dimension ( N )
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit D, if INFO = 0, contains its singular values.
+
+
+ E (input) REAL array, dimension ( M-1 )
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) REAL array,
+ dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
+ GIVNUM, and Z.
+
+ VT (output) REAL array,
+ dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT' contains the right
+
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ K (output) INTEGER array, dimension ( N )
+ if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
+ secular equation on the computation tree.
+
+ DIFL (output) REAL array, dimension ( LDU, NLVL ),
+ where NLVL = floor(log_2 (N/SMLSIZ))).
+
+ DIFR (output) REAL array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
+
+ record distances between singular values on the I-th
+ level and singular values on the (I -1)-th level, and
+ DIFR(1:N, 2 * I ) contains the normalizing factors for
+ the right singular vector matrix. See SLASD8 for details.
+
+ Z (output) REAL array,
+ dimension ( LDU, NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ The first K elements of Z(1, I) contain the components of
+ the deflation-adjusted updating row vector for subproblems
+ on the I-th level.
+
+ POLES (output) REAL array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
+
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
+ POLES(1, 2*I) contain the new and old singular values
+ involved in the secular equations on the I-th level.
+
+ GIVPTR (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1, and not referenced if
+ ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
+ the number of Givens rotations performed on the I-th
+ problem on the computation tree.
+
+ GIVCOL (output) INTEGER array,
+ dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
+ of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (output) INTEGER array, dimension ( LDGCOL, NLVL )
+ if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
+ permutations done on the I-th level of the computation tree.
+
+ GIVNUM (output) REAL array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+
+ GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
+ values of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ C (output) REAL array,
+ dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
+
+ If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
+
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (output) REAL array, dimension ( N ) if
+ ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
+ and the I-th subproblem is not square, on exit, S( I )
+ contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) REAL array, dimension
+ (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
+
+ IWORK (workspace) INTEGER array, dimension (7*N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param icompq
+ * @param smlsiz
+ * @param n
+ * @param sqre
+ * @param d
+ * @param e
+ * @param u
+ * @param ldu
+ * @param vt
+ * @param k
+ * @param difl
+ * @param difr
+ * @param z
+ * @param poles
+ * @param givptr
+ * @param givcol
+ * @param ldgcol
+ * @param perm
+ * @param givnum
+ * @param c
+ * @param s
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void slasda(int icompq, int smlsiz, int n, int sqre, float[] d, float[] e, float[] u, int ldu, float[] vt, int[] k, float[] difl, float[] difr, float[] z, float[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, float[] givnum, float[] c, float[] s, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASDQ computes the singular value decomposition (SVD) of a real
+ (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
+ E, accumulating the transformations if desired. Letting B denote
+ the input bidiagonal matrix, the algorithm computes orthogonal
+ matrices Q and P such that B = Q * S * P' (P' denotes the transpose
+ of P). The singular values S are overwritten on D.
+
+ The input matrix U is changed to U * Q if desired.
+ The input matrix VT is changed to P' * VT if desired.
+ The input matrix C is changed to Q' * C if desired.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3, for a detailed description of the algorithm.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ On entry, UPLO specifies whether the input bidiagonal matrix
+ is upper or lower bidiagonal, and wether it is square are
+ not.
+ UPLO = 'U' or 'u' B is upper bidiagonal.
+ UPLO = 'L' or 'l' B is lower bidiagonal.
+
+ SQRE (input) INTEGER
+ = 0: then the input matrix is N-by-N.
+ = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
+ (N+1)-by-N if UPLU = 'L'.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ N (input) INTEGER
+ On entry, N specifies the number of rows and columns
+ in the matrix. N must be at least 0.
+
+ NCVT (input) INTEGER
+ On entry, NCVT specifies the number of columns of
+ the matrix VT. NCVT must be at least 0.
+
+ NRU (input) INTEGER
+ On entry, NRU specifies the number of rows of
+ the matrix U. NRU must be at least 0.
+
+ NCC (input) INTEGER
+ On entry, NCC specifies the number of columns of
+ the matrix C. NCC must be at least 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D contains the diagonal entries of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in ascending order.
+
+ E (input/output) REAL array.
+ dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
+ On entry, the entries of E contain the offdiagonal entries
+ of the bidiagonal matrix whose SVD is desired. On normal
+ exit, E will contain 0. If the algorithm does not converge,
+ D and E will contain the diagonal and superdiagonal entries
+ of a bidiagonal matrix orthogonally equivalent to the one
+ given as input.
+
+ VT (input/output) REAL array, dimension (LDVT, NCVT)
+ On entry, contains a matrix which on exit has been
+ premultiplied by P', dimension N-by-NCVT if SQRE = 0
+ and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
+
+ LDVT (input) INTEGER
+ On entry, LDVT specifies the leading dimension of VT as
+ declared in the calling (sub) program. LDVT must be at
+ least 1. If NCVT is nonzero LDVT must also be at least N.
+
+ U (input/output) REAL array, dimension (LDU, N)
+ On entry, contains a matrix which on exit has been
+ postmultiplied by Q, dimension NRU-by-N if SQRE = 0
+ and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
+
+ LDU (input) INTEGER
+ On entry, LDU specifies the leading dimension of U as
+ declared in the calling (sub) program. LDU must be at
+ least max( 1, NRU ) .
+
+ C (input/output) REAL array, dimension (LDC, NCC)
+ On entry, contains an N-by-NCC matrix which on exit
+ has been premultiplied by Q' dimension N-by-NCC if SQRE = 0
+ and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
+
+ LDC (input) INTEGER
+ On entry, LDC specifies the leading dimension of C as
+ declared in the calling (sub) program. LDC must be at
+ least 1. If NCC is nonzero, LDC must also be at least N.
+
+ WORK (workspace) REAL array, dimension (4*N)
+ Workspace. Only referenced if one of NCVT, NRU, or NCC is
+ nonzero, and if N is at least 2.
+
+ INFO (output) INTEGER
+ On exit, a value of 0 indicates a successful exit.
+ If INFO < 0, argument number -INFO is illegal.
+ If INFO > 0, the algorithm did not converge, and INFO
+ specifies how many superdiagonals did not converge.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param sqre
+ * @param n
+ * @param ncvt
+ * @param nru
+ * @param ncc
+ * @param d
+ * @param e
+ * @param vt
+ * @param ldvt
+ * @param u
+ * @param ldu
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void slasdq(String uplo, int sqre, int n, int ncvt, int nru, int ncc, float[] d, float[] e, float[] vt, int ldvt, float[] u, int ldu, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASDT creates a tree of subproblems for bidiagonal divide and
+ conquer.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the number of diagonal elements of the
+ bidiagonal matrix.
+
+ LVL (output) INTEGER
+ On exit, the number of levels on the computation tree.
+
+ ND (output) INTEGER
+ On exit, the number of nodes on the tree.
+
+ INODE (output) INTEGER array, dimension ( N )
+ On exit, centers of subproblems.
+
+ NDIML (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of left children.
+
+ NDIMR (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of right children.
+
+ MSUB (input) INTEGER.
+ On entry, the maximum row dimension each subproblem at the
+ bottom of the tree can be of.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param lvl
+ * @param nd
+ * @param inode
+ * @param ndiml
+ * @param ndimr
+ * @param msub
+ */
+ public abstract void slasdt(int n, intW lvl, intW nd, int[] inode, int[] ndiml, int[] ndimr, int msub);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASET initializes an m-by-n matrix A to BETA on the diagonal and
+ ALPHA on the offdiagonals.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be set.
+ = 'U': Upper triangular part is set; the strictly lower
+
+ triangular part of A is not changed.
+ = 'L': Lower triangular part is set; the strictly upper
+
+ triangular part of A is not changed.
+ Otherwise: All of the matrix A is set.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ ALPHA (input) REAL
+ The constant to which the offdiagonal elements are to be set.
+
+ BETA (input) REAL
+ The constant to which the diagonal elements are to be set.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On exit, the leading m-by-n submatrix of A is set as follows:
+
+ if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+ if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+ otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+
+ and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param m
+ * @param n
+ * @param alpha
+ * @param beta
+ * @param a
+ * @param lda
+ */
+ public abstract void slaset(String uplo, int m, int n, float alpha, float beta, float[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ1 computes the singular values of a real N-by-N bidiagonal
+ matrix with diagonal D and off-diagonal E. The singular values
+ are computed to high relative accuracy, in the absence of
+ denormalization, underflow and overflow. The algorithm was first
+ presented in
+
+ "Accurate singular values and differential qd algorithms" by K. V.
+ Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
+ 1994,
+
+ and the present implementation is described in "An implementation of
+
+ the dqds Algorithm (Positive Case)", LAPACK Working Note.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, D contains the diagonal elements of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in decreasing order.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, elements E(1:N-1) contain the off-diagonal elements
+ of the bidiagonal matrix whose SVD is desired.
+ On exit, E is overwritten.
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param work
+ * @param info
+ */
+ public abstract void slasq1(int n, float[] d, float[] e, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ2 computes all the eigenvalues of the symmetric positive
+ definite tridiagonal matrix associated with the qd array Z to high
+ relative accuracy are computed to high relative accuracy, in the
+ absence of denormalization, underflow and overflow.
+
+ To see the relation of Z to the tridiagonal matrix, let L be a
+ unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
+ let U be an upper bidiagonal matrix with 1's above and diagonal
+ Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
+ symmetric tridiagonal to which it is similar.
+
+ Note : SLASQ2 defines a logical variable, IEEE, which is true
+ on machines which follow ieee-754 floating-point standard in their
+ handling of infinities and NaNs, and false otherwise. This variable
+ is passed to SLAZQ3.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ Z (workspace) REAL array, dimension (4*N)
+ On entry Z holds the qd array. On exit, entries 1 to N hold
+ the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
+ trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
+ N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
+ holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
+ shifts that failed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if the i-th argument is a scalar and had an illegal
+ value, then INFO = -i, if the i-th argument is an
+ array and the j-entry had an illegal value, then
+ INFO = -(i*100+j)
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ Further Details
+ ===============
+ Local Variables: I0:N0 defines a current unreduced segment of Z.
+ The shifts are accumulated in SIGMA. Iteration count is in ITER.
+ Ping-pong is controlled by PP (alternates between 0 and 1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param z
+ * @param info
+ */
+ public abstract void slasq2(int n, float[] z, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ SIGMA (output) REAL
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) REAL
+ Lower order part of SIGMA
+
+ QMAX (input) REAL
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to SLASQ5).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param dmin
+ * @param sigma
+ * @param desig
+ * @param qmax
+ * @param nfail
+ * @param iter
+ * @param ndiv
+ * @param ieee
+ */
+ public abstract void slasq3(int i0, intW n0, float[] z, int pp, floatW dmin, floatW sigma, floatW desig, floatW qmax, intW nfail, intW iter, intW ndiv, boolean ieee);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) REAL
+ Minimum value of d.
+
+ DMIN1 (input) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) REAL
+ d(N)
+
+ DN1 (input) REAL
+ d(N-1)
+
+ DN2 (input) REAL
+ d(N-2)
+
+ TAU (output) REAL
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param n0in
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dn1
+ * @param dn2
+ * @param tau
+ * @param ttype
+ */
+ public abstract void slasq4(int i0, int n0, float[] z, int pp, int n0in, float dmin, float dmin1, float dmin2, float dn, float dn1, float dn2, floatW tau, intW ttype);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ5 computes one dqds transform in ping-pong form, one
+ version for IEEE machines another for non IEEE machines.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ TAU (input) REAL
+ This is the shift.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ DMIN1 (output) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) REAL
+ d(N0), the last value of d.
+
+ DNM1 (output) REAL
+ d(N0-1).
+
+ DNM2 (output) REAL
+ d(N0-2).
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic.
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param tau
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dnm1
+ * @param dnm2
+ * @param ieee
+ */
+ public abstract void slasq5(int i0, int n0, float[] z, int pp, float tau, floatW dmin, floatW dmin1, floatW dmin2, floatW dn, floatW dnm1, floatW dnm2, boolean ieee);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASQ6 computes one dqd (shift equal to zero) transform in
+ ping-pong form, with protection against underflow and overflow.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ DMIN1 (output) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) REAL
+ d(N0), the last value of d.
+
+ DNM1 (output) REAL
+ d(N0-1).
+
+ DNM2 (output) REAL
+ d(N0-2).
+
+ =====================================================================
+
+ .. Parameter ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dnm1
+ * @param dnm2
+ */
+ public abstract void slasq6(int i0, int n0, float[] z, int pp, floatW dmin, floatW dmin1, floatW dmin2, floatW dn, floatW dnm1, floatW dnm2);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASR applies a sequence of plane rotations to a real matrix A,
+ from either the left or the right.
+
+ When SIDE = 'L', the transformation takes the form
+
+ A := P*A
+
+ and when SIDE = 'R', the transformation takes the form
+
+ A := A*P**T
+
+ where P is an orthogonal matrix consisting of a sequence of z plane
+ rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+ and P**T is the transpose of P.
+
+ When DIRECT = 'F' (Forward sequence), then
+
+ P = P(z-1) * ... * P(2) * P(1)
+
+ and when DIRECT = 'B' (Backward sequence), then
+
+ P = P(1) * P(2) * ... * P(z-1)
+
+ where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+
+
+ R(k) = ( c(k) s(k) )
+ = ( -s(k) c(k) ).
+
+ When PIVOT = 'V' (Variable pivot), the rotation is performed
+ for the plane (k,k+1), i.e., P(k) has the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears as a rank-2 modification to the identity matrix in
+ rows and columns k and k+1.
+
+ When PIVOT = 'T' (Top pivot), the rotation is performed for the
+ plane (1,k+1), so P(k) has the form
+
+ P(k) = ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+
+ where R(k) appears in rows and columns 1 and k+1.
+
+ Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+ performed for the plane (k,z), giving P(k) the form
+
+ P(k) = ( 1 )
+ ( ... )
+ ( 1 )
+ ( c(k) s(k) )
+ ( 1 )
+ ( ... )
+ ( 1 )
+ ( -s(k) c(k) )
+
+ where R(k) appears in rows and columns k and z. The rotations are
+ performed without ever forming P(k) explicitly.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ Specifies whether the plane rotation matrix P is applied to
+ A on the left or the right.
+ = 'L': Left, compute A := P*A
+ = 'R': Right, compute A:= A*P**T
+
+ PIVOT (input) CHARACTER*1
+ Specifies the plane for which P(k) is a plane rotation
+ matrix.
+ = 'V': Variable pivot, the plane (k,k+1)
+ = 'T': Top pivot, the plane (1,k+1)
+ = 'B': Bottom pivot, the plane (k,z)
+
+ DIRECT (input) CHARACTER*1
+ Specifies whether P is a forward or backward sequence of
+ plane rotations.
+ = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+ = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
+
+ M (input) INTEGER
+ The number of rows of the matrix A. If m <= 1, an immediate
+
+ return is effected.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. If n <= 1, an
+ immediate return is effected.
+
+ C (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The cosines c(k) of the plane rotations.
+
+ S (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ The sines s(k) of the plane rotations. The 2-by-2 plane
+ rotation part of the matrix P(k), R(k), has the form
+ R(k) = ( c(k) s(k) )
+ ( -s(k) c(k) ).
+
+ A (input/output) REAL array, dimension (LDA,N)
+ The M-by-N matrix A. On exit, A is overwritten by P*A if
+ SIDE = 'R' or by A*P**T if SIDE = 'L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param pivot
+ * @param direct
+ * @param m
+ * @param n
+ * @param c
+ * @param s
+ * @param a
+ * @param lda
+ */
+ public abstract void slasr(String side, String pivot, String direct, int m, int n, float[] c, float[] s, float[] a, int lda);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ Sort the numbers in D in increasing order (if ID = 'I') or
+ in decreasing order (if ID = 'D' ).
+
+ Use Quick Sort, reverting to Insertion sort on arrays of
+ size <= 20. Dimension of STACK limits N to about 2**32.
+
+ Arguments
+ =========
+
+ ID (input) CHARACTER*1
+ = 'I': sort D in increasing order;
+ = 'D': sort D in decreasing order.
+
+ N (input) INTEGER
+ The length of the array D.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the array to be sorted.
+ On exit, D has been sorted into increasing order
+ (D(1) <= ... <= D(N) ) or into decreasing order
+ (D(1) >= ... >= D(N) ), depending on ID.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param id
+ * @param n
+ * @param d
+ * @param info
+ */
+ public abstract void slasrt(String id, int n, float[] d, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASSQ returns the values scl and smsq such that
+
+ ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+
+
+ where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+ assumed to be non-negative and scl returns the value
+
+ scl = max( scale, abs( x( i ) ) ).
+
+ scale and sumsq must be supplied in SCALE and SUMSQ and
+ scl and smsq are overwritten on SCALE and SUMSQ respectively.
+
+ The routine makes only one pass through the vector x.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of elements to be used from the vector X.
+
+ X (input) REAL array, dimension (N)
+ The vector for which a scaled sum of squares is computed.
+ x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector X.
+ INCX > 0.
+
+ SCALE (input/output) REAL
+ On entry, the value scale in the equation above.
+ On exit, SCALE is overwritten with scl , the scaling factor
+
+ for the sum of squares.
+
+ SUMSQ (input/output) REAL
+ On entry, the value sumsq in the equation above.
+ On exit, SUMSQ is overwritten with smsq , the basic sum of
+ squares from which scl has been factored out.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param x
+ * @param incx
+ * @param scale
+ * @param sumsq
+ */
+ public abstract void slassq(int n, float[] x, int incx, floatW scale, floatW sumsq);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASV2 computes the singular value decomposition of a 2-by-2
+ triangular matrix
+ [ F G ]
+ [ 0 H ].
+ On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+ smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+
+ right singular vectors for abs(SSMAX), giving the decomposition
+
+ [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+ [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+
+ Arguments
+ =========
+
+ F (input) REAL
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) REAL
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) REAL
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) REAL
+ abs(SSMIN) is the smaller singular value.
+
+ SSMAX (output) REAL
+ abs(SSMAX) is the larger singular value.
+
+ SNL (output) REAL
+ CSL (output) REAL
+ The vector (CSL, SNL) is a unit left singular vector for the
+
+ singular value abs(SSMAX).
+
+ SNR (output) REAL
+ CSR (output) REAL
+ The vector (CSR, SNR) is a unit right singular vector for the
+ singular value abs(SSMAX).
+
+ Further Details
+ ===============
+
+ Any input parameter may be aliased with any output parameter.
+
+ Barring over/underflow and assuming a guard digit in subtraction, all
+ output quantities are correct to within a few units in the last
+ place (ulps).
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param f
+ * @param g
+ * @param h
+ * @param ssmin
+ * @param ssmax
+ * @param snr
+ * @param csr
+ * @param snl
+ * @param csl
+ */
+ public abstract void slasv2(float f, float g, float h, floatW ssmin, floatW ssmax, floatW snr, floatW csr, floatW snl, floatW csl);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASWP performs a series of row interchanges on the matrix A.
+ One row interchange is initiated for each of rows K1 through K2 of A.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of columns of the matrix A.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the matrix of column dimension N to which the row
+ interchanges will be applied.
+ On exit, the permuted matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+
+ K1 (input) INTEGER
+ The first element of IPIV for which a row interchange will
+ be done.
+
+ K2 (input) INTEGER
+ The last element of IPIV for which a row interchange will
+ be done.
+
+ IPIV (input) INTEGER array, dimension (K2*abs(INCX))
+ The vector of pivot indices. Only the elements in positions
+
+ K1 through K2 of IPIV are accessed.
+ IPIV(K) = L implies rows K and L are to be interchanged.
+
+ INCX (input) INTEGER
+ The increment between successive values of IPIV. If IPIV
+ is negative, the pivots are applied in reverse order.
+
+ Further Details
+ ===============
+
+ Modified by
+ R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param k1
+ * @param k2
+ * @param ipiv
+ * @param incx
+ */
+ public abstract void slaswp(int n, float[] a, int lda, int k1, int k2, int[] ipiv, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
+
+ op(TL)*X + ISGN*X*op(TR) = SCALE*B,
+
+ where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
+
+ -1. op(T) = T or T', where T' denotes the transpose of T.
+
+ Arguments
+ =========
+
+ LTRANL (input) LOGICAL
+ On entry, LTRANL specifies the op(TL):
+ = .FALSE., op(TL) = TL,
+ = .TRUE., op(TL) = TL'.
+
+ LTRANR (input) LOGICAL
+ On entry, LTRANR specifies the op(TR):
+ = .FALSE., op(TR) = TR,
+ = .TRUE., op(TR) = TR'.
+
+ ISGN (input) INTEGER
+ On entry, ISGN specifies the sign of the equation
+ as described before. ISGN may only be 1 or -1.
+
+ N1 (input) INTEGER
+ On entry, N1 specifies the order of matrix TL.
+ N1 may only be 0, 1 or 2.
+
+ N2 (input) INTEGER
+ On entry, N2 specifies the order of matrix TR.
+ N2 may only be 0, 1 or 2.
+
+ TL (input) REAL array, dimension (LDTL,2)
+ On entry, TL contains an N1 by N1 matrix.
+
+ LDTL (input) INTEGER
+ The leading dimension of the matrix TL. LDTL >= max(1,N1).
+
+ TR (input) REAL array, dimension (LDTR,2)
+ On entry, TR contains an N2 by N2 matrix.
+
+ LDTR (input) INTEGER
+ The leading dimension of the matrix TR. LDTR >= max(1,N2).
+
+ B (input) REAL array, dimension (LDB,2)
+ On entry, the N1 by N2 matrix B contains the right-hand
+ side of the equation.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1,N1).
+
+ SCALE (output) REAL
+ On exit, SCALE contains the scale factor. SCALE is chosen
+ less than or equal to 1 to prevent the solution overflowing.
+
+
+ X (output) REAL array, dimension (LDX,2)
+ On exit, X contains the N1 by N2 solution.
+
+ LDX (input) INTEGER
+ The leading dimension of the matrix X. LDX >= max(1,N1).
+
+ XNORM (output) REAL
+ On exit, XNORM is the infinity-norm of the solution.
+
+ INFO (output) INTEGER
+ On exit, INFO is set to
+ 0: successful exit.
+ 1: TL and TR have too close eigenvalues, so TL or
+ TR is perturbed to get a nonsingular equation.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param ltranl
+ * @param ltranr
+ * @param isgn
+ * @param n1
+ * @param n2
+ * @param tl
+ * @param ldtl
+ * @param tr
+ * @param ldtr
+ * @param b
+ * @param ldb
+ * @param scale
+ * @param x
+ * @param ldx
+ * @param xnorm
+ * @param info
+ */
+ public abstract void slasy2(boolean ltranl, boolean ltranr, int isgn, int n1, int n2, float[] tl, int ldtl, float[] tr, int ldtr, float[] b, int ldb, floatW scale, float[] x, int ldx, floatW xnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLASYF computes a partial factorization of a real symmetric matrix A
+
+ using the Bunch-Kaufman diagonal pivoting method. The partial
+ factorization has the form:
+
+ A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
+ ( 0 U22 ) ( 0 D ) ( U12' U22' )
+
+ A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L'
+ ( L21 I ) ( 0 A22 ) ( 0 I )
+
+ where the order of D is at most NB. The actual order is returned in
+ the argument KB, and is either NB or NB-1, or N if N <= NB.
+
+ SLASYF is an auxiliary routine called by SSYTRF. It uses blocked code
+ (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
+ A22 (if UPLO = 'L').
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NB (input) INTEGER
+ The maximum number of columns of the matrix A that should be
+
+ factored. NB should be at least 2 to allow for 2-by-2 pivot
+
+ blocks.
+
+ KB (output) INTEGER
+ The number of columns of A that were actually factored.
+ KB is either NB-1 or NB, or N if N <= NB.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, A contains details of the partial factorization.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If UPLO = 'U', only the last KB elements of IPIV are set;
+ if UPLO = 'L', only the first KB elements are set.
+
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ W (workspace) REAL array, dimension (LDW,NB)
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nb
+ * @param kb
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param w
+ * @param ldw
+ * @param info
+ */
+ public abstract void slasyf(String uplo, int n, int nb, intW kb, float[] a, int lda, int[] ipiv, float[] w, int ldw, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATBS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular band matrix. Here A' denotes the transpose of A, x and b
+
+ are n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine STBSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of subdiagonals or superdiagonals in the
+ triangular matrix A. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first KD+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ X (input/output) REAL array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) REAL
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) REAL array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, STBSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine STBSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call STBSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param normin
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param x
+ * @param scale
+ * @param cnorm
+ * @param info
+ */
+ public abstract void slatbs(String uplo, String trans, String diag, String normin, int n, int kd, float[] ab, int ldab, float[] x, floatW scale, float[] cnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATDF uses the LU factorization of the n-by-n matrix Z computed by
+ SGETC2 and computes a contribution to the reciprocal Dif-estimate
+ by solving Z * x = b for x, and choosing the r.h.s. b such that
+ the norm of x is as large as possible. On entry RHS = b holds the
+ contribution from earlier solved sub-systems, and on return RHS = x.
+
+
+ The factorization of Z returned by SGETC2 has the form Z = P*L*U*Q,
+ where P and Q are permutation matrices. L is lower triangular with
+ unit diagonal elements and U is upper triangular.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ IJOB = 2: First compute an approximative null-vector e
+ of Z using SGECON, e is normalized and solve for
+ Zx = +-e - f with the sign giving the greater value
+ of 2-norm(x). About 5 times as expensive as Default.
+ IJOB .ne. 2: Local look ahead strategy where all entries of
+ the r.h.s. b is choosen as either +1 or -1 (Default).
+
+ N (input) INTEGER
+ The number of columns of the matrix Z.
+
+ Z (input) REAL array, dimension (LDZ, N)
+ On entry, the LU part of the factorization of the n-by-n
+ matrix Z computed by SGETC2: Z = P * L * U * Q
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDA >= max(1, N).
+
+ RHS (input/output) REAL array, dimension N.
+ On entry, RHS contains contributions from other subsystems.
+ On exit, RHS contains the solution of the subsystem with
+ entries acoording to the value of IJOB (see above).
+
+ RDSUM (input/output) REAL
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by STGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when STGSY2 is called by STGSYL.
+
+ RDSCAL (input/output) REAL
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when STGSY2 is called by
+ STGSYL.
+
+ IPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= i <= N, row i of the
+ matrix has been interchanged with row IPIV(i).
+
+ JPIV (input) INTEGER array, dimension (N).
+ The pivot indices; for 1 <= j <= N, column j of the
+ matrix has been interchanged with column JPIV(j).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ This routine is a further developed implementation of algorithm
+ BSOLVE in [1] using complete pivoting in the LU factorization.
+
+ [1] Bo Kagstrom and Lars Westin,
+ Generalized Schur Methods with Condition Estimators for
+ Solving the Generalized Sylvester Equation, IEEE Transactions
+ on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
+
+ [2] Peter Poromaa,
+ On Efficient and Robust Estimators for the Separation
+ between two Regular Matrix Pairs with Applications in
+ Condition Estimation. Report IMINF-95.05, Departement of
+ Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param ijob
+ * @param n
+ * @param z
+ * @param ldz
+ * @param rhs
+ * @param rdsum
+ * @param rdscal
+ * @param ipiv
+ * @param jpiv
+ */
+ public abstract void slatdf(int ijob, int n, float[] z, int ldz, float[] rhs, floatW rdsum, floatW rdscal, int[] ipiv, int[] jpiv);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATPS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow, where A is an upper or lower
+ triangular matrix stored in packed form. Here A' denotes the
+ transpose of A, x and b are n-element vectors, and s is a scaling
+ factor, usually less than or equal to 1, chosen so that the
+ components of x will be less than the overflow threshold. If the
+ unscaled problem will not cause overflow, the Level 2 BLAS routine
+ STPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
+ then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ X (input/output) REAL array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) REAL
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) REAL array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, STPSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine STPSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call STPSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param normin
+ * @param n
+ * @param ap
+ * @param x
+ * @param scale
+ * @param cnorm
+ * @param info
+ */
+ public abstract void slatps(String uplo, String trans, String diag, String normin, int n, float[] ap, float[] x, floatW scale, float[] cnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATRD reduces NB rows and columns of a real symmetric matrix A to
+ symmetric tridiagonal form by an orthogonal similarity
+ transformation Q' * A * Q, and returns the matrices V and W which are
+ needed to apply the transformation to the unreduced part of A.
+
+ If UPLO = 'U', SLATRD reduces the last NB rows and columns of a
+ matrix, of which the upper triangle is supplied;
+ if UPLO = 'L', SLATRD reduces the first NB rows and columns of a
+ matrix, of which the lower triangle is supplied.
+
+ This is an auxiliary routine called by SSYTRD.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NB (input) INTEGER
+ The number of rows and columns to be reduced.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit:
+ if UPLO = 'U', the last NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements above the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+
+ product of elementary reflectors;
+ if UPLO = 'L', the first NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements below the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= (1,N).
+
+ E (output) REAL array, dimension (N-1)
+ If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+ elements of the last NB columns of the reduced matrix;
+ if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+ the first NB columns of the reduced matrix.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors, stored in
+ TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+
+ See Further Details.
+
+ W (output) REAL array, dimension (LDW,NB)
+ The n-by-nb matrix W required to update the unreduced part
+ of A.
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n) H(n-1) . . . H(n-nb+1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+
+ and tau in TAU(i-1).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+
+ and tau in TAU(i).
+
+ The elements of the vectors v together form the n-by-nb matrix V
+ which is needed, with W, to apply the transformation to the unreduced
+ part of the matrix, using a symmetric rank-2k update of the form:
+ A := A - V*W' - W*V'.
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5 and nb = 2:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( a a a v4 v5 ) ( d )
+ ( a a v4 v5 ) ( 1 d )
+ ( a 1 v5 ) ( v1 1 a )
+ ( d 1 ) ( v1 v2 a a )
+ ( d ) ( v1 v2 a a a )
+
+ where d denotes a diagonal element of the reduced matrix, a denotes
+ an element of the original matrix that is unchanged, and vi denotes
+ an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nb
+ * @param a
+ * @param lda
+ * @param e
+ * @param tau
+ * @param w
+ * @param ldw
+ */
+ public abstract void slatrd(String uplo, int n, int nb, float[] a, int lda, float[] e, float[] tau, float[] w, int ldw);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATRS solves one of the triangular systems
+
+ A *x = s*b or A'*x = s*b
+
+ with scaling to prevent overflow. Here A is an upper or lower
+ triangular matrix, A' denotes the transpose of A, x and b are
+ n-element vectors, and s is a scaling factor, usually less than
+ or equal to 1, chosen so that the components of x will be less than
+ the overflow threshold. If the unscaled problem will not cause
+ overflow, the Level 2 BLAS routine STRSV is called. If the matrix A
+
+ is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+ non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A'* x = s*b (Transpose)
+ = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max (1,N).
+
+ X (input/output) REAL array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) REAL
+ The scaling factor s for the triangular system
+ A * x = s*b or A'* x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+
+ CNORM (input or output) REAL array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, STRSV
+
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine STRSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+ algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call STRSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param normin
+ * @param n
+ * @param a
+ * @param lda
+ * @param x
+ * @param scale
+ * @param cnorm
+ * @param info
+ */
+ public abstract void slatrs(String uplo, String trans, String diag, String normin, int n, float[] a, int lda, float[] x, floatW scale, float[] cnorm, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
+ [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means
+ of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal
+ matrix and, R and A1 are M-by-M upper triangular matrices.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing the
+ meaningful part of the Householder vectors. N-M >= L >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements N-L+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace) REAL array, dimension (M)
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an l element vector. tau and z( k )
+ are chosen to annihilate the elements of the kth row of A2.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A2, such that the elements of z( k ) are
+ in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A1.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param l
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ */
+ public abstract void slatrz(int m, int n, int l, float[] a, int lda, float[] tau, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine SORMRZ.
+
+ SLATZM applies a Householder matrix generated by STZRQF to a matrix.
+
+
+ Let P = I - tau*u*u', u = ( 1 ),
+ ( v )
+ where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
+ SIDE = 'R'.
+
+ If SIDE equals 'L', let
+ C = [ C1 ] 1
+ [ C2 ] m-1
+ n
+ Then C is overwritten by P*C.
+
+ If SIDE equals 'R', let
+ C = [ C1, C2 ] m
+ 1 n-1
+ Then C is overwritten by C*P.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form P * C
+ = 'R': form C * P
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) REAL array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of P. V is not used
+ if TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0
+
+ TAU (input) REAL
+ The value tau in the representation of P.
+
+ C1 (input/output) REAL array, dimension
+ (LDC,N) if SIDE = 'L'
+ (M,1) if SIDE = 'R'
+ On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
+ if SIDE = 'R'.
+
+ On exit, the first row of P*C if SIDE = 'L', or the first
+ column of C*P if SIDE = 'R'.
+
+ C2 (input/output) REAL array, dimension
+ (LDC, N) if SIDE = 'L'
+ (LDC, N-1) if SIDE = 'R'
+ On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
+ m x (n - 1) matrix C2 if SIDE = 'R'.
+
+ On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
+ if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the arrays C1 and C2. LDC >= (1,M).
+
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param m
+ * @param n
+ * @param v
+ * @param incv
+ * @param tau
+ * @param c1
+ * @param c2
+ * @param Ldc
+ * @param work
+ */
+ public abstract void slatzm(String side, int m, int n, float[] v, int incv, float tau, float[] c1, float[] c2, int Ldc, float[] work);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAUU2 computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the unblocked form of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void slauu2(String uplo, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAUUM computes the product U * U' or L' * L, where the triangular
+ factor U or L is stored in the upper or lower triangular part of
+ the array A.
+
+ If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
+ overwriting the factor U in A.
+ If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
+ overwriting the factor L in A.
+
+ This is the blocked form of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the triangular factor stored in the array A
+ is upper or lower triangular:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the triangular factor U or L. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular factor U or L.
+ On exit, if UPLO = 'U', the upper triangle of A is
+ overwritten with the upper triangle of the product U * U';
+ if UPLO = 'L', the lower triangle of A is overwritten with
+ the lower triangle of the product L' * L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void slauum(String uplo, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAZQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) REAL
+ Minimum value of d.
+
+ SIGMA (output) REAL
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) REAL
+ Lower order part of SIGMA
+
+ QMAX (input) REAL
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to SLASQ5).
+
+ TTYPE (input/output) INTEGER
+ Shift type. TTYPE is passed as an argument in order to save
+ its value between calls to SLAZQ3
+
+ DMIN1 (input/output) REAL
+ DMIN2 (input/output) REAL
+ DN (input/output) REAL
+ DN1 (input/output) REAL
+ DN2 (input/output) REAL
+ TAU (input/output) REAL
+ These are passed as arguments in order to save their values
+ between calls to SLAZQ3
+
+ This is a thread safe version of SLASQ3, which passes TTYPE, DMIN1,
+ DMIN2, DN, DN1. DN2 and TAU through the argument list in place of
+ declaring them in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param dmin
+ * @param sigma
+ * @param desig
+ * @param qmax
+ * @param nfail
+ * @param iter
+ * @param ndiv
+ * @param ieee
+ * @param ttype
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dn1
+ * @param dn2
+ * @param tau
+ */
+ public void slazq3(int i0, intW n0, float[] z, int pp, floatW dmin, floatW sigma, floatW desig, floatW qmax, intW nfail, intW iter, intW ndiv, boolean ieee, intW ttype, floatW dmin1, floatW dmin2, floatW dn, floatW dn1, floatW dn2, floatW tau) {
+ org.netlib.lapack.Slazq3.slazq3(i0, n0, z, 0, pp, dmin, sigma, desig, qmax, nfail, iter, ndiv, ieee, ttype, dmin1, dmin2, dn, dn1, dn2, tau);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAZQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) REAL array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ N0IN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) REAL
+ Minimum value of d.
+
+ DMIN1 (input) REAL
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) REAL
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) REAL
+ d(N)
+
+ DN1 (input) REAL
+ d(N-1)
+
+ DN2 (input) REAL
+ d(N-2)
+
+ TAU (output) REAL
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ G (input/output) REAL
+ G is passed as an argument in order to save its value between
+ calls to SLAZQ4
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ This is a thread safe version of SLASQ4, which passes G through the
+ argument list in place of declaring G in a SAVE statment.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param i0
+ * @param n0
+ * @param z
+ * @param pp
+ * @param n0in
+ * @param dmin
+ * @param dmin1
+ * @param dmin2
+ * @param dn
+ * @param dn1
+ * @param dn2
+ * @param tau
+ * @param ttype
+ * @param g
+ */
+ public void slazq4(int i0, int n0, float[] z, int pp, int n0in, float dmin, float dmin1, float dmin2, float dn, float dn1, float dn2, floatW tau, intW ttype, floatW g) {
+ org.netlib.lapack.Slazq4.slazq4(i0, n0, z, 0, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, tau, ttype, g);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SOPGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors H(i) of order n, as returned by
+
+ SSPTRD using packed storage:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to SSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to SSPTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The vectors which define the elementary reflectors, as
+ returned by SSPTRD.
+
+ TAU (input) REAL array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSPTRD.
+
+ Q (output) REAL array, dimension (LDQ,N)
+ The N-by-N orthogonal matrix Q.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (N-1)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param tau
+ * @param q
+ * @param ldq
+ * @param work
+ * @param info
+ */
+ public abstract void sopgtr(String uplo, int n, float[] ap, float[] tau, float[] q, int ldq, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SOPMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by SSPTRD using packed
+ storage:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular packed storage used in previous
+ call to SSPTRD;
+ = 'L': Lower triangular packed storage used in previous
+ call to SSPTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ AP (input) REAL array, dimension
+ (M*(M+1)/2) if SIDE = 'L'
+ (N*(N+1)/2) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by SSPTRD. AP is modified by the routine but
+ restored on exit.
+
+ TAU (input) REAL array, dimension (M-1) if SIDE = 'L'
+ or (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSPTRD.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L'
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param trans
+ * @param m
+ * @param n
+ * @param ap
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sopmtr(String side, String uplo, String trans, int m, int n, float[] ap, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORG2L generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the last n columns of a product of k elementary
+ reflectors of order m
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQLF in the last k columns of its array
+ argument A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sorg2l(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORG2R generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the first n columns of a product of k elementary
+
+ reflectors of order m
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQRF in the first k columns of its array
+ argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sorg2r(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGBR generates one of the real orthogonal matrices Q or P**T
+ determined by SGEBRD when reducing a real matrix A to bidiagonal
+ form: A = Q * B * P**T. Q and P**T are defined as products of
+ elementary reflectors H(i) or G(i) respectively.
+
+ If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
+ is of order M:
+ if m >= k, Q = H(1) H(2) . . . H(k) and SORGBR returns the first n
+ columns of Q, where m >= n >= k;
+ if m < k, Q = H(1) H(2) . . . H(m-1) and SORGBR returns Q as an
+ M-by-M matrix.
+
+ If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
+ is of order N:
+ if k < n, P**T = G(k) . . . G(2) G(1) and SORGBR returns the first m
+
+ rows of P**T, where n >= m >= k;
+ if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as
+ an N-by-N matrix.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether the matrix Q or the matrix P**T is
+ required, as defined in the transformation applied by SGEBRD:
+ = 'Q': generate Q;
+ = 'P': generate P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix Q or P**T to be returned.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q or P**T to be returned.
+ N >= 0.
+ If VECT = 'Q', M >= N >= min(M,K);
+ if VECT = 'P', N >= M >= min(N,K).
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original M-by-K
+ matrix reduced by SGEBRD.
+ If VECT = 'P', the number of rows in the original K-by-N
+ matrix reduced by SGEBRD.
+ K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by SGEBRD.
+ On exit, the M-by-N matrix Q or P**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension
+ (min(M,K)) if VECT = 'Q'
+ (min(N,K)) if VECT = 'P'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i), which determines Q or P**T, as
+ returned by SGEBRD in its array argument TAUQ or TAUP.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,min(M,N)).
+ For optimum performance LWORK >= min(M,N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorgbr(String vect, int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGHR generates a real orthogonal matrix Q which is defined as the
+ product of IHI-ILO elementary reflectors of order N, as returned by
+ SGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of SGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by SGEHRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEHRD.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= IHI-ILO.
+ For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorghr(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGL2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the first m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by SGELQF in the first k rows of its array argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sorgl2(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGLQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the first M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by SGELQF in the first k rows of its array argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorglq(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGQL generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the last N columns of a product of K elementary
+ reflectors of order M
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (n-k+i)-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQLF in the last k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorgql(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGQR generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the first N columns of a product of K elementary
+
+ reflectors of order M
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGEQRF in the first k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorgqr(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGR2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the last m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGERQF in the last k rows of its array argument
+ A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ WORK (workspace) REAL array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param info
+ */
+ public abstract void sorgr2(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGRQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the last M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the (m-k+i)-th row must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+
+ returned by SGERQF in the last k rows of its array argument
+ A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorgrq(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORGTR generates a real orthogonal matrix Q which is defined as the
+ product of n-1 elementary reflectors of order N, as returned by
+ SSYTRD:
+
+ if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from SSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from SSYTRD.
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by SSYTRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSYTRD.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N-1).
+ For optimum performance LWORK >= (N-1)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sorgtr(String uplo, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORM2L overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sorm2l(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORM2R overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sorm2r(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ If VECT = 'Q', SORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ If VECT = 'P', SORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': P * C C * P
+ TRANS = 'T': P**T * C C * P**T
+
+ Here Q and P**T are the orthogonal matrices determined by SGEBRD when
+ reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
+
+ P**T are defined as products of elementary reflectors H(i) and G(i)
+ respectively.
+
+ Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
+ order of the orthogonal matrix Q or P**T that is applied.
+
+ If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
+ if nq >= k, Q = H(1) H(2) . . . H(k);
+ if nq < k, Q = H(1) H(2) . . . H(nq-1).
+
+ If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
+ if k < nq, P = G(1) G(2) . . . G(k);
+ if k >= nq, P = G(1) G(2) . . . G(nq-1).
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'Q': apply Q or Q**T;
+ = 'P': apply P or P**T.
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q, Q**T, P or P**T from the Left;
+ = 'R': apply Q, Q**T, P or P**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q or P;
+ = 'T': Transpose, apply Q**T or P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original
+ matrix reduced by SGEBRD.
+ If VECT = 'P', the number of rows in the original
+ matrix reduced by SGEBRD.
+ K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,min(nq,K)) if VECT = 'Q'
+ (LDA,nq) if VECT = 'P'
+ The vectors which define the elementary reflectors H(i) and
+ G(i), whose products determine the matrices Q and P, as
+ returned by SGEBRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If VECT = 'Q', LDA >= max(1,nq);
+ if VECT = 'P', LDA >= max(1,min(nq,K)).
+
+ TAU (input) REAL array, dimension (min(nq,K))
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i) which determines Q or P, as returned
+ by SGEBRD in the array argument TAUQ or TAUP.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
+ or P*C or P**T*C or C*P or C*P**T.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param vect
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormbr(String vect, String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMHR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ IHI-ILO elementary reflectors, as returned by SGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of SGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
+ ILO = 1 and IHI = 0, if M = 0;
+ if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
+ ILO = 1 and IHI = 0, if N = 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by SGEHRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEHRD.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param ilo
+ * @param ihi
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormhr(String side, String trans, int m, int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORML2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sorml2(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMLQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGELQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGELQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormlq(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMQL overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by SGEQLF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQLF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormql(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMQR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGEQRF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormqr(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMR2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sormr2(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMR3 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ STZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by STZRZF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) REAL array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param info
+ */
+ public abstract void sormr3(String side, String trans, int m, int n, int k, int l, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMRQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by SGERQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ SGERQF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SGERQF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormrq(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMRZ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ L (input) INTEGER
+ The number of columns of the matrix A containing
+ the meaningful part of the Householder reflectors.
+ If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+
+ STZRZF in the last k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) REAL array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by STZRZF.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param trans
+ * @param m
+ * @param n
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormrz(String side, String trans, int m, int n, int k, int l, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SORMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by SSYTRD:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from SSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from SSYTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ A (input) REAL array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by SSYTRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) REAL array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by SSYTRD.
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param side
+ * @param uplo
+ * @param trans
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param c
+ * @param Ldc
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void sormtr(String side, String uplo, String trans, int m, int n, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite band matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by SPBTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ ANORM (input) REAL
+ The 1-norm (or infinity-norm) of the symmetric band matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void spbcon(String uplo, int n, int kd, float[] ab, int ldab, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite band matrix A and reduce its condition
+ number (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular of A is stored;
+ = 'L': Lower triangular of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ S (output) REAL array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) REAL
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param s
+ * @param scond
+ * @param amax
+ * @param info
+ */
+ public abstract void spbequ(String uplo, int n, int kd, float[] ab, int ldab, float[] s, floatW scond, floatW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and banded, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangle of the symmetric band matrix A,
+ stored in the first KD+1 rows of the array. The j-th column
+
+ of A is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ AFB (input) REAL array, dimension (LDAFB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A as computed by
+
+ SPBTRF, in the same storage format as A (see AB).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPBTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void spbrfs(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBSTF computes a split Cholesky factorization of a real
+ symmetric positive definite band matrix A.
+
+ This routine is designed to be used in conjunction with SSBGST.
+
+ The factorization has the form A = S**T*S where S is a band matrix
+
+ of the same bandwidth as A and the following structure:
+
+ S = ( U )
+ ( M L )
+
+ where U is upper triangular of order m = (n+kd)/2, and L is lower
+ triangular of order n-m.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first kd+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the factor S from the split Cholesky
+ factorization A = S**T*S. See Further Details.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the factorization could not be completed,
+ because the updated element a(i,i) was negative; the
+ matrix A is not positive definite.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 7, KD = 2:
+
+ S = ( s11 s12 s13 )
+ ( s22 s23 s24 )
+ ( s33 s34 )
+ ( s44 )
+ ( s53 s54 s55 )
+ ( s64 s65 s66 )
+ ( s75 s76 s77 )
+
+ If UPLO = 'U', the array AB holds:
+
+ on entry: on exit:
+
+ * * a13 a24 a35 a46 a57 * * s13 s24 s53 s64 s75
+
+ * a12 a23 a34 a45 a56 a67 * s12 s23 s34 s54 s65 s76
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+
+ If UPLO = 'L', the array AB holds:
+
+ on entry: on exit:
+
+ a11 a22 a33 a44 a55 a66 a77 s11 s22 s33 s44 s55 s66 s77
+
+ a21 a32 a43 a54 a65 a76 * s12 s23 s34 s54 s65 s76 *
+ a31 a42 a53 a64 a64 * * s13 s24 s53 s64 s75 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param info
+ */
+ public abstract void spbstf(String uplo, int n, int kd, float[] ab, int ldab, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix, with the same number of superdiagonals or
+ subdiagonals as A. The factored form of A is then used to solve the
+
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * * a13 a24 a35 a46 * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void spbsv(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite band matrix and X
+ and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular band matrix, and L is a lower
+ triangular band matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFB contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AB and AFB will not
+ be modified.
+ = 'N': The matrix A will be copied to AFB and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFB and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right-hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array, except
+
+ if FACT = 'F' and EQUED = 'Y', then A must contain the
+ equilibrated matrix diag(S)*A*diag(S). The j-th column of A
+
+ is stored in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).
+ See below for further details.
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDAB (input) INTEGER
+ The leading dimension of the array A. LDAB >= KD+1.
+
+ AFB (input or output) REAL array, dimension (LDAFB,N)
+ If FACT = 'F', then AFB is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the band matrix
+ A, in the same storage format as A (see AB). If EQUED = 'Y',
+ then AFB is the factored form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ If FACT = 'E', then AFB is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAFB (input) INTEGER
+ The leading dimension of the array AFB. LDAFB >= KD+1.
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) REAL array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13
+ a22 a23 a24
+ a33 a34 a35
+ a44 a45 a46
+ a55 a56
+ (aij=conjg(aji)) a66
+
+ Band storage of the upper triangle of A:
+
+ * * a13 a24 a35 a46
+ * a12 a23 a34 a45 a56
+ a11 a22 a33 a44 a55 a66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ a11 a22 a33 a44 a55 a66
+ a21 a32 a43 a54 a65 *
+ a31 a42 a53 a64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param afb
+ * @param ldafb
+ * @param equed
+ * @param s
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void spbsvx(String fact, String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBTF2 computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix, U' is the transpose of U, and
+
+ L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of super-diagonals of the matrix A if UPLO = 'U',
+
+ or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U'*U or A = L*L' of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * * a13 a24 a35 a46 * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param info
+ */
+ public abstract void spbtf2(String uplo, int n, int kd, float[] ab, int ldab, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBTRF computes the Cholesky factorization of a real symmetric
+ positive definite band matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T of the band
+ matrix A, in the same storage format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ===============
+
+ The band storage scheme is illustrated by the following example, when
+ N = 6, KD = 2, and UPLO = 'U':
+
+ On entry: On exit:
+
+ * * a13 a24 a35 a46 * * u13 u24 u35 u46
+ * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
+ a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
+
+ Similarly, if UPLO = 'L' the format of A is as follows:
+
+ On entry: On exit:
+
+ a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66
+ a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 *
+ a31 a42 a53 a64 * * l31 l42 l53 l64 * *
+
+ Array elements marked * are not used by the routine.
+
+ Contributed by
+ Peter Mayes and Giuseppe Radicati, IBM ECSEC, Rome, March 23, 1989
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param info
+ */
+ public abstract void spbtrf(String uplo, int n, int kd, float[] ab, int ldab, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPBTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite band matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by SPBTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor stored in AB;
+ = 'L': Lower triangular factor stored in AB.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T of the band matrix A, stored in the
+
+ first KD+1 rows of the array. The j-th column of U or L is
+ stored in the j-th column of the array AB as follows:
+ if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
+
+ if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd).
+
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void spbtrs(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite matrix using the
+ Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ANORM (input) REAL
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void spocon(String uplo, int n, float[] a, int lda, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A and reduce its condition number
+
+ (with respect to the two-norm). S contains the scale factors,
+ S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
+ elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
+ choice of S puts the condition number of B within a factor N of the
+ smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The N-by-N symmetric positive definite matrix whose scaling
+ factors are to be computed. Only the diagonal elements of A
+
+ are referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ S (output) REAL array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) REAL
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param a
+ * @param lda
+ * @param s
+ * @param scond
+ * @param amax
+ * @param info
+ */
+ public abstract void spoequ(int n, float[] a, int lda, float[] s, floatW scond, floatW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPORFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite,
+ and provides error bounds and backward error estimates for the
+ solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) REAL array, dimension (LDAF,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPOTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPOTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sporfs(String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sposv(String uplo, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix and X and B
+ are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AF contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. A and AF will not
+ be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A, except if FACT = 'F' and
+ EQUED = 'Y', then A must contain the equilibrated matrix
+ diag(S)*A*diag(S). If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) REAL array, dimension (LDAF,N)
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A. If EQUED .ne. 'N', then AF is the factored form
+ of the equilibrated matrix diag(S)*A*diag(S).
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the original
+ matrix A.
+
+ If FACT = 'E', then AF is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T of the equilibrated
+ matrix A (see the description of A for the form of the
+ equilibrated matrix).
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) REAL array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param equed
+ * @param s
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sposvx(String fact, String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTF2 computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void spotf2(String uplo, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the block version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void spotrf(String uplo, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by SPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, as computed by
+ SPOTRF.
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void spotri(String uplo, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPOTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A using the Cholesky factorization
+ A = U**T*U or A = L*L**T computed by SPOTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPOTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void spotrs(String uplo, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite packed matrix using
+ the Cholesky factorization A = U**T*U or A = L*L**T computed by
+ SPPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ ANORM (input) REAL
+ The 1-norm (or infinity-norm) of the symmetric matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sppcon(String uplo, int n, float[] ap, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPEQU computes row and column scalings intended to equilibrate a
+ symmetric positive definite matrix A in packed storage and reduce
+ its condition number (with respect to the two-norm). S contains the
+
+ scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
+
+ B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
+ This choice of S puts the condition number of B within a factor N of
+
+ the smallest possible condition number over all possible diagonal
+ scalings.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ S (output) REAL array, dimension (N)
+ If INFO = 0, S contains the scale factors for A.
+
+ SCOND (output) REAL
+ If INFO = 0, S contains the ratio of the smallest S(i) to
+ the largest S(i). If SCOND >= 0.1 and AMAX is neither too
+ large nor too small, it is not worth scaling by S.
+
+ AMAX (output) REAL
+ Absolute value of largest matrix element. If AMAX is very
+ close to overflow or very close to underflow, the matrix
+ should be scaled.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element is nonpositive.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param s
+ * @param scond
+ * @param amax
+ * @param info
+ */
+ public abstract void sppequ(String uplo, int n, float[] ap, float[] s, floatW scond, floatW amax, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ AFP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, as computed by SPPTRF/CPPTRF,
+ packed columnwise in a linear array in the same format as A
+ (see AP).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void spprfs(String uplo, int n, int nrhs, float[] ap, float[] afp, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ The Cholesky decomposition is used to factor A as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+ matrix. The factored form of A is then used to solve the system of
+ equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, in the same storage
+ format as A.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i of A is not
+ positive definite, so the factorization could not be
+ completed, and the solution has not been computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sppsv(String uplo, int n, int nrhs, float[] ap, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to
+ compute the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric positive definite matrix stored in
+ packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'E', real scaling factors are computed to equilibrate
+ the system:
+ diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
+ Whether or not the system will be equilibrated depends on the
+ scaling of the matrix A, but if equilibration is used, A is
+ overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
+
+ 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
+ factor the matrix A (after equilibration if FACT = 'E') as
+ A = U**T* U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is a lower triangular
+
+ matrix.
+
+ 3. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 4. The system of equations is solved for X using the factored form
+ of A.
+
+ 5. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ 6. If equilibration was used, the matrix X is premultiplied by
+ diag(S) so that it solves the original system before
+ equilibration.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of the matrix A is
+ supplied on entry, and if not, whether the matrix A should be
+ equilibrated before it is factored.
+ = 'F': On entry, AFP contains the factored form of A.
+ If EQUED = 'Y', the matrix A has been equilibrated
+ with scaling factors given by S. AP and AFP will not
+ be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+ = 'E': The matrix A will be equilibrated if necessary, then
+
+ copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array, except if FACT = 'F'
+
+ and EQUED = 'Y', then A must contain the equilibrated matrix
+
+ diag(S)*A*diag(S). The j-th column of A is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details. A is not modified if
+ FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
+
+
+ On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
+ diag(S)*A*diag(S).
+
+ AFP (input or output) REAL array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L', in the same storage
+ format as A. If EQUED .ne. 'N', then AFP is the factored
+ form of the equilibrated matrix A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the original matrix A.
+
+
+ If FACT = 'E', then AFP is an output argument and on exit
+ returns the triangular factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L' of the equilibrated
+ matrix A (see the description of AP for the form of the
+ equilibrated matrix).
+
+ EQUED (input or output) CHARACTER*1
+ Specifies the form of equilibration that was done.
+ = 'N': No equilibration (always true if FACT = 'N').
+ = 'Y': Equilibration was done, i.e., A has been replaced by
+
+ diag(S) * A * diag(S).
+ EQUED is an input argument if FACT = 'F'; otherwise, it is an
+ output argument.
+
+ S (input or output) REAL array, dimension (N)
+ The scale factors for A; not accessed if EQUED = 'N'. S is
+ an input argument if FACT = 'F'; otherwise, S is an output
+ argument. If FACT = 'F' and EQUED = 'Y', each element of S
+ must be positive.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
+ B is overwritten by diag(S) * B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
+ the original system of equations. Note that if EQUED = 'Y',
+
+ A and B are modified on exit, and the solution to the
+ equilibrated system is inv(diag(S))*X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A after equilibration (if done). If RCOND is less than the
+ machine precision (in particular, if RCOND = 0), the matrix
+ is singular to working precision. This condition is
+ indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = conjg(aji))
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param equed
+ * @param s
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sppsvx(String fact, String uplo, int n, int nrhs, float[] ap, float[] afp, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A stored in packed format.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, if INFO = 0, the triangular factor U or L from the
+ Cholesky factorization A = U**T*U or A = L*L**T, in the same
+
+ storage format as A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ Further Details
+ ======= =======
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param info
+ */
+ public abstract void spptrf(String uplo, int n, float[] ap, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPTRI computes the inverse of a real symmetric positive definite
+ matrix A using the Cholesky factorization A = U**T*U or A = L*L**T
+ computed by SPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangular factor is stored in AP;
+ = 'L': Lower triangular factor is stored in AP.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the triangular factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T, packed columnwise as
+
+ a linear array. The j-th column of U or L is stored in the
+ array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ On exit, the upper or lower triangle of the (symmetric)
+ inverse of A, overwriting the input factor U or L.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the (i,i) element of the factor U or L is
+
+ zero, and the inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param info
+ */
+ public abstract void spptri(String uplo, int n, float[] ap, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPPTRS solves a system of linear equations A*X = B with a symmetric
+ positive definite matrix A in packed storage using the Cholesky
+ factorization A = U**T*U or A = L*L**T computed by SPPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor U or L from the Cholesky factorization
+
+ A = U**T*U or A = L*L**T, packed columnwise in a linear
+ array. The j-th column of U or L is stored in the array AP
+ as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void spptrs(String uplo, int n, int nrhs, float[] ap, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTCON computes the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric positive definite tridiagonal matrix
+ using the factorization A = L*D*L**T or A = U**T*D*U computed by
+ SPTTRF.
+
+ Norm(inv(A)) is computed by a direct method, and the reciprocal of
+ the condition number is computed as
+ RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization of A, as computed by SPTTRF.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) off-diagonal elements of the unit bidiagonal factor
+ U or L from the factorization of A, as computed by SPTTRF.
+
+ ANORM (input) REAL
+ The 1-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
+ 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The method used is described in Nicholas J. Higham, "Efficient
+ Algorithms for Computing the Condition Number of a Tridiagonal
+ Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param info
+ */
+ public abstract void sptcon(int n, float[] d, float[] e, float anorm, floatW rcond, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric positive definite tridiagonal matrix by first factoring the
+ matrix using SPTTRF, and then calling SBDSQR to compute the singular
+
+ values of the bidiagonal factor.
+
+ This routine computes the eigenvalues of the positive definite
+ tridiagonal matrix to high relative accuracy. This means that if the
+ eigenvalues range over many orders of magnitude in size, then the
+ small eigenvalues and corresponding eigenvectors will be computed
+ more accurately than, for example, with the standard QR method.
+
+ The eigenvectors of a full or band symmetric positive definite matrix
+ can also be found if SSYTRD, SSPTRD, or SSBTRD has been used to
+ reduce this matrix to tridiagonal form. (The reduction to tridiagonal
+ form, however, may preclude the possibility of obtaining high
+ relative accuracy in the small eigenvalues of the original matrix, if
+ these eigenvalues range over many orders of magnitude.)
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvectors of original symmetric
+ matrix also. Array Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal
+ matrix.
+ On normal exit, D contains the eigenvalues, in descending
+ order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', the orthogonal matrix used in the
+ reduction to tridiagonal form.
+ On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
+
+ original symmetric matrix;
+ if COMPZ = 'I', the orthonormal eigenvectors of the
+ tridiagonal matrix.
+ If INFO > 0 on exit, Z contains the eigenvectors associated
+ with only the stored eigenvalues.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ COMPZ = 'V' or 'I', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, and i is:
+ <= N the Cholesky factorization of the matrix could
+ not be performed because the i-th principal minor
+ was not positive definite.
+ > N the SVD algorithm failed to converge;
+ if INFO = N+i, i off-diagonal elements of the
+ bidiagonal factor did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void spteqr(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric positive definite
+
+ and tridiagonal, and provides error bounds and backward error
+ estimates for the solution.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ factorization computed by SPTTRF.
+
+ EF (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the factorization computed by SPTTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SPTTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param df
+ * @param ef
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param info
+ */
+ public abstract void sptrfs(int n, int nrhs, float[] d, float[] e, float[] df, float[] ef, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTSV computes the solution to a real system of linear equations
+ A*X = B, where A is an N-by-N symmetric positive definite tridiagonal
+ matrix, and X and B are N-by-NRHS matrices.
+
+ A is factored as A = L*D*L**T, and the factored form of A is then
+ used to solve the system of equations.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the factorization A = L*D*L**T.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L**T factorization of
+ A. (E can also be regarded as the superdiagonal of the unit
+
+ bidiagonal factor U from the U**T*D*U factorization of A.)
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the solution has not been
+ computed. The factorization has not been completed
+ unless i = N.
+
+ =====================================================================
+
+ .. External Subroutines ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sptsv(int n, int nrhs, float[] d, float[] e, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTSVX uses the factorization A = L*D*L**T to compute the solution
+ to a real system of linear equations A*X = B, where A is an N-by-N
+ symmetric positive definite tridiagonal matrix and X and B are
+ N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
+ is a unit lower bidiagonal matrix and D is diagonal. The
+ factorization can also be regarded as having the form
+ A = U**T*D*U.
+
+ 2. If the leading i-by-i principal minor is not positive definite,
+ then the routine returns with INFO = i. Otherwise, the factored
+ form of A is used to estimate the condition number of the matrix
+ A. If the reciprocal of the condition number is less than machine
+ precision, INFO = N+1 is returned as a warning, but the routine
+ still goes on to solve for X and compute error bounds as
+ described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, DF and EF contain the factored form of A.
+ D, E, DF, and EF will not be modified.
+ = 'N': The matrix A will be copied to DF and EF and
+ factored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix A.
+
+ DF (input or output) REAL array, dimension (N)
+ If FACT = 'F', then DF is an input argument and on entry
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+ If FACT = 'N', then DF is an output argument and on exit
+ contains the n diagonal elements of the diagonal matrix D
+ from the L*D*L**T factorization of A.
+
+ EF (input or output) REAL array, dimension (N-1)
+ If FACT = 'F', then EF is an input argument and on entry
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+ If FACT = 'N', then EF is an output argument and on exit
+ contains the (n-1) subdiagonal elements of the unit
+ bidiagonal factor L from the L*D*L**T factorization of A.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The reciprocal condition number of the matrix A. If RCOND
+ is less than the machine precision (in particular, if
+ RCOND = 0), the matrix is singular to working precision.
+ This condition is indicated by a return code of INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j).
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in any
+ element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: the leading minor of order i of A is
+ not positive definite, so the factorization
+ could not be completed, and the solution has not
+ been computed. RCOND = 0 is returned.
+ = N+1: U is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param df
+ * @param ef
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param info
+ */
+ public abstract void sptsvx(String fact, int n, int nrhs, float[] d, float[] e, float[] df, float[] ef, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTTRF computes the L*D*L' factorization of a real symmetric
+ positive definite tridiagonal matrix A. The factorization may also
+ be regarded as having the form A = U'*D*U.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A. On exit, the n diagonal elements of the diagonal matrix
+ D from the L*D*L' factorization of A.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A. On exit, the (n-1) subdiagonal elements of the
+ unit bidiagonal factor L from the L*D*L' factorization of A.
+
+ E can also be regarded as the superdiagonal of the unit
+ bidiagonal factor U from the U'*D*U factorization of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite; if k < N, the factorization could not
+ be completed, while if k = N, the factorization was
+ completed, but D(N) <= 0.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param info
+ */
+ public abstract void spttrf(int n, float[] d, float[] e, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTTRS solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by SPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void spttrs(int n, int nrhs, float[] d, float[] e, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SPTTS2 solves a tridiagonal system of the form
+ A * X = B
+ using the L*D*L' factorization of A computed by SPTTRF. D is a
+ diagonal matrix specified in the vector D, L is a unit bidiagonal
+ matrix whose subdiagonal is specified in the vector E, and X and B
+ are N by NRHS matrices.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the diagonal matrix D from the
+ L*D*L' factorization of A.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the unit bidiagonal factor
+
+ L from the L*D*L' factorization of A. E can also be regarded
+ as the superdiagonal of the unit bidiagonal factor U from the
+ factorization A = U'*D*U.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side vectors B for the system of
+ linear equations.
+ On exit, the solution vectors, X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param n
+ * @param nrhs
+ * @param d
+ * @param e
+ * @param b
+ * @param ldb
+ */
+ public abstract void sptts2(int n, int nrhs, float[] d, float[] e, float[] b, int ldb);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SRSCL multiplies an n-element real vector x by the real scalar 1/a.
+ This is done without overflow or underflow as long as
+ the final result x/a does not overflow or underflow.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of components of the vector x.
+
+ SA (input) REAL
+ The scalar a which is used to divide each component of x.
+ SA must be >= 0, or the subroutine will divide by zero.
+
+ SX (input/output) REAL array, dimension
+ (1+(N-1)*abs(INCX))
+ The n-element vector x.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector SX.
+ > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
+
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param sa
+ * @param sx
+ * @param incx
+ */
+ public abstract void srscl(int n, float sa, float[] sx, int incx);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBEV computes all the eigenvalues and, optionally, eigenvectors of
+ a real symmetric band matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (max(1,3*N-2))
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void ssbev(String jobz, String uplo, int n, int kd, float[] ab, int ldab, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBEVD computes all the eigenvalues and, optionally, eigenvectors of
+
+ a real symmetric band matrix A. If eigenvectors are desired, it uses
+
+ a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ IF N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 2, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 2, LWORK must be at least
+ ( 1 + 5*N + 2*N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array LIWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void ssbevd(String jobz, String uplo, int n, int kd, float[] ab, int ldab, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric band matrix A. Eigenvalues and eigenvectors can
+
+ be selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+
+ On exit, AB is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the first
+ superdiagonal and the diagonal of the tridiagonal matrix T
+ are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+ the diagonal and first subdiagonal of T are returned in the
+ first two rows of AB.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD + 1.
+
+ Q (output) REAL array, dimension (LDQ, N)
+ If JOBZ = 'V', the N-by-N orthogonal matrix used in the
+ reduction to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'V', then
+ LDQ >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AB to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (7*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param q
+ * @param ldq
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void ssbevx(String jobz, String range, String uplo, int n, int kd, float[] ab, int ldab, float[] q, int ldq, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGST reduces a real symmetric-definite banded generalized
+ eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
+ such that C has the same bandwidth as A.
+
+ B must have been previously factorized as S**T*S by SPBSTF, using a
+ split Cholesky factorization. A is overwritten by C = X**T*A*X, where
+ X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the
+ bandwidth of A.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form the transformation matrix X;
+ = 'V': form X.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= KB >= 0.
+
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the transformed matrix X**T*A*X, stored in the same
+
+ format as A.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input) REAL array, dimension (LDBB,N)
+ The banded factor S from the split Cholesky factorization of
+
+ B, as returned by SPBSTF, stored in the first KB+1 rows of
+ the array.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ X (output) REAL array, dimension (LDX,N)
+ If VECT = 'V', the n-by-n matrix X.
+ If VECT = 'N', the array X is not referenced.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X.
+ LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param x
+ * @param ldx
+ * @param work
+ * @param info
+ */
+ public abstract void ssbgst(String vect, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] x, int ldx, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+ and banded, and B is also positive definite.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) REAL array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by SPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so that Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= N.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then SPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void ssbgv(String jobz, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of the
+
+ form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and
+
+ banded, and B is also positive definite. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) REAL array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by SPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 3*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 5*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if LIWORK > 0, IWORK(1) returns the optimal LIWORK.
+
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is:
+ <= N: the algorithm failed to converge:
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then SPBSTF
+ returned INFO = i: B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void ssbgvd(String jobz, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite banded eigenproblem, of
+ the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric
+
+ and banded, and B is also positive definite. Eigenvalues and
+ eigenvectors can be selected by specifying either all eigenvalues,
+ a range of values or a range of indices for the desired eigenvalues.
+
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ KA (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KA >= 0.
+
+ KB (input) INTEGER
+ The number of superdiagonals of the matrix B if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KB >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first ka+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
+
+ On exit, the contents of AB are destroyed.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KA+1.
+
+ BB (input/output) REAL array, dimension (LDBB, N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix B, stored in the first kb+1 rows of the array. The
+ j-th column of B is stored in the j-th column of the array BB
+ as follows:
+ if UPLO = 'U', BB(ka+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
+ if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
+
+ On exit, the factor S from the split Cholesky factorization
+ B = S**T*S, as returned by SPBSTF.
+
+ LDBB (input) INTEGER
+ The leading dimension of the array BB. LDBB >= KB+1.
+
+ Q (output) REAL array, dimension (LDQ, N)
+ If JOBZ = 'V', the n-by-n matrix used in the reduction of
+ A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
+ and consequently C to tridiagonal form.
+ If JOBZ = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If JOBZ = 'N',
+ LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors, with the i-th column of Z holding the
+ eigenvector associated with W(i). The eigenvectors are
+ normalized so Z**T*B*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (7N)
+
+ IWORK (workspace/output) INTEGER array, dimension (5N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvalues that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0 : successful exit
+ < 0 : if INFO = -i, the i-th argument had an illegal value
+ <= N: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in IFAIL.
+ > N : SPBSTF returned an error code; i.e.,
+ if INFO = N + i, for 1 <= i <= N, then the leading
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param ka
+ * @param kb
+ * @param ab
+ * @param ldab
+ * @param bb
+ * @param ldbb
+ * @param q
+ * @param ldq
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void ssbgvx(String jobz, String range, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] q, int ldq, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSBTRD reduces a real symmetric band matrix A to symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'N': do not form Q;
+ = 'V': form Q;
+ = 'U': update a matrix X, by forming X*Q.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals of the matrix A if UPLO = 'U',
+ or the number of subdiagonals if UPLO = 'L'. KD >= 0.
+
+ AB (input/output) REAL array, dimension (LDAB,N)
+ On entry, the upper or lower triangle of the symmetric band
+ matrix A, stored in the first KD+1 rows of the array. The
+ j-th column of A is stored in the j-th column of the array AB
+ as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ On exit, the diagonal elements of AB are overwritten by the
+ diagonal elements of the tridiagonal matrix T; if KD > 0, the
+ elements on the first superdiagonal (if UPLO = 'U') or the
+ first subdiagonal (if UPLO = 'L') are overwritten by the
+ off-diagonal elements of T; the rest of AB is overwritten by
+
+ values generated during the reduction.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T.
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if VECT = 'U', then Q must contain an N-by-N
+ matrix X; if VECT = 'N' or 'V', then Q need not be set.
+
+ On exit:
+ if VECT = 'V', Q contains the N-by-N orthogonal matrix Q;
+ if VECT = 'U', Q contains the product X*Q;
+ if VECT = 'N', the array Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Modified by Linda Kaufman, Bell Labs.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param vect
+ * @param uplo
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param d
+ * @param e
+ * @param q
+ * @param ldq
+ * @param work
+ * @param info
+ */
+ public abstract void ssbtrd(String vect, String uplo, int n, int kd, float[] ab, int ldab, float[] d, float[] e, float[] q, int ldq, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric packed matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ ANORM (input) REAL
+ The 1-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sspcon(String uplo, int n, float[] ap, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPEV computes all the eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A in packed storage.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void sspev(String jobz, String uplo, int n, float[] ap, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPEVD computes all the eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. If eigenvectors are
+ desired, it uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void sspevd(String jobz, String uplo, int n, float[] ap, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A in packed storage. Eigenvalues/vectors
+
+ can be selected by specifying either a range of values or a range of
+
+ indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found;
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found;
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, AP is overwritten by values generated during the
+ reduction to tridiagonal form. If UPLO = 'U', the diagonal
+ and first superdiagonal of the tridiagonal matrix T overwrite
+ the corresponding elements of A, and if UPLO = 'L', the
+ diagonal and first subdiagonal of T overwrite the
+ corresponding elements of A.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing AP to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the selected eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void sspevx(String jobz, String range, String uplo, int n, float[] ap, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form, using packed storage.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by SPPTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ BP (input) REAL array, dimension (N*(N+1)/2)
+ The triangular factor from the Cholesky factorization of B,
+ stored in the same format as A, as returned by SPPTRF.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param info
+ */
+ public abstract void sspgst(int itype, String uplo, int n, float[] ap, float[] bp, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGV computes all the eigenvalues and, optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric, stored in packed format,
+ and B is also positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) REAL array, dimension
+ (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPPTRF or SSPEV returned an error code:
+ <= N: if INFO = i, SSPEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero.
+ > N: if INFO = n + i, for 1 <= i <= n, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void sspgv(int itype, String jobz, String uplo, int n, float[] ap, float[] bp, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric, stored in packed format, and B is also
+ positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
+ eigenvectors. The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the required LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the required sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the required LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the required sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPPTRF or SSPEVD returned an error code:
+ <= N: if INFO = i, SSPEVD failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void sspgvd(int itype, String jobz, String uplo, int n, float[] ap, float[] bp, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric, stored in packed storage, and B
+ is also positive definite. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ On exit, the contents of AP are destroyed.
+
+ BP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ B, packed columnwise in a linear array. The j-th column of B
+ is stored in the array BP as follows:
+ if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
+ if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
+
+
+ On exit, the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T, in the same storage
+ format as B.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (8*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPPTRF or SSPEVX returned an error code:
+ <= N: if INFO = i, SSPEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param bp
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void sspgvx(int itype, String jobz, String range, String uplo, int n, float[] ap, float[] bp, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite
+ and packed, and provides error bounds and backward error estimates
+ for the solution.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ AFP (input) REAL array, dimension (N*(N+1)/2)
+ The factored form of the matrix A. AFP contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by SSPTRF, stored as a packed
+ triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SSPTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void ssprfs(String uplo, int n, int nrhs, float[] ap, float[] afp, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix stored in packed format and X
+ and B are N-by-NRHS matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, D is symmetric and block diagonal with 1-by-1
+ and 2-by-2 diagonal blocks. The factored form of A is then used to
+ solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by SSPTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, so the solution could not be
+ computed.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. External Functions ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void sspsv(String uplo, int n, int nrhs, float[] ap, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPSVX uses the diagonal pivoting factorization A = U*D*U**T or
+ A = L*D*L**T to compute the solution to a real system of linear
+ equations A * X = B, where A is an N-by-N symmetric matrix stored
+ in packed format and X and B are N-by-NRHS matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AFP and IPIV contain the factored form of
+ A. AP, AFP and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AFP and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangle of the symmetric matrix A, packed
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ See below for further details.
+
+ AFP (input or output) REAL array, dimension
+ (N*(N+1)/2)
+ If FACT = 'F', then AFP is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ If FACT = 'N', then AFP is an output argument and on exit
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSPTRF, stored as
+ a packed triangular matrix in the same storage format as A.
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSPTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSPTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ Further Details
+ ===============
+
+ The packed storage scheme is illustrated by the following example
+ when N = 4, UPLO = 'U':
+
+ Two-dimensional storage of the symmetric matrix A:
+
+ a11 a12 a13 a14
+ a22 a23 a24
+ a33 a34 (aij = aji)
+ a44
+
+ Packed storage of the upper triangle of A:
+
+ AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param afp
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sspsvx(String fact, String uplo, int n, int nrhs, float[] ap, float[] afp, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRD reduces a real symmetric matrix A stored in packed form to
+ symmetric tridiagonal form T by an orthogonal similarity
+ transformation: Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
+ overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
+ overwriting A(i+2:n,i), and tau is stored in TAU(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param d
+ * @param e
+ * @param tau
+ * @param info
+ */
+ public abstract void ssptrd(String uplo, int n, float[] ap, float[] d, float[] e, float[] tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRF computes the factorization of a real symmetric matrix A stored
+ in packed format using the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangle of the symmetric matrix
+ A, packed columnwise in a linear array. The j-th column of A
+ is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L, stored as a packed triangular
+ matrix overwriting A (see below for further details).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 5-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param ipiv
+ * @param info
+ */
+ public abstract void ssptrf(String uplo, int n, float[] ap, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRI computes the inverse of a real symmetric indefinite matrix
+ A in packed storage using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by SSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by SSPTRF,
+ stored as a packed triangular matrix.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix, stored as a packed triangular matrix. The j-th column
+ of inv(A) is stored in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = inv(A)(i,j) for 1<=i<=j;
+ if UPLO = 'L',
+ AP(i + (j-1)*(2n-j)/2) = inv(A)(i,j) for j<=i<=n.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param ap
+ * @param ipiv
+ * @param work
+ * @param info
+ */
+ public abstract void ssptri(String uplo, int n, float[] ap, int[] ipiv, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSPTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A stored in packed format using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSPTRF, stored as a
+ packed triangular matrix.
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSPTRF.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void ssptrs(String uplo, int n, int nrhs, float[] ap, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEBZ computes the eigenvalues of a symmetric tridiagonal
+ matrix T. The user may ask for all eigenvalues, all eigenvalues
+ in the half-open interval (VL, VU], or the IL-th through IU-th
+ eigenvalues.
+
+ To avoid overflow, the matrix must be scaled so that its
+ largest element is no greater than overflow**(1/2) *
+ underflow**(1/4) in absolute value, and for greatest
+ accuracy, it should not be much smaller than that.
+
+ See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
+ Matrix", Report CS41, Computer Science Dept., Stanford
+ University, July 21, 1966.
+
+ Arguments
+ =========
+
+ RANGE (input) CHARACTER*1
+ = 'A': ("All") all eigenvalues will be found.
+ = 'V': ("Value") all eigenvalues in the half-open interval
+ (VL, VU] will be found.
+ = 'I': ("Index") the IL-th through IU-th eigenvalues (of the
+
+ entire matrix) will be found.
+
+ ORDER (input) CHARACTER*1
+ = 'B': ("By Block") the eigenvalues will be grouped by
+ split-off block (see IBLOCK, ISPLIT) and
+
+ ordered from smallest to largest within
+ the block.
+ = 'E': ("Entire matrix")
+ the eigenvalues for the entire matrix
+ will be ordered from smallest to
+ largest.
+
+ N (input) INTEGER
+ The order of the tridiagonal matrix T. N >= 0.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. Eigenvalues less than or equal
+
+ to VL, or greater than VU, will not be returned. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute tolerance for the eigenvalues. An eigenvalue
+ (or cluster) is considered to be located if it has been
+ determined to lie in an interval whose width is ABSTOL or
+ less. If ABSTOL is less than or equal to zero, then ULP*|T|
+
+ will be used, where |T| means the 1-norm of T.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) off-diagonal elements of the tridiagonal matrix T.
+
+
+ M (output) INTEGER
+ The actual number of eigenvalues found. 0 <= M <= N.
+ (See also the description of INFO=2,3.)
+
+ NSPLIT (output) INTEGER
+ The number of diagonal blocks in the matrix T.
+ 1 <= NSPLIT <= N.
+
+ W (output) REAL array, dimension (N)
+ On exit, the first M elements of W will contain the
+ eigenvalues. (SSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ IBLOCK (output) INTEGER array, dimension (N)
+ At each row/column j where E(j) is zero or small, the
+ matrix T is considered to split into a block diagonal
+ matrix. On exit, if INFO = 0, IBLOCK(i) specifies to which
+ block (from 1 to the number of blocks) the eigenvalue W(i)
+ belongs. (SSTEBZ may use the remaining N-M elements as
+ workspace.)
+
+ ISPLIT (output) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to ISPLIT(1),
+
+ the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
+ etc., and the NSPLIT-th consists of rows/columns
+ ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
+ (Only the first NSPLIT elements will actually be used, but
+ since the user cannot know a priori what value NSPLIT will
+ have, N words must be reserved for ISPLIT.)
+
+ WORK (workspace) REAL array, dimension (4*N)
+
+ IWORK (workspace) INTEGER array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: some or all of the eigenvalues failed to converge or
+ were not computed:
+ =1 or 3: Bisection failed to converge for some
+ eigenvalues; these eigenvalues are flagged by a
+ negative block number. The effect is that the
+
+ eigenvalues may not be as accurate as the
+ absolute and relative tolerances. This is
+ generally caused by unexpectedly inaccurate
+ arithmetic.
+ =2 or 3: RANGE='I' only: Not all of the eigenvalues
+ IL:IU were found.
+ Effect: M < IU+1-IL
+ Cause: non-monotonic arithmetic, causing the
+ Sturm sequence to be non-monotonic.
+ Cure: recalculate, using RANGE='A', and pick
+
+ out eigenvalues IL:IU. In some cases,
+
+ increasing the PARAMETER "FUDGE" may
+ make things work.
+ = 4: RANGE='I', and the Gershgorin interval
+ initially used was too small. No eigenvalues
+ were computed.
+ Probable cause: your machine has sloppy
+ floating-point arithmetic.
+ Cure: Increase the PARAMETER "FUDGE",
+ recompile, and try again.
+
+ Internal Parameters
+ ===================
+
+ RELFAC REAL, default = 2.0e0
+ The relative tolerance. An interval (a,b] lies within
+ "relative tolerance" if b-a < RELFAC*ulp*max(|a|,|b|),
+ where "ulp" is the machine precision (distance from 1 to
+ the next larger floating point number.)
+
+ FUDGE REAL, default = 2
+ A "fudge factor" to widen the Gershgorin intervals. Ideally,
+ a value of 1 should work, but on machines with sloppy
+ arithmetic, this needs to be larger. The default for
+ publicly released versions should be large enough to handle
+ the worst machine around. Note that this has no effect
+ on accuracy of the solution.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param range
+ * @param order
+ * @param n
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param d
+ * @param e
+ * @param m
+ * @param nsplit
+ * @param w
+ * @param iblock
+ * @param isplit
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void sstebz(String range, String order, int n, float vl, float vu, int il, int iu, float abstol, float[] d, float[] e, intW m, intW nsplit, float[] w, int[] iblock, int[] isplit, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEDC computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+ The eigenvectors of a full or band real symmetric matrix can also be
+
+ found if SSYTRD or SSPTRD or SSBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See SLAED3 for details.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+ = 'V': Compute eigenvectors of original dense symmetric
+ matrix also. On entry, Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the subdiagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 3*N + 2*N*lg N + 3*N**2 ),
+ where lg( N ) = smallest integer k such
+ that 2**k >= N.
+ If COMPZ = 'I' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LWORK need
+ only be max(1,2*(N-1)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LIWORK must be at least
+ ( 6 + 6*N + 5*N*lg N ).
+ If COMPZ = 'I' and N > 1 then LIWORK must be at least
+ ( 3 + 5*N ).
+ Note that for COMPZ = 'I' or 'V', then if N is less than or
+ equal to the minimum divide size, usually 25, then LIWORK
+ need only be 1.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void sstedc(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEGR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ SSTEGR is a compatability wrapper around the improved SSTEMR routine.
+ See SSTEMR for further details.
+
+ One important change is that the ABSTOL parameter no longer provides
+ benefit and hence is no longer used.
+
+ Note : SSTEGR and SSTEMR work only on machines which follow
+ IEEE-754 floating-point standard in their handling of infinities and
+
+ NaNs. Normal execution may create these exceptiona values and hence
+
+ may abort due to a floating point exception in environments which
+ do not conform to the IEEE-754 standard.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ Unused. Was the absolute error tolerance for the
+ eigenvalues/eigenvectors in previous versions.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in SLARRE,
+ if INFO = 2X, internal error in SLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by SLARRE or
+ SLARRV, respectively.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, LBNL/NERSC, USA
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void sstegr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEIN computes the eigenvectors of a real symmetric tridiagonal
+ matrix T corresponding to specified eigenvalues, using inverse
+ iteration.
+
+ The maximum number of iterations allowed for each eigenvector is
+ specified by an internal parameter MAXITS (currently set to 5).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input) REAL array, dimension (N)
+ The n diagonal elements of the tridiagonal matrix T.
+
+ E (input) REAL array, dimension (N-1)
+ The (n-1) subdiagonal elements of the tridiagonal matrix
+ T, in elements 1 to N-1.
+
+ M (input) INTEGER
+ The number of eigenvectors to be found. 0 <= M <= N.
+
+ W (input) REAL array, dimension (N)
+ The first M elements of W contain the eigenvalues for
+ which eigenvectors are to be computed. The eigenvalues
+ should be grouped by split-off block and ordered from
+ smallest to largest within the block. ( The output array
+ W from SSTEBZ with ORDER = 'B' is expected here. )
+
+ IBLOCK (input) INTEGER array, dimension (N)
+ The submatrix indices associated with the corresponding
+ eigenvalues in W; IBLOCK(i)=1 if eigenvalue W(i) belongs to
+ the first submatrix from the top, =2 if W(i) belongs to
+ the second submatrix, etc. ( The output array IBLOCK
+ from SSTEBZ is expected here. )
+
+ ISPLIT (input) INTEGER array, dimension (N)
+ The splitting points, at which T breaks up into submatrices.
+
+ The first submatrix consists of rows/columns 1 to
+ ISPLIT( 1 ), the second of rows/columns ISPLIT( 1 )+1
+ through ISPLIT( 2 ), etc.
+ ( The output array ISPLIT from SSTEBZ is expected here. )
+
+ Z (output) REAL array, dimension (LDZ, M)
+ The computed eigenvectors. The eigenvector associated
+ with the eigenvalue W(i) is stored in the i-th column of
+ Z. Any vector which fails to converge is set to its current
+
+ iterate after MAXITS iterations.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ IFAIL (output) INTEGER array, dimension (M)
+ On normal exit, all elements of IFAIL are zero.
+ If one or more eigenvectors fail to converge after
+ MAXITS iterations, then their indices are stored in
+ array IFAIL.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge
+ in MAXITS iterations. Their indices are stored in
+ array IFAIL.
+
+ Internal Parameters
+ ===================
+
+ MAXITS INTEGER, default = 5
+ The maximum number of iterations performed.
+
+ EXTRA INTEGER, default = 2
+ The number of iterations performed after norm growth
+ criterion is satisfied, should be at least 1.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param m
+ * @param w
+ * @param iblock
+ * @param isplit
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void sstein(int n, float[] d, float[] e, int m, float[] w, int[] iblock, int[] isplit, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEMR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Any such unreduced matrix h
+ a well defined set of pairwise different real eigenvalues, the corres
+ real eigenvectors are pairwise orthogonal.
+
+ The spectrum may be computed either completely or partially by specif
+ either an interval (VL,VU] or a range of indices IL:IU for the desire
+ eigenvalues.
+
+ Depending on the number of desired eigenvalues, these are computed ei
+ by bisection or the dqds algorithm. Numerically orthogonal eigenvecto
+ computed by the use of various suitable L D L^T factorizations near c
+ of close eigenvalues (referred to as RRRs, Relatively Robust
+ Representations). An informal sketch of the algorithm follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ For more details, see:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+ Notes:
+ 1.SSTEMR works only on machines which follow IEEE-754
+ floating-point standard in their handling of infinities and NaNs.
+ This permits the use of efficient inner loops avoiding a check for
+ zero divisors.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the N diagonal elements of the tridiagonal matrix
+ T. On exit, D is overwritten.
+
+ E (input/output) REAL array, dimension (N)
+ On entry, the (N-1) subdiagonal elements of the tridiagonal
+ matrix T in elements 1 to N-1 of E. E(N) need not be set on
+ input, but is used internally as workspace.
+ On exit, E is overwritten.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', and if INFO = 0, then the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix T
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and can be computed with a workspace
+
+ query by setting NZC = -1, see below.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', then LDZ >= max(1,N).
+
+ NZC (input) INTEGER
+ The number of eigenvectors to be held in the array Z.
+ If RANGE = 'A', then NZC >= max(1,N).
+ If RANGE = 'V', then NZC >= the number of eigenvalues in (VL,
+ If RANGE = 'I', then NZC >= IU-IL+1.
+ If NZC = -1, then a workspace query is assumed; the
+ routine calculates the number of columns of the array Z that
+
+ are needed to hold the eigenvectors.
+ This value is returned as the first entry of the Z array, and
+ no error message related to NZC is issued by XERBLA.
+
+ ISUPPZ (output) INTEGER ARRAY, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th computed eigen
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ). This is relevant in the case when the matrix
+ is split. ISUPPZ is only accessed when JOBZ is 'V' and N > 0.
+
+ TRYRAC (input/output) LOGICAL
+ If TRYRAC.EQ..TRUE., indicates that the code should check whe
+ the tridiagonal matrix defines its eigenvalues to high relati
+ accuracy. If so, the code uses relative-accuracy preserving
+
+ algorithms that might be (a bit) slower depending on the matr
+ If the matrix does not define its eigenvalues to high relativ
+ accuracy, the code can uses possibly faster algorithms.
+ If TRYRAC.EQ..FALSE., the code is not required to guarantee
+ relatively accurate eigenvalues and can use the fastest possi
+ techniques.
+ On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix
+ does not define its eigenvalues to high relative accuracy.
+
+ WORK (workspace/output) REAL array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal
+ (and minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,18*N)
+ if JOBZ = 'V', and LWORK >= max(1,12*N) if JOBZ = 'N'.
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N)
+ if the eigenvectors are desired, and LIWORK >= max(1,8*N)
+ if only the eigenvalues are to be computed.
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ On exit, INFO
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = 1X, internal error in SLARRE,
+ if INFO = 2X, internal error in SLARRV.
+ Here, the digit X = ABS( IINFO ) < 10, where IINFO is
+ the nonzero error code returned by SLARRE or
+ SLARRV, respectively.
+
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Beresford Parlett, University of California, Berkeley, USA
+ Jim Demmel, University of California, Berkeley, USA
+ Inderjit Dhillon, University of Texas, Austin, USA
+ Osni Marques, LBNL/NERSC, USA
+ Christof Voemel, University of California, Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param nzc
+ * @param isuppz
+ * @param tryrac
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public void sstemr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, intW m, float[] w, float[] z, int ldz, int nzc, int[] isuppz, booleanW tryrac, float[] work, int lwork, int[] iwork, int liwork, intW info) {
+ org.netlib.lapack.Sstemr.sstemr(jobz, range, n, d, 0, e, 0, vl, vu, il, iu, m, w, 0, z, 0, ldz, nzc, isuppz, 0, tryrac, work, 0, lwork, iwork, 0, liwork, info);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the implicit QL or QR method.
+ The eigenvectors of a full or band symmetric matrix can also be found
+ if SSYTRD or SSPTRD or SSBTRD has been used to reduce this matrix to
+
+ tridiagonal form.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvalues and eigenvectors of the original
+
+ symmetric matrix. On entry, Z must contain the
+ orthogonal matrix used to reduce the original matrix
+
+ to tridiagonal form.
+ = 'I': Compute eigenvalues and eigenvectors of the
+ tridiagonal matrix. Z is initialized to the identity
+ matrix.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) REAL array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (max(1,2*N-2))
+ If COMPZ = 'N', then WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm has failed to find all the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero; on exit, D
+ and E contain the elements of a symmetric tridiagonal
+ matrix which is orthogonally similar to the original
+ matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void ssteqr(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTERF computes all eigenvalues of a symmetric tridiagonal matrix
+ using the Pal-Walker-Kahan variant of the QL or QR algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix.
+
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed to find all of the eigenvalues in
+
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param n
+ * @param d
+ * @param e
+ * @param info
+ */
+ public abstract void ssterf(int n, float[] d, float[] e, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (max(1,2*N-2))
+ If JOBZ = 'N', WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param info
+ */
+ public abstract void sstev(String jobz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric tridiagonal matrix. If eigenvectors are desired, it
+ uses a divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) REAL array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A, stored in elements 1 to N-1 of E.
+ On exit, the contents of E are destroyed.
+
+ Z (output) REAL array, dimension (LDZ, N)
+ If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+ eigenvectors of the matrix A, with the i-th column of Z
+ holding the eigenvector associated with D(i).
+ If JOBZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
+
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of E did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param n
+ * @param d
+ * @param e
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void sstevd(String jobz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix T. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Whenever possible, SSTEVR calls SSTEMR to compute the
+ eigenspectrum using Relatively Robust Representations. SSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows. For the i-th
+ unreduced block of T,
+ (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T
+ is a relatively robust representation,
+ (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high
+ relative accuracy by the dqds algorithm,
+ (c) If there is a cluster of close eigenvalues, "choose" sigma_i
+ close to the cluster, and go to step (a),
+ (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T,
+ compute the corresponding eigenvector by forming a
+ rank-revealing twisted factorization.
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon,
+ Computer Science Division Technical Report No. UCB//CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : SSTEVR calls SSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ SSTEVR calls SSTEBZ and SSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of SSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+********* For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
+********* SSTEIN are called
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) REAL array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ SLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+********* Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal (and
+ minimal) LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 20*N.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal (and
+ minimal) LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= 10*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+ Jason Riedy, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void sstevr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSTEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric tridiagonal matrix A. Eigenvalues and
+ eigenvectors can be selected by specifying either a range of values
+ or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) REAL array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix
+ A.
+ On exit, D may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ E (input/output) REAL array, dimension (max(1,N-1))
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix A in elements 1 to N-1 of E.
+ On exit, E may be multiplied by a constant factor chosen
+ to avoid over/underflow in computing the eigenvalues.
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less
+ than or equal to zero, then EPS*|T| will be used in
+ its place, where |T| is the 1-norm of the tridiagonal
+ matrix.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M) )
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge (INFO > 0), then that
+ column of Z contains the latest approximation to the
+ eigenvector, and the index of the eigenvector is returned
+ in IFAIL. If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace) REAL array, dimension (5*N)
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param n
+ * @param d
+ * @param e
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void sstevx(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYCON estimates the reciprocal of the condition number (in the
+ 1-norm) of a real symmetric matrix A using the factorization
+ A = U*D*U**T or A = L*D*L**T computed by SSYTRF.
+
+ An estimate is obtained for norm(inv(A)), and the reciprocal of the
+ condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ ANORM (input) REAL
+ The 1-norm of the original matrix A.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+ estimate of the 1-norm of inv(A) computed in this routine.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param anorm
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void ssycon(String uplo, int n, float[] a, int lda, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEV computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for SSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param w
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void ssyev(String jobz, String uplo, int n, float[] a, int lda, float[] w, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A. If eigenvectors are desired, it uses a
+ divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Because of large use of BLAS of level 3, SSYEVD needs N**2 more
+ workspace than SSYEVX.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i and JOBZ = 'N', then the algorithm failed
+ to converge; i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ if INFO = i and JOBZ = 'V', then the algorithm failed
+ to compute an eigenvalue while working on the submatrix
+ lying in rows and columns INFO/(N+1) through
+ mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ Modified description of INFO. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param w
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void ssyevd(String jobz, String uplo, int n, float[] a, int lda, float[] w, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEVR computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of
+ indices for the desired eigenvalues.
+
+ SSYEVR first reduces the matrix A to tridiagonal form T with a call
+ to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute
+ the eigenspectrum using Relatively Robust Representations. SSTEMR
+ computes eigenvalues by the dqds algorithm, while orthogonal
+ eigenvectors are computed from various "good" L D L^T representations
+ (also known as Relatively Robust Representations). Gram-Schmidt
+ orthogonalization is avoided as far as possible. More specifically,
+ the various steps of the algorithm are as follows.
+
+ For each unreduced block (submatrix) of T,
+ (a) Compute T - sigma I = L D L^T, so that L and D
+ define all the wanted eigenvalues to high relative accuracy.
+ This means that small relative changes in the entries of D and
+ cause only small relative changes in the eigenvalues and
+ eigenvectors. The standard (unfactored) representation of the
+
+ tridiagonal matrix T does not have this property in general.
+ (b) Compute the eigenvalues to suitable accuracy.
+ If the eigenvectors are desired, the algorithm attains full
+ accuracy of the computed eigenvalues only right before
+ the corresponding vectors have to be computed, see steps c) an
+ (c) For each cluster of close eigenvalues, select a new
+ shift close to the cluster, find a new factorization, and refi
+ the shifted eigenvalues to suitable accuracy.
+ (d) For each eigenvalue with a large enough relative separation co
+ the corresponding eigenvector by forming a rank revealing twis
+ factorization. Go back to (c) for any clusters that remain.
+
+ The desired accuracy of the output can be specified by the input
+ parameter ABSTOL.
+
+ For more details, see SSTEMR's documentation and:
+ - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representat
+ to compute orthogonal eigenvectors of symmetric tridiagonal matrice
+ Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+ - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors an
+ Relative Gaps," SIAM Journal on Matrix Analysis and Applications, V
+ 2004. Also LAPACK Working Note 154.
+ - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+ tridiagonal eigenvalue/eigenvector problem",
+ Computer Science Division Technical Report No. UCB/CSD-97-971,
+ UC Berkeley, May 1997.
+
+
+ Note 1 : SSYEVR calls SSTEMR when the full spectrum is requested
+ on machines which conform to the ieee-754 floating point standard.
+ SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and
+ when partial spectrum requests are made.
+
+ Normal execution of SSTEMR may create NaNs and infinities and
+ hence may abort due to a floating point exception in environments
+ which do not handle NaNs and infinities in the ieee standard default
+
+ manner.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+********* For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
+********* SSTEIN are called
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ If high relative accuracy is important, set ABSTOL to
+ SLAMCH( 'Safe minimum' ). Doing so will guarantee that
+ eigenvalues are computed to high relative accuracy when
+ possible in future releases. The current code does not
+ make any guarantees about high relative accuracy, but
+ future releases will. See J. Barlow and J. Demmel,
+ "Computing Accurate Eigensystems of Scaled Diagonally
+ Dominant Matrices", LAPACK Working Note #7, for a discussion
+
+ of which matrices define their eigenvalues to high relative
+ accuracy.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ The first M elements contain the selected eigenvalues in
+ ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+ Supplying N columns is always safe.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ ISUPPZ (output) INTEGER array, dimension ( 2*max(1,M) )
+ The support of the eigenvectors in Z, i.e., the indices
+ indicating the nonzero elements in Z. The i-th eigenvector
+ is nonzero only in elements ISUPPZ( 2*i-1 ) through
+ ISUPPZ( 2*i ).
+********* Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,26*N).
+ For optimal efficiency, LWORK >= (NB+6)*N,
+ where NB is the max of the blocksize for SSYTRD and SORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= max(1,10*N).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: Internal error
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Inderjit Dhillon, IBM Almaden, USA
+ Osni Marques, LBNL/NERSC, USA
+ Ken Stanley, Computer Science Division, University of
+ California at Berkeley, USA
+ Jason Riedy, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param isuppz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void ssyevr(String jobz, String range, String uplo, int n, float[] a, int lda, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYEVX computes selected eigenvalues and, optionally, eigenvectors
+ of a real symmetric matrix A. Eigenvalues and eigenvectors can be
+ selected by specifying either a range of values or a range of indices
+ for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ See "Computing Small Singular Values of Bidiagonal Matrices
+ with Guaranteed High Relative Accuracy," by Demmel and
+ Kahan, LAPACK Working Note #3.
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ If JOBZ = 'N', then Z is not referenced.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= 1, when N <= 1;
+ otherwise 8*N.
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the max of the blocksize for SSYTRD and SORMTR
+ returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, then i eigenvectors failed to converge.
+ Their indices are stored in array IFAIL.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void ssyevx(String jobz, String range, String uplo, int n, float[] a, int lda, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGS2 reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U')*A*inv(U) or inv(L)*A*inv(L')
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U` or L'*A*L.
+
+ B must have been previously factorized as U'*U or L*L' by SPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U')*A*inv(U) or inv(L)*A*inv(L');
+ = 2 or 3: compute U*A*U' or L'*A*L.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored, and how B has been factorized.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by SPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void ssygs2(int itype, String uplo, int n, float[] a, int lda, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGST reduces a real symmetric-definite generalized eigenproblem
+ to standard form.
+
+ If ITYPE = 1, the problem is A*x = lambda*B*x,
+ and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
+
+ If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
+ B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
+
+ B must have been previously factorized as U**T*U or L*L**T by SPOTRF.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
+ = 2 or 3: compute U*A*U**T or L**T*A*L.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored and B is factored as
+ U**T*U;
+ = 'L': Lower triangle of A is stored and B is factored as
+ L*L**T.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the transformed matrix, stored in the
+ same format as A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,N)
+ The triangular factor from the Cholesky factorization of B,
+ as returned by SPOTRF.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void ssygst(int itype, String uplo, int n, float[] a, int lda, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGV computes all the eigenvalues, and optionally, the eigenvectors
+
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+ Here A and B are assumed to be symmetric and B is also
+ positive definite.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the symmetric positive definite matrix B.
+ If UPLO = 'U', the leading N-by-N upper triangular part of B
+
+ contains the upper triangular part of the matrix B.
+ If UPLO = 'L', the leading N-by-N lower triangular part of B
+
+ contains the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,3*N-1).
+ For optimal efficiency, LWORK >= (NB+2)*N,
+ where NB is the blocksize for SSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPOTRF or SSYEV returned an error code:
+ <= N: if INFO = i, SSYEV failed to converge;
+ i off-diagonal elements of an intermediate
+ tridiagonal form did not converge to zero;
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param w
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void ssygv(int itype, String jobz, String uplo, int n, float[] a, int lda, float[] b, int ldb, float[] w, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGVD computes all the eigenvalues, and optionally, the eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
+ B are assumed to be symmetric and B is also positive definite.
+ If eigenvectors are desired, it uses a divide and conquer algorithm.
+
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangles of A and B are stored;
+ = 'L': Lower triangles of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ matrix Z of eigenvectors. The eigenvectors are normalized
+ as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+ If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+
+ or the lower triangle (if UPLO='L') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ W (output) REAL array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK >= 1.
+ If JOBZ = 'N' and N > 1, LWORK >= 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal sizes of the WORK and IWORK
+ arrays, returns these values as the first entries of the WORK
+ and IWORK arrays, and no error message related to LWORK or
+ LIWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK >= 1.
+ If JOBZ = 'N' and N > 1, LIWORK >= 1.
+ If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal sizes of the WORK and
+ IWORK arrays, returns these values as the first entries of
+ the WORK and IWORK arrays, and no error message related to
+ LWORK or LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPOTRF or SSYEVD returned an error code:
+ <= N: if INFO = i and JOBZ = 'N', then the algorithm
+ failed to converge; i off-diagonal elements of an
+ intermediate tridiagonal form did not converge to
+ zero;
+ if INFO = i and JOBZ = 'V', then the algorithm
+ failed to compute an eigenvalue while working on
+ the submatrix lying in rows and columns INFO/(N+1)
+
+ through mod(INFO,N+1);
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ Modified so that no backsubstitution is performed if SSYEVD fails to
+
+ converge (NEIG in old code could be greater than N causing out of
+ bounds reference to A - reported by Ralf Meyer). Also corrected the
+
+ description of INFO and the test on ITYPE. Sven, 16 Feb 05.
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param w
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void ssygvd(int itype, String jobz, String uplo, int n, float[] a, int lda, float[] b, int ldb, float[] w, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYGVX computes selected eigenvalues, and optionally, eigenvectors
+ of a real generalized symmetric-definite eigenproblem, of the form
+ A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A
+ and B are assumed to be symmetric and B is also positive definite.
+ Eigenvalues and eigenvectors can be selected by specifying either a
+ range of values or a range of indices for the desired eigenvalues.
+
+ Arguments
+ =========
+
+ ITYPE (input) INTEGER
+ Specifies the problem type to be solved:
+ = 1: A*x = (lambda)*B*x
+ = 2: A*B*x = (lambda)*x
+ = 3: B*A*x = (lambda)*x
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ RANGE (input) CHARACTER*1
+ = 'A': all eigenvalues will be found.
+ = 'V': all eigenvalues in the half-open interval (VL,VU]
+ will be found.
+ = 'I': the IL-th through IU-th eigenvalues will be found.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A and B are stored;
+ = 'L': Lower triangle of A and B are stored.
+
+ N (input) INTEGER
+ The order of the matrix pencil (A,B). N >= 0.
+
+ A (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+
+ On exit, the lower triangle (if UPLO='L') or the upper
+ triangle (if UPLO='U') of A, including the diagonal, is
+ destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDA, N)
+ On entry, the symmetric matrix B. If UPLO = 'U', the
+ leading N-by-N upper triangular part of B contains the
+ upper triangular part of the matrix B. If UPLO = 'L',
+ the leading N-by-N lower triangular part of B contains
+ the lower triangular part of the matrix B.
+
+ On exit, if INFO <= N, the part of B containing the matrix is
+ overwritten by the triangular factor U or L from the Cholesky
+ factorization B = U**T*U or B = L*L**T.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) REAL
+ VU (input) REAL
+ If RANGE='V', the lower and upper bounds of the interval to
+ be searched for eigenvalues. VL < VU.
+ Not referenced if RANGE = 'A' or 'I'.
+
+ IL (input) INTEGER
+ IU (input) INTEGER
+ If RANGE='I', the indices (in ascending order) of the
+ smallest and largest eigenvalues to be returned.
+ 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+ Not referenced if RANGE = 'A' or 'V'.
+
+ ABSTOL (input) REAL
+ The absolute error tolerance for the eigenvalues.
+ An approximate eigenvalue is accepted as converged
+ when it is determined to lie in an interval [a,b]
+ of width less than or equal to
+
+ ABSTOL + EPS * max( |a|,|b| ) ,
+
+ where EPS is the machine precision. If ABSTOL is less than
+ or equal to zero, then EPS*|T| will be used in its place,
+ where |T| is the 1-norm of the tridiagonal matrix obtained
+ by reducing A to tridiagonal form.
+
+ Eigenvalues will be computed most accurately when ABSTOL is
+ set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+ If this routine returns with INFO>0, indicating that some
+ eigenvectors did not converge, try setting ABSTOL to
+ 2*SLAMCH('S').
+
+ M (output) INTEGER
+ The total number of eigenvalues found. 0 <= M <= N.
+ If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+
+ W (output) REAL array, dimension (N)
+ On normal exit, the first M elements contain the selected
+ eigenvalues in ascending order.
+
+ Z (output) REAL array, dimension (LDZ, max(1,M))
+ If JOBZ = 'N', then Z is not referenced.
+ If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+ contain the orthonormal eigenvectors of the matrix A
+ corresponding to the selected eigenvalues, with the i-th
+ column of Z holding the eigenvector associated with W(i).
+ The eigenvectors are normalized as follows:
+ if ITYPE = 1 or 2, Z**T*B*Z = I;
+ if ITYPE = 3, Z**T*inv(B)*Z = I.
+
+ If an eigenvector fails to converge, then that column of Z
+ contains the latest approximation to the eigenvector, and the
+ index of the eigenvector is returned in IFAIL.
+ Note: the user must ensure that at least max(1,M) columns are
+ supplied in the array Z; if RANGE = 'V', the exact value of M
+ is not known in advance and an upper bound must be used.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ JOBZ = 'V', LDZ >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,8*N).
+ For optimal efficiency, LWORK >= (NB+3)*N,
+ where NB is the blocksize for SSYTRD returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (5*N)
+
+ IFAIL (output) INTEGER array, dimension (N)
+ If JOBZ = 'V', then if INFO = 0, the first M elements of
+ IFAIL are zero. If INFO > 0, then IFAIL contains the
+ indices of the eigenvectors that failed to converge.
+ If JOBZ = 'N', then IFAIL is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: SPOTRF or SSYEVX returned an error code:
+ <= N: if INFO = i, SSYEVX failed to converge;
+ i eigenvectors failed to converge. Their indices
+ are stored in array IFAIL.
+ > N: if INFO = N + i, for 1 <= i <= N, then the leading
+
+ minor of order i of B is not positive definite.
+ The factorization of B could not be completed and
+ no eigenvalues or eigenvectors were computed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param itype
+ * @param jobz
+ * @param range
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param vl
+ * @param vu
+ * @param il
+ * @param iu
+ * @param abstol
+ * @param m
+ * @param w
+ * @param z
+ * @param ldz
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param ifail
+ * @param info
+ */
+ public abstract void ssygvx(int itype, String jobz, String range, String uplo, int n, float[] a, int lda, float[] b, int ldb, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYRFS improves the computed solution to a system of linear
+ equations when the coefficient matrix is symmetric indefinite, and
+ provides error bounds and backward error estimates for the solution.
+
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input) REAL array, dimension (LDAF,N)
+ The factored form of the matrix A. AF contains the block
+ diagonal matrix D and the multipliers used to obtain the
+ factor U or L from the factorization A = U*D*U**T or
+ A = L*D*L**T as computed by SSYTRF.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input/output) REAL array, dimension (LDX,NRHS)
+ On entry, the solution matrix X, as computed by SSYTRS.
+ On exit, the improved solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Internal Parameters
+ ===================
+
+ ITMAX is the maximum number of steps of iterative refinement.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void ssyrfs(String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYSV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ The diagonal pivoting method is used to factor A as
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
+ used to solve the system of equations A * X = B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the block diagonal matrix D and the
+ multipliers used to obtain the factor U or L from the
+ factorization A = U*D*U**T or A = L*D*L**T as computed by
+ SSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D, as
+
+ determined by SSYTRF. If IPIV(k) > 0, then rows and columns
+
+ k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
+ diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
+ then rows and columns k-1 and -IPIV(k) were interchanged and
+
+ D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
+ IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
+ -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
+ diagonal block.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= 1, and for best performance
+ LWORK >= max(1,N*NB), where NB is the optimal blocksize for
+ SSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, so the solution could not be computed.
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void ssysv(String uplo, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYSVX uses the diagonal pivoting factorization to compute the
+ solution to a real system of linear equations A * X = B,
+ where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+ matrices.
+
+ Error bounds on the solution and a condition estimate are also
+ provided.
+
+ Description
+ ===========
+
+ The following steps are performed:
+
+ 1. If FACT = 'N', the diagonal pivoting method is used to factor A.
+ The form of the factorization is
+ A = U * D * U**T, if UPLO = 'U', or
+ A = L * D * L**T, if UPLO = 'L',
+ where U (or L) is a product of permutation and unit upper (lower)
+
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ 2. If some D(i,i)=0, so that D is exactly singular, then the routine
+
+ returns with INFO = i. Otherwise, the factored form of A is used
+ to estimate the condition number of the matrix A. If the
+ reciprocal of the condition number is less than machine precision,
+ INFO = N+1 is returned as a warning, but the routine still goes on
+ to solve for X and compute error bounds as described below.
+
+ 3. The system of equations is solved for X using the factored form
+ of A.
+
+ 4. Iterative refinement is applied to improve the computed solution
+ matrix and calculate error bounds and backward error estimates
+ for it.
+
+ Arguments
+ =========
+
+ FACT (input) CHARACTER*1
+ Specifies whether or not the factored form of A has been
+ supplied on entry.
+ = 'F': On entry, AF and IPIV contain the factored form of
+ A. AF and IPIV will not be modified.
+ = 'N': The matrix A will be copied to AF and factored.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+
+ is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ AF (input or output) REAL array, dimension (LDAF,N)
+ If FACT = 'F', then AF is an input argument and on entry
+ contains the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T as computed by SSYTRF.
+
+ If FACT = 'N', then AF is an output argument and on exit
+ returns the block diagonal matrix D and the multipliers used
+
+ to obtain the factor U or L from the factorization
+ A = U*D*U**T or A = L*D*L**T.
+
+ LDAF (input) INTEGER
+ The leading dimension of the array AF. LDAF >= max(1,N).
+
+ IPIV (input or output) INTEGER array, dimension (N)
+ If FACT = 'F', then IPIV is an input argument and on entry
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSYTRF.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ If FACT = 'N', then IPIV is an output argument and on exit
+ contains details of the interchanges and the block structure
+
+ of D, as determined by SSYTRF.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The N-by-NRHS right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (output) REAL array, dimension (LDX,NRHS)
+ If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ RCOND (output) REAL
+ The estimate of the reciprocal condition number of the matrix
+ A. If RCOND is less than the machine precision (in
+ particular, if RCOND = 0), the matrix is singular to working
+
+ precision. This condition is indicated by a return code of
+ INFO > 0.
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >= max(1,3*N), and for best
+ performance, when FACT = 'N', LWORK >= max(1,3*N,N*NB), where
+ NB is the optimal blocksize for SSYTRF.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, and i is
+ <= N: D(i,i) is exactly zero. The factorization
+ has been completed but the factor D is exactly
+ singular, so the solution and error bounds could
+ not be computed. RCOND = 0 is returned.
+ = N+1: D is nonsingular, but RCOND is less than machine
+ precision, meaning that the matrix is singular
+ to working precision. Nevertheless, the
+ solution and error bounds are computed because
+ there are a number of situations where the
+ computed solution can be more accurate than the
+
+ value of RCOND would suggest.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param fact
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param af
+ * @param ldaf
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param rcond
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void ssysvx(String fact, String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
+ form T by an orthogonal similarity transformation: Q' * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tau
+ * @param info
+ */
+ public abstract void ssytd2(String uplo, int n, float[] a, int lda, float[] d, float[] e, float[] tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTF2 computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method:
+
+ A = U*D*U' or A = L*D*L'
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, U' is the transpose of U, and D is symmetric and
+ block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, D(k,k) is exactly zero. The factorization
+
+ has been completed, but the block diagonal matrix D is
+ exactly singular, and division by zero will occur if it
+
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ 09-29-06 - patch from
+ Bobby Cheng, MathWorks
+
+ Replace l.204 and l.372
+ IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+ by
+ IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN
+
+ 01-01-96 - Based on modifications by
+ J. Lewis, Boeing Computer Services Company
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ 1-96 - Based on modifications by J. Lewis, Boeing Computer Services
+ Company
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param info
+ */
+ public abstract void ssytf2(String uplo, int n, float[] a, int lda, int[] ipiv, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRD reduces a real symmetric matrix A to real symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) REAL array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) REAL array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) REAL array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+
+ Details).
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param d
+ * @param e
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void ssytrd(String uplo, int n, float[] a, int lda, float[] d, float[] e, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRF computes the factorization of a real symmetric matrix A using
+
+ the Bunch-Kaufman diagonal pivoting method. The form of the
+ factorization is
+
+ A = U*D*U**T or A = L*D*L**T
+
+ where U (or L) is a product of permutation and unit upper (lower)
+ triangular matrices, and D is symmetric and block diagonal with
+ 1-by-1 and 2-by-2 diagonal blocks.
+
+ This is the blocked version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, the block diagonal matrix D and the multipliers used
+ to obtain the factor U or L (see below for further details).
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D.
+ If IPIV(k) > 0, then rows and columns k and IPIV(k) were
+ interchanged and D(k,k) is a 1-by-1 diagonal block.
+ If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
+ columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
+ is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
+ IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
+ interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of WORK. LWORK >=1. For best performance
+ LWORK >= N*NB, where NB is the block size returned by ILAENV.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) is exactly zero. The factorization
+ has been completed, but the block diagonal matrix D is
+
+ exactly singular, and division by zero will occur if it
+ is used to solve a system of equations.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', then A = U*D*U', where
+ U = P(n)*U(n)* ... *P(k)U(k)* ...,
+ i.e., U is a product of terms P(k)*U(k), where k decreases from n to
+
+ 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I v 0 ) k-s
+ U(k) = ( 0 I 0 ) s
+ ( 0 0 I ) n-k
+ k-s s n-k
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
+ If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
+ and A(k,k), and v overwrites A(1:k-2,k-1:k).
+
+ If UPLO = 'L', then A = L*D*L', where
+ L = P(1)*L(1)* ... *P(k)*L(k)* ...,
+ i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
+
+ n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
+ and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
+ defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
+
+ that if the diagonal block D(k) is of order s (s = 1 or 2), then
+
+ ( I 0 0 ) k-1
+ L(k) = ( 0 I 0 ) s
+ ( 0 v I ) n-k-s+1
+ k-1 s n-k-s+1
+
+ If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
+ If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
+ and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
+
+ =====================================================================
+
+ .. Local Scalars ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void ssytrf(String uplo, int n, float[] a, int lda, int[] ipiv, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRI computes the inverse of a real symmetric indefinite matrix
+ A using the factorization A = U*D*U**T or A = L*D*L**T computed by
+ SSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the block diagonal matrix D and the multipliers
+ used to obtain the factor U or L as computed by SSYTRF.
+
+ On exit, if INFO = 0, the (symmetric) inverse of the original
+ matrix. If UPLO = 'U', the upper triangular part of the
+ inverse is formed and the part of A below the diagonal is not
+ referenced; if UPLO = 'L' the lower triangular part of the
+ inverse is formed and the part of A above the diagonal is
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+
+ inverse could not be computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param work
+ * @param info
+ */
+ public abstract void ssytri(String uplo, int n, float[] a, int lda, int[] ipiv, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SSYTRS solves a system of linear equations A*X = B with a real
+ symmetric matrix A using the factorization A = U*D*U**T or
+ A = L*D*L**T computed by SSYTRF.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the details of the factorization are stored
+ as an upper or lower triangular matrix.
+ = 'U': Upper triangular, form is A = U*D*U**T;
+ = 'L': Lower triangular, form is A = L*D*L**T.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The block diagonal matrix D and the multipliers used to
+ obtain the factor U or L as computed by SSYTRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ Details of the interchanges and the block structure of D
+ as determined by SSYTRF.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param ipiv
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void ssytrs(String uplo, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBCON estimates the reciprocal of the condition number of a
+ triangular band matrix A, in either the 1-norm or the infinity-norm.
+
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param kd
+ * @param ab
+ * @param ldab
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void stbcon(String norm, String uplo, String diag, int n, int kd, float[] ab, int ldab, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular band
+ coefficient matrix.
+
+ The solution matrix X must be computed by STBTRS or some other
+ means before entering this routine. STBRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of the array. The j-th column of A is stored
+
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void stbrfs(String uplo, String trans, String diag, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STBTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular band matrix of order N, and B is an
+ N-by NRHS matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ KD (input) INTEGER
+ The number of superdiagonals or subdiagonals of the
+ triangular band matrix A. KD >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AB (input) REAL array, dimension (LDAB,N)
+ The upper or lower triangular band matrix A, stored in the
+ first kd+1 rows of AB. The j-th column of A is stored
+ in the j-th column of the array AB as follows:
+ if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+ if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ LDAB (input) INTEGER
+ The leading dimension of the array AB. LDAB >= KD+1.
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param kd
+ * @param nrhs
+ * @param ab
+ * @param ldab
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void stbtrs(String uplo, String trans, String diag, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+
+ Purpose
+ =======
+
+ STGEVC computes some or all of the right and/or left eigenvectors of
+
+ a pair of real matrices (S,P), where S is a quasi-triangular matrix
+ and P is upper triangular. Matrix pairs of this type are produced by
+ the generalized Schur factorization of a matrix pair (A,B):
+
+ A = Q*S*Z**T, B = Q*P*Z**T
+
+ as computed by SGGHRD + SHGEQZ.
+
+ The right eigenvector x and the left eigenvector y of (S,P)
+ corresponding to an eigenvalue w are defined by:
+
+ S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+
+ where y**H denotes the conjugate tranpose of y.
+ The eigenvalues are not input to this routine, but are computed
+ directly from the diagonal blocks of S and P.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+ where Z and Q are input matrices.
+ If Q and Z are the orthogonal factors from the generalized Schur
+ factorization of a matrix pair (A,B), then Z*X and Q*Y
+ are the matrices of right and left eigenvectors of (A,B).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ specified by the logical array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY='S', SELECT specifies the eigenvectors to be
+ computed. If w(j) is a real eigenvalue, the corresponding
+ real eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector
+ is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+ and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+ set to .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrices S and P. N >= 0.
+
+ S (input) REAL array, dimension (LDS,N)
+ The upper quasi-triangular matrix S from a generalized Schur
+
+ factorization, as computed by SHGEQZ.
+
+ LDS (input) INTEGER
+ The leading dimension of array S. LDS >= max(1,N).
+
+ P (input) REAL array, dimension (LDP,N)
+ The upper triangular matrix P from a generalized Schur
+ factorization, as computed by SHGEQZ.
+ 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+ of S must be in positive diagonal form.
+
+ LDP (input) INTEGER
+ The leading dimension of array P. LDP >= max(1,N).
+
+ VL (input/output) REAL array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of left Schur vectors returned by SHGEQZ).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
+
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
+
+ SELECT, stored consecutively in the columns of
+ VL, in the same order as their eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) REAL array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Z (usually the orthogonal matrix Z
+ of right Schur vectors returned by SHGEQZ).
+
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+ if HOWMNY = 'B' or 'b', the matrix Z*X;
+ if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+ specified by SELECT, stored consecutively in the
+
+ columns of VR, in the same order as their
+ eigenvalues.
+
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
+ is set to N. Each selected real eigenvector occupies one
+ column and each selected complex eigenvector occupies two
+ columns.
+
+ WORK (workspace) REAL array, dimension (6*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the 2-by-2 block (INFO:INFO+1) does not have a complex
+
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Allocation of workspace:
+ ---------- -- ---------
+
+ WORK( j ) = 1-norm of j-th column of A, above the diagonal
+ WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
+ WORK( 2*N+1:3*N ) = real part of eigenvector
+ WORK( 3*N+1:4*N ) = imaginary part of eigenvector
+ WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
+ WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
+
+ Rowwise vs. columnwise solution methods:
+ ------- -- ---------- -------- -------
+
+ Finding a generalized eigenvector consists basically of solving the
+ singular triangular system
+
+ (A - w B) x = 0 (for right) or: (A - w B)**H y = 0 (for left)
+
+ Consider finding the i-th right eigenvector (assume all eigenvalues
+ are real). The equation to be solved is:
+ n i
+ 0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. . .,1
+ k=j k=j
+
+ where C = (A - w B) (The components v(i+1:n) are 0.)
+
+ The "rowwise" method is:
+
+ (1) v(i) := 1
+ for j = i-1,. . .,1:
+ i
+ (2) compute s = - sum C(j,k) v(k) and
+ k=j+1
+
+ (3) v(j) := s / C(j,j)
+
+ Step 2 is sometimes called the "dot product" step, since it is an
+ inner product between the j-th row and the portion of the eigenvector
+ that has been computed so far.
+
+ The "columnwise" method consists basically in doing the sums
+ for all the rows in parallel. As each v(j) is computed, the
+ contribution of v(j) times the j-th column of C is added to the
+ partial sums. Since FORTRAN arrays are stored columnwise, this has
+ the advantage that at each step, the elements of C that are accessed
+
+ are adjacent to one another, whereas with the rowwise method, the
+ elements accessed at a step are spaced LDS (and LDP) words apart.
+
+ When finding left eigenvectors, the matrix in question is the
+ transpose of the one in storage, so the rowwise method then
+ actually accesses columns of A and B at each step, and so is the
+ preferred method.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param howmny
+ * @param select
+ * @param n
+ * @param s
+ * @param lds
+ * @param p
+ * @param ldp
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param mm
+ * @param m
+ * @param work
+ * @param info
+ */
+ public abstract void stgevc(String side, String howmny, boolean[] select, int n, float[] s, int lds, float[] p, int ldp, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
+ of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
+ (A, B) by an orthogonal equivalence transformation.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL arrays, dimensions (LDA,N)
+ On entry, the matrix A in the pair (A, B).
+ On exit, the updated matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL arrays, dimensions (LDB,N)
+ On entry, the matrix B in the pair (A, B).
+ On exit, the updated matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ Not referenced if WANTQ = .FALSE..
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ Not referenced if WANTZ = .FALSE..
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ J1 (input) INTEGER
+ The index to the first block (A11, B11). 1 <= J1 <= N.
+
+ N1 (input) INTEGER
+ The order of the first block (A11, B11). N1 = 0, 1 or 2.
+
+ N2 (input) INTEGER
+ The order of the second block (A22, B22). N2 = 0, 1 or 2.
+
+ WORK (workspace) REAL array, dimension (MAX(1,LWORK)).
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= MAX( N*(N2+N1), (N2+N1)*(N2+N1)*2 )
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ >0: If INFO = 1, the transformed matrix (A, B) would be
+ too far from generalized Schur form; the blocks are
+ not swapped and (A, B) and (Q, Z) are unchanged.
+ The problem of swapping is too ill-conditioned.
+ <0: If INFO = -16: LWORK is too small. Appropriate value
+ for LWORK is returned in WORK(1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ In the current code both weak and strong stability tests are
+ performed. The user can omit the strong stability test by changing
+ the internal logical parameter WANDS to .FALSE.. See ref. [2] for
+ details.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ =====================================================================
+ Replaced various illegal calls to SCOPY by calls to SLASET, or by DO
+
+ loops. Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+ * @param wantq
+ * @param wantz
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param j1
+ * @param n1
+ * @param n2
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void stgex2(boolean wantq, boolean wantz, int n, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, int j1, int n1, int n2, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGEXC reorders the generalized real Schur decomposition of a real
+ matrix pair (A,B) using an orthogonal equivalence transformation
+
+ (A, B) = Q * (A, B) * Z',
+
+ so that the diagonal block of (A, B) with row index IFST is moved
+ to row ILST.
+
+ (A, B) must be in generalized real Schur canonical form (as returned
+
+ by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+ diagonal blocks. B is upper triangular.
+
+ Optionally, the matrices Q and Z of generalized Schur vectors are
+ updated.
+
+ Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+ Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+
+
+ Arguments
+ =========
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the matrix A in generalized real Schur canonical
+ form.
+ On exit, the updated matrix A, again in generalized
+ real Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the matrix B in generalized real Schur canonical
+ form (A,B).
+ On exit, the updated matrix B, again in generalized
+ real Schur canonical form (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+ On exit, the updated matrix Q.
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1.
+ If WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
+ On exit, the updated matrix Z.
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If WANTZ = .TRUE., LDZ >= N.
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of (A, B).
+ The block with row index IFST is moved to row ILST, by a
+ sequence of swapping between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of
+ a 2-by-2 block, it is changed to point to the first row;
+ ILST always points to the first row of the block in its
+ final position (which may differ from its input value by
+ +1 or -1). 1 <= IFST, ILST <= N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: successful exit.
+ <0: if INFO = -i, the i-th argument had an illegal value.
+ =1: The transformed matrix pair (A, B) would be too far
+ from generalized Schur form; the problem is ill-
+ conditioned. (A, B) may have been partially reordered,
+
+ and ILST points to the first row of the current
+ position of the block being moved.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param wantq
+ * @param wantz
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param ifst
+ * @param ilst
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void stgexc(boolean wantq, boolean wantz, int n, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, intW ifst, intW ilst, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSEN reorders the generalized real Schur decomposition of a real
+ matrix pair (A, B) (in terms of an orthonormal equivalence trans-
+ formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
+ appears in the leading diagonal blocks of the upper quasi-triangular
+
+ matrix A and the upper triangular B. The leading columns of Q and
+ Z form orthonormal bases of the corresponding left and right eigen-
+ spaces (deflating subspaces). (A, B) must be in generalized real
+ Schur canonical form (as returned by SGGES), i.e. A is block upper
+ triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
+ triangular.
+
+ STGSEN also computes the generalized eigenvalues
+
+ w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
+
+ of the reordered matrix pair (A, B).
+
+ Optionally, STGSEN computes the estimates of reciprocal condition
+ numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
+ (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
+ between the matrix pairs (A11, B11) and (A22,B22) that correspond to
+
+ the selected cluster and the eigenvalues outside the cluster, resp.,
+
+ and norms of "projections" onto left and right eigenspaces w.r.t.
+ the selected cluster in the (1,1)-block.
+
+ Arguments
+ =========
+
+ IJOB (input) INTEGER
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (PL and PR) or the deflating subspaces
+ (Difu and Difl):
+ =0: Only reorder w.r.t. SELECT. No extras.
+ =1: Reciprocal of norms of "projections" onto left and right
+ eigenspaces w.r.t. the selected cluster (PL and PR).
+ =2: Upper bounds on Difu and Difl. F-norm-based estimate
+ (DIF(1:2)).
+ =3: Estimate of Difu and Difl. 1-norm-based estimate
+ (DIF(1:2)).
+ About 5 times as expensive as IJOB = 2.
+ =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
+ version to get it all.
+ =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
+
+ WANTQ (input) LOGICAL
+ .TRUE. : update the left transformation matrix Q;
+ .FALSE.: do not update Q.
+
+ WANTZ (input) LOGICAL
+ .TRUE. : update the right transformation matrix Z;
+ .FALSE.: do not update Z.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster.
+ To select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrices A and B. N >= 0.
+
+ A (input/output) REAL array, dimension(LDA,N)
+ On entry, the upper quasi-triangular matrix A, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, A is overwritten by the reordered matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension(LDB,N)
+ On entry, the upper triangular matrix B, with (A, B) in
+ generalized real Schur canonical form.
+ On exit, B is overwritten by the reordered matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ ALPHAR (output) REAL array, dimension (N)
+ ALPHAI (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+ be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+ and BETA(j),j=1,...,N are the diagonals of the complex Schur
+ form (S,T) that would result if the 2-by-2 diagonal blocks of
+ the real generalized Schur form of (A,B) were further reduced
+ to triangular form using complex unitary transformations.
+ If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+ positive, then the j-th and (j+1)-st eigenvalues are a
+ complex conjugate pair, with ALPHAI(j+1) negative.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
+ On exit, Q has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Q form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTQ = .FALSE., Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= 1;
+ and if WANTQ = .TRUE., LDQ >= N.
+
+ Z (input/output) REAL array, dimension (LDZ,N)
+ On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
+ On exit, Z has been postmultiplied by the left orthogonal
+ transformation matrix which reorder (A, B); The leading M
+ columns of Z form orthonormal bases for the specified pair of
+ left eigenspaces (deflating subspaces).
+ If WANTZ = .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1;
+ If WANTZ = .TRUE., LDZ >= N.
+
+ M (output) INTEGER
+ The dimension of the specified pair of left and right eigen-
+
+ spaces (deflating subspaces). 0 <= M <= N.
+
+ PL (output) REAL
+ PR (output) REAL
+ If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
+ reciprocal of the norm of "projections" onto left and right
+ eigenspaces with respect to the selected cluster.
+ 0 < PL, PR <= 1.
+ If M = 0 or M = N, PL = PR = 1.
+ If IJOB = 0, 2 or 3, PL and PR are not referenced.
+
+ DIF (output) REAL array, dimension (2).
+ If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
+
+ If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
+ Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
+ estimates of Difu and Difl.
+ If M = 0 or N, DIF(1:2) = F-norm([A, B]).
+ If IJOB = 0 or 1, DIF is not referenced.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 4*N+16.
+ If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
+ If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
+ IF IJOB = 0, IWORK is not referenced. Otherwise,
+ on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK. LIWORK >= 1.
+ If IJOB = 1, 2 or 4, LIWORK >= N+6.
+ If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ =0: Successful exit.
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ =1: Reordering of (A, B) failed because the transformed
+ matrix pair (A, B) would be too far from generalized
+ Schur form; the problem is very ill-conditioned.
+ (A, B) may have been partially reordered.
+ If requested, 0 is returned in DIF(*), PL and PR.
+
+ Further Details
+ ===============
+
+ STGSEN first collects the selected eigenvalues by computing
+ orthogonal U and W that move them to the top left corner of (A, B).
+ In other words, the selected eigenvalues are the eigenvalues of
+ (A11, B11) in:
+
+ U'*(A, B)*W = (A11 A12) (B11 B12) n1
+ ( 0 A22),( 0 B22) n2
+ n1 n2 n1 n2
+
+ where N = n1+n2 and U' means the transpose of U. The first n1 columns
+ of U and W span the specified pair of left and right eigenspaces
+ (deflating subspaces) of (A, B).
+
+ If (A, B) has been obtained from the generalized real Schur
+ decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
+ reordered generalized real Schur form of (C, D) is given by
+
+ (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
+
+ and the first n1 columns of Q*U and Z*W span the corresponding
+ deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
+
+ Note that if the selected eigenvalue is sufficiently ill-conditioned,
+ then its value may differ significantly from its value before
+ reordering.
+
+ The reciprocal condition numbers of the left and right eigenspaces
+ spanned by the first n1 columns of U and W (or Q*U and Z*W) may
+ be returned in DIF(1:2), corresponding to Difu and Difl, resp.
+
+ The Difu and Difl are defined as:
+
+ Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
+ and
+ Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
+
+ where sigma-min(Zu) is the smallest singular value of the
+ (2*n1*n2)-by-(2*n1*n2) matrix
+
+ Zu = [ kron(In2, A11) -kron(A22', In1) ]
+ [ kron(In2, B11) -kron(B22', In1) ].
+
+ Here, Inx is the identity matrix of size nx and A22' is the
+ transpose of A22. kron(X, Y) is the Kronecker product between
+ the matrices X and Y.
+
+ When DIF(2) is small, small changes in (A, B) can cause large changes
+ in the deflating subspace. An approximate (asymptotic) bound on the
+ maximum angular error in the computed deflating subspaces is
+
+ EPS * norm((A, B)) / DIF(2),
+
+ where EPS is the machine precision.
+
+ The reciprocal norm of the projectors on the left and right
+ eigenspaces associated with (A11, B11) may be returned in PL and PR.
+
+ They are computed as follows. First we compute L and R so that
+ P*(A, B)*Q is block diagonal, where
+
+ P = ( I -L ) n1 Q = ( I R ) n1
+ ( 0 I ) n2 and ( 0 I ) n2
+ n1 n2 n1 n2
+
+ and (L, R) is the solution to the generalized Sylvester equation
+
+ A11*R - L*A22 = -A12
+ B11*R - L*B22 = -B12
+
+ Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
+ An approximate (asymptotic) bound on the average absolute error of
+ the selected eigenvalues is
+
+ EPS * norm((A, B)) / PL.
+
+ There are also global error bounds which valid for perturbations up
+ to a certain restriction: A lower bound (x) on the smallest
+ F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
+ coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
+ (i.e. (A + E, B + F), is
+
+ x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
+
+
+ An approximate bound on x can be computed from DIF(1:2), PL and PR.
+
+ If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
+ (L', R') and unperturbed (L, R) left and right deflating subspaces
+ associated with the selected cluster in the (1,1)-blocks can be
+ bounded as
+
+ max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
+
+ max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
+
+
+ See LAPACK User's Guide section 4.11 or the following references
+ for more information.
+
+ Note that if the default method for computing the Frobenius-norm-
+ based estimate DIF is not wanted (see SLATDF), then the parameter
+ IDIFJB (see below) should be changed from 3 to 4 (routine SLATDF
+ (IJOB = 2 will be used)). See STGSYL for more details.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
+ 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param ijob
+ * @param wantq
+ * @param wantz
+ * @param select
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param alphar
+ * @param alphai
+ * @param beta
+ * @param q
+ * @param ldq
+ * @param z
+ * @param ldz
+ * @param m
+ * @param pl
+ * @param pr
+ * @param dif
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void stgsen(int ijob, boolean wantq, boolean wantz, boolean[] select, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] q, int ldq, float[] z, int ldz, intW m, floatW pl, floatW pr, float[] dif, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSJA computes the generalized singular value decomposition (GSVD)
+ of two real upper triangular (or trapezoidal) matrices A and B.
+
+ On entry, it is assumed that matrices A and B have the following
+ forms, which may be obtained by the preprocessing subroutine SGGSVP
+ from a general M-by-N matrix A and P-by-N matrix B:
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L >= 0;
+ L ( 0 0 A23 )
+ M-K-L ( 0 0 0 )
+
+ N-K-L K L
+ A = K ( 0 A12 A13 ) if M-K-L < 0;
+ M-K ( 0 0 A23 )
+
+ N-K-L K L
+ B = L ( 0 0 B13 )
+ P-L ( 0 0 0 )
+
+ where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+ upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+ otherwise A23 is (M-K)-by-L upper trapezoidal.
+
+ On exit,
+
+ U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ),
+
+ where U, V and Q are orthogonal matrices, Z' denotes the transpose
+ of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are
+ ``diagonal'' matrices, which are of the following structures:
+
+ If M-K-L >= 0,
+
+ K L
+ D1 = K ( I 0 )
+ L ( 0 C )
+ M-K-L ( 0 0 )
+
+ K L
+ D2 = L ( 0 S )
+ P-L ( 0 0 )
+
+ N-K-L K L
+ ( 0 R ) = K ( 0 R11 R12 ) K
+ L ( 0 0 R22 ) L
+
+ where
+
+ C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+ S = diag( BETA(K+1), ... , BETA(K+L) ),
+ C**2 + S**2 = I.
+
+ R is stored in A(1:K+L,N-K-L+1:N) on exit.
+
+ If M-K-L < 0,
+
+ K M-K K+L-M
+ D1 = K ( I 0 0 )
+ M-K ( 0 C 0 )
+
+ K M-K K+L-M
+ D2 = M-K ( 0 S 0 )
+ K+L-M ( 0 0 I )
+ P-L ( 0 0 0 )
+
+ N-K-L K M-K K+L-M
+ ( 0 R ) = K ( 0 R11 R12 R13 )
+ M-K ( 0 0 R22 R23 )
+ K+L-M ( 0 0 0 R33 )
+
+ where
+ C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+ S = diag( BETA(K+1), ... , BETA(M) ),
+ C**2 + S**2 = I.
+
+ R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
+
+ ( 0 R22 R23 )
+ in B(M-K+1:L,N+M-K-L+1:N) on exit.
+
+ The computation of the orthogonal transformation matrices U, V or Q
+ is optional. These matrices may either be formed explicitly, or they
+ may be postmultiplied into input matrices U1, V1, or Q1.
+
+ Arguments
+ =========
+
+ JOBU (input) CHARACTER*1
+ = 'U': U must contain an orthogonal matrix U1 on entry, and
+
+ the product U1*U is returned;
+ = 'I': U is initialized to the unit matrix, and the
+ orthogonal matrix U is returned;
+ = 'N': U is not computed.
+
+ JOBV (input) CHARACTER*1
+ = 'V': V must contain an orthogonal matrix V1 on entry, and
+
+ the product V1*V is returned;
+ = 'I': V is initialized to the unit matrix, and the
+ orthogonal matrix V is returned;
+ = 'N': V is not computed.
+
+ JOBQ (input) CHARACTER*1
+ = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
+
+ the product Q1*Q is returned;
+ = 'I': Q is initialized to the unit matrix, and the
+ orthogonal matrix Q is returned;
+ = 'N': Q is not computed.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ P (input) INTEGER
+ The number of rows of the matrix B. P >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrices A and B. N >= 0.
+
+ K (input) INTEGER
+ L (input) INTEGER
+ K and L specify the subblocks in the input matrices A and B:
+
+ A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
+ of A and B, whose GSVD is going to be computed by STGSJA.
+ See Further details.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
+ matrix R or part of R. See Purpose for details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) REAL array, dimension (LDB,N)
+ On entry, the P-by-N matrix B.
+ On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
+ a part of R. See Purpose for details.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,P).
+
+ TOLA (input) REAL
+ TOLB (input) REAL
+ TOLA and TOLB are the convergence criteria for the Jacobi-
+ Kogbetliantz iteration procedure. Generally, they are the
+ same as used in the preprocessing step, say
+ TOLA = max(M,N)*norm(A)*MACHEPS,
+ TOLB = max(P,N)*norm(B)*MACHEPS.
+
+ ALPHA (output) REAL array, dimension (N)
+ BETA (output) REAL array, dimension (N)
+ On exit, ALPHA and BETA contain the generalized singular
+ value pairs of A and B;
+ ALPHA(1:K) = 1,
+ BETA(1:K) = 0,
+ and if M-K-L >= 0,
+ ALPHA(K+1:K+L) = diag(C),
+ BETA(K+1:K+L) = diag(S),
+ or if M-K-L < 0,
+ ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
+ BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
+ Furthermore, if K+L < N,
+ ALPHA(K+L+1:N) = 0 and
+ BETA(K+L+1:N) = 0.
+
+ U (input/output) REAL array, dimension (LDU,M)
+ On entry, if JOBU = 'U', U must contain a matrix U1 (usually
+
+ the orthogonal matrix returned by SGGSVP).
+ On exit,
+ if JOBU = 'I', U contains the orthogonal matrix U;
+ if JOBU = 'U', U contains the product U1*U.
+ If JOBU = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,M) if
+ JOBU = 'U'; LDU >= 1 otherwise.
+
+ V (input/output) REAL array, dimension (LDV,P)
+ On entry, if JOBV = 'V', V must contain a matrix V1 (usually
+
+ the orthogonal matrix returned by SGGSVP).
+ On exit,
+ if JOBV = 'I', V contains the orthogonal matrix V;
+ if JOBV = 'V', V contains the product V1*V.
+ If JOBV = 'N', V is not referenced.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,P) if
+ JOBV = 'V'; LDV >= 1 otherwise.
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
+
+ the orthogonal matrix returned by SGGSVP).
+ On exit,
+ if JOBQ = 'I', Q contains the orthogonal matrix Q;
+ if JOBQ = 'Q', Q contains the product Q1*Q.
+ If JOBQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N) if
+ JOBQ = 'Q'; LDQ >= 1 otherwise.
+
+ WORK (workspace) REAL array, dimension (2*N)
+
+ NCYCLE (output) INTEGER
+ The number of cycles required for convergence.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ = 1: the procedure does not converge after MAXIT cycles.
+
+ Internal Parameters
+ ===================
+
+ MAXIT INTEGER
+ MAXIT specifies the total loops that the iterative procedure
+
+ may take. If after MAXIT cycles, the routine fails to
+ converge, we return INFO = 1.
+
+ Further Details
+ ===============
+
+ STGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
+ min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
+ matrix B13 to the form:
+
+ U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1,
+
+ where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose
+ of Z. C1 and S1 are diagonal matrices satisfying
+
+ C1**2 + S1**2 = I,
+
+ and R1 is an L-by-L nonsingular upper triangular matrix.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param jobu
+ * @param jobv
+ * @param jobq
+ * @param m
+ * @param p
+ * @param n
+ * @param k
+ * @param l
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param tola
+ * @param tolb
+ * @param alpha
+ * @param beta
+ * @param u
+ * @param ldu
+ * @param v
+ * @param ldv
+ * @param q
+ * @param ldq
+ * @param work
+ * @param ncycle
+ * @param info
+ */
+ public abstract void stgsja(String jobu, String jobv, String jobq, int m, int p, int n, int k, int l, float[] a, int lda, float[] b, int ldb, float tola, float tolb, float[] alpha, float[] beta, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, float[] work, intW ncycle, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or eigenvectors of a matrix pair (A, B) in
+ generalized real Schur canonical form (or of any matrix pair
+ (Q*A*Z', Q*B*Z') with orthogonal matrices Q and Z, where
+ Z' denotes the transpose of Z.
+
+ (A, B) must be in generalized real Schur form (as returned by SGGES),
+ i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal
+ blocks. B is upper triangular.
+
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (DIF):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (DIF);
+ = 'B': for both eigenvalues and eigenvectors (S and DIF).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the square matrix pair (A, B). N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The upper quasi-triangular matrix A in the pair (A,B).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,N)
+ The upper triangular matrix B in the pair (A,B).
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ VL (input) REAL array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns of VL, as returned by STGEVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1.
+ If JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) REAL array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of
+ (A, B), corresponding to the eigenpairs specified by HOWMNY
+ and SELECT. The eigenvectors must be stored in consecutive
+ columns ov VR, as returned by STGEVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1.
+ If JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) REAL array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), DIF(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ DIF (output) REAL array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of DIF are set to the same value. If
+ the eigenvalues cannot be reordered to compute DIF(j), DIF(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', DIF is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S and DIF. MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and DIF used to store
+
+ the specified condition numbers; for each selected real
+ eigenvalue one element is used, and for each selected complex
+ conjugate pair of eigenvalues, two elements are used.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ If JOB = 'V' or 'B' LWORK >= 2*N*(N+2)+16.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (N + 6)
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value
+
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of a generalized eigenvalue
+ w = (a, b) is defined as
+
+ S(w) = (|u'Av|**2 + |u'Bv|**2)**(1/2) / (norm(u)*norm(v))
+
+ where u and v are the left and right eigenvectors of (A, B)
+ corresponding to w; |z| denotes the absolute value of the complex
+ number, and norm(u) denotes the 2-norm of the vector u.
+ The pair (a, b) corresponds to an eigenvalue w = a/b (= u'Av/u'Bv)
+ of the matrix pair (A, B). If both a and b equal zero, then (A B) is
+
+ singular and S(I) = -1 is returned.
+
+ An approximate error bound on the chordal distance between the i-th
+ computed generalized eigenvalue w and the corresponding exact
+ eigenvalue lambda is
+
+ chord(w, lambda) <= EPS * norm(A, B) / S(I)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number DIF(i) of right eigenvector u
+
+ and left eigenvector v corresponding to the generalized eigenvalue w
+
+ is defined as follows:
+
+ a) If the i-th eigenvalue w = (a,b) is real
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( a * ) ( b * ) 1
+ ( 0 S22 ),( 0 T22 ) n-1
+ 1 n-1 1 n-1
+
+ Then the reciprocal condition number DIF(i) is
+
+ Difl((a, b), (S22, T22)) = sigma-min( Zl ),
+
+ where sigma-min(Zl) denotes the smallest singular value of the
+ 2(n-1)-by-2(n-1) matrix
+
+ Zl = [ kron(a, In-1) -kron(1, S22) ]
+ [ kron(b, In-1) -kron(1, T22) ] .
+
+ Here In-1 is the identity matrix of size n-1. kron(X, Y) is the
+ Kronecker product between the matrices X and Y.
+
+ Note that if the default method for computing DIF(i) is wanted
+ (see SLATDF), then the parameter DIFDRI (see below) should be
+ changed from 3 to 4 (routine SLATDF(IJOB = 2 will be used)).
+ See STGSYL for more details.
+
+ b) If the i-th and (i+1)-th eigenvalues are complex conjugate pair,
+
+ Suppose U and V are orthogonal transformations such that
+
+ U'*(A, B)*V = (S, T) = ( S11 * ) ( T11 * ) 2
+ ( 0 S22 ),( 0 T22) n-2
+ 2 n-2 2 n-2
+
+ and (S11, T11) corresponds to the complex conjugate eigenvalue
+ pair (w, conjg(w)). There exist unitary matrices U1 and V1 such
+ that
+
+ U1'*S11*V1 = ( s11 s12 ) and U1'*T11*V1 = ( t11 t12 )
+ ( 0 s22 ) ( 0 t22 )
+
+ where the generalized eigenvalues w = s11/t11 and
+ conjg(w) = s22/t22.
+
+ Then the reciprocal condition number DIF(i) is bounded by
+
+ min( d1, max( 1, |real(s11)/real(s22)| )*d2 )
+
+ where, d1 = Difl((s11, t11), (s22, t22)) = sigma-min(Z1), where
+ Z1 is the complex 2-by-2 matrix
+
+ Z1 = [ s11 -s22 ]
+ [ t11 -t22 ],
+
+ This is done by computing (using real arithmetic) the
+ roots of the characteristical polynomial det(Z1' * Z1 - lambda I),
+ where Z1' denotes the conjugate transpose of Z1 and det(X) denotes
+ the determinant of X.
+
+ and d2 is an upper bound on Difl((S11, T11), (S22, T22)), i.e. an
+
+ upper bound on sigma-min(Z2), where Z2 is (2n-2)-by-(2n-2)
+
+ Z2 = [ kron(S11', In-2) -kron(I2, S22) ]
+ [ kron(T11', In-2) -kron(I2, T22) ]
+
+ Note that if the default method for computing DIF is wanted (see
+ SLATDF), then the parameter DIFDRI (see below) should be changed
+ from 3 to 4 (routine SLATDF(IJOB = 2 will be used)). See STGSYL
+ for more details.
+
+ For each eigenvalue/vector specified by SELECT, DIF stores a
+ Frobenius norm-based estimate of Difl.
+
+ An approximate error bound for the i-th computed eigenvector VL(i) or
+ VR(i) is given by
+
+ EPS * norm(A, B) / DIF(i).
+
+ See ref. [2-3] for more details and further references.
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ References
+ ==========
+
+ [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+ Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+ M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+ Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+
+ [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+
+ Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+ Estimation: Theory, Algorithms and Software,
+ Report UMINF - 94.04, Department of Computing Science, Umea
+ University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+ Note 87. To appear in Numerical Algorithms, 1996.
+
+ [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param howmny
+ * @param select
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param s
+ * @param dif
+ * @param mm
+ * @param m
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void stgsna(String job, String howmny, boolean[] select, int n, float[] a, int lda, float[] b, int ldb, float[] vl, int ldvl, float[] vr, int ldvr, float[] s, float[] dif, int mm, intW m, float[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSY2 solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F,
+
+ using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
+
+ (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
+ N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
+ must be in generalized Schur canonical form, i.e. A, B are upper
+ quasi triangular and D, E are upper triangular. The solution (R, L)
+ overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
+ chosen to avoid overflow.
+
+ In matrix notation solving equation (1) corresponds to solve
+ Z*x = scale*b, where Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ],
+
+ Ik is the identity matrix of size k and X' is the transpose of X.
+ kron(X, Y) is the Kronecker product between the matrices X and Y.
+ In the process of solving (1), we solve a number of such systems
+ where Dim(In), Dim(In) = 1 or 2.
+
+ If TRANS = 'T', solve the transposed system Z'*y = scale*b for y,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * -F
+
+ This case is used to compute an estimate of Dif[(A, D), (B, E)] =
+ sigma_min(Z) using reverse communicaton with SLACON.
+
+ STGSY2 also (IJOB >= 1) contributes to the computation in STGSYL
+ of an upper bound on the separation between to matrix pairs. Then
+ the input (A, D), (B, E) are sub-pencils of the matrix pair in
+ STGSYL. See STGSYL for details.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T': solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ = 0: solve (1) only.
+ = 1: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (look ahead strategy is used).
+ = 2: A contribution from this subsystem to a Frobenius
+ norm-based estimate of the separation between two matrix
+ pairs is computed. (SGECON on sub-systems is used.)
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ On entry, M specifies the order of A and D, and the row
+ dimension of C, F, R and L.
+
+ N (input) INTEGER
+ On entry, N specifies the order of B and E, and the column
+ dimension of C, F, R and L.
+
+ A (input) REAL array, dimension (LDA, M)
+ On entry, A contains an upper quasi triangular matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the matrix A. LDA >= max(1, M).
+
+ B (input) REAL array, dimension (LDB, N)
+ On entry, B contains an upper quasi triangular matrix.
+
+ LDB (input) INTEGER
+ The leading dimension of the matrix B. LDB >= max(1, N).
+
+ C (input/output) REAL array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1).
+ On exit, if IJOB = 0, C has been overwritten by the
+ solution R.
+
+ LDC (input) INTEGER
+ The leading dimension of the matrix C. LDC >= max(1, M).
+
+ D (input) REAL array, dimension (LDD, M)
+ On entry, D contains an upper triangular matrix.
+
+ LDD (input) INTEGER
+ The leading dimension of the matrix D. LDD >= max(1, M).
+
+ E (input) REAL array, dimension (LDE, N)
+ On entry, E contains an upper triangular matrix.
+
+ LDE (input) INTEGER
+ The leading dimension of the matrix E. LDE >= max(1, N).
+
+ F (input/output) REAL array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1).
+ On exit, if IJOB = 0, F has been overwritten by the
+ solution L.
+
+ LDF (input) INTEGER
+ The leading dimension of the matrix F. LDF >= max(1, M).
+
+ SCALE (output) REAL
+ On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
+ R and L (C and F on entry) will hold the solutions to a
+ slightly perturbed system but the input matrices A, B, D and
+
+ E have not been changed. If SCALE = 0, R and L will hold the
+
+ solutions to the homogeneous system with C = F = 0. Normally,
+ SCALE = 1.
+
+ RDSUM (input/output) REAL
+ On entry, the sum of squares of computed contributions to
+ the Dif-estimate under computation by STGSYL, where the
+ scaling factor RDSCAL (see below) has been factored out.
+ On exit, the corresponding sum of squares updated with the
+ contributions from the current sub-system.
+ If TRANS = 'T' RDSUM is not touched.
+ NOTE: RDSUM only makes sense when STGSY2 is called by STGSYL.
+
+ RDSCAL (input/output) REAL
+ On entry, scaling factor used to prevent overflow in RDSUM.
+ On exit, RDSCAL is updated w.r.t. the current contributions
+ in RDSUM.
+ If TRANS = 'T', RDSCAL is not touched.
+ NOTE: RDSCAL only makes sense when STGSY2 is called by
+ STGSYL.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+2)
+
+ PQ (output) INTEGER
+ On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
+ 8-by-8) solved by this routine.
+
+ INFO (output) INTEGER
+ On exit, if INFO is set to
+ =0: Successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: The matrix pairs (A, D) and (B, E) have common or very
+
+ close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ =====================================================================
+ Replaced various illegal calls to SCOPY by calls to SLASET.
+ Sven Hammarling, 27/5/02.
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param ijob
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param Ldc
+ * @param d
+ * @param ldd
+ * @param e
+ * @param lde
+ * @param f
+ * @param ldf
+ * @param scale
+ * @param rdsum
+ * @param rdscal
+ * @param iwork
+ * @param pq
+ * @param info
+ */
+ public abstract void stgsy2(String trans, int ijob, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, float[] d, int ldd, float[] e, int lde, float[] f, int ldf, floatW scale, floatW rdsum, floatW rdscal, int[] iwork, intW pq, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STGSYL solves the generalized Sylvester equation:
+
+ A * R - L * B = scale * C (1)
+ D * R - L * E = scale * F
+
+ where R and L are unknown m-by-n matrices, (A, D), (B, E) and
+ (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
+ respectively, with real entries. (A, D) and (B, E) must be in
+ generalized (real) Schur canonical form, i.e. A, B are upper quasi
+ triangular and D, E are upper triangular.
+
+ The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
+ scaling factor chosen to avoid overflow.
+
+ In matrix notation (1) is equivalent to solve Zx = scale b, where
+ Z is defined as
+
+ Z = [ kron(In, A) -kron(B', Im) ] (2)
+ [ kron(In, D) -kron(E', Im) ].
+
+ Here Ik is the identity matrix of size k and X' is the transpose of
+ X. kron(X, Y) is the Kronecker product between the matrices X and Y.
+
+
+ If TRANS = 'T', STGSYL solves the transposed system Z'*y = scale*b,
+ which is equivalent to solve for R and L in
+
+ A' * R + D' * L = scale * C (3)
+ R * B' + L * E' = scale * (-F)
+
+ This case (TRANS = 'T') is used to compute an one-norm-based estimate
+ of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
+ and (B,E), using SLACON.
+
+ If IJOB >= 1, STGSYL computes a Frobenius norm-based estimate
+ of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
+
+ reciprocal of the smallest singular value of Z. See [1-2] for more
+ information.
+
+ This is a level 3 BLAS algorithm.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ = 'N', solve the generalized Sylvester equation (1).
+ = 'T', solve the 'transposed' system (3).
+
+ IJOB (input) INTEGER
+ Specifies what kind of functionality to be performed.
+ =0: solve (1) only.
+ =1: The functionality of 0 and 3.
+ =2: The functionality of 0 and 4.
+ =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ (look ahead strategy IJOB = 1 is used).
+ =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
+ ( SGECON on sub-systems is used ).
+ Not referenced if TRANS = 'T'.
+
+ M (input) INTEGER
+ The order of the matrices A and D, and the row dimension of
+ the matrices C, F, R and L.
+
+ N (input) INTEGER
+ The order of the matrices B and E, and the column dimension
+ of the matrices C, F, R and L.
+
+ A (input) REAL array, dimension (LDA, M)
+ The upper quasi triangular matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1, M).
+
+ B (input) REAL array, dimension (LDB, N)
+ The upper quasi triangular matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1, N).
+
+ C (input/output) REAL array, dimension (LDC, N)
+ On entry, C contains the right-hand-side of the first matrix
+
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, C has been overwritten by
+ the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1, M).
+
+ D (input) REAL array, dimension (LDD, M)
+ The upper triangular matrix D.
+
+ LDD (input) INTEGER
+ The leading dimension of the array D. LDD >= max(1, M).
+
+ E (input) REAL array, dimension (LDE, N)
+ The upper triangular matrix E.
+
+ LDE (input) INTEGER
+ The leading dimension of the array E. LDE >= max(1, N).
+
+ F (input/output) REAL array, dimension (LDF, N)
+ On entry, F contains the right-hand-side of the second matrix
+ equation in (1) or (3).
+ On exit, if IJOB = 0, 1 or 2, F has been overwritten by
+ the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
+
+ the solution achieved during the computation of the
+ Dif-estimate.
+
+ LDF (input) INTEGER
+ The leading dimension of the array F. LDF >= max(1, M).
+
+ DIF (output) REAL
+ On exit DIF is the reciprocal of a lower bound of the
+ reciprocal of the Dif-function, i.e. DIF is an upper bound of
+ Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
+ IF IJOB = 0 or TRANS = 'T', DIF is not touched.
+
+ SCALE (output) REAL
+ On exit SCALE is the scaling factor in (1) or (3).
+ If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
+
+ to a slightly perturbed system but the input matrices A, B, D
+ and E have not been changed. If SCALE = 0, C and F hold the
+ solutions R and L, respectively, to the homogeneous system
+ with C = F = 0. Normally, SCALE = 1.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK > = 1.
+ If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (M+N+6)
+
+ INFO (output) INTEGER
+ =0: successful exit
+ <0: If INFO = -i, the i-th argument had an illegal value.
+ >0: (A, D) and (B, E) have common or close eigenvalues.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+ Umea University, S-901 87 Umea, Sweden.
+
+ [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+
+ for Solving the Generalized Sylvester Equation and Estimating the
+ Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+ Department of Computing Science, Umea University, S-901 87 Umea,
+
+ Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+ Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+ No 1, 1996.
+
+ [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
+ Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
+ Appl., 15(4):1045-1060, 1994
+
+ [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
+ Condition Estimators for Solving the Generalized Sylvester
+ Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
+ July 1989, pp 745-751.
+
+ =====================================================================
+ Replaced various illegal calls to SCOPY by calls to SLASET.
+ Sven Hammarling, 1/5/02.
+
+ .. Parameters ..
+</pre>
+ * @param trans
+ * @param ijob
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param Ldc
+ * @param d
+ * @param ldd
+ * @param e
+ * @param lde
+ * @param f
+ * @param ldf
+ * @param scale
+ * @param dif
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void stgsyl(String trans, int ijob, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, float[] d, int ldd, float[] e, int lde, float[] f, int ldf, floatW scale, floatW dif, float[] work, int lwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPCON estimates the reciprocal of the condition number of a packed
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param ap
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void stpcon(String norm, String uplo, String diag, int n, float[] ap, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular packed
+ coefficient matrix.
+
+ The solution matrix X must be computed by STPTRS or some other
+ means before entering this routine. STPRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+ If DIAG = 'U', the diagonal elements of A are not referenced
+
+ and are assumed to be 1.
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void stprfs(String uplo, String trans, String diag, int n, int nrhs, float[] ap, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPTRI computes the inverse of a real upper or lower triangular
+ matrix A stored in packed format.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ AP (input/output) REAL array, dimension (N*(N+1)/2)
+ On entry, the upper or lower triangular matrix A, stored
+ columnwise in a linear array. The j-th column of A is stored
+ in the array AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*((2*n-j)/2) = A(i,j) for j<=i<=n.
+ See below for further details.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same packed storage format.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+ Further Details
+ ===============
+
+ A triangular matrix A can be transferred to packed storage using one
+
+ of the following program segments:
+
+ UPLO = 'U': UPLO = 'L':
+
+ JC = 1 JC = 1
+ DO 2 J = 1, N DO 2 J = 1, N
+ DO 1 I = 1, J DO 1 I = J, N
+ AP(JC+I-1) = A(I,J) AP(JC+I-J) = A(I,J)
+ 1 CONTINUE 1 CONTINUE
+ JC = JC + J JC = JC + N - J + 1
+ 2 CONTINUE 2 CONTINUE
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param ap
+ * @param info
+ */
+ public abstract void stptri(String uplo, String diag, int n, float[] ap, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STPTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N stored in packed format,
+ and B is an N-by-NRHS matrix. A check is made to verify that A is
+ nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ AP (input) REAL array, dimension (N*(N+1)/2)
+ The upper or lower triangular matrix A, packed columnwise in
+
+ a linear array. The j-th column of A is stored in the array
+
+ AP as follows:
+ if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
+ if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
+
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the
+ solutions X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param ap
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void stptrs(String uplo, String trans, String diag, int n, int nrhs, float[] ap, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRCON estimates the reciprocal of the condition number of a
+ triangular matrix A, in either the 1-norm or the infinity-norm.
+
+ The norm of A is computed and an estimate is obtained for
+ norm(inv(A)), then the reciprocal of the condition number is
+ computed as
+ RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies whether the 1-norm condition number or the
+ infinity-norm condition number is required:
+ = '1' or 'O': 1-norm;
+ = 'I': Infinity-norm.
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ RCOND (output) REAL
+ The reciprocal of the condition number of the matrix A,
+ computed as RCOND = 1/(norm(A) * norm(inv(A))).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param norm
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param rcond
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void strcon(String norm, String uplo, String diag, int n, float[] a, int lda, floatW rcond, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STREVC computes some or all of the right and/or left eigenvectors of
+
+ a real upper quasi-triangular matrix T.
+ Matrices of this type are produced by the Schur factorization of
+ a real general matrix: A = Q*T*Q**T, as computed by SHSEQR.
+
+ The right eigenvector x and the left eigenvector y of T corresponding
+ to an eigenvalue w are defined by:
+
+ T*x = w*x, (y**H)*T = w*(y**H)
+
+ where y**H denotes the conjugate transpose of y.
+ The eigenvalues are not input to this routine, but are read directly
+
+ from the diagonal blocks of T.
+
+ This routine returns the matrices X and/or Y of right and left
+ eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+ input matrix. If Q is the orthogonal factor that reduces a matrix
+ A to Schur form T, then Q*X and Q*Y are the matrices of right and
+ left eigenvectors of A.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ backtransformed by the matrices in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ as indicated by the logical array SELECT.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+ computed.
+ If w(j) is a real eigenvalue, the corresponding real
+ eigenvector is computed if SELECT(j) is .TRUE..
+ If w(j) and w(j+1) are the real and imaginary parts of a
+ complex eigenvalue, the corresponding complex eigenvector is
+
+ computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+ on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+
+ .FALSE..
+ Not referenced if HOWMNY = 'A' or 'B'.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) REAL array, dimension (LDT,N)
+ The upper quasi-triangular matrix T in Schur canonical form.
+
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input/output) REAL array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by SHSEQR).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VL, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+ Not referenced if SIDE = 'R'.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1, and if
+ SIDE = 'L' or 'B', LDVL >= N.
+
+ VR (input/output) REAL array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by SHSEQR).
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+ if HOWMNY = 'B', the matrix Q*X;
+ if HOWMNY = 'S', the right eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+
+ of VR, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+ Not referenced if SIDE = 'L'.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1, and if
+ SIDE = 'R' or 'B', LDVR >= N.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors.
+ If HOWMNY = 'A' or 'B', M is set to N.
+ Each selected real eigenvector occupies one column and each
+ selected complex eigenvector occupies two columns.
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The algorithm used in this program is basically backward (forward)
+ substitution, with scaling to make the the code robust against
+ possible overflow.
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x| + |y|.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param side
+ * @param howmny
+ * @param select
+ * @param n
+ * @param t
+ * @param ldt
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param mm
+ * @param m
+ * @param work
+ * @param info
+ */
+ public abstract void strevc(String side, String howmny, boolean[] select, int n, float[] t, int ldt, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STREXC reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
+
+ moved to row ILST.
+
+ The real Schur form T is reordered by an orthogonal similarity
+ transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
+ is updated by postmultiplying it with Z.
+
+ T must be in Schur canonical form (as returned by SHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) REAL array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ Schur canonical form.
+ On exit, the reordered upper quasi-triangular matrix, again
+ in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix Z which reorders T.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ IFST (input/output) INTEGER
+ ILST (input/output) INTEGER
+ Specify the reordering of the diagonal blocks of T.
+ The block with row index IFST is moved to row ILST, by a
+ sequence of transpositions between adjacent blocks.
+ On exit, if IFST pointed on entry to the second row of a
+ 2-by-2 block, it is changed to point to the first row; ILST
+ always points to the first row of the block in its final
+ position (which may differ from its input value by +1 or -1).
+ 1 <= IFST <= N; 1 <= ILST <= N.
+
+ WORK (workspace) REAL array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: two adjacent blocks were too close to swap (the problem
+ is very ill-conditioned); T may have been partially
+ reordered, and ILST points to the first row of the
+ current position of the block being moved.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param compq
+ * @param n
+ * @param t
+ * @param ldt
+ * @param q
+ * @param ldq
+ * @param ifst
+ * @param ilst
+ * @param work
+ * @param info
+ */
+ public abstract void strexc(String compq, int n, float[] t, int ldt, float[] q, int ldq, intW ifst, intW ilst, float[] work, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRRFS provides error bounds and backward error estimates for the
+ solution to a system of linear equations with a triangular
+ coefficient matrix.
+
+ The solution matrix X must be computed by STRTRS or some other
+ means before entering this routine. STRRFS does not do iterative
+ refinement because doing so cannot improve the backward error.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input) REAL array, dimension (LDB,NRHS)
+ The right hand side matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ X (input) REAL array, dimension (LDX,NRHS)
+ The solution matrix X.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,N).
+
+ FERR (output) REAL array, dimension (NRHS)
+ The estimated forward error bound for each solution vector
+ X(j) (the j-th column of the solution matrix X).
+ If XTRUE is the true solution corresponding to X(j), FERR(j)
+
+ is an estimated upper bound for the magnitude of the largest
+
+ element in (X(j) - XTRUE) divided by the magnitude of the
+ largest element in X(j). The estimate is as reliable as
+ the estimate for RCOND, and is almost always a slight
+ overestimate of the true error.
+
+ BERR (output) REAL array, dimension (NRHS)
+ The componentwise relative backward error of each solution
+ vector X(j) (i.e., the smallest relative change in
+ any element of A or B that makes X(j) an exact solution).
+
+ WORK (workspace) REAL array, dimension (3*N)
+
+ IWORK (workspace) INTEGER array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param x
+ * @param ldx
+ * @param ferr
+ * @param berr
+ * @param work
+ * @param iwork
+ * @param info
+ */
+ public abstract void strrfs(String uplo, String trans, String diag, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSEN reorders the real Schur factorization of a real matrix
+ A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
+ the leading diagonal blocks of the upper quasi-triangular matrix T,
+ and the leading columns of Q form an orthonormal basis of the
+ corresponding right invariant subspace.
+
+ Optionally the routine computes the reciprocal condition numbers of
+ the cluster of eigenvalues and/or the invariant subspace.
+
+ T must be in Schur canonical form (as returned by SHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elemnts equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for the
+ cluster of eigenvalues (S) or the invariant subspace (SEP):
+ = 'N': none;
+ = 'E': for eigenvalues only (S);
+ = 'V': for invariant subspace only (SEP);
+ = 'B': for both eigenvalues and invariant subspace (S and
+ SEP).
+
+ COMPQ (input) CHARACTER*1
+ = 'V': update the matrix Q of Schur vectors;
+ = 'N': do not update Q.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ SELECT specifies the eigenvalues in the selected cluster. To
+
+ select a real eigenvalue w(j), SELECT(j) must be set to
+ .TRUE.. To select a complex conjugate pair of eigenvalues
+ w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+ either SELECT(j) or SELECT(j+1) or both must be set to
+ .TRUE.; a complex conjugate pair of eigenvalues must be
+ either both included in the cluster or both excluded.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) REAL array, dimension (LDT,N)
+ On entry, the upper quasi-triangular matrix T, in Schur
+ canonical form.
+ On exit, T is overwritten by the reordered matrix T, again in
+ Schur canonical form, with the selected eigenvalues in the
+ leading diagonal blocks.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ Q (input/output) REAL array, dimension (LDQ,N)
+ On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
+ On exit, if COMPQ = 'V', Q has been postmultiplied by the
+ orthogonal transformation matrix which reorders T; the
+ leading M columns of Q form an orthonormal basis for the
+ specified invariant subspace.
+ If COMPQ = 'N', Q is not referenced.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q.
+ LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
+
+ WR (output) REAL array, dimension (N)
+ WI (output) REAL array, dimension (N)
+ The real and imaginary parts, respectively, of the reordered
+
+ eigenvalues of T. The eigenvalues are stored in the same
+ order as on the diagonal of T, with WR(i) = T(i,i) and, if
+ T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
+ WI(i+1) = -WI(i). Note that if a complex eigenvalue is
+ sufficiently ill-conditioned, then its value may differ
+ significantly from its value before reordering.
+
+ M (output) INTEGER
+ The dimension of the specified invariant subspace.
+ 0 < = M <= N.
+
+ S (output) REAL
+ If JOB = 'E' or 'B', S is a lower bound on the reciprocal
+ condition number for the selected cluster of eigenvalues.
+ S cannot underestimate the true reciprocal condition number
+ by more than a factor of sqrt(N). If M = 0 or N, S = 1.
+ If JOB = 'N' or 'V', S is not referenced.
+
+ SEP (output) REAL
+ If JOB = 'V' or 'B', SEP is the estimated reciprocal
+ condition number of the specified invariant subspace. If
+ M = 0 or N, SEP = norm(T).
+ If JOB = 'N' or 'E', SEP is not referenced.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If JOB = 'N', LWORK >= max(1,N);
+ if JOB = 'E', LWORK >= max(1,M*(N-M));
+ if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (MAX(1,LIWORK))
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If JOB = 'N' or 'E', LIWORK >= 1;
+ if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: reordering of T failed because some eigenvalues are too
+
+ close to separate (the problem is very ill-conditioned);
+ T may have been partially reordered, and WR and WI
+ contain the eigenvalues in the same order as in T; S and
+ SEP (if requested) are set to zero.
+
+ Further Details
+ ===============
+
+ STRSEN first collects the selected eigenvalues by computing an
+ orthogonal transformation Z to move them to the top left corner of T.
+ In other words, the selected eigenvalues are the eigenvalues of T11
+ in:
+
+ Z'*T*Z = ( T11 T12 ) n1
+ ( 0 T22 ) n2
+ n1 n2
+
+ where N = n1+n2 and Z' means the transpose of Z. The first n1 columns
+ of Z span the specified invariant subspace of T.
+
+ If T has been obtained from the real Schur factorization of a matrix
+
+ A = Q*T*Q', then the reordered real Schur factorization of A is given
+ by A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span
+ the corresponding invariant subspace of A.
+
+ The reciprocal condition number of the average of the eigenvalues of
+
+ T11 may be returned in S. S lies between 0 (very badly conditioned)
+ and 1 (very well conditioned). It is computed as follows. First we
+ compute R so that
+
+ P = ( I R ) n1
+ ( 0 0 ) n2
+ n1 n2
+
+ is the projector on the invariant subspace associated with T11.
+ R is the solution of the Sylvester equation:
+
+ T11*R - R*T22 = T12.
+
+ Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
+ the two-norm of M. Then S is computed as the lower bound
+
+ (1 + F-norm(R)**2)**(-1/2)
+
+ on the reciprocal of 2-norm(P), the true reciprocal condition number.
+ S cannot underestimate 1 / 2-norm(P) by more than a factor of
+ sqrt(N).
+
+ An approximate error bound for the computed average of the
+ eigenvalues of T11 is
+
+ EPS * norm(T) / S
+
+ where EPS is the machine precision.
+
+ The reciprocal condition number of the right invariant subspace
+ spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
+
+ SEP is defined as the separation of T11 and T22:
+
+ sep( T11, T22 ) = sigma-min( C )
+
+ where sigma-min(C) is the smallest singular value of the
+ n1*n2-by-n1*n2 matrix
+
+ C = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
+
+ I(m) is an m by m identity matrix, and kprod denotes the Kronecker
+ product. We estimate sigma-min(C) by the reciprocal of an estimate of
+ the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
+ cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
+
+ When SEP is small, small changes in T can cause large changes in
+ the invariant subspace. An approximate bound on the maximum angular
+ error in the computed right invariant subspace is
+
+ EPS * norm(T) / SEP
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param compq
+ * @param select
+ * @param n
+ * @param t
+ * @param ldt
+ * @param q
+ * @param ldq
+ * @param wr
+ * @param wi
+ * @param m
+ * @param s
+ * @param sep
+ * @param work
+ * @param lwork
+ * @param iwork
+ * @param liwork
+ * @param info
+ */
+ public abstract void strsen(String job, String compq, boolean[] select, int n, float[] t, int ldt, float[] q, int ldq, float[] wr, float[] wi, intW m, floatW s, floatW sep, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSNA estimates reciprocal condition numbers for specified
+ eigenvalues and/or right eigenvectors of a real upper
+ quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
+ orthogonal).
+
+ T must be in Schur canonical form (as returned by SHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies whether condition numbers are required for
+ eigenvalues (S) or eigenvectors (SEP):
+ = 'E': for eigenvalues only (S);
+ = 'V': for eigenvectors only (SEP);
+ = 'B': for both eigenvalues and eigenvectors (S and SEP).
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute condition numbers for all eigenpairs;
+ = 'S': compute condition numbers for selected eigenpairs
+ specified by the array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenpairs for which
+ condition numbers are required. To select condition numbers
+ for the eigenpair corresponding to a real eigenvalue w(j),
+ SELECT(j) must be set to .TRUE.. To select condition numbers
+
+ corresponding to a complex conjugate pair of eigenvalues w(j)
+ and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
+
+ set to .TRUE..
+ If HOWMNY = 'A', SELECT is not referenced.
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) REAL array, dimension (LDT,N)
+ The upper quasi-triangular matrix T, in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input) REAL array, dimension (LDVL,M)
+ If JOB = 'E' or 'B', VL must contain left eigenvectors of T
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VL, as returned by
+ SHSEIN or STREVC.
+ If JOB = 'V', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL.
+ LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
+
+ VR (input) REAL array, dimension (LDVR,M)
+ If JOB = 'E' or 'B', VR must contain right eigenvectors of T
+
+ (or of any Q*T*Q**T with Q orthogonal), corresponding to the
+
+ eigenpairs specified by HOWMNY and SELECT. The eigenvectors
+ must be stored in consecutive columns of VR, as returned by
+ SHSEIN or STREVC.
+ If JOB = 'V', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR.
+ LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
+
+ S (output) REAL array, dimension (MM)
+ If JOB = 'E' or 'B', the reciprocal condition numbers of the
+
+ selected eigenvalues, stored in consecutive elements of the
+ array. For a complex conjugate pair of eigenvalues two
+ consecutive elements of S are set to the same value. Thus
+ S(j), SEP(j), and the j-th columns of VL and VR all
+ correspond to the same eigenpair (but not in general the
+ j-th eigenpair, unless all eigenpairs are selected).
+ If JOB = 'V', S is not referenced.
+
+ SEP (output) REAL array, dimension (MM)
+ If JOB = 'V' or 'B', the estimated reciprocal condition
+ numbers of the selected eigenvectors, stored in consecutive
+ elements of the array. For a complex eigenvector two
+ consecutive elements of SEP are set to the same value. If
+ the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
+ is set to 0; this can only occur when the true value would be
+ very small anyway.
+ If JOB = 'E', SEP is not referenced.
+
+ MM (input) INTEGER
+ The number of elements in the arrays S (if JOB = 'E' or 'B')
+
+ and/or SEP (if JOB = 'V' or 'B'). MM >= M.
+
+ M (output) INTEGER
+ The number of elements of the arrays S and/or SEP actually
+ used to store the estimated condition numbers.
+ If HOWMNY = 'A', M is set to N.
+
+ WORK (workspace) REAL array, dimension (LDWORK,N+6)
+ If JOB = 'E', WORK is not referenced.
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
+
+ IWORK (workspace) INTEGER array, dimension (2*(N-1))
+ If JOB = 'E', IWORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The reciprocal of the condition number of an eigenvalue lambda is
+ defined as
+
+ S(lambda) = |v'*u| / (norm(u)*norm(v))
+
+ where u and v are the right and left eigenvectors of T corresponding
+
+ to lambda; v' denotes the conjugate-transpose of v, and norm(u)
+ denotes the Euclidean norm. These reciprocal condition numbers always
+ lie between zero (very badly conditioned) and one (very well
+ conditioned). If n = 1, S(lambda) is defined to be 1.
+
+ An approximate error bound for a computed eigenvalue W(i) is given by
+
+ EPS * norm(T) / S(i)
+
+ where EPS is the machine precision.
+
+ The reciprocal of the condition number of the right eigenvector u
+ corresponding to lambda is defined as follows. Suppose
+
+ T = ( lambda c )
+ ( 0 T22 )
+
+ Then the reciprocal condition number is
+
+ SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
+
+ where sigma-min denotes the smallest singular value. We approximate
+ the smallest singular value by the reciprocal of an estimate of the
+ one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
+ defined to be abs(T(1,1)).
+
+ An approximate error bound for a computed right eigenvector VR(i)
+ is given by
+
+ EPS * norm(T) / SEP(i)
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param job
+ * @param howmny
+ * @param select
+ * @param n
+ * @param t
+ * @param ldt
+ * @param vl
+ * @param ldvl
+ * @param vr
+ * @param ldvr
+ * @param s
+ * @param sep
+ * @param mm
+ * @param m
+ * @param work
+ * @param ldwork
+ * @param iwork
+ * @param info
+ */
+ public abstract void strsna(String job, String howmny, boolean[] select, int n, float[] t, int ldt, float[] vl, int ldvl, float[] vr, int ldvr, float[] s, float[] sep, int mm, intW m, float[] work, int ldwork, int[] iwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRSYL solves the real Sylvester matrix equation:
+
+ op(A)*X + X*op(B) = scale*C or
+ op(A)*X - X*op(B) = scale*C,
+
+ where op(A) = A or A**T, and A and B are both upper quasi-
+ triangular. A is M-by-M and B is N-by-N; the right hand side C and
+ the solution X are M-by-N; and scale is an output scale factor, set
+ <= 1 to avoid overflow in X.
+
+ A and B must be in Schur canonical form (as returned by SHSEQR), that
+ is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
+ each 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign.
+
+ Arguments
+ =========
+
+ TRANA (input) CHARACTER*1
+ Specifies the option op(A):
+ = 'N': op(A) = A (No transpose)
+ = 'T': op(A) = A**T (Transpose)
+ = 'C': op(A) = A**H (Conjugate transpose = Transpose)
+
+ TRANB (input) CHARACTER*1
+ Specifies the option op(B):
+ = 'N': op(B) = B (No transpose)
+ = 'T': op(B) = B**T (Transpose)
+ = 'C': op(B) = B**H (Conjugate transpose = Transpose)
+
+ ISGN (input) INTEGER
+ Specifies the sign in the equation:
+ = +1: solve op(A)*X + X*op(B) = scale*C
+ = -1: solve op(A)*X - X*op(B) = scale*C
+
+ M (input) INTEGER
+ The order of the matrix A, and the number of rows in the
+ matrices X and C. M >= 0.
+
+ N (input) INTEGER
+ The order of the matrix B, and the number of columns in the
+ matrices X and C. N >= 0.
+
+ A (input) REAL array, dimension (LDA,M)
+ The upper quasi-triangular matrix A, in Schur canonical form.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input) REAL array, dimension (LDB,N)
+ The upper quasi-triangular matrix B, in Schur canonical form.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ C (input/output) REAL array, dimension (LDC,N)
+ On entry, the M-by-N right hand side matrix C.
+ On exit, C is overwritten by the solution matrix X.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M)
+
+ SCALE (output) REAL
+ The scale factor, scale, set <= 1 to avoid overflow in X.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ = 1: A and B have common or very close eigenvalues; perturbed
+ values were used to solve the equation (but the matrices
+ A and B are unchanged).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param trana
+ * @param tranb
+ * @param isgn
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param c
+ * @param Ldc
+ * @param scale
+ * @param info
+ */
+ public abstract void strsyl(String trana, String tranb, int isgn, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, floatW scale, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRTI2 computes the inverse of a real upper or lower triangular
+ matrix.
+
+ This is the Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading n by n upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void strti2(String uplo, String diag, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRTRI computes the inverse of a real upper or lower triangular
+ matrix A.
+
+ This is the Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the triangular matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of the array A contains
+
+ the upper triangular matrix, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of the array A contains
+
+ the lower triangular matrix, and the strictly upper
+ triangular part of A is not referenced. If DIAG = 'U', the
+ diagonal elements of A are also not referenced and are
+ assumed to be 1.
+ On exit, the (triangular) inverse of the original matrix, in
+
+ the same storage format.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, A(i,i) is exactly zero. The triangular
+ matrix is singular and its inverse can not be computed.
+
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param diag
+ * @param n
+ * @param a
+ * @param lda
+ * @param info
+ */
+ public abstract void strtri(String uplo, String diag, int n, float[] a, int lda, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STRTRS solves a triangular system of the form
+
+ A * X = B or A**T * X = B,
+
+ where A is a triangular matrix of order N, and B is an N-by-NRHS
+ matrix. A check is made to verify that A is nonsingular.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': A is upper triangular;
+ = 'L': A is lower triangular.
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose = Transpose)
+
+ DIAG (input) CHARACTER*1
+ = 'N': A is non-unit triangular;
+ = 'U': A is unit triangular.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) REAL array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading N-by-N
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+
+ A is not referenced. If UPLO = 'L', the leading N-by-N lower
+ triangular part of the array A contains the lower triangular
+
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ B (input/output) REAL array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, if INFO = 0, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the i-th diagonal element of A is zero,
+ indicating that the matrix is singular and the solutions
+ X have not been computed.
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param uplo
+ * @param trans
+ * @param diag
+ * @param n
+ * @param nrhs
+ * @param a
+ * @param lda
+ * @param b
+ * @param ldb
+ * @param info
+ */
+ public abstract void strtrs(String uplo, String trans, String diag, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ This routine is deprecated and has been replaced by routine STZRZF.
+
+ STZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param info
+ */
+ public abstract void stzrqf(int m, int n, float[] a, int lda, float[] tau, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+ to upper triangular form by means of orthogonal transformations.
+
+ The upper trapezoidal matrix A is factored as
+
+ A = ( R 0 ) * Z,
+
+ where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+ triangular matrix.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= M.
+
+ A (input/output) REAL array, dimension (LDA,N)
+ On entry, the leading M-by-N upper trapezoidal part of the
+ array A must contain the matrix to be factorized.
+ On exit, the leading M-by-M upper triangular part of A
+ contains the upper triangular matrix R, and elements M+1 to
+ N of the first M rows of A, with the array TAU, represent the
+ orthogonal matrix Z as a product of M elementary reflectors.
+
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) REAL array, dimension (M)
+ The scalar factors of the elementary reflectors.
+
+ WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+
+ The factorization is obtained by Householder's method. The kth
+ transformation matrix, Z( k ), which is used to introduce zeros into
+
+ the ( m - k + 1 )th row of A, is given in the form
+
+ Z( k ) = ( I 0 ),
+ ( 0 T( k ) )
+
+ where
+
+ T( k ) = I - tau*u( k )*u( k )', u( k ) = ( 1 ),
+ ( 0 )
+ ( z( k ) )
+
+ tau is a scalar and z( k ) is an ( n - m ) element vector.
+ tau and z( k ) are chosen to annihilate the elements of the kth row
+ of X.
+
+ The scalar tau is returned in the kth element of TAU and the vector
+ u( k ) in the kth row of A, such that the elements of z( k ) are
+ in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+
+ the upper triangular part of A.
+
+ Z is given by
+
+ Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
+
+ =====================================================================
+
+ .. Parameters ..
+</pre>
+ * @param m
+ * @param n
+ * @param a
+ * @param lda
+ * @param tau
+ * @param work
+ * @param lwork
+ * @param info
+ */
+ public abstract void stzrzf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMCH determines double precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by DLAMCH:
+ = 'E' or 'e', DLAMCH := eps
+ = 'S' or 's , DLAMCH := sfmin
+ = 'B' or 'b', DLAMCH := base
+ = 'P' or 'p', DLAMCH := eps*base
+ = 'N' or 'n', DLAMCH := t
+ = 'R' or 'r', DLAMCH := rnd
+ = 'M' or 'm', DLAMCH := emin
+ = 'U' or 'u', DLAMCH := rmin
+ = 'L' or 'l', DLAMCH := emax
+ = 'O' or 'o', DLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param cmach
+ */
+ public abstract double dlamch(String cmach);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param beta
+ * @param t
+ * @param rnd
+ * @param ieee1
+ */
+ public abstract void dlamc1(intW beta, intW t, booleanW rnd, booleanW ieee1);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) DOUBLE PRECISION
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) DOUBLE PRECISION
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) DOUBLE PRECISION
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param beta
+ * @param t
+ * @param rnd
+ * @param eps
+ * @param emin
+ * @param rmin
+ * @param emax
+ * @param rmax
+ */
+ public abstract void dlamc2(intW beta, intW t, booleanW rnd, doubleW eps, intW emin, doubleW rmin, intW emax, doubleW rmax);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC3 is intended to force A and B to be stored prior to doing
+
+ the addition of A and B , for use in situations where optimizers
+
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ B (input) DOUBLE PRECISION
+ The values A and B.
+
+ =====================================================================
+
+
+ .. Executable Statements ..
+
+</pre>
+ * @param a
+ * @param b
+ */
+ public double dlamc3(double a, double b) {
+ return org.netlib.lapack.Dlamc3.dlamc3(a, b);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC4 is a service routine for DLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow, computed by
+
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) DOUBLE PRECISION
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param emin
+ * @param start
+ * @param base
+ */
+ public abstract void dlamc4(intW emin, double start, int base);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ DLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) DOUBLE PRECISION
+ The largest machine floating-point number.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param beta
+ * @param p
+ * @param emin
+ * @param ieee
+ * @param emax
+ * @param rmax
+ */
+ public abstract void dlamc5(int beta, int p, int emin, boolean ieee, intW emax, doubleW rmax);
+
+ /**
+<pre>
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+ February 2007
+
+ Purpose
+ =======
+
+ DSECND returns the user time for a process in seconds.
+ This version gets the time from the EXTERNAL system function ETIME.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ */
+ public double dsecnd() {
+ return org.netlib.lapack.Dsecnd.dsecnd();
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
+ case.
+
+ Arguments
+ =========
+
+ CA (input) CHARACTER*1
+ CB (input) CHARACTER*1
+ CA and CB specify the single characters to be compared.
+
+ =====================================================================
+
+
+ .. Intrinsic Functions ..
+</pre>
+ * @param ca
+ * @param cb
+ */
+ public boolean lsame(String ca, String cb) {
+ return org.netlib.lapack.Lsame.lsame(ca, cb);
+ }
+
+ /**
+<pre>
+
+
+ -- LAPACK auxiliary routine (version 3.1.1) --
+ Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+ February 2007
+
+ Purpose
+ =======
+
+ SECOND returns the user time for a process in seconds.
+ This version gets the time from the EXTERNAL system function ETIME.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ */
+ public float second() {
+ return org.netlib.lapack.Second.second();
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMCH determines single precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by SLAMCH:
+ = 'E' or 'e', SLAMCH := eps
+ = 'S' or 's , SLAMCH := sfmin
+ = 'B' or 'b', SLAMCH := base
+ = 'P' or 'p', SLAMCH := eps*base
+ = 'N' or 'n', SLAMCH := t
+ = 'R' or 'r', SLAMCH := rnd
+ = 'M' or 'm', SLAMCH := emin
+ = 'U' or 'u', SLAMCH := rmin
+ = 'L' or 'l', SLAMCH := emax
+ = 'O' or 'o', SLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param cmach
+ */
+ public float slamch(String cmach) {
+ return org.netlib.lapack.Slamch.slamch(cmach);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param beta
+ * @param t
+ * @param rnd
+ * @param ieee1
+ */
+ public abstract void slamc1(intW beta, intW t, booleanW rnd, booleanW ieee1);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) REAL
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) REAL
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) REAL
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param beta
+ * @param t
+ * @param rnd
+ * @param eps
+ * @param emin
+ * @param rmin
+ * @param emax
+ * @param rmax
+ */
+ public abstract void slamc2(intW beta, intW t, booleanW rnd, floatW eps, intW emin, floatW rmin, intW emax, floatW rmax);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC3 is intended to force A and B to be stored prior to doing
+
+ the addition of A and B , for use in situations where optimizers
+
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A (input) REAL
+ B (input) REAL
+ The values A and B.
+
+ =====================================================================
+
+
+ .. Executable Statements ..
+
+</pre>
+ * @param a
+ * @param b
+ */
+ public float slamc3(float a, float b) {
+ return org.netlib.lapack.Slamc3.slamc3(a, b);
+ }
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC4 is a service routine for SLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow, computed by
+
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) REAL
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+
+
+ .. Local Scalars ..
+</pre>
+ * @param emin
+ * @param start
+ * @param base
+ */
+ public abstract void slamc4(intW emin, float start, int base);
+
+ /**
+<pre>
+
+ ..
+
+ Purpose
+ =======
+
+ SLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) REAL
+ The largest machine floating-point number.
+
+ =====================================================================
+
+
+ .. Parameters ..
+</pre>
+ * @param beta
+ * @param p
+ * @param emin
+ * @param ieee
+ * @param emax
+ * @param rmax
+ */
+ public abstract void slamc5(int beta, int p, int emin, boolean ieee, intW emax, floatW rmax);
+
+}
diff --git a/src/org/netlib/lapack/NativeLAPACK.java b/src/org/netlib/lapack/NativeLAPACK.java
new file mode 100644
index 0000000..c89532f
--- /dev/null
+++ b/src/org/netlib/lapack/NativeLAPACK.java
@@ -0,0 +1,1956 @@
+/*
+ * Copyright 2003-2007 Keith Seymour.
+ * Copyright 1992-2007 The University of Tennessee. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * - Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer listed
+ * in this license in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * This file was auto-generated by the org.netlib.generate.JavaGenerator
+ * program, a part of netlib-java.
+ *
+ * @see http://code.google.com/p/netlib-java/
+ */
+package org.netlib.lapack;
+
+import java.util.logging.Logger;
+import org.netlib.util.StringW;
+import org.netlib.util.booleanW;
+import org.netlib.util.doubleW;
+import org.netlib.util.floatW;
+import org.netlib.util.intW;
+import org.netlib.utils.JNIMethods;
+
+/**
+ * LAPACK provider implementation which uses the Java Native Interface to access
+ * system netlib libraries.
+ *
+ * @see http://www.netlib.org/
+ * @author Samuel Halliday
+ */
+final class NativeLAPACK extends LAPACK {
+
+ // singleton
+ protected static final NativeLAPACK INSTANCE = new NativeLAPACK();
+
+ // indicates if the JNI loaded OK. If this is false, calls to the native
+ // methods will fail with UnsatisfiedLinkError
+ protected final boolean isLoaded;
+
+ private NativeLAPACK() {
+ String libname = JNIMethods.getPortableLibraryName("jnilapack");
+ try {
+ System.loadLibrary(libname);
+ } catch (UnsatisfiedLinkError e) {
+ isLoaded = false;
+ return;
+ }
+ isLoaded = true;
+ }
+
+ @Override
+ public native void dbdsdc(String uplo, String compq, int n, double[] d, double[] e, double[] u, int ldu, double[] vt, int ldvt, double[] q, int[] iq, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dbdsqr(String uplo, int n, int ncvt, int nru, int ncc, double[] d, double[] e, double[] vt, int ldvt, double[] u, int ldu, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void ddisna(String job, int m, int n, double[] d, double[] sep, intW info);
+
+ @Override
+ public native void dgbbrd(String vect, int m, int n, int ncc, int kl, int ku, double[] ab, int ldab, double[] d, double[] e, double[] q, int ldq, double[] pt, int ldpt, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dgbcon(String norm, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgbequ(int m, int n, int kl, int ku, double[] ab, int ldab, double[] r, double[] c, doubleW rowcnd, doubleW colcnd, doubleW amax, intW info);
+
+ @Override
+ public native void dgbrfs(String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgbsv(int n, int kl, int ku, int nrhs, double[] ab, int ldab, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dgbsvx(String fact, String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, int[] ipiv, StringW equed, double[] r, double[] c, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgbtf2(int m, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, intW info);
+
+ @Override
+ public native void dgbtrf(int m, int n, int kl, int ku, double[] ab, int ldab, int[] ipiv, intW info);
+
+ @Override
+ public native void dgbtrs(String trans, int n, int kl, int ku, int nrhs, double[] ab, int ldab, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dgebak(String job, String side, int n, int ilo, int ihi, double[] scale, int m, double[] v, int ldv, intW info);
+
+ @Override
+ public native void dgebal(String job, int n, double[] a, int lda, intW ilo, intW ihi, double[] scale, intW info);
+
+ @Override
+ public native void dgebd2(int m, int n, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] work, intW info);
+
+ @Override
+ public native void dgebrd(int m, int n, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgecon(String norm, int n, double[] a, int lda, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgeequ(int m, int n, double[] a, int lda, double[] r, double[] c, doubleW rowcnd, doubleW colcnd, doubleW amax, intW info);
+
+ @Override
+ public native void dgeev(String jobvl, String jobvr, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgeevx(String balanc, String jobvl, String jobvr, String sense, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, intW ilo, intW ihi, double[] scale, doubleW abnrm, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void dgegs(String jobvsl, String jobvsr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vsl, int ldvsl, double[] vsr, int ldvsr, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgegv(String jobvl, String jobvr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgehd2(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgehrd(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgelq2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgelqf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgels(String trans, int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgelsd(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] s, double rcond, intW rank, double[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void dgelss(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] s, double rcond, intW rank, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgelsx(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, int[] jpvt, double rcond, intW rank, double[] work, intW info);
+
+ @Override
+ public native void dgelsy(int m, int n, int nrhs, double[] a, int lda, double[] b, int ldb, int[] jpvt, double rcond, intW rank, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgeql2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgeqlf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgeqp3(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgeqpf(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgeqr2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgeqrf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgerfs(String trans, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgerq2(int m, int n, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgerqf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgesc2(int n, double[] a, int lda, double[] rhs, int[] ipiv, int[] jpiv, doubleW scale);
+
+ @Override
+ public native void dgesdd(String jobz, int m, int n, double[] a, int lda, double[] s, double[] u, int ldu, double[] vt, int ldvt, double[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void dgesv(int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dgesvd(String jobu, String jobvt, int m, int n, double[] a, int lda, double[] s, double[] u, int ldu, double[] vt, int ldvt, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgesvx(String fact, String trans, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, StringW equed, double[] r, double[] c, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgetc2(int n, double[] a, int lda, int[] ipiv, int[] jpiv, intW info);
+
+ @Override
+ public native void dgetf2(int m, int n, double[] a, int lda, int[] ipiv, intW info);
+
+ @Override
+ public native void dgetrf(int m, int n, double[] a, int lda, int[] ipiv, intW info);
+
+ @Override
+ public native void dgetri(int n, double[] a, int lda, int[] ipiv, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgetrs(String trans, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dggbak(String job, String side, int n, int ilo, int ihi, double[] lscale, double[] rscale, int m, double[] v, int ldv, intW info);
+
+ @Override
+ public native void dggbal(String job, int n, double[] a, int lda, double[] b, int ldb, intW ilo, intW ihi, double[] lscale, double[] rscale, double[] work, intW info);
+
+ @Override
+ public native void dggev(String jobvl, String jobvr, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dggevx(String balanc, String jobvl, String jobvr, String sense, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] vl, int ldvl, double[] vr, int ldvr, intW ilo, intW ihi, double[] lscale, double[] rscale, doubleW abnrm, doubleW bbnrm, double[] rconde, double[] rcondv, double[] work, int lwork, int[] iwork, boolean[] bwork, intW info);
+
+ @Override
+ public native void dggglm(int n, int m, int p, double[] a, int lda, double[] b, int ldb, double[] d, double[] x, double[] y, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dgghrd(String compq, String compz, int n, int ilo, int ihi, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, intW info);
+
+ @Override
+ public native void dgglse(int m, int n, int p, double[] a, int lda, double[] b, int ldb, double[] c, double[] d, double[] x, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dggqrf(int n, int m, int p, double[] a, int lda, double[] taua, double[] b, int ldb, double[] taub, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dggrqf(int m, int p, int n, double[] a, int lda, double[] taua, double[] b, int ldb, double[] taub, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dggsvd(String jobu, String jobv, String jobq, int m, int n, int p, intW k, intW l, double[] a, int lda, double[] b, int ldb, double[] alpha, double[] beta, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dggsvp(String jobu, String jobv, String jobq, int m, int p, int n, double[] a, int lda, double[] b, int ldb, double tola, double tolb, intW k, intW l, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, int[] iwork, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dgtcon(String norm, int n, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgtrfs(String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] dlf, double[] df, double[] duf, double[] du2, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgtsv(int n, int nrhs, double[] dl, double[] d, double[] du, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dgtsvx(String fact, String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] dlf, double[] df, double[] duf, double[] du2, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dgttrf(int n, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, intW info);
+
+ @Override
+ public native void dgttrs(String trans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dgtts2(int itrans, int n, int nrhs, double[] dl, double[] d, double[] du, double[] du2, int[] ipiv, double[] b, int ldb);
+
+ @Override
+ public native void dhgeqz(String job, String compq, String compz, int n, int ilo, int ihi, double[] h, int ldh, double[] t, int ldt, double[] alphar, double[] alphai, double[] beta, double[] q, int ldq, double[] z, int ldz, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dhsein(String side, String eigsrc, String initv, boolean[] select, int n, double[] h, int ldh, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, int[] ifaill, int[] ifailr, intW info);
+
+ @Override
+ public native void dhseqr(String job, String compz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, double[] z, int ldz, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dlabad(doubleW small, doubleW large);
+
+ @Override
+ public native void dlabrd(int m, int n, int nb, double[] a, int lda, double[] d, double[] e, double[] tauq, double[] taup, double[] x, int ldx, double[] y, int ldy);
+
+ @Override
+ public native void dlacon(int n, double[] v, double[] x, int[] isgn, doubleW est, intW kase);
+
+ @Override
+ public native void dlacpy(String uplo, int m, int n, double[] a, int lda, double[] b, int ldb);
+
+ @Override
+ public native void dladiv(double a, double b, double c, double d, doubleW p, doubleW q);
+
+ @Override
+ public native void dlae2(double a, double b, double c, doubleW rt1, doubleW rt2);
+
+ @Override
+ public native void dlaebz(int ijob, int nitmax, int n, int mmax, int minp, int nbmin, double abstol, double reltol, double pivmin, double[] d, double[] e, double[] e2, int[] nval, double[] ab, double[] c, intW mout, int[] nab, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlaed0(int icompq, int qsiz, int n, double[] d, double[] e, double[] q, int ldq, double[] qstore, int ldqs, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlaed1(int n, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlaed2(intW k, int n, int n1, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, double[] z, double[] dlamda, double[] w, double[] q2, int[] indx, int[] indxc, int[] indxp, int[] coltyp, intW info);
+
+ @Override
+ public native void dlaed3(int k, int n, int n1, double[] d, double[] q, int ldq, double rho, double[] dlamda, double[] q2, int[] indx, int[] ctot, double[] w, double[] s, intW info);
+
+ @Override
+ public native void dlaed4(int n, int i, double[] d, double[] z, double[] delta, double rho, doubleW dlam, intW info);
+
+ @Override
+ public native void dlaed5(int i, double[] d, double[] z, double[] delta, double rho, doubleW dlam);
+
+ @Override
+ public native void dlaed6(int kniter, boolean orgati, double rho, double[] d, double[] z, double finit, doubleW tau, intW info);
+
+ @Override
+ public native void dlaed7(int icompq, int n, int qsiz, int tlvls, int curlvl, int curpbm, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] qstore, int[] qptr, int[] prmptr, int[] perm, int[] givptr, int[] givcol, double[] givnum, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlaed8(int icompq, intW k, int n, int qsiz, double[] d, double[] q, int ldq, int[] indxq, doubleW rho, int cutpnt, double[] z, double[] dlamda, double[] q2, int ldq2, double[] w, int[] perm, intW givptr, int[] givcol, double[] givnum, int[] indxp, int[] indx, intW info);
+
+ @Override
+ public native void dlaed9(int k, int kstart, int kstop, int n, double[] d, double[] q, int ldq, double rho, double[] dlamda, double[] w, double[] s, int lds, intW info);
+
+ @Override
+ public native void dlaeda(int n, int tlvls, int curlvl, int curpbm, int[] prmptr, int[] perm, int[] givptr, int[] givcol, double[] givnum, double[] q, int[] qptr, double[] z, double[] ztemp, intW info);
+
+ @Override
+ public native void dlaein(boolean rightv, boolean noinit, int n, double[] h, int ldh, double wr, double wi, double[] vr, double[] vi, double[] b, int ldb, double[] work, double eps3, double smlnum, double bignum, intW info);
+
+ @Override
+ public native void dlaev2(double a, double b, double c, doubleW rt1, doubleW rt2, doubleW cs1, doubleW sn1);
+
+ @Override
+ public native void dlaexc(boolean wantq, int n, double[] t, int ldt, double[] q, int ldq, int j1, int n1, int n2, double[] work, intW info);
+
+ @Override
+ public native void dlag2(double[] a, int lda, double[] b, int ldb, double safmin, doubleW scale1, doubleW scale2, doubleW wr1, doubleW wr2, doubleW wi);
+
+ @Override
+ public native void dlags2(boolean upper, double a1, double a2, double a3, double b1, double b2, double b3, doubleW csu, doubleW snu, doubleW csv, doubleW snv, doubleW csq, doubleW snq);
+
+ @Override
+ public native void dlagtf(int n, double[] a, double lambda, double[] b, double[] c, double tol, double[] d, int[] in, intW info);
+
+ @Override
+ public native void dlagtm(String trans, int n, int nrhs, double alpha, double[] dl, double[] d, double[] du, double[] x, int ldx, double beta, double[] b, int ldb);
+
+ @Override
+ public native void dlagts(int job, int n, double[] a, double[] b, double[] c, double[] d, int[] in, double[] y, doubleW tol, intW info);
+
+ @Override
+ public native void dlagv2(double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, doubleW csl, doubleW snl, doubleW csr, doubleW snr);
+
+ @Override
+ public native void dlahqr(boolean wantt, boolean wantz, int n, int ilo, int ihi, double[] h, int ldh, double[] wr, double[] wi, int iloz, int ihiz, double[] z, int ldz, intW info);
+
+ @Override
+ public native void dlahrd(int n, int k, int nb, double[] a, int lda, double[] tau, double[] t, int ldt, double[] y, int ldy);
+
+ @Override
+ public native void dlaic1(int job, int j, double[] x, double sest, double[] w, double gamma, doubleW sestpr, doubleW s, doubleW c);
+
+ @Override
+ public native void dlaln2(boolean ltrans, int na, int nw, double smin, double ca, double[] a, int lda, double d1, double d2, double[] b, int ldb, double wr, double wi, double[] x, int ldx, doubleW scale, doubleW xnorm, intW info);
+
+ @Override
+ public native void dlals0(int icompq, int nl, int nr, int sqre, int nrhs, double[] b, int ldb, double[] bx, int ldbx, int[] perm, int givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, double[] poles, double[] difl, double[] difr, double[] z, int k, double c, double s, double[] work, intW info);
+
+ @Override
+ public native void dlalsa(int icompq, int smlsiz, int n, int nrhs, double[] b, int ldb, double[] bx, int ldbx, double[] u, int ldu, double[] vt, int[] k, double[] difl, double[] difr, double[] z, double[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, double[] givnum, double[] c, double[] s, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlalsd(String uplo, int smlsiz, int n, int nrhs, double[] d, double[] e, double[] b, int ldb, double rcond, intW rank, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlamrg(int n1, int n2, double[] a, int dtrd1, int dtrd2, int[] index);
+
+ @Override
+ public native void dlanv2(doubleW a, doubleW b, doubleW c, doubleW d, doubleW rt1r, doubleW rt1i, doubleW rt2r, doubleW rt2i, doubleW cs, doubleW sn);
+
+ @Override
+ public native void dlapll(int n, double[] x, int incx, double[] y, int incy, doubleW ssmin);
+
+ @Override
+ public native void dlapmt(boolean forwrd, int m, int n, double[] x, int ldx, int[] k);
+
+ @Override
+ public native void dlaqgb(int m, int n, int kl, int ku, double[] ab, int ldab, double[] r, double[] c, double rowcnd, double colcnd, double amax, StringW equed);
+
+ @Override
+ public native void dlaqge(int m, int n, double[] a, int lda, double[] r, double[] c, double rowcnd, double colcnd, double amax, StringW equed);
+
+ @Override
+ public native void dlaqp2(int m, int n, int offset, double[] a, int lda, int[] jpvt, double[] tau, double[] vn1, double[] vn2, double[] work);
+
+ @Override
+ public native void dlaqps(int m, int n, int offset, int nb, intW kb, double[] a, int lda, int[] jpvt, double[] tau, double[] vn1, double[] vn2, double[] auxv, double[] f, int ldf);
+
+ @Override
+ public native void dlaqsb(String uplo, int n, int kd, double[] ab, int ldab, double[] s, double scond, double amax, StringW equed);
+
+ @Override
+ public native void dlaqsp(String uplo, int n, double[] ap, double[] s, double scond, double amax, StringW equed);
+
+ @Override
+ public native void dlaqsy(String uplo, int n, double[] a, int lda, double[] s, double scond, double amax, StringW equed);
+
+ @Override
+ public native void dlaqtr(boolean ltran, boolean lreal, int n, double[] t, int ldt, double[] b, double w, doubleW scale, double[] x, double[] work, intW info);
+
+ @Override
+ public native void dlar2v(int n, double[] x, double[] y, double[] z, int incx, double[] c, double[] s, int incc);
+
+ @Override
+ public native void dlarf(String side, int m, int n, double[] v, int incv, double tau, double[] c, int Ldc, double[] work);
+
+ @Override
+ public native void dlarfb(String side, String trans, String direct, String storev, int m, int n, int k, double[] v, int ldv, double[] t, int ldt, double[] c, int Ldc, double[] work, int ldwork);
+
+ @Override
+ public native void dlarfg(int n, doubleW alpha, double[] x, int incx, doubleW tau);
+
+ @Override
+ public native void dlarft(String direct, String storev, int n, int k, double[] v, int ldv, double[] tau, double[] t, int ldt);
+
+ @Override
+ public native void dlarfx(String side, int m, int n, double[] v, double tau, double[] c, int Ldc, double[] work);
+
+ @Override
+ public native void dlargv(int n, double[] x, int incx, double[] y, int incy, double[] c, int incc);
+
+ @Override
+ public native void dlarnv(int idist, int[] iseed, int n, double[] x);
+
+ @Override
+ public native void dlartg(double f, double g, doubleW cs, doubleW sn, doubleW r);
+
+ @Override
+ public native void dlartv(int n, double[] x, int incx, double[] y, int incy, double[] c, double[] s, int incc);
+
+ @Override
+ public native void dlaruv(int[] iseed, int n, double[] x);
+
+ @Override
+ public native void dlarz(String side, int m, int n, int l, double[] v, int incv, double tau, double[] c, int Ldc, double[] work);
+
+ @Override
+ public native void dlarzb(String side, String trans, String direct, String storev, int m, int n, int k, int l, double[] v, int ldv, double[] t, int ldt, double[] c, int Ldc, double[] work, int ldwork);
+
+ @Override
+ public native void dlarzt(String direct, String storev, int n, int k, double[] v, int ldv, double[] tau, double[] t, int ldt);
+
+ @Override
+ public native void dlas2(double f, double g, double h, doubleW ssmin, doubleW ssmax);
+
+ @Override
+ public native void dlascl(String type, int kl, int ku, double cfrom, double cto, int m, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dlasd0(int n, int sqre, double[] d, double[] e, double[] u, int ldu, double[] vt, int ldvt, int smlsiz, int[] iwork, double[] work, intW info);
+
+ @Override
+ public native void dlasd1(int nl, int nr, int sqre, double[] d, doubleW alpha, doubleW beta, double[] u, int ldu, double[] vt, int ldvt, int[] idxq, int[] iwork, double[] work, intW info);
+
+ @Override
+ public native void dlasd2(int nl, int nr, int sqre, intW k, double[] d, double[] z, double alpha, double beta, double[] u, int ldu, double[] vt, int ldvt, double[] dsigma, double[] u2, int ldu2, double[] vt2, int ldvt2, int[] idxp, int[] idx, int[] idxc, int[] idxq, int[] coltyp, intW info);
+
+ @Override
+ public native void dlasd3(int nl, int nr, int sqre, int k, double[] d, double[] q, int ldq, double[] dsigma, double[] u, int ldu, double[] u2, int ldu2, double[] vt, int ldvt, double[] vt2, int ldvt2, int[] idxc, int[] ctot, double[] z, intW info);
+
+ @Override
+ public native void dlasd4(int n, int i, double[] d, double[] z, double[] delta, double rho, doubleW sigma, double[] work, intW info);
+
+ @Override
+ public native void dlasd5(int i, double[] d, double[] z, double[] delta, double rho, doubleW dsigma, double[] work);
+
+ @Override
+ public native void dlasd6(int icompq, int nl, int nr, int sqre, double[] d, double[] vf, double[] vl, doubleW alpha, doubleW beta, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, double[] poles, double[] difl, double[] difr, double[] z, intW k, doubleW c, doubleW s, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlasd7(int icompq, int nl, int nr, int sqre, intW k, double[] d, double[] z, double[] zw, double[] vf, double[] vfw, double[] vl, double[] vlw, double alpha, double beta, double[] dsigma, int[] idx, int[] idxp, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, double[] givnum, int ldgnum, doubleW c, doubleW s, intW info);
+
+ @Override
+ public native void dlasd8(int icompq, int k, double[] d, double[] z, double[] vf, double[] vl, double[] difl, double[] difr, int lddifr, double[] dsigma, double[] work, intW info);
+
+ @Override
+ public native void dlasda(int icompq, int smlsiz, int n, int sqre, double[] d, double[] e, double[] u, int ldu, double[] vt, int[] k, double[] difl, double[] difr, double[] z, double[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, double[] givnum, double[] c, double[] s, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dlasdq(String uplo, int sqre, int n, int ncvt, int nru, int ncc, double[] d, double[] e, double[] vt, int ldvt, double[] u, int ldu, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dlasdt(int n, intW lvl, intW nd, int[] inode, int[] ndiml, int[] ndimr, int msub);
+
+ @Override
+ public native void dlaset(String uplo, int m, int n, double alpha, double beta, double[] a, int lda);
+
+ @Override
+ public native void dlasq1(int n, double[] d, double[] e, double[] work, intW info);
+
+ @Override
+ public native void dlasq2(int n, double[] z, intW info);
+
+ @Override
+ public native void dlasq3(int i0, intW n0, double[] z, int pp, doubleW dmin, doubleW sigma, doubleW desig, doubleW qmax, intW nfail, intW iter, intW ndiv, boolean ieee);
+
+ @Override
+ public native void dlasq4(int i0, int n0, double[] z, int pp, int n0in, double dmin, double dmin1, double dmin2, double dn, double dn1, double dn2, doubleW tau, intW ttype);
+
+ @Override
+ public native void dlasq5(int i0, int n0, double[] z, int pp, double tau, doubleW dmin, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dnm1, doubleW dnm2, boolean ieee);
+
+ @Override
+ public native void dlasq6(int i0, int n0, double[] z, int pp, doubleW dmin, doubleW dmin1, doubleW dmin2, doubleW dn, doubleW dnm1, doubleW dnm2);
+
+ @Override
+ public native void dlasr(String side, String pivot, String direct, int m, int n, double[] c, double[] s, double[] a, int lda);
+
+ @Override
+ public native void dlasrt(String id, int n, double[] d, intW info);
+
+ @Override
+ public native void dlassq(int n, double[] x, int incx, doubleW scale, doubleW sumsq);
+
+ @Override
+ public native void dlasv2(double f, double g, double h, doubleW ssmin, doubleW ssmax, doubleW snr, doubleW csr, doubleW snl, doubleW csl);
+
+ @Override
+ public native void dlaswp(int n, double[] a, int lda, int k1, int k2, int[] ipiv, int incx);
+
+ @Override
+ public native void dlasy2(boolean ltranl, boolean ltranr, int isgn, int n1, int n2, double[] tl, int ldtl, double[] tr, int ldtr, double[] b, int ldb, doubleW scale, double[] x, int ldx, doubleW xnorm, intW info);
+
+ @Override
+ public native void dlasyf(String uplo, int n, int nb, intW kb, double[] a, int lda, int[] ipiv, double[] w, int ldw, intW info);
+
+ @Override
+ public native void dlatbs(String uplo, String trans, String diag, String normin, int n, int kd, double[] ab, int ldab, double[] x, doubleW scale, double[] cnorm, intW info);
+
+ @Override
+ public native void dlatdf(int ijob, int n, double[] z, int ldz, double[] rhs, doubleW rdsum, doubleW rdscal, int[] ipiv, int[] jpiv);
+
+ @Override
+ public native void dlatps(String uplo, String trans, String diag, String normin, int n, double[] ap, double[] x, doubleW scale, double[] cnorm, intW info);
+
+ @Override
+ public native void dlatrd(String uplo, int n, int nb, double[] a, int lda, double[] e, double[] tau, double[] w, int ldw);
+
+ @Override
+ public native void dlatrs(String uplo, String trans, String diag, String normin, int n, double[] a, int lda, double[] x, doubleW scale, double[] cnorm, intW info);
+
+ @Override
+ public native void dlatrz(int m, int n, int l, double[] a, int lda, double[] tau, double[] work);
+
+ @Override
+ public native void dlatzm(String side, int m, int n, double[] v, int incv, double tau, double[] c1, double[] c2, int Ldc, double[] work);
+
+ @Override
+ public native void dlauu2(String uplo, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dlauum(String uplo, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dopgtr(String uplo, int n, double[] ap, double[] tau, double[] q, int ldq, double[] work, intW info);
+
+ @Override
+ public native void dopmtr(String side, String uplo, String trans, int m, int n, double[] ap, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dorg2l(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dorg2r(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dorgbr(String vect, int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorghr(int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorgl2(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dorglq(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorgql(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorgqr(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorgr2(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, intW info);
+
+ @Override
+ public native void dorgrq(int m, int n, int k, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorgtr(String uplo, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorm2l(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dorm2r(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dormbr(String vect, String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dormhr(String side, String trans, int m, int n, int ilo, int ihi, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dorml2(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dormlq(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dormql(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dormqr(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dormr2(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dormr3(String side, String trans, int m, int n, int k, int l, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, intW info);
+
+ @Override
+ public native void dormrq(String side, String trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dormrz(String side, String trans, int m, int n, int k, int l, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dormtr(String side, String uplo, String trans, int m, int n, double[] a, int lda, double[] tau, double[] c, int Ldc, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dpbcon(String uplo, int n, int kd, double[] ab, int ldab, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dpbequ(String uplo, int n, int kd, double[] ab, int ldab, double[] s, doubleW scond, doubleW amax, intW info);
+
+ @Override
+ public native void dpbrfs(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dpbstf(String uplo, int n, int kd, double[] ab, int ldab, intW info);
+
+ @Override
+ public native void dpbsv(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dpbsvx(String fact, String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] afb, int ldafb, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dpbtf2(String uplo, int n, int kd, double[] ab, int ldab, intW info);
+
+ @Override
+ public native void dpbtrf(String uplo, int n, int kd, double[] ab, int ldab, intW info);
+
+ @Override
+ public native void dpbtrs(String uplo, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dpocon(String uplo, int n, double[] a, int lda, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dpoequ(int n, double[] a, int lda, double[] s, doubleW scond, doubleW amax, intW info);
+
+ @Override
+ public native void dporfs(String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dposv(String uplo, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dposvx(String fact, String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dpotf2(String uplo, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dpotrf(String uplo, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dpotri(String uplo, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dpotrs(String uplo, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dppcon(String uplo, int n, double[] ap, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dppequ(String uplo, int n, double[] ap, double[] s, doubleW scond, doubleW amax, intW info);
+
+ @Override
+ public native void dpprfs(String uplo, int n, int nrhs, double[] ap, double[] afp, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dppsv(String uplo, int n, int nrhs, double[] ap, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dppsvx(String fact, String uplo, int n, int nrhs, double[] ap, double[] afp, StringW equed, double[] s, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dpptrf(String uplo, int n, double[] ap, intW info);
+
+ @Override
+ public native void dpptri(String uplo, int n, double[] ap, intW info);
+
+ @Override
+ public native void dpptrs(String uplo, int n, int nrhs, double[] ap, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dptcon(int n, double[] d, double[] e, double anorm, doubleW rcond, double[] work, intW info);
+
+ @Override
+ public native void dpteqr(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dptrfs(int n, int nrhs, double[] d, double[] e, double[] df, double[] ef, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, intW info);
+
+ @Override
+ public native void dptsv(int n, int nrhs, double[] d, double[] e, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dptsvx(String fact, int n, int nrhs, double[] d, double[] e, double[] df, double[] ef, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, intW info);
+
+ @Override
+ public native void dpttrf(int n, double[] d, double[] e, intW info);
+
+ @Override
+ public native void dpttrs(int n, int nrhs, double[] d, double[] e, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dptts2(int n, int nrhs, double[] d, double[] e, double[] b, int ldb);
+
+ @Override
+ public native void drscl(int n, double sa, double[] sx, int incx);
+
+ @Override
+ public native void dsbev(String jobz, String uplo, int n, int kd, double[] ab, int ldab, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dsbevd(String jobz, String uplo, int n, int kd, double[] ab, int ldab, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dsbevx(String jobz, String range, String uplo, int n, int kd, double[] ab, int ldab, double[] q, int ldq, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsbgst(String vect, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] x, int ldx, double[] work, intW info);
+
+ @Override
+ public native void dsbgv(String jobz, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dsbgvd(String jobz, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dsbgvx(String jobz, String range, String uplo, int n, int ka, int kb, double[] ab, int ldab, double[] bb, int ldbb, double[] q, int ldq, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsbtrd(String vect, String uplo, int n, int kd, double[] ab, int ldab, double[] d, double[] e, double[] q, int ldq, double[] work, intW info);
+
+ @Override
+ public native void dspcon(String uplo, int n, double[] ap, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dspev(String jobz, String uplo, int n, double[] ap, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dspevd(String jobz, String uplo, int n, double[] ap, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dspevx(String jobz, String range, String uplo, int n, double[] ap, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dspgst(int itype, String uplo, int n, double[] ap, double[] bp, intW info);
+
+ @Override
+ public native void dspgv(int itype, String jobz, String uplo, int n, double[] ap, double[] bp, double[] w, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dspgvd(int itype, String jobz, String uplo, int n, double[] ap, double[] bp, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dspgvx(int itype, String jobz, String range, String uplo, int n, double[] ap, double[] bp, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsprfs(String uplo, int n, int nrhs, double[] ap, double[] afp, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dspsv(String uplo, int n, int nrhs, double[] ap, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dspsvx(String fact, String uplo, int n, int nrhs, double[] ap, double[] afp, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dsptrd(String uplo, int n, double[] ap, double[] d, double[] e, double[] tau, intW info);
+
+ @Override
+ public native void dsptrf(String uplo, int n, double[] ap, int[] ipiv, intW info);
+
+ @Override
+ public native void dsptri(String uplo, int n, double[] ap, int[] ipiv, double[] work, intW info);
+
+ @Override
+ public native void dsptrs(String uplo, int n, int nrhs, double[] ap, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dstebz(String range, String order, int n, double vl, double vu, int il, int iu, double abstol, double[] d, double[] e, intW m, intW nsplit, double[] w, int[] iblock, int[] isplit, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dstedc(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dstegr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dstein(int n, double[] d, double[] e, int m, double[] w, int[] iblock, int[] isplit, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsteqr(String compz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dsterf(int n, double[] d, double[] e, intW info);
+
+ @Override
+ public native void dstev(String jobz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, intW info);
+
+ @Override
+ public native void dstevd(String jobz, int n, double[] d, double[] e, double[] z, int ldz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dstevr(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dstevx(String jobz, String range, int n, double[] d, double[] e, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsycon(String uplo, int n, double[] a, int lda, int[] ipiv, double anorm, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dsyev(String jobz, String uplo, int n, double[] a, int lda, double[] w, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dsyevd(String jobz, String uplo, int n, double[] a, int lda, double[] w, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dsyevr(String jobz, String range, String uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, int[] isuppz, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dsyevx(String jobz, String range, String uplo, int n, double[] a, int lda, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsygs2(int itype, String uplo, int n, double[] a, int lda, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dsygst(int itype, String uplo, int n, double[] a, int lda, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dsygv(int itype, String jobz, String uplo, int n, double[] a, int lda, double[] b, int ldb, double[] w, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dsygvd(int itype, String jobz, String uplo, int n, double[] a, int lda, double[] b, int ldb, double[] w, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dsygvx(int itype, String jobz, String range, String uplo, int n, double[] a, int lda, double[] b, int ldb, double vl, double vu, int il, int iu, double abstol, intW m, double[] w, double[] z, int ldz, double[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void dsyrfs(String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dsysv(String uplo, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dsysvx(String fact, String uplo, int n, int nrhs, double[] a, int lda, double[] af, int ldaf, int[] ipiv, double[] b, int ldb, double[] x, int ldx, doubleW rcond, double[] ferr, double[] berr, double[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void dsytd2(String uplo, int n, double[] a, int lda, double[] d, double[] e, double[] tau, intW info);
+
+ @Override
+ public native void dsytf2(String uplo, int n, double[] a, int lda, int[] ipiv, intW info);
+
+ @Override
+ public native void dsytrd(String uplo, int n, double[] a, int lda, double[] d, double[] e, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dsytrf(String uplo, int n, double[] a, int lda, int[] ipiv, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dsytri(String uplo, int n, double[] a, int lda, int[] ipiv, double[] work, intW info);
+
+ @Override
+ public native void dsytrs(String uplo, int n, int nrhs, double[] a, int lda, int[] ipiv, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dtbcon(String norm, String uplo, String diag, int n, int kd, double[] ab, int ldab, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dtbrfs(String uplo, String trans, String diag, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dtbtrs(String uplo, String trans, String diag, int n, int kd, int nrhs, double[] ab, int ldab, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dtgevc(String side, String howmny, boolean[] select, int n, double[] s, int lds, double[] p, int ldp, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, intW info);
+
+ @Override
+ public native void dtgex2(boolean wantq, boolean wantz, int n, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, int j1, int n1, int n2, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dtgexc(boolean wantq, boolean wantz, int n, double[] a, int lda, double[] b, int ldb, double[] q, int ldq, double[] z, int ldz, intW ifst, intW ilst, double[] work, int lwork, intW info);
+
+ @Override
+ public native void dtgsen(int ijob, boolean wantq, boolean wantz, boolean[] select, int n, double[] a, int lda, double[] b, int ldb, double[] alphar, double[] alphai, double[] beta, double[] q, int ldq, double[] z, int ldz, intW m, doubleW pl, doubleW pr, double[] dif, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dtgsja(String jobu, String jobv, String jobq, int m, int p, int n, int k, int l, double[] a, int lda, double[] b, int ldb, double tola, double tolb, double[] alpha, double[] beta, double[] u, int ldu, double[] v, int ldv, double[] q, int ldq, double[] work, intW ncycle, intW info);
+
+ @Override
+ public native void dtgsna(String job, String howmny, boolean[] select, int n, double[] a, int lda, double[] b, int ldb, double[] vl, int ldvl, double[] vr, int ldvr, double[] s, double[] dif, int mm, intW m, double[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void dtgsy2(String trans, int ijob, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, double[] d, int ldd, double[] e, int lde, double[] f, int ldf, doubleW scale, doubleW rdsum, doubleW rdscal, int[] iwork, intW pq, intW info);
+
+ @Override
+ public native void dtgsyl(String trans, int ijob, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, double[] d, int ldd, double[] e, int lde, double[] f, int ldf, doubleW scale, doubleW dif, double[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void dtpcon(String norm, String uplo, String diag, int n, double[] ap, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dtprfs(String uplo, String trans, String diag, int n, int nrhs, double[] ap, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dtptri(String uplo, String diag, int n, double[] ap, intW info);
+
+ @Override
+ public native void dtptrs(String uplo, String trans, String diag, int n, int nrhs, double[] ap, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dtrcon(String norm, String uplo, String diag, int n, double[] a, int lda, doubleW rcond, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dtrevc(String side, String howmny, boolean[] select, int n, double[] t, int ldt, double[] vl, int ldvl, double[] vr, int ldvr, int mm, intW m, double[] work, intW info);
+
+ @Override
+ public native void dtrexc(String compq, int n, double[] t, int ldt, double[] q, int ldq, intW ifst, intW ilst, double[] work, intW info);
+
+ @Override
+ public native void dtrrfs(String uplo, String trans, String diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb, double[] x, int ldx, double[] ferr, double[] berr, double[] work, int[] iwork, intW info);
+
+ @Override
+ public native void dtrsen(String job, String compq, boolean[] select, int n, double[] t, int ldt, double[] q, int ldq, double[] wr, double[] wi, intW m, doubleW s, doubleW sep, double[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void dtrsna(String job, String howmny, boolean[] select, int n, double[] t, int ldt, double[] vl, int ldvl, double[] vr, int ldvr, double[] s, double[] sep, int mm, intW m, double[] work, int ldwork, int[] iwork, intW info);
+
+ @Override
+ public native void dtrsyl(String trana, String tranb, int isgn, int m, int n, double[] a, int lda, double[] b, int ldb, double[] c, int Ldc, doubleW scale, intW info);
+
+ @Override
+ public native void dtrti2(String uplo, String diag, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dtrtri(String uplo, String diag, int n, double[] a, int lda, intW info);
+
+ @Override
+ public native void dtrtrs(String uplo, String trans, String diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb, intW info);
+
+ @Override
+ public native void dtzrqf(int m, int n, double[] a, int lda, double[] tau, intW info);
+
+ @Override
+ public native void dtzrzf(int m, int n, double[] a, int lda, double[] tau, double[] work, int lwork, intW info);
+
+ @Override
+ public native int ieeeck(int ispec, float zero, float one);
+
+ @Override
+ public native int ilaenv(int ispec, String name, String opts, int n1, int n2, int n3, int n4);
+
+ @Override
+ public native void sbdsdc(String uplo, String compq, int n, float[] d, float[] e, float[] u, int ldu, float[] vt, int ldvt, float[] q, int[] iq, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sbdsqr(String uplo, int n, int ncvt, int nru, int ncc, float[] d, float[] e, float[] vt, int ldvt, float[] u, int ldu, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sdisna(String job, int m, int n, float[] d, float[] sep, intW info);
+
+ @Override
+ public native void sgbbrd(String vect, int m, int n, int ncc, int kl, int ku, float[] ab, int ldab, float[] d, float[] e, float[] q, int ldq, float[] pt, int ldpt, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sgbcon(String norm, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgbequ(int m, int n, int kl, int ku, float[] ab, int ldab, float[] r, float[] c, floatW rowcnd, floatW colcnd, floatW amax, intW info);
+
+ @Override
+ public native void sgbrfs(String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgbsv(int n, int kl, int ku, int nrhs, float[] ab, int ldab, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sgbsvx(String fact, String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, int[] ipiv, StringW equed, float[] r, float[] c, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgbtf2(int m, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, intW info);
+
+ @Override
+ public native void sgbtrf(int m, int n, int kl, int ku, float[] ab, int ldab, int[] ipiv, intW info);
+
+ @Override
+ public native void sgbtrs(String trans, int n, int kl, int ku, int nrhs, float[] ab, int ldab, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sgebak(String job, String side, int n, int ilo, int ihi, float[] scale, int m, float[] v, int ldv, intW info);
+
+ @Override
+ public native void sgebal(String job, int n, float[] a, int lda, intW ilo, intW ihi, float[] scale, intW info);
+
+ @Override
+ public native void sgebd2(int m, int n, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] work, intW info);
+
+ @Override
+ public native void sgebrd(int m, int n, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgecon(String norm, int n, float[] a, int lda, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgeequ(int m, int n, float[] a, int lda, float[] r, float[] c, floatW rowcnd, floatW colcnd, floatW amax, intW info);
+
+ @Override
+ public native void sgeev(String jobvl, String jobvr, int n, float[] a, int lda, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgeevx(String balanc, String jobvl, String jobvr, String sense, int n, float[] a, int lda, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, intW ilo, intW ihi, float[] scale, floatW abnrm, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void sgegs(String jobvsl, String jobvsr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vsl, int ldvsl, float[] vsr, int ldvsr, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgegv(String jobvl, String jobvr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgehd2(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgehrd(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgelq2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgelqf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgels(String trans, int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgelsd(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] s, float rcond, intW rank, float[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void sgelss(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] s, float rcond, intW rank, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgelsx(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, int[] jpvt, float rcond, intW rank, float[] work, intW info);
+
+ @Override
+ public native void sgelsy(int m, int n, int nrhs, float[] a, int lda, float[] b, int ldb, int[] jpvt, float rcond, intW rank, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgeql2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgeqlf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgeqp3(int m, int n, float[] a, int lda, int[] jpvt, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgeqpf(int m, int n, float[] a, int lda, int[] jpvt, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgeqr2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgeqrf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgerfs(String trans, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgerq2(int m, int n, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgerqf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgesc2(int n, float[] a, int lda, float[] rhs, int[] ipiv, int[] jpiv, floatW scale);
+
+ @Override
+ public native void sgesdd(String jobz, int m, int n, float[] a, int lda, float[] s, float[] u, int ldu, float[] vt, int ldvt, float[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void sgesv(int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sgesvd(String jobu, String jobvt, int m, int n, float[] a, int lda, float[] s, float[] u, int ldu, float[] vt, int ldvt, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgesvx(String fact, String trans, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, StringW equed, float[] r, float[] c, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgetc2(int n, float[] a, int lda, int[] ipiv, int[] jpiv, intW info);
+
+ @Override
+ public native void sgetf2(int m, int n, float[] a, int lda, int[] ipiv, intW info);
+
+ @Override
+ public native void sgetrf(int m, int n, float[] a, int lda, int[] ipiv, intW info);
+
+ @Override
+ public native void sgetri(int n, float[] a, int lda, int[] ipiv, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgetrs(String trans, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sggbak(String job, String side, int n, int ilo, int ihi, float[] lscale, float[] rscale, int m, float[] v, int ldv, intW info);
+
+ @Override
+ public native void sggbal(String job, int n, float[] a, int lda, float[] b, int ldb, intW ilo, intW ihi, float[] lscale, float[] rscale, float[] work, intW info);
+
+ @Override
+ public native void sggev(String jobvl, String jobvr, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sggevx(String balanc, String jobvl, String jobvr, String sense, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] vl, int ldvl, float[] vr, int ldvr, intW ilo, intW ihi, float[] lscale, float[] rscale, floatW abnrm, floatW bbnrm, float[] rconde, float[] rcondv, float[] work, int lwork, int[] iwork, boolean[] bwork, intW info);
+
+ @Override
+ public native void sggglm(int n, int m, int p, float[] a, int lda, float[] b, int ldb, float[] d, float[] x, float[] y, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sgghrd(String compq, String compz, int n, int ilo, int ihi, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, intW info);
+
+ @Override
+ public native void sgglse(int m, int n, int p, float[] a, int lda, float[] b, int ldb, float[] c, float[] d, float[] x, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sggqrf(int n, int m, int p, float[] a, int lda, float[] taua, float[] b, int ldb, float[] taub, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sggrqf(int m, int p, int n, float[] a, int lda, float[] taua, float[] b, int ldb, float[] taub, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sggsvd(String jobu, String jobv, String jobq, int m, int n, int p, intW k, intW l, float[] a, int lda, float[] b, int ldb, float[] alpha, float[] beta, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sggsvp(String jobu, String jobv, String jobq, int m, int p, int n, float[] a, int lda, float[] b, int ldb, float tola, float tolb, intW k, intW l, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, int[] iwork, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sgtcon(String norm, int n, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgtrfs(String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] dlf, float[] df, float[] duf, float[] du2, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgtsv(int n, int nrhs, float[] dl, float[] d, float[] du, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sgtsvx(String fact, String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] dlf, float[] df, float[] duf, float[] du2, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sgttrf(int n, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, intW info);
+
+ @Override
+ public native void sgttrs(String trans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sgtts2(int itrans, int n, int nrhs, float[] dl, float[] d, float[] du, float[] du2, int[] ipiv, float[] b, int ldb);
+
+ @Override
+ public native void shgeqz(String job, String compq, String compz, int n, int ilo, int ihi, float[] h, int ldh, float[] t, int ldt, float[] alphar, float[] alphai, float[] beta, float[] q, int ldq, float[] z, int ldz, float[] work, int lwork, intW info);
+
+ @Override
+ public native void shsein(String side, String eigsrc, String initv, boolean[] select, int n, float[] h, int ldh, float[] wr, float[] wi, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, int[] ifaill, int[] ifailr, intW info);
+
+ @Override
+ public native void shseqr(String job, String compz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, float[] z, int ldz, float[] work, int lwork, intW info);
+
+ @Override
+ public native void slabad(floatW small, floatW large);
+
+ @Override
+ public native void slabrd(int m, int n, int nb, float[] a, int lda, float[] d, float[] e, float[] tauq, float[] taup, float[] x, int ldx, float[] y, int ldy);
+
+ @Override
+ public native void slacon(int n, float[] v, float[] x, int[] isgn, floatW est, intW kase);
+
+ @Override
+ public native void slacpy(String uplo, int m, int n, float[] a, int lda, float[] b, int ldb);
+
+ @Override
+ public native void sladiv(float a, float b, float c, float d, floatW p, floatW q);
+
+ @Override
+ public native void slae2(float a, float b, float c, floatW rt1, floatW rt2);
+
+ @Override
+ public native void slaebz(int ijob, int nitmax, int n, int mmax, int minp, int nbmin, float abstol, float reltol, float pivmin, float[] d, float[] e, float[] e2, int[] nval, float[] ab, float[] c, intW mout, int[] nab, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slaed0(int icompq, int qsiz, int n, float[] d, float[] e, float[] q, int ldq, float[] qstore, int ldqs, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slaed1(int n, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slaed2(intW k, int n, int n1, float[] d, float[] q, int ldq, int[] indxq, floatW rho, float[] z, float[] dlamda, float[] w, float[] q2, int[] indx, int[] indxc, int[] indxp, int[] coltyp, intW info);
+
+ @Override
+ public native void slaed3(int k, int n, int n1, float[] d, float[] q, int ldq, float rho, float[] dlamda, float[] q2, int[] indx, int[] ctot, float[] w, float[] s, intW info);
+
+ @Override
+ public native void slaed4(int n, int i, float[] d, float[] z, float[] delta, float rho, floatW dlam, intW info);
+
+ @Override
+ public native void slaed5(int i, float[] d, float[] z, float[] delta, float rho, floatW dlam);
+
+ @Override
+ public native void slaed6(int kniter, boolean orgati, float rho, float[] d, float[] z, float finit, floatW tau, intW info);
+
+ @Override
+ public native void slaed7(int icompq, int n, int qsiz, int tlvls, int curlvl, int curpbm, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] qstore, int[] qptr, int[] prmptr, int[] perm, int[] givptr, int[] givcol, float[] givnum, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slaed8(int icompq, intW k, int n, int qsiz, float[] d, float[] q, int ldq, int[] indxq, floatW rho, int cutpnt, float[] z, float[] dlamda, float[] q2, int ldq2, float[] w, int[] perm, intW givptr, int[] givcol, float[] givnum, int[] indxp, int[] indx, intW info);
+
+ @Override
+ public native void slaed9(int k, int kstart, int kstop, int n, float[] d, float[] q, int ldq, float rho, float[] dlamda, float[] w, float[] s, int lds, intW info);
+
+ @Override
+ public native void slaeda(int n, int tlvls, int curlvl, int curpbm, int[] prmptr, int[] perm, int[] givptr, int[] givcol, float[] givnum, float[] q, int[] qptr, float[] z, float[] ztemp, intW info);
+
+ @Override
+ public native void slaein(boolean rightv, boolean noinit, int n, float[] h, int ldh, float wr, float wi, float[] vr, float[] vi, float[] b, int ldb, float[] work, float eps3, float smlnum, float bignum, intW info);
+
+ @Override
+ public native void slaev2(float a, float b, float c, floatW rt1, floatW rt2, floatW cs1, floatW sn1);
+
+ @Override
+ public native void slaexc(boolean wantq, int n, float[] t, int ldt, float[] q, int ldq, int j1, int n1, int n2, float[] work, intW info);
+
+ @Override
+ public native void slag2(float[] a, int lda, float[] b, int ldb, float safmin, floatW scale1, floatW scale2, floatW wr1, floatW wr2, floatW wi);
+
+ @Override
+ public native void slags2(boolean upper, float a1, float a2, float a3, float b1, float b2, float b3, floatW csu, floatW snu, floatW csv, floatW snv, floatW csq, floatW snq);
+
+ @Override
+ public native void slagtf(int n, float[] a, float lambda, float[] b, float[] c, float tol, float[] d, int[] in, intW info);
+
+ @Override
+ public native void slagtm(String trans, int n, int nrhs, float alpha, float[] dl, float[] d, float[] du, float[] x, int ldx, float beta, float[] b, int ldb);
+
+ @Override
+ public native void slagts(int job, int n, float[] a, float[] b, float[] c, float[] d, int[] in, float[] y, floatW tol, intW info);
+
+ @Override
+ public native void slagv2(float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, floatW csl, floatW snl, floatW csr, floatW snr);
+
+ @Override
+ public native void slahqr(boolean wantt, boolean wantz, int n, int ilo, int ihi, float[] h, int ldh, float[] wr, float[] wi, int iloz, int ihiz, float[] z, int ldz, intW info);
+
+ @Override
+ public native void slahrd(int n, int k, int nb, float[] a, int lda, float[] tau, float[] t, int ldt, float[] y, int ldy);
+
+ @Override
+ public native void slaic1(int job, int j, float[] x, float sest, float[] w, float gamma, floatW sestpr, floatW s, floatW c);
+
+ @Override
+ public native void slaln2(boolean ltrans, int na, int nw, float smin, float ca, float[] a, int lda, float d1, float d2, float[] b, int ldb, float wr, float wi, float[] x, int ldx, floatW scale, floatW xnorm, intW info);
+
+ @Override
+ public native void slals0(int icompq, int nl, int nr, int sqre, int nrhs, float[] b, int ldb, float[] bx, int ldbx, int[] perm, int givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, float[] poles, float[] difl, float[] difr, float[] z, int k, float c, float s, float[] work, intW info);
+
+ @Override
+ public native void slalsa(int icompq, int smlsiz, int n, int nrhs, float[] b, int ldb, float[] bx, int ldbx, float[] u, int ldu, float[] vt, int[] k, float[] difl, float[] difr, float[] z, float[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, float[] givnum, float[] c, float[] s, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slalsd(String uplo, int smlsiz, int n, int nrhs, float[] d, float[] e, float[] b, int ldb, float rcond, intW rank, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slamrg(int n1, int n2, float[] a, int strd1, int strd2, int[] index);
+
+ @Override
+ public native void slanv2(floatW a, floatW b, floatW c, floatW d, floatW rt1r, floatW rt1i, floatW rt2r, floatW rt2i, floatW cs, floatW sn);
+
+ @Override
+ public native void slapll(int n, float[] x, int incx, float[] y, int incy, floatW ssmin);
+
+ @Override
+ public native void slapmt(boolean forwrd, int m, int n, float[] x, int ldx, int[] k);
+
+ @Override
+ public native void slaqgb(int m, int n, int kl, int ku, float[] ab, int ldab, float[] r, float[] c, float rowcnd, float colcnd, float amax, StringW equed);
+
+ @Override
+ public native void slaqge(int m, int n, float[] a, int lda, float[] r, float[] c, float rowcnd, float colcnd, float amax, StringW equed);
+
+ @Override
+ public native void slaqp2(int m, int n, int offset, float[] a, int lda, int[] jpvt, float[] tau, float[] vn1, float[] vn2, float[] work);
+
+ @Override
+ public native void slaqps(int m, int n, int offset, int nb, intW kb, float[] a, int lda, int[] jpvt, float[] tau, float[] vn1, float[] vn2, float[] auxv, float[] f, int ldf);
+
+ @Override
+ public native void slaqsb(String uplo, int n, int kd, float[] ab, int ldab, float[] s, float scond, float amax, StringW equed);
+
+ @Override
+ public native void slaqsp(String uplo, int n, float[] ap, float[] s, float scond, float amax, StringW equed);
+
+ @Override
+ public native void slaqsy(String uplo, int n, float[] a, int lda, float[] s, float scond, float amax, StringW equed);
+
+ @Override
+ public native void slaqtr(boolean ltran, boolean lreal, int n, float[] t, int ldt, float[] b, float w, floatW scale, float[] x, float[] work, intW info);
+
+ @Override
+ public native void slar2v(int n, float[] x, float[] y, float[] z, int incx, float[] c, float[] s, int incc);
+
+ @Override
+ public native void slarf(String side, int m, int n, float[] v, int incv, float tau, float[] c, int Ldc, float[] work);
+
+ @Override
+ public native void slarfb(String side, String trans, String direct, String storev, int m, int n, int k, float[] v, int ldv, float[] t, int ldt, float[] c, int Ldc, float[] work, int ldwork);
+
+ @Override
+ public native void slarfg(int n, floatW alpha, float[] x, int incx, floatW tau);
+
+ @Override
+ public native void slarft(String direct, String storev, int n, int k, float[] v, int ldv, float[] tau, float[] t, int ldt);
+
+ @Override
+ public native void slarfx(String side, int m, int n, float[] v, float tau, float[] c, int Ldc, float[] work);
+
+ @Override
+ public native void slargv(int n, float[] x, int incx, float[] y, int incy, float[] c, int incc);
+
+ @Override
+ public native void slarnv(int idist, int[] iseed, int n, float[] x);
+
+ @Override
+ public native void slartg(float f, float g, floatW cs, floatW sn, floatW r);
+
+ @Override
+ public native void slartv(int n, float[] x, int incx, float[] y, int incy, float[] c, float[] s, int incc);
+
+ @Override
+ public native void slaruv(int[] iseed, int n, float[] x);
+
+ @Override
+ public native void slarz(String side, int m, int n, int l, float[] v, int incv, float tau, float[] c, int Ldc, float[] work);
+
+ @Override
+ public native void slarzb(String side, String trans, String direct, String storev, int m, int n, int k, int l, float[] v, int ldv, float[] t, int ldt, float[] c, int Ldc, float[] work, int ldwork);
+
+ @Override
+ public native void slarzt(String direct, String storev, int n, int k, float[] v, int ldv, float[] tau, float[] t, int ldt);
+
+ @Override
+ public native void slas2(float f, float g, float h, floatW ssmin, floatW ssmax);
+
+ @Override
+ public native void slascl(String type, int kl, int ku, float cfrom, float cto, int m, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void slasd0(int n, int sqre, float[] d, float[] e, float[] u, int ldu, float[] vt, int ldvt, int smlsiz, int[] iwork, float[] work, intW info);
+
+ @Override
+ public native void slasd1(int nl, int nr, int sqre, float[] d, floatW alpha, floatW beta, float[] u, int ldu, float[] vt, int ldvt, int[] idxq, int[] iwork, float[] work, intW info);
+
+ @Override
+ public native void slasd2(int nl, int nr, int sqre, intW k, float[] d, float[] z, float alpha, float beta, float[] u, int ldu, float[] vt, int ldvt, float[] dsigma, float[] u2, int ldu2, float[] vt2, int ldvt2, int[] idxp, int[] idx, int[] idxc, int[] idxq, int[] coltyp, intW info);
+
+ @Override
+ public native void slasd3(int nl, int nr, int sqre, int k, float[] d, float[] q, int ldq, float[] dsigma, float[] u, int ldu, float[] u2, int ldu2, float[] vt, int ldvt, float[] vt2, int ldvt2, int[] idxc, int[] ctot, float[] z, intW info);
+
+ @Override
+ public native void slasd4(int n, int i, float[] d, float[] z, float[] delta, float rho, floatW sigma, float[] work, intW info);
+
+ @Override
+ public native void slasd5(int i, float[] d, float[] z, float[] delta, float rho, floatW dsigma, float[] work);
+
+ @Override
+ public native void slasd6(int icompq, int nl, int nr, int sqre, float[] d, float[] vf, float[] vl, floatW alpha, floatW beta, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, float[] poles, float[] difl, float[] difr, float[] z, intW k, floatW c, floatW s, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slasd7(int icompq, int nl, int nr, int sqre, intW k, float[] d, float[] z, float[] zw, float[] vf, float[] vfw, float[] vl, float[] vlw, float alpha, float beta, float[] dsigma, int[] idx, int[] idxp, int[] idxq, int[] perm, intW givptr, int[] givcol, int ldgcol, float[] givnum, int ldgnum, floatW c, floatW s, intW info);
+
+ @Override
+ public native void slasd8(int icompq, int k, float[] d, float[] z, float[] vf, float[] vl, float[] difl, float[] difr, int lddifr, float[] dsigma, float[] work, intW info);
+
+ @Override
+ public native void slasda(int icompq, int smlsiz, int n, int sqre, float[] d, float[] e, float[] u, int ldu, float[] vt, int[] k, float[] difl, float[] difr, float[] z, float[] poles, int[] givptr, int[] givcol, int ldgcol, int[] perm, float[] givnum, float[] c, float[] s, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void slasdq(String uplo, int sqre, int n, int ncvt, int nru, int ncc, float[] d, float[] e, float[] vt, int ldvt, float[] u, int ldu, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void slasdt(int n, intW lvl, intW nd, int[] inode, int[] ndiml, int[] ndimr, int msub);
+
+ @Override
+ public native void slaset(String uplo, int m, int n, float alpha, float beta, float[] a, int lda);
+
+ @Override
+ public native void slasq1(int n, float[] d, float[] e, float[] work, intW info);
+
+ @Override
+ public native void slasq2(int n, float[] z, intW info);
+
+ @Override
+ public native void slasq3(int i0, intW n0, float[] z, int pp, floatW dmin, floatW sigma, floatW desig, floatW qmax, intW nfail, intW iter, intW ndiv, boolean ieee);
+
+ @Override
+ public native void slasq4(int i0, int n0, float[] z, int pp, int n0in, float dmin, float dmin1, float dmin2, float dn, float dn1, float dn2, floatW tau, intW ttype);
+
+ @Override
+ public native void slasq5(int i0, int n0, float[] z, int pp, float tau, floatW dmin, floatW dmin1, floatW dmin2, floatW dn, floatW dnm1, floatW dnm2, boolean ieee);
+
+ @Override
+ public native void slasq6(int i0, int n0, float[] z, int pp, floatW dmin, floatW dmin1, floatW dmin2, floatW dn, floatW dnm1, floatW dnm2);
+
+ @Override
+ public native void slasr(String side, String pivot, String direct, int m, int n, float[] c, float[] s, float[] a, int lda);
+
+ @Override
+ public native void slasrt(String id, int n, float[] d, intW info);
+
+ @Override
+ public native void slassq(int n, float[] x, int incx, floatW scale, floatW sumsq);
+
+ @Override
+ public native void slasv2(float f, float g, float h, floatW ssmin, floatW ssmax, floatW snr, floatW csr, floatW snl, floatW csl);
+
+ @Override
+ public native void slaswp(int n, float[] a, int lda, int k1, int k2, int[] ipiv, int incx);
+
+ @Override
+ public native void slasy2(boolean ltranl, boolean ltranr, int isgn, int n1, int n2, float[] tl, int ldtl, float[] tr, int ldtr, float[] b, int ldb, floatW scale, float[] x, int ldx, floatW xnorm, intW info);
+
+ @Override
+ public native void slasyf(String uplo, int n, int nb, intW kb, float[] a, int lda, int[] ipiv, float[] w, int ldw, intW info);
+
+ @Override
+ public native void slatbs(String uplo, String trans, String diag, String normin, int n, int kd, float[] ab, int ldab, float[] x, floatW scale, float[] cnorm, intW info);
+
+ @Override
+ public native void slatdf(int ijob, int n, float[] z, int ldz, float[] rhs, floatW rdsum, floatW rdscal, int[] ipiv, int[] jpiv);
+
+ @Override
+ public native void slatps(String uplo, String trans, String diag, String normin, int n, float[] ap, float[] x, floatW scale, float[] cnorm, intW info);
+
+ @Override
+ public native void slatrd(String uplo, int n, int nb, float[] a, int lda, float[] e, float[] tau, float[] w, int ldw);
+
+ @Override
+ public native void slatrs(String uplo, String trans, String diag, String normin, int n, float[] a, int lda, float[] x, floatW scale, float[] cnorm, intW info);
+
+ @Override
+ public native void slatrz(int m, int n, int l, float[] a, int lda, float[] tau, float[] work);
+
+ @Override
+ public native void slatzm(String side, int m, int n, float[] v, int incv, float tau, float[] c1, float[] c2, int Ldc, float[] work);
+
+ @Override
+ public native void slauu2(String uplo, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void slauum(String uplo, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void sopgtr(String uplo, int n, float[] ap, float[] tau, float[] q, int ldq, float[] work, intW info);
+
+ @Override
+ public native void sopmtr(String side, String uplo, String trans, int m, int n, float[] ap, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sorg2l(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sorg2r(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sorgbr(String vect, int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorghr(int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorgl2(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sorglq(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorgql(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorgqr(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorgr2(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, intW info);
+
+ @Override
+ public native void sorgrq(int m, int n, int k, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorgtr(String uplo, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorm2l(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sorm2r(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sormbr(String vect, String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sormhr(String side, String trans, int m, int n, int ilo, int ihi, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sorml2(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sormlq(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sormql(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sormqr(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sormr2(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sormr3(String side, String trans, int m, int n, int k, int l, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, intW info);
+
+ @Override
+ public native void sormrq(String side, String trans, int m, int n, int k, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sormrz(String side, String trans, int m, int n, int k, int l, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void sormtr(String side, String uplo, String trans, int m, int n, float[] a, int lda, float[] tau, float[] c, int Ldc, float[] work, int lwork, intW info);
+
+ @Override
+ public native void spbcon(String uplo, int n, int kd, float[] ab, int ldab, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void spbequ(String uplo, int n, int kd, float[] ab, int ldab, float[] s, floatW scond, floatW amax, intW info);
+
+ @Override
+ public native void spbrfs(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void spbstf(String uplo, int n, int kd, float[] ab, int ldab, intW info);
+
+ @Override
+ public native void spbsv(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info);
+
+ @Override
+ public native void spbsvx(String fact, String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] afb, int ldafb, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void spbtf2(String uplo, int n, int kd, float[] ab, int ldab, intW info);
+
+ @Override
+ public native void spbtrf(String uplo, int n, int kd, float[] ab, int ldab, intW info);
+
+ @Override
+ public native void spbtrs(String uplo, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info);
+
+ @Override
+ public native void spocon(String uplo, int n, float[] a, int lda, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void spoequ(int n, float[] a, int lda, float[] s, floatW scond, floatW amax, intW info);
+
+ @Override
+ public native void sporfs(String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sposv(String uplo, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sposvx(String fact, String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void spotf2(String uplo, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void spotrf(String uplo, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void spotri(String uplo, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void spotrs(String uplo, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sppcon(String uplo, int n, float[] ap, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sppequ(String uplo, int n, float[] ap, float[] s, floatW scond, floatW amax, intW info);
+
+ @Override
+ public native void spprfs(String uplo, int n, int nrhs, float[] ap, float[] afp, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sppsv(String uplo, int n, int nrhs, float[] ap, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sppsvx(String fact, String uplo, int n, int nrhs, float[] ap, float[] afp, StringW equed, float[] s, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void spptrf(String uplo, int n, float[] ap, intW info);
+
+ @Override
+ public native void spptri(String uplo, int n, float[] ap, intW info);
+
+ @Override
+ public native void spptrs(String uplo, int n, int nrhs, float[] ap, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sptcon(int n, float[] d, float[] e, float anorm, floatW rcond, float[] work, intW info);
+
+ @Override
+ public native void spteqr(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void sptrfs(int n, int nrhs, float[] d, float[] e, float[] df, float[] ef, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, intW info);
+
+ @Override
+ public native void sptsv(int n, int nrhs, float[] d, float[] e, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sptsvx(String fact, int n, int nrhs, float[] d, float[] e, float[] df, float[] ef, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, intW info);
+
+ @Override
+ public native void spttrf(int n, float[] d, float[] e, intW info);
+
+ @Override
+ public native void spttrs(int n, int nrhs, float[] d, float[] e, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sptts2(int n, int nrhs, float[] d, float[] e, float[] b, int ldb);
+
+ @Override
+ public native void srscl(int n, float sa, float[] sx, int incx);
+
+ @Override
+ public native void ssbev(String jobz, String uplo, int n, int kd, float[] ab, int ldab, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void ssbevd(String jobz, String uplo, int n, int kd, float[] ab, int ldab, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void ssbevx(String jobz, String range, String uplo, int n, int kd, float[] ab, int ldab, float[] q, int ldq, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssbgst(String vect, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] x, int ldx, float[] work, intW info);
+
+ @Override
+ public native void ssbgv(String jobz, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void ssbgvd(String jobz, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void ssbgvx(String jobz, String range, String uplo, int n, int ka, int kb, float[] ab, int ldab, float[] bb, int ldbb, float[] q, int ldq, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssbtrd(String vect, String uplo, int n, int kd, float[] ab, int ldab, float[] d, float[] e, float[] q, int ldq, float[] work, intW info);
+
+ @Override
+ public native void sspcon(String uplo, int n, float[] ap, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sspev(String jobz, String uplo, int n, float[] ap, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void sspevd(String jobz, String uplo, int n, float[] ap, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void sspevx(String jobz, String range, String uplo, int n, float[] ap, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void sspgst(int itype, String uplo, int n, float[] ap, float[] bp, intW info);
+
+ @Override
+ public native void sspgv(int itype, String jobz, String uplo, int n, float[] ap, float[] bp, float[] w, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void sspgvd(int itype, String jobz, String uplo, int n, float[] ap, float[] bp, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void sspgvx(int itype, String jobz, String range, String uplo, int n, float[] ap, float[] bp, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssprfs(String uplo, int n, int nrhs, float[] ap, float[] afp, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sspsv(String uplo, int n, int nrhs, float[] ap, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sspsvx(String fact, String uplo, int n, int nrhs, float[] ap, float[] afp, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void ssptrd(String uplo, int n, float[] ap, float[] d, float[] e, float[] tau, intW info);
+
+ @Override
+ public native void ssptrf(String uplo, int n, float[] ap, int[] ipiv, intW info);
+
+ @Override
+ public native void ssptri(String uplo, int n, float[] ap, int[] ipiv, float[] work, intW info);
+
+ @Override
+ public native void ssptrs(String uplo, int n, int nrhs, float[] ap, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void sstebz(String range, String order, int n, float vl, float vu, int il, int iu, float abstol, float[] d, float[] e, intW m, intW nsplit, float[] w, int[] iblock, int[] isplit, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void sstedc(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void sstegr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void sstein(int n, float[] d, float[] e, int m, float[] w, int[] iblock, int[] isplit, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssteqr(String compz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void ssterf(int n, float[] d, float[] e, intW info);
+
+ @Override
+ public native void sstev(String jobz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, intW info);
+
+ @Override
+ public native void sstevd(String jobz, int n, float[] d, float[] e, float[] z, int ldz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void sstevr(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void sstevx(String jobz, String range, int n, float[] d, float[] e, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssycon(String uplo, int n, float[] a, int lda, int[] ipiv, float anorm, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void ssyev(String jobz, String uplo, int n, float[] a, int lda, float[] w, float[] work, int lwork, intW info);
+
+ @Override
+ public native void ssyevd(String jobz, String uplo, int n, float[] a, int lda, float[] w, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void ssyevr(String jobz, String range, String uplo, int n, float[] a, int lda, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, int[] isuppz, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void ssyevx(String jobz, String range, String uplo, int n, float[] a, int lda, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssygs2(int itype, String uplo, int n, float[] a, int lda, float[] b, int ldb, intW info);
+
+ @Override
+ public native void ssygst(int itype, String uplo, int n, float[] a, int lda, float[] b, int ldb, intW info);
+
+ @Override
+ public native void ssygv(int itype, String jobz, String uplo, int n, float[] a, int lda, float[] b, int ldb, float[] w, float[] work, int lwork, intW info);
+
+ @Override
+ public native void ssygvd(int itype, String jobz, String uplo, int n, float[] a, int lda, float[] b, int ldb, float[] w, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void ssygvx(int itype, String jobz, String range, String uplo, int n, float[] a, int lda, float[] b, int ldb, float vl, float vu, int il, int iu, float abstol, intW m, float[] w, float[] z, int ldz, float[] work, int lwork, int[] iwork, int[] ifail, intW info);
+
+ @Override
+ public native void ssyrfs(String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void ssysv(String uplo, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, float[] work, int lwork, intW info);
+
+ @Override
+ public native void ssysvx(String fact, String uplo, int n, int nrhs, float[] a, int lda, float[] af, int ldaf, int[] ipiv, float[] b, int ldb, float[] x, int ldx, floatW rcond, float[] ferr, float[] berr, float[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void ssytd2(String uplo, int n, float[] a, int lda, float[] d, float[] e, float[] tau, intW info);
+
+ @Override
+ public native void ssytf2(String uplo, int n, float[] a, int lda, int[] ipiv, intW info);
+
+ @Override
+ public native void ssytrd(String uplo, int n, float[] a, int lda, float[] d, float[] e, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native void ssytrf(String uplo, int n, float[] a, int lda, int[] ipiv, float[] work, int lwork, intW info);
+
+ @Override
+ public native void ssytri(String uplo, int n, float[] a, int lda, int[] ipiv, float[] work, intW info);
+
+ @Override
+ public native void ssytrs(String uplo, int n, int nrhs, float[] a, int lda, int[] ipiv, float[] b, int ldb, intW info);
+
+ @Override
+ public native void stbcon(String norm, String uplo, String diag, int n, int kd, float[] ab, int ldab, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void stbrfs(String uplo, String trans, String diag, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void stbtrs(String uplo, String trans, String diag, int n, int kd, int nrhs, float[] ab, int ldab, float[] b, int ldb, intW info);
+
+ @Override
+ public native void stgevc(String side, String howmny, boolean[] select, int n, float[] s, int lds, float[] p, int ldp, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, intW info);
+
+ @Override
+ public native void stgex2(boolean wantq, boolean wantz, int n, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, int j1, int n1, int n2, float[] work, int lwork, intW info);
+
+ @Override
+ public native void stgexc(boolean wantq, boolean wantz, int n, float[] a, int lda, float[] b, int ldb, float[] q, int ldq, float[] z, int ldz, intW ifst, intW ilst, float[] work, int lwork, intW info);
+
+ @Override
+ public native void stgsen(int ijob, boolean wantq, boolean wantz, boolean[] select, int n, float[] a, int lda, float[] b, int ldb, float[] alphar, float[] alphai, float[] beta, float[] q, int ldq, float[] z, int ldz, intW m, floatW pl, floatW pr, float[] dif, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void stgsja(String jobu, String jobv, String jobq, int m, int p, int n, int k, int l, float[] a, int lda, float[] b, int ldb, float tola, float tolb, float[] alpha, float[] beta, float[] u, int ldu, float[] v, int ldv, float[] q, int ldq, float[] work, intW ncycle, intW info);
+
+ @Override
+ public native void stgsna(String job, String howmny, boolean[] select, int n, float[] a, int lda, float[] b, int ldb, float[] vl, int ldvl, float[] vr, int ldvr, float[] s, float[] dif, int mm, intW m, float[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void stgsy2(String trans, int ijob, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, float[] d, int ldd, float[] e, int lde, float[] f, int ldf, floatW scale, floatW rdsum, floatW rdscal, int[] iwork, intW pq, intW info);
+
+ @Override
+ public native void stgsyl(String trans, int ijob, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, float[] d, int ldd, float[] e, int lde, float[] f, int ldf, floatW scale, floatW dif, float[] work, int lwork, int[] iwork, intW info);
+
+ @Override
+ public native void stpcon(String norm, String uplo, String diag, int n, float[] ap, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void stprfs(String uplo, String trans, String diag, int n, int nrhs, float[] ap, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void stptri(String uplo, String diag, int n, float[] ap, intW info);
+
+ @Override
+ public native void stptrs(String uplo, String trans, String diag, int n, int nrhs, float[] ap, float[] b, int ldb, intW info);
+
+ @Override
+ public native void strcon(String norm, String uplo, String diag, int n, float[] a, int lda, floatW rcond, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void strevc(String side, String howmny, boolean[] select, int n, float[] t, int ldt, float[] vl, int ldvl, float[] vr, int ldvr, int mm, intW m, float[] work, intW info);
+
+ @Override
+ public native void strexc(String compq, int n, float[] t, int ldt, float[] q, int ldq, intW ifst, intW ilst, float[] work, intW info);
+
+ @Override
+ public native void strrfs(String uplo, String trans, String diag, int n, int nrhs, float[] a, int lda, float[] b, int ldb, float[] x, int ldx, float[] ferr, float[] berr, float[] work, int[] iwork, intW info);
+
+ @Override
+ public native void strsen(String job, String compq, boolean[] select, int n, float[] t, int ldt, float[] q, int ldq, float[] wr, float[] wi, intW m, floatW s, floatW sep, float[] work, int lwork, int[] iwork, int liwork, intW info);
+
+ @Override
+ public native void strsna(String job, String howmny, boolean[] select, int n, float[] t, int ldt, float[] vl, int ldvl, float[] vr, int ldvr, float[] s, float[] sep, int mm, intW m, float[] work, int ldwork, int[] iwork, intW info);
+
+ @Override
+ public native void strsyl(String trana, String tranb, int isgn, int m, int n, float[] a, int lda, float[] b, int ldb, float[] c, int Ldc, floatW scale, intW info);
+
+ @Override
+ public native void strti2(String uplo, String diag, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void strtri(String uplo, String diag, int n, float[] a, int lda, intW info);
+
+ @Override
+ public native void strtrs(String uplo, String trans, String diag, int n, int nrhs, float[] a, int lda, float[] b, int ldb, intW info);
+
+ @Override
+ public native void stzrqf(int m, int n, float[] a, int lda, float[] tau, intW info);
+
+ @Override
+ public native void stzrzf(int m, int n, float[] a, int lda, float[] tau, float[] work, int lwork, intW info);
+
+ @Override
+ public native double dlamch(String cmach);
+
+ @Override
+ public native void dlamc1(intW beta, intW t, booleanW rnd, booleanW ieee1);
+
+ @Override
+ public native void dlamc2(intW beta, intW t, booleanW rnd, doubleW eps, intW emin, doubleW rmin, intW emax, doubleW rmax);
+
+ @Override
+ public native void dlamc4(intW emin, double start, int base);
+
+ @Override
+ public native void dlamc5(int beta, int p, int emin, boolean ieee, intW emax, doubleW rmax);
+
+ @Override
+ public native void slamc1(intW beta, intW t, booleanW rnd, booleanW ieee1);
+
+ @Override
+ public native void slamc2(intW beta, intW t, booleanW rnd, floatW eps, intW emin, floatW rmin, intW emax, floatW rmax);
+
+ @Override
+ public native void slamc4(intW emin, float start, int base);
+
+ @Override
+ public native void slamc5(int beta, int p, int emin, boolean ieee, intW emax, floatW rmax);
+
+}
diff --git a/src/org/netlib/utils/JNIMethods.java b/src/org/netlib/utils/JNIMethods.java
new file mode 100644
index 0000000..cce0c31
--- /dev/null
+++ b/src/org/netlib/utils/JNIMethods.java
@@ -0,0 +1,162 @@
+/*
+ * Copyright ThinkTank Maths Limited 2007. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without modification, are
+ * permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice, this list
+ * of conditions and the following disclaimer.
+ *
+ * - Redistributions in binary form must reproduce the above copyright notice, this
+ * list of conditions and the following disclaimer listed in this license in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * - Neither the name of the copyright holders nor the names of its contributors may
+ * be used to endorse or promote products derived from this software without specific
+ * prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
+ * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
+ * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package org.netlib.utils;
+
+import java.io.File;
+
+/**
+ * Static helper methods for dealing with the Java Native Interface and detection of
+ * operating systems and architectures. The main purpose of this class is to provide a
+ * more portable alternative to the System.loadLibrary method (and horrible syntax of
+ * Bundle-NativeCode in MANIFEST files) when bundling binaries as part of a jar (either
+ * inside, or in a directory structure nearby).
+ * <p>
+ * Note on usage: unfortunately it is not possible to provide a loadLibrary(String) method
+ * here as it needs to know the calling class, which is lost when wrapped here. To load a
+ * native library using this class, call the getPortableLibraryName() method to return a
+ * String which may then be passed to System.loadLibrary().
+ * <p>
+ * Note: due to the nature of this class, a portable JUnit TestCase is not possible.
+ *
+ * @author Samuel Halliday
+ */
+public final class JNIMethods {
+ /**
+ * Enumeration of common CPU architectures.
+ */
+ public enum ARCHType {
+ PPC, PPC_64, SPARC, UNKNOWN, X86, X86_64
+ };
+
+ /**
+ * Enumeration of common operating systems, independent of version or architecture.
+ */
+ public enum OSType {
+ APPLE, LINUX, SUN, UNKNOWN, WINDOWS
+ };
+
+ /**
+ * Stores the CPU Architecture the JVM is currently running on.
+ */
+ public static final ARCHType ARCH = calculateArch();
+
+ /**
+ * Stores the operating system the JVM is currently running on.
+ */
+ public static final OSType OS = calculateOS();
+
+ /**
+ * The System.mapLibraryName method is broken in the sense that it does not give
+ * unique names for operating systems and architectures. In order to facilitate
+ * cross-platform compatibility allowing bundled binary files, this method will return
+ * a unique library name, dependent on the operating system and architecture. The
+ * return value of this method should be passed to the System.loadLibrary method
+ * instead of the raw library name.
+ * <p>
+ * The resulting filename will be constructed by forcing the library name to lowercase
+ * and appending an extra String that is defined by the operating system (the
+ * architecture is only encoded if it is relevant). Some examples are for the
+ * parameter 'name':-
+ * <ul>
+ * <li>Apple (G3, G4): "name-apple-ppc"</li>
+ * <li>Apple (G5): "name-apple-ppc_64"</li>
+ * <li>Apple (Intel): "name-apple-x86"</li>
+ * <li>Apple (Intel 64 Bit mode): "name-apple-x86_64"</li>
+ * <li>Linux (i686): "name-linux-x86"</li>
+ * <li>Linux (Intel/AMD 64): "name-linux-x86_64"</li>
+ * <li>Linux (sparc): "name-linux-sparc"</li>
+ * <li>Linux (PPC 32 bit): "name-linux-ppc"</li>
+ * <li>Linux (PPC 64 bit): "name-linux-ppc_64"</li>
+ * <li>Windows XP/Vista (i686): "name-windows-x86"</li>
+ * <li>Windows XP/Vista (Intel/AMD 64): "name-windows-x86_64"</li>
+ * <li>Sun Solaris (Blade): "name-sun-sparc"</li>
+ * <li>Sun Solaris (Intel 64 bit): "name-sun-x86_64"</li>
+ * </ul>
+ *
+ * @param name
+ * @return
+ * @throws IllegalArgumentException
+ * if the input name is zero length or contains a directory separator
+ * character.
+ */
+ public static String getPortableLibraryName(String name) {
+ if (name == null)
+ throw new NullPointerException();
+
+ if ((name.length() == 0) || name.contains(File.separator) || name.
+ contains("/"))
+ throw new IllegalArgumentException(
+ "Directory separator should not appear in library name: " + name);
+
+ return name.toLowerCase() + getSuffix();
+ }
+
+ public static void main(String[] args) {
+ System.out.println(JNIMethods.OS + ", " + JNIMethods.ARCH + ", " +
+ getPortableLibraryName("NAME"));
+ }
+
+ private static ARCHType calculateArch() {
+ String osArch = System.getProperty("os.arch").toLowerCase();
+ assert osArch != null;
+ if (osArch.equals("i386"))
+ return ARCHType.X86;
+ if (osArch.startsWith("amd64") || osArch.startsWith("x86_64"))
+ return ARCHType.X86_64;
+ if (osArch.equals("ppc"))
+ return ARCHType.PPC;
+ if (osArch.startsWith("ppc"))
+ return ARCHType.PPC_64;
+ if (osArch.startsWith("sparc"))
+ return ARCHType.SPARC;
+ return ARCHType.UNKNOWN;
+ }
+
+ private static OSType calculateOS() {
+ String osName = System.getProperty("os.name").toLowerCase();
+ assert osName != null;
+ if (osName.startsWith("mac os x"))
+ return OSType.APPLE;
+ if (osName.startsWith("windows"))
+ return OSType.WINDOWS;
+ if (osName.startsWith("linux"))
+ return OSType.LINUX;
+ if (osName.startsWith("sun"))
+ return OSType.SUN;
+ return OSType.UNKNOWN;
+ }
+
+ private static String getSuffix() {
+ String prefix =
+ "-" + OS.toString().toLowerCase() + "-" + ARCH.toString().
+ toLowerCase();
+
+ return prefix;
+ }
+}
diff --git a/tests/org/netlib/blas/BLASTest.java b/tests/org/netlib/blas/BLASTest.java
new file mode 100644
index 0000000..d814eba
--- /dev/null
+++ b/tests/org/netlib/blas/BLASTest.java
@@ -0,0 +1,79 @@
+
+/**
+ * Jun 4, 2007
+ *
+ * @author Samuel Halliday, ThinkTank Maths Limited
+ * @copyright ThinkTank Maths Limited 2007
+ */
+package org.netlib.blas;
+
+import java.util.Random;
+
+import junit.framework.TestCase;
+
+/**
+ * @author Samuel Halliday, ThinkTank Maths Limited
+ */
+public class BLASTest extends TestCase {
+ private final BLAS jBLAS = JBLAS.INSTANCE;
+
+ private final NativeBLAS nativeBLAS = NativeBLAS.INSTANCE;
+
+ public void testDot() {
+ testDot1(jBLAS);
+ testDot1(nativeBLAS);
+ }
+
+ /**
+ * We test the JNI and the Java code at the same time so that we can compare results.
+ * Future JUnit tests should probably test against prior results so that we can write
+ * tests for the BLAS interface and then send the appropriate implementation to it.
+ *
+ * @see #testDot()
+ */
+ public void testDotSpeed() {
+ assert nativeBLAS.isLoaded;
+
+ int[] sizes = new int[]{10, 100, 1000, 10000, 20000, 50000, 75000,
+ 100000, 200000, 500000, 1000000, 10000000
+ }; // , 50000000 };
+
+ for (int size : sizes) {
+ final double[] array1 = randomArray(size);
+ final double[] array2 = randomArray(size);
+
+ long start = System.currentTimeMillis();
+ double outJ = jBLAS.ddot(size, array1, 1, array2, 1);
+ long endJ = System.currentTimeMillis();
+ double outN = nativeBLAS.ddot(size, array1, 1, array2, 1);
+ long endN = System.currentTimeMillis();
+
+
+ assert Math.abs(outJ - outN) < 0.00001d;
+ System.out.println("Array size: " + size + ", jLAPACK took: " +
+ (endJ - start) / 1000.0 + ", nativeLAPACK took: " +
+ (endN - endJ) / 1000.0);
+ }
+ }
+
+ // return array of size n with normally distributed elements
+ // this is a bottleneck when running the tests
+ private double[] randomArray(int n) {
+ assert n > 0;
+ Random random = new Random();
+ double[] array = new double[n];
+ for (int i = 0; i < n; i++) {
+ array[i] = random.nextGaussian();
+ }
+ return array;
+ }
+
+ private void testDot1(BLAS blas) {
+ double[] dx = {1.1, 2.2, 3.3, 4.4};
+ double[] dy = {1.1, 2.2, 3.3, 4.4};
+ int n = dx.length;
+
+ double answer = blas.ddot(n, dx, 1, dy, 1);
+ assert Math.abs(answer - 36.3) < 0.00001d;
+ }
+}
diff --git a/tests/org/netlib/lapack/LAPACKTest.java b/tests/org/netlib/lapack/LAPACKTest.java
new file mode 100644
index 0000000..28977ad
--- /dev/null
+++ b/tests/org/netlib/lapack/LAPACKTest.java
@@ -0,0 +1,88 @@
+
+/**
+ * Sep 14, 2007
+ *
+ * @author Samuel Halliday, ThinkTank Maths Limited
+ * @copyright ThinkTank Maths Limited 2007
+ */
+package org.netlib.lapack;
+
+import junit.framework.TestCase;
+
+/**
+ * @author Samuel Halliday, ThinkTank Maths Limited
+ */
+public class LAPACKTest extends TestCase {
+ LAPACK jLAPACK = JLAPACK.INSTANCE;
+
+ LAPACK nativeLAPACK = NativeLAPACK.INSTANCE;
+
+ public void testGesvd() {
+ double[] jAns = testGesvd1(jLAPACK);
+ double[] nativeAns = testGesvd1(nativeLAPACK);
+ assert arrayElementsEqual(jAns, nativeAns);
+ }
+
+ public void testSygv() {
+ double[] jAns = testSygv1(jLAPACK);
+ double[] nativeAns = testSygv1(nativeLAPACK);
+ assert arrayElementsEqual(jAns, nativeAns);
+ }
+
+ private double[] testGesvd1(LAPACK lapack) {
+ int M = 5;
+ int N = 3;
+ double[] m = {18.91, 14.91, -6.15, -18.15, 27.5, -1.59, -1.59, -2.25,
+ -1.59, -2.25, -1.59, 1.59, 0.0, 1.59, 0.0
+ };
+
+ double[] s = new double[m.length];
+ double[] u = new double[M * M];
+ double[] vt = new double[N * N];
+ double[] work =
+ new double[Math.max(3 * Math.min(M, N) + Math.max(M, N),
+ 5 * Math.min(M, N))];
+ org.netlib.util.intW info = new org.netlib.util.intW(2);
+
+ lapack.dgesvd("A", "A", M, N, m, M, s, u, M, vt, N, work, work.length,
+ info);
+
+ return s;
+ }
+
+ private double[] testSygv1(LAPACK lapack) {
+ int itype = 1;
+ int n = 3;
+ double[] a = {1.0, 2.0, 4.0, 0.0, 3.0, 5.0, 0.0, 0.0, 6.0};
+ int lda = 3;
+ double[] b = {2.5298, 0.6405, 0.2091, 0.3798, 2.7833, 0.6808, 0.4611,
+ 0.5678, 2.7942
+ };
+ int ldb = 3;
+ double[] w = new double[n];
+ int lwork = 9;
+ double[] work = new double[lwork];
+ org.netlib.util.intW info = new org.netlib.util.intW(0);
+
+ lapack.dsygv(itype, "N", "U", n, a, lda, b, ldb, w, work, lwork, info);
+ return w;
+ }
+
+ /**
+ * Convenience method to check equality of all elements in two arrays.
+ *
+ * @param a
+ * @param b
+ * @return
+ */
+ public static boolean arrayElementsEqual(double[] a, double[] b) {
+ if (a.length != b.length)
+ return false;
+
+ for (int i = 0; i < a.length; i++) {
+ if (Math.abs(a[i] - b[i]) > 0.00001d)
+ return false;
+ }
+ return true;
+ }
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-java/libnetlib-java.git
More information about the pkg-java-commits
mailing list